diff --git a/CMakeLists.txt b/CMakeLists.txt
index fb2597a..e5379c4 100644
--- a/CMakeLists.txt
+++ b/CMakeLists.txt
@@ -29,7 +29,12 @@ set(CMAKE_Fortran_FLAGS_DEBUG "${CMAKE_Fortran_FLAGS_DEBUG} ${debug_flags}")
set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} ${release_flags}")
# Sources to compile - everything except those matching the regex
-file(GLOB_RECURSE sources src/*.f90 vendor/*.f90)
+file(GLOB_RECURSIVE sources
+ src/*.f90
+ src/Data/*.f90
+ src/Contaminant/*.f90
+ vendor/*.f90
+)
list(FILTER sources EXCLUDE REGEX ".*vendor/feh/example/.*f90$")
list(FILTER sources EXCLUDE REGEX ".*vendor/feh/tests/.*f90$")
list(FILTER sources EXCLUDE REGEX ".*vendor/datetime-fortran/tests/.*f90$")
@@ -47,4 +52,4 @@ file(WRITE "src/VersionModule.f90" ${version_file_new})
# Compile to executable and link to NetCDF
add_executable(nanofase ${sources})
target_include_directories(nanofase PUBLIC "${NETCDF_INCLUDES}")
-target_link_libraries(nanofase PRIVATE "${NETCDF_LIBRARIES_F90}")
+target_link_libraries(nanofase PRIVATE "${NETCDF_LIBRARIES_F90}")
\ No newline at end of file
diff --git a/Makefile.example b/Makefile.example
index 0f5a78d..81df476 100644
--- a/Makefile.example
+++ b/Makefile.example
@@ -32,90 +32,92 @@ COMP_META = $(COMPILE_TIME) $(GIT_HASH) $(GIT_RELEASE)
AUTOPARALLEL = 0
N_THREADS = 4
ifeq ($(AUTOPARALLEL), 1)
- COMMON_FLAGS += -floop-parallelize-all -ftree-parallelize-loops=${N_THREADS}
+ COMMON_FLAGS += -floop-parallelize-all -ftree-parallelize-loops=${N_THREADS}
endif
# Objects to generate, in dependency order
OBJECTS_ = ErrorInstance.o \
- Result.o \
- ErrorHandler.o \
- ErrorCriteria.o \
- mo_types.o \
- mo_netcdf.o \
- datetime_module.o \
- sparskit.o \
- Spoof.o \
- mod_strptime.o \
- VersionModule.o \
- DefaultsModule.o \
- GlobalsModule.o \
- UtilModule.o \
- LoggerModule.o \
- DataInputModule.o \
- AbstractBiotaModule.o \
- BiotaSoilModule.o \
- BiotaWaterModule.o \
- AbstractReactorModule.o \
- ReactorModule.o \
- FineSedimentModule.o \
- AbstractBedSedimentLayerModule.o \
- BedSedimentLayerModule.o \
- AbstractBedSedimentModule.o \
- BedSedimentModule.o \
- DiffuseSourceModule.o \
- PointSourceModule.o \
- FlowModule.o \
- WaterBodyModule.o \
- ReachModule.o \
- RiverReachModule.o \
- EstuaryReachModule.o \
- AbstractSoilLayerModule.o \
- SoilLayerModule.o \
- AbstractSoilProfileModule.o \
- SoilProfileModule.o \
- CropModule.o \
- AbstractGridCellModule.o \
- GridCellModule.o \
- AbstractEnvironmentModule.o \
- EnvironmentModule.o \
- NetCDFOutputModule.o \
- NetCDFAggregatedOutputModule.o \
- DataOutputModule.o \
- CheckpointModule.o \
- main.o
+ Result.o \
+ ErrorHandler.o \
+ ErrorCriteria.o \
+ mo_types.o \
+ mo_netcdf.o \
+ datetime_module.o \
+ sparskit.o \
+ Spoof.o \
+ mod_strptime.o \
+ VersionModule.o \
+ DefaultsModule.o \
+ GlobalsModule.o \
+ UtilModule.o \
+ LoggerModule.o \
+ DataInputModule.o \
+ ContaminantModule.o \
+ FlowModule.o \
+ AbstractBiotaModule.o \
+ BiotaSoilModule.o \
+ BiotaWaterModule.o \
+ AbstractReactorModule.o \
+ ReactorModule.o \
+ FineSedimentModule.o \
+ AbstractBedSedimentLayerModule.o \
+ BedSedimentLayerModule.o \
+ AbstractBedSedimentModule.o \
+ BedSedimentModule.o \
+ DiffuseSourceModule.o \
+ PointSourceModule.o \
+ AbstractSoilLayerModule.o \
+ SoilLayerModule.o \
+ AbstractSoilProfileModule.o \
+ SoilProfileModule.o \
+ CropModule.o \
+ WaterBodyModule.o \
+ ReachModule.o \
+ RiverReachModule.o \
+ EstuaryReachModule.o \
+ AbstractGridCellModule.o \
+ GridCellModule.o \
+ AbstractEnvironmentModule.o \
+ EnvironmentModule.o \
+ NetCDFOutputModule.o \
+ NetCDFAggregatedOutputModule.o \
+ DataOutputModule.o \
+ CheckpointModule.o \
+ main.o
# Add the build dir to each object name
OBJECTS = $(addprefix build/, $(OBJECTS_))
# Where to look for the source files
VPATH = vendor/feh/src \
- vendor/mo_netcdf/src \
- vendor/datetime-fortran/src \
- vendor/spoof/src \
- src \
- src/Data \
- src/Logger \
- src/Biota \
- src/Reactor \
- src/BedSedimentLayer \
- src/BedSediment \
- src/Source \
- src/WaterBody \
- src/Soil \
- src/GridCell \
- src/Environment
+ vendor/mo_netcdf/src \
+ vendor/datetime-fortran/src \
+ vendor/spoof/src \
+ src \
+ src/Data \
+ src/Logger \
+ src/Biota \
+ src/Reactor \
+ src/BedSedimentLayer \
+ src/BedSediment \
+ src/Source \
+ src/WaterBody \
+ src/Soil \
+ src/GridCell \
+ src/Environment \
+ src/Contaminant
# Write the model version (from git) to file
MODEL_VERSION := $(shell sed -i "s/\".*\"/\"${GIT_RELEASE}\"/g" src/VersionModule.f90)
$(EXEC_FILE): $(OBJECTS)
- $(FC) $(FLAGS) -o $(BUILD_DIR)/$@ $^ $(NETCDF)
- echo $(COMP_META) > $(BUILD_DIR)/comp_meta
+ $(FC) $(FLAGS) -o $(BUILD_DIR)/$@ $^ $(NETCDF)
+ echo $(COMP_META) > $(BUILD_DIR)/comp_meta
$(BUILD_DIR)/%.o: %.f90
- $(FC) -c $< -o $@ -J$(BUILD_DIR) $(FLAGS) $(NETCDF)
+ $(FC) -c $< -o $@ -J$(BUILD_DIR) $(FLAGS) $(NETCDF)
release: FLAGS = ${RELEASE_FLAGS} ${COMMON_FLAGS}
release: $(EXEC_FILE)
fast: FLAGS = ${FAST_FLAGS} ${COMMON_FLAGS}
fast: $(EXEC_FILE)
clean:
- rm -f $(BUILD_DIR)/*.mod $(BUILD_DIR)/*.o $(BUILD_DIR)/$(EXEC_FILE) $(BUILD_DIR)/comp_meta
+ rm -f $(BUILD_DIR)/*.mod $(BUILD_DIR)/*.o $(BUILD_DIR)/$(EXEC_FILE) $(BUILD_DIR)/comp_meta
\ No newline at end of file
diff --git a/config.example/test-scenario.example.nml b/config.example/test-scenario.example.nml
index 1cdfb7c..5b26b2c 100644
--- a/config.example/test-scenario.example.nml
+++ b/config.example/test-scenario.example.nml
@@ -1,104 +1,96 @@
!! NanoFASE model test scenario example config file
!! ------------------------------------------------
-!! This file provideds a full list of config options that can be provided to
-!! the NanoFASE model. When used as is (alongside the data stored at
-!! data.example/test-scenario.nc), this runs the model for a 12-cell,
-!! 10-timestep test scenario.
+!! This file provides the main configuration options for the model run.
-! One of the quirks of Fortran namelist files is that you can't saved implicitly sized
-! arrays to variables in Fortran code without knowing their length. The way around this
-! is to specify the array lengths as separate variables in a group read in before the
-! arrays themselves. This is that group.
&allocatable_array_sizes
-n_soil_layers = 3 ! Number of soil layers to model
-n_sediment_layers = 4 ! Number of sediment layers to model
-n_nm_size_classes = 5 ! Number of NM size classes
-n_spm_size_classes = 5 ! Number of SPM size classes
-n_fractional_compositions = 2 ! Number of fractional compositions for sediment
+ n_soil_layers = 3 ! Number of soil layers to model
+ n_sediment_layers = 4 ! Number of sediment layers to model
+ n_contaminant_size_classes = 5 ! Number of contaminant size classes
+ n_spm_size_classes = 5 ! Number of SPM size classes
+ n_fractional_compositions = 2 ! Number of fractional compositions for sediment
/
-! Control the config options specific to the NMs
-&nanomaterial
-nm_size_classes = 10e-9, 30e-9, 100e-9, 300e-9, 1000e-9 ! Diameter of NM in each binned size class [m]
-n_nm_forms = 1 ! Number of NM forms (core, shell, coating, corona etc)
-n_nm_extra_states = 2 ! Number of extra NM states, other than heteroaggregated to SPM
-/
+&contaminant
+ n_contaminant_extra_states = 2 ! Number of extra contaminant states, other than heteroaggregated to SPM
+ n_contaminant_forms = 2 ! Number of contaminant forms (e.g., pristine, transformed)
+/
-! Paths to data. For info on compiling data for the NanoFASE model, see the nanofase-data repo: https://github.com/NERC-CEH/nanofase-data
&data
-input_file = "data.example/test-scenario.nc" ! Path to NetCDF input data, which includes most of the spatial and temporally resolved data
-constants_file = "data.example/constants_test-scenario.nml" ! Path to constants namelist file, which includes most of the non-spatiotemporal input data
-output_path = "output/" ! Path to store the output data
+ input_file = "data.example/test-scenario.nc" ! Path to NetCDF input data
+ constants_file = "data.example/constants_test-scenario.nml" ! Path to constants namelist file
+ output_path = "output/" ! Path to store the output data
/
&output
-write_csv = .true. ! Should we write output data to CSV files?
-write_netcdf = .true. ! Should we write output data to a NetCDF file?
-netcdf_write_mode = 'end' ! When should we write to the NetCDF file? Every time step ('itr') or at the end of the run ('end'). Every time step is slower, end uses much more memory
-write_metadata_as_comment = .true. ! Should output data metadata (e.g. column descriptions) be included as comments at top of CSV files?
-include_waterbody_breakdown = .false. ! For surface water and sediment output, include breakdown over waterbodies or aggregate at grid cell level?
-include_sediment_layer_breakdown = .true. ! Include breakdown of data over sediment layers?
-include_soil_layer_breakdown = .false. ! Include breaedown of data over soil layers?
-include_soil_state_breakdown = .false. ! Include breakdown of NM state - free vs attached to soil matrix
-soil_pec_units = 'kg/kg' ! What units to use for soil PEC - kg/kg or kg/m3? NOT CURRENTLY IN USE
-sediment_pec_units = 'kg/kg' ! What units to use for sediment PEC - kg/kg or kg/m3? NOT CURRENTLY IN USE
-include_soil_erosion_yields = .true. ! Should soil erosion yields be included in soil output?
-include_sediment_fluxes = .true. ! Should sediment fluxes to/from waterbodies be included?
+ write_csv = .true.
+ write_netcdf = .true.
+ netcdf_write_mode = 'end'
+ write_metadata_as_comment = .true.
+ include_waterbody_breakdown = .false.
+ include_sediment_layer_breakdown = .true.
+ include_soil_layer_breakdown = .false.
+ include_soil_state_breakdown = .false.
+ soil_pec_units = 'kg/kg'
+ sediment_pec_units = 'kg/kg'
+ include_soil_erosion_yields = .true.
+ include_sediment_fluxes = .true.
+ include_spm_size_class_breakdown = .false.
+ write_compartment_stats = .false.
/
&run
-description = "12 cell, 10 timestep test scenario" ! Not used by model, but included in output data
-write_to_log = .false. ! Should we write logs to file?
-timestep = 86400 ! Length of each time step, in seconds
-n_timesteps = 10 ! Number of time steps
-start_date = "2015-01-01" ! Start date for model run, in YYYY-MM-DD format
-epsilon = 1e-20, ! Precision for numerical simulations
-error_output = .true. ! Should error handling be turned on? Be careful if not, things might go wrong!
-trigger_warnings = .false. ! Should errors that are non-critical (warnings) be triggered (printed to the console)?
-log_file_path = "log/" ! Where to place model logs
-output_hash = "" ! Append all output file names with this value. Useful for parallel model runs. Max 32 characters (e.g. hex string).
-ignore_nm = .false. ! If .true., this tells the model we're not interested in NM and misses out costly computations. Useful for sediment calibration, NM PECs will be invalid
-warm_up_period = 10 ! Warm up period before main simulation begin.
-simulation_mask = "" ! Path to simulation mask, if only running for part of the data's area (empty string indicates no mask)
+ description = "12 cell, 10 timestep test scenario"
+ write_to_log = .false.
+ timestep = 86400
+ n_timesteps = 10
+ start_date = "2015-01-01"
+ epsilon = 1e-20
+ error_output = .true.
+ trigger_warnings = .false.
+ log_file_path = "log/"
+ output_hash = ""
+ ignore_contaminant = .false.
+ warm_up_period = 10
+ simulation_mask = ""
+ bash_colors = .true.
/
-! Checkpointing is the ability to save a model run so that it can be reinstated from file. This is useful if, for example,
-! you want to have a standard "warm-up" period for the model which you don't want to run every time you run the model.
-! The checkpoint file is a binary file and this may cause issues transferring to different architectures
&checkpoint
-checkpoint_file = "./checkpoint.dat" ! Location of checkpoint file to read from and/or save to
-save_checkpoint = .false. ! Save a checkpoint file when the run is finished? Defaults to false
-reinstate_checkpoint = .false. ! Reinstate a checkpoint from checkpoint_file? Defaults to false
-preserve_timestep = .false. ! Should the timestep from the checkpoint be used as a starting timestep in a reinstated run?
+ checkpoint_file = "./checkpoint.dat"
+ save_checkpoint = .false.
+ reinstate_checkpoint = .false.
+ preserve_timestep = .false.
+ save_checkpoint_after_warm_up = .false.
/
&steady_state
-run_to_steady_state = .false. ! Should the model be run until steady state by iterating over current simulation input data?
-mode = 'sediment_size_distribution' ! Mode defines what variable will be used to assess steady state
-delta = 1e-4
+ run_to_steady_state = .false.
+ mode = 'sediment_size_distribution'
+ delta = 1e-4
/
&soil
-soil_layer_depth = 0.05, 0.15, 0.2 ! Depth of each soil layer. Array of length &allocatable_array_sizes > n_soil_layers
-include_bioturbation = .true. ! Should bioturbation be modelled?
-include_attachment = .true. ! Should attachment be modelled?
-include_soil_erosion = .true. ! Should soil erosion be modelled?
+ soil_layer_depth = 0.05, 0.15, 0.2
+ include_bioturbation = .true.
+ include_attachment = .true.
+ include_soil_erosion = .true.
+ include_clay_enrichment = .false.
/
&sediment
-sediment_layer_depth = 0.01, 0.01, 0.01, 0.01 ! Depth of each sediment layer. Array of length &allocatable_array_sizes > n_sediment_layers
-spm_size_classes = 0.002e-3, 0.06e-3, 0.2e-3, 0.6e-3, 2.0e-3 ! Diameter of SPM in each binned size class [m]
-include_bed_sediment = .true. ! Should bed sediment be modelled?
-sediment_particle_densities = 1500, 2600 ! Density of sediment particles in each fractional composition class [kg/m3]
+ sediment_layer_depth = 0.01, 0.01, 0.01, 0.01
+ spm_size_classes = 0.002e-3, 0.06e-3, 0.2e-3, 0.6e-3, 2.0e-3
+ include_bed_sediment = .true.
+ sediment_particle_densities = 1500, 2600 ! optional; defaulted in code if omitted
/
&water
-min_stream_slope = 0.0001 ! Impose a minimum stream slope. Defaults to 0.0001, must be greater than 0
-min_estuary_timestep = 3600 ! Minimum timestep length to use when modelling estuarine dynamics [s]. Defaults to 1 hour
-include_estuary = .true. ! Should we model estuaries, or treat them as rivers?
-include_bank_erosion = .true. ! Should we model the input of sediment via bank erosion?
+ min_stream_slope = 0.0001
+ min_estuary_timestep = 3600
+ include_estuary = .true.
+ include_bank_erosion = .true.
/
&sources
-include_point_sources = .true. ! Should point sources be included?
+ include_point_sources = .true.
/
diff --git a/data.example/constants_test-scenario.nml b/data.example/constants_test-scenario.nml
index bc4dbd8..e559581 100644
--- a/data.example/constants_test-scenario.nml
+++ b/data.example/constants_test-scenario.nml
@@ -1,6 +1,15 @@
+!! NanoFASE model constants file for test scenario
+!! ------------------------------------------------
+!! This file is read by the DataInputModule to set up physical constants
+!! and default parameters for the simulation.
+
&allocatable_array_sizes
+ ! These parameters tell the model how large the arrays in this file are,
+ ! so it can allocate memory before reading them.
+ n_contaminant_size_classes = 5
+ n_default_contaminant_size_distribution = 5
+ n_default_contaminant_form_distribution = 3 ! Forms (pristine, transformed) + dissolved
n_default_matrixembedded_distribution_to_spm = 5
- n_default_nm_size_distribution = 5
n_default_spm_size_distribution = 5
n_spm_density_by_size_class = 5
n_estuary_mouth_coords = 2
@@ -9,21 +18,15 @@
n_porosity = 4
n_vertical_distribution = 3
/
-&earthworm_densities
- arable = 30
- coniferous = 150
- deciduous = 400
- grassland = 250
- heathland = 20
- urban_capped = 0
- urban_gardens = 150
- urban_parks = 250
- vertical_distribution = 50, 35, 15
-/
-&nanomaterial
- default_nm_size_distribution = 50, 30, 10, 7, 3
- nm_density = 4230
+&contaminant
+ contaminant_density = 4230
+ contaminant_size_classes = 10e-9, 30e-9, 100e-9, 300e-9, 1000e-9
+ default_contaminant_size_distribution = 50, 30, 10, 7, 3
+ default_contaminant_form_distribution = 80, 15, 5 ! 80% pristine, 15% transformed, 5% dissolved
+ k_diss_pristine = 0.0
+ k_diss_transformed = 0.0
+ k_transform_pristine = 0.0
/
&sediment
@@ -31,43 +34,52 @@
default_spm_size_distribution = 50, 30, 10, 7, 3
fractional_composition_distribution = 0.5, 0.5
spm_density_by_size_class = 1700, 260, 2600, 1700, 1300
- initial_mass = 0.02, 0.02, 0.32, 0.32, 0.32
+ sedimentInitialMass = 0.02, 0.02, 0.32, 0.32, 0.32
porosity = 0.8, 0.6, 0.4, 0.2
/
&soil
darcy_velocity = 9e-06
default_porosity = 0.456
+ hamaker_constant = 6.9e-21
+ particle_density = 2500.0
erosivity_a1 = 6.608
erosivity_a2 = 0.5
erosivity_a3 = 2.7
erosivity_b = 1.204
- hamaker_constant = 6.9e-21
- particle_density = 2500.0
- soil_attachment_efficiency = 0.1
+ soil_constant_attachment_efficiency = 0.1
/
&water
+ river_attachment_efficiency = 0.01
estuary_attachment_efficiency = 0.01
- estuary_mean_depth_expa = 19.4
- estuary_mean_depth_expb = 1.46e-05
- estuary_meandering_factor = 1.17
- estuary_mouth_coords = 601071, 182173
estuary_tidal_m2 = 2.25
estuary_tidal_s2 = 0.62
+ estuary_mean_depth_expa = 19.4
+ estuary_mean_depth_expb = 1.46e-05
estuary_width_expa = 12548
estuary_width_expb = 5.25e-05
- k_diss_pristine = 0
- k_diss_transformed = 0
- k_transform_pristine = 0
+ river_meandering_factor = 1.17
+ estuary_meandering_factor = 1.17
+ estuary_mouth_coords = 601071, 182173
resuspension_alpha = 0.003
- resuspension_alpha_estuary = 0.01
resuspension_beta = 0.007
+ resuspension_alpha_estuary = 0.01
resuspension_beta_estuary = 0.001
- river_attachment_efficiency = 0.01
- river_meandering_factor = 1.17
min_water_temperature = 10.0
max_water_temperature = 10.0
min_water_temperature_day_of_year = 32
shear_rate = 10.0
/
+
+&earthworm_densities
+ arable = 30
+ coniferous = 150
+ deciduous = 400
+ grassland = 250
+ heathland = 20
+ urban_capped = 0
+ urban_gardens = 150
+ urban_parks = 250
+ vertical_distribution = 50, 35, 15
+/
diff --git a/fpm.toml b/fpm.toml
index 3664b3a..c84092e 100644
--- a/fpm.toml
+++ b/fpm.toml
@@ -16,3 +16,6 @@ name = "nanofase"
source-dir = "src"
main = "main.f90"
+[build]
+link = ["netcdf", "netcdff"]
+
diff --git a/src/BedSediment/AbstractBedSedimentModule.f90 b/src/BedSediment/AbstractBedSedimentModule.f90
index b61cf9a..af1e2d8 100644
--- a/src/BedSediment/AbstractBedSedimentModule.f90
+++ b/src/BedSediment/AbstractBedSedimentModule.f90
@@ -2,10 +2,11 @@
module AbstractBedSedimentModule
use GlobalsModule
use mo_netcdf
- use ResultModule, only: Result, Result0D
+ use ResultModule, only: Result, Result0D, Result3D
use ErrorInstanceModule
use AbstractBedSedimentLayerModule
use FineSedimentModule
+ use ContaminantModule
use Spoof
implicit none ! force declaration of all variables
!> Type definition for polymorphic `BedSedimentLayer` container,
@@ -21,14 +22,15 @@ module AbstractBedSedimentModule
type, abstract, public :: AbstractBedSediment
character(len=256) :: name !! Name for this object, of the form *BedSediment_x_y_s_r*
class(BedSedimentLayerElement), allocatable :: colBedSedimentLayers(:) !! Collection of `BedSedimentLayer` objects
+ integer :: x !! x index of the containing water body
+ integer :: y !! y index of the containing water body
integer :: nSizeClasses !! Number of fine sediment size classes
real(dp), allocatable :: delta_sed(:,:,:) !! mass transfer matrix for sediment deposition and resuspension. dim1=layers+3, dim2=layers+3, dim3=size classes
integer :: n_delta_sed !! The order of delta_sed
type(CSRMatrix), allocatable :: delta_sed_csr(:) !! CSR matrix storage for delta_sed. dim=spm size classes
integer :: nfComp !! number of fractional composition terms for sediment
- ! Nanomaterials
- real(dp), allocatable :: M_np(:,:,:,:) !! Mass pools of nanomaterials in dep, resus, layer 1, ..., layer N, buried [kg/m2]
- real(dp), allocatable :: C_np_byMass(:,:,:,:) !! Concentration of NM across sediment layers [kg/kg dw]
+ ! Contaminants
+ type(Contaminant), allocatable :: m_contaminant(:) !! Contaminant objects for deposition, resuspension, layers 1 to N, and burial
contains
procedure(createBedSediment), deferred :: create ! constructor method
procedure(destroyBedSediment), deferred :: destroy ! finaliser method
@@ -36,7 +38,9 @@ module AbstractBedSedimentModule
procedure(ResuspendSediment), deferred :: resuspend ! resuspend sediment to water column
procedure(ReportBedMassToConsole), deferred :: repMass ! report fine sediment masses to the console
procedure(FinaliseMTCMatrix), deferred :: getMatrix ! finalise mass transfer coefficient matrix
- procedure(transferNMBedSediment), deferred :: transferNM ! Transfer NM masses between layers and to/from water body, using mass transfer coef matrix
+ procedure(transferContaminantBedSediment), deferred :: transferContaminant ! Transfer Contaminant masses between layers and to/from water body, using mass transfer coef matrix
+ procedure(deposit_spm), deferred :: deposit_spm
+ procedure(resuspend_spm), deferred :: resuspend_spm
procedure :: Af_sediment => Get_Af_sediment ! fine sediment available capacity for size class
procedure :: Cf_sediment => Get_Cf_sediment ! fine sediment capacity for size class
procedure :: Aw_sediment => Get_Aw_sediment ! water available capacity for size class
@@ -48,13 +52,14 @@ module AbstractBedSedimentModule
procedure :: Mf_bed_layer_array => get_Mf_bed_layer_array ! Fine sediment mass as an array of all layers
procedure :: V_w_by_layer => get_V_w_by_layer ! total water volume in each layer
! Getters
- procedure :: get_m_np
- procedure :: get_C_np
- procedure :: get_C_np_byMass => get_C_np_byMassBedSediment
- procedure :: get_m_np_l => get_m_np_lBedSediment
- procedure :: get_C_np_l => get_C_np_lBedSediment
- procedure :: get_C_np_l_byMass => get_C_np_l_byMassBedSediment
- procedure :: get_m_np_buried => get_m_np_buriedBedSediment
+ procedure :: get_m_contaminant
+ procedure :: get_C_contaminant
+ procedure :: get_C_contaminant_byMass
+ procedure :: get_m_contaminant_l
+ procedure :: get_C_contaminant_l
+ procedure :: get_C_contaminant_l_byMass
+ procedure :: get_m_contaminant_buried
+ procedure :: finalise => finaliseBedSediment
end type
abstract interface
@@ -110,12 +115,35 @@ function destroyBedSediment(Me) result(r)
type(Result) :: r !! Returned `Result` object
end function
- subroutine transferNMBedSediment(me, j_np_dep)
+ function transferContaminantBedSediment(me, j_contaminant_dep) result(r)
+ use ResultModule, only: Result
+ import AbstractBedSediment, Contaminant
+ class(AbstractBedSediment), intent(inout) :: me
+ type(Contaminant), intent(in) :: j_contaminant_dep
+ type(Result) :: r
+ end function
+
+ function deposit_spm(Me, dj_spm_deposit, bedArea, out_deposit, out_resus) result(r)
use GlobalsModule, only: dp
- import AbstractBedSediment
- class(AbstractBedSediment) :: me
- real(dp) :: j_np_dep(:,:,:)
- end subroutine
+ import AbstractBedSediment, Contaminant, Result
+ class(AbstractBedSediment), intent(inout) :: Me
+ real(dp), intent(in) :: dj_spm_deposit(:)
+ real(dp), intent(in) :: bedArea
+ type(Contaminant), intent(out) :: out_deposit
+ type(Contaminant), intent(out) :: out_resus
+ type(Result) :: r
+ end function
+
+ function resuspend_spm(Me, dj_spm_resus, bedArea, out_resus) result(r)
+ use GlobalsModule, only: dp
+ import AbstractBedSediment, Contaminant, Result
+ class(AbstractBedSediment), intent(inout) :: Me
+ real(dp), intent(in) :: dj_spm_resus(:)
+ real(dp), intent(in) :: bedArea
+ type(Contaminant), intent(out) :: out_resus
+ type(Result) :: r
+ end function
+
!> **Function purpose**
!! Deposit specified masses of fine sediment in each size class, and their
@@ -206,8 +234,7 @@ function resuspendSediment(Me, FS_resusp) result(r)
!!
subroutine ReportBedMassToConsole(Me)
import AbstractBedSediment
- class(AbstractBedSediment) :: Me !! The `AbstractBedSediment` instance
- integer :: n !! LOCAL loop counter
+ class(AbstractBedSediment) :: Me !! The `AbstractBedSediment` instance
end subroutine
!> **Function purpose**
@@ -271,7 +298,7 @@ function Get_Af_sediment(Me, S) result(Af_sediment)
end do
end function
- !> **Function purpose**
+ !> **Function purpose**
!! Return capacity for fine sediment of a specified size class in the whole
!! sediment
!!
@@ -494,82 +521,263 @@ function get_V_w_by_layer(me) result(V_w)
end do
end function
- function Get_Mf_bed_by_size(Me) result(Mf_size)
- class(AbstractBedSediment), intent(in) :: Me !! The AbstractBedSediment instance
- integer :: L ! LOCAL loop counter
- integer :: S ! LOCAL loop counter
- real(dp) :: Mf ! LOCAL internal storage
- real(dp) :: Mf_size(Me%nSizeClasses) ! LOCAL 1D array to hold masses by size fraction
- do S = 1, Me%nSizeClasses ! for each size class
- Mf = 0 ! initialise sumnation of mass
- do L = 1, C%nSedimentLayers ! loop through each layer
- Mf = Mf + &
- Me%colBedSedimentLayers(L)%item%colFineSediment(S)%M_f()
- ! sum masses across all layers. Not very elegant
+ function Get_Mf_bed_by_size(me) result(Mf)
+ class(AbstractBedSediment) :: me
+ real(dp) :: Mf(me%nSizeClasses)
+ integer :: l, s
+
+ Mf = 0.0_dp
+
+ ! Sum fine sediment mass across layers for each size class
+ do l = 1, size(me%colBedSedimentLayers)
+ do s = 1, me%nSizeClasses
+ Mf(s) = Mf(s) + me%colBedSedimentLayers(l)%item%colFineSediment(s)%M_f_l
end do
- Mf_size(S) = Mf ! assign to array for output
end do
- end function
-
- !> Get the current mass of NM in all bed sediment layers
- function get_m_np(me) result(m_np)
- class(AbstractBedSediment) :: me !! This AbstractBedSediment instance
- real(dp) :: m_np(C%npDim(1),C%npDim(2),C%npDim(3)) !! NM mass in all bed sediment layers [kg/m2]
- ! Sum the layer mass from the bed sediment m_np array. The first two elements
- ! are ignored as they are deposited and resuspended NM
- m_np = sum(me%m_np(3:C%nSedimentLayers+2,:,:,:), dim=1)
- end function
- !> Get the NM mass in layer l [kg/m2]
- function get_m_np_lBedSediment(me, l) result(m_np_l)
- class(AbstractBedSediment) :: me !! This AbstractBedSediment instance
- integer :: l !! Layer index to retrieve NM mass for
- real(dp) :: m_np_l(C%npDim(1), C%npDim(2), C%npDim(3)) !! NM mass in layer l
- m_np_l = me%m_np(2+l,:,:,:)
+ ! Mf(s) is already kg/m2 (mass per area), so don't divide by bedArea again
end function
- !> Get the current NM PEC [kg/m3] across all bed sediment layers
- function get_C_np(me) result(C_np)
- class(AbstractBedSediment) :: me !! This AbstractBedSediment instance
- real(dp) :: C_np(C%npDim(1), C%npDim(2), C%npDim(3)) !! NM PEC across all bed sediment layers [kg/m3]
- C_np = me%get_m_np() / sum(C%sedimentLayerDepth)
+
+ function get_m_contaminant(me) result(r)
+ class(AbstractBedSediment), intent(in) :: me
+ type(Result0D) :: r
+ type(Contaminant) :: m_contaminant
+ type(Result) :: res
+ integer :: i
+ if (.not. allocated(me%m_contaminant)) then
+ call r%addError(ErrorInstance(code=105, message="Contaminant array not allocated"))
+ return
+ end if
+ res = m_contaminant%create()
+ if (res%hasCriticalError()) then
+ call r%addErrors(res%getErrors())
+ return
+ end if
+ do i = 3, C%nSedimentLayers+2
+ call m_contaminant%add(me%m_contaminant(i))
+ end do
+ allocate(r%data, source=m_contaminant)
+ call r%setErrors()
end function
- !> Get the current NM PEC by volume [kg/m3] in layer 1
- function get_C_np_lBedSediment(me, l) result(C_np_l)
- class(AbstractBedSediment) :: me !! This AbstractBedSediment instance
- integer :: l !! Layer index to retrieve NM PEC for
- real(dp) :: C_np_l(C%npDim(1), C%npDim(2), C%npDim(3)) !! NM PEC in layer l [kg/m3]
- C_np_l = me%get_m_np_l(l) / C%sedimentLayerDepth(l)
+ function get_C_contaminant(me) result(r)
+ class(AbstractBedSediment), intent(in) :: me
+ type(Result3D) :: r
+ type(Contaminant) :: m_contaminant
+ real(dp), allocatable :: C_contaminant(:,:,:)
+ type(Result0D) :: res
+ if (.not. allocated(me%m_contaminant)) then
+ call r%addError(ErrorInstance(code=105, message="Contaminant array not allocated"))
+ return
+ end if
+ res = me%get_m_contaminant()
+ if (res%hasError()) then
+ call r%addErrors(res%getErrors())
+ return
+ end if
+ select type (data => res%getData())
+ type is (Contaminant)
+ m_contaminant = data
+ class default
+ call r%addError(ErrorInstance(code=106, message="Invalid data type in Result0D"))
+ return
+ end select
+ allocate(C_contaminant(C%contaminantDim(1), C%contaminantDim(2), C%contaminantDim(3)))
+ if (sum(C%sedimentLayerDepth) > C%epsilon) then
+ C_contaminant = m_contaminant%c / sum(C%sedimentLayerDepth)
+ else
+ C_contaminant = 0.0_dp
+ end if
+ allocate(r%data, source=C_contaminant)
+ call r%setErrors()
+ deallocate(C_contaminant)
end function
!> Get the current NM PEC by mass [kg/kg] across all bed sediment layers
- function get_C_np_byMassBedSediment(me) result(C_np_byMass)
- class(AbstractBedSediment) :: me !! This AbstractBedSediment instance
- real(dp) :: C_np_byMass(C%npDim(1), C%npDim(2), C%npDim(3)) !! NM PEC across all bed layers [kg/kg]
- real(dp) :: layerMasses(C%nSedimentLayers) !! Mass (per m2) of each layer to weight average NM PEC by [kg/m2]
- integer :: i
- ! Get the masses of the sediment in each layer to use in weighting PEC average
+ function get_C_contaminant_byMass(me) result(r)
+ class(AbstractBedSediment), intent(in) :: me
+ type(Result3D) :: r
+ real(dp), allocatable :: C_contaminant_byMass(:,:,:)
+ real(dp) :: layerMasses(C%nSedimentLayers)
+ type(Contaminant) :: m_contaminant_l
+ type(Result0D) :: res
+ integer :: i
+
+ if (.not. allocated(me%m_contaminant)) then
+ call r%addError(ErrorInstance(code=105, message="Contaminant array not allocated"))
+ return
+ end if
+
+ allocate(C_contaminant_byMass(C%contaminantDim(1), C%contaminantDim(2), C%contaminantDim(3)))
+ C_contaminant_byMass = 0.0_dp
+
do i = 1, C%nSedimentLayers
layerMasses(i) = me%Mf_bed_by_layer(i)
+ res = me%get_m_contaminant_l(i)
+ if (res%hasError()) then
+ call r%addErrors(res%getErrors())
+ deallocate(C_contaminant_byMass)
+ return
+ end if
+ select type (data => res%getData())
+ type is (Contaminant)
+ m_contaminant_l = data
+ class default
+ call r%addError(ErrorInstance(code=106, message="Invalid data type in Result0D"))
+ deallocate(C_contaminant_byMass)
+ return
+ end select
+
+ ! FIX: Accumulate Total Contaminant Mass [kg], not Concentration
+ ! Previously: C_contaminant_byMass + m_contaminant_l%c / layerMasses(i) (INCORRECT)
+ C_contaminant_byMass = C_contaminant_byMass + m_contaminant_l%c
end do
- ! Calculate the weighted average using these masses
- C_np_byMass = weightedAverage(me%C_np_byMass, layerMasses)
+
+ ! FIX: Divide Total Contaminant Mass by Total Sediment Mass
+ if (sum(layerMasses) > C%epsilon) then
+ C_contaminant_byMass = C_contaminant_byMass / sum(layerMasses)
+ else
+ C_contaminant_byMass = 0.0_dp
+ end if
+
+ allocate(r%data, source=C_contaminant_byMass)
+ call r%setErrors()
+ deallocate(C_contaminant_byMass)
end function
- !> Get the current NM PEC by mass [kg/kg] in layer l
- function get_C_np_l_byMassBedSediment(me, l) result(C_np_l_byMass)
- class(AbstractBedSediment) :: me !! This AbstractBedSediment instance
- integer :: l !! Layer index to retrieve NM PEC for
- real(dp) :: C_np_l_byMass(C%npDim(1), C%npDim(2), C%npDim(3)) !! NM PEC by mass for layer l [kg/kg]
- C_np_l_byMass = me%C_np_byMass(l,:,:,:)
+ function get_m_contaminant_l(me, l) result(r)
+ class(AbstractBedSediment), intent(in) :: me
+ integer, intent(in) :: l
+ type(Result0D) :: r
+ type(Contaminant) :: m_contaminant_l
+ type(Result) :: res
+ if (.not. allocated(me%m_contaminant)) then
+ call r%addError(ErrorInstance(code=105, message="Contaminant array not allocated"))
+ return
+ end if
+ if (l < 1 .or. l > C%nSedimentLayers) then
+ call r%addError(ErrorInstance(code=106, message="Invalid layer index"))
+ return
+ end if
+ res = m_contaminant_l%create()
+ if (res%hasCriticalError()) then
+ call r%addErrors(res%getErrors())
+ return
+ end if
+ call m_contaminant_l%add(me%m_contaminant(2+l))
+ allocate(r%data, source=m_contaminant_l)
+ call r%setErrors()
end function
-
- !> Get the mass of NM buried on this timestep [kg/m2]
- function get_m_np_buriedBedSediment(me) result(m_np_buried)
- class(AbstractBedSediment) :: me !! This AbstractBedSediment instance
- real(dp) :: m_np_buried(C%npDim(1), C%npDim(2), C%npDim(3)) !! Mass of buried NM [kg/m2]
- m_np_buried = me%m_np(C%nSedimentLayers+3,:,:,:)
+
+ function get_C_contaminant_l(me, l) result(r)
+ class(AbstractBedSediment), intent(in) :: me
+ integer, intent(in) :: l
+ type(Result3D) :: r
+ real(dp), allocatable :: C_contaminant_l(:,:,:)
+ type(Contaminant) :: m_contaminant_l
+ type(Result0D) :: res
+ if (.not. allocated(me%m_contaminant)) then
+ call r%addError(ErrorInstance(code=105, message="Contaminant array not allocated"))
+ return
+ end if
+ if (l < 1 .or. l > C%nSedimentLayers) then
+ call r%addError(ErrorInstance(code=106, message="Invalid layer index"))
+ return
+ end if
+ res = me%get_m_contaminant_l(l)
+ if (res%hasError()) then
+ call r%addErrors(res%getErrors())
+ return
+ end if
+ select type (data => res%getData())
+ type is (Contaminant)
+ m_contaminant_l = data
+ class default
+ call r%addError(ErrorInstance(code=106, message="Invalid data type in Result0D"))
+ return
+ end select
+ allocate(C_contaminant_l(C%contaminantDim(1), C%contaminantDim(2), C%contaminantDim(3)))
+ if (C%sedimentLayerDepth(l) > C%epsilon) then
+ C_contaminant_l = m_contaminant_l%c / C%sedimentLayerDepth(l)
+ else
+ C_contaminant_l = 0.0_dp
+ end if
+ allocate(r%data, source=C_contaminant_l)
+ call r%setErrors()
+ deallocate(C_contaminant_l)
end function
-end module
+ function get_C_contaminant_l_byMass(me, l) result(r)
+ class(AbstractBedSediment), intent(in) :: me
+ integer, intent(in) :: l
+ type(Result3D) :: r
+ real(dp), allocatable :: C_contaminant_l_byMass(:,:,:)
+ type(Contaminant) :: m_contaminant_l
+ real(dp) :: layerMass
+ type(Result0D) :: res
+ if (.not. allocated(me%m_contaminant)) then
+ call r%addError(ErrorInstance(code=105, message="Contaminant array not allocated"))
+ return
+ end if
+ if (l < 1 .or. l > C%nSedimentLayers) then
+ call r%addError(ErrorInstance(code=106, message="Invalid layer index"))
+ return
+ end if
+ res = me%get_m_contaminant_l(l)
+ if (res%hasError()) then
+ call r%addErrors(res%getErrors())
+ return
+ end if
+ select type (data => res%getData())
+ type is (Contaminant)
+ m_contaminant_l = data
+ class default
+ call r%addError(ErrorInstance(code=106, message="Invalid data type in Result0D"))
+ return
+ end select
+ allocate(C_contaminant_l_byMass(C%contaminantDim(1), C%contaminantDim(2), C%contaminantDim(3)))
+ layerMass = me%Mf_bed_by_layer(l)
+ if (layerMass > C%epsilon) then
+ C_contaminant_l_byMass = m_contaminant_l%c / layerMass
+ else
+ C_contaminant_l_byMass = 0.0_dp
+ end if
+ allocate(r%data, source=C_contaminant_l_byMass)
+ call r%setErrors()
+ deallocate(C_contaminant_l_byMass)
+ end function
+
+ function get_m_contaminant_buried(me) result(r)
+ class(AbstractBedSediment), intent(in) :: me
+ type(Result0D) :: r
+ type(Contaminant) :: m_contaminant_buried
+ type(Result) :: res
+ if (.not. allocated(me%m_contaminant)) then
+ call r%addError(ErrorInstance(code=105, message="Contaminant array not allocated"))
+ return
+ end if
+ res = m_contaminant_buried%create()
+ if (res%hasCriticalError()) then
+ call r%addErrors(res%getErrors())
+ return
+ end if
+ call m_contaminant_buried%add(me%m_contaminant(C%nSedimentLayers+3))
+ allocate(r%data, source=m_contaminant_buried)
+ call r%setErrors()
+ end function
+
+ subroutine finaliseBedSediment(me)
+ class(AbstractBedSediment), intent(inout) :: me
+ integer :: i
+ if (allocated(me%m_contaminant)) then
+ do i = 1, size(me%m_contaminant)
+ call me%m_contaminant(i)%finalise()
+ end do
+ deallocate(me%m_contaminant)
+ end if
+ if (allocated(me%colBedSedimentLayers)) deallocate(me%colBedSedimentLayers)
+ if (allocated(me%delta_sed)) deallocate(me%delta_sed)
+ if (allocated(me%delta_sed_csr)) deallocate(me%delta_sed_csr)
+ end subroutine
+end module
\ No newline at end of file
diff --git a/src/BedSediment/BedSedimentModule.f90 b/src/BedSediment/BedSedimentModule.f90
index 08d38ba..21c8199 100644
--- a/src/BedSediment/BedSedimentModule.f90
+++ b/src/BedSediment/BedSedimentModule.f90
@@ -6,24 +6,28 @@ module BedSedimentModule
use AbstractBedSedimentModule
use BedSedimentLayerModule
use FineSedimentModule
+ use ContaminantModule
use Spoof
+ use LoggerModule, only: LOGR
implicit none
private
!> Class representing a `BedSediment` object, which is an extension of the
!! abstract superclass `BedSediment`.
type, public, extends(AbstractBedSediment) :: BedSediment
- contains
- procedure, public :: create => createBedSediment1 ! constructor method
- procedure, public :: destroy => destroyBedSediment1 ! finaliser method
- procedure, public :: deposit => DepositSediment1 ! deposit sediment from water column
- procedure, public :: resuspend => ResuspendSediment1 ! resuspend sediment to water column
- procedure, public :: repmass => ReportBedMassToConsole1 ! report mass of fine sediment in each layer to console [kg/m2]
- procedure, public :: getmatrix => getMTCMatrix1 ! derives mass transfer coefficient matrix for sediment
- procedure, public :: transferNM => transferNMBedSediment1 ! Transfer NM masses between layers and to/from water body, using mass transfer coef matrix
+ contains
+ procedure, public :: create => createBedSediment1
+ procedure, public :: destroy => destroyBedSediment1
+ procedure, public :: deposit => DepositSediment1
+ procedure, public :: resuspend => ResuspendSediment1
+ procedure, public :: repmass => ReportBedMassToConsole1
+ procedure, public :: getmatrix => getMTCMatrix1
+ procedure, public :: transferContaminant => transferContaminantBedSediment1
+ procedure, public :: deposit_spm => deposit_spm_BedSediment
+ procedure, public :: resuspend_spm => resuspend_spm_BedSediment
end type
- contains
+contains
!> **Function purpose**
!! Derive a mass transfer coefficient matrix
@@ -40,60 +44,69 @@ module BedSedimentModule
!! containing the mass transfers coefficients for deposition,
!! resuspension, layers and burial
!! objects
+
+ !! Derive a mass transfer coefficient matrix
subroutine getMTCMatrix1(me, djdep, djres)
- class(BedSediment) :: me !! Self-reference
- real(dp) :: djdep(:) !! deposition fluxes by size class [kg/m2]
- real(dp) :: djres(:) !! resuspension fluxes by size class [kg/m2]
- real(dp) :: ml ! LOCAL holds initial sediment layer masses [kg/m2]
- integer :: L, LL, S ! Iterators
+ class(BedSediment) :: me !! Self-reference
+ real(dp) :: djdep(:) !! deposition fluxes by size class [kg/m2]
+ real(dp) :: djres(:) !! resuspension fluxes by size class [kg/m2]
+ real(dp) :: ml ! LOCAL holds initial sediment layer masses [kg/m2]
+ integer :: L, LL, S ! Iterators
do S = 1, me%nSizeClasses
+ ! 1. Normalize Deposition Columns (L=Layer, 1=DepositionSource)
do L = 3, C%nSedimentLayers + 3
if (.not. isZero(djdep(S)) .and. .not. isZero(me%delta_sed(L, 1, S))) then
- me%delta_sed(L, 1, S) = &
- me%delta_sed(L, 1, S) / djdep(S) ! d -> l and d-> b
+ me%delta_sed(L, 1, S) = me%delta_sed(L, 1, S) / djdep(S)
else
- me%delta_sed(L, 1, S) = 0 ! failsafe if no deposition
+ me%delta_sed(L, 1, S) = 0.0_dp
end if
end do
+
+ ! 2. Normalize Resuspension Row (2=ResuspensionTarget, LL=LayerSource)
do LL = 3, C%nSedimentLayers + 2
- if (.not. isZero(djres(S)) .and. .not. isZero(me%delta_sed(2, LL, S))) then
- ml = me%colBedSedimentLayers(LL - 2)%item%colFineSediment(S)%M_f_backup() ! Phew!
- me%delta_sed(2, LL, S) = &
- ! me%delta_sed(2, LL, S) / djres(S) ! l -> r
- me%delta_sed(2, LL, S) / ml ! l -> r
+ ! Note: normalization base is the Layer Mass (ml), not the flux.
+ ! The flux calculation happened in resuspendSediment1.
+ ml = me%colBedSedimentLayers(LL - 2)%item%colFineSediment(S)%M_f_backup()
+
+ if (.not. isZero(ml) .and. .not. isZero(me%delta_sed(2, LL, S))) then
+ me%delta_sed(2, LL, S) = me%delta_sed(2, LL, S) / ml
else
- me%delta_sed(2, LL, S) = 0 ! failsafe if no resuspension
+ me%delta_sed(2, LL, S) = 0.0_dp
end if
end do
+
+ ! 3. Normalize Layer-to-Layer transfers (Burial/Mixing)
do L = 3, C%nSedimentLayers + 3
do LL = 3, C%nSedimentLayers + 2
- ml = me%colBedSedimentLayers(LL - 2)%item%colFineSediment(S)%M_f_backup() ! Phew!
- ! print *, "per layer, S, from, to", S, LL - 2, L - 2, ml
+ ml = me%colBedSedimentLayers(LL - 2)%item%colFineSediment(S)%M_f_backup()
+
if (.not. isZero(ml)) then
if (L == LL) then
+ ! Same-layer retention
if (.not. isZero(me%delta_sed(L, LL, S))) then
-
- me%delta_sed(L, LL, S) = &
- (ml + me%delta_sed(L, LL, S)) / ml ! l -> l where l=l ('same-layer' transfers) and there is a mass transfer out of the layer
+ ! Add remaining mass back to get retention coefficient
+ me%delta_sed(L, LL, S) = (ml + me%delta_sed(L, LL, S)) / ml
else
- me%delta_sed(L, LL, S) = 1.0_dp ! If no transfer, must be 1 TODO check this
+ me%delta_sed(L, LL, S) = 1.0_dp
end if
else
- me%delta_sed(L, LL, S) = &
- me%delta_sed(L, LL, S) / ml ! l -> l where l/=l (interlayer transfers), also l -> b
+ ! Inter-layer transfer
+ me%delta_sed(L, LL, S) = me%delta_sed(L, LL, S) / ml
end if
else
- me%delta_sed(L, LL, S) = 0.0_dp ! failsafe if no sediment initially in layer
+ me%delta_sed(L, LL, S) = 0.0_dp
end if
end do
end do
end do
- ! Convert delta_sed to CSR storage, to speed up NM transfer during simulation
+
+ ! Convert to CSR for fast multiplication in transferContaminant
do s = 1, C%nSizeClassesSpm
me%delta_sed_csr(s) = CSRMatrix(me%delta_sed(:,:,s))
end do
end subroutine
+
!> **Function purpose**
!! Initialise a BedSediment object.
!!
@@ -101,55 +114,94 @@ subroutine getMTCMatrix1(me, djdep, djres)
!! Initialised `BedSediment` object, including all layers and included `FineSediment`
!! objects
function createBedSediment1(me, x, y, w) result(r)
- class(BedSediment) :: me !! Self-reference
- integer :: x !! x index of the containing water body
- integer :: y !! y index of the containing water body
- integer :: w !! w index of the containing water body
- type(Result) :: r !! Returned `Result` object
- type(BedSedimentLayer), allocatable :: bsl1 ! LOCAL object of type BedSedimentLayer, for implementation of polymorphism
- integer :: L ! LOCAL loop counter
- integer :: allst ! LOCAL array allocation status
- character(len=256) :: tr ! LOCAL error trace
- character(len=16), parameter :: ms = "Allocation error" ! LOCAL allocation error message
+ class(BedSediment) :: me
+ integer :: x, y, w
+ type(Result) :: r
+ type(BedSedimentLayer), allocatable :: bsl1
+ integer :: L, allst
+ character(len=256) :: tr
+ character(len=16), parameter :: ms = "Allocation error"
+ type(ErrorInstance) :: err(1)
+ integer :: nx, ny
+ logical :: inbounds
+ integer :: nComp, ii, jj
+ real(dp), allocatable :: I(:, :)
me%name = trim(ref('BedSediment', x, y, w))
- me%nSizeClasses = C%nSizeClassesSpm ! set number of size classes from global value
- me%nfComp = C%nFracCompsSpm ! set number of compositional fractions from global value
- tr = trim(me%name) // "%createBedSediment1" ! procedure name as trace
+ ! >>> critical: make sure grid indices are set so initial conditions use [x,y]
+ me%x = x
+ me%y = y
+ ! <<<
- ! Initialise NM mass pools matrix
- allocate(me%M_np(C%nSedimentLayers + 3, C%npDim(1), C%npDim(2), C%npDim(3)))
- allocate(me%C_np_byMass(C%nSedimentLayers, C%npDim(1), C%npDim(2), C%npDim(3)))
- allocate(me%delta_sed_csr(C%nSizeClassesSpm))
- me%M_np = 0.0_dp
- me%C_np_byMass = 0.0_dp
-
- allocate(me%colBedSedimentLayers(C%nSedimentLayers)) ! Create BedSedimentLayer collection
- me%n_delta_sed = C%nSedimentLayers + 3 ! The order of the delta_sed matrix
- allocate(me%delta_sed(C%nSedimentLayers + 3, &
- C%nSedimentLayers + 3, &
- me%nSizeClasses)) ! allocate space for sediment mass transfer matrix
- me%delta_sed = 0.0_dp ! initialise to zero
-
- do L = 1, C%nSedimentLayers ! loop through each layer
- allocate(bsl1) ! allocate the temporary local BedSedimentLayer variable
- call r%addErrors(.errors. bsl1%create(L)) ! initialise the layer object
- allocate(me%colBedSedimentLayers(L)%item, &
- source=bsl1, stat = allst) ! allocate empty object of this type
- deallocate(bsl1) ! deallocate local variable ready for the next iteration of the loop
- if (allst /= 0) then
- call r%addError(ErrorInstance( &
- code = 1, &
- message = ms, &
- trace = [tr])) ! add to Result
- return ! critical error, so return
+ me%nSizeClasses = C%nSizeClassesSpm
+ me%nfComp = C%nFracCompsSpm
+ tr = trim(me%name) // "%createBedSediment1"
+
+ ! Contaminant pools: [1]=interface (dep), [2]=ready to resuspend, [3..N+2]=layers, [N+3]=buried
+ allocate(me%m_contaminant(C%nSedimentLayers + 3), stat=allst)
+ if (allst /= 0) then
+ err(1) = ErrorInstance(code=1, message=ms, trace=[tr])
+ call r%addError(err(1))
+ return
+ end if
+
+ do L = 1, C%nSedimentLayers + 3
+ r = me%m_contaminant(L)%create_from_data( &
+ compartment='sediment', &
+ contaminantDensity=DATASET%contaminantDensity, &
+ soilAttachmentEfficiency=DATASET%soilConstantAttachmentEfficiency, &
+ riverAttachmentEfficiency=DATASET%riverAttachmentEfficiency, &
+ estuaryAttachmentEfficiency=DATASET%estuaryAttachmentEfficiency, &
+ k_diss_pristine=DATASET%contaminant_k_diss_pristine, &
+ k_diss_transformed=DATASET%contaminant_k_diss_transformed, &
+ k_transform_pristine=DATASET%contaminant_k_transform_pristine, &
+ waterTemperature=real(DATASET%waterTemperature(1), dp) )
+ if (r%hasCriticalError()) return
+
+ ! Seed initial concentrations by layer (if provided)
+ if (L > 2 .and. allocated(DATASET%initialContaminantConcsSediment)) then
+ nx = size(DATASET%initialContaminantConcsSediment,1)
+ ny = size(DATASET%initialContaminantConcsSediment,2)
+ inbounds = (me%x>=1 .and. me%y>=1 .and. me%x<=nx .and. me%y<=ny)
+ if (inbounds) then
+ me%m_contaminant(L)%c = DATASET%initialContaminantConcsSediment(me%x, me%y, :, :, :)
+ if (allocated(DATASET%initialDissolvedConcsSediment)) &
+ me%m_contaminant(L)%m_dissolved = DATASET%initialDissolvedConcsSediment(me%x, me%y)
+ else
+ me%m_contaminant(L)%c = 0.0_dp
+ me%m_contaminant(L)%m_dissolved = 0.0_dp
+ end if
end if
- if (r%hasCriticalError()) then ! if a critical error has been thrown
- call r%addToTrace(tr) ! add trace to Result
- return ! exit, as a critical error has occurred
+ end do
+
+ ! Build the sediment layers
+ allocate(me%colBedSedimentLayers(C%nSedimentLayers), stat=allst); if (allst /= 0) then
+ err(1) = ErrorInstance(code=1, message=ms, trace=[tr]); call r%addError(err(1)); return
+ end if
+ do L = 1, C%nSedimentLayers
+ allocate(bsl1)
+ call r%addErrors(.errors. bsl1%create(L))
+ allocate(me%colBedSedimentLayers(L)%item, source=bsl1, stat=allst)
+ deallocate(bsl1)
+ if (allst /= 0) then
+ err(1) = ErrorInstance(code=1, message=ms, trace=[tr]); call r%addError(err(1)); return
end if
end do
+
+ ! Mass-transfer matrix (dense + CSR). Start as identity so early-step transfers are no-ops.
+ me%n_delta_sed = C%nSedimentLayers + 3
+ allocate(me%delta_sed(me%n_delta_sed, me%n_delta_sed, me%nSizeClasses)); me%delta_sed = 0.0_dp
+ allocate(me%delta_sed_csr(C%nSizeClassesSpm))
+ allocate(I(me%n_delta_sed, me%n_delta_sed)); I = 0.0_dp
+ do ii=1, me%n_delta_sed; I(ii,ii) = 1.0_dp; end do
+ do jj=1, C%nSizeClassesSpm
+ me%delta_sed_csr(jj) = CSRMatrix(I)
+ end do
+ deallocate(I)
+
+ call r%addToTrace(me%name // "%create: ok")
end function
+
!> **Function purpose**
!! Deallocate all allocatable variables and call destroy methods for all
!! enclosed objects
@@ -161,78 +213,103 @@ function destroyBedSediment1(me) result(r)
type(Result) :: r !! returned Result object
type(ErrorInstance) :: er ! LOCAL ErrorInstance object for error handling.
character(len=256) :: tr ! LOCAL name of this procedure, for trace
- integer :: L ! LOCAL Loop iterator
+ integer :: L, i ! LOCAL Loop iterator
integer :: allst ! LOCAL array allocation status
character(len=18), parameter :: ms = "Deallocation error" ! LOCAL CONSTANT error message
+ tr = trim(me%name) // "%destroyBedSedimentLayer%colBedSedimentLayers"
do L = 1, C%nSedimentLayers
- call r%addErrors(.errors. &
- me%colBedSedimentLayers(L)%item%destroy()) ! destroy enclosed BedSedimentLayers
+ call r%addErrors(.errors. me%colBedSedimentLayers(L)%item%destroy())
end do
- tr = trim(me%name) // &
- "%destroyBedSedimentLayer%colBedSedimentLayers" ! trace message
- deallocate(me%colBedSedimentLayers, stat = allst) ! deallocate all allocatable variables
- if (allst /= 0) then
- er = ErrorInstance(code = 1, &
- message = ms, &
- trace = [tr] &
- ) ! create warning if error thrown
- call r%addError(er) ! add to Result
+ if (allocated(me%m_contaminant)) then
+ do i = 1, size(me%m_contaminant)
+ call me%m_contaminant(i)%finalise()
+ end do
+ deallocate(me%m_contaminant, stat=allst)
+ if (allst /= 0) then
+ er = ErrorInstance(code=1, message=ms, trace=[tr])
+ call r%addError(er)
+ call LOGR%toFile(errors=[er])
+ end if
+ end if
+ if (allocated(me%colBedSedimentLayers)) then
+ deallocate(me%colBedSedimentLayers, stat=allst)
+ if (allst /= 0) then
+ er = ErrorInstance(code=1, message=ms, trace=[tr])
+ call r%addError(er)
+ call LOGR%toFile(errors=[er])
+ end if
+ end if
+ if (allocated(me%delta_sed)) then
+ deallocate(me%delta_sed, stat=allst)
+ if (allst /= 0) then
+ er = ErrorInstance(code=1, message=ms, trace=[tr])
+ call r%addError(er)
+ call LOGR%toFile(errors=[er])
+ end if
+ end if
+ if (allocated(me%delta_sed_csr)) then
+ deallocate(me%delta_sed_csr, stat=allst)
+ if (allst /= 0) then
+ er = ErrorInstance(code=1, message=ms, trace=[tr])
+ call r%addError(er)
+ call LOGR%toFile(errors=[er])
+ end if
end if
end function
- !> Transfer NM between sediment layers, based on the mass transfer coefficient
+ !> Transfer Contaminant between sediment layers, based on the mass transfer coefficient
!! matrix delta_sed, which should already have been set prior to calling this procedure
- subroutine transferNMBedSediment1(me, j_np_dep)
- class(BedSediment) :: me !! This BedSediment instance
- real(dp) :: j_np_dep(:,:,:) !! Mass of NM deposited to bed sediment on this time step [kg/m2]
- integer :: i, j, k, l ! Iterator
- real(dp) :: M_f_byLayer(C%nSedimentLayers) ! Mass of fine sediment by layer
-
- ! Assumes me%delta_sed has already been set
- ! Add new deposited NM to matrix, reset resus and buried to zero
- me%M_np(1,:,:,:) = j_np_dep ! Deposited [kg/m2]
- me%M_np(2,:,:,:) = 0.0_dp ! Resuspended [kg/m2]
- me%M_np(C%nSedimentLayers+3,:,:,:) = 0.0_dp ! Buried [kg/m2]
-
- ! Perform the transfer calculation to move NM between the layers
- do k = 1, C%nSizeClassesSpm
- do j = 1, C%npDim(2)
- do i = 1, C%npDim(1)
- ! Below are a number of different matrix multiplication methods. Generally, the fastest
- ! is when delta_sed is stored in CSR format, for setups with ~5 sediment layers. You may
- ! wish to play around with other methods if your setup typically uses fewer or more
- ! sediment layers. This function is generally the most computationally expensive in the model.
- ! If changing storage format, make sure delta_sed_dia or delta_sed_csr are initialised
-
- ! CSR storage implementation
- me%M_np(:,i,j,k+2) = me%delta_sed_csr(k)%multiply(me%M_np(:,i,j,k+2))
- ! Set NM concentration for all layers
- me%C_np_byMass(:,i,j,k+2) = divideCheckZero(me%M_np(3:C%nSedimentLayers+2,i,j,k+2), me%Mf_bed_layer_array())
-
- ! Matmul implementation. Might be faster for <5 sediment layers
- ! me%M_np(:,i,j,k+2) = matmul(me%delta_sed(:,:,k), me%M_np(:,i,j,k+2))
-
- ! Diagonal storage implementation. Might be faster for >5 sediment layers,
- ! especially if transfers typically only between adjacent layers
- ! me%M_np(:,i,j,k+2) = me%delta_sed_dia(k)%multiply(me%M_np(:,i,j,k+2))
-
- ! OpenBLAS implementation. Might be faster for >5 sediment layers and if
- ! transfers across multiple layers are possible. Make sure you have OpenBLAS/BLAS
- ! installed and linked when compiling
- ! call dgemv('n', me%n_delta_sed, me%n_delta_sed, 1.0_dp, me%delta_sed(:,:,k), &
- ! me%n_delta_sed, me%M_np(:,i,j,k+2), 1, 0.0_dp, me%M_np(:,i,j,k+2), 1)
+ function transferContaminantBedSediment1(me, j_contaminant_dep) result(r)
+ class(BedSediment), intent(inout) :: me
+ type(Contaminant), intent(in) :: j_contaminant_dep
+ type(Result) :: r
+ type(ErrorInstance) :: err(1)
+ real(dp), allocatable :: state_vector(:)
+ integer :: nCompartments, j, n, f, st_spm, i
+ character(len=256) :: tr
+
+ tr = trim(me%name) // "%transferContaminantBedSediment1"
+ if (.not. allocated(me%m_contaminant)) then
+ err(1) = ErrorInstance(code=105, message="Contaminant array not allocated", trace=[tr])
+ call r%addError(err(1))
+ return
+ end if
+
+ nCompartments = C%nSedimentLayers + 3
+ allocate(state_vector(nCompartments))
+
+ ! Loop over SPM size classes and map to the contaminant "state" index
+ do j = 1, C%nSizeClassesSpm
+ st_spm = SPM_CONTAMINANT_START + j - 1
+
+ ! >>> FIX: use allocated state size, not scalar count
+ do n = 1, C%contaminantDim(1)
+ do f = 1, C%nContaminantForms
+ ! Build [ dep ; layers+specials ] vector
+ state_vector = 0.0_dp
+ state_vector(1) = j_contaminant_dep%c(n, f, st_spm)
+ do i = 2, nCompartments
+ state_vector(i) = me%m_contaminant(i)%c(n, f, st_spm)
+ end do
+
+ ! Multiply by the CSR for THIS SPM size class
+ state_vector = me%delta_sed_csr(j)%multiply(state_vector)
+
+ ! Write back
+ me%m_contaminant(1)%c(n, f, st_spm) = state_vector(1)
+ do i = 2, nCompartments
+ me%m_contaminant(i)%c(n, f, st_spm) = state_vector(i)
+ end do
end do
end do
end do
- ! Reset delta_sed. It seems delta_sed is used interchangeably as absolute masses
- ! and mass coefficients, so resetting is playing it safe to avoid numerical errors
- ! in case not all elements are reset on each timestep. TODO need to figure this
- ! out properly
- me%delta_sed = 0.0_dp
-
- end subroutine
+ ! SAFETY: reset delta_sed scratch to zero as in old NM implementation
+ if (allocated(me%delta_sed)) then
+ me%delta_sed = 0.0_dp
+ end if
+ end function
!> **Function purpose**
!! Resuspend specified masses of fine sediment in each size class, and their
@@ -246,85 +323,65 @@ subroutine transferNMBedSediment1(me, j_np_dep)
!! sediment bed. `r` returns resuspended fine sediments as type `ResultFineSediment2D`
function resuspendSediment1(me, FS_resusp) result(r)
class(BedSediment) :: me !! Self-reference
- real(dp) :: FS_resusp(:) !! Sediment masses to be resuspended [kg m-2]. Index = size class[1,...,S]
+ real(dp) :: FS_resusp(:) !! Sediment masses to be resuspended [kg m-2]. Index = size class[1,...,S]
type(ResultFineSediment2D) :: r !! Returned `Result` object. Type = `FineSediment`
- type(FineSediment), allocatable :: FS(:,:) ! LOCAL resuspended fine sediment. Index 1 = size class, Index 2 = layer
- type(FineSediment) :: F ! LOCAL FineSediment object representing material to be resuspended
- type(FineSediment) :: G ! LOCAL FineSediment object representing material not (yet) resuspended
+ type(FineSediment), allocatable :: FS(:,:) ! LOCAL resuspended fine sediment. Index 1 = size class, Index 2 = layer
+ type(FineSediment) :: F ! LOCAL FineSediment object representing material to be resuspended
+ type(FineSediment) :: G ! LOCAL FineSediment object representing material not (yet) resuspended
real(dp), allocatable :: delta_l_r(:,:) ! LOCAL deltas for layers to resuspension [-]. L x S array.
integer :: S ! LOCAL loop counter for size classes
integer :: L ! LOCAL counter for layers
- integer :: allst ! LOCAL anrray allocation status
+ integer :: allst ! LOCAL array allocation status
character(len=256) :: tr ! LOCAL name of this procedure, for trace
tr = trim(me%name) // "%resuspendSediment1" ! error trace for this procedure
! Create fine sediment objects F and G
call F%create("FineSediment", me%nfComp)
call G%create("FineSediment", me%nfComp)
- allocate(FS(me%nSizeClasses, C%nSedimentLayers)) ! set up FineSediment array FS
- allocate(delta_l_r(C%nSedimentLayers, me%nSizeClasses)) ! allocate delta_d-l
- me%delta_sed = 0.0_dp ! Reset the matrix of mass transfer coefficients
- delta_l_r = 0.0_dp ! initialise the delta_l_r values
+ allocate(FS(me%nSizeClasses, C%nSedimentLayers)) ! set up FineSediment array FS
+ allocate(delta_l_r(C%nSedimentLayers, me%nSizeClasses)) ! allocate delta_d-l
+ me%delta_sed = 0.0_dp ! Reset the matrix of mass transfer coefficients
+ delta_l_r = 0.0_dp ! initialise the delta_l_r values
do S = 1, me%nSizeClasses
do L = 1, C%nSedimentLayers
! back up all the fine sediment masses, an essential part of the mass trasfer matrix computation
call me%colBedSedimentLayers(L)%item%colFineSediment(S)%backup_M_f()
end do
end do
- ! main loop
- ! for each size class (1 to S), remove the required amount of fine sediment
- ! from the bed, by looping through each layer from top to bottom
- do S = 1, me%nSizeClasses ! loop through all size classes
- call F%set(Mf_in = FS_resusp(S)) ! set up F with the mass of fine sediment in this size class to be resuspended [kg]
+ ! Main loop: for each size class (1..S), remove required fine sediment
+ ! from the bed, by looping through each layer from top to bottom
+ do S = 1, me%nSizeClasses
+ call F%set(Mf_in = FS_resusp(S)) ! mass to resuspend [kg]
L = 1 ! start with top layer
- do while (FS_resusp(S) > 0.000001 .and. L <= C%nSedimentLayers) ! loop through layers until all sediment resuspended or all layers considered
- associate(O => me%colBedSedimentLayers(L)%item) ! association for brevity
- call F%set(f_comp_in = O%colFineSediment(S)%f_comp) ! set the fractional composition of F to that of the sediment being resuspended
- call r%addErrors(.errors. &
- O%removeSediment(S, F, G)) ! remove the resuspended sediment from the layer in question
- ! on entry, F contains the fine sediment to be resuspended
- ! on return, F contains the fine sediment that could not be removed because it exceeded
- ! the amount present in the layer
- ! on return, G contains the fine sediment that was removed
- delta_l_r(L, S) = G%M_f() ! assign the delta for layer to resuspension
- if (r%hasCriticalError()) then ! if a critical error has been thrown
- call r%addToTrace(tr) ! add the trace to the Result object
- return ! and exit
+ do while (FS_resusp(S) > 0.000001 .and. L <= C%nSedimentLayers)
+ associate(O => me%colBedSedimentLayers(L)%item)
+ call F%set(f_comp_in = O%colFineSediment(S)%f_comp) ! composition follows the donor
+ call r%addErrors(.errors. O%removeSediment(S, F, G))
+ delta_l_r(L, S) = G%M_f() ! layer->resusp mass
+ if (r%hasCriticalError()) then
+ call r%addToTrace(tr)
+ return
end if
end associate
- FS_resusp(S) = FS_resusp(S) - delta_l_r(L, S) ! modify the amount of sediment in the size class still to be resuspended
- if (isZero(FS_resusp(s), 1.0e-10_dp)) then ! Just to be on the safe side
- FS_resusp(S) = 0.0_dp
- end if
+ FS_resusp(S) = FS_resusp(S) - delta_l_r(L, S)
+ if (isZero(FS_resusp(s), 1.0e-10_dp)) FS_resusp(S) = 0.0_dp
call FS(s,l)%create("FS", me%nfComp)
- ! create and set up the element of the array FS for this size class and layer
- call FS(S, L)%set(Mf_in = G%M_f(), &
- Vw_in = G%V_w(), &
- f_comp_in = G%f_comp &
- )
- L = L + 1 ! increment the layer count
- end do ! and loop to the next layer
+ call FS(S, L)%set(Mf_in = G%M_f(), Vw_in = G%V_w(), f_comp_in = G%f_comp)
+ L = L + 1
+ end do
if (FS_resusp(S) > 0) then
- call r%addError(ErrorInstance(1, &
- "All sediment of size class " &
- // trim(str(S)) // " resuspended", &
- .false., &
- [tr] &
- ) &
- ) ! create a warning (noncritical error) if bed has been stripped of sediment of size class S
+ call r%addError(ErrorInstance(1, "All sediment of size class " // trim(str(S)) // " resuspended", .false., [tr]))
end if
- end do ! and loop to the next size class
- call r%setData(FS) ! copy output to Result
- do S = 1, me%nSizeClasses ! incorporate delta_l_r into the mass transfer coefficients matrix delta_sed
- do L = 1, C%nSedimentLayers
- me%delta_sed(2, L + 2, S) = &
- me%delta_sed(2, L + 2, S) + delta_l_r(L, S) ! element (L, S) of delta_l_r is added to element (2, L+2, S) of delta_sed
- me%delta_sed(L + 2, L + 2, S) = &
- me%delta_sed(L + 2, L + 2, S) - delta_l_r(L, S) ! element (L, S) of delta_l_r is subtracted from element(L+2, L+2, S) of delta_sed
- ! this accounts for the loss of sediment from layers during resuspension
+ end do
+ call r%setData(FS)
+ do S = 1, me%nSizeClasses
+ do L = 1, C%nSedimentLayers
+ me%delta_sed(2, L + 2, S) = me%delta_sed(2, L + 2, S) + delta_l_r(L, S) ! l -> r
+ me%delta_sed(L + 2, L + 2, S) = me%delta_sed(L + 2, L + 2, S) - delta_l_r(L, S) ! l -> l loss
end do
end do
end function
+
!> Compute deposition to bed sediment, including burial and downward shifting of fine sediment and water
!> **Function purpose**
!! Deposit specified masses of fine sediment in each size class, and their
@@ -332,184 +389,122 @@ function resuspendSediment1(me, FS_resusp) result(r)
!! to make space for deposition, if required
!!
!! **Function inputs**
- !! Function takes as inputs:
!! `FS_dep (FineSediment)`: 1D array of FineSediment objects containing the
!! depositing fine sediment per size class
!!
!! **Function outputs/outcomes**
!! `r (real(dp))`: returns water requirement from the water column [m3 m-2] real(dp)
function depositSediment1(me, FS_dep) result(r)
- class(BedSediment) :: me !! Self-reference
- type(FineSediment) :: FS_dep(:) !! Depositing sediment by size class
- type(Result0D) :: r !! `Result` object. Returns water requirement from the water column [m3 m-2], real(dp)
- type(FineSediment) :: T ! LOCAL object to receive sediment being buried
- type(FineSediment) :: U ! LOCAL object to receive sediment that has been buried
- integer :: s ! LOCAL loop counter for size classes
- integer :: l ! LOCAL counter for layers
- integer :: ll ! LOCAL second counter for layers
- integer :: A ! LOCAL second counter for layers
- real(dp) :: A_f_sed = 0.0_dp ! LOCAL available fine sediment capacity for size class [m3 m-2]
- real(dp) :: V_f_burial = 0.0_dp ! LOCAL excess of deposting fine sediment over capacity [m3 m-2]
- real(dp) :: tempV = 0.0_dp ! LOCAL volume variable
- real(dp) :: V_w_tot = 0.0_dp ! LOCAL water requirement from the water column [m3 m-2]
- real(dp) :: V_w_b = 0.0_dp ! LOCAL available water capacity in the receiving layer [m3 m-2]
- real(dp) :: dep_excess ! LOCAL excess of deposition over available capacity [m3 m-2]
- real(dp), allocatable :: delta_d_b(:) ! LOCAL delta for deposition to burial [-]. S array.
- real(dp), allocatable :: delta_d_l(:,:) ! LOCAL deltas for deposition to layers [-]. L x S array.
- real(dp), allocatable :: delta_l_b(:,:) ! LOCAL deltas for layers to burial [-]. L x S array.
- real(dp), allocatable :: delta_l_l(:,:,:) ! LOCAL deltas for layers to layers [-]. L x L X S array.
- real(dp) :: M_f_la ! LOCAL to store the mass of fine sediment in a layer, for computation of delta_l-b and delta_d-l
- logical, allocatable :: isEmpty(:) ! LOCAL .true. bed has been emptied completely to make space for depositing sediment
- character(len=256) :: tr ! LOCAL name of this procedure, for trace
+ class(BedSediment) :: me
+ type(FineSediment) :: FS_dep(:)
+ type(Result0D) :: r
+ type(FineSediment) :: T, U
+ integer :: s, l, ll, A
+ real(dp) :: A_f_sed, V_f_burial, tempV, V_w_tot, V_w_b, dep_excess
+ real(dp), allocatable :: delta_d_b(:), delta_d_l(:,:), delta_l_b(:,:), delta_l_l(:,:,:)
+ real(dp) :: M_f_la
+ logical, allocatable :: isEmpty(:)
+ character(len=256) :: tr
! -------------------------------------------------------------------------------
- !
! Notes
! -------------------------------------------------------------------------------
- ! 1. Currently does not account fully for sediment burial, in the sense that
- ! it does not tally mass, volume and composition of buried material. This
- ! will need to be added before burial losses of a chemical vector can be
- ! computed.
- ! TODO: add code to mix FineSediments together and return a single
- ! TODO: FineSediment object. This code can be used to tally up the sediment that
- ! TODO: is lost through burial, and can also be called from AddSediment.
- ! 2. The FineSediment objects in FS_dep should not contain any water, but if they
- ! do it is not a problem as it will be overwritten.
+ ! 1. Currently does not tally mass/volume/composition of buried material as a single object.
+ ! 2. FS_dep should not contain water (but if it does, it's overwritten).
! -------------------------------------------------------------------------------
- ! Add this procedure to the trace, allocate space to arrays and initialise them
tr = trim(me%name) // "%DepositSediment1"
allocate(IsEmpty(me%nSizeClasses))
allocate(delta_d_l(C%nSedimentLayers, me%nSizeClasses))
allocate(delta_d_b(me%nSizeClasses))
allocate(delta_l_b(C%nSedimentLayers, me%nSizeClasses))
allocate(delta_l_l(C%nSedimentLayers, C%nSedimentLayers, me%nSizeClasses))
- delta_d_b = 0.0_dp
- delta_d_l = 0.0_dp
- delta_l_b = 0.0_dp
- delta_l_l = 0.0_dp
- isEmpty = .true.
-
- do s = 1, me%nSizeClasses ! loop through all size classes
- dep_excess = FS_dep(S)%V_f() - me%Cf_sediment(S) ! compute the difference between the volume of depositing material and the bed capacity [m3 m-2]
- ! if this equals or exceeds zero, then there is complete replacement of the material in the bed and if
- ! it exceeds zero, there is direct burial of a portion of the depositing sediment
- ! in this case, delta[l,n-b] = 1 for all layers, and delta[d-b] > 0.
- if (dep_excess > 0) then ! check whether the depositing sediment in each size class exceeds the total
- associate(O => me%colBedSedimentLayers) ! association for brevity
- do l = 1, C%nSedimentLayers ! capacity for that size fraction in the bed. If so, then remove all fine sediment, water and
- delta_l_b(l, s) = O(l)%item%colFineSediment(s)%M_f() ! delta l -> b
- delta_l_l(l, l, s) = -O(l)%item%colFineSediment(s)%M_f() ! delta l -> l
- call O(l)%item%colFineSediment(s)%ClearAll() ! fractional compositions from all layers for this size class
- end do
- delta_d_b(S) = dep_excess * &
- FS_dep(s)%rho_part() ! delta for deposition to burial
- end associate
+ delta_d_b = 0.0_dp; delta_d_l = 0.0_dp; delta_l_b = 0.0_dp; delta_l_l = 0.0_dp; isEmpty = .true.
+
+ do s = 1, me%nSizeClasses
+ dep_excess = FS_dep(S)%V_f() - me%Cf_sediment(S)
+ if (dep_excess > 0) then
+ associate(O => me%colBedSedimentLayers)
+ do l = 1, C%nSedimentLayers
+ delta_l_b(l, s) = O(l)%item%colFineSediment(s)%M_f() ! l -> b
+ delta_l_l(l, l, s)= -O(l)%item%colFineSediment(s)%M_f() ! loss from l
+ call O(l)%item%colFineSediment(s)%ClearAll()
+ end do
+ delta_d_b(S) = dep_excess * FS_dep(s)%rho_part() ! d -> b
+ end associate
else
- isEmpty(s) = .false. ! set flag to indicate that there is sediment in this layer
+ isEmpty(s) = .false.
end if
end do
- call T%create("FineSediment_T", me%nfComp) ! create FineSediment object T
- call U%create("FineSediment_U", me%nfComp) ! create FineSediment object U
- do s = 1, me%nSizeClasses ! main loop for burial of sediment
- ! for each sediment size class, check whether the available capacity in the bed
- ! exceeds the amount of depositing sediment. If so, then bury sediment of this size class
- ! to provide the capacity for the depositing sediment
- if (.not. isEmpty(S)) then ! only do if there is sediment of this size class in the bed
- A_f_sed = me%Af_sediment(S) ! local copy of the capacity for this sediment size class in the whole bed [m3 m-2]
- V_f_burial = FS_dep(S)%V_f() - A_f_sed ! difference between volume of depositing sediment and available capacity
- ! if > 0, then sediment needs to be buried to create capacity for deposition
- if (V_f_burial > 0.0_dp) then ! do we need to bury sediment to create available capacity for deposition?
- call T%set(Vf_in = V_f_burial, &
- Vw_in = 0.0_dp, &
- f_comp_in = FS_dep(S)%f_comp &
- ) ! yes, so
- ! set up temporary FineSediment object T with volume of fine sediment requiring burial
- ! to compute the volume of water requiring burial, we must loop through layers
- ! from the top, compute for each layer the volume of fine sediment that must be
- ! removed to allow space for deposition, and the volume of water associated with the
- ! fine sediment
- l = C%nSedimentLayers ! loop through layers, upwards from the bottom
- do while (l > 0 .and. T%V_f() > 0) ! use fine sediment volume in T as a counter. Through this loop, T holds the count of the
- ! requirement for sediment burial that has not yet been accounted for by higher layers
- associate (O => me%colBedSedimentLayers(l)%item) ! association to layer L
- if (T%V_f() > O%C_f(s)) then ! does the depositing fine sediment fit into this layer,
- ! after accounting for the capacity in layers above?
- ! no, the depositing sediment will not fit into this layer
- ! so increase water removal requirement by the water capacity of this layer
- ! and decrease the count of remaining depositing fine sediment by the capacity
- call T%set( &
- Vf_in = T%V_f() - O%C_f(s), &
- Vw_in = T%V_w() + O%C_w(s))
- else ! yes, depositing sediment fits into this layer
- ! so increase the water burial requirement by the amount required to maintain the SLR in this layer
- ! and set the count of fine sediment to zero, to jump out of the loop
- tempV = T%V_f() / O%volSLR(s) ! temporary variable
- call T%set(Vf_in = 0.0_dp, &
- Vw_in = T%V_w() + tempV)
+
+ call T%create("FineSediment_T", me%nfComp)
+ call U%create("FineSediment_U", me%nfComp)
+
+ do s = 1, me%nSizeClasses
+ if (.not. isEmpty(S)) then
+ A_f_sed = me%Af_sediment(S)
+ V_f_burial = FS_dep(S)%V_f() - A_f_sed
+ if (V_f_burial > 0.0_dp) then
+ call T%set(Vf_in = V_f_burial, Vw_in = 0.0_dp, f_comp_in = FS_dep(S)%f_comp)
+
+ ! compute water to bury to preserve SLR
+ l = C%nSedimentLayers
+ do while (l > 0 .and. T%V_f() > 0)
+ associate (O => me%colBedSedimentLayers(l)%item)
+ if (T%V_f() > O%C_f(s)) then
+ call T%set(Vf_in = T%V_f() - O%C_f(s), Vw_in = T%V_w() + O%C_w(s))
+ else
+ if (O%volSLR(s) <= 1.0e-12_dp) then
+ tempV = 0.0_dp
+ else
+ tempV = T%V_f() / O%volSLR(s)
+ end if
+ call T%set(Vf_in = 0.0_dp, Vw_in = T%V_w() + tempV)
end if
end associate
- l = l - 1 ! decrement the layer count
- end do ! and loop
- ! now to actually bury fine sediment and water
- ! we still use the object T to hold the depositing material - firstly, its mass
- ! needs to be reset, as it was decremented to zero in the computation of the water requirement
- call T%set(Vf_in = FS_dep(s)%V_f() - A_f_sed) ! reset the fine sediment burial requirement, still using object T
- ! now we remove and bury material from the base of the sediment upwards,
- ! to create sufficient space to accommodate deposited material
- l = C%nSedimentLayers ! start with the bottom layer
- do while (l > 0 .and. T%V_f() + T%V_w() > 0) ! loop through each layer, while there is still material to bury
- if (T%V_f() > 0) Then
- associate(O => &
- me%colBedSedimentLayers(l)%item) ! association reference to layer L object
- call r%addErrors(.errors. &
- O%RemoveSediment(S, T, U) &
- ) ! remove the sediment, return amount removed (U) and not removed (T), and any errors thrown
-
- if (r%hasCriticalError()) then ! if RemoveSediment throws a critical error
- call r%addToTrace(tr) ! add trace to all errors
- return ! and exit
+ l = l - 1
+ end do
+
+ ! actually bury fine sediment (and its water) from the bottom up
+ call T%set(Vf_in = FS_dep(s)%V_f() - A_f_sed)
+ l = C%nSedimentLayers
+ do while (l > 0 .and. T%V_f() + T%V_w() > 0)
+ if (T%V_f() > 0) then
+ associate(O => me%colBedSedimentLayers(l)%item)
+ call r%addErrors(.errors. O%RemoveSediment(S, T, U))
+ if (r%hasCriticalError()) then
+ call r%addToTrace(tr)
+ return
end if
- delta_l_b(l, s) = U%M_f() ! delta for layer L to burial
- delta_l_l(l, l, s) = &
- delta_l_l(l, l, s) - U%M_f() ! delta for loss of sediment from L to burial
+ delta_l_b(l, s) = delta_l_b(l, s) + U%M_f()
+ delta_l_l(l, l, s) = delta_l_l(l, l, s) - U%M_f()
end associate
end if
- ! note that these are CHANGES in delta due to burial, not absolute values
- l = l - 1 ! move up to next layer
- end do ! finished burial. temporary object T can be reused
- ! now we shift sediment downwards from upper layers to fill the hole created by burial
- do l = C%nSedimentLayers, 2, -1 ! downward shift of fine sediment. Loop through the layers, starting at the bottom
- ! and working upwards
- assoc1 : associate(O => me%colBedSedimentLayers(L)%item) ! association to "receiving" layer L
- A = l - 1 ! counter for "donating" layer - initially the layer above
- call T%set(Vf_in = O%A_f(s), &
- Vw_in = O%A_w(s)) ! set FineSediment object T to hold the available capacity in the receiving layer i.e. the volumes that require shifting downwards
- ! Note no need to set f_comp in T
- do while (A > 0 .and. T%IsNotEmpty()) ! loop through "donating" layers, moving upwards
- assoc2 : associate (P => me%colBedSedimentLayers(A)%item) ! association to "donating" layer A
- if (P%colFineSediment(S)%V_f() > 0) &
- then ! if there is sediment in the "donating" layer
- call r%addErrors(.errors. &
- P%RemoveSediment(S, T, U)) ! remove the sediment, return amounts removed (U) and not removed (T), the delta, and any errors thrown
- if (r%hasCriticalError()) then ! if RemoveSediment throws a critical error
- call r%addToTrace(tr) ! add trace to all errors
- return ! and exit
- end if
- delta_l_l(A, L, S) = &
- delta_l_l(A, L, S) + &
- U%M_f() ! delta for transfer of sediment from Layer A to Layer L, correcting for material previously buried
- delta_l_l(A, A, S) = &
- delta_l_l(A, A, S) - &
- U%M_f() ! delta for retention of sediment in Layer A
- call r%addErrors(.errors. &
- O%addSediment(S, U)) ! add the sediment in U to the "receiving" layer L
- if (r%hasCriticalError()) then ! if AddSediment throws a critical error
- call r%addToTrace(tr) ! add trace to all errors
- return ! and exit
+ l = l - 1
+ end do
+
+ ! shift sediment downwards to fill the void created by burial
+ do l = C%nSedimentLayers, 2, -1
+ assoc1: associate(O => me%colBedSedimentLayers(L)%item)
+ A = l - 1
+ call T%set(Vf_in = O%A_f(s), Vw_in = O%A_w(s)) ! capacity to fill at receiving layer
+ do while (A > 0 .and. T%IsNotEmpty())
+ assoc2: associate(P => me%colBedSedimentLayers(A)%item)
+ if (P%colFineSediment(S)%V_f() > 0) then
+ call r%addErrors(.errors. P%RemoveSediment(S, T, U))
+ if (r%hasCriticalError()) then
+ call r%addToTrace(tr)
+ return
+ end if
+ delta_l_l(A, L, S) = delta_l_l(A, L, S) + U%M_f()
+ delta_l_l(A, A, S) = delta_l_l(A, A, S) - U%M_f()
+ call r%addErrors(.errors. O%addSediment(S, U))
+ if (r%hasCriticalError()) then
+ call r%addToTrace(tr)
+ return
end if
end if
- A = A - 1 ! shift up to next "donating" layer
+ A = A - 1
end associate assoc2
end do
end associate assoc1
@@ -517,46 +512,45 @@ function depositSediment1(me, FS_dep) result(r)
end if
end if
end do
- V_w_tot = 0.0_dp ! Initialise V_w_tot to zero
- do s = 1, me%nSizeClasses ! now add in the depositing sediment, work by size class
- do l = C%nSedimentLayers, 1, -1 ! start with the bottom layer and work upwards
+
+
+ ! add the depositing sediment (bottom-up to respect capacities)
+ V_w_tot = 0.0_dp
+ do s = 1, me%nSizeClasses
+ do l = C%nSedimentLayers, 1, -1
if (FS_dep(s)%M_f() > 0.0_dp) then
- associate(O => me%colBedSedimentLayers(l)%item) ! size class S in Layer L
- if (O%A_f(s) > 0.0_dp .or. &
- O%A_w(s) > 0.0_dp) then ! if there is available capacity in this layer, add deposition here
- V_w_b = FS_dep(s)%V_f() / O%volSLR(s) ! the volume of water needed to maintain SLR in the "receiving" layer,
- call FS_dep(s)%set(Vw_in = V_w_b) ! if all deposition were to fit into this layer
- M_f_la = FS_dep(s)%M_f() ! store the amount of sediment still to be deposited, for computation of deltas
- call r%addErrors(.errors. &
- O%addSediment(s, FS_dep(s))) ! add the fine sediment in deposition. FS_dep(S) returns volumes that could not be added
- if (r%hasCriticalError()) then ! if addSediment throws a critical error
- call r%addToTrace(tr) ! add trace to all errors
- return ! and exit
+ associate(O => me%colBedSedimentLayers(l)%item)
+ if (O%A_f(s) > 0.0_dp .or. O%A_w(s) > 0.0_dp) then
+ if (O%volSLR(s) <= 1.0e-12_dp) then
+ V_w_b = 0.0_dp
+ else
+ V_w_b = FS_dep(s)%V_f() / O%volSLR(s)
+ end if
+ call FS_dep(s)%set(Vw_in = V_w_b)
+ M_f_la = FS_dep(s)%M_f()
+ call r%addErrors(.errors. O%addSediment(s, FS_dep(s)))
+ if (r%hasCriticalError()) then
+ call r%addToTrace(tr)
+ return
end if
- delta_d_l(l, s) = M_f_la - FS_dep(s)%M_f() ! delta_d_l: the mass of material deposited to this layer
+ delta_d_l(l, s) = M_f_la - FS_dep(s)%M_f() ! d -> l
end if
- V_w_tot = V_w_tot + V_w_b - FS_dep(s)%V_w() ! tally up V_w_b to compute water requirement to take from the water column
+ V_w_tot = V_w_tot + V_w_b - FS_dep(s)%V_w() ! water required from the water column
end associate
end if
end do
end do
- r = Result(data = V_w_tot) ! return Result object, with volume of water required from water column
- do s = 1, me%nSizeClasses ! incorporate delta_d_b, delta_d_l, delta_l_b, delta_l_l into the mass transfer coefficients matrix delta_sed
- me%delta_sed(C%nSedimentLayers + 3, 1, S) = &
- me%delta_sed(C%nSedimentLayers + 3, 1, S) + delta_d_b(S) ! element (S) of delta_d_b is added to element (Layers+3, 1, S) of me%delta_sed
+ r = Result(data = V_w_tot)
+
+ ! Assemble delta_sed from deltas we collected
+ do s = 1, me%nSizeClasses
+ me%delta_sed(C%nSedimentLayers + 3, 1, S) = me%delta_sed(C%nSedimentLayers + 3, 1, S) + delta_d_b(S) ! d -> b
do L = 1, C%nSedimentLayers
- me%delta_sed(L + 2, 1, S) = &
- me%delta_sed(L + 2, 1, S) + delta_d_l(L, S) ! element (L, S) of delta_d_l is added to element (L+2, 1, S) of me%delta_sed
- me%delta_sed(C%nSedimentLayers + 3, L + 2, S) = &
- me%delta_sed(C%nSedimentLayers + 3, L + 2, S) + &
- delta_l_b(L, S) ! element (L, S) of delta_l_b is added to element (Layers+3, L+2, S) of me%delta_sed
+ me%delta_sed(L + 2, 1, S) = me%delta_sed(L + 2, 1, S) + delta_d_l(L, S) ! d -> l
+ me%delta_sed(C%nSedimentLayers + 3, L + 2, S) = me%delta_sed(C%nSedimentLayers + 3, L + 2, S) + delta_l_b(L, S) ! l -> b
do LL = 1, C%nSedimentLayers
- if (isZero(me%delta_sed(L + 2, LL + 2, S))) then
- me%delta_sed(L + 2, LL + 2, S) = 0.0_dp
- end if
- me%delta_sed(L + 2, LL + 2, S) = &
- me%delta_sed(L + 2, LL + 2, S) + &
- delta_l_l(LL, L, S) ! element (LL, L, S) of delta_l_l is added to element (L+2, LL+2, S) of me%delta_sed
+ if (isZero(me%delta_sed(L + 2, LL + 2, S))) me%delta_sed(L + 2, LL + 2, S) = 0.0_dp
+ me%delta_sed(L + 2, LL + 2, S) = me%delta_sed(L + 2, LL + 2, S) + delta_l_l(LL, L, S) ! l -> l
end do
end do
end do
@@ -572,11 +566,127 @@ function depositSediment1(me, FS_dep) result(r)
!! **Function outputs/outcomes**
!!
subroutine ReportBedMassToConsole1(me)
- class(BedSediment) :: me !! The `BedSediment` instance
- integer :: n !! LOCAL loop counter
+ class(BedSediment) :: me
+ integer :: n
do n=1, C%nSedimentLayers
- call me%colBedSedimentLayers(n)%item%repMass() !! print out mass of FS in each layer, by size class [kg/m2]
+ call me%colBedSedimentLayers(n)%item%repMass()
end do
end subroutine
-end module
\ No newline at end of file
+ !> Assemble contaminant package that co-deposits with SPM; scavenge FREE interface pool
+ function deposit_spm_BedSediment(Me, dj_spm_deposit, bedArea, out_deposit, out_resus) result(r)
+ class(BedSediment), intent(inout) :: Me
+ real(dp), intent(in) :: dj_spm_deposit(:) ! [kg/m2]
+ real(dp), intent(in) :: bedArea ! [m2]
+ type(Contaminant), intent(out) :: out_deposit
+ type(Contaminant), intent(out) :: out_resus
+ type(Result) :: r
+
+ real(dp) :: denom
+ real(dp), allocatable :: frac_dep(:)
+ integer :: j, n, f, st_spm
+
+ call r%addErrors(.errors. out_deposit%create())
+ call r%addErrors(.errors. out_resus%create())
+ if (C%nSizeClassesSpm <= 0) return
+
+ allocate(frac_dep(C%nSizeClassesSpm))
+ denom = sum(dj_spm_deposit)
+ if (denom < C%epsilon) then
+ frac_dep = 0.0_dp
+ else
+ frac_dep = dj_spm_deposit / denom
+ end if
+
+ ! Scavenge FREE at interface (pool 1) onto depositing SPM-attached bins
+ do j = 1, C%nSizeClassesSpm
+ st_spm = SPM_CONTAMINANT_START + j - 1
+ do n = 1, C%contaminantDim(1)
+ do f = 1, C%nContaminantForms
+ ! Move a fraction of FREE into the SPM-bound bin
+ out_deposit%c(n,f,st_spm) = out_deposit%c(n,f,st_spm) + &
+ Me%m_contaminant(1)%c(n,f,FREE_CONTAMINANT) * frac_dep(j)
+ Me%m_contaminant(1)%c(n,f,FREE_CONTAMINANT) = max(0.0_dp, &
+ Me%m_contaminant(1)%c(n,f,FREE_CONTAMINANT) - &
+ Me%m_contaminant(1)%c(n,f,FREE_CONTAMINANT) * frac_dep(j))
+ end do
+ end do
+ end do
+
+ ! Optionally expose “ready-to-resuspend” (pool 2) as an area flux
+ do j = 1, C%nSizeClassesSpm
+ st_spm = SPM_CONTAMINANT_START + j - 1
+ do n = 1, C%contaminantDim(1)
+ do f = 1, C%nContaminantForms
+ out_resus%c(n,f,st_spm) = out_resus%c(n,f,st_spm) + &
+ Me%m_contaminant(2)%c(n,f,st_spm) * bedArea
+ end do
+ end do
+ end do
+ end function
+
+ !> Assemble contaminant package that leaves with resuspended SPM; becomes FREE in water column
+ function resuspend_spm_BedSediment(Me, dj_spm_resus, bedArea, out_resus) result(r)
+ class(BedSediment), intent(inout) :: Me
+ real(dp), intent(in) :: dj_spm_resus(:) ! [kg/m2]
+ real(dp), intent(in) :: bedArea ! [m2]
+ type(Contaminant), intent(out) :: out_resus
+ type(Result) :: r
+
+ integer :: j, n, f, st_spm
+ real(dp) :: m_spm_ready, scale_j
+
+ call r%addErrors(.errors. out_resus%create())
+
+ ! If no resuspension or no bed area, nothing to do
+ if (all(dj_spm_resus <= C%epsilon) .or. bedArea <= C%epsilon) return
+
+ do j = 1, C%nSizeClassesSpm
+ st_spm = SPM_CONTAMINANT_START + j - 1
+
+ ! -----------------------------------------------------------------------
+ ! FIXED LOGIC START
+ ! -----------------------------------------------------------------------
+ m_spm_ready = 0.0_dp
+
+ ! Check if layers and fine sediment objects are allocated
+ if (allocated(Me%colBedSedimentLayers) .and. size(Me%colBedSedimentLayers) >= 1) then
+ if (allocated(Me%colBedSedimentLayers(1)%item%colFineSediment)) then
+ ! Access the mass of fine sediment for size class 'j'
+ ! M_f() returns mass in [kg/m2]
+ m_spm_ready = Me%colBedSedimentLayers(1)%item%colFineSediment(j)%M_f()
+ end if
+ end if
+
+ ! Note: m_spm_ready is already [kg/m2] and dj_spm_resus is [kg/m2].
+ ! No division by bedArea is needed here.
+ ! -----------------------------------------------------------------------
+ ! FIXED LOGIC END
+ ! -----------------------------------------------------------------------
+
+ ! If there is no ready SPM, skip this size class
+ if (m_spm_ready <= C%epsilon) cycle
+
+ ! Fraction of the ready SPM that actually resuspends this step
+ ! ratio of Flux [kg/m2] to Stock [kg/m2] -> Dimensionless fraction
+ scale_j = max(0.0_dp, min(1.0_dp, dj_spm_resus(j) / m_spm_ready))
+
+ if (scale_j <= 0.0_dp) cycle
+
+ do n = 1, C%contaminantDim(1)
+ do f = 1, C%nContaminantForms
+ ! Release a scaled fraction of the top layer (Index 1)
+ ! Me%m_contaminant(1) stores Total Mass [kg] in the layer
+
+ ! Add to output flux (Total Mass resuspended)
+ out_resus%c(n,f,st_spm) = out_resus%c(n,f,st_spm) + &
+ Me%m_contaminant(1)%c(n,f,st_spm) * scale_j
+
+ ! Remove that fraction from the bed layer
+ Me%m_contaminant(1)%c(n,f,st_spm) = &
+ Me%m_contaminant(1)%c(n,f,st_spm) * (1.0_dp - scale_j)
+ end do
+ end do
+ end do
+ end function
+end module
diff --git a/src/BedSedimentLayer/AbstractBedSedimentLayerModule.f90 b/src/BedSedimentLayer/AbstractBedSedimentLayerModule.f90
index eac6041..044aabe 100644
--- a/src/BedSedimentLayer/AbstractBedSedimentLayerModule.f90
+++ b/src/BedSedimentLayer/AbstractBedSedimentLayerModule.f90
@@ -234,7 +234,13 @@ function GetvolSLR(Me, S) result(volSLR)
class(AbstractBedSedimentLayer), intent(in) :: Me !! The `AbstractBedSedimentLayer` instance
integer :: S !! size class for which volumetric SLR is to be computed
real(dp) :: volSLR ! LOCAL internal storage
- volSLR = Me%C_f_l(S) / Me%C_w_l(S) ! compute ratio
+ real(dp), parameter :: eps = 1.0d-12
+ if (Me%C_w_l(S) <= eps) then
+ ! No water capacity -> define S:L as 0 safely (all solid in limiting sense)
+ volSLR = 0.0_dp
+ else
+ volSLR = Me%C_f_l(S) / Me%C_w_l(S)
+ end if
end function
!> Return the sediment mass in the layer across all size fractions
@@ -280,9 +286,9 @@ function GetVflayer(Me) result(Vf_layer)
! type(Result0D) :: r !! Return value
real(dp) :: Vf_layer ! LOCAL internal storage
integer :: S ! LOCAL loop counter
- Vf_layer = 0 ! initialise local variable
+ Vf_layer = 0.0_dp ! initialise local variable
do S = 1, Me%nSizeClasses
- Vf_layer = Vf_layer + Me%colFineSediment(S)%V_f() ! sum across all size classes
+ Vf_layer = Vf_layer + max(Me%colFineSediment(S)%V_f(), 0.0_dp) ! sum across all size classes
end do
! r = Result(data = Vf_layer)
end function
@@ -299,9 +305,9 @@ function GetVwlayer(Me) result(Vw_layer)
! type(Result0D) :: r !! Return value
real(dp) :: Vw_layer ! LOCAL internal storage
integer :: S ! LOCAL loop counter
- Vw_layer = 0
+ Vw_layer = 0.0_dp
do S = 1, Me%nSizeClasses
- Vw_layer = Vw_layer + Me%colFineSediment(S)%V_w() ! sum across all size classes
+ Vw_layer = Vw_layer + max(Me%colFineSediment(S)%V_w(), 0.0_dp)
end do
! r = Result(data = Vw_layer)
end function
@@ -318,9 +324,9 @@ function GetCwlayer(Me) result(Cw_layer)
! type(Result0D) :: r !! Return value
real(dp) :: Cw_layer ! LOCAL internal storage
integer :: S ! loop counter
- Cw_layer = 0
+ Cw_layer = 0.0_dp
do S = 1, Me%nSizeClasses
- Cw_layer = Cw_layer + Me%C_w_l(S) ! sum across all size classes
+ Cw_layer = Cw_layer + max(Me%C_w_l(S), 0.0_dp)
end do
! r = Result(data = Cw_layer)
end function
@@ -337,11 +343,10 @@ function GetVmlayer(Me) result(Vm_layer)
! type(Result0D) :: r !! Return value
real(dp) :: Vm_layer ! LOCAL internal storage
integer :: S ! loop counter
- Vm_layer = 0 ! initialise local variable
+ Vm_layer = 0.0_dp
do S = 1, Me%nSizeClasses
- Vm_layer = Vm_layer + &
- Me%colFineSediment(S)%V_f() + &
- Me%colFineSediment(S)%V_w() ! sum across all size classes
+ Vm_layer = Vm_layer + max(Me%colFineSediment(S)%V_f(), 0.0_dp) &
+ + max(Me%colFineSediment(S)%V_w(), 0.0_dp)
end do
! r = Result(data = Vm_layer)
end function
@@ -357,13 +362,6 @@ function GetVlayer(Me) result (V_layer)
class(AbstractBedSedimentLayer), intent(in) :: Me !! The `AbstractBedSedimentLayer` instance
type(Result0D) :: r !! Return value
real(dp) :: V_layer ! LOCAL internal storage
- integer :: S ! loop counter
- V_layer = Me%V_c ! start by adding coarse material volume
- do S = 1, Me%nSizeClasses
- V_layer = V_layer + &
- Me%colFineSediment(S)%V_f() + &
- Me%colFineSediment(S)%V_w() ! sum across all size classes
- end do
- r = Result(data = V_layer)
+ V_layer = max(Me%V_c, 0.0_dp) + Me%V_m_layer()
end function
end module
diff --git a/src/BedSedimentLayer/BedSedimentLayerModule.f90 b/src/BedSedimentLayer/BedSedimentLayerModule.f90
index a10eae9..125f655 100644
--- a/src/BedSedimentLayer/BedSedimentLayerModule.f90
+++ b/src/BedSedimentLayer/BedSedimentLayerModule.f90
@@ -7,6 +7,7 @@ module BedSedimentLayerModule
use DataInputModule, only: DATASET
use AbstractBedSedimentLayerModule
use FineSedimentModule
+ use LoggerModule, only: LOGR
implicit none
!> Class definition for `BedSedimentLayer`. Extends abstract
@@ -41,6 +42,7 @@ function createBedSedimentLayer(Me, l) result(r)
real(dp), allocatable :: M_f(:) ! LOCAL set of fine sediment masses, index = size class
real(dp), allocatable :: f_comp(:,:) ! LOCAL set of fractional compositions. Index 1 = size class, Index 2 = compositional fraction
character(len=256) :: tr ! LOCAL name of this procedure, for trace
+ character(len=256) :: msg
character(len=16), parameter :: ms = &
"Allocation error" ! LOCAL allocation error message
real(dp) :: fwr
@@ -48,6 +50,9 @@ function createBedSedimentLayer(Me, l) result(r)
integer :: S ! LOCAL loop counter
integer :: allst ! LOCAL array allocation status
character(len=256) :: allms ! LOCAL array allocation message
+ real(dp) :: scale_f
+ integer :: s_
+ real(dp) :: V_f_sum, V_w_sum, water_cap, scale_w
!
! Notes
! -------------------------------------------------------------------------------
@@ -149,15 +154,24 @@ function createBedSedimentLayer(Me, l) result(r)
Me%C_f_l(S) = Me%colFineSediment(S)%V_f() ! set the sediment capacities to the volumes
end do
- if (Me%V_f_layer() > Me%C_total) then ! CRITICAL ERROR HERE: if layer volume exceeds capacity
- call r%addError(ErrorInstance( &
- code = 1, &
- message = "Fine sediment volume &
- exceeds capacity" &
- ) &
- ) ! add ErrorInstance
- return ! critical error, so exit
+ ! DEBUG: initial fine sediment mass per size in this layer
+ do S = 1, Me%nSizeClasses
+ write(*,'(a,i3,a,i3,a,1p,e15.7)') 'Init Layer ', me%l, ', Size ', S, &
+ ' Mf=', me%colFineSediment(S)%M_f()
+ end do
+
+ if (Me%V_f_layer() > Me%C_total) then
+ ! Proportional down-scaling of fines to fit capacity; log a warning
+ scale_f = Me%C_total / max(C%epsilon, Me%V_f_layer())
+ do s_ = 1, Me%nSizeClasses
+ call Me%colFineSediment(s_)%set( Vf_in = Me%colFineSediment(s_)%V_f() * scale_f )
+ Me%C_f_l(s_) = Me%colFineSediment(s_)%V_f()
+ end do
+ msg = trim(Me%name)//": fines exceeded capacity; scaled to fit (scale="// &
+ trim(str(scale_f))//")"
+ call LOGR%toFile(msg)
end if
+
if (r%hasCriticalError()) then ! if a critical error has been thrown
call r%addToTrace(tr) ! add trace to Result
return ! exit, as a critical error has occurred
@@ -180,17 +194,26 @@ function createBedSedimentLayer(Me, l) result(r)
Me%C_w_l(S) = Me%colFineSediment(S)%V_w() ! set the water capacities, using the local variable
end do
V_m_layer_l = Me%V_m_layer() ! temporary storage of fines+water volume
- if (V_m_layer_l > Me%C_total) then ! CRITICAL ERROR HERE: if Me%V_m_layer > C_tot
- call r%addError(ErrorInstance( &
- code = 1, &
- message = "Fine sediment & &
- water volume &
- exceeds capacity" &
- ) &
- ) ! add ErrorInstance
- call r%addToTrace(tr) ! add trace to Result
- return ! critical error, so exit
+ if (V_m_layer_l > Me%C_total) then
+ ! First try: reduce only water to fit the remaining capacity
+ V_f_sum = Me%V_f_layer()
+ V_w_sum = V_m_layer_l - V_f_sum
+ water_cap = max(0.0_dp, Me%C_total - V_f_sum)
+
+ if (V_w_sum > 0.0_dp .and. V_w_sum > water_cap) then
+ scale_w = water_cap / V_w_sum
+ do s_ = 1, Me%nSizeClasses
+ call Me%colFineSediment(s_)%set( Vw_in = Me%colFineSediment(s_)%V_w() * max(0.0_dp, scale_w) )
+ Me%C_w_l(s_) = Me%colFineSediment(s_)%V_w()
+ end do
+ msg = trim(Me%name)//": fines+water exceeded capacity; scaled water to fit (scale="// &
+ trim(str(scale_w))//")"
+ call LOGR%toFile(msg)
+ end if
+ ! << recompute totals after possible water scaling
+ V_m_layer_l = Me%V_m_layer()
end if
+
Me%V_c = Me%C_total - V_m_layer_l ! set the coarse material volume
end function
!> **Function purpose**
diff --git a/src/BedSedimentLayer/FineSedimentModule.f90 b/src/BedSedimentLayer/FineSedimentModule.f90
index 7878bac..621c7bc 100644
--- a/src/BedSedimentLayer/FineSedimentModule.f90
+++ b/src/BedSedimentLayer/FineSedimentModule.f90
@@ -8,30 +8,30 @@ module FineSedimentModule
!> Definition of `FineSediment` class. Nonpolymorphic.
type, public :: FineSediment
character(len=256) :: name = "Undefined FineSediment" !! A name for the object
- real(dp), public :: M_f_l !! LOCAL fine sediment mass [kg m-2]
+ real(dp), public :: M_f_l !! LOCAL fine sediment mass [kg m-2]
real(dp), private :: M_f_l_backup !! LOCAL backup copy of fine sediment mass [kg m-2]
real(dp), private :: V_w_l = 0.0_dp !! LOCAL volume of water associated with fine sediment [m3 m-2]
real(dp), allocatable :: f_comp(:) !! Fractional composition [-]
- real, allocatable :: pd_comp(:) !! LOCAL storage of fractional particle densities [kg m-3]
+ real(dp), allocatable :: pd_comp(:) !! LOCAL storage of fractional particle density [kg m-3]
integer :: nfComp !! LOCAL number of fractional composition terms
logical :: isCreated = .false. !! LOCAL has this object been created?
contains
- procedure, public :: create => createFineSediment ! sets up by reading variables required for computations
- procedure, public :: destroy => destroyFineSediment ! finalises by doing all necessary deallocations
- procedure, public :: set => setFS ! set properties, using either fine sediment volume or mass
- procedure, public :: V_f => getFSVol ! returns the fine sediment volume [m3 m-2]
- procedure, public :: M_f => getFSMass ! returns the fine sediment mass [kg m-2]
- procedure, public :: M_f_backup => getFSMassBackup ! returns the backup fine sediment mass [kg m-2]
- procedure, public :: backup_M_f => setFSMassBackup ! back up the fine sediment mass [kg m-2]
- procedure, public :: V_w => getWVol ! returns the water volume [kg m-2]
- procedure, public :: rho_part => pdens ! returns the fine sediment particle density [kg m-3]
- procedure, public :: audit_comp => audit_fcomp ! check the fractional composition
- procedure, public :: IsEmpty => empty ! check for presence of sediment and water
- procedure, public :: IsNotEmpty => notempty ! check for presence of sediment and water
- procedure, public :: ClearAll => ClearAll ! clear all fine sediment and water from the object
- procedure, public :: mix => Mix ! mix this sediment into another
- procedure, public :: repstat => ReportStatusToConsole ! report the properties of this sediment to the console
- procedure, public :: repmass => ReportMassToConsole ! report the fine sediment mass of this sediment to the console
+ procedure, public :: create => createFineSediment
+ procedure, public :: destroy => destroyFineSediment
+ procedure, public :: set => setFS
+ procedure, public :: V_f => getFSVol
+ procedure, public :: M_f => getFSMass
+ procedure, public :: M_f_backup => getFSMassBackup
+ procedure, public :: backup_M_f => setFSMassBackup
+ procedure, public :: V_w => getWVol
+ procedure, public :: rho_part => pdens
+ procedure, public :: audit_comp => audit_fcomp
+ procedure, public :: IsEmpty => empty
+ procedure, public :: IsNotEmpty => notempty
+ procedure, public :: ClearAll => ClearAll
+ procedure, public :: mix => Mix
+ procedure, public :: repstat => ReportStatusToConsole
+ procedure, public :: repmass => ReportMassToConsole
end type
!> Result object with operator for FineSediment scalar data
diff --git a/src/Biota/AbstractBiotaModule.f90 b/src/Biota/AbstractBiotaModule.f90
index 3c82c08..349f9bd 100644
--- a/src/Biota/AbstractBiotaModule.f90
+++ b/src/Biota/AbstractBiotaModule.f90
@@ -1,54 +1,90 @@
module AbstractBiotaModule
use GlobalsModule, only: dp
+ use ContaminantModule
implicit none
- type, abstract, public :: AbstractBiota
+ type, abstract, public :: AbstractBiota
character(len=256) :: ref !! Reference for this instance
character(len=100) :: name !! Name of this organism
integer :: biotaIndex !! Index of this biota index in database, TODO deprecate and deal with data better
- real(dp) :: C_active !! Concentration of nanomaterial in biota [kg/kg dw]
- real(dp) :: C_stored !! Concentration of nanomaterial in biota stored fraction [kg/kg dw]
- real(dp) :: k_uptake_np !! Uptake constant [/day]
- real(dp) :: k_uptake_transformed !! Uptake constant [/day]
- real(dp) :: k_uptake_dissolved !! Uptake constant [/day]
- real(dp) :: k_elim_np !! Elimination constant [/day]
- real(dp) :: k_elim_transformed
- real(dp) :: k_elim_dissolved
- real(dp) :: k_growth !! Growth dilution rate [/day]
- real(dp) :: k_death
- real(dp) :: storedFraction !! Stored fraction of namoaterial [-]
- character(len=17) :: uptakeFromForm !! What form (free, attached) to uptake from. Options: free, attached, free_and_attached
- integer :: harvestInMonth !! Month to harvest biota, i.e. set C_org to zero
-
- contains
+ real(dp), allocatable :: C_active(:) !! Concentration of nanomaterial in biota [kg/kg dw]
+ real(dp), allocatable :: C_stored(:) !! Concentration of nanomaterial in biota stored fraction [kg/kg dw]
+ real(dp), allocatable :: k_uptake(:) !! Uptake constant [/day]
+ real(dp), allocatable :: k_elim(:) !! Elimination constant [/day]
+ real(dp) :: k_growth !! Growth dilution rate [/day]
+ real(dp) :: k_death !! Death rate [/day]
+ real(dp) :: storedFraction !! Stored fraction of nanomaterial [-]
+ character(len=17) :: uptakeFromForm !! What form (free, attached) to uptake from. Options: free, attached, free_and_attached
+ integer :: harvestInMonth !! Month to harvest biota, i.e. set C_org to zero
+ contains
procedure, public :: create => createAbstractBiota
procedure, public :: update => updateAbstractBiota
procedure, public :: parseInputData => parseInputDataAbstractBiota
+ procedure :: finalise => finaliseAbstractBiota
end type
contains
- function createAbstractBiota(me, biotaIndex) result(rslt)
+ function createAbstractBiota(me, biotaIndex) result(rslt)
use ResultModule, only: Result
- class(AbstractBiota) :: me
- integer :: biotaIndex
- type(Result) :: rslt
+ class(AbstractBiota) :: me
+ integer :: biotaIndex
+ type(Result) :: rslt
+ integer :: allocStat, nForms
+ nForms = C%contaminantDim(2) + 1 ! Forms + dissolved
+ me%biotaIndex = biotaIndex
+ allocate(me%C_active(nForms), me%C_stored(nForms), &
+ me%k_uptake(nForms), me%k_elim(nForms), stat=allocStat)
+ if (allocStat /= 0) then
+ call rslt%addError(ErrorInstance(code=1, message="Allocation failed for biota arrays"))
+ return
+ end if
+ me%C_active = 0.0_dp
+ me%C_stored = 0.0_dp
+ me%k_uptake = 0.0_dp
+ me%k_elim = 0.0_dp
+ call rslt%addErrors(.errors. me%parseInputData())
end function
- function updateAbstractBiota(me, t, C_env_np, C_env_transformed, C_env_dissolved) result(rslt)
+ function updateAbstractBiota(me, t, C_env_contaminant) result(rslt)
use ResultModule, only: Result
- class(AbstractBiota) :: me
- integer :: t
- real(dp) :: C_env_np(:,:,:)
- real(dp) :: C_env_transformed(:,:,:)
- real(dp) :: C_env_dissolved
+ class(AbstractBiota) :: me
+ integer :: t
+ type(Contaminant), intent(in) :: C_env_contaminant
type(Result) :: rslt
end function
function parseInputDataAbstractBiota(me) result(rslt)
use ResultModule, only: Result
- class(AbstractBiota) :: me
- type(Result) :: rslt
+ use DataInputModule, only: DATASET
+ class(AbstractBiota) :: me
+ type(Result) :: rslt
+ integer :: i
+ if (me%biotaIndex < 1 .or. me%biotaIndex > DATASET%nBiota) then
+ call rslt%addError(ErrorInstance(code=902, message="Invalid biota index"))
+ return
+ end if
+ me%name = DATASET%biotaName(me%biotaIndex)
+ me%k_growth = DATASET%biota_k_growth(me%biotaIndex)
+ me%k_death = DATASET%biota_k_death(me%biotaIndex) ! Add k_death
+ me%storedFraction = DATASET%biotaStoredFraction(me%biotaIndex)
+ me%uptakeFromForm = DATASET%biotaUptakeFromForm(me%biotaIndex)
+ me%harvestInMonth = DATASET%biotaHarvestInMonth(me%biotaIndex)
+ do i = 1, C%contaminantDim(2)
+ me%k_uptake(i) = DATASET%biota_k_uptake_contaminant(me%biotaIndex, i)
+ me%k_elim(i) = DATASET%biota_k_elim_contaminant(me%biotaIndex, i)
+ end do
+ me%k_uptake(C%contaminantDim(2) + 1) = DATASET%biota_k_uptake_dissolved(me%biotaIndex)
+ me%k_elim(C%contaminantDim(2) + 1) = DATASET%biota_k_elim_dissolved(me%biotaIndex)
+ me%C_active = DATASET%biotaInitial_C_org(me%biotaIndex)
+ me%C_stored = 0.0_dp
end function
-end module
+ subroutine finaliseAbstractBiota(me)
+ class(AbstractBiota) :: me
+ if (allocated(me%C_active)) deallocate(me%C_active)
+ if (allocated(me%C_stored)) deallocate(me%C_stored)
+ if (allocated(me%k_uptake)) deallocate(me%k_uptake)
+ if (allocated(me%k_elim)) deallocate(me%k_elim)
+ end subroutine
+end module
\ No newline at end of file
diff --git a/src/Biota/BiotaSoilModule.f90 b/src/Biota/BiotaSoilModule.f90
index 19c815e..cd63e78 100644
--- a/src/Biota/BiotaSoilModule.f90
+++ b/src/Biota/BiotaSoilModule.f90
@@ -4,6 +4,7 @@ module BiotaSoilModule
use GlobalsModule
use DataInputModule
use datetime_module
+ use ContaminantModule, only: Contaminant, FREE_CONTAMINANT, ATTACHED_CONTAMINANT
implicit none
type, public, extends(AbstractBiota) :: BiotaSoil
@@ -18,108 +19,89 @@ module BiotaSoilModule
!> Create this soil biota instance
function createBiotaSoil(me, biotaIndex) result(rslt)
class(BiotaSoil) :: me !! This soil biota instance
- integer :: biotaIndex !! Database index for this biota object TODO move to database
- type(Result) :: rslt
- ! Set defaults and ref
+ integer :: biotaIndex !! Database index for this biota object
+ type(Result) :: rslt !! Result object for error handling
me%ref = "BiotaSoil_" // trim(str(biotaIndex))
- me%biotaIndex = biotaIndex
- me%C_stored = 0.0_dp
- ! Get data from input file
- call rslt%addErrors(.errors. me%parseInputData())
- call rslt%addToTrace('Creating Biota')
- ! call LOGR%toFile(errors=.errors. rslt)
+ ! Call the parent class's create method
+ call rslt%addErrors(.errors. createAbstractBiota(me, biotaIndex))
+ call rslt%addToTrace('Creating BiotaSoil')
end function
!> Update the soil biota on this time step
- function updateBiotaSoil(me, t, C_env_np, C_env_transformed, C_env_dissolved) result(rslt)
+ function updateBiotaSoil(me, t, C_env_contaminant) result(rslt)
class(BiotaSoil) :: me !! This BiotaSoil instance
integer :: t !! The current time step
- real(dp) :: C_env_np(:,:,:)
- real(dp) :: C_env_transformed(:,:,:)
- real(dp) :: C_env_dissolved
+ type(Contaminant), intent(in) :: C_env_contaminant
type(Result) :: rslt !! The Result object to return errors in
- real(dp) :: C_env_np_sum
- real(dp) :: C_env_transformed_sum
- real(dp) :: gamma_np
- real(dp) :: gamma_transformed
- real(dp) :: gamma_dissolved
- real(dp) :: k_elim
+ real(dp), allocatable :: C_env_sum(:)
+ real(dp), allocatable :: gamma(:)
+ real(dp) :: k_elim_total
type(datetime) :: currentDate
-
+ integer :: f, nForms
+
+ if (.not. allocated(C_env_contaminant%c)) then
+ call rslt%addError(ErrorInstance(code=105, message="Contaminant array not allocated"))
+ return
+ end if
+ nForms = C%contaminantDim(2) + 1
+ allocate(C_env_sum(nForms), gamma(nForms))
currentDate = C%startDate + timedelta(days=t-1)
- ! If it's the month this harvesting is to occur, set concentrations
- ! to zero
if (me%harvestInMonth == currentDate%getMonth()) then
me%C_active = 0.0_dp
me%C_stored = 0.0_dp
else
- if (trim(me%uptakeFromForm) == 'free') then
- C_env_np_sum = sum(C_env_np(:,:,1))
- C_env_transformed_sum = sum(C_env_transformed(:,:,1))
- else if (trim(me%uptakeFromForm) == 'attached') then
- C_env_np_sum = sum(C_env_np(:,:,2))
- C_env_transformed_sum = sum(C_env_transformed(:,:,2))
- else if (trim(me%uptakeFromForm) == 'free_and_attached' &
- .or. trim(me%uptakeFromForm) == 'attached_and_free' &
- .or. trim(me%uptakeFromForm) == 'free_attached' &
- .or. trim(me%uptakeFromForm) == 'attached_free') then
- C_env_np_sum = sum(C_env_np(:,:,1:2))
- C_env_transformed_sum = sum(C_env_transformed(:,:,1:2))
- else
- call rslt%addError( &
- ErrorInstance(message = "Sorry, I can't understand the form specified " // &
- "in the uptake_from_form option for this biota. Specified form: " // &
- trim(me%uptakeFromForm) &
- ) &
- )
- call rslt%addToTrace("Updating " // trim(me%ref))
- end if
-
- gamma_np = me%k_uptake_np * (1 - me%storedFraction) * C_env_np_sum &
- / (me%k_elim_np + me%k_growth + me%k_death)
- gamma_transformed = me%k_uptake_transformed * (1 - me%storedFraction) * C_env_transformed_sum &
- / (me%k_elim_transformed + me%k_growth + me%k_death)
- gamma_dissolved = me%k_uptake_dissolved * (1 - me%storedFraction) * C_env_dissolved &
- / (me%k_elim_dissolved + me%k_growth + me%k_death)
- k_elim = me%k_elim_np + me%k_elim_transformed + me%k_elim_dissolved
- ! Calculate C_active, converting time step to days (because rate constants are /day)
- me%C_active = gamma_np + gamma_transformed + gamma_dissolved &
- + (me%C_active - gamma_np - gamma_transformed - gamma_dissolved) &
- * exp(-(k_elim + me%k_growth + me%k_death) * C%timeStep/86400)
-
+ C_env_sum = 0.0_dp
+ select case (trim(me%uptakeFromForm))
+ case ('free')
+ do f = 1, C%contaminantDim(2)
+ C_env_sum(f) = sum(C_env_contaminant%c(:,f,FREE_CONTAMINANT))
+ end do
+ C_env_sum(nForms) = C_env_contaminant%m_dissolved
+ case ('attached')
+ do f = 1, C%contaminantDim(2)
+ C_env_sum(f) = sum(C_env_contaminant%c(:,f,ATTACHED_CONTAMINANT))
+ end do
+ case ('free_and_attached', 'attached_and_free', 'free_attached', 'attached_free')
+ do f = 1, C%contaminantDim(2)
+ C_env_sum(f) = sum(C_env_contaminant%c(:,f,FREE_CONTAMINANT)) + &
+ sum(C_env_contaminant%c(:,f,ATTACHED_CONTAMINANT))
+ end do
+ C_env_sum(nForms) = C_env_contaminant%m_dissolved
+ case default
+ call rslt%addError(ErrorInstance(message="Invalid uptake_from_form: "//trim(me%uptakeFromForm)))
+ return
+ end select
+ do f = 1, nForms
+ gamma(f) = me%k_uptake(f) * (1 - me%storedFraction) * C_env_sum(f) / &
+ (me%k_elim(f) + me%k_growth + me%k_death)
+ end do
+ k_elim_total = sum(me%k_elim)
+ me%C_active = gamma + (me%C_active - gamma) * &
+ exp(-(k_elim_total + me%k_growth + me%k_death) * C%timeStep/86400)
if (.not. isZero(me%k_growth + me%k_death)) then
- gamma_np = me%k_uptake_np * me%storedFraction * C_env_np_sum &
- / (me%k_growth + me%k_death)
- gamma_transformed = me%k_uptake_transformed * me%storedFraction * C_env_transformed_sum &
- / (me%k_growth + me%k_death)
- gamma_dissolved = me%k_uptake_dissolved * me%storedFraction * C_env_dissolved &
- / (me%k_growth + me%k_death)
- else
- gamma_np = 0.0_dp
- gamma_transformed = 0.0_dp
- gamma_dissolved = 0.0_dp
+ do f = 1, nForms
+ gamma(f) = me%k_uptake(f) * me%storedFraction * C_env_sum(f) / &
+ (me%k_growth + me%k_death)
+ end do
+ me%C_stored = gamma + (me%C_stored - gamma) * &
+ exp(-(me%k_growth + me%k_death) * C%timeStep/86400)
end if
-
- me%C_stored = gamma_np + gamma_transformed + gamma_dissolved &
- + (me%C_stored - gamma_np - gamma_transformed - gamma_dissolved) &
- * exp(-(me%k_growth + me%k_death) * C%timeStep/86400)
end if
-
end function
!> Parse input data for the soil biota
function parseInputDataBiotaSoil(me) result(rslt)
- class(BiotaSoil) :: me
- type(Result) :: rslt
- ! Get rates from database. TODO deprecate in favour of using directly
- ! to save memory
+ class(BiotaSoil) :: me
+ type(Result) :: rslt
+ integer :: nForms, f
+ nForms = C%contaminantDim(2) + 1
me%name = DATASET%biotaName(me%biotaIndex)
- me%k_uptake_np = DATASET%biota_k_uptake_np(me%biotaIndex)
- me%k_uptake_transformed = DATASET%biota_k_uptake_transformed(me%biotaIndex)
- me%k_uptake_dissolved = DATASET%biota_k_uptake_dissolved(me%biotaIndex)
- me%k_elim_np = DATASET%biota_k_elim_np(me%biotaIndex)
- me%k_elim_transformed = DATASET%biota_k_elim_transformed(me%biotaIndex)
- me%k_elim_dissolved = DATASET%biota_k_elim_dissolved(me%biotaIndex)
+ do f = 1, C%contaminantDim(2)
+ me%k_uptake(f) = DATASET%biota_k_uptake_contaminant(me%biotaIndex, f)
+ me%k_elim(f) = DATASET%biota_k_elim_contaminant(me%biotaIndex, f)
+ end do
+ me%k_uptake(nForms) = DATASET%biota_k_uptake_dissolved(me%biotaIndex)
+ me%k_elim(nForms) = DATASET%biota_k_elim_dissolved(me%biotaIndex)
me%k_growth = DATASET%biota_k_growth(me%biotaIndex)
me%k_death = DATASET%biota_k_death(me%biotaIndex)
me%C_active = DATASET%biotaInitial_C_org(me%biotaIndex)
@@ -128,4 +110,4 @@ function parseInputDataBiotaSoil(me) result(rslt)
me%harvestInMonth = DATASET%biotaHarvestInMonth(me%biotaIndex)
end function
-end module
+end module
\ No newline at end of file
diff --git a/src/Biota/BiotaWaterModule.f90 b/src/Biota/BiotaWaterModule.f90
index 8d8fe38..51f8ace 100644
--- a/src/Biota/BiotaWaterModule.f90
+++ b/src/Biota/BiotaWaterModule.f90
@@ -4,129 +4,85 @@ module BiotaWaterModule
use GlobalsModule
use DataInputModule
use datetime_module
+ use ContaminantModule
implicit none
type, public, extends(AbstractBiota) :: BiotaWater
contains
procedure :: create => createBiotaWater
procedure :: update => updateBiotaWater
- procedure :: parseInputData => parseInputDataBiotaWater
end type
contains
!> Create this water biota instance
function createBiotaWater(me, biotaIndex) result(rslt)
- class(BiotaWater) :: me !! This Water biota instance
+ class(BiotaWater) :: me !! This Water biota instance
integer :: biotaIndex !! Database index for this biota object TODO move to database
- type(Result) :: rslt
- ! Set defaults and ref
+ type(Result) :: rslt
me%ref = "BiotaWater_" // trim(str(biotaIndex))
- me%biotaIndex = biotaIndex
- me%C_stored = 0.0_dp
- ! Get data from input file
- call rslt%addErrors(.errors. me%parseInputData())
- call rslt%addToTrace('Creating Biota') ! Add this procedure to the trace
- ! call LOGR%toFile(errors=.errors. rslt)
+ call rslt%addErrors(.errors. createAbstractBiota(me, biotaIndex)) ! Call parent class's create method
+ call rslt%addToTrace('Creating Biota')
end function
!> Update the water biota on this time step
- function updateBiotaWater(me, t, C_env_np, C_env_transformed, C_env_dissolved) result(rslt)
+ function updateBiotaWater(me, t, C_env_contaminant) result(rslt)
class(BiotaWater) :: me !! This BiotaWater instance
integer :: t !! The current time step
- real(dp) :: C_env_np(:,:,:)
- real(dp) :: C_env_transformed(:,:,:)
- real(dp) :: C_env_dissolved
- type(Result) :: rslt !! The Result object to return errors in
- real(dp) :: C_env_np_sum
- real(dp) :: C_env_transformed_sum
- real(dp) :: gamma_np
- real(dp) :: gamma_transformed
- real(dp) :: gamma_dissolved
- real(dp) :: k_elim
+ type(Contaminant), intent(in) :: C_env_contaminant
+ type(Result) :: rslt
+ real(dp), allocatable :: C_env_sum(:)
+ real(dp), allocatable :: gamma(:)
+ real(dp) :: k_elim_total
type(datetime) :: currentDate
-
- ! Get the current date
+ integer :: f, nForms
+ if (.not. allocated(C_env_contaminant%c)) then
+ call rslt%addError(ErrorInstance(code=105, message="Contaminant array not allocated"))
+ return
+ end if
+ nForms = C%contaminantDim(2) + 1
+ allocate(C_env_sum(nForms), gamma(nForms))
currentDate = C%startDate + timedelta(days=t-1)
- ! If it's the month this harvesting is to occur, set concentrations
- ! to zero
if (me%harvestInMonth == currentDate%getMonth()) then
me%C_active = 0.0_dp
me%C_stored = 0.0_dp
else
- if (trim(me%uptakeFromForm) == 'free') then
- C_env_np_sum = sum(C_env_np(:,:,1))
- C_env_transformed_sum = sum(C_env_transformed(:,:,1))
- else if (trim(me%uptakeFromForm) == 'attached') then
- C_env_np_sum = sum(C_env_np(:,:,3:))
- C_env_transformed_sum = sum(C_env_transformed(:,:,3:))
- else if (trim(me%uptakeFromForm) == 'free_and_attached' &
- .or. trim(me%uptakeFromForm) == 'attached_and_free' &
- .or. trim(me%uptakeFromForm) == 'free_attached' &
- .or. trim(me%uptakeFromForm) == 'attached_free') then
- C_env_np_sum = sum(C_env_np(:,:,:))
- C_env_transformed_sum = sum(C_env_transformed(:,:,:))
- else
- call rslt%addError( &
- ErrorInstance(message = "Sorry, I can't understand the form specified " // &
- "in the uptake_from_form option for this biota. Specified form: " // &
- trim(me%uptakeFromForm) &
- ) &
- )
- call rslt%addToTrace("Updating " // trim(me%ref))
- end if
-
- gamma_np = me%k_uptake_np * (1 - me%storedFraction) * C_env_np_sum &
- / (me%k_elim_np + me%k_growth + me%k_death)
- gamma_transformed = me%k_uptake_transformed * (1 - me%storedFraction) * C_env_transformed_sum &
- / (me%k_elim_transformed + me%k_growth + me%k_death)
- gamma_dissolved = me%k_uptake_dissolved * (1 - me%storedFraction) * C_env_dissolved &
- / (me%k_elim_dissolved + me%k_growth + me%k_death)
- k_elim = me%k_elim_np + me%k_elim_transformed + me%k_elim_dissolved
- ! Calculate C_active, converting time step to days (because rate constants are /day)
- me%C_active = gamma_np + gamma_transformed + gamma_dissolved &
- + (me%C_active - gamma_np - gamma_transformed - gamma_dissolved) &
- * exp(-(k_elim + me%k_growth + me%k_death) * C%timeStep/86400)
-
+ C_env_sum = 0.0_dp
+ select case (trim(me%uptakeFromForm))
+ case ('free')
+ do f = 1, C%contaminantDim(2)
+ C_env_sum(f) = sum(C_env_contaminant%c(:,f,FREE_CONTAMINANT))
+ end do
+ C_env_sum(nForms) = C_env_contaminant%m_dissolved
+ case ('attached')
+ do f = 1, C%contaminantDim(2)
+ C_env_sum(f) = sum(C_env_contaminant%c(:,f,3:)) ! Heteroaggregated states
+ end do
+ case ('free_and_attached', 'attached_and_free', 'free_attached', 'attached_free')
+ do f = 1, C%contaminantDim(2)
+ C_env_sum(f) = sum(C_env_contaminant%c(:,f,:))
+ end do
+ C_env_sum(nForms) = C_env_contaminant%m_dissolved
+ case default
+ call rslt%addError(ErrorInstance(message="Invalid uptake_from_form: "//trim(me%uptakeFromForm)))
+ return
+ end select
+ do f = 1, nForms
+ gamma(f) = me%k_uptake(f) * (1 - me%storedFraction) * C_env_sum(f) / &
+ (me%k_elim(f) + me%k_growth + me%k_death)
+ end do
+ k_elim_total = sum(me%k_elim)
+ me%C_active = sum(gamma) + (me%C_active - sum(gamma)) * &
+ exp(-(k_elim_total + me%k_growth + me%k_death) * C%timeStep/86400)
if (.not. isZero(me%k_growth + me%k_death)) then
- gamma_np = me%k_uptake_np * me%storedFraction * C_env_np_sum &
- / (me%k_growth + me%k_death)
- gamma_transformed = me%k_uptake_transformed * me%storedFraction * C_env_transformed_sum &
- / (me%k_growth + me%k_death)
- gamma_dissolved = me%k_uptake_dissolved * me%storedFraction * C_env_dissolved &
- / (me%k_growth + me%k_death)
- else
- gamma_np = 0.0_dp
- gamma_transformed = 0.0_dp
- gamma_dissolved = 0.0_dp
+ do f = 1, nForms
+ gamma(f) = me%k_uptake(f) * me%storedFraction * C_env_sum(f) / &
+ (me%k_growth + me%k_death)
+ end do
+ me%C_stored = sum(gamma) + (me%C_stored - sum(gamma)) * &
+ exp(-(me%k_growth + me%k_death) * C%timeStep/86400)
end if
-
- me%C_stored = gamma_np + gamma_transformed + gamma_dissolved &
- + (me%C_stored - gamma_np - gamma_transformed - gamma_dissolved) &
- * exp(-(me%k_growth + me%k_death) * C%timeStep/86400)
end if
-
- end function
-
- !> Parse the input data for this water biota
- function parseInputDataBiotaWater(me) result(rslt)
- class(BiotaWater) :: me
- type(Result) :: rslt
- ! Get rates from database. TODO deprecate in favour of using directly
- ! to save memory
- me%name = DATASET%biotaName(me%biotaIndex)
- me%k_uptake_np = DATASET%biota_k_uptake_np(me%biotaIndex)
- me%k_uptake_transformed = DATASET%biota_k_uptake_transformed(me%biotaIndex)
- me%k_uptake_dissolved = DATASET%biota_k_uptake_dissolved(me%biotaIndex)
- me%k_elim_np = DATASET%biota_k_elim_np(me%biotaIndex)
- me%k_elim_transformed = DATASET%biota_k_elim_transformed(me%biotaIndex)
- me%k_elim_dissolved = DATASET%biota_k_elim_dissolved(me%biotaIndex)
- me%k_growth = DATASET%biota_k_growth(me%biotaIndex)
- me%k_death = DATASET%biota_k_death(me%biotaIndex)
- me%C_active = DATASET%biotaInitial_C_org(me%biotaIndex) ! TODO make possible to input C_init_stored too
- me%storedFraction = DATASET%biotaStoredFraction(me%biotaIndex)
- me%uptakeFromForm = DATASET%biotaUptakeFromForm(me%biotaIndex)
- me%harvestInMonth = DATASET%biotaHarvestInMonth(me%biotaIndex)
end function
-end module
+end module
\ No newline at end of file
diff --git a/src/CheckpointModule.f90 b/src/CheckpointModule.f90
index f573d08..3d6349c 100644
--- a/src/CheckpointModule.f90
+++ b/src/CheckpointModule.f90
@@ -9,167 +9,144 @@ module CheckpointModule
use ErrorInstanceModule
use ResultModule
use UtilModule
+ use ContaminantModule
+ use WaterBodyModule
+ use SoilProfileModule
+ use BedSedimentModule
implicit none
private
type, public :: Checkpoint
- type(EnvironmentPointer) :: env !! Pointer to the environment, to pull state variables from
- character(len=256) :: checkpointFile !! Path to the checkpoint file to dump state variables to
-
- contains
- procedure, public :: init => init
- procedure, public :: save => save
- procedure, public :: reinstate => reinstate
+ type(EnvironmentPointer) :: env
+ character(len=256) :: checkpointFile
+ contains
+ procedure, public :: init => initCheckpoint
+ procedure, public :: save => saveCheckpoint
+ procedure, public :: reinstate => reinstateCheckpoint
end type
- contains
-
- !> Initialise the Checkpoint module
- subroutine init(me, env, checkpointFile)
- class(Checkpoint) :: me !! This Checkpoint instance
- type(Environment), target :: env !! Pointer to the Environment object
- character(len=*) :: checkpointFile !! Path to the checkpoint file
- ! Point to the environment object
+contains
+ subroutine initCheckpoint(me, env, checkpointFile)
+ class(Checkpoint) :: me
+ type(Environment), target :: env
+ character(len=*) :: checkpointFile
me%env%item => env
- ! Store the checkpoint file path
me%checkpointFile = checkpointFile
end subroutine
- !> Create a checkpoint by saving the current dynamic state of the model to file.
- !! This routine loops through all grid cells and their compartments, constructs
- !! spatial arrays of dynamic variables (through which are passed between timesteps)
- !! and saves these to a binary checkpoint file
- subroutine save(me, t)
- class(Checkpoint) :: me !! This Checkpoint instance
- integer :: t !! The current timestep
- integer :: i, j, k, l, m ! Iterators
- ! Variables to save
- ! TODO allow multiple soil profiles
- ! Soil profile
- real(dp) :: soilProfile_m_np(DATASET%gridShape(1), DATASET%gridShape(2), 1, C%npDim(1), C%npDim(2), C%npDim(3))
- real(dp) :: soilProfile_m_transformed(DATASET%gridShape(1), DATASET%gridShape(2), 1, C%npDim(1), C%npDim(2), C%npDim(3))
- real(dp) :: soilProfile_m_dissolved(DATASET%gridShape(1), DATASET%gridShape(2), 1)
- ! Soil layers
- real(dp) :: soilLayer_m_np(DATASET%gridShape(1), DATASET%gridShape(2), 1, C%nSoilLayers, C%npDim(1), C%npDim(2), C%npDim(3))
- real(dp) :: soilLayer_m_transformed(DATASET%gridShape(1), DATASET%gridShape(2), 1, &
- C%nSoilLayers, C%npDim(1), C%npDim(2), C%npDim(3))
- real(dp) :: soilLayer_m_dissolved(DATASET%gridShape(1), DATASET%gridShape(2), 1, C%nSoilLayers)
- real(dp) :: soilLayer_V_w(DATASET%gridShape(1), DATASET%gridShape(2), 1, C%nSoilLayers)
- ! Waterbodies
- real(dp) :: water_volume(DATASET%gridShape(1), DATASET%gridShape(2), maxval(DATASET%nWaterbodies))
- real(dp) :: water_bedArea(DATASET%gridShape(1), DATASET%gridShape(2), maxval(DATASET%nWaterbodies))
- real(dp) :: water_Q(5, maxval(DATASET%nWaterbodies), DATASET%gridShape(1), DATASET%gridShape(2))
- real(dp) :: water_Q_final(5, maxval(DATASET%nWaterbodies), DATASET%gridShape(1), DATASET%gridShape(2))
- real(dp) :: water_j_spm(8, C%nSizeClassesSPM, maxval(DATASET%nWaterbodies), DATASET%gridShape(1), DATASET%gridShape(2))
- real(dp) :: water_j_spm_final(8, C%nSizeClassesSPM, maxval(DATASET%nWaterbodies), &
- DATASET%gridShape(1), DATASET%gridShape(2))
- real(dp) :: water_j_np(10, C%npDim(1), C%npDim(2), C%npDim(3), maxval(DATASET%nWaterbodies), &
- DATASET%gridShape(1), DATASET%gridShape(2))
- real(dp) :: water_j_np_final(10, C%npDim(1), C%npDim(2), C%npDim(3), maxval(DATASET%nWaterbodies), &
- DATASET%gridShape(1), DATASET%gridShape(2))
- real(dp) :: water_j_transformed(10, C%npDim(1), C%npDim(2), C%npDim(3), maxval(DATASET%nWaterbodies), &
- DATASET%gridShape(1), DATASET%gridShape(2))
- real(dp) :: water_j_transformed_final(10, C%npDim(1), C%npDim(2), C%npDim(3), maxval(DATASET%nWaterbodies), &
- DATASET%gridShape(1), DATASET%gridShape(2))
- real(dp) :: water_j_dissolved(6, maxval(DATASET%nWaterbodies), DATASET%gridShape(1), DATASET%gridShape(2))
- real(dp) :: water_j_dissolved_final(6, maxval(DATASET%nWaterbodies), DATASET%gridShape(1), DATASET%gridShape(2))
- real(dp) :: water_m_spm(C%nSizeClassesSpm, maxval(DATASET%nWaterbodies), DATASET%gridShape(1), DATASET%gridShape(2))
- real(dp) :: water_m_np(C%npDim(1), C%npDim(2), C%npDim(3), maxval(DATASET%nWaterbodies), &
- DATASET%gridShape(1), DATASET%gridShape(2))
- real(dp) :: water_m_transformed(C%npDim(1), C%npDim(2), C%npDim(3), maxval(DATASET%nWaterbodies), &
- DATASET%gridShape(1), DATASET%gridShape(2))
- real(dp) :: water_m_dissolved(maxval(DATASET%nWaterbodies), DATASET%gridShape(1), DATASET%gridShape(2))
- ! Sediment
- real(dp) :: sediment_m_np(DATASET%gridShape(1), DATASET%gridShape(2), &
- maxval(DATASET%nWaterbodies), C%nSedimentLayers + 3, C%npDim(1), C%npDim(2), C%npDim(3))
- real(dp) :: sedimentLayer_M_f(DATASET%gridShape(1), DATASET%gridShape(2), &
- maxval(DATASET%nWaterbodies), C%nSedimentLayers, C%nSizeClassesSpm)
- real(dp) :: sedimentLayer_M_f_backup(DATASET%gridShape(1), DATASET%gridShape(2), &
- maxval(DATASET%nWaterbodies), C%nSedimentLayers, C%nSizeClassesSpm)
- real(dp) :: sedimentLayer_V_w(DATASET%gridShape(1), DATASET%gridShape(2), &
- maxval(DATASET%nWaterbodies), C%nSedimentLayers, C%nSizeClassesSpm)
- real(dp) :: sedimentLayer_f_comp(DATASET%gridShape(1), DATASET%gridShape(2), &
- maxval(DATASET%nWaterbodies), C%nSedimentLayers, C%nSizeClassesSpm, C%nFracCompsSpm)
- real(dp) :: sedimentLayer_pd_comp(DATASET%gridShape(1), DATASET%gridShape(2), &
- maxval(DATASET%nWaterbodies), C%nSedimentLayers, C%nSizeClassesSpm, C%nFracCompsSpm)
+ subroutine saveCheckpoint(me, t)
+ class(Checkpoint) :: me
+ integer, intent(in) :: t
+ integer :: i, j, k, l, m, alloc_stat
+ real(dp), allocatable :: soilProfile_contaminant(:,:,:,:,:,:)
+ real(dp), allocatable :: soilProfile_m_dissolved(:,:,:)
+ real(dp), allocatable :: soilLayer_contaminant(:,:,:,:,:,:,:)
+ real(dp), allocatable :: soilLayer_m_dissolved(:,:,:,:)
+ real(dp), allocatable :: soilLayer_V_w(:,:,:,:)
+ real(dp), allocatable :: waterBody_contaminant(:,:,:,:,:,:)
+ real(dp), allocatable :: waterBody_m_dissolved(:,:,:)
+ real(dp), allocatable :: waterBody_volume(:,:,:)
+ real(dp), allocatable :: waterBody_bedArea(:,:,:)
+ real(dp), allocatable :: waterBody_Q(:,:,:,:)
+ real(dp), allocatable :: waterBody_Q_final(:,:,:,:)
+ real(dp), allocatable :: waterBody_j_spm(:,:,:,:,:)
+ real(dp), allocatable :: waterBody_j_spm_final(:,:,:,:,:)
+ real(dp), allocatable :: bedSediment_contaminant(:,:,:,:,:,:,:)
+ real(dp), allocatable :: bedSediment_m_dissolved(:,:,:,:)
+ real(dp), allocatable :: sedimentLayer_M_f(:,:,:,:,:)
+ real(dp), allocatable :: sedimentLayer_M_f_backup(:,:,:,:,:)
+ real(dp), allocatable :: sedimentLayer_V_w(:,:,:,:,:)
+ real(dp), allocatable :: sedimentLayer_f_comp(:,:,:,:,:,:)
+ real(dp), allocatable :: sedimentLayer_pd_comp(:,:,:,:,:,:)
+ character(len=256) :: tr
+ tr = "Checkpoint%saveCheckpoint"
- ! There will be empty elements in the water arrays, as the number of waterbodies, inflows and emissions
- ! varies between each grid cell. So, set to zero so we're at least storing a small number
- water_Q = 0.0_dp
- water_Q_final = 0.0_dp
- water_j_spm = 0.0_dp
- water_j_spm_final = 0.0_dp
- water_j_np = 0.0_dp
- water_j_np_final = 0.0_dp
- water_j_transformed = 0.0_dp
- water_j_transformed_final = 0.0_dp
- water_j_dissolved = 0.0_dp
- water_j_dissolved_final = 0.0_dp
- water_m_spm = 0.0_dp
- water_m_np = 0.0_dp
- water_m_transformed = 0.0_dp
- water_m_dissolved = 0.0_dp
+ allocate(soilProfile_contaminant(DATASET%gridShape(1), DATASET%gridShape(2), 1, &
+ C%contaminantDim(1), C%contaminantDim(2), C%contaminantDim(3)), &
+ soilProfile_m_dissolved(DATASET%gridShape(1), DATASET%gridShape(2), 1), &
+ soilLayer_contaminant(DATASET%gridShape(1), DATASET%gridShape(2), 1, C%nSoilLayers, &
+ C%contaminantDim(1), C%contaminantDim(2), C%contaminantDim(3)), &
+ soilLayer_m_dissolved(DATASET%gridShape(1), DATASET%gridShape(2), 1, C%nSoilLayers), &
+ soilLayer_V_w(DATASET%gridShape(1), DATASET%gridShape(2), 1, C%nSoilLayers), &
+ waterBody_contaminant(DATASET%gridShape(1), DATASET%gridShape(2), maxval(DATASET%nWaterbodies), &
+ C%contaminantDim(1), C%contaminantDim(2), C%contaminantDim(3)), &
+ waterBody_m_dissolved(DATASET%gridShape(1), DATASET%gridShape(2), maxval(DATASET%nWaterbodies)), &
+ waterBody_volume(DATASET%gridShape(1), DATASET%gridShape(2), maxval(DATASET%nWaterbodies)), &
+ waterBody_bedArea(DATASET%gridShape(1), DATASET%gridShape(2), maxval(DATASET%nWaterbodies)), &
+ waterBody_Q(5, maxval(DATASET%nWaterbodies), DATASET%gridShape(1), DATASET%gridShape(2)), &
+ waterBody_Q_final(5, maxval(DATASET%nWaterbodies), DATASET%gridShape(1), DATASET%gridShape(2)), &
+ waterBody_j_spm(8, C%nSizeClassesSpm, maxval(DATASET%nWaterbodies), DATASET%gridShape(1), DATASET%gridShape(2)), &
+ waterBody_j_spm_final(8, C%nSizeClassesSpm, maxval(DATASET%nWaterbodies), &
+ DATASET%gridShape(1), DATASET%gridShape(2)), &
+ bedSediment_contaminant(DATASET%gridShape(1), DATASET%gridShape(2), maxval(DATASET%nWaterbodies), &
+ C%nSedimentLayers+3, C%contaminantDim(1), C%contaminantDim(2), C%contaminantDim(3)), &
+ bedSediment_m_dissolved(DATASET%gridShape(1), DATASET%gridShape(2), maxval(DATASET%nWaterbodies), &
+ C%nSedimentLayers+3), &
+ sedimentLayer_M_f(DATASET%gridShape(1), DATASET%gridShape(2), maxval(DATASET%nWaterbodies), &
+ C%nSedimentLayers, C%nSizeClassesSpm), &
+ sedimentLayer_M_f_backup(DATASET%gridShape(1), DATASET%gridShape(2), maxval(DATASET%nWaterbodies), &
+ C%nSedimentLayers, C%nSizeClassesSpm), &
+ sedimentLayer_V_w(DATASET%gridShape(1), DATASET%gridShape(2), maxval(DATASET%nWaterbodies), &
+ C%nSedimentLayers, C%nSizeClassesSpm), &
+ sedimentLayer_f_comp(DATASET%gridShape(1), DATASET%gridShape(2), maxval(DATASET%nWaterbodies), &
+ C%nSedimentLayers, C%nSizeClassesSpm, C%nFracCompsSpm), &
+ sedimentLayer_pd_comp(DATASET%gridShape(1), DATASET%gridShape(2), maxval(DATASET%nWaterbodies), &
+ C%nSedimentLayers, C%nSizeClassesSpm, C%nFracCompsSpm), &
+ stat=alloc_stat)
+ if (alloc_stat /= 0) call ERROR_HANDLER%trigger(error=ErrorInstance(message="Checkpoint allocation failed", trace=[tr]))
- ! Open the binary checkpoint file, opting to replace any existing contents
- open(iouCheckpoint, &
- file=trim(me%checkpointFile), &
- form='unformatted', &
- status='replace')
+ soilProfile_contaminant = 0.0_dp
+ soilProfile_m_dissolved = 0.0_dp
+ soilLayer_contaminant = 0.0_dp
+ soilLayer_m_dissolved = 0.0_dp
+ soilLayer_V_w = 0.0_dp
+ waterBody_contaminant = 0.0_dp
+ waterBody_m_dissolved = 0.0_dp
+ waterBody_volume = 0.0_dp
+ waterBody_bedArea = 0.0_dp
+ waterBody_Q = 0.0_dp
+ waterBody_Q_final = 0.0_dp
+ waterBody_j_spm = 0.0_dp
+ waterBody_j_spm_final = 0.0_dp
+ bedSediment_contaminant = 0.0_dp
+ bedSediment_m_dissolved = 0.0_dp
+ sedimentLayer_M_f = 0.0_dp
+ sedimentLayer_M_f_backup = 0.0_dp
+ sedimentLayer_V_w = 0.0_dp
+ sedimentLayer_f_comp = 0.0_dp
+ sedimentLayer_pd_comp = 0.0_dp
- ! Now we need to get spatial arrays of the state variables to save from the
- ! different compartments. We will do the looping through grid cells here
- ! as opposed to in the environment class, so that it's all done within the
- ! same loop. Non-dynamic data will be re-created from input data on restart,
- ! so we only save variables that alter on each time step here
- do j = 1, size(me%env%item%colGridCells, dim=2)
- do i = 1, size(me%env%item%colGridCells, dim=1)
+ do j = 1, DATASET%gridShape(2)
+ do i = 1, DATASET%gridShape(1)
associate (cell => me%env%item%colGridCells(i,j)%item)
-
- ! Soil
do k = 1, cell%nSoilProfiles
associate (profile => cell%colSoilProfiles(k)%item)
- ! Soil profile dynamic properties
- soilProfile_m_np(i,j,k,:,:,:) = profile%m_np
- soilProfile_m_transformed(i,j,k,:,:,:) = profile%m_transformed
- soilProfile_m_dissolved(i,j,k) = profile%m_dissolved
+ soilProfile_contaminant(i,j,k,:,:,:) = profile%m_contaminant%c
+ soilProfile_m_dissolved(i,j,k) = profile%m_contaminant%m_dissolved
do l = 1, C%nSoilLayers
associate (layer => profile%colSoilLayers(l)%item)
- ! Soil layer dynamic properties
- soilLayer_m_np(i,j,k,l,:,:,:) = layer%m_np
- soilLayer_m_transformed(i,j,k,l,:,:,:) = layer%m_transformed
- soilLayer_m_dissolved(i,j,k,l) = layer%m_dissolved
+ soilLayer_contaminant(i,j,k,l,:,:,:) = layer%m_contaminant%c
+ soilLayer_m_dissolved(i,j,k,l) = layer%m_contaminant%m_dissolved
soilLayer_V_w(i,j,k,l) = layer%V_w
end associate
end do
- ! TODO soil biota
end associate
end do
-
- ! Water
do k = 1, cell%nReaches
associate (water => cell%colRiverReaches(k)%item)
- ! Waterbody dynamic properties
- water_volume(i,j,k) = water%volume
- water_bedArea(i,j,k) = water%bedArea
- water_Q(:,k,i,j) = water%Q%asArray()
- water_Q_final(:,k,i,j) = water%Q_final%asArray()
- water_j_spm(:,:,k,i,j) = water%j_spm%asArray()
- water_j_spm_final(:,:,k,i,j) = water%j_spm_final%asArray()
- water_j_np(:,:,:,:,k,i,j) = water%j_nm%asArray()
- water_j_np_final(:,:,:,:,k,i,j) = water%j_nm_final%asArray()
- water_j_transformed(:,:,:,:,k,i,j) = water%j_nm_transformed%asArray()
- water_j_transformed_final(:,:,:,:,k,i,j) = water%j_nm_transformed_final%asArray()
- water_j_dissolved(:,k,i,j) = water%j_dissolved%asArray()
- water_j_dissolved_final(:,k,i,j) = water%j_dissolved_final%asArray()
- water_m_spm(:,k,i,j) = water%m_spm
- water_m_np(:,:,:,k,i,j) = water%m_np
- water_m_transformed(:,:,:,k,i,j) = water%m_transformed
- water_m_dissolved(k,i,j) = water%m_dissolved
-
- ! Sediment
+ waterBody_contaminant(i,j,k,:,:,:) = water%reactor%contaminant%c
+ waterBody_m_dissolved (i,j,k) = water%reactor%contaminant%m_dissolved
+ waterBody_volume(i,j,k) = water%volume
+ waterBody_bedArea(i,j,k) = water%bedArea
+ waterBody_Q(:,k,i,j) = water%Q%asArray()
+ waterBody_Q_final(:,k,i,j) = water%Q_final%asArray()
+ waterBody_j_spm(:,:,k,i,j) = water%j_spm%asArray()
+ waterBody_j_spm_final(:,:,k,i,j) = water%j_spm_final%asArray()
associate (sediment => water%bedSediment)
- sediment_m_np(i,j,k,:,:,:,:) = sediment%M_np
- ! Sediment layers
+ do l = 1, C%nSedimentLayers+3
+ bedSediment_contaminant(i,j,k,l,:,:,:) = sediment%m_contaminant(l)%c
+ bedSediment_m_dissolved(i,j,k,l) = sediment%m_contaminant(l)%m_dissolved
+ end do
do l = 1, C%nSedimentLayers
associate (layer => sediment%colBedSedimentLayers(l)%item)
do m = 1, C%nSizeClassesSpm
@@ -184,213 +161,167 @@ subroutine save(me, t)
end associate
end associate
end do
-
end associate
end do
end do
- ! Grid properties, used to check this checkpoint is compatible with the model run we want to reinstate it to
+ open(iouCheckpoint, file=trim(me%checkpointFile), form='unformatted', status='replace')
write(iouCheckpoint) DATASET%gridBounds, DATASET%gridRes
- ! Write the timestep first, in case we want to use that to resume the model run from
write(iouCheckpoint) t
- ! Now the compartment specific stuff we obtained above
- write(iouCheckpoint) soilProfile_m_np, soilProfile_m_transformed, soilProfile_m_dissolved
- write(iouCheckpoint) soilLayer_m_np, soilLayer_m_transformed, soilLayer_m_dissolved, soilLayer_V_w
- write(iouCheckpoint) water_volume, water_bedArea, water_Q, water_Q_final, water_j_spm, water_j_spm_final, &
- water_j_np, water_j_np_final, water_j_transformed, water_j_transformed_final, water_j_dissolved, &
- water_j_dissolved_final, water_m_spm, water_m_np, water_m_transformed, water_m_dissolved
- write(iouCheckpoint) sediment_m_np, sedimentLayer_M_f, sedimentLayer_M_f_backup, sedimentLayer_V_w, &
- sedimentLayer_f_comp, sedimentLayer_pd_comp
- ! Close the file
+ write(iouCheckpoint) soilProfile_contaminant, soilProfile_m_dissolved
+ write(iouCheckpoint) soilLayer_contaminant, soilLayer_m_dissolved, soilLayer_V_w
+ write(iouCheckpoint) waterBody_contaminant, waterBody_m_dissolved, waterBody_volume, waterBody_bedArea, &
+ waterBody_Q, waterBody_Q_final, waterBody_j_spm, waterBody_j_spm_final
+ write(iouCheckpoint) bedSediment_contaminant, bedSediment_m_dissolved, sedimentLayer_M_f, &
+ sedimentLayer_M_f_backup, sedimentLayer_V_w, sedimentLayer_f_comp, sedimentLayer_pd_comp
close(iouCheckpoint)
-
- ! Log that we've successfully created a checkpoint
+
call LOGR%toConsole('Saving checkpoint to '//trim(me%checkpointFile)//': '//COLOR_GREEN//'success'//COLOR_RESET)
call LOGR%toFile('Saving checkpoint to '//trim(me%checkpointFile)//': success')
-
end subroutine
- !> Reinstate the model run from the checkpoint file
- subroutine reinstate(me, preserve_timestep)
- class(Checkpoint) :: me !! This Checkpoint instance
- logical, optional :: preserve_timestep !! Should the restarted run preserve the model timestep at the end of saved run?
- integer :: i, j, k, l, m ! Iterators
- integer :: ioStat ! IO status, for checking the checkpoint file
- integer :: t ! Timestep
- real :: gridRes(2), gridBounds(4) ! Grid properties, for checking the checkpoint is compatible with this model run
- ! Soil profile
- real(dp) :: soilProfile_m_np(DATASET%gridShape(1), DATASET%gridShape(2), 1, C%npDim(1), C%npDim(2), C%npDim(3)) ! TODO allow multiple soil profiles
- real(dp) :: soilProfile_m_transformed(DATASET%gridShape(1), DATASET%gridShape(2), 1, C%npDim(1), C%npDim(2), C%npDim(3)) ! TODO allow multiple soil profiles
- real(dp) :: soilProfile_m_dissolved(DATASET%gridShape(1), DATASET%gridShape(2), 1) ! TODO allow multiple soil profiles
- ! Soil layers
- real(dp) :: soilLayer_m_np(DATASET%gridShape(1), DATASET%gridShape(2), 1, C%nSoilLayers, C%npDim(1), C%npDim(2), C%npDim(3))
- real(dp) :: soilLayer_m_transformed(DATASET%gridShape(1), DATASET%gridShape(2), 1, &
- C%nSoilLayers, C%npDim(1), C%npDim(2), C%npDim(3))
- real(dp) :: soilLayer_m_dissolved(DATASET%gridShape(1), DATASET%gridShape(2), 1, C%nSoilLayers)
- real(dp) :: soilLayer_V_w(DATASET%gridShape(1), DATASET%gridShape(2), 1, C%nSoilLayers)
- ! Water
- real(dp) :: water_volume(DATASET%gridShape(1), DATASET%gridShape(2), maxval(DATASET%nWaterbodies))
- real(dp) :: water_bedArea(DATASET%gridShape(1), DATASET%gridShape(2), maxval(DATASET%nWaterbodies))
- real(dp) :: water_Q(5, maxval(DATASET%nWaterbodies), DATASET%gridShape(1), DATASET%gridShape(2))
- real(dp) :: water_Q_final(5, maxval(DATASET%nWaterbodies), DATASET%gridShape(1), DATASET%gridShape(2))
- real(dp) :: water_j_spm(8, C%nSizeClassesSPM, maxval(DATASET%nWaterbodies), DATASET%gridShape(1), DATASET%gridShape(2))
- real(dp) :: water_j_spm_final(8, C%nSizeClassesSPM, maxval(DATASET%nWaterbodies), &
- DATASET%gridShape(1), DATASET%gridShape(2))
- real(dp) :: water_j_np(10, C%npDim(1), C%npDim(2), C%npDim(3), maxval(DATASET%nWaterbodies), &
- DATASET%gridShape(1), DATASET%gridShape(2))
- real(dp) :: water_j_np_final(10, C%npDim(1), C%npDim(2), C%npDim(3), maxval(DATASET%nWaterbodies), &
- DATASET%gridShape(1), DATASET%gridShape(2))
- real(dp) :: water_j_transformed(10, C%npDim(1), C%npDim(2), C%npDim(3), maxval(DATASET%nWaterbodies), &
- DATASET%gridShape(1), DATASET%gridShape(2))
- real(dp) :: water_j_transformed_final(10, C%npDim(1), C%npDim(2), C%npDim(3), maxval(DATASET%nWaterbodies), &
- DATASET%gridShape(1), DATASET%gridShape(2))
- real(dp) :: water_j_dissolved(DATASET%gridShape(1), DATASET%gridShape(2), &
- maxval(DATASET%nWaterbodies), 6)
- real(dp) :: water_j_dissolved_final(DATASET%gridShape(1), DATASET%gridShape(2), &
- maxval(DATASET%nWaterbodies), 6)
- real(dp) :: water_m_spm(C%nSizeClassesSPM, maxval(DATASET%nWaterbodies), DATASET%gridShape(1), DATASET%gridShape(2))
- real(dp) :: water_m_np(C%npDim(1), C%npDim(2), C%npDim(3), maxval(DATASET%nWaterbodies), &
- DATASET%gridShape(1), DATASET%gridShape(2))
- real(dp) :: water_m_transformed(C%npDim(1), C%npDim(2), C%npDim(3), maxval(DATASET%nWaterbodies), &
- DATASET%gridShape(1), DATASET%gridShape(2))
- real(dp) :: water_m_dissolved(maxval(DATASET%nWaterbodies), DATASET%gridShape(1), DATASET%gridShape(2))
- ! Sediment
- real(dp) :: sediment_m_np(DATASET%gridShape(1), DATASET%gridShape(2), &
- maxval(DATASET%nWaterbodies), C%nSedimentLayers + 3, C%npDim(1), C%npDim(2), C%npDim(3))
- real(dp) :: sedimentLayer_M_f(DATASET%gridShape(1), DATASET%gridShape(2), &
- maxval(DATASET%nWaterbodies), C%nSedimentLayers, C%nSizeClassesSpm)
- real(dp) :: sedimentLayer_M_f_backup(DATASET%gridShape(1), DATASET%gridShape(2), &
- maxval(DATASET%nWaterbodies), C%nSedimentLayers, C%nSizeClassesSpm)
- real(dp) :: sedimentLayer_V_w(DATASET%gridShape(1), DATASET%gridShape(2), &
- maxval(DATASET%nWaterbodies), C%nSedimentLayers, C%nSizeClassesSpm)
- real(dp) :: sedimentLayer_f_comp(DATASET%gridShape(1), DATASET%gridShape(2), &
- maxval(DATASET%nWaterbodies), C%nSedimentLayers, C%nSizeClassesSpm, C%nFracCompsSpm)
- real(dp) :: sedimentLayer_pd_comp(DATASET%gridShape(1), DATASET%gridShape(2), &
- maxval(DATASET%nWaterbodies), C%nSedimentLayers, C%nSizeClassesSpm, C%nFracCompsSpm)
+ subroutine reinstateCheckpoint(me, preserve_timestep)
+ class(Checkpoint) :: me
+ logical, optional :: preserve_timestep
+ integer :: i, j, k, l, m, ioStat, alloc_stat
+ real :: gridRes(2), gridBounds(4)
+ real(dp), allocatable :: soilProfile_contaminant(:,:,:,:,:,:)
+ real(dp), allocatable :: soilProfile_m_dissolved(:,:,:)
+ real(dp), allocatable :: soilLayer_contaminant(:,:,:,:,:,:,:)
+ real(dp), allocatable :: soilLayer_m_dissolved(:,:,:,:)
+ real(dp), allocatable :: soilLayer_V_w(:,:,:,:)
+ real(dp), allocatable :: waterBody_contaminant(:,:,:,:,:,:)
+ real(dp), allocatable :: waterBody_m_dissolved(:,:,:)
+ real(dp), allocatable :: waterBody_volume(:,:,:)
+ real(dp), allocatable :: waterBody_bedArea(:,:,:)
+ real(dp), allocatable :: waterBody_Q(:,:,:,:)
+ real(dp), allocatable :: waterBody_Q_final(:,:,:,:)
+ real(dp), allocatable :: waterBody_j_spm(:,:,:,:,:)
+ real(dp), allocatable :: waterBody_j_spm_final(:,:,:,:,:)
+ real(dp), allocatable :: bedSediment_contaminant(:,:,:,:,:,:,:)
+ real(dp), allocatable :: bedSediment_m_dissolved(:,:,:,:)
+ real(dp), allocatable :: sedimentLayer_M_f(:,:,:,:,:)
+ real(dp), allocatable :: sedimentLayer_M_f_backup(:,:,:,:,:)
+ real(dp), allocatable :: sedimentLayer_V_w(:,:,:,:,:)
+ real(dp), allocatable :: sedimentLayer_f_comp(:,:,:,:,:,:)
+ real(dp), allocatable :: sedimentLayer_pd_comp(:,:,:,:,:,:)
+ integer :: t
+ character(len=256) :: tr
+ tr = "Checkpoint%reinstateCheckpoint"
- ! If preserve timestep not present, then default to false
- if (.not. present(preserve_timestep)) preserve_timestep = .false.
+ allocate(soilProfile_contaminant(DATASET%gridShape(1), DATASET%gridShape(2), 1, &
+ C%contaminantDim(1), C%contaminantDim(2), C%contaminantDim(3)), &
+ soilProfile_m_dissolved(DATASET%gridShape(1), DATASET%gridShape(2), 1), &
+ soilLayer_contaminant(DATASET%gridShape(1), DATASET%gridShape(2), 1, C%nSoilLayers, &
+ C%contaminantDim(1), C%contaminantDim(2), C%contaminantDim(3)), &
+ soilLayer_m_dissolved(DATASET%gridShape(1), DATASET%gridShape(2), 1, C%nSoilLayers), &
+ soilLayer_V_w(DATASET%gridShape(1), DATASET%gridShape(2), 1, C%nSoilLayers), &
+ waterBody_contaminant(DATASET%gridShape(1), DATASET%gridShape(2), maxval(DATASET%nWaterbodies), &
+ C%contaminantDim(1), C%contaminantDim(2), C%contaminantDim(3)), &
+ waterBody_m_dissolved(DATASET%gridShape(1), DATASET%gridShape(2), maxval(DATASET%nWaterbodies)), &
+ waterBody_volume(DATASET%gridShape(1), DATASET%gridShape(2), maxval(DATASET%nWaterbodies)), &
+ waterBody_bedArea(DATASET%gridShape(1), DATASET%gridShape(2), maxval(DATASET%nWaterbodies)), &
+ waterBody_Q(5, maxval(DATASET%nWaterbodies), DATASET%gridShape(1), DATASET%gridShape(2)), &
+ waterBody_Q_final(5, maxval(DATASET%nWaterbodies), DATASET%gridShape(1), DATASET%gridShape(2)), &
+ waterBody_j_spm(8, C%nSizeClassesSpm, maxval(DATASET%nWaterbodies), DATASET%gridShape(1), DATASET%gridShape(2)), &
+ waterBody_j_spm_final(8, C%nSizeClassesSpm, maxval(DATASET%nWaterbodies), &
+ DATASET%gridShape(1), DATASET%gridShape(2)), &
+ bedSediment_contaminant(DATASET%gridShape(1), DATASET%gridShape(2), maxval(DATASET%nWaterbodies), &
+ C%nSedimentLayers+3, C%contaminantDim(1), C%contaminantDim(2), C%contaminantDim(3)), &
+ bedSediment_m_dissolved(DATASET%gridShape(1), DATASET%gridShape(2), maxval(DATASET%nWaterbodies), &
+ C%nSedimentLayers+3), &
+ sedimentLayer_M_f(DATASET%gridShape(1), DATASET%gridShape(2), maxval(DATASET%nWaterbodies), &
+ C%nSedimentLayers, C%nSizeClassesSpm), &
+ sedimentLayer_M_f_backup(DATASET%gridShape(1), DATASET%gridShape(2), maxval(DATASET%nWaterbodies), &
+ C%nSedimentLayers, C%nSizeClassesSpm), &
+ sedimentLayer_V_w(DATASET%gridShape(1), DATASET%gridShape(2), maxval(DATASET%nWaterbodies), &
+ C%nSedimentLayers, C%nSizeClassesSpm), &
+ sedimentLayer_f_comp(DATASET%gridShape(1), DATASET%gridShape(2), maxval(DATASET%nWaterbodies), &
+ C%nSedimentLayers, C%nSizeClassesSpm, C%nFracCompsSpm), &
+ sedimentLayer_pd_comp(DATASET%gridShape(1), DATASET%gridShape(2), maxval(DATASET%nWaterbodies), &
+ C%nSedimentLayers, C%nSizeClassesSpm, C%nFracCompsSpm), &
+ stat=alloc_stat)
+ if (alloc_stat /= 0) call ERROR_HANDLER%trigger(error=ErrorInstance(message="Checkpoint allocation failed", trace=[tr]))
- ! Open the checkpoint file, read in the grid properties and use these to check if the checkpoint file
- ! is compatible with the current grid setup
open(iouCheckpoint, file=trim(me%checkpointFile), form='unformatted', status='old')
- read(iouCheckpoint) gridBounds, gridRes
-
+ read(iouCheckpoint, iostat=ioStat) gridBounds, gridRes
+ if (ioStat /= 0) call ERROR_HANDLER%trigger(error=ErrorInstance(message="Error reading grid properties", trace=[tr]))
if (any(abs(gridBounds - DATASET%gridBounds) > C%epsilon)) then
- call ERROR_HANDLER%trigger( &
- error=ErrorInstance(message="Grid bounds of checkpoint and current simulation do not match. " // &
- "Grid setup must be identical to reinstate a checkpoint. Checkpoint bounds: " // &
- trim(adjustl(str(gridBounds))) // ". Simulation bounds: " // trim(adjustl(str(DATASET%gridBounds))) // ".") &
- )
- else if (any(abs(gridRes - DATASET%gridRes) > C%epsilon)) then
- call ERROR_HANDLER%trigger( &
- error=ErrorInstance(message="Grid resolution of checkpoint and current simulation do not match. " // &
- "Grid setup must be identical to reinstate a checkpoint. Checkpoint resolution: " // &
- trim(adjustl(str(gridRes))) // ". Simulation resolution: " // trim(adjustl(str(DATASET%gridRes))) // ".") &
- )
+ call ERROR_HANDLER%trigger(error=ErrorInstance(message="Grid bounds mismatch. Checkpoint: " // &
+ trim(adjustl(str(gridBounds))) // ". Simulation: " // trim(adjustl(str(DATASET%gridBounds))), trace=[tr]))
end if
-
- read(iouCheckpoint) t
- read(iouCheckpoint, iostat=ioStat) soilProfile_m_np, soilProfile_m_transformed, soilProfile_m_dissolved
- ! If there is a read error, it's likely the geographical scenario is different
- if (ioStat /= 0) then
- print *, ioStat
- call ERROR_HANDLER%trigger( &
- error=ErrorInstance(message="Error reading from checkpoint file. Are you sure the checkpoint you " // &
- "are trying to reinstate is the same geographical scenario as this model run?") &
- )
+ if (any(abs(gridRes - DATASET%gridRes) > C%epsilon)) then
+ call ERROR_HANDLER%trigger(error=ErrorInstance(message="Grid resolution mismatch. Checkpoint: " // &
+ trim(adjustl(str(gridRes))) // ". Simulation: " // trim(adjustl(str(DATASET%gridRes))), trace=[tr]))
end if
- read(iouCheckpoint) soilLayer_m_np, soilLayer_m_transformed, soilLayer_m_dissolved, soilLayer_V_w
- read(iouCheckpoint) water_volume, water_bedArea, water_Q, water_Q_final, water_j_spm, water_j_spm_final, &
- water_j_np, water_j_np_final, water_j_transformed, water_j_transformed_final, water_j_dissolved, &
- water_j_dissolved_final, water_m_spm, water_m_np, water_m_transformed, water_m_dissolved
- read(iouCheckpoint) sediment_m_np, sedimentLayer_M_f, sedimentLayer_M_f_backup, sedimentLayer_V_w, &
- sedimentLayer_f_comp, sedimentLayer_pd_comp
+ read(iouCheckpoint, iostat=ioStat) t
+ if (ioStat /= 0) call ERROR_HANDLER%trigger(error=ErrorInstance(message="Error reading timestep", trace=[tr]))
+ read(iouCheckpoint, iostat=ioStat) soilProfile_contaminant, soilProfile_m_dissolved
+ if (ioStat /= 0) call ERROR_HANDLER%trigger(error=ErrorInstance(message="Error reading soil profile data", trace=[tr]))
+ read(iouCheckpoint, iostat=ioStat) soilLayer_contaminant, soilLayer_m_dissolved, soilLayer_V_w
+ if (ioStat /= 0) call ERROR_HANDLER%trigger(error=ErrorInstance(message="Error reading soil layer data", trace=[tr]))
+ read(iouCheckpoint, iostat=ioStat) waterBody_contaminant, waterBody_m_dissolved, waterBody_volume, waterBody_bedArea, &
+ waterBody_Q, waterBody_Q_final, waterBody_j_spm, waterBody_j_spm_final
+ if (ioStat /= 0) call ERROR_HANDLER%trigger(error=ErrorInstance(message="Error reading water body data", trace=[tr]))
+ read(iouCheckpoint, iostat=ioStat) bedSediment_contaminant, bedSediment_m_dissolved, sedimentLayer_M_f, &
+ sedimentLayer_M_f_backup, sedimentLayer_V_w, sedimentLayer_f_comp, sedimentLayer_pd_comp
+ if (ioStat /= 0) call ERROR_HANDLER%trigger(error=ErrorInstance(message="Error reading bed sediment data", trace=[tr]))
close(iouCheckpoint)
- ! Now we've read in those variables, we need to reinstate them.
- ! First, should we reinstate the model timestep from the checkpoint?
- if (preserve_timestep) then
- C%t0 = t
- end if
-
- ! Loop through all the grid cells and use the checkpoint data to set
- ! their dynamic state variables. Basically the opposite of me%save()
- do j = 1, size(me%env%item%colGridCells, dim=2)
- do i = 1, size(me%env%item%colGridCells, dim=1)
+ do j = 1, DATASET%gridShape(2)
+ do i = 1, DATASET%gridShape(1)
associate (cell => me%env%item%colGridCells(i,j)%item)
-
- ! Soil
do k = 1, cell%nSoilProfiles
associate (profile => cell%colSoilProfiles(k)%item)
- ! Soil profile dynamic properties
- profile%m_np = soilProfile_m_np(i,j,k,:,:,:)
- profile%m_transformed = soilProfile_m_transformed(i,j,k,:,:,:)
- profile%m_dissolved = soilProfile_m_dissolved(i,j,k)
- ! CHECK: m_np_eroded
+ profile%m_contaminant%c = soilProfile_contaminant(i,j,k,:,:,:)
+ profile%m_contaminant%m_dissolved = soilProfile_m_dissolved(i,j,k)
do l = 1, C%nSoilLayers
associate (layer => profile%colSoilLayers(l)%item)
- ! Soil layer dynamic properties
- layer%m_np = soilLayer_m_np(i,j,k,l,:,:,:)
- layer%m_transformed = soilLayer_m_transformed(i,j,k,l,:,:,:)
- layer%m_dissolved = soilLayer_m_dissolved(i,j,k,l)
- layer%V_w = soilLayer_V_w(i,j,k,l)
+ layer%m_contaminant%c = soilLayer_contaminant(i,j,k,l,:,:,:)
+ layer%m_contaminant%m_dissolved = soilLayer_m_dissolved(i,j,k,l)
+ layer%V_w = soilLayer_V_w(i,j,k,l)
end associate
end do
- ! TODO soil biota
end associate
end do
-
- ! Water
do k = 1, cell%nReaches
associate (water => cell%colRiverReaches(k)%item)
- ! Waterbody dynamic properties
- water%volume = water_volume(i,j,k)
- water%bedArea = water_bedArea(i,j,k)
- water%Q = water_Q(:,k,i,j)
- water%Q_final = water_Q_final(:,k,i,j)
- water%j_spm = water_j_spm(:,:,k,i,j)
- water%j_spm_final = water_j_spm_final(:,:,k,i,j)
- water%j_nm = water_j_np(:,:,:,:,k,i,j)
- water%j_nm_final = water_j_np_final(:,:,:,:,k,i,j)
- water%j_nm_transformed = water_j_transformed(:,:,:,:,k,i,j)
- water%j_nm_transformed_final = water_j_transformed_final(:,:,:,:,k,i,j)
- water%j_dissolved = water_j_dissolved(:,k,i,j)
- water%j_dissolved_final = water_j_dissolved_final(:,k,i,j)
- water%m_spm = water_m_spm(:,k,i,j)
- water%m_np = water_m_np(:,:,:,k,i,j)
- water%m_transformed = water_m_transformed(:,:,:,k,i,j)
- water%m_dissolved = water_m_dissolved(k,i,j)
-
- ! Sediment
+ water%reactor%contaminant%c = waterBody_contaminant(i,j,k,:,:,:)
+ water%reactor%contaminant%m_dissolved = waterBody_m_dissolved(i,j,k)
+ water%volume = waterBody_volume(i,j,k)
+ water%bedArea = waterBody_bedArea(i,j,k)
+ water%Q = waterBody_Q(:,k,i,j)
+ water%Q_final = waterBody_Q_final(:,k,i,j)
+ water%j_spm = waterBody_j_spm(:,:,k,i,j)
+ water%j_spm_final = waterBody_j_spm_final(:,:,k,i,j)
associate (sediment => water%bedSediment)
- sediment%M_np = sediment_m_np(i,j,k,:,:,:,:)
- ! Sediment layers
+ do l = 1, C%nSedimentLayers+3
+ sediment%m_contaminant(l)%c = bedSediment_contaminant(i,j,k,l,:,:,:)
+ sediment%m_contaminant(l)%m_dissolved = bedSediment_m_dissolved(i,j,k,l)
+ end do
do l = 1, C%nSedimentLayers
associate (layer => sediment%colBedSedimentLayers(l)%item)
do m = 1, C%nSizeClassesSpm
- call layer%colFineSediment(m)%set( &
- Mf_in = sedimentLayer_M_f(i,j,k,l,m), &
- Vw_in = sedimentLayer_V_w(i,j,k,l,m) &
- )
- call layer%colFineSediment(m)%backup_M_f()
+ call layer%colFineSediment(m)%set(Mf_in=sedimentLayer_M_f(i,j,k,l,m), &
+ Vw_in=sedimentLayer_V_w(i,j,k,l,m))
+ call layer%colFineSediment(m)%backup_M_f()
layer%colFineSediment(m)%f_comp = sedimentLayer_f_comp(i,j,k,l,m,:)
- layer%colFineSediment(m)%pd_comp = sedimentLayer_pd_comp(i,j,k,l,m,:)
+ layer%colFineSediment(m)%pd_comp = sedimentLayer_pd_comp(i,j,k,l,m,:)
end do
end associate
end do
end associate
end associate
end do
-
end associate
end do
end do
- ! Log that we've successfully reinstated a checkpoint
+ if (present(preserve_timestep) .and. preserve_timestep) then
+ C%t0 = t
+ end if
+
call LOGR%toConsole('Reinstating checkpoint from '//trim(me%checkpointFile)//': '//COLOR_GREEN//'success'//COLOR_RESET)
call LOGR%toFile('Reinstating checkpoint from '//trim(me%checkpointFile)//': success')
-
end subroutine
-
end module
\ No newline at end of file
diff --git a/src/ConstantsDefaultsModule.f90 b/src/ConstantsDefaultsModule.f90
new file mode 100644
index 0000000..c839695
--- /dev/null
+++ b/src/ConstantsDefaultsModule.f90
@@ -0,0 +1,32 @@
+!> The ConstantsDefaultsModule holds default values for constants used in the model
+module ConstantsDefaultsModule
+ implicit none
+
+ integer, private, parameter :: dp = selected_real_kind(15, 307)
+
+ ! Defaults for constants
+ real(dp), parameter :: defaultSoilAttachmentEfficiency = 0.0_dp
+ real(dp), parameter :: defaultRiverAttachmentEfficiency = 0.0_dp ! Attachment efficiency for NM to SPM in rivers
+ real(dp), parameter :: defaultEstuaryAttachmentEfficiency = 0.0_dp
+ real(dp), parameter :: defaultSoilDarcyVelocity = 9.0e-6_dp ! [m/s] Tufenkji et al, 2004: https://doi.org/10.1021/es034049r
+ real(dp), parameter :: default_k_diss_pristine = 0.0_dp ! Dissolution rate for pristine contaminant [s-1]
+ real(dp), parameter :: default_k_diss_transformed = 0.0_dp ! Dissolution rate for transformed contaminant [s-1]
+ real(dp), parameter :: default_k_transform_pristine = 0.0_dp ! Transformation rate for pristine contaminant [s-1]
+ real(dp), parameter :: default_rho_contaminant = 1000.0_dp ! Density of contaminant [kg/m3]
+ real(dp), parameter :: defaultShearRate = 10.0_dp ! Arvidsson et al, 2009: https://doi.org/10.1080/10807039.2011.538639
+ real(dp), parameter :: defaultMinWaterTemperature = 4.0_dp ! Thames River
+ real(dp), parameter :: defaultMaxWaterTemperature = 21.0_dp ! Thames River
+ integer, parameter :: defaultMinWaterTemperatureDayOfYear = 32 ! Thames River
+ real(dp), parameter :: defaultSedimentTransport_a = 2.0e-9_dp
+ real(dp), parameter :: defaultSedimentTransport_b = 0.0_dp
+ real(dp), parameter :: defaultSedimentTransport_c = 0.2_dp
+ real(dp), parameter :: defaultSedimentEnrichment_k = 1.0_dp
+ real(dp), parameter :: defaultSedimentEnrichment_a = 0.0_dp
+ real(dp), parameter :: defaultSlope = 0.0005_dp
+ real(dp), parameter :: defaultDepositionAlpha = 38.1_dp ! Zhiyao et al, 2008: https://doi.org/10.1016/S1674-2370(15)30017-X
+ real(dp), parameter :: defaultDepositionBeta = 0.93_dp ! Zhiyao et al, 2008: https://doi.org/10.1016/S1674-2370(15)30017-X
+ real(dp), parameter :: defaultBankErosionAlpha = 1.0e-9_dp ! [kg/m5] Loosely based on Lazar et al, 2010: https://doi.org/10.1016/j.scitotenv.2010.02.030
+ real(dp), parameter :: defaultBankErosionBeta = 1.0_dp ! [-] Loosely based on Lazar et al, 2010: https://doi.org/10.1016/j.scitotenv.2010.02.030
+ ! Default for contaminant form distribution (pristine, transformed, dissolved)
+ real(dp), parameter :: defaultContaminantFormDistribution(3) = [1.0_dp, 0.0_dp, 0.0_dp] ! All in pristine form
+end module
\ No newline at end of file
diff --git a/src/ContaminantModule.f90 b/src/ContaminantModule.f90
new file mode 100644
index 0000000..88f6ac8
--- /dev/null
+++ b/src/ContaminantModule.f90
@@ -0,0 +1,800 @@
+module ContaminantModule
+ use GlobalsModule, only: dp, C, FREE_CONTAMINANT, ATTACHED_CONTAMINANT, SPM_CONTAMINANT_START
+ use ResultModule, only: Result, Result0D
+ use ErrorInstanceModule
+ use mo_netcdf
+ use DataInputModule, only: DATASET
+ use LoggerModule, only: LOGR
+ use ConstantsDefaultsModule
+ implicit none
+
+ type, public :: Contaminant
+ real(dp), allocatable :: c(:,:,:)
+ real(dp) :: m_dissolved = 0.0_dp
+ real(dp) :: rho_contaminant
+ real(dp) :: k_diss_pristine
+ real(dp) :: k_diss_transformed
+ real(dp) :: k_transform_pristine
+ real(dp) :: alpha_hetero
+ real(dp) :: alpha_att
+ real(dp), allocatable :: k_hetero(:,:)
+ real(dp), allocatable :: W_settle_contaminant(:)
+ real(dp), allocatable :: individualContaminantMass(:)
+ real(dp), allocatable :: C_contaminant_free_particle(:)
+ character(len=100) :: compartment
+ contains
+ procedure :: create => contaminant_create
+ procedure :: create_from_data => contaminant_create_from_data
+ procedure :: add => contaminant_add
+ procedure :: add_scaled => contaminant_add_scaled
+ procedure :: multiply_scalar => contaminant_multiply_scalar
+ procedure :: finalise => contaminant_finalise
+ procedure :: update => contaminant_update
+ procedure :: update_water => contaminant_update_water
+ procedure :: update_sediment => contaminant_update_sediment
+ procedure :: update_soil => contaminant_update_soil
+ procedure :: heteroaggregation => contaminant_heteroaggregation
+ procedure :: dissolution => contaminant_dissolution
+ procedure :: transformation => contaminant_transformation
+ procedure :: getConcentration => contaminant_getConcentration
+ procedure :: get_free => contaminant_get_free
+ procedure :: get_attached => contaminant_get_attached
+ procedure :: attachment => contaminant_attachment
+ procedure :: calculateCollisionRate => contaminant_calculateCollisionRate
+ procedure :: calculateParticleConcentration => contaminant_calculateParticleConcentration
+ procedure :: calculateAttachmentRate => contaminant_calculateAttachmentRate
+ procedure :: calculateSettlingVelocity => contaminant_calculateSettlingVelocity
+ procedure :: divideCheckZero => contaminant_divideCheckZero
+ procedure :: empty => contaminant_empty
+ procedure :: deposition => contaminant_deposition
+ procedure :: outflow_split => contaminant_outflow_split
+ end type
+
+ interface operator(*)
+ module procedure multiply_contaminant_scalar
+ end interface
+
+ interface operator(-)
+ module procedure negate_contaminant
+ end interface
+
+ interface operator(+)
+ module procedure add_contaminant
+ end interface
+
+contains
+
+ !> Local function to replace str from UtilModule.
+ !! This is included locally to avoid introducing a dependency on UtilModule,
+ !! which could potentially create circular dependencies in the module graph.
+ !! If UtilModule's str is needed elsewhere, consider importing it, but here
+ !! it's isolated for simplicity.
+ function int_to_string(i) result(s)
+ integer, intent(in) :: i
+ character(len=20) :: s
+ write(s, '(I0)') i
+ s = trim(adjustl(s))
+ end function
+
+ !> Negate a Contaminant object by multiplying its mass-related fields by -1.
+ !! Properties (rho_contaminant, rates, etc.) are copied from the original.
+ function negate_contaminant(this) result(negated)
+ type(Contaminant), intent(in) :: this
+ type(Contaminant) :: negated
+ type(Result) :: r
+ type(ErrorInstance) :: err(1)
+
+ r = negated%create()
+ if (r%hasCriticalError()) then
+ err(1) = ErrorInstance(code=901, message="Failed to create Contaminant in negate_contaminant")
+ call LOGR%toFile(errors=r%errors)
+ return
+ end if
+ negated%c = -this%c
+ negated%m_dissolved = -this%m_dissolved
+ negated%rho_contaminant = this%rho_contaminant
+ negated%k_diss_pristine = this%k_diss_pristine
+ negated%k_diss_transformed = this%k_diss_transformed
+ negated%k_transform_pristine = this%k_transform_pristine
+ negated%alpha_hetero = this%alpha_hetero
+ negated%alpha_att = this%alpha_att
+ negated%compartment = this%compartment
+ end function
+
+ !> Add two Contaminant objects, summing their mass fields (c and m_dissolved).
+ !! Properties (rho_contaminant, rates, etc.) are taken from the first operand ('this').
+ !! Note: This makes addition non-commutative for properties (A + B != B + A in terms of properties).
+ !! Always use the left operand as the base for properties. This behavior is intentional
+ !! to preserve the primary contaminant's characteristics; document usage accordingly.
+ function add_contaminant(this, other) result(sum_result)
+ type(Contaminant), intent(in) :: this
+ type(Contaminant), intent(in) :: other
+ type(Contaminant) :: sum_result
+ type(Result) :: r
+ type(ErrorInstance) :: err(1)
+
+ r = sum_result%create()
+ if (r%hasCriticalError()) then
+ err(1) = ErrorInstance(code=901, message="Failed to create Contaminant in add_contaminant")
+ call LOGR%toFile(errors=r%errors)
+ return
+ end if
+ call sum_result%add(this)
+ call sum_result%add(other)
+ sum_result%rho_contaminant = this%rho_contaminant
+ sum_result%k_diss_pristine = this%k_diss_pristine
+ sum_result%k_diss_transformed = this%k_diss_transformed
+ sum_result%k_transform_pristine = this%k_transform_pristine
+ sum_result%alpha_hetero = this%alpha_hetero
+ sum_result%alpha_att = this%alpha_att
+ sum_result%compartment = this%compartment
+ end function
+
+
+ !> Calculate and remove deposited mass from the contaminant object.
+ !! Returns a new contaminant object containing the mass that was deposited.
+ subroutine contaminant_deposition(this, dt, W_settle_spm, depth, dj_dep)
+ class(Contaminant), intent(in) :: this
+ real(dp), intent(in) :: dt
+ real(dp), intent(in) :: W_settle_spm(:) ! size-resolved [m s-1], length = C%nSizeClassesSpm
+ real(dp), intent(in) :: depth ! water column height [m]
+ type(Contaminant), intent(inout) :: dj_dep ! OUT: removed mass (>=0)
+
+ type(Result) :: r
+ integer :: n, f, s, sidx
+ real(dp) :: frac, dm
+
+ r = dj_dep%create()
+ if (allocated(dj_dep%c)) dj_dep%c = 0.0_dp
+ dj_dep%m_dissolved = 0.0_dp
+
+ if (.not. allocated(this%c)) return
+ if (depth <= C%epsilon) return
+
+ do s = 1, C%nSizeClassesSpm
+ sidx = SPM_CONTAMINANT_START + s - 1
+ ! fraction settled in this displacement (bounded [0,1])
+ frac = max(0.0_dp, min(1.0_dp, (W_settle_spm(s) * dt) / max(C%epsilon, depth)))
+
+ do n = 1, C%contaminantDim(1)
+ do f = 1, C%nContaminantForms
+ dm = frac * this%c(n, f, sidx)
+ dm = min(dm, this%c(n, f, sidx)) ! mass-limited
+ dj_dep%c(n, f, sidx) = dm
+ end do
+ end do
+ end do
+ end subroutine
+
+ ! Split outflow correctly:
+ ! - dissolved and FREE pools leave with water outflow fraction k_outflow
+ ! - SPM-attached pools leave per size with frac_out(j) = dj_spm_outflow(j) / m_spm(j)
+ subroutine contaminant_outflow_split(this, k_outflow, dj_spm_outflow, m_spm, dj_out)
+ class(Contaminant), intent(in) :: this
+ real(dp), intent(in) :: k_outflow ! water outflow fraction [0..1]
+ real(dp), intent(in) :: dj_spm_outflow(:) ! SPM outflow per size [kg], len = C%nSizeClassesSpm
+ real(dp), intent(in) :: m_spm(:) ! current SPM mass per size [kg]
+ type(Contaminant), intent(inout) :: dj_out ! OUT: removed mass (>=0)
+
+ type(Result) :: r
+ integer :: n, f, s, sidx
+ real(dp) :: frac_out, denom
+
+ r = dj_out%create()
+ if (allocated(dj_out%c)) dj_out%c = 0.0_dp
+ dj_out%m_dissolved = 0.0_dp
+
+ if (.not. allocated(this%c)) return
+
+ ! --- Water-borne outflow: dissolved + FREE ---
+ ! dissolved
+ dj_out%m_dissolved = min(this%m_dissolved * max(0.0_dp, min(1.0_dp, k_outflow)), this%m_dissolved)
+
+ ! FREE particulate bin
+ do n = 1, C%contaminantDim(1)
+ do f = 1, C%nContaminantForms
+ dj_out%c(n, f, FREE_CONTAMINANT) = min( &
+ this%c(n, f, FREE_CONTAMINANT) * max(0.0_dp, min(1.0_dp, k_outflow)), &
+ this%c(n, f, FREE_CONTAMINANT) )
+ end do
+ end do
+
+ ! --- SPM-borne outflow: attached per size ---
+ do s = 1, C%nSizeClassesSpm
+ sidx = SPM_CONTAMINANT_START + s - 1
+ denom = max(C%epsilon, m_spm(s))
+ frac_out = dj_spm_outflow(s) / denom
+ frac_out = max(0.0_dp, min(1.0_dp, frac_out))
+
+ do n = 1, C%contaminantDim(1)
+ do f = 1, C%nContaminantForms
+ dj_out%c(n, f, sidx) = min(this%c(n, f, sidx) * frac_out, this%c(n, f, sidx))
+ end do
+ end do
+ end do
+ end subroutine contaminant_outflow_split
+
+
+ !> Initialize a Contaminant object, allocating arrays and setting default values to zero.
+ !! Adds defensive finalize, dimension checks, and verbose logging.
+ function contaminant_create(this) result(r)
+ class(Contaminant), intent(inout) :: this
+ type(Result) :: r
+ integer :: alloc_stat
+ type(ErrorInstance) :: err(1)
+ integer :: nx, nf, nz
+
+ nx = C%contaminantDim(1)
+ nf = C%contaminantDim(2)
+ nz = C%contaminantDim(3)
+
+ ! call LOGR%add("Contaminant%create: requested dims = (" // trim(int_to_string(nx)) // "," // &
+ ! trim(int_to_string(nf)) // "," // trim(int_to_string(nz)) // "); nSPM=" // &
+ ! trim(int_to_string(C%nSizeClassesSpm)))
+ ! Defensive: clear any previous allocation
+ if (allocated(this%c) .or. allocated(this%k_hetero) .or. allocated(this%W_settle_contaminant) .or. &
+ allocated(this%individualContaminantMass) .or. allocated(this%C_contaminant_free_particle)) then
+ ! call LOGR%add("Contaminant%create: finalising previous allocation")
+ call this%finalise()
+ end if
+
+ ! Hard checks on dimensions
+ if (min(nx, nf, nz) <= 0) then
+ err(1) = ErrorInstance(code=900, message='Contaminant dims must all be > 0')
+ call r%addError(err(1))
+ call LOGR%toFile(errors=r%errors)
+ return
+ end if
+ if (nz < SPM_CONTAMINANT_START + C%nSizeClassesSpm - 1) then
+ err(1) = ErrorInstance(code=900, message='Contaminant state dimension too small for SPM classes')
+ call r%addError(err(1))
+ call LOGR%toFile(errors=r%errors)
+ return
+ end if
+
+ allocate(this%c(nx, nf, nz), &
+ this%k_hetero(nx, C%nSizeClassesSpm), &
+ this%W_settle_contaminant(nx), &
+ this%individualContaminantMass(nx), &
+ this%C_contaminant_free_particle(nx), &
+ stat=alloc_stat)
+
+ if (alloc_stat /= 0) then
+ err(1) = ErrorInstance(code=901, message='Contaminant allocation failed')
+ call r%addError(err(1))
+ call LOGR%toFile(errors=r%errors)
+ return
+ end if
+
+ this%c = 0.0_dp
+ this%m_dissolved = 0.0_dp
+ this%k_hetero = 0.0_dp
+ this%W_settle_contaminant = 0.0_dp
+ this%individualContaminantMass = 0.0_dp
+ this%C_contaminant_free_particle= 0.0_dp
+ this%rho_contaminant = 0.0_dp
+ this%k_diss_pristine = 0.0_dp
+ this%k_diss_transformed = 0.0_dp
+ this%k_transform_pristine = 0.0_dp
+ this%alpha_hetero = 0.0_dp
+ this%alpha_att = 0.0_dp
+ this%compartment = ''
+
+ ! call LOGR%add("Contaminant%create: allocation OK")
+ end function
+
+
+ !> Create a Contaminant from input data, setting properties and calculating settling velocities.
+ !! Adds a warning if scalar/class counts disagree; keeps single create path and debug logs.
+ function contaminant_create_from_data(this, compartment, contaminantDensity, &
+ soilAttachmentEfficiency, riverAttachmentEfficiency, &
+ estuaryAttachmentEfficiency, k_diss_pristine, &
+ k_diss_transformed, k_transform_pristine, waterTemperature) result(r)
+ class(Contaminant), intent(inout) :: this
+ character(len=*), intent(in) :: compartment
+ real(dp), intent(in) :: contaminantDensity
+ real(dp), intent(in) :: soilAttachmentEfficiency
+ real(dp), intent(in) :: riverAttachmentEfficiency
+ real(dp), intent(in) :: estuaryAttachmentEfficiency
+ real(dp), intent(in) :: k_diss_pristine
+ real(dp), intent(in) :: k_diss_transformed
+ real(dp), intent(in) :: k_transform_pristine
+ real(dp), intent(in) :: waterTemperature
+ type(Result) :: r
+ type(ErrorInstance) :: err(1)
+ integer :: n
+
+ ! call LOGR%add("Contaminant%create_from_data: compartment=" // trim(compartment))
+ r = this%create()
+ if (r%hasCriticalError()) then
+ call LOGR%toFile(errors=r%errors)
+ return
+ end if
+
+ ! Sanity: warn if scalar count and allocated dimension differ
+ if (C%nContaminantSizeClasses /= C%contaminantDim(1)) then
+ err(1) = ErrorInstance(code=902, &
+ message="Mismatch: nContaminantSizeClasses /= contaminantDim(1); proceeding with contaminantDim(1)", &
+ isCritical=.false.)
+ call r%addError(err(1))
+ call LOGR%toFile(errors=r%errors)
+ call r%clear()
+ end if
+
+ this%compartment = compartment
+ this%rho_contaminant = contaminantDensity
+ this%k_diss_pristine = k_diss_pristine
+ this%k_diss_transformed = k_diss_transformed
+ this%k_transform_pristine = k_transform_pristine
+
+ select case (compartment)
+ case ('soil','atmospheric')
+ this%alpha_hetero = soilAttachmentEfficiency
+ this%alpha_att = soilAttachmentEfficiency
+ case ('water')
+ this%alpha_hetero = riverAttachmentEfficiency
+ this%alpha_att = riverAttachmentEfficiency
+ case ('estuary','sediment')
+ this%alpha_hetero = estuaryAttachmentEfficiency
+ this%alpha_att = estuaryAttachmentEfficiency
+ case default
+ err(1) = ErrorInstance(code=900, message="Invalid compartment: " // trim(compartment))
+ call r%addErrors(err)
+ call LOGR%toFile(errors=r%errors)
+ return
+ end select
+
+ do n = 1, C%contaminantDim(1)
+ this%W_settle_contaminant(n) = this%calculateSettlingVelocity( &
+ DATASET%contaminantSizeClasses(n), this%rho_contaminant, waterTemperature)
+ this%individualContaminantMass(n) = this%rho_contaminant * (4.0_dp/3.0_dp) * &
+ C%pi * (DATASET%contaminantSizeClasses(n)/2.0_dp)**3
+ end do
+
+ ! call LOGR%add("Contaminant%create_from_data: parameters set and settling velocities computed")
+ end function
+
+ !> Add the mass fields of another Contaminant to this one (in-place addition).
+ subroutine contaminant_add(this, addition)
+ class(Contaminant), intent(inout) :: this
+ type(Contaminant), intent(in) :: addition
+ this%c = this%c + addition%c
+ this%m_dissolved = this%m_dissolved + addition%m_dissolved
+ end subroutine
+
+ !> Add a scaled version of another Contaminant's mass fields to this one.
+ subroutine contaminant_add_scaled(this, addition, scale)
+ class(Contaminant), intent(inout) :: this
+ type(Contaminant), intent(in) :: addition
+ real(dp), intent(in) :: scale
+ this%c = this%c + addition%c * scale
+ this%m_dissolved = this%m_dissolved + addition%m_dissolved * scale
+ end subroutine
+
+ !> Multiply a Contaminant by a scalar, returning a new Contaminant with scaled masses.
+ function multiply_contaminant_scalar(this, scalar) result(product)
+ type(Contaminant), intent(in) :: this
+ real(dp), intent(in) :: scalar
+ type(Contaminant) :: product
+ type(Result) :: r
+ type(ErrorInstance) :: err(1)
+
+ r = product%create()
+ if (r%hasCriticalError()) then
+ err(1) = ErrorInstance(code=901, message="Failed to create Contaminant in multiply_contaminant_scalar")
+ call LOGR%toFile(errors=r%errors)
+ return
+ end if
+
+ ! --- Scalar multiplication of masses ---
+ product%c = this%c * scalar
+ product%m_dissolved = this%m_dissolved * scalar
+
+ ! --- Copy ALL other properties from the source object ---
+ product%rho_contaminant = this%rho_contaminant
+ product%k_diss_pristine = this%k_diss_pristine
+ product%k_diss_transformed = this%k_diss_transformed
+ product%k_transform_pristine = this%k_transform_pristine
+ product%alpha_hetero = this%alpha_hetero
+ product%alpha_att = this%alpha_att
+ product%compartment = this%compartment
+ ! Copy allocatable arrays
+ product%k_hetero = this%k_hetero
+ product%W_settle_contaminant = this%W_settle_contaminant
+ product%individualContaminantMass = this%individualContaminantMass
+ product%C_contaminant_free_particle = this%C_contaminant_free_particle
+ end function
+
+ !> Set this Contaminant's masses to a scaled copy of the source's masses.
+ subroutine contaminant_multiply_scalar(this, source, scalar)
+ class(Contaminant), intent(inout) :: this
+ type(Contaminant), intent(in) :: source
+ real(dp), intent(in) :: scalar
+ type(Result) :: r
+ type(ErrorInstance) :: err(1)
+
+ r = this%create()
+ if (r%hasCriticalError()) then
+ err(1) = ErrorInstance(code=901, message="Failed to create Contaminant in contaminant_multiply_scalar")
+ call LOGR%toFile(errors=r%errors)
+ return
+ end if
+ this%c = source%c * scalar
+ this%m_dissolved = source%m_dissolved * scalar
+ this%rho_contaminant = source%rho_contaminant
+ this%k_diss_pristine = source%k_diss_pristine
+ this%k_diss_transformed = source%k_diss_transformed
+ this%k_transform_pristine = source%k_transform_pristine
+ this%alpha_hetero = source%alpha_hetero
+ this%alpha_att = source%alpha_att
+ this%compartment = source%compartment
+ end subroutine
+
+ !> Divide the contaminant's masses by a denominator, returning a new object; sets to zero if denominator is near zero.
+ function contaminant_divideCheckZero(this, denominator) result(divided)
+ class(Contaminant), intent(in) :: this
+ real(dp), intent(in) :: denominator
+ type(Contaminant) :: divided
+ type(Result) :: r
+ type(ErrorInstance) :: err(1)
+
+ r = divided%create()
+ if (r%hasCriticalError()) then
+ err(1) = ErrorInstance(code=901, message="Failed to create Contaminant in divideCheckZero")
+ call LOGR%toFile(errors=r%errors)
+ return
+ end if
+ if (abs(denominator) < C%epsilon) then
+ divided%c = 0.0_dp
+ divided%m_dissolved = 0.0_dp
+ else
+ if (allocated(this%c)) then
+ divided%c = this%c / denominator
+ end if
+ divided%m_dissolved = this%m_dissolved / denominator
+ end if
+ divided%rho_contaminant = this%rho_contaminant
+ divided%k_diss_pristine = this%k_diss_pristine
+ divided%k_diss_transformed = this%k_diss_transformed
+ divided%k_transform_pristine = this%k_transform_pristine
+ divided%alpha_hetero = this%alpha_hetero
+ divided%alpha_att = this%alpha_att
+ divided%compartment = this%compartment
+ end function
+
+ !> Reset the contaminant's mass fields to zero without deallocating arrays.
+ subroutine contaminant_empty(this)
+ class(Contaminant), intent(inout) :: this
+ if (allocated(this%c)) this%c = 0.0_dp
+ this%m_dissolved = 0.0_dp
+ end subroutine
+
+ !> Deallocate all allocated arrays in the Contaminant and reset compartment.
+ subroutine contaminant_finalise(this)
+ class(Contaminant), intent(inout) :: this
+ if (allocated(this%c)) deallocate(this%c)
+ if (allocated(this%k_hetero)) deallocate(this%k_hetero)
+ if (allocated(this%W_settle_contaminant)) deallocate(this%W_settle_contaminant)
+ if (allocated(this%individualContaminantMass)) deallocate(this%individualContaminantMass)
+ if (allocated(this%C_contaminant_free_particle)) deallocate(this%C_contaminant_free_particle)
+ this%m_dissolved = 0.0_dp
+ this%compartment = ''
+ end subroutine
+
+ !> Update the contaminant based on compartment type, dispatching to specific update methods.
+ function contaminant_update(this, dt, T_water, C_spm, W_settle_spm, G, volume, compartment, k_att, alpha_att) result(r)
+ class(Contaminant), intent(inout) :: this
+ real(dp), intent(in) :: dt, T_water
+ real(dp), intent(in) :: C_spm(:), W_settle_spm(:)
+ real(dp), intent(in) :: G
+ real(dp), intent(in) :: volume
+ character(len=*), intent(in) :: compartment
+ real(dp), intent(in), optional :: k_att(:), alpha_att
+ type(Result) :: r
+ type(ErrorInstance) :: err(1)
+
+ select case (compartment)
+ case ('water', 'estuary')
+ if (present(k_att) .or. present(alpha_att)) then
+ err(1) = ErrorInstance(code=900, &
+ message="k_att and alpha_att not applicable for water or estuary compartment", &
+ isCritical=.false.)
+ call r%addErrors(err)
+ call LOGR%toFile(errors=err)
+ end if
+ call r%addErrors(.errors. this%update_water(dt, T_water, C_spm, W_settle_spm, G, volume))
+ case ('sediment')
+ if (present(k_att) .or. present(alpha_att)) then
+ err(1) = ErrorInstance(code=900, &
+ message="k_att and alpha_att not applicable for sediment compartment", &
+ isCritical=.false.)
+ call r%addErrors(err)
+ call LOGR%toFile(errors=err)
+ end if
+ call r%addErrors(.errors. this%update_sediment(dt, T_water, C_spm, W_settle_spm, G, volume))
+ case ('soil')
+ if (.not. (present(k_att) .and. present(alpha_att))) then
+ err(1) = ErrorInstance(code=900, message="k_att and alpha_att required for soil compartment")
+ call r%addErrors(err)
+ call LOGR%toFile(errors=err)
+ return
+ end if
+ call r%addErrors(.errors. this%update_soil(dt, T_water, C_spm, W_settle_spm, G, volume, k_att, alpha_att))
+ case default
+ err(1) = ErrorInstance(code=900, message="Invalid compartment: " // trim(compartment))
+ call r%addErrors(err)
+ call LOGR%toFile(errors=err)
+ end select
+ end function
+
+ !> Update for water/estuary: Calculate particle concentrations, perform heteroaggregation, dissolution, and transformation.
+ function contaminant_update_water(this, dt, T_water, C_spm, W_settle_spm, G, volume) result(r)
+ class(Contaminant), intent(inout) :: this
+ real(dp), intent(in) :: dt, T_water
+ real(dp), intent(in) :: C_spm(:), W_settle_spm(:)
+ real(dp), intent(in) :: G
+ real(dp), intent(in) :: volume
+ type(Result) :: r
+ integer :: s, n
+ real(dp), allocatable :: C_spm_particle(:)
+ allocate(C_spm_particle(C%nSizeClassesSpm))
+ do s = 1, C%nSizeClassesSpm
+ C_spm_particle(s) = this%calculateParticleConcentration(C_spm(s), &
+ real(sum(C%sedimentParticleDensities)/C%nSizeClassesSpm,dp), real(C%d_spm(s),dp))
+ end do
+ do n = 1, C%contaminantDim(1)
+ ! FIX: Use the initialized DATASET%contaminantSizeClasses instead of uninitialized C%d_contaminant
+ this%C_contaminant_free_particle(n) = this%calculateParticleConcentration( &
+ sum(this%c(n,:,FREE_CONTAMINANT))/volume, this%rho_contaminant, DATASET%contaminantSizeClasses(n))
+ end do
+ call r%addErrors(.errors. this%heteroaggregation(dt, T_water, C_spm, W_settle_spm, C_spm_particle))
+ call r%addErrors(.errors. this%dissolution(dt))
+ call r%addErrors(.errors. this%transformation(dt))
+ deallocate(C_spm_particle)
+ end function
+
+ !> Update for sediment: Similar to water update, focusing on heteroaggregation, dissolution, and transformation.
+ function contaminant_update_sediment(this, dt, T_water, C_spm, W_settle_spm, G, volume) result(r)
+ class(Contaminant), intent(inout) :: this
+ real(dp), intent(in) :: dt, T_water
+ real(dp), intent(in) :: C_spm(:), W_settle_spm(:)
+ real(dp), intent(in) :: G
+ real(dp), intent(in) :: volume
+ type(Result) :: r
+ integer :: s, n
+ real(dp), allocatable :: C_spm_particle(:)
+ allocate(C_spm_particle(C%nSizeClassesSpm))
+ do s = 1, C%nSizeClassesSpm
+ C_spm_particle(s) = this%calculateParticleConcentration(C_spm(s), &
+ real(sum(C%sedimentParticleDensities)/C%nSizeClassesSpm,dp), real(C%d_spm(s),dp))
+ end do
+ do n = 1, C%contaminantDim(1)
+ ! FIX: Use the initialized DATASET%contaminantSizeClasses instead of uninitialized C%d_contaminant
+ this%C_contaminant_free_particle(n) = this%calculateParticleConcentration( &
+ sum(this%c(n,:,FREE_CONTAMINANT))/volume, this%rho_contaminant, DATASET%contaminantSizeClasses(n))
+ end do
+ call r%addErrors(.errors. this%heteroaggregation(dt, T_water, C_spm, W_settle_spm, C_spm_particle))
+ call r%addErrors(.errors. this%dissolution(dt))
+ call r%addErrors(.errors. this%transformation(dt))
+ deallocate(C_spm_particle)
+ end function
+
+ !> Update for soil: Includes heteroaggregation, attachment to soil matrix, dissolution, and transformation.
+ function contaminant_update_soil(this, dt, T_water, C_spm, W_settle_spm, G, volume, k_att, alpha_att) result(r)
+ class(Contaminant), intent(inout) :: this
+ real(dp), intent(in) :: dt, T_water
+ real(dp), intent(in) :: C_spm(:), W_settle_spm(:)
+ real(dp), intent(in) :: G
+ real(dp), intent(in) :: volume
+ real(dp), intent(in) :: k_att(:), alpha_att
+ type(Result) :: r
+ integer :: s, n
+ real(dp), allocatable :: C_spm_particle(:)
+ allocate(C_spm_particle(C%nSizeClassesSpm))
+ do s = 1, C%nSizeClassesSpm
+ C_spm_particle(s) = this%calculateParticleConcentration(C_spm(s), &
+ real(sum(C%sedimentParticleDensities)/C%nSizeClassesSpm,dp), real(C%d_spm(s),dp))
+ end do
+ do n = 1, C%contaminantDim(1)
+ ! FIX: Use the initialized DATASET%contaminantSizeClasses instead of uninitialized C%d_contaminant
+ this%C_contaminant_free_particle(n) = this%calculateParticleConcentration( &
+ sum(this%c(n,:,FREE_CONTAMINANT))/volume, this%rho_contaminant, DATASET%contaminantSizeClasses(n))
+ end do
+ call r%addErrors(.errors. this%heteroaggregation(dt, T_water, C_spm, W_settle_spm, C_spm_particle))
+ call r%addErrors(.errors. this%attachment(dt, k_att, alpha_att))
+ call r%addErrors(.errors. this%dissolution(dt))
+ call r%addErrors(.errors. this%transformation(dt))
+ deallocate(C_spm_particle)
+ end function
+
+ !> Perform heteroaggregation: Calculate collision rates, update heteroaggregation rates, and transfer mass from free to attached states.
+ function contaminant_heteroaggregation(this, dt, T_water, C_spm, W_settle_spm, C_spm_particle) result(r)
+ class(Contaminant), intent(inout) :: this
+ real(dp), intent(in) :: dt, T_water
+ real(dp), intent(in) :: C_spm(:)
+ real(dp), intent(in) :: W_settle_spm(:), C_spm_particle(:)
+ type(Result) :: r
+ real(dp) :: k_coll(C%contaminantDim(1), C%nSizeClassesSpm)
+ integer :: s, n, f
+ real(dp) :: dm_hetero, G
+ G = 0.0_dp
+ k_coll = this%calculateCollisionRate(T_water, G, W_settle_spm)
+ do s = 1, C%nSizeClassesSpm
+ do n = 1, C%contaminantDim(1)
+ this%k_hetero(n,s) = k_coll(n,s) * this%alpha_hetero * C_spm_particle(s)
+ end do
+ end do
+ do n = 1, C%contaminantDim(1)
+ do f = 1, C%nContaminantForms
+ dm_hetero = min(sum(this%k_hetero(n,:))*dt*this%c(n,f,FREE_CONTAMINANT), this%c(n,f,FREE_CONTAMINANT))
+ this%c(n,f,FREE_CONTAMINANT) = this%c(n,f,FREE_CONTAMINANT) - dm_hetero
+ do s = 1, C%nSizeClassesSpm
+ if (this%k_hetero(n,s) > C%epsilon) then
+ this%c(n,f,SPM_CONTAMINANT_START+s-1) = this%c(n,f,SPM_CONTAMINANT_START+s-1) + &
+ dm_hetero*(this%k_hetero(n,s)/sum(this%k_hetero(n,:)))
+ end if
+ end do
+ end do
+ end do
+ end function
+
+ !> Perform attachment to matrix: Transfer mass from free to attached state based on attachment rates.
+ function contaminant_attachment(this, dt, k_att, alpha_att) result(r)
+ class(Contaminant), intent(inout) :: this
+ real(dp), intent(in) :: dt
+ real(dp), intent(in) :: k_att(:), alpha_att
+ type(Result) :: r
+ integer :: n, f
+ real(dp) :: dm_att
+ do n = 1, C%contaminantDim(1)
+ do f = 1, C%nContaminantForms
+ dm_att = min(k_att(n) * alpha_att * dt * this%c(n,f,FREE_CONTAMINANT), this%c(n,f,FREE_CONTAMINANT))
+ this%c(n,f,FREE_CONTAMINANT) = this%c(n,f,FREE_CONTAMINANT) - dm_att
+ this%c(n,f,ATTACHED_CONTAMINANT) = this%c(n,f,ATTACHED_CONTAMINANT) + dm_att
+ end do
+ end do
+ end function
+
+ !> Perform dissolution: Transfer mass from particulate forms to dissolved based on dissolution rates.
+ function contaminant_dissolution(this, dt) result(r)
+ class(Contaminant), intent(inout) :: this
+ real(dp), intent(in) :: dt
+ type(Result) :: r
+ real(dp) :: dm_diss(C%contaminantDim(1), C%nContaminantForms, C%contaminantDim(3))
+ integer :: f
+ do f = 1, C%nContaminantForms
+ if (f == 1) then
+ dm_diss(:,f,:) = min(this%k_diss_pristine * dt * this%c(:,f,:), this%c(:,f,:))
+ else
+ dm_diss(:,f,:) = min(this%k_diss_transformed * dt * this%c(:,f,:), this%c(:,f,:))
+ end if
+ this%c(:,f,:) = this%c(:,f,:) - dm_diss(:,f,:)
+ this%m_dissolved = this%m_dissolved + sum(dm_diss(:,f,:))
+ end do
+ end function
+
+ !> Perform transformation: Transfer mass from pristine to transformed form if multiple forms exist.
+ function contaminant_transformation(this, dt) result(r)
+ class(Contaminant), intent(inout) :: this
+ real(dp), intent(in) :: dt
+ type(Result) :: r
+ real(dp) :: dm_transform(C%contaminantDim(1), C%nContaminantForms, C%contaminantDim(3))
+ if (C%nContaminantForms > 1) then
+ dm_transform = 0.0_dp
+ dm_transform(:,1,:) = min(this%k_transform_pristine * dt * this%c(:,1,:), this%c(:,1,:))
+ this%c(:,1,:) = this%c(:,1,:) - dm_transform(:,1,:)
+ this%c(:,2,:) = this%c(:,2,:) + dm_transform(:,1,:)
+ end if
+ end function
+
+ !> Calculate total concentration (sum of all masses divided by volume).
+ function contaminant_getConcentration(this, volume) result(r)
+ class(Contaminant), intent(in) :: this
+ real(dp), intent(in) :: volume
+ type(Result0D) :: r
+ type(ErrorInstance) :: err(1)
+ real(dp) :: C_total
+
+ if (volume > C%epsilon) then
+ C_total = sum(this%c) / volume
+ allocate(r%data, source=C_total)
+ else
+ err(1) = ErrorInstance(code=900, message="Zero or negative volume in getConcentration")
+ call r%addErrors(err)
+ call LOGR%toFile(errors=err)
+ end if
+ end function
+
+ !> Get concentrations of free (non-attached) contaminant.
+ function contaminant_get_free(this) result(C_free)
+ class(Contaminant), intent(in) :: this
+ real(dp) :: C_free(C%contaminantDim(1), C%contaminantDim(2))
+ C_free = this%c(:,:,FREE_CONTAMINANT)
+ end function
+
+ !> Get concentrations of attached contaminant.
+ function contaminant_get_attached(this) result(C_attached)
+ class(Contaminant), intent(in) :: this
+ real(dp) :: C_attached(C%contaminantDim(1), C%contaminantDim(2))
+ C_attached = this%c(:,:,ATTACHED_CONTAMINANT)
+ end function
+
+ !> Calculate collision rates between contaminant and SPM particles using Brownian, shear, and differential settling terms.
+ function contaminant_calculateCollisionRate(this, T_water, G, W_settle_spm) result(k_coll)
+ class(Contaminant), intent(in) :: this
+ real(dp), intent(in) :: T_water
+ real(dp), intent(in) :: G
+ real(dp), intent(in) :: W_settle_spm(:)
+ real(dp) :: k_coll(C%contaminantDim(1), C%nSizeClassesSpm)
+ integer :: n, s
+ do s = 1, C%nSizeClassesSpm
+ do n = 1, C%contaminantDim(1)
+ ! FIX: Use the initialized DATASET%contaminantSizeClasses instead of uninitialized C%d_contaminant
+ k_coll(n,s) = (2.0_dp*C%k_B*(T_water+273.15_dp)/(3.0_dp*C%mu_w(T_water))) &
+ * (C%d_spm(s)/2.0_dp + DATASET%contaminantSizeClasses(n)/2.0_dp)**2 / &
+ ((C%d_spm(s)/2.0_dp)*(DATASET%contaminantSizeClasses(n)/2.0_dp)) &
+ + (4.0_dp/3.0_dp)*G*(DATASET%contaminantSizeClasses(n)/2.0_dp + C%d_spm(s)/2.0_dp)**3 &
+ + C%pi*(C%d_spm(s)/2.0_dp+DATASET%contaminantSizeClasses(n)/2.0_dp)**2 * &
+ abs(this%W_settle_contaminant(n) - W_settle_spm(s))
+ end do
+ end do
+ end function
+
+ !> Calculate number concentration of particles from mass concentration, density, and diameter.
+ function contaminant_calculateParticleConcentration(this, C_mass, rho_particle, d) result(C_particle)
+ class(Contaminant), intent(in) :: this
+ real(dp), intent(in) :: C_mass, rho_particle, d
+ real(dp) :: C_particle
+ C_particle = C_mass / (rho_particle*(4.0_dp/3.0_dp)*C%pi*(d/2.0_dp)**3)
+ end function
+
+ !> Calculate attachment rate to porous media using colloid filtration theory.
+ function contaminant_calculateAttachmentRate(this, T_water, porosity, d_grain, velocity) result(k_att)
+ class(Contaminant), intent(in) :: this
+ real(dp), intent(in) :: T_water
+ real(dp), intent(in) :: porosity, d_grain
+ real(dp), intent(in), optional :: velocity
+ real(dp) :: k_att(C%contaminantDim(1))
+ integer :: i
+ real(dp) :: gamma, r_i, kBT, N_G, N_VDW, N_Pe, N_R, A_s, eta_grav, eta_intercept, eta_Brownian, eta_0, lambda_filter, D_i
+ real(dp) :: v
+
+ ! Use compartment-specific velocity
+ if (present(velocity) .and. (this%compartment == 'water' .or. this%compartment == 'estuary')) then
+ v = velocity
+ else if (this%compartment == 'soil') then
+ v = DATASET%soilDarcyVelocity
+ else
+ v = 0.0_dp ! Default to zero if velocity not provided for water/estuary
+ end if
+
+ gamma = (1.0_dp - porosity) ** (1.0_dp/3.0_dp)
+ kBT = C%k_B * (T_water + 273.15_dp)
+ N_VDW = DATASET%soilHamakerConstant / kBT
+ A_s = 2.0_dp * (1.0_dp - gamma**5) / (2.0_dp - 3.0_dp*gamma + 3.0_dp*gamma**5 - 2.0_dp*gamma**6)
+ do i = 1, C%contaminantDim(1)
+ ! FIX: Use the initialized DATASET%contaminantSizeClasses instead of uninitialized C%d_contaminant
+ r_i = DATASET%contaminantSizeClasses(i) * 0.5_dp
+ D_i = kBT / (6.0_dp * C%pi * C%mu_w(T_water) * r_i)
+ N_Pe = v * d_grain / D_i
+ N_G = 2.0_dp * r_i**2 * (DATASET%soilParticleDensity - C%rho_w(T_water)) * C%g &
+ / (9.0_dp * C%mu_w(T_water) * v)
+ N_R = r_i / (d_grain * 0.5_dp)
+ eta_grav = 2.22_dp * N_R**(-0.024_dp) * N_G**1.11_dp * N_VDW**0.053_dp
+ eta_intercept = 0.55_dp * N_R**1.55_dp * N_Pe**(-0.125_dp) * N_VDW**0.125_dp
+ eta_Brownian = 2.4_dp * A_s**0.33_dp * N_R**(-0.081_dp) * N_Pe**(-0.715_dp) * N_VDW**0.053_dp
+ eta_0 = eta_grav + eta_intercept + eta_Brownian
+ lambda_filter = 1.5_dp * (1.0_dp - porosity) / (d_grain * porosity)
+ k_att(i) = lambda_filter * eta_0 * v
+ end do
+ end function
+
+ !> Calculate settling velocity using Stokes' law.
+ function contaminant_calculateSettlingVelocity(this, d, rho_particle, T_water) result(W_settle)
+ class(Contaminant), intent(in) :: this
+ real(dp), intent(in) :: d, rho_particle
+ real(dp), intent(in) :: T_water
+ real(dp) :: W_settle
+ W_settle = (rho_particle - C%rho_w(T_water)) * C%g * d**2 / (18.0_dp * C%mu_w(T_water))
+ end function
+end module
\ No newline at end of file
diff --git a/src/Data/DataInputModule.f90 b/src/Data/DataInputModule.f90
index 1a88c5b..eb11234 100644
--- a/src/Data/DataInputModule.f90
+++ b/src/Data/DataInputModule.f90
@@ -5,7 +5,8 @@
module DataInputModule
use mo_netcdf
use DefaultsModule
- use GlobalsModule
+ use ConstantsDefaultsModule
+ use GlobalsModule, only: dp, C, FREE_CONTAMINANT, ATTACHED_CONTAMINANT
use ResultModule, only: Result
use ErrorInstanceModule, only: ErrorInstance
use LoggerModule, only: LOGR
@@ -19,29 +20,30 @@ module DataInputModule
! CONSTANTS
! ---------
- ! Nanomaterial
- real :: nmDensity ! Density of the nanomaterial [kg/m3]
- real, allocatable :: nmSizeClasses(:) ! Diameter of each NM size class [m]
- real, allocatable :: defaultNMSizeDistribution(:) ! Default distribution to split NM across size classes
- integer :: nSizeClassesNM ! Number of NM size classes
+ ! Contaminant
+ real(dp) :: contaminantDensity ! Density of the contaminant [kg/m3]
+ real(dp), allocatable :: contaminantSizeClasses(:) ! Diameter of each contaminant size class [m]
+ real, allocatable :: defaultDistributionContaminant(:) ! Default distribution to split contaminant across size classes
+ real, allocatable :: defaultContaminantFormDistribution(:)
+ integer :: nContaminantSizeClasses ! Number of contaminant size classes
! Sediment
real, allocatable :: defaultSpmSizeDistribution(:) ! Default distribution to split SPM across size classes
- real, allocatable :: spmDensityBySizeClass(:) ! Density of sediment in each size class [kg/m3]
- real, allocatable :: spmSizeClasses(:) ! Diameter of each SPM size class [m]
+ real(dp), allocatable :: spmDensityBySizeClass(:) ! Density of sediment in each size class [kg/m3]
+ real(dp), allocatable :: spmSizeClasses(:) ! Diameter of each SPM size class [m]
real, allocatable :: defaultMatrixEmbeddedDistributionToSpm(:) ! Default distribution to proportion matrix-embedded releases to SPM size classes
integer :: nSizeClassesSpm ! Number of SPM size classes
real(dp) :: sedimentEnrichment_k ! Clay enrichment scaling factor
real(dp) :: sedimentEnrichment_a ! Clay enrichment skew factor
! Soil
real(dp) :: soilDarcyVelocity ! Darcy velocity in soil [m/s]
- real(dp) :: soilDefaultPorosity ! Default porosity [-] ! TODO deprecate this in favour of spatially resolved porosity
+ real(dp) :: soilDefaultPorosity ! Default porosity [-]
real(dp) :: soilHamakerConstant ! Hamaker constant for soil [J]
real(dp) :: soilParticleDensity ! Particle density of soil [kg m-3]
real(dp) :: soilErosivity_a1 ! Erosivity a1 parameter [-]
real(dp) :: soilErosivity_a2 ! Erosivity a2 parameter [-]
real(dp) :: soilErosivity_a3 ! Erosivity a3 parameter [-]
real(dp) :: soilErosivity_b ! Erosivity b parameter [-]
- real :: soilConstantAttachmentEfficiency ! Attachment efficiency to soil matrix [-]
+ real(dp) :: soilConstantAttachmentEfficiency ! Attachment efficiency to soil matrix [-]
real(dp) :: sedimentTransport_aConstant ! Sediment transport capacity a parameter (scaling factor) [kg/m2/km2]
real(dp) :: sedimentTransport_bConstant ! Sediment transport capacity b parameter (overland flow threshold) [m2/s]
real(dp) :: sedimentTransport_cConstant ! Sediment transport capacity c parameter (non-linear coefficient) [-]
@@ -61,19 +63,17 @@ module DataInputModule
real(dp), allocatable :: biotaInitial_C_org(:)
real(dp), allocatable :: biota_k_growth(:)
real(dp), allocatable :: biota_k_death(:)
- real(dp), allocatable :: biota_k_uptake_np(:)
- real(dp), allocatable :: biota_k_elim_np(:)
- real(dp), allocatable :: biota_k_uptake_transformed(:)
- real(dp), allocatable :: biota_k_elim_transformed(:)
- real(dp), allocatable :: biota_k_uptake_dissolved(:)
- real(dp), allocatable :: biota_k_elim_dissolved(:)
+ real(dp), allocatable :: biota_k_uptake_contaminant(:,:) ! Uptake rates for contaminant forms [nBiota, nContaminantForms]
+ real(dp), allocatable :: biota_k_elim_contaminant(:,:) ! Elimination rates for contaminant forms [nBiota, nContaminantForms]
+ real(dp), allocatable :: biota_k_uptake_dissolved(:) ! Uptake rate for dissolved contaminant
+ real(dp), allocatable :: biota_k_elim_dissolved(:) ! Elimination rate for dissolved contaminant
real, allocatable :: biotaStoredFraction(:)
character(len=17), allocatable :: biotaUptakeFromForm(:)
integer, allocatable :: biotaHarvestInMonth(:)
logical :: hasBiota = .false.
integer :: nBiota = 0
! Water
- real :: riverMeanderingFactor ! Meandering factor for rivers (not estuaries) [-]
+ real :: riverMeanderingFactor ! Meandering factor for rivers (not estuaries) [-]
real(dp) :: waterResuspensionAlpha ! Resuspension parameter alpha
real(dp) :: waterResuspensionBeta ! Resuspension parameter beta
real(dp) :: waterResuspensionAlphaEstuary ! Resuspension parameter alpha for estuary
@@ -82,12 +82,12 @@ module DataInputModule
real(dp) :: depositionBetaConstant ! Deposition parameter beta - constant if spatial variable not supplied
real(dp) :: bankErosionAlphaConstant ! Bank erosion parameter alpha - constant if spatial variable not supplied
real(dp) :: bankErosionBetaConstant ! Bank erosion parameter beta - constant if spatial variable not supplied
- real(dp) :: water_k_diss_pristine ! Dissolution rate constant for pristine NM [/s]
- real(dp) :: water_k_diss_transformed ! Dissolution rate constant for transformed NM [/s]
- real(dp) :: water_k_transform_pristine ! Transformation rate constant for pristine NM [/s]
- real(dp) :: riverAttachmentEfficiency ! Attachment efficiency for NM to SPM in rivers [-]
- real :: shearRate ! Shear rate [/s]
- real :: waterTemperature(366) ! Temporally varying water temperature [deg C]
+ real(dp) :: contaminant_k_diss_pristine ! Dissolution rate constant for pristine contaminant [/s]
+ real(dp) :: contaminant_k_diss_transformed ! Dissolution rate constant for transformed contaminant [/s]
+ real(dp) :: contaminant_k_transform_pristine ! Transformation rate constant for pristine contaminant [/s]
+ real(dp) :: shearRate ! Shear rate [/s]
+ real(dp) :: waterTemperature(366) ! Temporally varying water temperature [deg C]
+ real(dp) :: riverAttachmentEfficiency
! Estuary
real(dp) :: estuaryAttachmentEfficiency ! Attachment efficiency for NM to SPM in estuaries [-]
real :: estuaryTidalM2 ! Estuary tidal harmonics parameter M2
@@ -148,49 +148,36 @@ module DataInputModule
real(dp), allocatable :: soilUsleCFactor(:,:)
real(dp), allocatable :: soilUslePFactor(:,:)
real(dp), allocatable :: soilUsleLSFactor(:,:)
- real, allocatable :: resuspensionAlpha(:,:)
- real, allocatable :: resuspensionBeta(:,:)
- real, allocatable :: depositionAlpha(:,:)
- real, allocatable :: depositionBeta(:,:)
+ real(dp), allocatable :: resuspensionAlpha(:,:)
+ real(dp), allocatable :: resuspensionBeta(:,:)
+ real(dp), allocatable :: depositionAlpha(:,:)
+ real(dp), allocatable :: depositionBeta(:,:)
real(dp), allocatable :: bankErosionAlpha(:,:)
real(dp), allocatable :: bankErosionBeta(:,:)
real(dp), allocatable :: sedimentTransport_a(:,:) ! Sediment transport capacity a parameter (scaling factor) [kg/m2/km2]
real(dp), allocatable :: sedimentTransport_b(:,:) ! Sediment transport capacity b parameter (overland flow threshold) [m2/s]
real(dp), allocatable :: sedimentTransport_c(:,:) ! Sediment transport capacity c parameter (non-linear coefficient) [-]
! Initial concentrations
- ! real(dp), allocatable :: initialNMConcsSoil(:,:,:)
- ! real(dp), allocatable :: initialTransformedConcsSoil(:,:,;)
- ! real(dp), allocatable :: initialDissolvedConcsSoil(:,:,;)
- ! real(dp), allocatable :: initialNMConcsWater(:,:,;)
- ! real(dp), allocatable :: initialTransformedConcsWater(:,:,;)
- ! real(dp), allocatable :: initialDissolvedConcsWater(:,:,;)
- ! real(dp), allocatable :: initialNMConcsSediment(:,:,;)
- ! real(dp), allocatable :: initialTransformedConcsSediment(:,:,:)
- ! real(dp), allocatable :: initialDissolvedConcsSediment(:,:,:)
+ real(dp), allocatable :: initialContaminantConcsSoil(:,:,:,:,:)
+ real(dp), allocatable :: initialContaminantConcsWater(:,:,:,:,:)
+ real(dp), allocatable :: initialContaminantConcsSediment(:,:,:,:,:)
+ real(dp), allocatable :: initialDissolvedConcsSoil(:,:)
+ real(dp), allocatable :: initialDissolvedConcsWater(:,:)
+ real(dp), allocatable :: initialDissolvedConcsSediment(:,:)
! Emissions - areal
- real(dp), allocatable :: emissionsArealSoilPristine(:,:)
- real(dp), allocatable :: emissionsArealSoilMatrixEmbedded(:,:)
- real(dp), allocatable :: emissionsArealSoilTransformed(:,:)
- real(dp), allocatable :: emissionsArealSoilDissolved(:,:)
- real(dp), allocatable :: emissionsArealWaterPristine(:,:)
- real(dp), allocatable :: emissionsArealWaterMatrixEmbedded(:,:)
- real(dp), allocatable :: emissionsArealWaterTransformed(:,:)
- real(dp), allocatable :: emissionsArealWaterDissolved(:,:)
+ real(dp), allocatable :: emissionsArealSoilContaminant(:,:,:,:,:)
+ real(dp), allocatable :: emissionsArealWaterContaminant(:,:,:,:,:)
+ real(dp), allocatable :: emissionsArealSoilDissolvedContaminant(:,:)
+ real(dp), allocatable :: emissionsArealWaterDissolvedContaminant(:,:)
! Emissions - atmospheric depo
- real(dp), allocatable :: emissionsAtmosphericDryDepoPristine(:,:,:)
- real(dp), allocatable :: emissionsAtmosphericDryDepoMatrixEmbedded(:,:,:)
- real(dp), allocatable :: emissionsAtmosphericDryDepoTransformed(:,:,:)
- real(dp), allocatable :: emissionsAtmosphericDryDepoDissolved(:,:,:)
- real(dp), allocatable :: emissionsAtmosphericWetDepoPristine(:,:,:)
- real(dp), allocatable :: emissionsAtmosphericWetDepoMatrixEmbedded(:,:,:)
- real(dp), allocatable :: emissionsAtmosphericWetDepoTransformed(:,:,:)
- real(dp), allocatable :: emissionsAtmosphericWetDepoDissolved(:,:,:)
- ! Emisions - point
- real(dp), allocatable :: emissionsPointWaterPristine(:,:,:,:)
- real(dp), allocatable :: emissionsPointWaterMatrixEmbedded(:,:,:,:)
- real(dp), allocatable :: emissionsPointWaterTransformed(:,:,:,:)
- real(dp), allocatable :: emissionsPointWaterDissolved(:,:,:,:)
+ real(dp), allocatable :: emissionsAtmosphericDryDepoContaminant(:,:,:,:,:,:)
+ real(dp), allocatable :: emissionsAtmosphericWetDepoContaminant(:,:,:,:,:,:)
+ real(dp), allocatable :: emissionsAtmosphericDryDepoDissolvedContaminant(:,:,:)
+ real(dp), allocatable :: emissionsAtmosphericWetDepoDissolvedContaminant(:,:,:)
+ ! Emissions - point
real(dp), allocatable :: emissionsPointWaterCoords(:,:,:,:)
+ real(dp), allocatable :: emissionsPointWaterContaminant(:,:,:,:,:,:,:) ! (x, y, t, p, size, form, state)
+ real(dp), allocatable :: emissionsPointWaterDissolvedContaminant(:,:,:)
integer, allocatable :: nPointSources(:,:)
integer :: maxPointSources ! Maximum number of point sources in a cell in the whole environment
! Spatial 1D variables
@@ -221,84 +208,84 @@ subroutine initDatabase(me, inputFile, constantsFile)
class(Database) :: me
type(NcDataset) :: nc_simulationMask
type(NcVariable) :: var
- character(len=*) :: inputFile
- character(len=*) :: constantsFile
+ character(len=* ) :: inputFile, constantsFile
type(Result) :: rslt
- integer, allocatable :: isHeadwaterInt(:,:) ! Temporary variable to store int before convert to bool
- integer, allocatable :: isEstuaryInt(:,:)
+ ! temps returned by mo_netcdf in Fortran order (reversed NetCDF dims)
+ integer, allocatable :: outflow_dxy(:,:,:)
+ integer, allocatable :: inflows_dwxy(:,:,:,:)
+ integer, allocatable :: isHeadwaterInt_xy(:,:), isEstuaryInt_xy(:,:)
+ integer, allocatable :: nWaterbodies_xy(:,:)
integer, allocatable :: simulationMask(:,:)
-
- ! Open the dataset and parse constants NML file
+ integer :: nx, ny
+
+ ! Open the dataset and parse constants
me%nc = NcDataset(inputFile, 'r')
call me%parseConstants(constantsFile)
-
- ! Variable units: These will already have been converted to the correct
- ! units for use in the model by nanofase-data (the input data compilation
- ! script). Hence, no maths need be done on variables here to convert and
- ! thus no FPEs will occur from the masked (_FillValue) values - the model will
- ! check the relevant variables for these *when they are used*.
-
- ! GRID AND COORDINATE VARIABLES
- var = me%nc%getVariable('grid_shape')
- call var%getData(me%gridShape)
- var = me%nc%getVariable('grid_res')
- call var%getData(me%gridRes)
- var = me%nc%getVariable('grid_bounds')
- call var%getData(me%gridBounds)
- var = me%nc%getVariable('x')
- call var%getData(me%x)
- allocate(me%x_l(me%gridShape(1)))
- me%x_l = me%x - 0.5 * me%gridRes(1)
- var = me%nc%getVariable('y')
- call var%getData(me%y)
- allocate(me%y_u(me%gridShape(2)))
- me%y_u = me%y + 0.5 * me%gridRes(2)
- var = me%nc%getVariable('crs')
- call var%getAttribute('crs_wkt', me%crsWKT)
-
- ! ROUTING VARIABLES
- var = me%nc%getVariable('outflow')
- call var%getData(me%outflow)
- var = me%nc%getVariable('inflows')
- call var%getData(me%inflows)
- var = me%nc%getVariable('is_headwater')
- call var%getData(isHeadwaterInt)
- me%isHeadwater = ulgcl(isHeadwaterInt) ! Convert uint1 to logical
- var = me%nc%getVariable('n_waterbodies')
- call var%getData(me%nWaterbodies)
+
+ ! GRID / COORDS
+ var = me%nc%getVariable('grid_shape'); call var%getData(me%gridShape)
+ var = me%nc%getVariable('grid_res'); call var%getData(me%gridRes)
+ var = me%nc%getVariable('grid_bounds'); call var%getData(me%gridBounds)
+ var = me%nc%getVariable('x'); call var%getData(me%x)
+ var = me%nc%getVariable('y'); call var%getData(me%y)
+ allocate(me%x_l(size(me%x))); me%x_l = me%x - 0.5 * me%gridRes(1)
+ allocate(me%y_u(size(me%y))); me%y_u = me%y + 0.5 * me%gridRes(2)
+ var = me%nc%getVariable('crs'); call var%getAttribute('crs_wkt', me%crsWKT)
+
+ nx = me%gridShape(1)
+ ny = me%gridShape(2)
+
+ ! ROUTING (getData already reversed dims to Fortran order)
+ ! outflow: file (y,x,d) -> returned (d,x,y) => model (d,x,y)
+ var = me%nc%getVariable('outflow'); call var%getData(outflow_dxy)
+ if (allocated(me%outflow)) deallocate(me%outflow)
+ allocate(me%outflow( size(outflow_dxy,1), size(outflow_dxy,2), size(outflow_dxy,3) ))
+ me%outflow = outflow_dxy
+ deallocate(outflow_dxy)
+
+ ! inflows: file (y,x,w,d) -> returned (d,w,x,y) => model (d,w,x,y)
+ var = me%nc%getVariable('inflows'); call var%getData(inflows_dwxy)
+ if (allocated(me%inflows)) deallocate(me%inflows)
+ allocate(me%inflows( size(inflows_dwxy,1), size(inflows_dwxy,2), &
+ size(inflows_dwxy,3), size(inflows_dwxy,4) ))
+ me%inflows = inflows_dwxy
+ deallocate(inflows_dwxy)
+
+ ! headwater / n_waterbodies / estuary: file (y,x) -> returned (x,y) => model (x,y)
+ var = me%nc%getVariable('is_headwater'); call var%getData(isHeadwaterInt_xy)
+ me%isHeadwater = ulgcl(isHeadwaterInt_xy)
+ deallocate(isHeadwaterInt_xy)
+
+ var = me%nc%getVariable('n_waterbodies'); call var%getData(nWaterbodies_xy)
+ me%nWaterbodies = nWaterbodies_xy
+ deallocate(nWaterbodies_xy)
me%maxNWaterbodies = maxval(me%nWaterbodies)
- ! If we're meant to be including the estuary, then get the is_estuary variable
+
if (C%includeEstuary) then
- var = me%nc%getVariable('is_estuary')
- call var%getData(isEstuaryInt)
- me%isEstuary = ulgcl(isEstuaryInt) ! Convert uint1 to logical
- ! Otherwise, just set isEstuary to false everywhere
+ var = me%nc%getVariable('is_estuary'); call var%getData(isEstuaryInt_xy)
+ me%isEstuary = ulgcl(isEstuaryInt_xy)
+ deallocate(isEstuaryInt_xy)
else
- allocate(me%isEstuary(me%gridShape(1), me%gridShape(2)))
- me%isEstuary = .false.
+ allocate(me%isEstuary(nx, ny)); me%isEstuary = .false.
end if
- ! Use the nWaterbodies array to set the grid mask
- allocate(me%gridMask(me%gridShape(1), me%gridShape(2)))
+ ! Grid mask from nWaterbodies
+ allocate(me%gridMask(nx, ny))
me%gridMask = me%mask(me%nWaterbodies)
- ! Meandering factors are set using grid resolution, if not present in constants,
- ! so they must be set after grid resolution pulled for NetCDF file (here), as
- ! opposed to in the constants parsing routine
- if (isZero(me%riverMeanderingFactor)) then
- me%riverMeanderingFactor = me%calculateMeanderingFactorFromCellSize()
- end if
- if (isZero(me%estuaryMeanderingFactor)) then
- me%estuaryMeanderingFactor = me%calculateMeanderingFactorFromCellSize()
- end if
+ ! Derive meandering factors from grid size if not set in constants
+ if (isZero(me%riverMeanderingFactor)) me%riverMeanderingFactor = &
+ me%calculateMeanderingFactorFromCellSize()
+ if (isZero(me%estuaryMeanderingFactor)) me%estuaryMeanderingFactor = &
+ me%calculateMeanderingFactorFromCellSize()
- ! Read the variables that can be updated on each batch (i.e. not geographical)
+ ! Chunk-varying variables
call me%readBatchVariables()
- ! Close the dataset
+ ! Close input dataset
call me%nc%close()
- ! Has a simulation mask been provided?
+ ! Simulation mask (same reversal: file (y,x) -> returned (x,y))
if (C%hasSimulationMask) then
nc_simulationMask = NcDataset(C%simulationMaskPath, 'r')
var = nc_simulationMask%getVariable('simulation_mask')
@@ -306,14 +293,13 @@ subroutine initDatabase(me, inputFile, constantsFile)
me%simulationMask = ulgcl(simulationMask)
me%nNonMaskedCells = count(me%simulationMask)
else
- allocate(me%simulationMask(me%gridShape(1), me%gridShape(2)))
+ allocate(me%simulationMask(nx, ny))
me%simulationMask = .true.
me%nNonMaskedCells = count(.not. me%gridMask)
end if
- ! Do the auditing
+ ! Audit & log
call rslt%addErrors(.errors. me%audit())
-
call rslt%addToTrace('Initialising database')
call ERROR_HANDLER%trigger(errors=.errors.rslt)
call LOGR%toFile("Initialising database: success")
@@ -323,193 +309,286 @@ subroutine initDatabase(me, inputFile, constantsFile)
!> Update the database based on data for a new chunk (k), or for the only chunk if this
!! isn't a batch run.
subroutine updateDatabase(me, k)
- class(Database) :: me !! This Database instance
- integer :: k !! The index of this chunk, used to access correct config options
+ class(Database) :: me
+ integer :: k
! Get the config options for this chunk
- C%inputFile = C%batchInputFiles(k)
+ C%inputFile = C%batchInputFiles(k)
C%constantsFile = C%batchConstantFiles(k)
- C%nTimeSteps = C%batchNTimesteps(k)
- C%startDate = C%batchStartDates(k)
+ C%nTimeSteps = C%batchNTimesteps(k)
+ C%startDate = C%batchStartDates(k)
- ! Read in the new constants file
call me%parseConstants(C%constantsFile)
- ! Open the new dataset
me%nc = NcDataset(C%inputFile, 'r')
- ! Deallocate the previous chunk's variables
- deallocate(me%t)
- deallocate(me%soilAttachmentRate)
- deallocate(me%soilAttachmentEfficiency)
- deallocate(me%emissionsArealSoilPristine)
- deallocate(me%emissionsArealSoilMatrixEmbedded)
- deallocate(me%emissionsArealSoilTransformed)
- deallocate(me%emissionsArealSoilDissolved)
- deallocate(me%emissionsArealWaterPristine)
- deallocate(me%emissionsArealWaterMatrixEmbedded)
- deallocate(me%emissionsArealWaterTransformed)
- deallocate(me%emissionsArealWaterDissolved)
- deallocate(me%emissionsAtmosphericDryDepoPristine)
- deallocate(me%emissionsAtmosphericDryDepoMatrixEmbedded)
- deallocate(me%emissionsAtmosphericDryDepoTransformed)
- deallocate(me%emissionsAtmosphericDryDepoDissolved)
- deallocate(me%emissionsAtmosphericWetDepoPristine)
- deallocate(me%emissionsAtmosphericWetDepoMatrixEmbedded)
- deallocate(me%emissionsAtmosphericWetDepoTransformed)
- deallocate(me%emissionsAtmosphericWetDepoDissolved)
- deallocate(me%emissionsPointWaterPristine)
- deallocate(me%emissionsPointWaterMatrixEmbedded)
- deallocate(me%emissionsPointWaterTransformed)
- deallocate(me%emissionsPointWaterDissolved)
- deallocate(me%resuspensionAlpha)
- deallocate(me%resuspensionBeta)
- deallocate(me%depositionAlpha)
- deallocate(me%depositionBeta)
- deallocate(me%bankErosionAlpha)
- deallocate(me%bankErosionBeta)
- deallocate(me%sedimentTransport_a)
- deallocate(me%sedimentTransport_b)
- deallocate(me%sedimentTransport_c)
-
- ! Read this chunk's variables
+ ! Deallocate previous-chunk vars
+ if (allocated(me%t)) deallocate(me%t)
+ if (allocated(me%soilAttachmentRate)) deallocate(me%soilAttachmentRate)
+ if (allocated(me%soilAttachmentEfficiency)) deallocate(me%soilAttachmentEfficiency)
+ if (allocated(me%emissionsArealSoilContaminant)) deallocate(me%emissionsArealSoilContaminant)
+ if (allocated(me%emissionsArealWaterContaminant)) deallocate(me%emissionsArealWaterContaminant)
+ if (allocated(me%emissionsAtmosphericDryDepoContaminant)) deallocate(me%emissionsAtmosphericDryDepoContaminant)
+ if (allocated(me%emissionsAtmosphericWetDepoContaminant)) deallocate(me%emissionsAtmosphericWetDepoContaminant)
+ if (allocated(me%emissionsPointWaterContaminant)) deallocate(me%emissionsPointWaterContaminant)
+ if (allocated(me%emissionsPointWaterCoords)) deallocate(me%emissionsPointWaterCoords)
+ if (allocated(me%resuspensionAlpha)) deallocate(me%resuspensionAlpha)
+ if (allocated(me%resuspensionBeta)) deallocate(me%resuspensionBeta)
+ if (allocated(me%depositionAlpha)) deallocate(me%depositionAlpha)
+ if (allocated(me%depositionBeta)) deallocate(me%depositionBeta)
+ if (allocated(me%bankErosionAlpha)) deallocate(me%bankErosionAlpha)
+ if (allocated(me%bankErosionBeta)) deallocate(me%bankErosionBeta)
+ if (allocated(me%sedimentTransport_a)) deallocate(me%sedimentTransport_a)
+ if (allocated(me%sedimentTransport_b)) deallocate(me%sedimentTransport_b)
+ if (allocated(me%sedimentTransport_c)) deallocate(me%sedimentTransport_c)
+ if (allocated(me%initialContaminantConcsSoil)) deallocate(me%initialContaminantConcsSoil)
+ if (allocated(me%initialContaminantConcsWater)) deallocate(me%initialContaminantConcsWater)
+ if (allocated(me%initialContaminantConcsSediment)) deallocate(me%initialContaminantConcsSediment)
+ if (allocated(me%initialDissolvedConcsSoil)) deallocate(me%initialDissolvedConcsSoil)
+ if (allocated(me%initialDissolvedConcsWater)) deallocate(me%initialDissolvedConcsWater)
+ if (allocated(me%initialDissolvedConcsSediment)) deallocate(me%initialDissolvedConcsSediment)
+ if (allocated(me%emissionsArealSoilDissolvedContaminant)) deallocate(me%emissionsArealSoilDissolvedContaminant)
+ if (allocated(me%emissionsArealWaterDissolvedContaminant)) deallocate(me%emissionsArealWaterDissolvedContaminant)
+ if (allocated(me%emissionsAtmosphericDryDepoDissolvedContaminant)) &
+ deallocate(me%emissionsAtmosphericDryDepoDissolvedContaminant)
+ if (allocated(me%emissionsAtmosphericWetDepoDissolvedContaminant)) &
+ deallocate(me%emissionsAtmosphericWetDepoDissolvedContaminant)
+ if (allocated(me%emissionsPointWaterDissolvedContaminant)) &
+ deallocate(me%emissionsPointWaterDissolvedContaminant)
+
call me%readBatchVariables()
-
- ! Close the dataset
call me%nc%close()
end subroutine
!> Read variables in for the new chunk as part of a batch run
subroutine readBatchVariablesDatabase(me)
- class(Database) :: me ! This Database instance
- type(NcVariable) :: var ! NetCDF variable
- type(NcDimension) :: p_dim ! NetCDF dimensions for point sources
- integer :: x, y ! Grid cell iterators
-
- ! Spatial extent (grid setup, rivers etc) will stay the same between chunks,
- ! but the number of timesteps might not, so let's change that
- var = me%nc%getVariable('t')
- call var%getData(me%t)
- me%nTimesteps = size(me%t)
-
- ! SPATIOTEMPORAL VARIABLES
- ! If number of timesteps in this chunk is different, the getData() method
- ! will take care of reallocating the variable to the correct length. But
- ! we need to be careful to reallocate variables we don't get by getData
- ! (i.e. ones that aren't present in the data file)
-
- ! Digital elevation model [dm asl]
- if (me%nc%hasVariable('dem')) then
- var = me%nc%getVariable('dem')
- call var%getData(me%dem)
+ class(Database) :: me
+ type(NcVariable) :: var
+ type(NcDimension) :: p_dim
+ logical :: haveCoordVar
+ integer :: n
+ integer :: alloc_stat
+ integer :: nx, ny, nt, nforms, nsizes, np
+ integer :: f_pris, f_mat, f_tra
+
+ ! temp arrays with explicit ranks that match legacy file vars
+ real(dp), allocatable :: A2(:,:) ! (x,y)
+ real(dp), allocatable :: A3(:,:,:) ! (x,y,t)
+ real(dp), allocatable :: COORD4(:,:,:,:) ! (x,y,p,d)
+ real(dp), allocatable :: A4(:,:,:,:) ! (x,y,t,p)
+ real(dp), allocatable :: T2(:,:) ! temp for spatial (x,y) → transpose → (y,x)
+
+ nx = me%gridShape(1)
+ ny = me%gridShape(2)
+ nt = C%nTimeSteps
+ nsizes = C%contaminantDim(1)
+ nforms = C%contaminantDim(2)
+
+ ! Legacy form indices (cap to available number of forms)
+ f_pris = 1
+ f_mat = merge(2, 1, nforms >= 2)
+ f_tra = merge(3, 1, nforms >= 3)
+
+ ! ----------------------
+ ! SPATIAL SOIL VARIABLES
+ ! ----------------------
+ ! File vars are 2-D (y,x); the NetCDF helper returns (x,y) on getData.
+ ! We read into T2(nx,ny) and store as (y,x) to match NetCDFOutput expectations.
+
+ ! Soil bulk density [kg/m3]
+ if (me%nc%hasVariable('soil_bulk_density')) then
+ var = me%nc%getVariable('soil_bulk_density')
+ if (allocated(me%soilBulkDensity)) deallocate(me%soilBulkDensity)
+ allocate(T2(nx,ny)); call var%getData(T2) ! (x,y)
+ allocate(me%soilBulkDensity(ny,nx)) ! (y,x)
+ me%soilBulkDensity = transpose(T2) ! → (y,x)
+ deallocate(T2)
else
- call LOGR%toFile(errors=[ &
- ErrorInstance(message='Digital elevation model (dem) not found in input file. ' // &
- 'Default slope of ' // trim(str(defaultSlope)) // ' m/m will be used.', iscritical=.false.) &
- ])
- end if
-
- ! Runoff [m/timestep]
- var = me%nc%getVariable('runoff')
- call var%getData(me%runoff)
- ! Quickflow [m/timestep]
- var = me%nc%getVariable('quickflow')
- call var%getData(me%quickflow)
- ! Precip [m/timestep]
- var = me%nc%getVariable('precip')
- call var%getData(me%precip)
- ! Evap
- ! TODO actually get some data for this
- if (me%nc%hasVariable('evap')) then
- var = me%nc%getVariable('evap')
- call var%getData(me%evap)
+ if (allocated(me%soilBulkDensity)) deallocate(me%soilBulkDensity)
+ allocate(me%soilBulkDensity(ny,nx))
+ me%soilBulkDensity = nf90_fill_real
+ end if
+
+ ! Soil water content at field capacity [cm3/cm3]
+ if (me%nc%hasVariable('soil_water_content_field_capacity')) then
+ var = me%nc%getVariable('soil_water_content_field_capacity')
+ if (allocated(me%soilWaterContentFieldCapacity)) deallocate(me%soilWaterContentFieldCapacity)
+ allocate(T2(nx,ny)); call var%getData(T2)
+ allocate(me%soilWaterContentFieldCapacity(ny,nx))
+ me%soilWaterContentFieldCapacity = transpose(T2)
+ deallocate(T2)
else
- if (allocated(me%evap)) deallocate(me%evap)
- allocate(me%evap(me%gridShape(1), me%gridShape(2), C%nTimesteps))
- me%evap = 0.0
- end if
-
- ! SPATIAL VARIABLES
- ! Soil bulk density [kg/m3]
- var = me%nc%getVariable('soil_bulk_density')
- call var%getData(me%soilBulkDensity)
- ! Soil water content at field capacity [cm3/cm3]
- var = me%nc%getVariable('soil_water_content_field_capacity')
- call var%getData(me%soilWaterContentFieldCapacity)
- ! Soil water content at saturation [cm3/cm3]
- var = me%nc%getVariable('soil_water_content_saturation')
- call var%getData(me%soilWaterContentSaturation)
- ! Soil hydraulic conductivity [m/s]
- var = me%nc%getVariable('soil_hydraulic_conductivity')
- call var%getData(me%soilHydraulicConductivity)
- ! Soil texture [%]
- var = me%nc%getVariable('soil_texture_clay_content')
- call var%getData(me%soilTextureClayContent)
- var = me%nc%getVariable('soil_texture_sand_content')
- call var%getData(me%soilTextureSandContent)
- var = me%nc%getVariable('soil_texture_silt_content')
- call var%getData(me%soilTextureSiltContent)
- var = me%nc%getVariable('soil_texture_coarse_frag_content')
- call var%getData(me%soilTextureCoarseFragContent)
- var = me%nc%getVariable('soil_usle_c_factor')
- call var%getData(me%soilUsleCFactor)
- var = me%nc%getVariable('soil_usle_ls_factor')
- call var%getData(me%soilUsleLSFactor)
- var = me%nc%getVariable('soil_usle_p_factor')
- call var%getData(me%soilUslePFactor)
- ! Soil attachment efficienecy/rate
- ! Try and get attachment rate. This is used preferentially by soil profile
+ if (allocated(me%soilWaterContentFieldCapacity)) deallocate(me%soilWaterContentFieldCapacity)
+ allocate(me%soilWaterContentFieldCapacity(ny,nx))
+ me%soilWaterContentFieldCapacity = nf90_fill_real
+ end if
+
+ ! Soil water content at saturation [cm3/cm3]
+ if (me%nc%hasVariable('soil_water_content_saturation')) then
+ var = me%nc%getVariable('soil_water_content_saturation')
+ if (allocated(me%soilWaterContentSaturation)) deallocate(me%soilWaterContentSaturation)
+ allocate(T2(nx,ny)); call var%getData(T2)
+ allocate(me%soilWaterContentSaturation(ny,nx))
+ me%soilWaterContentSaturation = transpose(T2)
+ deallocate(T2)
+ else
+ if (allocated(me%soilWaterContentSaturation)) deallocate(me%soilWaterContentSaturation)
+ allocate(me%soilWaterContentSaturation(ny,nx))
+ me%soilWaterContentSaturation = nf90_fill_real
+ end if
+
+ ! Soil hydraulic conductivity [m/s]
+ if (me%nc%hasVariable('soil_hydraulic_conductivity')) then
+ var = me%nc%getVariable('soil_hydraulic_conductivity')
+ if (allocated(me%soilHydraulicConductivity)) deallocate(me%soilHydraulicConductivity)
+ allocate(T2(nx,ny)); call var%getData(T2)
+ allocate(me%soilHydraulicConductivity(ny,nx))
+ me%soilHydraulicConductivity = transpose(T2)
+ deallocate(T2)
+ else
+ if (allocated(me%soilHydraulicConductivity)) deallocate(me%soilHydraulicConductivity)
+ allocate(me%soilHydraulicConductivity(ny,nx))
+ me%soilHydraulicConductivity = nf90_fill_real
+ end if
+
+ ! Soil texture [%] — clay
+ if (me%nc%hasVariable('soil_texture_clay_content')) then
+ var = me%nc%getVariable('soil_texture_clay_content')
+ if (allocated(me%soilTextureClayContent)) deallocate(me%soilTextureClayContent)
+ allocate(T2(nx,ny)); call var%getData(T2)
+ allocate(me%soilTextureClayContent(ny,nx))
+ me%soilTextureClayContent = transpose(T2)
+ deallocate(T2)
+ else
+ if (allocated(me%soilTextureClayContent)) deallocate(me%soilTextureClayContent)
+ allocate(me%soilTextureClayContent(ny,nx))
+ me%soilTextureClayContent = nf90_fill_real
+ end if
+
+ ! Soil texture [%] — sand
+ if (me%nc%hasVariable('soil_texture_sand_content')) then
+ var = me%nc%getVariable('soil_texture_sand_content')
+ if (allocated(me%soilTextureSandContent)) deallocate(me%soilTextureSandContent)
+ allocate(T2(nx,ny)); call var%getData(T2)
+ allocate(me%soilTextureSandContent(ny,nx))
+ me%soilTextureSandContent = transpose(T2)
+ deallocate(T2)
+ else
+ if (allocated(me%soilTextureSandContent)) deallocate(me%soilTextureSandContent)
+ allocate(me%soilTextureSandContent(ny,nx))
+ me%soilTextureSandContent = nf90_fill_real
+ end if
+
+ ! Soil texture [%] — silt
+ if (me%nc%hasVariable('soil_texture_silt_content')) then
+ var = me%nc%getVariable('soil_texture_silt_content')
+ if (allocated(me%soilTextureSiltContent)) deallocate(me%soilTextureSiltContent)
+ allocate(T2(nx,ny)); call var%getData(T2)
+ allocate(me%soilTextureSiltContent(ny,nx))
+ me%soilTextureSiltContent = transpose(T2)
+ deallocate(T2)
+ else
+ if (allocated(me%soilTextureSiltContent)) deallocate(me%soilTextureSiltContent)
+ allocate(me%soilTextureSiltContent(ny,nx))
+ me%soilTextureSiltContent = nf90_fill_real
+ end if
+
+ ! Soil texture [%] — coarse fragments
+ if (me%nc%hasVariable('soil_texture_coarse_frag_content')) then
+ var = me%nc%getVariable('soil_texture_coarse_frag_content')
+ if (allocated(me%soilTextureCoarseFragContent)) deallocate(me%soilTextureCoarseFragContent)
+ allocate(T2(nx,ny)); call var%getData(T2)
+ allocate(me%soilTextureCoarseFragContent(ny,nx))
+ me%soilTextureCoarseFragContent = transpose(T2)
+ deallocate(T2)
+ else
+ if (allocated(me%soilTextureCoarseFragContent)) deallocate(me%soilTextureCoarseFragContent)
+ allocate(me%soilTextureCoarseFragContent(ny,nx))
+ me%soilTextureCoarseFragContent = nf90_fill_real
+ end if
+
+ ! USLE factors [-] — C
+ if (me%nc%hasVariable('soil_usle_c_factor')) then
+ var = me%nc%getVariable('soil_usle_c_factor')
+ if (allocated(me%soilUsleCFactor)) deallocate(me%soilUsleCFactor)
+ allocate(T2(nx,ny)); call var%getData(T2)
+ allocate(me%soilUsleCFactor(ny,nx))
+ me%soilUsleCFactor = transpose(T2)
+ deallocate(T2)
+ else
+ if (allocated(me%soilUsleCFactor)) deallocate(me%soilUsleCFactor)
+ allocate(me%soilUsleCFactor(ny,nx))
+ me%soilUsleCFactor = nf90_fill_real
+ end if
+
+ ! USLE factors [-] — LS
+ if (me%nc%hasVariable('soil_usle_ls_factor')) then
+ var = me%nc%getVariable('soil_usle_ls_factor')
+ if (allocated(me%soilUsleLSFactor)) deallocate(me%soilUsleLSFactor)
+ allocate(T2(nx,ny)); call var%getData(T2)
+ allocate(me%soilUsleLSFactor(ny,nx))
+ me%soilUsleLSFactor = transpose(T2)
+ deallocate(T2)
+ else
+ if (allocated(me%soilUsleLSFactor)) deallocate(me%soilUsleLSFactor)
+ allocate(me%soilUsleLSFactor(ny,nx))
+ me%soilUsleLSFactor = nf90_fill_real
+ end if
+
+ ! USLE factors [-] — P
+ if (me%nc%hasVariable('soil_usle_p_factor')) then
+ var = me%nc%getVariable('soil_usle_p_factor')
+ if (allocated(me%soilUslePFactor)) deallocate(me%soilUslePFactor)
+ allocate(T2(nx,ny)); call var%getData(T2)
+ allocate(me%soilUslePFactor(ny,nx))
+ me%soilUslePFactor = transpose(T2)
+ deallocate(T2)
+ else
+ if (allocated(me%soilUslePFactor)) deallocate(me%soilUslePFactor)
+ allocate(me%soilUslePFactor(ny,nx))
+ me%soilUslePFactor = nf90_fill_real
+ end if
+
+ ! Soil attachment — prefer explicit rate; otherwise efficiency (default fallback elsewhere)
if (me%nc%hasVariable('soil_attachment_rate')) then
var = me%nc%getVariable('soil_attachment_rate')
- call var%getData(me%soilAttachmentRate)
+ if (allocated(me%soilAttachmentRate)) deallocate(me%soilAttachmentRate)
+ allocate(T2(nx,ny)); call var%getData(T2)
+ allocate(me%soilAttachmentRate(ny,nx))
+ me%soilAttachmentRate = transpose(T2)
+ deallocate(T2)
else
- allocate(me%soilAttachmentRate(me%gridShape(1), me%gridShape(2)))
+ if (allocated(me%soilAttachmentRate)) deallocate(me%soilAttachmentRate)
+ allocate(me%soilAttachmentRate(ny,nx))
me%soilAttachmentRate = nf90_fill_real
end if
- ! Try and get attachment efficiency. This is used to calculate rate
- ! if rate not present. Defaults to to value given in constants file
+
if (me%nc%hasVariable('soil_attachment_efficiency')) then
var = me%nc%getVariable('soil_attachment_efficiency')
- call var%getData(me%soilAttachmentEfficiency)
+ if (allocated(me%soilAttachmentEfficiency)) deallocate(me%soilAttachmentEfficiency)
+ allocate(T2(nx,ny)); call var%getData(T2)
+ allocate(me%soilAttachmentEfficiency(ny,nx))
+ me%soilAttachmentEfficiency = transpose(T2)
+ deallocate(T2)
else
- allocate(me%soilAttachmentEfficiency(me%gridShape(1), me%gridShape(2)))
+ if (allocated(me%soilAttachmentEfficiency)) deallocate(me%soilAttachmentEfficiency)
+ allocate(me%soilAttachmentEfficiency(ny,nx))
me%soilAttachmentEfficiency = me%soilConstantAttachmentEfficiency
end if
- ! Try and get resuspension and sediment transport parameters
- ! Defaults to value given in constants file if not present in NetCDF file
- ! TODO add check that at least one of the variables exists, or put a default in there
- if (me%nc%hasVariable('resuspension_alpha')) then
- var = me%nc%getVariable('resuspension_alpha')
- call var%getData(me%resuspensionAlpha)
- else
- allocate(me%resuspensionAlpha(me%gridShape(1), me%gridShape(2)))
- do y = 1, me%gridShape(2)
- do x = 1, me%gridShape(1)
- if (me%isEstuary(x,y)) then
- me%resuspensionAlpha(x,y) = me%waterResuspensionAlphaEstuary
- else
- me%resuspensionAlpha(x,y) = me%waterResuspensionAlpha
- end if
- end do
- end do
- end if
- ! Resuspension beta
- if (me%nc%hasVariable('resuspension_beta')) then
- var = me%nc%getVariable('resuspension_beta')
- call var%getData(me%resuspensionBeta)
- else
- allocate(me%resuspensionBeta(me%gridShape(1), me%gridShape(2)))
- do y = 1, me%gridShape(2)
- do x = 1, me%gridShape(1)
- if (me%isEstuary(x,y)) then
- me%resuspensionBeta(x,y) = me%waterResuspensionBetaEstuary
- else
- me%resuspensionBeta(x,y) = me%waterResuspensionBeta
- end if
- end do
- end do
- end if
+
+ ! ----------------------
+ ! SEDIMENT TRANSPORT
+ ! ----------------------
+ ! Note that these variables use (x,y) indexing (i.e. they aren't transposed
+ ! when they are retrieved from the NetCDF file). This is in constrast to the
+ ! soil spatial variables above, which are transposed to (y,x)
+ !
+ ! If a spatial var is available in the NetCDF file, this is used. If not,
+ ! the constant value is used for the whole grid. If a constant isn't available
+ ! in the constant namelist, this will have already been set to the default
+ ! from ConstantsDefaultsModule
+
! Deposition alpha
if (me%nc%hasVariable('deposition_alpha')) then
var = me%nc%getVariable('deposition_alpha')
@@ -526,6 +605,64 @@ subroutine readBatchVariablesDatabase(me)
allocate(me%depositionBeta(me%gridShape(1), me%gridShape(2)))
me%depositionBeta = me%depositionBetaConstant
end if
+
+ ! Resuspension alpha
+ ! TODO add check that at least one of the variables exists, or put a default in
+ if (me%nc%hasVariable('resuspension_alpha')) then
+ var = me%nc%getVariable('resuspension_alpha')
+ call var%getData(me%resuspensionAlpha)
+ else
+ allocate(me%resuspensionAlpha(me%gridShape(1), me%gridShape(2)))
+ ! Use the estuary mask to get a different resuspension alpha value in
+ ! estuaries. If no specific alpha value is given for estuaries, it
+ ! defaults to that for rivers
+ where (me%isEstuary)
+ me%resuspensionAlpha = me%waterResuspensionAlphaEstuary
+ elsewhere
+ me%resuspensionAlpha = me%waterResuspensionAlpha
+ end where
+ end if
+ ! Resuspension beta
+ if (me%nc%hasVariable('resuspension_beta')) then
+ var = me%nc%getVariable('resuspension_beta')
+ call var%getData(me%resuspensionBeta)
+ else
+ allocate(me%resuspensionBeta(me%gridShape(1), me%gridShape(2)))
+ ! Same as for alpha, use different value for estuaries if available
+ where (me%isEstuary)
+ me%resuspensionBeta = me%waterResuspensionBetaEstuary
+ elsewhere
+ me%resuspensionBeta = me%waterResuspensionBeta
+ end where
+ end if
+
+ ! Sediment transport param a
+ if (me%nc%hasVariable('sediment_transport_a')) then
+ var = me%nc%getVariable('sediment_transport_a')
+ call var%getData(me%sedimentTransport_a)
+ else
+ allocate(me%sedimentTransport_a(me%gridShape(1), me%gridShape(2)))
+ me%sedimentTransport_a = me%sedimentTransport_aConstant
+ end if
+
+ ! Sediment transport param b
+ if (me%nc%hasVariable('sediment_transport_b')) then
+ var = me%nc%getVariable('sediment_transport_b')
+ call var%getData(me%sedimentTransport_b)
+ else
+ allocate(me%sedimentTransport_b(me%gridShape(1), me%gridShape(2)))
+ me%sedimentTransport_b = me%sedimentTransport_bConstant
+ end if
+
+ ! Sediment transport param b
+ if (me%nc%hasVariable('sediment_transport_c')) then
+ var = me%nc%getVariable('sediment_transport_c')
+ call var%getData(me%sedimentTransport_c)
+ else
+ allocate(me%sedimentTransport_c(me%gridShape(1), me%gridShape(2)))
+ me%sedimentTransport_c = me%sedimentTransport_cConstant
+ end if
+
! Bank erosion alpha
if (me%nc%hasVariable('bank_erosion_alpha')) then
var = me%nc%getVariable('bank_erosion_alpha')
@@ -534,6 +671,7 @@ subroutine readBatchVariablesDatabase(me)
allocate(me%bankErosionAlpha(me%gridShape(1), me%gridShape(2)))
me%bankErosionAlpha = me%bankErosionAlphaConstant
end if
+
! Bank erosion beta
if (me%nc%hasVariable('bank_erosion_beta')) then
var = me%nc%getVariable('bank_erosion_beta')
@@ -542,326 +680,626 @@ subroutine readBatchVariablesDatabase(me)
allocate(me%bankErosionBeta(me%gridShape(1), me%gridShape(2)))
me%bankErosionBeta = me%bankErosionBetaConstant
end if
- ! Sediment transport param a
- if (me%nc%hasVariable('sediment_transport_a')) then
- var = me%nc%getVariable('sediment_transport_a')
- call var%getData(me%sedimentTransport_a)
+
+
+ !----------------------
+ ! BASIC TIME SERIES
+ !----------------------
+ if (me%nc%hasVariable('quickflow')) then
+ var = me%nc%getVariable('quickflow') ! (t,y,x) in file
+ if (allocated(me%quickflow)) deallocate(me%quickflow)
+ allocate(me%quickflow(nx,ny,nt))
+ call var%getData(me%quickflow) ! library reverses -> (x,y,t)
else
- allocate(me%sedimentTransport_a(me%gridShape(1), me%gridShape(2)))
- me%sedimentTransport_a = me%sedimentTransport_aConstant
+ if (allocated(me%quickflow)) deallocate(me%quickflow)
+ allocate(me%quickflow(nx,ny,nt))
+ me%quickflow = 0.0_dp
end if
- ! Sediment transport param b
- if (me%nc%hasVariable('sediment_transport_b')) then
- var = me%nc%getVariable('sediment_transport_b')
- call var%getData(me%sedimentTransport_b)
+
+ if (me%nc%hasVariable('runoff')) then
+ var = me%nc%getVariable('runoff')
+ if (allocated(me%runoff)) deallocate(me%runoff)
+ allocate(me%runoff(nx,ny,nt))
+ call var%getData(me%runoff)
else
- allocate(me%sedimentTransport_b(me%gridShape(1), me%gridShape(2)))
- me%sedimentTransport_b = me%sedimentTransport_bConstant
+ if (allocated(me%runoff)) deallocate(me%runoff)
+ allocate(me%runoff(nx,ny,nt))
+ me%runoff = 0.0_dp
end if
- ! Sediment transport param c
- if (me%nc%hasVariable('sediment_transport_c')) then
- var = me%nc%getVariable('sediment_transport_c')
- call var%getData(me%sedimentTransport_c)
+
+ if (me%nc%hasVariable('precip')) then
+ var = me%nc%getVariable('precip')
+ if (allocated(me%precip)) deallocate(me%precip)
+ allocate(me%precip(nx,ny,nt))
+ call var%getData(me%precip)
else
- allocate(me%sedimentTransport_c(me%gridShape(1), me%gridShape(2)))
- me%sedimentTransport_c = me%sedimentTransport_cConstant
- end if
-
- ! Initial concentrations [kg/volume]
- ! if (me%nc%hasVariable('initial_nm_concs_soil')) then
- ! var = me%nc%getVariable('initial_nm_concs_soil')
- ! call var%getData(me%initialNMConcsSoil)
- ! else
- ! allocate(me%initialNMConcsSoil(me%maxNWaterbodies, me%gridShape(1), me%gridShape(2))))
- ! me%initialNMConcsSoil = 0.0_dp
- ! end if
- ! if (me%nc%hasVariable('initial_transformed_concs_soil')) then
- ! var = me%nc%getVariable('initial_transformed_concs_soil')
- ! call var%getData(me%initialTransformedConcsSoil)
- ! else
- ! allocate(me%initialTransformedConcsSoil(me%maxNWaterbodies, me%gridShape(1), me%gridShape(2))))
- ! me%initialTransformedConcsSoil = 0.0_dp
- ! end if
-
- ! Emissions - areal [kg/m2/timestep]
- ! Soil
+ if (allocated(me%precip)) deallocate(me%precip)
+ allocate(me%precip(nx,ny,nt))
+ me%precip = 0.0_dp
+ end if
+
+ if (me%nc%hasVariable('evap')) then
+ var = me%nc%getVariable('evap')
+ if (allocated(me%evap)) deallocate(me%evap)
+ allocate(me%evap(nx,ny,nt))
+ call var%getData(me%evap)
+ else
+ if (allocated(me%evap)) deallocate(me%evap)
+ allocate(me%evap(nx,ny,nt))
+ me%evap = 0.0_dp
+ end if
+
+ !----------------------
+ ! POINT-SOURCE DIM
+ !----------------------
+ if (me%nc%hasDimension('p')) then
+ p_dim = me%nc%getDimension('p')
+ me%maxPointSources = p_dim%getLength()
+ else
+ me%maxPointSources = 0
+ end if
+ np = max(1, me%maxPointSources)
+
+ !----------------------
+ ! DEALLOC & ALLOC EMISSIONS
+ !----------------------
+ if (allocated(me%emissionsArealSoilContaminant)) &
+ deallocate(me%emissionsArealSoilContaminant)
+ if (allocated(me%emissionsArealWaterContaminant)) &
+ deallocate(me%emissionsArealWaterContaminant)
+ if (allocated(me%emissionsAtmosphericDryDepoContaminant)) &
+ deallocate(me%emissionsAtmosphericDryDepoContaminant)
+ if (allocated(me%emissionsAtmosphericWetDepoContaminant)) &
+ deallocate(me%emissionsAtmosphericWetDepoContaminant)
+ if (allocated(me%emissionsPointWaterContaminant)) &
+ deallocate(me%emissionsPointWaterContaminant)
+ if (allocated(me%emissionsArealSoilDissolvedContaminant)) &
+ deallocate(me%emissionsArealSoilDissolvedContaminant)
+ if (allocated(me%emissionsArealWaterDissolvedContaminant)) &
+ deallocate(me%emissionsArealWaterDissolvedContaminant)
+ if (allocated(me%emissionsAtmosphericDryDepoDissolvedContaminant)) &
+ deallocate(me%emissionsAtmosphericDryDepoDissolvedContaminant)
+ if (allocated(me%emissionsAtmosphericWetDepoDissolvedContaminant)) &
+ deallocate(me%emissionsAtmosphericWetDepoDissolvedContaminant)
+ if (allocated(me%emissionsPointWaterDissolvedContaminant)) &
+ deallocate(me%emissionsPointWaterDissolvedContaminant)
+ if (allocated(me%emissionsPointWaterCoords)) &
+ deallocate(me%emissionsPointWaterCoords)
+
+ allocate( &
+ me%emissionsArealSoilContaminant( nx, ny, nsizes, nforms, C%contaminantDim(3) ), &
+ me%emissionsArealWaterContaminant( nx, ny, nsizes, nforms, C%contaminantDim(3) ), &
+ me%emissionsAtmosphericDryDepoContaminant( nx, ny, nt, nsizes, nforms, &
+ C%contaminantDim(3) ), &
+ me%emissionsAtmosphericWetDepoContaminant( nx, ny, nt, nsizes, nforms, &
+ C%contaminantDim(3) ), &
+ me%emissionsPointWaterContaminant( nx, ny, nt, np, nsizes, nforms, &
+ C%contaminantDim(3) ), &
+ me%emissionsArealSoilDissolvedContaminant( nx, ny ), &
+ me%emissionsArealWaterDissolvedContaminant( nx, ny ), &
+ me%emissionsAtmosphericDryDepoDissolvedContaminant( nx, ny, nt ), &
+ me%emissionsAtmosphericWetDepoDissolvedContaminant( nx, ny, nt ), &
+ me%emissionsPointWaterDissolvedContaminant( nx, ny, nt ), &
+ stat=alloc_stat )
+
+ if (alloc_stat /= 0) then
+ call ERROR_HANDLER%trigger( &
+ error=ErrorInstance(message='Emission allocation failed') )
+ return
+ end if
+
+ me%emissionsArealSoilContaminant = 0.0_dp
+ me%emissionsArealWaterContaminant = 0.0_dp
+ me%emissionsAtmosphericDryDepoContaminant = 0.0_dp
+ me%emissionsAtmosphericWetDepoContaminant = 0.0_dp
+ me%emissionsPointWaterContaminant = 0.0_dp
+ me%emissionsArealSoilDissolvedContaminant = 0.0_dp
+ me%emissionsArealWaterDissolvedContaminant = 0.0_dp
+ me%emissionsAtmosphericDryDepoDissolvedContaminant = 0.0_dp
+ me%emissionsAtmosphericWetDepoDissolvedContaminant = 0.0_dp
+ me%emissionsPointWaterDissolvedContaminant = 0.0_dp
+
+ !-----------------------------------
+ ! AREAL EMISSIONS (2-D y,x -> (x,y))
+ !-----------------------------------
+
+ ! 1. SOIL EMISSIONS (PRISTINE) - Updated with Fallback
+ ! ----------------------------------------------------
if (me%nc%hasVariable('emissions_areal_soil_pristine')) then
+ ! Try NEW name first
var = me%nc%getVariable('emissions_areal_soil_pristine')
- call var%getData(me%emissionsArealSoilPristine)
- else
- allocate(me%emissionsArealSoilPristine(me%gridShape(1), me%gridShape(2)))
- me%emissionsArealSoilPristine = nf90_fill_double
+ allocate(A2(nx,ny)); call var%getData(A2)
+ me%emissionsArealSoilContaminant(:,:,1,f_pris,FREE_CONTAMINANT) = A2
+ do n = 2, nsizes
+ me%emissionsArealSoilContaminant(:,:,n,f_pris,FREE_CONTAMINANT) = &
+ A2 * me%defaultDistributionContaminant(n)
+ end do
+ deallocate(A2)
+ call LOGR%add("DataInput: Read 'emissions_areal_soil_pristine'")
+
+ else if (me%nc%hasVariable('emissions_areal_soil_nm')) then
+ ! FALLBACK: Try OLD name (legacy support)
+ var = me%nc%getVariable('emissions_areal_soil_nm')
+ allocate(A2(nx,ny)); call var%getData(A2)
+
+ ! Map legacy 'nm' emissions to 'pristine' form
+ me%emissionsArealSoilContaminant(:,:,1,f_pris,FREE_CONTAMINANT) = A2
+ do n = 2, nsizes
+ me%emissionsArealSoilContaminant(:,:,n,f_pris,FREE_CONTAMINANT) = &
+ A2 * me%defaultDistributionContaminant(n)
+ end do
+ deallocate(A2)
+ call LOGR%add("DataInput: Read legacy 'emissions_areal_soil_nm' as pristine")
end if
+
+ ! 2. SOIL EMISSIONS (MATRIX EMBEDDED)
+ ! -----------------------------------
if (me%nc%hasVariable('emissions_areal_soil_matrixembedded')) then
var = me%nc%getVariable('emissions_areal_soil_matrixembedded')
- call var%getData(me%emissionsArealSoilMatrixEmbedded)
- else
- allocate(me%emissionsArealSoilMatrixEmbedded(me%gridShape(1), me%gridShape(2)))
- me%emissionsArealSoilMatrixEmbedded = nf90_fill_double
+ allocate(A2(nx,ny)); call var%getData(A2)
+ me%emissionsArealSoilContaminant(:,:,1,f_mat,FREE_CONTAMINANT) = A2
+ do n = 2, nsizes
+ me%emissionsArealSoilContaminant(:,:,n,f_mat,FREE_CONTAMINANT) = &
+ A2 * me%defaultDistributionContaminant(n)
+ end do
+ deallocate(A2)
end if
+
+ ! 3. SOIL EMISSIONS (TRANSFORMED)
+ ! -------------------------------
if (me%nc%hasVariable('emissions_areal_soil_transformed')) then
var = me%nc%getVariable('emissions_areal_soil_transformed')
- call var%getData(me%emissionsArealSoilTransformed)
- else
- allocate(me%emissionsArealSoilTransformed(me%gridShape(1), me%gridShape(2)))
- me%emissionsArealSoilTransformed = nf90_fill_double
- end if
- if (me%nc%hasVariable('emissions_areal_soil_dissolved')) then
- var = me%nc%getVariable('emissions_areal_soil_dissolved')
- call var%getData(me%emissionsArealSoilDissolved)
- else
- allocate(me%emissionsArealSoilDissolved(me%gridShape(1), me%gridShape(2)))
- me%emissionsArealSoilDissolved = nf90_fill_double
+ allocate(A2(nx,ny)); call var%getData(A2)
+ me%emissionsArealSoilContaminant(:,:,1,f_tra,FREE_CONTAMINANT) = A2
+ do n = 2, nsizes
+ me%emissionsArealSoilContaminant(:,:,n,f_tra,FREE_CONTAMINANT) = &
+ A2 * me%defaultDistributionContaminant(n)
+ end do
+ deallocate(A2)
end if
- ! Water
+
+ ! 4. WATER EMISSIONS (PRISTINE) - Updated with Fallback
+ ! -----------------------------------------------------
if (me%nc%hasVariable('emissions_areal_water_pristine')) then
+ ! Try NEW name first
var = me%nc%getVariable('emissions_areal_water_pristine')
- call var%getData(me%emissionsArealWaterPristine)
- else
- allocate(me%emissionsArealWaterPristine(me%gridShape(1), me%gridShape(2)))
- me%emissionsArealWaterPristine = nf90_fill_double
+ allocate(A2(nx,ny)); call var%getData(A2)
+ me%emissionsArealWaterContaminant(:,:,1,f_pris,FREE_CONTAMINANT) = A2
+ do n = 2, nsizes
+ me%emissionsArealWaterContaminant(:,:,n,f_pris,FREE_CONTAMINANT) = &
+ A2 * me%defaultDistributionContaminant(n)
+ end do
+ deallocate(A2)
+ call LOGR%add("DataInput: Read 'emissions_areal_water_pristine'")
+
+ else if (me%nc%hasVariable('emissions_areal_water_nm')) then
+ ! FALLBACK: Try OLD name (legacy support)
+ var = me%nc%getVariable('emissions_areal_water_nm')
+ allocate(A2(nx,ny)); call var%getData(A2)
+
+ ! Map legacy 'nm' emissions to 'pristine' form
+ me%emissionsArealWaterContaminant(:,:,1,f_pris,FREE_CONTAMINANT) = A2
+ do n = 2, nsizes
+ me%emissionsArealWaterContaminant(:,:,n,f_pris,FREE_CONTAMINANT) = &
+ A2 * me%defaultDistributionContaminant(n)
+ end do
+ deallocate(A2)
+ call LOGR%add("DataInput: Read legacy 'emissions_areal_water_nm' as pristine")
end if
+
+ ! 5. WATER EMISSIONS (MATRIX EMBEDDED)
+ ! ------------------------------------
if (me%nc%hasVariable('emissions_areal_water_matrixembedded')) then
var = me%nc%getVariable('emissions_areal_water_matrixembedded')
- call var%getData(me%emissionsArealWaterMatrixEmbedded)
- else
- allocate(me%emissionsArealWaterMatrixEmbedded(me%gridShape(1), me%gridShape(2)))
- me%emissionsArealWaterMatrixEmbedded = nf90_fill_double
+ allocate(A2(nx,ny)); call var%getData(A2)
+ me%emissionsArealWaterContaminant(:,:,1,f_mat,FREE_CONTAMINANT) = A2
+ do n = 2, nsizes
+ me%emissionsArealWaterContaminant(:,:,n,f_mat,FREE_CONTAMINANT) = &
+ A2 * me%defaultDistributionContaminant(n)
+ end do
+ deallocate(A2)
end if
+
+ ! 6. WATER EMISSIONS (TRANSFORMED)
+ ! --------------------------------
if (me%nc%hasVariable('emissions_areal_water_transformed')) then
var = me%nc%getVariable('emissions_areal_water_transformed')
- call var%getData(me%emissionsArealWaterTransformed)
- else
- allocate(me%emissionsArealWaterTransformed(me%gridShape(1), me%gridShape(2)))
- me%emissionsArealWaterTransformed = nf90_fill_double
+ allocate(A2(nx,ny)); call var%getData(A2)
+ me%emissionsArealWaterContaminant(:,:,1,f_tra,FREE_CONTAMINANT) = A2
+ do n = 2, nsizes
+ me%emissionsArealWaterContaminant(:,:,n,f_tra,FREE_CONTAMINANT) = &
+ A2 * me%defaultDistributionContaminant(n)
+ end do
+ deallocate(A2)
+ end if
+
+ ! 7. DISSOLVED EMISSIONS
+ ! ----------------------
+ if (me%nc%hasVariable('emissions_areal_soil_dissolved')) then
+ var = me%nc%getVariable('emissions_areal_soil_dissolved')
+ allocate(A2(nx,ny)); call var%getData(A2)
+ me%emissionsArealSoilDissolvedContaminant = A2
+ deallocate(A2)
end if
+
if (me%nc%hasVariable('emissions_areal_water_dissolved')) then
var = me%nc%getVariable('emissions_areal_water_dissolved')
- call var%getData(me%emissionsArealWaterDissolved)
- else
- allocate(me%emissionsArealWaterDissolved(me%gridShape(1), me%gridShape(2)))
- me%emissionsArealWaterDissolved = nf90_fill_double
+ allocate(A2(nx,ny)); call var%getData(A2)
+ me%emissionsArealWaterDissolvedContaminant = A2
+ deallocate(A2)
end if
- ! Emissions - atmospheric [kg/m2/timestep]
+ !-----------------------------------------
+ ! ATMOSPHERIC DEPOSITION (3-D t,y,x → (x,y,t))
+ !-----------------------------------------
if (me%nc%hasVariable('emissions_atmospheric_drydepo_pristine')) then
var = me%nc%getVariable('emissions_atmospheric_drydepo_pristine')
- call var%getData(me%emissionsAtmosphericDryDepoPristine)
- else
- allocate(me%emissionsAtmosphericDryDepoPristine(me%gridShape(1), me%gridShape(2), me%nTimesteps))
- me%emissionsAtmosphericDryDepoPristine = nf90_fill_double
+ allocate(A3(nx,ny,nt)); call var%getData(A3)
+ me%emissionsAtmosphericDryDepoContaminant(:,:,:,1,f_pris,FREE_CONTAMINANT) = A3
+ do n = 2, nsizes
+ me%emissionsAtmosphericDryDepoContaminant(:,:,:,n,f_pris,FREE_CONTAMINANT) = &
+ A3 * me%defaultDistributionContaminant(n)
+ end do
+ deallocate(A3)
end if
+
if (me%nc%hasVariable('emissions_atmospheric_drydepo_matrixembedded')) then
var = me%nc%getVariable('emissions_atmospheric_drydepo_matrixembedded')
- call var%getData(me%emissionsAtmosphericDryDepoMatrixEmbedded)
- else
- allocate(me%emissionsAtmosphericDryDepoMatrixEmbedded(me%gridShape(1), me%gridShape(2), me%nTimesteps))
- me%emissionsAtmosphericDryDepoMatrixEmbedded = nf90_fill_double
+ allocate(A3(nx,ny,nt)); call var%getData(A3)
+ me%emissionsAtmosphericDryDepoContaminant(:,:,:,1,f_mat,FREE_CONTAMINANT) = A3
+ do n = 2, nsizes
+ me%emissionsAtmosphericDryDepoContaminant(:,:,:,n,f_mat,FREE_CONTAMINANT) = &
+ A3 * me%defaultDistributionContaminant(n)
+ end do
+ deallocate(A3)
end if
+
if (me%nc%hasVariable('emissions_atmospheric_drydepo_transformed')) then
var = me%nc%getVariable('emissions_atmospheric_drydepo_transformed')
- call var%getData(me%emissionsAtmosphericDryDepoTransformed)
- else
- allocate(me%emissionsAtmosphericDryDepoTransformed(me%gridShape(1), me%gridShape(2), me%nTimesteps))
- me%emissionsAtmosphericDryDepoTransformed = nf90_fill_double
- end if
- if (me%nc%hasVariable('emissions_atmospheric_drydepo_dissolved')) then
- var = me%nc%getVariable('emissions_atmospheric_drydepo_dissolved')
- call var%getData(me%emissionsAtmosphericDryDepoDissolved)
- else
- allocate(me%emissionsAtmosphericDryDepoDissolved(me%gridShape(1), me%gridShape(2), me%nTimesteps))
- me%emissionsAtmosphericDryDepoDissolved = nf90_fill_double
+ allocate(A3(nx,ny,nt)); call var%getData(A3)
+ me%emissionsAtmosphericDryDepoContaminant(:,:,:,1,f_tra,FREE_CONTAMINANT) = A3
+ do n = 2, nsizes
+ me%emissionsAtmosphericDryDepoContaminant(:,:,:,n,f_tra,FREE_CONTAMINANT) = &
+ A3 * me%defaultDistributionContaminant(n)
+ end do
+ deallocate(A3)
end if
+
if (me%nc%hasVariable('emissions_atmospheric_wetdepo_pristine')) then
var = me%nc%getVariable('emissions_atmospheric_wetdepo_pristine')
- call var%getData(me%emissionsAtmosphericWetDepoPristine)
- else
- allocate(me%emissionsAtmosphericWetDepoPristine(me%gridShape(1), me%gridShape(2), me%nTimesteps))
- me%emissionsAtmosphericWetDepoPristine = nf90_fill_double
+ allocate(A3(nx,ny,nt)); call var%getData(A3)
+ me%emissionsAtmosphericWetDepoContaminant(:,:,:,1,f_pris,FREE_CONTAMINANT) = A3
+ do n = 2, nsizes
+ me%emissionsAtmosphericWetDepoContaminant(:,:,:,n,f_pris,FREE_CONTAMINANT) = &
+ A3 * me%defaultDistributionContaminant(n)
+ end do
+ deallocate(A3)
end if
+
if (me%nc%hasVariable('emissions_atmospheric_wetdepo_matrixembedded')) then
var = me%nc%getVariable('emissions_atmospheric_wetdepo_matrixembedded')
- call var%getData(me%emissionsAtmosphericWetDepoMatrixEmbedded)
- else
- allocate(me%emissionsAtmosphericWetDepoMatrixEmbedded(me%gridShape(1), me%gridShape(2), me%nTimesteps))
- me%emissionsAtmosphericWetDepoMatrixEmbedded = nf90_fill_double
+ allocate(A3(nx,ny,nt)); call var%getData(A3)
+ me%emissionsAtmosphericWetDepoContaminant(:,:,:,1,f_mat,FREE_CONTAMINANT) = A3
+ do n = 2, nsizes
+ me%emissionsAtmosphericWetDepoContaminant(:,:,:,n,f_mat,FREE_CONTAMINANT) = &
+ A3 * me%defaultDistributionContaminant(n)
+ end do
+ deallocate(A3)
end if
+
if (me%nc%hasVariable('emissions_atmospheric_wetdepo_transformed')) then
var = me%nc%getVariable('emissions_atmospheric_wetdepo_transformed')
- call var%getData(me%emissionsAtmosphericWetDepoTransformed)
- else
- allocate(me%emissionsAtmosphericWetDepoTransformed(me%gridShape(1), me%gridShape(2), me%nTimesteps))
- me%emissionsAtmosphericWetDepoTransformed = nf90_fill_double
+ allocate(A3(nx,ny,nt)); call var%getData(A3)
+ me%emissionsAtmosphericWetDepoContaminant(:,:,:,1,f_tra,FREE_CONTAMINANT) = A3
+ do n = 2, nsizes
+ me%emissionsAtmosphericWetDepoContaminant(:,:,:,n,f_tra,FREE_CONTAMINANT) = &
+ A3 * me%defaultDistributionContaminant(n)
+ end do
+ deallocate(A3)
end if
+
+ if (me%nc%hasVariable('emissions_atmospheric_drydepo_dissolved')) then
+ var = me%nc%getVariable('emissions_atmospheric_drydepo_dissolved')
+ allocate(A3(nx,ny,nt)); call var%getData(A3)
+ me%emissionsAtmosphericDryDepoDissolvedContaminant = A3
+ deallocate(A3)
+ end if
+
if (me%nc%hasVariable('emissions_atmospheric_wetdepo_dissolved')) then
var = me%nc%getVariable('emissions_atmospheric_wetdepo_dissolved')
- call var%getData(me%emissionsAtmosphericWetDepoDissolved)
- else
- allocate(me%emissionsAtmosphericWetDepoDissolved(me%gridShape(1), me%gridShape(2), me%nTimesteps))
- me%emissionsAtmosphericWetDepoDissolved = nf90_fill_double
+ allocate(A3(nx,ny,nt)); call var%getData(A3)
+ me%emissionsAtmosphericWetDepoDissolvedContaminant = A3
+ deallocate(A3)
end if
- ! Emissions - point (all water) [kg/timestep]
- ! Check there's actually a p (number of point source) dimension first, in case the
- ! data was provided without point sources
- if (me%nc%hasDimension('p')) then
- p_dim = me%nc%getDimension('p')
- me%maxPointSources = p_dim%getLength()
+ !-----------------------------------------
+ ! POINT-SOURCE COORDS (4-D x,y,p,2)
+ !-----------------------------------------
+ haveCoordVar = .false.
+ if (me%nc%hasVariable('emissions_point_water_contaminant_coords')) then
+ var = me%nc%getVariable('emissions_point_water_contaminant_coords')
+ haveCoordVar = .true.
+ else if (me%nc%hasVariable('emissions_point_water_pristine_coords')) then
+ var = me%nc%getVariable('emissions_point_water_pristine_coords')
+ haveCoordVar = .true.
+ else if (me%nc%hasVariable('emissions_point_water_matrixembedded_coords')) then
+ var = me%nc%getVariable('emissions_point_water_matrixembedded_coords')
+ haveCoordVar = .true.
+ end if
+
+ if (allocated(me%emissionsPointWaterCoords)) &
+ deallocate(me%emissionsPointWaterCoords)
+ allocate(me%emissionsPointWaterCoords(nx, ny, me%maxPointSources, 2))
+
+ if (haveCoordVar) then
+ allocate(COORD4(nx, ny, me%maxPointSources, 2))
+ call var%getData(COORD4) ! library returns (x,y,p,d)
+ me%emissionsPointWaterCoords = COORD4
+ deallocate(COORD4)
else
- me%maxPointSources = 0
+ me%emissionsPointWaterCoords = nf90_fill_double
end if
- ! Pristine
- if (me%nc%hasVariable('emissions_point_water_pristine')) then
- var = me%nc%getVariable('emissions_point_water_pristine')
- call var%getData(me%emissionsPointWaterPristine)
- ! Get point source coords
- if (me%nc%hasVariable('emissions_point_water_pristine_coords')) then
- var = me%nc%getVariable('emissions_point_water_pristine_coords')
- call var%getData(me%emissionsPointWaterCoords)
+
+ !-----------------------------------------
+ ! POINT-SOURCE EMISSIONS (4-D p,t,y,x → (x,y,t,p))
+ !-----------------------------------------
+ if (me%maxPointSources > 0) then
+
+ if (me%nc%hasVariable('emissions_point_water_pristine')) then
+ var = me%nc%getVariable('emissions_point_water_pristine')
+ allocate(A4(nx,ny,nt,np)); call var%getData(A4) ! (x,y,t,p)
+ ! size=1 takes raw; n=2..nsizes distributed
+ me%emissionsPointWaterContaminant(:,:,:,1:np,1,f_pris,FREE_CONTAMINANT) = A4
+ do n = 2, nsizes
+ me%emissionsPointWaterContaminant(:,:,:,1:np,n,f_pris,FREE_CONTAMINANT) = &
+ A4 * me%defaultDistributionContaminant(n)
+ end do
+ deallocate(A4)
end if
- else
- allocate(me%emissionsPointWaterPristine(me%gridShape(1), me%gridShape(2), me%nTimesteps, me%maxPointSources))
- me%emissionsPointWaterPristine = nf90_fill_double
- end if
- ! Matrix-embedded
- if (me%nc%hasVariable('emissions_point_water_matrixembedded')) then
- var = me%nc%getVariable('emissions_point_water_matrixembedded')
- call var%getData(me%emissionsPointWaterMatrixEmbedded)
- ! Get point source coords
- if (me%nc%hasVariable('emissions_point_water_matrixembedded_coords')) then
- var = me%nc%getVariable('emissions_point_water_matrixembedded_coords')
- call var%getData(me%emissionsPointWaterCoords)
+
+ if (me%nc%hasVariable('emissions_point_water_matrixembedded')) then
+ var = me%nc%getVariable('emissions_point_water_matrixembedded')
+ allocate(A4(nx,ny,nt,np)); call var%getData(A4) ! (x,y,t,p)
+ me%emissionsPointWaterContaminant(:,:,:,1:np,1,f_mat,FREE_CONTAMINANT) = A4
+ do n = 2, nsizes
+ me%emissionsPointWaterContaminant(:,:,:,1:np,n,f_mat,FREE_CONTAMINANT) = &
+ A4 * me%defaultDistributionContaminant(n)
+ end do
+ deallocate(A4)
end if
- else
- allocate(me%emissionsPointWaterMatrixEmbedded(me%gridShape(1), me%gridShape(2), me%nTimesteps, me%maxPointSources))
- me%emissionsPointWaterMatrixEmbedded = nf90_fill_double
- end if
- ! Transformed
- if (me%nc%hasVariable('emissions_point_water_transformed')) then
- var = me%nc%getVariable('emissions_point_water_transformed')
- call var%getData(me%emissionsPointWaterTransformed)
- ! Get point source coords
- if (me%nc%hasVariable('emissions_point_water_transformed_coords')) then
- var = me%nc%getVariable('emissions_point_water_transformed_coords')
- call var%getData(me%emissionsPointWaterCoords)
+
+ ! Optional: only if present in file
+ if (me%nc%hasVariable('emissions_point_water_transformed')) then
+ var = me%nc%getVariable('emissions_point_water_transformed')
+ allocate(A4(nx,ny,nt,np)); call var%getData(A4) ! (x,y,t,p)
+ me%emissionsPointWaterContaminant(:,:,:,1:np,1,f_tra,FREE_CONTAMINANT) = A4
+ do n = 2, nsizes
+ me%emissionsPointWaterContaminant(:,:,:,1:np,n,f_tra,FREE_CONTAMINANT) = &
+ A4 * me%defaultDistributionContaminant(n)
+ end do
+ deallocate(A4)
end if
+
+ end if
+
+ ! -----------------------------------
+ ! INITIAL CONCENTRATIONS
+ ! -----------------------------------
+ if (allocated(me%initialContaminantConcsSoil)) deallocate(me%initialContaminantConcsSoil)
+ if (allocated(me%initialContaminantConcsWater)) deallocate(me%initialContaminantConcsWater)
+ if (allocated(me%initialContaminantConcsSediment)) deallocate(me%initialContaminantConcsSediment)
+
+ allocate(me%initialContaminantConcsSoil( nx,ny,nsizes,nforms, C%contaminantDim(3)))
+ allocate(me%initialContaminantConcsWater( nx,ny,nsizes,nforms, C%contaminantDim(3)))
+ allocate(me%initialContaminantConcsSediment(nx,ny,nsizes,nforms, C%contaminantDim(3)))
+
+ me%initialContaminantConcsSoil = 0.0_dp
+ me%initialContaminantConcsWater = 0.0_dp
+ me%initialContaminantConcsSediment = 0.0_dp
+
+ ! --- 1. SOIL INITIAL CONCENTRATIONS ---
+ if (me%nc%hasVariable('initial_contaminant_concs_soil')) then
+ ! Try NEW name
+ var = me%nc%getVariable('initial_contaminant_concs_soil')
+ call var%getData(me%initialContaminantConcsSoil)
+ call LOGR%add("DataInput: Read 'initial_contaminant_concs_soil'")
+ else if (me%nc%hasVariable('initial_nm_concs_soil')) then
+ ! FALLBACK: Try OLD name
+ var = me%nc%getVariable('initial_nm_concs_soil')
+ call var%getData(me%initialContaminantConcsSoil)
+ call LOGR%add("DataInput: Read legacy 'initial_nm_concs_soil'")
else
- allocate(me%emissionsPointWaterTransformed(me%gridShape(1), me%gridShape(2), me%nTimesteps, me%maxPointSources))
- me%emissionsPointWaterTransformed = nf90_fill_double
- end if
- if (me%nc%hasVariable('emissions_point_water_dissolved')) then
- var = me%nc%getVariable('emissions_point_water_dissolved')
- call var%getData(me%emissionsPointWaterDissolved)
- ! Get point source coords
- if (me%nc%hasVariable('emissions_point_water_dissolved_coords')) then
- var = me%nc%getVariable('emissions_point_water_dissolved_coords')
- call var%getData(me%emissionsPointWaterCoords)
- end if
+ call LOGR%add("DataInput: WARNING - No initial SOIL contaminant data found. Set to 0.0.")
+ end if
+
+ ! --- 2. WATER INITIAL CONCENTRATIONS ---
+ if (me%nc%hasVariable('initial_contaminant_concs_water')) then
+ ! Try NEW name
+ var = me%nc%getVariable('initial_contaminant_concs_water')
+ call var%getData(me%initialContaminantConcsWater)
+ call LOGR%add("DataInput: Read 'initial_contaminant_concs_water'")
+ else if (me%nc%hasVariable('initial_nm_concs_water')) then
+ ! FALLBACK: Try OLD name
+ var = me%nc%getVariable('initial_nm_concs_water')
+ call var%getData(me%initialContaminantConcsWater)
+ call LOGR%add("DataInput: Read legacy 'initial_nm_concs_water'")
else
- allocate(me%emissionsPointWaterDissolved(me%gridShape(1), me%gridShape(2), me%nTimesteps, me%maxPointSources))
- me%emissionsPointWaterDissolved = nf90_fill_double
+ call LOGR%add("DataInput: WARNING - No initial WATER contaminant data found. Set to 0.0.")
end if
- ! Emissions - point coordinates. We only need to use one form's point coords (they should
- ! all be the same), so we'll go through them all until we hit one that exists (in case
- ! we're only inputting a certain form)
- if ((me%maxPointSources > 0) .and. (.not. allocated(me%emissionsPointWaterCoords))) then
- call ERROR_HANDLER%trigger(error=ErrorInstance( &
- message="Unable to find coordinates for point sources in input data. Check point sources " // &
- "have coordinates sidecar variables." &
- ))
+
+ ! --- 3. SEDIMENT INITIAL CONCENTRATIONS ---
+ if (me%nc%hasVariable('initial_contaminant_concs_sediment')) then
+ ! Try NEW name
+ var = me%nc%getVariable('initial_contaminant_concs_sediment')
+ call var%getData(me%initialContaminantConcsSediment)
+ call LOGR%add("DataInput: Read 'initial_contaminant_concs_sediment'")
+ else if (me%nc%hasVariable('initial_nm_concs_sediment')) then
+ ! FALLBACK: Try OLD name
+ var = me%nc%getVariable('initial_nm_concs_sediment')
+ call var%getData(me%initialContaminantConcsSediment)
+ call LOGR%add("DataInput: Read legacy 'initial_nm_concs_sediment'")
+ else
+ call LOGR%add("DataInput: WARNING - No initial SEDIMENT contaminant data found. Set to 0.0.")
end if
- ! Calculate the number of point source per cell
- call me%calculateNPointSources(me%maxPointSources)
+ if (me%nc%hasVariable('initial_dissolved_concentrations_soil')) then
+ var = me%nc%getVariable('initial_dissolved_concentrations_soil')
+ allocate(A2(nx,ny)); call var%getData(A2)
+ me%initialDissolvedConcsSoil = A2
+ deallocate(A2)
+ end if
+ if (me%nc%hasVariable('initial_dissolved_concentrations_water')) then
+ var = me%nc%getVariable('initial_dissolved_concentrations_water')
+ allocate(A2(nx,ny)); call var%getData(A2)
+ me%initialDissolvedConcsWater = A2
+ deallocate(A2)
+ end if
+ if (me%nc%hasVariable('initial_dissolved_concentrations_sediment')) then
+ var = me%nc%getVariable('initial_dissolved_concentrations_sediment')
+ allocate(A2(nx,ny)); call var%getData(A2)
+ me%initialDissolvedConcsSediment = A2
+ deallocate(A2)
+ end if
- ! SPATIAL 1D VARIABLES
- ! Land use [-]
- var = me%nc%getVariable('land_use')
- call var%getData(me%landUse)
- end subroutine
+ ! Count point sources after coords are populated
+ call me%calculateNPointSources(me%maxPointSources)
+ end subroutine readBatchVariablesDatabase
!> Get the constants from the namelist file
subroutine parseConstantsDatabase(me, constantsFile)
- class(Database) :: me !! This Database instance
- character(len=*) :: constantsFile !! The constants file path
- integer :: nmlIOStat ! IO status for NML file
- integer :: n_default_nm_size_distribution, n_default_spm_size_distribution, &
- n_default_matrixembedded_distribution_to_spm, n_vertical_distribution, &
- n_initial_c_org, n_k_death, n_k_elim_np, n_k_growth, n_k_uptake_np, n_name, n_stored_fraction, &
- n_k_uptake_transformed, n_k_elim_transformed, n_biota, n_compartment, &
- n_k_uptake_dissolved, n_k_elim_dissolved, n_uptake_from_form, n_harvest_in_month, &
- n_porosity, n_initial_mass, n_spm_density_by_size_class, &
- n_fractional_composition_distribution, n_estuary_mouth_coords, &
- arable, coniferous, deciduous, grassland, heathland, urban_capped, urban_gardens, urban_parks, &
- min_water_temperature_day_of_year
+ class(Database) :: me
+ character(len=*) :: constantsFile
+ integer :: nmlIOStat
+ character(len=256) :: nmlIOMsg
+ integer :: n_biota, n_contaminant_size_classes, n_default_spm_size_distribution, &
+ n_default_matrixembedded_distribution_to_spm, n_vertical_distribution, &
+ n_initial_c_org, n_k_growth, n_k_uptake_contaminant, n_k_elim_contaminant, &
+ n_name, n_stored_fraction, n_k_uptake_dissolved, n_k_elim_dissolved, &
+ n_uptake_from_form, n_harvest_in_month, n_porosity, n_initial_mass, &
+ n_spm_density_by_size_class, n_fractional_composition_distribution, &
+ n_estuary_mouth_coords, n_compartment, n_default_contaminant_size_distribution, &
+ n_default_contaminant_form_distribution
real :: estuary_mouth_coords(2)
- integer, allocatable :: default_nm_size_distribution(:), default_spm_size_distribution(:), &
- default_matrixembedded_distribution_to_spm(:), vertical_distribution(:), harvest_in_month(:)
- real, allocatable :: stored_fraction(:), &
- porosity(:), fractional_composition_distribution(:), spm_density_by_size_class(:)
- real :: darcy_velocity, default_porosity, particle_density, &
- estuary_tidal_S2, estuary_mean_depth_expA, estuary_mean_depth_expB, estuary_width_expA, &
- estuary_width_expB, estuary_tidal_M2, estuary_meandering_factor, nm_density, river_meandering_factor, &
- deposition_alpha, deposition_beta, bank_erosion_alpha, bank_erosion_beta, shear_rate, &
- min_water_temperature, max_water_temperature
+ integer, allocatable :: default_contaminant_size_distribution(:), default_spm_size_distribution(:), &
+ default_matrixembedded_distribution_to_spm(:), vertical_distribution(:), &
+ harvest_in_month(:)
+ real, allocatable :: stored_fraction(:), porosity(:), sedimentInitialMass(:), &
+ fractional_composition_distribution(:), spm_density_by_size_class(:), &
+ default_contaminant_form_distribution(:)
+ real :: darcy_velocity, default_porosity, particle_density, estuary_tidal_S2, &
+ estuary_mean_depth_expA, estuary_mean_depth_expB, estuary_width_expA, &
+ estuary_width_expB, estuary_tidal_M2, estuary_meandering_factor, &
+ river_meandering_factor, deposition_alpha, deposition_beta, &
+ bank_erosion_alpha, bank_erosion_beta
real(dp) :: hamaker_constant, resuspension_alpha, resuspension_beta, &
- resuspension_alpha_estuary, resuspension_beta_estuary, k_diss_pristine, k_diss_transformed, &
- k_transform_pristine, erosivity_a1, erosivity_a2, erosivity_a3, erosivity_b, &
- river_attachment_efficiency, estuary_attachment_efficiency, soil_attachment_efficiency, &
- sediment_transport_a, sediment_transport_b, sediment_transport_c, &
- sediment_enrichment_k, sediment_enrichment_a
- real(dp), allocatable :: initial_C_org(:), k_growth(:), k_death(:), k_elim_np(:), k_uptake_np(:), &
- k_elim_transformed(:), k_uptake_transformed(:), k_uptake_dissolved(:), &
- k_elim_dissolved(:), initial_mass(:)
+ resuspension_alpha_estuary, resuspension_beta_estuary, k_diss_pristine, &
+ k_diss_transformed, k_transform_pristine, erosivity_a1, erosivity_a2, &
+ erosivity_a3, erosivity_b, contaminant_density, estuary_attachment_efficiency, &
+ soil_constant_attachment_efficiency, river_attachment_efficiency, &
+ sediment_transport_a, sediment_transport_b, sediment_transport_c, &
+ sediment_enrichment_k, sediment_enrichment_a, min_water_temperature, &
+ max_water_temperature, shear_rate
+ real(dp), allocatable :: initial_C_org(:), k_growth(:), k_uptake_contaminant(:), &
+ k_elim_contaminant(:), k_uptake_dissolved(:), k_elim_dissolved(:), &
+ contaminant_size_classes(:)
character(len=100), allocatable :: name(:), compartment(:)
character(len=17), allocatable :: uptake_from_form(:)
+ integer :: min_water_temperature_day_of_year, arable, coniferous, deciduous, grassland, &
+ heathland, urban_capped, urban_gardens, urban_parks
- ! Define the namelists and their variables
- namelist /allocatable_array_sizes/ n_default_nm_size_distribution, &
+ namelist /allocatable_array_sizes/ n_default_contaminant_size_distribution, &
n_default_spm_size_distribution, n_default_matrixembedded_distribution_to_spm, &
- n_vertical_distribution, n_initial_c_org, n_k_death, n_k_growth, n_name, n_stored_fraction, &
- n_k_uptake_np, n_k_elim_np, n_k_uptake_transformed, n_k_elim_transformed, &
- n_compartment, n_k_uptake_dissolved, n_k_elim_dissolved, &
- n_uptake_from_form, n_harvest_in_month, n_porosity, n_spm_density_by_size_class, &
- n_initial_mass, n_fractional_composition_distribution, n_estuary_mouth_coords
- namelist /nanomaterial/ nm_density, default_nm_size_distribution
+ n_vertical_distribution, n_initial_c_org, n_k_growth, n_name, &
+ n_stored_fraction, n_k_uptake_contaminant, n_k_elim_contaminant, &
+ n_compartment, n_k_uptake_dissolved, n_k_elim_dissolved, n_uptake_from_form, &
+ n_harvest_in_month, n_porosity, n_spm_density_by_size_class, &
+ n_initial_mass, n_fractional_composition_distribution, n_estuary_mouth_coords, &
+ n_contaminant_size_classes, n_default_contaminant_form_distribution
namelist /n_biota_grp/ n_biota
- namelist /biota/ initial_C_org, k_death, k_growth, k_elim_np, k_uptake_np, name, &
- k_elim_transformed, k_uptake_transformed, stored_fraction, compartment, &
- k_uptake_dissolved, k_elim_dissolved, uptake_from_form, harvest_in_month
- namelist /earthworm_densities/ arable, coniferous, deciduous, grassland, heathland, urban_capped, urban_gardens, &
- urban_parks, vertical_distribution
+ namelist /contaminant/ contaminant_density, default_contaminant_size_distribution, &
+ contaminant_size_classes, k_diss_pristine, k_diss_transformed, k_transform_pristine, &
+ default_contaminant_form_distribution
+ namelist /biota/ initial_C_org, k_growth, k_elim_contaminant, k_uptake_contaminant, &
+ name, stored_fraction, compartment, k_uptake_dissolved, k_elim_dissolved, &
+ uptake_from_form, harvest_in_month
+ namelist /earthworm_densities/ arable, coniferous, deciduous, grassland, heathland, &
+ urban_capped, urban_gardens, urban_parks, vertical_distribution
namelist /soil/ darcy_velocity, default_porosity, hamaker_constant, particle_density, &
- erosivity_a1, erosivity_a2, erosivity_a3, erosivity_b, soil_attachment_efficiency, sediment_transport_a, &
- sediment_transport_b, sediment_transport_c
- namelist /water/ resuspension_alpha, resuspension_beta, resuspension_alpha_estuary, resuspension_beta_estuary, &
- k_diss_pristine, k_diss_transformed, k_transform_pristine, estuary_tidal_m2, estuary_tidal_s2, estuary_mouth_coords, &
- estuary_mean_depth_expa, estuary_mean_depth_expb, estuary_width_expa, estuary_width_expb, estuary_meandering_factor, &
- river_meandering_factor, river_attachment_efficiency, estuary_attachment_efficiency, &
- deposition_alpha, deposition_beta, bank_erosion_alpha, bank_erosion_beta, shear_rate, min_water_temperature, &
- max_water_temperature, min_water_temperature_day_of_year
- namelist /sediment/ porosity, initial_mass, fractional_composition_distribution, &
- default_spm_size_distribution, default_matrixembedded_distribution_to_spm, sediment_enrichment_a, &
- sediment_enrichment_k, spm_density_by_size_class
+ erosivity_a1, erosivity_a2, erosivity_a3, erosivity_b, soil_constant_attachment_efficiency, &
+ sediment_transport_a, sediment_transport_b, sediment_transport_c
+ namelist /water/ resuspension_alpha, resuspension_beta, resuspension_alpha_estuary, &
+ resuspension_beta_estuary, estuary_tidal_m2, estuary_tidal_s2, estuary_mouth_coords, &
+ estuary_mean_depth_expa, estuary_mean_depth_expb, estuary_width_expa, estuary_width_expb, &
+ estuary_meandering_factor, river_meandering_factor, river_attachment_efficiency, &
+ estuary_attachment_efficiency, deposition_alpha, deposition_beta, bank_erosion_alpha, &
+ bank_erosion_beta, shear_rate, min_water_temperature, max_water_temperature, &
+ min_water_temperature_day_of_year
+ namelist /sediment/ porosity, sedimentInitialMass, fractional_composition_distribution, &
+ default_spm_size_distribution, default_matrixembedded_distribution_to_spm, &
+ sediment_enrichment_a, sediment_enrichment_k, spm_density_by_size_class
+
+ ! Initialize variables
+ n_biota = 0
+ n_default_contaminant_form_distribution = 0
+ contaminant_density = default_rho_contaminant
+ k_diss_pristine = default_k_diss_pristine
+ k_diss_transformed = default_k_diss_transformed
+ k_transform_pristine = default_k_transform_pristine
+ soil_constant_attachment_efficiency = defaultSoilAttachmentEfficiency
+ river_attachment_efficiency = defaultRiverAttachmentEfficiency
+ resuspension_alpha_estuary = 0.0_dp
+ resuspension_beta_estuary = 0.0_dp
+ soil_constant_attachment_efficiency = real(defaultSoilAttachmentEfficiency, dp)
+ river_attachment_efficiency = real(defaultRiverAttachmentEfficiency, dp)
+ estuary_attachment_efficiency = defaultEstuaryAttachmentEfficiency
+ darcy_velocity = defaultSoilDarcyVelocity
+ estuary_meandering_factor = 0.0
+ river_meandering_factor = 0.0
+ shear_rate = defaultShearRate
+ min_water_temperature = defaultMinWaterTemperature
+ max_water_temperature = defaultMaxWaterTemperature
+ min_water_temperature_day_of_year = defaultMinWaterTemperatureDayOfYear
+ sediment_transport_a = defaultSedimentTransport_a
+ sediment_transport_b = defaultSedimentTransport_b
+ sediment_transport_c = defaultSedimentTransport_c
+ sediment_enrichment_k = defaultSedimentEnrichment_k
+ sediment_enrichment_a = defaultSedimentEnrichment_a
+ deposition_alpha = defaultDepositionAlpha
+ deposition_beta = defaultDepositionBeta
+ bank_erosion_alpha = defaultBankErosionAlpha
+ bank_erosion_beta = defaultBankErosionBeta
! Open and read the NML file
- open(iouConstants, file=constantsFile, status="old")
- read(iouConstants, nml=allocatable_array_sizes)
+ open(iouConstants, file=constantsFile, status="old", iostat=nmlIOStat)
+ if (nmlIOStat /= 0) then
+ call ERROR_HANDLER%trigger(error=ErrorInstance( &
+ code=200, message="Failed to open constants file: " // trim(constantsFile)))
+ return
+ end if
+ read(iouConstants, nml=allocatable_array_sizes, iostat=nmlIOStat)
+ if (nmlIOStat /= 0) then
+ call ERROR_HANDLER%trigger(error=ErrorInstance( &
+ code=200, message="Failed to read allocatable_array_sizes namelist"))
+ close(iouConstants)
+ return
+ end if
rewind(iouConstants)
- ! Allocate the appropriate variable dimensions
- allocate(default_nm_size_distribution(n_default_nm_size_distribution), &
- default_spm_size_distribution(n_default_spm_size_distribution), &
- default_matrixembedded_distribution_to_spm(n_default_matrixembedded_distribution_to_spm), &
- vertical_distribution(n_vertical_distribution), &
- porosity(n_porosity), &
- initial_mass(n_initial_mass), &
- fractional_composition_distribution(n_fractional_composition_distribution), &
- spm_density_by_size_class(n_spm_density_by_size_class) &
- )
- ! Allocate the class variables, first checking they're not already allocated (e.g. from a previous batch)
- if (.not. allocated(me%defaultNMSizeDistribution)) then
- allocate(me%defaultNMSizeDistribution(n_default_nm_size_distribution))
+ ! Allocate arrays
+ allocate(default_contaminant_size_distribution(n_default_contaminant_size_distribution), &
+ default_spm_size_distribution(n_default_spm_size_distribution), &
+ default_matrixembedded_distribution_to_spm(n_default_matrixembedded_distribution_to_spm), &
+ vertical_distribution(n_vertical_distribution), &
+ porosity(n_porosity), &
+ sedimentInitialMass(n_initial_mass), &
+ fractional_composition_distribution(n_fractional_composition_distribution), &
+ spm_density_by_size_class(n_spm_density_by_size_class), &
+ contaminant_size_classes(n_contaminant_size_classes), &
+ default_contaminant_form_distribution(n_default_contaminant_form_distribution))
+
+ ! Allocate class variables
+ if (.not. allocated(me%defaultDistributionContaminant)) then
+ allocate(me%defaultDistributionContaminant(n_default_contaminant_size_distribution))
end if
if (.not. allocated(me%defaultSpmSizeDistribution)) then
allocate(me%defaultSpmSizeDistribution(n_default_spm_size_distribution))
@@ -881,63 +1319,191 @@ subroutine parseConstantsDatabase(me, constantsFile)
if (.not. allocated(me%sedimentFractionalComposition)) then
allocate(me%sedimentFractionalComposition(n_fractional_composition_distribution))
end if
+ if (.not. allocated(me%contaminantSizeClasses)) then
+ allocate(me%contaminantSizeClasses(n_contaminant_size_classes))
+ end if
+ if (.not. allocated(me%defaultContaminantFormDistribution)) then
+ allocate(me%defaultContaminantFormDistribution(n_default_contaminant_form_distribution))
+ end if
- ! Defaults, if the variable doesn't exist in namelist
- resuspension_alpha_estuary = 0.0_dp
- resuspension_beta_estuary = 0.0_dp
- soil_attachment_efficiency = defaultSoilAttachmentEfficiency
- darcy_velocity = defaultSoilDarcyVelocity
- k_diss_pristine = default_k_diss_pristine
- k_diss_transformed = default_k_diss_transformed
- k_transform_pristine = default_k_transform_pristine
- estuary_meandering_factor = 0.0 ! If meandering factors are zero, they are calculated from cell size
- river_meandering_factor = 0.0
- porosity = 0.0
- shear_rate = defaultShearRate
- min_water_temperature = defaultMinWaterTemperature
- max_water_temperature = defaultMaxWaterTemperature
- min_water_temperature_day_of_year = defaultMinWaterTemperatureDayOfYear
- sediment_transport_a = defaultSedimentTransport_a
- sediment_transport_b = defaultSedimentTransport_b
- sediment_transport_c = defaultSedimentTransport_c
- sediment_enrichment_k = defaultSedimentEnrichment_k
- sediment_enrichment_a = defaultSedimentEnrichment_a
- deposition_alpha = defaultDepositionAlpha
- deposition_beta = defaultDepositionBeta
- bank_erosion_alpha = defaultBankErosionAlpha
- bank_erosion_beta = defaultBankErosionBeta
-
- ! Read in the namelists
- read(iouConstants, nml=n_biota_grp, iostat=nmlIOStat); rewind(iouConstants)
- ! Only read in the biota group if there is one
+ ! Read namelists
+ read(iouConstants, nml=n_biota_grp, iostat=nmlIOStat)
+ rewind(iouConstants)
+ me%nBiota = n_biota
if (nmlIOStat .ge. 0) then
- allocate(initial_C_org(n_biota), k_death(n_biota), k_elim_np(n_biota), &
- k_uptake_np(n_biota), k_growth(n_biota), name(n_biota), &
- stored_fraction(n_biota), k_uptake_transformed(n_biota), &
- k_elim_transformed(n_biota), compartment(n_biota), &
- k_uptake_dissolved(n_biota), k_elim_dissolved(n_biota), &
- uptake_from_form(n_biota), harvest_in_month(n_biota))
- read(iouConstants, nml=biota); rewind(iouConstants)
+ ! Validate allocation sizes
+ if (n_k_uptake_contaminant /= me%nBiota * n_contaminant_size_classes) then
+ call ERROR_HANDLER%trigger(error=ErrorInstance(code=900, &
+ message="Mismatch in k_uptake_contaminant size: expected " // &
+ trim(str(me%nBiota * n_contaminant_size_classes)) // &
+ ", got " // trim(str(n_k_uptake_contaminant))))
+ close(iouConstants)
+ return
+ end if
+ if (n_k_elim_contaminant /= me%nBiota * n_contaminant_size_classes) then
+ call ERROR_HANDLER%trigger(error=ErrorInstance(code=900, &
+ message="Mismatch in k_elim_contaminant size: expected " // &
+ trim(str(me%nBiota * n_contaminant_size_classes)) // &
+ ", got " // trim(str(n_k_elim_contaminant))))
+ close(iouConstants)
+ return
+ end if
+ if (n_initial_c_org /= me%nBiota) then
+ call ERROR_HANDLER%trigger(error=ErrorInstance(code=900, &
+ message="Mismatch in initial_C_org size: expected " // &
+ trim(str(me%nBiota)) // ", got " // trim(str(n_initial_c_org))))
+ close(iouConstants)
+ return
+ end if
+ if (n_k_growth /= me%nBiota) then
+ call ERROR_HANDLER%trigger(error=ErrorInstance(code=900, &
+ message="Mismatch in k_growth size: expected " // &
+ trim(str(me%nBiota)) // ", got " // trim(str(n_k_growth))))
+ close(iouConstants)
+ return
+ end if
+ if (n_name /= me%nBiota) then
+ call ERROR_HANDLER%trigger(error=ErrorInstance(code=900, &
+ message="Mismatch in name size: expected " // &
+ trim(str(me%nBiota)) // ", got " // trim(str(n_name))))
+ close(iouConstants)
+ return
+ end if
+ if (n_stored_fraction /= me%nBiota) then
+ call ERROR_HANDLER%trigger(error=ErrorInstance(code=900, &
+ message="Mismatch in stored_fraction size: expected " // &
+ trim(str(me%nBiota)) // ", got " // trim(str(n_stored_fraction))))
+ close(iouConstants)
+ return
+ end if
+ if (n_compartment /= me%nBiota) then
+ call ERROR_HANDLER%trigger(error=ErrorInstance(code=900, &
+ message="Mismatch in compartment size: expected " // &
+ trim(str(me%nBiota)) // ", got " // trim(str(n_compartment))))
+ close(iouConstants)
+ return
+ end if
+ if (n_k_uptake_dissolved /= me%nBiota) then
+ call ERROR_HANDLER%trigger(error=ErrorInstance(code=900, &
+ message="Mismatch in k_uptake_dissolved size: expected " // &
+ trim(str(me%nBiota)) // ", got " // trim(str(n_k_uptake_dissolved))))
+ close(iouConstants)
+ return
+ end if
+ if (n_k_elim_dissolved /= me%nBiota) then
+ call ERROR_HANDLER%trigger(error=ErrorInstance(code=900, &
+ message="Mismatch in k_elim_dissolved size: expected " // &
+ trim(str(me%nBiota)) // ", got " // trim(str(n_k_elim_dissolved))))
+ close(iouConstants)
+ return
+ end if
+ if (n_uptake_from_form /= me%nBiota) then
+ call ERROR_HANDLER%trigger(error=ErrorInstance(code=900, &
+ message="Mismatch in uptake_from_form size: expected " // &
+ trim(str(me%nBiota)) // ", got " // trim(str(n_uptake_from_form))))
+ close(iouConstants)
+ return
+ end if
+ if (n_harvest_in_month /= me%nBiota) then
+ call ERROR_HANDLER%trigger(error=ErrorInstance(code=900, &
+ message="Mismatch in harvest_in_month size: expected " // &
+ trim(str(me%nBiota)) // ", got " // trim(str(n_harvest_in_month))))
+ close(iouConstants)
+ return
+ end if
+ rewind(iouConstants)
+
+ ! Allocate biota-related arrays
+ allocate(initial_C_org(me%nBiota), k_growth(me%nBiota), &
+ k_uptake_contaminant(me%nBiota * n_contaminant_size_classes), &
+ k_elim_contaminant(me%nBiota * n_contaminant_size_classes), &
+ name(me%nBiota), stored_fraction(me%nBiota), &
+ compartment(me%nBiota), k_uptake_dissolved(me%nBiota), &
+ k_elim_dissolved(me%nBiota), uptake_from_form(me%nBiota), &
+ harvest_in_month(me%nBiota))
+
+ ! Read biota namelist
+ read(iouConstants, nml=biota, iostat=nmlIOStat)
+ if (nmlIOStat /= 0) then
+ call ERROR_HANDLER%trigger(error=ErrorInstance(code=200, message="Failed to read biota namelist"))
+ close(iouConstants)
+ return
+ end if
me%hasBiota = .true.
end if
- read(iouConstants, nml=nanomaterial); rewind(iouConstants)
- read(iouConstants, nml=earthworm_densities); rewind(iouConstants)
- read(iouConstants, nml=soil); rewind(iouConstants)
- read(iouConstants, nml=water); rewind(iouConstants)
- read(iouConstants, nml=sediment); rewind(iouConstants)
+ rewind(iouConstants)
+
+ ! Read other namelists
+ read(iouConstants, nml=contaminant, iostat=nmlIOStat)
+ if (nmlIOStat /= 0) then
+ call ERROR_HANDLER%trigger(error=ErrorInstance(code=200, message="Failed to read contaminant namelist, using defaults"))
+ end if
+ rewind(iouConstants)
+
+ read(iouConstants, nml=earthworm_densities, iostat=nmlIOStat, iomsg=nmlIOMsg)
+ if (nmlIOStat /= 0) then
+ call ERROR_HANDLER%trigger(error=ErrorInstance(code=200, message="Failed to read earthworm_densities namelist" &
+ // " with message: " // trim(nmlIOMsg)))
+ close(iouConstants)
+ return
+ end if
+ rewind(iouConstants)
+
+ read(iouConstants, nml=soil, iostat=nmlIOStat, iomsg=nmlIOMsg)
+ if (nmlIOStat /= 0) then
+ call ERROR_HANDLER%trigger(error=ErrorInstance(code=200, message="Failed to read soil namelist" &
+ // " with message: " // trim(nmlIOMsg)))
+ close(iouConstants)
+ return
+ end if
+ rewind(iouConstants)
+
+ read(iouConstants, nml=water, iostat=nmlIOStat, iomsg=nmlIOMsg)
+ if (nmlIOStat /= 0) then
+ call ERROR_HANDLER%trigger(error=ErrorInstance(code=200, message="Failed to read water namelist" &
+ // " with message: " // trim(nmlIOMsg)))
+ close(iouConstants)
+ return
+ end if
+ rewind(iouConstants)
+
+ read(iouConstants, nml=sediment, iostat=nmlIOStat, iomsg=nmlIOMsg)
+ if (nmlIOStat /= 0) then
+ call ERROR_HANDLER%trigger(error=ErrorInstance(code=200, message="Failed to read sediment namelist" &
+ // " with message: " // trim(nmlIOMsg)))
+ close(iouConstants)
+ return
+ end if
+ rewind(iouConstants)
close(iouConstants)
- ! Save these to class variables
- me%nmDensity = nm_density
- me%defaultNMSizeDistribution = default_nm_size_distribution / 100.0
+ ! Save to class variables
+ me%contaminantDensity = contaminant_density
+ me%contaminantSizeClasses = contaminant_size_classes
+ if (size(default_contaminant_size_distribution) /= n_contaminant_size_classes) then
+ call ERROR_HANDLER%trigger(error=ErrorInstance( &
+ code=900, message="Mismatch in default_contaminant_size_distribution size: expected " // &
+ trim(str(n_contaminant_size_classes)) // ", got " // &
+ trim(str(size(default_contaminant_size_distribution)))))
+ return
+ end if
+ me%defaultDistributionContaminant = default_contaminant_size_distribution / 100.0
+ if (size(default_contaminant_form_distribution) /= C%contaminantDim(2)+1) then
+ call ERROR_HANDLER%trigger(error=ErrorInstance( &
+ code=900, message="Mismatch in default_contaminant_form_distribution size: expected " // &
+ trim(str(C%contaminantDim(2)+1)) // ", got " // &
+ trim(str(size(default_contaminant_form_distribution)))))
+ return
+ end if
+ me%defaultContaminantFormDistribution = default_contaminant_form_distribution / 100.0
+ me%nContaminantSizeClasses = n_contaminant_size_classes
me%defaultSpmSizeDistribution = default_spm_size_distribution / 100.0
me%defaultMatrixEmbeddedDistributionToSpm = default_matrixembedded_distribution_to_spm / 100.0
me%soilDarcyVelocity = darcy_velocity
me%soilDefaultPorosity = default_porosity
- ! TODO Hamaker constant really should be a NM property as it depends on NM material, see https://doi.org/10.1021/es100598h
me%soilHamakerConstant = hamaker_constant
- me%soilParticleDensity = particle_density ! TODO can we calculate this from soil texture (clay, silt, sand) etc?
- me%soilConstantAttachmentEfficiency = soil_attachment_efficiency
+ me%soilParticleDensity = particle_density
+ me%soilConstantAttachmentEfficiency = soil_constant_attachment_efficiency
me%soilErosivity_a1 = erosivity_a1
me%soilErosivity_a2 = erosivity_a2
me%soilErosivity_a3 = erosivity_a3
@@ -945,7 +1511,6 @@ subroutine parseConstantsDatabase(me, constantsFile)
me%sedimentTransport_aConstant = sediment_transport_a
me%sedimentTransport_bConstant = sediment_transport_b
me%sedimentTransport_cConstant = sediment_transport_c
- ! Earthworm densities
me%earthwormDensityArable = arable
me%earthwormDensityConiferous = coniferous
me%earthwormDensityDeciduous = deciduous
@@ -955,25 +1520,33 @@ subroutine parseConstantsDatabase(me, constantsFile)
me%earthwormDensityUrbanGardens = urban_gardens
me%earthwormDensityUrbanParks = urban_parks
me%earthwormVerticalDistribution = vertical_distribution / 100.0
- ! Biota
if (me%hasBiota) then
me%biotaName = name
me%biotaInitial_C_org = initial_C_org
me%biota_k_growth = k_growth
- me%biota_k_death = k_death
- me%biota_k_uptake_np = k_uptake_np
- me%biota_k_elim_np = k_elim_np
- me%biota_k_uptake_transformed = k_uptake_transformed
- me%biota_k_elim_transformed = k_elim_transformed
- me%biota_k_uptake_dissolved = k_uptake_dissolved
- me%biota_k_elim_dissolved = k_elim_dissolved
me%biotaStoredFraction = stored_fraction
- me%nBiota = n_biota
me%biotaCompartment = compartment
me%biotaUptakeFromForm = uptake_from_form
me%biotaHarvestInMonth = harvest_in_month
+ if (allocated(me%biota_k_uptake_contaminant)) deallocate(me%biota_k_uptake_contaminant)
+ if (allocated(me%biota_k_elim_contaminant)) deallocate(me%biota_k_elim_contaminant)
+ allocate(me%biota_k_uptake_contaminant(me%nBiota, C%contaminantDim(2)))
+ allocate(me%biota_k_elim_contaminant(me%nBiota, C%contaminantDim(2)))
+ me%biota_k_uptake_contaminant(:,1) = k_uptake_contaminant(1:me%nBiota)
+ me%biota_k_elim_contaminant(:,1) = k_elim_contaminant(1:me%nBiota)
+ if (C%contaminantDim(2) > 1) then
+ me%biota_k_uptake_contaminant(:,2) = k_uptake_contaminant(me%nBiota+1:2*me%nBiota)
+ me%biota_k_elim_contaminant(:,2) = k_elim_contaminant(me%nBiota+1:2*me%nBiota)
+ end if
+ if (.not. allocated(me%biota_k_uptake_dissolved)) then
+ allocate(me%biota_k_uptake_dissolved(me%nBiota))
+ me%biota_k_uptake_dissolved = k_uptake_dissolved
+ end if
+ if (.not. allocated(me%biota_k_elim_dissolved)) then
+ allocate(me%biota_k_elim_dissolved(me%nBiota))
+ me%biota_k_elim_dissolved = k_elim_dissolved
+ end if
end if
- ! Water
me%riverMeanderingFactor = river_meandering_factor
me%waterResuspensionAlpha = resuspension_alpha
me%waterResuspensionBeta = resuspension_beta
@@ -981,42 +1554,34 @@ subroutine parseConstantsDatabase(me, constantsFile)
me%depositionBetaConstant = deposition_beta
me%bankErosionAlphaConstant = bank_erosion_alpha
me%bankErosionBetaConstant = bank_erosion_beta
- me%water_k_diss_pristine = k_diss_pristine
- me%water_k_diss_transformed = k_diss_transformed
- me%water_k_transform_pristine = k_transform_pristine
- ! Check if estuary params have been provided, otherwise default to freshwater
- if (resuspension_alpha_estuary /= 0.0_dp) then
- me%waterResuspensionAlphaEstuary = resuspension_alpha_estuary
- else
- me%waterResuspensionAlphaEstuary = me%waterResuspensionAlpha
- end if
- if (resuspension_beta_estuary /= 0.0_dp) then
- me%waterResuspensionBetaEstuary = resuspension_beta_estuary
- else
- me%waterResuspensionBetaEstuary = me%waterResuspensionBeta
- end if
+ me%contaminant_k_diss_pristine = k_diss_pristine
+ me%contaminant_k_diss_transformed = k_diss_transformed
+ me%contaminant_k_transform_pristine = k_transform_pristine
me%riverAttachmentEfficiency = river_attachment_efficiency
+ me%estuaryAttachmentEfficiency = estuary_attachment_efficiency
+ me%waterResuspensionAlphaEstuary = merge(resuspension_alpha_estuary, me%waterResuspensionAlpha, &
+ resuspension_alpha_estuary /= 0.0_dp)
+ me%waterResuspensionBetaEstuary = merge(resuspension_beta_estuary, me%waterResuspensionBeta, &
+ resuspension_beta_estuary /= 0.0_dp)
me%shearRate = shear_rate
me%waterTemperature = me%calculateWaterTemperatureTimeSeries(min_water_temperature, &
- max_water_temperature, &
- min_water_temperature_day_of_year)
- ! Estuary
- me%estuaryAttachmentEfficiency = estuary_attachment_efficiency
+ max_water_temperature, &
+ min_water_temperature_day_of_year)
me%estuaryTidalM2 = estuary_tidal_M2
me%estuaryTidalS2 = estuary_tidal_S2
me%estuaryMeanDepthExpA = estuary_mean_depth_expA
me%estuaryMeanDepthExpB = estuary_mean_depth_expB
me%estuaryWidthExpA = estuary_width_expA
- me%estuaryWidthExpB = estuary_width_expB
+ me%estuaryWidthExpB = estuary_width_expb
me%estuaryMeanderingFactor = estuary_meandering_factor
me%estuaryMouthCoords = estuary_mouth_coords
- ! Sediment
- me%sedimentInitialMass = initial_mass
+ me%sedimentInitialMass = sedimentInitialMass
me%sedimentPorosity = porosity
me%sedimentFractionalComposition = fractional_composition_distribution
me%sedimentEnrichment_k = sediment_enrichment_k
me%sedimentEnrichment_a = sediment_enrichment_a
me%spmDensityBySizeClass = spm_density_by_size_class
+
end subroutine
!> Elemental function for getting a mask from an int2 array, where the NetCDF
@@ -1032,26 +1597,36 @@ elemental function maskDatabase(me, int) result(mask)
end if
end function
- !> Calculate the number of point sources per grid cell
+ ! Compute number of point sources per (x,y) cell by inspecting coordinates.
subroutine calculateNPointSourcesDatabase(me, maxPointSources)
class(Database) :: me
- integer :: maxPointSources
- integer :: i, j, k, n
- if (.not. allocated(me%nPointSources)) then
- allocate(me%nPointSources(me%gridShape(1), me%gridShape(2)))
- end if
+ integer, intent(in) :: maxPointSources
+ integer :: i, j, p
+ real(dp) :: px, py
+
+ if (allocated(me%nPointSources)) deallocate(me%nPointSources)
+ allocate(me%nPointSources(me%gridShape(1), me%gridShape(2)))
+ me%nPointSources = 0
+
+ if (.not. allocated(me%emissionsPointWaterCoords)) return
+ if (maxPointSources <= 0) return
+
do j = 1, me%gridShape(2)
do i = 1, me%gridShape(1)
- n = 0
- do k = 1, maxPointSources
- if (me%emissionsPointWaterCoords(i, j, k, 1) /= nf90_fill_double) then
- n = n + 1
+ do p = 1, maxPointSources
+ px = me%emissionsPointWaterCoords(i, j, p, 1)
+ py = me%emissionsPointWaterCoords(i, j, p, 2)
+ if (px /= nf90_fill_double .and. py /= nf90_fill_double) then
+ if ((abs(px) > C%epsilon .or. abs(py) > C%epsilon) .and. &
+ .not. (px < -9.9e8_dp .and. py < -9.9e8_dp)) then
+ me%nPointSources(i, j) = me%nPointSources(i, j) + 1
+ end if
end if
end do
- me%nPointSources(i, j) = n
end do
end do
- end subroutine
+ end subroutine calculateNPointSourcesDatabase
+
!> Check whether a set of coordinates (x,y) is in the model domain
function inModelDomainDatabase(me, x, y) result(inModelDomain)
@@ -1117,82 +1692,175 @@ function calculateMeanderingFactorFromCellSizeDatabase(me) result(f_m)
!! $$
function calculateWaterTemperatureTimeSeriesWaterBody(me, minTemp, maxTemp, minTempDay) result(waterTemperature)
class(Database) :: me
- real :: minTemp
- real :: maxTemp
+ real(dp) :: minTemp, maxTemp
integer :: minTempDay
- real :: waterTemperature(366)
+ real(dp) :: waterTemperature(366)
integer :: i
- integer :: days(366)
- ! Integer range of days in year
- days = [(i, i = 1, 366, 1)]
- ! Calculate the water temperature timeseries using cos function
- waterTemperature = - 0.5 * (maxTemp - minTemp) * cos(days * 2 * C%pi / 366 - minTempDay) &
- + (maxTemp + minTemp) / 2
- end function
+ real(dp) :: angle(366)
+
+ ! angle = 2*pi*(day - day_min)/366
+ do i = 1, 366
+ angle(i) = 2.0_dp*C%pi * real(i - minTempDay, dp) / 366.0_dp
+ end do
+
+ waterTemperature = 0.5_dp*(maxTemp - minTemp) * cos(angle) + 0.5_dp*(maxTemp + minTemp)
+ end function calculateWaterTemperatureTimeSeriesWaterBody
+
!> Audit the database
function auditDatabase(me) result(rslt)
- class(Database) :: me ! This Database
- type(Result) :: rslt ! Result object to return errors in
- integer :: x, y, i ! Iterators
- integer :: xy_in(2) ! Inflow x and y
- logical :: simulationMaskError = .false.
+ class(Database) :: me
+ type(Result) :: rslt
+ integer :: x, y, i
+ integer :: xi, yi
+ integer :: nx, ny
+ logical :: simulationMaskError
+
+ simulationMaskError = .false.
! Is the simulation mask self-contained (no inflows to area to simulate)?
if (C%hasSimulationMask) then
- do y = 1, me%gridShape(2)
- do x = 1, me%gridShape(1)
- if (me%simulationMask(x,y)) then
- ! We're in the area to simulate, so check if there are inflows from
- ! outside the area to simulation
+ nx = me%gridShape(1)
+ ny = me%gridShape(2)
+ do y = 1, ny
+ do x = 1, nx
+ if (me%simulationMask(x, y)) then
+ ! me%inflows is (d,w,x,y) where d=2 holds (x,y) origin indices
do i = 1, size(me%inflows, dim=2)
- ! Is the inflow actually an inflow or a fill value
- if (me%inflows(1,i,x,y) >= 0) then
- xy_in = me%inflows(:,i,x,y)
- if (.not. me%simulationMask(xy_in(1), xy_in(2))) then
- simulationMaskError = .true.
- end if
+ xi = me%inflows(1, i, x, y)
+ yi = me%inflows(2, i, x, y)
+ ! Skip invalid/out-of-domain inflow indices
+ if (xi >= 1 .and. xi <= nx .and. yi >= 1 .and. yi <= ny) then
+ if (.not. me%simulationMask(xi, yi)) simulationMaskError = .true.
end if
end do
- end if
+ end if
end do
end do
end if
if (simulationMaskError) then
call rslt%addError(ErrorInstance( &
- message="Simulation mask provided has inflows from outside " // &
- "the area to simulate. Please provide a simulation mask that " // &
- "is self-contained." &
- ))
+ message="Simulation mask provided has inflows from outside the area to " // &
+ "simulate. Please provide a simulation mask that is self-contained." ))
end if
- ! Bounds checks for sediment calibration parameters
- if (any(me%depositionAlpha < 0.0_dp)) then
+ ! Bounds checks for sediment calibration parameters (arrays may be unallocated)
+ if (allocated(me%depositionAlpha)) then
+ if (any(me%depositionAlpha < 0.0_dp)) then
+ call rslt%addError(ErrorInstance( &
+ message="Value provided for deposition_alpha must be >= 0. At least one < 0." ))
+ end if
+ end if
+ if (allocated(me%resuspensionAlpha)) then
+ if (any(me%resuspensionAlpha < 0.0_dp)) then
+ call rslt%addError(ErrorInstance( &
+ message="Value provided for resuspension_alpha must be >= 0. At least one < 0." ))
+ end if
+ end if
+ if (allocated(me%resuspensionBeta)) then
+ if (any(me%resuspensionBeta < 0.0_dp)) then
+ call rslt%addError(ErrorInstance( &
+ message="Value provided for resuspension_beta must be >= 0. At least one < 0." ))
+ end if
+ end if
+
+ ! Does sediment fractional composition sum to unity?
+ if (.not. isZero(1.0_dp - sum(me%sedimentFractionalComposition))) then
call rslt%addError(ErrorInstance( &
- message="Value provided for deposition_alpha must be greater than or equal to zero. " // &
- "At least one value provided is less than zero." &
- ))
+ message="sedimentFractionalComposition must sum to 1. Found: " // &
+ str(sum(me%sedimentFractionalComposition)) ))
end if
- if (any(me%resuspensionAlpha < 0.0_dp)) then
+
+ if (any(me%defaultDistributionContaminant < 0.0)) then
call rslt%addError(ErrorInstance( &
- message="Value provided for resuspension_alpha must be greater than or equal to zero. " // &
- "At least one value provided is less than zero." &
- ))
+ message="defaultDistributionContaminant must be non-negative." ))
end if
- if (any(me%resuspensionBeta < 0.0_dp)) then
+ if (.not. isZero(1.0_dp - sum(me%defaultDistributionContaminant))) then
call rslt%addError(ErrorInstance( &
- message="Value provided for resuspension_beta must be greater than or equal to zero. " // &
- "At least one value provided is less than zero." &
- ))
+ message="defaultDistributionContaminant must sum to 1. Found: " // &
+ str(sum(me%defaultDistributionContaminant)) ))
end if
- ! Does sediment fractional composition sum to unity?
- if (.not. isZero(1.0_dp - sum(me%sedimentFractionalComposition))) then
+ if (me%contaminantDensity <= 0.0) then
call rslt%addError(ErrorInstance( &
- message="Values provided for fractional_composition_distribution must sum to unity. " // &
- "Value found: " // str(sum(me%sedimentFractionalComposition)) &
- ))
+ message="contaminantDensity must be positive." ))
+ end if
+ if (any(me%contaminantSizeClasses <= 0.0)) then
+ call rslt%addError(ErrorInstance( &
+ message="contaminantSizeClasses must be positive." ))
+ end if
+
+ ! Bounds checks for initial concentrations
+ if (allocated(me%initialContaminantConcsSoil)) then
+ if (any(me%initialContaminantConcsSoil < 0.0_dp)) then
+ call rslt%addError(ErrorInstance( &
+ message="initialContaminantConcsSoil must be non-negative. At least one < 0." ))
+ end if
+ end if
+ if (allocated(me%initialContaminantConcsWater)) then
+ if (any(me%initialContaminantConcsWater < 0.0_dp)) then
+ call rslt%addError(ErrorInstance( &
+ message="initialContaminantConcsWater must be non-negative. At least one < 0." ))
+ end if
+ end if
+ if (allocated(me%initialContaminantConcsSediment)) then
+ if (any(me%initialContaminantConcsSediment < 0.0_dp)) then
+ call rslt%addError(ErrorInstance( &
+ message="initialContaminantConcsSediment must be non-negative. At least one < 0." ))
+ end if
+ end if
+ if (allocated(me%initialDissolvedConcsSoil)) then
+ if (any(me%initialDissolvedConcsSoil < 0.0_dp)) then
+ call rslt%addError(ErrorInstance( &
+ message="initialDissolvedConcsSoil must be non-negative. At least one < 0." ))
+ end if
+ end if
+ if (allocated(me%initialDissolvedConcsWater)) then
+ if (any(me%initialDissolvedConcsWater < 0.0_dp)) then
+ call rslt%addError(ErrorInstance( &
+ message="initialDissolvedConcsWater must be non-negative. At least one < 0." ))
+ end if
+ end if
+ if (allocated(me%initialDissolvedConcsSediment)) then
+ if (any(me%initialDissolvedConcsSediment < 0.0_dp)) then
+ call rslt%addError(ErrorInstance( &
+ message="initialDissolvedConcsSediment must be non-negative. At least one < 0." ))
+ end if
+ end if
+
+ ! Bounds checks for dissolved emissions
+ if (allocated(me%emissionsArealSoilDissolvedContaminant)) then
+ if (any(me%emissionsArealSoilDissolvedContaminant < 0.0_dp)) then
+ call rslt%addError(ErrorInstance( &
+ message="emissionsArealSoilDissolvedContaminant must be >= 0. At least one < 0." ))
+ end if
+ end if
+ if (allocated(me%emissionsArealWaterDissolvedContaminant)) then
+ if (any(me%emissionsArealWaterDissolvedContaminant < 0.0_dp)) then
+ call rslt%addError(ErrorInstance( &
+ message="emissionsArealWaterDissolvedContaminant must be >= 0. At least one < 0." ))
+ end if
+ end if
+ if (allocated(me%emissionsAtmosphericDryDepoDissolvedContaminant)) then
+ if (any(me%emissionsAtmosphericDryDepoDissolvedContaminant < 0.0_dp)) then
+ call rslt%addError(ErrorInstance( &
+ message="emissionsAtmosphericDryDepoDissolvedContaminant must be >= 0. " // &
+ "At least one < 0." ))
+ end if
+ end if
+ if (allocated(me%emissionsAtmosphericWetDepoDissolvedContaminant)) then
+ if (any(me%emissionsAtmosphericWetDepoDissolvedContaminant < 0.0_dp)) then
+ call rslt%addError(ErrorInstance( &
+ message="emissionsAtmosphericWetDepoDissolvedContaminant must be >= 0. " // &
+ "At least one < 0." ))
+ end if
+ end if
+ if (allocated(me%emissionsPointWaterDissolvedContaminant)) then
+ if (any(me%emissionsPointWaterDissolvedContaminant < 0.0_dp)) then
+ call rslt%addError(ErrorInstance( &
+ message="emissionsPointWaterDissolvedContaminant must be >= 0. At least one < 0." ))
+ end if
end if
end function
diff --git a/src/Data/DataOutputModule.f90 b/src/Data/DataOutputModule.f90
index 38e74b7..bf1a1a0 100644
--- a/src/Data/DataOutputModule.f90
+++ b/src/Data/DataOutputModule.f90
@@ -2,7 +2,7 @@
module DataOutputModule
use DefaultsModule, only: iouOutputSummary, iouOutputWater, &
iouOutputSediment, iouOutputSoil, iouOutputSSD, iouOutputStats
- use GlobalsModule, only: C, dp
+ use GlobalsModule, only: C, dp, FREE_CONTAMINANT, ATTACHED_CONTAMINANT
use DataInputModule, only: DATASET
use LoggerModule, only: LOGR
use AbstractEnvironmentModule
@@ -15,6 +15,7 @@ module DataOutputModule
use mo_netcdf
use NetCDFOutputModule
use NetCDFAggregatedOutputModule
+ use ContaminantModule
implicit none
!> The DataOutput class is responsible for writing output data to disk
@@ -23,8 +24,8 @@ module DataOutputModule
type(EnvironmentPointer) :: env !! Pointer to the environment, to retrieve state variables
class(NetCDFOutput), allocatable :: ncout !! NetCDF output class
! Storing variables across timesteps for dynamics calculations
- real(dp), allocatable :: previousSSDByLayer(:,:)
- real(dp), allocatable :: previousSSD(:)
+ real(dp), allocatable :: previousSSDByLayer(:,:)
+ real(dp), allocatable :: previousSSD(:)
contains
procedure, public :: init => initDataOutput
procedure, public :: initSedimentSizeDistribution => initSedimentSizeDistributionDataOutput
@@ -45,72 +46,65 @@ module DataOutputModule
end type
contains
-
+
!> Initialise the data output be creating the relevant output files and writing
!! their headers and metadata
- subroutine initDataOutput(me, env)
- class(DataOutput) :: me
+ subroutine initDataOutput(this, env)
+ class(DataOutput) :: this
type(Environment), target :: env
! Point the Environment object to that passed in
- me%env%item => env
+ this%env%item => env
! Allocate the appropriate NetCDF output object, depending on whether we're aggregating
! to grid cell or not
if (C%includeWaterbodyBreakdown) then
- allocate(NetCDFOutput :: me%ncout)
+ allocate(NetCDFOutput :: this%ncout)
else
- allocate(NetCDFAggregatedOutput :: me%ncout)
+ allocate(NetCDFAggregatedOutput :: this%ncout)
end if
if (C%writeNetCDF) then
- call me%ncout%init(env, 1)
+ call this%ncout%init(env, 1)
end if
! Open the files to write to
open(iouOutputSummary, file=trim(C%outputPath) // 'summary' // trim(C%outputHash) // '.md')
if (C%writeCSV) then
- open(iouOutputWater, &
- file=trim(C%outputPath) // 'output_water' // trim(C%outputHash) // '.csv')
- open(iouOutputSediment, &
- file=trim(C%outputPath) // 'output_sediment' // trim(C%outputHash) // '.csv')
- open(iouOutputSoil, &
- file=trim(C%outputPath) // 'output_soil' // trim(C%outputHash) // '.csv')
+ open(iouOutputWater, file=trim(C%outputPath) // 'output_water' // trim(C%outputHash) // '.csv')
+ open(iouOutputSediment, file=trim(C%outputPath) // 'output_sediment' // trim(C%outputHash) // '.csv')
+ open(iouOutputSoil, file=trim(C%outputPath) // 'output_soil' // trim(C%outputHash) // '.csv')
end if
if (C%writeCompartmentStats) then
- open(iouOutputStats, &
- file=trim(C%outputPath) // 'stats' // trim(C%outputHash) // '.csv')
+ open(iouOutputStats, file=trim(C%outputPath) // 'stats' // trim(C%outputHash) // '.csv')
end if
! Write the headers for the files
- call me%writeHeaders()
+ call this%writeHeaders()
end subroutine
!> Initialise the sediment size distribution steady state run output data file
- subroutine initSedimentSizeDistributionDataOutput(me)
- class(DataOutput) :: me
- integer :: i, j
-
+ subroutine initSedimentSizeDistributionDataOutput(this)
+ class(DataOutput) :: this
+ integer :: i, j
+
! Sediment begins with distribution given in the input data
- allocate(me%previousSSD, source=DATASET%sedimentInitialMass)
- allocate(me%previousSSDByLayer(C%nSedimentLayers, C%nSizeClassesSpm))
+ allocate(this%previousSSD, source=DATASET%sedimentInitialMass)
+ allocate(this%previousSSDByLayer(C%nSedimentLayers, C%nSizeClassesSpm))
do i = 1, C%nSedimentLayers
- me%previousSSDByLayer(i,:) = DATASET%sedimentInitialMass
+ this%previousSSDByLayer(i,:) = DATASET%sedimentInitialMass
end do
! Open the SSD file and write the headers
open(iouOutputSSD, file=trim(C%outputPath) // 'output_ssd' // trim(C%outputHash) // '.csv')
if (C%writeMetadataAsComment) then
write(iouOutputSSD, '(a)') "# NanoFASE model output data - SEDIMENT SIZE DISTRIBUTION."
- write(iouOutputSSD, '(a)') "# Output file for when running the model until sediment size " // &
- "distribution is at steady state."
- write(iouOutputSSD, '(a)') "# Each row represents a complete model run (as defined by the config/batch config file)."
- write(iouOutputSSD, '(a)') "#\ti: model run index (number of iterations of the same input data)"
- write(iouOutputSSD, '(a)') "#\tssd_sci_all_layers: sediment size distribution across size classes i, " // &
- "averaged across sediment layers"
+ write(iouOutputSSD, '(a)') "# Output file for running model until sediment size distribution is at steady state."
+ write(iouOutputSSD, '(a)') "# Each row represents a complete model run."
+ write(iouOutputSSD, '(a)') "#\ti: model run index"
+ write(iouOutputSSD, '(a)') "#\tssd_sci_all_layers: sediment size distribution, averaged across sediment layers"
write(iouOutputSSD, '(a)') "#\tssd_sci_lj: sediment size distribution across size classes i, for layer j"
write(iouOutputSSD, '(a)') "#\tdelta_max_lj: maximum difference between size distribution bins for layer j"
- write(iouOutputSSD, '(a)') "#\tdelta_max_all_layers: maximum difference between size " // &
- "distribution bins for size distribution averaged across sediment layers"
+ write(iouOutputSSD, '(a)') "#\tdelta_max_all_layers: maximum difference for size distribution averaged across layers"
end if
write(iouOutputSSD, '(a)', advance='no') "i,"
write(iouOutputSSD, '(*(a))', advance='no') ('ssd_sc'//trim(str(i))//'_all_layers,', i=1, C%nSizeClassesSpm)
@@ -121,11 +115,9 @@ subroutine initSedimentSizeDistributionDataOutput(me)
end subroutine
!> Save the output from the current timestep to the output files
- subroutine updateDataOutput(me, t, tInChunk)
- class(DataOutput) :: me !! The DataOutput instance
- integer :: t !! The current timestep in the batch
- integer :: tInChunk !! The timestep in the current chunk
- integer :: x, y ! Iterators
+ subroutine updateDataOutput(this, t, tInChunk)
+ class(DataOutput) :: this
+ integer :: t, tInChunk, x, y
type(datetime) :: date
character(len=100) :: dateISO
real :: easts, norths
@@ -135,20 +127,19 @@ subroutine updateDataOutput(me, t, tInChunk)
dateISO = date%isoformat()
! Loop through the grid cells and update each compartment
- do y = 1, size(me%env%item%colGridCells, dim=2)
- do x = 1, size(me%env%item%colGridCells, dim=1)
+ do y = 1, size(this%env%item%colGridCells, dim=2)
+ do x = 1, size(this%env%item%colGridCells, dim=1)
! Only write data if cell isn't masked
if (DATASET%simulationMask(x,y)) then
easts = DATASET%x(x)
norths = DATASET%y(y)
- call me%updateWater(t, tInChunk, x, y, dateISO, easts, norths)
- call me%updateSediment(t, tInChunk, x, y, dateISO, easts, norths)
- call me%updateSoil(t, tInChunk, x, y, dateISO, easts, norths)
- ! Are we writing to a NetCDF file?
+ call this%updateWater(t, tInChunk, x, y, dateISO, easts, norths)
+ call this%updateSediment(t, tInChunk, x, y, dateISO, easts, norths)
+ call this%updateSoil(t, tInChunk, x, y, dateISO, easts, norths)
if (C%writeNetCDF) then
- call me%ncout%updateWater(t, tInChunk, x, y)
- call me%ncout%updateSediment(t, tInChunk, x, y)
- call me%ncout%updateSoil(t, tInChunk, x, y)
+ call this%ncout%updateWater(t, tInChunk, x, y)
+ call this%ncout%updateSediment(t, tInChunk, x, y)
+ call this%ncout%updateSoil(t, tInChunk, x, y)
end if
end if
end do
@@ -156,354 +147,674 @@ subroutine updateDataOutput(me, t, tInChunk)
end subroutine
!> Update the water output file for the current timestep
- subroutine updateWaterDataOutput(me, t, tInChunk, x, y, date, easts, norths)
- class(DataOutput) :: me !! The DataOutput instance
- integer :: t !! The current timestep
- integer :: tInChunk !! Timestep in the current chunk
- integer :: x, y !! Grid cell indices
- character(len=*) :: date !! Datetime of this timestep
- real :: easts, norths !! Eastings and northings of this grid cell
- integer :: i, w ! Iterators
- character(len=3) :: reachType ! Is this a river of estuary?
- real(dp) :: m_spm(C%nSizeClassesSpm) ! SPM masses
- real(dp) :: C_spm(C%nSizeClassesSpm) ! SPM concs
- if (C%writeCSV) then
- ! Do we want to output waterbody breakdown or aggregate to grid cell level?
- if (C%includeWaterbodyBreakdown) then
- ! Loop through the waterbodies in this cell. Only loops if nReaches > 0, hence we don't check explicitly
- do w = 1, me%env%item%colGridCells(x,y)%item%nReaches
- associate (reach => me%env%item%colGridCells(x,y)%item%colRiverReaches(w)%item)
- ! Is it a reach or an estuary?
- select type (reach)
- type is (RiverReach)
- reachType = 'riv'
- type is (EstuaryReach)
- reachType = 'est'
- end select
- ! Write the data
- write(iouOutputWater, '(a)', advance='no') trim(str(t)) // "," // trim(date) // "," // &
- trim(str(x)) // "," // trim(str(y)) // "," // &
- trim(str(easts)) // "," // trim(str(norths)) // "," // trim(str(w)) // "," // reachType // "," // &
- trim(str(sum(reach%m_np))) // "," // trim(str(sum(reach%C_np))) // "," // &
- trim(str(sum(reach%m_transformed))) // "," // trim(str(sum(reach%C_transformed))) // "," // &
- trim(str(reach%m_dissolved)) // "," // trim(str(reach%C_dissolved)) // "," // &
- trim(str(sum(reach%j_nm%deposition))) // "," // &
- trim(str(sum(reach%j_nm_transformed%deposition))) // "," // &
- trim(str(sum(reach%j_nm%resuspension))) // "," // &
- trim(str(sum(reach%j_nm_transformed%resuspension))) // "," // &
- trim(str(sum(reach%j_nm%outflow))) // "," // &
- trim(str(sum(reach%j_nm_transformed%outflow))) // "," // &
- trim(str(reach%j_dissolved%outflow)) // "," // &
- trim(str(sum(reach%m_spm))) // "," // &
- trim(str(sum(reach%C_spm))) // ","
- if (C%includeSpmSizeClassBreakdown) then
- write(iouOutputWater, '(*(a))', advance='no') (trim(str(reach%m_spm(i))) // "," // &
- trim(str(reach%C_spm(i))) // ",", i=1, C%nSizeClassesSpm)
- end if
- if (C%includeSedimentFluxes) then
- write(iouOutputWater, '(a)', advance='no') trim(str(sum(reach%j_spm%soilErosion))) // "," // &
- trim(str(sum(reach%j_spm%deposition))) // "," // &
- trim(str(sum(reach%j_spm%resuspension))) // "," // &
- trim(str(sum(reach%j_spm%inflow))) // "," // trim(str(sum(reach%j_spm%outflow))) // "," // &
- trim(str(sum(reach%j_spm%bankErosion))) // ","
- end if
- write(iouOutputWater, '(a)') trim(str(reach%volume)) // "," // trim(str(reach%depth)) // "," // &
- trim(str(reach%Q%outflow / C%timeStep))
- end associate
- end do
- else
- ! We're not including waterbody breakdown, so just output the grid cell aggregated values. Here we check
- ! that there are reaches in the cell, and if not, don't print a row for this cell. There is slightly different
- ! to checking if the cell is empty (i.e. doesn't have a soil profile either)
- associate (cell => me%env%item%colGridCells(x,y)%item)
- if (cell%nReaches > 0) then
- ! Write the data
- write(iouOutputWater, '(a)', advance='no') trim(str(t)) // "," // trim(date) // "," // &
- trim(str(x)) // "," // trim(str(y)) // "," // &
- trim(str(easts)) // "," // trim(str(norths)) // "," // cell%aggregatedReachType // "," // &
- trim(str(sum(cell%get_m_np_water()))) // "," // trim(str(sum(cell%get_C_np_water()))) // "," // &
- trim(str(sum(cell%get_m_transformed_water()))) // "," // &
- trim(str(sum(cell%get_C_transformed_water()))) // "," // &
- trim(str(cell%get_m_dissolved_water())) // "," // &
- trim(str(cell%get_C_dissolved_water())) // "," // &
- trim(str(sum(cell%get_j_nm_deposition()))) // "," // &
- trim(str(sum(cell%get_j_transformed_deposition()))) // "," // &
- trim(str(sum(cell%get_j_nm_resuspension()))) // "," // &
- trim(str(sum(cell%get_j_transformed_resuspension()))) // "," // &
- trim(str(sum(cell%get_j_nm_outflow()))) // "," // &
- trim(str(sum(cell%get_j_transformed_outflow()))) // "," // &
- trim(str(cell%get_j_dissolved_outflow())) // ","
- m_spm = cell%get_m_spm()
- C_spm = cell%get_C_spm()
- write(iouOutputWater, '(a)', advance='no') trim(str(sum(m_spm))) // "," // &
- trim(str(sum(C_spm))) // ","
- if (C%includeSpmSizeClassBreakdown) then
- write(iouOutputWater, '(*(a))', advance='no') (trim(str(m_spm(i))) // "," // &
- trim(str(C_spm(i))) // ",", i=1, C%nSizeClassesSpm)
- end if
- if (C%includeSedimentFluxes) then
- write(iouOutputWater, '(a)', advance='no') trim(str(sum(cell%get_j_spm_soilErosion()))) // "," // &
- trim(str(sum(cell%get_j_spm_deposition()))) // "," // &
- trim(str(sum(cell%get_j_spm_resuspension()))) // "," // &
- trim(str(sum(cell%get_j_spm_inflow()))) // "," // &
- trim(str(sum(cell%get_j_spm_outflow()))) // "," // &
- trim(str(sum(cell%get_j_spm_bankErosion()))) // ","
+ subroutine updateWaterDataOutput(this, t, tInChunk, x, y, date, easts, norths)
+ class(DataOutput) :: this !! The DataOutput instance
+ integer :: t, tInChunk, x, y
+ character(len=*) :: date
+ real :: easts, norths
+ integer :: i, w, f
+ character(len=3) :: reachType
+ real(dp) :: m_spm(C%nSizeClassesSpm)
+ real(dp) :: C_spm(C%nSizeClassesSpm)
+ type(Contaminant) :: m_contaminant, j_contaminant_outflow, j_contaminant_deposition, j_contaminant_resuspension
+ real(dp) :: C_contaminant, C_dissolved, C_attached
+ real(dp) :: vol
+ real(dp) :: s_free, s_att, s_dep_free, s_dep_att, s_res_free, s_res_att
+ real(dp) :: s_out_free, s_out_att
+ type(Result0D) :: r
+ character(len=256) :: tr = "DataOutputModule.f90%updateWaterDataOutput"
+
+ if (.not. C%writeCSV) return
+
+ if (C%includeWaterbodyBreakdown) then
+ do w = 1, this%env%item%colGridCells(x,y)%item%nReaches
+ associate (reach => this%env%item%colGridCells(x,y)%item%colRiverReaches(w)%item)
+ select type (reach)
+ type is (RiverReach); reachType = 'riv'
+ type is (EstuaryReach); reachType = 'est'
+ end select
+
+ ! --- state ---
+ m_contaminant = reach%get_m_contaminant()
+ vol = reach%volume
+
+ r = m_contaminant%getConcentration(vol)
+ if (r%hasCriticalError() .or. .not. allocated(r%data)) then
+ call r%addToTrace(tr)
+ call m_contaminant%finalise()
+ return
+ end if
+ C_contaminant = r%getDataAsRealDP()
+
+ if (vol > C%epsilon) then
+ C_dissolved = m_contaminant%m_dissolved / vol
+ C_attached = sum(m_contaminant%get_attached()) / vol
+ else
+ C_dissolved = 0.0_dp
+ C_attached = 0.0_dp
+ end if
+
+ ! --- fluxes (guard against unallocated %c) ---
+ j_contaminant_outflow = reach%j_contaminant_outflow
+ j_contaminant_deposition = reach%j_contaminant_deposition
+ j_contaminant_resuspension= reach%j_contaminant_resuspension
+
+ if (allocated(m_contaminant%c)) then
+ s_free = sum(m_contaminant%c(:,:,FREE_CONTAMINANT))
+ s_att = sum(m_contaminant%c(:,:,ATTACHED_CONTAMINANT))
+ else
+ s_free = 0.0_dp
+ s_att = 0.0_dp
+ end if
+
+ if (allocated(j_contaminant_deposition%c)) then
+ s_dep_free = sum(j_contaminant_deposition%c(:,:,FREE_CONTAMINANT))
+ s_dep_att = sum(j_contaminant_deposition%c(:,:,ATTACHED_CONTAMINANT))
+ else
+ s_dep_free = 0.0_dp
+ s_dep_att = 0.0_dp
+ end if
+
+ if (allocated(j_contaminant_resuspension%c)) then
+ s_res_free = sum(j_contaminant_resuspension%c(:,:,FREE_CONTAMINANT))
+ s_res_att = sum(j_contaminant_resuspension%c(:,:,ATTACHED_CONTAMINANT))
+ else
+ s_res_free = 0.0_dp
+ s_res_att = 0.0_dp
+ end if
+
+ if (allocated(j_contaminant_outflow%c)) then
+ s_out_free = sum(j_contaminant_outflow%c(:,:,FREE_CONTAMINANT))
+ s_out_att = sum(j_contaminant_outflow%c(:,:,ATTACHED_CONTAMINANT))
+ else
+ s_out_free = 0.0_dp
+ s_out_att = 0.0_dp
+ end if
+
+ ! --- write row (keep original column order) ---
+ write(iouOutputWater, '(a)', advance='no') trim(str(t)) // "," // trim(date) // "," // &
+ trim(str(x)) // "," // trim(str(y)) // "," // &
+ trim(str(easts)) // "," // trim(str(norths)) // "," // trim(str(w)) // "," // reachType // "," // &
+ trim(str(s_free)) // "," // &
+ trim(str(C_contaminant)) // "," // &
+ trim(str(s_att)) // "," // &
+ trim(str(C_attached)) // "," // &
+ trim(str(m_contaminant%m_dissolved)) // "," // &
+ trim(str(C_dissolved)) // "," // &
+ trim(str(s_dep_free)) // "," // &
+ trim(str(s_dep_att)) // "," // &
+ trim(str(s_res_free)) // "," // &
+ trim(str(s_res_att)) // "," // &
+ trim(str(s_out_free)) // "," // &
+ trim(str(s_out_att)) // "," // &
+ trim(str(j_contaminant_outflow%m_dissolved)) // "," // &
+ trim(str(sum(reach%m_spm))) // "," // &
+ trim(str(sum(reach%C_spm))) // ","
+
+ do f = 1, C%contaminantDim(2)
+ if (allocated(m_contaminant%c)) then
+ write(iouOutputWater, '(a)', advance='no') trim(str(sum(m_contaminant%c(:,f,:)))) // ","
+ else
+ write(iouOutputWater, '(a)', advance='no') "0.0,"
end if
- write(iouOutputWater, '(a)') trim(str(cell%getWaterVolume())) // "," // &
- trim(str(cell%getWaterDepth())) // "," // &
- trim(str(cell%get_Q_outflow() / C%timeStep))
+ end do
+
+ if (C%includeSpmSizeClassBreakdown) then
+ write(iouOutputWater, '(*(a))', advance='no') (trim(str(reach%m_spm(i))) // "," // &
+ trim(str(reach%C_spm(i))) // ",", i=1, C%nSizeClassesSpm)
+ end if
+ if (C%includeSedimentFluxes) then
+ write(iouOutputWater, '(a)', advance='no') trim(str(sum(reach%j_spm%soilErosion))) // "," // &
+ trim(str(sum(reach%j_spm%deposition))) // "," // &
+ trim(str(sum(reach%j_spm%resuspension))) // "," // &
+ trim(str(sum(reach%j_spm%inflow))) // "," // &
+ trim(str(sum(reach%j_spm%outflow))) // "," // &
+ trim(str(sum(reach%j_spm%bankErosion))) // ","
end if
+ write(iouOutputWater, '(a)') trim(str(reach%volume)) // "," // trim(str(reach%depth)) // "," // &
+ trim(str(reach%Q%outflow / C%timeStep))
+
+ call m_contaminant%finalise()
end associate
- end if
- end if
+ end do
+
+ else
+ associate (cell => this%env%item%colGridCells(x,y)%item)
+ if (cell%nReaches > 0) then
+ ! --- aggregated state ---
+ m_contaminant = cell%get_m_contaminant_water()
+ j_contaminant_outflow = cell%get_j_contaminant_outflow()
+ j_contaminant_deposition = cell%get_j_contaminant_deposition()
+ j_contaminant_resuspension = cell%get_j_contaminant_resuspension()
+ vol = cell%getWaterVolume()
+ r = m_contaminant%getConcentration(vol)
+ if (r%hasCriticalError() .or. .not. allocated(r%data)) then
+ call r%addToTrace(tr)
+ call m_contaminant%finalise()
+ return
+ end if
+ C_contaminant = r%getDataAsRealDP()
+
+ if (vol > C%epsilon) then
+ C_dissolved = m_contaminant%m_dissolved / vol
+ C_attached = sum(m_contaminant%get_attached()) / vol
+ else
+ C_dissolved = 0.0_dp
+ C_attached = 0.0_dp
+ end if
+
+ if (allocated(m_contaminant%c)) then
+ s_free = sum(m_contaminant%c(:,:,FREE_CONTAMINANT))
+ s_att = sum(m_contaminant%c(:,:,ATTACHED_CONTAMINANT))
+ else
+ s_free = 0.0_dp
+ s_att = 0.0_dp
+ end if
+
+ if (allocated(j_contaminant_deposition%c)) then
+ s_dep_free = sum(j_contaminant_deposition%c(:,:,FREE_CONTAMINANT))
+ s_dep_att = sum(j_contaminant_deposition%c(:,:,ATTACHED_CONTAMINANT))
+ else
+ s_dep_free = 0.0_dp
+ s_dep_att = 0.0_dp
+ end if
+
+ if (allocated(j_contaminant_resuspension%c)) then
+ s_res_free = sum(j_contaminant_resuspension%c(:,:,FREE_CONTAMINANT))
+ s_res_att = sum(j_contaminant_resuspension%c(:,:,ATTACHED_CONTAMINANT))
+ else
+ s_res_free = 0.0_dp
+ s_res_att = 0.0_dp
+ end if
+
+ if (allocated(j_contaminant_outflow%c)) then
+ s_out_free = sum(j_contaminant_outflow%c(:,:,FREE_CONTAMINANT))
+ s_out_att = sum(j_contaminant_outflow%c(:,:,ATTACHED_CONTAMINANT))
+ else
+ s_out_free = 0.0_dp
+ s_out_att = 0.0_dp
+ end if
+
+ write(iouOutputWater, '(a)', advance='no') trim(str(t)) // "," // trim(date) // "," // &
+ trim(str(x)) // "," // trim(str(y)) // "," // &
+ trim(str(easts)) // "," // trim(str(norths)) // "," // cell%aggregatedReachType // "," // &
+ trim(str(s_free)) // "," // &
+ trim(str(C_contaminant)) // "," // &
+ trim(str(s_att)) // "," // &
+ trim(str(C_attached)) // "," // &
+ trim(str(m_contaminant%m_dissolved)) // "," // &
+ trim(str(C_dissolved)) // "," // &
+ trim(str(s_dep_free)) // "," // &
+ trim(str(s_dep_att)) // "," // &
+ trim(str(s_res_free)) // "," // &
+ trim(str(s_res_att)) // "," // &
+ trim(str(s_out_free)) // "," // &
+ trim(str(s_out_att)) // "," // &
+ trim(str(j_contaminant_outflow%m_dissolved)) // ","
+
+ m_spm = cell%get_m_spm()
+ C_spm = cell%get_C_spm()
+ write(iouOutputWater, '(a)', advance='no') trim(str(sum(m_spm))) // "," // &
+ trim(str(sum(C_spm))) // ","
+
+ do f = 1, C%contaminantDim(2)
+ if (allocated(m_contaminant%c)) then
+ write(iouOutputWater, '(a)', advance='no') trim(str(sum(m_contaminant%c(:,f,:)))) // ","
+ else
+ write(iouOutputWater, '(a)', advance='no') "0.0,"
+ end if
+ end do
+
+ if (C%includeSpmSizeClassBreakdown) then
+ write(iouOutputWater, '(*(a))', advance='no') (trim(str(m_spm(i))) // "," // &
+ trim(str(C_spm(i))) // ",", i=1, C%nSizeClassesSpm)
+ end if
+ if (C%includeSedimentFluxes) then
+ write(iouOutputWater, '(a)', advance='no') &
+ trim(str(sum(cell%get_j_spm_soilErosion()))) // "," // &
+ trim(str(sum(cell%get_j_spm_deposition()))) // "," // &
+ trim(str(sum(cell%get_j_spm_resuspension()))) // "," // &
+ trim(str(sum(cell%get_j_spm_inflow()))) // "," // &
+ trim(str(sum(cell%get_j_spm_outflow()))) // "," // &
+ trim(str(sum(cell%colRiverReaches(1)%item%j_spm%bankErosion))) // ","
+ end if
+ write(iouOutputWater, '(a)') trim(str(cell%getWaterVolume())) // "," // &
+ trim(str(cell%getWaterDepth())) // "," // &
+ trim(str(cell%get_Q_outflow() / C%timeStep))
+
+ call m_contaminant%finalise()
+ end if
+ end associate
+ end if
end subroutine
- !> Update the current sediment output file on the current timestep
- subroutine updateSedimentDataOutput(me, t, tInChunk, x, y, date, easts, norths)
- class(DataOutput) :: me !! The DataOutput instance
- integer :: t !! The current timestep
- integer :: tInChunk !! The current timestep
- integer :: x, y !! Grid cell indices
- character(len=*) :: date !! Datetime of this timestep
- real :: easts, norths !! Eastings and northings of this grid cell
- integer :: w, l ! Iterators
- character(len=3) :: reachType ! Is this a river of estuary?
+
+ !> Update the sediment output file on the current timestep
+ subroutine updateSedimentDataOutput(this, t, tInChunk, x, y, date, easts, norths)
+ class(DataOutput) :: this
+ integer :: t, tInChunk, x, y
+ character(len=*) :: date
+ real :: easts, norths
+ integer :: w, l, f
+ character(len=3) :: reachType
+ type(Contaminant) :: m_contaminant, m_buried
+ real(dp) :: C_contaminant, C_byMass, C_byMass_layer
+ type(Result0D) :: r, res_l, res_get
+ real(dp) :: total_sediment_mass
+ character(len=256) :: tr = "DataOutputModule.f90%updateSedimentDataOutput"
if (C%writeCSV) then
if (C%includeWaterbodyBreakdown) then
- ! Loop through the waterbodies in this cell
- do w = 1, me%env%item%colGridCells(x,y)%item%nReaches
- associate (reach => me%env%item%colGridCells(x,y)%item%colRiverReaches(w)%item)
- ! Is this a river or estuary?
+ do w = 1, this%env%item%colGridCells(x,y)%item%nReaches
+ associate (reach => this%env%item%colGridCells(x,y)%item%colRiverReaches(w)%item)
select type (reach)
- type is (RiverReach)
- reachType = 'riv'
- type is (EstuaryReach)
- reachType = 'est'
+ type is (RiverReach); reachType = 'riv'
+ type is (EstuaryReach); reachType = 'est'
end select
- ! Write the data
- write(iouOutputSediment, '(a)', advance='no') trim(str(t)) // "," &
- // trim(date) // "," // trim(str(x)) // "," // trim(str(y)) &
- // "," // trim(str(easts)) // "," // trim(str(norths)) // "," // &
- trim(str(w)) // "," // reachType // "," // &
- trim(str(sum(reach%bedSediment%get_m_np()) * reach%bedArea)) // "," // & ! Converting from kg/m2 to kg
- trim(str(sum(reach%bedSediment%get_C_np()))) // "," // &
- trim(str(sum(reach%bedSediment%get_C_np_byMass()))) // ","
- ! Only include layer-by-layer breakdown if we've been asked to
+
+ res_get = reach%bedSediment%get_m_contaminant()
+ if (res_get%hasCriticalError() .or. .not. allocated(res_get%data)) then
+ call res_get%addToTrace(tr); return
+ end if
+ select type (data => res_get%getData())
+ type is (Contaminant); m_contaminant = data
+ class default; return
+ end select
+
+ r = m_contaminant%getConcentration(reach%bedArea * sum(C%sedimentLayerDepth))
+ if (r%hasCriticalError() .or. .not. allocated(r%data)) then
+ call r%addToTrace(tr); call m_contaminant%finalise(); return
+ end if
+ C_contaminant = r%getDataAsRealDP()
+
+ total_sediment_mass = reach%bedSediment%Mf_bed_all()
+ if (total_sediment_mass > C%epsilon) then
+ C_byMass = (sum(m_contaminant%c) + m_contaminant%m_dissolved) / total_sediment_mass
+ else
+ C_byMass = 0.0_dp
+ end if
+
+ res_get = reach%bedSediment%get_m_contaminant_buried()
+ if (res_get%hasCriticalError() .or. .not. allocated(res_get%data)) then
+ call res_get%addToTrace(tr); return
+ end if
+ select type (data => res_get%getData())
+ type is (Contaminant); m_buried = data
+ class default; return
+ end select
+
+ write(iouOutputSediment, '(a)', advance='no') trim(str(t)) // "," // trim(date) // "," // &
+ trim(str(x)) // "," // trim(str(y)) // "," // &
+ trim(str(easts)) // "," // trim(str(norths)) // "," // trim(str(w)) // "," // reachType // "," // &
+ trim(str(sum(m_contaminant%c(:,:,FREE_CONTAMINANT)) * reach%bedArea)) // "," // &
+ trim(str(C_contaminant)) // "," // &
+ trim(str(C_byMass)) // ","
+ do f = 1, C%contaminantDim(2)
+ write(iouOutputSediment, '(a)', advance='no') &
+ trim(str(sum(m_contaminant%c(:,f,:)) * reach%bedArea)) // ","
+ end do
if (C%includeSedimentLayerBreakdown) then
- write(iouOutputSediment, '(*(a))', advance='no') &
- (trim(str(sum(reach%bedSediment%get_C_np_l(l)))) // "," // &
- trim(str(sum(reach%bedSediment%get_C_np_l_byMass(l)))) // ",", l=1, C%nSedimentLayers)
+ do l = 1, C%nSedimentLayers
+ res_l = reach%bedSediment%get_m_contaminant_l(l)
+ if (res_l%hasCriticalError() .or. .not. allocated(res_l%data)) then
+ call res_l%addToTrace(tr); cycle
+ end if
+ select type (data => res_l%getData())
+ type is (Contaminant); m_contaminant = data
+ class default; cycle
+ end select
+ r = m_contaminant%getConcentration(reach%bedSediment%colBedSedimentLayers(l)%item%V_layer())
+ if (r%hasCriticalError() .or. .not. allocated(r%data)) then
+ call r%addToTrace(tr); call m_contaminant%finalise(); call m_buried%finalise(); return
+ end if
+
+ total_sediment_mass = reach%bedSediment%colBedSedimentLayers(l)%item%M_f_layer()
+ if (total_sediment_mass > C%epsilon) then
+ C_byMass_layer = (sum(m_contaminant%c) + m_contaminant%m_dissolved) / total_sediment_mass
+ else
+ C_byMass_layer = 0.0_dp
+ end if
+
+ write(iouOutputSediment, '(a)', advance='no') trim(str(r%getDataAsRealDP())) // "," // &
+ trim(str(C_byMass_layer)) // ","
+ call m_contaminant%finalise()
+ end do
end if
write(iouOutputSediment, '(a)') &
- trim(str(sum(reach%bedSediment%get_m_np_buried()) * reach%bedArea)) // "," // &
- trim(str(reach%bedArea)) // "," // trim(str(reach%bedSediment%Mf_bed_all() * reach%bedArea)) &
- // "," // trim(str(reach%bedSediment%Mf_bed_all() / sum(C%sedimentLayerDepth)))
+ trim(str(sum(m_buried%c(:,:,FREE_CONTAMINANT)) * reach%bedArea)) // "," // &
+ trim(str(reach%bedArea)) // "," // &
+ trim(str(reach%bedSediment%Mf_bed_all() * reach%bedArea)) // "," // &
+ trim(str(reach%bedSediment%Mf_bed_all() / sum(C%sedimentLayerDepth)))
+ call m_contaminant%finalise()
+ call m_buried%finalise()
end associate
end do
else
- ! We're not including waterbody breakdown, so just output the grid cell aggregated values. Here we check
- ! that there are reaches in the cell, and if not, don't print a row for this cell. There is slightly different
- ! to checking if the cell is empty (i.e. doesn't have a soil profile either)
- associate (cell => me%env%item%colGridCells(x,y)%item)
+ associate (cell => this%env%item%colGridCells(x,y)%item)
if (cell%nReaches > 0) then
- ! Write the data
+ ! Get contaminant mass directly (cell getters are not wrapped in Result0D)
+ m_contaminant = cell%get_m_contaminant_sediment()
+
+ r = m_contaminant%getConcentration(cell%getBedSedimentArea() * sum(C%sedimentLayerDepth))
+ if (r%hasCriticalError() .or. .not. allocated(r%data)) then
+ call r%addToTrace(tr); call m_contaminant%finalise(); return
+ end if
+ C_contaminant = r%getDataAsRealDP()
+
+ total_sediment_mass = cell%getBedSedimentMass()
+ if (total_sediment_mass > C%epsilon) then
+ C_byMass = (sum(m_contaminant%c) + m_contaminant%m_dissolved) / total_sediment_mass
+ else
+ C_byMass = 0.0_dp
+ end if
+
+ ! Get buried contaminant mass directly
+ m_buried = cell%get_m_contaminant_buried_sediment()
+
write(iouOutputSediment, '(a)', advance='no') trim(str(t)) // "," // trim(date) // "," // &
trim(str(x)) // "," // trim(str(y)) // "," // &
trim(str(easts)) // "," // trim(str(norths)) // "," // cell%aggregatedReachType // "," // &
- trim(str(sum(cell%get_m_np_sediment()))) // "," // &
- trim(str(sum(cell%get_C_np_sediment_byVolume()))) // "," // &
- trim(str(sum(cell%get_C_np_sediment()))) // ","
- ! Only include layer-by-layer breakdown if we've been asked to
+ trim(str(sum(m_contaminant%c(:,:,FREE_CONTAMINANT)))) // "," // &
+ trim(str(C_contaminant)) // "," // &
+ trim(str(C_byMass)) // ","
+ do f = 1, C%contaminantDim(2)
+ write(iouOutputSediment, '(a)', advance='no') trim(str(sum(m_contaminant%c(:,f,:)))) // ","
+ end do
if (C%includeSedimentLayerBreakdown) then
- write(iouOutputSediment, '(*(a))', advance='no') &
- (trim(str(sum(cell%get_C_np_sediment_l_byVolume(l)))) // "," // &
- trim(str(sum(cell%get_C_np_sediment_l(l)))) // ",", l=1, C%nSedimentLayers)
+ associate (bedSediment => cell%colRiverReaches(1)%item%bedSediment)
+ do l = 1, C%nSedimentLayers
+ res_l = bedSediment%get_m_contaminant_l(l)
+ if (res_l%hasCriticalError() .or. .not. allocated(res_l%data)) then
+ call res_l%addToTrace(tr); cycle
+ end if
+ select type (data => res_l%getData())
+ type is (Contaminant); m_contaminant = data
+ class default; cycle
+ end select
+ r = m_contaminant%getConcentration(bedSediment%colBedSedimentLayers(l)%item%V_layer())
+ if (r%hasCriticalError() .or. .not. allocated(r%data)) then
+ call r%addToTrace(tr); call m_contaminant%finalise(); call m_buried%finalise(); return
+ end if
+
+ total_sediment_mass = bedSediment%colBedSedimentLayers(l)%item%M_f_layer()
+ if (total_sediment_mass > C%epsilon) then
+ C_byMass_layer = (sum(m_contaminant%c) + m_contaminant%m_dissolved) / total_sediment_mass
+ else
+ C_byMass_layer = 0.0_dp
+ end if
+
+ write(iouOutputSediment, '(a)', advance='no') trim(str(r%getDataAsRealDP())) // "," // &
+ trim(str(C_byMass_layer)) // ","
+ call m_contaminant%finalise()
+ end do
+ end associate
end if
write(iouOutputSediment, '(a)') &
- trim(str(sum(cell%get_m_np_buried_sediment()))) // "," // &
- trim(str(cell%getBedSedimentArea())) // "," // trim(str(cell%getBedSedimentMass())) &
- // "," // trim(str(cell%getBedSedimentMass() / &
- ((cell%getBedSedimentArea() * sum(C%sedimentLayerDepth)))))
+ trim(str(sum(m_buried%c(:,:,FREE_CONTAMINANT)))) // "," // &
+ trim(str(cell%getBedSedimentArea())) // "," // trim(str(cell%getBedSedimentMass())) // "," // &
+ trim(str(cell%getBedSedimentMass() / (cell%getBedSedimentArea() * sum(C%sedimentLayerDepth))))
+ call m_contaminant%finalise()
+ call m_buried%finalise()
end if
end associate
end if
end if
end subroutine
- !> Update the sediment output file on the current timestep
- subroutine updateSoilDataOutput(me, t, tInChunk, x, y, date, easts, norths)
- class(DataOutput) :: me !! This DataOutput instance
- integer :: t !! The current timestep
- integer :: tInChunk !! The current timestep
- integer :: x, y !! Grid cell indices
- character(len=*) :: date !! Datetime of this timestep
- real :: easts, norths !! Eastings and northings of this grid cell
- integer :: i, l ! Iterators
- ! Loop through soil profiles and write row for each one
- do i = 1, me%env%item%colGridCells(x,y)%item%nSoilProfiles
- associate (profile => me%env%item%colGridCells(x,y)%item%colSoilProfiles(i)%item)
- write(iouOutputSoil, '(a)', advance='no') trim(str(t)) // "," // trim(date) // "," // &
- trim(str(x)) // "," // trim(str(y)) // "," // trim(str(easts)) // "," // trim(str(norths)) // "," // &
- trim(str(i)) // "," // trim(profile%dominantLandUseName) // "," // &
- trim(str(sum(profile%get_m_np()))) // "," // trim(str(sum(profile%get_m_transformed()))) // "," // &
- trim(str(profile%get_m_dissolved())) // "," // trim(str(sum(profile%get_C_np()))) // "," // &
- trim(str(sum(profile%get_C_transformed()))) // "," // trim(str(profile%get_C_dissolved())) // ","
- if (C%includeSoilStateBreakdown) then
- write(iouOutputSoil, '(a)', advance='no') trim(str(sum(freeNM(profile%get_C_np())))) // "," // &
- trim(str(sum(freeNM(profile%get_C_transformed())))) // "," // &
- trim(str(sum(attachedNM(profile%get_C_np())))) // "," // &
- trim(str(sum(attachedNM(profile%get_C_transformed())))) // ","
- end if
- if (C%includeSoilLayerBreakdown) then
- write(iouOutputSoil, '(*(a))', advance='no') &
- (trim(str(sum(profile%colSoilLayers(l)%item%C_np))) // "," // &
- trim(str(sum(profile%colSoilLayers(l)%item%C_transformed))) // "," // &
- trim(str(profile%colSoilLayers(l)%item%C_dissolved)) // ",", l = 1, C%nSoilLayers)
- if (C%includeSedimentLayerBreakdown) then
- write(iouOutputSoil, '(*(a))', advance='no') &
- (trim(str(sum(freeNM(profile%colSoilLayers(l)%item%C_np)))) // "," // &
- trim(str(sum(freeNM(profile%colSoilLayers(l)%item%C_transformed)))) // ",", &
- l = 1, C%nSoilLayers)
- write(iouOutputSoil, '(*(a))', advance='no') &
- (trim(str(sum(attachedNM(profile%colSoilLayers(l)%item%C_np)))) // "," // &
- trim(str(sum(attachedNM(profile%colSoilLayers(l)%item%C_transformed)))) // ",", &
- l = 1, C%nSoilLayers)
+ subroutine updateSoilDataOutput(this, t, tInChunk, x, y, date, easts, norths)
+ class(DataOutput) :: this
+ integer :: t, tInChunk, x, y
+ character(len=*) :: date
+ real :: easts, norths
+ integer :: i, l, f
+ type(Contaminant) :: m_contaminant, m_eroded, m_buried
+ real(dp) :: C_contaminant, C_attached, C_dissolved
+ real(dp) :: C_layer_total, C_dissolved_layer
+ real(dp) :: profile_volume, profile_mass
+ real(dp) :: layer_volume, layer_mass
+
+ if (C%writeCSV) then
+ do i = 1, this%env%item%colGridCells(x,y)%item%nSoilProfiles
+ associate (profile => this%env%item%colGridCells(x,y)%item%colSoilProfiles(i)%item)
+
+ ! --- masses in the whole profile ---
+ m_contaminant = profile%get_m_contaminant()
+
+ ! total *volume* of soil in profile (sum of layer volumes already in m^3)
+ profile_volume = sum([(profile%colSoilLayers(l)%item%volume, l = 1, C%nSoilLayers)])
+ ! convert to dry-soil mass [kg] using bulk density
+ profile_mass = profile%bulkDensity * profile_volume
+
+ ! --- concentrations in kg/kg (mass / dry-soil mass) ---
+ if (profile_mass > C%epsilon) then
+ C_contaminant = ( sum(m_contaminant%get_free()) &
+ + sum(m_contaminant%get_attached()) &
+ + m_contaminant%m_dissolved ) / profile_mass
+
+ C_attached = sum(m_contaminant%get_attached()) / profile_mass
+ C_dissolved = m_contaminant%m_dissolved / profile_mass
+ else
+ C_contaminant = 0.0_dp
+ C_attached = 0.0_dp
+ C_dissolved = 0.0_dp
end if
- end if
- ! Should we include soil erosion?
- if (C%includeSoilErosionYields) then
- write(iouOutputSoil, '(a)', advance='no') trim(str(sum(profile%erodedSediment) * profile%area)) &
- // "," // trim(str(sum(profile%m_np_eroded(:,:,2)))) // "," // &
- trim(str(sum(profile%m_transformed_eroded(:,:,2)))) // ","
- end if
- write(iouOutputSoil, '(a)') trim(str(sum(profile%m_np_buried))) // "," // &
- trim(str(sum(profile%m_transformed_buried))) // "," // &
- trim(str(profile%m_dissolved_buried)) // "," // &
- trim(str(profile%bulkDensity))
- end associate
- end do
+
+ ! erosion/burial masses (unchanged)
+ m_eroded = profile%m_contaminant_eroded
+ m_buried = profile%m_contaminant_buried
+
+ ! -------- write CSV row header + profile totals --------
+ write(iouOutputSoil, '(a)', advance='no') trim(str(t)) // "," // trim(date) // "," // &
+ trim(str(x)) // "," // trim(str(y)) // "," // trim(str(easts)) // "," // trim(str(norths)) // "," // &
+ trim(str(i)) // "," // trim(profile%dominantLandUseName) // "," // &
+ trim(str(sum(m_contaminant%c(:,:,FREE_CONTAMINANT)))) // "," // & ! m_contaminant_pristine_total(kg)
+ trim(str(sum(m_contaminant%c(:,:,ATTACHED_CONTAMINANT)))) // "," // & ! m_contaminant_attached_total(kg)
+ trim(str(m_contaminant%m_dissolved)) // "," // & ! m_dissolved_total(kg)
+ trim(str(C_contaminant)) // "," // & ! C_contaminant_total(kg/kg)
+ trim(str(C_attached)) // "," // & ! C_contaminant_attached(kg/kg)
+ trim(str(C_dissolved)) // "," ! C_dissolved_total(kg/kg)
+
+ ! per-form masses (unchanged)
+ do f = 1, C%contaminantDim(2)
+ write(iouOutputSoil, '(a)', advance='no') trim(str(sum(m_contaminant%c(:,f,:)))) // ","
+ end do
+
+ ! optional: state breakdown totals (unchanged, but keep order)
+ if (C%includeSoilStateBreakdown) then
+ write(iouOutputSoil, '(a)', advance='no') &
+ trim(str(sum(m_contaminant%get_free()))) // "," // &
+ trim(str(sum(m_contaminant%get_attached()))) // ","
+ end if
+
+ ! -------- per-layer concentrations (kg/kg) --------
+ if (C%includeSoilLayerBreakdown) then
+ do l = 1, C%nSoilLayers
+ m_contaminant = profile%colSoilLayers(l)%item%m_contaminant
+
+ layer_volume = profile%colSoilLayers(l)%item%volume
+ layer_mass = profile%bulkDensity * layer_volume
+
+ if (layer_mass > C%epsilon) then
+ C_layer_total = ( sum(m_contaminant%get_free()) &
+ + sum(m_contaminant%get_attached()) &
+ + m_contaminant%m_dissolved ) / layer_mass
+ C_dissolved_layer = m_contaminant%m_dissolved / layer_mass
+ else
+ C_layer_total = 0.0_dp
+ C_dissolved_layer = 0.0_dp
+ end if
+
+ write(iouOutputSoil, '(a)', advance='no') &
+ trim(str(C_layer_total)) // "," // &
+ trim(str(C_dissolved_layer)) // ","
+
+ if (C%includeSoilStateBreakdown) then
+ write(iouOutputSoil, '(a)', advance='no') &
+ trim(str(sum(m_contaminant%get_free()))) // "," // &
+ trim(str(sum(m_contaminant%get_attached()))) // ","
+ end if
+ call m_contaminant%finalise()
+ end do
+ end if
+
+ ! -------- erosion yields (unchanged) --------
+ if (C%includeSoilErosionYields) then
+ write(iouOutputSoil, '(a)', advance='no') &
+ trim(str(sum(profile%erodedSediment) * profile%area)) // "," // &
+ trim(str(sum(m_eroded%c(:,:,FREE_CONTAMINANT)))) // "," // &
+ trim(str(sum(m_eroded%c(:,:,ATTACHED_CONTAMINANT)))) // ","
+ end if
+
+ ! -------- burial + bulk density (unchanged) --------
+ write(iouOutputSoil, '(a)') &
+ trim(str(sum(m_buried%c(:,:,FREE_CONTAMINANT)))) // "," // &
+ trim(str(sum(m_buried%c(:,:,ATTACHED_CONTAMINANT)))) // "," // &
+ trim(str(m_buried%m_dissolved)) // "," // &
+ trim(str(profile%bulkDensity))
+
+ call m_contaminant%finalise()
+ call m_eroded%finalise()
+ call m_buried%finalise()
+ end associate
+ end do
+ end if
end subroutine
- function updateSedimentSizeDistributionDataOutput(me, i_model) result(delta_max)
- class(DataOutput) :: me !! This DataOutput instance
- integer :: i_model !! Current model iteration
- real(dp) :: m_sediment_byLayer(C%nSedimentLayers, C%nSizeClassesSpm)
+ function updateSedimentSizeDistributionDataOutput(this, i_model) result(delta_max)
+ class(DataOutput) :: this
+ integer :: i_model
+ real(dp) :: delta_max, m_sediment_byLayer(C%nSedimentLayers, C%nSizeClassesSpm)
real(dp) :: sedimentSizeDistributionByLayer(C%nSedimentLayers, C%nSizeClassesSpm)
real(dp) :: sedimentSizeDistribution(C%nSizeClassesSpm)
integer :: i, j
- real(dp) :: delta_max
real(dp) :: delta_max_l(C%nSedimentLayers)
- ! Get the current mass of sediment in each layer
- m_sediment_byLayer = me%env%item%get_m_sediment_byLayer()
- ! Calculate the sediment size distribution across all layers
+
+ m_sediment_byLayer = this%env%item%get_m_sediment_byLayer()
sedimentSizeDistribution = sum(m_sediment_byLayer, dim=1) / sum(m_sediment_byLayer)
- ! Calculate the sediment size distribution for each layer
do j = 1, C%nSedimentLayers
sedimentSizeDistributionByLayer(j,:) = m_sediment_byLayer(j,:) / sum(m_sediment_byLayer(j,:))
- delta_max_l = maxval(abs(me%previousSSDByLayer(j,:) - sedimentSizeDistributionByLayer(j,:)))
+ delta_max_l(j) = maxval(abs(this%previousSSDByLayer(j,:) - sedimentSizeDistributionByLayer(j,:)))
end do
- delta_max = maxval(abs(me%previousSSD - sedimentSizeDistribution))
- ! Write the values to file
+ delta_max = maxval(abs(this%previousSSD - sedimentSizeDistribution))
write(iouOutputSSD, '(a)', advance='no') trim(str(i_model)) // ","
- write(iouOutputSSD, '(*(a))', advance='no') (trim(str(sedimentSizeDistribution(i))) // &
- ",", i=1, C%nSizeClassesSpm)
- write(iouOutputSSD, '(*(a))', advance='no') ((trim(str(sedimentSizeDistributionByLayer(j,i))) // &
- ",", i=1, C%nSizeClassesSpm), j=1, C%nSedimentLayers)
+ write(iouOutputSSD, '(*(a))', advance='no') (trim(str(sedimentSizeDistribution(i))) // ",", i=1, C%nSizeClassesSpm)
+ write(iouOutputSSD, '(*(a))', advance='no') ((trim(str(sedimentSizeDistributionByLayer(j,i))) // ",", &
+ i=1, C%nSizeClassesSpm), j=1, C%nSedimentLayers)
write(iouOutputSSD, '(*(a))', advance='no') (trim(str(delta_max_l(i)))//',', i=1, C%nSedimentLayers)
write(iouOutputSSD, '(a)') trim(str(delta_max))
- ! Update the previous SSDs to use on the next model iteration
- me%previousSSD = sedimentSizeDistribution
- me%previousSSDByLayer = sedimentSizeDistributionByLayer
+ this%previousSSD = sedimentSizeDistribution
+ this%previousSSDByLayer = sedimentSizeDistributionByLayer
end function
- ! Finalise the data output by adding PECs to the simulation summary file and closing output files
- subroutine finaliseDataOutput(me, iSteadyState)
- class(DataOutput) :: me
- integer :: iSteadyState
- real(dp) :: timeUntilSteadyState
- ! Write the final model summary info to the simulation summary file
+ subroutine finaliseDataOutput(this, iSteadyState)
+ class(DataOutput) :: this
+ integer :: iSteadyState
+ real(dp) :: timeUntilSteadyState
+ type(Contaminant) :: cont_soil, cont_water, cont_sediment
+ real(dp) :: total_mass_water, mean_mass_water, total_mass_sediment, mean_mass_sediment
+ integer :: t
+
if (.not. C%runToSteadyState) then
write(iouOutputSummary, *) "\n## PECs"
else
write(iouOutputSummary, *) "\n## PECs (final model iteration)"
end if
+ cont_soil = this%env%item%get_C_contaminant_soil()
+ cont_water = this%env%item%get_C_contaminant_water()
+ cont_sediment = this%env%item%get_C_contaminant_sediment()
write(iouOutputSummary, *) "- Soil, spatial mean on final timestep: " // &
- trim(str(sum(me%env%item%get_C_np_soil()))) // " kg/kg soil"
+ trim(str(sum(cont_soil%c(:,:,FREE_CONTAMINANT)))) // " kg/kg soil"
+
+ total_mass_water = 0.0_dp
+ if (allocated(this%env%item%contaminant_water_t)) then
+ do t = 1, size(this%env%item%contaminant_water_t)
+ total_mass_water = total_mass_water + sum(this%env%item%contaminant_water_t(t)%c) &
+ + this%env%item%contaminant_water_t(t)%m_dissolved
+ end do
+ if (size(this%env%item%contaminant_water_t) > 0) then
+ mean_mass_water = total_mass_water / size(this%env%item%contaminant_water_t)
+ else
+ mean_mass_water = 0.0_dp
+ end if
+ else
+ mean_mass_water = 0.0_dp
+ end if
write(iouOutputSummary, *) "- Water, spatiotemporal mean: " // &
- trim(str(sum(sum(me%env%item%C_np_water_t, dim=1)) / size(me%env%item%C_np_water_t, dim=1))) // " kg/m3"
+ trim(str(mean_mass_water)) // " kg/m3"
+
+ total_mass_sediment = 0.0_dp
+ if (allocated(this%env%item%contaminant_sediment_t)) then
+ do t = 1, size(this%env%item%contaminant_sediment_t)
+ total_mass_sediment = total_mass_sediment + sum(this%env%item%contaminant_sediment_t(t)%c) &
+ + this%env%item%contaminant_sediment_t(t)%m_dissolved
+ end do
+ if (size(this%env%item%contaminant_sediment_t) > 0) then
+ mean_mass_sediment = total_mass_sediment / size(this%env%item%contaminant_sediment_t)
+ else
+ mean_mass_sediment = 0.0_dp
+ end if
+ else
+ mean_mass_sediment = 0.0_dp
+ end if
write(iouOutputSummary, *) "- Sediment, spatiotemporal mean: " // &
- trim(str(sum(sum(me%env%item%C_np_sediment_t, dim=1)) / size(me%env%item%C_np_sediment_t, dim=1))) // &
- " kg/kg sediment"
-
+ trim(str(mean_mass_sediment)) // " kg/kg sediment"
+
+ call cont_soil%finalise()
+ call cont_water%finalise()
+ call cont_sediment%finalise()
+
timeUntilSteadyState = iSteadyState * C%timeStep * C%nTimestepsInBatch
if (C%runToSteadyState) then
write(iouOutputSummary, *) "\n## Steady state"
write(iouOutputSummary, *) "- Iterations until steady state: " // trim(str(iSteadyState))
- write(iouOutputSummary, *) "- Time until steady state: " &
- // trim(str(iSteadyState * C%timeStep * C%nTimestepsInBatch)) // " s"
+ write(iouOutputSummary, *) "- Time until steady state: " // trim(str(timeUntilSteadyState)) // " s"
end if
- ! Close the files
- close(iouOutputSummary); close(iouOutputWater); close(iouOutputSediment); close(iouOutputSoil)
- close(iouOutputSSD); close(iouOutputStats)
+ close(iouOutputSummary); close(iouOutputWater); close(iouOutputSediment)
+ close(iouOutputSoil); close(iouOutputSSD); close(iouOutputStats)
- ! Log that we've written output data files
call LOGR%add('Model output written to ' // trim(C%outputPath), COLOR_GREEN)
end subroutine
- !> Tell the NetCDF output class to reallocate memory for the new chunk,
- !! if we're in write-at-end mode
- subroutine newChunkDataOutput(me, k)
- class(DataOutput) :: me !! This DataOutput instance
- integer :: k !! This chunk index
- ! Only bother calling this if we need to reallocate memory
+ subroutine newChunkDataOutput(this, k)
+ class(DataOutput) :: this
+ integer :: k
if (C%writeNetCDF .and. C%netCDFWriteMode == 'end') then
- call me%ncout%newChunk(k)
+ call this%ncout%newChunk(k)
end if
end subroutine
- !> Tell the NetCDF output class that we're at the end of a chunk, so that
- !! it write to the NetCDF file if in write-at-end mode
- subroutine finaliseChunkDataOutput(me, tStart, isFinalChunk)
- class(DataOutput) :: me !! This DataOutput instance
- integer :: tStart !! Timestep index at the start of this chunk
- logical :: isFinalChunk !! Is this the final chunk?
- ! Only bother calling this if we need to write to the NetCDF file
+ subroutine finaliseChunkDataOutput(this, tStart, isFinalChunk)
+ class(DataOutput) :: this
+ integer :: tStart
+ logical :: isFinalChunk
if (C%writeNetCDF .and. C%netCDFWriteMode == 'end') then
- call me%ncout%finaliseChunk(tStart)
+ call this%ncout%finaliseChunk(tStart)
end if
- ! If this is the final chunk, close the NetCDF file
if (C%writeNetCDF .and. isFinalChunk) then
- call me%ncout%close()
+ call this%ncout%close()
end if
end subroutine
- ! Write the headers for the output files
- subroutine writeHeadersDataOutput(me)
- class(DataOutput) :: me !! This DataOutput instance
- ! Write headers all of the output files
- call me%writeHeadersSimulationSummary()
+ subroutine writeHeadersDataOutput(this)
+ class(DataOutput) :: this
+ call this%writeHeadersSimulationSummary()
if (C%writeCSV) then
- call me%writeHeadersWater()
- call me%writeHeadersSediment()
- call me%writeHeadersSoil()
+ call this%writeHeadersWater()
+ call this%writeHeadersSediment()
+ call this%writeHeadersSoil()
end if
if (C%writeCompartmentStats) then
- call me%writeHeadersStats()
+ call this%writeHeadersStats()
end if
end subroutine
- !> Write headers for the simulation summary file, including basic info about the model run
- subroutine writeHeadersSimulationSummaryDataOutput(me)
- class(DataOutput) :: me !! This DataOutput instance
- type(datetime) :: simDatetime ! Datetime the simulation was run
+ subroutine writeHeadersSimulationSummaryDataOutput(this)
+ class(DataOutput) :: this
+ type(datetime) :: simDatetime
- ! Parse some datetimes
simDatetime = simDatetime%now()
-
- ! Summary file headers
write(iouOutputSummary, '(a)') "# NanoFASE model simulation summary"
write(iouOutputSummary, '(a)') " - Description: " // trim(C%runDescription)
write(iouOutputSummary, '(a)') " - Simulation datetime: " // simDatetime%isoformat()
@@ -521,7 +832,6 @@ subroutine writeHeadersSimulationSummaryDataOutput(me)
write(iouOutputSummary, *) "- End date: " // C%batchEndDate%strftime('%Y-%m-%d')
write(iouOutputSummary, *) "- Timestep length: " // trim(str(C%timeStep)) // " s"
write(iouOutputSummary, *) "- Number of timesteps: " // trim(str(C%nTimestepsInBatch))
-
write(iouOutputSummary, *) "\n## Spatial domain"
write(iouOutputSummary, *) "- Grid resolution: " // trim(str(DATASET%gridRes(1))) // ", " // &
trim(str(DATASET%gridRes(2))) // " m"
@@ -529,32 +839,21 @@ subroutine writeHeadersSimulationSummaryDataOutput(me)
trim(str(DATASET%gridBounds(2))) // &
", " // trim(str(DATASET%gridBounds(3))) // ", " // trim(str(DATASET%gridBounds(4))) // " m"
write(iouOutputSummary, *) "- Grid shape: " // trim(str(DATASET%gridShape(1))) // ", " // trim(str(DATASET%gridShape(2)))
- write(iouOutputSummary, *) "- Number of non-empty grid cells: " // trim(str(me%env%item%nGridCells))
+ write(iouOutputSummary, *) "- Number of non-empty grid cells: " // trim(str(this%env%item%nGridCells))
write(iouOutputSummary, *) "- Is simulation masked? " // trim(str(C%hasSimulationMask))
write(iouOutputSummary, *) "- Number of non-masked grid cells: " // trim(str(DATASET%nNonMaskedCells))
end subroutine
- !> Write the headers for the compartment stats file
- subroutine writeHeadersStatsDataOutput(me)
- class(DataOutput) :: me
-
- ! ! Write metadata, if we're meant to
- ! if (C%writeMetadataAsComment) then
- ! write(iouOutputStats, '(a)') "# NanoFASE model output data - COMPARTMENT STATS.\n"
- ! write(iouOutputStats, '(a)') "# This file contains summary statistics for each environmental compartment.\n"
- ! end if
- ! write(iouOutputStats '(a)')
- end subroutine
-
- !> Write the headers for the water output file
- subroutine writeHeadersWaterDataOutput(me)
- class(DataOutput) :: me !! This DataOutput instance
- integer :: i ! Size class iterator
+ subroutine writeHeadersWaterDataOutput(this)
+ class(DataOutput) :: this
+ integer :: i, f
- ! Write metadata, if we're meant to
if (C%writeMetadataAsComment) then
- write(iouOutputWater, '(a)') "# NanoFASE model output data - WATER.\n# See summary.md for model run metadata."
- write(iouOutputWater, '(a)') "# Columns:\n#\tt: timestep index\n#\tdatetime: datetime of this timestep"
+ write(iouOutputWater, '(a)') "# NanoFASE model output data - WATER."
+ write(iouOutputWater, '(a)') "# See summary.md for model run metadata."
+ write(iouOutputWater, '(a)') "# Columns:"
+ write(iouOutputWater, '(a)') "#\tt: timestep index"
+ write(iouOutputWater, '(a)') "#\tdatetime: datetime of this timestep"
write(iouOutputWater, '(a)') "#\tx, y: grid cell (eastings and northings) index"
write(iouOutputWater, '(a)') "#\teasts, norths: eastings and northings at the centre of this grid cell (m)"
if (C%includeWaterbodyBreakdown) write(iouOutputWater, '(a)') "#\tw: waterbody index within this grid cell"
@@ -563,34 +862,38 @@ subroutine writeHeadersWaterDataOutput(me)
else
write(iouOutputWater, '(a)') "#\twaterbody_type: what is the dominant waterbody type in this cell?"
end if
- write(iouOutputWater, '(a)') "#\tm_np(kg), m_transformed(kg), m_dissolved(kg): " // &
- "NM mass (pristine, transformed and dissolved, kg)"
- write(iouOutputWater, '(a)') "#\tC_np(kg/m3), C_transformed(kg/m3), C_dissolved(kg/m3): NM concentration (kg/m3)"
- write(iouOutputWater, '(a)') "#\tm_np_outflow(kg), m_transformed_outflow(kg), m_dissolved_outflow(kg): " // &
- "downstream outflow NM masses (kg)"
- write(iouOutputWater, '(a)') "#\tm_np_deposited(kg), m_transformed_deposited(kg): mass of NM deposited (kg)"
- write(iouOutputWater, '(a)') "#\tm_np_resuspended(kg), m_transformed_resuspended(kg): mass of NM resuspended (kg)"
+ write(iouOutputWater, '(a)') "#\tm_contaminant_pristine(kg), m_contaminant_attached(kg), m_dissolved(kg): " // &
+ "contaminant mass (pristine, attached, dissolved, kg)"
+ write(iouOutputWater, '(a)') "#\tC_contaminant_total(kg/m3), C_contaminant_attached(kg/m3), C_dissolved(kg/m3): " // &
+ "contaminant concentration (total, attached, dissolved, kg/m3)"
+ write(iouOutputWater, '(a)') "#\tm_contaminant_pristine_deposited(kg), m_contaminant_attached_deposited(kg): " // &
+ "deposited contaminant masses (kg)"
+ write(iouOutputWater, '(a)') "#\tm_contaminant_pristine_resuspended(kg), m_contaminant_attached_resuspended(kg): " // &
+ "resuspended contaminant masses (kg)"
+ write(iouOutputWater, '(a)') "#\tm_contaminant_pristine_outflow(kg), " // &
+ "m_contaminant_attached_outflow(kg), m_dissolved_outflow(kg): " // &
+ "outflow contaminant masses (kg)"
write(iouOutputWater, '(a)') "#\tm_spm(kg), C_spm(kg/m3): mass and concentration of SPM (kg, kg/m3)"
+ write(iouOutputWater, '(a)') "#\tm_contaminant_form_f(kg): contaminant mass for form f (kg)"
if (C%includeSpmSizeClassBreakdown) then
- write(iouOutputWater, '(a)') "#\tm_spm_sci(kg), C_spm_sci(kg/m3): mass aond concentration of SPM in " // &
- "size class i (kg, kg/m3)"
+ write(iouOutputWater, '(a)') "#\tm_spm_sci(kg), C_spm_sci(kg/m3): " // &
+ "mass and concentration of SPM in size class i (kg, kg/m3)"
end if
if (C%includeSedimentFluxes) then
write(iouOutputWater, '(a)') "#\tm_spm_erosion(kg), m_spm_dep(kg), m_spm_res(kg), m_spm_inflow(kg), " // &
- "m_spm_outflow(kg), m_spm_bank_erosion(kg): SPM fluxes from erosion, deposition, resuspension, " // &
- "inflows, outflow and bank erosion on this timestep (kg)"
+ "m_spm_outflow(kg), m_spm_bank_erosion(kg): SPM fluxes (kg)"
end if
- write(iouOutputWater, '(a)') "#\tvolume(m3), depth(m), flow(m3/s): volume (m3), " // &
- "depth (m) and flow rate (m3/s) of this waterbody"
+ write(iouOutputWater, '(a)') "#\tvolume(m3), depth(m), flow(m3/s): volume (m3), depth (m), flow rate (m3/s)"
end if
- ! Write the actual headers
write(iouOutputWater, '(a)', advance='no') "t,datetime,x,y,easts,norths,"
if (C%includeWaterbodyBreakdown) write(iouOutputWater, '(a)', advance='no') "w,"
- write(iouOutputWater, '(a)', advance='no') "waterbody_type,m_np(kg),C_np(kg/m3)," // &
- "m_transformed(kg),C_transformed(kg/m3),m_dissolved(kg),C_dissolved(kg/m3)," // &
- "m_np_deposited(kg),m_transformed_deposited(kg)," // &
- "m_np_resuspended(kg),m_transformed_resuspended(kg),m_np_outflow(kg),m_transformed_outflow(kg)," // &
- "m_dissolved_outflow(kg),m_spm(kg),C_spm(kg/m3),"
+ write(iouOutputWater, '(a)', advance='no') "waterbody_type,m_contaminant_pristine(kg),C_contaminant_total(kg/m3)," // &
+ "m_contaminant_attached(kg),C_contaminant_attached(kg/m3),m_dissolved(kg),C_dissolved(kg/m3)," // &
+ "m_contaminant_pristine_deposited(kg),m_contaminant_attached_deposited(kg)," // &
+ "m_contaminant_pristine_resuspended(kg),m_contaminant_attached_resuspended(kg)," // &
+ "m_contaminant_pristine_outflow(kg),m_contaminant_attached_outflow(kg),m_dissolved_outflow(kg)," // &
+ "m_spm(kg),C_spm(kg/m3),"
+ write(iouOutputWater, '(*(a))', advance='no') ("m_contaminant_form" // trim(str(f)) // "(kg),", f=1, C%contaminantDim(2))
if (C%includeSpmSizeClassBreakdown) then
write(iouOutputWater, '(*(a))', advance="no") &
("m_spm_sc" // trim(str(i)) // "(kg),C_spm_sc" // trim(str(i)) // "(kg/m3),", i=1, C%nSizeClassesSpm)
@@ -602,12 +905,10 @@ subroutine writeHeadersWaterDataOutput(me)
write(iouOutputWater, '(a)') "volume(m3),depth(m),flow(m3/s)"
end subroutine
- !> Write the headers for the sediment output file
- subroutine writeHeadersSedimentDataOutput(me)
- class(DataOutput) :: me !! This DataOutput instance
- integer :: i ! Iterator
+ subroutine writeHeadersSedimentDataOutput(this)
+ class(DataOutput) :: this
+ integer :: i, f
- ! Write metadata, if we're meant to
if (C%writeMetadataAsComment) then
write(iouOutputSediment, '(a)') "# NanoFASE model output data - SEDIMENT."
write(iouOutputSediment, '(a)') "# See summary.md for model run metadata."
@@ -615,108 +916,117 @@ subroutine writeHeadersSedimentDataOutput(me)
write(iouOutputSediment, '(a)') "#\teasts, norths: eastings and northings at the centre of this grid cell (m)"
if (C%includeWaterbodyBreakdown) write(iouOutputSediment, '(a)') "#\tw: waterbody index within this grid cell"
if (C%includeWaterbodyBreakdown) then
- write(iouOutputSediment, '(a)') "#\twaterbody_type: what type (river, estuary etc) " // &
- "of waterbody is this sediment in?"
+ write(iouOutputSediment, '(a)') "#\twaterbody_type: what type (river, estuary etc) is this sediment in?"
else
- write(iouOutputSediment, '(a)') "#\twaterbody_type: what is the dominant waterbody type in this cell?"
+ write(iouOutputSediment, '(a)') "#\twaterbody_type: dominant waterbody type in this cell"
end if
- write(iouOutputSediment, '(a)') "#\tm_np_total(kg), C_np_total(kg/m3), C_np_total(kg/kg): " &
- // "NM mass (kg) and concentration (kg/m3 and kg/kg dry weight) for all layers"
+ write(iouOutputSediment, '(a)') "#\tm_contaminant_pristine_total(kg), " // &
+ "C_contaminant_total(kg/m3), C_contaminant_total(kg/kg): " // &
+ "contaminant mass (kg) and concentration (kg/m3, kg/kg dry weight) for all layers"
+ write(iouOutputSediment, '(a)') "#\tm_contaminant_form_f(kg): contaminant mass for form f (kg)"
if (C%includeSedimentLayerBreakdown) then
- write(iouOutputSediment, '(a)') "#\tC_np_li(kg/m3), C_np_li(kg/kg): NM conc for layer i (kg/m3 and kg/kg)"
+ write(iouOutputSediment, '(a)') "#\tC_contaminant_li(kg/m3), C_contaminant_li(kg/kg): contaminant conc for layer i"
end if
- write(iouOutputSediment, '(a)') "#\tm_np_buried(kg): NM mass buried on this timestep (kg)"
+ write(iouOutputSediment, '(a)') "#\tm_contaminant_pristine_buried(kg): contaminant mass buried (kg)"
write(iouOutputSediment, '(a)') "#\tbed_area(m2): area of this bed sediment (m2)"
- write(iouOutputSediment, '(a)') "#\tsediment_mass(kg): total mass of fine sediment " // &
- "in this bed sediment (kg, *not* kg/m2)"
- write(iouOutputSediment, '(a)') "#\tsediment_density(kg): average density of the sediment (kg/m3)"
+ write(iouOutputSediment, '(a)') "#\tsediment_mass(kg): total mass of fine sediment (kg)"
+ write(iouOutputSediment, '(a)') "#\tsediment_density(kg/m3): average density of the sediment"
end if
- ! Write the actual headers
write(iouOutputSediment, '(a)', advance="no") "t,datetime,x,y,easts,norths,"
if (C%includeWaterbodyBreakdown) write(iouOutputSediment, '(a)', advance='no') "w,"
- write(iouOutputSediment, '(a)', advance='no') "waterbody_type,m_np_total(kg),C_np_total(kg/m3),C_np_total(kg/kg),"
- ! Should we include sediment layer breakdown?
+ write(iouOutputSediment, '(a)', advance='no') &
+ "waterbody_type,m_contaminant_pristine_total(kg),C_contaminant_total(kg/m3)," // &
+ "C_contaminant_total(kg/kg),"
+ write(iouOutputSediment, '(*(a))', advance='no') ("m_contaminant_form" // trim(str(f)) // "(kg),", f=1, C%contaminantDim(2))
if (C%includeSedimentLayerBreakdown) then
write(iouOutputSediment, '(*(a))', advance="no") &
- ("C_np_l" // trim(str(i)) // "(kg/m3),C_np_l" // trim(str(i)) // "(kg/kg),", i = 1, C%nSedimentLayers)
+ ("C_contaminant_l" // trim(str(i)) // "(kg/m3),C_contaminant_l" &
+ // trim(str(i)) // "(kg/kg),", i = 1, C%nSedimentLayers)
end if
- write(iouOutputSediment, '(a)') "m_np_buried(kg),bed_area(m2),sediment_mass(kg),sediment_density(kg/m3)"
+ write(iouOutputSediment, '(a)') "m_contaminant_pristine_buried(kg),bed_area(m2),sediment_mass(kg),sediment_density(kg/m3)"
end subroutine
- !> Write the headers for the soil output file
- subroutine writeHeadersSoilDataOutput(me)
- class(DataOutput) :: me !! This DataOutput instance
- integer :: i ! Iterator
+ subroutine writeHeadersSoilDataOutput(this)
+ class(DataOutput) :: this
+ integer :: i, f
if (C%writeMetadataAsComment) then
write(iouOutputSoil, '(a)') "# NanoFASE model output data - SOIL."
write(iouOutputSoil, '(a)') "# See summary.md for model run metadata."
- write(iouOutputSoil, '(a)') "# Columns:\n#\tt: timestep index\n#\tdatetime: datetime of this timestep"
+ write(iouOutputSoil, '(a)') "# Columns:"
+ write(iouOutputSoil, '(a)') "#\tt: timestep index"
+ write(iouOutputSoil, '(a)') "#\tdatetime: datetime of this timestep"
write(iouOutputSoil, '(a)') "#\tx, y: grid cell (eastings and northings) index"
write(iouOutputSoil, '(a)') "#\teasts, norths: eastings and northings at the centre of this grid cell (m)"
write(iouOutputSoil, '(a)') "#\tp: soil profile index within this cell"
write(iouOutputSoil, '(a)') "#\tland_use: dominant land use of this soil profile"
- write(iouOutputSoil, '(a)') "#\tm_np_total(kg), m_transformed_total(kg), m_dissolved_total(kg): " // &
- "NM mass (pristine, transformed and dissolved) in whole soil profile, sum of free and attached NM"
- write(iouOutputSoil, '(a)') "#\tC_np_total(" // C%soilPECUnits // "), C_transformed_total(" // C%soilPECUnits // &
- "), C_dissolved_total(" // C%soilPECUnits // "): " // &
- "NM concentration averaged over all soil layers, sum of free and attached NM"
- ! Should we include a breakdown of NM state (free vs attached)?
+ write(iouOutputSoil, '(a)') "#\tm_contaminant_pristine_total(kg), "// &
+ "m_contaminant_attached_total(kg), m_dissolved_total(kg): " // &
+ "contaminant mass (pristine, attached, dissolved) in whole soil profile"
+ write(iouOutputSoil, '(a)') "#\tC_contaminant_total(" // C%soilPECUnits // "), " // &
+ "C_contaminant_attached(" // C%soilPECUnits // &
+ "), C_dissolved_total(" // C%soilPECUnits // "): contaminant concentration"
+ write(iouOutputSoil, '(a)') "#\tm_contaminant_form_f(kg): contaminant mass for form f (kg)"
if (C%includeSoilStateBreakdown) then
- write(iouOutputSoil, '(a)') "#\tC_np_free(" // C%soilPECUnits // "), C_transformed_free(" // C%soilPECUnits // &
- "): free NM concentration averaged over all soil layers"
- write(iouOutputSoil, '(a)') "#\tC_np_att(" // C%soilPECUnits // "), C_transformed_att(" // C%soilPECUnits // &
- "): attached NM concentration averaged over all soil layers"
+ write(iouOutputSoil, '(a)') "#\tC_contaminant_pristine_free(" // C%soilPECUnits // "), " // &
+ "C_contaminant_attached(" // C%soilPECUnits // &
+ "): free and attached contaminant concentration"
end if
- ! Should we include a breakdown across the soil layers?
- if (C%includeSedimentLayerBreakdown) then
- write(iouOutputSoil, '(a)') "#\tC_np_li(" // C%soilPECUnits // "), C_transformed_li(" // C%soilPECUnits // &
- "), C_dissolved_li(" // C%soilPECUnits // "): NM concentration for layer i, sum of free and attached"
+ if (C%includeSoilLayerBreakdown) then
+ write(iouOutputSoil, '(a)') "#\tC_contaminant_li(" // C%soilPECUnits // "), " // &
+ "C_dissolved_li(" // C%soilPECUnits // &
+ "): contaminant concentration for layer i"
if (C%includeSoilStateBreakdown) then
- write(iouOutputSoil, '(a)') "#\tC_np_free_li("//C%soilPECUnits//"), C_transformed_free_li("// &
- C%soilPECUnits//"): free NM concentration for layer i"
- write(iouOutputSoil, '(a)') "#\tC_np_att_li("// C%soilPECUnits//"), C_transformed_att_li("// &
- C%soilPECUnits//"): attached NM concentration for layer i"
+ write(iouOutputSoil, '(a)') "#\tC_contaminant_pristine_free_li(" // C%soilPECUnits // "), " // &
+ "C_contaminant_attached_li(" // &
+ C%soilPECUnits // "): free and attached contaminant concentration for layer i"
end if
end if
if (C%includeSoilErosionYields) then
- write(iouOutputSoil, '(a)') "#\tm_soil_eroded(kg), m_np_eroded(kg), m_transformed_eroded(kg): " // &
- "mass of soil and NM eroded on this timestep"
+ write(iouOutputSoil, '(a)') "#\tm_soil_eroded(kg), " // &
+ "m_contaminant_pristine_eroded(kg), m_contaminant_attached_eroded(kg): " // &
+ "mass of soil and contaminant eroded"
end if
- write(iouOutputSoil, '(a)') "#\tm_np_buried(kg), m_transformed_buried(kg), m_dissolved_buried(kg): " // &
- "mass of NM buried on this timestep"
+ write(iouOutputSoil, '(a)') "#\tm_contaminant_pristine_buried(kg), " // &
+ "m_contaminant_attached_buried(kg), m_dissolved_buried(kg): " // &
+ "mass of contaminant buried"
write(iouOutputSoil, '(a)') "#\tbulk_density(kg/m3): bulk density of this soil profile"
end if
- ! Write the actual headers
write(iouOutputSoil, '(a)', advance="no") "t,datetime,x,y,easts,norths,p,land_use," // &
- "m_np_total(kg),m_transformed_total(kg),m_dissolved_total(kg)," // &
- "C_np_total(" // C%soilPECUnits // "),C_transformed_total(" // C%soilPECUnits // &
+ "m_contaminant_pristine_total(kg),m_contaminant_attached_total(kg),m_dissolved_total(kg)," // &
+ "C_contaminant_total(" // C%soilPECUnits // "),C_contaminant_attached(" // C%soilPECUnits // &
"),C_dissolved_total(" // C%soilPECUnits // "),"
- ! Should we include state breakdown - free vs attached?
+ write(iouOutputSoil, '(*(a))', advance='no') ("m_contaminant_form" // trim(str(f)) // &
+ "(" // C%soilPECUnits // "),", f=1, C%contaminantDim(2))
if (C%includeSoilStateBreakdown) then
- write(iouOutputSoil, '(a)', advance="no") "C_np_free("//C%soilPECUnits//"),C_transformed_free("// &
- C%soilPECUnits//"),C_np_att("//C%soilPECUnits//"),C_transformed_att("//C%soilPECUnits//"),"
+ write(iouOutputSoil, '(a)', advance="no") "C_contaminant_pristine_free(" // C%soilPECUnits // ")," // &
+ "C_contaminant_attached(" // &
+ C%soilPECUnits // "),"
end if
- ! Should we include soil layer breakdown?
if (C%includeSoilLayerBreakdown) then
write(iouOutputSoil, '(*(a))', advance="no") &
- ("C_np_l"//trim(str(i))//"("//C%soilPECUnits//"),C_transformed_l"//trim(str(i))//"("//C%soilPECUnits//"),"// &
- "C_dissolved_l"//trim(str(i))//"("//C%soilPECUnits//"),", i = 1, C%nSoilLayers)
+ ("C_contaminant_l" // trim(str(i)) // "(" // C%soilPECUnits // "),C_dissolved_l" // trim(str(i)) // &
+ "(" // C%soilPECUnits // "),", i = 1, C%nSoilLayers)
if (C%includeSoilStateBreakdown) then
write(iouOutputSoil, '(*(a))', advance="no") &
- ("C_np_free_l"//trim(str(i))//"("//C%soilPECUnits//"),C_transformed_free_l"//trim(str(i))// &
- "("//C%soilPECUnits//"),", i = 1, C%nSoilLayers)
- write(iouOutputSoil, '(*(a))', advance="no") &
- ("C_np_att_l"//trim(str(i))//"("//C%soilPECUnits//"),C_transformed_att_l"//trim(str(i))// &
- "("//C%soilPECUnits//"),", i = 1, C%nSoilLayers)
+ ("C_contaminant_pristine_free_l" // trim(str(i)) // "(" // C%soilPECUnits // "),C_contaminant_attached_l" // &
+ trim(str(i)) // "(" // C%soilPECUnits // "),", i = 1, C%nSoilLayers)
end if
end if
- ! Should we include eroded soil and NM?
if (C%includeSoilErosionYields) then
- write(iouOutputSoil, '(a)', advance='no') "m_soil_eroded(kg),m_np_eroded(kg),m_transformed_eroded(kg),"
+ write(iouOutputSoil, '(a)', advance='no') "m_soil_eroded(kg),m_contaminant_pristine_eroded(kg)," // &
+ "m_contaminant_attached_eroded(kg),"
+ end if
+ write(iouOutputSoil, '(a)') "m_contaminant_pristine_buried(kg),m_contaminant_attached_buried(kg)," // &
+ "m_dissolved_buried(kg),bulk_density(kg/m3)"
+ end subroutine
+
+ subroutine writeHeadersStatsDataOutput(this)
+ class(DataOutput) :: this
+ if (C%writeMetadataAsComment) then
+ write(iouOutputStats, '(a)') "# NanoFASE model output data - COMPARTMENT STATS."
+ write(iouOutputStats, '(a)') "# This file contains summary statistics for each environmental compartment."
end if
- write(iouOutputSoil, '(a)', advance='no') "m_np_buried(kg),m_transformed_buried(kg),"
- write(iouOutputSoil, '(a)') "m_dissolved_buried(kg),bulk_density(kg/m3)"
end subroutine
end module
\ No newline at end of file
diff --git a/src/Data/NetCDFAggregatedOutputModule.f90 b/src/Data/NetCDFAggregatedOutputModule.f90
index fd2c6e1..f375078 100644
--- a/src/Data/NetCDFAggregatedOutputModule.f90
+++ b/src/Data/NetCDFAggregatedOutputModule.f90
@@ -1,5 +1,5 @@
module NetCDFAggregatedOutputModule
- use GlobalsModule, only: C, dp
+ use GlobalsModule, only: C, dp, FREE_CONTAMINANT, ATTACHED_CONTAMINANT
use UtilModule
use mo_netcdf, only: NcDataset, NcVariable, NcDimension, nf90_fill_int, nf90_fill_double
use DataInputModule, only: DATASET
@@ -7,61 +7,59 @@ module NetCDFAggregatedOutputModule
use AbstractEnvironmentModule, only: EnvironmentPointer
use datetime_module
use NetCDFOutputModule
+ use ContaminantModule
+ implicit none
!> Class for outputting data to a NetCDF file, aggregated at the grid cell level
type, public, extends(NetCDFOutput) :: NetCDFAggregatedOutput
- ! The NetCDF variables are all already defined in the NetCDFOutput class, so we just
- ! need to define the model output variables with different dimensions (water and sediment)
- real(dp), allocatable :: output_agg_water__m_nm(:,:,:)
- real(dp), allocatable :: output_agg_water__m_transformed(:,:,:)
- real(dp), allocatable :: output_agg_water__m_dissolved(:,:,:)
- real(dp), allocatable :: output_agg_water__C_nm(:,:,:)
- real(dp), allocatable :: output_agg_water__C_transformed(:,:,:)
- real(dp), allocatable :: output_agg_water__C_dissolved(:,:,:)
- real(dp), allocatable :: output_agg_water__m_nm_outflow(:,:,:)
- real(dp), allocatable :: output_agg_water__m_transformed_outflow(:,:,:)
- real(dp), allocatable :: output_agg_water__m_dissolved_outflow(:,:,:)
- real(dp), allocatable :: output_agg_water__m_nm_deposited(:,:,:)
- real(dp), allocatable :: output_agg_water__m_transformed_deposited(:,:,:)
- real(dp), allocatable :: output_agg_water__m_nm_resuspended(:,:,:)
- real(dp), allocatable :: output_agg_water__m_transformed_resuspended(:,:,:)
- real(dp), allocatable :: output_agg_water__m_spm(:,:,:)
- real(dp), allocatable :: output_agg_water__C_spm(:,:,:)
- real(dp), allocatable :: output_agg_water__m_spm_erosion(:,:,:)
- real(dp), allocatable :: output_agg_water__m_spm_deposition(:,:,:)
- real(dp), allocatable :: output_agg_water__m_spm_resuspended(:,:,:)
- real(dp), allocatable :: output_agg_water__m_spm_inflow(:,:,:)
- real(dp), allocatable :: output_agg_water__m_spm_outflow(:,:,:)
- real(dp), allocatable :: output_agg_water__m_spm_bank_erosion(:,:,:)
- real(dp), allocatable :: output_agg_water__volume(:,:,:)
- real(dp), allocatable :: output_agg_water__depth(:,:,:)
- real(dp), allocatable :: output_agg_water__flow(:,:,:)
- real(dp), allocatable :: output_agg_sediment__m_nm_total(:,:,:)
- real(dp), allocatable :: output_agg_sediment__C_nm_total(:,:,:)
- real(dp), allocatable :: output_agg_sediment__C_nm_layers(:,:,:,:)
- real(dp), allocatable :: output_agg_sediment__m_nm_buried(:,:,:)
- real(dp), allocatable :: output_agg_sediment__bed_area(:,:,:)
- real(dp), allocatable :: output_agg_sediment__mass(:,:,:)
- contains
- procedure, public :: init => initNetCDFAggregatedOutput
- procedure, public :: updateWater => updateWaterNetCDFAggregatedOutput
- procedure, public :: updateSediment => updateSedimentNetCDFAggregatedOutput
- procedure, private :: initWater => initWaterNetCDFAggregatedOutput
- procedure, private :: initSediment => initSedimentNetCDFAggregatedOutput
- procedure, private :: createDimensions => createDimensionsNetCDFAggregatedOutput
- procedure, private :: allocateVariables => allocateVariablesNetCDFAggregatedOutput
- procedure, public :: newChunk => newChunkNetCDFAggregatedOutput
- procedure, public :: finaliseChunk => finaliseChunkNetCDFAggregatedOutput
+ ! The NetCDF variables are inherited from NetCDFOutput; we define model output variables
+ ! with aggregated dimensions (no waterbody dimension)
+ real(dp), allocatable :: output_agg_water__m_contaminant(:,:,:,:)
+ real(dp), allocatable :: output_agg_water__C_contaminant(:,:,:,:)
+ real(dp), allocatable :: output_agg_water__C_contaminant_free(:,:,:)
+ real(dp), allocatable :: output_agg_water__C_contaminant_attached(:,:,:)
+ real(dp), allocatable :: output_agg_water__j_contaminant_outflow(:,:,:,:)
+ real(dp), allocatable :: output_agg_water__j_contaminant_deposited(:,:,:,:)
+ real(dp), allocatable :: output_agg_water__j_contaminant_resuspended(:,:,:,:)
+ real(dp), allocatable :: output_agg_water__m_spm(:,:,:)
+ real(dp), allocatable :: output_agg_water__C_spm(:,:,:)
+ real(dp), allocatable :: output_agg_water__m_spm_erosion(:,:,:)
+ real(dp), allocatable :: output_agg_water__m_spm_deposition(:,:,:)
+ real(dp), allocatable :: output_agg_water__m_spm_resuspended(:,:,:)
+ real(dp), allocatable :: output_agg_water__m_spm_inflow(:,:,:)
+ real(dp), allocatable :: output_agg_water__m_spm_outflow(:,:,:)
+ real(dp), allocatable :: output_agg_water__m_spm_bank_erosion(:,:,:)
+ real(dp), allocatable :: output_agg_water__volume(:,:,:)
+ real(dp), allocatable :: output_agg_water__depth(:,:,:)
+ real(dp), allocatable :: output_agg_water__flow(:,:,:)
+ real(dp), allocatable :: output_agg_sediment__m_contaminant_total(:,:,:,:)
+ real(dp), allocatable :: output_agg_sediment__C_contaminant_total(:,:,:,:)
+ real(dp), allocatable :: output_agg_sediment__C_contaminant_layers(:,:,:,:,:)
+ real(dp), allocatable :: output_agg_sediment__m_contaminant_buried(:,:,:,:)
+ real(dp), allocatable :: output_agg_sediment__bed_area(:,:,:)
+ real(dp), allocatable :: output_agg_sediment__mass(:,:,:)
+ real(dp), allocatable :: output_agg_soil__land_use(:,:)
+ real(dp), allocatable :: output_agg_soil__bulk_density(:,:)
+ contains
+ procedure, public :: init => initNetCDFAggregatedOutput
+ procedure, public :: updateWater => updateWaterNetCDFAggregatedOutput
+ procedure, public :: updateSediment => updateSedimentNetCDFAggregatedOutput
+ procedure, private :: initWater => initWaterNetCDFAggregatedOutput
+ procedure, private :: initSediment => initSedimentNetCDFAggregatedOutput
+ procedure, private :: createDimensions => createDimensionsNetCDFAggregatedOutput
+ procedure, private :: allocateVariables => allocateVariablesNetCDFAggregatedOutput
+ procedure, public :: newChunk => newChunkNetCDFAggregatedOutput
+ procedure, public :: finaliseChunk => finaliseChunkNetCDFAggregatedOutput
end type
- contains
+contains
!> Initialise the NetCDF output class by creating the NetCDF file and allocating space
!! for the output variables (if we're in write-at-end mode and it's needed)
subroutine initNetCDFAggregatedOutput(me, env, k)
- class(NetCDFAggregatedOutput) :: me !! This NetCDFAggregatedOutput class
- type(Environment), target :: env !! The environment, with model run variable stored in it
- integer :: k !! Chunk index
+ class(NetCDFAggregatedOutput):: me
+ type(Environment), target :: env
+ integer :: k
! Point the Environment object to that passed in
me%env%item => env
@@ -74,296 +72,412 @@ subroutine initNetCDFAggregatedOutput(me, env, k)
if (C%netCDFWriteMode == 'end') then
call me%allocateVariables(k)
end if
-
end subroutine
!> Update either the NetCDF file or the in-memory output variables on this time step
subroutine updateWaterNetCDFAggregatedOutput(me, t, tInChunk, x, y)
- class(NetCDFAggregatedOutput) :: me !! This NetCDFAggregatedOutput class
- integer :: t !! Timestep index for whole batch
- integer :: tInChunk !! Timestep index for this chunk
- integer :: x !! Grid cell x index
- integer :: y !! Grid cell y index
-
+ class(NetCDFAggregatedOutput):: me
+ integer :: t, tInChunk, x, y
+ type(Contaminant) :: m_contaminant
+ type(Contaminant) :: j_contaminant_outflow
+ type(Contaminant) :: j_contaminant_deposited
+ type(Contaminant) :: j_contaminant_resuspended
+ real(dp) :: C_contaminant
+ real(dp) :: C_dissolved
+ real(dp) :: volume
+ type(Result0D) :: r
+ character(len=256) :: tr
+ tr = "NetCDFAggregatedOutputModule%updateWaterNetCDFAggregatedOutput"
+
associate (cell => me%env%item%colGridCells(x,y)%item)
if (cell%nReaches > 0) then
- ! If we're in 'write at end' mode, then store this timestep's output to the output arrays, indexed
- ! by the timestep in the current chunk (because we write the NetCDF file at the end of each chunk)
+ m_contaminant = cell%get_m_contaminant_water()
+ r = m_contaminant%getConcentration(cell%getWaterVolume())
+ if (r%hasCriticalError()) then
+ call r%addToTrace(tr)
+ return
+ end if
+ if (.not. allocated(r%data)) then
+ call r%addToTrace(tr)
+ call r%addError(ErrorInstance(code=901, message="Result0D data not allocated"))
+ return
+ end if
+
+ C_contaminant = r%getDataAsRealDP()
+ C_dissolved = m_contaminant%m_dissolved / cell%getWaterVolume()
+ j_contaminant_outflow = cell%get_j_contaminant_outflow()
+ j_contaminant_deposited = cell%get_j_contaminant_deposition()
+ j_contaminant_resuspended = cell%get_j_contaminant_resuspension()
+ volume = cell%getWaterVolume()
+
if (C%netCDFWriteMode == 'end') then
- me%output_agg_water__m_nm(x,y,tInChunk) = sum(cell%get_m_np_water())
- me%output_agg_water__m_transformed(x,y,tInChunk) = sum(cell%get_m_transformed_water())
- me%output_agg_water__m_dissolved(x,y,tInChunk) = cell%get_m_dissolved_water()
- me%output_agg_water__C_nm(x,y,tInChunk) = sum(cell%get_C_np_water())
- me%output_agg_water__C_transformed(x,y,tInChunk) = sum(cell%get_C_transformed_water())
- me%output_agg_water__C_dissolved(x,y,tInChunk) = cell%get_C_dissolved_water()
- me%output_agg_water__m_nm_outflow(x,y,tInChunk) = sum(cell%get_j_nm_outflow())
- me%output_agg_water__m_transformed_outflow(x,y,tInChunk) = sum(cell%get_j_transformed_outflow())
- me%output_agg_water__m_dissolved_outflow(x,y,tInChunk) = cell%get_j_dissolved_outflow()
- me%output_agg_water__m_nm_deposited(x,y,tInChunk) = sum(cell%get_j_nm_deposition())
- me%output_agg_water__m_transformed_deposited(x,y,tInChunk) = sum(cell%get_j_transformed_deposition())
- me%output_agg_water__m_nm_resuspended(x,y,tInChunk) = sum(cell%get_j_nm_resuspension())
- me%output_agg_water__m_transformed_resuspended(x,y,tInChunk) = sum(cell%get_j_transformed_resuspension())
- me%output_agg_water__m_spm(x,y,tInChunk) = sum(cell%get_m_spm())
- me%output_agg_water__C_spm(x,y,tInChunk) = sum(cell%get_C_spm())
+ ! ---- form-first (form, x, y, t) ----
+ me%output_agg_water__m_contaminant(FREE_CONTAMINANT, x, y, tInChunk) = &
+ sum(m_contaminant%c(:,:,FREE_CONTAMINANT))
+ me%output_agg_water__m_contaminant(ATTACHED_CONTAMINANT, x, y, tInChunk) = &
+ sum(m_contaminant%c(:,:,ATTACHED_CONTAMINANT))
+ me%output_agg_water__m_contaminant(C%contaminantDim(3), x, y, tInChunk) = &
+ m_contaminant%m_dissolved
+
+ ! store a value per form in the aggregated file
+ me%output_agg_water__C_contaminant(FREE_CONTAMINANT, x, y, tInChunk) = C_contaminant
+ me%output_agg_water__C_contaminant(ATTACHED_CONTAMINANT, x, y, tInChunk) = C_contaminant
+ me%output_agg_water__C_contaminant(C%contaminantDim(3), x, y, tInChunk) = C_dissolved
+
+ if (C%includeSoilStateBreakdown) then
+ me%output_agg_water__C_contaminant_free( x, y, tInChunk) = &
+ sum(m_contaminant%get_free()) / cell%getWaterVolume()
+ me%output_agg_water__C_contaminant_attached(x, y, tInChunk) = &
+ sum(m_contaminant%get_attached()) / cell%getWaterVolume()
+ end if
+
+ me%output_agg_water__j_contaminant_outflow(FREE_CONTAMINANT, x, y, tInChunk) = &
+ sum(j_contaminant_outflow%c(:,:,FREE_CONTAMINANT))
+ me%output_agg_water__j_contaminant_outflow(ATTACHED_CONTAMINANT, x, y, tInChunk) = &
+ sum(j_contaminant_outflow%c(:,:,ATTACHED_CONTAMINANT))
+ me%output_agg_water__j_contaminant_outflow(C%contaminantDim(3), x, y, tInChunk) = &
+ j_contaminant_outflow%m_dissolved
+
+ me%output_agg_water__j_contaminant_deposited(FREE_CONTAMINANT, x, y, tInChunk) = &
+ sum(j_contaminant_deposited%c(:,:,FREE_CONTAMINANT))
+ me%output_agg_water__j_contaminant_deposited(ATTACHED_CONTAMINANT, x, y, tInChunk) = &
+ sum(j_contaminant_deposited%c(:,:,ATTACHED_CONTAMINANT))
+ me%output_agg_water__j_contaminant_deposited(C%contaminantDim(3), x, y, tInChunk) = &
+ j_contaminant_deposited%m_dissolved
+
+ me%output_agg_water__j_contaminant_resuspended(FREE_CONTAMINANT, x, y, tInChunk) = &
+ sum(j_contaminant_resuspended%c(:,:,FREE_CONTAMINANT))
+ me%output_agg_water__j_contaminant_resuspended(ATTACHED_CONTAMINANT, x, y, tInChunk) = &
+ sum(j_contaminant_resuspended%c(:,:,ATTACHED_CONTAMINANT))
+ me%output_agg_water__j_contaminant_resuspended(C%contaminantDim(3), x, y, tInChunk) = &
+ j_contaminant_resuspended%m_dissolved
+
+ me%output_agg_water__m_spm( x, y, tInChunk) = sum(cell%get_m_spm())
+ me%output_agg_water__C_spm( x, y, tInChunk) = sum(cell%get_C_spm())
+
if (C%includeSedimentFluxes) then
- me%output_agg_water__m_spm_erosion(x,y,tInChunk) = sum(cell%get_j_spm_soilErosion())
- me%output_agg_water__m_spm_deposition(x,y,tInChunk) = sum(cell%get_j_spm_deposition())
- me%output_agg_water__m_spm_resuspended(x,y,tInChunk) = sum(cell%get_j_spm_resuspension())
- me%output_agg_water__m_spm_inflow(x,y,tInChunk) = sum(cell%get_j_spm_inflow())
- me%output_agg_water__m_spm_outflow(x,y,tInChunk) = sum(cell%get_j_spm_outflow())
- me%output_agg_water__m_spm_bank_erosion(x,y,tInChunk) = sum(cell%get_j_spm_bankErosion())
+ me%output_agg_water__m_spm_erosion( x, y, tInChunk) = sum(cell%get_j_spm_soilErosion())
+ me%output_agg_water__m_spm_deposition( x, y, tInChunk) = sum(cell%get_j_spm_deposition())
+ me%output_agg_water__m_spm_resuspended(x, y, tInChunk) = sum(cell%get_j_spm_resuspension())
+ me%output_agg_water__m_spm_inflow( x, y, tInChunk) = sum(cell%get_j_spm_inflow())
+ me%output_agg_water__m_spm_outflow( x, y, tInChunk) = sum(cell%get_j_spm_outflow())
+ me%output_agg_water__m_spm_bank_erosion(x, y, tInChunk) = sum(cell%get_j_spm_bankErosion())
end if
- me%output_agg_water__volume(x,y,tInChunk) = cell%getWaterVolume()
- me%output_agg_water__depth(x,y,tInChunk) = cell%getWaterDepth()
- me%output_agg_water__flow(x,y,tInChunk) = cell%get_Q_outflow() / C%timeStep
- ! If we're in iterative write mode, then write straight to the NetCDF file, which is time-indexed
- ! by the whole batch, not just this chunk
+
+ me%output_agg_water__volume(x, y, tInChunk) = volume
+ me%output_agg_water__depth( x, y, tInChunk) = cell%getWaterDepth()
+ me%output_agg_water__flow( x, y, tInChunk) = cell%get_Q_outflow() / C%timeStep
+
else if (C%netCDFWriteMode == 'itr') then
- call me%nc__water__m_nm%setData(sum(cell%get_m_np_water()), start=[x,y,t])
- call me%nc__water__m_transformed%setData(sum(cell%get_m_transformed_water()), start=[x,y,t])
- call me%nc__water__m_dissolved%setData(cell%get_m_dissolved_water(), start=[x,y,t])
- call me%nc__water__C_nm%setData(sum(cell%get_C_np_water()), start=[x,y,t])
- call me%nc__water__C_transformed%setData(sum(cell%get_C_transformed_water()), start=[x,y,t])
- call me%nc__water__C_dissolved%setData(cell%get_C_dissolved_water(), start=[x,y,t])
- call me%nc__water__m_nm_outflow%setData(sum(cell%get_j_nm_outflow()), start=[x,y,t])
- call me%nc__water__m_transformed_outflow%setData(sum(cell%get_j_transformed_outflow()), start=[x,y,t])
- call me%nc__water__m_dissolved_outflow%setData(cell%get_j_dissolved_outflow(), start=[x,y,t])
- call me%nc__water__m_nm_deposited%setData(sum(cell%get_j_nm_deposition()), start=[x,y,t])
- call me%nc__water__m_transformed_deposited%setData(sum(cell%get_j_transformed_deposition()), start=[x,y,t])
- call me%nc__water__m_nm_resuspended%setData(sum(cell%get_j_nm_resuspension()), start=[x,y,t])
- call me%nc__water__m_transformed_resuspended%setData(sum(cell%get_j_transformed_resuspension()), &
- start=[x,y,t])
- call me%nc__water__m_spm%setData(sum(cell%get_m_spm()), start=[x,y,t])
- call me%nc__water__C_spm%setData(sum(cell%get_C_spm()), start=[x,y,t])
+ call me%nc__water__m_contaminant%setData([ &
+ sum(m_contaminant%c(:,:,FREE_CONTAMINANT)), &
+ sum(m_contaminant%c(:,:,ATTACHED_CONTAMINANT)), &
+ m_contaminant%m_dissolved ], start=[1, x, y, t])
+
+ call me%nc__water__C_contaminant%setData([ &
+ C_contaminant, &
+ C_contaminant, &
+ C_dissolved ], start=[1, x, y, t])
+
+ if (C%includeSoilStateBreakdown) then
+ call me%nc__water__C_contaminant_free%setData( &
+ sum(m_contaminant%get_free()) / cell%getWaterVolume(), start=[x, y, t])
+ call me%nc__water__C_contaminant_attached%setData( &
+ sum(m_contaminant%get_attached()) / cell%getWaterVolume(), start=[x, y, t])
+ end if
+
+ call me%nc__water__j_contaminant_outflow%setData([ &
+ sum(j_contaminant_outflow%c(:,:,FREE_CONTAMINANT)), &
+ sum(j_contaminant_outflow%c(:,:,ATTACHED_CONTAMINANT)), &
+ j_contaminant_outflow%m_dissolved ], start=[1, x, y, t])
+
+ call me%nc__water__j_contaminant_deposited%setData([ &
+ sum(j_contaminant_deposited%c(:,:,FREE_CONTAMINANT)), &
+ sum(j_contaminant_deposited%c(:,:,ATTACHED_CONTAMINANT)), &
+ j_contaminant_deposited%m_dissolved ], start=[1, x, y, t])
+
+ call me%nc__water__j_contaminant_resuspended%setData([ &
+ sum(j_contaminant_resuspended%c(:,:,FREE_CONTAMINANT)), &
+ sum(j_contaminant_resuspended%c(:,:,ATTACHED_CONTAMINANT)), &
+ j_contaminant_resuspended%m_dissolved ], start=[1, x, y, t])
+
+ call me%nc__water__m_spm%setData(sum(cell%get_m_spm()), start=[x, y, t])
+ call me%nc__water__C_spm%setData(sum(cell%get_C_spm()), start=[x, y, t])
+
if (C%includeSedimentFluxes) then
- call me%nc__water__m_spm_erosion%setData(sum(cell%get_j_spm_soilErosion()), start=[x,y,t])
- call me%nc__water__m_spm_deposited%setData(sum(cell%get_j_spm_deposition()), start=[x,y,t])
- call me%nc__water__m_spm_resuspended%setData(sum(cell%get_j_spm_resuspension()), start=[x,y,t])
- call me%nc__water__m_spm_inflow%setData(sum(cell%get_j_spm_inflow()), start=[x,y,t])
- call me%nc__water__m_spm_outflow%setData(sum(cell%get_j_spm_outflow()), start=[x,y,t])
- call me%nc__water__m_spm_bank_erosion%setData(sum(cell%get_j_spm_bankErosion()), start=[x,y,t])
- end if
- call me%nc__water__volume%setData(cell%getWaterVolume(), start=[x,y,t])
- call me%nc__water__depth%setData(cell%getWaterDepth(), start=[x,y,t])
- call me%nc__water__flow%setData(cell%get_Q_outflow() / C%timeStep, start=[x,y,t])
+ call me%nc__water__m_spm_erosion%setData( sum(cell%get_j_spm_soilErosion()), start=[x, y, t])
+ call me%nc__water__m_spm_deposited%setData( sum(cell%get_j_spm_deposition()), start=[x, y, t])
+ call me%nc__water__m_spm_resuspended%setData(sum(cell%get_j_spm_resuspension()), start=[x, y, t])
+ call me%nc__water__m_spm_inflow%setData( sum(cell%get_j_spm_inflow()), start=[x, y, t])
+ call me%nc__water__m_spm_outflow%setData( sum(cell%get_j_spm_outflow()), start=[x, y, t])
+ call me%nc__water__m_spm_bank_erosion%setData(sum(cell%get_j_spm_bankErosion()), start=[x, y, t])
+ end if
+
+ call me%nc__water__volume%setData(volume, start=[x, y, t])
+ call me%nc__water__depth%setData(cell%getWaterDepth(), start=[x, y, t])
+ call me%nc__water__flow%setData(cell%get_Q_outflow() / C%timeStep, start=[x, y, t])
end if
end if
end associate
-
end subroutine
!> Update either the NetCDF file or write to the in-memory variables for this timestep
subroutine updateSedimentNetCDFAggregatedOutput(me, t, tInChunk, x, y)
- class(NetCDFAggregatedOutput) :: me !! This NetCDFAggregatedOutput instance
- integer :: t !! Current timestep in batch
- integer :: tInChunk !! Current timestep in chunk
- integer :: x, y !! Grid cell indices
- integer :: l ! Sediment layer index
+ class(NetCDFAggregatedOutput) :: me
+ integer :: t, tInChunk, x, y, l
+ real(dp), dimension(C%nSedimentLayers) :: C_cont_layers
+ type(Contaminant) :: cont, cont_buried, layer_cont
+ type(Result0D) :: r0
+ character(len=256) :: tr
+ tr = "NetCDFAggregatedOutputModule%updateSedimentNetCDFAggregatedOutput"
associate(cell => me%env%item%colGridCells(x,y)%item)
- ! If we're in 'write at end' mode, then store this timestep's output to the output arrays, indexed
- ! by the timestep in the current chunk (because we write the NetCDF file at the end of each chunk)
if (cell%nReaches > 0) then
+ ! Total sediment-phase contaminant mass
+ cont = cell%get_m_contaminant_sediment()
+ ! Buried contaminant mass
+ cont_buried = cell%get_m_contaminant_buried_sediment()
+ ! Concentration in each sediment layer (total)
+ do l = 1, C%nSedimentLayers
+ layer_cont = cell%get_C_contaminant_sediment_l_byVolume(l)
+ r0 = layer_cont%getConcentration(1.0_dp) ! Volume already built into getter
+ if (r0%hasCriticalError()) then
+ call r0%addToTrace(tr)
+ call LOGR%toFile(errors=r0%errors)
+ return
+ end if
+ if (.not. allocated(r0%data)) then
+ call r0%addToTrace(tr)
+ call r0%addError(ErrorInstance(code=901, message="Result0D data not allocated"))
+ call LOGR%toFile(errors=r0%errors)
+ return
+ end if
+ C_cont_layers(l) = r0%getDataAsRealDP()
+ end do
+
if (C%netCDFWriteMode == 'end') then
- me%output_agg_sediment__m_nm_total(x,y,tInChunk) = sum(cell%get_m_np_sediment())
- me%output_agg_sediment__C_nm_total(x,y,tInChunk) = sum(cell%get_C_np_sediment())
- do l = 1, C%nSedimentLayers
- me%output_agg_sediment__C_nm_layers(l,x,y,tInChunk) = sum(cell%get_C_np_sediment_l(l))
- end do
- me%output_agg_sediment__m_nm_buried(x,y,tInChunk) = sum(cell%get_m_np_buried_sediment())
- me%output_agg_sediment__bed_area(x,y,tInChunk) = cell%getBedSedimentArea()
- me%output_agg_sediment__mass(x,y,tInChunk) = cell%getBedSedimentMass()
- ! If we're in iterative write mode, then write straight to the NetCDF file, which is time-indexed
- ! by the whole batch, not just this chunk
+ ! ---- form-first (form, x, y, t) ----
+ me%output_agg_sediment__m_contaminant_total(FREE_CONTAMINANT, x, y, tInChunk) = &
+ sum(cont%c(:,:,FREE_CONTAMINANT))
+ me%output_agg_sediment__m_contaminant_total(ATTACHED_CONTAMINANT, x, y, tInChunk) = &
+ sum(cont%c(:,:,ATTACHED_CONTAMINANT))
+ me%output_agg_sediment__m_contaminant_total(C%contaminantDim(3), x, y, tInChunk) = &
+ cont%m_dissolved
+
+ me%output_agg_sediment__m_contaminant_buried(FREE_CONTAMINANT, x, y, tInChunk) = &
+ sum(cont_buried%c(:,:,FREE_CONTAMINANT))
+ me%output_agg_sediment__m_contaminant_buried(ATTACHED_CONTAMINANT, x, y, tInChunk) = &
+ sum(cont_buried%c(:,:,ATTACHED_CONTAMINANT))
+ me%output_agg_sediment__m_contaminant_buried(C%contaminantDim(3), x, y, tInChunk) = &
+ cont_buried%m_dissolved
+
+ me%output_agg_sediment__C_contaminant_total(FREE_CONTAMINANT, x, y, tInChunk) = &
+ sum(cont%c(:,:,FREE_CONTAMINANT)) / cell%getBedSedimentMass()
+ me%output_agg_sediment__C_contaminant_total(ATTACHED_CONTAMINANT, x, y, tInChunk) = &
+ sum(cont%c(:,:,ATTACHED_CONTAMINANT)) / cell%getBedSedimentMass()
+ me%output_agg_sediment__C_contaminant_total(C%contaminantDim(3), x, y, tInChunk) = &
+ cont%m_dissolved / cell%getBedSedimentMass()
+
+ ! layers-first (layer, form, x, y, t); store total into FREE slot
+ me%output_agg_sediment__C_contaminant_layers(1:C%nSedimentLayers, FREE_CONTAMINANT, &
+ x, y, tInChunk) = C_cont_layers
+
+ me%output_agg_sediment__bed_area(x, y, tInChunk) = cell%getBedSedimentArea()
+ me%output_agg_sediment__mass( x, y, tInChunk) = cell%getBedSedimentMass()
+
else if (C%netCDFWriteMode == 'itr') then
- call me%nc__sediment__m_nm_total%setData(sum(cell%get_m_np_sediment()), start=[x,y,t])
- call me%nc__sediment__C_nm_total%setData(sum(cell%get_C_np_sediment()), start=[x,y,t])
- do l = 1, C%nSedimentLayers
- call me%nc__sediment__C_nm_layers%setData(sum(cell%get_C_np_sediment_l(l)), start=[l,x,y,t])
- end do
- call me%nc__sediment__m_nm_buried%setData(sum(cell%get_m_np_buried_sediment()), start=[x,y,t])
- call me%nc__sediment__bed_area%setData(cell%getBedSedimentArea(), start=[x,y,t])
- call me%nc__sediment__mass%setData(cell%getBedSedimentMass(), start=[x,y,t])
+ call me%nc__sediment__m_contaminant_total%setData([ &
+ sum(cont%c(:,:,FREE_CONTAMINANT)), &
+ sum(cont%c(:,:,ATTACHED_CONTAMINANT)), &
+ cont%m_dissolved ], start=[1, x, y, t])
+
+ call me%nc__sediment__m_contaminant_buried%setData([ &
+ sum(cont_buried%c(:,:,FREE_CONTAMINANT)), &
+ sum(cont_buried%c(:,:,ATTACHED_CONTAMINANT)), &
+ cont_buried%m_dissolved ], start=[1, x, y, t])
+
+ call me%nc__sediment__C_contaminant_total%setData([ &
+ sum(cont%c(:,:,FREE_CONTAMINANT)) / cell%getBedSedimentMass(), &
+ sum(cont%c(:,:,ATTACHED_CONTAMINANT)) / cell%getBedSedimentMass(), &
+ cont%m_dissolved / cell%getBedSedimentMass() ], start=[1, x, y, t])
+
+ ! write layers into FREE slot (form=1)
+ call me%nc__sediment__C_contaminant_layers%setData( &
+ C_cont_layers, start=[1, FREE_CONTAMINANT, x, y, t])
+
+ call me%nc__sediment__bed_area%setData(cell%getBedSedimentArea(), start=[x, y, t])
+ call me%nc__sediment__mass%setData( cell%getBedSedimentMass(), start=[x, y, t])
end if
end if
end associate
end subroutine
- !> Create the variables for water
+ !> Create the variables for water (aggregated: [cont_form, x, y, t])
subroutine initWaterNetCDFAggregatedOutput(me)
- class(NetCDFAggregatedOutput) :: me !! This NetCDFAggregatedOutput class
+ class(NetCDFAggregatedOutput) :: me
+
+ ! Mass by contaminant form (free, attached, dissolved)
+ me%nc__water__m_contaminant = me%nc%setVariable('water__m_contaminant', 'f64', &
+ [me%contaminant_form_dim, me%x_dim, me%y_dim, me%t_dim])
+ call me%nc__water__m_contaminant%setAttribute('units', 'kg')
+ call me%nc__water__m_contaminant%setAttribute('long_name', &
+ 'Mass of contaminant in surface water (free, attached, dissolved)')
+ call me%nc__water__m_contaminant%setAttribute('grid_mapping', 'spatial_ref')
+ call me%nc__water__m_contaminant%setAttribute('_FillValue', nf90_fill_double)
+
+ ! Concentrations by form (total and – optionally – split)
+ me%nc__water__C_contaminant = me%nc%setVariable('water__C_contaminant', 'f64', &
+ [me%contaminant_form_dim, me%x_dim, me%y_dim, me%t_dim])
+ call me%nc__water__C_contaminant%setAttribute('units', 'kg/m3')
+ call me%nc__water__C_contaminant%setAttribute('long_name', &
+ 'Total concentration of contaminant in surface water')
+ call me%nc__water__C_contaminant%setAttribute('grid_mapping', 'spatial_ref')
+ call me%nc__water__C_contaminant%setAttribute('_FillValue', nf90_fill_double)
+
+ if (C%includeSoilStateBreakdown) then
+ me%nc__water__C_contaminant_free = me%nc%setVariable('water__C_contaminant_free', 'f64', &
+ [me%x_dim, me%y_dim, me%t_dim])
+ call me%nc__water__C_contaminant_free%setAttribute('units', 'kg/m3')
+ call me%nc__water__C_contaminant_free%setAttribute('long_name', &
+ 'Concentration of free contaminant in surface water')
+ call me%nc__water__C_contaminant_free%setAttribute('grid_mapping', 'spatial_ref')
+ call me%nc__water__C_contaminant_free%setAttribute('_FillValue', nf90_fill_double)
+
+ me%nc__water__C_contaminant_attached = me%nc%setVariable('water__C_contaminant_attached', 'f64', &
+ [me%x_dim, me%y_dim, me%t_dim])
+ call me%nc__water__C_contaminant_attached%setAttribute('units', 'kg/m3')
+ call me%nc__water__C_contaminant_attached%setAttribute('long_name', &
+ 'Concentration of attached contaminant in surface water')
+ call me%nc__water__C_contaminant_attached%setAttribute('grid_mapping', 'spatial_ref')
+ call me%nc__water__C_contaminant_attached%setAttribute('_FillValue', nf90_fill_double)
+ end if
+
+ ! Contaminant fluxes by form
+ me%nc__water__j_contaminant_outflow = me%nc%setVariable('water__j_contaminant_outflow', 'f64', &
+ [me%contaminant_form_dim, me%x_dim, me%y_dim, me%t_dim])
+ call me%nc__water__j_contaminant_outflow%setAttribute('units', 'kg')
+ call me%nc__water__j_contaminant_outflow%setAttribute('long_name', 'Mass of contaminant outflowing downstream')
+ call me%nc__water__j_contaminant_outflow%setAttribute('grid_mapping', 'spatial_ref')
+ call me%nc__water__j_contaminant_outflow%setAttribute('_FillValue', nf90_fill_double)
+
+ me%nc__water__j_contaminant_deposited = me%nc%setVariable('water__j_contaminant_deposited', 'f64', &
+ [me%contaminant_form_dim, me%x_dim, me%y_dim, me%t_dim])
+ call me%nc__water__j_contaminant_deposited%setAttribute('units', 'kg')
+ call me%nc__water__j_contaminant_deposited%setAttribute('long_name', 'Mass of contaminant deposited to bed sediment')
+ call me%nc__water__j_contaminant_deposited%setAttribute('grid_mapping', 'spatial_ref')
+ call me%nc__water__j_contaminant_deposited%setAttribute('_FillValue', nf90_fill_double)
- ! SPM mass and concentration
- me%nc__water__m_spm = me%nc%setVariable('water__m_spm','f64', [me%x_dim, me%y_dim, me%t_dim])
+ me%nc__water__j_contaminant_resuspended = me%nc%setVariable('water__j_contaminant_resuspended', 'f64', &
+ [me%contaminant_form_dim, me%x_dim, me%y_dim, me%t_dim])
+ call me%nc__water__j_contaminant_resuspended%setAttribute('units', 'kg')
+ call me%nc__water__j_contaminant_resuspended%setAttribute('long_name', 'Mass of contaminant resuspended from bed sediment')
+ call me%nc__water__j_contaminant_resuspended%setAttribute('grid_mapping', 'spatial_ref')
+ call me%nc__water__j_contaminant_resuspended%setAttribute('_FillValue', nf90_fill_double)
+
+ ! SPM state
+ me%nc__water__m_spm = me%nc%setVariable('water__m_spm', 'f64', [me%x_dim, me%y_dim, me%t_dim])
call me%nc__water__m_spm%setAttribute('units', 'kg')
call me%nc__water__m_spm%setAttribute('long_name', 'Mass of suspended particulate matter in surface water')
call me%nc__water__m_spm%setAttribute('grid_mapping', 'spatial_ref')
call me%nc__water__m_spm%setAttribute('_FillValue', nf90_fill_double)
- me%nc__water__C_spm = me%nc%setVariable('water__C_spm','f64', [me%x_dim, me%y_dim, me%t_dim])
+
+ me%nc__water__C_spm = me%nc%setVariable('water__C_spm', 'f64', [me%x_dim, me%y_dim, me%t_dim])
call me%nc__water__C_spm%setAttribute('units', 'kg/m3')
call me%nc__water__C_spm%setAttribute('long_name', 'Concentration of suspended particulate matter in surface water')
call me%nc__water__C_spm%setAttribute('grid_mapping', 'spatial_ref')
call me%nc__water__C_spm%setAttribute('_FillValue', nf90_fill_double)
- ! NM mass
- me%nc__water__m_nm = me%nc%setVariable('water__m_nm','f64', [me%x_dim, me%y_dim, me%t_dim])
- call me%nc__water__m_nm%setAttribute('units', 'kg')
- call me%nc__water__m_nm%setAttribute('long_name', 'Mass of pristine NM in surface water')
- call me%nc__water__m_nm%setAttribute('grid_mapping', 'spatial_ref')
- call me%nc__water__m_nm%setAttribute('_FillValue', nf90_fill_double)
- me%nc__water__m_transformed = me%nc%setVariable('water__m_transformed','f64', [me%x_dim, me%y_dim, me%t_dim])
- call me%nc__water__m_transformed%setAttribute('units', 'kg')
- call me%nc__water__m_transformed%setAttribute('long_name', 'Mass of transformed NM in surface water')
- call me%nc__water__m_transformed%setAttribute('grid_mapping', 'spatial_ref')
- call me%nc__water__m_transformed%setAttribute('_FillValue', nf90_fill_double)
- me%nc__water__m_dissolved = me%nc%setVariable('water__m_dissolved','f64', [me%x_dim, me%y_dim, me%t_dim])
- call me%nc__water__m_dissolved%setAttribute('units', 'kg')
- call me%nc__water__m_dissolved%setAttribute('long_name', 'Mass of dissolved species in surface water')
- call me%nc__water__m_dissolved%setAttribute('grid_mapping', 'spatial_ref')
- call me%nc__water__m_dissolved%setAttribute('_FillValue', nf90_fill_double)
- ! NM concentration
- me%nc__water__C_nm = me%nc%setVariable('water__C_nm','f64', [me%x_dim, me%y_dim, me%t_dim])
- call me%nc__water__C_nm%setAttribute('units', 'kg/m3')
- call me%nc__water__C_nm%setAttribute('long_name', 'Concentration of pristine NM in surface water')
- call me%nc__water__C_nm%setAttribute('grid_mapping', 'spatial_ref')
- call me%nc__water__C_nm%setAttribute('_FillValue', nf90_fill_double)
- me%nc__water__C_transformed = me%nc%setVariable('water__C_transformed','f64', [me%x_dim, me%y_dim, me%t_dim])
- call me%nc__water__C_transformed%setAttribute('units', 'kg/m3')
- call me%nc__water__C_transformed%setAttribute('long_name', 'Concentration of transformed NM in surface water')
- call me%nc__water__C_transformed%setAttribute('grid_mapping', 'spatial_ref')
- call me%nc__water__C_transformed%setAttribute('_FillValue', nf90_fill_double)
- me%nc__water__C_dissolved = me%nc%setVariable('water__C_dissolved','f64', [me%x_dim, me%y_dim, me%t_dim])
- call me%nc__water__C_dissolved%setAttribute('units', 'kg/m3')
- call me%nc__water__C_dissolved%setAttribute('long_name', 'Concentration of dissolved species in surface water')
- call me%nc__water__C_dissolved%setAttribute('grid_mapping', 'spatial_ref')
- call me%nc__water__C_dissolved%setAttribute('_FillValue', nf90_fill_double)
- ! NM flows
- me%nc__water__m_nm_outflow = me%nc%setVariable('water__m_nm_outflow','f64', [me%x_dim, me%y_dim, me%t_dim])
- call me%nc__water__m_nm_outflow%setAttribute('units', 'kg')
- call me%nc__water__m_nm_outflow%setAttribute('long_name', 'Mass of pristine NM outflowing downstream')
- call me%nc__water__m_nm_outflow%setAttribute('grid_mapping', 'spatial_ref')
- call me%nc__water__m_nm_outflow%setAttribute('_FillValue', nf90_fill_double)
- me%nc__water__m_transformed_outflow = me%nc%setVariable('water__m_transformed_outflow','f64', &
- [me%x_dim, me%y_dim, me%t_dim])
- call me%nc__water__m_transformed_outflow%setAttribute('units', 'kg')
- call me%nc__water__m_transformed_outflow%setAttribute('long_name', 'Mass of transformed NM outflowing downstream')
- call me%nc__water__m_transformed_outflow%setAttribute('grid_mapping', 'spatial_ref')
- call me%nc__water__m_transformed_outflow%setAttribute('_FillValue', nf90_fill_double)
- me%nc__water__m_dissolved_outflow = me%nc%setVariable('water__m_dissolved_outflow','f64', &
- [me%x_dim, me%y_dim, me%t_dim])
- call me%nc__water__m_dissolved_outflow%setAttribute('units', 'kg')
- call me%nc__water__m_dissolved_outflow%setAttribute('long_name', 'Mass of dissolved species outflowing downstream')
- call me%nc__water__m_dissolved_outflow%setAttribute('grid_mapping', 'spatial_ref')
- call me%nc__water__m_dissolved_outflow%setAttribute('_FillValue', nf90_fill_double)
- me%nc__water__m_nm_deposited = me%nc%setVariable('water__m_nm_deposited','f64', [me%x_dim, me%y_dim, me%t_dim])
- call me%nc__water__m_nm_deposited%setAttribute('units', 'kg')
- call me%nc__water__m_nm_deposited%setAttribute('long_name', 'Mass of NM deposited to bed sediment')
- call me%nc__water__m_nm_deposited%setAttribute('grid_mapping', 'spatial_ref')
- call me%nc__water__m_nm_deposited%setAttribute('_FillValue', nf90_fill_double)
- me%nc__water__m_transformed_deposited = me%nc%setVariable('water__m_transformed_deposited', &
- 'f64', [me%x_dim, me%y_dim, me%t_dim])
- call me%nc__water__m_transformed_deposited%setAttribute('long_name', 'Mass of transformed NM deposited to bed sediment')
- call me%nc__water__m_transformed_deposited%setAttribute('units', 'kg')
- call me%nc__water__m_transformed_deposited%setAttribute('grid_mapping', 'spatial_ref')
- call me%nc__water__m_transformed_deposited%setAttribute('_FillValue', nf90_fill_double)
- me%nc__water__m_nm_resuspended = me%nc%setVariable('water__m_nm_resuspended','f64', &
- [me%x_dim, me%y_dim, me%t_dim])
- call me%nc__water__m_nm_resuspended%setAttribute('units', 'kg')
- call me%nc__water__m_nm_resuspended%setAttribute('long_name', 'Mass of pristine NM resuspended from bed sediment')
- call me%nc__water__m_nm_resuspended%setAttribute('grid_mapping', 'spatial_ref')
- call me%nc__water__m_nm_resuspended%setAttribute('_FillValue', nf90_fill_double)
- me%nc__water__m_transformed_resuspended = me%nc%setVariable('water__m_transformed_resuspended', &
- 'f64', [me%x_dim, me%y_dim, me%t_dim])
- call me%nc__water__m_transformed_resuspended%setAttribute('units', 'kg')
- call me%nc__water__m_transformed_resuspended%setAttribute('long_name', &
- 'Mass of transformed NM resuspended from bed sediment')
- call me%nc__water__m_transformed_resuspended%setAttribute('grid_mapping', 'spatial_ref')
- call me%nc__water__m_transformed_resuspended%setAttribute('_FillValue', nf90_fill_double)
- ! SPM flows
+
+ ! Optional SPM fluxes (use names that exist on NetCDFOutput: *_deposited*)
if (C%includeSedimentFluxes) then
- me%nc__water__m_spm_erosion = me%nc%setVariable('water__m_spm_erosion','f64', [me%x_dim, me%y_dim, me%t_dim])
+ me%nc__water__m_spm_erosion = me%nc%setVariable('water__m_spm_erosion', 'f64', [me%x_dim, me%y_dim, me%t_dim])
call me%nc__water__m_spm_erosion%setAttribute('units', 'kg')
- call me%nc__water__m_spm_erosion%setAttribute('long_name', 'Mass of suspended particulate matter from soil erosion')
+ call me%nc__water__m_spm_erosion%setAttribute('long_name', 'Mass of SPM eroded from soil')
call me%nc__water__m_spm_erosion%setAttribute('grid_mapping', 'spatial_ref')
call me%nc__water__m_spm_erosion%setAttribute('_FillValue', nf90_fill_double)
- me%nc__water__m_spm_deposited = me%nc%setVariable('water__m_spm_deposited','f64', &
- [me%x_dim, me%y_dim, me%t_dim])
+
+ me%nc__water__m_spm_deposited = me%nc%setVariable('water__m_spm_deposited', 'f64', [me%x_dim, me%y_dim, me%t_dim])
call me%nc__water__m_spm_deposited%setAttribute('units', 'kg')
- call me%nc__water__m_spm_deposited%setAttribute('long_name', &
- 'Mass of suspended particulate matter deposited to bed sediment')
+ call me%nc__water__m_spm_deposited%setAttribute('long_name', 'Mass of SPM deposited to bed sediment')
call me%nc__water__m_spm_deposited%setAttribute('grid_mapping', 'spatial_ref')
call me%nc__water__m_spm_deposited%setAttribute('_FillValue', nf90_fill_double)
- me%nc__water__m_spm_resuspended = me%nc%setVariable('water__m_spm_resuspended','f64', &
- [me%x_dim, me%y_dim, me%t_dim])
+
+ me%nc__water__m_spm_resuspended = me%nc%setVariable('water__m_spm_resuspended', 'f64', [me%x_dim, me%y_dim, me%t_dim])
call me%nc__water__m_spm_resuspended%setAttribute('units', 'kg')
- call me%nc__water__m_spm_resuspended%setAttribute('long_name', &
- 'Mass of suspended particulate matter resuspended from bed sediment')
+ call me%nc__water__m_spm_resuspended%setAttribute('long_name', 'Mass of SPM resuspended from bed sediment')
call me%nc__water__m_spm_resuspended%setAttribute('grid_mapping', 'spatial_ref')
call me%nc__water__m_spm_resuspended%setAttribute('_FillValue', nf90_fill_double)
- me%nc__water__m_spm_inflow = me%nc%setVariable('water__m_spm_inflow','f64', [me%x_dim, me%y_dim, me%t_dim])
+
+ me%nc__water__m_spm_inflow = me%nc%setVariable('water__m_spm_inflow', 'f64', [me%x_dim, me%y_dim, me%t_dim])
call me%nc__water__m_spm_inflow%setAttribute('units', 'kg')
- call me%nc__water__m_spm_inflow%setAttribute('long_name', &
- 'Mass of suspended particulate matter inflowing from upstream')
+ call me%nc__water__m_spm_inflow%setAttribute('long_name', 'Mass of SPM inflowing from upstream')
call me%nc__water__m_spm_inflow%setAttribute('grid_mapping', 'spatial_ref')
call me%nc__water__m_spm_inflow%setAttribute('_FillValue', nf90_fill_double)
- me%nc__water__m_spm_outflow = me%nc%setVariable('water__m_spm_outflow','f64', [me%x_dim, me%y_dim, me%t_dim])
+
+ me%nc__water__m_spm_outflow = me%nc%setVariable('water__m_spm_outflow', 'f64', [me%x_dim, me%y_dim, me%t_dim])
call me%nc__water__m_spm_outflow%setAttribute('units', 'kg')
- call me%nc__water__m_spm_outflow%setAttribute('long_name', &
- 'Mass of suspended particulate matter outflowing downstream')
+ call me%nc__water__m_spm_outflow%setAttribute('long_name', 'Mass of SPM outflowing downstream')
call me%nc__water__m_spm_outflow%setAttribute('grid_mapping', 'spatial_ref')
call me%nc__water__m_spm_outflow%setAttribute('_FillValue', nf90_fill_double)
- me%nc__water__m_spm_bank_erosion = me%nc%setVariable('water__m_spm_bank_erosion','f64', &
- [me%x_dim, me%y_dim, me%t_dim])
+
+ me%nc__water__m_spm_bank_erosion = me%nc%setVariable('water__m_spm_bank_erosion', 'f64', [me%x_dim, me%y_dim, me%t_dim])
call me%nc__water__m_spm_bank_erosion%setAttribute('units', 'kg')
- call me%nc__water__m_spm_bank_erosion%setAttribute('long_name', &
- 'Mass of suspended particulate matter from bank erosion')
+ call me%nc__water__m_spm_bank_erosion%setAttribute('long_name', 'Mass of SPM eroded from river banks')
call me%nc__water__m_spm_bank_erosion%setAttribute('grid_mapping', 'spatial_ref')
call me%nc__water__m_spm_bank_erosion%setAttribute('_FillValue', nf90_fill_double)
end if
- ! Water
- me%nc__water__volume = me%nc%setVariable('water__volume','f64', [me%x_dim, me%y_dim, me%t_dim])
+
+ ! Water volume/depth/flow
+ me%nc__water__volume = me%nc%setVariable('water__volume', 'f64', [me%x_dim, me%y_dim, me%t_dim])
call me%nc__water__volume%setAttribute('units', 'm3')
call me%nc__water__volume%setAttribute('long_name', 'Volume of water')
call me%nc__water__volume%setAttribute('grid_mapping', 'spatial_ref')
call me%nc__water__volume%setAttribute('_FillValue', nf90_fill_double)
- me%nc__water__depth = me%nc%setVariable('water__depth','f64', [me%x_dim, me%y_dim, me%t_dim])
+
+ me%nc__water__depth = me%nc%setVariable('water__depth', 'f64', [me%x_dim, me%y_dim, me%t_dim])
call me%nc__water__depth%setAttribute('units', 'm')
call me%nc__water__depth%setAttribute('standard_name', 'depth')
call me%nc__water__depth%setAttribute('long_name', 'Depth of water')
call me%nc__water__depth%setAttribute('grid_mapping', 'spatial_ref')
call me%nc__water__depth%setAttribute('_FillValue', nf90_fill_double)
- me%nc__water__flow = me%nc%setVariable('water__flow','f64', [me%x_dim, me%y_dim, me%t_dim])
+
+ me%nc__water__flow = me%nc%setVariable('water__flow', 'f64', [me%x_dim, me%y_dim, me%t_dim])
call me%nc__water__flow%setAttribute('units', 'm3/s')
- call me%nc__water__flow%setAttribute('standard_name', 'water_volume_transport_in_river_channel')
- call me%nc__water__flow%setAttribute('long_name', 'Flow of water at outflow of grid cell')
+ call me%nc__water__flow%setAttribute('long_name', 'Discharge out of the cell')
call me%nc__water__flow%setAttribute('grid_mapping', 'spatial_ref')
call me%nc__water__flow%setAttribute('_FillValue', nf90_fill_double)
end subroutine
- !> Create variables for bed sediments
+ !> Create the variables for bed sediments
subroutine initSedimentNetCDFAggregatedOutput(me)
- class(NetCDFAggregatedOutput) :: me !! This NetCDFAggregatedOutput class
-
- me%nc__sediment__m_nm_total = me%nc%setVariable('sediment__m_nm_total', 'f64', [me%x_dim, me%y_dim, me%t_dim])
- call me%nc__sediment__m_nm_total%setAttribute('units', 'kg')
- call me%nc__sediment__m_nm_total%setAttribute('long_name', 'Mass of pristine NM in sediment')
- call me%nc__sediment__m_nm_total%setAttribute('grid_mapping', 'spatial_ref')
- call me%nc__sediment__m_nm_total%setAttribute('_FillValue', nf90_fill_double)
- me%nc__sediment__C_nm_total = me%nc%setVariable('sediment__C_nm_total', 'f64', [me%x_dim, me%y_dim, me%t_dim])
- call me%nc__sediment__C_nm_total%setAttribute('units', 'kg/kg')
- call me%nc__sediment__C_nm_total%setAttribute('long_name', 'Mass concentration of pristine NM across all sediment layers')
- call me%nc__sediment__C_nm_total%setAttribute('grid_mapping', 'spatial_ref')
- call me%nc__sediment__C_nm_total%setAttribute('_FillValue', nf90_fill_double)
- me%nc__sediment__C_nm_layers = me%nc%setVariable('sediment__C_nm_layers', 'f64', &
- [me%sed_l_dim, me%x_dim, me%y_dim, me%t_dim])
- call me%nc__sediment__C_nm_layers%setAttribute('units', 'kg/kg')
- call me%nc__sediment__C_nm_layers%setAttribute('long_name', 'Mass concentration of pristine NM by sediment layer')
- call me%nc__sediment__C_nm_layers%setAttribute('grid_mapping', 'spatial_ref')
- call me%nc__sediment__C_nm_layers%setAttribute('_FillValue', nf90_fill_double)
- me%nc__sediment__m_nm_buried = me%nc%setVariable('sediment__m_nm_buried', 'f64', [me%x_dim, me%y_dim, me%t_dim])
- call me%nc__sediment__m_nm_buried%setAttribute('units', 'kg')
- call me%nc__sediment__m_nm_buried%setAttribute('long_name', 'Mass of pristine NM buried from sediment')
- call me%nc__sediment__m_nm_buried%setAttribute('grid_mapping', 'spatial_ref')
- call me%nc__sediment__m_nm_buried%setAttribute('_FillValue', nf90_fill_double)
+ class(NetCDFAggregatedOutput) :: me
+ me%nc__sediment__m_contaminant_total = me%nc%setVariable('sediment__m_contaminant_total', 'f64', &
+ [me%contaminant_form_dim, me%x_dim, me%y_dim, me%t_dim])
+ call me%nc__sediment__m_contaminant_total%setAttribute('units', 'kg')
+ call me%nc__sediment__m_contaminant_total%setAttribute('long_name', &
+ 'Mass of contaminant in sediment (free, attached, dissolved)')
+ call me%nc__sediment__m_contaminant_total%setAttribute('grid_mapping', 'spatial_ref')
+ call me%nc__sediment__m_contaminant_total%setAttribute('_FillValue', nf90_fill_double)
+ me%nc__sediment__C_contaminant_total = me%nc%setVariable('sediment__C_contaminant_total', 'f64', &
+ [me%contaminant_form_dim, me%x_dim, me%y_dim, me%t_dim])
+ call me%nc__sediment__C_contaminant_total%setAttribute('units', 'kg/m3')
+ call me%nc__sediment__C_contaminant_total%setAttribute('long_name', &
+ 'Concentration of contaminant across all sediment layers')
+ call me%nc__sediment__C_contaminant_total%setAttribute('grid_mapping', 'spatial_ref')
+ call me%nc__sediment__C_contaminant_total%setAttribute('_FillValue', nf90_fill_double)
+ me%nc__sediment__C_contaminant_layers = me%nc%setVariable('sediment__C_contaminant_layers', 'f64', &
+ [me%sed_l_dim, me%contaminant_form_dim, me%x_dim, me%y_dim, me%t_dim])
+ call me%nc__sediment__C_contaminant_layers%setAttribute('units', 'kg/m3')
+ call me%nc__sediment__C_contaminant_layers%setAttribute('long_name', &
+ 'Concentration of contaminant by sediment layer')
+ call me%nc__sediment__C_contaminant_layers%setAttribute('grid_mapping', 'spatial_ref')
+ call me%nc__sediment__C_contaminant_layers%setAttribute('_FillValue', nf90_fill_double)
+ me%nc__sediment__m_contaminant_buried = me%nc%setVariable('sediment__m_contaminant_buried', 'f64', &
+ [me%contaminant_form_dim, me%x_dim, me%y_dim, me%t_dim])
+ call me%nc__sediment__m_contaminant_buried%setAttribute('units', 'kg')
+ call me%nc__sediment__m_contaminant_buried%setAttribute('long_name', &
+ 'Mass of contaminant buried from sediment')
+ call me%nc__sediment__m_contaminant_buried%setAttribute('grid_mapping', 'spatial_ref')
+ call me%nc__sediment__m_contaminant_buried%setAttribute('_FillValue', nf90_fill_double)
me%nc__sediment__bed_area = me%nc%setVariable('sediment__bed_area', 'f64', [me%x_dim, me%y_dim, me%t_dim])
call me%nc__sediment__bed_area%setAttribute('units', 'm2')
call me%nc__sediment__bed_area%setAttribute('long_name', 'Surface area of bed sediment')
@@ -376,203 +490,215 @@ subroutine initSedimentNetCDFAggregatedOutput(me)
call me%nc__sediment__mass%setAttribute('_FillValue', nf90_fill_double)
end subroutine
- !> Create the dimensions in the NetCDF file. This in included as a separate function so
- !! that we can create different dimensions in the aggregated vs non-aggregated NetCDF files
+ !> Create the dimensions in the NetCDF file (aggregated: no waterbody dim)
subroutine createDimensionsNetCDFAggregatedOutput(me)
- class(NetCDFAggregatedOutput) :: me
- ! Create the dimensions
- me%t_dim = me%nc%setDimension('t', C%nTimestepsInBatch)
- me%x_dim = me%nc%setDimension('x', DATASET%gridShape(1))
- me%y_dim = me%nc%setDimension('y', DATASET%gridShape(2))
- me%sed_l_dim = me%nc%setDimension('sed_l', C%nSedimentLayers)
- me%soil_l_dim = me%nc%setDimension('soil_l', C%nSoilLayers)
+ class(NetCDFAggregatedOutput) :: me
+
+ me%t_dim = me%nc%setDimension('t', C%nTimestepsInBatch)
+ me%x_dim = me%nc%setDimension('x', DATASET%gridShape(1))
+ me%y_dim = me%nc%setDimension('y', DATASET%gridShape(2))
+ me%sed_l_dim = me%nc%setDimension('sed_l', C%nSedimentLayers)
+ me%contaminant_form_dim = me%nc%setDimension('contaminant_form', C%contaminantDim(3))
end subroutine
- !> Allocate space for the in-memory output variables and fill with NetCDF fill value.
- !! Only call this if we're in iterative write mode.
+ !> Allocate space for the in-memory output variables and fill with NetCDF fill value
subroutine allocateVariablesNetCDFAggregatedOutput(me, k)
- class(NetCDFAggregatedOutput) :: me !! This NetCDFAggregatedOutput class
- integer :: k ! The current chunk
- real(dp), allocatable :: empty2DArray(:,:) ! 2D array filled with nf90 fill value
- real(dp), allocatable :: empty3DArray(:,:,:) ! 3D array filled with nf90 fill value
- real(dp), allocatable :: empty4DArraySoil(:,:,:,:) ! 4D array filled with nf90 fill value, with soil layer dim
- real(dp), allocatable :: empty4DArraySediment(:,:,:,:) ! 4D array filled with nf90 fill value, with sediment layer dim
- ! Allocate the empty array to be the current size for this chunk
- allocate(empty2DArray(DATASET%gridShape(1), DATASET%gridShape(2)))
- allocate(empty3DArray(DATASET%gridShape(1), DATASET%gridShape(2), C%batchNTimesteps(k)))
- allocate(empty4DArraySoil(C%nSoilLayers, DATASET%gridShape(1), &
- DATASET%gridShape(2), C%batchNTimesteps(k)))
- allocate(empty4DArraySediment(C%nSedimentLayers, DATASET%gridShape(1), &
- DATASET%gridShape(2), C%batchNTimesteps(k)))
- ! Allocate all water output variables to the correct shape, and fill with the NetCDF fill value
- empty2DArray = nf90_fill_double
- empty3DArray = nf90_fill_double
- empty4DArraySoil = nf90_fill_double
- empty4DArraySediment = nf90_fill_double
- allocate(me%output_agg_water__m_nm, source=empty3DArray)
- allocate(me%output_agg_water__m_transformed, source=empty3DArray)
- allocate(me%output_agg_water__m_dissolved, source=empty3DArray)
- allocate(me%output_agg_water__C_nm, source=empty3DArray)
- allocate(me%output_agg_water__C_transformed, source=empty3DArray)
- allocate(me%output_agg_water__C_dissolved, source=empty3DArray)
- allocate(me%output_agg_water__m_nm_outflow, source=empty3DArray)
- allocate(me%output_agg_water__m_transformed_outflow, source=empty3DArray)
- allocate(me%output_agg_water__m_dissolved_outflow, source=empty3DArray)
- allocate(me%output_agg_water__m_nm_deposited, source=empty3DArray)
- allocate(me%output_agg_water__m_transformed_deposited, source=empty3DArray)
- allocate(me%output_agg_water__m_nm_resuspended, source=empty3DArray)
- allocate(me%output_agg_water__m_transformed_resuspended, source=empty3DArray)
+ class(NetCDFAggregatedOutput) :: me
+ integer :: k
+ real(dp), allocatable :: empty2DArray(:,:)
+ real(dp), allocatable :: empty3DArray(:,:,:)
+ real(dp), allocatable :: empty4DArray(:,:,:,:)
+ real(dp), allocatable :: empty5DArraySediment(:,:,:,:,:)
+ integer :: nx, ny, nt, nls
+
+ nx = DATASET%gridShape(1)
+ ny = DATASET%gridShape(2)
+ nt = C%batchNTimesteps(k)
+ nls = C%nSoilLayers
+
+ allocate(empty2DArray(nx, ny))
+ allocate(empty3DArray(nx, ny, nt))
+ allocate(empty4DArray(C%contaminantDim(3), nx, ny, nt)) ! (form,x,y,t)
+ allocate(empty5DArraySediment(C%nSedimentLayers, C%contaminantDim(3), &
+ nx, ny, nt)) ! (layer,form,x,y,t)
+
+ empty2DArray = nf90_fill_double
+ empty3DArray = nf90_fill_double
+ empty4DArray = nf90_fill_double
+ empty5DArraySediment = nf90_fill_double
+
+ ! ---- aggregated WATER/SEDIMENT (form-first) ----
+ allocate(me%output_agg_water__m_contaminant, source=empty4DArray)
+ allocate(me%output_agg_water__C_contaminant, source=empty4DArray)
+ allocate(me%output_agg_water__j_contaminant_outflow, source=empty4DArray)
+ allocate(me%output_agg_water__j_contaminant_deposited, source=empty4DArray)
+ allocate(me%output_agg_water__j_contaminant_resuspended, source=empty4DArray)
+
allocate(me%output_agg_water__m_spm, source=empty3DArray)
allocate(me%output_agg_water__C_spm, source=empty3DArray)
if (C%includeSedimentFluxes) then
- allocate(me%output_agg_water__m_spm_erosion, source=empty3DArray)
- allocate(me%output_agg_water__m_spm_deposition, source=empty3DArray)
- allocate(me%output_agg_water__m_spm_resuspended, source=empty3DArray)
- allocate(me%output_agg_water__m_spm_inflow, source=empty3DArray)
- allocate(me%output_agg_water__m_spm_outflow, source=empty3DArray)
+ allocate(me%output_agg_water__m_spm_erosion, source=empty3DArray)
+ allocate(me%output_agg_water__m_spm_deposition, source=empty3DArray)
+ allocate(me%output_agg_water__m_spm_resuspended, source=empty3DArray)
+ allocate(me%output_agg_water__m_spm_inflow, source=empty3DArray)
+ allocate(me%output_agg_water__m_spm_outflow, source=empty3DArray)
allocate(me%output_agg_water__m_spm_bank_erosion, source=empty3DArray)
end if
allocate(me%output_agg_water__volume, source=empty3DArray)
- allocate(me%output_agg_water__depth, source=empty3DArray)
- allocate(me%output_agg_water__flow, source=empty3DArray)
- ! Allocate the sediment variables and fill with the NetCDF fill value
- allocate(me%output_agg_sediment__m_nm_total, source=empty3DArray)
- allocate(me%output_agg_sediment__C_nm_total, source=empty3DArray)
- allocate(me%output_agg_sediment__C_nm_layers, source=empty4DArraySediment)
- allocate(me%output_agg_sediment__m_nm_buried, source=empty3DArray)
+ allocate(me%output_agg_water__depth, source=empty3DArray)
+ allocate(me%output_agg_water__flow, source=empty3DArray)
+
+ allocate(me%output_agg_sediment__m_contaminant_total, source=empty4DArray)
+ allocate(me%output_agg_sediment__C_contaminant_total, source=empty4DArray)
+ allocate(me%output_agg_sediment__C_contaminant_layers, source=empty5DArraySediment)
+ allocate(me%output_agg_sediment__m_contaminant_buried, source=empty4DArray)
allocate(me%output_agg_sediment__bed_area, source=empty3DArray)
- allocate(me%output_agg_sediment__mass, source=empty3DArray)
- ! Allocate the sediment variables and fill with NetCDF fill value
- allocate(me%output_soil__land_use, source=empty2DArray)
- allocate(me%output_soil__m_nm_total, source=empty3DArray)
- allocate(me%output_soil__m_transformed_total, source=empty3DArray)
- allocate(me%output_soil__m_dissolved_total, source=empty3DArray)
- allocate(me%output_soil__C_nm_total, source=empty3DArray)
- allocate(me%output_soil__C_transformed_total, source=empty3DArray)
- allocate(me%output_soil__C_dissolved_total, source=empty3DArray)
+ allocate(me%output_agg_sediment__mass, source=empty3DArray)
+
+ allocate(me%output_soil__m_contaminant_total(1:3, 1:nx, 1:ny, 1:nt))
+ me%output_soil__m_contaminant_total = nf90_fill_double
+
+ allocate(me%output_soil__C_contaminant_total(1:nx, 1:ny, 1:nt))
+ me%output_soil__C_contaminant_total = nf90_fill_double
+
if (C%includeSoilStateBreakdown) then
- allocate(me%output_soil__C_nm_free, source=empty3DArray)
- allocate(me%output_soil__C_transformed_free, source=empty3DArray)
- allocate(me%output_soil__C_nm_att, source=empty3DArray)
- allocate(me%output_soil__C_transformed_att, source=empty3DArray)
+ allocate(me%output_soil__C_contaminant_free(1:nx, 1:ny, 1:nt))
+ me%output_soil__C_contaminant_free = nf90_fill_double
+
+ allocate(me%output_soil__C_contaminant_attached(1:nx, 1:ny, 1:nt))
+ me%output_soil__C_contaminant_attached = nf90_fill_double
+
+ allocate(me%output_soil__C_contaminant_free_layers(1:nls, 1:nx, 1:ny, 1:nt))
+ me%output_soil__C_contaminant_free_layers = nf90_fill_double
+
+ allocate(me%output_soil__C_contaminant_attached_layers(1:nls, 1:nx, 1:ny, 1:nt))
+ me%output_soil__C_contaminant_attached_layers = nf90_fill_double
end if
+
if (C%includeSoilLayerBreakdown) then
- allocate(me%output_soil__C_nm_layers, source=empty4DArraySoil)
- allocate(me%output_soil__C_transformed_layers, source=empty4DArraySoil)
- allocate(me%output_soil__C_dissolved_layers, source=empty4DArraySoil)
- if (C%includeSoilStateBreakdown) then
- allocate(me%output_soil__C_nm_free_layers, source=empty4DArraySoil)
- allocate(me%output_soil__C_transformed_free_layers, source=empty4DArraySoil)
- allocate(me%output_soil__C_nm_att_layers, source=empty4DArraySoil)
- allocate(me%output_soil__C_transformed_att_layers, source=empty4DArraySoil)
- end if
+ allocate(me%output_soil__C_contaminant_layers(1:nls, 1:nx, 1:ny, 1:nt))
+ me%output_soil__C_contaminant_layers = nf90_fill_double
end if
+
if (C%includeSoilErosionYields) then
- allocate(me%output_soil__m_soil_eroded, source=empty3DArray)
- allocate(me%output_soil__m_nm_eroded, source=empty3DArray)
- allocate(me%output_soil__m_transformed_eroded, source=empty3DArray)
+ allocate(me%output_soil__m_soil_eroded(1:nx, 1:ny, 1:nt))
+ me%output_soil__m_soil_eroded = nf90_fill_double
+
+ allocate(me%output_soil__m_contaminant_eroded(1:2, 1:nx, 1:ny, 1:nt))
+ me%output_soil__m_contaminant_eroded = nf90_fill_double
end if
- allocate(me%output_soil__m_nm_buried, source=empty3DArray)
- allocate(me%output_soil__m_transformed_buried, source=empty3DArray)
- allocate(me%output_soil__m_dissolved_buried, source=empty3DArray)
- allocate(me%output_soil__bulk_density, source=empty2DArray)
+
+ allocate(me%output_soil__m_contaminant_buried(1:3, 1:nx, 1:ny, 1:nt))
+ me%output_soil__m_contaminant_buried = nf90_fill_double
+
+ ! parent soil arrays — FIX DIM ORDER to (y,x)
+ ! HACK - SH: converted this back to (x,y) to keep NetCDF file as (y,x),
+ ! see https://github.com/NERC-CEH/nanofase/pull/10/files#r2432863960
+ allocate(me%output_soil__bulk_density(1:nx, 1:nx))
+ me%output_soil__bulk_density = nf90_fill_double
+
+ deallocate(empty2DArray, empty3DArray, empty4DArray, empty5DArraySediment)
end subroutine
- !> Reallocate output variable memory for a new chunk. This subroutine should
- !! only be called if we're writing to the NetCDF file, in write-at-end mode
- !! and at the start of a new chunk, so be sure of that when calling it
+ !> Reallocate output variable memory for a new chunk
subroutine newChunkNetCDFAggregatedOutput(me, k)
- class(NetCDFAggregatedOutput) :: me !! This NetCDF output class
- integer :: k !! This chunk index
- ! Allocate the variables. They should have been deallocated at the end of the previous chunk
+ class(NetCDFAggregatedOutput) :: me
+ integer :: k
call me%allocateVariables(k)
end subroutine
- !> Write the output variables to the NetCDF file. This subroutine should be called
- !! at the end of a chunk if we're in write-at-end mode and writing to a NetCDF file
+ !> Write the output variables to the NetCDF file
subroutine finaliseChunkNetCDFAggregatedOutput(me, tStart)
- class(NetCDFAggregatedOutput) :: me !! This NetCDF output class
- integer :: tStart !! Timestep index at the start of this chunk
- ! Write the data from this chunk to the NetCDF file, water first
- call me%nc__water__m_nm%setData(me%output_agg_water__m_nm, start=[1,1,tStart])
- call me%nc__water__m_transformed%setData(me%output_agg_water__m_transformed, start=[1,1,tStart])
- call me%nc__water__m_dissolved%setData(me%output_agg_water__m_dissolved, start=[1,1,tStart])
- call me%nc__water__C_nm%setData(me%output_agg_water__C_nm, start=[1,1,tStart])
- call me%nc__water__C_transformed%setData(me%output_agg_water__C_transformed, start=[1,1,tStart])
- call me%nc__water__C_dissolved%setData(me%output_agg_water__C_dissolved, start=[1,1,tStart])
- call me%nc__water__m_nm_outflow%setData(me%output_agg_water__m_nm_outflow, start=[1,1,tStart])
- call me%nc__water__m_transformed_outflow%setData(me%output_agg_water__m_transformed_outflow, start=[1,1,tStart])
- call me%nc__water__m_dissolved_outflow%setData(me%output_agg_water__m_dissolved_outflow, start=[1,1,tStart])
- call me%nc__water__m_nm_deposited%setData(me%output_agg_water__m_nm_deposited, start=[1,1,tStart])
- call me%nc__water__m_transformed_deposited%setData(me%output_agg_water__m_transformed_deposited, start=[1,1,tStart])
- call me%nc__water__m_nm_resuspended%setData(me%output_agg_water__m_nm_resuspended, start=[1,1,tStart])
- call me%nc__water__m_transformed_resuspended%setData(me%output_agg_water__m_transformed_resuspended, start=[1,1,tStart])
- call me%nc__water__m_spm%setData(me%output_agg_water__m_spm, start=[1,1,tStart])
- call me%nc__water__C_spm%setData(me%output_agg_water__C_spm, start=[1,1,tStart])
+ class(NetCDFAggregatedOutput) :: me
+ integer :: tStart
+
+ call me%nc__water__m_contaminant%setData( me%output_agg_water__m_contaminant, &
+ start=[1,1,1,tStart])
+ call me%nc__water__C_contaminant%setData( me%output_agg_water__C_contaminant, &
+ start=[1,1,1,tStart])
+ if (C%includeSoilStateBreakdown) then
+ call me%nc__water__C_contaminant_free%setData( me%output_agg_water__C_contaminant_free, &
+ start=[1,1,tStart])
+ call me%nc__water__C_contaminant_attached%setData(me%output_agg_water__C_contaminant_attached, &
+ start=[1,1,tStart])
+ end if
+ call me%nc__water__j_contaminant_outflow%setData( me%output_agg_water__j_contaminant_outflow, &
+ start=[1,1,1,tStart])
+ call me%nc__water__j_contaminant_deposited%setData( me%output_agg_water__j_contaminant_deposited, &
+ start=[1,1,1,tStart])
+ call me%nc__water__j_contaminant_resuspended%setData(me%output_agg_water__j_contaminant_resuspended,&
+ start=[1,1,1,tStart])
+ call me%nc__water__m_spm%setData( me%output_agg_water__m_spm, &
+ start=[1,1,tStart])
+ call me%nc__water__C_spm%setData( me%output_agg_water__C_spm, &
+ start=[1,1,tStart])
if (C%includeSedimentFluxes) then
- call me%nc__water__m_spm_erosion%setData(me%output_agg_water__m_spm_erosion, start=[1,1,tStart])
- call me%nc__water__m_spm_deposited%setData(me%output_agg_water__m_spm_deposition, start=[1,1,tStart])
- call me%nc__water__m_spm_resuspended%setData(me%output_agg_water__m_spm_resuspended, start=[1,1,tStart])
- call me%nc__water__m_spm_inflow%setData(me%output_agg_water__m_spm_inflow, start=[1,1,tStart])
- call me%nc__water__m_spm_outflow%setData(me%output_agg_water__m_spm_outflow, start=[1,1,tStart])
- call me%nc__water__m_spm_bank_erosion%setData(me%output_agg_water__m_spm_bank_erosion, start=[1,1,tStart])
+ call me%nc__water__m_spm_erosion%setData( me%output_agg_water__m_spm_erosion, &
+ start=[1,1,tStart])
+ call me%nc__water__m_spm_deposited%setData( me%output_agg_water__m_spm_deposition, &
+ start=[1,1,tStart])
+ call me%nc__water__m_spm_resuspended%setData( me%output_agg_water__m_spm_resuspended, &
+ start=[1,1,tStart])
+ call me%nc__water__m_spm_inflow%setData( me%output_agg_water__m_spm_inflow, &
+ start=[1,1,tStart])
+ call me%nc__water__m_spm_outflow%setData( me%output_agg_water__m_spm_outflow, &
+ start=[1,1,tStart])
+ call me%nc__water__m_spm_bank_erosion%setData( me%output_agg_water__m_spm_bank_erosion, &
+ start=[1,1,tStart])
end if
- call me%nc__water__volume%setData(me%output_agg_water__volume, start=[1,1,tStart])
- call me%nc__water__depth%setData(me%output_agg_water__depth, start=[1,1,tStart])
- call me%nc__water__flow%setData(me%output_agg_water__flow, start=[1,1,tStart])
- ! Sediment
- call me%nc__sediment__m_nm_total%setData(me%output_agg_sediment__m_nm_total, start=[1,1,tStart])
- call me%nc__sediment__C_nm_total%setData(me%output_agg_sediment__C_nm_total, start=[1,1,tStart])
- call me%nc__sediment__C_nm_layers%setData(me%output_agg_sediment__C_nm_layers, start=[1,1,1,tStart])
- call me%nc__sediment__m_nm_buried%setData(me%output_agg_sediment__m_nm_buried, start=[1,1,tStart])
- call me%nc__sediment__bed_area%setData(me%output_agg_sediment__bed_area, start=[1,1,tStart])
- call me%nc__sediment__mass%setData(me%output_agg_sediment__mass, start=[1,1,tStart])
- ! Soil
- call me%nc__soil__m_nm_total%setData(me%output_soil__m_nm_total, start=[1,1,tStart])
- call me%nc__soil__m_transformed_total%setData(me%output_soil__m_transformed_total, start=[1,1,tStart])
- call me%nc__soil__m_dissolved_total%setData(me%output_soil__m_dissolved_total, start=[1,1,tStart])
- call me%nc__soil__C_nm_total%setData(me%output_soil__C_nm_total, start=[1,1,tStart])
- call me%nc__soil__C_transformed_total%setData(me%output_soil__C_transformed_total, start=[1,1,tStart])
- call me%nc__soil__C_dissolved_total%setData(me%output_soil__C_dissolved_total, start=[1,1,tStart])
- if (C%includeSoilStateBreakdown) then
- call me%nc__soil__C_nm_free%setData(me%output_soil__C_nm_free, start=[1,1,tStart])
- call me%nc__soil__C_transformed_free%setData(me%output_soil__C_transformed_free, start=[1,1,tStart])
- call me%nc__soil__C_nm_att%setData(me%output_soil__C_nm_att, start=[1,1,tStart])
- call me%nc__soil__C_transformed_att%setData(me%output_soil__C_transformed_att, start=[1,1,tStart])
+ call me%nc__water__volume%setData( me%output_agg_water__volume, &
+ start=[1,1,tStart])
+ call me%nc__water__depth%setData( me%output_agg_water__depth, &
+ start=[1,1,tStart])
+ call me%nc__water__flow%setData( me%output_agg_water__flow, &
+ start=[1,1,tStart])
+
+ call me%nc__sediment__m_contaminant_total%setData( me%output_agg_sediment__m_contaminant_total, &
+ start=[1,1,1,tStart])
+ call me%nc__sediment__C_contaminant_total%setData( me%output_agg_sediment__C_contaminant_total, &
+ start=[1,1,1,tStart])
+ call me%nc__sediment__C_contaminant_layers%setData( me%output_agg_sediment__C_contaminant_layers, &
+ start=[1,1,1,1,tStart])
+ call me%nc__sediment__m_contaminant_buried%setData( me%output_agg_sediment__m_contaminant_buried, &
+ start=[1,1,1,tStart])
+ call me%nc__sediment__bed_area%setData( me%output_agg_sediment__bed_area, &
+ start=[1,1,tStart])
+ call me%nc__sediment__mass%setData( me%output_agg_sediment__mass, &
+ start=[1,1,tStart])
+
+ ! Parent soil variables (grid-cell level)
+ call me%nc__soil__m_contaminant_total%setData( me%output_soil__m_contaminant_total, &
+ start=[1,1,1,tStart])
+ call me%nc__soil__C_contaminant_total%setData( me%output_soil__C_contaminant_total, &
+ start=[1,1,tStart])
+
+ if (allocated(me%output_soil__C_contaminant_layers)) then
+ call me%nc__soil__C_contaminant_layers%setData( me%output_soil__C_contaminant_layers, &
+ start=[1,1,1,tStart])
end if
- if (C%includeSoilLayerBreakdown) then
- call me%nc__soil__C_nm_layers%setData(me%output_soil__C_nm_layers, start=[1,1,1,tStart])
- call me%nc__soil__C_transformed_layers%setData(me%output_soil__C_transformed_layers, start=[1,1,1,tStart])
- call me%nc__soil__C_dissolved_layers%setData(me%output_soil__C_dissolved_layers, start=[1,1,1,tStart])
- if (C%includeSoilStateBreakdown) then
- call me%nc__soil__C_nm_free_layers%setData(me%output_soil__C_nm_free_layers, start=[1,1,1,tStart])
- call me%nc__soil__C_transformed_free_layers%setData(me%output_soil__C_transformed_free_layers, start=[1,1,1,tStart])
- call me%nc__soil__C_nm_att_layers%setData(me%output_soil__C_nm_att_layers, start=[1,1,1,tStart])
- call me%nc__soil__C_transformed_att_layers%setData(me%output_soil__C_transformed_att_layers, start=[1,1,1,tStart])
- end if
+ if (allocated(me%output_soil__m_soil_eroded)) then
+ call me%nc__soil__m_soil_eroded%setData( me%output_soil__m_soil_eroded, &
+ start=[1,1,tStart])
+ call me%nc__soil__m_contaminant_eroded%setData(me%output_soil__m_contaminant_eroded, &
+ start=[1,1,1,tStart])
end if
- if (C%includeSoilErosionYields) then
- call me%nc__soil__m_soil_eroded%setData(me%output_soil__m_soil_eroded, start=[1,1,tStart])
- call me%nc__soil__m_nm_eroded%setData(me%output_soil__m_nm_eroded, start=[1,1,tStart])
- call me%nc__soil__m_transformed_eroded%setData(me%output_soil__m_transformed_eroded, start=[1,1,tStart])
+ call me%nc__soil__m_contaminant_buried%setData( me%output_soil__m_contaminant_buried, &
+ start=[1,1,1,tStart])
+
+ ! Optional static grid vars
+ !call me%nc__soil__land_use%setData( me%output_soil__land_use, start=[1,1])
+ !call me%nc__soil__bulk_density%setData(me%output_soil__bulk_density, start=[1,1])
+
+ ! Deallocate
+ deallocate(me%output_agg_water__m_contaminant)
+ deallocate(me%output_agg_water__C_contaminant)
+ if (C%includeSoilStateBreakdown) then
+ deallocate(me%output_agg_water__C_contaminant_free)
+ deallocate(me%output_agg_water__C_contaminant_attached)
end if
- call me%nc__soil__m_nm_buried%setData(me%output_soil__m_nm_buried, start=[1,1,tStart])
- call me%nc__soil__m_transformed_buried%setData(me%output_soil__m_transformed_buried, start=[1,1,tStart])
- call me%nc__soil__m_dissolved_buried%setData(me%output_soil__m_dissolved_buried, start=[1,1,tStart])
- ! Deallocate the output variables
- deallocate(me%output_agg_water__m_nm)
- deallocate(me%output_agg_water__m_transformed)
- deallocate(me%output_agg_water__m_dissolved)
- deallocate(me%output_agg_water__C_nm)
- deallocate(me%output_agg_water__C_transformed)
- deallocate(me%output_agg_water__C_dissolved)
- deallocate(me%output_agg_water__m_nm_outflow)
- deallocate(me%output_agg_water__m_transformed_outflow)
- deallocate(me%output_agg_water__m_dissolved_outflow)
- deallocate(me%output_agg_water__m_nm_deposited)
- deallocate(me%output_agg_water__m_transformed_deposited)
- deallocate(me%output_agg_water__m_nm_resuspended)
- deallocate(me%output_agg_water__m_transformed_resuspended)
+ deallocate(me%output_agg_water__j_contaminant_outflow)
+ deallocate(me%output_agg_water__j_contaminant_deposited)
+ deallocate(me%output_agg_water__j_contaminant_resuspended)
deallocate(me%output_agg_water__m_spm)
deallocate(me%output_agg_water__C_spm)
if (C%includeSedimentFluxes) then
@@ -586,45 +712,25 @@ subroutine finaliseChunkNetCDFAggregatedOutput(me, tStart)
deallocate(me%output_agg_water__volume)
deallocate(me%output_agg_water__depth)
deallocate(me%output_agg_water__flow)
- deallocate(me%output_agg_sediment__m_nm_total)
- deallocate(me%output_agg_sediment__C_nm_total)
- deallocate(me%output_agg_sediment__C_nm_layers)
- deallocate(me%output_agg_sediment__m_nm_buried)
+ deallocate(me%output_agg_sediment__m_contaminant_total)
+ deallocate(me%output_agg_sediment__C_contaminant_total)
+ deallocate(me%output_agg_sediment__C_contaminant_layers)
+ deallocate(me%output_agg_sediment__m_contaminant_buried)
deallocate(me%output_agg_sediment__bed_area)
deallocate(me%output_agg_sediment__mass)
- deallocate(me%output_soil__land_use)
- deallocate(me%output_soil__m_nm_total)
- deallocate(me%output_soil__m_transformed_total)
- deallocate(me%output_soil__m_dissolved_total)
- deallocate(me%output_soil__C_nm_total)
- deallocate(me%output_soil__C_transformed_total)
- deallocate(me%output_soil__C_dissolved_total)
- if (C%includeSoilStateBreakdown) then
- deallocate(me%output_soil__C_nm_free)
- deallocate(me%output_soil__C_transformed_free)
- deallocate(me%output_soil__C_nm_att)
- deallocate(me%output_soil__C_transformed_att)
- end if
- if (C%includeSoilLayerBreakdown) then
- deallocate(me%output_soil__C_nm_layers)
- deallocate(me%output_soil__C_transformed_layers)
- deallocate(me%output_soil__C_dissolved_layers)
- if (C%includeSoilStateBreakdown) then
- deallocate(me%output_soil__C_nm_free_layers)
- deallocate(me%output_soil__C_transformed_free_layers)
- deallocate(me%output_soil__C_nm_att_layers)
- deallocate(me%output_soil__C_transformed_att_layers)
- end if
- end if
- if (C%includeSoilErosionYields) then
- deallocate(me%output_soil__m_soil_eroded)
- deallocate(me%output_soil__m_nm_eroded)
- deallocate(me%output_soil__m_transformed_eroded)
- end if
- deallocate(me%output_soil__m_nm_buried)
- deallocate(me%output_soil__m_transformed_buried)
- deallocate(me%output_soil__m_dissolved_buried)
+
+ ! Parent soil arrays
+ if (allocated(me%output_soil__land_use)) deallocate(me%output_soil__land_use)
+ deallocate(me%output_soil__m_contaminant_total)
+ deallocate(me%output_soil__C_contaminant_total)
+ if (allocated(me%output_soil__C_contaminant_free)) deallocate(me%output_soil__C_contaminant_free)
+ if (allocated(me%output_soil__C_contaminant_attached)) deallocate(me%output_soil__C_contaminant_attached)
+ if (allocated(me%output_soil__C_contaminant_free_layers)) deallocate(me%output_soil__C_contaminant_free_layers)
+ if (allocated(me%output_soil__C_contaminant_attached_layers)) deallocate(me%output_soil__C_contaminant_attached_layers)
+ if (allocated(me%output_soil__C_contaminant_layers)) deallocate(me%output_soil__C_contaminant_layers)
+ if (allocated(me%output_soil__m_soil_eroded)) deallocate(me%output_soil__m_soil_eroded)
+ if (allocated(me%output_soil__m_contaminant_eroded)) deallocate(me%output_soil__m_contaminant_eroded)
+ deallocate(me%output_soil__m_contaminant_buried)
deallocate(me%output_soil__bulk_density)
end subroutine
-
end module
\ No newline at end of file
diff --git a/src/Data/NetCDFOutputModule.f90 b/src/Data/NetCDFOutputModule.f90
index 2a26ac5..61bb617 100644
--- a/src/Data/NetCDFOutputModule.f90
+++ b/src/Data/NetCDFOutputModule.f90
@@ -1,32 +1,35 @@
module NetCDFOutputModule
- use GlobalsModule, only: C, dp
+ use GlobalsModule, only: C, dp, FREE_CONTAMINANT, ATTACHED_CONTAMINANT
use UtilModule
use mo_netcdf, only: NcDataset, NcVariable, NcDimension, nf90_fill_int, nf90_fill_double
use DataInputModule, only: DATASET
+ use ContaminantModule, only: Contaminant
+ use ResultModule
+ use WaterBodyModule, only: WaterBody
use EnvironmentModule
+ use AbstractGridCellModule, only: AbstractGridCell
use AbstractEnvironmentModule, only: EnvironmentPointer
+ use AbstractBedSedimentModule
use datetime_module
+ implicit none
+
+
!> Class for outputting data to a NetCDF file
type, public :: NetCDFOutput
type(NcDataset) :: nc !! The NetCDF file to write to
type(EnvironmentPointer) :: env !! Pointer to the environment, to retrieve state variables
- type(NcDimension) :: t_dim, x_dim, y_dim, w_dim, sed_l_dim, soil_l_dim
+ type(NcDimension) :: t_dim, x_dim, y_dim, w_dim, sed_l_dim, soil_l_dim, contaminant_form_dim
+ integer :: w_count = 1
! The NetCDF variables
type(NcVariable) :: nc__water__waterbody_type
- type(NcVariable) :: nc__water__m_nm
- type(NcVariable) :: nc__water__m_transformed
- type(NcVariable) :: nc__water__m_dissolved
- type(NcVariable) :: nc__water__C_nm
- type(NcVariable) :: nc__water__C_transformed
- type(NcVariable) :: nc__water__C_dissolved
- type(NcVariable) :: nc__water__m_nm_outflow
- type(NcVariable) :: nc__water__m_transformed_outflow
- type(NcVariable) :: nc__water__m_dissolved_outflow
- type(NcVariable) :: nc__water__m_nm_deposited
- type(NcVariable) :: nc__water__m_transformed_deposited
- type(NcVariable) :: nc__water__m_nm_resuspended
- type(NcVariable) :: nc__water__m_transformed_resuspended
+ type(NcVariable) :: nc__water__m_contaminant
+ type(NcVariable) :: nc__water__C_contaminant
+ type(NcVariable) :: nc__water__C_contaminant_free
+ type(NcVariable) :: nc__water__C_contaminant_attached
+ type(NcVariable) :: nc__water__j_contaminant_outflow
+ type(NcVariable) :: nc__water__j_contaminant_deposited
+ type(NcVariable) :: nc__water__j_contaminant_resuspended
type(NcVariable) :: nc__water__m_spm
type(NcVariable) :: nc__water__C_spm
type(NcVariable) :: nc__water__m_spm_erosion
@@ -38,53 +41,36 @@ module NetCDFOutputModule
type(NcVariable) :: nc__water__volume
type(NcVariable) :: nc__water__depth
type(NcVariable) :: nc__water__flow
- type(NcVariable) :: nc__sediment__m_nm_total
- type(NcVariable) :: nc__sediment__C_nm_total
- type(NcVariable) :: nc__sediment__C_nm_layers
- type(NcVariable) :: nc__sediment__m_nm_buried
+ type(NcVariable) :: nc__sediment__m_contaminant_total
+ type(NcVariable) :: nc__sediment__C_contaminant_total
+ type(NcVariable) :: nc__sediment__C_contaminant_free
+ type(NcVariable) :: nc__sediment__C_contaminant_attached
+ type(NcVariable) :: nc__sediment__C_contaminant_layers
+ type(NcVariable) :: nc__sediment__m_contaminant_buried
type(NcVariable) :: nc__sediment__bed_area
type(NcVariable) :: nc__sediment__mass
type(NcVariable) :: nc__soil__land_use
- type(NcVariable) :: nc__soil__m_nm_total
- type(NcVariable) :: nc__soil__m_transformed_total
- type(NcVariable) :: nc__soil__m_dissolved_total
- type(NcVariable) :: nc__soil__C_nm_total
- type(NcVariable) :: nc__soil__C_transformed_total
- type(NcVariable) :: nc__soil__C_dissolved_total
- type(NcVariable) :: nc__soil__C_nm_free
- type(NcVariable) :: nc__soil__C_transformed_free
- type(NcVariable) :: nc__soil__C_nm_att
- type(NcVariable) :: nc__soil__C_transformed_att
- type(NcVariable) :: nc__soil__C_nm_layers
- type(NcVariable) :: nc__soil__C_transformed_layers
- type(NcVariable) :: nc__soil__C_dissolved_layers
- type(NcVariable) :: nc__soil__C_nm_free_layers
- type(NcVariable) :: nc__soil__C_transformed_free_layers
- type(NcVariable) :: nc__soil__C_nm_att_layers
- type(NcVariable) :: nc__soil__C_transformed_att_layers
+ type(NcVariable) :: nc__soil__m_contaminant_total
+ type(NcVariable) :: nc__soil__C_contaminant_total
+ type(NcVariable) :: nc__soil__C_contaminant_free
+ type(NcVariable) :: nc__soil__C_contaminant_attached
+ type(NcVariable) :: nc__soil__C_contaminant_layers
+ type(NcVariable) :: nc__soil__C_contaminant_free_layers
+ type(NcVariable) :: nc__soil__C_contaminant_attached_layers
type(NcVariable) :: nc__soil__m_soil_eroded
- type(NcVariable) :: nc__soil__m_nm_eroded
- type(NcVariable) :: nc__soil__m_transformed_eroded
- type(NcVariable) :: nc__soil__m_nm_buried
- type(NcVariable) :: nc__soil__m_transformed_buried
- type(NcVariable) :: nc__soil__m_dissolved_buried
+ type(NcVariable) :: nc__soil__m_contaminant_eroded
+ type(NcVariable) :: nc__soil__m_contaminant_buried
type(NcVariable) :: nc__soil__bulk_density
! Model output variables
real(dp), allocatable :: output_water__waterbody_type(:,:)
- real(dp), allocatable :: output_water__m_nm(:,:,:,:)
- real(dp), allocatable :: output_water__m_transformed(:,:,:,:)
- real(dp), allocatable :: output_water__m_dissolved(:,:,:,:)
- real(dp), allocatable :: output_water__C_nm(:,:,:,:)
- real(dp), allocatable :: output_water__C_transformed(:,:,:,:)
- real(dp), allocatable :: output_water__C_dissolved(:,:,:,:)
- real(dp), allocatable :: output_water__m_nm_outflow(:,:,:,:)
- real(dp), allocatable :: output_water__m_transformed_outflow(:,:,:,:)
- real(dp), allocatable :: output_water__m_dissolved_outflow(:,:,:,:)
- real(dp), allocatable :: output_water__m_nm_deposited(:,:,:,:)
- real(dp), allocatable :: output_water__m_transformed_deposited(:,:,:,:)
- real(dp), allocatable :: output_water__m_nm_resuspended(:,:,:,:)
- real(dp), allocatable :: output_water__m_transformed_resuspended(:,:,:,:)
+ real(dp), allocatable :: output_water__m_contaminant(:,:,:,:,:)
+ real(dp), allocatable :: output_water__C_contaminant(:,:,:,:)
+ real(dp), allocatable :: output_water__C_contaminant_free(:,:,:,:)
+ real(dp), allocatable :: output_water__C_contaminant_attached(:,:,:,:)
+ real(dp), allocatable :: output_water__j_contaminant_outflow(:,:,:,:,:)
+ real(dp), allocatable :: output_water__j_contaminant_deposited(:,:,:,:,:)
+ real(dp), allocatable :: output_water__j_contaminant_resuspended(:,:,:,:,:)
real(dp), allocatable :: output_water__m_spm(:,:,:,:)
real(dp), allocatable :: output_water__C_spm(:,:,:,:)
real(dp), allocatable :: output_water__m_spm_erosion(:,:,:,:)
@@ -96,39 +82,28 @@ module NetCDFOutputModule
real(dp), allocatable :: output_water__volume(:,:,:,:)
real(dp), allocatable :: output_water__depth(:,:,:,:)
real(dp), allocatable :: output_water__flow(:,:,:,:)
- real(dp), allocatable :: output_sediment__m_nm_total(:,:,:,:)
- real(dp), allocatable :: output_sediment__C_nm_total(:,:,:,:)
- real(dp), allocatable :: output_sediment__C_nm_layers(:,:,:,:,:)
- real(dp), allocatable :: output_sediment__m_nm_buried(:,:,:,:)
+ real(dp), allocatable :: output_sediment__m_contaminant_total(:,:,:,:,:)
+ real(dp), allocatable :: output_sediment__C_contaminant_total(:,:,:,:)
+ real(dp), allocatable :: output_sediment__C_contaminant_free(:,:,:,:)
+ real(dp), allocatable :: output_sediment__C_contaminant_attached(:,:,:,:)
+ real(dp), allocatable :: output_sediment__C_contaminant_layers(:,:,:,:,:)
+ real(dp), allocatable :: output_sediment__m_contaminant_buried(:,:,:,:,:)
real(dp), allocatable :: output_sediment__bed_area(:,:,:,:)
real(dp), allocatable :: output_sediment__mass(:,:,:,:)
real(dp), allocatable :: output_soil__land_use(:,:)
- real(dp), allocatable :: output_soil__m_nm_total(:,:,:)
- real(dp), allocatable :: output_soil__m_transformed_total(:,:,:)
- real(dp), allocatable :: output_soil__m_dissolved_total(:,:,:)
- real(dp), allocatable :: output_soil__C_nm_total(:,:,:)
- real(dp), allocatable :: output_soil__C_transformed_total(:,:,:)
- real(dp), allocatable :: output_soil__C_dissolved_total(:,:,:)
- real(dp), allocatable :: output_soil__C_nm_free(:,:,:)
- real(dp), allocatable :: output_soil__C_transformed_free(:,:,:)
- real(dp), allocatable :: output_soil__C_nm_att(:,:,:)
- real(dp), allocatable :: output_soil__C_transformed_att(:,:,:)
- real(dp), allocatable :: output_soil__C_nm_layers(:,:,:,:)
- real(dp), allocatable :: output_soil__C_transformed_layers(:,:,:,:)
- real(dp), allocatable :: output_soil__C_dissolved_layers(:,:,:,:)
- real(dp), allocatable :: output_soil__C_nm_free_layers(:,:,:,:)
- real(dp), allocatable :: output_soil__C_transformed_free_layers(:,:,:,:)
- real(dp), allocatable :: output_soil__C_nm_att_layers(:,:,:,:)
- real(dp), allocatable :: output_soil__C_transformed_att_layers(:,:,:,:)
+ real(dp), allocatable :: output_soil__m_contaminant_total(:,:,:,:)
+ real(dp), allocatable :: output_soil__C_contaminant_total(:,:,:)
+ real(dp), allocatable :: output_soil__C_contaminant_free(:,:,:)
+ real(dp), allocatable :: output_soil__C_contaminant_attached(:,:,:)
+ real(dp), allocatable :: output_soil__C_contaminant_layers(:,:,:,:)
+ real(dp), allocatable :: output_soil__C_contaminant_free_layers(:,:,:,:)
+ real(dp), allocatable :: output_soil__C_contaminant_attached_layers(:,:,:,:)
real(dp), allocatable :: output_soil__m_soil_eroded(:,:,:)
- real(dp), allocatable :: output_soil__m_nm_eroded(:,:,:)
- real(dp), allocatable :: output_soil__m_transformed_eroded(:,:,:)
- real(dp), allocatable :: output_soil__m_nm_buried(:,:,:)
- real(dp), allocatable :: output_soil__m_transformed_buried(:,:,:)
- real(dp), allocatable :: output_soil__m_dissolved_buried(:,:,:)
+ real(dp), allocatable :: output_soil__m_contaminant_eroded(:,:,:,:)
+ real(dp), allocatable :: output_soil__m_contaminant_buried(:,:,:,:)
real(dp), allocatable :: output_soil__bulk_density(:,:)
- contains
+ contains
procedure, public :: init => initNetCDFOutput
procedure, public :: updateWater => updateWaterNetCDFOutput
procedure, public :: updateSediment => updateSedimentNetCDFOutput
@@ -146,6 +121,19 @@ module NetCDFOutputModule
contains
+ ! small helper to compute the maximum number of reaches across the grid
+ ! (used to size the 'w' dimension dynamically)
+ integer function getMaxReaches(me) result(nw)
+ class(NetCDFOutput), intent(in) :: me
+ integer :: ix, iy
+ nw = 1
+ do iy = 1, size(me%env%item%colGridCells, 2)
+ do ix = 1, size(me%env%item%colGridCells, 1)
+ nw = max(nw, me%env%item%colGridCells(ix,iy)%item%nReaches)
+ end do
+ end do
+ end function getMaxReaches
+
!> Initialise the NetCDF output class by creating the NetCDF file and allocating space
!! for the output variables (if we're in write-at-end mode and it's needed)
subroutine initNetCDFOutput(me, env, k)
@@ -163,84 +151,156 @@ subroutine initNetCDFOutput(me, env, k)
if (C%netCDFWriteMode == 'end') then
call me%allocateVariables(k)
end if
-
end subroutine
!> Update either the NetCDF file or the in-memory output variables on this time step
subroutine updateWaterNetCDFOutput(me, t, tInChunk, x, y)
- class(NetCDFOutput) :: me !! This NetCDFOutput class
- integer :: t !! Timestep index for whole batch
- integer :: tInChunk !! Timestep index for this chunk
- integer :: x !! Grid cell x index
- integer :: y !! Grid cell y index
- integer :: w ! Waterbody index
-
- ! Loop through the reaches in cell (x,y)
+ class(NetCDFOutput) :: me
+ integer :: t, tInChunk, x, y, w
+ type(Contaminant) :: cont, j_cont_outflow, j_cont_deposited, j_cont_resuspended
+ real(dp) :: C_total, C_dissolved
+ type(Result) :: r_create
+ type(Result0D) :: r
+ character(len=256) :: tr
+
+ tr = "NetCDFOutputModule%updateWater"
+
do w = 1, me%env%item%colGridCells(x,y)%item%nReaches
+
+ ! Guard: make sure 'w' fits the allocated 2nd dimension
+ if (C%netCDFWriteMode == 'end') then
+ if (allocated(me%output_water__m_contaminant)) then
+ if (w > ubound(me%output_water__m_contaminant, 2)) then
+ stop "updateWaterNetCDFOutput: w index exceeds allocated dimension"
+ end if
+ end if
+ else
+ ! Optional: in iterative mode, check against the configured w-count
+ if (w > max(1, me%w_count)) then
+ stop "updateWaterNetCDFOutput (itr): w index exceeds w_count"
+ end if
+ end if
+
associate(reach => me%env%item%colGridCells(x,y)%item%colRiverReaches(w)%item)
- ! If we're in 'write at end' mode, then store this timestep's output to the output arrays, indexed
- ! by the timestep in the current chunk (because we write the NetCDF file at the end of each chunk)
+
+ ! temp objects
+ r_create = cont%create(); if (r_create%hasCriticalError()) return
+ r_create = j_cont_outflow%create(); if (r_create%hasCriticalError()) return
+ r_create = j_cont_deposited%create(); if (r_create%hasCriticalError()) return
+ r_create = j_cont_resuspended%create(); if (r_create%hasCriticalError()) return
+
+ ! concentrations
+ cont = reach%get_m_contaminant()
+ r = cont%getConcentration(reach%volume); if (r%hasCriticalError()) then
+ call cont%finalise(); call j_cont_outflow%finalise()
+ call j_cont_deposited%finalise(); call j_cont_resuspended%finalise()
+ return
+ end if
+ if (.not. allocated(r%data)) then
+ call cont%finalise(); call j_cont_outflow%finalise()
+ call j_cont_deposited%finalise(); call j_cont_resuspended%finalise()
+ return
+ end if
+ C_total = r%getDataAsRealDP()
+ C_dissolved = merge(cont%m_dissolved / reach%volume, 0.0_dp, reach%volume > C%epsilon)
+
+ ! fluxes
+ j_cont_outflow = reach%j_contaminant_outflow
+ j_cont_deposited = reach%j_contaminant_deposition
+ j_cont_resuspended= reach%j_contaminant_resuspension
+
if (C%netCDFWriteMode == 'end') then
- me%output_water__m_nm(w,x,y,tInChunk) = sum(reach%m_np)
- me%output_water__m_transformed(w,x,y,tInChunk) = sum(reach%m_transformed)
- me%output_water__m_dissolved(w,x,y,tInChunk) = reach%m_dissolved
- me%output_water__C_nm(w,x,y,tInChunk) = sum(reach%C_np)
- me%output_water__C_transformed(w,x,y,tInChunk) = sum(reach%C_transformed)
- me%output_water__C_dissolved(w,x,y,tInChunk) = reach%C_dissolved
- me%output_water__m_nm_outflow(w,x,y,tInChunk) = sum(reach%j_nm%outflow)
- me%output_water__m_transformed_outflow(w,x,y,tInChunk) = sum(reach%j_nm_transformed%outflow)
- me%output_water__m_dissolved_outflow(w,x,y,tInChunk) = reach%j_dissolved%outflow
- me%output_water__m_nm_deposited(w,x,y,tInChunk) = sum(reach%j_nm%deposition)
- me%output_water__m_transformed_deposited(w,x,y,tInChunk) = sum(reach%j_nm_transformed%deposition)
- me%output_water__m_nm_resuspended(w,x,y,tInChunk) = sum(reach%j_nm%resuspension)
- me%output_water__m_transformed_resuspended(w,x,y,tInChunk) = sum(reach%j_nm_transformed%resuspension)
+ ! ---- form-first ----
+ me%output_water__m_contaminant(1,w,x,y,tInChunk) = sum(cont%c(:,:,FREE_CONTAMINANT))
+ me%output_water__m_contaminant(2,w,x,y,tInChunk) = sum(cont%c(:,:,ATTACHED_CONTAMINANT))
+ me%output_water__m_contaminant(3,w,x,y,tInChunk) = cont%m_dissolved
+
+ me%output_water__C_contaminant(w,x,y,tInChunk) = C_total
+ me%output_water__C_contaminant_free(w,x,y,tInChunk) = sum(cont%get_free()) / reach%volume
+ me%output_water__C_contaminant_attached(w,x,y,tInChunk)= sum(cont%get_attached())/ reach%volume
+
+ me%output_water__j_contaminant_outflow(1,w,x,y,tInChunk) = &
+ sum(j_cont_outflow%c(:,:,FREE_CONTAMINANT))
+ me%output_water__j_contaminant_outflow(2,w,x,y,tInChunk) = &
+ sum(j_cont_outflow%c(:,:,ATTACHED_CONTAMINANT))
+ me%output_water__j_contaminant_outflow(3,w,x,y,tInChunk) = j_cont_outflow%m_dissolved
+
+ me%output_water__j_contaminant_deposited(1,w,x,y,tInChunk) = &
+ sum(j_cont_deposited%c(:,:,FREE_CONTAMINANT))
+ me%output_water__j_contaminant_deposited(2,w,x,y,tInChunk) = &
+ sum(j_cont_deposited%c(:,:,ATTACHED_CONTAMINANT))
+ me%output_water__j_contaminant_deposited(3,w,x,y,tInChunk) = j_cont_deposited%m_dissolved
+
+ me%output_water__j_contaminant_resuspended(1,w,x,y,tInChunk) = &
+ sum(j_cont_resuspended%c(:,:,FREE_CONTAMINANT))
+ me%output_water__j_contaminant_resuspended(2,w,x,y,tInChunk) = &
+ sum(j_cont_resuspended%c(:,:,ATTACHED_CONTAMINANT))
+ me%output_water__j_contaminant_resuspended(3,w,x,y,tInChunk) = j_cont_resuspended%m_dissolved
+
me%output_water__m_spm(w,x,y,tInChunk) = sum(reach%m_spm)
me%output_water__C_spm(w,x,y,tInChunk) = sum(reach%C_spm)
+
if (C%includeSedimentFluxes) then
- me%output_water__m_spm_erosion(w,x,y,tInChunk) = sum(reach%j_spm%soilErosion)
+ me%output_water__m_spm_erosion(w,x,y,tInChunk) = sum(reach%j_spm%soilErosion)
me%output_water__m_spm_deposition(w,x,y,tInChunk) = sum(reach%j_spm%deposition)
- me%output_water__m_spm_resuspended(w,x,y,tInChunk) = sum(reach%j_spm%resuspension)
- me%output_water__m_spm_inflow(w,x,y,tInChunk) = sum(reach%j_spm%inflow)
- me%output_water__m_spm_outflow(w,x,y,tInChunk) = sum(reach%j_spm%outflow)
- me%output_water__m_spm_bank_erosion(w,x,y,tInChunk) = sum(reach%j_spm%bankErosion)
+ me%output_water__m_spm_resuspended(w,x,y,tInChunk)= sum(reach%j_spm%resuspension)
+ me%output_water__m_spm_inflow(w,x,y,tInChunk) = sum(reach%j_spm%inflow)
+ me%output_water__m_spm_outflow(w,x,y,tInChunk) = sum(reach%j_spm%outflow)
+ me%output_water__m_spm_bank_erosion(w,x,y,tInChunk)= sum(reach%j_spm%bankErosion)
end if
+
me%output_water__volume(w,x,y,tInChunk) = reach%volume
- me%output_water__depth(w,x,y,tInChunk) = reach%depth
- me%output_water__flow(w,x,y,tInChunk) = reach%Q%outflow / C%timeStep
- ! If we're in iterative write mode, then write straight to the NetCDF file, which is time-indexed
- ! by the whole batch, not just this chunk
+ me%output_water__depth(w,x,y,tInChunk) = reach%depth
+ me%output_water__flow(w,x,y,tInChunk) = reach%Q%outflow / C%timeStep
+
else if (C%netCDFWriteMode == 'itr') then
- call me%nc__water__m_nm%setData(sum(reach%m_np), start=[w,x,y,t])
- call me%nc__water__m_transformed%setData(sum(reach%m_transformed), start=[w,x,y,t])
- call me%nc__water__m_dissolved%setData(reach%m_dissolved, start=[w,x,y,t])
- call me%nc__water__C_nm%setData(sum(reach%C_np), start=[w,x,y,t])
- call me%nc__water__C_transformed%setData(sum(reach%C_transformed), start=[w,x,y,t])
- call me%nc__water__C_dissolved%setData(reach%C_dissolved, start=[w,x,y,t])
- call me%nc__water__m_nm_outflow%setData(sum(reach%j_nm%outflow), start=[w,x,y,t])
- call me%nc__water__m_transformed_outflow%setData(sum(reach%j_nm_transformed%outflow), start=[w,x,y,t])
- call me%nc__water__m_dissolved_outflow%setData(reach%j_dissolved%outflow, start=[w,x,y,t])
- call me%nc__water__m_nm_deposited%setData(sum(reach%j_nm%deposition), start=[w,x,y,t])
- call me%nc__water__m_transformed_deposited%setData(sum(reach%j_nm_transformed%deposition), start=[w,x,y,t])
- call me%nc__water__m_nm_resuspended%setData(sum(reach%j_nm%resuspension), start=[w,x,y,t])
- call me%nc__water__m_transformed_resuspended%setData(sum(reach%j_nm_transformed%resuspension), &
- start=[w,x,y,t])
- call me%nc__water__m_spm%setData(sum(reach%m_spm), start=[w,x,y,t])
- call me%nc__water__C_spm%setData(sum(reach%C_spm), start=[w,x,y,t])
+ call me%nc__water__m_contaminant%setData( &
+ [ sum(cont%c(:,:,FREE_CONTAMINANT)), &
+ sum(cont%c(:,:,ATTACHED_CONTAMINANT)), &
+ cont%m_dissolved ], start=[1, w, x, y, t])
+
+ call me%nc__water__C_contaminant%setData(C_total, start=[w,x,y,t])
+ call me%nc__water__C_contaminant_free%setData(sum(cont%get_free())/reach%volume, start=[w,x,y,t])
+ call me%nc__water__C_contaminant_attached%setData(sum(cont%get_attached())/reach%volume, start=[w,x,y,t])
+
+ call me%nc__water__j_contaminant_outflow%setData( &
+ [ sum(j_cont_outflow%c(:,:,FREE_CONTAMINANT)), &
+ sum(j_cont_outflow%c(:,:,ATTACHED_CONTAMINANT)), &
+ j_cont_outflow%m_dissolved ], start=[1, w, x, y, t])
+
+ call me%nc__water__j_contaminant_deposited%setData( &
+ [ sum(j_cont_deposited%c(:,:,FREE_CONTAMINANT)), &
+ sum(j_cont_deposited%c(:,:,ATTACHED_CONTAMINANT)), &
+ j_cont_deposited%m_dissolved ], start=[1, w, x, y, t])
+
+ call me%nc__water__j_contaminant_resuspended%setData( &
+ [ sum(j_cont_resuspended%c(:,:,FREE_CONTAMINANT)), &
+ sum(j_cont_resuspended%c(:,:,ATTACHED_CONTAMINANT)), &
+ j_cont_resuspended%m_dissolved ], start=[1, w, x, y, t])
+
+ call me%nc__water__m_spm%setData(sum(reach%m_spm), start=[w,x,y,t])
+ call me%nc__water__C_spm%setData(sum(reach%C_spm), start=[w,x,y,t])
+
if (C%includeSedimentFluxes) then
- call me%nc__water__m_spm_erosion%setData(sum(reach%j_spm%soilErosion), start=[w,x,y,t])
- call me%nc__water__m_spm_deposited%setData(sum(reach%j_spm%deposition), start=[w,x,y,t])
- call me%nc__water__m_spm_resuspended%setData(sum(reach%j_spm%resuspension), start=[w,x,y,t])
- call me%nc__water__m_spm_inflow%setData(sum(reach%j_spm%inflow), start=[w,x,y,t])
- call me%nc__water__m_spm_outflow%setData(sum(reach%j_spm%outflow), start=[w,x,y,t])
- call me%nc__water__m_spm_bank_erosion%setData(sum(reach%j_spm%bankErosion), start=[w,x,y,t])
- end if
+ call me%nc__water__m_spm_erosion%setData( sum(reach%j_spm%soilErosion), start=[w,x,y,t])
+ call me%nc__water__m_spm_deposited%setData( sum(reach%j_spm%deposition), start=[w,x,y,t])
+ call me%nc__water__m_spm_resuspended%setData(sum(reach%j_spm%resuspension),start=[w,x,y,t])
+ call me%nc__water__m_spm_inflow%setData( sum(reach%j_spm%inflow), start=[w,x,y,t])
+ call me%nc__water__m_spm_outflow%setData( sum(reach%j_spm%outflow), start=[w,x,y,t])
+ call me%nc__water__m_spm_bank_erosion%setData(sum(reach%j_spm%bankErosion),start=[w,x,y,t])
+ end if
+
call me%nc__water__volume%setData(reach%volume, start=[w,x,y,t])
- call me%nc__water__depth%setData(reach%depth, start=[w,x,y,t])
+ call me%nc__water__depth%setData(reach%depth, start=[w,x,y,t])
call me%nc__water__flow%setData(reach%Q%outflow / C%timeStep, start=[w,x,y,t])
end if
+
+ call cont%finalise()
+ call j_cont_outflow%finalise()
+ call j_cont_deposited%finalise()
+ call j_cont_resuspended%finalise()
end associate
end do
-
end subroutine
!> Update either the NetCDF file or write to the in-memory variables for this timestep
@@ -249,363 +309,487 @@ subroutine updateSedimentNetCDFOutput(me, t, tInChunk, x, y)
integer :: t !! Current timestep in batch
integer :: tInChunk !! Current timestep in chunk
integer :: x, y !! Grid cell indices
- integer :: w ! Waterbody index
- integer :: l ! Sediment layer index
+ integer :: w !! Waterbody index
+ integer :: l !! Sediment layer index
+ type(Contaminant) :: cont !! Contaminant object for total mass
+ type(Contaminant) :: cont_buried !! Contaminant object for buried mass
+ type(Contaminant) :: layer_cont
+ real(dp) :: C_total, C_dissolved
+ real(dp) :: C_contaminant_layers(C%nSedimentLayers)
+ type(Result) :: r_create
+ type(Result0D) :: r
+ character(len=256) :: tr
+ real(dp) :: sediment_volume !! Total water volume in sediment layers
+
+ tr = "NetCDFOutputModule%updateSediment"
+
+ ! Loop through the reaches in cell (x,y)
+ do w = 1, me%env%item%colGridCells(x,y)%item%nReaches
+
+ ! Guard: make sure 'w' fits the allocated 2nd dimension
+ if (C%netCDFWriteMode == 'end') then
+ if (allocated(me%output_sediment__m_contaminant_total)) then
+ if (w > ubound(me%output_sediment__m_contaminant_total, 2)) then
+ stop "updateSedimentNetCDFOutput: w index exceeds allocated dimension"
+ end if
+ end if
+ else
+ ! Optional: in iterative mode, check against the configured w-count
+ if (w > max(1, me%w_count)) then
+ stop "updateSedimentNetCDFOutput (itr): w index exceeds w_count"
+ end if
+ end if
+
+ associate(reach => me%env%item%colGridCells(x,y)%item%colRiverReaches(w)%item, &
+ sediment => me%env%item%colGridCells(x,y)%item%colRiverReaches(w)%item%bedSediment)
+
+ ! Init temporaries
+ r_create = cont%create(); if (r_create%hasCriticalError()) return
+ r_create = cont_buried%create(); if (r_create%hasCriticalError()) return
+
+ ! ---- total contaminant in sediment (all layers)
+ r = sediment%get_m_contaminant()
+ if (r%hasCriticalError()) then
+ call r%addToTrace(tr); call cont%finalise(); call cont_buried%finalise(); return
+ end if
+ select type (data => r%getData())
+ type is (Contaminant); cont = data
+ class default; call cont%finalise(); call cont_buried%finalise(); return
+ end select
+
+ sediment_volume = sum(sediment%V_w_by_layer())
+ if (sediment_volume <= C%epsilon) then
+ call cont%finalise(); call cont_buried%finalise(); return
+ end if
+
+ r = cont%getConcentration(sediment_volume)
+ if (r%hasCriticalError() .or. .not. allocated(r%data)) then
+ call r%addToTrace(tr); call cont%finalise(); call cont_buried%finalise(); return
+ end if
+ C_total = r%getDataAsRealDP()
+ C_dissolved = cont%m_dissolved / sediment_volume
+
+ ! ---- buried contaminant
+ r = sediment%get_m_contaminant_buried()
+ if (r%hasCriticalError()) then
+ call r%addToTrace(tr); call cont%finalise(); call cont_buried%finalise(); return
+ end if
+ select type (data => r%getData())
+ type is (Contaminant); cont_buried = data
+ class default; call cont%finalise(); call cont_buried%finalise(); return
+ end select
+
+ ! ---- layer concentrations (kg/m3 water in pore space)
+ do l = 1, C%nSedimentLayers
+ r = sediment%get_m_contaminant_l(l)
+ if (r%hasCriticalError() .or. .not. allocated(r%data)) then
+ call r%addToTrace(tr); call cont%finalise(); call cont_buried%finalise(); return
+ end if
+ select type (data => r%getData())
+ type is (Contaminant); layer_cont = data
+ class default; call cont%finalise(); call cont_buried%finalise(); return
+ end select
+ r = layer_cont%getConcentration(sediment%colBedSedimentLayers(l)%item%V_w_layer())
+ if (r%hasCriticalError() .or. .not. allocated(r%data)) then
+ call r%addToTrace(tr); call cont%finalise(); call cont_buried%finalise(); call layer_cont%finalise(); return
+ end if
+ C_contaminant_layers(l) = r%getDataAsRealDP()
+ call layer_cont%finalise()
+ end do
- ! Loop through the reaches in cell (x,y)
- do w = 1, me%env%item%colGridCells(x,y)%item%nReaches
- associate(reach => me%env%item%colGridCells(x,y)%item%colRiverReaches(w)%item)
- ! If we're in 'write at end' mode, then store this timestep's output to the output arrays, indexed
- ! by the timestep in the current chunk (because we write the NetCDF file at the end of each chunk)
if (C%netCDFWriteMode == 'end') then
- me%output_sediment__m_nm_total(w,x,y,tInChunk) = sum(reach%bedSediment%get_m_np()) &
- * reach%bedArea
- me%output_sediment__C_nm_total(w,x,y,tInChunk) = sum(reach%bedSediment%get_C_np_byMass())
- do l = 1, C%nSedimentLayers
- me%output_sediment__C_nm_layers(l,w,x,y,tInChunk) = sum(reach%bedSediment%get_C_np_l_byMass(l))
- end do
- me%output_sediment__m_nm_buried(w,x,y,tInChunk) = sum(reach%bedSediment%get_m_np_buried()) &
- * reach%bedArea
+ ! ---------- FORM-FIRST ----------
+ me%output_sediment__m_contaminant_total(1,w,x,y,tInChunk) = sum(cont%c(:,:,FREE_CONTAMINANT))
+ me%output_sediment__m_contaminant_total(2,w,x,y,tInChunk) = sum(cont%c(:,:,ATTACHED_CONTAMINANT))
+ me%output_sediment__m_contaminant_total(3,w,x,y,tInChunk) = cont%m_dissolved
+
+ me%output_sediment__C_contaminant_total(w,x,y,tInChunk) = C_total
+ me%output_sediment__C_contaminant_free(w,x,y,tInChunk) = sum(cont%get_free()) / sediment_volume
+ me%output_sediment__C_contaminant_attached(w,x,y,tInChunk)= sum(cont%get_attached())/ sediment_volume
+
+ me%output_sediment__C_contaminant_layers(1:C%nSedimentLayers, w, x, y, tInChunk) = C_contaminant_layers
+
+ me%output_sediment__m_contaminant_buried(1,w,x,y,tInChunk) = sum(cont_buried%c(:,:,FREE_CONTAMINANT))
+ me%output_sediment__m_contaminant_buried(2,w,x,y,tInChunk) = sum(cont_buried%c(:,:,ATTACHED_CONTAMINANT))
+ me%output_sediment__m_contaminant_buried(3,w,x,y,tInChunk) = cont_buried%m_dissolved
+
me%output_sediment__bed_area(w,x,y,tInChunk) = reach%bedArea
- me%output_sediment__mass(w,x,y,tInChunk) = reach%bedSediment%Mf_bed_all() * reach%bedArea
- ! If we're in iterative write mode, then write straight to the NetCDF file, which is time-indexed
- ! by the whole batch, not just this chunk
+ me%output_sediment__mass(w,x,y,tInChunk) = sediment%Mf_bed_all() * reach%bedArea
+
else if (C%netCDFWriteMode == 'itr') then
- call me%nc__sediment__m_nm_total%setData(sum(reach%bedSediment%get_m_np()) * reach%bedArea, &
- start=[w,x,y,t])
- call me%nc__sediment__C_nm_total%setData(sum(reach%bedSediment%get_C_np_byMass()), start=[w,x,y,t])
- do l = 1, C%nSedimentLayers
- call me%nc__sediment__C_nm_layers%setData(sum(reach%bedSediment%get_C_np_l_byMass(l)), &
- start=[l,w,x,y,t])
- end do
- call me%nc__sediment__m_nm_buried%setData(sum(reach%bedSediment%get_m_np_buried()) * reach%bedArea, &
- start=[w,x,y,t])
+ call me%nc__sediment__m_contaminant_total%setData( &
+ [ sum(cont%c(:,:,FREE_CONTAMINANT)), &
+ sum(cont%c(:,:,ATTACHED_CONTAMINANT)), &
+ cont%m_dissolved ], start=[1,w,x,y,t])
+
+ call me%nc__sediment__C_contaminant_total%setData(C_total, start=[w,x,y,t])
+ call me%nc__sediment__C_contaminant_free%setData( sum(cont%get_free()) / sediment_volume, start=[w,x,y,t])
+ call me%nc__sediment__C_contaminant_attached%setData(sum(cont%get_attached())/ sediment_volume, start=[w,x,y,t])
+
+ call me%nc__sediment__C_contaminant_layers%setData(C_contaminant_layers, start=[1,w,x,y,t])
+
+ call me%nc__sediment__m_contaminant_buried%setData( &
+ [ sum(cont_buried%c(:,:,FREE_CONTAMINANT)), &
+ sum(cont_buried%c(:,:,ATTACHED_CONTAMINANT)), &
+ cont_buried%m_dissolved ], start=[1,w,x,y,t])
+
call me%nc__sediment__bed_area%setData(reach%bedArea, start=[w,x,y,t])
- call me%nc__sediment__mass%setData(reach%bedSediment%Mf_bed_all() * reach%bedArea, start=[w,x,y,t])
+ call me%nc__sediment__mass%setData(sediment%Mf_bed_all() * reach%bedArea, start=[w,x,y,t])
end if
+
+ call cont%finalise()
+ call cont_buried%finalise()
end associate
end do
end subroutine
+ !> Update either the NetCDF file or the in-memory output variables on this time step
!> Update either the NetCDF file or the in-memory output variables on this time step
subroutine updateSoilNetCDFOutput(me, t, tInChunk, x, y)
class(NetCDFOutput) :: me
- integer :: t !! Timestep index for whole batch
- integer :: tInChunk !! Timestep index for this chunk
- integer :: x !! Grid cell x index
- integer :: y !! Grid cell y index
- integer :: l !! Soil layer index
-
- if (me%env%item%colGridCells(x,y)%item%nSoilProfiles > 0) then
- associate(profile => me%env%item%colGridCells(x,y)%item%colSoilProfiles(1)%item)
- ! If we're in 'write at end' mode, then store this timestep's output to the output arrays, indexed
- ! by the timestep in the current chunk (because we write the NetCDF file at the end of each chunk)
+ integer :: t, tInChunk, x, y
+ integer :: p, l
+ type(Contaminant) :: cont, cont_eroded, cont_buried
+ real(dp) :: C_total, C_dissolved
+ real(dp) :: C_contaminant_layers(C%nSoilLayers)
+ real(dp) :: C_contaminant_free_layers(C%nSoilLayers)
+ real(dp) :: C_contaminant_attached_layers(C%nSoilLayers)
+ type(Result) :: r_create
+ type(Result0D) :: r
+ character(len=256) :: tr
+ real(dp) :: profile_volume
+
+ ! lower-bound aware indices (used when writing to in-memory arrays)
+ integer :: lb4(4), ix, iy, it
+ integer :: lbL(4), lbE(4), lbB(4)
+
+ tr = "NetCDFOutputModule%updateSoil"
+
+ do p = 1, me%env%item%colGridCells(x,y)%item%nSoilProfiles
+ associate(profile => me%env%item%colGridCells(x,y)%item%colSoilProfiles(p)%item)
+
+ r_create = cont%create(); if (r_create%hasCriticalError()) return
+ r_create = cont_eroded%create(); if (r_create%hasCriticalError()) then; call cont%finalise(); return; end if
+ r_create = cont_buried%create(); if (r_create%hasCriticalError()) then
+ call cont%finalise(); call cont_eroded%finalise(); return
+ end if
+
+ cont = profile%get_m_contaminant()
+
+ profile_volume = sum([(profile%colSoilLayers(l)%item%volume, l = 1, C%nSoilLayers)])
+ if (profile_volume <= C%epsilon) then
+ call cont%finalise(); call cont_eroded%finalise(); call cont_buried%finalise(); return
+ end if
+
+ r = cont%getConcentration(profile_volume)
+ if (r%hasCriticalError() .or. .not. allocated(r%data)) then
+ call r%addToTrace(tr)
+ call cont%finalise(); call cont_eroded%finalise(); call cont_buried%finalise(); return
+ end if
+ C_total = r%getDataAsRealDP()
+ C_dissolved = cont%m_dissolved / profile_volume
+
+ cont_eroded = profile%m_contaminant_eroded
+ cont_buried = profile%m_contaminant_buried
+
+ do l = 1, C%nSoilLayers
+ r = profile%colSoilLayers(l)%item%m_contaminant%getConcentration( &
+ profile%colSoilLayers(l)%item%volume)
+ if (r%hasCriticalError() .or. .not. allocated(r%data)) then
+ call r%addToTrace(tr)
+ call cont%finalise(); call cont_eroded%finalise(); call cont_buried%finalise(); return
+ end if
+ C_contaminant_layers(l) = r%getDataAsRealDP()
+ C_contaminant_free_layers(l) = sum(profile%colSoilLayers(l)%item%m_contaminant%get_free()) &
+ / profile%colSoilLayers(l)%item%volume
+ C_contaminant_attached_layers(l) = sum(profile%colSoilLayers(l)%item%m_contaminant%get_attached()) &
+ / profile%colSoilLayers(l)%item%volume
+ end do
+
if (C%netCDFWriteMode == 'end') then
- me%output_soil__m_nm_total(x,y,tInChunk) = sum(profile%get_m_np())
- me%output_soil__m_transformed_total(x,y,tInChunk) = sum(profile%get_m_transformed())
- me%output_soil__m_dissolved_total(x,y,tInChunk) = profile%get_m_dissolved()
- me%output_soil__C_nm_total(x,y,tInChunk) = sum(profile%get_C_np())
- me%output_soil__C_transformed_total(x,y,tInChunk) = sum(profile%get_C_transformed())
- me%output_soil__C_dissolved_total(x,y,tInChunk) = profile%get_C_dissolved()
+ ! --- compute LB-aware indices once ---
+ lb4 = lbound(me%output_soil__m_contaminant_total) ! (form, x, y, t)
+ ix = lb4(2) + x - 1
+ iy = lb4(3) + y - 1
+ it = lb4(4) + tInChunk - 1
+
+ ! masses by form (form-first)
+ me%output_soil__m_contaminant_total(lb4(1) , ix, iy, it) = sum(cont%c(:,:,FREE_CONTAMINANT))
+ me%output_soil__m_contaminant_total(lb4(1) + 1, ix, iy, it) = sum(cont%c(:,:,ATTACHED_CONTAMINANT))
+ me%output_soil__m_contaminant_total(lb4(1) + 2, ix, iy, it) = cont%m_dissolved
+
+ ! total concentration
+ me%output_soil__C_contaminant_total(ix, iy, it) = C_total
+
if (C%includeSoilStateBreakdown) then
- me%output_soil__C_nm_free(x,y,tInChunk) = sum(freeNM(profile%get_C_np()))
- me%output_soil__C_transformed_free(x,y,tInChunk) = sum(freeNM(profile%get_C_transformed()))
- me%output_soil__C_nm_att(x,y,tInChunk) = sum(attachedNM(profile%get_C_np()))
- me%output_soil__C_transformed_att(x,y,tInChunk) = sum(attachedNM(profile%get_C_transformed()))
+ me%output_soil__C_contaminant_free( ix, iy, it) = sum(cont%get_free()) / profile_volume
+ me%output_soil__C_contaminant_attached(ix, iy, it) = sum(cont%get_attached()) / profile_volume
+
+ lbL = lbound(me%output_soil__C_contaminant_free_layers) ! (layer,x,y,t)
+ me%output_soil__C_contaminant_free_layers( lbL(1):lbL(1)+C%nSoilLayers-1, ix, iy, it) = &
+ C_contaminant_free_layers
+
+ lbL = lbound(me%output_soil__C_contaminant_attached_layers) ! (layer,x,y,t)
+ me%output_soil__C_contaminant_attached_layers(lbL(1):lbL(1)+C%nSoilLayers-1, ix, iy, it) = &
+ C_contaminant_attached_layers
end if
+
if (C%includeSoilLayerBreakdown) then
- do l = 1, C%nSoilLayers
- associate(layer => profile%colSoilLayers(l)%item)
- me%output_soil__C_nm_layers(l,x,y,tInChunk) = sum(layer%C_np)
- me%output_soil__C_transformed_layers(l,x,y,tInChunk) = sum(layer%C_transformed)
- me%output_soil__C_dissolved_layers(l,x,y,tInChunk) = layer%C_dissolved
- if (C%includeSoilStateBreakdown) then
- me%output_soil__C_nm_free_layers(l,x,y,tInChunk) = sum(freeNM(layer%C_np))
- me%output_soil__C_transformed_free_layers(l,x,y,tInChunk) = sum(freeNM(layer%C_transformed))
- me%output_soil__C_nm_att_layers(l,x,y,tInChunk) = sum(attachedNM(layer%C_np))
- me%output_soil__C_transformed_att_layers(l,x,y,tInChunk) = sum(attachedNM(layer%C_transformed))
- end if
- end associate
- end do
+ lbL = lbound(me%output_soil__C_contaminant_layers) ! (layer,x,y,t)
+ me%output_soil__C_contaminant_layers(lbL(1):lbL(1)+C%nSoilLayers-1, ix, iy, it) = &
+ C_contaminant_layers
end if
+
if (C%includeSoilErosionYields) then
- me%output_soil__m_soil_eroded(x,y,tInChunk) = sum(profile%erodedSediment) * profile%area
- me%output_soil__m_nm_eroded(x,y,tInChunk) = sum(profile%m_np_eroded(:,:,2))
- me%output_soil__m_transformed_eroded(x,y,tInChunk) = sum(profile%m_transformed_eroded(:,:,2))
+ me%output_soil__m_soil_eroded(ix, iy, it) = sum(profile%erodedSediment) * profile%area
+
+ lbE = lbound(me%output_soil__m_contaminant_eroded) ! (form=2,x,y,t)
+ me%output_soil__m_contaminant_eroded(lbE(1) , ix, iy, it) = sum(cont_eroded%c(:,:,FREE_CONTAMINANT))
+ me%output_soil__m_contaminant_eroded(lbE(1) + 1, ix, iy, it) = sum(cont_eroded%c(:,:,ATTACHED_CONTAMINANT))
end if
- me%output_soil__m_nm_buried(x,y,tInChunk) = sum(profile%m_np_buried)
- me%output_soil__m_transformed_buried(x,y,tInChunk) = sum(profile%m_transformed_buried)
- me%output_soil__m_dissolved_buried(x,y,tInChunk) = profile%m_dissolved_buried
- ! If we're in iterative write mode, then write straight to the NetCDF file, which is time-indexed
- ! by the whole batch, not just this chunk
+
+ lbB = lbound(me%output_soil__m_contaminant_buried) ! (form=3,x,y,t)
+ me%output_soil__m_contaminant_buried(lbB(1) , ix, iy, it) = sum(cont_buried%c(:,:,FREE_CONTAMINANT))
+ me%output_soil__m_contaminant_buried(lbB(1) + 1, ix, iy, it) = sum(cont_buried%c(:,:,ATTACHED_CONTAMINANT))
+ me%output_soil__m_contaminant_buried(lbB(1) + 2, ix, iy, it) = cont_buried%m_dissolved
+
else if (C%netCDFWriteMode == 'itr') then
- call me%nc__soil__m_nm_total%setData(sum(profile%get_m_np()), start=[x,y,t])
- call me%nc__soil__m_transformed_total%setData(sum(profile%get_m_transformed()), start=[x,y,t])
- call me%nc__soil__m_dissolved_total%setData(profile%get_m_dissolved(), start=[x,y,t])
- call me%nc__soil__C_nm_total%setData(sum(profile%get_C_np()), start=[x,y,t])
- call me%nc__soil__C_transformed_total%setData(sum(profile%get_C_transformed()), start=[x,y,t])
- call me%nc__soil__C_dissolved_total%setData(profile%get_C_dissolved(), start=[x,y,t])
+ call me%nc__soil__m_contaminant_total%setData( &
+ [ sum(cont%c(:,:,FREE_CONTAMINANT)), &
+ sum(cont%c(:,:,ATTACHED_CONTAMINANT)), &
+ cont%m_dissolved ], start=[1, x, y, t])
+
+ call me%nc__soil__C_contaminant_total%setData(C_total, start=[x, y, t])
+
if (C%includeSoilStateBreakdown) then
- call me%nc__soil__C_nm_free%setData(sum(freeNM(profile%get_C_np())), start=[x,y,t])
- call me%nc__soil__C_transformed_free%setData(sum(freeNM(profile%get_C_transformed())), start=[x,y,t])
- call me%nc__soil__C_nm_att%setData(sum(attachedNM(profile%get_C_np())), start=[x,y,t])
- call me%nc__soil__C_transformed_att%setData(sum(attachedNM(profile%get_C_transformed())), start=[x,y,t])
+ call me%nc__soil__C_contaminant_free%setData( sum(cont%get_free()) / profile_volume, start=[x,y,t])
+ call me%nc__soil__C_contaminant_attached%setData(sum(cont%get_attached())/ profile_volume, start=[x,y,t])
+ call me%nc__soil__C_contaminant_free_layers%setData( C_contaminant_free_layers, start=[1,x,y,t])
+ call me%nc__soil__C_contaminant_attached_layers%setData(C_contaminant_attached_layers, start=[1,x,y,t])
end if
+
if (C%includeSoilLayerBreakdown) then
- do l = 1, C%nSoilLayers
- associate(layer => profile%colSoilLayers(l)%item)
- call me%nc__soil__C_nm_layers%setData(sum(layer%C_np), start=[l,x,y,t])
- call me%nc__soil__C_transformed_layers%setData(sum(layer%C_transformed), start=[l,x,y,t])
- call me%nc__soil__C_dissolved_layers%setData(layer%C_dissolved, start=[l,x,y,t])
- if (C%includeSoilStateBreakdown) then
- call me%nc__soil__C_nm_free_layers%setData(sum(freeNM(layer%C_np)), start=[l,x,y,t])
- call me%nc__soil__C_transformed_free_layers%setData(sum(freeNM(layer%C_transformed)), &
- start=[l,x,y,t])
- call me%nc__soil__C_nm_att_layers%setData(sum(attachedNM(layer%C_np)), start=[l,x,y,t])
- call me%nc__soil__C_transformed_att_layers%setData(sum(attachedNM(layer%C_transformed)), &
- start=[l,x,y,t])
- end if
- end associate
- end do
+ call me%nc__soil__C_contaminant_layers%setData(C_contaminant_layers, start=[1, x, y, t])
end if
+
if (C%includeSoilErosionYields) then
- call me%nc__soil__m_soil_eroded%setData(sum(profile%erodedSediment) * profile%area, start=[x,y,t])
- call me%nc__soil__m_nm_eroded%setData(sum(profile%m_np_eroded(:,:,2)), start=[x,y,t])
- call me%nc__soil__m_transformed_eroded%setData(sum(profile%m_transformed_eroded(:,:,2)), start=[x,y,t])
+ call me%nc__soil__m_soil_eroded%setData(sum(profile%erodedSediment) * profile%area, start=[x, y, t])
+ call me%nc__soil__m_contaminant_eroded%setData( &
+ [ sum(cont_eroded%c(:,:,FREE_CONTAMINANT)), &
+ sum(cont_eroded%c(:,:,ATTACHED_CONTAMINANT)) ], start=[1, x, y, t])
end if
- call me%nc__soil__m_nm_buried%setData(sum(profile%m_np_buried), start=[x,y,t])
- call me%nc__soil__m_transformed_buried%setData(sum(profile%m_transformed_buried), start=[x,y,t])
- call me%nc__soil__m_dissolved_buried%setData(profile%m_dissolved_buried, start=[x,y,t])
+
+ call me%nc__soil__m_contaminant_buried%setData( &
+ [ sum(cont_buried%c(:,:,FREE_CONTAMINANT)), &
+ sum(cont_buried%c(:,:,ATTACHED_CONTAMINANT)), &
+ cont_buried%m_dissolved ], start=[1, x, y, t])
end if
+
+ call cont%finalise()
+ call cont_eroded%finalise()
+ call cont_buried%finalise()
end associate
- end if
+ end do
end subroutine
!> Create the NetCDF file and fill with variables and their attributes
subroutine initFileNetCDFOutput(me)
- class(NetCDFOutput) :: me !! This NetCDFOutput class
- type(datetime) :: simDatetime ! Datetime that the simulation we performed
- type(NcVariable) :: var ! NetCDF variable
- integer :: i ! Loop iterator
- integer :: t(C%nTimestepsInBatch) ! Time record dimension
- integer :: waterbodyType(DATASET%gridShape(1), DATASET%gridShape(2)) ! Waterbody type
-
- ! Create the NetCDF file
- me%nc = NcDataset(trim(C%outputPath) // 'output' // trim(C%outputHash) // '.nc', 'w')
-
- ! Metadata to describe the NetCDF file
- call me%nc%setAttribute('title', 'NanoFASE model output data: ' // trim(C%runDescription))
- call me%nc%setAttribute('source', 'NanoFASE model v' // trim(C%modelVersion) // &
- ': https://github.com/nerc-ceh/nanofase/tree/' // trim(C%modelVersion))
- simDatetime = simDatetime%now() ! Chaining functions doesn't work in Fortran...
- call me%nc%setAttribute('history', simDatetime%isoformat() // &
- ': File created and data written by NanoFASE model')
- call me%nc%setAttribute('Conventions', 'CF-1.8')
- call me%nc%setAttribute('coordinates', 'spatial_ref') ! Needed for xarray to recognise spatial_ref as a coordinate, not a variable
- call me%nc%setAttribute('acronyms', 'NM = nanomaterial; SPM = suspended particulate matter')
-
- ! Set the CRS, based on input data (we haven't changed the CRS in the model). We're calling this 'spatial_ref' because
- ! rioxarray looks for this name as default if the grid_mapping attribute isn't present, and CF conventions don't care
- ! what you call it. Interesting conversation on the topic here: https://github.com/opendatacube/datacube-core/issues/837
+ class(NetCDFOutput) :: me
+ type(datetime) :: simDatetime
+ type(NcVariable) :: var
+ integer :: i
+ integer :: t(C%nTimestepsInBatch)
+ integer :: waterbodyType(DATASET%gridShape(1), DATASET%gridShape(2))
+
+ ! Create file + metadata (unchanged) ...
+ me%nc = NcDataset(trim(C%outputPath)//'output'//trim(C%outputHash)//'.nc', 'w')
+
+ call me%nc%setAttribute('title', trim('FASE model output data: '//trim(C%runDescription)))
+ call me%nc%setAttribute('source', trim('FASE model v'//trim(C%modelVersion)// &
+ ': https://github.com/nerc-ceh/nanofase/tree/'//trim(C%modelVersion)))
+ simDatetime = simDatetime%now()
+ call me%nc%setAttribute('history', trim(simDatetime%isoformat()// &
+ ' - model run completed'))
+
+ ! Encourage xarray to treat the CRS as a coordinate (unchanged) ...
+ call me%nc%setAttribute('coordinates', 'spatial_ref')
+
+ ! CRS variable (unchanged, but attribute strings trimmed)
var = me%nc%setVariable('spatial_ref', 'i32')
- call var%setAttribute('spatial_ref', trim(DATASET%crsWKT)) ! GDAL/Arc recognises spatial_ref to define CRS
- call var%setAttribute('crs_wkt', trim(DATASET%crsWKT)) ! CF conventions recommends crs_wkt
- call var%setAttribute('epsg_code', DATASET%epsgCode) ! Not a standard, but might be useful instead of having to decipher WKT
+ call var%setAttribute('spatial_ref', trim(DATASET%crsWKT))
+ call var%setAttribute('crs_wkt', trim(DATASET%crsWKT))
+ call var%setAttribute('epsg_code', DATASET%epsgCode)
+ ! --- IMPORTANT ---
+ ! Dynamic dispatch: this calls the *derived* createDimensions()
call me%createDimensions()
- ! Create the record dimensions
+ ! Record time dimension (unchanged; with trim)
var = me%nc%setVariable('t', 'i32', [me%t_dim])
- call var%setAttribute('units', 'seconds since ' // C%batchStartDate%isoformat())
+ call var%setAttribute('units', trim('seconds since '//C%batchStartDate%isoformat()))
call var%setAttribute('standard_name', 'time')
call var%setAttribute('calendar', 'gregorian')
- ! Create an array for the time dimension
do i = 1, C%nTimeStepsInBatch
t(i) = i * C%timeStep
end do
call var%setData(t)
- ! x coordinate
+
+ ! x, y coordinates (unchanged; trim attributes)
var = me%nc%setVariable('x', 'i32', [me%x_dim])
call var%setAttribute('units', 'm')
call var%setAttribute('standard_name', 'projection_x_coordinate')
call var%setAttribute('axis', 'X')
call var%setData(DATASET%x)
- ! y coordinate
+
var = me%nc%setVariable('y', 'i32', [me%y_dim])
call var%setAttribute('units', 'm')
call var%setAttribute('standard_name', 'projection_y_coordinate')
call var%setAttribute('axis', 'Y')
call var%setData(DATASET%y)
- ! Create the variables
- ! TODO change to aggregated waterbody type
+ ! Waterbody type (unchanged; grid_mapping string trimmed)
where (DATASET%isEstuary .and. .not. DATASET%gridMask .and. DATASET%nWaterbodies > 0)
waterbodyType = 2
elsewhere (.not. DATASET%isEstuary .and. .not. DATASET%gridMask .and. DATASET%nWaterbodies > 0)
waterbodyType = 1
elsewhere
- waterbodyType = nf90_fill_int
+ waterbodyType = 0
end where
- ! Waterbody type
- me%nc__water__waterbody_type = me%nc%setVariable('waterbody_type', 'i32', [me%x_dim, me%y_dim])
- call me%nc__water__waterbody_type%setAttribute('description', '1 = river, 2 = estuary')
- call me%nc__water__waterbody_type%setAttribute('long_name', 'Type of waterbody')
+
+ me%nc__water__waterbody_type = me%nc%setVariable('water__waterbody_type', 'i32', [me%x_dim, me%y_dim])
+ call me%nc__water__waterbody_type%setAttribute('long_name', 'waterbody type (0 land, 1 river, 2 estuary)')
call me%nc__water__waterbody_type%setAttribute('grid_mapping', 'spatial_ref')
- ! Set the fill value explicitly. Though we're using the default fill value, some applications (like xarray)
- ! don't pick this up, so it's best to be explicit
call me%nc__water__waterbody_type%setAttribute('_FillValue', nf90_fill_int)
call me%nc__water__waterbody_type%setData(waterbodyType)
- ! Create the variables for water, sediment and soil
+ ! --- IMPORTANT ---
+ ! Virtual calls: the derived (aggregated) overrides will run here.
call me%initWater()
call me%initSediment()
call me%initSoil()
-
end subroutine
!> Create the variables for water
subroutine initWaterNetCDFOutput(me)
class(NetCDFOutput) :: me
- ! SPM mass and concentration
- me%nc__water__m_spm = me%nc%setVariable('water__m_spm','f64', [me%w_dim, me%x_dim, me%y_dim, me%t_dim])
+ me%contaminant_form_dim = me%nc%setDimension('contaminant_form', 3)
+ me%nc__water__m_contaminant = me%nc%setVariable('water__m_contaminant', 'f64', &
+ [me%contaminant_form_dim, me%w_dim, me%x_dim, me%y_dim, me%t_dim])
+ call me%nc__water__m_contaminant%setAttribute('units', 'kg')
+ call me%nc__water__m_contaminant%setAttribute &
+ ('long_name', 'Mass of contaminant in surface water (pristine, attached, dissolved)')
+ call me%nc__water__m_contaminant%setAttribute('grid_mapping', 'spatial_ref')
+ call me%nc__water__m_contaminant%setAttribute('_FillValue', nf90_fill_double)
+ me%nc__water__C_contaminant = me%nc%setVariable('water__C_contaminant', 'f64', &
+ [me%w_dim, me%x_dim, me%y_dim, me%t_dim])
+ call me%nc__water__C_contaminant%setAttribute('units', 'kg/m3')
+ call me%nc__water__C_contaminant%setAttribute('long_name', 'Total concentration of contaminant in surface water')
+ call me%nc__water__C_contaminant%setAttribute('grid_mapping', 'spatial_ref')
+ call me%nc__water__C_contaminant%setAttribute('_FillValue', nf90_fill_double)
+ me%nc__water__C_contaminant_free = me%nc%setVariable('water__C_contaminant_free', 'f64', &
+ [me%w_dim, me%x_dim, me%y_dim, me%t_dim])
+ call me%nc__water__C_contaminant_free%setAttribute('units', 'kg/m3')
+ call me%nc__water__C_contaminant_free%setAttribute('long_name', &
+ 'Concentration of free pristine contaminant in surface water')
+ call me%nc__water__C_contaminant_free%setAttribute('grid_mapping', 'spatial_ref')
+ call me%nc__water__C_contaminant_free%setAttribute('_FillValue', nf90_fill_double)
+ me%nc__water__C_contaminant_attached = me%nc%setVariable('water__C_contaminant_attached', 'f64', &
+ [me%w_dim, me%x_dim, me%y_dim, me%t_dim])
+ call me%nc__water__C_contaminant_attached%setAttribute('units', 'kg/m3')
+ call me%nc__water__C_contaminant_attached%setAttribute('long_name', &
+ 'Concentration of attached contaminant in surface water')
+ call me%nc__water__C_contaminant_attached%setAttribute('grid_mapping', 'spatial_ref')
+ call me%nc__water__C_contaminant_attached%setAttribute('_FillValue', nf90_fill_double)
+ me%nc__water__j_contaminant_outflow = me%nc%setVariable('water__j_contaminant_outflow', 'f64', &
+ [me%contaminant_form_dim, me%w_dim, me%x_dim, me%y_dim, me%t_dim])
+ call me%nc__water__j_contaminant_outflow%setAttribute('units', 'kg')
+ call me%nc__water__j_contaminant_outflow%setAttribute('long_name', &
+ 'Mass of contaminant outflowing downstream')
+ call me%nc__water__j_contaminant_outflow%setAttribute('grid_mapping', 'spatial_ref')
+ call me%nc__water__j_contaminant_outflow%setAttribute('_FillValue', nf90_fill_double)
+ me%nc__water__j_contaminant_deposited = me%nc%setVariable('water__j_contaminant_deposited', 'f64', &
+ [me%contaminant_form_dim, me%w_dim, me%x_dim, me%y_dim, me%t_dim])
+ call me%nc__water__j_contaminant_deposited%setAttribute('units', 'kg')
+ call me%nc__water__j_contaminant_deposited%setAttribute('long_name', &
+ 'Mass of contaminant deposited to bed sediment')
+ call me%nc__water__j_contaminant_deposited%setAttribute('grid_mapping', 'spatial_ref')
+ call me%nc__water__j_contaminant_deposited%setAttribute('_FillValue', nf90_fill_double)
+ me%nc__water__j_contaminant_resuspended = me%nc%setVariable('water__j_contaminant_resuspended', 'f64', &
+ [me%contaminant_form_dim, me%w_dim, me%x_dim, me%y_dim, me%t_dim])
+ call me%nc__water__j_contaminant_resuspended%setAttribute('units', 'kg')
+ call me%nc__water__j_contaminant_resuspended%setAttribute('long_name', &
+ 'Mass of contaminant resuspended from bed sediment')
+ call me%nc__water__j_contaminant_resuspended%setAttribute('grid_mapping', 'spatial_ref')
+ call me%nc__water__j_contaminant_resuspended%setAttribute('_FillValue', nf90_fill_double)
+ me%nc__water__m_spm = me%nc%setVariable('water__m_spm', 'f64', [me%w_dim, me%x_dim, me%y_dim, me%t_dim])
call me%nc__water__m_spm%setAttribute('units', 'kg')
- call me%nc__water__m_spm%setAttribute('long_name', 'Mass of suspended particulate matter in surface water')
+ call me%nc__water__m_spm%setAttribute('long_name', &
+ 'Mass of suspended particulate matter in surface water')
call me%nc__water__m_spm%setAttribute('grid_mapping', 'spatial_ref')
call me%nc__water__m_spm%setAttribute('_FillValue', nf90_fill_double)
- me%nc__water__C_spm = me%nc%setVariable('water__C_spm','f64', [me%w_dim, me%x_dim, me%y_dim, me%t_dim])
+ me%nc__water__C_spm = me%nc%setVariable('water__C_spm', 'f64', [me%w_dim, me%x_dim, me%y_dim, me%t_dim])
call me%nc__water__C_spm%setAttribute('units', 'kg/m3')
- call me%nc__water__C_spm%setAttribute('long_name', 'Concentration of suspended particulate matter in surface water')
+ call me%nc__water__C_spm%setAttribute('long_name', &
+ 'Concentration of suspended particulate matter in surface water')
call me%nc__water__C_spm%setAttribute('grid_mapping', 'spatial_ref')
call me%nc__water__C_spm%setAttribute('_FillValue', nf90_fill_double)
- ! NM mass
- me%nc__water__m_nm = me%nc%setVariable('water__m_nm','f64', [me%w_dim, me%x_dim, me%y_dim, me%t_dim])
- call me%nc__water__m_nm%setAttribute('units', 'kg')
- call me%nc__water__m_nm%setAttribute('long_name', 'Mass of pristine NM in surface water')
- call me%nc__water__m_nm%setAttribute('grid_mapping', 'spatial_ref')
- call me%nc__water__m_nm%setAttribute('_FillValue', nf90_fill_double)
- me%nc__water__m_transformed = me%nc%setVariable('water__m_transformed','f64', [me%w_dim, me%x_dim, me%y_dim, me%t_dim])
- call me%nc__water__m_transformed%setAttribute('units', 'kg')
- call me%nc__water__m_transformed%setAttribute('long_name', 'Mass of transformed NM in surface water')
- call me%nc__water__m_transformed%setAttribute('grid_mapping', 'spatial_ref')
- call me%nc__water__m_transformed%setAttribute('_FillValue', nf90_fill_double)
- me%nc__water__m_dissolved = me%nc%setVariable('water__m_dissolved','f64', [me%w_dim, me%x_dim, me%y_dim, me%t_dim])
- call me%nc__water__m_dissolved%setAttribute('units', 'kg')
- call me%nc__water__m_dissolved%setAttribute('long_name', 'Mass of dissolved species in surface water')
- call me%nc__water__m_dissolved%setAttribute('grid_mapping', 'spatial_ref')
- call me%nc__water__m_dissolved%setAttribute('_FillValue', nf90_fill_double)
- ! NM concentration
- me%nc__water__C_nm = me%nc%setVariable('water__C_nm','f64', [me%w_dim, me%x_dim, me%y_dim, me%t_dim])
- call me%nc__water__C_nm%setAttribute('units', 'kg/m3')
- call me%nc__water__C_nm%setAttribute('long_name', 'Concentration of pristine NM in surface water')
- call me%nc__water__C_nm%setAttribute('grid_mapping', 'spatial_ref')
- call me%nc__water__C_nm%setAttribute('_FillValue', nf90_fill_double)
- me%nc__water__C_transformed = me%nc%setVariable('water__C_transformed','f64', [me%w_dim, me%x_dim, me%y_dim, me%t_dim])
- call me%nc__water__C_transformed%setAttribute('units', 'kg/m3')
- call me%nc__water__C_transformed%setAttribute('long_name', 'Concentration of transformed NM in surface water')
- call me%nc__water__C_transformed%setAttribute('grid_mapping', 'spatial_ref')
- call me%nc__water__C_transformed%setAttribute('_FillValue', nf90_fill_double)
- me%nc__water__C_dissolved = me%nc%setVariable('water__C_dissolved','f64', [me%w_dim, me%x_dim, me%y_dim, me%t_dim])
- call me%nc__water__C_dissolved%setAttribute('units', 'kg/m3')
- call me%nc__water__C_dissolved%setAttribute('long_name', 'Concentration of dissolved species in surface water')
- call me%nc__water__C_dissolved%setAttribute('grid_mapping', 'spatial_ref')
- call me%nc__water__C_dissolved%setAttribute('_FillValue', nf90_fill_double)
- ! NM flows
- me%nc__water__m_nm_outflow = me%nc%setVariable('water__m_nm_outflow','f64', [me%w_dim, me%x_dim, me%y_dim, me%t_dim])
- call me%nc__water__m_nm_outflow%setAttribute('units', 'kg')
- call me%nc__water__m_nm_outflow%setAttribute('long_name', 'Mass of pristine NM outflowing downstream')
- call me%nc__water__m_nm_outflow%setAttribute('grid_mapping', 'spatial_ref')
- call me%nc__water__m_nm_outflow%setAttribute('_FillValue', nf90_fill_double)
- me%nc__water__m_transformed_outflow = me%nc%setVariable('water__m_transformed_outflow','f64', &
- [me%w_dim, me%x_dim, me%y_dim, me%t_dim])
- call me%nc__water__m_transformed_outflow%setAttribute('units', 'kg')
- call me%nc__water__m_transformed_outflow%setAttribute('long_name', 'Mass of transformed NM outflowing downstream')
- call me%nc__water__m_transformed_outflow%setAttribute('grid_mapping', 'spatial_ref')
- call me%nc__water__m_transformed_outflow%setAttribute('_FillValue', nf90_fill_double)
- me%nc__water__m_dissolved_outflow = me%nc%setVariable('water__m_dissolved_outflow','f64', &
- [me%w_dim, me%x_dim, me%y_dim, me%t_dim])
- call me%nc__water__m_dissolved_outflow%setAttribute('units', 'kg')
- call me%nc__water__m_dissolved_outflow%setAttribute('long_name', 'Mass of dissolved species outflowing downstream')
- call me%nc__water__m_dissolved_outflow%setAttribute('grid_mapping', 'spatial_ref')
- call me%nc__water__m_dissolved_outflow%setAttribute('_FillValue', nf90_fill_double)
- me%nc__water__m_nm_deposited = me%nc%setVariable('water__m_nm_deposited','f64', [me%w_dim, me%x_dim, me%y_dim, me%t_dim])
- call me%nc__water__m_nm_deposited%setAttribute('units', 'kg')
- call me%nc__water__m_nm_deposited%setAttribute('long_name', 'Mass of pristine NM deposited to bed sediment')
- call me%nc__water__m_nm_deposited%setAttribute('grid_mapping', 'spatial_ref')
- call me%nc__water__m_nm_deposited%setAttribute('_FillValue', nf90_fill_double)
- me%nc__water__m_transformed_deposited = me%nc%setVariable('water__m_transformed_deposited', &
- 'f64', [me%w_dim, me%x_dim, me%y_dim, me%t_dim])
- call me%nc__water__m_transformed_deposited%setAttribute('long_name', 'Mass of transformed NM deposited to bed sediment')
- call me%nc__water__m_transformed_deposited%setAttribute('units', 'kg')
- call me%nc__water__m_transformed_deposited%setAttribute('grid_mapping', 'spatial_ref')
- call me%nc__water__m_transformed_deposited%setAttribute('_FillValue', nf90_fill_double)
- me%nc__water__m_nm_resuspended = me%nc%setVariable('water__m_nm_resuspended','f64', &
- [me%w_dim, me%x_dim, me%y_dim, me%t_dim])
- call me%nc__water__m_nm_resuspended%setAttribute('units', 'kg')
- call me%nc__water__m_nm_resuspended%setAttribute('long_name', 'Mass of pristine NM resuspended from bed sediment')
- call me%nc__water__m_nm_resuspended%setAttribute('grid_mapping', 'spatial_ref')
- call me%nc__water__m_nm_resuspended%setAttribute('_FillValue', nf90_fill_double)
- me%nc__water__m_transformed_resuspended = me%nc%setVariable('water__m_transformed_resuspended', &
- 'f64', [me%w_dim, me%x_dim, me%y_dim, me%t_dim])
- call me%nc__water__m_transformed_resuspended%setAttribute('units', 'kg')
- call me%nc__water__m_transformed_resuspended%setAttribute('long_name', &
- 'Mass of transformed NM resuspended from bed sediment')
- call me%nc__water__m_transformed_resuspended%setAttribute('grid_mapping', 'spatial_ref')
- call me%nc__water__m_transformed_resuspended%setAttribute('_FillValue', nf90_fill_double)
- ! SPM flows
if (C%includeSedimentFluxes) then
- me%nc__water__m_spm_erosion = me%nc%setVariable('water__m_spm_erosion','f64', [me%w_dim, me%x_dim, me%y_dim, me%t_dim])
+ me%nc__water__m_spm_erosion = me%nc%setVariable('water__m_spm_erosion', &
+ 'f64', [me%w_dim, me%x_dim, me%y_dim, me%t_dim])
call me%nc__water__m_spm_erosion%setAttribute('units', 'kg')
- call me%nc__water__m_spm_erosion%setAttribute('long_name', 'Mass of suspended particulate matter from soil erosion')
+ call me%nc__water__m_spm_erosion%setAttribute('long_name', &
+ 'Mass of suspended particulate matter from soil erosion')
call me%nc__water__m_spm_erosion%setAttribute('grid_mapping', 'spatial_ref')
call me%nc__water__m_spm_erosion%setAttribute('_FillValue', nf90_fill_double)
- me%nc__water__m_spm_deposited = me%nc%setVariable('water__m_spm_deposited','f64', &
- [me%w_dim, me%x_dim, me%y_dim, me%t_dim])
+ me%nc__water__m_spm_deposited = me%nc%setVariable('water__m_spm_deposited', &
+ 'f64', [me%w_dim, me%x_dim, me%y_dim, me%t_dim])
call me%nc__water__m_spm_deposited%setAttribute('units', 'kg')
call me%nc__water__m_spm_deposited%setAttribute('long_name', &
- 'Mass of suspended particulate matter deposited to bed sediment')
+ 'Mass of suspended particulate matter deposited to bed sediment')
call me%nc__water__m_spm_deposited%setAttribute('grid_mapping', 'spatial_ref')
call me%nc__water__m_spm_deposited%setAttribute('_FillValue', nf90_fill_double)
- me%nc__water__m_spm_resuspended = me%nc%setVariable('water__m_spm_resuspended','f64', &
- [me%w_dim, me%x_dim, me%y_dim, me%t_dim])
+ me%nc__water__m_spm_resuspended = me%nc%setVariable('water__m_spm_resuspended', &
+ 'f64', [me%w_dim, me%x_dim, me%y_dim, me%t_dim])
call me%nc__water__m_spm_resuspended%setAttribute('units', 'kg')
call me%nc__water__m_spm_resuspended%setAttribute('long_name', &
- 'Mass of suspended particulate matter resuspended from bed sediment')
+ 'Mass of suspended particulate matter resuspended from bed sediment')
call me%nc__water__m_spm_resuspended%setAttribute('grid_mapping', 'spatial_ref')
call me%nc__water__m_spm_resuspended%setAttribute('_FillValue', nf90_fill_double)
- me%nc__water__m_spm_inflow = me%nc%setVariable('water__m_spm_inflow','f64', [me%w_dim, me%x_dim, me%y_dim, me%t_dim])
+ me%nc__water__m_spm_inflow = me%nc%setVariable('water__m_spm_inflow', &
+ 'f64', [me%w_dim, me%x_dim, me%y_dim, me%t_dim])
call me%nc__water__m_spm_inflow%setAttribute('units', 'kg')
call me%nc__water__m_spm_inflow%setAttribute('long_name', &
- 'Mass of suspended particulate matter inflowing from upstream')
+ 'Mass of suspended particulate matter inflowing from upstream')
call me%nc__water__m_spm_inflow%setAttribute('grid_mapping', 'spatial_ref')
call me%nc__water__m_spm_inflow%setAttribute('_FillValue', nf90_fill_double)
- me%nc__water__m_spm_outflow = me%nc%setVariable('water__m_spm_outflow','f64', [me%w_dim, me%x_dim, me%y_dim, me%t_dim])
+ me%nc__water__m_spm_outflow = me%nc%setVariable('water__m_spm_outflow', &
+ 'f64', [me%w_dim, me%x_dim, me%y_dim, me%t_dim])
call me%nc__water__m_spm_outflow%setAttribute('units', 'kg')
call me%nc__water__m_spm_outflow%setAttribute('long_name', &
- 'Mass of suspended particulate matter outflowing downstream')
+ 'Mass of suspended particulate matter outflowing downstream')
call me%nc__water__m_spm_outflow%setAttribute('grid_mapping', 'spatial_ref')
call me%nc__water__m_spm_outflow%setAttribute('_FillValue', nf90_fill_double)
- me%nc__water__m_spm_bank_erosion = me%nc%setVariable('water__m_spm_bank_erosion','f64', &
- [me%w_dim, me%x_dim, me%y_dim, me%t_dim])
+ me%nc__water__m_spm_bank_erosion = me%nc%setVariable('water__m_spm_bank_erosion', &
+ 'f64', [me%w_dim, me%x_dim, me%y_dim, me%t_dim])
call me%nc__water__m_spm_bank_erosion%setAttribute('units', 'kg')
call me%nc__water__m_spm_bank_erosion%setAttribute('long_name', &
- 'Mass of suspended particulate matter from bank erosion')
+ 'Mass of suspended particulate matter from bank erosion')
call me%nc__water__m_spm_bank_erosion%setAttribute('grid_mapping', 'spatial_ref')
call me%nc__water__m_spm_bank_erosion%setAttribute('_FillValue', nf90_fill_double)
end if
- ! Water
- me%nc__water__volume = me%nc%setVariable('water__volume','f64', [me%w_dim, me%x_dim, me%y_dim, me%t_dim])
+ me%nc__water__volume = me%nc%setVariable('water__volume', 'f64', [me%w_dim, me%x_dim, me%y_dim, me%t_dim])
call me%nc__water__volume%setAttribute('units', 'm3')
call me%nc__water__volume%setAttribute('long_name', 'Volume of water')
call me%nc__water__volume%setAttribute('grid_mapping', 'spatial_ref')
call me%nc__water__volume%setAttribute('_FillValue', nf90_fill_double)
- me%nc__water__depth = me%nc%setVariable('water__depth','f64', [me%w_dim, me%x_dim, me%y_dim, me%t_dim])
+ me%nc__water__depth = me%nc%setVariable('water__depth', 'f64', [me%w_dim, me%x_dim, me%y_dim, me%t_dim])
call me%nc__water__depth%setAttribute('units', 'm')
call me%nc__water__depth%setAttribute('standard_name', 'depth')
call me%nc__water__depth%setAttribute('long_name', 'Depth of water')
call me%nc__water__depth%setAttribute('grid_mapping', 'spatial_ref')
call me%nc__water__depth%setAttribute('_FillValue', nf90_fill_double)
- me%nc__water__flow = me%nc%setVariable('water__flow','f64', [me%w_dim, me%x_dim, me%y_dim, me%t_dim])
+ me%nc__water__flow = me%nc%setVariable('water__flow', 'f64', [me%w_dim, me%x_dim, me%y_dim, me%t_dim])
call me%nc__water__flow%setAttribute('units', 'm3/s')
call me%nc__water__flow%setAttribute('standard_name', 'water_volume_transport_in_river_channel')
call me%nc__water__flow%setAttribute('long_name', 'Flow of water')
@@ -617,27 +801,48 @@ subroutine initWaterNetCDFOutput(me)
subroutine initSedimentNetCDFOutput(me)
class(NetCDFOutput) :: me
- me%nc__sediment__m_nm_total = me%nc%setVariable('sediment__m_nm_total', 'f64', [me%w_dim, me%x_dim, me%y_dim, me%t_dim])
- call me%nc__sediment__m_nm_total%setAttribute('units', 'kg')
- call me%nc__sediment__m_nm_total%setAttribute('long_name', 'Mass of pristine NM in sediment')
- call me%nc__sediment__m_nm_total%setAttribute('grid_mapping', 'spatial_ref')
- call me%nc__sediment__m_nm_total%setAttribute('_FillValue', nf90_fill_double)
- me%nc__sediment__C_nm_total = me%nc%setVariable('sediment__C_nm_total', 'f64', [me%w_dim, me%x_dim, me%y_dim, me%t_dim])
- call me%nc__sediment__C_nm_total%setAttribute('units', 'kg/kg')
- call me%nc__sediment__C_nm_total%setAttribute('long_name', 'Mass concentration of pristine NM across all sediment layers')
- call me%nc__sediment__C_nm_total%setAttribute('grid_mapping', 'spatial_ref')
- call me%nc__sediment__C_nm_total%setAttribute('_FillValue', nf90_fill_double)
- me%nc__sediment__C_nm_layers = me%nc%setVariable('sediment__C_nm_layers', 'f64', &
- [me%sed_l_dim, me%w_dim, me%x_dim, me%y_dim, me%t_dim])
- call me%nc__sediment__C_nm_layers%setAttribute('units', 'kg/kg')
- call me%nc__sediment__C_nm_layers%setAttribute('long_name', 'Mass concentration of pristine NM by sediment layer')
- call me%nc__sediment__C_nm_layers%setAttribute('grid_mapping', 'spatial_ref')
- call me%nc__sediment__C_nm_layers%setAttribute('_FillValue', nf90_fill_double)
- me%nc__sediment__m_nm_buried = me%nc%setVariable('sediment__m_nm_buried', 'f64', [me%w_dim, me%x_dim, me%y_dim, me%t_dim])
- call me%nc__sediment__m_nm_buried%setAttribute('units', 'kg')
- call me%nc__sediment__m_nm_buried%setAttribute('long_name', 'Mass of pristine NM buried from sediment')
- call me%nc__sediment__m_nm_buried%setAttribute('grid_mapping', 'spatial_ref')
- call me%nc__sediment__m_nm_buried%setAttribute('_FillValue', nf90_fill_double)
+ me%nc__sediment__m_contaminant_total = me%nc%setVariable('sediment__m_contaminant_total', 'f64', &
+ [me%contaminant_form_dim, me%w_dim, me%x_dim, me%y_dim, me%t_dim])
+ call me%nc__sediment__m_contaminant_total%setAttribute('units', 'kg')
+ call me%nc__sediment__m_contaminant_total%setAttribute('long_name', &
+ 'Mass of contaminant in sediment (pristine, attached, dissolved)')
+ call me%nc__sediment__m_contaminant_total%setAttribute('grid_mapping', 'spatial_ref')
+ call me%nc__sediment__m_contaminant_total%setAttribute('_FillValue', nf90_fill_double)
+ me%nc__sediment__C_contaminant_total = me%nc%setVariable('sediment__C_contaminant_total', 'f64', &
+ [me%w_dim, me%x_dim, me%y_dim, me%t_dim])
+ call me%nc__sediment__C_contaminant_total%setAttribute('units', 'kg/kg')
+ call me%nc__sediment__C_contaminant_total%setAttribute('long_name', &
+ 'Total mass concentration of contaminant across all sediment layers')
+ call me%nc__sediment__C_contaminant_total%setAttribute('grid_mapping', 'spatial_ref')
+ call me%nc__sediment__C_contaminant_total%setAttribute('_FillValue', nf90_fill_double)
+ me%nc__sediment__C_contaminant_free = me%nc%setVariable('sediment__C_contaminant_free', 'f64', &
+ [me%w_dim, me%x_dim, me%y_dim, me%t_dim])
+ call me%nc__sediment__C_contaminant_free%setAttribute('units', 'kg/kg')
+ call me%nc__sediment__C_contaminant_free%setAttribute('long_name', &
+ 'Mass concentration of free pristine contaminant in sediment')
+ call me%nc__sediment__C_contaminant_free%setAttribute('grid_mapping', 'spatial_ref')
+ call me%nc__sediment__C_contaminant_free%setAttribute('_FillValue', nf90_fill_double)
+ me%nc__sediment__C_contaminant_attached = me%nc%setVariable('sediment__C_contaminant_attached', 'f64', &
+ [me%w_dim, me%x_dim, me%y_dim, me%t_dim])
+ call me%nc__sediment__C_contaminant_attached%setAttribute('units', 'kg/kg')
+ call me%nc__sediment__C_contaminant_attached%setAttribute('long_name', &
+ 'Mass concentration of attached contaminant in sediment')
+ call me%nc__sediment__C_contaminant_attached%setAttribute('grid_mapping', 'spatial_ref')
+ call me%nc__sediment__C_contaminant_attached%setAttribute('_FillValue', nf90_fill_double)
+ me%nc__sediment__C_contaminant_layers = me%nc%setVariable('sediment__C_contaminant_layers', 'f64', &
+ [me%sed_l_dim, me%w_dim, me%x_dim, me%y_dim, me%t_dim])
+ call me%nc__sediment__C_contaminant_layers%setAttribute('units', 'kg/kg')
+ call me%nc__sediment__C_contaminant_layers%setAttribute('long_name', &
+ 'Total mass concentration of contaminant by sediment layer')
+ call me%nc__sediment__C_contaminant_layers%setAttribute('grid_mapping', 'spatial_ref')
+ call me%nc__sediment__C_contaminant_layers%setAttribute('_FillValue', nf90_fill_double)
+ me%nc__sediment__m_contaminant_buried = me%nc%setVariable('sediment__m_contaminant_buried', 'f64', &
+ [me%contaminant_form_dim, me%w_dim, me%x_dim, me%y_dim, me%t_dim])
+ call me%nc__sediment__m_contaminant_buried%setAttribute('units', 'kg')
+ call me%nc__sediment__m_contaminant_buried%setAttribute('long_name', &
+ 'Mass of contaminant buried from sediment')
+ call me%nc__sediment__m_contaminant_buried%setAttribute('grid_mapping', 'spatial_ref')
+ call me%nc__sediment__m_contaminant_buried%setAttribute('_FillValue', nf90_fill_double)
me%nc__sediment__bed_area = me%nc%setVariable('sediment__bed_area', 'f64', [me%w_dim, me%x_dim, me%y_dim, me%t_dim])
call me%nc__sediment__bed_area%setAttribute('units', 'm2')
call me%nc__sediment__bed_area%setAttribute('long_name', 'Surface area of bed sediment')
@@ -650,161 +855,167 @@ subroutine initSedimentNetCDFOutput(me)
call me%nc__sediment__mass%setAttribute('_FillValue', nf90_fill_double)
end subroutine
+
!> Create the soil variables in the NetCDF file
subroutine initSoilNetCDFOutput(me)
+ use, intrinsic :: ieee_arithmetic
class(NetCDFOutput) :: me
- ! Land use - we can fill this now
+ type(NcDimension) :: eroded_contaminant_form_dim
+
+ ! -----------------------------
+ ! Land-use category (argmax over categories)
+ ! INPUT shape: DATASET%landUse(l, y, x)
+ ! OUTPUT shape: (x, y) integer category index
+ ! -----------------------------
+ integer, parameter :: i4 = selected_int_kind(9)
+ integer :: nx, ny, ncat, ix, iy, k, kmax
+ integer(i4), allocatable :: land_use_idx(:,:)
+ integer, parameter :: sp = kind(1.0)
+ real(sp), allocatable :: bd(:,:)
+ real(sp), allocatable :: bd_transposed(:,:)
+ integer :: i, j, ny_in, nx_in
+
+ nx = DATASET%gridShape(1)
+ ny = DATASET%gridShape(2)
+ ncat = size(DATASET%landUse, 1)
+
+ allocate(land_use_idx(nx, ny))
+ land_use_idx = 0_i4
+
+ do iy = 1, ny
+ do ix = 1, nx
+ kmax = 1
+ do k = 2, ncat
+ if (DATASET%landUse(k, iy, ix) > DATASET%landUse(kmax, iy, ix)) kmax = k
+ end do
+ land_use_idx(ix, iy) = int(kmax, kind=i4)
+ end do
+ end do
+
me%nc__soil__land_use = me%nc%setVariable('land_use', 'i32', [me%x_dim, me%y_dim])
call me%nc__soil__land_use%setAttribute('units', '-')
call me%nc__soil__land_use%setAttribute('long_name', 'Land use')
call me%nc__soil__land_use%setAttribute('grid_mapping', 'spatial_ref')
call me%nc__soil__land_use%setAttribute('category_lookup', '1: urban_no_soil. 2: urban_parks_leisure. ' // &
'3: urban_industrial_soil. 4: urban_green_residential. 5: arable. ' // &
- '6: grassland. 7: deciduous. 8: coniferous. 9: heathland. 10: water.' // &
+ '6: grassland. 7: deciduous. 8: coniferous. 9: heathland. 10: water. ' // &
'11: desert. 12/other: other')
- call me%nc__soil__land_use%setData(maxloc(DATASET%landUse(:, :, :), dim=3))
- ! Everything else - create now, fill later
- me%nc__soil__m_nm_total = me%nc%setVariable('soil__m_nm_total', 'f64', [me%x_dim, me%y_dim, me%t_dim])
- call me%nc__soil__m_nm_total%setAttribute('units', 'kg')
- call me%nc__soil__m_nm_total%setAttribute('long_name', 'Mass of pristine NM in soil')
- call me%nc__soil__m_nm_total%setAttribute('grid_mapping', 'spatial_ref')
- call me%nc__soil__m_nm_total%setAttribute('_FillValue', nf90_fill_double)
- me%nc__soil__m_transformed_total = me%nc%setVariable('soil__m_transformed_total', 'f64', [me%x_dim, me%y_dim, me%t_dim])
- call me%nc__soil__m_transformed_total%setAttribute('units', 'kg')
- call me%nc__soil__m_transformed_total%setAttribute('long_name', 'Mass of transformed NM in soil')
- call me%nc__soil__m_transformed_total%setAttribute('grid_mapping', 'spatial_ref')
- call me%nc__soil__m_transformed_total%setAttribute('_FillValue', nf90_fill_double)
- me%nc__soil__m_dissolved_total = me%nc%setVariable('soil__m_dissolved_total', 'f64', [me%x_dim, me%y_dim, me%t_dim])
- call me%nc__soil__m_dissolved_total%setAttribute('units', 'kg')
- call me%nc__soil__m_dissolved_total%setAttribute('long_name', 'Mass of dissolved species in soil')
- call me%nc__soil__m_dissolved_total%setAttribute('grid_mapping', 'spatial_ref')
- call me%nc__soil__m_dissolved_total%setAttribute('_FillValue', nf90_fill_double)
- me%nc__soil__C_nm_total = me%nc%setVariable('soil__C_nm_total', 'f64', [me%x_dim, me%y_dim, me%t_dim])
- call me%nc__soil__C_nm_total%setAttribute('units', 'kg/kg')
- call me%nc__soil__C_nm_total%setAttribute('long_name', 'Mass concentration of pristine NM in soil')
- call me%nc__soil__C_nm_total%setAttribute('grid_mapping', 'spatial_ref')
- call me%nc__soil__C_nm_total%setAttribute('_FillValue', nf90_fill_double)
- me%nc__soil__C_transformed_total = me%nc%setVariable('soil__C_transformed_total', 'f64', [me%x_dim, me%y_dim, me%t_dim])
- call me%nc__soil__C_transformed_total%setAttribute('units', 'kg/kg')
- call me%nc__soil__C_transformed_total%setAttribute('long_name', 'Mass concentration of transformed NM in soil')
- call me%nc__soil__C_transformed_total%setAttribute('grid_mapping', 'spatial_ref')
- call me%nc__soil__C_transformed_total%setAttribute('_FillValue', nf90_fill_double)
- me%nc__soil__C_dissolved_total = me%nc%setVariable('soil__C_dissolved_total', 'f64', [me%x_dim, me%y_dim, me%t_dim])
- call me%nc__soil__C_dissolved_total%setAttribute('units', 'kg/kg')
- call me%nc__soil__C_dissolved_total%setAttribute('long_name', 'Mass concentration of dissolved species in soil')
- call me%nc__soil__C_dissolved_total%setAttribute('grid_mapping', 'spatial_ref')
- call me%nc__soil__C_dissolved_total%setAttribute('_FillValue', nf90_fill_double)
+ call me%nc__soil__land_use%setData(land_use_idx)
+ deallocate(land_use_idx)
+
+ ! -----------------------------
+ ! Mass & concentration (unchanged)
+ ! -----------------------------
+ me%nc__soil__m_contaminant_total = me%nc%setVariable('soil__m_contaminant_total', 'f64', &
+ [me%contaminant_form_dim, me%x_dim, me%y_dim, me%t_dim])
+ call me%nc__soil__m_contaminant_total%setAttribute('units', 'kg')
+ call me%nc__soil__m_contaminant_total%setAttribute('long_name', &
+ 'Mass of contaminant in soil (free, attached, dissolved)')
+ call me%nc__soil__m_contaminant_total%setAttribute('grid_mapping', 'spatial_ref')
+ call me%nc__soil__m_contaminant_total%setAttribute('_FillValue', nf90_fill_double)
+
+ me%nc__soil__C_contaminant_total = me%nc%setVariable('soil__C_contaminant_total', 'f64', &
+ [me%x_dim, me%y_dim, me%t_dim])
+ call me%nc__soil__C_contaminant_total%setAttribute('units', C%soilPECUnits)
+ call me%nc__soil__C_contaminant_total%setAttribute('long_name', 'Total concentration of contaminant in soil')
+ call me%nc__soil__C_contaminant_total%setAttribute('grid_mapping', 'spatial_ref')
+ call me%nc__soil__C_contaminant_total%setAttribute('_FillValue', nf90_fill_double)
+
if (C%includeSoilStateBreakdown) then
- me%nc__soil__C_nm_free = me%nc%setVariable('soil__C_nm_free', 'f64', [me%x_dim, me%y_dim, me%t_dim])
- call me%nc__soil__C_nm_free%setAttribute('units', 'kg/kg')
- call me%nc__soil__C_nm_free%setAttribute('long_name', 'Mass concentration of free pristine NM in soil')
- call me%nc__soil__C_nm_free%setAttribute('grid_mapping', 'spatial_ref')
- call me%nc__soil__C_nm_free%setAttribute('_FillValue', nf90_fill_double)
- me%nc__soil__C_transformed_free = me%nc%setVariable('soil__C_transformed_free', 'f64', [me%x_dim, me%y_dim, me%t_dim])
- call me%nc__soil__C_transformed_free%setAttribute('units', 'kg/kg')
- call me%nc__soil__C_transformed_free%setAttribute('long_name', 'Mass concentration of free transformed NM in soil')
- call me%nc__soil__C_transformed_free%setAttribute('grid_mapping', 'spatial_ref')
- call me%nc__soil__C_transformed_free%setAttribute('_FillValue', nf90_fill_double)
- me%nc__soil__C_nm_att = me%nc%setVariable('soil__C_nm_att', 'f64', [me%x_dim, me%y_dim, me%t_dim])
- call me%nc__soil__C_nm_att%setAttribute('units', 'kg/kg')
- call me%nc__soil__C_nm_att%setAttribute('long_name', 'Mass concentration of attached pristine NM in soil')
- call me%nc__soil__C_nm_att%setAttribute('grid_mapping', 'spatial_ref')
- call me%nc__soil__C_nm_att%setAttribute('_FillValue', nf90_fill_double)
- me%nc__soil__C_transformed_att = me%nc%setVariable('soil__C_transformed_att', 'f64', [me%x_dim, me%y_dim, me%t_dim])
- call me%nc__soil__C_transformed_att%setAttribute('units', 'kg/kg')
- call me%nc__soil__C_transformed_att%setAttribute('long_name', 'Mass concentration of attached transformed NM in soil')
- call me%nc__soil__C_transformed_att%setAttribute('grid_mapping', 'spatial_ref')
- call me%nc__soil__C_transformed_att%setAttribute('_FillValue', nf90_fill_double)
+ me%nc__soil__C_contaminant_free = me%nc%setVariable('soil__C_contaminant_free', 'f64', &
+ [me%x_dim, me%y_dim, me%t_dim])
+ call me%nc__soil__C_contaminant_free%setAttribute('units', C%soilPECUnits)
+ call me%nc__soil__C_contaminant_free%setAttribute('long_name', 'Concentration of free contaminant in soil')
+ call me%nc__soil__C_contaminant_free%setAttribute('grid_mapping', 'spatial_ref')
+ call me%nc__soil__C_contaminant_free%setAttribute('_FillValue', nf90_fill_double)
+
+ me%nc__soil__C_contaminant_attached = me%nc%setVariable('soil__C_contaminant_attached', 'f64', &
+ [me%x_dim, me%y_dim, me%t_dim])
+ call me%nc__soil__C_contaminant_attached%setAttribute('units', C%soilPECUnits)
+ call me%nc__soil__C_contaminant_attached%setAttribute('long_name', 'Concentration of attached contaminant in soil')
+ call me%nc__soil__C_contaminant_attached%setAttribute('grid_mapping', 'spatial_ref')
+ call me%nc__soil__C_contaminant_attached%setAttribute('_FillValue', nf90_fill_double)
+
+ me%nc__soil__C_contaminant_free_layers = me%nc%setVariable('soil__C_contaminant_free_layers', 'f64', &
+ [me%soil_l_dim, me%x_dim, me%y_dim, me%t_dim])
+ call me%nc__soil__C_contaminant_free_layers%setAttribute('units', C%soilPECUnits)
+ call me%nc__soil__C_contaminant_free_layers%setAttribute('long_name', 'Concentration of free contaminant by soil layer')
+ call me%nc__soil__C_contaminant_free_layers%setAttribute('grid_mapping', 'spatial_ref')
+ call me%nc__soil__C_contaminant_free_layers%setAttribute('_FillValue', nf90_fill_double)
+
+ me%nc__soil__C_contaminant_attached_layers = me%nc%setVariable('soil__C_contaminant_attached_layers', 'f64', &
+ [me%soil_l_dim, me%x_dim, me%y_dim, me%t_dim])
+ call me%nc__soil__C_contaminant_attached_layers%setAttribute('units', C%soilPECUnits)
+ call me%nc__soil__C_contaminant_attached_layers%setAttribute('long_name', &
+ 'Concentration of attached contaminant by soil layer')
+ call me%nc__soil__C_contaminant_attached_layers%setAttribute('grid_mapping', 'spatial_ref')
+ call me%nc__soil__C_contaminant_attached_layers%setAttribute('_FillValue', nf90_fill_double)
end if
+
if (C%includeSoilLayerBreakdown) then
- me%nc__soil__C_nm_layers = me%nc%setVariable('soil__C_nm_layers', 'f64', [me%soil_l_dim, me%x_dim, me%y_dim, me%t_dim])
- call me%nc__soil__C_nm_layers%setAttribute('units', 'kg/kg')
- call me%nc__soil__C_nm_layers%setAttribute('long_name', 'Mass concentration of pristine NM by soil layer')
- call me%nc__soil__C_nm_layers%setAttribute('grid_mapping', 'spatial_ref')
- call me%nc__soil__C_nm_layers%setAttribute('_FillValue', nf90_fill_double)
- me%nc__soil__C_transformed_layers = me%nc%setVariable('soil__C_transformed_layers', 'f64', &
- [me%soil_l_dim, me%x_dim, me%y_dim, me%t_dim])
- call me%nc__soil__C_transformed_layers%setAttribute('units', 'kg/kg')
- call me%nc__soil__C_transformed_layers%setAttribute('long_name', 'Mass concentration of transformed NM by soil layer')
- call me%nc__soil__C_transformed_layers%setAttribute('grid_mapping', 'spatial_ref')
- call me%nc__soil__C_transformed_layers%setAttribute('_FillValue', nf90_fill_double)
- me%nc__soil__C_dissolved_layers = me%nc%setVariable('soil__C_dissolved_layers', 'f64', &
- [me%soil_l_dim, me%x_dim, me%y_dim, me%t_dim])
- call me%nc__soil__C_dissolved_layers%setAttribute('units', 'kg/kg')
- call me%nc__soil__C_dissolved_layers%setAttribute('long_name', 'Mass concentration of dissolved species by soil layer')
- call me%nc__soil__C_dissolved_layers%setAttribute('grid_mapping', 'spatial_ref')
- call me%nc__soil__C_dissolved_layers%setAttribute('_FillValue', nf90_fill_double)
- me%nc__soil__C_nm_free_layers = me%nc%setVariable('soil__C_nm_free_layers', 'f64', &
- [me%soil_l_dim, me%x_dim, me%y_dim, me%t_dim])
- if (C%includeSoilStateBreakdown) then
- call me%nc__soil__C_nm_free_layers%setAttribute('units', 'kg/kg')
- call me%nc__soil__C_nm_free_layers%setAttribute('long_name', 'Mass concentration of free pristine NM by soil layer')
- call me%nc__soil__C_nm_free_layers%setAttribute('grid_mapping', 'spatial_ref')
- call me%nc__soil__C_nm_free_layers%setAttribute('_FillValue', nf90_fill_double)
- me%nc__soil__C_transformed_free_layers = me%nc%setVariable('soil__C_transformed_free_layers', 'f64', &
- [me%soil_l_dim, me%x_dim, me%y_dim, me%t_dim])
- call me%nc__soil__C_transformed_free_layers%setAttribute('units', 'kg/kg')
- call me%nc__soil__C_transformed_free_layers%setAttribute('long_name', &
- 'Mass concentration of free transformed NM by soil layer')
- call me%nc__soil__C_transformed_free_layers%setAttribute('grid_mapping', 'spatial_ref')
- call me%nc__soil__C_transformed_free_layers%setAttribute('_FillValue', nf90_fill_double)
- me%nc__soil__C_nm_att_layers = me%nc%setVariable('soil__C_nm_att_layers', 'f64', &
- [me%soil_l_dim, me%x_dim, me%y_dim, me%t_dim])
- call me%nc__soil__C_nm_att_layers%setAttribute('units', 'kg/kg')
- call me%nc__soil__C_nm_att_layers%setAttribute('long_name', &
- 'Mass concentration of attached pristine NM by soil layer')
- call me%nc__soil__C_nm_att_layers%setAttribute('grid_mapping', 'spatial_ref')
- call me%nc__soil__C_nm_att_layers%setAttribute('_FillValue', nf90_fill_double)
- me%nc__soil__C_transformed_att_layers = me%nc%setVariable('soil__C_transformed_att_layers', 'f64', &
- [me%soil_l_dim, me%x_dim, me%y_dim, me%t_dim])
- call me%nc__soil__C_transformed_att_layers%setAttribute('units', 'kg/kg')
- call me%nc__soil__C_transformed_att_layers%setAttribute( &
- 'long_name', &
- 'Mass concentration of attached transformed NM by soil layer')
- call me%nc__soil__C_transformed_att_layers%setAttribute('grid_mapping', 'spatial_ref')
- call me%nc__soil__C_transformed_att_layers%setAttribute('_FillValue', nf90_fill_double)
- end if
+ me%nc__soil__C_contaminant_layers = me%nc%setVariable('soil__C_contaminant_layers', 'f64', &
+ [me%soil_l_dim, me%x_dim, me%y_dim, me%t_dim])
+ call me%nc__soil__C_contaminant_layers%setAttribute('units', C%soilPECUnits)
+ call me%nc__soil__C_contaminant_layers%setAttribute('long_name', 'Total concentration of contaminant by soil layer')
+ call me%nc__soil__C_contaminant_layers%setAttribute('grid_mapping', 'spatial_ref')
+ call me%nc__soil__C_contaminant_layers%setAttribute('_FillValue', nf90_fill_double)
end if
- if (C%includeSoilErosionYields) then
- me%nc__soil__m_soil_eroded = me%nc%setVariable('soil__m_soil_eroded', 'f64', [me%x_dim, me%y_dim, me%t_dim])
- call me%nc__soil__m_soil_eroded%setAttribute('units', 'kg')
- call me%nc__soil__m_soil_eroded%setAttribute('long_name', 'Mass of soil eroded')
- call me%nc__soil__m_soil_eroded%setAttribute('grid_mapping', 'spatial_ref')
- call me%nc__soil__m_soil_eroded%setAttribute('_FillValue', nf90_fill_double)
- me%nc__soil__m_nm_eroded = me%nc%setVariable('soil__m_nm_eroded', 'f64', [me%x_dim, me%y_dim, me%t_dim])
- call me%nc__soil__m_nm_eroded%setAttribute('units', 'kg')
- call me%nc__soil__m_nm_eroded%setAttribute('long_name', 'Mass of pristine NM eroded from soil')
- call me%nc__soil__m_nm_eroded%setAttribute('grid_mapping', 'spatial_ref')
- call me%nc__soil__m_nm_eroded%setAttribute('_FillValue', nf90_fill_double)
- me%nc__soil__m_transformed_eroded = me%nc%setVariable('soil__m_transformed_eroded', &
- 'f64', [me%x_dim, me%y_dim, me%t_dim])
- call me%nc__soil__m_transformed_eroded%setAttribute('units', 'kg')
- call me%nc__soil__m_transformed_eroded%setAttribute('long_name', 'Mass of transformed NM eroded from soil')
- call me%nc__soil__m_transformed_eroded%setAttribute('grid_mapping', 'spatial_ref')
- call me%nc__soil__m_transformed_eroded%setAttribute('_FillValue', nf90_fill_double)
- end if
- me%nc__soil__m_nm_buried = me%nc%setVariable('soil__m_nm_buried', 'f64', [me%x_dim, me%y_dim, me%t_dim])
- call me%nc__soil__m_nm_buried%setAttribute('units', 'kg')
- call me%nc__soil__m_nm_buried%setAttribute('long_name', 'Mass of pristine NM buried from soil')
- call me%nc__soil__m_nm_buried%setAttribute('grid_mapping', 'spatial_ref')
- call me%nc__soil__m_nm_buried%setAttribute('_FillValue', nf90_fill_double)
- me%nc__soil__m_transformed_buried = me%nc%setVariable('soil__m_transformed_buried', 'f64', [me%x_dim, me%y_dim, me%t_dim])
- call me%nc__soil__m_transformed_buried%setAttribute('units', 'kg')
- call me%nc__soil__m_transformed_buried%setAttribute('long_name', 'Mass of transformed NM buried from soil')
- call me%nc__soil__m_transformed_buried%setAttribute('grid_mapping', 'spatial_ref')
- call me%nc__soil__m_transformed_buried%setAttribute('_FillValue', nf90_fill_double)
- me%nc__soil__m_dissolved_buried = me%nc%setVariable('soil__m_dissolved_buried', 'f64', [me%x_dim, me%y_dim, me%t_dim])
- call me%nc__soil__m_dissolved_buried%setAttribute('units', 'kg')
- call me%nc__soil__m_dissolved_buried%setAttribute('long_name', 'Mass of dissolved species buried from soil')
- call me%nc__soil__m_dissolved_buried%setAttribute('grid_mapping', 'spatial_ref')
- call me%nc__soil__m_dissolved_buried%setAttribute('_FillValue', nf90_fill_double)
- ! We can also set bulk density now
- me%nc__soil__bulk_density = me%nc%setVariable('soil__bulk_density', 'f64', [me%x_dim, me%y_dim])
- call me%nc__soil__bulk_density%setAttribute('units', 'kg')
+
+ me%nc__soil__m_soil_eroded = me%nc%setVariable('soil__m_soil_eroded', 'f64', [me%x_dim, me%y_dim, me%t_dim])
+ call me%nc__soil__m_soil_eroded%setAttribute('units', 'kg')
+ call me%nc__soil__m_soil_eroded%setAttribute('long_name', 'Mass of soil eroded')
+ call me%nc__soil__m_soil_eroded%setAttribute('grid_mapping', 'spatial_ref')
+ call me%nc__soil__m_soil_eroded%setAttribute('_FillValue', nf90_fill_double)
+
+ eroded_contaminant_form_dim = me%nc%setDimension('eroded_contaminant_form', 2)
+
+ me%nc__soil__m_contaminant_eroded = me%nc%setVariable('soil__m_contaminant_eroded', 'f64', &
+ [eroded_contaminant_form_dim, me%x_dim, me%y_dim, me%t_dim])
+ call me%nc__soil__m_contaminant_eroded%setAttribute('units', 'kg')
+ call me%nc__soil__m_contaminant_eroded%setAttribute('long_name', &
+ 'Mass of contaminant eroded from soil (free, attached)')
+ call me%nc__soil__m_contaminant_eroded%setAttribute('grid_mapping', 'spatial_ref')
+ call me%nc__soil__m_contaminant_eroded%setAttribute('_FillValue', nf90_fill_double)
+
+ me%nc__soil__m_contaminant_buried = me%nc%setVariable('soil__m_contaminant_buried', 'f64', &
+ [me%contaminant_form_dim, me%x_dim, me%y_dim, me%t_dim])
+ call me%nc__soil__m_contaminant_buried%setAttribute('units', 'kg')
+ call me%nc__soil__m_contaminant_buried%setAttribute('long_name', 'Mass of contaminant buried from soil')
+ call me%nc__soil__m_contaminant_buried%setAttribute('grid_mapping', 'spatial_ref')
+ call me%nc__soil__m_contaminant_buried%setAttribute('_FillValue', nf90_fill_double)
+
+ ! -----------------------------
+ ! Bulk density (INPUT is real(4) :: soilBulkDensity(y,x))
+ ! Define NetCDF var with (y,x) to match memory layout, write as f32, and sanitize.
+ ! -----------------------------
+ ny_in = size(DATASET%soilBulkDensity, 1)
+ nx_in = size(DATASET%soilBulkDensity, 2)
+
+ ! HACK to address https://github.com/NERC-CEH/nanofase/pull/10/files#r2432863960
+ ! and https://github.com/NERC-CEH/nanofase/pull/10#issuecomment-3285937997:
+ ! Transposing soil bulk density back to (x,y) so that the order in the NetCDF file
+ ! is (y,x)
+
+ ! NetCDF var dims match the array order (y, x)
+ me%nc__soil__bulk_density = me%nc%setVariable('soil__bulk_density', 'f32', [me%x_dim, me%y_dim])
+ call me%nc__soil__bulk_density%setAttribute('units', 'kg/m3')
call me%nc__soil__bulk_density%setAttribute('long_name', 'Bulk density of the soil')
call me%nc__soil__bulk_density%setAttribute('grid_mapping', 'spatial_ref')
- call me%nc__soil__bulk_density%setAttribute('_FillValue', nf90_fill_double)
- call me%nc__soil__bulk_density%setData(DATASET%soilBulkDensity)
+
+ allocate(bd(nx_in, ny_in))
+ allocate(bd_transposed(ny_in, nx_in))
+ bd = real(DATASET%soilBulkDensity, kind=sp)
+
+ do j = 1, nx_in
+ do i = 1, ny_in
+ if (.not. ieee_is_finite(bd(i,j))) bd(i,j) = 0.0_sp
+ if (bd(i,j) < 0.0_sp) bd(i,j) = 0.0_sp
+ if (abs(bd(i,j)) < 1.0e-30_sp) bd(i,j) = 0.0_sp ! squash denormals
+ end do
+ end do
+
+ bd_transposed = transpose(bd)
+ call me%nc__soil__bulk_density%setData(bd_transposed)
end subroutine
subroutine createDimensionsNetCDFOutput(me)
@@ -815,100 +1026,168 @@ subroutine createDimensionsNetCDFOutput(me)
me%y_dim = me%nc%setDimension('y', DATASET%gridShape(2))
me%sed_l_dim = me%nc%setDimension('sed_l', C%nSedimentLayers)
me%soil_l_dim = me%nc%setDimension('soil_l', C%nSoilLayers)
- me%w_dim = me%nc%setDimension('w', 7)
+ ! Size 'w' to the actual maximum number of reaches in the environment
+ me%w_dim = me%nc%setDimension('w', max(1, me%w_count))
end subroutine
!> Allocate space for the in-memory output variables and fill with NetCDF fill value.
!! Only call this if we're in iterative write mode.
subroutine allocateVariablesNetCDFOutput(me, k)
- class(NetCDFOutput) :: me
- integer :: k
- real(dp), allocatable :: empty2DArray(:,:)
- real(dp), allocatable :: empty3DArray(:,:,:)
- real(dp), allocatable :: empty4DArray(:,:,:,:)
- real(dp), allocatable :: empty4DArraySoil(:,:,:,:)
- real(dp), allocatable :: empty5DArray(:,:,:,:,:)
- ! Allocate the empty array to be the current size for this chunk
- allocate(empty2DArray(DATASET%gridShape(1), DATASET%gridShape(2)))
- allocate(empty3DArray(DATASET%gridShape(1), DATASET%gridShape(2), C%batchNTimesteps(k)))
- allocate(empty4DArray(7, DATASET%gridShape(1), DATASET%gridShape(2), C%batchNTimesteps(k)))
- allocate(empty4DArraySoil(C%nSoilLayers, DATASET%gridShape(1), &
- DATASET%gridShape(2), C%batchNTimesteps(k)))
- allocate(empty5DArray(C%nSedimentLayers, 7, DATASET%gridShape(1), &
- DATASET%gridShape(2), C%batchNTimesteps(k)))
- ! Allocate all water output variables to the correct shape, and fill with the NetCDF fill value
- empty2DArray = nf90_fill_double
- empty3DArray = nf90_fill_double
- empty4DArray = nf90_fill_double
- empty4DArraySoil = nf90_fill_double
- empty5DArray = nf90_fill_double
- allocate(me%output_water__m_nm, source=empty4DArray)
- allocate(me%output_water__m_transformed, source=empty4DArray)
- allocate(me%output_water__m_dissolved, source=empty4DArray)
- allocate(me%output_water__C_nm, source=empty4DArray)
- allocate(me%output_water__C_transformed, source=empty4DArray)
- allocate(me%output_water__C_dissolved, source=empty4DArray)
- allocate(me%output_water__m_nm_outflow, source=empty4DArray)
- allocate(me%output_water__m_transformed_outflow, source=empty4DArray)
- allocate(me%output_water__m_dissolved_outflow, source=empty4DArray)
- allocate(me%output_water__m_nm_deposited, source=empty4DArray)
- allocate(me%output_water__m_transformed_deposited, source=empty4DArray)
- allocate(me%output_water__m_nm_resuspended, source=empty4DArray)
- allocate(me%output_water__m_transformed_resuspended, source=empty4DArray)
- allocate(me%output_water__m_spm, source=empty4DArray)
- allocate(me%output_water__C_spm, source=empty4DArray)
+ class(NetCDFOutput) :: me
+ integer :: k
+ integer :: nx, ny, nt, nw, nls, nld
+
+ nx = DATASET%gridShape(1)
+ ny = DATASET%gridShape(2)
+ nt = C%batchNTimesteps(k)
+ ! FIX: dynamic 'nw' (was 7)
+ nw = max(1, me%w_count)
+ nls = C%nSoilLayers
+ nld = C%nSedimentLayers
+
+ ! ===== DEBUG/SANITY =====
+ if (nt <= 0) then
+ write(*,*) 'allocateVariablesNetCDFOutput: nt <= 0 for chunk k=', k, &
+ ' C%batchNTimesteps(k)=', nt
+ stop 2
+ end if
+ write(*,*) 'DEBUG allocateVariablesNetCDFOutput: k=', k, ' nx=', nx, ' ny=', ny, ' nt=', nt, ' nw=', nw
+ ! ========================
+
+ ! --------------------------
+ ! WATER (form, w, x, y, t)
+ ! --------------------------
+ allocate(me%output_water__waterbody_type(1:nx, 1:ny))
+ me%output_water__waterbody_type = nf90_fill_double
+
+ allocate(me%output_water__m_contaminant(1:3, 1:nw, 1:nx, 1:ny, 1:nt))
+ me%output_water__m_contaminant = nf90_fill_double
+
+ allocate(me%output_water__C_contaminant(1:nw, 1:nx, 1:ny, 1:nt))
+ me%output_water__C_contaminant = nf90_fill_double
+
+ allocate(me%output_water__C_contaminant_free(1:nw, 1:nx, 1:ny, 1:nt))
+ me%output_water__C_contaminant_free = nf90_fill_double
+
+ allocate(me%output_water__C_contaminant_attached(1:nw, 1:nx, 1:ny, 1:nt))
+ me%output_water__C_contaminant_attached = nf90_fill_double
+
+ allocate(me%output_water__j_contaminant_outflow(1:3, 1:nw, 1:nx, 1:ny, 1:nt))
+ me%output_water__j_contaminant_outflow = nf90_fill_double
+
+ allocate(me%output_water__j_contaminant_deposited(1:3, 1:nw, 1:nx, 1:ny, 1:nt))
+ me%output_water__j_contaminant_deposited = nf90_fill_double
+
+ allocate(me%output_water__j_contaminant_resuspended(1:3, 1:nw, 1:nx, 1:ny, 1:nt))
+ me%output_water__j_contaminant_resuspended = nf90_fill_double
+
+ allocate(me%output_water__m_spm(1:nw, 1:nx, 1:ny, 1:nt))
+ me%output_water__m_spm = nf90_fill_double
+
+ allocate(me%output_water__C_spm(1:nw, 1:nx, 1:ny, 1:nt))
+ me%output_water__C_spm = nf90_fill_double
+
if (C%includeSedimentFluxes) then
- allocate(me%output_water__m_spm_erosion, source=empty4DArray)
- allocate(me%output_water__m_spm_deposition, source=empty4DArray)
- allocate(me%output_water__m_spm_resuspended, source=empty4DArray)
- allocate(me%output_water__m_spm_inflow, source=empty4DArray)
- allocate(me%output_water__m_spm_outflow, source=empty4DArray)
- allocate(me%output_water__m_spm_bank_erosion, source=empty4DArray)
+ allocate(me%output_water__m_spm_erosion(1:nw, 1:nx, 1:ny, 1:nt))
+ me%output_water__m_spm_erosion = nf90_fill_double
+
+ allocate(me%output_water__m_spm_deposition(1:nw, 1:nx, 1:ny, 1:nt))
+ me%output_water__m_spm_deposition = nf90_fill_double
+
+ allocate(me%output_water__m_spm_resuspended(1:nw, 1:nx, 1:ny, 1:nt))
+ me%output_water__m_spm_resuspended = nf90_fill_double
+
+ allocate(me%output_water__m_spm_inflow(1:nw, 1:nx, 1:ny, 1:nt))
+ me%output_water__m_spm_inflow = nf90_fill_double
+
+ allocate(me%output_water__m_spm_outflow(1:nw, 1:nx, 1:ny, 1:nt))
+ me%output_water__m_spm_outflow = nf90_fill_double
+
+ allocate(me%output_water__m_spm_bank_erosion(1:nw, 1:nx, 1:ny, 1:nt))
+ me%output_water__m_spm_bank_erosion = nf90_fill_double
end if
- allocate(me%output_water__volume, source=empty4DArray)
- allocate(me%output_water__depth, source=empty4DArray)
- allocate(me%output_water__flow, source=empty4DArray)
- ! Allocate the sediment variables and fill with the NetCDF fill value
- allocate(me%output_sediment__m_nm_total, source=empty4DArray)
- allocate(me%output_sediment__C_nm_total, source=empty4DArray)
- allocate(me%output_sediment__C_nm_layers, source=empty5DArray)
- allocate(me%output_sediment__m_nm_buried, source=empty4DArray)
- allocate(me%output_sediment__bed_area, source=empty4DArray)
- allocate(me%output_sediment__mass, source=empty4DArray)
- ! Allocate the sediment variables and fill with NetCDF fill value
- allocate(me%output_soil__land_use, source=empty2DArray)
- allocate(me%output_soil__m_nm_total, source=empty3DArray)
- allocate(me%output_soil__m_transformed_total, source=empty3DArray)
- allocate(me%output_soil__m_dissolved_total, source=empty3DArray)
- allocate(me%output_soil__C_nm_total, source=empty3DArray)
- allocate(me%output_soil__C_transformed_total, source=empty3DArray)
- allocate(me%output_soil__C_dissolved_total, source=empty3DArray)
+
+ allocate(me%output_water__volume(1:nw, 1:nx, 1:ny, 1:nt))
+ me%output_water__volume = nf90_fill_double
+
+ allocate(me%output_water__depth(1:nw, 1:nx, 1:ny, 1:nt))
+ me%output_water__depth = nf90_fill_double
+
+ allocate(me%output_water__flow(1:nw, 1:nx, 1:ny, 1:nt))
+ me%output_water__flow = nf90_fill_double
+
+ ! --------------------------
+ ! SEDIMENT (form-first; layers-first)
+ ! --------------------------
+ allocate(me%output_sediment__m_contaminant_total(1:3, 1:nw, 1:nx, 1:ny, 1:nt))
+ me%output_sediment__m_contaminant_total = nf90_fill_double
+
+ allocate(me%output_sediment__C_contaminant_total(1:nw, 1:nx, 1:ny, 1:nt))
+ me%output_sediment__C_contaminant_total = nf90_fill_double
+
+ allocate(me%output_sediment__C_contaminant_free(1:nw, 1:nx, 1:ny, 1:nt))
+ me%output_sediment__C_contaminant_free = nf90_fill_double
+
+ allocate(me%output_sediment__C_contaminant_attached(1:nw, 1:nx, 1:ny, 1:nt))
+ me%output_sediment__C_contaminant_attached = nf90_fill_double
+
+ allocate(me%output_sediment__C_contaminant_layers(1:nld, 1:nw, 1:nx, 1:ny, 1:nt))
+ me%output_sediment__C_contaminant_layers = nf90_fill_double
+
+ allocate(me%output_sediment__m_contaminant_buried(1:3, 1:nw, 1:nx, 1:ny, 1:nt))
+ me%output_sediment__m_contaminant_buried = nf90_fill_double
+
+ allocate(me%output_sediment__bed_area(1:nw, 1:nx, 1:ny, 1:nt))
+ me%output_sediment__bed_area = nf90_fill_double
+
+ allocate(me%output_sediment__mass(1:nw, 1:nx, 1:ny, 1:nt))
+ me%output_sediment__mass = nf90_fill_double
+
+ ! --------------------------
+ ! SOIL (form-first; layers-first)
+ ! --------------------------
+ allocate(me%output_soil__land_use(1:nx, 1:ny))
+ me%output_soil__land_use = nf90_fill_double
+
+ ! *** THIS WAS THE ISSUE: ensure (form, x, y, t) ***
+ allocate(me%output_soil__m_contaminant_total(1:3, 1:nx, 1:ny, 1:nt))
+ me%output_soil__m_contaminant_total = nf90_fill_double
+
+ allocate(me%output_soil__C_contaminant_total(1:nx, 1:ny, 1:nt))
+ me%output_soil__C_contaminant_total = nf90_fill_double
+
if (C%includeSoilStateBreakdown) then
- allocate(me%output_soil__C_nm_free, source=empty3DArray)
- allocate(me%output_soil__C_transformed_free, source=empty3DArray)
- allocate(me%output_soil__C_nm_att, source=empty3DArray)
- allocate(me%output_soil__C_transformed_att, source=empty3DArray)
+ allocate(me%output_soil__C_contaminant_free(1:nx, 1:ny, 1:nt))
+ me%output_soil__C_contaminant_free = nf90_fill_double
+
+ allocate(me%output_soil__C_contaminant_attached(1:nx, 1:ny, 1:nt))
+ me%output_soil__C_contaminant_attached = nf90_fill_double
+
+ allocate(me%output_soil__C_contaminant_free_layers(1:nls, 1:nx, 1:ny, 1:nt))
+ me%output_soil__C_contaminant_free_layers = nf90_fill_double
+
+ allocate(me%output_soil__C_contaminant_attached_layers(1:nls, 1:nx, 1:ny, 1:nt))
+ me%output_soil__C_contaminant_attached_layers = nf90_fill_double
end if
+
if (C%includeSoilLayerBreakdown) then
- allocate(me%output_soil__C_nm_layers, source=empty4DArraySoil)
- allocate(me%output_soil__C_transformed_layers, source=empty4DArraySoil)
- allocate(me%output_soil__C_dissolved_layers, source=empty4DArraySoil)
- if (C%includeSoilStateBreakdown) then
- allocate(me%output_soil__C_nm_free_layers, source=empty4DArraySoil)
- allocate(me%output_soil__C_transformed_free_layers, source=empty4DArraySoil)
- allocate(me%output_soil__C_nm_att_layers, source=empty4DArraySoil)
- allocate(me%output_soil__C_transformed_att_layers, source=empty4DArraySoil)
- end if
+ allocate(me%output_soil__C_contaminant_layers(1:nls, 1:nx, 1:ny, 1:nt))
+ me%output_soil__C_contaminant_layers = nf90_fill_double
end if
+
if (C%includeSoilErosionYields) then
- allocate(me%output_soil__m_soil_eroded, source=empty3DArray)
- allocate(me%output_soil__m_nm_eroded, source=empty3DArray)
- allocate(me%output_soil__m_transformed_eroded, source=empty3DArray)
+ allocate(me%output_soil__m_soil_eroded(1:nx, 1:ny, 1:nt))
+ me%output_soil__m_soil_eroded = nf90_fill_double
+
+ allocate(me%output_soil__m_contaminant_eroded(1:2, 1:nx, 1:ny, 1:nt))
+ me%output_soil__m_contaminant_eroded = nf90_fill_double
end if
- allocate(me%output_soil__m_nm_buried, source=empty3DArray)
- allocate(me%output_soil__m_transformed_buried, source=empty3DArray)
- allocate(me%output_soil__m_dissolved_buried, source=empty3DArray)
- allocate(me%output_soil__bulk_density, source=empty2DArray)
+
+ allocate(me%output_soil__m_contaminant_buried(1:3, 1:nx, 1:ny, 1:nt))
+ me%output_soil__m_contaminant_buried = nf90_fill_double
+
+ allocate(me%output_soil__bulk_density(1:nx, 1:ny))
+ me%output_soil__bulk_density = nf90_fill_double
end subroutine
!> Reallocate output variable memory for a new chunk. This subroutine should
@@ -924,140 +1203,94 @@ subroutine newChunkNetCDFOutput(me, k)
!> Write the output variables to the NetCDF file. This subroutine should be called
!! at the end of a chunk if we're in write-at-end mode and writing to a NetCDF file
subroutine finaliseChunkNetCDFOutput(me, tStart)
- class(NetCDFOutput) :: me !! This NetCDF output class
- integer :: tStart !! Timestep index at the start of this chunk
- ! Write the data from this chunk to the NetCDF file, water first
- call me%nc__water__m_nm%setData(me%output_water__m_nm, start=[1,1,1,tStart])
- call me%nc__water__m_transformed%setData(me%output_water__m_transformed, start=[1,1,1,tStart])
- call me%nc__water__m_dissolved%setData(me%output_water__m_dissolved, start=[1,1,1,tStart])
- call me%nc__water__C_nm%setData(me%output_water__C_nm, start=[1,1,1,tStart])
- call me%nc__water__C_transformed%setData(me%output_water__C_transformed, start=[1,1,1,tStart])
- call me%nc__water__C_dissolved%setData(me%output_water__C_dissolved, start=[1,1,1,tStart])
- call me%nc__water__m_nm_outflow%setData(me%output_water__m_nm_outflow, start=[1,1,1,tStart])
- call me%nc__water__m_transformed_outflow%setData(me%output_water__m_transformed_outflow, start=[1,1,1,tStart])
- call me%nc__water__m_dissolved_outflow%setData(me%output_water__m_dissolved_outflow, start=[1,1,1,tStart])
- call me%nc__water__m_nm_deposited%setData(me%output_water__m_nm_deposited, start=[1,1,1,tStart])
- call me%nc__water__m_transformed_deposited%setData(me%output_water__m_transformed_deposited, start=[1,1,1,tStart])
- call me%nc__water__m_nm_resuspended%setData(me%output_water__m_nm_resuspended, start=[1,1,1,tStart])
- call me%nc__water__m_transformed_resuspended%setData(me%output_water__m_transformed_resuspended, start=[1,1,1,tStart])
- call me%nc__water__m_spm%setData(me%output_water__m_spm, start=[1,1,1,tStart])
- call me%nc__water__C_spm%setData(me%output_water__C_spm, start=[1,1,1,tStart])
- if (C%includeSedimentFluxes) then
- call me%nc__water__m_spm_erosion%setData(me%output_water__m_spm_erosion, start=[1,1,1,tStart])
- call me%nc__water__m_spm_deposited%setData(me%output_water__m_spm_deposition, start=[1,1,1,tStart])
- call me%nc__water__m_spm_resuspended%setData(me%output_water__m_spm_resuspended, start=[1,1,1,tStart])
- call me%nc__water__m_spm_inflow%setData(me%output_water__m_spm_inflow, start=[1,1,1,tStart])
- call me%nc__water__m_spm_outflow%setData(me%output_water__m_spm_outflow, start=[1,1,1,tStart])
- call me%nc__water__m_spm_bank_erosion%setData(me%output_water__m_spm_bank_erosion, start=[1,1,1,tStart])
- end if
- call me%nc__water__volume%setData(me%output_water__volume, start=[1,1,1,tStart])
- call me%nc__water__depth%setData(me%output_water__depth, start=[1,1,1,tStart])
- call me%nc__water__flow%setData(me%output_water__flow, start=[1,1,1,tStart])
- ! Sediment
- call me%nc__sediment__m_nm_total%setData(me%output_sediment__m_nm_total, start=[1,1,1,tStart])
- call me%nc__sediment__C_nm_total%setData(me%output_sediment__C_nm_total, start=[1,1,1,tStart])
- call me%nc__sediment__C_nm_layers%setData(me%output_sediment__C_nm_layers, start=[1,1,1,1,tStart])
- call me%nc__sediment__m_nm_buried%setData(me%output_sediment__m_nm_buried, start=[1,1,1,tStart])
- call me%nc__sediment__bed_area%setData(me%output_sediment__bed_area, start=[1,1,1,tStart])
- call me%nc__sediment__mass%setData(me%output_sediment__mass, start=[1,1,1,tStart])
- ! Soil
- call me%nc__soil__m_nm_total%setData(me%output_soil__m_nm_total, start=[1,1,tStart])
- call me%nc__soil__m_transformed_total%setData(me%output_soil__m_transformed_total, start=[1,1,tStart])
- call me%nc__soil__m_dissolved_total%setData(me%output_soil__m_dissolved_total, start=[1,1,tStart])
- call me%nc__soil__C_nm_total%setData(me%output_soil__C_nm_total, start=[1,1,tStart])
- call me%nc__soil__C_transformed_total%setData(me%output_soil__C_transformed_total, start=[1,1,tStart])
- call me%nc__soil__C_dissolved_total%setData(me%output_soil__C_dissolved_total, start=[1,1,tStart])
- if (C%includeSoilStateBreakdown) then
- call me%nc__soil__C_nm_free%setData(me%output_soil__C_nm_free, start=[1,1,tStart])
- call me%nc__soil__C_transformed_free%setData(me%output_soil__C_transformed_free, start=[1,1,tStart])
- call me%nc__soil__C_nm_att%setData(me%output_soil__C_nm_att, start=[1,1,tStart])
- call me%nc__soil__C_transformed_att%setData(me%output_soil__C_transformed_att, start=[1,1,tStart])
- end if
- if (C%includeSoilLayerBreakdown) then
- call me%nc__soil__C_nm_layers%setData(me%output_soil__C_nm_layers, start=[1,1,1,tStart])
- call me%nc__soil__C_transformed_layers%setData(me%output_soil__C_transformed_layers, start=[1,1,1,tStart])
- call me%nc__soil__C_dissolved_layers%setData(me%output_soil__C_dissolved_layers, start=[1,1,1,tStart])
- if (C%includeSoilStateBreakdown) then
- call me%nc__soil__C_nm_free_layers%setData(me%output_soil__C_nm_free_layers, start=[1,1,1,tStart])
- call me%nc__soil__C_transformed_free_layers%setData(me%output_soil__C_transformed_free_layers, start=[1,1,1,tStart])
- call me%nc__soil__C_nm_att_layers%setData(me%output_soil__C_nm_att_layers, start=[1,1,1,tStart])
- call me%nc__soil__C_transformed_att_layers%setData(me%output_soil__C_transformed_att_layers, start=[1,1,1,tStart])
- end if
- end if
- if (C%includeSoilErosionYields) then
- call me%nc__soil__m_soil_eroded%setData(me%output_soil__m_soil_eroded, start=[1,1,tStart])
- call me%nc__soil__m_nm_eroded%setData(me%output_soil__m_nm_eroded, start=[1,1,tStart])
- call me%nc__soil__m_transformed_eroded%setData(me%output_soil__m_transformed_eroded, start=[1,1,tStart])
- end if
- call me%nc__soil__m_nm_buried%setData(me%output_soil__m_nm_buried, start=[1,1,tStart])
- call me%nc__soil__m_transformed_buried%setData(me%output_soil__m_transformed_buried, start=[1,1,tStart])
- call me%nc__soil__m_dissolved_buried%setData(me%output_soil__m_dissolved_buried, start=[1,1,tStart])
- ! Deallocate the output variables
- deallocate(me%output_water__m_nm)
- deallocate(me%output_water__m_transformed)
- deallocate(me%output_water__m_dissolved)
- deallocate(me%output_water__C_nm)
- deallocate(me%output_water__C_transformed)
- deallocate(me%output_water__C_dissolved)
- deallocate(me%output_water__m_nm_outflow)
- deallocate(me%output_water__m_transformed_outflow)
- deallocate(me%output_water__m_dissolved_outflow)
- deallocate(me%output_water__m_nm_deposited)
- deallocate(me%output_water__m_transformed_deposited)
- deallocate(me%output_water__m_nm_resuspended)
- deallocate(me%output_water__m_transformed_resuspended)
- deallocate(me%output_water__m_spm)
- deallocate(me%output_water__C_spm)
+ class(NetCDFOutput) :: me
+ integer :: tStart
+
+ call me%nc__water__m_contaminant%setData( me%output_water__m_contaminant, start=[1,1,1,1,tStart])
+ call me%nc__water__C_contaminant%setData( me%output_water__C_contaminant, start=[1,1,1,tStart])
+ call me%nc__water__j_contaminant_outflow%setData(me%output_water__j_contaminant_outflow,start=[1,1,1,1,tStart])
+ call me%nc__water__j_contaminant_deposited%setData(me%output_water__j_contaminant_deposited,start=[1,1,1,1,tStart])
+ call me%nc__water__j_contaminant_resuspended%setData(me%output_water__j_contaminant_resuspended,start=[1,1,1,1,tStart])
+ call me%nc__water__m_spm%setData( me%output_water__m_spm, start=[1,1,1,tStart])
+ call me%nc__water__C_spm%setData( me%output_water__C_spm, start=[1,1,1,tStart])
+
if (C%includeSedimentFluxes) then
- deallocate(me%output_water__m_spm_erosion)
- deallocate(me%output_water__m_spm_deposition)
- deallocate(me%output_water__m_spm_resuspended)
- deallocate(me%output_water__m_spm_inflow)
- deallocate(me%output_water__m_spm_outflow)
- deallocate(me%output_water__m_spm_bank_erosion)
- end if
- deallocate(me%output_water__volume)
- deallocate(me%output_water__depth)
- deallocate(me%output_water__flow)
- deallocate(me%output_sediment__m_nm_total)
- deallocate(me%output_sediment__C_nm_total)
- deallocate(me%output_sediment__C_nm_layers)
- deallocate(me%output_sediment__m_nm_buried)
- deallocate(me%output_sediment__bed_area)
- deallocate(me%output_sediment__mass)
- deallocate(me%output_soil__land_use)
- deallocate(me%output_soil__m_nm_total)
- deallocate(me%output_soil__m_transformed_total)
- deallocate(me%output_soil__m_dissolved_total)
- deallocate(me%output_soil__C_nm_total)
- deallocate(me%output_soil__C_transformed_total)
- deallocate(me%output_soil__C_dissolved_total)
- if (C%includeSoilStateBreakdown) then
- deallocate(me%output_soil__C_nm_free)
- deallocate(me%output_soil__C_transformed_free)
- deallocate(me%output_soil__C_nm_att)
- deallocate(me%output_soil__C_transformed_att)
+ call me%nc__water__m_spm_erosion%setData( me%output_water__m_spm_erosion, start=[1,1,1,tStart])
+ call me%nc__water__m_spm_deposited%setData( me%output_water__m_spm_deposition, start=[1,1,1,tStart])
+ call me%nc__water__m_spm_resuspended%setData(me%output_water__m_spm_resuspended, start=[1,1,1,tStart])
+ call me%nc__water__m_spm_inflow%setData( me%output_water__m_spm_inflow, start=[1,1,1,tStart])
+ call me%nc__water__m_spm_outflow%setData( me%output_water__m_spm_outflow, start=[1,1,1,tStart])
+ call me%nc__water__m_spm_bank_erosion%setData(me%output_water__m_spm_bank_erosion,start=[1,1,1,tStart])
end if
- if (C%includeSoilLayerBreakdown) then
- deallocate(me%output_soil__C_nm_layers)
- deallocate(me%output_soil__C_transformed_layers)
- deallocate(me%output_soil__C_dissolved_layers)
- if (C%includeSoilStateBreakdown) then
- deallocate(me%output_soil__C_nm_free_layers)
- deallocate(me%output_soil__C_transformed_free_layers)
- deallocate(me%output_soil__C_nm_att_layers)
- deallocate(me%output_soil__C_transformed_att_layers)
- end if
+
+ call me%nc__water__volume%setData( me%output_water__volume, start=[1,1,1,tStart])
+ call me%nc__water__depth%setData( me%output_water__depth, start=[1,1,1,tStart])
+ call me%nc__water__flow%setData( me%output_water__flow, start=[1,1,1,tStart])
+
+ call me%nc__sediment__m_contaminant_total%setData(me%output_sediment__m_contaminant_total, start=[1,1,1,1,tStart])
+ call me%nc__sediment__C_contaminant_total%setData(me%output_sediment__C_contaminant_total, start=[1,1,1,tStart])
+
+ ! *** FIXED: 5D var, so 5 indices in start ***
+ call me%nc__sediment__C_contaminant_layers%setData(me%output_sediment__C_contaminant_layers, start=[1,1,1,1,tStart])
+
+ call me%nc__sediment__m_contaminant_buried%setData(me%output_sediment__m_contaminant_buried, start=[1,1,1,1,tStart])
+ call me%nc__sediment__bed_area%setData( me%output_sediment__bed_area, start=[1,1,1,tStart])
+ call me%nc__sediment__mass%setData( me%output_sediment__mass, start=[1,1,1,tStart])
+
+ call me%nc__soil__m_contaminant_total%setData( me%output_soil__m_contaminant_total, start=[1,1,1,tStart])
+ call me%nc__soil__C_contaminant_total%setData( me%output_soil__C_contaminant_total, start=[1,1,tStart])
+
+ if (allocated(me%output_soil__C_contaminant_layers)) then
+ call me%nc__soil__C_contaminant_layers%setData(me%output_soil__C_contaminant_layers, start=[1,1,1,tStart])
end if
- if (C%includeSoilErosionYields) then
- deallocate(me%output_soil__m_soil_eroded)
- deallocate(me%output_soil__m_nm_eroded)
- deallocate(me%output_soil__m_transformed_eroded)
+ if (allocated(me%output_soil__m_soil_eroded)) then
+ call me%nc__soil__m_soil_eroded%setData( me%output_soil__m_soil_eroded, start=[1,1,tStart])
+ call me%nc__soil__m_contaminant_eroded%setData(me%output_soil__m_contaminant_eroded, start=[1,1,1,tStart])
end if
- deallocate(me%output_soil__m_nm_buried)
- deallocate(me%output_soil__m_transformed_buried)
- deallocate(me%output_soil__m_dissolved_buried)
- deallocate(me%output_soil__bulk_density)
+ call me%nc__soil__m_contaminant_buried%setData(me%output_soil__m_contaminant_buried, start=[1,1,1,tStart])
+
+ ! deallocations unchanged...
+ if (allocated(me%output_water__waterbody_type)) deallocate(me%output_water__waterbody_type)
+ if (allocated(me%output_water__m_contaminant)) deallocate(me%output_water__m_contaminant)
+ if (allocated(me%output_water__C_contaminant)) deallocate(me%output_water__C_contaminant)
+ if (allocated(me%output_water__C_contaminant_free)) deallocate(me%output_water__C_contaminant_free)
+ if (allocated(me%output_water__C_contaminant_attached))deallocate(me%output_water__C_contaminant_attached)
+ if (allocated(me%output_water__j_contaminant_outflow)) deallocate(me%output_water__j_contaminant_outflow)
+ if (allocated(me%output_water__j_contaminant_deposited))deallocate(me%output_water__j_contaminant_deposited)
+ if (allocated(me%output_water__j_contaminant_resuspended))deallocate(me%output_water__j_contaminant_resuspended)
+ if (allocated(me%output_water__m_spm)) deallocate(me%output_water__m_spm)
+ if (allocated(me%output_water__C_spm)) deallocate(me%output_water__C_spm)
+ if (allocated(me%output_water__m_spm_erosion)) deallocate(me%output_water__m_spm_erosion)
+ if (allocated(me%output_water__m_spm_deposition)) deallocate(me%output_water__m_spm_deposition)
+ if (allocated(me%output_water__m_spm_resuspended)) deallocate(me%output_water__m_spm_resuspended)
+ if (allocated(me%output_water__m_spm_inflow)) deallocate(me%output_water__m_spm_inflow)
+ if (allocated(me%output_water__m_spm_outflow)) deallocate(me%output_water__m_spm_outflow)
+ if (allocated(me%output_water__m_spm_bank_erosion)) deallocate(me%output_water__m_spm_bank_erosion)
+ if (allocated(me%output_water__volume)) deallocate(me%output_water__volume)
+ if (allocated(me%output_water__depth)) deallocate(me%output_water__depth)
+ if (allocated(me%output_water__flow)) deallocate(me%output_water__flow)
+
+ if (allocated(me%output_sediment__m_contaminant_total))deallocate(me%output_sediment__m_contaminant_total)
+ if (allocated(me%output_sediment__C_contaminant_total))deallocate(me%output_sediment__C_contaminant_total)
+ if (allocated(me%output_sediment__C_contaminant_free)) deallocate(me%output_sediment__C_contaminant_free)
+ if (allocated(me%output_sediment__C_contaminant_attached))deallocate(me%output_sediment__C_contaminant_attached)
+ if (allocated(me%output_sediment__C_contaminant_layers))deallocate(me%output_sediment__C_contaminant_layers)
+ if (allocated(me%output_sediment__m_contaminant_buried))deallocate(me%output_sediment__m_contaminant_buried)
+ if (allocated(me%output_sediment__bed_area)) deallocate(me%output_sediment__bed_area)
+ if (allocated(me%output_sediment__mass)) deallocate(me%output_sediment__mass)
+
+ if (allocated(me%output_soil__land_use)) deallocate(me%output_soil__land_use)
+ if (allocated(me%output_soil__m_contaminant_total)) deallocate(me%output_soil__m_contaminant_total)
+ if (allocated(me%output_soil__C_contaminant_total)) deallocate(me%output_soil__C_contaminant_total)
+ if (allocated(me%output_soil__C_contaminant_free)) deallocate(me%output_soil__C_contaminant_free)
+ if (allocated(me%output_soil__C_contaminant_attached))deallocate(me%output_soil__C_contaminant_attached)
+ if (allocated(me%output_soil__C_contaminant_layers)) deallocate(me%output_soil__C_contaminant_layers)
+ if (allocated(me%output_soil__C_contaminant_free_layers)) deallocate(me%output_soil__C_contaminant_free_layers)
+ if (allocated(me%output_soil__C_contaminant_attached_layers)) deallocate(me%output_soil__C_contaminant_attached_layers)
+ if (allocated(me%output_soil__m_soil_eroded)) deallocate(me%output_soil__m_soil_eroded)
+ if (allocated(me%output_soil__m_contaminant_eroded)) deallocate(me%output_soil__m_contaminant_eroded)
+ if (allocated(me%output_soil__m_contaminant_buried)) deallocate(me%output_soil__m_contaminant_buried)
+ if (allocated(me%output_soil__bulk_density)) deallocate(me%output_soil__bulk_density)
end subroutine
!> Close the NetCDF dataset
@@ -1066,4 +1299,4 @@ subroutine closeNetCDFOutput(me)
call me%nc%close()
end subroutine
-end module
\ No newline at end of file
+end module
diff --git a/src/Data/output_vars.yaml b/src/Data/output_vars.yaml
index 2e3bc38..fa9b7a9 100644
--- a/src/Data/output_vars.yaml
+++ b/src/Data/output_vars.yaml
@@ -19,8 +19,8 @@ soil:
long_name: Eastings
description: Eastings coordinate at the centre of the grid cell
units: m
- easts:
- long_name: Northing
+ norths:
+ long_name: Northings
description: Northings coordinate at the centre of the grid cell
units: m
p:
@@ -32,96 +32,22 @@ soil:
long_name: Main land use
description: Predominant land use type of this soil profile
units: ~
- m_np_total:
- long_name: Pristine NM mass
- description: Pristine NM mass in whole soil profile, attached and free
- units: kg
- m_transformed_total:
- long_name: Transformed NM mass
- description: Transformed NM mass in whole soil profile, attached and free
+ m_contaminant_total:
+ long_name: Contaminant mass
+ description: Contaminant mass in whole soil profile (form: 1=pristine, 2=transformed, 3=dissolved)
units: kg
- m_dissolved_total:
- long_name: Dissolved species mass
- description: Dissolved species mass in whole soil profile
- units: kg
- C_np_total:
- long_name: Pristine NM concentration
- description: Average concentration of pristine NM across soil profile, attached and free
- units: kg/kg
- C_transformed_total:
- long_name: Transformed NM concentration
- description: Average concentration of transformed NM across soil profile, attached and free
- units: kg/kg
- C_dissolved_total:
- long_name: Dissolved species concentration
- description: Average concentration of dissolved species across soil profile
- units: kg/kg
- C_np_free:
- long_name: Free pristine NM concentration
- description: Average concentration of free pristine NM across soil profile
- units: kg/kg
- comments: Only output if include_soil_state_breakdown = .true.
- C_transformed_free:
- long_name: Free transformed NM concentration
- description: Average concentration of free transformed NM across soil profile
- units: kg/kg
- comments: Only output if include_soil_state_breakdown = .true.
- C_np_att:
- long_name: Attached pristine NM concentration
- description: Average concentration of attached pristine NM across soil profile
+ C_contaminant_total:
+ long_name: Contaminant concentration
+ description: Average concentration of contaminant across soil profile (form: 1=pristine, 2=transformed, 3=dissolved)
units: kg/kg
- comments: Only output if include_soil_state_breakdown = .true.
- C_transformed_att:
- long_name: Attached transformed NM concentration
- description: Average concentration of attached transformed NM across soil profile
- units: kg/kg
- comments: Only output if include_soil_state_breakdown = .true.
- C_np_l{i}:
- long_name: Pristine NM concentration in layer {i}
- description: Concentration of pristine NM in soil layer {i}, attached and free
- units: kg/kg
- comments: Only output if include_soil_layer_breakdown = .true.
- C_transformed_l{i}:
- long_name: Transformed NM concentration in layer {i}
- description: Concentration of transformed NM in soil layer {i}, attached and free
+ C_contaminant_l{i}:
+ long_name: Contaminant concentration in layer {i}
+ description: Concentration of contaminant in soil layer {i} (form: 1=pristine, 2=transformed, 3=dissolved)
units: kg/kg
comments: Only output if include_soil_layer_breakdown = .true.
- C_dissolved_l{i}:
- long_name: Dissolved species concentration in layer {i}
- description: Concentration of dissolved species in soil layer {i}
- units: kg/kg
- comments: Only output if include_soil_layer_breakdown = .true.
- C_np_free_l{i}:
- long_name: Free pristine NM concentration in layer {i}
- description: Concentration of free pristine NM in soil layer {i}
- units: kg/kg
- comments: Only output if include_soil_layer_breakdown = .true. and include_soil_state_breakdown = .true.
- C_transformed_free_l{i}:
- long_name: Free transformed NM concentration in layer {i}
- description: Concentration of free transformed NM in soil layer {i}
- units: kg/kg
- comments: Only output if include_soil_layer_breakdown = .true. and include_soil_state_breakdown = .true.
- C_np_att_l{i}:
- long_name: Attached pristine NM concentration in layer {i}
- description: Concentration of attached pristine NM in soil layer {i}
- units: kg/kg
- comments: Only output if include_soil_layer_breakdown = .true. and include_soil_state_breakdown = .true.
- C_transformed_att_l{i}:
- long_name: Attached transformed NM concentration in layer {i}
- description: Concentration of attached transformed NM in soil layer {i}
- units: kg/kg
- comments: Only output if include_soil_layer_breakdown = .true. and include_soil_state_breakdown = .true.
- m_np_buried:
- long_name: Mass of pristine NM buried
- description: Mass of pristine NM buried from the bottom of the soil profile on this timestep
- units: kg
- m_transformed_buried:
- long_name: Mass of transformed NM buried
- description: Mass of transformed NM buried from the bottom of the soil profile on this timestep
- units: kg
- m_dissolved_buried:
- long_name: Mass of dissolved species buried
- description: Mass of dissolved species buried from the bottom of the soil profile on this timestep
+ m_contaminant_buried:
+ long_name: Mass of contaminant buried
+ description: Mass of contaminant buried from the bottom of the soil profile on this timestep (form: 1=pristine, 2=transformed, 3=dissolved)
units: kg
bulk_density:
long_name: Bulk density
@@ -148,8 +74,8 @@ water:
long_name: Eastings
description: Eastings coordinate at the centre of the grid cell
units: m
- easts:
- long_name: Northing
+ norths:
+ long_name: Northings
description: Northings coordinate at the centre of the grid cell
units: m
w:
@@ -163,93 +89,37 @@ water:
long_name: Waterbody type
description: Waterbody type - river or estuary?
units: ~
- m_np:
- long_name: Pristine NM mass
- description: Pristine NM mass
- comments: |
- If include_waterbody_breakdown = .true., this is for each waterbody.
- If .false., this is the sum across waterbodies for this grid cell.
- units: kg
- m_transformed_total:
- long_name: Transformed NM mass
- description: Transformed NM mass in whole soil profile
+ m_contaminant:
+ long_name: Contaminant mass
+ description: Contaminant mass (form: 1=pristine, 2=transformed, 3=dissolved)
comments: |
If include_waterbody_breakdown = .true., this is for each waterbody.
If .false., this is the sum across waterbodies for this grid cell.
units: kg
- m_dissolved_total:
- long_name: Dissolved species mass
- description: Dissolved species mass in whole soil profile
- comments: |
- If include_waterbody_breakdown = .true., this is for each waterbody.
- If .false., this is the sum across waterbodies for this grid cell.
- units: kg
- C_np:
- long_name: Pristine NM concentration
- description: Pristine NM concentration
+ C_contaminant:
+ long_name: Contaminant concentration
+ description: Contaminant concentration (form: 1=pristine, 2=transformed, 3=dissolved)
comments: |
If include_waterbody_breakdown = .true., this is for each waterbody.
If .false., this is the weighted average across waterbodies for this grid cell.
units: kg/m3
- C_transformed_total:
- long_name: Transformed NM concentration
- description: Transformed NM concentration
- comments: |
- If include_waterbody_breakdown = .true., this is for each waterbody.
- If .false., this is the weighted average across waterbodies for this grid cell.
- units: kg/m3
- C_dissolved_total:
- long_name: Dissolved species concentration
- description: Dissolved species concentration
- comments: |
- If include_waterbody_breakdown = .true., this is for each waterbody.
- If .false., this is the weighted average across waterbodies for this grid cell.
- units: kg/m3
- m_np_outflow:
- long_name: Pristine NM mass in outflow
- description: Pristine NM mass in downstream outflow on this timestep
- comments: |
- If include_waterbody_breakdown = .true., this is for each waterbody.
- If .false., this is the outflow to the grid cell.
- units: kg
- m_transformed_outflow:
- long_name: Transformed NM mass in outflow
- description: Transformed NM mass in downstream outflow on this timestep
- comments: |
- If include_waterbody_breakdown = .true., this is for each waterbody.
- If .false., this is the outflow to the grid cell.
- units: kg
- m_dissolved_outflow:
- long_name: Dissolved species mass in outflow
- description: Dissolved species mass in downstream outflow on this timestep
+ j_contaminant_outflow:
+ long_name: Contaminant mass in outflow
+ description: Contaminant mass in downstream outflow on this timestep (form: 1=pristine, 2=transformed, 3=dissolved)
comments: |
If include_waterbody_breakdown = .true., this is for each waterbody.
If .false., this is the outflow to the grid cell.
units: kg
- m_np_deposited:
- long_name: Pristine NM mass deposited
- description: Pristine NM mass deposited to bed sediment on this timestep
- comments: |
- If include_waterbody_breakdown = .true., this is for each waterbody.
- If .false., this is the sum across the grid cell.
- units: kg
- m_transformed_deposited:
- long_name: Transformed NM mass deposited
- description: Transformed NM mass deposited to bed sediment on this timestep
- comments: |
- If include_waterbody_breakdown = .true., this is for each waterbody.
- If .false., this is the sum across the grid cell.
- units: kg
- m_np_resuspended:
- long_name: Pristine NM mass resuspended
- description: Pristine NM mass resuspended from bed sediment on this timestep
+ j_contaminant_deposited:
+ long_name: Contaminant mass deposited
+ description: Contaminant mass deposited to bed sediment on this timestep (form: 1=pristine, 2=transformed)
comments: |
If include_waterbody_breakdown = .true., this is for each waterbody.
If .false., this is the sum across the grid cell.
units: kg
- m_transformed_resuspended:
- long_name: Transformed NM mass resuspended
- description: Transformed NM mass resuspended from bed sediment on this timestep
+ j_contaminant_resuspended:
+ long_name: Contaminant mass resuspended
+ description: Contaminant mass resuspended from bed sediment on this timestep (form: 1=pristine, 2=transformed)
comments: |
If include_waterbody_breakdown = .true., this is for each waterbody.
If .false., this is the sum across the grid cell.
@@ -302,11 +172,11 @@ water:
units: kg
m_spm_outflow:
long_name: Mass of suspended particulate matter in outflow
- description: Mass of suspended particulate matter in inflow from upstream on this timestep
+ description: Mass of suspended particulate matter in outflow from upstream on this timestep
comments: |
Only output if include_sediment_fluxes = .true.
If include_waterbody_breakdown = .true., this is for each waterbody.
- If .false., this is the inflow to the whole grid cell.
+ If .false., this is the outflow to the whole grid cell.
units: kg
m_spm_bank_erosion:
long_name: Mass of suspended particulate matter from bank erosion
@@ -322,21 +192,21 @@ water:
comments: |
If include_waterbody_breakdown = .true., this is for each waterbody.
If .false., this is the total volume of water across the whole grid cell.
- units: kg
+ units: m3
depth:
long_name: Depth of water
description: Depth of water
comments: |
If include_waterbody_breakdown = .true., this is for each waterbody.
If .false., this is the average depth across the whole grid cell.
- units: kg
+ units: m
flow:
long_name: Flow rate
description: Flow rate of water at outflow
comments: |
If include_waterbody_breakdown = .true., this is for each waterbody.
If .false., this is the flow rate at the outflow to the grid cell.
- units: m3/s
+ units: m3/s
sediment:
t:
long_name: Timestep index
@@ -358,8 +228,8 @@ sediment:
long_name: Eastings
description: Eastings coordinate at the centre of the grid cell
units: m
- easts:
- long_name: Northing
+ norths:
+ long_name: Northings
description: Northings coordinate at the centre of the grid cell
units: m
w:
@@ -373,23 +243,23 @@ sediment:
long_name: Waterbody type
description: Waterbody type for the waterbody this bed sediment is in - river or estuary?
units: ~
- m_np_total:
- long_name: Pristine NM mass
- description: Total pristine NM mass across the sediment layers
+ m_contaminant_total:
+ long_name: Contaminant mass
+ description: Total contaminant mass across the sediment layers (form: 1=pristine, 2=transformed)
units: kg
- C_np_total:
- long_name: Pristine NM concentration
- description: Total untransformed NM concentration across the sediment layers
+ C_contaminant_total:
+ long_name: Contaminant concentration
+ description: Total contaminant concentration across the sediment layers (form: 1=pristine, 2=transformed)
units: kg/m3 and kg/kg
- comments: Outputs conentrations in kg/kg and kg/m3
- C_np_l{i}:
- long_name: Pristine NM concentration in sediment layer {i}
- description: Pristine NM concentration in sediment layer {i}
+ comments: Outputs concentrations in kg/kg and kg/m3
+ C_contaminant_l{i}:
+ long_name: Contaminant concentration in sediment layer {i}
+ description: Contaminant concentration in sediment layer {i} (form: 1=pristine, 2=transformed)
units: kg/m3 and kg/kg
- comments: Outputs conentrations in kg/kg and kg/m3
- m_np_buried:
- long_name: Pristine NM mass buried
- description: Mass of pristine NM mass buried from the bottom sediment layer
+ comments: Outputs concentrations in kg/kg and kg/m3
+ m_contaminant_buried:
+ long_name: Contaminant mass buried
+ description: Mass of contaminant buried from the bottom sediment layer (form: 1=pristine, 2=transformed)
units: kg
bed_area:
long_name: Bed sediment area
diff --git a/src/DefaultsModule.f90 b/src/DefaultsModule.f90
index 86f6790..83c0a08 100644
--- a/src/DefaultsModule.f90
+++ b/src/DefaultsModule.f90
@@ -1,9 +1,8 @@
!> The DefaultsModule holds default values used throughout the model, such as those
!! used in input data or config
module DefaultsModule
- implicit none
+ implicit none! Double precision reals. Private for the moment as it's also in GlobalsModule
- ! Double precision reals. Private for the moment as it's also in GlobalsModule
integer, private, parameter :: dp = selected_real_kind(15, 307)
! Config file IO units
@@ -19,6 +18,7 @@ module DefaultsModule
integer, parameter :: iouOutputSoil = 103
integer, parameter :: iouOutputSSD = 104
integer, parameter :: iouOutputStats = 105
+ integer, parameter :: iouOutputBiota = 106
! Checkpoint and logging
integer, parameter :: iouCheckpoint = 500
integer, parameter :: iouLog = 501
@@ -48,7 +48,7 @@ module DefaultsModule
logical :: includeSoilErosionYields = .false. ! Should we output soil erosion yields?
logical :: includeSpmSizeClassBreakdown = .false.
logical :: includeClayEnrichment = .false.
- character(len=5) :: soilPECUnits = 'kg/kg' ! Should soil PECS be kg/kg or kg/m3?
+ character(len=5) :: soilPECUnits = 'kg/kg' ! Should soil PECs be kg/kg or kg/m3?
character(len=5) :: sedimentPECUnits = 'kg/kg' ! Should sediment PECs be kg/kg or kg/m3?
logical :: writeMetadataAsComment = .true. ! Should metadata be added to the top of CSV files as # comments
! Checkpoint
@@ -59,7 +59,7 @@ module DefaultsModule
logical :: preserveTimeStep = .false. ! Should the time step be preserved when reinstating a checkpoint?
! Run
character(len=32) :: outputHash = '' ! Hash to append to output file names
- logical :: ignoreNM = .false. ! If .true., costly NM calculations are missed out. Useful for sediment calibation
+ logical :: ignoreContaminant = .false. ! If .true., costly contaminant calculations are skipped. Useful for sediment calibration
character(len=256) :: simulationMask = '' ! Path to model simulation mask (or empty if there isn't one)
! Water
logical :: includeEstuary = .true. ! Should we model estuaries, or treat them as rivers?
@@ -67,27 +67,30 @@ module DefaultsModule
! Soil
logical :: includeSoilErosion = .true. ! Should we model soil erosion?
end type
- ! Object to exposre the config defaults
type(ConfigDefaultsType) :: configDefaults
- ! Defaults for constants
- real, parameter :: defaultSoilAttachmentEfficiency = 0.0
- real, parameter :: defaultSoilDarcyVelocity = 9e-6_dp ! [m/s] Tufenkji et al, 2004: https://doi.org/10.1021/es034049r
- real, parameter :: default_k_diss_pristine = 0.0
- real, parameter :: default_k_diss_transformed = 0.0
- real, parameter :: default_k_transform_pristine = 0.0
- real, parameter :: defaultShearRate = 10.0 ! Arvidsson et al, 2009: https://doi.org/10.1080/10807039.2011.538639
- real, parameter :: defaultMinWaterTemperature = 4.0 ! Thames River
- real, parameter :: defaultMaxWaterTemperature = 21.0 ! Thames River
- integer, parameter :: defaultMinWaterTemperatureDayOfYear = 32 ! Thames River
- real(dp), parameter :: defaultSedimentTransport_a = 2.0e-9_dp
- real(dp), parameter :: defaultSedimentTransport_b = 0.0_dp
- real(dp), parameter :: defaultSedimentTransport_c = 0.2_dp
- real(dp), parameter :: defaultSedimentEnrichment_k = 1.0_dp
- real(dp), parameter :: defaultSedimentEnrichment_a = 0.0_dp
- real(dp), parameter :: defaultSlope = 0.0005_dp
- real(dp), parameter :: defaultDepositionAlpha = 38.1_dp ! Zhiyao et al, 2008: https://doi.org/10.1016/S1674-2370(15)30017-X
- real(dp), parameter :: defaultDepositionBeta = 0.93_dp ! Zhiyao et al, 2008: https://doi.org/10.1016/S1674-2370(15)30017-X
- real(dp), parameter :: defaultBankErosionAlpha = 1.0e-9_dp ! [kg/m5] Loosely based on Lazar et al, 2010: https://doi.org/10.1016/j.scitotenv.2010.02.030
- real(dp), parameter :: defaultBankErosionBeta = 1.0_dp ! [-] Loosely based on Lazar et al, 2010: https://doi.org/10.1016/j.scitotenv.2010.02.030
+ ! ! Defaults for constants
+ ! real, parameter :: defaultSoilAttachmentEfficiency = 0.0
+ ! real, parameter :: defaultSoilDarcyVelocity = 9e-6_dp ! [m/s] Tufenkji et al, 2004: https://doi.org/10.1021/es034049r
+ ! real(dp), parameter :: default_k_diss_pristine = 0.0_dp ! Dissolution rate for pristine contaminant [s-1]
+ ! real(dp), parameter :: default_k_diss_transformed = 0.0_dp ! Dissolution rate for transformed contaminant [s-1]
+ ! real(dp), parameter :: default_k_transform_pristine = 0.0_dp ! Transformation rate for pristine contaminant [s-1]
+ ! real(dp), parameter :: default_rho_contaminant = 1000.0_dp ! Density of contaminant [kg/m3]
+ ! real, parameter :: defaultShearRate = 10.0 ! Arvidsson et al, 2009: https://doi.org/10.1080/10807039.2011.538639
+ ! real, parameter :: defaultMinWaterTemperature = 4.0 ! Thames River
+ ! real, parameter :: defaultMaxWaterTemperature = 21.0 ! Thames River
+ ! integer, parameter :: defaultMinWaterTemperatureDayOfYear = 32 ! Thames River
+ ! real(dp), parameter :: defaultSedimentTransport_a = 2.0e-9_dp
+ ! real(dp), parameter :: defaultSedimentTransport_b = 0.0_dp
+ ! real(dp), parameter :: defaultSedimentTransport_c = 0.2_dp
+ ! real(dp), parameter :: defaultSedimentEnrichment_k = 1.0_dp
+ ! real(dp), parameter :: defaultSedimentEnrichment_a = 0.0_dp
+ ! real(dp), parameter :: defaultSlope = 0.0005_dp
+ ! real(dp), parameter :: defaultDepositionAlpha = 38.1_dp ! Zhiyao et al, 2008: https://doi.org/10.1016/S1674-2370(15)30017-X
+ ! real(dp), parameter :: defaultDepositionBeta = 0.93_dp ! Zhiyao et al, 2008: https://doi.org/10.1016/S1674-2370(15)30017-X
+ ! real(dp), parameter :: defaultBankErosionAlpha = 1.0e-9_dp ! [kg/m5] Loosely based on Lazar et al, 2010: https://doi.org/10.1016/j.scitotenv.2010.02.030
+ ! real(dp), parameter :: defaultBankErosionBeta = 1.0_dp ! [-] Loosely based on Lazar et al, 2010: https://doi.org/10.1016/j.scitotenv.2010.02.030
+ ! real(dp), parameter :: defaultEstuaryAttachmentEfficiency = 0.0_dp
+ ! real(dp), parameter :: defaultRiverAttachmentEfficiency = 0.0_dp
end module
+
diff --git a/src/Environment/AbstractEnvironmentModule.f90 b/src/Environment/AbstractEnvironmentModule.f90
index afd394a..feb0567 100644
--- a/src/Environment/AbstractEnvironmentModule.f90
+++ b/src/Environment/AbstractEnvironmentModule.f90
@@ -2,13 +2,14 @@
module AbstractEnvironmentModule
use GlobalsModule
use ResultModule
+ use ContaminantModule
use AbstractGridCellModule
use mo_netcdf
implicit none
private
type, public :: EnvironmentPointer
- class(AbstractEnvironment), pointer :: item => null() !! Pointer to polymorphic AbstractEnvironment object
+ class(AbstractEnvironment), pointer :: item => null() !! Pointer to polymorphic AbstractEnvironment object
end type
!> Abstract base class definition for `AbstractEnvironment`.
@@ -22,9 +23,9 @@ module AbstractEnvironmentModule
integer :: nWaterbodies = 0 !! The number of waterbodies in the Environment
type(NcGroup) :: ncGroup !! NetCDF group for this `Environment` object
! Summary statistics
- real(dp), allocatable :: C_np_water_t(:,:,:,:) !! Water NM conc spatial mean on each timestep [kg/m3]
- real(dp), allocatable :: C_np_sediment_t(:,:,:,:) !! Sediment NM conc spatial mean on each timestep [kg/kg]
- real(dp), allocatable :: m_sediment_t_byLayer(:,:,:) !! Sediment mass in each layer on each timestep [kg]
+ type(Contaminant), allocatable :: contaminant_water_t(:) ! Contaminant state in water per timestep
+ type(Contaminant), allocatable :: contaminant_sediment_t(:) ! Contaminant state in sediment per timestep
+ real(dp), allocatable :: m_sediment_t_byLayer(:,:,:) ! Sediment mass in each layer per timestep [kg]
contains
procedure(createEnvironment), deferred :: create
procedure(updateEnvironment), deferred :: update
@@ -32,12 +33,14 @@ module AbstractEnvironmentModule
procedure(determineStreamOrderEnvironment), deferred :: determineStreamOrder
procedure(parseNewBatchDataEnvironment), deferred :: parseNewBatchData
! Getters
- procedure(get_m_npEnvironment), deferred :: get_m_np
- procedure(get_C_np_soilEnvironment), deferred :: get_C_np_soil
- procedure(get_C_np_waterEnvironment), deferred :: get_C_np_water
- procedure(get_C_np_sedimentEnvironment), deferred :: get_C_np_sediment
+ procedure(parseInputDataEnvironment), deferred :: parseInputData
+ procedure(get_m_contaminantEnvironment), deferred :: get_m_contaminant
+ procedure(get_C_contaminant_soilEnvironment), deferred :: get_C_contaminant_soil
+ procedure(get_C_contaminant_waterEnvironment), deferred :: get_C_contaminant_water
+ procedure(get_C_contaminant_sedimentEnvironment), deferred :: get_C_contaminant_sediment
procedure(getBedSedimentAreaEnvironment), deferred :: getBedSedimentArea
procedure(get_m_sediment_byLayerEnvironment), deferred :: get_m_sediment_byLayer
+ procedure :: finalise => finaliseEnvironment
end type
abstract interface
@@ -87,32 +90,34 @@ subroutine parseNewBatchDataEnvironment(me)
class(AbstractEnvironment) :: me
end subroutine
- function get_m_npEnvironment(me) result(m_np)
- use GlobalsModule
+ function get_m_contaminantEnvironment(me) result(m_contaminant)
+ use ContaminantModule
import AbstractEnvironment
class(AbstractEnvironment) :: me
- real(dp) :: m_np(C%nSizeClassesNM, 4, 2 + C%nSizeClassesSpm)
+ type(Contaminant) :: m_contaminant
end function
- function get_C_np_soilEnvironment(me) result(C_np_soil)
- use GlobalsModule, only: C, dp
+ function get_C_contaminant_soilEnvironment(me) result(C_contaminant_soil)
+ !use GlobalsModule, only: C, dp
+ use ContaminantModule
import AbstractEnvironment
class(AbstractEnvironment) :: me
- real(dp), allocatable :: C_np_soil(:,:,:)
+ !real(dp), allocatable :: C_contaminant_soil(:,:,:)
+ type(Contaminant) :: C_contaminant_soil
end function
- function get_C_np_waterEnvironment(me) result(C_np_water)
+ function get_C_contaminant_waterEnvironment(me) result(C_contaminant_water)
use GlobalsModule, only: C, dp
- import AbstractEnvironment
+ import AbstractEnvironment, Contaminant
class(AbstractEnvironment) :: me
- real(dp), allocatable :: C_np_water(:,:,:)
+ type(Contaminant) :: C_contaminant_water
end function
- function get_C_np_sedimentEnvironment(me) result(C_np_sediment)
+ function get_C_contaminant_sedimentEnvironment(me) result(C_contaminant_sediment)
use GlobalsModule, only: C, dp
- import AbstractEnvironment
+ import AbstractEnvironment, Contaminant
class(AbstractEnvironment) :: me
- real(dp), allocatable :: C_np_sediment(:,:,:)
+ type(Contaminant) :: C_contaminant_sediment
end function
function getBedSedimentAreaEnvironment(me) result(bedArea)
@@ -126,9 +131,32 @@ function get_m_sediment_byLayerEnvironment(me) result(m_sediment_byLayer)
use GlobalsModule, only: dp, C
import AbstractEnvironment
class(AbstractEnvironment) :: me
- real(dp), allocatable :: m_sediment_byLayer(:,:)
+ real(dp), allocatable :: m_sediment_byLayer(:,:) ! (nSedimentLayers, C%contaminantDim(1))
end function
end interface
+ contains
+ subroutine finaliseEnvironment(me)
+ class(AbstractEnvironment) :: me
+ integer :: i
+ if (allocated(me%contaminant_water_t)) then
+ do i = 1, size(me%contaminant_water_t)
+ call me%contaminant_water_t(i)%finalise()
+ end do
+ deallocate(me%contaminant_water_t)
+ end if
+ if (allocated(me%contaminant_sediment_t)) then
+ do i = 1, size(me%contaminant_sediment_t)
+ call me%contaminant_sediment_t(i)%finalise()
+ end do
+ deallocate(me%contaminant_sediment_t)
+ end if
+ if (allocated(me%m_sediment_t_byLayer)) deallocate(me%m_sediment_t_byLayer)
+ if (allocated(me%colGridCells)) deallocate(me%colGridCells)
+ if (allocated(me%headwaters)) deallocate(me%headwaters)
+ if (allocated(me%routedReaches)) deallocate(me%routedReaches)
+ if (allocated(me%gridDimensions)) deallocate(me%gridDimensions)
+ end subroutine
+
end module
\ No newline at end of file
diff --git a/src/Environment/EnvironmentModule.f90 b/src/Environment/EnvironmentModule.f90
index 139f2a2..b819d5c 100644
--- a/src/Environment/EnvironmentModule.f90
+++ b/src/Environment/EnvironmentModule.f90
@@ -6,6 +6,7 @@ module EnvironmentModule
use AbstractEnvironmentModule
use ResultModule
use GridCellModule
+ use ContaminantModule
use DataInputModule, only: DATASET
use datetime_module, only: datetime, timedelta
implicit none
@@ -15,7 +16,6 @@ module EnvironmentModule
!! environmental compartments, triggering their creation, simulation
!! and passing data between them
type, public, extends(AbstractEnvironment) :: Environment
-
contains
procedure :: create => createEnvironment
procedure :: update => updateEnvironment
@@ -23,10 +23,11 @@ module EnvironmentModule
procedure :: determineStreamOrder => determineStreamOrderEnvironment
procedure :: parseNewBatchData => parseNewBatchDataEnvironment
! Getters
- procedure :: get_m_np => get_m_npEnvironment
- procedure :: get_C_np_soil => get_C_np_soilEnvironment
- procedure :: get_C_np_water => get_C_np_waterEnvironment
- procedure :: get_C_np_sediment => get_C_np_sedimentEnvironment
+ procedure :: parseInputData => parseInputDataEnvironment
+ procedure :: get_m_contaminant => get_m_contaminantEnvironment
+ procedure :: get_C_contaminant_soil => get_C_contaminant_soilEnvironment
+ procedure :: get_C_contaminant_water => get_C_contaminant_waterEnvironment
+ procedure :: get_C_contaminant_sediment => get_C_contaminant_sedimentEnvironment
procedure :: getBedSedimentArea => getBedSedimentAreaEnvironment
procedure :: get_m_sediment_byLayer => get_m_sediment_byLayerEnvironment
end type
@@ -39,72 +40,70 @@ module EnvironmentModule
!! ([see here](https://stackoverflow.com/questions/45761050/pointing-to-a-objects-type-variable-fortran/))
function createEnvironment(me) result(r)
class(Environment), target :: me
- !! This `Environment` instace. Must be target so children can be pointed at.
- type(Result) :: r !! `Result` object to return any error(s) in
- integer :: x, y, w, i, ix, iy, iw ! Iterators
- type(ReachPointer), allocatable :: tmpHeadwaters(:) ! Temporary headwaters array
+ !! This `Environment` instance. Must be target so children can be pointed at.
+ type(Result) :: r
+ integer :: x, y, w, i, ix, iy, iw
+ type(ReachPointer), allocatable :: tmpHeadwaters(:)
+ integer :: allst
+ character(len=256) :: tr
- me%nGridCells = 0
+ tr = "Environment%createEnvironment"
+ me%nGridCells = 0 ! Inherited from AbstractEnvironment
! Allocate grid cells array to be the shape of the grid
- allocate(me%colGridCells(DATASET%gridShape(1), DATASET%gridShape(2)))
+ allocate(me%colGridCells(DATASET%gridShape(1), DATASET%gridShape(2)), stat=allst)
+ if (allst /= 0) then
+ call r%addError(ErrorInstance(code=1, message="Allocation error for colGridCells", trace=[tr]))
+ return
+ end if
! Loop over grid and create cells
do y = 1, DATASET%gridShape(2)
do x = 1, DATASET%gridShape(1)
allocate(GridCell :: me%colGridCells(x,y)%item)
! If this grid cell isn't masked, create it
if (.not. DATASET%gridMask(x,y)) then
- call r%addErrors(.errors. &
- me%colGridCells(x,y)%item%create(x,y) &
- )
+ call r%addErrors(.errors. me%colGridCells(x,y)%item%create(x,y))
me%nGridCells = me%nGridCells + 1
! If it is masked, still create it but tell it that it's empty
else
- call r%addErrors(.errors. &
- me%colGridCells(x,y)%item%create(x,y,isEmpty=.true.) &
- )
+ call r%addErrors(.errors. me%colGridCells(x,y)%item%create(x,y,isEmpty=.true.))
end if
end do
end do
if (.not. r%hasCriticalError()) then
- ! Now we need to create links between waterbodies, which wasn't possible before all cells
- ! and their waterbodies were created. We do this by pointing reach%inflows and reach%outflow
- ! to correct waterbody object.
+ ! Create links between waterbodies
do y = 1, DATASET%gridShape(2)
do x = 1, DATASET%gridShape(1)
if (.not. me%colGridCells(x,y)%item%isEmpty) then
- do w = 1, me%colGridCells(x,y)%item%nReaches ! Loop through the reaches
+ do w = 1, me%colGridCells(x,y)%item%nReaches
associate (reach => me%colGridCells(x,y)%item%colRiverReaches(w)%item)
- ! Loop through the inflows for this reach
do i = 1, reach%nInflows
iw = reach%inflowsArr(i,1)
ix = reach%inflowsArr(i,2)
iy = reach%inflowsArr(i,3)
- ! We've already checked the inflows are in the model domain, so set this
- ! reach's inflow to the correct river
reach%inflows(i)%item => me%colGridCells(ix,iy)%item%colRiverReaches(iw)%item
- ! Set the outflow of this reach's inflow to this reach
reach%inflows(i)%item%outflow%item => reach
- ! Check if this reach is a grid cell inflow (and thus the inflow reach is a grid cell outflow)
if (ix /= x .or. iy /= y) then
reach%inflows(i)%item%isGridCellOutflow = .true.
reach%isGridCellInflow = .true.
end if
- ! If the inflow is a river and this reach is an estuary, set the estuary to
- ! be the tidal limit
if (reach%ref(1:3) == 'Est' .and. reach%inflows(i)%item%ref(1:3) == 'Riv') then
reach%isTidalLimit = .true.
end if
end do
- ! If this is a headwater, add to headwaters array to start routing from
if (reach%isHeadwater) then
- me%nHeadwaters = me%nHeadwaters + 1 ! Extend nHeadwater by one
- allocate(tmpHeadwaters(me%nHeadwaters)) ! Move around the allocation to add extra element
+ me%nHeadwaters = me%nHeadwaters + 1
+ allocate(tmpHeadwaters(me%nHeadwaters), stat=allst)
+ if (allst /= 0) then
+ call r%addError(ErrorInstance(code=1, &
+ message="Allocation error for tmpHeadwaters", trace=[tr]))
+ return
+ end if
if (me%nHeadwaters > 1) then
tmpHeadwaters(1:me%nHeadwaters-1) = me%headwaters
end if
call move_alloc(tmpHeadwaters, me%headwaters)
- me%headwaters(me%nHeadwaters)%item => reach ! Point to this reach
+ me%headwaters(me%nHeadwaters)%item => reach
end if
end associate
end do
@@ -112,8 +111,7 @@ function createEnvironment(me) result(r)
end do
end do
- ! Finally, perform any creation operations that required proper cell linking (e.g. snapping point sources
- ! to the correct cells)
+ ! Finalise creation operations
do y = 1, DATASET%gridShape(2)
do x = 1, DATASET%gridShape(1)
call me%colGridCells(x,y)%item%finaliseCreate()
@@ -121,25 +119,27 @@ function createEnvironment(me) result(r)
end do
end do
- ! Allocate the routedReaches to the number of waterbodies, and set the stream order for all the reaches
- allocate(me%routedReaches(me%nWaterbodies))
+ ! Allocate routedReaches
+ allocate(me%routedReaches(me%nWaterbodies), stat=allst)
+ if (allst /= 0) then
+ call r%addError(ErrorInstance(code=1, message="Allocation error for routedReaches", trace=[tr]))
+ return
+ end if
call me%determineStreamOrder()
-
end if
- ! Allocate the per timestep spatial mean water conc array. Begin with 0 timesteps, as this array
- ! is reallocated on each timestep (to account for batch runs)
- allocate(me%C_np_water_t(0, C%npDim(1), C%npDim(2), C%npDim(3)))
- allocate(me%C_np_sediment_t(0, C%npDim(1), C%npDim(2), C%npDim(3)))
- allocate(me%m_sediment_t_byLayer(0, C%nSedimentLayers, C%nSizeClassesSpm))
- me%C_np_water_t = 0.0_dp
- me%C_np_sediment_t = 0.0_dp
- me%m_sediment_t_byLayer = 0.0_dp
+ ! Allocate temporal arrays
+ allocate(me%contaminant_water_t(0), me%contaminant_sediment_t(0), &
+ me%m_sediment_t_byLayer(0, C%nSedimentLayers, C%nSizeClassesSpm), stat=allst)
+ if (allst /= 0) then
+ call r%addError(ErrorInstance(code=1, message="Allocation error for temporal arrays", trace=[tr]))
+ return
+ end if
- call r%addToTrace('Creating the Environment') ! Add this procedure to the trace
+ call r%addToTrace('Creating the Environment')
call LOGR%toFile(errors=.errors.r)
- call ERROR_HANDLER%trigger(errors= .errors. r) ! Trigger any errors present
- call r%clear() ! Remove any errors so we don't trigger them twice
+ call ERROR_HANDLER%trigger(errors=.errors.r)
+ call r%clear()
call LOGR%toConsole('Creating the Environment: '//COLOR_GREEN//'success'//COLOR_RESET)
end function
@@ -147,21 +147,25 @@ function createEnvironment(me) result(r)
subroutine updateEnvironment(me, t, tInBatch, isWarmUp)
use omp_lib
class(Environment), target :: me !! This `Environment` instance
- integer :: t !! Current time step
- integer :: tInBatch !! Current time step in full batch run
- logical :: isWarmUp !! Are we in a warm up period?
- integer :: i, x, y ! Iterators
- type(datetime) :: currentDate ! Current simulation date
- real(dp), allocatable :: tmp_C_np(:,:,:,:) ! Temporary array
- real(dp), allocatable :: tmp_m_sediment(:,:,:) ! Temporary array
+ integer :: t !! Current time step
+ integer :: tInBatch !! Current time step in full batch run
+ logical :: isWarmUp !! Are we in a warm up period?
+ integer :: i, x, y ! Iterators
+ type(datetime) :: currentDate ! Current simulation date
+ type(Contaminant), allocatable :: tmp_contaminant(:) ! Temporary array for contaminants
+ real(dp), allocatable :: tmp_m_sediment(:,:,:) ! Temporary array for sediment
+ integer :: allst ! Allocation status
+ type(Result) :: r_ct, rslt1, rslt2
+ character(len=256) :: tr
+ tr = "Environment%updateEnvironment"
! Get the current date and log it
currentDate = C%startDate + timedelta(t-1)
if (isWarmUp) then
call LOGR%add("Warm up period (time step #" // trim(str(tInBatch)) // ")...")
else
call LOGR%add("Performing simulation for " // trim(currentDate%strftime('%Y-%m-%d')) // &
- " (time step #" // trim(str(tInBatch)) // ")...")
+ " (time step #" // trim(str(tInBatch)) // ")...")
end if
!!$omp parallel do private(y,x)
@@ -194,68 +198,113 @@ subroutine updateEnvironment(me, t, tInBatch, isWarmUp)
! Add to the per timestep spatial weighted mean water and sediment conc array
! Here we simply append to the array because we don't want to loose data from
! a previous chunk, if we're in batch run mode
- ! TODO allocate size from C%batchNTimesteps so we don't have to reallocate
- call move_alloc(me%C_np_water_t, tmp_C_np)
- allocate(me%C_np_water_t(size(tmp_C_np, dim=1) + 1, size(tmp_C_np, dim=2), size(tmp_C_np, dim=3), size(tmp_C_np, dim=4)))
- me%C_np_water_t(:size(tmp_C_np, dim=1), :, :, :) = tmp_C_np
- me%C_np_water_t(size(tmp_C_np, dim=1) + 1, :, :, :) = me%get_C_np_water()
- ! Same for sediment
- call move_alloc(me%C_np_sediment_t, tmp_C_np)
- allocate(me%C_np_sediment_t(size(tmp_C_np, dim=1) + 1, size(tmp_C_np, dim=2), size(tmp_C_np, dim=3), size(tmp_C_np, dim=4)))
- me%C_np_sediment_t(:size(tmp_C_np, dim=1), :, :, :) = tmp_C_np
- me%C_np_sediment_t(size(tmp_C_np, dim=1) + 1, :, :, :) = me%get_C_np_sediment()
- ! Sediment mass
- ! TODO don't think this is needed, potentially remove
+ call move_alloc(me%contaminant_water_t, tmp_contaminant)
+ allocate(me%contaminant_water_t(size(tmp_contaminant)+1), stat=allst)
+ if (allst /= 0) then
+ call LOGR%add("Error allocating contaminant_water_t")
+ return
+ end if
+ if (size(tmp_contaminant) > 0) then
+ me%contaminant_water_t(1:size(tmp_contaminant)) = tmp_contaminant
+ end if
+
+ ! --- FUNCTION create() must be captured, not CALLed ---
+ r_ct = me%contaminant_water_t(size(tmp_contaminant)+1)%create()
+ if (r_ct%hasError()) then
+ call LOGR%toFile(errors=r_ct%errors)
+ call ERROR_HANDLER%trigger(errors=r_ct%errors)
+ return
+ end if
+ me%contaminant_water_t(size(tmp_contaminant)+1) = me%get_C_contaminant_water()
+
+ ! Append new sediment‐phase contaminant
+ call move_alloc(me%contaminant_sediment_t, tmp_contaminant)
+ allocate(me%contaminant_sediment_t(size(tmp_contaminant)+1), stat=allst)
+ if (allst /= 0) then
+ call LOGR%add("Error allocating contaminant_sediment_t")
+ return
+ end if
+ if (size(tmp_contaminant) > 0) then
+ me%contaminant_sediment_t(1:size(tmp_contaminant)) = tmp_contaminant
+ end if
+
+ rslt1 = me%contaminant_sediment_t(size(tmp_contaminant)+1)%create()
+ if (rslt1%hasError()) then
+ call LOGR%toFile(errors=rslt1%errors)
+ call ERROR_HANDLER%trigger(errors=rslt1%errors)
+ return
+ end if
+ me%contaminant_sediment_t(size(tmp_contaminant)+1) = me%get_C_contaminant_sediment()
+
+ ! Append new sediment‐by‐layer mass
call move_alloc(me%m_sediment_t_byLayer, tmp_m_sediment)
- allocate(me%m_sediment_t_byLayer(size(tmp_m_sediment, dim=1) + 1, size(tmp_m_sediment, dim=2), size(tmp_m_sediment, dim=3)))
- me%m_sediment_t_byLayer(:size(tmp_m_sediment, dim=1), :, :) = tmp_m_sediment
- me%m_sediment_t_byLayer(size(tmp_m_sediment, dim=1) + 1, :, :) = me%get_m_sediment_byLayer()
+ allocate(me%m_sediment_t_byLayer(size(tmp_m_sediment,1)+1, C%nSedimentLayers, C%nSizeClassesSpm), stat=allst)
+ if (allst /= 0) then
+ call LOGR%add("Error allocating m_sediment_t_byLayer")
+ return
+ end if
+ me%m_sediment_t_byLayer(1:size(tmp_m_sediment,1),:,:) = tmp_m_sediment
+ me%m_sediment_t_byLayer(size(tmp_m_sediment,1)+1,:,:) = me%get_m_sediment_byLayer()
end subroutine
- !> Update an individual reach, also updating the containng grid cell, if it hasn't
+ !> Update an individual reach, also updating the containing grid cell, if it hasn't
!! already been updated.
subroutine updateReachEnvironment(me, t, reach, isWarmUp)
- class(Environment), target :: me !! This `Environment` instance
- integer :: t !! Time step
- type(ReachPointer) :: reach !! Pointer to the reach to update
- logical :: isWarmUp !! Are we in a warm up period?
- type(GridCellPointer) :: cell ! Pointer to this reach's grid cell
- real(dp) :: lengthRatio ! Length ratio of this reach to the total reach length in cell
- real(dp) :: j_spm_runoff(C%nSizeClassesSpm) ! Sediment runoff [kg/timestep]
- real(dp) :: j_np_runoff(C%npDim(1), C%npDim(2), C%npDim(3)) ! Proportion of cell's NM runoff going to this reach
- real(dp) :: j_transformed_runoff(C%npDim(1), C%npDim(2), C%npDim(3)) ! Proportion of cell's transformed NM runoff going to this reach
- ! Get this reach's cell
+ class(Environment), target :: me
+ integer :: t
+ type(ReachPointer) :: reach
+ logical :: isWarmUp
+ type(GridCellPointer) :: cell
+ real(dp) :: lengthRatio
+ real(dp) :: j_spm_runoff(C%nSizeClassesSpm)
+ type(Contaminant) :: j_contaminant_runoff
+ type(Result) :: r_cr ! for create()
+ character(len=256) :: tr
+
+ tr = "Environment%updateReachEnvironment"
cell%item => me%colGridCells(reach%item%x, reach%item%y)%item
- ! Only update if this cell isn't masked
+
if (DATASET%simulationMask(cell%item%x, cell%item%y)) then
- ! Determine the proportion of this reach's length to the the total
- ! river length in this GridCell and use it to proportion NM runoff
- lengthRatio = reach%item%length/cell%item%getTotalReachLength()
- ! Convert eroded sediment from kg/m2/day to kg/reach/day.
- j_spm_runoff = cell%item%erodedSediment * cell%item%area * lengthRatio ! [kg/timestep]
- j_np_runoff = lengthRatio*cell%item%colSoilProfiles(1)%item%m_np_eroded ! [kg/timestep]
- j_transformed_runoff = lengthRatio*cell%item%colSoilProfiles(1)%item%m_transformed_eroded ! [kg/timestep]
-
- ! Update the reach for this timestep
+ ! compute partitioning
+ lengthRatio = reach%item%length / cell%item%getTotalReachLength()
+ j_spm_runoff = cell%item%erodedSediment * cell%item%area * lengthRatio
+
+ ! initialize contaminant-runoff object
+ r_cr = j_contaminant_runoff%create()
+ if (r_cr%hasError()) then
+ call LOGR%toFile(errors=r_cr%errors)
+ call ERROR_HANDLER%trigger(errors=r_cr%errors)
+ return
+ end if
+
+ if (allocated(cell%item%colSoilProfiles)) then
+ call j_contaminant_runoff%multiply_scalar( &
+ cell%item%colSoilProfiles(1)%item%m_contaminant_eroded, &
+ lengthRatio )
+ end if
+
+ ! now update the reach
call reach%item%update( &
- t=t, &
- q_runoff=cell%item%q_runoff_timeSeries(t), &
- q_overland=real(DATASET%quickflow(cell%item%x, cell%item%y, t), 8), &
- j_spm_runoff=j_spm_runoff, &
- j_np_runoff=j_np_runoff, &
- j_transformed_runoff=j_transformed_runoff, &
- contributingArea=cell%item%area * lengthRatio, &
- isWarmUp=isWarmUp &
- )
+ t = t, &
+ q_runoff = cell%item%q_runoff_timeSeries(t), &
+ q_overland = real(DATASET%quickflow(cell%item%x, cell%item%y, t), dp), &
+ j_spm_runoff = j_spm_runoff, &
+ j_contaminant_runoff = j_contaminant_runoff, &
+ contributingArea = cell%item%area * lengthRatio, &
+ isWarmUp = isWarmUp )
+
+ call j_contaminant_runoff%finalise()
end if
end subroutine
+
+
subroutine determineStreamOrderEnvironment(me)
class(Environment) :: me !! This Environment instance
- integer :: streamOrder !! Index to keep track of stream order
- type(ReachPointer) :: reach ! Pointer to the reach we're updating
- logical :: goDownstream ! Flag to determine whether to go to next downstream reach
- integer :: i, j, rr, x, y ! Iterators
+ integer :: streamOrder !! Index to keep track of stream order
+ type(ReachPointer) :: reach ! Pointer to the reach we're updating
+ logical :: goDownstream ! Flag to determine whether to go to next downstream reach
+ integer :: i, j, rr, x, y ! Iterators
streamOrder = 1
! Loop through the headwaters and route from these downstream
@@ -298,7 +347,6 @@ subroutine determineStreamOrderEnvironment(me)
end if
end do
! Reset the isUpdated flag
- ! TODO tidy up
do y = 1, size(me%colGridCells, 2) ! Loop through the rows
do x = 1, size(me%colGridCells, 1) ! Loop through the columns
if (.not. me%colGridCells(x,y)%item%isEmpty) then
@@ -308,9 +356,28 @@ subroutine determineStreamOrderEnvironment(me)
end if
end do
end do
-
end subroutine
+ function parseInputDataEnvironment(me) result(r)
+ class(Environment) :: me
+ type(Result) :: r
+ integer :: x, y
+ character(len=256):: tr
+
+ tr = "Environment%parseInputDataEnvironment"
+
+ do y = 1, size(me%colGridCells, 2)
+ do x = 1, size(me%colGridCells, 1)
+ ! Just call the subroutine on each concrete GridCell
+ call me%colGridCells(x,y)%item%parseInputData()
+ end do
+ end do
+
+ call r%addToTrace(tr // ": parsed all grid‑cell input data")
+ end function parseInputDataEnvironment
+
+
+
subroutine parseNewBatchDataEnvironment(me)
class(Environment) :: me
integer :: x, y
@@ -322,95 +389,215 @@ subroutine parseNewBatchDataEnvironment(me)
end do
end subroutine
- !> Get the mass of NM in all waterbodies in the environment
- !! TODO is this used? If so, check it works
- function get_m_npEnvironment(me) result(m_np)
+ !> Get the total mass of Contaminant in all waterbodies in the environment
+ function get_m_contaminantEnvironment(me) result(m_contaminant)
class(Environment) :: me
- real(dp) :: m_np(C%nSizeClassesNM, 4, 2 + C%nSizeClassesSpm)
- integer :: x, y, rr
- m_np = 0
- do y = 1, size(me%colGridCells, 2)
- do x = 1, size(me%colGridCells, 1)
- do rr = 1, size(me%colGridCells(x,y)%item%colRiverReaches)
- m_np = m_np + me%colGridCells(x,y)%item%colRiverReaches(rr)%item%reactor%m_np
- end do
- end do
- end do
- end function
+ type(Contaminant) :: m_contaminant
+ type(Result) :: rslt
+ integer :: x, y, rr
+
+ ! Initialize the Contaminant object
+ rslt = m_contaminant%create()
+ if (rslt%hasError()) then
+ call rslt%addToTrace("Failed to create m_contaminant in get_m_contaminantEnvironment")
+ call LOGR%toFile(errors=rslt%errors)
+ call ERROR_HANDLER%trigger(errors=rslt%errors)
+ return
+ end if
- !> Calculate the mean soil PEC in the environment
- function get_C_np_soilEnvironment(me) result(C_np_soil)
- class(Environment) :: me !! This Environment instance
- real(dp), allocatable :: C_np_soil(:,:,:) !! Mass concentration of NM in environment [kg/kg soil]
- real(dp) :: C_np_soil_i(me%nGridCells, C%npDim(1), C%npDim(2), C%npDim(3)) ! Per grid NM conc [kg/kg soil]
- integer :: x, y, i ! Iterators
- allocate(C_np_soil(C%npDim(1), C%npDim(2), C%npDim(3)))
- i = 1
+ ! Loop over all non‐empty grid cells and their reaches
do y = 1, size(me%colGridCells, 2)
do x = 1, size(me%colGridCells, 1)
if (.not. me%colGridCells(x,y)%item%isEmpty) then
- associate (cell => me%colGridCells(x,y)%item)
- C_np_soil_i(i, :, :, :) = cell%get_C_np_soil()
- end associate
- i = i + 1
+ do rr = 1, me%colGridCells(x,y)%item%nReaches
+ associate(reactor => me%colGridCells(x,y)%item%colRiverReaches(rr)%item%reactor)
+ call m_contaminant%add(reactor%contaminant)
+ end associate
+ end do
end if
end do
end do
- C_np_soil = divideCheckZero(sum(C_np_soil_i, dim=1), me%nGridCells)
- end function
- !> Get the mean water NM PEC at this moment in time, by looping over all grid cells
- !! and their water bodies and averaging.
- function get_C_np_waterEnvironment(me) result(C_np_water)
- class(Environment) :: me !! This Environment instance
- real(dp), allocatable :: C_np_water(:,:,:) !! Mean water PEC [kg/m3]
- real(dp) :: C_np_water_i(me%nGridCells, C%npDim(1), C%npDim(2), C%npDim(3)) ! Per cell mean water PEC [kg/m3]
- real(dp) :: volumes(me%nGridCells) ! Per cell sediment volumes, for weighted average [m3]
- integer :: x, y, i ! Iterators
- allocate(C_np_water(C%npDim(1), C%npDim(2), C%npDim(3)))
- i = 1
+ end function
+
+ function get_C_contaminant_soilEnvironment(me) result(C_contaminant_soil)
+ class(Environment) :: me
+ type(Contaminant) :: C_contaminant_soil ! Correct return type
+ type(Contaminant) :: m_total_contaminant ! Accumulator for contaminant mass
+ real(dp) :: m_total_soil ! Accumulator for total soil mass
+ type(Result) :: r
+ integer :: x, y, p
+ character(len=256) :: tr
+
+ tr = "Environment%get_C_contaminant_soilEnvironment"
+
+ ! Initialize accumulators
+ r = m_total_contaminant%create()
+ if (r%hasError()) then
+ call r%addToTrace(tr)
+ call LOGR%toFile(errors=r%errors)
+ call ERROR_HANDLER%trigger(errors=r%errors)
+ ! Return an empty object on error
+ r = C_contaminant_soil%create()
+ return
+ end if
+ m_total_soil = 0.0_dp
+
+ ! Loop over all grid cells and their soil profiles
do y = 1, size(me%colGridCells, 2)
do x = 1, size(me%colGridCells, 1)
if (.not. me%colGridCells(x,y)%item%isEmpty) then
- associate (cell => me%colGridCells(x,y)%item)
- C_np_water_i(i, :, :, :) = cell%get_C_np_water()
- volumes(i) = cell%getWaterVolume()
- end associate
- i = i + 1
+ do p = 1, me%colGridCells(x,y)%item%nSoilProfiles
+ associate (profile => me%colGridCells(x,y)%item%colSoilProfiles(p)%item)
+ ! Add contaminant mass from this profile to the total
+ call m_total_contaminant%add(profile%get_m_contaminant())
+ ! Add soil mass from this profile to the total [kg]
+ m_total_soil = m_total_soil + (profile%bulkDensity * profile%area * sum(C%soilLayerDepth))
+ end associate
+ end do
end if
end do
end do
- C_np_water = weightedAverage(C_np_water_i, volumes)
+
+ ! Calculate the final average concentration (kg contaminant / kg soil)
+ C_contaminant_soil = m_total_contaminant%divideCheckZero(m_total_soil)
+
+ ! Clean up temporary object
+ call m_total_contaminant%finalise()
+
end function
- !> Get the mean sediment NM PEC [kg/kg] at this moment in time, by looping over all grid cells
- !! and their water bodies and getting the weighted average.
- function get_C_np_sedimentEnvironment(me) result(C_np_sediment)
- class(Environment) :: me !! This Environment instance
- real(dp), allocatable :: C_np_sediment(:,:,:) !! Mean sediment PEC [kg/kg]
- real(dp) :: C_np_sediment_i(me%nGridCells, C%npDim(1), C%npDim(2), C%npDim(3)) ! Per cell mean sediment PEC [kg/kg]
- real(dp) :: sedimentMasses(me%nGridCells) ! Per cell sediment masses, for weighted average [kg]
- integer :: x, y, i ! Iterators
- allocate(C_np_sediment(C%npDim(1), C%npDim(2), C%npDim(3)))
- i = 1
- do y = 1, size(me%colGridCells, 2)
- do x = 1, size(me%colGridCells, 1)
- if (.not. me%colGridCells(x,y)%item%isEmpty) then
- associate (cell => me%colGridCells(x,y)%item)
- C_np_sediment_i(i, :, :, :) = cell%get_C_np_sediment()
- sedimentMasses(i) = cell%getBedSedimentMass()
- end associate
- i = i + 1
- end if
+ !> Get the mean water‐phase Contaminant PEC at this moment in time,
+ !! by looping over all grid cells and averaging.
+ function get_C_contaminant_waterEnvironment(me) result(C_contaminant_water)
+ class(Environment) :: me
+ type(Contaminant) :: C_contaminant_water
+ type(Result) :: rslt
+ type(Contaminant), allocatable :: m_i(:)
+ real(dp), allocatable :: volumes(:)
+ integer :: x, y, idx, n
+
+ ! Count non‐empty cells
+ n = 0
+ do y = 1, size(me%colGridCells,2)
+ do x = 1, size(me%colGridCells,1)
+ if (.not. me%colGridCells(x,y)%item%isEmpty) n = n + 1
end do
end do
- C_np_sediment = weightedAverage(C_np_sediment_i, sedimentMasses)
- end function
+
+ if (n == 0) then
+ ! Create an empty result and return
+ rslt = C_contaminant_water%create()
+ return
+ end if
+
+ ! Allocate temporary arrays
+ allocate(m_i(n))
+ allocate(volumes(n))
+
+ ! Initialize the Contaminant result
+ rslt = C_contaminant_water%create()
+ if (rslt%hasError()) then
+ call rslt%addToTrace("Failed to create C_contaminant_water")
+ call LOGR%toFile(errors=rslt%errors)
+ call ERROR_HANDLER%trigger(errors=rslt%errors)
+ return
+ end if
+
+ ! Gather per‐cell mass and volume
+ idx = 0
+ do y = 1, size(me%colGridCells,2)
+ do x = 1, size(me%colGridCells,1)
+ if (.not. me%colGridCells(x,y)%item%isEmpty) then
+ idx = idx + 1
+ m_i(idx) = me%colGridCells(x,y)%item%get_m_contaminant_water()
+ volumes(idx)= me%colGridCells(x,y)%item%getWaterVolume()
+ end if
+ end do
+ end do
+
+ ! Build the volume‐weighted sum
+ do idx = 1, n
+ if (volumes(idx) > C%epsilon) then
+ call C_contaminant_water%add_scaled(m_i(idx), volumes(idx))
+ end if
+ end do
+
+ ! Normalize by total volume
+ if (sum(volumes) > C%epsilon) then
+ call C_contaminant_water%multiply_scalar( &
+ C_contaminant_water, &
+ 1.0_dp / sum(volumes) &
+ )
+ end if
+
+ end function
+
+ !> Get the mean sediment Contaminant PEC [kg/kg] at this moment in time,
+ ! by looping over all grid cells and their water bodies and getting the
+ !! weighted average.
+ function get_C_contaminant_sedimentEnvironment(me) result(C_contaminant_sediment)
+ class(Environment) :: me
+ type(Contaminant) :: C_contaminant_sediment
+ type(Result) :: rslt
+ type(Contaminant), allocatable :: m_i(:)
+ real(dp), allocatable :: masses(:)
+ integer :: x, y, idx, n
+
+ ! Count non‐empty cells
+ n = 0
+ do y = 1, size(me%colGridCells,2)
+ do x = 1, size(me%colGridCells,1)
+ if (.not. me%colGridCells(x,y)%item%isEmpty) n = n + 1
+ end do
+ end do
+
+ ! Allocate temp arrays
+ allocate(m_i(n))
+ allocate(masses(n))
+
+ ! Initialize the result object
+ rslt = C_contaminant_sediment%create()
+ if (rslt%hasError()) then
+ call rslt%addToTrace("Failed to create C_contaminant_sediment")
+ call LOGR%toFile(errors=rslt%errors)
+ call ERROR_HANDLER%trigger(errors=rslt%errors)
+ return
+ end if
+
+ ! Gather per‐cell contaminant and sediment mass
+ idx = 0
+ do y = 1, size(me%colGridCells,2)
+ do x = 1, size(me%colGridCells,1)
+ if (.not. me%colGridCells(x,y)%item%isEmpty) then
+ idx = idx + 1
+ m_i(idx) = me%colGridCells(x,y)%item%get_C_contaminant_sediment()
+ masses(idx) = me%colGridCells(x,y)%item%getBedSedimentMass()
+ end if
+ end do
+ end do
+
+ ! Build weighted sum
+ do idx = 1, n
+ if (masses(idx) > C%epsilon) then
+ call C_contaminant_sediment%add_scaled(m_i(idx), masses(idx))
+ end if
+ end do
+
+ ! Normalize to get the mean
+ if (sum(masses) > C%epsilon) then
+ call C_contaminant_sediment%multiply_scalar( &
+ C_contaminant_sediment, &
+ 1.0_dp / sum(masses) &
+ )
+ end if
+
+ end function
function getBedSedimentAreaEnvironment(me) result(bedArea)
class(Environment) :: me
- real(dp) :: bedArea
- integer :: x, y
+ real(dp) :: bedArea
+ integer :: x, y
bedArea = 0.0_dp
do y = 1, size(me%colGridCells, dim=2)
do x = 1, size(me%colGridCells, dim=1)
@@ -424,14 +611,13 @@ function getBedSedimentAreaEnvironment(me) result(bedArea)
!> Get the mass of sediment [kg] in the environment, broken down by layer and sediment
!! size class.
function get_m_sediment_byLayerEnvironment(me) result(m_sediment_byLayer)
- class(Environment) :: me !! This Environment instance
- real(dp), allocatable :: m_sediment_byLayer(:,:) !! Mass of sediment in the environment [kg]
- integer :: x, y, i, j, k ! Iterators
+ class(Environment) :: me
+ real(dp), allocatable :: m_sediment_byLayer(:,:)
+ integer :: x, y, i, j, k
+ character(len=256) :: tr
+ tr = "Environment%get_m_sediment_byLayerEnvironment"
allocate(m_sediment_byLayer(C%nSedimentLayers, C%nSizeClassesSpm))
m_sediment_byLayer = 0.0_dp
- ! Loop through cells and reaches and sum up the sediment mass. GFortran compiler
- ! bugs meant I was struggling to encase the reach/sediment actions within their
- ! own class, so as a work around they will be pulled directly from here
do y = 1, size(me%colGridCells, dim=2)
do x = 1, size(me%colGridCells, dim=1)
if (.not. me%colGridCells(x,y)%item%isEmpty) then
@@ -439,9 +625,9 @@ function get_m_sediment_byLayerEnvironment(me) result(m_sediment_byLayer)
associate (sediment => me%colGridCells(x,y)%item%colRiverReaches(i)%item%bedSediment)
do j = 1, C%nSedimentLayers
do k = 1, C%nSizeClassesSpm
- m_sediment_byLayer(j,k) = m_sediment_byLayer(j,k) &
- + sediment%colBedSedimentLayers(j)%item%colFineSediment(k)%M_f() &
- * me%colGridCells(x,y)%item%colRiverReaches(i)%item%bedArea
+ m_sediment_byLayer(j,k) = m_sediment_byLayer(j,k) + &
+ sediment%colBedSedimentLayers(j)%item%colFineSediment(k)%M_f() * &
+ me%colGridCells(x,y)%item%colRiverReaches(i)%item%bedArea
end do
end do
end associate
@@ -450,5 +636,5 @@ function get_m_sediment_byLayerEnvironment(me) result(m_sediment_byLayer)
end do
end do
end function
-
-end module
+
+end module
\ No newline at end of file
diff --git a/src/GlobalsModule.f90 b/src/GlobalsModule.f90
index 56cf677..c4fc581 100644
--- a/src/GlobalsModule.f90
+++ b/src/GlobalsModule.f90
@@ -8,6 +8,11 @@ module GlobalsModule
use ErrorInstanceModule
use ResultModule, only: Result
implicit none
+
+ ! Contaminant state constants
+ integer, parameter :: FREE_CONTAMINANT = 1
+ integer, parameter :: ATTACHED_CONTAMINANT = 2
+ integer, parameter :: SPM_CONTAMINANT_START = 3
type(ErrorCriteria) :: ERROR_HANDLER ! Global error handling
integer, parameter :: dp = selected_real_kind(15, 307) ! Double precision
@@ -40,7 +45,7 @@ module GlobalsModule
logical :: includeSoilLayerBreakdown !! Include breakdown of data over soil layers?
character(len=5) :: soilPECUnits !! What units to use for soil PEC - kg/m3 or kg/kg dw?
character(len=5) :: sedimentPECUnits !! What units to use for sediment PEC - kg/m4 or kg/kg dw?
- logical :: includeSoilStateBreakdown !! Should the breakdown of NM state (free vs attached) be included?
+ logical :: includeSoilStateBreakdown !! Should the breakdown of Contaminant state (free vs attached) be included?
logical :: includeSedimentFluxes !! Should sediment fluxes to/from waterbodies be included?
logical :: includeSpmSizeClassBreakdown !! Should the breakdown of SPM size classes be included?
logical :: includeSoilErosionYields !! Should sediment fluxes to/from waterbodies be included?
@@ -54,11 +59,11 @@ module GlobalsModule
integer :: timeStep !! The timestep to run the model on [s]
integer :: nTimeSteps !! The number of timesteps
real(dp) :: epsilon = 1e-10 !! Used as proximity to check whether variable as equal
- integer :: warmUpPeriod !! How long before we start inputting NM (to give flows to reach steady state)?
+ integer :: warmUpPeriod !! How long before we start inputting Contaminant (to give flows to reach steady state)?
logical :: triggerWarnings !! Should error warnings be printed to the console?
logical :: hasSimulationMask = .false. !! Are we meant to mask the simulation (i.e. only use a subset of the input dataset)?
character(len=256) :: simulationMaskPath = "" !! Path to NetCDF simulation mask
- logical :: ignoreNM !! If .true., miss out costly NM calculations. Useful for sediment calibration, NM PECs will be invalid
+ logical :: ignoreContaminant !! If .true., miss out costly Contaminant calculations. Useful for sediment calibration, Contaminant PECs will be invalid
logical :: bashColors !! Should output to the console use ANSI color codes?
! Checkpointing
@@ -118,20 +123,20 @@ module GlobalsModule
real(dp) :: T = 15.0_dp !! Temperature [C]
! Size class distributions
- real, allocatable :: d_spm(:) !! Suspended particulate matter size class diameters [m]
- real, allocatable :: d_spm_low(:) !! Lower bound when treating each size class as distribution [m]
- real, allocatable :: d_spm_upp(:) !! Upper bound when treating each size class as distribution [m]
- real, allocatable :: d_nm(:) !! Nanomaterial size class diameters [m]
- real, allocatable :: sedimentParticleDensities(:) !! Sediment particle densities [kg m-3]
+ real(dp), allocatable :: d_spm(:) !! Suspended particulate matter size class diameters [m]
+ real(dp), allocatable :: d_spm_low(:) !! Lower bound when treating each size class as distribution [m]
+ real(dp), allocatable :: d_spm_upp(:) !! Upper bound when treating each size class as distribution [m]
+ real(dp), allocatable :: d_contaminant(:) !! Contaminant size class diameters [m]
+ real(dp), allocatable :: sedimentParticleDensities(:) !! Sediment particle densities [kg m-3]
integer :: nSizeClassesSpm !! Number of sediment particle size classes
- integer :: nSizeClassesNM !! Number of nanoparticle size classes
integer :: nFracCompsSpm !! Number of sediment fractional compositions
- integer :: nFormsNM !! Number of NM forms (e.g. pristine, transformed, etc)
- integer :: nExtraStatesNM !! Number of NM states other than heteroaggregated to SPM
+ integer :: nContaminantSizeClasses !! Number of contaminant size classes
+ integer :: nContaminantForms !! Number of contaminant forms (e.g. pristine, transformed, etc)
+ integer :: nContaminantExtraStates !! Number of contaminant states other than heteroaggregated to SPM
integer, allocatable :: defaultDistributionSediment(:) !! Default imposed size distribution for sediment
- integer, allocatable :: defaultDistributionNP(:) !! Default imposed size distribution for NPs
- integer :: npDim(3) !! Default dimensions for arrays of NM
- integer :: ionicDim !! Default dimensions for ionic metal
+ integer, allocatable :: defaultDistributionContaminant(:) !! Default imposed size distribution for contaminants
+ integer :: contaminantDim(3) !! Default dimensions for arrays of contaminant
+ integer :: ionicDim !! Default dimensions for ionic metal
contains
procedure :: rho_w ! Density of water
@@ -148,7 +153,7 @@ module GlobalsModule
subroutine GLOBALS_INIT()
integer :: n, i ! Iterators
integer :: nmlIOStat ! IO status for namelist reading
- type(ErrorInstance) :: errors(17) ! ErrorInstances to be added to ErrorHandler
+ type(ErrorInstance) :: errors(18) ! ErrorInstances to be added to ErrorHandler
character(len=256) :: configFilePath, batchRunFilePath
integer :: configFilePathLength, batchRunFilePathLength
! Values from config file
@@ -160,32 +165,67 @@ subroutine GLOBALS_INIT()
character(len=3) :: netcdf_write_mode
character(len=32) :: output_hash
integer, allocatable :: n_timesteps_per_chunk(:)
- integer :: n_nm_size_classes, n_nm_forms, n_nm_extra_states, warm_up_period, n_spm_size_classes, &
- n_fractional_compositions, n_chunks
- integer :: timestep, n_timesteps, n_soil_layers, n_sediment_layers, min_estuary_timestep
- real :: min_stream_slope
+ integer :: n_contaminant_size_classes
+ integer :: n_contaminant_forms
+ integer :: n_contaminant_extra_states
+ integer :: warm_up_period
+ integer :: n_spm_size_classes
+ integer :: n_fractional_compositions
+ integer :: n_chunks
+ integer :: timestep
+ integer :: n_timesteps
+ integer :: n_soil_layers
+ integer :: n_sediment_layers
+ integer :: min_estuary_timestep
+
+ real(dp) :: min_stream_slope
real(dp) :: epsilon, delta
- real, allocatable :: soil_layer_depth(:), nm_size_classes(:), spm_size_classes(:), &
- sediment_particle_densities(:), sediment_layer_depth(:)
- logical :: error_output, include_bioturbation, include_attachment, include_point_sources, include_bed_sediment, &
- write_csv, write_netcdf, write_metadata_as_comment, include_sediment_layer_breakdown, &
- include_soil_layer_breakdown, include_soil_state_breakdown, save_checkpoint, reinstate_checkpoint, &
- preserve_timestep, trigger_warnings, run_to_steady_state, include_sediment_fluxes, include_soil_erosion_yields, &
- write_to_log, include_spm_size_class_breakdown, include_clay_enrichment, include_waterbody_breakdown, &
- write_compartment_stats, ignore_nm, include_estuary, bash_colors, save_checkpoint_after_warm_up, include_bank_erosion, &
- include_soil_erosion
-
+ real(dp), allocatable :: soil_layer_depth(:)
+ real(dp), allocatable :: contaminant_size_classes(:)
+ real(dp), allocatable :: spm_size_classes(:)
+ real(dp), allocatable :: sediment_particle_densities(:)
+ real(dp), allocatable :: sediment_layer_depth(:)
+ logical :: error_output
+ logical :: include_bioturbation
+ logical :: include_attachment
+ logical :: include_point_sources
+ logical :: include_bed_sediment
+ logical :: write_csv
+ logical :: write_netcdf
+ logical :: write_metadata_as_comment
+ logical :: include_sediment_layer_breakdown
+ logical :: include_soil_layer_breakdown
+ logical :: include_soil_state_breakdown
+ logical :: save_checkpoint
+ logical :: reinstate_checkpoint
+ logical :: preserve_timestep
+ logical :: trigger_warnings
+ logical :: run_to_steady_state
+ logical :: include_sediment_fluxes
+ logical :: include_soil_erosion_yields
+ logical :: write_to_log
+ logical :: include_spm_size_class_breakdown
+ logical :: include_clay_enrichment
+ logical :: include_waterbody_breakdown
+ logical :: write_compartment_stats
+ logical :: include_estuary
+ logical :: bash_colors
+ logical :: save_checkpoint_after_warm_up
+ logical :: include_bank_erosion
+ logical :: include_soil_erosion
+ logical :: ignore_contaminant
+
! Config file namelists
- namelist /allocatable_array_sizes/ n_soil_layers, n_nm_size_classes, n_spm_size_classes, &
+ namelist /allocatable_array_sizes/ n_soil_layers, n_contaminant_size_classes, n_spm_size_classes, &
n_fractional_compositions, n_sediment_layers
- namelist /nanomaterial/ n_nm_forms, n_nm_extra_states, nm_size_classes
+ namelist /contaminant/ n_contaminant_forms, n_contaminant_extra_states, contaminant_size_classes
namelist /data/ input_file, constants_file, output_path
namelist /output/ write_metadata_as_comment, include_sediment_layer_breakdown, include_soil_layer_breakdown, &
soil_pec_units, sediment_pec_units, include_soil_state_breakdown, write_csv, include_sediment_fluxes, &
include_soil_erosion_yields, include_spm_size_class_breakdown, include_waterbody_breakdown, write_compartment_stats, &
write_netcdf, netcdf_write_mode
namelist /run/ timestep, n_timesteps, epsilon, error_output, log_file_path, start_date, warm_up_period, &
- description, trigger_warnings, simulation_mask, write_to_log, output_hash, ignore_nm, bash_colors
+ description, trigger_warnings, simulation_mask, write_to_log, output_hash, ignore_contaminant, bash_colors
namelist /checkpoint/ checkpoint_file, save_checkpoint, reinstate_checkpoint, preserve_timestep, &
save_checkpoint_after_warm_up
namelist /steady_state/ run_to_steady_state, mode, delta
@@ -199,43 +239,42 @@ subroutine GLOBALS_INIT()
namelist /chunks/ input_files, constants_files, start_dates, n_timesteps_per_chunk
! Defaults, which will be overwritten if present in config file
- ! TODO move all defaults to DefaultsModule.f90
- write_to_log = configDefaults%writeToLog ! True
- write_csv = configDefaults%writeCSV ! True
- write_netcdf = configDefaults%writeNetCDF ! False
- netcdf_write_mode = configDefaults%netCDFWriteMode ! 'end'
- output_hash = configDefaults%outputHash ! ''
- description = configDefaults%description ! 'NanoFASE model run'
- batch_description = configDefaults%description ! 'NanoFASE model run'
- write_metadata_as_comment = configDefaults%writeMetadataAsComment ! True
- include_sediment_layer_breakdown = configDefaults%includeSedimentLayerBreakdown ! True
- include_soil_layer_breakdown = configDefaults%includeSoilLayerBreakdown ! True
- include_soil_state_breakdown = configDefaults%includeSoilStateBreakdown ! False
- include_sediment_fluxes = configDefaults%includeSedimentFluxes ! False
- include_spm_size_class_breakdown = configDefaults%includeSpmSizeClassBreakdown ! False
- include_soil_erosion_yields = configDefaults%includeSoilErosionYields ! False
- include_clay_enrichment = configDefaults%includeClayEnrichment ! False
- soil_pec_units = configDefaults%soilPECUnits ! kg/kg
- sediment_pec_units = configDefaults%sedimentPECUnits ! kg/kg
- save_checkpoint = configDefaults%saveCheckpoint ! False
- save_checkpoint_after_warm_up = configDefaults%saveCheckpointAfterWarmUp ! False
- checkpoint_file = configDefaults%checkpointFile ! ./checkpoint.dat
- reinstate_checkpoint = configDefaults%reinstateCheckpoint ! False
- preserve_timestep = configDefaults%preserveTimeStep ! False
- run_to_steady_state = configDefaults%runToSteadyState ! False
- delta = configDefaults%steadyStateDelta ! 1e-5
- mode = configDefaults%steadyStateMode ! 'sediment_size_distribution'
- simulation_mask = configDefaults%simulationMask ! ''
- min_stream_slope = configDefaults%minStreamSlope ! 0.001
- min_estuary_timestep = configDefaults%minEstuaryTimestep ! 3600
- include_waterbody_breakdown = configDefaults%includeWaterbodyBreakdown ! True
- write_compartment_stats = configDefaults%writeCompartmentStats ! False
- ignore_nm = configDefaults%ignoreNM ! False
- include_estuary = configDefaults%includeEstuary ! True
- include_bank_erosion = configDefaults%includeBankErosion ! True
- warm_up_period = configDefaults%warmUpPeriod ! 0
- bash_colors = configDefaults%bashColors ! True
- include_soil_erosion = configDefaults%includeSoilErosion ! True
+ write_to_log = configDefaults%writeToLog
+ write_csv = configDefaults%writeCSV
+ write_netcdf = configDefaults%writeNetCDF
+ netcdf_write_mode = configDefaults%netCDFWriteMode
+ output_hash = configDefaults%outputHash
+ description = configDefaults%description
+ batch_description = configDefaults%description
+ write_metadata_as_comment = configDefaults%writeMetadataAsComment
+ include_sediment_layer_breakdown = configDefaults%includeSedimentLayerBreakdown
+ include_soil_layer_breakdown = configDefaults%includeSoilLayerBreakdown
+ include_soil_state_breakdown = configDefaults%includeSoilStateBreakdown
+ include_sediment_fluxes = configDefaults%includeSedimentFluxes
+ include_spm_size_class_breakdown = configDefaults%includeSpmSizeClassBreakdown
+ include_soil_erosion_yields = configDefaults%includeSoilErosionYields
+ include_clay_enrichment = configDefaults%includeClayEnrichment
+ soil_pec_units = configDefaults%soilPECUnits
+ sediment_pec_units = configDefaults%sedimentPECUnits
+ save_checkpoint = configDefaults%saveCheckpoint
+ save_checkpoint_after_warm_up = configDefaults%saveCheckpointAfterWarmUp
+ checkpoint_file = configDefaults%checkpointFile
+ reinstate_checkpoint = configDefaults%reinstateCheckpoint
+ preserve_timestep = configDefaults%preserveTimeStep
+ run_to_steady_state = configDefaults%runToSteadyState
+ delta = configDefaults%steadyStateDelta
+ mode = configDefaults%steadyStateMode
+ simulation_mask = configDefaults%simulationMask
+ min_stream_slope = configDefaults%minStreamSlope
+ min_estuary_timestep = configDefaults%minEstuaryTimestep
+ include_waterbody_breakdown = configDefaults%includeWaterbodyBreakdown
+ write_compartment_stats = configDefaults%writeCompartmentStats
+ ignore_contaminant = configDefaults%ignoreContaminant
+ include_estuary = configDefaults%includeEstuary
+ include_bank_erosion = configDefaults%includeBankErosion
+ warm_up_period = configDefaults%warmUpPeriod
+ bash_colors = configDefaults%bashColors
+ include_soil_erosion = configDefaults%includeSoilErosion
! Has a path to the config path been provided as a command line argument?
call get_command_argument(1, configFilePath, configFilePathLength)
@@ -253,61 +292,53 @@ subroutine GLOBALS_INIT()
! If this is a batch run, then open the batch run config file and store the data from it
if (batchRunFilePathLength > 0) then
C%isBatchRun = .true.
- ! Open and read the namelists
open(iouBatchConfig, file=trim(batchRunFilePath), status="old")
read(iouBatchConfig, nml=batch_config); rewind(iouBatchConfig)
C%nChunks = n_chunks
- ! Allocate variables based on the number of batches
allocate(input_files(C%nChunks), &
- constants_files(C%nChunks), &
- start_dates(C%nChunks), &
- n_timesteps_per_chunk(C%nChunks))
- ! Now we can read the other variables in
+ constants_files(C%nChunks), &
+ start_dates(C%nChunks), &
+ n_timesteps_per_chunk(C%nChunks))
read(iouBatchConfig, nml=chunks)
- ! Store these in config variables
allocate(C%batchInputFiles, source=input_files)
allocate(C%batchConstantFiles, source=constants_files)
allocate(C%batchStartDates(C%nChunks))
allocate(C%batchNTimesteps, source=n_timesteps_per_chunk)
- ! Turn the datetime string into a datetime object
do i = 1, C%nChunks
C%batchStartDates(i) = f_strptime(start_dates(i))
end do
- ! Close the file
close(iouBatchConfig)
end if
- read(iouConfig, nml=allocatable_array_sizes); rewind(iouConfig)
- ! Use the allocatable array sizes to allocate those arrays (allocatable arrays
- ! must be allocated before being read in to)
+ ! Read all namelists in a single pass through the file.
+ ! This requires the .nml file to have the namelist groups in this order.
+ read(iouConfig, nml=allocatable_array_sizes)
allocate(soil_layer_depth(n_soil_layers))
allocate(sediment_layer_depth(n_sediment_layers))
- allocate(nm_size_classes(n_nm_size_classes))
+ allocate(contaminant_size_classes(n_contaminant_size_classes))
allocate(spm_size_classes(n_spm_size_classes))
allocate(sediment_particle_densities(n_fractional_compositions))
- ! Carry on reading in the different config groups
- read(iouConfig, nml=nanomaterial); rewind(iouConfig)
- read(iouConfig, nml=data); rewind(iouConfig)
- read(iouConfig, nml=output); rewind(iouConfig)
- read(iouConfig, nml=run); rewind(iouConfig)
- ! Checkpoint and steady state - check if groups exist before reading
- read(iouConfig, nml=checkpoint, iostat=nmlIOStat); rewind(iouConfig)
- if (nmlIOStat .ge. 0) read(iouConfig, nml=checkpoint); rewind(iouConfig)
- read(iouConfig, nml=steady_state, iostat=nmlIOStat); rewind(iouConfig)
- if (nmlIOStat .ge. 0) read(iouConfig, nml=steady_state); rewind(iouConfig)
- read(iouConfig, nml=soil); rewind(iouConfig)
- read(iouConfig, nml=sediment); rewind(iouConfig)
- read(iouConfig, nml=water, iostat=nmlIOStat); rewind(iouConfig)
- if (nmlIOStat .ge. 0) read(iouConfig, nml=water); rewind(iouConfig)
+ ! Ensure defined even if /sediment/ does not provide them
+ sediment_particle_densities = 0.0_dp
+ rewind(iouConfig)
+ read(iouConfig, nml=contaminant)
+ read(iouConfig, nml=data)
+ read(iouConfig, nml=output)
+ read(iouConfig, nml=run)
+ read(iouConfig, nml=checkpoint)
+ read(iouConfig, nml=steady_state)
+ read(iouConfig, nml=soil)
+ read(iouConfig, nml=sediment)
+ read(iouConfig, nml=water)
read(iouConfig, nml=sources)
close(iouConfig)
-
+
! Store this data in the Globals variable
- ! Nanomaterial
- C%nSizeClassesNM = n_nm_size_classes
- C%nFormsNM = n_nm_forms
- C%nExtraStatesNM = n_nm_extra_states
- allocate(C%d_nm, source=nm_size_classes)
+ ! Contaminant
+ C%nContaminantSizeClasses = n_contaminant_size_classes
+ C%nContaminantForms = n_contaminant_forms
+ C%nContaminantExtraStates = n_contaminant_extra_states
+ allocate(C%d_contaminant, source=contaminant_size_classes)
! Data
C%inputFile = input_file
C%constantsFile = constants_file
@@ -346,7 +377,7 @@ subroutine GLOBALS_INIT()
C%hasSimulationMask = .true.
C%simulationMaskPath = simulation_mask
end if
- C%ignoreNM = ignore_nm
+ C%ignoreContaminant = ignore_contaminant
C%warmUpPeriod = warm_up_period
C%bashColors = bash_colors
! Checkpointing
@@ -366,7 +397,17 @@ subroutine GLOBALS_INIT()
C%nSedimentLayers = n_sediment_layers
allocate(C%d_spm, source=spm_size_classes)
C%nFracCompsSpm = n_fractional_compositions
+
+ ! If /sediment/ didn’t specify densities, use a sane legacy default
+ if (all(sediment_particle_densities == 0.0_dp)) then
+ ! default to legacy 2-fraction pair
+ sediment_particle_densities = 0.0_dp
+ sediment_particle_densities(1) = 1500.0_dp
+ if (size(sediment_particle_densities) >= 2) sediment_particle_densities(2) = 2600.0_dp
+ end if
+
allocate(C%sedimentParticleDensities, source=sediment_particle_densities)
+
! Soil
C%nSoilLayers = n_soil_layers
C%soilLayerDepth = soil_layer_depth
@@ -394,7 +435,7 @@ subroutine GLOBALS_INIT()
C%batchStartDate = C%batchStartDates(1)
C%batchEndDate = C%batchStartDates(C%nChunks) + timedelta(C%batchNTimesteps(C%nChunks) - 1)
else
- C%nTimestepsInBatch = C%nTimesteps
+ C%nTimestepsInBatch = C%nTimeSteps
C%batchStartDate = C%startDate
C%batchEndDate = C%startDate + timedelta(C%nTimeSteps - 1)
allocate(C%batchNTimesteps(1))
@@ -403,38 +444,28 @@ subroutine GLOBALS_INIT()
allocate(C%d_spm_low(C%nSizeClassesSpm))
allocate(C%d_spm_upp(C%nSizeClassesSpm))
- ! Set the upper and lower bounds of each size class, if treated as a distribution
do n = 1, C%nSizeClassesSpm
- ! Set the upper and lower limit of the size class's distributions
if (n == C%nSizeClassesSpm) then
- C%d_spm_upp(n) = 1 ! failsafe overall upper size limit
+ C%d_spm_upp(n) = 1.0_dp
else
- C%d_spm_upp(n) = C%d_spm(n+1) - (C%d_spm(n+1)-C%d_spm(n))/2 ! Halfway between d_1 and d_2
- end if
+ C%d_spm_upp(n) = C%d_spm(n+1) - (C%d_spm(n+1)-C%d_spm(n))/2.0_dp
+ end if
end do
do n = 1, C%nSizeClassesSpm
if (n == 1) then
- C%d_spm_low(n) = 0 ! Particles can be any size below d_upp,1
+ C%d_spm_low(n) = 0.0_dp
else
- C%d_spm_low(n) = C%d_spm_upp(n-1) ! lower size boundary equals upper size boundary of lower size class
+ C%d_spm_low(n) = C%d_spm_upp(n-1)
end if
- end do
-
- ! Array to store default NM and ionic array dimensions. NM:
- ! 1: NP size class
- ! 2: form (core, shell, coating, corona)
- ! 3: state (free, bound, heteroaggregated)
- ! Ionic: Form (free ion, solution, adsorbed)
- C%npDim = [C%nSizeClassesNM, C%nFormsNM, C%nSizeClassesSpm + C%nExtraStatesNM]
-
+ end do
+
+ C%contaminantDim = [C%nContaminantSizeClasses, C%nContaminantForms, C%nSizeClassesSpm + C%nContaminantExtraStates]
+
! General
errors(1) = ErrorInstance(code=110, message="Invalid object type index in data file.")
- ! File operations
errors(2) = ErrorInstance(code=200, message="File not found.")
errors(3) = ErrorInstance(code=201, message="Variable not found in input file.")
- ! Numerical calculations
errors(6) = ErrorInstance(code=300, message="Newton's method failed to converge.")
- ! Grid and geography
errors(7) = ErrorInstance(code=401, &
message="Invalid RiverReach inflow reference. Inflow must be from a neighbouring RiverReach.")
errors(8) = ErrorInstance(code=402, &
@@ -448,26 +479,18 @@ subroutine GLOBALS_INIT()
errors(11) = ErrorInstance(code=405, &
message="RiverReach lengths specified in input data sum to greater than straight-line river branch " // &
"length. Are you sure this is intended?", isCritical=.false.)
- ! River routing
- errors(11) = ErrorInstance(code=500, &
+ errors(12) = ErrorInstance(code=500, &
message="All SPM advected from RiverReach.", isCritical=.false.)
- errors(12) = ErrorInstance(code=501, &
+ errors(13) = ErrorInstance(code=501, &
message="No input data provided for required SubRiver - check nSubRivers is correct.")
- ! Soil
- errors(13) = ErrorInstance(code=600, message="All water removed from SoilLayer.", isCritical=.false.)
- ! General
- errors(14) = ErrorInstance(code=901, message="Invalid RiverReach type index provided.")
- errors(15) = ErrorInstance(code=902, message="Invalid Biota index provided.")
- errors(16) = ErrorInstance(code=903, message="Invalid Reactor index provided.")
- errors(17) = ErrorInstance(code=904, message="Invalid BedSedimentLayer index provided.")
+ errors(14) = ErrorInstance(code=600, message="All water removed from SoilLayer.", isCritical=.false.)
+ errors(15) = ErrorInstance(code=901, message="Invalid RiverReach type index provided.")
+ errors(16) = ErrorInstance(code=902, message="Invalid Biota index provided.")
+ errors(17) = ErrorInstance(code=903, message="Invalid Reactor index provided.")
+ errors(18) = ErrorInstance(code=904, message="Invalid BedSedimentLayer index provided.")
- ! Add custom errors to the error handler
call ERROR_HANDLER%init(errors=errors, triggerWarnings=C%triggerWarnings, on=error_output)
-
- ! Auditing the config. Must be done after error handler and logger
- ! have been initialised
call C%audit()
-
end subroutine
!> Audit the config file options
@@ -520,11 +543,11 @@ subroutine audit(me)
!! [D. R. Maidment, Handbook of Hydrology (2012)](https://books.google.co.uk/books/about/Handbook_of_hydrology.html?id=4_9OAAAAMAAJ)
function rho_w(me, T, S)
class(GlobalsType), intent(in) :: me !! This `Constants` instance
- real, intent(in) :: T !! Temperature \( T \) [deg C]
+ real(dp), intent(in) :: T !! Temperature \( T \) [deg C]
real(dp), intent(in), optional :: S !! Salinity \( S \) [g/kg]
real(dp) :: rho_w !! Density of water \( \rho_w \) [kg/m**3].
if (present(S)) then
- rho_w = 1000.0_dp*(1-(T+288.9414_dp)/(508929.2_dp*(T+68.12963_dp))*(T-3.9863_dp)**2) &
+ rho_w = 1000.0_dp*(1-(T+288.9414_dp)/(508929.2_dp*(T+68.12963_dp))*(T-3.9863_dp)**2) &
+ (0.824493_dp - 0.0040899_dp*T + 0.000076438_dp*T**2 - 0.00000082467_dp*T**3 + 0.0000000053675_dp*T**4)*S &
+ (-0.005724_dp + 0.00010227_dp*T - 0.0000016546_dp*T**2)*S**(3.0_dp/2.0_dp) &
+ 0.00048314_dp*S**2
@@ -541,7 +564,7 @@ function rho_w(me, T, S)
!! Reference: [T. Al-Shemmeri](http://varunkamboj.typepad.com/files/engineering-fluid-mechanics-1.pdf)
function nu_w(me, T, S)
class(GlobalsType), intent(in) :: me !! This Globals instance
- real, intent(in) :: T !! Temperature \( T \) [deg C]
+ real(dp), intent(in) :: T !! Temperature \( T \) [deg C]
real(dp), intent(in), optional :: S !! Salinity \( S \) [g/kg]
real(dp) :: nu_w !! Kinematic viscosity of water \( \nu_{\text{w}} \)
if (present(S)) then
@@ -558,7 +581,7 @@ function nu_w(me, T, S)
!! Reference: [T. Al-Shemmeri](http://varunkamboj.typepad.com/files/engineering-fluid-mechanics-1.pdf)
function mu_w(me, T)
class(GlobalsType), intent(in) :: me
- real, intent(in) :: T
+ real(dp), intent(in) :: T
real(dp) :: mu_w
mu_w = (2.414e-5_dp * 10.0_dp**(247.8_dp/((T+273.15_dp)-140.0_dp)))
end function
diff --git a/src/GridCell/AbstractGridCellModule.f90 b/src/GridCell/AbstractGridCellModule.f90
index 481884b..98534ac 100644
--- a/src/GridCell/AbstractGridCellModule.f90
+++ b/src/GridCell/AbstractGridCellModule.f90
@@ -7,6 +7,7 @@ module AbstractGridCellModule
use AbstractSoilProfileModule
use DiffuseSourceModule
use CropModule
+ use ContaminantModule
implicit none
!> GridCellPointer used to link GridCells array, so the elements within can
@@ -15,6 +16,11 @@ module AbstractGridCellModule
class(AbstractGridCell), pointer :: item => null() !! Pointer to polymorphic GridCell object
end type
+ !> Container type for polymorphic AbstractGridCells
+ type GridCellElement
+ class(AbstractGridCell), pointer :: item => null()
+ end type
+
!> Abstract base class AbstractGridCell define the interface for grid cells
!! and their properties
type, abstract, public :: AbstractGridCell
@@ -52,7 +58,10 @@ module AbstractGridCellModule
real(dp), allocatable :: T_water_timeSeries(:) !! Water temperature [C]
real(dp), allocatable :: erodedSediment(:) !! Sediment yield eroded on this timestep [kg/m2/day], simulated by `SoilProfile`(s)
real(dp), allocatable :: distributionSediment(:) !! Distribution used to split sediment yields across size classes
- real(dp), allocatable :: j_np_diffuseSource(:,:,:) !! Input NPs from diffuse sources on this timestep [(kg/m2)/timestep]
+ type(Contaminant), allocatable :: j_contaminant_diffuseSource(:) !! Input Contaminant from diffuse sources on this timestep [(kg/m2)/timestep]
+ type(Contaminant) :: contaminant_water !! Water compartment contaminant
+ type(Contaminant) :: contaminant_sediment !! Sediment compartment contaminant
+ type(Contaminant), allocatable :: contaminant_water_t(:) !! Time-series tracking [kg]
logical :: isEmpty = .false. !! Is there anything going on in the `GridCell` or should we skip over when simulating?
logical :: isHeadwater = .false. !! Is this `GridCell` a headwater?
logical :: hasStreamJunctionInflow = .false. !! Is the inflow to this cell from more than one cell?
@@ -73,55 +82,44 @@ module AbstractGridCellModule
contains
! Creation/destruction
- procedure(createAbstractGridCell), deferred :: create
- procedure(finaliseCreateAbstractGridCell), deferred :: finaliseCreate
- procedure(snapPointSourcesToReachAbstractGridCell), deferred :: snapPointSourcesToReach
+ procedure(createAbstractGridCell), deferred :: create
+ procedure(finaliseCreateAbstractGridCell), deferred :: finaliseCreate
+ procedure(snapPointSourcesToReachAbstractGridCell), deferred :: snapPointSourcesToReach
! Simulation
- procedure(updateAbstractGridCell), deferred :: update
- procedure(finaliseUpdateAbstractGridCell), deferred :: finaliseUpdate
- procedure(parseNewBatchDataAbstractGridCell), deferred :: parseNewBatchData
+ procedure(updateAbstractGridCell), deferred :: update
+ procedure(finaliseUpdateAbstractGridCell), deferred :: finaliseUpdate
+ procedure(parseInputDataAbstractGridCell), deferred :: parseInputData
+ procedure(parseNewBatchDataAbstractGridCell), deferred :: parseNewBatchData
! Getters
- procedure(get_Q_outflowAbstractGridCell), deferred :: get_Q_outflow
- procedure(get_j_spm_outflowAbstractGridCell), deferred :: get_j_spm_outflow
- procedure(get_m_spmAbstractGridCell), deferred :: get_m_spm
- procedure(get_j_spm_inflowAbstractGridCell), deferred :: get_j_spm_inflow
- procedure(get_j_spm_soilErosionAbstractGridCell), deferred :: get_j_spm_soilErosion
- procedure(get_j_spm_bankErosionAbstractGridCell), deferred :: get_j_spm_bankErosion
- procedure(get_j_spm_depositionAbstractGridCell), deferred :: get_j_spm_deposition
- procedure(get_j_spm_resuspensionAbstractGridCell), deferred :: get_j_spm_resuspension
- procedure(get_m_np_waterAbstractGridCell), deferred :: get_m_np_water
- procedure(get_m_transformed_waterAbstractGridCell), deferred :: get_m_transformed_water
- procedure(get_m_dissolved_waterAbstractGridCell), deferred :: get_m_dissolved_water
- procedure(get_C_spmAbstractGridCell), deferred :: get_C_spm
- procedure(get_C_np_soilAbstractGridCell), deferred :: get_C_np_soil
- procedure(get_C_np_waterAbstractGridCell), deferred :: get_C_np_water
- procedure(get_C_np_sedimentAbstractGridCell), deferred :: get_C_np_sediment
- procedure(get_C_np_sediment_byVolumeAbstractGridCell), deferred :: get_C_np_sediment_byVolume
- procedure(get_C_np_sediment_lAbstractGridCell), deferred :: get_C_np_sediment_l
- procedure(get_C_np_sediment_l_byVolumeAbstractGridCell), deferred :: get_C_np_sediment_l_byVolume
- procedure(get_C_transformed_waterAbstractGridCell), deferred :: get_C_transformed_water
- procedure(get_C_dissolved_waterAbstractGridCell), deferred :: get_C_dissolved_water
- procedure(get_m_np_sedimentAbstractGridCell), deferred :: get_m_np_sediment
- procedure(get_m_np_buried_sedimentAbstractGridCell), deferred :: get_m_np_buried_sediment
- procedure(get_sediment_massAbstractGridCell), deferred :: get_sediment_mass
- procedure(get_j_nm_depositionAbstractGridCell), deferred :: get_j_nm_deposition
- procedure(get_j_transformed_depositionAbstractGridCell), deferred :: get_j_transformed_deposition
- procedure(get_j_nm_resuspensionAbstractGridCell), deferred :: get_j_nm_resuspension
- procedure(get_j_transformed_resuspensionAbstractGridCell), deferred :: get_j_transformed_resuspension
- procedure(get_j_nm_outflowAbstractGridCell), deferred :: get_j_nm_outflow
- procedure(get_j_transformed_outflowAbstractGridCell), deferred :: get_j_transformed_outflow
- procedure(get_j_dissolved_outflowAbstractGridCell), deferred :: get_j_dissolved_outflow
- procedure(getTotalReachLengthAbstractGridCell), deferred :: getTotalReachLength
- procedure(getWaterVolumeAbstractGridCell), deferred :: getWaterVolume
- procedure(getWaterDepthAbstractGridCell), deferred :: getWaterDepth
- procedure(getBedSedimentAreaAbstractGridCell), deferred :: getBedSedimentArea
- procedure(getBedSedimentMassAbstractGridCell), deferred :: getBedSedimentMass
+ procedure(get_Q_outflowAbstractGridCell), deferred :: get_Q_outflow
+ procedure(get_j_spm_outflowAbstractGridCell), deferred :: get_j_spm_outflow
+ procedure(get_m_spmAbstractGridCell), deferred :: get_m_spm
+ procedure(get_j_spm_inflowAbstractGridCell), deferred :: get_j_spm_inflow
+ procedure(get_j_spm_soilErosionAbstractGridCell), deferred :: get_j_spm_soilErosion
+ procedure(get_j_spm_bankErosionAbstractGridCell), deferred :: get_j_spm_bankErosion
+ procedure(get_j_spm_depositionAbstractGridCell), deferred :: get_j_spm_deposition
+ procedure(get_j_spm_resuspensionAbstractGridCell), deferred :: get_j_spm_resuspension
+ procedure(get_m_contaminant_waterAbstractGridCell), deferred :: get_m_contaminant_water
+ procedure(get_m_contaminant_sedimentAbstractGridCell), deferred :: get_m_contaminant_sediment
+ procedure(get_m_contaminant_buried_sedimentAbstractGridCell), deferred :: get_m_contaminant_buried_sediment
+ procedure(get_C_spmAbstractGridCell), deferred :: get_C_spm
+ procedure(get_C_contaminant_soilAbstractGridCell), deferred :: get_C_contaminant_soil
+ procedure(get_C_contaminant_waterAbstractGridCell), deferred :: get_C_contaminant_water
+ procedure(get_C_contaminant_sedimentAbstractGridCell), deferred :: get_C_contaminant_sediment
+ procedure(get_C_contaminant_sediment_byVolumeAbstractGridCell), deferred :: get_C_contaminant_sediment_byVolume
+ procedure(get_C_contaminant_sediment_lAbstractGridCell), deferred :: get_C_contaminant_sediment_l
+ procedure(get_C_contaminant_sediment_l_byVolumeAbstractGridCell), deferred :: get_C_contaminant_sediment_l_byVolume
+ procedure(get_C_dissolved_waterAbstractGridCell), deferred :: get_C_dissolved_water
+ procedure(get_j_contaminant_depositionAbstractGridCell), deferred :: get_j_contaminant_deposition
+ procedure(get_j_contaminant_resuspensionAbstractGridCell), deferred :: get_j_contaminant_resuspension
+ procedure(get_j_contaminant_outflowAbstractGridCell), deferred :: get_j_contaminant_outflow
+ procedure(getTotalReachLengthAbstractGridCell), deferred :: getTotalReachLength
+ procedure(getWaterVolumeAbstractGridCell), deferred :: getWaterVolume
+ procedure(getWaterDepthAbstractGridCell), deferred :: getWaterDepth
+ procedure(getBedSedimentAreaAbstractGridCell), deferred :: getBedSedimentArea
+ procedure(getBedSedimentMassAbstractGridCell), deferred :: getBedSedimentMass
end type
- !> Container type for polymorphic AbstractGridCells
- type GridCellElement
- class(AbstractGridCell), allocatable :: item !! Polymorphic AbstractGridCell object
- end type
abstract interface
!> Create this grid cell
@@ -159,6 +157,11 @@ subroutine snapPointSourcesToReachAbstractGridCell(me)
class(AbstractGridCell) :: me
end subroutine
+ subroutine parseInputDataAbstractGridCell(me)
+ import AbstractGridCell
+ class(AbstractGridCell) :: me
+ end subroutine
+
subroutine parseNewBatchDataAbstractGridCell(me)
import AbstractGridCell
class(AbstractGridCell) :: me
@@ -175,242 +178,217 @@ function get_Q_outflowAbstractGridCell(me) result(Q_outflow)
function get_j_spm_outflowAbstractGridCell(me) result(j_spm_outflow)
use GlobalsModule, only: dp, C
import AbstractGridCell
- class(AbstractGridCell) :: me !! This grid cell
- real(dp) :: j_spm_outflow(C%nSizeClassesSpm) !! SPM outflow to return
+ class(AbstractGridCell) :: me
+ real(dp) :: j_spm_outflow(C%nSizeClassesSpm)
end function
function get_m_spmAbstractGridCell(me) result(m_spm)
use GlobalsModule, only: dp, C
import AbstractGridCell
class(AbstractGridCell) :: me
- real(dp) :: m_spm(C%nSizeClassesSpm)
+ real(dp) :: m_spm(C%nSizeClassesSpm)
end function
function get_j_spm_inflowAbstractGridCell(me) result(j_spm_inflow)
use GlobalsModule, only: dp, C
import AbstractGridCell
class(AbstractGridCell) :: me
- real(dp) :: j_spm_inflow(C%nSizeClassesSpm)
+ real(dp) :: j_spm_inflow(C%nSizeClassesSpm)
end function
function get_j_spm_soilErosionAbstractGridCell(me) result(j_spm_soilErosion)
use GlobalsModule, only: dp, C
import AbstractGridCell
class(AbstractGridCell) :: me
- real(dp) :: j_spm_soilErosion(C%nSizeClassesSpm)
+ real(dp) :: j_spm_soilErosion(C%nSizeClassesSpm)
end function
function get_j_spm_bankErosionAbstractGridCell(me) result(j_spm_bankErosion)
use GlobalsModule, only: dp, C
import AbstractGridCell
class(AbstractGridCell) :: me
- real(dp) :: j_spm_bankErosion(C%nSizeClassesSpm)
+ real(dp) :: j_spm_bankErosion(C%nSizeClassesSpm)
end function
function get_j_spm_depositionAbstractGridCell(me) result(j_spm_deposition)
use GlobalsModule, only: dp, C
import AbstractGridCell
class(AbstractGridCell) :: me
- real(dp) :: j_spm_deposition(C%nSizeClassesSpm)
+ real(dp) :: j_spm_deposition(C%nSizeClassesSpm)
end function
function get_j_spm_resuspensionAbstractGridCell(me) result(j_spm_resuspension)
use GlobalsModule, only: dp, C
import AbstractGridCell
class(AbstractGridCell) :: me
- real(dp) :: j_spm_resuspension(C%nSizeClassesSpm)
- end function
-
- function get_m_np_waterAbstractGridCell(me) result(m_np)
- use GlobalsModule, only: dp, C
- import AbstractGridCell
- class(AbstractGridCell) :: me
- real(dp), allocatable :: m_np(:,:,:)
+ real(dp) :: j_spm_resuspension(C%nSizeClassesSpm)
end function
- function get_m_np_sedimentAbstractGridCell(me) result(m_np)
- use GlobalsModule, only: dp
+ function get_m_contaminant_waterAbstractGridCell(me) result(m_contaminant)
+ use ContaminantModule
import AbstractGridCell
class(AbstractGridCell) :: me
- real(dp), allocatable :: m_np(:,:,:)
+ type(Contaminant) :: m_contaminant
end function
- function get_m_transformed_waterAbstractGridCell(me) result(m_transformed)
- use GlobalsModule, only: dp, C
+ function get_m_contaminant_sedimentAbstractGridCell(me) result(m_contaminant)
+ use ContaminantModule
import AbstractGridCell
class(AbstractGridCell) :: me
- real(dp), allocatable :: m_transformed(:,:,:)
+ type(Contaminant) :: m_contaminant
end function
- function get_m_dissolved_waterAbstractGridCell(me) result(m_dissolved)
- use GlobalsModule, only: dp, C
+ function get_m_contaminant_buried_sedimentAbstractGridCell(me) result(m_contaminant_buried)
+ use ContaminantModule
import AbstractGridCell
class(AbstractGridCell) :: me
- real(dp) :: m_dissolved
+ type(Contaminant) :: m_contaminant_buried
end function
function get_C_spmAbstractGridCell(me) result(C_spm)
use GlobalsModule, only: dp, C
import AbstractGridCell
class(AbstractGridCell) :: me
- real(dp), allocatable :: C_spm(:)
- end function
-
- function get_C_np_soilAbstractGridCell(me) result(C_np_soil)
- use GlobalsModule, only: dp
- import AbstractGridCell
- class(AbstractGridCell) :: me
- real(dp), allocatable :: C_np_soil(:,:,:)
+ real(dp), allocatable :: C_spm(:)
end function
- function get_C_np_waterAbstractGridCell(me) result(C_np_water)
- use GlobalsModule, only: dp
+ function get_C_contaminant_soilAbstractGridCell(me) result(C_contaminant_soil)
+ use ContaminantModule
import AbstractGridCell
class(AbstractGridCell) :: me
- real(dp), allocatable :: C_np_water(:,:,:)
+ type(Contaminant) :: C_contaminant_soil
end function
- function get_C_np_sedimentAbstractGridCell(me) result(C_np_sediment)
- use GlobalsModule, only: dp
+ function get_C_contaminant_waterAbstractGridCell(me) result(C_contaminant_water)
+ use ContaminantModule
import AbstractGridCell
class(AbstractGridCell) :: me
- real(dp), allocatable :: C_np_sediment(:,:,:)
+ type(Contaminant) :: C_contaminant_water
end function
- function get_C_np_sediment_byVolumeAbstractGridCell(me) result(C_np_sediment)
- use GlobalsModule, only: dp
+ function get_C_contaminant_sedimentAbstractGridCell(me) result(C_contaminant_sediment)
+ use ContaminantModule
import AbstractGridCell
class(AbstractGridCell) :: me
- real(dp), allocatable :: C_np_sediment(:,:,:)
+ type(Contaminant) :: C_contaminant_sediment
end function
- function get_C_np_sediment_lAbstractGridCell(me, l) result(C_np_sediment)
- use GlobalsModule, only: dp
+ function get_C_contaminant_sediment_byVolumeAbstractGridCell(me) result(C_contaminant_sediment)
+ use ContaminantModule
import AbstractGridCell
class(AbstractGridCell) :: me
- integer :: l
- real(dp), allocatable :: C_np_sediment(:,:,:)
+ type(Contaminant) :: C_contaminant_sediment
end function
- function get_C_np_sediment_l_byVolumeAbstractGridCell(me, l) result(C_np_sediment)
- use GlobalsModule, only: dp
+ function get_C_contaminant_sediment_lAbstractGridCell(me, l) result(C_contaminant_sediment)
+ use ContaminantModule
import AbstractGridCell
class(AbstractGridCell) :: me
- integer :: l
- real(dp), allocatable :: C_np_sediment(:,:,:)
+ integer :: l
+ type(Contaminant) :: C_contaminant_sediment
end function
- function get_C_transformed_waterAbstractGridCell(me) result(C_transformed_water)
- use GlobalsModule, only: dp
+ function get_C_contaminant_sediment_l_byVolumeAbstractGridCell(me, l) result(C_contaminant_sediment)
+ use ContaminantModule
import AbstractGridCell
class(AbstractGridCell) :: me
- real(dp), allocatable :: C_transformed_water(:,:,:)
+ integer :: l
+ type(Contaminant) :: C_contaminant_sediment
end function
function get_C_dissolved_waterAbstractGridCell(me) result(C_dissolved_water)
use GlobalsModule, only: dp
import AbstractGridCell
class(AbstractGridCell) :: me
- real(dp) :: C_dissolved_water
- end function
-
- function get_m_np_buried_sedimentAbstractGridCell(me) result(m_np_buried)
- use GlobalsModule, only: dp
- import AbstractGridCell
- class(AbstractGridCell) :: me
- real(dp), allocatable :: m_np_buried(:,:,:)
- end function
-
- function get_sediment_massAbstractGridCell(me) result(sediment_mass)
- use GlobalsModule, only: dp
- import AbstractGridCell
- class(AbstractGridCell) :: me
- real(dp) :: sediment_mass
- end function
-
- function get_j_nm_depositionAbstractGridCell(me) result(j_nm_deposition)
- use GlobalsModule, only: dp
- import AbstractGridCell
- class(AbstractGridCell) :: me
- real(dp), allocatable :: j_nm_deposition(:,:,:)
- end function
-
- function get_j_transformed_depositionAbstractGridCell(me) result(j_transformed_deposition)
- use GlobalsModule, only: dp
- import AbstractGridCell
- class(AbstractGridCell) :: me
- real(dp), allocatable :: j_transformed_deposition(:,:,:)
- end function
-
- function get_j_nm_resuspensionAbstractGridCell(me) result(j_nm_resuspension)
- use GlobalsModule, only: dp
- import AbstractGridCell
- class(AbstractGridCell) :: me
- real(dp), allocatable :: j_nm_resuspension(:,:,:)
- end function
-
- function get_j_transformed_resuspensionAbstractGridCell(me) result(j_transformed_resuspension)
- use GlobalsModule, only: dp
- import AbstractGridCell
- class(AbstractGridCell) :: me
- real(dp), allocatable :: j_transformed_resuspension(:,:,:)
+ real(dp) :: C_dissolved_water
end function
- function get_j_nm_outflowAbstractGridCell(me) result(j_nm_outflow)
- use GlobalsModule, only: dp
+ function get_j_contaminant_depositionAbstractGridCell(me) result(j_contaminant_deposition)
+ use ContaminantModule
import AbstractGridCell
class(AbstractGridCell) :: me
- real(dp), allocatable :: j_nm_outflow(:,:,:)
+ type(Contaminant) :: j_contaminant_deposition
end function
- function get_j_transformed_outflowAbstractGridCell(me) result(j_transformed_outflow)
- use GlobalsModule, only: dp
+ function get_j_contaminant_resuspensionAbstractGridCell(me) result(j_contaminant_resuspension)
+ use ContaminantModule
import AbstractGridCell
class(AbstractGridCell) :: me
- real(dp), allocatable :: j_transformed_outflow(:,:,:)
+ type(Contaminant) :: j_contaminant_resuspension
end function
- function get_j_dissolved_outflowAbstractGridCell(me) result(j_dissolved_outflow)
- use GlobalsModule, only: dp
+ function get_j_contaminant_outflowAbstractGridCell(me) result(j_contaminant_outflow)
+ use ContaminantModule
import AbstractGridCell
class(AbstractGridCell) :: me
- real(dp) :: j_dissolved_outflow
+ type(Contaminant) :: j_contaminant_outflow
end function
function getTotalReachLengthAbstractGridCell(me) result(totalReachLength)
use GlobalsModule, only: dp
import AbstractGridCell
class(AbstractGridCell) :: me
- real(dp) :: totalReachLength
+ real(dp) :: totalReachLength
end function
function getWaterVolumeAbstractGridCell(me) result(waterVolume)
use GlobalsModule, only: dp
import AbstractGridCell
class(AbstractGridCell) :: me
- real(dp) :: waterVolume
+ real(dp) :: waterVolume
end function
function getWaterDepthAbstractGridCell(me) result(waterDepth)
use GlobalsModule, only: dp
import AbstractGridCell
class(AbstractGridCell) :: me
- real(dp) :: waterDepth
+ real(dp) :: waterDepth
end function
function getBedSedimentAreaAbstractGridCell(me) result(bedArea)
use GlobalsModule, only: dp
import AbstractGridCell
class(AbstractGridCell) :: me
- real(dp) :: bedArea
+ real(dp) :: bedArea
end function
function getBedSedimentMassAbstractGridCell(me) result(sedimentMass)
use GlobalsModule, only: dp
import AbstractGridCell
class(AbstractGridCell) :: me
- real(dp) :: sedimentMass
+ real(dp) :: sedimentMass
end function
-
end interface
-end module
+
+contains
+ subroutine finaliseAbstractGridCell(me)
+ class(AbstractGridCell) :: me
+ integer :: i
+ call me%contaminant_water%finalise()
+ call me%contaminant_sediment%finalise()
+ if (allocated(me%contaminant_water_t)) then
+ do i = 1, size(me%contaminant_water_t)
+ call me%contaminant_water_t(i)%finalise()
+ end do
+ deallocate(me%contaminant_water_t)
+ end if
+ if (allocated(me%j_contaminant_diffuseSource)) then
+ do i = 1, size(me%j_contaminant_diffuseSource)
+ call me%j_contaminant_diffuseSource(i)%finalise()
+ end do
+ deallocate(me%j_contaminant_diffuseSource)
+ end if
+ if (allocated(me%colRiverReaches)) deallocate(me%colRiverReaches)
+ if (allocated(me%colSoilProfiles)) deallocate(me%colSoilProfiles)
+ if (allocated(me%diffuseSources)) deallocate(me%diffuseSources)
+ if (allocated(me%crops)) deallocate(me%crops)
+ if (allocated(me%reachTypes)) deallocate(me%reachTypes)
+ if (allocated(me%q_runoff_timeSeries)) deallocate(me%q_runoff_timeSeries)
+ if (allocated(me%q_quickflow_timeSeries)) deallocate(me%q_quickflow_timeSeries)
+ if (allocated(me%q_evap_timeSeries)) deallocate(me%q_evap_timeSeries)
+ if (allocated(me%q_precip_timeSeries)) deallocate(me%q_precip_timeSeries)
+ if (allocated(me%T_water_timeSeries)) deallocate(me%T_water_timeSeries)
+ if (allocated(me%erodedSediment)) deallocate(me%erodedSediment)
+ if (allocated(me%distributionSediment)) deallocate(me%distributionSediment)
+ end subroutine
+end module
\ No newline at end of file
diff --git a/src/GridCell/GridCellModule.f90 b/src/GridCell/GridCellModule.f90
index 1f90f22..9869dc5 100644
--- a/src/GridCell/GridCellModule.f90
+++ b/src/GridCell/GridCellModule.f90
@@ -9,10 +9,11 @@ module GridCellModule
use RiverReachModule
use EstuaryReachModule
use CropModule
+ use ContaminantModule
implicit none
- !> Responsible for the creation of simulation of grid cells
- !! and contained compartments (e.g. rivers, soils).
+ !> Responsible for the creation and simulation of grid cells
+ !! and contained compartments (e.g., rivers, soils).
type, public, extends(AbstractGridCell) :: GridCell
contains
! Create/destroy
@@ -37,32 +38,25 @@ module GridCellModule
procedure :: get_j_spm_bankErosion => get_j_spm_bankErosionGridCell
procedure :: get_j_spm_deposition => get_j_spm_depositionGridCell
procedure :: get_j_spm_resuspension => get_j_spm_resuspensionGridCell
- procedure :: get_m_np_water => get_m_np_waterGridCell
- procedure :: get_m_transformed_water => get_m_transformed_waterGridCell
- procedure :: get_m_dissolved_water => get_m_dissolved_waterGridCell
+ procedure :: get_m_contaminant_water => get_m_contaminant_waterGridCell
procedure :: get_C_spm => get_C_spmGridCell
- procedure :: get_C_np_soil => get_C_np_soilGridCell
- procedure :: get_C_np_water => get_C_np_waterGridCell
- procedure :: get_C_np_sediment => get_C_np_sedimentGridCell
- procedure :: get_C_np_sediment_byVolume => get_C_np_sediment_byVolumeGridCell
- procedure :: get_C_np_sediment_l => get_C_np_sediment_lGridCell
- procedure :: get_C_np_sediment_l_byVolume => get_C_np_sediment_l_byVolumeGridCell
- procedure :: get_C_transformed_water => get_C_transformed_waterGridCell
- procedure :: get_C_dissolved_water => get_C_dissolved_waterGridCell
- procedure :: get_m_np_sediment => get_m_np_sedimentGridCell
- procedure :: get_m_np_buried_sediment => get_m_np_buried_sedimentGridCell
+ procedure :: get_C_contaminant_soil => get_C_contaminant_soilGridCell
+ procedure :: get_C_contaminant_water => get_C_contaminant_waterGridCell
+ procedure :: get_C_contaminant_sediment => get_C_contaminant_sedimentGridCell
+ procedure :: get_C_contaminant_sediment_byVolume => get_C_contaminant_sediment_byVolumeGridCell
+ procedure :: get_C_contaminant_sediment_l => get_C_contaminant_sediment_lGridCell
+ procedure :: get_C_contaminant_sediment_l_byVolume => get_C_contaminant_sediment_l_byVolumeGridCell
+ procedure :: get_m_contaminant_sediment => get_m_contaminant_sedimentGridCell
+ procedure :: get_m_contaminant_buried_sediment => get_m_contaminant_buried_sedimentGridCell
procedure :: get_sediment_mass => get_sediment_massGridCell
- procedure :: get_j_nm_deposition => get_j_nm_depositionGridCell
- procedure :: get_j_transformed_deposition => get_j_transformed_depositionGridCell
- procedure :: get_j_nm_resuspension => get_j_nm_resuspensionGridCell
- procedure :: get_j_transformed_resuspension => get_j_transformed_resuspensionGridCell
- procedure :: get_j_nm_outflow => get_j_nm_outflowGridCell
- procedure :: get_j_transformed_outflow => get_j_transformed_outflowGridCell
- procedure :: get_j_dissolved_outflow => get_j_dissolved_outflowGridCell
+ procedure :: get_j_contaminant_deposition => get_j_contaminant_depositionGridCell
+ procedure :: get_j_contaminant_resuspension => get_j_contaminant_resuspensionGridCell
+ procedure :: get_j_contaminant_outflow => get_j_contaminant_outflowGridCell
procedure :: getWaterVolume => getWaterVolumeGridCell
procedure :: getWaterDepth => getWaterDepthGridCell
procedure :: getBedSedimentArea => getBedSedimentAreaGridCell
procedure :: getBedSedimentMass => getBedSedimentMassGridCell
+ procedure :: get_C_dissolved_water => get_C_dissolved_waterGridCell
procedure :: getTotalReachLength => getTotalReachLengthGridCell
! Calculators
procedure :: reachLineParamsFromInflowsOutflow => reachLineParamsFromInflowsOutflowGridCell
@@ -72,27 +66,62 @@ module GridCellModule
!> Create a GridCell with coordinates x and y.
function createGridCell(me, x, y, isEmpty) result(rslt)
- class(GridCell), target :: me !! The `GridCell` instance.
- type(Result) :: rslt !! The `Result` object to return.
- integer :: x, y !! Spatial index of the grid cell
- logical, optional :: isEmpty !! Is anything to be simulated in this `GridCell`?
- type(SoilProfile) :: soilProfile ! The soil profile contained in this GridCell
+ class(GridCell), target :: me !! The `GridCell` instance.
+ type(Result) :: rslt !! The `Result` object to return.
+ integer :: x, y !! Spatial index of the grid cell
+ logical, optional :: isEmpty !! Is anything to be simulated in this `GridCell`?
+ type(SoilProfile) :: soilProfile ! The soil profile contained in this GridCell
+ type(Result) :: rslt_temp ! Temporary Result for error handling
+ character(len=100) :: compartment ! Compartment for contaminant initialization
+ character(len=7) :: comp_wat
! Allocate the object properties that need to be and set up defaults
allocate(me%colSoilProfiles(1))
- allocate(me%j_np_diffuseSource(C%npDim(1), C%npDim(2), C%npDim(3)))
+ allocate(me%j_contaminant_diffuseSource(2)) ! Two diffuse sources (soil, atmospheric)
+ if (me%aggregatedReachType == 'riv') then
+ comp_wat = 'water'//repeat(' ',2) ! make it length=7
+ else
+ comp_wat = 'estuary'
+ end if
+ rslt_temp = me%contaminant_water%create_from_data( &
+ trim(comp_wat), &
+ DATASET%contaminantDensity, DATASET%soilConstantAttachmentEfficiency, &
+ DATASET%riverAttachmentEfficiency, DATASET%estuaryAttachmentEfficiency, &
+ DATASET%contaminant_k_diss_pristine, DATASET%contaminant_k_diss_transformed, &
+ DATASET%contaminant_k_transform_pristine, real(DATASET%waterTemperature(1), dp))
+ call rslt%addErrors(.errors. rslt_temp)
+ rslt_temp = me%contaminant_sediment%create_from_data( &
+ 'sediment', &
+ DATASET%contaminantDensity, DATASET%soilConstantAttachmentEfficiency, &
+ DATASET%riverAttachmentEfficiency, DATASET%estuaryAttachmentEfficiency, &
+ DATASET%contaminant_k_diss_pristine, DATASET%contaminant_k_diss_transformed, &
+ DATASET%contaminant_k_transform_pristine, real(DATASET%waterTemperature(1), dp))
+ call rslt%addErrors(.errors. rslt_temp)
+ rslt_temp = me%j_contaminant_diffuseSource(1)%create_from_data( &
+ 'soil', &
+ DATASET%contaminantDensity, DATASET%soilConstantAttachmentEfficiency, &
+ DATASET%riverAttachmentEfficiency, DATASET%estuaryAttachmentEfficiency, &
+ DATASET%contaminant_k_diss_pristine, DATASET%contaminant_k_diss_transformed, &
+ DATASET%contaminant_k_transform_pristine, real(DATASET%waterTemperature(1), dp))
+ call rslt%addErrors(.errors. rslt_temp)
+ rslt_temp = me%j_contaminant_diffuseSource(2)%create_from_data( &
+ 'atmospheric', &
+ DATASET%contaminantDensity, DATASET%soilConstantAttachmentEfficiency, &
+ DATASET%riverAttachmentEfficiency, DATASET%estuaryAttachmentEfficiency, &
+ DATASET%contaminant_k_diss_pristine, DATASET%contaminant_k_diss_transformed, &
+ DATASET%contaminant_k_transform_pristine, real(DATASET%waterTemperature(1), dp))
+ call rslt%addErrors(.errors. rslt_temp)
me%q_runoff = 0
! Set the GridCell's position, whether it's empty and its name
me%x = x
me%y = y
- if (present(isEmpty)) me%isEmpty = isEmpty ! isEmpty defaults to false if not present
- me%ref = trim(ref("GridCell", x, y)) ! ref() interface is from the Util module
- me%nSoilProfiles = 0 ! Default to no soil profiles
+ if (present(isEmpty)) me%isEmpty = isEmpty ! isEmpty defaults to false if not present
+ me%ref = trim(ref("GridCell", x, y)) ! ref() interface is from the Util module
+ me%nSoilProfiles = 0 ! Default to no soil profiles
! Only carry on if there's stuff to be simulated for this GridCell
if (.not. me%isEmpty) then
-
! If cell not empty, then create just one soil profile
me%nSoilProfiles = 1
@@ -115,22 +144,21 @@ function createGridCell(me, x, y, isEmpty) result(rslt)
me%area, &
me%q_precip_timeseries, &
me%q_evap_timeseries &
- ) &
- )
- allocate(me%colsoilprofiles(1)%item, source=soilprofile)
- allocate(me%distributionsediment, source=me%colsoilprofiles(1)%item%distributionsediment)
+ ))
+ allocate(me%colSoilProfiles(1)%item, source=soilProfile)
+ allocate(me%distributionSediment, source=me%colSoilProfiles(1)%item%distributionSediment)
- ! only proceed if there are no critical errors (which might be caused by parseinputdata())
- if (.not. rslt%hascriticalerror()) then
- ! add riverreaches to the gridcell (if any are present in the data file)
- call rslt%adderrors(.errors. me%createreaches())
+ ! Only proceed if there are no critical errors (which might be caused by parseInputData())
+ if (.not. rslt%hasCriticalError()) then
+ ! Add river reaches to the grid cell (if any are present in the data file)
+ call rslt%addErrors(.errors. me%createReaches())
end if
end if
call rslt%addToTrace("Creating " // trim(me%ref))
call LOGR%toFile(errors = .errors. rslt)
call ERROR_HANDLER%trigger(errors = .errors. rslt)
- call rslt%clear() ! Clear errors from the Result object so they're not reported twice
+ call rslt%clear() ! Clear errors from the Result object so they're not reported twice
if (.not. me%isEmpty) then
call LOGR%toConsole(" > Creating " // trim(me%ref) // ": "//COLOR_GREEN//"success"//COLOR_RESET)
call LOGR%toFile("Creating " // trim(me%ref) // ": success")
@@ -143,8 +171,8 @@ function createGridCell(me, x, y, isEmpty) result(rslt)
!> Finalise creation should be done after routing is complete, and is meant for
!! procedures that rely on waterbodies being linked to their inflows/outflow
subroutine finaliseCreateGridCell(me)
- class(GridCell) :: me !! This GridCell instance
- integer :: i ! Iterator
+ class(GridCell) :: me !! This GridCell instance
+ integer :: i ! Iterator
! Snap point sources to the closest reach
call me%snapPointSourcesToReach()
! Run each waterbody's finalise creation method, which at the moment
@@ -156,13 +184,13 @@ subroutine finaliseCreateGridCell(me)
end subroutine
subroutine snapPointSourcesToReachGridCell(me)
- class(GridCell) :: me !! The GridCell instance
- integer :: i, j ! Iterators
- real, allocatable :: lineParams(:,:)
- real, allocatable :: distanceToReach(:)
- real :: x0, y0
- real :: fracIndicies(2)
- integer :: reachIndexToSnapTo
+ class(GridCell) :: me !! The GridCell instance
+ integer :: i, j ! Iterators
+ real, allocatable :: lineParams(:,:)
+ real, allocatable :: distanceToReach(:)
+ real :: x0, y0
+ real :: fracIndices(2)
+ integer :: reachIndexToSnapTo
! Make sure there are no point sources already allocated
do i = 1, me%nReaches
@@ -183,7 +211,7 @@ subroutine snapPointSourcesToReachGridCell(me)
! Generate reach coord, with axis placed at bottom left of cell and representing each
! cell as being 2x2, so we can calculate distance between point sources and each reach
allocate(lineParams(me%nReaches,3), &
- distanceToReach(me%nReaches))
+ distanceToReach(me%nReaches))
do i = 1, me%nReaches
lineParams(i,:) = me%reachLineParamsFromInflowsOutflow(i)
end do
@@ -193,11 +221,11 @@ subroutine snapPointSourcesToReachGridCell(me)
do j = 1, DATASET%nPointSources(me%x, me%y)
x0 = DATASET%emissionsPointWaterCoords(me%x, me%y, j, 1)
y0 = DATASET%emissionsPointWaterCoords(me%x, me%y, j, 2)
- fracIndicies = DATASET%coordsToFractionalCellIndex(x0, y0)
+ fracIndices = DATASET%coordsToFractionalCellIndex(x0, y0)
do i = 1, me%nReaches
- ! Calculate distance from point given by fracIndicies and the line
+ ! Calculate distance from point given by fracIndices and the line
! with params lineParams(i,:)
- distanceToReach(i) = abs(lineParams(i,1) * fracIndicies(1) + lineParams(i,2) * fracIndicies(2) &
+ distanceToReach(i) = abs(lineParams(i,1) * fracIndices(1) + lineParams(i,2) * fracIndices(2) &
+ lineParams(i,3)) / sqrt(lineParams(i,1) ** 2 + lineParams(i,2) ** 2)
end do
! Use minloc to get the index of the minimum value in the distanceToReach array,
@@ -210,8 +238,8 @@ subroutine snapPointSourcesToReachGridCell(me)
!> Create the reaches within this grid cell
function createReaches(me) result(rslt)
- class(GridCell), target :: me !! This GridCell instance
- type(Result) :: rslt !! The Result object to return any errors in
+ class(GridCell), target :: me !! This GridCell instance
+ type(Result) :: rslt !! The Result object to return any errors in
integer :: i
! Loop through waterbodies and create them
do i = 1, me%nReaches
@@ -234,29 +262,41 @@ function createReaches(me) result(rslt)
!> Perform the simulations required for an individual time step
subroutine updateGridCell(me, t, isWarmUp)
- class(GridCell) :: me !! The GridCell instance
- integer :: t !! The timestep we're on
- logical :: isWarmUp !! Are we in a warm up period?
- type(Result) :: r ! Result object
- integer :: i ! Iterator
- real(dp) :: j_transformed_diffuseSource(C%npDim(1), C%npDim(2), C%npDim(3))
- real(dp) :: j_dissolved_diffuseSource
+ class(GridCell) :: me !! The GridCell instance
+ integer :: t !! The timestep we're on
+ logical :: isWarmUp !! Are we in a warm up period?
+ type(Result) :: r ! Result object
+ integer :: i ! Iterator
+ type(Contaminant) :: temp_contaminant
+ character(len=100) :: compartment
! Check that the GridCell is not empty before simulating anything
if (.not. me%isEmpty) then
+ do i = 1, size(me%j_contaminant_diffuseSource)
+ call me%j_contaminant_diffuseSource(i)%finalise()
+ if (i == 1) then
+ compartment = 'soil'
+ else
+ compartment = 'atmospheric'
+ end if
+ call r%addErrors(.errors. me%j_contaminant_diffuseSource(i)%create_from_data( &
+ compartment, &
+ DATASET%contaminantDensity, &
+ DATASET%soilConstantAttachmentEfficiency, &
+ DATASET%riverAttachmentEfficiency, &
+ DATASET%estuaryAttachmentEfficiency, &
+ DATASET%contaminant_k_diss_pristine, &
+ DATASET%contaminant_k_diss_transformed, &
+ DATASET%contaminant_k_transform_pristine, &
+ real(DATASET%waterTemperature(1), dp)))
+ end do
- ! Reset variables
- me%j_np_diffuseSource = 0.0_dp
- j_transformed_diffuseSource = 0.0_dp
- j_dissolved_diffuseSource = 0.0_dp
-
- ! Only input NM if we're not in a warm up period
+ ! Only input Contaminant if we're not in a warm up period
if (.not. isWarmUp) then
do i = 1, size(me%diffuseSources)
call me%diffuseSources(i)%update(t)
- me%j_np_diffuseSource = me%j_np_diffuseSource + me%diffuseSources(i)%j_np_diffuseSource ! [kg/m2/timestep]
- j_transformed_diffuseSource = j_transformed_diffuseSource + me%diffuseSources(i)%j_transformed_diffuseSource
- j_dissolved_diffuseSource = j_dissolved_diffuseSource + me%diffuseSources(i)%j_dissolved_diffuseSource
+ temp_contaminant = me%diffuseSources(i)%j_contaminant
+ call me%j_contaminant_diffuseSource(i)%add(temp_contaminant)
end do
end if
@@ -269,14 +309,7 @@ subroutine updateGridCell(me, t, isWarmUp)
! Loop through all SoilProfiles (only one for the moment), run their
! simulations and store the eroded sediment in this object
! TODO extend to multiple soil profiles
- call r%addErrors( &
- .errors. me%colSoilProfiles(1)%item%update( &
- t, &
- me%j_np_diffuseSource, &
- j_transformed_diffuseSource, &
- j_dissolved_diffuseSource &
- ) &
- )
+ call r%addErrors(.errors. me%colSoilProfiles(1)%item%update(t, me%j_contaminant_diffuseSource(1)))
me%erodedSediment = me%colSoilProfiles(1)%item%erodedSediment
! Reaches will be updated separately in reach routing order, by the `Environment` object
end if
@@ -291,18 +324,18 @@ subroutine updateGridCell(me, t, isWarmUp)
call LOGR%toFile("Performing simulation for " // trim(me%ref) // " on time step #" // trim(str(t)) // ": success")
end subroutine
- !> Set the outflow from the temporary outflow variables that were setting by the
+ !> Set the outflow from the temporary outflow variables that were set by the
!! update procedure. This step is kept separate from the routing so that the
!! wrong outflow isn't used as an inflow for another `RiverReach` whilst the reaches
!! are looped through.
subroutine finaliseUpdateGridCell(me)
- class(GridCell) :: me !! This GridCell instace
- integer :: rr ! Iterator for reaches
+ class(GridCell) :: me !! This GridCell instance
+ integer :: rr ! Iterator for reaches
if (.not. me%isEmpty) then
do rr = 1, me%nReaches
call me%colRiverReaches(rr)%item%finaliseUpdate()
end do
- me%isUpdated = .false. ! Reset updated flag for the next timestep
+ me%isUpdated = .false. ! Reset updated flag for the next timestep
end if
end subroutine
@@ -310,11 +343,11 @@ subroutine finaliseUpdateGridCell(me)
function demandsGridCell(me) result(r)
class(GridCell) :: me
type(Result) :: r
- integer :: pcLossUrban = 0 ! TODO where should this come from?
- integer :: pcLossRural = 0 ! TODO where should this come from?
- integer :: pcLossLivestockConsumption = 10 ! TODO where should this come from?
- real(dp) :: cattleDemandPerCapita = 140 ! TODO where should this come from?
- real(dp) :: sheepGoatDemandPerCapita = 70 ! TODO where should this come from?
+ integer :: pcLossUrban = 0 ! TODO where should this come from?
+ integer :: pcLossRural = 0 ! TODO where should this come from?
+ integer :: pcLossLivestockConsumption = 10 ! TODO where should this come from?
+ real(dp) :: cattleDemandPerCapita = 140 ! TODO where should this come from?
+ real(dp) :: sheepGoatDemandPerCapita = 70 ! TODO where should this come from?
real(dp) :: totalUrbanDemand
real(dp) :: totalLivestockDemand
real(dp) :: totalRuralDemand
@@ -322,16 +355,15 @@ function demandsGridCell(me) result(r)
! TODO Population increase factor is excluded here - check this is okay?
! I'm thinking that population increase can be factored into population
! numbers in dataset instead
- totalUrbanDemand = (me%urbanPopulation * me%urbanDemandPerCapita * 1.0e-9)/(1.0_dp - 0.01_dp * pcLossUrban) ! [Mm3/day]
+ totalUrbanDemand = (me%urbanPopulation * me%urbanDemandPerCapita * 1.0e-9)/(1.0_dp - 0.01_dp * pcLossUrban) ![Mm3/day]
totalLivestockDemand = ((me%cattlePopulation * cattleDemandPerCapita + me%sheepGoatPopulation * sheepGoatDemandPerCapita) &
* 0.01_dp * pcLossLivestockConsumption * 1.0e-9) / (1.0_dp - 0.01_dp * pcLossRural)
totalRuralDemand = ((me%totalPopulation - me%urbanPopulation) * me%ruralDemandPerCapita * 1.0e-9) &
- / (1.0_dp - 0.01_dp * pcLossRural)
+ / (1.0_dp - 0.01_dp * pcLossRural)
! TODO See Virginie's email 29/08/2018
-
end function
- !> Process the water abstractions and transferss for this GridCell
+ !> Process the water abstractions and transfers for this GridCell
function transfersGridCell(me) result(r)
class(GridCell) :: me
type(Result) :: r
@@ -342,120 +374,100 @@ function transfersGridCell(me) result(r)
!! accordingly, including allocation of arrays that depend on
!! input data.
subroutine parseInputDataGridCell(me)
- class(GridCell) :: me !! This `GridCell` object
+ class(GridCell) :: me
- ! Allocate arrays to store flows in
allocate(me%q_runoff_timeSeries(C%nTimeSteps))
allocate(me%q_evap_timeSeries(C%nTimeSteps))
allocate(me%q_precip_timeSeries(C%nTimeSteps))
allocate(me%T_water_timeSeries(C%nTimeSteps))
- ! Get grid cell size from grid resolution
- me%dx = DATASET%gridRes(1)
- me%dy = DATASET%gridRes(2)
+ me%dx = DATASET%gridRes(1)
+ me%dy = DATASET%gridRes(2)
me%area = me%dx * me%dy
-
- ! Get the number of waterbodies
+
me%nReaches = DATASET%nWaterbodies(me%x, me%y)
allocate(me%colRiverReaches(me%nReaches))
allocate(me%reachTypes(me%nReaches))
- ! What are the types of those waterbodies?
- ! Currently, all reach types in a cell must be the same, but the functionality to have
- ! different reach types exists (hence the aggregatedReachType variable)
+
if (DATASET%isEstuary(me%x, me%y)) then
- me%reachTypes = 'est'
+ me%reachTypes = 'est'
me%aggregatedReachType = 'est'
else
- me%reachTypes = 'riv'
+ me%reachTypes = 'riv'
me%aggregatedReachType = 'riv'
end if
- ! TODO get the following from data
- me%n_river = 0.035_dp
+ me%n_river = 0.035_dp
me%T_water_timeSeries = 10.0_dp
-
- me%q_runoff_timeSeries = DATASET%runoff(me%x, me%y, :)
- me%q_precip_timeSeries = DATASET%precip(me%x, me%y, :)
- me%q_evap_timeSeries = DATASET%evap(me%x, me%y, :)
- ! TODO demands data (see commented out bit below)
-
- ! Try and set the group to the demands group. It will produce an error if group
- ! doesn't exist - use this to set me%hasDemands to .false.
- ! rslt = DATA%setGroup([character(len=100)::'Environment', me%ref, 'demands'])
- ! if (.not. rslt%hasError()) then
- ! me%hasDemands = .true.
- ! ! Now get the data from the group. These should all default to zero.
- ! ! TODO What should the default surface water to total water ratio be?
- ! call r%addErrors([ &
- ! .errors. DATA%get('total_population', me%totalPopulation, 0.0_dp), &
- ! .errors. DATA%get('urban_population', me%urbanPopulation, 0.0_dp), &
- ! .errors. DATA%get('cattle_population', me%cattlePopulation, 0.0_dp), &
- ! .errors. DATA%get('sheep_goat_population', me%sheepGoatPopulation, 0.0_dp), &
- ! .errors. DATA%get('urban_demand', me%urbanDemandPerCapita, 0.0_dp), &
- ! .errors. DATA%get('rural_demand', me%ruralDemandPerCapita, 0.0_dp), &
- ! .errors. DATA%get('industrial_demand', me%industrialDemand, 0.0_dp), &
- ! .errors. DATA%get('sw_to_tw_ratio', me%surfaceWaterToTotalWaterRatio, 0.42_dp, warnIfDefaulting=.true.), &
- ! .errors. DATA%get('has_large_city', hasLargeCityInt, 0) &
- ! ])
- ! me%hasLargeCity = lgcl(hasLargeCityInt) ! Convert int to bool
-
- ! ! Check if there are any crops to get. These will be retrieved iteratively
- ! ! (i.e. crop_1, crop_2, crop_3). Then get the data for those crops and create
- ! ! array of Crop objects in me%crops
- ! i = 1
- ! do while (DATA%grp%hasGroup("crop_" // trim(str(i))))
- ! allocate(me%crops(i))
- ! call r%addErrors(.errors. &
- ! DATA%setGroup([character(len=100)::'Environment', me%ref, 'demands', 'crop_' // trim(str(i))]))
- ! call r%addErrors([ &
- ! .errors. DATA%get('crop_area', cropArea), &
- ! .errors. DATA%get('crop_type', cropType), &
- ! .errors. DATA%get('planting_month', cropPlantingMonth) &
- ! ])
- ! me%crops(i) = Crop(cropType, cropArea, cropPlantingMonth)
- ! i = i+1
- ! end do
- ! end if
+ ! Guarded reads from DATASET
+ if (allocated(DATASET%runoff)) then
+ me%q_runoff_timeSeries = DATASET%runoff(me%x, me%y, :)
+ else
+ me%q_runoff_timeSeries = 0.0_dp
+ end if
+
+ if (allocated(DATASET%precip)) then
+ me%q_precip_timeSeries = DATASET%precip(me%x, me%y, :)
+ else
+ me%q_precip_timeSeries = 0.0_dp
+ end if
+ if (allocated(DATASET%evap)) then
+ me%q_evap_timeSeries = DATASET%evap(me%x, me%y, :)
+ else
+ me%q_evap_timeSeries = 0.0_dp
+ end if
end subroutine
- subroutine parseNewBatchDataGridCell(me)
- class(GridCell) :: me !! This grid cell instance
- integer :: i ! Iterators
-
- if (.not. me%isEmpty) then
- ! Allocate arrays to store flows in
- deallocate(me%q_runoff_timeSeries, &
- me%q_evap_timeSeries, &
- me%q_precip_timeSeries, &
- me%T_water_timeSeries)
- allocate(me%q_runoff_timeSeries(C%nTimeSteps))
- allocate(me%q_evap_timeSeries(C%nTimeSteps))
- allocate(me%q_precip_timeSeries(C%nTimeSteps))
- allocate(me%T_water_timeSeries(C%nTimeSteps))
-
- me%n_river = 0.035_dp
+ subroutine parseNewBatchDataGridCell(me)
+ class(GridCell) :: me !! This grid cell instance
+ integer :: i ! Iterator
+
+ if (.not. me%isEmpty) then
+ ! Reallocate time series for new batch
+ if (allocated(me%q_runoff_timeSeries)) deallocate(me%q_runoff_timeSeries)
+ if (allocated(me%q_evap_timeSeries)) deallocate(me%q_evap_timeSeries)
+ if (allocated(me%q_precip_timeSeries)) deallocate(me%q_precip_timeSeries)
+ if (allocated(me%T_water_timeSeries)) deallocate(me%T_water_timeSeries)
+
+ allocate(me%q_runoff_timeSeries(C%nTimeSteps))
+ allocate(me%q_evap_timeSeries(C%nTimeSteps))
+ allocate(me%q_precip_timeSeries(C%nTimeSteps))
+ allocate(me%T_water_timeSeries(C%nTimeSteps))
+
+ me%n_river = 0.035_dp
me%T_water_timeSeries = 10.0_dp
- me%q_runoff_timeSeries = DATASET%runoff(me%x, me%y, :)
- me%q_precip_timeSeries = DATASET%precip(me%x, me%y, :)
- me%q_evap_timeSeries = DATASET%evap(me%x, me%y, :)
- ! Parse this batch's soil data
+ ! Guarded reads from DATASET for new batch
+ if (allocated(DATASET%runoff)) then
+ me%q_runoff_timeSeries = DATASET%runoff(me%x, me%y, :)
+ else
+ me%q_runoff_timeSeries = 0.0_dp
+ end if
+
+ if (allocated(DATASET%precip)) then
+ me%q_precip_timeSeries = DATASET%precip(me%x, me%y, :)
+ else
+ me%q_precip_timeSeries = 0.0_dp
+ end if
+
+ if (allocated(DATASET%evap)) then
+ me%q_evap_timeSeries = DATASET%evap(me%x, me%y, :)
+ else
+ me%q_evap_timeSeries = 0.0_dp
+ end if
+
+ ! Parse batch soil data
call me%colSoilProfiles(1)%item%parseNewBatchData()
- ! Number of point sources per grid cell might have changed, so we
- ! need to re-snap them to the closest reach
+ ! Re-snap point sources to closest reach
call me%snapPointSourcesToReach()
- ! Now loop through reaches and alter size of j matrices to account
- ! for potentially different number of point sources
+
+ ! Allow reaches to resize internal arrays for new batch
do i = 1, me%nReaches
call me%colRiverReaches(i)%item%parseNewBatchData()
end do
-
- ! Reaches and sources don't need updating as they either
- ! get their data from grid cell, or directly from DATASET,
- ! which has already been updated.
end if
end subroutine
@@ -463,11 +475,11 @@ subroutine parseNewBatchDataGridCell(me)
!--- GETTERS ---!
!---------------!
- !> Get the ouflow from this grid cell, which is the sum of the branch outflows
+ !> Get the outflow from this grid cell, which is the sum of the branch outflows
function get_Q_outflowGridCell(me) result(Q_outflow)
- class(GridCell) :: me !! This `GridCell` instance
- real(dp) :: Q_outflow !! Outflow from this grid cell [m3/timestep]
- integer :: i ! Iterator
+ class(GridCell) :: me !! This `GridCell` instance
+ real(dp) :: Q_outflow !! Outflow from this grid cell [m3/timestep]
+ integer :: i ! Iterator
Q_outflow = 0
! Loop through the reaches and sum up the outflow from those that are a grid cell outflow
do i = 1, me%nReaches
@@ -479,23 +491,23 @@ function get_Q_outflowGridCell(me) result(Q_outflow)
!> Get the outflow of SPM from this grid cell
function get_j_spm_outflowGridCell(me) result(j_spm_outflow)
- class(GridCell) :: me !! This `GridCell` instance
- real(dp) :: j_spm_outflow(C%nSizeClassesSpm) !! Outflow from this grid cell [kg/timestep]
- integer :: i ! Iterator
+ class(GridCell) :: me !! This `GridCell` instance
+ real(dp) :: j_spm_outflow(C%nSizeClassesSpm) !! Outflow from this grid cell [kg/timestep]
+ integer :: i ! Iterator
j_spm_outflow = 0.0_dp
! Loop through reaches and sum the SPM outflow for the grid cell outflows
do i = 1, me%nReaches
if (me%colRiverReaches(i)%item%isGridCellOutflow) then
- j_spm_outflow = j_spm_outflow + me%colRiverReaches(i)%item%Q%outflow
+ j_spm_outflow = j_spm_outflow + me%colRiverReaches(i)%item%j_spm%outflow
end if
end do
end function
!> Get the total mass of SPM currently in the GridCell
function get_m_spmGridCell(me) result(m_spm)
- class(GridCell) :: me !! This `GridCell` instance
- real(dp) :: m_spm(C%nSizeClassesSpm) !! SPM mass in this reach
- integer :: i ! Iterator
+ class(GridCell) :: me !! This `GridCell` instance
+ real(dp) :: m_spm(C%nSizeClassesSpm) !! SPM mass in this reach
+ integer :: i ! Iterator
m_spm = 0.0_dp
! Loop through the reaches and sum the SPM masses
do i = 1, me%nReaches
@@ -505,14 +517,14 @@ function get_m_spmGridCell(me) result(m_spm)
!> Get the mass of SPM inflowing to this grid cell
function get_j_spm_inflowGridCell(me) result(j_spm_inflow)
- class(GridCell) :: me !! This grid cell instance
- real(dp) :: j_spm_inflow(C%nSizeClassesSpm) ! Total mass of SPM inflowing [kg/timestep]
- integer :: i ! Iterator
+ class(GridCell) :: me !! This grid cell instance
+ real(dp) :: j_spm_inflow(C%nSizeClassesSpm)! Total mass of SPM inflowing [kg/timestep]
+ integer :: i ! Iterator
j_spm_inflow = 0.0_dp
! Loop through the inflows and sum the inflowing SPM
do i = 1, me%nReaches
if (me%colRiverReaches(i)%item%isGridCellInflow) then
- j_spm_inflow = j_spm_inflow + me%colRiverReaches(i)%item%Q%inflow
+ j_spm_inflow = j_spm_inflow + me%colRiverReaches(i)%item%j_spm%inflow
end if
end do
end function
@@ -521,9 +533,9 @@ function get_j_spm_inflowGridCell(me) result(j_spm_inflow)
!! Note this may be different to eroded yields from the soil profile due to the
!! sediment transport capacity limited inputs to water bodies
function get_j_spm_soilErosionGridCell(me) result(j_spm_soilErosion)
- class(GridCell) :: me !! This grid cell instance
- real(dp) :: j_spm_soilErosion(C%nSizeClassesSpm) ! Total mass of soil erosion [kg/timestep]
- integer :: i ! Iterator
+ class(GridCell) :: me !! This grid cell instance
+ real(dp) :: j_spm_soilErosion(C%nSizeClassesSpm) ! Total mass of soil erosion [kg/timestep]
+ integer :: i ! Iterator
j_spm_soilErosion = 0.0_dp
! Loop through water bodies and sum the eroded soil
do i = 1, me%nReaches
@@ -533,9 +545,9 @@ function get_j_spm_soilErosionGridCell(me) result(j_spm_soilErosion)
!> Get the total mass of bank erosion into water bodies in this grid cell
function get_j_spm_bankErosionGridCell(me) result(j_spm_bankErosion)
- class(GridCell) :: me !! This grid cell instance
- real(dp) :: j_spm_bankErosion(C%nSizeClassesSpm) ! Total mass of bank erosion [kg/timestep]
- integer :: i ! Iterator
+ class(GridCell) :: me !! This grid cell instance
+ real(dp) :: j_spm_bankErosion(C%nSizeClassesSpm) ! Total mass of bank erosion [kg/timestep]
+ integer :: i ! Iterator
j_spm_bankErosion = 0.0_dp
! Loop through water bodies and sum the bank erosion
do i = 1, me%nReaches
@@ -545,9 +557,9 @@ function get_j_spm_bankErosionGridCell(me) result(j_spm_bankErosion)
!> Get the total mass of deposited SPM in this cell
function get_j_spm_depositionGridCell(me) result(j_spm_deposition)
- class(GridCell) :: me !! This grid cell instance
- real(dp) :: j_spm_deposition(C%nSizeClassesSpm) ! Total mass of deposited SPM [kg/timestep]
- integer :: i ! Iterator
+ class(GridCell) :: me !! This grid cell instance
+ real(dp) :: j_spm_deposition(C%nSizeClassesSpm) ! Total mass of deposited SPM [kg/timestep]
+ integer :: i ! Iterator
j_spm_deposition = 0.0_dp
! Loop through water bodies and sum the deposited SPM
do i = 1, me%nReaches
@@ -557,9 +569,9 @@ function get_j_spm_depositionGridCell(me) result(j_spm_deposition)
!> Get the total mass of resuspended SPM in this cell
function get_j_spm_resuspensionGridCell(me) result(j_spm_resuspension)
- class(GridCell) :: me !! This grid cell instance
- real(dp) :: j_spm_resuspension(C%nSizeClassesSpm) ! Total mass of resuspended SPM [kg/timestep]
- integer :: i ! Iterator
+ class(GridCell) :: me !! This grid cell instance
+ real(dp) :: j_spm_resuspension(C%nSizeClassesSpm) ! Total mass of resuspended SPM [kg/timestep]
+ integer :: i ! Iterator
j_spm_resuspension = 0.0_dp
! Loop through water bodies and sum the resuspended SPM
do i = 1, me%nReaches
@@ -567,76 +579,89 @@ function get_j_spm_resuspensionGridCell(me) result(j_spm_resuspension)
end do
end function
- !> Get the total mass of NM currently in waterbodies in the GridCell
- function get_m_np_waterGridCell(me) result(m_np)
- class(GridCell) :: me !! This `GridCell` instance
- real(dp), allocatable :: m_np(:,:,:)
- integer :: w
- allocate(m_np(C%npDim(1), C%npDim(2), C%npDim(3)))
- m_np = 0.0_dp
+ !> Get the total mass of Contaminant currently in waterbodies in the GridCell
+ function get_m_contaminant_waterGridCell(me) result(m_contaminant)
+ class(GridCell) :: me
+ type(Contaminant) :: m_contaminant
+ integer :: w
+ type(Result) :: rslt
+
+ rslt = m_contaminant%create()
+ if (rslt%hasCriticalError()) then
+ call rslt%addToTrace("Failed to create m_contaminant in get_m_contaminant_waterGridCell")
+ call LOGR%toFile(errors=rslt%errors)
+ call ERROR_HANDLER%trigger(errors=rslt%errors)
+ return
+ end if
do w = 1, me%nReaches
- m_np = m_np + me%colRiverReaches(w)%item%m_np
+ m_contaminant = m_contaminant + me%colRiverReaches(w)%item%get_m_contaminant()
end do
end function
- !> Get the total mass of transformed NM currently in waterbodies in the GridCell
- function get_m_transformed_waterGridCell(me) result(m_transformed)
- class(GridCell) :: me !! This `GridCell` instance
- real(dp), allocatable :: m_transformed(:,:,:)
- integer :: w
- allocate(m_transformed(C%npDim(1), C%npDim(2), C%npDim(3)))
- m_transformed = 0.0_dp
- do w = 1, me%nReaches
- m_transformed = m_transformed + me%colRiverReaches(w)%item%m_transformed
- end do
- end function
+ !> Get the total mass of Contaminant currently in the sediment in the GridCell
+ function get_m_contaminant_sedimentGridCell(me) result(m_contaminant)
+ class(GridCell) :: me
+ type(Contaminant) :: m_contaminant, tmp_cont
+ integer :: w
+ type(Result) :: rslt
+ type(Result0D) :: r0
+
+ rslt = m_contaminant%create_from_data('sediment', &
+ DATASET%contaminantDensity, DATASET%soilConstantAttachmentEfficiency, &
+ DATASET%riverAttachmentEfficiency, DATASET%estuaryAttachmentEfficiency, &
+ DATASET%contaminant_k_diss_pristine, DATASET%contaminant_k_diss_transformed, &
+ DATASET%contaminant_k_transform_pristine, real(DATASET%waterTemperature(1), dp))
+ if (rslt%hasCriticalError()) then
+ call rslt%addToTrace("Failed to create m_contaminant in get_m_contaminant_sedimentGridCell")
+ call LOGR%toFile(errors=rslt%errors); call ERROR_HANDLER%trigger(errors=rslt%errors); return
+ end if
- !> Get the total mass of dissolved species currently in the GridCell
- function get_m_dissolved_waterGridCell(me) result(m_dissolved)
- class(GridCell) :: me !! This `GridCell` instance
- real(dp) :: m_dissolved
- integer :: w
- m_dissolved = 0.0_dp
do w = 1, me%nReaches
- m_dissolved = m_dissolved + me%colRiverReaches(w)%item%m_dissolved
+ r0 = me%colRiverReaches(w)%item%bedSediment%get_m_contaminant()
+ if (r0%hasError()) then
+ call r0%addToTrace("get_m_contaminant() failed for reach "//trim(str(w)))
+ call LOGR%toFile(errors=r0%errors); call ERROR_HANDLER%trigger(errors=r0%errors); return
+ end if
+ select type (data => r0%getData())
+ type is (Contaminant)
+ tmp_cont = data
+ class default
+ call rslt%addError(ErrorInstance(code=106, message="Result0D did not contain Contaminant"))
+ call ERROR_HANDLER%trigger(errors=rslt%errors); return
+ end select
+ call m_contaminant%add_scaled(tmp_cont, me%colRiverReaches(w)%item%bedArea)
end do
- end function
+ end function get_m_contaminant_sedimentGridCell
- !> Get the total mass of NM currently in the sediment in the GridCell
- function get_m_np_sedimentGridCell(me) result(m_np)
- class(GridCell) :: me !! This `GridCell` instance
- real(dp), allocatable :: m_np(:,:,:)
- integer :: w ! Waterbody iterator
- allocate(m_np(C%npDim(1), C%npDim(2), C%npDim(3)))
- m_np = 0.0_dp
- do w = 1, me%nReaches
- associate (reach => me%colRiverReaches(w)%item)
- m_np = m_np + reach%bedSediment%get_m_np() * reach%bedArea
- end associate
- end do
- end function
-
+
!> Get the total mass of sediment in this grid cell
function get_sediment_massGridCell(me) result(sediment_mass)
- class(GridCell) :: me !! This GridCell instance
- real(dp) :: sediment_mass !! Mass of sediment in grid cell [kg]
- integer :: i ! Iterator
+ class(GridCell) :: me !! This GridCell instance
+ real(dp) :: sediment_mass !! Mass of sediment in grid cell [kg]
+ integer :: i ! Iterator
sediment_mass = 0.0_dp
do i = 1, me%nReaches
sediment_mass = sediment_mass + me%colRiverReaches(i)%item%bedSediment%Mf_bed_all() &
- * me%colRiverReaches(i)%item%bedArea
+ * me%colRiverReaches(i)%item%bedArea
end do
end function
!> Get the average SPM concentration in the grid cell, weighted by water volume in
!! each of the water bodies
function get_C_spmGridCell(me) result(C_spm)
- class(GridCell) :: me !! This grid cell
- real(dp), allocatable :: C_spm(:) !! Average SPM concentration in grid cell
+ class(GridCell) :: me !! This grid cell
+ real(dp), allocatable :: C_spm(:) !! Average SPM concentration in grid cell
real(dp) :: C_spm_w(me%nReaches,C%nSizeClassesSpm)
real(dp) :: volumes(me%nReaches)
- integer :: i !! Iterator for water bodies
- allocate(C_spm(C%nSizeClassesSpm))
+ integer :: i !! Iterator for water bodies
+ integer :: istat
+
+ allocate(C_spm(C%nSizeClassesSpm), stat=istat)
+ if (istat /= 0) then
+ allocate(C_spm(1))
+ C_spm = 0.0_dp
+ return
+ end if
! Loop over the water bodies in this cell and get SPM and volume
do i = 1, me%nReaches
associate (reach => me%colRiverReaches(i)%item)
@@ -652,335 +677,488 @@ function get_C_spmGridCell(me) result(C_spm)
!! for the reach with index i in this GridCell. From these line parameters,
!! the distance to a point (source) can be calculated.
function reachLineParamsFromInflowsOutflowGridCell(me, i) result(lineParams)
- class(GridCell) :: me !! This GridCell
- integer :: i !! The reach to calculate line equation for
- real :: lineParams(3) !! Line parameters to return
- integer :: x_in, y_in, x_out, y_out ! Inflow and outflow indices of this reach
- real :: x0, y0, x1, y1, a, b, c ! Inflow and outflow coords and line params
- ! Calculate the point of the inflow and outflow of each reach
+ class(GridCell) :: me !! This GridCell
+ integer :: i !! The reach to calculate line equation for
+ real :: lineParams(3) !! Line parameters to return
+ integer :: x_in, y_in, x_out, y_out ! Inflow and outflow indices of this reach
+ real :: x0, y0, x1, y1, a, b, c ! Inflow and outflow coords and line params
+
+ ! Inflow point: first inflow reach if present, else centre (headwater)
if (me%colRiverReaches(i)%item%nInflows > 0) then
x_in = me%colRiverReaches(i)%item%inflows(1)%item%x
y_in = me%colRiverReaches(i)%item%inflows(1)%item%y
x0 = (x_in + 0.5) + 0.5 * (me%x - x_in)
y0 = (y_in + 0.5) + 0.5 * (me%y - y_in)
- else ! Must be the centre of the cell (headwater)
+ else
x0 = me%x + 0.5
y0 = me%y + 0.5
end if
- ! Get the outflow i coords, whether it's in the model domain or not
+
+ ! Outflow point: either linked reach or grid outflow from DATASET
if (.not. me%colRiverReaches(i)%item%isDomainOutflow) then
x_out = me%colRiverReaches(i)%item%outflow%item%x
y_out = me%colRiverReaches(i)%item%outflow%item%y
else
- x_out = DATASET%outflow(1, me%x, me%y)
- y_out = DATASET%outflow(2, me%x, me%y)
+ ! NOTE: NetCDF stored as outflow(y, x, d) -> Fortran indexing (d, y, x)
+ x_out = DATASET%outflow(1, me%y, me%x)
+ y_out = DATASET%outflow(2, me%y, me%x)
end if
+
x1 = (x_out + 0.5) + 0.5 * (me%x - x_out)
y1 = (y_out + 0.5) + 0.5 * (me%y - y_out)
- ! Calculate the parameters to the general straight line
- ! ax + bx + c = 0 from this, which can be used to calculate
- ! distance to point
- if ((x1 - x0) /= 0) then
- a = -(y1 - y0)/(x1 - x0)
- b = 1
+
+ ! General line ax + by + c = 0 through (x0,y0) and (x1,y1)
+ if ((x1 - x0) /= 0.0) then
+ a = -(y1 - y0) / (x1 - x0)
+ b = 1.0
else
- a = 1
- b = 0
+ a = 1.0
+ b = 0.0
end if
c = -(a * x0 + b * y0)
+
lineParams = [a, b, c]
end function
- function get_C_np_soilGridCell(me) result(C_np_soil)
- class(GridCell) :: me !! This GridCell instance
- real(dp), allocatable :: C_np_soil(:,:,:) !! Mass concentration of NM in this GridCell [kg/kg soil]
- real(dp) :: C_np_soil_p(me%nSoilProfiles, C%npDim(1), C%npDim(2), C%npDim(3)) ! Per profile NM concentration [kg/kg soil]
- integer :: i ! Iterator
- allocate(C_np_soil(C%npDim(1), C%npDim(2), C%npDim(3)))
- ! Loop over the soil profiles and get soil PEC
- ! TODO when multiple soil profiles implemented, make sure this gets the weighted average
+ !> Weighted mean soil-phase contaminant concentration in this grid cell
+ function get_C_contaminant_soilGridCell(me) result(cont)
+ class(GridCell) :: me
+ type(Contaminant) :: cont
+ real(dp), allocatable :: arr(:,:,:)
+ real(dp) :: partial(me%nSoilProfiles, C%contaminantDim(1), C%contaminantDim(2), C%contaminantDim(3))
+ real(dp) :: weights(me%nSoilProfiles)
+ integer :: i
+ type(Contaminant) :: tmp_cont
+ type(Result) :: rslt
+
+ rslt = cont%create_from_data('soil', &
+ DATASET%contaminantDensity, DATASET%soilConstantAttachmentEfficiency, &
+ DATASET%riverAttachmentEfficiency, DATASET%estuaryAttachmentEfficiency, &
+ DATASET%contaminant_k_diss_pristine, DATASET%contaminant_k_diss_transformed, &
+ DATASET%contaminant_k_transform_pristine, real(DATASET%waterTemperature(1), dp))
+ if (rslt%hasCriticalError()) then
+ call rslt%addToTrace("Failed to create cont in get_C_contaminant_soilGridCell")
+ call LOGR%toFile(errors=rslt%errors)
+ call ERROR_HANDLER%trigger(errors=rslt%errors)
+ return
+ end if
+
do i = 1, me%nSoilProfiles
- associate (profile => me%colSoilProfiles(i)%item)
- C_np_soil_p(i, :, :, :) = profile%get_C_np()
+ associate(sp => me%colSoilProfiles(i)%item)
+ tmp_cont = sp%get_m_contaminant()
+ partial(i,:,:,:) = tmp_cont%c
+ weights(i) = 1.0_dp
end associate
end do
- C_np_soil = divideCheckZero(sum(C_np_soil_p, dim=1), me%nSoilProfiles)
+
+ arr = weightedAverage(partial, weights)
+ cont%c = arr
end function
- !> Get the current weighted mean of NM conc in the water bodies in this grid cell,
- !! weighted by the current water volume in the cell
- function get_C_np_waterGridCell(me) result(C_np_water)
- class(GridCell) :: me !! This GridCell instance
- real(dp), allocatable :: C_np_water(:,:,:) !! Mass concentration of NM in this GridCell [kg/m3]
- real(dp) :: C_np_water_w(me%nReaches, C%npDim(1), C%npDim(2), C%npDim(3)) ! Per waterbody NM concentration [kg/m3]
- real(dp) :: volumes(me%nReaches) ! Volumes [m3] of each reach, used for weighting
- integer :: i ! Iterator
- allocate(C_np_water(C%npDim(1), C%npDim(2), C%npDim(3)))
- ! Loop over the water bodies in this cell and get water PEC and volume
+ !> Weighted mean water‑phase contaminant concentration in this grid cell
+ function get_C_contaminant_waterGridCell(me) result(cont)
+ class(GridCell) :: me
+ type(Contaminant) :: cont
+ real(dp), allocatable :: arr(:,:,:)
+ real(dp) :: partial(me%nReaches, C%contaminantDim(1), C%contaminantDim(2), C%contaminantDim(3))
+ real(dp) :: weights(me%nReaches)
+ integer :: i
+ type(Contaminant) :: tmp_cont
+ real(dp) :: vol
+ type(Result) :: rslt
+ character(len=7) :: compstr
+
+ compstr = merge('water ', 'estuary', me%aggregatedReachType /= 'riv')
+
+ rslt = cont%create_from_data(trim(compstr), &
+ DATASET%contaminantDensity, DATASET%soilConstantAttachmentEfficiency, &
+ DATASET%riverAttachmentEfficiency, DATASET%estuaryAttachmentEfficiency, &
+ DATASET%contaminant_k_diss_pristine, DATASET%contaminant_k_diss_transformed, &
+ DATASET%contaminant_k_transform_pristine, real(DATASET%waterTemperature(1), dp))
+ if (rslt%hasCriticalError()) then
+ call rslt%addToTrace("Failed to create Contaminant in get_C_contaminant_waterGridCell")
+ call LOGR%toFile(errors=rslt%errors); call ERROR_HANDLER%trigger(errors=rslt%errors); return
+ end if
+
do i = 1, me%nReaches
- associate (reach => me%colRiverReaches(i)%item)
- C_np_water_w(i, :, :, :) = reach%C_np
- volumes(i) = reach%volume
- end associate
+ tmp_cont = me%colRiverReaches(i)%item%get_m_contaminant()
+ vol = me%colRiverReaches(i)%item%volume
+ if (vol > 0.0_dp) then
+ partial(i,:,:,:) = tmp_cont%c / vol
+ weights(i) = vol
+ else
+ partial(i,:,:,:) = 0.0_dp
+ weights(i) = 0.0_dp
+ end if
end do
- ! Get the weighted average across the reaches, using the volumes as the weight
- C_np_water = weightedAverage(C_np_water_w, volumes)
- end function
-
+
+ arr = weightedAverage(partial, weights)
+ cont%c = arr
+ end function get_C_contaminant_waterGridCell
+
+
!> Get the current weighted mean sediment PEC [kg/kg] in this grid cell,
!! weighted by the current sediment masses in the cell
- function get_C_np_sedimentGridCell(me) result(C_np_sediment)
- class(GridCell) :: me !! This GridCell instance
- real(dp), allocatable :: C_np_sediment(:,:,:) !! Mass concentration of NM in this GridCell's sediment [kg/kg]
- real(dp) :: C_np_sediment_b(me%nReaches, C%npDim(1), C%npDim(2), C%npDim(3)) ! Per sediment NM concentration [kg/kg]
- real(dp) :: sedimentMasses(me%nReaches) ! Mass of sediment in each reach, used to weight average [kg]
- integer :: i ! Iterator
- allocate(C_np_sediment(C%npDim(1), C%npDim(2), C%npDim(3)))
- ! Loop over the water bodies in this cell and get sediment PEC and bed area
- do i = 1, me%nReaches
- associate (bedSediment => me%colRiverReaches(i)%item%bedSediment)
- ! Get the NM PEC [kg/kg] for each sediment
- C_np_sediment_b(i, :, :, :) = bedSediment%get_C_np_byMass()
- ! Get the sediment mass from BedSediment [kg/m2] and multiply by bed area to give total mass
- sedimentMasses(i) = bedSediment%Mf_bed_all() * me%colRiverReaches(i)%item%bedArea
- end associate
- end do
- ! Get the weighted mean across the bed sediments, using sediment mass as the weight
- C_np_sediment = weightedAverage(C_np_sediment_b, sedimentMasses)
- end function
+ function get_C_contaminant_sedimentGridCell(me) result(cont)
+ class(GridCell) :: me
+ type(Contaminant) :: cont, tmp_cont
+ real(dp), allocatable :: arr(:,:,:)
+ real(dp) :: partial(me%nReaches, C%contaminantDim(1), C%contaminantDim(2), C%contaminantDim(3))
+ real(dp) :: weights(me%nReaches)
+ integer :: i
+ type(Result) :: rslt
+ type(Result0D) :: r0
+ real(dp) :: m_reach
+
+ rslt = cont%create_from_data('sediment', &
+ DATASET%contaminantDensity, DATASET%soilConstantAttachmentEfficiency, &
+ DATASET%riverAttachmentEfficiency, DATASET%estuaryAttachmentEfficiency, &
+ DATASET%contaminant_k_diss_pristine, DATASET%contaminant_k_diss_transformed, &
+ DATASET%contaminant_k_transform_pristine, real(DATASET%waterTemperature(1), dp))
+ if (rslt%hasCriticalError()) then
+ call rslt%addToTrace("Failed to create cont in get_C_contaminant_sedimentGridCell")
+ call LOGR%toFile(errors=rslt%errors); call ERROR_HANDLER%trigger(errors=rslt%errors); return
+ end if
- !> Get the current weighted mean sediment PEC [kg/m3] in this grid cell,
- !! weighted by the current volume of sediment in the grid cell
- function get_C_np_sediment_byVolumeGridCell(me) result(C_np_sediment)
- class(GridCell) :: me !! This GridCell instance
- real(dp), allocatable :: C_np_sediment(:,:,:) !! Volume concentration of NM in this GridCell's sediment [kg/m3]
- real(dp) :: C_np_sediment_b(me%nReaches, C%npDim(1), C%npDim(2), C%npDim(3)) ! Per sediment NM concentration [kg/m3]
- real(dp) :: sedimentVolumes(me%nReaches) ! Volume of sediment in each reach, used to weight average [m3]
- integer :: i ! Iterator
- allocate(C_np_sediment(C%npDim(1), C%npDim(2), C%npDim(3)))
- ! Loop over the water bodies in this cell and get sediment PEC and bed area
do i = 1, me%nReaches
- associate (bedSediment => me%colRiverReaches(i)%item%bedSediment)
- ! Get the NM PEC [kg/m3] for each sediment
- C_np_sediment_b(i, :, :, :) = bedSediment%get_C_np()
- ! Calculate the sediment volume from the bed area and depth
- sedimentVolumes(i) = me%colRiverReaches(i)%item%bedArea * sum(C%sedimentLayerDepth)
+ associate (reach => me%colRiverReaches(i)%item)
+ r0 = reach%bedSediment%get_m_contaminant()
+ if (r0%hasError()) then
+ call r0%addToTrace("get_m_contaminant() failed for reach "//trim(str(i)))
+ call LOGR%toFile(errors=r0%errors); call ERROR_HANDLER%trigger(errors=r0%errors); return
+ end if
+ select type (data => r0%getData())
+ type is (Contaminant)
+ tmp_cont = data
+ class default
+ call rslt%addError(ErrorInstance(code=106, message="Result0D did not contain Contaminant"))
+ call ERROR_HANDLER%trigger(errors=rslt%errors); return
+ end select
+
+ m_reach = reach%bedSediment%Mf_bed_all()
+ if (m_reach > C%epsilon) then
+ partial(i,:,:,:) = tmp_cont%c / m_reach
+ else
+ partial(i,:,:,:) = 0.0_dp
+ end if
+ weights(i) = m_reach * reach%bedArea
end associate
end do
- ! Get the weighted mean across the bed sediments, using sediment mass as the weight
- C_np_sediment = weightedAverage(C_np_sediment_b, sedimentVolumes)
- end function
- !> Get the current weighted mean sediment PEC [kg/m3] for sediment layer l,
- !! weighted by the current volume of sediment layer l in the grid cell
- function get_C_np_sediment_l_byVolumeGridCell(me, l) result(C_np_sediment)
- class(GridCell) :: me !! This GridCell instance
- integer :: l !! Sediment layer index
- real(dp), allocatable :: C_np_sediment(:,:,:) !! Volume concentration of NM in this GridCell's sediment [kg/m3]
- real(dp) :: C_np_sediment_b(me%nReaches, C%npDim(1), C%npDim(2), C%npDim(3)) ! Per sediment NM concentration [kg/m3]
- real(dp) :: sedimentVolumes(me%nReaches) ! Volume of sediment in each reach, used to weight average [m3]
- integer :: i ! Iterator
- allocate(C_np_sediment(C%npDim(1), C%npDim(2), C%npDim(3)))
- ! Loop over the water bodies in this cell and get sediment PEC and bed area for layer l
- do i = 1, me%nReaches
- associate (bedSediment => me%colRiverReaches(i)%item%bedSediment)
- ! Get the NM PEC [kg/m3] for each layer
- C_np_sediment_b(i, :, :, :) = bedSediment%get_C_np_l(l)
- ! Calculate the sediment volume from the bed area and layer depth
- sedimentVolumes(i) = me%colRiverReaches(i)%item%bedArea * C%sedimentLayerDepth(l)
- end associate
- end do
- ! Get the weighted mean across the sediment layers, using sediment mass as the weight
- C_np_sediment = weightedAverage(C_np_sediment_b, sedimentVolumes)
- end function
+ arr = weightedAverage(partial, weights)
+ cont%c = arr
+ end function get_C_contaminant_sedimentGridCell
- !> Get the current weighted mean sediment PEC [kg/kg] for sediment layer l,
- !! weighted by the current mass of sediment in layers
- function get_C_np_sediment_lGridCell(me, l) result(C_np_sediment)
- class(GridCell) :: me !! This GridCell instance
- integer :: l !! Sediment layer index
- real(dp), allocatable :: C_np_sediment(:,:,:) !! Mass concentration of NM in this GridCell's sediment [kg/kg]
- real(dp) :: C_np_sediment_b(me%nReaches, C%npDim(1), C%npDim(2), C%npDim(3)) ! Per sediment NM concentration [kg/kg]
- real(dp) :: sedimentMasses(me%nReaches) ! Mass of sediment layer l in each reach, used to weight average [kg]
- integer :: i ! Iterator
- allocate(C_np_sediment(C%npDim(1), C%npDim(2), C%npDim(3)))
- ! Loop over the water bodies in this cell and get sediment PEC and bed area for layer l
- do i = 1, me%nReaches
- associate (bedSediment => me%colRiverReaches(i)%item%bedSediment)
- ! Get the NM PEC [kg/m3] for each layer
- C_np_sediment_b(i, :, :, :) = bedSediment%get_C_np_l(l)
- ! Calculate the sediment volume from the bed area and layer depth
- sedimentMasses(i) = bedSediment%Mf_bed_by_layer(l) * me%colRiverReaches(i)%item%bedArea
- end associate
- end do
- ! Get the weighted mean across the sediment layers, using sediment mass as the weight
- C_np_sediment = weightedAverage(C_np_sediment_b, sedimentMasses)
- end function
+ !> Weighted mean sediment PEC [kg/m3] in this grid cell
+ function get_C_contaminant_sediment_byVolumeGridCell(me) result(cont)
+ class(GridCell) :: me
+ type(Contaminant) :: cont, tmp_cont
+ real(dp), allocatable :: arr(:,:,:)
+ real(dp) :: partial(me%nReaches, C%contaminantDim(1), C%contaminantDim(2), C%contaminantDim(3))
+ real(dp) :: weights(me%nReaches)
+ integer :: i
+ type(Result) :: rslt
+ type(Result0D) :: r0
+ real(dp) :: vol_reach
+
+ rslt = cont%create_from_data('sediment', &
+ DATASET%contaminantDensity, DATASET%soilConstantAttachmentEfficiency, &
+ DATASET%riverAttachmentEfficiency, DATASET%estuaryAttachmentEfficiency, &
+ DATASET%contaminant_k_diss_pristine, DATASET%contaminant_k_diss_transformed, &
+ DATASET%contaminant_k_transform_pristine, real(DATASET%waterTemperature(1), dp))
+ if (rslt%hasCriticalError()) then
+ call rslt%addToTrace("Failed to create cont in get_C_contaminant_sediment_byVolumeGridCell")
+ call LOGR%toFile(errors=rslt%errors); call ERROR_HANDLER%trigger(errors=rslt%errors); return
+ end if
- !> Get the current weighted mean of transformed NM conc in the water bodies in this grid cell,
- !! weighted by the current water volume in the cell
- function get_C_transformed_waterGridCell(me) result(C_transformed_water)
- class(GridCell) :: me !! This GridCell instance
- real(dp), allocatable :: C_transformed_water(:,:,:) !! Mass concentration of NM in this GridCell [kg/m3]
- real(dp) :: C_transformed_water_w(me%nReaches, C%npDim(1), C%npDim(2), C%npDim(3)) ! Per waterbody NM concentration [kg/m3]
- real(dp) :: volumes(me%nReaches) ! Volumes [m3] of each reach, used for weighting
- integer :: i ! Iterator
- allocate(C_transformed_water(C%npDim(1), C%npDim(2), C%npDim(3)))
- ! Loop over the water bodies in this cell and get water PEC and volume
do i = 1, me%nReaches
associate (reach => me%colRiverReaches(i)%item)
- C_transformed_water_w(i, :, :, :) = reach%C_transformed
- volumes(i) = reach%volume
+ r0 = reach%bedSediment%get_m_contaminant()
+ if (r0%hasError()) then
+ call r0%addToTrace("get_m_contaminant() failed for reach "//trim(str(i)))
+ call LOGR%toFile(errors=r0%errors); call ERROR_HANDLER%trigger(errors=r0%errors); return
+ end if
+ select type (data => r0%getData())
+ type is (Contaminant)
+ tmp_cont = data
+ class default
+ call rslt%addError(ErrorInstance(code=106, message="Result0D did not contain Contaminant"))
+ call ERROR_HANDLER%trigger(errors=rslt%errors); return
+ end select
+
+ vol_reach = reach%bedArea * sum(C%sedimentLayerDepth) ! m3
+ if (vol_reach > C%epsilon) then
+ partial(i,:,:,:) = tmp_cont%c / vol_reach
+ else
+ partial(i,:,:,:) = 0.0_dp
+ end if
+ weights(i) = vol_reach
end associate
end do
- ! Get the weighted average across the reaches, using the volumes as the weight
- C_transformed_water = weightedAverage(C_transformed_water_w, volumes)
- end function
- !> Get the current weighted mean of dissolved species conc in the water bodies in this grid cell,
- !! weighted by the current water volume in the cell
- function get_C_dissolved_waterGridCell(me) result(C_dissolved_water)
- class(GridCell) :: me !! This GridCell instance
- real(dp) :: C_dissolved_water !! Mass concentration of NM in this GridCell [kg/m3]
- real(dp) :: C_dissolved_water_w(me%nReaches) ! Per waterbody NM concentration [kg/m3]
- real(dp) :: volumes(me%nReaches) ! Volumes [m3] of each reach, used for weighting
- integer :: i ! Iterator
- ! Loop over the waterbodies in this cell and get water PEC and volume
- do i = 1, me%nReaches
- associate (reach => me%colRiverReaches(i)%item)
- C_dissolved_water_w(i) = reach%C_dissolved
- volumes(i) = reach%volume
- end associate
- end do
- ! Get the weighted average across the reaches, using the volumes as the weight
- C_dissolved_water = weightedAverage(C_dissolved_water_w, volumes)
- end function
+ arr = weightedAverage(partial, weights)
+ cont%c = arr
+ end function get_C_contaminant_sediment_byVolumeGridCell
+
+
+ !> Weighted mean sediment PEC [kg/kg] for layer l in this grid cell
+ function get_C_contaminant_sediment_lGridCell(me, l) result(cont)
+ class(GridCell) :: me
+ integer :: l
+ type(Contaminant) :: cont
+ real(dp), allocatable :: arr(:,:,:)
+ real(dp) :: partial(me%nReaches, C%contaminantDim(1), C%contaminantDim(2), C%contaminantDim(3))
+ real(dp) :: weights(me%nReaches)
+ integer :: i
+ type(Contaminant) :: tmp_cont
+ type(Result0D) :: res
+ type(Result) :: rslt
+
+ ! Initialize the result Contaminant object
+ rslt = cont%create_from_data('sediment', &
+ DATASET%contaminantDensity, DATASET%soilConstantAttachmentEfficiency, &
+ DATASET%riverAttachmentEfficiency, DATASET%estuaryAttachmentEfficiency, &
+ DATASET%contaminant_k_diss_pristine, DATASET%contaminant_k_diss_transformed, &
+ DATASET%contaminant_k_transform_pristine, real(DATASET%waterTemperature(1), dp))
+ if (rslt%hasCriticalError()) then
+ call rslt%addToTrace("Failed to create cont in get_C_contaminant_sediment_lGridCell")
+ call LOGR%toFile(errors=rslt%errors)
+ call ERROR_HANDLER%trigger(errors=rslt%errors)
+ return
+ end if
- !> Get the mass of NM buried for all the bed sediments in this grid cell
- function get_m_np_buried_sedimentGridCell(me) result(m_np_buried)
- class(GridCell) :: me ! This GridCell instance
- real(dp), allocatable :: m_np_buried(:,:,:) ! Mass of NM buried [kg]
- integer :: i ! Iterator
- allocate(m_np_buried(C%npDim(1), C%npDim(2), C%npDim(3)))
- m_np_buried = 0.0_dp
- ! Loop over the waterbodies in this cell and get mass of sediment buried
+ ! Build per-reach concentrations normalized to layer mass (kg/kg)
do i = 1, me%nReaches
- associate (reach => me%colRiverReaches(i)%item)
- m_np_buried = m_np_buried &
- + reach%bedSediment%get_m_np_buried() * reach%bedArea
+ associate(bs => me%colRiverReaches(i)%item%bedSediment)
+ res = bs%get_m_contaminant_l(l)
+ if (res%hasError()) then
+ call res%addToTrace("Failed to get contaminant for layer " // trim(str(l)) // " in reach " // trim(str(i)))
+ call LOGR%toFile(errors=res%errors)
+ call ERROR_HANDLER%trigger(errors=res%errors)
+ return
+ end if
+ select type (data => res%getData())
+ type is (Contaminant)
+ tmp_cont = data
+ class default
+ call res%addError(ErrorInstance(code=106, message="Invalid data type in Result0D for get_m_contaminant_l"))
+ call res%addToTrace("Failed to extract Contaminant for layer " &
+ // trim(str(l)) // " in reach " // trim(str(i)))
+ call LOGR%toFile(errors=res%errors)
+ call ERROR_HANDLER%trigger(errors=res%errors)
+ return
+ end select
+ if (bs%Mf_bed_by_layer(l) > C%epsilon) then
+ partial(i,:,:,:) = tmp_cont%c / bs%Mf_bed_by_layer(l)
+ else
+ partial(i,:,:,:) = 0.0_dp
+ end if
+ weights(i) = bs%Mf_bed_by_layer(l) * me%colRiverReaches(i)%item%bedArea
end associate
end do
- end function
- !> Get the sum of MN deposition for this grid cell
- function get_j_nm_depositionGridCell(me) result(j_nm_deposition)
- class(GridCell) :: me !! This GridCell instance
- real(dp), allocatable :: j_nm_deposition(:,:,:) !! The NM deposited
- integer :: i ! Iterator
- allocate(j_nm_deposition(C%npDim(1), C%npDim(2), C%npDim(3)))
- j_nm_deposition = 0.0_dp
- ! Loop over the water bodies and sum up the deposited NM
- do i = 1, me%nReaches
- j_nm_deposition = j_nm_deposition + me%colRiverReaches(i)%item%j_nm%deposition
- end do
- end function
+ ! Compute weighted average
+ arr = weightedAverage(partial, weights)
- !> Get the sum of MN deposition for this grid cell
- function get_j_transformed_depositionGridCell(me) result(j_transformed_deposition)
- class(GridCell) :: me !! This GridCell instance
- real(dp), allocatable :: j_transformed_deposition(:,:,:) !! The transformed NM deposited
- integer :: i ! Iterator
- allocate(j_transformed_deposition(C%npDim(1), C%npDim(2), C%npDim(3)))
- j_transformed_deposition = 0.0_dp
- ! Loop over the water bodies and sum up the deposited transformed NM
- do i = 1, me%nReaches
- j_transformed_deposition = j_transformed_deposition + me%colRiverReaches(i)%item%j_nm_transformed%deposition
- end do
+ ! Wrap into Contaminant
+ cont%c = arr
end function
- !> Get the sum of NM resuspended for this grid cell
- function get_j_nm_resuspensionGridCell(me) result(j_nm_resuspension)
- class(GridCell) :: me !! This GridCell instance
- real(dp), allocatable :: j_nm_resuspension(:,:,:) !! The NM resuspended
- integer :: i ! Iterator
- allocate(j_nm_resuspension(C%npDim(1), C%npDim(2), C%npDim(3)))
- j_nm_resuspension = 0.0_dp
- ! Loop over the water bodies in this cell sum the resuspended NM
+ !> Weighted mean sediment PEC [kg/m3] for layer l in this grid cell
+ function get_C_contaminant_sediment_l_byVolumeGridCell(me, l) result(cont)
+ class(GridCell) :: me
+ integer :: l
+ type(Contaminant) :: cont
+ real(dp), allocatable :: arr(:,:,:)
+ real(dp) :: partial(me%nReaches, C%contaminantDim(1), C%contaminantDim(2), C%contaminantDim(3))
+ real(dp) :: weights(me%nReaches)
+ integer :: i
+ type(Contaminant) :: tmp_cont
+ type(Result0D) :: res
+ type(Result) :: rslt
+
+ ! Initialize the result Contaminant object
+ rslt = cont%create_from_data('sediment', &
+ DATASET%contaminantDensity, DATASET%soilConstantAttachmentEfficiency, &
+ DATASET%riverAttachmentEfficiency, DATASET%estuaryAttachmentEfficiency, &
+ DATASET%contaminant_k_diss_pristine, DATASET%contaminant_k_diss_transformed, &
+ DATASET%contaminant_k_transform_pristine, real(DATASET%waterTemperature(1), dp))
+ if (rslt%hasCriticalError()) then
+ call rslt%addToTrace("Failed to create cont in get_C_contaminant_sediment_l_byVolumeGridCell")
+ call LOGR%toFile(errors=rslt%errors)
+ call ERROR_HANDLER%trigger(errors=rslt%errors)
+ return
+ end if
+
+ ! Build per-reach concentrations normalized to layer volume (kg/m3)
+ do i = 1, me%nReaches
+ associate(bs => me%colRiverReaches(i)%item%bedSediment)
+ res = bs%get_m_contaminant_l(l)
+ if (res%hasError()) then
+ call res%addToTrace("Failed to get contaminant for layer " // trim(str(l)) // " in reach " // trim(str(i)))
+ call LOGR%toFile(errors=res%errors)
+ call ERROR_HANDLER%trigger(errors=res%errors)
+ return
+ end if
+ select type (data => res%getData())
+ type is (Contaminant)
+ tmp_cont = data
+ class default
+ call res%addError(ErrorInstance(code=106, message="Invalid data type in Result0D for get_m_contaminant_l"))
+ call res%addToTrace("Failed to extract Contaminant for layer " &
+ // trim(str(l)) // " in reach " // trim(str(i)))
+ call LOGR%toFile(errors=res%errors)
+ call ERROR_HANDLER%trigger(errors=res%errors)
+ return
+ end select
+ ! Normalize by sediment volume (bedArea * layer depth) to get PEC [kg/m3]
+ if (C%sedimentLayerDepth(l) > C%epsilon) then
+ partial(i,:,:,:) = tmp_cont%c / (me%colRiverReaches(i)%item%bedArea * C%sedimentLayerDepth(l))
+ else
+ partial(i,:,:,:) = 0.0_dp
+ end if
+ weights(i) = me%colRiverReaches(i)%item%bedArea * C%sedimentLayerDepth(l)
+ end associate
+ end do
+
+ ! Compute weighted average
+ arr = weightedAverage(partial, weights)
+
+ ! Wrap into Contaminant
+ cont%c = arr
+end function
+
+ !> Get the mass of Contaminant buried for all the bed sediments in this grid cell
+ function get_m_contaminant_buried_sedimentGridCell(me) result(m_contaminant_buried)
+ class(GridCell) :: me
+ type(Contaminant) :: m_contaminant_buried, tmp_cont
+ integer :: i
+ type(Result) :: rslt
+ type(Result0D) :: r0
+
+ rslt = m_contaminant_buried%create_from_data('sediment', &
+ DATASET%contaminantDensity, DATASET%soilConstantAttachmentEfficiency, &
+ DATASET%riverAttachmentEfficiency, DATASET%estuaryAttachmentEfficiency, &
+ DATASET%contaminant_k_diss_pristine, DATASET%contaminant_k_diss_transformed, &
+ DATASET%contaminant_k_transform_pristine, real(DATASET%waterTemperature(1), dp))
+ if (rslt%hasCriticalError()) then
+ call rslt%addToTrace("Failed to create m_contaminant_buried in get_m_contaminant_buried_sedimentGridCell")
+ call LOGR%toFile(errors=rslt%errors); call ERROR_HANDLER%trigger(errors=rslt%errors); return
+ end if
+
do i = 1, me%nReaches
- j_nm_resuspension = j_nm_resuspension + me%colRiverReaches(i)%item%j_nm%resuspension
+ associate (reach => me%colRiverReaches(i)%item)
+ r0 = reach%bedSediment%get_m_contaminant_buried()
+ if (r0%hasError()) then
+ call r0%addToTrace("get_m_contaminant_buried() failed for reach "//trim(str(i)))
+ call LOGR%toFile(errors=r0%errors); call ERROR_HANDLER%trigger(errors=r0%errors); return
+ end if
+ select type (data => r0%getData())
+ type is (Contaminant)
+ tmp_cont = data
+ class default
+ call rslt%addError(ErrorInstance(code=106, message="Result0D did not contain Contaminant"))
+ call ERROR_HANDLER%trigger(errors=rslt%errors); return
+ end select
+ call m_contaminant_buried%add_scaled(tmp_cont, reach%bedArea)
+ end associate
end do
- end function
+ end function get_m_contaminant_buried_sedimentGridCell
- !> Get the sum of transformed NM resuspended for this grid cell
- function get_j_transformed_resuspensionGridCell(me) result(j_transformed_resuspension)
- class(GridCell) :: me !! This GridCell instance
- real(dp), allocatable :: j_transformed_resuspension(:,:,:) !! The NM resuspended
- integer :: i ! Iterator
- allocate(j_transformed_resuspension(C%npDim(1), C%npDim(2), C%npDim(3)))
- j_transformed_resuspension = 0.0_dp
- ! Loop over the water bodies in this cell sum the resuspended transformed NM
+
+ !> Get the sum of Contaminant deposition for this grid cell
+ function get_j_contaminant_depositionGridCell(me) result(j_contaminant_deposition)
+ class(GridCell) :: me
+ type(Contaminant) :: j_contaminant_deposition
+ integer :: i
+ type(Result) :: rslt
+
+ rslt = j_contaminant_deposition%create_from_data( &
+ 'sediment', &
+ DATASET%contaminantDensity, DATASET%soilConstantAttachmentEfficiency, &
+ DATASET%riverAttachmentEfficiency, DATASET%estuaryAttachmentEfficiency, &
+ DATASET%contaminant_k_diss_pristine, DATASET%contaminant_k_diss_transformed, &
+ DATASET%contaminant_k_transform_pristine, real(DATASET%waterTemperature(1), dp))
+ if (rslt%hasCriticalError()) then
+ call rslt%addToTrace("Failed to create j_contaminant_deposition in get_j_contaminant_depositionGridCell")
+ call LOGR%toFile(errors=rslt%errors)
+ call ERROR_HANDLER%trigger(errors=rslt%errors)
+ return
+ end if
do i = 1, me%nReaches
- j_transformed_resuspension = j_transformed_resuspension + me%colRiverReaches(i)%item%j_nm_transformed%resuspension
+ j_contaminant_deposition = j_contaminant_deposition + &
+ me%colRiverReaches(i)%item%j_contaminant_deposition
end do
end function
- !> Get the sum of NM outflowing from this grid cell
- function get_j_nm_outflowGridCell(me) result(j_nm_outflow)
- class(GridCell) :: me !! This GridCell instance
- real(dp), allocatable :: j_nm_outflow(:,:,:) !! The NM outflowing
- integer :: i ! Iterator
- allocate(j_nm_outflow(C%npDim(1), C%npDim(2), C%npDim(3)))
- j_nm_outflow = 0.0_dp
- ! Loop over the water bodies in this cell and sum outflows if they are grid cell outflows
+ !> Get the sum of Contaminant resuspended for this grid cell
+ function get_j_contaminant_resuspensionGridCell(me) result(j_contaminant_resuspension)
+ class(GridCell) :: me
+ type(Contaminant) :: j_contaminant_resuspension
+ integer :: i
+ type(Result) :: rslt
+
+ rslt = j_contaminant_resuspension%create_from_data( &
+ 'sediment', &
+ DATASET%contaminantDensity, DATASET%soilConstantAttachmentEfficiency, &
+ DATASET%riverAttachmentEfficiency, DATASET%estuaryAttachmentEfficiency, &
+ DATASET%contaminant_k_diss_pristine, DATASET%contaminant_k_diss_transformed, &
+ DATASET%contaminant_k_transform_pristine, real(DATASET%waterTemperature(1), dp))
+ if (rslt%hasCriticalError()) then
+ call rslt%addToTrace("Failed to create j_contaminant_resuspension in get_j_contaminant_resuspensionGridCell")
+ call LOGR%toFile(errors=rslt%errors)
+ call ERROR_HANDLER%trigger(errors=rslt%errors)
+ return
+ end if
do i = 1, me%nReaches
- associate (reach => me%colRiverReaches(i)%item)
- if (reach%isGridCellOutflow) then
- j_nm_outflow = j_nm_outflow + reach%j_nm%outflow
- end if
- end associate
+ j_contaminant_resuspension = j_contaminant_resuspension + &
+ me%colRiverReaches(i)%item%j_contaminant_resuspension
end do
end function
- !> Get the sum of transformed NM outflowing from this grid cell
- function get_j_transformed_outflowGridCell(me) result(j_transformed_outflow)
- class(GridCell) :: me !! This GridCell instance
- real(dp), allocatable :: j_transformed_outflow(:,:,:) !! The transformed NM outflowing
- integer :: i ! Iterator
- allocate(j_transformed_outflow(C%npDim(1), C%npDim(2), C%npDim(3)))
- j_transformed_outflow = 0.0_dp
- ! Loop over the water bodies in this cell and sum outflows if they are grid cell outflows
+ !> Get the sum of Contaminant outflowing from this grid cell
+ function get_j_contaminant_outflowGridCell(me) result(j_contaminant_outflow)
+ class(GridCell) :: me
+ type(Contaminant) :: j_contaminant_outflow
+ integer :: i
+ type(Result) :: rslt
+
+ rslt = j_contaminant_outflow%create()
+ if (rslt%hasCriticalError()) then
+ call LOGR%toFile(errors=rslt%errors)
+ call ERROR_HANDLER%trigger(errors=rslt%errors)
+ return
+ end if
do i = 1, me%nReaches
associate (reach => me%colRiverReaches(i)%item)
if (reach%isGridCellOutflow) then
- j_transformed_outflow = j_transformed_outflow + reach%j_nm_transformed%outflow
+ call j_contaminant_outflow%add(reach%j_contaminant_outflow)
end if
end associate
end do
end function
- !> Get the sum of dissolved species outflowing from this grid cell
+ !> Get the sum of dissolved species outflowing from this grid cell
function get_j_dissolved_outflowGridCell(me) result(j_dissolved_outflow)
- class(GridCell) :: me !! This GridCell instance
- real(dp) :: j_dissolved_outflow !! The dissolved species outflowing
- integer :: i ! Iterator
+ class(GridCell) :: me
+ real(dp) :: j_dissolved_outflow
+ integer :: i
+ type(Contaminant) :: tmp_cont
j_dissolved_outflow = 0.0_dp
- ! Loop over the water bodies in this cell and sum outflows if they are grid cell outflows
do i = 1, me%nReaches
- associate (reach => me%colRiverReaches(i)%item)
- if (reach%isGridCellOutflow) then
- j_dissolved_outflow = j_dissolved_outflow + reach%j_dissolved%outflow
- end if
- end associate
+ if (me%colRiverReaches(i)%item%isGridCellOutflow) then
+ tmp_cont = me%colRiverReaches(i)%item%get_m_contaminant()
+ j_dissolved_outflow = j_dissolved_outflow + tmp_cont%m_dissolved
+ end if
end do
end function
!> Get the total length of all reaches in the cell
function getTotalReachLengthGridCell(me) result(totalReachLength)
- class(GridCell) :: me
- real(dp) :: totalReachLength
- integer :: r
+ class(GridCell) :: me
+ real(dp) :: totalReachLength
+ integer :: r
totalReachLength = 0
- ! Loop through reaches to get total length
do r = 1, me%nReaches
totalReachLength = totalReachLength + me%colRiverReaches(r)%item%length
end do
@@ -988,9 +1166,9 @@ function getTotalReachLengthGridCell(me) result(totalReachLength)
!> Get the total volume of water [m3] in this grid cell
function getWaterVolumeGridCell(me) result(waterVolume)
- class(GridCell) :: me !! This GridCell instance
- real(dp) :: waterVolume !! Water volume [m3]
- integer :: i ! Iterator
+ class(GridCell) :: me !! This GridCell instance
+ real(dp) :: waterVolume !! Water volume [m3]
+ integer :: i ! Iterator
waterVolume = 0.0_dp
do i = 1, me%nReaches
waterVolume = waterVolume + me%colRiverReaches(i)%item%volume
@@ -999,12 +1177,11 @@ function getWaterVolumeGridCell(me) result(waterVolume)
!> Get the average depth of water [m] in this grid cell, weighted by reach lengths
function getWaterDepthGridCell(me) result(waterDepth)
- class(GridCell) :: me
- real(dp) :: waterDepth
- real(dp) :: waterDepth_i(me%nReaches)
- real(dp) :: lengths(me%nReaches)
- integer :: i
- ! Loop over reaches and get their depths and lengths
+ class(GridCell) :: me
+ real(dp) :: waterDepth
+ real(dp) :: waterDepth_i(me%nReaches)
+ real(dp) :: lengths(me%nReaches)
+ integer :: i
do i = 1, me%nReaches
waterDepth_i(i) = me%colRiverReaches(i)%item%depth
lengths(i) = me%colRiverReaches(i)%item%length
@@ -1014,9 +1191,9 @@ function getWaterDepthGridCell(me) result(waterDepth)
!> Get the total bed sediment area [m2] in this grid cell
function getBedSedimentAreaGridCell(me) result(bedArea)
- class(GridCell) :: me !! This GridCell instance
- real(dp) :: bedArea !! Bed sediment area [m2]
- integer :: i ! Iterator
+ class(GridCell) :: me !! This GridCell instance
+ real(dp) :: bedArea !! Bed sediment area [m2]
+ integer :: i ! Iterator
bedArea = 0.0_dp
do i = 1, me%nReaches
bedArea = bedArea + me%colRiverReaches(i)%item%bedArea
@@ -1025,16 +1202,37 @@ function getBedSedimentAreaGridCell(me) result(bedArea)
!> Get the total mass of sediment [kg] in this grid cell
function getBedSedimentMassGridCell(me) result(sedimentMass)
- class(GridCell) :: me !! This GridCell instance
- real(dp) :: sedimentMass !! Bed sediment mass [kg]
- integer :: i ! Iterator
+ class(GridCell) :: me !! This GridCell instance
+ real(dp) :: sedimentMass !! Bed sediment mass [kg]
+ integer :: i ! Iterator
sedimentMass = 0.0_dp
- ! Loop over the reaches and sum the total masses of sediment in each reach
do i = 1, me%nReaches
sedimentMass = sedimentMass &
+ me%colRiverReaches(i)%item%bedSediment%Mf_bed_all() & ! Sediment mass in this reach, kg/m2
- * me%colRiverReaches(i)%item%bedArea ! Mutiply by bed area to get total mass in this reach
+ * me%colRiverReaches(i)%item%bedArea ! Multiply by bed area to get total mass in this reach
end do
end function
-end module
+ !> Get the average dissolved contaminant concentration in the grid cell, weighted by water volume
+ function get_C_dissolved_waterGridCell(me) result(C_dissolved_water)
+ class(GridCell) :: me
+ real(dp) :: C_dissolved_water
+ real(dp), allocatable :: C_dissolved_water_w(:)
+ real(dp) :: volumes(me%nReaches)
+ integer :: i
+ type(Contaminant) :: tmp_cont
+
+ allocate(C_dissolved_water_w(me%nReaches))
+ do i = 1, me%nReaches
+ tmp_cont = me%colRiverReaches(i)%item%get_m_contaminant()
+ if (me%colRiverReaches(i)%item%volume > 0.0_dp) then
+ C_dissolved_water_w(i) = tmp_cont%m_dissolved / me%colRiverReaches(i)%item%volume
+ else
+ C_dissolved_water_w(i) = 0.0_dp
+ end if
+ volumes(i) = me%colRiverReaches(i)%item%volume
+ end do
+ C_dissolved_water = weightedAverage(C_dissolved_water_w, volumes)
+ end function get_C_dissolved_waterGridCell
+
+end module
\ No newline at end of file
diff --git a/src/Reactor/AbstractReactorModule.f90 b/src/Reactor/AbstractReactorModule.f90
index 42f1c2e..3e75d18 100644
--- a/src/Reactor/AbstractReactorModule.f90
+++ b/src/Reactor/AbstractReactorModule.f90
@@ -1,153 +1,61 @@
module AbstractReactorModule
use GlobalsModule
+ use ContaminantModule
implicit none
- !> A `Reactor` objects deals with nanoparticle transformations
- !! within any environmental compartment
type, abstract, public :: AbstractReactor
character(len=100) :: ref
- integer :: x
- integer :: y
- real(dp), allocatable :: m_np(:,:,:)
- !! Matrix of NP masses, each element representing a different NP size class (1st dimension),
- !! state (2nd dimension) and form (3rd dimension). States: free, bound to solid, heteroaggreated
- !! (per SPM size class). Forms: core, shell, coating, corona.
- real(dp), allocatable :: m_transformed(:,:,:)
- real(dp) :: m_dissolved
- real(dp), allocatable :: C_np_free_particle(:) !! Particle concentration of free NPs
- real :: T_water !! Temperature of the water [C]
- real(dp), allocatable :: W_settle_np(:) !! NP settling velocity [m/s]
- real(dp), allocatable :: W_settle_spm(:) !! SPM settling velocity [m/s]
- real :: G !! Shear rate of the water [s-1]
- real(dp) :: alpha_hetero !! Attachment efficiency, 0-1 [-]
- real(dp), allocatable :: k_hetero(:,:)
- !! Heteroaggregation rate constant [s-1]. 1st dimension: NP size class.
- !! 2nd dimesion: SPM size class
- real(dp) :: k_diss_pristine
- real(dp) :: k_diss_transformed
- real(dp) :: k_transform_pristine
- real(dp) :: rho_np
- real(dp), allocatable :: individualNPMass(:) !! Mass of individual nanoparticles
- real(dp), allocatable :: C_spm_particle(:) !! Particle concentration of SPM [m-3]
- real(dp) :: volume !! Volume of the container the Reactor is in [m3]
-
- contains
+ integer :: x, y
+ type(Contaminant), pointer :: contaminant => null()
+ real(dp) :: volume ! Must be initialized by derived class or calling module
+ contains
procedure(createAbstractReactor), deferred :: create
procedure(updateAbstractReactor), deferred :: update
- ! Processes
- procedure(heteroaggregationAbstractReactor), deferred :: heteroaggregation
- procedure(dissolutionAbstractReactor), deferred :: dissolution
- procedure(transformationAbstractReactor), deferred :: transformation
+ procedure(finaliseAbstractReactor), deferred :: finalise
procedure(parseInputDataAbstractReactor), deferred :: parseInputData
- ! Calculators
- procedure(calculateCollisionRateAbstractReactor), deferred :: calculateCollisionRate
- procedure(calculateParticleConcentrationAbstractReactor), deferred :: calculateParticleConcentration
end type
abstract interface
-
- !> Run initialising procedures for the `AbstractReactor` object
- function createAbstractReactor(me, x, y, alpha_hetero) result(r)
+ function createAbstractReactor(me, x, y, compartment, contaminant_in, volume, T_water, &
+ C_spm, W_settle_spm, G, k_att, alpha_att, velocity) result(r)
use GlobalsModule
use ResultModule, only: Result
- import AbstractReactor
- class(AbstractReactor) :: me !! This `AbstractReactor` object
- integer :: x !! The containing `GridCell` x reference
- integer :: y !! The containing `GridCell` y reference
- real(dp) :: alpha_hetero !! Attachment efficiency, 0-1 [-]
- type(Result) :: r !! The `Result` object to
+ use ContaminantModule
+ import AbstractReactor
+ class(AbstractReactor), intent(inout) :: me ! Explicit INTENT
+ integer, intent(in) :: x, y
+ character(len=*), intent(in) :: compartment
+ type(Contaminant), target, intent(in) :: contaminant_in
+ real(dp), intent(in) :: volume
+ real(dp), intent(in) :: T_water
+ real(dp), intent(in), optional :: C_spm(:), W_settle_spm(:)
+ real(dp), intent(in), optional :: G
+ real(dp), intent(in), optional :: k_att(:), alpha_att
+ real(dp), intent(in), optional :: velocity
+ type(Result) :: r
end function
- !> Run the `AbstractReactor`'s simulation for the current time step
- function updateAbstractReactor(me, &
- t, &
- m_np, &
- m_transformed, &
- m_dissolved, &
- C_spm, &
- T_water, &
- W_settle_np, &
- W_settle_spm, &
- G, &
- volume) result(r)
+ function updateAbstractReactor(me, j_contaminant_in, dt) result(r)
use GlobalsModule
+ use ContaminantModule
use ResultModule, only: Result
import AbstractReactor
- class(AbstractReactor) :: me !! This `AbstractReactor1` object
- integer :: t !! The current time step
- real(dp) :: m_np(C%npDim(1), C%npDim(2), C%npDim(3)) !! Mass of NP for this timestep [kg]
- real(dp) :: m_transformed(C%npDim(1), C%npDim(2), C%npDim(3)) !! Mass of transformed NM for this timestep [kg]
- real(dp) :: m_dissolved !! Mass of dissolved species for this timestep [kg]
- real(dp) :: C_spm(C%nSizeClassesSpm) !! The current mass concentration of SPM [kg/m3]
- real :: T_water !! The current water temperature [deg C]
- real(dp) :: W_settle_np(C%nSizeClassesNM) !! NP settling velocity [m/s]
- real(dp) :: W_settle_spm(C%nSizeClassesSpm) !! SPM settling velocity [m/s]
- real :: G !! Shear rate [/s]
- real(dp) :: volume !! `RiverReach` volume on this timestep [m3]
- type(Result) :: r
- end function
-
- function finaliseUpdateAbstractReactor(me) result(r)
- use ResultModule, only: Result
- import AbstractReactor
- class(AbstractReactor) :: me
+ class(AbstractReactor), intent(inout) :: me ! Explicit INTENT
+ type(Contaminant), intent(in), optional :: j_contaminant_in
+ real(dp), intent(in) :: dt
type(Result) :: r
end function
- !> Perform the heteroaggregation calculation for this time step
- function heteroaggregationAbstractReactor(me) result(r)
- use ResultModule, only: Result
- import AbstractReactor
- class(AbstractReactor) :: me
- type(Result) :: r
- end function
-
- function dissolutionAbstractReactor(me) result(rslt)
- use ResultModule, only: Result
+ subroutine finaliseAbstractReactor(me)
import AbstractReactor
- class(AbstractReactor) :: me
- type(Result) :: rslt
- end function
-
- function transformationAbstractReactor(me) result(rslt)
- use ResultModule, only: Result
- import AbstractReactor
- class(AbstractReactor) :: me
- type(Result) :: rslt
- end function
+ class(AbstractReactor), intent(inout) :: me ! Explicit INTENT
+ end subroutine
- !> Parse the input data for this AbstractReactor object
function parseInputDataAbstractReactor(me) result(r)
use ResultModule, only: Result
import AbstractReactor
- class(AbstractReactor) :: me
+ class(AbstractReactor), intent(inout) :: me ! Explicit INTENT
type(Result) :: r
end function
-
- !> Calculate the collision rate of NPs to SPM
- function calculateCollisionRateAbstractReactor(me, T_water, G, W_settle_np, W_settle_spm) result(k_coll)
- use GlobalsModule
- use ResultModule, only: Result
- import AbstractReactor
- class(AbstractReactor) :: me
- real :: T_water !! Temperature of the water [deg C]
- real :: G !! Shear rate [/s]
- real(dp) :: W_settle_np(:) !! NP settling velocity [m/s]
- real(dp) :: W_settle_spm(:) !! SPM settling velocity [m/s]
- real(dp) :: k_coll(C%nSizeClassesNM,C%nSizeClassesSpm) !! The collision frequency to return [/s]
- end function
-
- !> Calculate a particle concentration from a mass concentration
- function calculateParticleConcentrationAbstractReactor(me, C_mass, rho_particle, d) result(C_particle)
- use GlobalsModule
- import AbstractReactor
- class(AbstractReactor) :: me
- real(dp) :: C_mass
- real :: rho_particle
- real :: d
- real(dp) :: C_particle
- end function
-
end interface
-
end module
\ No newline at end of file
diff --git a/src/Reactor/ReactorModule.f90 b/src/Reactor/ReactorModule.f90
index 857ac8f..cac4598 100644
--- a/src/Reactor/ReactorModule.f90
+++ b/src/Reactor/ReactorModule.f90
@@ -1,240 +1,176 @@
module ReactorModule
+ use ContaminantModule
use GlobalsModule
- use UtilModule
use ResultModule
use AbstractReactorModule
use DataInputModule, only: DATASET
-
+ use LoggerModule, only: LOGR
+ use ErrorInstanceModule
+ use UtilModule, only: ref
implicit none
-
+
type, public, extends(AbstractReactor) :: Reactor
- contains
- procedure :: create => createReactor
- procedure :: update => updateReactor
- ! Processes
- procedure :: heteroaggregation => heteroaggregationReactor
- procedure :: dissolution => dissolutionReactor
- procedure :: transformation => transformationReactor
+ character(len=100) :: compartment
+ real(dp) :: T_water
+ real(dp), allocatable :: C_spm(:)
+ real(dp), allocatable :: W_settle_spm(:)
+ real(dp) :: G
+ real(dp), allocatable :: k_att(:)
+ real(dp) :: alpha_att
+ real(dp) :: velocity
+ contains
+ procedure :: create => createReactor
+ procedure :: update => updateReactor
+ procedure :: finalise => finaliseReactor
procedure :: parseInputData => parseInputDataReactor
- ! Calculations
- procedure :: calculateCollisionRate => calculateCollisionRateReactor
- procedure :: calculateParticleConcentration => calculateParticleConcentrationReactor
end type
-
- contains
-
- !> Run initialising procedures for the `Reactor` object
- function createReactor(me, x, y, alpha_hetero) result(r)
- class(Reactor) :: me !! This `Reactor` object
- integer :: x !! The containing `GridCell` x reference
- integer :: y !! The containing `GridCell` x reference
- real(dp) :: alpha_hetero !! Attachment efficiency, 0-1 [-]
- type(Result) :: r !! The `Result` object to return
- integer :: n !! NP size class iterator
-
- ! Set the grid references
- me%x = x
- me%y = y
- me%alpha_hetero = alpha_hetero
- me%rho_np = DATASET%nmDensity
- me%volume = 0 ! No river to begin with...
-
- call r%addErrors(.errors. me%parseInputData())
-
- ! Allocate size class arrays to the correct size
- allocate(me%W_settle_np(C%nSizeClassesNM))
- allocate(me%W_settle_spm(C%nSizeClassesSpm))
- allocate(me%k_hetero(C%nSizeClassesNM, C%nSizeClassesSpm))
- allocate(me%C_spm_particle(C%nSizeClassesSpm))
- allocate(me%C_np_free_particle(C%nSizeClassesNM))
- allocate(me%individualNPMass(C%nSizeClassesNM))
-
- ! Allocate the NP mass matrix to correct number of state/form elements.
- ! States: 1. free, 2. bound to solid, 3+ heteroaggreated (per SPM size class).
- ! Forms: 1. core, 2. shell, 3. coating, 4. corona.
- allocate(me%m_np( &
- C%npDim(1), & ! Number of NM size classes
- C%npDim(2), & ! Number of different forms
- C%npDim(3) & ! Number of different states
- ))
- ! Same from transformed NM
- allocate(me%m_transformed(C%npDim(1), C%npDim(2), C%npDim(3)))
-
- end function
-
- !> Run the `Reactor`'s simulation for the current time step
- function updateReactor(me, t, m_np, m_transformed, m_dissolved, C_spm, T_water, W_settle_np, W_settle_spm, G, volume) result(r)
- class(Reactor) :: me !! This `Reactor` object
- integer :: t !! The current time step
- real(dp) :: m_np(C%npDim(1), C%npDim(2), C%npDim(3)) !! Mass of NM for this timestep [kg]
- real(dp) :: m_transformed(C%npDim(1), C%npDim(2), C%npDim(3)) !! Mass of NM for this timestep [kg]
- real(dp) :: m_dissolved !! Mass of dissolved NM for this timestep [kg]
- real(dp) :: C_spm(C%nSizeClassesSpm) !! The current mass concentration of SPM [kg/m3]
- real :: T_water !! The current water temperature [C]
- real(dp) :: W_settle_np(C%nSizeClassesNM) !! NM settling velocity [m/s]
- real(dp) :: W_settle_spm(C%nSizeClassesSpm) !! SPM settling velocity [m/s]
- real :: G !! Shear rate [s-1]
- real(dp) :: volume !! Volume of the reach on this time step [m3]
- type(Result) :: r !! The `Result` object to return
- integer :: s ! Iterator for SPM size classes
- integer :: n ! Iterator for NP size classes
-
- ! Set current mass of NP in reactor to that given. Reactor doesn't deal
- ! with inflows/outflows and just takes a mass on each timestep and transforms
- ! that mass
- me%m_np = m_np
- me%m_transformed = m_transformed
- me%m_dissolved = m_dissolved
- me%volume = volume ! Volume of the container
- me%T_water = T_water ! Current water temperature
- me%W_settle_np = W_settle_np ! Settling rates
+
+contains
+
+! Matches abstract interface exactly
+function createReactor(me, x, y, compartment, contaminant_in, volume, T_water, &
+ C_spm, W_settle_spm, G, k_att, alpha_att, velocity) result(r)
+ class(Reactor), intent(inout) :: me
+ integer, intent(in) :: x, y
+ character(len=*), intent(in) :: compartment
+ type(Contaminant), target, intent(in) :: contaminant_in
+ real(dp), intent(in) :: volume
+ real(dp), intent(in) :: T_water
+ real(dp), intent(in), optional :: C_spm(:), W_settle_spm(:)
+ real(dp), intent(in), optional :: G
+ real(dp), intent(in), optional :: k_att(:), alpha_att
+ real(dp), intent(in), optional :: velocity
+ type(Result) :: r
+
+ integer :: alloc_stat
+ integer :: nspm
+
+ ! basics
+ me%x = x; me%y = y
+ me%ref = trim(ref('Reactor', x, y, 0))
+ me%compartment = trim(compartment)
+ me%volume = volume
+ me%T_water = T_water
+
+ ! associate to live contaminant (caller-owned)
+ if (associated(me%contaminant)) nullify(me%contaminant)
+ me%contaminant => contaminant_in
+
+ ! defaults
+ me%G = 0.0_dp
+ me%alpha_att = 0.0_dp
+ me%velocity = 0.0_dp
+ if (present(G)) me%G = G
+ if (present(alpha_att)) me%alpha_att = alpha_att
+ if (present(velocity)) me%velocity = velocity
+
+ ! (re)allocate arrays
+ if (allocated(me%C_spm)) deallocate(me%C_spm)
+ if (allocated(me%W_settle_spm)) deallocate(me%W_settle_spm)
+ if (allocated(me%k_att)) deallocate(me%k_att)
+
+ if (present(C_spm)) then
+ allocate(me%C_spm(size(C_spm)), stat=alloc_stat); if (alloc_stat /= 0) then
+ call r%addError(ErrorInstance(code=901, message="Failed to allocate C_spm")); return
+ end if
+ me%C_spm = C_spm
+ else
+ nspm = max(1, C%nSizeClassesSpm)
+ allocate(me%C_spm(nspm), stat=alloc_stat); if (alloc_stat /= 0) then
+ call r%addError(ErrorInstance(code=901, message="Failed to allocate C_spm")); return
+ end if
+ me%C_spm = 0.0_dp
+ end if
+
+ if (present(W_settle_spm)) then
+ allocate(me%W_settle_spm(size(W_settle_spm)), stat=alloc_stat); if (alloc_stat /= 0) then
+ call r%addError(ErrorInstance(code=902, message="Failed to allocate W_settle_spm")); return
+ end if
me%W_settle_spm = W_settle_spm
- me%G = G ! Shear rate
-
- ! Calculate the SPM particle concentration, assuming SPM is spherical
- do s = 1, C%nSizeClassesSpm
- ! HACK: Sort this out to use propper fractional comp densities
- ! C_spm_particle = C_spm / mass of particle
- me%C_spm_particle(s) = me%calculateParticleConcentration( &
- C_spm(s), &
- sum(C%sedimentParticleDensities)/C%nFracCompsSpm, &
- C%d_spm(s) &
- )
- end do
-
- ! Heteroaggregate NPs to SPM, which updates m_np accordingly
- call r%addErrors(.errors. me%heteroaggregation())
- call r%addErrors(.errors. me%dissolution())
- call r%addErrors(.errors. me%transformation())
-
- ! The mass will have now been adjusted according to transformation.
- ! Reactor doesn't deal with inflows/outflows, so this updated mass
- ! must be picked up by the containing object and dealt with accordingly.
- end function
-
- !> Perform the heteroaggregation calculation for this time step
- function heteroaggregationReactor(me) result(r)
- class(Reactor) :: me !! This `Reactor` instance
- type(Result) :: r !! The `Result` object to return any errors in
- real(dp) :: k_coll(C%nSizeClassesNM,C%nSizeClassesSpm) ! Collision frequency [s-1]
- integer :: s, n ! Iterators for NM and SPM size classes
- real(dp) :: T(C%nSizeClassesNM, C%nSizeClassesSpm + 2, C%nSizeClassesSpm + 2)
- real(dp) :: dm_hetero ! Mass of NPs heteroaggregated on this timestep [kg/timestep]
-
- ! Calculate the collision rate and then heteroaggregation rate constant
- k_coll = me%calculateCollisionRate( &
- me%T_water, &
- me%G, &
- me%W_settle_np, &
- me%W_settle_spm &
- )
- do s = 1, C%nSizeClassesSpm
- do n = 1, C%nSizeClassesNM
- me%k_hetero(n,s) = k_coll(n,s) * me%alpha_hetero * me%C_spm_particle(s)
- end do
- end do
-
- do n = 1, C%nSizeClassesNM
- ! Calculate mass heteroaggregated (dm_hetero)
- ! first so that, if all NPs are heteroaggregated on one timestep, the mass can be split
- ! amongst SPM size classes correctly (rather than using k_hetero for each SPM size class,
- ! when we add to the heteroaggregated mass, which would result in too much mass being added)
- dm_hetero = min(sum(me%k_hetero(n,:))*C%timeStep*me%m_np(n,1,1), me%m_np(n,1,1))
- me%m_np(n,1,1) = me%m_np(n,1,1) - dm_hetero ! Remove heteroaggregated mass from free NPs
- ! Add heteroaggregated mass to each size class of SPM
- do s = 1, C%nSizeClassesSpm
- if (.not. isZero(me%k_hetero(n,s))) then
- dm_hetero = dm_hetero*(me%k_hetero(n,s)/sum(me%k_hetero(n,:))) ! Fraction of heteroaggregated mass to add to this SPM size class
- me%m_np(n,1,s+2) = me%m_np(n,1,s+2) + dm_hetero ! Add that heteroaggregated NPs
- else
- dm_hetero = 0.0_dp
- end if
- end do
-
- ! Transformed NM
- dm_hetero = min(sum(me%k_hetero(n,:))*C%timeStep*me%m_transformed(n,1,1), me%m_transformed(n,1,1))
- me%m_transformed(n,1,1) = me%m_transformed(n,1,1) - dm_hetero ! Remove heteroaggregated mass from free NPs
- do s = 1, C%nSizeClassesSpm
- if (.not. isZero(me%k_hetero(n,s))) then
- dm_hetero = dm_hetero*(me%k_hetero(n,s)/sum(me%k_hetero(n,:))) ! Fraction of heteroaggregated mass to add to this SPM size class
- me%m_transformed(n,1,s+2) = me%m_transformed(n,1,s+2) + dm_hetero
- else
- dm_hetero = 0.0_dp
- end if
- end do
-
- end do
- end function
-
- function dissolutionReactor(me) result(rslt)
- class(Reactor) :: me
- type(Result) :: rslt
- real(dp) :: dm_diss(C%npDim(1), C%npDim(2), C%npDim(3)) ! Mass of NM dissolving on each time step [kg/timestep]
- ! Dissolution of pristine NM
- dm_diss = min(me%k_diss_pristine * C%timeStep * me%m_np, me%m_np)
- me%m_np = me%m_np - dm_diss
- me%m_dissolved = me%m_dissolved + sum(dm_diss)
- ! Dissolution of transformed NM
- dm_diss = min(me%k_diss_transformed * C%timeStep * me%m_transformed, me%m_transformed)
- me%m_transformed = me%m_transformed - dm_diss
- me%m_dissolved = me%m_dissolved + sum(dm_diss)
- end function
-
- function transformationReactor(me) result(rslt)
- class(Reactor) :: me
- type(Result) :: rslt
- real(dp) :: dm_transform(C%npDim(1), C%npDim(2), C%npDim(3))
-
- ! Transformation (e.g. sulphidation) of pristine NM
- dm_transform = min(me%k_transform_pristine * C%timeStep * me%m_np, me%m_np)
- me%m_np = me%m_np - dm_transform
- me%m_transformed = me%m_transformed + dm_transform
-
- end function
-
- !> Parse the input data for this Reactor
- function parseInputDataReactor(me) result(r)
- class(Reactor) :: me
- type(Result) :: r
-
- me%k_diss_pristine = DATASET%water_k_diss_pristine
- me%k_diss_transformed = DATASET%water_k_diss_transformed
- me%k_transform_pristine = DATASET%water_k_transform_pristine
- ! TODO: Is there actually going to be input data,
- ! or is this going to be passed from RiverReach?
- end function
-
- !> Calculate the collision rate between NPs and SPM.
- !! Reference: [Praetorious et al, 2012](http://dx.doi.org/10.1021/es204530n)
- function calculateCollisionRateReactor(me, T_water, G, W_settle_np, W_settle_spm) result(k_coll)
- class(Reactor) :: me !! This `Reactor` instance
- real :: T_water !! Temperature of the water [deg C]
- real :: G !! Shear rate [/s]
- real(dp) :: W_settle_np(:) !! NP settling velocity [m/s]
- real(dp) :: W_settle_spm(:) !! SPM settling velocity [m/s]
- real(dp) :: k_coll(C%nSizeClassesNM, C%nSizeClassesSpm) !! The collision frequency to return [/s]
- integer :: n, s ! Iterators for SPM and NP size classes
-
- do s = 1, C%nSizeClassesSpm
- do n = 1, C%nSizeClassesNM
- k_coll(n,s) = (2*C%k_B*(T_water+273.15_dp)/(3*C%mu_w(T_water))) &
- * (C%d_spm(s)/2 + C%d_nm(n)/2)**2/((C%d_spm(s)/2)*(C%d_nm(n)/2)) &
- + (4.0_dp/3.0_dp)*G*(C%d_nm(n)/2 + C%d_spm(s)/2)**3 &
- + C%pi*(C%d_spm(s)/2+C%d_nm(n)/2)**2 &
- * abs(W_settle_np(n) - W_settle_spm(s))
- end do
- end do
-
- end function
-
- !> Calculate a particle concentration from a mass concentration
- function calculateParticleConcentrationReactor(me, C_mass, rho_particle, d) result(C_particle)
- class(Reactor) :: me
- real(dp) :: C_mass
- real :: rho_particle
- real :: d
- real(dp) :: C_particle
- C_particle = C_mass / (rho_particle*(4.0_dp/3.0_dp)*C%pi*(d/2)**3)
- end function
-
+ else
+ allocate(me%W_settle_spm(size(me%C_spm)), stat=alloc_stat); if (alloc_stat /= 0) then
+ call r%addError(ErrorInstance(code=902, message="Failed to allocate W_settle_spm")); return
+ end if
+ me%W_settle_spm = 0.0_dp
+ end if
+
+ if (present(k_att)) then
+ allocate(me%k_att(size(k_att)), stat=alloc_stat); if (alloc_stat /= 0) then
+ call r%addError(ErrorInstance(code=903, message="Failed to allocate k_att")); return
+ end if
+ me%k_att = k_att
+ end if
+end function createReactor
+
+
+function updateReactor(me, j_contaminant_in, dt) result(r)
+ class(Reactor), intent(inout) :: me
+ type(Contaminant), intent(in), optional :: j_contaminant_in
+ real(dp), intent(in) :: dt
+ type(Result) :: r
+ type(ErrorInstance) :: err(1)
+ real(dp), allocatable :: local_k_att(:)
+ real(dp) :: d_grain_eff
+
+ if (.not. associated(me%contaminant)) then
+ err(1) = ErrorInstance(code=905, message="Reactor's contaminant pointer is not associated.")
+ call r%addErrors(err)
+ return
+ end if
+
+ select case (trim(me%compartment))
+ case ('water','estuary')
+ ! If k_att is provided externally, use it directly; otherwise build a temporary fallback.
+ if (allocated(me%k_att)) then
+ call r%addErrors(.errors. me%contaminant%update( &
+ dt, me%T_water, me%C_spm, me%W_settle_spm, me%G, me%volume, &
+ me%compartment, me%k_att, me%alpha_att))
+ else
+ allocate(local_k_att(C%contaminantDim(1)))
+ if (allocated(DATASET%spmSizeClasses) .and. size(DATASET%spmSizeClasses) > 0) then
+ d_grain_eff = DATASET%spmSizeClasses(1)
+ else
+ d_grain_eff = C%d_spm(1) ! representative SPM diameter
+ end if
+ local_k_att = me%contaminant%calculateAttachmentRate( &
+ me%T_water, DATASET%soilDefaultPorosity, d_grain_eff, me%velocity)
+
+ call r%addErrors(.errors. me%contaminant%update( &
+ dt, me%T_water, me%C_spm, me%W_settle_spm, me%G, me%volume, &
+ me%compartment, local_k_att, me%alpha_att))
+
+ deallocate(local_k_att)
+ end if
+
+ case ('sediment')
+ call r%addErrors(.errors. me%contaminant%update( &
+ dt, me%T_water, me%C_spm, me%W_settle_spm, me%G, me%volume, 'sediment'))
+
+ case ('soil')
+ call r%addErrors(.errors. me%contaminant%update( &
+ dt, me%T_water, me%C_spm, me%W_settle_spm, me%G, me%volume, 'soil', me%k_att, me%alpha_att))
+
+ case default
+ err(1) = ErrorInstance(code=900, message="Invalid compartment in Reactor: " // trim(me%compartment))
+ call r%addErrors(err)
+ end select
+end function updateReactor
+
+
+
+subroutine finaliseReactor(me)
+ class(Reactor), intent(inout) :: me
+ if (associated(me%contaminant)) nullify(me%contaminant)
+ if (allocated(me%C_spm)) deallocate(me%C_spm)
+ if (allocated(me%W_settle_spm)) deallocate(me%W_settle_spm)
+ if (allocated(me%k_att)) deallocate(me%k_att)
+end subroutine finaliseReactor
+
+
+function parseInputDataReactor(me) result(r)
+ class(Reactor), intent(inout) :: me
+ type(Result) :: r
+ ! hook for future per-cell reactor inputs
+end function parseInputDataReactor
+
end module
diff --git a/src/Soil/AbstractSoilLayerModule.f90 b/src/Soil/AbstractSoilLayerModule.f90
index 03c1484..ce818b9 100644
--- a/src/Soil/AbstractSoilLayerModule.f90
+++ b/src/Soil/AbstractSoilLayerModule.f90
@@ -1,9 +1,11 @@
!> Module containing definition of abstract base class AbstractSoilLayer
module AbstractSoilLayerModule
- use GlobalsModule ! Global definitions and constants
+ use GlobalsModule ! Global definitions and constants
use mo_netcdf ! NetCDF input/output
use ResultModule, only: Result ! Result object to pass errors
use BiotaSoilModule
+ use ContaminantModule
+ use DataInputModule, only: DATASET
implicit none
!> Abstract base class for \1 object. Defines properties and
@@ -20,19 +22,6 @@ module AbstractSoilLayerModule
real(dp) :: depth !! Layer depth [m]
real(dp) :: area !! Area of the containing SoilProfile [m2]
real(dp) :: volume !! Volume of the soil layer [m3]
- ! Nanomaterials
- real(dp), allocatable :: m_np(:,:,:) !! Mass of NM currently in layer [kg]
- real(dp), allocatable :: m_np_perc(:,:,:) !! Mass of NM percolating to layer below on given timestep [kg]
- real(dp), allocatable :: m_np_eroded(:,:,:) !! Mass of NM eroded on given timestep [kg]
- real(dp), allocatable :: C_np(:,:,:) !! Mass concentration of NM [kg/kg soil]
- real(dp), allocatable :: m_transformed(:,:,:)
- real(dp), allocatable :: m_transformed_perc(:,:,:)
- real(dp), allocatable :: m_transformed_eroded(:,:,:)
- real(dp), allocatable :: C_transformed(:,:,:)
- real(dp), allocatable :: m_dissolved
- real(dp), allocatable :: m_dissolved_perc
- real(dp), allocatable :: m_dissolved_eroded
- real(dp), allocatable :: C_dissolved
! Hydrology
real(dp) :: q_in !! Inflow to this `SoilLayer` [m3 m-2 s-1]
real(dp) :: V_w !! Volume of water currently in layer [m3 m-2]
@@ -46,22 +35,29 @@ module AbstractSoilLayerModule
real(dp) :: d_grain !! Average grain diameter [m]
real(dp) :: porosity !! Porosity [-]
real(dp) :: earthwormDensity !! Earthworm density [individuals/layer]
- ! NM transformations
- real :: alpha_att !! Attachment efficiency to soil matrix [-]
- real, allocatable :: k_att(:) !! Attachment rate to soil matrix [s-1]
+ real(dp) :: alpha_att
+ real(dp), allocatable :: k_att(:)
! Biota
integer :: nBiota = 0
integer, allocatable :: biotaIndices(:)
class(BiotaSoil), allocatable :: biota(:)
+ type(Contaminant) :: m_contaminant
+ type(Contaminant) :: j_contaminant_in
+ type(Contaminant) :: j_contaminant_perc
+ type(Contaminant) :: j_contaminant_eroded
+
contains
procedure(createAbstractSoilLayer), deferred :: create
procedure(updateAbstractSoilLayer), deferred :: update
procedure(addPooledWaterAbstractSoilLayer), deferred :: addPooledWater
+ procedure(updateContaminantStateAbstractSoilLayer), deferred :: update_contaminant_state
procedure(erodeAbstractSoilLayer), deferred :: erode
procedure(parseInputDataAbstractSoilLayer), deferred :: parseInputData
procedure(calculateBioturbationRateAbstractSoilLayer), deferred :: calculateBioturbationRate
! Non-deferred procedures
procedure :: setV_pool
+ procedure :: finalise => finaliseSoilLayer
+ procedure :: get_C_contaminant
end type
!> Container type for `class(AbstractSoilLayer)` such that a polymorphic
@@ -95,19 +91,25 @@ function createAbstractSoilLayer(me, x, y, p, l, WC_sat, WC_FC, K_s, area, &
end function
!> Update the AbstractSoilLayer on a given timestep
- function updateAbstractSoilLayer(me, t, q_in, m_np_in, m_transformed_in, m_dissolved_in) result(r)
+ function updateAbstractSoilLayer(me, t, q_in, j_contaminant_in) result(r)
use ResultModule, only: Result
use GlobalsModule, only: dp
+ use ContaminantModule
import AbstractSoilLayer
class(AbstractSoilLayer) :: me !! This AbstractSoilLayer instance
integer :: t !! The current time step
real(dp) :: q_in !! Water into the layer on this time step [m/timestep]
- real(dp) :: m_np_in(:,:,:) !! NM into the layer on this time step [kg/timestep]
- real(dp) :: m_transformed_in(:,:,:) !! Transformed NM into the layer on this time step [kg/timestep]
- real(dp) :: m_dissolved_in !! Dissolved species into the layer on this time step [kg/timestep]
+ type(Contaminant), intent(in) :: j_contaminant_in
type(Result) :: r !! The `Result` object to return, with no data
end function
+ subroutine updateContaminantStateAbstractSoilLayer(me, T_water_t)
+ use GlobalsModule, only: dp
+ import AbstractSoilLayer
+ class(AbstractSoilLayer), intent(inout) :: me
+ real(dp), intent(in) :: T_water_t
+ end subroutine
+
!> Add a volume \( V_{\text{pool}} \) of pooled water to the layer.
!! No percolation occurs as pooled water never really leaves the AbstractSoilLayer.
function addPooledWaterAbstractSoilLayer(me, V_pool) result(r)
@@ -122,12 +124,12 @@ function addPooledWaterAbstractSoilLayer(me, V_pool) result(r)
!> Erode NM from this soil layer
function erodeAbstractSoilLayer(me, erodedSediment, bulkDensity, area) result(r)
use ResultModule, only: Result
- use GlobalsModule, only: dp, C
+ use GlobalsModule, only: dp
+ use ContaminantModule
import AbstractSoilLayer
class(AbstractSoilLayer) :: me
real(dp) :: erodedSediment(:)
- real(dp) :: bulkDensity
- real(dp) :: area
+ real(dp) :: bulkDensity, area
type(Result) :: r
end function
@@ -145,7 +147,6 @@ function parseInputDataAbstractSoilLayer(me) result(r)
import AbstractSoilLayer
class(AbstractSoilLayer) :: me !! This AbstractSoilLayer instance
type(Result) :: r
- !! The Result object to return any errors relating to the input data file
end function
end interface
@@ -158,4 +159,32 @@ subroutine setV_pool(me, V_pool)
me%V_pool = V_pool
end subroutine
+ function get_C_contaminant(me) result(C_contaminant)
+ class(AbstractSoilLayer), intent(in) :: me
+ real(dp) :: C_contaminant(C%contaminantDim(1), C%contaminantDim(2), C%contaminantDim(3))
+ real(dp) :: soil_mass
+ soil_mass = me%bulkDensity * me%volume / me%area ! [kg/m2]
+ if (soil_mass > C%epsilon) then
+ C_contaminant = me%m_contaminant%c / soil_mass
+ else
+ C_contaminant = 0.0_dp
+ end if
+ end function
+
+ subroutine finaliseSoilLayer(me)
+ class(AbstractSoilLayer) :: me
+ integer :: i
+ call me%m_contaminant%finalise()
+ call me%j_contaminant_in%finalise()
+ call me%j_contaminant_perc%finalise()
+ call me%j_contaminant_eroded%finalise()
+ if (allocated(me%biota)) then
+ do i = 1, size(me%biota)
+ call me%biota(i)%finalise()
+ end do
+ deallocate(me%biota)
+ end if
+ if (allocated(me%k_att)) deallocate(me%k_att)
+ if (allocated(me%biotaIndices)) deallocate(me%biotaIndices)
+ end subroutine
end module
\ No newline at end of file
diff --git a/src/Soil/AbstractSoilProfileModule.f90 b/src/Soil/AbstractSoilProfileModule.f90
index 89d1332..6e5e258 100644
--- a/src/Soil/AbstractSoilProfileModule.f90
+++ b/src/Soil/AbstractSoilProfileModule.f90
@@ -1,14 +1,15 @@
-!> Module containing definition of abstract base class AbstractSoilProfile
module AbstractSoilProfileModule
use GlobalsModule
use AbstractSoilLayerModule
use ResultModule, only: Result
+ use ContaminantModule
+ use DataInputModule, only: DATASET
implicit none
- !> Abstract base class for soil profiles. Defines properties and methods required in any implmentation
+ !> Abstract base class for soil profiles. Defines properties and methods required in any implementation
!! of an AbstractSoilProfile class. This class acts as a container for a collection of SoilLayer objects,
- !! which collectively define the layout of the SoilProfile. The SoilLayer class routes, water, eroded
- !! soil (and ultimately NM) through a layer of soil
+ !! which collectively define the layout of the SoilProfile. The SoilLayer class routes water, eroded
+ !! soil (and ultimately contaminants) through a layer of soil
type, abstract, public :: AbstractSoilProfile
! Setup and dimensions
character(len=256) :: ref !! A reference name for the object
@@ -17,18 +18,6 @@ module AbstractSoilProfileModule
integer :: p !! SoilProfile index
type(SoilLayerElement), allocatable :: colSoilLayers(:) !! Array of `SoilLayerElement` objects to hold the soil layers
real(dp) :: area !! The surface area of the `SoilProfile`
- ! Nanomaterial
- real(dp), allocatable :: m_np(:,:,:) !! Mass of NM currently in profile [kg]
- real(dp), allocatable :: m_np_in(:,:,:) !! Mass of NM deposited to profile on a time step [kg]
- real(dp), allocatable :: m_np_buried(:,:,:) !! Cumulative mass of NM "lost" from the bottom `SoilLayer` [kg]
- real(dp), allocatable :: m_np_eroded(:,:,:) !! Mass of NM eroded on current timestep [kg]
- real(dp), allocatable :: m_transformed(:,:,:) !! Mass of transformed NM currently in profile [kg]
- real(dp), allocatable :: m_transformed_in(:,:,:) !! Mass of transformed NM deposited to profile on a time step [kg]
- real(dp), allocatable :: m_transformed_buried(:,:,:) !! Cumulative mass of transformed NM "lost" from the bottom `SoilLayer` [kg]
- real(dp), allocatable :: m_transformed_eroded(:,:,:) !! Mass of transformed NM eroded on current timestep [kg]
- real(dp), allocatable :: m_dissolved !! Mass of dissolved NM currently in profile [kg]
- real(dp), allocatable :: m_dissolved_in !! Mass of dissolved NM deposited to profile on a time step [kg]
- real(dp), allocatable :: m_dissolved_buried !! Cumulative mass of dissolved NM "lost" from the bottom `SoilLayer` [kg]
! Hydrology and met
real(dp) :: n_river !! Manning's roughness coefficient for the river
real(dp) :: V_pool !! Pooled water from top SoilLayer for this timestep [m3 m-2]
@@ -36,13 +25,11 @@ module AbstractSoilProfileModule
real :: q_precip !! Precipitation for this time step [m3 m-2 s-1]
real, allocatable :: q_evap_timeSeries(:) !! Time series of evapotranspiration data [m3 m-2 s-1]
real :: q_evap !! Evapotranspiration for this time step [m3 m-2 s-1]
- real(dp) :: q_in
- !! Infiltration for this time step: \( q_{\text{in}} = q_{\text{precip}} - q_{\text{evap}} \) [m3 m-2 s-1]
+ real(dp) :: q_in !! Infiltration for this time step: \( q_{\text{in}} = q_{\text{precip}} - q_{\text{evap}} \) [m3 m-2 s-1]
real(dp) :: WC_sat !! Water content at saturation [m3 m-3]
real(dp) :: WC_FC !! Water content at field capacity [m3 m-3]
real(dp) :: K_s !! Saturated hydraulic conductivity [m s-1]
real(dp) :: V_buried !! Volume of buried water (from the bottom `SoilLayer`) [m3 m-2]
- !! Total volume of water lost from the bottom of the SoilProfile, over the complete model run [m3 m-2]
! Soil properties. Sand + silt + clay = 100 %
real :: sandContent !! Sand content of the soil [%]
real :: siltContent !! Silt content of the soil [%]
@@ -68,23 +55,24 @@ module AbstractSoilProfileModule
real(dp) :: sedimentTransportCapacity !! Maximum erodable sediment [kg/m2/timestep]
real(dp), allocatable :: distributionSediment(:) !! Distribution to split sediment into
logical :: isUrban = .false. !! Is this an urban soil?
+ type(Contaminant) :: m_contaminant !! Total contaminant mass in profile [kg]
+ type(Contaminant) :: m_contaminant_in !! Contaminant deposited to profile on a time step [kg]
+ type(Contaminant) :: m_contaminant_buried !! Cumulative contaminant "lost" from the bottom `SoilLayer` [kg]
+ type(Contaminant) :: m_contaminant_eroded !! Contaminant eroded on current timestep [kg]
contains
- procedure(createAbstractSoilProfile), deferred :: create
- procedure(updateAbstractSoilProfile), deferred :: update
- procedure(percolateAbstractSoilProfile), deferred :: percolate
- procedure(erodeAbstractSoilProfile), deferred :: erode
- procedure(bioturbationAbstractSoilProfile), deferred :: bioturbation
- procedure(imposeSizeDistributionAbstractSoilProfile), deferred :: imposeSizeDistribution
- procedure(calculateSizeDistributionAbstractSoilProfile), deferred :: calculateSizeDistribution
- procedure(calculateAverageGrainSizeAbstractSoilProfile), deferred :: calculateAverageGrainSize
- procedure(parseInputDataAbstractSoilProfile), deferred :: parseInputData
- procedure(parseNewBatchDataAbstractSoilProfile), deferred :: parseNewBatchData
- procedure(get_m_np_AbstractSoilProfile), deferred :: get_m_np
- procedure(get_m_transformed_AbstractSoilProfile), deferred :: get_m_transformed
- procedure(get_m_dissolved_AbstractSoilProfile), deferred :: get_m_dissolved
- procedure(get_C_np_AbstractSoilProfile), deferred :: get_C_np
- procedure(get_C_transformed_AbstractSoilProfile), deferred :: get_C_transformed
- procedure(get_C_dissolved_AbstractSoilProfile), deferred :: get_C_dissolved
+ procedure(createAbstractSoilProfile), deferred :: create
+ procedure(updateAbstractSoilProfile), deferred :: update
+ procedure(percolateAbstractSoilProfile), deferred :: percolate
+ procedure(erodeAbstractSoilProfile), deferred :: erode
+ procedure(bioturbationAbstractSoilProfile), deferred :: bioturbation
+ procedure(imposeSizeDistributionAbstractSoilProfile), deferred :: imposeSizeDistribution
+ procedure(calculateSizeDistributionAbstractSoilProfile), deferred :: calculateSizeDistribution
+ procedure(calculateAverageGrainSizeAbstractSoilProfile), deferred :: calculateAverageGrainSize
+ procedure(parseInputDataAbstractSoilProfile), deferred :: parseInputData
+ procedure(parseNewBatchDataAbstractSoilProfile), deferred :: parseNewBatchData
+ procedure(get_m_contaminant_AbstractSoilProfile), deferred :: get_m_contaminant
+ procedure(get_C_contaminant_AbstractSoilProfile), deferred :: get_C_contaminant
+ procedure :: finalise => finaliseSoilProfile
end type
!> Container type for `class(AbstractSoilProfile)` such that a polymorphic
@@ -120,31 +108,27 @@ function createAbstractSoilProfile(me, &
end function
!> Perform the AbstractSoilProfile's simulation for one timestep
- function updateAbstractSoilProfile(me, t, j_np_diffuseSource, j_transformed_diffuseSource, &
- j_dissolved_diffuseSource) result(r)
+ function updateAbstractSoilProfile(me, t, j_contaminant_diffuseSource) result(r)
use GlobalsModule, only: dp
use ResultModule, only: Result
+ use ContaminantModule
import AbstractSoilProfile
- class(AbstractSoilProfile) :: me !! This AbstractSoilProfile instance
- integer :: t !! The current time step
- real(dp) :: j_np_diffuseSource(:,:,:) !! Difffuse source of NM for this timestep [kg/m2/timestep]
- real(dp) :: j_transformed_diffuseSource(:,:,:) !! Diffuse source of transformed NM for this timestep [kg/m2/timestep]
- real(dp) :: j_dissolved_diffuseSource !! Diffuse source of dissolved species for this timestep [kg/m2/timestep]
- type(Result) :: r !! Result object to return
+ class(AbstractSoilProfile), intent(inout) :: me !! This AbstractSoilProfile instance
+ integer, intent(in) :: t !! The current time step
+ type(Contaminant), intent(in) :: j_contaminant_diffuseSource !! Diffuse source of contaminant for this timestep
+ type(Result) :: r !! Result object to return
end function
!> Percolate water through the AbstractSoilProfile for the current time step
- function percolateAbstractSoilProfile(me, t, j_np_diffuseSource, j_transformed_diffuseSource, &
- j_dissolved_diffuseSource) result(r)
+ function percolateAbstractSoilProfile(me, t, j_contaminant_diffuseSource) result(r)
use GlobalsModule, only: dp
use ResultModule, only: Result
+ use ContaminantModule
import AbstractSoilProfile
- class(AbstractSoilProfile) :: me !! This AbstractSoilProfile instance
- integer :: t !! The current time step
- real(dp) :: j_np_diffuseSource(:,:,:) !! Diffuse source of NM for this timestep [kg/m2/timestep]
- real(dp) :: j_transformed_diffuseSource(:,:,:) !! Diffuse source of transformed NM for this time step [kg/m2/timestep]
- real(dp) :: j_dissolved_diffuseSource !! Diffuse source of dissolved species for this time step [kg/m2/timestep]
- type(Result) :: r !! The Result object to return
+ class(AbstractSoilProfile) :: me !! This AbstractSoilProfile instance
+ integer :: t !! The current time step
+ type(Contaminant), intent(in) :: j_contaminant_diffuseSource !! Diffuse source of contaminant for this timestep
+ type(Result) :: r !! The Result object to return
end function
!> Erode soil for the current time step
@@ -189,16 +173,6 @@ function calculateAverageGrainSizeAbstractSoilProfile(me, clay, silt, sand) resu
real :: d_grain !! The average grain size
end function
- function calculateClayEnrichmentAbstractSoilProfile(me, ssd, k_dist, a) result(ssdEnriched)
- use GlobalsModule, only: C, dp
- import AbstractSoilProfile
- class(AbstractSoilProfile) :: me !! This AbstractSoilProfile instance
- real(dp) :: ssd(C%nSizeClassesSpm) !! Original sediment size distribution
- real(dp) :: k_dist !! Enrichment scaling factor
- real(dp) :: a !! Enrichment skew factor
- real(dp) :: ssdEnriched(C%nSizeClassesSpm) !! Enriched sediment size distribution
- end function
-
!> Parses the input data for the `AbstractSoilProfile` from the data file
function parseInputDataAbstractSoilProfile(me) result(r)
use ResultModule, only: Result
@@ -212,48 +186,41 @@ subroutine parseNewBatchDataAbstractSoilProfile(me)
class(AbstractSoilProfile) :: me
end subroutine
- function get_m_np_AbstractSoilProfile(me) result(m_np)
- use GlobalsModule, only: C, dp
- import AbstractSoilProfile
- class(AbstractSoilProfile) :: me
- real(dp), allocatable :: m_np(:,:,:)
- end function
-
- function get_m_transformed_AbstractSoilProfile(me) result(m_transformed)
- use GlobalsModule, only: C, dp
- import AbstractSoilProfile
- class(AbstractSoilProfile) :: me
- real(dp), allocatable :: m_transformed(:,:,:)
- end function
-
- function get_m_dissolved_AbstractSoilProfile(me) result(m_dissolved)
- use GlobalsModule, only: dp
- import AbstractSoilProfile
- class(AbstractSoilProfile) :: me
- real(dp) :: m_dissolved
- end function
-
- function get_C_np_AbstractSoilProfile(me) result(C_np)
- use GlobalsModule, only: C, dp
- import AbstractSoilProfile
- class(AbstractSoilProfile) :: me
- real(dp), allocatable :: C_np(:,:,:)
- end function
-
- function get_C_transformed_AbstractSoilProfile(me) result(C_transformed)
- use GlobalsModule, only: C, dp
+ function get_m_contaminant_AbstractSoilProfile(me) result(m_contaminant)
+ use ContaminantModule
import AbstractSoilProfile
class(AbstractSoilProfile) :: me
- real(dp), allocatable :: C_transformed(:,:,:)
+ type(Contaminant) :: m_contaminant
end function
- function get_C_dissolved_AbstractSoilProfile(me) result(C_dissolved)
+ function get_C_contaminant_AbstractSoilProfile(me) result(C_contaminant)
use GlobalsModule, only: dp
import AbstractSoilProfile
class(AbstractSoilProfile) :: me
- real(dp) :: C_dissolved
+ real(dp), allocatable :: C_contaminant(:,:,:)
end function
-
end interface
-end module
+contains
+
+ subroutine finaliseSoilProfile(me)
+ class(AbstractSoilProfile) :: me
+ integer :: i
+ call me%m_contaminant%finalise()
+ call me%m_contaminant_in%finalise()
+ call me%m_contaminant_buried%finalise()
+ call me%m_contaminant_eroded%finalise()
+ if (allocated(me%colSoilLayers)) then
+ do i = 1, size(me%colSoilLayers)
+ if (allocated(me%colSoilLayers(i)%item)) then
+ call me%colSoilLayers(i)%item%finalise()
+ end if
+ end do
+ deallocate(me%colSoilLayers)
+ end if
+ if (allocated(me%q_precip_timeSeries)) deallocate(me%q_precip_timeSeries)
+ if (allocated(me%q_evap_timeSeries)) deallocate(me%q_evap_timeSeries)
+ if (allocated(me%erodedSediment)) deallocate(me%erodedSediment)
+ if (allocated(me%distributionSediment)) deallocate(me%distributionSediment)
+ end subroutine
+end module
\ No newline at end of file
diff --git a/src/Soil/SoilLayerModule.f90 b/src/Soil/SoilLayerModule.f90
index e9fda4a..78737d8 100644
--- a/src/Soil/SoilLayerModule.f90
+++ b/src/Soil/SoilLayerModule.f90
@@ -1,22 +1,24 @@
!> Module containing definition of `SoilLayer` class.
module SoilLayerModule
- use GlobalsModule
+ use GlobalsModule, only: dp, C, FREE_CONTAMINANT, ATTACHED_CONTAMINANT
use UtilModule
use AbstractSoilLayerModule
use DataInputModule, only: DATASET
use BiotaSoilModule
use datetime_module
+ use ContaminantModule, only: Contaminant
implicit none
!> `SoilLayer` is responsible for routing percolated water through
!! the `SoilProfile` in which it is contained.
- type, public, extends(AbstractSoilLayer) :: SoilLayer
+
+ type, public, extends(AbstractSoilLayer) :: SoilLayer
contains
procedure :: create => createSoilLayer
procedure :: update => updateSoilLayer
+ procedure :: update_contaminant_state => updateContaminantStateSoilLayer
procedure :: addPooledWater => addPooledWaterSoilLayer
procedure :: erode => erodeSoilLayer
- procedure :: attachment => attachmentSoilLayer
procedure :: calculateAttachmentRate => calculateAttachmentRateSoilLayer
procedure :: calculateBioturbationRate => calculateBioturbationRateSoilLayer
procedure :: parseInputData => parseInputDataSoilLayer
@@ -26,22 +28,24 @@ module SoilLayerModule
contains
!> Create this `SoilLayer` and call the input data parsing procedure
function createSoilLayer(me, x, y, p, l, WC_sat, WC_FC, K_s, area, bulkDensity, d_grain, porosity, earthwormDensity) result(r)
- class(SoilLayer) :: me !! This `SoilLayer` instance
- integer, intent(in) :: x !! Containing `GridCell` x index
- integer, intent(in) :: y !! Containing `GridCell` y index
- integer, intent(in) :: p !! Containing `SoilProfile` index
- integer, intent(in) :: l !! Layer index
- real(dp), intent(in) :: WC_sat !! Water content at saturation [m3/m3]
- real(dp), intent(in) :: WC_FC !! Water content at field capacity [m3/m3]
- real(dp), intent(in) :: K_s !! Saturated hydraulic conductivity [m/s]
- real(dp), intent(in) :: area !! Area of the containing SoilProfile [m2]
- real(dp), intent(in) :: bulkDensity !! Bulk density [kg/m3]
- real(dp), intent(in) :: d_grain !! Average grain diameter [m]
- real(dp), intent(in) :: porosity !! Porosity [-]
- real(dp), intent(in) :: earthwormDensity !! Earthworm density [individuals/m2]
- integer :: i ! Iterator
- type(Result) :: r
- !! The `Result` object to return, with any errors from parsing input data.
+ class(SoilLayer) :: me !! This `SoilLayer` instance
+ integer, intent(in) :: x !! Containing `GridCell` x index
+ integer, intent(in) :: y !! Containing `GridCell` y index
+ integer, intent(in) :: p !! Containing `SoilProfile` index
+ integer, intent(in) :: l !! Layer index
+ real(dp), intent(in) :: WC_sat !! Water content at saturation [m3/m3]
+ real(dp), intent(in) :: WC_FC !! Water content at field capacity [m3/m3]
+ real(dp), intent(in) :: K_s !! Saturated hydraulic conductivity [m/s]
+ real(dp), intent(in) :: area !! Area of the containing SoilProfile [m2]
+ real(dp), intent(in) :: bulkDensity !! Bulk density [kg/m3]
+ real(dp), intent(in) :: d_grain !! Average grain diameter [m]
+ real(dp), intent(in) :: porosity !! Porosity [-]
+ real(dp), intent(in) :: earthwormDensity !! Earthworm density [individuals/m2]
+ integer :: i ! Iterator
+ type(Result) :: r !! The `Result` object to return, with any errors from parsing input data.
+ integer :: allocStat ! Allocation status
+ real(dp) :: T_water_t ! Water temperature for initialization [deg C]
+ type(datetime) :: currentDate ! Current date for water temperature
! Set the metadata and area
me%x = x
@@ -57,39 +61,55 @@ function createSoilLayer(me, x, y, p, l, WC_sat, WC_FC, K_s, area, bulkDensity,
me%porosity = porosity
me%earthwormDensity = earthwormDensity
- ! Allocate and initialise variables
- allocate(me%m_np(C%npDim(1), C%npDim(2), C%npDim(3)))
- allocate(me%m_np_perc(C%npDim(1), C%npDim(2), C%npDim(3)))
- allocate(me%m_np_eroded(C%npDim(1), C%npDim(2), C%npDim(3)))
- allocate(me%C_np(C%npDim(1), C%npDim(2), C%npDim(3)))
- allocate(me%m_transformed(C%npDim(1), C%npDim(2), C%npDim(3)))
- allocate(me%m_transformed_perc(C%npDim(1), C%npDim(2), C%npDim(3)))
- allocate(me%m_transformed_eroded(C%npDim(1), C%npDim(2), C%npDim(3)))
- allocate(me%C_transformed(C%npDim(1), C%npDim(2), C%npDim(3)))
- allocate(me%k_att(C%npDim(1)))
- me%m_np = 0.0_dp ! Set initial NM mass to 0 [kg]
- me%m_np_perc = 0.0_dp ! Just to be on the safe side
- me%m_np_eroded = 0.0_dp
- me%m_transformed = 0.0_dp
- me%m_transformed_perc = 0.0_dp
- me%m_transformed_eroded = 0.0_dp
- me%m_dissolved = 0.0_dp
- me%C_np = 0.0_dp
- me%C_transformed = 0.0_dp
- me%C_dissolved = 0.0_dp
- me%V_w = 0.0_dp ! Set initial water content to 0 [m3/m2]
+ ! Get water temperature for initialization (use first day of simulation)
+ currentDate = C%startDate
+ T_water_t = DATASET%waterTemperature(currentDate%yearday())
+
+ ! Initialize Contaminant objects
+ ! FIX: Removed the invalid DATASET%nc argument and switched to keyword-based passing.
+ call r%addErrors(.errors. me%m_contaminant%create_from_data( &
+ compartment='soil', &
+ contaminantDensity=DATASET%contaminantDensity, &
+ soilAttachmentEfficiency=DATASET%soilConstantAttachmentEfficiency, &
+ riverAttachmentEfficiency=DATASET%riverAttachmentEfficiency, &
+ estuaryAttachmentEfficiency=DATASET%estuaryAttachmentEfficiency, &
+ k_diss_pristine=DATASET%contaminant_k_diss_pristine, &
+ k_diss_transformed=DATASET%contaminant_k_diss_transformed, &
+ k_transform_pristine=DATASET%contaminant_k_transform_pristine, &
+ waterTemperature=T_water_t &
+ ))
+
+ ! Initialize other Contaminant objects
+ call r%addErrors(.errors. me%j_contaminant_in%create())
+ call r%addErrors(.errors. me%j_contaminant_perc%create())
+ call r%addErrors(.errors. me%j_contaminant_eroded%create())
+
+ ! Set initial contaminant concentrations from DATASET
+ if (allocated(DATASET%initialContaminantConcsSoil)) then
+ me%m_contaminant%c = DATASET%initialContaminantConcsSoil(me%x, me%y, :, :, :)
+ if (allocated(DATASET%initialDissolvedConcsSoil)) then
+ me%m_contaminant%m_dissolved = DATASET%initialDissolvedConcsSoil(me%x, me%y)
+ end if
+ end if
+
+ ! Allocate and initialize k_att
+ allocate(me%k_att(C%contaminantDim(1)), stat=allocStat)
+ if (allocStat /= 0) then
+ call r%addError(ErrorInstance(code=901, message="Failed to allocate k_att"))
+ return
+ end if
+ me%k_att = 0.0_dp
+ me%V_w = 0.0_dp
! Parse the input data into the object properties
- r = me%parseInputData()
+ call r%addErrors(.errors. me%parseInputData())
! Set saturation and field capacity volumes [m3/m2] based on depth of layer
- me%V_sat = WC_sat*me%depth
- me%V_FC = WC_FC*me%depth
- me%K_s = K_s ! Hydraulic conductivity [m/s]
-
+ me%V_sat = WC_sat * me%depth
+ me%V_FC = WC_FC * me%depth
+ me%K_s = K_s ! Hydraulic conductivity [m/s]
! Allocate and create the Biota object
- ! TODO move all this to database
allocate(me%biotaIndices(0))
if (DATASET%hasBiota) then
do i = 1, DATASET%nBiota
@@ -99,7 +119,11 @@ function createSoilLayer(me, x, y, p, l, WC_sat, WC_FC, K_s, area, bulkDensity,
end if
end do
end if
- allocate(me%biota(me%nBiota))
+ allocate(me%biota(me%nBiota), stat=allocStat)
+ if (allocStat /= 0) then
+ call r%addError(ErrorInstance(code=901, message="Failed to allocate biota"))
+ return
+ end if
do i = 1, me%nBiota
call r%addErrors(.errors. me%biota(i)%create(me%biotaIndices(i)))
end do
@@ -111,87 +135,95 @@ function createSoilLayer(me, x, y, p, l, WC_sat, WC_FC, K_s, area, bulkDensity,
!> Update the `SoilLayer` on a given time step, based on specified inflow.
!! Calculate percolation to next layer and, if saturated, the amount
!! to pool to the above layer (or surface runoff, if this is the top layer)
- function updateSoilLayer(me, t, q_in, m_np_in, m_transformed_in, m_dissolved_in) result(r)
+ function updateSoilLayer(me, t, q_in, j_contaminant_in) result(r)
class(SoilLayer) :: me !! This `SoilLayer` instance
integer :: t !! The current time step [s]
real(dp) :: q_in !! Water into the layer on this time step, from percolation and pooling [m/timestep]
- real(dp) :: m_np_in(:,:,:) !! NM into the layer on this time step, from percolation and pooling [kg/timestep]
- real(dp) :: m_transformed_in(:,:,:) !! Transformed NM into the layer on this time step [kg/timestep]
- real(dp) :: m_dissolved_in !! Dissolved species into the layer on this time step [kg/timestep]
+ type(Contaminant), intent(in) :: j_contaminant_in
type(Result) :: r !! The Result object to return any errors in
real(dp) :: initial_V_w ! Initial V_w used for checking whether all water removed
- integer :: i, j, k ! Iterators
- type(datetime) :: currentDate ! Current date
- real :: T_water_t ! Water temperature on the current timestep [deg C]
+ integer :: i ! Iterators
+ type(datetime) :: currentDate ! Current date
+ real(dp) :: T_water_t ! Water temperature on the current timestep [deg C]
+
+ ! NEW: zero SPM arrays with correct model dimension
+ real(dp) :: C_spm_zero(C%nSizeClassesSpm)
+ real(dp) :: W_settle_zero(C%nSizeClassesSpm)
+
+ C_spm_zero = 0.0_dp
+ W_settle_zero = 0.0_dp
! Get the current date to use to get the water temperature
currentDate = C%startDate + timedelta(t-1)
T_water_t = DATASET%waterTemperature(currentDate%yearday())
- ! Set the inflow to this SoilLayer and store initial water in layer
+ ! Set the inflow to this this SoilLayer and store initial water in layer
me%q_in = q_in
initial_V_w = me%V_w
- ! Add in the NM from the above layer/source
- me%m_np = me%m_np + m_np_in ! [kg]
- me%m_transformed = me%m_transformed + m_transformed_in ! [kg]
- me%m_dissolved = me%m_dissolved + m_dissolved_in ! [kg]
-
- ! Attachment
- call me%attachment(T_water_t) ! Transfers free -> attached
+ call me%m_contaminant%add(j_contaminant_in)
! Setting volume of water, pooled water and excess water, based on inflow
- if (me%V_w + me%q_in < me%V_sat) then ! If water volume below V_sat after inflow
- me%V_pool = 0.0_dp ! No pooled water
- me%V_w = me%V_w + me%q_in ! Update the volume based on inflow
- me%V_excess = max(me%V_w - me%V_FC, 0.0_dp) ! Volume of water above V_FC
- else if (me%V_w + me%q_in > me%V_sat) then ! Else, water pooled above V_sat
- me%V_pool = me%V_w + me%q_in - me%V_sat ! Water pooled above V_sat
- me%V_w = me%V_sat ! Volume of water must be V_sat
- me%V_excess = me%V_w - me%V_FC ! Volume must be above FC and so there is excess
+ if (me%V_w + me%q_in < me%V_sat) then
+ me%V_pool = 0.0_dp
+ me%V_w = me%V_w + me%q_in
+ me%V_excess = max(me%V_w - me%V_FC, 0.0_dp)
+ else if (me%V_w + me%q_in > me%V_sat) then
+ me%V_pool = me%V_w + me%q_in - me%V_sat
+ me%V_w = me%V_sat
+ me%V_excess = me%V_w - me%V_FC
end if
+
! Calculate volume percolated on this timestep [m3 m-2]
- me%V_perc = min(me%V_excess * &
- (1-exp(-C%timeStep*me%K_s/(me%V_sat-me%V_FC))), & ! Up to a maximum of V_w
- me%V_w)
- ! Use this to calculate the amount of nanomaterial percolated as a fraction of that in layer,
- ! then remove this and the water. Check if (near) zero to avoid FPE.
- me%m_np_perc = 0.0_dp
- me%m_transformed_perc = 0.0_dp
- me%m_dissolved_perc = 0.0_dp
- if (.not. isZero(me%V_perc)) then
- ! Only free (porewater) particles will percolate, otherise m_np_perc is 0 (as set above)
- me%m_np_perc(:,1,1) = (me%V_perc/me%V_w)*me%m_np(:,1,1) ! V_perc/V_w will be 1 at maximum
- me%m_transformed_perc(:,1,1) = (me%V_perc/me%V_w)*me%m_transformed(:,1,1)
- me%m_dissolved_perc = (me%V_perc/me%V_w)*me%m_dissolved ! All dissolved percolates
+ me%V_perc = min(me%V_excess * (1 - exp(-C%timeStep * me%K_s / (me%V_sat - me%V_FC))), me%V_w)
+ call r%addErrors(.errors. me%j_contaminant_perc%create())
+ if (.not. isZero(me%V_perc) .and. me%V_w > C%epsilon) then
+ call me%j_contaminant_perc%multiply_scalar(me%m_contaminant, me%V_perc / me%V_w)
+ me%j_contaminant_perc%c(:,:,ATTACHED_CONTAMINANT+1:) = 0.0_dp
+ me%j_contaminant_perc%c(:,:,ATTACHED_CONTAMINANT) = 0.0_dp
end if
- me%m_np = me%m_np - me%m_np_perc ! Get rid of percolated NM
- me%m_transformed = me%m_transformed - me%m_transformed_perc ! Get rid of percolated transformed NM
- me%m_dissolved = me%m_dissolved - me%m_dissolved_perc ! Get rid of dissovled species
- me%V_w = me%V_w - me%V_perc ! Get rid of the percolated water
- me%C_np = divideCheckZero(me%m_np, me%depth * me%area * me%bulkDensity)
- me%C_transformed = divideCheckZero(me%m_transformed, (me%depth * me%area * me%bulkDensity))
- me%C_dissolved = divideCheckZero(me%m_dissolved, (me%depth * me%area * me%bulkDensity))
-
- ! Emit a warning if all water removed
+ call me%m_contaminant%add_scaled(me%j_contaminant_perc, -1.0_dp)
+ me%V_w = me%V_w - me%V_perc
+
+ me%k_att = me%calculateAttachmentRate(T_water_t)
+
+ ! *** FIXED CALL: pass full-length zero arrays, not [0.0_dp] ***
+ call r%addErrors(.errors. me%m_contaminant%update( &
+ real(C%timeStep, dp), T_water_t, C_spm_zero, W_settle_zero, 0.0_dp, me%volume, 'soil', me%k_att, me%alpha_att))
+
if (isZero(me%V_w) .and. initial_V_w > 0) then
call r%addError(ErrorInstance(600, isCritical=.false.))
end if
-
- ! Update the biota
do i = 1, me%nBiota
- call r%addErrors(.errors. me%biota(i)%update( &
- t, &
- me%C_np, &
- me%C_transformed, &
- me%C_dissolved &
- ))
+ call r%addErrors(.errors. me%biota(i)%update(t, me%m_contaminant))
end do
-
- ! Add this procedure to the error trace
call r%addToTrace("Updating " // trim(me%ref) // " on time step #" // trim(str(t)))
end function
+ !> Update the internal contaminant state (attachment, etc.) without handling water fluxes.
+ subroutine updateContaminantStateSoilLayer(me, T_water_t)
+ class(SoilLayer), intent(inout) :: me
+ real(dp), intent(in) :: T_water_t
+ type(Result) :: r
+ ! These are zero because we are only updating internal state, not adding fluxes
+ real(dp) :: C_spm_zero(C%nSizeClassesSpm)
+ real(dp) :: W_settle_zero(C%nSizeClassesSpm)
+ C_spm_zero = 0.0_dp
+ W_settle_zero = 0.0_dp
+
+ ! Calculate the attachment rate for this layer
+ me%k_att = me%calculateAttachmentRate(T_water_t)
+
+ ! Call the generic contaminant update routine to perform attachment etc.
+ call r%addErrors(.errors. me%m_contaminant%update( &
+ real(C%timeStep, dp), T_water_t, C_spm_zero, W_settle_zero, 0.0_dp, me%volume, 'soil', me%k_att, me%alpha_att))
+
+ if (r%hasCriticalError()) then
+ call r%addToTrace("Updating contaminant state in " // trim(me%ref))
+ call ERROR_HANDLER%trigger(errors=.errors.r)
+ end if
+ end subroutine updateContaminantStateSoilLayer
+
!> Add a volume \( V_{\text{pool}} \) of pooled water to the layer.
!! No percolation occurs as pooled water never really leaves the `SoilLayer`.
function addPooledWaterSoilLayer(me, V_pool) result(r)
@@ -203,116 +235,99 @@ function addPooledWaterSoilLayer(me, V_pool) result(r)
me%V_w = min(me%V_w + V_pool, me%V_sat) ! Add pooled water, up to a maximum of V_sat
end function
- !> TODO move this to a Reactor of some sort
- subroutine attachmentSoilLayer(me, T_water_t)
- class(SoilLayer) :: me
- real :: T_water_t
- integer :: i
- real(dp) :: dm_att
-
- if (C%includeAttachment) then
- do i = 1, C%nSizeClassesNM
- ! Has attachment rate been set by input data? If not, then calculate it from
- ! attachment efficiency. Attachment efficiency will be either spatial (if
- ! provided), or set by default value in constants file. If it is calculated here,
- ! it is temporal as it depends on water temperature
- if (me%k_att(1) == nf90_fill_real) then
- me%k_att = me%calculateAttachmentRate(T_water_t)
- end if
- ! Pristine NM
- dm_att = min(me%k_att(i)*C%timeStep*me%m_np(i,1,1), me%m_np(i,1,1)) ! Mass to move from free -> attached, max of the current mass
- me%m_np(i,1,1) = me%m_np(i,1,1) - dm_att ! Remove from free
- me%m_np(i,1,2) = me%m_np(i,1,2) + dm_att ! Add to attached (bound)
- ! Same for transformed NM
- dm_att = min(me%k_att(i)*C%timeStep*me%m_transformed(i,1,1), me%m_transformed(i,1,1))
- me%m_transformed(i,1,1) = me%m_transformed(i,1,1) - dm_att
- me%m_transformed(i,1,2) = me%m_transformed(i,1,2) + dm_att
- end do
- end if
- end subroutine
-
!> Erode NM from this soil layer
!! TODO bulk density could be stored in this object, not passed, probably same with area
function erodeSoilLayer(me, erodedSediment, bulkDensity, area) result(r)
- class(SoilLayer) :: me
- real(dp) :: erodedSediment(:) ! [kg/m2/day] TODO make sure changed to kg/m2/timestep
- real(dp) :: bulkDensity ! [kg/m3]
- real(dp) :: area ! [m2]
- type(Result) :: r
- real(dp) :: m_soil_l1
- real(dp) :: propEroded
- real(dp) :: erodedNP(C%nSizeClassesNM)
-
- m_soil_l1 = bulkDensity * area * me%depth ! Calculate the mass of the soil in this soil layer
- propEroded = sum(erodedSediment)*area/m_soil_l1 ! Proportion of this that is eroded, convert erodedSediment to kg/gridcell/day
- ! Pristine NM
- erodedNP = me%m_np(:,1,2)*propEroded ! Only erode attached NM
- me%m_np(:,1,2) = me%m_np(:,1,2) - erodedNP ! Remove the eroded NM from the layer
- me%m_np_eroded(:,1,2) = erodedNP
- ! Transformed NM
- erodedNP = me%m_transformed(:,1,2)*propEroded
- me%m_transformed(:,1,2) = me%m_transformed(:,1,2) - erodedNP
- me%m_transformed_eroded(:,1,2) = erodedNP
+ class(SoilLayer) :: me
+ real(dp) :: erodedSediment(:)
+ real(dp) :: bulkDensity
+ real(dp) :: area
+ type(Result) :: r
+ real(dp) :: m_soil_layer, propEroded
+
+ ! Calculate the mass of the soil in this layer
+ m_soil_layer = bulkDensity * area * me%depth
+ propEroded = sum(erodedSediment) * area / m_soil_layer
+
+ ! Initialize the eroded contaminant object
+ call r%addErrors(.errors. me%j_contaminant_eroded%create())
+
+ ! Calculate eroded contaminant (only attached contaminant is eroded)
+ me%j_contaminant_eroded%c(:,:,ATTACHED_CONTAMINANT) = &
+ me%m_contaminant%c(:,:,ATTACHED_CONTAMINANT) * propEroded
+
+ ! Remove the eroded contaminant from the layer
+ call me%m_contaminant%add_scaled(me%j_contaminant_eroded, -1.0_dp)
+
+ ! Add this procedure to the error trace
+ call r%addToTrace("Eroding " // trim(me%ref))
+ end function
+
+ function calculateAttachmentRateSoilLayer(me, T_water_t) result(k_att)
+ class(SoilLayer) :: me
+ real(dp) :: T_water_t
+ real(dp) :: k_att(C%contaminantDim(1))
+ k_att = me%m_contaminant%calculateAttachmentRate(T_water_t, me%porosity, me%d_grain)
end function
function calculateBioturbationRateSoilLayer(me) result(bioturbationRate)
class(SoilLayer) :: me
real(dp) :: bioturbationRate
- real(dp) :: earthwormDensity_perVolume ! [individuals/m3]
- real(dp) :: bioturb_alpha = 3.56e-9 ! Bioturbation fitting parameter [m4/s]
- ! Convert from worms/layer to worms/m3 for the bioturbation model
+ real(dp) :: earthwormDensity_perVolume
+ real(dp) :: bioturb_alpha = 3.56e-9
earthwormDensity_perVolume = me%earthwormDensity * me%depth
- ! Calculate the bioturbation rate based on this worm density
bioturbationRate = (earthwormDensity_perVolume * bioturb_alpha) / me%depth
end function
- !> Calculate the attachment rate from the attachment efficiency and soil properties, using
- !! coloid filtration theory. References:
- !! - Meesters et al. 2014 (SI): https://doi.org/10.1021/es500548h
- !! - Tufenkji et al. 2004: https://doi.org/10.1021/es034049r
- function calculateAttachmentRateSoilLayer(me, T_water_t) result(k_att)
- class(SoilLayer) :: me
- real :: T_water_t
- real :: k_att(C%nSizeClassesNM)
- integer :: i
- real(dp) :: gamma, r_i, kBT, N_G, N_VDW, N_Pe, N_R, A_s, eta_grav, eta_intercept, &
- eta_0, lambda_filter, D_i, eta_Brownian
-
- gamma = (1 - me%porosity) ** 0.333
- kBT = C%k_B * (T_water_t + 273.15)
- N_VDW = DATASET%soilHamakerConstant / kBT ! Van der Waals number
- A_s = 2 * (1 - gamma**5) / (2 - 3 * gamma + 3 * gamma**5 - 2 * gamma**6) ! Porosity dependent param
- ! Loop through NM size classes for the parameters that are dependent on NM size
- do i = 1, C%nSizeClassesNM
- r_i = C%d_nm(i) * 0.5 ! NM radius
- D_i = kBT / (6 * C%pi * C%mu_w(T_water_t) * r_i) ! Diffusivity of NM particle
- N_Pe = DATASET%soilDarcyVelocity * me%d_grain / D_i ! Peclet number
- N_G = 2 * r_i**2 * (DATASET%soilParticleDensity - C%rho_w(T_water_t)) * C%g &
- / (9 * C%mu_w(T_water_t) * DATASET%soilDarcyVelocity) ! Gravity number
- N_R = r_i / (me%d_grain * 0.5) ! Aspect ratio number
- eta_grav = 2.22 * N_R**(-0.024) * N_G**1.11 * N_VDW**0.053 ! Gravitational collection efficiency
- eta_intercept = 0.55 * N_R**1.55 * N_Pe**(-0.125) * N_VDW**0.125 ! Interception collection efficiency
- eta_Brownian = 2.4 * A_s**0.33 * N_R**(-0.081) * N_Pe**(-0.715) * N_VDW**0.053 ! Brownian motion collection efficiency
- eta_0 = eta_grav + eta_intercept + eta_Brownian ! Total collection efficiency
- lambda_filter = 1.5 * (1 - me%porosity) / (me%d_grain * me%porosity) ! Filtration
- k_att(i) = me%alpha_att * lambda_filter * eta_0 * DATASET%soilDarcyVelocity ! Attachment rate [/s]
- end do
- end function
-
!> Get the data from the input file and set object properties
!! accordingly, including allocation of arrays that depend on
!! input data
function parseInputDataSoilLayer(me) result(r)
- class(SoilLayer) :: me !! This SoilLayer instance
- type(Result) :: r !! The Result object to return any errors relating to the input data file
- me%k_att(:) = DATASET%soilAttachmentRate(me%x, me%y)
- me%alpha_att = DATASET%soilAttachmentEfficiency(me%x, me%y)
+ class(SoilLayer) :: me
+ type(Result) :: r
+ logical :: have2D
+ integer :: nx, ny
+
+ have2D = .false.
+ if (allocated(DATASET%soilAttachmentEfficiency)) then
+ if (size(DATASET%soilAttachmentEfficiency,1) > 0 .and. &
+ size(DATASET%soilAttachmentEfficiency,2) > 0) then
+ nx = size(DATASET%soilAttachmentEfficiency,1)
+ ny = size(DATASET%soilAttachmentEfficiency,2)
+ if (me%x>=1 .and. me%y>=1 .and. me%x<=nx .and. me%y<=ny) have2D = .true.
+ end if
+ end if
+
+ if (have2D) then
+ me%alpha_att = DATASET%soilAttachmentEfficiency(me%x, me%y)
+ else
+ ! Fallback to configured constant if the 2-D field is absent/empty/out of bounds
+ me%alpha_att = DATASET%soilConstantAttachmentEfficiency
+ end if
+
+ call r%addToTrace("Parsing input data (soil layer)")
end function
subroutine parseNewBatchDataSoilLayer(me)
class(SoilLayer) :: me
- me%k_att(:) = DATASET%soilAttachmentRate(me%x, me%y)
- me%alpha_att = DATASET%soilAttachmentEfficiency(me%x, me%y)
+ logical :: have2D
+ integer :: nx, ny
+
+ have2D = .false.
+ if (allocated(DATASET%soilAttachmentEfficiency)) then
+ if (size(DATASET%soilAttachmentEfficiency,1) > 0 .and. &
+ size(DATASET%soilAttachmentEfficiency,2) > 0) then
+ nx = size(DATASET%soilAttachmentEfficiency,1)
+ ny = size(DATASET%soilAttachmentEfficiency,2)
+ if (me%x>=1 .and. me%y>=1 .and. me%x<=nx .and. me%y<=ny) have2D = .true.
+ end if
+ end if
+
+ if (have2D) then
+ me%alpha_att = DATASET%soilAttachmentEfficiency(me%x, me%y)
+ else
+ me%alpha_att = DATASET%soilConstantAttachmentEfficiency
+ end if
end subroutine
end module
\ No newline at end of file
diff --git a/src/Soil/SoilProfileModule.f90 b/src/Soil/SoilProfileModule.f90
index 8e4469c..7fb075e 100644
--- a/src/Soil/SoilProfileModule.f90
+++ b/src/Soil/SoilProfileModule.f90
@@ -9,6 +9,7 @@ module SoilProfileModule
use AbstractSoilProfileModule
use SoilLayerModule
use DataInputModule, only: DATASET
+ use ContaminantModule
implicit none
!> A SoilProfile class acts as a container for a collection of SoilLayer objects,
@@ -26,74 +27,81 @@ module SoilProfileModule
procedure :: parseInputData => parseInputDataSoilProfile
procedure :: parseNewBatchData => parseNewBatchDataSoilProfile
! Getters
- procedure :: get_m_np => get_m_np_SoilProfile
- procedure :: get_m_transformed => get_m_transformed_SoilProfile
- procedure :: get_m_dissolved => get_m_dissolved_SoilProfile
- procedure :: get_C_np => get_C_np_SoilProfile
- procedure :: get_C_transformed => get_C_transformed_SoilProfile
- procedure :: get_C_dissolved => get_C_dissolved_SoilProfile
+ procedure :: get_m_contaminant => get_m_contaminant_SoilProfile
+ procedure :: get_C_contaminant => get_C_contaminant_SoilProfile
end type
- contains
+contains
+
!> Creating the SoilProfile parses input data and fills the corresponding object properties,
!! as well as setting up the contained SoilLayers
function createSoilProfile(me, x, y, p, n_river, area, q_precip_timeSeries, &
- q_evap_timeSeries) result(r)
+ q_evap_timeSeries) result(r)
class(SoilProfile) :: me !! The `SoilProfile` instance.
integer :: x !! Containing `GridCell` x index
integer :: y !! Containing `GridCell` y index
- integer :: p !! `SoilProfile` reference (redundant for now as only one `SoilProfile` per `GridCell`)
+ integer :: p !! `SoilProfile` reference
real(dp) :: n_river !! Manning's roughness coefficient for the `GridCell`'s rivers [-]
- real(dp) :: area !! The surface area of the `SoilProfile` [m3]
+ real(dp) :: area !! The surface area of the `SoilProfile` [m2]
real, allocatable :: q_precip_timeSeries(:) !! Precipitation time series [m/timestep]
real, allocatable :: q_evap_timeSeries(:) !! Evaporation time series [m/timestep]
type(Result) :: r !! The `Result` object
integer :: l ! Soil layer iterator
type(SoilLayer), allocatable :: sl ! Temporary SoilLayer variable
+ real :: T_water_t ! Water temperature for initialization [deg C]
+ type(datetime) :: currentDate ! Current date for water temperature
+ integer :: allocStat ! Allocation status
! Generate the reference name for this SoilProfile
me%ref = ref("SoilProfile", x, y, p)
! Allocate the object properties that need to be
allocate(me%erodedSediment(C%nSizeClassesSpm), &
- me%distributionSediment(C%nSizeClassesSpm), &
- me%m_np(C%npDim(1), C%npDim(2), C%npDim(3)), &
- me%m_np_buried(C%npDim(1), C%npDim(2), C%npDim(3)), &
- me%m_np_eroded(C%npDim(1), C%npDim(2), C%npDim(3)), &
- me%m_np_in(C%npDim(1), C%npDim(2), C%npDim(3)), &
- me%m_transformed(C%npDim(1), C%npDim(2), C%npDim(3)), &
- me%m_transformed_buried(C%npDim(1), C%npDim(2), C%npDim(3)), &
- me%m_transformed_eroded(C%npDim(1), C%npDim(2), C%npDim(3)), &
- me%m_transformed_in(C%npDim(1), C%npDim(2), C%npDim(3)), &
- me%colSoilLayers(C%nSoilLayers))
+ me%distributionSediment(C%nSizeClassesSpm), &
+ me%colSoilLayers(C%nSoilLayers), &
+ stat=allocStat)
+ if (allocStat /= 0) then
+ call r%addError(ErrorInstance(code=901, message="Failed to allocate arrays"))
+ return
+ end if
! Initialise variables
- me%x = x ! GridCell x index
- me%y = y ! GridCell y index
- me%p = p ! SoilProfile index within the GridCell
+ me%x = x
+ me%y = y
+ me%p = p
me%n_river = n_river
- me%area = area ! Surface area
- allocate(me%q_precip_timeSeries, source=q_precip_timeSeries) ! [m/timestep]
- allocate(me%q_evap_timeSeries, source=q_evap_timeSeries) ! [m/timestep]
- me%V_buried = 0.0_dp ! Volume of water "lost" from the bottom of SoilProfile
- me%m_np_buried = 0.0_dp ! Mass of NM "lost" from the bottom of the SoilProfile
- me%m_np = 0.0_dp ! Nanomaterial mass
- me%m_np_eroded = 0.0_dp
- me%m_np_in = 0.0_dp
- me%m_transformed = 0.0_dp
- me%m_transformed_eroded = 0.0_dp
- me%m_transformed_in = 0.0_dp
- me%m_transformed_buried = 0.0_dp
- me%m_dissolved = 0.0_dp
- me%m_dissolved_in = 0.0_dp
- me%m_dissolved_buried = 0.0_dp
-
+ me%area = area
+ allocate(me%q_precip_timeSeries, source=q_precip_timeSeries)
+ allocate(me%q_evap_timeSeries, source=q_evap_timeSeries)
+ me%V_buried = 0.0_dp
+
+ ! Initialize Contaminant objects
+ r = me%m_contaminant%create()
+ if (r%hasCriticalError()) then
+ call ERROR_HANDLER%trigger(errors=.errors.r)
+ return
+ end if
+ r = me%m_contaminant_in%create()
+ if (r%hasCriticalError()) then
+ call ERROR_HANDLER%trigger(errors=.errors.r)
+ return
+ end if
+ r = me%m_contaminant_buried%create()
+ if (r%hasCriticalError()) then
+ call ERROR_HANDLER%trigger(errors=.errors.r)
+ return
+ end if
+ r = me%m_contaminant_eroded%create()
+ if (r%hasCriticalError()) then
+ call ERROR_HANDLER%trigger(errors=.errors.r)
+ return
+ end if
+
! Parse and store input data in this object's properties
call r%addErrors(.errors. me%parseInputData())
- if (r%hasCriticalError()) return ! Return early if there are critical errors
+ if (r%hasCriticalError()) return
! Set up the SoilLayers
do l = 1, C%nSoilLayers
- allocate(sl) ! Must be allocated on every time step
- ! Create the SoilLayer and add any errors to Result object
+ allocate(sl)
call r%addErrors(.errors. &
sl%create( &
me%x, &
@@ -107,9 +115,8 @@ function createSoilProfile(me, x, y, p, n_river, area, q_precip_timeSeries, &
me%bulkDensity, &
me%d_grain, &
me%porosity, &
- me%earthwormDensity * DATASET%earthwormVerticalDistribution(l) & ! Split earthworm density into vertical distribution
- ) &
- )
+ me%earthwormDensity * DATASET%earthwormVerticalDistribution(l) &
+ ))
call move_alloc(sl, me%colSoilLayers(l)%item)
end do
call r%addToTrace("Creating " // trim(me%ref))
@@ -117,93 +124,76 @@ function createSoilProfile(me, x, y, p, n_river, area, q_precip_timeSeries, &
!> Perform the simulation of the SoilProfile for the current time step, including
!! percolation of soil through soil layers and soil erosion
- function updateSoilProfile(me, t, j_np_diffuseSource, j_transformed_diffuseSource, j_dissolved_diffuseSource) result(r)
- class(SoilProfile) :: me !! This `SoilProfile` instance
- integer :: t !! The current timestep
- real(dp) :: j_np_diffuseSource(:,:,:) !! Diffuse source of NM for this timestep [kg/m2/timestep]
- real(dp) :: j_transformed_diffuseSource(:,:,:) !! Diffuse source of NM for this timestep [kg/m2/timestep]
- real(dp) :: j_dissolved_diffuseSource !! Diffuse source of NM for this timestep [kg/m2/timestep]
- type(Result) :: r !! Result object to return
+ function updateSoilProfile(me, t, j_contaminant_diffuseSource) result(r)
+ class(SoilProfile), intent(inout) :: me
+ integer, intent(in) :: t
+ type(Contaminant), intent(in) :: j_contaminant_diffuseSource
+ type(Result) :: r
+ integer :: l
+ type(datetime) :: currentDate
+ real(dp) :: T_water_t
! Reset for this timestep
me%V_pool = 0.0_dp
if (.not. me%isUrban) then
- ! Set the timestep-specific object properties
- me%q_precip = me%q_precip_timeSeries(t) ! Get the relevant time step's precipitation [m/timestep]
- me%q_evap = me%q_evap_timeSeries(t) ! and evaporation [m/timestep]
- me%q_in = max(me%q_precip - me%q_evap, 0.0_dp) ! Infiltration = precip - evap. This is supplied to SoilLayer_1 [m/timestep]. Minimum = 0.
- ! TODO: Should the minimum q_in be 0, or should evaporation be allowed to remove water from top soil layer?
-
- ! Add NM from the diffuse source
- me%m_np = me%m_np + j_np_diffuseSource * me%area ! j_np_diffuseSource is in kg/m2/timestep
- me%m_np_in = j_np_diffuseSource * me%area
- me%m_transformed_in = j_transformed_diffuseSource * me%area
- me%m_transformed = me%m_transformed + me%m_transformed_in
- me%m_dissolved_in = j_dissolved_diffuseSource * me%area
- me%m_dissolved = me%m_dissolved + me%m_dissolved_in
-
- ! Perform percolation, erosion and bioturbation simluations
- call r%addErrors([ &
- .errors. me%erode(t), &
- .errors. me%percolate(t, j_np_diffuseSource, j_transformed_diffuseSource, j_dissolved_diffuseSource), &
- .errors. me%bioturbation() &
- ])
-
- ! Remove buried NM (eroded NM removed in me%erode)
- ! TODO unify where me%m_np is updated (or deprecate, see me%erode())
- me%m_np = me%m_np - me%m_np_buried
+ ! Set timestep-specific properties
+ me%q_precip = me%q_precip_timeSeries(t)
+ me%q_evap = me%q_evap_timeSeries(t)
+ me%q_in = max(me%q_precip - me%q_evap, 0.0_dp)
+
+ ! --- NEW ORDER OF OPERATIONS ---
+ ! 1. Perform in-soil transformations (e.g., attachment) BEFORE erosion
+ currentDate = C%startDate + timedelta(t-1)
+ T_water_t = DATASET%waterTemperature(currentDate%yearday())
+ do l = 1, C%nSoilLayers
+ call me%colSoilLayers(l)%item%update_contaminant_state(T_water_t)
+ end do
+ ! 2. Now perform erosion, percolation (with diffuse source), and bioturbation
+ call r%addErrors([.errors. me%erode(t), &
+ .errors. me%percolate(t, j_contaminant_diffuseSource), &
+ .errors. me%bioturbation()])
+
+ ! 3. Update total mass in profile by removing buried mass
+ call me%m_contaminant%add_scaled(me%m_contaminant_buried, -1.0_dp)
else
- ! If this is an urban cell, presume no erosion
- me%erodedSediment = 0
+ me%erodedSediment = 0.0_dp
end if
- ! Add this procedure to the Result object's trace
call r%addToTrace("Updating " // trim(me%ref) // " on timestep #" // trim(str(t)))
- end function
+ end function updateSoilProfile
!> Percolate water through the `SoilProfile`, by looping through `SoilLayer`s
!! and running their individual percolation procedures, and then passing
!! percolated and pooled flows between `SoilLayer`s. Pooled water from top
!! `SoilLayer` forms surface runoff, and "lost" water from bottom `SoilLayer`
!! is kept track of in `me%V_buried`
- function percolateSoilProfile(me, t, j_np_diffuseSource, j_transformed_diffuseSource, j_dissolved_diffuseSource) result(r)
- class(SoilProfile) :: me !! This `SoilProfile` instance
- integer :: t !! The current time step
- real(dp) :: j_np_diffuseSource(:,:,:) !! Difffuse source of NM for this timestep [kg/m2/timestep]
- real(dp) :: j_transformed_diffuseSource(:,:,:)
- real(dp) :: j_dissolved_diffuseSource
- type(Result) :: r !! The `Result` object to return
- integer :: l, i ! Loop iterator for SoilLayers
- real(dp) :: q_l_in ! Temporary water inflow for a particular SoilLayer
- real(dp) :: m_np_l_in(C%npDim(1), & ! Temporary NM inflow for particular SoilLayer
- C%npDim(2), &
- C%npDim(3))
- real(dp) :: m_transformed_l_in(C%npDim(1), C%npDim(2), C%npDim(3))
- real(dp) :: m_dissolved_l_in
+ function percolateSoilProfile(me, t, j_contaminant_diffuseSource) result(r)
+ class(SoilProfile) :: me !! This `SoilProfile` instance
+ integer :: t !! The current time step
+ type(Contaminant), intent(in) :: j_contaminant_diffuseSource
+ type(Result) :: r !! The `Result` object to return
+ integer :: l, i ! Loop iterator for SoilLayers
+ real(dp) :: q_l_in ! Temporary water inflow for a particular SoilLayer
+ type(Contaminant) :: j_contaminant_l_in
! Loop through SoilLayers and percolate
do l = 1, C%nSoilLayers
if (l == 1) then
- ! If it's the first SoilLayer, water and NM inflow will be from precip - ET
+ ! If it's the first SoilLayer, water and contaminant inflow will be from precip - ET
! and the diffuse source, respectively
q_l_in = me%q_in ! [m3/m2/timestep]
- m_np_l_in = j_np_diffuseSource * me%area ! [kg/timestep]
- m_transformed_l_in = j_transformed_diffuseSource * me%area
- m_dissolved_l_in = j_dissolved_diffuseSource * me%area
+ call j_contaminant_l_in%multiply_scalar(j_contaminant_diffuseSource, me%area)
else
! Otherwise, they'll be from the layer above
- q_l_in = me%colSoilLayers(l-1)%item%V_perc ! [m3/m2/timestep]
- m_np_l_in = me%colSoilLayers(l-1)%item%m_np_perc ! [kg/timestep]
- m_transformed_l_in = me%colSoilLayers(l-1)%item%m_transformed_perc ! [kg/timestep]
- m_dissolved_l_in = me%colSoilLayers(l-1)%item%m_dissolved_perc ! [kg/timestep]
+ q_l_in = me%colSoilLayers(l-1)%item%V_perc
+ j_contaminant_l_in = me%colSoilLayers(l-1)%item%j_contaminant_perc
end if
- ! Run the percolation simulation for individual layer, setting V_perc, V_pool, m_np_perc etc.
- call r%addErrors(.errors. &
- me%colSoilLayers(l)%item%update(t, q_l_in, m_np_l_in, m_transformed_l_in, m_dissolved_l_in) &
- )
+ ! Run the percolation simulation for individual layer, setting V_perc, V_pool, m_contaminant_perc etc.
+ call r%addErrors(.errors. me%colSoilLayers(l)%item%update(t, q_l_in, j_contaminant_l_in))
+
! If there is pooled water, we must push up to the previous layer, recursively
! for each SoilLayer above this
do i = 1, l
@@ -222,11 +212,9 @@ function percolateSoilProfile(me, t, j_np_diffuseSource, j_transformed_diffuseSo
end do
end do
- ! Keep track of "lost" NM and water from the bottom soil layer. Not cumulative.
- me%V_buried = me%colSoilLayers(C%nSoilLayers)%item%V_perc
- me%m_np_buried = me%colSoilLayers(C%nSoilLayers)%item%m_np_perc
- me%m_transformed_buried = me%colSoilLayers(C%nSoilLayers)%item%m_transformed_perc
- me%m_dissolved_buried = me%colSoilLayers(C%nSoilLayers)%item%m_dissolved_perc
+ ! Keep track of "lost" Contaminant and water from the bottom soil layer. Not cumulative.
+ me%V_buried = me%colSoilLayers(C%nSoilLayers)%item%V_perc
+ me%m_contaminant_buried = me%colSoilLayers(C%nSoilLayers)%item%j_contaminant_perc
! Add this procedure to the Result object's trace
call r%addToTrace("Percolating water on time step #" // trim(str(t)))
@@ -249,75 +237,85 @@ function erodeSoilProfile(me, t) result(rslt)
real(dp) :: erodedSedimentTotal
type(datetime) :: currentDate
integer :: julianDay
- integer :: i
+ integer :: n, f
+ type(Result) :: r
! Only calculate erosion yield if we're meant to be
if (C%includeSoilErosion) then
! TODO This function only works with daily timesteps
- ! Convert the current date to Julian day number (https://en.wikipedia.org/wiki/Julian_day).
- ! date2num converts to number of days since 0001-01-01, and 1721423 is the Julian day
- ! number of 0001-01-01.
+ ! Convert the current date to Julian day number
currentDate = C%startDate + timedelta(days=t-1)
julianDay = currentDate%yearday()
- ! Then calculate the kinetic energy [J/m2/day]. Precip needs converting to [mm/day] from [m/timestep].
+ ! Calculate the kinetic energy [J/m2/day]. Precip needs converting to [mm/day] from [m/timestep].
E_k = (me%erosivity_a1 + me%erosivity_a2 * cos(julianDay * (2*C%pi/365) + me%erosivity_a3)) &
* (me%q_precip_timeSeries(t)*1.0e3)**me%erosivity_b
- ! Now the modified MMF version of K, dependent on sand, silt and clay content [g/J]
+ ! Modified MMF version of K, dependent on sand, silt and clay content [g/J]
K_MMF = 0.1*(me%clayContent/100.0_dp) + 0.3*(me%sandContent/100.0_dp) + 0.5*(me%siltContent/100.0_dp)
! Total eroded sediment [g/m2/day]
erodedSedimentTotal = E_k * K_MMF * me%usle_C * me%usle_P * me%usle_LS
! Split this into a size distribution and convert to [kg/m2/day]
me%erodedSediment = me%imposeSizeDistribution(erodedSedimentTotal*1.0e-3)
+ ! Call SoilLayer%erode with correct arguments
+ call rslt%addErrors(.errors. me%colSoilLayers(1)%item%erode( &
+ me%erodedSediment, me%bulkDensity, me%area))
+ ! Transition attached to heteroaggregated states
+ do n = 1, C%contaminantDim(1)
+ do f = 1, C%contaminantDim(2)
+ me%m_contaminant_eroded%c(n,f,SPM_CONTAMINANT_START:) = &
+ me%imposeSizeDistribution(me%m_contaminant_eroded%c(n,f,ATTACHED_CONTAMINANT))
+ me%m_contaminant_eroded%c(n,f,ATTACHED_CONTAMINANT) = 0.0_dp
+ end do
+ end do
+ call me%m_contaminant%add_scaled(me%m_contaminant_eroded, -1.0_dp)
else
- ! If we're not meant to be modelling erosion, then set yield to zero
+ ! If not modelling erosion, set yield to zero
me%erodedSediment = 0.0_dp
+ r = me%m_contaminant_eroded%create()
+ if (r%hasCriticalError()) then
+ call ERROR_HANDLER%trigger(errors=.errors.r)
+ call rslt%addErrors(.errors.r)
+ return
+ end if
+ me%m_contaminant_eroded%c = 0.0_dp
+ me%m_contaminant_eroded%m_dissolved = 0.0_dp
end if
-
- ! The top soil layer deals with eroding NM
- call rslt%addErrors(.errors. me%colSoilLayers(1)%item%erode(me%erodedSediment, me%bulkDensity, me%area))
- ! Remove this eroded soil from the total m_np in the profile
- do i = 1, C%nSizeClassesNM
- ! Transfer NM eroded from attached to heteroaggregated, by imposing the size distribution
- ! as for eroded SPM. The logic here is that the soil the NM is attached to will end up
- ! as SPM and thus the NM attached it will be heteroaggregated rather than attached/bound.
- me%m_np_eroded(i,1,3:) = me%imposeSizeDistribution(me%colSoilLayers(1)%item%m_np_eroded(i,1,2)) ! [kg/gridcell/timestep]
- me%m_transformed_eroded(i,1,3:) = me%imposeSizeDistribution(me%colSoilLayers(1)%item%m_transformed_eroded(i,1,2))
- end do
- ! TODO why is attached being set? m_np_eroded has double the mass it should now
- me%m_np_eroded(:,1,2) = me%colSoilLayers(1)%item%m_np_eroded(:,1,2)
- me%m_transformed_eroded(:,1,2) = me%colSoilLayers(1)%item%m_transformed_eroded(:,1,2)
- me%m_np(:,1,2) = me%m_np(:,1,2) - me%m_np_eroded(:,1,2) ! Remove the eroded NM from the soil
- me%m_transformed(:,1,2) = me%m_transformed(:,1,2) - me%m_transformed_eroded(:,1,2)
-
+ call rslt%addToTrace("Eroding soil on time step #" // trim(str(t)))
end function
!> Perform bioturbation on a time step by mixing calculated depth of two layers together
function bioturbationSoilProfile(me) result(rslt)
class(SoilProfile) :: me !! This `SoilProfile` instance
type(Result) :: rslt !! The `Result` object to return
- integer :: i ! Iterator
- real :: fractionOfLayerToMix
+ integer :: i, j, k ! Iterator
+ real(dp) :: fractionOfLayerToMix
+ type(Contaminant) :: temp ! Temporary Contaminant object
+ type(Result) :: r ! Result object for error handling
! Only model bioturbation if config file has asked us to
if (C%includeBioturbation) then
+ ! Initialize temp Contaminant object
+ r = temp%create()
+ if (r%hasCriticalError()) then
+ call ERROR_HANDLER%trigger(errors=.errors.r)
+ call rslt%addErrors(.errors.r)
+ return
+ end if
! Perform bioturbation for each layer, except final layer
- ! TODO set some proper boundary conditions
do i = 1, C%nSoilLayers - 1
fractionOfLayerToMix = me%colSoilLayers(i)%item%calculateBioturbationRate() * C%timeStep
- ! Only attached NM are mixed
- me%colSoilLayers(i)%item%m_np(:,1,2) = me%colSoilLayers(i)%item%m_np(:,1,2) &
- + fractionOfLayerToMix * (me%colSoilLayers(i+1)%item%m_np(:,1,2) - me%colSoilLayers(i)%item%m_np(:,1,2))
- me%colSoilLayers(i+1)%item%m_np(:,1,2) = me%colSoilLayers(i+1)%item%m_np(:,1,2) &
- + fractionOfLayerToMix * (me%colSoilLayers(i)%item%m_np(:,1,2) - me%colSoilLayers(i+1)%item%m_np(:,1,2))
- ! Same for transformed NM
- me%colSoilLayers(i)%item%m_transformed(:,1,2) &
- = me%colSoilLayers(i)%item%m_transformed(:,1,2) + fractionOfLayerToMix &
- * (me%colSoilLayers(i+1)%item%m_transformed(:,1,2) - me%colSoilLayers(i)%item%m_transformed(:,1,2))
- me%colSoilLayers(i+1)%item%m_transformed(:,1,2) &
- = me%colSoilLayers(i+1)%item%m_transformed(:,1,2) + fractionOfLayerToMix &
- * (me%colSoilLayers(i)%item%m_transformed(:,1,2) - me%colSoilLayers(i+1)%item%m_transformed(:,1,2))
+ ! Direct state mixing (no separate method needed)
+ associate (upper => me%colSoilLayers(i)%item%m_contaminant, &
+ lower => me%colSoilLayers(i+1)%item%m_contaminant)
+ temp = upper * fractionOfLayerToMix
+ call upper%add(-temp)
+ call lower%add(temp)
+ temp = lower * fractionOfLayerToMix
+ call lower%add(-temp)
+ call upper%add(temp)
+ end associate
end do
end if
+ call rslt%addToTrace("Performing bioturbation on " // trim(me%ref))
end function
!> Impose a size class distribution on a total mass to split it up into separate size classes.
@@ -342,7 +340,7 @@ function calculateSizeDistributionSoilProfile(me, clay, silt, sand, enrichClay)
real :: dClay ! Change in clay content
real :: textureEnriched(3) ! Texture distribution, clay enriched
real :: texture_bins(3,2) ! Array to store texture size class bounds in
- real :: ssd_bins(C%nSizeClassesSpm,2) ! Array to store sediment size class bounds in
+ real(dp):: ssd_bins(C%nSizeClassesSpm,2) ! Array to store sediment size class bounds in
real :: frac_ssd_in_texture_bin(3,C%nSizeClassesSpm) ! Fraction of SSD bin in texture bin
integer :: i, j ! Iterators
logical :: not_in_ssd_bin ! Is this texture bin within this SSD bin?
@@ -411,267 +409,277 @@ function calculateAverageGrainSizeSoilProfile(me, clay, silt, sand) result(d_gra
!! accordingly, including the allocation of arrays that depend on
!! this input data
function parseInputDataSoilProfile(me) result(r)
- class(SoilProfile) :: me !! This `SoilProfile` instance
- type(Result) :: r !! `Result` object to return
- integer :: landUse ! Index of max land use fraction in this profile
-
- me%distributionSediment = DATASET%defaultSpmSizeDistribution ! TODO we can probably get rid of this, but check
- me%bulkDensity = DATASET%soilBulkDensity(me%x, me%y)
- me%WC_sat = DATASET%soilWaterContentSaturation(me%x, me%y)
- me%WC_FC = DATASET%soilWaterContentFieldCapacity(me%x, me%y)
- me%K_s = DATASET%soilHydraulicConductivity(me%x, me%y)
- ! Soil hydraulic properties contain no data where in urban areas. For the moment,
- ! until land cover properly incorporated into model, we'll use this as a proxy
- ! for urban areas (which therefore contain no soil profile). In the future, we should
- ! account for this properly by splitting grid cells into different soil profiles.
- if (me%WC_sat == nf90_fill_real) me%WC_sat = 0.8
- if (me%WC_FC == nf90_fill_real) me%WC_FC = 0.5
- if (me%K_s == nf90_fill_real) me%K_s = 1e-6
- if (me%bulkDensity == nf90_fill_real) me%bulkDensity = 1220
-
- me%clayContent = DATASET%soilTextureClayContent(me%x, me%y)
- me%sandContent = DATASET%soilTextureSandContent(me%x, me%y)
- me%siltContent = DATASET%soilTextureSiltContent(me%x, me%y)
- me%coarseFragContent = DATASET%soilTextureCoarseFragContent(me%x, me%y)
- ! Check if clay, sand and silt sum to (nearly) 100%, and if not, default to
- ! the average soil texture for Europe
- if (abs(100.0 - me%clayContent - me%sandContent - me%siltContent) > 0.1) then
- me%clayContent = 18.0
- me%sandContent = 46.0
- me%siltContent = 36.0
- end if
- if (me%coarseFragContent == nf90_fill_real) then
- me%coarseFragContent = 0.0
- end if
- ! Calculate the average grain diameter from soil texture
- me%d_grain = me%calculateAverageGrainSize(me%clayContent, me%siltContent, me%sandContent)
- me%distributionSediment = me%calculateSizeDistribution( &
- me%clayContent, &
- me%siltContent, &
- me%sandContent, &
- C%includeClayEnrichment &
- )
- me%porosity = DATASET%soilDefaultPorosity ! TODO change to be spatial
-
- ! USLE params
- me%usle_C = DATASET%soilUsleCFactor(me%x, me%y)
- if (me%usle_C == nf90_fill_double) then
- me%usle_C = 0.00055095 ! Pick a small value to represent urban, if there's no data
- end if
- me%usle_P = DATASET%soilUslePFactor(me%x, me%y)
- if (me%usle_P == nf90_fill_double) then
- me%usle_P = 1.0 ! If there's no data, assume no support practice
+ class(SoilProfile) :: me
+ type(Result) :: r
+ integer :: landUse
+ logical :: haveSoil2D, haveLU3D
+ integer :: nx, ny, nlux, nluy, nluc
+
+ ! Defensive checks on dataset shapes before indexing
+ haveSoil2D = .false.
+ if (allocated(DATASET%soilBulkDensity)) then
+ nx = size(DATASET%soilBulkDensity, 1) ! y
+ ny = size(DATASET%soilBulkDensity, 2) ! x
+ if (nx > 0 .and. ny > 0 .and. me%x >= 1 .and. me%y >= 1 &
+ .and. me%y <= nx .and. me%x <= ny) haveSoil2D = .true.
end if
- me%usle_LS = DATASET%soilUsleLSFactor(me%x, me%y)
- if (me%usle_LS == nf90_fill_double) then
- me%usle_LS = 0.3 ! Pick an average value if there's no data
+
+ haveLU3D = .false.
+ if (allocated(DATASET%landUse)) then
+ nlux = size(DATASET%landUse, 1) ! categories
+ nluy = size(DATASET%landUse, 2) ! y
+ nluc = size(DATASET%landUse, 3) ! x
+ if (nlux > 0 .and. nluy > 0 .and. nluc > 0 .and. &
+ me%y >= 1 .and. me%x >= 1 .and. me%y <= nluy .and. me%x <= nluc) haveLU3D = .true.
end if
- ! Get earthworm density from land use. Select the maximum land use fraction and use all
- ! of profile as that
- landUse = maxloc(DATASET%landUse(me%x, me%y, :), dim=1)
- ! TODO get these values more intelligently
- select case (landUse)
- case (1)
- me%earthwormDensity = DATASET%earthwormDensityUrbanCapped
- me%dominantLandUseName = 'urban_no_soil'
- case (2)
- me%earthwormDensity = DATASET%earthwormDensityUrbanParks
- me%dominantLandUseName = 'urban_parks_leisure'
- case (3)
- me%earthwormDensity = DATASET%earthwormDensityUrbanGardens
- me%dominantLandUseName = 'urban_industrial_soil'
- case (4)
- me%earthwormDensity = DATASET%earthwormDensityUrbanGardens
- me%dominantLandUseName = 'urban_green_residential'
- case (5)
- me%earthwormDensity = DATASET%earthwormDensityArable
- me%dominantLandUseName = 'arable'
- case (6)
- me%earthwormDensity = DATASET%earthwormDensityGrassland
- me%dominantLandUseName = 'grassland'
- case (7)
- me%earthwormDensity = DATASET%earthwormDensityDeciduous
- me%dominantLandUseName = 'deciduous'
- case (8)
- me%earthwormDensity = DATASET%earthwormDensityConiferous
- me%dominantLandUseName = 'coniferous'
- case (9)
- me%earthwormDensity = DATASET%earthwormDensityHeathland
- me%dominantLandUseName = 'heathland'
- case (10)
- me%earthwormDensity = 0.0_dp
- me%dominantLandUseName = 'water'
- case (11)
- me%earthwormDensity = 0.0_dp
- me%dominantLandUseName = 'desert'
- case default
- me%earthwormDensity = 0.0_dp
- me%dominantLandUseName = 'other'
- end select
+ ! Base SPM distribution (kept even in fallback mode)
+ me%distributionSediment = DATASET%defaultSpmSizeDistribution
+
+ if (haveSoil2D) then
+ me%bulkDensity = DATASET%soilBulkDensity(me%y, me%x)
+ me%WC_sat = DATASET%soilWaterContentSaturation(me%y, me%x)
+ me%WC_FC = DATASET%soilWaterContentFieldCapacity(me%y, me%x)
+ me%K_s = DATASET%soilHydraulicConductivity(me%y, me%x)
+
+ if (me%WC_sat == nf90_fill_real) me%WC_sat = 0.8
+ if (me%WC_FC == nf90_fill_real) me%WC_FC = 0.5
+ if (me%K_s == nf90_fill_real) me%K_s = 1e-6
+ if (me%bulkDensity == nf90_fill_real) me%bulkDensity = 1220.0
+
+ me%clayContent = DATASET%soilTextureClayContent(me%y, me%x)
+ me%sandContent = DATASET%soilTextureSandContent(me%y, me%x)
+ me%siltContent = DATASET%soilTextureSiltContent(me%y, me%x)
+ me%coarseFragContent = DATASET%soilTextureCoarseFragContent(me%y, me%x)
+ if (abs(100.0 - me%clayContent - me%sandContent - me%siltContent) > 0.1) then
+ me%clayContent = 18.0; me%sandContent = 46.0; me%siltContent = 36.0
+ end if
+ if (me%coarseFragContent == nf90_fill_real) me%coarseFragContent = 0.0
+
+ me%d_grain = me%calculateAverageGrainSize(me%clayContent, me%siltContent, me%sandContent)
+ ! Derive the eroded sediment size distribution from soil texture. This must be done on
+ ! this path too (not just the no-soil-data fallback below), otherwise every cell retains
+ ! the placeholder default distribution set above.
+ me%distributionSediment = me%calculateSizeDistribution( &
+ me%clayContent, me%siltContent, me%sandContent, C%includeClayEnrichment )
+ me%porosity = DATASET%soilDefaultPorosity
+
+ me%usle_C = DATASET%soilUsleCFactor(me%y, me%x); if (me%usle_C == nf90_fill_double) me%usle_C = 0.00055095
+ me%usle_P = DATASET%soilUslePFactor(me%y, me%x); if (me%usle_P == nf90_fill_double) me%usle_P = 1.0
+ me%usle_LS = DATASET%soilUsleLSFactor(me%y, me%x); if (me%usle_LS == nf90_fill_double) me%usle_LS = 0.3
+
+ if (haveLU3D) then
+ landUse = maxloc(DATASET%landUse(:, me%y, me%x), dim=1) ! FIX: category along dim 1
+ else
+ landUse = 5
+ end if
+
+ select case (landUse)
+ case (1)
+ me%earthwormDensity = DATASET%earthwormDensityUrbanCapped
+ me%dominantLandUseName= 'urban_no_soil'
+ case (2)
+ me%earthwormDensity = DATASET%earthwormDensityUrbanParks
+ me%dominantLandUseName= 'urban_parks_leisure'
+ case (3)
+ me%earthwormDensity = DATASET%earthwormDensityUrbanGardens
+ me%dominantLandUseName= 'urban_industrial_soil'
+ case (4)
+ me%earthwormDensity = DATASET%earthwormDensityUrbanGardens
+ me%dominantLandUseName= 'urban_green_residential'
+ case (5)
+ me%earthwormDensity = DATASET%earthwormDensityArable
+ me%dominantLandUseName= 'arable'
+ case (6)
+ me%earthwormDensity = DATASET%earthwormDensityGrassland
+ me%dominantLandUseName= 'grassland'
+ case (7)
+ me%earthwormDensity = DATASET%earthwormDensityDeciduous
+ me%dominantLandUseName= 'deciduous'
+ case (8)
+ me%earthwormDensity = DATASET%earthwormDensityConiferous
+ me%dominantLandUseName= 'coniferous'
+ case (9)
+ me%earthwormDensity = DATASET%earthwormDensityHeathland
+ me%dominantLandUseName= 'heathland'
+ case (10)
+ me%earthwormDensity = 0.0_dp
+ me%dominantLandUseName= 'water'
+ case (11)
+ me%earthwormDensity = 0.0_dp
+ me%dominantLandUseName= 'desert'
+ case default
+ me%earthwormDensity = 0.0_dp
+ me%dominantLandUseName= 'other'
+ end select
+
+ me%isUrban = (me%dominantLandUseName == 'urban_no_soil')
+
+ else
+ !--- Fallback path: no soil grids -> treat as water/urban-no-soil; use safe defaults ---
+ me%bulkDensity = 1220.0_dp
+ me%WC_sat = 0.8_dp
+ me%WC_FC = 0.5_dp
+ me%K_s = 1.0e-6_dp
+
+ me%clayContent = 18.0
+ me%sandContent = 46.0
+ me%siltContent = 36.0
+ me%coarseFragContent = 0.0
+ me%d_grain = me%calculateAverageGrainSize(me%clayContent, me%siltContent, me%sandContent)
+ me%distributionSediment = me%calculateSizeDistribution( &
+ me%clayContent, me%siltContent, me%sandContent, C%includeClayEnrichment )
+
+ me%porosity = DATASET%soilDefaultPorosity
+ me%usle_C = 0.00055095_dp
+ me%usle_P = 1.0_dp
+ me%usle_LS = 0.3_dp
+
+ me%earthwormDensity = 0.0_dp
+ me%dominantLandUseName = 'water'
+ me%isUrban = .true.
+ end if
! Auditing
call r%addError( &
- ERROR_HANDLER%equal( &
- value = sum(me%distributionSediment), &
- criterion = 1.0_dp, &
- epsilon = 1e-3, &
- message = "Grain size distribution does not sum to 1 (100%). " &
- // "Have you set sediment size classes correctly?" &
- ) &
- )
+ ERROR_HANDLER%equal( value=sum(me%distributionSediment), criterion=1.0_dp, epsilon=1e-3, &
+ message="Grain size distribution does not sum to 1 (100%). Have you set sediment size classes correctly?" ) )
me%erosivity_a1 = DATASET%soilErosivity_a1
me%erosivity_a2 = DATASET%soilErosivity_a2
me%erosivity_a3 = DATASET%soilErosivity_a3
- me%erosivity_b = DATASET%soilErosivity_b
+ me%erosivity_b = DATASET%soilErosivity_b
- ! Add this procedure to the trace
- call r%addToTrace('Parsing input data')
+ call r%addToTrace('Parsing input data (soil profile)')
end function
subroutine parseNewBatchDataSoilProfile(me)
class(SoilProfile) :: me
- integer :: landUse
+ integer :: landUse
+ logical :: haveSoil2D, haveLU3D
+ integer :: nx, ny, nlux, nluy, nluc
- ! These timeseries are passed to soil profile in create(), so we need to set again here
+ ! Refresh time series
deallocate(me%q_evap_timeSeries, me%q_precip_timeSeries)
- allocate(me%q_evap_timeSeries, source=DATASET%evap(me%x, me%y, :))
+ allocate(me%q_evap_timeSeries, source=DATASET%evap(me%x, me%y, :))
allocate(me%q_precip_timeSeries, source=DATASET%precip(me%x, me%y, :))
- me%bulkDensity = DATASET%soilBulkDensity(me%x, me%y)
- me%WC_sat = DATASET%soilWaterContentSaturation(me%x, me%y)
- me%WC_FC = DATASET%soilWaterContentFieldCapacity(me%x, me%y)
- me%K_s = DATASET%soilHydraulicConductivity(me%x, me%y)
- ! Soil hydraulic properties contain no data where in urban areas. For the moment,
- ! until land cover properly incorporated into model, we'll use this as a proxy
- ! for urban areas (which therefore contain no soil profile). In the future, we should
- ! account for this properly by splitting grid cells into different soil profiles.
- if (me%WC_sat == nf90_fill_real) me%WC_sat = 0.8
- if (me%WC_FC == nf90_fill_real) me%WC_FC = 0.5
- if (me%K_s == nf90_fill_real) me%K_s = 1e-6
- if (me%bulkDensity == nf90_fill_real) me%bulkDensity = 1220
-
- me%clayContent = DATASET%soilTextureClayContent(me%x, me%y)
- me%sandContent = DATASET%soilTextureSandContent(me%x, me%y)
- me%siltContent = DATASET%soilTextureSiltContent(me%x, me%y)
- me%coarseFragContent = DATASET%soilTextureCoarseFragContent(me%x, me%y)
- ! Check if clay, sand and silt sum to (nearly) 100%, and if not, default to
- ! the average soil texture for Europe
- if (abs(100.0 - me%clayContent - me%sandContent - me%siltContent) > 0.1) then
- me%clayContent = 18.0
- me%sandContent = 46.0
- me%siltContent = 36.0
- end if
- if (me%coarseFragContent == nf90_fill_real) then
- me%coarseFragContent = 0.0
+ ! Check availability of spatial layers
+ haveSoil2D = .false.
+ if (allocated(DATASET%soilBulkDensity)) then
+ nx = size(DATASET%soilBulkDensity, 1)
+ ny = size(DATASET%soilBulkDensity, 2)
+ if (nx > 0 .and. ny > 0 .and. me%x >= 1 .and. me%y >= 1 &
+ .and. me%x <= nx .and. me%y <= ny) haveSoil2D = .true.
end if
- ! Calculate the average grain diameter from soil texture
- me%d_grain = me%calculateAverageGrainSize(me%clayContent, me%siltContent, me%sandContent)
- me%porosity = DATASET%soilDefaultPorosity ! TODO change to be spatial
-
- ! USLE params
- me%usle_C = DATASET%soilUsleCFactor(me%x, me%y)
- ! TODO make usle_C not temporal
- if (me%usle_C == nf90_fill_double) then
- me%usle_C = 0.00055095 ! Pick a small value to represent urban, if there's no data
- end if
- me%usle_P = DATASET%soilUslePFactor(me%x, me%y)
- if (me%usle_P == nf90_fill_double) then
- me%usle_P = 1.0 ! If there's no data, assume no support practice
- end if
- me%usle_LS = DATASET%soilUsleLSFactor(me%x, me%y)
- if (me%usle_LS == nf90_fill_double) then
- me%usle_LS = 0.3 ! Pick an average value if there's no data
+
+ haveLU3D = .false.
+ if (allocated(DATASET%landUse)) then
+ nlux = size(DATASET%landUse, 1)
+ nluy = size(DATASET%landUse, 2)
+ nluc = size(DATASET%landUse, 3)
+ if (nlux > 0 .and. nluy > 0 .and. nluc > 0 .and. &
+ me%y >= 1 .and. me%x >= 1 .and. me%y <= nluy .and. me%x <= nluc) haveLU3D = .true.
end if
- ! Get earthworm density from land use. Select the maximum land use fraction and use all
- ! of profile is that.
- landUse = maxloc(DATASET%landUse(me%x, me%y, :), dim=1)
- ! TODO get these values more intelligently
- select case (landUse)
- case (1)
- me%earthwormDensity = DATASET%earthwormDensityUrbanCapped
- case (2)
- me%earthwormDensity = DATASET%earthwormDensityUrbanParks
- case (3)
- me%earthwormDensity = DATASET%earthwormDensityUrbanGardens
- case (4)
- me%earthwormDensity = DATASET%earthwormDensityUrbanGardens
- case (5)
- me%earthwormDensity = DATASET%earthwormDensityArable
- case (6)
- me%earthwormDensity = DATASET%earthwormDensityGrassland
- case (7)
- me%earthwormDensity = DATASET%earthwormDensityDeciduous
- case (8)
- me%earthwormDensity = DATASET%earthwormDensityConiferous
- case (9)
- me%earthwormDensity = DATASET%earthwormDensityHeathland
- case default
- me%earthwormDensity = 0.0_dp
- end select
- end subroutine
+ if (haveSoil2D) then
+ me%bulkDensity = DATASET%soilBulkDensity(me%x, me%y)
+ me%WC_sat = DATASET%soilWaterContentSaturation(me%x, me%y)
+ me%WC_FC = DATASET%soilWaterContentFieldCapacity(me%x, me%y)
+ me%K_s = DATASET%soilHydraulicConductivity(me%x, me%y)
+ if (me%WC_sat == nf90_fill_real) me%WC_sat = 0.8
+ if (me%WC_FC == nf90_fill_real) me%WC_FC = 0.5
+ if (me%K_s == nf90_fill_real) me%K_s = 1e-6
+ if (me%bulkDensity == nf90_fill_real) me%bulkDensity = 1220.0
+
+ me%clayContent = DATASET%soilTextureClayContent(me%x, me%y)
+ me%sandContent = DATASET%soilTextureSandContent(me%x, me%y)
+ me%siltContent = DATASET%soilTextureSiltContent(me%x, me%y)
+ me%coarseFragContent = DATASET%soilTextureCoarseFragContent(me%x, me%y)
+ if (abs(100.0 - me%clayContent - me%sandContent - me%siltContent) > 0.1) then
+ me%clayContent = 18.0
+ me%sandContent = 46.0
+ me%siltContent = 36.0
+ end if
+ if (me%coarseFragContent == nf90_fill_real) me%coarseFragContent = 0.0
- !> Calculate the mean NM PEC across all soil layers for this soil profile
- function get_C_np_SoilProfile(me) result(C_np)
- class(SoilProfile) :: me !! This SoilProfile instance
- real(dp), allocatable :: C_np(:,:,:) !! Mass concentration of NM [kg/kg soil]
- ! For some reason, ifort 18 won't compile if C_np isn't allocatable. Same for the other getter functions
- allocate(C_np(C%npDim(1), C%npDim(2), C%npDim(3)))
- C_np = me%get_m_np() / (me%bulkDensity * me%area * sum(C%soilLayerDepth))
- end function
+ me%d_grain = me%calculateAverageGrainSize(me%clayContent, me%siltContent, me%sandContent)
+ me%porosity = DATASET%soilDefaultPorosity
- !> Calculate the mean transformed NM PEC across all soil layers for this soil profile
- function get_C_transformed_SoilProfile(me) result(C_transformed)
- class(SoilProfile) :: me !! This SoilProfile instance
- real(dp), allocatable :: C_transformed(:,:,:) !! Mass concentration of NM [kg/kg soil]
- allocate(C_transformed(C%npDim(1), C%npDim(2), C%npDim(3)))
- C_transformed = me%get_m_transformed() / (me%bulkDensity * me%area * sum(C%soilLayerDepth))
- end function
+ me%usle_C = DATASET%soilUsleCFactor(me%x, me%y); if (me%usle_C == nf90_fill_double) me%usle_C = 0.00055095
+ me%usle_P = DATASET%soilUslePFactor(me%x, me%y); if (me%usle_P == nf90_fill_double) me%usle_P = 1.0
+ me%usle_LS = DATASET%soilUsleLSFactor(me%x, me%y); if (me%usle_LS == nf90_fill_double) me%usle_LS = 0.3
- !> Calculate the mean dissolved species PEC across all soil layers for this soil profile
- function get_C_dissolved_SoilProfile(me) result(C_dissolved)
- class(SoilProfile) :: me !! This SoilProfile instance
- real(dp) :: C_dissolved !! Mass concentration of dissolved species [kg/kg soil]
- C_dissolved = me%get_m_dissolved() / (me%bulkDensity * me%area * sum(C%soilLayerDepth))
- end function
+ if (haveLU3D) then
+ landUse = maxloc(DATASET%landUse(:, me%y, me%x), dim=1)
+ else
+ landUse = 5
+ end if
+ select case (landUse)
+ case (1); me%earthwormDensity = DATASET%earthwormDensityUrbanCapped
+ case (2); me%earthwormDensity = DATASET%earthwormDensityUrbanParks
+ case (3); me%earthwormDensity = DATASET%earthwormDensityUrbanGardens
+ case (4); me%earthwormDensity = DATASET%earthwormDensityUrbanGardens
+ case (5); me%earthwormDensity = DATASET%earthwormDensityArable
+ case (6); me%earthwormDensity = DATASET%earthwormDensityGrassland
+ case (7); me%earthwormDensity = DATASET%earthwormDensityDeciduous
+ case (8); me%earthwormDensity = DATASET%earthwormDensityConiferous
+ case (9); me%earthwormDensity = DATASET%earthwormDensityHeathland
+ case default
+ me%earthwormDensity = 0.0_dp
+ end select
+ me%isUrban = (landUse == 1)
+
+ else
+ ! No soil grids in this batch: keep model stable with defaults
+ me%bulkDensity = 1220.0_dp
+ me%WC_sat = 0.8_dp
+ me%WC_FC = 0.5_dp
+ me%K_s = 1.0e-6_dp
+ me%d_grain = me%calculateAverageGrainSize(18.0, 36.0, 46.0)
+ me%porosity = DATASET%soilDefaultPorosity
+ me%usle_C = 0.00055095_dp
+ me%usle_P = 1.0_dp
+ me%usle_LS = 0.3_dp
+ me%earthwormDensity = 0.0_dp
+ me%isUrban = .true.
+ end if
+ end subroutine
- !> Get the total NM mass in the soil profile
- function get_m_np_SoilProfile(me) result(m_np)
- class(SoilProfile) :: me !! This SoilProfile instance
- real(dp), allocatable :: m_np(:,:,:) !! NM mass in the soil profile [kg]
- integer :: i ! Iterator
- allocate(m_np(C%npDim(1), C%npDim(2), C%npDim(3)))
- m_np = 0.0_dp
- ! Loop through the soil layers and sum m_np
- do i = 1, C%nSoilLayers
- m_np = m_np + me%colSoilLayers(i)%item%m_np
- end do
- end function
- !> Get the total transformed NM mass in the soil profile
- function get_m_transformed_SoilProfile(me) result(m_transformed)
- class(SoilProfile) :: me !! This SoilProfile instance
- real(dp), allocatable :: m_transformed(:,:,:) !! Transformed NM mass in the soil profile [kg]
- integer :: i ! Iterator
- allocate(m_transformed(C%npDim(1), C%npDim(2), C%npDim(3)))
- m_transformed = 0.0_dp
- ! Loop through the soil layers and sum m_transformed
+ function get_m_contaminant_SoilProfile(me) result(m_contaminant)
+ class(SoilProfile) :: me
+ type(Contaminant) :: m_contaminant
+ type(Result) :: r
+ integer :: i
+ r = m_contaminant%create()
do i = 1, C%nSoilLayers
- m_transformed = m_transformed + me%colSoilLayers(i)%item%m_transformed
+ call m_contaminant%add(me%colSoilLayers(i)%item%m_contaminant)
end do
end function
- !> Get the total dissolved NM mass in the soil profile
- function get_m_dissolved_SoilProfile(me) result(m_dissolved)
- class(SoilProfile) :: me !! This SoilProfile instance
- real(dp) :: m_dissolved !! Dissolved NM mass in the soil profile [kg]
- integer :: i ! Iterator
- m_dissolved = 0.0_dp
- ! Loop through the soil layers and sum m_dissolved
- do i = 1, C%nSoilLayers
- m_dissolved = m_dissolved + me%colSoilLayers(i)%item%m_dissolved
+ ! Return 3-D concentration array for the whole profile (same shape as Contaminant%c)
+ function get_C_contaminant_SoilProfile(me) result(C_contaminant)
+ class(SoilProfile) :: me ! CORRECTED: Removed intent(in)
+ real(dp), allocatable :: C_contaminant(:,:,:)
+ type(Contaminant) :: mtot
+ real(dp) :: V_profile
+ integer :: l
+
+ ! total contaminant mass across all layers (same shape as %c)
+ mtot = me%get_m_contaminant()
+
+ ! total profile volume = sum of layer volumes
+ V_profile = 0.0_dp
+ do l = 1, C%nSoilLayers
+ V_profile = V_profile + me%colSoilLayers(l)%item%volume
end do
- end function
+
+ allocate(C_contaminant(size(mtot%c,1), size(mtot%c,2), size(mtot%c,3)))
+ if (V_profile > C%epsilon) then
+ C_contaminant = mtot%c / V_profile
+ else
+ C_contaminant = 0.0_dp
+ end if
+ end function get_C_contaminant_SoilProfile
end module
diff --git a/src/Source/DiffuseSourceModule.f90 b/src/Source/DiffuseSourceModule.f90
index 751b136..6326109 100644
--- a/src/Source/DiffuseSourceModule.f90
+++ b/src/Source/DiffuseSourceModule.f90
@@ -1,19 +1,18 @@
module DiffuseSourceModule
- use GlobalsModule
+ use GlobalsModule, only: dp, C, FREE_CONTAMINANT, ATTACHED_CONTAMINANT, SPM_CONTAMINANT_START
use ResultModule
use netcdf, only: nf90_fill_double
use DataInputModule
+ use ContaminantModule
implicit none
private
-
+
type, public :: DiffuseSource
integer :: x !! Grid cell x reference
integer :: y !! Grid cell y reference
integer :: s !! Diffuse source reference
character(len=11) :: compartment !! Which environmental compartment is this source for?
- real(dp), allocatable :: j_np_diffuseSource(:,:,:) !! NM input for given timestep [kg/m2/timestep]
- real(dp), allocatable :: j_transformed_diffuseSource(:,:,:) !! Transformed input for given timestep [kg/m2/timestep]
- real(dp) :: j_dissolved_diffuseSource !! Dissolved input for given timestep [kg/m2/timestep]
+ type(Contaminant) :: j_contaminant
contains
procedure :: create => createDiffuseSource
procedure :: update => updateDiffuseSource
@@ -28,114 +27,107 @@ subroutine createDiffuseSource(me, x, y, s, compartment)
integer :: y !! Grid cell y index
integer :: s !! Source index
character(len=*) :: compartment !! Soil, water or atmospheric
+ type(Result) :: r
+
me%x = x
me%y = y
me%s = s
me%compartment = compartment
- allocate(me%j_np_diffuseSource(C%npDim(1), C%npDim(2), C%npDim(3)), &
- me%j_transformed_diffuseSource(C%npDim(1), C%npDim(2), C%npDim(3)))
+ r = me%j_contaminant%create()
+ if (r%hasCriticalError()) then
+ call ERROR_HANDLER%trigger(errors=.errors.r)
+ end if
end subroutine
!> Update the diffuse source on time step t
subroutine updateDiffuseSource(me, t)
- class(DiffuseSource) :: me !! This diffuse source
- integer :: t !! Current time step
- integer :: i ! Iterator
- ! Default to zero
- me%j_np_diffuseSource = 0.0_dp
- me%j_dissolved_diffuseSource = 0.0_dp
- me%j_transformed_diffuseSource = 0.0_dp
- ! Check the environmental compartment we're in, get the corresponding areal source
- ! data and impose the default NM size distribution on it. Data already kg/m2/timestep.
- ! If data doesn't exist, DataInputModule has already created array filled with nf90_fill_double
- if (trim(me%compartment) == 'soil') then
- ! Pristine NM - assumed to be core (form index = 1)
- if (.not. DATASET%emissionsArealSoilPristine(me%x, me%y) >= nf90_fill_double) then
- me%j_np_diffuseSource(:,1,1) = DATASET%emissionsArealSoilPristine(me%x, me%y) * DATASET%defaultNMSizeDistribution
- end if
- ! Matrix-embedded NM - add to form=core (index=1) and state=attached (index=2)
- if (.not. DATASET%emissionsArealSoilMatrixEmbedded(me%x, me%y) >= nf90_fill_double) then
- me%j_np_diffuseSource(:,1,2) = DATASET%emissionsArealSoilMatrixEmbedded(me%x, me%y) &
- * DATASET%defaultNMSizeDistribution
- end if
- ! Dissolved
- if (.not. DATASET%emissionsArealSoilDissolved(me%x, me%y) >= nf90_fill_double) then
- me%j_dissolved_diffuseSource = DATASET%emissionsArealSoilDissolved(me%x, me%y)
- end if
- ! Transformed
- if (.not. DATASET%emissionsArealSoilTransformed(me%x, me%y) >= nf90_fill_double) then
- me%j_transformed_diffuseSource(:,1,1) = DATASET%emissionsArealSoilTransformed(me%x, me%y) &
- * DATASET%defaultNMSizeDistribution
- end if
- else if (trim(me%compartment) >= 'water') then
- ! Pristine NM
- if (.not. DATASET%emissionsArealWaterPristine(me%x, me%y) >= nf90_fill_double) then
- me%j_np_diffuseSource(:,1,1) = DATASET%emissionsArealWaterPristine(me%x, me%y) * DATASET%defaultNMSizeDistribution
- end if
- ! Matrix-embedded NM - add to form=core (index=1) and state=attached (index=2)
- if (.not. DATASET%emissionsArealWaterMatrixEmbedded(me%x, me%y) >= nf90_fill_double) then
- do i = 1, C%nSizeClassesNM
- me%j_np_diffuseSource(i,1,3:) = DATASET%emissionsArealWaterMatrixEmbedded(me%x, me%y) &
- * DATASET%defaultMatrixEmbeddedDistributionToSpm * DATASET%defaultNMSizeDistribution(i)
+ class(DiffuseSource) :: me
+ integer, intent(in) :: t
+ type(Result) :: r
+ integer :: i, j
+ real(dp) :: total_emission
+ real(dp), allocatable :: form_fraction(:)
+ real(dp) :: spm_distribution(C%nSizeClassesSpm)
+
+ call me%j_contaminant%finalise() ! Reset to zero
+ r = me%j_contaminant%create()
+ if (r%hasCriticalError()) then
+ call ERROR_HANDLER%trigger(errors=.errors.r)
+ return
+ end if
+ allocate(form_fraction(C%contaminantDim(2)+1)) ! Forms + dissolved
+ form_fraction = DATASET%defaultContaminantFormDistribution
+ spm_distribution = DATASET%defaultMatrixEmbeddedDistributionToSpm
+ select case (trim(me%compartment))
+ case ('soil')
+ if (DATASET%emissionsArealSoilContaminant(me%x, me%y, 1, 1, FREE_CONTAMINANT) /= nf90_fill_double) then
+ total_emission = sum(DATASET%emissionsArealSoilContaminant(me%x, me%y, :, :, :))
+ do i = 1, C%contaminantDim(2)
+ me%j_contaminant%c(:,i,FREE_CONTAMINANT) = total_emission * form_fraction(i) * &
+ DATASET%defaultDistributionContaminant
+ me%j_contaminant%c(:,i,ATTACHED_CONTAMINANT) = total_emission * form_fraction(C%contaminantDim(2)+1) * &
+ DATASET%defaultDistributionContaminant / C%contaminantDim(2)
end do
- end if
- ! Dissolved
- if (.not. DATASET%emissionsArealWaterDissolved(me%x, me%y) >= nf90_fill_double) then
- me%j_dissolved_diffuseSource = DATASET%emissionsArealWaterDissolved(me%x, me%y)
- end if
- ! Transformed
- if (.not. DATASET%emissionsArealWaterTransformed(me%x, me%y) >= nf90_fill_double) then
- me%j_transformed_diffuseSource(:,1,1) = DATASET%emissionsArealWaterTransformed(me%x, me%y) &
- * DATASET%defaultNMSizeDistribution
+ me%j_contaminant%m_dissolved = total_emission * form_fraction(C%contaminantDim(2)+1)
end if
- else if (trim(me%compartment) == 'atmospheric') then
- ! Dry depo
- ! Pristine NM
- if (.not. DATASET%emissionsAtmosphericDryDepoPristine(me%x, me%y, t) >= nf90_fill_double) then
- me%j_np_diffuseSource(:,1,1) = DATASET%emissionsAtmosphericDryDepoPristine(me%x, me%y, t) &
- * DATASET%defaultNMSizeDistribution
+ if (DATASET%emissionsArealSoilDissolvedContaminant(me%x, me%y) /= nf90_fill_double) then
+ me%j_contaminant%m_dissolved = me%j_contaminant%m_dissolved + &
+ DATASET%emissionsArealSoilDissolvedContaminant(me%x, me%y)
end if
- ! Matrix-embedded NM
- if (.not. DATASET%emissionsAtmosphericDryDepoMatrixEmbedded(me%x, me%y, t) >= nf90_fill_double) then
- do i = 1, C%nSizeClassesNM
- me%j_np_diffuseSource(i,1,3:) = DATASET%emissionsAtmosphericDryDepoMatrixEmbedded(me%x, me%y, t) &
- * DATASET%defaultMatrixEmbeddedDistributionToSpm * DATASET%defaultNMSizeDistribution(i)
+ case ('water')
+ if (DATASET%emissionsArealWaterContaminant(me%x, me%y, 1, 1, FREE_CONTAMINANT) /= nf90_fill_double) then
+ total_emission = sum(DATASET%emissionsArealWaterContaminant(me%x, me%y, :, :, :))
+ do i = 1, C%contaminantDim(2)
+ me%j_contaminant%c(:,i,FREE_CONTAMINANT) = total_emission * form_fraction(i) * &
+ DATASET%defaultDistributionContaminant
+ do j = 1, C%nSizeClassesSpm
+ me%j_contaminant%c(:,i,SPM_CONTAMINANT_START+j-1) = total_emission * &
+ form_fraction(C%contaminantDim(2)+1) * DATASET%defaultDistributionContaminant * &
+ spm_distribution(j) / C%contaminantDim(2)
+ end do
end do
+ me%j_contaminant%m_dissolved = total_emission * form_fraction(C%contaminantDim(2)+1)
end if
- ! Dissolved
- if (.not. DATASET%emissionsAtmosphericDryDepoDissolved(me%x, me%y, t) >= nf90_fill_double) then
- me%j_dissolved_diffuseSource = DATASET%emissionsAtmosphericDryDepoDissolved(me%x, me%y, t)
+ if (DATASET%emissionsArealWaterDissolvedContaminant(me%x, me%y) /= nf90_fill_double) then
+ me%j_contaminant%m_dissolved = me%j_contaminant%m_dissolved + &
+ DATASET%emissionsArealWaterDissolvedContaminant(me%x, me%y)
end if
- ! Transformed
- if (.not. DATASET%emissionsAtmosphericDryDepoTransformed(me%x, me%y, t) >= nf90_fill_double) then
- me%j_transformed_diffuseSource(:,1,1) = DATASET%emissionsAtmosphericDryDepoTransformed(me%x, me%y, t) &
- * DATASET%defaultNMSizeDistribution
+ case ('atmospheric')
+ total_emission = 0.0_dp
+ if (DATASET%emissionsAtmosphericDryDepoContaminant(me%x, me%y, t, 1, 1, FREE_CONTAMINANT) /= nf90_fill_double) then
+ total_emission = total_emission + sum(DATASET%emissionsAtmosphericDryDepoContaminant(me%x, me%y, t, :, :, :))
end if
- ! Wet depo
- ! Pristine NM
- if (.not. DATASET%emissionsAtmosphericWetDepoPristine(me%x, me%y, t) >= nf90_fill_double) then
- me%j_np_diffuseSource(:,1,1) = me%j_np_diffuseSource(:,1,1) &
- + DATASET%emissionsAtmosphericWetDepoPristine(me%x, me%y, t) * DATASET%defaultNMSizeDistribution
+ if (DATASET%emissionsAtmosphericWetDepoContaminant(me%x, me%y, t, 1, 1, FREE_CONTAMINANT) /= nf90_fill_double) then
+ total_emission = total_emission + sum(DATASET%emissionsAtmosphericWetDepoContaminant(me%x, me%y, t, :, :, :))
end if
- ! Matrix-embedded NM
- if (.not. DATASET%emissionsAtmosphericWetDepoMatrixEmbedded(me%x, me%y, t) >= nf90_fill_double) then
- do i = 1, C%nSizeClassesNM
- me%j_np_diffuseSource(i,1,3:) = me%j_np_diffuseSource(i,1,3:) &
- + DATASET%emissionsAtmosphericWetDepoMatrixEmbedded(me%x, me%y, t) &
- * DATASET%defaultMatrixEmbeddedDistributionToSpm * DATASET%defaultNMSizeDistribution(i)
+ if (total_emission > 0.0_dp) then
+ do i = 1, C%contaminantDim(2)
+ me%j_contaminant%c(:,i,FREE_CONTAMINANT) = total_emission * form_fraction(i) * &
+ DATASET%defaultDistributionContaminant
+ do j = 1, C%nSizeClassesSpm
+ me%j_contaminant%c(:,i,SPM_CONTAMINANT_START+j-1) = total_emission * &
+ form_fraction(C%contaminantDim(2)+1) * DATASET%defaultDistributionContaminant * &
+ spm_distribution(j) / C%contaminantDim(2)
+ end do
end do
- end if
- ! Dissolved
- if (.not. DATASET%emissionsAtmosphericWetDepoDissolved(me%x, me%y, t) >= nf90_fill_double) then
- me%j_dissolved_diffuseSource = me%j_dissolved_diffuseSource &
- + DATASET%emissionsAtmosphericWetDepoDissolved(me%x, me%y, t)
+ me%j_contaminant%m_dissolved = total_emission * form_fraction(C%contaminantDim(2)+1)
end if
- ! Transformed
- if (.not. DATASET%emissionsAtmosphericWetDepoTransformed(me%x, me%y, t) >= nf90_fill_double) then
- me%j_transformed_diffuseSource(:,1,1) = me%j_transformed_diffuseSource(:,1,1) &
- + DATASET%emissionsAtmosphericWetDepoTransformed(me%x, me%y, t) * DATASET%defaultNMSizeDistribution
+ if (DATASET%emissionsAtmosphericDryDepoDissolvedContaminant(me%x, me%y, t) /= nf90_fill_double) then
+ me%j_contaminant%m_dissolved = me%j_contaminant%m_dissolved + &
+ DATASET%emissionsAtmosphericDryDepoDissolvedContaminant(me%x, me%y, t)
end if
+ if (DATASET%emissionsAtmosphericWetDepoDissolvedContaminant(me%x, me%y, t) /= nf90_fill_double) then
+ me%j_contaminant%m_dissolved = me%j_contaminant%m_dissolved + &
+ DATASET%emissionsAtmosphericWetDepoDissolvedContaminant(me%x, me%y, t)
+ end if
+ case default
+ call r%addError(ErrorInstance(code=900, message="Invalid compartment: "//trim(me%compartment)))
+ end select
+ if (.not. allocated(me%j_contaminant%c)) then
+ call r%addError(ErrorInstance(code=105, message="Contaminant array not allocated"))
+ end if
+ if (r%hasCriticalError()) then
+ call ERROR_HANDLER%trigger(errors=.errors.r)
end if
end subroutine
-
end module
\ No newline at end of file
diff --git a/src/Source/PointSourceModule.f90 b/src/Source/PointSourceModule.f90
index 6305b73..4a095a2 100644
--- a/src/Source/PointSourceModule.f90
+++ b/src/Source/PointSourceModule.f90
@@ -2,9 +2,9 @@ module PointSourceModule
use GlobalsModule
use ResultModule
use DataInputModule, only: DATASET
+ use ContaminantModule
implicit none
- !> PointSource objects are used to input point source emissions to the environment
type, public :: PointSource
integer :: x !! Grid cell x reference
integer :: y !! Grid cell y reference
@@ -12,8 +12,7 @@ module PointSourceModule
real :: x_coord !! Exact eastings of this point source
real :: y_coord !! Exact northings of this point source
character(len=11) :: compartment !! Which environmental compartment is this source for?
- real(dp), allocatable :: j_np_pointSource(:,:,:) !! NM input for a given time step [kg/timestep]
- real(dp), allocatable :: j_transformed_pointSource(:,:,:) !! Transformed NM input for a given time step [kg/timestep]
+ type(Contaminant) :: j_contaminant_pointSource !! Contaminant input for a given time step
real(dp) :: j_dissolved_pointSource !! Dissolved species input for a given time step [kg/timestep]
contains
procedure :: create => createPointSource
@@ -22,62 +21,75 @@ module PointSourceModule
contains
- !> Create the point source
subroutine createPointSource(me, x, y, s, compartment)
class(PointSource) :: me !! This point source
integer :: x !! Grid cell x index
integer :: y !! Grid cell y index
integer :: s !! Point source index
character(len=*) :: compartment !! Compartment type (only water at the moment)
- ! Allocate and initialise
+ type(Result) :: r !! Result object for error handling
+ ! Allocate and initialize
me%x = x
me%y = y
me%s = s
me%compartment = compartment
- allocate(me%j_np_pointSource(C%npDim(1), C%npDim(2), C%npDim(3)), &
- me%j_transformed_pointSource(C%npDim(1), C%npDim(2), C%npDim(3)))
+ ! Initialize the Contaminant object
+ r = me%j_contaminant_pointSource%create()
+ if (r%hasCriticalError()) call ERROR_HANDLER%trigger(errors=.errors.r)
+ me%j_dissolved_pointSource = 0.0_dp
! Get the exact coordinates of this point source
- if (.not. DATASET%emissionsPointWaterCoords(me%x, me%y, me%s, 1) == nf90_fill_double) then
+ if (DATASET%emissionsPointWaterCoords(me%x, me%y, me%s, 1) /= nf90_fill_double) then
me%x_coord = DATASET%emissionsPointWaterCoords(me%x, me%y, me%s, 1)
me%y_coord = DATASET%emissionsPointWaterCoords(me%x, me%y, me%s, 2)
end if
end subroutine
- !> Update the point source on this time step t
subroutine updatePointSource(me, t)
class(PointSource) :: me !! This point source
integer :: t !! Current time step
- integer :: i ! Iterator
+ integer :: n, s, f !! Iterators for size classes, SPM states, and forms
+ type(Result) :: r !! Result object for error handling
! Default to zero
- me%j_np_pointSource = 0
- me%j_dissolved_pointSource = 0
- me%j_transformed_pointSource = 0
+ call me%j_contaminant_pointSource%finalise() ! Reset to zero
+ r = me%j_contaminant_pointSource%create() ! Reallocate
+ if (r%hasCriticalError()) then
+ call ERROR_HANDLER%trigger(errors=.errors.r)
+ return
+ end if
+ me%j_dissolved_pointSource = 0.0_dp
! Only include point sources if config says we're meant to, and we're not in the
! warm up period
- if (C%includePointSources .and. t .ge. C%warmUpPeriod) then
- ! There are only point sources to water (for the moment)
+ if (C%includePointSources .and. t >= C%warmUpPeriod) then
if (trim(me%compartment) == 'water') then
- ! Pristine - assumed to be core (form index = 1)
- if (.not. DATASET%emissionsPointWaterPristine(me%x, me%y, t, me%s) == nf90_fill_double) then
- me%j_np_pointSource(:,1,1) = DATASET%emissionsPointWaterPristine(me%x, me%y, t, me%s) &
- * DATASET%defaultNMSizeDistribution
- end if
- ! Matrix-embedded
- if (.not. DATASET%emissionsPointWaterMatrixEmbedded(me%x, me%y, t, me%s) == nf90_fill_double) then
- do i = 1, C%nSizeClassesNM
- me%j_np_pointSource(i,1,3:) = DATASET%emissionsPointWaterMatrixEmbedded(me%x, me%y, t, me%s) &
- * DATASET%defaultMatrixEmbeddedDistributionToSpm * DATASET%defaultNMSizeDistribution(i)
+ ! Pristine and transformed contaminants
+ do n = 1, C%nContaminantSizeClasses
+ do f = 1, C%contaminantDim(2) ! Forms (pristine, transformed)
+ ! Free contaminant (state = FREE_CONTAMINANT)
+ if (DATASET%emissionsPointWaterContaminant(me%x, me%y, t, me%s, n, f, FREE_CONTAMINANT) &
+ /= nf90_fill_double) then
+ me%j_contaminant_pointSource%c(n, f, FREE_CONTAMINANT) = &
+ DATASET%emissionsPointWaterContaminant(me%x, me%y, t, me%s, n, f, FREE_CONTAMINANT)
+ end if
+ ! Matrix-embedded (attached to SPM)
+ do s = 1, C%nSizeClassesSpm
+ if (DATASET%emissionsPointWaterContaminant(me%x, me%y, t, me%s, n, f, &
+ SPM_CONTAMINANT_START + s - 1) /= nf90_fill_double) then
+ me%j_contaminant_pointSource%c(n, f, SPM_CONTAMINANT_START + s - 1) = &
+ DATASET%emissionsPointWaterContaminant(me%x, me%y, t, me%s, n, f, &
+ SPM_CONTAMINANT_START + s - 1)
+ end if
+ end do
end do
- end if
+ end do
! Dissolved
- if (.not. DATASET%emissionsPointWaterDissolved(me%x, me%y, t, me%s) == nf90_fill_double) then
- me%j_dissolved_pointSource = DATASET%emissionsPointWaterDissolved(me%x, me%y, t, me%s)
- end if
- ! Transformed
- if (.not. DATASET%emissionsPointWaterTransformed(me%x, me%y, t, me%s) == nf90_fill_double) then
- me%j_transformed_pointSource(:,1,1) = DATASET%emissionsPointWaterTransformed(me%x, me%y, t, me%s) &
- * DATASET%defaultNMSizeDistribution
+ if (DATASET%emissionsPointWaterDissolvedContaminant(me%x, me%y, t) /= nf90_fill_double) then
+ me%j_dissolved_pointSource = DATASET%emissionsPointWaterDissolvedContaminant(me%x, me%y, t)
+ else
+ me%j_dissolved_pointSource = 0.0_dp
end if
+
+ ! FIX: Add the dissolved scalar to the Contaminant object so the Reach receives it
+ me%j_contaminant_pointSource%m_dissolved = me%j_dissolved_pointSource
end if
end if
end subroutine
diff --git a/src/UtilModule.f90 b/src/UtilModule.f90
index 470ea62..fa1909d 100644
--- a/src/UtilModule.f90
+++ b/src/UtilModule.f90
@@ -65,9 +65,9 @@ subroutine printWelcome()
write(*,'(A)') " _ _ _____ _ ____ _____ "
write(*,'(A)') " | \ | | __ _ _ __ ___ | ___/ \ / ___|| ____|"
write(*,'(A)') " | \| |/ _` | '_ \ / _ \| |_ / _ \ \___ \| _| "
- write(*,'(A)') " | |\ | (_| | | | | (_) | _/ ___ \ ___) | |___ "
- write(*,'(A)') "Welcome to the |_| \_|\__,_|_| |_|\___/|_|/_/ \_\____/|_____| model"
- write(*,'(A)') "...version: " // C%modelVersion
+ write(*,'(A)') " | |\ | (_| | | | | () | _/ ___ \ ___) | |___ "
+ write(*,'(A)') "Welcome to the |_| \_|\__,_|_| |_| ||_|_|_|/_/ \_\___/|_____| model"
+ write(*,'(A)') "...version: " // trim(C%modelVersion)
write(*,'(A)') "_____________________________________________________________________"
write(*,'(A)') ""
end subroutine
@@ -75,7 +75,7 @@ subroutine printWelcome()
!> Print a 3D array as a set of 2D matrices to the console
subroutine printMatrix3D(m)
real(dp), allocatable :: m(:,:,:) !! The 3D array to print
- real(dp), allocatable :: mm(:) ! 1D temproary array
+ real(dp), allocatable :: mm(:) ! 1D temporary array
integer :: i, j ! Iterators
allocate(mm(size(m, 2)))
do j = 1, size(m, 3)
@@ -90,7 +90,7 @@ subroutine printMatrix3D(m)
!> Print a 2D array as a matrix
subroutine printMatrix2D(m)
real(dp), allocatable :: m(:,:) !! The 2D array to print
- real(dp), allocatable :: mm(:) ! 1D temproary array
+ real(dp), allocatable :: mm(:) ! 1D temporary array
integer :: i ! Iterator
allocate(mm(size(m, 2)))
do i = 1, size(m, 1)
@@ -137,7 +137,7 @@ pure elemental function ulgcl(i)
pure function strFromInteger(i) result(str)
integer, intent(in) :: i !! The integer to convert to a string
character(len=256) :: str !! The string to return
- write(str, *)i
+ write(str, *) i
str = trim(adjustl(str))
end function
@@ -145,15 +145,15 @@ pure function strFromInteger(i) result(str)
pure function strFromReal(r) result(str)
real, intent(in) :: r !! The real to convert to a string
character(len=256) :: str !! The string to return
- write(str, *)r
+ write(str, *) r
str = trim(adjustl(str))
end function
!> Convert a real 1D array to a string
pure function strFromReal1D(r) result(string)
real, intent(in) :: r(:) !! The integer to convert to a string
- character(len=256) :: string !! The string to return
- integer :: i
+ character(len=256) :: string !! The string to return
+ integer :: i
write(string, *) (trim(str(r(i))) // ", ", i=1, size(r) - 1)
string = trim(string) // " " // trim(str(r(size(r))))
end function
@@ -162,7 +162,7 @@ pure function strFromReal1D(r) result(string)
pure function strFromDp(r) result(str)
real(dp), intent(in) :: r !! The dp real to convert to a string
character(len=256) :: str !! The string to return
- write(str, *)r
+ write(str, *) r
str = trim(adjustl(str))
end function
@@ -177,7 +177,7 @@ pure function strFromLogical(l) result(str)
end function
!> Generate an object reference from a prefix (e.g., "GridCell")
- !! and one integers
+ !! and one integer
function ref1(prefix, a)
character(len=*), intent(in) :: prefix
integer, intent(in) :: a
@@ -205,7 +205,7 @@ function ref2(prefix, a, b)
ref2 = trim(prefix) // "_" // trim(str(a)) // "_" // trim(str(b))
end function
- !> Generate an object reference from a prefix (e.g., "RiverReach")
+ !> Generatetransformer from a prefix (e.g., "RiverReach")
!! and three integers
function ref3(prefix, a, b, c)
character(len=*), intent(in) :: prefix
@@ -449,24 +449,4 @@ function weightedAverageDp3D(x, w) result(x_w)
end do
end function
-! Functions without interfaces
-
- function freeNM(x) result(free)
- real(dp), intent(in) :: x(C%npDim(1), C%npDim(2), C%npDim(3))
- real(dp) :: free(C%nSizeClassesNM)
- free = x(:,1,1)
- end function
-
- function attachedNM(x) result(attached)
- real(dp), intent(in) :: x(C%npDim(1), C%npDim(2), C%npDim(3))
- real(dp) :: attached(C%nSizeClassesNM)
- attached = x(:,1,2)
- end function
-
- function heteroaggregatedNM(x) result(heteroaggregated)
- real(dp), intent(in) :: x(C%npDim(1), C%npDim(2), C%npDim(3))
- real(dp) :: heteroaggregated(C%nSizeClassesNM)
- heteroaggregated = sum(x(:,1,3:), dim=1)
- end function
-
end module
\ No newline at end of file
diff --git a/src/WaterBody/EstuaryReachModule.f90 b/src/WaterBody/EstuaryReachModule.f90
index db68a60..8b49e78 100644
--- a/src/WaterBody/EstuaryReachModule.f90
+++ b/src/WaterBody/EstuaryReachModule.f90
@@ -6,60 +6,67 @@ module EstuaryReachModule
use BedSedimentModule
use LoggerModule, only: LOGR
use ReactorModule
+ use ContaminantModule
+ use DataInputModule, only: DATASET
implicit none
type, public, extends(Reach) :: EstuaryReach
- real(dp) :: meanDepth !! Mean estuary depth for use in tidal depth calculations [m]
- real(dp) :: distanceToMouth !! Distance to the mouth of the estuary [m]
- real(dp) :: tidalM2 !! Tidal harmonic coefficient M2 [-]
- real(dp) :: tidalS2 !! Tidal harmonic coefficient S2 [-]
-
+ real(dp) :: meanDepth !! Mean estuary depth for use in tidal depth calculations [m]
+ real(dp) :: distanceToMouth !! Distance to the mouth of the estuary [m]
+ real(dp) :: tidalM2 !! Tidal harmonic coefficient M2 [-]
+ real(dp) :: tidalS2 !! Tidal harmonic coefficient S2 [-]
contains
- ! Create/destroy
procedure :: create => createEstuaryReach
- ! Simulators
procedure :: update => updateEstuaryReach
+ procedure :: updateDisplacement => updateDisplacementEstuaryReach
procedure :: setDimensions
- ! Data handlers
procedure :: parseInputData => parseInputDataEstuaryReach
- ! Calculators
procedure :: calculateDepth => calculateDepth
procedure :: calculateVelocity => calculateVelocity
procedure :: calculateDistanceToMouth => calculateDistanceToMouth
procedure :: changeInVolume => changeInVolume
+ procedure :: finalise => finaliseEstuaryReach
end type
- contains
+contains
function createEstuaryReach(me, x, y, w, distributionSediment) result(rslt)
- class(EstuaryReach) :: me !! This `EstuaryReach` instance
- integer :: x !! Grid cell x-position index
- integer :: y !! Grid cell y-position index
- integer :: w !! Water body index within the cell
- real(dp) :: distributionSediment(C%nSizeClassesSPM) !! Distribution to split sediment yields with
- type(Result) :: rslt !! Result object to return errors in
- integer :: i, j ! Iterator
-
- ! Set reach references (indices set in WaterBody%create) and grid cell area
+ class(EstuaryReach), intent(inout) :: me
+ integer, intent(in) :: x, y, w
+ real(dp), intent(in) :: distributionSediment(C%nSizeClassesSPM)
+ type(Result) :: rslt
+ integer :: i
+
call rslt%addErrors(.errors. me%WaterBody%create(x, y, w, distributionSediment))
me%ref = trim(ref("EstuaryReach", x, y, w))
- ! Parse input data and allocate/initialise variables
call rslt%addErrors(.errors. me%parseInputData())
+ call rslt%addErrors(.errors. me%m_contaminant%create_from_data( &
+ 'estuary', &
+ DATASET%contaminantDensity, &
+ DATASET%soilConstantAttachmentEfficiency, &
+ DATASET%riverAttachmentEfficiency, &
+ DATASET%estuaryAttachmentEfficiency, &
+ DATASET%contaminant_k_diss_pristine, &
+ DATASET%contaminant_k_diss_transformed, &
+ DATASET%contaminant_k_transform_pristine, &
+ DATASET%waterTemperature(C%startDate%yearday()) &
+ ))
- ! Make sure the reach has some dimensions to begin with
call me%setDimensions(0)
- ! Create the bed sediment and reactor for this reach
allocate(BedSediment :: me%bedSediment)
allocate(Reactor :: me%reactor)
call rslt%addErrors([ &
.errors. me%bedSediment%create(me%x, me%y, me%w), &
- .errors. me%reactor%create(me%x, me%y, me%alpha_hetero) &
+ .errors. me%reactor%create( &
+ me%x, me%y, 'estuary', &
+ me%m_contaminant, me%volume, &
+ DATASET%waterTemperature(C%startDate%yearday()), &
+ C_spm=me%C_spm, W_settle_spm=me%W_settle_spm, &
+ G=DATASET%shearRate, velocity=me%velocity) &
])
- ! Allocate and create the correct number of biota objects for this reach
- ! TODO move all this to database
allocate(me%biotaIndices(0))
if (DATASET%hasBiota) then
do i = 1, DATASET%nBiota
@@ -78,399 +85,254 @@ function createEstuaryReach(me, x, y, w, distributionSediment) result(rslt)
call LOGR%toFile("Creating " // trim(me%ref) // ": success")
end function
-
- !> Run the estuary reach simulation for this timestep
- subroutine updateEstuaryReach(me, t, q_runoff, q_overland, j_spm_runoff, j_np_runoff, &
- j_transformed_runoff, contributingArea, isWarmUp)
- class(EstuaryReach) :: me
- integer :: t
- real(dp) :: q_runoff !! Runoff (slow + quick flow) from the hydrological model [m/timestep]
- real(dp) :: q_overland !! Overland flow [m3/m2/timestep]
- real(dp) :: j_spm_runoff(:) !! Eroded sediment runoff to this reach [kg/timestep]
- real(dp) :: j_np_runoff(:,:,:) !! Eroded NP runoff to this reach [kg/timestep]
- real(dp) :: j_transformed_runoff(:,:,:) !! Eroded NP runoff to this reach [kg/timestep]
- real(dp) :: contributingArea !! Area contributing to this reach (e.g. the soil profile) [m2]
- logical :: isWarmUp
+ subroutine updateEstuaryReach(me, t, q_runoff, q_overland, j_spm_runoff, j_contaminant_runoff, &
+ contributingArea, isWarmUp)
+ class(EstuaryReach), intent(inout) :: me
+ integer, intent(in) :: t
+ real(dp), intent(in) :: q_runoff, q_overland
+ real(dp), intent(in) :: j_spm_runoff(:)
+ type(Contaminant), intent(in) :: j_contaminant_runoff
+ real(dp), intent(in) :: contributingArea
+ logical, intent(in) :: isWarmUp
type(Result) :: rslt
- real(dp) :: Q_outflow
- real(dp) :: changeInVolume, previousVolume
- real(dp) :: j_spm_outflow(C%nSizeClassesSpm)
- real(dp) :: j_np_outflow(C%npDim(1), C%npDim(2), C%npDim(3))
- real(dp) :: j_spm_in_total(C%nSizeClassesSpm) ! Total inflow of SPM [kg/timestep]
- real(dp) :: j_np_in_total(C%npDim(1), C%npDim(2), C%npDim(3)) ! Total inflow of NP [kg/timestep]
- real(dp) :: fractionSpmDeposited(C%nSizeClassesSpm) ! Fraction of SPM deposited on each time step [-]
- integer :: i, j, k ! Iterator
- integer :: nDisp ! Number of displacements to split this time step into
- real(dp) :: dt ! Length of each displacement [s]
- real(dp) :: dQ_in ! Water inflow for each displacement [m3/displacement]
- real(dp) :: dQ_out
- real(dp) :: dj_spm_erosion(C%nSizeClassesSpm) ! SPM inflow due to erosion for each displacement [kg/displacement]
- real(dp) :: dj_spm_inflow(C%nSizeClassesSpm) ! SPM inflow from inflow reaches for each displacement [kg/displacement]
- real(dp) :: dj_nm_erosion_sources(C%npDim(1), C%npDim(2), C%npDim(3)) ! NM inflow due to erosion and sources for each displacement [kg/displacement]
- real(dp) :: dj_nm_inflow(C%npDim(1), C%npDim(2), C%npDim(3)) ! NM inflow from inflow reaches for each displacement [kg/displacement]
- real(dp) :: dj_nm_transformed_erosion_sources(C%npDim(1), C%npDim(2), C%npDim(3)) ! Transformed NM inflow due to erosion and sources for each displacement [kg/displacement]
- real(dp) :: dj_nm_transformed_inflow(C%npDim(1), C%npDim(2), C%npDim(3)) ! Transformed NM inflow from inflow reaches for each displacement [kg/displacement]
- real(dp) :: dj_dissolved_sources ! Dissolved species inflow from sources on each displacement [kg/displacement]
- real(dp) :: dj_dissolved_inflow ! Dissolved species inflow from inflow reaches on each displacement [kg/displacement]
- real(dp) :: dj_spm_out(C%nSizeClassesSpm) ! SPM outflow from reach on current displacement [kg/displacement]
- real(dp) :: dj_nm_out(C%npDim(1), C%npDim(2), C%npDim(3)) ! NM outflow from reach on current displacement [kg/displacement]
- real(dp) :: dj_nm_transformed_out(C%npDim(1), C%npDim(2), C%npDim(3)) ! Transformed NM outflow from reach on current displacement [kg/displacement]
- real(dp) :: dj_dissolved_out ! Dissolved species outflow from reach on current displacement [kg/displacement]
- real(dp) :: dj_spm_outflow(C%nSizeClassesSpm) ! SPM outflow from reach on current displacement [kg/displacement]
- real(dp) :: dj_nm_outflow(C%npDim(1), C%npDim(2), C%npDim(3)) ! NM outflow from reach on current displacement [kg/displacement]
- real(dp) :: dj_nm_transformed_outflow(C%npDim(1), C%npDim(2), C%npDim(3)) ! Transformed NM outflow from reach on current displacement [kg/displacement]
- real(dp) :: dj_dissolved_outflow ! Dissolved species outflow from reach on current displacement [kg/displacement]
- real(dp) :: dj_spm_resus(C%nSizeClassesSpm) ! Mass of each sediment size class resuspended on each displacement [kg]
- real(dp) :: dj_spm_in(C%nSizeClassesSpm)
- real(dp) :: dj_nm_in(C%npDim(1), C%npDim(2), C%npDim(3))
- real(dp) :: dj_nm_transformed_in(C%npDim(1), C%npDim(2), C%npDim(3))
- real(dp) :: dj_dissolved_in
- real(dp) :: tpm_m_spm(C%nSizeClassesSpm)
- integer :: f
- real(dp) :: dj_spm_deposit(C%nSizeClassesSpm)
- real(dp) :: dj_nm_deposit(C%npDim(1), C%npDim(2), C%npDim(3))
- real(dp) :: dj_nm_transformed_deposit(C%npDim(1), C%npDim(2), C%npDim(3))
- real(dp) :: dj_nm_resus(C%npDim(1), C%npDim(2), C%npDim(3))
- real(dp) :: dj_spm_resus_perArea(C%nSizeClassesSpm) ! Mass of each sediment size class resuspended on each displacement, per unit area [kg/m2/disp]
- real(dp) :: dj_spm_deposit_perArea(C%nSizeClassesSpm) ! Mass of each sediment size class deposited on each displacement, per unit area [kg/m2/disp]
- real(dp) :: tmp_dj_spm_resus_perArea(C%nSizeClassesSpm) ! Temp dj_spm_resus_perArea, to get around bed sediment procedures modifying input params - TODO sort this out
- real(dp) :: dj_nm_deposit_perArea(C%npDim(1), C%npDim(2), C%npDim(3))
+ real(dp) :: changeInVolume
+ real(dp) :: j_spm_in_total(C%nSizeClassesSpm)
+ type(Contaminant) :: j_contaminant_in_total
+ integer :: i, nDisp
+ real(dp) :: dt, dQ_in
+ real(dp) :: dj_spm_erosion(C%nSizeClassesSpm)
+ real(dp) :: dj_spm_inflow(C%nSizeClassesSpm)
+ type(Contaminant) :: dj_contaminant_erosion_sources, dj_contaminant_inflow
type(datetime) :: currentDate
- real :: T_water_t ! Water temperature on this timestep [deg C]
+ real(dp) :: T_water_t
- ! Reset all flows to zero, which is needed as flows are added to iteratively in the displacement loop
call me%emptyFlows()
-
- ! Get the current date and use the day of year to get the water temp
+
currentDate = C%startDate + timedelta(t-1)
- T_water_t = me%T_water(currentDate%yearday())
+ T_water_t = me%T_water(currentDate%yearday())
- ! Get the inflows from upstream water bodies
- ! TODO sort out routing and get rid of _final flow objects
do i = 1, me%nInflows
- me%Q%inflow = me%Q%inflow - me%inflows(i)%item%Q_final%outflow
- me%j_spm%inflow = me%j_spm%inflow - me%inflows(i)%item%j_spm_final%outflow
- me%j_nm%inflow = me%j_nm%inflow - me%inflows(i)%item%j_nm_final%outflow
- me%j_nm_transformed%inflow = me%j_nm_transformed%inflow &
- - me%inflows(i)%item%j_nm_transformed_final%outflow
- me%j_dissolved%inflow = me%j_dissolved%inflow - me%inflows(i)%item%j_dissolved_final%outflow
- end do
-
- ! Get the inflows from runoff and scale to this reach
- me%Q%runoff = q_runoff * contributingArea
-
- ! TODO transfers and demands
-
- ! Inflows from point and diffuse sources, updates the NM flow object
- if (.not. C%ignoreNM .and. .not. isWarmUp) then
+ me%Q%inflow = me%Q%inflow + me%inflows(i)%item%Q_final%outflow
+ me%j_spm%inflow = me%j_spm%inflow + me%inflows(i)%item%j_spm_final%outflow
+ call me%j_contaminant_inflow%add(me%inflows(i)%item%get_j_contaminant_outflow())
+ end do
+
+ me%Q%runoff = q_runoff * contributingArea
+
+ if (.not. C%ignoreContaminant .and. .not. isWarmUp) then
call me%updateSources(t)
end if
- ! Set the reach dimensions (using the timestep in hours for tidal harmonics) and calculate the change in volume
call me%setDimensions((t-1) * C%timeStep / C%minEstuaryTimestep)
changeInVolume = me%changeInVolume((t-1)*24, t*24)
- ! Calculate the outflow based on the change in volume and inflows. +ve outflow indicates upstream tidal flow,
- ! -ve outflow indicates downstream tidal flow. This is used to determine what classes as "input" SPM/NM
- Q_outflow = changeInVolume - me%Q%inflow - me%Q%runoff - me%Q%transfers
- ! Input will always be from runoff, transfers and sources
+ me%Q%outflow = changeInVolume - me%Q%inflow - me%Q%runoff - me%Q%transfers
me%Q_in_total = me%Q%runoff + me%Q%transfers
- ! j_spm_input_total = me%j_spm_runoff() + me%j_spm_transfers()
- ! j_np_input_total = me%j_np_runoff() + me%j_np_transfers() + me%j_np_pointsource() + me%j_np_diffusesource()
- ! If outflow is positive (incoming tide) then some input will be provided by the inflowing outflow (which will be +ve)
- if (Q_outflow > 0) then
+ j_spm_in_total = me%j_spm%soilErosion + me%j_spm%transfers
+ call rslt%addErrors(.errors. j_contaminant_in_total%create())
+ call j_contaminant_in_total%add(j_contaminant_runoff)
+ call j_contaminant_in_total%add(me%j_contaminant_transfers)
+ call j_contaminant_in_total%add(me%j_contaminant_pointSources)
+ call j_contaminant_in_total%add(me%j_contaminant_diffuseSources)
+ if (me%Q%outflow > 0) then
me%Q_in_total = me%Q_in_total + me%Q%outflow
- ! j_spm_input_total = j_spm_input_total + me%j_spm_outflow()
- ! j_np_input_total = j_np_input_total + me%j_np_outflow()
+ j_spm_in_total = j_spm_in_total + me%j_spm%outflow
+ call j_contaminant_in_total%add(me%j_contaminant_outflow)
end if
- ! If inflow is positive, input will also be from inflows (tide might still be incoming for this particular reach)
if (me%Q%inflow > 0.0_dp) then
me%Q_in_total = me%Q_in_total + me%Q%inflow
- ! j_spm_input_total = j_spm_input_total + me%j_spm_inflows()
- ! j_np_input_total = j_np_input_total + me%j_np_inflows()
+ j_spm_in_total = j_spm_in_total + me%j_spm%inflow
+ call j_contaminant_in_total%add(me%j_contaminant_inflow)
end if
- ! Use the total inflow to calculate the velocity
me%velocity = me%calculateVelocity(me%depth, me%Q_in_total/C%timeStep, me%width)
- ! Set the erosion yields, which includes scaling the soil erosion by sediment transport
- ! capacity, calculating the bank ersoion, and storing these in the flow objects. This must
- ! be done after me%Q_in_total has been set
- call me%setErosionYields(j_spm_runoff, q_overland, contributingArea, j_np_runoff, j_transformed_runoff)
+ call me%setErosionYields(j_spm_runoff, q_overland, contributingArea, j_contaminant_runoff)
- ! Set the resuspension and settling rates [/s] (but don't settle until we're looping through displacements)
call me%setResuspensionRate(me%Q_in_total / C%timeStep, T_water_t)
call me%setSettlingRate(T_water_t)
- ! If Q_in for this timestep is bigger than the reach volume, then we need to
- ! split into a number of displacements. If Q_in is zero, just have 1 displacement.
if (isZero(me%Q_in_total) .or. isZero(me%volume)) then
nDisp = C%timeStep / C%minEstuaryTimestep
else
- ! Make sure the minimum displacement duration is that provided in config (defaults to 1 hour)
nDisp = max(ceiling(me%Q_in_total / me%volume), C%timeStep / C%minEstuaryTimestep)
end if
- dt = C%timeStep / nDisp ! Length of each displacement [s]
+ dt = C%timeStep / nDisp
dQ_in = me%Q_in_total / nDisp
- dj_SPM_erosion = (me%j_spm%soilErosion + me%j_spm%bankErosion) / nDisp
+ dj_spm_erosion = (me%j_spm%soilErosion + me%j_spm%bankErosion) / nDisp
dj_spm_inflow = me%j_spm%inflow / nDisp
- dj_nm_erosion_sources = (me%j_nm%soilErosion + me%j_nm%pointSources &
- + me%j_nm%diffuseSources) / nDisp
- dj_nm_inflow = me%j_nm%inflow / nDisp
- dj_NM_transformed_erosion_sources = (me%j_nm_transformed%soilErosion &
- + me%j_nm_transformed%pointSources &
- + me%j_nm_transformed%diffuseSources) / nDisp
- dj_nm_transformed_inflow = me%j_nm_transformed%inflow / nDisp
- dj_dissolved_sources = (me%j_dissolved%pointSources + me%j_dissolved%diffuseSources) / nDisp
- dj_dissolved_inflow = me%j_dissolved%inflow / nDisp
+ call rslt%addErrors(.errors. dj_contaminant_erosion_sources%create())
+ call dj_contaminant_erosion_sources%multiply_scalar(j_contaminant_runoff, 1.0_dp/nDisp)
+ call dj_contaminant_erosion_sources%add_scaled(me%j_contaminant_pointSources, 1.0_dp/nDisp)
+ call dj_contaminant_erosion_sources%add_scaled(me%j_contaminant_diffuseSources, 1.0_dp/nDisp)
+ call rslt%addErrors(.errors. dj_contaminant_inflow%create())
+ call dj_contaminant_inflow%multiply_scalar(me%j_contaminant_inflow, 1.0_dp/nDisp)
do i = 1, nDisp
- ! Calculate the timestep in hours from the displacement length, and pass to setDimensions
- ! to use to calculate tidal harmonics
- call me%setDimensions((t -1)*C%timeStep/3600 + i*(int(dt)/3600))
- ! Calculate the change in volume between this displacement and the next
- changeInVolume = me%changeInVolume((t-1)*24 + (i-1)*(int(dt)/3600), (t-1)*24 + i*(int(dt)/3600))
- ! Water mass balance (outflow = all the inflows + change in volume)
- dQ_out = -dQ_in + changeInVolume
- ! As flow changes so much over displacement, set resuspension rate on each
- call me%setResuspensionRate(abs(dQ_out) / dt, T_water_t)
-
- ! If this displacement's outflow is -ve, tidal flow must be downstream and
- ! outflowing SPM/NM is a function of this reach's SPM/NM conc, else if it is
- ! +ve, then it must be a function of the outflow reach's SPM/NM conc (if that
- ! outflow reach exists)
- if (dQ_out < 0 .and. .not. isZero(me%volume)) then
- ! SPM and NM outflows (which are downstream)
- dj_spm_out = max(me%m_spm * dQ_out / me%volume, -me%m_spm)
- dj_nm_out = max(me%m_np * dQ_out / me%volume, -me%m_np)
- dj_nm_transformed_out = max(me%m_transformed * dQ_out / me%volume, -me%m_transformed)
- dj_dissolved_out = max(me%m_dissolved * dQ_out / me%volume, -me%m_dissolved)
- ! Total SPM input to this displacement, from erosion and inflow reaches (but not depsition yet)
- dj_spm_in = dj_spm_erosion + dj_spm_inflow
- dj_nm_in = dj_nm_erosion_sources + dj_nm_inflow
- dj_nm_transformed_in = dj_nm_transformed_erosion_sources + dj_nm_transformed_inflow
- dj_dissolved_in = dj_dissolved_sources + dj_dissolved_inflow
- else if (dQ_out > 0 .and. associated(me%outflow%item)) then
- ! Add SPM inflowing from downstream reach
- ! TODO setting inflow by splitting outflow m_spm by nInflows is a hack, change this to
- ! get the proper m_spm from each reach
- dj_spm_out = min(me%outflow%item%C_spm_final * dQ_out, me%outflow%item%m_spm / me%outflow%item%nInflows)
- dj_nm_out = min(me%outflow%item%C_np_final * dQ_out, me%outflow%item%m_np / me%outflow%item%nInflows)
- dj_nm_transformed_out = min(me%outflow%item%C_transformed_final * dQ_out, &
- me%outflow%item%m_transformed/me%outflow%item%nInflows)
- dj_dissolved_out = min(me%outflow%item%C_dissolved_final * dQ_out, &
- me%outflow%item%m_dissolved/me%outflow%item%nInflows)
- ! Set the "inflow" (upstream) based on this
- dj_spm_inflow = -min(me%m_spm * dQ_out / me%volume, me%m_spm)
- dj_nm_inflow = -min(me%m_np * dQ_out / me%volume, me%m_np)
- dj_nm_transformed_inflow = -min(me%m_transformed * dQ_out / me%volume, me%m_transformed)
- dj_dissolved_inflow = -min(me%m_dissolved * dQ_out / me%volume, me%m_dissolved)
- !!!!!! NEED TO REMOVE SPM, NM FROM THE OUTFLOW REACH !!!!!!!!!
- !!!!!! AND MAKE SURE IT'S NOT ALL ADVECTED !!!!!!!!!!!!!!!!!!!
- dj_spm_in = dj_spm_erosion + dj_spm_inflow ! Total SPM input, from inflowing outflow and erosion (not deposition)
- dj_nm_in = dj_nm_erosion_sources + dj_nm_inflow
- dj_nm_transformed_in = dj_nm_transformed_erosion_sources + dj_nm_transformed_inflow
- dj_dissolved_in = dj_dissolved_sources + dj_dissolved_inflow
- else if (dQ_out > 0 .and. .not. associated(me%outflow%item)) then
- ! If there is no outflow but tidal flow is in, set inflow SPM/NM to zero
- dj_spm_out = 0.0_dp
- dj_nm_out = 0.0_dp
- dj_nm_transformed_out = 0.0_dp
- dj_dissolved_out = 0.0_dp
- dj_spm_in = dj_spm_erosion + dj_spm_inflow
- dj_nm_in = dj_nm_erosion_sources + dj_nm_inflow
- dj_nm_transformed_in = dj_nm_transformed_erosion_sources + dj_nm_transformed_inflow
- dj_dissolved_in = dj_dissolved_sources + dj_dissolved_inflow
- else
- dj_spm_out = 0.0_dp
- dj_nm_out = 0.0_dp
- dj_nm_transformed_out = 0.0_dp
- dj_dissolved_out = 0.0_dp
- dj_spm_in = 0.0_dp
- dj_nm_in = 0.0_dp
- dj_nm_transformed_in = 0.0_dp
- dj_dissolved_in = 0.0_dp
- end if
+ call me%updateDisplacement(t, i, dt, dQ_in, dj_spm_erosion, dj_spm_inflow, &
+ dj_contaminant_erosion_sources, dj_contaminant_inflow, T_water_t)
+ end do
- tpm_m_spm = max(me%m_spm + dj_spm_in, 0.0_dp) ! Check the SPM isn't making the new mass negative
- ! SPM deposition and resuspension. Use m_spm as previous m_spm + inflow - outflow, making sure to
- ! not pick up on the previous displacement's deposition (index 4+me%nInflows)
- dj_spm_deposit = min(me%k_settle * dt * tpm_m_spm, tpm_m_spm)
- dj_spm_resus = me%k_resus * me%bedSediment%Mf_bed_by_size() * dt
-
- ! Calculate the fraction of SPM from each size class that was deposited, for use in calculating mass of NM deposited
- do j = 1, C%nSizeClassesSpm
- if (isZero(dj_spm_deposit(j))) then
- fractionSpmDeposited(j) = 0
- else
- fractionSpmDeposited(j) = dj_spm_deposit(j) / (tpm_m_spm(j)) ! TODO include resus
- end if
- end do
- ! Update the deposition element of the SPM and NM flux array. Only heteroaggregated,
- dj_nm_deposit = 0.0_dp
- dj_nm_transformed_deposit = 0.0_dp
- do j = 1, C%nSizeClassesSpm
- dj_nm_deposit(:,:,2+j) = min(me%m_np(:,:,2+j)*fractionSpmDeposited(j), me%m_np(:,:,2+j)) ! Only deposit heteroaggregated NM (index 3+)
- dj_nm_transformed_deposit(:,:,2+j) = min(me%m_transformed(:,:,2+j)*fractionSpmDeposited(j), &
- me%m_transformed(:,:,2+j))
- ! dj_np(4+me%nInflows,:,:,2+j) = -min(me%m_np(:,:,2+j)*fractionSpmDeposited(j), me%m_np(:,:,2+j)) ! Only deposit heteroaggregated NM (index 3+)
- ! dj_transformed(4+me%nInflows,:,:,2+j) = &:w
- ! -min(me%m_transformed(:,:,2+j)*fractionSpmDeposited(j), me%m_transformed(:,:,2+j))
- end do
+ call j_contaminant_in_total%finalise()
+ call dj_contaminant_erosion_sources%finalise()
+ call dj_contaminant_inflow%finalise()
- !-- MASS BALANCES --!
- ! SPM and NM mass balance. As outflow was set before deposition etc fluxes, we need to check that masses aren't below zero again
- dj_nm_outflow = -min(me%m_np, dj_nm_out) ! Maximum outflow is the current mass
- dj_spm_outflow = -min(me%m_spm, dj_spm_out)
- dj_nm_transformed_outflow = -min(me%m_transformed, dj_nm_transformed_out)
- dj_dissolved_outflow = -min(me%m_dissolved, dj_dissolved_out)
- me%m_spm = flushToZero(max(me%m_spm + dj_spm_in - dj_spm_outflow, 0.0_dp))
- me%m_np = flushToZero(max(me%m_np + dj_nm_in - dj_nm_outflow, 0.0_dp))
- me%m_transformed = flushToZero(max(me%m_transformed + dj_nm_transformed_in - dj_nm_transformed_outflow, 0.0_dp))
- me%m_dissolved = flushToZero(max(me%m_dissolved + dj_dissolved_in - dj_dissolved_outflow, 0.0_dp))
-
- ! Add the calculated fluxes (outflow and deposition) to the total. Don't update inflows
- ! (inflows, runoff, sources) as they've already been correctly before the disp loop
- me%Q%outflow = me%Q%outflow + dQ_out
- me%j_spm%outflow = me%j_spm%outflow + dj_spm_outflow ! dj_spm_outflow should already be -ve
- me%j_nm%outflow = me%j_nm%outflow + dj_nm_outflow
- me%j_nm_transformed%outflow = me%j_nm_transformed%outflow + dj_nm_transformed_outflow
- me%j_dissolved%outflow = me%j_dissolved%outflow + dj_dissolved_outflow
- me%j_spm%deposition = me%j_spm%deposition - dj_spm_deposit ! Deposition is -ve
- me%j_spm%resuspension = me%j_spm%resuspension + dj_spm_resus
- me%j_nm%deposition = me%j_nm%deposition - dj_nm_deposit
- me%j_nm_transformed%deposition = me%j_nm_transformed%deposition - dj_nm_transformed_deposit
-
- ! Deposit SPM and NM to bed, and pull out resuspended NM mass
- dj_spm_resus_perArea = divideCheckZero(dj_spm_resus, me%bedArea)
- dj_spm_deposit_perArea = divideCheckZero(dj_spm_deposit, me%bedArea)
- tmp_dj_spm_resus_perArea = dj_spm_resus_perArea
- dj_nm_deposit_perArea = divideCheckZero(dj_nm_deposit, me%bedArea)
- ! If we're including bed sediment, then deposit and resuspend to/from
- if (C%includeBedSediment) then
- ! Remove resuspended SPM from sediment
- call rslt%addErrors(.errors. me%bedSediment%resuspend(tmp_dj_spm_resus_perArea))
- ! bedSediment%resuspend modifies dj_spm_resus_perArea to be the amount of sediment passed in
- ! that isn't resuspended, so the amount actually resuspended is input - output:
- dj_spm_resus_perArea = dj_spm_resus_perArea - tmp_dj_spm_resus_perArea
- ! Update the deposition element of SPM array based on this
- ! dj_spm(4+me%nInflows,:) = dj_spm_resus_perArea * me%bedArea - dj_spm_deposit
- ! Add deposited SPM to sediment
- call rslt%addErrors(.errors. me%depositToBed(dj_spm_deposit))
- if (rslt%hasCriticalError()) return
- ! Fill bedSediment%delta_sed mass transfer matrix based on this passed deposition and resuspension
-
- if (.not. C%ignoreNM) then
- call me%bedSediment%getmatrix(dj_spm_deposit_perArea, dj_spm_resus_perArea)
- ! The above must be called before transferNM so that delta_sed is set. TODO change this to be internal to bed sediment
- ! Now actually transfer the NM between the layers (only if there is NM to deposit)
- if (.not. any(dj_nm_deposit_perArea == 0.0_dp)) then
- call me%bedSediment%transferNM(dj_nm_deposit_perArea)
- end if
- ! Now we've computed transfers in bed sediment, we need to pull the resuspended NM out and add to mass balance matrices
- dj_nm_resus = me%bedSediment%M_np(2,:,:,:) * me%bedArea
- me%j_nm%resuspension = me%j_nm%resuspension + dj_nm_resus
- end if
+ me%C_spm = divideCheckZero(me%m_spm, me%volume)
+ if (.not. C%ignoreContaminant .and. .not. isZero(me%volume)) then
+ call rslt%addErrors(.errors. me%reactor%update(j_contaminant_in_total, dt))
+ me%m_contaminant = me%reactor%contaminant
+ if (me%volume > 0.0_dp) then
+ me%C_dissolved = me%m_contaminant%m_dissolved / me%volume
+ else
+ me%C_dissolved = 0.0_dp
end if
+ end if
- ! Concentrations
- me%C_spm = divideCheckZero(me%m_spm, me%volume)
- me%C_np = divideCheckZero(me%m_np, me%volume)
- me%C_transformed = divideCheckZero(me%m_transformed, me%volume)
- me%C_dissolved = divideCheckZero(me%m_dissolved, me%volume)
+ do i = 1, me%nBiota
+ call rslt%addErrors(.errors. me%biota(i)%update(t, me%m_contaminant%divideCheckZero(me%volume)))
end do
- ! Transform the NPs. TODO: Should this be done before or after settling/resuspension?
- ! TODO for the moment, ignoring heteroaggregation if no volume, need to figure out
- ! what to really do if there are no flows
- if (.not. isZero(me%volume)) then
- call rslt%addErrors([ &
- .errors. me%reactor%update( &
- t, &
- me%m_np, &
- me%m_transformed, &
- me%m_dissolved, &
- me%C_spm, &
- T_water_t, &
- me%W_settle_np, &
- me%W_settle_spm, &
- DATASET%shearRate, &
- me%volume &
- ) &
- ])
- ! Get the resultant transformed mass from the Reactor
- me%m_np = me%reactor%m_np
- me%m_transformed = me%reactor%m_transformed
- me%m_dissolved = me%reactor%m_dissolved
+ call me%finaliseUpdate()
+
+ call rslt%addToTrace("Updating " // trim(me%ref) // " on timestep #" // trim(str(t)))
+ call LOGR%toFile(errors = .errors. rslt)
+ call ERROR_HANDLER%trigger(errors = .errors. rslt)
+ end subroutine
+
+ subroutine updateDisplacementEstuaryReach(me, t, d, dt, dQ_in, dj_spm_erosion, dj_spm_inflow, &
+ dj_contaminant_erosion_sources, dj_contaminant_inflow, T_water)
+ class(EstuaryReach), intent(inout) :: me
+ integer, intent(in) :: t, d
+ real(dp), intent(in) :: dt, dQ_in
+ real(dp), intent(in) :: dj_spm_erosion(:), dj_spm_inflow(:)
+ type(Contaminant), intent(in) :: dj_contaminant_erosion_sources, dj_contaminant_inflow
+ real(dp), intent(in) :: T_water
+ real(dp) :: dQ_out, changeInVolume
+ real(dp) :: dj_spm_out(C%nSizeClassesSpm)
+ type(Contaminant) :: dj_contaminant_out
+ real(dp) :: dj_spm_in(C%nSizeClassesSpm)
+ type(Contaminant) :: dj_contaminant_in
+ real(dp) :: dj_spm_deposit(C%nSizeClassesSpm), dj_spm_resus(C%nSizeClassesSpm)
+ real(dp) :: dj_spm_deposit_perArea(C%nSizeClassesSpm), dj_spm_resus_perArea(C%nSizeClassesSpm)
+ real(dp) :: tmp_dj_spm_resus_perArea(C%nSizeClassesSpm)
+ type(Contaminant) :: dj_contaminant_deposit, dj_contaminant_resus
+ type(Result) :: rslt
+ type(Result0D) :: res_contaminant
+ type(Contaminant) :: m_contaminant
+
+ call rslt%addErrors(.errors. dj_contaminant_out%create())
+ call rslt%addErrors(.errors. dj_contaminant_in%create())
+ call rslt%addErrors(.errors. dj_contaminant_deposit%create())
+ call rslt%addErrors(.errors. dj_contaminant_resus%create())
+
+ call me%setDimensions((t-1)*C%timeStep/3600 + d*(int(dt)/3600))
+ changeInVolume = me%changeInVolume((t-1)*24 + (d-1)*(int(dt)/3600), (t-1)*24 + d*(int(dt)/3600))
+ dQ_out = -dQ_in + changeInVolume
+ call me%setResuspensionRate(abs(dQ_out) / dt, T_water)
+
+ if (dQ_out < 0 .and. .not. isZero(me%volume)) then
+ dj_spm_out = max(me%m_spm * dQ_out / me%volume, -me%m_spm)
+ call dj_contaminant_out%multiply_scalar(me%m_contaminant, dQ_out / me%volume)
+ dj_spm_in = dj_spm_erosion + dj_spm_inflow
+ call dj_contaminant_in%add(dj_contaminant_erosion_sources)
+ call dj_contaminant_in%add(dj_contaminant_inflow)
+ else if (dQ_out > 0 .and. associated(me%outflow%item)) then
+ dj_spm_out = min(me%outflow%item%C_spm_final * dQ_out, me%outflow%item%m_spm / me%outflow%item%nInflows)
+ call dj_contaminant_out%multiply_scalar(me%outflow%item%m_contaminant, dQ_out / me%outflow%item%volume)
+ dj_spm_in = dj_spm_erosion + dj_spm_inflow - min(me%m_spm * dQ_out / me%volume, me%m_spm)
+ call dj_contaminant_in%add(dj_contaminant_erosion_sources)
+ call dj_contaminant_in%add(dj_contaminant_inflow)
+ call dj_contaminant_in%add_scaled(me%m_contaminant, -dQ_out / me%volume)
+ else
+ dj_spm_out = 0.0_dp
+ call dj_contaminant_out%multiply_scalar(me%m_contaminant, 0.0_dp)
+ dj_spm_in = dj_spm_erosion + dj_spm_inflow
+ call dj_contaminant_in%add(dj_contaminant_erosion_sources)
+ call dj_contaminant_in%add(dj_contaminant_inflow)
end if
- ! Set the final concentrations, checking that the river has a volume
- me%C_spm = divideCheckZero(me%m_spm, me%volume)
- me%C_np = divideCheckZero(me%m_np, me%volume)
- me%C_transformed = divideCheckZero(me%m_transformed, me%volume)
- me%C_dissolved = divideCheckZero(me%m_dissolved, me%volume)
+ me%m_spm = flushToZero(max(me%m_spm + dj_spm_in - dj_spm_out, 0.0_dp))
+ call me%m_contaminant%add(dj_contaminant_in)
+ call me%m_contaminant%add_scaled(dj_contaminant_out, -1.0_dp)
+
+ dj_spm_deposit = min(me%k_settle * dt * me%m_spm, me%m_spm)
+ dj_spm_resus = me%k_resus * me%bedSediment%Mf_bed_by_size() * dt
+
+ dj_spm_deposit_perArea = divideCheckZero(dj_spm_deposit, me%bedArea)
+ dj_spm_resus_perArea = divideCheckZero(dj_spm_resus, me%bedArea)
+ tmp_dj_spm_resus_perArea = dj_spm_resus_perArea
+
+ if (C%includeBedSediment) then
+ call rslt%addErrors(.errors. me%bedSediment%resuspend(tmp_dj_spm_resus_perArea))
+ dj_spm_resus_perArea = dj_spm_resus_perArea - tmp_dj_spm_resus_perArea
+ call rslt%addErrors(.errors. me%depositToBed(dj_spm_deposit_perArea))
+ if (.not. C%ignoreContaminant) then
+ call dj_contaminant_deposit%multiply_scalar(me%m_contaminant, sum(me%k_settle * dt))
+ res_contaminant = me%bedSediment%get_m_contaminant()
+ if (res_contaminant%hasError()) then
+ call rslt%addErrors(res_contaminant%getErrors())
+ call LOGR%toFile(errors = .errors. rslt)
+ call ERROR_HANDLER%trigger(errors = .errors. rslt)
+ return
+ end if
+ select type (data => res_contaminant%getData())
+ type is (Contaminant)
+ m_contaminant = data
+ class default
+ call rslt%addError(ErrorInstance(code=106, message="Invalid data type in Result0D"))
+ call LOGR%toFile(errors = .errors. rslt)
+ call ERROR_HANDLER%trigger(errors = .errors. rslt)
+ return
+ end select
+ call dj_contaminant_resus%multiply_scalar(m_contaminant, sum(me%k_resus * dt))
+ call rslt%addErrors(.errors. me%bedSediment%transferContaminant(dj_contaminant_deposit))
+ end if
+ end if
- ! Update the biota
- do i = 1, me%nBiota
- call rslt%addErrors(.errors. me%biota(i)%update( &
- t, &
- me%C_np, &
- me%C_transformed, &
- me%C_dissolved &
- ) &
- )
- end do
+ me%Q%outflow = me%Q%outflow + dQ_out
+ me%j_spm%outflow = me%j_spm%outflow + dj_spm_out
+ call me%j_contaminant_outflow%add(dj_contaminant_out)
+ me%j_spm%deposition = me%j_spm%deposition - dj_spm_deposit
+ me%j_spm%resuspension = me%j_spm%resuspension + dj_spm_resus
+ call me%j_contaminant_deposition%add_scaled(dj_contaminant_deposit, -1.0_dp)
+ call me%j_contaminant_resuspension%add(dj_contaminant_resus)
- ! Set the updated flag to true
- me%isUpdated = .true.
+ call dj_contaminant_out%finalise()
+ call dj_contaminant_in%finalise()
+ call dj_contaminant_deposit%finalise()
+ call dj_contaminant_resus%finalise()
- ! Add what we're doing here to the error trace and trigger any errors there are
+ call rslt%addToTrace("Updating time displacement #" // trim(str(d)))
call rslt%addToTrace("Updating " // trim(me%ref) // " on timestep #" // trim(str(t)))
call LOGR%toFile(errors = .errors. rslt)
call ERROR_HANDLER%trigger(errors = .errors. rslt)
end subroutine
-
- !> Set the dimensions (width, depth, area, volume) of the reach
subroutine setDimensions(me, tHours)
- class(EstuaryReach) :: me
- integer :: tHours
-
- ! Calculate actual depth based on these and number of hours through model run
+ class(EstuaryReach), intent(inout) :: me
+ integer, intent(in) :: tHours
me%depth = me%calculateDepth(tHours)
- me%xsArea = me%depth*me%width ! Calculate the cross-sectional area of the reach [m2]
- me%bedArea = me%width*me%length*me%f_m ! Calculate the BedSediment area [m2]
- me%surfaceArea = me%bedArea ! TODO maybe alter this for estuaries to make non-rectangular
- me%volume = me%depth*me%width*me%length*me%f_m ! Reach volume
+ me%xsArea = me%depth * me%width
+ me%bedArea = me%width * me%length * me%f_m
+ me%surfaceArea = me%bedArea
+ me%volume = me%depth * me%width * me%length * me%f_m
end subroutine
-
- function changeInVolume(me, tStart, tFinal)
- class(EstuaryReach) :: me
- integer :: tStart !! Initial time [hours]
- integer :: tFinal !! Final time [hours]
- real(dp) :: changeInVolume !! Change in reach volume between `tStart` and `tFinal`
- changeInVolume = (me%calculateDepth(tFinal) - me%calculateDepth(tStart))*me%width*me%length*me%f_m
+ function changeInVolume(me, tStart, tFinal) result(volChange)
+ class(EstuaryReach), intent(in) :: me
+ integer, intent(in) :: tStart, tFinal
+ real(dp) :: volChange
+ volChange = (me%calculateDepth(tFinal) - me%calculateDepth(tStart)) * &
+ me%width * me%length * me%f_m
end function
-
- !> Parse input data for this EstuaryReach and store in state variables.
function parseInputDataEstuaryReach(me) result(rslt)
- class(EstuaryReach) :: me
+ class(EstuaryReach), intent(inout) :: me
type(Result) :: rslt
- integer :: i ! Loop iterator
- integer, allocatable :: inflowArray(:,:) ! Temporary array for storing inflows from data file in
- ! Calculate the distance to the estuary mouth from data
- me%distanceToMouth = me%calculateDistanceToMouth( &
- DATASET%x(me%x), &
- DATASET%y(me%y), &
- DATASET%estuaryMeanderingFactor, &
- DATASET%estuaryMouthCoords(1), &
- DATASET%estuaryMouthCoords(2) &
- )
- ! Width, as exponential function of distance from mouth, unless specified in data
+ me%distanceToMouth = me%calculateDistanceToMouth(DATASET%x(me%x), DATASET%y(me%y), &
+ DATASET%estuaryMeanderingFactor, &
+ DATASET%estuaryMouthCoords(1), &
+ DATASET%estuaryMouthCoords(2))
me%width = DATASET%estuaryWidthExpA * exp(-DATASET%estuaryWidthExpB * me%distanceToMouth)
- ! Mean depth as exponential function of distance from mouth
me%meanDepth = DATASET%estuaryMeanDepthExpA * exp(-DATASET%estuaryMeanDepthExpB * me%distanceToMouth)
- ! if (allocated(me%domainOutflow)) me%isDomainOutflow = .true. ! If we managed to set domainOutflow, then this reach is one
me%f_m = DATASET%estuaryMeanderingFactor
me%alpha_hetero = DATASET%estuaryAttachmentEfficiency
me%alpha_resus = DATASET%resuspensionAlpha(me%x, me%y)
@@ -479,64 +341,59 @@ function parseInputDataEstuaryReach(me) result(rslt)
me%b_stc = DATASET%sedimentTransport_b(me%x, me%y)
me%c_stc = DATASET%sedimentTransport_c(me%x, me%y)
me%T_water = DATASET%waterTemperature
- ! Parse the input data to get inflows and outflow arrays. Pointers to reaches won't be
- ! set until all reaches created
- call rslt%addErrors( &
- .errors. me%parseInflowsAndOutflow() &
- )
- ! Now we've got inflows and outflows, we can set reach length, assuming one reach per branch
+ call rslt%addErrors(.errors. me%parseInflowsAndOutflow())
call me%setReachLengthAndSlope()
-
- call rslt%addToTrace('Parsing input data') ! Add this procedure to the trace
+ call rslt%addToTrace('Parsing input data')
end function
- !> Estimate the distance of the point (x,y) to the estuary mouth assuming the straight
- !! line distance mutiplied by a meandering factor.
function calculateDistanceToMouth(me, x, y, f, x_mouth, y_mouth) result(distanceToMouth)
- class(EstuaryReach) :: me !! This EstuaryReach instance
- real :: x !! x coordinate of cell to calculate distance to mouth of
- real :: y !! y coordinate of cell to calculate distance to mouth of
- real :: f !! Meandering factor
- real :: x_mouth !! x coordinate of estuary mouth
- real :: y_mouth !! y coordinate of estuary mouth
- real :: distanceToMouth !! The calculated distance to the estuary mouth
+ class(EstuaryReach), intent(in) :: me
+ real, intent(in) :: x, y, f, x_mouth, y_mouth
+ real :: distanceToMouth
distanceToMouth = f * sqrt((x_mouth - x)**2 + (y_mouth - y)**2)
end function
- !> Calculate water depth from tidal harmonics.
- !! $$
- !! D(x,t) = A_{S2} \cos \left( 2\pi \frac{t}{12} \right) + A_{M2} \cos \left( 2\pi \frac{t}{12.42} \right) + /
- !! \frac{3}{4} \frac{xA_{M2}^2}{D_x (6.21 \times 3600) \sqrt{gD_x}} \cos(2\pi \frac{t}{6.21}) + z_0
- !! $$
- !! Ref: [Hardisty, 2007](https://doi.org/10.1002/9780470750889)
function calculateDepth(me, tHours) result(depth)
- class(EstuaryReach), intent(in) :: me !! The `EstuaryReach` instance.
- integer, intent(in) :: tHours !! The current timestep (in hours)
+ class(EstuaryReach), intent(in) :: me
+ integer, intent(in) :: tHours
real(dp) :: depth
-
- depth = DATASET%estuaryTidalS2 * cos(2.0_dp*C%pi*tHours/12.0_dp) + DATASET%estuaryTidalM2 &
- * cos(2.0_dp*C%pi*tHours/12.42_dp) + (0.75_dp) * ((me%distanceToMouth * DATASET%estuaryTidalM2 ** 2) &
- / (me%meanDepth * 22356.0_dp * sqrt(9.81_dp * me%meanDepth))) &
- * cos(2*C%pi*tHours/6.21_dp) + me%meanDepth
- ! If the depth is negative (which it really shouldn't be...), set it to zero
+ depth = DATASET%estuaryTidalS2 * cos(2.0_dp*C%pi*tHours/12.0_dp) + &
+ DATASET%estuaryTidalM2 * cos(2.0_dp*C%pi*tHours/12.42_dp) + &
+ (0.75_dp) * ((me%distanceToMouth * DATASET%estuaryTidalM2 ** 2) / &
+ (me%meanDepth * 22356.0_dp * sqrt(9.81_dp * me%meanDepth))) * &
+ cos(2*C%pi*tHours/6.21_dp) + me%meanDepth
if (depth < 0) depth = 0.0_dp
end function
- !> Calculate the velocity of the river:
- !! $$
- !! v = \frac{Q}{WD}
- !! $$
function calculateVelocity(me, D, Q, W) result(v)
- class(EstuaryReach), intent(in) :: me !! This `EstuaryReach` instance
- real(dp), intent(in) :: D !! River depth \( D \) [m]
- real(dp), intent(in) :: Q !! Flow rate \( Q \) [m**3/s]
- real(dp), intent(in) :: W !! River width \( W \) [m]
- real(dp) :: v !! The calculated velocity \( v \) [m/s]
+ class(EstuaryReach), intent(in) :: me
+ real(dp), intent(in) :: D, Q, W
+ real(dp) :: v
if (isZero(Q) .or. isZero(W) .or. isZero(D)) then
v = 0.0_dp
else
- v = Q/(W*D)
+ v = Q / (W * D)
end if
end function
+ subroutine finaliseEstuaryReach(me)
+ class(EstuaryReach), intent(inout) :: me
+ integer :: i
+ call me%WaterBody%finalise()
+ if (allocated(me%biota)) then
+ do i = 1, me%nBiota
+ call me%biota(i)%finalise()
+ end do
+ deallocate(me%biota)
+ end if
+ if (allocated(me%biotaIndices)) deallocate(me%biotaIndices)
+ if (allocated(me%bedSediment)) then
+ call me%bedSediment%finalise()
+ deallocate(me%bedSediment)
+ end if
+ if (allocated(me%reactor)) then
+ call me%reactor%finalise()
+ deallocate(me%reactor)
+ end if
+ end subroutine
end module
\ No newline at end of file
diff --git a/src/WaterBody/FlowModule.f90 b/src/WaterBody/FlowModule.f90
index 6c637ff..b8a9dc0 100644
--- a/src/WaterBody/FlowModule.f90
+++ b/src/WaterBody/FlowModule.f90
@@ -2,24 +2,46 @@
!! Separate types are provided for water, SPM, NM and dissolved species flows.
module FlowModule
use GlobalsModule, only: dp, C
+ use ContaminantModule
+ use ResultModule
+ use ErrorInstanceModule
+ use ErrorHandlerModule
+ use DataInputModule, only: DATASET
+ use LoggerModule, only: LOGR
implicit none
- !> The WaterFlows object stores information on water flows in and out of a reach.
+ type, public :: ContaminantFlows
+ type(Contaminant) :: inflow
+ type(Contaminant) :: soilErosion
+ type(Contaminant) :: bankErosion
+ type(Contaminant) :: transfers
+ type(Contaminant) :: demands
+ type(Contaminant) :: deposition
+ type(Contaminant) :: resuspension
+ type(Contaminant) :: outflow
+ type(Contaminant) :: pointSources
+ type(Contaminant) :: diffuseSources
+ contains
+ procedure :: init => initContaminantFlows
+ procedure :: empty => emptyContaminantFlows
+ procedure :: asArray => asArrayContaminantFlows
+ end type
+
type, public :: WaterFlows
real(dp) :: inflow
real(dp) :: runoff
real(dp) :: transfers
real(dp) :: demands
real(dp) :: outflow
- contains
+ contains
procedure :: init => initWaterFlows
procedure :: empty => emptyWaterFlows
+ procedure :: addInflow => addInflowWaterFlows
procedure :: asArray => asArrayWaterFlows
procedure :: assignWaterFlows
generic :: assignment(=) => assignWaterFlows
end type
- !> The SPMFlows object stores information on SPM flows in and out of a reach.
type, public :: SPMFlows
real(dp), allocatable :: inflow(:)
real(dp), allocatable :: soilErosion(:)
@@ -29,92 +51,110 @@ module FlowModule
real(dp), allocatable :: deposition(:)
real(dp), allocatable :: resuspension(:)
real(dp), allocatable :: outflow(:)
- contains
+ contains
procedure :: init => initSPMFlows
procedure :: empty => emptySPMFlows
+ procedure :: addInflow => addInflowSPMFlows
procedure :: asArray => asArraySPMFlows
procedure :: assignSPMFlows
generic :: assignment(=) => assignSPMFlows
end type
- !> The NMFlows object stores information on NM flows in and out of a reach.
- type, public :: NMFlows
- real(dp), allocatable :: inflow(:,:,:)
- real(dp), allocatable :: soilErosion(:,:,:)
- real(dp), allocatable :: bankErosion(:,:,:)
- real(dp), allocatable :: transfers(:,:,:)
- real(dp), allocatable :: demands(:,:,:)
- real(dp), allocatable :: deposition(:,:,:)
- real(dp), allocatable :: resuspension(:,:,:)
- real(dp), allocatable :: outflow(:,:,:)
- real(dp), allocatable :: pointSources(:,:,:)
- real(dp), allocatable :: diffuseSources(:,:,:)
- contains
- procedure :: init => initNMFlows
- procedure :: empty => emptyNMFlows
- procedure :: asArray => asArrayNMFlows
- procedure :: assignNMFlows
- generic :: assignment(=) => assignNMFlows
- end type
+contains
+
+ subroutine initContaminantFlows(me)
+ class(ContaminantFlows), intent(inout) :: me
+ type(Result) :: r
+ call r%addErrors(.errors. me%inflow%create())
+ call r%addErrors(.errors. me%soilErosion%create())
+ call r%addErrors(.errors. me%bankErosion%create())
+ call r%addErrors(.errors. me%transfers%create())
+ call r%addErrors(.errors. me%demands%create())
+ call r%addErrors(.errors. me%deposition%create())
+ call r%addErrors(.errors. me%resuspension%create())
+ call r%addErrors(.errors. me%outflow%create())
+ call r%addErrors(.errors. me%pointSources%create())
+ call r%addErrors(.errors. me%diffuseSources%create())
+ end subroutine
- !> The DissolvedFlows object stores information on dissolved species flows in and out of a reach.
- type, public :: DissolvedFlows
- real(dp), allocatable :: inflow
- real(dp), allocatable :: transfers
- real(dp), allocatable :: demands
- real(dp), allocatable :: outflow
- real(dp), allocatable :: pointSources
- real(dp), allocatable :: diffuseSources
- contains
- procedure :: init => initDissolvedFlows
- procedure :: empty => emptyDissolvedFlows
- procedure :: asArray => asArrayDissolvedFlows
- procedure :: assignDissolvedFlows
- generic :: assignment(=) => assignDissolvedFlows
- end type
+ subroutine emptyContaminantFlows(me)
+ class(ContaminantFlows), intent(inout) :: me
+ call me%inflow%empty()
+ call me%soilErosion%empty()
+ call me%bankErosion%empty()
+ call me%transfers%empty()
+ call me%demands%empty()
+ call me%deposition%empty()
+ call me%resuspension%empty()
+ call me%outflow%empty()
+ call me%pointSources%empty()
+ call me%diffuseSources%empty()
+ end subroutine
- contains
+ ! Helper to verify mass balance if needed
+ function asArrayContaminantFlows(me) result(arr)
+ class(ContaminantFlows), intent(in) :: me
+ real(dp) :: arr(10)
+ ! Returns total mass (dissolved + particle) for each flow
+ arr(1) = sum_mass(me%inflow)
+ arr(2) = sum_mass(me%soilErosion)
+ arr(3) = sum_mass(me%bankErosion)
+ arr(4) = sum_mass(me%transfers)
+ arr(5) = sum_mass(me%demands)
+ arr(6) = sum_mass(me%deposition)
+ arr(7) = sum_mass(me%resuspension)
+ arr(8) = sum_mass(me%outflow)
+ arr(9) = sum_mass(me%pointSources)
+ arr(10)= sum_mass(me%diffuseSources)
+ contains
+ real(dp) function sum_mass(c)
+ type(Contaminant), intent(in) :: c
+ if (allocated(c%c)) then
+ sum_mass = sum(c%c) + c%m_dissolved
+ else
+ sum_mass = c%m_dissolved
+ end if
+ end function
+ end function
subroutine initWaterFlows(me)
- class(WaterFlows) :: me
+ class(WaterFlows), intent(inout) :: me
call me%empty()
end subroutine
- subroutine initSPMFlows(me)
- class(SPMFlows) :: me
- allocate(me%inflow(C%nSizeClassesSPM))
- allocate(me%soilErosion(C%nSizeClassesSPM))
- allocate(me%bankErosion(C%nSizeClassesSPM))
- allocate(me%transfers(C%nSizeClassesSPM))
- allocate(me%demands(C%nSizeClassesSPM))
- allocate(me%deposition(C%nSizeClassesSPM))
- allocate(me%resuspension(C%nSizeClassesSPM))
- allocate(me%outflow(C%nSizeClassesSPM))
- call me%empty()
+ subroutine addInflowWaterFlows(me, q_in)
+ class(WaterFlows), intent(inout) :: me
+ real(dp), intent(in) :: q_in
+ me%inflow = me%inflow + q_in
end subroutine
- subroutine initNMFlows(me)
- class(NMFlows) :: me
- allocate(me%inflow(C%npDim(1),C%npDim(2),C%npDim(3)))
- allocate(me%soilErosion(C%npDim(1),C%npDim(2),C%npDim(3)))
- allocate(me%bankErosion(C%npDim(1),C%npDim(2),C%npDim(3)))
- allocate(me%transfers(C%npDim(1),C%npDim(2),C%npDim(3)))
- allocate(me%demands(C%npDim(1),C%npDim(2),C%npDim(3)))
- allocate(me%deposition(C%npDim(1),C%npDim(2),C%npDim(3)))
- allocate(me%resuspension(C%npDim(1),C%npDim(2),C%npDim(3)))
- allocate(me%outflow(C%npDim(1),C%npDim(2),C%npDim(3)))
- allocate(me%pointSources(C%npDim(1),C%npDim(2),C%npDim(3)))
- allocate(me%diffuseSources(C%npDim(1),C%npDim(2),C%npDim(3)))
+ subroutine initSPMFlows(me)
+ class(SPMFlows), intent(inout) :: me
+ allocate(me%inflow(C%nSizeClassesSpm))
+ allocate(me%soilErosion(C%nSizeClassesSpm))
+ allocate(me%bankErosion(C%nSizeClassesSpm))
+ allocate(me%transfers(C%nSizeClassesSpm))
+ allocate(me%demands(C%nSizeClassesSpm))
+ allocate(me%deposition(C%nSizeClassesSpm))
+ allocate(me%resuspension(C%nSizeClassesSpm))
+ allocate(me%outflow(C%nSizeClassesSpm))
call me%empty()
end subroutine
- subroutine initDissolvedFlows(me)
- class(DissolvedFlows) :: me
- call me%empty()
+ subroutine addInflowSPMFlows(me, j_in)
+ class(SPMFlows), intent(inout) :: me
+ real(dp), intent(in) :: j_in(:)
+ type(ErrorInstance) :: err(1)
+ if (size(j_in) /= C%nSizeClassesSpm) then
+ err(1) = ErrorInstance(code=900, message="Size mismatch in SPMFlows addInflow")
+ call LOGR%toFile(errors=err)
+ error stop "Critical error in addInflowSPMFlows"
+ end if
+ me%inflow = me%inflow + j_in
end subroutine
subroutine emptyWaterFlows(me)
- class(WaterFlows) :: me
+ class(WaterFlows), intent(inout) :: me
me%inflow = 0.0_dp
me%runoff = 0.0_dp
me%transfers = 0.0_dp
@@ -123,50 +163,26 @@ subroutine emptyWaterFlows(me)
end subroutine
subroutine emptySPMFlows(me)
- class(SPMFlows) :: me
- me%inflow = 0.0_dp
- me%soilErosion = 0.0_dp
- me%bankErosion = 0.0_dp
- me%transfers = 0.0_dp
- me%demands = 0.0_dp
- me%deposition = 0.0_dp
- me%resuspension = 0.0_dp
- me%outflow = 0.0_dp
- end subroutine
-
- subroutine emptyNMFlows(me)
- class(NMFlows) :: me
- me%inflow = 0.0_dp
- me%soilErosion = 0.0_dp
- me%bankErosion = 0.0_dp
- me%transfers = 0.0_dp
- me%demands = 0.0_dp
- me%deposition = 0.0_dp
- me%resuspension = 0.0_dp
- me%outflow = 0.0_dp
- me%pointSources = 0.0_dp
- me%diffuseSources = 0.0_dp
- end subroutine
-
- subroutine emptyDissolvedFlows(me)
- class(DissolvedFlows) :: me
- me%inflow = 0.0_dp
- me%transfers = 0.0_dp
- me%demands = 0.0_dp
- me%outflow = 0.0_dp
- me%diffuseSources = 0.0_dp
- me%pointSources = 0.0_dp
+ class(SPMFlows), intent(inout) :: me
+ if (allocated(me%inflow)) me%inflow = 0.0_dp
+ if (allocated(me%soilErosion)) me%soilErosion = 0.0_dp
+ if (allocated(me%bankErosion)) me%bankErosion = 0.0_dp
+ if (allocated(me%transfers)) me%transfers = 0.0_dp
+ if (allocated(me%demands)) me%demands = 0.0_dp
+ if (allocated(me%deposition)) me%deposition = 0.0_dp
+ if (allocated(me%resuspension)) me%resuspension = 0.0_dp
+ if (allocated(me%outflow)) me%outflow = 0.0_dp
end subroutine
function asArrayWaterFlows(me) result(arr)
- class(WaterFlows) :: me
- real(dp) :: arr(5)
+ class(WaterFlows), intent(in) :: me
+ real(dp) :: arr(5)
arr = [me%inflow, me%runoff, me%transfers, me%demands, me%outflow]
end function
function asArraySPMFlows(me) result(arr)
- class(SPMFlows) :: me
- real(dp) :: arr(8,C%nSizeClassesSpm)
+ class(SPMFlows), intent(in) :: me
+ real(dp) :: arr(8,C%nSizeClassesSpm)
arr(1,:) = me%inflow
arr(2,:) = me%soilErosion
arr(3,:) = me%bankErosion
@@ -177,30 +193,9 @@ function asArraySPMFlows(me) result(arr)
arr(8,:) = me%outflow
end function
- function asArrayNMFlows(me) result(arr)
- class(NMFlows) :: me
- real(dp) :: arr(10,C%npDim(1),C%npDim(2),C%npDim(3))
- arr(1,:,:,:) = me%inflow
- arr(2,:,:,:) = me%soilErosion
- arr(3,:,:,:) = me%bankErosion
- arr(4,:,:,:) = me%transfers
- arr(5,:,:,:) = me%demands
- arr(6,:,:,:) = me%deposition
- arr(7,:,:,:) = me%resuspension
- arr(8,:,:,:) = me%outflow
- arr(9,:,:,:) = me%pointSources
- arr(10,:,:,:) = me%diffuseSources
- end function
-
- function asArrayDissolvedFlows(me) result(arr)
- class(DissolvedFlows) :: me
- real(dp) :: arr(6)
- arr = [me%inflow, me%transfers, me%demands, me%outflow, me%pointSources, me%diffuseSources]
- end function
-
subroutine assignWaterFlows(obj, arr)
- class(WaterFlows), intent(out) :: obj
- real(dp), intent(in) :: arr(5)
+ class(WaterFlows), intent(out) :: obj
+ real(dp), intent(in) :: arr(5)
obj%inflow = arr(1)
obj%runoff = arr(2)
obj%transfers = arr(3)
@@ -209,8 +204,8 @@ subroutine assignWaterFlows(obj, arr)
end subroutine
subroutine assignSPMFlows(obj, arr)
- class(SPMFlows), intent(out) :: obj
- real(dp), intent(in) :: arr(8,C%nSizeClassesSpm)
+ class(SPMFlows), intent(out) :: obj
+ real(dp), intent(in) :: arr(8,C%nSizeClassesSpm)
obj%inflow = arr(1,:)
obj%soilErosion = arr(2,:)
obj%bankErosion = arr(3,:)
@@ -220,31 +215,4 @@ subroutine assignSPMFlows(obj, arr)
obj%resuspension = arr(7,:)
obj%outflow = arr(8,:)
end subroutine
-
- subroutine assignNMFlows(obj, arr)
- class(NMFlows), intent(out) :: obj
- real(dp), intent(in) :: arr(10,C%npDim(1),C%npDim(2),C%npDim(3))
- obj%inflow = arr(1,:,:,:)
- obj%soilErosion = arr(2,:,:,:)
- obj%bankErosion = arr(3,:,:,:)
- obj%transfers = arr(4,:,:,:)
- obj%demands = arr(5,:,:,:)
- obj%deposition = arr(6,:,:,:)
- obj%resuspension = arr(7,:,:,:)
- obj%outflow = arr(8,:,:,:)
- obj%pointSources = arr(9,:,:,:)
- obj%diffuseSources = arr(10,:,:,:)
- end subroutine
-
- subroutine assignDissolvedFlows(obj, arr)
- class(DissolvedFlows), intent(out) :: obj
- real(dp), intent(in) :: arr(6)
- obj%inflow = arr(1)
- obj%transfers = arr(2)
- obj%demands = arr(3)
- obj%outflow = arr(4)
- obj%pointSources = arr(5)
- obj%diffuseSources = arr(6)
- end subroutine
-
end module
\ No newline at end of file
diff --git a/src/WaterBody/ReachModule.f90 b/src/WaterBody/ReachModule.f90
index 9c605de..452c55f 100644
--- a/src/WaterBody/ReachModule.f90
+++ b/src/WaterBody/ReachModule.f90
@@ -6,7 +6,8 @@ module ReachModule
use WaterBodyModule
use netcdf
use DataInputModule, only: DATASET
- use DefaultsModule, only: defaultSlope
+ use ConstantsDefaultsModule, only: defaultSlope
+ use ContaminantModule
implicit none
!> `ReachPointer` used for `Reach` inflows array, so the elements within can
@@ -67,7 +68,7 @@ module ReachModule
! Getters
procedure :: Q_outflow_final => Q_outflow_finalReach
procedure :: j_spm_outflow_final => j_spm_outflow_finalReach
- procedure :: j_np_outflow_final => j_np_outflow_finalReach
+ procedure :: j_contaminant_outflow_final => j_contaminant_outflow_finalReach
procedure :: Q_outflow
procedure :: Q_inflows
procedure :: Q_runoff
@@ -77,20 +78,14 @@ module ReachModule
procedure :: j_spm_runoff
procedure :: j_spm_transfers
procedure :: j_spm_deposit
- procedure :: j_np_outflow
- procedure :: j_np_inflows
- procedure :: j_np_runoff
- procedure :: j_np_transfer
- procedure :: j_np_deposit
- procedure :: j_np_diffusesource
- procedure :: j_np_pointsource
- procedure :: j_transformed_outflow
- procedure :: j_transformed_deposit
- procedure :: j_transformed_diffusesource
- procedure :: j_transformed_pointsource
- procedure :: j_dissolved_outflow
- procedure :: j_dissolved_diffusesource
- procedure :: j_dissolved_pointsource
+ procedure :: get_j_contaminant_outflow => j_contaminant_outflow
+ procedure :: get_j_contaminant_inflows => j_contaminant_inflows
+ procedure :: get_j_contaminant_runoff => j_contaminant_runoff
+ procedure :: get_j_contaminant_transfer => j_contaminant_transfer
+ procedure :: get_j_contaminant_deposit => j_contaminant_deposit
+ procedure :: get_j_contaminant_diffusesource => j_contaminant_diffusesource
+ procedure :: get_j_contaminant_pointsource => j_contaminant_pointsource
+ procedure :: finalise => finaliseReach
end type
!> Container type for `class(Reach)`, the actual type of the `Reach` class.
@@ -104,54 +99,134 @@ module ReachModule
!> Allocate memory for arrays and set any initial values
subroutine allocateAndInitialiseReach(me)
- class(Reach) :: me !! This Reach instance
+ class(Reach), intent(inout) :: me
+ type(Result) :: r
+
! WaterBody initialises the variables common to all water bodies
call me%WaterBody%allocateAndInitialise()
- ! Defaults
+
+ ! Environment defaults
me%n = C%n_river
+
+ ! Main WATER contaminant state (sizes, rates, etc.)
+ call r%addErrors(.errors. me%m_contaminant%create_from_data( &
+ 'water', &
+ DATASET%contaminantDensity, &
+ DATASET%soilConstantAttachmentEfficiency, &
+ DATASET%riverAttachmentEfficiency, &
+ DATASET%estuaryAttachmentEfficiency, &
+ DATASET%contaminant_k_diss_pristine, &
+ DATASET%contaminant_k_diss_transformed, &
+ DATASET%contaminant_k_transform_pristine, &
+ DATASET%waterTemperature(C%startDate%yearday()) &
+ ))
+
+ ! Zero/construct ALL contaminant flux containers so getters are safe
+ call r%addErrors(.errors. me%j_contaminant_inflow%create())
+ call r%addErrors(.errors. me%j_contaminant_runoff%create())
+ call r%addErrors(.errors. me%j_contaminant_transfers%create())
+ call r%addErrors(.errors. me%j_contaminant_deposition%create())
+ call r%addErrors(.errors. me%j_contaminant_resuspension%create())
+ call r%addErrors(.errors. me%j_contaminant_outflow%create())
+ call r%addErrors(.errors. me%j_contaminant_final%create())
+
+ if (r%hasCriticalError()) call ERROR_HANDLER%trigger(errors=.errors.r)
+ end subroutine
+
+
+ subroutine finaliseReach(me)
+ class(Reach), intent(inout) :: me
+ call me%WaterBody%finalise()
+ if (allocated(me%inflowsArr)) deallocate(me%inflowsArr)
+ if (allocated(me%inflows)) deallocate(me%inflows)
+ if (allocated(me%domainOutflow)) deallocate(me%domainOutflow)
end subroutine
!> Parse the input data for this reach. This function is called at the start of every
!! chunk for batch runs.
subroutine parseNewBatchDataReach(me)
- class(Reach) :: me
-
+ class(Reach), intent(inout) :: me
end subroutine
!> Set the settling rate [/s]
subroutine setSettlingRateReach(me, T_water_t)
class(Reach) :: me !! This `Reach` instance
- real :: T_water_t !! Water temperature on this timestep
+ real(dp) :: T_water_t !! Water temperature on this timestep
integer :: i ! Size class iterator
+ ! Local holders for depositional parameters
+ real(dp) :: alphaDepVal, betaDepVal
+ logical :: haveAlpha, haveBeta
+ integer :: nxA, nyA, nxB, nyB
+
+ ! Deposition calibration parameters, with grid->scalar fallback. Note that these
+ ! spatial variables use (x,y) indexing (they aren't transposed when retrieved from
+ ! the NetCDF file), in contrast to the soil spatial variables - see DataInputModule.
+ ! The scalar fallback is the value from the constants namelist, which itself defaults
+ ! to defaultDepositionAlpha/Beta if not supplied.
+ haveAlpha = .false.
+ if (allocated(DATASET%depositionAlpha)) then
+ nxA = size(DATASET%depositionAlpha, 1)
+ nyA = size(DATASET%depositionAlpha, 2)
+ if (me%x >= 1 .and. me%y >= 1 .and. me%x <= nxA .and. me%y <= nyA) then
+ alphaDepVal = DATASET%depositionAlpha(me%x, me%y)
+ haveAlpha = .true.
+ end if
+ end if
+ if (.not. haveAlpha) alphaDepVal = DATASET%depositionAlphaConstant
+
+ haveBeta = .false.
+ if (allocated(DATASET%depositionBeta)) then
+ nxB = size(DATASET%depositionBeta, 1)
+ nyB = size(DATASET%depositionBeta, 2)
+ if (me%x >= 1 .and. me%y >= 1 .and. me%x <= nxB .and. me%y <= nyB) then
+ betaDepVal = DATASET%depositionBeta(me%x, me%y)
+ haveBeta = .true.
+ end if
+ end if
+ if (.not. haveBeta) betaDepVal = DATASET%depositionBetaConstant
if (.not. isZero(me%depth)) then
! SPM: Loop through the size classes and calculate settling velocity
- ! TODO make calculateSettlingVelocity an elemental function
do i = 1, C%nSizeClassesSpm
me%W_settle_spm(i) = me%calculateSettlingVelocity( &
- C%d_spm(i), &
- DATASET%spmDensityBySizeClass(i), & ! Average of the fractional comps. TODO: Change to work with actual fractional comps.
- T_water_t, &
- alphaDep=DATASET%depositionAlpha(me%x, me%y), &
- betaDep=DATASET%depositionBeta(me%x, me%y) &
+ d = C%d_spm(i), &
+ rho_particle = DATASET%spmDensityBySizeClass(i), &
+ T = T_water_t, &
+ alphaDep = alphaDepVal, &
+ betaDep = betaDepVal &
)
end do
me%k_settle = me%W_settle_spm / me%depth
- ! NP: Calculate this to pass to Reactor
- do i = 1, C%nSizeClassesNM
- me%W_settle_np(i) = me%calculateSettlingVelocity( &
- C%d_nm(i), &
- DATASET%nmDensity, &
- T_water_t, &
- alphaDep=DATASET%depositionAlpha(me%x, me%y), &
- betaDep=DATASET%depositionBeta(me%x, me%y) &
- )
- end do
+ ! ---------------------------------------------------------
+ ! [FIXED CODE START] Calculate Contaminant Settling Velocity
+ ! ---------------------------------------------------------
+ ! W_settle_contaminant is a 1D array for the intrinsic (Free) particle velocity.
+ ! Attached forms settle with the SPM, handled in transport routines.
+
+ if (allocated(me%m_contaminant%W_settle_contaminant)) then
+ do i = 1, C%nContaminantSizeClasses
+ ! Corrected: removed (i, FREE_CONTAMINANT), using (i)
+ me%m_contaminant%W_settle_contaminant(i) = &
+ me%calculateSettlingVelocity( &
+ d = DATASET%contaminantSizeClasses(i), &
+ rho_particle = DATASET%contaminantDensity, &
+ T = T_water_t, &
+ alphaDep = alphaDepVal, &
+ betaDep = betaDepVal &
+ )
+ end do
+ end if
+ ! ---------------------------------------------------------
+ ! [FIXED CODE END]
+ ! ---------------------------------------------------------
+
else
+ ! Zero depth handling
me%W_settle_spm = 0.0_dp
- me%W_settle_np = 0.0_dp
- me%k_settle = 0.0_dp
+ me%k_settle = 0.0_dp
+ if (allocated(me%m_contaminant%W_settle_contaminant)) &
+ me%m_contaminant%W_settle_contaminant = 0.0_dp
end if
end subroutine
@@ -198,75 +273,107 @@ function scaleErosionBySedimentTransportCapacityReach(me, erosionYield, q_overla
!> Get the inflows from point and diffuse sources for this timestep
subroutine updateSourcesReach(me, t)
- class(Reach) :: me !! This SoilProfile instance
- integer :: t !! This timestep index
- integer :: i !! Iterator for sources
+ class(Reach) :: me !! This Reach instance
+ integer :: t !! This timestep index
+ integer :: i !! Iterator for sources
! Diffuse sources converted from kg/m2/timestep to kg/reach/timestep
do i = 1, me%nDiffuseSources
call me%diffuseSources(i)%update(t)
- me%j_nm%diffuseSources = me%j_nm%diffuseSources + me%diffuseSources(i)%j_np_diffuseSource * me%surfaceArea
- me%j_nm_transformed%diffuseSources = me%j_nm_transformed%diffuseSources &
- + me%diffuseSources(i)%j_transformed_diffuseSource * me%surfaceArea
- me%j_dissolved%diffuseSources = me%j_dissolved%diffuseSources &
- + me%diffuseSources(i)%j_dissolved_diffuseSource * me%surfaceArea
+ call me%j_contaminant_diffuseSources%add_scaled(me%diffuseSources(i)%j_contaminant, me%surfaceArea)
end do
! Point sources are kg/point
do i = 1, me%nPointSources
call me%pointSources(i)%update(t)
- me%j_nm%pointSources = me%j_nm%pointSources + me%pointSources(i)%j_np_pointSource
- me%j_nm_transformed%pointSources = me%j_nm_transformed%pointSources &
- + me%pointSources(i)%j_transformed_pointSource
- me%j_dissolved%pointSources = me%j_dissolved%pointSources &
- + me%pointSources(i)%j_dissolved_pointSource
- end do
+ call me%j_contaminant_pointSources%add(me%pointSources(i)%j_contaminant_pointSource)
+ end do
end subroutine
!> Set the sediment yields from soil and bank erosion, and distribute correctly
!! across size classes
- subroutine setErosionYieldsReach(me, soilErosionYield, q_overland, contributingArea, NMYield, NMTransformedYield)
- class(Reach) :: me !! This reach
- real(dp) :: soilErosionYield(C%nSizeClassesSPM) !! Soil erosion yield from the soil profile [kg/timestep]
- real(dp) :: q_overland !! Overland flow [m3/m2/timestep]
- real(dp) :: contributingArea !! Contributing area to this reach [m2]
- real(dp) :: NMYield(C%npDim(1), C%npDim(2), C%npDim(3)) !! NM yield from soil erosion [kg/timestep]
- real(dp) :: NMTransformedYield(C%npDim(1), C%npDim(2), C%npDim(3)) !! NM yield from soil erosion [kg/timestep]
- real(dp) :: ratio ! Ratio of unscaled to scaled, to scale NM by
+ subroutine setErosionYieldsReach(me, soilErosionYield, q_overland, contributingArea, contaminantYield)
+ class(Reach) :: me !! This reach
+ real(dp) :: soilErosionYield(:) !! Soil erosion yield from the soil profile [kg/timestep]
+ real(dp) :: q_overland !! Overland flow [m3/m2/timestep]
+ real(dp) :: contributingArea !! Contributing area to this reach [m2]
+ type(Contaminant) :: contaminantYield !! Contaminant yield from soil erosion [kg/timestep]
+ real(dp) :: ratio ! Ratio of unscaled to scaled, to scale Contaminant by
+ logical :: haveAlpha, haveBeta
+ integer :: nxA, nyA, nxB, nyB
+ real(dp) :: alpha_bank_val, beta_bank_val
+
! We need to use the sediment transport capacity to scale eroded sediment. Sediment transport
! capacity is stored in me%sedimentTransportCapacity and has units of kg/m2/timestep
me%j_spm%soilErosion = me%scaleErosionBySedimentTransportCapacity(soilErosionYield, q_overland, contributingArea)
ratio = divideCheckZero(sum(me%j_spm%soilErosion), sum(soilErosionYield))
- me%j_nm%soilErosion = flushToZero(ratio * NMYield)
- me%j_nm_transformed%soilErosion = flushToZero(ratio * NMTransformedYield)
- ! Calculate bank erosion rate, if we're meant to be modelling it
+ call me%j_contaminant_soilErosion%multiply_scalar(contaminantYield, ratio)
+
+ ! --- Bank erosion (defensive against missing/empty DATASET fields) ---
if (C%includeBankErosion) then
- ! Calculate bank erosion based on the flow and use the sediment distribution to split
- me%j_spm%bankErosion = me%calculateBankErosionRate( &
- abs(me%Q_in_total), &
- DATASET%bankErosionAlpha(me%x, me%y), &
- DATASET%bankErosionBeta(me%x, me%y), &
- me%length, &
- me%depth &
- ) * me%distributionSediment
+
+ haveAlpha = .false.; haveBeta = .false.
+
+ ! Alpha: check allocation and bounds
+ if (allocated(DATASET%bankErosionAlpha)) then
+ if (size(DATASET%bankErosionAlpha) > 0) then
+ nxA = size(DATASET%bankErosionAlpha, 1)
+ nyA = size(DATASET%bankErosionAlpha, 2)
+ if (me%x >= 1 .and. me%y >= 1 .and. me%x <= nxA .and. me%y <= nyA) then
+ alpha_bank_val = DATASET%bankErosionAlpha(me%x, me%y)
+ haveAlpha = .true.
+ end if
+ end if
+ end if
+
+ ! Beta: check allocation and bounds
+ if (allocated(DATASET%bankErosionBeta)) then
+ if (size(DATASET%bankErosionBeta) > 0) then
+ nxB = size(DATASET%bankErosionBeta, 1)
+ nyB = size(DATASET%bankErosionBeta, 2)
+ if (me%x >= 1 .and. me%y >= 1 .and. me%x <= nxB .and. me%y <= nyB) then
+ beta_bank_val = DATASET%bankErosionBeta(me%x, me%y)
+ haveBeta = .true.
+ end if
+ end if
+ end if
+
+ if (haveAlpha .and. haveBeta) then
+ ! Calculate bank erosion based on the flow and split across size classes
+ me%j_spm%bankErosion = me%calculateBankErosionRate( &
+ abs(me%Q_in_total), &
+ alpha_bank_val, &
+ beta_bank_val, &
+ me%length, &
+ me%depth &
+ ) * me%distributionSediment
+ else
+ ! Missing fields or out-of-bounds: safely disable bank erosion
+ me%j_spm%bankErosion = 0.0_dp
+ end if
else
- ! If we're not meant to be modelling bank erosion, then set it to zero
+ ! If we're not modelling bank erosion, set it to zero
me%j_spm%bankErosion = 0.0_dp
end if
end subroutine
!> Deposit SPM to the bed sediment, by passing a fine sediment object to the bed sediment object
function depositToBedReach(me, spmDep) result(rslt)
- class(Reach) :: me !! This Reach instance
- real(dp) :: spmDep(C%nSizeClassesSpm) !! The SPM to deposit [kg]
- type(Result) :: rslt !! The data object to return any errors in
- real(dp) :: spmDep_perArea(C%nSizeClassesSpm) ! The SPM to deposit, per unit area [kg/m2]
- type(Result0D) :: depositRslt !! Result from the bed sediment's deposit procedure
- real(dp) :: V_water_toDeposit !! Volume of water to deposit to bed sediment [m3/m2]
- type(FineSediment) :: fineSed(C%nSizeClassesSpm) ! FineSediment object to pass to BedSediment
- integer :: n ! Loop iterator
- ! Create the FineSediment object and add deposited SPM to it
- ! (converting units of Mf_in to kg/m2), then give that object
- ! to the BedSediment
+ class(Reach), intent(inout) :: me !! This Reach instance
+ real(dp), intent(in) :: spmDep(C%nSizeClassesSpm) !! The SPM to deposit [kg]
+ type(Result) :: rslt !! The data object to return any errors in
+
+ real(dp) :: spmDep_perArea(C%nSizeClassesSpm) ! The SPM to deposit, per unit area [kg/m2]
+ real(dp) :: spmRes_perArea(C%nSizeClassesSpm) ! The SPM resuspension, per unit area [kg/m2]
+ type(Result0D) :: depositRslt !! Result from the bed sediment's deposit procedure
+ real(dp) :: V_water_toDeposit !! Volume of water to deposit to bed sediment [m3/m2]
+ type(FineSediment) :: fineSed(C%nSizeClassesSpm) ! FineSediment object to pass to BedSediment
+ type(Contaminant) :: j_contam_per_area ! Temp object for flux per area
+ integer :: n ! Loop iterator
+ integer, parameter :: sp = kind(1.0) ! single precision kind for matching
+
+ ! Create the FineSediment object and add deposited SPM to it
+ ! (converting units of Mf_in to kg/m2), then give that object to the BedSediment
spmDep_perArea = divideCheckZero(spmDep, me%bedArea)
+
do n = 1, C%nSizeClassesSpm
call fineSed(n)%create("FS", C%nFracCompsSpm)
call fineSed(n)%set( &
@@ -274,24 +381,56 @@ function depositToBedReach(me, spmDep) result(rslt)
f_comp_in=real(DATASET%sedimentFractionalComposition, 8) &
)
end do
+
+ V_water_toDeposit = 0.0_dp
if (C%includeBedSediment) then
- ! Deposit the fine sediment to the bed sediment
- depositRslt = Me%bedSediment%deposit(fineSed)
+ ! 1. Deposit the physical fine sediment (SPM) to the bed sediment
+ depositRslt = me%bedSediment%deposit(fineSed)
call rslt%addErrors(.errors. depositRslt)
- if (rslt%hasCriticalError()) then
- return
+ if (rslt%hasCriticalError()) return
+
+ ! Safely extract the scalar from the 0D result
+ if (allocated(depositRslt%data)) then
+ select type (d => depositRslt%data)
+ type is (real(dp)); V_water_toDeposit = d
+ type is (real(sp)); V_water_toDeposit = real(d, dp)
+ class default; V_water_toDeposit = 0.0_dp
+ end select
end if
+
+ ! --------------------------------------------------------------------------
+ ! FIX: Transfer Contaminant to Bed Sediment
+ ! --------------------------------------------------------------------------
+
+ ! A. Update the Mass Transfer Coefficient Matrix
+ ! We need physical fluxes in [kg/m2].
+ ! spmDep_perArea is calculated above.
+ ! We assume me%j_spm%resuspension contains total resuspension mass [kg].
+ spmRes_perArea = divideCheckZero(me%j_spm%resuspension, me%bedArea)
+
+ call me%bedSediment%getmatrix(spmDep_perArea, spmRes_perArea)
+
+ ! B. Transfer the Contaminant Mass
+ ! BedSediment expects flux in [kg/m2] to match its internal state units.
+ ! me%j_contaminant_deposition is in [kg] (from Reactor volume).
+ call rslt%addErrors(.errors. j_contam_per_area%create())
+ call j_contam_per_area%add_scaled(me%j_contaminant_deposition, 1.0_dp / max(C%epsilon, me%bedArea))
+
+ call rslt%addErrors(.errors. me%bedSediment%transferContaminant(j_contam_per_area))
+
+ call j_contam_per_area%finalise()
+ ! --------------------------------------------------------------------------
+
end if
- ! TODO add error handling to line above as it causes a crash if there is a critical error in the called method
- ! Retrieve the amount of water to be taken from the reach
- V_water_toDeposit = .dp. depositRslt ! [m3/m2]
- ! Subtract that volume for the reach (as a depth). This doesn't have any effect on
- ! the model calculations, as the model recalculates depth depth on hydrology at the
- ! start of every timestep. However, it is this updated depth that is saved to data.
+
+ ! Clamp NaN / negative to zero
+ if (V_water_toDeposit /= V_water_toDeposit) V_water_toDeposit = 0.0_dp
+ if (V_water_toDeposit < 0.0_dp) V_water_toDeposit = 0.0_dp
+
+ ! Reduce reach depth by deposited water volume (may be zero)
me%depth = max(me%depth - V_water_toDeposit, 0.0_dp)
- ! Add any errors that occured in the deposit procedure
call rslt%addToTrace("Depositing SPM to BedSediment")
end function
@@ -300,7 +439,7 @@ function depositToBedReach(me, spmDep) result(rslt)
subroutine setResuspensionRateReach(me, Q, T_water_t)
class(Reach) :: me !! This `Reach` instance
real(dp) :: Q !! Flow rate to set resuspension rate based on [m/s]
- real :: T_water_t !! Water temperature on this timestep [deg C]
+ real(dp) :: T_water_t !! Water temperature on this timestep [deg C]
real(dp) :: d_max ! Maximum resuspendable particle size [m]
integer :: i ! Iterator
real(dp) :: M_prop(C%nSizeClassesSpm) ! Proportion of size class that can be resuspended [-]
@@ -312,7 +451,7 @@ subroutine setResuspensionRateReach(me, Q, T_water_t)
! Calculate maximum resuspendable particle size and proportion of each
! size class that can be resuspended. Changes on each timestep as dependent
! on river depth
- d_max = 9.994*sqrt(me%alpha_resus*C%g*me%depth*me%slope)**2.5208
+ d_max = 9.994*sqrt(me%alpha_resus*C%g*me%depth*me%slope)**2.5208
! Calculate proportion of each size class that can be resuspended
do i = 1, C%nSizeClassesSpm
! Calculate the proportion of size class that can be resuspended
@@ -330,12 +469,12 @@ subroutine setResuspensionRateReach(me, Q, T_water_t)
f_fr = 4 * me%depth / (me%width + 2 * me%depth)
! Set k_resus using the above [/s]
me%k_resus = me%calculateResuspension( &
- beta = me%beta_resus, &
- L = me%length*me%f_m, &
- W = me%width, &
- M_prop = M_prop, &
- omega = omega, &
- f_fr = f_fr &
+ beta=me%beta_resus, &
+ L=me%length*me%f_m, &
+ W=me%width, &
+ M_prop=M_prop, &
+ omega=omega, &
+ f_fr=f_fr &
)
else
me%k_resus = 0.0_dp ! If there's no inflow
@@ -358,22 +497,21 @@ subroutine setResuspensionRateReach(me, Q, T_water_t)
!! Reference: [Zhiyao et al, 2008](https://doi.org/10.1016/S1674-2370(15)30017-X).
function calculateSettlingVelocity(me, d, rho_particle, T, alphaDep, betaDep) result(W)
class(Reach), intent(in) :: me !! The `Reach` instance
- real, intent(in) :: d !! Sediment particle diameter [m]
- real, intent(in) :: rho_particle !! Sediment particulate density [kg/m3]
- real, intent(in) :: T !! Temperature [C]
- real, intent(in) :: alphaDep !! Alpha calibration parameter
- real, intent(in) :: betaDep !! Beta calibration parameter
+ real(dp), intent(in) :: d !! Sediment particle diameter [m]
+ real(dp), intent(in) :: rho_particle !! Sediment particulate density [kg/m3]
+ real(dp), intent(in) :: T !! Temperature [C]
+ real(dp), intent(in) :: alphaDep !! Alpha calibration parameter
+ real(dp), intent(in) :: betaDep !! Beta calibration parameter
real(dp) :: W !! Calculated settling velocity [m/s]
real(dp) :: dStar ! Dimensionless particle diameter.
real(dp) :: dStarTerm ! Local storage for d* term, to check if it's < 0
! Settling only occurs if SPM particle density is greater than density of water
- if ((rho_particle > C%rho_w(T))) then
- dStar = ((rho_particle/C%rho_w(T) - 1)*C%g/C%nu_w(T)**2)**(1.0_dp/3.0_dp) * d ! Calculate the dimensionless particle diameter
+ if (rho_particle > C%rho_w(T)) then
+ dStar = ((rho_particle/C%rho_w(T) - 1)*C%g/C%nu_w(T)**2)**(1.0_dp/3.0_dp) * d
dStarTerm = alphaDep + betaDep * dStar ** (1.714285714_dp)
if (dStarTerm > 0.0) then
W = max( &
- (C%nu_w(T)/d) * dStar**3 * (alphaDep + betaDep & ! Calculate the settling velocity
- * dStar**(1.714285714_dp))**(-0.875_dp), &
+ (C%nu_w(T)/d) * dStar**3 * (alphaDep + betaDep * dStar**(1.714285714_dp))**(-0.875_dp), &
0.0_dp &
)
else
@@ -520,21 +658,25 @@ function Q_outflow_finalReach(me) result(Q_outflow_final)
Q_outflow_final = me%Q_final%outflow
end function
- !> Return the SPM discahrge.
function j_spm_outflow_finalReach(me) result(j_spm_outflow_final)
class(Reach) :: me
real(dp) :: j_spm_outflow_final(C%nSizeClassesSpm)
j_spm_outflow_final = me%j_spm_final%outflow
end function
- !> Return the SPM discahrge.
- function j_np_outflow_finalReach(me) result(j_np_outflow_final)
- class(Reach) :: me
- real(dp) :: j_np_outflow_final(C%npDim(1), C%npDim(2), C%npDim(3))
- j_np_outflow_final = me%j_nm_final%outflow
+ function j_contaminant_outflow_finalReach(me) result(result_out)
+ class(Reach), intent(in) :: me
+ type(Contaminant) :: result_out
+ type(Result) :: r
+ r = result_out%create()
+ if (r%hasCriticalError()) then
+ call ERROR_HANDLER%trigger(errors=.errors.r)
+ return
+ end if
+ result_out = me%j_contaminant_final
end function
- function Q_outflow(me)
+ function Q_outflow(me)
class(Reach) :: me
real(dp) :: Q_outflow
Q_outflow = me%Q%outflow
@@ -570,120 +712,79 @@ function j_spm_inflows(me)
j_spm_inflows = me%j_spm%inflow
end function
- function j_spm_runoff(me)
+ function j_spm_runoff(me)
class(Reach) :: me
real(dp) :: j_spm_runoff(C%nSizeClassesSpm)
j_spm_runoff = me%j_spm%soilErosion
end function
- function j_spm_transfers(me)
+ function j_spm_transfers(me)
class(Reach) :: me
real(dp) :: j_spm_transfers(C%nSizeClassesSpm)
j_spm_transfers = me%j_spm%transfers
end function
- function j_spm_deposit(me)
+ function j_spm_deposit(me)
class(Reach) :: me
real(dp) :: j_spm_deposit(C%nSizeClassesSpm)
j_spm_deposit = me%j_spm%deposition + me%j_spm%resuspension
end function
- !> Get the outflow from NM flux array
- function j_np_outflow(me)
- class(Reach) :: me
- real(dp) :: j_np_outflow(C%npDim(1), C%npDim(2), C%npDim(3))
- j_np_outflow = me%j_nm%outflow
- end function
-
- !> Get the inflowing NM from NM flux array
- function j_np_inflows(me)
- class(Reach) :: me
- real(dp) :: j_np_inflows(C%npDim(1), C%npDim(2), C%npDim(3))
- j_np_inflows = me%j_nm%inflow
- end function
-
- !> Get the total runoff from NM flux array
- function j_np_runoff(me)
- class(Reach) :: me
- real(dp) :: j_np_runoff(C%npDim(1), C%npDim(2), C%npDim(3))
- j_np_runoff = me%j_nm%soilErosion
- end function
-
- !> Get the total diffuse source fluxes from NM flux array
- function j_np_transfer(me)
+ function j_contaminant_outflow(me)
class(Reach) :: me
- real(dp) :: j_np_transfer(C%npDim(1), C%npDim(2), C%npDim(3))
- j_np_transfer = me%j_nm%transfers
+ type(Contaminant) :: j_contaminant_outflow
+ type(Result) :: r
+ r = j_contaminant_outflow%create()
+ j_contaminant_outflow = me%j_contaminant_outflow
end function
- !> Get the total deposited NM (settling + resus) from NM flux array
- function j_np_deposit(me)
+ function j_contaminant_inflows(me)
class(Reach) :: me
- real(dp) :: j_np_deposit(C%npDim(1), C%npDim(2), C%npDim(3))
- j_np_deposit = me%j_nm%deposition + me%j_nm%resuspension
+ type(Contaminant) :: j_contaminant_inflows
+ type(Result) :: r
+ r = j_contaminant_inflows%create()
+ j_contaminant_inflows = me%j_contaminant_inflow
end function
- !> Get the total diffuse source fluxes from NM flux array
- function j_np_diffusesource(me)
+ function j_contaminant_runoff(me)
class(Reach) :: me
- real(dp) :: j_np_diffusesource(C%npDim(1), C%npDim(2), C%npDim(3))
- j_np_diffuseSource = me%j_nm%diffuseSources
+ type(Contaminant) :: j_contaminant_runoff
+ type(Result) :: r
+ r = j_contaminant_runoff%create()
+ j_contaminant_runoff = me%j_contaminant_runoff
end function
- !> Get the total point source fluxes from NM flux array
- function j_np_pointsource(me)
+ function j_contaminant_transfer(me)
class(Reach) :: me
- real(dp) :: j_np_pointsource(C%npDim(1), C%npDim(2), C%npDim(3))
- j_np_pointSource = me%j_nm%pointSources
+ type(Contaminant) :: j_contaminant_transfer
+ type(Result) :: r
+ r = j_contaminant_transfer%create()
+ j_contaminant_transfer = me%j_contaminant_transfers
end function
- !> Get the outflow from transformed flux array
- function j_transformed_outflow(me)
+ function j_contaminant_deposit(me)
class(Reach) :: me
- real(dp) :: j_transformed_outflow(C%npDim(1), C%npDim(2), C%npDim(3))
- j_transformed_outflow = me%j_nm_transformed%outflow
+ type(Contaminant) :: j_contaminant_deposit
+ type(Result) :: r
+ r = j_contaminant_deposit%create()
+ call j_contaminant_deposit%add(me%j_contaminant_deposition)
+ call j_contaminant_deposit%add(me%j_contaminant_resuspension)
end function
- function j_transformed_deposit(me)
+ function j_contaminant_diffusesource(me)
class(Reach) :: me
- real(dp) :: j_transformed_deposit(C%npDim(1), C%npDim(2), C%npDim(3))
- j_transformed_deposit = me%j_nm_transformed%deposition + me%j_nm_transformed%resuspension
+ type(Contaminant) :: j_contaminant_diffusesource
+ type(Result) :: r
+ r = j_contaminant_diffusesource%create()
+ j_contaminant_diffusesource = me%j_contaminant_diffuseSources
end function
- !> Get the total diffuse source fluxes from NM flux array
- function j_transformed_diffusesource(me)
+ function j_contaminant_pointsource(me)
class(Reach) :: me
- real(dp) :: j_transformed_diffusesource(C%npDim(1), C%npDim(2), C%npDim(3))
- j_transformed_diffusesource = me%j_nm_transformed%diffuseSources
+ type(Contaminant) :: j_contaminant_pointsource
+ type(Result) :: r
+ r = j_contaminant_pointsource%create()
+ j_contaminant_pointsource = me%j_contaminant_pointSources
end function
- !> Get the total point source fluxes from NM flux array
- function j_transformed_pointsource(me)
- class(Reach) :: me
- real(dp) :: j_transformed_pointsource(C%npDim(1), C%npDim(2), C%npDim(3))
- j_transformed_pointSource = me%j_nm_transformed%pointSources
- end function
-
- !> Get the outflow from dissolved flux array
- function j_dissolved_outflow(me)
- class(Reach) :: me
- real(dp) :: j_dissolved_outflow
- j_dissolved_outflow = me%j_dissolved%outflow
- end function
-
- !> Get the total diffuse source fluxes from NM flux array
- function j_dissolved_diffusesource(me)
- class(Reach) :: me
- real(dp) :: j_dissolved_diffusesource
- j_dissolved_diffusesource = me%j_dissolved%diffuseSources
- end function
-
- !> Get the total point source fluxes from NM flux array
- function j_dissolved_pointsource(me)
- class(Reach) :: me
- real(dp) :: j_dissolved_pointsource
- j_dissolved_pointSource = me%j_dissolved%pointSources
- end function
-
-
end module
\ No newline at end of file
diff --git a/src/WaterBody/RiverReachModule.f90 b/src/WaterBody/RiverReachModule.f90
index beb9f0e..dfb3091 100644
--- a/src/WaterBody/RiverReachModule.f90
+++ b/src/WaterBody/RiverReachModule.f90
@@ -1,6 +1,7 @@
!> Module containing RiverReach type definition.
module RiverReachModule
use GlobalsModule
+ use ConstantsDefaultsModule, only: defaultSedimentEnrichment_a, defaultSedimentTransport_b, defaultSedimentTransport_c
use ReachModule
use UtilModule
use ResultModule
@@ -9,11 +10,12 @@ module RiverReachModule
use DataInputModule, only: DATASET
use ReactorModule
use BiotaWaterModule
+ use ContaminantModule
implicit none
!> The RiverReach type represents a segment of river within a grid cell
type, public, extends(Reach) :: RiverReach
- contains
+ contains
! Create
procedure :: create => createRiverReach
! Simulators
@@ -22,41 +24,93 @@ module RiverReachModule
procedure :: setDimensions
! Data handlers
procedure :: parseInputData => parseInputDataRiverReach
+ procedure :: updateSources
! Calculators
procedure :: calculateWidth => calculateWidth
procedure :: calculateDepth => calculateDepth
procedure :: calculateVelocity => calculateVelocity
+ procedure :: finalise => finaliseRiverReach
end type
- contains
+contains
!> Create this RiverReach with the provided grid cell and waterbody indices (x, y, w)
- !! and sediment size class distribution
+ !! and sediment size class distribution. Avoid double allocation of m_contaminant.
function createRiverReach(me, x, y, w, distributionSediment) result(rslt)
- class(RiverReach) :: me !! This `RiverReach` instance
- integer :: x !! Grid cell x-position index
- integer :: y !! Grid cell y-position index
- integer :: w !! Water body index within the cell
- real(dp) :: distributionSediment(C%nSizeClassesSPM) !! Distribution to split sediment across size classes
- type(Result) :: rslt !! Result object to return errors in
- integer :: i ! Iterator
-
- ! Set reach references (indices set in WaterBody%create) and grid cell area.
- ! Diffuse and point sources are created in WaterBody%create
+ class(RiverReach), intent(inout) :: me
+ integer, intent(in) :: x, y, w
+ real(dp), intent(in) :: distributionSediment(C%nSizeClassesSpm)
+ type(Result) :: rslt
+ integer :: i, s, istat
+ real(dp) :: T0, rho_s
+
+ ! Create base waterbody and set ref
call rslt%addErrors(.errors. me%WaterBody%create(x, y, w, distributionSediment))
me%ref = trim(ref("RiverReach", x, y, w))
- ! Parse input data and allocate/initialise variables. The order here is important:
- ! allocation depends on the input data.
+ ! Parse all grid-based inputs for the reach (includes new scalar fallbacks)
call rslt%addErrors(.errors. me%parseInputData())
- ! Create the BedSediment for this RiverReach
- ! TODO: Get the type of BedSediment from the data file, and check for allst
- allocate(BedSediment :: me%bedSediment)
- allocate(Reactor :: me%reactor)
+ ! Create the contaminant object for WATER (sizes, rates, etc.)
+ call rslt%addErrors(.errors. me%m_contaminant%create_from_data( &
+ compartment='water', &
+ contaminantDensity=DATASET%contaminantDensity, &
+ soilAttachmentEfficiency=DATASET%soilConstantAttachmentEfficiency, &
+ riverAttachmentEfficiency=DATASET%riverAttachmentEfficiency, &
+ estuaryAttachmentEfficiency=DATASET%estuaryAttachmentEfficiency, &
+ k_diss_pristine=DATASET%contaminant_k_diss_pristine, &
+ k_diss_transformed=DATASET%contaminant_k_diss_transformed, &
+ k_transform_pristine=DATASET%contaminant_k_transform_pristine, &
+ waterTemperature=DATASET%waterTemperature(C%startDate%yearday()) ))
+
+ if (allocated(DATASET%initialContaminantConcsWater)) then
+ me%m_contaminant%c = DATASET%initialContaminantConcsWater(me%x, me%y, :, :, :)
+ if (allocated(DATASET%initialDissolvedConcsWater)) then
+ me%m_contaminant%m_dissolved = DATASET%initialDissolvedConcsWater(me%x, me%y)
+ end if
+ call LOGR%toFile("RiverReach%create: applied initial contaminant concentrations")
+ end if
+
+ ! Settling velocities for SPM size classes — prefer DATASET%spmDensityBySizeClass
+ if (allocated(me%W_settle_spm)) deallocate(me%W_settle_spm)
+ allocate(me%W_settle_spm(C%nSizeClassesSpm), stat=istat)
+ if (istat /= 0) then
+ allocate(me%W_settle_spm(1))
+ me%W_settle_spm = 0.0_dp
+ end if
- ! Allocate and create the correct number of biota objects for this reach
- ! TODO move all this to database
+ T0 = DATASET%waterTemperature(C%startDate%yearday())
+ do s = 1, C%nSizeClassesSpm
+ if (allocated(DATASET%spmDensityBySizeClass)) then
+ rho_s = DATASET%spmDensityBySizeClass(min(s, size(DATASET%spmDensityBySizeClass)))
+ else
+ ! GLOBAL fallback (now guaranteed to be defined by GLOBALS_INIT)
+ rho_s = C%sedimentParticleDensities(min(s, size(C%sedimentParticleDensities)))
+ end if
+ me%W_settle_spm(s) = me%m_contaminant%calculateSettlingVelocity( &
+ d = C%d_spm(s), rho_particle = rho_s, T_water = T0)
+ end do
+
+ ! ensure an SPM vector exists for the reactor
+ if (allocated(me%C_spm)) deallocate(me%C_spm)
+ allocate(me%C_spm(C%nSizeClassesSpm), stat=istat)
+ if (istat /= 0) then
+ allocate(me%C_spm(1)); me%C_spm = 0.0_dp
+ end if
+
+ ! Create the bed and reactor
+ allocate(BedSediment :: me%bedSediment)
+ allocate(Reactor :: me%reactor)
+ call rslt%addErrors([ &
+ .errors. me%bedSediment%create(me%x, me%y, me%w), &
+ .errors. me%reactor%create( &
+ me%x, me%y, merge('estuary', 'water ', DATASET%isEstuary(me%x, me%y)), &
+ me%m_contaminant, me%volume, &
+ DATASET%waterTemperature(C%startDate%yearday()), &
+ C_spm=me%C_spm, W_settle_spm=me%W_settle_spm, &
+ G=DATASET%shearRate, velocity=me%velocity) ])
+
+ ! Water biota (unchanged)
allocate(me%biotaIndices(0))
if (DATASET%hasBiota) then
do i = 1, DATASET%nBiota
@@ -71,313 +125,596 @@ function createRiverReach(me, x, y, w, distributionSediment) result(rslt)
call rslt%addErrors(.errors. me%biota(i)%create(me%biotaIndices(i)))
end do
- ! Create the bed sediment and reactor
- call rslt%addErrors([ &
- .errors. me%bedSediment%create(me%x, me%y, me%w), &
- .errors. me%reactor%create(me%x, me%y, me%alpha_hetero) &
- ])
-
- ! Add what we're doing here to the trace and log that creating the reach was successful
call rslt%addToTrace('Creating ' // trim(me%ref))
call LOGR%toFile("Creating " // trim(me%ref) // ": success")
end function
+ subroutine updateSources(me, t)
+ class(RiverReach) :: me
+ integer :: t
+ integer :: p
+ type(Result) :: rslt
+ type(Contaminant) :: temp_contaminant
+
+ call rslt%addErrors(.errors. me%j_contaminant_pointSources%create())
+ do p = 1, DATASET%maxPointSources
+ call rslt%addErrors(.errors. temp_contaminant%create())
+ if (allocated(DATASET%emissionsPointWaterContaminant)) then
+ temp_contaminant%c = DATASET%emissionsPointWaterContaminant(me%x, me%y, t, p, :, :, :)
+ else
+ temp_contaminant%c = 0.0_dp
+ end if
+ if (allocated(DATASET%emissionsPointWaterDissolvedContaminant)) then
+ temp_contaminant%m_dissolved = DATASET%emissionsPointWaterDissolvedContaminant(me%x, me%y, t)
+ else
+ temp_contaminant%m_dissolved = 0.0_dp
+ end if
+ call me%j_contaminant_pointSources%add(temp_contaminant)
+ call temp_contaminant%finalise()
+ end do
+
+ call rslt%addErrors(.errors. me%j_contaminant_diffuseSources%create())
+ call rslt%addErrors(.errors. temp_contaminant%create())
+ if (allocated(DATASET%emissionsArealWaterContaminant)) then
+ temp_contaminant%c = DATASET%emissionsArealWaterContaminant(me%x, me%y, :, :, :)
+ else
+ temp_contaminant%c = 0.0_dp
+ end if
+ if (allocated(DATASET%emissionsArealWaterDissolvedContaminant)) then
+ temp_contaminant%m_dissolved = DATASET%emissionsArealWaterDissolvedContaminant(me%x, me%y)
+ else
+ temp_contaminant%m_dissolved = 0.0_dp
+ end if
+ call me%j_contaminant_diffuseSources%add(temp_contaminant)
+ call temp_contaminant%finalise()
+
+ call rslt%addToTrace("Updating sources for " // trim(me%ref) // " on timestep #" // trim(str(t)))
+ call LOGR%toFile(errors = .errors. rslt)
+ call ERROR_HANDLER%trigger(errors = .errors. rslt)
+ end subroutine
+
!> Run the river reach simulation for this timestep
- subroutine updateRiverReach(me, t, q_runoff, q_overland, j_spm_runoff, j_np_runoff, &
- j_transformed_runoff, contributingArea, isWarmUp)
- class(RiverReach) :: me !! This `RiverReach` instance
- integer :: t !! The current timestep
- real(dp) :: q_runoff !! Runoff from the hydrological model [m3/m2/timestep]
- real(dp) :: q_overland !! Overland runoff [m3/m2/timestep]
- real(dp) :: j_spm_runoff(:) !! Eroded sediment runoff to this reach [kg/timestep]
- real(dp) :: j_np_runoff(:,:,:) !! Eroded NP runoff to this reach [kg/timestep]
- real(dp) :: j_transformed_runoff(:,:,:) !! Eroded transformed NP runoff to this reach [kg/timestep]
- real(dp) :: contributingArea !! Area contributing to this reach (e.g. the soil profile) [m2]
- logical :: isWarmUp !! Are we in a warm up period?
- type(Result) :: rslt ! Result object to store errors in
- integer :: i ! Iterator
- integer :: nDisp ! Number of displacements to split this time step into
- real(dp) :: dt ! Length of each displacement [s]
- real(dp) :: dQ ! Water flow for each displacement
- real(dp) :: dj_spm(C%nSizeClassesSpm) ! SPM inflows for each displacement
- real(dp) :: dj_nm(C%npDim(1), C%npDim(2), C%npDim(3)) ! NM inflows for each displacement
- real(dp) :: dj_nm_transformed(C%npDim(1), C%npDim(2), C%npDim(3)) ! Transformed NM inflows for each displacement
- real(dp) :: dj_dissolved ! Dissolved species inflows for each displacement
- type(datetime) :: currentDate ! The current timestep's date
- real :: T_water_t ! Water temperature on this timestep [deg C]
-
- ! Reset all flows to zero, which is needed as flows are added to iteratively in the displacement loop
+ subroutine updateRiverReach(me, t, q_runoff, q_overland, j_spm_runoff, j_contaminant_runoff, &
+ contributingArea, isWarmUp)
+ class(RiverReach), intent(inout) :: me !! This `RiverReach` instance
+ integer, intent(in) :: t !! The current timestep
+ real(dp), intent(in) :: q_runoff !! Runoff from the hydrological model [m3/m2/timestep]
+ real(dp), intent(in) :: q_overland !! Overland runoff [m3/m2/timestep]
+ real(dp), intent(in) :: j_spm_runoff(:) !! Eroded sediment runoff to this reach [kg/timestep]
+ type(Contaminant), intent(in) :: j_contaminant_runoff !! Contaminant runoff to this reach [kg/timestep]
+ real(dp), intent(in) :: contributingArea !! Area contributing to this reach [m2]
+ logical, intent(in) :: isWarmUp !! Are we in a warm up period?
+ type(Result) :: rslt ! Result object to store errors in
+ integer :: i ! Iterator
+ integer :: nDisp ! Number of displacements to split this time step into
+ real(dp) :: dt ! Length of each displacement [s]
+ real(dp) :: dQ ! Water flow for each displacement
+ real(dp) :: dj_spm(C%nSizeClassesSpm) ! SPM inflows for each displacement
+ type(Contaminant) :: dj_contaminant_in
+ type(datetime) :: currentDate ! The current timestep's date
+ real(dp) :: T_water_t
+ type(Contaminant) :: c_env_contaminant
+
+ ! Reset all flows to zero (water/SPM done inside WaterBody/Reach)
call me%emptyFlows()
+ ! --- hard reset contaminant flux holders each timestep (prevents junk in outputs) ---
+ call rslt%addErrors(.errors. me%j_contaminant_inflow%create())
+ call rslt%addErrors(.errors. me%j_contaminant_runoff%create())
+ call rslt%addErrors(.errors. me%j_contaminant_transfers%create())
+ call rslt%addErrors(.errors. me%j_contaminant_deposition%create())
+ call rslt%addErrors(.errors. me%j_contaminant_resuspension%create())
+ call rslt%addErrors(.errors. me%j_contaminant_outflow%create())
+ ! -------------------------------------------------------------------------------------
+
! Get the current date and use the day of year to get the water temp
currentDate = C%startDate + timedelta(t-1)
- T_water_t = me%T_water(currentDate%yearday())
-
- ! Get the inflows from upstream water bodies
+ T_water_t = me%T_water(currentDate%yearday())
+
+ ! Inflows from upstream reaches
do i = 1, me%nInflows
- me%Q%inflow = me%Q%inflow - me%inflows(i)%item%Q%outflow
+ me%Q%inflow = me%Q%inflow - me%inflows(i)%item%Q%outflow
me%j_spm%inflow = me%j_spm%inflow - me%inflows(i)%item%j_spm%outflow
- me%j_nm%inflow = me%j_nm%inflow - me%inflows(i)%item%j_nm%outflow
- me%j_nm_transformed%inflow = me%j_nm_transformed%inflow - me%inflows(i)%item%j_nm_transformed%outflow
- me%j_dissolved%inflow = me%j_dissolved%inflow - me%inflows(i)%item%j_dissolved%outflow
+ call me%j_contaminant_inflow%add(me%inflows(i)%item%get_j_contaminant_outflow())
end do
- ! Get the inflows from runoff and scale to this reach, then use this to set dimensions
- me%Q%runoff = q_runoff * contributingArea
+ ! Runoff to this reach and geometry update
+ me%Q%runoff = q_runoff * contributingArea ! [m³/timestep]
me%Q_in_total = me%Q%inflow + me%Q%runoff
call me%setDimensions(t)
- ! Set the erosion yields, with includes scaling the soil erosion by sediment transport
- ! capacity, calculating the bank ersoion, and storing these in the flow objects
- call me%setErosionYields(j_spm_runoff, q_overland, contributingArea, j_np_runoff, j_transformed_runoff)
-
- ! TODO transfers and demands
+ ! Erosion yields & bank erosion; store in flow objects
+ call me%setErosionYields(j_spm_runoff, q_overland, contributingArea, j_contaminant_runoff)
- if (.not. C%ignoreNM .and. .not. isWarmUp) then
- ! Inflows from point and diffuse sources, updates the NM flow object
+ ! Point + diffuse sources (if any flow)
+ if (.not. C%ignoreContaminant .and. .not. isZero(me%Q_in_total)) then
call me%updateSources(t)
end if
- ! Set the resuspension and settling rates [/s] (but don't settle until we're looping through displacements)
+ ! Physics for this step (resuspension & settling)
call me%setResuspensionRate(me%Q_in_total / C%timeStep, T_water_t)
call me%setSettlingRate(T_water_t)
- ! If the total inflow for this timestep is bigger than the current reach volume,
- ! then we need to split into a number of time displacements
+ ! ----------------------------------------------------------------------
+ ! Displacement splitting (same logic as old NanoFASE)
+ ! ----------------------------------------------------------------------
if (isZero(me%Q_in_total) .or. isZero(me%volume)) then
nDisp = 1
else
nDisp = ceiling(me%Q_in_total / me%volume)
end if
- dt = C%timestep / nDisp
+
+ dt = C%timeStep / nDisp
dQ = me%Q_in_total / nDisp
- dj_SPM = (me%j_spm%inflow + me%j_spm%soilErosion + me%j_spm%bankErosion) / nDisp
- if (.not. C%ignoreNM) then
- dj_NM = (me%j_nm%inflow + me%j_nm%soilErosion + me%j_nm%pointSources &
- + me%j_nm%diffuseSources) / nDisp
- dj_NM_transformed = (me%j_nm_transformed%inflow + me%j_nm_transformed%soilErosion &
- + me%j_nm_transformed%pointSources + me%j_nm_transformed%diffuseSources) / nDisp
- dj_dissolved = (me%j_dissolved%inflow + me%j_dissolved%pointSources &
- + me%j_dissolved%diffuseSources) / nDisp
- end if
- ! Now we can run the simulation for each time displacement, with calculates SPM and NM outflow,
- ! deposition and resuspension, and updates the flow objects accordingly
+ ! SPM inflow per displacement
+ dj_spm = (me%j_spm%inflow + me%j_spm%soilErosion + me%j_spm%bankErosion) / nDisp
+
+ ! Contaminant inflow per displacement
+ call rslt%addErrors(.errors. dj_contaminant_in%create())
+ call dj_contaminant_in%add_scaled(me%j_contaminant_inflow, 1.0_dp / nDisp)
+ call dj_contaminant_in%add_scaled(me%j_contaminant_soilErosion, 1.0_dp / nDisp)
+ call dj_contaminant_in%add_scaled(me%j_contaminant_pointSources, 1.0_dp / nDisp)
+ call dj_contaminant_in%add_scaled(me%j_contaminant_diffuseSources, 1.0_dp / nDisp)
+
+ ! ----------------------------------------------------------------------
+ ! Run displacement physics
+ ! ----------------------------------------------------------------------
do i = 1, nDisp
- call me%updateDisplacement(t, i, dt, dQ, dj_SPM, dj_NM, dj_nm_transformed, dj_dissolved)
+ call me%updateDisplacement(t, i, dt, dQ, dj_spm, dj_contaminant_in, T_water_t)
end do
- ! Set the new concentrations
+ call dj_contaminant_in%finalise()
+
+ ! Final concentrations based on the calculated masses [kg/m³]
me%C_spm = divideCheckZero(me%m_spm, me%volume)
- ! Only if we're not ignoring NM
- if (.not. C%ignoreNM) then
- me%C_np = divideCheckZero(me%m_np, me%volume)
- me%C_transformed = divideCheckZero(me%m_transformed, me%volume)
- me%C_dissolved = divideCheckZero(me%m_dissolved, me%volume)
-
- ! Now we pass the NM to the reactor to update
- call rslt%addErrors([.errors. &
- me%reactor%update( &
- t, &
- me%m_np, &
- me%m_transformed, &
- me%m_dissolved, &
- me%C_spm, &
- T_water_t, &
- me%W_settle_np, &
- me%W_settle_spm, &
- DATASET%shearRate, &
- me%volume &
- ) &
- ])
- ! Get the resultant masses from the Reactor
- me%m_np = me%reactor%m_np
- me%m_transformed = me%reactor%m_transformed
- me%m_dissolved = me%reactor%m_dissolved
- end if
- ! Set the final concentrations based on the calculated mases [kg/m3]
- me%C_np = divideCheckZero(me%m_np, me%volume)
- me%C_transformed = divideCheckZero(me%m_transformed, me%volume)
- me%C_dissolved = divideCheckZero(me%m_dissolved, me%volume)
+ if (.not. C%ignoreContaminant .and. .not. isZero(me%volume)) then
+ ! FIX: Reactor Update
+ ! The contaminant MUST react/partition to attach to SPM.
+ ! Reactor has a pointer to me%m_contaminant, so no set_state is needed.
+ call rslt%addErrors(.errors. me%reactor%update(dt=real(C%timeStep, dp)))
+ end if
- ! Update the biota
+ ! Biota update (uses current environmental concentration)
do i = 1, me%nBiota
- call rslt%addErrors(.errors. me%biota(i)%update( &
- t, &
- me%C_np, &
- me%C_transformed, &
- me%C_dissolved &
- ))
+ c_env_contaminant = me%m_contaminant%divideCheckZero(me%volume)
+ call rslt%addErrors(.errors. me%biota(i)%update(t, c_env_contaminant))
+ call c_env_contaminant%finalise()
end do
- ! Add what we're doing here to the error trace and trigger any errors there are
call rslt%addToTrace("Updating " // trim(me%ref) // " on timestep #" // trim(str(t)))
call LOGR%toFile(errors = .errors. rslt)
call ERROR_HANDLER%trigger(errors = .errors. rslt)
- end subroutine
+ end subroutine updateRiverReach
+
!> Run the simulation for an individual time displacement
- subroutine updateDisplacementRiverReach(me, t, d, dt, dQ, dj_spm_in, dj_nm_in, dj_nm_transformed_in, dj_dissolved_in)
- class(RiverReach) :: me !! This reach
+ subroutine updateDisplacementRiverReach(me, t, d, dt, dQ, dj_spm_in, dj_contaminant_in, T_water_t)
+ class(RiverReach) :: me !! This reach
integer :: t !! Current timestep index (used for error output)
integer :: d !! Current time displacement index (used for error output)
real(dp) :: dt !! Time displacement [s]
real(dp) :: dQ !! Water flow from runoff and inflows [m3/displacement]
- real(dp) :: dj_spm_in(C%nSizeClassesSPM) !! SPM inflow from erosion and inflows [kg/displacement]
- real(dp) :: dj_nm_in(C%npDim(1), C%npDim(2), C%npDim(3)) !! NM inflow from erosion, inflows and sources [kg/displacement]
- real(dp) :: dj_nm_transformed_in(C%npDim(1), C%npDim(2), C%npDim(3)) !! Transformed NM inflow from erosion, inflows and sources [kg/displacement]
- real(dp) :: dj_dissolved_in !! Dissolved species inflow from inflows and sources [kg/displacement]
- real(dp) :: dj_spm_resus(C%nSizeClassesSPM)
+ real(dp) :: dj_spm_in(C%nSizeClassesSpm) !! SPM inflow from erosion and inflows [kg/displacement]
+ type(Contaminant) :: dj_contaminant_in !! Contaminant inflow for this displacement
+ real(dp) :: T_water_t !! Water temperature [deg C]
+
+ ! SPM bookkeeping
+ real(dp) :: dj_spm_resus(C%nSizeClassesSpm)
real(dp) :: dj_spm_resus_perArea(C%nSizeClassesSpm)
real(dp) :: dj_spm_resus_perArea_(C%nSizeClassesSpm)
+ real(dp) :: dj_spm_deposit_perArea(C%nSizeClassesSpm)
+ real(dp) :: dj_spm_deposit(C%nSizeClassesSpm)
+ real(dp) :: dj_spm_outflow(C%nSizeClassesSpm)
+ real(dp) :: k_outflow
+
+ ! Contaminant bookkeeping
+ type(Contaminant) :: dj_contaminant_deposit
+ type(Contaminant) :: dj_contaminant_resus
+ type(Contaminant) :: dj_contaminant_outflow
+ type(Contaminant) :: m_contaminant
+ type(Contaminant) :: cont_dep_spm, cont_resus_spm
+ type(Contaminant) :: j_contam_dep_perArea
+ type(Result0D) :: res_contaminant
+
+ ! Error/result
type(Result) :: rslt
- real(dp) :: dj_spm_deposit(C%nSizeClassesSPM)
- real(dp) :: dj_spm_outflow(C%nSizeClassesSPM)
- integer :: i
- real(dp) :: k_outflow ! The outflow rate [/s]
- real(dp) :: dj_nm_deposit(C%npDim(1), C%npDim(2), C%npDim(3))
- real(dp) :: dj_nm_transformed_deposit(C%npDim(1), C%npDim(2), C%npDim(3))
- real(dp) :: dj_nm_resus(C%npDim(1), C%npDim(2), C%npDim(3))
- real(dp) :: dj_nm_transformed_resus(C%npDim(1), C%npDim(2), C%npDim(3))
- real(dp) :: dj_nm_outflow(C%npDim(1), C%npDim(2), C%npDim(3))
- real(dp) :: dj_nm_transformed_outflow(C%npDim(1), C%npDim(2), C%npDim(3))
- real(dp) :: dj_dissolved_outflow
-
- ! Check that we've got a volume before going on
- if (.not. isZero(me%volume)) then
- ! Outflow rate [/disp]
- k_outflow = dQ / me%volume
+ ! Mass-balance check (toggleable)
+ logical :: do_mb_check
+ type(Contaminant) :: w_before, w_after, bed_before, bed_after
+ real(dp) :: mb_in, mb_resus, mb_dep, mb_out, mb_delta, mb_storage
+ do_mb_check = .true.
- ! Calculate outflow and deposition first
- dj_spm_outflow = min(flushToZero(me%m_spm * k_outflow), me%m_spm) ! [kg/disp]
- dj_spm_deposit = flushToZero((me%m_spm + dj_spm_in) * me%k_settle * dt) ! [kg/disp]
- dj_spm_deposit = min(dj_spm_deposit, me%m_spm + dj_spm_in)
+ ! Ensure local contaminant containers are allocated/zeroed
+ call rslt%addErrors(.errors. dj_contaminant_outflow%create())
+ call rslt%addErrors(.errors. dj_contaminant_deposit%create())
+ call rslt%addErrors(.errors. dj_contaminant_resus%create())
+ call rslt%addErrors(.errors. cont_dep_spm%create())
+ call rslt%addErrors(.errors. cont_resus_spm%create())
+ call rslt%addErrors(.errors. j_contam_dep_perArea%create())
- ! Calculate resuspension [kg/displacement] and send this to the bed sediment,
- ! which tells us how much sediment can actually be resuspended. Bed sediment resuspend
- ! method *must* be called before deposition
- dj_spm_resus_perArea = flushToZero(me%k_resus * me%bedSediment%Mf_bed_by_size() * dt) ! kg/m2 = s-1 * kg/m2 * s
+ if (.not. isZero(me%volume)) then
+ ! ------------------------------------------------------------------
+ ! WATER → WATER bookkeeping (SPM)
+ ! ------------------------------------------------------------------
+ k_outflow = max(0.0_dp, min(1.0_dp, dQ / max(C%epsilon, me%volume)))
+ dj_spm_outflow = min(flushToZero(me%m_spm * k_outflow), me%m_spm)
+ dj_spm_deposit = flushToZero((me%m_spm + dj_spm_in) * me%k_settle * dt)
+ dj_spm_deposit = min(dj_spm_deposit, me%m_spm + dj_spm_in)
+
+ ! Resuspension demand as an area flux; bed returns the accepted amount
+ ! print *, 'mf_bed_by_size', me%bedSediment%Mf_bed_by_size()
+ dj_spm_resus_perArea = flushToZero(me%k_resus * me%bedSediment%Mf_bed_by_size() * dt)
dj_spm_resus_perArea_ = dj_spm_resus_perArea
call rslt%addErrors(.errors. me%bedSediment%resuspend(dj_spm_resus_perArea_))
- ! The above modifies dj_spm_resus_perArea to be the amount of sediment passed
- ! in that *isn't* resuspended, so the amount actually resuspended is input - output:
- dj_spm_resus_perArea = dj_spm_resus_perArea - dj_spm_resus_perArea_
- dj_spm_resus = dj_spm_resus_perArea * me%bedArea
+ ! The bedSediment%resuspend method modifies dj_spm_resus_perArea_ to return
+ ! the amount of sediment that *isn't* resuspended, so now calculate the
+ ! actual resuspension flux
+ dj_spm_resus_perArea = dj_spm_resus_perArea - dj_spm_resus_perArea_
+ dj_spm_resus = dj_spm_resus_perArea * me%bedArea
- ! Pass the deposited SPM to the bed sediment
+ ! Move SPM mass to bed (updates water depth via depositToBed)
call rslt%addErrors(.errors. me%depositToBed(dj_spm_deposit))
- ! Add these to the flow objects and ammend the SPM mass
- me%Q%outflow = me%Q%outflow - dQ
+ ! Update SPM storages/fluxes in water
+ me%Q%outflow = me%Q%outflow - dQ
+ ! Deposition is -ve (loss), resuspension is +ve (gain)
me%j_spm%resuspension = me%j_spm%resuspension + dj_spm_resus
- me%j_spm%deposition = me%j_spm%deposition - dj_spm_deposit ! Deposition is negative
- me%j_spm%outflow = me%j_spm%outflow - dj_spm_outflow ! Outflow is negative
- ! Mass of SPM = previous mass + inflows (runoff and inflow) + resus - deposition - outflow.
- ! We still need to set minimum bound as 0 in case of FP rounding errors in calculating scaling
- ! factor forces outflow mass to be slightly higher than inflow
+ me%j_spm%deposition = me%j_spm%deposition - dj_spm_deposit
+ me%j_spm%outflow = me%j_spm%outflow - dj_spm_outflow
me%m_spm = flushToZero(max(me%m_spm + dj_spm_in + dj_spm_resus - dj_spm_deposit - dj_spm_outflow, 0.0_dp))
- ! Check we're not meant to be ignore NM processes to speed things up
- if (.not. C%ignoreNM) then
- ! Now we can deal with NM, firstly by calculating the deposited and outflowing NM
- dj_nm_outflow = min(flushToZero(me%m_np * k_outflow), me%m_np) ! [kg/disp]
- dj_nm_transformed_outflow = min(flushToZero(me%m_transformed * k_outflow), me%m_transformed) ! [kg/disp]
- dj_dissolved_outflow = min(flushToZero(me%m_dissolved * k_outflow), me%m_dissolved) ! [kg/disp]
- dj_nm_deposit = 0.0_dp ! Only heteraggregated size classes will be changed, to set others to zero
- dj_nm_transformed_deposit = 0.0_dp
- do i = 1, C%nSizeClassesSpm
- dj_nm_deposit(:,:,2+i) = min(flushToZero((me%m_np(:,:,2+i) + dj_nm_in(:,:,2+i)) &
- * me%k_settle(i) * dt), me%m_np(:,:,2+i) + dj_nm_in(:,:,2+i))
- dj_nm_transformed_deposit(:,:,2+i) = min(flushToZero((me%m_transformed(:,:,2+i) &
- + dj_nm_transformed_in(:,:,2+i)) * me%k_settle(i) * dt), me%m_transformed(:,:,2+i) &
- + dj_nm_transformed_in(:,:,2+i))
- end do
-
- ! Pass the deposited and resuspended SPM to the bed sediment, which will use it
- ! to populate the mass transfer matrix
- call me%bedSediment%getMatrix(divideCheckZero(dj_spm_deposit, me%bedArea), dj_spm_resus_perArea)
- ! Pass the deposited NM to the bed sediment, which apportions it across the sediment layers
- call me%bedSediment%transferNM(divideCheckZero(dj_nm_deposit, me%bedArea))
- ! Now pull the mass of NM resuspended out of the bed sediment (which internally
- ! is calculated using the mass of sediment resuspended)
- dj_nm_resus = flushToZero(me%bedSediment%M_np(2,:,:,:) * me%bedArea)
-
- ! TODO no resuspended transformed NM for the moment
- dj_nm_transformed_resus = 0.0_dp
-
- ! Add these NM fluxes to the flow object and ammend the NM mass
- me%j_nm%deposition = me%j_nm%deposition - dj_nm_deposit ! Deposition is negative
- me%j_nm%resuspension = me%j_nm%resuspension + dj_nm_resus
- me%j_nm%outflow = me%j_nm%outflow - dj_nm_outflow ! Outflow is negative
- me%j_nm_transformed%deposition = me%j_nm_transformed%deposition - dj_nm_transformed_deposit
- me%j_nm_transformed%resuspension = me%j_nm_transformed%resuspension + dj_nm_transformed_resus
- me%j_nm_transformed%outflow = me%j_nm_transformed%outflow - dj_nm_transformed_outflow
- me%j_dissolved%outflow = me%j_dissolved%outflow - dj_dissolved_outflow
- ! Mass of NM = previous mass + inflows (runoff, inflows, sources) + resus - deposition - outflow
- me%m_np = max(me%m_np + dj_nm_in + dj_nm_resus - dj_nm_deposit - dj_nm_outflow, 0.0_dp)
- me%m_transformed = max(me%m_transformed + dj_nm_transformed_in + dj_nm_transformed_resus &
- - dj_nm_transformed_deposit - dj_nm_transformed_outflow, 0.0_dp)
- me%m_dissolved = max(me%m_dissolved + dj_dissolved_in - dj_dissolved_outflow, 0.0_dp)
- end if
+ if (.not. C%ignoreContaminant) then
+ ! ---- capture pre-update storages for MB check ----
+ if (do_mb_check) then
+ call rslt%addErrors(.errors. w_before%create())
+ w_before = me%m_contaminant
+ res_contaminant = me%bedSediment%get_m_contaminant()
+ if (res_contaminant%hasError()) then
+ call rslt%addErrors(res_contaminant%getErrors()); call LOGR%toFile(errors = .errors. rslt)
+ call ERROR_HANDLER%trigger(errors = .errors. rslt); return
+ end if
+ select type (data => res_contaminant%getData())
+ type is (Contaminant); bed_before = data
+ class default
+ call rslt%addError(ErrorInstance(code=106, message="Invalid data type in Result0D"))
+ call LOGR%toFile(errors = .errors. rslt); call ERROR_HANDLER%trigger(errors = .errors. rslt)
+ return
+ end select
+ end if
+
+ ! ------------------------------------------------------------------
+ ! WATER contaminant internal (outflow split + deposition/settling)
+ ! ------------------------------------------------------------------
+ call me%m_contaminant%outflow_split( &
+ k_outflow = max(0.0_dp, min(1.0_dp, k_outflow)), &
+ dj_spm_outflow = dj_spm_outflow, &
+ m_spm = me%m_spm, &
+ dj_out = dj_contaminant_outflow )
+
+ call me%m_contaminant%deposition(dt, me%W_settle_spm, me%volume, dj_contaminant_deposit)
+
+ ! Legacy-style proxy resuspension term (scalar on current bed state)
+ res_contaminant = me%bedSediment%get_m_contaminant()
+ if (res_contaminant%hasError()) then
+ call rslt%addErrors(res_contaminant%getErrors()); call LOGR%toFile(errors = .errors. rslt)
+ call ERROR_HANDLER%trigger(errors = .errors. rslt); return
+ end if
+ select type (data2 => res_contaminant%getData())
+ type is (Contaminant)
+ m_contaminant = data2
+ class default
+ call rslt%addError(ErrorInstance(code=106, message="Invalid data type in Result0D"))
+ call LOGR%toFile(errors = .errors. rslt); call ERROR_HANDLER%trigger(errors = .errors. rslt)
+ return
+ end select
+ dj_contaminant_resus = m_contaminant * sum(me%k_resus * dt)
+
+ ! ------------------------------------------------------------------
+ ! NEW: SPM-mediated coupling with the bed (FREE scavenging + co-movement)
+ ! ------------------------------------------------------------------
+ if (isZero(me%bedArea)) then
+ dj_spm_deposit_perArea = 0.0_dp
+ dj_spm_resus_perArea = 0.0_dp
+ else
+ dj_spm_deposit_perArea = dj_spm_deposit / me%bedArea
+ dj_spm_resus_perArea = dj_spm_resus / me%bedArea
+ end if
+ ! At the water–bed interface: scavenge FREE mass onto depositing SPM (returns
+ ! a deposited package and a package ready to resuspend next step)
+ call rslt%addErrors(.errors. me%bedSediment%deposit_spm( &
+ dj_spm_deposit_perArea, me%bedArea, cont_dep_spm, cont_resus_spm))
+ call rslt%addErrors(.errors. me%bedSediment%resuspend_spm( &
+ dj_spm_resus_perArea, me%bedArea, cont_resus_spm))
+
+ ! ------------------------------------------------------------------
+ ! PATCH: drive bed sediment contaminant transfer (matrix + per-area deposit)
+ ! ------------------------------------------------------------------
+ call me%bedSediment%getmatrix(dj_spm_deposit_perArea, dj_spm_resus_perArea)
+
+ ! j_contam_dep_perArea = (direct settling) + (FREE scavenged at interface), per unit bed area
+ call j_contam_dep_perArea%add(dj_contaminant_deposit)
+ call j_contam_dep_perArea%add(cont_dep_spm)
+ if (me%bedArea > C%epsilon) then
+ ! Use overloaded operator: Contaminant * scalar → Contaminant
+ j_contam_dep_perArea = j_contam_dep_perArea * (1.0_dp / me%bedArea)
+ else
+ ! no bed area; nothing to scale
+ end if
+
+ call rslt%addErrors(.errors. me%bedSediment%transferContaminant(j_contam_dep_perArea))
+
+ ! ------------------------------------------------------------------
+ ! Apply ALL contaminant flows to WATER storages/fluxes
+ ! ------------------------------------------------------------------
+ call me%j_contaminant_deposition%add_scaled(dj_contaminant_deposit, -1.0_dp)
+ call me%j_contaminant_resuspension%add(dj_contaminant_resus)
+ call me%j_contaminant_outflow%add_scaled(dj_contaminant_outflow, -1.0_dp)
+ call me%m_contaminant%add(dj_contaminant_in)
+ call me%m_contaminant%add_scaled(dj_contaminant_deposit, -1.0_dp)
+ call me%m_contaminant%add(dj_contaminant_resus)
+ call me%m_contaminant%add_scaled(dj_contaminant_outflow, -1.0_dp)
+
+ ! Add the SPM-mediated bed packages (mirrors legacy nm behaviour)
+ call me%j_contaminant_deposition%add_scaled(cont_dep_spm, -1.0_dp)
+ call me%j_contaminant_resuspension%add(cont_resus_spm)
+ call me%m_contaminant%add_scaled(cont_dep_spm, -1.0_dp)
+ call me%m_contaminant%add(cont_resus_spm)
+
+ ! ------------------------------------------------------------------
+ ! MASS-BALANCE CHECK (per displacement) — keep here
+ ! lhs = inflows + resus − deposits − outflow vs Δstorage (water + bed)
+ ! ------------------------------------------------------------------
+ if (do_mb_check) then
+ ! Post-update storages
+ w_after = me%m_contaminant
+ res_contaminant = me%bedSediment%get_m_contaminant()
+ if (res_contaminant%hasError()) then
+ call rslt%addErrors(res_contaminant%getErrors()); call LOGR%toFile(errors = .errors. rslt)
+ else
+ select type (data3 => res_contaminant%getData())
+ type is (Contaminant); bed_after = data3
+ class default
+ call rslt%addError(ErrorInstance(code=106, message="Invalid data type in Result0D(b)"))
+ end select
+ end if
+
+ mb_in = total_mass(dj_contaminant_in)
+ mb_resus = total_mass(dj_contaminant_resus) + total_mass(cont_resus_spm)
+ mb_dep = total_mass(dj_contaminant_deposit)+ total_mass(cont_dep_spm)
+ mb_out = total_mass(dj_contaminant_outflow)
+
+ mb_delta = mb_in + mb_resus - mb_dep - mb_out
+ mb_storage = (total_mass(w_after) + total_mass(bed_after)) - &
+ (total_mass(w_before) + total_mass(bed_before))
+
+ call LOGR%toFile( &
+ "MB (reach "//trim(me%ref)//", disp "//trim(str(d))//"): " // &
+ "in=" // trim(str(mb_in)) // ", resus=" // trim(str(mb_resus)) // &
+ ", dep=" // trim(str(mb_dep)) // ", out=" // trim(str(mb_out)) // &
+ " | lhs=" // trim(str(mb_delta)) // ", dStorage=" // trim(str(mb_storage)) // &
+ ", diff=" // trim(str(mb_delta - mb_storage)) )
+ end if
+ ! ------------------------------------------------------------------
+
+ end if
else
- ! If there is no volume then there must be no SPM/NM. Concentrations will be
- ! set outside of the displacement loop
+ ! dry/empty: zero SPM and reset contaminant container
me%m_spm = 0.0_dp
- me%m_np = 0.0_dp
- me%m_transformed = 0.0_dp
- me%m_dissolved = 0.0_dp
+ call rslt%addErrors(.errors. me%m_contaminant%create())
+ call me%m_contaminant%finalise()
+ end if
+
+ ! ------------------------------------------------------------------
+ ! Mass-balance diagnostic
+ ! ------------------------------------------------------------------
+ if (do_mb_check) then
+ call rslt%addErrors(.errors. w_after%create())
+ call rslt%addErrors(.errors. bed_after%create())
+ call w_after%add(me%m_contaminant)
+ res_contaminant = me%bedSediment%get_m_contaminant()
+ if (.not. res_contaminant%hasError()) then
+ select type (data2 => res_contaminant%getData())
+ type is (Contaminant)
+ call bed_after%add(data2)
+ class default
+ call rslt%addError(ErrorInstance(code=106, message="Invalid data type in get_m_contaminant()"))
+ end select
+ else
+ call rslt%addErrors(res_contaminant%getErrors())
+ end if
+
+
+ mb_in = total_mass(dj_contaminant_in)
+ mb_resus = total_mass(dj_contaminant_resus)
+ mb_dep = total_mass(dj_contaminant_deposit)
+ mb_out = total_mass(dj_contaminant_outflow)
+ mb_delta = (mb_in + mb_resus) - (mb_dep + mb_out)
+ mb_storage = ( total_mass(w_after) + total_mass(bed_after) ) - &
+ ( total_mass(w_before) + total_mass(bed_before) )
+
+ if (abs(mb_delta - mb_storage) > 1.0e-8_dp) then
+ call rslt%addToTrace( &
+ "MB RiverReach "//trim(me%ref)//" t="//trim(str(t))// &
+ " disp="//trim(str(d))//": " // &
+ "in=" // trim(str(mb_in)) // ", resus=" // trim(str(mb_resus)) // &
+ ", dep=" // trim(str(mb_dep)) // ", out=" // trim(str(mb_out)) // &
+ " | lhs=" // trim(str(mb_delta)) // ", dStorage=" // trim(str(mb_storage)) // &
+ ", diff=" // trim(str(mb_delta - mb_storage)) )
+ end if
+
+ call w_before%finalise()
+ call bed_before%finalise()
+ call w_after%finalise()
+ call bed_after%finalise()
end if
+ ! -----------------------------------------------------------------
+
+ ! Finalise locals
+ call dj_contaminant_outflow%finalise()
+ call dj_contaminant_deposit%finalise()
+ call dj_contaminant_resus%finalise()
+ call cont_dep_spm%finalise()
+ call cont_resus_spm%finalise()
+ call j_contam_dep_perArea%finalise()
- ! Trigger any errors that there were
call rslt%addToTrace("Updating time displacement #" // trim(str(d)))
call rslt%addToTrace("Updating " // trim(me%ref) // " on timestep #" // trim(str(t)))
call LOGR%toFile(errors = .errors. rslt)
call ERROR_HANDLER%trigger(errors = .errors. rslt)
- end subroutine
+
+ contains
+ pure function total_mass(cont) result(m)
+ type(Contaminant), intent(in) :: cont
+ real(dp) :: m
+ if (allocated(cont%c)) then
+ m = sum(cont%c) + cont%m_dissolved
+ else
+ m = cont%m_dissolved
+ end if
+ end function total_mass
+ end subroutine updateDisplacementRiverReach
+
!> Set the dimensions (width, depth, areas, volume) of the reach
subroutine setDimensions(me, t)
- class(RiverReach) :: me !! This reach
+ class(RiverReach) :: me !! This reach
integer :: t !! The current timestep index
! Calculate the width [m], depth [m], cross-section, bed and surface areas [m2] and volume [m3]
me%width = me%calculateWidth(me%Q_in_total/C%timeStep)
me%depth = me%calculateDepth(me%width, me%slope, me%Q_in_total/C%timeStep, t)
me%xsArea = me%depth*me%width
me%bedArea = me%width*me%length*me%f_m
- me%surfaceArea = me%bedArea ! For river reaches, set surface area equal to bed area [m2]
+ me%surfaceArea = me%bedArea ! For river reaches, set surface area equal to bed area [m2]
me%volume = me%depth*me%width*me%length*me%f_m
me%velocity = me%calculateVelocity(me%depth, me%Q_in_total/C%timeStep, me%width)
end subroutine
!> Parse data from the input file for this river reach
function parseInputDataRiverReach(me) result(rslt)
- class(RiverReach) :: me
+ class(RiverReach), intent(inout) :: me
type(Result) :: rslt
+ integer :: nx, ny
+ logical :: okA, okB, okSa, okSb, okSc
+ logical :: is_est
+ ! Basic constants
me%f_m = DATASET%riverMeanderingFactor
- me%alpha_hetero = DATASET%riverAttachmentEfficiency
- me%alpha_resus = DATASET%resuspensionAlpha(me%x, me%y)
- me%beta_resus = DATASET%resuspensionBeta(me%x, me%y)
- me%a_stc = DATASET%sedimentTransport_a(me%x, me%y)
- me%b_stc = DATASET%sedimentTransport_b(me%x, me%y)
- me%c_stc = DATASET%sedimentTransport_c(me%x, me%y)
- me%T_water = DATASET%waterTemperature
+ is_est = DATASET%isEstuary(me%x, me%y)
+
+ ! Attachment efficiency (heteroaggregation) selected by environment
+ me%alpha_hetero = merge( DATASET%estuaryAttachmentEfficiency, &
+ DATASET%riverAttachmentEfficiency, &
+ is_est )
+
+ ! -----------------------------------------------------------------
+ ! Resuspension coefficients with GRID→SCALAR fallback
+ ! -----------------------------------------------------------------
+ okA = .false.
+ if (allocated(DATASET%resuspensionAlpha)) then
+ if (size(DATASET%resuspensionAlpha,1) > 0 .and. size(DATASET%resuspensionAlpha,2) > 0) then
+ nx = size(DATASET%resuspensionAlpha,1)
+ ny = size(DATASET%resuspensionAlpha,2)
+ if (me%x>=1 .and. me%y>=1 .and. me%x<=nx .and. me%y<=ny) then
+ me%alpha_resus = DATASET%resuspensionAlpha(me%x, me%y)
+ okA = .true.
+ end if
+ end if
+ end if
+ if (.not. okA) then
+ ! scalar fallback from constants (prefer estuary value if this reach is estuarine)
+ if (is_est) then
+ me%alpha_resus = DATASET%waterResuspensionAlphaEstuary
+ else
+ me%alpha_resus = DATASET%waterResuspensionAlpha
+ end if
+ call LOGR%toFile("parseInputDataRiverReach: using scalar alpha_resus = " // trim(str(me%alpha_resus)))
+ end if
- ! Parse the input data to get inflows and outflow arrays. Pointers to reaches won't be
- ! set until all reaches created
- call rslt%addErrors( &
- .errors. me%parseInflowsAndOutflow() &
- )
+ okB = .false.
+ if (allocated(DATASET%resuspensionBeta)) then
+ if (size(DATASET%resuspensionBeta,1) > 0 .and. size(DATASET%resuspensionBeta,2) > 0) then
+ nx = size(DATASET%resuspensionBeta,1)
+ ny = size(DATASET%resuspensionBeta,2)
+ if (me%x>=1 .and. me%y>=1 .and. me%x<=nx .and. me%y<=ny) then
+ me%beta_resus = DATASET%resuspensionBeta(me%x, me%y)
+ okB = .true.
+ end if
+ end if
+ end if
+ if (.not. okB) then
+ if (is_est) then
+ me%beta_resus = DATASET%waterResuspensionBetaEstuary
+ else
+ me%beta_resus = DATASET%waterResuspensionBeta
+ end if
+ call LOGR%toFile("parseInputDataRiverReach: using scalar beta_resus = " // trim(str(me%beta_resus)))
+ end if
+
+ ! -----------------------------------------------------------------
+ ! Sediment transport coefficients with grid→scalar fallback
+ ! (use 0.0 if not provided; same behaviour as before but explicit)
+ ! -----------------------------------------------------------------
+ okSa = .false.; okSb = .false.; okSc = .false.
+
+ if (allocated(DATASET%sedimentTransport_a)) then
+ if (size(DATASET%sedimentTransport_a,1) > 0 .and. size(DATASET%sedimentTransport_a,2) > 0) then
+ nx = size(DATASET%sedimentTransport_a,1)
+ ny = size(DATASET%sedimentTransport_a,2)
+ if (me%x>=1 .and. me%y>=1 .and. me%x<=nx .and. me%y<=ny) then
+ me%a_stc = DATASET%sedimentTransport_a(me%x, me%y)
+ okSa = .true.
+ end if
+ end if
+ end if
+ if (.not. okSa) then
+ ! Defaults to 2e-9
+ me%a_stc = defaultSedimentTransport_a
+ end if
+
+ if (allocated(DATASET%sedimentTransport_b)) then
+ if (size(DATASET%sedimentTransport_b,1) > 0 .and. size(DATASET%sedimentTransport_b,2) > 0) then
+ nx = size(DATASET%sedimentTransport_b,1)
+ ny = size(DATASET%sedimentTransport_b,2)
+ if (me%x>=1 .and. me%y>=1 .and. me%x<=nx .and. me%y<=ny) then
+ me%b_stc = DATASET%sedimentTransport_b(me%x, me%y)
+ okSb = .true.
+ end if
+ end if
+ end if
+ if (.not. okSb) then
+ ! Defaults to 0
+ me%b_stc = defaultSedimentTransport_b
+ end if
+
+ if (allocated(DATASET%sedimentTransport_c)) then
+ if (size(DATASET%sedimentTransport_c,1) > 0 .and. size(DATASET%sedimentTransport_c,2) > 0) then
+ nx = size(DATASET%sedimentTransport_c,1)
+ ny = size(DATASET%sedimentTransport_c,2)
+ if (me%x>=1 .and. me%y>=1 .and. me%x<=nx .and. me%y<=ny) then
+ me%c_stc = DATASET%sedimentTransport_c(me%x, me%y)
+ okSc = .true.
+ end if
+ end if
+ end if
+ if (.not. okSc) then
+ ! Defaults to 0.2
+ me%c_stc = defaultSedimentTransport_c
+ end if
- ! Now we've got inflows and outflows, we can set reach length, assuming one reach per branch
+ ! Water temperature (vector over day-of-year)
+ me%T_water = DATASET%waterTemperature
+
+ ! Inflow/outflow topology & reach geometry
+ call rslt%addErrors(.errors. me%parseInflowsAndOutflow())
call me%setReachLengthAndSlope()
- call rslt%addToTrace('Parsing input data') ! Add this procedure to the trace
+ call rslt%addToTrace('Parsing input data (RiverReach)')
end function
-
+
!> Calculate the width \( W \) of the river based on the discharge:
!! $$
!! W = 1.22Q^{0.557}
@@ -412,7 +749,7 @@ function calculateDepth(me, W, S, Q, t) result(D_i)
real(dp), intent(in) :: W !! River width \( W \) [m].
real(dp), intent(in) :: S !! River slope \( S \) [-].
real(dp), intent(in) :: Q !! Flow rate \( Q \) [m3/s].
- integer :: t !! Timestep index
+ integer :: t !! Timestep index
real(dp) :: D_i !! The iterative river depth \( D_i \) [m].
type(Result0D) :: rslt ! The Result object to store numerical errors in
real(dp) :: f ! The function to find roots for \( f(D) \).
@@ -423,38 +760,35 @@ function calculateDepth(me, W, S, Q, t) result(D_i)
real(dp) :: epsilon ! Proximity to zero allowed.
! TODO: Allow user (e.g., data file) to specify max iterations and precision?
- D_i = 1.0_dp ! Take a guess at D being 1m to begin
- i = 1 ! Iterator for Newton solver
- iMax = 100000 ! Allow 10000 iterations
- epsilon = 1.0e-9_dp ! Proximity to zero allowed
- alpha = W**(5.0_dp/3.0_dp) * sqrt(S)/me%n ! Extract constant to simplify f and df.
- f = alpha*D_i*((D_i/(W+2*D_i))**(2.0_dp/3.0_dp)) - Q ! First value for f, based on guessed D_i
+ D_i = 1.0_dp ! Take a guess at D being 1m to begin
+ i = 1 ! Iterator for Newton solver
+ iMax = 100000 ! Allow 10000 iterations
+ epsilon = 1.0e-9_dp ! Proximity to zero allowed
+ alpha = W**(5.0_dp/3.0_dp) * sqrt(S)/me%n ! Extract constant to simplify f and df.
+ f = alpha*D_i*((D_i/(W+2*D_i))**(2.0_dp/3.0_dp)) - Q ! First value for f, based on guessed D_i
! Loop through and solve until f(D) is within e-9 of zero, or max iterations reached
do while (abs(f) > epsilon .and. i <= iMax)
- f = alpha * D_i * ((D_i/(W+2*D_i))**(2.0_dp/3.0_dp)) - Q ! f(D) based on D_{m-1}
+ f = alpha * D_i * ((D_i/(W+2*D_i))**(2.0_dp/3.0_dp)) - Q ! f(D) based on D_{m-1}
df = alpha * ((D_i)**(5.0_dp/3.0_dp) * (6*D_i + 5*W))/(3*D_i * (2*D_i + W)**(5.0_dp/3.0_dp))
- D_i = D_i - f/df ! Calculate D_i based on D_{m-1}
+ D_i = D_i - f/df ! Calculate D_i based on D_{m-1}
i = i + 1
end do
! If method diverged (results in NaN)
if (isnan(D_i)) then
call rslt%addError(ErrorInstance( &
- message="Newton's method diverged to NaN after " // trim(str(i)) // " iterations." &
- ))
- ! If max number of iterations reached
+ message="Newton's method diverged to NaN after " // trim(str(i)) // " iterations."))
+ ! If max number of iterations reached
else if (i > iMax) then
call rslt%addError(ErrorInstance( &
message="Newton's method failed to converge - maximum number of iterations (" &
// trim(str(i)) // ") exceeded. Precision (proximity to zero) required: " &
- // trim(str(epsilon)) // ". Final value: " // trim(str(f)) // "." &
- ))
+ // trim(str(epsilon)) // ". Final value: " // trim(str(f)) // "."))
! If we got a negative river depth
else if (D_i < 0.0_dp) then
call rslt%addError( &
- ErrorInstance(message="Newton's method gave negative river depth. Depth: " // trim(str(D_i))) &
- )
+ ErrorInstance(message="Newton's method gave negative river depth. Depth: " // trim(str(D_i))))
end if
! Add what we're doing here to the error trace and trigger any errors there are
@@ -463,13 +797,13 @@ function calculateDepth(me, W, S, Q, t) result(D_i)
call LOGR%toFile(errors = .errors. rslt)
call ERROR_HANDLER%trigger(errors = .errors. rslt)
end function
-
+
!> Calculate the velocity of the river:
- !! $$
+ !! $$\
!! v = \frac{Q}{WD}
!! $$
function calculateVelocity(me, D, Q, W) result(v)
- class(RiverReach), intent(in) :: me !! This `RiverReach` instance
+ class(RiverReach), intent(in) :: me !! This `RiverReach` instance
real(dp), intent(in) :: D !! River depth \( D \) [m]
real(dp), intent(in) :: Q !! Flow rate \( Q \) [m**3/s]
real(dp), intent(in) :: W !! River width \( W \) [m]
@@ -481,4 +815,22 @@ function calculateVelocity(me, D, Q, W) result(v)
end if
end function
-end module
+ subroutine finaliseRiverReach(me)
+ class(RiverReach), intent(inout) :: me
+ call me%WaterBody%finalise()
+ if (allocated(me%biota)) then
+ deallocate(me%biota)
+ end if
+ if (allocated(me%biotaIndices)) then
+ deallocate(me%biotaIndices)
+ end if
+ if (allocated(me%bedSediment)) then
+ call me%bedSediment%finalise()
+ deallocate(me%bedSediment)
+ end if
+ if (allocated(me%reactor)) then
+ call me%reactor%finalise()
+ deallocate(me%reactor)
+ end if
+ end subroutine
+end module
\ No newline at end of file
diff --git a/src/WaterBody/WaterBodyModule.f90 b/src/WaterBody/WaterBodyModule.f90
index 7ffa41b..5702958 100644
--- a/src/WaterBody/WaterBodyModule.f90
+++ b/src/WaterBody/WaterBodyModule.f90
@@ -1,5 +1,3 @@
-!> Module containing definition of base class WaterBody, which provides the primitive
-!! functionality to all environmental compartments that are water bodies.
module WaterBodyModule
use GlobalsModule
use PointSourceModule
@@ -7,8 +5,10 @@ module WaterBodyModule
use DataInputModule, only: DATASET
use AbstractBedSedimentModule
use AbstractReactorModule
+ use ReactorModule
use BiotaWaterModule
use FlowModule
+ use ContaminantModule
implicit none
!> WaterBodyPointer used for WaterBody inflows array, so the elements within can
@@ -39,37 +39,30 @@ module WaterBodyModule
real(dp) :: surfaceArea !! Surface area of the `WaterBody` [m2]
real(dp) :: bedArea !! Area of the contained `BedSediment` [m2]
real(dp) :: volume !! Volume of water in the body [m3]
- real :: T_water(366) !! Water temperature [C]
+ real(dp) :: T_water(366) !! Water temperature [C]
! Concentrations
real(dp), allocatable :: C_spm(:) !! Sediment concentration [kg/m3]
real(dp), allocatable :: C_spm_final(:) !! Sediment concentration [kg/m3]
real(dp), allocatable :: m_spm(:) !! Sediment mass [kg/m3]
- real(dp), allocatable :: C_np(:,:,:) !! NM mass concentration [kg/m3]
- real(dp), allocatable :: C_np_final(:,:,:) !! Final NM mass concentration [kg/m3]
- real(dp), allocatable :: m_np(:,:,:) !! NM mass mass [kg]
- real(dp), allocatable :: m_transformed(:,:,:) !! Transformed NM mass [kg]
- real(dp), allocatable :: C_transformed(:,:,:) !! Transformed NM concentration [kg/m3]
- real(dp), allocatable :: C_transformed_final(:,:,:) !! Final transformed NM concentration [kg/m3]
- real(dp) :: m_dissolved !! Dissolved NM mass [kg]
- real(dp) :: C_dissolved !! Dissolved NM concentration [kg/m3]
- real(dp) :: C_dissolved_final !! Final dissolved NM concentration [kg/m3]
+ type(Contaminant) :: m_contaminant !! Mass in water body [kg]
+ real(dp) :: C_dissolved = 0.0_dp !! Dissolved concentration [kg/m³]
+ real(dp) :: C_dissolved_final = 0.0_dp !! Final dissolved concentration [kg/m³]
! Flows and fluxes
integer, allocatable :: neighboursArray(:,:) !! Neighbouring waterbodies, as array of indices
- type(WaterBodyPointer), allocatable :: neighbours(:) !! Neighbouring waterbodies
+ type(WaterBodyPointer), allocatable :: neighbours(:) !! Neighbouring waterbodies
real(dp) :: Q_in_total !! Total inflow of water [m3/timestep]
real(dp), allocatable :: k_resus(:) !! Resuspension rate for a given timestep [s-1]
real(dp), allocatable :: k_settle(:) !! Sediment settling rate on a given timestep [s-1]
real(dp), allocatable :: W_settle_spm(:) !! SPM settling velocity [m/s]
- real(dp), allocatable :: W_settle_np(:) !! NP settling velocity [m/s]
real(dp) :: sedimentTransportCapacity !! Sediment transport capacity, to limit erosion [kg/m2/timestep]
real(dp) :: a_stc !! Sediment transport scaling factor[kg/m2/km2]
real(dp) :: b_stc !! Sediment transport direct runoff (overland flow) threshold [m2/s]
real(dp) :: c_stc !! Sediment transport non-linear coefficient [-]
real(dp), allocatable :: distributionSediment(:) !! Distribution to use to split sediment yields with
- real :: waterTemperature_t(366) !! Water temperature timeseries across a year [deg C]
+ real(dp) :: waterTemperature_t(366) !! Water temperature timeseries across a year [deg C]
+ class(Reactor), allocatable :: reactor !! Concrete reactor instance
! Contained objects
class(AbstractBedSediment), allocatable :: bedSediment !! Contained BedSediment object
- class(AbstractReactor), allocatable :: reactor !! Contained Reactor object
type(PointSource), allocatable :: pointSources(:) !! Contained PointSource objects
logical :: hasPointSource = .false. !! Does this water body have any point sources?
integer :: nPointSources = 0 !! How many point sources this water body has
@@ -85,18 +78,25 @@ module WaterBodyModule
! Flow objects
type(WaterFlows) :: Q
type(SPMFlows) :: j_spm
- type(NMFlows) :: j_nm
- type(NMFlows) :: j_nm_transformed
- type(DissolvedFlows) :: j_dissolved
type(WaterFlows) :: Q_final
type(SPMFlows) :: j_spm_final
- type(NMFlows) :: j_nm_final
- type(NMFlows) :: j_nm_transformed_final
- type(DissolvedFlows) :: j_dissolved_final
+ type(Contaminant) :: j_contaminant_inflow
+ type(Contaminant) :: j_contaminant_outflow
+ type(Contaminant) :: j_contaminant_runoff
+ type(Contaminant) :: j_contaminant_transfers
+ type(Contaminant) :: j_contaminant_pointSources
+ type(Contaminant) :: j_contaminant_diffuseSources
+ type(Contaminant) :: j_contaminant_soilErosion
+ type(Contaminant) :: j_contaminant_bankErosion
+ type(Contaminant) :: j_contaminant_deposition
+ type(Contaminant) :: j_contaminant_resuspension
+ type(Contaminant) :: j_contaminant_final
+
contains
! Create
procedure :: create => createWaterBody
procedure :: finaliseCreate => finaliseCreateWaterBody
+ procedure :: finalise => finaliseWaterBody
procedure :: addPointSource => addPointSourceWaterBody
! Simulators
procedure :: update => updateWaterBody
@@ -106,6 +106,8 @@ module WaterBodyModule
procedure :: allocateAndInitialise => allocateAndInitialiseWaterBody
procedure :: parseInputData => parseInputDataWaterBody
procedure :: parseNewBatchData => parseNewBatchDataWaterBody
+ procedure :: get_m_contaminant => get_m_contaminant_WaterBody
+ procedure :: get_C_contaminant => get_C_contaminant_WaterBody
end type
!> Container type for `class(WaterBody)`, the actual type of the `WaterBody` class.
@@ -119,10 +121,10 @@ module WaterBodyModule
!> Create this `WaterBody`
function createWaterBody(me, x, y, w, distributionSediment) result(rslt)
- class(WaterBody) :: me !! The `WaterBody` instance
- integer :: x, y, w !! `GridCell` and `WaterBody` identifiers
- real(dp) :: distributionSediment(C%nSizeClassesSPM) !! Distribution to split sediment across size classes
- type(Result) :: rslt !! The Result object
+ class(WaterBody), intent(inout) :: me !! The `WaterBody` instance
+ integer, intent(in) :: x, y, w !! `GridCell` and `WaterBody` identifiers
+ real(dp), intent(in) :: distributionSediment(C%nSizeClassesSPM) !! Distribution to split sediment across size classes
+ type(Result) :: rslt !! The Result object
! Set reach indices and grid cell area
me%x = x
me%y = y
@@ -135,94 +137,188 @@ function createWaterBody(me, x, y, w, distributionSediment) result(rslt)
me%nDiffuseSources = 2
! Make sure there are no point source to begin with (they're added one at a time)
allocate(me%pointSources(0))
-
+
! Initialise the flow objects
call me%Q%init()
call me%j_spm%init()
- call me%j_nm%init()
- call me%j_nm_transformed%init()
- call me%j_dissolved%init()
- call me%Q_final%init()
- call me%j_spm_final%init()
- call me%j_nm_final%init()
- call me%j_nm_transformed_final%init()
- call me%j_dissolved_final%init()
+ call rslt%addErrors(.errors. me%j_contaminant_inflow%create())
+ call rslt%addErrors(.errors. me%j_contaminant_outflow%create())
+ call rslt%addErrors(.errors. me%j_contaminant_runoff%create())
+ call rslt%addErrors(.errors. me%j_contaminant_transfers%create())
+ call rslt%addErrors(.errors. me%j_contaminant_pointSources%create())
+ call rslt%addErrors(.errors. me%j_contaminant_diffuseSources%create())
+ call rslt%addErrors(.errors. me%j_contaminant_soilErosion%create())
+ call rslt%addErrors(.errors. me%j_contaminant_bankErosion%create())
+ call rslt%addErrors(.errors. me%j_contaminant_deposition%create())
+ call rslt%addErrors(.errors. me%j_contaminant_resuspension%create())
+ call rslt%addErrors(.errors. me%j_contaminant_final%create())
end function
!> Perform creation operations that required routing and point source snapping
!! to reaches to be done.
subroutine finaliseCreateWaterBody(me)
- class(WaterBody) :: me
- ! We can't allocate j_nm until we know the number of point sources, which
+ class(WaterBody), intent(inout) :: me
+ type(Result) :: rslt
+ ! We can't allocate contaminants until we know the number of point sources, which
! is calculated during GridCell%finaliseCreate. Hence this is done here
call me%allocateAndInitialise()
+ rslt = me%reactor%create( &
+ me%x, me%y, 'water', me%m_contaminant, me%volume, me%T_water(1), &
+ me%C_spm, me%W_settle_spm, 0.0_dp, velocity=0.0_dp &
+ )
+ end subroutine
+
+ subroutine finaliseWaterBody(me)
+ class(WaterBody), intent(inout) :: me
+ integer :: i
+ call me%m_contaminant%finalise()
+ call me%j_contaminant_inflow%finalise()
+ call me%j_contaminant_outflow%finalise()
+ call me%j_contaminant_runoff%finalise()
+ call me%j_contaminant_transfers%finalise()
+ call me%j_contaminant_pointSources%finalise()
+ call me%j_contaminant_diffuseSources%finalise()
+ call me%j_contaminant_soilErosion%finalise()
+ call me%j_contaminant_bankErosion%finalise()
+ call me%j_contaminant_deposition%finalise()
+ call me%j_contaminant_resuspension%finalise()
+ call me%j_contaminant_final%finalise()
+ if (allocated(me%reactor)) then
+ call me%reactor%finalise()
+ deallocate(me%reactor)
+ end if
+ if (allocated(me%bedSediment)) then
+ call me%bedSediment%finalise()
+ deallocate(me%bedSediment)
+ end if
+ if (allocated(me%pointSources)) deallocate(me%pointSources)
+ if (allocated(me%diffuseSources)) deallocate(me%diffuseSources)
+ if (allocated(me%biota)) then
+ do i = 1, me%nBiota
+ call me%biota(i)%finalise()
+ end do
+ deallocate(me%biota)
+ end if
+ if (allocated(me%C_spm)) deallocate(me%C_spm)
+ if (allocated(me%C_spm_final)) deallocate(me%C_spm_final)
+ if (allocated(me%m_spm)) deallocate(me%m_spm)
+ if (allocated(me%k_resus)) deallocate(me%k_resus)
+ if (allocated(me%k_settle)) deallocate(me%k_settle)
+ if (allocated(me%W_settle_spm)) deallocate(me%W_settle_spm)
+ if (allocated(me%neighboursArray)) deallocate(me%neighboursArray)
+ if (allocated(me%neighbours)) deallocate(me%neighbours)
+ if (allocated(me%biotaIndices)) deallocate(me%biotaIndices)
+ if (allocated(me%distributionSediment)) deallocate(me%distributionSediment)
end subroutine
!> Update this `WaterBody` on given time step
- subroutine updateWaterBody(me, t, q_runoff, q_overland, j_spm_runoff, j_np_runoff, &
- j_transformed_runoff, contributingArea, isWarmUp)
- class(WaterBody) :: me !! This `WaterBody` instance
- integer :: t !! What time step are we on?
- real(dp) :: q_runoff !! Runoff from the hydrological model [m/timestep]
- real(dp) :: q_overland !! Overland flow [m3/m2/timestep]
- real(dp) :: j_spm_runoff(:) !! Eroded sediment runoff to this water body [kg/timestep]
- real(dp) :: j_np_runoff(:,:,:) !! Eroded NP runoff to this water body [kg/timestep]
- real(dp) :: j_transformed_runoff(:,:,:) !! Eroded transformed NP runoff to this water body [kg/timestep]
- real(dp) :: contributingArea !! Area contributing to this reach (e.g. the soil profile) [m2]
- logical :: isWarmUp !! Are we in a warm up period?
+ subroutine updateWaterBody(me, t, q_runoff, q_overland, j_spm_runoff, j_contaminant_runoff, &
+ contributingArea, isWarmUp)
+ class(WaterBody), intent(inout) :: me !! This `WaterBody` instance
+ integer, intent(in) :: t !! What time step are we on?
+ real(dp), intent(in) :: q_runoff !! Runoff from the hydrological model [m/timestep]
+ real(dp), intent(in) :: q_overland !! Overland flow [m3/m2/timestep]
+ real(dp), intent(in) :: j_spm_runoff(:) !! Eroded sediment runoff to this water body [kg/timestep]
+ type(Contaminant), intent(in) :: j_contaminant_runoff !! Contaminant runoff to this water body [kg/timestep]
+ real(dp), intent(in) :: contributingArea !! Area contributing to this reach (e.g. the soil profile) [m2]
+ logical, intent(in) :: isWarmUp !! Are we in a warm up period?
+ type(Result) :: rslt
+
+ call me%Q%addInflow(q_runoff)
+ call me%j_spm%addInflow(j_spm_runoff)
+ call me%j_contaminant_runoff%add(j_contaminant_runoff)
+ rslt = me%reactor%update(j_contaminant_runoff, real(C%timeStep, dp))
end subroutine
!> Set all flow object properties to zero. Useful for the start of
!! every timestep
subroutine emptyFlows(me)
- class(WaterBody) :: me
+ class(WaterBody), intent(inout) :: me
call me%Q%empty()
call me%j_spm%empty()
- call me%j_nm%empty()
- call me%j_nm_transformed%empty()
- call me%j_dissolved%empty()
+ call me%j_contaminant_inflow%empty()
+ call me%j_contaminant_outflow%empty()
+ call me%j_contaminant_runoff%empty()
+ call me%j_contaminant_transfers%empty()
+ call me%j_contaminant_pointSources%empty()
+ call me%j_contaminant_diffuseSources%empty()
+ call me%j_contaminant_soilErosion%empty()
+ call me%j_contaminant_bankErosion%empty()
+ call me%j_contaminant_deposition%empty()
+ call me%j_contaminant_resuspension%empty()
+ call me%j_contaminant_final%empty()
end subroutine
!> Allocate memory for arrays generic to any water body. Individual water bodies
!! may extend this routine to allocate their own body specific variables
subroutine allocateAndInitialiseWaterBody(me)
- class(WaterBody) :: me
- allocate(me%C_spm(C%nSizeClassesSpm), &
- me%C_spm_final(C%nSizeClassesSpm), &
- me%m_spm(C%nSizeClassesSpm), &
- me%C_np(C%npDim(1), C%npDim(2), C%npDim(3)), &
- me%C_np_final(C%npDim(1), C%npDim(2), C%npDim(3)), &
- me%m_np(C%npDim(1), C%npDim(2), C%npDim(3)), &
- me%k_resus(C%nSizeClassesSpm), &
- me%k_settle(C%nSizeClassesSpm), &
- me%W_settle_spm(C%nSizeClassesSpm), &
- me%W_settle_np(C%nSizeClassesNM), &
- me%C_transformed(C%npDim(1), C%npDim(2), C%npDim(3)), &
- me%C_transformed_final(C%npDim(1), C%npDim(2), C%npDim(3)), &
- me%m_transformed(C%npDim(1), C%npDim(2), C%npDim(3)) &
- )
- me%C_spm = 0.0_dp
- me%C_spm_final = 0.0_dp
- me%C_np_final = 0.0_dp
- me%m_spm = 0.0_dp
- me%C_np = 0.0_dp
- me%m_np = 0.0_dp
- me%C_transformed = 0.0_dp
- me%C_transformed_final = 0.0_dp
- me%m_transformed = 0.0_dp
- me%C_dissolved = 0.0_dp
- me%C_dissolved_final = 0.0_dp
- me%m_dissolved = 0.0_dp
- me%bedArea = 0.0_dp
- me%volume = 0.0_dp
+ class(WaterBody), intent(inout) :: me
+ type(Result) :: rslt
+
+ ! Be re-entry safe: deallocate before (re)allocating
+ if (allocated(me%C_spm)) deallocate(me%C_spm)
+ if (allocated(me%C_spm_final)) deallocate(me%C_spm_final)
+ if (allocated(me%m_spm)) deallocate(me%m_spm)
+ if (allocated(me%k_resus)) deallocate(me%k_resus)
+ if (allocated(me%k_settle)) deallocate(me%k_settle)
+ if (allocated(me%W_settle_spm)) deallocate(me%W_settle_spm)
+
+ allocate(me%C_spm( C%nSizeClassesSpm))
+ allocate(me%C_spm_final( C%nSizeClassesSpm))
+ allocate(me%m_spm( C%nSizeClassesSpm))
+ allocate(me%k_resus( C%nSizeClassesSpm))
+ allocate(me%k_settle( C%nSizeClassesSpm))
+ allocate(me%W_settle_spm( C%nSizeClassesSpm))
+
+ me%C_spm = 0.0_dp
+ me%C_spm_final = 0.0_dp
+ me%m_spm = 0.0_dp
+ me%k_resus = 0.0_dp
+ me%k_settle = 0.0_dp
+ me%W_settle_spm = 0.0_dp
+ me%C_dissolved = 0.0_dp
+ me%C_dissolved_final = 0.0_dp
+ me%bedArea = 0.0_dp
+ me%volume = 0.0_dp
+
+ ! Ensure contaminant internals are clean before re-create
+ call me%m_contaminant%finalise()
+
+ rslt = me%m_contaminant%create_from_data( &
+ compartment='water', &
+ contaminantDensity = DATASET%contaminantDensity, &
+ soilAttachmentEfficiency = &
+ DATASET%soilConstantAttachmentEfficiency, &
+ riverAttachmentEfficiency = DATASET%riverAttachmentEfficiency, &
+ estuaryAttachmentEfficiency = &
+ DATASET%estuaryAttachmentEfficiency, &
+ k_diss_pristine = DATASET%contaminant_k_diss_pristine, &
+ k_diss_transformed = DATASET%contaminant_k_diss_transformed, &
+ k_transform_pristine= &
+ DATASET%contaminant_k_transform_pristine, &
+ waterTemperature = real(DATASET%waterTemperature(1), dp) )
+
+ ! If this routine can be re-entered, (re)create flow objects too
+ call rslt%addErrors(.errors. me%j_contaminant_inflow%create())
+ call rslt%addErrors(.errors. me%j_contaminant_outflow%create())
+ call rslt%addErrors(.errors. me%j_contaminant_runoff%create())
+ call rslt%addErrors(.errors. me%j_contaminant_transfers%create())
+ call rslt%addErrors(.errors. me%j_contaminant_pointSources%create())
+ call rslt%addErrors(.errors. me%j_contaminant_diffuseSources%create())
+ call rslt%addErrors(.errors. me%j_contaminant_soilErosion%create())
+ call rslt%addErrors(.errors. me%j_contaminant_bankErosion%create())
+ call rslt%addErrors(.errors. me%j_contaminant_deposition%create())
+ call rslt%addErrors(.errors. me%j_contaminant_resuspension%create())
+ call rslt%addErrors(.errors. me%j_contaminant_final%create())
end subroutine
+
!> Add a point source to this WaterBody
subroutine addPointSourceWaterBody(me, index)
- class(WaterBody) :: me !! This WaterBody
- integer :: index !! Point source index
- type(PointSource) :: newSource ! The new point source to add
- type(PointSource), allocatable :: oldPointSources(:) ! The old point sources
+ class(WaterBody), intent(inout) :: me !! This WaterBody
+ integer, intent(in) :: index !! Point source index
+ type(PointSource) :: newSource !! The new point source to add
+ type(PointSource), allocatable :: oldPointSources(:) !! The old point sources
! Create the new source
call newSource%create(me%x, me%y, index, 'water')
! Store old point sources
@@ -234,29 +330,45 @@ subroutine addPointSourceWaterBody(me, index)
!> Parse input data for this WaterBody
function parseInputDataWaterBody(me) result(rslt)
- class(WaterBody) :: me !! This WaterBody
- type(Result) :: rslt !! The Result object
+ class(WaterBody), intent(inout) :: me !! This WaterBody
+ type(Result) :: rslt !! The Result object
end function
!> Parse new batch input data for this WaterBody
subroutine parseNewBatchDataWaterBody(me)
- class(WaterBody) :: me
+ class(WaterBody), intent(inout) :: me !! This WaterBody
end subroutine
!> Set the final flow arrays for this water body. These final arrays are used by other linked
!! water bodies such that the avoid using the wrong timestep's values, in particular as inflows.
subroutine finaliseUpdate(me)
- class(WaterBody) :: me
+ class(WaterBody), intent(inout) :: me
me%Q_final = me%Q
me%j_spm_final = me%j_spm
- me%j_nm_final = me%j_nm
- me%j_nm_transformed_final = me%j_nm_transformed
- me%j_dissolved = me%j_dissolved
+ me%j_contaminant_final = me%j_contaminant_outflow
me%C_spm_final = me%C_spm
- me%C_np_final = me%C_np
- me%C_transformed_final = me%C_transformed
+ if (me%volume > 0.0_dp) then
+ me%C_dissolved = me%m_contaminant%m_dissolved / me%volume
+ else
+ me%C_dissolved = 0.0_dp
+ end if
me%C_dissolved_final = me%C_dissolved
- me%isUpdated = .false.
end subroutine
+ function get_m_contaminant_WaterBody(me) result(m_contaminant)
+ class(WaterBody), intent(in) :: me
+ type(Contaminant) :: m_contaminant
+ m_contaminant = me%m_contaminant
+ end function
+
+ function get_C_contaminant_WaterBody(me) result(C_contaminant)
+ class(WaterBody), intent(in) :: me
+ real(dp), allocatable :: C_contaminant(:,:,:)
+ allocate(C_contaminant(C%contaminantDim(1), C%contaminantDim(2), C%contaminantDim(3)))
+ if (me%volume > 0.0_dp) then
+ C_contaminant = me%m_contaminant%c / me%volume
+ else
+ C_contaminant = 0.0_dp
+ end if
+ end function
end module
\ No newline at end of file
diff --git a/src/main.f90 b/src/main.f90
index 2700382..87d42f6 100644
--- a/src/main.f90
+++ b/src/main.f90
@@ -1,16 +1,17 @@
!-------------------------------------------------------------------------------!
-!> NanoFASE model !
+!> FASE model !
!> -------------- !
-!> Nanomaterial Fate And Speciation in the Environment !
+!> Fate And Speciation in the Environment !
!> !
!> Authors: Sam Harrison (sharrison@ceh.ac.uk) !
+!> Cansu Uluseker !
!> Stephen Lofts !
!> Virginie Keller !
!> Michael Hutchins !
!> Richard Williams !
!> Institute: UK Centre for Ecology & Hydrology !
!> Repository: https://github.com/nerc-ceh/nanofase !
-!> Documentation: * !
+!> Documentation: https://nerc-ceh.github.io/nanofase !
!> Changelog: https://github.com/NERC-CEH/nanofase/blob/develop/CHANGELOG.md !
!> License: BSD 3-Clause, !
!> https://github.com/NERC-CEH/nanofase/blob/develop/LICENSE !
@@ -81,7 +82,7 @@ program main
end if
! Check if we've been asked to run a warm up period, which runs the first N timesteps' worth
- ! of data, excluding NM inputs, through the model, where N is specified by C%warmUpPeriod
+ ! of data, excluding contaminant inputs, through the model, where N is specified by C%warmUpPeriod
if (C%warmUpPeriod > 0) then
! Log some info about it
call LOGR%add("Running for warm up period of " // trim(str(C%warmUpPeriod)) // " time steps", COLOR_BLUE)
@@ -165,7 +166,7 @@ program main
! Write the simulation summary to file, close output data files and report that it was a successful
! model run. Pass the steady state iterator in to give number of iterations until steady state
call output%finalise(i-1)
- call LOGR%add("Model run completeled successfully", COLOR_GREEN)
+ call LOGR%add("Model run completed successfully", COLOR_GREEN)
! Timings
call cpu_time(finish)