diff --git a/CMakeLists.txt b/CMakeLists.txt index 6447d01c..a17254f1 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -146,11 +146,19 @@ if(BUILD_NUOPC) PRIVATE $ $ + $ + $ + $ $ $ $ ) + # Link GOCART2G library if available (needed for drydep process) + if(TARGET GOCART2G) + target_link_libraries(cc_nuopc PRIVATE $) + endif() + # Include directories for compilation target_include_directories( cc_nuopc diff --git a/cmake/generate_metstate_macros.py b/cmake/generate_metstate_macros.py index 1672bb46..8e5efb22 100644 --- a/cmake/generate_metstate_macros.py +++ b/cmake/generate_metstate_macros.py @@ -341,7 +341,7 @@ def classify_fields(fields): """ # Categorical 3D fields with non-vertical dimensions (soil, land use, etc.) categorical_patterns = { - 'SOILM', 'FRSOIL', # Soil-related + 'SOILM', 'SOILT', 'FRSOIL', # Soil-related 'FRLANDUSE', 'FRLAI', 'FRZ0', # Land use categories } @@ -426,6 +426,7 @@ def get_field_description(name): 'F_UNDER_PBLTOP': 'Fraction under PBL top [1]', # Categorical 3D fields 'SOILM': 'Volumetric soil moisture [m3/m3] (nsoil layers)', + 'SOILT': 'Temperature of soil layer [K] (nsoil layers)', 'FRLANDUSE': 'Fractional land use [1] (nlanduse categories)', 'FRSOIL': 'Fractional soil [1] (nsoil categories)', 'FRLAI': 'LAI per land use type [m2/m2] (nlanduse categories)', @@ -677,6 +678,7 @@ def write_virtualmet_type(fields, output_file): ---------- fields : list of tuple List of (name, type_name, rank, dims, is_edge) for each field. + List of (name, type_name, rank, dims, is_edge) for each field. output_file : str Path to output .inc file. """ @@ -873,6 +875,7 @@ def write_virtualmet_cleanup(fields, output_file): f.write("! Generated VirtualMetType cleanup procedure\n") f.write("! This macro should be included in the virtual_met_cleanup subroutine\n") f.write("! Auto-generated from MetState field definitions\n") + f.write("! Now includes scalar fields since VirtualMet contains them\n") f.write("! Now includes scalar fields since VirtualMet contains them\n\n") # Nullify 3D atmospheric field pointers @@ -1023,7 +1026,7 @@ def write_set_field_2d_real(fields, output_file): f.write(f" return\n") f.write(f" end if\n") f.write(f" end if\n") - elif name.lower() in ("frsoil", "soilm"): + elif name.lower() in ("frsoil", "soilm", "soilt"): f.write(f" if (.not. allocated(this%{name})) then\n") f.write(f" ! Allocate with default soil parameters if not already allocated\n") f.write(f" if (this%nSOILTYPE > 0) then\n") @@ -1110,6 +1113,12 @@ def get_conditional_allocation_info(field_name): 'dimension_var': 'this%nSOIL', 'type': 'soil' }, + 'soilt': { + 'condition': 'nsoil > 0', + 'dimension': 'nsoil', + 'dimension_var': 'this%nSOIL', + 'type': 'soil' + }, 'frsoil': { 'condition': 'nsoiltype > 0', 'dimension': 'nsoiltype', diff --git a/docs/processes/drydep/drydep.md b/docs/processes/drydep/drydep.md new file mode 100644 index 00000000..2c47f358 --- /dev/null +++ b/docs/processes/drydep/drydep.md @@ -0,0 +1,267 @@ +# DryDep Process + +**Process Type:** Deposition +**Description:** Process for computing dry deposition of gas and aerosol species +**Author:** Wei Li +**Generated:** 2025-11-25T22:20:02.547522 + +## Overview + +The DryDep process implements Process for computing dry deposition of gas and aerosol species. This process provides a modular, extensible framework for deposition calculations within the CATChem chemical transport model. + +## Available Schemes + +### WESELY Scheme + +**Name:** `wesely` +**Description:** Wesely 1989 gas dry deposition scheme +**Author:** Wei Li +**Reference:** Wesely, M. L. [1989] Parameterization of surface resistances to gaseous dry deposition... +#### Parameters + +| Parameter | Default | Range | Description | +|-----------|---------|--------|-------------| +| `scale_factor` | 1.0 | - | DryDep velocity scale factor | +| `co2_effect` | True | - | Apply CO2 effect on stomatal conductance | +| `co2_level` | 600.0 | - | Ambient CO2 level for stomatal conductance adjustment | +| `co2_reference` | 380.0 | - | Reference CO2 level for stomatal conductance adjustment | + +#### Required Meteorological Fields + +- `USTAR` - Meteorological field required for scheme computation +- `TSTEP` - Meteorological field required for scheme computation +- `TS` - Meteorological field required for scheme computation +- `SWGDN` - Meteorological field required for scheme computation +- `SUNCOSmid` - Meteorological field required for scheme computation +- `OBK` - Meteorological field required for scheme computation +- `CLDFRC` - Meteorological field required for scheme computation +- `BXHEIGHT` - Meteorological field required for scheme computation +- `Z0` - Meteorological field required for scheme computation +- `PS` - Meteorological field required for scheme computation +- `FRLAI` - Meteorological field required for scheme computation +- `ILAND` - Meteorological field required for scheme computation +- `SALINITY` - Meteorological field required for scheme computation +- `FRLANDUSE` - Meteorological field required for scheme computation +- `TSKIN` - Meteorological field required for scheme computation +- `LON` - Meteorological field required for scheme computation +- `LAT` - Meteorological field required for scheme computation +- `LUCNAME` - Meteorological field required for scheme computation +- `IsSnow` - Meteorological field required for scheme computation +- `IsIce` - Meteorological field required for scheme computation +- `IsLand` - Meteorological field required for scheme computation + + +### GOCART Scheme + +**Name:** `gocart` +**Description:** GOCART-2G aerosol dry deposition scheme +**Author:** Wei Li & Lacey Holland +**Reference:** Allison et al. [2024] Benchmarking GOCART-2G in GEOS +#### Parameters + +| Parameter | Default | Range | Description | +|-----------|---------|--------|-------------| +| `scale_factor` | 1.0 | - | Dry deposition velocity scale factor | +| `resuspension` | False | - | Apply resuspension for dry deposition | + +#### Required Meteorological Fields + +- `USTAR` - Meteorological field required for scheme computation +- `TSTEP` - Meteorological field required for scheme computation +- `T` - Meteorological field required for scheme computation +- `AIRDEN` - Meteorological field required for scheme computation +- `Z` - Meteorological field required for scheme computation +- `LWI` - Meteorological field required for scheme computation +- `PBLH` - Meteorological field required for scheme computation +- `HFLUX` - Meteorological field required for scheme computation +- `Z0H` - Meteorological field required for scheme computation +- `U10M` - Meteorological field required for scheme computation +- `V10M` - Meteorological field required for scheme computation +- `FRLAKE` - Meteorological field required for scheme computation +- `GWETTOP` - Meteorological field required for scheme computation + + +### ZHANG Scheme + +**Name:** `zhang` +**Description:** Zhang et al. [2001] scheme with Emerson et al. [2020] updates +**Author:** Wei Li +**Reference:** Zhang et al., 2001; Emerson et al., 2020 +#### Parameters + +| Parameter | Default | Range | Description | +|-----------|---------|--------|-------------| +| `scale_factor` | 1.0 | - | Dry deposition velocity scale factor | + +#### Required Meteorological Fields + +- `USTAR` - Meteorological field required for scheme computation +- `TSTEP` - Meteorological field required for scheme computation +- `TS` - Meteorological field required for scheme computation +- `OBK` - Meteorological field required for scheme computation +- `BXHEIGHT` - Meteorological field required for scheme computation +- `Z0` - Meteorological field required for scheme computation +- `RH` - Meteorological field required for scheme computation +- `PS` - Meteorological field required for scheme computation +- `U10M` - Meteorological field required for scheme computation +- `V10M` - Meteorological field required for scheme computation +- `FRLANDUSE` - Meteorological field required for scheme computation +- `ILAND` - Meteorological field required for scheme computation +- `LUCNAME` - Meteorological field required for scheme computation +- `IsSnow` - Meteorological field required for scheme computation +- `IsIce` - Meteorological field required for scheme computation + + + +## Process Interface + +### Species + +The drydep process operates on the following chemical species: + + +### Required Inputs + + + +### Process Diagnostics + +| Diagnostic | Units | Description | +|------------|-------|-------------| +| `drydep_con_per_species` | ug/kg or ppm | Dry deposition concentration per species | +| `drydep_velocity_per_species` | m/s | Dry deposition velocity | + +## Usage + +### Basic Integration + +```fortran +use DryDepProcessCreator_Mod +use DryDepCommon_Mod + +! Create process instance +type(DryDepProcess_t) :: process +call create_drydep_process(process, config_data) + +! Use process in model time step +call process%run(state, dt) +``` + +### Scheme Selection + +The process supports multiple schemes. Select your desired scheme: + +```fortran +! Use WESELY scheme +process%scheme_name = "wesely" +``` +```fortran +! Use GOCART scheme +process%scheme_name = "gocart" +``` +```fortran +! Use ZHANG scheme +process%scheme_name = "zhang" +``` + +## Implementation Details + +### Pure Science Kernels + +Each scheme is implemented as a pure science kernel with no infrastructure dependencies: + +```fortran +! WESELY scheme +pure subroutine compute_wesely( & + num_layers, num_species, params, & + USTAR, & TSTEP, & TS, & SWGDN, & SUNCOSmid, & OBK, & CLDFRC, & BXHEIGHT, & Z0, & PS, & FRLAI, & ILAND, & SALINITY, & FRLANDUSE, & TSKIN, & LON, & LAT, & LUCNAME, & IsSnow, & IsIce, & IsLand, & + species_conc, emission_flux) +``` +```fortran +! GOCART scheme +pure subroutine compute_gocart( & + num_layers, num_species, params, & + USTAR, & TSTEP, & T, & AIRDEN, & Z, & LWI, & PBLH, & HFLUX, & Z0H, & U10M, & V10M, & FRLAKE, & GWETTOP, & + species_conc, emission_flux) +``` +```fortran +! ZHANG scheme +pure subroutine compute_zhang( & + num_layers, num_species, params, & + USTAR, & TSTEP, & TS, & OBK, & BXHEIGHT, & Z0, & RH, & PS, & U10M, & V10M, & FRLANDUSE, & ILAND, & LUCNAME, & IsSnow, & IsIce, & + species_conc, emission_flux) +``` + +### Host Model Responsibilities + +The host model (CATChem infrastructure) handles: + +- Parameter initialization and validation +- Input array validation and error handling +- Memory management and array allocation +- Integration with model time stepping +- Diagnostic output management + +## Configuration + +### YAML Configuration Example + +```yaml +processes: + drydep: + enabled: true + scheme: "wesely" + parameters: + scale_factor: 1.0 + co2_effect: True + co2_level: 600.0 + co2_reference: 380.0 + diagnostics: + enabled: true + output_frequency: "daily" +``` + +## Technical Specifications + +- **Parallelization:** Column +- **Memory Requirements:** Low +- **Timestep Dependency:** Independent +- **Multiphase Support:** No +- **Size Bin Support:** No +- **Vectorization:** Supported + +## Files Generated + +### Source Code +- `src/process/drydep/ProcessDryDepInterface_Mod.F90` - Main process interface +- `src/process/drydep/DryDepCommon_Mod.F90` - Common types and parameters +- `src/process/drydep/DryDepProcessCreator_Mod.F90` - Process factory +- `src/process/drydep/schemes/DryDepScheme_WESELY_Mod.F90` - Wesely 1989 gas dry deposition scheme +- `src/process/drydep/schemes/DryDepScheme_GOCART_Mod.F90` - GOCART-2G aerosol dry deposition scheme +- `src/process/drydep/schemes/DryDepScheme_ZHANG_Mod.F90` - Zhang et al. [2001] scheme with Emerson et al. [2020] updates + +### Tests +- `tests/process/drydep/unit/` - Unit tests +- `tests/process/drydep/integration/` - Integration tests + +### Documentation +- `docs/processes/drydep/drydep.md` - This documentation + +## Contributing + +When modifying or extending this process: + +1. **Science Changes:** Modify the scheme modules in `schemes/` +2. **Interface Changes:** Update the main interface module +3. **New Schemes:** Add new scheme modules and update the creator +4. **Tests:** Add corresponding unit and integration tests +5. **Documentation:** Update this documentation file + +## References + +- WESELY: Wesely, M. L. [1989] Parameterization of surface resistances to gaseous dry deposition... +- GOCART: Allison et al. [2024] Benchmarking GOCART-2G in GEOS +- ZHANG: Zhang et al., 2001; Emerson et al., 2020 + +--- +*This documentation was automatically generated by the CATChem Process Generator on 2025-11-25T22:20:02.547522* diff --git a/docs/processes/settling/settling.md b/docs/processes/settling/settling.md new file mode 100644 index 00000000..062116af --- /dev/null +++ b/docs/processes/settling/settling.md @@ -0,0 +1,166 @@ +# Settling Process + +**Process Type:** Deposition +**Description:** Process for computing gravitational settling of aerosol species +**Author:** Wei Li +**Generated:** 2025-12-18T14:12:33.301923 + +## Overview + +The Settling process implements Process for computing gravitational settling of aerosol species. This process provides a modular, extensible framework for deposition calculations within the CATChem chemical transport model. + +## Available Schemes + +### GOCART Scheme + +**Name:** `gocart` +**Description:** GOCART gravitational settling scheme +**Author:** Wei Li +**Reference:** GOCART2G process library Chem_SettlingSimple function +#### Parameters + +| Parameter | Default | Range | Description | +|-----------|---------|--------|-------------| +| `scale_factor` | 1.0 | - | settling velocity factor | +| `simple_scheme` | False | - | read in mie data for wet particles if true; otherwise calculate particles wet swelling internally | +| `swelling_method` | 1 | - | method for calculating particle swelling: 1 Fitzgerald 1975; 2 for Gerber 1985 | +| `correction_maring` | False | - | correct the settling velocity following Maring et al, 2003 | + +#### Required Meteorological Fields + +- `T` - Meteorological field required for scheme computation +- `TSTEP` - Meteorological field required for scheme computation +- `AIRDEN` - Meteorological field required for scheme computation +- `RH` - Meteorological field required for scheme computation +- `Z` - Meteorological field required for scheme computation +- `PMID` - Meteorological field required for scheme computation +- `DELP` - Meteorological field required for scheme computation + + + +## Process Interface + +### Species + +The settling process operates on the following chemical species: + + +### Required Inputs + + + +### Process Diagnostics + +| Diagnostic | Units | Description | +|------------|-------|-------------| +| `settling_velocity_per_species_per_level` | m/s | settling velocity per species per level | +| `settling_flux_per_species` | kg/m2/s | settling flux per species across column | + +## Usage + +### Basic Integration + +```fortran +use SettlingProcessCreator_Mod +use SettlingCommon_Mod + +! Create process instance +type(SettlingProcess_t) :: process +call create_settling_process(process, config_data) + +! Use process in model time step +call process%run(state, dt) +``` + +### Scheme Selection + +The process supports multiple schemes. Select your desired scheme: + +```fortran +! Use GOCART scheme +process%scheme_name = "gocart" +``` + +## Implementation Details + +### Pure Science Kernels + +Each scheme is implemented as a pure science kernel with no infrastructure dependencies: + +```fortran +! GOCART scheme +pure subroutine compute_gocart( & + num_layers, num_species, params, & + T, & TSTEP, & AIRDEN, & RH, & Z, & PMID, & DELP, & + species_conc, emission_flux) +``` + +### Host Model Responsibilities + +The host model (CATChem infrastructure) handles: + +- Parameter initialization and validation +- Input array validation and error handling +- Memory management and array allocation +- Integration with model time stepping +- Diagnostic output management + +## Configuration + +### YAML Configuration Example + +```yaml +processes: + settling: + enabled: true + scheme: "gocart" + parameters: + scale_factor: 1.0 + simple_scheme: False + swelling_method: 1 + correction_maring: False + diagnostics: + enabled: true + output_frequency: "daily" +``` + +## Technical Specifications + +- **Parallelization:** Column +- **Memory Requirements:** Low +- **Timestep Dependency:** Independent +- **Multiphase Support:** No +- **Size Bin Support:** No +- **Vectorization:** Supported + +## Files Generated + +### Source Code +- `src/process/settling/ProcessSettlingInterface_Mod.F90` - Main process interface +- `src/process/settling/SettlingCommon_Mod.F90` - Common types and parameters +- `src/process/settling/SettlingProcessCreator_Mod.F90` - Process factory +- `src/process/settling/schemes/SettlingScheme_GOCART_Mod.F90` - GOCART gravitational settling scheme + +### Tests +- `tests/process/settling/unit/` - Unit tests +- `tests/process/settling/integration/` - Integration tests + +### Documentation +- `docs/processes/settling/settling.md` - This documentation + +## Contributing + +When modifying or extending this process: + +1. **Science Changes:** Modify the scheme modules in `schemes/` +2. **Interface Changes:** Update the main interface module +3. **New Schemes:** Add new scheme modules and update the creator +4. **Tests:** Add corresponding unit and integration tests +5. **Documentation:** Update this documentation file + +## References + +- GOCART: GOCART2G process library Chem_SettlingSimple function + +--- +*This documentation was automatically generated by the CATChem Process Generator on 2025-12-18T14:12:33.301923* diff --git a/docs/processes/wetdep/wetdep.md b/docs/processes/wetdep/wetdep.md new file mode 100644 index 00000000..d32813bd --- /dev/null +++ b/docs/processes/wetdep/wetdep.md @@ -0,0 +1,163 @@ +# WetDep Process + +**Process Type:** Deposition +**Description:** Process for computing wet deposition of gas and aerosol species +**Author:** Wei Li +**Generated:** 2025-12-15T16:30:33.934868 + +## Overview + +The WetDep process implements Process for computing wet deposition of gas and aerosol species. This process provides a modular, extensible framework for deposition calculations within the CATChem chemical transport model. + +## Available Schemes + +### JACOB Scheme + +**Name:** `jacob` +**Description:** Jacob et al. [2000] wet deposition scheme +**Author:** Wei Li +**Reference:** Jacob, D. J. et al., [2000] Harvard wet deposition scheme for GMI +#### Parameters + +| Parameter | Default | Range | Description | +|-----------|---------|--------|-------------| +| `scale_factor` | 1.0 | - | Washout tuning factor | +| `radius_threshold` | 1.0 | - | Radius threshold for aerosol wet deposition (um) | + +#### Required Meteorological Fields + +- `T` - Meteorological field required for scheme computation +- `TSTEP` - Meteorological field required for scheme computation +- `AIRDEN_DRY` - Meteorological field required for scheme computation +- `MAIRDEN` - Meteorological field required for scheme computation +- `PFLLSAN` - Meteorological field required for scheme computation +- `PFILSAN` - Meteorological field required for scheme computation +- `PEDGE` - Meteorological field required for scheme computation +- `REEVAPLS` - Meteorological field required for scheme computation + + + +## Process Interface + +### Species + +The wetdep process operates on the following chemical species: + + +### Required Inputs + + + +### Process Diagnostics + +| Diagnostic | Units | Description | +|------------|-------|-------------| +| `wetdep_mass_per_species_per_level` | kg/m2 | Wet deposition mass loss per species per level | +| `wetdep_flux_per_species_per_level` | kg/m2/s | Wet deposition flux per species per level | + +## Usage + +### Basic Integration + +```fortran +use WetDepProcessCreator_Mod +use WetDepCommon_Mod + +! Create process instance +type(WetDepProcess_t) :: process +call create_wetdep_process(process, config_data) + +! Use process in model time step +call process%run(state, dt) +``` + +### Scheme Selection + +The process supports multiple schemes. Select your desired scheme: + +```fortran +! Use JACOB scheme +process%scheme_name = "jacob" +``` + +## Implementation Details + +### Pure Science Kernels + +Each scheme is implemented as a pure science kernel with no infrastructure dependencies: + +```fortran +! JACOB scheme +pure subroutine compute_jacob( & + num_layers, num_species, params, & + T, & TSTEP, & AIRDEN_DRY, & MAIRDEN, & PFLLSAN, & PFILSAN, & PEDGE, & REEVAPLS, & + species_conc, emission_flux) +``` + +### Host Model Responsibilities + +The host model (CATChem infrastructure) handles: + +- Parameter initialization and validation +- Input array validation and error handling +- Memory management and array allocation +- Integration with model time stepping +- Diagnostic output management + +## Configuration + +### YAML Configuration Example + +```yaml +processes: + wetdep: + enabled: true + scheme: "jacob" + parameters: + scale_factor: 1.0 + radius_threshold: 1.0 + diagnostics: + enabled: true + output_frequency: "daily" +``` + +## Technical Specifications + +- **Parallelization:** Column +- **Memory Requirements:** Low +- **Timestep Dependency:** Independent +- **Multiphase Support:** No +- **Size Bin Support:** No +- **Vectorization:** Supported + +## Files Generated + +### Source Code +- `src/process/wetdep/ProcessWetDepInterface_Mod.F90` - Main process interface +- `src/process/wetdep/WetDepCommon_Mod.F90` - Common types and parameters +- `src/process/wetdep/WetDepProcessCreator_Mod.F90` - Process factory +- `src/process/wetdep/schemes/WetDepScheme_JACOB_Mod.F90` - Jacob et al. [2000] wet deposition scheme + +### Tests +- `tests/process/wetdep/unit/` - Unit tests +- `tests/process/wetdep/integration/` - Integration tests + +### Documentation +- `docs/processes/wetdep/wetdep.md` - This documentation + +## Contributing + +When modifying or extending this process: + +1. **Science Changes:** Modify the scheme modules in `schemes/` +2. **Interface Changes:** Update the main interface module +3. **New Schemes:** Add new scheme modules and update the creator +4. **Tests:** Add corresponding unit and integration tests +5. **Documentation:** Update this documentation file + +## References + +- JACOB: Jacob, D. J. et al., [2000] Harvard wet deposition scheme for GMI + +--- +*This documentation was automatically generated by the CATChem Process Generator on 2025-12-15T16:30:33.934868* diff --git a/drivers/nuopc/CATChem_field_mapping.yml b/drivers/nuopc/CATChem_field_mapping.yml index da09fef4..e34c3f2d 100644 --- a/drivers/nuopc/CATChem_field_mapping.yml +++ b/drivers/nuopc/CATChem_field_mapping.yml @@ -30,7 +30,7 @@ import_fields: units: "m/s" optional: false - standard_name: "inst_merid_wind_levels" - catchem_var: "U" + catchem_var: "V" dimensions: 3 units: "m/s" optional: false @@ -55,7 +55,7 @@ import_fields: units: "m/s" optional: false - standard_name: "inst_aerodynamic_conductance" - catchem_var: "Z0H" + catchem_var: "CMM" dimensions: 2 units: "s/m" optional: false @@ -115,17 +115,17 @@ import_fields: units: "m" optional: false - standard_name: "height" - catchem_var: "OBK" + catchem_var: "ORO" dimensions: 2 units: "m" optional: true - standard_name: "canopy_moisture_storage" - catchem_var: "OBK" + catchem_var: "WCA" dimensions: 2 units: "m3" optional: true - standard_name: "inst_canopy_resistance" - catchem_var: "OBK" + catchem_var: "RCA" dimensions: 2 units: "s/m" optional: true @@ -164,6 +164,26 @@ import_fields: dimensions: 2 units: "1" optional: false + - standard_name: "lake_fraction" + catchem_var: "FRLAKE" + dimensions: 2 + units: "1" + optional: false + - standard_name: "inst_surface_soil_wetness" + catchem_var: "GWETTOP" + dimensions: 2 + units: "1" + optional: false + - standard_name: "inst_ice_nonconv_tendency_levels" + catchem_var: "PFILSAN" + dimensions: 3 + units: "kg/m2/s" + optional: false + - standard_name: "inst_liq_nonconv_tendency_levels" + catchem_var: "PFLLSAN" + dimensions: 3 + units: "kg/m2/s" + optional: false - standard_name: "soil_type" catchem_var: "DSOILTYPE" dimensions: 2 @@ -180,7 +200,7 @@ import_fields: units: "m3/m3" optional: false - standard_name: "temperature_of_soil_layer" - catchem_var: "SOILM" + catchem_var: "SOILT" dimensions: 3 units: "K" optional: true @@ -191,28 +211,28 @@ import_fields: optional: false export_fields: - - standard_name: "inst_tracer_mass_frac" - catchem_var: "chem" - dimensions: 4 - units: "ug/kg" - optional: false - - standard_name: "inst_tracer_diag_aod" - catchem_var: "AOD" - dimensions: 2 - units: "1" - optional: false - - standard_name: "inst_tracer_diag_coszens" - catchem_var: "coszens" - dimensions: 2 - units: "1" - optional: false - - standard_name: "inst_tracer_diag_jo3o1d" - catchem_var: "jo3o1d" - dimensions: 2 - units: "1" - optional: false - - standard_name: "inst_tracer_diag_jno2" - catchem_var: "jno2" - dimensions: 2 - units: "1" - optional: false + - standard_name: "inst_tracer_mass_frac" + catchem_var: "chem" + dimensions: 4 + units: "ug/kg" + optional: false + - standard_name: "inst_tracer_diag_aod" + catchem_var: "AOD" + dimensions: 2 + units: "1" + optional: false + - standard_name: "inst_tracer_diag_coszens" + catchem_var: "coszens" + dimensions: 2 + units: "1" + optional: false + - standard_name: "inst_tracer_diag_jo3o1d" + catchem_var: "jo3o1d" + dimensions: 2 + units: "1" + optional: false + - standard_name: "inst_tracer_diag_jno2" + catchem_var: "jno2" + dimensions: 2 + units: "1" + optional: false diff --git a/drivers/nuopc/catchem_nuopc_cap.F90 b/drivers/nuopc/catchem_nuopc_cap.F90 index 9e1dbb78..d66a4558 100644 --- a/drivers/nuopc/catchem_nuopc_cap.F90 +++ b/drivers/nuopc/catchem_nuopc_cap.F90 @@ -35,7 +35,7 @@ !! \date November 2024 !! \ingroup catchem_nuopc_group -module aqm +module cc_nuopc ! Renamed from catchem_nuopc_cap to aqm for UFS Driver compatibility ! UFS expects: use aqm, only: AQM_SS => SetServices (after FRONT_AQM=aqm substitution) @@ -484,7 +484,7 @@ subroutine ModelAdvance(model, rc) line=__LINE__, file=__FILE__)) return ! bail out ! Import meteorological data from other components - call transform_nuopc_to_catchem(is%wrap, importState, rc) + call transform_nuopc_to_catchem(is%wrap, importState, currTime, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=__FILE__)) return @@ -591,4 +591,4 @@ function real_to_string(val) result(str) str = adjustl(str) end function real_to_string -end module aqm +end module cc_nuopc diff --git a/drivers/nuopc/catchem_nuopc_interface.F90 b/drivers/nuopc/catchem_nuopc_interface.F90 index b1ea3797..0e585a82 100644 --- a/drivers/nuopc/catchem_nuopc_interface.F90 +++ b/drivers/nuopc/catchem_nuopc_interface.F90 @@ -33,12 +33,14 @@ module catchem_nuopc_interface ! use catchem_nuopc_netcdf_out ! use machine, only: kind_phys use precision_mod, only: fp + use Constants, only: g0, Rd use Error_Mod, only : CC_SUCCESS, CC_FAILURE use StateManager_Mod, only: StateManagerType use ProcessManager_Mod, only: ProcessManagerType use error_mod, only: ErrorManagerType use MetState_Mod, only: MetStateType use ChemState_Mod, only: ChemStateType + use TimeState_Mod, only: TimeStateType use DiagnosticManager_Mod, only: DiagnosticManagerType use DiagnosticInterface_Mod, only: DiagnosticRegistryType, DIAG_REAL_SCALAR, DIAG_REAL_1D, DIAG_REAL_2D, DIAG_REAL_3D use aqmio, only: AQMIO_Create, AQMIO_Write, AQMIO_Close, AQMIO_Write1D, AQMIO_FMT_NETCDF @@ -182,6 +184,7 @@ subroutine catchem_nuopc_init(model, config_file, lat, lon, nlev, tracerinfo, in type(MetStateType), pointer :: met_state type(ChemStateType), pointer :: chem_state integer :: nx, ny, num_processes, stat + integer(ESMF_KIND_I8) :: tstep_seconds character(len=128), allocatable :: tracer_names(:) !< NUOPC tracer name character(len=128), allocatable :: tracer_units(:) !< NUOPC tracer unit type(CATChem_InternalState) :: is @@ -220,6 +223,10 @@ subroutine catchem_nuopc_init(model, config_file, lat, lon, nlev, tracerinfo, in met_state => state_mgr%get_met_state_ptr() met_state%lat = lat met_state%lon = lon + ! Convert longitude from 0–360 to -180–180 + where (met_state%lon > 180.0_fp) + met_state%lon = met_state%lon - 360.0_fp + end where !populate tracer mapping using process-local tracer_map call TracerInfoGet(tracerinfo, 'tracerNames', tracer_names, rc=rc) @@ -279,8 +286,11 @@ subroutine catchem_nuopc_init(model, config_file, lat, lon, nlev, tracerinfo, in if (present(startTime)) then cc_wrap%startTime = startTime end if + if (present(timeStep)) then cc_wrap%timeStep = timeStep + call ESMF_TimeIntervalGet(timeStep, s_i8=tstep_seconds, rc=rc) + state_mgr%tstep = real(tstep_seconds, fp) end if ! Add all enabled processes from configuration @@ -458,21 +468,39 @@ end subroutine catchem_nuopc_finalize !! \param kme Vertical dimension !! \param rc ESMF return code !! - subroutine transform_nuopc_to_catchem(cc_wrap, importState, rc) + subroutine transform_nuopc_to_catchem(cc_wrap, importState, currTime, rc) type(cc_wrap_type), intent(inout) :: cc_wrap type(ESMF_State), intent(in) :: importState + type(ESMF_Time), intent(in) :: currTime integer, intent(out) :: rc type(ESMF_Field) :: field + type(StateManagerType), pointer :: state_mgr + type(ErrorManagerType), pointer :: error_mgr + type(TimeStateType), pointer :: time_state + type(MetStateType), pointer :: met_state logical, allocatable :: set_required_met(:) + integer(ESMF_KIND_I8) :: timestep_seconds + integer :: year, month, day, hour, minute, second integer :: i, n, n_met !type(cc_wrap_type), pointer :: cc_wrap rc = ESMF_SUCCESS - ! Get process-local state - !cc_wrap => get_cc_wrap() + ! assign time to catchem model's time state + state_mgr => cc_wrap%catchem_model%get_state_manager() + error_mgr => state_mgr%get_error_manager() + time_state => state_mgr%get_time_state_ptr() + met_state => state_mgr%get_met_state_ptr() + + call ESMF_TimeGet(currTime, yy=year, mm=month, dd=day, & + h=hour, m=minute, s=second, rc=rc) + call ESMF_TimeIntervalGet(cc_wrap%timeStep, s_i8=timestep_seconds, rc=rc) + call time_state%init(year, month, day, hour, minute, second, real(timestep_seconds), error_mgr, rc) + if (rc /= CC_SUCCESS) then + return !maybe add an error message + end if ! This is to check if all required met fields in CATChem are set if (allocated(cc_wrap%catchem_model%required_fields)) then @@ -506,6 +534,23 @@ subroutine transform_nuopc_to_catchem(cc_wrap, importState, rc) end do + !derive some met fields if required after reading from NUOPC + if (allocated(cc_wrap%catchem_model%required_fields)) then + do i = 1, n_met + if (.not. set_required_met(i)) then + call met_state%derive_field(trim(cc_wrap%catchem_model%required_fields(i)), error_mgr, time_state, rc) + if (rc /= CC_SUCCESS) then + call ESMF_LogSetError(ESMF_RC_INTNRL_BAD, & + msg="Error deriving required met field: "// trim(cc_wrap%catchem_model%required_fields(i)), & + line=__LINE__, file=__FILE__, rcToReturn=rc) + return ! bail out + else + set_required_met(i) = .true. + end if + end if + end do + end if + !check if all require met fields are set if (allocated(cc_wrap%catchem_model%required_fields)) then do i = 1, n_met @@ -591,7 +636,7 @@ subroutine transform_field_to_catchem(cc_wrap, field, field_map, required, is_me integer, intent(out) :: rc !local vars - type(ProcessManagerType), pointer :: process_mgr + !type(ProcessManagerType), pointer :: process_mgr type(StateManagerType), pointer :: state_mgr type(ErrorManagerType), pointer :: error_mgr type(MetStateType), pointer :: met_state @@ -599,16 +644,14 @@ subroutine transform_field_to_catchem(cc_wrap, field, field_map, required, is_me !type(cc_wrap_type), pointer :: cc_wrap real(ESMF_KIND_R8), pointer :: fptr4d(:,:,:,:), fptr3d(:,:,:), fptr2d(:,:) real(ESMF_KIND_R8), pointer :: fptr4d_rev(:,:,:,:), fptr3d_rev(:,:,:) + real(fp), pointer :: column_ptr(:) !catchem met column pointer to get vertical dimension for nz+1 variables real(ESMF_KIND_R8) :: unit_conv - integer :: i, j, k, v, ni, nj, nk, nv, kk, v_cc, met_index + integer :: i, j, k, v, ni, nj, nk, nk1, nv, kk, v_cc, met_index rc = ESMF_SUCCESS ! Get process-local state - !cc_wrap => get_cc_wrap() - !write(*,*) 'Start Field set for: ' // field_map%catchem_var - - process_mgr => cc_wrap%catchem_model%get_process_manager() + !process_mgr => cc_wrap%catchem_model%get_process_manager() state_mgr => cc_wrap%catchem_model%get_state_manager() error_mgr => state_mgr%get_error_manager() met_state => state_mgr%get_met_state_ptr() @@ -636,6 +679,8 @@ subroutine transform_field_to_catchem(cc_wrap, field, field_map, required, is_me trim(field_map%catchem_var) == 'LWI') then !convert to integer call met_state%set_field(trim(field_map%catchem_var), int(fptr2d), error_mgr, rc) + else if (trim(field_map%catchem_var) == 'Z0') then ! roughness length in cm in NUOPC but m in CATChem + call met_state%set_field(trim(field_map%catchem_var), real(fptr2d, fp)*0.01_fp, error_mgr, rc) else call met_state%set_field(trim(field_map%catchem_var), real(fptr2d, fp), error_mgr, rc) end if @@ -660,19 +705,6 @@ subroutine transform_field_to_catchem(cc_wrap, field, field_map, required, is_me return ! bail out end if - !set some special cases - if (trim(field_map%catchem_var) == 'TS') then !assign SST the same as TS - call met_state%set_field('SST', real(fptr2d, fp), error_mgr, rc) - if (rc == CC_SUCCESS) then - if (allocated(cc_wrap%catchem_model%required_fields)) then - met_index = cc_wrap%catchem_model%get_required_met_index( 'SST' ) - if (met_index >0 ) then - is_met_set(met_index) = .true. - end if - end if - end if - end if - ! 3D meteorological fields case (3) nullify(fptr3d, fptr3d_rev) @@ -684,17 +716,44 @@ subroutine transform_field_to_catchem(cc_wrap, field, field_map, required, is_me nj = size(fptr3d, 2) nk = size(fptr3d, 3) - ! Allocate fptr3d_rev with the same dimensions as fptr3d - allocate(fptr3d_rev(ni, nj, nk)) + if (trim(field_map%catchem_var) .ne. 'SOILM' .and. trim(field_map%catchem_var) .ne. 'SOILT') then + !get catchem receriver vertical dimension for nz+1 variables while NUOPC has nz levels + !Currently only PFILSAN and PFLLSAN are in this case following GOCART and in most cases, + ! nk == nk1 + call met_state%get_field_ptr(trim(field_map%catchem_var), i=1, j=1, col_ptr=column_ptr, rc=rc) + if (rc /= CC_SUCCESS) then + call ESMF_LogSetError(ESMF_RC_INTNRL_BAD, & + msg="Error getting met field pointer for: " // trim(field_map%catchem_var), & + line=__LINE__, file=__FILE__, rcToReturn=rc) + return ! bail out + end if + nk1 = size(column_ptr) + else + !SOILM and SOILT have not been allocated because we do not have soil layers yet and the get_field_ptr will fail + nk1 = nk + end if - !reverse vertical layers - do k = 1, nk - kk = nk - k + 1 + ! Allocate fptr3d_rev with the same dimensions as fptr3d + allocate(fptr3d_rev(ni, nj, nk1)) + + ! -- map provider field levels to receiver field levels in the same (not reverse) order + ! -- NOTE: if provider field from NUOPC has fewer vertical levels than the receiver field in CATChem, + ! -- the remaining receiver field levels are filled by replicating values from + ! -- the closest available level in the provider field. + kk = 1 + do k = 1, nk1 + !kk = nk - k + 1 !no need to reverse + !kk = k do j = 1, nj do i = 1, ni - fptr3d_rev(i,j,kk) = fptr3d(i,j,k) + if (trim(field_map%catchem_var) == 'Z' .or. trim(field_map%catchem_var) == 'ZMID') then + fptr3d_rev(i,j,k) = fptr3d(i,j,kk) / g0 + else + fptr3d_rev(i,j,k) = fptr3d(i,j,kk) + end if end do end do + kk = min(nk, kk + 1) end do !set to met_state in CATChem @@ -723,32 +782,6 @@ subroutine transform_field_to_catchem(cc_wrap, field, field_map, required, is_me ! Clean up allocated memory deallocate(fptr3d_rev) - !set some special cases - if (trim(field_map%catchem_var) == 'PEDGE') then !assign DELP from PEDGE - nk = nk -1 !PEDGE has nlevel + 1 levels - ! Re-allocate fptr3d_rev with new nk - allocate(fptr3d_rev(ni, nj, nk)) - do k = 1, nk - kk = nk - k + 1 - do j = 1, nj - do i = 1, ni - fptr3d_rev(i,j,kk) = fptr3d(i,j,k) - fptr3d(i,j,k+1) - end do - end do - end do - call met_state%set_field('DELP', real(fptr3d_rev, fp), error_mgr, rc) - if (rc == CC_SUCCESS) then - if (allocated(cc_wrap%catchem_model%required_fields)) then - met_index = cc_wrap%catchem_model%get_required_met_index( 'DELP' ) - if (met_index >0 ) then - is_met_set(met_index) = .true. - end if - end if - end if - ! Clean up allocated memory - deallocate(fptr3d_rev) - end if - ! 4D tracer concentrations case (4) nullify(fptr4d, fptr4d_rev) @@ -771,23 +804,51 @@ subroutine transform_field_to_catchem(cc_wrap, field, field_map, required, is_me ! Allocate fptr4d_rev with the same dimensions as fptr4d allocate(fptr4d_rev(ni, nj, nk, size(chem_state%ChemSpecies))) + fptr4d_rev = 0.0_fp ! Initialize to zero ! Reverse vertical layers do v = 1, nv + !read in specific humidity from tracer array + if (trim(cc_wrap%tracer_map%names(v)) == 'sphum') then + call met_state%set_field('QV', real(fptr4d(:,:, :,v), fp), error_mgr, rc) + if (rc == CC_SUCCESS) then + if (allocated(cc_wrap%catchem_model%required_fields)) then + met_index = cc_wrap%catchem_model%get_required_met_index( 'QV' ) + if (met_index >0 ) then + is_met_set(met_index) = .true. + end if + end if + else if (.not. required) then + ! If the field is not required, we can skip the transformation + call ESMF_LogSetError(ESMF_RC_INTNRL_BAD, & + msg="Met field is not set and its optional: QV", & + line=__LINE__, file=__FILE__, rcToReturn=rc) + else + call ESMF_LogSetError(ESMF_RC_INTNRL_BAD, & + msg="Met field is not set successfully for: QV", & + line=__LINE__, file=__FILE__, rcToReturn=rc) + deallocate(fptr4d_rev) ! Clean up before returning + return ! bail out + end if + end if + + !map NUOPC tracer index to CATChem species index v_cc = cc_wrap%tracer_map%nuopc_to_cc(v) if (v_cc <= 0) cycle !if not a species in CATChem, go to next cycle !unit conversion if (chem_state%ChemSpecies(v_cc)%is_gas) then - unit_conv = 28.9644 / chem_state%ChemSpecies(v_cc)%mw_g * 1.0e-3 ! convert from ug/kg to ppm for gases + !unit_conv = 28.9644 / chem_state%ChemSpecies(v_cc)%mw_g * 1.0e-3 ! convert from ug/kg to ppm for gases + unit_conv = 1.00 !keep it in ppmV else unit_conv = 1.00 ! convert from ug/kg to ug/kg for aerosols end if do k = 1, nk - kk = nk - k + 1 + !kk = nk - k + 1 !no need to reverse + kk = k do j = 1, nj do i = 1, ni - fptr4d_rev(i,j,kk,v_cc) = fptr4d(i,j,k,v) * unit_conv + fptr4d_rev(i,j,kk,v_cc) = max(fptr4d(i,j,k,v), 0.0_fp) * unit_conv end do end do end do @@ -903,7 +964,8 @@ subroutine transform_catchem_to_field(cc_wrap, field, field_map, rc) nk = size(fptr3d, 3) !revserse vertical layers do k = 1, nk - kk = nk - k + 1 + !kk = nk - k + 1 !no need to reverse + kk = k do j = 1, nj do i = 1, ni fptr3d(i,j,kk) = cc_diag_data(i,j,k) @@ -942,13 +1004,15 @@ subroutine transform_catchem_to_field(cc_wrap, field, field_map, rc) if (v_cc > 0) then cc_diag_data = chem_state%ChemSpecies(v_cc)%conc if (chem_state%ChemSpecies(v_cc)%is_gas) then - unit_conv = 1.0e3 * chem_state%ChemSpecies(v_cc)%mw_g /28.9644 ! convert from ppm to ug/kg for gases + !unit_conv = 1.0e3 * chem_state%ChemSpecies(v_cc)%mw_g /28.9644 ! convert from ppm to ug/kg for gases + unit_conv = 1.00 !keep it in ppmV else unit_conv = 1.00 ! convert from ug/kg to ug/kg for aerosols end if do k = 1, nk - kk = nk - k + 1 + !kk = nk - k + 1 !no need to reverse + kk = k do j = 1, nj do i = 1, ni fptr4d(i,j,kk,v) = cc_diag_data(i,j,k) * unit_conv @@ -1591,10 +1655,16 @@ subroutine parse_field_section(filename, section_name, fields, n_fields, errflg, if (io_stat /= 0) exit ! End of file or error line_number = line_number + 1 + + ! Remove inline comments - everything after '#' character + if (index(line, '#') > 0) then + line = line(1:index(line, '#')-1) + endif + trimmed_line = trim(adjustl(line)) - ! Skip empty lines and comments - if (len_trim(trimmed_line) == 0 .or. trimmed_line(1:1) == '#') cycle + ! Skip empty lines (comments have already been stripped) + if (len_trim(trimmed_line) == 0) cycle ! Calculate indentation level do indent_level = 1, len_trim(line) diff --git a/src/api/CATChem_API.F90 b/src/api/CATChem_API.F90 index c6fa0552..b9dd8213 100644 --- a/src/api/CATChem_API.F90 +++ b/src/api/CATChem_API.F90 @@ -45,6 +45,9 @@ module CATChem_API use ProcessInterface_Mod, only: ProcessInterface ! Import process registration functions use SeaSaltProcessCreator_Mod, only: register_seasalt_process + use DryDepProcessCreator_Mod, only: register_drydep_process + use WetDepProcessCreator_Mod, only: register_wetdep_process + use SettlingProcessCreator_Mod, only: register_settling_process implicit none private @@ -350,6 +353,27 @@ subroutine model_register_process(this, process_name, process_mgr, rc) ! Add more processes here as they become available ! case ('dust') ! call register_dust_process(process_mgr, rc) + case ('drydep') + call register_drydep_process(process_mgr, rc) + if (rc /= CC_SUCCESS) then + call this%error_manager%push_context('model_register_process', 'registering drydep process') + call this%error_manager%report_error(1014, 'Failed to register drydep process', rc) + call this%error_manager%pop_context() + endif + case ('wetdep') + call register_wetdep_process(process_mgr, rc) + if (rc /= CC_SUCCESS) then + call this%error_manager%push_context('model_register_process', 'registering wetdep process') + call this%error_manager%report_error(1014, 'Failed to register wetdep process', rc) + call this%error_manager%pop_context() + endif + case ('settling') + call register_settling_process(process_mgr, rc) + if (rc /= CC_SUCCESS) then + call this%error_manager%push_context('model_register_process', 'registering settling process') + call this%error_manager%report_error(1014, 'Failed to register settling process', rc) + call this%error_manager%pop_context() + endif ! case ('chemistry') ! call register_chemistry_process(process_mgr, rc) diff --git a/src/api/CMakeLists.txt b/src/api/CMakeLists.txt index 5eac7a77..9ab06cf1 100644 --- a/src/api/CMakeLists.txt +++ b/src/api/CMakeLists.txt @@ -7,7 +7,9 @@ target_link_libraries(${_lib} PUBLIC CATChem_core) #target_link_libraries(${_lib} PUBLIC CATChem_process_dust) target_link_libraries(${_lib} PUBLIC CATChem_process_seasalt) # target_link_libraries(${_lib} PUBLIC CATChem_process_plumerise) -# target_link_libraries(${_lib} PUBLIC CATChem_process_drydep) +target_link_libraries(${_lib} PUBLIC CATChem_process_drydep) +target_link_libraries(${_lib} PUBLIC CATChem_process_wetdep) +target_link_libraries(${_lib} PUBLIC CATChem_process_settling) # target_link_libraries(${_lib} PUBLIC CATChem_process_chem) set_target_properties( ${_lib} diff --git a/src/core/CMakeLists.txt b/src/core/CMakeLists.txt index ea6d2e88..e215b4f9 100644 --- a/src/core/CMakeLists.txt +++ b/src/core/CMakeLists.txt @@ -51,6 +51,11 @@ target_compile_options(CATChem_core PRIVATE ${_catchem_compiler_options}) target_link_libraries(CATChem_core PRIVATE yaml_interface catchem_utilities) +# Link GOCART2G library for external process dependencies +if(TARGET GOCART2G) + target_link_libraries(CATChem_core PUBLIC GOCART2G) +endif() + set(METSTATE_MOD_F90 ${CMAKE_CURRENT_SOURCE_DIR}/metstate_mod.F90) set( METSTATE_ACCESSOR_INC diff --git a/src/core/ConfigManager_Mod.F90 b/src/core/ConfigManager_Mod.F90 index 75bdc3f7..b33a01f5 100644 --- a/src/core/ConfigManager_Mod.F90 +++ b/src/core/ConfigManager_Mod.F90 @@ -107,6 +107,7 @@ module ConfigManager_Mod type :: FilePathConfig character(len=255) :: Emission_File = '' !< Path to emission mapping file character(len=255) :: Species_File = '' !< Path to species configuration file + character(len=255) :: Mie_Directory = '' !< Path to Mie optics data directory character(len=255) :: Input_Directory = './' !< Input data directory character(len=255) :: Output_Directory = './' !< Output data directory end type FilePathConfig @@ -319,6 +320,7 @@ module ConfigManager_Mod procedure :: get_nemission_species => config_manager_get_nemission_species procedure :: get_species_file => config_manager_get_species_file procedure :: get_emission_file => config_manager_get_emission_file + procedure :: get_mie_data => config_manager_get_mie_data ! State integration !procedure :: apply_to_container => config_manager_apply_to_container @@ -1292,6 +1294,9 @@ subroutine config_data_init(this, rc) ! Initialize emission mapping call this%emission_mapping%init() + ! Initialize emission mapping + call this%emission_mapping%init() + end subroutine config_data_init !> \brief Clean up configuration data @@ -1449,6 +1454,7 @@ subroutine parse_config_data(this, rc) ! Parse file paths call yaml_get(this%yaml_data, 'diagnostics/output/directory', this%config_data%file_paths%Output_Directory, rc, './') + call yaml_get(this%yaml_data, 'mie/directory', this%config_data%file_paths%Mie_Directory, rc, './') call yaml_get(this%yaml_data, 'simulation/species_filename', this%config_data%file_paths%Species_File, rc, '') call yaml_get(this%yaml_data, 'simulation/emission_filename', this%config_data%file_paths%Emission_File, rc, '') @@ -1605,13 +1611,18 @@ subroutine config_manager_load_and_init_species(this, filename, chem_state, erro endif endif + if (chem_state%ChemSpecies(i)%is_wetdep) then + chem_state%nSpeciesWetDep = chem_state%nSpeciesWetDep + 1 + chem_state%WetDepIndex(chem_state%nSpeciesWetDep) = species_index + endif + if (chem_state%ChemSpecies(i)%is_tracer) then chem_state%nSpeciesTracer = chem_state%nSpeciesTracer + 1 chem_state%TracerIndex(chem_state%nSpeciesTracer) = species_index endif !print species info as a test - ! write(*, '(A,A)') 'Species name: ', chem_state%ChemSpecies(i)%short_name + write(*, '(A,A)') 'Species name: ', chem_state%ChemSpecies(i)%short_name ! write(*, '(A,A)') 'Description: ', chem_state%ChemSpecies(i)%description ! write(*, *) 'lower radius: ', chem_state%ChemSpecies(i)%lower_radius ! write(*, *) 'upper radius: ', chem_state%ChemSpecies(i)%upper_radius @@ -1623,6 +1634,7 @@ subroutine config_manager_load_and_init_species(this, filename, chem_state, erro ! write(*, *) 'is sea salt: ', chem_state%ChemSpecies(i)%is_seasalt ! write(*, *) 'is dry deposition: ', chem_state%ChemSpecies(i)%is_drydep ! write(*, *) 'is tracer: ', chem_state%ChemSpecies(i)%is_tracer + write(*, *) 'wd_rainouteff: ', chem_state%ChemSpecies(i)%wd_rainouteff enddo @@ -1636,9 +1648,18 @@ subroutine config_manager_load_and_init_species(this, filename, chem_state, erro write(*, '(A,I0)') ' Dust species: ', chem_state%nSpeciesDust write(*, '(A,I0)') ' Sea salt species: ', chem_state%nSpeciesSeaSalt write(*, '(A,I0)') ' Dry deposition species: ', chem_state%nSpeciesDryDep + write(*, '(A,I0)') ' Wet deposition species: ', chem_state%nSpeciesWetDep write(*, '(A,I0)') ' Aerosol dry deposition species: ', chem_state%nSpeciesAeroDryDep write(*, '(A,I0)') ' Tracer species: ', chem_state%nSpeciesTracer + ! Initialize Mie data if configuration is available + call this%get_mie_data(chem_state, rc) + if (rc /= CC_SUCCESS) then + write(*, '(A)') 'WARNING: Mie data initialization failed or skipped' + ! Don't fail the overall species loading for Mie issues + rc = CC_SUCCESS + end if + ! Return optional output parameters if (present(num_species)) then num_species = list_size @@ -1662,10 +1683,11 @@ subroutine load_species_properties(yaml_root, species_path, species, rc) character(len=256) :: field_path character(len=64) :: species_name real(fp) :: temp_real ! Using project-wide fp precision + real(fp), allocatable :: temp_real_array(:) ! Using project-wide fp precision logical :: temp_logical character(len=256) :: temp_string integer :: yaml_rc ! Separate return code for YAML operations - integer :: i, j ! Loop variables for debugging + integer :: i, j, actual_size ! Loop variables for debugging rc = CC_SUCCESS @@ -1706,6 +1728,13 @@ subroutine load_species_properties(yaml_root, species_path, species, rc) species%description = trim(adjustl(temp_string)) endif + ! Load mie name (optional) + write(field_path, '(A,A)') trim(species_path), '/mie_name' + call yaml_get(yaml_root, trim(field_path), temp_string, yaml_rc) + if (yaml_rc == 0) then + species%mie_name = trim(adjustl(temp_string)) + endif + ! Load molecular weight (optional, but important) - use safe conversion for numeric values write(field_path, '(A,A)') trim(species_path), '/mw_g' call safe_yaml_get_real(yaml_root, trim(field_path), temp_real, yaml_rc) @@ -1798,6 +1827,66 @@ subroutine load_species_properties(yaml_root, species_path, species, rc) species%dd_DvzMinVal_land = MISSING endif + write(field_path, '(A,A)') trim(species_path), '/henry_k0' + call safe_yaml_get_real(yaml_root, trim(field_path), temp_real, yaml_rc) + if (yaml_rc == 0) then + species%henry_k0 = temp_real + else + species%henry_k0 = MISSING + endif + + write(field_path, '(A,A)') trim(species_path), '/henry_cr' + call safe_yaml_get_real(yaml_root, trim(field_path), temp_real, yaml_rc) + if (yaml_rc == 0) then + species%henry_cr = temp_real + else + species%henry_cr = MISSING + endif + + write(field_path, '(A,A)') trim(species_path), '/henry_pKa' + call safe_yaml_get_real(yaml_root, trim(field_path), temp_real, yaml_rc) + if (yaml_rc == 0) then + species%henry_pKa = temp_real + else + species%henry_pKa = 0.0_fp ! Default to 0.0 if not specified + endif + + write(field_path, '(A,A)') trim(species_path), '/wd_retfactor' + call safe_yaml_get_real(yaml_root, trim(field_path), temp_real, yaml_rc) + if (yaml_rc == 0) then + species%wd_retfactor = temp_real + else + species%wd_retfactor = MISSING + endif + + write(field_path, '(A,A)') trim(species_path), '/wd_LiqAndGas' + call safe_yaml_get_logical(yaml_root, trim(field_path), temp_logical, yaml_rc) + if (yaml_rc == 0) then + species%wd_LiqAndGas = temp_logical + else + species%wd_LiqAndGas = MISSING_BOOL + endif + + write(field_path, '(A,A)') trim(species_path), '/wd_convfacI2G' + call safe_yaml_get_real(yaml_root, trim(field_path), temp_real, yaml_rc) + if (yaml_rc == 0) then + species%wd_convfacI2G = temp_real + else + species%wd_convfacI2G = MISSING + endif + + write(field_path, '(A,A)') trim(species_path), '/wd_rainouteff' + allocate(temp_real_array(10)) ! Assume max size of 10 for temporary array + success = yaml_get_real_array(yaml_root, trim(field_path), temp_real_array, actual_size) + if (success .and. actual_size > 0) then + species%wd_rainouteff(1:actual_size) = temp_real_array(1:actual_size) + deallocate(temp_real_array) + else + ! Return missing array + species%wd_rainouteff(:) = MISSING + deallocate(temp_real_array) + endif + ! Load type flags (with proper default handling) write(field_path, '(A,A)') trim(species_path), '/is_gas' call safe_yaml_get_logical(yaml_root, trim(field_path), temp_logical, yaml_rc) @@ -1847,6 +1936,14 @@ subroutine load_species_properties(yaml_root, species_path, species, rc) species%is_drydep = MISSING_BOOL endif + write(field_path, '(A,A)') trim(species_path), '/is_wetdep' + call safe_yaml_get_logical(yaml_root, trim(field_path), temp_logical, yaml_rc) + if (yaml_rc == 0) then + species%is_wetdep = temp_logical + else + species%is_wetdep = MISSING_BOOL + endif + write(field_path, '(A,A)') trim(species_path), '/is_photolysis' call safe_yaml_get_logical(yaml_root, trim(field_path), temp_logical, yaml_rc) if (yaml_rc == 0) then @@ -1876,6 +1973,83 @@ subroutine load_species_properties(yaml_root, species_path, species, rc) end subroutine load_species_properties + !> \brief Get Mie data and initialize ChemState Mie arrays + !! + !! This subroutine reads the mie/files section from the configuration, + !! loads the Mie data files, and initializes the ChemState Mie arrays. + !! + !! \param[in] this ConfigManager object + !! \param[inout] chem_state ChemState object to initialize with Mie data + !! \param[out] rc Return code + subroutine config_manager_get_mie_data(this, chem_state, rc) + use ChemState_Mod, only: ChemStateType + implicit none + class(ConfigManagerType), intent(in) :: this + type(ChemStateType), intent(inout) :: chem_state + integer, intent(out) :: rc + + ! Temporary variables for file information + integer :: n_mie_files + character(len=30) :: mie_names(100) + character(len=255) :: mie_filenames(100) + character(len=512) :: mie_full_paths(100) + character(len=320) :: key_value_pairs(100) ! key:value entries + integer :: i, colon_pos + character(len=255) :: mie_dir + character(len=320) :: trimmed_entry + + rc = CC_SUCCESS + n_mie_files = 0 + + ! Get Mie directory + mie_dir = this%config_data%file_paths%Mie_Directory + if (len_trim(mie_dir) == 0) then + mie_dir = './' + end if + + ! Discover key:value pairs in mie/files section using modified function + call discover_nested_yaml_section_items(this%config_file, 'mie/files', key_value_pairs, n_mie_files, rc, 'key_value_pairs') + + if (rc /= CC_SUCCESS .or. n_mie_files == 0) then + write(*, '(A)') 'WARNING: No Mie files found in configuration. Skipping Mie data initialization.' + rc = CC_SUCCESS ! Don't fail, just skip Mie initialization + return + end if + + ! Parse each key:value pair inline (reusing existing colon parsing logic) + do i = 1, n_mie_files + trimmed_entry = trim(key_value_pairs(i)) + + ! Find the colon separator (reusing existing pattern) + colon_pos = index(trimmed_entry, ':') + if (colon_pos == 0) then + rc = CC_FAILURE + return + end if + + ! Extract Mie name (before colon) and filename (after colon) + mie_names(i) = trim(trimmed_entry(1:colon_pos-1)) + mie_filenames(i) = trim(adjustl(trimmed_entry(colon_pos+1:))) + + ! Construct full path + if (trim(mie_dir) == './') then + mie_full_paths(i) = trim(mie_filenames(i)) + else + mie_full_paths(i) = trim(mie_dir) // trim(mie_filenames(i)) + end if + end do + + ! Initialize Mie data in ChemState directly + call chem_state%init_mie_data(n_mie_files, mie_names(1:n_mie_files), mie_full_paths(1:n_mie_files), rc) + + if (rc == CC_SUCCESS) then + write(*, '(A,I0,A)') 'INFO: Successfully initialized Mie data with ', n_mie_files, ' files' + else + write(*, '(A)') 'ERROR: Failed to initialize Mie data in ChemState' + end if + + end subroutine config_manager_get_mie_data + !> \brief Find category mapping for a specific category subroutine config_manager_find_category_mapping(this, category_name, category_mapping, rc) implicit none @@ -2451,24 +2625,27 @@ end subroutine discover_yaml_section_items !! Examples: !! - "processes/extemis" -> finds anthro, point, fire, fengsha !! - "processes/extemis/anthro" -> finds activate, scale_factor, source_file, etc. - !! - "simulation/grid/levels" -> finds any items under that path + !! - "mie/files" with mode 'key_value_pairs' -> finds "SS: opticsBands_SS.v3_3.RRTMG.nc" !! !! \param[in] filename YAML file to parse !! \param[in] section_path Nested path (e.g., "processes/extemis/anthro") !! \param[inout] item_names Array to store discovered item names !! \param[out] n_items Number of items found !! \param[out] rc Return code - subroutine discover_nested_yaml_section_items(filename, section_path, item_names, n_items, rc) + !! \param[in] search_mode Optional: 'section_headers' (default) or 'key_value_pairs' + subroutine discover_nested_yaml_section_items(filename, section_path, item_names, n_items, rc, search_mode) implicit none character(len=*), intent(in) :: filename character(len=*), intent(in) :: section_path - character(len=64), intent(inout) :: item_names(:) + character(len=*), intent(inout) :: item_names(:) integer, intent(out) :: n_items integer, intent(out) :: rc + character(len=*), optional, intent(in) :: search_mode integer :: unit_num, io_stat, colon_pos, indent_level character(len=256) :: line, trimmed_line, field_name, content_after_colon integer :: line_number, target_indent + character(len=20) :: mode ! Path navigation variables character(len=64) :: path_components(10) ! Support up to 10 levels deep @@ -2481,6 +2658,13 @@ subroutine discover_nested_yaml_section_items(filename, section_path, item_names line_number = 0 target_indent = -1 + ! Set search mode (default to section headers for backward compatibility) + if (present(search_mode)) then + mode = trim(search_mode) + else + mode = 'section_headers' + end if + ! Initialize path tracking current_depth = 0 path_matched = .false. @@ -2538,14 +2722,24 @@ subroutine discover_nested_yaml_section_items(filename, section_path, item_names if (indent_level > target_indent) then ! Check if this is a direct child (first level below target) if (indent_level == target_indent + 2) then - ! Only add items that don't have a scalar value after the colon (i.e., are nodes) content_after_colon = adjustl(trimmed_line(colon_pos+1:)) - if (len_trim(content_after_colon) == 0) then - ! Nothing after colon - this is a node - if (n_items < size(item_names)) then - n_items = n_items + 1 - item_names(n_items) = trim(field_name) - !write(*, '(A,A)') 'INFO: Discovered field in file: ', trim(field_name) + + ! Handle different search modes + if (trim(mode) == 'key_value_pairs') then + ! Look for entries WITH content after colon (key:value pairs) + if (len_trim(content_after_colon) > 0) then + if (n_items < size(item_names)) then + n_items = n_items + 1 + item_names(n_items) = trim(trimmed_line) ! Store full line + endif + endif + else + ! Default: look for entries WITHOUT content after colon (section headers) + if (len_trim(content_after_colon) == 0) then + if (n_items < size(item_names)) then + n_items = n_items + 1 + item_names(n_items) = trim(field_name) ! Store just field name + endif endif endif endif @@ -3160,8 +3354,8 @@ subroutine populate_process_config(config_mgr, process_name, phase_name, process integer, intent(in) :: local_priority integer, intent(out) :: rc - character(len=256) :: process_path, temp_string - logical :: temp_logical, success + character(len=256) :: process_path, temp_string, gas_scheme, aero_scheme + logical :: temp_logical, success, gas_success, aero_success integer :: temp_integer, local_rc rc = CC_SUCCESS @@ -3218,8 +3412,24 @@ subroutine populate_process_config(config_mgr, process_name, phase_name, process if (success) then process_config%scheme = trim(temp_string) else - write(*,'(A,A,A)') 'Warning: Scheme of process "', trim(process_name), '" is not defined!' - process_config%scheme = 'default' + ! Try to read separate gas_scheme and aero_scheme + gas_success = yaml_get_string(config_mgr%yaml_data, trim(process_path) // '/gas_scheme', gas_scheme) + aero_success = yaml_get_string(config_mgr%yaml_data, trim(process_path) // '/aero_scheme', aero_scheme) + + if (gas_success .and. aero_success) then + ! Combine gas and aero schemes + process_config%scheme = trim(gas_scheme) // ' (gas) & ' // trim(aero_scheme) // ' (aero)' + elseif (gas_success) then + ! Only gas scheme found + process_config%scheme = trim(gas_scheme) // ' (gas)' + elseif (aero_success) then + ! Only aero scheme found + process_config%scheme = trim(aero_scheme) // ' (aero)' + else + ! No scheme configuration found + write(*,'(A,A,A)') 'Warning: Scheme of process "', trim(process_name), '" is not defined!' + process_config%scheme = 'default' + endif endif end subroutine populate_process_config diff --git a/src/core/ProcessInterface_Mod.F90 b/src/core/ProcessInterface_Mod.F90 index 8ac16353..c51cae47 100644 --- a/src/core/ProcessInterface_Mod.F90 +++ b/src/core/ProcessInterface_Mod.F90 @@ -266,7 +266,7 @@ end function process_get_required_met_fields !! should be created and made available. function process_get_required_diagnostic_fields(this) result(field_names) class(ProcessInterface), intent(in) :: this - character(len=32), allocatable :: field_names(:) + character(len=64), allocatable :: field_names(:) ! Default implementation - no diagnostic fields required allocate(field_names(0)) diff --git a/src/core/ProcessManager_Mod.F90 b/src/core/ProcessManager_Mod.F90 index 8d4781e0..6f18296f 100644 --- a/src/core/ProcessManager_Mod.F90 +++ b/src/core/ProcessManager_Mod.F90 @@ -25,9 +25,15 @@ module ProcessManager_Mod public :: ProcessManagerType + ! 1. Define a wrapper otherwise the polymorphic array allocation fails + type :: ProcessContainerType + ! The 'allocatable' keyword here is the magic sauce + class(ProcessInterface), allocatable :: item + end type ProcessContainerType + type :: ProcessManagerType private - class(ProcessInterface), allocatable, public :: processes(:) + class(ProcessContainerType), allocatable, public :: processes(:) integer :: num_processes = 0 integer :: max_processes = 50 type(ProcessFactoryType) :: factory @@ -83,7 +89,9 @@ subroutine manager_add_process(this, process_name, container, rc) type(StateManagerType), intent(inout) :: container integer, intent(out) :: rc + integer :: i class(ProcessInterface), allocatable :: new_process + class(ProcessContainerType), allocatable :: tmp(:) if (this%num_processes >= this%max_processes) then rc = CC_FAILURE @@ -98,6 +106,9 @@ subroutine manager_add_process(this, process_name, container, rc) call new_process%init(container, rc) if (rc /= CC_SUCCESS) return + ! Set timestep for each process to the same value. + call new_process%set_timestep(container%tstep) + ! Collect required met fields from this process call this%add_met_fields_from_process(new_process, rc) if (rc /= CC_SUCCESS) return @@ -111,20 +122,40 @@ subroutine manager_add_process(this, process_name, container, rc) return endif - ! Handle polymorphic array allocation on first use - if (.not. allocated(this%processes)) then - ! For polymorphic arrays, we need to allocate with proper bounds - ! We'll allocate the whole array when adding the first process - block - class(ProcessInterface), allocatable :: temp_array(:) - allocate(temp_array(this%max_processes), source=new_process) - call move_alloc(temp_array, this%processes) - end block - else - ! Subsequent assignments - just copy into the allocated slot - allocate(this%processes(this%num_processes), source=new_process) + ! ! Handle polymorphic array allocation on first use + ! if (.not. allocated(this%processes)) then + ! ! For polymorphic arrays, we need to allocate with proper bounds + ! ! We'll allocate the whole array when adding the first process + ! block + ! class(ProcessInterface), allocatable :: temp_array(:) + ! allocate(temp_array(this%max_processes), source=new_process) + ! call move_alloc(temp_array, this%processes) + ! end block + ! else + ! ! Subsequent assignments - just copy into the allocated slot + ! allocate(this%processes(this%num_processes), source=new_process) + ! endif + + ! Allocate a temporary array of WRAPPERS with the new size + allocate(tmp(this%num_processes)) + + ! Move existing items into the new array + ! We check if there was previous data to move + if (allocated(this%processes)) then + do i = 1, this%num_processes - 1 + ! We can move the internal allocatable item safely! + call move_alloc(from=this%processes(i)%item, to=tmp(i)%item) + end do + ! Optional: Deallocate the old empty shell (Fortran does this auto, but safe to be explicit) + deallocate(this%processes) endif + ! Move the new process into the last slot + call move_alloc(from=new_process, to=tmp(this%num_processes)%item) + + ! Move the wrapper array back to the manager + call move_alloc(from=tmp, to=this%processes) + rc = CC_SUCCESS end subroutine manager_add_process @@ -153,15 +184,15 @@ subroutine manager_run_all(this, container, rc) endif do i = 1, this%num_processes - if (this%processes(i)%is_ready()) then + if (this%processes(i)%item%is_ready()) then ! Check if this is a column process - select type(proc => this%processes(i)) + select type(proc => this%processes(i)%item) class is (ColumnProcessInterface) ! Run column-based process call this%run_process_on_columns(i, container, local_rc) class default ! Run traditional 3D process - call this%processes(i)%run(container, local_rc) + call this%processes(i)%item%run(container, local_rc) end select if (local_rc /= CC_SUCCESS) then @@ -209,7 +240,7 @@ subroutine manager_run_column_processes(this, container, rc) ! Run all column processes on this column do i = 1, this%num_processes - select type(proc => this%processes(i)) + select type(proc => this%processes(i)%item) class is (ColumnProcessInterface) if (proc%is_ready()) then call proc%run_column(virtual_col, container, local_rc) @@ -225,6 +256,9 @@ subroutine manager_run_column_processes(this, container, rc) call container%apply_virtual_column(virtual_col, rc) if (rc /= CC_SUCCESS) return enddo + ! Clean up virtual column + if (virtual_col%is_valid) call virtual_col%cleanup() + end subroutine manager_run_column_processes !> \brief Run a specific process on all columns @@ -253,7 +287,7 @@ subroutine manager_run_process_on_columns(this, process_index, container, rc) return endif - select type(proc => this%processes(process_index)) + select type(proc => this%processes(process_index)%item) class is (ColumnProcessInterface) ! Initialize column iterator using create_column_iterator col_iter = grid_mgr%create_column_iterator() @@ -276,6 +310,8 @@ subroutine manager_run_process_on_columns(this, process_index, container, rc) call container%apply_virtual_column(virtual_col, rc) if (rc /= CC_SUCCESS) return enddo + ! Clean up virtual column + if (virtual_col%is_valid) call virtual_col%cleanup() end select end subroutine manager_run_process_on_columns @@ -291,13 +327,13 @@ subroutine manager_run_process(this, process_name, container, rc) rc = CC_FAILURE do i = 1, this%num_processes - if (trim(this%processes(i)%get_name()) == trim(process_name)) then + if (trim(this%processes(i)%item%get_name()) == trim(process_name)) then ! Check if this is a column process and run appropriately - select type(proc => this%processes(i)) + select type(proc => this%processes(i)%item) class is (ColumnProcessInterface) call this%run_process_on_columns(i, container, rc) class default - call this%processes(i)%run(container, rc) + call this%processes(i)%item%run(container, rc) end select return endif @@ -316,7 +352,7 @@ subroutine manager_get_column_processes(this, column_indices, count) max_count = min(this%num_processes, size(column_indices)) do i = 1, this%num_processes - select type(proc => this%processes(i)) + select type(proc => this%processes(i)%item) class is (ColumnProcessInterface) count = count + 1 if (count <= max_count) then @@ -388,12 +424,13 @@ subroutine manager_run_phase(this, phase_name, config_data, container, rc) write(*,*) 'INFO: Running process: ', trim(process_config%name), ' (index=', process_idx, ')' ! Run the process based on its type - if (this%processes(process_idx)%is_ready()) then - select type(proc => this%processes(process_idx)) + if (this%processes(process_idx)%item%is_ready()) then + select type(proc => this%processes(process_idx)%item) class is (ColumnProcessInterface) + !!write(*,*) 'Test phase process', process_idx, trim(proc%name) !debug only call this%run_process_on_columns(process_idx, container, local_rc) class default - call this%processes(process_idx)%run(container, local_rc) + call this%processes(process_idx)%item%run(container, local_rc) end select if (local_rc /= CC_SUCCESS) then @@ -499,7 +536,7 @@ subroutine manager_finalize(this, rc) rc = CC_SUCCESS do i = 1, this%num_processes - call this%processes(i)%finalize(local_rc) + call this%processes(i)%item%finalize(local_rc) if (local_rc /= CC_SUCCESS) then rc = local_rc endif @@ -523,7 +560,7 @@ subroutine manager_list_processes(this, process_names, count) max_count = min(this%num_processes, size(process_names)) do i = 1, max_count - process_names(i) = this%processes(i)%get_name() + process_names(i) = this%processes(i)%item%get_name() enddo count = max_count end subroutine manager_list_processes @@ -588,18 +625,32 @@ subroutine manager_add_met_fields_from_process(this, process, rc) allocate(current_fields(0)) endif - ! Merge fields, avoiding duplicates + ! Merge fields, avoiding duplicates and filtering out TSTEP ! Worst case: all new fields are unique, so allocate maximum possible size allocate(merged_fields(current_size + new_size)) + merged_size = 0 - ! Start with current fields - merged_fields(1:current_size) = current_fields(1:current_size) - merged_size = current_size + ! Start with current fields, but filter out TSTEP + do i = 1, current_size + if (trim(adjustl(current_fields(i))) /= 'TSTEP' .and. & + trim(adjustl(current_fields(i))) /= 'LON' .and. & + trim(adjustl(current_fields(i))) /= 'LAT') then + merged_size = merged_size + 1 + merged_fields(merged_size) = current_fields(i) + endif + end do - ! Add new fields if they're not already present + ! Add new fields if they're not already present and not TSTEP do i = 1, new_size field_exists = .false. + ! Skip TSTEP field (case insensitive) + if (trim(adjustl(new_fields(i))) == 'TSTEP' .or. & + trim(adjustl(new_fields(i))) == 'LON' .or. & + trim(adjustl(new_fields(i))) == 'LAT') then + cycle + endif + ! Check if this field already exists (case insensitive) do j = 1, merged_size if (trim(adjustl(new_fields(i))) == trim(adjustl(merged_fields(j)))) then diff --git a/src/core/StateManager_Mod.F90 b/src/core/StateManager_Mod.F90 index 1141a61d..4d720491 100644 --- a/src/core/StateManager_Mod.F90 +++ b/src/core/StateManager_Mod.F90 @@ -19,6 +19,7 @@ module StateManager_Mod use error_mod, only: CC_SUCCESS, CC_FAILURE, ErrorManagerType use ConfigManager_Mod, only: ConfigManagerType use MetState_Mod, only: MetStateType + use TimeState_Mod, only: TimeStateType use ChemState_Mod, only: ChemStateType use GridManager_Mod, only: GridManagerType use DiagnosticManager_Mod, only: DiagnosticManagerType @@ -70,6 +71,7 @@ module StateManager_Mod ! Core state objects type(MetStateType), allocatable :: met_state !< Meteorological fields + type(TimeStateType), allocatable :: time_state !< Time state and solar calculations type(ChemStateType), allocatable :: chem_state !< Chemical species concentrations type(ErrorManagerType) :: error_mgr !< Error manager @@ -82,6 +84,7 @@ module StateManager_Mod logical :: is_initialized = .false. !< Initialization status logical :: is_configured = .false. !< Configuration status character(len=256) :: name = '' !< Container name + real(fp), public :: tstep = 0.0_fp !< time step for all processes contains ! Basic lifecycle (called by CATChemCore) @@ -95,6 +98,7 @@ module StateManager_Mod procedure :: get_config_ptr => manager_get_config_ptr procedure :: set_config => manager_set_config procedure :: get_met_state_ptr => manager_get_met_state_ptr + procedure :: get_time_state_ptr => manager_get_time_state_ptr procedure :: get_chem_state_ptr => manager_get_chem_state_ptr procedure :: get_error_manager => manager_get_error_manager procedure :: get_grid_manager => manager_get_grid_manager @@ -154,6 +158,8 @@ subroutine manager_init(this, name, rc) if (.not. allocated(this%met_state)) allocate(this%met_state) + if (.not. allocated(this%time_state)) allocate(this%time_state) + if (.not. allocated(this%chem_state)) allocate(this%chem_state) this%is_initialized = .true. @@ -163,13 +169,17 @@ end subroutine manager_init !> \brief Clean up the state manager subroutine manager_cleanup(this, rc) - class(StateManagerType), intent(inout) :: this + class(StateManagerType), intent(inout), target :: this integer, intent(out) :: rc - integer :: config_rc, met_rc, chem_rc + integer :: config_rc, met_rc, time_rc, chem_rc + type(ErrorManagerType), pointer :: error_mgr_ptr rc = CC_SUCCESS + ! Get pointer to error manager for cleanup calls + error_mgr_ptr => this%get_error_manager() + ! Clean up and deallocate state objects - call their cleanup procedures first! if (allocated(this%met_state)) then call this%met_state%cleanup('ALL', met_rc) @@ -177,6 +187,12 @@ subroutine manager_cleanup(this, rc) deallocate(this%met_state) end if + if (allocated(this%time_state)) then + call this%time_state%cleanup(error_mgr_ptr, time_rc) + if (time_rc /= CC_SUCCESS) rc = time_rc ! Don't stop cleanup on error + deallocate(this%time_state) + end if + if (allocated(this%chem_state)) then call this%chem_state%cleanup(chem_rc) if (chem_rc /= CC_SUCCESS) rc = chem_rc ! Don't stop cleanup on error @@ -193,6 +209,7 @@ subroutine manager_cleanup(this, rc) this%is_initialized = .false. this%is_configured = .false. this%name = '' + this%tstep = 0.0_fp end subroutine manager_cleanup @@ -204,6 +221,7 @@ function manager_is_ready(this) result(ready) ready = this%is_initialized .and. this%is_configured .and. & associated(this%config) .and. & allocated(this%met_state) .and. & + allocated(this%time_state) .and. & allocated(this%chem_state) end function manager_is_ready @@ -250,6 +268,18 @@ function manager_get_met_state_ptr(this) result(met_ptr) endif end function manager_get_met_state_ptr + !> \brief Get pointer to time state for modification + function manager_get_time_state_ptr(this) result(time_ptr) + class(StateManagerType), intent(inout), target :: this + type(TimeStateType), pointer :: time_ptr + + if (allocated(this%time_state)) then + time_ptr => this%time_state + else + nullify(time_ptr) + endif + end function manager_get_time_state_ptr + !> \brief Get pointer to chem state for modification function manager_get_chem_state_ptr(this) result(chem_ptr) class(StateManagerType), intent(inout), target :: this @@ -412,7 +442,7 @@ subroutine manager_apply_virtual_column(this, virtual_col, rc) if (associated(this%chem_state%ChemSpecies(ispec)%conc)) then do k = 1, nlev ! Get modified concentration from virtual column - chem_value = virtual_col%get_chem_field(k, ispec) + chem_value = virtual_col%get_chem_field(ispec, k) ! Apply back to the 3D concentration array this%chem_state%ChemSpecies(ispec)%conc(grid_i, grid_j, k) = chem_value end do @@ -490,6 +520,7 @@ subroutine manager_print_info(this) write(*,'(A,L1)') 'Initialized: ', this%is_initialized write(*,'(A,L1)') 'Config manager associated: ', associated(this%config) write(*,'(A,L1)') 'Met state allocated: ', allocated(this%met_state) + write(*,'(A,L1)') 'Time state allocated: ', allocated(this%time_state) write(*,'(A,L1)') 'Chem state allocated: ', allocated(this%chem_state) write(*,'(A)') '=================================' @@ -513,6 +544,7 @@ function manager_get_memory_usage(this) result(memory_bytes) if (associated(this%config)) memory_bytes = memory_bytes + 1024_8 if (allocated(this%met_state)) memory_bytes = memory_bytes + 102400_8 + if (allocated(this%time_state)) memory_bytes = memory_bytes + 32_8 if (allocated(this%chem_state)) memory_bytes = memory_bytes + 1048576_8 end function manager_get_memory_usage diff --git a/src/core/TimeState_Mod.F90 b/src/core/TimeState_Mod.F90 index 2e16a184..1d11ab1f 100644 --- a/src/core/TimeState_Mod.F90 +++ b/src/core/TimeState_Mod.F90 @@ -4,13 +4,16 @@ !! Provides timekeeping, solar zenith angle, and calendar utilities for CATChem. !! module TimeState_Mod - use StateManager_Mod, only: STATE_STATUS_UNINITIALIZED, STATE_STATUS_INITIALIZED use error_mod, only: ErrorManagerType, CC_SUCCESS, CC_FAILURE use constants, only: PI, PI_180 implicit none private public :: TimeStateType, is_global_holiday, is_us_holiday + ! Local status constants to avoid circular dependency + integer, parameter :: STATE_STATUS_UNINITIALIZED = 0 + integer, parameter :: STATE_STATUS_INITIALIZED = 1 + !> \brief Time state for model type :: TimeStateType integer :: year = 2000 @@ -41,19 +44,21 @@ module TimeState_Mod procedure :: get_time_human procedure :: get_time_compact procedure :: get_timezone_offset + procedure, private :: calculate_derived_fields end type TimeStateType contains !> \brief Compute solar zenith angle (degrees) using latitude, longitude, and time of day - real function get_sza(this, lat, lon) result(sza) + real function get_cos_sza(this, lat, lon, mid_timestep) result(cos_sza_val) class(TimeStateType), intent(in) :: this real, intent(in) :: lat, lon + logical, intent(in), optional :: mid_timestep ! Accurate solar zenith angle calculation ! Inputs: lat, lon in degrees; time from this%hour, this%minute, this%second; day of year from this%doy real :: lat_rad, lon_rad, decl_rad, ha_rad real :: decl, eqtime, time_offset, tst, ha - real :: cos_sza_val + !real :: cos_sza_val real :: fractional_hour, gamma ! Convert latitude and longitude to radians @@ -61,20 +66,32 @@ real function get_sza(this, lat, lon) result(sza) lon_rad = lon * PI_180 ! Calculate fractional hour of the day (UTC) - fractional_hour = real(this%hour) + real(this%minute)/60.0 + real(this%second)/3600.0 + if (present(mid_timestep)) then + if (mid_timestep) then + fractional_hour = real(this%hour) + real(this%minute)/60.0 + real(this%second)/3600.0 + (this%timestep/2.0)/3600.0 + end if + else + fractional_hour = real(this%hour) + real(this%minute)/60.0 + real(this%second)/3600.0 + end if ! Calculate day angle (in radians) gamma = 2.0 * PI * (real(this%doy) - 1.0) / 365.0 ! Solar declination (in degrees, then radians) - decl = 23.44 * sin(2.0 * PI * (real(this%doy) - 81.0) / 365.0) - decl_rad = decl * PI_180 + !decl = 23.44 * sin(2.0 * PI * (real(this%doy) - 81.0) / 365.0) + !decl_rad = decl * PI_180 + + !use a more accurate formula for declination + decl = 0.006918 - 0.399912*cos(gamma) + 0.070257*sin(gamma) & + - 0.006758*cos(2.0*gamma) + 0.000907*sin(2.0*gamma) & + - 0.002697*cos(3.0*gamma) + 0.00148*sin(3.0*gamma) + decl_rad = decl - ! Equation of time (in minutes) + ! Equation of time (in minutes). eqtime = 229.18 * (0.000075 + 0.001868 * cos(gamma) - 0.032077 * sin(gamma) \ - 0.014615 * cos(2.0*gamma) - 0.040849 * sin(2.0*gamma)) - ! Time offset (in minutes) + ! Time offset (in minutes). Note here we assume longitude between -180 and 180 degrees time_offset = eqtime + 4.0 * lon ! True solar time (in minutes) @@ -87,16 +104,17 @@ real function get_sza(this, lat, lon) result(sza) ! Solar zenith angle calculation cos_sza_val = sin(lat_rad) * sin(decl_rad) + cos(lat_rad) * cos(decl_rad) * cos(ha_rad) cos_sza_val = max(-1.0, min(1.0, cos_sza_val)) ! Clamp for safety - sza = acos(cos_sza_val) / PI_180 - sza = min(max(sza, 0.0), 90.0) ! Clamp to [0, 90] degrees - end function get_sza + end function get_cos_sza !> \brief Compute cosine of solar zenith angle - real function get_cos_sza(this, lat, lon) result(cos_sza) + real function get_sza(this, lat, lon) result(sza) class(TimeStateType), intent(in) :: this real, intent(in) :: lat, lon - cos_sza = cos(this%get_sza(lat, lon) * PI_180) - end function get_cos_sza + real :: cos_sza_val + cos_sza_val = this%get_cos_sza(lat, lon) + sza = acos(cos_sza_val) / PI_180 + sza = min(max(sza, 0.0), 90.0) ! clamp to [0, 90] (daylight) degrees + end function get_sza !> \brief Get model timestep (seconds) real function get_timestep(this) result(dt) @@ -126,61 +144,234 @@ integer function get_doy(this) result(doy) end function get_doy !> \brief Initialize TimeStateType - subroutine timestate_init(this, error_mgr, rc) + !! Sets default values, calculates derived quantities (Julian date, DOY), + !! and validates the initial time configuration. + subroutine timestate_init(this, year, month, day, hour, minute, second, timestep, error_mgr, rc) + use error_mod, only: ERROR_INVALID_INPUT + class(TimeStateType), intent(inout) :: this + integer, optional, intent(in) :: year, month, day, hour, minute, second + real, optional, intent(in) :: timestep type(ErrorManagerType), pointer, intent(inout) :: error_mgr integer, intent(out) :: rc - ! Suppress unused parameter warning - if (associated(error_mgr)) continue + character(len=256) :: thisLoc + + thisLoc = 'timestate_init (in core/TimeState_Mod.F90)' + call error_mgr%push_context('timestate_init', 'initializing time state') + rc = CC_SUCCESS + + ! Set time components with defaults or provided values + this%year = 2000 + this%month = 1 + this%day = 1 + this%hour = 0 + this%minute = 0 + this%second = 0 + this%timestep = 3600.0 ! 1 hour default + + if (present(year)) this%year = year + if (present(month)) this%month = month + if (present(day)) this%day = day + if (present(hour)) this%hour = hour + if (present(minute)) this%minute = minute + if (present(second)) this%second = second + if (present(timestep)) this%timestep = timestep + + ! Calculate derived quantities + call this%calculate_derived_fields(error_mgr, rc) + if (rc /= CC_SUCCESS) then + call error_mgr%pop_context() + return + endif + + ! Validate the initialized state + call this%validate(error_mgr, rc) + + call error_mgr%pop_context() end subroutine timestate_init !> \brief Validate TimeStateType + !! Checks that all time components are within valid ranges and + !! that derived quantities are consistent. subroutine timestate_validate(this, error_mgr, rc) + use error_mod, only: ERROR_INVALID_INPUT + class(TimeStateType), intent(in) :: this type(ErrorManagerType), pointer, intent(inout) :: error_mgr integer, intent(out) :: rc - ! Suppress unused parameter warning - if (associated(error_mgr)) continue + character(len=256) :: thisLoc + integer :: days_in_month + + thisLoc = 'timestate_validate (in core/TimeState_Mod.F90)' + call error_mgr%push_context('timestate_validate', 'validating time state') + rc = CC_SUCCESS + + ! Validate year (reasonable range) + if (this%year < 1900 .or. this%year > 2200) then + call error_mgr%report_error(ERROR_INVALID_INPUT, & + 'Year must be between 1900 and 2200', rc, & + thisLoc, 'Adjust year to reasonable range') + call error_mgr%pop_context() + return + endif + + ! Validate month + if (this%month < 1 .or. this%month > 12) then + call error_mgr%report_error(ERROR_INVALID_INPUT, & + 'Month must be between 1 and 12', rc, & + thisLoc, 'Set month to valid range [1-12]') + call error_mgr%pop_context() + return + endif + + ! Validate day based on month and leap year + days_in_month = get_days_in_month(this%month, this%year) + if (this%day < 1 .or. this%day > days_in_month) then + call error_mgr%report_error(ERROR_INVALID_INPUT, & + 'Day is invalid for the given month/year', rc, & + thisLoc, 'Set day to valid range for the month') + call error_mgr%pop_context() + return + endif + + ! Validate hour + if (this%hour < 0 .or. this%hour > 23) then + call error_mgr%report_error(ERROR_INVALID_INPUT, & + 'Hour must be between 0 and 23', rc, & + thisLoc, 'Set hour to valid range [0-23]') + call error_mgr%pop_context() + return + endif + + ! Validate minute + if (this%minute < 0 .or. this%minute > 59) then + call error_mgr%report_error(ERROR_INVALID_INPUT, & + 'Minute must be between 0 and 59', rc, & + thisLoc, 'Set minute to valid range [0-59]') + call error_mgr%pop_context() + return + endif + + ! Validate second + if (this%second < 0 .or. this%second > 59) then + call error_mgr%report_error(ERROR_INVALID_INPUT, & + 'Second must be between 0 and 59', rc, & + thisLoc, 'Set second to valid range [0-59]') + call error_mgr%pop_context() + return + endif + + ! Validate timestep + if (this%timestep <= 0.0) then + call error_mgr%report_error(ERROR_INVALID_INPUT, & + 'Timestep must be positive', rc, & + thisLoc, 'Set timestep to positive value in seconds') + call error_mgr%pop_context() + return + endif + + ! Validate day of year + if (this%doy < 1 .or. this%doy > 366) then + call error_mgr%report_error(ERROR_INVALID_INPUT, & + 'Day of year must be between 1 and 366', rc, & + thisLoc, 'Check DOY calculation') + call error_mgr%pop_context() + return + endif + + call error_mgr%pop_context() end subroutine timestate_validate !> \brief Cleanup TimeStateType + !! Resets all time state variables to uninitialized values. + !! This prepares the object for deallocation or reinitialization. subroutine timestate_cleanup(this, error_mgr, rc) class(TimeStateType), intent(inout) :: this type(ErrorManagerType), pointer, intent(inout) :: error_mgr integer, intent(out) :: rc - ! Suppress unused parameter warning - if (associated(error_mgr)) continue + character(len=256) :: thisLoc + + thisLoc = 'timestate_cleanup (in core/TimeState_Mod.F90)' + call error_mgr%push_context('timestate_cleanup', 'cleaning up time state') + rc = CC_SUCCESS + + ! Reset all time components to invalid/uninitialized values + this%year = -1 + this%month = -1 + this%day = -1 + this%hour = -1 + this%minute = -1 + this%second = -1 + this%timestep = -1.0 + this%julian_date = -1.0 + this%doy = -1 + + call error_mgr%pop_context() end subroutine timestate_cleanup !> \brief Reset TimeStateType + !! Resets time state to default values (Jan 1, 2000, 00:00:00) + !! and recalculates derived quantities. subroutine timestate_reset(this, error_mgr, rc) class(TimeStateType), intent(inout) :: this type(ErrorManagerType), pointer, intent(inout) :: error_mgr integer, intent(out) :: rc - ! Suppress unused parameter warning - if (associated(error_mgr)) continue + character(len=256) :: thisLoc + + thisLoc = 'timestate_reset (in core/TimeState_Mod.F90)' + call error_mgr%push_context('timestate_reset', 'resetting time state') + rc = CC_SUCCESS + + ! Reset to default values + this%year = 2000 + this%month = 1 + this%day = 1 + this%hour = 0 + this%minute = 0 + this%second = 0 + this%timestep = 3600.0 ! 1 hour + + ! Recalculate derived quantities + call this%calculate_derived_fields(error_mgr, rc) + + call error_mgr%pop_context() end subroutine timestate_reset !> \brief Get status of TimeStateType + !! Returns initialized status if all time components are valid function timestate_get_status(this) result(status) class(TimeStateType), intent(in) :: this integer :: status - status = STATE_STATUS_INITIALIZED + + ! Check if time state has been properly initialized + if (this%year > 0 .and. this%month > 0 .and. this%day > 0 .and. & + this%hour >= 0 .and. this%minute >= 0 .and. this%second >= 0 .and. & + this%timestep > 0.0 .and. this%doy > 0) then + status = STATE_STATUS_INITIALIZED + else + status = STATE_STATUS_UNINITIALIZED + endif end function timestate_get_status !> \brief Get memory usage of TimeStateType + !! Returns estimated memory usage in bytes for the time state object function timestate_get_memory_usage(this) result(memory_bytes) class(TimeStateType), intent(in) :: this integer(8) :: memory_bytes - memory_bytes = 0_8 + + ! Estimate memory usage: + ! 6 integers (year, month, day, hour, minute, second, doy) = 6 * 4 = 24 bytes + ! 2 reals (timestep, julian_date) = 2 * 4 = 8 bytes (assuming real is 4 bytes) + ! Total ≈ 32 bytes + memory_bytes = 32_8 end function timestate_get_memory_usage !> \brief Print info for TimeStateType @@ -195,10 +386,12 @@ subroutine timestate_print_info(this, unit) end subroutine timestate_print_info !> \brief Is TimeStateType ready? + !! Returns true if the time state is properly initialized and valid function timestate_is_ready(this) result(ready) class(TimeStateType), intent(in) :: this logical :: ready - ready = .true. + + ready = (this%get_status() == STATE_STATUS_INITIALIZED) end function timestate_is_ready !> \brief Check if a date is a global holiday @@ -246,4 +439,95 @@ pure integer function get_timezone_offset(this, lon) result(tz_offset) tz_offset = max(-12, min(14, tz_offset)) end function get_timezone_offset + !> \brief Calculate derived fields (Julian date, DOY) from date components + !! \param[inout] this TimeStateType object + !! \param[inout] error_mgr Error manager + !! \param[out] rc Return code + subroutine calculate_derived_fields(this, error_mgr, rc) + use error_mod, only: ERROR_INVALID_INPUT + + class(TimeStateType), intent(inout) :: this + type(ErrorManagerType), pointer, intent(inout) :: error_mgr + integer, intent(out) :: rc + + integer :: a, y, m, jdn + character(len=256) :: thisLoc + + thisLoc = 'calculate_derived_fields (in core/TimeState_Mod.F90)' + rc = CC_SUCCESS + + ! Calculate Julian Date Number using standard algorithm + if (this%month > 2) then + a = 0 + y = this%year + m = this%month + else + a = 1 + y = this%year - 1 + m = this%month + 12 + endif + + ! Julian Day Number (integer part) + jdn = int(365.25 * (y + 4716)) + int(30.6001 * (m + 1)) + this%day - 1524 - a + + ! Julian Date (with fractional day) + this%julian_date = real(jdn) + (this%hour + this%minute/60.0 + this%second/3600.0) / 24.0 + + ! Calculate day of year + this%doy = calculate_day_of_year(this%year, this%month, this%day) + + end subroutine calculate_derived_fields + + !> \brief Get number of days in a given month, accounting for leap years + !! \param[in] month Month (1-12) + !! \param[in] year Year + !! \return Number of days in the month + pure integer function get_days_in_month(month, year) result(days) + integer, intent(in) :: month, year + + integer, parameter :: days_per_month(12) = [31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31] + + days = days_per_month(month) + + ! Adjust February for leap years + if (month == 2 .and. is_leap_year(year)) then + days = 29 + endif + + end function get_days_in_month + + !> \brief Check if a year is a leap year + !! \param[in] year Year to check + !! \return True if leap year, false otherwise + pure logical function is_leap_year(year) result(is_leap) + integer, intent(in) :: year + + is_leap = (mod(year, 4) == 0 .and. mod(year, 100) /= 0) .or. (mod(year, 400) == 0) + + end function is_leap_year + + !> \brief Calculate day of year from month and day + !! \param[in] year Year + !! \param[in] month Month (1-12) + !! \param[in] day Day of month + !! \return Day of year (1-366) + pure integer function calculate_day_of_year(year, month, day) result(doy) + integer, intent(in) :: year, month, day + + integer :: i + integer, parameter :: days_per_month(12) = [31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31] + + doy = day + + ! Add days from previous months + do i = 1, month - 1 + doy = doy + days_per_month(i) + ! Add extra day for February in leap years + if (i == 2 .and. is_leap_year(year)) then + doy = doy + 1 + endif + enddo + + end function calculate_day_of_year + end module TimeState_Mod diff --git a/src/core/VirtualColumn_Mod.F90 b/src/core/VirtualColumn_Mod.F90 index 000bdc15..2321766e 100644 --- a/src/core/VirtualColumn_Mod.F90 +++ b/src/core/VirtualColumn_Mod.F90 @@ -77,17 +77,17 @@ module VirtualColumn_Mod subroutine virtual_met_cleanup(this) class(VirtualMetType), intent(inout) :: this - print *, '[DEBUG] Entering virtual_met_cleanup' + !print *, '[DEBUG] Entering virtual_met_cleanup' if (associated(this%T)) then - print *, '[DEBUG] Cleaning up T, associated before nullify' + ! print *, '[DEBUG] Cleaning up T, associated before nullify' else - print *, '[DEBUG] T not associated' + ! print *, '[DEBUG] T not associated' endif ! Generated cleanup code from MetState field definitions #include "virtualmet_cleanup.inc" - print *, '[DEBUG] Exiting virtual_met_cleanup' + !print *, '[DEBUG] Exiting virtual_met_cleanup' end subroutine virtual_met_cleanup !========================================================================= @@ -252,18 +252,18 @@ end function virtual_column_is_initialized subroutine virtual_column_cleanup(this) class(VirtualColumnType), intent(inout) :: this - print *, '[DEBUG] Entering virtual_column_cleanup' + !print *, '[DEBUG] Entering virtual_column_cleanup' ! Clean up meteorological pointers call this%met%cleanup() ! Deallocate chemical and emission data if (allocated(this%chem_data)) then - print *, '[DEBUG] Deallocating chem_data' + !print *, '[DEBUG] Deallocating chem_data' deallocate(this%chem_data) endif if (allocated(this%emis_data)) then - print *, '[DEBUG] Deallocating emis_data' + !print *, '[DEBUG] Deallocating emis_data' deallocate(this%emis_data) endif @@ -272,7 +272,7 @@ subroutine virtual_column_cleanup(this) this%nspec_emis = 0 this%is_valid = .false. - print *, '[DEBUG] Exiting virtual_column_cleanup' + !print *, '[DEBUG] Exiting virtual_column_cleanup' end subroutine virtual_column_cleanup end module VirtualColumn_Mod diff --git a/src/core/chemstate_mod.F90 b/src/core/chemstate_mod.F90 index 2261f926..969ed2ef 100644 --- a/src/core/chemstate_mod.F90 +++ b/src/core/chemstate_mod.F90 @@ -15,7 +15,7 @@ module ChemState_Mod USE Precision_Mod USE species_mod, only: SpeciesType USE GridGeometry_Mod, only: GridGeometryType - ! USE state_interface_mod ! Removed for decoupling + USE GOCART2G_MieMod, only: GOCART2G_Mie IMPLICIT NONE PRIVATE @@ -71,6 +71,7 @@ module ChemState_Mod INTEGER :: nSpeciesAero ! Number of Aerosol Species INTEGER :: nSpeciesAeroDryDep ! Number of Aerosol Species for Dry Dep INTEGER :: nSpeciesDryDep ! Number of DryDep Species + INTEGER :: nSpeciesWetDep ! Number of WetDep Species INTEGER :: nSpeciesTracer ! Number of Tracer Species INTEGER :: nSpeciesDust ! Number of Dust Species INTEGER :: nSpeciesSeaSalt ! Number of SeaSalt Species @@ -82,7 +83,11 @@ module ChemState_Mod INTEGER, ALLOCATABLE :: DustIndex(:) ! Dust Species Index INTEGER, ALLOCATABLE :: SeaSaltIndex(:) ! SeaSalt Species Index INTEGER, ALLOCATABLE :: DryDepIndex(:) ! DryDep Species Index + INTEGER, ALLOCATABLE :: WetDepIndex(:) ! WetDep Species Index CHARACTER(len=50), ALLOCATABLE :: SpeciesNames(:) ! Species Names + type(GOCART2G_Mie), ALLOCATABLE :: MieData(:) ! Mie data for aerosols + CHARACTER(len=50), ALLOCATABLE :: MieNames(:) ! Mie species names + INTEGER, ALLOCATABLE :: SpcMieMap(:) ! Mapping from species name to Mie data !--------------------------------------------------------------------- ! Reals @@ -114,6 +119,7 @@ module ChemState_Mod procedure :: has_species => chemstate_has_species procedure :: get_dimensions => chemstate_get_dimensions + procedure :: init_mie_data => chemstate_init_mie_data end type ChemStateType CONTAINS @@ -164,6 +170,7 @@ subroutine Find_Number_of_Species(ChemState, RC) ChemState%nSpeciesAero = 0 ChemState%nSpeciesAeroDryDep = 0 ChemState%nSpeciesDryDep = 0 + ChemState%nSpeciesWetDep = 0 ChemState%nSpeciesDust = 0 ChemState%nSpeciesGas = 0 ChemState%nSpeciesSeaSalt = 0 @@ -187,13 +194,15 @@ subroutine Find_Number_of_Species(ChemState, RC) ChemState%nSpeciesTracer = ChemState%nSpeciesTracer + 1 endif if (ChemState%ChemSpecies(i)%is_drydep .eqv. .true.) then - ChemState%nSpeciesAeroDryDep = ChemState%nSpeciesAeroDryDep + 1 ChemState%nSpeciesDryDep = ChemState%nSpeciesDryDep + 1 endif if (ChemState%ChemSpecies(i)%is_drydep .eqv. .true. .and. & ChemState%ChemSpecies(i)%is_aerosol .eqv. .true.) then ChemState%nSpeciesAeroDryDep = ChemState%nSpeciesAeroDryDep + 1 endif + if (ChemState%ChemSpecies(i)%is_wetdep .eqv. .true.) then + ChemState%nSpeciesWetDep = ChemState%nSpeciesWetDep + 1 + endif enddo end subroutine Find_Number_of_Species @@ -551,6 +560,7 @@ subroutine chemstate_init(this, max_species, error_mgr, rc, grid) this%nSpeciesAero = 0 this%nSpeciesAeroDryDep = 0 this%nSpeciesDryDep = 0 + this%nSpeciesWetDep = 0 this%nSpeciesTracer = 0 this%nSpeciesDust = 0 this%nSpeciesSeaSalt = 0 @@ -627,6 +637,15 @@ subroutine chemstate_init(this, max_species, error_mgr, rc, grid) return endif + allocate(this%WetDepIndex(max_species), stat=allocStat) + if (allocStat /= 0) then + call error_mgr%report_error(ERROR_MEMORY_ALLOCATION, & + 'Failed to allocate WetDepIndex', rc, & + thisLoc, 'Check available memory') + call error_mgr%pop_context() + return + endif + allocate(this%AeroDryDepIndex(max_species), stat=allocStat) if (allocStat /= 0) then call error_mgr%report_error(ERROR_MEMORY_ALLOCATION, & @@ -705,9 +724,13 @@ subroutine chemstate_cleanup(this, rc) if (allocated(this%DustIndex)) deallocate(this%DustIndex) if (allocated(this%SeaSaltIndex)) deallocate(this%SeaSaltIndex) if (allocated(this%DryDepIndex)) deallocate(this%DryDepIndex) + if (allocated(this%WetDepIndex)) deallocate(this%WetDepIndex) if (allocated(this%AeroDryDepIndex)) deallocate(this%AeroDryDepIndex) if (allocated(this%SpeciesNames)) deallocate(this%SpeciesNames) if (allocated(this%ChemSpecies)) deallocate(this%ChemSpecies) + if (allocated(this%MieData)) deallocate(this%MieData) + if (allocated(this%MieNames)) deallocate(this%MieNames) + if (allocated(this%SpcMieMap)) deallocate(this%SpcMieMap) ! Clean up grid geometry pointer (nullify only, don't deallocate as we don't own it) if (associated(this%Grid)) then @@ -720,6 +743,7 @@ subroutine chemstate_cleanup(this, rc) this%nSpeciesAero = 0 this%nSpeciesAeroDryDep = 0 this%nSpeciesDryDep = 0 + this%nSpeciesWetDep = 0 this%nSpeciesTracer = 0 this%nSpeciesDust = 0 this%nSpeciesSeaSalt = 0 @@ -797,6 +821,7 @@ subroutine chemstate_reset(this, rc) this%nSpeciesAero = 0 this%nSpeciesAeroDryDep = 0 this%nSpeciesDryDep = 0 + this%nSpeciesWetDep = 0 this%nSpeciesTracer = 0 this%nSpeciesDust = 0 this%nSpeciesSeaSalt = 0 @@ -809,6 +834,7 @@ subroutine chemstate_reset(this, rc) if (allocated(this%DustIndex)) this%DustIndex = 0 if (allocated(this%SeaSaltIndex)) this%SeaSaltIndex = 0 if (allocated(this%DryDepIndex)) this%DryDepIndex = 0 + if (allocated(this%WetDepIndex)) this%WetDepIndex = 0 if (allocated(this%AeroDryDepIndex)) this%AeroDryDepIndex = 0 if (allocated(this%SpeciesNames)) this%SpeciesNames = '' @@ -854,6 +880,9 @@ function chemstate_get_memory_usage(this) result(memory_bytes) if (allocated(this%DryDepIndex)) then memory_bytes = memory_bytes + size(this%DryDepIndex) * 4 endif + if (allocated(this%WetDepIndex)) then + memory_bytes = memory_bytes + size(this%WetDepIndex) * 4 + endif if (allocated(this%AeroDryDepIndex)) then memory_bytes = memory_bytes + size(this%AeroDryDepIndex) * 4 endif @@ -880,6 +909,7 @@ subroutine chemstate_print_summary(this) write(*,'(A,I0)') 'Sea salt species: ', this%nSpeciesSeaSalt write(*,'(A,I0)') 'Tracer species: ', this%nSpeciesTracer write(*,'(A,I0)') 'DryDep species: ', this%nSpeciesDryDep + write(*,'(A,I0)') 'WetDep species: ', this%nSpeciesWetDep write(*,'(A,L1)') 'Arrays allocated: ', this%is_allocated() write(*,'(A,I0,A)') 'Memory usage: ', this%get_memory_usage(), ' bytes' write(*,'(A)') '========================' @@ -1146,4 +1176,100 @@ subroutine chemstate_set_all_concentrations(this, concentrations, rc) rc = CC_SUCCESS end subroutine chemstate_set_all_concentrations + !> \brief Initialize Mie data for aerosol optical properties + !! + !! This subroutine allocates and initializes Mie scattering data based on + !! the configuration file information and species Mie name mappings. + !! + !! \param[inout] this ChemStateType object + !! \param[in] n_mie_files Number of Mie files + !! \param[in] mie_names Array of Mie type names (e.g., 'SS', 'DU', 'BC') + !! \param[in] mie_full_paths Array of full file paths to Mie data files + !! \param[out] rc Return code + subroutine chemstate_init_mie_data(this, n_mie_files, mie_names, mie_full_paths, rc) + implicit none + class(ChemStateType), intent(inout) :: this + integer, intent(in) :: n_mie_files + character(len=30), intent(in) :: mie_names(:) + character(len=512), intent(in) :: mie_full_paths(:) + integer, intent(out) :: rc + + integer :: i, j, local_rc + !integer :: channels(4) = [470, 550, 670, 870] ! Example channels: 470, 550, 670, 870 nm + character(len=255) :: err_msg + character(len=255) :: this_loc + + rc = CC_SUCCESS + this_loc = ' -> at chemstate_init_mie_data (in core/chemstate_mod.F90)' + + ! Allocate MieData and MieNames arrays + if (allocated(this%MieData)) deallocate(this%MieData) + if (allocated(this%MieNames)) deallocate(this%MieNames) + + allocate(this%MieData(n_mie_files), stat=rc) + if (rc /= CC_SUCCESS) then + err_msg = 'Error allocating MieData array' + call CC_Error(err_msg, rc, this_loc) + return + end if + + allocate(this%MieNames(n_mie_files), stat=rc) + if (rc /= CC_SUCCESS) then + err_msg = 'Error allocating MieNames array' + call CC_Error(err_msg, rc, this_loc) + return + end if + + ! Copy Mie names and load Mie data files + do i = 1, n_mie_files + this%MieNames(i) = mie_names(i) + + ! Initialize Mie data from file [470 550 670 870] nm for diagnostics + !this%MieData(i) = GOCART2G_Mie(trim(mie_full_paths(i)), channels*1.e-9, nmom=0, rc=local_rc) !This is for diagMie + this%MieData(i) = GOCART2G_Mie(trim(mie_full_paths(i)), rc=local_rc) + if (local_rc /= 0) then + err_msg = 'Error initializing Mie data for ' // trim(mie_names(i)) // & + ' from file: ' // trim(mie_full_paths(i)) + rc = local_rc + call CC_Error(err_msg, rc, this_loc) + return + end if + end do + + ! Allocate and compute species-to-Mie mapping + if (allocated(this%SpcMieMap)) deallocate(this%SpcMieMap) + allocate(this%SpcMieMap(this%nSpecies), stat=rc) + if (rc /= CC_SUCCESS) then + err_msg = 'Error allocating SpcMieMap array' + call CC_Error(err_msg, rc, this_loc) + return + end if + + ! Initialize mapping to zero (no Mie data) + this%SpcMieMap(:) = 0 + + ! Map species to Mie data based on species mie_name field + do i = 1, this%nSpecies + if (len_trim(this%ChemSpecies(i)%mie_name) > 0) then + ! Find matching Mie data + do j = 1, n_mie_files + if (trim(this%ChemSpecies(i)%mie_name) == trim(this%MieNames(j))) then + this%SpcMieMap(i) = j + exit + end if + end do + + ! Warn if no matching Mie data found + if (this%SpcMieMap(i) == 0) then + err_msg = 'Warning: No Mie data found for species ' // & + trim(this%ChemSpecies(i)%short_name) // ' with mie_name: ' // & + trim(this%ChemSpecies(i)%mie_name) + call CC_Warning(err_msg, rc, this_loc) + end if + end if + end do + + rc = CC_SUCCESS + end subroutine chemstate_init_mie_data + end module ChemState_Mod diff --git a/src/core/met_utilities_mod.F90 b/src/core/met_utilities_mod.F90 index 6421a908..96b65a96 100644 --- a/src/core/met_utilities_mod.F90 +++ b/src/core/met_utilities_mod.F90 @@ -119,6 +119,8 @@ function relative_humidity(T, qv, p) result(rh) e = qv * p / (0.622_fp + 0.378_fp * qv) es = saturation_vapor_pressure(T) rh = e / es + ! Clip to physical limits + rh = max(0.0_fp, min(1.0_fp, rh)) end function relative_humidity !> \brief Calculate saturation vapor pressure (Clausius-Clapeyron) @@ -184,7 +186,7 @@ function monin_obukhov_length(ustar, T0, H, rho) result(L) if (ustar > 0.0_fp .and. abs(H) > 0.0_fp) then L = - (ustar**3 * rho * Cp * T0) / (VON_KARMAN * g0 * H) else - L = 1.0e6_fp ! Neutral/very stable default + L = 1.0e5_fp ! Neutral/very stable default endif end function monin_obukhov_length diff --git a/src/core/metstate_mod.F90 b/src/core/metstate_mod.F90 index ffa90fe9..948bbb3c 100644 --- a/src/core/metstate_mod.F90 +++ b/src/core/metstate_mod.F90 @@ -13,7 +13,8 @@ MODULE MetState_Mod USE Error_Mod USE Precision_Mod USE GridGeometry_Mod - ! USE TimeState_Mod, only: TimeStateType + USE Met_Utilities_Mod + USE TimeState_Mod, only: TimeStateType @@ -92,6 +93,7 @@ MODULE MetState_Mod INTEGER :: nSOIL !< # number of soil layers INTEGER :: nSOILTYPE !< # number of soil types REAL(fp), ALLOCATABLE :: SOILM(:,:,:) !< Volumetric Soil moisture [m3/m3] (nx,ny,nsoil) + REAL(fp), ALLOCATABLE :: SOILT(:,:,:) !< Temperature of soil layer [K] (nx,ny,nsoil) REAL(fp), ALLOCATABLE :: FRLANDUSE(:,:,:) !< Fractional Land Use (nx,ny,nlanduse) REAL(fp), ALLOCATABLE :: FRSOIL(:,:,:) !< Fractional Soil (nx,ny,nsoil) REAL(fp), ALLOCATABLE :: FRLAI(:,:,:) !< LAI in each Fractional Land use type [m2/m2] (nx,ny,nlanduse) @@ -121,6 +123,10 @@ MODULE MetState_Mod REAL(fp), ALLOCATABLE :: FRZ0(:,:,:) !< Aerodynamic Roughness Length per FRLANDUSE (nx,ny,nlanduse) REAL(fp), ALLOCATABLE :: PBLH(:,:) !< PBL height [m] REAL(fp), ALLOCATABLE :: SALINITY(:,:) !< Salinity of the ocean [part per thousand] + REAL(fp), ALLOCATABLE :: CMM(:,:) !< Aerodynamic conductance [m/s] + REAL(fp), ALLOCATABLE :: ORO(:,:) !< surface height above sea level [m] + REAL(fp), ALLOCATABLE :: RCA(:,:) !< Aerodynamic resistance in canopy [s/m] + REAL(fp), ALLOCATABLE :: WCA(:,:) ! canopy water amount [kg/m2] ! 3D volumetric fields (3D: nx, ny, nz) REAL(fp), ALLOCATABLE :: F_OF_PBL(:,:,:) !< Fraction of box within PBL [1] REAL(fp), ALLOCATABLE :: F_UNDER_PBLTOP(:,:,:) !< Fraction of box under PBL top @@ -138,13 +144,14 @@ MODULE MetState_Mod REAL(fp), ALLOCATABLE :: PRECANV(:,:) !< Anvil previp @ ground [kg/m2/s] -> [mm/day] REAL(fp), ALLOCATABLE :: PRECCON(:,:) !< Conv precip @ ground [kg/m2/s] -> [mm/day] REAL(fp), ALLOCATABLE :: PRECLSC(:,:) !< Large-scale precip @ ground kg/m2/s] -> [mm/day] + real(fp), ALLOCATABLE :: REEVAPLS(:,:,:) !< Evap of precip LS+anvil [kg/kg/s] (assume per dry air) ! 3D cloud and precipitation arrays REAL(fp), ALLOCATABLE :: QI(:,:,:) !< Mass fraction of cloud ice water [kg/kg dry air] REAL(fp), ALLOCATABLE :: QL(:,:,:) !< Mass fraction of cloud liquid water [kg/kg dry air] REAL(fp), ALLOCATABLE :: PFICU(:,:,:) !< Dwn flux ice prec:conv [kg/m2/s] - REAL(fp), ALLOCATABLE :: PFILSAN(:,:,:) !< Dwn flux ice prec:LS+anv [kg/m2/s] + REAL(fp), ALLOCATABLE :: PFILSAN(:,:,:) !< Dwn flux ice prec:LS+anv [kg/m2/s] (nx,ny,nz+1) REAL(fp), ALLOCATABLE :: PFLCU(:,:,:) !< Dwn flux liq prec:conv [kg/m2/s] - REAL(fp), ALLOCATABLE :: PFLLSAN(:,:,:) !< Dwn flux ice prec:LS+anv [kg/m2/s] + REAL(fp), ALLOCATABLE :: PFLLSAN(:,:,:) !< Dwn flux liq prec:LS+anv [kg/m2/s] (nx,ny,nz+1) REAL(fp), ALLOCATABLE :: TAUCLI(:,:,:) !< Opt depth of ice clouds [1] REAL(fp), ALLOCATABLE :: TAUCLW(:,:,:) !< Opt depth of H2O clouds [1] ! Surface scalars (now 2D: nx, ny) @@ -163,8 +170,8 @@ MODULE MetState_Mod INTEGER, ALLOCATABLE :: TropLev(:,:) !< Tropopause level [1] REAL(fp), ALLOCATABLE :: TropHt(:,:) !< Tropopause height [km] ! 3D atmospheric variables (3D: nx, ny, nz) - REAL(fp), ALLOCATABLE :: Z(:,:,:) !< Full Layer Geopotential Height - REAL(fp), ALLOCATABLE :: ZMID(:,:,:) !< Mid Layer Geopotential Height + REAL(fp), ALLOCATABLE :: Z(:,:,:) !< Geopotential Height @ level edges [m] (nx,ny,nz+1) + REAL(fp), ALLOCATABLE :: ZMID(:,:,:) !< Mid Layer Geopotential Height [m] REAL(fp), ALLOCATABLE :: BXHEIGHT(:,:,:) !< Grid box height [m] (dry air) REAL(fp), ALLOCATABLE :: QV(:,:,:) !< Specific Humidity [kg/kg] REAL(fp), ALLOCATABLE :: T(:,:,:) !< Temperature [K] @@ -175,12 +182,13 @@ MODULE MetState_Mod REAL(fp), ALLOCATABLE :: OMEGA(:,:,:) !< Updraft velocity [Pa/s] REAL(fp), ALLOCATABLE :: RH(:,:,:) !< Relative humidity [fraction, not %] REAL(fp), ALLOCATABLE :: SPHU(:,:,:) !< Specific humidity [g H2O/kg tot air] - REAL(fp), ALLOCATABLE :: AIRDEN(:,:,:) !< Dry air density [kg/m3] + REAL(fp), ALLOCATABLE :: AIRDEN(:,:,:) !< Wet air density [kg/m3] + REAL(fp), ALLOCATABLE :: AIRDEN_DRY(:,:,:) !< Dry air density [kg/m3] REAL(fp), ALLOCATABLE :: AIRNUMDEN(:,:,:) !< Dry air density [molec/cm3] - REAL(fp), ALLOCATABLE :: MAIRDEN(:,:,:) !< Moist air density [kg/m3] + REAL(fp), ALLOCATABLE :: MAIRDEN(:,:,:) !< Moist air density (same as AIRDEN to cover possible use cases) [kg/m3] REAL(fp), ALLOCATABLE :: AVGW(:,:,:) !< Water vapor volume mixing ratio [vol H2O/vol dry air] - REAL(fp), ALLOCATABLE :: DELP(:,:,:) !< Delta-P (wet) across box [hPa] - REAL(fp), ALLOCATABLE :: DELP_DRY(:,:,:) !< Delta-P (dry) across box [hPa] + REAL(fp), ALLOCATABLE :: DELP(:,:,:) !< Delta-P (wet) across box [Pa] + REAL(fp), ALLOCATABLE :: DELP_DRY(:,:,:) !< Delta-P (dry) across box [Pa] REAL(fp), ALLOCATABLE :: DAIRMASS(:,:,:) !< Dry air mass [kg] in grid box REAL(fp), ALLOCATABLE :: AIRVOL(:,:,:) !< Grid box volume [m3] (dry air) REAL(fp), ALLOCATABLE :: PEDGE_DRY(:,:,:) !< Dry air partial pressure @ level edges [Pa] (nx,ny,nz+1) @@ -229,6 +237,7 @@ MODULE MetState_Mod procedure, public :: metstate_set_field_3d_int procedure, public :: metstate_set_field_3d_logical procedure, public :: set_multiple_fields => metstate_set_multiple_fields + procedure, public :: derive_field => metstate_derive_field procedure :: allocate_field => metstate_allocate_field procedure :: deallocate_field => metstate_deallocate_field procedure, private :: allocate_arrays => allocate_metstate_arrays @@ -1183,4 +1192,387 @@ end subroutine metstate_set_field_3d_logical ! Include the auto-generated multiple fields interface #include "metstate_multiple_fields_interface.inc" + !> \brief Derive meteorological fields from existing data + !! + !! Calculates derived fields using existing meteorological variables. + !! Supports common derived quantities like air density, virtual temperature, etc. + !! + !! \param[inout] this MetStateType object + !! \param[in] field_name Name of the field to derive + !! \param[inout] error_mgr Error manager for context and error reporting + !! \param[out] rc Return code (CC_SUCCESS or error code) + subroutine metstate_derive_field(this, field_name, error_mgr, time_state, rc) + use error_mod, only: ErrorManagerType, CC_SUCCESS, CC_FAILURE, ERROR_INVALID_INPUT, ERROR_NOT_FOUND + use constants, only: g0, Rd, Rdg0, AIRMW, H2OMW + + implicit none + class(MetStateType), intent(inout) :: this + character(len=*), intent(in) :: field_name + type(ErrorManagerType), pointer, intent(inout) :: error_mgr + type(TimeStateType), pointer,intent(inout) :: time_state + integer, intent(out) :: rc + + character(len=256) :: thisLoc + integer :: nx, ny, nz, i, j, k, nlanduse + real(fp) :: airden + real(fp) :: avgw ! Water vapor volume mixing ratio [v/v dry air] + real(fp) :: xh2o ! Water vapor mole fraction [mol (H2O) / mol (moist air)] + + thisLoc = 'metstate_derive_field (in core/metstate_mod.F90)' + call error_mgr%push_context('metstate_derive_field', 'deriving field: ' // trim(field_name)) + + rc = CC_SUCCESS + call this%get_dimensions(nx, ny, nz) + + select case (trim(adjustl(field_name))) + + case ('MAIRDEN', 'mairden', 'AIRDEN', 'airden') + ! Calculate dry air density from pressure and temperature + ! ρ = P / (R_specific * T) where R_specific = R / MW + if (.not. allocated(this%PMID) .or. .not. allocated(this%T)) then + call error_mgr%report_error(ERROR_INVALID_INPUT, & + 'PMID and T fields required for MAIRDEN/AIRDEN calculation', rc, & + thisLoc, 'Ensure pressure and temperature are available') + call error_mgr%pop_context() + return + endif + + ! Allocate MAIRDEN if not already allocated + if (.not. allocated(this%MAIRDEN) .or. .not. allocated(this%AIRDEN)) then + call error_mgr%report_error(rc, 'MAIRDEN/AIRDEN fields need to be allocated first!', rc, thisLoc) + call error_mgr%pop_context() + return + endif + + ! Calculate dry air density: ρ = P / (R_dry * T) + do k = 1, nz + do j = 1, ny + do i = 1, nx + this%MAIRDEN(i, j, k) = this%PMID(i, j, k) / rd / this%T(i, j, k) + this%AIRDEN(i, j, k) = this%PMID(i, j, k) / rd / this%T(i, j, k) + enddo + enddo + enddo + + case ('AIRDEN_DRY', 'airden_dry', 'PMID_DRY', 'pmid_dry', 'PEDGE_DRY', 'pedge_dry', 'DELP_DRY', 'delp_dry') + ! Calculate dry air density from pressure and temperature + ! ρ = P / (R_specific * T) where R_specific = R / MW + if (.not. allocated(this%PMID) .or. .not. allocated(this%T)) then + call error_mgr%report_error(ERROR_INVALID_INPUT, & + 'PMID and T fields required for AIRDEN_DRY calculation', rc, & + thisLoc, 'Ensure pressure and temperature are available') + call error_mgr%pop_context() + return + endif + + ! Allocate AIRDEN_DRY if not already allocated + if (.not. allocated(this%AIRDEN_DRY) .or. .not. allocated(this%PMID_DRY) .or. & + .not. allocated(this%PEDGE_DRY) .or. .not. allocated(this%DELP_DRY)) then + call error_mgr%report_error(rc, 'AIRDEN_DRY/PMID_DRY/PEDGE_DRY/DELP_DRY fields need to be allocated first!', rc, thisLoc) + call error_mgr%pop_context() + return + endif + + ! Calculate dry air density: ρ = P / (R_dry * T) + do k = 1, nz + do j = 1, ny + do i = 1, nx + avgw = AIRMW * this%QV(i,j,k) / ( H2OMW * (1.0e+0_fp - this%QV(i,j,k)) ) + xh2o = avgw / (1.0e+0_fp + avgw) + this%PMID_DRY(i, j, k) = this%PMID(i, j, k) * ( 1.e+0_fp - xh2o ) + this%AIRDEN_DRY(i, j, k) = this%PMID_DRY(i, j, k) / rd / this%T(i, j, k) + this%PEDGE_DRY(i, j, k) = this%PEDGE(i, j, k) * ( 1.e+0_fp - xh2o ) + if (k == nz) then + this%PEDGE_DRY(i, j, k+1) = this%PEDGE(i, j, k+1) * ( 1.e+0_fp - xh2o ) + end if + this%DELP_DRY(i, j, k) = this%PEDGE_DRY(i, j, k) - this%PEDGE_DRY(i, j, k+1) + enddo + enddo + enddo + + case ('RH', 'rh') + ! Calculate virtual temperature from temperature and humidity + if (.not. allocated(this%T) .or. .not. allocated(this%QV) .or. .not. allocated(this%PMID)) then + call error_mgr%report_error(ERROR_INVALID_INPUT, & + 'T, PMID and QV fields required for RH calculation', rc, & + thisLoc, 'Ensure temperature, pressure and humidity are available') + call error_mgr%pop_context() + return + endif + + ! Allocate RH if not already allocated + if (.not. allocated(this%RH)) then + call error_mgr%report_error(rc, 'RH field needs to be allocated first!', rc, thisLoc) + call error_mgr%pop_context() + return + endif + + ! Calculate relative humidity from met_utility module + do k = 1, nz + do j = 1, ny + do i = 1, nx + this%RH(i, j, k) = relative_humidity(this%T(i, j, k), this%QV(i, j, k), this%PMID(i, j, k)) + enddo + enddo + enddo + + case ('TV', 'tv') + ! Calculate virtual temperature from temperature and humidity + if (.not. allocated(this%T) .or. .not. allocated(this%QV)) then + call error_mgr%report_error(ERROR_INVALID_INPUT, & + 'T and QV fields required for TV calculation', rc, & + thisLoc, 'Ensure temperature and humidity are available') + call error_mgr%pop_context() + return + endif + + ! Allocate TV if not already allocated + if (.not. allocated(this%TV)) then + call error_mgr%report_error(rc, 'TV field needs to be allocated first!', rc, thisLoc) + call error_mgr%pop_context() + return + endif + + ! Calculate virtual temperature: Tv = T * (1 + 0.608 * qv) + do k = 1, nz + do j = 1, ny + do i = 1, nx + this%TV(i, j, k) = this%T(i, j, k) * (1.0_fp + 0.608_fp * this%QV(i, j, k)) + enddo + enddo + enddo + + case ('OBK', 'obk') + ! Calculate OBK from sensible heat flux and air density + if (.not. allocated(this%HFLUX) .or. .not. allocated(this%AIRDEN) .or. .not. allocated(this%TS) .or. & + .not. allocated(this%USTAR)) then + call error_mgr%report_error(ERROR_INVALID_INPUT, & + 'TS, USTAR, AIRDEN and HFLUX fields required for OBK calculation', rc, & + thisLoc, 'Ensure temperature, ustar, air density, and sensible heat flux are available') + call error_mgr%pop_context() + return + endif + + ! Allocate OBK if not already allocated + if (.not. allocated(this%OBK)) then + call error_mgr%report_error(rc, 'OBK field needs to be allocated first!', rc, thisLoc) + call error_mgr%pop_context() + return + endif + + ! Calculate OBK from met_utility module + do j = 1, ny + do i = 1, nx + airden = this%PMID(i, j, 1) / rd / this%T(i, j, 1) + !!!! Note we cannot use this%AIRDEN here because it may not be calculated yet + this%OBK(i, j) = monin_obukhov_length(this%USTAR(i, j), this%TS(i, j), this%HFLUX(i, j), airden) + enddo + enddo + + case ('SUNCOS', 'suncos') + ! Calculate SUNCOS + if (.not. allocated(this%LAT) .or. .not. allocated(this%LON)) then + call error_mgr%report_error(ERROR_INVALID_INPUT, & + 'LAT and LON fields required for SUNCOS calculation', rc, & + thisLoc, 'Ensure latitude and longitude are available') + call error_mgr%pop_context() + return + endif + + ! Allocate OBK if not already allocated + if (.not. allocated(this%SUNCOS)) then + call error_mgr%report_error(rc, 'SUNCOS field needs to be allocated first!', rc, thisLoc) + call error_mgr%pop_context() + return + endif + + ! Calculate OBK from met_utility module + do j = 1, ny + do i = 1, nx + !make sure lat[-90 - 90] and lon[-180 - 180] are in degrees + this%SUNCOS(i, j) = time_state%get_cos_sza(this%LAT(i, j), this%LON(i, j)) + enddo + enddo + + case ('SUNCOSmid', 'suncosmid') + ! Calculate SUNCOSmid + if (.not. allocated(this%LAT) .or. .not. allocated(this%LON)) then + call error_mgr%report_error(ERROR_INVALID_INPUT, & + 'LAT and LON fields required for SUNCOSmid calculation', rc, & + thisLoc, 'Ensure latitude and longitude are available') + call error_mgr%pop_context() + return + endif + + ! Allocate OBK if not already allocated + if (.not. allocated(this%SUNCOSmid)) then + call error_mgr%report_error(rc, 'SUNCOSmid field needs to be allocated first!', rc, thisLoc) + call error_mgr%pop_context() + return + endif + + ! Calculate OBK from met_utility module + do j = 1, ny + do i = 1, nx + !make sure lat[-90 - 90] and lon[-180 - 180] are in degrees + this%SUNCOSmid(i, j) = time_state%get_cos_sza(this%LAT(i, j), this%LON(i, j), .true.) + enddo + enddo + + case ('DELP', 'delp') + ! Calculate box height from geopotential heights + if (.not. allocated(this%PEDGE)) then + call error_mgr%report_error(ERROR_INVALID_INPUT, & + 'PEDGE field required for DELP calculation', rc, & + thisLoc, 'Ensure pressure edges are available') + call error_mgr%pop_context() + return + endif + + ! Allocate BXHEIGHT if not already allocated + if (.not. allocated(this%DELP)) then + call error_mgr%report_error(rc, 'BXHEIGHT field needs to be allocated first!', rc, thisLoc) + call error_mgr%pop_context() + return + endif + + ! Calculate box height as difference between edge heights + do k = 1, nz + do j = 1, ny + do i = 1, nx + ! lower edge - upper edge + this%DELP(i, j, k) = this%PEDGE(i, j, k) - this%PEDGE(i, j, k+1) + enddo + enddo + enddo + + case ('BXHEIGHT', 'bxheight') + ! Calculate box height from geopotential heights + if (.not. allocated(this%PEDGE)) then + call error_mgr%report_error(ERROR_INVALID_INPUT, & + 'PEDGE field required for BXHEIGHT calculation', rc, & + thisLoc, 'Ensure pressure edges are available') + call error_mgr%pop_context() + return + endif + + ! Allocate BXHEIGHT if not already allocated + if (.not. allocated(this%BXHEIGHT)) then + call error_mgr%report_error(rc, 'BXHEIGHT field needs to be allocated first!', rc, thisLoc) + call error_mgr%pop_context() + return + endif + + ! Calculate box height as difference between edge heights + do k = 1, nz + do j = 1, ny + do i = 1, nx + ! Refer to https://github.com/geoschem/geos-chem/GeosCore/calc_met_mod.F90 + this%BXHEIGHT(i, j, k) = Rdg0 * virtual_temperature(this%T(i, j, k), this%QV(i, j, k)) * & + LOG(this%PEDGE(i, j, k) / this%PEDGE(i, j, k+1)) + enddo + enddo + enddo + + case ('SST', 'sst') + this%SST(:,:) = this%TS(:,:) !just copy TS to SST + + case ('TSKIN', 'tskin') + this%TSKIN(:,:) = this%TS(:,:) !just copy TS to TSKIN + + case ('Z0H', 'z0h') + this%Z0H(:,:) = this%Z0(:,:) !just copy Z0 to Z0H + + case ('CLDFRC', 'cldfrc') + this%CLDFRC(:,:) = this%CLDF(:,:, 1) !just copy surface CLDF to CLDFRC + + case ('IsLand', 'island', 'ISLAND') + do j = 1, ny + do i = 1, nx + this%IsLand(i, j) = ( abs(this%LWI(i, j) - 1.0_fp) < 0.5_fp ) ! Land if LWI = 1.0 + enddo + enddo + + case ('IsIce', 'isice', 'ISICE') + do j = 1, ny + do i = 1, nx + this%IsIce(i, j) = ( abs(this%LWI(i, j) - 2.0_fp) < 0.5_fp ) ! Ice if LWI = 2.0 + enddo + enddo + + case ('IsWater', 'iswater', 'ISWATER') + do j = 1, ny + do i = 1, nx + this%IsWater(i, j) = ( abs(this%LWI(i, j) - 0.0_fp) < 0.5_fp ) ! sea if LWI = 0.0 + enddo + enddo + + case ('IsSnow', 'issnow', 'ISSNOW') + do j = 1, ny + do i = 1, nx + !geos-chem has a different method: https://github.com/geoschem/geos-chem/GeosCore/calc_met_mod.F90#L324 + this%IsSnow(i, j) = ( this%FRSNO(i, j) >= 0.5_fp ) ! Snow fraction is read in + enddo + enddo + + case ('LUCNAME', 'lucname') + this%LUCNAME = 'NOAH' + case ('nLNDTYPE', 'nlndtype', 'NLNDTYPE') + nlanduse = 20 !set to 20 for now; later we can read from a config file or pass in from outside + this%nLNDTYPE(:,:) = nlanduse !manually set to 20 for now; not sure if NUOPC can get it + case ('FRLANDUSE', 'frlanduse') + !Note that FRLANDUSE is not allocated yet in met_sate%init phase because we don't know nlanduse yet + nlanduse = 20 !set to 20 for now; later we can read from a config file or pass in from outside + if (.not. allocated(this%FRLANDUSE)) allocate(this%FRLANDUSE(nx, ny, nlanduse)) + this%FRLANDUSE(:,:,:) = 0.0_fp + do j = 1, ny + do i = 1, nx + do k = 1, nlanduse + if (this%DLUSE(i, j) == k) this%FRLANDUSE(i, j, k) = 1.0_fp + !We receive DLUSE = 0 over water but it should be 17th type + if (this%DLUSE(i, j) == 0 .and. k == 17) this%FRLANDUSE(i, j, k) = 1.0_fp + enddo + enddo + enddo + case ('ILAND', 'iland') + !Note that ILAND is not allocated yet in met_sate%init phase because we don't know nlanduse yet + nlanduse = 20 !set to 20 for now; later we can read from a config file or pass in from outside + if (.not. allocated(this%ILAND)) allocate(this%ILAND(nx, ny, nlanduse)) + this%ILAND(:,:,:) = 0 + do j = 1, ny + do i = 1, nx + do k = 1, nlanduse + this%ILAND(i, j, k) = k + enddo + enddo + enddo + case ('FRLAI', 'frlai') + !Note that FRLAI is not allocated yet in met_sate%init phase because we don't know nlanduse yet + nlanduse = 20 !set to 20 for now; later we can read from a config file or pass in from outside + if (.not. allocated(this%FRLAI)) allocate(this%FRLAI(nx, ny, nlanduse)) + this%FRLAI(:,:,:) = 0.0_fp + do j = 1, ny + do i = 1, nx + do k = 1, nlanduse + if (this%DLUSE(i, j) == k) this%FRLAI(i, j, k) = this%LAI(i, j) !TODO: should times fraclanduse but here is 1.0 + enddo + this%FRLAI(i, j, 15:17) = 0.0 !manually give index 15(snow and ice), 16(barren), 17(water) zeros + enddo + enddo + case ('SALINITY', 'salinity') + this%SALINITY(:,:) = 0.0_fp !set to zero for now, which will turn off O3 dry deposition over ocean with iodine. + + case ('REEVAPLS', 'reevapls') + this%REEVAPLS(:,:,:) = 0.0_fp !set to zero for now because I did not find data from GFS. This will overestimate the washout of aerosols. + + case default + call error_mgr%report_error(ERROR_NOT_FOUND, & + 'Unknown derived field: ' // trim(field_name), rc, & + thisLoc, 'Supported fields: AIRDEN, TV, BXHEIGHT') + rc = CC_FAILURE + end select + + call error_mgr%pop_context() + end subroutine metstate_derive_field + END MODULE MetState_Mod diff --git a/src/core/species_mod.F90 b/src/core/species_mod.F90 index f222d80c..d7992f5e 100644 --- a/src/core/species_mod.F90 +++ b/src/core/species_mod.F90 @@ -75,6 +75,7 @@ module species_mod logical :: is_tracer !< If true, species is a tracer and not an aerosol or gas that undergoes chemistry or photolysis logical :: is_advected !< If true, species is advected logical :: is_drydep !< If true, species undergoes dry deposition + logical :: is_wetdep !< if true, species undergoes wet deposition logical :: is_photolysis !< If true, species undergoes photolysis logical :: is_gocart_aero !< If true, species is a GOCART aerosol species logical :: is_dust !< If true, species is dust @@ -95,6 +96,19 @@ module species_mod real(kind=fp) :: dd_DvzMinVal_snow !< minimum dry deposition velocity (cm/s) over snow and ice real(kind=fp) :: dd_DvzMinVal_land !< minimum dry deposition velocity (cm/s) over land + ! used for wet deposition + !real(kind=fp) :: radius_wet !< mean molecular diameter in meters for wet conditions (use the same radius for both dry and wet deposition for now) + real(kind=fp) :: henry_k0 !< Henry’s law solubility constant ( M / atm) + real(kind=fp) :: henry_cr !< Henry’s law volatility constant (K) + real(kind=fp) :: henry_pKa !< Henry’s Law pH correction factor (seems zeros for all species now) + real(kind=fp) :: wd_retfactor !< retention efficiency of species in the liquid cloud condensate as it is converted to precipitation + logical :: wd_LiqAndGas !< whether the ice-to-gas ratio can be computed for this species by co-condensation + real(kind=fp) :: wd_convfacI2G !< conversion factor for computing the ice-to-gas ratio by co-condensation when wd_LiqAndGas = .true. + real(kind=fp) :: wd_rainouteff(3) !< temperature-dependent (T < 237k; 237 <= T < 258k; T >= 258k) scale factor for the fraction of rainout. + + !used for settling + character(len=30) :: mie_name !< Mie data name associated with this species for settling velocity calculation + ! Default background concentration real(kind=fp) :: BackgroundVV !< Background concentration [v/v] @@ -188,6 +202,7 @@ subroutine species_init(this, species_name, long_name, molecular_weight, rc) ! Initialize species properties this%short_name = trim(species_name) this%long_name = trim(long_name) + this%description = '' ! Initialize description this%mw_g = molecular_weight ! Set defaults @@ -196,6 +211,7 @@ subroutine species_init(this, species_name, long_name, molecular_weight, rc) this%is_tracer = .false. this%is_advected = .true. this%is_drydep = .false. + this%is_wetdep = .false. ! Initialize wet deposition flag this%is_photolysis = .false. this%is_gocart_aero = .false. this%is_dust = .false. @@ -206,7 +222,25 @@ subroutine species_init(this, species_name, long_name, molecular_weight, rc) this%lower_radius = 0.0_fp this%upper_radius = 0.0_fp this%viscosity = 1.0e-5_fp + + ! Initialize dry deposition properties + this%dd_f0 = 0.0_fp + this%dd_hstar = 0.0_fp + this%dd_DvzAerSnow = 0.0_fp + this%dd_DvzMinVal_snow = 0.0_fp + this%dd_DvzMinVal_land = 0.0_fp + + ! Initialize wet deposition properties + this%henry_k0 = 0.0_fp + this%henry_cr = 0.0_fp + this%henry_pKa = 0.0_fp + this%wd_retfactor = 0.0_fp + this%wd_LiqAndGas = .false. + this%wd_convfacI2G = 0.0_fp + this%wd_rainouteff(:) = 0.0_fp + this%BackgroundVV = MISSING_VV + this%mie_name = '' ! Initialize Mie name to empty this%species_index = -1 this%drydep_index = -1 @@ -348,6 +382,8 @@ subroutine species_cleanup(this, rc) if (associated(this%conc)) deallocate(this%conc) + this%description = '' ! Clear description + this%mie_name = '' ! Clear Mie name this%is_valid = .false. rc = CC_SUCCESS @@ -542,6 +578,7 @@ subroutine species_copy(this, source, rc) ! Copy all scalar properties this%short_name = source%short_name this%long_name = source%long_name + this%description = source%description ! Copy logical switches this%is_gas = source%is_gas @@ -549,6 +586,7 @@ subroutine species_copy(this, source, rc) this%is_tracer = source%is_tracer this%is_advected = source%is_advected this%is_drydep = source%is_drydep + this%is_wetdep = source%is_wetdep this%is_photolysis = source%is_photolysis this%is_gocart_aero = source%is_gocart_aero this%is_dust = source%is_dust @@ -561,7 +599,25 @@ subroutine species_copy(this, source, rc) this%lower_radius = source%lower_radius this%upper_radius = source%upper_radius this%viscosity = source%viscosity + + ! Copy dry deposition properties + this%dd_f0 = source%dd_f0 + this%dd_hstar = source%dd_hstar + this%dd_DvzAerSnow = source%dd_DvzAerSnow + this%dd_DvzMinVal_snow = source%dd_DvzMinVal_snow + this%dd_DvzMinVal_land = source%dd_DvzMinVal_land + + ! Copy wet deposition properties + this%henry_k0 = source%henry_k0 + this%henry_cr = source%henry_cr + this%henry_pKa = source%henry_pKa + this%wd_retfactor = source%wd_retfactor + this%wd_LiqAndGas = source%wd_LiqAndGas + this%wd_convfacI2G = source%wd_convfacI2G + this%wd_rainouteff = source%wd_rainouteff + this%BackgroundVV = source%BackgroundVV + this%mie_name = source%mie_name ! Copy indices this%species_index = source%species_index @@ -598,14 +654,22 @@ subroutine species_print_info(this) write(*, '(A)') '=== Species Information ===' write(*, '(A,A)') 'Short name: ', trim(this%short_name) write(*, '(A,A)') 'Long name: ', trim(this%long_name) + write(*, '(A,A)') 'Description: ', trim(this%description) write(*, '(A,F12.6)') 'Molecular weight [g/mol]: ', this%mw_g write(*, '(A,F12.3)') 'Density [kg/m³]: ', this%density write(*, '(A,E12.5)') 'Radius [m]: ', this%radius write(*, '(A,L1)') 'Is gas: ', this%is_gas write(*, '(A,L1)') 'Is aerosol: ', this%is_aerosol write(*, '(A,L1)') 'Is tracer: ', this%is_tracer + write(*, '(A,L1)') 'Is advected: ', this%is_advected write(*, '(A,L1)') 'Undergoes dry deposition: ', this%is_drydep + write(*, '(A,L1)') 'Undergoes wet deposition: ', this%is_wetdep write(*, '(A,L1)') 'Undergoes photolysis: ', this%is_photolysis + write(*, '(A,L1)') 'Is GOCART aerosol: ', this%is_gocart_aero + write(*, '(A,L1)') 'Is dust: ', this%is_dust + write(*, '(A,L1)') 'Is seasalt: ', this%is_seasalt + write(*, '(A,A)') 'Mie data name: ', trim(this%mie_name) + write(*, '(A,E12.5)') 'Background concentration [v/v]: ', this%BackgroundVV write(*, '(A,I0)') 'Species index: ', this%species_index if (associated(this%conc)) then write(*, '(A,I0)') 'Concentration grid size: ', size(this%conc) diff --git a/src/external/GOCART b/src/external/GOCART index c393e57d..9ff3df95 160000 --- a/src/external/GOCART +++ b/src/external/GOCART @@ -1 +1 @@ -Subproject commit c393e57d4472c06ec61b770f8f46a152fd3280ff +Subproject commit 9ff3df9545dd582f415f682d3297e8c6c841e5cb diff --git a/src/process/CMakeLists.txt b/src/process/CMakeLists.txt index 140cb43a..b18c6728 100644 --- a/src/process/CMakeLists.txt +++ b/src/process/CMakeLists.txt @@ -4,4 +4,6 @@ add_compile_options(${_catchem_compiler_options}) add_subdirectory(seasalt) #add_subdirectory(plumerise) add_subdirectory(drydep) +add_subdirectory(wetdep) +add_subdirectory(settling) #add_subdirectory(chem) diff --git a/src/process/drydep/DryDepCommon_Mod.F90 b/src/process/drydep/DryDepCommon_Mod.F90 index b465c805..0e663737 100644 --- a/src/process/drydep/DryDepCommon_Mod.F90 +++ b/src/process/drydep/DryDepCommon_Mod.F90 @@ -4,7 +4,7 @@ !! This module defines the configuration types used by the !! drydep process and its schemes. !! -!! Generated on: 2025-11-14T22:58:26.251823 +!! Generated on: 2025-11-25T22:20:02.319771 !! Author: Wei Li !! Version: 1.0.0 @@ -97,8 +97,8 @@ module DryDepCommon_Mod real(fp) :: co2_reference = 380.0 ! Reference CO2 level for stomatal conductance adjustment ! Required meteorological fields - integer :: n_required_met_fields = 19 - character(len=32) :: required_met_fields(19) + integer :: n_required_met_fields = 21 + character(len=32) :: required_met_fields(21) contains procedure, public :: validate => validate_wesely_config @@ -124,8 +124,8 @@ module DryDepCommon_Mod logical :: resuspension = .false. ! Apply resuspension for dry deposition ! Required meteorological fields - integer :: n_required_met_fields = 12 - character(len=32) :: required_met_fields(12) + integer :: n_required_met_fields = 13 + character(len=32) :: required_met_fields(13) contains procedure, public :: validate => validate_gocart_config @@ -150,8 +150,8 @@ module DryDepCommon_Mod real(fp) :: scale_factor = 1.0 ! Dry deposition velocity scale factor ! Required meteorological fields - integer :: n_required_met_fields = 13 - character(len=32) :: required_met_fields(13) + integer :: n_required_met_fields = 15 + character(len=32) :: required_met_fields(15) contains procedure, public :: validate => validate_zhang_config diff --git a/src/process/drydep/ProcessDryDepInterface_Mod.F90 b/src/process/drydep/ProcessDryDepInterface_Mod.F90 index e266c858..858a7d61 100644 --- a/src/process/drydep/ProcessDryDepInterface_Mod.F90 +++ b/src/process/drydep/ProcessDryDepInterface_Mod.F90 @@ -11,7 +11,7 @@ !! This approach maintains backward compatibility while providing flexible diagnostic capabilities. !! !! This code was generated by the CATChem Process Generator. -!! Generation date: 2025-11-14T22:58:25.022560 +!! Generation date: 2025-11-25T22:20:02.219376 !! Configuration: drydep !! !! @author CATChem Process Generator @@ -385,7 +385,7 @@ subroutine run_wesely_scheme_column(this, column, rc) real(fp), allocatable :: species_tendencies(:,:) integer :: n_species, n_levels, n_chem, n_emis, i, k integer, allocatable :: species_indices(:) - real(fp) :: dqa ! Concentration change for additive tendencies + real(fp) :: loss_fraction ! Loss fraction for multiplicative tendencies rc = CC_SUCCESS @@ -406,7 +406,7 @@ subroutine run_wesely_scheme_column(this, column, rc) allocate(species_conc(1, n_species)) allocate(species_tendencies(1, n_species)) ! Allocate meteorological field arrays based on field type and process configuration - allocate(bxheight(1)) ! Surface level only + allocate(bxheight(n_levels)) ! Atmospheric field - always n_levels allocate(cldfrc(1)) ! Surface field - always scalar @@ -444,7 +444,7 @@ subroutine run_wesely_scheme_column(this, column, rc) allocate(iland(size(met%ILAND))) ! Categorical field - get size from met pointer ! Extract required fields from met pointer based on field type and processing mode - bxheight(1) = met%BXHEIGHT(1) ! Surface level only + bxheight(1:n_levels) = met%BXHEIGHT(1:n_levels) ! Atmospheric field - always n_levels cldfrc(1) = met%CLDFRC ! Surface field - scalar access frlai(:) = met%FRLAI(:) ! Categorical field - full dimension frlanduse(:) = met%FRLANDUSE(:) ! Categorical field - full dimension @@ -575,11 +575,11 @@ subroutine run_wesely_scheme_column(this, column, rc) do i = 1, n_species ! Skip species that don't match scheme type (gas vs aerosol) if (.not. this%process_config%drydep_config%is_gas(i)) cycle - ! Additive tendency (default): new_conc = conc + dqa - ! Dry deposition specific calculation: dqa = MAX(0.0, conc * (1 - exp(-tendency * dt))) - dqa = MAX(0.0_fp, species_conc(1, i) * (1.0_fp - exp(-1.0_fp * species_tendencies(1, i) * this%get_timestep()))) + ! Multiplicative tendency: new_conc = conc * (1 - loss_fraction) + ! where loss_fraction = 1 - exp(-tendency * dt) + loss_fraction = MAX(1.0_fp - exp(-species_tendencies(1, i) * this%get_timestep()), 0.0_fp) call column%set_chem_field(1, species_indices(i), & - species_conc(1, i) - dqa) + species_conc(1, i) * (1.0_fp - loss_fraction)) end do end subroutine run_wesely_scheme_column @@ -598,23 +598,23 @@ subroutine run_gocart_scheme_column(this, column, rc) real(fp), allocatable :: gwettop(:) real(fp), allocatable :: hflux(:) integer, allocatable :: lwi(:) - real(fp), allocatable :: nlevs(:) real(fp), allocatable :: pblh(:) real(fp), allocatable :: t(:) real(fp), allocatable :: tstep(:) real(fp), allocatable :: u10m(:) real(fp), allocatable :: ustar(:) real(fp), allocatable :: v10m(:) + real(fp), allocatable :: z(:) real(fp), allocatable :: z0h(:) - real(fp), allocatable :: zmid(:) ! Species properties real(fp), allocatable :: species_density(:) real(fp), allocatable :: species_radius(:) + logical, allocatable :: species_is_seasalt(:) real(fp), allocatable :: species_conc(:,:) real(fp), allocatable :: species_tendencies(:,:) integer :: n_species, n_levels, n_chem, n_emis, i, k integer, allocatable :: species_indices(:) - real(fp) :: dqa ! Concentration change for additive tendencies + real(fp) :: loss_fraction ! Loss fraction for multiplicative tendencies rc = CC_SUCCESS @@ -635,22 +635,22 @@ subroutine run_gocart_scheme_column(this, column, rc) allocate(species_conc(1, n_species)) allocate(species_tendencies(1, n_species)) ! Allocate meteorological field arrays based on field type and process configuration - allocate(airden(1)) ! Surface level only + allocate(airden(n_levels)) ! Atmospheric field - always n_levels allocate(frlake(1)) ! Surface field - always scalar allocate(gwettop(1)) ! Surface field - always scalar allocate(hflux(1)) ! Surface field - always scalar allocate(lwi(1)) ! Surface field - always scalar - allocate(nlevs(1)) ! Surface field - always scalar allocate(pblh(1)) ! Surface field - always scalar - allocate(t(1)) ! Surface level only + allocate(t(n_levels)) ! Atmospheric field - always n_levels allocate(tstep(1)) ! Special timestep field - scalar allocate(u10m(1)) ! Surface field - always scalar allocate(ustar(1)) ! Surface field - always scalar allocate(v10m(1)) ! Surface field - always scalar + allocate(z(n_levels+1)) ! Edge field - always n_levels+1 allocate(z0h(1)) ! Surface field - always scalar - allocate(zmid(1)) ! Surface level only allocate(species_density(n_species)) allocate(species_radius(n_species)) + allocate(species_is_seasalt(n_species)) species_tendencies = 0.0_fp ! Get meteorological data pointer from virtual column (VirtualMet pattern) @@ -659,20 +659,19 @@ subroutine run_gocart_scheme_column(this, column, rc) ! Now allocate categorical fields using the met pointer dimensions ! Extract required fields from met pointer based on field type and processing mode - airden(1) = met%AIRDEN(1) ! Surface level only + airden(1:n_levels) = met%AIRDEN(1:n_levels) ! Atmospheric field - always n_levels frlake(1) = met%FRLAKE ! Surface field - scalar access gwettop(1) = met%GWETTOP ! Surface field - scalar access hflux(1) = met%HFLUX ! Surface field - scalar access lwi(1) = met%LWI ! Surface field - scalar access - nlevs(1) = met%NLEVS ! Surface field - scalar access pblh(1) = met%PBLH ! Surface field - scalar access - t(1) = met%T(1) ! Surface level only + t(1:n_levels) = met%T(1:n_levels) ! Atmospheric field - always n_levels tstep(1) = this%get_timestep() ! Special timestep field - retrieved from ProcessInterface u10m(1) = met%U10M ! Surface field - scalar access ustar(1) = met%USTAR ! Surface field - scalar access v10m(1) = met%V10M ! Surface field - scalar access + z(1:n_levels+1) = met%Z(1:n_levels+1) ! Edge field - always n_levels+1 z0h(1) = met%Z0H ! Surface field - scalar access - zmid(1) = met%ZMID(1) ! Surface level only ! Get species concentrations from virtual column ! Surface-only processing - get surface level concentrations @@ -685,6 +684,8 @@ subroutine run_gocart_scheme_column(this, column, rc) species_density(1:n_species) = this%process_config%drydep_config%species_density(1:n_species) ! Use species properties from process configuration species_radius(1:n_species) = this%process_config%drydep_config%species_radius(1:n_species) + ! Use species properties from process configuration + species_is_seasalt(1:n_species) = this%process_config%drydep_config%species_is_seasalt(1:n_species) ! Call the science scheme with optional diagnostic parameters ! Note: gocart uses the following diagnostic fields (if diagnostics enabled): @@ -701,17 +702,17 @@ subroutine run_gocart_scheme_column(this, column, rc) gwettop(1), & hflux(1), & lwi(1), & - nlevs(1), & pblh(1), & t, & tstep(1), & u10m(1), & ustar(1), & v10m(1), & - z0h(1), & - zmid , & + z, & + z0h(1) , & species_density, & species_radius, & + species_is_seasalt, & species_conc, & species_tendencies, & this%process_config%drydep_config%is_gas, & @@ -729,17 +730,17 @@ subroutine run_gocart_scheme_column(this, column, rc) gwettop(1), & hflux(1), & lwi(1), & - nlevs(1), & pblh(1), & t, & tstep(1), & u10m(1), & ustar(1), & v10m(1), & - z0h(1), & - zmid , & + z, & + z0h(1) , & species_density, & species_radius, & + species_is_seasalt, & species_conc, & species_tendencies, & this%process_config%drydep_config%is_gas & @@ -751,11 +752,11 @@ subroutine run_gocart_scheme_column(this, column, rc) do i = 1, n_species ! Skip species that don't match scheme type (gas vs aerosol) if (this%process_config%drydep_config%is_gas(i)) cycle - ! Additive tendency (default): new_conc = conc + dqa - ! Dry deposition specific calculation: dqa = MAX(0.0, conc * (1 - exp(-tendency * dt))) - dqa = MAX(0.0_fp, species_conc(1, i) * (1.0_fp - exp(-1.0_fp * species_tendencies(1, i) * this%get_timestep()))) + ! Multiplicative tendency: new_conc = conc * (1 - loss_fraction) + ! where loss_fraction = 1 - exp(-tendency * dt) + loss_fraction = MAX(1.0_fp - exp(-species_tendencies(1, i) * this%get_timestep()), 0.0_fp) call column%set_chem_field(1, species_indices(i), & - species_conc(1, i) - dqa) + species_conc(1, i) * (1.0_fp - loss_fraction)) end do end subroutine run_gocart_scheme_column @@ -800,7 +801,7 @@ subroutine run_zhang_scheme_column(this, column, rc) real(fp), allocatable :: species_tendencies(:,:) integer :: n_species, n_levels, n_chem, n_emis, i, k integer, allocatable :: species_indices(:) - real(fp) :: dqa ! Concentration change for additive tendencies + real(fp) :: loss_fraction ! Loss fraction for multiplicative tendencies rc = CC_SUCCESS @@ -821,7 +822,7 @@ subroutine run_zhang_scheme_column(this, column, rc) allocate(species_conc(1, n_species)) allocate(species_tendencies(1, n_species)) ! Allocate meteorological field arrays based on field type and process configuration - allocate(bxheight(1)) ! Surface level only + allocate(bxheight(n_levels)) ! Atmospheric field - always n_levels allocate(isice(1)) ! Surface field - always scalar @@ -829,7 +830,7 @@ subroutine run_zhang_scheme_column(this, column, rc) allocate(lucname(1)) ! Surface field - always scalar allocate(obk(1)) ! Surface field - always scalar allocate(ps(1)) ! Surface field - always scalar - allocate(rh(1)) ! Surface level only + allocate(rh(n_levels)) ! Atmospheric field - always n_levels allocate(ts(1)) ! Surface field - always scalar allocate(tstep(1)) ! Special timestep field - scalar allocate(u10m(1)) ! Surface field - always scalar @@ -857,7 +858,7 @@ subroutine run_zhang_scheme_column(this, column, rc) allocate(iland(size(met%ILAND))) ! Categorical field - get size from met pointer ! Extract required fields from met pointer based on field type and processing mode - bxheight(1) = met%BXHEIGHT(1) ! Surface level only + bxheight(1:n_levels) = met%BXHEIGHT(1:n_levels) ! Atmospheric field - always n_levels frlanduse(:) = met%FRLANDUSE(:) ! Categorical field - full dimension iland(:) = met%ILAND(:) ! Categorical field - full dimension isice(1) = met%IsIce ! Surface field - scalar access @@ -865,7 +866,7 @@ subroutine run_zhang_scheme_column(this, column, rc) lucname(1) = met%LUCNAME ! Surface field - scalar access obk(1) = met%OBK ! Surface field - scalar access ps(1) = met%PS ! Surface field - scalar access - rh(1) = met%RH(1) ! Surface level only + rh(1:n_levels) = met%RH(1:n_levels) ! Atmospheric field - always n_levels ts(1) = met%TS ! Surface field - scalar access tstep(1) = this%get_timestep() ! Special timestep field - retrieved from ProcessInterface u10m(1) = met%U10M ! Surface field - scalar access @@ -990,11 +991,11 @@ subroutine run_zhang_scheme_column(this, column, rc) do i = 1, n_species ! Skip species that don't match scheme type (gas vs aerosol) if (this%process_config%drydep_config%is_gas(i)) cycle - ! Additive tendency (default): new_conc = conc + dqa - ! Dry deposition specific calculation: dqa = MAX(0.0, conc * (1 - exp(-tendency * dt))) - dqa = MAX(0.0_fp, species_conc(1, i) * (1.0_fp - exp(-1.0_fp * species_tendencies(1, i) * this%get_timestep()))) + ! Multiplicative tendency: new_conc = conc * (1 - loss_fraction) + ! where loss_fraction = 1 - exp(-tendency * dt) + loss_fraction = MAX(1.0_fp - exp(-species_tendencies(1, i) * this%get_timestep()), 0.0_fp) call column%set_chem_field(1, species_indices(i), & - species_conc(1, i) - dqa) + species_conc(1, i) * (1.0_fp - loss_fraction)) end do end subroutine run_zhang_scheme_column @@ -1013,37 +1014,37 @@ function get_required_met_fields(this) result(field_names) integer :: total_fields, scheme_count, process_count, i, j, unique_count logical :: is_duplicate - ! Process-level required fields - process_count = 2 - allocate(process_fields(process_count)) - process_fields(1) = 'USTAR' - process_fields(2) = 'TSTEP' + ! No process-level required fields + process_count = 0 + allocate(process_fields(0)) ! For gas/aero differentiated processes, get fields from both schemes ! Get gas scheme fields select case (trim(this%process_config%drydep_config%gas_scheme)) case ('wesely') - gas_scheme_count = 19 + gas_scheme_count = 21 allocate(gas_scheme_fields(gas_scheme_count)) - gas_scheme_fields(1) = 'TS' - gas_scheme_fields(2) = 'SWGDN' - gas_scheme_fields(3) = 'SUNCOSmid' - gas_scheme_fields(4) = 'OBK' - gas_scheme_fields(5) = 'CLDFRC' - gas_scheme_fields(6) = 'BXHEIGHT' - gas_scheme_fields(7) = 'Z0' - gas_scheme_fields(8) = 'PS' - gas_scheme_fields(9) = 'FRLAI' - gas_scheme_fields(10) = 'ILAND' - gas_scheme_fields(11) = 'SALINITY' - gas_scheme_fields(12) = 'FRLANDUSE' - gas_scheme_fields(13) = 'TSKIN' - gas_scheme_fields(14) = 'LON' - gas_scheme_fields(15) = 'LAT' - gas_scheme_fields(16) = 'LUCNAME' - gas_scheme_fields(17) = 'IsSnow' - gas_scheme_fields(18) = 'IsIce' - gas_scheme_fields(19) = 'IsLand' + gas_scheme_fields(1) = 'USTAR' + gas_scheme_fields(2) = 'TSTEP' + gas_scheme_fields(3) = 'TS' + gas_scheme_fields(4) = 'SWGDN' + gas_scheme_fields(5) = 'SUNCOSmid' + gas_scheme_fields(6) = 'OBK' + gas_scheme_fields(7) = 'CLDFRC' + gas_scheme_fields(8) = 'BXHEIGHT' + gas_scheme_fields(9) = 'Z0' + gas_scheme_fields(10) = 'PS' + gas_scheme_fields(11) = 'FRLAI' + gas_scheme_fields(12) = 'ILAND' + gas_scheme_fields(13) = 'SALINITY' + gas_scheme_fields(14) = 'FRLANDUSE' + gas_scheme_fields(15) = 'TSKIN' + gas_scheme_fields(16) = 'LON' + gas_scheme_fields(17) = 'LAT' + gas_scheme_fields(18) = 'LUCNAME' + gas_scheme_fields(19) = 'IsSnow' + gas_scheme_fields(20) = 'IsIce' + gas_scheme_fields(21) = 'IsLand' case default gas_scheme_count = 0 allocate(gas_scheme_fields(0)) @@ -1052,36 +1053,39 @@ function get_required_met_fields(this) result(field_names) ! Get aerosol scheme fields select case (trim(this%process_config%drydep_config%aero_scheme)) case ('gocart') - aero_scheme_count = 12 + aero_scheme_count = 13 allocate(aero_scheme_fields(aero_scheme_count)) - aero_scheme_fields(1) = 'NLEVS' - aero_scheme_fields(2) = 'T' - aero_scheme_fields(3) = 'AIRDEN' - aero_scheme_fields(4) = 'ZMID' - aero_scheme_fields(5) = 'LWI' - aero_scheme_fields(6) = 'PBLH' - aero_scheme_fields(7) = 'HFLUX' - aero_scheme_fields(8) = 'Z0H' - aero_scheme_fields(9) = 'U10M' - aero_scheme_fields(10) = 'V10M' - aero_scheme_fields(11) = 'FRLAKE' - aero_scheme_fields(12) = 'GWETTOP' + aero_scheme_fields(1) = 'USTAR' + aero_scheme_fields(2) = 'TSTEP' + aero_scheme_fields(3) = 'T' + aero_scheme_fields(4) = 'AIRDEN' + aero_scheme_fields(5) = 'Z' + aero_scheme_fields(6) = 'LWI' + aero_scheme_fields(7) = 'PBLH' + aero_scheme_fields(8) = 'HFLUX' + aero_scheme_fields(9) = 'Z0H' + aero_scheme_fields(10) = 'U10M' + aero_scheme_fields(11) = 'V10M' + aero_scheme_fields(12) = 'FRLAKE' + aero_scheme_fields(13) = 'GWETTOP' case ('zhang') - aero_scheme_count = 13 + aero_scheme_count = 15 allocate(aero_scheme_fields(aero_scheme_count)) - aero_scheme_fields(1) = 'TS' - aero_scheme_fields(2) = 'OBK' - aero_scheme_fields(3) = 'BXHEIGHT' - aero_scheme_fields(4) = 'Z0' - aero_scheme_fields(5) = 'RH' - aero_scheme_fields(6) = 'PS' - aero_scheme_fields(7) = 'U10M' - aero_scheme_fields(8) = 'V10M' - aero_scheme_fields(9) = 'FRLANDUSE' - aero_scheme_fields(10) = 'ILAND' - aero_scheme_fields(11) = 'LUCNAME' - aero_scheme_fields(12) = 'IsSnow' - aero_scheme_fields(13) = 'IsIce' + aero_scheme_fields(1) = 'USTAR' + aero_scheme_fields(2) = 'TSTEP' + aero_scheme_fields(3) = 'TS' + aero_scheme_fields(4) = 'OBK' + aero_scheme_fields(5) = 'BXHEIGHT' + aero_scheme_fields(6) = 'Z0' + aero_scheme_fields(7) = 'RH' + aero_scheme_fields(8) = 'PS' + aero_scheme_fields(9) = 'U10M' + aero_scheme_fields(10) = 'V10M' + aero_scheme_fields(11) = 'FRLANDUSE' + aero_scheme_fields(12) = 'ILAND' + aero_scheme_fields(13) = 'LUCNAME' + aero_scheme_fields(14) = 'IsSnow' + aero_scheme_fields(15) = 'IsIce' case default aero_scheme_count = 0 allocate(aero_scheme_fields(0)) @@ -1144,7 +1148,7 @@ end function get_required_met_fields !> Get required diagnostic fields for this process function get_required_diagnostic_fields(this) result(field_names) class(ProcessDryDepInterface), intent(in) :: this - character(len=32), allocatable :: field_names(:) + character(len=64), allocatable :: field_names(:) allocate(field_names(2)) field_names(1) = 'drydep_con_per_species' @@ -1164,7 +1168,6 @@ subroutine register_and_allocate_diagnostics(this, container, rc) type(DiagnosticManagerType), pointer :: diag_mgr type(DiagnosticRegistryType), pointer :: registry type(GridManagerType), pointer :: grid_mgr - character(len=32) :: selected_scheme character(len=256) :: field_name ! For constructing species-specific field names integer :: i ! Loop variable for diagnostic species integer :: nx, ny, nz @@ -1200,7 +1203,7 @@ subroutine register_and_allocate_diagnostics(this, container, rc) dims_3d_species = [nx, ny, n_species] ! Register drydep_con_per_species - ! Register individual 2D fields for each diagnostic species + ! Register individual 2D fields for each diagnostic species (species-only diagnostics) if (this%process_config%drydep_config%n_diagnostic_species > 0) then do i = 1, this%process_config%drydep_config%n_diagnostic_species write(field_name, '(A,A,A)') 'drydep_con_', & @@ -1215,7 +1218,7 @@ subroutine register_and_allocate_diagnostics(this, container, rc) if (rc /= CC_SUCCESS) return ! Register drydep_velocity_per_species - ! Register individual 2D fields for each diagnostic species + ! Register individual 2D fields for each diagnostic species (species-only diagnostics) if (this%process_config%drydep_config%n_diagnostic_species > 0) then do i = 1, this%process_config%drydep_config%n_diagnostic_species write(field_name, '(A,A,A)') 'drydep_velocity_', & @@ -1233,8 +1236,7 @@ subroutine register_and_allocate_diagnostics(this, container, rc) ! For gas/aero differentiated processes, register diagnostics from both schemes ! Track registered diagnostics to avoid duplicates ! Register gas scheme diagnostics - selected_scheme = trim(this%process_config%drydep_config%gas_scheme) - select case (selected_scheme) + select case (trim(this%process_config%drydep_config%gas_scheme)) case ('wesely') ! Register wesely-specific diagnostics (gas) case default @@ -1242,8 +1244,7 @@ subroutine register_and_allocate_diagnostics(this, container, rc) end select ! Register aerosol scheme diagnostics (only if not already registered) - selected_scheme = trim(this%process_config%drydep_config%aero_scheme) - select case (selected_scheme) + select case (trim(this%process_config%drydep_config%aero_scheme)) case ('gocart') ! Register gocart-specific diagnostics (aerosol) case ('zhang') @@ -1317,7 +1318,7 @@ subroutine calculate_and_update_diagnostics(this, column, container, rc) call column%get_position(i_col, j_col) ! Update common diagnostic fields (used by all schemes) - ! Update individual species diagnostic fields + ! Update individual species diagnostic fields (species-only diagnostics) if (this%process_config%drydep_config%n_diagnostic_species > 0) then do i = 1, this%process_config%drydep_config%n_diagnostic_species write(field_name, '(A,A,A)') 'drydep_con_', & @@ -1328,7 +1329,7 @@ subroutine calculate_and_update_diagnostics(this, column, container, rc) if (rc /= CC_SUCCESS) return end do end if - ! Update individual species diagnostic fields + ! Update individual species diagnostic fields (species-only diagnostics) if (this%process_config%drydep_config%n_diagnostic_species > 0) then do i = 1, this%process_config%drydep_config%n_diagnostic_species write(field_name, '(A,A,A)') 'drydep_velocity_', & diff --git a/src/process/drydep/examples/drydep_config.yaml b/src/process/drydep/examples/drydep_config.yaml index 38661a7d..e793b2e4 100644 --- a/src/process/drydep/examples/drydep_config.yaml +++ b/src/process/drydep/examples/drydep_config.yaml @@ -1,5 +1,5 @@ # Example configuration for drydep process -# Generated on: 2025-11-14T22:58:26.818412 +# Generated on: 2025-11-25T22:20:02.567378 # Author: Wei Li process: @@ -32,6 +32,8 @@ schemes: # Required meteorological fields for this scheme required_met_fields: + - "USTAR" + - "TSTEP" - "TS" - "SWGDN" - "SUNCOSmid" @@ -67,10 +69,11 @@ schemes: # Required meteorological fields for this scheme required_met_fields: - - "NLEVS" + - "USTAR" + - "TSTEP" - "T" - "AIRDEN" - - "ZMID" + - "Z" - "LWI" - "PBLH" - "HFLUX" @@ -94,6 +97,8 @@ schemes: # Required meteorological fields for this scheme required_met_fields: + - "USTAR" + - "TSTEP" - "TS" - "OBK" - "BXHEIGHT" diff --git a/src/process/drydep/examples/drydep_example.F90 b/src/process/drydep/examples/drydep_example.F90 index 91729948..7e76d332 100644 --- a/src/process/drydep/examples/drydep_example.F90 +++ b/src/process/drydep/examples/drydep_example.F90 @@ -4,7 +4,7 @@ !! This program demonstrates how to use the drydep process !! in a standalone application or host model integration. !! -!! Generated on: 2025-11-14T22:58:26.798112 +!! Generated on: 2025-11-25T22:20:02.555883 !! Author: Wei Li program drydep_example @@ -195,10 +195,6 @@ subroutine setup_meteorological_fields(state_manager, error_handler) type(ErrorHandler), intent(inout) :: error_handler ! Add required meteorological fields - call state_manager%add_met_field('USTAR', error_handler) - if (error_handler%has_error()) return - call state_manager%add_met_field('TSTEP', error_handler) - if (error_handler%has_error()) return ! Add optional meteorological fields @@ -223,12 +219,6 @@ subroutine initialize_test_meteorology(state_manager, error_handler) latitude = 45.0_fp + real(i_col - 1, fp) * 1.0_fp ! Latitude longitude = -120.0_fp + real(i_col - 1, fp) * 1.0_fp ! Longitude - call state_manager%set_met_field('USTAR', i_col, i_lev, & - 1.0_fp, error_handler) ! Default value - if (error_handler%has_error()) return - call state_manager%set_met_field('TSTEP', i_col, i_lev, & - 1.0_fp, error_handler) ! Default value - if (error_handler%has_error()) return end do end do diff --git a/src/process/drydep/schemes/CMakeLists.txt b/src/process/drydep/schemes/CMakeLists.txt index dc19487e..e6d2afbc 100644 --- a/src/process/drydep/schemes/CMakeLists.txt +++ b/src/process/drydep/schemes/CMakeLists.txt @@ -1,5 +1,5 @@ # DryDep Schemes CMakeLists.txt -# Generated on: 2025-11-14T22:58:26.616033 +# Generated on: 2025-11-25T22:20:02.442271 # This file is included by the parent CMakeLists.txt # Schemes are built as part of the main process library @@ -13,6 +13,8 @@ # WESELY scheme configuration # Required meteorological fields for WESELY: +# - USTAR +# - TSTEP # - TS # - SWGDN # - SUNCOSmid @@ -35,10 +37,11 @@ # GOCART scheme configuration # Required meteorological fields for GOCART: -# - NLEVS +# - USTAR +# - TSTEP # - T # - AIRDEN -# - ZMID +# - Z # - LWI # - PBLH # - HFLUX @@ -50,6 +53,8 @@ # ZHANG scheme configuration # Required meteorological fields for ZHANG: +# - USTAR +# - TSTEP # - TS # - OBK # - BXHEIGHT diff --git a/src/process/drydep/schemes/DryDepScheme_GOCART_Mod.F90 b/src/process/drydep/schemes/DryDepScheme_GOCART_Mod.F90 index c7a7fa61..870d41c9 100644 --- a/src/process/drydep/schemes/DryDepScheme_GOCART_Mod.F90 +++ b/src/process/drydep/schemes/DryDepScheme_GOCART_Mod.F90 @@ -19,12 +19,17 @@ !! !! Generated on: 2025-11-14T22:58:26.525574 !! Author: Wei Li & Lacey Holland -!! Reference: Allison et al. [2024] Benchmarking GOCART-2G in GEOS +!! Reference: Benchmarking GOCART-2G in the Goddard Earth Observing System (GEOS) +!! Allison B. Collow, Peter R. Colarco, Arlindo M. da Silva, Virginie Buchard, +!! Huisheng Bian, M Chin, Sampa Das, Ravi Govindaraju, Dongchul Kim, and Valentina Aquila, +!! Geosci. Model Development, 17, 14431468, 2024 +!! https://doi.org/10.5194/gmd-17-1443-2024 module DryDepScheme_GOCART_Mod use precision_mod, only: fp use DryDepCommon_Mod, only: DryDepSchemeGOCARTConfig - use Constants, only: PI !load the constants needed for this scheme + use error_mod, only: CC_SUCCESS, CC_Error + use Constants, only: Cp, g0, VON_KARMAN !load the constants needed for this scheme implicit none private @@ -33,8 +38,7 @@ module DryDepScheme_GOCART_Mod public :: compute_gocart ! Additional physical constants (modify as needed for your scheme) - real(fp), parameter :: T_STANDARD = 303.15_fp ! Standard reference temperature [K] - real(fp), parameter :: DEFAULT_SCALING = 1.0e-9_fp ! Default emission scaling factor + real(fp), parameter :: OCEAN=0.0, LAND = 1.0, SEA_ICE = 2.0 contains @@ -52,7 +56,6 @@ module DryDepScheme_GOCART_Mod !! @param[in] gwettop GWETTOP field [appropriate units] !! @param[in] hflux HFLUX field [appropriate units] !! @param[in] lwi LWI field [appropriate units] - !! @param[in] nlevs NLEVS field [appropriate units] !! @param[in] pblh PBLH field [appropriate units] !! @param[in] t T field [appropriate units] !! @param[in] tstep Time step [s] - retrieved from process interface @@ -60,13 +63,17 @@ module DryDepScheme_GOCART_Mod !! @param[in] ustar USTAR field [appropriate units] !! @param[in] v10m V10M field [appropriate units] !! @param[in] z0h Z0H field [appropriate units] - !! @param[in] zmid ZMID field [appropriate units] + !! @param[in] z Z field [appropriate units] + !! @param[in] species_density Species density property + !! @param[in] species_radius Species radius property + !! @param[in] species_is_seasalt Species is_seasalt property !! @param[in] species_conc Species concentrations [mol/mol] (num_layers, num_species) !! @param[inout] species_tendencies Species tendency terms [mol/mol/s] (num_layers, num_species) !! @param[inout] drydep_con_per_species Dry deposition concentration per species [ug/kg or ppm] (num_species) !! @param[inout] drydep_velocity_per_species Dry deposition velocity [m/s] (num_species) !! @param[in] diagnostic_species_id Indices mapping diagnostic species to species array (optional, for per-species diagnostics) - pure subroutine compute_gocart( & + + subroutine compute_gocart( & num_layers, & num_species, & params, & @@ -75,17 +82,17 @@ pure subroutine compute_gocart( & gwettop, & hflux, & lwi, & - nlevs, & pblh, & t, & tstep, & u10m, & ustar, & v10m, & + z, & z0h, & - zmid, & species_density, & species_radius, & + species_is_seasalt, & species_conc, & species_tendencies, & is_gas, & @@ -94,6 +101,8 @@ pure subroutine compute_gocart( & diagnostic_species_id & ) + ! Uses + USE GOCART2G_Process, only: DryDeposition ! Arguments integer, intent(in) :: num_layers integer, intent(in) :: num_species @@ -103,7 +112,6 @@ pure subroutine compute_gocart( & real(fp), intent(in) :: gwettop ! Surface field - scalar real(fp), intent(in) :: hflux ! Surface field - scalar integer, intent(in) :: lwi ! Surface field - scalar - real(fp), intent(in) :: nlevs ! Surface field - scalar real(fp), intent(in) :: pblh ! Surface field - scalar real(fp), intent(in) :: t(num_layers) ! 3D atmospheric field real(fp), intent(in) :: tstep ! Time step [s] - from process interface @@ -111,9 +119,10 @@ pure subroutine compute_gocart( & real(fp), intent(in) :: ustar ! Surface field - scalar real(fp), intent(in) :: v10m ! Surface field - scalar real(fp), intent(in) :: z0h ! Surface field - scalar - real(fp), intent(in) :: zmid(num_layers) ! 3D atmospheric field + real(fp), intent(in) :: z(num_layers+1) ! 3D atmospheric field real(fp), intent(in) :: species_density(num_species) ! Species density property real(fp), intent(in) :: species_radius(num_species) ! Species radius property + logical, intent(in) :: species_is_seasalt(num_species) ! Species is seasalt property real(fp), intent(in) :: species_conc(num_layers, num_species) real(fp), intent(inout) :: species_tendencies(num_layers, num_species) logical, intent(in) :: is_gas(num_species) ! Species type flags (true=gas, false=aerosol) @@ -122,88 +131,94 @@ pure subroutine compute_gocart( & integer, intent(in), optional :: diagnostic_species_id(:) ! Indices mapping diagnostic species to species array ! Local variables - integer :: k, species_idx + integer :: rc, k, species_idx integer :: diag_idx ! For diagnostic species indexing - real(fp) :: base_emission_factor - real(fp) :: environmental_factor - real(fp) :: species_factor + real(fp) :: VD + real(fp) :: drydepf(1,1) + ! Local Variables + real(fp), pointer :: GOCART_tmpu(:,:,:) + real(fp), pointer :: GOCART_rhoa(:,:,:) + real(fp), pointer :: GOCART_HGHTE(:,:,:) + real(fp), pointer :: GOCART_LWI(:,:) + real(fp), pointer :: GOCART_USTAR(:,:) + real(fp), pointer :: GOCART_PBLH(:,:) + + real(fp), pointer :: GOCART_HFLUX(:,:) + real(fp), pointer :: GOCART_Z0H(:,:) + real(fp), pointer :: GOCART_U10(:,:) + real(fp), pointer :: GOCART_V10(:,:) + real(fp), pointer :: GOCART_FRACLAKE(:,:) + real(fp), pointer :: GOCART_GWETTOP(:,:) + + character(len=256) :: errMsg + character(len=256) :: thisLoc + + ! Initialize + errMsg = '' + thisLoc = ' -> at compute_gocart (in DryDepScheme_GOCART_Mod.F90)' + RC = CC_SUCCESS + VD = 0.0_fp + drydepf = 0.0_fp ! Note: species_tendencies and diagnostic arrays are already initialized ! by the host ProcessInterface before calling this subroutine. ! Do not re-initialize them here. + ! transform data for GOCART DryDeposition call + call PrepMetVarsForGOCART(num_layers, & + t, & + airden, & + z, & + u10m, & + v10m, & + frlake, & + gwettop, & + lwi, & + ustar, & + pblh, & + hflux, & + z0h, & + GOCART_tmpu, & + GOCART_RHOA, & + GOCART_HGHTE, & + GOCART_U10, & + GOCART_V10, & + GOCART_FRACLAKE, & + GOCART_GWETTOP, & + GOCART_LWI, & + GOCART_USTAR, & + GOCART_PBLH, & + GOCART_HFLUX, & + GOCART_Z0H) + ! Main computation loop - CUSTOMIZE THIS SECTION FOR YOUR SCHEME do k = 1, num_layers - ! TODO: Replace this generic implementation with your scheme's algorithm - ! This is a placeholder that demonstrates the expected structure - - ! Initialize environmental factors - environmental_factor = 1.0_fp - - ! Apply scheme-specific environmental responses based on meteorological fields - ! Generic field usage (customize for your scheme) - ! TODO: Consider how AIRDEN affects your emissions - ! environmental_factor = environmental_factor * some_function(airden(k)) - ! Generic field usage (customize for your scheme) - ! TODO: Consider how FRLAKE affects your emissions - ! environmental_factor = environmental_factor * some_function(frlake(k)) - ! Generic field usage (customize for your scheme) - ! TODO: Consider how GWETTOP affects your emissions - ! environmental_factor = environmental_factor * some_function(gwettop(k)) - ! Generic field usage (customize for your scheme) - ! TODO: Consider how HFLUX affects your emissions - ! environmental_factor = environmental_factor * some_function(hflux(k)) - ! Generic field usage (customize for your scheme) - ! TODO: Consider how LWI affects your emissions - ! environmental_factor = environmental_factor * some_function(lwi(k)) - ! Generic field usage (customize for your scheme) - ! TODO: Consider how NLEVS affects your emissions - ! environmental_factor = environmental_factor * some_function(nlevs(k)) - ! Generic field usage (customize for your scheme) - ! TODO: Consider how PBLH affects your emissions - ! environmental_factor = environmental_factor * some_function(pblh(k)) - ! Generic field usage (customize for your scheme) - ! TODO: Consider how T affects your emissions - ! environmental_factor = environmental_factor * some_function(t(k)) - ! Generic field usage (customize for your scheme) - ! TODO: Consider how TSTEP affects your emissions - ! environmental_factor = environmental_factor * some_function(tstep(k)) - ! Generic field usage (customize for your scheme) - ! TODO: Consider how U10M affects your emissions - ! environmental_factor = environmental_factor * some_function(u10m(k)) - ! Generic field usage (customize for your scheme) - ! TODO: Consider how USTAR affects your emissions - ! environmental_factor = environmental_factor * some_function(ustar(k)) - ! Generic field usage (customize for your scheme) - ! TODO: Consider how V10M affects your emissions - ! environmental_factor = environmental_factor * some_function(v10m(k)) - ! Generic field usage (customize for your scheme) - ! TODO: Consider how Z0H affects your emissions - ! environmental_factor = environmental_factor * some_function(z0h(k)) - ! Generic field usage (customize for your scheme) - ! TODO: Consider how ZMID affects your emissions - ! environmental_factor = environmental_factor * some_function(zmid(k)) - ! Apply to each species do species_idx = 1, num_species ! Skip species that don't match scheme type (gas vs aerosol) if (is_gas(species_idx)) cycle - ! Base emission factor (customize this for species-specific emissions) - base_emission_factor = DEFAULT_SCALING - ! Species-specific factor (customize based on species properties) - species_factor = 1.0_fp ! TODO: Add species-specific scaling + if (params%resuspension) then + call DryDeposition(num_layers, GOCART_TMPU, GOCART_RHOA, GOCART_HGHTE, GOCART_LWI, GOCART_USTAR, & + GOCART_PBLH, GOCART_HFLUX, von_karman, cp, g0, GOCART_Z0H, drydepf, RC, & + species_radius(species_idx)*1e-6_fp, species_density(species_idx), GOCART_U10, GOCART_V10, & + GOCART_FRACLAKE, GOCART_GWETTOP) + else + call DryDeposition(num_layers, GOCART_TMPU, GOCART_RHOA, GOCART_HGHTE, GOCART_LWI, GOCART_USTAR, & + GOCART_PBLH, GOCART_HFLUX, von_karman, cp, g0, GOCART_Z0H, drydepf, RC) + endif - ! Compute emission flux using your scheme's formula - ! This is a simple example - replace with your actual algorithm - species_tendencies(k, species_idx) = base_emission_factor * & - environmental_factor * & - species_factor * & - (1.0_fp + species_conc(k, species_idx)) + ! Ensure non-negative values + species_tendencies(k, species_idx) = max(0.0_fp, drydepf(1,1)) * params%scale_factor + !increase drydep frequency by factor of 5 for seasalt species to match GOCART2G. See the codes in: + !https://github.com/GEOS-ESM/GOCART/blob/9ff3df9545dd582f415f682d3297e8c6c841e5cb/ESMF/GOCART2G_GridComp/SS2G_GridComp/SS2G_GridCompMod.F90#L820 + if (species_is_seasalt(species_idx) .and. abs(LWI - LAND) < 0.5) then + species_tendencies(k, species_idx) = species_tendencies(k, species_idx) * 5.0_fp + end if + + VD = max(species_tendencies(k, species_idx) * (z(k+1) -z(k) ), 1.e-4_fp) - ! Ensure non-negative emissions - species_tendencies(k, species_idx) = max(0.0_fp, species_tendencies(k, species_idx)) ! TODO: Update diagnostic fields here based on your scheme's requirements ! Each process should implement custom diagnostic calculations @@ -214,7 +229,8 @@ pure subroutine compute_gocart( & do diag_idx = 1, size(diagnostic_species_id) if (diagnostic_species_id(diag_idx) == species_idx) then ! Add your custom dry deposition concentration per species calculation - drydep_con_per_species(diag_idx) = species_tendencies(k, species_idx) * 1.0_fp ! TODO: Replace with actual calculation + drydep_con_per_species(diag_idx) = & + MAX(0.0_fp, species_conc(k,species_idx) * (1.0_fp - exp(-1.0_fp * species_tendencies(k, species_idx) * tstep))) exit end if end do @@ -225,7 +241,7 @@ pure subroutine compute_gocart( & do diag_idx = 1, size(diagnostic_species_id) if (diagnostic_species_id(diag_idx) == species_idx) then ! Add your custom dry deposition velocity calculation - drydep_velocity_per_species(diag_idx) = species_tendencies(k, species_idx) * 1.0_fp ! TODO: Replace with actual calculation + drydep_velocity_per_species(diag_idx) = VD exit end if end do @@ -234,41 +250,143 @@ pure subroutine compute_gocart( & end do + !cleanup pointers + if (associated(GOCART_TMPU)) nullify(GOCART_TMPU) + if (associated(GOCART_RHOA)) nullify(GOCART_RHOA) + if (associated(GOCART_HGHTE)) nullify(GOCART_HGHTE) + if (associated(GOCART_U10)) nullify(GOCART_U10) + if (associated(GOCART_V10)) nullify(GOCART_V10) + if (associated(GOCART_FRACLAKE)) nullify(GOCART_FRACLAKE) + if (associated(GOCART_GWETTOP)) nullify(GOCART_GWETTOP) + if (associated(GOCART_LWI)) nullify(GOCART_LWI) + if (associated(GOCART_USTAR)) nullify(GOCART_USTAR) + if (associated(GOCART_LWI)) nullify(GOCART_LWI) + if (associated(GOCART_HFLUX)) nullify(GOCART_HFLUX) + if (associated(GOCART_Z0H)) nullify(GOCART_Z0H) + end subroutine compute_gocart ! ======================================================================= ! SCHEME-SPECIFIC HELPER SUBROUTINES ! ======================================================================= ! Add your custom scientific algorithms here as pure functions/subroutines - ! Examples: environmental response functions, species-specific calculations, etc. - - !> Example helper function for environmental response - pure function compute_environmental_response_gocart(met_value, reference_value) result(factor) - real(fp), intent(in) :: met_value ! Meteorological value - real(fp), intent(in) :: reference_value ! Reference value - real(fp) :: factor - - ! Simple exponential response - customize for your scheme - factor = exp((met_value - reference_value) / reference_value) - factor = max(0.0_fp, min(10.0_fp, factor)) ! Reasonable bounds - end function compute_environmental_response_gocart - - !> Example helper function for species-specific scaling - pure function compute_species_scaling_gocart(species_idx, params) result(scaling) - integer, intent(in) :: species_idx - type(DryDepSchemeGOCARTConfig), intent(in) :: params - real(fp) :: scaling - - ! Species-specific scaling - customize for your scheme - select case (species_idx) - case (1) - scaling = 1.0_fp ! First species baseline - case (2:3) - scaling = 0.5_fp ! Reduced emission for species 2-3 - case default - scaling = 0.1_fp ! Low emission for other species - end select - - end function compute_species_scaling_gocart + + !> + !! \brief PrepMetVarsForGOCART - Prep the meteorological variables for GOCART DryDeposition scheme + !! + !! \param [INOUT] metstate + !! \param [INOUT] tmpu + !! \param [INOUT] rhoa + !! \param [INOUT] hghte + !! \param [INOUT] oro + !! \param [INOUT] ustar + !! \param [INOUT] pblh + !! \param [INOUT] shflux + !! \param [INOUT] z0h + !! \param [INOUT] u10m + !! \param [INOUT] v10m + !! \param [INOUT] fraclake + !! \param [INOUT] gwettop + !! \param [OUT] rc + !! + !! \ingroup core_modules + !!!> + subroutine PrepMetVarsForGOCART(km, & + tmpu, & + rhoa, & + hghte, & + u10m, & + v10m, & + fraclake, & + gwettop, & + lwi, & + ustar, & + pblh, & + hflux, & + z0h, & + GOCART_tmpu, & + GOCART_RHOA, & + GOCART_HGHTE, & + GOCART_U10, & + GOCART_V10, & + GOCART_FRACLAKE, & + GOCART_GWETTOP, & + GOCART_LWI, & + GOCART_USTAR, & + GOCART_PBLH, & + GOCART_HFLUX, & + GOCART_Z0H) + + + + IMPLICIT NONE + + ! INPUTS + INTEGER, intent(in) :: km ! number of vertical levels + INTEGER, intent(in) :: lwi ! orography flag; Land, ocean, ice mask + REAL(fp), intent(in), DIMENSION(:), target :: tmpu ! Temperature [K] + REAL(fp), intent(in), DIMENSION(:), target :: rhoa ! Air density [kg/m^3] + REAL(fp), intent(in), DIMENSION(:), target :: hghte ! Height [m] + REAL(fp), intent(in), target :: ustar ! friction speed [m/sec] + REAL(fp), intent(in), target :: pblh ! PBL height [m] + REAL(fp), intent(in), target :: hflux ! sfc. sens. heat flux [W m-2] + REAL(fp), intent(in), target :: z0h ! rough height, sens. heat [m] + REAL(fp), intent(in), target :: u10m ! 10-m u-wind component [m/sec] + REAL(fp), intent(in), target :: v10m ! 10-m v-wind component [m/sec] + REAL(fp), intent(in), target :: fraclake ! fraction covered by water [1] + REAL(fp), intent(in), target :: gwettop ! fraction soil moisture [1] + + ! INPUT/OUTPUTS + REAL(fp), intent(inout), pointer :: GOCART_TMPU(:,:,:) !< temperature [K] + REAL(fp), intent(inout), pointer, DIMENSION(:,:,:) :: GOCART_RHOA !< air density [kg/m^3] + REAL(fp), intent(inout), pointer, DIMENSION(:,:,:) :: GOCART_HGHTE !< geometric height [m] + REAL(fp), intent(inout), pointer :: GOCART_U10(:,:) !< 10-m u-wind component [m/sec] + REAL(fp), intent(inout), pointer :: GOCART_V10 (:,:) !< 10-m v-wind component [m/sec] + REAL(fp), intent(inout), pointer :: GOCART_FRACLAKE(:,:) !< fraction covered by water [1] + REAL(fp), intent(inout), pointer :: GOCART_GWETTOP(:,:) !< fraction soil moisture [1] + real(fp), intent(inout), pointer :: GOCART_LWI(:,:) !< orography flag; Land, ocean, ice mask + REAL(fp), intent(inout), pointer :: GOCART_USTAR(:,:) !< friction speed [m/sec] + REAL(fp), intent(inout), pointer :: GOCART_PBLH(:,:) !< PBL height [m] + REAL(fp), intent(inout), pointer :: GOCART_HFLUX(:,:) !< sfc. sens. heat flux [W m-2] + REAL(fp), intent(inout), pointer :: GOCART_Z0H(:,:) !< rough height, sens. heat [m] + + ! OUTPUTS - Add error handling back in late + !INTEGER :: rc !< Return code + + ! Error handling + !character(len=255) :: thisloc + + allocate(GOCART_TMPU(1, 1, km)) + allocate(GOCART_RHOA(1, 1, km)) + allocate(GOCART_HGHTE(1, 1, 0:km)) + allocate(GOCART_U10(1, 1)) + allocate(GOCART_V10(1, 1)) + allocate(GOCART_FRACLAKE(1, 1)) + allocate(GOCART_GWETTOP(1, 1)) + allocate(GOCART_LWI(1, 1)) + allocate(GOCART_USTAR(1, 1)) + allocate(GOCART_PBLH(1, 1)) + allocate(GOCART_HFLUX(1, 1)) + allocate(GOCART_Z0H(1, 1)) + + !Note: GOCART scheme expects vertical levels in reverse order (top to bottom) + + GOCART_TMPU(1,1,:) = tmpu(size(tmpu):1:-1) ! temperature [K] + GOCART_RHOA(1,1,:) = rhoa(size(rhoa):1:-1) ! air density [kg/m^3] + GOCART_HGHTE(1,1,:) = hghte(size(hghte):1:-1) ! top of layer geopotential height [m] + GOCART_LWI = real(LWI, fp) ! orography flag; Land, ocean, ice mask + GOCART_USTAR = ustar + + ! friction speed [m/sec] + GOCART_PBLH = pblh ! PBL height [m] + GOCART_HFLUX = hflux ! sfc. sens. heat flux [W m-2] + GOCART_Z0H = z0h ! rough height, sens. heat [m] + GOCART_U10 = u10m ! zonal wind component (E/W) [m/s] + GOCART_V10 = v10m ! meridional wind component (N/S) [m/s] + GOCART_FRACLAKE = fraclake ! unitless, lake fraction (0-1) + GOCART_GWETTOP = gwettop ! unitless, soil moisture fraction (0-1) + + + end subroutine PrepMetVarsForGOCART end module DryDepScheme_GOCART_Mod diff --git a/src/process/drydep/schemes/DryDepScheme_WESELY_Mod copy.F90 b/src/process/drydep/schemes/DryDepScheme_WESELY_Mod copy.F90 deleted file mode 100644 index 219970bc..00000000 --- a/src/process/drydep/schemes/DryDepScheme_WESELY_Mod copy.F90 +++ /dev/null @@ -1,1388 +0,0 @@ -!> \file DryDepScheme_WESELY_Mod.F90 -!! \brief Wesely 1989 gas dry deposition scheme -!! -!! Pure science kernel for wesely scheme in drydep process. -!! This module contains ONLY the computational algorithm with NO infrastructure dependencies. -!! Uses only basic Fortran types for maximum portability and reusability. -!! -!! SCIENCE CUSTOMIZATION GUIDE: -!! 1. Modify the algorithm in compute_wesely (search for "TODO") -!! 2. Add scheme-specific helper subroutines as needed -!! 3. Update physical constants for your scheme -!! 4. Customize the environmental response functions -!! -!! INFRASTRUCTURE RESPONSIBILITIES (handled by host model): -!! - Parameter initialization and validation -!! - Input array validation and error handling -!! - Memory management and array allocation -!! - Integration with host model time stepping -!! -!! Generated on: 2025-11-13T14:35:43.237148 -!! Author: Wei Li -!! Reference: Wesely, M. L. [1989] Parameterization of surface resistances to gaseous dry deposition... -module DryDepScheme_WESELY_Mod - - use precision_mod, only: fp, rae - use error_mod, only: CC_SUCCESS, CC_Error - use DryDepCommon_Mod, only: DryDepSchemeWESELYConfig - use Constants, only: PI, H2OMW, AVO, VON_KARMAN, RSTARG !load the constants needed for this scheme - - implicit none - private - - ! Public interface - pure science only - public :: compute_wesely - - ! module variables (mainly some constants dependent on land use in the scheme) - integer, parameter :: NDRYDTYPE = 11 !< # of drydep land types following GEOS-Chem - real(fp), parameter :: TWO_THIRDS = 2.0_fp / 3.0_fp - !real(fp), parameter :: H2OMW = 18.0_fp !declared in constant module - real(fp), parameter :: SMALL = 1.0e-10_fp !< Small number - integer, parameter :: IWATER = 1 !< Index for water in Olson land use - ! Arrays that hold information for each of the 11 drydep land types - integer :: IDRYDTYPE(NDRYDTYPE) - real(fp) :: IRAC(NDRYDTYPE), IRCLO(NDRYDTYPE), IRCLS(NDRYDTYPE) - real(fp) :: IRGSS(NDRYDTYPE), IRGSO(NDRYDTYPE), IRLU(NDRYDTYPE) - real(fp) :: IRI(NDRYDTYPE), IVSMAX(NDRYDTYPE) - !some Olson land use (74 types) related parameters - real(fp):: DRYCOEFF(20) !< DRYCOEFF : Baldocchi polynomial coeffs - integer :: IOLSON (74), IDEP_IOLSON(74) - integer :: IDEP_NOAH(20), IDEP_IGBP(17) - !integer :: IZO(74) !< Roughness height for each Olson land types - - !assign some drydep values to arrays based on the 11 drydep land use in GEOS-Chem. - !Wesely (1989) is separated into seasons, but not sure how GEOS-Chem gets its values (TODO). - !You can find the values and references in https://wiki.seas.harvard.edu/geos-chem/index.php/Dry_deposition - !*********************************************************************** - !* The land types within each grid square are defined using the Olson - !* land-type database. Each of the Olson land types is assigned a - !* corresponding "deposition land type" with characteristic values of - !* surface resistance components. There are 74 Olson land-types but only - !* 11 deposition land-types (i.e., many of the Olson land types share the - !* same deposition characteristics). Surface resistance components for - !* the "deposition land types" are from Wesely [1989] except for tropical - !* forests [Jacob and Wofsy, 1990] and for tundra [Jacob et al., 1992]. - !* All surface resistance components are normalized to a leaf area index - !* of unity. - !* - !* Olson land types, deposition land types, and surface resistance - !* components are read from file 'Olson_2001_Drydep_Inputs.nc'; check that file for - !* further details. - !*********************************************************************** - - ! (1) (2) (3) (4) (5) (6) (7) (8) (9) (10) (11) - ! snow/ice deciduous coniferous agricultural shub/ Amozaon tundra Desert wetland urban water - ! forest forest land grassland forest - ! Note IRI(3) = 200 is hardcoded and not the same as in the file. - DATA IRI /9999, 200, 200, 200, 200, 200, 200, 9999, 200, 9999, 9999/ - DATA IRLU /9999, 9000, 9000, 9000, 9000, 1000, 4000, 9999, 9000, 9999, 9999/ - DATA IRAC / 0, 2000, 2000, 200, 100, 2000, 0, 0, 300, 100, 0/ - DATA IRGSS / 100, 500, 500, 150, 350, 200, 340, 1000, 0, 400, 0/ - DATA IRGSO /3500, 200, 200, 150, 200, 200, 340, 400, 1000, 300, 2000/ - DATA IRCLS /9999, 2000, 2000, 2000, 2000, 9999, 9999, 9999, 2500, 9999, 9999/ - DATA IRCLO /1000, 1000, 1000, 1000, 1000, 9999, 9999, 9999, 1000, 9999, 9999/ - DATA IVSMAX /100, 100, 100, 100, 100, 100, 100, 10, 100, 100, 10/ - DATA IDRYDTYPE /1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11/ - ! Olson land use related parameters (https://wiki.seas.harvard.edu/geos-chem/index.php/Olson_land_map) - DATA IOLSON /1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, & - 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, 47, 48, 49, 50, 51, 52, & - 53, 54, 55, 56, 57, 58, 59, 60, 61, 62, 63, 64, 65, 66, 67, 68, 69, 70, 71, 72, 73, 74/ - DATA IDEP_IOLSON / 11,10, 5, 3, 3, 2, 2, 5, 8, 7, 5, 8, 1, 9, 11, 11, 5, 5, 5, 2, 6, 3, 3, 2, 2, 2, 2, & - 3, 6, 6, 4, 4, 2, 6, 2, 4, 9, 4, 4, 4, 5, 5, 5, 2, 5, 9, 5, 5, 2, 8, 8, 5, & - 5, 7, 2, 4, 2, 2, 2, 5, 2, 2, 3, 5, 5, 9, 9, 9, 9, 8, 8, 8, 9, 11/ - DATA IDEP_NOAH / 3, 6, 3, 2, 2, 5, 5, 2, 5, 5, 9, 4, 10, 5, 1, 8, 11, 7, 7, 7 / - DATA IDEP_IGBP / 3, 6, 3, 2, 2, 5, 5, 2, 5, 5, 9, 4, 10, 5, 1, 8, 11 / !same as NOAH without the last three tundra types - !roughness height is not used now and is read from MET directly; so comment out - !DATA IZO / 10, 25000, 100, 10000, 10000, 10000, 10000, 100, 10, 2000, 100, 10, 1, 100, 1000, 1000, 1000, 100, 100, 2000, & - ! 10000, 10000,10000, 10000, 10000, 10000, 10000,10000,1000,10000,1000,1000,2000,10000,10000, 1000, 100, 1000, 1000,1000, & - ! 100, 100, 100, 2000, 100, 100, 1000, 1000, 1000, 1000,1000, 50, 50, 50, 2000, 2000, 2000, 2000, 1000, 100, & - ! 2000, 2000, 10000, 2000, 1000, 1000, 1000, 1000, 1000, 10, 1000,1000,500, 100 / - ! Baldocchi polynomial coeffs - DATA DRYCOEFF /-0.358_fp, 3.02_fp, 3.85_fp, -0.0978_fp, -3.66_fp, 12_fp, 0.252_fp, -7.8_fp, 0.226_fp, 0.274_fp, & - 1.14_fp, -2.19_fp, 0.261_fp, -4.62_fp, 0.685_fp, -0.254_fp, 4.37_fp, -0.266_fp, -0.159_fp, -0.206_fp / - -contains - - !> Pure science computation for wesely scheme - !! - !! This is a pure computational kernel implementing Wesely 1989 gas dry deposition scheme. - !! NO error checking, validation, or infrastructure concerns. - !! Host model must ensure all inputs are valid before calling. - !! - !! @param[in] num_layers Number of vertical layers - !! @param[in] num_species Number of chemical species - !! @param[in] params Scheme parameters (pre-validated by host) - !! @param[in] bxheight BXHEIGHT field [appropriate units] - !! @param[in] cldfrc CLDFRC field [appropriate units] - !! @param[in] frlai FRLAI field [appropriate units] - !! @param[in] frlanduse FRLANDUSE field [appropriate units] - !! @param[in] iland ILAND field [appropriate units] - !! @param[in] isice IsIce field [appropriate units] - !! @param[in] island IsLand field [appropriate units] - !! @param[in] issnow IsSnow field [appropriate units] - !! @param[in] lat LAT field [appropriate units] - !! @param[in] lon LON field [appropriate units] - !! @param[in] lucname LUCNAME field [appropriate units] - !! @param[in] obk OBK field [appropriate units] - !! @param[in] ps PS field [appropriate units] - !! @param[in] salinity SALINITY field [appropriate units] - !! @param[in] suncosmid SUNCOSmid field [appropriate units] - !! @param[in] swgdn SWGDN field [appropriate units] - !! @param[in] ts TS field [appropriate units] - !! @param[in] tskin TSKIN field [appropriate units] - !! @param[in] tstep Time step [s] - retrieved from process interface - !! @param[in] ustar USTAR field [appropriate units] - !! @param[in] z0 Z0 field [appropriate units] - !! @param[in] species_conc Species concentrations [mol/mol] (num_layers, num_species) - !! @param[inout] species_tendencies Species tendency terms [mol/mol/s] (num_layers, num_species) - !! @param[inout] drydep_con_per_species Dry deposition concentration per species [ug/kg or ppm] (num_species) - !! @param[inout] drydep_velocity_per_species Dry deposition velocity [m/s] (num_species) - !! @param[in] diagnostic_species_id Indices mapping diagnostic species to species array (optional, for per-species diagnostics) - subroutine compute_wesely( & - num_layers, & - num_species, & - params, & - bxheight, & - cldfrc, & - frlai, & - frlanduse, & - iland, & - isice, & - island, & - issnow, & - lat, & - lon, & - lucname, & - obk, & - ps, & - salinity, & - suncosmid, & - swgdn, & - ts, & - tskin, & - tstep, & - ustar, & - z0, & - species_mw_g, & - species_dd_f0, & - species_short_name, & - species_dd_hstar, & - species_dd_DvzAerSnow, & - species_dd_DvzMinVal_snow, & - species_dd_DvzMinVal_land, & - species_conc, & - species_tendencies, & - is_gas, & - drydep_con_per_species, & - drydep_velocity_per_species, & - diagnostic_species_id & - ) - - ! Arguments - integer, intent(in) :: num_layers - integer, intent(in) :: num_species - type(DryDepSchemeWESELYConfig), intent(in) :: params - real(fp), intent(in) :: bxheight(num_layers) ! 3D atmospheric field - real(fp), intent(in) :: cldfrc ! Surface field - scalar - real(fp), intent(in) :: frlai(:) ! Categorical field - variable dimension array - real(fp), intent(in) :: frlanduse(:) ! Categorical field - variable dimension array - integer, intent(in) :: iland(:) ! Categorical field - variable dimension array - logical, intent(in) :: isice ! Surface field - scalar - logical, intent(in) :: island ! Surface field - scalar - logical, intent(in) :: issnow ! Surface field - scalar - real(fp), intent(in) :: lat ! Surface field - scalar - real(fp), intent(in) :: lon ! Surface field - scalar - character(len=255), intent(in) :: lucname ! Surface field - scalar - real(fp), intent(in) :: obk ! Surface field - scalar - real(fp), intent(in) :: ps ! Surface field - scalar - real(fp), intent(in) :: salinity ! Surface field - scalar - real(fp), intent(in) :: suncosmid ! Surface field - scalar - real(fp), intent(in) :: swgdn ! Surface field - scalar - real(fp), intent(in) :: ts ! Surface field - scalar - real(fp), intent(in) :: tskin ! Surface field - scalar - real(fp), intent(in) :: tstep ! Time step [s] - from process interface - real(fp), intent(in) :: ustar ! Surface field - scalar - real(fp), intent(in) :: z0 ! Surface field - scalar - real(fp), intent(in) :: species_mw_g(num_species) ! Species mw_g property - real(fp), intent(in) :: species_dd_f0(num_species) ! Species dd_f0 property - character(len=255), intent(in) :: species_short_name(num_species) ! Species short_name property - real(fp), intent(in) :: species_dd_hstar(num_species) ! Species dd_hstar property - real(fp), intent(in) :: species_dd_DvzAerSnow(num_species) ! Species dd_DvzAerSnow property - real(fp), intent(in) :: species_dd_DvzMinVal_snow(num_species) ! Species dd_DvzMinVal_snow property - real(fp), intent(in) :: species_dd_DvzMinVal_land(num_species) ! Species dd_DvzMinVal_land property - real(fp), intent(in) :: species_conc(num_layers, num_species) - real(fp), intent(inout) :: species_tendencies(num_layers, num_species) - logical, intent(in) :: is_gas(num_species) ! Species type flags (true=gas, false=aerosol) - real(fp), intent(inout), optional :: drydep_con_per_species(:) - real(fp), intent(inout), optional :: drydep_velocity_per_species(:) - integer, intent(in), optional :: diagnostic_species_id(:) ! Indices mapping diagnostic species to species array - - ! Local variables - integer :: rc, k, species_idx - integer :: diag_idx ! For diagnostic species indexing - real(fp) :: VD ! Dry deposition velocity - real(fp) :: DDFreq ! Dry deposition frequency - real(fp) :: XLAI_IN, C1X, RA, RB, RSURFC, VK, DVZ - real(fp) :: HSTAR, XMW, IODIDE, F0 - integer :: II !< Index of the drydep land type - integer :: ILDT !< index of the land types in the grid box - integer :: LDT !loop index of land types - character(255) :: SPC !current species name - character(len=255) :: thisLoc - character(len=512) :: ErrMsg - - ! Note: species_tendencies and diagnostic arrays are already initialized - ! by the host ProcessInterface before calling this subroutine. - ! Do not re-initialize them here. - ! Assume success - RC = CC_SUCCESS - ErrMsg = '' - ThisLoc = ' -> at compute_Wesely (in process/drydep/scheme/DryDepScheme_WESELY_Mod.F90)' - - !TODO : Placeholder for iodide concentration; zero means O3 deposition to ocean through halogen chemistry is not - !doing anything although the codes are there. If we have iodide as a species in the future, we can get its - !concentration from the species_conc array here. - IODIDE = 0.0_fp - - ! Main computation loop - CUSTOMIZE THIS SECTION FOR YOUR SCHEME - do k = 1, num_layers - - ! Apply to each species - do species_idx = 1, num_species - ! Skip species that don't match scheme type (gas vs aerosol) - if (.not. is_gas(species_idx)) cycle - ! Add option for non-local PBL mixing scheme: THIK must be the first box height. - ! TODO: we only use non-local mixing here - !IF (.NOT. LNLPBL) THIK = MAX( ZH, THIK ) - - ! Zero variables that aren't zeroed below - VD = 0.0_fp - DDFreq = 0.0_fp - DVZ = 0.0_fp - RSURFC = 0.0_fp - RA = 0.0_fp - RB = 0.0_fp - C1X = 0.0_fp - VK = 0.0_fp - XLAI_IN = 0.0_fp - - !property for current species - HSTAR = species_dd_hstar(species_idx) - XMW = species_mw_g(species_idx)*1e-3_fp !convert from g/mol to kg/mole - SPC = species_short_name(species_idx) - F0 = species_dd_f0(species_idx) - - ! Better test for depositing species: We need both HSTAR and XMW - ! to be nonzero, OR the value of AIROSOL to be true. This should - ! avoid any further floating point invalid issues caused by putting - ! a zero value in a denominator. - IF ( ( HSTAR > 0e+0_fp .and. XMW > 0e+0_fp ) ) THEN - DO LDT =1 , SIZE(frlanduse) - ! If the land type is not represented in grid - ! box, then skip to the next land type - IF ( frlanduse(LDT) <= 0 ) CYCLE - - ILDT = ILAND(LDT) - IF ( LUCNAME == 'OLSON' ) THEN - ! Olson land type index + 1 - ILDT = ILDT + 1 - ! Dry deposition land type index - II = IDEP_IOLSON(ILDT) - ELSE IF ( LUCNAME == 'NOAH' ) THEN - ! it is possible that water is given as 0 not 17 in GFS CCPP - IF (ILDT == 0) ILDT = 17 - II = IDEP_NOAH(ILDT) - ELSE IF ( LUCNAME == 'IGBP' ) THEN - ! it is possible that water is given as 0 not 17 - IF (ILDT == 0) ILDT = 17 - II = IDEP_IGBP(ILDT) - ENDIF - - !LAI of the landtype in the subgrid - !XLAI_IN = XLAI * DBLE(IUSE(LDT)) !TODO: may be able to calculate online if fraction LAI is not provided - XLAI_IN = frlai(LDT) - - !If the surface to be snow or ice;set II to 1 instead - !We do not use II index to specify directly since IS_SNOW and IS_ICE are given at each grid not subgrid as ILAND - IF( (ISSNOW) .OR. (ISICE) ) II=1 - - !get bulk surface resistances (Rs) - call Wesely_Rc_Gas( swgdn, ts, suncosmid, F0, HSTAR, XMW, ustar, cldfrc, & - ps, XLAI_IN, II, SPC, salinity, tskin, IODIDE, lon, lat, & - params%co2_effect, params%co2_level, params%co2_reference, RSURFC, RC) - - if (RC /= CC_SUCCESS ) then - errMsg = 'Error in getting bulk surface resistances (RSURFC)' - CALL CC_Error( errMsg, RC, thisLoc ) - RETURN - endif - - !*Set max and min values for bulk surface resistances - RSURFC = MAX(1.e+0_fp, MIN(RSURFC,9999.e+0_fp)) - !*because of high resistance values, different rule applied for ocean ozone - IF ( (SPC .EQ. 'O3' .OR. SPC .EQ. 'o3') & - .AND. (II .EQ. 11)) THEN - RSURFC = MAX(1.e+0_fp, MIN(RSURFC,999999.e+0_fp)) - ENDIF - ! Set Rc for strong acids (HNO3,HCl,HBr) to 1 s/m - ! Ref. Jaegle et al. 2018, cf. Erisman,van Pul,Ayers 1994 - IF ( HSTAR .gt. 1.e+10_fp ) RSURFC= 1.e+0_fp - - !get Ra and Rb - call Wesely_Ra_Rb(ts, ps, XMW, USTAR, obk, z0, bxheight(1), .TRUE., Ra, Rb, RC) - - !get VD (TODO: IUSE is decimal not percent or permille as in GEOS-Chem) - C1X = RSURFC + Ra + Rb - VK = VD - !VD = VK + DBLE( IUSE(LDT) ) / C1X !This seems to be useless in the original codes - - !VD = VK + DBLE( IUSE(LDT) ) / C1X - VD = VK + frlanduse(LDT) / C1X - - END DO - ENDIF - - !apply spectial treatment or scaling factor to Vd - DVZ = VD *100.e+0_fp !m/s -- > cm/s - - ! Scale relative to specified species(Note:we do not use FLAG but match names instead) - !TODO: We simply hardcode the scaling factor here - - !IF ( FLAG(D) .eq. 1 ) THEN - IF ((SPC .eq. 'N2O5') .or. (SPC .eq. 'HC187') .or. & - (SPC .eq. 'n2o5') .or. (SPC .eq. 'hc187') ) THEN - - ! Scale species to HNO3 (MW_g = 63.012 g/mol) - DVZ = DVZ * sqrt(63.01_fp) / sqrt( XMW*1e3_fp ) - - !ELSE IF ( FLAG(D) .eq. 2 ) THEN - ELSE IF ((SPC .eq. 'MPAN') .or. (SPC .eq. 'PPN') .or. (SPC .eq. 'R4N2') .or. & - (SPC .eq. 'mpan') .or. (SPC .eq. 'ppn') .or. (SPC .eq. 'r4n2') ) THEN - - ! Scale species to PAN (MW_g = 121.06 g/mol) - DVZ = DVZ * sqrt(121.06_fp) / sqrt( XMW*1e3_fp ) - - !ELSE IF ( FLAG(D) .eq. 3 ) THEN - ELSE IF ((SPC .eq. 'MONITS') .or. (SPC .eq. 'MONITU') .or. (SPC .eq. 'HONIT') .or. & - (SPC .eq. 'monits') .or. (SPC .eq. 'monitu') .or. (SPC .eq. 'honit') ) THEN - - ! Scale species to ISOPN (MW_g = 147.15 g/mol) - DVZ = DVZ * sqrt(147.15_fp) / sqrt(XMW*1e3_fp) - - ENDIF - - !----------------------------------------------------------- - ! Special treatment for snow and ice - !----------------------------------------------------------- - IF ( (ISSNOW) .OR. (ISICE) ) THEN - - !------------------------------------- - ! %%% SURFACE IS SNOW OR ICE %%% - !------------------------------------- - IF ( species_DD_DvzAerSnow(species_idx) > 0.0_fp ) THEN - - ! For most aerosol species (basically everything - ! except sea salt and dust species), we just set - ! the deposition velocity over snow to a fixed value - !DVZ = DBLE( DD_DvzAerSnow ) - DVZ = species_DD_DvzAerSnow(species_idx) - - ELSE - - ! Otherwise, enforce a minimum drydep velocity over snow - ! (cf. the GOCART model). NOTE: In practice this will - ! only apply to the species SO2, SO4, MSA, NH3, NH4, NIT. - !DVZ = MAX( DVZ, DBLE( DD_DvzMinVal_Snow ) ) - DVZ = MAX( DVZ, species_DD_DvzMinVal_Snow(species_idx) ) - - ENDIF - - ELSE - - !------------------------------------- - ! %%% SURFACE IS NOT SNOW OR ICE %%% - !------------------------------------- - - ! Enforce a minimum drydep velocity over land (cf. the - ! GOCART model). NOTE: In practice this will only apply - ! to the species SO2, SO4, MSA, NH3, NH4, NIT. - !DVZ = MAX( DVZ, DBLE( DD_DvzMinVal_Land ) ) - DVZ = MAX( DVZ, species_DD_DvzMinVal_Land(species_idx) ) - - ENDIF - - !----------------------------------------------------------- - ! Special treatment for ACETONE - !----------------------------------------------------------- - - ! For ACET, we need to only do drydep over the land - ! and not over the oceans. - !IF ( N == id_ACET ) THEN - IF ( (SPC == 'ACET') .or. (SPC == 'acet') ) THEN - IF ( IsLand ) THEN - DVZ = 0.1e+0_fp - ELSE - DVZ = 0e+0_fp - ENDIF - ENDIF - - !----------------------------------------------------------- - ! Special treatment for ALD2,MENO3,ETNO3,MOH - !----------------------------------------------------------- - - ! we need to only do drydep over the land - ! and not over the oceans. - !IF ( N == id_ALD2 ) THEN - IF ( (SPC == 'ALD2') .or. (SPC == 'MENO3') .or. (SPC == 'ETNO3') .or. (SPC == 'MOH') .or. & - (SPC == 'ald2') .or. (SPC == 'meno3') .or. (SPC == 'etno3') .or. (SPC == 'moh') ) THEN - IF ( .not. IsLand ) THEN - DVZ = 0e+0_fp - ENDIF - ENDIF - - !----------------------------------------------------------- - ! Compute drydep velocity and frequency - !----------------------------------------------------------- - - ! Dry deposition velocities [m/s] - VD = DVZ / 100.e+0_fp * params%scale_factor - - ! Dry deposition frequency [1/s] - DDFreq = VD / bxheight(1) - - ! Ensure non-negative emissions - species_tendencies(k, species_idx) = max(0.0_fp, DDFreq) - - ! TODO: Update diagnostic fields here based on your scheme's requirements - ! Each process should implement custom diagnostic calculations - ! Example patterns: - ! Per-species diagnostic: only update for diagnostic species - if (present(drydep_con_per_species) .and. present(diagnostic_species_id)) then - ! Find position of this species in diagnostic_species_id array - do diag_idx = 1, size(diagnostic_species_id) - if (diagnostic_species_id(diag_idx) == species_idx) then - ! Add your custom dry deposition concentration per species calculation - drydep_con_per_species(diag_idx) = & - MAX(0.0_fp, species_conc(k,species_idx) * (1.0_fp - exp(-1.0_fp * species_tendencies(k, species_idx) * tstep))) - exit - end if - end do - end if - ! Per-species diagnostic: only update for diagnostic species - if (present(drydep_velocity_per_species) .and. present(diagnostic_species_id)) then - ! Find position of this species in diagnostic_species_id array - do diag_idx = 1, size(diagnostic_species_id) - if (diagnostic_species_id(diag_idx) == species_idx) then - ! Add your custom dry deposition velocity calculation - drydep_velocity_per_species(diag_idx) = VD - exit - end if - end do - end if - end do - - end do - - end subroutine compute_wesely - - ! ======================================================================= - ! SCHEME-SPECIFIC HELPER SUBROUTINES - ! ======================================================================= - ! Add your custom scientific algorithms here as pure functions/subroutines - - !> - !! \brief Computes the bulk surface resistance (Rc) for the gas species - !! - !!References: - !! Wesely, M. L. "Parameterization of surface resistances to gaseous dry deposition in - !! regional-scale numerical models." Atmospheric environment 41 (2007): 52-63. - !! https://doi.org/10.1016/0004-6981(89)90153-4 - !! - !! \param RADIAT Solar radiation [W/m2] - !! \param TEMP Temperature [K] - !! \param SUNCOS Cosine of solar zenith angle - !! \param F0 React. factor for oxidation depends on species - !! \param HSTAR Henry's law constant depends on species - !! \param XMW Molecular weight [kg/mol] - !! \param USTAR Friction velocity [m/s] - !! \param CFRAC Surface cloud fraction - !! \param PRESSU Surface pressure [Pa] - !! \param XLAI Leaf area index - !! \param II Index of the drydep land type - !! \param SPC Species name - !! \param SALINITY Salinity of the ocean - !! \param TSKIN Skin temperature - !! \param IODIDE Iodide concentration - !! \param XLON Longitude - !! \param YLAT Latitude - !! \param CO2_EFFECT CO2 effect on RS - !! \param CO2_LEVEL CO2 level - !! \param CO2_REF CO2 reference level - !! \param RSURFC Bulk Surface resistance [s/m] - !! \param RC Success or failure? - !! - !! \ingroup catchem_drydep_process - !!!> - subroutine Wesely_Rc_Gas( RADIAT, TEMP, SUNCOS, F0, HSTAR, XMW, USTAR, CFRAC, PRESSU, & - XLAI, II, SPC, SALINITY, TSKIN, IODIDE, XLON, YLAT, & - CO2_EFFECT, CO2_LEVEL, CO2_REF, RSURFC, RC) - IMPLICIT NONE - ! Parameters - !----------- - real(fp), intent(in) :: RADIAT !< Solar radiation [W/m2] - real(fp), intent(in) :: TEMP !< Temperature [K] - real(fp), intent(in) :: SUNCOS !< Cosine of solar zenith angle - real(fp), intent(inout) :: F0 !< React. factor for oxidation depends on species (inout because it is changed in the function) - real(fp), intent(in) :: HSTAR !< Henry's law constant depends on species - real(fp), intent(in) :: XMW !< Molecular weight [kg/mol] - real(fp), intent(in) :: USTAR !< Friction velocity [m/s] - real(fp), intent(in) :: CFRAC !< Surface cloud fraction - real(fp), intent(in) :: PRESSU !< Surface pressure [Pa] - real(fp), intent(in) :: XLAI !< Leaf area index - integer, intent(in) :: II !< Index of the drydep land type - !integer, intent(in) :: N_SPC !< Species ID (TODO: may be changed to species name) - character(len=20), intent(in) :: SPC !< Species name - !some inputs are for O3 over water and Hg over Amazon forest (not sure if we should include them for now) - real(fp), intent(in) :: SALINITY !< Salinity of the ocean - real(fp), intent(in) :: TSKIN !< Skin temperature - real(fp), intent(in) :: IODIDE !< Iodide concentration - real(fp), intent(in) :: XLON !< Longitude - real(fp), intent(in) :: YLAT !< Latitude - logical, intent(in) :: CO2_EFFECT !< CO2 effect on RS - real(fp), intent(in) :: CO2_LEVEL !< CO2 level - real(fp), intent(in) :: CO2_REF !< CO2 reference level - !output - real(fp), intent(out) :: RSURFC !< Bulk Surface resistance [s/m] - integer, intent(out) :: RC !< Success or failure? - - ! Local Variables - !---------------- - real(fp) :: RI, RLU, RAC, RGSS, RGSO, RCLS, RCLO - real(fp) :: RT,RIX,GFACT,GFACI,RS_SCALE - real(fp) :: RDC,RLUXX,RGSX,DTMP1,DTMP2,DTMP3,DTMP4 - real(fp) :: XMWH2O,TEMPK,TEMPC,DEPVw,alpha0 - real(fp) :: RCLX,RIXX !,BIOFIT - !string - character(len=255) :: thisLoc - character(len=512) :: ErrMsg - - !-------------------------------------------- - ! main function - !-------------------------------------------- - - ! Assume success - RC = CC_SUCCESS - ErrMsg = '' - ThisLoc = ' -> at Wesely_Rc_Gas (in process/drydep/scheme/DryDepScheme_WESELY_Mod.F90)' - - ! Zero variables that aren't zeroed below - RSURFC = 0.0_fp - RI = 0.0_fp - RLU = 0.0_fp - RAC = 0.0_fp - RGSS = 0.0_fp - RGSO = 0.0_fp - RCLS = 0.0_fp - RCLO = 0.0_fp - RIX = 0.0_fp - GFACT = 0.0_fp - GFACI = 0.0_fp - RDC = 0.0_fp - XMWH2O = 0.0_fp - RIXX = 0.0_fp - RLUXX = 0.0_fp - RGSX = 0.0_fp - RCLX = 0.0_fp - DTMP1 = 0.0_fp - DTMP2 = 0.0_fp - DTMP3 = 0.0_fp - DTMP4 = 0.0_fp - !N_SPC = 0 - alpha0 = 0.0_fp - DEPVw = 0.0_fp - - !** TEMPK and TEMPC are surface air temperatures in K and in C - TEMPK = TEMP - TEMPC = TEMP - 273.15e+0_fp - - !* Adjust external surface resistances for temperature; - !* from Wesely [1989], expression given in text on p. 1296. - !* - !* BUG FIX! Wesely [1989] gives RT = 1000.0*EXP(-TEMPC-4.0) - !* RT = 1000.0*EXP(-(TEMPC-4.0)) - RT = 1000.0e+0_fp*EXP(-TEMPC-4.0e+0_fp) - - !If the surface to be snow or ice, set II to 1 instead. - !IF((State_Met%isSnow(I,J)).OR.(State_Met%isIce(I,J))) II=1 - - !************************************************************************ - !* Read the internal resistance RI (minimum stomatal resistance for - !* water vapor,per unit area of leaf) from the IRI array; a '9999' - !* value means no deposition to stomata so we impose a very large - !* value for RI. - ! - !* Adjust stomatal resistances for insolation and temperature: - !* Temperature adjustment is from Wesely [1989], equation (3). - !* - !* Light adjustment by the function BIOFIT is described by Wang - !* [1996]. It combines - !* - Local dependence of stomal resistance on the intensity I - !* of light impinging the leaf; this is expressed as a - !* multiplicative factor I/(I+b) to the stomatal resistance - !* where b = 50 W m-2 (equation (7) of Baldocchi et al.[1987]) - !* - radiative transfer of direct and diffuse radiation in the - !* canopy using equations (12)-(16) from Guenther et al.[1995] - !* - separate accounting of sunlit and shaded leaves using - !* equation (12) of Guenther et al. [1995] - !* - partitioning of the radiation at the top of the canopy into - !* direct and diffuse components using a parameterization to - !* results from an atmospheric radiative transfer model - !* [Wang, 1996] - !* The dependent variables of the function BIOFIT are the leaf - !* area index (XYLAI), the cosine of zenith angle (SUNCOS) and - !* the fractional cloud cover (CFRAC). The factor GFACI - !* integrates the light dependence over the canopy depth; sp even - !* though RI is input per unit area of leaf it need not be scaled - !* by LAI to yield a bulk canopy value because that's already - !* done in the GFACI formulation. - !******************************************************************** - !RI = DBLE(IRI(II)) - RI = IRI(II) - IF (RI .GE. 9999.e+0_fp) THEN - RI = 1.e+12_fp - ELSE - GFACT = 100.0e+0_fp - IF (TEMPC .GT. 0.e+0_fp .AND. TEMPC .LT. 40.e+0_fp) THEN - GFACT = 400.e+0_fp/TEMPC/(40.0e+0_fp-TEMPC) - ENDIF - - GFACI = 100.e+0_fp - IF ( RADIAT > 0.e+0_fp .and. XLAI > 0.e+0_fp ) THEN - GFACI = 1.e+0_fp / BIOFIT( DRYCOEFF, XLAI, SUNCOS, CFRAC, SIZE(DRYCOEFF) ) - ENDIF - RIX = RI*GFACT*GFACI - ! Apply scaling factor to RIX when CO2 effect is turned - ! on based on Franks et al. (2013) - If (CO2_EFFECT) THEN - RS_SCALE = CO2_LEVEL / CO2_REF * & - (CO2_LEVEL + 80.0_fp) * & - (CO2_REF - 40.0_fp) / & - (CO2_LEVEL - 40.0_fp) / & - (CO2_REF + 80.0_fp) - RIX = RIX * RS_SCALE - ENDIF - - ENDIF - - !*Cuticular resistances IRLU array defined above are per unit area of leaf; - !*divide them by the leaf area index to get a cuticular resistance for the bulk canopy. - !*If IRLU is '9999' it means there are no cuticular surfaces on which to deposit so - !*we impose a very large value for RLU. - !TODO: not sure if XLAI is land type dependent or not. - IF ( IRLU(II) >= 9999 .or. XLAI <= 0.e+0_fp ) THEN - RLU = 1.e+6_fp - ELSE - !RLU = DBLE( IRLU(II) ) / XLAI - RLU = IRLU(II) / XLAI - ! Additional resistance at low temperatures.Limit increase to a factor of 2. - ! Ref Jaegle et al. 2018 - RLU = MIN( RLU + RT, 2.e+0_fp * RLU ) - ENDIF - - !*The following are the remaining resistances for the Wesely model for a surface canopy - !*(Wesely 1989, Fig.1). - !RAC = MAX(DBLE(IRAC(II)), 1.e+0_fp) - RAC = MAX(IRAC(II), 1.e+0_fp) - IF (RAC .GE. 9999.e+0_fp) RAC = 1.e+12_fp - !RGSS = MAX(DBLE(IRGSS(II)), 1.e+0_fp) - RGSS = MAX(IRGSS(II), 1.e+0_fp) - ! Additional resistance at low temperatures.Limit increase to a factor of 2. - ! Ref Jaegle et al. 2018 - RGSS = MIN( RGSS + RT, 2.e+0_fp * RGSS ) - IF (RGSS .GE. 9999.e+0_fp) RGSS = 1.e12_fp - !RGSO = MAX(DBLE(IRGSO(II)) ,1.e+0_fp) - RGSO = MAX(IRGSO(II) ,1.e+0_fp) - RGSO = MIN( RGSO + RT, 2.e+0_fp * RGSO ) - IF (RGSO .GE. 9999.e+0_fp) RGSO = 1.e+12_fp - !RCLS = DBLE(IRCLS(II)) - RCLS = IRCLS(II) - RCLS = MIN( RCLS + RT, 2.e+0_fp * RCLS ) - IF (RCLS .GE. 9999.e+0_fp) RCLS = 1.e+12_fp - !RCLO = DBLE(IRCLO(II)) - RCLO = IRCLO(II) - RCLO = MIN( RCLO + RT, 2.e+0_fp * RCLO ) - IF (RCLO .GE. 9999.e+0_fp) RCLO = 1.e+12_fp - - !* Compute aerodynamic resistance to lower elements in lower part - !* of the canopy or structure, assuming level terrain - - !* equation (5) of Wesely [1989]. - !* species-dependent corrections to resistances - !* are from equations (6)-(9) of Wesely [1989]. - - RDC = 100.e+0_fp*(1.0e+0_fp+1000.0e+0_fp/(RADIAT+10.e+0_fp)) - - IF ( SPC .EQ. 'O3' .or. SPC .EQ. 'o3') THEN - !O3 over water - IF ((II .EQ. 11)) THEN - IF (SALINITY .GT. 20.0_fp) THEN - ! Now apply the Luhar et al. [2018] equations for the - ! special treatment of O3 dry deposition to the ocean - CALL OCEANO3(TSKIN,USTAR,IODIDE,DEPVw) - ! Now convert to the new rc value(s) - alpha0 = 10.0_fp**(-0.25_fp-0.013_fp * (TSKIN-273.16_fp)) - RSURFC = 1.0_fp/(alpha0*DEPVw) - ELSE - ! It's not saline enough for 'ocean' so we instead don't change it from - ! 'default' rc to water - RSURFC = 2000.0_fp - ENDIF - ENDIF - - !O3 over snow/ice, the surface resistance is set to an observation derived value - IF ((II .EQ. 1)) THEN - RSURFC = 10000.0_fp - ENDIF - ELSE - !set a different F0 for Hg0 - IF (SPC .EQ. 'Hg0' .or. SPC .EQ. 'hg0') THEN - ! Assume lower reactivity - F0 = 3.0e-05_fp - ! But if this is the rainforest land type and we fall - ! within the bounding box of the Amazon rainforest, - ! then increase reactivity as inferred from observations. - IF ( II == 6 .AND. & - XLON > -82.0_fp .AND. & - XLON < -33.0_fp .AND. & - YLAT > -34.0_fp .AND. & - YLAT < 14.0_fp ) THEN - F0 = 2.0e-01_fp - ENDIF - ENDIF - - XMWH2O = H2OMW * 1.e-3_fp - RIXX = RIX*DIFFG(TEMPK,PRESSU,XMWH2O)/ DIFFG(TEMPK,PRESSU,XMW) & - + 1.e+0_fp/(HSTAR/3000.e+0_fp+100.e+0_fp*F0) - RLUXX = 1.e+12_fp - IF (RLU .LT. 9999.e+0_fp) RLUXX = RLU/(HSTAR/1.0e+05_fp + F0) - RGSX = 1.e+0_fp/(HSTAR/1.0e+05_fp/RGSS + F0/RGSO) - RCLX = 1.e+0_fp/(HSTAR/1.0e+05_fp/RCLS + F0/RCLO) - !** Get the bulk surface resistance of the canopy, RSURFC, from - !** the network of resistances in parallel and in series (Fig.1 of Wesely [1989]) - DTMP1=1.e+0_fp/RIXX - DTMP2=1.e+0_fp/RLUXX - DTMP3=1.e+0_fp/(RAC+RGSX) - DTMP4=1.e+0_fp/(RDC+RCLX) - RSURFC = 1.e+0_fp/(DTMP1 + DTMP2 + DTMP3 + DTMP4) - ENDIF - - !TODO: this is put in the main scheme function - !*Set max and min values for bulk surface resistances - !!RSURFC = MAX(1.e+0_fp, MIN(RSURFC,9999.e+0_fp)) - !*because of high resistance values, different rule applied for ocean ozone - !!IF ((SPC .EQ. 'O3') .AND. (II .EQ. 11)) THEN - !! RSURFC = MAX(1.e+0_fp, MIN(RSURFC,999999.e+0_fp)) - !!ENDIF - ! Set Rc for strong acids (HNO3,HCl,HBr) to 1 s/m - ! Ref. Jaegle et al. 2018, cf. Erisman,van Pul,Ayers 1994 - !!IF ( HSTAR .gt. 1.e+10_fp ) RSURFC= 1.e+0_fp - - return - end subroutine Wesely_Rc_Gas - - - !> - !! \brief calculates the dry deposition velocity of O3 to ocean - !! - !!References: - !! Pound, R. J., Sherwen, T., Helmig, D., Carpenter, L. J., and Evans, M. J.: - !! Influence of oceanic ozone deposition on tropospheric photochemistry, - !! Atmos. Chem. Phys., https://doi.org/10.5194/acp-20-4227-2020, 2020. - !! - !! \param TEMPK Temperatue [K] - !! \param USTAR Fictional Velocity [m/s] - !! \param IODIDE_IN Surface iodide concentration [nM] - !! \param DEPV output of the new deposition vel [cm/s] - !! - !! \ingroup catchem_drydep_process - !!!> - SUBROUTINE OCEANO3( TEMPK, USTAR, IODIDE_IN, DEPV ) - - IMPLICIT NONE - - !INPUT PARAMETERS: - REAL(fp), INTENT(IN) :: TEMPK ! Temperature [K] - REAL(fp), INTENT(IN) :: USTAR ! Fictional Velocity [m/s] - REAL(fp), INTENT(IN) :: IODIDE_IN ! Surface iodide concentration [nM] - REAL(fp), INTENT(OUT) :: DEPV ! the new deposition vel [cm/s] - !LOCAL VARIABLES: - REAL(fp) :: a0,D,DelM,b,PSI,LAM,EP,USTARWater,K0,K1,Iodide - - !================================================================= - ! OCEANO3 begins here! - !================================================================= - - USTARWater = 0.0345_fp * USTAR !waterside friction velocity - - Iodide = IODIDE_IN*1.0E-9_fp ! Convert from nM to M - - a0 = Iodide*EXP((-8772.2_fp/TEMPK)+51.5_fp) !chemical reactivity - - D = 1.1E-6_fp*EXP(-1896.0_fp/TEMPK) ! diffusivity - - DelM = SQRT(D/a0) ! reaction-diffusion length - - b = 2.0_fp/(0.4_fp*USTARWater) - - LAM = DelM*SQRT(a0/D) ! this cancels to 1 but here for completeness of equations - - EP = SQRT(2.0_fp*a0*b*(DelM+(b*D/2.0_fp))) - - PSI = EP/SQRT(a0*b**2*D) - - CALL K0K1_APROX(EP,K0,K1) - - DEPV = SQRT(a0*D)*((PSI*K1*COSH(LAM)+K0*SINH(LAM))/(PSI*K1* SINH(LAM)+K0*COSH(LAM))) - - END SUBROUTINE OCEANO3 - - !> - !! \brief estimate the modified Bessel functions of the second order zero (K0) and one (K1). - !! - !!References: - !! Approach initially described in Numerical Recipes in Fortran 90 second edition - !! (1996). This implementation is designed to be specific to the use - !! case required for calculating oceanic deposition velocity. Uses a - !! polynomial fit of each type of modified bessel function to - !! estimate the value of the function for each input. - !! - !! \param input_arg !the value we want the soln for - !! \param K0, K1 output of the modified bessel functions - !! - !! \ingroup catchem_drydep_process - !!!> - SUBROUTINE K0K1_APROX( input_arg, K0, K1 ) - - IMPLICIT NONE - !INPUT PARAMETERS: - REAL(fp), INTENT(IN) :: input_arg !the value we want the soln for - REAL(fp), INTENT(OUT) :: K0,K1 !the values of the modified bessel fncs - !LOCAL VARIABLES: - REAL(fp), DIMENSION(7) :: coeff !coefficients for polynomial fit - ! of each bessel function - REAL(fp) :: I0,I1 !modified bessel functions of - ! first kind order 0 and 1 - - ! determine which fit method is best for the bessel functions - IF (input_arg <= 2.0_fp) THEN - ! begin the calculation of k0 by estimating i0 - coeff = (/1.0_fp,3.5156229_fp,3.0899424_fp,1.2067492_fp,0.2659732_fp, & - 0.360768e-1_fp,0.45813e-2_fp/) - I0 = poly_fit((input_arg/3.75_fp)**2,coeff) - !now we can use this estimate of i0 to calculate k0 - coeff = (/-0.57721566_fp,0.42278420_fp,0.23069756_fp,0.3488590e-1_fp, & - 0.262698e-2_fp,0.10750e-3_fp,0.74e-5_fp/) - K0 = (-LOG(0.5_fp*input_arg)*I0)+ & - poly_fit(0.25_fp*input_arg**2,coeff) - - !begin the calculation of k0 by estimating i1 - coeff = (/0.5_fp,0.87890594_fp,0.51498869_fp,0.15084934_fp,0.2658733e-1_fp, & - 0.301532e-2_fp,0.32411e-3_fp/) - I1 = input_arg*poly_fit((input_arg/3.75_fp)**2,coeff) - ! now we can use this to estimate to get a value for k1 - coeff = (/1.0_fp,0.15443144_fp,-0.67278579_fp,-0.18156897_fp, & - -0.1919402e-1_fp,-0.110404e-2_fp,-0.4686e-4_fp/) - K1 = (LOG(0.5_fp*input_arg)*I1)+(1.0_fp/input_arg)* & - poly_fit(0.25_fp*input_arg**2,coeff) - ELSE !use a different approximation that doesn't need I0/I1 - coeff = (/1.25331414_fp,-0.7832358e-1_fp,0.2189568e-1_fp,-0.1062446e-1_fp, & - 0.587872e-2_fp,-0.251540e-2_fp,0.53208e-3_fp/) - K0 = (EXP(-input_arg)/SQRT(input_arg))* & - poly_fit((2.0_fp/input_arg),coeff) - coeff = (/1.25331414_fp,0.23498619_fp,-0.3655620e-1_fp,0.1504268e-1_fp, & - -0.780353e-2_fp,0.325614e-2_fp,-0.68245e-3_fp/) - K1 = (EXP(-input_arg)/SQRT(input_arg))* & - poly_fit((2.0_fp/input_arg),coeff) - ENDIF - - END SUBROUTINE K0K1_APROX - - !> - !! \brief calculate the value of a polynomial fit used in - !! the K0K1_APPROX function in estimating the values of a - !! modified bessel function. - !! - !!References: - !! - !! \param input - !! \param coeffs - !! - !! \ingroup catchem_drydep_process - !!!> - FUNCTION poly_fit ( input, coeffs ) - - !INPUT PARAMETERS: - REAL(fp), INTENT(IN) :: input - REAL(fp), DIMENSION(:), INTENT(IN) :: coeffs - !LOCAL VARIABLES: - REAL(fp) :: poly_fit - INTEGER :: i - - poly_fit = 0 - - DO i = 1,7,1 - poly_fit = poly_fit+coeffs(i)*input**i - ENDDO - - END FUNCTION poly_fit - - !> - !! \brief calculates the molecular diffusivity [m2/s] in air for a gas X - !! of molecular weight XM [kg] at temperature TK [K] and pressure PRESS [Pa]. - !! - !!References: - !! - !! \param TK Temperatue [K] - !! \param PRESS Pressure [Pa] - !! \param XM Molecular weight of gas [kg] - !! - !! \ingroup catchem_drydep_process - !!!> - - FUNCTION DIFFG( TK, PRESS, XM ) RESULT( DIFF_G ) - - !INPUT PARAMETERS: - REAL(fp), INTENT(IN) :: TK ! Temperature [K] - REAL(fp), INTENT(IN) :: PRESS ! Pressure [Pa] - REAL(fp), INTENT(IN) :: XM ! Molecular weight of gas [kg] - !LOCAL VARIABLES: - REAL(fp) :: AIRDEN, Z, DIAM, FRPATH, SPEED, DIFF_G - - !REMARKS: - !We specify the molecular weight of air (XMAIR) and the hard-sphere molecular - !radii of air (RADAIR) and of the diffusing gas (RADX). The molecular - !radius of air is given in a Table on p. 479 of Levine [1988]. The Table - !also gives radii for some other molecules. Rather than requesting the user - !to supply a molecular radius we specify here a generic value of 1.2E-10 m for - !all molecules, which is good enough in terms of calculating the diffusivity - !as long as molecule is not too big. - - !DEFINED PARAMETERS: - REAL(fp), PARAMETER :: XMAIR = 28.8e-3_fp ! Moist air molec wt? - REAL(fp), PARAMETER :: RADAIR = 1.2e-10_fp - REAL(fp), PARAMETER :: RADX = 1.5e-10_fp - - !================================================================= - ! DIFFG begins here! - !================================================================= - - ! Air density [molec/m3] - AIRDEN = ( PRESS * AVO ) / ( RSTARG * TK ) - - ! DIAM is the collision diameter for gas X with air. - DIAM = RADX + RADAIR - - ! Calculate the mean free path for gas X in air: - ! eq. 8.5 of Seinfeld [1986]; - Z = XM / XMAIR - FRPATH = 1e+0_fp /( PI * SQRT( 1e+0_fp + Z ) * AIRDEN * ( DIAM**2 ) ) - - ! Calculate average speed of gas X; eq. 15.47 of Levine [1988] - SPEED = SQRT( 8e+0_fp * RSTARG * TK / ( PI * XM ) ) - - ! Calculate diffusion coefficient of gas X in air; - ! eq. 8.9 of Seinfeld [1986] - DIFF_G = ( 3e+0_fp * PI / 32e+0_fp ) * ( 1e+0_fp + Z ) * FRPATH * SPEED - - END FUNCTION DIFFG - - !> - !! \brief computes the light correction used in the dry deposition and canopy NOx modules. - !! It was part of the old Harvard-GISS CTM and was ported into GEOS-Chem - !! - !!References: - !! Wang, Y., D.J. Jacob, and J.A. Logan, "Global simulation of tropospheric - !! O3-NOx-hydrocarbon chemistry, 1. Model formulation", J. Geophys. Res., - !! 103/D9, 10,713-10,726, 1998. - !! - !! \param COEFF1 Baldocchi drydep coefficients - !! \param XLAI1 Leaf area index [cm2/cm2] - !! \param SUNCOS1 Cosine( Solar Zenith Angle ) - !! \param CFRAC1 Cloud fraction [unitless] - !! \param NPOLY # of drydep coefficients - !! - !! \ingroup catchem_drydep_process - !!!> - FUNCTION BioFit( COEFF1, XLAI1, SUNCOS1, CFRAC1, NPOLY ) RESULT( BIO_FIT ) - - !INPUT PARAMETERS: - INTEGER, INTENT(IN) :: NPOLY ! # of drydep coefficients - REAL(fp), INTENT(IN) :: COEFF1(NPOLY) ! Baldocchi drydep coefficients - REAL(fp), INTENT(IN) :: XLAI1 ! Leaf area index [cm2/cm2] - REAL(fp), INTENT(IN) :: SUNCOS1 ! Cosine( Solar Zenith Angle ) - REAL(fp), INTENT(IN) :: CFRAC1 ! Cloud fraction [unitless] - !RETURN VALUE: - REAL(fp) :: BIO_FIT ! Resultant light correction - !DEFINED PARAMETERS: - INTEGER, PARAMETER :: KK = 4 - INTEGER, PARAMETER :: NN = 3 ! # of variables (LAI, SUNCOS, CLDFRC) - REAL(fp) :: ND(NN) = (/ 55.0e0_fp, 20.0e0_fp, 11.0e0_fp /) !scaling factor for each variable !codespell:ignore - REAL(fp) :: X0(NN) = (/ 11.0e0_fp, 1.0e0_fp, 1.0e0_fp /) !maximum for each variable - !LOCAL VARIABLES: - REAL(fp) :: XLOW !minimum for each variable - REAL(fp) :: TERM(KK) - REAL(fp) :: REALTERM(NPOLY) - INTEGER :: K,K1,K2,K3,I,I2 - - !================================================================= - ! BIOFIT begins here! - !================================================================= - TERM(1) = 1.0e0_fp - TERM(2) = XLAI1 - TERM(3) = SUNCOS1 - TERM(4) = CFRAC1 - !we replace SUNPARAM_R4( TERM(2:4) ) as below - !outdate lai,suncos,cloud fraction - DO I = 1, NN - I2 = I + 1 !variable index in TERM is from 2 - TERM(I2) = MIN( TERM(I2), X0(I) ) - ! XLOW = minimum for each variable - IF ( I .NE. 3 ) THEN - XLOW = X0(I) / ND(I) !codespell:ignore - ELSE - XLOW = 0.0e0_fp - ENDIF - TERM(I2) = MAX( TERM(I2), XLOW ) - TERM(I2) = TERM(I2) / X0(I) - ENDDO - - !get realterm - K = 0 - DO K3 = 1, KK - DO K2 = K3, KK - DO K1 = K2, KK - K = K + 1 - REALTERM(K)=TERM(K1)*TERM(K2)*TERM(K3) - ENDDO - ENDDO - ENDDO - - BIO_FIT = 0e0_fp - DO K = 1, NPOLY - BIO_FIT = BIO_FIT + COEFF1(K)*REALTERM(K) - END DO - IF ( BIO_FIT .LT. 0.1e0_fp ) BIO_FIT = 0.1e0_fp - - END FUNCTION BioFit - - !> - !! \brief calculates the Ra and Rb term in the Wesely scheme - !! - !!References: - !! Wesely, M. L. "Parameterization of surface resistances to gaseous dry deposition in - !! regional-scale numerical models." Atmospheric environment 41 (2007): 52-63. - !! https://doi.org/10.1016/0004-6981(89)90153-4 - !! - !! \param TEMPK Temperatue [K] - !! \param PRESSU Pressure [Pa] - !! \param XMW Molecular weight [kg/mol] - !! \param USTAR Fictional Velocity [m/s] - !! \param OBK Monin-Obhukov length [m] - !! \param ZO Roughness length [m] - !! \param THIK height of first model layer [m] - !! \param IS_GAS flag for gas - !! \param Ra output of aerodynamic resistance [s/m] - !! \param Rb output of quasi-laminar boundary layer resistance [s/m] - !! \param RC Success or failure? - !! - !! \ingroup catchem_drydep_process - !!!> - subroutine Wesely_Ra_Rb(TEMP, PRESSU, XMW, USTAR, OBK, ZO, THIK, IS_GAS, Ra, Rb, RC) - IMPLICIT NONE - ! Parameters - !----------- - real(fp), intent(in) :: TEMP !< Temperature [K] - real(fp), intent(in) :: PRESSU !< Pressure [Pa] - real(fp), intent(in) :: XMW !< Molecular weight [kg/mol] - real(fp), intent(in) :: USTAR !< Friction velocity [m/s] - real(fp), intent(in) :: OBK !< Monin-Obhukov length [m] - real(fp), intent(in) :: ZO !< Roughness length [m] - real(fp), intent(in) :: THIK !< height of first model layer [m] - logical, intent(in) :: IS_GAS !< flag for gas - !output - real(fp), intent(out) :: Ra !< aerodynamic resistance [s/m] - real(fp), intent(out) :: Rb !< quasi-laminar boundary layer resistance [s/m] - integer, intent(out) :: RC !< Success or failure? - - ! Local Variables - !---------------- - real(fp) :: C1,CZ,XNU - real(fp) :: CKUSTR,REYNO,CORR1,CORR2,Z0OBK - real(fp) :: DUMMY1,DUMMY2,DUMMY3,DUMMY4 - real(fp) :: DAIR,TEMPK,TEMPC - logical :: LRGERA !stable atmosphere; a high aerodynamic resistance (RA=1.E4 m s-1) is imposed; else RA is calculated - !string - character(len=255) :: thisLoc - character(len=512) :: ErrMsg - - !-------------------------------------------- - ! main function - !-------------------------------------------- - - ! Assume success - RC = CC_SUCCESS - ErrMsg = '' - ThisLoc = ' -> at Wesely_Ra_Rb (in process/drydep/scheme/DryDepScheme_WESELY_Mod.F90)' - - ! Zero variables that aren't zeroed below - CZ = 0.0_fp - CKUSTR = 0.0_fp - REYNO = 0.0_fp - CORR1 = 0.0_fp - CORR2 = 0.0_fp - Z0OBK = 0.0_fp - DUMMY1 = 0.0_fp - DUMMY2 = 0.0_fp - DUMMY3 = 0.0_fp - DUMMY4 = 0.0_fp - DAIR = 0.0_fp - Ra = 0.0_fp - Rb = 0.0_fp - - !CZ is Altitude (m) at which deposition velocity is computed - !use Midpoint height of first model level [m] - CZ = THIK / 2.0e+0_fp - - !** TEMPK and TEMPC are surface air temperatures in K and in C - TEMPK = TEMP - TEMPC = TEMP-273.15e+0_fp - - !** Calculate the kinematic viscosity XNU (m2 s-1) of air - !** as a function of temperature. - !** The kinematic viscosity is used to calculate the roughness heights - !** over water surfaces and to diagnose whether such surfaces are - !** aerodynamically rough or smooth using a Reynolds number criterion. - !** The expression for the temperature dependence of XNU - !** is from the FORTRAN code in Appendix II of Wesely [1988]; - !** I wasn't able to find an original reference but it seems benign enough. - C1 = TEMPK/273.15e+0_fp - XNU = 0.151e+0_fp*(C1**1.77e+0_fp)*1.0e-04_fp - - !***** Get aerodynamic resistances Ra and Rb. *********** - ! The aerodynamic resistance Ra is integrated from altitude z0+d up - ! to the altitude z1 at which the dry deposition velocity is to be - ! referenced. The integration corrects for stability using Monin- - ! Obukhov similarity formulas from Businger et al. [1971] which - ! apply over the range -2.5 < z/zMO < 1.5 (see their Figure 2). - ! Under very unstable conditions when z1 > -2.5 zMO, we assume that - ! there is no resistance to transfer in the convective column - ! between zMO and z1. Under very stable conditions when z1 > 1.5 zMO - ! we assume that vertical transfer in the column between zMO and z1 - ! is strongly suppressed so that the deposition velocity at altitude - ! z1 is very low. Under these conditions we just specify a very - ! large Ra=1.E4 s m-1 (LRGERA = T). - !** - ! The Reynolds number REYNO diagnoses whether a surface is - ! aerodynamically rough (REYNO > 1) or smooth. - ! - ! NOTE: The criterion "REYNO > 1" was originally "REYNO > 10". See - ! below for an explanation of why it was changed (hyl, 10/15/99) - ! - ! Surface is rough in all cases except over water with low wind - ! speeds. In the smooth case, vertical transport IN THE SUBLAYER - ! near the surface is limited by molecular diffusion and is - ! therefore very slow; we assign a large value we assign a large - ! value of Ra + Rb to account for this effect. [In Versions 3.2 - ! and earlier we used the formulation for Ra + Rb given in Equation - ! (12) of Walcek et al [1986] to calculate the aerodynamic - ! resistance over smooth surfaces. However, that expression fails - ! when u* is very small, as it yields negative values of Ra + Rb]. - ! (djj, hyl, bmy, 5/8/00) - !** - ! In the aerodynamically rough case, the expression for Ra is as - ! given in equation (5) of Jacob et al. [1992]: - ! - ! Ra = (1/ku*)*int(from z0 to z1) (phi(x)/z)dz - ! - ! where x = (z-D)/zMO, z is the height above ground, and D is the - ! displacement height which is typically 70-80% of the canopy - ! height [Brutsaert, 1982]. We change the vertical coordinate so - ! that z=0 at the displacement height; that's OK since for all - ! practical applications z1 >> D. In this manner we don't need - ! to assume any specific value for the displacement height. - ! Applying the variable transformation z -> x = z/zMO, the equation - ! above becomes - ! - ! Ra = (1/ku*)*int(from x0 to x1) (phi(x)/x)dx with x=z/zMO - ! - ! Here phi is a stability correction function originally formulated - ! by Businger et al. [1971] and given in eqns 5a and 5b of Jacob et - ! al. [1992]. For unstable conditions, - ! - ! phi(x) = a/sqrt(1-bx) where a=0.74, b = 9 - ! - ! The analytical solution to the integral is [Dwight, 1957, - ! integral 192.11]: - ! - ! int(dx/(x*sqrt(1-bx))) = log(abs((sqrt(1-bx)-1) - ! /(sqrt(1-bx)+1))) - ! - ! which yields the expression for Ra used in the code for - ! unstable conditions. For stable conditions, - ! - ! phi(x) = a + bx where a=0.74, b = 4.7 - ! - ! and the analytical solution to the integral is - ! - ! int((a/x)+b)dx = a*ln(x) + bx - ! - ! which yields the expression of Ra used in the code for stable - ! conditions. - !** - ! The formulation of RB for gases is equation (12) of Walcek et al. - ! [1986]. The parameterization for deposition of aerosols does not - ! include an RB term so RB for aerosols is set to zero. - ! Modify phi(x) according to the non-local mixing scheme - ! by Holtslag and Boville [1993] ( Lin, 07/18/08 ) - ! For unstable conditions, - ! phi(x) = a/sqrt(1-bx) where a=1.0, b=15.0 - ! - ! For stable conditions, - ! phi(x) = a + bx - ! where a=1.0, b=5.0 for 0 <= x <= 1, and - ! a=5.0, b=1.0 for x > 1.0 - !******************************************************** - - CKUSTR = VON_KARMAN * USTAR - REYNO = USTAR*ZO/XNU - CORR1 = CZ/OBK - ! Define Z0OBK - Z0OBK = ZO/OBK - - LRGERA = .FALSE. - ! Add option for non-local PBL - !IF (.NOT. LNLPBL) THEN - ! IF (CORR1 .GT. 0.e+0_fp) THEN - ! IF (CORR1 .GT. 1.5e+0_fp) LRGERA = .TRUE. - ! ELSEIF(CORR1 .LE. 0.e+0_fp) THEN - ! IF (CORR1 .LE. -2.5e+0_fp) CORR1 = -2.5e+0_fp - ! CORR2 = LOG(-CORR1) - ! ENDIF - !ENDIF - - !use rae function from pecision_mod to avoid "equality comparison for real" warning - IF ( rae(CKUSTR, 0.0e+0_fp) ) THEN - ErrMsg = 'CKUSTR cannot be zero.' - CALL CC_Error( ErrMsg, RC, ThisLoc ) - RETURN ! debug - ENDIF - - !...aerodynamically rough or smooth surface - ! "In the classic study by Nikuradse (1933) the transition from - ! smooth to rough was examined in pipe flow. He introduced a - ! roughness Reynolds number Rr = U* Z0 / Nu and found the flow to - ! be smooth for Rr < 0.13 and rough for Rr > 2.5 with a transition - ! regime in between." (E.B. Kraus and J.A. Businger, Atmosphere-Ocean - ! Interaction, second edition, P.144-145, 1994). - ! Similar statements can be found in the books: Evaporation into the - ! atmosphere, by Wilfried Brutsaert ,P.59,89, 1982; or Seinfeld & - ! Pandis, P.858, 1998. - ! Here we assume a sudden transition point Rr = 1 from smooth to - ! rough, following L. Merlivat (1978, The dependence of bulk - ! evaporation coefficients on air-water interfacial conditions as - ! determined by the isotopic method, J. Geophys. Res., Oceans & - ! Atmos., 83, C6, 2977-2980). Also refer to Brutsaert's book, P.125. - ! We used to use the criterion "REYNO > 10" for aerodynamically rough - ! surface and now change to "REYNO > 1". (hyl, 10/15/99) - ! D. J. Jacob change the criterion for aerodynamically rough - ! surface to REYNO > 0.1 - IF ( REYNO >= 0.1e+0_fp ) THEN !rough surface - ! Add option for non-local PBL - !TODO: we only use non-local option - !IF (.NOT. LNLPBL) THEN - - !...aerodynamically rough surface. - !* - ! IF (CORR1.LE.0.0e+0_fp .AND. Z0OBK .LT. -1.e+0_fp)THEN - !*... unstable condition; set RA to zero. - !* (first implemented in V. 3.2) - ! RA = 0.e+0_fp - !*... error trap: prevent CORR1 or Z0OBK from being - !*... zero or close to zero (ckeller, 3/15/16) - ! ELSEIF ( ABS(CORR1)<=SMALL .OR. ABS(Z0OBK)<=SMALL ) THEN - ! RA = 0.e+0_fp - ! ELSEIF (CORR1.LE.0.0e+0_fp .AND. Z0OBK .GE. -1.e+0_fp) THEN - !*... unstable conditions; - !*... compute Ra as described above - ! DUMMY1 = (1.e+0_fp - 9e+0_fp*CORR1)**0.5e+0_fp - ! DUMMY2 = (1.e+0_fp - 9e+0_fp*Z0OBK)**0.5e+0_fp - ! DUMMY3 = ABS((DUMMY1 - 1.e+0_fp)/(DUMMY1 + 1.e+0_fp)) - ! DUMMY4 = ABS((DUMMY2 - 1.e+0_fp)/(DUMMY2 + 1.e+0_fp)) - ! RA = 0.74e+0_fp* (1.e+0_fp/CKUSTR) * LOG(DUMMY3/DUMMY4) - - ! ELSEIF((CORR1.GT.0.0e+0_fp).AND.(.NOT.LRGERA)) THEN - !*... moderately stable conditions (z/zMO <1); - !*... compute Ra as described above - ! RA = (1e+0_fp/CKUSTR) * (.74e+0_fp*LOG(CORR1/Z0OBK) + & - ! 4.7e+0_fp*(CORR1-Z0OBK)) - ! ELSEIF(LRGERA) THEN - !*... very stable conditions - ! RA = 1.e+04_fp - ! ENDIF - !* check that RA is positive; if RA is negative (as occasionally - !* happened in version 3.1) send a warning message. - - !ELSE !not using non-local PBL - - IF (CORR1.LT.0.0e+0_fp) THEN - !*... unstable conditions; compute Ra as described - !*... above. - !coef_a=1.e+0_fp - !coef_b=15.e+0_fp - DUMMY1 = (1.e+0_fp - 15.e+0_fp*CORR1)**0.5e+0_fp - DUMMY2 = (1.e+0_fp - 15.e+0_fp*Z0OBK)**0.5e+0_fp - DUMMY3 = ABS((DUMMY1 - 1.e+0_fp)/(DUMMY1 + 1.e+0_fp)) - DUMMY4 = ABS((DUMMY2 - 1.e+0_fp)/(DUMMY2 + 1.e+0_fp)) - RA = 1.e+0_fp * (1.e+0_fp/CKUSTR) * LOG(DUMMY3/DUMMY4) - - ELSEIF((CORR1.GE.0.0e+0_fp).AND.(CORR1.LE.1.0e+0_fp)) THEN - !coef_a=1.e+0_fp - !coef_b=5.e+0_fp - RA = (1.e+0_fp/CKUSTR) * (1.e+0_fp*LOG(CORR1/Z0OBK) + & - 5.e+0_fp*(CORR1-Z0OBK)) - - ELSE ! CORR1 .GT. 1.0D0 - !coef_a=5e+0_fp - !coef_b=1.e+0_fp - RA = (1.e+0_fp/CKUSTR) * (5.e+0_fp*LOG(CORR1/Z0OBK) + & - 1.e+0_fp*(CORR1-Z0OBK)) - ENDIF - - !* check that RA is positive and maximize at 1.E4 s m-1 - RA = MIN(RA,1.e+4_fp) - ! If RA is < 0, set RA = 0 - IF (RA .LT. 0.e+0_fp) RA = 0.0e+0_fp - - !END IF !PBL or non-local PBL options - - !get Rb for a gas species; arosol Rb is set to zero - !** DAIR is the thermal diffusivity of air; value 0.2*1.E-4 m2 s-1 cited on p. 16,476 of - !** Jacob et al. [1992] - DAIR = 0.2e0_fp*1.e-4_fp - IF (IS_GAS) THEN - RB = (2.e+0_fp/CKUSTR)* (DAIR/DIFFG(TEMPK,PRESSU,XMW)) & - **0.667e+0_fp - END IF - - ELSE !smooth surface - !** suppress drydep over smooth surfaces by setting Ra to - !** a large value (1e4). This prevents negative dry deposition - !** velocities when u* is very small. Rb is not important in that case since - !** the total resistentce is Ra + Rb. So we set Rb to zero. - RA = 1.e+4_fp - - END IF - - end subroutine Wesely_Ra_Rb - - -end module DryDepScheme_WESELY_Mod diff --git a/src/process/drydep/schemes/DryDepScheme_WESELY_Mod.F90 b/src/process/drydep/schemes/DryDepScheme_WESELY_Mod.F90 index 219970bc..b6401b6a 100644 --- a/src/process/drydep/schemes/DryDepScheme_WESELY_Mod.F90 +++ b/src/process/drydep/schemes/DryDepScheme_WESELY_Mod.F90 @@ -133,6 +133,13 @@ module DryDepScheme_WESELY_Mod !! @param[in] tstep Time step [s] - retrieved from process interface !! @param[in] ustar USTAR field [appropriate units] !! @param[in] z0 Z0 field [appropriate units] + !! @param[in] species_mw_g Species mw_g property + !! @param[in] species_dd_f0 Species dd_f0 property + !! @param[in] species_short_name Species short_name property + !! @param[in] species_dd_hstar Species dd_hstar property + !! @param[in] species_dd_DvzAerSnow Species dd_DvzAerSnow property + !! @param[in] species_dd_DvzMinVal_snow Species dd_DvzMinVal_snow property + !! @param[in] species_dd_DvzMinVal_land Species dd_DvzMinVal_land property !! @param[in] species_conc Species concentrations [mol/mol] (num_layers, num_species) !! @param[inout] species_tendencies Species tendency terms [mol/mol/s] (num_layers, num_species) !! @param[inout] drydep_con_per_species Dry deposition concentration per species [ug/kg or ppm] (num_species) @@ -205,7 +212,7 @@ subroutine compute_wesely( & real(fp), intent(in) :: z0 ! Surface field - scalar real(fp), intent(in) :: species_mw_g(num_species) ! Species mw_g property real(fp), intent(in) :: species_dd_f0(num_species) ! Species dd_f0 property - character(len=255), intent(in) :: species_short_name(num_species) ! Species short_name property + character(len=32), intent(in) :: species_short_name(num_species) ! Species short_name property real(fp), intent(in) :: species_dd_hstar(num_species) ! Species dd_hstar property real(fp), intent(in) :: species_dd_DvzAerSnow(num_species) ! Species dd_DvzAerSnow property real(fp), intent(in) :: species_dd_DvzMinVal_snow(num_species) ! Species dd_DvzMinVal_snow property @@ -650,6 +657,7 @@ subroutine Wesely_Rc_Gas( RADIAT, TEMP, SUNCOS, F0, HSTAR, XMW, USTAR, CFRAC, P RI = IRI(II) IF (RI .GE. 9999.e+0_fp) THEN RI = 1.e+12_fp + RIX = 1.e+12_fp ELSE GFACT = 100.0e+0_fp IF (TEMPC .GT. 0.e+0_fp .AND. TEMPC .LT. 40.e+0_fp) THEN diff --git a/src/process/drydep/schemes/DryDepScheme_ZHANG_Mod copy.F90 b/src/process/drydep/schemes/DryDepScheme_ZHANG_Mod copy.F90 deleted file mode 100644 index c4320ec5..00000000 --- a/src/process/drydep/schemes/DryDepScheme_ZHANG_Mod copy.F90 +++ /dev/null @@ -1,1623 +0,0 @@ -!> \file DryDepScheme_ZHANG_Mod.F90 -!! \brief Zhang et al. [2001] scheme with Emerson et al. [2020] updates. -!! The Ra and Rb are still from Wesely (1989) for now. -!! -!! Pure science kernel for zhang scheme in drydep process. -!! This module contains ONLY the computational algorithm with NO infrastructure dependencies. -!! Uses only basic Fortran types for maximum portability and reusability. -!! Reference: -!! (1) Wesely, M. L. (1989). Parameterization of surface resistances to gaseous dry -!! deposition in regional-scale numerical models. Atmospheric Environment. -!! (2) Zhang, L., Gong, S., Padro, J., & Barrie, L. (2001). A size-segregated particle -!! dry deposition scheme for an atmospheric aerosol module. Atmospheric environment. -!! (3) Emerson, E. W., et al. (2020). Revisiting particle dry deposition and its role -!! in radiative effect estimates. PNAS, 117(42), 26076-26082. -!! (4) Most of the codes are adopted from GEOS-Chem drydep_mod.F90 module. -!! https://github.com/geoschem/geos-chem -!! -!! SCIENCE CUSTOMIZATION GUIDE: -!! 1. Modify the algorithm in compute_zhang (search for "TODO") -!! 2. Add scheme-specific helper subroutines as needed -!! 3. Update physical constants for your scheme -!! 4. Customize the environmental response functions -!! -!! INFRASTRUCTURE RESPONSIBILITIES (handled by host model): -!! - Parameter initialization and validation -!! - Input array validation and error handling -!! - Memory management and array allocation -!! - Integration with host model time stepping -!! -!! Generated on: 2025-11-13T17:12:59.281598 -!! Author: Wei Li -!! Reference: Zhang et al., 2001; Emerson et al., 2020 -module DryDepScheme_ZHANG_Mod - - use precision_mod, only: fp, rae - use error_mod, only: CC_SUCCESS, CC_Error - use DryDepCommon_Mod, only: DryDepSchemeZHANGConfig - use Constants, only: PI, AVO, VON_KARMAN, RSTARG, g0, BOLTZ !load the constants needed for this scheme - - implicit none - private - - ! Public interface - pure science only - public :: compute_zhang - - !There are 15 land types in Zhang et al., 2001 **aerosol deposition** scheme. - !The land types in the model need to be mapped to these 15 land types. - !======================================================================= - ! # LUC [Zhang et al., 2001] GEOS-CHEM LUC (Corr. #) - !----------------------------------------------------------------------- - ! 1 - Evergreen needleleaf trees Snow/Ice (12) - ! 2 - Evergreen broadleaf trees Deciduous forest ( 4) - ! 3 - Deciduous needleleaf trees Coniferous forest ( 1) - ! 4 - Deciduous broadleaf trees Agricultural land ( 7) - ! 5 - Mixed broadleaf and needleleaf trees Shrub/grassland (10) - ! 6 - Grass Amazon forest ( 2) - ! 7 - Crops and mixed farming Tundra ( 9) - ! 8 - Desert Desert ( 8) - ! 9 - Tundra Wetland (11) - ! 10 - Shrubs and interrupted woodlands Urban (15) - ! 11 - Wet land with plants Water (14) - ! 12 - Ice cap and glacier - ! 13 - Inland water - ! 14 - Ocean - ! 15 - Urban - !======================================================================= - ! GEOS-CHEM LUC 1, 2, 3, 4, 5, 6, 7 8, 9,10,11 (TODO:may add other land types later) - INTEGER :: LUCINDEX_GC(11) = (/12, 4, 1, 7,10, 2, 9, 8,11,15,14/) - ! Noah-MP LUC mapping - INTEGER :: LUCINDEX_NOAH(20) = (/ 1, 2, 3, 4, 5, 10, 10, 10, 10, 6, 11, 7, 15, 7, 12, 8, 14, 9, 9, 9 /) - ! IGBP LUC mapping - INTEGER :: LUCINDEX_IGBP(17) = (/ 1, 2, 3, 4, 5, 10, 10, 10, 10, 6, 11, 7, 15, 7, 12, 8, 14 /) - - !same as in the Wesely scheme - integer :: IDEP_IOLSON(74) - DATA IDEP_IOLSON / 11,10, 5, 3, 3, 2, 2, 5, 8, 7, 5, 8, 1, 9, 11, 11, 5, 5, 5, 2, 6, 3, 3, 2, 2, 2, 2, & - 3, 6, 6, 4, 4, 2, 6, 2, 4, 9, 4, 4, 4, 5, 5, 5, 2, 5, 9, 5, 5, 2, 8, 8, 5, & - 5, 7, 2, 4, 2, 2, 2, 5, 2, 2, 3, 5, 5, 9, 9, 9, 9, 8, 8, 8, 9, 11/ - real(fp), parameter :: TWO_THIRDS = 2.0_fp / 3.0_fp - - !======================================================================= - ! LUC 1, 2, 3, 4, 5, 6, 7, 8, - ! alpha 1.0, 0.6, 1.1, 0.8, 0.8, 1.2, 1.2, 50.0, - ! gamma 0.56, 0.58, 0.56, 0.56, 0.56, 0.54, 0.54, 0.54 - ! - ! LUC 9, 10, 11, 12, 13, 14, 15 - ! alpha 50.0, 1,3, 2.0, 50.0,100.0,100.0, 1.5 - ! gamma 0.54, 0.54, 0.54, 0.54, 0.50, 0.50, 0.56 - !======================================================================= - REAL(fp) :: ALPHA(15) = (/ 1.0e+0_fp, 0.6e+0_fp, 1.1e+0_fp, & - 0.8e+0_fp, 0.8e+0_fp, 1.2e+0_fp, & - 1.2e+0_fp, 50.0e+0_fp, 50.0e+0_fp, & - 1.3e+0_fp, 2.0e+0_fp, 50.0e+0_fp, & - 100.0e+0_fp, 100.0e+0_fp, 1.5e+0_fp /) - - ! REAL(fp) :: GAMMA(15) = (/ 0.56e+0_fp, 0.58e+0_fp, 0.56e+0_fp, & - ! 0.56e+0_fp, 0.56e+0_fp, 0.54e+0_fp, & - ! 0.54e+0_fp, 0.54e+0_fp, 0.54e+0_fp, & - ! 0.54e+0_fp, 0.54e+0_fp, 0.54e+0_fp, & - ! 0.50e+0_fp, 0.50e+0_fp, 0.56e+0_fp /) - - !...A unit is (mm) so multiply by 1.D-3 to (m) - ! LUC 1, 2, 3, 4, 5, 6, 7, 8, - ! SC1 2.0, 5.0, 2.0, 5.0, 5.0, 2.0, 2.0,-999., - ! SC2 2.0, 5.0, 2.0, 5.0, 5.0, 2.0, 2.0,-999., - ! A SC3 2.0, 5.0, 5.0, 10.0, 5.0, 5.0, 5.0,-999., - ! SC4 2.0, 5.0, 5.0, 10.0, 5.0, 5.0, 5.0,-999., - ! SC5 2.0, 5.0, 2.0, 5.0, 5.0, 2.0, 2.0,-999., - ! - ! LUC 9, 10, 11, 12, 13, 14, 15 - ! SC1 -999., 10.0, 10.0,-999.,-999.,-999., 10.0 - ! SC2 -999., 10.0, 10.0,-999.,-999.,-999., 10.0 - ! A SC3 -999., 10.0, 10.0,-999.,-999.,-999., 10.0 - ! SC4 -999., 10.0, 10.0,-999.,-999.,-999., 10.0 - ! SC5 -999., 10.0, 10.0,-999.,-999.,-999., 10.0 - REAL(fp) :: A(15,5) - - DATA A / 2.0e+0_fp, 5.0e+0_fp, 2.0e+0_fp, 5.0e+0_fp, 5.0e+0_fp, & - 2.0e+0_fp, 2.0e+0_fp, -999.e+0_fp, -999.e+0_fp, 10.0e+0_fp, & - 10.0e+0_fp, -999.e+0_fp, -999.e+0_fp, -999.e+0_fp, 10.0e+0_fp, & - - 2.0e+0_fp, 5.0e+0_fp, 2.0e+0_fp, 5.0e+0_fp, 5.0e+0_fp, & - 2.0e+0_fp, 2.0e+0_fp, -999.e+0_fp, -999.e+0_fp, 10.0e+0_fp, & - 10.0e+0_fp, -999.e+0_fp, -999.e+0_fp, -999.e+0_fp, 10.0e+0_fp, & - - 2.0e+0_fp, 5.0e+0_fp, 5.0e+0_fp, 10.0e+0_fp, 5.0e+0_fp, & - 5.0e+0_fp, 5.0e+0_fp, -999.e+0_fp, -999.e+0_fp, 10.0e+0_fp, & - 10.0e+0_fp, -999.e+0_fp, -999.e+0_fp, -999.e+0_fp, 10.0e+0_fp, & - - 2.0e+0_fp, 5.0e+0_fp, 5.0e+0_fp, 10.0e+0_fp, 5.0e+0_fp, & - 5.0e+0_fp, 5.0e+0_fp, -999.e+0_fp, -999.e+0_fp, 10.0e+0_fp, & - 10.0e+0_fp, -999.e+0_fp, -999.e+0_fp, -999.e+0_fp, 10.0e+0_fp, & - - 2.0e+0_fp, 5.0e+0_fp, 2.0e+0_fp, 5.0e+0_fp, 5.0e+0_fp, & - 2.0e+0_fp, 2.0e+0_fp, -999.e+0_fp, -999.e+0_fp, 10.0e+0_fp, & - 10.0e+0_fp, -999.e+0_fp, -999.e+0_fp, -999.e+0_fp, 10.0e+0_fp / - - ! Annual average of A; put in the function now - !REAL(fp) :: Aavg(15) - !Aavg(:) = (A(:,1)+A(:,2)+A(:,3)+A(:,4)+A(:,5))/5. - - ! SeaSalt bin boundaries - real(fp), allocatable, save :: SeaSalt_Lower_Bin(:), SeaSalt_UPPER_Bin(:) - ! Allocatable arrays for sea salt volume size bins (persistent across calls) - REAL(fp), ALLOCATABLE, SAVE :: DMID (: ) - REAL(fp), ALLOCATABLE, SAVE :: SALT_V (: ) - !TODO:put sea salt size bins here for now; may be read from input file later - !real(fp), parameter :: SALA_REDGE_um(2)=(/0.01_fp, 0.5_fp/) !< accumulation mode Sea salt radius bin [um] - !real(fp), parameter :: SALC_REDGE_um(2)=(/0.5_fp, 8.0_fp/) !< coarse mode Sea salt radius bin [um] - -contains - - !> Pure science computation for zhang scheme - !! - !! This is a pure computational kernel implementing Zhang et al. [2001] scheme with Emerson et al. [2020] updates. - !! NO error checking, validation, or infrastructure concerns. - !! Host model must ensure all inputs are valid before calling. - !! - !! @param[in] num_layers Number of vertical layers - !! @param[in] num_species Number of chemical species - !! @param[in] params Scheme parameters (pre-validated by host) - !! @param[in] bxheight BXHEIGHT field [appropriate units] - !! @param[in] frlanduse FRLANDUSE field [appropriate units] - !! @param[in] iland ILAND field [appropriate units] - !! @param[in] isice IsIce field [appropriate units] - !! @param[in] issnow IsSnow field [appropriate units] - !! @param[in] lucname LUCNAME field [appropriate units] - !! @param[in] obk OBK field [appropriate units] - !! @param[in] ps PS field [appropriate units] - !! @param[in] rh RH field [appropriate units] - !! @param[in] ts TS field [appropriate units] - !! @param[in] tstep Time step [s] - retrieved from process interface - !! @param[in] u10m U10M field [appropriate units] - !! @param[in] ustar USTAR field [appropriate units] - !! @param[in] v10m V10M field [appropriate units] - !! @param[in] z0 Z0 field [appropriate units] - !! @param[in] species_conc Species concentrations [mol/mol] (num_layers, num_species) - !! @param[inout] species_tendencies Species tendency terms [mol/mol/s] (num_layers, num_species) - !! @param[inout] drydep_con_per_species Dry deposition concentration per species [ug/kg or ppm] (num_species) - !! @param[inout] drydep_velocity_per_species Dry deposition velocity [m/s] (num_species) - !! @param[in] diagnostic_species_id Indices mapping diagnostic species to species array (optional, for per-species diagnostics) - subroutine compute_zhang( & - num_layers, & - num_species, & - params, & - bxheight, & - frlanduse, & - iland, & - isice, & - issnow, & - lucname, & - obk, & - ps, & - rh, & - ts, & - tstep, & - u10m, & - ustar, & - v10m, & - z0, & - species_mw_g, & - species_radius, & - species_density, & - species_short_name, & - species_dd_hstar, & - species_dd_DvzAerSnow, & - species_dd_DvzMinVal_snow, & - species_dd_DvzMinVal_land, & - species_lower_radius, & - species_upper_radius, & - species_is_dust, & - species_is_seasalt, & - species_conc, & - species_tendencies, & - is_gas, & - drydep_con_per_species, & - drydep_velocity_per_species, & - diagnostic_species_id & - ) - - ! Arguments - integer, intent(in) :: num_layers - integer, intent(in) :: num_species - type(DryDepSchemeZHANGConfig), intent(in) :: params - real(fp), intent(in) :: bxheight(num_layers) ! 3D atmospheric field - real(fp), intent(in) :: frlanduse(:) ! Categorical field - variable dimension array - integer, intent(in) :: iland(:) ! Categorical field - variable dimension array - logical, intent(in) :: isice ! Surface field - scalar - logical, intent(in) :: issnow ! Surface field - scalar - character(len=255), intent(in) :: lucname ! Surface field - scalar - real(fp), intent(in) :: obk ! Surface field - scalar - real(fp), intent(in) :: ps ! Surface field - scalar - real(fp), intent(in) :: rh(num_layers) ! 3D atmospheric field - real(fp), intent(in) :: ts ! Surface field - scalar - real(fp), intent(in) :: tstep ! Time step [s] - from process interface - real(fp), intent(in) :: u10m ! Surface field - scalar - real(fp), intent(in) :: ustar ! Surface field - scalar - real(fp), intent(in) :: v10m ! Surface field - scalar - real(fp), intent(in) :: z0 ! Surface field - scalar - real(fp), intent(in) :: species_mw_g(num_species) ! Species mw_g property - real(fp), intent(in) :: species_radius(num_species) ! Species radius property - real(fp), intent(in) :: species_density(num_species) ! Species density property - character(len=255), intent(in) :: species_short_name(num_species) ! Species short_name property - real(fp), intent(in) :: species_dd_hstar(num_species) ! Species dd_hstar property - real(fp), intent(in) :: species_dd_DvzAerSnow(num_species) ! Species dd_DvzAerSnow property - real(fp), intent(in) :: species_dd_DvzMinVal_snow(num_species) ! Species dd_DvzMinVal_snow property - real(fp), intent(in) :: species_dd_DvzMinVal_land(num_species) ! Species dd_DvzMinVal_land property - real(fp), intent(in) :: species_lower_radius(num_species) ! Species lower_radius property - real(fp), intent(in) :: species_upper_radius(num_species) ! Species upper_radius property - logical, intent(in) :: species_is_dust(num_species) ! Species is_dust property - logical, intent(in) :: species_is_seasalt(num_species) ! Species is_seasalt property - real(fp), intent(in) :: species_conc(num_layers, num_species) - real(fp), intent(inout) :: species_tendencies(num_layers, num_species) - logical, intent(in) :: is_gas(num_species) ! Species type flags (true=gas, false=aerosol) - real(fp), intent(inout), optional :: drydep_con_per_species(:) - real(fp), intent(inout), optional :: drydep_velocity_per_species(:) - integer, intent(in), optional :: diagnostic_species_id(:) ! Indices mapping diagnostic species to species array - - ! Local variables - integer :: rc, k, species_idx - integer :: diag_idx ! For diagnostic species indexing - real(fp) :: VD ! Dry deposition velocity - real(fp) :: DDFreq ! Dry deposition frequency - real(fp) :: C1X, RA, RB, RSURFC, VTSoutput, VK, DVZ - real(fp) :: HSTAR, XMW, W10 - integer :: II !< Index of the drydep land type - integer :: ILDT !< index of the land types in the grid box - integer :: LDT !loop index of land types - integer :: LUCINDEX !mapping above II to Zhang's 15 land types for aerosols - !logical - logical, save :: firsttime = .true. - !string - character(255) :: SPC !current species name - character(len=255) :: thisLoc - character(len=512) :: ErrMsg - - ! Note: species_tendencies and diagnostic arrays are already initialized - ! by the host ProcessInterface before calling this subroutine. - ! Do not re-initialize them here. - - RC = CC_SUCCESS - ErrMsg = '' - thisLoc = ' -> at compute_zhang (in src/process/drydep/schemes/DryDepScheme_ZHANG_Mod.F90)' - - !calculate the volume distribution of sea salt aerosols (only need to do this once) - IF ( firsttime ) THEN - ! Derive seasalt bin boundaries from species properties - call get_seasalt_bin_boundaries(num_species, species_is_seasalt, & - species_lower_radius, species_upper_radius, & - SeaSalt_Lower_Bin, SeaSalt_UPPER_Bin) - - CALL INIT_WEIGHTSS(MINVAL(SeaSalt_Lower_Bin), MAXVAL(SeaSalt_UPPER_Bin), RC) - IF ( RC /= CC_SUCCESS ) THEN - ErrMsg = 'Could not Allocate arrays in INIT_WEIGHTSS' - CALL CC_Error( ErrMsg, RC, ThisLoc ) - RETURN - ENDIF - firsttime = .false. - ENDIF - - ! Calculate 10m wind speed - W10 = sqrt(U10M**2 + V10M**2) - - ! Main computation loop - CUSTOMIZE THIS SECTION FOR YOUR SCHEME - do k = 1, num_layers - - ! Apply to each species - do species_idx = 1, num_species - ! Skip species that don't match scheme type (gas vs aerosol) - if (is_gas(species_idx)) cycle - - ! Add option for non-local PBL mixing scheme: THIK must be the first box height. - ! TODO: we only use non-local mixing here - !IF (.NOT. LNLPBL) THIK = MAX( ZH, THIK ) - - ! Zero variables that aren't zeroed below - VD = 0.0_fp - DDFreq = 0.0_fp - DVZ = 0.0_fp - RSURFC = 0.0_fp - RA = 0.0_fp - RB = 0.0_fp - C1X = 0.0_fp - VK = 0.0_fp - VTSoutput = 0.0_fp - - !property for current species - HSTAR = species_dd_hstar(species_idx) - XMW = species_mw_g(species_idx)*1e-3_fp !convert from g/mol to kg/mole - SPC = trim(species_short_name(species_idx)) - - ! Better test for depositing species: We need both HSTAR and XMW - ! to be nonzero, OR the value of AIROSOL to be true. This should - ! avoid any further floating point invalid issues caused by putting - ! a zero value in a denominator. - DO LDT =1 , SIZE(frlanduse) - ! If the land type is not represented in grid - ! box, then skip to the next land type - IF ( frlanduse(LDT) <= 0 ) CYCLE - - ILDT = ILAND(LDT) - IF ( LUCNAME == 'OLSON' ) THEN - ! Olson land type index + 1 - ILDT = ILDT + 1 - ! Dry deposition land type index - II = IDEP_IOLSON(ILDT) - LUCINDEX = LUCINDEX_GC(II) - ELSE IF ( LUCNAME == 'NOAH' ) THEN - ! it is possible that water is given as 0 not 17 in GFS CCPP - IF (ILDT == 0) ILDT = 17 - !II = IDEP_NOAH(ILDT) - !Note: we use ILDT, instead of II, to get LUCINDEX here - LUCINDEX = LUCINDEX_NOAH(ILDT) - ELSE IF ( LUCNAME == 'IGBP' ) THEN - ! it is possible that water is given as 0 not 17 - IF (ILDT == 0) ILDT = 17 - !II = IDEP_IGBP(ILDT) - LUCINDEX = LUCINDEX_IGBP(ILDT) - ENDIF - - !get bulk surface resistances (Rs) - !Note to change pressure unit from Pa to kPa - RSURFC = AERO_SFCRSII ( SPC, species_is_dust(species_idx), species_is_seasalt(species_idx), LUCINDEX, & - species_radius(species_idx)*1e-6_fp, species_density(species_idx), PS*1e-3_fp, & !um to m; Pa to kPa - TS, USTAR, RH(1), W10, SeaSalt_Lower_Bin, SeaSalt_UPPER_Bin,VTSoutput, RC) - - if (RC /= CC_SUCCESS ) then - errMsg = 'Error in getting bulk surface resistances (RSURFC)' - CALL CC_Error( errMsg, RC, thisLoc ) - RETURN - endif - - !*Set max and min values for bulk surface resistances - RSURFC = MAX(1.e+0_fp, MIN(RSURFC,9999.e+0_fp)) - ! Set Rc for strong acids (HNO3,HCl,HBr) to 1 s/m - ! Ref. Jaegle et al. 2018, cf. Erisman,van Pul,Ayers 1994 - IF ( HSTAR .gt. 1.e+10_fp ) RSURFC= 1.e+0_fp - - !get Ra and Rb - call Wesely_Ra_Rb(TS, PS, XMW, USTAR, OBK, Z0, bxheight(1), .FALSE., Ra, Rb, RC) - - !get VD (TODO: IUSE is decimal not percent or permille as in GEOS-Chem) - C1X = RSURFC + Ra + Rb - VK = VD - !VD = VK + DBLE( IUSE(LDT) ) / C1X + DBLE( IUSE(LDT) ) * VTSoutput - VD = VK + frlanduse(LDT) / C1X + frlanduse(LDT) * VTSoutput - END DO - - !apply spectial treatment or scaling factor to Vd - DVZ = VD *100.e+0_fp !m/s -- > cm/s - - !----------------------------------------------------------- - ! Special treatment for snow and ice - !----------------------------------------------------------- - IF ( (ISSNOW) .OR. (ISICE) ) THEN - - !------------------------------------- - ! %%% SURFACE IS SNOW OR ICE %%% - !------------------------------------- - IF ( species_DD_DvzAerSnow(species_idx) > 0.0_fp ) THEN - - ! For most aerosol species (basically everything - ! except sea salt and dust species), we just set - ! the deposition velocity over snow to a fixed value - !DVZ = DBLE( DD_DvzAerSnow ) - DVZ = species_DD_DvzAerSnow(species_idx) - - ELSE - - ! Otherwise, enforce a minimum drydep velocity over snow - ! (cf. the GOCART model). NOTE: In practice this will - ! only apply to the species SO2, SO4, MSA, NH3, NH4, NIT. - !DVZ = MAX( DVZ, DBLE( DD_DvzMinVal_Snow ) ) - DVZ = MAX( DVZ, species_DD_DvzMinVal_Snow(species_idx) ) - - ENDIF - - ELSE - - !------------------------------------- - ! %%% SURFACE IS NOT SNOW OR ICE %%% - !------------------------------------- - - ! Enforce a minimum drydep velocity over land (cf. the - ! GOCART model). NOTE: In practice this will only apply - ! to the species SO2, SO4, MSA, NH3, NH4, NIT. - !DVZ = MAX( DVZ, DBLE( DD_DvzMinVal_Land ) ) - DVZ = MAX( DVZ, species_DD_DvzMinVal_Land(species_idx) ) - - ENDIF - - !----------------------------------------------------------- - ! Compute drydep velocity and frequency - !----------------------------------------------------------- - - ! Dry deposition velocities [m/s] - VD = DVZ / 100.e+0_fp * params%scale_factor - - ! Dry deposition frequency [1/s] - DDFreq = VD / bxheight(1) - - ! Ensure non-negative emissions - species_tendencies(k, species_idx) = max(0.0_fp, DDFreq) - - ! TODO: Update diagnostic fields here based on your scheme's requirements - ! Each process should implement custom diagnostic calculations - ! Example patterns: - ! Per-species diagnostic: only update for diagnostic species - if (present(drydep_con_per_species) .and. present(diagnostic_species_id)) then - ! Find position of this species in diagnostic_species_id array - do diag_idx = 1, size(diagnostic_species_id) - if (diagnostic_species_id(diag_idx) == species_idx) then - ! Add your custom dry deposition concentration per species calculation - drydep_con_per_species(diag_idx) = & - MAX(0.0_fp, species_conc(k,species_idx) * (1.0_fp - exp(-1.0_fp * species_tendencies(k, species_idx) * tstep))) - exit - end if - end do - end if - ! Per-species diagnostic: only update for diagnostic species - if (present(drydep_velocity_per_species) .and. present(diagnostic_species_id)) then - ! Find position of this species in diagnostic_species_id array - do diag_idx = 1, size(diagnostic_species_id) - if (diagnostic_species_id(diag_idx) == species_idx) then - ! Add your custom dry deposition velocity calculation - drydep_velocity_per_species(diag_idx) = VD - exit - end if - end do - end if - end do - - end do - - end subroutine compute_zhang - - ! ======================================================================= - ! SCHEME-SPECIFIC HELPER SUBROUTINES - ! ======================================================================= - ! Add your custom scientific algorithms here as pure functions/subroutines - ! Examples: environmental response functions, species-specific calculations, etc. - - !> Extract and sort seasalt bin boundaries from species properties - !! - !! This subroutine identifies seasalt species and extracts their lower and upper - !! radius boundaries, then sorts them in ascending order using the same approach - !! as Find_SeaSalt_Bin in ChemState_Mod. - !! - !! @param[in] num_species Number of chemical species - !! @param[in] is_seasalt Logical array indicating which species are seasalt - !! @param[in] lower_radius Lower radius bounds for each species [μm] - !! @param[in] upper_radius Upper radius bounds for each species [μm] - !! @param[out] lower_bin Sorted lower bin boundaries [μm] - !! @param[out] upper_bin Sorted upper bin boundaries [μm] - subroutine get_seasalt_bin_boundaries(num_species, is_seasalt, lower_radius, upper_radius, & - lower_bin, upper_bin) - implicit none - - ! Arguments - integer, intent(in) :: num_species - logical, intent(in) :: is_seasalt(num_species) - real(fp), intent(in) :: lower_radius(num_species), upper_radius(num_species) - real(fp), allocatable, intent(out) :: lower_bin(:), upper_bin(:) - - ! Local variables - integer :: n, n_bin, rc - real(fp), allocatable :: temp_lower(:), temp_upper(:), temp_lower1(:), temp_upper1(:) - logical, allocatable :: mask(:) - ! Error handling - CHARACTER(LEN=255) :: ErrMsg - CHARACTER(LEN=255) :: thisLoc - - RC = CC_SUCCESS - ErrMsg = '' - thisLoc = ' -> at get_seasalt_bin_boundaries (in src/process/drydep/schemes/DryDepScheme_ZHANG_Mod.F90)' - - ! Count unique seasalt bins (similar to Find_SeaSalt_Bin approach) - n_bin = 0 - allocate(temp_lower1(num_species), temp_upper1(num_species)) - - do n = 1, num_species - if (.not. is_seasalt(n)) cycle - - if (n_bin == 0) then - ! First seasalt species - n_bin = 1 - temp_lower1(n_bin) = lower_radius(n) - temp_upper1(n_bin) = upper_radius(n) - else - ! Check if this radius already exists - if (ALL(ABS(temp_lower1(1:n_bin) - lower_radius(n)) > 0.0_fp)) then - n_bin = n_bin + 1 - temp_lower1(n_bin) = lower_radius(n) - temp_upper1(n_bin) = upper_radius(n) - endif - endif - enddo - - if (n_bin == 0) then - ! No seasalt species - allocate empty arrays - allocate(lower_bin(0), upper_bin(0)) - deallocate(temp_lower1, temp_upper1) - return - end if - - ! Allocate output arrays - allocate(lower_bin(n_bin), upper_bin(n_bin)) - allocate(temp_lower(n_bin), temp_upper(n_bin)) - allocate(mask(n_bin)) - - !copy temp_lower1 and temp_upper1 to temp_lower and temp_upper for sorting - temp_lower = temp_lower1(1:n_bin) - temp_upper = temp_upper1(1:n_bin) - - !sort bins by radius from low to high for lower_radius - mask(1:n_bin) = .TRUE. - do n = 1, n_bin - lower_bin(n) = MINVAL(temp_lower,mask) - mask(MINLOC(temp_lower,mask)) = .FALSE. - enddo - - !sort bins by radius from low to high for upper_radius - mask(1:n_bin) = .TRUE. - do n = 1, n_bin - upper_bin(n) = MINVAL(temp_upper,mask) - mask(MINLOC(temp_upper,mask)) = .FALSE. - enddo - - !check if the bins are continuous - do n = 1, n_bin-1 - if ( .not. rae(upper_bin(n), lower_bin(n+1)) ) then - errMsg = 'Sea Salt Bins are not continuous' - call CC_Error(errMsg, RC, thisLoc) - RETURN - endif - enddo - - ! Clean up - deallocate(temp_lower, temp_upper, temp_lower1, temp_upper1,mask) - - end subroutine get_seasalt_bin_boundaries - - !> - !! \brief computes the aerodynamic resistance of aerosols. - !! - !!References: - !! Zhang, L., Gong, S., Padro, J., & Barrie, L. (2001). A size-segregated particle - !! dry deposition scheme for an atmospheric aerosol module. - !! Atmospheric environment., https://doi.org/10.1016/S1352-2310(00)00326-5 - !! - !! Emerson, E. W., et al. (2020). Revisiting particle dry deposition and its role - !! in radiative effect estimates. PNAS, 117(42), 26076-26082. - !! https://doi.org/10.1073/pnas.2014761117 - !! - !! \param SPC Species name - !! \param II Surface type index - !! \param IS_DUST Is dust species? - !! \param IS_SEASALT Is seasalt species? - !! \param LUCINDEX mapping above II to the 15 drydep land use categories - !! \param A_RADI Aerosol radius [m] - !! \param A_DEN Aerosol density [kg/m3] - !! \param PRESS Pressure [KPa] - !! \param TEMP Temperature [K] - !! \param USTAR Fictional Velocity [m/s] - !! \param RHB Relative humidity [fraction] - !! \param W10 10m wind speed [m/s] - !! \param LOWERBIN lower bound of sea-salt bins - !! \param UPPERBIN upper bound of sea-salt bins - !! \param VTSout output of setttling velocity [m/s] - !! \param RC success flag - !! \param RS return value of surface resistance [s/m] - !! - !! \ingroup catchem_drydep_process - !!!> - - FUNCTION AERO_SFCRSII( SPC, IS_DUST, IS_SEASALT, LUCINDEX, A_RADI, A_DEN, & - PRESS, TEMP, USTAR, RHB, W10, LOWERBIN, UPPERBIN, VTSout, RC) RESULT( RS ) - - IMPLICIT NONE - !INPUT PARAMETERS - CHARACTER(len=255), INTENT(IN) :: SPC ! Species name - !TODO: not sure if SPC or index is better - !INTEGER, INTENT(IN) :: K ! Drydep species index (range: 1-NUMDEP) - !INTEGER, INTENT(IN) :: II ! Surface type index of host model (e.g., GEOS-CHEM) - LOGICAL, INTENT(IN) :: IS_DUST, IS_SEASALT ! Is dust or seasalt species? - INTEGER, INTENT(IN) :: LUCINDEX !mapping to the 15 drydep land use categories - REAL(fp), INTENT(IN) :: A_RADI ! Aerosol radius [m] - REAL(fp), INTENT(IN) :: A_DEN ! Aerosol density [kg/m3] - REAL(fp), INTENT(IN) :: PRESS ! Pressure [kPa] (1 mb = 100 Pa = 0.1 kPa) - REAL(fp), INTENT(IN) :: TEMP ! Temperature [K] - REAL(fp), INTENT(IN) :: USTAR ! Friction velocity [m/s] - REAL(fp), INTENT(IN) :: RHB ! Relative humidity (fraction) - REAL(fp), INTENT(IN) :: W10 ! 10m wind speed [m/s]; only need for SeaSalt over water - REAL(fp), DIMENSION(:), INTENT(IN) :: LOWERBIN ! lower bound of sea-salt bins - REAL(fp), DIMENSION(:), INTENT(IN) :: UPPERBIN ! upper bound of sea-salt bins - !OUTPUT PARAMETERS - REAL(fp), INTENT(OUT) :: VTSout ! Settling velocity [m/s] - INTEGER, INTENT(OUT) :: RC ! success flag - !RETURN VALUE - REAL(fp) :: RS ! Surface resistance for particles [s/m] - - !define constants - REAL(fp), PARAMETER :: E0 = 3.0_fp - ! Emerson et al. (2020) added parameters - REAL(fp), PARAMETER :: UPSILON = 0.8_fp - REAL(fp), PARAMETER :: BETA = 1.7_fp - REAL(fp), PARAMETER :: CB = 0.2_fp - REAL(fp), PARAMETER :: CIN = 2.5_fp - REAL(fp), PARAMETER :: CIM = 0.4_fp - !increment of radius for integration of settling velocity (um) - REAL(fp), PARAMETER :: DR = 5.0e-2_fp - !LOCAL VARIABLES - INTEGER :: LUC - INTEGER :: ID,NR,n, n1 - REAL(fp) :: AIRVS ! kinematic viscosity of Air (m^2/s) - REAL(fp) :: DP ! Diameter of aerosol [um] - REAL(fp) :: PDP ! Press * Dp - REAL(fp) :: CONST ! Constant for settling velocity calculations - REAL(fp) :: SLIP ! Slip correction factor - REAL(fp) :: VISC ! Viscosity of air (Pa s) - REAL(fp) :: SALT_MASS, SALT_MASS_TOTAL, VTS_WEIGHT, DMIDW - real(fp) :: D0, D1 !lower and upper bounds of sea-salt dry diameter bins - REAL(fp) :: DIFF ! Brownian Diffusion constant for particles (m2/s) - REAL(fp) :: SC, ST ! Schmidt and Stokes number (nondim) - REAL(fp) :: DIAM, RDRY, RWET, RUM, DEN - REAL(fp) :: EB, EIM, EIN, R1, AA, VTS - REAL(fp) :: RHBL ! Relative humidity local - REAL(fp) :: Aavg(15) ! annual average of A - CHARACTER(LEN=255) :: ErrMsg, thisLoc - - ! Initialize - RC = CC_SUCCESS - errMsg = '' - thisLoc = ' -> at AERO_SFCRSII (in process/drydep/scheme/DryDepScheme_ZHANG_Mod.F90)' - - !================================================================= - ! ADUST_SFCRII begins here! - !================================================================= - - ! Annual average of A - Aavg(:) = (A(:,1)+A(:,2)+A(:,3)+A(:,4)+A(:,5))/5.0_fp - - LUC = LUCINDEX - AA = Aavg(LUC) * 1.e-3_fp - RS = 0e+0_fp !initialize returned value first - - !================================================================= - !...Ref. Zhang et al., AE 35(2001) 549-560 - !. - !...Model theroy - ! Vd = Vs + 1./(Ra+Rs) - ! where Vs is the gravitational settling velocity, - ! Ra is the aerodynamic resistance above the canopy - ! Rs is the surface resistance - ! Here we calculate Rs only.. - ! Rs = 1 / (Eo*Ustar*(Eb+Eim+Ein)*R1) - ! where Eo is an empirical constant ( = 3.) - ! Ustar is the friction velocity - ! Collection efficiency from - ! Eb, [Brownian diffusion] - ! Eim, [Impaction] - ! Ein, [Interception] - ! R1 is the correction factor representing the fraction - ! of particles that stick to the surface. - !======================================================================= - ! Eb is a funciont of Schmidt number, Eb = Sc^(-gamma) - ! Sc = v/D, v (the kinematic viscosity of air) - ! D (particle brownian diffusivity) - ! r usually lies between 1/2 and 2/3 - ! Eim is a function of Stokes number, St - ! St = Vs * Ustar / (g0 * A) for vegetated surfaces - ! St = Vs * Ustar * Ustar / v for smooth surface - ! A is the characteristic radius of collectors. - ! - ! 1) Slinn (1982) - ! Eim = 10^(-3/St) for smooth surface - ! Eim = St^2 / ( 1 + St^2 ) for vegetative canopies - ! 2) Peters and Eiden (1992) - ! Eim = ( St / ( alpha + St ) )^(beta) - ! alpha(=0.8) and beta(=2) are constants - ! 3) Giorgi (1986) - ! Eim = St^2 / ( 400 + St^2 ) for smooth surface - ! Eim = ( St / (0.6 + St) )^(3.2) for vegetative surface - ! 4) Davidson et al.(1982) - ! Eim = St^3 / (St^3+0.753*St^2+2.796St-0.202) for grassland - ! 5) Zhang et al.(2001) used 2) method with alpha varying with - ! vegetation type and beta equal to 2 - ! - ! Ein = 0.5 * ( Dp / A )^2 - ! - ! R1 (Particle rebound) = exp(-St^0.5) - !================================================================= - - ! Particle diameter [m] - ! A_RADI & A_DEN are read from inputs. - DIAM = A_RADI * 2.e+0_fp - - ! Particle density [kg/m3] - DEN = A_DEN - - !update DIAM of dust species; no hygroscopic growth for dust - !TODO: here we comment out these hardcoded lines and use the radius from inputs directly - !IF ( K == idd_DST1 .or. K == idd_DSTAL1 .or. K == idd_NITD1 .or. K == idd_SO4D1 ) THEN - !IF ( SPC == 'DST1' .or. SPC == 'DSTAL1' .or. SPC == 'NITD1' .or. SPC == 'SO4D1' .or. SPC == 'dust1') THEN - ! DIAM = 0.66895E-6 - !ENDIF - - !IF ( K == idd_DST2 .or. K == idd_DSTAL2 .or. K == idd_NITD2 .or. K == idd_SO4D2 ) THEN - !IF ( SPC == 'DST2' .or. SPC == 'DSTAL2' .or. SPC == 'NITD2' .or. SPC == 'SO4D2' .or. SPC == 'dust2') THEN - ! DIAM = 2.4907E-6 - !ENDIF - - !IF ( K == idd_DST3 .or. K == idd_DSTAL3 .or. K == idd_NITD3 .or. K == idd_SO4D3 ) THEN - !IF ( SPC == 'DST3' .or. SPC == 'DSTAL3' .or. SPC == 'NITD3' .or. SPC == 'SO4D3' ) THEN - ! DIAM = 4.164E-6 - !ENDIF - - !IF ( K == idd_DST4 .or. K == idd_DSTAL4 .or. K == idd_NITD4 .or. K == idd_SO4D4 ) THEN - !IF ( SPC == 'DST4' .or. SPC == 'DSTAL4' .or. SPC == 'NITD4' .or. SPC == 'SO4D4' ) THEN - ! DIAM = 6.677E-6 - !ENDIF - - ! Hygroscopic growth following Latimer and Martin (2019) ACP - RHBL = MAX( TINY(RHB), RHB ) - - ! Over oceans the RH in the viscous sublayer is set to 98%, - ! following Lewis and Schwartz (2004) - IF (LUC == 14) THEN - RHBL = 0.98_fp - ENDIF - - IF (.NOT. IS_DUST) THEN - !update DIAM and DEN after hygroscopic growth for non-dust species - call New_DIAM_DEN( SPC, IS_SEASALT, RHBL, RDRY, RWET, DIAM, DEN, RC) - if (RC /= CC_SUCCESS ) then - errMsg = 'New_DIAM_DEN failed.' - CALL CC_Error( errMsg, RC, thisLoc ) - RETURN - endif - ENDIF - - ! Dp [m] --> [um] = particle diameter if necessary - IF (DIAM > 0.001) THEN !here use 0.001 to determine if the unit is in m or um - DP = DIAM - DIAM = DIAM * 1.e-6_fp - ELSE - DP = DIAM * 1.e+6_fp - ENDIF - - ! Constant for settling velocity calculation - CONST = DEN * DIAM**2 * g0 / 18.e+0_fp - - !================================================================= - ! Slip correction factor calculations following Seinfeld, - ! pp464 which is thought to be more accurate but more computation - ! required. - ! # air molecule number density - ! num = P * 1d3 * 6.023d23 / (8.314 * Temp) - ! # gas mean free path - ! lambda = 1.d6/( 1.41421 * num * 3.141592 * (3.7d-10)**2 ) - ! # Slip correction - ! Slip = 1. + 2. * lambda * (1.257 + 0.4 * exp( -1.1 * Dp & - ! / (2. * lambda))) / Dp - ! - ! Note, Eq) 3.22 pp 50 in Hinds (Aerosol Technology) - ! which produce slip correction factore with small error - ! compared to the above with less computation. - !================================================================= - - ! Slip correction factor as function of (P*dp) - PDP = PRESS * DP - SLIP = 1e+0_fp + ( 15.60e+0_fp + 7.0e+0_fp * & - EXP( -0.059e+0_fp * PDP) ) / PDP - - ! Viscosity [Pa s] of air as a function of temp (K) - VISC = 1.458e-6_fp * (TEMP)**(1.5e+0_fp) / (TEMP + 110.4e+0_fp) - - ! Kinematic viscosity (Dynamic viscosity/Density) - AIRVS= VISC / 1.2928e+0_fp - - ! Settling velocity [m/s] - VTS = CONST * SLIP / VISC - !sea salt VTS update - IF (IS_SEASALT) THEN - ! This settling velocity is for the mid-point of the size bin. - ! Need to integrate over the size bin, taking into account the - ! mass distribution of sea-salt and the dependence of VTS on aerosol - ! size. See WET_SETTLING in SEASALT_MOD.f for more details. - - !TODO: this may be used in initialization of the scheme - !Number of bins for sea salt size distribution - !SALA_radius_bin_in_um: [0.01, 0.5]; SALC_radius_bin_in_um: [0.5, 8.0] - - ! Make sure that SALA, SALC bins are contiguous - !IF ( SALA_REDGE_um(2) /= SALC_REDGE_um(1) ) THEN - ! MSG = 'SALA and SALC bin edges are not contiguous!' - ! CALL ERROR_STOP( MSG, LOCATION ) - !ENDIF - !TODO: need to figure out how to read in these values from the namelist - NR = INT((( MAXVAL(UPPERBIN) - MINVAL(LOWERBIN) ) / DR ) + 0.5e+0_fp ) - - SALT_MASS_TOTAL = 0e+0_fp - VTS_WEIGHT = 0e+0_fp - - ! Dry particle radius [m] --> [um] - RUM = RDRY * 1.e+6_fp - - ! Check what the min/max range of the SS size bins are - !IF ( RUM .le. SALA_REDGE_um(2) ) THEN - ! D0 = SALA_REDGE_um(1)*2e+0_fp - ! D1 = SALA_REDGE_um(2)*2e+0_fp - !ELSE - ! D0 = SALC_REDGE_um(1)*2e+0_fp - ! D1 = SALC_REDGE_um(2)*2e+0_fp - !ENDIF - D0 = 0e+0_fp; D1 = 0e+0_fp; n1=1 - DO n =1, size(UPPERBIN) - IF ( (RUM .ge. LOWERBIN(n)) .and. (RUM .le. UPPERBIN(n)) ) THEN - D0 = LOWERBIN(n)*2e+0_fp - D1 = UPPERBIN(n)*2e+0_fp - n1=0 - EXIT - ENDIF - ENDDO - IF (n1 > 0) THEN ! D0 and D1 may not be set properly - errMsg = 'Sea salt radius is not in any bins. Check the species namelist.' - CALL CC_Error( errMsg, RC, thisLoc ) - RETURN - ENDIF - - DO ID = 1, NR - ! Calculate mass of wet aerosol (Dw = wet diameter, D = dry diameter): - ! Overall = dM/dDw = dV/dlnD * Rwet/Rdry * DEN /Rw - !TODO: DMID is not defined in this module. Need to define it. - IF (DMID(ID) .ge. D0 .and. DMID(ID) .le. D1 ) THEN - DMIDW = DMID(ID) * RWET/RDRY ! wet radius [um] - SALT_MASS = SALT_V(ID) * RWET/RDRY * DEN / & - (DMIDW*0.5e+0_fp) - VTS_WEIGHT = VTS_WEIGHT + & - !SALT_MASS * VTS * (DMIDW/(RWET*1d6*2e+0_fp) )** & - SALT_MASS * VTS * (DMIDW/(RWET*1e+6_fp*2e+0_fp) )** & - 2e+0_fp * (2e+0_fp * DR * RWET/RDRY) - SALT_MASS_TOTAL = SALT_MASS_TOTAL+SALT_MASS * & - (2e+0_fp * DR * RWET/RDRY) - ENDIF - ENDDO - - ! Final mass weighted setting velocity: - VTS = VTS_WEIGHT/SALT_MASS_TOTAL - END IF - - VTSout = VTS !need to save out for final Vd calculation - - ! Brownian diffusion constant for particle (m2/s) - DIFF = BOLTZ * TEMP * SLIP / (3.e+0_fp * PI * VISC * DIAM) - - ! Schmidt number - SC = AIRVS / DIFF - !EB = 1.e+0_fp/SC**(gamma(LUC)) - - !-------------------------------------------------------------- - ! NOTE: This loses precision, use TWO_THIRDS parameter instead - !EB = CB/SC**(0.6667e+0_fp) ! Emerson 2020 update JRP - !-------------------------------------------------------------- - EB = CB/SC**TWO_THIRDS ! Emerson 2020 update JRP - - ! Stokes number - IF ( AA < 0e+0_fp ) then - ST = VTS * USTAR * USTAR / ( AIRVS * g0 ) ! for smooth surface - EIN = 0e+0_fp - ELSE - ST = VTS * USTAR / ( g0 * AA ) ! for vegetated surfaces - !EIN = 0.5e+0_fp * ( DIAM / AA )**2 - EIN = CIN * ( DIAM / AA )**(UPSILON) ! Emerson 2020 update JRP - ENDIF - - IF (LUC == 14 .and. IS_SEASALT) THEN - EIM = 10.e+0_fp**( -3.e+0_fp/ ST ) ! for water surface - ! JRP: Emerson doesn't describe what to do here, so I'm leaving as is - ELSE - !EIM = ( ST / ( ALPHA(LUC) + ST ) )**(BETA) - EIM = CIM * ( ST / ( ALPHA(LUC) + ST ) )**(BETA) ! Emerson 2020 update JRP - EIM = MIN( EIM, 0.6e+0_fp ) - ENDIF - - IF (LUC == 11 .OR. LUC == 13 .OR. LUC == 14) THEN - R1 = 1.e+0_fp - ELSE - R1 = EXP( -1e+0_fp * SQRT( ST ) ) - ENDIF - - !add error check here to make sure RS below is not a infinite value - IF (rae(R1, 0.0_fp) .or. rae(USTAR, 0.0_fp)) THEN - errMsg = 'USTAR or R1 is zero. Check met field or diameter (in m) of aerosol is too big.' - CALL CC_Error( errMsg, RC, thisLoc ) - RETURN - ENDIF - - ! surface resistance for particle - IF (LUC == 14 .and. IS_SEASALT) THEN - ! Use the formulation of Slinn and Slinn (1980) for the impaction over - ! water surfaces for sea salt - RS = 1.e+0_fp / (USTAR**2.e+0_fp/ (W10*VON_KARMAN) * & - (EB + EIM ) + VTS) - ELSE - RS = 1.e0_fp / (E0 * USTAR * (EB + EIM + EIN) * R1 ) - ENDIF - - END FUNCTION AERO_SFCRSII - - !> - !! \brief updates the diameter and density of non-dust aerosols - !! - !!References: - !! Adapted from GEOS-Chem source code (GeosCore/drydep_mod.F90) - !! ADUST_SFCRSII and AERO_SFCRSII functions - !! - !! \param SPC Species name - !! \param IS_SEASALT Is seasalt species? - !! \param RHBL Relative humidity [unitless] - !! \param RDRY Dry radius of particle [m] - !! \param RWET Wet radius of particle [m] - !! \param DIAM diameter of wet particle [m] - !! \param DEN density of particle [kg/m3] - !! \param RC return code - !! - !! \ingroup catchem_drydep_process - !!!> - SUBROUTINE New_DIAM_DEN( SPC, IS_SEASALT, RHBL, RDRY, RWET, DIAM, DEN, RC) - - IMPLICIT NONE - - !input parameters - character(len=255), INTENT(IN) :: SPC ! Species name - logical, INTENT(IN) :: IS_SEASALT ! Is sea salt species? - !INTEGER, INTENT(IN) :: K ! Drydep species index (range: 1-NUMDEP) - real(fp), INTENT(IN) :: RHBL ! Relative humidity local - real(fp), INTENT(OUT) :: RDRY ! dry radius of particle [m] - real(fp), INTENT(OUT) :: RWET ! wet radius of particle [m] - real(fp), INTENT(INOUT) :: DIAM ! diameter of wet particle [m] - real(fp), INTENT(INOUT) :: DEN ! density of particle [kg/m3] - integer, INTENT(OUT) :: RC ! success flag - !defined parameters - REAL(fp), PARAMETER :: C1 = 0.7674_fp - REAL(fp), PARAMETER :: C2 = 3.079_fp - REAL(fp), PARAMETER :: C3 = 2.573e-11_fp - REAL(fp), PARAMETER :: C4 = -1.424_fp - !REAL(fp), PARAMETER :: E0 = 3.0_fp - - ! Parameters for polynomial coefficients to derive seawater - ! density. From Tang et al. (1997) - REAL(fp), PARAMETER :: A1 = 7.93e-3_fp - REAL(fp), PARAMETER :: A2 = -4.28e-5_fp - REAL(fp), PARAMETER :: A3 = 2.52e-6_fp - REAL(fp), PARAMETER :: A4 = -2.35e-8_fp - REAL(fp), PARAMETER :: EPSI = 1.0e-4_fp - - ! parameters for assumed size distribution of accumulation and coarse - ! mode sea salt aerosols, as described in Jaegle et al. (ACP, 11, 2011) - ! 1) geometric dry mean diameters (microns) - !REAL(fp), PARAMETER :: RG_A = 0.085e+0_fp - !REAL(fp), PARAMETER :: RG_C = 0.4e+0_fp - ! 2) sigma of the size distribution - !REAL(fp), PARAMETER :: SIG_A = 1.5e+0_fp - !REAL(fp), PARAMETER :: SIG_C = 1.8e+0_fp - - !increment of radius for integration of settling velocity (um) - !REAL(fp), PARAMETER :: DR = 5.0e-2_fp - !local variables - real(fp) :: FAC1, FAC2 !Exponential factors for hygroscopic growth - real(fp) :: RUM !Radius of dry particle in micronmeters [um] - REAL(fp) :: RATIO_R !Ratio dry over wet radii - REAL(fp) :: DEN0, DEN1, WTP - integer :: I !Loop index - CHARACTER(LEN=255) :: ErrMsg, thisLoc - - ! Initialize - RC = CC_SUCCESS - errMsg = '' - thisLoc = ' -> at New_DIAM_DEN (in process/drydep/scheme/DryDepScheme_ZHANG_Mod.F90)' - - IF ( .NOT. IS_SEASALT ) THEN - - ! Particle diameter [m] - DIAM = 0.17378e-6_fp - RDRY = DIAM / 2.0e+0_fp !Not needed for further calculations for dust species - - ! SIA (TODO: keep this for now and need to be consistent with real species names in the future) - !IF ( K == idd_NIT .or. K == idd_NH4 .or. K == idd_SO4 ) THEN - IF ( SPC == 'NIT' .or. SPC == 'NH4' .or. SPC == 'SO4' .or. & - SPC == 'nit' .or. SPC == 'nh4' .or. SPC == 'so4' ) THEN - ! Efflorescence transitions - IF (RHBL .LT. 0.35) THEN - ! DIAM is not changed - ELSE IF ((RHBL .GE. 0.35) .AND. (RHBL .LE. 0.40)) THEN - ! Linear hygroscopic growth - DIAM = DIAM + (DIAM * ((1.0_fp + 0.61_fp * 0.40_fp / & - (1.0_fp - 0.40_fp)) ** (1.0_fp / 3.0_fp)) - DIAM) / & - (0.40_fp - 0.35_fp) * (RHBL - 0.35_fp) - ELSE - ! Kohler hygroscopic growth - DIAM = DIAM * ((1.0_fp + 0.61_fp * RHBL / (1.0_fp - RHBL)) & - ** (1.0_fp / 3.0_fp)) - ENDIF - - !BC - !ELSE IF ( K == idd_BCPI .OR. K == idd_BCPO ) THEN - ELSE IF ( SPC == 'BCPI' .OR. SPC == 'BCPO' .OR. & - SPC == 'bcpi' .OR. SPC == 'bcpo' ) THEN - ! DIAM is not changed - - !OA - ELSE - DIAM = DIAM * ((1.0_fp + 0.1_fp * RHBL / (1.0_fp - RHBL)) & - ** (1.0_fp / 3.0_fp)) - ENDIF - - !get RWET - RWET = DIAM / 2.0e+0_fp - ! Particle density [kg/m3]; same for all aerosols except sea salt and dust - DEN = 1500 - - ELSE !sea salt aerosol case - - !drydepRadius = A_RADI(K) - RDRY = DIAM / 2.0e+0_fp - - ! Coarse seasalt (TODO: we commented out these hardcoded lines and use the radius from inputs directly) - !IF ( K == idd_NITS .or. K == idd_SALC .or. K == idd_SO4S .or. K == idd_BRSALC .or. K == idd_ISALC ) THEN - !IF ( SPC == 'NITS' .or. SPC == 'SALC' .or. SPC == 'SO4S' .or. SPC == 'BRSALC' .or. SPC == 'ISALC' ) THEN - ! RDRY = 0.74025E-6 - !ENDIF - - !IF ( K == idd_SALA .OR. K == idd_BRSALA .or. K == idd_ISALA ) THEN - !IF ( SPC == 'SALA' .OR. SPC == 'BRSALA' .or. SPC == 'ISALA' ) THEN - ! RDRY = 0.114945E-6 - !ENDIF - - ! Dry particle radius [um] - RUM = RDRY * 1.e+6_fp - - ! Exponential factors used for hygroscopic growth (not used now) - FAC1 = C1 * ( RUM**C2 ) - FAC2 = C3 * ( RUM**C4 ) - - ! Corrected bug in Gerber formulation: use of LOG10 (jaegle 5/11/11) - !RWET = 0.01e+0_fp*(FAC1/(FAC2-DLOG(RHBL))+RCM**3.e+0_fp)**0.33e+0_fp - !RWET = 1.d-6*(FAC1/(FAC2-LOG10(RHBL))+RUM**3.e+0_fp)**0.33333e+0_fp - - ! Use equation 5 in Lewis and Schwartz (2006) for sea salt growth [m] - ! (jaegle 5/11/11) - RWET = RDRY * (4.e+0_fp / 3.7e+0_fp) * & - ( (2.e+0_fp - RHBL)/(1.e+0_fp - RHBL) )**(1.e+0_fp/3.e+0_fp) - - ! Ratio dry over wet radii at the cubic power - !RATIO_R = ( A_RADI(K) / RWET )**3.e+0_fp - - ! Diameter of the wet aerosol [m] - DIAM = RWET * 2.e+0_fp - - ! Density of the wet aerosol [kg/m3] (bec, 12/8/04) - !DEN = RATIO_R * A_DEN(K) + ( 1.e+0_fp - RATIO_R ) * 1000.e+0_fp - - ! Above density calculation is chemically unsound because it ignores chemical solvation. - ! Iteratively solve Tang et al., 1997 equation 5 to calculate density of wet aerosol (kg/m3) - ! Redefine RATIO_R - RATIO_R = RDRY / RWET - - ! Assume an initial density of 1000 kg/m3 - DEN0 = DEN !assign initial DEN to DEN0 - DEN = 1000.e+0_fp - DEN1 = 0.e+0_fp !initialize - i = 0 !initialize loop index - !Note that if RH is too low, the loop will not converge and will run forever - DO WHILE ( ABS( DEN1-DEN ) .gt. EPSI ) - ! First calculate weight percent of aerosol (kg_RH=0.8/kg_wet) - WTP = 100.e+0_fp * DEN0/DEN * RATIO_R**3.e+0_fp - ! Then calculate density of wet aerosol using equation 5 - ! in Tang et al., 1997 [kg/m3] - DEN1 = ( 0.9971e+0_fp + (A1 * WTP) + (A2 * WTP**2) + & - (A3 * WTP**3) + (A4 * WTP**4) ) * 1000.e+0_fp - - ! Now calculate new weight percent using above density calculation - WTP = 100.e+0_fp * DEN0/DEN1 * RATIO_R**3.e+0_fp - ! Now recalculate new wet density [kg/m3] - DEN = ( 0.9971e+0_fp + (A1 * WTP) + (A2 * WTP**2) + & - (A3 * WTP**3) + (A4 * WTP**4) ) * 1000.e+0_fp - - ! add some protection against infinite loop - i = i+1 - IF ( i .GT. 500 ) THEN - errMsg = 'Error in calculating new density for sea salt aerosol due to very low RH input!' - CALL CC_Error( errMsg, RC, thisLoc ) - RETURN - ENDIF - - ENDDO - ENDIF - - END SUBROUTINE New_DIAM_DEN - - !> - !! \brief calculates the volume size distribution of sea-salt. - !! This only has to be done once. We assume that sea-salt is the - !! combination of a coarse mode and accumulation model log-normal - !! distribution functions. The resulting arrays are: DMID = diameter - !! of bin and SALT_V = dV/dln(D) [in um3]. - !! - !!References: - !! Adapted from GEOS-Chem source code (GeosCore/drydep_mod.F90) - !! INIT_WEIGHTSS function - !! - !! - !! \param SALT_RLOW_um lowest edge of sea salt radius [um] - !! \param SALT_RUP_um uppest edge of sea sakt radius [um] - !! - !! \ingroup catchem_drydep_process - !!!> - - SUBROUTINE INIT_WEIGHTSS( SALT_RLOW_um, SALT_RUP_um, RC ) - - IMPLICIT NONE - !INPUT PARAMETERS: - real(fp), INTENT(IN) :: SALT_RLOW_um ! lowest edge of sea salt radius [um] - real(fp), INTENT(IN) :: SALT_RUP_um ! uppest edge of sea sakt radius [um] - INTEGER, INTENT(INOUT) :: RC ! Success or failure - !LOCAL VARIABLES: - !INTEGER :: N - REAL(fp) :: DEDGE - INTEGER :: ID,NR - !DEFINED PARAMETERS: - ! increment of radius for integration of settling velocity (um) - REAL(fp), PARAMETER :: DR = 5.e-2_fp - - ! parameters for assumed size distribution of acc and coarse mode - ! sea salt aerosols - ! geometric dry mean diameters (microns) - REAL(fp), PARAMETER :: RG_A = 0.085e+0_fp - REAL(fp), PARAMETER :: RG_C = 0.4e+0_fp - ! sigma of the size distribution - REAL(fp), PARAMETER :: SIG_A = 1.5e+0_fp - REAL(fp), PARAMETER :: SIG_C = 1.8e+0_fp - ! Error handling - !--------------- - CHARACTER(LEN=255) :: ErrMsg - CHARACTER(LEN=255) :: ThisLoc - - !================================================================= - ! INIT_WEIGHTSS begins here! - !================================================================= - ErrMsg = '' - ThisLoc = ' -> at INIT_WEIGHTSS (in process/drydep/schemes/DryDepScheme_ZHANG_Mod.F90)' - - ! Number of bins between the lowest bound of of the accumulation mode - ! sea salt and the upper bound of the coarse mode sea salt. - NR = INT((( SALT_RUP_um - SALT_RLOW_um ) / DR ) + 0.5e+0_fp ) - - ALLOCATE( DMID( NR ), STAT=RC ) - IF ( RC /= CC_SUCCESS ) THEN - ErrMsg = 'Could not allocate array DMID' - CALL CC_Error( ErrMsg, RC, ThisLoc ) - RETURN - END IF - DMID = 0e+0_fp - - ALLOCATE( SALT_V( NR ), STAT=RC ) - IF ( RC /= CC_SUCCESS ) THEN - ErrMsg = 'Could not allocate array SALT_V' - CALL CC_Error( ErrMsg, RC, ThisLoc ) - RETURN - END IF - SALT_V = 0e+0_fp - - !================================================================= - ! Define the volume size distribution of sea-salt. This only has - ! to be done once. We assume that sea-salt is the combination of a - ! coarse mode and accumulation model log-normal distribution functions - !================================================================= - - ! Lower edge of 0th bin diameter [um] - DEDGE=SALT_RLOW_um * 2e+0_fp - - ! Loop over diameters - DO ID = 1, NR - - ! Diameter of mid-point in microns - DMID(ID) = DEDGE + ( DR ) - - ! Calculate the dry volume size distribution as the sum of two - ! log-normal size distributions. The parameters for the size - ! distribution are based on Reid et al. and Quinn et al. - ! The scaling factors 13. and 0.8 for acc and coarse mode aerosols - ! are chosen to obtain a realistic distribution - ! SALT_V (D) = dV/dln(D) [um3] - SALT_V(ID) = PI / 6e+0_fp* (DMID(ID)**3) * ( & - 13e+0_fp*exp(-0.5_fp*( LOG(DMID(ID))- & - LOG(RG_A*2e+0_fp) )**2e+0_fp/ & - LOG(SIG_A)**2e+0_fp ) & - /( sqrt(2e+0_fp * PI) * LOG(SIG_A) ) + & - 0.8e+0_fp*exp(-0.5_fp*( LOG(DMID(ID))- & - LOG(RG_C*2e+0_fp) )**2e+0_fp/ & - LOG(SIG_C)**2e+0_fp) & - /( sqrt(2e+0_fp * PI) * LOG(SIG_C) ) ) - - ! update the next edge - DEDGE = DEDGE + DR*2e+0_fp - ENDDO - - END SUBROUTINE INIT_WEIGHTSS - - !> - !! \brief calculates the molecular diffusivity [m2/s] in air for a gas X - !! of molecular weight XM [kg] at temperature TK [K] and pressure PRESS [Pa]. - !! - !!References: - !! - !! \param TK Temperatue [K] - !! \param PRESS Pressure [Pa] - !! \param XM Molecular weight of gas [kg] - !! - !! \ingroup catchem_drydep_process - !!!> - - FUNCTION DIFFG( TK, PRESS, XM ) RESULT( DIFF_G ) - - !INPUT PARAMETERS: - REAL(fp), INTENT(IN) :: TK ! Temperature [K] - REAL(fp), INTENT(IN) :: PRESS ! Pressure [Pa] - REAL(fp), INTENT(IN) :: XM ! Molecular weight of gas [kg] - !LOCAL VARIABLES: - REAL(fp) :: AIRDEN, Z, DIAM, FRPATH, SPEED, DIFF_G - - !REMARKS: - !We specify the molecular weight of air (XMAIR) and the hard-sphere molecular - !radii of air (RADAIR) and of the diffusing gas (RADX). The molecular - !radius of air is given in a Table on p. 479 of Levine [1988]. The Table - !also gives radii for some other molecules. Rather than requesting the user - !to supply a molecular radius we specify here a generic value of 1.2E-10 m for - !all molecules, which is good enough in terms of calculating the diffusivity - !as long as molecule is not too big. - - !DEFINED PARAMETERS: - REAL(fp), PARAMETER :: XMAIR = 28.8e-3_fp ! Moist air molec wt? - REAL(fp), PARAMETER :: RADAIR = 1.2e-10_fp - REAL(fp), PARAMETER :: RADX = 1.5e-10_fp - - !================================================================= - ! DIFFG begins here! - !================================================================= - - ! Air density [molec/m3] - AIRDEN = ( PRESS * AVO ) / ( RSTARG * TK ) - - ! DIAM is the collision diameter for gas X with air. - DIAM = RADX + RADAIR - - ! Calculate the mean free path for gas X in air: - ! eq. 8.5 of Seinfeld [1986]; - Z = XM / XMAIR - FRPATH = 1e+0_fp /( PI * SQRT( 1e+0_fp + Z ) * AIRDEN * ( DIAM**2 ) ) - - ! Calculate average speed of gas X; eq. 15.47 of Levine [1988] - SPEED = SQRT( 8e+0_fp * RSTARG * TK / ( PI * XM ) ) - - ! Calculate diffusion coefficient of gas X in air; - ! eq. 8.9 of Seinfeld [1986] - DIFF_G = ( 3e+0_fp * PI / 32e+0_fp ) * ( 1e+0_fp + Z ) * FRPATH * SPEED - - END FUNCTION DIFFG - - !> - !! \brief calculates the Ra and Rb term in the Wesely scheme - !! - !!References: - !! Wesely, M. L. "Parameterization of surface resistances to gaseous dry deposition in - !! regional-scale numerical models." Atmospheric environment 41 (2007): 52-63. - !! https://doi.org/10.1016/0004-6981(89)90153-4 - !! - !! \param TEMPK Temperatue [K] - !! \param PRESSU Pressure [Pa] - !! \param XMW Molecular weight [kg/mol] - !! \param USTAR Fictional Velocity [m/s] - !! \param OBK Monin-Obhukov length [m] - !! \param ZO Roughness length [m] - !! \param THIK height of first model layer [m] - !! \param IS_GAS flag for gas - !! \param Ra output of aerodynamic resistance [s/m] - !! \param Rb output of quasi-laminar boundary layer resistance [s/m] - !! \param RC Success or failure? - !! - !! \ingroup catchem_drydep_process - !!!> - subroutine Wesely_Ra_Rb(TEMP, PRESSU, XMW, USTAR, OBK, ZO, THIK, IS_GAS, Ra, Rb, RC) - IMPLICIT NONE - ! Parameters - !----------- - real(fp), intent(in) :: TEMP !< Temperature [K] - real(fp), intent(in) :: PRESSU !< Pressure [Pa] - real(fp), intent(in) :: XMW !< Molecular weight [kg/mol] - real(fp), intent(in) :: USTAR !< Friction velocity [m/s] - real(fp), intent(in) :: OBK !< Monin-Obhukov length [m] - real(fp), intent(in) :: ZO !< Roughness length [m] - real(fp), intent(in) :: THIK !< height of first model layer [m] - logical, intent(in) :: IS_GAS !< flag for gas - !output - real(fp), intent(out) :: Ra !< aerodynamic resistance [s/m] - real(fp), intent(out) :: Rb !< quasi-laminar boundary layer resistance [s/m] - integer, intent(out) :: RC !< Success or failure? - - ! Local Variables - !---------------- - real(fp) :: C1,CZ,XNU - real(fp) :: CKUSTR,REYNO,CORR1,CORR2,Z0OBK - real(fp) :: DUMMY1,DUMMY2,DUMMY3,DUMMY4 - real(fp) :: DAIR,TEMPK,TEMPC - logical :: LRGERA !stable atmosphere; a high aerodynamic resistance (RA=1.E4 m s-1) is imposed; else RA is calculated - !string - character(len=255) :: thisLoc - character(len=512) :: ErrMsg - - !-------------------------------------------- - ! main function - !-------------------------------------------- - - ! Assume success - RC = CC_SUCCESS - ErrMsg = '' - ThisLoc = ' -> at Wesely_Ra_Rb (in process/drydep/scheme/DryDepScheme_ZHANG_Mod.F90)' - - ! Zero variables that aren't zeroed below - CZ = 0.0_fp - CKUSTR = 0.0_fp - REYNO = 0.0_fp - CORR1 = 0.0_fp - CORR2 = 0.0_fp - Z0OBK = 0.0_fp - DUMMY1 = 0.0_fp - DUMMY2 = 0.0_fp - DUMMY3 = 0.0_fp - DUMMY4 = 0.0_fp - DAIR = 0.0_fp - Ra = 0.0_fp - Rb = 0.0_fp - - !CZ is Altitude (m) at which deposition velocity is computed - !use Midpoint height of first model level [m] - CZ = THIK / 2.0e+0_fp - - !** TEMPK and TEMPC are surface air temperatures in K and in C - TEMPK = TEMP - TEMPC = TEMP-273.15e+0_fp - - !** Calculate the kinematic viscosity XNU (m2 s-1) of air - !** as a function of temperature. - !** The kinematic viscosity is used to calculate the roughness heights - !** over water surfaces and to diagnose whether such surfaces are - !** aerodynamically rough or smooth using a Reynolds number criterion. - !** The expression for the temperature dependence of XNU - !** is from the FORTRAN code in Appendix II of Wesely [1988]; - !** I wasn't able to find an original reference but it seems benign enough. - C1 = TEMPK/273.15e+0_fp - XNU = 0.151e+0_fp*(C1**1.77e+0_fp)*1.0e-04_fp - - !***** Get aerodynamic resistances Ra and Rb. *********** - ! The aerodynamic resistance Ra is integrated from altitude z0+d up - ! to the altitude z1 at which the dry deposition velocity is to be - ! referenced. The integration corrects for stability using Monin- - ! Obukhov similarity formulas from Businger et al. [1971] which - ! apply over the range -2.5 < z/zMO < 1.5 (see their Figure 2). - ! Under very unstable conditions when z1 > -2.5 zMO, we assume that - ! there is no resistance to transfer in the convective column - ! between zMO and z1. Under very stable conditions when z1 > 1.5 zMO - ! we assume that vertical transfer in the column between zMO and z1 - ! is strongly suppressed so that the deposition velocity at altitude - ! z1 is very low. Under these conditions we just specify a very - ! large Ra=1.E4 s m-1 (LRGERA = T). - !** - ! The Reynolds number REYNO diagnoses whether a surface is - ! aerodynamically rough (REYNO > 1) or smooth. - ! - ! NOTE: The criterion "REYNO > 1" was originally "REYNO > 10". See - ! below for an explanation of why it was changed (hyl, 10/15/99) - ! - ! Surface is rough in all cases except over water with low wind - ! speeds. In the smooth case, vertical transport IN THE SUBLAYER - ! near the surface is limited by molecular diffusion and is - ! therefore very slow; we assign a large value we assign a large - ! value of Ra + Rb to account for this effect. [In Versions 3.2 - ! and earlier we used the formulation for Ra + Rb given in Equation - ! (12) of Walcek et al [1986] to calculate the aerodynamic - ! resistance over smooth surfaces. However, that expression fails - ! when u* is very small, as it yields negative values of Ra + Rb]. - ! (djj, hyl, bmy, 5/8/00) - !** - ! In the aerodynamically rough case, the expression for Ra is as - ! given in equation (5) of Jacob et al. [1992]: - ! - ! Ra = (1/ku*)*int(from z0 to z1) (phi(x)/z)dz - ! - ! where x = (z-D)/zMO, z is the height above ground, and D is the - ! displacement height which is typically 70-80% of the canopy - ! height [Brutsaert, 1982]. We change the vertical coordinate so - ! that z=0 at the displacement height; that's OK since for all - ! practical applications z1 >> D. In this manner we don't need - ! to assume any specific value for the displacement height. - ! Applying the variable transformation z -> x = z/zMO, the equation - ! above becomes - ! - ! Ra = (1/ku*)*int(from x0 to x1) (phi(x)/x)dx with x=z/zMO - ! - ! Here phi is a stability correction function originally formulated - ! by Businger et al. [1971] and given in eqns 5a and 5b of Jacob et - ! al. [1992]. For unstable conditions, - ! - ! phi(x) = a/sqrt(1-bx) where a=0.74, b = 9 - ! - ! The analytical solution to the integral is [Dwight, 1957, - ! integral 192.11]: - ! - ! int(dx/(x*sqrt(1-bx))) = log(abs((sqrt(1-bx)-1) - ! /(sqrt(1-bx)+1))) - ! - ! which yields the expression for Ra used in the code for - ! unstable conditions. For stable conditions, - ! - ! phi(x) = a + bx where a=0.74, b = 4.7 - ! - ! and the analytical solution to the integral is - ! - ! int((a/x)+b)dx = a*ln(x) + bx - ! - ! which yields the expression of Ra used in the code for stable - ! conditions. - !** - ! The formulation of RB for gases is equation (12) of Walcek et al. - ! [1986]. The parameterization for deposition of aerosols does not - ! include an RB term so RB for aerosols is set to zero. - ! Modify phi(x) according to the non-local mixing scheme - ! by Holtslag and Boville [1993] ( Lin, 07/18/08 ) - ! For unstable conditions, - ! phi(x) = a/sqrt(1-bx) where a=1.0, b=15.0 - ! - ! For stable conditions, - ! phi(x) = a + bx - ! where a=1.0, b=5.0 for 0 <= x <= 1, and - ! a=5.0, b=1.0 for x > 1.0 - !******************************************************** - - CKUSTR = VON_KARMAN * USTAR - REYNO = USTAR*ZO/XNU - CORR1 = CZ/OBK - ! Define Z0OBK - Z0OBK = ZO/OBK - - LRGERA = .FALSE. - ! Add option for non-local PBL - !IF (.NOT. LNLPBL) THEN - ! IF (CORR1 .GT. 0.e+0_fp) THEN - ! IF (CORR1 .GT. 1.5e+0_fp) LRGERA = .TRUE. - ! ELSEIF(CORR1 .LE. 0.e+0_fp) THEN - ! IF (CORR1 .LE. -2.5e+0_fp) CORR1 = -2.5e+0_fp - ! CORR2 = LOG(-CORR1) - ! ENDIF - !ENDIF - - !use rae function from pecision_mod to avoid "equality comparison for real" warning - IF ( rae(CKUSTR, 0.0e+0_fp) ) THEN - ErrMsg = 'CKUSTR cannot be zero.' - CALL CC_Error( ErrMsg, RC, ThisLoc ) - RETURN ! debug - ENDIF - - !...aerodynamically rough or smooth surface - ! "In the classic study by Nikuradse (1933) the transition from - ! smooth to rough was examined in pipe flow. He introduced a - ! roughness Reynolds number Rr = U* Z0 / Nu and found the flow to - ! be smooth for Rr < 0.13 and rough for Rr > 2.5 with a transition - ! regime in between." (E.B. Kraus and J.A. Businger, Atmosphere-Ocean - ! Interaction, second edition, P.144-145, 1994). - ! Similar statements can be found in the books: Evaporation into the - ! atmosphere, by Wilfried Brutsaert ,P.59,89, 1982; or Seinfeld & - ! Pandis, P.858, 1998. - ! Here we assume a sudden transition point Rr = 1 from smooth to - ! rough, following L. Merlivat (1978, The dependence of bulk - ! evaporation coefficients on air-water interfacial conditions as - ! determined by the isotopic method, J. Geophys. Res., Oceans & - ! Atmos., 83, C6, 2977-2980). Also refer to Brutsaert's book, P.125. - ! We used to use the criterion "REYNO > 10" for aerodynamically rough - ! surface and now change to "REYNO > 1". (hyl, 10/15/99) - ! D. J. Jacob change the criterion for aerodynamically rough - ! surface to REYNO > 0.1 - IF ( REYNO >= 0.1e+0_fp ) THEN !rough surface - ! Add option for non-local PBL - !TODO: we only use non-local option - !IF (.NOT. LNLPBL) THEN - - !...aerodynamically rough surface. - !* - ! IF (CORR1.LE.0.0e+0_fp .AND. Z0OBK .LT. -1.e+0_fp)THEN - !*... unstable condition; set RA to zero. - !* (first implemented in V. 3.2) - ! RA = 0.e+0_fp - !*... error trap: prevent CORR1 or Z0OBK from being - !*... zero or close to zero (ckeller, 3/15/16) - ! ELSEIF ( ABS(CORR1)<=SMALL .OR. ABS(Z0OBK)<=SMALL ) THEN - ! RA = 0.e+0_fp - ! ELSEIF (CORR1.LE.0.0e+0_fp .AND. Z0OBK .GE. -1.e+0_fp) THEN - !*... unstable conditions; - !*... compute Ra as described above - ! DUMMY1 = (1.e+0_fp - 9e+0_fp*CORR1)**0.5e+0_fp - ! DUMMY2 = (1.e+0_fp - 9e+0_fp*Z0OBK)**0.5e+0_fp - ! DUMMY3 = ABS((DUMMY1 - 1.e+0_fp)/(DUMMY1 + 1.e+0_fp)) - ! DUMMY4 = ABS((DUMMY2 - 1.e+0_fp)/(DUMMY2 + 1.e+0_fp)) - ! RA = 0.74e+0_fp* (1.e+0_fp/CKUSTR) * LOG(DUMMY3/DUMMY4) - - ! ELSEIF((CORR1.GT.0.0e+0_fp).AND.(.NOT.LRGERA)) THEN - !*... moderately stable conditions (z/zMO <1); - !*... compute Ra as described above - ! RA = (1e+0_fp/CKUSTR) * (.74e+0_fp*LOG(CORR1/Z0OBK) + & - ! 4.7e+0_fp*(CORR1-Z0OBK)) - ! ELSEIF(LRGERA) THEN - !*... very stable conditions - ! RA = 1.e+04_fp - ! ENDIF - !* check that RA is positive; if RA is negative (as occasionally - !* happened in version 3.1) send a warning message. - - !ELSE !not using non-local PBL - - IF (CORR1.LT.0.0e+0_fp) THEN - !*... unstable conditions; compute Ra as described - !*... above. - !coef_a=1.e+0_fp - !coef_b=15.e+0_fp - DUMMY1 = (1.e+0_fp - 15.e+0_fp*CORR1)**0.5e+0_fp - DUMMY2 = (1.e+0_fp - 15.e+0_fp*Z0OBK)**0.5e+0_fp - DUMMY3 = ABS((DUMMY1 - 1.e+0_fp)/(DUMMY1 + 1.e+0_fp)) - DUMMY4 = ABS((DUMMY2 - 1.e+0_fp)/(DUMMY2 + 1.e+0_fp)) - RA = 1.e+0_fp * (1.e+0_fp/CKUSTR) * LOG(DUMMY3/DUMMY4) - - ELSEIF((CORR1.GE.0.0e+0_fp).AND.(CORR1.LE.1.0e+0_fp)) THEN - !coef_a=1.e+0_fp - !coef_b=5.e+0_fp - RA = (1.e+0_fp/CKUSTR) * (1.e+0_fp*LOG(CORR1/Z0OBK) + & - 5.e+0_fp*(CORR1-Z0OBK)) - - ELSE ! CORR1 .GT. 1.0D0 - !coef_a=5e+0_fp - !coef_b=1.e+0_fp - RA = (1.e+0_fp/CKUSTR) * (5.e+0_fp*LOG(CORR1/Z0OBK) + & - 1.e+0_fp*(CORR1-Z0OBK)) - ENDIF - - !* check that RA is positive and maximize at 1.E4 s m-1 - RA = MIN(RA,1.e+4_fp) - ! If RA is < 0, set RA = 0 - IF (RA .LT. 0.e+0_fp) RA = 0.0e+0_fp - - !END IF !PBL or non-local PBL options - - !get Rb for a gas species; arosol Rb is set to zero - !** DAIR is the thermal diffusivity of air; value 0.2*1.E-4 m2 s-1 cited on p. 16,476 of - !** Jacob et al. [1992] - DAIR = 0.2e0_fp*1.e-4_fp - IF (IS_GAS) THEN - RB = (2.e+0_fp/CKUSTR)* (DAIR/DIFFG(TEMPK,PRESSU,XMW)) & - **0.667e+0_fp - END IF - - ELSE !smooth surface - !** suppress drydep over smooth surfaces by setting Ra to - !** a large value (1e4). This prevents negative dry deposition - !** velocities when u* is very small. Rb is not important in that case since - !** the total resistentce is Ra + Rb. So we set Rb to zero. - RA = 1.e+4_fp - - END IF - - end subroutine Wesely_Ra_Rb - - - -end module DryDepScheme_ZHANG_Mod diff --git a/src/process/drydep/schemes/DryDepScheme_ZHANG_Mod.F90 b/src/process/drydep/schemes/DryDepScheme_ZHANG_Mod.F90 index c4320ec5..3bf8f43a 100644 --- a/src/process/drydep/schemes/DryDepScheme_ZHANG_Mod.F90 +++ b/src/process/drydep/schemes/DryDepScheme_ZHANG_Mod.F90 @@ -32,7 +32,7 @@ !! Reference: Zhang et al., 2001; Emerson et al., 2020 module DryDepScheme_ZHANG_Mod - use precision_mod, only: fp, rae + use precision_mod, only: fp, rae, f8 use error_mod, only: CC_SUCCESS, CC_Error use DryDepCommon_Mod, only: DryDepSchemeZHANGConfig use Constants, only: PI, AVO, VON_KARMAN, RSTARG, g0, BOLTZ !load the constants needed for this scheme @@ -174,6 +174,18 @@ module DryDepScheme_ZHANG_Mod !! @param[in] ustar USTAR field [appropriate units] !! @param[in] v10m V10M field [appropriate units] !! @param[in] z0 Z0 field [appropriate units] + !! @param[in] species_mw_g Species mw_g property + !! @param[in] species_radius Species radius property + !! @param[in] species_density Species density property + !! @param[in] species_short_name Species short_name property + !! @param[in] species_dd_hstar Species dd_hstar property + !! @param[in] species_dd_DvzAerSnow Species dd_DvzAerSnow property + !! @param[in] species_dd_DvzMinVal_snow Species dd_DvzMinVal_snow property + !! @param[in] species_dd_DvzMinVal_land Species dd_DvzMinVal_land property + !! @param[in] species_lower_radius Species lower_radius property + !! @param[in] species_upper_radius Species upper_radius property + !! @param[in] species_is_dust Species is_dust property + !! @param[in] species_is_seasalt Species is_seasalt property !! @param[in] species_conc Species concentrations [mol/mol] (num_layers, num_species) !! @param[inout] species_tendencies Species tendency terms [mol/mol/s] (num_layers, num_species) !! @param[inout] drydep_con_per_species Dry deposition concentration per species [ug/kg or ppm] (num_species) @@ -240,7 +252,7 @@ subroutine compute_zhang( & real(fp), intent(in) :: species_mw_g(num_species) ! Species mw_g property real(fp), intent(in) :: species_radius(num_species) ! Species radius property real(fp), intent(in) :: species_density(num_species) ! Species density property - character(len=255), intent(in) :: species_short_name(num_species) ! Species short_name property + character(len=32), intent(in) :: species_short_name(num_species) ! Species short_name property real(fp), intent(in) :: species_dd_hstar(num_species) ! Species dd_hstar property real(fp), intent(in) :: species_dd_DvzAerSnow(num_species) ! Species dd_DvzAerSnow property real(fp), intent(in) :: species_dd_DvzMinVal_snow(num_species) ! Species dd_DvzMinVal_snow property @@ -765,7 +777,8 @@ FUNCTION AERO_SFCRSII( SPC, IS_DUST, IS_SEASALT, LUCINDEX, A_RADI, A_DEN, & ! Over oceans the RH in the viscous sublayer is set to 98%, ! following Lewis and Schwartz (2004) - IF (LUC == 14) THEN + !I added condition when RHBL=1 to avoid DIAM = infinity issue in the New_DIAM_DEN subroutine later for SO4 (Wei Li) + IF (LUC == 14 .or. rae(RHBL, 1.0_fp)) THEN RHBL = 0.98_fp ENDIF @@ -927,10 +940,12 @@ FUNCTION AERO_SFCRSII( SPC, IS_DUST, IS_SEASALT, LUCINDEX, A_RADI, A_DEN, & R1 = 1.e+0_fp ELSE R1 = EXP( -1e+0_fp * SQRT( ST ) ) + R1 = MAX( tiny(R1), R1 ) !avoid R1 = 0 when ST is large under very low TEMP and AA < 0 (Wei Li) ENDIF !add error check here to make sure RS below is not a infinite value IF (rae(R1, 0.0_fp) .or. rae(USTAR, 0.0_fp)) THEN + !write(*,*) 'DEBUG INFO: SPC=', trim(SPC), LUC, USTAR, R1, ST, AA, VTS, CONST, DEN, DIAM, RHBL, RHB, AIRVS errMsg = 'USTAR or R1 is zero. Check met field or diameter (in m) of aerosol is too big.' CALL CC_Error( errMsg, RC, thisLoc ) RETURN @@ -993,7 +1008,7 @@ SUBROUTINE New_DIAM_DEN( SPC, IS_SEASALT, RHBL, RDRY, RWET, DIAM, DEN, RC) REAL(fp), PARAMETER :: A2 = -4.28e-5_fp REAL(fp), PARAMETER :: A3 = 2.52e-6_fp REAL(fp), PARAMETER :: A4 = -2.35e-8_fp - REAL(fp), PARAMETER :: EPSI = 1.0e-4_fp + REAL(f8), PARAMETER :: EPSI = 1.0e-4_f8 !!!Note we changed it fp to f8 otherwise the do while loop may not converge ! parameters for assumed size distribution of accumulation and coarse ! mode sea salt aerosols, as described in Jaegle et al. (ACP, 11, 2011) @@ -1009,8 +1024,8 @@ SUBROUTINE New_DIAM_DEN( SPC, IS_SEASALT, RHBL, RDRY, RWET, DIAM, DEN, RC) !local variables real(fp) :: FAC1, FAC2 !Exponential factors for hygroscopic growth real(fp) :: RUM !Radius of dry particle in micronmeters [um] - REAL(fp) :: RATIO_R !Ratio dry over wet radii - REAL(fp) :: DEN0, DEN1, WTP + REAL(f8) :: RATIO_R !Ratio dry over wet radii + REAL(f8) :: DEN0, DEN1, WTP, DEN_f8 integer :: I !Loop index CHARACTER(LEN=255) :: ErrMsg, thisLoc @@ -1027,8 +1042,8 @@ SUBROUTINE New_DIAM_DEN( SPC, IS_SEASALT, RHBL, RDRY, RWET, DIAM, DEN, RC) ! SIA (TODO: keep this for now and need to be consistent with real species names in the future) !IF ( K == idd_NIT .or. K == idd_NH4 .or. K == idd_SO4 ) THEN - IF ( SPC == 'NIT' .or. SPC == 'NH4' .or. SPC == 'SO4' .or. & - SPC == 'nit' .or. SPC == 'nh4' .or. SPC == 'so4' ) THEN + IF ( SPC == 'NIT' .or. SPC == 'NH4' .or. SPC == 'SO4' .or. SPC == 'ASO4J' .or. & + SPC == 'nit' .or. SPC == 'nh4' .or. SPC == 'so4' .or. SPC == 'aso4j' ) THEN ! Efflorescence transitions IF (RHBL .LT. 0.35) THEN ! DIAM is not changed @@ -1104,37 +1119,40 @@ SUBROUTINE New_DIAM_DEN( SPC, IS_SEASALT, RHBL, RDRY, RWET, DIAM, DEN, RC) ! Above density calculation is chemically unsound because it ignores chemical solvation. ! Iteratively solve Tang et al., 1997 equation 5 to calculate density of wet aerosol (kg/m3) ! Redefine RATIO_R - RATIO_R = RDRY / RWET + RATIO_R = real(RDRY / RWET, f8) ! Assume an initial density of 1000 kg/m3 - DEN0 = DEN !assign initial DEN to DEN0 - DEN = 1000.e+0_fp - DEN1 = 0.e+0_fp !initialize + DEN0 = real(DEN, f8) !assign initial DEN to DEN0 + DEN_f8 = 1000.e+0_f8 + DEN1 = 0.e+0_f8 !initialize i = 0 !initialize loop index !Note that if RH is too low, the loop will not converge and will run forever - DO WHILE ( ABS( DEN1-DEN ) .gt. EPSI ) + DO WHILE ( ABS( DEN1-DEN_f8 ) .gt. EPSI ) ! First calculate weight percent of aerosol (kg_RH=0.8/kg_wet) - WTP = 100.e+0_fp * DEN0/DEN * RATIO_R**3.e+0_fp + WTP = 100.e+0_f8 * DEN0/DEN_f8 * RATIO_R**3 ! Then calculate density of wet aerosol using equation 5 ! in Tang et al., 1997 [kg/m3] - DEN1 = ( 0.9971e+0_fp + (A1 * WTP) + (A2 * WTP**2) + & - (A3 * WTP**3) + (A4 * WTP**4) ) * 1000.e+0_fp + DEN1 = ( 0.9971e+0_f8 + (A1 * WTP) + (A2 * WTP**2) + & + (A3 * WTP**3) + (A4 * WTP**4) ) * 1000.e+0_f8 ! Now calculate new weight percent using above density calculation - WTP = 100.e+0_fp * DEN0/DEN1 * RATIO_R**3.e+0_fp + WTP = 100.e+0_f8 * DEN0/DEN1 * RATIO_R**3 ! Now recalculate new wet density [kg/m3] - DEN = ( 0.9971e+0_fp + (A1 * WTP) + (A2 * WTP**2) + & - (A3 * WTP**3) + (A4 * WTP**4) ) * 1000.e+0_fp + DEN_f8 = ( 0.9971e+0_f8 + (A1 * WTP) + (A2 * WTP**2) + & + (A3 * WTP**3) + (A4 * WTP**4) ) * 1000.e+0_f8 ! add some protection against infinite loop i = i+1 IF ( i .GT. 500 ) THEN + !write(*,*) 'Test NEW_DIAM_DEN output: ', trim(SPC), RHBL, RDRY, RWET, DIAM, DEN0, DEN,DEN1 errMsg = 'Error in calculating new density for sea salt aerosol due to very low RH input!' CALL CC_Error( errMsg, RC, thisLoc ) RETURN ENDIF ENDDO + ! Convert back to fp + DEN = REAL(DEN_f8, fp) ENDIF END SUBROUTINE New_DIAM_DEN diff --git a/src/process/seasalt/ProcessSeaSaltInterface_Mod.F90 b/src/process/seasalt/ProcessSeaSaltInterface_Mod.F90 index f7e1d161..68c7a83f 100644 --- a/src/process/seasalt/ProcessSeaSaltInterface_Mod.F90 +++ b/src/process/seasalt/ProcessSeaSaltInterface_Mod.F90 @@ -11,7 +11,7 @@ !! This approach maintains backward compatibility while providing flexible diagnostic capabilities. !! !! This code was generated by the CATChem Process Generator. -!! Generation date: 2025-11-14T23:01:21.180443 +!! Generation date: 2025-12-15T16:09:09.402672 !! Configuration: seasalt !! !! @author CATChem Process Generator @@ -348,7 +348,6 @@ subroutine run_gong97_scheme_column(this, column, rc) ! Local variables for scheme calculation type(VirtualMetType), pointer :: met => null() ! Pointer to meteorological data ! Meteorological fields - real(fp), allocatable :: delp(:) real(fp), allocatable :: frocean(:) real(fp), allocatable :: frseaice(:) real(fp), allocatable :: sst(:) @@ -385,7 +384,6 @@ subroutine run_gong97_scheme_column(this, column, rc) allocate(species_conc(1, n_species)) allocate(species_tendencies(1, n_species)) ! Allocate meteorological field arrays based on field type and process configuration - allocate(delp(1)) ! Surface level only allocate(frocean(1)) ! Surface field - always scalar allocate(frseaice(1)) ! Surface field - always scalar allocate(sst(1)) ! Surface field - always scalar @@ -403,7 +401,6 @@ subroutine run_gong97_scheme_column(this, column, rc) ! Now allocate categorical fields using the met pointer dimensions ! Extract required fields from met pointer based on field type and processing mode - delp(1) = met%DELP(1) ! Surface level only frocean(1) = met%FROCEAN ! Surface field - scalar access frseaice(1) = met%FRSEAICE ! Surface field - scalar access sst(1) = met%SST ! Surface field - scalar access @@ -436,7 +433,6 @@ subroutine run_gong97_scheme_column(this, column, rc) n_levels, & n_species, & this%process_config%gong97_config, & - delp, & frocean(1), & frseaice(1), & sst(1), & @@ -459,7 +455,6 @@ subroutine run_gong97_scheme_column(this, column, rc) n_levels, & n_species, & this%process_config%gong97_config, & - delp, & frocean(1), & frseaice(1), & sst(1), & @@ -477,20 +472,23 @@ subroutine run_gong97_scheme_column(this, column, rc) ! Apply tendencies back to virtual column based on tendency_mode ! Surface-only processing - apply tendencies to surface level only do i = 1, n_species - ! Additive tendency (default): new_conc = conc + dqa - ! where dqa = tendency * dt * g0 / DELP(1) for surface + ! Additive tendency: convert emission flux to concentration change + ! Step 1: Convert to mass mixing ratio change (kg/kg) dqa = species_tendencies(1, i) * this%get_timestep() * g0 / met%DELP(1) - ! Apply unit conversion for emission processes - ! For gas species: convert kg/kg to ppmv (converter = AIRMW / mw_g * 1.0e6) - ! For aerosol species: convert kg/kg to ug/kg (converter = 1.0e9) + + ! Step 2: Convert to final concentration units + ! For gas species: convert kg/kg to ppmv + ! For aerosol species: convert kg/kg to ug/kg if (this%chem_state%ChemSpecies(species_indices(i))%is_gas) then converter = AIRMW / this%chem_state%ChemSpecies(species_indices(i))%mw_g * 1.0e6_fp else converter = 1.0e9_fp end if dqa = dqa * converter + call column%set_chem_field(1, species_indices(i), & species_conc(1, i) + dqa) + end do end subroutine run_gong97_scheme_column @@ -504,7 +502,6 @@ subroutine run_gong03_scheme_column(this, column, rc) ! Local variables for scheme calculation type(VirtualMetType), pointer :: met => null() ! Pointer to meteorological data ! Meteorological fields - real(fp), allocatable :: delp(:) real(fp), allocatable :: frocean(:) real(fp), allocatable :: frseaice(:) real(fp), allocatable :: sst(:) @@ -541,7 +538,6 @@ subroutine run_gong03_scheme_column(this, column, rc) allocate(species_conc(1, n_species)) allocate(species_tendencies(1, n_species)) ! Allocate meteorological field arrays based on field type and process configuration - allocate(delp(1)) ! Surface level only allocate(frocean(1)) ! Surface field - always scalar allocate(frseaice(1)) ! Surface field - always scalar allocate(sst(1)) ! Surface field - always scalar @@ -559,7 +555,6 @@ subroutine run_gong03_scheme_column(this, column, rc) ! Now allocate categorical fields using the met pointer dimensions ! Extract required fields from met pointer based on field type and processing mode - delp(1) = met%DELP(1) ! Surface level only frocean(1) = met%FROCEAN ! Surface field - scalar access frseaice(1) = met%FRSEAICE ! Surface field - scalar access sst(1) = met%SST ! Surface field - scalar access @@ -592,7 +587,6 @@ subroutine run_gong03_scheme_column(this, column, rc) n_levels, & n_species, & this%process_config%gong03_config, & - delp, & frocean(1), & frseaice(1), & sst(1), & @@ -615,7 +609,6 @@ subroutine run_gong03_scheme_column(this, column, rc) n_levels, & n_species, & this%process_config%gong03_config, & - delp, & frocean(1), & frseaice(1), & sst(1), & @@ -633,20 +626,23 @@ subroutine run_gong03_scheme_column(this, column, rc) ! Apply tendencies back to virtual column based on tendency_mode ! Surface-only processing - apply tendencies to surface level only do i = 1, n_species - ! Additive tendency (default): new_conc = conc + dqa - ! where dqa = tendency * dt * g0 / DELP(1) for surface + ! Additive tendency: convert emission flux to concentration change + ! Step 1: Convert to mass mixing ratio change (kg/kg) dqa = species_tendencies(1, i) * this%get_timestep() * g0 / met%DELP(1) - ! Apply unit conversion for emission processes - ! For gas species: convert kg/kg to ppmv (converter = AIRMW / mw_g * 1.0e6) - ! For aerosol species: convert kg/kg to ug/kg (converter = 1.0e9) + + ! Step 2: Convert to final concentration units + ! For gas species: convert kg/kg to ppmv + ! For aerosol species: convert kg/kg to ug/kg if (this%chem_state%ChemSpecies(species_indices(i))%is_gas) then converter = AIRMW / this%chem_state%ChemSpecies(species_indices(i))%mw_g * 1.0e6_fp else converter = 1.0e9_fp end if dqa = dqa * converter + call column%set_chem_field(1, species_indices(i), & species_conc(1, i) + dqa) + end do end subroutine run_gong03_scheme_column @@ -660,7 +656,6 @@ subroutine run_geos12_scheme_column(this, column, rc) ! Local variables for scheme calculation type(VirtualMetType), pointer :: met => null() ! Pointer to meteorological data ! Meteorological fields - real(fp), allocatable :: delp(:) real(fp), allocatable :: frocean(:) real(fp), allocatable :: frseaice(:) real(fp), allocatable :: sst(:) @@ -696,7 +691,6 @@ subroutine run_geos12_scheme_column(this, column, rc) allocate(species_conc(1, n_species)) allocate(species_tendencies(1, n_species)) ! Allocate meteorological field arrays based on field type and process configuration - allocate(delp(1)) ! Surface level only allocate(frocean(1)) ! Surface field - always scalar allocate(frseaice(1)) ! Surface field - always scalar allocate(sst(1)) ! Surface field - always scalar @@ -713,7 +707,6 @@ subroutine run_geos12_scheme_column(this, column, rc) ! Now allocate categorical fields using the met pointer dimensions ! Extract required fields from met pointer based on field type and processing mode - delp(1) = met%DELP(1) ! Surface level only frocean(1) = met%FROCEAN ! Surface field - scalar access frseaice(1) = met%FRSEAICE ! Surface field - scalar access sst(1) = met%SST ! Surface field - scalar access @@ -745,7 +738,6 @@ subroutine run_geos12_scheme_column(this, column, rc) n_levels, & n_species, & this%process_config%geos12_config, & - delp, & frocean(1), & frseaice(1), & sst(1), & @@ -767,7 +759,6 @@ subroutine run_geos12_scheme_column(this, column, rc) n_levels, & n_species, & this%process_config%geos12_config, & - delp, & frocean(1), & frseaice(1), & sst(1), & @@ -784,20 +775,23 @@ subroutine run_geos12_scheme_column(this, column, rc) ! Apply tendencies back to virtual column based on tendency_mode ! Surface-only processing - apply tendencies to surface level only do i = 1, n_species - ! Additive tendency (default): new_conc = conc + dqa - ! where dqa = tendency * dt * g0 / DELP(1) for surface + ! Additive tendency: convert emission flux to concentration change + ! Step 1: Convert to mass mixing ratio change (kg/kg) dqa = species_tendencies(1, i) * this%get_timestep() * g0 / met%DELP(1) - ! Apply unit conversion for emission processes - ! For gas species: convert kg/kg to ppmv (converter = AIRMW / mw_g * 1.0e6) - ! For aerosol species: convert kg/kg to ug/kg (converter = 1.0e9) + + ! Step 2: Convert to final concentration units + ! For gas species: convert kg/kg to ppmv + ! For aerosol species: convert kg/kg to ug/kg if (this%chem_state%ChemSpecies(species_indices(i))%is_gas) then converter = AIRMW / this%chem_state%ChemSpecies(species_indices(i))%mw_g * 1.0e6_fp else converter = 1.0e9_fp end if dqa = dqa * converter + call column%set_chem_field(1, species_indices(i), & species_conc(1, i) + dqa) + end do end subroutine run_geos12_scheme_column @@ -890,7 +884,7 @@ end function get_required_met_fields !> Get required diagnostic fields for this process function get_required_diagnostic_fields(this) result(field_names) class(ProcessSeaSaltInterface), intent(in) :: this - character(len=32), allocatable :: field_names(:) + character(len=64), allocatable :: field_names(:) allocate(field_names(2)) field_names(1) = 'seasalt_mass_emission_total' @@ -910,7 +904,6 @@ subroutine register_and_allocate_diagnostics(this, container, rc) type(DiagnosticManagerType), pointer :: diag_mgr type(DiagnosticRegistryType), pointer :: registry type(GridManagerType), pointer :: grid_mgr - character(len=32) :: selected_scheme character(len=256) :: field_name ! For constructing species-specific field names integer :: i ! Loop variable for diagnostic species integer :: nx, ny, nz @@ -946,6 +939,7 @@ subroutine register_and_allocate_diagnostics(this, container, rc) dims_3d_species = [nx, ny, n_species] ! Register seasalt_mass_emission_total + ! Register single field for non-species or level-only diagnostics call this%register_diagnostic_field(registry, 'seasalt_mass_emission_total', & 'Sea salt mass emission flux total', & 'kg/m2/s', DIAG_REAL_2D, & @@ -953,6 +947,7 @@ subroutine register_and_allocate_diagnostics(this, container, rc) if (rc /= CC_SUCCESS) return ! Register seasalt_number_emission_total + ! Register single field for non-species or level-only diagnostics call this%register_diagnostic_field(registry, 'seasalt_number_emission_total', & 'Sea salt number emission flux total', & 'kg/m2/s', DIAG_REAL_2D, & @@ -960,14 +955,12 @@ subroutine register_and_allocate_diagnostics(this, container, rc) if (rc /= CC_SUCCESS) return ! Get selected scheme(s) - selected_scheme = trim(this%process_config%seasalt_config%scheme) - ! Register scheme-specific diagnostics based on selected scheme - select case (selected_scheme) + select case (trim(this%process_config%seasalt_config%scheme)) case ('gong97') ! Register gong97-specific diagnostics - ! Register individual 2D fields for each diagnostic species + ! Register individual 2D fields for each diagnostic species (species-only diagnostics) if (this%process_config%seasalt_config%n_diagnostic_species > 0) then do i = 1, this%process_config%seasalt_config%n_diagnostic_species write(field_name, '(A,A,A)') 'seasalt_mass_emission_', & @@ -981,7 +974,7 @@ subroutine register_and_allocate_diagnostics(this, container, rc) end if if (rc /= CC_SUCCESS) return - ! Register individual 2D fields for each diagnostic species + ! Register individual 2D fields for each diagnostic species (species-only diagnostics) if (this%process_config%seasalt_config%n_diagnostic_species > 0) then do i = 1, this%process_config%seasalt_config%n_diagnostic_species write(field_name, '(A,A,A)') 'seasalt_number_emission_', & @@ -997,7 +990,7 @@ subroutine register_and_allocate_diagnostics(this, container, rc) case ('gong03') ! Register gong03-specific diagnostics - ! Register individual 2D fields for each diagnostic species + ! Register individual 2D fields for each diagnostic species (species-only diagnostics) if (this%process_config%seasalt_config%n_diagnostic_species > 0) then do i = 1, this%process_config%seasalt_config%n_diagnostic_species write(field_name, '(A,A,A)') 'seasalt_mass_emission_', & @@ -1011,7 +1004,7 @@ subroutine register_and_allocate_diagnostics(this, container, rc) end if if (rc /= CC_SUCCESS) return - ! Register individual 2D fields for each diagnostic species + ! Register individual 2D fields for each diagnostic species (species-only diagnostics) if (this%process_config%seasalt_config%n_diagnostic_species > 0) then do i = 1, this%process_config%seasalt_config%n_diagnostic_species write(field_name, '(A,A,A)') 'seasalt_number_emission_', & @@ -1027,7 +1020,7 @@ subroutine register_and_allocate_diagnostics(this, container, rc) case ('geos12') ! Register geos12-specific diagnostics - ! Register individual 2D fields for each diagnostic species + ! Register individual 2D fields for each diagnostic species (species-only diagnostics) if (this%process_config%seasalt_config%n_diagnostic_species > 0) then do i = 1, this%process_config%seasalt_config%n_diagnostic_species write(field_name, '(A,A,A)') 'seasalt_mass_emission_', & @@ -1041,7 +1034,7 @@ subroutine register_and_allocate_diagnostics(this, container, rc) end if if (rc /= CC_SUCCESS) return - ! Register individual 2D fields for each diagnostic species + ! Register individual 2D fields for each diagnostic species (species-only diagnostics) if (this%process_config%seasalt_config%n_diagnostic_species > 0) then do i = 1, this%process_config%seasalt_config%n_diagnostic_species write(field_name, '(A,A,A)') 'seasalt_number_emission_', & @@ -1080,8 +1073,7 @@ subroutine register_and_allocate_diagnostics(this, container, rc) this%column_seasalt_number_emission_total = 0.0_fp ! Allocate scheme-specific diagnostics - selected_scheme = trim(this%process_config%seasalt_config%scheme) - select case (selected_scheme) + select case (trim(this%process_config%seasalt_config%scheme)) case ('gong97') ! Scheme-specific diagnostics for gong97 ! 1D diagnostic: diagnostic species only - allocated based on n_diagnostic_species @@ -1160,12 +1152,10 @@ subroutine calculate_and_update_diagnostics(this, column, container, rc) i_col, j_col, container, rc) if (rc /= CC_SUCCESS) return ! Update scheme-specific diagnostic fields based on active scheme - selected_scheme = trim(this%process_config%seasalt_config%scheme) - - select case (selected_scheme) + select case (trim(this%process_config%seasalt_config%scheme)) case ("gong97") ! Scheme-specific diagnostics for gong97 - ! Update individual fields for each diagnostic species + ! Update individual species diagnostic fields (species-only diagnostics) if (this%process_config%seasalt_config%n_diagnostic_species > 0) then do i = 1, this%process_config%seasalt_config%n_diagnostic_species write(field_name, '(A,A,A)') 'seasalt_mass_emission_', & @@ -1176,7 +1166,7 @@ subroutine calculate_and_update_diagnostics(this, column, container, rc) if (rc /= CC_SUCCESS) return end do end if - ! Update individual fields for each diagnostic species + ! Update individual species diagnostic fields (species-only diagnostics) if (this%process_config%seasalt_config%n_diagnostic_species > 0) then do i = 1, this%process_config%seasalt_config%n_diagnostic_species write(field_name, '(A,A,A)') 'seasalt_number_emission_', & @@ -1189,7 +1179,7 @@ subroutine calculate_and_update_diagnostics(this, column, container, rc) end if case ("gong03") ! Scheme-specific diagnostics for gong03 - ! Update individual fields for each diagnostic species + ! Update individual species diagnostic fields (species-only diagnostics) if (this%process_config%seasalt_config%n_diagnostic_species > 0) then do i = 1, this%process_config%seasalt_config%n_diagnostic_species write(field_name, '(A,A,A)') 'seasalt_mass_emission_', & @@ -1200,7 +1190,7 @@ subroutine calculate_and_update_diagnostics(this, column, container, rc) if (rc /= CC_SUCCESS) return end do end if - ! Update individual fields for each diagnostic species + ! Update individual species diagnostic fields (species-only diagnostics) if (this%process_config%seasalt_config%n_diagnostic_species > 0) then do i = 1, this%process_config%seasalt_config%n_diagnostic_species write(field_name, '(A,A,A)') 'seasalt_number_emission_', & @@ -1213,7 +1203,7 @@ subroutine calculate_and_update_diagnostics(this, column, container, rc) end if case ("geos12") ! Scheme-specific diagnostics for geos12 - ! Update individual fields for each diagnostic species + ! Update individual species diagnostic fields (species-only diagnostics) if (this%process_config%seasalt_config%n_diagnostic_species > 0) then do i = 1, this%process_config%seasalt_config%n_diagnostic_species write(field_name, '(A,A,A)') 'seasalt_mass_emission_', & @@ -1224,7 +1214,7 @@ subroutine calculate_and_update_diagnostics(this, column, container, rc) if (rc /= CC_SUCCESS) return end do end if - ! Update individual fields for each diagnostic species + ! Update individual species diagnostic fields (species-only diagnostics) if (this%process_config%seasalt_config%n_diagnostic_species > 0) then do i = 1, this%process_config%seasalt_config%n_diagnostic_species write(field_name, '(A,A,A)') 'seasalt_number_emission_', & diff --git a/src/process/seasalt/schemes/SeaSaltScheme_GEOS12_Mod copy.F90 b/src/process/seasalt/schemes/SeaSaltScheme_GEOS12_Mod copy.F90 deleted file mode 100644 index 19170136..00000000 --- a/src/process/seasalt/schemes/SeaSaltScheme_GEOS12_Mod copy.F90 +++ /dev/null @@ -1,375 +0,0 @@ -!> \file SeaSaltScheme_GEOS12_Mod.F90 -!! \brief GEOS-Chem 2012 sea salt emission scheme with observational constraints -!! -!! Pure science kernel for geos12 scheme in seasalt process. -!! This module contains ONLY the computational algorithm with NO infrastructure dependencies. -!! Uses only basic Fortran types for maximum portability and reusability. -!! -!! SCIENCE CUSTOMIZATION GUIDE: -!! 1. Modify the algorithm in compute_geos12 (search for "TODO") -!! 2. Add scheme-specific helper subroutines as needed -!! 3. Update physical constants for your scheme -!! 4. Customize the environmental response functions -!! -!! INFRASTRUCTURE RESPONSIBILITIES (handled by host model): -!! - Parameter initialization and validation -!! - Input array validation and error handling -!! - Memory management and array allocation -!! - Integration with host model time stepping -!! -!! Generated on: 2025-09-15T17:20:44.139071 -!! Author: Barry Baker -!! Reference: Jaeglé et al. [2011] -module SeaSaltScheme_GEOS12_Mod - - use precision_mod, only: fp, zero - use SeaSaltCommon_Mod, only: SeaSaltSchemeGEOS12Config - use Constants, only: PI !load the constants needed for this scheme - - implicit none - private - - ! Public interface - pure science only - public :: compute_geos12 - - ! Additional physical constants (modify as needed for your scheme) - real(fp), parameter :: T_STANDARD = 303.15_fp ! Standard reference temperature [K] - real(fp), parameter :: DEFAULT_SCALING = 1.0e-9_fp ! Default emission scaling factor - -contains - - !> Pure science computation for geos12 scheme - !! - !! This is a pure computational kernel implementing GEOS-Chem 2012 sea salt emission scheme with observational constraints. - !! NO error checking, validation, or infrastructure concerns. - !! Host model must ensure all inputs are valid before calling. - !! - !! @param[in] num_layers Number of vertical layers - !! @param[in] num_species Number of chemical species - !! @param[in] params Scheme parameters (pre-validated by host) - !! @param[in] frocean FROCEAN field [appropriate units] - !! @param[in] frseaice FRSEAICE field [appropriate units] - !! @param[in] sst SST field [appropriate units] - !! @param[in] ustar USTAR field [appropriate units] - !! @param[in] species_conc Species concentrations [mol/mol] (num_layers, num_species) - !! @param[inout] species_tendencies Species tendency terms [mol/mol/s] (num_layers, num_species) - !! @param[inout] seasalt_mass_emission_total Total mass emission diagnostic [ug/m2/s] - !! @param[inout] seasalt_number_emission_total Total number emission diagnostic [#/m2/s] - !! @param[inout] seasalt_mass_emission_per_bin Mass emission per bin diagnostic [kg/m2/s] (num_species) - !! @param[inout] seasalt_number_emission_per_bin Number emission per bin diagnostic [#/m2/s] (num_species) - !! @param[in] diagnostic_species_id Indices mapping diagnostic species to species array (optional, for per-species diagnostics) - pure subroutine compute_geos12( & - num_layers, & - num_species, & - params, & - frocean, & - frseaice, & - sst, & - ustar, & - species_density, & - species_radius, & - species_lower_radius, & - species_upper_radius, & - species_conc, & - species_tendencies, & - seasalt_mass_emission_total, & - seasalt_number_emission_total, & - seasalt_mass_emission_per_bin, & - seasalt_number_emission_per_bin, & - diagnostic_species_id & - ) - - ! Arguments - integer, intent(in) :: num_layers - integer, intent(in) :: num_species - type(SeaSaltSchemeGEOS12Config), intent(in) :: params - real(fp), intent(in) :: frocean ! Surface field - scalar - real(fp), intent(in) :: frseaice ! Surface field - scalar - real(fp), intent(in) :: sst ! Surface field - scalar - real(fp), intent(in) :: ustar ! Surface field - scalar - real(fp), intent(in) :: species_density(num_species) ! Species density property - real(fp), intent(in) :: species_radius(num_species) ! Species radius property - real(fp), intent(in) :: species_lower_radius(num_species) ! Species lower_radius property - real(fp), intent(in) :: species_upper_radius(num_species) ! Species upper_radius property - real(fp), intent(in) :: species_conc(num_layers, num_species) - real(fp), intent(inout) :: species_tendencies(num_layers, num_species) - real(fp), intent(inout), optional :: seasalt_mass_emission_total - real(fp), intent(inout), optional :: seasalt_number_emission_total - real(fp), intent(inout), optional :: seasalt_mass_emission_per_bin(:) - real(fp), intent(inout), optional :: seasalt_number_emission_per_bin(:) - integer, intent(in), optional :: diagnostic_species_id(:) ! Indices mapping diagnostic species to species array - - ! Local variables - integer :: k, species_idx, RC - integer :: diag_idx ! For diagnostic species indexing - real(fp) :: base_emission_factor - real(fp) :: environmental_factor - real(fp) :: species_factor - - logical :: do_seasalt !< Enable Dust Calculation Flag - integer :: n, ir !< Loop counter - integer, parameter :: nr = 10 !< Number of (linear) sub-size bins - real(fp), parameter :: r80fac = 1.65 !< ratio of radius(RH=0.8)/radius(RH=0.) [Gerber] - real(fp) :: DryRadius !< sub-bin radius (dry, um) - real(fp) :: DeltaDryRadius !< sub-bin radius spacing (dry, um) - real(fp) :: rwet, drwet !< sub-bin radius spacing (rh=80%, um) - real(fp) :: NumberEmissions !< sub-bin number emission rate [#/m2/s] - real(fp) :: MassEmissions !< sub-bin number emission rate [kg/m2/s] - real(fp) :: mass_emission_flux(num_layers, num_species) - real(fp) :: numb_emission_flux(num_layers, num_species) - real(fp) :: aFac - real(fp) :: bFac - real(fp) :: scalefac - real(fp) :: rpow - real(fp) :: exppow - real(fp) :: wpow - real(fp) :: MassScaleFac - real(fp) :: gweibull - real(fp) :: fsstemis - real(fp) :: fhoppel - real(fp) :: scale - - ! Note: species_tendencies and diagnostic arrays are already initialized - ! by the host ProcessInterface before calling this subroutine. - ! Do not re-initialize them here. - RC = 0 - mass_emission_flux = 0.0_fp - numb_emission_flux = 0.0_fp - MassEmissions = 0.0_fp - NumberEmissions = 0.0_fp - fsstemis = 1.0_fp - fhoppel = 1.0_fp - - do_seasalt = .true. ! Default value for all cases - - ! Don't do Sea Salt over land - !---------------------------------------------------------------- - scale = FROCEAN - FRSEAICE - if (scale <= 0.0_fp) then - do_seasalt = .False. - endif - - if (do_seasalt) then - ! GEOS 12 Params - !--------------- - scalefac = 33.0e3_fp - rpow = 3.45_fp - exppow = 1.607_fp - wpow = 3.41_fp - 1._fp - - ! Main computation loop - CUSTOMIZE THIS SECTION FOR YOUR SCHEME - do k = 1, num_layers - - ! TODO: Replace this generic implementation with your scheme's algorithm - ! This is a placeholder that demonstrates the expected structure - ! Get Jeagle SST Correction - call jeagleSSTcorrection(fsstemis, SST,1, RC) - if (RC /= 0) then - RC = -1 - !print *, 'Error in jeagleSSTcorrection' - return - endif - - scale = scale * fsstemis * params%scale_factor - - ! Apply to each species - do n = 1, num_species - ! delta dry radius - !----------------- - DeltaDryRadius = (species_upper_radius(n) - species_lower_radius(n) )/ nr - - ! Dry Radius Substep - !------------------- - DryRadius = species_lower_radius(n) + 0.5_fp * DeltaDryRadius - - ! Mass scale fcator - MassScaleFac = scalefac * 4._fp/3._fp*PI*species_density(n)*(DryRadius**3._fp) * 1.e-18_fp - - do ir = 1, nr ! SubSteps - - ! Effective Wet Radius in Sub Step - rwet = r80fac * DryRadius - - ! Effective Delta Wet Radius - drwet = r80fac * DeltaDryRadius - - aFac = 4.7_fp*(1._fp + 30._fp*rwet)**(-0.017_fp*rwet**(-1.44_fp)) - bFac = (0.380_fp-log10(rwet))/0.65_fp - - ! Number emissions flux (# m-2 s-1) - NumberEmissions = NumberEmissions + SeasaltEmissionGong( rwet, drwet, USTAR, scalefac, & - aFac, bFac, rpow, exppow, wpow ) - - ! Mass emissions flux (kg m-2 s-1) - MassEmissions = MassEmissions + SeasaltEmissionGong( rwet, drwet, USTAR, MassScaleFac, & - aFac, bFac, rpow, exppow, wpow ) - - DryRadius = DryRadius + DeltaDryRadius - - enddo ! ir loop - - mass_emission_flux(k, n) = MassEmissions * scale - numb_emission_flux(k, n) = NumberEmissions * scale - ! Reset for next species - MassEmissions = 0.0_fp - NumberEmissions = 0.0_fp - - ! Ensure non-negative emissions - species_tendencies(k, n) = max(0.0_fp, mass_emission_flux(k, n)) - - ! TODO: Update diagnostic fields here based on your scheme's requirements - ! Each process should implement custom diagnostic calculations - ! Example patterns: - if (present(seasalt_mass_emission_total)) then - seasalt_mass_emission_total = seasalt_mass_emission_total + mass_emission_flux(k, n) - end if - if (present(seasalt_number_emission_total)) then - seasalt_number_emission_total = seasalt_number_emission_total + numb_emission_flux(k, n) - end if - if (present(seasalt_mass_emission_per_bin) .and. present(diagnostic_species_id)) then - ! Find position of this species in diagnostic_species_id array - do diag_idx = 1, size(diagnostic_species_id) - if (diagnostic_species_id(diag_idx) == n) then - ! Add your custom sea salt mass emission flux per bin calculation - seasalt_mass_emission_per_bin(diag_idx) = mass_emission_flux(k, n) - exit - end if - end do - end if - if (present(seasalt_number_emission_per_bin) .and. present(diagnostic_species_id)) then - ! Find position of this species in diagnostic_species_id array - do diag_idx = 1, size(diagnostic_species_id) - if (diagnostic_species_id(diag_idx) == n) then - ! Add your custom sea salt mass emission flux per bin calculation - seasalt_number_emission_per_bin(diag_idx) = numb_emission_flux(k, n) - exit - end if - end do - end if - end do - - end do - - end if ! do_seasalt - - end subroutine compute_geos12 - - ! ======================================================================= - ! SCHEME-SPECIFIC HELPER SUBROUTINES - ! ======================================================================= - ! Add your custom scientific algorithms here as pure functions/subroutines - ! Examples: environmental response functions, species-specific calculations, etc. - - !> Example helper function for environmental response - pure function compute_environmental_response_geos12(met_value, reference_value) result(factor) - real(fp), intent(in) :: met_value ! Meteorological value - real(fp), intent(in) :: reference_value ! Reference value - real(fp) :: factor - - ! Simple exponential response - customize for your scheme - factor = exp((met_value - reference_value) / reference_value) - factor = max(0.0_fp, min(10.0_fp, factor)) ! Reasonable bounds - end function compute_environmental_response_geos12 - - !> Example helper function for species-specific scaling - pure function compute_species_scaling_geos12(species_idx, params) result(scaling) - integer, intent(in) :: species_idx - type(SeaSaltSchemeGEOS12Config), intent(in) :: params - real(fp) :: scaling - - ! Species-specific scaling - customize for your scheme - select case (species_idx) - case (1) - scaling = 1.0_fp ! First species baseline - case (2:3) - scaling = 0.5_fp ! Reduced emission for species 2-3 - case default - scaling = 0.1_fp ! Low emission for other species - end select - - end function compute_species_scaling_geos12 - - !> - !! \brief Jeagle et al. 2012 SST correction - !! - !! Jaeglé, L., Quinn, P. K., Bates, T. S., Alexander, B., and Lin, J.-T.: - !! Global distribution of sea salt aerosols: new constraints from in situ and remote - !! sensing observations, Atmos. Chem. Phys., 11, 3137–3157, - !! https://doi.org/10.5194/acp-11-3137-2011, 2011. - !! - !! \ingroup catchem_seasalt_process - !!!> - pure subroutine jeagleSSTcorrection(fsstemis, sst, sstFlag, rc) - - ! !USES: - implicit NONE - - ! !INPUT/OUTPUT PARAMETERS: - real(fp), intent(inout) :: fsstemis ! - real(fp), intent(in) :: sst ! surface temperature (K) - integer, intent(in) :: sstFlag - - ! !OUTPUT PARAMETERS: - integer, optional, intent(out) :: rc - !EOP - - ! !Local Variables - real(fp) :: tskin_c - !EOP - !------------------------------------------------------------------------- - ! Begin... - RC = -1 ! Error code - fsstemis = 1.0_fp - - fsstemis = ZERO - tskin_c = sst - 273.15_fp - if (sstFlag .eq. 1) then - fsstemis = max(0.0_fp,(0.3_fp + 0.1_fp*tskin_c - 0.0076_fp*tskin_c**2 + 0.00021_fp*tskin_c**3)) - else - ! temperature range (0, 36) C - tskin_c = max(-0.1_fp, Tskin_c) - tskin_c = min(36.0_fp, tskin_c) - - fsstemis = (-1.107211_fp -0.010681_fp * tskin_c -0.002276_fp * tskin_c**2.0_fp & - + 60.288927_fp*1.0_fp/(40.0_fp - tskin_c)) - fsstemis = max(0.0_fp, fsstemis) - fsstemis = min(7.0_fp, fsstemis) - endif - - RC = 0 - end subroutine jeagleSSTcorrection - - !> - !! \brief Function to compute sea salt emissions following the Gong style parameterization. - !! - !! Functional form is from Gong 2003: - !! \f$dN/dr = scalefac * 1.373 * (w^wpow) * (r^-aFac) * (1+0.057*r^rpow) * 10^(exppow*exp(-bFac^2))\f$ - !! where r is the particle radius at 80% RH, dr is the size bin width at 80% RH, and w is the wind speed - !! - !! \ingroup catchem_seasalt_process - !!!> - pure function SeasaltEmissionGong ( r, dr, w, scalefac, aFac, bFac, rpow, exppow, wpow ) - - real(fp), intent(in) :: r !< Wet particle radius [um] - real(fp), intent(in) :: dr !< Wet particle bin width [um] - real(fp), intent(in) :: w !< Grid box mean wind speed [m s-1] (10-m or ustar wind) - real(fp), intent(in) :: scalefac !< scale factor - real(fp), intent(in) :: aFac - real(fp), intent(in) :: bFac - real(fp), intent(in) :: rpow - real(fp), intent(in) :: exppow - real(fp), intent(in) :: wpow - real(fp) :: SeasaltEmissionGong - - ! Initialize - SeasaltEmissionGong = 0. - - ! Particle size distribution function - SeasaltEmissionGong = scalefac * 1.373_fp*r**(-aFac)*(1._fp+0.057_fp*r**rpow) & - *10._fp**(exppow*exp(-bFac**2._fp))*dr - ! Apply wind speed function - SeasaltEmissionGong = w**wpow * SeasaltEmissionGong - - end function SeasaltEmissionGong - -end module SeaSaltScheme_GEOS12_Mod diff --git a/src/process/seasalt/schemes/SeaSaltScheme_GEOS12_Mod.F90 b/src/process/seasalt/schemes/SeaSaltScheme_GEOS12_Mod.F90 index a95736de..c3721b14 100644 --- a/src/process/seasalt/schemes/SeaSaltScheme_GEOS12_Mod.F90 +++ b/src/process/seasalt/schemes/SeaSaltScheme_GEOS12_Mod.F90 @@ -17,12 +17,12 @@ !! - Memory management and array allocation !! - Integration with host model time stepping !! -!! Generated on: 2025-11-14T23:01:21.754177 +!! Generated on: 2025-09-15T17:20:44.139071 !! Author: Barry Baker !! Reference: Jaeglé et al. [2011] module SeaSaltScheme_GEOS12_Mod - use precision_mod, only: fp + use precision_mod, only: fp, zero use SeaSaltCommon_Mod, only: SeaSaltSchemeGEOS12Config use Constants, only: PI !load the constants needed for this scheme @@ -47,23 +47,25 @@ module SeaSaltScheme_GEOS12_Mod !! @param[in] num_layers Number of vertical layers !! @param[in] num_species Number of chemical species !! @param[in] params Scheme parameters (pre-validated by host) - !! @param[in] delp DELP field [appropriate units] !! @param[in] frocean FROCEAN field [appropriate units] !! @param[in] frseaice FRSEAICE field [appropriate units] !! @param[in] sst SST field [appropriate units] !! @param[in] ustar USTAR field [appropriate units] + !! @param[in] species_density Species density property + !! @param[in] species_radius Species radius property + !! @param[in] species_lower_radius Species lower_radius property + !! @param[in] species_upper_radius Species upper_radius property !! @param[in] species_conc Species concentrations [mol/mol] (num_layers, num_species) !! @param[inout] species_tendencies Species tendency terms [mol/mol/s] (num_layers, num_species) - !! @param[inout] seasalt_mass_emission_total Sea salt mass emission flux total [kg/m2/s] - !! @param[inout] seasalt_number_emission_total Sea salt number emission flux total [kg/m2/s] - !! @param[inout] seasalt_mass_emission_per_bin Sea salt mass emission flux per bin [kg/m2/s] (num_species) - !! @param[inout] seasalt_number_emission_per_bin Sea salt number emission flux per bin [kg/m2/s] (num_species) + !! @param[inout] seasalt_mass_emission_total Total mass emission diagnostic [ug/m2/s] + !! @param[inout] seasalt_number_emission_total Total number emission diagnostic [#/m2/s] + !! @param[inout] seasalt_mass_emission_per_bin Mass emission per bin diagnostic [kg/m2/s] (num_species) + !! @param[inout] seasalt_number_emission_per_bin Number emission per bin diagnostic [#/m2/s] (num_species) !! @param[in] diagnostic_species_id Indices mapping diagnostic species to species array (optional, for per-species diagnostics) pure subroutine compute_geos12( & num_layers, & num_species, & params, & - delp, & frocean, & frseaice, & sst, & @@ -78,14 +80,13 @@ pure subroutine compute_geos12( & seasalt_number_emission_total, & seasalt_mass_emission_per_bin, & seasalt_number_emission_per_bin, & - diagnostic_species_id & + diagnostic_species_id & ) ! Arguments integer, intent(in) :: num_layers integer, intent(in) :: num_species type(SeaSaltSchemeGEOS12Config), intent(in) :: params - real(fp), intent(in) :: delp(num_layers) ! 3D atmospheric field real(fp), intent(in) :: frocean ! Surface field - scalar real(fp), intent(in) :: frseaice ! Surface field - scalar real(fp), intent(in) :: sst ! Surface field - scalar @@ -103,100 +104,157 @@ pure subroutine compute_geos12( & integer, intent(in), optional :: diagnostic_species_id(:) ! Indices mapping diagnostic species to species array ! Local variables - integer :: k, species_idx + integer :: k, species_idx, RC integer :: diag_idx ! For diagnostic species indexing real(fp) :: base_emission_factor real(fp) :: environmental_factor real(fp) :: species_factor + logical :: do_seasalt !< Enable Dust Calculation Flag + integer :: n, ir !< Loop counter + integer, parameter :: nr = 10 !< Number of (linear) sub-size bins + real(fp), parameter :: r80fac = 1.65 !< ratio of radius(RH=0.8)/radius(RH=0.) [Gerber] + real(fp) :: DryRadius !< sub-bin radius (dry, um) + real(fp) :: DeltaDryRadius !< sub-bin radius spacing (dry, um) + real(fp) :: rwet, drwet !< sub-bin radius spacing (rh=80%, um) + real(fp) :: NumberEmissions !< sub-bin number emission rate [#/m2/s] + real(fp) :: MassEmissions !< sub-bin number emission rate [kg/m2/s] + real(fp) :: mass_emission_flux(num_layers, num_species) + real(fp) :: numb_emission_flux(num_layers, num_species) + real(fp) :: aFac + real(fp) :: bFac + real(fp) :: scalefac + real(fp) :: rpow + real(fp) :: exppow + real(fp) :: wpow + real(fp) :: MassScaleFac + real(fp) :: gweibull + real(fp) :: fsstemis + real(fp) :: fhoppel + real(fp) :: scale + ! Note: species_tendencies and diagnostic arrays are already initialized ! by the host ProcessInterface before calling this subroutine. ! Do not re-initialize them here. + RC = 0 + mass_emission_flux = 0.0_fp + numb_emission_flux = 0.0_fp + MassEmissions = 0.0_fp + NumberEmissions = 0.0_fp + fsstemis = 1.0_fp + fhoppel = 1.0_fp + + do_seasalt = .true. ! Default value for all cases + + ! Don't do Sea Salt over land + !---------------------------------------------------------------- + scale = FROCEAN - FRSEAICE + if (scale <= 0.0_fp) then + do_seasalt = .False. + endif + + if (do_seasalt) then + ! GEOS 12 Params + !--------------- + scalefac = 33.0e3_fp + rpow = 3.45_fp + exppow = 1.607_fp + wpow = 3.41_fp - 1._fp + + ! Main computation loop - CUSTOMIZE THIS SECTION FOR YOUR SCHEME + do k = 1, num_layers + + ! TODO: Replace this generic implementation with your scheme's algorithm + ! This is a placeholder that demonstrates the expected structure + ! Get Jeagle SST Correction + call jeagleSSTcorrection(fsstemis, SST,1, RC) + if (RC /= 0) then + RC = -1 + !print *, 'Error in jeagleSSTcorrection' + return + endif + + scale = scale * fsstemis * params%scale_factor + + ! Apply to each species + do n = 1, num_species + ! delta dry radius + !----------------- + DeltaDryRadius = (species_upper_radius(n) - species_lower_radius(n) )/ nr + + ! Dry Radius Substep + !------------------- + DryRadius = species_lower_radius(n) + 0.5_fp * DeltaDryRadius + + ! Mass scale fcator + MassScaleFac = scalefac * 4._fp/3._fp*PI*species_density(n)*(DryRadius**3._fp) * 1.e-18_fp + + do ir = 1, nr ! SubSteps + + ! Effective Wet Radius in Sub Step + rwet = r80fac * DryRadius + + ! Effective Delta Wet Radius + drwet = r80fac * DeltaDryRadius + + aFac = 4.7_fp*(1._fp + 30._fp*rwet)**(-0.017_fp*rwet**(-1.44_fp)) + bFac = (0.380_fp-log10(rwet))/0.65_fp + + ! Number emissions flux (# m-2 s-1) + NumberEmissions = NumberEmissions + SeasaltEmissionGong( rwet, drwet, USTAR, scalefac, & + aFac, bFac, rpow, exppow, wpow ) + + ! Mass emissions flux (kg m-2 s-1) + MassEmissions = MassEmissions + SeasaltEmissionGong( rwet, drwet, USTAR, MassScaleFac, & + aFac, bFac, rpow, exppow, wpow ) + + DryRadius = DryRadius + DeltaDryRadius + + enddo ! ir loop + + mass_emission_flux(k, n) = MassEmissions * scale + numb_emission_flux(k, n) = NumberEmissions * scale + ! Reset for next species + MassEmissions = 0.0_fp + NumberEmissions = 0.0_fp + + ! Ensure non-negative emissions + species_tendencies(k, n) = max(0.0_fp, mass_emission_flux(k, n)) + + ! TODO: Update diagnostic fields here based on your scheme's requirements + ! Each process should implement custom diagnostic calculations + ! Example patterns: + if (present(seasalt_mass_emission_total)) then + seasalt_mass_emission_total = seasalt_mass_emission_total + mass_emission_flux(k, n) + end if + if (present(seasalt_number_emission_total)) then + seasalt_number_emission_total = seasalt_number_emission_total + numb_emission_flux(k, n) + end if + if (present(seasalt_mass_emission_per_bin) .and. present(diagnostic_species_id)) then + ! Find position of this species in diagnostic_species_id array + do diag_idx = 1, size(diagnostic_species_id) + if (diagnostic_species_id(diag_idx) == n) then + ! Add your custom sea salt mass emission flux per bin calculation + seasalt_mass_emission_per_bin(diag_idx) = mass_emission_flux(k, n) + exit + end if + end do + end if + if (present(seasalt_number_emission_per_bin) .and. present(diagnostic_species_id)) then + ! Find position of this species in diagnostic_species_id array + do diag_idx = 1, size(diagnostic_species_id) + if (diagnostic_species_id(diag_idx) == n) then + ! Add your custom sea salt mass emission flux per bin calculation + seasalt_number_emission_per_bin(diag_idx) = numb_emission_flux(k, n) + exit + end if + end do + end if + end do - ! Main computation loop - CUSTOMIZE THIS SECTION FOR YOUR SCHEME - do k = 1, num_layers - - ! TODO: Replace this generic implementation with your scheme's algorithm - ! This is a placeholder that demonstrates the expected structure - - ! Initialize environmental factors - environmental_factor = 1.0_fp - - ! Apply scheme-specific environmental responses based on meteorological fields - ! Generic field usage (customize for your scheme) - ! TODO: Consider how DELP affects your emissions - ! environmental_factor = environmental_factor * some_function(delp(k)) - ! Generic field usage (customize for your scheme) - ! TODO: Consider how FROCEAN affects your emissions - ! environmental_factor = environmental_factor * some_function(frocean(k)) - ! Generic field usage (customize for your scheme) - ! TODO: Consider how FRSEAICE affects your emissions - ! environmental_factor = environmental_factor * some_function(frseaice(k)) - ! Generic field usage (customize for your scheme) - ! TODO: Consider how SST affects your emissions - ! environmental_factor = environmental_factor * some_function(sst(k)) - ! Generic field usage (customize for your scheme) - ! TODO: Consider how USTAR affects your emissions - ! environmental_factor = environmental_factor * some_function(ustar(k)) - - ! Apply to each species - do species_idx = 1, num_species - ! Base emission factor (customize this for species-specific emissions) - base_emission_factor = DEFAULT_SCALING - - ! Species-specific factor (customize based on species properties) - species_factor = 1.0_fp ! TODO: Add species-specific scaling - - ! Compute emission flux using your scheme's formula - ! This is a simple example - replace with your actual algorithm - species_tendencies(k, species_idx) = base_emission_factor * & - environmental_factor * & - species_factor * & - (1.0_fp + species_conc(k, species_idx)) - - ! Ensure non-negative emissions - species_tendencies(k, species_idx) = max(0.0_fp, species_tendencies(k, species_idx)) - - ! TODO: Update diagnostic fields here based on your scheme's requirements - ! Each process should implement custom diagnostic calculations - ! Example patterns: - if (present(seasalt_mass_emission_total)) then - ! Add your custom sea salt mass emission flux total calculation - seasalt_mass_emission_total = seasalt_mass_emission_total + species_tendencies(k, species_idx) * 1.0_fp ! TODO: Replace with actual calculation - end if - if (present(seasalt_number_emission_total)) then - ! Add your custom sea salt number emission flux total calculation - seasalt_number_emission_total = seasalt_number_emission_total + species_tendencies(k, species_idx) * 1.0_fp ! TODO: Replace with actual calculation - end if - - ! TODO: Update scheme-specific diagnostic fields here based on your scheme's requirements - ! Each scheme should implement custom diagnostic calculations - ! Example patterns: - ! Per-species diagnostic: only update for diagnostic species - if (present(seasalt_mass_emission_per_bin) .and. present(diagnostic_species_id)) then - ! Find position of this species in diagnostic_species_id array - do diag_idx = 1, size(diagnostic_species_id) - if (diagnostic_species_id(diag_idx) == species_idx) then - ! Add your custom sea salt mass emission flux per bin calculation - seasalt_mass_emission_per_bin(diag_idx) = species_tendencies(k, species_idx) * 1.0_fp ! TODO: Replace with actual calculation - exit - end if - end do - end if - ! Per-species diagnostic: only update for diagnostic species - if (present(seasalt_number_emission_per_bin) .and. present(diagnostic_species_id)) then - ! Find position of this species in diagnostic_species_id array - do diag_idx = 1, size(diagnostic_species_id) - if (diagnostic_species_id(diag_idx) == species_idx) then - ! Add your custom sea salt number emission flux per bin calculation - seasalt_number_emission_per_bin(diag_idx) = species_tendencies(k, species_idx) * 1.0_fp ! TODO: Replace with actual calculation - exit - end if - end do - end if end do - end do + end if ! do_seasalt end subroutine compute_geos12 @@ -235,4 +293,87 @@ pure function compute_species_scaling_geos12(species_idx, params) result(scaling end function compute_species_scaling_geos12 + !> + !! \brief Jeagle et al. 2012 SST correction + !! + !! Jaeglé, L., Quinn, P. K., Bates, T. S., Alexander, B., and Lin, J.-T.: + !! Global distribution of sea salt aerosols: new constraints from in situ and remote + !! sensing observations, Atmos. Chem. Phys., 11, 3137–3157, + !! https://doi.org/10.5194/acp-11-3137-2011, 2011. + !! + !! \ingroup catchem_seasalt_process + !!!> + pure subroutine jeagleSSTcorrection(fsstemis, sst, sstFlag, rc) + + ! !USES: + implicit NONE + + ! !INPUT/OUTPUT PARAMETERS: + real(fp), intent(inout) :: fsstemis ! + real(fp), intent(in) :: sst ! surface temperature (K) + integer, intent(in) :: sstFlag + + ! !OUTPUT PARAMETERS: + integer, optional, intent(out) :: rc + !EOP + + ! !Local Variables + real(fp) :: tskin_c + !EOP + !------------------------------------------------------------------------- + ! Begin... + RC = -1 ! Error code + fsstemis = 1.0_fp + + fsstemis = ZERO + tskin_c = sst - 273.15_fp + if (sstFlag .eq. 1) then + fsstemis = max(0.0_fp,(0.3_fp + 0.1_fp*tskin_c - 0.0076_fp*tskin_c**2 + 0.00021_fp*tskin_c**3)) + else + ! temperature range (0, 36) C + tskin_c = max(-0.1_fp, Tskin_c) + tskin_c = min(36.0_fp, tskin_c) + + fsstemis = (-1.107211_fp -0.010681_fp * tskin_c -0.002276_fp * tskin_c**2.0_fp & + + 60.288927_fp*1.0_fp/(40.0_fp - tskin_c)) + fsstemis = max(0.0_fp, fsstemis) + fsstemis = min(7.0_fp, fsstemis) + endif + + RC = 0 + end subroutine jeagleSSTcorrection + + !> + !! \brief Function to compute sea salt emissions following the Gong style parameterization. + !! + !! Functional form is from Gong 2003: + !! \f$dN/dr = scalefac * 1.373 * (w^wpow) * (r^-aFac) * (1+0.057*r^rpow) * 10^(exppow*exp(-bFac^2))\f$ + !! where r is the particle radius at 80% RH, dr is the size bin width at 80% RH, and w is the wind speed + !! + !! \ingroup catchem_seasalt_process + !!!> + pure function SeasaltEmissionGong ( r, dr, w, scalefac, aFac, bFac, rpow, exppow, wpow ) + + real(fp), intent(in) :: r !< Wet particle radius [um] + real(fp), intent(in) :: dr !< Wet particle bin width [um] + real(fp), intent(in) :: w !< Grid box mean wind speed [m s-1] (10-m or ustar wind) + real(fp), intent(in) :: scalefac !< scale factor + real(fp), intent(in) :: aFac + real(fp), intent(in) :: bFac + real(fp), intent(in) :: rpow + real(fp), intent(in) :: exppow + real(fp), intent(in) :: wpow + real(fp) :: SeasaltEmissionGong + + ! Initialize + SeasaltEmissionGong = 0. + + ! Particle size distribution function + SeasaltEmissionGong = scalefac * 1.373_fp*r**(-aFac)*(1._fp+0.057_fp*r**rpow) & + *10._fp**(exppow*exp(-bFac**2._fp))*dr + ! Apply wind speed function + SeasaltEmissionGong = w**wpow * SeasaltEmissionGong + + end function SeasaltEmissionGong + end module SeaSaltScheme_GEOS12_Mod diff --git a/src/process/seasalt/schemes/SeaSaltScheme_GONG03_Mod copy.F90 b/src/process/seasalt/schemes/SeaSaltScheme_GONG03_Mod copy.F90 deleted file mode 100644 index 6499ec39..00000000 --- a/src/process/seasalt/schemes/SeaSaltScheme_GONG03_Mod copy.F90 +++ /dev/null @@ -1,476 +0,0 @@ -!> \file SeaSaltScheme_GONG03_Mod.F90 -!! \brief Gong 2003 sea salt emission scheme with improved sub- and super-micron treatment -!! -!! Pure science kernel for gong03 scheme in seasalt process. -!! This module contains ONLY the computational algorithm with NO infrastructure dependencies. -!! Uses only basic Fortran types for maximum portability and reusability. -!! -!! SCIENCE CUSTOMIZATION GUIDE: -!! 1. Modify the algorithm in compute_gong03 (search for "TODO") -!! 2. Add scheme-specific helper subroutines as needed -!! 3. Update physical constants for your scheme -!! 4. Customize the environmental response functions -!! -!! INFRASTRUCTURE RESPONSIBILITIES (handled by host model): -!! - Parameter initialization and validation -!! - Input array validation and error handling -!! - Memory management and array allocation -!! - Integration with host model time stepping -!! -!! Generated on: 2025-09-16T00:40:10.218304 -!! Author: Barry Baker -!! Reference: Gong [2003] -module SeaSaltScheme_GONG03_Mod - - use precision_mod, only: fp, zero, rae - use SeaSaltCommon_Mod, only: SeaSaltSchemeGONG03Config - use Constants, only: PI !load the constants needed for this scheme - - implicit none - private - - ! Public interface - pure science only - public :: compute_gong03 - - ! Additional physical constants (modify as needed for your scheme) - real(fp), parameter :: T_STANDARD = 303.15_fp ! Standard reference temperature [K] - real(fp), parameter :: DEFAULT_SCALING = 1.0e-9_fp ! Default emission scaling factor - -contains - - !> Pure science computation for gong03 scheme - !! - !! This is a pure computational kernel implementing Gong 2003 sea salt emission scheme with improved sub- and super-micron treatment. - !! NO error checking, validation, or infrastructure concerns. - !! Host model must ensure all inputs are valid before calling. - !! - !! @param[in] num_layers Number of vertical layers - !! @param[in] num_species Number of chemical species - !! @param[in] params Scheme parameters (pre-validated by host) - !! @param[in] frocean FROCEAN field [appropriate units] - !! @param[in] frseaice FRSEAICE field [appropriate units] - !! @param[in] sst SST field [appropriate units] - !! @param[in] u10m U10M field [appropriate units] - !! @param[in] v10m V10M field [appropriate units] - !! @param[in] species_conc Species concentrations [mol/mol] (num_layers, num_species) - !! @param[inout] species_tendencies Species tendency terms [mol/mol/s] (num_layers, num_species) - !! @param[inout] seasalt_mass_emission_total Total mass emission diagnostic [ug/m2/s] - !! @param[inout] seasalt_number_emission_total Total number emission diagnostic [#/m2/s] - !! @param[inout] seasalt_mass_emission_per_bin Mass emission per bin diagnostic [kg/m2/s] (num_species) - !! @param[inout] seasalt_number_emission_per_bin Number emission per bin diagnostic [#/m2/s] (num_species) - !! @param[in] diagnostic_species_id Indices mapping diagnostic species to species array (optional, for per-species diagnostics) - subroutine compute_gong03( & - num_layers, & - num_species, & - params, & - frocean, & - frseaice, & - sst, & - u10m, & - v10m, & - species_density, & - species_radius, & - species_lower_radius, & - species_upper_radius, & - species_conc, & - species_tendencies, & - seasalt_mass_emission_total, & - seasalt_number_emission_total, & - seasalt_mass_emission_per_bin, & - seasalt_number_emission_per_bin, & - diagnostic_species_id & - ) - - ! Arguments - integer, intent(in) :: num_layers - integer, intent(in) :: num_species - type(SeaSaltSchemeGONG03Config), intent(in) :: params - real(fp), intent(in) :: frocean ! Surface field - scalar - real(fp), intent(in) :: frseaice ! Surface field - scalar - real(fp), intent(in) :: sst ! Surface field - scalar - real(fp), intent(in) :: u10m ! Surface field - scalar - real(fp), intent(in) :: v10m ! Surface field - scalar - real(fp), intent(in) :: species_density(num_species) ! Species density property - real(fp), intent(in) :: species_radius(num_species) ! Species radius property - real(fp), intent(in) :: species_lower_radius(num_species) ! Species lower_radius property - real(fp), intent(in) :: species_upper_radius(num_species) ! Species upper_radius property - real(fp), intent(in) :: species_conc(num_layers, num_species) - real(fp), intent(inout) :: species_tendencies(num_layers, num_species) - real(fp), intent(inout), optional :: seasalt_mass_emission_total - real(fp), intent(inout), optional :: seasalt_number_emission_total - real(fp), intent(inout), optional :: seasalt_mass_emission_per_bin(:) - real(fp), intent(inout), optional :: seasalt_number_emission_per_bin(:) - integer, intent(in), optional :: diagnostic_species_id(:) ! Indices mapping diagnostic species to species array - - ! Local variables - integer :: k, RC - integer :: diag_idx ! For diagnostic species indexing - logical :: do_seasalt !< Enable Dust Calculation Flag - integer :: n, ir !< Loop counter - real(fp) :: w10m !< 10m wind speed [m/s] - integer, parameter :: nr = 10 !< Number of (linear) sub-size bins - real(fp), parameter :: r80fac = 1.65_fp !< ratio of radius(RH=0.8)/radius(RH=0.) [Gerber] - real(fp) :: DryRadius !< sub-bin radius (dry, um) - real(fp) :: DeltaDryRadius !< sub-bin radius spacing (dry, um) - real(fp) :: rwet, drwet !< sub-bin radius spacing (rh=80%, um) - real(fp) :: NumberEmissions !< sub-bin number emission rate [#/m2/s] - real(fp) :: MassEmissions !< sub-bin number emission rate [kg/m2/s] - real(fp) :: mass_emission_flux(num_layers, num_species) - real(fp) :: numb_emission_flux(num_layers, num_species) - real(fp) :: aFac - real(fp) :: bFac - real(fp) :: scalefac - real(fp) :: rpow - real(fp) :: exppow - real(fp) :: wpow - real(fp) :: MassScaleFac - real(fp) :: gweibull - real(fp) :: fsstemis - real(fp) :: fhoppel - real(fp) :: scale - - ! Initialize output (pure subroutines must initialize all outputs) - RC = 0 - mass_emission_flux = 0.0_fp - numb_emission_flux = 0.0_fp - MassEmissions = 0.0_fp - NumberEmissions = 0.0_fp - gweibull = 1.0_fp - fsstemis = 1.0_fp - fhoppel = 1.0_fp - - do_seasalt = .true. ! Default value for all cases - - ! Don't do Sea Salt over land - !---------------------------------------------------------------- - scale = FROCEAN - FRSEAICE - if (scale <= 0.0_fp) then - do_seasalt = .False. - endif - - if (do_seasalt) then - ! Gong 03 Params - !--------------- - scalefac = 1._fp - rpow = 3.45_fp - exppow = 1.607_fp - wpow = 3.41_fp - - ! Main computation loop - CUSTOMIZE THIS SECTION FOR YOUR SCHEME - do k = 1, num_layers - - ! get 10m mean wind speed - !------------------------ - w10m = sqrt(U10M ** 2 + V10M ** 2) - - ! Weibull Distribution following Fan and Toon 2011 if WeibullFlag - !---------------------------------------------------------------------------- - call weibullDistribution(gweibull, params%weibull_flag, w10m, RC) - if (RC /= 0) then - RC = -1 - print *, 'Error in weibullDistribution' - return - endif - - ! Get Jeagle SST Correction - call jeagleSSTcorrection(fsstemis, SST,1, RC) - if (RC /= 0) then - RC = -1 - !print *, 'Error in jeagleSSTcorrection' - return - endif - - scale = scale * gweibull * fsstemis * params%scale_factor - - ! Apply to each species - do n = 1, num_species - ! delta dry radius - !----------------- - DeltaDryRadius = (species_upper_radius(n) - species_lower_radius(n) )/ nr - - ! Dry Radius Substep - !------------------- - DryRadius = species_lower_radius(n) + 0.5_fp * DeltaDryRadius - - do ir = 1, nr ! SubSteps - - ! Mass scale fcator - MassScaleFac = scalefac * 4._fp/3._fp*PI*species_density(n)*(DryRadius**3._fp) * 1.e-18_fp - - ! Effective Wet Radius in Sub Step - rwet = r80fac * DryRadius - - ! Effective Delta Wet Radius - drwet = r80fac * DeltaDryRadius - - aFac = 4.7_fp*(1._fp + 30._fp*rwet)**(-0.017_fp*rwet**(-1.44_fp)) - bFac = (0.433_fp-log10(rwet))/0.433_fp - - ! Number emissions flux (# m-2 s-1) - NumberEmissions = NumberEmissions + SeasaltEmissionGong( rwet, drwet, w10m, scalefac, & - aFac, bFac, rpow, exppow, wpow ) - - ! Mass emissions flux (kg m-2 s-1) - MassEmissions = MassEmissions + SeasaltEmissionGong( rwet, drwet, w10m, MassScaleFac, & - aFac, bFac, rpow, exppow, wpow ) - - DryRadius = DryRadius + DeltaDryRadius - - enddo ! ir loop - - mass_emission_flux(k, n) = MassEmissions * scale - numb_emission_flux(k, n) = NumberEmissions * scale - - ! Reset for next species - MassEmissions = 0.0_fp - NumberEmissions = 0.0_fp - - ! Ensure non-negative emissions - species_tendencies(k, n) = max(0.0_fp, mass_emission_flux(k, n)) - - ! TODO: Update diagnostic fields here based on your scheme's requirements - ! Each process should implement custom diagnostic calculations - ! Example patterns: - if (present(seasalt_mass_emission_total)) then - seasalt_mass_emission_total = seasalt_mass_emission_total + mass_emission_flux(k, n) - end if - if (present(seasalt_number_emission_total)) then - seasalt_number_emission_total = seasalt_number_emission_total + numb_emission_flux(k, n) - end if - if (present(seasalt_mass_emission_per_bin) .and. present(diagnostic_species_id)) then - ! Find position of this species in diagnostic_species_id array - do diag_idx = 1, size(diagnostic_species_id) - if (diagnostic_species_id(diag_idx) == n) then - ! Add your custom sea salt mass emission flux per bin calculation - seasalt_mass_emission_per_bin(diag_idx) = mass_emission_flux(k, n) - exit - end if - end do - end if - if (present(seasalt_number_emission_per_bin) .and. present(diagnostic_species_id)) then - ! Find position of this species in diagnostic_species_id array - do diag_idx = 1, size(diagnostic_species_id) - if (diagnostic_species_id(diag_idx) == n) then - ! Add your custom sea salt mass emission flux per bin calculation - seasalt_number_emission_per_bin(diag_idx) = numb_emission_flux(k, n) - exit - end if - end do - end if - end do !species loop - - end do !layer loop - - end if !do_seasalt - - end subroutine compute_gong03 - - ! ======================================================================= - ! SCHEME-SPECIFIC HELPER SUBROUTINES - ! ======================================================================= - ! Add your custom scientific algorithms here as pure functions/subroutines - ! Examples: environmental response functions, species-specific calculations, etc. - - !> - !! \brief Jeagle et al. 2012 SST correction - !! - !! Jaeglé, L., Quinn, P. K., Bates, T. S., Alexander, B., and Lin, J.-T.: - !! Global distribution of sea salt aerosols: new constraints from in situ and remote - !! sensing observations, Atmos. Chem. Phys., 11, 3137–3157, - !! https://doi.org/10.5194/acp-11-3137-2011, 2011. - !! - !! \ingroup catchem_seasalt_process - !!!> - subroutine jeagleSSTcorrection(fsstemis, sst, sstFlag, rc) - - ! !USES: - implicit NONE - - ! !INPUT/OUTPUT PARAMETERS: - real(fp), intent(inout) :: fsstemis ! - real(fp), intent(in) :: sst ! surface temperature (K) - integer, intent(in) :: sstFlag - - ! !OUTPUT PARAMETERS: - integer, optional, intent(out) :: rc - !EOP - - ! !Local Variables - real(fp) :: tskin_c - !EOP - !------------------------------------------------------------------------- - ! Begin... - RC = -1 ! Error code - fsstemis = 1.0_fp - - fsstemis = ZERO - tskin_c = sst - 273.15_fp - if (sstFlag .eq. 1) then - fsstemis = max(0.0_fp,(0.3_fp + 0.1_fp*tskin_c - 0.0076_fp*tskin_c**2 + 0.00021_fp*tskin_c**3)) - else - ! temperature range (0, 36) C - tskin_c = max(-0.1_fp, Tskin_c) - tskin_c = min(36.0_fp, tskin_c) - - fsstemis = (-1.107211_fp -0.010681_fp * tskin_c -0.002276_fp * tskin_c**2.0_fp & - + 60.288927_fp*1.0_fp/(40.0_fp - tskin_c)) - fsstemis = max(0.0_fp, fsstemis) - fsstemis = min(7.0_fp, fsstemis) - endif - - RC = 0 - end subroutine jeagleSSTcorrection - - !> - !! \brief Function to compute sea salt emissions following the Gong style parameterization. - !! - !! Functional form is from Gong 2003: - !! \f$dN/dr = scalefac * 1.373 * (w^wpow) * (r^-aFac) * (1+0.057*r^rpow) * 10^(exppow*exp(-bFac^2))\f$ - !! where r is the particle radius at 80% RH, dr is the size bin width at 80% RH, and w is the wind speed - !! - !! \ingroup catchem_seasalt_process - !!!> - function SeasaltEmissionGong ( r, dr, w, scalefac, aFac, bFac, rpow, exppow, wpow ) - - real(fp), intent(in) :: r !< Wet particle radius [um] - real(fp), intent(in) :: dr !< Wet particle bin width [um] - real(fp), intent(in) :: w !< Grid box mean wind speed [m s-1] (10-m or ustar wind) - real(fp), intent(in) :: scalefac !< scale factor - real(fp), intent(in) :: aFac - real(fp), intent(in) :: bFac - real(fp), intent(in) :: rpow - real(fp), intent(in) :: exppow - real(fp), intent(in) :: wpow - real(fp) :: SeasaltEmissionGong - - ! Initialize - SeasaltEmissionGong = 0. - - ! Particle size distribution function - SeasaltEmissionGong = scalefac * 1.373_fp*r**(-aFac)*(1._fp+0.057_fp*r**rpow) & - *10._fp**(exppow*exp(-bFac**2._fp))*dr - ! Apply wind speed function - SeasaltEmissionGong = w**wpow * SeasaltEmissionGong - - end function SeasaltEmissionGong - - !> - !! \brief Calculate the weibull distribution for 10m wind speed (u10, v10) - !! - !! The Weibull distribution correction ends up being a multiplicative constant - !! (g) times our present source function (see Eq. 12 in Fan & Toon, 2011 and notes for - !! (9/22/11). This constant is derived from the incomplete and complete forms of the gamma - !! function, hence the utilities pasted below. The Weibull function and shape - !! parameters (k, c) assumed are from Justus 1978. - !! - !! \param[inout] gweibull Multiplicative constant - !! \param[in] weibullFlag Flag for weibull correction - !! \param[in] wm 10m wind speed - !! \param[out] RC Return Code - !! - !! \ingroup catchem_seasalt_process - !!!> - subroutine weibullDistribution(gweibull, weibullFlag, wm, RC) - - implicit none - - ! Input/Output - !------------- - real(fp), intent(inout) :: gweibull - - ! Input - !------ - logical, intent(in) :: weibullFlag - real(fp), intent(in) :: wm - - ! Output - !------- - integer, intent(out) :: RC - - ! Local Variables - real(fp) :: a, c, k, wt, x - character(len=256) :: errMsg, thisLoc ! needed for error handling thisLoc - ! Initialize - errMsg = '' - thisLoc = ' -> at weibullDistribution (in util/metutils_mod.F90)' - RC = 0 - gweibull = 1.0_fp - - wt = 4.0_fp - - if (weibullFlag) then - gweibull = 0.0_fp - - if (wm > 0.012_fp) then - k = 0.94_fp * sqrt(wm) - c = wm / gamma(1.0_fp + 1.0_fp / k) - x = (wt / c) ** k - a = 3.41_fp / k + 1.0_fp - gweibull = (c / wm) ** 3.41_fp * igamma(a, x, RC) - endif - endif - - - end subroutine weibullDistribution - - !> - !! \brief Calculate the incomplete Gamma function - !! - !! The incomplete Gamma function is defined as - !! \int_x^\infty t^{A-1}\exp(-t) dt - !! - !! \param[in] A - !! \param[in] X - !! \param[out] RC - !! - !! \ingroup catchem_seasalt_process - !!!> - real(fp) function igamma(A, X, RC) - - IMPLICIT NONE - - REAL(fp), INTENT(in) :: A - REAL(fp), INTENT(IN) :: X - integer, intent(out) :: rc - - ! LOCAL VARIABLE - REAL(fp) :: XAM, GIN, S, R, T0 - INTEGER K - rc = 0 - igamma = 0 - - XAM=-X+A*LOG(X) - IF (XAM.GT.700.0_fp.OR.A.GT.170.0_fp) THEN - WRITE(*,*)'IGAMMA: a and/or x too large, X = ', X - WRITE(*,*) 'A = ', A - rc = -1 - return - ENDIF - - IF (rae(X, 0.0_fp)) THEN - !IF ( X == 0.0_fp) THEN - IGAMMA=GAMMA(A) - - ELSE IF (X.LE.1.0_fp+A) THEN - S=1.0_fp/A - R=S - DO K=1,60 - R=R*X/(A+K) - S=S+R - IF (ABS(R/S).LT.1.0e-15_fp) EXIT - END DO - GIN=EXP(XAM)*S - IGAMMA=GAMMA(A)-GIN - ELSE IF (X.GT.1.0_fp+A) THEN - T0=0.0_fp - DO K=60,1,-1 - T0=(K-A)/(1.0_fp+K/(X+T0)) - end do - - IGAMMA=EXP(XAM)/(X+T0) - - ENDIF - - end function igamma - -end module SeaSaltScheme_GONG03_Mod diff --git a/src/process/seasalt/schemes/SeaSaltScheme_GONG03_Mod.F90 b/src/process/seasalt/schemes/SeaSaltScheme_GONG03_Mod.F90 index e639e09b..36838ac0 100644 --- a/src/process/seasalt/schemes/SeaSaltScheme_GONG03_Mod.F90 +++ b/src/process/seasalt/schemes/SeaSaltScheme_GONG03_Mod.F90 @@ -17,12 +17,12 @@ !! - Memory management and array allocation !! - Integration with host model time stepping !! -!! Generated on: 2025-11-14T23:01:21.740375 +!! Generated on: 2025-09-16T00:40:10.218304 !! Author: Barry Baker !! Reference: Gong [2003] module SeaSaltScheme_GONG03_Mod - use precision_mod, only: fp + use precision_mod, only: fp, zero, rae use SeaSaltCommon_Mod, only: SeaSaltSchemeGONG03Config use Constants, only: PI !load the constants needed for this scheme @@ -47,24 +47,26 @@ module SeaSaltScheme_GONG03_Mod !! @param[in] num_layers Number of vertical layers !! @param[in] num_species Number of chemical species !! @param[in] params Scheme parameters (pre-validated by host) - !! @param[in] delp DELP field [appropriate units] !! @param[in] frocean FROCEAN field [appropriate units] !! @param[in] frseaice FRSEAICE field [appropriate units] !! @param[in] sst SST field [appropriate units] !! @param[in] u10m U10M field [appropriate units] !! @param[in] v10m V10M field [appropriate units] + !! @param[in] species_density Species density property + !! @param[in] species_radius Species radius property + !! @param[in] species_lower_radius Species lower_radius property + !! @param[in] species_upper_radius Species upper_radius property !! @param[in] species_conc Species concentrations [mol/mol] (num_layers, num_species) !! @param[inout] species_tendencies Species tendency terms [mol/mol/s] (num_layers, num_species) - !! @param[inout] seasalt_mass_emission_total Sea salt mass emission flux total [kg/m2/s] - !! @param[inout] seasalt_number_emission_total Sea salt number emission flux total [kg/m2/s] - !! @param[inout] seasalt_mass_emission_per_bin Sea salt mass emission flux per bin [kg/m2/s] (num_species) - !! @param[inout] seasalt_number_emission_per_bin Sea salt number emission flux per bin [kg/m2/s] (num_species) + !! @param[inout] seasalt_mass_emission_total Total mass emission diagnostic [ug/m2/s] + !! @param[inout] seasalt_number_emission_total Total number emission diagnostic [#/m2/s] + !! @param[inout] seasalt_mass_emission_per_bin Mass emission per bin diagnostic [kg/m2/s] (num_species) + !! @param[inout] seasalt_number_emission_per_bin Number emission per bin diagnostic [#/m2/s] (num_species) !! @param[in] diagnostic_species_id Indices mapping diagnostic species to species array (optional, for per-species diagnostics) - pure subroutine compute_gong03( & + subroutine compute_gong03( & num_layers, & num_species, & params, & - delp, & frocean, & frseaice, & sst, & @@ -80,14 +82,13 @@ pure subroutine compute_gong03( & seasalt_number_emission_total, & seasalt_mass_emission_per_bin, & seasalt_number_emission_per_bin, & - diagnostic_species_id & + diagnostic_species_id & ) ! Arguments integer, intent(in) :: num_layers integer, intent(in) :: num_species type(SeaSaltSchemeGONG03Config), intent(in) :: params - real(fp), intent(in) :: delp(num_layers) ! 3D atmospheric field real(fp), intent(in) :: frocean ! Surface field - scalar real(fp), intent(in) :: frseaice ! Surface field - scalar real(fp), intent(in) :: sst ! Surface field - scalar @@ -106,103 +107,165 @@ pure subroutine compute_gong03( & integer, intent(in), optional :: diagnostic_species_id(:) ! Indices mapping diagnostic species to species array ! Local variables - integer :: k, species_idx + integer :: k, RC integer :: diag_idx ! For diagnostic species indexing - real(fp) :: base_emission_factor - real(fp) :: environmental_factor - real(fp) :: species_factor - - ! Note: species_tendencies and diagnostic arrays are already initialized - ! by the host ProcessInterface before calling this subroutine. - ! Do not re-initialize them here. - - ! Main computation loop - CUSTOMIZE THIS SECTION FOR YOUR SCHEME - do k = 1, num_layers - - ! TODO: Replace this generic implementation with your scheme's algorithm - ! This is a placeholder that demonstrates the expected structure - - ! Initialize environmental factors - environmental_factor = 1.0_fp - - ! Apply scheme-specific environmental responses based on meteorological fields - ! Generic field usage (customize for your scheme) - ! TODO: Consider how DELP affects your emissions - ! environmental_factor = environmental_factor * some_function(delp(k)) - ! Generic field usage (customize for your scheme) - ! TODO: Consider how FROCEAN affects your emissions - ! environmental_factor = environmental_factor * some_function(frocean(k)) - ! Generic field usage (customize for your scheme) - ! TODO: Consider how FRSEAICE affects your emissions - ! environmental_factor = environmental_factor * some_function(frseaice(k)) - ! Generic field usage (customize for your scheme) - ! TODO: Consider how SST affects your emissions - ! environmental_factor = environmental_factor * some_function(sst(k)) - ! Generic field usage (customize for your scheme) - ! TODO: Consider how U10M affects your emissions - ! environmental_factor = environmental_factor * some_function(u10m(k)) - ! Generic field usage (customize for your scheme) - ! TODO: Consider how V10M affects your emissions - ! environmental_factor = environmental_factor * some_function(v10m(k)) - - ! Apply to each species - do species_idx = 1, num_species - ! Base emission factor (customize this for species-specific emissions) - base_emission_factor = DEFAULT_SCALING - - ! Species-specific factor (customize based on species properties) - species_factor = 1.0_fp ! TODO: Add species-specific scaling - - ! Compute emission flux using your scheme's formula - ! This is a simple example - replace with your actual algorithm - species_tendencies(k, species_idx) = base_emission_factor * & - environmental_factor * & - species_factor * & - (1.0_fp + species_conc(k, species_idx)) - - ! Ensure non-negative emissions - species_tendencies(k, species_idx) = max(0.0_fp, species_tendencies(k, species_idx)) - - ! TODO: Update diagnostic fields here based on your scheme's requirements - ! Each process should implement custom diagnostic calculations - ! Example patterns: - if (present(seasalt_mass_emission_total)) then - ! Add your custom sea salt mass emission flux total calculation - seasalt_mass_emission_total = seasalt_mass_emission_total + species_tendencies(k, species_idx) * 1.0_fp ! TODO: Replace with actual calculation - end if - if (present(seasalt_number_emission_total)) then - ! Add your custom sea salt number emission flux total calculation - seasalt_number_emission_total = seasalt_number_emission_total + species_tendencies(k, species_idx) * 1.0_fp ! TODO: Replace with actual calculation - end if - - ! TODO: Update scheme-specific diagnostic fields here based on your scheme's requirements - ! Each scheme should implement custom diagnostic calculations - ! Example patterns: - ! Per-species diagnostic: only update for diagnostic species - if (present(seasalt_mass_emission_per_bin) .and. present(diagnostic_species_id)) then - ! Find position of this species in diagnostic_species_id array - do diag_idx = 1, size(diagnostic_species_id) - if (diagnostic_species_id(diag_idx) == species_idx) then - ! Add your custom sea salt mass emission flux per bin calculation - seasalt_mass_emission_per_bin(diag_idx) = species_tendencies(k, species_idx) * 1.0_fp ! TODO: Replace with actual calculation - exit - end if - end do - end if - ! Per-species diagnostic: only update for diagnostic species - if (present(seasalt_number_emission_per_bin) .and. present(diagnostic_species_id)) then - ! Find position of this species in diagnostic_species_id array - do diag_idx = 1, size(diagnostic_species_id) - if (diagnostic_species_id(diag_idx) == species_idx) then - ! Add your custom sea salt number emission flux per bin calculation - seasalt_number_emission_per_bin(diag_idx) = species_tendencies(k, species_idx) * 1.0_fp ! TODO: Replace with actual calculation - exit - end if - end do - end if - end do + logical :: do_seasalt !< Enable Dust Calculation Flag + integer :: n, ir !< Loop counter + real(fp) :: w10m !< 10m wind speed [m/s] + integer, parameter :: nr = 10 !< Number of (linear) sub-size bins + real(fp), parameter :: r80fac = 1.65_fp !< ratio of radius(RH=0.8)/radius(RH=0.) [Gerber] + real(fp) :: DryRadius !< sub-bin radius (dry, um) + real(fp) :: DeltaDryRadius !< sub-bin radius spacing (dry, um) + real(fp) :: rwet, drwet !< sub-bin radius spacing (rh=80%, um) + real(fp) :: NumberEmissions !< sub-bin number emission rate [#/m2/s] + real(fp) :: MassEmissions !< sub-bin number emission rate [kg/m2/s] + real(fp) :: mass_emission_flux(num_layers, num_species) + real(fp) :: numb_emission_flux(num_layers, num_species) + real(fp) :: aFac + real(fp) :: bFac + real(fp) :: scalefac + real(fp) :: rpow + real(fp) :: exppow + real(fp) :: wpow + real(fp) :: MassScaleFac + real(fp) :: gweibull + real(fp) :: fsstemis + real(fp) :: fhoppel + real(fp) :: scale + + ! Initialize output (pure subroutines must initialize all outputs) + RC = 0 + mass_emission_flux = 0.0_fp + numb_emission_flux = 0.0_fp + MassEmissions = 0.0_fp + NumberEmissions = 0.0_fp + gweibull = 1.0_fp + fsstemis = 1.0_fp + fhoppel = 1.0_fp + + do_seasalt = .true. ! Default value for all cases + + ! Don't do Sea Salt over land + !---------------------------------------------------------------- + scale = FROCEAN - FRSEAICE + if (scale <= 0.0_fp) then + do_seasalt = .False. + endif + + if (do_seasalt) then + ! Gong 03 Params + !--------------- + scalefac = 1._fp + rpow = 3.45_fp + exppow = 1.607_fp + wpow = 3.41_fp + + ! Main computation loop - CUSTOMIZE THIS SECTION FOR YOUR SCHEME + do k = 1, num_layers + + ! get 10m mean wind speed + !------------------------ + w10m = sqrt(U10M ** 2 + V10M ** 2) + + ! Weibull Distribution following Fan and Toon 2011 if WeibullFlag + !---------------------------------------------------------------------------- + call weibullDistribution(gweibull, params%weibull_flag, w10m, RC) + if (RC /= 0) then + RC = -1 + print *, 'Error in weibullDistribution' + return + endif + + ! Get Jeagle SST Correction + call jeagleSSTcorrection(fsstemis, SST,1, RC) + if (RC /= 0) then + RC = -1 + !print *, 'Error in jeagleSSTcorrection' + return + endif + + scale = scale * gweibull * fsstemis * params%scale_factor + + ! Apply to each species + do n = 1, num_species + ! delta dry radius + !----------------- + DeltaDryRadius = (species_upper_radius(n) - species_lower_radius(n) )/ nr + + ! Dry Radius Substep + !------------------- + DryRadius = species_lower_radius(n) + 0.5_fp * DeltaDryRadius + + do ir = 1, nr ! SubSteps + + ! Mass scale fcator + MassScaleFac = scalefac * 4._fp/3._fp*PI*species_density(n)*(DryRadius**3._fp) * 1.e-18_fp + + ! Effective Wet Radius in Sub Step + rwet = r80fac * DryRadius + + ! Effective Delta Wet Radius + drwet = r80fac * DeltaDryRadius + + aFac = 4.7_fp*(1._fp + 30._fp*rwet)**(-0.017_fp*rwet**(-1.44_fp)) + bFac = (0.433_fp-log10(rwet))/0.433_fp + + ! Number emissions flux (# m-2 s-1) + NumberEmissions = NumberEmissions + SeasaltEmissionGong( rwet, drwet, w10m, scalefac, & + aFac, bFac, rpow, exppow, wpow ) - end do + ! Mass emissions flux (kg m-2 s-1) + MassEmissions = MassEmissions + SeasaltEmissionGong( rwet, drwet, w10m, MassScaleFac, & + aFac, bFac, rpow, exppow, wpow ) + + DryRadius = DryRadius + DeltaDryRadius + + enddo ! ir loop + + mass_emission_flux(k, n) = MassEmissions * scale + numb_emission_flux(k, n) = NumberEmissions * scale + + ! Reset for next species + MassEmissions = 0.0_fp + NumberEmissions = 0.0_fp + + ! Ensure non-negative emissions + species_tendencies(k, n) = max(0.0_fp, mass_emission_flux(k, n)) + + ! TODO: Update diagnostic fields here based on your scheme's requirements + ! Each process should implement custom diagnostic calculations + ! Example patterns: + if (present(seasalt_mass_emission_total)) then + seasalt_mass_emission_total = seasalt_mass_emission_total + mass_emission_flux(k, n) + end if + if (present(seasalt_number_emission_total)) then + seasalt_number_emission_total = seasalt_number_emission_total + numb_emission_flux(k, n) + end if + if (present(seasalt_mass_emission_per_bin) .and. present(diagnostic_species_id)) then + ! Find position of this species in diagnostic_species_id array + do diag_idx = 1, size(diagnostic_species_id) + if (diagnostic_species_id(diag_idx) == n) then + ! Add your custom sea salt mass emission flux per bin calculation + seasalt_mass_emission_per_bin(diag_idx) = mass_emission_flux(k, n) + exit + end if + end do + end if + if (present(seasalt_number_emission_per_bin) .and. present(diagnostic_species_id)) then + ! Find position of this species in diagnostic_species_id array + do diag_idx = 1, size(diagnostic_species_id) + if (diagnostic_species_id(diag_idx) == n) then + ! Add your custom sea salt mass emission flux per bin calculation + seasalt_number_emission_per_bin(diag_idx) = numb_emission_flux(k, n) + exit + end if + end do + end if + end do !species loop + + end do !layer loop + + end if !do_seasalt end subroutine compute_gong03 @@ -212,33 +275,206 @@ end subroutine compute_gong03 ! Add your custom scientific algorithms here as pure functions/subroutines ! Examples: environmental response functions, species-specific calculations, etc. - !> Example helper function for environmental response - pure function compute_environmental_response_gong03(met_value, reference_value) result(factor) - real(fp), intent(in) :: met_value ! Meteorological value - real(fp), intent(in) :: reference_value ! Reference value - real(fp) :: factor + !> + !! \brief Jeagle et al. 2012 SST correction + !! + !! Jaeglé, L., Quinn, P. K., Bates, T. S., Alexander, B., and Lin, J.-T.: + !! Global distribution of sea salt aerosols: new constraints from in situ and remote + !! sensing observations, Atmos. Chem. Phys., 11, 3137–3157, + !! https://doi.org/10.5194/acp-11-3137-2011, 2011. + !! + !! \ingroup catchem_seasalt_process + !!!> + subroutine jeagleSSTcorrection(fsstemis, sst, sstFlag, rc) - ! Simple exponential response - customize for your scheme - factor = exp((met_value - reference_value) / reference_value) - factor = max(0.0_fp, min(10.0_fp, factor)) ! Reasonable bounds - end function compute_environmental_response_gong03 + ! !USES: + implicit NONE - !> Example helper function for species-specific scaling - pure function compute_species_scaling_gong03(species_idx, params) result(scaling) - integer, intent(in) :: species_idx - type(SeaSaltSchemeGONG03Config), intent(in) :: params - real(fp) :: scaling - - ! Species-specific scaling - customize for your scheme - select case (species_idx) - case (1) - scaling = 1.0_fp ! First species baseline - case (2:3) - scaling = 0.5_fp ! Reduced emission for species 2-3 - case default - scaling = 0.1_fp ! Low emission for other species - end select - - end function compute_species_scaling_gong03 + ! !INPUT/OUTPUT PARAMETERS: + real(fp), intent(inout) :: fsstemis ! + real(fp), intent(in) :: sst ! surface temperature (K) + integer, intent(in) :: sstFlag + + ! !OUTPUT PARAMETERS: + integer, optional, intent(out) :: rc + !EOP + + ! !Local Variables + real(fp) :: tskin_c + !EOP + !------------------------------------------------------------------------- + ! Begin... + RC = -1 ! Error code + fsstemis = 1.0_fp + + fsstemis = ZERO + tskin_c = sst - 273.15_fp + if (sstFlag .eq. 1) then + fsstemis = max(0.0_fp,(0.3_fp + 0.1_fp*tskin_c - 0.0076_fp*tskin_c**2 + 0.00021_fp*tskin_c**3)) + else + ! temperature range (0, 36) C + tskin_c = max(-0.1_fp, Tskin_c) + tskin_c = min(36.0_fp, tskin_c) + + fsstemis = (-1.107211_fp -0.010681_fp * tskin_c -0.002276_fp * tskin_c**2.0_fp & + + 60.288927_fp*1.0_fp/(40.0_fp - tskin_c)) + fsstemis = max(0.0_fp, fsstemis) + fsstemis = min(7.0_fp, fsstemis) + endif + + RC = 0 + end subroutine jeagleSSTcorrection + + !> + !! \brief Function to compute sea salt emissions following the Gong style parameterization. + !! + !! Functional form is from Gong 2003: + !! \f$dN/dr = scalefac * 1.373 * (w^wpow) * (r^-aFac) * (1+0.057*r^rpow) * 10^(exppow*exp(-bFac^2))\f$ + !! where r is the particle radius at 80% RH, dr is the size bin width at 80% RH, and w is the wind speed + !! + !! \ingroup catchem_seasalt_process + !!!> + function SeasaltEmissionGong ( r, dr, w, scalefac, aFac, bFac, rpow, exppow, wpow ) + + real(fp), intent(in) :: r !< Wet particle radius [um] + real(fp), intent(in) :: dr !< Wet particle bin width [um] + real(fp), intent(in) :: w !< Grid box mean wind speed [m s-1] (10-m or ustar wind) + real(fp), intent(in) :: scalefac !< scale factor + real(fp), intent(in) :: aFac + real(fp), intent(in) :: bFac + real(fp), intent(in) :: rpow + real(fp), intent(in) :: exppow + real(fp), intent(in) :: wpow + real(fp) :: SeasaltEmissionGong + + ! Initialize + SeasaltEmissionGong = 0. + + ! Particle size distribution function + SeasaltEmissionGong = scalefac * 1.373_fp*r**(-aFac)*(1._fp+0.057_fp*r**rpow) & + *10._fp**(exppow*exp(-bFac**2._fp))*dr + ! Apply wind speed function + SeasaltEmissionGong = w**wpow * SeasaltEmissionGong + + end function SeasaltEmissionGong + + !> + !! \brief Calculate the weibull distribution for 10m wind speed (u10, v10) + !! + !! The Weibull distribution correction ends up being a multiplicative constant + !! (g) times our present source function (see Eq. 12 in Fan & Toon, 2011 and notes for + !! (9/22/11). This constant is derived from the incomplete and complete forms of the gamma + !! function, hence the utilities pasted below. The Weibull function and shape + !! parameters (k, c) assumed are from Justus 1978. + !! + !! \param[inout] gweibull Multiplicative constant + !! \param[in] weibullFlag Flag for weibull correction + !! \param[in] wm 10m wind speed + !! \param[out] RC Return Code + !! + !! \ingroup catchem_seasalt_process + !!!> + subroutine weibullDistribution(gweibull, weibullFlag, wm, RC) + + implicit none + + ! Input/Output + !------------- + real(fp), intent(inout) :: gweibull + + ! Input + !------ + logical, intent(in) :: weibullFlag + real(fp), intent(in) :: wm + + ! Output + !------- + integer, intent(out) :: RC + + ! Local Variables + real(fp) :: a, c, k, wt, x + character(len=256) :: errMsg, thisLoc ! needed for error handling thisLoc + ! Initialize + errMsg = '' + thisLoc = ' -> at weibullDistribution (in util/metutils_mod.F90)' + RC = 0 + gweibull = 1.0_fp + + wt = 4.0_fp + + if (weibullFlag) then + gweibull = 0.0_fp + + if (wm > 0.012_fp) then + k = 0.94_fp * sqrt(wm) + c = wm / gamma(1.0_fp + 1.0_fp / k) + x = (wt / c) ** k + a = 3.41_fp / k + 1.0_fp + gweibull = (c / wm) ** 3.41_fp * igamma(a, x, RC) + endif + endif + + + end subroutine weibullDistribution + + !> + !! \brief Calculate the incomplete Gamma function + !! + !! The incomplete Gamma function is defined as + !! \int_x^\infty t^{A-1}\exp(-t) dt + !! + !! \param[in] A + !! \param[in] X + !! \param[out] RC + !! + !! \ingroup catchem_seasalt_process + !!!> + real(fp) function igamma(A, X, RC) + + IMPLICIT NONE + + REAL(fp), INTENT(in) :: A + REAL(fp), INTENT(IN) :: X + integer, intent(out) :: rc + + ! LOCAL VARIABLE + REAL(fp) :: XAM, GIN, S, R, T0 + INTEGER K + rc = 0 + igamma = 0 + + XAM=-X+A*LOG(X) + IF (XAM.GT.700.0_fp.OR.A.GT.170.0_fp) THEN + WRITE(*,*)'IGAMMA: a and/or x too large, X = ', X + WRITE(*,*) 'A = ', A + rc = -1 + return + ENDIF + + IF (rae(X, 0.0_fp)) THEN + !IF ( X == 0.0_fp) THEN + IGAMMA=GAMMA(A) + + ELSE IF (X.LE.1.0_fp+A) THEN + S=1.0_fp/A + R=S + DO K=1,60 + R=R*X/(A+K) + S=S+R + IF (ABS(R/S).LT.1.0e-15_fp) EXIT + END DO + GIN=EXP(XAM)*S + IGAMMA=GAMMA(A)-GIN + ELSE IF (X.GT.1.0_fp+A) THEN + T0=0.0_fp + DO K=60,1,-1 + T0=(K-A)/(1.0_fp+K/(X+T0)) + end do + + IGAMMA=EXP(XAM)/(X+T0) + + ENDIF + + end function igamma end module SeaSaltScheme_GONG03_Mod diff --git a/src/process/seasalt/schemes/SeaSaltScheme_GONG97_Mod copy.F90 b/src/process/seasalt/schemes/SeaSaltScheme_GONG97_Mod copy.F90 deleted file mode 100644 index b55fcf59..00000000 --- a/src/process/seasalt/schemes/SeaSaltScheme_GONG97_Mod copy.F90 +++ /dev/null @@ -1,478 +0,0 @@ -!> \file SeaSaltScheme_GONG97_Mod.F90 -!! \brief Gong 1997 sea salt emission scheme -!! -!! Pure science kernel for gong97 scheme in seasalt process. -!! This module contains ONLY the computational algorithm with NO infrastructure dependencies. -!! Uses only basic Fortran types for maximum portability and reusability. -!! -!! SCIENCE CUSTOMIZATION GUIDE: -!! 1. Modify the algorithm in compute_gong97 (search for "TODO") -!! 2. Add scheme-specific helper subroutines as needed -!! 3. Update physical constants for your scheme -!! 4. Customize the environmental response functions -!! -!! INFRASTRUCTURE RESPONSIBILITIES (handled by host model): -!! - Parameter initialization and validation -!! - Input array validation and error handling -!! - Memory management and array allocation -!! - Integration with host model time stepping -!! -!! Generated on: 2025-09-16T00:40:10.206610 -!! Author: Barry Baker -!! Reference: Gong et al. [1997] -module SeaSaltScheme_GONG97_Mod - - use precision_mod, only: fp,zero, rae - use SeaSaltCommon_Mod, only: SeaSaltSchemeGONG97Config - use Constants, only: PI !load the constants needed for this scheme - - implicit none - private - - ! Public interface - pure science only - public :: compute_gong97 - - ! Additional physical constants (modify as needed for your scheme) - real(fp), parameter :: T_STANDARD = 303.15_fp ! Standard reference temperature [K] - real(fp), parameter :: DEFAULT_SCALING = 1.0e-9_fp ! Default emission scaling factor - -contains - - !> Pure science computation for gong97 scheme - !! - !! This is a pure computational kernel implementing Gong 1997 sea salt emission scheme. - !! NO error checking, validation, or infrastructure concerns. - !! Host model must ensure all inputs are valid before calling. - !! - !! @param[in] num_layers Number of vertical layers - !! @param[in] num_species Number of chemical species - !! @param[in] params Scheme parameters (pre-validated by host) - !! @param[in] frocean FROCEAN field [appropriate units] - !! @param[in] frseaice FRSEAICE field [appropriate units] - !! @param[in] sst SST field [appropriate units] - !! @param[in] u10m U10M field [appropriate units] - !! @param[in] v10m V10M field [appropriate units] - !! @param[in] species_conc Species concentrations [mol/mol] (num_layers, num_species) - !! @param[inout] species_tendencies Species tendency terms [mol/mol/s] (num_layers, num_species) - !! @param[inout] seasalt_mass_emission_total Total mass emission diagnostic [ug/m2/s] - !! @param[inout] seasalt_number_emission_total Total number emission diagnostic [#/m2/s] - !! @param[inout] seasalt_mass_emission_per_bin Mass emission per bin diagnostic [kg/m2/s] (num_species) - !! @param[inout] seasalt_number_emission_per_bin Number emission per bin diagnostic [#/m2/s] (num_species) - !! @param[in] diagnostic_species_id Indices mapping diagnostic species to species array (optional, for per-species diagnostics) - subroutine compute_gong97( & - num_layers, & - num_species, & - params, & - frocean, & - frseaice, & - sst, & - u10m, & - v10m, & - species_density, & - species_radius, & - species_lower_radius, & - species_upper_radius, & - species_conc, & - species_tendencies, & - seasalt_mass_emission_total, & - seasalt_number_emission_total, & - seasalt_mass_emission_per_bin, & - seasalt_number_emission_per_bin, & - diagnostic_species_id & - ) - - ! Arguments - integer, intent(in) :: num_layers - integer, intent(in) :: num_species - type(SeaSaltSchemeGONG97Config), intent(in) :: params - real(fp), intent(in) :: frocean ! Surface field - scalar - real(fp), intent(in) :: frseaice ! Surface field - scalar - real(fp), intent(in) :: sst ! Surface field - scalar - real(fp), intent(in) :: u10m ! Surface field - scalar - real(fp), intent(in) :: v10m ! Surface field - scalar - real(fp), intent(in) :: species_density(num_species) ! Species density property - real(fp), intent(in) :: species_radius(num_species) ! Species radius property - real(fp), intent(in) :: species_lower_radius(num_species) ! Species lower_radius property - real(fp), intent(in) :: species_upper_radius(num_species) ! Species upper_radius property - real(fp), intent(in) :: species_conc(num_layers, num_species) - real(fp), intent(inout) :: species_tendencies(num_layers, num_species) - real(fp), intent(inout), optional :: seasalt_mass_emission_total - real(fp), intent(inout), optional :: seasalt_number_emission_total - real(fp), intent(inout), optional :: seasalt_mass_emission_per_bin(:) - real(fp), intent(inout), optional :: seasalt_number_emission_per_bin(:) - integer, intent(in), optional :: diagnostic_species_id(:) ! Indices mapping diagnostic species to species array - - ! Local variables - integer :: k, RC - integer :: diag_idx ! For diagnostic species indexing - logical :: do_seasalt !< Enable Dust Calculation Flag - integer :: n, ir !< Loop counter - real(fp) :: w10m !< 10m wind speed [m/s] - integer, parameter :: nr = 10 !< Number of (linear) sub-size bins - real, parameter :: r80fac = 1.65_fp !< ratio of radius(RH=0.8)/radius(RH=0.) [Gerber] - real(fp) :: DryRadius !< sub-bin radius (dry, um) - real(fp) :: DeltaDryRadius !< sub-bin radius spacing (dry, um) - real(fp) :: rwet, drwet !< sub-bin radius spacing (rh=80%, um) - real(fp) :: NumberEmissions !< sub-bin number emission rate [#/m2/s] - real(fp) :: MassEmissions !< sub-bin number emission rate [kg/m2/s] - real(fp) :: mass_emission_flux(num_layers, num_species) - real(fp) :: numb_emission_flux(num_layers, num_species) - real(fp) :: aFac - real(fp) :: bFac - real(fp) :: scalefac - real(fp) :: rpow - real(fp) :: exppow - real(fp) :: wpow - real(fp) :: MassScaleFac - real(fp) :: gweibull - real(fp) :: fsstemis - real(fp) :: fhoppel - real(fp) :: scale - - - ! Initialize output (pure subroutines must initialize all outputs) - RC = 0 - mass_emission_flux = 0.0_fp - numb_emission_flux = 0.0_fp - MassEmissions = 0.0_fp - NumberEmissions = 0.0_fp - gweibull = 1.0_fp - fsstemis = 1.0_fp - fhoppel = 1.0_fp - - - do_seasalt = .true. ! Default value for all cases - - ! Don't do Sea Salt over land - !---------------------------------------------------------------- - scale = FROCEAN - FRSEAICE - if (scale <= 0.0_fp) then - do_seasalt = .False. - endif - - if (do_seasalt) then - ! Gong 1997 Params - !----------------- - scalefac = 3.0_fp - rpow = 1.05_fp - exppow = 1.19_fp - wpow = 3.41_fp - - ! Main computation loop - CUSTOMIZE THIS SECTION FOR YOUR SCHEME - do k = 1, num_layers - - ! get 10m mean wind speed - !------------------------ - w10m = sqrt(U10M ** 2 + V10M ** 2) - - ! Weibull Distribution following Fan and Toon 2011 if WeibullFlag - !---------------------------------------------------------------------------- - call weibullDistribution(gweibull, params%weibull_flag, w10m, RC) - if (RC /= 0) then - RC = -1 - print *, 'Error in weibullDistribution' !TODO: this may not allowed in a pure function - return - endif - - ! Get Jeagle SST Correction - call jeagleSSTcorrection(fsstemis, SST,1, RC) - if (RC /= 0) then - RC = -1 - print *, 'Error in jeagleSSTcorrection' - return - endif - - scale = scale * gweibull * fsstemis * params%scale_factor - - ! Apply to each species - do n = 1, num_species - ! delta dry radius - !----------------- - DeltaDryRadius = (species_upper_radius(n) - species_lower_radius(n) )/ nr - - ! Dry Radius Substep - !------------------- - DryRadius = species_lower_radius(n) + 0.5 * DeltaDryRadius - - do ir = 1, nr ! SubSteps - - ! Mass scale fcator - MassScaleFac = scalefac * 4._fp/3._fp*PI*species_density(n)*(DryRadius**3._fp) * 1.e-18_fp - - ! Effective Wet Radius in Sub Step - rwet = r80fac * DryRadius - - ! Effective Delta Wet Radius - drwet = r80fac * DeltaDryRadius - - aFac = 3.0_fp - bFac = (0.380_fp-log10(rwet))/0.650_fp - - ! Number emissions flux (# m-2 s-1) - NumberEmissions = NumberEmissions + SeasaltEmissionGong( rwet, drwet, w10m, scalefac, & - aFac, bFac, rpow, exppow, wpow ) - - ! Mass emissions flux (kg m-2 s-1) - MassEmissions = MassEmissions + SeasaltEmissionGong( rwet, drwet, w10m, MassScaleFac, & - aFac, bFac, rpow, exppow, wpow ) - - DryRadius = DryRadius + DeltaDryRadius - - enddo ! ir loop - - mass_emission_flux(k, n) = MassEmissions * scale - numb_emission_flux(k, n) = NumberEmissions * scale - - ! Reset for next species - MassEmissions = 0.0_fp - NumberEmissions = 0.0_fp - - ! Ensure non-negative emissions - species_tendencies(k, n) = max(0.0_fp, mass_emission_flux(k, n)) - - ! TODO: Update diagnostic fields here based on your scheme's requirements - ! Each process should implement custom diagnostic calculations - ! Example patterns: - if (present(seasalt_mass_emission_total)) then - seasalt_mass_emission_total = seasalt_mass_emission_total + mass_emission_flux(k, n) - end if - if (present(seasalt_number_emission_total)) then - seasalt_number_emission_total = seasalt_number_emission_total + numb_emission_flux(k, n) - end if - if (present(seasalt_mass_emission_per_bin) .and. present(diagnostic_species_id)) then - ! Find position of this species in diagnostic_species_id array - do diag_idx = 1, size(diagnostic_species_id) - if (diagnostic_species_id(diag_idx) == n) then - ! Add your custom sea salt mass emission flux per bin calculation - seasalt_mass_emission_per_bin(diag_idx) = mass_emission_flux(k, n) - exit - end if - end do - end if - if (present(seasalt_number_emission_per_bin) .and. present(diagnostic_species_id)) then - ! Find position of this species in diagnostic_species_id array - do diag_idx = 1, size(diagnostic_species_id) - if (diagnostic_species_id(diag_idx) == n) then - ! Add your custom sea salt mass emission flux per bin calculation - seasalt_number_emission_per_bin(diag_idx) = numb_emission_flux(k, n) - exit - end if - end do - end if - end do - - end do - - end if - - end subroutine compute_gong97 - - ! ======================================================================= - ! SCHEME-SPECIFIC HELPER SUBROUTINES - ! ======================================================================= - ! Add your custom scientific algorithms here as pure functions/subroutines - ! Examples: environmental response functions, species-specific calculations, etc. - - !> - !! \brief Jeagle et al. 2012 SST correction - !! - !! Jaeglé, L., Quinn, P. K., Bates, T. S., Alexander, B., and Lin, J.-T.: - !! Global distribution of sea salt aerosols: new constraints from in situ and remote - !! sensing observations, Atmos. Chem. Phys., 11, 3137–3157, - !! https://doi.org/10.5194/acp-11-3137-2011, 2011. - !! - !! \ingroup catchem_seasalt_process - !!!> - subroutine jeagleSSTcorrection(fsstemis, sst, sstFlag, rc) - - ! !USES: - implicit NONE - - ! !INPUT/OUTPUT PARAMETERS: - real(fp), intent(inout) :: fsstemis ! - real(fp), intent(in) :: sst ! surface temperature (K) - integer, intent(in) :: sstFlag - - ! !OUTPUT PARAMETERS: - integer, optional, intent(out) :: rc - !EOP - - ! !Local Variables - real(fp) :: tskin_c - !EOP - !------------------------------------------------------------------------- - ! Begin... - RC = -1 ! Error code - fsstemis = 1.0_fp - - fsstemis = ZERO - tskin_c = sst - 273.15_fp - if (sstFlag .eq. 1) then - fsstemis = max(0.0_fp,(0.3_fp + 0.1_fp*tskin_c - 0.0076_fp*tskin_c**2 + 0.00021_fp*tskin_c**3)) - else - ! temperature range (0, 36) C - tskin_c = max(-0.1_fp, Tskin_c) - tskin_c = min(36.0_fp, tskin_c) - - fsstemis = (-1.107211_fp -0.010681_fp * tskin_c -0.002276_fp * tskin_c**2.0_fp & - + 60.288927_fp*1.0_fp/(40.0_fp - tskin_c)) - fsstemis = max(0.0_fp, fsstemis) - fsstemis = min(7.0_fp, fsstemis) - endif - - RC = 0 - end subroutine jeagleSSTcorrection - - !> - !! \brief Function to compute sea salt emissions following the Gong style parameterization. - !! - !! Functional form is from Gong 2003: - !! \f$dN/dr = scalefac * 1.373 * (w^wpow) * (r^-aFac) * (1+0.057*r^rpow) * 10^(exppow*exp(-bFac^2))\f$ - !! where r is the particle radius at 80% RH, dr is the size bin width at 80% RH, and w is the wind speed - !! - !! \ingroup catchem_seasalt_process - !!!> - function SeasaltEmissionGong ( r, dr, w, scalefac, aFac, bFac, rpow, exppow, wpow ) - - real(fp), intent(in) :: r !< Wet particle radius [um] - real(fp), intent(in) :: dr !< Wet particle bin width [um] - real(fp), intent(in) :: w !< Grid box mean wind speed [m s-1] (10-m or ustar wind) - real(fp), intent(in) :: scalefac !< scale factor - real(fp), intent(in) :: aFac - real(fp), intent(in) :: bFac - real(fp), intent(in) :: rpow - real(fp), intent(in) :: exppow - real(fp), intent(in) :: wpow - real(fp) :: SeasaltEmissionGong - - ! Initialize - SeasaltEmissionGong = 0. - - ! Particle size distribution function - SeasaltEmissionGong = scalefac * 1.373_fp*r**(-aFac)*(1._fp+0.057_fp*r**rpow) & - *10._fp**(exppow*exp(-bFac**2._fp))*dr - ! Apply wind speed function - SeasaltEmissionGong = w**wpow * SeasaltEmissionGong - - end function SeasaltEmissionGong - - !> - !! \brief Calculate the weibull distribution for 10m wind speed (u10, v10) - !! - !! The Weibull distribution correction ends up being a multiplicative constant - !! (g) times our present source function (see Eq. 12 in Fan & Toon, 2011 and notes for - !! (9/22/11). This constant is derived from the incomplete and complete forms of the gamma - !! function, hence the utilities pasted below. The Weibull function and shape - !! parameters (k, c) assumed are from Justus 1978. - !! - !! \param[inout] gweibull Multiplicative constant - !! \param[in] weibullFlag Flag for weibull correction - !! \param[in] wm 10m wind speed - !! \param[out] RC Return Code - !! - !! \ingroup catchem_seasalt_process - !!!> - subroutine weibullDistribution(gweibull, weibullFlag, wm, RC) - - implicit none - - ! Input/Output - !------------- - real(fp), intent(inout) :: gweibull - - ! Input - !------ - logical, intent(in) :: weibullFlag - real(fp), intent(in) :: wm - - ! Output - !------- - integer, intent(out) :: RC - - ! Local Variables - real(fp) :: a, c, k, wt, x - character(len=256) :: errMsg, thisLoc ! needed for error handling thisLoc - ! Initialize - errMsg = '' - thisLoc = ' -> at weibullDistribution (in util/metutils_mod.F90)' - RC = 0 - gweibull = 1.0_fp - - wt = 4.0_fp - - if (weibullFlag) then - gweibull = 0.0_fp - - if (wm > 0.012_fp) then - k = 0.94_fp * sqrt(wm) - c = wm / gamma(1.0_fp + 1.0_fp / k) - x = (wt / c) ** k - a = 3.41_fp / k + 1.0_fp - gweibull = (c / wm) ** 3.41_fp * igamma(a, x, RC) - endif - endif - - - end subroutine weibullDistribution - - !> - !! \brief Calculate the incomplete Gamma function - !! - !! The incomplete Gamma function is defined as - !! \int_x^\infty t^{A-1}\exp(-t) dt - !! - !! \param[in] A - !! \param[in] X - !! \param[out] RC - !! - !! \ingroup catchem_seasalt_process - !!!> - real(fp) function igamma(A, X, RC) - - IMPLICIT NONE - - REAL(fp), INTENT(in) :: A - REAL(fp), INTENT(IN) :: X - integer, intent(out) :: rc - - ! LOCAL VARIABLE - REAL(fp) :: XAM, GIN, S, R, T0 - INTEGER K - rc = 0 - igamma = 0 - - XAM=-X+A*LOG(X) - IF (XAM.GT.700.0_fp.OR.A.GT.170.0_fp) THEN - WRITE(*,*)'IGAMMA: a and/or x too large, X = ', X - WRITE(*,*) 'A = ', A - rc = -1 - return - ENDIF - - IF (rae(X, 0.0_fp)) THEN - !IF ( X == 0.0_fp) THEN - IGAMMA=GAMMA(A) - - ELSE IF (X.LE.1.0_fp+A) THEN - S=1.0_fp/A - R=S - DO K=1,60 - R=R*X/(A+K) - S=S+R - IF (ABS(R/S).LT.1.0e-15_fp) EXIT - END DO - GIN=EXP(XAM)*S - IGAMMA=GAMMA(A)-GIN - ELSE IF (X.GT.1.0_fp+A) THEN - T0=0.0_fp - DO K=60,1,-1 - T0=(K-A)/(1.0_fp+K/(X+T0)) - end do - - IGAMMA=EXP(XAM)/(X+T0) - - ENDIF - - end function igamma - -end module SeaSaltScheme_GONG97_Mod diff --git a/src/process/seasalt/schemes/SeaSaltScheme_GONG97_Mod.F90 b/src/process/seasalt/schemes/SeaSaltScheme_GONG97_Mod.F90 index 1deaa8a6..75d3a530 100644 --- a/src/process/seasalt/schemes/SeaSaltScheme_GONG97_Mod.F90 +++ b/src/process/seasalt/schemes/SeaSaltScheme_GONG97_Mod.F90 @@ -17,12 +17,12 @@ !! - Memory management and array allocation !! - Integration with host model time stepping !! -!! Generated on: 2025-11-14T23:01:21.714170 +!! Generated on: 2025-09-16T00:40:10.206610 !! Author: Barry Baker !! Reference: Gong et al. [1997] module SeaSaltScheme_GONG97_Mod - use precision_mod, only: fp + use precision_mod, only: fp,zero, rae use SeaSaltCommon_Mod, only: SeaSaltSchemeGONG97Config use Constants, only: PI !load the constants needed for this scheme @@ -47,24 +47,26 @@ module SeaSaltScheme_GONG97_Mod !! @param[in] num_layers Number of vertical layers !! @param[in] num_species Number of chemical species !! @param[in] params Scheme parameters (pre-validated by host) - !! @param[in] delp DELP field [appropriate units] !! @param[in] frocean FROCEAN field [appropriate units] !! @param[in] frseaice FRSEAICE field [appropriate units] !! @param[in] sst SST field [appropriate units] !! @param[in] u10m U10M field [appropriate units] !! @param[in] v10m V10M field [appropriate units] + !! @param[in] species_density Species density property + !! @param[in] species_radius Species radius property + !! @param[in] species_lower_radius Species lower_radius property + !! @param[in] species_upper_radius Species upper_radius property !! @param[in] species_conc Species concentrations [mol/mol] (num_layers, num_species) !! @param[inout] species_tendencies Species tendency terms [mol/mol/s] (num_layers, num_species) - !! @param[inout] seasalt_mass_emission_total Sea salt mass emission flux total [kg/m2/s] - !! @param[inout] seasalt_number_emission_total Sea salt number emission flux total [kg/m2/s] - !! @param[inout] seasalt_mass_emission_per_bin Sea salt mass emission flux per bin [kg/m2/s] (num_species) - !! @param[inout] seasalt_number_emission_per_bin Sea salt number emission flux per bin [kg/m2/s] (num_species) + !! @param[inout] seasalt_mass_emission_total Total mass emission diagnostic [ug/m2/s] + !! @param[inout] seasalt_number_emission_total Total number emission diagnostic [#/m2/s] + !! @param[inout] seasalt_mass_emission_per_bin Mass emission per bin diagnostic [kg/m2/s] (num_species) + !! @param[inout] seasalt_number_emission_per_bin Number emission per bin diagnostic [#/m2/s] (num_species) !! @param[in] diagnostic_species_id Indices mapping diagnostic species to species array (optional, for per-species diagnostics) - pure subroutine compute_gong97( & + subroutine compute_gong97( & num_layers, & num_species, & params, & - delp, & frocean, & frseaice, & sst, & @@ -80,14 +82,13 @@ pure subroutine compute_gong97( & seasalt_number_emission_total, & seasalt_mass_emission_per_bin, & seasalt_number_emission_per_bin, & - diagnostic_species_id & + diagnostic_species_id & ) ! Arguments integer, intent(in) :: num_layers integer, intent(in) :: num_species type(SeaSaltSchemeGONG97Config), intent(in) :: params - real(fp), intent(in) :: delp(num_layers) ! 3D atmospheric field real(fp), intent(in) :: frocean ! Surface field - scalar real(fp), intent(in) :: frseaice ! Surface field - scalar real(fp), intent(in) :: sst ! Surface field - scalar @@ -106,103 +107,167 @@ pure subroutine compute_gong97( & integer, intent(in), optional :: diagnostic_species_id(:) ! Indices mapping diagnostic species to species array ! Local variables - integer :: k, species_idx + integer :: k, RC integer :: diag_idx ! For diagnostic species indexing - real(fp) :: base_emission_factor - real(fp) :: environmental_factor - real(fp) :: species_factor - - ! Note: species_tendencies and diagnostic arrays are already initialized - ! by the host ProcessInterface before calling this subroutine. - ! Do not re-initialize them here. - - ! Main computation loop - CUSTOMIZE THIS SECTION FOR YOUR SCHEME - do k = 1, num_layers - - ! TODO: Replace this generic implementation with your scheme's algorithm - ! This is a placeholder that demonstrates the expected structure - - ! Initialize environmental factors - environmental_factor = 1.0_fp - - ! Apply scheme-specific environmental responses based on meteorological fields - ! Generic field usage (customize for your scheme) - ! TODO: Consider how DELP affects your emissions - ! environmental_factor = environmental_factor * some_function(delp(k)) - ! Generic field usage (customize for your scheme) - ! TODO: Consider how FROCEAN affects your emissions - ! environmental_factor = environmental_factor * some_function(frocean(k)) - ! Generic field usage (customize for your scheme) - ! TODO: Consider how FRSEAICE affects your emissions - ! environmental_factor = environmental_factor * some_function(frseaice(k)) - ! Generic field usage (customize for your scheme) - ! TODO: Consider how SST affects your emissions - ! environmental_factor = environmental_factor * some_function(sst(k)) - ! Generic field usage (customize for your scheme) - ! TODO: Consider how U10M affects your emissions - ! environmental_factor = environmental_factor * some_function(u10m(k)) - ! Generic field usage (customize for your scheme) - ! TODO: Consider how V10M affects your emissions - ! environmental_factor = environmental_factor * some_function(v10m(k)) - - ! Apply to each species - do species_idx = 1, num_species - ! Base emission factor (customize this for species-specific emissions) - base_emission_factor = DEFAULT_SCALING - - ! Species-specific factor (customize based on species properties) - species_factor = 1.0_fp ! TODO: Add species-specific scaling - - ! Compute emission flux using your scheme's formula - ! This is a simple example - replace with your actual algorithm - species_tendencies(k, species_idx) = base_emission_factor * & - environmental_factor * & - species_factor * & - (1.0_fp + species_conc(k, species_idx)) - - ! Ensure non-negative emissions - species_tendencies(k, species_idx) = max(0.0_fp, species_tendencies(k, species_idx)) - - ! TODO: Update diagnostic fields here based on your scheme's requirements - ! Each process should implement custom diagnostic calculations - ! Example patterns: - if (present(seasalt_mass_emission_total)) then - ! Add your custom sea salt mass emission flux total calculation - seasalt_mass_emission_total = seasalt_mass_emission_total + species_tendencies(k, species_idx) * 1.0_fp ! TODO: Replace with actual calculation - end if - if (present(seasalt_number_emission_total)) then - ! Add your custom sea salt number emission flux total calculation - seasalt_number_emission_total = seasalt_number_emission_total + species_tendencies(k, species_idx) * 1.0_fp ! TODO: Replace with actual calculation - end if - - ! TODO: Update scheme-specific diagnostic fields here based on your scheme's requirements - ! Each scheme should implement custom diagnostic calculations - ! Example patterns: - ! Per-species diagnostic: only update for diagnostic species - if (present(seasalt_mass_emission_per_bin) .and. present(diagnostic_species_id)) then - ! Find position of this species in diagnostic_species_id array - do diag_idx = 1, size(diagnostic_species_id) - if (diagnostic_species_id(diag_idx) == species_idx) then - ! Add your custom sea salt mass emission flux per bin calculation - seasalt_mass_emission_per_bin(diag_idx) = species_tendencies(k, species_idx) * 1.0_fp ! TODO: Replace with actual calculation - exit - end if - end do - end if - ! Per-species diagnostic: only update for diagnostic species - if (present(seasalt_number_emission_per_bin) .and. present(diagnostic_species_id)) then - ! Find position of this species in diagnostic_species_id array - do diag_idx = 1, size(diagnostic_species_id) - if (diagnostic_species_id(diag_idx) == species_idx) then - ! Add your custom sea salt number emission flux per bin calculation - seasalt_number_emission_per_bin(diag_idx) = species_tendencies(k, species_idx) * 1.0_fp ! TODO: Replace with actual calculation - exit - end if - end do - end if + logical :: do_seasalt !< Enable Dust Calculation Flag + integer :: n, ir !< Loop counter + real(fp) :: w10m !< 10m wind speed [m/s] + integer, parameter :: nr = 10 !< Number of (linear) sub-size bins + real, parameter :: r80fac = 1.65_fp !< ratio of radius(RH=0.8)/radius(RH=0.) [Gerber] + real(fp) :: DryRadius !< sub-bin radius (dry, um) + real(fp) :: DeltaDryRadius !< sub-bin radius spacing (dry, um) + real(fp) :: rwet, drwet !< sub-bin radius spacing (rh=80%, um) + real(fp) :: NumberEmissions !< sub-bin number emission rate [#/m2/s] + real(fp) :: MassEmissions !< sub-bin number emission rate [kg/m2/s] + real(fp) :: mass_emission_flux(num_layers, num_species) + real(fp) :: numb_emission_flux(num_layers, num_species) + real(fp) :: aFac + real(fp) :: bFac + real(fp) :: scalefac + real(fp) :: rpow + real(fp) :: exppow + real(fp) :: wpow + real(fp) :: MassScaleFac + real(fp) :: gweibull + real(fp) :: fsstemis + real(fp) :: fhoppel + real(fp) :: scale + + + ! Initialize output (pure subroutines must initialize all outputs) + RC = 0 + mass_emission_flux = 0.0_fp + numb_emission_flux = 0.0_fp + MassEmissions = 0.0_fp + NumberEmissions = 0.0_fp + gweibull = 1.0_fp + fsstemis = 1.0_fp + fhoppel = 1.0_fp + + + do_seasalt = .true. ! Default value for all cases + + ! Don't do Sea Salt over land + !---------------------------------------------------------------- + scale = FROCEAN - FRSEAICE + if (scale <= 0.0_fp) then + do_seasalt = .False. + endif + + if (do_seasalt) then + ! Gong 1997 Params + !----------------- + scalefac = 3.0_fp + rpow = 1.05_fp + exppow = 1.19_fp + wpow = 3.41_fp + + ! Main computation loop - CUSTOMIZE THIS SECTION FOR YOUR SCHEME + do k = 1, num_layers + + ! get 10m mean wind speed + !------------------------ + w10m = sqrt(U10M ** 2 + V10M ** 2) + + ! Weibull Distribution following Fan and Toon 2011 if WeibullFlag + !---------------------------------------------------------------------------- + call weibullDistribution(gweibull, params%weibull_flag, w10m, RC) + if (RC /= 0) then + RC = -1 + print *, 'Error in weibullDistribution' !TODO: this may not allowed in a pure function + return + endif + + ! Get Jeagle SST Correction + call jeagleSSTcorrection(fsstemis, SST,1, RC) + if (RC /= 0) then + RC = -1 + print *, 'Error in jeagleSSTcorrection' + return + endif + + scale = scale * gweibull * fsstemis * params%scale_factor + + ! Apply to each species + do n = 1, num_species + ! delta dry radius + !----------------- + DeltaDryRadius = (species_upper_radius(n) - species_lower_radius(n) )/ nr + + ! Dry Radius Substep + !------------------- + DryRadius = species_lower_radius(n) + 0.5 * DeltaDryRadius + + do ir = 1, nr ! SubSteps + + ! Mass scale fcator + MassScaleFac = scalefac * 4._fp/3._fp*PI*species_density(n)*(DryRadius**3._fp) * 1.e-18_fp + + ! Effective Wet Radius in Sub Step + rwet = r80fac * DryRadius + + ! Effective Delta Wet Radius + drwet = r80fac * DeltaDryRadius + + aFac = 3.0_fp + bFac = (0.380_fp-log10(rwet))/0.650_fp + + ! Number emissions flux (# m-2 s-1) + NumberEmissions = NumberEmissions + SeasaltEmissionGong( rwet, drwet, w10m, scalefac, & + aFac, bFac, rpow, exppow, wpow ) + + ! Mass emissions flux (kg m-2 s-1) + MassEmissions = MassEmissions + SeasaltEmissionGong( rwet, drwet, w10m, MassScaleFac, & + aFac, bFac, rpow, exppow, wpow ) + + DryRadius = DryRadius + DeltaDryRadius + + enddo ! ir loop + + mass_emission_flux(k, n) = MassEmissions * scale + numb_emission_flux(k, n) = NumberEmissions * scale + + ! Reset for next species + MassEmissions = 0.0_fp + NumberEmissions = 0.0_fp + + ! Ensure non-negative emissions + species_tendencies(k, n) = max(0.0_fp, mass_emission_flux(k, n)) + + ! TODO: Update diagnostic fields here based on your scheme's requirements + ! Each process should implement custom diagnostic calculations + ! Example patterns: + if (present(seasalt_mass_emission_total)) then + seasalt_mass_emission_total = seasalt_mass_emission_total + mass_emission_flux(k, n) + end if + if (present(seasalt_number_emission_total)) then + seasalt_number_emission_total = seasalt_number_emission_total + numb_emission_flux(k, n) + end if + if (present(seasalt_mass_emission_per_bin) .and. present(diagnostic_species_id)) then + ! Find position of this species in diagnostic_species_id array + do diag_idx = 1, size(diagnostic_species_id) + if (diagnostic_species_id(diag_idx) == n) then + ! Add your custom sea salt mass emission flux per bin calculation + seasalt_mass_emission_per_bin(diag_idx) = mass_emission_flux(k, n) + exit + end if + end do + end if + if (present(seasalt_number_emission_per_bin) .and. present(diagnostic_species_id)) then + ! Find position of this species in diagnostic_species_id array + do diag_idx = 1, size(diagnostic_species_id) + if (diagnostic_species_id(diag_idx) == n) then + ! Add your custom sea salt mass emission flux per bin calculation + seasalt_number_emission_per_bin(diag_idx) = numb_emission_flux(k, n) + exit + end if + end do + end if + end do + end do - end do + end if end subroutine compute_gong97 @@ -212,33 +277,206 @@ end subroutine compute_gong97 ! Add your custom scientific algorithms here as pure functions/subroutines ! Examples: environmental response functions, species-specific calculations, etc. - !> Example helper function for environmental response - pure function compute_environmental_response_gong97(met_value, reference_value) result(factor) - real(fp), intent(in) :: met_value ! Meteorological value - real(fp), intent(in) :: reference_value ! Reference value - real(fp) :: factor + !> + !! \brief Jeagle et al. 2012 SST correction + !! + !! Jaeglé, L., Quinn, P. K., Bates, T. S., Alexander, B., and Lin, J.-T.: + !! Global distribution of sea salt aerosols: new constraints from in situ and remote + !! sensing observations, Atmos. Chem. Phys., 11, 3137–3157, + !! https://doi.org/10.5194/acp-11-3137-2011, 2011. + !! + !! \ingroup catchem_seasalt_process + !!!> + subroutine jeagleSSTcorrection(fsstemis, sst, sstFlag, rc) - ! Simple exponential response - customize for your scheme - factor = exp((met_value - reference_value) / reference_value) - factor = max(0.0_fp, min(10.0_fp, factor)) ! Reasonable bounds - end function compute_environmental_response_gong97 + ! !USES: + implicit NONE - !> Example helper function for species-specific scaling - pure function compute_species_scaling_gong97(species_idx, params) result(scaling) - integer, intent(in) :: species_idx - type(SeaSaltSchemeGONG97Config), intent(in) :: params - real(fp) :: scaling - - ! Species-specific scaling - customize for your scheme - select case (species_idx) - case (1) - scaling = 1.0_fp ! First species baseline - case (2:3) - scaling = 0.5_fp ! Reduced emission for species 2-3 - case default - scaling = 0.1_fp ! Low emission for other species - end select - - end function compute_species_scaling_gong97 + ! !INPUT/OUTPUT PARAMETERS: + real(fp), intent(inout) :: fsstemis ! + real(fp), intent(in) :: sst ! surface temperature (K) + integer, intent(in) :: sstFlag + + ! !OUTPUT PARAMETERS: + integer, optional, intent(out) :: rc + !EOP + + ! !Local Variables + real(fp) :: tskin_c + !EOP + !------------------------------------------------------------------------- + ! Begin... + RC = -1 ! Error code + fsstemis = 1.0_fp + + fsstemis = ZERO + tskin_c = sst - 273.15_fp + if (sstFlag .eq. 1) then + fsstemis = max(0.0_fp,(0.3_fp + 0.1_fp*tskin_c - 0.0076_fp*tskin_c**2 + 0.00021_fp*tskin_c**3)) + else + ! temperature range (0, 36) C + tskin_c = max(-0.1_fp, Tskin_c) + tskin_c = min(36.0_fp, tskin_c) + + fsstemis = (-1.107211_fp -0.010681_fp * tskin_c -0.002276_fp * tskin_c**2.0_fp & + + 60.288927_fp*1.0_fp/(40.0_fp - tskin_c)) + fsstemis = max(0.0_fp, fsstemis) + fsstemis = min(7.0_fp, fsstemis) + endif + + RC = 0 + end subroutine jeagleSSTcorrection + + !> + !! \brief Function to compute sea salt emissions following the Gong style parameterization. + !! + !! Functional form is from Gong 2003: + !! \f$dN/dr = scalefac * 1.373 * (w^wpow) * (r^-aFac) * (1+0.057*r^rpow) * 10^(exppow*exp(-bFac^2))\f$ + !! where r is the particle radius at 80% RH, dr is the size bin width at 80% RH, and w is the wind speed + !! + !! \ingroup catchem_seasalt_process + !!!> + function SeasaltEmissionGong ( r, dr, w, scalefac, aFac, bFac, rpow, exppow, wpow ) + + real(fp), intent(in) :: r !< Wet particle radius [um] + real(fp), intent(in) :: dr !< Wet particle bin width [um] + real(fp), intent(in) :: w !< Grid box mean wind speed [m s-1] (10-m or ustar wind) + real(fp), intent(in) :: scalefac !< scale factor + real(fp), intent(in) :: aFac + real(fp), intent(in) :: bFac + real(fp), intent(in) :: rpow + real(fp), intent(in) :: exppow + real(fp), intent(in) :: wpow + real(fp) :: SeasaltEmissionGong + + ! Initialize + SeasaltEmissionGong = 0. + + ! Particle size distribution function + SeasaltEmissionGong = scalefac * 1.373_fp*r**(-aFac)*(1._fp+0.057_fp*r**rpow) & + *10._fp**(exppow*exp(-bFac**2._fp))*dr + ! Apply wind speed function + SeasaltEmissionGong = w**wpow * SeasaltEmissionGong + + end function SeasaltEmissionGong + + !> + !! \brief Calculate the weibull distribution for 10m wind speed (u10, v10) + !! + !! The Weibull distribution correction ends up being a multiplicative constant + !! (g) times our present source function (see Eq. 12 in Fan & Toon, 2011 and notes for + !! (9/22/11). This constant is derived from the incomplete and complete forms of the gamma + !! function, hence the utilities pasted below. The Weibull function and shape + !! parameters (k, c) assumed are from Justus 1978. + !! + !! \param[inout] gweibull Multiplicative constant + !! \param[in] weibullFlag Flag for weibull correction + !! \param[in] wm 10m wind speed + !! \param[out] RC Return Code + !! + !! \ingroup catchem_seasalt_process + !!!> + subroutine weibullDistribution(gweibull, weibullFlag, wm, RC) + + implicit none + + ! Input/Output + !------------- + real(fp), intent(inout) :: gweibull + + ! Input + !------ + logical, intent(in) :: weibullFlag + real(fp), intent(in) :: wm + + ! Output + !------- + integer, intent(out) :: RC + + ! Local Variables + real(fp) :: a, c, k, wt, x + character(len=256) :: errMsg, thisLoc ! needed for error handling thisLoc + ! Initialize + errMsg = '' + thisLoc = ' -> at weibullDistribution (in util/metutils_mod.F90)' + RC = 0 + gweibull = 1.0_fp + + wt = 4.0_fp + + if (weibullFlag) then + gweibull = 0.0_fp + + if (wm > 0.012_fp) then + k = 0.94_fp * sqrt(wm) + c = wm / gamma(1.0_fp + 1.0_fp / k) + x = (wt / c) ** k + a = 3.41_fp / k + 1.0_fp + gweibull = (c / wm) ** 3.41_fp * igamma(a, x, RC) + endif + endif + + + end subroutine weibullDistribution + + !> + !! \brief Calculate the incomplete Gamma function + !! + !! The incomplete Gamma function is defined as + !! \int_x^\infty t^{A-1}\exp(-t) dt + !! + !! \param[in] A + !! \param[in] X + !! \param[out] RC + !! + !! \ingroup catchem_seasalt_process + !!!> + real(fp) function igamma(A, X, RC) + + IMPLICIT NONE + + REAL(fp), INTENT(in) :: A + REAL(fp), INTENT(IN) :: X + integer, intent(out) :: rc + + ! LOCAL VARIABLE + REAL(fp) :: XAM, GIN, S, R, T0 + INTEGER K + rc = 0 + igamma = 0 + + XAM=-X+A*LOG(X) + IF (XAM.GT.700.0_fp.OR.A.GT.170.0_fp) THEN + WRITE(*,*)'IGAMMA: a and/or x too large, X = ', X + WRITE(*,*) 'A = ', A + rc = -1 + return + ENDIF + + IF (rae(X, 0.0_fp)) THEN + !IF ( X == 0.0_fp) THEN + IGAMMA=GAMMA(A) + + ELSE IF (X.LE.1.0_fp+A) THEN + S=1.0_fp/A + R=S + DO K=1,60 + R=R*X/(A+K) + S=S+R + IF (ABS(R/S).LT.1.0e-15_fp) EXIT + END DO + GIN=EXP(XAM)*S + IGAMMA=GAMMA(A)-GIN + ELSE IF (X.GT.1.0_fp+A) THEN + T0=0.0_fp + DO K=60,1,-1 + T0=(K-A)/(1.0_fp+K/(X+T0)) + end do + + IGAMMA=EXP(XAM)/(X+T0) + + ENDIF + + end function igamma end module SeaSaltScheme_GONG97_Mod diff --git a/src/process/settling/CMakeLists.txt b/src/process/settling/CMakeLists.txt new file mode 100644 index 00000000..22df25bf --- /dev/null +++ b/src/process/settling/CMakeLists.txt @@ -0,0 +1,122 @@ +# Settling Process CMakeLists.txt +# Generated on: 2025-12-18T14:12:33.107935 +# Author: Wei Li +# Description: Process for computing gravitational settling of aerosol species + +# Define settling process sources +set( + SETTLING_PROCESS_SOURCES + SettlingCommon_Mod.F90 + ProcessSettlingInterface_Mod.F90 + SettlingProcessCreator_Mod.F90 +) + +# Define settling scheme sources +set(SETTLING_SCHEME_SOURCES schemes/SettlingScheme_GOCART_Mod.F90) + +# Combine all sources +set(SETTLING_ALL_SOURCES ${SETTLING_PROCESS_SOURCES} ${SETTLING_SCHEME_SOURCES}) + +# Create the settling process library +set(_lib CATChem_process_settling) +add_library(${_lib} ${SETTLING_ALL_SOURCES}) + +# Link with required libraries +target_link_libraries(${_lib} PUBLIC CATChem_core) + +# Additional dependencies + +# Set module directory +set_target_properties( + ${_lib} + PROPERTIES Fortran_MODULE_DIRECTORY ${CMAKE_BINARY_DIR}/include +) + +# Include directories +target_include_directories(${_lib} PRIVATE ${CMAKE_BINARY_DIR}/include) + +# Compiler-specific flags +if(CMAKE_Fortran_COMPILER_ID MATCHES "GNU") + target_compile_options(${_lib} PRIVATE -fdefault-real-8 -fdefault-double-8) +elseif(CMAKE_Fortran_COMPILER_ID MATCHES "Intel") + target_compile_options(${_lib} PRIVATE -r8) +endif() + +# Add preprocessor definitions +target_compile_definitions( + ${_lib} + PRIVATE PROCESS_NAME="settling" PROCESS_VERSION="1.0.0" +) + +# Install targets +install( + TARGETS ${_lib} + ARCHIVE DESTINATION lib + LIBRARY DESTINATION lib + RUNTIME DESTINATION bin +) + +# Install module files +install( + DIRECTORY ${CMAKE_BINARY_DIR}/include/ + DESTINATION include + FILES_MATCHING + PATTERN "*.mod" +) + +# Add subdirectories +if(BUILD_TESTING) + # Add tests subdirectory - tests are located in tests/process/settling/ + set(TESTS_DIR "${CMAKE_SOURCE_DIR}/tests/process/settling") + if(EXISTS "${TESTS_DIR}/CMakeLists.txt") + add_subdirectory("${TESTS_DIR}" "${CMAKE_CURRENT_BINARY_DIR}/tests") + endif() +endif() + +if(BUILD_EXAMPLES) + add_subdirectory(examples) +endif() + +# Documentation +if(BUILD_DOCUMENTATION) + find_package(Doxygen QUIET) + if(DOXYGEN_FOUND) + set(DOXYGEN_PROJECT_NAME "Settling Process") + set( + DOXYGEN_PROJECT_BRIEF + "Process for computing gravitational settling of aerosol species" + ) + set(DOXYGEN_OUTPUT_DIRECTORY "${CMAKE_CURRENT_BINARY_DIR}/docs") + set(DOXYGEN_INPUT "${CMAKE_CURRENT_SOURCE_DIR}") + set(DOXYGEN_RECURSIVE YES) + set(DOXYGEN_FILE_PATTERNS "*.F90 *.md") + set(DOXYGEN_EXCLUDE_PATTERNS "*/build/* */tests/*") + + doxygen_add_docs( + settling_docs + ${CMAKE_CURRENT_SOURCE_DIR} + COMMENT "Generating settling process documentation" + ) + + install( + DIRECTORY ${CMAKE_CURRENT_BINARY_DIR}/docs/ + DESTINATION share/doc/settling + OPTIONAL + ) + endif() +endif() + +# Performance testing + +# Process-specific targets + +# Print configuration summary +message(STATUS "Configured Settling process:") +message(STATUS " Process type: deposition") +message(STATUS " Number of schemes: 1") +message(STATUS " Default scheme: ") +message(STATUS " Has size bins: No") +message(STATUS " Multiphase: No") +message(STATUS " Generate tests: Yes") +message(STATUS " Generate docs: Yes") +message(STATUS " Generate examples: Yes") diff --git a/src/process/settling/ProcessSettlingInterface_Mod.F90 b/src/process/settling/ProcessSettlingInterface_Mod.F90 new file mode 100644 index 00000000..1049b945 --- /dev/null +++ b/src/process/settling/ProcessSettlingInterface_Mod.F90 @@ -0,0 +1,760 @@ +!> Process for computing gravitational settling of aerosol species +!! +!! This module provides the settling process interface for the CATChem library. +!! The interface leverages CATChem's core infrastructure for data marshaling and process management. +!! All algorithmic calculations are performed in separate scheme modules. +!! +!! DIAGNOSTIC INTERFACE: +!! The compute_scheme functions support optional diagnostic parameters. When diagnostics are +!! enabled in the configuration, these parameters are passed to capture emission/tendency data. +!! When diagnostics are disabled, the scheme calls use the original interface without diagnostics. +!! This approach maintains backward compatibility while providing flexible diagnostic capabilities. +!! +!! This code was generated by the CATChem Process Generator. +!! Generation date: 2025-12-18T14:12:32.836310 +!! Configuration: settling +!! +!! @author CATChem Process Generator +!! @version 1.0.0 + +module ProcessSettlingInterface_Mod + + ! Core CATChem infrastructure + use precision_mod, only: fp + use ProcessInterface_Mod, only: ProcessInterface, ColumnProcessInterface + use StateManager_Mod, only: StateManagerType + use GridManager_Mod, only: GridManagerType + use error_mod, only: CC_SUCCESS, CC_FAILURE, CC_Error, CC_Warning, ErrorManagerType + use DiagnosticManager_Mod, only: DiagnosticManagerType + use DiagnosticInterface_Mod, only: DiagnosticRegistryType, DiagnosticFieldType, DiagnosticDataType + use VirtualColumn_Mod, only: VirtualColumnType, VirtualMetType + use Constants, only: g0, AIRMW ! Gravitational acceleration for tendency physics and air molecular weight for unit conversion + + ! Core utilities (leverage existing infrastructure) + use ConfigManager_Mod, only: ConfigManagerType + use ChemState_Mod, only: ChemStateType + use MetState_Mod, only: MetStateType + + ! Common utilities - unified configuration + use SettlingCommon_Mod, only: SettlingProcessConfig + + ! Scheme modules + use SettlingScheme_GOCART_Mod, only: compute_gocart + + implicit none + private + + public :: ProcessSettlingInterface + + !> Main settling process interface type - extends core ColumnProcessInterface !! + !! This type leverages CATChem's core ColumnProcessInterface infrastructure for column + !! virtualization, focusing only on process-specific configuration and scheme management. + !! All boilerplate infrastructure and column processing is handled by the base class. + type, extends(ColumnProcessInterface) :: ProcessSettlingInterface + private + + ! Unified process configuration (bridges ConfigManager to process-specific config) + type(SettlingProcessConfig), public :: process_config + + ! Process utilities (leverage core infrastructure) + type(ChemStateType), pointer :: chem_state => null() + type(MetStateType), pointer :: met_state => null() + ! Note: state_manager pointer removed as it was never used + + ! Process-specific diagnostic indices (base class handles storage) + integer :: diag_settling_velocity_per_species_per_level_idx = -1 + integer :: diag_settling_flux_per_species_idx = -1 + + ! Column-level diagnostic storage for interfacing with DiagManager + ! These are allocated per-column during processing and can be used to + ! accumulate data for DiagManager updates + real(fp), allocatable :: column_settling_velocity_per_species_per_level(:,:) ! 2D: levels x species - per column + real(fp), allocatable :: column_settling_flux_per_species(:) ! 1D: species - per column + + ! Scheme-specific diagnostic storage (shared across all schemes that use them) + + contains + ! Required ProcessInterface implementations + procedure :: init => process_init + procedure :: run => process_run + procedure :: finalize => process_finalize + procedure :: parse_process_config => parse_settling_config + + ! Required ColumnProcessInterface implementations + procedure :: init_column_processing => init_column_processing + procedure :: run_column => run_column + procedure :: finalize_column_processing => finalize_column_processing + + ! ProcessInterface capability registration + procedure :: get_required_met_fields => get_required_met_fields + procedure :: get_required_diagnostic_fields => get_required_diagnostic_fields + + ! Public testing interface for scheme manipulation + procedure :: set_scheme => set_settling_scheme + procedure :: get_scheme => get_settling_scheme + + ! Process-specific implementations (column virtualization) + procedure, private :: run_active_scheme_column + procedure, private :: run_gocart_scheme_column + + ! Diagnostic procedures (override base class method) + procedure :: register_diagnostics => register_and_allocate_diagnostics + procedure, private :: register_and_allocate_diagnostics + procedure, private :: calculate_and_update_diagnostics + + end type ProcessSettlingInterface + +contains + + !> Initialize the settling process + !! + !! Leverages ProcessInterface base class for common initialization tasks. + !! Only handles process-specific configuration and scheme setup. + subroutine process_init(this, container, rc) + class(ProcessSettlingInterface), intent(inout) :: this + type(StateManagerType), intent(inout) :: container + integer, intent(out) :: rc + + type(ErrorManagerType), pointer :: error_manager + + rc = CC_SUCCESS + + ! Get error manager + error_manager => container%get_error_manager() + + ! Initialize column processing capabilities + call this%init_column_processing(container, rc) + if (rc /= CC_SUCCESS) return + + ! Set process-specific name and info + this%name = 'settling' + this%version = '1.0.0' + this%description = 'Process for computing gravitational settling of aerosol species' + + ! Parse process-specific configuration using unified approach + call this%parse_process_config(container, error_manager, rc) + if (rc /= CC_SUCCESS) then + return + end if + + ! Get state pointers from container (needed for species loading) + this%chem_state => container%get_chem_state_ptr() + this%met_state => container%get_met_state_ptr() + + ! Load species from ChemState based on is_settling property + call this%process_config%load_species_from_chem_state(this%chem_state, error_manager) + ! Note: Error handling managed by error_manager internally + + ! Map diagnostic species names to indices in the species array + call this%process_config%map_diagnostic_species_indices(error_manager) + + ! Validate the configuration with StateManager + call this%process_config%validate(container, error_manager) + ! Note: validate doesn't return rc, but error_manager tracks errors + + ! Register diagnostics for this process (only if diagnostics enabled) + call this%register_diagnostics(container, rc) + if (rc /= CC_SUCCESS) then + return + end if + + ! Mark process as initialized and active + call this%activate() + + end subroutine process_init + + !> Run the settling process + !! + !! This method implements the main ProcessInterface run method. + !! For ColumnProcessInterface processes, the actual column iteration is handled + !! by ProcessManager, so this method serves as a placeholder for any 3D operations + !! that might be needed before or after column processing. + subroutine process_run(this, container, rc) + class(ProcessSettlingInterface), intent(inout) :: this + type(StateManagerType), intent(inout) :: container + integer, intent(out) :: rc + + rc = CC_SUCCESS + + ! Check if process is active + if (.not. this%process_config%is_active) then + return + end if + + ! For ColumnProcessInterface processes, the ProcessManager handles column iteration + ! and calls run_column() for each virtual column. This method is mainly a placeholder + ! for any global 3D operations that need to happen before/after column processing. + + ! Currently no global 3D operations needed for settling process + ! All processing happens in run_column() method + + end subroutine process_run + + !> Finalize the settling process + subroutine process_finalize(this, rc) + class(ProcessSettlingInterface), intent(inout) :: this + integer, intent(out) :: rc + + rc = CC_SUCCESS + + ! Finalize column processing + call this%finalize_column_processing(rc) + if (rc /= CC_SUCCESS) return + + ! Deallocate diagnostic class members + if (allocated(this%column_settling_velocity_per_species_per_level)) deallocate(this%column_settling_velocity_per_species_per_level) + if (allocated(this%column_settling_flux_per_species)) deallocate(this%column_settling_flux_per_species) + ! Deallocate scheme-specific diagnostic fields (only deallocate unique fields once) + + ! Finalize unified configuration + call this%process_config%finalize() + + end subroutine process_finalize + + !> Parse process configuration using unified approach + !! This function bridges the ConfigManager YAML structure to process-specific configuration + subroutine parse_settling_config(this, state_manager, error_manager, rc) + class(ProcessSettlingInterface), intent(inout) :: this + type(StateManagerType), intent(inout) :: state_manager ! Changed to inout for function call + type(ErrorManagerType), intent(inout) :: error_manager + integer, intent(out) :: rc + + type(ConfigManagerType), pointer :: config_manager + + rc = CC_SUCCESS + + ! Get configuration manager from state manager + config_manager => state_manager%get_config_ptr() + if (.not. associated(config_manager)) then + call error_manager%report_error(1003, & + 'ConfigManager not available from StateManager', rc) + return + end if + + ! Use the unified configuration loader from SettlingCommon_Mod + ! This handles the complexity of parsing hierarchical YAML into process-specific types + call this%process_config%load_from_config(config_manager, error_manager) + ! Note: Error handling managed by error_manager internally + + ! Process is now configured - the unified config contains all scheme-specific settings + + end subroutine parse_settling_config + + !======================================================================== + ! Column Processing Interface Implementation + !======================================================================== + + !> Initialize column processing for settling + !! + !! This method sets up the column processing infrastructure for the process. + !! The base class ColumnProcessInterface handles the actual column virtualization. + subroutine init_column_processing(this, container, rc) + class(ProcessSettlingInterface), intent(inout) :: this + type(StateManagerType), intent(inout) :: container + integer, intent(out) :: rc + + rc = CC_SUCCESS + + ! Enable column processing and set batch size for optimal performance + call this%enable_column_processing() + call this%set_column_batch_size(50) ! Process 50 columns at a time + + ! Any process-specific column processing setup would go here + ! For settling, no additional setup is needed + + end subroutine init_column_processing + + !> Process a single virtual column for settling + !! + !! This is the core column processing method where the actual atmospheric process + !! calculations happen for a single column. The base class handles column + !! virtualization and calls this method for each virtual column. + subroutine run_column(this, column, container, rc) + class(ProcessSettlingInterface), intent(inout) :: this + type(VirtualColumnType), intent(inout) :: column + type(StateManagerType), intent(inout) :: container + integer, intent(out) :: rc + + rc = CC_SUCCESS + + ! Check if process is active + if (.not. this%process_config%is_active) return + + ! Delegate to the active scheme for column processing + call this%run_active_scheme_column(column, rc) + + ! Calculate and update diagnostics if enabled + if (this%process_config%settling_config%diagnostics .and. rc == CC_SUCCESS) then + call this%calculate_and_update_diagnostics(column, container, rc) + end if + + end subroutine run_column + + !> Finalize column processing for settling + !! + !! Clean up any column processing resources. + subroutine finalize_column_processing(this, rc) + class(ProcessSettlingInterface), intent(inout) :: this + integer, intent(out) :: rc + + rc = CC_SUCCESS + + ! Clean up column processing + call this%disable_column_processing() + + ! Any process-specific cleanup would go here + + end subroutine finalize_column_processing + + !> Run the active scheme for a single virtual column + !! + !! This method adapts the existing scheme methods to work with virtual columns + !! instead of state manager column indices. + subroutine run_active_scheme_column(this, column, rc) + class(ProcessSettlingInterface), intent(inout) :: this + type(VirtualColumnType), intent(inout) :: column + integer, intent(out) :: rc + + rc = CC_SUCCESS + + ! Delegate to appropriate scheme using unified config + select case (trim(this%process_config%settling_config%scheme)) + case ('gocart') + call this%run_gocart_scheme_column(column, rc) + case default + rc = CC_FAILURE + end select + + end subroutine run_active_scheme_column + + !> Run the gocart scheme for a single virtual column + subroutine run_gocart_scheme_column(this, column, rc) + class(ProcessSettlingInterface), intent(inout) :: this + type(VirtualColumnType), intent(inout) :: column + integer, intent(out) :: rc + + ! Local variables for scheme calculation + type(VirtualMetType), pointer :: met => null() ! Pointer to meteorological data + ! Meteorological fields + real(fp), allocatable :: airden(:) + real(fp), allocatable :: delp(:) + real(fp), allocatable :: pmid(:) + real(fp), allocatable :: rh(:) + real(fp), allocatable :: t(:) + real(fp), allocatable :: tstep(:) + real(fp), allocatable :: z(:) + ! Species properties + integer, allocatable :: species_mie_map(:) ! Mapping from process species to MieData indices + real(fp), allocatable :: species_radius(:) + real(fp), allocatable :: species_density(:) + real(fp), allocatable :: species_conc(:,:) + real(fp), allocatable :: species_tendencies(:,:) + integer :: n_species, n_levels, n_chem, n_emis, i, k + integer, allocatable :: species_indices(:) + + rc = CC_SUCCESS + + ! Get dimensions from virtual column + call column%get_dimensions(n_levels, n_chem, n_emis) ! Full column processing + + ! Get settling species information from process configuration + n_species = this%process_config%settling_config%n_species + if (n_species <= 0) then + return + end if + + ! Get species indices directly from configuration (pre-computed) + allocate(species_indices(n_species)) + species_indices(1:n_species) = this%process_config%settling_config%species_indices(1:n_species) + + ! Allocate arrays + allocate(species_conc(n_levels, n_species)) + allocate(species_tendencies(n_levels, n_species)) + ! Allocate meteorological field arrays based on field type and process configuration + allocate(airden(n_levels)) ! Atmospheric field - always n_levels + allocate(delp(n_levels)) ! Atmospheric field - always n_levels + allocate(pmid(n_levels)) ! Atmospheric field - always n_levels + allocate(rh(n_levels)) ! Atmospheric field - always n_levels + allocate(t(n_levels)) ! Atmospheric field - always n_levels + allocate(tstep(1)) ! Special timestep field - scalar + allocate(z(n_levels+1)) ! Edge field - always n_levels+1 + allocate(species_mie_map(n_species)) + allocate(species_radius(n_species)) + allocate(species_density(n_species)) + species_tendencies = 0.0_fp + + ! Get meteorological data pointer from virtual column (VirtualMet pattern) + met => column%get_met() + + ! Now allocate categorical fields using the met pointer dimensions + + ! Extract required fields from met pointer based on field type and processing mode + airden(1:n_levels) = met%AIRDEN(1:n_levels) ! Atmospheric field - always n_levels + delp(1:n_levels) = met%DELP(1:n_levels) ! Atmospheric field - always n_levels + pmid(1:n_levels) = met%PMID(1:n_levels) ! Atmospheric field - always n_levels + rh(1:n_levels) = met%RH(1:n_levels) ! Atmospheric field - always n_levels + t(1:n_levels) = met%T(1:n_levels) ! Atmospheric field - always n_levels + tstep(1) = this%get_timestep() ! Special timestep field - retrieved from ProcessInterface + z(1:n_levels+1) = met%Z(1:n_levels+1) ! Edge field - always n_levels+1 + + ! Get species concentrations from virtual column + ! Full column processing - get concentrations for all levels + do k = 1, n_levels + do i = 1, n_species + species_conc(k, i) = column%get_chem_field(species_indices(i), k) + end do + end do + + ! Get species properties from configuration (pre-loaded during initialization) + ! Extract filtered Mie mapping for process species + species_mie_map(1:n_species) = this%process_config%settling_config%species_mie_map(1:n_species) + ! Use species properties from process configuration + species_radius(1:n_species) = this%process_config%settling_config%species_radius(1:n_species) + ! Use species properties from process configuration + species_density(1:n_species) = this%process_config%settling_config%species_density(1:n_species) + + ! Call the science scheme with optional diagnostic parameters + ! Note: gocart uses the following diagnostic fields (if diagnostics enabled): + ! - settling_velocity_per_species_per_level (settling velocity per species per level) + ! - settling_flux_per_species (settling flux per species across column) + if (this%process_config%settling_config%diagnostics) then + ! Call with diagnostic outputs enabled + call compute_gocart( & + n_levels, & + n_species, & + this%process_config%gocart_config, & + airden, & + delp, & + pmid, & + rh, & + t, & + tstep(1), & + z , & + this%process_config%settling_config%species_names, & + this%chem_state%MieData, & + species_mie_map, & + species_radius, & + species_density, & + species_conc, & + species_tendencies, & + this%column_settling_velocity_per_species_per_level, & + this%column_settling_flux_per_species, & + this%process_config%settling_config%diagnostic_species_id ) + else + ! Call without diagnostic outputs (optional parameters not passed) + call compute_gocart( & + n_levels, & + n_species, & + this%process_config%gocart_config, & + airden, & + delp, & + pmid, & + rh, & + t, & + tstep(1), & + z , & + this%process_config%settling_config%species_names, & + this%chem_state%MieData, & + species_mie_map, & + species_radius, & + species_density, & + species_conc, & + species_tendencies & + ) + end if + + ! Apply tendencies back to virtual column based on tendency_mode + ! Full column processing - apply tendencies to all levels + do k = 1, n_levels + do i = 1, n_species + ! Replacement tendency: new_conc = tendency (tendency is the new value) + call column%set_chem_field(k, species_indices(i), & + species_tendencies(k, i)) + end do + end do + + end subroutine run_gocart_scheme_column + + + + !> Get required meteorological fields for this process + function get_required_met_fields(this) result(field_names) + class(ProcessSettlingInterface), intent(in) :: this + character(len=32), allocatable :: field_names(:) + character(len=32), allocatable :: scheme_fields(:) + character(len=32), allocatable :: process_fields(:) + character(len=32), allocatable :: unique_fields(:) + integer :: total_fields, scheme_count, process_count, i, j, unique_count + logical :: is_duplicate + + ! No process-level required fields + process_count = 0 + allocate(process_fields(0)) + + ! Get scheme-specific fields based on selected scheme + select case (trim(this%process_config%settling_config%scheme)) + case ('gocart') + scheme_count = 7 + allocate(scheme_fields(scheme_count)) + scheme_fields(1) = 'T' + scheme_fields(2) = 'TSTEP' + scheme_fields(3) = 'AIRDEN' + scheme_fields(4) = 'RH' + scheme_fields(5) = 'Z' + scheme_fields(6) = 'PMID' + scheme_fields(7) = 'DELP' + case default + scheme_count = 0 + allocate(scheme_fields(0)) + end select + + ! Combine process-level and scheme-specific fields and remove duplicates + ! First estimate maximum possible size (without duplicates) + total_fields = process_count + scheme_count + allocate(unique_fields(total_fields)) + unique_count = 0 + + ! Add process-level fields first + do i = 1, process_count + unique_count = unique_count + 1 + unique_fields(unique_count) = process_fields(i) + end do + + ! Add scheme-specific fields (check for duplicates) + do i = 1, scheme_count + is_duplicate = .false. + do j = 1, unique_count + if (trim(scheme_fields(i)) == trim(unique_fields(j))) then + is_duplicate = .true. + exit + end if + end do + if (.not. is_duplicate) then + unique_count = unique_count + 1 + unique_fields(unique_count) = scheme_fields(i) + end if + end do + + ! Allocate final result array with exact size + allocate(field_names(unique_count)) + field_names(1:unique_count) = unique_fields(1:unique_count) + + ! Clean up temporary arrays + if (allocated(unique_fields)) deallocate(unique_fields) + if (allocated(process_fields)) deallocate(process_fields) + if (allocated(scheme_fields)) deallocate(scheme_fields) + + end function get_required_met_fields + + !> Get required diagnostic fields for this process + function get_required_diagnostic_fields(this) result(field_names) + class(ProcessSettlingInterface), intent(in) :: this + character(len=64), allocatable :: field_names(:) + + allocate(field_names(2)) + field_names(1) = 'settling_velocity_per_species_per_level' + field_names(2) = 'settling_flux_per_species' + + end function get_required_diagnostic_fields + + !> Register diagnostic fields with the DiagnosticManager and allocate diagnostic storage + + subroutine register_and_allocate_diagnostics(this, container, rc) + use DiagnosticInterface_Mod, only: DiagnosticRegistryType, DIAG_REAL_2D, DIAG_REAL_3D + + class(ProcessSettlingInterface), intent(inout) :: this + type(StateManagerType), intent(inout) :: container + integer, intent(out) :: rc + + type(DiagnosticManagerType), pointer :: diag_mgr + type(DiagnosticRegistryType), pointer :: registry + type(GridManagerType), pointer :: grid_mgr + character(len=256) :: field_name ! For constructing species-specific field names + integer :: i ! Loop variable for diagnostic species + integer :: nx, ny, nz + integer :: dims_2d(2) + integer :: dims_3d_levels(3) + + rc = CC_SUCCESS + + ! Only register diagnostics if enabled in config + if (.not. this%process_config%settling_config%diagnostics) then + return + endif + + ! Get managers + diag_mgr => container%get_diagnostic_manager() + grid_mgr => container%get_grid_manager() + + ! Register this process with diagnostic manager (only once per process) + call diag_mgr%register_process('settling', rc) + if (rc /= CC_SUCCESS) return + + ! Get the process registry for registering individual diagnostics + call diag_mgr%get_process_registry('settling', registry, rc) + if (rc /= CC_SUCCESS) return + + ! Get grid dimensions + call grid_mgr%get_shape(nx, ny, nz) + dims_2d = [nx, ny] + + dims_3d_levels = [nx, ny, nz] + + ! Register settling_velocity_per_species_per_level + ! Register individual 3D fields for each diagnostic species (level + species diagnostics) + if (this%process_config%settling_config%n_diagnostic_species > 0) then + do i = 1, this%process_config%settling_config%n_diagnostic_species + write(field_name, '(A,A,A)') 'settling_velocity_', & + trim(this%process_config%settling_config%diagnostic_species(i)) + call this%register_diagnostic_field(registry, trim(field_name), & + 'settling velocity per species per level', & + 'm/s', DIAG_REAL_3D, & + 'settling', dims_3d_levels, rc=rc) + if (rc /= CC_SUCCESS) return + end do + end if + if (rc /= CC_SUCCESS) return + + ! Register settling_flux_per_species + ! Register individual 2D fields for each diagnostic species (species-only diagnostics) + if (this%process_config%settling_config%n_diagnostic_species > 0) then + do i = 1, this%process_config%settling_config%n_diagnostic_species + write(field_name, '(A,A,A)') 'settling_flux_', & + trim(this%process_config%settling_config%diagnostic_species(i)) + call this%register_diagnostic_field(registry, trim(field_name), & + 'settling flux per species across column', & + 'kg/m2/s', DIAG_REAL_2D, & + 'settling', dims_2d, rc=rc) + if (rc /= CC_SUCCESS) return + end do + end if + if (rc /= CC_SUCCESS) return + + ! Get selected scheme(s) + ! Register scheme-specific diagnostics based on selected scheme + select case (trim(this%process_config%settling_config%scheme)) + + case ('gocart') + ! Register gocart-specific diagnostics + case default + ! Unknown scheme - only register common diagnostics + ! (already done above) + + end select + + ! Now allocate diagnostic class members after successful registration + ! First, deallocate if already allocated (for scheme switching) + if (allocated(this%column_settling_velocity_per_species_per_level)) deallocate(this%column_settling_velocity_per_species_per_level) + if (allocated(this%column_settling_flux_per_species)) deallocate(this%column_settling_flux_per_species) + + ! Allocate and initialize scheme-specific diagnostic fields based on selected scheme + ! For non-gas/aero differentiated process, allocate diagnostics normally + + ! Allocate common diagnostic fields (used by all schemes) + ! 2D diagnostic: levels x diagnostic_species + if (nz > 0 .and. this%process_config%settling_config%n_diagnostic_species > 0) then + allocate(this%column_settling_velocity_per_species_per_level(nz, this%process_config%settling_config%n_diagnostic_species)) + end if + if (allocated(this%column_settling_velocity_per_species_per_level)) this%column_settling_velocity_per_species_per_level = 0.0_fp + ! 1D diagnostic: species only + if (this%process_config%settling_config%n_species > 0) then + allocate(this%column_settling_flux_per_species(this%process_config%settling_config%n_species)) + end if + if (allocated(this%column_settling_flux_per_species)) this%column_settling_flux_per_species = 0.0_fp + + ! Allocate scheme-specific diagnostics + select case (trim(this%process_config%settling_config%scheme)) + case ('gocart') + ! Scheme-specific diagnostics for gocart + case default + ! No scheme-specific diagnostics for unknown schemes + end select + + end subroutine register_and_allocate_diagnostics + + !> Calculate and update all diagnostic fields for this process + !! + !! With the new flexible column-level design, diagnostics are calculated directly by the + !! science schemes for each column and passed to this method for aggregation or output. + !! This approach uses dimension inference to reduce 2D->scalar and 3D->1D for column processing. + subroutine calculate_and_update_diagnostics(this, column, container, rc) + class(ProcessSettlingInterface), intent(inout) :: this + type(VirtualColumnType), intent(in) :: column + type(StateManagerType), intent(inout) :: container + integer, intent(out) :: rc + + integer :: i_col, j_col ! Column grid position + integer :: i ! Loop variable for diagnostic species + character(len=256) :: field_name ! For constructing species-specific field names + + rc = CC_SUCCESS + + ! Skip if diagnostics not enabled + if (.not. this%process_config%settling_config%diagnostics) return + + ! Get column grid position (x, y indices) + call column%get_position(i_col, j_col) + + ! Update common diagnostic fields (used by all schemes) + ! Update individual 3D fields for each diagnostic species (level + species diagnostics) + if (this%process_config%settling_config%n_diagnostic_species > 0) then + do i = 1, this%process_config%settling_config%n_diagnostic_species + write(field_name, '(A,A,A)') 'settling_velocity_', & + trim(this%process_config%settling_config%diagnostic_species(i)) + call this%update_1d_diagnostic_column(trim(field_name), & + this%column_settling_velocity_per_species_per_level(:,i), & + i_col, j_col, container, rc) + if (rc /= CC_SUCCESS) return + end do + end if + ! Update individual species diagnostic fields (species-only diagnostics) + if (this%process_config%settling_config%n_diagnostic_species > 0) then + do i = 1, this%process_config%settling_config%n_diagnostic_species + write(field_name, '(A,A,A)') 'settling_flux_', & + trim(this%process_config%settling_config%diagnostic_species(i)) + call this%update_scalar_diagnostic_column(trim(field_name), & + this%column_settling_flux_per_species(i), & + i_col, j_col, container, rc) + if (rc /= CC_SUCCESS) return + end do + end if + ! Update scheme-specific diagnostic fields based on active scheme + select case (trim(this%process_config%settling_config%scheme)) + case ("gocart") + ! Scheme-specific diagnostics for gocart + end select + + end subroutine calculate_and_update_diagnostics + + + !> Set the active scheme (for testing purposes) + !! + !! This method allows tests to override the scheme configuration + !! to test different schemes programmatically. + !! + !! @param[inout] this The ProcessSettlingInterface instance + !! @param[in] scheme_name The scheme name to set + subroutine set_settling_scheme(this, scheme_name) + class(ProcessSettlingInterface), intent(inout) :: this + character(len=*), intent(in) :: scheme_name + + this%process_config%settling_config%scheme = trim(scheme_name) + + end subroutine set_settling_scheme + + !> Get the current active scheme + !! + !! This method allows retrieval of the current scheme for testing + !! and verification purposes. + !! + !! @param[in] this The ProcessSettlingInterface instance + !! @returns The current scheme name + function get_settling_scheme(this) result(scheme_name) + class(ProcessSettlingInterface), intent(in) :: this + character(len=64) :: scheme_name + + scheme_name = trim(this%process_config%settling_config%scheme) + + end function get_settling_scheme + +end module ProcessSettlingInterface_Mod diff --git a/src/process/settling/SettlingCommon_Mod.F90 b/src/process/settling/SettlingCommon_Mod.F90 new file mode 100644 index 00000000..b6a94515 --- /dev/null +++ b/src/process/settling/SettlingCommon_Mod.F90 @@ -0,0 +1,530 @@ +!> \file SettlingCommon_Mod.F90 +!! \brief Common types and utilities for settling process +!! +!! This module defines the configuration types used by the +!! settling process and its schemes. +!! +!! Generated on: 2025-12-18T14:12:32.947343 +!! Author: Wei Li +!! Version: 1.0.0 + +module SettlingCommon_Mod + + use precision_mod, only: fp + ! use precision_mod, only: fp + use error_mod, only: CC_SUCCESS, CC_FAILURE, CC_Error, CC_Warning, ErrorManagerType, & + ERROR_INVALID_CONFIG, ERROR_INVALID_STATE, ERROR_NOT_FOUND + use ConfigManager_Mod, only: ConfigManagerType ! ConfigManager integration + use StateManager_Mod, only: StateManagerType ! Add StateManager integration + + implicit none + private + + ! Export types + public :: SettlingProcessConfig ! New unified process config + public :: SettlingConfig + public :: SettlingSchemeGOCARTConfig + + ! Export utility functions + public :: int_to_string + + !> Main configuration type for settling process + type :: SettlingConfig + + ! Process settings + character(len=32) :: scheme = 'gocart' + logical :: is_active = .true. + logical :: diagnostics = .false. ! Diagnostic switch + + ! Diagnostic species configuration + integer :: n_diagnostic_species = 0 + character(len=32), allocatable :: diagnostic_species(:) ! User-defined species for diagnostics + integer, allocatable :: diagnostic_species_id(:) ! Indices mapping diagnostic_species to species_names + real(fp) :: dt_min = 1.0_fp ! Minimum time step (seconds) + real(fp) :: dt_max = 3600.0_fp ! Maximum time step (seconds) + + ! Species configuration + integer :: n_species = 0 + character(len=32), allocatable :: species_names(:) + integer, allocatable :: species_indices(:) ! Indices of settling species in ChemState + + + + ! Species properties + real(fp), allocatable :: species_density(:) ! density for each species + real(fp), allocatable :: species_mie_map(:) ! mie_map for each species + real(fp), allocatable :: species_radius(:) ! radius for each species + + ! Diagnostic configuration + logical :: output_diagnostics = .true. + real(fp) :: diagnostic_frequency = 3600.0_fp ! Output frequency (seconds) + + contains + procedure, public :: validate => validate_settling_config + procedure, public :: finalize => finalize_settling_config + procedure, public :: print_summary => print_settling_config_summary + end type SettlingConfig + + !> Configuration type for gocart scheme + type :: SettlingSchemeGOCARTConfig + + ! Scheme metadata + character(len=64) :: scheme_name = 'gocart' + character(len=256) :: description = 'GOCART gravitational settling scheme' + character(len=64) :: author = 'Wei Li' + character(len=16) :: algorithm_type = 'explicit' + + ! Process configuration + logical :: affects_full_column = .true. ! Full column processing + + ! Scheme parameters + real(fp) :: scale_factor = 1.0 ! settling velocity factor + logical :: simple_scheme = .false. ! read in mie data for wet particles if true; otherwise calculate particles wet swelling internally + integer :: swelling_method = 1 ! method for calculating particle swelling: 1 Fitzgerald 1975; 2 for Gerber 1985 + logical :: correction_maring = .false. ! correct the settling velocity following Maring et al, 2003 + + ! Required meteorological fields + integer :: n_required_met_fields = 7 + character(len=32) :: required_met_fields(7) + + contains + procedure, public :: validate => validate_gocart_config + procedure, public :: finalize => finalize_gocart_config + end type SettlingSchemeGOCARTConfig + + ! gocart scheme uses local variables only - no persistent state type needed + + + !> Unified process configuration type that bridges ConfigManager and process-specific configs + !! This is the main configuration type that ProcessInterface should use + type :: SettlingProcessConfig + + ! Process metadata + character(len=64) :: process_name = 'settling' + character(len=16) :: process_version = '1.0.0' + logical :: is_active = .true. + + ! Process-specific configuration (delegate to SettlingConfig) + type(SettlingConfig) :: settling_config + + ! Scheme configurations + type(SettlingSchemeGOCARTConfig) :: gocart_config + + contains + procedure, public :: load_from_config => settling_process_load_config + procedure, public :: load_species_from_chem_state => load_species_from_chem_state + procedure, public :: validate => settling_process_validate + procedure, public :: finalize => settling_process_finalize + procedure, public :: get_active_scheme_config => get_active_scheme_config + procedure, public :: load_gocart_config + procedure, public :: map_diagnostic_species_indices + end type SettlingProcessConfig + +contains + + !> Validate settling configuration + subroutine validate_settling_config(this, error_handler) + class(SettlingConfig), intent(inout) :: this + type(ErrorManagerType), intent(inout) :: error_handler + + character(len=256) :: error_msg + integer :: rc + + ! Validate time step bounds + if (this%dt_min <= 0.0_fp) then + call error_handler%report_error(ERROR_INVALID_CONFIG, & + "Minimum time step must be positive", rc) + return + end if + + if (this%dt_max < this%dt_min) then + call error_handler%report_error(ERROR_INVALID_CONFIG, & + "Maximum time step must be >= minimum time step", rc) + return + end if + + ! Validate active scheme(s) + ! Validate scheme + if (trim(this%scheme) /= 'gocart' .and. & + .true.) then + write(error_msg, '(A)') "Invalid scheme: " // trim(this%scheme) + call error_handler%report_error(ERROR_INVALID_CONFIG, error_msg, rc) + return + end if + + end subroutine validate_settling_config + + !> Print configuration summary + subroutine print_settling_config_summary(this) + class(SettlingConfig), intent(in) :: this + + write(*, '(A)') "=== Settling Process Configuration ===" + write(*, '(A,A)') " Active scheme: ", trim(this%scheme) + write(*, '(A,I0)') " Number of species: ", this%n_species + write(*, '(A,F0.1,A)') " Minimum time step: ", this%dt_min, " s" + write(*, '(A,F0.1,A)') " Maximum time step: ", this%dt_max, " s" + write(*, '(A,L1)') " Output diagnostics: ", this%output_diagnostics + write(*, '(A)') "=============================================" + + end subroutine print_settling_config_summary + + !> Finalize settling configuration + subroutine finalize_settling_config(this) + class(SettlingConfig), intent(inout) :: this + + ! Deallocate species names array + if (allocated(this%species_names)) then + deallocate(this%species_names) + end if + + ! Deallocate species indices array + if (allocated(this%species_indices)) then + deallocate(this%species_indices) + end if + + ! Deallocate species properties arrays + if (allocated(this%species_density)) then + deallocate(this%species_density) + end if + if (allocated(this%species_mie_map)) then + deallocate(this%species_mie_map) + end if + if (allocated(this%species_radius)) then + deallocate(this%species_radius) + end if + + + ! Deallocate diagnostic species array + if (allocated(this%diagnostic_species)) then + deallocate(this%diagnostic_species) + end if + + ! Deallocate diagnostic species indices array + if (allocated(this%diagnostic_species_id)) then + deallocate(this%diagnostic_species_id) + end if + + end subroutine finalize_settling_config + + !> Validate gocart scheme configuration + subroutine validate_gocart_config(this, error_handler) + class(SettlingSchemeGOCARTConfig), intent(inout) :: this + type(ErrorManagerType), intent(inout) :: error_handler + + ! TODO: Add scheme-specific validation + + end subroutine validate_gocart_config + + !> Finalize gocart scheme configuration + subroutine finalize_gocart_config(this) + class(SettlingSchemeGOCARTConfig), intent(inout) :: this + + ! Nothing to deallocate for basic configuration + + end subroutine finalize_gocart_config + + + + !> Convert integer to string (utility function) + function int_to_string(int_val) result(str_val) + integer, intent(in) :: int_val + character(len=32) :: str_val + + write(str_val, '(I0)') int_val + str_val = adjustl(str_val) + + end function int_to_string + + !> Load unified process configuration from ConfigManager + !! This is the main function that ProcessInterface.parse_process_config should call + !! Process reads its configuration directly from the master YAML via ConfigManager + subroutine settling_process_load_config(this, config_manager, error_handler) + class(SettlingProcessConfig), intent(inout) :: this + type(ConfigManagerType), intent(inout) :: config_manager + type(ErrorManagerType), intent(inout) :: error_handler + + character(len=256) :: scheme_name + integer :: ierr, rc + + ! Process reads directly from master YAML structure: processes.settling + ! ConfigManager provides generic YAML access, process handles its own configuration + + ! Load process metadata + call config_manager%get_string("processes/settling/name", this%process_name, rc, "settling") + if (rc /= CC_SUCCESS) this%process_name = "settling" ! default + + call config_manager%get_string("processes/settling/version", this%process_version, rc, "1.0.0") + if (rc /= CC_SUCCESS) this%process_version = "1.0.0" ! default + + call config_manager%get_logical("processes/settling/activate", this%is_active, rc, .true.) + if (rc /= CC_SUCCESS) this%is_active = .true. ! default + + ! Load process-specific configuration directly from master YAML + call config_manager%get_string("processes/settling/scheme", this%settling_config%scheme, rc, "gocart") + if (rc /= CC_SUCCESS) then + call error_handler%report_error(ERROR_INVALID_CONFIG, & + "Missing required 'scheme' in processes/settling configuration", rc) + return + end if + + ! Load diagnostic switch + call config_manager%get_logical("processes/settling/diagnostics", this%settling_config%diagnostics, rc, .false.) + if (rc /= CC_SUCCESS) this%settling_config%diagnostics = .false. ! Default + + ! Load diagnostic species list + call config_manager%get_array("processes/settling/diag_species", this%settling_config%diagnostic_species, & + rc, default_values=["All"]) + if (rc /= CC_SUCCESS) then + ! Default to all species if not specified + allocate(this%settling_config%diagnostic_species(1)) + this%settling_config%diagnostic_species(1) = "All" + this%settling_config%n_diagnostic_species = 1 + else + ! Set the count based on the returned array size + if (allocated(this%settling_config%diagnostic_species)) then + this%settling_config%n_diagnostic_species = size(this%settling_config%diagnostic_species) + else + this%settling_config%n_diagnostic_species = 0 + end if + end if + + ! Species configuration is loaded from ChemState in load_species_from_chem_state + ! The species come from the master species YAML file (CATChem_species.yml) + ! and are filtered by is_settling property + + + ! Load scheme-specific configuration from master YAML + scheme_name = trim(this%settling_config%scheme) + select case (scheme_name) + case ('gocart') + call this%load_gocart_config(config_manager, error_handler) + case default + call error_handler%report_error(ERROR_INVALID_STATE, & + "Unknown settling scheme: " // trim(scheme_name), rc) + return + end select + + end subroutine settling_process_load_config + + + !> Load species from ChemState + !! This function is used for dynamic species discovery (by_metadata or all_species) + !! For 'all_species' mode: loads all species using nSpecies and SpeciesIndex + !! For 'by_metadata' mode: loads species by type using nSpeciesSettling and SettlingIndex + subroutine load_species_from_chem_state(this, chem_state, error_handler) + use ChemState_Mod, only: ChemStateType + + class(SettlingProcessConfig), intent(inout) :: this + type(ChemStateType), pointer, intent(in) :: chem_state + type(ErrorManagerType), intent(inout) :: error_handler + + integer :: i, rc + integer :: species_idx + + if (.not. associated(chem_state)) then + call error_handler%report_error(ERROR_INVALID_STATE, & + "ChemState not associated in load_species_from_chem_state", rc) + return + end if + + ! by_metadata mode: Load species by type from ChemState using dynamic metadata flag mapping + ! Dynamic mapping: is_aerosol -> nSpeciesAero and AeroIndex + this%settling_config%n_species = chem_state%nSpeciesAero + + if (this%settling_config%n_species <= 0) then + call error_handler%report_error(ERROR_INVALID_STATE, & + "No aerosol species found in ChemState", rc) + return + end if + + ! Check if AeroIndex is allocated and has correct size + if (.not. allocated(chem_state%AeroIndex)) then + call error_handler%report_error(ERROR_INVALID_STATE, & + "AeroIndex not allocated in ChemState", rc) + return + end if + + if (size(chem_state%AeroIndex) < this%settling_config%n_species) then + call error_handler%report_error(ERROR_INVALID_STATE, & + "AeroIndex size inconsistent with nSpeciesAero", rc) + return + end if + + ! Deallocate existing arrays if allocated + if (allocated(this%settling_config%species_names)) then + deallocate(this%settling_config%species_names) + end if + if (allocated(this%settling_config%species_indices)) then + deallocate(this%settling_config%species_indices) + end if + + ! Allocate arrays + allocate(this%settling_config%species_names(this%settling_config%n_species)) + allocate(this%settling_config%species_indices(this%settling_config%n_species)) + + ! Allocate species properties arrays + allocate(this%settling_config%species_density(this%settling_config%n_species)) + allocate(this%settling_config%species_mie_map(this%settling_config%n_species)) + allocate(this%settling_config%species_radius(this%settling_config%n_species)) + + ! by_metadata mode: Copy indices from metadata-specific index array using dynamic mapping + ! Dynamic mapping: is_aerosol -> AeroIndex + this%settling_config%species_indices(1:this%settling_config%n_species) = & + chem_state%AeroIndex(1:this%settling_config%n_species) + + ! Get species names using the indices + do i = 1, this%settling_config%n_species + if (this%settling_config%species_indices(i) > 0 .and. & + this%settling_config%species_indices(i) <= size(chem_state%SpeciesNames)) then + this%settling_config%species_names(i) = & + trim(chem_state%SpeciesNames(this%settling_config%species_indices(i))) + else + call error_handler%report_error(ERROR_INVALID_STATE, & + "Invalid species index in species index array", rc) + return + end if + end do + + ! Load species properties from ChemState + do i = 1, this%settling_config%n_species + species_idx = this%settling_config%species_indices(i) + this%settling_config%species_density(i) = chem_state%ChemSpecies(species_idx)%density + if (allocated(chem_state%SpcMieMap)) then + this%settling_config%species_mie_map(i) = chem_state%SpcMieMap(species_idx) + else + this%settling_config%species_mie_map(i) = -1 ! Default or error value + end if + this%settling_config%species_radius(i) = chem_state%ChemSpecies(species_idx)%radius + end do + + end subroutine load_species_from_chem_state + + + !> Load gocart scheme configuration from master YAML + subroutine load_gocart_config(this, config_manager, error_handler) + class(SettlingProcessConfig), intent(inout) :: this + type(ConfigManagerType), intent(inout) :: config_manager + type(ErrorManagerType), intent(inout) :: error_handler + + integer :: ierr, rc + + ! Load scheme parameters directly from processes/settling/gocart/ in master YAML + call config_manager%get_real("processes/settling/gocart/scale_factor", & + this%gocart_config%scale_factor, rc, 1.0_fp) + if (rc /= CC_SUCCESS) this%gocart_config%scale_factor = 1.0_fp + call config_manager%get_logical("processes/settling/gocart/simple_scheme", & + this%gocart_config%simple_scheme, rc, .false.) + if (rc /= CC_SUCCESS) this%gocart_config%simple_scheme = .false. + call config_manager%get_integer("processes/settling/gocart/swelling_method", & + this%gocart_config%swelling_method, rc, 1) + if (rc /= CC_SUCCESS) this%gocart_config%swelling_method = 1 + call config_manager%get_logical("processes/settling/gocart/correction_maring", & + this%gocart_config%correction_maring, rc, .false.) + if (rc /= CC_SUCCESS) this%gocart_config%correction_maring = .false. + + + end subroutine load_gocart_config + + + !> Validate unified process configuration + subroutine settling_process_validate(this, state_manager, error_handler) + class(SettlingProcessConfig), intent(inout) :: this + type(StateManagerType), intent(in) :: state_manager + type(ErrorManagerType), intent(inout) :: error_handler + + ! Validate main config + call this%settling_config%validate(error_handler) + + ! Validate scheme-specific config + select case (trim(this%settling_config%scheme)) + case ('gocart') + call this%gocart_config%validate(error_handler) + end select + + end subroutine settling_process_validate + + !> Finalize unified process configuration + subroutine settling_process_finalize(this) + class(SettlingProcessConfig), intent(inout) :: this + + call this%settling_config%finalize() + call this%gocart_config%finalize() + + end subroutine settling_process_finalize + + !> Get active scheme configuration (polymorphic return) + function get_active_scheme_config(this) result(scheme_config) + class(SettlingProcessConfig), intent(in) :: this + class(*), allocatable :: scheme_config + + select case (trim(this%settling_config%scheme)) + case ('gocart') + allocate(scheme_config, source=this%gocart_config) + case default + ! Return null + end select + + end function get_active_scheme_config + + !> Map diagnostic species names to indices in the species_names array + !! This function creates the diagnostic_species_id array that maps each diagnostic species + !! to its corresponding index in the full species_names array + subroutine map_diagnostic_species_indices(this, error_handler) + class(SettlingProcessConfig), intent(inout) :: this + type(ErrorManagerType), intent(inout) :: error_handler + + integer :: i, j, rc + character(len=256) :: error_msg + logical :: found_species + + ! Only proceed if diagnostic species are defined + if (this%settling_config%n_diagnostic_species == 0) return + + ! Handle "All" case - map all available species + if (this%settling_config%n_diagnostic_species == 1 .and. & + trim(this%settling_config%diagnostic_species(1)) == "All") then + + ! Deallocate and reallocate for all species + if (allocated(this%settling_config%diagnostic_species_id)) deallocate(this%settling_config%diagnostic_species_id) + allocate(this%settling_config%diagnostic_species_id(this%settling_config%n_species)) + if (allocated(this%settling_config%diagnostic_species)) deallocate(this%settling_config%diagnostic_species) + allocate(this%settling_config%diagnostic_species(this%settling_config%n_species)) + this%settling_config%n_diagnostic_species = this%settling_config%n_species + this%settling_config%diagnostic_species = this%settling_config%species_names + + ! Map all species indices (1:n_species) + do i = 1, this%settling_config%n_species + this%settling_config%diagnostic_species_id(i) = i + end do + + return + end if + + ! Allocate diagnostic species indices array + if (allocated(this%settling_config%diagnostic_species_id)) deallocate(this%settling_config%diagnostic_species_id) + allocate(this%settling_config%diagnostic_species_id(this%settling_config%n_diagnostic_species)) + + ! Map each diagnostic species name to its index in species_names + do i = 1, this%settling_config%n_diagnostic_species + found_species = .false. + + do j = 1, this%settling_config%n_species + if (trim(this%settling_config%diagnostic_species(i)) == trim(this%settling_config%species_names(j))) then + this%settling_config%diagnostic_species_id(i) = j + found_species = .true. + exit + end if + end do + + if (.not. found_species) then + write(error_msg, '(A,A,A)') "Diagnostic species '", & + trim(this%settling_config%diagnostic_species(i)), & + "' not found in process species list" + call error_handler%report_error(ERROR_NOT_FOUND, error_msg, rc) + return + end if + end do + + end subroutine map_diagnostic_species_indices + +end module SettlingCommon_Mod diff --git a/src/process/settling/SettlingProcessCreator_Mod.F90 b/src/process/settling/SettlingProcessCreator_Mod.F90 new file mode 100644 index 00000000..3ebeb05b --- /dev/null +++ b/src/process/settling/SettlingProcessCreator_Mod.F90 @@ -0,0 +1,115 @@ +!> \file SettlingProcessCreator_Mod.F90 +!! \brief Factory for creating settling process instances +!! +!! This module provides the factory functions for creating settling +!! process instances following the CATChem Process Factory pattern. +!! +!! Generated on: 2025-12-18T14:12:32.971831 +!! Author: Wei Li +!! Version: 1.0.0 + +module SettlingProcessCreator_Mod + + use precision_mod, only: fp + use error_mod, only: CC_SUCCESS, CC_FAILURE, CC_Error, CC_Warning, ErrorManagerType + use ProcessInterface_Mod + use ProcessSettlingInterface_Mod + + implicit none + private + + public :: create_settling_process + public :: register_settling_process + public :: get_settling_default_config + +contains + + !> Create a new settling process instance + !! + !! This factory function creates and returns a new instance of the + !! settling process. The process is not initialized - the caller + !! must call the init() method with appropriate configuration. + !! + !! @param[out] process Allocated process instance + !! @param[out] rc Return code + subroutine create_settling_process(process, rc) + class(ProcessInterface), allocatable, intent(out) :: process + integer, intent(out) :: rc + + type(ProcessSettlingInterface), allocatable :: settling_process + integer :: alloc_stat + + rc = CC_SUCCESS + + ! Allocate the process instance + allocate(settling_process, stat=alloc_stat) + if (alloc_stat /= 0) then + rc = CC_FAILURE + return + end if + + ! Move to polymorphic variable + call move_alloc(settling_process, process) + + end subroutine create_settling_process + + !> Register the settling process with a ProcessManager + !! + !! This subroutine registers the settling process with a ProcessManager's + !! factory. This is the correct way to register processes for use in + !! applications and integration tests. + !! + !! @param[inout] process_mgr The ProcessManager to register with + !! @param[out] rc Return code + subroutine register_settling_process(process_mgr, rc) + use ProcessManager_Mod, only: ProcessManagerType + + type(ProcessManagerType), intent(inout) :: process_mgr + integer, intent(out) :: rc + + rc = CC_SUCCESS + + call process_mgr%register_process( & + name='settling', & + category='deposition', & + description='Process for computing gravitational settling of aerosol species', & + creator=create_settling_process, & + rc=rc & + ) + + end subroutine register_settling_process + + !> Get default configuration for settling process + !! + !! This function returns a default configuration string that can be + !! used to initialize the settling process with reasonable defaults. + !! + !! @param[out] config_data Default configuration string + subroutine get_settling_default_config(config_data) + character(len=*), intent(out) :: config_data + + ! Return default YAML configuration + config_data = & + '# Default settling process configuration' // new_line('A') // & + 'process:' // new_line('A') // & + ' name: "settling"' // new_line('A') // & + ' version: "1.0.0"' // new_line('A') // & + ' active_scheme: ""' // new_line('A') // & + ' is_active: true' // new_line('A') // & + '' // new_line('A') // & + '# Scheme configuration' // new_line('A') // & + 'schemes:' // new_line('A') // & + ' gocart:' // new_line('A') // & + ' description: "GOCART gravitational settling scheme"' // new_line('A') // & + ' algorithm_type: "explicit"' // new_line('A') // & + ' parameters:' // new_line('A') // & + ' scale_factor: 1.0' // new_line('A') // & + '' // new_line('A') // & + '# Diagnostic configuration' // new_line('A') // & + 'diagnostics:' // new_line('A') // & + ' output_frequency: 3600.0 # seconds' // new_line('A') // & + ' output_diagnostics: true' + + end subroutine get_settling_default_config + +end module SettlingProcessCreator_Mod diff --git a/src/process/settling/examples/settling_config.yaml b/src/process/settling/examples/settling_config.yaml new file mode 100644 index 00000000..9f55e11e --- /dev/null +++ b/src/process/settling/examples/settling_config.yaml @@ -0,0 +1,101 @@ +# Example configuration for settling process +# Generated on: 2025-12-18T14:12:33.350626 +# Author: Wei Li + +process: + name: "settling" + version: "1.0.0" + description: "Process for computing gravitational settling of aerosol species" + active_scheme: "" + is_active: true + + # Time stepping configuration + dt_min: 1.0 # Minimum time step (seconds) + dt_max: 3600.0 # Maximum time step (seconds) + + + + +# Scheme configurations +schemes: + gocart: + description: "GOCART gravitational settling scheme" + author: "Wei Li" + algorithm_type: "explicit" + + # Scheme-specific parameters + parameters: + scale_factor: 1.0 # settling velocity factor + simple_scheme: False # read in mie data for wet particles if true; otherwise calculate particles wet swelling internally + swelling_method: 1 # method for calculating particle swelling: 1 Fitzgerald 1975; 2 for Gerber 1985 + correction_maring: False # correct the settling velocity following Maring et al, 2003 + + # Required meteorological fields for this scheme + required_met_fields: + - "T" + - "TSTEP" + - "AIRDEN" + - "RH" + - "Z" + - "PMID" + - "DELP" + + # Scheme-specific diagnostic configuration + diagnostics: + + +# Diagnostic configuration +diagnostics: + # Global diagnostic settings + output_frequency: 3600.0 # seconds + output_diagnostics: true + + # Individual diagnostic controls + settling_velocity_per_species_per_level: + description: "settling velocity per species per level" + units: "m/s" + output: true + settling_flux_per_species: + description: "settling flux per species across column" + units: "kg/m2/s" + output: true + + +# Performance and optimization settings +performance: + parallelization: "column" + memory_optimization: "low" + vectorization: true + + +# Input/output configuration +io: + # Input data sources + input_data: + + # Output configuration + output_data: + base_directory: "/path/to/output" + file_prefix: "settling_" + compression: true + +# Quality control and validation +quality_control: + enable_bounds_checking: true + enable_conservation_checks: false + enable_mass_balance_checks: false + + # Value limits + limits: + +# Debugging and logging +debug: + level: "info" # debug, info, warning, error + output_file: "settling_debug.log" + flush_frequency: 100 # Flush log every N time steps + + # Debug-specific outputs + debug_outputs: + intermediate_variables: false + conservation_diagnostics: false + timing_information: true diff --git a/src/process/settling/examples/settling_example.F90 b/src/process/settling/examples/settling_example.F90 new file mode 100644 index 00000000..28ee8aae --- /dev/null +++ b/src/process/settling/examples/settling_example.F90 @@ -0,0 +1,327 @@ +!> \file settling_example.F90 +!! \brief Example usage of settling process +!! +!! This program demonstrates how to use the settling process +!! in a standalone application or host model integration. +!! +!! Generated on: 2025-12-18T14:12:33.328014 +!! Author: Wei Li + +program settling_example + + use precision_mod, only: fp + use iso_fortran_env, only: output_unit, error_unit + use precision_mod, only: fp + use Error_Mod, only: CC_SUCCESS, CC_FAILURE + use ProcessInterface_Mod + use ProcessSettlingInterface_Mod + use SettlingCommon_Mod + use SettlingProcessCreator_Mod + use StateManager_Mod + + implicit none + + ! Process and state management + class(ProcessInterface), allocatable :: process + type(StateManagerType) :: state_manager + integer :: rc + + ! Configuration + character(len=256) :: config_file = "settling_config.yaml" + + ! Simulation parameters + integer, parameter :: n_columns = 10 + integer, parameter :: n_levels = 50 + integer, parameter :: n_time_steps = 24 + real(fp), parameter :: dt = 3600.0_fp ! 1 hour time step + + ! Working variables + integer :: i_time, i_col + real(fp) :: total_time + + write(output_unit, '(A)') "=== Settling Process Example ===" + write(output_unit, '(A)') "Process for computing gravitational settling of aerosol species" + write(output_unit, '(A)') "Author: Wei Li" + write(output_unit, '(A)') "" + + ! Step 1: Initialize state manager + call state_manager%init(n_levels, n_columns, 1, rc) + if (rc /= CC_SUCCESS) then + write(error_unit, *) 'ERROR: Failed to initialize state manager' + stop 1 + end if + + ! Step 2: Create process instance + call create_process(process, rc) + if (rc /= CC_SUCCESS) then + write(error_unit, *) 'ERROR: Failed to create process' + stop 1 + end if + + ! Step 3: Initialize process + call process%init(state_manager, rc) + if (rc /= CC_SUCCESS) then + write(error_unit, *) 'ERROR: Process initialization failed' + stop 1 + end if + + write(output_unit, '(A)') "Process initialized successfully" + + ! Step 4: Time loop simulation + write(output_unit, '(A,I0,A)') "Starting ", n_time_steps, " time step simulation" + + do i_time = 1, n_time_steps + total_time = real(i_time - 1, fp) * dt + + write(output_unit, '(A,I0,A,F8.1,A)') "Time step ", i_time, " (t=", total_time/3600.0_fp, " hours)" + + ! Run process for this time step + call process%run(state_manager, rc) + if (rc /= CC_SUCCESS) then + write(error_unit, *) 'ERROR: Process execution failed at time step ', i_time + stop 1 + end if + end do + + write(output_unit, '(A)') "Simulation completed successfully" + + ! Step 5: Finalize process + call process%finalize(rc) + if (rc /= CC_SUCCESS) then + write(error_unit, *) 'ERROR: Process finalization failed' + stop 1 + end if + + write(output_unit, '(A)') "Process finalized successfully" + write(output_unit, '(A)') "Example completed!" + +end program settling_example +write(error_unit, '(A)') "Error creating settling process" +call error_handler%print_errors() +stop 1 +end if +write(output_unit, '(A)') "5. Settling process created" + + ! Step 6: Load configuration +call load_configuration(config_data, error_handler) +if (error_handler%has_error()) then + write(error_unit, '(A)') "Error loading configuration" + call error_handler%print_errors() + stop 1 +end if +write(output_unit, '(A)') "6. Configuration loaded" + + ! Step 7: Initialize process +call process%init(state_manager, config_data, error_handler) +if (error_handler%has_error()) then + write(error_unit, '(A)') "Error initializing settling process" + call error_handler%print_errors() + stop 1 +end if +write(output_unit, '(A)') "7. Settling process initialized" + + ! Step 8: Print process information +call print_process_info(process) + + ! Step 9: Set up initial conditions +call setup_initial_conditions(state_manager, error_handler) +if (error_handler%has_error()) then + write(error_unit, '(A)') "Error setting up initial conditions" + call error_handler%print_errors() + stop 1 +end if +write(output_unit, '(A)') "8. Initial conditions set" + + ! Step 10: Time integration loop +write(output_unit, '(A)') "9. Starting time integration..." +write(output_unit, '(A,I0,A,F0.1,A)') " Running ", n_time_steps, & + " time steps with dt = ", dt, " seconds" + +total_time = 0.0_fp +do i_time = 1, n_time_steps + + ! Run process for one time step + call process%run(state_manager, dt, error_handler) + if (error_handler%has_error()) then + write(error_unit, '(A,I0)') "Error during time step ", i_time + call error_handler%print_errors() + exit + end if + + total_time = total_time + dt + + ! Print progress + if (mod(i_time, max(n_time_steps/10, 1)) == 0) then + write(output_unit, '(A,I0,A,I0,A,F0.1,A)') " Step ", i_time, & + "/", n_time_steps, " (t = ", total_time/3600.0_fp, " hours)" + end if + +end do + +if (.not. error_handler%has_error()) then + write(output_unit, '(A)') "10. Time integration completed successfully" +end if + + ! Step 11: Print diagnostic summary +diag_mgr => state_manager%get_diagnostic_manager() +call print_diagnostic_summary(diag_mgr) + + ! Step 12: Clean up +call process%finalize(error_handler) +call state_manager%finalize(error_handler) + +write(output_unit, '(A)') "11. Cleanup completed" +write(output_unit, '(A)') "" +write(output_unit, '(A)') "=== Example completed successfully ===" + +contains + + !> Set up chemical species in state manager +subroutine setup_chemical_species(state_manager, error_handler) + type(StateManagerType), intent(inout) :: state_manager + type(ErrorHandler), intent(inout) :: error_handler + + ! Add generic species + call state_manager%add_species('GENERIC_SPECIES', error_handler) + + ! Initialize species concentrations + call state_manager%allocate_species_arrays(error_handler) + +end subroutine setup_chemical_species + + !> Set up meteorological fields +subroutine setup_meteorological_fields(state_manager, error_handler) + type(StateManagerType), intent(inout) :: state_manager + type(ErrorHandler), intent(inout) :: error_handler + + ! Add required meteorological fields + + ! Add optional meteorological fields + + ! Initialize meteorological data with test values + call initialize_test_meteorology(state_manager, error_handler) + +end subroutine setup_meteorological_fields + + !> Initialize test meteorological data +subroutine initialize_test_meteorology(state_manager, error_handler) + type(StateManagerType), intent(inout) :: state_manager + type(ErrorHandler), intent(inout) :: error_handler + + integer :: i_col, i_lev + real(fp) :: height, latitude, longitude + + ! Set test meteorological values + do i_col = 1, n_columns + do i_lev = 1, n_levels + + height = real(i_lev - 1, fp) * 1000.0_fp ! Height in meters + latitude = 45.0_fp + real(i_col - 1, fp) * 1.0_fp ! Latitude + longitude = -120.0_fp + real(i_col - 1, fp) * 1.0_fp ! Longitude + + + end do + end do + +end subroutine initialize_test_meteorology + + !> Load process configuration +subroutine load_configuration(config_data, error_handler) + character(len=*), intent(out) :: config_data + type(ErrorHandler), intent(inout) :: error_handler + + ! For this example, use inline configuration + ! In practice, this would be loaded from a file + config_data = & + 'process:' // new_line('A') // & + ' name: "settling"' // new_line('A') // & + ' version: "1.0.0"' // new_line('A') // & + ' active_scheme: ""' // new_line('A') // & + ' is_active: true' // new_line('A') // & + 'diagnostics:' // new_line('A') // & + ' output_frequency: 3600.0' // new_line('A') // & + ' output_diagnostics: true' + +end subroutine load_configuration + + !> Set up initial conditions +subroutine setup_initial_conditions(state_manager, error_handler) + type(StateManagerType), intent(inout) :: state_manager + type(ErrorHandler), intent(inout) :: error_handler + + integer :: i_col, i_lev, i_spec + real(fp) :: initial_concentration + + ! Set initial chemical concentrations + +end subroutine setup_initial_conditions + + !> Print process information +subroutine print_process_info(process) + class(ProcessInterface), intent(in) :: process + + character(len=32), allocatable :: species_list(:) + character(len=32), allocatable :: required_fields(:) + integer :: i + + write(output_unit, '(A)') "" + write(output_unit, '(A)') "Process Information:" + write(output_unit, '(A,A)') " Name: ", trim(process%get_name()) + write(output_unit, '(A,A)') " Version: ", trim(process%get_version()) + write(output_unit, '(A,A)') " Description: ", trim(process%get_description()) + + ! Print species list + species_list = process%get_species_list() + write(output_unit, '(A,I0)') " Number of species: ", size(species_list) + if (size(species_list) > 0) then + write(output_unit, '(A)', advance='no') " Species: " + do i = 1, size(species_list) + write(output_unit, '(A)', advance='no') trim(species_list(i)) + if (i < size(species_list)) write(output_unit, '(A)', advance='no') ", " + end do + write(output_unit, '(A)') "" + end if + + ! Print required fields + required_fields = process%get_required_met_fields() + write(output_unit, '(A,I0)') " Required met fields: ", size(required_fields) + if (size(required_fields) > 0) then + do i = 1, size(required_fields) + write(output_unit, '(A,A)') " - ", trim(required_fields(i)) + end do + end if + write(output_unit, '(A)') "" + +end subroutine print_process_info + + !> Print diagnostic summary +subroutine print_diagnostic_summary(diag_mgr) + type(DiagnosticManager), intent(in) :: diag_mgr + + integer :: n_diagnostics, i + character(len=64), allocatable :: diag_names(:) + real(fp), allocatable :: diag_values(:) + + write(output_unit, '(A)') "" + write(output_unit, '(A)') "Diagnostic Summary:" + + n_diagnostics = diag_mgr%get_n_diagnostics() + write(output_unit, '(A,I0)') " Number of diagnostics: ", n_diagnostics + + if (n_diagnostics > 0) then + allocate(diag_names(n_diagnostics)) + allocate(diag_values(n_diagnostics)) + + call diag_mgr%get_diagnostic_names(diag_names) + call diag_mgr%get_diagnostic_values(diag_values) + + do i = 1, n_diagnostics + write(output_unit, '(A,A,A,ES12.4)') " ", & + trim(diag_names(i)), ": ", diag_values(i) + end do + end if + write(output_unit, '(A)') "" + +end subroutine print_diagnostic_summary + +end program settling_example diff --git a/src/process/settling/schemes/CMakeLists.txt b/src/process/settling/schemes/CMakeLists.txt new file mode 100644 index 00000000..763541fb --- /dev/null +++ b/src/process/settling/schemes/CMakeLists.txt @@ -0,0 +1,34 @@ +# Settling Schemes CMakeLists.txt +# Generated on: 2025-12-18T14:12:33.125087 + +# This file is included by the parent CMakeLists.txt +# Schemes are built as part of the main process library + +# Scheme source files are defined in the parent CMakeLists.txt: +# - SettlingScheme_GOCART_Mod.F90 + +# Scheme-specific configurations can be added here if needed + +# GOCART scheme configuration +# Required meteorological fields for GOCART: +# - T +# - TSTEP +# - AIRDEN +# - RH +# - Z +# - PMID +# - DELP + +# Scheme validation targets +add_custom_target( + validate_gocart_scheme + COMMAND ${CMAKE_COMMAND} -E echo "Validating gocart scheme implementation" + COMMENT "Validating gocart scheme" +) + +# Combined validation target +add_custom_target( + validate_all_schemes + DEPENDS validate_gocart_scheme + COMMENT "Validating all settling schemes" +) diff --git a/src/process/settling/schemes/SettlingScheme_GOCART_Mod.F90 b/src/process/settling/schemes/SettlingScheme_GOCART_Mod.F90 new file mode 100644 index 00000000..7d63f5db --- /dev/null +++ b/src/process/settling/schemes/SettlingScheme_GOCART_Mod.F90 @@ -0,0 +1,408 @@ +!> \file SettlingScheme_GOCART_Mod.F90 +!! \brief GOCART gravitational settling scheme +!! +!! Pure science kernel for gocart scheme in settling process. +!! This module contains ONLY the computational algorithm with NO infrastructure dependencies. +!! Uses only basic Fortran types for maximum portability and reusability. +!! +!! SCIENCE CUSTOMIZATION GUIDE: +!! 1. Modify the algorithm in compute_gocart (search for "TODO") +!! 2. Add scheme-specific helper subroutines as needed +!! 3. Update physical constants for your scheme +!! 4. Customize the environmental response functions +!! +!! INFRASTRUCTURE RESPONSIBILITIES (handled by host model): +!! - Parameter initialization and validation +!! - Input array validation and error handling +!! - Memory management and array allocation +!! - Integration with host model time stepping +!! +!! Generated on: 2025-12-17T15:27:52.203209 +!! Author: Wei Li +!! Reference: GOCART2G process library Chem_SettlingSimple function +module SettlingScheme_GOCART_Mod + + use precision_mod, only: fp, rae + use SettlingCommon_Mod, only: SettlingSchemeGOCARTConfig + use error_mod, only: CC_SUCCESS, CC_Error + use Constants, only: g0 !load the constants needed for this scheme + use GOCART2G_MieMod, only: GOCART2G_Mie ! For Mie data in gocart scheme + + implicit none + private + + ! Public interface - pure science only + public :: compute_gocart + + ! Additional physical constants (modify as needed for your scheme) + real(fp), parameter :: plid = 0.01_fp ! Pressure lid [hPa] + +contains + + !> Pure science computation for gocart scheme + !! + !! This is a pure computational kernel implementing GOCART gravitational settling scheme. + !! NO error checking, validation, or infrastructure concerns. + !! Host model must ensure all inputs are valid before calling. + !! + !! @param[in] num_layers Number of vertical layers + !! @param[in] num_species Number of chemical species + !! @param[in] params Scheme parameters (pre-validated by host) + !! @param[in] airden AIRDEN field [appropriate units] + !! @param[in] delp DELP field [appropriate units] + !! @param[in] pmid PMID field [appropriate units] + !! @param[in] rh RH field [appropriate units] + !! @param[in] t T field [appropriate units] + !! @param[in] tstep Time step [s] - retrieved from process interface + !! @param[in] z Z field [appropriate units] + !! @param[in] species_short_name Species short_name property + !! @param[in] mie_data Complete Mie data array from ChemState + !! @param[in] species_mie_map Mapping from process species to MieData indices + !! @param[in] species_radius Species radius property + !! @param[in] species_density Species density property + !! @param[in] species_conc Species concentrations [mol/mol] (num_layers, num_species) + !! @param[inout] species_tendencies Species tendency terms [mol/mol/s] (num_layers, num_species) + !! @param[inout] settling_velocity_per_species_per_level settling velocity per species per level [m/s] (num_layers, num_species) + !! @param[inout] settling_flux_per_species settling flux per species across column [kg/m2/s] (num_species) + !! @param[in] diagnostic_species_id Indices mapping diagnostic species to species array (optional, for per-species diagnostics) + subroutine compute_gocart( & + num_layers, & + num_species, & + params, & + airden, & + delp, & + pmid, & + rh, & + t, & + tstep, & + z, & + species_short_name, & + mie_data, & + species_mie_map, & + species_radius, & + species_density, & + species_conc, & + species_tendencies, & + settling_velocity_per_species_per_level, & + settling_flux_per_species, & + diagnostic_species_id & + ) + ! Uses + USE GOCART2G_Process, only: Chem_SettlingSimple, Chem_Settling + ! Arguments + integer, intent(in) :: num_layers + integer, intent(in) :: num_species + type(SettlingSchemeGOCARTConfig), intent(in) :: params + real(fp), intent(in) :: airden(num_layers) ! 3D atmospheric field + real(fp), intent(in) :: delp(num_layers) ! 3D atmospheric field + real(fp), intent(in) :: pmid(num_layers) ! 3D atmospheric field + real(fp), intent(in) :: rh(num_layers) ! 3D atmospheric field + real(fp), intent(in) :: t(num_layers) ! 3D atmospheric field + real(fp), intent(in) :: tstep ! Time step [s] - from process interface + real(fp), intent(in) :: z(num_layers+1) ! 3D atmospheric field + character(len=32), intent(in) :: species_short_name(:) ! Species short_name property + type(GOCART2G_Mie), intent(in) :: mie_data(:) ! Complete Mie data array from ChemState + integer, intent(in) :: species_mie_map(num_species) ! Mapping from process species to MieData indices + real(fp), intent(in) :: species_radius(:) ! Species radius property + real(fp), intent(in) :: species_density(:) ! Species density property + real(fp), intent(in) :: species_conc(num_layers, num_species) + real(fp), intent(inout) :: species_tendencies(num_layers, num_species) + real(fp), intent(inout), optional :: settling_velocity_per_species_per_level(:,:) + real(fp), intent(inout), optional :: settling_flux_per_species(:) + integer, intent(in), optional :: diagnostic_species_id(:) ! Indices mapping diagnostic species to species array + + ! Local variables + integer :: rc, species_idx, p + integer :: diag_idx ! For diagnostic species indexing + integer :: bin ! For bin index + integer :: klid ! For pressure lid index + ! Local Variables + real(fp), pointer :: GOCART_tmpu(:,:,:) + real(fp), pointer :: GOCART_rhoa(:,:,:) + real(fp), pointer :: GOCART_HGHTE(:,:,:) + real(fp), pointer :: GOCART_RH(:,:,:) + real(fp), pointer :: GOCART_PRESS(:,:,:) + real(fp), pointer :: GOCART_DELP(:,:,:) + real(fp) :: qa(1,1,num_layers) ! concentration in [kg/kg] + real(fp), pointer :: SD(:,:,:) ! settling velocity [m/s] + real(fp), pointer :: fluxout(:,:,:) ! flux out across column [kg/m2/s] + real(fp), pointer :: fluxout_temp(:,:) ! flux out across column [kg/m2/s] + !error information + character(len=255) :: thisLoc + character(len=512) :: ErrMsg + ErrMsg = '' + ThisLoc = ' -> at compute_gocart (in process/settling/schemes/SettlingScheme_GOCART_Mod.F90)' + ! Initialize + RC = CC_SUCCESS + klid = 1 !since the layer is reversed, we give 1 here, which is the top layer + qa = 0.0_fp + allocate(SD(1, 1, num_layers)) + allocate(fluxout_temp(1,1)) + SD = 0.0_fp + fluxout_temp = 0.0_fp + + ! Note: species_tendencies and diagnostic arrays are already initialized + ! by the host ProcessInterface before calling this subroutine. + ! Do not re-initialize them here. + + !reverse met variables + call PrepMetVarsForGOCART(num_layers, & + t, & + airden, & + z, & + rh, & + pmid, & + delp, & + GOCART_tmpu, & + GOCART_RHOA, & + GOCART_HGHTE, & + GOCART_RH, & + GOCART_PRESS, & + GOCART_DELP) + + !get pressure lid index + call findKlid(klid, plid, GOCART_PRESS(:,:,:), RC) + if (RC /= CC_SUCCESS) then + ErrMsg = 'Error in finding pressure lid index in GOCART settling scheme.' + call CC_Error(trim(ErrMsg), RC, thisLoc) + return + end if + + ! Main computation loop - CUSTOMIZE THIS SECTION FOR YOUR SCHEME + ! Apply to each species + do species_idx = 1, num_species + ! get bin based on name ending with 1, 2,3,4,5 or a letter + if (len_trim(species_short_name(species_idx)) >= 1) then + p = len_trim(species_short_name(species_idx)) + select case (species_short_name(species_idx)(p:p)) + case ('1') + bin = 1 + case ('2') + bin = 2 + case ('3') + bin = 3 + case ('4') + bin = 4 + case ('5') + bin = 5 + case default + bin = 1 ! default bin if no match + end select + else + bin = 1 ! default bin if name is too short + end if + + !initialize fluxout + allocate(fluxout(1, 1, bin)) + fluxout = 0.0_fp + + !reverse vertical layer and convert from ug/kg to kg/kg + qa(1,1,:) = species_conc(num_layers:1:-1, species_idx) * 1.0e-9_fp ! from ug/kg to kg/kg + + if (params%simple_scheme) then !call gocart simple settling function with mie data provided + !check mie data is available + if (species_mie_map(species_idx) <= 0) then + ErrMsg = 'Invalid Mie data mapping found. Check if proper mie files are provided.' + RC = 1 + call CC_Error(trim(ErrMsg), RC, thisLoc) + return + end if + call Chem_SettlingSimple (num_layers, klid, mie_data(species_mie_map(species_idx)), bin, tstep, g0, & + qa, GOCART_tmpu, GOCART_rhoa, GOCART_RH, GOCART_HGHTE, GOCART_DELP, fluxout_temp, & + vsettleOut=SD, correctionMaring=params%correction_maring, settling_scheme=2, rc=RC) !hardcode settling_scheme=2 for GOCART scheme + if (RC /= CC_SUCCESS) then + ErrMsg = 'Error in running GOCART Chem_SettlingSimple scheme.' + call CC_Error(trim(ErrMsg), RC, thisLoc) + return + end if + fluxout(:,:,bin) = fluxout_temp(:,:) + else !call gocart simple settling function with internal mie calculation + call Chem_Settling (num_layers, klid, bin, params%swelling_method, tstep, g0, species_radius(species_idx)*1.0e-6_fp, & !um to m + species_density(species_idx), qa, GOCART_tmpu, GOCART_RHOA, GOCART_RH, GOCART_HGHTE, GOCART_DELP, fluxout, & + vsettleOut=SD, correctionMaring=params%correction_maring, settling_scheme=2, rc=RC) !hardcode settling_scheme=2 for GOCART scheme + if (RC /= CC_SUCCESS) then + ErrMsg = 'Error in running GOCART Chem_Settling scheme.' + call CC_Error(trim(ErrMsg), RC, thisLoc) + return + end if + end if + + ! convert concentrations back to original order and units + species_tendencies(:, species_idx) = max(0.0_fp, qa(1, 1, num_layers:1:-1) * 1.0e9_fp) ! from kg/kg to ug/kg + + ! TODO: Update diagnostic fields here based on your scheme's requirements + ! Each process should implement custom diagnostic calculations + ! Example patterns: + ! Per-species-per-level diagnostic: 2D array (levels, species) + if (present(settling_velocity_per_species_per_level) .and. present(diagnostic_species_id)) then + ! Find position of this species in diagnostic_species_id array + do diag_idx = 1, size(diagnostic_species_id) + if (diagnostic_species_id(diag_idx) == species_idx) then + ! Add your custom settling velocity per species per level calculation + settling_velocity_per_species_per_level(:, diag_idx) = SD(1,1,num_layers:1:-1) !reverse layers + exit + end if + end do + end if + ! Per-species diagnostic: only update for diagnostic species + if (present(settling_flux_per_species) .and. present(diagnostic_species_id)) then + ! Find position of this species in diagnostic_species_id array + do diag_idx = 1, size(diagnostic_species_id) + if (diagnostic_species_id(diag_idx) == species_idx) then + ! Add your custom settling flux per species across column calculation + settling_flux_per_species(diag_idx) = fluxout(1,1, bin) + exit + end if + end do + end if + end do + + !cleanup pointers + if (associated(GOCART_TMPU)) nullify(GOCART_TMPU) + if (associated(GOCART_RHOA)) nullify(GOCART_RHOA) + if (associated(GOCART_HGHTE)) nullify(GOCART_HGHTE) + if (associated(GOCART_RH)) nullify(GOCART_RH) + if (associated(GOCART_PRESS)) nullify(GOCART_PRESS) + if (associated(GOCART_DELP)) nullify(GOCART_DELP) + if (associated(SD)) nullify(SD) + if (associated(fluxout)) nullify(fluxout) + if (associated(fluxout_temp)) nullify(fluxout_temp) + + end subroutine compute_gocart + + ! ======================================================================= + ! SCHEME-SPECIFIC HELPER SUBROUTINES + ! ======================================================================= + ! Add your custom scientific algorithms here as pure functions/subroutines + ! Examples: environmental response functions, species-specific calculations, etc. + + !> + !! \brief findKlid - Finds corresponding vertical index for defined pressure lid + !! + !! \param [INOUT] klid + !! \param [IN] plid + !! \param [IN] ple + !! \param [OUT] rc + !!!> + subroutine findKlid (klid, plid, ple, rc) + + implicit NONE + ! !INPUT PARAMETERS: + integer, intent(inout) :: klid ! index for pressure lid + real(fp), intent(in) :: plid ! pressure lid [hPa]; default is 0.01 hPa + real(fp), dimension(:,:,:), intent(in) :: ple ! air pressure [Pa] + ! !OUTPUT PARAMETERS: + integer, intent(out) :: rc ! return code; 0 - all is good; 1 - bad + ! !Reference to gocart: https://github.com/GEOS-ESM/GOCART/blob/9ff3df9545dd582f415f682d3297e8c6c841e5cb/ESMF/Shared/Chem_AeroGeneric.F90#L316 + ! !Local Variables + integer :: k, j, i + real(fp) :: plid_, diff, refDiff + real(fp), allocatable, dimension(:) :: pres ! pressure at each model level [Pa] + !EOP + !---------------------------------------------------------------------------------- + ! Begin... + klid = 1 + rc = 0 + + ! convert from hPa to Pa + plid_ = plid*100.0_fp + + allocate(pres(ubound(ple,3))) + + ! find pressure at each model level + do k = 1, ubound(ple,3) + pres(k) = ple(1,1,k) + end do + + ! find smallest absolute difference between plid and average pressure at each model level + refDiff = 150000.0_fp + do k = 1, ubound(ple,3) + diff = abs(pres(k) - plid_) + if (diff < refDiff) then + klid = k + refDiff = diff + end if + end do + + ! Check to make sure that all pressures at (i,j) were the same + do j = 1, ubound(ple,2) + do i = 1, ubound(ple,1) + !if (pres(klid) /= ple(i,j,klid)) then !This gives a warning for floating point comparison. Use rae instead + if (.not. rae(pres(klid), ple(i,j,klid))) then + rc = 1 + return + end if + end do + end do + + end subroutine findKlid + + !> + !! \brief PrepMetVarsForGOCART - Prep the meteorological variables for GOCART settling scheme + !! + !! \param [IN] km + !! \param [IN] tmpu + !! \param [IN] rhoa + !! \param [IN] hghte + !! \param [IN] rh + !! \param [IN] press + !! \param [IN] delp + !! \param [INOUT] GOCART_tmpu + !! \param [INOUT] GOCART_RHOA + !! \param [INOUT] GOCART_HGHTE + !! \param [INOUT] GOCART_RH + !! \param [INOUT] GOCART_PRESS + !! \param [INOUT] GOCART_DELP + !!!> + subroutine PrepMetVarsForGOCART(km, & + tmpu, & + rhoa, & + hghte, & + rh, & + press, & + delp, & + GOCART_tmpu, & + GOCART_RHOA, & + GOCART_HGHTE, & + GOCART_RH, & + GOCART_PRESS, & + GOCART_DELP) + + IMPLICIT NONE + + ! INPUTS + INTEGER, intent(in) :: km ! number of vertical levels + REAL(fp), intent(in), DIMENSION(:), target :: tmpu ! Temperature [K] + REAL(fp), intent(in), DIMENSION(:), target :: rhoa ! Air density [kg/m^3] + REAL(fp), intent(in), DIMENSION(:), target :: hghte ! Geopotential Height [m] + REAL(fp), intent(in), DIMENSION(:), target :: rh ! Relative Humidity [decimal; not %] + REAL(fp), intent(in), DIMENSION(:), target :: press ! Pressure [Pa] + REAL(fp), intent(in), DIMENSION(:), target :: delp ! Pressure thickness [Pa] + + ! INPUT/OUTPUTS + REAL(fp), intent(inout), pointer :: GOCART_TMPU(:,:,:) !< temperature [K] + REAL(fp), intent(inout), pointer, DIMENSION(:,:,:) :: GOCART_RHOA !< air density [kg/m^3] + REAL(fp), intent(inout), pointer, DIMENSION(:,:,:) :: GOCART_HGHTE !< geometric height [m] + REAL(fp), intent(inout), pointer, DIMENSION(:,:,:) :: GOCART_RH !< relative humidity [decimal; not %] + REAL(fp), intent(inout), pointer, DIMENSION(:,:,:) :: GOCART_PRESS !< pressure [Pa] + REAL(fp), intent(inout), pointer, DIMENSION(:,:,:) :: GOCART_DELP !< pressure thickness [Pa] + + + allocate(GOCART_TMPU(1, 1, km)) + allocate(GOCART_RHOA(1, 1, km)) + allocate(GOCART_HGHTE(1,1, 0:km)) + allocate(GOCART_RH(1,1, km)) + allocate(GOCART_PRESS(1,1, km)) + allocate(GOCART_DELP(1,1, km)) + + !Note: GOCART scheme expects vertical levels in reverse order (top to bottom) + GOCART_TMPU(1,1,:) = tmpu(size(tmpu):1:-1) ! temperature [K] + GOCART_RHOA(1,1,:) = rhoa(size(rhoa):1:-1) ! air density [kg/m^3] + GOCART_HGHTE(1,1,:) = hghte(size(hghte):1:-1) ! geopotential height [m] + GOCART_RH(1,1,:) = rh(size(rh):1:-1) ! relative humidity [decimal; not %] + GOCART_PRESS(1,1,:) = press(size(press):1:-1) ! pressure [Pa] + GOCART_DELP(1,1,:) = delp(size(delp):1:-1) ! pressure thickness [Pa] + + end subroutine PrepMetVarsForGOCART + +end module SettlingScheme_GOCART_Mod diff --git a/src/process/wetdep/CMakeLists.txt b/src/process/wetdep/CMakeLists.txt new file mode 100644 index 00000000..7ecc84dc --- /dev/null +++ b/src/process/wetdep/CMakeLists.txt @@ -0,0 +1,122 @@ +# WetDep Process CMakeLists.txt +# Generated on: 2025-12-15T16:30:33.743213 +# Author: Wei Li +# Description: Process for computing wet deposition of gas and aerosol species + +# Define wetdep process sources +set( + WETDEP_PROCESS_SOURCES + WetDepCommon_Mod.F90 + ProcessWetDepInterface_Mod.F90 + WetDepProcessCreator_Mod.F90 +) + +# Define wetdep scheme sources +set(WETDEP_SCHEME_SOURCES schemes/WetDepScheme_JACOB_Mod.F90) + +# Combine all sources +set(WETDEP_ALL_SOURCES ${WETDEP_PROCESS_SOURCES} ${WETDEP_SCHEME_SOURCES}) + +# Create the wetdep process library +set(_lib CATChem_process_wetdep) +add_library(${_lib} ${WETDEP_ALL_SOURCES}) + +# Link with required libraries +target_link_libraries(${_lib} PUBLIC CATChem_core) + +# Additional dependencies + +# Set module directory +set_target_properties( + ${_lib} + PROPERTIES Fortran_MODULE_DIRECTORY ${CMAKE_BINARY_DIR}/include +) + +# Include directories +target_include_directories(${_lib} PRIVATE ${CMAKE_BINARY_DIR}/include) + +# Compiler-specific flags +if(CMAKE_Fortran_COMPILER_ID MATCHES "GNU") + target_compile_options(${_lib} PRIVATE -fdefault-real-8 -fdefault-double-8) +elseif(CMAKE_Fortran_COMPILER_ID MATCHES "Intel") + target_compile_options(${_lib} PRIVATE -r8) +endif() + +# Add preprocessor definitions +target_compile_definitions( + ${_lib} + PRIVATE PROCESS_NAME="wetdep" PROCESS_VERSION="1.0.0" +) + +# Install targets +install( + TARGETS ${_lib} + ARCHIVE DESTINATION lib + LIBRARY DESTINATION lib + RUNTIME DESTINATION bin +) + +# Install module files +install( + DIRECTORY ${CMAKE_BINARY_DIR}/include/ + DESTINATION include + FILES_MATCHING + PATTERN "*.mod" +) + +# Add subdirectories +if(BUILD_TESTING) + # Add tests subdirectory - tests are located in tests/process/wetdep/ + set(TESTS_DIR "${CMAKE_SOURCE_DIR}/tests/process/wetdep") + if(EXISTS "${TESTS_DIR}/CMakeLists.txt") + add_subdirectory("${TESTS_DIR}" "${CMAKE_CURRENT_BINARY_DIR}/tests") + endif() +endif() + +if(BUILD_EXAMPLES) + add_subdirectory(examples) +endif() + +# Documentation +if(BUILD_DOCUMENTATION) + find_package(Doxygen QUIET) + if(DOXYGEN_FOUND) + set(DOXYGEN_PROJECT_NAME "WetDep Process") + set( + DOXYGEN_PROJECT_BRIEF + "Process for computing wet deposition of gas and aerosol species" + ) + set(DOXYGEN_OUTPUT_DIRECTORY "${CMAKE_CURRENT_BINARY_DIR}/docs") + set(DOXYGEN_INPUT "${CMAKE_CURRENT_SOURCE_DIR}") + set(DOXYGEN_RECURSIVE YES) + set(DOXYGEN_FILE_PATTERNS "*.F90 *.md") + set(DOXYGEN_EXCLUDE_PATTERNS "*/build/* */tests/*") + + doxygen_add_docs( + wetdep_docs + ${CMAKE_CURRENT_SOURCE_DIR} + COMMENT "Generating wetdep process documentation" + ) + + install( + DIRECTORY ${CMAKE_CURRENT_BINARY_DIR}/docs/ + DESTINATION share/doc/wetdep + OPTIONAL + ) + endif() +endif() + +# Performance testing + +# Process-specific targets + +# Print configuration summary +message(STATUS "Configured WetDep process:") +message(STATUS " Process type: deposition") +message(STATUS " Number of schemes: 1") +message(STATUS " Default scheme: ") +message(STATUS " Has size bins: No") +message(STATUS " Multiphase: No") +message(STATUS " Generate tests: Yes") +message(STATUS " Generate docs: Yes") +message(STATUS " Generate examples: Yes") diff --git a/src/process/wetdep/ProcessWetDepInterface_Mod.F90 b/src/process/wetdep/ProcessWetDepInterface_Mod.F90 new file mode 100644 index 00000000..1e283771 --- /dev/null +++ b/src/process/wetdep/ProcessWetDepInterface_Mod.F90 @@ -0,0 +1,806 @@ +!> Process for computing wet deposition of gas and aerosol species +!! +!! This module provides the wetdep process interface for the CATChem library. +!! The interface leverages CATChem's core infrastructure for data marshaling and process management. +!! All algorithmic calculations are performed in separate scheme modules. +!! +!! DIAGNOSTIC INTERFACE: +!! The compute_scheme functions support optional diagnostic parameters. When diagnostics are +!! enabled in the configuration, these parameters are passed to capture emission/tendency data. +!! When diagnostics are disabled, the scheme calls use the original interface without diagnostics. +!! This approach maintains backward compatibility while providing flexible diagnostic capabilities. +!! +!! This code was generated by the CATChem Process Generator. +!! Generation date: 2025-12-15T16:30:33.461694 +!! Configuration: wetdep +!! +!! @author CATChem Process Generator +!! @version 1.0.0 + +module ProcessWetDepInterface_Mod + + ! Core CATChem infrastructure + use precision_mod, only: fp + use ProcessInterface_Mod, only: ProcessInterface, ColumnProcessInterface + use StateManager_Mod, only: StateManagerType + use GridManager_Mod, only: GridManagerType + use error_mod, only: CC_SUCCESS, CC_FAILURE, CC_Error, CC_Warning, ErrorManagerType + use DiagnosticManager_Mod, only: DiagnosticManagerType + use DiagnosticInterface_Mod, only: DiagnosticRegistryType, DiagnosticFieldType, DiagnosticDataType + use VirtualColumn_Mod, only: VirtualColumnType, VirtualMetType + use Constants, only: g0, AIRMW ! Gravitational acceleration for tendency physics and air molecular weight for unit conversion + + ! Core utilities (leverage existing infrastructure) + use ConfigManager_Mod, only: ConfigManagerType + use ChemState_Mod, only: ChemStateType + use MetState_Mod, only: MetStateType + + ! Common utilities - unified configuration + use WetDepCommon_Mod, only: WetDepProcessConfig + + ! Scheme modules + use WetDepScheme_JACOB_Mod, only: compute_jacob + + implicit none + private + + public :: ProcessWetDepInterface + + !> Main wetdep process interface type - extends core ColumnProcessInterface !! + !! This type leverages CATChem's core ColumnProcessInterface infrastructure for column + !! virtualization, focusing only on process-specific configuration and scheme management. + !! All boilerplate infrastructure and column processing is handled by the base class. + type, extends(ColumnProcessInterface) :: ProcessWetDepInterface + private + + ! Unified process configuration (bridges ConfigManager to process-specific config) + type(WetDepProcessConfig), public :: process_config + + ! Process utilities (leverage core infrastructure) + type(ChemStateType), pointer :: chem_state => null() + type(MetStateType), pointer :: met_state => null() + ! Note: state_manager pointer removed as it was never used + + ! Process-specific diagnostic indices (base class handles storage) + integer :: diag_wetdep_mass_per_species_per_level_idx = -1 + integer :: diag_wetdep_flux_per_species_per_level_idx = -1 + + ! Column-level diagnostic storage for interfacing with DiagManager + ! These are allocated per-column during processing and can be used to + ! accumulate data for DiagManager updates + real(fp), allocatable :: column_wetdep_mass_per_species_per_level(:,:) ! 2D: levels x species - per column + real(fp), allocatable :: column_wetdep_flux_per_species_per_level(:,:) ! 2D: levels x species - per column + + ! Scheme-specific diagnostic storage (shared across all schemes that use them) + + contains + ! Required ProcessInterface implementations + procedure :: init => process_init + procedure :: run => process_run + procedure :: finalize => process_finalize + procedure :: parse_process_config => parse_wetdep_config + + ! Required ColumnProcessInterface implementations + procedure :: init_column_processing => init_column_processing + procedure :: run_column => run_column + procedure :: finalize_column_processing => finalize_column_processing + + ! ProcessInterface capability registration + procedure :: get_required_met_fields => get_required_met_fields + procedure :: get_required_diagnostic_fields => get_required_diagnostic_fields + + ! Public testing interface for scheme manipulation + procedure :: set_scheme => set_wetdep_scheme + procedure :: get_scheme => get_wetdep_scheme + + ! Process-specific implementations (column virtualization) + procedure, private :: run_active_scheme_column + procedure, private :: run_jacob_scheme_column + + ! Diagnostic procedures (override base class method) + procedure :: register_diagnostics => register_and_allocate_diagnostics + procedure, private :: register_and_allocate_diagnostics + procedure, private :: calculate_and_update_diagnostics + + end type ProcessWetDepInterface + +contains + + !> Initialize the wetdep process + !! + !! Leverages ProcessInterface base class for common initialization tasks. + !! Only handles process-specific configuration and scheme setup. + subroutine process_init(this, container, rc) + class(ProcessWetDepInterface), intent(inout) :: this + type(StateManagerType), intent(inout) :: container + integer, intent(out) :: rc + + type(ErrorManagerType), pointer :: error_manager + + rc = CC_SUCCESS + + ! Get error manager + error_manager => container%get_error_manager() + + ! Initialize column processing capabilities + call this%init_column_processing(container, rc) + if (rc /= CC_SUCCESS) return + + ! Set process-specific name and info + this%name = 'wetdep' + this%version = '1.0.0' + this%description = 'Process for computing wet deposition of gas and aerosol species' + + ! Parse process-specific configuration using unified approach + call this%parse_process_config(container, error_manager, rc) + if (rc /= CC_SUCCESS) then + return + end if + + ! Get state pointers from container (needed for species loading) + this%chem_state => container%get_chem_state_ptr() + this%met_state => container%get_met_state_ptr() + + ! Load species from ChemState based on is_wetdep property + call this%process_config%load_species_from_chem_state(this%chem_state, error_manager) + ! Note: Error handling managed by error_manager internally + + ! Map diagnostic species names to indices in the species array + call this%process_config%map_diagnostic_species_indices(error_manager) + + ! Validate the configuration with StateManager + call this%process_config%validate(container, error_manager) + ! Note: validate doesn't return rc, but error_manager tracks errors + + ! Register diagnostics for this process (only if diagnostics enabled) + call this%register_diagnostics(container, rc) + if (rc /= CC_SUCCESS) then + return + end if + + ! Mark process as initialized and active + call this%activate() + + end subroutine process_init + + !> Run the wetdep process + !! + !! This method implements the main ProcessInterface run method. + !! For ColumnProcessInterface processes, the actual column iteration is handled + !! by ProcessManager, so this method serves as a placeholder for any 3D operations + !! that might be needed before or after column processing. + subroutine process_run(this, container, rc) + class(ProcessWetDepInterface), intent(inout) :: this + type(StateManagerType), intent(inout) :: container + integer, intent(out) :: rc + + rc = CC_SUCCESS + + ! Check if process is active + if (.not. this%process_config%is_active) then + return + end if + + ! For ColumnProcessInterface processes, the ProcessManager handles column iteration + ! and calls run_column() for each virtual column. This method is mainly a placeholder + ! for any global 3D operations that need to happen before/after column processing. + + ! Currently no global 3D operations needed for wetdep process + ! All processing happens in run_column() method + + end subroutine process_run + + !> Finalize the wetdep process + subroutine process_finalize(this, rc) + class(ProcessWetDepInterface), intent(inout) :: this + integer, intent(out) :: rc + + rc = CC_SUCCESS + + ! Finalize column processing + call this%finalize_column_processing(rc) + if (rc /= CC_SUCCESS) return + + ! Deallocate diagnostic class members + if (allocated(this%column_wetdep_mass_per_species_per_level)) deallocate(this%column_wetdep_mass_per_species_per_level) + if (allocated(this%column_wetdep_flux_per_species_per_level)) deallocate(this%column_wetdep_flux_per_species_per_level) + ! Deallocate scheme-specific diagnostic fields (only deallocate unique fields once) + + ! Finalize unified configuration + call this%process_config%finalize() + + end subroutine process_finalize + + !> Parse process configuration using unified approach + !! This function bridges the ConfigManager YAML structure to process-specific configuration + subroutine parse_wetdep_config(this, state_manager, error_manager, rc) + class(ProcessWetDepInterface), intent(inout) :: this + type(StateManagerType), intent(inout) :: state_manager ! Changed to inout for function call + type(ErrorManagerType), intent(inout) :: error_manager + integer, intent(out) :: rc + + type(ConfigManagerType), pointer :: config_manager + + rc = CC_SUCCESS + + ! Get configuration manager from state manager + config_manager => state_manager%get_config_ptr() + if (.not. associated(config_manager)) then + call error_manager%report_error(1003, & + 'ConfigManager not available from StateManager', rc) + return + end if + + ! Use the unified configuration loader from WetDepCommon_Mod + ! This handles the complexity of parsing hierarchical YAML into process-specific types + call this%process_config%load_from_config(config_manager, error_manager) + ! Note: Error handling managed by error_manager internally + + ! Process is now configured - the unified config contains all scheme-specific settings + + end subroutine parse_wetdep_config + + !======================================================================== + ! Column Processing Interface Implementation + !======================================================================== + + !> Initialize column processing for wetdep + !! + !! This method sets up the column processing infrastructure for the process. + !! The base class ColumnProcessInterface handles the actual column virtualization. + subroutine init_column_processing(this, container, rc) + class(ProcessWetDepInterface), intent(inout) :: this + type(StateManagerType), intent(inout) :: container + integer, intent(out) :: rc + + rc = CC_SUCCESS + + ! Enable column processing and set batch size for optimal performance + call this%enable_column_processing() + call this%set_column_batch_size(50) ! Process 50 columns at a time + + ! Any process-specific column processing setup would go here + ! For wetdep, no additional setup is needed + + end subroutine init_column_processing + + !> Process a single virtual column for wetdep + !! + !! This is the core column processing method where the actual atmospheric process + !! calculations happen for a single column. The base class handles column + !! virtualization and calls this method for each virtual column. + subroutine run_column(this, column, container, rc) + class(ProcessWetDepInterface), intent(inout) :: this + type(VirtualColumnType), intent(inout) :: column + type(StateManagerType), intent(inout) :: container + integer, intent(out) :: rc + + rc = CC_SUCCESS + + ! Check if process is active + if (.not. this%process_config%is_active) return + + ! Delegate to the active scheme for column processing + call this%run_active_scheme_column(column, rc) + + ! Calculate and update diagnostics if enabled + if (this%process_config%wetdep_config%diagnostics .and. rc == CC_SUCCESS) then + call this%calculate_and_update_diagnostics(column, container, rc) + end if + + end subroutine run_column + + !> Finalize column processing for wetdep + !! + !! Clean up any column processing resources. + subroutine finalize_column_processing(this, rc) + class(ProcessWetDepInterface), intent(inout) :: this + integer, intent(out) :: rc + + rc = CC_SUCCESS + + ! Clean up column processing + call this%disable_column_processing() + + ! Any process-specific cleanup would go here + + end subroutine finalize_column_processing + + !> Run the active scheme for a single virtual column + !! + !! This method adapts the existing scheme methods to work with virtual columns + !! instead of state manager column indices. + subroutine run_active_scheme_column(this, column, rc) + class(ProcessWetDepInterface), intent(inout) :: this + type(VirtualColumnType), intent(inout) :: column + integer, intent(out) :: rc + + rc = CC_SUCCESS + + ! Delegate to appropriate scheme using unified config + select case (trim(this%process_config%wetdep_config%scheme)) + case ('jacob') + call this%run_jacob_scheme_column(column, rc) + case default + rc = CC_FAILURE + end select + + end subroutine run_active_scheme_column + + !> Run the jacob scheme for a single virtual column + subroutine run_jacob_scheme_column(this, column, rc) + class(ProcessWetDepInterface), intent(inout) :: this + type(VirtualColumnType), intent(inout) :: column + integer, intent(out) :: rc + + ! Local variables for scheme calculation + type(VirtualMetType), pointer :: met => null() ! Pointer to meteorological data + ! Meteorological fields + real(fp), allocatable :: airden_dry(:) + real(fp), allocatable :: mairden(:) + real(fp), allocatable :: pedge(:) + real(fp), allocatable :: pfilsan(:) + real(fp), allocatable :: pfllsan(:) + real(fp), allocatable :: reevapls(:) + real(fp), allocatable :: t(:) + real(fp), allocatable :: tstep(:) + ! Species properties + logical, allocatable :: species_is_aerosol(:) + real(fp), allocatable :: species_henry_cr(:) + real(fp), allocatable :: species_henry_k0(:) + real(fp), allocatable :: species_henry_pKa(:) + real(fp), allocatable :: species_wd_retfactor(:) + logical, allocatable :: species_wd_LiqAndGas(:) + real(fp), allocatable :: species_wd_convfacI2G(:) + real(fp), allocatable :: species_wd_rainouteff(:,:) + real(fp), allocatable :: species_radius(:) + real(fp), allocatable :: species_mw_g(:) + real(fp), allocatable :: species_conc(:,:) + real(fp), allocatable :: species_tendencies(:,:) + integer :: n_species, n_levels, n_chem, n_emis, i, k + integer, allocatable :: species_indices(:) + + rc = CC_SUCCESS + + ! Get dimensions from virtual column + call column%get_dimensions(n_levels, n_chem, n_emis) ! Full column processing + + ! Get wetdep species information from process configuration + n_species = this%process_config%wetdep_config%n_species + if (n_species <= 0) then + return + end if + + ! Get species indices directly from configuration (pre-computed) + allocate(species_indices(n_species)) + species_indices(1:n_species) = this%process_config%wetdep_config%species_indices(1:n_species) + + ! Allocate arrays + allocate(species_conc(n_levels, n_species)) + allocate(species_tendencies(n_levels, n_species)) + ! Allocate meteorological field arrays based on field type and process configuration + allocate(airden_dry(n_levels)) ! Atmospheric field - always n_levels + allocate(mairden(n_levels)) ! Atmospheric field - always n_levels + allocate(pedge(n_levels+1)) ! Edge field - always n_levels+1 + allocate(pfilsan(n_levels+1)) ! Edge field - always n_levels+1 + allocate(pfllsan(n_levels+1)) ! Edge field - always n_levels+1 + allocate(reevapls(n_levels)) ! Atmospheric field - always n_levels + allocate(t(n_levels)) ! Atmospheric field - always n_levels + allocate(tstep(1)) ! Special timestep field - scalar + allocate(species_is_aerosol(n_species)) + allocate(species_henry_cr(n_species)) + allocate(species_henry_k0(n_species)) + allocate(species_henry_pKa(n_species)) + allocate(species_wd_retfactor(n_species)) + allocate(species_wd_LiqAndGas(n_species)) + allocate(species_wd_convfacI2G(n_species)) + allocate(species_wd_rainouteff(n_species, 3)) + allocate(species_radius(n_species)) + allocate(species_mw_g(n_species)) + species_tendencies = 0.0_fp + + ! Get meteorological data pointer from virtual column (VirtualMet pattern) + met => column%get_met() + + ! Now allocate categorical fields using the met pointer dimensions + + ! Extract required fields from met pointer based on field type and processing mode + airden_dry(1:n_levels) = met%AIRDEN_DRY(1:n_levels) ! Atmospheric field - always n_levels + mairden(1:n_levels) = met%MAIRDEN(1:n_levels) ! Atmospheric field - always n_levels + pedge(1:n_levels+1) = met%PEDGE(1:n_levels+1) ! Edge field - always n_levels+1 + pfilsan(1:n_levels+1) = met%PFILSAN(1:n_levels+1) ! Edge field - always n_levels+1 + pfllsan(1:n_levels+1) = met%PFLLSAN(1:n_levels+1) ! Edge field - always n_levels+1 + reevapls(1:n_levels) = met%REEVAPLS(1:n_levels) ! Atmospheric field - always n_levels + t(1:n_levels) = met%T(1:n_levels) ! Atmospheric field - always n_levels + tstep(1) = this%get_timestep() ! Special timestep field - retrieved from ProcessInterface + + ! Get species concentrations from virtual column + ! Full column processing - get concentrations for all levels + do k = 1, n_levels + do i = 1, n_species + species_conc(k, i) = column%get_chem_field(species_indices(i), k) + end do + end do + + ! Get species properties from configuration (pre-loaded during initialization) + ! Use species properties from process configuration + species_is_aerosol(1:n_species) = this%process_config%wetdep_config%species_is_aerosol(1:n_species) + ! Use species properties from process configuration + species_henry_cr(1:n_species) = this%process_config%wetdep_config%species_henry_cr(1:n_species) + ! Use species properties from process configuration + species_henry_k0(1:n_species) = this%process_config%wetdep_config%species_henry_k0(1:n_species) + ! Use species properties from process configuration + species_henry_pKa(1:n_species) = this%process_config%wetdep_config%species_henry_pKa(1:n_species) + ! Use species properties from process configuration + species_wd_retfactor(1:n_species) = this%process_config%wetdep_config%species_wd_retfactor(1:n_species) + ! Use species properties from process configuration + species_wd_LiqAndGas(1:n_species) = this%process_config%wetdep_config%species_wd_LiqAndGas(1:n_species) + ! Use species properties from process configuration + species_wd_convfacI2G(1:n_species) = this%process_config%wetdep_config%species_wd_convfacI2G(1:n_species) + ! Use species properties from process configuration + species_wd_rainouteff(1:n_species, :) = this%process_config%wetdep_config%species_wd_rainouteff(1:n_species, :) + ! Use species properties from process configuration + species_radius(1:n_species) = this%process_config%wetdep_config%species_radius(1:n_species) + ! Use species properties from process configuration + species_mw_g(1:n_species) = this%process_config%wetdep_config%species_mw_g(1:n_species) + + ! Call the science scheme with optional diagnostic parameters + ! Note: jacob uses the following diagnostic fields (if diagnostics enabled): + ! - wetdep_mass_per_species_per_level (Wet deposition mass loss per species per level) + ! - wetdep_flux_per_species_per_level (Wet deposition flux per species per level) + if (this%process_config%wetdep_config%diagnostics) then + ! Call with diagnostic outputs enabled + call compute_jacob( & + n_levels, & + n_species, & + this%process_config%jacob_config, & + airden_dry, & + mairden, & + pedge, & + pfilsan, & + pfllsan, & + reevapls, & + t, & + tstep(1) , & + species_is_aerosol, & + this%process_config%wetdep_config%species_names, & + species_henry_cr, & + species_henry_k0, & + species_henry_pKa, & + species_wd_retfactor, & + species_wd_LiqAndGas, & + species_wd_convfacI2G, & + species_wd_rainouteff, & + species_radius, & + species_mw_g, & + species_conc, & + species_tendencies, & + this%column_wetdep_mass_per_species_per_level, & + this%column_wetdep_flux_per_species_per_level, & + this%process_config%wetdep_config%diagnostic_species_id ) + else + ! Call without diagnostic outputs (optional parameters not passed) + call compute_jacob( & + n_levels, & + n_species, & + this%process_config%jacob_config, & + airden_dry, & + mairden, & + pedge, & + pfilsan, & + pfllsan, & + reevapls, & + t, & + tstep(1) , & + species_is_aerosol, & + this%process_config%wetdep_config%species_names, & + species_henry_cr, & + species_henry_k0, & + species_henry_pKa, & + species_wd_retfactor, & + species_wd_LiqAndGas, & + species_wd_convfacI2G, & + species_wd_rainouteff, & + species_radius, & + species_mw_g, & + species_conc, & + species_tendencies & + ) + end if + + ! Apply tendencies back to virtual column based on tendency_mode + ! Full column processing - apply tendencies to all levels + do k = 1, n_levels + do i = 1, n_species + ! Replacement tendency: new_conc = tendency (tendency is the new value) + call column%set_chem_field(k, species_indices(i), & + species_tendencies(k, i)) + end do + end do + + end subroutine run_jacob_scheme_column + + + + !> Get required meteorological fields for this process + function get_required_met_fields(this) result(field_names) + class(ProcessWetDepInterface), intent(in) :: this + character(len=32), allocatable :: field_names(:) + character(len=32), allocatable :: scheme_fields(:) + character(len=32), allocatable :: process_fields(:) + character(len=32), allocatable :: unique_fields(:) + integer :: total_fields, scheme_count, process_count, i, j, unique_count + logical :: is_duplicate + + ! No process-level required fields + process_count = 0 + allocate(process_fields(0)) + + ! Get scheme-specific fields based on selected scheme + select case (trim(this%process_config%wetdep_config%scheme)) + case ('jacob') + scheme_count = 8 + allocate(scheme_fields(scheme_count)) + scheme_fields(1) = 'T' + scheme_fields(2) = 'TSTEP' + scheme_fields(3) = 'AIRDEN_DRY' + scheme_fields(4) = 'MAIRDEN' + scheme_fields(5) = 'PFLLSAN' + scheme_fields(6) = 'PFILSAN' + scheme_fields(7) = 'PEDGE' + scheme_fields(8) = 'REEVAPLS' + case default + scheme_count = 0 + allocate(scheme_fields(0)) + end select + + ! Combine process-level and scheme-specific fields and remove duplicates + ! First estimate maximum possible size (without duplicates) + total_fields = process_count + scheme_count + allocate(unique_fields(total_fields)) + unique_count = 0 + + ! Add process-level fields first + do i = 1, process_count + unique_count = unique_count + 1 + unique_fields(unique_count) = process_fields(i) + end do + + ! Add scheme-specific fields (check for duplicates) + do i = 1, scheme_count + is_duplicate = .false. + do j = 1, unique_count + if (trim(scheme_fields(i)) == trim(unique_fields(j))) then + is_duplicate = .true. + exit + end if + end do + if (.not. is_duplicate) then + unique_count = unique_count + 1 + unique_fields(unique_count) = scheme_fields(i) + end if + end do + + ! Allocate final result array with exact size + allocate(field_names(unique_count)) + field_names(1:unique_count) = unique_fields(1:unique_count) + + ! Clean up temporary arrays + if (allocated(unique_fields)) deallocate(unique_fields) + if (allocated(process_fields)) deallocate(process_fields) + if (allocated(scheme_fields)) deallocate(scheme_fields) + + end function get_required_met_fields + + !> Get required diagnostic fields for this process + function get_required_diagnostic_fields(this) result(field_names) + class(ProcessWetDepInterface), intent(in) :: this + character(len=64), allocatable :: field_names(:) + + allocate(field_names(2)) + field_names(1) = 'wetdep_mass_per_species_per_level' + field_names(2) = 'wetdep_flux_per_species_per_level' + + end function get_required_diagnostic_fields + + !> Register diagnostic fields with the DiagnosticManager and allocate diagnostic storage + + subroutine register_and_allocate_diagnostics(this, container, rc) + use DiagnosticInterface_Mod, only: DiagnosticRegistryType, DIAG_REAL_2D, DIAG_REAL_3D + + class(ProcessWetDepInterface), intent(inout) :: this + type(StateManagerType), intent(inout) :: container + integer, intent(out) :: rc + + type(DiagnosticManagerType), pointer :: diag_mgr + type(DiagnosticRegistryType), pointer :: registry + type(GridManagerType), pointer :: grid_mgr + character(len=256) :: field_name ! For constructing species-specific field names + integer :: i ! Loop variable for diagnostic species + integer :: nx, ny, nz + integer :: dims_2d(2) + integer :: dims_3d_levels(3) + + rc = CC_SUCCESS + + ! Only register diagnostics if enabled in config + if (.not. this%process_config%wetdep_config%diagnostics) then + return + endif + + ! Get managers + diag_mgr => container%get_diagnostic_manager() + grid_mgr => container%get_grid_manager() + + ! Register this process with diagnostic manager (only once per process) + call diag_mgr%register_process('wetdep', rc) + if (rc /= CC_SUCCESS) return + + ! Get the process registry for registering individual diagnostics + call diag_mgr%get_process_registry('wetdep', registry, rc) + if (rc /= CC_SUCCESS) return + + ! Get grid dimensions + call grid_mgr%get_shape(nx, ny, nz) + dims_2d = [nx, ny] + + dims_3d_levels = [nx, ny, nz] + + ! Register wetdep_mass_per_species_per_level + ! Register individual 3D fields for each diagnostic species (level + species diagnostics) + if (this%process_config%wetdep_config%n_diagnostic_species > 0) then + do i = 1, this%process_config%wetdep_config%n_diagnostic_species + write(field_name, '(A,A,A)') 'wetdep_mass_', & + trim(this%process_config%wetdep_config%diagnostic_species(i)) + call this%register_diagnostic_field(registry, trim(field_name), & + 'Wet deposition mass loss per species per level', & + 'kg/m2', DIAG_REAL_3D, & + 'wetdep', dims_3d_levels, rc=rc) + if (rc /= CC_SUCCESS) return + end do + end if + if (rc /= CC_SUCCESS) return + + ! Register wetdep_flux_per_species_per_level + ! Register individual 3D fields for each diagnostic species (level + species diagnostics) + if (this%process_config%wetdep_config%n_diagnostic_species > 0) then + do i = 1, this%process_config%wetdep_config%n_diagnostic_species + write(field_name, '(A,A,A)') 'wetdep_flux_', & + trim(this%process_config%wetdep_config%diagnostic_species(i)) + call this%register_diagnostic_field(registry, trim(field_name), & + 'Wet deposition flux per species per level', & + 'kg/m2/s', DIAG_REAL_3D, & + 'wetdep', dims_3d_levels, rc=rc) + if (rc /= CC_SUCCESS) return + end do + end if + if (rc /= CC_SUCCESS) return + + ! Get selected scheme(s) + ! Register scheme-specific diagnostics based on selected scheme + select case (trim(this%process_config%wetdep_config%scheme)) + + case ('jacob') + ! Register jacob-specific diagnostics + case default + ! Unknown scheme - only register common diagnostics + ! (already done above) + + end select + + ! Now allocate diagnostic class members after successful registration + ! First, deallocate if already allocated (for scheme switching) + if (allocated(this%column_wetdep_mass_per_species_per_level)) deallocate(this%column_wetdep_mass_per_species_per_level) + if (allocated(this%column_wetdep_flux_per_species_per_level)) deallocate(this%column_wetdep_flux_per_species_per_level) + + ! Allocate and initialize scheme-specific diagnostic fields based on selected scheme + ! For non-gas/aero differentiated process, allocate diagnostics normally + + ! Allocate common diagnostic fields (used by all schemes) + ! 2D diagnostic: levels x diagnostic_species + if (nz > 0 .and. this%process_config%wetdep_config%n_diagnostic_species > 0) then + allocate(this%column_wetdep_mass_per_species_per_level(nz, this%process_config%wetdep_config%n_diagnostic_species)) + end if + if (allocated(this%column_wetdep_mass_per_species_per_level)) this%column_wetdep_mass_per_species_per_level = 0.0_fp + ! 2D diagnostic: levels x diagnostic_species + if (nz > 0 .and. this%process_config%wetdep_config%n_diagnostic_species > 0) then + allocate(this%column_wetdep_flux_per_species_per_level(nz, this%process_config%wetdep_config%n_diagnostic_species)) + end if + if (allocated(this%column_wetdep_flux_per_species_per_level)) this%column_wetdep_flux_per_species_per_level = 0.0_fp + + ! Allocate scheme-specific diagnostics + select case (trim(this%process_config%wetdep_config%scheme)) + case ('jacob') + ! Scheme-specific diagnostics for jacob + case default + ! No scheme-specific diagnostics for unknown schemes + end select + + end subroutine register_and_allocate_diagnostics + + !> Calculate and update all diagnostic fields for this process + !! + !! With the new flexible column-level design, diagnostics are calculated directly by the + !! science schemes for each column and passed to this method for aggregation or output. + !! This approach uses dimension inference to reduce 2D->scalar and 3D->1D for column processing. + subroutine calculate_and_update_diagnostics(this, column, container, rc) + class(ProcessWetDepInterface), intent(inout) :: this + type(VirtualColumnType), intent(in) :: column + type(StateManagerType), intent(inout) :: container + integer, intent(out) :: rc + + integer :: i_col, j_col ! Column grid position + integer :: i ! Loop variable for diagnostic species + character(len=256) :: field_name ! For constructing species-specific field names + + rc = CC_SUCCESS + + ! Skip if diagnostics not enabled + if (.not. this%process_config%wetdep_config%diagnostics) return + + ! Get column grid position (x, y indices) + call column%get_position(i_col, j_col) + + ! Update common diagnostic fields (used by all schemes) + ! Update individual 3D fields for each diagnostic species (level + species diagnostics) + if (this%process_config%wetdep_config%n_diagnostic_species > 0) then + do i = 1, this%process_config%wetdep_config%n_diagnostic_species + write(field_name, '(A,A,A)') 'wetdep_mass_', & + trim(this%process_config%wetdep_config%diagnostic_species(i)) + call this%update_1d_diagnostic_column(trim(field_name), & + this%column_wetdep_mass_per_species_per_level(:,i), & + i_col, j_col, container, rc) + if (rc /= CC_SUCCESS) return + end do + end if + ! Update individual 3D fields for each diagnostic species (level + species diagnostics) + if (this%process_config%wetdep_config%n_diagnostic_species > 0) then + do i = 1, this%process_config%wetdep_config%n_diagnostic_species + write(field_name, '(A,A,A)') 'wetdep_flux_', & + trim(this%process_config%wetdep_config%diagnostic_species(i)) + call this%update_1d_diagnostic_column(trim(field_name), & + this%column_wetdep_flux_per_species_per_level(:,i), & + i_col, j_col, container, rc) + if (rc /= CC_SUCCESS) return + end do + end if + ! Update scheme-specific diagnostic fields based on active scheme + select case (trim(this%process_config%wetdep_config%scheme)) + case ("jacob") + ! Scheme-specific diagnostics for jacob + end select + + end subroutine calculate_and_update_diagnostics + + + !> Set the active scheme (for testing purposes) + !! + !! This method allows tests to override the scheme configuration + !! to test different schemes programmatically. + !! + !! @param[inout] this The ProcessWetDepInterface instance + !! @param[in] scheme_name The scheme name to set + subroutine set_wetdep_scheme(this, scheme_name) + class(ProcessWetDepInterface), intent(inout) :: this + character(len=*), intent(in) :: scheme_name + + this%process_config%wetdep_config%scheme = trim(scheme_name) + + end subroutine set_wetdep_scheme + + !> Get the current active scheme + !! + !! This method allows retrieval of the current scheme for testing + !! and verification purposes. + !! + !! @param[in] this The ProcessWetDepInterface instance + !! @returns The current scheme name + function get_wetdep_scheme(this) result(scheme_name) + class(ProcessWetDepInterface), intent(in) :: this + character(len=64) :: scheme_name + + scheme_name = trim(this%process_config%wetdep_config%scheme) + + end function get_wetdep_scheme + +end module ProcessWetDepInterface_Mod diff --git a/src/process/wetdep/WetDepCommon_Mod.F90 b/src/process/wetdep/WetDepCommon_Mod.F90 new file mode 100644 index 00000000..e7c76bbe --- /dev/null +++ b/src/process/wetdep/WetDepCommon_Mod.F90 @@ -0,0 +1,560 @@ +!> \file WetDepCommon_Mod.F90 +!! \brief Common types and utilities for wetdep process +!! +!! This module defines the configuration types used by the +!! wetdep process and its schemes. +!! +!! Generated on: 2025-12-15T16:30:33.593509 +!! Author: Wei Li +!! Version: 1.0.0 + +module WetDepCommon_Mod + + use precision_mod, only: fp + ! use precision_mod, only: fp + use error_mod, only: CC_SUCCESS, CC_FAILURE, CC_Error, CC_Warning, ErrorManagerType, & + ERROR_INVALID_CONFIG, ERROR_INVALID_STATE, ERROR_NOT_FOUND + use ConfigManager_Mod, only: ConfigManagerType ! ConfigManager integration + use StateManager_Mod, only: StateManagerType ! Add StateManager integration + + implicit none + private + + ! Export types + public :: WetDepProcessConfig ! New unified process config + public :: WetDepConfig + public :: WetDepSchemeJACOBConfig + + ! Export utility functions + public :: int_to_string + + !> Main configuration type for wetdep process + type :: WetDepConfig + + ! Process settings + character(len=32) :: scheme = 'jacob' + logical :: is_active = .true. + logical :: diagnostics = .false. ! Diagnostic switch + + ! Diagnostic species configuration + integer :: n_diagnostic_species = 0 + character(len=32), allocatable :: diagnostic_species(:) ! User-defined species for diagnostics + integer, allocatable :: diagnostic_species_id(:) ! Indices mapping diagnostic_species to species_names + real(fp) :: dt_min = 1.0_fp ! Minimum time step (seconds) + real(fp) :: dt_max = 3600.0_fp ! Maximum time step (seconds) + + ! Species configuration + integer :: n_species = 0 + character(len=32), allocatable :: species_names(:) + integer, allocatable :: species_indices(:) ! Indices of wetdep species in ChemState + + + + ! Species properties + real(fp), allocatable :: species_henry_cr(:) ! henry_cr for each species + real(fp), allocatable :: species_henry_k0(:) ! henry_k0 for each species + real(fp), allocatable :: species_henry_pKa(:) ! henry_pKa for each species + logical, allocatable :: species_is_aerosol(:) ! is_aerosol for each species + real(fp), allocatable :: species_mw_g(:) ! mw_g for each species + real(fp), allocatable :: species_radius(:) ! radius for each species + logical, allocatable :: species_wd_LiqAndGas(:) ! wd_LiqAndGas for each species + real(fp), allocatable :: species_wd_convfacI2G(:) ! wd_convfacI2G for each species + real(fp), allocatable :: species_wd_rainouteff(:,:) ! wd_rainouteff for each species + real(fp), allocatable :: species_wd_retfactor(:) ! wd_retfactor for each species + + ! Diagnostic configuration + logical :: output_diagnostics = .true. + real(fp) :: diagnostic_frequency = 3600.0_fp ! Output frequency (seconds) + + contains + procedure, public :: validate => validate_wetdep_config + procedure, public :: finalize => finalize_wetdep_config + procedure, public :: print_summary => print_wetdep_config_summary + end type WetDepConfig + + !> Configuration type for jacob scheme + type :: WetDepSchemeJACOBConfig + + ! Scheme metadata + character(len=64) :: scheme_name = 'jacob' + character(len=256) :: description = 'Jacob et al. [2000] wet deposition scheme' + character(len=64) :: author = 'Wei Li' + character(len=16) :: algorithm_type = 'explicit' + + ! Process configuration + logical :: affects_full_column = .true. ! Full column processing + + ! Scheme parameters + real(fp) :: scale_factor = 1.0 ! Washout tuning factor + real(fp) :: radius_threshold = 1.0 ! Radius threshold for aerosol wet deposition (um) + + ! Required meteorological fields + integer :: n_required_met_fields = 8 + character(len=32) :: required_met_fields(8) + + contains + procedure, public :: validate => validate_jacob_config + procedure, public :: finalize => finalize_jacob_config + end type WetDepSchemeJACOBConfig + + ! jacob scheme uses local variables only - no persistent state type needed + + + !> Unified process configuration type that bridges ConfigManager and process-specific configs + !! This is the main configuration type that ProcessInterface should use + type :: WetDepProcessConfig + + ! Process metadata + character(len=64) :: process_name = 'wetdep' + character(len=16) :: process_version = '1.0.0' + logical :: is_active = .true. + + ! Process-specific configuration (delegate to WetDepConfig) + type(WetDepConfig) :: wetdep_config + + ! Scheme configurations + type(WetDepSchemeJACOBConfig) :: jacob_config + + contains + procedure, public :: load_from_config => wetdep_process_load_config + procedure, public :: load_species_from_chem_state => load_species_from_chem_state + procedure, public :: validate => wetdep_process_validate + procedure, public :: finalize => wetdep_process_finalize + procedure, public :: get_active_scheme_config => get_active_scheme_config + procedure, public :: load_jacob_config + procedure, public :: map_diagnostic_species_indices + end type WetDepProcessConfig + +contains + + !> Validate wetdep configuration + subroutine validate_wetdep_config(this, error_handler) + class(WetDepConfig), intent(inout) :: this + type(ErrorManagerType), intent(inout) :: error_handler + + character(len=256) :: error_msg + integer :: rc + + ! Validate time step bounds + if (this%dt_min <= 0.0_fp) then + call error_handler%report_error(ERROR_INVALID_CONFIG, & + "Minimum time step must be positive", rc) + return + end if + + if (this%dt_max < this%dt_min) then + call error_handler%report_error(ERROR_INVALID_CONFIG, & + "Maximum time step must be >= minimum time step", rc) + return + end if + + ! Validate active scheme(s) + ! Validate scheme + if (trim(this%scheme) /= 'jacob' .and. & + .true.) then + write(error_msg, '(A)') "Invalid scheme: " // trim(this%scheme) + call error_handler%report_error(ERROR_INVALID_CONFIG, error_msg, rc) + return + end if + + end subroutine validate_wetdep_config + + !> Print configuration summary + subroutine print_wetdep_config_summary(this) + class(WetDepConfig), intent(in) :: this + + write(*, '(A)') "=== WetDep Process Configuration ===" + write(*, '(A,A)') " Active scheme: ", trim(this%scheme) + write(*, '(A,I0)') " Number of species: ", this%n_species + write(*, '(A,F0.1,A)') " Minimum time step: ", this%dt_min, " s" + write(*, '(A,F0.1,A)') " Maximum time step: ", this%dt_max, " s" + write(*, '(A,L1)') " Output diagnostics: ", this%output_diagnostics + write(*, '(A)') "=============================================" + + end subroutine print_wetdep_config_summary + + !> Finalize wetdep configuration + subroutine finalize_wetdep_config(this) + class(WetDepConfig), intent(inout) :: this + + ! Deallocate species names array + if (allocated(this%species_names)) then + deallocate(this%species_names) + end if + + ! Deallocate species indices array + if (allocated(this%species_indices)) then + deallocate(this%species_indices) + end if + + ! Deallocate species properties arrays + if (allocated(this%species_henry_cr)) then + deallocate(this%species_henry_cr) + end if + if (allocated(this%species_henry_k0)) then + deallocate(this%species_henry_k0) + end if + if (allocated(this%species_henry_pKa)) then + deallocate(this%species_henry_pKa) + end if + if (allocated(this%species_is_aerosol)) then + deallocate(this%species_is_aerosol) + end if + if (allocated(this%species_mw_g)) then + deallocate(this%species_mw_g) + end if + if (allocated(this%species_radius)) then + deallocate(this%species_radius) + end if + if (allocated(this%species_wd_LiqAndGas)) then + deallocate(this%species_wd_LiqAndGas) + end if + if (allocated(this%species_wd_convfacI2G)) then + deallocate(this%species_wd_convfacI2G) + end if + if (allocated(this%species_wd_rainouteff)) then + deallocate(this%species_wd_rainouteff) + end if + if (allocated(this%species_wd_retfactor)) then + deallocate(this%species_wd_retfactor) + end if + + + ! Deallocate diagnostic species array + if (allocated(this%diagnostic_species)) then + deallocate(this%diagnostic_species) + end if + + ! Deallocate diagnostic species indices array + if (allocated(this%diagnostic_species_id)) then + deallocate(this%diagnostic_species_id) + end if + + end subroutine finalize_wetdep_config + + !> Validate jacob scheme configuration + subroutine validate_jacob_config(this, error_handler) + class(WetDepSchemeJACOBConfig), intent(inout) :: this + type(ErrorManagerType), intent(inout) :: error_handler + + ! TODO: Add scheme-specific validation + + end subroutine validate_jacob_config + + !> Finalize jacob scheme configuration + subroutine finalize_jacob_config(this) + class(WetDepSchemeJACOBConfig), intent(inout) :: this + + ! Nothing to deallocate for basic configuration + + end subroutine finalize_jacob_config + + + + !> Convert integer to string (utility function) + function int_to_string(int_val) result(str_val) + integer, intent(in) :: int_val + character(len=32) :: str_val + + write(str_val, '(I0)') int_val + str_val = adjustl(str_val) + + end function int_to_string + + !> Load unified process configuration from ConfigManager + !! This is the main function that ProcessInterface.parse_process_config should call + !! Process reads its configuration directly from the master YAML via ConfigManager + subroutine wetdep_process_load_config(this, config_manager, error_handler) + class(WetDepProcessConfig), intent(inout) :: this + type(ConfigManagerType), intent(inout) :: config_manager + type(ErrorManagerType), intent(inout) :: error_handler + + character(len=256) :: scheme_name + integer :: ierr, rc + + ! Process reads directly from master YAML structure: processes.wetdep + ! ConfigManager provides generic YAML access, process handles its own configuration + + ! Load process metadata + call config_manager%get_string("processes/wetdep/name", this%process_name, rc, "wetdep") + if (rc /= CC_SUCCESS) this%process_name = "wetdep" ! default + + call config_manager%get_string("processes/wetdep/version", this%process_version, rc, "1.0.0") + if (rc /= CC_SUCCESS) this%process_version = "1.0.0" ! default + + call config_manager%get_logical("processes/wetdep/activate", this%is_active, rc, .true.) + if (rc /= CC_SUCCESS) this%is_active = .true. ! default + + ! Load process-specific configuration directly from master YAML + call config_manager%get_string("processes/wetdep/scheme", this%wetdep_config%scheme, rc, "jacob") + if (rc /= CC_SUCCESS) then + call error_handler%report_error(ERROR_INVALID_CONFIG, & + "Missing required 'scheme' in processes/wetdep configuration", rc) + return + end if + + ! Load diagnostic switch + call config_manager%get_logical("processes/wetdep/diagnostics", this%wetdep_config%diagnostics, rc, .false.) + if (rc /= CC_SUCCESS) this%wetdep_config%diagnostics = .false. ! Default + + ! Load diagnostic species list + call config_manager%get_array("processes/wetdep/diag_species", this%wetdep_config%diagnostic_species, & + rc, default_values=["All"]) + if (rc /= CC_SUCCESS) then + ! Default to all species if not specified + allocate(this%wetdep_config%diagnostic_species(1)) + this%wetdep_config%diagnostic_species(1) = "All" + this%wetdep_config%n_diagnostic_species = 1 + else + ! Set the count based on the returned array size + if (allocated(this%wetdep_config%diagnostic_species)) then + this%wetdep_config%n_diagnostic_species = size(this%wetdep_config%diagnostic_species) + else + this%wetdep_config%n_diagnostic_species = 0 + end if + end if + + ! Species configuration is loaded from ChemState in load_species_from_chem_state + ! The species come from the master species YAML file (CATChem_species.yml) + ! and are filtered by is_wetdep property + + + ! Load scheme-specific configuration from master YAML + scheme_name = trim(this%wetdep_config%scheme) + select case (scheme_name) + case ('jacob') + call this%load_jacob_config(config_manager, error_handler) + case default + call error_handler%report_error(ERROR_INVALID_STATE, & + "Unknown wetdep scheme: " // trim(scheme_name), rc) + return + end select + + end subroutine wetdep_process_load_config + + + !> Load species from ChemState + !! This function is used for dynamic species discovery (by_metadata or all_species) + !! For 'all_species' mode: loads all species using nSpecies and SpeciesIndex + !! For 'by_metadata' mode: loads species by type using nSpeciesWetDep and WetDepIndex + subroutine load_species_from_chem_state(this, chem_state, error_handler) + use ChemState_Mod, only: ChemStateType + + class(WetDepProcessConfig), intent(inout) :: this + type(ChemStateType), pointer, intent(in) :: chem_state + type(ErrorManagerType), intent(inout) :: error_handler + + integer :: i, rc + integer :: species_idx + + if (.not. associated(chem_state)) then + call error_handler%report_error(ERROR_INVALID_STATE, & + "ChemState not associated in load_species_from_chem_state", rc) + return + end if + + ! by_metadata mode: Load species by type from ChemState using dynamic metadata flag mapping + ! Dynamic mapping: is_wetdep -> nSpeciesWetdep and WetdepIndex + this%wetdep_config%n_species = chem_state%nSpeciesWetdep + + if (this%wetdep_config%n_species <= 0) then + call error_handler%report_error(ERROR_INVALID_STATE, & + "No wetdep species found in ChemState", rc) + return + end if + + ! Check if WetdepIndex is allocated and has correct size + if (.not. allocated(chem_state%WetdepIndex)) then + call error_handler%report_error(ERROR_INVALID_STATE, & + "WetdepIndex not allocated in ChemState", rc) + return + end if + + if (size(chem_state%WetdepIndex) < this%wetdep_config%n_species) then + call error_handler%report_error(ERROR_INVALID_STATE, & + "WetdepIndex size inconsistent with nSpeciesWetdep", rc) + return + end if + + ! Deallocate existing arrays if allocated + if (allocated(this%wetdep_config%species_names)) then + deallocate(this%wetdep_config%species_names) + end if + if (allocated(this%wetdep_config%species_indices)) then + deallocate(this%wetdep_config%species_indices) + end if + + ! Allocate arrays + allocate(this%wetdep_config%species_names(this%wetdep_config%n_species)) + allocate(this%wetdep_config%species_indices(this%wetdep_config%n_species)) + + ! Allocate species properties arrays + allocate(this%wetdep_config%species_henry_cr(this%wetdep_config%n_species)) + allocate(this%wetdep_config%species_henry_k0(this%wetdep_config%n_species)) + allocate(this%wetdep_config%species_henry_pKa(this%wetdep_config%n_species)) + allocate(this%wetdep_config%species_is_aerosol(this%wetdep_config%n_species)) + allocate(this%wetdep_config%species_mw_g(this%wetdep_config%n_species)) + allocate(this%wetdep_config%species_radius(this%wetdep_config%n_species)) + allocate(this%wetdep_config%species_wd_LiqAndGas(this%wetdep_config%n_species)) + allocate(this%wetdep_config%species_wd_convfacI2G(this%wetdep_config%n_species)) + allocate(this%wetdep_config%species_wd_rainouteff(this%wetdep_config%n_species, 3)) + allocate(this%wetdep_config%species_wd_retfactor(this%wetdep_config%n_species)) + + ! by_metadata mode: Copy indices from metadata-specific index array using dynamic mapping + ! Dynamic mapping: is_wetdep -> WetdepIndex + this%wetdep_config%species_indices(1:this%wetdep_config%n_species) = & + chem_state%WetdepIndex(1:this%wetdep_config%n_species) + + ! Get species names using the indices + do i = 1, this%wetdep_config%n_species + if (this%wetdep_config%species_indices(i) > 0 .and. & + this%wetdep_config%species_indices(i) <= size(chem_state%SpeciesNames)) then + this%wetdep_config%species_names(i) = & + trim(chem_state%SpeciesNames(this%wetdep_config%species_indices(i))) + else + call error_handler%report_error(ERROR_INVALID_STATE, & + "Invalid species index in species index array", rc) + return + end if + end do + + ! Load species properties from ChemState + do i = 1, this%wetdep_config%n_species + species_idx = this%wetdep_config%species_indices(i) + this%wetdep_config%species_henry_cr(i) = chem_state%ChemSpecies(species_idx)%henry_cr + this%wetdep_config%species_henry_k0(i) = chem_state%ChemSpecies(species_idx)%henry_k0 + this%wetdep_config%species_henry_pKa(i) = chem_state%ChemSpecies(species_idx)%henry_pKa + this%wetdep_config%species_is_aerosol(i) = chem_state%ChemSpecies(species_idx)%is_aerosol + this%wetdep_config%species_mw_g(i) = chem_state%ChemSpecies(species_idx)%mw_g + this%wetdep_config%species_radius(i) = chem_state%ChemSpecies(species_idx)%radius + this%wetdep_config%species_wd_LiqAndGas(i) = chem_state%ChemSpecies(species_idx)%wd_LiqAndGas + this%wetdep_config%species_wd_convfacI2G(i) = chem_state%ChemSpecies(species_idx)%wd_convfacI2G + this%wetdep_config%species_wd_rainouteff(i, :) = chem_state%ChemSpecies(species_idx)%wd_rainouteff(:) + this%wetdep_config%species_wd_retfactor(i) = chem_state%ChemSpecies(species_idx)%wd_retfactor + end do + + end subroutine load_species_from_chem_state + + + !> Load jacob scheme configuration from master YAML + subroutine load_jacob_config(this, config_manager, error_handler) + class(WetDepProcessConfig), intent(inout) :: this + type(ConfigManagerType), intent(inout) :: config_manager + type(ErrorManagerType), intent(inout) :: error_handler + + integer :: ierr, rc + + ! Load scheme parameters directly from processes/wetdep/jacob/ in master YAML + call config_manager%get_real("processes/wetdep/jacob/scale_factor", & + this%jacob_config%scale_factor, rc, 1.0_fp) + if (rc /= CC_SUCCESS) this%jacob_config%scale_factor = 1.0_fp + call config_manager%get_real("processes/wetdep/jacob/radius_threshold", & + this%jacob_config%radius_threshold, rc, 1.0_fp) + if (rc /= CC_SUCCESS) this%jacob_config%radius_threshold = 1.0_fp + + + end subroutine load_jacob_config + + + !> Validate unified process configuration + subroutine wetdep_process_validate(this, state_manager, error_handler) + class(WetDepProcessConfig), intent(inout) :: this + type(StateManagerType), intent(in) :: state_manager + type(ErrorManagerType), intent(inout) :: error_handler + + ! Validate main config + call this%wetdep_config%validate(error_handler) + + ! Validate scheme-specific config + select case (trim(this%wetdep_config%scheme)) + case ('jacob') + call this%jacob_config%validate(error_handler) + end select + + end subroutine wetdep_process_validate + + !> Finalize unified process configuration + subroutine wetdep_process_finalize(this) + class(WetDepProcessConfig), intent(inout) :: this + + call this%wetdep_config%finalize() + call this%jacob_config%finalize() + + end subroutine wetdep_process_finalize + + !> Get active scheme configuration (polymorphic return) + function get_active_scheme_config(this) result(scheme_config) + class(WetDepProcessConfig), intent(in) :: this + class(*), allocatable :: scheme_config + + select case (trim(this%wetdep_config%scheme)) + case ('jacob') + allocate(scheme_config, source=this%jacob_config) + case default + ! Return null + end select + + end function get_active_scheme_config + + !> Map diagnostic species names to indices in the species_names array + !! This function creates the diagnostic_species_id array that maps each diagnostic species + !! to its corresponding index in the full species_names array + subroutine map_diagnostic_species_indices(this, error_handler) + class(WetDepProcessConfig), intent(inout) :: this + type(ErrorManagerType), intent(inout) :: error_handler + + integer :: i, j, rc + character(len=256) :: error_msg + logical :: found_species + + ! Only proceed if diagnostic species are defined + if (this%wetdep_config%n_diagnostic_species == 0) return + + ! Handle "All" case - map all available species + if (this%wetdep_config%n_diagnostic_species == 1 .and. & + trim(this%wetdep_config%diagnostic_species(1)) == "All") then + + ! Deallocate and reallocate for all species + if (allocated(this%wetdep_config%diagnostic_species_id)) deallocate(this%wetdep_config%diagnostic_species_id) + allocate(this%wetdep_config%diagnostic_species_id(this%wetdep_config%n_species)) + if (allocated(this%wetdep_config%diagnostic_species)) deallocate(this%wetdep_config%diagnostic_species) + allocate(this%wetdep_config%diagnostic_species(this%wetdep_config%n_species)) + this%wetdep_config%n_diagnostic_species = this%wetdep_config%n_species + this%wetdep_config%diagnostic_species = this%wetdep_config%species_names + + ! Map all species indices (1:n_species) + do i = 1, this%wetdep_config%n_species + this%wetdep_config%diagnostic_species_id(i) = i + end do + + return + end if + + ! Allocate diagnostic species indices array + if (allocated(this%wetdep_config%diagnostic_species_id)) deallocate(this%wetdep_config%diagnostic_species_id) + allocate(this%wetdep_config%diagnostic_species_id(this%wetdep_config%n_diagnostic_species)) + + ! Map each diagnostic species name to its index in species_names + do i = 1, this%wetdep_config%n_diagnostic_species + found_species = .false. + + do j = 1, this%wetdep_config%n_species + if (trim(this%wetdep_config%diagnostic_species(i)) == trim(this%wetdep_config%species_names(j))) then + this%wetdep_config%diagnostic_species_id(i) = j + found_species = .true. + exit + end if + end do + + if (.not. found_species) then + write(error_msg, '(A,A,A)') "Diagnostic species '", & + trim(this%wetdep_config%diagnostic_species(i)), & + "' not found in process species list" + call error_handler%report_error(ERROR_NOT_FOUND, error_msg, rc) + return + end if + end do + + end subroutine map_diagnostic_species_indices + +end module WetDepCommon_Mod diff --git a/src/process/wetdep/WetDepProcessCreator_Mod.F90 b/src/process/wetdep/WetDepProcessCreator_Mod.F90 new file mode 100644 index 00000000..21e16bf1 --- /dev/null +++ b/src/process/wetdep/WetDepProcessCreator_Mod.F90 @@ -0,0 +1,115 @@ +!> \file WetDepProcessCreator_Mod.F90 +!! \brief Factory for creating wetdep process instances +!! +!! This module provides the factory functions for creating wetdep +!! process instances following the CATChem Process Factory pattern. +!! +!! Generated on: 2025-12-15T16:30:33.627354 +!! Author: Wei Li +!! Version: 1.0.0 + +module WetDepProcessCreator_Mod + + use precision_mod, only: fp + use error_mod, only: CC_SUCCESS, CC_FAILURE, CC_Error, CC_Warning, ErrorManagerType + use ProcessInterface_Mod + use ProcessWetDepInterface_Mod + + implicit none + private + + public :: create_wetdep_process + public :: register_wetdep_process + public :: get_wetdep_default_config + +contains + + !> Create a new wetdep process instance + !! + !! This factory function creates and returns a new instance of the + !! wetdep process. The process is not initialized - the caller + !! must call the init() method with appropriate configuration. + !! + !! @param[out] process Allocated process instance + !! @param[out] rc Return code + subroutine create_wetdep_process(process, rc) + class(ProcessInterface), allocatable, intent(out) :: process + integer, intent(out) :: rc + + type(ProcessWetDepInterface), allocatable :: wetdep_process + integer :: alloc_stat + + rc = CC_SUCCESS + + ! Allocate the process instance + allocate(wetdep_process, stat=alloc_stat) + if (alloc_stat /= 0) then + rc = CC_FAILURE + return + end if + + ! Move to polymorphic variable + call move_alloc(wetdep_process, process) + + end subroutine create_wetdep_process + + !> Register the wetdep process with a ProcessManager + !! + !! This subroutine registers the wetdep process with a ProcessManager's + !! factory. This is the correct way to register processes for use in + !! applications and integration tests. + !! + !! @param[inout] process_mgr The ProcessManager to register with + !! @param[out] rc Return code + subroutine register_wetdep_process(process_mgr, rc) + use ProcessManager_Mod, only: ProcessManagerType + + type(ProcessManagerType), intent(inout) :: process_mgr + integer, intent(out) :: rc + + rc = CC_SUCCESS + + call process_mgr%register_process( & + name='wetdep', & + category='deposition', & + description='Process for computing wet deposition of gas and aerosol species', & + creator=create_wetdep_process, & + rc=rc & + ) + + end subroutine register_wetdep_process + + !> Get default configuration for wetdep process + !! + !! This function returns a default configuration string that can be + !! used to initialize the wetdep process with reasonable defaults. + !! + !! @param[out] config_data Default configuration string + subroutine get_wetdep_default_config(config_data) + character(len=*), intent(out) :: config_data + + ! Return default YAML configuration + config_data = & + '# Default wetdep process configuration' // new_line('A') // & + 'process:' // new_line('A') // & + ' name: "wetdep"' // new_line('A') // & + ' version: "1.0.0"' // new_line('A') // & + ' active_scheme: ""' // new_line('A') // & + ' is_active: true' // new_line('A') // & + '' // new_line('A') // & + '# Scheme configuration' // new_line('A') // & + 'schemes:' // new_line('A') // & + ' jacob:' // new_line('A') // & + ' description: "Jacob et al. [2000] wet deposition scheme"' // new_line('A') // & + ' algorithm_type: "explicit"' // new_line('A') // & + ' parameters:' // new_line('A') // & + ' scale_factor: 1.0' // new_line('A') // & + '' // new_line('A') // & + '# Diagnostic configuration' // new_line('A') // & + 'diagnostics:' // new_line('A') // & + ' output_frequency: 3600.0 # seconds' // new_line('A') // & + ' output_diagnostics: true' + + end subroutine get_wetdep_default_config + +end module WetDepProcessCreator_Mod diff --git a/src/process/wetdep/examples/wetdep_config.yaml b/src/process/wetdep/examples/wetdep_config.yaml new file mode 100644 index 00000000..83041845 --- /dev/null +++ b/src/process/wetdep/examples/wetdep_config.yaml @@ -0,0 +1,100 @@ +# Example configuration for wetdep process +# Generated on: 2025-12-15T16:30:33.974401 +# Author: Wei Li + +process: + name: "wetdep" + version: "1.0.0" + description: "Process for computing wet deposition of gas and aerosol species" + active_scheme: "" + is_active: true + + # Time stepping configuration + dt_min: 1.0 # Minimum time step (seconds) + dt_max: 3600.0 # Maximum time step (seconds) + + + + +# Scheme configurations +schemes: + jacob: + description: "Jacob et al. [2000] wet deposition scheme" + author: "Wei Li" + algorithm_type: "explicit" + + # Scheme-specific parameters + parameters: + scale_factor: 1.0 # Washout tuning factor + radius_threshold: 1.0 # Radius threshold for aerosol wet deposition (um) + + # Required meteorological fields for this scheme + required_met_fields: + - "T" + - "TSTEP" + - "AIRDEN_DRY" + - "MAIRDEN" + - "PFLLSAN" + - "PFILSAN" + - "PEDGE" + - "REEVAPLS" + + # Scheme-specific diagnostic configuration + diagnostics: + + +# Diagnostic configuration +diagnostics: + # Global diagnostic settings + output_frequency: 3600.0 # seconds + output_diagnostics: true + + # Individual diagnostic controls + wetdep_mass_per_species_per_level: + description: "Wet deposition mass loss per species per level" + units: "kg/m2" + output: true + wetdep_flux_per_species_per_level: + description: "Wet deposition flux per species per level" + units: "kg/m2/s" + output: true + + +# Performance and optimization settings +performance: + parallelization: "column" + memory_optimization: "low" + vectorization: true + + +# Input/output configuration +io: + # Input data sources + input_data: + + # Output configuration + output_data: + base_directory: "/path/to/output" + file_prefix: "wetdep_" + compression: true + +# Quality control and validation +quality_control: + enable_bounds_checking: true + enable_conservation_checks: false + enable_mass_balance_checks: false + + # Value limits + limits: + +# Debugging and logging +debug: + level: "info" # debug, info, warning, error + output_file: "wetdep_debug.log" + flush_frequency: 100 # Flush log every N time steps + + # Debug-specific outputs + debug_outputs: + intermediate_variables: false + conservation_diagnostics: false + timing_information: true diff --git a/src/process/wetdep/examples/wetdep_example.F90 b/src/process/wetdep/examples/wetdep_example.F90 new file mode 100644 index 00000000..19a8f017 --- /dev/null +++ b/src/process/wetdep/examples/wetdep_example.F90 @@ -0,0 +1,327 @@ +!> \file wetdep_example.F90 +!! \brief Example usage of wetdep process +!! +!! This program demonstrates how to use the wetdep process +!! in a standalone application or host model integration. +!! +!! Generated on: 2025-12-15T16:30:33.952593 +!! Author: Wei Li + +program wetdep_example + + use precision_mod, only: fp + use iso_fortran_env, only: output_unit, error_unit + use precision_mod, only: fp + use Error_Mod, only: CC_SUCCESS, CC_FAILURE + use ProcessInterface_Mod + use ProcessWetDepInterface_Mod + use WetDepCommon_Mod + use WetDepProcessCreator_Mod + use StateManager_Mod + + implicit none + + ! Process and state management + class(ProcessInterface), allocatable :: process + type(StateManagerType) :: state_manager + integer :: rc + + ! Configuration + character(len=256) :: config_file = "wetdep_config.yaml" + + ! Simulation parameters + integer, parameter :: n_columns = 10 + integer, parameter :: n_levels = 50 + integer, parameter :: n_time_steps = 24 + real(fp), parameter :: dt = 3600.0_fp ! 1 hour time step + + ! Working variables + integer :: i_time, i_col + real(fp) :: total_time + + write(output_unit, '(A)') "=== WetDep Process Example ===" + write(output_unit, '(A)') "Process for computing wet deposition of gas and aerosol species" + write(output_unit, '(A)') "Author: Wei Li" + write(output_unit, '(A)') "" + + ! Step 1: Initialize state manager + call state_manager%init(n_levels, n_columns, 1, rc) + if (rc /= CC_SUCCESS) then + write(error_unit, *) 'ERROR: Failed to initialize state manager' + stop 1 + end if + + ! Step 2: Create process instance + call create_process(process, rc) + if (rc /= CC_SUCCESS) then + write(error_unit, *) 'ERROR: Failed to create process' + stop 1 + end if + + ! Step 3: Initialize process + call process%init(state_manager, rc) + if (rc /= CC_SUCCESS) then + write(error_unit, *) 'ERROR: Process initialization failed' + stop 1 + end if + + write(output_unit, '(A)') "Process initialized successfully" + + ! Step 4: Time loop simulation + write(output_unit, '(A,I0,A)') "Starting ", n_time_steps, " time step simulation" + + do i_time = 1, n_time_steps + total_time = real(i_time - 1, fp) * dt + + write(output_unit, '(A,I0,A,F8.1,A)') "Time step ", i_time, " (t=", total_time/3600.0_fp, " hours)" + + ! Run process for this time step + call process%run(state_manager, rc) + if (rc /= CC_SUCCESS) then + write(error_unit, *) 'ERROR: Process execution failed at time step ', i_time + stop 1 + end if + end do + + write(output_unit, '(A)') "Simulation completed successfully" + + ! Step 5: Finalize process + call process%finalize(rc) + if (rc /= CC_SUCCESS) then + write(error_unit, *) 'ERROR: Process finalization failed' + stop 1 + end if + + write(output_unit, '(A)') "Process finalized successfully" + write(output_unit, '(A)') "Example completed!" + +end program wetdep_example +write(error_unit, '(A)') "Error creating wetdep process" +call error_handler%print_errors() +stop 1 +end if +write(output_unit, '(A)') "5. WetDep process created" + + ! Step 6: Load configuration +call load_configuration(config_data, error_handler) +if (error_handler%has_error()) then + write(error_unit, '(A)') "Error loading configuration" + call error_handler%print_errors() + stop 1 +end if +write(output_unit, '(A)') "6. Configuration loaded" + + ! Step 7: Initialize process +call process%init(state_manager, config_data, error_handler) +if (error_handler%has_error()) then + write(error_unit, '(A)') "Error initializing wetdep process" + call error_handler%print_errors() + stop 1 +end if +write(output_unit, '(A)') "7. WetDep process initialized" + + ! Step 8: Print process information +call print_process_info(process) + + ! Step 9: Set up initial conditions +call setup_initial_conditions(state_manager, error_handler) +if (error_handler%has_error()) then + write(error_unit, '(A)') "Error setting up initial conditions" + call error_handler%print_errors() + stop 1 +end if +write(output_unit, '(A)') "8. Initial conditions set" + + ! Step 10: Time integration loop +write(output_unit, '(A)') "9. Starting time integration..." +write(output_unit, '(A,I0,A,F0.1,A)') " Running ", n_time_steps, & + " time steps with dt = ", dt, " seconds" + +total_time = 0.0_fp +do i_time = 1, n_time_steps + + ! Run process for one time step + call process%run(state_manager, dt, error_handler) + if (error_handler%has_error()) then + write(error_unit, '(A,I0)') "Error during time step ", i_time + call error_handler%print_errors() + exit + end if + + total_time = total_time + dt + + ! Print progress + if (mod(i_time, max(n_time_steps/10, 1)) == 0) then + write(output_unit, '(A,I0,A,I0,A,F0.1,A)') " Step ", i_time, & + "/", n_time_steps, " (t = ", total_time/3600.0_fp, " hours)" + end if + +end do + +if (.not. error_handler%has_error()) then + write(output_unit, '(A)') "10. Time integration completed successfully" +end if + + ! Step 11: Print diagnostic summary +diag_mgr => state_manager%get_diagnostic_manager() +call print_diagnostic_summary(diag_mgr) + + ! Step 12: Clean up +call process%finalize(error_handler) +call state_manager%finalize(error_handler) + +write(output_unit, '(A)') "11. Cleanup completed" +write(output_unit, '(A)') "" +write(output_unit, '(A)') "=== Example completed successfully ===" + +contains + + !> Set up chemical species in state manager +subroutine setup_chemical_species(state_manager, error_handler) + type(StateManagerType), intent(inout) :: state_manager + type(ErrorHandler), intent(inout) :: error_handler + + ! Add generic species + call state_manager%add_species('GENERIC_SPECIES', error_handler) + + ! Initialize species concentrations + call state_manager%allocate_species_arrays(error_handler) + +end subroutine setup_chemical_species + + !> Set up meteorological fields +subroutine setup_meteorological_fields(state_manager, error_handler) + type(StateManagerType), intent(inout) :: state_manager + type(ErrorHandler), intent(inout) :: error_handler + + ! Add required meteorological fields + + ! Add optional meteorological fields + + ! Initialize meteorological data with test values + call initialize_test_meteorology(state_manager, error_handler) + +end subroutine setup_meteorological_fields + + !> Initialize test meteorological data +subroutine initialize_test_meteorology(state_manager, error_handler) + type(StateManagerType), intent(inout) :: state_manager + type(ErrorHandler), intent(inout) :: error_handler + + integer :: i_col, i_lev + real(fp) :: height, latitude, longitude + + ! Set test meteorological values + do i_col = 1, n_columns + do i_lev = 1, n_levels + + height = real(i_lev - 1, fp) * 1000.0_fp ! Height in meters + latitude = 45.0_fp + real(i_col - 1, fp) * 1.0_fp ! Latitude + longitude = -120.0_fp + real(i_col - 1, fp) * 1.0_fp ! Longitude + + + end do + end do + +end subroutine initialize_test_meteorology + + !> Load process configuration +subroutine load_configuration(config_data, error_handler) + character(len=*), intent(out) :: config_data + type(ErrorHandler), intent(inout) :: error_handler + + ! For this example, use inline configuration + ! In practice, this would be loaded from a file + config_data = & + 'process:' // new_line('A') // & + ' name: "wetdep"' // new_line('A') // & + ' version: "1.0.0"' // new_line('A') // & + ' active_scheme: ""' // new_line('A') // & + ' is_active: true' // new_line('A') // & + 'diagnostics:' // new_line('A') // & + ' output_frequency: 3600.0' // new_line('A') // & + ' output_diagnostics: true' + +end subroutine load_configuration + + !> Set up initial conditions +subroutine setup_initial_conditions(state_manager, error_handler) + type(StateManagerType), intent(inout) :: state_manager + type(ErrorHandler), intent(inout) :: error_handler + + integer :: i_col, i_lev, i_spec + real(fp) :: initial_concentration + + ! Set initial chemical concentrations + +end subroutine setup_initial_conditions + + !> Print process information +subroutine print_process_info(process) + class(ProcessInterface), intent(in) :: process + + character(len=32), allocatable :: species_list(:) + character(len=32), allocatable :: required_fields(:) + integer :: i + + write(output_unit, '(A)') "" + write(output_unit, '(A)') "Process Information:" + write(output_unit, '(A,A)') " Name: ", trim(process%get_name()) + write(output_unit, '(A,A)') " Version: ", trim(process%get_version()) + write(output_unit, '(A,A)') " Description: ", trim(process%get_description()) + + ! Print species list + species_list = process%get_species_list() + write(output_unit, '(A,I0)') " Number of species: ", size(species_list) + if (size(species_list) > 0) then + write(output_unit, '(A)', advance='no') " Species: " + do i = 1, size(species_list) + write(output_unit, '(A)', advance='no') trim(species_list(i)) + if (i < size(species_list)) write(output_unit, '(A)', advance='no') ", " + end do + write(output_unit, '(A)') "" + end if + + ! Print required fields + required_fields = process%get_required_met_fields() + write(output_unit, '(A,I0)') " Required met fields: ", size(required_fields) + if (size(required_fields) > 0) then + do i = 1, size(required_fields) + write(output_unit, '(A,A)') " - ", trim(required_fields(i)) + end do + end if + write(output_unit, '(A)') "" + +end subroutine print_process_info + + !> Print diagnostic summary +subroutine print_diagnostic_summary(diag_mgr) + type(DiagnosticManager), intent(in) :: diag_mgr + + integer :: n_diagnostics, i + character(len=64), allocatable :: diag_names(:) + real(fp), allocatable :: diag_values(:) + + write(output_unit, '(A)') "" + write(output_unit, '(A)') "Diagnostic Summary:" + + n_diagnostics = diag_mgr%get_n_diagnostics() + write(output_unit, '(A,I0)') " Number of diagnostics: ", n_diagnostics + + if (n_diagnostics > 0) then + allocate(diag_names(n_diagnostics)) + allocate(diag_values(n_diagnostics)) + + call diag_mgr%get_diagnostic_names(diag_names) + call diag_mgr%get_diagnostic_values(diag_values) + + do i = 1, n_diagnostics + write(output_unit, '(A,A,A,ES12.4)') " ", & + trim(diag_names(i)), ": ", diag_values(i) + end do + end if + write(output_unit, '(A)') "" + +end subroutine print_diagnostic_summary + +end program wetdep_example diff --git a/src/process/wetdep/schemes/CMakeLists.txt b/src/process/wetdep/schemes/CMakeLists.txt new file mode 100644 index 00000000..f88631c5 --- /dev/null +++ b/src/process/wetdep/schemes/CMakeLists.txt @@ -0,0 +1,35 @@ +# WetDep Schemes CMakeLists.txt +# Generated on: 2025-12-15T16:30:33.761046 + +# This file is included by the parent CMakeLists.txt +# Schemes are built as part of the main process library + +# Scheme source files are defined in the parent CMakeLists.txt: +# - WetDepScheme_JACOB_Mod.F90 + +# Scheme-specific configurations can be added here if needed + +# JACOB scheme configuration +# Required meteorological fields for JACOB: +# - T +# - TSTEP +# - AIRDEN_DRY +# - MAIRDEN +# - PFLLSAN +# - PFILSAN +# - PEDGE +# - REEVAPLS + +# Scheme validation targets +add_custom_target( + validate_jacob_scheme + COMMAND ${CMAKE_COMMAND} -E echo "Validating jacob scheme implementation" + COMMENT "Validating jacob scheme" +) + +# Combined validation target +add_custom_target( + validate_all_schemes + DEPENDS validate_jacob_scheme + COMMENT "Validating all wetdep schemes" +) diff --git a/src/process/wetdep/schemes/WetDepScheme_JACOB_Mod.F90 b/src/process/wetdep/schemes/WetDepScheme_JACOB_Mod.F90 new file mode 100644 index 00000000..8e6ca297 --- /dev/null +++ b/src/process/wetdep/schemes/WetDepScheme_JACOB_Mod.F90 @@ -0,0 +1,1178 @@ +!> \file WetDepScheme_JACOB_Mod.F90 +!! \brief Jacob et al. [2000] wet deposition scheme +!! +!! Pure science kernel for jacob scheme in wetdep process. +!! This module contains ONLY the computational algorithm with NO infrastructure dependencies. +!! Uses only basic Fortran types for maximum portability and reusability. +!! +!! SCIENCE CUSTOMIZATION GUIDE: +!! 1. Modify the algorithm in compute_jacob (search for "TODO") +!! 2. Add scheme-specific helper subroutines as needed +!! 3. Update physical constants for your scheme +!! 4. Customize the environmental response functions +!! +!! INFRASTRUCTURE RESPONSIBILITIES (handled by host model): +!! - Parameter initialization and validation +!! - Input array validation and error handling +!! - Memory management and array allocation +!! - Integration with host model time stepping +!! +!! Generated on: 2025-11-25T14:47:14.566559 +!! Author: Wei Li +!! (1) Jacob, D. J., Liu, H., Mari, C., and Yantosca, B. M., Harvard wet deposition scheme for GMI, +!! available at: http://acmg.seas.harvard.edu/geos/wiki_docs/deposition/wetdep.jacob_etal_2000.pdf +!! (2) GEOS-Chem's source codes in the module file of wetscav_mod.F90 and reference therein. +!! (https://github.com/geoschem/geos-chem/blob/main/GeosCore/wetscav_mod.F90) +!! (3) The above scheme was also adopted in GOCART2G_process.F90 for aerosols, which is shorter and cleaner. +!! https://github.com/GEOS-ESM/GOCART/blob/develop/Process_Library/GOCART2G_Process.F90#L3525-L4115 +!! +module WetDepScheme_JACOB_Mod + + use precision_mod, only: fp, zero, one, rae, TINY_ + use error_mod, only: CC_Warning, CC_SUCCESS !CC_Error + use WetDepCommon_Mod, only: WetDepSchemeJACOBConfig + use Constants, only: g0, AIRMW !load the constants needed for this scheme + + implicit none + private + + ! Public interface - pure science only + public :: compute_jacob + + ! -- local parameters + real(fp), parameter :: density_ice = 917.0_fp ! density of ice in kg m-3 + real(fp), parameter :: density_liq = 1.e+03_fp ! density of liquid water in kg m-3 + real(fp), parameter :: m_to_cm = 100.0_fp ! conversion factor from m to cm + real(fp), parameter :: kg_to_cm3_liq = m_to_cm / density_liq ! conversion factor from kg to cm3 for liquid water + real(fp), parameter :: kg_to_cm3_ice = m_to_cm / density_ice ! conversion factor from kg to cm3 for ice + real(fp), parameter :: qq_thr = 0.0_fp ! cm3 (h2o) / cm3 (air) / s + real(fp), parameter :: pdwn_thr = 0.0_fp ! cm3 (h2o) / cm2 (air) / s + real(fp), parameter :: k_min = 1.e-04_fp ! s-1 + real(fp), parameter :: cwc = 1.e-06_fp ! s-1 (recommended by Qiaoqiao Wang et al., 2014. Originally 1.5e-6, see Jacob et al., 2000) + + +contains + + !> Pure science computation for jacob scheme + !! + !! This is a pure computational kernel implementing Jacob et al. [2000] wet deposition scheme. + !! NO error checking, validation, or infrastructure concerns. + !! Host model must ensure all inputs are valid before calling. + !! + !! @param[in] num_layers Number of vertical layers + !! @param[in] num_species Number of chemical species + !! @param[in] params Scheme parameters (pre-validated by host) + !! @param[in] airden_dry AIRDEN_DRY field [appropriate units] + !! @param[in] mairden MAIRDEN field [appropriate units] + !! @param[in] pedge PEDGE field [appropriate units] + !! @param[in] pfilsan PFILSAN field [appropriate units] + !! @param[in] pfllsan PFLLSAN field [appropriate units] + !! @param[in] reevapls REEVAPLS field [appropriate units] + !! @param[in] t T field [appropriate units] + !! @param[in] tstep Time step [s] - retrieved from process interface + !! @param[in] species_is_aerosol Species is_aerosol property + !! @param[in] species_short_name Species short_name property + !! @param[in] species_henry_cr Species henry_cr property + !! @param[in] species_henry_k0 Species henry_k0 property + !! @param[in] species_henry_pKa Species henry_pKa property + !! @param[in] species_wd_retfactor Species wd_retfactor property + !! @param[in] species_wd_LiqAndGas Species wd_LiqAndGas property + !! @param[in] species_wd_convfacI2G Species wd_convfacI2G property + !! @param[in] species_wd_rainouteff Species wd_rainouteff property + !! @param[in] species_radius Species radius property + !! @param[in] species_mw_g Species mw_g property + !! @param[in] species_conc Species concentrations [mol/mol] (num_layers, num_species) + !! @param[inout] species_tendencies Species tendency terms [mol/mol/s] (num_layers, num_species) + !! @param[inout] wetdep_mass_per_species_per_level Wet deposition mass loss per species per level [kg/m2] (num_species) + !! @param[inout] wetdep_flux_per_species_per_level Wet deposition flux per species per level [kg/m2/s] (num_species) + !! @param[inout] wetdep_mass_per_species_per_level Wet deposition mass loss per species per level [kg/m2] (num_species) + !! @param[inout] wetdep_flux_per_species_per_level Wet deposition flux per species per level [kg/m2/s] (num_species) + !! @param[in] diagnostic_species_id Indices mapping diagnostic species to species array (optional, for per-species diagnostics) + subroutine compute_jacob( & + num_layers, & + num_species, & + params, & + airden_dry, & + mairden, & + pedge, & + pfilsan, & + pfllsan, & + reevapls, & + t, & + tstep, & + species_is_aerosol, & + species_short_name, & + species_henry_cr, & + species_henry_k0, & + species_henry_pKa, & + species_wd_retfactor, & + species_wd_LiqAndGas, & + species_wd_convfacI2G, & + species_wd_rainouteff, & + species_radius, & + species_mw_g, & + species_conc, & + species_tendencies, & + wetdep_mass_per_species_per_level, & + wetdep_flux_per_species_per_level, & + diagnostic_species_id & + ) + + ! Arguments + integer, intent(in) :: num_layers + integer, intent(in) :: num_species + type(WetDepSchemeJACOBConfig), intent(in) :: params + real(fp), intent(in) :: airden_dry(num_layers) ! 3D atmospheric field + real(fp), intent(in) :: mairden(num_layers) ! 3D atmospheric field + real(fp), intent(in) :: pedge(num_layers+1) ! Edge field - requires nz+1 dimensions + real(fp), intent(in) :: pfilsan(num_layers+1) ! 3D atmospheric field + real(fp), intent(in) :: pfllsan(num_layers+1) ! 3D atmospheric field + real(fp), intent(in) :: reevapls(num_layers) ! 3D atmospheric field + real(fp), intent(in) :: t(num_layers) ! 3D atmospheric field + real(fp), intent(in) :: tstep ! Time step [s] - from process interface + logical, intent(in) :: species_is_aerosol(:) ! Species is_aerosol property + character(len=32), intent(in) :: species_short_name(:) ! Species short_name property + real(fp), intent(in) :: species_henry_cr(:) ! Species henry_cr property + real(fp), intent(in) :: species_henry_k0(:) ! Species henry_k0 property + real(fp), intent(in) :: species_henry_pKa(:) ! Species henry_pKa property + real(fp), intent(in) :: species_wd_retfactor(:) ! Species wd_retfactor property + logical, intent(in) :: species_wd_LiqAndGas(:) ! Species wd_LiqAndGas property + real(fp), intent(in) :: species_wd_convfacI2G(:) ! Species wd_convfacI2G property + real(fp), intent(in) :: species_wd_rainouteff(:,:) ! Species wd_rainouteff property + real(fp), intent(in) :: species_radius(:) ! Species radius property + real(fp), intent(in) :: species_mw_g(:) ! Species mw_g property + real(fp), intent(in) :: species_conc(num_layers, num_species) + real(fp), intent(inout) :: species_tendencies(num_layers, num_species) + real(fp), intent(inout), optional :: wetdep_mass_per_species_per_level(:,:) + real(fp), intent(inout), optional :: wetdep_flux_per_species_per_level(:,:) + integer, intent(in), optional :: diagnostic_species_id(:) ! Indices mapping diagnostic species to species array + + ! Local variables + integer :: k, species_idx, km1, ktop, kbot, so2_id, so4_id, h2o2_id, rc + integer :: diag_idx ! For diagnostic species indexing + ! local physical variables + real(fp) :: delp ! pressure thickness [Pa] + real(fp) :: dqls ! liquid water flux gradient [kg/(m^2 s)] + real(fp) :: dqis ! ice water flux gradient [kg/(m^2 s)] + real(fp) :: dqls_kgm3s ! liquid water flux gradient [kg/(m^3 s)] + real(fp) :: dqis_kgm3s ! ice water flux gradient [kg/(m^3 s)] + real(fp) :: f ! total precipitation fraction (f_rainout + f_washout) [1] + real(fp) :: ftop ! top of grid box rainout fraction [1] + real(fp) :: f_prime ! rainout fraction in middle layers [1] + real(fp) :: f_rainout ! rainout fraction [1] + real(fp) :: f_washout ! washout fraction [1] + real(fp) :: k_rain ! rainout rate [m^3/s] + logical :: kin ! kinetic process flag [kinetic or equilibrium] + real(fp) :: dt ! chemistry model time-step [sec] + real(fp) :: lossfrac ! loss fraction + real(fp) :: qdwn ! cm3 (h2o) / cm2 (air) / s + real(fp) :: press ! pressure [Pa] + real(fp) :: delz ! thickness of layer [m] + real(fp) :: efficiency(3) ! efficiency factors for rainout + real(fp), dimension(:), allocatable :: qq ! precipatitng water rate [cm3 (h2o) / cm2 (air) / s] + real(fp), dimension(:), allocatable :: pdwn ! preciptation rate at top of grid cells [cm3 (h2o) / cm2 (air) / s] + real(fp), dimension(:), allocatable :: dpog ! pressure thickness of grid cells divided by gravity [Pa / (m/s^2)] + real(fp), dimension(:), allocatable :: conc ! concentration [kg/m2] converted from conc_in [kg/kg] + real(fp), dimension(:), allocatable :: SO2 ! concentration of SO2 [kg/kg]; converted in rainout and washout, not here + real(fp), dimension(:), allocatable :: SO4 ! concentration of SO4 [kg/m2]; converted from input SO4_in [kg/kg] + real(fp), dimension(:), allocatable :: H2O2 ! concentration of H2O2 [kg/kg]; converted in rainout and washout, not here + real(fp), dimension(:), allocatable :: dconc ! concentration loss kg/m2 + real(fp), dimension(:), allocatable :: c_h2o ! concentration of h2o + real(fp), dimension(:), allocatable :: cldice ! ice concentration + real(fp), dimension(:), allocatable :: cldliq ! liquid water concentration + real(fp), dimension(:), allocatable :: reevap ! evaporation rate [cm3 (h2o) / cm2 (air) / s] + real(fp), dimension(:), allocatable :: delz_cm ! thickness of layer [cm] + ! + character(len=255) :: thisLoc + character(len=512) :: ErrMsg + ErrMsg = '' + ThisLoc = ' -> at compute_jacob (in process/wetdep/scheme/WetDepScheme_JACOB_Mod.F90)' + + ! -- begin + rc = cc_success + + !initialize variables + ktop = num_layers + kbot = 1 + km1 = 2 !This is to depress the warning 'km1 may be used uninitialized' + dt = tstep + + allocate(qq(kbot:ktop), pdwn(kbot:ktop), conc(kbot:ktop), dconc(kbot:ktop), dpog(kbot:ktop), c_h2o(kbot:ktop), & + cldice(kbot:ktop), cldliq(kbot:ktop), delz_cm(kbot:ktop), SO2(kbot:ktop), SO4(kbot:ktop), H2O2(kbot:ktop), reevap(kbot:ktop)) + + ! find species indices for SO2, SO4, and H2O2 + so2_id = -1 + so4_id = -1 + h2o2_id = -1 + so2_id = max(find_species_ind(species_short_name, 'SO2'), find_species_ind(species_short_name, 'so2')) + so4_id = max(find_species_ind(species_short_name, 'SO4'), find_species_ind(species_short_name, 'so4'), & + find_species_ind(species_short_name, 'aso4j'), find_species_ind(species_short_name, 'ASO4J')) + h2o2_id = max(find_species_ind(species_short_name, 'H2O2'), find_species_ind(species_short_name, 'h2o2')) + if (so2_id < 1 ) then + errMsg = 'SO2 is not a chemical species in the model. Jacob wet deposition scheme will assign zero to it.' + CALL CC_Warning( errMsg, RC, thisLoc ) + SO2 = zero + else + SO2 = species_conc(:, so2_id) * species_mw_g(so2_id) * 1.0e-6_fp / AIRMW !convert from ppmv to kg/kg + endif + if (so4_id < 1 ) then + errMsg = 'SO4 is not a chemical species in the model. Jacob wet deposition scheme will assign zero to it.' + CALL CC_Warning( errMsg, RC, thisLoc ) + SO4 = zero + else + SO4 = species_conc(:, so4_id) * 1.e-09_fp !convert from ug/kg to kg/kg + endif + if (h2o2_id < 1 ) then + errMsg = 'H2O2 is not a chemical species in the model. Jacob wet deposition scheme will assign zero to it.' + CALL CC_Warning( errMsg, RC, thisLoc ) + H2O2 = zero + else + H2O2 = species_conc(:, h2o2_id) * species_mw_g(h2o2_id) * 1.0e-6_fp / AIRMW !convert from ppmv to kg/kg + endif + + ! calculate vertical met first + do k = kbot, ktop + km1 = k + 1 + + ! -- initialize auxiliary arrays + !if (k == ktop) then + ! !TODO: GOCART has an additional index on the model top edge; + ! dqls = pfllsan(k) + ! dqis = pfilsan(k) + ! pdwn(k) = kg_to_cm3_liq * pfllsan(k) + kg_to_cm3_ice * pfilsan(k) + !else + + !Here we follow GOCART with an additional index; otherwise, uncomment the if else statement above + ! -- liquid/ice precipitation formation in grid cell (kg/m2/s) + dqls = pfllsan(k) - pfllsan(km1) + dqis = pfilsan(k) - pfilsan(km1) + ! -- precipitation flux from upper level (convert from kg/m2/s to cm3/cm2/s) + pdwn(k) = kg_to_cm3_liq * pfllsan(km1) + kg_to_cm3_ice * pfilsan(km1) + + !end if ! if (k == ktop) + + delp = pedge(k) - pedge(km1) + dpog(k) = delp / g0 + delz = dpog(k) / mairden(k) ! thickness of layer [m] + delz_cm(k) = delz * m_to_cm ! thickness of layer [cm] + + ! -- liquid/ice precipitation formation in grid cell (kg/m2/s) + !dqls = pfllsan(k) - pfllsan(km1) + !dqis = pfilsan(k) - pfilsan(km1) + + ! -- convert from kg/m2/s to kg (H2O) / m3(air) / s + dqls_kgm3s = dqls / delz + dqis_kgm3s = dqis / delz + + ! -- total precipitation formation (convert from kg (H2O) / m3(air) / s to cm3 (H2O) / cm3 (air) /s) + ! -- To convert from kg (H2O) / m3(air) / s to cm3 (H2O) / cm3 (air) / s, divide by the density of + ! -- the precipitation (ice or liquid) + qq(k) = dqls_kgm3s / density_liq + dqis_kgm3s / density_ice + reevap(k) = reevapls(k) * (airden_dry(k) / 1000.0_fp) ! convert from kg/kg/s to cm3/cm2/s + + ! -- precipitation flux from upper level (convert from kg/m2/s to cm3/cm2/s) + !pdwn(k) = kg_to_cm3_liq * pfllsan(km1) + kg_to_cm3_ice * pfilsan(km1) + + ! -- initialize concentrations array, converting from kg/kg to kg/m2 + !this seems for both gas and aerosol + !SO2(k) = conc_in(k) !already assigned before the loop + SO4(k) = SO4(k) * dpog(k) + + ! -- compute mixing ratio of saturated water vapour over ice (from SETUP_WETSCAV) + press = 0.5_fp * ( pedge(km1) + pedge(k) ) !pressure in grid box + c_h2o(k) = 10._fp ** (-2663.5_fp / t(k) + 12.537_fp ) / press + + ! -- estimate cloud ice and liquid water content (from SETUP_WETSCAV) + if ( t(k) >= 268.0_fp ) then + cldliq(k) = cwc + else if ( t(k) > 248.0_fp ) then + cldliq(k) = cwc * ( t(k) - 248.0_fp ) / 20.0_fp + else + cldliq(k) = zero + end if + cldice(k) = MAX(cwc - cldliq(k), zero) ! ensure cldice >= 0 + end do + + ! loop each species for wet deposition calculation + do species_idx = 1, num_species + !get input concentration for this species + ! -- initialize concentrations array, converting from ug/kg or ppmv to kg/m2 + if (species_is_aerosol(species_idx)) then + conc(:) = species_conc(:, species_idx) * 1.e-09_fp * dpog(:) !convert from ug/kg to kg/kg and then to kg/m2 + else + conc(:) = species_conc(:, species_idx) * species_mw_g(species_idx) * 1.0e-6_fp / AIRMW * dpog(:) !convert from ppmv to kg/kg and then to kg/m2 + end if + ! -- initialize loss array + dconc(:) = zero + efficiency(:) = species_wd_rainouteff(species_idx, :) + + ! -- starts at the top + k = ktop + f = zero + if (qq(k) > qq_thr) then + ! -- compute rainout rate + k_rain = k_min + qq(k) / cwc + f = qq(k) / ( k_rain * cwc ) + + call rainout(species_is_aerosol(species_idx), efficiency, species_wd_LiqAndGas(species_idx), & + species_henry_k0(species_idx), species_henry_cr(species_idx), species_henry_pKa(species_idx), & + species_wd_convfacI2G(species_idx), species_wd_retfactor(species_idx), f, k_rain, dt, t(k), c_h2o(k), & + cldice(k), cldliq(k), species_short_name(species_idx), lossfrac, SO2(k), H2O2(k)) + + ! -- compute and apply effective loss fraction + call rainout_loss( k, lossfrac, conc, dconc ) + + end if + + ! -- middle layers + ftop = f + do k = ktop-1 , kbot+1, -1 + km1 = k + 1 + + f_prime = zero + ! -- if precipitation is forming in the grid cell + if (qq(k) > qq_thr) then + k_rain = k_min + qq(k) / cwc + f_prime = qq(k) / ( k_rain * cwc ) + end if + + ! -- account for precipitation flux + f_rainout = zero + f_washout = zero + + if (pdwn(k) > pdwn_thr) then + f_rainout = f_prime + f_washout = max( zero, ftop - f_rainout ) + end if + + f = f_rainout + f_washout + + if ( f > zero ) then + if ( f_rainout > zero ) then + + call rainout(species_is_aerosol(species_idx), efficiency, species_wd_LiqAndGas(species_idx), & + species_henry_k0(species_idx), species_henry_cr(species_idx), species_henry_pKa(species_idx), & + species_wd_convfacI2G(species_idx), species_wd_retfactor(species_idx), f, k_rain, dt, t(k), c_h2o(k), & + cldice(k), cldliq(k), species_short_name(species_idx), lossfrac, SO2(k), H2O2(k)) + + ! -- compute and apply effective loss fraction + call rainout_loss( k, lossfrac, conc, dconc ) + + end if + if ( f_washout > zero ) then + if ( f_rainout > zero ) then + ! -- washout from precipitation entering from the top + qdwn = pdwn(km1) + !TODO: is reevap available in GFS? Not used in GOCART version? + reevap(k) = max(reevap(k), 0e+0_fp) + else + ! -- washout from precipitation leaving through the bottom + qdwn = pdwn(k) + end if + + call washout(species_radius(species_idx), f, t(k), qdwn, delz_cm(k), dt, species_short_name(species_idx), & + species_is_aerosol(species_idx), species_henry_k0(species_idx), species_henry_cr(species_idx), & + species_henry_pKa(species_idx), params%scale_factor, params%radius_threshold, lossfrac, kin, SO2(k), H2O2(k)) + + ! -- compute and apply effective loss fraction + call washout_loss( k, lossfrac, kin, f_washout, f_rainout, pdwn, reevap(k), & + delz_cm, conc, dconc, species_short_name(species_idx), SO4 ) + + end if + else + ! -- complete resuspension of rainout + washout from level above + call complete_reevap( k, conc, dconc, species_short_name(species_idx), SO4 ) + + end if + + ftop = f + + end do + + ! -- surface level + k = kbot + if (pdwn(km1) > pdwn_thr) then + f = ftop + if ( f > zero ) then + qdwn = pdwn(km1) + + call washout(species_radius(species_idx), f, t(k), qdwn, delz_cm(k), dt, species_short_name(species_idx), & + species_is_aerosol(species_idx), species_henry_k0(species_idx), species_henry_cr(species_idx), & + species_henry_pKa(species_idx), params%scale_factor, params%radius_threshold, lossfrac, kin, SO2(k), H2O2(k)) + + ! -- compute and apply effective loss fraction + call washout_loss( k, lossfrac, kin, f_washout, f_rainout, pdwn, reevap(k), & + delz_cm, conc, dconc, species_short_name(species_idx), SO4 ) + + end if + end if + + ! calculate vertical met first + do k = kbot, ktop + + ! -- convert back to ug/kg or ppmv + if (species_is_aerosol(species_idx)) then + species_tendencies(k, species_idx) = max(0.0_fp, conc(k)) / dpog(k) * 1.0e9_fp + else + species_tendencies(k, species_idx) = max(0.0_fp, conc(k)) / dpog(k) * AIRMW / species_mw_g(species_idx) * 1.0e6_fp + end if + + ! Update diagnostic fields here based on your scheme's requirements + ! Per-species-per-level diagnostic: 2D array (levels, species) + if (present(wetdep_mass_per_species_per_level) .and. present(diagnostic_species_id)) then + ! Find position of this species in diagnostic_species_id array + do diag_idx = 1, size(diagnostic_species_id) + if (diagnostic_species_id(diag_idx) == species_idx) then + ! Add your custom wet deposition mass loss per species per level calculation + wetdep_mass_per_species_per_level(k, diag_idx) = dconc(k) + exit + end if + end do + end if + ! Per-species-per-level diagnostic: 2D array (levels, species) + if (present(wetdep_flux_per_species_per_level) .and. present(diagnostic_species_id)) then + ! Find position of this species in diagnostic_species_id array + do diag_idx = 1, size(diagnostic_species_id) + if (diagnostic_species_id(diag_idx) == species_idx) then + ! Add your custom wet deposition flux per species per level calculation + wetdep_flux_per_species_per_level(k, diag_idx) = dconc(k) / dt + exit + end if + end do + end if + end do ! End layer loop + + end do ! End species loop + + deallocate(qq, pdwn, conc, dconc, dpog, delz_cm, c_h2o, cldice, cldliq, SO2, SO4, H2O2, reevap) + + end subroutine compute_jacob + + ! ======================================================================= + ! SCHEME-SPECIFIC HELPER SUBROUTINES + ! ======================================================================= + ! Add your custom scientific algorithms here as pure functions/subroutines + ! Examples: environmental response functions, species-specific calculations, etc. + + !> \brief Find species index by name + function find_species_ind(SpeciesNames, species_name) result(species_index) + implicit none + character(len=*), intent(in) :: SpeciesNames(:) + character(len=*), intent(in) :: species_name + integer :: species_index + + integer :: i + + species_index = 0 ! Not found + + if (size(SpeciesNames) > 0 ) then + do i = 1, size(SpeciesNames) + if (trim(SpeciesNames(i)) == trim(species_name)) then + species_index = i + exit + endif + enddo + endif + + end function find_species_ind + + !> + !! \brief Computes RAINFRAC, the fraction of soluble species lost to rainout events in precipitation. + !! + !! \param is_aero aerosol rainout flag + !! \param efficiency temperature-dependent scale factor for rainout fraction + !! \param wd_LidAndGas ice-to-gas ratio is computed by co-condensation? + !! \param k0 Henry's solubility constant [M/atm] + !! \param cr Henry's volatility constant [K] + !! \param pKa Henry's pH correction factor [1] + !! \param cnvI2G Conversion factor from ice to gas ratio if wd_LidAndGas is true + !! \param retfac Retention factor of species + !! \param f Fraction of grid box that is precipiting [unitless] + !! \param k Rainout rate constant [1/s] + !! \param dt time step [s] + !! \param tk temperature [K] + !! \param c_h2o Mix ratio of H2O [cm3 H2O/cm3 air] + !! \param cldice Precipitable cloud ice mixing ratio [cm3 ice/cm3 air] + !! \param cldliq Precipitable cloud liquid mixing ratio [cm3 H2O/cm3 air] + !! \param spc Species name + !! \param lossfrac Fraction of species lost to rainout [unitless] + !! \param SO2 SO2 concentration [kg/kg] + !! \param H2O2 H2O2 concentration [kg/kg] + !! + !! \ingroup catchem_wetdep_process + !!!> + subroutine rainout( is_aero, efficiency, wd_LidAndGas, k0, cr, pKa, cnvI2G, retfac, f, k, dt, tk, c_h2o, cldice, cldliq, spc, lossfrac, SO2, H2O2 ) + IMPLICIT NONE + ! Parameters + !----------- + logical, intent(in) :: is_aero !< aerosol rainout flag + real(fp), intent(in) :: efficiency(3) !< temperature-dependent scale factor for rainout fraction + logical, intent(in) :: wd_LidAndGas !< ice-to-gas ratio is computed by co-condensation? + real(fp), intent(in) :: k0 !< Henry's solubility constant [M/atm] + real(fp), intent(in) :: cr !< Henry's volatility constant [K] + real(fp), intent(in) :: pKa !< Henry's pH correction factor [1] + real(fp), intent(in) :: cnvI2G !< Conversion factor from ice to gas ratio if wd_LidAndGas is true + real(fp), intent(in) :: retfac !< Retention factor of species + real(fp), intent(in) :: f !< Fraction of grid box that is precipiting [unitless] + real(fp), intent(in) :: k !< Rainout rate constant [1/s] + real(fp), intent(in) :: dt !< time step [s] + real(fp), intent(in) :: tk !< temperature [K] + real(fp), intent(in) :: c_h2o !< Mix ratio of H2O [cm3 H2O/cm3 air] + real(fp), intent(in) :: cldice !< Precipitable cloud ice mixing ratio [cm3 ice/cm3 air] + real(fp), intent(in) :: cldliq !< Precipitable cloud liquid mixing ratio [cm3 H2O/cm3 air] + character(len = 20), intent(in) :: spc !< Species name + real(fp), intent(out) :: lossfrac !< Fraction of species lost to rainout [unitless] + real(fp), intent(in) :: SO2 !< SO2 concentration [kg/kg] + real(fp), intent(in) :: H2O2 !< H2O2 concentration [kg/kg] + + ! Local Variables + !---------------- + real(fp) :: i2g, l2g, c_tot + real(fp) :: f_i, f_l, ki + real(fp) :: SO2s, H2O2s !after uint conversion to mol/mol + real(fp) :: SO2LOSS + real(fp), parameter :: kc = 5.e-3_fp ! conversion rate from cloud condensate to precip (s-1) + + !-------------------------------------------- + ! main function + !-------------------------------------------- + !================================================================= + ! %%% SPECIAL CASE %%% + ! SO2, HNO3 and H2SO4 scavenges like an aerosol although they are + ! considered to be a gas-phase species elsewhere + !================================================================= + if (is_aero .or. spc == 'SO2' .or. spc == 'HNO3' .or. spc == 'H2SO4' & + .or. spc == 'so2' .or. spc == 'hno3' .or. spc == 'h2so4') then + lossfrac = rainfrac( f, k, dt ) + + ! -- apply rainout efficiency (simplify from APPLY_RAINOUT_EFF) + if (tk < 237.0_fp) then + ! ice + lossfrac = efficiency(1) * lossfrac + else if (tk < 258.0_fp) then + ! snow + lossfrac = efficiency(2) * lossfrac + else + ! liquid rain + lossfrac = efficiency(3) * lossfrac + end if + + if (spc == 'SO2' .or. spc == 'so2') then + !unit conversion to mol/mol using airMW and SO2MW or H2OMW + SO2s = SO2 * (AIRMW / 64.04_fp) + H2O2s = H2O2 * (AIRMW / 34.02_fp) + ! Update SO2 and H2O2 + if ( SO2s > TINY_ ) then + ! Limit lossfrac + SO2LOSS = MIN( SO2s, H2O2s ) + lossfrac = SO2LOSS * lossfrac / SO2s + lossfrac = MAX( lossfrac, 0e+0_fp ) + + ! Update saved H2O2 concentration + !TODO:: comment out the depletion since we may not have afterchem H2O2 like in GOES-Chem + ! Otherwise, the depletion will do twice with the later one in washout_loss subroutine + !H2O2s = H2O2s - ( SO2s * lossfrac ) + !H2O2s = MAX( H2O2s, TINY_ ) + + else + + ! If SO2 is not defined then set lossfrac to 0 + lossfrac = 0.0_fp + + endif + + ! Update saved SO2 concentration + !TODO:: comment out the depletion since we may not have afterchem SO2 like in GOES-Chem + ! Otherwise, the depletion will do twice with the later one in washout_loss subroutine + !SO2s = SO2s * ( 1.0_fp - lossfrac ) + !SO2s = MAX( SO2s, TINY_ ) + end if + + else !for gases exceptfor SO2, HNO3 and H2SO4 + + ! -- compute ice to gas ratio assuming scavenging by co-condensation + ! simplified from COMPUTE_Ki + ! wd_LidAndGas is true only for SO2, NH3 and H2O2 for now + i2g = zero + if (wd_LidAndGas) then + if ( c_h2o > zero ) i2g = cnvI2G * cldice / c_h2o + end if + ! -- compute l2g (adopted from COMPUTE_L2G) + !TODO: seems an error in GOCART version here + l2g = liq_to_gas_ratio( k0, cr, pKa, tk, cldliq) + + ! -- fraction of species in liquid and ice phases + c_tot = one + l2g + i2g + f_l = l2g / c_tot + f_i = i2g / c_tot + + ! -- compute Ki for loss due to scavenging from convective updraft + if ( tk >= 268.0_fp ) then + ki = kc * ( f_l + f_i ) + else if ( tk > 248.0_fp ) then + ki = kc * ( retfac * f_l + f_i ) + else + ki = kc * f_i + end if + + ! -- compute rained-out fraction + lossfrac = rainfrac( f, ki, dt ) + + end if + + end subroutine rainout + + !> + !! \brief Computes WASHFRAC, the fraction of soluble species lost to washout events in precipitation. + !! + !! \param radius Particle radius (um) + !! \param f Fraction of grid box that is precipitating [unitless] + !! \param tk Temperature in grid box (K) + !! \param qdwn Instant precip rate in grid box (cm3 (H2O) / cm2 (air) / s) + !! \param dz Height of grid box [cm] + !! \param dt Timestep (s) + !! \param spc Species name + !! \param is_aero aerosol washout flag + !! \param k0 Henry's solubility constant [M/atm] + !! \param cr Henry's volatility constant [K] + !! \param pKa Henry's pH correction factor [1] + !! \param wtune Washout tuning factor; newly added in GOCART version + !! \param radius_thr Fine/coarse particle radius threshold (um); using 1.0 um for now + !! \param washfrac Fraction of species lost to washout [unitless] + !! \param kin Kinetic process flag [kinetic or equilibrium] + !! \param SO2 SO2 concentration [kg/kg] + !! \param H2O2 H2O2 concentration [kg/kg] + !! + !! \ingroup catchem_wetdep_process + !!!> + + subroutine washout( radius, f, tk, qdwn, dz, dt, spc, is_aero, k0, cr, pKa, wtune, radius_thr, washfrac, kin, SO2, H2O2) + + implicit none + + real(fp), intent(in) :: radius !< Particle radius (um) + real(fp), intent(in) :: f !< Fraction of grid box that is precipitating [unitless] + real(fp), intent(in) :: tk !< Temperature in grid box (K) + real(fp), intent(in) :: qdwn !< Instant precip rate in grid box (cm3 (H2O) / cm2 (air) / s) + real(fp), intent(in) :: dz !< Height of grid box [cm] + real(fp), intent(in) :: dt !< Timestep (s) + character(len = 20), intent(in) :: spc !< Species name + logical, intent(in) :: is_aero !< aerosol washout flag + real(fp), intent(in) :: k0 !< Henry's solubility constant [M/atm] + real(fp), intent(in) :: cr !< Henry's volatility constant [K] + real(fp), intent(in) :: pKa !< Henry's pH correction factor [1] + real(fp), intent(in) :: wtune !< Washout tuning factor; newly added in GOCART version + real(fp), intent(in) :: radius_thr !< Fine/coarse particle radius threshold (um); using 1.0 um for now + real(fp), intent(out) :: washfrac !< Fraction of species lost to washout [unitless] + logical, intent(out) :: kin !< Kinetic process flag [kinetic or equilibrium] + real(fp), intent(in) :: H2O2 !< H2O2 conc [kg/kg] TODO: conc's after aqueous rxns are applied. These are computed + real(fp), intent(in) :: SO2 !< SO2 conc [kg/kg] in the sulfate chemistry module and passed here (not considered by now) + ! -- local variables + real(fp) :: SO2LOSS + real(fp) :: SO2s, H2O2s !unit conversion to mol/mol + + ! -- begin + washfrac = zero + + !================================================================= + ! HNO3 scavenges like an aerosol although it is considered + ! to be a gas-phase species elsewhere (e.g. dry deposition) + !================================================================= + + IF ( Spc == 'HNO3' .or. spc == 'hno3' ) THEN !TODO: better way to check species name? + + ! Washout is a kinetic process + KIN = .TRUE. + + ! Get washout fraction + WASHFRAC = WASHFRAC_HNO3( F, TK, QDWN, DT ) + + !================================================================= + ! SO2 scavenges like an aerosol although it is considered + ! to be a gas-phase species elsewhere (e.g. dry deposition) + !================================================================= + ELSE IF ( Spc == 'SO2' .or. spc == 'H2SO4' .or. & + spc == 'so2' .or. spc == 'h2so4') THEN !TODO: better way to check species name? + + ! NOTE: Even though SO2 is not an aerosol we treat it as SO4 in + ! wet scavenging. When evaporation occurs, it returns to SO4. + KIN = .TRUE. + !NOTE: Here we use a dummy radius = 0.5 um for SO2/H2SO4 since + ! it is considered as fine aerosol here + WASHFRAC = WASHFRAC_AEROSOL( 0.5_fp, F, TK, QDWN, DT, wtune, 1.0_fp ) + + IF (Spc == 'SO2' .or. spc == 'so2') THEN + ! Use the wet-scavenging following [Chin et al, 1996] such + ! that a soluble fraction of SO2 is limited by the availability + ! of H2O2 in the precipitating grid box. Then scavenge the + ! soluble SO2 at the same rate as sulfate. + + !unit conversion to mol/mol using airMW and SO2MW or H2OMW + SO2s = SO2 * (AIRMW / 64.04_fp) + H2O2s = H2O2 * (AIRMW / 34.02_fp) + IF ( TK >= 268e+0_fp .AND. SO2s > TINY_ ) THEN + + ! Adjust WASHFRAC + SO2LOSS = MIN( SO2s, H2O2s ) + WASHFRAC = SO2LOSS * WASHFRAC / SO2s + WASHFRAC = MAX( WASHFRAC, 0e+0_fp ) + + ! Deplete H2O2s the same as SO2s + !TODO:: comment out the depletion since we may not have afterchem H2O2 like in GOES-Chem + ! Otherwise, the depletion will do twice with the later one in washout_loss subroutine + !H2O2s = H2O2s - ( SO2s * WASHFRAC ) + !H2O2s = MAX( H2O2s, TINY_ ) + + ELSE + WASHFRAC = 0e+0_fp + + ENDIF + + ! Update saved SO2 concentration + !TODO:: comment out the depletion since we may not have afterchem SO2 like in GOES-Chem + ! Otherwise, the depletion will do twice with the later one in washout_loss subroutine + !SO2s = SO2s * ( 1e+0_fp - WASHFRAC ) + !SO2s = MAX( SO2s, TINY_ ) + END IF + + !----------------------------------------------------------------- + ! Washout for aerosol species + !----------------------------------------------------------------- + ELSE IF ( is_aero ) THEN + + ! Washout is a kinetic process + KIN = .TRUE. + WASHFRAC = WASHFRAC_AEROSOL( radius, F, TK, QDWN, DT, wtune, radius_thr ) + + !----------------------------------------------------------------- + ! Washout for gas-phase species + ! (except H2SO4, NO3, and SO2, which scavenge like aerosols; + !----------------------------------------------------------------- + ELSE + ! Washout is an equilibrium process + KIN = .FALSE. + CALL WASHFRAC_LIQ_GAS( F, TK, QDWN, DZ, DT, K0, CR, PKA, WASHFRAC, KIN ) + + END IF + + end subroutine washout + + !> + !! \brief Computes the fraction of species lost to rainout. + !! + !! \param f Fraction of grid box that is precipiting [unitless] + !! \param k Rainout rate constant [1/s] + !! \param dt time step [s] + !! + !! \ingroup catchem_wetdep_process + !!!> + real(fp) function rainfrac( f, k, dt ) + + implicit none + ! INPUT Parameters + real(fp), intent(in) :: f !< Fraction of grid box that is precipiting [unitless] + real(fp), intent(in) :: k !< Rainout rate constant [1/s] + real(fp), intent(in) :: dt !< time step [s] + + rainfrac = f * ( one - exp( -k * dt ) ) + + end function rainfrac + + !> + !! \brief Computes the ratio L2G = Cliq / Cgas, which is the mixing ratio + !! of species in the liquid phase, divided by the mixing ratio of species in the gas phase. + !! + !! \param k0 Henry's solubility constant [M/atm] + !! \param cr Henry's volatility constant [K] + !! \param pKa Henry's pH correction factor [1] + !! \param tk Temperature [K] + !! \param qliq Liquid water content [cm3 H2O/cm3 air] + !! + !! \ingroup catchem_wetdep_process + !!!> + real(fp) function liq_to_gas_ratio( k0, cr, pKa, tk, qliq ) + + real(fp), intent(in) :: k0 !< Henry's solubility constant [M/atm] + real(fp), intent(in) :: cr !< Henry's volatility constant [K] + real(fp), intent(in) :: pKa !< Henry's pH correction factor [1] + real(fp), intent(in) :: tk !< Temperature [K] + real(fp), intent(in) :: qliq !< Liquid water content [cm3 H2O/cm3 air] + + ! -- local variables + real(fp) :: h !, t + ! -- local parameters + real(fp), parameter :: cloud_pH = 4.5_fp + real(fp), parameter :: Tref = 298.15_fp ! K + real(fp), parameter :: R = 8.3144598_fp ! J K-1 mol-1 + real(fp), parameter :: Pref = 101.325_fp ! mPa + + ! -- compute Henry's law constant for a given temperature + !t = real(tk, kind=f8) TODO: not sure why this conversion is needed; do not use it for now + h = k0 * exp( cr * (1._fp/tk - 1._fp/Tref) ) * R * tk / Pref + + ! -- adjust Henry's law constant for chemical equilibriums in liquid phase + if ( pKa > -100._fp ) h = h * ( one + 10._fp ** ( cloud_pH - pKa ) ) + + liq_to_gas_ratio = h * qliq + + end function liq_to_gas_ratio + + !> + !! \brief Computes the fraction of soluble aerosol species lost to washout. + !! + !! \param radius Particle radius (um) + !! \param f Washout fraction [unitless] + !! \param tk Temperature in grid box (K) + !! \param pdwn Instant precip rate in grid box (cm3 (H2O) / cm2 (air) / s) + !! \param dt Timestep (s) + !! \param tuning Washout tuning factor; newly added in GOCART version + !! \param radius_fine Fine particle radius threshold (um); using 1.0 um for now + !! + !! \ingroup catchem_wetdep_process + !!!> + real(fp) function washfrac_aerosol( radius, f, tk, pdwn, dt, tuning, radius_fine ) + + implicit none + + real(fp), intent(in) :: radius !< particle radius (um) + real(fp), intent(in) :: f !< washout fraction [unitless] + real(fp), intent(in) :: tk !< Temperature in grid box (K) + real(fp), intent(in) :: pdwn !< Instant precip rate in grid box (cm3 (H2O) / cm2 (air) / s) + real(fp), intent(in) :: dt !< Timestep (s) + real(fp), intent(in) :: tuning !< Washout tuning factor; newly added in GOCART version + real(fp), intent(in) :: radius_fine !< fine particle radius threshold (um); using 1.0 um for now + + ! -- local variables + real(fp) :: dth, pph + ! -- local parameters + real(fp), parameter :: k_wash = 1.06e-03_fp + real(fp), parameter :: h2s = 3600.0_fp ! s-1 + + ! -- begin + washfrac_aerosol = zero + + if ( f > zero ) then + ! -- convert instant rates (s-1) to hourly rates + pph = 10.0_fp * pdwn * h2s + dth = dt / h2s + + if ( radius < radius_fine ) then !for fine aerosol (simplified from WASHFRAC_FINE_AEROSOL) + if ( tk >= 268e+0_fp ) then + washfrac_aerosol = F * ( one - EXP(-k_wash * tuning * (pph / f ) ** 0.61e+0_fp * dth)) + else + washfrac_aerosol = F * ( one - EXP(-2.6e+1_fp * k_wash * tuning * (pph / f ) ** 0.96e+0_fp * dth)) + endif + else !for coarse aerosol (simplified from WASHFRAC_COARSE_AEROSOL) + if ( tk >= 268e+0_fp ) then + washfrac_aerosol = F * ( one - EXP(-0.92e+0_fp * tuning * (pph / f ) ** 0.79e+0_fp * dth)) + else + !TODO: GOCART applied a factor of 0.5 to the tuning factor for coarse aerosol???? + !washfrac_aerosol = F * ( one - EXP(-1.57e+0_fp / 0.5e+0_fp * tuning * (pph / f ) ** 0.96e+0_fp * dth)) + washfrac_aerosol = F * ( one - EXP(-1.57e+0_fp * tuning * (pph / f ) ** 0.96e+0_fp * dth)) + endif + endif + endif + + end function washfrac_aerosol + + !> + !! \brief Computes the fraction of HNO3 species lost to washout. + !! + !! \param f Fraction of grid box that is precipitating [unitless] + !! \param tk Temperature in grid box (K) + !! \param pdwn Instant precip rate in grid box (cm3 (H2O) / cm2 (air) / s) + !! \param dt Timestep (s) + !! + !! \ingroup catchem_wetdep_process + !!!> + real(fp) function washfrac_hno3( f, tk, pdwn, dt ) + + implicit none + + real(fp), intent(in) :: f !< Fraction of grid box that is precipitating [unitless] + real(fp), intent(in) :: tk !< Temperature in grid box [K] + real(fp), intent(in) :: pdwn !< Precip rate thru bottom of grid box (cm3 (H2O) / cm2 (air) / s) + real(fp), intent(in) :: dt !< Timestep of washout event (s) + + ! -- local parameters + real(fp), parameter :: k_wash = 1.0_fp ! First order washout rate (cm-1) + + ! -- begin + washfrac_hno3 = zero + ! -- compute washout fraction only if T >= 268K + if ( tk >= 268.0_fp .and. f > zero ) then + washfrac_hno3 = f * ( one - exp( -k_wash * pdwn * dt / f ) ) + end if + + end function washfrac_hno3 + + !> + !! \brief Computes the fraction of soluble liquid/gas phase species lost to washout. + !! + !! \param f Fraction of grid box that is precipitating [unitless] + !! \param tk Temperature in grid box (K) + !! \param pdwn Instant precip rate in grid box (cm3 (H2O) / cm2 (air) / s) + !! \param dz Height of grid box [cm] + !! \param dt Timestep of washout event (s) + !! \param k0 Henry's solubility constant [M/atm] + !! \param cr Henry's volatility constant [K] + !! \param pKa Henry's pH correction factor [1] + !! \param washfrac Fraction of species lost to washout [unitless] + !! \param kin Kinetic process flag [kinetic or equilibrium] + !! + !! \ingroup catchem_wetdep_process + !!!> + subroutine washfrac_liq_gas( f, tk, pdwn, dz, dt, k0, cr, pKa, washfrac, kin) + + implicit none + + real(fp), intent(in) :: f !< Fraction of grid box that is precipitating [unitless] + real(fp), intent(in) :: tk !< Temperature in grid box [K] + real(fp), intent(in) :: pdwn !< Precip rate thru bottom of grid box (cm3 (H2O) / cm2 (air) / s) + real(fp), intent(in) :: dz !< Height of grid box [cm] + real(fp), intent(in) :: dt !< Timestep of washout event (s) + real(fp), intent(in) :: k0 !< Henry's solubility constant [M/atm] + real(fp), intent(in) :: cr !< Henry's volatility constant [K] + real(fp), intent(in) :: pKa !< Henry's pH correction factor [1] + real(fp), intent(out) :: washfrac !< Fraction of species lost to washout [unitless] + logical, intent(out) :: kin !< Kinetic process flag [kinetic or equilibrium] + + ! -- local variables + real(fp) :: qliq, l2g, washfrac_kin + + ! -- begin + + ! Start with the assumption that washout will be an + ! equilibrium process + kin = .false. + + if ( tk < 268.0_fp ) then + ! -- no washout + washfrac = zero + + else + + ! -- compute L2G + qliq = pdwn * dt / ( f * dz ) + + ! Compute liquid to gas ratio + l2g = liq_to_gas_ratio( k0, cr, pKa, tk, qliq ) + + ! -- washout fraction from Henry's Law + washfrac = l2g / ( one + l2g ) + + ! -- washout fraction from kinetic processes (HNO3) + ! set f = one and call washfrac_hno3 function above + washfrac_kin = washfrac_hno3( one, tk, pdwn, dt ) + + ! -- equilibrium washout must not exceed kinetic washout + !TODO: GOCART is missing 'washfrac_kin * f' here ?????? + if ( washfrac > washfrac_kin ) then + washfrac = washfrac_kin * f + kin = .true. ! washout is a kinetic process + end if + + end if + + end subroutine washfrac_liq_gas + + !> + !! \brief Computes the concentrations of species lost to rainout. + !! + !! \param k Layer index + !! \param lossfrac Fraction of species lost to washout [unitless] + !! \param conc Concentration [kg/m2] + !! \param dconc Concentration loss [kg/m2] + !! + !! \ingroup catchem_wetdep_process + !!!> + subroutine rainout_loss( k, lossfrac, conc, dconc ) + + implicit none + + ! -- input/output parameters + integer, intent(in) :: k !< layer index + real(fp), intent(in) :: lossfrac !< fraction of species lost to rainout [unitless] + real(fp), dimension(:), intent(inout) :: conc !< concentration [kg/m2] + real(fp), dimension(:), intent(inout) :: dconc !< concentration loss kg/m2 + + ! -- local variables + real(fp) :: wetloss !< wet loss concentration + + ! -- apply loss (simplified from the DO_WASHOUT_ONLY subroutine) + wetloss = lossfrac * conc(k) + conc(k) = conc(k) - wetloss + if ( k == size(conc) ) then !If it is the top layer; we assume the layer index is not reversed + ! Dconc is an accumulator array for rained-out species. + ! The species in Dconc are in the liquid phase and will + ! precipitate to the levels below until a washout occurs. + dconc(k) = wetloss + else + ! Add to Dconc the species lost to rainout in grid box + ! (I,J,L) plus the species lost to rainout from grid box + ! (I,J,L+1), which has by now precipitated down into + ! grid box (I,J,L). Dconc will continue to accumulate + ! rained out species in this manner until a washout + ! event occurs. + dconc(k) = dconc(k+1) + wetloss + end if + + end subroutine rainout_loss + + !> + !! \brief Computes the concentrations of species lost to washout. + !! + !! \param k layer index + !! \param lossfrac fraction of species lost to washout [unitless] + !! \param kin kinetic process flag [kinetic or equilibrium] + !! \param f_washout washout fraction [unitless] + !! \param f_rainout rainout fraction [unitless] + !! \param pdwn downward flux of precipitation + !! \param reevap Precip forming or evaporating [cm3 (h2o)/cm3 (air)] + !! \param delz_cm vertical grid spacing [cm] + !! \param conc concentration [kg/m2] + !! \param dconc concentration loss kg/m2 + !! \param SO4 SO4 concentration [kg/m2] + !! \param spc Species name + !! + !! \ingroup catchem_wetdep_process + !!!> + subroutine washout_loss( k, lossfrac, kin, f_washout, f_rainout, pdwn, reevap, delz_cm, conc, dconc, spc, SO4 ) + + implicit none + + ! -- input/output parameters + integer, intent(in) :: k !< layer index + real(fp), intent(inout) :: lossfrac !< fraction of species lost to rainout [unitless] + logical, intent(in) :: kin !< kinetic process flag [kinetic or equilibrium] + real(fp), intent(in) :: f_washout !< washout fraction [unitless] + real(fp), intent(in) :: f_rainout !< rainout fraction [unitless] + real(fp), dimension(:), intent(in) :: pdwn !< downward flux of precipitation + !real(fp), dimension(:), intent(in) :: qq !< precipatitng water rate [cm3 (h2o) / cm2 (air) / s] + real(fp) :: reevap !< Precip forming or evaporating [cm3 (h2o)/cm3 (air)] + real(fp), dimension(:), intent(in) :: delz_cm !< vertical grid spacing [cm] + real(fp), dimension(:), intent(inout) :: conc !< concentration [kg/m2] + real(fp), dimension(:), intent(inout) :: dconc !< concentration loss kg/m2 + real(fp), dimension(:), intent(inout) :: SO4 !< SO4 concentration [kg/m2] + character(len = 20), intent(in) :: spc !< Species name + + ! -- local variables + integer :: km1 !< upper one layer index + real(fp) :: f !< washout + rainout fraction [unitless] + real(fp) :: wetloss !< wet loss concentration + real(fp) :: alpha !< re-evaporate fraction [1] + real(fp) :: gain !< washout gain [kg/m2] + real(fp) :: washed !< washout concentration [kg/m2] + + !begins here (simplified from the DO_WASHOUT_ONLY and DO_WASHOUT_AT_SFC subroutines) + f = f_washout + f_rainout + km1 = k + 1 + if ( k == 1 ) then !for the surface layer; note this assumes the layer index starts from surface not the top + + ! -- f is included in lossfrac for aerosols and HNO3 + if ( kin ) then + wetloss = lossfrac * conc(k) + else + wetloss = f * lossfrac * conc(k) + end if + conc (k) = conc (k) - wetloss + dconc(k) = dconc(km1) + wetloss + + else !for middle layers + if ( kin ) then + ! -- adjust loss fraction for aerosols + lossfrac = lossfrac * f_washout / f + + ! Define ALPHA, the fraction of the raindrops that + ! re-evaporate when falling from (I,J,L+1) to (I,J,L) + if ( pdwn(km1) - ZERO > ZERO ) then !avoid divide by zero + !TODO: is qq(k) right in here? + !alpha = abs( qq(k) ) * delz_cm(k) / pdwn(km1) + alpha = abs( reevap ) * delz_cm(k) / pdwn(km1) + else + alpha = one + end if + ! Restrict ALPHA to be less than 1 + alpha = min( one, alpha ) + ! Assume 50% of the re-evaporated water rains out to aerosols + ! GAINED is the rained out aerosol coming down from + ! grid box (I,J,L+1) that will evaporate and re-enter + ! the atmosphere in the gas phase in grid box (I,J,L). + gain = 0.5_fp * alpha * dconc(km1) + wetloss = conc(k) * lossfrac - gain + ! SO2 in sulfate chemistry is wet-scavenged on the + ! raindrop and converted to SO4 by aqeuous chem. + ! If evaporation occurs then SO2 comes back as SO4 + if (spc == 'SO2' .or. spc == 'so2') then + SO4(k) = SO4(k) + gain * 96e+0_fp / 64e+0_fp + conc(k) = conc(k) * (1e+0_fp - lossfrac) + else + conc(k) = conc(k) - wetloss + end if + + else !not kinetic process (mainly for gases) + + !Not sure why dconc is not counted here in wetloss calculation + washed = f_washout * conc(k) + dconc(km1) + wetloss = lossfrac * ( washed - dconc(km1) ) + conc(k) = conc(k) - wetloss + + end if ! kinetic or equilibrium process + + ! Add washout losses in grid box (I,J,L) to dconc + if ( f_rainout > zero ) then + dconc(k) = dconc(k) + wetloss + else + dconc(k) = dconc(km1) + wetloss + end if + + end if !surface or middle layer + + end subroutine washout_loss + + !> + !! \brief Computes the re-evaporation all of the soluble species back into the atmosphere. + !! + !! \param k layer index + !! \param conc concentration [kg/m2] + !! \param dconc concentration loss [kg/m2] + !! \param spc Species name + !! \param SO4 SO4 concentration [kg/m2] + !! + !! \ingroup catchem_wetdep_process + !!!> + subroutine complete_reevap( k, conc, dconc, spc, SO4 ) + + implicit none + + ! -- input/output parameters + integer, intent(in) :: k !< layer index + real(fp), dimension(:), intent(inout) :: conc !< concentration [kg/m2] + real(fp), dimension(:), intent(inout) :: dconc !< concentration loss kg/m2 + character(len = 20), intent(in) :: spc !< Species name + real(fp), dimension(:), intent(inout) :: SO4 !< SO4 concentration [kg/m2] + + ! -- local variables + integer :: km1 !< upper one layer index + real(fp) :: wetloss !< wet loss + + ! -- begin + km1 = k + 1 + wetloss = -dconc(km1) + ! All of the rained-out species coming from grid box + ! (I,J,L+1) goes back into the gas phase at (I,J,L) + ! In evap, SO2 comes back as SO4 + if (spc == 'SO2' .or. spc == 'so2') then + SO4(k) = SO4(k) - (wetloss * 96e+0_fp / 64e+0_fp ) + else + conc(k) = conc(k) - wetloss + end if + + ! There is nothing rained out/washed out in grid box + ! (I,J,L), so set dconc at grid box (I,J,L) to zero. + dconc(k) = 0e+0_fp + + end subroutine complete_reevap + + +end module WetDepScheme_JACOB_Mod diff --git a/tests/CMakeLists.txt b/tests/CMakeLists.txt index 9d353649..cac2c54b 100644 --- a/tests/CMakeLists.txt +++ b/tests/CMakeLists.txt @@ -333,6 +333,9 @@ add_test( add_executable(test_catchem_api test_catchem_api.F90 ../src/api/CATChem_API.F90) target_link_libraries(test_catchem_api PRIVATE CATChem_core) target_link_libraries(test_catchem_api PRIVATE CATChem_process_seasalt) +target_link_libraries(test_catchem_api PRIVATE CATChem_process_drydep) +target_link_libraries(test_catchem_api PRIVATE CATChem_process_wetdep) +target_link_libraries(test_catchem_api PRIVATE CATChem_process_settling) target_link_libraries(test_catchem_api PRIVATE testing) set_target_properties( test_catchem_api diff --git a/tests/Configs/Default/CATChem_new_config.yml b/tests/Configs/Default/CATChem_new_config.yml index f57ae321..aed95fd6 100644 --- a/tests/Configs/Default/CATChem_new_config.yml +++ b/tests/Configs/Default/CATChem_new_config.yml @@ -42,6 +42,25 @@ diagnostics: enabled: true buffer_size: 1000 #============================================================================ +# Optics files for Mie +#============================================================================ +mie: + #directory: "/gpfs/f6/bil-fire3/world-shared/Emissions/NASA/ExtData/monochromatic/" #location on gaeac6 + directory: "../../../../../../optics/" + files: + # SS: opticsBands_SS.v3_3.RRTMG.nc + # DU: opticsBands_DU.v15_3.RRTMG.nc + # BC: opticsBands_BC.v1_3.RRTMG.nc + # OC: opticsBands_OC.v1_3.RRTMG.nc + # NI: opticsBands_NI.v2_5.RRTMG.nc + # SU: opticsBands_SU.v1_3.RRTMG.nc + SS: optics_SS.v3_5.nc + DU: optics_DU.v15_5.nc + BC: optics_BC.v1_5.nc + OC: optics_OC.v1_5.nc + NI: optics_NI.v2_5.nc + SU: optics_SU.v1_5.nc +#============================================================================ # RunPhase settings: define process running order #============================================================================ run_phases: @@ -49,8 +68,9 @@ run_phases: description: "Test phase 1" processes: seasalt - # dust - # drydep + settling + drydep + wetdep # test2: # description: "Test phase 2" # processes: @@ -113,7 +133,7 @@ processes: seasalt: activate: true diagnostics: true - diag_species: [seas1, seas3, seas5] + diag_species: [] scheme: 'geos12' gong97: scale_factor: 1.0 @@ -134,7 +154,7 @@ processes: drydep: activate: true diagnostics: true - diag_species: [seas1, seas3, seas5] + diag_species: [so2, aso4j, seas1, seas3, seas5] gas_scheme: 'wesely' aero_scheme: 'zhang' wesely: @@ -144,3 +164,21 @@ processes: resuspension: false zhang: scale_factor: 1.0 + wetdep: + activate: true + diagnostics: true + diag_species: [so2, aso4j, seas1, seas3, seas5] + scheme: 'jacob' + jacob: + scale_factor: 1.0 + radius_threshold: 1.0 + settling: + activate: true + diagnostics: true + diag_species: [aso4j, seas1, seas3, seas5] + scheme: 'gocart' + gocart: + scale_factor: 1.0 #not doing anything for now since we cannot edit gocart2g module + simple_scheme: false #read in mie data for wet particles if true; otherwise calculate particles wet swelling internally + swelling_method: 1 # 1 for Fitzgerald 1975; 2 for Gerber 1985 if simple_scheme is false + correction_maring: false #correction settling velocity following Maring et al, 2003 for both simple and non-simple schemes diff --git a/tests/Configs/Default/CATChem_species.yml b/tests/Configs/Default/CATChem_species.yml index 9a489386..4e6defb6 100644 --- a/tests/Configs/Default/CATChem_species.yml +++ b/tests/Configs/Default/CATChem_species.yml @@ -9,18 +9,42 @@ so2: description: Sulfur dioxide is_gas: true is_drydep: true + is_wetdep: true dd_f0: 0.0 dd_hstar: 1.0e+5 mw_g: 64.04 dd_DvzAerSnow: 0.03 dd_DvzMinVal_snow: 0.2 dd_DvzMinVal_land: 0.3 - viscosity: 0.0 -so4: - name: so4 + viscosity: 0.0 #dummy value + #This is Luo's scheme for SO2 but adopted here + henry_k0: 1.22 + henry_cr: 3100.0 + wd_retfactor: 5.0e-2 + wd_LiqAndGas: true + wd_convfacI2G: 6.17395e-1 + wd_rainouteff: [1.0, 0.0, 1.0] +h2o2: + name: h2o2 + description: Hydrogen peroxide + is_gas: true + is_drydep: true + is_wetdep: true + dd_f0: 1.0 + dd_hstar: 5.0e+7 + mw_g: 34.02 + viscosity: 0.0 #dummy value + henry_k0: 8.3e+4 + henry_cr: 7400.0 + wd_retfactor: 5.0e-2 + wd_LiqAndGas: true + wd_convfacI2G: 4.36564e-1 +aso4j: #This is to match CMAQ name to use the restart file. so4 is used in GEOS-Chem. + name: aso4j description: sulfate is_aerosol: true is_drydep: true + is_wetdep: true dd_f0: 0.0 dd_hstar: 0.0 mw_g: 96.06 @@ -31,6 +55,8 @@ so4: dd_DvzMinVal_land: 0.01 lower_radius: 0.1 upper_radius: 1.0 + wd_rainouteff: [1.0, 0.0, 1.0] + mie_name: SU dms: name: dms description: Dimethyl sulfide @@ -39,37 +65,47 @@ dms: is_dust: false is_aerosol: true is_drydep: false + henry_k0: 0.48 + henry_cr: 3100.0 + mie_name: SU bc1: name: bc1 description: BC1 is_aerosol: true is_drydep: true + is_wetdep: true dd_f0: 0.0 dd_hstar: 0.0 mw_g: 12.01 - radius: 0.087 + radius: 0.087 #gocart is 0.35 density: 1800.0 dd_DvzAerSnow: 0.03 lower_radius: 0.1 upper_radius: 1.0 + wd_rainouteff: [1.0, 0.0, 1.0] + mie_name: BC bc2: name: bc2 description: BC2 is_aerosol: true is_drydep: true + is_wetdep: true dd_f0: 0.0 dd_hstar: 0.0 mw_g: 12.01 - radius: 0.087 + radius: 0.087 #gocart is 0.35 density: 1800.0 dd_DvzAerSnow: 0.03 lower_radius: 0.1 upper_radius: 1.0 + wd_rainouteff: [1.0, 0.0, 1.0] + mie_name: BC oc1: name: oc1 description: OC1 is_aerosol: true is_drydep: true + is_wetdep: true dd_f0: 0.0 dd_hstar: 0.0 mw_g: 12.01 @@ -78,11 +114,14 @@ oc1: dd_DvzAerSnow: 0.03 lower_radius: 0.1 upper_radius: 1.0 + wd_rainouteff: [1.0, 0.0, 1.0] + mie_name: OC oc2: name: oc2 description: OC2 is_aerosol: true is_drydep: true + is_wetdep: true dd_f0: 0.0 dd_hstar: 0.0 mw_g: 12.01 @@ -91,6 +130,8 @@ oc2: dd_DvzAerSnow: 0.03 lower_radius: 0.1 upper_radius: 1.0 + wd_rainouteff: [1.0, 0.0, 1.0] + mie_name: OC dust1: name: dust1 long_name: dust1 @@ -105,6 +146,9 @@ dust1: is_dust: true is_aerosol: true is_drydep: true + is_wetdep: true + wd_rainouteff: [1.0, 1.0, 0.0] + mie_name: DU dust2: name: dust2 long_name: dust2 @@ -119,6 +163,9 @@ dust2: is_dust: true is_aerosol: true is_drydep: true + is_wetdep: true + wd_rainouteff: [1.0, 1.0, 0.0] + mie_name: DU dust3: name: dust3 long_name: dust3 @@ -133,6 +180,9 @@ dust3: is_dust: true is_aerosol: true is_drydep: true + is_wetdep: true + wd_rainouteff: [1.0, 1.0, 0.0] + mie_name: DU dust4: name: dust4 long_name: dust4 @@ -147,6 +197,9 @@ dust4: is_dust: true is_aerosol: true is_drydep: true + is_wetdep: true + wd_rainouteff: [1.0, 1.0, 0.0] + mie_name: DU dust5: name: dust5 long_name: dust5 @@ -161,6 +214,9 @@ dust5: is_dust: true is_aerosol: true is_drydep: true + is_wetdep: true + wd_rainouteff: [1.0, 1.0, 0.0] + mie_name: DU seas1: name: seas1 long_name: seas1 @@ -169,12 +225,15 @@ seas1: upper_radius: 0.1 dd_f0: 0.0 dd_hstar: 0.0 - mw_g: 31.40 + mw_g: 31.40 #GEOS-Chem is 31.40; gocart is 58 but it seems not used in gocart processes. So we go with GC radius: 0.079 density: 2200. is_seasalt: true is_aerosol: true is_drydep: true + is_wetdep: true + wd_rainouteff: [1.0, 0.0, 1.0] + mie_name: SS seas2: name: seas2 long_name: seas2 @@ -183,12 +242,15 @@ seas2: upper_radius: 0.5 dd_f0: 0.0 dd_hstar: 0.0 - mw_g: 31.40 + mw_g: 31.40 #GEOS-Chem is 31.40; gocart is 58 radius: 0.316 density: 2200. is_seasalt: true is_aerosol: true is_drydep: true + is_wetdep: true + wd_rainouteff: [1.0, 0.0, 1.0] + mie_name: SS seas3: name: seas3 long_name: seas3 @@ -197,12 +259,15 @@ seas3: upper_radius: 1.5 dd_f0: 0.0 dd_hstar: 0.0 - mw_g: 31.40 + mw_g: 31.40 #GEOS-Chem is 31.40; gocart is 58 radius: 1.119 density: 2200. is_seasalt: true is_aerosol: true is_drydep: true + is_wetdep: true + wd_rainouteff: [1.0, 0.0, 1.0] + mie_name: SS seas4: name: seas4 long_name: seas4 @@ -211,12 +276,15 @@ seas4: upper_radius: 5.0 dd_f0: 0.0 dd_hstar: 0.0 - mw_g: 31.40 + mw_g: 31.40 #GEOS-Chem is 31.40; gocart is 58 radius: 2.818 density: 2200. is_seasalt: true is_aerosol: true is_drydep: true + is_wetdep: true + wd_rainouteff: [1.0, 0.0, 1.0] + mie_name: SS seas5: name: seas5 long_name: seas5 @@ -225,9 +293,12 @@ seas5: upper_radius: 10.0 dd_f0: 0.0 dd_hstar: 0.0 - mw_g: 31.40 + mw_g: 31.40 #GEOS-Chem is 31.40; gocart is 58 radius: 7.772 density: 2200. is_seasalt: true is_aerosol: true is_drydep: true + is_wetdep: true + wd_rainouteff: [1.0, 0.0, 1.0] + mie_name: SS diff --git a/tests/process/drydep/integration/test_drydep_integration.F90 b/tests/process/drydep/integration/test_drydep_integration.F90 index dbfeb60e..8aca6300 100644 --- a/tests/process/drydep/integration/test_drydep_integration.F90 +++ b/tests/process/drydep/integration/test_drydep_integration.F90 @@ -4,7 +4,7 @@ !! This file contains comprehensive integration tests for the drydep process implementation !! using the centralized CATChemCore framework. Tests complete workflow: core initialization, !! configuration loading, process registration, and all scheme validation. -!! Generated on: 2025-11-14T22:58:26.726097 +!! Generated on: 2025-12-18T14:21:30.137417 program test_drydep_integration use precision_mod, only: fp @@ -254,13 +254,21 @@ subroutine setup_met(core_arg, rc_arg) altitude_km = real(k-1, fp) * 1.0_fp met_state%T(i,j,k) = 288.15_fp - 6.5_fp * altitude_km ! Temperature lapse rate [K] met_state%RH(i,j,k) = 0.90_fp * exp(-altitude_km / 5.0_fp) ! Relative humidity [fraction] - met_state%AIRDEN(i,j,k) = 1.2_fp * exp(-altitude_km / 8.0_fp) ! Air density [kg/m3] + met_state%AIRDEN_DRY(i,j,k) = 1.2_fp * exp(-altitude_km / 8.0_fp) ! Dry air density [kg/m3] + met_state%AIRDEN(i,j,k) = met_state%AIRDEN_DRY(i,j,k) * 1.01_fp ! wet Air density [kg/m3] met_state%BXHEIGHT(i,j,k) = 1000.0_fp ! Grid box height [m] - met_state%ZMID(i,j,k) = altitude_km * 1000.0_fp * 9.81_fp ! Mid-level geopotential [m2/s2] end do end do end do - + ! Set up pressure edge arrays (nx, ny, nz+1) + do j = 1, ny + do i = 1, nx + do k = 1, nz+1 + edge_altitude_km = real(k-1, fp) * 1.0_fp - 0.5_fp + met_state%Z(i,j,k) = 1000.0_fp * (edge_altitude_km + 0.65_fp) ! Geopotential height at edges [m] + end do + end do + end do ! Set up some arrays with special dimensions (nx, ny, ncat) do j = 1, ny @@ -331,7 +339,7 @@ subroutine test_scheme(core_arg, scheme_name, rc_arg) ! Get drydep process interface drydep_interface => null() - select type(process => process_mgr%processes(1)) + select type(process => process_mgr%processes(1)%item) type is (ProcessDryDepInterface) drydep_interface => process end select @@ -341,7 +349,10 @@ subroutine test_scheme(core_arg, scheme_name, rc_arg) return end if - ! Step 1: Set the scheme + ! Step 1: Set the timestep for process calculations + call drydep_interface%set_timestep(dt) + + ! Step 2: Set the scheme ! For gas/aerosol differentiated processes, determine scheme type select case (trim(scheme_name)) case ('wesely') @@ -354,7 +365,7 @@ subroutine test_scheme(core_arg, scheme_name, rc_arg) call drydep_interface%set_scheme(scheme_name) end select - ! Step 2: Reload scheme-specific configuration + ! Step 3: Reload scheme-specific configuration config_mgr => state_mgr%get_config_ptr() error_mgr => state_mgr%get_error_manager() diff --git a/tests/process/seasalt/integration/test_seasalt_integration.F90 b/tests/process/seasalt/integration/test_seasalt_integration.F90 index 3941689b..5e780466 100644 --- a/tests/process/seasalt/integration/test_seasalt_integration.F90 +++ b/tests/process/seasalt/integration/test_seasalt_integration.F90 @@ -4,7 +4,7 @@ !! This file contains comprehensive integration tests for the seasalt process implementation !! using the centralized CATChemCore framework. Tests complete workflow: core initialization, !! configuration loading, process registration, and all scheme validation. -!! Generated on: 2025-11-14T23:01:21.917777 +!! Generated on: 2025-12-15T16:09:09.864661 program test_seasalt_integration use precision_mod, only: fp @@ -227,7 +227,6 @@ subroutine setup_met(core_arg, rc_arg) - ! Set up DELP (pressure difference between levels) for emission unit conversion ! DELP is only used for unit conversion in emission processes do j = 1, ny @@ -263,7 +262,7 @@ subroutine test_scheme(core_arg, scheme_name, rc_arg) ! Get seasalt process interface seasalt_interface => null() - select type(process => process_mgr%processes(1)) + select type(process => process_mgr%processes(1)%item) type is (ProcessSeaSaltInterface) seasalt_interface => process end select @@ -273,7 +272,7 @@ subroutine test_scheme(core_arg, scheme_name, rc_arg) return end if - ! Step 1: Set the timestep for emission calculations + ! Step 1: Set the timestep for process calculations call seasalt_interface%set_timestep(dt) ! Step 2: Set the scheme diff --git a/tests/process/settling/CMakeLists.txt b/tests/process/settling/CMakeLists.txt new file mode 100644 index 00000000..ebb90197 --- /dev/null +++ b/tests/process/settling/CMakeLists.txt @@ -0,0 +1,149 @@ +# CMakeLists.txt for settling process tests +# Generated on: 2025-12-18T14:12:33.273972 + +cmake_minimum_required(VERSION 3.12) + +# Test executables +set( + TEST_SOURCES + unit/test_settling_unit.F90 + integration/test_settling_integration.F90 +) + +# Create test executables +foreach(test_source ${TEST_SOURCES}) + get_filename_component(test_name ${test_source} NAME_WE) + + add_executable(${test_name} ${test_source}) + + # Link against process modules + target_link_libraries( + ${test_name} + CATChem_process_settling + CATChem_core + testing + ) + + # Set Fortran module directory + set_target_properties( + ${test_name} + PROPERTIES Fortran_MODULE_DIRECTORY "${CMAKE_CURRENT_BINARY_DIR}/modules" + ) + + # Add include directories for module files + target_include_directories( + ${test_name} + PRIVATE "${CMAKE_BINARY_DIR}/include" "${CMAKE_CURRENT_BINARY_DIR}/modules" + ) + + # Add to test suite + add_test(NAME ${test_name} COMMAND ${test_name}) + + # Set test properties + set_tests_properties( + ${test_name} + PROPERTIES TIMEOUT 60 WORKING_DIRECTORY "${CMAKE_CURRENT_BINARY_DIR}" + ) +endforeach() + +# Test data files +configure_file( + "${CMAKE_SOURCE_DIR}/tests/Configs/Default/CATChem_new_config.yml" + "${CMAKE_CURRENT_BINARY_DIR}/settling_config.yaml" + COPYONLY +) + +# Additional test data files - copy other config files that might be needed +file(GLOB TEST_DATA_FILES "${CMAKE_SOURCE_DIR}/tests/Configs/Default/*.yml") +foreach(test_data_file ${TEST_DATA_FILES}) + get_filename_component(filename ${test_data_file} NAME) + configure_file( + "${test_data_file}" + "${CMAKE_CURRENT_BINARY_DIR}/${filename}" + COPYONLY + ) +endforeach() + +# Custom test targets with unique names +add_custom_target( + run_settling_unit + COMMAND test_settling_unit + DEPENDS test_settling_unit + WORKING_DIRECTORY "${CMAKE_CURRENT_BINARY_DIR}" + COMMENT "Running unit tests for settling process" +) + +add_custom_target( + run_settling_integration + COMMAND test_settling_integration + DEPENDS test_settling_integration + WORKING_DIRECTORY "${CMAKE_CURRENT_BINARY_DIR}" + COMMENT "Running integration tests for settling process" +) + +add_custom_target( + run_settling_all + DEPENDS run_settling_unit run_settling_integration + COMMENT "Running all tests for settling process" +) + +# Test coverage (if available) +if(CODE_COVERAGE) + find_program(GCOV_PATH gcov) + find_program(LCOV_PATH lcov) + find_program(GENHTML_PATH genhtml) + + if(GCOV_PATH AND LCOV_PATH AND GENHTML_PATH) + # Add coverage flags + set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} --coverage") + set(CMAKE_EXE_LINKER_FLAGS "${CMAKE_EXE_LINKER_FLAGS} --coverage") + + # Coverage target + add_custom_target( + coverage_settling + COMMAND + ${LCOV_PATH} --directory . --capture --output-file + coverage_settling.info + COMMAND + ${LCOV_PATH} --remove coverage_settling.info '/usr/*' --output-file + coverage_settling.info + COMMAND ${GENHTML_PATH} -o coverage_settling_html coverage_settling.info + DEPENDS run_settling_all + WORKING_DIRECTORY "${CMAKE_CURRENT_BINARY_DIR}" + COMMENT "Generating test coverage report for settling process" + ) + endif() +endif() + +# Performance benchmarks +add_custom_target( + benchmark_settling + DEPENDS run_settling_integration + WORKING_DIRECTORY "${CMAKE_CURRENT_BINARY_DIR}" + COMMENT "Running performance benchmarks for settling process" +) + +# Memory checking with valgrind (if available) +find_program(VALGRIND_PATH valgrind) +if(VALGRIND_PATH) + add_custom_target( + memcheck_settling + COMMAND + ${VALGRIND_PATH} --tool=memcheck --leak-check=full --show-leak-kinds=all + --track-origins=yes ./test_settling_integration + DEPENDS test_settling_integration + WORKING_DIRECTORY "${CMAKE_CURRENT_BINARY_DIR}" + COMMENT "Running memory check for settling process" + ) +endif() + +# Install test executables (optional) +if(INSTALL_TESTS) + install(TARGETS ${TEST_SOURCES} RUNTIME DESTINATION bin/tests) + + install( + FILES "${CMAKE_SOURCE_DIR}/tests/Configs/Default/CATChem_new_config.yml" + DESTINATION share/tests/settling + RENAME settling_config.yaml + ) +endif() diff --git a/tests/process/settling/integration/test_settling_integration.F90 b/tests/process/settling/integration/test_settling_integration.F90 new file mode 100644 index 00000000..dd6f668a --- /dev/null +++ b/tests/process/settling/integration/test_settling_integration.F90 @@ -0,0 +1,785 @@ +!> \file test_settling_integration.F90 +!! \brief Comprehensive integration tests for settling process using CATChemCore +!! +!! This file contains comprehensive integration tests for the settling process implementation +!! using the centralized CATChemCore framework. Tests complete workflow: core initialization, +!! configuration loading, process registration, and all scheme validation. +!! Generated on: 2025-12-18T14:12:33.239223 + +program test_settling_integration + use precision_mod, only: fp + use iso_fortran_env, only: output_unit, error_unit + use error_mod, only: CC_SUCCESS, CC_FAILURE, ErrorManagerType, ERROR_UNSUPPORTED_OPERATION + use CATChemCore_Mod, only: CATChemCoreType, CATChemBuilderType + use StateManager_Mod, only: StateManagerType + use ProcessManager_Mod, only: ProcessManagerType + use GridManager_Mod, only: GridManagerType + use DiagnosticManager_Mod, only: DiagnosticManagerType + use MetState_Mod, only: MetStateType + use ChemState_Mod, only: ChemStateType + use ConfigManager_Mod, only: ConfigManagerType + use ProcessSettlingInterface_Mod, only: ProcessSettlingInterface + use SettlingProcessCreator_Mod, only: register_settling_process + use SettlingCommon_Mod, only: SettlingProcessConfig + use DiagnosticInterface_Mod, only: DiagnosticRegistryType, DiagnosticFieldType, & + DIAG_REAL_SCALAR, DIAG_REAL_1D, DIAG_REAL_2D, DIAG_REAL_3D, & + DIAG_INTEGER_SCALAR, DIAG_INTEGER_1D, DIAG_INTEGER_2D, DIAG_INTEGER_3D + + implicit none + + ! Core framework + type(CATChemCoreType) :: core + type(CATChemBuilderType) :: builder + type(ProcessManagerType), pointer :: process_mgr_ptr + + ! Configuration file path + character(len=*), parameter :: config_file = './CATChem_new_config.yml' + + ! Test parameters for realistic deposition scenario + integer, parameter :: n_columns = 10 ! Grid columns + integer, parameter :: n_levels = 20 ! Vertical levels (surface to ~20 km) + integer, parameter :: n_time_steps = 5 ! Multiple timesteps for integration testing + real(fp), parameter :: dt = 3600.0_fp ! 1 hour timestep + + ! Test schemes + character(len=20) :: schemes(1) + + integer :: rc, i_scheme, i_time + logical :: all_tests_passed = .true. + + ! Initialize scheme array + schemes = [ & + 'gocart '] + + write(output_unit,'(A)') '==================================' + write(output_unit,'(A)') '=== SETTLING INTEGRATION TESTS ===' + write(output_unit,'(A)') '==================================' + write(output_unit,'(A)') 'Using CATChemCore for comprehensive testing with' + write(output_unit,'(A)') 'configuration, meteorological data, and all scheme validation' + write(output_unit,'(A)') '' + + ! Step 1: Initialize CATChem Core with proper grid dimensions + write(output_unit,'(A)') 'Step 1: Initializing CATChem Core...' + + call builder%init() + builder = builder%with_name('SettlingIntegrationTest') + builder = builder%with_config(config_file) + builder = builder%with_grid(n_columns, 1, n_levels) + builder = builder%with_verbose() + call builder%build(core, rc) + + if (rc /= CC_SUCCESS) then + write(error_unit,'(A)') 'ERROR: CATChemCore initialization/configuration failed' + all_tests_passed = .false. + goto 999 + end if + write(output_unit,'(A,I0,A,I0,A)') ' ✓ CATChemCore initialized: ', n_columns, ' columns, ', n_levels, ' levels' + write(output_unit,'(A)') ' ✓ Configuration loaded and all managers set up' + + ! Register settling processes with ProcessFactory + process_mgr_ptr => core%get_process_manager() + call register_settling_process(process_mgr_ptr, rc) + if (rc /= CC_SUCCESS) then + write(error_unit,'(A)') 'ERROR: Failed to register settling processes with ProcessFactory' + all_tests_passed = .false. + goto 999 + end if + write(output_unit,'(A)') ' ✓ Settling processes registered with ProcessFactory' + + ! Step 2: Set up realistic meteorological conditions + write(output_unit,'(A)') '' + write(output_unit,'(A)') 'Step 2: Setting up realistic meteorological conditions...' + call setup_met(core, rc) + if (rc /= CC_SUCCESS) then + write(error_unit,'(A)') 'ERROR: Failed to set up meteorological conditions' + all_tests_passed = .false. + goto 999 + end if + write(output_unit,'(A)') ' ✓ Meteorological conditions configured' + + ! Step 3: Testing settling process with all schemes + write(output_unit,'(A)') '' + write(output_unit,'(A)') 'Step 3: Testing settling process with all schemes...' + + ! Add settling process for scheme testing + call core%add_process('settling', rc) + if (rc /= CC_SUCCESS) then + write(error_unit,'(A)') 'ERROR: Failed to add settling process for scheme testing' + all_tests_passed = .false. + goto 999 + end if + write(output_unit,'(A)') ' ✓ Settling process added successfully' + + write(output_unit,'(A)') '' + write(output_unit,'(A)') ' Testing multiple settling schemes...' + do i_scheme = 1, size(schemes) + write(output_unit,'(A,A,A)') ' Testing ', trim(schemes(i_scheme)), ' scheme...' + + call test_scheme(core, schemes(i_scheme), rc) + if (rc /= CC_SUCCESS) then + write(output_unit,'(A,A)') ' ✗ ', trim(schemes(i_scheme)), ' scheme test failed' + write(error_unit,'(A,A)') 'ERROR: Scheme test failed for ', trim(schemes(i_scheme)) + all_tests_passed = .false. + else + write(output_unit,'(A,A)') ' ✓ ', trim(schemes(i_scheme)), ' scheme test passed' + end if + end do + write(output_unit,'(A)') ' ✓ All scheme tests completed' + + ! Step 4: Test multi-timestep stability + write(output_unit,'(A)') '' + write(output_unit,'(A)') 'Step 4: Testing multi-timestep stability...' + write(output_unit,'(A,I0,A)') ' Running ', n_time_steps, ' timestep integration test...' + + + do i_time = 1, n_time_steps + call core%run_timestep(i_time, dt, rc) + if (rc /= CC_SUCCESS) then + write(error_unit,'(A,I0)') 'ERROR: Timestep ', i_time, ' failed' + all_tests_passed = .false. + exit + end if + end do + + if (all_tests_passed) then + write(output_unit,'(A,I0,A)') ' ✓ All ', n_time_steps, ' timesteps completed successfully' + write(output_unit,'(A)') ' - Settling process stability verified' + write(output_unit,'(A)') ' - Multi-timestep conservation maintained' + end if + + ! Final validation and cleanup + write(output_unit,'(A)') '' + write(output_unit,'(A)') 'Final validation and cleanup...' + call core%finalize(rc) + if (rc /= CC_SUCCESS) then + write(error_unit,'(A)') 'WARNING: Core finalization had issues' + end if + +999 continue + + ! Print final results + write(output_unit,'(A)') '' + write(output_unit,'(A)') '==================================' + if (all_tests_passed) then + write(output_unit,'(A)') '=== ALL SETTLING TESTS PASSED! ===' + write(output_unit,'(A)') '=== Integration test successful ===' + else + write(output_unit,'(A)') '=== SOME SETTLING TESTS FAILED ===' + write(output_unit,'(A)') '=== Check error messages above ===' + end if + write(output_unit,'(A)') '==================================' + + if (.not. all_tests_passed) stop 1 + +contains + + !> Set up realistic meteorological conditions for settling testing + subroutine setup_met(core_arg, rc_arg) + type(CATChemCoreType), intent(inout) :: core_arg + integer, intent(out) :: rc_arg + + type(StateManagerType), pointer :: state_mgr + type(MetStateType), pointer :: met_state + type(GridManagerType), pointer :: grid_mgr + integer :: nx, ny, nz, i, j, k + real(fp) :: lat, wind_speed, altitude_km, edge_altitude_km + + rc_arg = CC_SUCCESS + + ! Get managers and state pointers + state_mgr => core_arg%get_state_manager() + met_state => state_mgr%get_met_state_ptr() + grid_mgr => core_arg%get_grid_manager() + + ! Get grid dimensions + call grid_mgr%get_shape(nx, ny, nz) + + ! Allocate categorical arrays with standard dimensions + + ! Set realistic conditions for settling processes + do j = 1, ny + ! Calculate latitude for realistic gradients + lat = -30.0_fp + (j-1) * 60.0_fp / max(1, ny-1) ! -30°S to 30°N + do i = 1, nx + + end do + end do + + ! Set up 3D atmospheric fields (nx, ny, nz) + do j = 1, ny + do i = 1, nx + do k = 1, nz + ! Calculate height-dependent values + ! Approximate altitude in km (assuming ~1 km per level near surface) + altitude_km = real(k-1, fp) * 1.0_fp + met_state%T(i,j,k) = 288.15_fp - 6.5_fp * altitude_km ! Temperature lapse rate [K] + met_state%RH(i,j,k) = 0.90_fp * exp(-altitude_km / 5.0_fp) ! Relative humidity [fraction] + met_state%PMID(i,j,k) = 101300.25_fp * exp(-altitude_km / 8.0_fp) ! Mid-level pressure [Pa] + met_state%DELP(i,j,k) = 5000.0_fp ! Pressure thickness [Pa] + met_state%AIRDEN_DRY(i,j,k) = 1.2_fp * exp(-altitude_km / 8.0_fp) ! Dry air density [kg/m3] + met_state%AIRDEN(i,j,k) = met_state%AIRDEN_DRY(i,j,k) * 1.01_fp ! wet Air density [kg/m3] + end do + end do + end do + ! Set up pressure edge arrays (nx, ny, nz+1) + do j = 1, ny + do i = 1, nx + do k = 1, nz+1 + edge_altitude_km = real(k-1, fp) * 1.0_fp - 0.5_fp + met_state%Z(i,j,k) = 1000.0_fp * (edge_altitude_km + 0.65_fp) ! Geopotential height at edges [m] + end do + end do + end do + + + + + end subroutine setup_met + + !> Test a specific settling scheme with comprehensive validation + subroutine test_scheme(core_arg, scheme_name, rc_arg) + type(CATChemCoreType), intent(inout) :: core_arg + character(len=*), intent(in) :: scheme_name + integer, intent(out) :: rc_arg + + type(ProcessManagerType), pointer :: process_mgr + type(StateManagerType), pointer :: state_mgr + type(ProcessSettlingInterface), pointer :: settling_interface + type(ConfigManagerType), pointer :: config_mgr + type(ErrorManagerType), pointer :: error_mgr + + rc_arg = CC_SUCCESS + + ! Get process manager and state manager + process_mgr => core_arg%get_process_manager() + state_mgr => core_arg%get_state_manager() + + ! Get settling process interface + settling_interface => null() + select type(process => process_mgr%processes(1)%item) + type is (ProcessSettlingInterface) + settling_interface => process + end select + + if (.not. associated(settling_interface)) then + rc_arg = CC_FAILURE + return + end if + + ! Step 1: Set the timestep for process calculations + call settling_interface%set_timestep(dt) + + ! Step 2: Set the scheme + call settling_interface%set_scheme(scheme_name) + + ! Step 3: Reload scheme-specific configuration + config_mgr => state_mgr%get_config_ptr() + error_mgr => state_mgr%get_error_manager() + + if (.not. associated(config_mgr)) then + call error_mgr%report_error(1003, & + 'ConfigManager not available from StateManager', rc_arg) + return + end if + + if (.not. associated(error_mgr)) then + rc_arg = CC_FAILURE + return + end if + + ! Call the scheme-specific loading function directly + select case (trim(scheme_name)) + case ('gocart') + call settling_interface%process_config%load_gocart_config(config_mgr, error_mgr) + case default + call error_mgr%report_error(1004, & + 'Unknown scheme: ' // trim(scheme_name), rc_arg) + return + end select + + + ! Step 3: Reset diagnostics for the new scheme + call reset_diagnostics_for_scheme(settling_interface, state_mgr, scheme_name, rc_arg) + if (rc_arg /= CC_SUCCESS) return + + ! Step 4: Run the process to populate diagnostic data + call process_mgr%run_column_processes(state_mgr, rc_arg) + if (rc_arg /= CC_SUCCESS) return + + ! Step 5: Validate all results + call validate_results(core_arg, rc_arg) + + end subroutine test_scheme + + !> Reset diagnostics for a specific scheme (test-specific function) + !! This function handles diagnostic reset when switching between schemes during testing + subroutine reset_diagnostics_for_scheme(settling_interface, container, scheme_name, rc_arg) + type(ProcessSettlingInterface), intent(inout) :: settling_interface + type(StateManagerType), intent(inout) :: container + character(len=*), intent(in) :: scheme_name + integer, intent(out) :: rc_arg + + type(DiagnosticManagerType), pointer :: diag_mgr + type(ErrorManagerType), pointer :: error_mgr + character(len=64) :: current_scheme + + rc_arg = CC_SUCCESS + + ! Get managers + diag_mgr => container%get_diagnostic_manager() + error_mgr => container%get_error_manager() + + ! Get current scheme + current_scheme = settling_interface%get_scheme() + + ! Remove existing process registration (this clears all diagnostic fields) + call diag_mgr%remove_process('settling', rc_arg) + if (rc_arg /= CC_SUCCESS) then + call error_mgr%report_error(ERROR_UNSUPPORTED_OPERATION, & + 'Failed to remove existing diagnostics for settling process', rc_arg) + ! Continue anyway - this might be the first registration + rc_arg = CC_SUCCESS + endif + + ! Re-register diagnostics for the new scheme + ! The scheme-specific configuration should already be set correctly + call settling_interface%register_diagnostics(container, rc_arg) + if (rc_arg /= CC_SUCCESS) then + call error_mgr%report_error(ERROR_UNSUPPORTED_OPERATION, & + 'Failed to re-register diagnostics for scheme: ' // & + trim(current_scheme), rc_arg) + return + endif + + end subroutine reset_diagnostics_for_scheme + + !> Validate the results of the integration test with comprehensive diagnostic checking + subroutine validate_results(core_arg, rc_arg) + type(CATChemCoreType), intent(inout) :: core_arg + integer, intent(out) :: rc_arg + + type(DiagnosticManagerType), pointer :: diag_mgr + type(DiagnosticRegistryType), pointer :: settling_registry + character(len=64), allocatable :: field_names(:) + integer :: num_fields, i, local_rc, data_type + real(fp) :: scalar_value + real(fp), pointer :: array_1d_ptr(:) => null() + real(fp), pointer :: array_2d_ptr(:,:) => null() + real(fp), pointer :: array_3d_ptr(:,:,:) => null() + logical :: validation_passed + character(len=64) :: field_name + character(len=20) :: type_name + + rc_arg = CC_SUCCESS + validation_passed = .true. + + write(output_unit,'(A)') ' Validating settling emission results...' + + ! Use core validation first + if (.not. core_arg%validate()) then + write(error_unit,'(A)') ' ERROR: Core validation failed' + rc_arg = CC_FAILURE + return + end if + write(output_unit,'(A)') ' ✓ Core validation passed' + + ! Get DiagnosticManager from core + diag_mgr => core_arg%get_diagnostic_manager() + if (.not. associated(diag_mgr)) then + write(error_unit,'(A)') ' ERROR: Could not get DiagnosticManager from core' + rc_arg = CC_FAILURE + return + end if + + ! Get the settling process diagnostic registry + call diag_mgr%get_process_registry('settling', settling_registry, local_rc) + if (local_rc /= CC_SUCCESS .or. .not. associated(settling_registry)) then + write(error_unit,'(A)') ' ERROR: Could not get settling process registry' + rc_arg = CC_FAILURE + return + end if + + ! Get the number of registered diagnostic fields + num_fields = settling_registry%get_field_count() + write(output_unit,'(A,I0,A)') ' Found ', num_fields, ' registered diagnostic fields for settling process' + + if (num_fields == 0) then + write(error_unit,'(A)') ' ERROR: No diagnostic fields registered for settling process' + rc_arg = CC_FAILURE + return + end if + + ! Allocate array for field names + allocate(field_names(num_fields)) + + ! Get all field names + call settling_registry%list_fields(field_names, num_fields) + + ! Iterate through all diagnostic fields and validate them + write(output_unit,'(A)') ' Validating all registered diagnostic fields:' + + do i = 1, num_fields + field_name = trim(field_names(i)) + write(output_unit,'(A,I0,A,A)') ' Field ', i, ': ', trim(field_name) + + ! Get field values and type information directly from DiagnosticManager + call diag_mgr%get_field_value('settling', field_name, & + scalar_value=scalar_value, & + array_1d_ptr=array_1d_ptr, & + array_2d_ptr=array_2d_ptr, & + array_3d_ptr=array_3d_ptr, & + data_type=data_type, & + rc=local_rc) + if (local_rc /= CC_SUCCESS) then + write(error_unit,'(A,A)') ' WARNING: Could not retrieve field value: ', trim(field_name) + validation_passed = .false. + cycle + end if + + ! Convert data type to readable name and validate values + call validate_field_by_type(field_name, data_type, scalar_value, & + array_1d_ptr, array_2d_ptr, array_3d_ptr, validation_passed, verbose=.false.) + + end do + + ! Clean up + deallocate(field_names) + + ! Final validation result + if (.not. validation_passed) then + write(error_unit,'(A)') ' VALIDATION FAILED: Some settling diagnostics failed validation' + rc_arg = CC_FAILURE + else + write(output_unit,'(A)') ' ✓ All settling diagnostic validations passed' + write(output_unit,'(A,I0,A)') ' - ', num_fields, ' diagnostic fields validated' + write(output_unit,'(A)') ' - All emission values are positive' + write(output_unit,'(A)') ' - Diagnostic system is functioning correctly' + end if + + end subroutine validate_results + + !> Validate field values based on type and emission expectations + subroutine validate_field_by_type(field_name, data_type, scalar_value, & + array_1d_ptr, array_2d_ptr, array_3d_ptr, validation_passed, verbose) + character(len=*), intent(in) :: field_name + integer, intent(in) :: data_type + real(fp), intent(in) :: scalar_value + real(fp), pointer, intent(in) :: array_1d_ptr(:) + real(fp), pointer, intent(in) :: array_2d_ptr(:,:) + real(fp), pointer, intent(in) :: array_3d_ptr(:,:,:) + logical, intent(inout) :: validation_passed + logical, intent(in), optional :: verbose + + logical :: field_passed + logical :: is_verbose = .false. + character(len=20) :: type_name + integer :: i, j, k + real(fp) :: current_value + + ! Set verbose mode + if (present(verbose)) is_verbose = verbose + ! Explicitly initialize field_passed for each call + field_passed = .true. + + ! Convert data type to readable name and validate values + select case (data_type) + case (DIAG_REAL_SCALAR) + type_name = 'Real Scalar' + write(output_unit,'(A,A)') ' Type: ', trim(type_name) + write(output_unit,'(A,E12.5)') ' Scalar value: ', scalar_value + if (is_verbose) then + write(output_unit,'(A,A,A,E12.5)') ' ', trim(field_name), ' = ', scalar_value + end if + + ! Check if scalar value is finite and non-negative + if (scalar_value /= scalar_value) then ! NaN check + write(error_unit,'(A,A)') ' ERROR: Field has NaN value: ', trim(field_name) + field_passed = .false. + else if (scalar_value < 0.0_fp) then + write(error_unit,'(A,A)') ' ERROR: Field has negative value: ', trim(field_name) + field_passed = .false. + else if (.not. (scalar_value < huge(scalar_value))) then ! Infinite check + write(error_unit,'(A,A)') ' ERROR: Field has infinite value: ', trim(field_name) + field_passed = .false. + else + write(output_unit,'(A,A)') ' ✓ Field has valid finite non-negative value: ', trim(field_name) + end if + + case (DIAG_REAL_1D) + type_name = 'Real 1D Array' + write(output_unit,'(A,A)') ' Type: ', trim(type_name) + if (associated(array_1d_ptr)) then + write(output_unit,'(A,I0)') ' Array size: ', size(array_1d_ptr) + + ! Check each element in the 1D array + do i = 1, size(array_1d_ptr) + current_value = array_1d_ptr(i) + if (is_verbose) then + write(output_unit,'(A,A,A,I0,A,E12.5)') ' ', trim(field_name), '[', i, '] = ', current_value + end if + if (current_value /= current_value) then ! NaN check + write(error_unit,'(A,A,A,I0,A)') ' ERROR: Field has NaN at index ', trim(field_name), ' (', i, ')' + field_passed = .false. + exit + else if (current_value < 0.0_fp) then + write(error_unit,'(A,A,A,I0,A)') ' ERROR: Field has negative value at index ', trim(field_name), ' (', i, ')' + field_passed = .false. + exit + else if (.not. (current_value < huge(current_value))) then ! Infinite check + write(error_unit,'(A,A,A,I0,A)') ' ERROR: Field has infinite value at index ', trim(field_name), ' (', i, ')' + field_passed = .false. + exit + end if + end do + + if (field_passed) then + ! Check if sum of array is zero + if (sum(array_1d_ptr) == 0.0_fp) then + write(error_unit,'(A,A)') ' WARNING: Field has zero sum (all elements are zero): ', trim(field_name) + !field_passed = .false. + else + write(output_unit,'(A,A)') ' ✓ All array elements are finite and non-negative: ', trim(field_name) + end if + end if + else + write(error_unit,'(A,A)') ' ERROR: 1D array not associated for field: ', trim(field_name) + field_passed = .false. + end if + + case (DIAG_REAL_2D) + type_name = 'Real 2D Array' + write(output_unit,'(A,A)') ' Type: ', trim(type_name) + if (associated(array_2d_ptr)) then + write(output_unit,'(A,I0,A,I0)') ' Array size: ', size(array_2d_ptr,1), ' x ', size(array_2d_ptr,2) + + ! Check each element in the 2D array + outer_loop_2d: do j = 1, size(array_2d_ptr,2) + do i = 1, size(array_2d_ptr,1) + current_value = array_2d_ptr(i,j) + if (is_verbose) then + write(output_unit,'(A,A,A,I0,A,I0,A,E12.5)') ' ', trim(field_name), '[', i, ',', j, '] = ', current_value + end if + if (current_value /= current_value) then ! NaN check + write(error_unit,'(A,A,A,I0,A,I0,A)') ' ERROR: Field has NaN at index ', trim(field_name), ' (', i, ',', j, ')' + field_passed = .false. + exit outer_loop_2d + else if (current_value < 0.0_fp) then + write(error_unit,'(A,A,A,I0,A,I0,A)') ' ERROR: Field has negative value at index ', trim(field_name), ' (', i, ',', j, ')' + field_passed = .false. + exit outer_loop_2d + else if (.not. (current_value < huge(current_value))) then ! Infinite check + write(error_unit,'(A,A,A,I0,A,I0,A)') ' ERROR: Field has infinite value at index ', trim(field_name), ' (', i, ',', j, ')' + field_passed = .false. + exit outer_loop_2d + end if + end do + end do outer_loop_2d + + if (field_passed) then + ! Check if sum of array is zero + if (sum(array_2d_ptr) == 0.0_fp) then + write(error_unit,'(A,A)') ' WARNING: Field has zero sum (all elements are zero): ', trim(field_name) + !field_passed = .false. + else + write(output_unit,'(A,A)') ' ✓ All array elements are finite and non-negative: ', trim(field_name) + end if + end if + else + write(error_unit,'(A,A)') ' ERROR: 2D array not associated for field: ', trim(field_name) + field_passed = .false. + end if + + case (DIAG_REAL_3D) + type_name = 'Real 3D Array' + write(output_unit,'(A,A)') ' Type: ', trim(type_name) + if (associated(array_3d_ptr)) then + write(output_unit,'(A,I0,A,I0,A,I0)') ' Array size: ', size(array_3d_ptr,1), ' x ', size(array_3d_ptr,2), ' x ', size(array_3d_ptr,3) + + ! Check each element in the 3D array + outer_loop_3d: do k = 1, size(array_3d_ptr,3) + do j = 1, size(array_3d_ptr,2) + do i = 1, size(array_3d_ptr,1) + current_value = array_3d_ptr(i,j,k) + if (is_verbose) then + write(output_unit,'(A,A,A,I0,A,I0,A,I0,A,E12.5)') ' ', trim(field_name), '[', i, ',', j, ',', k, '] = ', current_value + end if + if (current_value /= current_value) then ! NaN check + write(error_unit,'(A,A,A,I0,A,I0,A,I0,A)') ' ERROR: Field has NaN at index ', trim(field_name), ' (', i, ',', j, ',', k, ')' + field_passed = .false. + exit outer_loop_3d + else if (current_value < 0.0_fp) then + write(error_unit,'(A,A,A,I0,A,I0,A,I0,A)') ' ERROR: Field has negative value at index ', trim(field_name), ' (', i, ',', j, ',', k, ')' + field_passed = .false. + exit outer_loop_3d + else if (.not. (current_value < huge(current_value))) then ! Infinite check + write(error_unit,'(A,A,A,I0,A,I0,A,I0,A)') ' ERROR: Field has infinite value at index ', trim(field_name), ' (', i, ',', j, ',', k, ')' + field_passed = .false. + exit outer_loop_3d + end if + end do + end do + end do outer_loop_3d + + if (field_passed) then + ! Check if sum of array is zero + if (sum(array_3d_ptr) == 0.0_fp) then + write(error_unit,'(A,A)') ' WARNING: Field has zero sum (all elements are zero): ', trim(field_name) + !field_passed = .false. + else + write(output_unit,'(A,A)') ' ✓ All array elements are finite and non-negative: ', trim(field_name) + end if + end if + else + write(error_unit,'(A,A)') ' ERROR: 3D array not associated for field: ', trim(field_name) + field_passed = .false. + end if + + case (DIAG_INTEGER_SCALAR) + type_name = 'Integer Scalar' + write(output_unit,'(A,A)') ' Type: ', trim(type_name) + write(output_unit,'(A,E12.5)') ' Scalar value: ', scalar_value + if (is_verbose) then + write(output_unit,'(A,A,A,E12.5)') ' ', trim(field_name), ' = ', scalar_value + end if + + ! For integer scalar, just check if it's non-negative + if (scalar_value < 0.0_fp) then + write(error_unit,'(A,A)') ' ERROR: Integer field has negative value: ', trim(field_name) + field_passed = .false. + else + write(output_unit,'(A,A)') ' ✓ Integer field has non-negative value: ', trim(field_name) + end if + + case (DIAG_INTEGER_1D) + type_name = 'Integer 1D Array' + write(output_unit,'(A,A)') ' Type: ', trim(type_name) + if (associated(array_1d_ptr)) then + write(output_unit,'(A,I0)') ' Array size: ', size(array_1d_ptr) + + ! Check each element in the 1D integer array + do i = 1, size(array_1d_ptr) + current_value = array_1d_ptr(i) + if (is_verbose) then + write(output_unit,'(A,A,A,I0,A,E12.5)') ' ', trim(field_name), '[', i, '] = ', current_value + end if + if (current_value /= current_value) then ! NaN check + write(error_unit,'(A,A,A,I0,A)') ' ERROR: Integer field has NaN at index ', trim(field_name), ' (', i, ')' + field_passed = .false. + exit + else if (current_value < 0.0_fp) then + write(error_unit,'(A,A,A,I0,A)') ' ERROR: Integer field has negative value at index ', trim(field_name), ' (', i, ')' + field_passed = .false. + exit + end if + end do + + if (field_passed) then + ! Check if sum of array is zero + if (sum(array_1d_ptr) == 0.0_fp) then + write(error_unit,'(A,A)') ' WARNING: Integer field has zero sum (all elements are zero): ', trim(field_name) + !field_passed = .false. + else + write(output_unit,'(A,A)') ' ✓ All integer array elements are non-negative: ', trim(field_name) + end if + end if + else + write(error_unit,'(A,A)') ' ERROR: 1D integer array not associated for field: ', trim(field_name) + field_passed = .false. + end if + + case (DIAG_INTEGER_2D) + type_name = 'Integer 2D Array' + write(output_unit,'(A,A)') ' Type: ', trim(type_name) + if (associated(array_2d_ptr)) then + write(output_unit,'(A,I0,A,I0)') ' Array size: ', size(array_2d_ptr,1), ' x ', size(array_2d_ptr,2) + + ! Check each element in the 2D integer array + outer_loop_int_2d: do j = 1, size(array_2d_ptr,2) + do i = 1, size(array_2d_ptr,1) + current_value = array_2d_ptr(i,j) + if (is_verbose) then + write(output_unit,'(A,A,A,I0,A,I0,A,E12.5)') ' ', trim(field_name), '[', i, ',', j, '] = ', current_value + end if + if (current_value /= current_value) then ! NaN check + write(error_unit,'(A,A,A,I0,A,I0,A)') ' ERROR: Integer field has NaN at index ', trim(field_name), ' (', i, ',', j, ')' + field_passed = .false. + exit outer_loop_int_2d + else if (current_value < 0.0_fp) then + write(error_unit,'(A,A,A,I0,A,I0,A)') ' ERROR: Integer field has negative value at index ', trim(field_name), ' (', i, ',', j, ')' + field_passed = .false. + exit outer_loop_int_2d + end if + end do + end do outer_loop_int_2d + + if (field_passed) then + ! Check if sum of array is zero + if (sum(array_2d_ptr) == 0.0_fp) then + write(error_unit,'(A,A)') ' WARNING: Integer field has zero sum (all elements are zero): ', trim(field_name) + !field_passed = .false. + else + write(output_unit,'(A,A)') ' ✓ All integer array elements are non-negative: ', trim(field_name) + end if + end if + else + write(error_unit,'(A,A)') ' ERROR: 2D integer array not associated for field: ', trim(field_name) + field_passed = .false. + end if + + case (DIAG_INTEGER_3D) + type_name = 'Integer 3D Array' + write(output_unit,'(A,A)') ' Type: ', trim(type_name) + if (associated(array_3d_ptr)) then + write(output_unit,'(A,I0,A,I0,A,I0)') ' Array size: ', size(array_3d_ptr,1), ' x ', size(array_3d_ptr,2), ' x ', size(array_3d_ptr,3) + + ! Check each element in the 3D integer array + outer_loop_int_3d: do k = 1, size(array_3d_ptr,3) + do j = 1, size(array_3d_ptr,2) + do i = 1, size(array_3d_ptr,1) + current_value = array_3d_ptr(i,j,k) + if (is_verbose) then + write(output_unit,'(A,A,A,I0,A,I0,A,I0,A,E12.5)') ' ', trim(field_name), '[', i, ',', j, ',', k, '] = ', current_value + end if + if (current_value /= current_value) then ! NaN check + write(error_unit,'(A,A,A,I0,A,I0,A,I0,A)') ' ERROR: Integer field has NaN at index ', trim(field_name), ' (', i, ',', j, ',', k, ')' + field_passed = .false. + exit outer_loop_int_3d + else if (current_value < 0.0_fp) then + write(error_unit,'(A,A,A,I0,A,I0,A,I0,A)') ' ERROR: Integer field has negative value at index ', trim(field_name), ' (', i, ',', j, ',', k, ')' + field_passed = .false. + exit outer_loop_int_3d + end if + end do + end do + end do outer_loop_int_3d + + if (field_passed) then + ! Check if sum of array is zero + if (sum(array_3d_ptr) == 0.0_fp) then + write(error_unit,'(A,A)') ' WARNING: Integer field has zero sum (all elements are zero): ', trim(field_name) + !field_passed = .false. + else + write(output_unit,'(A,A)') ' ✓ All integer array elements are non-negative: ', trim(field_name) + end if + end if + else + write(error_unit,'(A,A)') ' ERROR: 3D integer array not associated for field: ', trim(field_name) + field_passed = .false. + end if + + case default + type_name = 'Unknown Type' + write(output_unit,'(A,A)') ' Type: ', trim(type_name) + write(error_unit,'(A,A)') ' ERROR: Unsupported data type for field: ', trim(field_name) + field_passed = .false. + return + end select + + ! Update overall validation status + if (.not. field_passed) then + validation_passed = .false. + end if + + end subroutine validate_field_by_type + +end program test_settling_integration diff --git a/tests/process/settling/unit/test_settling_unit.F90 b/tests/process/settling/unit/test_settling_unit.F90 new file mode 100644 index 00000000..a06f8369 --- /dev/null +++ b/tests/process/settling/unit/test_settling_unit.F90 @@ -0,0 +1,151 @@ +!> \file test_settling_unit.F90 +!! \brief Unit tests for settling process +!! +!! This file contains unit tests for the settling process implementation +!! following the same pattern as core tests like test_ConfigManager.F90 +!! Generated on: 2025-12-18T14:12:33.147744 + +program test_settling_unit + use testing_mod, only: assert, assert_close + use precision_mod, only: fp + use error_mod, only: CC_SUCCESS, CC_FAILURE, ErrorManagerType + use StateManager_Mod, only: StateManagerType + use GridManager_Mod, only: GridManagerType + use ProcessSettlingInterface_Mod, only: ProcessSettlingInterface + use SettlingCommon_Mod, only: SettlingConfig + + implicit none + + type(ProcessSettlingInterface) :: settling_process + type(StateManagerType) :: state_mgr + type(ErrorManagerType) :: error_mgr + type(GridManagerType) :: grid_mgr + integer :: rc + + write(*,*) 'Testing Settling Process module...' + write(*,*) '' + + ! Test 1: Initialize error manager + write(*,*) 'Test 1: Initialize error manager' + call error_mgr%init() + + write(*,*) 'Test 1 passed!' + write(*,*) '' + + ! Test 2: Initialize grid manager + write(*,*) 'Test 2: Initialize grid manager' + call grid_mgr%init(1, 1, 10, error_mgr, rc=rc) ! 1x1 grid, 10 levels for testing + call assert(rc == CC_SUCCESS, "GridManager initialization should succeed") + + write(*,*) 'Test 2 passed!' + write(*,*) '' + + ! Test 3: Initialize state manager + write(*,*) 'Test 3: Initialize state manager' + call state_mgr%init('TestSettlingStateManager', rc) + call assert(rc == CC_SUCCESS, "StateManager initialization should succeed") + + write(*,*) 'Test 3 passed!' + write(*,*) '' + + ! Test 4: Settling configuration creation and defaults + write(*,*) 'Test 4: Settling configuration creation and defaults' + call test_settling_config_defaults() + + write(*,*) 'Test 4 passed!' + write(*,*) '' + + ! Test 5: Settling configuration validation + write(*,*) 'Test 5: Settling configuration validation' + call test_settling_config_validation() + + write(*,*) 'Test 5 passed!' + write(*,*) '' + + ! Test 6: Settling scheme configuration + write(*,*) 'Test 6: Settling scheme configuration' + call test_scheme_configuration() + + write(*,*) 'Test 6 passed!' + write(*,*) '' + + ! Test 7: ProcessSettlingInterface creation + write(*,*) 'Test 7: ProcessSettlingInterface creation' + call test_process_interface_creation() + + write(*,*) 'Test 7 passed!' + write(*,*) '' + + ! Test 8: Process interface methods exist (without full initialization) + write(*,*) 'Test 8: Process interface methods exist' + call test_process_interface_methods() + + write(*,*) 'Test 8 passed!' + write(*,*) '' + write(*,*) 'All Settling unit tests completed successfully!' + +contains + + !> Test Settling configuration default values + subroutine test_settling_config_defaults() + type(SettlingConfig) :: config + + ! Test default values are correctly set + call assert(config%is_active .eqv. .true., "Default is_active should be true") + call assert(len_trim(config%scheme) > 0, "Default scheme should be set") + call assert(config%n_species == 0, "Default n_species should be 0") + call assert(config%diagnostics .eqv. .false., "Default diagnostics should be false") + + end subroutine test_settling_config_defaults + + !> Test Settling configuration validation + subroutine test_settling_config_validation() + type(SettlingConfig) :: config + type(ErrorManagerType) :: error_manager + + ! Test validation of default configuration + call config%validate(error_manager) + call assert(.true., "Default configuration validation completed") + + ! Test validation of different schemes + config%scheme = 'gocart' + call config%validate(error_manager) + call assert(.true., "GOCART scheme validation completed") + + + end subroutine test_settling_config_validation + + !> Test scheme configuration + subroutine test_scheme_configuration() + type(SettlingConfig) :: config + type(ErrorManagerType) :: error_manager + + ! Test valid schemes + config%scheme = 'gocart' + call config%validate(error_manager) + call assert(.true., "GOCART scheme validation completed") + + config%scheme = 'invalid_scheme' + call config%validate(error_manager) + call assert(.true., "Invalid scheme validation completed") + + + ! Cleanup configuration + call config%finalize() + + end subroutine test_scheme_configuration + + !> Test ProcessSettlingInterface can be created + subroutine test_process_interface_creation() + ! Test that we can create the interface object + call assert(.true., "ProcessSettlingInterface object created successfully") + end subroutine test_process_interface_creation + + !> Test ProcessSettlingInterface has required methods (without calling them) + subroutine test_process_interface_methods() + ! Test that the interface has the expected methods by checking if it's ready + ! (this doesn't call init, just checks the initial state) + call assert(.not. settling_process%is_ready(), "Process should not be ready before initialization") + end subroutine test_process_interface_methods + +end program test_settling_unit diff --git a/tests/process/wetdep/CMakeLists.txt b/tests/process/wetdep/CMakeLists.txt new file mode 100644 index 00000000..df2b141d --- /dev/null +++ b/tests/process/wetdep/CMakeLists.txt @@ -0,0 +1,148 @@ +# CMakeLists.txt for wetdep process tests +# Generated on: 2025-12-15T16:30:33.913416 + +cmake_minimum_required(VERSION 3.12) + +# Test executables +set( + TEST_SOURCES + unit/test_wetdep_unit.F90 + integration/test_wetdep_integration.F90 +) + +# Create test executables +foreach(test_source ${TEST_SOURCES}) + get_filename_component(test_name ${test_source} NAME_WE) + + add_executable(${test_name} ${test_source}) + + # Link against process modules + target_link_libraries( + ${test_name} + CATChem_process_wetdep + CATChem_core + testing + ) + + # Set Fortran module directory + set_target_properties( + ${test_name} + PROPERTIES Fortran_MODULE_DIRECTORY "${CMAKE_CURRENT_BINARY_DIR}/modules" + ) + + # Add include directories for module files + target_include_directories( + ${test_name} + PRIVATE "${CMAKE_BINARY_DIR}/include" "${CMAKE_CURRENT_BINARY_DIR}/modules" + ) + + # Add to test suite + add_test(NAME ${test_name} COMMAND ${test_name}) + + # Set test properties + set_tests_properties( + ${test_name} + PROPERTIES TIMEOUT 60 WORKING_DIRECTORY "${CMAKE_CURRENT_BINARY_DIR}" + ) +endforeach() + +# Test data files +configure_file( + "${CMAKE_SOURCE_DIR}/tests/Configs/Default/CATChem_new_config.yml" + "${CMAKE_CURRENT_BINARY_DIR}/wetdep_config.yaml" + COPYONLY +) + +# Additional test data files - copy other config files that might be needed +file(GLOB TEST_DATA_FILES "${CMAKE_SOURCE_DIR}/tests/Configs/Default/*.yml") +foreach(test_data_file ${TEST_DATA_FILES}) + get_filename_component(filename ${test_data_file} NAME) + configure_file( + "${test_data_file}" + "${CMAKE_CURRENT_BINARY_DIR}/${filename}" + COPYONLY + ) +endforeach() + +# Custom test targets with unique names +add_custom_target( + run_wetdep_unit + COMMAND test_wetdep_unit + DEPENDS test_wetdep_unit + WORKING_DIRECTORY "${CMAKE_CURRENT_BINARY_DIR}" + COMMENT "Running unit tests for wetdep process" +) + +add_custom_target( + run_wetdep_integration + COMMAND test_wetdep_integration + DEPENDS test_wetdep_integration + WORKING_DIRECTORY "${CMAKE_CURRENT_BINARY_DIR}" + COMMENT "Running integration tests for wetdep process" +) + +add_custom_target( + run_wetdep_all + DEPENDS run_wetdep_unit run_wetdep_integration + COMMENT "Running all tests for wetdep process" +) + +# Test coverage (if available) +if(CODE_COVERAGE) + find_program(GCOV_PATH gcov) + find_program(LCOV_PATH lcov) + find_program(GENHTML_PATH genhtml) + + if(GCOV_PATH AND LCOV_PATH AND GENHTML_PATH) + # Add coverage flags + set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} --coverage") + set(CMAKE_EXE_LINKER_FLAGS "${CMAKE_EXE_LINKER_FLAGS} --coverage") + + # Coverage target + add_custom_target( + coverage_wetdep + COMMAND + ${LCOV_PATH} --directory . --capture --output-file coverage_wetdep.info + COMMAND + ${LCOV_PATH} --remove coverage_wetdep.info '/usr/*' --output-file + coverage_wetdep.info + COMMAND ${GENHTML_PATH} -o coverage_wetdep_html coverage_wetdep.info + DEPENDS run_wetdep_all + WORKING_DIRECTORY "${CMAKE_CURRENT_BINARY_DIR}" + COMMENT "Generating test coverage report for wetdep process" + ) + endif() +endif() + +# Performance benchmarks +add_custom_target( + benchmark_wetdep + DEPENDS run_wetdep_integration + WORKING_DIRECTORY "${CMAKE_CURRENT_BINARY_DIR}" + COMMENT "Running performance benchmarks for wetdep process" +) + +# Memory checking with valgrind (if available) +find_program(VALGRIND_PATH valgrind) +if(VALGRIND_PATH) + add_custom_target( + memcheck_wetdep + COMMAND + ${VALGRIND_PATH} --tool=memcheck --leak-check=full --show-leak-kinds=all + --track-origins=yes ./test_wetdep_integration + DEPENDS test_wetdep_integration + WORKING_DIRECTORY "${CMAKE_CURRENT_BINARY_DIR}" + COMMENT "Running memory check for wetdep process" + ) +endif() + +# Install test executables (optional) +if(INSTALL_TESTS) + install(TARGETS ${TEST_SOURCES} RUNTIME DESTINATION bin/tests) + + install( + FILES "${CMAKE_SOURCE_DIR}/tests/Configs/Default/CATChem_new_config.yml" + DESTINATION share/tests/wetdep + RENAME wetdep_config.yaml + ) +endif() diff --git a/tests/process/wetdep/integration/test_wetdep_integration.F90 b/tests/process/wetdep/integration/test_wetdep_integration.F90 new file mode 100644 index 00000000..784a85f2 --- /dev/null +++ b/tests/process/wetdep/integration/test_wetdep_integration.F90 @@ -0,0 +1,785 @@ +!> \file test_wetdep_integration.F90 +!! \brief Comprehensive integration tests for wetdep process using CATChemCore +!! +!! This file contains comprehensive integration tests for the wetdep process implementation +!! using the centralized CATChemCore framework. Tests complete workflow: core initialization, +!! configuration loading, process registration, and all scheme validation. +!! Generated on: 2025-12-15T16:30:33.888881 + +program test_wetdep_integration + use precision_mod, only: fp + use iso_fortran_env, only: output_unit, error_unit + use error_mod, only: CC_SUCCESS, CC_FAILURE, ErrorManagerType, ERROR_UNSUPPORTED_OPERATION + use CATChemCore_Mod, only: CATChemCoreType, CATChemBuilderType + use StateManager_Mod, only: StateManagerType + use ProcessManager_Mod, only: ProcessManagerType + use GridManager_Mod, only: GridManagerType + use DiagnosticManager_Mod, only: DiagnosticManagerType + use MetState_Mod, only: MetStateType + use ChemState_Mod, only: ChemStateType + use ConfigManager_Mod, only: ConfigManagerType + use ProcessWetDepInterface_Mod, only: ProcessWetDepInterface + use WetDepProcessCreator_Mod, only: register_wetdep_process + use WetDepCommon_Mod, only: WetDepProcessConfig + use DiagnosticInterface_Mod, only: DiagnosticRegistryType, DiagnosticFieldType, & + DIAG_REAL_SCALAR, DIAG_REAL_1D, DIAG_REAL_2D, DIAG_REAL_3D, & + DIAG_INTEGER_SCALAR, DIAG_INTEGER_1D, DIAG_INTEGER_2D, DIAG_INTEGER_3D + + implicit none + + ! Core framework + type(CATChemCoreType) :: core + type(CATChemBuilderType) :: builder + type(ProcessManagerType), pointer :: process_mgr_ptr + + ! Configuration file path + character(len=*), parameter :: config_file = './CATChem_new_config.yml' + + ! Test parameters for realistic deposition scenario + integer, parameter :: n_columns = 10 ! Grid columns + integer, parameter :: n_levels = 20 ! Vertical levels (surface to ~20 km) + integer, parameter :: n_time_steps = 5 ! Multiple timesteps for integration testing + real(fp), parameter :: dt = 3600.0_fp ! 1 hour timestep + + ! Test schemes + character(len=20) :: schemes(1) + + integer :: rc, i_scheme, i_time + logical :: all_tests_passed = .true. + + ! Initialize scheme array + schemes = [ & + 'jacob '] + + write(output_unit,'(A)') '==================================' + write(output_unit,'(A)') '=== WETDEP INTEGRATION TESTS ===' + write(output_unit,'(A)') '==================================' + write(output_unit,'(A)') 'Using CATChemCore for comprehensive testing with' + write(output_unit,'(A)') 'configuration, meteorological data, and all scheme validation' + write(output_unit,'(A)') '' + + ! Step 1: Initialize CATChem Core with proper grid dimensions + write(output_unit,'(A)') 'Step 1: Initializing CATChem Core...' + + call builder%init() + builder = builder%with_name('WetDepIntegrationTest') + builder = builder%with_config(config_file) + builder = builder%with_grid(n_columns, 1, n_levels) + builder = builder%with_verbose() + call builder%build(core, rc) + + if (rc /= CC_SUCCESS) then + write(error_unit,'(A)') 'ERROR: CATChemCore initialization/configuration failed' + all_tests_passed = .false. + goto 999 + end if + write(output_unit,'(A,I0,A,I0,A)') ' ✓ CATChemCore initialized: ', n_columns, ' columns, ', n_levels, ' levels' + write(output_unit,'(A)') ' ✓ Configuration loaded and all managers set up' + + ! Register wetdep processes with ProcessFactory + process_mgr_ptr => core%get_process_manager() + call register_wetdep_process(process_mgr_ptr, rc) + if (rc /= CC_SUCCESS) then + write(error_unit,'(A)') 'ERROR: Failed to register wetdep processes with ProcessFactory' + all_tests_passed = .false. + goto 999 + end if + write(output_unit,'(A)') ' ✓ WetDep processes registered with ProcessFactory' + + ! Step 2: Set up realistic meteorological conditions + write(output_unit,'(A)') '' + write(output_unit,'(A)') 'Step 2: Setting up realistic meteorological conditions...' + call setup_met(core, rc) + if (rc /= CC_SUCCESS) then + write(error_unit,'(A)') 'ERROR: Failed to set up meteorological conditions' + all_tests_passed = .false. + goto 999 + end if + write(output_unit,'(A)') ' ✓ Meteorological conditions configured' + + ! Step 3: Testing wetdep process with all schemes + write(output_unit,'(A)') '' + write(output_unit,'(A)') 'Step 3: Testing wetdep process with all schemes...' + + ! Add wetdep process for scheme testing + call core%add_process('wetdep', rc) + if (rc /= CC_SUCCESS) then + write(error_unit,'(A)') 'ERROR: Failed to add wetdep process for scheme testing' + all_tests_passed = .false. + goto 999 + end if + write(output_unit,'(A)') ' ✓ WetDep process added successfully' + + write(output_unit,'(A)') '' + write(output_unit,'(A)') ' Testing multiple wetdep schemes...' + do i_scheme = 1, size(schemes) + write(output_unit,'(A,A,A)') ' Testing ', trim(schemes(i_scheme)), ' scheme...' + + call test_scheme(core, schemes(i_scheme), rc) + if (rc /= CC_SUCCESS) then + write(output_unit,'(A,A)') ' ✗ ', trim(schemes(i_scheme)), ' scheme test failed' + write(error_unit,'(A,A)') 'ERROR: Scheme test failed for ', trim(schemes(i_scheme)) + all_tests_passed = .false. + else + write(output_unit,'(A,A)') ' ✓ ', trim(schemes(i_scheme)), ' scheme test passed' + end if + end do + write(output_unit,'(A)') ' ✓ All scheme tests completed' + + ! Step 4: Test multi-timestep stability + write(output_unit,'(A)') '' + write(output_unit,'(A)') 'Step 4: Testing multi-timestep stability...' + write(output_unit,'(A,I0,A)') ' Running ', n_time_steps, ' timestep integration test...' + + + do i_time = 1, n_time_steps + call core%run_timestep(i_time, dt, rc) + if (rc /= CC_SUCCESS) then + write(error_unit,'(A,I0)') 'ERROR: Timestep ', i_time, ' failed' + all_tests_passed = .false. + exit + end if + end do + + if (all_tests_passed) then + write(output_unit,'(A,I0,A)') ' ✓ All ', n_time_steps, ' timesteps completed successfully' + write(output_unit,'(A)') ' - WetDep process stability verified' + write(output_unit,'(A)') ' - Multi-timestep conservation maintained' + end if + + ! Final validation and cleanup + write(output_unit,'(A)') '' + write(output_unit,'(A)') 'Final validation and cleanup...' + call core%finalize(rc) + if (rc /= CC_SUCCESS) then + write(error_unit,'(A)') 'WARNING: Core finalization had issues' + end if + +999 continue + + ! Print final results + write(output_unit,'(A)') '' + write(output_unit,'(A)') '==================================' + if (all_tests_passed) then + write(output_unit,'(A)') '=== ALL WETDEP TESTS PASSED! ===' + write(output_unit,'(A)') '=== Integration test successful ===' + else + write(output_unit,'(A)') '=== SOME WETDEP TESTS FAILED ===' + write(output_unit,'(A)') '=== Check error messages above ===' + end if + write(output_unit,'(A)') '==================================' + + if (.not. all_tests_passed) stop 1 + +contains + + !> Set up realistic meteorological conditions for wetdep testing + subroutine setup_met(core_arg, rc_arg) + type(CATChemCoreType), intent(inout) :: core_arg + integer, intent(out) :: rc_arg + + type(StateManagerType), pointer :: state_mgr + type(MetStateType), pointer :: met_state + type(GridManagerType), pointer :: grid_mgr + integer :: nx, ny, nz, i, j, k + real(fp) :: lat, wind_speed, altitude_km, edge_altitude_km + + rc_arg = CC_SUCCESS + + ! Get managers and state pointers + state_mgr => core_arg%get_state_manager() + met_state => state_mgr%get_met_state_ptr() + grid_mgr => core_arg%get_grid_manager() + + ! Get grid dimensions + call grid_mgr%get_shape(nx, ny, nz) + + ! Allocate categorical arrays with standard dimensions + + ! Set realistic conditions for wetdep processes + do j = 1, ny + ! Calculate latitude for realistic gradients + lat = -30.0_fp + (j-1) * 60.0_fp / max(1, ny-1) ! -30°S to 30°N + do i = 1, nx + + end do + end do + + ! Set up 3D atmospheric fields (nx, ny, nz) + do j = 1, ny + do i = 1, nx + do k = 1, nz + ! Calculate height-dependent values + ! Approximate altitude in km (assuming ~1 km per level near surface) + altitude_km = real(k-1, fp) * 1.0_fp + met_state%T(i,j,k) = 288.15_fp - 6.5_fp * altitude_km ! Temperature lapse rate [K] + met_state%AIRDEN_DRY(i,j,k) = 1.2_fp * exp(-altitude_km / 8.0_fp) ! Dry air density [kg/m3] + met_state%MAIRDEN(i,j,k) = met_state%AIRDEN_DRY(i,j,k) * 1.01_fp ! Moist air density [kg/m3] + met_state%REEVAPLS(i,j,k) = 1.0e-6_fp * (1.0_fp + 0.1_fp * altitude_km) ! Evaporation of large-scale precipitation [kg/kg/s] + end do + end do + end do + ! Set up pressure edge arrays (nx, ny, nz+1) + do j = 1, ny + do i = 1, nx + do k = 1, nz+1 + edge_altitude_km = real(k-1, fp) * 1.0_fp - 0.5_fp + met_state%PEDGE(i,j,k) = 101300.25_fp * exp(-edge_altitude_km / 8.0_fp) ! Pressure at edges [Pa] + met_state%PFILSAN(i,j,k) = 1.0e-3_fp * (1.0_fp + 0.2_fp * edge_altitude_km) ! Ice precip flux: LS+anvil [kg/m2/s] + met_state%PFLLSAN(i,j,k) = 1.5e-3_fp * (1.0_fp + 0.15_fp * edge_altitude_km) ! Liquid precip flux: LS+anvil [kg/m2/s] + end do + end do + end do + + + + + end subroutine setup_met + + !> Test a specific wetdep scheme with comprehensive validation + subroutine test_scheme(core_arg, scheme_name, rc_arg) + type(CATChemCoreType), intent(inout) :: core_arg + character(len=*), intent(in) :: scheme_name + integer, intent(out) :: rc_arg + + type(ProcessManagerType), pointer :: process_mgr + type(StateManagerType), pointer :: state_mgr + type(ProcessWetDepInterface), pointer :: wetdep_interface + type(ConfigManagerType), pointer :: config_mgr + type(ErrorManagerType), pointer :: error_mgr + + rc_arg = CC_SUCCESS + + ! Get process manager and state manager + process_mgr => core_arg%get_process_manager() + state_mgr => core_arg%get_state_manager() + + ! Get wetdep process interface + wetdep_interface => null() + select type(process => process_mgr%processes(1)%item) + type is (ProcessWetDepInterface) + wetdep_interface => process + end select + + if (.not. associated(wetdep_interface)) then + rc_arg = CC_FAILURE + return + end if + + ! Step 1: Set the timestep for process calculations + call wetdep_interface%set_timestep(dt) + + ! Step 2: Set the scheme + call wetdep_interface%set_scheme(scheme_name) + + ! Step 3: Reload scheme-specific configuration + config_mgr => state_mgr%get_config_ptr() + error_mgr => state_mgr%get_error_manager() + + if (.not. associated(config_mgr)) then + call error_mgr%report_error(1003, & + 'ConfigManager not available from StateManager', rc_arg) + return + end if + + if (.not. associated(error_mgr)) then + rc_arg = CC_FAILURE + return + end if + + ! Call the scheme-specific loading function directly + select case (trim(scheme_name)) + case ('jacob') + call wetdep_interface%process_config%load_jacob_config(config_mgr, error_mgr) + case default + call error_mgr%report_error(1004, & + 'Unknown scheme: ' // trim(scheme_name), rc_arg) + return + end select + + + ! Step 3: Reset diagnostics for the new scheme + call reset_diagnostics_for_scheme(wetdep_interface, state_mgr, scheme_name, rc_arg) + if (rc_arg /= CC_SUCCESS) return + + ! Step 4: Run the process to populate diagnostic data + call process_mgr%run_column_processes(state_mgr, rc_arg) + if (rc_arg /= CC_SUCCESS) return + + ! Step 5: Validate all results + call validate_results(core_arg, rc_arg) + + end subroutine test_scheme + + !> Reset diagnostics for a specific scheme (test-specific function) + !! This function handles diagnostic reset when switching between schemes during testing + subroutine reset_diagnostics_for_scheme(wetdep_interface, container, scheme_name, rc_arg) + type(ProcessWetDepInterface), intent(inout) :: wetdep_interface + type(StateManagerType), intent(inout) :: container + character(len=*), intent(in) :: scheme_name + integer, intent(out) :: rc_arg + + type(DiagnosticManagerType), pointer :: diag_mgr + type(ErrorManagerType), pointer :: error_mgr + character(len=64) :: current_scheme + + rc_arg = CC_SUCCESS + + ! Get managers + diag_mgr => container%get_diagnostic_manager() + error_mgr => container%get_error_manager() + + ! Get current scheme + current_scheme = wetdep_interface%get_scheme() + + ! Remove existing process registration (this clears all diagnostic fields) + call diag_mgr%remove_process('wetdep', rc_arg) + if (rc_arg /= CC_SUCCESS) then + call error_mgr%report_error(ERROR_UNSUPPORTED_OPERATION, & + 'Failed to remove existing diagnostics for wetdep process', rc_arg) + ! Continue anyway - this might be the first registration + rc_arg = CC_SUCCESS + endif + + ! Re-register diagnostics for the new scheme + ! The scheme-specific configuration should already be set correctly + call wetdep_interface%register_diagnostics(container, rc_arg) + if (rc_arg /= CC_SUCCESS) then + call error_mgr%report_error(ERROR_UNSUPPORTED_OPERATION, & + 'Failed to re-register diagnostics for scheme: ' // & + trim(current_scheme), rc_arg) + return + endif + + end subroutine reset_diagnostics_for_scheme + + !> Validate the results of the integration test with comprehensive diagnostic checking + subroutine validate_results(core_arg, rc_arg) + type(CATChemCoreType), intent(inout) :: core_arg + integer, intent(out) :: rc_arg + + type(DiagnosticManagerType), pointer :: diag_mgr + type(DiagnosticRegistryType), pointer :: wetdep_registry + character(len=64), allocatable :: field_names(:) + integer :: num_fields, i, local_rc, data_type + real(fp) :: scalar_value + real(fp), pointer :: array_1d_ptr(:) => null() + real(fp), pointer :: array_2d_ptr(:,:) => null() + real(fp), pointer :: array_3d_ptr(:,:,:) => null() + logical :: validation_passed + character(len=64) :: field_name + character(len=20) :: type_name + + rc_arg = CC_SUCCESS + validation_passed = .true. + + write(output_unit,'(A)') ' Validating wetdep emission results...' + + ! Use core validation first + if (.not. core_arg%validate()) then + write(error_unit,'(A)') ' ERROR: Core validation failed' + rc_arg = CC_FAILURE + return + end if + write(output_unit,'(A)') ' ✓ Core validation passed' + + ! Get DiagnosticManager from core + diag_mgr => core_arg%get_diagnostic_manager() + if (.not. associated(diag_mgr)) then + write(error_unit,'(A)') ' ERROR: Could not get DiagnosticManager from core' + rc_arg = CC_FAILURE + return + end if + + ! Get the wetdep process diagnostic registry + call diag_mgr%get_process_registry('wetdep', wetdep_registry, local_rc) + if (local_rc /= CC_SUCCESS .or. .not. associated(wetdep_registry)) then + write(error_unit,'(A)') ' ERROR: Could not get wetdep process registry' + rc_arg = CC_FAILURE + return + end if + + ! Get the number of registered diagnostic fields + num_fields = wetdep_registry%get_field_count() + write(output_unit,'(A,I0,A)') ' Found ', num_fields, ' registered diagnostic fields for wetdep process' + + if (num_fields == 0) then + write(error_unit,'(A)') ' ERROR: No diagnostic fields registered for wetdep process' + rc_arg = CC_FAILURE + return + end if + + ! Allocate array for field names + allocate(field_names(num_fields)) + + ! Get all field names + call wetdep_registry%list_fields(field_names, num_fields) + + ! Iterate through all diagnostic fields and validate them + write(output_unit,'(A)') ' Validating all registered diagnostic fields:' + + do i = 1, num_fields + field_name = trim(field_names(i)) + write(output_unit,'(A,I0,A,A)') ' Field ', i, ': ', trim(field_name) + + ! Get field values and type information directly from DiagnosticManager + call diag_mgr%get_field_value('wetdep', field_name, & + scalar_value=scalar_value, & + array_1d_ptr=array_1d_ptr, & + array_2d_ptr=array_2d_ptr, & + array_3d_ptr=array_3d_ptr, & + data_type=data_type, & + rc=local_rc) + if (local_rc /= CC_SUCCESS) then + write(error_unit,'(A,A)') ' WARNING: Could not retrieve field value: ', trim(field_name) + validation_passed = .false. + cycle + end if + + ! Convert data type to readable name and validate values + call validate_field_by_type(field_name, data_type, scalar_value, & + array_1d_ptr, array_2d_ptr, array_3d_ptr, validation_passed, verbose=.false.) + + end do + + ! Clean up + deallocate(field_names) + + ! Final validation result + if (.not. validation_passed) then + write(error_unit,'(A)') ' VALIDATION FAILED: Some wetdep diagnostics failed validation' + rc_arg = CC_FAILURE + else + write(output_unit,'(A)') ' ✓ All wetdep diagnostic validations passed' + write(output_unit,'(A,I0,A)') ' - ', num_fields, ' diagnostic fields validated' + write(output_unit,'(A)') ' - All emission values are positive' + write(output_unit,'(A)') ' - Diagnostic system is functioning correctly' + end if + + end subroutine validate_results + + !> Validate field values based on type and emission expectations + subroutine validate_field_by_type(field_name, data_type, scalar_value, & + array_1d_ptr, array_2d_ptr, array_3d_ptr, validation_passed, verbose) + character(len=*), intent(in) :: field_name + integer, intent(in) :: data_type + real(fp), intent(in) :: scalar_value + real(fp), pointer, intent(in) :: array_1d_ptr(:) + real(fp), pointer, intent(in) :: array_2d_ptr(:,:) + real(fp), pointer, intent(in) :: array_3d_ptr(:,:,:) + logical, intent(inout) :: validation_passed + logical, intent(in), optional :: verbose + + logical :: field_passed + logical :: is_verbose = .false. + character(len=20) :: type_name + integer :: i, j, k + real(fp) :: current_value + + ! Set verbose mode + if (present(verbose)) is_verbose = verbose + ! Explicitly initialize field_passed for each call + field_passed = .true. + + ! Convert data type to readable name and validate values + select case (data_type) + case (DIAG_REAL_SCALAR) + type_name = 'Real Scalar' + write(output_unit,'(A,A)') ' Type: ', trim(type_name) + write(output_unit,'(A,E12.5)') ' Scalar value: ', scalar_value + if (is_verbose) then + write(output_unit,'(A,A,A,E12.5)') ' ', trim(field_name), ' = ', scalar_value + end if + + ! Check if scalar value is finite and non-negative + if (scalar_value /= scalar_value) then ! NaN check + write(error_unit,'(A,A)') ' ERROR: Field has NaN value: ', trim(field_name) + field_passed = .false. + else if (scalar_value < 0.0_fp) then + write(error_unit,'(A,A)') ' ERROR: Field has negative value: ', trim(field_name) + field_passed = .false. + else if (.not. (scalar_value < huge(scalar_value))) then ! Infinite check + write(error_unit,'(A,A)') ' ERROR: Field has infinite value: ', trim(field_name) + field_passed = .false. + else + write(output_unit,'(A,A)') ' ✓ Field has valid finite non-negative value: ', trim(field_name) + end if + + case (DIAG_REAL_1D) + type_name = 'Real 1D Array' + write(output_unit,'(A,A)') ' Type: ', trim(type_name) + if (associated(array_1d_ptr)) then + write(output_unit,'(A,I0)') ' Array size: ', size(array_1d_ptr) + + ! Check each element in the 1D array + do i = 1, size(array_1d_ptr) + current_value = array_1d_ptr(i) + if (is_verbose) then + write(output_unit,'(A,A,A,I0,A,E12.5)') ' ', trim(field_name), '[', i, '] = ', current_value + end if + if (current_value /= current_value) then ! NaN check + write(error_unit,'(A,A,A,I0,A)') ' ERROR: Field has NaN at index ', trim(field_name), ' (', i, ')' + field_passed = .false. + exit + else if (current_value < 0.0_fp) then + write(error_unit,'(A,A,A,I0,A)') ' ERROR: Field has negative value at index ', trim(field_name), ' (', i, ')' + field_passed = .false. + exit + else if (.not. (current_value < huge(current_value))) then ! Infinite check + write(error_unit,'(A,A,A,I0,A)') ' ERROR: Field has infinite value at index ', trim(field_name), ' (', i, ')' + field_passed = .false. + exit + end if + end do + + if (field_passed) then + ! Check if sum of array is zero + if (sum(array_1d_ptr) == 0.0_fp) then + write(error_unit,'(A,A)') ' WARNING: Field has zero sum (all elements are zero): ', trim(field_name) + !field_passed = .false. + else + write(output_unit,'(A,A)') ' ✓ All array elements are finite and non-negative: ', trim(field_name) + end if + end if + else + write(error_unit,'(A,A)') ' ERROR: 1D array not associated for field: ', trim(field_name) + field_passed = .false. + end if + + case (DIAG_REAL_2D) + type_name = 'Real 2D Array' + write(output_unit,'(A,A)') ' Type: ', trim(type_name) + if (associated(array_2d_ptr)) then + write(output_unit,'(A,I0,A,I0)') ' Array size: ', size(array_2d_ptr,1), ' x ', size(array_2d_ptr,2) + + ! Check each element in the 2D array + outer_loop_2d: do j = 1, size(array_2d_ptr,2) + do i = 1, size(array_2d_ptr,1) + current_value = array_2d_ptr(i,j) + if (is_verbose) then + write(output_unit,'(A,A,A,I0,A,I0,A,E12.5)') ' ', trim(field_name), '[', i, ',', j, '] = ', current_value + end if + if (current_value /= current_value) then ! NaN check + write(error_unit,'(A,A,A,I0,A,I0,A)') ' ERROR: Field has NaN at index ', trim(field_name), ' (', i, ',', j, ')' + field_passed = .false. + exit outer_loop_2d + else if (current_value < 0.0_fp) then + write(error_unit,'(A,A,A,I0,A,I0,A)') ' ERROR: Field has negative value at index ', trim(field_name), ' (', i, ',', j, ')' + field_passed = .false. + exit outer_loop_2d + else if (.not. (current_value < huge(current_value))) then ! Infinite check + write(error_unit,'(A,A,A,I0,A,I0,A)') ' ERROR: Field has infinite value at index ', trim(field_name), ' (', i, ',', j, ')' + field_passed = .false. + exit outer_loop_2d + end if + end do + end do outer_loop_2d + + if (field_passed) then + ! Check if sum of array is zero + if (sum(array_2d_ptr) == 0.0_fp) then + write(error_unit,'(A,A)') ' WARNING: Field has zero sum (all elements are zero): ', trim(field_name) + !field_passed = .false. + else + write(output_unit,'(A,A)') ' ✓ All array elements are finite and non-negative: ', trim(field_name) + end if + end if + else + write(error_unit,'(A,A)') ' ERROR: 2D array not associated for field: ', trim(field_name) + field_passed = .false. + end if + + case (DIAG_REAL_3D) + type_name = 'Real 3D Array' + write(output_unit,'(A,A)') ' Type: ', trim(type_name) + if (associated(array_3d_ptr)) then + write(output_unit,'(A,I0,A,I0,A,I0)') ' Array size: ', size(array_3d_ptr,1), ' x ', size(array_3d_ptr,2), ' x ', size(array_3d_ptr,3) + + ! Check each element in the 3D array + outer_loop_3d: do k = 1, size(array_3d_ptr,3) + do j = 1, size(array_3d_ptr,2) + do i = 1, size(array_3d_ptr,1) + current_value = array_3d_ptr(i,j,k) + if (is_verbose) then + write(output_unit,'(A,A,A,I0,A,I0,A,I0,A,E12.5)') ' ', trim(field_name), '[', i, ',', j, ',', k, '] = ', current_value + end if + if (current_value /= current_value) then ! NaN check + write(error_unit,'(A,A,A,I0,A,I0,A,I0,A)') ' ERROR: Field has NaN at index ', trim(field_name), ' (', i, ',', j, ',', k, ')' + field_passed = .false. + exit outer_loop_3d + else if (current_value < 0.0_fp) then + write(error_unit,'(A,A,A,I0,A,I0,A,I0,A)') ' ERROR: Field has negative value at index ', trim(field_name), ' (', i, ',', j, ',', k, ')' + field_passed = .false. + exit outer_loop_3d + else if (.not. (current_value < huge(current_value))) then ! Infinite check + write(error_unit,'(A,A,A,I0,A,I0,A,I0,A)') ' ERROR: Field has infinite value at index ', trim(field_name), ' (', i, ',', j, ',', k, ')' + field_passed = .false. + exit outer_loop_3d + end if + end do + end do + end do outer_loop_3d + + if (field_passed) then + ! Check if sum of array is zero + if (sum(array_3d_ptr) == 0.0_fp) then + write(error_unit,'(A,A)') ' WARNING: Field has zero sum (all elements are zero): ', trim(field_name) + !field_passed = .false. + else + write(output_unit,'(A,A)') ' ✓ All array elements are finite and non-negative: ', trim(field_name) + end if + end if + else + write(error_unit,'(A,A)') ' ERROR: 3D array not associated for field: ', trim(field_name) + field_passed = .false. + end if + + case (DIAG_INTEGER_SCALAR) + type_name = 'Integer Scalar' + write(output_unit,'(A,A)') ' Type: ', trim(type_name) + write(output_unit,'(A,E12.5)') ' Scalar value: ', scalar_value + if (is_verbose) then + write(output_unit,'(A,A,A,E12.5)') ' ', trim(field_name), ' = ', scalar_value + end if + + ! For integer scalar, just check if it's non-negative + if (scalar_value < 0.0_fp) then + write(error_unit,'(A,A)') ' ERROR: Integer field has negative value: ', trim(field_name) + field_passed = .false. + else + write(output_unit,'(A,A)') ' ✓ Integer field has non-negative value: ', trim(field_name) + end if + + case (DIAG_INTEGER_1D) + type_name = 'Integer 1D Array' + write(output_unit,'(A,A)') ' Type: ', trim(type_name) + if (associated(array_1d_ptr)) then + write(output_unit,'(A,I0)') ' Array size: ', size(array_1d_ptr) + + ! Check each element in the 1D integer array + do i = 1, size(array_1d_ptr) + current_value = array_1d_ptr(i) + if (is_verbose) then + write(output_unit,'(A,A,A,I0,A,E12.5)') ' ', trim(field_name), '[', i, '] = ', current_value + end if + if (current_value /= current_value) then ! NaN check + write(error_unit,'(A,A,A,I0,A)') ' ERROR: Integer field has NaN at index ', trim(field_name), ' (', i, ')' + field_passed = .false. + exit + else if (current_value < 0.0_fp) then + write(error_unit,'(A,A,A,I0,A)') ' ERROR: Integer field has negative value at index ', trim(field_name), ' (', i, ')' + field_passed = .false. + exit + end if + end do + + if (field_passed) then + ! Check if sum of array is zero + if (sum(array_1d_ptr) == 0.0_fp) then + write(error_unit,'(A,A)') ' WARNING: Integer field has zero sum (all elements are zero): ', trim(field_name) + !field_passed = .false. + else + write(output_unit,'(A,A)') ' ✓ All integer array elements are non-negative: ', trim(field_name) + end if + end if + else + write(error_unit,'(A,A)') ' ERROR: 1D integer array not associated for field: ', trim(field_name) + field_passed = .false. + end if + + case (DIAG_INTEGER_2D) + type_name = 'Integer 2D Array' + write(output_unit,'(A,A)') ' Type: ', trim(type_name) + if (associated(array_2d_ptr)) then + write(output_unit,'(A,I0,A,I0)') ' Array size: ', size(array_2d_ptr,1), ' x ', size(array_2d_ptr,2) + + ! Check each element in the 2D integer array + outer_loop_int_2d: do j = 1, size(array_2d_ptr,2) + do i = 1, size(array_2d_ptr,1) + current_value = array_2d_ptr(i,j) + if (is_verbose) then + write(output_unit,'(A,A,A,I0,A,I0,A,E12.5)') ' ', trim(field_name), '[', i, ',', j, '] = ', current_value + end if + if (current_value /= current_value) then ! NaN check + write(error_unit,'(A,A,A,I0,A,I0,A)') ' ERROR: Integer field has NaN at index ', trim(field_name), ' (', i, ',', j, ')' + field_passed = .false. + exit outer_loop_int_2d + else if (current_value < 0.0_fp) then + write(error_unit,'(A,A,A,I0,A,I0,A)') ' ERROR: Integer field has negative value at index ', trim(field_name), ' (', i, ',', j, ')' + field_passed = .false. + exit outer_loop_int_2d + end if + end do + end do outer_loop_int_2d + + if (field_passed) then + ! Check if sum of array is zero + if (sum(array_2d_ptr) == 0.0_fp) then + write(error_unit,'(A,A)') ' WARNING: Integer field has zero sum (all elements are zero): ', trim(field_name) + !field_passed = .false. + else + write(output_unit,'(A,A)') ' ✓ All integer array elements are non-negative: ', trim(field_name) + end if + end if + else + write(error_unit,'(A,A)') ' ERROR: 2D integer array not associated for field: ', trim(field_name) + field_passed = .false. + end if + + case (DIAG_INTEGER_3D) + type_name = 'Integer 3D Array' + write(output_unit,'(A,A)') ' Type: ', trim(type_name) + if (associated(array_3d_ptr)) then + write(output_unit,'(A,I0,A,I0,A,I0)') ' Array size: ', size(array_3d_ptr,1), ' x ', size(array_3d_ptr,2), ' x ', size(array_3d_ptr,3) + + ! Check each element in the 3D integer array + outer_loop_int_3d: do k = 1, size(array_3d_ptr,3) + do j = 1, size(array_3d_ptr,2) + do i = 1, size(array_3d_ptr,1) + current_value = array_3d_ptr(i,j,k) + if (is_verbose) then + write(output_unit,'(A,A,A,I0,A,I0,A,I0,A,E12.5)') ' ', trim(field_name), '[', i, ',', j, ',', k, '] = ', current_value + end if + if (current_value /= current_value) then ! NaN check + write(error_unit,'(A,A,A,I0,A,I0,A,I0,A)') ' ERROR: Integer field has NaN at index ', trim(field_name), ' (', i, ',', j, ',', k, ')' + field_passed = .false. + exit outer_loop_int_3d + else if (current_value < 0.0_fp) then + write(error_unit,'(A,A,A,I0,A,I0,A,I0,A)') ' ERROR: Integer field has negative value at index ', trim(field_name), ' (', i, ',', j, ',', k, ')' + field_passed = .false. + exit outer_loop_int_3d + end if + end do + end do + end do outer_loop_int_3d + + if (field_passed) then + ! Check if sum of array is zero + if (sum(array_3d_ptr) == 0.0_fp) then + write(error_unit,'(A,A)') ' WARNING: Integer field has zero sum (all elements are zero): ', trim(field_name) + !field_passed = .false. + else + write(output_unit,'(A,A)') ' ✓ All integer array elements are non-negative: ', trim(field_name) + end if + end if + else + write(error_unit,'(A,A)') ' ERROR: 3D integer array not associated for field: ', trim(field_name) + field_passed = .false. + end if + + case default + type_name = 'Unknown Type' + write(output_unit,'(A,A)') ' Type: ', trim(type_name) + write(error_unit,'(A,A)') ' ERROR: Unsupported data type for field: ', trim(field_name) + field_passed = .false. + return + end select + + ! Update overall validation status + if (.not. field_passed) then + validation_passed = .false. + end if + + end subroutine validate_field_by_type + +end program test_wetdep_integration diff --git a/tests/process/wetdep/unit/test_wetdep_unit.F90 b/tests/process/wetdep/unit/test_wetdep_unit.F90 new file mode 100644 index 00000000..cf29bcc1 --- /dev/null +++ b/tests/process/wetdep/unit/test_wetdep_unit.F90 @@ -0,0 +1,151 @@ +!> \file test_wetdep_unit.F90 +!! \brief Unit tests for wetdep process +!! +!! This file contains unit tests for the wetdep process implementation +!! following the same pattern as core tests like test_ConfigManager.F90 +!! Generated on: 2025-12-15T16:30:33.789112 + +program test_wetdep_unit + use testing_mod, only: assert, assert_close + use precision_mod, only: fp + use error_mod, only: CC_SUCCESS, CC_FAILURE, ErrorManagerType + use StateManager_Mod, only: StateManagerType + use GridManager_Mod, only: GridManagerType + use ProcessWetDepInterface_Mod, only: ProcessWetDepInterface + use WetDepCommon_Mod, only: WetDepConfig + + implicit none + + type(ProcessWetDepInterface) :: wetdep_process + type(StateManagerType) :: state_mgr + type(ErrorManagerType) :: error_mgr + type(GridManagerType) :: grid_mgr + integer :: rc + + write(*,*) 'Testing WetDep Process module...' + write(*,*) '' + + ! Test 1: Initialize error manager + write(*,*) 'Test 1: Initialize error manager' + call error_mgr%init() + + write(*,*) 'Test 1 passed!' + write(*,*) '' + + ! Test 2: Initialize grid manager + write(*,*) 'Test 2: Initialize grid manager' + call grid_mgr%init(1, 1, 10, error_mgr, rc=rc) ! 1x1 grid, 10 levels for testing + call assert(rc == CC_SUCCESS, "GridManager initialization should succeed") + + write(*,*) 'Test 2 passed!' + write(*,*) '' + + ! Test 3: Initialize state manager + write(*,*) 'Test 3: Initialize state manager' + call state_mgr%init('TestWetDepStateManager', rc) + call assert(rc == CC_SUCCESS, "StateManager initialization should succeed") + + write(*,*) 'Test 3 passed!' + write(*,*) '' + + ! Test 4: WetDep configuration creation and defaults + write(*,*) 'Test 4: WetDep configuration creation and defaults' + call test_wetdep_config_defaults() + + write(*,*) 'Test 4 passed!' + write(*,*) '' + + ! Test 5: WetDep configuration validation + write(*,*) 'Test 5: WetDep configuration validation' + call test_wetdep_config_validation() + + write(*,*) 'Test 5 passed!' + write(*,*) '' + + ! Test 6: WetDep scheme configuration + write(*,*) 'Test 6: WetDep scheme configuration' + call test_scheme_configuration() + + write(*,*) 'Test 6 passed!' + write(*,*) '' + + ! Test 7: ProcessWetDepInterface creation + write(*,*) 'Test 7: ProcessWetDepInterface creation' + call test_process_interface_creation() + + write(*,*) 'Test 7 passed!' + write(*,*) '' + + ! Test 8: Process interface methods exist (without full initialization) + write(*,*) 'Test 8: Process interface methods exist' + call test_process_interface_methods() + + write(*,*) 'Test 8 passed!' + write(*,*) '' + write(*,*) 'All WetDep unit tests completed successfully!' + +contains + + !> Test WetDep configuration default values + subroutine test_wetdep_config_defaults() + type(WetDepConfig) :: config + + ! Test default values are correctly set + call assert(config%is_active .eqv. .true., "Default is_active should be true") + call assert(len_trim(config%scheme) > 0, "Default scheme should be set") + call assert(config%n_species == 0, "Default n_species should be 0") + call assert(config%diagnostics .eqv. .false., "Default diagnostics should be false") + + end subroutine test_wetdep_config_defaults + + !> Test WetDep configuration validation + subroutine test_wetdep_config_validation() + type(WetDepConfig) :: config + type(ErrorManagerType) :: error_manager + + ! Test validation of default configuration + call config%validate(error_manager) + call assert(.true., "Default configuration validation completed") + + ! Test validation of different schemes + config%scheme = 'jacob' + call config%validate(error_manager) + call assert(.true., "JACOB scheme validation completed") + + + end subroutine test_wetdep_config_validation + + !> Test scheme configuration + subroutine test_scheme_configuration() + type(WetDepConfig) :: config + type(ErrorManagerType) :: error_manager + + ! Test valid schemes + config%scheme = 'jacob' + call config%validate(error_manager) + call assert(.true., "JACOB scheme validation completed") + + config%scheme = 'invalid_scheme' + call config%validate(error_manager) + call assert(.true., "Invalid scheme validation completed") + + + ! Cleanup configuration + call config%finalize() + + end subroutine test_scheme_configuration + + !> Test ProcessWetDepInterface can be created + subroutine test_process_interface_creation() + ! Test that we can create the interface object + call assert(.true., "ProcessWetDepInterface object created successfully") + end subroutine test_process_interface_creation + + !> Test ProcessWetDepInterface has required methods (without calling them) + subroutine test_process_interface_methods() + ! Test that the interface has the expected methods by checking if it's ready + ! (this doesn't call init, just checks the initial state) + call assert(.not. wetdep_process%is_ready(), "Process should not be ready before initialization") + end subroutine test_process_interface_methods + +end program test_wetdep_unit diff --git a/tests/test_StateManager.f90 b/tests/test_StateManager.f90 index a7ddfdf5..49cb3d89 100644 --- a/tests/test_StateManager.f90 +++ b/tests/test_StateManager.f90 @@ -67,64 +67,75 @@ program test_StateManager write(*,*) 'Test 4 passed!' write(*,*) '' - ! Test 5: Get error manager - write(*,*) 'Test 5: Get error manager' + ! Test 5: Get time state pointer + write(*,*) 'Test 5: Get time state pointer' + block + use TimeState_Mod, only: TimeStateType + type(TimeStateType), pointer :: time_ptr + + time_ptr => state_mgr%get_time_state_ptr() + call assert(associated(time_ptr), "Should be able to get time state pointer") + end block + + write(*,*) 'Test 5 passed!' + write(*,*) '' + + ! Test 6: Get error manager + write(*,*) 'Test 6: Get error manager' error_mgr_ptr => state_mgr%get_error_manager() call assert(associated(error_mgr_ptr), "Should be able to get error manager") - write(*,*) 'Test 5 passed!' + write(*,*) 'Test 6 passed!' write(*,*) '' - ! Test 6: Get grid manager - write(*,*) 'Test 6: Get grid manager' + ! Test 7: Get grid manager + write(*,*) 'Test 7: Get grid manager' grid_mgr_ptr => state_mgr%get_grid_manager() ! Grid manager might not be associated initially call assert(.not. associated(grid_mgr_ptr) .or. associated(grid_mgr_ptr), & "Grid manager pointer should be valid (null or associated)") - write(*,*) 'Test 6 passed!' + write(*,*) 'Test 7 passed!' write(*,*) '' - ! Test 7: Get diagnostic manager - write(*,*) 'Test 7: Get diagnostic manager' + ! Test 8: Get diagnostic manager + write(*,*) 'Test 8: Get diagnostic manager' diag_mgr_ptr => state_mgr%get_diagnostic_manager() ! Diagnostic manager might not be associated initially call assert(.not. associated(diag_mgr_ptr) .or. associated(diag_mgr_ptr), & "Diagnostic manager pointer should be valid (null or associated)") - write(*,*) 'Test 7 passed!' + write(*,*) 'Test 8 passed!' write(*,*) '' - ! Test 8: Set name - write(*,*) 'Test 8: Set name' + ! Test 9: Set name + write(*,*) 'Test 9: Set name' call state_mgr%set_name('NewName') - ! Note: There's no direct way to verify the name was set in the current API - ! This test just ensures the method doesn't crash + ! (No direct way to test this other than with print_info) - write(*,*) 'Test 8 passed!' + write(*,*) 'Test 9 passed!' write(*,*) '' - ! Test 9: Print info - write(*,*) 'Test 9: Print info' + ! Test 10: Print info + write(*,*) 'Test 10: Print info' call state_mgr%print_info() - ! Should complete without error - write(*,*) 'Test 9 passed!' + write(*,*) 'Test 10 passed!' write(*,*) '' - ! Test 10: Get memory usage - write(*,*) 'Test 10: Get memory usage' + ! Test 11: Get memory usage + write(*,*) 'Test 11: Get memory usage' block integer(kind=8) :: memory_usage memory_usage = state_mgr%get_memory_usage() call assert(memory_usage >= 0, "Memory usage should be non-negative") end block - write(*,*) 'Test 10 passed!' + write(*,*) 'Test 11 passed!' write(*,*) '' - ! Test 11: Cleanup - write(*,*) 'Test 11: Cleanup' + ! Test 12: Cleanup + write(*,*) 'Test 12: Cleanup' call state_mgr%cleanup(rc) call assert(rc == CC_SUCCESS, "StateManager cleanup should succeed") @@ -132,7 +143,7 @@ program test_StateManager is_ready = state_mgr%is_ready() call assert(.not. is_ready, "StateManager should not be ready after cleanup") - write(*,*) 'Test 11 passed!' + write(*,*) 'Test 12 passed!' write(*,*) '' write(*,*) 'All StateManager tests passed!' diff --git a/tests/test_TimeState.f90 b/tests/test_TimeState.f90 index fe9dfb59..54794c98 100644 --- a/tests/test_TimeState.f90 +++ b/tests/test_TimeState.f90 @@ -25,9 +25,9 @@ program test_TimeState allocate(error_mgr) call error_mgr%init() - ! Test 2: TimeState initialization - write(*,*) 'Test 2: TimeState initialization' - call time_state%init(error_mgr, rc) + ! Test 2: TimeState initialization (default values) + write(*,*) 'Test 2: TimeState initialization (default values)' + call time_state%init(error_mgr=error_mgr, rc=rc) call assert(rc == CC_SUCCESS, "TimeState initialization should succeed") write(*,*) 'Test 2 passed!' @@ -61,7 +61,7 @@ program test_TimeState block real :: dt dt = time_state%get_timestep() - call assert(dt == 3600.0, "Default timestep should be 3600 seconds") + call assert_close(dt, 3600.0, 1e-6, "Default timestep should be 3600 seconds") end block write(*,*) 'Test 5 passed!' @@ -87,12 +87,93 @@ program test_TimeState write(*,*) 'Test 6 passed!' write(*,*) '' - ! Test 7: Cleanup - write(*,*) 'Test 7: Cleanup' + ! Test 7: Custom initialization + write(*,*) 'Test 7: Custom initialization' + call time_state%init(year=2023, month=6, day=15, hour=12, minute=30, second=45, timestep=1800.0, error_mgr=error_mgr, rc=rc) + call assert(rc == CC_SUCCESS, "Custom TimeState initialization should succeed") + + call time_state%get_current_date(year, month, day) + call assert(year == 2023, "Custom year should be 2023") + call assert(month == 6, "Custom month should be 6") + call assert(day == 15, "Custom day should be 15") + call assert_close(time_state%get_timestep(), 1800.0, 1e-6, "Custom timestep should be 1800 seconds") + + write(*,*) 'Test 7 passed!' + write(*,*) '' + + ! Test 8: Validation + write(*,*) 'Test 8: Validation' + call time_state%validate(error_mgr, rc) + call assert(rc == CC_SUCCESS, "TimeState validation should succeed") + + write(*,*) 'Test 8 passed!' + write(*,*) '' + + ! Test 9: Reset functionality + write(*,*) 'Test 9: Reset functionality' + call time_state%reset(error_mgr, rc) + call assert(rc == CC_SUCCESS, "TimeState reset should succeed") + + call time_state%get_current_date(year, month, day) + call assert(year == 2000, "Reset year should be 2000") + call assert(month == 1, "Reset month should be 1") + call assert(day == 1, "Reset day should be 1") + + write(*,*) 'Test 9 passed!' + write(*,*) '' + + ! Test 10: State status + write(*,*) 'Test 10: State status' + block + logical :: is_ready + is_ready = time_state%is_ready() + call assert(is_ready, "TimeState should be ready after initialization") + end block + + write(*,*) 'Test 10 passed!' + write(*,*) '' + + ! Test 11: Memory usage + write(*,*) 'Test 11: Memory usage' + block + integer(8) :: memory_bytes + memory_bytes = time_state%get_memory_usage() + call assert(memory_bytes > 0, "Memory usage should be positive") + end block + + write(*,*) 'Test 11 passed!' + write(*,*) '' + + ! Test 12: Timezone offset + write(*,*) 'Test 12: Timezone offset' + block + integer :: tz_offset + tz_offset = time_state%get_timezone_offset(0.0) ! UTC + call assert(tz_offset == 0, "UTC timezone offset should be 0") + + tz_offset = time_state%get_timezone_offset(-75.0) ! Eastern US + call assert(tz_offset == -5, "Eastern US timezone offset should be -5") + + tz_offset = time_state%get_timezone_offset(120.0) ! China + call assert(tz_offset == 8, "China timezone offset should be 8") + end block + + write(*,*) 'Test 12 passed!' + write(*,*) '' + + ! Test 13: Cleanup + write(*,*) 'Test 13: Cleanup' call time_state%cleanup(error_mgr, rc) call assert(rc == CC_SUCCESS, "TimeState cleanup should succeed") - write(*,*) 'Test 7 passed!' + ! Verify cleanup worked + block + logical :: is_ready + is_ready = time_state%is_ready() + call assert(.not. is_ready, "TimeState should not be ready after cleanup") + end block + + write(*,*) 'Test 13 passed!' write(*,*) '' write(*,*) 'All TimeState tests passed!' diff --git a/tests/test_catchem_api.F90 b/tests/test_catchem_api.F90 index 0f133f5d..e622a206 100644 --- a/tests/test_catchem_api.F90 +++ b/tests/test_catchem_api.F90 @@ -269,6 +269,16 @@ subroutine test_process_management(model, tests_total, tests_success) write(output_unit,'(A)') ' Adding processes to the model (auto-configured from YAML)...' + block + type(StateManagerType), pointer :: state_mgr => null() + state_mgr => model%get_state_manager() + if (associated(state_mgr)) then + state_mgr%tstep = dt + write(output_unit,'(A,F8.2,A)') ' Current model timestep: ', state_mgr%tstep, ' seconds' + else + write(output_unit,'(A)') ' Could not access StateManager to get timestep' + endif + end block ! Add all enabled processes from configuration call model%add_process(rc) diff --git a/tools/process_generator/configs/dry_deposition.yaml b/tools/process_generator/configs/dry_deposition.yaml index 8b4f7c3d..8746ba42 100644 --- a/tools/process_generator/configs/dry_deposition.yaml +++ b/tools/process_generator/configs/dry_deposition.yaml @@ -7,7 +7,7 @@ author: "Wei Li" # Explicit process behavior configuration with species filtering process_behavior: type: "sink" #is not doing anything now - tendency_mode: "additive" #is not doing anything now + tendency_mode: "multiplicative" #additive or multiplicative or replacement; species_filter: #type: "all_species" type: "by_metadata" @@ -26,9 +26,7 @@ process_behavior: parallelization: "column" #column: (extends(ColumnProcessInterface); use VirtualColumnType ) or global: (extends(ProcessInterface)) memory_requirements: "low" #is not doing anything now -required_met_fields: #needed for other purposes, such as unit conversion - - USTAR - - TSTEP #Note TSTEP is not from met_state but we put it here anyways +#required_met_fields: [] #used for other purpose, such as unit conversion schemes: wesely: @@ -42,6 +40,8 @@ schemes: author: "Wei Li" required_met_fields: #needed for scheme calculations + - USTAR + - TSTEP - TS - SWGDN - SUNCOSmid @@ -63,6 +63,7 @@ schemes: - IsIce - IsLand + required_species_properties: - mw_g - dd_f0 @@ -100,10 +101,12 @@ schemes: author: "Wei Li & Lacey Holland" required_met_fields: - - NLEVS + #- NLEVS + - USTAR + - TSTEP - T - AIRDEN - - ZMID + - Z - LWI - PBLH - HFLUX @@ -116,6 +119,7 @@ schemes: required_species_properties: - density - radius + - is_seasalt parameters: scale_factor: @@ -138,6 +142,8 @@ schemes: author: "Wei Li" required_met_fields: + - USTAR + - TSTEP - TS - OBK - BXHEIGHT diff --git a/tools/process_generator/configs/seasalt_emission.yaml b/tools/process_generator/configs/seasalt_emission.yaml index 841d2566..1436006d 100644 --- a/tools/process_generator/configs/seasalt_emission.yaml +++ b/tools/process_generator/configs/seasalt_emission.yaml @@ -7,7 +7,7 @@ author: "Barry Baker & Wei Li" # Explicit process behavior configuration with species filtering process_behavior: type: "source" #is not doing anything now - tendency_mode: "additive" #is not doing anything now + tendency_mode: "additive" ##additive or multiplicative or replacement; species_filter: #type: "all_species" type: "by_metadata" diff --git a/tools/process_generator/configs/settling.yaml b/tools/process_generator/configs/settling.yaml new file mode 100644 index 00000000..4a30efd3 --- /dev/null +++ b/tools/process_generator/configs/settling.yaml @@ -0,0 +1,81 @@ +name: "settling" +description: "Process for computing gravitational settling of aerosol species" +class_name: "Settling" +process_type: "deposition" +author: "Wei Li" + +# Explicit process behavior configuration with species filtering +process_behavior: + type: "sink" #is not doing anything now + tendency_mode: "replacement" #additive or multiplicative or replacement; + species_filter: + #type: "all_species" + type: "by_metadata" + metadata_flags: + - "is_aerosol" # Filter for species with is_aerosol=true property + #type: "by_list" + #species_list: + # - "SEASALT_FINE" # Fine mode sea salt (< 1 μm) + # - "SEASALT_COARSE" # Coarse mode sea salt (1-10 μm) + # - "SEASALT_SUPER" # Super-coarse mode sea salt (> 10 μm) + gas_aero_differentiation: false # Use different schemes for gas and aerosol species + tendency_calculation: "rates" #is not doing anything now + timestep_dependency: "independent" #is not doing anything now + spatial_scope: "column" #is not doing anything now + #only 'column' is supported for now + parallelization: "column" #column: (extends(ColumnProcessInterface); use VirtualColumnType ) or global: (extends(ProcessInterface)) + memory_requirements: "low" #is not doing anything now + +#required_met_fields: [] #used for other purpose, such as unit conversion + +schemes: + gocart: + name: "gocart" + class_name: "GOCART" + description: "GOCART gravitational settling scheme" + #gas_or_aero: gas #gas, aero or both; only applies when gas_aero_differentiation is true + algorithm_type: "explicit" + affects_full_column: true + reference: "GOCART2G process library Chem_SettlingSimple function" + author: "Wei Li" + + required_met_fields: #needed for scheme calculations + - T + - TSTEP + - AIRDEN + - RH + - Z + - PMID + - DELP + + + required_species_properties: + - short_name + - mie_map + - radius + - density + + parameters: + scale_factor: + default: 1.0 + description: "settling velocity factor" + simple_scheme: + default: false + description: "read in mie data for wet particles if true; otherwise calculate particles wet swelling internally" + swelling_method: + default: 1 + description: "method for calculating particle swelling: 1 Fitzgerald 1975; 2 for Gerber 1985" + correction_maring: + default: false + description: "correct the settling velocity following Maring et al, 2003" + + diagnostics: [] + + +diagnostics: + - name: "settling_velocity_per_species_per_level" + description: "settling velocity per species per level" + units: "m/s" + - name: "settling_flux_per_species" + description: "settling flux per species across column" + units: "kg/m2/s" diff --git a/tools/process_generator/configs/wet_deposition.yaml b/tools/process_generator/configs/wet_deposition.yaml new file mode 100644 index 00000000..892146b8 --- /dev/null +++ b/tools/process_generator/configs/wet_deposition.yaml @@ -0,0 +1,83 @@ +name: "wetdep" +description: "Process for computing wet deposition of gas and aerosol species" +class_name: "WetDep" +process_type: "deposition" +author: "Wei Li" + +# Explicit process behavior configuration with species filtering +process_behavior: + type: "sink" #is not doing anything now + tendency_mode: "replacement" #additive or multiplicative or replacement; + species_filter: + #type: "all_species" + type: "by_metadata" + metadata_flags: + - "is_wetdep" # Filter for species with is_drydep=true property + #type: "by_list" + #species_list: + # - "SEASALT_FINE" # Fine mode sea salt (< 1 μm) + # - "SEASALT_COARSE" # Coarse mode sea salt (1-10 μm) + # - "SEASALT_SUPER" # Super-coarse mode sea salt (> 10 μm) + gas_aero_differentiation: false # Use different schemes for gas and aerosol species + tendency_calculation: "rates" #is not doing anything now + timestep_dependency: "independent" #is not doing anything now + spatial_scope: "column" #is not doing anything now + #only 'column' is supported for now + parallelization: "column" #column: (extends(ColumnProcessInterface); use VirtualColumnType ) or global: (extends(ProcessInterface)) + memory_requirements: "low" #is not doing anything now + +#required_met_fields: [] #used for other purpose, such as unit conversion + +schemes: + jacob: + name: "jacob" + class_name: "JACOB" + description: "Jacob et al. [2000] wet deposition scheme" + #gas_or_aero: gas #gas, aero or both; only applies when gas_aero_differentiation is true + algorithm_type: "explicit" + affects_full_column: true + reference: "Jacob, D. J. et al., [2000] Harvard wet deposition scheme for GMI" + author: "Wei Li" + + required_met_fields: #needed for scheme calculations + - T + - TSTEP + - AIRDEN_DRY + - MAIRDEN + - PFLLSAN + - PFILSAN + - PEDGE + - REEVAPLS #need to add to metstate + + + required_species_properties: + - is_aerosol + - short_name + - henry_cr + - henry_k0 + - henry_pKa + - wd_retfactor + - wd_LiqAndGas + - wd_convfacI2G + - wd_rainouteff + - radius + - mw_g + + parameters: + scale_factor: + default: 1.0 + description: "Washout tuning factor" + radius_threshold: + default: 1.0 + description: "Radius threshold for aerosol wet deposition (um)" + + diagnostics: [] + + +diagnostics: + - name: "wetdep_mass_per_species_per_level" + description: "Wet deposition mass loss per species per level" + units: "kg/m2" + - name: "wetdep_flux_per_species_per_level" + description: "Wet deposition flux per species per level" + units: "kg/m2/s" diff --git a/tools/process_generator/process_generator.py b/tools/process_generator/process_generator.py index 602b4620..87f9a6ff 100755 --- a/tools/process_generator/process_generator.py +++ b/tools/process_generator/process_generator.py @@ -282,7 +282,8 @@ def get_species_property_data_type(self, property_name: str) -> str: # Boolean/logical species properties - properties that represent true/false values boolean_properties = { 'is_dust', 'is_seasalt', 'is_gas', 'is_aerosol', 'is_tracer', - 'is_transported', 'is_wet_scavenged', 'is_dry_deposited' + 'is_transported', 'is_wet_scavenged', 'is_dry_deposited', + 'wd_LiqAndGas' # Add wet deposition logical property } # Character/string species properties - properties that represent text/names @@ -293,10 +294,26 @@ def get_species_property_data_type(self, property_name: str) -> str: if property_name in boolean_properties: return 'logical' elif property_name in string_properties: - return 'character(len=255)' + return 'character(len=32)' else: return 'real(fp)' + def get_species_property_dimensions(self, property_name: str) -> str: + """Get the Fortran array dimensions for a species property.""" + # Properties with special dimensions + if property_name == 'wd_rainouteff': + return '(:,:)' # 2D array: (n_species, 3) + else: + return '(:)' # Default: 1D array (n_species) + + def get_species_property_allocation_size(self, property_name: str) -> str: + """Get the Fortran allocation size for a species property.""" + # Properties with special dimensions + if property_name == 'wd_rainouteff': + return '(this%{{ config.name }}_config%n_species, 3)' + else: + return '(this%{{ config.name }}_config%n_species)' + def get_all_categorical_fields(self) -> List[str]: """Get all categorical fields.""" fields = self._parse_metstate_fields() @@ -447,6 +464,49 @@ def __init__(self, template_dir: Optional[str] = None, metstate_file: Optional[s self.env.filters['infer_diagnostic_properties'] = self._infer_diagnostic_properties self.env.filters['analyze_required_dimensions'] = self._analyze_required_dimensions + # Add a filter to get all required met fields for a scheme + def get_all_met_fields_filter(scheme): + """Jinja2 filter to get all required meteorological fields for a scheme.""" + # Access the config from template globals if available + context = self.env.globals.get('config', {}) + + all_fields = set() + + # Add common process-level fields from config + if hasattr(context, 'required_met_fields') and context.required_met_fields: + all_fields.update(context.required_met_fields) + + # Add scheme-specific fields - handle both dict and object + scheme_fields = None + if isinstance(scheme, dict): + scheme_fields = scheme.get('required_met_fields') + elif hasattr(scheme, 'required_met_fields'): + scheme_fields = scheme.required_met_fields + + if scheme_fields: + all_fields.update(scheme_fields) + + # Return sorted list for consistent ordering + return sorted(list(all_fields)) + + # Add filter for scheme-only met fields (excludes process-level fields) + def get_scheme_only_met_fields_filter(scheme, context=None): + """Filter for scheme-only meteorological fields (excludes process-level fields).""" + scheme_fields = set() + + # Add only scheme-specific fields - handle both dict and object + if isinstance(scheme, dict): + if 'required_met_fields' in scheme and scheme['required_met_fields']: + scheme_fields.update(scheme['required_met_fields']) + elif hasattr(scheme, 'required_met_fields') and scheme.required_met_fields: + scheme_fields.update(scheme.required_met_fields) + + # Return sorted list for consistent ordering + return sorted(list(scheme_fields)) + + self.env.filters['all_required_met_fields'] = get_all_met_fields_filter + self.env.filters['scheme_only_met_fields'] = get_scheme_only_met_fields_filter + # Add a filter to get all required met fields for a scheme def get_all_met_fields_filter(scheme): """Jinja2 filter to get all required meteorological fields for a scheme.""" @@ -549,10 +609,31 @@ def _infer_diagnostic_properties(self, diagnostic: Dict[str, Any], config: Proce name_lower = name.lower() desc_lower = description.lower() - # Check for species/bin/distribution patterns in name or description - if ('_per_bin' in name or '_per_species' in name or '_per_mode' in name or '_distribution' in name or - 'per bin' in desc_lower or 'per species' in desc_lower or 'per mode' in desc_lower or - 'distribution' in desc_lower or 'size resolved' in desc_lower): + # Check for combined level AND species patterns for 4D diagnostics + has_level_pattern = ('_per_level' in name or '_profile' in name or '_vertical' in name or + '_column' in name or '_layer' in name or + 'level' in desc_lower or 'levels' in desc_lower or 'vertical' in desc_lower or + 'profile' in desc_lower or 'column' in desc_lower or 'layer' in desc_lower or + 'atmospheric' in desc_lower) + + has_species_pattern = ('_per_bin' in name or '_per_species' in name or '_per_mode' in name or '_distribution' in name or + 'per bin' in desc_lower or 'per species' in desc_lower or 'per mode' in desc_lower or + 'distribution' in desc_lower or 'size resolved' in desc_lower) + + # Priority 1: Check for combined level AND species patterns for 3D level diagnostics + if has_level_pattern and has_species_pattern: + result.update({ + 'data_type': 'DIAG_REAL_3D', + 'dimensions': ['nx', 'ny', 'nz'], + 'dimension_vars': ['dims_3d_levels'], + 'fortran_dims': 'dims_3d_levels', + 'dimension_source': 'grid_manager', + 'dimension_type': '3d_levels_species', + 'dimension_name': 'levels_with_species' + }) + + # Priority 2: Check for species/bin/distribution patterns only + elif has_species_pattern: result.update({ 'data_type': 'DIAG_REAL_3D', 'dimensions': ['nx', 'ny', 'n_species'], @@ -563,12 +644,8 @@ def _infer_diagnostic_properties(self, diagnostic: Dict[str, Any], config: Proce 'dimension_name': 'n_species' }) - # Check for level/vertical patterns in name or description - elif (('_per_level' in name or '_profile' in name or '_vertical' in name or - '_column' in name or '_layer' in name) or - ('level' in desc_lower or 'levels' in desc_lower or 'vertical' in desc_lower or - 'profile' in desc_lower or 'column' in desc_lower or 'layer' in desc_lower or - 'atmospheric' in desc_lower)): + # Priority 3: Check for level/vertical patterns only + elif has_level_pattern: result.update({ 'data_type': 'DIAG_REAL_3D', 'dimensions': ['nx', 'ny', 'nz'], diff --git a/tools/process_generator/templates/integration_test.F90.j2 b/tools/process_generator/templates/integration_test.F90.j2 index b28d925d..db2a430c 100644 --- a/tools/process_generator/templates/integration_test.F90.j2 +++ b/tools/process_generator/templates/integration_test.F90.j2 @@ -518,7 +518,7 @@ contains end do end do {% set has_3d_fields = [] %} -{% for field in ['T', 'THETA', 'TV', 'U', 'V', 'OMEGA', 'QV', 'SPHU', 'RH', 'AVGW', 'PMID', 'PMID_DRY', 'DELP', 'DELP_DRY', 'AIRDEN', 'AIRNUMDEN', 'MAIRDEN', 'DAIRMASS', 'BXHEIGHT', 'AIRVOL', 'Z', 'ZMID', 'CLDF', 'QI', 'QL', 'TAUCLI', 'TAUCLW', 'CMFMC', 'DTRAIN', 'DQRCU', 'DQRLSAN', 'PFICU', 'PFILSAN', 'PFLCU', 'PFLLSAN', 'F_OF_PBL', 'F_UNDER_PBLTOP'] %} +{% for field in ['T', 'THETA', 'TV', 'U', 'V', 'OMEGA', 'QV', 'SPHU', 'RH', 'AVGW', 'PMID', 'PMID_DRY', 'DELP', 'DELP_DRY', 'AIRDEN', 'AIRDEN_DRY','AIRNUMDEN', 'MAIRDEN', 'DAIRMASS', 'BXHEIGHT', 'AIRVOL', 'ZMID', 'CLDF', 'QI', 'QL', 'TAUCLI', 'TAUCLW', 'CMFMC', 'DTRAIN', 'DQRCU', 'DQRLSAN', 'PFICU', 'PFLCU', 'F_OF_PBL', 'F_UNDER_PBLTOP'] %} {% if required_met_fields and field in required_met_fields %} {% if has_3d_fields.append(field) %}{% endif %} {% endif %} @@ -576,14 +576,22 @@ contains {%- if required_met_fields and 'DELP_DRY' in required_met_fields %}{{- sep.value -}} met_state%DELP_DRY(i,j,k) = 4950.0_fp ! Dry pressure thickness [Pa] {%- set sep.value = '\n ' %}{%- endif %} -{%- if required_met_fields and 'AIRDEN' in required_met_fields %}{{- sep.value -}} - met_state%AIRDEN(i,j,k) = 1.2_fp * exp(-altitude_km / 8.0_fp) ! Air density [kg/m3] +{%- if required_met_fields and 'AIRDEN_DRY' in required_met_fields %}{{- sep.value -}} + met_state%AIRDEN_DRY(i,j,k) = 1.2_fp * exp(-altitude_km / 8.0_fp) ! Dry air density [kg/m3] {%- set sep.value = '\n ' %}{%- endif %} {%- if required_met_fields and 'AIRNUMDEN' in required_met_fields %}{{- sep.value -}} met_state%AIRNUMDEN(i,j,k) = 2.5e19_fp * exp(-altitude_km / 8.0_fp) ! Air number density [molec/cm3] {%- set sep.value = '\n ' %}{%- endif %} +{%- if required_met_fields and 'AIRDEN' in required_met_fields %}{{- sep.value -}} + met_state%AIRDEN_DRY(i,j,k) = 1.2_fp * exp(-altitude_km / 8.0_fp) ! Dry air density [kg/m3] + met_state%AIRDEN(i,j,k) = met_state%AIRDEN_DRY(i,j,k) * 1.01_fp ! wet Air density [kg/m3] +{%- set sep.value = '\n ' %}{%- endif %} {%- if required_met_fields and 'MAIRDEN' in required_met_fields %}{{- sep.value -}} - met_state%MAIRDEN(i,j,k) = met_state%AIRDEN(i,j,k) * 1.01_fp ! Moist air density [kg/m3] + met_state%AIRDEN_DRY(i,j,k) = 1.2_fp * exp(-altitude_km / 8.0_fp) ! Dry air density [kg/m3] + met_state%MAIRDEN(i,j,k) = met_state%AIRDEN_DRY(i,j,k) * 1.01_fp ! Moist air density [kg/m3] +{%- set sep.value = '\n ' %}{%- endif %} +{%- if required_met_fields and 'REEVAPLS' in required_met_fields %}{{- sep.value -}} + met_state%REEVAPLS(i,j,k) = 1.0e-6_fp * (1.0_fp + 0.1_fp * altitude_km) ! Evaporation of large-scale precipitation [kg/kg/s] {%- set sep.value = '\n ' %}{%- endif %} {%- if required_met_fields and 'DAIRMASS' in required_met_fields %}{{- sep.value -}} met_state%DAIRMASS(i,j,k) = 1.2e8_fp * exp(-altitude_km / 8.0_fp) ! Dry air mass [kg] @@ -594,11 +602,8 @@ contains {%- if required_met_fields and 'AIRVOL' in required_met_fields %}{{- sep.value -}} met_state%AIRVOL(i,j,k) = 1.0e11_fp ! Grid box volume [m3] {%- set sep.value = '\n ' %}{%- endif %} -{%- if required_met_fields and 'Z' in required_met_fields %}{{- sep.value -}} - met_state%Z(i,j,k) = altitude_km * 1000.0_fp * 9.81_fp ! Geopotential height [m2/s2] -{%- set sep.value = '\n ' %}{%- endif %} {%- if required_met_fields and 'ZMID' in required_met_fields %}{{- sep.value -}} - met_state%ZMID(i,j,k) = altitude_km * 1000.0_fp * 9.81_fp ! Mid-level geopotential [m2/s2] + met_state%ZMID(i,j,k) = altitude_km * 1000.0_fp ! Mid-level geopotential [m] {%- set sep.value = '\n ' %}{%- endif %} {%- if required_met_fields and 'CLDF' in required_met_fields %}{{- sep.value -}} met_state%CLDF(i,j,k) = max(0.0_fp, 0.4_fp - altitude_km * 0.05_fp) ! 3D cloud fraction @@ -630,15 +635,9 @@ contains {%- if required_met_fields and 'PFICU' in required_met_fields %}{{- sep.value -}} met_state%PFICU(i,j,k) = 0.0_fp ! Ice precip flux: convective [kg/m2/s] {%- set sep.value = '\n ' %}{%- endif %} -{%- if required_met_fields and 'PFILSAN' in required_met_fields %}{{- sep.value -}} - met_state%PFILSAN(i,j,k) = 0.0_fp ! Ice precip flux: LS+anvil [kg/m2/s] -{%- set sep.value = '\n ' %}{%- endif %} {%- if required_met_fields and 'PFLCU' in required_met_fields %}{{- sep.value -}} met_state%PFLCU(i,j,k) = 0.0_fp ! Liquid precip flux: convective [kg/m2/s] {%- set sep.value = '\n ' %}{%- endif %} -{%- if required_met_fields and 'PFLLSAN' in required_met_fields %}{{- sep.value -}} - met_state%PFLLSAN(i,j,k) = 0.0_fp ! Liquid precip flux: LS+anvil [kg/m2/s] -{%- set sep.value = '\n ' %}{%- endif %} {%- if required_met_fields and 'F_OF_PBL' in required_met_fields %}{{- sep.value -}} met_state%F_OF_PBL(i,j,k) = max(0.0_fp, 1.0_fp - altitude_km / 1.0_fp) ! Fraction in PBL {%- set sep.value = '\n ' %}{%- endif %} @@ -651,7 +650,7 @@ contains end do {% endif %} {% set has_edge_fields = [] %} -{% for field in ['PEDGE', 'PEDGE_DRY'] %} +{% for field in ['PEDGE', 'PEDGE_DRY', 'PFILSAN', 'PFLLSAN', 'Z'] %} {% if required_met_fields and field in required_met_fields %} {% if has_edge_fields.append(field) %}{% endif %} {% endif %} @@ -665,9 +664,18 @@ contains {%- if required_met_fields and 'PEDGE' in required_met_fields %}{{- sep.value -}} met_state%PEDGE(i,j,k) = 101300.25_fp * exp(-edge_altitude_km / 8.0_fp) ! Pressure at edges [Pa] {%- set sep.value = '\n ' %}{%- endif %} +{%- if required_met_fields and 'Z' in required_met_fields %}{{- sep.value -}} + met_state%Z(i,j,k) = 1000.0_fp * (edge_altitude_km + 0.65_fp) ! Geopotential height at edges [m] +{%- set sep.value = '\n ' %}{%- endif %} {%- if required_met_fields and 'PEDGE_DRY' in required_met_fields %}{{- sep.value -}} met_state%PEDGE_DRY(i,j,k) = met_state%PEDGE(i,j,k) * 0.99_fp ! Dry pressure at edges [Pa] {%- set sep.value = '\n ' %}{%- endif %} +{%- if required_met_fields and 'PFILSAN' in required_met_fields %}{{- sep.value -}} + met_state%PFILSAN(i,j,k) = 1.0e-3_fp * (1.0_fp + 0.2_fp * edge_altitude_km) ! Ice precip flux: LS+anvil [kg/m2/s] +{%- set sep.value = '\n ' %}{%- endif %} +{%- if required_met_fields and 'PFLLSAN' in required_met_fields %}{{- sep.value -}} + met_state%PFLLSAN(i,j,k) = 1.5e-3_fp * (1.0_fp + 0.15_fp * edge_altitude_km) ! Liquid precip flux: LS+anvil [kg/m2/s] +{%- set sep.value = '\n ' %}{%- endif %} end do end do @@ -817,7 +825,7 @@ contains ! Get {{ config.name }} process interface {{ config.name }}_interface => null() - select type(process => process_mgr%processes(1)) + select type(process => process_mgr%processes(1)%item) type is (Process{{ config.class_name }}Interface) {{ config.name }}_interface => process end select @@ -827,14 +835,10 @@ contains return end if -{% if config.process_type == "emission" %} - ! Step 1: Set the timestep for emission calculations + ! Step 1: Set the timestep for process calculations call {{ config.name }}_interface%set_timestep(dt) ! Step 2: Set the scheme -{% else %} - ! Step 1: Set the scheme -{% endif %} {% if config.process_behavior and config.process_behavior.gas_aero_differentiation %} ! For gas/aerosol differentiated processes, determine scheme type select case (trim(scheme_name)) @@ -855,11 +859,7 @@ contains call {{ config.name }}_interface%set_scheme(scheme_name) {% endif %} -{% if config.process_type == "emission" %} ! Step 3: Reload scheme-specific configuration -{% else %} - ! Step 2: Reload scheme-specific configuration -{% endif %} config_mgr => state_mgr%get_config_ptr() error_mgr => state_mgr%get_error_manager() diff --git a/tools/process_generator/templates/process_common.F90.j2 b/tools/process_generator/templates/process_common.F90.j2 index 87f2580f..68c9751c 100644 --- a/tools/process_generator/templates/process_common.F90.j2 +++ b/tools/process_generator/templates/process_common.F90.j2 @@ -86,11 +86,7 @@ module {{ config.class_name }}Common_Mod ! Species properties {% for prop in all_required_species_properties %} {% if prop != 'short_name' %} -{% if prop.startswith('is_') %} - logical, allocatable :: species_{{ prop }}(:) ! {{ prop }} for each species -{% else %} - real(fp), allocatable :: species_{{ prop }}(:) ! {{ prop }} for each species -{% endif %} + {{ field_classifier.get_species_property_data_type(prop) }}, allocatable :: species_{{ prop }}{{ field_classifier.get_species_property_dimensions(prop) }} ! {{ prop }} for each species {% endif %} {% endfor %} {% endif %} @@ -124,11 +120,13 @@ module {{ config.class_name }}Common_Mod {% if param_type == 'auto' %} {% if param_info.default is sameas true or param_info.default is sameas false %} {% set param_type = 'logical' %} +{% elif param_info.default is integer %} +{% set param_type = 'integer' %} {% else %} {% set param_type = 'real(fp)' %} {% endif %} {% endif %} - {{ param_type }} :: {{ param_name }} = {% if param_type == 'logical' %}{% if param_info.default %}{% if param_info.default is sameas true %}.true.{% else %}.false.{% endif %}{% else %}.false.{% endif %}{% else %}{{ param_info.default | default('0.0_fp') }}{% endif %} ! {{ param_info.description | default('Parameter') }} + {{ param_type }} :: {{ param_name }} = {% if param_type == 'logical' %}{% if param_info.default %}{% if param_info.default is sameas true %}.true.{% else %}.false.{% endif %}{% else %}.false.{% endif %}{% elif param_type == 'integer' %}{{ param_info.default | default('0') }}{% else %}{{ param_info.default | default('0.0_fp') }}{% endif %} ! {{ param_info.description | default('Parameter') }} {% endfor %} ! Required meteorological fields @@ -448,8 +446,20 @@ contains {% if config.process_specific_params %} ! Load process-specific parameters from master YAML {% for param_name, param_info in config.process_specific_params.items() %} - call config_manager%get_{{ param_info.yaml_type | default('real') }}("processes/{{ config.name }}/{{ param_name }}", & - this%{{ config.name }}_config%{{ param_name }}, ierr, {{ param_info.default }}) +{% set param_type = param_info.type | default('auto') %} +{% if param_type == 'auto' %} +{% if param_info.default is sameas true or param_info.default is sameas false %} +{% set yaml_type = 'logical' %} +{% elif param_info.default is integer %} +{% set yaml_type = 'integer' %} +{% else %} +{% set yaml_type = 'real' %} +{% endif %} +{% else %} +{% set yaml_type = param_info.yaml_type | default('real') %} +{% endif %} + call config_manager%get_{{ yaml_type }}("processes/{{ config.name }}/{{ param_name }}", & + this%{{ config.name }}_config%{{ param_name }}, ierr, {% if yaml_type == 'logical' %}{% if param_info.default %}{% if param_info.default is sameas true %}.true.{% else %}.false.{% endif %}{% else %}.false.{% endif %}{% elif yaml_type == 'integer' %}{{ param_info.default | default('0') }}{% else %}{{ param_info.default | default('1.0') }}_fp{% endif %}) {% endfor %} {% endif %} @@ -555,8 +565,12 @@ contains ! Allocate species properties arrays {% for prop in all_required_species_properties %} {% if prop != 'short_name' %} +{% if prop == 'wd_rainouteff' %} + allocate(this%{{ config.name }}_config%species_{{ prop }}(this%{{ config.name }}_config%n_species, 3)) +{% else %} allocate(this%{{ config.name }}_config%species_{{ prop }}(this%{{ config.name }}_config%n_species)) {% endif %} +{% endif %} {% endfor %} {% endif %} @@ -588,8 +602,18 @@ contains species_idx = this%{{ config.name }}_config%species_indices(i) {% for prop in all_required_species_properties %} {% if prop != 'short_name' %} +{% if prop == 'wd_rainouteff' %} + this%{{ config.name }}_config%species_{{ prop }}(i, :) = chem_state%ChemSpecies(species_idx)%{{ prop }}(:) +{% elif prop == 'mie_map' %} + if (allocated(chem_state%SpcMieMap)) then + this%{{ config.name }}_config%species_mie_map(i) = chem_state%SpcMieMap(species_idx) + else + this%{{ config.name }}_config%species_mie_map(i) = -1 ! Default or error value + end if +{% else %} this%{{ config.name }}_config%species_{{ prop }}(i) = chem_state%ChemSpecies(species_idx)%{{ prop }} {% endif %} +{% endif %} {% endfor %} {% if config.gas_aero_differentiation %} this%{{ config.name }}_config%is_gas(i) = chem_state%ChemSpecies(species_idx)%is_gas @@ -662,6 +686,8 @@ contains {% set species_type = 'Gas' %} {% elif flag_base == 'tracer' or flag_base == 'Tracer' %} {% set species_type = 'Tracer' %} +{% elif flag_base == 'aerosol' or flag_base == 'Aerosol' %} +{% set species_type = 'Aero' %} {% elif flag_base == 'aerodrydep' or flag_base == 'aeroDryDep' or flag_base == 'AeroDryDep' %} {% set species_type = 'AeroDryDep' %} {% elif flag_base == 'drydep' or flag_base == 'dryDep' or flag_base == 'DryDep' %} @@ -734,8 +760,12 @@ contains ! Allocate species properties arrays {% for prop in all_required_species_properties %} {% if prop != 'short_name' %} +{% if prop == 'wd_rainouteff' %} + allocate(this%{{ config.name }}_config%species_{{ prop }}(this%{{ config.name }}_config%n_species, 3)) +{% else %} allocate(this%{{ config.name }}_config%species_{{ prop }}(this%{{ config.name }}_config%n_species)) {% endif %} +{% endif %} {% endfor %} {% endif %} @@ -760,6 +790,8 @@ contains {% set species_type = 'Gas' %} {% elif flag_base == 'tracer' or flag_base == 'Tracer' %} {% set species_type = 'Tracer' %} +{% elif flag_base == 'aerosol' or flag_base == 'Aerosol' %} +{% set species_type = 'Aero' %} {% elif flag_base == 'aerodrydep' or flag_base == 'aeroDryDep' or flag_base == 'AeroDryDep' %} {% set species_type = 'AeroDryDep' %} {% elif flag_base == 'drydep' or flag_base == 'dryDep' or flag_base == 'DryDep' %} @@ -796,8 +828,18 @@ contains species_idx = this%{{ config.name }}_config%species_indices(i) {% for prop in all_required_species_properties %} {% if prop != 'short_name' %} +{% if prop == 'wd_rainouteff' %} + this%{{ config.name }}_config%species_{{ prop }}(i, :) = chem_state%ChemSpecies(species_idx)%{{ prop }}(:) +{% elif prop == 'mie_map' %} + if (allocated(chem_state%SpcMieMap)) then + this%{{ config.name }}_config%species_mie_map(i) = chem_state%SpcMieMap(species_idx) + else + this%{{ config.name }}_config%species_mie_map(i) = -1 ! Default or error value + end if +{% else %} this%{{ config.name }}_config%species_{{ prop }}(i) = chem_state%ChemSpecies(species_idx)%{{ prop }} {% endif %} +{% endif %} {% endfor %} {% if config.process_behavior and config.process_behavior.gas_aero_differentiation %} this%{{ config.name }}_config%is_gas(i) = chem_state%ChemSpecies(species_idx)%is_gas @@ -870,8 +912,12 @@ contains ! Allocate species properties arrays {% for prop in all_required_species_properties %} {% if prop != 'short_name' %} +{% if prop == 'wd_rainouteff' %} + allocate(this%{{ config.name }}_config%species_{{ prop }}(this%{{ config.name }}_config%n_species, 3)) +{% else %} allocate(this%{{ config.name }}_config%species_{{ prop }}(this%{{ config.name }}_config%n_species)) {% endif %} +{% endif %} {% endfor %} {% endif %} {% if config.process_behavior and config.process_behavior.gas_aero_differentiation %} @@ -909,6 +955,8 @@ contains {% if param_type == 'auto' %} {% if param_info.default is sameas true or param_info.default is sameas false %} {% set yaml_type = 'logical' %} +{% elif param_info.default is integer %} +{% set yaml_type = 'integer' %} {% else %} {% set yaml_type = 'real' %} {% endif %} @@ -916,11 +964,13 @@ contains {% set yaml_type = param_info.yaml_type | default('real') %} {% if param_type == 'logical' %} {% set yaml_type = 'logical' %} +{% elif param_type == 'integer' %} +{% set yaml_type = 'integer' %} {% endif %} {% endif %} call config_manager%get_{{ yaml_type }}("processes/{{ config.name }}/{{ scheme.name }}/{{ param_name }}", & - this%{{ scheme.name }}_config%{{ param_name }}, rc, {% if yaml_type == 'logical' %}{% if param_info.default %}{% if param_info.default is sameas true %}.true.{% else %}.false.{% endif %}{% else %}.false.{% endif %}{% else %}{{ param_info.default | default('1.0') }}_fp{% endif %}) - if (rc /= CC_SUCCESS) this%{{ scheme.name }}_config%{{ param_name }} = {% if yaml_type == 'logical' %}{% if param_info.default %}{% if param_info.default is sameas true %}.true.{% else %}.false.{% endif %}{% else %}.false.{% endif %}{% else %}{{ param_info.default | default('1.0') }}_fp{% endif %} + this%{{ scheme.name }}_config%{{ param_name }}, rc, {% if yaml_type == 'logical' %}{% if param_info.default %}{% if param_info.default is sameas true %}.true.{% else %}.false.{% endif %}{% else %}.false.{% endif %}{% elif yaml_type == 'integer' %}{{ param_info.default | default('0') }}{% else %}{{ param_info.default | default('1.0') }}_fp{% endif %}) + if (rc /= CC_SUCCESS) this%{{ scheme.name }}_config%{{ param_name }} = {% if yaml_type == 'logical' %}{% if param_info.default %}{% if param_info.default is sameas true %}.true.{% else %}.false.{% endif %}{% else %}.false.{% endif %}{% elif yaml_type == 'integer' %}{{ param_info.default | default('0') }}{% else %}{{ param_info.default | default('1.0') }}_fp{% endif %} {% endfor %} diff --git a/tools/process_generator/templates/process_interface.F90.j2 b/tools/process_generator/templates/process_interface.F90.j2 index 23f6eab1..fbc58656 100644 --- a/tools/process_generator/templates/process_interface.F90.j2 +++ b/tools/process_generator/templates/process_interface.F90.j2 @@ -469,11 +469,11 @@ contains integer, intent(out) :: rc ! Local variables for scheme calculation -{% set all_met_fields = scheme | all_required_met_fields %} -{% if all_met_fields %} +{% set scheme_met_fields = scheme | scheme_only_met_fields %} +{% if scheme_met_fields %} type(VirtualMetType), pointer :: met => null() ! Pointer to meteorological data ! Meteorological fields -{% for field in all_met_fields %} +{% for field in scheme_met_fields %} {% if field is string %} {{ field_classifier.get_data_type(field) }}, allocatable :: {{ field | lower | replace('-', '_') | replace('.', '_') }}(:) {% else %} @@ -488,8 +488,12 @@ contains {% if scheme.required_species_properties %} ! Species properties {% for prop in scheme.required_species_properties %} +{% if prop == 'mie_map' %} + integer, allocatable :: species_mie_map(:) ! Mapping from process species to MieData indices +{% else %} {% if prop != 'short_name' %} - {{ field_classifier.get_species_property_data_type(prop) }}, allocatable :: species_{{ prop }}(:) + {{ field_classifier.get_species_property_data_type(prop) }}, allocatable :: species_{{ prop }}{{ field_classifier.get_species_property_dimensions(prop) }} +{% endif %} {% endif %} {% endfor %} {% endif %} @@ -594,9 +598,9 @@ contains allocate(species_tendencies(1, n_species)) {% endif %} {% endif %} -{% if all_met_fields %} +{% if scheme_met_fields %} ! Allocate meteorological field arrays based on field type and process configuration -{% for field in all_met_fields %} +{% for field in scheme_met_fields %} {% if field is string %} {% set field_name = field %} {% set var_name = field | lower | replace('-', '_') | replace('.', '_') %} @@ -609,17 +613,9 @@ contains {% elif field_classifier.get_field_type(field_name) == '2d_surface' %} allocate({{ var_name }}(1)) ! Surface field - always scalar {% elif field_classifier.get_field_type(field_name) == '3d_atmospheric' %} -{% if scheme.affects_full_column %} - allocate({{ var_name }}(n_levels)) ! Full column atmospheric field -{% else %} - allocate({{ var_name }}(1)) ! Surface level only -{% endif %} + allocate({{ var_name }}(n_levels)) ! Atmospheric field - always n_levels {% elif field_classifier.get_field_type(field_name) == '3d_edge' %} -{% if scheme.affects_full_column %} - allocate({{ var_name }}(n_levels+1)) ! Full column edge field - requires nz+1 dimensions -{% else %} - allocate({{ var_name }}(2)) ! Surface edge field - surface and first edge level -{% endif %} + allocate({{ var_name }}(n_levels+1)) ! Edge field - always n_levels+1 {% elif field_classifier.get_field_type(field_name) == 'categorical' %} {% else %} @@ -629,19 +625,25 @@ contains {% endif %} {% if scheme.required_species_properties %} {% for prop in scheme.required_species_properties %} -{% if prop != 'short_name' %} +{% if prop == 'mie_map' %} + allocate(species_mie_map(n_species)) +{% elif prop != 'short_name' %} +{% if prop == 'wd_rainouteff' %} + allocate(species_{{ prop }}(n_species, 3)) +{% else %} allocate(species_{{ prop }}(n_species)) {% endif %} +{% endif %} {% endfor %} {% endif %} species_tendencies = 0.0_fp -{% if all_met_fields %} +{% if scheme_met_fields %} ! Get meteorological data pointer from virtual column (VirtualMet pattern) met => column%get_met() ! Now allocate categorical fields using the met pointer dimensions -{% for field in all_met_fields %} +{% for field in scheme_met_fields %} {% if field is string %} {% set field_name = field %} {% set var_name = field | lower | replace('-', '_') | replace('.', '_') %} @@ -655,7 +657,7 @@ contains {% endfor %} ! Extract required fields from met pointer based on field type and processing mode -{% for field in all_met_fields %} +{% for field in scheme_met_fields %} {% if field is string %} {% set field_name = field %} {% set var_name = field | lower | replace('-', '_') | replace('.', '_') %} @@ -668,17 +670,9 @@ contains {% elif field_classifier.get_field_type(field_name) == '2d_surface' %} {{ var_name }}(1) = met%{{ field_name }} ! Surface field - scalar access {% elif field_classifier.get_field_type(field_name) == '3d_atmospheric' %} -{% if scheme.affects_full_column %} - {{ var_name }}(1:n_levels) = met%{{ field_name }}(1:n_levels) ! Full column atmospheric field -{% else %} - {{ var_name }}(1) = met%{{ field_name }}(1) ! Surface level only -{% endif %} + {{ var_name }}(1:n_levels) = met%{{ field_name }}(1:n_levels) ! Atmospheric field - always n_levels {% elif field_classifier.get_field_type(field_name) == '3d_edge' %} -{% if scheme.affects_full_column %} - {{ var_name }}(1:n_levels+1) = met%{{ field_name }}(1:n_levels+1) ! Full column edge field - includes all edge levels -{% else %} - {{ var_name }}(1:2) = met%{{ field_name }}(1:2) ! Surface edge field - surface and first edge level -{% endif %} + {{ var_name }}(1:n_levels+1) = met%{{ field_name }}(1:n_levels+1) ! Edge field - always n_levels+1 {% elif field_classifier.get_field_type(field_name) == 'categorical' %} {{ var_name }}(:) = met%{{ field_name }}(:) ! Categorical field - full dimension {% else %} @@ -722,10 +716,17 @@ contains {% if scheme.required_species_properties %} ! Get species properties from configuration (pre-loaded during initialization) {% for prop in scheme.required_species_properties %} -{% if prop != 'short_name' %} +{% if prop == 'mie_map' %} + ! Extract filtered Mie mapping for process species + species_mie_map(1:n_species) = this%process_config%{{ config.name }}_config%species_mie_map(1:n_species) +{% elif prop != 'short_name' %} ! Use species properties from process configuration +{% if prop == 'wd_rainouteff' %} + species_{{ prop }}(1:n_species, :) = this%process_config%{{ config.name }}_config%species_{{ prop }}(1:n_species, :) +{% else %} species_{{ prop }}(1:n_species) = this%process_config%{{ config.name }}_config%species_{{ prop }}(1:n_species) {% endif %} +{% endif %} {% endfor %} {% endif %} @@ -742,8 +743,8 @@ contains {% if config.process_behavior and config.process_behavior.species_filter and config.process_behavior.species_filter.type == "emission_mapping" %} n_species_mapping, & {% endif %} - this%process_config%{{ scheme.name }}_config{% if all_met_fields and all_met_fields|length > 0 %}, & -{% for field in all_met_fields %} + this%process_config%{{ scheme.name }}_config{% if scheme_met_fields and scheme_met_fields|length > 0 %}, & +{% for field in scheme_met_fields %} {% if field is string %} {% set field_name = field %} {% set var_name = field | lower | replace('-', '_') | replace('.', '_') %} @@ -776,7 +777,10 @@ contains {% if scheme.required_species_properties and scheme.required_species_properties|length > 0 %} , & {% for prop in scheme.required_species_properties %} -{% if prop == 'short_name' %} +{% if prop == 'mie_map' %} + this%chem_state%MieData, & + species_mie_map, & +{% elif prop == 'short_name' %} this%process_config%{{ config.name }}_config%species_names, & {% else %} species_{{ prop }}, & @@ -803,8 +807,8 @@ contains {% if config.process_behavior and config.process_behavior.species_filter and config.process_behavior.species_filter.type == "emission_mapping" %} n_species_mapping, & {% endif %} - this%process_config%{{ scheme.name }}_config{% if all_met_fields and all_met_fields|length > 0 %}, & -{% for field in all_met_fields %} + this%process_config%{{ scheme.name }}_config{% if scheme_met_fields and scheme_met_fields|length > 0 %}, & +{% for field in scheme_met_fields %} {% if field is string %} {% set field_name = field %} {% set var_name = field | lower | replace('-', '_') | replace('.', '_') %} @@ -837,7 +841,10 @@ contains {% if scheme.required_species_properties and scheme.required_species_properties|length > 0 %} , & {% for prop in scheme.required_species_properties %} -{% if prop == 'short_name' %} +{% if prop == 'mie_map' %} + this%chem_state%MieData, & + species_mie_map, & +{% elif prop == 'short_name' %} this%process_config%{{ config.name }}_config%species_names, & {% else %} species_{{ prop }}, & @@ -863,7 +870,7 @@ contains {% if config.process_behavior and config.process_behavior.tendency_mode == "multiplicative" %} ! Multiplicative tendency: new_conc = conc * (1 - loss_fraction) ! where loss_fraction = 1 - exp(-tendency * dt) - loss_fraction = 1.0_fp - exp(-species_tendencies(k, i) * this%get_timestep()) + loss_fraction = MAX(1.0_fp - exp(-species_tendencies(k, i) * this%get_timestep()), 0.0_fp) call column%set_chem_field(k, chem_species_indices(chem_idx), & species_conc(k, chem_idx) * (1.0_fp - loss_fraction)) {% elif config.process_behavior and config.process_behavior.tendency_mode == "replacement" %} @@ -871,18 +878,13 @@ contains call column%set_chem_field(k, chem_species_indices(chem_idx), & species_tendencies(k, i)) {% else %} - ! Additive tendency (default): new_conc = conc + dqa -{% if config.process_behavior and config.process_behavior.type == "sink" %} - ! Dry deposition specific calculation: dqa = MAX(0.0, conc * (1 - exp(-tendency * dt))) - dqa = MAX(0.0_fp, species_conc(k, chem_idx) * (1.0_fp - exp(-1.0_fp * species_tendencies(k, i) * this%get_timestep()))) -{% else %} - ! where dqa = tendency * dt * g0 / DELP(k) + ! Additive tendency: convert emission flux to concentration change + ! Step 1: Convert to mass mixing ratio change (kg/kg) dqa = species_tendencies(k, i) * this%get_timestep() * g0 / met%DELP(k) -{% if config.process_behavior and config.process_behavior.type == "source" %} - ! Apply unit conversion for emission processes - ! For gas species: convert kg/kg to ppmv (converter = AIRMW / mw_g * 1.0e6) - ! For aerosol species: convert kg/kg to ug/kg (converter = 1.0e9) - ! Also apply emission mapping scale factor + + ! Step 2: Convert to final concentration units with emission mapping scale factor + ! For gas species: convert kg/kg to ppmv + ! For aerosol species: convert kg/kg to ug/kg if (this%chem_state%ChemSpecies(chem_species_indices(chem_idx))%is_gas) then converter = AIRMW / this%chem_state%ChemSpecies(chem_species_indices(chem_idx))%mw_g * 1.0e6_fp else @@ -890,15 +892,10 @@ contains end if converter = converter * this%process_config%{{ config.name }}_config%emission_mapping%species_mappings(i)%scale(j) dqa = dqa * converter -{% endif %} -{% endif %} -{% if config.process_behavior and config.process_behavior.type == "sink" %} - call column%set_chem_field(k, chem_species_indices(chem_idx), & - species_conc(k, chem_idx) - dqa) -{% else %} + call column%set_chem_field(k, chem_species_indices(chem_idx), & species_conc(k, chem_idx) + dqa) -{% endif %} + {% endif %} chem_idx = chem_idx + 1 end do @@ -913,7 +910,7 @@ contains {% if config.process_behavior and config.process_behavior.tendency_mode == "multiplicative" %} ! Multiplicative tendency: new_conc = conc * (1 - loss_fraction) ! where loss_fraction = 1 - exp(-tendency * dt) - loss_fraction = 1.0_fp - exp(-species_tendencies(1, i) * this%get_timestep()) + loss_fraction = MAX(1.0_fp - exp(-species_tendencies(1, i) * this%get_timestep()), 0.0_fp) call column%set_chem_field(1, chem_species_indices(chem_idx), & species_conc(1, chem_idx) * (1.0_fp - loss_fraction)) {% elif config.process_behavior and config.process_behavior.tendency_mode == "replacement" %} @@ -921,18 +918,13 @@ contains call column%set_chem_field(1, chem_species_indices(chem_idx), & species_tendencies(1, i)) {% else %} - ! Additive tendency (default): new_conc = conc + dqa -{% if config.process_behavior and config.process_behavior.type == "sink" %} - ! Dry deposition specific calculation: dqa = MAX(0.0, conc * (1 - exp(-tendency * dt))) - dqa = MAX(0.0_fp, species_conc(1, chem_idx) * (1.0_fp - exp(-1.0_fp * species_tendencies(1, i) * this%get_timestep()))) -{% else %} - ! where dqa = tendency * dt * g0 / DELP(1) for surface + ! Additive tendency: convert emission flux to concentration change + ! Step 1: Convert to mass mixing ratio change (kg/kg) dqa = species_tendencies(1, i) * this%get_timestep() * g0 / met%DELP(1) -{% if config.process_behavior and config.process_behavior.type == "source" %} - ! Apply unit conversion for emission processes - ! For gas species: convert kg/kg to ppmv (converter = AIRMW / mw_g * 1.0e6) - ! For aerosol species: convert kg/kg to ug/kg (converter = 1.0e9) - ! Also apply emission mapping scale factor + + ! Step 2: Convert to final concentration units with emission mapping scale factor + ! For gas species: convert kg/kg to ppmv + ! For aerosol species: convert kg/kg to ug/kg if (this%chem_state%ChemSpecies(chem_species_indices(chem_idx))%is_gas) then converter = AIRMW / this%chem_state%ChemSpecies(chem_species_indices(chem_idx))%mw_g * 1.0e6_fp else @@ -940,15 +932,10 @@ contains end if converter = converter * this%process_config%{{ config.name }}_config%emission_mapping%species_mappings(i)%scale(j) dqa = dqa * converter -{% endif %} -{% endif %} -{% if config.process_behavior and config.process_behavior.type == "sink" %} - call column%set_chem_field(1, chem_species_indices(chem_idx), & - species_conc(1, chem_idx) - dqa) -{% else %} + call column%set_chem_field(1, chem_species_indices(chem_idx), & species_conc(1, chem_idx) + dqa) -{% endif %} + {% endif %} chem_idx = chem_idx + 1 end do @@ -970,7 +957,7 @@ contains {% if config.process_behavior and config.process_behavior.tendency_mode == "multiplicative" %} ! Multiplicative tendency: new_conc = conc * (1 - loss_fraction) ! where loss_fraction = 1 - exp(-tendency * dt) - loss_fraction = 1.0_fp - exp(-species_tendencies(k, i) * this%get_timestep()) + loss_fraction = MAX(1.0_fp - exp(-species_tendencies(k, i) * this%get_timestep()), 0.0_fp) call column%set_chem_field(k, species_indices(i), & species_conc(k, i) * (1.0_fp - loss_fraction)) {% elif config.process_behavior and config.process_behavior.tendency_mode == "replacement" %} @@ -978,32 +965,23 @@ contains call column%set_chem_field(k, species_indices(i), & species_tendencies(k, i)) {% else %} - ! Additive tendency (default): new_conc = conc + dqa -{% if config.process_behavior and config.process_behavior.type == "sink" %} - ! Dry deposition specific calculation: dqa = MAX(0.0, conc * (1 - exp(-tendency * dt))) - dqa = MAX(0.0_fp, species_conc(k, i) * (1.0_fp - exp(-1.0_fp * species_tendencies(k, i) * this%get_timestep()))) -{% else %} - ! where dqa = tendency * dt * g0 / DELP(k) + ! Additive tendency: convert emission flux to concentration change + ! Step 1: Convert to mass mixing ratio change (kg/kg) dqa = species_tendencies(k, i) * this%get_timestep() * g0 / met%DELP(k) -{% if config.process_behavior and config.process_behavior.type == "source" %} - ! Apply unit conversion for emission processes - ! For gas species: convert kg/kg to ppmv (converter = AIRMW / mw_g * 1.0e6) - ! For aerosol species: convert kg/kg to ug/kg (converter = 1.0e9) + + ! Step 2: Convert to final concentration units + ! For gas species: convert kg/kg to ppmv + ! For aerosol species: convert kg/kg to ug/kg if (this%chem_state%ChemSpecies(species_indices(i))%is_gas) then converter = AIRMW / this%chem_state%ChemSpecies(species_indices(i))%mw_g * 1.0e6_fp else converter = 1.0e9_fp end if dqa = dqa * converter -{% endif %} -{% endif %} -{% if config.process_behavior and config.process_behavior.type == "sink" %} - call column%set_chem_field(k, species_indices(i), & - species_conc(k, i) - dqa) -{% else %} + call column%set_chem_field(k, species_indices(i), & species_conc(k, i) + dqa) -{% endif %} + {% endif %} end do end do @@ -1021,7 +999,7 @@ contains {% if config.process_behavior and config.process_behavior.tendency_mode == "multiplicative" %} ! Multiplicative tendency: new_conc = conc * (1 - loss_fraction) ! where loss_fraction = 1 - exp(-tendency * dt) - loss_fraction = 1.0_fp - exp(-species_tendencies(1, i) * this%get_timestep()) + loss_fraction = MAX(1.0_fp - exp(-species_tendencies(1, i) * this%get_timestep()), 0.0_fp) call column%set_chem_field(1, species_indices(i), & species_conc(1, i) * (1.0_fp - loss_fraction)) {% elif config.process_behavior and config.process_behavior.tendency_mode == "replacement" %} @@ -1029,32 +1007,23 @@ contains call column%set_chem_field(1, species_indices(i), & species_tendencies(1, i)) {% else %} - ! Additive tendency (default): new_conc = conc + dqa -{% if config.process_behavior and config.process_behavior.type == "sink" %} - ! Dry deposition specific calculation: dqa = MAX(0.0, conc * (1 - exp(-tendency * dt))) - dqa = MAX(0.0_fp, species_conc(1, i) * (1.0_fp - exp(-1.0_fp * species_tendencies(1, i) * this%get_timestep()))) -{% else %} - ! where dqa = tendency * dt * g0 / DELP(1) for surface + ! Additive tendency: convert emission flux to concentration change + ! Step 1: Convert to mass mixing ratio change (kg/kg) dqa = species_tendencies(1, i) * this%get_timestep() * g0 / met%DELP(1) -{% if config.process_behavior and config.process_behavior.type == "source" %} - ! Apply unit conversion for emission processes - ! For gas species: convert kg/kg to ppmv (converter = AIRMW / mw_g * 1.0e6) - ! For aerosol species: convert kg/kg to ug/kg (converter = 1.0e9) + + ! Step 2: Convert to final concentration units + ! For gas species: convert kg/kg to ppmv + ! For aerosol species: convert kg/kg to ug/kg if (this%chem_state%ChemSpecies(species_indices(i))%is_gas) then converter = AIRMW / this%chem_state%ChemSpecies(species_indices(i))%mw_g * 1.0e6_fp else converter = 1.0e9_fp end if dqa = dqa * converter -{% endif %} -{% endif %} -{% if config.process_behavior and config.process_behavior.type == "sink" %} - call column%set_chem_field(1, species_indices(i), & - species_conc(1, i) - dqa) -{% else %} + call column%set_chem_field(1, species_indices(i), & species_conc(1, i) + dqa) -{% endif %} + {% endif %} end do {% endif %} @@ -1337,7 +1306,7 @@ contains !> Get required diagnostic fields for this process function get_required_diagnostic_fields(this) result(field_names) class(Process{{ config.class_name }}Interface), intent(in) :: this - character(len=32), allocatable :: field_names(:) + character(len=64), allocatable :: field_names(:) {% if config.diagnostics %} allocate(field_names({{ config.diagnostics | length }})) @@ -1363,7 +1332,6 @@ contains type(DiagnosticManagerType), pointer :: diag_mgr type(DiagnosticRegistryType), pointer :: registry type(GridManagerType), pointer :: grid_mgr - character(len=32) :: selected_scheme character(len=256) :: field_name ! For constructing species-specific field names integer :: i ! Loop variable for diagnostic species {% set required_dims = config | analyze_required_dimensions %} @@ -1418,9 +1386,11 @@ contains {% for diagnostic in config.diagnostics %} ! Register {{ diagnostic.name }} {% set diag_props = diagnostic | infer_diagnostic_properties(config) %} -{% if 'per_bin' in diagnostic.name or 'per_species' in diagnostic.name %} +{% set has_level_pattern = ('per_level' in diagnostic.name or 'level' in diagnostic.name or 'vertical' in diagnostic.name or 'profile' in diagnostic.name) %} +{% set has_species_pattern = ('per_bin' in diagnostic.name or 'per_species' in diagnostic.name) %} +{% if has_species_pattern and not has_level_pattern %} {% set clean_name = diagnostic.name.replace('_per_bin', '').replace('_per_species', '') %} - ! Register individual 2D fields for each diagnostic species + ! Register individual 2D fields for each diagnostic species (species-only diagnostics) if (this%process_config%{{ config.name }}_config%n_diagnostic_species > 0) then do i = 1, this%process_config%{{ config.name }}_config%n_diagnostic_species write(field_name, '(A,A,A)') '{{ clean_name }}_', & @@ -1432,7 +1402,22 @@ contains if (rc /= CC_SUCCESS) return end do end if +{% elif has_level_pattern and has_species_pattern %} +{% set clean_name = diagnostic.name.replace('_per_bin', '').replace('_per_species', '').replace('_per_level', '') %} + ! Register individual 3D fields for each diagnostic species (level + species diagnostics) + if (this%process_config%{{ config.name }}_config%n_diagnostic_species > 0) then + do i = 1, this%process_config%{{ config.name }}_config%n_diagnostic_species + write(field_name, '(A,A,A)') '{{ clean_name }}_', & + trim(this%process_config%{{ config.name }}_config%diagnostic_species(i)) + call this%register_diagnostic_field(registry, trim(field_name), & + '{{ diagnostic.description }}', & + '{{ diagnostic.units }}', {{ diag_props.data_type }}, & + '{{ config.name }}', {{ diag_props.fortran_dims }}, rc=rc) + if (rc /= CC_SUCCESS) return + end do + end if {% else %} + ! Register single field for non-species or level-only diagnostics call this%register_diagnostic_field(registry, '{{ diagnostic.name }}', & '{{ diagnostic.description }}', & '{{ diagnostic.units }}', {{ diag_props.data_type }}, & @@ -1447,8 +1432,7 @@ contains ! Track registered diagnostics to avoid duplicates {% set registered_diagnostics = [] %} ! Register gas scheme diagnostics - selected_scheme = trim(this%process_config%{{ config.name }}_config%gas_scheme) - select case (selected_scheme) + select case (trim(this%process_config%{{ config.name }}_config%gas_scheme)) {% for scheme in config.schemes %} {% if scheme.gas_or_aero == 'gas' %} case ('{{ scheme.name }}') @@ -1481,8 +1465,7 @@ contains end select ! Register aerosol scheme diagnostics (only if not already registered) - selected_scheme = trim(this%process_config%{{ config.name }}_config%aero_scheme) - select case (selected_scheme) + select case (trim(this%process_config%{{ config.name }}_config%aero_scheme)) {% for scheme in config.schemes %} {% if scheme.gas_or_aero == 'aero' %} case ('{{ scheme.name }}') @@ -1514,19 +1497,19 @@ contains ! Unknown aerosol scheme end select {% else %} - selected_scheme = trim(this%process_config%{{ config.name }}_config%scheme) - ! Register scheme-specific diagnostics based on selected scheme - select case (selected_scheme) + select case (trim(this%process_config%{{ config.name }}_config%scheme)) {% for scheme in config.schemes %} case ('{{ scheme.name }}') ! Register {{ scheme.name }}-specific diagnostics {% for diagnostic in scheme.scheme_diagnostics %} {% set diag_props = diagnostic | infer_diagnostic_properties(config, scheme) %} -{% if 'per_bin' in diagnostic.name or 'per_species' in diagnostic.name %} +{% set has_level_pattern = ('per_level' in diagnostic.name or 'level' in diagnostic.name or 'vertical' in diagnostic.name or 'profile' in diagnostic.name) %} +{% set has_species_pattern = ('per_bin' in diagnostic.name or 'per_species' in diagnostic.name) %} +{% if has_species_pattern and not has_level_pattern %} {% set clean_name = diagnostic.name.replace('_per_bin', '').replace('_per_species', '') %} - ! Register individual 2D fields for each diagnostic species + ! Register individual 2D fields for each diagnostic species (species-only diagnostics) if (this%process_config%{{ config.name }}_config%n_diagnostic_species > 0) then do i = 1, this%process_config%{{ config.name }}_config%n_diagnostic_species write(field_name, '(A,A,A)') '{{ clean_name }}_', & @@ -1538,11 +1521,32 @@ contains if (rc /= CC_SUCCESS) return end do end if +{% elif has_level_pattern and has_species_pattern %} +{% set clean_name = diagnostic.name.replace('_per_bin', '').replace('_per_species', '').replace('_per_level', '') %} + ! Register individual 3D fields for each diagnostic species (level + species diagnostics) + if (this%process_config%{{ config.name }}_config%n_diagnostic_species > 0) then + do i = 1, this%process_config%{{ config.name }}_config%n_diagnostic_species + write(field_name, '(A,A,A)') '{{ clean_name }}_', & + trim(this%process_config%{{ config.name }}_config%diagnostic_species(i)) + call this%register_diagnostic_field(registry, trim(field_name), & + '{{ diagnostic.description }}', & + '{{ diagnostic.units }}', {{ diag_props.data_type }}, & + '{{ config.name }}', {{ diag_props.fortran_dims }}, rc=rc) + if (rc /= CC_SUCCESS) return + end do + end if +{% elif has_level_pattern and not has_species_pattern %} + ! Register single 3D field for level-only diagnostics + call this%register_diagnostic_field(registry, '{{ diagnostic.name }}', & + '{{ diagnostic.description }}', & + '{{ diagnostic.units }}', DIAG_REAL_3D, & + '{{ config.name }}', dims_3d_levels, rc=rc) {% else %} + ! Register single field for scalar diagnostics call this%register_diagnostic_field(registry, '{{ diagnostic.name }}', & '{{ diagnostic.description }}', & '{{ diagnostic.units }}', {{ diag_props.data_type }}, & - '{{ config.name }}', {{ diag_props.fortran_dims }}, rc) + '{{ config.name }}', {{ diag_props.fortran_dims }}, rc=rc) {% endif %} if (rc /= CC_SUCCESS) return @@ -1582,9 +1586,9 @@ contains {% for diagnostic in config.diagnostics %} {% set _ = allocated_diagnostics.append(diagnostic.name) %} {% if ('per_level' in diagnostic.name or 'level' in diagnostic.name) and ('per_bin' in diagnostic.name or 'bin' in diagnostic.name or 'per_species' in diagnostic.name) %} - ! 2D diagnostic: levels x species - if (nz > 0 .and. this%process_config%{{ config.name }}_config%n_species > 0) then - allocate(this%column_{{ diagnostic.name }}(nz, this%process_config%{{ config.name }}_config%n_species)) + ! 2D diagnostic: levels x diagnostic_species + if (nz > 0 .and. this%process_config%{{ config.name }}_config%n_diagnostic_species > 0) then + allocate(this%column_{{ diagnostic.name }}(nz, this%process_config%{{ config.name }}_config%n_diagnostic_species)) end if if (allocated(this%column_{{ diagnostic.name }})) this%column_{{ diagnostic.name }} = 0.0_fp {% elif 'per_level' in diagnostic.name or 'level' in diagnostic.name %} @@ -1617,9 +1621,9 @@ contains {% if diagnostic.name not in allocated_diagnostics %} {% set _ = allocated_diagnostics.append(diagnostic.name) %} {% if ('per_level' in diagnostic.name or 'level' in diagnostic.name) and ('per_bin' in diagnostic.name or 'bin' in diagnostic.name) %} - ! 2D diagnostic: levels x species - if (nz > 0 .and. this%process_config%{{ config.name }}_config%n_species > 0) then - allocate(this%column_{{ diagnostic.name }}(nz, this%process_config%{{ config.name }}_config%n_species)) + ! 2D diagnostic: levels x diagnostic_species + if (nz > 0 .and. this%process_config%{{ config.name }}_config%n_diagnostic_species > 0) then + allocate(this%column_{{ diagnostic.name }}(nz, this%process_config%{{ config.name }}_config%n_diagnostic_species)) end if if (allocated(this%column_{{ diagnostic.name }})) this%column_{{ diagnostic.name }} = 0.0_fp {% elif 'per_level' in diagnostic.name or 'level' in diagnostic.name %} @@ -1659,9 +1663,9 @@ contains {% if diagnostic.name not in allocated_diagnostics %} {% set _ = allocated_diagnostics.append(diagnostic.name) %} {% if ('per_level' in diagnostic.name or 'level' in diagnostic.name) and ('per_bin' in diagnostic.name or 'bin' in diagnostic.name) %} - ! 2D diagnostic: levels x species - if (nz > 0 .and. this%process_config%{{ config.name }}_config%n_species > 0) then - allocate(this%column_{{ diagnostic.name }}(nz, this%process_config%{{ config.name }}_config%n_species)) + ! 2D diagnostic: levels x diagnostic_species + if (nz > 0 .and. this%process_config%{{ config.name }}_config%n_diagnostic_species > 0) then + allocate(this%column_{{ diagnostic.name }}(nz, this%process_config%{{ config.name }}_config%n_diagnostic_species)) end if if (allocated(this%column_{{ diagnostic.name }})) this%column_{{ diagnostic.name }} = 0.0_fp {% elif 'per_level' in diagnostic.name or 'level' in diagnostic.name %} @@ -1695,9 +1699,9 @@ contains ! Allocate common diagnostic fields (used by all schemes) {% for diagnostic in config.diagnostics %} {% if ('per_level' in diagnostic.name or 'level' in diagnostic.name) and ('per_bin' in diagnostic.name or 'bin' in diagnostic.name or 'per_species' in diagnostic.name) %} - ! 2D diagnostic: levels x species - if (nz > 0 .and. this%process_config%{{ config.name }}_config%n_species > 0) then - allocate(this%column_{{ diagnostic.name }}(nz, this%process_config%{{ config.name }}_config%n_species)) + ! 2D diagnostic: levels x diagnostic_species + if (nz > 0 .and. this%process_config%{{ config.name }}_config%n_diagnostic_species > 0) then + allocate(this%column_{{ diagnostic.name }}(nz, this%process_config%{{ config.name }}_config%n_diagnostic_species)) end if if (allocated(this%column_{{ diagnostic.name }})) this%column_{{ diagnostic.name }} = 0.0_fp {% elif 'per_level' in diagnostic.name or 'level' in diagnostic.name %} @@ -1720,17 +1724,16 @@ contains {% endfor %} ! Allocate scheme-specific diagnostics - selected_scheme = trim(this%process_config%{{ config.name }}_config%scheme) - select case (selected_scheme) + select case (trim(this%process_config%{{ config.name }}_config%scheme)) {% for scheme in config.schemes %} case ('{{ scheme.name }}') ! Scheme-specific diagnostics for {{ scheme.name }} {% if scheme.scheme_diagnostics %} {% for diagnostic in scheme.scheme_diagnostics %} -{% if ('per_level' in diagnostic.name or 'level' in diagnostic.name) and ('per_bin' in diagnostic.name or 'bin' in diagnostic.name) %} - ! 2D diagnostic: levels x species - if (nz > 0 .and. this%process_config%{{ config.name }}_config%n_species > 0) then - allocate(this%column_{{ diagnostic.name }}(nz, this%process_config%{{ config.name }}_config%n_species)) +{% if ('per_level' in diagnostic.name or 'level' in diagnostic.name) and ('per_bin' in diagnostic.name or 'bin' in diagnostic.name or 'per_species' in diagnostic.name) %} + ! 2D diagnostic: levels x diagnostic_species + if (nz > 0 .and. this%process_config%{{ config.name }}_config%n_diagnostic_species > 0) then + allocate(this%column_{{ diagnostic.name }}(nz, this%process_config%{{ config.name }}_config%n_diagnostic_species)) end if if (allocated(this%column_{{ diagnostic.name }})) this%column_{{ diagnostic.name }} = 0.0_fp {% elif 'per_level' in diagnostic.name or 'level' in diagnostic.name %} @@ -1791,9 +1794,24 @@ contains {% set updated_diagnostics = [] %} {% for diagnostic in config.diagnostics %} {% set _ = updated_diagnostics.append(diagnostic.name) %} -{% if 'per_bin' in diagnostic.name or 'per_species' in diagnostic.name %} +{% set has_level_pattern = ('per_level' in diagnostic.name or 'level' in diagnostic.name) %} +{% set has_species_pattern = ('per_bin' in diagnostic.name or 'per_species' in diagnostic.name) %} +{% if has_level_pattern and has_species_pattern %} +{% set clean_name = diagnostic.name.replace('_per_bin', '').replace('_per_species', '').replace('_per_level', '') %} + ! Update individual 3D fields for each diagnostic species (level + species diagnostics) + if (this%process_config%{{ config.name }}_config%n_diagnostic_species > 0) then + do i = 1, this%process_config%{{ config.name }}_config%n_diagnostic_species + write(field_name, '(A,A,A)') '{{ clean_name }}_', & + trim(this%process_config%{{ config.name }}_config%diagnostic_species(i)) + call this%update_1d_diagnostic_column(trim(field_name), & + this%column_{{ diagnostic.name }}(:,i), & + i_col, j_col, container, rc) + if (rc /= CC_SUCCESS) return + end do + end if +{% elif has_species_pattern and not has_level_pattern %} {% set clean_name = diagnostic.name.replace('_per_bin', '').replace('_per_species', '') %} - ! Update individual species diagnostic fields + ! Update individual species diagnostic fields (species-only diagnostics) if (this%process_config%{{ config.name }}_config%n_diagnostic_species > 0) then do i = 1, this%process_config%{{ config.name }}_config%n_diagnostic_species write(field_name, '(A,A,A)') '{{ clean_name }}_', & @@ -1804,14 +1822,8 @@ contains if (rc /= CC_SUCCESS) return end do end if -{% elif ('per_level' in diagnostic.name or 'level' in diagnostic.name) and ('per_bin' in diagnostic.name or 'bin' in diagnostic.name or 'per_species' in diagnostic.name) %} - ! 2D diagnostic field - call this%update_2d_diagnostic_column('{{ diagnostic.name }}', & - this%column_{{ diagnostic.name }}, & - i_col, j_col, container, rc) - if (rc /= CC_SUCCESS) return -{% elif 'per_level' in diagnostic.name or 'level' in diagnostic.name or 'per_bin' in diagnostic.name or 'bin' in diagnostic.name %} - ! 1D diagnostic field +{% elif has_level_pattern and not has_species_pattern %} + ! 1D diagnostic field (level-only) call this%update_1d_diagnostic_column('{{ diagnostic.name }}', & this%column_{{ diagnostic.name }}, & i_col, j_col, container, rc) @@ -1919,43 +1931,52 @@ contains ! No aerosol scheme diagnostics for unknown schemes end select {% else %} - selected_scheme = trim(this%process_config%{{ config.name }}_config%scheme) - - select case (selected_scheme) + select case (trim(this%process_config%{{ config.name }}_config%scheme)) {% for scheme in config.schemes %} case ("{{ scheme.name }}") ! Scheme-specific diagnostics for {{ scheme.name }} {% if scheme.scheme_diagnostics %} {% for diagnostic in scheme.scheme_diagnostics %} -{% if ('per_level' in diagnostic.name or 'level' in diagnostic.name) and ('per_bin' in diagnostic.name or 'bin' in diagnostic.name or 'per_species' in diagnostic.name) %} - ! Update 2D level-species diagnostics (map to 4D global fields) - if (allocated(this%column_{{ diagnostic.name }})) then - call this%update_2d_diagnostic_column('{{ diagnostic.name }}', & - this%column_{{ diagnostic.name }}, & - i_col, j_col, container, rc) - if (rc /= CC_SUCCESS) return +{% set has_level_pattern = ('per_level' in diagnostic.name or 'level' in diagnostic.name) %} +{% set has_species_pattern = ('per_bin' in diagnostic.name or 'per_species' in diagnostic.name) %} +{% if has_level_pattern and has_species_pattern %} +{% set clean_name = diagnostic.name.replace('_per_bin', '').replace('_per_species', '').replace('_per_level', '') %} + ! Update individual 3D fields for each diagnostic species (level + species diagnostics) + if (this%process_config%{{ config.name }}_config%n_diagnostic_species > 0) then + do i = 1, this%process_config%{{ config.name }}_config%n_diagnostic_species + write(field_name, '(A,A,A)') '{{ clean_name }}_', & + trim(this%process_config%{{ config.name }}_config%diagnostic_species(i)) + call this%update_1d_diagnostic_column(trim(field_name), & + this%column_{{ diagnostic.name }}(:,i), & + i_col, j_col, container, rc) + if (rc /= CC_SUCCESS) return + end do end if -{% elif 'per_level' in diagnostic.name or 'level' in diagnostic.name or 'per_bin' in diagnostic.name or 'bin' in diagnostic.name or 'per_species' in diagnostic.name %} +{% elif has_species_pattern and not has_level_pattern %} {% set clean_name = diagnostic.name.replace('_per_bin', '').replace('_per_species', '') %} - ! Update individual fields for each diagnostic species + ! Update individual species diagnostic fields (species-only diagnostics) if (this%process_config%{{ config.name }}_config%n_diagnostic_species > 0) then do i = 1, this%process_config%{{ config.name }}_config%n_diagnostic_species write(field_name, '(A,A,A)') '{{ clean_name }}_', & trim(this%process_config%{{ config.name }}_config%diagnostic_species(i)) call this%update_scalar_diagnostic_column(trim(field_name), & - this%column_{{ diagnostic.name }}(i), & - i_col, j_col, container, rc) + this%column_{{ diagnostic.name }}(i), & + i_col, j_col, container, rc) if (rc /= CC_SUCCESS) return end do end if +{% elif has_level_pattern and not has_species_pattern %} + ! 1D diagnostic field (level-only) + call this%update_1d_diagnostic_column('{{ diagnostic.name }}', & + this%column_{{ diagnostic.name }}, & + i_col, j_col, container, rc) + if (rc /= CC_SUCCESS) return {% else %} - ! Update scalar diagnostics (map to 2D global fields) - if (allocated(this%column_{{ diagnostic.name }})) then - call this%update_scalar_diagnostic_column('{{ diagnostic.name }}', & - this%column_{{ diagnostic.name }}, & - i_col, j_col, container, rc) - if (rc /= CC_SUCCESS) return - end if + ! Scalar diagnostic field + call this%update_scalar_diagnostic_column('{{ diagnostic.name }}', & + this%column_{{ diagnostic.name }}, & + i_col, j_col, container, rc) + if (rc /= CC_SUCCESS) return {% endif %} {% endfor %} {% endif %} diff --git a/tools/process_generator/templates/scheme_module.F90.j2 b/tools/process_generator/templates/scheme_module.F90.j2 index 52e5b57d..6f5e5062 100644 --- a/tools/process_generator/templates/scheme_module.F90.j2 +++ b/tools/process_generator/templates/scheme_module.F90.j2 @@ -26,6 +26,9 @@ module {{ config.class_name }}Scheme_{{ scheme.class_name }}_Mod use precision_mod, only: fp use {{ config.class_name }}Common_Mod, only: {{ config.class_name }}Scheme{{ scheme.class_name }}Config use Constants, only: PI !load the constants needed for this scheme +{% if scheme.required_species_properties and 'mie_map' in scheme.required_species_properties %} + use GOCART2G_MieMod, only: GOCART2G_Mie ! For Mie data in {{ scheme.name }} scheme +{% endif %} implicit none private @@ -51,8 +54,8 @@ contains {% if config.process_behavior and config.process_behavior.species_filter and config.process_behavior.species_filter.type == "emission_mapping" %} !! @param[in] n_species_mapping Number of chemical species per emission species (num_species) {% endif %} -{% set all_met_fields = scheme | all_required_met_fields %} -{% for field in all_met_fields %} +{% set scheme_met_fields = scheme|scheme_only_met_fields %} +{% for field in scheme_met_fields %} {% if field is string %} {% if field_classifier.get_field_type(field) == 'special_timestep' %} !! @param[in] {{ field | lower | replace('-', '_') | replace('.', '_') }} Time step [s] - retrieved from process interface @@ -63,6 +66,16 @@ contains !! @param[in] {{ field.variable_name }} {{ field.description }} [{{ field.units }}] {% endif %} {% endfor %} +{% if scheme.required_species_properties and scheme.required_species_properties|length > 0 %} +{% for prop in scheme.required_species_properties %} +{% if prop == 'mie_map' %} + !! @param[in] mie_data Complete Mie data array from ChemState + !! @param[in] species_mie_map Mapping from process species to MieData indices +{% else %} + !! @param[in] species_{{ prop }} Species {{ prop }} property +{% endif %} +{% endfor %} +{% endif %} !! @param[in] species_conc Species concentrations [mol/mol] (num_layers, num_species) !! @param[inout] species_tendencies Species tendency terms [mol/mol/s] (num_layers, num_species) {% if config.diagnostics %} @@ -72,7 +85,9 @@ contains {% set diag_units = diag.get('units', 'units') if diag is mapping else 'units' %} {% set diag_dims = diag.get('dimensions', 'auto') if diag is mapping else 'auto' %} {% if diag_dims == 'auto' %} -{% if 'per_species' in diag_name or 'per_bin' in diag_name %} +{% if 'per_species_per_level' in diag_name %} + !! @param[inout] {{ diag_name }} {{ diag_desc }} [{{ diag_units }}] (num_layers, num_species) +{% elif 'per_species' in diag_name or 'per_bin' in diag_name %} !! @param[inout] {{ diag_name }} {{ diag_desc }} [{{ diag_units }}] (num_species) {% else %} !! @param[inout] {{ diag_name }} {{ diag_desc }} [{{ diag_units }}] @@ -95,7 +110,11 @@ contains {% set diag_units = diag.get('units', 'units') if diag is mapping else 'units' %} {% set diag_dims = diag.get('dimensions', 'auto') if diag is mapping else 'auto' %} {% if diag_dims == 'auto' %} -{% if 'per_species' in diag_name or 'per_bin' in diag_name %} +{% if ('per_level' in diag_name or 'level' in diag_name) and ('per_species' in diag_name or 'per_bin' in diag_name) %} + !! @param[inout] {{ diag_name }} {{ diag_desc }} [{{ diag_units }}] (num_layers, num_species) +{% elif 'per_level' in diag_name or 'level' in diag_name %} + !! @param[inout] {{ diag_name }} {{ diag_desc }} [{{ diag_units }}] (num_layers) +{% elif 'per_species' in diag_name or 'per_bin' in diag_name %} !! @param[inout] {{ diag_name }} {{ diag_desc }} [{{ diag_units }}] (num_species) {% else %} !! @param[inout] {{ diag_name }} {{ diag_desc }} [{{ diag_units }}] @@ -111,15 +130,17 @@ contains {% endif %} {% endfor %} {% endif %} +{% if config.diagnostics or scheme.scheme_diagnostics %} !! @param[in] diagnostic_species_id Indices mapping diagnostic species to species array (optional, for per-species diagnostics) +{% endif %} pure subroutine compute_{{ scheme.name }}( & num_layers, & num_species, & {% if config.process_behavior and config.process_behavior.species_filter and config.process_behavior.species_filter.type == "emission_mapping" %} n_species_mapping, & {% endif %} - params{% if all_met_fields and all_met_fields|length > 0 %}, & -{% for field in all_met_fields %} + params{% if scheme_met_fields and scheme_met_fields|length > 0 %}, & +{% for field in scheme_met_fields %} {% if field is string %} {{ field | lower | replace('-', '_') | replace('.', '_') }}{% if not loop.last %}, & {% endif %} @@ -130,7 +151,12 @@ contains {% endfor %}{% endif %}, & {% if scheme.required_species_properties and scheme.required_species_properties|length > 0 %} {% for prop in scheme.required_species_properties %} +{% if prop == 'mie_map' %} + mie_data, & + species_mie_map, & +{% else %} species_{{ prop }}, & +{% endif %} {% endfor %} {% endif %} species_conc, & @@ -148,8 +174,8 @@ contains integer, intent(in) :: n_species_mapping(num_species) ! Number of chem species per emission species {% endif %} type({{ config.class_name }}Scheme{{ scheme.class_name }}Config), intent(in) :: params -{% if all_met_fields and all_met_fields|length > 0 %} -{% for field in all_met_fields %} +{% if scheme_met_fields and scheme_met_fields|length > 0 %} +{% for field in scheme_met_fields %} {% if field is string %} {% set field_name = field %} {% set var_name = field | lower | replace('-', '_') | replace('.', '_') %} @@ -197,7 +223,12 @@ contains {% endif %} {% if scheme.required_species_properties and scheme.required_species_properties|length > 0 %} {% for prop in scheme.required_species_properties %} - {{ field_classifier.get_species_property_data_type(prop) }}, intent(in) :: species_{{ prop }}(num_species) ! Species {{ prop }} property +{% if prop == 'mie_map' %} + type(GOCART2G_Mie), intent(in) :: mie_data(:) ! Complete Mie data array from ChemState + integer, intent(in) :: species_mie_map(num_species) ! Mapping from process species to MieData indices +{% else %} + {{ field_classifier.get_species_property_data_type(prop) }}, intent(in) :: species_{{ prop }}{{ field_classifier.get_species_property_dimensions(prop) }} ! Species {{ prop }} property +{% endif %} {% endfor %} {% endif %} {% if config.process_behavior and config.process_behavior.species_filter and config.process_behavior.species_filter.type == "emission_mapping" %} @@ -214,7 +245,9 @@ contains {% set diag_name = diag['name'] if diag is mapping else diag %} {% set diag_dims = diag.get('dimensions', 'auto') if diag is mapping else 'auto' %} {% if diag_dims == 'auto' %} -{% if 'per_species' in diag_name or 'per_bin' in diag_name %} +{% if 'per_species_per_level' in diag_name %} + real(fp), intent(inout), optional :: {{ diag_name }}(:,:) +{% elif 'per_species' in diag_name or 'per_bin' in diag_name %} real(fp), intent(inout), optional :: {{ diag_name }}(:) {% else %} real(fp), intent(inout), optional :: {{ diag_name }} @@ -224,7 +257,7 @@ contains {% elif diag_dims == '1d' or diag_dims == 'num_species' %} real(fp), intent(inout), optional :: {{ diag_name }}(:) {% elif diag_dims == 'num_layers' %} - real(fp), intent(inout), optional :: {{ diag_name }}(num_layers) + real(fp), intent(inout), optional :: {{ diag_name }}(:) {% else %} real(fp), intent(inout), optional :: {{ diag_name }}({{ diag_dims }}) {% endif %} @@ -235,7 +268,11 @@ contains {% set diag_name = diag['name'] if diag is mapping else diag %} {% set diag_dims = diag.get('dimensions', 'auto') if diag is mapping else 'auto' %} {% if diag_dims == 'auto' %} -{% if 'per_species' in diag_name or 'per_bin' in diag_name %} +{% if ('per_level' in diag_name or 'level' in diag_name) and ('per_species' in diag_name or 'per_bin' in diag_name) %} + real(fp), intent(inout), optional :: {{ diag_name }}(:,:) +{% elif 'per_level' in diag_name or 'level' in diag_name %} + real(fp), intent(inout), optional :: {{ diag_name }}(:) +{% elif 'per_species' in diag_name or 'per_bin' in diag_name %} real(fp), intent(inout), optional :: {{ diag_name }}(:) {% else %} real(fp), intent(inout), optional :: {{ diag_name }} @@ -245,7 +282,7 @@ contains {% elif diag_dims == '1d' or diag_dims == 'num_species' %} real(fp), intent(inout), optional :: {{ diag_name }}(:) {% elif diag_dims == 'num_layers' %} - real(fp), intent(inout), optional :: {{ diag_name }}(num_layers) + real(fp), intent(inout), optional :: {{ diag_name }}(:) {% else %} real(fp), intent(inout), optional :: {{ diag_name }}({{ diag_dims }}) {% endif %} @@ -282,9 +319,9 @@ contains environmental_factor = 1.0_fp ! Apply scheme-specific environmental responses based on meteorological fields -{% set all_met_fields = scheme|all_required_met_fields %} -{% if all_met_fields and all_met_fields|length > 0 %} -{% for field in all_met_fields %} +{% set scheme_met_fields = scheme|scheme_only_met_fields %} +{% if scheme_met_fields and scheme_met_fields|length > 0 %} +{% for field in scheme_met_fields %} {% if field is string %} {% if field == "temperature_2m" %} ! Temperature response (customize for your scheme) @@ -429,7 +466,19 @@ contains {% set diag_desc = diag.get('description', 'diagnostic') if diag is mapping else 'diagnostic' %} {% set diag_dims = diag.get('dimensions', 'auto') if diag is mapping else 'auto' %} {% if diag_dims == 'auto' %} -{% if 'per_species' in diag_name or 'per_bin' in diag_name %} +{% if 'per_species_per_level' in diag_name %} + ! Per-species-per-level diagnostic: 2D array (levels, species) + if (present({{ diag_name }}) .and. present(diagnostic_species_id)) then + ! Find position of this species in diagnostic_species_id array + do diag_idx = 1, size(diagnostic_species_id) + if (diagnostic_species_id(diag_idx) == species_idx) then + ! Add your custom {{ diag_desc | lower }} calculation + {{ diag_name }}(k, diag_idx) = species_tendencies(k, species_idx) * 1.0_fp ! TODO: Replace with actual calculation + exit + end if + end do + end if +{% elif 'per_species' in diag_name or 'per_bin' in diag_name %} ! Per-species diagnostic: only update for diagnostic species if (present({{ diag_name }}) .and. present(diagnostic_species_id)) then ! Find position of this species in diagnostic_species_id array @@ -483,7 +532,21 @@ contains {% set diag_desc = diag.get('description', 'diagnostic') if diag is mapping else 'diagnostic' %} {% set diag_dims = diag.get('dimensions', 'auto') if diag is mapping else 'auto' %} {% if diag_dims == 'auto' %} -{% if 'per_species' in diag_name or 'per_bin' in diag_name %} +{% set has_level_pattern = ('per_level' in diag_name or 'level' in diag_name) %} +{% set has_species_pattern = ('per_species' in diag_name or 'per_bin' in diag_name) %} +{% if has_level_pattern and has_species_pattern %} + ! Per-species-per-level diagnostic: 2D array (levels, species) + if (present({{ diag_name }}) .and. present(diagnostic_species_id)) then + ! Find position of this species in diagnostic_species_id array + do diag_idx = 1, size(diagnostic_species_id) + if (diagnostic_species_id(diag_idx) == species_idx) then + ! Add your custom {{ diag_desc | lower }} calculation + {{ diag_name }}(k, diag_idx) = species_tendencies(k, species_idx) * 1.0_fp ! TODO: Replace with actual calculation + exit + end if + end do + end if +{% elif has_species_pattern and not has_level_pattern %} ! Per-species diagnostic: only update for diagnostic species if (present({{ diag_name }}) .and. present(diagnostic_species_id)) then ! Find position of this species in diagnostic_species_id array @@ -495,6 +558,12 @@ contains end if end do end if +{% elif has_level_pattern and not has_species_pattern %} + ! Per-level diagnostic: update for current level + if (present({{ diag_name }})) then + ! Add your custom {{ diag_desc | lower }} calculation + {{ diag_name }}(k) = {{ diag_name }}(k) + species_tendencies(k, species_idx) * 1.0_fp ! TODO: Replace with actual calculation + end if {% else %} if (present({{ diag_name }})) then ! Add your custom {{ diag_desc | lower }} calculation