diff --git a/bld/CLMBuildNamelist.pm b/bld/CLMBuildNamelist.pm
index 4d4522a4cd..2c356cc9e9 100755
--- a/bld/CLMBuildNamelist.pm
+++ b/bld/CLMBuildNamelist.pm
@@ -1581,6 +1581,7 @@ sub process_namelist_inline_logic {
setup_logic_luna($opts, $nl_flags, $definition, $defaults, $nl, $physv);
setup_logic_hillslope($opts, $nl_flags, $definition, $defaults, $nl);
setup_logic_o3_veg_stress_method($opts, $nl_flags, $definition, $defaults, $nl,$physv);
+ setup_logic_do3_streams($opts, $nl_flags, $definition, $defaults, $nl, $physv);
setup_logic_hydrstress($opts, $nl_flags, $definition, $defaults, $nl);
setup_logic_dynamic_roots($opts, $nl_flags, $definition, $defaults, $nl, $physv);
setup_logic_params_file($opts, $nl_flags, $definition, $defaults, $nl);
diff --git a/bld/namelist_files/namelist_defaults_ctsm.xml b/bld/namelist_files/namelist_defaults_ctsm.xml
index 6f07fc0ffe..2bced86626 100644
--- a/bld/namelist_files/namelist_defaults_ctsm.xml
+++ b/bld/namelist_files/namelist_defaults_ctsm.xml
@@ -1733,8 +1733,8 @@ lnd/clm2/surfdata_esmf/NEON/surfdata_1x1_NEON_TOOL_hist_78pfts_CMIP6_simyr2000_c
.false.
-/glade/work/afoster/ozone_damage_files/converted/diurnal_factor_O3surface_ssp370_2015-2024_c20220502.nc
-$DIN_LOC_ROOT/share/meshes/fv0.9x1.25_141008_polemod_ESMFmesh.nc
+/glade/work/afoster/ozone_update/ozone_damage_files/converted/diurnal_factor_O3surface_ssp370_2015-2024_c20220502.nc
+share/meshes/fv0.9x1.25_141008_polemod_ESMFmesh.nc
bilinear
diff --git a/src/biogeophys/DiurnalOzoneType.F90 b/src/biogeophys/DiurnalOzoneType.F90
index 88f83426e0..7d332c241f 100644
--- a/src/biogeophys/DiurnalOzoneType.F90
+++ b/src/biogeophys/DiurnalOzoneType.F90
@@ -92,32 +92,32 @@ end subroutine InitAllocate
!-----------------------------------------------------------------------
!-----------------------------------------------------------------------
- subroutine Interp(this, forc_o3, forc_o3_down)
+ subroutine Interp(this, bounds, forc_o3, forc_o3_down)
!
! !DESCRIPTION:
! Downscale/interpolate multi-day ozone data to subdaily
!
! !USES:
- use clm_time_manager , only : get_curr_time
+ use clm_time_manager , only : get_curr_date
use clm_varcon , only : secspday
!
! !ARGUMENTS:
class(diurnal_ozone_anom_type), intent(in) :: this
- real(r8), intent(in) :: forc_o3(bounds%begg:bounds%endg) ! ozone partial pressure (mol/mol)
- real(r8), intent(out) :: forc_o3_down(bounds%begg:bounds%endg) ! ozone partial pressure, downscaled (mol/mol)
+ type(bounds_type), intent(in) :: bounds ! bounds type
+ real(r8), intent(in) :: forc_o3(:) ! ozone partial pressure (mol/mol)
+ real(r8), intent(out) :: forc_o3_down(:) ! ozone partial pressure, downscaled (mol/mol)
+
!
! LOCAL VARIABLES:
- integer :: t ! looping index
- integer :: yr ! year
- integer :: mon ! month
+ integer :: t ! looping index
+ integer :: yr ! year
+ integer :: mon ! month
integer :: day ! day of month
integer :: tod ! time of day (seconds past 0Z)
integer :: begg, endg ! bounds
integer :: t_prev ! previous time index
- real(r8) :: anomaly_val_start
- real(r8) :: anomaly_val_end
- real(r8) :: anomaly_scalar
- real(r8) :: tdiff_end, tdiff_start
+ real(r8) :: tdiff_end
+ real(r8) :: tdiff_start
real(r8) :: tdiff
!-----------------------------------------------------------------------
@@ -135,6 +135,7 @@ subroutine Interp(this, forc_o3, forc_o3_down)
! interpolate, checking for edge cases
if (t == 1) then
+ ! wrap around back
t_prev = this%ntimes
tdiff_end = secspday - this%time_arr(t_prev) + real(tod)
tdiff = this%time_arr(t) + secspday - this%time_arr(t_prev)
@@ -144,14 +145,12 @@ subroutine Interp(this, forc_o3, forc_o3_down)
tdiff = this%time_arr(t) - this%time_arr(t_prev)
end if
- anomaly_val_start = this%o3_anomaly_grc(begg:endg, t_prev)
- anomaly_val_end = this%o3_anomaly_grc(begg:endg, t)
tdiff_start = this%time_arr(t) - real(tod)
! interpolate
- anomaly_scalar = (anomaly_val_start*tdiff_start + anomaly_val_end*tdiff_end)/tdiff
-
- forc_o3_down(begg:endg) = forc_o3(begg:endg)*anomaly_scalar
+ forc_o3_down(begg:endg) = forc_o3(begg:endg)* &
+ ((this%o3_anomaly_grc(begg:endg, t_prev)*tdiff_start + &
+ this%o3_anomaly_grc(begg:endg, t_prev)*tdiff_end)/tdiff)
end subroutine Interp
diff --git a/src/biogeophys/OzoneMod.F90 b/src/biogeophys/OzoneMod.F90
index 73622117de..5c799aae7f 100644
--- a/src/biogeophys/OzoneMod.F90
+++ b/src/biogeophys/OzoneMod.F90
@@ -419,7 +419,7 @@ subroutine CalcOzoneUptake(this, bounds, num_exposedvegp, filter_exposedvegp, &
)
if (this%atm_ozone_freq == atm_ozone_frequency_multiday_average) then
- call this%diurnalOzoneAnomInst%Interp(forc_o3, forc_o3_down)
+ call this%diurnalOzoneAnomInst%Interp(bounds, forc_o3, forc_o3_down)
else
forc_o3_down(bounds%begg:bounds%endg) = forc_o3(bounds%begg:bounds%endg)
end if
diff --git a/src/cpl/nuopc/lnd_import_export.F90 b/src/cpl/nuopc/lnd_import_export.F90
index 647d468960..30c9f6eec3 100644
--- a/src/cpl/nuopc/lnd_import_export.F90
+++ b/src/cpl/nuopc/lnd_import_export.F90
@@ -22,7 +22,6 @@ module lnd_import_export
use shr_megan_mod , only : shr_megan_readnl, shr_megan_mechcomps_n
use nuopc_shr_methods , only : chkerr
use lnd_import_export_utils , only : check_for_errors, check_for_nans
- use diurnalOzoneStreamMod , only : dO3_init
implicit none
private ! except
@@ -1331,7 +1330,7 @@ subroutine ReadCapNamelist( NLFilename, rc )
integer, target :: tmp(1)
type(ESMF_VM) :: vm
character(*), parameter :: nml_name = "ctsm_nuopc_cap" ! MUST match with namelist name below
-
+
namelist /ctsm_nuopc_cap/ force_send_to_atm
@@ -1356,7 +1355,7 @@ subroutine ReadCapNamelist( NLFilename, rc )
! Broadcast namelist to all processors
call ESMF_VMBroadcast(vm, tmp, 1, 0, rc=rc)
-
+
force_send_to_atm = (tmp(1) == 1)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
diff --git a/src/main/clm_varctl.F90 b/src/main/clm_varctl.F90
index 7d0b2b55ad..82f4cdb40b 100644
--- a/src/main/clm_varctl.F90
+++ b/src/main/clm_varctl.F90
@@ -27,27 +27,27 @@ module clm_varctl
! Run control variables
!
! case id
- character(len=256), public :: caseid = ' '
+ character(len=256), public :: caseid = ' '
! case title
- character(len=256), public :: ctitle = ' '
+ character(len=256), public :: ctitle = ' '
! Type of run
- integer, public :: nsrest = iundef
+ integer, public :: nsrest = iundef
logical, public :: is_cold_start = .false.
! Startup from initial conditions
- integer, public, parameter :: nsrStartup = 0
+ integer, public, parameter :: nsrStartup = 0
! Continue from restart files
- integer, public, parameter :: nsrContinue = 1
+ integer, public, parameter :: nsrContinue = 1
! Branch from restart files
- integer, public, parameter :: nsrBranch = 2
+ integer, public, parameter :: nsrBranch = 2
! true => allow case name to remain the same for branch run
! by default this is not allowed
- logical, public :: brnch_retain_casename = .false.
+ logical, public :: brnch_retain_casename = .false.
! true => run tests of ncdio_pio
logical, public :: for_testing_run_ncdiopio_tests = .false.
@@ -74,19 +74,19 @@ module clm_varctl
logical, public :: for_testing_no_crop_seed_replenishment = .false.
! Hostname of machine running on
- character(len=256), public :: hostname = ' '
+ character(len=256), public :: hostname = ' '
! username of user running program
- character(len=256), public :: username = ' '
+ character(len=256), public :: username = ' '
! description of this source
character(len=256), public :: source = "Community Terrestrial Systems Model"
! version of program
- character(len=256), public :: version = " "
+ character(len=256), public :: version = " "
! dataset conventions
- character(len=256), public :: conventions = "CF-1.0"
+ character(len=256), public :: conventions = "CF-1.0"
! component name for filenames (history or restart files)
character(len=8), public :: compname = 'clm2'
@@ -120,14 +120,14 @@ module clm_varctl
!----------------------------------------------------------
! Flag to read ndep rather than obtain it from coupler
!----------------------------------------------------------
-
+
logical, public :: ndep_from_cpl = .false.
!----------------------------------------------------------
! Interpolation of finidat if requested
!----------------------------------------------------------
- logical, public :: bound_h2osoi = .true. ! for debugging
+ logical, public :: bound_h2osoi = .true. ! for debugging
! If finidat_interp_source is non-blank and finidat is blank then interpolation will be
! done from finidat_interp_source to finidat_interp_dest. Note that
@@ -150,8 +150,8 @@ module clm_varctl
logical, public, parameter :: use_crop_agsys = .false.
! true => separate crop landunit is not created by default
- logical, public :: create_crop_landunit = .false.
-
+ logical, public :: create_crop_landunit = .false.
+
! number of hillslopes per landunit
integer, public :: nhillslope = 0
@@ -159,14 +159,14 @@ module clm_varctl
integer, public :: max_columns_hillslope = 1
! do not irrigate by default
- logical, public :: irrigate = .false.
+ logical, public :: irrigate = .false.
! set saturated excess runoff to zero for crops
logical, public :: crop_fsat_equals_zero = .false.
! remove this fraction of crop residues to a 1-year product pool (instead of going to litter)
real(r8), public :: crop_residue_removal_frac = 0.0
-
+
!----------------------------------------------------------
! Other subgrid logic
!----------------------------------------------------------
@@ -175,7 +175,7 @@ module clm_varctl
logical, public :: run_zero_weight_urban = .false.
! true => make ALL patches, cols & landunits active (even if weight is 0)
- logical, public :: all_active = .false.
+ logical, public :: all_active = .false.
! true => any ocean (i.e., "wetland") points on the surface dataset are converted to
! bare ground (or whatever vegetation is given in that grid cell... but typically this
@@ -198,33 +198,33 @@ module clm_varctl
!----------------------------------------------------------
! values of 'prognostic','diagnostic','constant'
- character(len=16), public :: co2_type = 'constant'
+ character(len=16), public :: co2_type = 'constant'
- ! State of the model for the accelerated decomposition (AD) spinup.
+ ! State of the model for the accelerated decomposition (AD) spinup.
! 0 (default) = normal model; 1 = AD SPINUP
- integer, public :: spinup_state = 0
+ integer, public :: spinup_state = 0
! true => anoxia is applied to heterotrophic respiration also considered in CH4 model
! default value reset in controlMod
- logical, public :: anoxia = .true.
+ logical, public :: anoxia = .true.
! used to override an error check on reading in restart files
- logical, public :: override_bgc_restart_mismatch_dump = .false.
+ logical, public :: override_bgc_restart_mismatch_dump = .false.
! Set in CNAllocationInit (TODO - had to move it here to avoid circular dependency)
- logical, private:: carbon_only
+ logical, private:: carbon_only
- ! Set in CNNDynamicsInit
+ ! Set in CNNDynamicsInit
! NOTE (mvertens, 2014-9 had to move it here to avoid confusion when carbon data types
- ! wehre split - TODO - should move it our of this module)
+ ! wehre split - TODO - should move it our of this module)
! NOTE(bandre, 2013-10) according to Charlie Koven, nfix_timeconst
- ! is currently used as a flag and rate constant.
+ ! is currently used as a flag and rate constant.
! Rate constant: time over which to exponentially relax the npp flux for N fixation term
! (days) time over which to exponentially relax the npp flux for N fixation term
- ! flag: (if <= 0. or >= 365; use old annual method).
+ ! flag: (if <= 0. or >= 365; use old annual method).
! Default value is junk that should always be overwritten by the namelist or init function!
!
- real(r8), public :: nfix_timeconst = -1.2345_r8
+ real(r8), public :: nfix_timeconst = -1.2345_r8
!----------------------------------------------------------
! Physics
@@ -244,10 +244,16 @@ module clm_varctl
! ozone vegitation stress method, valid values: unset, stress_lombardozzi2015, stress_falk
character(len=64), public :: o3_veg_stress_method = 'unset'
+ ! other o3_streams parameters
+ logical, public :: use_do3_streams = .false.
+ character(len=fname_len), public :: stream_fldfilename_do3
+ character(len=fname_len), public :: stream_meshfile_do3
+ character(len=fname_len), public :: do3_mapalgo
+
real(r8), public :: o3_ppbv = 100._r8
! number of wavelength bands used in SNICAR snow albedo calculation
- integer, public :: snicar_numrad_snw = 5
+ integer, public :: snicar_numrad_snw = 5
! type of downward solar radiation spectrum for SNICAR snow albedo calculation
! options:
@@ -316,7 +322,7 @@ module clm_varctl
integer, public :: fates_parteh_mode = -9 ! 1 => carbon only
! 2 => C+N+P (not enabled yet)
! no others enabled
- integer, public :: fates_spitfire_mode = 0
+ integer, public :: fates_spitfire_mode = 0
! 0 for no fire; 1 for constant ignitions;
! > 1 for external data (lightning and/or anthropogenic ignitions)
! see bld/namelist_files/namelist_definition_clm4_5.xml for details
@@ -336,13 +342,13 @@ module clm_varctl
! Performing this output can be expensive, so we allow different history dimension
! levels.
! The first index is output at the model timescale
- ! The second index is output at the dynamics (daily) timescale
+ ! The second index is output at the dynamics (daily) timescale
! 0 - no output
! 1 - include only column level means (3D)
! 2 - include output that includes the 4th dimension
-
+
integer, dimension(2), public :: fates_history_dimlevel = (/2,2/)
-
+
logical, public :: use_fates_luh = .false. ! true => use FATES landuse data mode
character(len=256), public :: fluh_timeseries = '' ! filename for fates landuse timeseries data
character(len=256), public :: fates_inventory_ctrl_filename = '' ! filename for inventory control
@@ -351,9 +357,9 @@ module clm_varctl
! BUT... THEY CAN BOTH BE OFF (IF FATES IS OFF)
logical, public :: use_fates_sp = .false. ! true => use FATES satellite phenology mode
logical, public :: use_fates_bgc = .false. ! true => use FATES along with CLM soil biogeochemistry
-
+
!----------------------------------------------------------
- ! LUNA switches
+ ! LUNA switches
!----------------------------------------------------------
logical, public :: use_luna = .false. ! true => use LUNA
@@ -373,7 +379,7 @@ module clm_varctl
integer, public :: carbon_resp_opt = 0
!----------------------------------------------------------
- ! prescribed soil moisture streams switch
+ ! prescribed soil moisture streams switch
!----------------------------------------------------------
logical, public :: use_soil_moisture_streams = .false. ! true => use prescribed soil moisture stream
@@ -436,11 +442,11 @@ module clm_varctl
! glacier_mec control variables: default values (may be overwritten by namelist)
!----------------------------------------------------------
- ! true => CLM glacier area & topography changes dynamically
- logical , public :: glc_do_dynglacier = .false.
+ ! true => CLM glacier area & topography changes dynamically
+ logical , public :: glc_do_dynglacier = .false.
! number of days before one considers the perennially snow-covered point 'land ice'
- integer , public :: glc_snow_persistence_max_days = 7300
+ integer , public :: glc_snow_persistence_max_days = 7300
!
!----------------------------------------------------------
@@ -464,21 +470,21 @@ module clm_varctl
!----------------------------------------------------------
! number of segments per clump for decomp
- integer, public :: nsegspc = 20
+ integer, public :: nsegspc = 20
!----------------------------------------------------------
! Derived variables (run, history and restart file)
!----------------------------------------------------------
! directory name for local restart pointer file
- character(len=256), public :: rpntdir = '.'
+ character(len=256), public :: rpntdir = '.'
! file name for local restart pointer file
- character(len=256), public :: rpntfil = 'rpointer.lnd'
+ character(len=256), public :: rpntfil = 'rpointer.lnd'
! moved hist_wrtch4diag from histFileMod.F90 to here - caused compiler error with intel
! namelist: write CH4 extra diagnostic output
- logical, public :: hist_wrtch4diag = .false.
+ logical, public :: hist_wrtch4diag = .false.
! namelist: write list of all history fields to a file for use in documentation
logical, public :: hist_fields_list_file = .false.
@@ -532,7 +538,7 @@ subroutine clm_varctl_set( caseid_in, ctitle_in, brnch_retain_casename_in, &
! !ARGUMENTS:
character(len=256), optional, intent(IN) :: caseid_in ! case id
character(len=256), optional, intent(IN) :: ctitle_in ! case title
- logical, optional, intent(IN) :: brnch_retain_casename_in ! true => allow case name to remain the
+ logical, optional, intent(IN) :: brnch_retain_casename_in ! true => allow case name to remain the
! same for branch run
logical, optional, intent(IN) :: single_column_in ! true => single column mode
real(r8), optional, intent(IN) :: scmlat_in ! single column lat
diff --git a/src/main/controlMod.F90 b/src/main/controlMod.F90
index 46d9e9958a..fb61a0a958 100644
--- a/src/main/controlMod.F90
+++ b/src/main/controlMod.F90
@@ -244,8 +244,9 @@ subroutine control_init(dtime)
use_fates_tree_damage, &
fates_history_dimlevel
- ! Ozone vegetation stress method
- namelist / clm_inparm / o3_veg_stress_method
+ ! Ozone vegetation stress method and streams file
+ namelist / clm_inparm / o3_veg_stress_method, use_do3_streams, &
+ stream_fldfilename_do3, stream_meshfile_do3, do3_mapalgo
! CLM 5.0 nitrogen flags
namelist /clm_inparm/ use_flexibleCN, use_luna
@@ -465,7 +466,7 @@ subroutine control_init(dtime)
else
use_fates_bgc = .true.
end if
-
+
if (fates_parteh_mode == 1 .and. suplnitro == suplnNon .and. use_fates_bgc )then
write(iulog,*) ' When FATES with fates_parteh_mode == 1 (ie carbon only mode),'
write(iulog,*) ' you must have supplemental nitrogen turned on, there will be'
@@ -474,7 +475,7 @@ subroutine control_init(dtime)
call endrun(msg=' ERROR: fates_parteh_mode=1 must have suplnitro set to suplnAll.'//&
errMsg(sourcefile, __LINE__))
end if
-
+
if ( use_cn) then
call endrun(msg=' ERROR: use_cn and use_fates cannot both be set to true.'//&
errMsg(sourcefile, __LINE__))
@@ -506,21 +507,21 @@ subroutine control_init(dtime)
end if
else
-
+
! These do default to false anyway, but this emphasizes they
! are false when fates is false
use_fates_sp = .false.
use_fates_bgc = .false.
-
+
end if
! Check compatibility with use_lai_streams
if (use_lai_streams) then
- if ((use_fates .and. .not. use_fates_sp) .or. use_cn) then
+ if ((use_fates .and. .not. use_fates_sp) .or. use_cn) then
call endrun(msg=' ERROR: cannot use LAI streams unless in SP mode (use_cn = .false. or use_fates_sp=.true.).'//&
errMsg(sourcefile, __LINE__))
- end if
- end if
+ end if
+ end if
! If nfix_timeconst is equal to the junk default value, then it was not specified
! by the user namelist and we need to assign it the correct default value. If the
@@ -774,7 +775,7 @@ subroutine control_spmd()
! BGC
call mpi_bcast (co2_type, len(co2_type), MPI_CHARACTER, 0, mpicom, ier)
-
+
call mpi_bcast (use_fates, 1, MPI_LOGICAL, 0, mpicom, ier)
if (use_cn .or. use_fates) then
@@ -987,6 +988,10 @@ subroutine control_print ()
write(iulog,*) ' use_grainproduct = ', use_grainproduct
write(iulog,*) ' crop_residue_removal_frac = ', crop_residue_removal_frac
write(iulog,*) ' o3_veg_stress_method = ', o3_veg_stress_method
+ write(iulog,*) ' use_do3_streams = ', use_do3_streams
+ write(iulog,*) ' stream_fldfilename_do3 = ', stream_fldfilename_do3
+ write(iulog,*) ' stream_meshfile_do3 = ', stream_meshfile_do3
+ write(iulog,*) ' do3_mapalgo = ', do3_mapalgo
write(iulog,*) ' use_snicar_frc = ', use_snicar_frc
write(iulog,*) ' snicar_use_aerosol = ',snicar_use_aerosol
write(iulog,*) ' use_vancouver = ', use_vancouver