diff --git a/biogeochem/EDCanopyStructureMod.F90 b/biogeochem/EDCanopyStructureMod.F90 index 83f10a26b5..8b5ddf79ff 100644 --- a/biogeochem/EDCanopyStructureMod.F90 +++ b/biogeochem/EDCanopyStructureMod.F90 @@ -35,6 +35,7 @@ module EDCanopyStructureMod use FatesInterfaceTypesMod , only : hlm_use_planthydro use FatesInterfaceTypesMod , only : hlm_use_cohort_age_tracking use FatesInterfaceTypesMod , only : hlm_use_sp + use FatesInterfaceTypesMod , only : hlm_use_edge_forest use FatesInterfaceTypesMod , only : numpft use FatesInterfaceTypesMod, only : bc_in_type use FatesPlantHydraulicsMod, only : UpdateH2OVeg,InitHydrCohort, RecruitWaterStorage @@ -1319,6 +1320,9 @@ subroutine canopy_summarization( nsites, sites, bc_in ) use FatesSizeAgeTypeIndicesMod, only : coagetype_class_index use EDtypesMod , only : area use FatesConstantsMod , only : itrue + use FatesEcotypesMod , only : IsPatchForest + use EDParamsMod , only : forest_tree_fraction_threshold + use FatesEdgeForestMod , only : CalculateEdgeForestArea ! !ARGUMENTS integer , intent(in) :: nsites @@ -1447,9 +1451,15 @@ subroutine canopy_summarization( nsites, sites, bc_in ) currentPatch%total_canopy_area = currentPatch%area endif + currentPatch%is_forest = IsPatchForest(currentPatch, forest_tree_fraction_threshold) + currentPatch => currentPatch%younger end do !patch loop + if (hlm_use_edge_forest == itrue) then + call CalculateEdgeForestArea(sites(s)) + end if + call leaf_area_profile(sites(s)) if(hlm_radiation_model.eq.twostr_solver) then diff --git a/biogeochem/EDPatchDynamicsMod.F90 b/biogeochem/EDPatchDynamicsMod.F90 index 6c181b936d..a099b26354 100644 --- a/biogeochem/EDPatchDynamicsMod.F90 +++ b/biogeochem/EDPatchDynamicsMod.F90 @@ -680,7 +680,8 @@ subroutine spawn_patches( currentSite, bc_in ) call newPatch%Create(age, site_areadis, i_landusechange_receiverpatchlabel, i_nocomp_pft, & num_swb, numpft, currentSite%nlevsoil, hlm_current_tod, & - hlm_regeneration_model) + hlm_regeneration_model, & + currentSite%youngest_patch) ! Initialize the litter pools to zero, these ! pools will be populated by looping over the existing patches @@ -1442,7 +1443,7 @@ subroutine spawn_patches( currentSite, bc_in ) call buffer_patch%Create(0._r8, 0._r8, i_land_use_label, 0, & num_swb, numpft, currentSite%nlevsoil, hlm_current_tod, & - hlm_regeneration_model) + hlm_regeneration_model, currentSite%youngest_patch) ! Initialize the litter pools to zero do el=1,num_elements @@ -1735,7 +1736,7 @@ subroutine split_patch(currentSite, currentPatch, new_patch, fraction_to_keep, a call new_patch%Create(0._r8, temp_area, & currentPatch%land_use_label, currentPatch%nocomp_pft_label, & num_swb, numpft, currentSite%nlevsoil, hlm_current_tod, & - hlm_regeneration_model) + hlm_regeneration_model, currentSite%youngest_patch) ! Initialize the litter pools to zero, these ! pools will be populated shortly @@ -3272,6 +3273,14 @@ subroutine fuse_2_patches(csite, dp, rp) ! Radiation rp%rad_error(1) = (dp%rad_error(1)*dp%area + rp%rad_error(1)*rp%area) * inv_sum_area rp%rad_error(2) = (dp%rad_error(2)*dp%area + rp%rad_error(2)*rp%area) * inv_sum_area + + ! Fire weather + rp%fireWeather%precip = (dp%fireWeather%precip*dp%area + rp%fireWeather%precip*rp%area) * inv_sum_area + rp%fireWeather%rh = (dp%fireWeather%rh*dp%area + rp%fireWeather%rh*rp%area) * inv_sum_area + rp%fireWeather%temp_C = (dp%fireWeather%temp_C*dp%area + rp%fireWeather%temp_C*rp%area) * inv_sum_area + rp%fireWeather%wind = (dp%fireWeather%wind*dp%area + rp%fireWeather%wind*rp%area) * inv_sum_area + rp%fireWeather%fire_weather_index = (dp%fireWeather%fire_weather_index*dp%area + rp%fireWeather%fire_weather_index*rp%area) * inv_sum_area + rp%fireWeather%effective_windspeed = (dp%fireWeather%effective_windspeed*dp%area + rp%fireWeather%effective_windspeed*rp%area) * inv_sum_area rp%area = rp%area + dp%area !THIS MUST COME AT THE END! diff --git a/biogeochem/FatesPatchMod.F90 b/biogeochem/FatesPatchMod.F90 index 0132f7c7ef..6a2198e8d2 100644 --- a/biogeochem/FatesPatchMod.F90 +++ b/biogeochem/FatesPatchMod.F90 @@ -32,6 +32,9 @@ module FatesPatchMod use FatesRadiationMemMod, only : num_rad_stream_types use FatesInterfaceTypesMod, only : hlm_hio_ignore_val use FatesInterfaceTypesMod, only : numpft + use FatesInterfaceTypesMod, only : nlevedgeforest + use SFFireWeatherMod, only : fire_weather + use SFNesterovMod, only : nesterov_index use shr_infnan_mod, only : nan => shr_infnan_nan, assignment(=) use shr_log_mod, only : errMsg => shr_log_errMsg @@ -74,6 +77,12 @@ module FatesPatchMod !--------------------------------------------------------------------------- + ! FOREST INFO + logical :: is_forest ! whether the patch is "forest" according to FATES param file criteria + real(r8), dimension(:), allocatable :: area_in_edgeforest_bins + + !--------------------------------------------------------------------------- + ! RUNNING MEANS !class(rmean_type), pointer :: t2m ! place-holder for 2m air temperature (variable window-size) class(rmean_type), pointer :: tveg24 ! 24-hour mean vegetation temperature [K] @@ -201,9 +210,17 @@ module FatesPatchMod !--------------------------------------------------------------------------- ! FUELS AND FIRE + ! fire weather + class(fire_weather), pointer :: fireWeather ! fire weather object + ! fuel characteristics real(r8) :: livegrass ! total aboveground grass biomass in patch [kgC/m2] + ! number of fires + real(r8) :: fdi ! daily probability an ignition event will start a fire + real(r8) :: NF ! daily ignitions in km2 + real(r8) :: NF_successful ! daily ignitions in km2 that actually lead to fire + ! fire spread real(r8) :: ros_front ! rate of forward spread of fire [m/min] real(r8) :: ros_back ! rate of backward spread of fire [m/min] @@ -258,7 +275,7 @@ module FatesPatchMod !=========================================================================== - subroutine Init(this, num_swb, num_levsoil) + subroutine Init(this, num_swb, num_levsoil, from_patch_for_fire) ! ! DESCRIPTION: ! Initialize a new patch - allocate arrays and set values to nan and/or 0.0 @@ -268,6 +285,7 @@ subroutine Init(this, num_swb, num_levsoil) class(fates_patch_type), intent(inout) :: this ! patch object integer, intent(in) :: num_swb ! number of shortwave broad-bands to track integer, intent(in) :: num_levsoil ! number of soil layers + class(fates_patch_type), intent(in), optional :: from_patch_for_fire ! patch to take fire info from ! allocate arrays allocate(this%tr_soil_dir(num_swb)) @@ -279,6 +297,21 @@ subroutine Init(this, num_swb, num_levsoil) allocate(this%sabs_dir(num_swb)) allocate(this%sabs_dif(num_swb)) allocate(this%fragmentation_scaler(num_levsoil)) + allocate(this%area_in_edgeforest_bins(nlevedgeforest)) + + ! allocate and copy or initialize patch-level fire info + allocate(nesterov_index :: this%fireWeather) + if (present(from_patch_for_fire)) then + call this%fireWeather%CopyFrom(from_patch_for_fire%fireWeather) + this%FDI = from_patch_for_fire%FDI + this%NF = from_patch_for_fire%NF + this%NF_successful = from_patch_for_fire%NF_successful + else + call this%fireWeather%Init() + this%FDI = 0.0_r8 + this%NF = 0.0_r8 + this%NF_successful = 0.0_r8 + end if ! initialize all values to nan call this%NanValues() @@ -453,6 +486,10 @@ subroutine NanValues(this) this%ncl_p = fates_unset_int this%land_use_label = fates_unset_int this%age_since_anthro_disturbance = nan + + ! FOREST INFO + this%is_forest = .false. + this%area_in_edgeforest_bins(:) = nan ! LEAF ORGANIZATION this%pft_agb_profile(:,:) = nan @@ -706,7 +743,7 @@ end subroutine InitLitter !=========================================================================== subroutine Create(this, age, area, land_use_label, nocomp_pft, num_swb, num_pft, & - num_levsoil, current_tod, regeneration_model) + num_levsoil, current_tod, regeneration_model, from_patch_for_fire) ! ! DESCRIPTION: ! create a new patch with input and default values @@ -723,10 +760,15 @@ subroutine Create(this, age, area, land_use_label, nocomp_pft, num_swb, num_pft, integer, intent(in) :: num_levsoil ! number of soil layers integer, intent(in) :: current_tod ! time of day [seconds past 0Z] integer, intent(in) :: regeneration_model ! regeneration model version + class(fates_patch_type), intent(in), optional :: from_patch_for_fire ! patch to take fire info from ! initialize patch ! sets all values to nan, then some values to zero - call this%Init(num_swb, num_levsoil) + if (present(from_patch_for_fire)) then + call this%Init(num_swb, num_levsoil, from_patch_for_fire) + else + call this%Init(num_swb, num_levsoil) + end if ! initialize running means for patch call this%InitRunningMeans(current_tod, regeneration_model, num_pft) @@ -898,6 +940,7 @@ subroutine FreeMemory(this, regeneration_model, numpft) this%sabs_dir, & this%sabs_dif, & this%fragmentation_scaler, & + this%area_in_edgeforest_bins, & stat=istat, errmsg=smsg) ! These arrays are allocated via a call from EDCanopyStructureMod @@ -1227,6 +1270,7 @@ subroutine Dump(this) write(fates_log(),*) 'pa%ncl_p = ',this%ncl_p write(fates_log(),*) 'pa%total_canopy_area = ',this%total_canopy_area write(fates_log(),*) 'pa%total_tree_area = ',this%total_tree_area + write(fates_log(),*) 'pa%is_forest = ',this%is_forest write(fates_log(),*) 'pa%total_grass_area = ',this%total_grass_area write(fates_log(),*) 'pa%zstar = ',this%zstar write(fates_log(),*) 'pa%gnd_alb_dif = ',this%gnd_alb_dif(:) diff --git a/fire/SFEquationsMod.F90 b/fire/SFEquationsMod.F90 index ab8fcc16c3..96794144b7 100644 --- a/fire/SFEquationsMod.F90 +++ b/fire/SFEquationsMod.F90 @@ -442,10 +442,6 @@ real(r8) function AreaBurnt(fire_size, num_ignitions, FDI) ! daily area burnt = size fires in m2 * num ignitions per day per km2 * prob ignition starts fire ! Thonicke 2010 Eq. 1 ! - ! the denominator in the units of currentSite%NF is total gridcell area, but since we assume that ignitions - ! are equally probable across patches, currentSite%NF is equivalently per area of a given patch - ! thus AreaBurnt has units of m2 burned area per km2 patch area per day - ! ! TO DO: Connect here with the Li & Levis GDP fire suppression algorithm. ! Equation 16 in arora and boer model JGR 2005 ! diff --git a/fire/SFFireWeatherMod.F90 b/fire/SFFireWeatherMod.F90 index 37bc45eed8..128e513ff7 100644 --- a/fire/SFFireWeatherMod.F90 +++ b/fire/SFFireWeatherMod.F90 @@ -12,10 +12,17 @@ module SFFireWeatherMod real(r8) :: effective_windspeed ! effective wind speed, corrected for by tree/grass cover [m/min] integer :: rx_flag ! prescribed fire burn window flag [1=burn window present; 0=no burn window] + real(r8) :: temp_C ! daily averaged temperature [deg C] + real(r8) :: precip ! daily precip [mm/day] + real(r8) :: rh ! daily relative humidity [%] + real(r8) :: wind ! wind speed [m/min] + contains procedure(initialize_fire_weather), public, deferred :: Init - procedure(update_fire_weather), public, deferred :: UpdateIndex + procedure(copy_fire_weather), public, deferred :: CopyFrom + procedure(update_fire_weather_index), public, deferred :: UpdateIndex + procedure, public :: UpdateFireWeatherData procedure, public :: UpdateEffectiveWindSpeed procedure, public :: UpdateRxfireBurnWindow @@ -30,25 +37,49 @@ subroutine initialize_fire_weather(this) end subroutine initialize_fire_weather - subroutine update_fire_weather(this, temp_C, precip, rh, wind) + subroutine copy_fire_weather(this, from) + + import :: fire_weather + + class(fire_weather), intent(inout) :: this + class(fire_weather), intent(in) :: from + + end subroutine copy_fire_weather + + subroutine update_fire_weather_index(this) use FatesConstantsMod, only : r8 => fates_r8 import :: fire_weather class(fire_weather), intent(inout) :: this - real(r8), intent(in) :: temp_C - real(r8), intent(in) :: precip - real(r8), intent(in) :: rh - real(r8), intent(in) :: wind - end subroutine update_fire_weather + end subroutine update_fire_weather_index end interface contains - subroutine UpdateEffectiveWindSpeed(this, wind_speed, tree_fraction, grass_fraction, & + subroutine UpdateFireWeatherData(this, temp_C, precip, rh, wind) + ! + ! DESCRIPTION: + ! Updates fire weather variables + + ! ARGUMENTS + class(fire_weather), intent(inout) :: this ! fire weather class + real(r8), intent(in) :: temp_C ! daily averaged temperature [degrees C] + real(r8), intent(in) :: precip ! daily precipitation [mm] + real(r8), intent(in) :: rh ! daily relative humidity [%] + real(r8), intent(in) :: wind ! daily wind speed [m/min] + + this%temp_C = temp_C + this%precip = precip + this%rh = rh + this%wind = wind + + end subroutine UpdateFireWeatherData + + subroutine UpdateEffectiveWindSpeed(this, tree_fraction, grass_fraction, & bare_fraction) ! ! DESCRIPTION: @@ -60,25 +91,23 @@ subroutine UpdateEffectiveWindSpeed(this, wind_speed, tree_fraction, grass_fract ! ARGUMENTS class(fire_weather), intent(inout) :: this ! fire weather class - real(r8), intent(in) :: wind_speed ! wind speed [m/min] real(r8), intent(in) :: tree_fraction ! tree fraction [0-1] real(r8), intent(in) :: grass_fraction ! grass fraction [0-1] real(r8), intent(in) :: bare_fraction ! bare ground fraction [0-1] - this%effective_windspeed = wind_speed*(tree_fraction*wind_atten_treed + & + this%effective_windspeed = this%wind * (tree_fraction*wind_atten_treed + & (grass_fraction + bare_fraction)*wind_atten_grass) end subroutine UpdateEffectiveWindSpeed - subroutine UpdateRxfireBurnWindow(this, rxfire_switch, temp_C, rh, wind, temp_up, & + subroutine UpdateRxfireBurnWindow(this, rxfire_switch, temp_up, & temp_low,rh_up, rh_low, wind_up, wind_low) + use FatesConstantsMod, only : sec_per_min + ! ARGUMENTS class(fire_weather), intent(inout) :: this ! fire weather class - real(r8), intent(in) :: temp_C ! daily averaged temperature [degrees C] integer, intent(in) :: rxfire_switch ! whether prescribed fire is turned on - real(r8), intent(in) :: rh ! daily relative humidity [%] - real(r8), intent(in) :: wind ! wind speed [m/min] real(r8), intent(in) :: temp_up ! user defined upper bound for temp when define a burn window real(r8), intent(in) :: temp_low ! user defined lower bound for temp when define a burn window real(r8), intent(in) :: rh_up ! user defined upper bound for relative humidity @@ -87,11 +116,15 @@ subroutine UpdateRxfireBurnWindow(this, rxfire_switch, temp_C, rh, wind, temp_up real(r8), intent(in) :: wind_low ! user defined lower bound for wind speed ! LOCAL VARIABLES + real(r8) :: wind_m_per_s ! wind speed (m/s) real(r8) :: t_check ! intermediate value derived from temp condition check real(r8) :: rh_check ! intermediate value derived from RH condition check real(r8) :: ws_check ! intermediate value derived from wind speed condition check if (rxfire_switch .eq. ifalse) return + + ! Convert from m/min to m/s + wind_m_per_s = this%wind / sec_per_min ! check if ambient temperature, relative humidity, and wind speed ! are within user defined ranges by comparing current weather @@ -99,9 +132,9 @@ subroutine UpdateRxfireBurnWindow(this, rxfire_switch, temp_C, rh, wind, temp_up ! it should result in negative value or zero (at the boundary condition) ! for each check below - t_check = (temp_C - temp_low)*(temp_C - temp_up) - rh_check = (rh - rh_low)*(rh - rh_up) - ws_check = (wind - wind_low)*(wind - wind_up) + t_check = (this%temp_C - temp_low)*(this%temp_C - temp_up) + rh_check = (this%rh - rh_low)*(this%rh - rh_up) + ws_check = (wind_m_per_s - wind_low)*(wind_m_per_s - wind_up) if (t_check <= 0.0_r8 .and. rh_check <= 0.0_r8 .and. ws_check <= 0.0_r8) then this%rx_flag = 1 diff --git a/fire/SFMainMod.F90 b/fire/SFMainMod.F90 index 7e6de3323b..007faceab6 100644 --- a/fire/SFMainMod.F90 +++ b/fire/SFMainMod.F90 @@ -18,6 +18,7 @@ module SFMainMod use FatesInterfaceTypesMod, only : hlm_sf_scalar_lightning_def use FatesInterfaceTypesMod, only : hlm_sf_successful_ignitions_def use FatesInterfaceTypesMod, only : hlm_sf_anthro_ignitions_def + use FatesInterfaceTypesMod, only : hlm_use_edge_forest use FatesInterfaceTypesMod, only : bc_in_type use EDPftvarcon, only : EDPftvarcon_inst use PRTParametersMod, only : prt_params @@ -32,12 +33,14 @@ module SFMainMod use FatesInterfaceTypesMod, only : numpft use FatesAllometryMod, only : CrownDepth use FatesFuelClassesMod, only : fuel_classes + use FatesEdgeForestMod, only : ApplyEdgeForestFlamToSite implicit none private public :: DailyFireModel public :: UpdateFuelCharacteristics + public :: UpdateFireWeather ! TROUBLESHOOTING ! ====================================================================================== @@ -70,7 +73,7 @@ end subroutine DailyFireModel !--------------------------------------------------------------------------------------- - subroutine UpdateFireWeather(currentSite, bc_in) + subroutine UpdateFireWeather(currentSite, bc_in, update_weather_only) ! ! DESCRIPTION: ! Updates the site's fire weather index, burn window for prescribed fire, and calculates effective windspeed based on @@ -81,7 +84,7 @@ subroutine UpdateFireWeather(currentSite, bc_in) use FatesConstantsMod, only : tfrz => t_water_freeze_k_1atm use FatesConstantsMod, only : sec_per_day, sec_per_min - use EDTypesMod, only : CalculateTreeGrassAreaSite + use FatesEdgeForestMod, only : CalculateTreeGrassAreaSite use FatesInterfaceTypesMod, only : hlm_use_managed_fire use SFParamsMod, only : SF_val_rxfire_tpup, SF_val_rxfire_tplw, SF_val_rxfire_rhup, & SF_val_rxfire_rhlw, SF_val_rxfire_wdup, SF_val_rxfire_wdlw @@ -89,55 +92,87 @@ subroutine UpdateFireWeather(currentSite, bc_in) ! ARGUMENTS: type(ed_site_type), intent(inout), target :: currentSite type(bc_in_type), intent(in) :: bc_in + logical, optional, intent(in) :: update_weather_only ! LOCALS: type(fates_patch_type), pointer :: currentPatch ! patch object + type(fates_patch_type), pointer :: oldestvegPatch ! object for oldest vegetated patch real(r8) :: temp_C ! daily averaged temperature [deg C] real(r8) :: precip ! daily precip [mm/day] real(r8) :: rh ! daily relative humidity [%] - real(r8) :: wind ! wind speed [m/s] + real(r8) :: wind ! wind speed [m/min] real(r8) :: tree_fraction ! site-level tree fraction [0-1] real(r8) :: grass_fraction ! site-level grass fraction [0-1] real(r8) :: bare_fraction ! site-level bare ground fraction [0-1] integer :: iofp ! index of oldest the fates patch + logical :: do_update_weather_only ! NOTE that the boundary conditions of temperature, precipitation and relative humidity ! are available at the patch level. We are currently using a simplification where the whole site ! is simply using the values associated with the first patch. ! which probably won't have much impact, unless we decide to ever calculated fire weather for each patch. - currentPatch => currentSite%oldest_patch - - ! If the oldest patch is a bareground patch (i.e. nocomp mode is on) use the first vegetated patch - ! for the iofp index (i.e. the next younger patch) - if (currentPatch%nocomp_pft_label == nocomp_bareground) then - currentPatch => currentPatch%younger - endif + ! Calculate site-level tree, grass, and bare fraction. + ! This should remain at site level to allow wind speed enhancement based on edge distance. + call CalculateTreeGrassAreaSite(currentSite, tree_fraction, grass_fraction, bare_fraction) - iofp = currentPatch%patchno - temp_C = currentPatch%tveg24%GetMean() - tfrz + ! TODO SSR: Before my edge-flammability work, the temperature used here across the site was + ! taken from the oldest vegetated patch. Using patch-level temperatures should thus be expected + ! to introduce diffs. This TEMPORARY code block is designed to test whether the diffs I've seen + ! are indeed due to that. + ! TODO SSR: Also using that patch's other fire weather variables, just to be extra safe. + oldestvegPatch => currentSite%oldest_patch + if (oldestvegPatch%nocomp_pft_label == nocomp_bareground) then + oldestvegPatch => oldestvegPatch%younger + end if + temp_C = oldestvegPatch%tveg24%GetMean() - tfrz ! Convert K to °C + iofp = oldestvegPatch%patchno precip = bc_in%precip24_pa(iofp)*sec_per_day rh = bc_in%relhumid24_pa(iofp) - wind = bc_in%wind24_pa(iofp) + wind = bc_in%wind24_pa(iofp) * sec_per_min - ! convert to m/min - currentSite%wind = wind*sec_per_min + ! TODO: Remove. Useful during development but probably not needed in production. + currentSite%ovp_relhumid24 = rh + currentSite%ovp_wind24 = wind - ! update fire weather index - call currentSite%fireWeather%UpdateIndex(temp_C, precip, rh, wind) + ! Save site-level fire weather (i.e., before considering edge forest flammability enhancements) + ! to patch%fireWeather + currentPatch => currentSite%oldest_patch + patchloop1: do while(associated(currentPatch)) + call currentPatch%fireWeather%UpdateFireWeatherData(temp_C, precip, rh, wind) + call currentPatch%fireWeather%UpdateEffectiveWindSpeed(tree_fraction, & + grass_fraction, bare_fraction) + currentPatch => currentPatch%younger + end do patchloop1 - ! update prescribed fire burn window - call currentSite%fireWeather%UpdateRxfireBurnWindow(hlm_use_managed_fire, temp_C, rh, wind, & - SF_val_rxfire_tpup, SF_val_rxfire_tplw, SF_val_rxfire_rhup, SF_val_rxfire_rhlw, & - SF_val_rxfire_wdup, SF_val_rxfire_wdlw) + ! Apply edge forest flammability enhancements to patch%fireWeather + if (hlm_use_edge_forest) then + call ApplyEdgeForestFlamToSite(currentSite) + end if - ! calculate site-level tree, grass, and bare fraction - call CalculateTreeGrassAreaSite(currentSite, tree_fraction, grass_fraction, bare_fraction) + ! If we only wanted to update fire weather data, we're done + if (.not. present(update_weather_only)) then + do_update_weather_only = .false. + else + do_update_weather_only = update_weather_only + end if + if (do_update_weather_only) then + return + end if - ! update effective wind speed - call currentSite%fireWeather%UpdateEffectiveWindSpeed(wind*sec_per_min, tree_fraction, & - grass_fraction, bare_fraction) - + currentPatch => currentSite%oldest_patch + patchloop2: do while(associated(currentPatch)) + + ! update fire weather index + call currentPatch%fireWeather%UpdateIndex() + + ! update prescribed fire burn window + call currentPatch%fireWeather%UpdateRxfireBurnWindow(hlm_use_managed_fire, & + SF_val_rxfire_tpup, SF_val_rxfire_tplw, SF_val_rxfire_rhup, SF_val_rxfire_rhlw, & + SF_val_rxfire_wdup, SF_val_rxfire_wdlw) + + currentPatch => currentPatch%younger + end do patchloop2 end subroutine UpdateFireWeather !--------------------------------------------------------------------------------------- @@ -178,7 +213,7 @@ subroutine UpdateFuelCharacteristics(currentSite) ! calculate fuel moisture [m3/m3] call currentPatch%fuel%UpdateFuelMoisture(SF_val_SAV, SF_val_drying_ratio, & - currentSite%fireWeather) + currentPatch%fireWeather) ! calculate geometric properties call currentPatch%fuel%AverageBulkDensity_NoTrunks(SF_val_FBD) @@ -218,47 +253,47 @@ subroutine CalculateIgnitionsandFDI(currentSite, bc_in) real(r8), parameter :: igns_per_person_month = 0.0035_r8 ! potential human ignition counts (alpha in Li et al. 2012) (#/person/month) real(r8), parameter :: approx_days_per_month = 30.0_r8 ! approximate days per month [days] - ! initialize site parameters to zero - currentSite%NF_successful = 0.0_r8 - - ! Equation 7 from Venevsky et al GCB 2002 (modification of equation 8 in Thonicke et al. 2010) - ! FDI 0.1 = low, 0.3 moderate, 0.75 high, and 1 = extreme ignition potential for alpha 0.000337 - if (hlm_spitfire_mode == hlm_sf_successful_ignitions_def) then - ! READING "SUCCESSFUL IGNITION" DATA - ! force ignition potential to be extreme - ! cloud_to_ground_strikes = 1 means using 100% of incoming observed ignitions - currentSite%FDI = 1.0_r8 - cloud_to_ground_strikes = 1.0_r8 - else - ! USING LIGHTNING STRIKE DATA - currentSite%FDI = 1.0_r8 - exp(-SF_val_fdi_alpha*currentSite%fireWeather%fire_weather_index) - cloud_to_ground_strikes = cg_strikes - end if - - ! if the oldest patch is a bareground patch (i.e. nocomp mode is on) use the first vegetated patch - ! for the iofp index (i.e. the next younger patch) currentPatch => currentSite%oldest_patch - if (currentPatch%nocomp_pft_label == nocomp_bareground)then - currentPatch => currentPatch%younger - endif - iofp = currentPatch%patchno - - ! NF = number of lighting strikes per day per km2 scaled by cloud to ground strikes - if (hlm_spitfire_mode == hlm_sf_scalar_lightning_def) then - currentSite%NF = ED_val_nignitions*years_per_day*cloud_to_ground_strikes - else - ! use external daily lightning ignition data - currentSite%NF = bc_in%lightning24(iofp)*cloud_to_ground_strikes - end if + patchloop: do while(associated(currentPatch)) + + ! initialize patch parameters to zero + currentPatch%NF_successful = 0.0_r8 + + ! Equation 7 from Venevsky et al GCB 2002 (modification of equation 8 in Thonicke et al. 2010) + ! FDI 0.1 = low, 0.3 moderate, 0.75 high, and 1 = extreme ignition potential for alpha 0.000337 + if (hlm_spitfire_mode == hlm_sf_successful_ignitions_def) then + ! READING "SUCCESSFUL IGNITION" DATA + ! force ignition potential to be extreme + ! cloud_to_ground_strikes = 1 means using 100% of incoming observed ignitions + currentPatch%FDI = 1.0_r8 + cloud_to_ground_strikes = 1.0_r8 + else + ! USING LIGHTNING STRIKE DATA + currentPatch%FDI = 1.0_r8 - exp(-SF_val_fdi_alpha*currentPatch%fireWeather%fire_weather_index) + cloud_to_ground_strikes = cg_strikes + end if - ! calculate anthropogenic ignitions according to Li et al. (2012) - ! add to ignitions by lightning - if (hlm_spitfire_mode == hlm_sf_anthro_ignitions_def) then - ! anthropogenic ignitions (count/km2/day) - ! = (ignitions/person/month)*6.8*population_density**0.43/approximate days per month - anthro_ignitions = igns_per_person_month*6.8_r8*bc_in%pop_density(iofp)**0.43_r8/approx_days_per_month - currentSite%NF = currentSite%NF + anthro_ignitions - end if + iofp = currentPatch%patchno + + ! NF = number of lighting strikes per day per km2 scaled by cloud to ground strikes + if (hlm_spitfire_mode == hlm_sf_scalar_lightning_def) then + currentPatch%NF = ED_val_nignitions*years_per_day*cloud_to_ground_strikes + else + ! use external daily lightning ignition data + currentPatch%NF = bc_in%lightning24(iofp)*cloud_to_ground_strikes + end if + + ! calculate anthropogenic ignitions according to Li et al. (2012) + ! add to ignitions by lightning + if (hlm_spitfire_mode == hlm_sf_anthro_ignitions_def) then + ! anthropogenic ignitions (count/km2/day) + ! = (ignitions/person/month)*6.8*population_density**0.43/approximate days per month + anthro_ignitions = igns_per_person_month*6.8_r8*bc_in%pop_density(iofp)**0.43_r8/approx_days_per_month + currentPatch%NF = currentPatch%NF + anthro_ignitions + end if + + currentPatch => currentPatch%younger + end do patchloop !patch loop end subroutine CalculateIgnitionsandFDI @@ -325,7 +360,7 @@ subroutine CalculateSurfaceRateOfSpread(currentSite) eps = EffectiveHeatingNumber(currentPatch%fuel%SAV_notrunks) ! wind factor [unitless] - phi_wind = WindFactor(currentSite%fireWeather%effective_windspeed, beta_ratio, & + phi_wind = WindFactor(currentPatch%fireWeather%effective_windspeed, beta_ratio, & currentPatch%fuel%SAV_notrunks) ! propagating flux [unitless] @@ -338,7 +373,7 @@ subroutine CalculateSurfaceRateOfSpread(currentSite) ! backwards rate of spread [m/min] ! backward ROS wind not changed by vegetation - so use wind, not effective_windspeed currentPatch%ROS_back = BackwardRateOfSpread(currentPatch%ROS_front, & - currentSite%wind) + currentPatch%fireWeather%wind) end if currentPatch => currentPatch%younger @@ -394,9 +429,9 @@ subroutine CalculateSurfaceFireIntensity(currentSite) currentPatch%rx_FI = 0.0_r8 currentPatch%nonrx_FI = 0.0_r8 - has_ignition = currentSite%NF > 0.0_r8 + has_ignition = currentPatch%NF > 0.0_r8 - if (has_ignition .or. currentSite%fireWeather%rx_flag == itrue) then + if (has_ignition .or. currentPatch%fireWeather%rx_flag == itrue) then ! fire intensity [kW/m] currentPatch%FI = FireIntensity(currentPatch%TFC_ROS/0.45_r8, currentPatch%ROS_front/60.0_r8) @@ -406,14 +441,14 @@ subroutine CalculateSurfaceFireIntensity(currentSite) rxfire_fuel_check = currentPatch%fuel%non_trunk_loading > SF_val_rxfire_fuel_min .and. & currentPatch%fuel%non_trunk_loading < SF_val_rxfire_fuel_max - if (currentSite%fireWeather%rx_flag == itrue .and. rxfire_fuel_check) then - + if (currentPatch%fireWeather%rx_flag == itrue .and. rxfire_fuel_check) then + ! record burnable area after fuel load check - currentSite%rxfire_area_fuel = currentSite%rxfire_area_fuel + currentPatch%area - + currentSite%rxfire_area_fuel = currentSite%rxfire_area_fuel + currentPatch%area + ! determine fire type ! prescribed fire and wildfire cannot happen on the same patch - is_rxfire = is_prescribed_burn(currentPatch%FI, currentSite%NF, & + is_rxfire = is_prescribed_burn(currentPatch%FI, currentPatch%NF, & SF_val_rxfire_min_threshold, SF_val_rxfire_max_threshold, SF_val_fire_threshold) if (is_rxfire) then @@ -430,8 +465,8 @@ subroutine CalculateSurfaceFireIntensity(currentSite) ! assign fire intensities and ignitions based on fire type if (currentPatch%nonrx_fire == itrue) then - currentSite%NF_successful = currentSite%NF_successful + & - currentSite%NF*currentSite%FDI*currentPatch%area/area + currentPatch%NF_successful = currentPatch%NF_successful + & + currentPatch%NF*currentPatch%FDI currentPatch%nonrx_FI = currentPatch%FI else if (currentPatch%rx_fire == itrue) then currentPatch%rx_FI = currentPatch%FI @@ -479,18 +514,18 @@ subroutine CalculateAreaBurnt(currentSite) if (currentPatch%nonrx_fire == 1) then ! fire duration [min] - currentPatch%FD = FireDuration(currentSite%FDI) + currentPatch%FD = FireDuration(currentPatch%FDI) ! length-to-breadth ratio of fire ellipse [unitless] tree_fraction_patch = currentPatch%total_tree_area/currentPatch%area - length_to_breadth = LengthToBreadth(currentSite%fireWeather%effective_windspeed, tree_fraction_patch) + length_to_breadth = LengthToBreadth(currentPatch%fireWeather%effective_windspeed, tree_fraction_patch) ! fire size [m2] fire_size = FireSize(length_to_breadth, currentPatch%ROS_back, & currentPatch%ROS_front, currentPatch%FD) ! area burnt [m2/km2] - area_burnt = AreaBurnt(fire_size, currentSite%NF, currentSite%FDI) + area_burnt = AreaBurnt(fire_size, currentPatch%NF, currentPatch%FDI) ! convert to area burned per area patch per day ! i.e., fraction of the patch burned on that day diff --git a/fire/SFNesterovMod.F90 b/fire/SFNesterovMod.F90 index 2a0147058b..9c426c6f2c 100644 --- a/fire/SFNesterovMod.F90 +++ b/fire/SFNesterovMod.F90 @@ -14,6 +14,7 @@ module SFNesterovMod contains procedure, public :: Init => init_nesterov_fire_weather + procedure, public :: CopyFrom => copy_nesterov_fire_weather procedure, public :: UpdateIndex => update_nesterov_index end type nesterov_index @@ -39,30 +40,47 @@ end subroutine init_nesterov_fire_weather !------------------------------------------------------------------------------------- - subroutine update_nesterov_index(this, temp_C, precip, rh, wind) + subroutine copy_nesterov_fire_weather(this, from) + ! + ! DESCRIPTION: + ! Copies class attributes from one instance to another + + ! ARGUMENTS + class(nesterov_index), intent(inout) :: this + class(fire_weather), intent(in) :: from + + this%temp_C = from%temp_C + this%precip = from%precip + this%rh = from%rh + this%wind = from%wind + this%fire_weather_index = from%fire_weather_index + this%effective_windspeed = from%effective_windspeed + this%rx_flag = from%rx_flag + + end subroutine copy_nesterov_fire_weather + + !------------------------------------------------------------------------------------- + + subroutine update_nesterov_index(this) ! ! DESCRIPTION: ! Updates Nesterov Index ! ARGUMENTS class(nesterov_index), intent(inout) :: this ! nesterov index extended class - real(r8), intent(in) :: temp_C ! daily averaged temperature [degrees C] - real(r8), intent(in) :: precip ! daily precipitation [mm] - real(r8), intent(in) :: rh ! daily relative humidity [%] - real(r8), intent(in) :: wind ! daily wind speed [m/min] ! LOCALS: real(r8) :: t_dew ! dewpoint temperature [degrees C] - if (precip > min_precip_thresh) then ! rezero NI if it rains + if (this%precip > min_precip_thresh) then ! rezero NI if it rains this%fire_weather_index = 0.0_r8 else ! Calculate dewpoint temperature - t_dew = dewpoint(temp_c, rh) + t_dew = dewpoint(this%temp_C, this%rh) ! Accumulate Nesterov index over fire season. - this%fire_weather_index = this%fire_weather_index + calc_nesterov_index(temp_C, t_dew) + this%fire_weather_index = this%fire_weather_index + calc_nesterov_index(this%temp_C, t_dew) end if end subroutine update_nesterov_index diff --git a/main/CMakeLists.txt b/main/CMakeLists.txt index 8db1d06331..dbfe2fda67 100644 --- a/main/CMakeLists.txt +++ b/main/CMakeLists.txt @@ -6,6 +6,9 @@ list(APPEND clm_sources EDTypesMod.F90 EDPftvarcon.F90 FatesConstantsMod.F90 + FatesEcotypesMod.F90 + FatesEdgeForestMod.F90 + FatesEdgeForestParamsMod.F90 FatesHydraulicsMemMod.F90 FatesParametersInterface.F90 FatesUtilsMod.F90 @@ -27,6 +30,10 @@ list(APPEND fates_sources FatesSizeAgeTypeIndicesMod.F90 FatesIntegratorsMod.F90 FatesUtilsMod.F90 - FatesSynchronizedParamsMod.F90) + FatesSynchronizedParamsMod.F90 + FatesEcotypesMod.F90 + FatesEdgeForestMod.F90 + FatesEdgeForestParamsMod.F90 + ) sourcelist_to_parent(fates_sources) diff --git a/main/EDInitMod.F90 b/main/EDInitMod.F90 index 09db71632c..f0f3c35f7c 100644 --- a/main/EDInitMod.F90 +++ b/main/EDInitMod.F90 @@ -22,6 +22,7 @@ module EDInitMod use FatesInterfaceTypesMod , only : hlm_is_restart use FatesInterfaceTypesMod , only : hlm_current_tod use FatesInterfaceTypesMod , only : hlm_regeneration_model + use FatesInterfaceTypesMod , only : nlevedgeforest use EDPftvarcon , only : EDPftvarcon_inst use PRTParametersMod , only : prt_params use EDCohortDynamicsMod , only : create_cohort, fuse_cohorts @@ -99,7 +100,6 @@ module EDInitMod use FatesConstantsMod, only : nocomp_bareground_land, nocomp_bareground use FatesConstantsMod, only : min_nocomp_pftfrac_perlanduse use EdTypesMod, only : dump_site - use SFNesterovMod, only : nesterov_index ! CIME GLOBALS @@ -237,6 +237,8 @@ subroutine init_site_vars( site_in, bc_in, bc_out ) ! for different pfts and canopy positions allocate(site_in%rec_l2fr(1:numpft,nclmax)) + ! Forest edge + allocate(site_in%fraction_forest_in_each_bin(1:nlevedgeforest)) ! SP mode allocate(site_in%sp_tlai(1:numpft)) @@ -269,9 +271,6 @@ subroutine init_site_vars( site_in, bc_in, bc_out ) allocate(site_in%seed_in(1:numpft)) allocate(site_in%seed_out(1:numpft)) - allocate(nesterov_index :: site_in%fireWeather) - call site_in%fireWeather%Init() - end subroutine init_site_vars ! ============================================================================ @@ -324,9 +323,13 @@ subroutine zero_site( site_in ) site_in%landuse_transition_matrix(:,:) = 0.0_r8 ! FIRE - site_in%FDI = 0.0_r8 ! daily fire danger index (0-1) - site_in%NF = 0.0_r8 ! daily lightning strikes per km2 - site_in%NF_successful = 0.0_r8 ! daily successful iginitions per km2 + ! TODO: Not sure why this is necessary now but it wasn't in edge area branch this branched from + site_in%rxfire_area_fuel = 0._r8 + site_in%rxfire_area_fi = 0._r8 + site_in%rxfire_area_final = 0._r8 + ! TODO: Remove. Useful during development but probably not needed in production. + site_in%ovp_relhumid24 = fates_unset_r8 + site_in%ovp_wind24 = fates_unset_r8 do el=1,num_elements ! Zero the state variables used for checking mass conservation @@ -523,8 +526,6 @@ subroutine set_site_properties( nsites, sites,bc_in ) sites(s)%dstatus(1:numpft) = dstat sites(s)%elong_factor(1:numpft) = elong_factor - sites(s)%NF = 0.0_r8 - sites(s)%NF_successful = 0.0_r8 sites(s)%area_pft(:,:) = 0.0_r8 do ft = 1,numpft diff --git a/main/EDMainMod.F90 b/main/EDMainMod.F90 index c5b2cad8c9..608d1ec2e9 100644 --- a/main/EDMainMod.F90 +++ b/main/EDMainMod.F90 @@ -59,6 +59,7 @@ module EDMainMod use FatesSoilBGCFluxMod , only : PrepNutrientAquisitionBCs use FatesSoilBGCFluxMod , only : PrepCH4BCs use SFMainMod , only : DailyFireModel + use SFMainMod , only : UpdateFireWeather ! TROUBLESHOOTING use FatesSizeAgeTypeIndicesMod, only : get_age_class_index use FatesSizeAgeTypeIndicesMod, only : coagetype_class_index use FatesLitterMod , only : litter_type @@ -323,6 +324,11 @@ subroutine ed_ecosystem_dynamics(currentSite, bc_in, bc_out) ! kill patches that are too small call terminate_patches(currentSite, bc_in) + + ! TROUBLESHOOTING: Does calling this here resolve unexpected identical fire weather between + ! deep forest and other forest? + call UpdateFireWeather(currentSite, bc_in, .true.) + end if ! Final instantaneous mass balance check diff --git a/main/EDParamsMod.F90 b/main/EDParamsMod.F90 index 5b1ff524fc..6bf33f1306 100644 --- a/main/EDParamsMod.F90 +++ b/main/EDParamsMod.F90 @@ -213,7 +213,9 @@ module EDParamsMod integer, protected, public :: max_cohort_per_patch character(len=param_string_length), parameter, public :: maxcohort_name = "fates_maxcohort" - + ! Ecotypes parameters + real(r8),protected,public :: forest_tree_fraction_threshold ! Tree fraction above which a patch is "forest" + character(len=param_string_length),parameter,public :: forest_tree_fraction_threshold_name = "fates_forest_tree_fraction_threshold" ! Logging Control Parameters (ONLY RELEVANT WHEN USE_FATES_LOGGING = TRUE) ! ---------------------------------------------------------------------------------------------- @@ -266,6 +268,7 @@ module EDParamsMod character(len=param_string_length),parameter,public :: eca_name_plant_escalar = "fates_cnp_eca_plant_escalar" public :: FatesParamsInit + public :: FatesParamsInitForFactory public :: FatesRegisterParams public :: FatesReceiveParams public :: FatesReportParams @@ -342,6 +345,7 @@ subroutine FatesParamsInit() dev_arbitrary = nan damage_event_code = -9 damage_canopy_layer_code = -9 + forest_tree_fraction_threshold = nan landuse_grazing_carbon_use_eff = nan landuse_grazing_nitrogen_use_eff = nan landuse_grazing_phosphorus_use_eff = nan @@ -350,6 +354,21 @@ subroutine FatesParamsInit() end subroutine FatesParamsInit + !----------------------------------------------------------------------- + + subroutine FatesParamsInitForFactory() + ! Initialize some parameters that are needed for unit-testing factories + + allocate(ED_val_history_ageclass_bin_edges(7)) + ED_val_history_ageclass_bin_edges = [0, 1, 2, 5, 10, 20, 50] + + allocate(ED_val_history_sizeclass_bin_edges(13)) + ED_val_history_sizeclass_bin_edges = [0, 5, 10, 15, 20, 30, 40, 50, 60, 70, 80, 90, 100] + + allocate(ED_val_history_coageclass_bin_edges(13)) + ED_val_history_coageclass_bin_edges = [0, 5] + end subroutine FatesParamsInitForFactory + !----------------------------------------------------------------------- subroutine FatesRegisterParams(fates_params) ! Register the parameters we want the host to provide, and @@ -518,6 +537,9 @@ subroutine FatesRegisterParams(fates_params) call fates_params%RegisterParameter(name=damage_name_canopy_layer_code, dimension_shape=dimension_shape_scalar, & dimension_names=dim_names_scalar) + + call fates_params%RegisterParameter(name=forest_tree_fraction_threshold_name, dimension_shape=dimension_shape_scalar, & + dimension_names=dim_names_scalar) call fates_params%RegisterParameter(name=name_landuse_grazing_carbon_use_eff, dimension_shape=dimension_shape_scalar, & dimension_names=dim_names_scalar) @@ -739,6 +761,9 @@ subroutine FatesReceiveParams(fates_params) data=tmpreal) damage_canopy_layer_code = nint(tmpreal) + call fates_params%RetrieveParameter(name=forest_tree_fraction_threshold_name, & + data=forest_tree_fraction_threshold) + ! parameters that are arrays of size defined within the params file and thus need allocating as well call fates_params%RetrieveParameterAllocate(name=ED_name_history_sizeclass_bin_edges, & data=ED_val_history_sizeclass_bin_edges) @@ -864,6 +889,7 @@ subroutine FatesReportParams(is_master) write(fates_log(),'(a,L2)') 'active_crown_fire = ',active_crown_fire write(fates_log(),fmt0) 'damage_event_code = ',damage_event_code write(fates_log(),fmt0) 'damage_canopy_layer_code = ', damage_canopy_layer_code + write(fates_log(),fmt0) 'forest_tree_fraction_threshold = ', forest_tree_fraction_threshold write(fates_log(),fmt0) 'landuse_grazing_carbon_use_eff = ', landuse_grazing_carbon_use_eff write(fates_log(),fmt0) 'name_landuse_grazing_nitrogen_use_eff = ', name_landuse_grazing_nitrogen_use_eff write(fates_log(),fmt0) 'name_landuse_grazing_phosphorus_use_eff = ', name_landuse_grazing_phosphorus_use_eff diff --git a/main/EDTypesMod.F90 b/main/EDTypesMod.F90 index 90be4df5ec..68695f183c 100644 --- a/main/EDTypesMod.F90 +++ b/main/EDTypesMod.F90 @@ -36,7 +36,6 @@ module EDTypesMod use EDParamsMod, only : nclmax, nlevleaf, maxpft use FatesConstantsMod, only : n_dbh_bins, n_dist_types use shr_log_mod, only : errMsg => shr_log_errMsg - use SFFireWeatherMod, only : fire_weather implicit none private ! By default everything is private @@ -449,15 +448,12 @@ module EDTypesMod ! FIRE - real(r8) :: wind ! daily wind in m/min for Spitfire units - real(r8) :: fdi ! daily probability an ignition event will start a fire - real(r8) :: NF ! daily ignitions in km2 - real(r8) :: NF_successful ! daily ignitions in km2 that actually lead to fire - class(fire_weather), pointer :: fireWeather ! fire weather object - integer :: rx_flag ! daily burn window flag real(r8) :: rxfire_area_fuel ! daily total burnable area [m2] when burn window present and fuel condition met real(r8) :: rxfire_area_fi ! daily total burnable area [m2] when burn window present, fuel and fire intensity condition met real(r8) :: rxfire_area_final ! daily total burnable area [m2] when all conditions met + ! TODO: Remove. Useful during development but probably not needed in production. + real(r8) :: ovp_relhumid24 ! bc_in%relhumid24_pa of oldest vegetated patch + real(r8) :: ovp_wind24 ! bc_in%wind24_pa of oldest vegetated patch @@ -601,16 +597,20 @@ module EDTypesMod logical, allocatable :: landuse_vector_gt_min(:) ! is the land use state vector for each land use type greater than the minimum below which we ignore? logical :: transition_landuse_from_off_to_on ! special flag to use only when reading restarts, which triggers procedure to initialize land use + ! Variables related to forest edge + real(r8) :: area_forest_patches ! total area (m2) of all forest patches in site + real(r8), allocatable :: fraction_forest_in_each_bin(:) ! fraction of site forest in each bin of distance from edge + contains procedure, public :: get_current_landuse_statevector procedure, public :: get_secondary_young_fraction + procedure, public :: GetNumberOfPatches end type ed_site_type ! Make public necessary subroutines and functions public :: dump_site - public :: CalculateTreeGrassAreaSite public :: set_patchno contains @@ -737,39 +737,6 @@ end subroutine ZeroMassBalFlux ! ===================================================================================== - subroutine CalculateTreeGrassAreaSite(csite, tree_fraction, grass_fraction, bare_fraction) - ! - ! DESCRIPTION: - ! Calculates total grass, tree, and bare fractions for a site - - ! ARGUMENTS: - type(ed_site_type), intent(inout) :: csite ! site object - real(r8), intent(out) :: tree_fraction ! total site tree fraction - real(r8), intent(out) :: grass_fraction ! total site grass fraction - real(r8), intent(out) :: bare_fraction ! total site bare fraction - - ! LOCALS: - type(fates_patch_type), pointer :: currentPatch ! patch object - - tree_fraction = 0.0_r8 - grass_fraction = 0.0_r8 - - currentPatch => csite%oldest_patch - do while(associated(currentPatch)) - if (currentPatch%nocomp_pft_label /= nocomp_bareground) then - call currentPatch%UpdateTreeGrassArea() - tree_fraction = tree_fraction + currentPatch%total_tree_area/AREA - grass_fraction = grass_fraction + currentPatch%total_grass_area/AREA - end if - currentPatch => currentPatch%younger - end do - - ! if cover > 1.0, grasses are under the trees - grass_fraction = min(grass_fraction, 1.0_r8 - tree_fraction) - bare_fraction = 1.0_r8 - tree_fraction - grass_fraction - - end subroutine CalculateTreeGrassAreaSite - !--------------------------------------------------------------------------------------- subroutine dump_site(csite) @@ -865,4 +832,26 @@ function get_secondary_young_fraction(this) result(secondary_young_fraction) end function get_secondary_young_fraction + function GetNumberOfPatches(this) result(n_patches) + ! DESCRIPTION + ! Returns number of patches at site + ! + ! ARGUMENTS: + class(ed_site_type) :: this + ! + ! RETURN VALUE: + integer :: n_patches + ! + ! LOCAL VARIABLES: + type(fates_patch_type), pointer :: currentPatch + + n_patches = 0 + currentPatch => this%youngest_patch + do while(associated(currentPatch)) + n_patches = n_patches + 1 + currentPatch => currentPatch%older + enddo + + end function GetNumberOfPatches + end module EDTypesMod diff --git a/main/FatesEcotypesMod.F90 b/main/FatesEcotypesMod.F90 new file mode 100644 index 0000000000..911bed7db6 --- /dev/null +++ b/main/FatesEcotypesMod.F90 @@ -0,0 +1,81 @@ +module FatesEcotypesMod + + use FatesConstantsMod, only : r8 => fates_r8 + use EDTypesMod, only : ed_site_type + use FatesPatchMod, only : fates_patch_type + + implicit none + private ! By default everything is private + + ! Make public necessary subroutines and functions + public :: IsPatchForest + ! For unit testing + public :: DoesPatchHaveForest_TreeCover + public :: DoesPatchHaveForest_GrassBiomass + +contains + + ! ===================================================================================== + + function DoesPatchHaveForest_TreeCover(patchptr, forest_tree_fraction_threshold) + ! DESCRIPTION: + ! Return boolean: Is this patch "forest"? + ! + ! ARGUMENTS: + type(fates_patch_type), intent(in), pointer :: patchptr ! pointer to patch object + real(r8), intent(in) :: forest_tree_fraction_threshold ! Tree fraction above which a patch is "forest" + ! + ! RETURN VALUE + logical :: DoesPatchHaveForest_TreeCover + ! + ! LOCAL VARIABLES + real(r8) :: tree_fraction = 0._r8 + + if (patchptr%area > 0._r8) then + tree_fraction = patchptr%total_tree_area / patchptr%area + else + tree_fraction = 0._r8 + end if + + DoesPatchHaveForest_TreeCover = tree_fraction > forest_tree_fraction_threshold + + end function DoesPatchHaveForest_TreeCover + + + function DoesPatchHaveForest_GrassBiomass(patchptr, grass_biomass_threshold) + ! DESCRIPTION: + ! Return boolean: Does this patch have grass biomass above a threshold? + ! + ! ARGUMENTS: + type(fates_patch_type), intent(in), pointer :: patchptr ! pointer to patch object + real(r8), intent(in) :: grass_biomass_threshold ! Live grass biomass (kgC/m2) above which a patch is considered to "have grass" + ! + ! RETURN VALUE + logical :: DoesPatchHaveForest_GrassBiomass + + DoesPatchHaveForest_GrassBiomass = patchptr%livegrass > grass_biomass_threshold + + end function DoesPatchHaveForest_GrassBiomass + + + function IsPatchForest(patchptr, forest_tree_fraction_threshold, grass_biomass_threshold) + ! DESCRIPTION: + ! Return boolean: Is this patch forest according to tree cover and, optionally, grass biomass? + ! + ! ARGUMENTS: + type(fates_patch_type), intent(in), pointer :: patchptr ! pointer to patch object + real(r8), intent(in) :: forest_tree_fraction_threshold ! Tree fraction above which a patch is "forest" + real(r8), intent(in), optional :: grass_biomass_threshold ! Live grass biomass (kgC/m2) above which a patch is considered to "have grass" + ! + ! RETURN VALUE + logical :: IsPatchForest + + IsPatchForest = DoesPatchHaveForest_TreeCover(patchptr, forest_tree_fraction_threshold) + if (IsPatchForest .and. present(grass_biomass_threshold)) then + IsPatchForest = .not. DoesPatchHaveForest_GrassBiomass(patchptr, grass_biomass_threshold) + end if + + end function IsPatchForest + + +end module FatesEcotypesMod diff --git a/main/FatesEdgeForestMod.F90 b/main/FatesEdgeForestMod.F90 new file mode 100644 index 0000000000..e7161be37b --- /dev/null +++ b/main/FatesEdgeForestMod.F90 @@ -0,0 +1,844 @@ +module FatesEdgeForestMod + + use FatesConstantsMod, only : r8 => fates_r8 + use FatesConstantsMod, only : nocomp_bareground + use FatesConstantsMod, only : nearzero + use FatesGlobals, only : fates_log + use FatesGlobals, only : endrun => fates_endrun + use shr_log_mod, only : errMsg => shr_log_errMsg + use EDTypesMod, only : ed_site_type + use EDTypesMod, only : AREA + use FatesPatchMod, only : fates_patch_type + use FatesEcotypesMod, only : IsPatchForest + use FatesUtilsMod, only : is_param_set + + implicit none + private ! By default everything is private + + ! Make public necessary subroutines and functions + public :: CalculateTreeGrassAreaSite + public :: CalculateEdgeForestArea + public :: ApplyEdgeForestFlamToSite + ! Public for unit testing + public :: indexx + public :: GetFracEdgeForestInEachBin + public :: GetFracEdgeForestInEachBin_norm_numerator + public :: GetFracEdgeForestInEachBin_norm_denominator + public :: GetFracEdgeForestInEachBin_norm + public :: GetFracEdgeForestInEachBin_quadratic + public :: AssignPatchToBins + public :: CalcEdgeForestFlam_1var_1bin + public :: CalcEdgeForestFlam_1var + public :: ApplyEdgeForestFlamToPatch_1var + public :: CheckFlamChangeIntended + +contains + + ! ===================================================================================== + + subroutine CalculateTreeGrassAreaSite(csite, tree_fraction, grass_fraction, bare_fraction) + ! + ! DESCRIPTION: + ! Calculates total grass, tree, and bare fractions for a site + + use FatesEcotypesMod, only : IsPatchForest + use EDParamsMod, only : forest_tree_fraction_threshold + + ! ARGUMENTS: + type(ed_site_type), intent(inout), target :: csite ! site object + real(r8), intent(out) :: tree_fraction ! total site tree fraction + real(r8), intent(out) :: grass_fraction ! total site grass fraction + real(r8), intent(out) :: bare_fraction ! total site bare fraction + + ! LOCALS: + type(fates_patch_type), pointer :: currentPatch ! patch object + + tree_fraction = 0.0_r8 + grass_fraction = 0.0_r8 + + currentPatch => csite%oldest_patch + do while(associated(currentPatch)) + if (currentPatch%nocomp_pft_label /= nocomp_bareground) then + call currentPatch%UpdateTreeGrassArea() + tree_fraction = tree_fraction + currentPatch%total_tree_area/AREA + grass_fraction = grass_fraction + currentPatch%total_grass_area/AREA + currentPatch%is_forest = IsPatchForest(currentPatch, forest_tree_fraction_threshold) + end if + currentPatch => currentPatch%younger + end do + + ! if cover > 1.0, grasses are under the trees + grass_fraction = min(grass_fraction, 1.0_r8 - tree_fraction) + bare_fraction = 1.0_r8 - tree_fraction - grass_fraction + + ! Must come after patch loop with IsPatchForest() call + call CalculateEdgeForestArea(csite) + + end subroutine CalculateTreeGrassAreaSite + + + subroutine GetNumberOfForestPatches(site, n_forest_patches, area_site) + ! DESCRIPTION + ! Returns number and area of forest patches at site + ! + ! ARGUMENTS: + type(ed_site_type), pointer, intent(in) :: site + integer, intent(out) :: n_forest_patches + real(r8), intent(out) :: area_site + ! + ! LOCAL VARIABLES: + type(fates_patch_type), pointer :: currentPatch + + n_forest_patches = 0 + site%area_forest_patches = 0._r8 + area_site = 0._r8 + currentPatch => site%youngest_patch + do while(associated(currentPatch)) + area_site = area_site + currentPatch%area + if (currentPatch%is_forest) then + n_forest_patches = n_forest_patches + 1 + site%area_forest_patches = site%area_forest_patches + currentPatch%area + end if + + currentPatch => currentPatch%older + enddo + + end subroutine GetNumberOfForestPatches + + + subroutine RankForestEdgeProximity(site, indices, index_forestpatches_to_allpatches) + ! DESCRIPTION: + ! Rank forest patches by their proximity to edge, using age as a proxy. + ! + ! ARGUMENTS: + type(ed_site_type), pointer, intent(in) :: site + integer, dimension(:), intent(inout) :: indices ! Indices to use if you want to sort patches + integer, dimension(:), intent(inout) :: index_forestpatches_to_allpatches ! Array with length (number of patches in gridcell), values 0 if not forest and otherwise an index corresponding to which number forest patch this is + ! + ! LOCAL VARIABLES: + real(r8), dimension(:), allocatable :: array ! Array to be index-sorted. + integer :: n_forest_patches ! Number of patches in above arrays + type(fates_patch_type), pointer :: currentPatch + integer :: f ! index of current forest patch + integer :: p ! index of patch + + ! Skip sites with no forest patches + n_forest_patches = size(indices) + if (n_forest_patches == 0) then + return + end if + + ! Allocate arrays + allocate(array(1:n_forest_patches)) + + ! Fill arrays + f = 0 + p = 0 + index_forestpatches_to_allpatches(:) = 0 + currentPatch => site%oldest_patch + patchloop: do while(associated(currentPatch)) + p = p + 1 + if (.not. currentPatch%is_forest) then + currentPatch => currentPatch%younger + cycle + end if + + f = f + 1 + index_forestpatches_to_allpatches(p) = f + + ! Fill with patch age. + ! TODO: Add other options. Biomass? Woody biomass? + array(f) = currentPatch%age + + currentPatch => currentPatch%younger + end do patchloop + + ! Get indices of sorted forest patches + call indexx(array, indices) + + ! Clean up + deallocate(array) + end subroutine RankForestEdgeProximity + + function GetFracEdgeForestInEachBin_norm_numerator(x_in, A, mu, sigma, lognorm) + ! DESCRIPTION + ! Gets numerator at xof normal-like function (Gaussian if lognorm==.true., lognormal otherwise) + ! + ! ARGUMENTS: + real(r8), intent(in) :: x_in + real(r8), intent(in) :: A ! Amplitude + real(r8), intent(in) :: mu ! Center + real(r8), intent(in) :: sigma ! Width + logical, intent(in) :: lognorm ! Gaussian function if true, lognormal otherwise + ! + ! RETURN VALUE: + real(r8) :: GetFracEdgeForestInEachBin_norm_numerator + ! + ! LOCAL VARIABLES: + real(r8) :: x ! either x_in or its log + + if (lognorm) then + x = log(x_in) + else + x = x_in + end if + + GetFracEdgeForestInEachBin_norm_numerator = A * exp(-(x - mu)**2 / (2*sigma**2)) + end function GetFracEdgeForestInEachBin_norm_numerator + + function GetFracEdgeForestInEachBin_norm_denominator(x, sigma, lognorm) + ! DESCRIPTION + ! Gets denominator at x of normal-like function (Gaussian if lognorm==.true., lognormal otherwise) + ! + ! ARGUMENTS: + use FatesConstantsMod, only : pi => pi_const + real(r8), intent(in) :: x + real(r8), intent(in) :: sigma ! Width + logical, intent(in) :: lognorm ! Gaussian function if true, lognormal otherwise + ! + ! RETURN VALUE: + real(r8) :: GetFracEdgeForestInEachBin_norm_denominator + + GetFracEdgeForestInEachBin_norm_denominator = sigma * sqrt(2*pi) + if (lognorm) then + GetFracEdgeForestInEachBin_norm_denominator = GetFracEdgeForestInEachBin_norm_denominator * x + end if + end function GetFracEdgeForestInEachBin_norm_denominator + + function GetFracEdgeForestInEachBin_norm(x, A, mu, sigma, lognorm) + ! DESCRIPTION + ! Gets value at x of normal-like function (Gaussian if lognorm==.true., lognormal otherwise) + ! + ! ARGUMENTS: + real(r8), intent(in) :: x + real(r8), intent(in) :: A ! Amplitude + real(r8), intent(in) :: mu ! Center + real(r8), intent(in) :: sigma ! Width + logical, intent(in) :: lognorm ! Gaussian function if true, lognormal otherwise + ! + ! RETURN VALUE: + real(r8) :: GetFracEdgeForestInEachBin_norm + + GetFracEdgeForestInEachBin_norm = GetFracEdgeForestInEachBin_norm_numerator(x, A, mu, sigma, lognorm) / GetFracEdgeForestInEachBin_norm_denominator(x, sigma, lognorm) + end function GetFracEdgeForestInEachBin_norm + + function GetFracEdgeForestInEachBin_quadratic(x, a, b, c) + ! DESCRIPTION + ! Gets value at x of quadratic function + ! + ! ARGUMENTS: + real(r8), intent(in) :: x + real(r8), intent(in) :: a, b, c ! Parameters + ! + ! RETURN VALUE: + real(r8) :: GetFracEdgeForestInEachBin_quadratic + + GetFracEdgeForestInEachBin_quadratic = a*(x**2) + b*x + c + end function GetFracEdgeForestInEachBin_quadratic + + subroutine GetFracEdgeForestInEachBin(x, nlevedgeforest, efb_gaussian_amplitudes, efb_gaussian_sigmas, efb_gaussian_centers, efb_lognormal_amplitudes, efb_lognormal_sigmas, efb_lognormal_centers, efb_quadratic_a, efb_quadratic_b, efb_quadratic_c, fraction_forest_in_bin, norm) + ! DESCRIPTION: + ! Get the fraction of forest in each bin. + ! + ! USES + use FatesConstantsMod, only : pi => pi_const + ! + ! ARGUMENTS + real(r8), intent(in) :: x ! Independent variable in the fit + integer, intent(in) :: nlevedgeforest + real(r8), dimension(:), intent(in) :: efb_gaussian_amplitudes + real(r8), dimension(:), intent(in) :: efb_gaussian_sigmas + real(r8), dimension(:), intent(in) :: efb_gaussian_centers + real(r8), dimension(:), intent(in) :: efb_lognormal_amplitudes + real(r8), dimension(:), intent(in) :: efb_lognormal_sigmas + real(r8), dimension(:), intent(in) :: efb_lognormal_centers + real(r8), dimension(:), intent(in) :: efb_quadratic_a + real(r8), dimension(:), intent(in) :: efb_quadratic_b + real(r8), dimension(:), intent(in) :: efb_quadratic_c + real(r8), dimension(:), intent(out) :: fraction_forest_in_bin + logical, optional, intent(in) :: norm + ! + ! LOCAL VARIABLES + integer :: b ! Bin index + real(r8) :: A ! Amplitude + real(r8) :: mu ! Center + real(r8) :: sigma ! Sigma + logical :: lognorm + logical :: do_norm + ! Error checking + real(r8), parameter :: tol = 1.e-9_r8 ! fraction of total forest area + real(r8) :: err_chk + + ! Initialize + fraction_forest_in_bin(:) = 0._r8 + + ! If the cell is nearly 0% forest, put any forest in the first edge bin (closest to edge) + if (x < nearzero) then + fraction_forest_in_bin(1) = 1._r8 + return + end if + + ! If the cell is (nearly) 100% forest, it's all "deep forest" + if (1._r8 - x < nearzero) then + fraction_forest_in_bin(nlevedgeforest) = 1._r8 + return + end if + + if (present(norm)) then + do_norm = norm + else + do_norm = .true. + end if + + binloop: do b = 1, nlevedgeforest + + if (is_param_set(efb_gaussian_amplitudes(b)) .or. is_param_set(efb_lognormal_amplitudes(b))) then + ! Gaussian or Lognormal + lognorm = is_param_set(efb_lognormal_amplitudes(b)) + if (lognorm) then + A = efb_lognormal_amplitudes(b) + mu = efb_lognormal_centers(b) + sigma = efb_lognormal_sigmas(b) + else + A = efb_gaussian_amplitudes(b) + mu = efb_gaussian_centers(b) + sigma = efb_gaussian_sigmas(b) + end if + fraction_forest_in_bin(b) = GetFracEdgeForestInEachBin_norm(x, A, mu, sigma, lognorm) + + else if (is_param_set(efb_quadratic_a(b))) then + ! Quadratic + fraction_forest_in_bin(b) = GetFracEdgeForestInEachBin_quadratic(x, efb_quadratic_a(b), efb_quadratic_b(b), efb_quadratic_c(b)) + + else + call endrun("Unrecognized bin fit type") + end if + end do binloop + + ! Account for fit errors by normalizing to 1 + if (do_norm) then + fraction_forest_in_bin(:) = fraction_forest_in_bin(:) / sum(fraction_forest_in_bin) + + err_chk = sum(fraction_forest_in_bin) - 1._r8 + if (abs(err_chk) > tol) then + write(fates_log(),*) "ERROR: bin fractions don't sum to 1; actual minus expected = ",err_chk + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if + end if + + + end subroutine GetFracEdgeForestInEachBin + + + subroutine AssignPatchToBins(fraction_forest_in_each_bin, area_forest_patches, patch_area, nlevedgeforest, tol, sum_forest_bins_so_far_m2, area_in_edgeforest_bins_m2) + ! DESCRIPTION + ! Given one patch in a site, assign its area to edge bin(s). + ! + ! ARGUMENTS + real(r8), dimension(:), pointer, intent(in) :: fraction_forest_in_each_bin ! Fraction of site's forest area in each edge bin + real(r8), intent(in) :: area_forest_patches ! Total forest area in the site + real(r8), intent(in) :: patch_area ! Area of this patch + integer, intent(in) :: nlevedgeforest ! Number of edge forest bins, including "deep forest" + real(r8), intent(in) :: tol ! Tolerance for checking total area assigned to bins + real(r8), intent(inout) :: sum_forest_bins_so_far_m2 ! How much of the site's forest area has been assigned? + real(r8), dimension(:), intent(out) :: area_in_edgeforest_bins_m2 ! Area of this patch in each edge bin (m2) + ! + ! LOCAL VARIABLES + real(r8) :: remaining_to_assign_from_patch_m2 ! How much of this patch's area still needs to be assigned + real(r8) :: remaining_to_assign_to_bin_m2 ! How much of a given bin's area still needs to be assigned + integer :: b + ! For checks + real(r8) :: err_chk + + area_in_edgeforest_bins_m2(:) = 0._r8 + remaining_to_assign_from_patch_m2 = patch_area + binloop: do b = 1, nlevedgeforest + + ! How much area is left for this bin? + remaining_to_assign_to_bin_m2 = sum(fraction_forest_in_each_bin(1:b))*area_forest_patches - sum_forest_bins_so_far_m2 + if (remaining_to_assign_to_bin_m2 <= 0) then + cycle + end if + + ! Assign area + area_in_edgeforest_bins_m2(b) = min(remaining_to_assign_from_patch_m2, remaining_to_assign_to_bin_m2) + remaining_to_assign_from_patch_m2 = remaining_to_assign_from_patch_m2 - area_in_edgeforest_bins_m2(b) + + ! Update accounting + sum_forest_bins_so_far_m2 = sum_forest_bins_so_far_m2 + area_in_edgeforest_bins_m2(b) + + if (remaining_to_assign_from_patch_m2 == 0._r8) then + exit + end if + end do binloop + + ! Check that this patch's complete area was assigned (and no more) + err_chk = remaining_to_assign_from_patch_m2 + if (abs(err_chk) > tol) then + write(fates_log(),*) "ERROR: not enough or too much patch area was assigned to bins (check 1); remainder = ",err_chk + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if + err_chk = patch_area - sum(area_in_edgeforest_bins_m2) + if (abs(err_chk) > tol) then + write(fates_log(),*) "ERROR: not enough or too much patch area was assigned to bins (check 2); remainder = ",err_chk + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if + end subroutine AssignPatchToBins + + + subroutine AssignPatchesToBins(site, indices, index_forestpatches_to_allpatches, n_forest_patches, n_patches) + ! DESCRIPTION + ! Loops through forest patches from nearest to farthest from edge, assigning their + ! area to edge bin(s). + ! + ! USES: + use FatesInterfaceTypesMod, only : nlevedgeforest + ! ARGUMENTS + type(ed_site_type), pointer, intent(in) :: site + integer, dimension(:), intent(in) :: indices ! Indices to use if you want to sort patches + integer, dimension(:), intent(in) :: index_forestpatches_to_allpatches ! Array with length (number of patches in gridcell), values 0 if not forest and otherwise an index corresponding to which number forest patch this is + integer, intent(in) :: n_forest_patches ! Number of forest patches + integer, intent(in) :: n_patches ! Number of patches in site + ! + ! LOCAL VARIABLES + integer :: f, i, p, b + type(fates_patch_type), pointer :: currentPatch + real(r8) :: sum_forest_bins_so_far_m2 + ! For checks + real(r8), dimension(nlevedgeforest) :: bin_area_sums + real(r8), parameter :: tol = 1.e-9_r8 ! m2 + real(r8) :: err_chk + + sum_forest_bins_so_far_m2 = 0._r8 + forestpatchloop: do f = 1, n_forest_patches + + ! Get the i'th patch (which is the f'th forest patch) + i = indices(f) + currentPatch => site%oldest_patch + allpatchloop: do p = 1, n_patches + if (index_forestpatches_to_allpatches(p) == i) then + exit + end if + currentPatch => currentPatch%younger + end do allpatchloop + if ((.not. associated(currentPatch)) .and. (.not. p == n_patches)) then + write(fates_log(),*) "ERROR: i'th patch (f'th forest patch) not found." + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if + + ! Make sure this is a forest patch + if (.not. currentPatch%is_forest) then + write(fates_log(),*) "ERROR: unexpected non-forest patch in forestpatchloop" + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if + + ! Assign this patch's area + call AssignPatchToBins(site%fraction_forest_in_each_bin, site%area_forest_patches, currentPatch%area, nlevedgeforest, tol, sum_forest_bins_so_far_m2, currentPatch%area_in_edgeforest_bins) + + end do forestpatchloop + + ! More checks + bin_area_sums(:) = 0._r8 + currentPatch => site%oldest_patch + allpatchloop_check: do while (associated(currentPatch)) + if (currentPatch%is_forest) then + + ! Check that all area of each forest patch is assigned + err_chk = sum(currentPatch%area_in_edgeforest_bins) - currentPatch%area + if (abs(err_chk) > tol) then + write(fates_log(),*) "ERROR: unexpected patch forest bin sum (check 3); actual minus expected = ",err_chk + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if + + ! Accumulate site-wide area in each bin + binloop_check4a: do b = 1, nlevedgeforest + bin_area_sums(b) = bin_area_sums(b) + currentPatch%area_in_edgeforest_bins(b) / site%area_forest_patches + end do binloop_check4a + + end if + currentPatch => currentPatch%younger + end do allpatchloop_check + ! Check that fraction in each bin is what was expected + binloop_check4b: do b = 1, nlevedgeforest + err_chk = bin_area_sums(b) - site%fraction_forest_in_each_bin(b) + if (abs(err_chk) > tol) then + write(fates_log(),*) "ERROR: unexpected bin sum (check 4); actual minus expected = ",err_chk + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if + end do binloop_check4b + ! Check that sum of all bin fractions is 1 + err_chk = 1._r8 - sum(site%fraction_forest_in_each_bin(:)) + if (abs(err_chk) > tol) then + write(fates_log(),*) "ERROR: unexpected bin sum (check 5); actual minus expected = ",err_chk + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if + end subroutine AssignPatchesToBins + + + subroutine CalculateEdgeForestArea(site) + ! DESCRIPTION: + ! Loop through forest patches in decreasing order of proximity, calculating the + ! area of each patch that is in each edge bin. + ! + ! USES: + use FatesInterfaceTypesMod, only : nlevedgeforest + use FatesEdgeForestParamsMod, only : ED_val_edgeforest_gaussian_amplitude, ED_val_edgeforest_gaussian_sigma, ED_val_edgeforest_gaussian_center + use FatesEdgeForestParamsMod, only : ED_val_edgeforest_lognormal_amplitude, ED_val_edgeforest_lognormal_sigma, ED_val_edgeforest_lognormal_center + use FatesEdgeForestParamsMod, only : ED_val_edgeforest_quadratic_a, ED_val_edgeforest_quadratic_b, ED_val_edgeforest_quadratic_c + use FatesEdgeForestParamsMod, only : ED_val_edgeforest_bin_edges + ! + ! ARGUMENTS: + type(ed_site_type), pointer, intent(in) :: site + ! + ! LOCAL VARIABLES: + type(fates_patch_type), pointer :: currentPatch + integer, dimension(:), allocatable :: indices ! Indices to use if you want to sort patches + integer, dimension(:), allocatable :: index_forestpatches_to_allpatches ! Array with length (number of patches in gridcell), values 0 if not forest and otherwise an index corresponding to which number forest patch this is + integer :: n_forest_patches ! Number of forest patches + integer :: n_patches ! Number of patches in site + real(r8) :: area_site + real(r8) :: frac_forest + real(r8), dimension(nlevedgeforest), target :: fraction_forest_in_each_bin + + ! Zero out all fractions + currentPatch => site%oldest_patch + do while (associated(currentPatch)) + currentPatch%area_in_edgeforest_bins(:) = 0._r8 + currentPatch => currentPatch%younger + end do + + ! Skip sites with no forest patches + call GetNumberOfForestPatches(site, n_forest_patches, area_site) + if (n_forest_patches == 0) then + return + end if + + ! Allocate arrays + allocate(indices(1:n_forest_patches)) + n_patches = site%GetNumberOfPatches() + allocate(index_forestpatches_to_allpatches(1:n_patches)) + + ! Rank forest patches by their proximity to edge + call RankForestEdgeProximity(site, indices, index_forestpatches_to_allpatches) + + ! Get fraction of forest area in each bin + frac_forest = site%area_forest_patches / area_site + call GetFracEdgeForestInEachBin(frac_forest, nlevedgeforest, ED_val_edgeforest_gaussian_amplitude, ED_val_edgeforest_gaussian_sigma, ED_val_edgeforest_gaussian_center, ED_val_edgeforest_lognormal_amplitude, ED_val_edgeforest_lognormal_sigma, ED_val_edgeforest_lognormal_center, ED_val_edgeforest_quadratic_a, ED_val_edgeforest_quadratic_b, ED_val_edgeforest_quadratic_c, fraction_forest_in_each_bin) + site%fraction_forest_in_each_bin = fraction_forest_in_each_bin + + ! Assign patches to bins + call AssignPatchesToBins(site, indices, index_forestpatches_to_allpatches, n_forest_patches, n_patches) + + ! Clean up + deallocate(indices) + deallocate(index_forestpatches_to_allpatches) + end subroutine CalculateEdgeForestArea + + + elemental function CalcEdgeForestFlam_1var_1bin(mult_factor, add_factor, weather_in) result(weather_out) + ! DESCRIPTION: + ! Apply flammability enhancements to one fireWeather variable for one edge bin + ! + ! USES: + ! + ! ARGUMENTS: + real(r8), intent(in) :: mult_factor ! Multiplicative factor + real(r8), intent(in) :: add_factor ! Additive factor + real(r8), intent(in) :: weather_in ! Value of weather variable before applying factors + ! + ! LOCAL VARIABLES: + real(r8) :: weather_out ! Value of weather variable after applying factors + + weather_out = (weather_in * mult_factor) + add_factor + + end function CalcEdgeForestFlam_1var_1bin + + + subroutine CalcEdgeForestFlam_1var(mult_factors, add_factors, weather_in, weather_out) + ! DESCRIPTION: + ! Calculate one fireWeather variable for all edge bins after applying flammability enhancements + ! + ! USES: + ! + ! ARGUMENTS: + real(r8), intent(in) :: mult_factors(:) ! Multiplicative factors + real(r8), intent(in) :: add_factors(:) ! Additive factors + real(r8), intent(in) :: weather_in ! Value of weather variable before applying factors + real(r8), intent(out) :: weather_out(:) ! Value of weather variable in each bin after applying factors + ! + ! LOCAL VARIABLES: + + weather_out = CalcEdgeForestFlam_1var_1bin(mult_factors, add_factors, weather_in) + + end subroutine CalcEdgeForestFlam_1var + + + subroutine ApplyEdgeForestFlamToPatch_1var(weather_by_edge_bin, patch_area_each_edge_bin, weather_inout) + ! DESCRIPTION: + ! Apply enhancements to one fireWeather variable in a patch based on how much of its area is in + ! each edge bin + ! + ! USES: + ! + ! ARGUMENTS: + real(r8), intent(in) :: weather_by_edge_bin(:) ! Weather value in each edge bin + real(r8), intent(in) :: patch_area_each_edge_bin(:) ! Patch area in each edge bin (unit doesn't matter) + real(r8), intent(inout) :: weather_inout ! Value of fireWeather variable in this patch + ! + ! LOCAL VARIABLES: + real(r8) :: patch_forest_area ! Forest area in patch (unit doesn't matter) + real(r8), allocatable :: patch_weight_each_edge_bin(:) ! Area weighting of each edge bin in patch + + ! If patch has no or little forest, return early to avoid divide-by-zero + ! TODO: Or should such patches get the same flammability as nearest edge? It doesn't make much + ! sense for grassland to have, e.g., lower wind speed than nearest-edge forest just because the + ! grassland isn't getting the flammability enhancement. + patch_forest_area = sum(patch_area_each_edge_bin) + if (patch_forest_area < nearzero) then + return + end if + + ! Calculate weight of each edge bin for this patch + allocate(patch_weight_each_edge_bin(size(patch_area_each_edge_bin))) + patch_weight_each_edge_bin = patch_area_each_edge_bin(:) / patch_forest_area + + weather_inout = sum(weather_by_edge_bin * patch_weight_each_edge_bin) + + ! Clean up + deallocate(patch_weight_each_edge_bin) + + end subroutine ApplyEdgeForestFlamToPatch_1var + + + function CheckFlamChangeIntended(params_mult, params_add, weather_before, weather_after, tol) result(change_intended) + ! DESCRIPTION: + ! Check whether fire weather change was intended. If not but one was found, throw error. + ! + ! + ! ARGUMENTS: + real(r8), intent(in) :: params_mult(:) + real(r8), intent(in) :: params_add(:) + real(r8), intent(in) :: weather_before + real(r8), intent(in) :: weather_after + real(r8), intent(in) :: tol + ! + ! LOCAL VARIABLES + real(r8) :: weather_diff + ! + ! RESULT: + logical :: change_intended + + change_intended = any(abs(params_mult - 1._r8) > tol) .or. any(abs(params_add) > tol) + if (.not. change_intended) then + weather_diff = weather_after - weather_before + if (abs(weather_diff) > tol) then + write(fates_log(),*) 'No fire weather change intended but diff ',weather_diff + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if + end if + end function CheckFlamChangeIntended + + + subroutine ApplyEdgeForestFlamToSite(site) + ! DESCRIPTION: + ! Apply enhancements to one fireWeather variable in a patch based on how much of its area is in + ! each edge bin + ! + ! USES: + use FatesConstantsMod, only: t_water_freeze_k_1atm + use FatesInterfaceTypesMod, only : nlevedgeforest + use FatesEdgeForestParamsMod, only : ED_val_edgeforest_fireweather_rh_mult, ED_val_edgeforest_fireweather_rh_add + use FatesEdgeForestParamsMod, only : ED_val_edgeforest_fireweather_temp_C_mult, ED_val_edgeforest_fireweather_temp_C_add + use FatesEdgeForestParamsMod, only : ED_val_edgeforest_fireweather_wind_mult, ED_val_edgeforest_fireweather_wind_add + ! + ! ARGUMENTS: + type(ed_site_type), pointer, intent(in) :: site + ! + ! LOCAL VARIABLES: + real(r8) :: rh, temp_C, wind + real(r8) :: rh_by_edge_bin(nlevedgeforest) ! rh value in each edge bin + real(r8) :: temp_C_by_edge_bin(nlevedgeforest) ! temp_C value in each edge bin + real(r8) :: wind_by_edge_bin(nlevedgeforest) ! wind value in each edge bin + type(fates_patch_type), pointer :: currentPatch + real(r8) :: weather_inout + logical :: change_intended + real(r8) :: tol = 1.e-9_r8 + real(r8) :: weather_diff + + ! Get site-level weather values, assuming youngest patch has the same values as all others + rh = site%youngest_patch%fireWeather%rh + temp_C = site%youngest_patch%fireWeather%temp_C + wind = site%youngest_patch%fireWeather%wind + + ! Calculate weather values for each edge bin + call CalcEdgeForestFlam_1var( & + ED_val_edgeforest_fireweather_rh_mult, & + ED_val_edgeforest_fireweather_rh_add, & + rh, & + rh_by_edge_bin) + call CalcEdgeForestFlam_1var( & + ED_val_edgeforest_fireweather_temp_C_mult, & + ED_val_edgeforest_fireweather_temp_C_add, & + temp_C, & + temp_C_by_edge_bin) + call CalcEdgeForestFlam_1var( & + ED_val_edgeforest_fireweather_wind_mult, & + ED_val_edgeforest_fireweather_wind_add, & + wind, & + wind_by_edge_bin) + + ! Update patch values + currentPatch => site%oldest_patch + do while(associated(currentPatch)) + ! RH + weather_inout = currentPatch%fireWeather%rh + call ApplyEdgeForestFlamToPatch_1var( & + rh_by_edge_bin, & + currentPatch%area_in_edgeforest_bins, & + weather_inout) + change_intended = CheckFlamChangeIntended(ED_val_edgeforest_fireweather_rh_mult, & + ED_val_edgeforest_fireweather_rh_add, currentPatch%fireWeather%rh, weather_inout, tol) + if (change_intended) then + ! RH can't be negative. In rare cases it can be supersaturated (>100%), so don't check that. + currentPatch%fireWeather%rh = max(weather_inout, 0._r8) + end if + + ! Temp + weather_inout = currentPatch%fireWeather%temp_C + call ApplyEdgeForestFlamToPatch_1var( & + temp_C_by_edge_bin, & + currentPatch%area_in_edgeforest_bins, & + weather_inout) + change_intended = CheckFlamChangeIntended(ED_val_edgeforest_fireweather_temp_C_mult, & + ED_val_edgeforest_fireweather_temp_C_add, currentPatch%fireWeather%temp_C, weather_inout, tol) + if (change_intended) then + ! Temperature can't be below absolute zero + currentPatch%fireWeather%temp_C = max(weather_inout, -t_water_freeze_k_1atm) + end if + + ! Wind + weather_inout = currentPatch%fireWeather%wind + call ApplyEdgeForestFlamToPatch_1var( & + wind_by_edge_bin, & + currentPatch%area_in_edgeforest_bins, & + weather_inout) + change_intended = CheckFlamChangeIntended(ED_val_edgeforest_fireweather_wind_mult, & + ED_val_edgeforest_fireweather_wind_add, currentPatch%fireWeather%wind, weather_inout, tol) + if (change_intended) then + ! Wind speed can't be negative + currentPatch%fireWeather%wind = max(weather_inout, 0._r8) + end if + + currentPatch => currentPatch%younger + end do + + end subroutine ApplyEdgeForestFlamToSite + + + !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + ! + ! The following two subroutines perform an index-sort of an array. + ! They are a GPL-licenced replacement for the Numerical Recipes routine indexx. + ! They are not derived from any NR code, but are based on a quicksort routine by + ! Michael Lamont (http://linux.wku.edu/~lamonml/kb.html), originally written + ! in C, and issued under the GNU General Public License. The conversion to + ! Fortran 90, and modification to do an index sort was done by Ian Rutt. + ! + !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + subroutine indexx(array, index) + + ! Performs an index sort of \texttt{array} and returns the result in + ! \texttt{index}. The order of elements in \texttt{array} is unchanged. + ! + ! This is a GPL-licenced replacement for the Numerical Recipes routine indexx. + ! It is not derived from any NR code, but are based on a quicksort routine by + ! Michael Lamont (http://linux.wku.edu/~lamonml/kb.html), originally written + ! in C, and issued under the GNU General Public License. The conversion to + ! Fortran 90, and modification to do an index sort was done by Ian Rutt. + + real(r8), dimension(:) :: array ! Array to be indexed. + integer, dimension(:) :: index ! Index of elements of patch_array + integer :: i + + if (size(array) /= size(index)) then + write(fates_log(),*) 'ERROR: INDEXX size mismatch.' + call endrun(msg=errMsg(__FILE__, __LINE__)) + else if (size(array) == 0) then + write(fates_log(),*) 'ERROR: INDEXX array size 0.' + call endrun(msg=errMsg(__FILE__, __LINE__)) + endif + + do i=1,size(index) + index(i)=i + enddo + + call q_sort_index(array,index,1,size(array)) + + end subroutine indexx + +!============================================================== + + recursive subroutine q_sort_index(numbers,index,left,right) + + !> This is the recursive subroutine actually used by sort_patches. + !> + !> This is a GPL-licenced replacement for the Numerical Recipes routine indexx. + !> It is not derived from any NR code, but are based on a quicksort routine by + !> Michael Lamont (http://linux.wku.edu/~lamonml/kb.html), originally written + !> in C, and issued under the GNU General Public License. The conversion to + !> Fortran 90, and modification to do an index sort was done by Ian Rutt. + + implicit none + + real(r8), dimension(:) :: numbers !> Numbers being sorted + integer, dimension(:) :: index !> Returned index + integer :: left, right !> Limit of sort region + + integer :: ll,rr + integer :: pv_int,l_hold, r_hold,pivpos + real(r8) :: pivot + + ll=left + rr=right + + l_hold = ll + r_hold = rr + pivot = numbers(index(ll)) + pivpos=index(ll) + + do + if (.not.(ll < rr)) exit + + do + if (.not.((numbers(index(rr)) >= pivot) .and. (ll < rr))) exit + rr=rr-1 + enddo + + if (ll /= rr) then + index(ll) = index(rr) + ll=ll+1 + endif + + do + if (.not.((numbers(index(ll)) <= pivot) .and. (ll < rr))) exit + ll=ll+1 + enddo + + if (ll /= rr) then + index(rr) = index(ll) + rr=rr-1 + endif + enddo + + index(ll) = pivpos + pv_int = ll + ll = l_hold + rr = r_hold + if (ll < pv_int) call q_sort_index(numbers, index,ll, pv_int-1) + if (rr > pv_int) call q_sort_index(numbers, index,pv_int+1, rr) + + end subroutine q_sort_index + + + end module FatesEdgeForestMod diff --git a/main/FatesEdgeForestParamsMod.F90 b/main/FatesEdgeForestParamsMod.F90 new file mode 100644 index 0000000000..d97c365943 --- /dev/null +++ b/main/FatesEdgeForestParamsMod.F90 @@ -0,0 +1,272 @@ +module FatesEdgeForestParamsMod + ! + ! module that deals with reading the edge forest parameter file + ! + use FatesConstantsMod, only : r8 => fates_r8 + use FatesInterfaceTypesMod, only : nlevedgeforest + use FatesParametersInterface, only : param_string_length + use FatesGlobals, only : fates_log + use FatesGlobals, only : endrun => fates_endrun + use FatesUtilsMod, only : is_param_set + use shr_log_mod, only : errMsg => shr_log_errMsg + + implicit none + private + save + + ! + ! this is what the user can use for the actual values + ! + real(r8),protected,allocatable,public :: ED_val_edgeforest_gaussian_amplitude(:) + real(r8),protected,allocatable,public :: ED_val_edgeforest_gaussian_sigma(:) + real(r8),protected,allocatable,public :: ED_val_edgeforest_gaussian_center(:) + real(r8),protected,allocatable,public :: ED_val_edgeforest_lognormal_amplitude(:) + real(r8),protected,allocatable,public :: ED_val_edgeforest_lognormal_sigma(:) + real(r8),protected,allocatable,public :: ED_val_edgeforest_lognormal_center(:) + real(r8),protected,allocatable,public :: ED_val_edgeforest_quadratic_a(:) + real(r8),protected,allocatable,public :: ED_val_edgeforest_quadratic_b(:) + real(r8),protected,allocatable,public :: ED_val_edgeforest_quadratic_c(:) + real(r8),protected,allocatable,public :: ED_val_edgeforest_bin_edges(:) + real(r8),protected,allocatable,public :: ED_val_edgeforest_fireweather_rh_mult(:) + real(r8),protected,allocatable,public :: ED_val_edgeforest_fireweather_temp_C_mult(:) + real(r8),protected,allocatable,public :: ED_val_edgeforest_fireweather_wind_mult(:) + real(r8),protected,allocatable,public :: ED_val_edgeforest_fireweather_rh_add(:) + real(r8),protected,allocatable,public :: ED_val_edgeforest_fireweather_temp_C_add(:) + real(r8),protected,allocatable,public :: ED_val_edgeforest_fireweather_wind_add(:) + + character(len=param_string_length),parameter,public :: ED_name_edgeforest_gaussian_amplitude = "fates_edgeforest_gaussian_amplitude" + character(len=param_string_length),parameter,public :: ED_name_edgeforest_gaussian_sigma = "fates_edgeforest_gaussian_sigma" + character(len=param_string_length),parameter,public :: ED_name_edgeforest_gaussian_center = "fates_edgeforest_gaussian_center" + character(len=param_string_length),parameter,public :: ED_name_edgeforest_lognormal_amplitude = "fates_edgeforest_lognormal_amplitude" + character(len=param_string_length),parameter,public :: ED_name_edgeforest_lognormal_sigma = "fates_edgeforest_lognormal_sigma" + character(len=param_string_length),parameter,public :: ED_name_edgeforest_lognormal_center = "fates_edgeforest_lognormal_center" + character(len=param_string_length),parameter,public :: ED_name_edgeforest_quadratic_a = "fates_edgeforest_quadratic_a" + character(len=param_string_length),parameter,public :: ED_name_edgeforest_quadratic_b = "fates_edgeforest_quadratic_b" + character(len=param_string_length),parameter,public :: ED_name_edgeforest_quadratic_c = "fates_edgeforest_quadratic_c" + character(len=param_string_length),parameter,public :: ED_name_edgeforest_bin_edges = "fates_edgeforest_bin_edges" + character(len=param_string_length),parameter,public :: ED_name_edgeforest_fireweather_rh_mult = "fates_edgeforest_fireweather_rh_mult" + character(len=param_string_length),parameter,public :: ED_name_edgeforest_fireweather_temp_C_mult = "fates_edgeforest_fireweather_temp_C_mult" + character(len=param_string_length),parameter,public :: ED_name_edgeforest_fireweather_wind_mult = "fates_edgeforest_fireweather_wind_mult" + character(len=param_string_length),parameter,public :: ED_name_edgeforest_fireweather_rh_add = "fates_edgeforest_fireweather_rh_add" + character(len=param_string_length),parameter,public :: ED_name_edgeforest_fireweather_temp_C_add = "fates_edgeforest_fireweather_temp_C_add" + character(len=param_string_length),parameter,public :: ED_name_edgeforest_fireweather_wind_add = "fates_edgeforest_fireweather_wind_add" + + character(len=*), parameter, private :: sourcefile = __FILE__ + + public :: EdgeForestRegisterParams + public :: EdgeForestReceiveParams + public :: EdgeForestCheckParams + +contains + + ! ===================================================================================== + + subroutine check_all_unset(value_array, b) + real(r8), dimension(:), intent(in) :: value_array + integer, intent(in) :: b + integer :: i + do i = 1, size(value_array) + if (is_param_set(value_array(i))) then + write(fates_log(),*) 'Multiple fit types found for bin ',b + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if + end do + end subroutine check_all_unset + + subroutine EdgeForestCheckParams(is_master) + + ! ---------------------------------------------------------------------------------- + ! + ! This subroutine performs logical checks on user supplied parameters. It cross + ! compares various parameters and will fail if they don't make sense. + ! E.g.: Each bin should have parameters for exactly one fit type. + ! ----------------------------------------------------------------------------------- + + logical, intent(in) :: is_master ! Only check if this is the master proc + + real(r8) :: gaussian_amplitude + real(r8) :: gaussian_sigma + real(r8) :: gaussian_center + real(r8) :: lognormal_amplitude + real(r8) :: lognormal_sigma + real(r8) :: lognormal_center + real(r8) :: quadratic_a + real(r8) :: quadratic_b + real(r8) :: quadratic_c + integer :: b + + if (.not. is_master) return + + ! Check each bin + do b = 1, nlevedgeforest + + gaussian_amplitude = ED_val_edgeforest_gaussian_amplitude(b) + gaussian_sigma = ED_val_edgeforest_gaussian_sigma(b) + gaussian_center = ED_val_edgeforest_gaussian_center(b) + lognormal_amplitude = ED_val_edgeforest_lognormal_amplitude(b) + lognormal_sigma = ED_val_edgeforest_lognormal_sigma(b) + lognormal_center = ED_val_edgeforest_lognormal_center(b) + quadratic_a = ED_val_edgeforest_quadratic_a(b) + quadratic_b = ED_val_edgeforest_quadratic_b(b) + quadratic_c = ED_val_edgeforest_quadratic_c(b) + + if (is_param_set(gaussian_amplitude)) then + ! Has all gaussian parameters + if (.not. (is_param_set(gaussian_center) .and. is_param_set(gaussian_sigma))) then + write(fates_log(),*) 'Not all gaussian forest edge parameters found for bin ',b + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if + ! Has no other parameters + call check_all_unset( (/ lognormal_amplitude, lognormal_sigma, lognormal_center, quadratic_a, quadratic_b, quadratic_c /), b ) + + else if (is_param_set(lognormal_amplitude)) then + ! Has all lognormal parameters + if (.not. (is_param_set(lognormal_center) .and. is_param_set(lognormal_sigma))) then + write(fates_log(),*) 'Not all lognormal forest edge parameters found for bin ',b + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if + ! Has no other parameters + call check_all_unset( (/ gaussian_amplitude, gaussian_sigma, gaussian_center, quadratic_a, quadratic_b, quadratic_c /), b ) + + else if (is_param_set(quadratic_a)) then + ! Has all quadratic parameters + if (.not. (is_param_set(quadratic_b) .and. is_param_set(quadratic_c))) then + write(fates_log(),*) 'Not all quadratic forest edge parameters found for bin ',b + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if + ! Has no other parameters + call check_all_unset( (/ gaussian_amplitude, gaussian_sigma, gaussian_center, lognormal_amplitude, lognormal_sigma, lognormal_center /), b ) + + else + write(fates_log(),*) 'Unrecognized bin fit type for bin ',b + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if + end do + + return + end subroutine EdgeForestCheckParams + + !----------------------------------------------------------------------- + subroutine EdgeForestRegisterParams(fates_params) + + use FatesParametersInterface, only : fates_parameters_type, dimension_name_scalar, dimension_shape_scalar + use FatesParametersInterface, only : dimension_name_edgeforest_bins + use FatesParametersInterface, only : dimension_shape_1d + + implicit none + + class(fates_parameters_type), intent(inout) :: fates_params + + character(len=param_string_length), parameter :: dim_names_edgeforest(1)= (/dimension_name_edgeforest_bins/) + + call fates_params%RegisterParameter(name=ED_name_edgeforest_gaussian_amplitude, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names_edgeforest) + + call fates_params%RegisterParameter(name=ED_name_edgeforest_gaussian_sigma, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names_edgeforest) + + call fates_params%RegisterParameter(name=ED_name_edgeforest_gaussian_center, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names_edgeforest) + + call fates_params%RegisterParameter(name=ED_name_edgeforest_lognormal_amplitude, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names_edgeforest) + + call fates_params%RegisterParameter(name=ED_name_edgeforest_lognormal_sigma, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names_edgeforest) + + call fates_params%RegisterParameter(name=ED_name_edgeforest_lognormal_center, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names_edgeforest) + + call fates_params%RegisterParameter(name=ED_name_edgeforest_quadratic_a, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names_edgeforest) + + call fates_params%RegisterParameter(name=ED_name_edgeforest_quadratic_b, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names_edgeforest) + + call fates_params%RegisterParameter(name=ED_name_edgeforest_quadratic_c, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names_edgeforest) + + call fates_params%RegisterParameter(name=ED_name_edgeforest_bin_edges, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names_edgeforest) + + call fates_params%RegisterParameter(name=ED_name_edgeforest_fireweather_rh_mult, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names_edgeforest) + + call fates_params%RegisterParameter(name=ED_name_edgeforest_fireweather_temp_C_mult, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names_edgeforest) + + call fates_params%RegisterParameter(name=ED_name_edgeforest_fireweather_wind_mult, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names_edgeforest) + + call fates_params%RegisterParameter(name=ED_name_edgeforest_fireweather_rh_add, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names_edgeforest) + + call fates_params%RegisterParameter(name=ED_name_edgeforest_fireweather_temp_C_add, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names_edgeforest) + + call fates_params%RegisterParameter(name=ED_name_edgeforest_fireweather_wind_add, dimension_shape=dimension_shape_1d, & + dimension_names=dim_names_edgeforest) + + end subroutine EdgeForestRegisterParams + + !----------------------------------------------------------------------- + subroutine EdgeForestReceiveParams(fates_params) + + use FatesParametersInterface, only : fates_parameters_type, dimension_name_scalar + + implicit none + + class(fates_parameters_type), intent(inout) :: fates_params + + call fates_params%RetrieveParameterAllocate(name=ED_name_edgeforest_gaussian_amplitude, & + data=ED_val_edgeforest_gaussian_amplitude) + + call fates_params%RetrieveParameterAllocate(name=ED_name_edgeforest_gaussian_sigma, & + data=ED_val_edgeforest_gaussian_sigma) + + call fates_params%RetrieveParameterAllocate(name=ED_name_edgeforest_gaussian_center, & + data=ED_val_edgeforest_gaussian_center) + + call fates_params%RetrieveParameterAllocate(name=ED_name_edgeforest_lognormal_amplitude, & + data=ED_val_edgeforest_lognormal_amplitude) + + call fates_params%RetrieveParameterAllocate(name=ED_name_edgeforest_lognormal_sigma, & + data=ED_val_edgeforest_lognormal_sigma) + + call fates_params%RetrieveParameterAllocate(name=ED_name_edgeforest_lognormal_center, & + data=ED_val_edgeforest_lognormal_center) + + call fates_params%RetrieveParameterAllocate(name=ED_name_edgeforest_quadratic_a, & + data=ED_val_edgeforest_quadratic_a) + + call fates_params%RetrieveParameterAllocate(name=ED_name_edgeforest_quadratic_b, & + data=ED_val_edgeforest_quadratic_b) + + call fates_params%RetrieveParameterAllocate(name=ED_name_edgeforest_quadratic_c, & + data=ED_val_edgeforest_quadratic_c) + + call fates_params%RetrieveParameterAllocate(name=ED_name_edgeforest_bin_edges, & + data=ED_val_edgeforest_bin_edges) + + call fates_params%RetrieveParameterAllocate(name=ED_name_edgeforest_fireweather_rh_mult, & + data=ED_val_edgeforest_fireweather_rh_mult) + + call fates_params%RetrieveParameterAllocate(name=ED_name_edgeforest_fireweather_temp_C_mult, & + data=ED_val_edgeforest_fireweather_temp_C_mult) + + call fates_params%RetrieveParameterAllocate(name=ED_name_edgeforest_fireweather_wind_mult, & + data=ED_val_edgeforest_fireweather_wind_mult) + + call fates_params%RetrieveParameterAllocate(name=ED_name_edgeforest_fireweather_rh_add, & + data=ED_val_edgeforest_fireweather_rh_add) + + call fates_params%RetrieveParameterAllocate(name=ED_name_edgeforest_fireweather_temp_C_add, & + data=ED_val_edgeforest_fireweather_temp_C_add) + + call fates_params%RetrieveParameterAllocate(name=ED_name_edgeforest_fireweather_wind_add, & + data=ED_val_edgeforest_fireweather_wind_add) + + end subroutine EdgeForestReceiveParams + + +end module FatesEdgeForestParamsMod diff --git a/main/FatesHistoryInterfaceMod.F90 b/main/FatesHistoryInterfaceMod.F90 index b9dc19bf49..20a008af1a 100644 --- a/main/FatesHistoryInterfaceMod.F90 +++ b/main/FatesHistoryInterfaceMod.F90 @@ -50,6 +50,7 @@ module FatesHistoryInterfaceMod use FatesInterfaceTypesMod , only : hlm_use_ed_st3 use FatesInterfaceTypesMod , only : hlm_use_cohort_age_tracking use FatesInterfaceTypesMod , only : hlm_use_tree_damage + use FatesInterfaceTypesMod , only : hlm_use_edge_forest use FatesInterfaceTypesMod , only : nlevdamage use FatesInterfaceTypesMod , only : numpft use FatesInterfaceTypesMod , only : hlm_freq_day @@ -60,6 +61,7 @@ module FatesHistoryInterfaceMod use EDParamsMod , only : nlevleaf use EDParamsMod , only : ED_val_history_height_bin_edges use EDParamsMod , only : ED_val_history_ageclass_bin_edges + use EDParamsMod , only : ED_val_history_height_bin_edges use FatesInterfaceTypesMod , only : nlevsclass, nlevage use FatesInterfaceTypesMod , only : nlevheight use FatesInterfaceTypesMod , only : bc_in_type @@ -68,6 +70,7 @@ module FatesHistoryInterfaceMod use FatesInterfaceTypesMod , only : nlevcoage use FatesInterfaceTypesMod , only : hlm_use_nocomp use FatesInterfaceTypesMod , only : hlm_use_fixed_biogeog + use FatesInterfaceTypesMod , only : nlevedgeforest use FatesRadiationMemMod , only : ivis,inir use FatesInterfaceTypesMod , only : hlm_hist_level_hifrq,hlm_hist_level_dynam use FatesIOVariableKindMod, only : site_r8, site_soil_r8, site_size_pft_r8 @@ -81,6 +84,7 @@ module FatesHistoryInterfaceMod use FatesIOVariableKindMod, only : site_elcwd_r8, site_elage_r8, site_clscpf_r8 use FatesIOVariableKindMod, only : site_cdpf_r8, site_cdsc_r8, site_cdam_r8 use FatesIOVariableKindMod, only : site_landuse_r8, site_lulu_r8, site_lupft_r8 + use FatesIOVariableKindMod, only : site_edgebin_r8 use FatesConstantsMod , only : n_landuse_cats use FatesAllometryMod , only : CrownDepth use FatesAllometryMod , only : bstore_allom, bsap_allom @@ -293,6 +297,24 @@ module FatesHistoryInterfaceMod integer :: ih_trimming_si integer :: ih_fracarea_plant_si integer :: ih_fracarea_trees_si + integer :: ih_is_forest_si + integer :: ih_is_forest_si_age + integer :: ih_is_forest_pct10_si + integer :: ih_is_forest_pct25_si + integer :: ih_is_forest_pct50_si + integer :: ih_is_forest_pct75_si + integer :: ih_is_forest_pct90_si + integer :: ih_is_forest_pct10_0grass_si + integer :: ih_is_forest_pct25_0grass_si + integer :: ih_is_forest_pct50_0grass_si + integer :: ih_is_forest_pct75_0grass_si + integer :: ih_is_forest_pct90_0grass_si + integer :: ih_forest_edge_bin_area_si_edge + integer :: ih_forest_edge_bin_anyarea_si_edge + integer :: ih_fireweather_temp_si_edge + integer :: ih_fireweather_precip_si_edge + integer :: ih_fireweather_rh_si_edge + integer :: ih_fireweather_wind_si_edge integer :: ih_litter_in_elem integer :: ih_litter_out_elem integer :: ih_seed_bank_elem @@ -446,23 +468,34 @@ module FatesHistoryInterfaceMod integer :: ih_cleafon_si integer :: ih_nesterov_fire_danger_si + integer :: ih_nesterov_fire_danger_si_edge integer :: ih_fire_nignitions_si + integer :: ih_fire_nignitions_si_edge integer :: ih_fire_fdi_si + integer :: ih_fire_fdi_si_edge integer :: ih_fire_intensity_fracarea_product_si + integer :: ih_fire_intensity_fracarea_product_si_edge integer :: ih_nonrx_intensity_fracarea_product_si integer :: ih_rx_intensity_fracarea_product_si integer :: ih_spitfire_ros_si + integer :: ih_spitfire_ros_si_edge integer :: ih_effect_wspeed_si + integer :: ih_effect_wspeed_si_edge integer :: ih_tfc_ros_si + integer :: ih_tfc_ros_si_edge integer :: ih_fire_intensity_si + integer :: ih_fire_intensity_si_edge integer :: ih_nonrx_intensity_si integer :: ih_fire_fracarea_si + integer :: ih_fire_fracarea_si_edge integer :: ih_nonrx_fracarea_si integer :: ih_fire_fuel_bulkd_si integer :: ih_fire_fuel_eff_moist_si + integer :: ih_fire_fuel_eff_moist_si_edge integer :: ih_fire_fuel_sav_si integer :: ih_fire_fuel_mef_si integer :: ih_sum_fuel_si + integer :: ih_sum_fuel_si_edge integer :: ih_rx_burn_window_si integer :: ih_rx_intensity_si integer :: ih_rx_fracarea_si @@ -471,6 +504,9 @@ module FatesHistoryInterfaceMod integer :: ih_rx_fracarea_final_si integer :: ih_fragmentation_scaler_sl + integer :: ih_ovp_relhumid24_si ! TODO: Remove. Useful during development but probably not needed in production. + integer :: ih_ovp_wind24_si ! TODO: Remove. Useful during development but probably not needed in production. + integer :: ih_nplant_si_scpf integer :: ih_gpp_si_scpf integer :: ih_npp_totl_si_scpf @@ -664,6 +700,8 @@ module FatesHistoryInterfaceMod ! indices to (site x patch-age) variables integer :: ih_fracarea_si_age + integer :: ih_fracarea_plant_si_age + integer :: ih_fracarea_trees_si_age integer :: ih_lai_si_age integer :: ih_canopy_fracarea_si_age integer :: ih_gpp_si_age @@ -831,6 +869,7 @@ module FatesHistoryInterfaceMod !! THESE WERE EXPLICITLY PRIVATE WHEN TYPE WAS PUBLIC integer, private :: column_index_, levsoil_index_, levscpf_index_ integer, private :: levscls_index_, levpft_index_, levage_index_ + integer, private :: levedgeforest_index_ integer, private :: levfuel_index_, levcwdsc_index_, levscag_index_ integer, private :: levcan_index_, levcnlf_index_, levcnlfpft_index_ integer, private :: levcdpf_index_, levcdsc_index_, levcdam_index_ @@ -872,6 +911,7 @@ module FatesHistoryInterfaceMod procedure :: levcacls_index procedure :: levpft_index procedure :: levage_index + procedure :: levedgeforest_index procedure :: levfuel_index procedure :: levcwdsc_index procedure :: levcan_index @@ -908,6 +948,7 @@ module FatesHistoryInterfaceMod procedure, private :: set_levscls_index procedure, private :: set_levpft_index procedure, private :: set_levage_index + procedure, private :: set_levedgeforest_index procedure, private :: set_levfuel_index procedure, private :: set_levcwdsc_index procedure, private :: set_levcan_index @@ -953,6 +994,7 @@ subroutine Init(this, num_threads, fates_bounds) use FatesIODimensionsMod, only : column, levsoil, levscpf use FatesIODimensionsMod, only : levscls, levpft, levage + use FatesIODimensionsMod, only : levedgeforest use FatesIODimensionsMod, only : levcacls, levcapf use FatesIODimensionsMod, only : levfuel, levcwdsc, levscag use FatesIODimensionsMod, only : levscagpft, levagepft @@ -1012,6 +1054,11 @@ subroutine Init(this, num_threads, fates_bounds) call this%dim_bounds(dim_count)%Init(levage, num_threads, & fates_bounds%age_class_begin, fates_bounds%age_class_end) + dim_count = dim_count + 1 + call this%set_levedgeforest_index(dim_count) + call this%dim_bounds(dim_count)%Init(levedgeforest, num_threads, & + fates_bounds%edgeforest_class_begin, fates_bounds%edgeforest_class_end) + dim_count = dim_count + 1 call this%set_levfuel_index(dim_count) call this%dim_bounds(dim_count)%Init(levfuel, num_threads, & @@ -1165,6 +1212,10 @@ subroutine SetThreadBoundsEach(this, thread_index, thread_bounds) call this%dim_bounds(index)%SetThreadBounds(thread_index, & thread_bounds%age_class_begin, thread_bounds%age_class_end) + index = this%levedgeforest_index() + call this%dim_bounds(index)%SetThreadBounds(thread_index, & + thread_bounds%edgeforest_class_begin, thread_bounds%edgeforest_class_end) + index = this%levfuel_index() call this%dim_bounds(index)%SetThreadBounds(thread_index, & thread_bounds%fuel_begin, thread_bounds%fuel_end) @@ -1255,8 +1306,6 @@ end subroutine SetThreadBoundsEach ! =================================================================================== subroutine assemble_history_output_types(this) - - implicit none class(fates_history_interface_type), intent(inout) :: this @@ -1286,6 +1335,9 @@ subroutine assemble_history_output_types(this) call this%set_dim_indices(site_age_r8, 1, this%column_index()) call this%set_dim_indices(site_age_r8, 2, this%levage_index()) + call this%set_dim_indices(site_edgebin_r8, 1, this%column_index()) + call this%set_dim_indices(site_edgebin_r8, 2, this%levedgeforest_index()) + call this%set_dim_indices(site_fuel_r8, 1, this%column_index()) call this%set_dim_indices(site_fuel_r8, 2, this%levfuel_index()) @@ -1503,6 +1555,20 @@ integer function levage_index(this) levage_index = this%levage_index_ end function levage_index + ! ======================================================================= + subroutine set_levedgeforest_index(this, index) + implicit none + class(fates_history_interface_type), intent(inout) :: this + integer, intent(in) :: index + this%levedgeforest_index_ = index + end subroutine set_levedgeforest_index + + integer function levedgeforest_index(this) + implicit none + class(fates_history_interface_type), intent(in) :: this + levedgeforest_index = this%levedgeforest_index_ + end function levedgeforest_index + ! ======================================================================= subroutine set_levfuel_index(this, index) implicit none @@ -1975,16 +2041,6 @@ subroutine init_dim_kinds_maps(this) ! number of entries listed here. ! ! ---------------------------------------------------------------------------------- - use FatesIOVariableKindMod, only : site_r8, site_soil_r8, site_size_pft_r8 - use FatesIOVariableKindMod, only : site_size_r8, site_pft_r8, site_age_r8 - use FatesIOVariableKindMod, only : site_coage_r8, site_coage_pft_r8 - use FatesIOVariableKindMod, only : site_fuel_r8, site_cwdsc_r8, site_scag_r8 - use FatesIOVariableKindMod, only : site_scagpft_r8, site_agepft_r8 - use FatesIOVariableKindMod, only : site_can_r8, site_cnlf_r8, site_cnlfpft_r8 - use FatesIOVariableKindMod, only : site_height_r8, site_agefuel_r8 - use FatesIOVariableKindMod, only : site_elem_r8, site_elpft_r8 - use FatesIOVariableKindMod, only : site_elcwd_r8, site_elage_r8, site_clscpf_r8 - use FatesIOVariableKindMod, only : site_cdpf_r8, site_cdsc_r8, site_cdam_r8 implicit none @@ -2026,6 +2082,10 @@ subroutine init_dim_kinds_maps(this) index = index + 1 call this%dim_kinds(index)%Init(site_age_r8, 2) + ! site x forest-edge-bin class + index = index + 1 + call this%dim_kinds(index)%Init(site_edgebin_r8, 2) + ! site x fuel size class index = index + 1 call this%dim_kinds(index)%Init(site_fuel_r8, 2) @@ -2387,6 +2447,8 @@ subroutine update_history_dyn_sitelevel(this,nc,nsites,sites) ! updated here, but not FATES_VEGC_PF. ! --------------------------------------------------------------------------------- + use FatesEcotypesMod, only : IsPatchForest + use FatesUtilsMod, only : logical_to_real ! Arguments class(fates_history_interface_type) :: this @@ -2436,7 +2498,18 @@ subroutine update_history_dyn_sitelevel(this,nc,nsites,sites) hio_zstar_si => this%hvars(ih_zstar_si)%r81d, & hio_trimming_si => this%hvars(ih_trimming_si)%r81d, & hio_fracarea_plant_si => this%hvars(ih_fracarea_plant_si)%r81d, & - hio_fracarea_trees_si => this%hvars(ih_fracarea_trees_si)%r81d, & + hio_fracarea_trees_si => this%hvars(ih_fracarea_trees_si)%r81d, & + hio_is_forest_si => this%hvars(ih_is_forest_si)%r81d, & + hio_is_forest_pct10_si => this%hvars(ih_is_forest_pct10_si)%r81d, & + hio_is_forest_pct25_si => this%hvars(ih_is_forest_pct25_si)%r81d, & + hio_is_forest_pct50_si => this%hvars(ih_is_forest_pct50_si)%r81d, & + hio_is_forest_pct75_si => this%hvars(ih_is_forest_pct75_si)%r81d, & + hio_is_forest_pct90_si => this%hvars(ih_is_forest_pct90_si)%r81d, & + hio_is_forest_pct10_0grass_si => this%hvars(ih_is_forest_pct10_0grass_si)%r81d, & + hio_is_forest_pct25_0grass_si => this%hvars(ih_is_forest_pct25_0grass_si)%r81d, & + hio_is_forest_pct50_0grass_si => this%hvars(ih_is_forest_pct50_0grass_si)%r81d, & + hio_is_forest_pct75_0grass_si => this%hvars(ih_is_forest_pct75_0grass_si)%r81d, & + hio_is_forest_pct90_0grass_si => this%hvars(ih_is_forest_pct90_0grass_si)%r81d, & hio_fates_fraction_si => this%hvars(ih_fates_fraction_si)%r81d, & hio_ba_weighted_height_si => this%hvars(ih_ba_weighted_height_si)%r81d, & hio_ca_weighted_height_si => this%hvars(ih_ca_weighted_height_si)%r81d, & @@ -2456,6 +2529,11 @@ subroutine update_history_dyn_sitelevel(this,nc,nsites,sites) hio_fire_fuel_sav_si => this%hvars(ih_fire_fuel_sav_si)%r81d, & hio_fire_fuel_mef_si => this%hvars(ih_fire_fuel_mef_si)%r81d, & hio_sum_fuel_si => this%hvars(ih_sum_fuel_si)%r81d, & + + ! TODO: Remove. Useful during development but probably not needed in production. + hio_ovp_relhumid24_si => this%hvars(ih_ovp_relhumid24_si)%r81d, & + hio_ovp_wind24_si => this%hvars(ih_ovp_wind24_si)%r81d, & + hio_nonrx_intensity_si => this%hvars(ih_nonrx_intensity_si)%r81d, & hio_nonrx_intensity_fracarea_product_si => this%hvars(ih_nonrx_intensity_fracarea_product_si)%r81d, & hio_nonrx_fracarea_si => this%hvars(ih_nonrx_fracarea_si)%r81d, & @@ -2575,21 +2653,6 @@ subroutine update_history_dyn_sitelevel(this,nc,nsites,sites) ! site-level fire variables: - ! Nesterov index (unitless) - hio_nesterov_fire_danger_si(io_si) = sites(s)%fireWeather%fire_weather_index - - hio_effect_wspeed_si(io_si) = sites(s)%fireWeather%effective_windspeed/sec_per_min - - ! Prescribed fire burn window - hio_rx_burn_window_si(io_si) = hio_rx_burn_window_si(io_si) + sites(s)%fireWeather%rx_flag - - ! number of ignitions [#/km2/day -> #/m2/s] - hio_fire_nignitions_si(io_si) = sites(s)%NF_successful / m2_per_km2 / & - sec_per_day - - ! Fire danger index (FDI) (0-1) - hio_fire_fdi_si(io_si) = sites(s)%FDI - ! total rx burnable fraction when fuel condition met hio_rx_fracarea_fuel_si(io_si) = sites(s)%rxfire_area_fuel * AREA_INV @@ -2677,6 +2740,10 @@ subroutine update_history_dyn_sitelevel(this,nc,nsites,sites) sum(elflux_diags_c%root_litter_input(:))) * & AREA_INV * days_per_sec + ! TODO: Remove. Useful during development but probably not needed in production. + hio_ovp_relhumid24_si(io_si) = sites(s)%ovp_relhumid24 + hio_ovp_wind24_si(io_si) = sites(s)%ovp_wind24 + ! Loop through patches to sum up diagonistics cpatch => sites(s)%oldest_patch patchloop: do while(associated(cpatch)) @@ -2719,6 +2786,31 @@ subroutine update_history_dyn_sitelevel(this,nc,nsites,sites) hio_fracarea_plant_si(io_si) = hio_fracarea_plant_si(io_si) + min(cpatch%total_canopy_area,cpatch%area) * AREA_INV hio_fracarea_trees_si(io_si) = hio_fracarea_trees_si(io_si) + min(cpatch%total_tree_area,cpatch%area) * AREA_INV + ! whether patch is forest according to FATES parameter file threshold + hio_is_forest_si(io_si) = hio_is_forest_si(io_si) + & + merge(1._r8, 0._r8, cpatch%is_forest) * cpatch%area * AREA_INV + ! according to experimental definitions + hio_is_forest_pct10_si(io_si) = hio_is_forest_pct10_si(io_si) + cpatch%area * AREA_INV * & + logical_to_real(IsPatchForest(cpatch, 0.1_r8)) + hio_is_forest_pct25_si(io_si) = hio_is_forest_pct25_si(io_si) + cpatch%area * AREA_INV * & + logical_to_real(IsPatchForest(cpatch, 0.25_r8)) + hio_is_forest_pct50_si(io_si) = hio_is_forest_pct50_si(io_si) + cpatch%area * AREA_INV * & + logical_to_real(IsPatchForest(cpatch, 0.5_r8)) + hio_is_forest_pct75_si(io_si) = hio_is_forest_pct75_si(io_si) + cpatch%area * AREA_INV * & + logical_to_real(IsPatchForest(cpatch, 0.75_r8)) + hio_is_forest_pct90_si(io_si) = hio_is_forest_pct90_si(io_si) + cpatch%area * AREA_INV * & + logical_to_real(IsPatchForest(cpatch, 0.9_r8)) + hio_is_forest_pct10_0grass_si(io_si) = hio_is_forest_pct10_0grass_si(io_si) + cpatch%area * AREA_INV * & + logical_to_real(IsPatchForest(cpatch, 0.1_r8, grass_biomass_threshold=0._r8)) + hio_is_forest_pct25_0grass_si(io_si) = hio_is_forest_pct25_0grass_si(io_si) + cpatch%area * AREA_INV * & + logical_to_real(IsPatchForest(cpatch, 0.25_r8, grass_biomass_threshold=0._r8)) + hio_is_forest_pct50_0grass_si(io_si) = hio_is_forest_pct50_0grass_si(io_si) + cpatch%area * AREA_INV * & + logical_to_real(IsPatchForest(cpatch, 0.5_r8, grass_biomass_threshold=0._r8)) + hio_is_forest_pct75_0grass_si(io_si) = hio_is_forest_pct75_0grass_si(io_si) + cpatch%area * AREA_INV * & + logical_to_real(IsPatchForest(cpatch, 0.75_r8, grass_biomass_threshold=0._r8)) + hio_is_forest_pct90_0grass_si(io_si) = hio_is_forest_pct90_0grass_si(io_si) + cpatch%area * AREA_INV * & + logical_to_real(IsPatchForest(cpatch, 0.9_r8, grass_biomass_threshold=0._r8)) + ! Patch specific variables that are already calculated ! These things are all duplicated. Should they all be converted to LL or array structures RF? ! define scalar to counteract the patch albedo scaling logic for conserved quantities @@ -2747,6 +2839,25 @@ subroutine update_history_dyn_sitelevel(this,nc,nsites,sites) hio_fire_intensity_fracarea_product_si(io_si) = hio_fire_intensity_fracarea_product_si(io_si) + & cpatch%FI * cpatch%frac_burnt * cpatch%area * AREA_INV * J_per_kJ + hio_fire_fdi_si(io_si) = hio_fire_fdi_si(io_si) + & + cpatch%FDI * cpatch%area * AREA_INV + + ! number of ignitions [#/km2/day -> #/m2/s] + hio_fire_nignitions_si(io_si) = hio_fire_nignitions_si(io_si) + & + cpatch%NF_successful / m2_per_km2 / sec_per_day * & + cpatch%area * AREA_INV + + ! Nesterov index (unitless) + hio_nesterov_fire_danger_si(io_si) = hio_nesterov_fire_danger_si(io_si) + & + cpatch%fireWeather%fire_weather_index * cpatch%area * AREA_INV + + hio_effect_wspeed_si(io_si) = hio_effect_wspeed_si(io_si) + & + cpatch%fireWeather%effective_windspeed/sec_per_min * cpatch%area * AREA_INV + + ! Prescribed fire burn window + hio_rx_burn_window_si(io_si) = hio_rx_burn_window_si(io_si) + & + cpatch%fireWeather%rx_flag * cpatch%area * AREA_INV + litt => cpatch%litter(element_pos(carbon12_element)) patch_fracarea = cpatch%area * AREA_INV @@ -3084,7 +3195,7 @@ subroutine update_history_dyn_subsite(this,nc,nsites,sites,bc_in) type(litter_type), pointer :: litt_c ! Pointer to the carbon12 litter pool type(litter_type), pointer :: litt ! Generic pointer to any litter pool integer :: s ! site counter - integer :: ipa2 ! patch index matching host model array space + integer :: b ! edge bin counter integer :: io_si ! site's index in the history output array space integer :: el ! element index integer :: ft ! pft index @@ -3115,6 +3226,10 @@ subroutine update_history_dyn_subsite(this,nc,nsites,sites,bc_in) ! time-since-anthropogenic-disturbance of secondary forest real(r8) :: patch_fracarea ! Fraction of area for this patch real(r8) :: frac_canopy_in_bin ! fraction of a leaf's canopy that is within a given height bin + real(r8) :: patch_area_in_this_bin ! amount of patch area in a given forest edge bin (mw) + real(r8) :: site_area_in_this_bin ! amount of site area in a given forest edge bin (m2) + real(r8) :: patch_weight_of_this_bin ! contribution of (part of) this patch to total site area of a given forest edge bin + real(r8) :: area_burned_this_bin ! area (m2) burned in a given forest edge bin real(r8) :: binbottom,bintop ! edges of height bins integer :: height_bin_max, height_bin_min ! which height bin a given cohort's canopy is in integer :: ican, ileaf, cnlf_indx ! iterators for leaf and canopy level @@ -3137,6 +3252,11 @@ subroutine update_history_dyn_subsite(this,nc,nsites,sites,bc_in) real(r8) :: a_sapw ! sapwood area [m^2] real(r8) :: c_sapw ! sapwood biomass [kgC] + ! TODO: Remove? For checking that patch bin weights are correct + real(r8) :: sum_bin_weight_of_all_patches + real(r8) :: bin_weight_discrepancy + real(r8) :: bin_weight_discrepancy_as_frac_site_forest + integer :: i_dist, j_dist type(elem_diag_type), pointer :: elflux_diags @@ -3319,6 +3439,23 @@ subroutine update_history_dyn_subsite(this,nc,nsites,sites,bc_in) hio_cwd_ag_out_si_cwdsc => this%hvars(ih_cwd_ag_out_si_cwdsc)%r82d, & hio_cwd_bg_out_si_cwdsc => this%hvars(ih_cwd_bg_out_si_cwdsc)%r82d, & hio_crownarea_si_cnlf => this%hvars(ih_crownarea_si_cnlf)%r82d, & + hio_forest_edge_bin_area_si_edge => this%hvars(ih_forest_edge_bin_area_si_edge)%r82d, & + hio_forest_edge_bin_anyarea_si_edge => this%hvars(ih_forest_edge_bin_anyarea_si_edge)%r82d, & + hio_fireweather_precip_si_edge => this%hvars(ih_fireweather_precip_si_edge)%r82d, & + hio_fireweather_rh_si_edge => this%hvars(ih_fireweather_rh_si_edge)%r82d, & + hio_fireweather_temp_si_edge => this%hvars(ih_fireweather_temp_si_edge)%r82d, & + hio_fireweather_wind_si_edge => this%hvars(ih_fireweather_wind_si_edge)%r82d, & + hio_nesterov_fire_danger_si_edge => this%hvars(ih_nesterov_fire_danger_si_edge)%r82d, & + hio_fire_nignitions_si_edge => this%hvars(ih_fire_nignitions_si_edge)%r82d, & + hio_fire_fdi_si_edge => this%hvars(ih_fire_fdi_si_edge)%r82d, & + hio_fire_intensity_fracarea_product_si_edge => this%hvars(ih_fire_intensity_fracarea_product_si_edge)%r82d, & + hio_spitfire_ros_si_edge => this%hvars(ih_spitfire_ros_si_edge)%r82d, & + hio_effect_wspeed_si_edge => this%hvars(ih_effect_wspeed_si_edge)%r82d, & + hio_tfc_ros_si_edge => this%hvars(ih_tfc_ros_si_edge)%r82d, & + hio_fire_intensity_si_edge => this%hvars(ih_fire_intensity_si_edge)%r82d, & + hio_fire_fracarea_si_edge => this%hvars(ih_fire_fracarea_si_edge)%r82d, & + hio_fire_fuel_eff_moist_si_edge => this%hvars(ih_fire_fuel_eff_moist_si_edge)%r82d, & + hio_sum_fuel_si_edge => this%hvars(ih_sum_fuel_si_edge)%r82d, & hio_crownarea_cl => this%hvars(ih_crownarea_cl)%r82d) ! Break up associates for NAG compilers @@ -3425,12 +3562,112 @@ subroutine update_history_dyn_subsite(this,nc,nsites,sites,bc_in) end if end do + ! TODO: Move "area of forest in each edge bin" from below into here + if (hlm_use_edge_forest == itrue .and. sites(s)%area_forest_patches > 0._r8) then + do b = 1, nlevedgeforest + + ! Skip this bin if site has no forest area in it + site_area_in_this_bin = sites(s)%area_forest_patches * sites(s)%fraction_forest_in_each_bin(b) + if (site_area_in_this_bin == 0._r8) then + cycle + end if + + ! Calculate area of this bin that burned + area_burned_this_bin = 0._r8 + cpatch => sites(s)%oldest_patch + do while(associated(cpatch)) + area_burned_this_bin = area_burned_this_bin + cpatch%frac_burnt * cpatch%area + cpatch => cpatch%younger + end do + + ! Calculate (weighted) means across all patches in this bin + sum_bin_weight_of_all_patches = 0._r8 + cpatch => sites(s)%oldest_patch + do while(associated(cpatch)) + + ! Skip this patch if it has no area in this bin + patch_area_in_this_bin = cpatch%area_in_edgeforest_bins(b) + if (patch_area_in_this_bin == 0._r8) then + cpatch => cpatch%younger + cycle + end if + + ! Calculate weight of this patch + patch_weight_of_this_bin = patch_area_in_this_bin / site_area_in_this_bin + + ! For checking that weighting is correct + sum_bin_weight_of_all_patches = sum_bin_weight_of_all_patches + patch_weight_of_this_bin + + ! fire weather in each edge bin + hio_fireweather_precip_si_edge(io_si,b) = hio_fireweather_precip_si_edge(io_si,b) + & + cpatch%fireWeather%precip * patch_weight_of_this_bin + hio_fireweather_rh_si_edge(io_si,b) = hio_fireweather_rh_si_edge(io_si,b) + & + cpatch%fireWeather%rh * patch_weight_of_this_bin + hio_fireweather_temp_si_edge(io_si,b) = hio_fireweather_temp_si_edge(io_si,b) + & + cpatch%fireWeather%temp_C * patch_weight_of_this_bin + hio_fireweather_wind_si_edge(io_si,b) = hio_fireweather_wind_si_edge(io_si,b) + & + cpatch%fireWeather%wind * patch_weight_of_this_bin + hio_nesterov_fire_danger_si_edge(io_si,b) = hio_nesterov_fire_danger_si_edge(io_si,b) + & + cpatch%fireWeather%fire_weather_index * patch_weight_of_this_bin + hio_effect_wspeed_si_edge(io_si,b) = hio_effect_wspeed_si_edge(io_si,b) + & + cpatch%fireWeather%effective_windspeed/sec_per_min * patch_weight_of_this_bin + hio_fire_fdi_si_edge(io_si,b) = hio_fire_fdi_si_edge(io_si,b) + & + cpatch%FDI * patch_weight_of_this_bin + + ! fuel state in each edge bin + hio_fire_fuel_eff_moist_si_edge(io_si,b) = hio_fire_fuel_eff_moist_si_edge(io_si,b) + & + cpatch%fuel%average_moisture_notrunks * patch_weight_of_this_bin + hio_sum_fuel_si_edge(io_si,b) = hio_sum_fuel_si_edge(io_si,b) + & + cpatch%fuel%non_trunk_loading * patch_weight_of_this_bin + + ! fire in each edge bin + hio_fire_nignitions_si_edge(io_si,b) = hio_fire_nignitions_si_edge(io_si,b) + & + cpatch%NF_successful / m2_per_km2 / sec_per_day * patch_weight_of_this_bin + hio_fire_intensity_fracarea_product_si_edge(io_si,b) =hio_fire_intensity_fracarea_product_si_edge(io_si,b) + & + cpatch%FI * cpatch%frac_burnt * patch_weight_of_this_bin * J_per_kJ + hio_spitfire_ros_si_edge(io_si,b) = hio_spitfire_ros_si_edge(io_si,b) + & + cpatch%ROS_front * patch_weight_of_this_bin / sec_per_min + hio_tfc_ros_si_edge(io_si,b) = hio_tfc_ros_si_edge(io_si,b) + & + cpatch%TFC_ROS * patch_weight_of_this_bin + hio_fire_fracarea_si_edge(io_si,b) = hio_fire_fracarea_si_edge(io_si,b) + & + cpatch%frac_burnt * patch_weight_of_this_bin / sec_per_day + + cpatch => cpatch%younger + end do + + ! Check that weighting is correct + ! TODO: Remove? + bin_weight_discrepancy = abs(1._r8 - sum_bin_weight_of_all_patches) + bin_weight_discrepancy_as_frac_site_forest = bin_weight_discrepancy * sites(s)%fraction_forest_in_each_bin(b) + if (bin_weight_discrepancy > 1e-9_r8 .and. bin_weight_discrepancy_as_frac_site_forest > 1e-9_r8) then + write(fates_log(),*) 'sum of patch bin weights not 1: ',sum_bin_weight_of_all_patches + write(fates_log(),*) 'sites(s)%area_forest_patches: ',sites(s)%area_forest_patches + write(fates_log(),*) 'sites(s)%fraction_forest_in_each_bin(b): ',sites(s)%fraction_forest_in_each_bin(b) + write(fates_log(),*) 'site_area_in_this_bin: ',site_area_in_this_bin + write(fates_log(),*) 'bin_weight_discrepancy: ',bin_weight_discrepancy + write(fates_log(),*) 'bin_weight_discrepancy_as_frac_site_forest: ',bin_weight_discrepancy_as_frac_site_forest + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if + + end do + end if + ! Loop through patches to sum up diagonistics cpatch => sites(s)%oldest_patch patchloop: do while(associated(cpatch)) hio_fracarea_si(io_si) = hio_fracarea_si(io_si) & + cpatch%area * AREA_INV + ! area of forest in each edge bin + if (hlm_use_edge_forest == itrue .and. cpatch%is_forest) then + binloop: do b = 1, nlevedgeforest + hio_forest_edge_bin_area_si_edge(io_si,b) = hio_forest_edge_bin_area_si_edge(io_si,b) + & + cpatch%area_in_edgeforest_bins(b) + if (cpatch%area_in_edgeforest_bins(b) > 0._r8) then + hio_forest_edge_bin_anyarea_si_edge(io_si,b) = 1._r8 + end if + end do binloop + end if ! ignore land use info on nocomp bareground (where landuse label = 0) if (cpatch%land_use_label .gt. nocomp_bareground_land) then @@ -4782,6 +5019,7 @@ subroutine update_history_dyn_subsite_ageclass(this,nc,nsites,sites) associate( & hio_lai_si_age => this%hvars(ih_lai_si_age)%r82d, & + hio_is_forest_si_age => this%hvars(ih_is_forest_si_age)%r82d, & hio_ncl_si_age => this%hvars(ih_ncl_si_age)%r82d, & hio_scorch_height_si_agepft => this%hvars(ih_scorch_height_si_agepft)%r82d, & hio_zstar_si_age => this%hvars(ih_zstar_si_age)%r82d, & @@ -4808,6 +5046,8 @@ subroutine update_history_dyn_subsite_ageclass(this,nc,nsites,sites) hio_nplant_canopy_si_scag => this%hvars(ih_nplant_canopy_si_scag)%r82d, & hio_nplant_understory_si_scag => this%hvars(ih_nplant_understory_si_scag)%r82d, & hio_fracarea_si_age => this%hvars(ih_fracarea_si_age)%r82d, & + hio_fracarea_plant_si_age => this%hvars(ih_fracarea_plant_si_age)%r82d, & + hio_fracarea_trees_si_age => this%hvars(ih_fracarea_trees_si_age)%r82d, & hio_agesince_anthrodist_si_age => this%hvars(ih_agesince_anthrodist_si_age)%r82d, & hio_primarylands_fracarea_si_age => this%hvars(ih_primarylands_fracarea_si_age)%r82d, & hio_secondarylands_fracarea_si_age => this%hvars(ih_secondarylands_fracarea_si_age)%r82d, & @@ -4866,6 +5106,10 @@ subroutine update_history_dyn_subsite_ageclass(this,nc,nsites,sites) + cpatch%zstar * patch_area_div_site_area end if + ! whether patch is forest according to FATES parameter file threshold + hio_is_forest_si_age(io_si,cpatch%age_class) = hio_is_forest_si_age(io_si,cpatch%age_class) + & + merge(1._r8, 0._r8, cpatch%is_forest) * patch_area_div_site_area + ! some diagnostics on secondary forest area and its age distribution if ( cpatch%land_use_label .eq. secondaryland ) then @@ -4900,16 +5144,24 @@ subroutine update_history_dyn_subsite_ageclass(this,nc,nsites,sites) hio_fire_intensity_si_age(io_si, cpatch%age_class) = hio_fire_intensity_si_age(io_si,cpatch%age_class) + & cpatch%FI * J_per_kJ & ! [kJ/m/s] -> [J/m/s] * cpatch%frac_burnt * patch_area_div_site_area - ! hio_fire_rate_of_spread_front_si_age(io_si, cpatch%age_class) = hio_fire_rate_of_spread_si_age(io_si, cpatch%age_class) + & - ! cpatch%ros_front * cpatch*frac_burnt * patch_area_div_site_area - hio_rx_intensity_si_age(io_si, cpatch%age_class) = hio_rx_intensity_si_age(io_si, cpatch%age_class) + & cpatch%rx_FI * J_per_kJ & ! [kJ/m/s] -> [J/m/s] * cpatch%rx_frac_burnt * patch_area_div_site_area - hio_nonrx_intensity_si_age(io_si, cpatch%age_class) = hio_nonrx_intensity_si_age(io_si, cpatch%age_class) + & cpatch%nonrx_FI * J_per_kJ & ! [kJ/m/s] -> [J/m/s] * cpatch%nonrx_frac_burnt * patch_area_div_site_area + ! hio_fire_rate_of_spread_front_si_age(io_si, cpatch%age_class) = hio_fire_rate_of_spread_si_age(io_si, cpatch%age_class) + & + ! cpatch%ros_front * cpatch*frac_burnt * patch_area_div_site_area + + ! Weighted by site-wide plant or tree canopy area + hio_fracarea_plant_si_age(io_si,cpatch%age_class) = & + hio_fracarea_plant_si_age(io_si,cpatch%age_class) + & + min(cpatch%total_canopy_area,cpatch%area) * & + AREA_INV + hio_fracarea_trees_si_age(io_si,cpatch%age_class) = & + hio_fracarea_trees_si_age(io_si,cpatch%age_class) + & + min(cpatch%total_tree_area,cpatch%area) * & + AREA_INV ! Weighted by cohort canopy area relative to site area ccohort => cpatch%shortest @@ -5428,7 +5680,7 @@ subroutine update_history_hifrq_subsite(this,nc,nsites,sites,dt_tstep) hio_parsun_si_can => this%hvars(ih_parsun_si_can)%r82d, & hio_parsha_si_can => this%hvars(ih_parsha_si_can)%r82d, & hio_laisun_si_can => this%hvars(ih_laisun_si_can)%r82d, & - hio_laisha_si_can => this%hvars(ih_laisha_si_can)%r82d ) + hio_laisha_si_can => this%hvars(ih_laisha_si_can)%r82d) ! THIS CAN BE REMOVED WHEN BOTH CTSM AND E3SM CALL FLUSH_ALL_HVARS @@ -6296,19 +6548,8 @@ subroutine define_history_vars(this, initialize_variables) ! a real. The applied flush value will use the NINT() intrinsic function ! --------------------------------------------------------------------------------- - use FatesIOVariableKindMod, only : site_r8, site_soil_r8, site_size_pft_r8 - use FatesIOVariableKindMod, only : site_size_r8, site_pft_r8, site_age_r8 - use FatesIOVariableKindMod, only : site_coage_pft_r8, site_coage_r8 - use FatesIOVariableKindMod, only : site_height_r8, site_agefuel_r8 use FatesInterfaceTypesMod, only : hlm_use_planthydro - use FatesIOVariableKindMod, only : site_fuel_r8, site_cwdsc_r8, site_scag_r8 - use FatesIOVariableKindMod, only : site_can_r8, site_cnlf_r8, site_cnlfpft_r8 - use FatesIOVariableKindMod, only : site_cdsc_r8, site_cdpf_r8, site_cdam_r8 - use FatesIOVariableKindMod, only : site_scagpft_r8, site_agepft_r8 - use FatesIOVariableKindMod, only : site_elem_r8, site_elpft_r8, site_clscpf_r8 - use FatesIOVariableKindMod, only : site_elcwd_r8, site_elage_r8 - implicit none @@ -6327,6 +6568,7 @@ subroutine define_history_vars(this, initialize_variables) ! patch age (site_age_r8) : AP ! canopy layer (site_can_r8) : CL ! coarse woody debris size (site_cwdsc_r8) : DC + ! forest edge bin (site_edgebin_r8): EB ! element (site_elem_r8) : EL ! leaf layer : LL ! fuel class (site_fuel_r8) : FC @@ -6378,12 +6620,107 @@ subroutine define_history_vars(this, initialize_variables) avgflag='A', vtype=site_r8, hlms='CLM:ALM', upfreq=group_dyna_simple, ivar=ivar, & initialize=initialize_variables, index=ih_fracarea_plant_si) + call this%set_history_var(vname='FATES_AREA_PLANTS_AP', units='m2 m-2', & + long='area occupied by all plants per m2 land area (by patch age)', use_default='active', & + avgflag='A', vtype=site_age_r8, hlms='CLM:ALM', upfreq=group_dyna_complx, ivar=ivar, & + initialize=initialize_variables, index=ih_fracarea_plant_si_age) + call this%set_history_var(vname='FATES_AREA_TREES', units='m2 m-2', & long='area occupied by woody plants per m2 land area', use_default='active', & avgflag='A', vtype=site_r8, hlms='CLM:ALM', & upfreq=group_dyna_simple, ivar=ivar, initialize=initialize_variables, & index=ih_fracarea_trees_si) + call this%set_history_var(vname='FATES_AREA_TREES_AP', units='m2 m-2', & + long='area occupied by woody plants per m2 land area (by patch age)', use_default='active', & + avgflag='A', vtype=site_age_r8, hlms='CLM:ALM', & + upfreq=group_dyna_complx, ivar=ivar, initialize=initialize_variables, & + index=ih_fracarea_trees_si_age) + + call this%set_history_var(vname='FATES_IS_FOREST', units='', & + long='whether patch is forest', use_default='inactive', & + avgflag='A', vtype=site_r8, hlms='CLM:ALM', & + upfreq=group_dyna_simple, ivar=ivar, initialize=initialize_variables, & + index=ih_is_forest_si) + + call this%set_history_var(vname='FATES_IS_FOREST_AP', units='', & + long='whether patch is forest (by patch age)', use_default='inactive',& + avgflag='A', vtype=site_age_r8, hlms='CLM:ALM', & + upfreq=group_dyna_complx, ivar=ivar, initialize=initialize_variables, & + index=ih_is_forest_si_age) + + call this%set_history_var(vname='FATES_IS_FOREST_PCT10', units='', & + long='whether patch is forest (10% threshold)', use_default='inactive',& + avgflag='A', vtype=site_r8, hlms='CLM:ALM', & + upfreq=group_dyna_simple, ivar=ivar, initialize=initialize_variables, & + index=ih_is_forest_pct10_si) + + call this%set_history_var(vname='FATES_IS_FOREST_PCT25', units='', & + long='whether patch is forest (25% threshold)', use_default='inactive',& + avgflag='A', vtype=site_r8, hlms='CLM:ALM', & + upfreq=group_dyna_simple, ivar=ivar, initialize=initialize_variables, & + index=ih_is_forest_pct25_si) + + call this%set_history_var(vname='FATES_IS_FOREST_PCT50', units='', & + long='whether patch is forest (50% threshold)', use_default='inactive',& + avgflag='A', vtype=site_r8, hlms='CLM:ALM', & + upfreq=group_dyna_simple, ivar=ivar, initialize=initialize_variables, & + index=ih_is_forest_pct50_si) + + call this%set_history_var(vname='FATES_IS_FOREST_PCT75', units='', & + long='whether patch is forest (75% threshold)', use_default='inactive',& + avgflag='A', vtype=site_r8, hlms='CLM:ALM', & + upfreq=group_dyna_simple, ivar=ivar, initialize=initialize_variables, & + index=ih_is_forest_pct75_si) + + call this%set_history_var(vname='FATES_IS_FOREST_PCT90', units='', & + long='whether patch is forest (90% threshold)', use_default='inactive',& + avgflag='A', vtype=site_r8, hlms='CLM:ALM', & + upfreq=group_dyna_simple, ivar=ivar, initialize=initialize_variables, & + index=ih_is_forest_pct90_si) + + call this%set_history_var(vname='FATES_IS_FOREST_PCT10_0GRASS', units='', & + long='whether patch is forest (10% threshold, no grass)', use_default='inactive',& + avgflag='A', vtype=site_r8, hlms='CLM:ALM', & + upfreq=group_dyna_simple, ivar=ivar, initialize=initialize_variables, & + index=ih_is_forest_pct10_0grass_si) + + call this%set_history_var(vname='FATES_IS_FOREST_PCT25_0GRASS', units='', & + long='whether patch is forest (25% threshold, no grass)', use_default='inactive',& + avgflag='A', vtype=site_r8, hlms='CLM:ALM', & + upfreq=group_dyna_simple, ivar=ivar, initialize=initialize_variables, & + index=ih_is_forest_pct25_0grass_si) + + call this%set_history_var(vname='FATES_IS_FOREST_PCT50_0GRASS', units='', & + long='whether patch is forest (50% threshold, no grass)', use_default='inactive',& + avgflag='A', vtype=site_r8, hlms='CLM:ALM', & + upfreq=group_dyna_simple, ivar=ivar, initialize=initialize_variables, & + index=ih_is_forest_pct50_0grass_si) + + call this%set_history_var(vname='FATES_IS_FOREST_PCT75_0GRASS', units='', & + long='whether patch is forest (75% threshold, no grass)', use_default='inactive',& + avgflag='A', vtype=site_r8, hlms='CLM:ALM', & + upfreq=group_dyna_simple, ivar=ivar, initialize=initialize_variables, & + index=ih_is_forest_pct75_0grass_si) + + call this%set_history_var(vname='FATES_IS_FOREST_PCT90_0GRASS', units='', & + long='whether patch is forest (90% threshold, no grass)', use_default='inactive',& + avgflag='A', vtype=site_r8, hlms='CLM:ALM', & + upfreq=group_dyna_simple, ivar=ivar, initialize=initialize_variables, & + index=ih_is_forest_pct90_0grass_si) + + call this%set_history_var(vname='FATES_FOREST_AREA_EB', units='m2', & + long='area of forest in each edge bin', use_default='inactive', & + avgflag='A', vtype=site_edgebin_r8, hlms='CLM:ALM', & + upfreq=group_dyna_complx, ivar=ivar, initialize=initialize_variables, & + index=ih_forest_edge_bin_area_si_edge) + + call this%set_history_var(vname='FATES_FOREST_ANYAREA_EB', units='', & + long='whether edge bin has any forest in it', use_default='inactive', & + avgflag='A', vtype=site_edgebin_r8, hlms='CLM:ALM', & + upfreq=group_dyna_complx, ivar=ivar, initialize=initialize_variables, & + index=ih_forest_edge_bin_anyarea_si_edge) + call this%set_history_var(vname='FATES_FRACTION', units='m2 m-2', & long='total gridcell fraction which FATES is running over', use_default='active', & avgflag='A', vtype=site_r8, hlms='CLM:ALM', & @@ -6462,9 +6799,15 @@ subroutine define_history_vars(this, initialize_variables) avgflag='A', vtype=site_r8, hlms='CLM:ALM', & upfreq=group_dyna_simple, ivar=ivar, initialize=initialize_variables, & index=ih_nesterov_fire_danger_si) + + call this%set_history_var(vname='FATES_NESTEROV_INDEX_EB', units='', & + long='nesterov fire danger index by edge bin', use_default='active', & + avgflag='A', vtype=site_edgebin_r8, hlms='CLM:ALM', & + upfreq=group_dyna_complx, ivar=ivar, initialize=initialize_variables, & + index=ih_nesterov_fire_danger_si_edge) call this%set_history_var(vname='FATES_RX_BURN_WINDOW', units='', & - long='fraction of time when prescribed fire burn window presents', & + long='fraction of time and area in prescribed fire burn window', & use_default='active',avgflag='A', vtype=site_r8, hlms='CLM:ALM', & upfreq=1, ivar=ivar, initialize=initialize_variables, & index=ih_rx_burn_window_si) @@ -6476,30 +6819,61 @@ subroutine define_history_vars(this, initialize_variables) upfreq=group_dyna_simple, ivar=ivar, initialize=initialize_variables, & index=ih_fire_nignitions_si) + call this%set_history_var(vname='FATES_IGNITIONS_EB', & + units='m-2 s-1', & + long='number of successful fire ignitions per m2 land area per second in each forest edge bin', & + use_default='active', avgflag='A', vtype=site_edgebin_r8, hlms='CLM:ALM', & + upfreq=group_dyna_complx, ivar=ivar, initialize=initialize_variables, & + index=ih_fire_nignitions_si_edge) + call this%set_history_var(vname='FATES_FDI', units='1', & long='Fire Danger Index (probability that an ignition will lead to a fire)', & use_default='active', avgflag='A', vtype=site_r8, hlms='CLM:ALM', & upfreq=group_dyna_simple, ivar=ivar, initialize=initialize_variables, & index=ih_fire_fdi_si) + call this%set_history_var(vname='FATES_FDI_EB', units='1', & + long='Fire Danger Index (probability that an ignition will lead to a fire) in each forest edge bin', & + use_default='active', avgflag='A', vtype=site_edgebin_r8, hlms='CLM:ALM', & + upfreq=group_dyna_complx, ivar=ivar, initialize=initialize_variables, & + index=ih_fire_fdi_si_edge) + call this%set_history_var(vname='FATES_ROS', units='m s-1', & long='fire rate of spread in meters per second', & use_default='active', avgflag='A', vtype=site_r8, hlms='CLM:ALM', & upfreq=group_dyna_simple, ivar=ivar, initialize=initialize_variables, & index=ih_spitfire_ros_si) + call this%set_history_var(vname='FATES_ROS_EB', units='m s-1', & + long='fire rate of spread in meters per second in each forest edge bin', & + use_default='active', avgflag='A', vtype=site_edgebin_r8, hlms='CLM:ALM', & + upfreq=group_dyna_complx, ivar=ivar, initialize=initialize_variables, & + index=ih_spitfire_ros_si_edge) + call this%set_history_var(vname='FATES_EFFECT_WSPEED', units='m s-1', & long ='effective wind speed for fire spread in meters per second', & use_default='active', avgflag='A', vtype=site_r8, hlms='CLM:ALM', & upfreq=group_dyna_simple, ivar=ivar, initialize=initialize_variables, & index=ih_effect_wspeed_si) + call this%set_history_var(vname='FATES_EFFECT_WSPEED_EB', units='m s-1', & + long ='effective wind speed for fire spread in meters per second', & + use_default='active', avgflag='A', vtype=site_edgebin_r8, hlms='CLM:ALM', & + upfreq=group_dyna_complx, ivar=ivar, initialize=initialize_variables, & + index=ih_effect_wspeed_si_edge) + call this%set_history_var(vname='FATES_FUELCONSUMED', units='kg m-2', & long ='total fuel consumed in kg carbon per m2 land area', & use_default='active', avgflag='A', vtype=site_r8, hlms='CLM:ALM', & upfreq=group_dyna_simple, ivar=ivar, initialize=initialize_variables, & index=ih_tfc_ros_si) + call this%set_history_var(vname='FATES_FUELCONSUMED_EB', units='kg m-2', & + long ='total fuel consumed in kg carbon per m2 land area in each forest edge bin', & + use_default='active', avgflag='A', vtype=site_edgebin_r8, hlms='CLM:ALM', & + upfreq=group_dyna_complx, ivar=ivar, initialize=initialize_variables, & + index=ih_tfc_ros_si_edge) + call this%set_history_var(vname='FATES_FIRE_INTENSITY', & units='J m-1 s-1', & long='spitfire surface fireline intensity in J per m per second, sum of rx and wildfire', & @@ -6507,6 +6881,13 @@ subroutine define_history_vars(this, initialize_variables) upfreq=group_dyna_simple, ivar=ivar, initialize=initialize_variables, & index=ih_fire_intensity_si) + call this%set_history_var(vname='FATES_FIRE_INTENSITY_EB', & + units='J m-1 s-1', & + long='spitfire surface fireline intensity per forest edge bin in J per m per second, sum of rx and wildfire', & + use_default='active', avgflag='A', vtype=site_edgebin_r8, hlms='CLM:ALM', & + upfreq=group_dyna_complx, ivar=ivar, initialize=initialize_variables, & + index=ih_fire_intensity_si_edge) + call this%set_history_var(vname='FATES_FIRE_INTENSITY_BURNFRAC', & units='J m-1 s-1', & long='product of surface fire intensity and burned area fraction, sum of rx and wildfire-- divide by FATES_BURNFRAC to get area-weighted mean intensity', & @@ -6514,6 +6895,13 @@ subroutine define_history_vars(this, initialize_variables) upfreq=group_dyna_simple, ivar=ivar, initialize=initialize_variables, & index=ih_fire_intensity_fracarea_product_si) + call this%set_history_var(vname='FATES_FIRE_INTENSITY_BURNFRAC_EB', & + units='J m-1 s-1', & + long='product of surface fire intensity and burned area fraction per forest edge bin, sum of rx and wildfire-- divide by FATES_BURNFRAC_EB to get area-weighted mean intensity', & + use_default='active', avgflag='A', vtype=site_edgebin_r8, hlms='CLM:ALM', & + upfreq=group_dyna_complx, ivar=ivar, initialize=initialize_variables, & + index=ih_fire_intensity_fracarea_product_si_edge) + call this%set_history_var(vname='FATES_WILDFIRE_INTENSITY', & units='J m-1 s-1', & long='spitfire surface fireline intensity of wildfire in J per m per second', & @@ -6548,6 +6936,12 @@ subroutine define_history_vars(this, initialize_variables) upfreq=group_dyna_simple, ivar=ivar, initialize=initialize_variables, & index=ih_fire_fracarea_si) + call this%set_history_var(vname='FATES_BURNFRAC_EB', units='s-1', & + long='totaL burned area fraction per second in each forest edge bin -- sum of rxfire and wildfire burnt frac', use_default='active', & + avgflag='A', vtype=site_edgebin_r8, hlms='CLM:ALM', & + upfreq=group_dyna_complx, ivar=ivar, initialize=initialize_variables, & + index=ih_fire_fracarea_si_edge) + call this%set_history_var(vname='FATES_WILDFIRE_BURNFRAC', units='s-1', & long='burned area fraction per second by wildfire', & use_default='active', avgflag='A', vtype=site_r8, hlms='CLM:ALM', & @@ -6595,6 +6989,11 @@ subroutine define_history_vars(this, initialize_variables) avgflag='A', vtype=site_r8, hlms='CLM:ALM', upfreq=group_dyna_simple, ivar=ivar, & initialize=initialize_variables, index = ih_fire_fuel_eff_moist_si) + call this%set_history_var(vname='FATES_FUEL_EFF_MOIST_EB', units='m3 m-3', & + long='spitfire fuel moisture (volumetric) in each forest edge bin', use_default='active', & + avgflag='A', vtype=site_edgebin_r8, hlms='CLM:ALM', upfreq=group_dyna_complx, ivar=ivar, & + initialize=initialize_variables, index = ih_fire_fuel_eff_moist_si_edge) + call this%set_history_var(vname='FATES_FUEL_SAV', units='m-1', & long='spitfire fuel surface area to volume ratio', & use_default='active', avgflag='A', vtype=site_r8, hlms='CLM:ALM', & @@ -6606,6 +7005,52 @@ subroutine define_history_vars(this, initialize_variables) use_default='active', avgflag='A', vtype=site_r8, hlms='CLM:ALM', & upfreq=group_dyna_simple, ivar=ivar, initialize=initialize_variables, & index = ih_sum_fuel_si) + + call this%set_history_var(vname='FATES_FUEL_AMOUNT_EB', units='kg m-2', & + long='total ground fuel related to FATES_ROS (omits 1000hr fuels) in kg C per m2 land area, in each edge bin', & + use_default='active', avgflag='A', vtype=site_edgebin_r8, hlms='CLM:ALM', & + upfreq=group_dyna_complx, ivar=ivar, initialize=initialize_variables, & + index = ih_sum_fuel_si_edge) + + ! TODO: Remove. Useful during development but probably not needed in production. + call this%set_history_var(vname='FATES_OVP_RELHUMID24', units='%', & + long='24-hour running mean relative humidity passed in from HLM, in oldest vegetated patch', & + use_default='active', avgflag='A', vtype=site_r8, hlms='CLM:ALM', & + upfreq=group_dyna_simple, ivar=ivar, initialize=initialize_variables, & + index = ih_ovp_relhumid24_si) + + ! TODO: Remove. Useful during development but probably not needed in production. + call this%set_history_var(vname='FATES_OVP_WIND24', units='m/min', & + long='24-hour running mean wind speed passed in from HLM, in oldest vegetated patch', & + use_default='active', avgflag='A', vtype=site_r8, hlms='CLM:ALM', & + upfreq=group_dyna_simple, ivar=ivar, initialize=initialize_variables, & + index = ih_ovp_wind24_si) + + call this%set_history_var(vname='FATES_FIREWEATHER_PRECIP_EB', units='mm/day', & + long='mean precipitation for fire weather in each edge bin', & + use_default='active', avgflag='A', vtype=site_edgebin_r8, hlms='CLM:ALM', & + upfreq=group_dyna_complx, ivar=ivar, initialize=initialize_variables, & + index = ih_fireweather_precip_si_edge) + + call this%set_history_var(vname='FATES_FIREWEATHER_RH_EB', units='%', & + long='mean relative humidity for fire weather in each edge bin', & + use_default='active', avgflag='A', vtype=site_edgebin_r8, hlms='CLM:ALM', & + upfreq=group_dyna_complx, ivar=ivar, initialize=initialize_variables, & + index = ih_fireweather_rh_si_edge) + + call this%set_history_var(vname='FATES_FIREWEATHER_TEMP_EB', units='deg C', & + long='mean temperature for fire weather in each edge bin', & + use_default='active', avgflag='A', vtype=site_edgebin_r8, hlms='CLM:ALM', & + upfreq=group_dyna_complx, ivar=ivar, initialize=initialize_variables, & + index = ih_fireweather_temp_si_edge) + + call this%set_history_var(vname='FATES_FIREWEATHER_WIND_EB', units='m/min', & + long='mean wind speed for fire weather in each edge bin', & + use_default='active', avgflag='A', vtype=site_edgebin_r8, hlms='CLM:ALM', & + upfreq=group_dyna_complx, ivar=ivar, initialize=initialize_variables, & + index = ih_fireweather_wind_si_edge) + + ! Litter Variables call this%set_history_var(vname='FATES_LITTER_IN', units='kg m-2 s-1', & diff --git a/main/FatesHistoryVariableType.F90 b/main/FatesHistoryVariableType.F90 index 3b0bcc1b29..fc1772665f 100644 --- a/main/FatesHistoryVariableType.F90 +++ b/main/FatesHistoryVariableType.F90 @@ -8,6 +8,7 @@ module FatesHistoryVariableType use FatesIOVariableKindMod, only : fates_io_variable_kind_type use FatesIOVariableKindMod, only : site_r8, site_soil_r8, site_size_pft_r8 use FatesIOVariableKindMod, only : site_size_r8, site_pft_r8, site_age_r8 + use FatesIOVariableKindMod, only : site_edgebin_r8 use FatesIOVariableKindMod, only : site_coage_r8, site_coage_pft_r8 use FatesIOVariableKindMod, only : site_height_r8 use FatesIOVariableKindMod, only : site_fuel_r8, site_cwdsc_r8, site_scag_r8 @@ -153,6 +154,10 @@ subroutine Init(this, vname, units, long, use_default, & allocate(this%r82d(lb1:ub1, lb2:ub2)) this%r82d(:,:) = flushval + case(site_edgebin_r8) + allocate(this%r82d(lb1:ub1, lb2:ub2)) + this%r82d(:,:) = flushval + case(site_height_r8) allocate(this%r82d(lb1:ub1, lb2:ub2)) this%r82d(:,:) = flushval @@ -321,6 +326,8 @@ subroutine HFlush(this, thread, dim_bounds, dim_kinds) this%r82d(lb1:ub1, lb2:ub2) = this%flushval case(site_age_r8) this%r82d(lb1:ub1, lb2:ub2) = this%flushval + case(site_edgebin_r8) + this%r82d(lb1:ub1, lb2:ub2) = this%flushval case(site_height_r8) this%r82d(lb1:ub1, lb2:ub2) = this%flushval case(site_fuel_r8) diff --git a/main/FatesIODimensionsMod.F90 b/main/FatesIODimensionsMod.F90 index ed487d7eed..b618af1902 100644 --- a/main/FatesIODimensionsMod.F90 +++ b/main/FatesIODimensionsMod.F90 @@ -20,6 +20,7 @@ module FatesIODimensionsMod character(*), parameter, public :: levscls = 'fates_levscls' ! matches histFileMod character(*), parameter, public :: levpft = 'fates_levpft' ! matches histFileMod character(*), parameter, public :: levage = 'fates_levage' ! matches histFileMod + character(*), parameter, public :: levedgeforest = 'fates_levedge' ! matches histFileMod character(*), parameter, public :: levheight = 'fates_levheight' ! matches histFileMod character(*), parameter, public :: levfuel = 'fates_levfuel' ! matches histFileMod character(*), parameter, public :: levcwdsc = 'fates_levcwdsc' ! matches histFileMod @@ -64,6 +65,9 @@ module FatesIODimensionsMod ! levage = This is a structure that records the boundaries for the ! number of patch-age-class dimension + ! levedgeforest = This is a structure that records the boundaries for the + ! number of forest-edge-bin dimension + ! levheight = This is a structure that records the boundaries for the ! number of height dimension @@ -153,6 +157,8 @@ module FatesIODimensionsMod integer :: pft_class_end integer :: age_class_begin integer :: age_class_end + integer :: edgeforest_class_begin + integer :: edgeforest_class_end integer :: height_begin integer :: height_end integer :: fuel_begin diff --git a/main/FatesIOVariableKindMod.F90 b/main/FatesIOVariableKindMod.F90 index 75ea7dbe57..efd49e84f6 100644 --- a/main/FatesIOVariableKindMod.F90 +++ b/main/FatesIOVariableKindMod.F90 @@ -27,6 +27,7 @@ module FatesIOVariableKindMod character(*), parameter, public :: cohort_int = 'CO_INT' character(*), parameter, public :: site_pft_r8 = 'SI_PFT_R8' character(*), parameter, public :: site_age_r8 = 'SI_AGE_R8' + character(*), parameter, public :: site_edgebin_r8 = 'SI_EDGEBIN_R8' character(*), parameter, public :: site_height_r8 = 'SI_HEIGHT_R8' character(*), parameter, public :: site_fuel_r8 = 'SI_FUEL_R8' character(*), parameter, public :: site_cwdsc_r8 = 'SI_CWDSC_R8' diff --git a/main/FatesInterfaceMod.F90 b/main/FatesInterfaceMod.F90 index c5ce7f56aa..a791a0a0b1 100644 --- a/main/FatesInterfaceMod.F90 +++ b/main/FatesInterfaceMod.F90 @@ -43,6 +43,7 @@ module FatesInterfaceMod use FatesConstantsMod , only : n_crop_lu_types use FatesConstantsMod , only : n_term_mort_types use FatesConstantsMod , only : nocomp_bareground + use FatesInterfaceTypesMod , only : nlevedgeforest, hlm_use_tree_damage use FatesGlobals , only : fates_global_verbose use FatesGlobals , only : fates_log use FatesGlobals , only : endrun => fates_endrun @@ -53,6 +54,7 @@ module FatesInterfaceMod use EDPftvarcon , only : FatesCheckParams use EDPftvarcon , only : EDPftvarcon_inst use SFParamsMod , only : SpitFireCheckParams + use FatesEdgeForestParamsMod , only : EdgeForestCheckParams use EDParamsMod , only : FatesReportParams use EDParamsMod , only : bgc_soil_salinity use FatesPlantHydraulicsMod , only : InitHydroGlobals @@ -64,12 +66,14 @@ module FatesInterfaceMod use EDParamsMod , only : sdlng_mdd_timescale use EDParamsMod , only : ED_val_history_sizeclass_bin_edges use EDParamsMod , only : ED_val_history_ageclass_bin_edges + use FatesEdgeForestParamsMod , only : ED_val_edgeforest_bin_edges use EDParamsMod , only : ED_val_history_height_bin_edges use EDParamsMod , only : ED_val_history_coageclass_bin_edges use FatesParametersInterface , only : fates_param_reader_type use FatesParametersInterface , only : fates_parameters_type use EDParamsMod , only : FatesRegisterParams, FatesReceiveParams use SFParamsMod , only : SpitFireRegisterParams, SpitFireReceiveParams + use FatesEdgeForestParamsMod , only : EdgeForestRegisterParams, EdgeForestReceiveParams use PRTInitParamsFATESMod , only : PRTRegisterParams, PRTReceiveParams use FatesLeafBiophysParamsMod , only : LeafBiophysRegisterParams, LeafBiophysReceiveParams,LeafBiophysReportParams use FatesSynchronizedParamsMod, only : FatesSynchronizedParamsInst @@ -972,6 +976,7 @@ subroutine SetFatesGlobalElements2(use_fates) ! Identify number of size and age class bins for history output ! assume these arrays are 1-indexed nlevage = size(ED_val_history_ageclass_bin_edges,dim=1) + nlevedgeforest = size(ED_val_edgeforest_bin_edges,dim=1) nlevheight = size(ED_val_history_height_bin_edges,dim=1) nlevcoage = size(ED_val_history_coageclass_bin_edges,dim=1) nlevdamage = size(ED_val_history_damage_bin_edges, dim=1) @@ -986,6 +991,10 @@ subroutine SetFatesGlobalElements2(use_fates) write(fates_log(), *) 'age class bins specified in parameter file must start at zero' call endrun(msg=errMsg(sourcefile, __LINE__)) endif + if ( ED_val_edgeforest_bin_edges(1) .ne. 0._r8 ) then + write(fates_log(), *) 'edge forest class bins specified in parameter file must start at zero' + call endrun(msg=errMsg(sourcefile, __LINE__)) + endif if ( ED_val_history_height_bin_edges(1) .ne. 0._r8 ) then write(fates_log(), *) 'height class bins specified in parameter file must start at zero' call endrun(msg=errMsg(sourcefile, __LINE__)) @@ -1002,6 +1011,12 @@ subroutine SetFatesGlobalElements2(use_fates) call endrun(msg=errMsg(sourcefile, __LINE__)) end if end do + do i = 2,nlevedgeforest + if ( (ED_val_edgeforest_bin_edges(i) - ED_val_edgeforest_bin_edges(i-1)) .le. 0._r8) then + write(fates_log(), *) 'edge forest class bins specified in parameter file must be monotonically increasing' + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if + end do do i = 2,nlevheight if ( (ED_val_history_height_bin_edges(i) - ED_val_history_height_bin_edges(i-1)) .le. 0._r8) then write(fates_log(), *) 'height class bins specified in parameter file must be monotonically increasing' @@ -1014,7 +1029,7 @@ subroutine SetFatesGlobalElements2(use_fates) call endrun(msg=errMsg(sourcefile, __LINE__)) end if end do - + ! Set the fates dispersal kernel mode if there are any seed dispersal parameters set. ! The validation of the parameter values is check in FatesCheckParams prior to this check. ! This is currently hard coded, but could be added as a fates parameter file option, @@ -1160,6 +1175,7 @@ subroutine fates_history_maps use EDParamsMod, only : nlevleaf use EDParamsMod, only : ED_val_history_sizeclass_bin_edges use EDParamsMod, only : ED_val_history_ageclass_bin_edges + use FatesEdgeForestParamsMod, only : ED_val_edgeforest_bin_edges use EDParamsMod, only : ED_val_history_height_bin_edges use EDParamsMod, only : ED_val_history_coageclass_bin_edges @@ -1193,6 +1209,7 @@ subroutine fates_history_maps allocate( fates_hdim_levfuel(1:num_fuel_classes )) allocate( fates_hdim_levcwdsc(1:NCWD )) allocate( fates_hdim_levage(1:nlevage )) + allocate( fates_hdim_levedge(1:nlevedgeforest )) allocate( fates_hdim_levheight(1:nlevheight )) allocate( fates_hdim_levcoage(1:nlevcoage )) allocate( fates_hdim_pfmap_levcapf(1:nlevcoage*numpft)) @@ -1233,6 +1250,7 @@ subroutine fates_history_maps ! Fill the IO array of plant size classes fates_hdim_levsclass(:) = ED_val_history_sizeclass_bin_edges(:) fates_hdim_levage(:) = ED_val_history_ageclass_bin_edges(:) + fates_hdim_levedge(:) = ED_val_edgeforest_bin_edges(:) fates_hdim_levheight(:) = ED_val_history_height_bin_edges(:) fates_hdim_levcoage(:) = ED_val_history_coageclass_bin_edges(:) fates_hdim_levleaf(:) = dlower_vai(:) @@ -1491,6 +1509,7 @@ subroutine set_fates_ctrlparms(tag,ival,rval,cval) hlm_decomp = 'unset' hlm_nitrogen_spec = unset_int hlm_use_tree_damage = unset_int + hlm_use_edge_forest = unset_int hlm_phosphorus_spec = unset_int hlm_use_ch4 = unset_int hlm_use_vertsoilc = unset_int @@ -1688,15 +1707,16 @@ subroutine set_fates_ctrlparms(tag,ival,rval,cval) if(hlm_use_tree_damage .eq. unset_int) then write(fates_log(),*) 'FATES dimension/parameter unset: hlm_use_tree_damage, exiting' call endrun(msg=errMsg(sourcefile, __LINE__)) - else - if((hlm_use_tree_damage .eq. itrue) .and. & + else if ((hlm_use_tree_damage .eq. itrue) .and. & (hlm_parteh_mode .eq. prt_cnp_flex_allom_hyp))then - write(fates_log(),*) 'FATES tree damage (use_fates_tree_damage = .true.) is not' - write(fates_log(),*) '(yet) compatible with CNP allocation (fates_parteh_mode = 2)' - call endrun(msg=errMsg(sourcefile, __LINE__)) + write(fates_log(),*) 'FATES tree damage (use_fates_tree_damage = .true.) is not' + write(fates_log(),*) '(yet) compatible with CNP allocation (fates_parteh_mode = 2)' + call endrun(msg=errMsg(sourcefile, __LINE__)) end if - + if(hlm_use_edge_forest .eq. unset_int) then + write(fates_log(),*) 'FATES dimension/parameter unset: hlm_use_edge_forest, exiting' + call endrun(msg=errMsg(sourcefile, __LINE__)) end if if(hlm_nitrogen_spec .eq. unset_int) then @@ -1923,6 +1943,12 @@ subroutine set_fates_ctrlparms(tag,ival,rval,cval) if (fates_global_verbose()) then write(fates_log(),*) 'Transfering hlm_use_tree_damage = ',ival,' to FATES' end if + + case('use_edge_forest') + hlm_use_edge_forest = ival + if (fates_global_verbose()) then + write(fates_log(),*) 'Transfering hlm_use_edge_forest = ',ival,' to FATES' + end if case('nitrogen_spec') hlm_nitrogen_spec = ival @@ -2250,6 +2276,7 @@ subroutine FatesReportParameters(masterproc) call FatesCheckParams(masterproc) ! Check general fates parameters call PRTCheckParams(masterproc) ! Check PARTEH parameters call SpitFireCheckParams(masterproc) + call EdgeForestCheckParams(masterproc) call TransferRadParams() @@ -2686,6 +2713,7 @@ subroutine FatesReadParameters(param_reader) call fates_params%Init() ! fates_params class, in FatesParameterInterfaceMod call FatesRegisterParams(fates_params) !EDParamsMod, only operates on fates_params class call SpitFireRegisterParams(fates_params) !SpitFire Mod, only operates of fates_params class + call EdgeForestRegisterParams(fates_params) !EdgeForest Mod, only operates on fates_params class call PRTRegisterParams(fates_params) ! PRT mod, only operates on fates_params class call LeafBiophysRegisterParams(fates_params) call FatesSynchronizedParamsInst%RegisterParams(fates_params) !Synchronized params class in Synchronized params mod, only operates on fates_params class @@ -2694,6 +2722,7 @@ subroutine FatesReadParameters(param_reader) call FatesReceiveParams(fates_params) call SpitFireReceiveParams(fates_params) + call EdgeForestReceiveParams(fates_params) call PRTReceiveParams(fates_params) call LeafBiophysReceiveParams(fates_params) call FatesSynchronizedParamsInst%ReceiveParams(fates_params) diff --git a/main/FatesInterfaceTypesMod.F90 b/main/FatesInterfaceTypesMod.F90 index fabddbec1c..8fb998a656 100644 --- a/main/FatesInterfaceTypesMod.F90 +++ b/main/FatesInterfaceTypesMod.F90 @@ -160,6 +160,9 @@ module FatesInterfaceTypesMod integer, public :: hlm_use_tree_damage ! This flag signals whether or not to turn on the ! tree damage module + integer, public :: hlm_use_edge_forest ! This flag signals whether or not to turn on the + ! edge forest module + integer, public :: hlm_hydr_solver ! Switch that defines which hydraulic solver to use ! 1 = Taylor solution that solves plant fluxes with 1 layer ! sequentially placing solution on top of previous layer solves @@ -299,6 +302,7 @@ module FatesInterfaceTypesMod integer , public, allocatable :: fates_hdim_pfmap_levscpf(:) ! map of pfts into size-class x pft dimension integer , public, allocatable :: fates_hdim_scmap_levscpf(:) ! map of size-class into size-class x pft dimension real(r8), public, allocatable :: fates_hdim_levage(:) ! patch age lower bound dimension + real(r8), public, allocatable :: fates_hdim_levedge(:) ! edge forest bin lower bound dimension real(r8), public, allocatable :: fates_hdim_levheight(:) ! height lower bound dimension integer , public, allocatable :: fates_hdim_levpft(:) ! plant pft dimension integer , public, allocatable :: fates_hdim_levlanduse(:) ! land use label dimension @@ -373,6 +377,7 @@ module FatesInterfaceTypesMod integer, public :: nlevcoage ! The total number of cohort age bins output to history integer, public :: nleafage ! The total number of leaf age classes integer, public :: nlevdamage ! The total number of damage classes + integer, public :: nlevedgeforest ! The total number of forest edge bins (incl. deep forest) ! ------------------------------------------------------------------------------------- ! Structured Boundary Conditions (SITE/PATCH SCALE) diff --git a/main/FatesInventoryInitMod.F90 b/main/FatesInventoryInitMod.F90 index 6673f4b819..87f6c497a8 100644 --- a/main/FatesInventoryInitMod.F90 +++ b/main/FatesInventoryInitMod.F90 @@ -284,7 +284,7 @@ subroutine initialize_sites_by_inventory(nsites,sites,bc_in) allocate(newpatch) call newpatch%Create(age_init, area_init, primaryland, & fates_unset_int, num_swb, numpft, sites(s)%nlevsoil, & - hlm_current_tod, hlm_regeneration_model) + hlm_current_tod, hlm_regeneration_model, sites(s)%youngest_patch) newpatch%patchno = ipa newpatch%younger => null() diff --git a/main/FatesParametersInterface.F90 b/main/FatesParametersInterface.F90 index feebf503b7..be33cb812c 100644 --- a/main/FatesParametersInterface.F90 +++ b/main/FatesParametersInterface.F90 @@ -33,6 +33,7 @@ module FatesParametersInterface character(len=*), parameter, public :: dimension_name_leaf_age = 'fates_leafage_class' character(len=*), parameter, public :: dimension_name_history_size_bins = 'fates_history_size_bins' character(len=*), parameter, public :: dimension_name_history_age_bins = 'fates_history_age_bins' + character(len=*), parameter, public :: dimension_name_edgeforest_bins = 'fates_edgeforest_bins' character(len=*), parameter, public :: dimension_name_history_height_bins = 'fates_history_height_bins' character(len=*), parameter, public :: dimension_name_history_coage_bins = 'fates_history_coage_bins' character(len=*), parameter, public :: dimension_name_hlm_pftno = 'fates_hlm_pftno' diff --git a/main/FatesRestartInterfaceMod.F90 b/main/FatesRestartInterfaceMod.F90 index 2a1ec24b36..3c44417ded 100644 --- a/main/FatesRestartInterfaceMod.F90 +++ b/main/FatesRestartInterfaceMod.F90 @@ -104,7 +104,6 @@ module FatesRestartInterfaceMod integer :: ir_cndaysleafon_si integer :: ir_cndaysleafoff_si integer :: ir_phenmodeldate_si - integer :: ir_fireweather_index_si integer :: ir_gdd_si integer :: ir_min_allowed_landuse_fraction_si integer :: ir_landuse_vector_gt_min_si @@ -159,6 +158,7 @@ module FatesRestartInterfaceMod integer :: ir_nclp_pa integer :: ir_zstar_pa + integer :: ir_fireweather_index_pa !Logging integer :: ir_lmort_direct_co @@ -740,9 +740,9 @@ subroutine define_restart_vars(this, initialize_variables) long_name='integer model day used for phen timing', units='absolute integer day', flushval = flushinvalid, & hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_phenmodeldate_si ) - call this%set_restart_var(vname='fates_acc_nesterov_id', vtype=site_r8, & + call this%set_restart_var(vname='fates_acc_nesterov_id', vtype=cohort_r8, & long_name='a nesterov index accumulator', units='unitless', flushval = flushzero, & - hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_fireweather_index_si ) + hlms='CLM:ALM', initialize=initialize_variables, ivar=ivar, index = ir_fireweather_index_pa ) call this%set_restart_var(vname='fates_gdd_site', vtype=site_r8, & long_name='growing degree days at each site', units='degC days', flushval = flushzero, & @@ -2261,7 +2261,7 @@ subroutine set_restart_vectors(this,nc,nsites,sites) rio_cndaysleafon_si => this%rvars(ir_cndaysleafon_si)%int1d, & rio_cndaysleafoff_si => this%rvars(ir_cndaysleafoff_si)%int1d, & rio_phenmodeldate_si => this%rvars(ir_phenmodeldate_si)%int1d, & - rio_fireweather_index_si => this%rvars(ir_fireweather_index_si)%r81d, & + rio_fireweather_index_pa => this%rvars(ir_fireweather_index_pa)%r81d, & rio_gdd_si => this%rvars(ir_gdd_si)%r81d, & rio_min_allowed_landuse_fraction_si => this%rvars(ir_min_allowed_landuse_fraction_si)%r81d, & rio_landuse_vector_gt_min_si => this%rvars(ir_landuse_vector_gt_min_si)%int1d, & @@ -2738,6 +2738,7 @@ subroutine set_restart_vectors(this,nc,nsites,sites) rio_agesinceanthrodist_pa(io_idx_co_1st) = cpatch%age_since_anthro_disturbance rio_nocomp_pft_label_pa(io_idx_co_1st)= cpatch%nocomp_pft_label rio_area_pa(io_idx_co_1st) = cpatch%area + rio_fireweather_index_pa(io_idx_co_1st) = cpatch%fireWeather%fire_weather_index ! Patch level running means call this%SetRMeanRestartVar(cpatch%tveg24, ir_tveg24_pa, io_idx_co_1st) @@ -2940,7 +2941,6 @@ subroutine set_restart_vectors(this,nc,nsites,sites) rio_solar_zenith_angle(io_idx_si) = sites(s)%coszen - rio_fireweather_index_si(io_idx_si) = sites(s)%fireWeather%fire_weather_index rio_snow_depth_si(io_idx_si) = sites(s)%snow_depth ! land use flag @@ -3307,7 +3307,7 @@ subroutine get_restart_vectors(this, nc, nsites, sites) rio_cndaysleafon_si => this%rvars(ir_cndaysleafon_si)%int1d, & rio_cndaysleafoff_si => this%rvars(ir_cndaysleafoff_si)%int1d, & rio_phenmodeldate_si => this%rvars(ir_phenmodeldate_si)%int1d, & - rio_fireweather_index_si => this%rvars(ir_fireweather_index_si)%r81d, & + rio_fireweather_index_pa => this%rvars(ir_fireweather_index_pa)%r81d, & rio_gdd_si => this%rvars(ir_gdd_si)%r81d, & rio_min_allowed_landuse_fraction_si => this%rvars(ir_min_allowed_landuse_fraction_si)%r81d, & rio_landuse_vector_gt_min_si => this%rvars(ir_landuse_vector_gt_min_si)%int1d, & @@ -3767,6 +3767,7 @@ subroutine get_restart_vectors(this, nc, nsites, sites) cpatch%area = rio_area_pa(io_idx_co_1st) cpatch%age_class = get_age_class_index(cpatch%age) cpatch%fcansno = rio_fcansno_pa(io_idx_co_1st) + cpatch%fireWeather%fire_weather_index = rio_fireweather_index_pa(io_idx_co_1st) ! Set zenith angle info @@ -4021,7 +4022,6 @@ subroutine get_restart_vectors(this, nc, nsites, sites) sites(s)%coszen = rio_solar_zenith_angle(io_idx_si) - sites(s)%fireWeather%fire_weather_index = rio_fireweather_index_si(io_idx_si) sites(s)%snow_depth = rio_snow_depth_si(io_idx_si) ! if needed, trigger the special procedure to initialize land use structure from a diff --git a/main/FatesUtilsMod.F90 b/main/FatesUtilsMod.F90 index 03537bd226..7067c86bbf 100644 --- a/main/FatesUtilsMod.F90 +++ b/main/FatesUtilsMod.F90 @@ -6,6 +6,7 @@ module FatesUtilsMod use FatesConstantsMod, only : r8 => fates_r8 use FatesGlobals, only : fates_log use FatesConstantsMod, only : nearzero + use FatesConstantsMod, only : fates_check_param_set use FatesGlobals, only : endrun => fates_endrun use shr_log_mod , only : errMsg => shr_log_errMsg @@ -21,6 +22,8 @@ module FatesUtilsMod public :: QuadraticRootsNSWC public :: QuadraticRootsSridharachary public :: ArrayNint + public :: is_param_set + public :: logical_to_real character(len=*), parameter, private :: sourcefile = & __FILE__ @@ -299,5 +302,24 @@ subroutine QuadraticRootsSridharachary(a,b,c,root1,root2,err) end subroutine QuadraticRootsSridharachary + function is_param_set(param) + use shr_infnan_mod, only : isnan => shr_infnan_isnan + + real(r8), intent(in) :: param + + logical :: is_param_set + + is_param_set = .not. isnan(param) + if (is_param_set) then + is_param_set = param < fates_check_param_set + end if + end function is_param_set + + function logical_to_real(logical_in) result(real_out) + logical, intent(in) :: logical_in + real(r8) :: real_out + real_out = merge(1._r8, 0._r8, logical_in) + end function logical_to_real + ! ====================================================================================== end module FatesUtilsMod diff --git a/main/test/CMakeLists.txt b/main/test/CMakeLists.txt new file mode 100644 index 0000000000..72d2b9fc61 --- /dev/null +++ b/main/test/CMakeLists.txt @@ -0,0 +1 @@ +add_subdirectory(edge_forest_test) diff --git a/parameter_files/fates_params_default.cdl b/parameter_files/fates_params_default.cdl index e899d3ff7b..c131a1ab21 100644 --- a/parameter_files/fates_params_default.cdl +++ b/parameter_files/fates_params_default.cdl @@ -1,6 +1,7 @@ netcdf fates_params_default { dimensions: fates_NCWD = 4 ; + fates_edgeforest_bins = 6 ; fates_history_age_bins = 7 ; fates_history_coage_bins = 2 ; fates_history_damage_bins = 2 ; @@ -258,6 +259,66 @@ variables: double fates_dev_arbitrary_pft(fates_pft) ; fates_dev_arbitrary_pft:units = "unknown" ; fates_dev_arbitrary_pft:long_name = "Unassociated pft dimensioned free parameter that developers can use for testing arbitrary new hypotheses" ; + double fates_edgeforest_bin_edges(fates_edgeforest_bins) ; + fates_edgeforest_bin_edges:units = "m" ; + fates_edgeforest_bin_edges:long_name = "Boundaries of forest edge bins (for each bin, include value closest to zero)" ; + double fates_edgeforest_gaussian_amplitude(fates_edgeforest_bins) ; + fates_edgeforest_gaussian_amplitude:units = "unitless" ; + fates_edgeforest_gaussian_amplitude:long_name = "Amplitudes for calculating forest area in each edge bin (gaussian fit)" ; + double fates_edgeforest_gaussian_sigma(fates_edgeforest_bins) ; + fates_edgeforest_gaussian_sigma:units = "unitless" ; + fates_edgeforest_gaussian_sigma:long_name = "Sigmas for calculating forest area in each edge bin (gaussian fit)" ; + double fates_edgeforest_gaussian_center(fates_edgeforest_bins) ; + fates_edgeforest_gaussian_center:units = "unitless" ; + fates_edgeforest_gaussian_center:long_name = "Centers for calculating forest area in each edge bin (gaussian fit)" ; + double fates_edgeforest_lognormal_amplitude(fates_edgeforest_bins) ; + fates_edgeforest_lognormal_amplitude:units = "unitless" ; + fates_edgeforest_lognormal_amplitude:long_name = "Amplitudes for calculating forest area in each edge bin (lognormal fit)" ; + double fates_edgeforest_lognormal_sigma(fates_edgeforest_bins) ; + fates_edgeforest_lognormal_sigma:units = "unitless" ; + fates_edgeforest_lognormal_sigma:long_name = "Sigmas for calculating forest area in each edge bin (lognormal fit)" ; + double fates_edgeforest_lognormal_center(fates_edgeforest_bins) ; + fates_edgeforest_lognormal_center:units = "unitless" ; + fates_edgeforest_lognormal_center:long_name = "Centers for calculating forest area in each edge bin (lognormal fit)" ; + double fates_edgeforest_quadratic_a(fates_edgeforest_bins) ; + fates_edgeforest_quadratic_a:units = "unitless" ; + fates_edgeforest_quadratic_a:long_name = "x^2 coefficient for calculating forest area in each edge bin (quadratic fit)" ; + double fates_edgeforest_quadratic_b(fates_edgeforest_bins) ; + fates_edgeforest_quadratic_b:units = "unitless" ; + fates_edgeforest_quadratic_b:long_name = "x^1 coefficient for calculating forest area in each edge bin (quadratic fit)" ; + double fates_edgeforest_quadratic_c(fates_edgeforest_bins) ; + fates_edgeforest_quadratic_c:units = "unitless" ; + fates_edgeforest_quadratic_c:long_name = "x^0 coefficient for calculating forest area in each edge bin (quadratic fit)" ; + double fates_edgeforest_fireweather_rh_mult(fates_edgeforest_bins) ; + fates_edgeforest_fireweather_rh_mult:units = "unitless" ; + fates_edgeforest_fireweather_rh_mult:long_name = "Factor multiplied onto + relative humidity (for fire weather only) in each edge forest bin. Applied before additive factor + fates_edgeforest_fireweather_rh_add." ; + double fates_edgeforest_fireweather_temp_C_mult(fates_edgeforest_bins) ; + fates_edgeforest_fireweather_temp_C_mult:units = "unitless" ; + fates_edgeforest_fireweather_temp_C_mult:long_name = "Factor multiplied onto + temperature (for fire weather only) in each edge forest bin. Applied before additive factor + fates_edgeforest_fireweather_temp_C_add." ; + double fates_edgeforest_fireweather_wind_mult(fates_edgeforest_bins) ; + fates_edgeforest_fireweather_wind_mult:units = "unitless" ; + fates_edgeforest_fireweather_wind_mult:long_name = "Factor multiplied onto + wind speed (for fire weather only) in each edge forest bin. Applied before additive factor + fates_edgeforest_fireweather_wind_add." ; + double fates_edgeforest_fireweather_rh_add(fates_edgeforest_bins) ; + fates_edgeforest_fireweather_rh_add:units = "%" ; + fates_edgeforest_fireweather_rh_add:long_name = "Factor added to + relative humidity (for fire weather only) in each edge forest bin. Applied after multiplicative + factor fates_edgeforest_fireweather_rh_mult." ; + double fates_edgeforest_fireweather_temp_C_add(fates_edgeforest_bins) ; + fates_edgeforest_fireweather_temp_C_add:units = "degrees C" ; + fates_edgeforest_fireweather_temp_C_add:long_name = "Factor added to + temperature (for fire weather only) in each edge forest bin. Applied after multiplicative + factor fates_edgeforest_fireweather_temp_C_mult." ; + double fates_edgeforest_fireweather_wind_add(fates_edgeforest_bins) ; + fates_edgeforest_fireweather_wind_add:units = "m/min" ; + fates_edgeforest_fireweather_wind_add:long_name = "Factor added to + wind speed (for fire weather only) in each edge forest bin. Applied after multiplicative + factor fates_edgeforest_fireweather_wind_mult." ; double fates_fire_alpha_SH(fates_pft) ; fates_fire_alpha_SH:units = "m / (kw/m)**(2/3)" ; fates_fire_alpha_SH:long_name = "spitfire parameter, alpha scorch height, Equation 16 Thonicke et al 2010" ; @@ -783,6 +844,9 @@ variables: double fates_fire_threshold ; fates_fire_threshold:units = "kW/m" ; fates_fire_threshold:long_name = "spitfire parameter, fire intensity threshold for tracking fires that spread" ; + double fates_forest_tree_fraction_threshold ; + fates_forest_tree_fraction_threshold:units = "m2/m2" ; + fates_forest_tree_fraction_threshold:long_name = "Tree fraction above which patch is considered 'forest'" ; double fates_frag_cwd_fcel ; fates_frag_cwd_fcel:units = "unitless" ; fates_frag_cwd_fcel:long_name = "Cellulose fraction for CWD" ; @@ -1205,6 +1269,38 @@ data: fates_dev_arbitrary_pft = _, _, _, _, _, _, _, _, _, _, _, _, _, _ ; + fates_edgeforest_gaussian_amplitude = 0.37033665947126704, 0.25548576693720165, _, _, _, _ ; + + fates_edgeforest_gaussian_sigma = 0.4329573815987602, 0.42239011110175917, _, _, _, _ ; + + fates_edgeforest_gaussian_center = -0.35596450526414164, -0.28183332150023604, _, _, _, _ ; + + fates_edgeforest_lognormal_amplitude = _, _, _, _, _, 14.283227336273354 ; + + fates_edgeforest_lognormal_sigma = _, _, _, _, _, 1.26210031507715 ; + + fates_edgeforest_lognormal_center = _, _, _, _, _, 2.1958393621871597 ; + + fates_edgeforest_quadratic_a = _, _, 0.2549551300197741, 0.07685044819893726, 0.035189070666016925, _ ; + + fates_edgeforest_quadratic_b = _, _, -0.5457222474679617, -0.19438641157435982, -0.300528731650077, _ ; + + fates_edgeforest_quadratic_c = _, _, 0.29299184857665717, 0.11825507562859365, 0.2669694066063096, _ ; + + fates_edgeforest_fireweather_rh_mult = 1, 1, 1, 1, 1, 1 ; + + fates_edgeforest_fireweather_temp_C_mult = 1, 1, 1, 1, 1, 1 ; + + fates_edgeforest_fireweather_wind_mult = 1, 1, 1, 1, 1, 1 ; + + fates_edgeforest_fireweather_rh_add = 0, 0, 0, 0, 0, 0 ; + + fates_edgeforest_fireweather_temp_C_add = 0, 0, 0, 0, 0, 0 ; + + fates_edgeforest_fireweather_wind_add = 0, 0, 0, 0, 0, 0 ; + + fates_edgeforest_bin_edges = 0, 30, 60, 120, 150, 300 ; + fates_fire_alpha_SH = 0.2, 0.2, 0.2, 0.2, 0.2, 0.2, 0.2, 0.2, 0.2, 0.2, 0.2, 0.2, 0.2, 0.2 ; @@ -1784,6 +1880,8 @@ data: fates_fire_threshold = 50 ; + fates_forest_tree_fraction_threshold = 0.5 ; + fates_frag_cwd_fcel = 0.76 ; fates_frag_cwd_flig = 0.24 ; diff --git a/parameter_files/fates_params_edgeflam.cdl b/parameter_files/fates_params_edgeflam.cdl new file mode 100644 index 0000000000..1764bcf9f9 --- /dev/null +++ b/parameter_files/fates_params_edgeflam.cdl @@ -0,0 +1,1992 @@ +netcdf fates_params_default { +dimensions: + fates_NCWD = 4 ; + fates_edgeforest_bins = 6 ; + fates_history_age_bins = 7 ; + fates_history_coage_bins = 2 ; + fates_history_damage_bins = 2 ; + fates_history_height_bins = 6 ; + fates_history_size_bins = 13 ; + fates_hlm_pftno = 14 ; + fates_hydr_organs = 4 ; + fates_landuseclass = 5 ; + fates_leafage_class = 1 ; + fates_litterclass = 6 ; + fates_pft = 14 ; + fates_plant_organs = 4 ; + fates_string_length = 60 ; +variables: + double fates_history_ageclass_bin_edges(fates_history_age_bins) ; + fates_history_ageclass_bin_edges:units = "yr" ; + fates_history_ageclass_bin_edges:long_name = "Lower edges for age class bins used in age-resolved patch history output" ; + double fates_history_coageclass_bin_edges(fates_history_coage_bins) ; + fates_history_coageclass_bin_edges:units = "years" ; + fates_history_coageclass_bin_edges:long_name = "Lower edges for cohort age class bins used in cohort age resolved history output" ; + double fates_history_height_bin_edges(fates_history_height_bins) ; + fates_history_height_bin_edges:units = "m" ; + fates_history_height_bin_edges:long_name = "Lower edges for height bins used in height-resolved history output" ; + double fates_history_damage_bin_edges(fates_history_damage_bins) ; + fates_history_damage_bin_edges:units = "% crown loss" ; + fates_history_damage_bin_edges:long_name = "Lower edges for damage class bins used in cohort history output" ; + double fates_history_sizeclass_bin_edges(fates_history_size_bins) ; + fates_history_sizeclass_bin_edges:units = "cm" ; + fates_history_sizeclass_bin_edges:long_name = "Lower edges for DBH size class bins used in size-resolved cohort history output" ; + double fates_alloc_organ_id(fates_plant_organs) ; + fates_alloc_organ_id:units = "unitless" ; + fates_alloc_organ_id:long_name = "This is the global index that the organ in this file is associated with, values match those in parteh/PRTGenericMod.F90" ; + double fates_hydro_htftype_node(fates_hydr_organs) ; + fates_hydro_htftype_node:units = "unitless" ; + fates_hydro_htftype_node:long_name = "Switch that defines the hydraulic transfer functions for each organ." ; + char fates_pftname(fates_pft, fates_string_length) ; + fates_pftname:units = "unitless - string" ; + fates_pftname:long_name = "Description of plant type" ; + char fates_hydro_organ_name(fates_hydr_organs, fates_string_length) ; + fates_hydro_organ_name:units = "unitless - string" ; + fates_hydro_organ_name:long_name = "Name of plant hydraulics organs (DONT CHANGE, order matches media list in FatesHydraulicsMemMod.F90)" ; + char fates_alloc_organ_name(fates_plant_organs, fates_string_length) ; + fates_alloc_organ_name:units = "unitless - string" ; + fates_alloc_organ_name:long_name = "Name of plant organs (with alloc_organ_id, must match PRTGenericMod.F90)" ; + char fates_landuseclass_name(fates_landuseclass, fates_string_length) ; + fates_landuseclass_name:units = "unitless - string" ; + fates_landuseclass_name:long_name = "Name of the land use classes, for variables associated with dimension fates_landuseclass" ; + char fates_litterclass_name(fates_litterclass, fates_string_length) ; + fates_litterclass_name:units = "unitless - string" ; + fates_litterclass_name:long_name = "Name of the litter classes, for variables associated with dimension fates_litterclass" ; + double fates_alloc_organ_priority(fates_plant_organs, fates_pft) ; + fates_alloc_organ_priority:units = "index" ; + fates_alloc_organ_priority:long_name = "Priority level for allocation, 1: replaces turnover from storage, 2: same priority as storage use/replacement, 3: ascending in order of least importance" ; + double fates_alloc_storage_cushion(fates_pft) ; + fates_alloc_storage_cushion:units = "fraction" ; + fates_alloc_storage_cushion:long_name = "maximum size of storage C pool, relative to maximum size of leaf C pool" ; + double fates_alloc_store_priority_frac(fates_pft) ; + fates_alloc_store_priority_frac:units = "unitless" ; + fates_alloc_store_priority_frac:long_name = "for high-priority organs, the fraction of their turnover demand that is gauranteed to be replaced, and if need-be by storage" ; + double fates_allom_agb1(fates_pft) ; + fates_allom_agb1:units = "variable" ; + fates_allom_agb1:long_name = "Parameter 1 for agb allometry" ; + double fates_allom_agb2(fates_pft) ; + fates_allom_agb2:units = "variable" ; + fates_allom_agb2:long_name = "Parameter 2 for agb allometry" ; + double fates_allom_agb3(fates_pft) ; + fates_allom_agb3:units = "variable" ; + fates_allom_agb3:long_name = "Parameter 3 for agb allometry" ; + double fates_allom_agb4(fates_pft) ; + fates_allom_agb4:units = "variable" ; + fates_allom_agb4:long_name = "Parameter 4 for agb allometry" ; + double fates_allom_agb_frac(fates_pft) ; + fates_allom_agb_frac:units = "fraction" ; + fates_allom_agb_frac:long_name = "Fraction of woody biomass that is above ground" ; + double fates_allom_amode(fates_pft) ; + fates_allom_amode:units = "index" ; + fates_allom_amode:long_name = "AGB allometry function index." ; + double fates_allom_blca_expnt_diff(fates_pft) ; + fates_allom_blca_expnt_diff:units = "unitless" ; + fates_allom_blca_expnt_diff:long_name = "difference between allometric DBH:bleaf and DBH:crown area exponents" ; + double fates_allom_cmode(fates_pft) ; + fates_allom_cmode:units = "index" ; + fates_allom_cmode:long_name = "coarse root biomass allometry function index." ; + double fates_allom_d2bl1(fates_pft) ; + fates_allom_d2bl1:units = "variable" ; + fates_allom_d2bl1:long_name = "Parameter 1 for d2bl allometry" ; + double fates_allom_d2bl2(fates_pft) ; + fates_allom_d2bl2:units = "variable" ; + fates_allom_d2bl2:long_name = "Parameter 2 for d2bl allometry" ; + double fates_allom_d2bl3(fates_pft) ; + fates_allom_d2bl3:units = "unitless" ; + fates_allom_d2bl3:long_name = "Parameter 3 for d2bl allometry" ; + double fates_allom_d2ca_coefficient_max(fates_pft) ; + fates_allom_d2ca_coefficient_max:units = "m2 cm^(-1/beta)" ; + fates_allom_d2ca_coefficient_max:long_name = "max (savanna) dbh to area multiplier factor where: area = n*d2ca_coeff*dbh^beta" ; + double fates_allom_d2ca_coefficient_min(fates_pft) ; + fates_allom_d2ca_coefficient_min:units = "m2 cm^(-1/beta)" ; + fates_allom_d2ca_coefficient_min:long_name = "min (forest) dbh to area multiplier factor where: area = n*d2ca_coeff*dbh^beta" ; + double fates_allom_d2h1(fates_pft) ; + fates_allom_d2h1:units = "variable" ; + fates_allom_d2h1:long_name = "Parameter 1 for d2h allometry (intercept, or c)" ; + double fates_allom_d2h2(fates_pft) ; + fates_allom_d2h2:units = "variable" ; + fates_allom_d2h2:long_name = "Parameter 2 for d2h allometry (slope, or m)" ; + double fates_allom_d2h3(fates_pft) ; + fates_allom_d2h3:units = "variable" ; + fates_allom_d2h3:long_name = "Parameter 3 for d2h allometry (optional)" ; + double fates_allom_dbh_maxheight(fates_pft) ; + fates_allom_dbh_maxheight:units = "cm" ; + fates_allom_dbh_maxheight:long_name = "the diameter (if any) corresponding to maximum height, diameters may increase beyond this" ; + double fates_allom_dmode(fates_pft) ; + fates_allom_dmode:units = "index" ; + fates_allom_dmode:long_name = "crown depth allometry function index" ; + double fates_allom_fmode(fates_pft) ; + fates_allom_fmode:units = "index" ; + fates_allom_fmode:long_name = "fine root biomass allometry function index." ; + double fates_allom_fnrt_prof_a(fates_pft) ; + fates_allom_fnrt_prof_a:units = "unitless" ; + fates_allom_fnrt_prof_a:long_name = "Fine root profile function, parameter a" ; + double fates_allom_fnrt_prof_b(fates_pft) ; + fates_allom_fnrt_prof_b:units = "unitless" ; + fates_allom_fnrt_prof_b:long_name = "Fine root profile function, parameter b" ; + double fates_allom_fnrt_prof_mode(fates_pft) ; + fates_allom_fnrt_prof_mode:units = "index" ; + fates_allom_fnrt_prof_mode:long_name = "Index to select fine root profile function: 1) Jackson Beta, 2) 1-param exponential 3) 2-param exponential" ; + double fates_allom_frbstor_repro(fates_pft) ; + fates_allom_frbstor_repro:units = "fraction" ; + fates_allom_frbstor_repro:long_name = "fraction of bstore goes to reproduction after plant dies" ; + double fates_allom_h2cd1(fates_pft) ; + fates_allom_h2cd1:units = "variable" ; + fates_allom_h2cd1:long_name = "Parameter 1 for h2cd allometry (exp(log-intercept) or scaling). If allom_dmode=1; this is the same as former crown_depth_frac parameter" ; + double fates_allom_h2cd2(fates_pft) ; + fates_allom_h2cd2:units = "variable" ; + fates_allom_h2cd2:long_name = "Parameter 2 for h2cd allometry (log-slope or exponent). If allom_dmode=1; this is not needed (as exponent is assumed 1)" ; + double fates_allom_hmode(fates_pft) ; + fates_allom_hmode:units = "index" ; + fates_allom_hmode:long_name = "height allometry function index." ; + double fates_allom_l2fr(fates_pft) ; + fates_allom_l2fr:units = "gC/gC" ; + fates_allom_l2fr:long_name = "Allocation parameter: fine root C per leaf C" ; + double fates_allom_la_per_sa_int(fates_pft) ; + fates_allom_la_per_sa_int:units = "m2/cm2" ; + fates_allom_la_per_sa_int:long_name = "Leaf area per sapwood area, intercept" ; + double fates_allom_la_per_sa_slp(fates_pft) ; + fates_allom_la_per_sa_slp:units = "m2/cm2/m" ; + fates_allom_la_per_sa_slp:long_name = "Leaf area per sapwood area rate of change with height, slope (optional)" ; + double fates_allom_lmode(fates_pft) ; + fates_allom_lmode:units = "index" ; + fates_allom_lmode:long_name = "leaf biomass allometry function index." ; + double fates_allom_sai_scaler(fates_pft) ; + fates_allom_sai_scaler:units = "m2/m2" ; + fates_allom_sai_scaler:long_name = "allometric ratio of SAI per LAI" ; + double fates_allom_smode(fates_pft) ; + fates_allom_smode:units = "index" ; + fates_allom_smode:long_name = "sapwood allometry function index." ; + double fates_allom_stmode(fates_pft) ; + fates_allom_stmode:units = "index" ; + fates_allom_stmode:long_name = "storage allometry function index: 1) Storage proportional to leaf biomass (with trimming), 2) Storage proportional to maximum leaf biomass (not trimmed)" ; + double fates_allom_zroot_k(fates_pft) ; + fates_allom_zroot_k:units = "unitless" ; + fates_allom_zroot_k:long_name = "scale coefficient of logistic rooting depth model" ; + double fates_allom_zroot_max_dbh(fates_pft) ; + fates_allom_zroot_max_dbh:units = "cm" ; + fates_allom_zroot_max_dbh:long_name = "dbh at which a plant reaches the maximum value for its maximum rooting depth" ; + double fates_allom_zroot_max_z(fates_pft) ; + fates_allom_zroot_max_z:units = "m" ; + fates_allom_zroot_max_z:long_name = "the maximum rooting depth defined at dbh = fates_allom_zroot_max_dbh. note: max_z=min_z=large, sets rooting depth to soil depth" ; + double fates_allom_zroot_min_dbh(fates_pft) ; + fates_allom_zroot_min_dbh:units = "cm" ; + fates_allom_zroot_min_dbh:long_name = "dbh at which the maximum rooting depth for a recruit is defined" ; + double fates_allom_zroot_min_z(fates_pft) ; + fates_allom_zroot_min_z:units = "m" ; + fates_allom_zroot_min_z:long_name = "the maximum rooting depth defined at dbh = fates_allom_zroot_min_dbh. note: max_z=min_z=large, sets rooting depth to soil depth" ; + double fates_c2b(fates_pft) ; + fates_c2b:units = "ratio" ; + fates_c2b:long_name = "Carbon to biomass multiplier of bulk structural tissues" ; + double fates_cnp_eca_alpha_ptase(fates_pft) ; + fates_cnp_eca_alpha_ptase:units = "g/m3" ; + fates_cnp_eca_alpha_ptase:long_name = "(INACTIVE, KEEP AT 0) fraction of P from ptase activity sent directly to plant (ECA)" ; + double fates_cnp_eca_decompmicc(fates_pft) ; + fates_cnp_eca_decompmicc:units = "gC/m3" ; + fates_cnp_eca_decompmicc:long_name = "maximum soil microbial decomposer biomass found over depth (will be applied at a reference depth w/ exponential attenuation) (ECA)" ; + double fates_cnp_eca_km_nh4(fates_pft) ; + fates_cnp_eca_km_nh4:units = "gN/m3" ; + fates_cnp_eca_km_nh4:long_name = "half-saturation constant for plant nh4 uptake (ECA)" ; + double fates_cnp_eca_km_no3(fates_pft) ; + fates_cnp_eca_km_no3:units = "gN/m3" ; + fates_cnp_eca_km_no3:long_name = "half-saturation constant for plant no3 uptake (ECA)" ; + double fates_cnp_eca_km_p(fates_pft) ; + fates_cnp_eca_km_p:units = "gP/m3" ; + fates_cnp_eca_km_p:long_name = "half-saturation constant for plant p uptake (ECA)" ; + double fates_cnp_eca_km_ptase(fates_pft) ; + fates_cnp_eca_km_ptase:units = "gP/m3" ; + fates_cnp_eca_km_ptase:long_name = "half-saturation constant for biochemical P (ECA)" ; + double fates_cnp_eca_lambda_ptase(fates_pft) ; + fates_cnp_eca_lambda_ptase:units = "g/m3" ; + fates_cnp_eca_lambda_ptase:long_name = "(INACTIVE, KEEP AT 0) critical value for biochemical production (ECA)" ; + double fates_cnp_eca_vmax_ptase(fates_pft) ; + fates_cnp_eca_vmax_ptase:units = "gP/m2/s" ; + fates_cnp_eca_vmax_ptase:long_name = "maximum production rate for biochemical P (per m2) (ECA)" ; + double fates_cnp_nfix1(fates_pft) ; + fates_cnp_nfix1:units = "fraction" ; + fates_cnp_nfix1:long_name = "fractional surcharge added to maintenance respiration that drives symbiotic fixation" ; + double fates_cnp_nitr_store_ratio(fates_pft) ; + fates_cnp_nitr_store_ratio:units = "(gN/gN)" ; + fates_cnp_nitr_store_ratio:long_name = "storeable (labile) N, as a ratio compared to the N bound in cell structures of other organs (see code)" ; + double fates_cnp_phos_store_ratio(fates_pft) ; + fates_cnp_phos_store_ratio:units = "(gP/gP)" ; + fates_cnp_phos_store_ratio:long_name = "storeable (labile) P, as a ratio compared to the P bound in cell structures of other organs (see code)" ; + double fates_cnp_pid_kd(fates_pft) ; + fates_cnp_pid_kd:units = "unknown" ; + fates_cnp_pid_kd:long_name = "derivative constant of the PID controller on adaptive fine-root biomass" ; + double fates_cnp_pid_ki(fates_pft) ; + fates_cnp_pid_ki:units = "unknown" ; + fates_cnp_pid_ki:long_name = "integral constant of the PID controller on adaptive fine-root biomass" ; + double fates_cnp_pid_kp(fates_pft) ; + fates_cnp_pid_kp:units = "unknown" ; + fates_cnp_pid_kp:long_name = "proportional constant of the PID controller on adaptive fine-root biomass" ; + double fates_cnp_prescribed_nuptake(fates_pft) ; + fates_cnp_prescribed_nuptake:units = "fraction" ; + fates_cnp_prescribed_nuptake:long_name = "Prescribed N uptake flux. 0=fully coupled simulation >0=prescribed (experimental)" ; + double fates_cnp_prescribed_puptake(fates_pft) ; + fates_cnp_prescribed_puptake:units = "fraction" ; + fates_cnp_prescribed_puptake:long_name = "Prescribed P uptake flux. 0=fully coupled simulation, >0=prescribed (experimental)" ; + double fates_cnp_store_ovrflw_frac(fates_pft) ; + fates_cnp_store_ovrflw_frac:units = "fraction" ; + fates_cnp_store_ovrflw_frac:long_name = "size of overflow storage (for excess C,N or P) as a fraction of storage target" ; + double fates_cnp_turnover_nitr_retrans(fates_plant_organs, fates_pft) ; + fates_cnp_turnover_nitr_retrans:units = "fraction" ; + fates_cnp_turnover_nitr_retrans:long_name = "retranslocation (reabsorbtion) fraction of nitrogen in turnover of scenescing tissues" ; + double fates_cnp_turnover_phos_retrans(fates_plant_organs, fates_pft) ; + fates_cnp_turnover_phos_retrans:units = "fraction" ; + fates_cnp_turnover_phos_retrans:long_name = "retranslocation (reabsorbtion) fraction of phosphorus in turnover of scenescing tissues" ; + double fates_cnp_vmax_nh4(fates_pft) ; + fates_cnp_vmax_nh4:units = "gN/gC/s" ; + fates_cnp_vmax_nh4:long_name = "maximum (potential) uptake rate of NH4 per gC of fineroot biomass (see main/EDPftvarcon.F90 vmax_nh4 for usage)" ; + double fates_cnp_vmax_no3(fates_pft) ; + fates_cnp_vmax_no3:units = "gN/gC/s" ; + fates_cnp_vmax_no3:long_name = "maximum (potential) uptake rate of NO3 per gC of fineroot biomass (see main/EDPftvarcon.F90 vmax_no3 for usage)" ; + double fates_cnp_vmax_p(fates_pft) ; + fates_cnp_vmax_p:units = "gP/gC/s" ; + fates_cnp_vmax_p:long_name = "maximum production rate for phosphorus (ECA and RD)" ; + double fates_damage_frac(fates_pft) ; + fates_damage_frac:units = "fraction" ; + fates_damage_frac:long_name = "fraction of cohort damaged in each damage event (event frequency specified in the is_it_damage_time subroutine)" ; + double fates_damage_mort_p1(fates_pft) ; + fates_damage_mort_p1:units = "fraction" ; + fates_damage_mort_p1:long_name = "inflection point of damage mortality function, a value of 0.8 means 50% mortality with 80% loss of crown, turn off with a large number" ; + double fates_damage_mort_p2(fates_pft) ; + fates_damage_mort_p2:units = "unitless" ; + fates_damage_mort_p2:long_name = "rate of mortality increase with damage" ; + double fates_damage_recovery_scalar(fates_pft) ; + fates_damage_recovery_scalar:units = "unitless" ; + fates_damage_recovery_scalar:long_name = "fraction of the cohort that recovers from damage" ; + double fates_dev_arbitrary_pft(fates_pft) ; + fates_dev_arbitrary_pft:units = "unknown" ; + fates_dev_arbitrary_pft:long_name = "Unassociated pft dimensioned free parameter that developers can use for testing arbitrary new hypotheses" ; + double fates_edgeforest_bin_edges(fates_edgeforest_bins) ; + fates_edgeforest_bin_edges:units = "m" ; + fates_edgeforest_bin_edges:long_name = "Boundaries of forest edge bins (for each bin, include value closest to zero)" ; + double fates_edgeforest_gaussian_amplitude(fates_edgeforest_bins) ; + fates_edgeforest_gaussian_amplitude:units = "unitless" ; + fates_edgeforest_gaussian_amplitude:long_name = "Amplitudes for calculating forest area in each edge bin (gaussian fit)" ; + double fates_edgeforest_gaussian_sigma(fates_edgeforest_bins) ; + fates_edgeforest_gaussian_sigma:units = "unitless" ; + fates_edgeforest_gaussian_sigma:long_name = "Sigmas for calculating forest area in each edge bin (gaussian fit)" ; + double fates_edgeforest_gaussian_center(fates_edgeforest_bins) ; + fates_edgeforest_gaussian_center:units = "unitless" ; + fates_edgeforest_gaussian_center:long_name = "Centers for calculating forest area in each edge bin (gaussian fit)" ; + double fates_edgeforest_lognormal_amplitude(fates_edgeforest_bins) ; + fates_edgeforest_lognormal_amplitude:units = "unitless" ; + fates_edgeforest_lognormal_amplitude:long_name = "Amplitudes for calculating forest area in each edge bin (lognormal fit)" ; + double fates_edgeforest_lognormal_sigma(fates_edgeforest_bins) ; + fates_edgeforest_lognormal_sigma:units = "unitless" ; + fates_edgeforest_lognormal_sigma:long_name = "Sigmas for calculating forest area in each edge bin (lognormal fit)" ; + double fates_edgeforest_lognormal_center(fates_edgeforest_bins) ; + fates_edgeforest_lognormal_center:units = "unitless" ; + fates_edgeforest_lognormal_center:long_name = "Centers for calculating forest area in each edge bin (lognormal fit)" ; + double fates_edgeforest_quadratic_a(fates_edgeforest_bins) ; + fates_edgeforest_quadratic_a:units = "unitless" ; + fates_edgeforest_quadratic_a:long_name = "x^2 coefficient for calculating forest area in each edge bin (quadratic fit)" ; + double fates_edgeforest_quadratic_b(fates_edgeforest_bins) ; + fates_edgeforest_quadratic_b:units = "unitless" ; + fates_edgeforest_quadratic_b:long_name = "x^1 coefficient for calculating forest area in each edge bin (quadratic fit)" ; + double fates_edgeforest_quadratic_c(fates_edgeforest_bins) ; + fates_edgeforest_quadratic_c:units = "unitless" ; + fates_edgeforest_quadratic_c:long_name = "x^0 coefficient for calculating forest area in each edge bin (quadratic fit)" ; + double fates_edgeforest_fireweather_rh_mult(fates_edgeforest_bins) ; + fates_edgeforest_fireweather_rh_mult:units = "unitless" ; + fates_edgeforest_fireweather_rh_mult:long_name = "Factor multiplied onto + relative humidity (for fire weather only) in each edge forest bin. Applied before additive factor + fates_edgeforest_fireweather_rh_add." ; + double fates_edgeforest_fireweather_temp_C_mult(fates_edgeforest_bins) ; + fates_edgeforest_fireweather_temp_C_mult:units = "unitless" ; + fates_edgeforest_fireweather_temp_C_mult:long_name = "Factor multiplied onto + temperature (for fire weather only) in each edge forest bin. Applied before additive factor + fates_edgeforest_fireweather_temp_C_add." ; + double fates_edgeforest_fireweather_wind_mult(fates_edgeforest_bins) ; + fates_edgeforest_fireweather_wind_mult:units = "unitless" ; + fates_edgeforest_fireweather_wind_mult:long_name = "Factor multiplied onto + wind speed (for fire weather only) in each edge forest bin. Applied before additive factor + fates_edgeforest_fireweather_wind_add." ; + double fates_edgeforest_fireweather_rh_add(fates_edgeforest_bins) ; + fates_edgeforest_fireweather_rh_add:units = "%" ; + fates_edgeforest_fireweather_rh_add:long_name = "Factor added to + relative humidity (for fire weather only) in each edge forest bin. Applied after multiplicative + factor fates_edgeforest_fireweather_rh_mult." ; + double fates_edgeforest_fireweather_temp_C_add(fates_edgeforest_bins) ; + fates_edgeforest_fireweather_temp_C_add:units = "degrees C" ; + fates_edgeforest_fireweather_temp_C_add:long_name = "Factor added to + temperature (for fire weather only) in each edge forest bin. Applied after multiplicative + factor fates_edgeforest_fireweather_temp_C_mult." ; + double fates_edgeforest_fireweather_wind_add(fates_edgeforest_bins) ; + fates_edgeforest_fireweather_wind_add:units = "m/min" ; + fates_edgeforest_fireweather_wind_add:long_name = "Factor added to + wind speed (for fire weather only) in each edge forest bin. Applied after multiplicative + factor fates_edgeforest_fireweather_wind_mult." ; + double fates_fire_alpha_SH(fates_pft) ; + fates_fire_alpha_SH:units = "m / (kw/m)**(2/3)" ; + fates_fire_alpha_SH:long_name = "spitfire parameter, alpha scorch height, Equation 16 Thonicke et al 2010" ; + double fates_fire_bark_scaler(fates_pft) ; + fates_fire_bark_scaler:units = "fraction" ; + fates_fire_bark_scaler:long_name = "the thickness of a cohorts bark as a fraction of its dbh" ; + double fates_fire_crown_kill(fates_pft) ; + fates_fire_crown_kill:units = "NA" ; + fates_fire_crown_kill:long_name = "fire parameter, see equation 22 in Thonicke et al 2010" ; + double fates_frag_fnrt_fcel(fates_pft) ; + fates_frag_fnrt_fcel:units = "fraction" ; + fates_frag_fnrt_fcel:long_name = "Fine root litter cellulose fraction" ; + double fates_frag_fnrt_flab(fates_pft) ; + fates_frag_fnrt_flab:units = "fraction" ; + fates_frag_fnrt_flab:long_name = "Fine root litter labile fraction" ; + double fates_frag_fnrt_flig(fates_pft) ; + fates_frag_fnrt_flig:units = "fraction" ; + fates_frag_fnrt_flig:long_name = "Fine root litter lignin fraction" ; + double fates_frag_leaf_fcel(fates_pft) ; + fates_frag_leaf_fcel:units = "fraction" ; + fates_frag_leaf_fcel:long_name = "Leaf litter cellulose fraction" ; + double fates_frag_leaf_flab(fates_pft) ; + fates_frag_leaf_flab:units = "fraction" ; + fates_frag_leaf_flab:long_name = "Leaf litter labile fraction" ; + double fates_frag_leaf_flig(fates_pft) ; + fates_frag_leaf_flig:units = "fraction" ; + fates_frag_leaf_flig:long_name = "Leaf litter lignin fraction" ; + double fates_frag_seed_decay_rate(fates_pft) ; + fates_frag_seed_decay_rate:units = "yr-1" ; + fates_frag_seed_decay_rate:long_name = "fraction of seeds that decay per year" ; + double fates_grperc(fates_pft) ; + fates_grperc:units = "unitless" ; + fates_grperc:long_name = "Growth respiration factor" ; + double fates_hydro_avuln_gs(fates_pft) ; + fates_hydro_avuln_gs:units = "unitless" ; + fates_hydro_avuln_gs:long_name = "shape parameter for stomatal control of water vapor exiting leaf" ; + double fates_hydro_avuln_node(fates_hydr_organs, fates_pft) ; + fates_hydro_avuln_node:units = "unitless" ; + fates_hydro_avuln_node:long_name = "xylem vulnerability curve shape parameter" ; + double fates_hydro_epsil_node(fates_hydr_organs, fates_pft) ; + fates_hydro_epsil_node:units = "MPa" ; + fates_hydro_epsil_node:long_name = "bulk elastic modulus" ; + double fates_hydro_fcap_node(fates_hydr_organs, fates_pft) ; + fates_hydro_fcap_node:units = "unitless" ; + fates_hydro_fcap_node:long_name = "fraction of non-residual water that is capillary in source" ; + double fates_hydro_k_lwp(fates_pft) ; + fates_hydro_k_lwp:units = "unitless" ; + fates_hydro_k_lwp:long_name = "inner leaf humidity scaling coefficient" ; + double fates_hydro_kmax_node(fates_hydr_organs, fates_pft) ; + fates_hydro_kmax_node:units = "kg/MPa/m/s" ; + fates_hydro_kmax_node:long_name = "maximum xylem conductivity per unit conducting xylem area" ; + double fates_hydro_p50_gs(fates_pft) ; + fates_hydro_p50_gs:units = "MPa" ; + fates_hydro_p50_gs:long_name = "water potential at 50% loss of stomatal conductance" ; + double fates_hydro_p50_node(fates_hydr_organs, fates_pft) ; + fates_hydro_p50_node:units = "MPa" ; + fates_hydro_p50_node:long_name = "xylem water potential at 50% loss of conductivity" ; + double fates_hydro_p_taper(fates_pft) ; + fates_hydro_p_taper:units = "unitless" ; + fates_hydro_p_taper:long_name = "xylem taper exponent" ; + double fates_hydro_pinot_node(fates_hydr_organs, fates_pft) ; + fates_hydro_pinot_node:units = "MPa" ; + fates_hydro_pinot_node:long_name = "osmotic potential at full turgor" ; + double fates_hydro_pitlp_node(fates_hydr_organs, fates_pft) ; + fates_hydro_pitlp_node:units = "MPa" ; + fates_hydro_pitlp_node:long_name = "turgor loss point" ; + double fates_hydro_resid_node(fates_hydr_organs, fates_pft) ; + fates_hydro_resid_node:units = "cm3/cm3" ; + fates_hydro_resid_node:long_name = "residual water conent" ; + double fates_hydro_rfrac_stem(fates_pft) ; + fates_hydro_rfrac_stem:units = "fraction" ; + fates_hydro_rfrac_stem:long_name = "fraction of total tree resistance from troot to canopy" ; + double fates_hydro_rs2(fates_pft) ; + fates_hydro_rs2:units = "m" ; + fates_hydro_rs2:long_name = "absorbing root radius" ; + double fates_hydro_srl(fates_pft) ; + fates_hydro_srl:units = "m g-1" ; + fates_hydro_srl:long_name = "specific root length" ; + double fates_hydro_thetas_node(fates_hydr_organs, fates_pft) ; + fates_hydro_thetas_node:units = "cm3/cm3" ; + fates_hydro_thetas_node:long_name = "saturated water content" ; + double fates_hydro_vg_alpha_node(fates_hydr_organs, fates_pft) ; + fates_hydro_vg_alpha_node:units = "MPa-1" ; + fates_hydro_vg_alpha_node:long_name = "(used if hydr_htftype_node = 2), capillary length parameter in van Genuchten model" ; + double fates_hydro_vg_m_node(fates_hydr_organs, fates_pft) ; + fates_hydro_vg_m_node:units = "unitless" ; + fates_hydro_vg_m_node:long_name = "(used if hydr_htftype_node = 2),m in van Genuchten 1980 model, 2nd pore size distribution parameter" ; + double fates_hydro_vg_n_node(fates_hydr_organs, fates_pft) ; + fates_hydro_vg_n_node:units = "unitless" ; + fates_hydro_vg_n_node:long_name = "(used if hydr_htftype_node = 2),n in van Genuchten 1980 model, pore size distribution parameter" ; + double fates_landuse_grazing_palatability(fates_pft) ; + fates_landuse_grazing_palatability:units = "unitless 0-1" ; + fates_landuse_grazing_palatability:long_name = "Relative intensity of leaf grazing/browsing per PFT" ; + double fates_landuse_harvest_pprod10(fates_pft) ; + fates_landuse_harvest_pprod10:units = "fraction" ; + fates_landuse_harvest_pprod10:long_name = "fraction of harvest wood product that goes to 10-year product pool (remainder goes to 100-year pool)" ; + double fates_landuse_luc_frac_burned(fates_pft) ; + fates_landuse_luc_frac_burned:units = "fraction" ; + fates_landuse_luc_frac_burned:long_name = "fraction of land use change-generated and not-exported material that is burned (the remainder goes to litter)" ; + double fates_landuse_luc_frac_exported(fates_pft) ; + fates_landuse_luc_frac_exported:units = "fraction" ; + fates_landuse_luc_frac_exported:long_name = "fraction of land use change-generated wood material that is exported to wood product (the remainder is either burned or goes to litter)" ; + double fates_landuse_luc_pprod10(fates_pft) ; + fates_landuse_luc_pprod10:units = "fraction" ; + fates_landuse_luc_pprod10:long_name = "fraction of land use change wood product that goes to 10-year product pool (remainder goes to 100-year pool)" ; + double fates_leaf_agross_btran_model(fates_pft) ; + fates_leaf_agross_btran_model:units = "index" ; + fates_leaf_agross_btran_model:long_name = "model switch for how gross assimilation affects conductance. See LeafBiophysicsMod.F90, integer constants: btran_on_" ; + double fates_leaf_c3psn(fates_pft) ; + fates_leaf_c3psn:units = "flag" ; + fates_leaf_c3psn:long_name = "Photosynthetic pathway (1=c3, 0=c4)" ; + double fates_leaf_fnps(fates_pft) ; + fates_leaf_fnps:units = "fraction" ; + fates_leaf_fnps:long_name = "fraction of light absorbed by non-photosynthetic pigments" ; + double fates_leaf_jmaxha(fates_pft) ; + fates_leaf_jmaxha:units = "J/mol" ; + fates_leaf_jmaxha:long_name = "activation energy for jmax. NOTE: if fates_leaf_photo_tempsens_model=2 then these values are NOT USED" ; + double fates_leaf_jmaxhd(fates_pft) ; + fates_leaf_jmaxhd:units = "J/mol" ; + fates_leaf_jmaxhd:long_name = "deactivation energy for jmax. NOTE: if fates_leaf_photo_tempsens_model=2 then these values are NOT USED" ; + double fates_leaf_jmaxse(fates_pft) ; + fates_leaf_jmaxse:units = "J/mol/K" ; + fates_leaf_jmaxse:long_name = "entropy term for jmax. NOTE: if fates_leaf_photo_tempsens_model=2 then these values are NOT USED" ; + double fates_leaf_slamax(fates_pft) ; + fates_leaf_slamax:units = "m^2/gC" ; + fates_leaf_slamax:long_name = "Maximum Specific Leaf Area (SLA), even if under a dense canopy" ; + double fates_leaf_slatop(fates_pft) ; + fates_leaf_slatop:units = "m^2/gC" ; + fates_leaf_slatop:long_name = "Specific Leaf Area (SLA) at top of canopy, projected area basis" ; + double fates_leaf_stomatal_btran_model(fates_pft) ; + fates_leaf_stomatal_btran_model:units = "index" ; + fates_leaf_stomatal_btran_model:long_name = "model switch for how btran affects conductance. See LeafBiophysicsMod.F90, integer constants: btran_on_" ; + double fates_leaf_stomatal_intercept(fates_pft) ; + fates_leaf_stomatal_intercept:units = "umol H2O/m**2/s" ; + fates_leaf_stomatal_intercept:long_name = "Minimum unstressed stomatal conductance for Ball-Berry model and Medlyn model" ; + double fates_leaf_stomatal_slope_ballberry(fates_pft) ; + fates_leaf_stomatal_slope_ballberry:units = "unitless" ; + fates_leaf_stomatal_slope_ballberry:long_name = "stomatal slope parameter, as per Ball-Berry" ; + double fates_leaf_stomatal_slope_medlyn(fates_pft) ; + fates_leaf_stomatal_slope_medlyn:units = "KPa**0.5" ; + fates_leaf_stomatal_slope_medlyn:long_name = "stomatal slope parameter, as per Medlyn" ; + double fates_leaf_vcmax25top(fates_leafage_class, fates_pft) ; + fates_leaf_vcmax25top:units = "umol CO2/m^2/s" ; + fates_leaf_vcmax25top:long_name = "maximum carboxylation rate of Rub. at 25C, canopy top" ; + double fates_leaf_vcmaxha(fates_pft) ; + fates_leaf_vcmaxha:units = "J/mol" ; + fates_leaf_vcmaxha:long_name = "activation energy for vcmax. NOTE: if fates_leaf_photo_tempsens_model=2 then these values are NOT USED" ; + double fates_leaf_vcmaxhd(fates_pft) ; + fates_leaf_vcmaxhd:units = "J/mol" ; + fates_leaf_vcmaxhd:long_name = "deactivation energy for vcmax. NOTE: if fates_leaf_photo_tempsens_model=2 then these values are NOT USED" ; + double fates_leaf_vcmaxse(fates_pft) ; + fates_leaf_vcmaxse:units = "J/mol/K" ; + fates_leaf_vcmaxse:long_name = "entropy term for vcmax. NOTE: if fates_leaf_photo_tempsens_model=2 then these values are NOT USED" ; + double fates_leafn_vert_scaler_coeff1(fates_pft) ; + fates_leafn_vert_scaler_coeff1:units = "unitless" ; + fates_leafn_vert_scaler_coeff1:long_name = "Coefficient one for decrease in leaf nitrogen through the canopy, from Lloyd et al. 2010." ; + double fates_leafn_vert_scaler_coeff2(fates_pft) ; + fates_leafn_vert_scaler_coeff2:units = "unitless" ; + fates_leafn_vert_scaler_coeff2:long_name = "Coefficient two for decrease in leaf nitrogen through the canopy, from Lloyd et al. 2010." ; + double fates_maintresp_leaf_atkin2017_baserate(fates_pft) ; + fates_maintresp_leaf_atkin2017_baserate:units = "umol CO2/m^2/s" ; + fates_maintresp_leaf_atkin2017_baserate:long_name = "Leaf maintenance respiration base rate parameter (r0) per Atkin et al 2017" ; + double fates_maintresp_leaf_ryan1991_baserate(fates_pft) ; + fates_maintresp_leaf_ryan1991_baserate:units = "gC/gN/s" ; + fates_maintresp_leaf_ryan1991_baserate:long_name = "Leaf maintenance respiration base rate per Ryan et al 1991" ; + double fates_maintresp_leaf_vert_scaler_coeff1(fates_pft) ; + fates_maintresp_leaf_vert_scaler_coeff1:units = "unitless" ; + fates_maintresp_leaf_vert_scaler_coeff1:long_name = "Leaf maintenance respiration decrease through the canopy. Only applies to Atkin et al. 2017. For proportionality between photosynthesis and respiration through the canopy, match with fates_leafn_vert_scaler_coeff1." ; + double fates_maintresp_leaf_vert_scaler_coeff2(fates_pft) ; + fates_maintresp_leaf_vert_scaler_coeff2:units = "unitless" ; + fates_maintresp_leaf_vert_scaler_coeff2:long_name = "Leaf maintenance respiration decrease through the canopy. Only applies to Atkin et al. 2017. For proportionality between photosynthesis and respiration through the canopy, match with fates_leafn_vert_scaler_coeff2." ; + double fates_maintresp_reduction_curvature(fates_pft) ; + fates_maintresp_reduction_curvature:units = "unitless (0-1)" ; + fates_maintresp_reduction_curvature:long_name = "curvature of MR reduction as f(carbon storage), 1=linear, 0=very curved" ; + double fates_maintresp_reduction_intercept(fates_pft) ; + fates_maintresp_reduction_intercept:units = "unitless (0-1)" ; + fates_maintresp_reduction_intercept:long_name = "intercept of MR reduction as f(carbon storage), 0=no throttling, 1=max throttling" ; + double fates_maintresp_reduction_upthresh(fates_pft) ; + fates_maintresp_reduction_upthresh:units = "unitless (0-1)" ; + fates_maintresp_reduction_upthresh:long_name = "upper threshold for storage biomass (relative to leaf biomass) above which MR is not reduced" ; + double fates_mort_bmort(fates_pft) ; + fates_mort_bmort:units = "1/yr" ; + fates_mort_bmort:long_name = "background mortality rate" ; + double fates_mort_freezetol(fates_pft) ; + fates_mort_freezetol:units = "degrees C" ; + fates_mort_freezetol:long_name = "minimum temperature tolerance" ; + double fates_mort_hf_flc_threshold(fates_pft) ; + fates_mort_hf_flc_threshold:units = "fraction" ; + fates_mort_hf_flc_threshold:long_name = "plant fractional loss of conductivity at which drought mortality begins for hydraulic model" ; + double fates_mort_hf_sm_threshold(fates_pft) ; + fates_mort_hf_sm_threshold:units = "unitless" ; + fates_mort_hf_sm_threshold:long_name = "soil moisture (btran units) at which drought mortality begins for non-hydraulic model" ; + double fates_mort_ip_age_senescence(fates_pft) ; + fates_mort_ip_age_senescence:units = "years" ; + fates_mort_ip_age_senescence:long_name = "Mortality cohort age senescence inflection point. If _ this mortality term is off. Setting this value turns on age dependent mortality. " ; + double fates_mort_ip_size_senescence(fates_pft) ; + fates_mort_ip_size_senescence:units = "dbh cm" ; + fates_mort_ip_size_senescence:long_name = "Mortality dbh senescence inflection point. If _ this mortality term is off. Setting this value turns on size dependent mortality" ; + double fates_mort_prescribed_canopy(fates_pft) ; + fates_mort_prescribed_canopy:units = "1/yr" ; + fates_mort_prescribed_canopy:long_name = "mortality rate of canopy trees for prescribed physiology mode" ; + double fates_mort_prescribed_understory(fates_pft) ; + fates_mort_prescribed_understory:units = "1/yr" ; + fates_mort_prescribed_understory:long_name = "mortality rate of understory trees for prescribed physiology mode" ; + double fates_mort_r_age_senescence(fates_pft) ; + fates_mort_r_age_senescence:units = "mortality rate year^-1" ; + fates_mort_r_age_senescence:long_name = "Mortality age senescence rate of change. Sensible range is around 0.03-0.06. Larger values givesteeper mortality curves." ; + double fates_mort_r_size_senescence(fates_pft) ; + fates_mort_r_size_senescence:units = "mortality rate dbh^-1" ; + fates_mort_r_size_senescence:long_name = "Mortality dbh senescence rate of change. Sensible range is around 0.03-0.06. Larger values give steeper mortality curves." ; + double fates_mort_scalar_coldstress(fates_pft) ; + fates_mort_scalar_coldstress:units = "1/yr" ; + fates_mort_scalar_coldstress:long_name = "maximum mortality rate from cold stress" ; + double fates_mort_scalar_cstarvation(fates_pft) ; + fates_mort_scalar_cstarvation:units = "1/yr" ; + fates_mort_scalar_cstarvation:long_name = "maximum mortality rate from carbon starvation" ; + double fates_mort_scalar_hydrfailure(fates_pft) ; + fates_mort_scalar_hydrfailure:units = "1/yr" ; + fates_mort_scalar_hydrfailure:long_name = "maximum mortality rate from hydraulic failure" ; + double fates_mort_upthresh_cstarvation(fates_pft) ; + fates_mort_upthresh_cstarvation:units = "unitless" ; + fates_mort_upthresh_cstarvation:long_name = "threshold for storage biomass (relative to target leaf biomass) above which carbon starvation is zero" ; + double fates_nonhydro_smpsc(fates_pft) ; + fates_nonhydro_smpsc:units = "mm" ; + fates_nonhydro_smpsc:long_name = "Soil water potential at full stomatal closure" ; + double fates_nonhydro_smpso(fates_pft) ; + fates_nonhydro_smpso:units = "mm" ; + fates_nonhydro_smpso:long_name = "Soil water potential at full stomatal opening" ; + double fates_phen_cold_size_threshold(fates_pft) ; + fates_phen_cold_size_threshold:units = "cm" ; + fates_phen_cold_size_threshold:long_name = "the dbh size above which will lead to phenology-related stem and leaf drop" ; + double fates_phen_drought_threshold(fates_pft) ; + fates_phen_drought_threshold:units = "m3/m3 or mm" ; + fates_phen_drought_threshold:long_name = "threshold for drought phenology (or lower threshold for semi-deciduous PFTs); the quantity depends on the sign: if positive, the threshold is volumetric soil moisture (m3/m3). If negative, the threshold is soil matric potentical (mm)" ; + double fates_phen_flush_fraction(fates_pft) ; + fates_phen_flush_fraction:units = "fraction" ; + fates_phen_flush_fraction:long_name = "Upon bud-burst, the maximum fraction of storage carbon used for flushing leaves" ; + double fates_phen_fnrt_drop_fraction(fates_pft) ; + fates_phen_fnrt_drop_fraction:units = "fraction" ; + fates_phen_fnrt_drop_fraction:long_name = "fraction of fine roots to drop during drought/cold" ; + double fates_phen_leaf_habit(fates_pft) ; + fates_phen_leaf_habit:units = "flag" ; + fates_phen_leaf_habit:long_name = "Flag for leaf phenology habit. 1 - evergreen; 2 - season (cold) deciduous; 3 - stress (hydro) deciduous; 4 - stress (hydro) semi-deciduous" ; + double fates_phen_mindaysoff(fates_pft) ; + fates_phen_mindaysoff:units = "days" ; + fates_phen_mindaysoff:long_name = "day threshold compared against days since leaves abscised (shed)" ; + double fates_phen_moist_threshold(fates_pft) ; + fates_phen_moist_threshold:units = "m3/m3 or mm" ; + fates_phen_moist_threshold:long_name = "upper threshold for drought phenology (only for drought semi-deciduous PFTs); the quantity depends on the sign: if positive, the threshold is volumetric soil moisture (m3/m3). If negative, the threshold is soil matric potentical (mm)" ; + double fates_phen_stem_drop_fraction(fates_pft) ; + fates_phen_stem_drop_fraction:units = "fraction" ; + fates_phen_stem_drop_fraction:long_name = "fraction of stems to drop for non-woody species during drought/cold" ; + double fates_prescribed_npp_canopy(fates_pft) ; + fates_prescribed_npp_canopy:units = "kgC / m^2 / yr" ; + fates_prescribed_npp_canopy:long_name = "NPP per unit crown area of canopy trees for prescribed physiology mode" ; + double fates_prescribed_npp_understory(fates_pft) ; + fates_prescribed_npp_understory:units = "kgC / m^2 / yr" ; + fates_prescribed_npp_understory:long_name = "NPP per unit crown area of understory trees for prescribed physiology mode" ; + double fates_rad_leaf_clumping_index(fates_pft) ; + fates_rad_leaf_clumping_index:units = "fraction (0-1)" ; + fates_rad_leaf_clumping_index:long_name = "factor describing how much self-occlusion of leaf scattering elements decreases light interception" ; + double fates_rad_leaf_rhonir(fates_pft) ; + fates_rad_leaf_rhonir:units = "fraction" ; + fates_rad_leaf_rhonir:long_name = "Leaf reflectance: near-IR" ; + double fates_rad_leaf_rhovis(fates_pft) ; + fates_rad_leaf_rhovis:units = "fraction" ; + fates_rad_leaf_rhovis:long_name = "Leaf reflectance: visible" ; + double fates_rad_leaf_taunir(fates_pft) ; + fates_rad_leaf_taunir:units = "fraction" ; + fates_rad_leaf_taunir:long_name = "Leaf transmittance: near-IR" ; + double fates_rad_leaf_tauvis(fates_pft) ; + fates_rad_leaf_tauvis:units = "fraction" ; + fates_rad_leaf_tauvis:long_name = "Leaf transmittance: visible" ; + double fates_rad_leaf_xl(fates_pft) ; + fates_rad_leaf_xl:units = "unitless" ; + fates_rad_leaf_xl:long_name = "Leaf/stem orientation index" ; + double fates_rad_stem_rhonir(fates_pft) ; + fates_rad_stem_rhonir:units = "fraction" ; + fates_rad_stem_rhonir:long_name = "Stem reflectance: near-IR" ; + double fates_rad_stem_rhovis(fates_pft) ; + fates_rad_stem_rhovis:units = "fraction" ; + fates_rad_stem_rhovis:long_name = "Stem reflectance: visible" ; + double fates_rad_stem_taunir(fates_pft) ; + fates_rad_stem_taunir:units = "fraction" ; + fates_rad_stem_taunir:long_name = "Stem transmittance: near-IR" ; + double fates_rad_stem_tauvis(fates_pft) ; + fates_rad_stem_tauvis:units = "fraction" ; + fates_rad_stem_tauvis:long_name = "Stem transmittance: visible" ; + double fates_recruit_height_min(fates_pft) ; + fates_recruit_height_min:units = "m" ; + fates_recruit_height_min:long_name = "the minimum height (ie starting height) of a newly recruited plant" ; + double fates_recruit_init_density(fates_pft) ; + fates_recruit_init_density:units = "stems/m2" ; + fates_recruit_init_density:long_name = "initial seedling density for a cold-start near-bare-ground simulation. If negative sets initial tree dbh - only to be used in nocomp mode" ; + double fates_recruit_prescribed_rate(fates_pft) ; + fates_recruit_prescribed_rate:units = "n/yr" ; + fates_recruit_prescribed_rate:long_name = "recruitment rate for prescribed physiology mode" ; + double fates_recruit_seed_alloc(fates_pft) ; + fates_recruit_seed_alloc:units = "fraction" ; + fates_recruit_seed_alloc:long_name = "fraction of available carbon balance allocated to seeds" ; + double fates_recruit_seed_alloc_mature(fates_pft) ; + fates_recruit_seed_alloc_mature:units = "fraction" ; + fates_recruit_seed_alloc_mature:long_name = "fraction of available carbon balance allocated to seeds in mature plants (adds to fates_seed_alloc)" ; + double fates_recruit_seed_dbh_repro_threshold(fates_pft) ; + fates_recruit_seed_dbh_repro_threshold:units = "cm" ; + fates_recruit_seed_dbh_repro_threshold:long_name = "the diameter where the plant will increase allocation to the seed pool by fraction: fates_recruit_seed_alloc_mature" ; + double fates_recruit_seed_germination_rate(fates_pft) ; + fates_recruit_seed_germination_rate:units = "yr-1" ; + fates_recruit_seed_germination_rate:long_name = "fraction of seeds that germinate per year" ; + double fates_recruit_seed_supplement(fates_pft) ; + fates_recruit_seed_supplement:units = "KgC/m2/yr" ; + fates_recruit_seed_supplement:long_name = "Supplemental external seed rain source term (non-mass conserving)" ; + double fates_seed_dispersal_fraction(fates_pft) ; + fates_seed_dispersal_fraction:units = "fraction" ; + fates_seed_dispersal_fraction:long_name = "fraction of seed rain to be dispersed to other grid cells" ; + double fates_seed_dispersal_max_dist(fates_pft) ; + fates_seed_dispersal_max_dist:units = "m" ; + fates_seed_dispersal_max_dist:long_name = "maximum seed dispersal distance for a given pft" ; + double fates_seed_dispersal_pdf_scale(fates_pft) ; + fates_seed_dispersal_pdf_scale:units = "unitless" ; + fates_seed_dispersal_pdf_scale:long_name = "seed dispersal probability density function scale parameter, A, Table 1 Bullock et al 2016" ; + double fates_seed_dispersal_pdf_shape(fates_pft) ; + fates_seed_dispersal_pdf_shape:units = "unitless" ; + fates_seed_dispersal_pdf_shape:long_name = "seed dispersal probability density function shape parameter, B, Table 1 Bullock et al 2016" ; + double fates_stoich_nitr(fates_plant_organs, fates_pft) ; + fates_stoich_nitr:units = "gN/gC" ; + fates_stoich_nitr:long_name = "target nitrogen concentration (ratio with carbon) of organs" ; + double fates_stoich_phos(fates_plant_organs, fates_pft) ; + fates_stoich_phos:units = "gP/gC" ; + fates_stoich_phos:long_name = "target phosphorus concentration (ratio with carbon) of organs" ; + double fates_trim_inc(fates_pft) ; + fates_trim_inc:units = "m2/m2" ; + fates_trim_inc:long_name = "Arbitrary incremental change in trimming function." ; + double fates_trim_limit(fates_pft) ; + fates_trim_limit:units = "m2/m2" ; + fates_trim_limit:long_name = "Arbitrary limit to reductions in leaf area with stress" ; + double fates_trs_repro_alloc_a(fates_pft) ; + fates_trs_repro_alloc_a:units = "fraction" ; + fates_trs_repro_alloc_a:long_name = "shape parameter for sigmoidal function relating dbh to reproductive allocation" ; + double fates_trs_repro_alloc_b(fates_pft) ; + fates_trs_repro_alloc_b:units = "fraction" ; + fates_trs_repro_alloc_b:long_name = "intercept parameter for sigmoidal function relating dbh to reproductive allocation" ; + double fates_trs_repro_frac_seed(fates_pft) ; + fates_trs_repro_frac_seed:units = "fraction" ; + fates_trs_repro_frac_seed:long_name = "fraction of reproductive mass that is seed" ; + double fates_trs_seedling_a_emerg(fates_pft) ; + fates_trs_seedling_a_emerg:units = "day -1" ; + fates_trs_seedling_a_emerg:long_name = "mean fraction of seed bank emerging" ; + double fates_trs_seedling_b_emerg(fates_pft) ; + fates_trs_seedling_b_emerg:units = "day -1" ; + fates_trs_seedling_b_emerg:long_name = "seedling emergence sensitivity to soil moisture" ; + double fates_trs_seedling_background_mort(fates_pft) ; + fates_trs_seedling_background_mort:units = "yr-1" ; + fates_trs_seedling_background_mort:long_name = "background seedling mortality rate" ; + double fates_trs_seedling_h2o_mort_a(fates_pft) ; + fates_trs_seedling_h2o_mort_a:units = "-" ; + fates_trs_seedling_h2o_mort_a:long_name = "coefficient in moisture-based seedling mortality" ; + double fates_trs_seedling_h2o_mort_b(fates_pft) ; + fates_trs_seedling_h2o_mort_b:units = "-" ; + fates_trs_seedling_h2o_mort_b:long_name = "coefficient in moisture-based seedling mortality" ; + double fates_trs_seedling_h2o_mort_c(fates_pft) ; + fates_trs_seedling_h2o_mort_c:units = "-" ; + fates_trs_seedling_h2o_mort_c:long_name = "coefficient in moisture-based seedling mortality" ; + double fates_trs_seedling_light_mort_a(fates_pft) ; + fates_trs_seedling_light_mort_a:units = "-" ; + fates_trs_seedling_light_mort_a:long_name = "light-based seedling mortality coefficient" ; + double fates_trs_seedling_light_mort_b(fates_pft) ; + fates_trs_seedling_light_mort_b:units = "-" ; + fates_trs_seedling_light_mort_b:long_name = "light-based seedling mortality coefficient" ; + double fates_trs_seedling_light_rec_a(fates_pft) ; + fates_trs_seedling_light_rec_a:units = "-" ; + fates_trs_seedling_light_rec_a:long_name = "coefficient in light-based seedling to sapling transition" ; + double fates_trs_seedling_light_rec_b(fates_pft) ; + fates_trs_seedling_light_rec_b:units = "-" ; + fates_trs_seedling_light_rec_b:long_name = "coefficient in light-based seedling to sapling transition" ; + double fates_trs_seedling_mdd_crit(fates_pft) ; + fates_trs_seedling_mdd_crit:units = "mm H2O day" ; + fates_trs_seedling_mdd_crit:long_name = "critical moisture deficit (suction) day accumulation for seedling moisture-based seedling mortality to begin" ; + double fates_trs_seedling_par_crit_germ(fates_pft) ; + fates_trs_seedling_par_crit_germ:units = "MJ m-2 day-1" ; + fates_trs_seedling_par_crit_germ:long_name = "critical light level for germination" ; + double fates_trs_seedling_psi_crit(fates_pft) ; + fates_trs_seedling_psi_crit:units = "mm H2O" ; + fates_trs_seedling_psi_crit:long_name = "critical soil moisture (suction) for seedling stress" ; + double fates_trs_seedling_psi_emerg(fates_pft) ; + fates_trs_seedling_psi_emerg:units = "mm h20 suction" ; + fates_trs_seedling_psi_emerg:long_name = "critical soil moisture for seedling emergence" ; + double fates_trs_seedling_root_depth(fates_pft) ; + fates_trs_seedling_root_depth:units = "m" ; + fates_trs_seedling_root_depth:long_name = "rooting depth of seedlings" ; + double fates_turb_displar(fates_pft) ; + fates_turb_displar:units = "unitless" ; + fates_turb_displar:long_name = "Ratio of displacement height to canopy top height" ; + double fates_turb_leaf_diameter(fates_pft) ; + fates_turb_leaf_diameter:units = "m" ; + fates_turb_leaf_diameter:long_name = "Characteristic leaf dimension" ; + double fates_turb_z0mr(fates_pft) ; + fates_turb_z0mr:units = "unitless" ; + fates_turb_z0mr:long_name = "Ratio of momentum roughness length to canopy top height" ; + double fates_turnover_branch(fates_pft) ; + fates_turnover_branch:units = "yr" ; + fates_turnover_branch:long_name = "turnover time of branches" ; + double fates_turnover_fnrt(fates_pft) ; + fates_turnover_fnrt:units = "yr" ; + fates_turnover_fnrt:long_name = "root longevity (alternatively, turnover time)" ; + double fates_turnover_leaf_canopy(fates_leafage_class, fates_pft) ; + fates_turnover_leaf_canopy:units = "yr" ; + fates_turnover_leaf_canopy:long_name = "Leaf longevity (ie turnover timescale) of canopy plants. For drought-deciduous PFTs, this also indicates the maximum length of the growing (i.e., leaves on) season." ; + double fates_turnover_leaf_ustory(fates_leafage_class, fates_pft) ; + fates_turnover_leaf_ustory:units = "yr" ; + fates_turnover_leaf_ustory:long_name = "Leaf longevity (ie turnover timescale) of understory plants." ; + double fates_turnover_senleaf_fdrought(fates_pft) ; + fates_turnover_senleaf_fdrought:units = "unitless[0-1]" ; + fates_turnover_senleaf_fdrought:long_name = "multiplication factor for leaf longevity of senescent leaves during drought" ; + double fates_wood_density(fates_pft) ; + fates_wood_density:units = "g/cm3" ; + fates_wood_density:long_name = "mean density of woody tissue in plant" ; + double fates_woody(fates_pft) ; + fates_woody:units = "logical flag" ; + fates_woody:long_name = "Binary woody lifeform flag" ; + double fates_hlm_pft_map(fates_hlm_pftno, fates_pft) ; + fates_hlm_pft_map:units = "area fraction" ; + fates_hlm_pft_map:long_name = "In fixed biogeog mode, fraction of HLM area associated with each FATES PFT" ; + double fates_fire_FBD(fates_litterclass) ; + fates_fire_FBD:units = "kg Biomass/m3" ; + fates_fire_FBD:long_name = "fuel bulk density" ; + double fates_fire_low_moisture_Coeff(fates_litterclass) ; + fates_fire_low_moisture_Coeff:units = "NA" ; + fates_fire_low_moisture_Coeff:long_name = "spitfire parameter, equation B1 Thonicke et al 2010" ; + double fates_fire_low_moisture_Slope(fates_litterclass) ; + fates_fire_low_moisture_Slope:units = "NA" ; + fates_fire_low_moisture_Slope:long_name = "spitfire parameter, equation B1 Thonicke et al 2010" ; + double fates_fire_mid_moisture(fates_litterclass) ; + fates_fire_mid_moisture:units = "NA" ; + fates_fire_mid_moisture:long_name = "spitfire litter moisture threshold to be considered medium dry" ; + double fates_fire_mid_moisture_Coeff(fates_litterclass) ; + fates_fire_mid_moisture_Coeff:units = "NA" ; + fates_fire_mid_moisture_Coeff:long_name = "spitfire parameter, equation B1 Thonicke et al 2010" ; + double fates_fire_mid_moisture_Slope(fates_litterclass) ; + fates_fire_mid_moisture_Slope:units = "NA" ; + fates_fire_mid_moisture_Slope:long_name = "spitfire parameter, equation B1 Thonicke et al 2010" ; + double fates_fire_min_moisture(fates_litterclass) ; + fates_fire_min_moisture:units = "NA" ; + fates_fire_min_moisture:long_name = "spitfire litter moisture threshold to be considered very dry" ; + double fates_fire_SAV(fates_litterclass) ; + fates_fire_SAV:units = "cm-1" ; + fates_fire_SAV:long_name = "fuel surface area to volume ratio" ; + double fates_frag_maxdecomp(fates_litterclass) ; + fates_frag_maxdecomp:units = "yr-1" ; + fates_frag_maxdecomp:long_name = "maximum rate of litter & CWD transfer from non-decomposing class into decomposing class" ; + double fates_frag_cwd_frac(fates_NCWD) ; + fates_frag_cwd_frac:units = "fraction" ; + fates_frag_cwd_frac:long_name = "fraction of woody (bdead+bsw) biomass destined for CWD pool" ; + double fates_landuse_crop_lu_pft_vector(fates_landuseclass) ; + fates_landuse_crop_lu_pft_vector:units = "NA" ; + fates_landuse_crop_lu_pft_vector:long_name = "the FATES PFT index to use on a given crop land-use type (dummy value of -999 for non-crop types)" ; + double fates_landuse_grazing_rate(fates_landuseclass) ; + fates_landuse_grazing_rate:units = "1/day" ; + fates_landuse_grazing_rate:long_name = "fraction of leaf biomass consumed by grazers per day" ; + double fates_max_nocomp_pfts_by_landuse(fates_landuseclass) ; + fates_max_nocomp_pfts_by_landuse:units = "count" ; + fates_max_nocomp_pfts_by_landuse:long_name = "maximum number of nocomp PFTs on each land use type (only used in nocomp mode)" ; + double fates_maxpatches_by_landuse(fates_landuseclass) ; + fates_maxpatches_by_landuse:units = "count" ; + fates_maxpatches_by_landuse:long_name = "maximum number of patches per site on each land use type" ; + double fates_canopy_closure_thresh ; + fates_canopy_closure_thresh:units = "unitless" ; + fates_canopy_closure_thresh:long_name = "tree canopy coverage at which crown area allometry changes from savanna to forest value" ; + double fates_cnp_eca_plant_escalar ; + fates_cnp_eca_plant_escalar:units = "" ; + fates_cnp_eca_plant_escalar:long_name = "scaling factor for plant fine root biomass to calculate nutrient carrier enzyme abundance (ECA)" ; + double fates_cohort_age_fusion_tol ; + fates_cohort_age_fusion_tol:units = "unitless" ; + fates_cohort_age_fusion_tol:long_name = "minimum fraction in differece in cohort age between cohorts." ; + double fates_cohort_size_fusion_tol ; + fates_cohort_size_fusion_tol:units = "unitless" ; + fates_cohort_size_fusion_tol:long_name = "minimum fraction in difference in dbh between cohorts" ; + double fates_comp_excln ; + fates_comp_excln:units = "none" ; + fates_comp_excln:long_name = "IF POSITIVE: weighting factor (exponent on dbh) for canopy layer exclusion and promotion, IF NEGATIVE: switch to use deterministic height sorting" ; + double fates_damage_canopy_layer_code ; + fates_damage_canopy_layer_code:units = "unitless" ; + fates_damage_canopy_layer_code:long_name = "Integer code that decides whether damage affects canopy trees (1), understory trees (2)" ; + double fates_damage_event_code ; + fates_damage_event_code:units = "unitless" ; + fates_damage_event_code:long_name = "Integer code that options how damage events are structured" ; + double fates_dev_arbitrary ; + fates_dev_arbitrary:units = "unknown" ; + fates_dev_arbitrary:long_name = "Unassociated free parameter that developers can use for testing arbitrary new hypotheses" ; + double fates_fire_active_crown_fire ; + fates_fire_active_crown_fire:units = "0 or 1" ; + fates_fire_active_crown_fire:long_name = "flag, 1=active crown fire 0=no active crown fire" ; + double fates_fire_cg_strikes ; + fates_fire_cg_strikes:units = "fraction (0-1)" ; + fates_fire_cg_strikes:long_name = "fraction of cloud to ground lightning strikes" ; + double fates_fire_drying_ratio ; + fates_fire_drying_ratio:units = "NA" ; + fates_fire_drying_ratio:long_name = "spitfire parameter, fire drying ratio for fuel moisture, alpha_FMC EQ 6 Thonicke et al 2010" ; + double fates_fire_durat_slope ; + fates_fire_durat_slope:units = "NA" ; + fates_fire_durat_slope:long_name = "spitfire parameter, fire max duration slope, Equation 14 Thonicke et al 2010" ; + double fates_fire_fdi_alpha ; + fates_fire_fdi_alpha:units = "NA" ; + fates_fire_fdi_alpha:long_name = "spitfire parameter, EQ 7 Venevsky et al. GCB 2002,(modified EQ 8 Thonicke et al. 2010) " ; + double fates_fire_fuel_energy ; + fates_fire_fuel_energy:units = "kJ/kg" ; + fates_fire_fuel_energy:long_name = "spitfire parameter, heat content of fuel" ; + double fates_fire_max_durat ; + fates_fire_max_durat:units = "minutes" ; + fates_fire_max_durat:long_name = "spitfire parameter, fire maximum duration, Equation 14 Thonicke et al 2010" ; + double fates_fire_miner_damp ; + fates_fire_miner_damp:units = "NA" ; + fates_fire_miner_damp:long_name = "spitfire parameter, mineral-dampening coefficient EQ A1 Thonicke et al 2010 " ; + double fates_fire_miner_total ; + fates_fire_miner_total:units = "fraction" ; + fates_fire_miner_total:long_name = "spitfire parameter, total mineral content, Table A1 Thonicke et al 2010" ; + double fates_fire_nignitions ; + fates_fire_nignitions:units = "ignitions per year per km2" ; + fates_fire_nignitions:long_name = "number of annual ignitions per square km" ; + double fates_fire_part_dens ; + fates_fire_part_dens:units = "kg/m2" ; + fates_fire_part_dens:long_name = "spitfire parameter, oven dry particle density, Table A1 Thonicke et al 2010" ; + double fates_fire_threshold ; + fates_fire_threshold:units = "kW/m" ; + fates_fire_threshold:long_name = "spitfire parameter, fire intensity threshold for tracking fires that spread" ; + double fates_forest_tree_fraction_threshold ; + fates_forest_tree_fraction_threshold:units = "m2/m2" ; + fates_forest_tree_fraction_threshold:long_name = "Tree fraction above which patch is considered 'forest'" ; + double fates_frag_cwd_fcel ; + fates_frag_cwd_fcel:units = "unitless" ; + fates_frag_cwd_fcel:long_name = "Cellulose fraction for CWD" ; + double fates_frag_cwd_flig ; + fates_frag_cwd_flig:units = "unitless" ; + fates_frag_cwd_flig:long_name = "Lignin fraction of coarse woody debris" ; + double fates_hydro_kmax_rsurf1 ; + fates_hydro_kmax_rsurf1:units = "kg water/m2 root area/Mpa/s" ; + fates_hydro_kmax_rsurf1:long_name = "maximum conducitivity for unit root surface (into root)" ; + double fates_hydro_kmax_rsurf2 ; + fates_hydro_kmax_rsurf2:units = "kg water/m2 root area/Mpa/s" ; + fates_hydro_kmax_rsurf2:long_name = "maximum conducitivity for unit root surface (out of root)" ; + double fates_hydro_psi0 ; + fates_hydro_psi0:units = "MPa" ; + fates_hydro_psi0:long_name = "sapwood water potential at saturation" ; + double fates_hydro_psicap ; + fates_hydro_psicap:units = "MPa" ; + fates_hydro_psicap:long_name = "sapwood water potential at which capillary reserves exhausted" ; + double fates_landuse_grazing_carbon_use_eff ; + fates_landuse_grazing_carbon_use_eff:units = "unitless" ; + fates_landuse_grazing_carbon_use_eff:long_name = "carbon use efficiency of material eaten by grazers/browsers (i.e. amount in manure / amount consumed)" ; + double fates_landuse_grazing_maxheight ; + fates_landuse_grazing_maxheight:units = "m" ; + fates_landuse_grazing_maxheight:long_name = "maximum height that grazers (browsers, actually) can reach" ; + double fates_landuse_grazing_nitrogen_use_eff ; + fates_landuse_grazing_nitrogen_use_eff:units = "unitless" ; + fates_landuse_grazing_nitrogen_use_eff:long_name = "nitrogen use efficiency of material eaten by grazers/browsers (i.e. amount in manure / amount consumed)" ; + double fates_landuse_grazing_phosphorus_use_eff ; + fates_landuse_grazing_phosphorus_use_eff:units = "unitless" ; + fates_landuse_grazing_phosphorus_use_eff:long_name = "phosphorus use efficiency of material eaten by grazers/browsers (i.e. amount in manure / amount consumed)" ; + double fates_landuse_logging_coll_under_frac ; + fates_landuse_logging_coll_under_frac:units = "fraction" ; + fates_landuse_logging_coll_under_frac:long_name = "Fraction of stems killed in the understory when logging generates disturbance" ; + double fates_landuse_logging_collateral_frac ; + fates_landuse_logging_collateral_frac:units = "fraction" ; + fates_landuse_logging_collateral_frac:long_name = "Fraction of large stems in upperstory that die from logging collateral damage" ; + double fates_landuse_logging_dbhmax ; + fates_landuse_logging_dbhmax:units = "cm" ; + fates_landuse_logging_dbhmax:long_name = "Maximum dbh below which logging is applied (unset values flag this to be unused)" ; + double fates_landuse_logging_dbhmax_infra ; + fates_landuse_logging_dbhmax_infra:units = "cm" ; + fates_landuse_logging_dbhmax_infra:long_name = "Tree diameter, above which infrastructure from logging does not impact damage or mortality." ; + double fates_landuse_logging_dbhmin ; + fates_landuse_logging_dbhmin:units = "cm" ; + fates_landuse_logging_dbhmin:long_name = "Minimum dbh at which logging is applied" ; + double fates_landuse_logging_direct_frac ; + fates_landuse_logging_direct_frac:units = "fraction" ; + fates_landuse_logging_direct_frac:long_name = "Fraction of stems logged directly per event" ; + double fates_landuse_logging_event_code ; + fates_landuse_logging_event_code:units = "unitless" ; + fates_landuse_logging_event_code:long_name = "Integer code that options how logging events are structured" ; + double fates_landuse_logging_export_frac ; + fates_landuse_logging_export_frac:units = "fraction" ; + fates_landuse_logging_export_frac:long_name = "fraction of trunk product being shipped offsite, the leftovers will be left onsite as large CWD" ; + double fates_landuse_logging_mechanical_frac ; + fates_landuse_logging_mechanical_frac:units = "fraction" ; + fates_landuse_logging_mechanical_frac:long_name = "Fraction of stems killed due infrastructure an other mechanical means" ; + double fates_leaf_photo_temp_acclim_thome_time ; + fates_leaf_photo_temp_acclim_thome_time:units = "years" ; + fates_leaf_photo_temp_acclim_thome_time:long_name = "Length of the window for the long-term (i.e. T_home in Kumarathunge et al 2019) exponential moving average (ema) of vegetation temperature used in photosynthesis temperature acclimation (used if fates_leaf_photo_tempsens_model = 2)" ; + double fates_leaf_photo_temp_acclim_timescale ; + fates_leaf_photo_temp_acclim_timescale:units = "days" ; + fates_leaf_photo_temp_acclim_timescale:long_name = "Length of the window for the exponential moving average (ema) of vegetation temperature used in photosynthesis temperature acclimation (used if fates_maintresp_leaf_model=2 or fates_leaf_photo_tempsens_model = 2)" ; + double fates_maintresp_nonleaf_baserate ; + fates_maintresp_nonleaf_baserate:units = "gC/gN/s" ; + fates_maintresp_nonleaf_baserate:long_name = "Base maintenance respiration rate for plant tissues, using Ryan 1991" ; + double fates_maxcohort ; + fates_maxcohort:units = "count" ; + fates_maxcohort:long_name = "maximum number of cohorts per patch. Actual number of cohorts also depend on cohort fusion tolerances" ; + double fates_mort_disturb_frac ; + fates_mort_disturb_frac:units = "fraction" ; + fates_mort_disturb_frac:long_name = "fraction of canopy mortality that results in disturbance (i.e. transfer of area from old to new patch)" ; + double fates_mort_understorey_death ; + fates_mort_understorey_death:units = "fraction" ; + fates_mort_understorey_death:long_name = "fraction of plants in understorey cohort impacted by overstorey tree-fall" ; + double fates_patch_fusion_tol ; + fates_patch_fusion_tol:units = "unitless" ; + fates_patch_fusion_tol:long_name = "minimum fraction in difference in profiles between patches" ; + double fates_phen_chilltemp ; + fates_phen_chilltemp:units = "degrees C" ; + fates_phen_chilltemp:long_name = "chilling day counting threshold for vegetation" ; + double fates_phen_coldtemp ; + fates_phen_coldtemp:units = "degrees C" ; + fates_phen_coldtemp:long_name = "vegetation temperature exceedance that flags a cold-day for leaf-drop" ; + double fates_phen_gddthresh_a ; + fates_phen_gddthresh_a:units = "none" ; + fates_phen_gddthresh_a:long_name = "GDD accumulation function, intercept parameter: gdd_thesh = a + b exp(c*ncd)" ; + double fates_phen_gddthresh_b ; + fates_phen_gddthresh_b:units = "none" ; + fates_phen_gddthresh_b:long_name = "GDD accumulation function, multiplier parameter: gdd_thesh = a + b exp(c*ncd)" ; + double fates_phen_gddthresh_c ; + fates_phen_gddthresh_c:units = "none" ; + fates_phen_gddthresh_c:long_name = "GDD accumulation function, exponent parameter: gdd_thesh = a + b exp(c*ncd)" ; + double fates_phen_mindayson ; + fates_phen_mindayson:units = "days" ; + fates_phen_mindayson:long_name = "day threshold compared against days since leaves became on-allometry" ; + double fates_phen_ncolddayslim ; + fates_phen_ncolddayslim:units = "days" ; + fates_phen_ncolddayslim:long_name = "day threshold exceedance for temperature leaf-drop" ; + double fates_q10_froz ; + fates_q10_froz:units = "unitless" ; + fates_q10_froz:long_name = "Q10 for frozen-soil respiration rates" ; + double fates_q10_mr ; + fates_q10_mr:units = "unitless" ; + fates_q10_mr:long_name = "Q10 for maintenance respiration" ; + double fates_rxfire_AB ; + fates_rxfire_AB:units = "fraction/day" ; + fates_rxfire_AB:long_name = "daily burn capacity of prescribed fire" ; + double fates_rxfire_fuel_max ; + fates_rxfire_fuel_max:units = "kgC/m2" ; + fates_rxfire_fuel_max:long_name = "maximum fuel load at or above which prescribed fire is disallowed" ; + double fates_rxfire_fuel_min ; + fates_rxfire_fuel_min:units = "kgC/m2" ; + fates_rxfire_fuel_min:long_name = "minimum fuel load at or below which prescribed fire is disallowed" ; + double fates_rxfire_max_threshold ; + fates_rxfire_max_threshold:units = "kJ/m/s or kW/m" ; + fates_rxfire_max_threshold:long_name = "maximum energy threshold at or above which prescribed fire is disallowed" ; + double fates_rxfire_min_frac ; + fates_rxfire_min_frac:units = "fraction" ; + fates_rxfire_min_frac:long_name = "minimum fraction of land needs to be burnable to allow rx fire" ; + double fates_rxfire_min_threshold ; + fates_rxfire_min_threshold:units = "kJ/m/s or kW/m" ; + fates_rxfire_min_threshold:long_name = "minimum energy threshold at or above which prescribed fire is disallowed" ; + double fates_rxfire_rh_lwthreshold ; + fates_rxfire_rh_lwthreshold:units = "%" ; + fates_rxfire_rh_lwthreshold:long_name = "minimum relative humidity threshold below which prescribed fire is disallowed" ; + double fates_rxfire_rh_upthreshold ; + fates_rxfire_rh_upthreshold:units = "%" ; + fates_rxfire_rh_upthreshold:long_name = "maximum relative humidity threshold above which prescribed fire is disallowed" ; + double fates_rxfire_temp_lwthreshold ; + fates_rxfire_temp_lwthreshold:units = "degree C" ; + fates_rxfire_temp_lwthreshold:long_name = "minimum temprature threshold below which prescribed fire is disallowed" ; + double fates_rxfire_temp_upthreshold ; + fates_rxfire_temp_upthreshold:units = "degree C" ; + fates_rxfire_temp_upthreshold:long_name = "maximum temprature threshold above which prescribed fire is disallowed" ; + double fates_rxfire_wind_lwthreshold ; + fates_rxfire_wind_lwthreshold:units = "%" ; + fates_rxfire_wind_lwthreshold:long_name = "minimum wind speed threshold below which prescribed fire is disallowed" ; + double fates_rxfire_wind_upthreshold ; + fates_rxfire_wind_upthreshold:units = "%" ; + fates_rxfire_wind_upthreshold:long_name = "maximum wind speed threshold above which prescribed fire is disallowed" ; + double fates_soil_salinity ; + fates_soil_salinity:units = "ppt" ; + fates_soil_salinity:long_name = "soil salinity used for model when not coupled to dynamic soil salinity" ; + double fates_trs_seedling2sap_par_timescale ; + fates_trs_seedling2sap_par_timescale:units = "days" ; + fates_trs_seedling2sap_par_timescale:long_name = "Length of the window for the exponential moving average of par at the seedling layer used to calculate seedling to sapling transition rates" ; + double fates_trs_seedling_emerg_h2o_timescale ; + fates_trs_seedling_emerg_h2o_timescale:units = "days" ; + fates_trs_seedling_emerg_h2o_timescale:long_name = "Length of the window for the exponential moving average of smp used to calculate seedling emergence" ; + double fates_trs_seedling_mdd_timescale ; + fates_trs_seedling_mdd_timescale:units = "days" ; + fates_trs_seedling_mdd_timescale:long_name = "Length of the window for the exponential moving average of moisture deficit days used to calculate seedling mortality" ; + double fates_trs_seedling_mort_par_timescale ; + fates_trs_seedling_mort_par_timescale:units = "days" ; + fates_trs_seedling_mort_par_timescale:long_name = "Length of the window for the exponential moving average of par at the seedling layer used to calculate seedling mortality" ; + double fates_vai_top_bin_width ; + fates_vai_top_bin_width:units = "m2/m2" ; + fates_vai_top_bin_width:long_name = "width in VAI units of uppermost leaf+stem layer scattering element in each canopy layer" ; + double fates_vai_width_increase_factor ; + fates_vai_width_increase_factor:units = "unitless" ; + fates_vai_width_increase_factor:long_name = "factor by which each leaf+stem scattering element increases in VAI width (1 = uniform spacing)" ; + +// global attributes: + :history = "This file was generated by BatchPatchParams.py:\nCDL Base File = fates_params_default.cdl\nXML patch file = archive/api36.1.0_100224_pr1255-2.xml" ; +data: + + fates_history_ageclass_bin_edges = 0, 1, 2, 5, 10, 20, 50 ; + + fates_history_coageclass_bin_edges = 0, 5 ; + + fates_history_height_bin_edges = 0, 0.1, 0.3, 1, 3, 10 ; + + fates_history_damage_bin_edges = 0, 80 ; + + fates_history_sizeclass_bin_edges = 0, 5, 10, 15, 20, 30, 40, 50, 60, 70, + 80, 90, 100 ; + + fates_alloc_organ_id = 1, 2, 3, 6 ; + + fates_hydro_htftype_node = 1, 1, 1, 1 ; + + fates_pftname = + "broadleaf_evergreen_tropical_tree ", + "needleleaf_evergreen_extratrop_tree ", + "needleleaf_colddecid_extratrop_tree ", + "broadleaf_evergreen_extratrop_tree ", + "broadleaf_hydrodecid_tropical_tree ", + "broadleaf_colddecid_extratrop_tree ", + "broadleaf_evergreen_extratrop_shrub ", + "broadleaf_hydrodecid_extratrop_shrub ", + "broadleaf_colddecid_extratrop_shrub ", + " broadleaf_evergreen_arctic_shrub ", + " broadleaf_colddecid_arctic_shrub ", + "arctic_c3_grass ", + "cool_c3_grass ", + "c4_grass " ; + + fates_hydro_organ_name = + "leaf ", + "stem ", + "transporting root ", + "absorbing root " ; + + fates_alloc_organ_name = + "leaf", + "fine root", + "sapwood", + "structure" ; + + fates_landuseclass_name = + "primaryland", + "secondaryland", + "rangeland", + "pastureland", + "cropland" ; + + fates_litterclass_name = + "twig ", + "small branch ", + "large branch ", + "trunk ", + "dead leaves ", + "live grass " ; + + fates_alloc_organ_priority = + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, + 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4 ; + + fates_alloc_storage_cushion = 1.2, 1.2, 1.2, 1.2, 2.4, 1.2, 1.2, 2.4, 1.2, + 1.5, 1.4, 1.2, 1.2, 1.2 ; + + fates_alloc_store_priority_frac = 0.8, 0.8, 0.8, 0.8, 0.8, 0.8, 0.8, 0.8, + 0.8, 0.7, 0.6, 0.6, 0.8, 0.8 ; + + fates_allom_agb1 = 0.0673, 0.1364012, 0.0393057, 0.2653695, 0.0673, + 0.0728698, 0.06896, 0.06896, 0.06896, 0.06896, 0.06896, 0.001, 0.001, + 0.003 ; + + fates_allom_agb2 = 0.976, 0.9449041, 1.087335, 0.8321321, 0.976, 1.0373211, + 0.572, 0.572, 0.572, 0.5289883, 0.6853945, 1.6592, 1.6592, 1.3456 ; + + fates_allom_agb3 = 1.94, 1.94, 1.94, 1.94, 1.94, 1.94, 1.94, 1.94, 1.94, + 2.1010352, 1.7628613, 1.248, 1.248, 1.869 ; + + fates_allom_agb4 = 0.931, 0.931, 0.931, 0.931, 0.931, 0.931, 0.931, 0.931, + 0.931, 0.931, 0.931, -999.9, -999.9, -999.9 ; + + fates_allom_agb_frac = 0.6, 0.6, 0.6, 0.6, 0.6, 0.6, 0.6, 0.6, 0.6, 0.6, + 0.6, 1, 1, 1 ; + + fates_allom_amode = 3, 3, 3, 3, 3, 3, 1, 1, 1, 1, 1, 5, 5, 5 ; + + fates_allom_blca_expnt_diff = -0.12, -0.34, -0.32, -0.22, -0.12, -0.35, 0, + 0, 0, 0, 0, -0.487, -0.487, -0.259 ; + + fates_allom_cmode = 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 ; + + fates_allom_d2bl1 = 0.04, 0.07, 0.07, 0.01, 0.04, 0.07, 0.07, 0.07, 0.07, + 0.0481934, 0.0481934, 0.0004, 0.0004, 0.0012 ; + + fates_allom_d2bl2 = 1.6019679, 1.5234373, 1.3051237, 1.9621397, 1.6019679, + 1.3998939, 1.3, 1.3, 1.3, 1.0600586, 1.7176758, 1.7092, 1.7092, 1.5879 ; + + fates_allom_d2bl3 = 0.55, 0.55, 0.55, 0.55, 0.55, 0.55, 0.55, 0.55, 0.55, + 0.55, 0.55, 0.3417, 0.3417, 0.9948 ; + + fates_allom_d2ca_coefficient_max = 0.2715891, 0.3693718, 1.0787259, + 0.0579297, 0.2715891, 1.1553612, 0.6568464, 0.6568464, 0.6568464, + 0.4363427, 0.3166497, 0.0408, 0.0408, 0.0862 ; + + fates_allom_d2ca_coefficient_min = 0.2715891, 0.3693718, 1.0787259, + 0.0579297, 0.2715891, 1.1553612, 0.6568464, 0.6568464, 0.6568464, + 0.4363427, 0.3166497, 0.0408, 0.0408, 0.0862 ; + + fates_allom_d2h1 = 78.4087704, 306.842667, 106.8745821, 104.3586841, + 78.4087704, 31.4557047, 0.64, 0.64, 0.64, 0.8165625, 0.778125, 0.1812, + 0.1812, 0.3353 ; + + fates_allom_d2h2 = 0.8124383, 0.752377, 0.9471302, 1.1146973, 0.8124383, + 0.9734088, 0.37, 0.37, 0.37, 0.2316113, 0.4027002, 0.6384, 0.6384, 0.4235 ; + + fates_allom_d2h3 = 47.6666164, 196.6865691, 93.9790461, 160.6835089, + 47.6666164, 16.5928174, -999.9, -999.9, -999.9, -999.9, -999.9, -999.9, + -999.9, -999.9 ; + + fates_allom_dbh_maxheight = 1000, 1000, 1000, 1000, 1000, 1000, 3, 3, 2, + 2.4, 1.9, 20, 20, 30 ; + + fates_allom_dmode = 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 ; + + fates_allom_fmode = 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 ; + + fates_allom_fnrt_prof_a = 7, 7, 7, 7, 6, 6, 7, 7, 7, 7, 7, 11, 11, 11 ; + + fates_allom_fnrt_prof_b = 1, 2, 2, 1, 2, 2, 1.5, 1.5, 1.5, 1.5, 1.5, 2, 2, 2 ; + + fates_allom_fnrt_prof_mode = 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3 ; + + fates_allom_frbstor_repro = 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 ; + + fates_allom_h2cd1 = 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.95, 0.95, 0.95, 0.95, + 0.95, 1, 1, 1 ; + + fates_allom_h2cd2 = 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 ; + + fates_allom_hmode = 5, 5, 5, 5, 5, 5, 1, 1, 1, 1, 1, 3, 3, 3 ; + + fates_allom_l2fr = 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0.67, 0.67, 1.41 ; + + fates_allom_la_per_sa_int = 0.8, 0.8, 0.8, 0.8, 0.8, 0.8, 0.8, 0.8, 0.8, + 0.8, 0.8, 0.8, 0.8, 0.8 ; + + fates_allom_la_per_sa_slp = 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 ; + + fates_allom_lmode = 2, 2, 2, 2, 2, 2, 1, 1, 1, 1, 1, 5, 5, 5 ; + + fates_allom_sai_scaler = 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, + 0.1, 0.1, 0.1, 0.1 ; + + fates_allom_smode = 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 2, 2, 2 ; + + fates_allom_stmode = 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 ; + + fates_allom_zroot_k = 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10 ; + + fates_allom_zroot_max_dbh = 100, 100, 100, 100, 100, 100, 2, 2, 2, 2, 2, 2, + 2, 2 ; + + fates_allom_zroot_max_z = 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, + 100, 100, 100, 100 ; + + fates_allom_zroot_min_dbh = 1, 1, 1, 2.5, 2.5, 2.5, 0.1, 0.1, 0.1, 0.1, 0.1, + 0.1, 0.1, 0.1 ; + + fates_allom_zroot_min_z = 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, + 100, 100, 100, 100 ; + + fates_c2b = 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2 ; + + fates_cnp_eca_alpha_ptase = 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 ; + + fates_cnp_eca_decompmicc = 280, 280, 280, 280, 280, 280, 280, 280, 280, 280, + 280, 280, 280, 280 ; + + fates_cnp_eca_km_nh4 = 0.14, 0.14, 0.14, 0.14, 0.14, 0.14, 0.14, 0.14, 0.14, + 0.14, 0.14, 0.14, 0.14, 0.14 ; + + fates_cnp_eca_km_no3 = 0.27, 0.27, 0.27, 0.27, 0.27, 0.27, 0.27, 0.27, 0.27, + 0.27, 0.27, 0.27, 0.27, 0.27 ; + + fates_cnp_eca_km_p = 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, + 0.1, 0.1, 0.1 ; + + fates_cnp_eca_km_ptase = 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 ; + + fates_cnp_eca_lambda_ptase = 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 ; + + fates_cnp_eca_vmax_ptase = 5e-09, 5e-09, 5e-09, 5e-09, 5e-09, 5e-09, 5e-09, + 5e-09, 5e-09, 5e-09, 5e-09, 5e-09, 5e-09, 5e-09 ; + + fates_cnp_nfix1 = 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 ; + + fates_cnp_nitr_store_ratio = 1.5, 1.5, 1.5, 1.5, 1.5, 1.5, 1.5, 1.5, 1.5, + 1.5, 1.5, 1.5, 1.5, 1.5 ; + + fates_cnp_phos_store_ratio = 1.5, 1.5, 1.5, 1.5, 1.5, 1.5, 1.5, 1.5, 1.5, + 1.5, 1.5, 1.5, 1.5, 1.5 ; + + fates_cnp_pid_kd = 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, + 0.1, 0.1, 0.1 ; + + fates_cnp_pid_ki = 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 ; + + fates_cnp_pid_kp = 0.0005, 0.0005, 0.0005, 0.0005, 0.0005, 0.0005, 0.0005, + 0.0005, 0.0005, 0.0005, 0.0005, 0.0005, 0.0005, 0.0005 ; + + fates_cnp_prescribed_nuptake = 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 ; + + fates_cnp_prescribed_puptake = 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 ; + + fates_cnp_store_ovrflw_frac = 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 ; + + fates_cnp_turnover_nitr_retrans = + 0.25, 0.25, 0.25, 0.25, 0.25, 0.25, 0.25, 0.25, 0.25, 0.25, 0.25, 0.25, + 0.25, 0.25, + 0.25, 0.25, 0.25, 0.25, 0.25, 0.25, 0.25, 0.25, 0.25, 0.25, 0.25, 0.25, + 0.25, 0.25, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 ; + + fates_cnp_turnover_phos_retrans = + 0.25, 0.25, 0.25, 0.25, 0.25, 0.25, 0.25, 0.25, 0.25, 0.25, 0.25, 0.25, + 0.25, 0.25, + 0.25, 0.25, 0.25, 0.25, 0.25, 0.25, 0.25, 0.25, 0.25, 0.25, 0.25, 0.25, + 0.25, 0.25, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 ; + + fates_cnp_vmax_nh4 = 2.5e-09, 2.5e-09, 2.5e-09, 2.5e-09, 2.5e-09, 2.5e-09, + 2.5e-09, 2.5e-09, 2.5e-09, 2.5e-09, 2.5e-09, 2.5e-09, 2.5e-09, 2.5e-09 ; + + fates_cnp_vmax_no3 = 2.5e-09, 2.5e-09, 2.5e-09, 2.5e-09, 2.5e-09, 2.5e-09, + 2.5e-09, 2.5e-09, 2.5e-09, 2.5e-09, 2.5e-09, 2.5e-09, 2.5e-09, 2.5e-09 ; + + fates_cnp_vmax_p = 5e-10, 5e-10, 5e-10, 5e-10, 5e-10, 5e-10, 5e-10, 5e-10, + 5e-10, 5e-10, 5e-10, 5e-10, 5e-10, 5e-10 ; + + fates_damage_frac = 0.01, 0.01, 0.01, 0.01, 0.01, 0.01, 0.01, 0.01, 0.01, + 0.01, 0.01, 0.01, 0.01, 0.01 ; + + fates_damage_mort_p1 = 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9 ; + + fates_damage_mort_p2 = 5.5, 5.5, 5.5, 5.5, 5.5, 5.5, 5.5, 5.5, 5.5, 5.5, + 5.5, 5.5, 5.5, 5.5 ; + + fates_damage_recovery_scalar = 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 ; + + fates_dev_arbitrary_pft = _, _, _, _, _, _, _, _, _, _, _, _, _, _ ; + + fates_edgeforest_gaussian_amplitude = 0.37033665947126704, 0.25548576693720165, _, _, _, _ ; + + fates_edgeforest_gaussian_sigma = 0.4329573815987602, 0.42239011110175917, _, _, _, _ ; + + fates_edgeforest_gaussian_center = -0.35596450526414164, -0.28183332150023604, _, _, _, _ ; + + fates_edgeforest_lognormal_amplitude = _, _, _, _, _, 14.283227336273354 ; + + fates_edgeforest_lognormal_sigma = _, _, _, _, _, 1.26210031507715 ; + + fates_edgeforest_lognormal_center = _, _, _, _, _, 2.1958393621871597 ; + + fates_edgeforest_quadratic_a = _, _, 0.2549551300197741, 0.07685044819893726, 0.035189070666016925, _ ; + + fates_edgeforest_quadratic_b = _, _, -0.5457222474679617, -0.19438641157435982, -0.300528731650077, _ ; + + fates_edgeforest_quadratic_c = _, _, 0.29299184857665717, 0.11825507562859365, 0.2669694066063096, _ ; + + fates_edgeforest_fireweather_rh_mult = 1, 1, 1, 1, 1, 1 ; + + fates_edgeforest_fireweather_temp_C_mult = 1, 1, 1, 1, 1, 1 ; + + fates_edgeforest_fireweather_wind_mult = 1.11, 1.11, 1.11, 1.11, 1.11, 1 ; + + fates_edgeforest_fireweather_rh_add = -30, -30, -30, -30, -30, 0 ; + + fates_edgeforest_fireweather_temp_C_add = 2, 2, 2, 2, 2, 0 ; + + fates_edgeforest_fireweather_wind_add = 0, 0, 0, 0, 0, 0 ; + + fates_edgeforest_bin_edges = 0, 30, 60, 120, 150, 300 ; + + fates_fire_alpha_SH = 0.2, 0.2, 0.2, 0.2, 0.2, 0.2, 0.2, 0.2, 0.2, 0.2, 0.2, + 0.2, 0.2, 0.2 ; + + fates_fire_bark_scaler = 0.07, 0.07, 0.07, 0.07, 0.07, 0.07, 0.07, 0.07, + 0.07, 0.07, 0.07, 0.07, 0.07, 0.07 ; + + fates_fire_crown_kill = 0.775, 0.775, 0.775, 0.775, 0.775, 0.775, 0.775, + 0.775, 0.775, 0.775, 0.775, 0.775, 0.775, 0.775 ; + + fates_frag_fnrt_fcel = 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, + 0.5, 0.5, 0.5, 0.5 ; + + fates_frag_fnrt_flab = 0.25, 0.25, 0.25, 0.25, 0.25, 0.25, 0.25, 0.25, 0.25, + 0.25, 0.25, 0.25, 0.25, 0.25 ; + + fates_frag_fnrt_flig = 0.25, 0.25, 0.25, 0.25, 0.25, 0.25, 0.25, 0.25, 0.25, + 0.25, 0.25, 0.25, 0.25, 0.25 ; + + fates_frag_leaf_fcel = 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, + 0.5, 0.5, 0.5, 0.5 ; + + fates_frag_leaf_flab = 0.25, 0.25, 0.25, 0.25, 0.25, 0.25, 0.25, 0.25, 0.25, + 0.25, 0.25, 0.25, 0.25, 0.25 ; + + fates_frag_leaf_flig = 0.25, 0.25, 0.25, 0.25, 0.25, 0.25, 0.25, 0.25, 0.25, + 0.25, 0.25, 0.25, 0.25, 0.25 ; + + fates_frag_seed_decay_rate = 0.51, 0.51, 0.51, 0.51, 0.51, 0.51, 0.51, 0.51, + 0.51, 0.74, 0.46, 0.35, 0.51, 0.51 ; + + fates_grperc = 0.11, 0.11, 0.11, 0.11, 0.11, 0.11, 0.11, 0.11, 0.11, 0.12, + 0.11, 0.16, 0.11, 0.11 ; + + fates_hydro_avuln_gs = 2.5, 2.5, 2.5, 2.5, 2.5, 2.5, 2.5, 2.5, 2.5, 2.5, + 2.5, 2.5, 2.5, 2.5 ; + + fates_hydro_avuln_node = + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2 ; + + fates_hydro_epsil_node = + 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, + 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, + 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, + 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8 ; + + fates_hydro_fcap_node = + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0.08, 0.08, 0.08, 0.08, 0.08, 0.08, 0.08, 0.08, 0.08, 0.08, 0.08, 0.08, + 0.08, 0.08, + 0.08, 0.08, 0.08, 0.08, 0.08, 0.08, 0.08, 0.08, 0.08, 0.08, 0.08, 0.08, + 0.08, 0.08, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 ; + + fates_hydro_k_lwp = 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 ; + + fates_hydro_kmax_node = + -999, -999, -999, -999, -999, -999, -999, -999, -999, -999, -999, -999, + -999, -999, + 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, + -999, -999, -999, -999, -999, -999, -999, -999, -999, -999, -999, -999, + -999, -999, + -999, -999, -999, -999, -999, -999, -999, -999, -999, -999, -999, -999, + -999, -999 ; + + fates_hydro_p50_gs = -1.5, -1.5, -1.5, -1.5, -1.5, -1.5, -1.5, -1.5, -1.5, + -1.5, -1.5, -1.5, -1.5, -1.5 ; + + fates_hydro_p50_node = + -2.25, -2.25, -2.25, -2.25, -2.25, -2.25, -2.25, -2.25, -2.25, -2.25, + -2.25, -2.25, -2.25, -2.25, + -2.25, -2.25, -2.25, -2.25, -2.25, -2.25, -2.25, -2.25, -2.25, -2.25, + -2.25, -2.25, -2.25, -2.25, + -2.25, -2.25, -2.25, -2.25, -2.25, -2.25, -2.25, -2.25, -2.25, -2.25, + -2.25, -2.25, -2.25, -2.25, + -2.25, -2.25, -2.25, -2.25, -2.25, -2.25, -2.25, -2.25, -2.25, -2.25, + -2.25, -2.25, -2.25, -2.25 ; + + fates_hydro_p_taper = 0.333, 0.333, 0.333, 0.333, 0.333, 0.333, 0.333, + 0.333, 0.333, 0.333, 0.333, 0.333, 0.333, 0.333 ; + + fates_hydro_pinot_node = + -1.465984, -1.465984, -1.465984, -1.465984, -1.465984, -1.465984, + -1.465984, -1.465984, -1.465984, -1.465984, -1.465984, -1.465984, + -1.465984, -1.465984, + -1.22807, -1.22807, -1.22807, -1.22807, -1.22807, -1.22807, -1.22807, + -1.22807, -1.22807, -1.22807, -1.22807, -1.22807, -1.22807, -1.22807, + -1.22807, -1.22807, -1.22807, -1.22807, -1.22807, -1.22807, -1.22807, + -1.22807, -1.22807, -1.22807, -1.22807, -1.22807, -1.22807, -1.22807, + -1.043478, -1.043478, -1.043478, -1.043478, -1.043478, -1.043478, + -1.043478, -1.043478, -1.043478, -1.043478, -1.043478, -1.043478, + -1.043478, -1.043478 ; + + fates_hydro_pitlp_node = + -1.67, -1.67, -1.67, -1.67, -1.67, -1.67, -1.67, -1.67, -1.67, -1.67, + -1.67, -1.67, -1.67, -1.67, + -1.4, -1.4, -1.4, -1.4, -1.4, -1.4, -1.4, -1.4, -1.4, -1.4, -1.4, -1.4, + -1.4, -1.4, + -1.4, -1.4, -1.4, -1.4, -1.4, -1.4, -1.4, -1.4, -1.4, -1.4, -1.4, -1.4, + -1.4, -1.4, + -1.2, -1.2, -1.2, -1.2, -1.2, -1.2, -1.2, -1.2, -1.2, -1.2, -1.2, -1.2, + -1.2, -1.2 ; + + fates_hydro_resid_node = + 0.16, 0.16, 0.16, 0.16, 0.16, 0.16, 0.16, 0.16, 0.16, 0.16, 0.16, 0.16, + 0.16, 0.16, + 0.21, 0.21, 0.21, 0.21, 0.21, 0.21, 0.21, 0.21, 0.21, 0.21, 0.21, 0.21, + 0.21, 0.21, + 0.21, 0.21, 0.21, 0.21, 0.21, 0.21, 0.21, 0.21, 0.21, 0.21, 0.21, 0.21, + 0.21, 0.21, + 0.11, 0.11, 0.11, 0.11, 0.11, 0.11, 0.11, 0.11, 0.11, 0.11, 0.11, 0.11, + 0.11, 0.11 ; + + fates_hydro_rfrac_stem = 0.625, 0.625, 0.625, 0.625, 0.625, 0.625, 0.625, + 0.625, 0.625, 0.625, 0.625, 0.625, 0.625, 0.625 ; + + fates_hydro_rs2 = 0.0001, 0.0001, 0.0001, 0.0001, 0.0001, 0.0001, 0.0001, + 0.0001, 0.0001, 0.0001, 0.0001, 0.0001, 0.0001, 0.0001 ; + + fates_hydro_srl = 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25 ; + + fates_hydro_thetas_node = + 0.65, 0.65, 0.65, 0.65, 0.65, 0.65, 0.65, 0.65, 0.65, 0.65, 0.65, 0.65, + 0.65, 0.65, + 0.65, 0.65, 0.65, 0.65, 0.65, 0.65, 0.65, 0.65, 0.65, 0.65, 0.65, 0.65, + 0.65, 0.65, + 0.65, 0.65, 0.65, 0.65, 0.65, 0.65, 0.65, 0.65, 0.65, 0.65, 0.65, 0.65, + 0.65, 0.65, + 0.75, 0.75, 0.75, 0.75, 0.75, 0.75, 0.75, 0.75, 0.75, 0.75, 0.75, 0.75, + 0.75, 0.75 ; + + fates_hydro_vg_alpha_node = + 0.12, 0.12, 0.12, 0.12, 0.12, 0.12, 0.12, 0.12, 0.12, 0.12, 0.12, 0.12, + 0.12, 0.12, + 0.12, 0.12, 0.12, 0.12, 0.12, 0.12, 0.12, 0.12, 0.12, 0.12, 0.12, 0.12, + 0.12, 0.12, + 0.12, 0.12, 0.12, 0.12, 0.12, 0.12, 0.12, 0.12, 0.12, 0.12, 0.12, 0.12, + 0.12, 0.12, + 0.12, 0.12, 0.12, 0.12, 0.12, 0.12, 0.12, 0.12, 0.12, 0.12, 0.12, 0.12, + 0.12, 0.12 ; + + fates_hydro_vg_m_node = + 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, + 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, + 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, + 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5 ; + + fates_hydro_vg_n_node = + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2 ; + + fates_landuse_grazing_palatability = 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 1 ; + + fates_landuse_harvest_pprod10 = 1, 0.75, 0.75, 0.75, 1, 0.75, 1, 1, 1, 1, 1, + 1, 1, 1 ; + + fates_landuse_luc_frac_burned = 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, + 0.5, 0.5, 0.5, 0.5, 0.5 ; + + fates_landuse_luc_frac_exported = 0.4, 0.4, 0.4, 0.4, 0.4, 0.4, 0.2, 0.2, + 0.2, 0.2, 0.2, 0, 0, 0 ; + + fates_landuse_luc_pprod10 = 1, 0.75, 0.75, 0.75, 1, 0.75, 1, 1, 1, 1, 1, 1, + 1, 1 ; + + fates_leaf_agross_btran_model = 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 ; + + fates_leaf_c3psn = 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0 ; + + fates_leaf_fnps = 0.15, 0.15, 0.15, 0.15, 0.15, 0.15, 0.15, 0.15, 0.15, + 0.15, 0.15, 0.15, 0.15, 0.15 ; + + fates_leaf_jmaxha = 43540, 43540, 43540, 43540, 43540, 43540, 43540, 43540, + 43540, 43540, 43540, 43540, 43540, 43540 ; + + fates_leaf_jmaxhd = 152040, 152040, 152040, 152040, 152040, 152040, 152040, + 152040, 152040, 152040, 152040, 152040, 152040, 152040 ; + + fates_leaf_jmaxse = 495, 495, 495, 495, 495, 495, 495, 495, 495, 495, 495, + 495, 495, 495 ; + + fates_leaf_slamax = 0.0954, 0.0954, 0.0954, 0.0954, 0.0954, 0.0954, 0.012, + 0.03, 0.03, 0.012, 0.032, 0.05, 0.05, 0.05 ; + + fates_leaf_slatop = 0.012, 0.005, 0.024, 0.009, 0.03, 0.03, 0.012, 0.03, + 0.03, 0.01, 0.032, 0.027, 0.05, 0.05 ; + + fates_leaf_stomatal_btran_model = 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 ; + + fates_leaf_stomatal_intercept = 10000, 10000, 10000, 10000, 10000, 10000, + 10000, 10000, 10000, 10000, 10000, 10000, 10000, 40000 ; + + fates_leaf_stomatal_slope_ballberry = 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8 ; + + fates_leaf_stomatal_slope_medlyn = 4.1, 2.3, 2.3, 4.1, 4.4, 4.4, 4.7, 4.7, + 4.7, 4.7, 4.7, 2.2, 5.3, 1.6 ; + + fates_leaf_vcmax25top = + 50, 62, 39, 61, 58, 58, 62, 54, 54, 38, 54, 86, 78, 78 ; + + fates_leaf_vcmaxha = 65330, 65330, 65330, 65330, 65330, 65330, 65330, 65330, + 65330, 65330, 65330, 65330, 65330, 65330 ; + + fates_leaf_vcmaxhd = 149250, 149250, 149250, 149250, 149250, 149250, 149250, + 149250, 149250, 149250, 149250, 149250, 149250, 149250 ; + + fates_leaf_vcmaxse = 485, 485, 485, 485, 485, 485, 485, 485, 485, 485, 485, + 485, 485, 485 ; + + fates_leafn_vert_scaler_coeff1 = 0.00963, 0.00963, 0.00963, 0.00963, + 0.00963, 0.00963, 0.00963, 0.00963, 0.00963, 0.00963, 0.00963, 0.00963, + 0.00963, 0.00963 ; + + fates_leafn_vert_scaler_coeff2 = 2.43, 2.43, 2.43, 2.43, 2.43, 2.43, 2.43, + 2.43, 2.43, 2.43, 2.43, 2.43, 2.43, 2.43 ; + + fates_maintresp_leaf_atkin2017_baserate = 1.756, 1.4995, 1.4995, 1.756, + 1.756, 1.756, 2.0749, 2.0749, 2.0749, 2.0749, 2.0749, 2.1956, 2.1956, + 2.1956 ; + + fates_maintresp_leaf_ryan1991_baserate = 2.525e-06, 2.525e-06, 2.525e-06, + 2.525e-06, 2.525e-06, 2.525e-06, 2.525e-06, 2.525e-06, 2.525e-06, + 2.525e-06, 2.525e-06, 2.525e-06, 2.525e-06, 2.525e-06 ; + + fates_maintresp_leaf_vert_scaler_coeff1 = 0.00963, 0.00963, 0.00963, + 0.00963, 0.00963, 0.00963, 0.00963, 0.00963, 0.00963, 0.00963, 0.00963, + 0.00963, 0.00963, 0.00963 ; + + fates_maintresp_leaf_vert_scaler_coeff2 = 2.43, 2.43, 2.43, 2.43, 2.43, + 2.43, 2.43, 2.43, 2.43, 2.43, 2.43, 2.43, 2.43, 2.43 ; + + fates_maintresp_reduction_curvature = 0.01, 0.01, 0.01, 0.01, 0.01, 0.01, + 0.01, 0.01, 0.01, 0.01, 0.01, 0.01, 0.01, 0.01 ; + + fates_maintresp_reduction_intercept = 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 ; + + fates_maintresp_reduction_upthresh = 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 ; + + fates_mort_bmort = 0.014, 0.014, 0.014, 0.014, 0.014, 0.014, 0.014, 0.014, + 0.014, 0.016, 0.01, 0.014, 0.014, 0.014 ; + + fates_mort_freezetol = 2.5, -55, -80, -30, 2.5, -80, -60, -10, -80, -71, + -95, -89, -20, 2.5 ; + + fates_mort_hf_flc_threshold = 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, + 0.5, 0.5, 0.5, 0.5, 0.5 ; + + fates_mort_hf_sm_threshold = 1e-06, 1e-06, 1e-06, 1e-06, 1e-06, 1e-06, + 1e-06, 1e-06, 1e-06, 1e-06, 1e-06, 1e-06, 1e-06, 1e-06 ; + + fates_mort_ip_age_senescence = _, _, _, _, _, _, _, _, _, _, _, _, _, _ ; + + fates_mort_ip_size_senescence = _, _, _, _, _, _, _, _, _, _, _, _, _, _ ; + + fates_mort_prescribed_canopy = 0.0194, 0.0194, 0.0194, 0.0194, 0.0194, + 0.0194, 0.0194, 0.0194, 0.0194, 0.0194, 0.0194, 0.0194, 0.0194, 0.0194 ; + + fates_mort_prescribed_understory = 0.025, 0.025, 0.025, 0.025, 0.025, 0.025, + 0.025, 0.025, 0.025, 0.025, 0.025, 0.025, 0.025, 0.025 ; + + fates_mort_r_age_senescence = _, _, _, _, _, _, _, _, _, _, _, _, _, _ ; + + fates_mort_r_size_senescence = _, _, _, _, _, _, _, _, _, _, _, _, _, _ ; + + fates_mort_scalar_coldstress = 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3.5, 2.3, 3, 3 ; + + fates_mort_scalar_cstarvation = 0.6, 0.6, 0.6, 0.6, 0.6, 0.6, 0.6, 0.6, 0.6, + 0.6, 0.57, 0.6, 0.6, 0.6 ; + + fates_mort_scalar_hydrfailure = 0.6, 0.6, 0.6, 0.6, 0.6, 0.6, 0.6, 0.6, 0.6, + 0.6, 0.8, 0.6, 0.6, 0.6 ; + + fates_mort_upthresh_cstarvation = 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 ; + + fates_nonhydro_smpsc = -255000, -255000, -255000, -255000, -255000, -255000, + -255000, -255000, -255000, -255000, -255000, -255000, -255000, -255000 ; + + fates_nonhydro_smpso = -66000, -66000, -66000, -66000, -66000, -66000, + -66000, -66000, -66000, -66000, -66000, -66000, -66000, -66000 ; + + fates_phen_cold_size_threshold = 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 ; + + fates_phen_drought_threshold = -152957.4, -152957.4, -152957.4, -152957.4, + -152957.4, -152957.4, -152957.4, -152957.4, -152957.4, -152957.4, + -152957.4, -152957.4, -152957.4, -152957.4 ; + + fates_phen_flush_fraction = _, _, 0.5, _, 0.5, 0.5, _, 0.5, 0.5, _, 0.5, + 0.5, 0.5, 0.5 ; + + fates_phen_fnrt_drop_fraction = 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 ; + + fates_phen_leaf_habit = 1, 1, 2, 1, 3, 2, 1, 3, 2, 1, 2, 2, 3, 3 ; + + fates_phen_mindaysoff = 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, + 100, 100, 100, 100 ; + + fates_phen_moist_threshold = -122365.9, -122365.9, -122365.9, -122365.9, + -122365.9, -122365.9, -122365.9, -122365.9, -122365.9, -122365.9, + -122365.9, -122365.9, -122365.9, -122365.9 ; + + fates_phen_stem_drop_fraction = 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 ; + + fates_prescribed_npp_canopy = 0.4, 0.4, 0.4, 0.4, 0.4, 0.4, 0.4, 0.4, 0.4, + 0.4, 0.4, 0.4, 0.4, 0.4 ; + + fates_prescribed_npp_understory = 0.03125, 0.03125, 0.03125, 0.03125, + 0.03125, 0.03125, 0.03125, 0.03125, 0.03125, 0.03125, 0.03125, 0.03125, + 0.03125, 0.03125 ; + + fates_rad_leaf_clumping_index = 0.85, 0.85, 0.8, 0.85, 0.85, 0.9, 0.85, 0.9, + 0.9, 0.85, 0.9, 0.75, 0.75, 0.75 ; + + fates_rad_leaf_rhonir = 0.46, 0.41, 0.39, 0.46, 0.41, 0.41, 0.46, 0.41, + 0.41, 0.46, 0.41, 0.28, 0.28, 0.28 ; + + fates_rad_leaf_rhovis = 0.11, 0.09, 0.08, 0.11, 0.08, 0.08, 0.11, 0.08, + 0.08, 0.11, 0.08, 0.05, 0.05, 0.05 ; + + fates_rad_leaf_taunir = 0.33, 0.32, 0.42, 0.33, 0.43, 0.43, 0.33, 0.43, + 0.43, 0.33, 0.43, 0.4, 0.4, 0.4 ; + + fates_rad_leaf_tauvis = 0.06, 0.04, 0.06, 0.06, 0.06, 0.06, 0.06, 0.06, + 0.06, 0.06, 0.06, 0.05, 0.05, 0.05 ; + + fates_rad_leaf_xl = 0.32, 0.01, 0.01, 0.32, 0.2, 0.59, 0.32, 0.59, 0.59, + 0.32, 0.59, -0.23, -0.23, -0.23 ; + + fates_rad_stem_rhonir = 0.49, 0.36, 0.36, 0.49, 0.49, 0.49, 0.49, 0.49, + 0.49, 0.49, 0.49, 0.53, 0.53, 0.53 ; + + fates_rad_stem_rhovis = 0.21, 0.12, 0.12, 0.21, 0.21, 0.21, 0.21, 0.21, + 0.21, 0.21, 0.21, 0.31, 0.31, 0.31 ; + + fates_rad_stem_taunir = 0.001, 0.001, 0.001, 0.001, 0.001, 0.001, 0.001, + 0.001, 0.001, 0.001, 0.001, 0.25, 0.25, 0.25 ; + + fates_rad_stem_tauvis = 0.001, 0.001, 0.001, 0.001, 0.001, 0.001, 0.001, + 0.001, 0.001, 0.001, 0.001, 0.12, 0.12, 0.12 ; + + fates_recruit_height_min = 1.3, 1.3, 1.3, 1.3, 1.3, 1.3, 0.2, 0.2, 0.2, 0.8, + 0.8, 0.11, 0.2, 0.2 ; + + fates_recruit_init_density = 0.2, 0.2, 0.2, 0.2, 0.2, 0.2, 0.2, 0.2, 0.2, + 0.16, 0.2, 0.2, 0.2, 0.2 ; + + fates_recruit_prescribed_rate = 0.02, 0.02, 0.02, 0.02, 0.02, 0.02, 0.02, + 0.02, 0.02, 0.02, 0.02, 0.02, 0.02, 0.02 ; + + fates_recruit_seed_alloc = 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, + 0.07, 0.1, 0, 0, 0 ; + + fates_recruit_seed_alloc_mature = 0, 0, 0, 0, 0, 0, 0.9, 0.9, 0.9, 0.9, 0.9, + 0.25, 0.25, 0.2 ; + + fates_recruit_seed_dbh_repro_threshold = 90, 80, 80, 80, 90, 80, 3, 3, 2, + 2.4, 1.9, 3, 3, 3 ; + + fates_recruit_seed_germination_rate = 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, + 0.5, 0.5, 0.4, 0.49, 0.29, 0.5, 0.5 ; + + fates_recruit_seed_supplement = 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 ; + + fates_seed_dispersal_fraction = _, _, _, _, _, _, _, _, _, _, _, _, _, _ ; + + fates_seed_dispersal_max_dist = _, _, _, _, _, _, _, _, _, _, _, _, _, _ ; + + fates_seed_dispersal_pdf_scale = _, _, _, _, _, _, _, _, _, _, _, _, _, _ ; + + fates_seed_dispersal_pdf_shape = _, _, _, _, _, _, _, _, _, _, _, _, _, _ ; + + fates_stoich_nitr = + 0.033, 0.029, 0.04, 0.033, 0.04, 0.04, 0.033, 0.04, 0.04, 0.033, 0.04, + 0.04, 0.04, 0.04, + 0.024, 0.024, 0.024, 0.024, 0.024, 0.024, 0.024, 0.024, 0.024, 0.024, + 0.024, 0.024, 0.024, 0.024, + 1e-08, 1e-08, 1e-08, 1e-08, 1e-08, 1e-08, 1e-08, 1e-08, 1e-08, 1e-08, + 1e-08, 1e-08, 1e-08, 1e-08, + 0.0047, 0.0047, 0.0047, 0.0047, 0.0047, 0.0047, 0.0047, 0.0047, 0.0047, + 0.0047, 0.0047, 0.0047, 0.0047, 0.0047 ; + + fates_stoich_phos = + 0.0033, 0.0029, 0.004, 0.0033, 0.004, 0.004, 0.0033, 0.004, 0.004, 0.0033, + 0.004, 0.004, 0.004, 0.004, + 0.0024, 0.0024, 0.0024, 0.0024, 0.0024, 0.0024, 0.0024, 0.0024, 0.0024, + 0.0024, 0.0024, 0.0024, 0.0024, 0.0024, + 1e-09, 1e-09, 1e-09, 1e-09, 1e-09, 1e-09, 1e-09, 1e-09, 1e-09, 1e-09, + 1e-09, 1e-09, 1e-09, 1e-09, + 0.00047, 0.00047, 0.00047, 0.00047, 0.00047, 0.00047, 0.00047, 0.00047, + 0.00047, 0.00047, 0.00047, 0.00047, 0.00047, 0.00047 ; + + fates_trim_inc = 0.03, 0.03, 0.03, 0.03, 0.03, 0.03, 0.03, 0.03, 0.03, 0.03, + 0.03, 0.03, 0.03, 0.03 ; + + fates_trim_limit = 0.3, 0.3, 0.3, 0.3, 0.3, 0.3, 0.3, 0.3, 0.3, 0.3, 0.3, + 0.3, 0.3, 0.3 ; + + fates_trs_repro_alloc_a = 0.0049, 0.0049, 0.0049, 0.0049, 0.0049, 0.0049, + 0.0049, 0.0049, 0.0049, 0.0049, 0.0049, 0.0049, 0.0049, 0.0049 ; + + fates_trs_repro_alloc_b = -2.6171, -2.6171, -2.6171, -2.6171, -2.6171, + -2.6171, -2.6171, -2.6171, -2.6171, -2.6171, -2.6171, -2.6171, -2.6171, + -2.6171 ; + + fates_trs_repro_frac_seed = 0.24, 0.24, 0.24, 0.24, 0.24, 0.24, 0.24, 0.24, + 0.24, 0.24, 0.24, 0.24, 0.24, 0.24 ; + + fates_trs_seedling_a_emerg = 0.0003, 0.0003, 0.0003, 0.0003, 0.0003, 0.0003, + 0.0003, 0.0003, 0.0003, 0.0003, 0.0003, 0.0003, 0.0003, 0.0003 ; + + fates_trs_seedling_b_emerg = 1.2, 1.2, 1.2, 1.2, 1.2, 1.2, 1.2, 1.2, 1.2, + 1.2, 1.2, 1.2, 1.2, 1.2 ; + + fates_trs_seedling_background_mort = 0.1085371, 0.1085371, 0.1085371, + 0.1085371, 0.1085371, 0.1085371, 0.1085371, 0.1085371, 0.1085371, + 0.1085371, 0.1085371, 0.1085371, 0.1085371, 0.1085371 ; + + fates_trs_seedling_h2o_mort_a = 4.070565e-17, 4.070565e-17, 4.070565e-17, + 4.070565e-17, 4.070565e-17, 4.070565e-17, 4.070565e-17, 4.070565e-17, + 4.070565e-17, 4.070565e-17, 4.070565e-17, 4.070565e-17, 4.070565e-17, + 4.070565e-17 ; + + fates_trs_seedling_h2o_mort_b = -6.390757e-11, -6.390757e-11, -6.390757e-11, + -6.390757e-11, -6.390757e-11, -6.390757e-11, -6.390757e-11, + -6.390757e-11, -6.390757e-11, -6.390757e-11, -6.390757e-11, + -6.390757e-11, -6.390757e-11, -6.390757e-11 ; + + fates_trs_seedling_h2o_mort_c = 1.268992e-05, 1.268992e-05, 1.268992e-05, + 1.268992e-05, 1.268992e-05, 1.268992e-05, 1.268992e-05, 1.268992e-05, + 1.268992e-05, 1.268992e-05, 1.268992e-05, 1.268992e-05, 1.268992e-05, + 1.268992e-05 ; + + fates_trs_seedling_light_mort_a = -0.009897694, -0.009897694, -0.009897694, + -0.009897694, -0.009897694, -0.009897694, -0.009897694, -0.009897694, + -0.009897694, -0.009897694, -0.009897694, -0.009897694, -0.009897694, + -0.009897694 ; + + fates_trs_seedling_light_mort_b = -7.154063, -7.154063, -7.154063, + -7.154063, -7.154063, -7.154063, -7.154063, -7.154063, -7.154063, + -7.154063, -7.154063, -7.154063, -7.154063, -7.154063 ; + + fates_trs_seedling_light_rec_a = 0.007, 0.007, 0.007, 0.007, 0.007, 0.007, + 0.007, 0.007, 0.007, 0.007, 0.007, 0.007, 0.007, 0.007 ; + + fates_trs_seedling_light_rec_b = 0.8615, 0.8615, 0.8615, 0.8615, 0.8615, + 0.8615, 0.8615, 0.8615, 0.8615, 0.8615, 0.8615, 0.8615, 0.8615, 0.8615 ; + + fates_trs_seedling_mdd_crit = 1400000, 1400000, 1400000, 1400000, 1400000, + 1400000, 1400000, 1400000, 1400000, 1400000, 1400000, 1400000, 1400000, + 1400000 ; + + fates_trs_seedling_par_crit_germ = 0.656, 0.656, 0.656, 0.656, 0.656, 0.656, + 0.656, 0.656, 0.656, 0.656, 0.656, 0.656, 0.656, 0.656 ; + + fates_trs_seedling_psi_crit = -251995.7, -251995.7, -251995.7, -251995.7, + -251995.7, -251995.7, -251995.7, -251995.7, -251995.7, -251995.7, + -251995.7, -251995.7, -251995.7, -251995.7 ; + + fates_trs_seedling_psi_emerg = -15744.65, -15744.65, -15744.65, -15744.65, + -15744.65, -15744.65, -15744.65, -15744.65, -15744.65, -15744.65, + -15744.65, -15744.65, -15744.65, -15744.65 ; + + fates_trs_seedling_root_depth = 0.06, 0.06, 0.06, 0.06, 0.06, 0.06, 0.06, + 0.06, 0.06, 0.06, 0.06, 0.06, 0.06, 0.06 ; + + fates_turb_displar = 0.67, 0.67, 0.67, 0.67, 0.67, 0.67, 0.67, 0.67, 0.67, + 0.67, 0.67, 0.67, 0.67, 0.67 ; + + fates_turb_leaf_diameter = 0.04, 0.04, 0.04, 0.04, 0.04, 0.04, 0.04, 0.04, + 0.04, 0.04, 0.04, 0.04, 0.04, 0.04 ; + + fates_turb_z0mr = 0.075, 0.055, 0.055, 0.075, 0.055, 0.055, 0.12, 0.12, + 0.12, 0.12, 0.12, 0.12, 0.12, 0.12 ; + + fates_turnover_branch = 150, 150, 150, 150, 150, 150, 150, 150, 150, 150, + 150, 0, 0, 0 ; + + fates_turnover_fnrt = 1, 2, 1, 1.5, 1, 1, 1.5, 1, 1, 1.5, 1, 1, 1, 1 ; + + fates_turnover_leaf_canopy = + 1.5, 4, 1, 1.5, 1, 1, 1.5, 1, 1, 1.5, 1, 1, 1, 1 ; + + fates_turnover_leaf_ustory = + 1.5, 4, 1, 1.5, 1, 1, 1.5, 1, 1, 1.5, 1, 1, 1, 1 ; + + fates_turnover_senleaf_fdrought = 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 ; + + fates_wood_density = 0.548327, 0.44235, 0.454845, 0.754336, 0.548327, + 0.566452, 0.7, 0.7, 0.7, 0.7, 0.7, 0.7, 0.7, 0.7 ; + + fates_woody = 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, 0, 0 ; + + fates_hlm_pft_map = + 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0.1, 0.1, 0.8, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1 ; + + fates_fire_FBD = 15.4, 16.8, 19.6, 999, 4, 4 ; + + fates_fire_low_moisture_Coeff = 1.12, 1.09, 0.98, 0.8, 1.15, 1.15 ; + + fates_fire_low_moisture_Slope = 0.62, 0.72, 0.85, 0.8, 0.62, 0.62 ; + + fates_fire_mid_moisture = 0.72, 0.51, 0.38, 1, 0.8, 0.8 ; + + fates_fire_mid_moisture_Coeff = 2.35, 1.47, 1.06, 0.8, 3.2, 3.2 ; + + fates_fire_mid_moisture_Slope = 2.35, 1.47, 1.06, 0.8, 3.2, 3.2 ; + + fates_fire_min_moisture = 0.18, 0.12, 0, 0, 0.24, 0.24 ; + + fates_fire_SAV = 13, 3.58, 0.98, 0.2, 66, 66 ; + + fates_frag_maxdecomp = 0.52, 0.383, 0.383, 0.19, 1, 999 ; + + fates_frag_cwd_frac = 0.045, 0.075, 0.21, 0.67 ; + + fates_landuse_crop_lu_pft_vector = -999, -999, -999, -999, 13 ; + + fates_landuse_grazing_rate = 0, 0, 0, 0, 0 ; + + fates_max_nocomp_pfts_by_landuse = 4, 4, 1, 1, 1 ; + + fates_maxpatches_by_landuse = 9, 4, 1, 1, 1 ; + + fates_canopy_closure_thresh = 0.8 ; + + fates_cnp_eca_plant_escalar = 1.25e-05 ; + + fates_cohort_age_fusion_tol = 0.08 ; + + fates_cohort_size_fusion_tol = 0.08 ; + + fates_comp_excln = -1 ; + + fates_damage_canopy_layer_code = 1 ; + + fates_damage_event_code = 1 ; + + fates_dev_arbitrary = _ ; + + fates_fire_active_crown_fire = 0 ; + + fates_fire_cg_strikes = 0.2 ; + + fates_fire_drying_ratio = 66000 ; + + fates_fire_durat_slope = -11.06 ; + + fates_fire_fdi_alpha = 0.00037 ; + + fates_fire_fuel_energy = 18000 ; + + fates_fire_max_durat = 240 ; + + fates_fire_miner_damp = 0.41739 ; + + fates_fire_miner_total = 0.055 ; + + fates_fire_nignitions = 15 ; + + fates_fire_part_dens = 513 ; + + fates_fire_threshold = 50 ; + + fates_forest_tree_fraction_threshold = 0.5 ; + + fates_frag_cwd_fcel = 0.76 ; + + fates_frag_cwd_flig = 0.24 ; + + fates_hydro_kmax_rsurf1 = 20 ; + + fates_hydro_kmax_rsurf2 = 0.0001 ; + + fates_hydro_psi0 = 0 ; + + fates_hydro_psicap = -0.6 ; + + fates_landuse_grazing_carbon_use_eff = 0 ; + + fates_landuse_grazing_maxheight = 1 ; + + fates_landuse_grazing_nitrogen_use_eff = 0.25 ; + + fates_landuse_grazing_phosphorus_use_eff = 0.5 ; + + fates_landuse_logging_coll_under_frac = 0 ; + + fates_landuse_logging_collateral_frac = 0 ; + + fates_landuse_logging_dbhmax = _ ; + + fates_landuse_logging_dbhmax_infra = 0 ; + + fates_landuse_logging_dbhmin = 0 ; + + fates_landuse_logging_direct_frac = 1 ; + + fates_landuse_logging_event_code = -30 ; + + fates_landuse_logging_export_frac = 0.8 ; + + fates_landuse_logging_mechanical_frac = 0 ; + + fates_leaf_photo_temp_acclim_thome_time = 30 ; + + fates_leaf_photo_temp_acclim_timescale = 30 ; + + fates_maintresp_nonleaf_baserate = 2.525e-06 ; + + fates_maxcohort = 100 ; + + fates_mort_disturb_frac = 1 ; + + fates_mort_understorey_death = 0.55983 ; + + fates_patch_fusion_tol = 0.05 ; + + fates_phen_chilltemp = 5 ; + + fates_phen_coldtemp = 7.5 ; + + fates_phen_gddthresh_a = -68 ; + + fates_phen_gddthresh_b = 638 ; + + fates_phen_gddthresh_c = -0.01 ; + + fates_phen_mindayson = 90 ; + + fates_phen_ncolddayslim = 5 ; + + fates_q10_froz = 1.5 ; + + fates_q10_mr = 1.5 ; + + fates_rxfire_AB = 0.01 ; + + fates_rxfire_fuel_max = 1.5 ; + + fates_rxfire_fuel_min = 0.5 ; + + fates_rxfire_max_threshold = 500 ; + + fates_rxfire_min_frac = 0.1 ; + + fates_rxfire_min_threshold = 50 ; + + fates_rxfire_rh_lwthreshold = 30 ; + + fates_rxfire_rh_upthreshold = 55 ; + + fates_rxfire_temp_lwthreshold = 5 ; + + fates_rxfire_temp_upthreshold = 30 ; + + fates_rxfire_wind_lwthreshold = 2 ; + + fates_rxfire_wind_upthreshold = 10 ; + + fates_soil_salinity = 0.4 ; + + fates_trs_seedling2sap_par_timescale = 32 ; + + fates_trs_seedling_emerg_h2o_timescale = 7 ; + + fates_trs_seedling_mdd_timescale = 126 ; + + fates_trs_seedling_mort_par_timescale = 32 ; + + fates_vai_top_bin_width = 1 ; + + fates_vai_width_increase_factor = 1 ; +} diff --git a/testing/CMakeLists.txt b/testing/CMakeLists.txt index 3b788d51fa..c08e021e05 100644 --- a/testing/CMakeLists.txt +++ b/testing/CMakeLists.txt @@ -7,9 +7,12 @@ add_subdirectory(functional_testing/fire/fuel fates_fuel_ftest) add_subdirectory(functional_testing/fire/ros fates_ros_ftest) add_subdirectory(functional_testing/patch fates_patch_ftest) add_subdirectory(functional_testing/fire/mortality fates_firemort_ftest) +add_subdirectory(functional_testing/edge_forest fates_edge_forest_ftest) ## Unit tests add_subdirectory(unit_testing/fire_weather_test fates_fire_weather_utest) +add_subdirectory(unit_testing/ecotypes_test fates_ecotypes_utest) +add_subdirectory(unit_testing/edge_forest_test fates_edge_forest_utest) add_subdirectory(unit_testing/fire_fuel_test fates_fire_fuel_utest) add_subdirectory(unit_testing/sort_cohorts_test fates_sort_cohorts_utest) add_subdirectory(unit_testing/insert_cohort_test fates_insert_cohort_utest) diff --git a/testing/functional_testing/edge_forest/CMakeLists.txt b/testing/functional_testing/edge_forest/CMakeLists.txt new file mode 100644 index 0000000000..371f4d911c --- /dev/null +++ b/testing/functional_testing/edge_forest/CMakeLists.txt @@ -0,0 +1,24 @@ +set(edgeforest_sources FatesTestEdgeForest.F90) + +set(NETCDF_C_DIR ${NETCDF_C_PATH}) +set(NETCDF_FORTRAN_DIR ${NETCDF_F_PATH}) + +FIND_PATH(NETCDFC_FOUND libnetcdf.a ${NETCDF_C_DIR}/lib) +FIND_PATH(NETCDFF_FOUND libnetcdff.a ${NETCDF_FORTRAN_DIR}/lib) + + +include_directories(${NETCDF_C_DIR}/include + ${NETCDF_FORTRAN_DIR}/include) + +link_directories(${NETCDF_C_DIR}/lib + ${NETCDF_FORTRAN_DIR}/lib + ${PFUNIT_TOP_DIR}/lib) + +add_executable(FATES_edge_forest_exe ${edgeforest_sources}) + +target_link_libraries(FATES_edge_forest_exe + netcdf + netcdff + fates + csm_share + funit) diff --git a/testing/functional_testing/edge_forest/FatesTestEdgeForest.F90 b/testing/functional_testing/edge_forest/FatesTestEdgeForest.F90 new file mode 100644 index 0000000000..e3a903e234 --- /dev/null +++ b/testing/functional_testing/edge_forest/FatesTestEdgeForest.F90 @@ -0,0 +1,253 @@ +program FatesTestEdgeForest + + use FatesConstantsMod, only : r8 => fates_r8 + use FatesUtilsMod, only : is_param_set + use FatesEdgeForestMod, only : GetFracEdgeForestInEachBin_norm, GetFracEdgeForestInEachBin_quadratic + use FatesEdgeForestMod, only : GetFracEdgeForestInEachBin + use FatesEdgeForestParamsMod, only : ED_val_edgeforest_gaussian_amplitude, ED_val_edgeforest_gaussian_sigma,ED_val_edgeforest_gaussian_center + use FatesEdgeForestParamsMod, only : ED_val_edgeforest_lognormal_amplitude, ED_val_edgeforest_lognormal_sigma,ED_val_edgeforest_lognormal_center + use FatesEdgeForestParamsMod, only : ED_val_edgeforest_quadratic_a, ED_val_edgeforest_quadratic_b,ED_val_edgeforest_quadratic_c + use FatesEdgeForestParamsMod, only : ED_val_edgeforest_bin_edges + use FatesUnitTestParamReaderMod, only :fates_unit_test_param_reader + use FatesArgumentUtils, only : command_line_arg + use shr_infnan_mod, only : nan => shr_infnan_nan, assignment(=), isnan => shr_infnan_isnan + + implicit none + + ! LOCALS: + type(fates_unit_test_param_reader) :: param_reader ! param reader instance + character(len=:), allocatable :: param_file ! input parameter file + integer :: e, i ! looping indices + integer :: n_bins ! number of edge forest bins in the parameter file + integer :: n_frac_forest ! size of frac_forest array + real(r8), allocatable :: frac_forest(:) ! fraction forest in site + real(r8), allocatable :: frac_in_bin_gaussian(:) ! output: fraction of forest in a bin with Gaussian fit + real(r8), allocatable :: frac_in_bin_lognormal(:) ! output: fraction of forest in a bin with lognormal fit + real(r8), allocatable :: frac_in_bin_quadratic(:) ! output: fraction of forest in a bin with quadratic fit + real(r8), allocatable :: frac_in_every_bin(:,:) ! output: fraction of forest in each bin + real(r8), allocatable :: frac_in_every_bin_norm(:,:) ! output: fraction of forest in each bin (normalized) + ! Edge bin parameters + real(r8) :: amplitude, mu, sigma, a, b, c + logical :: bin_found + + ! CONSTANTS: + logical, parameter :: debug = .false. + character(len=*), parameter :: out_file = 'edge_forest_out.nc' ! output file + real(r8), parameter :: min_frac_forest = 0._r8 ! minimum fraction forest to calculate + real(r8), parameter :: max_frac_forest = 1.0_r8 ! maximum fraction forest to calculate + real(r8), parameter :: frac_forest_inc = 0.001_r8 ! fraction forest increment to use + + interface + + subroutine WriteEdgeForestData(out_file, n_frac_forest, n_bins, frac_forest, frac_in_bin_gaussian, & + frac_in_bin_lognormal, frac_in_bin_quadratic, frac_in_every_bin, frac_in_every_bin_norm) + + use FatesUnitTestIOMod, only : OpenNCFile, RegisterNCDims, CloseNCFile + use FatesUnitTestIOMod, only : WriteVar, RegisterVar + use FatesUnitTestIOMod, only : type_double, type_int + use FatesConstantsMod, only : r8 => fates_r8 + implicit none + + character(len=*), intent(in) :: out_file + integer, intent(in) :: n_frac_forest + integer, intent(in) :: n_bins + real(r8), intent(in) :: frac_forest(:) + real(r8), intent(in) :: frac_in_bin_gaussian(:) + real(r8), intent(in) :: frac_in_bin_lognormal(:) + real(r8), intent(in) :: frac_in_bin_quadratic(:) + real(r8), intent(in) :: frac_in_every_bin(:,:) + real(r8), intent(in) :: frac_in_every_bin_norm(:,:) + end subroutine WriteEdgeForestData + + end interface + + ! read in parameter file name from command line + param_file = command_line_arg(1) + + ! read in parameter file + call param_reader%Init(param_file) + call param_reader%RetrieveParameters() + + ! determine sizes of arrays + n_bins = size(ED_val_edgeforest_bin_edges, dim=1) + n_frac_forest = int((max_frac_forest - min_frac_forest)/frac_forest_inc + 1) + + ! allocate arrays + allocate(frac_forest(n_frac_forest)) + allocate(frac_in_bin_gaussian(n_frac_forest)) + allocate(frac_in_bin_lognormal(n_frac_forest)) + allocate(frac_in_bin_quadratic(n_frac_forest)) + allocate(frac_in_every_bin(n_frac_forest, n_bins)) + allocate(frac_in_every_bin_norm(n_frac_forest, n_bins)) + + ! initialize frac_forest array + do i = 1, n_frac_forest + frac_forest(i) = min_frac_forest + frac_forest_inc*(i-1) + end do + + ! if debugging, print read-in parameters for all bins + if (debug) then + do e = 1, n_bins + + ! Gaussian + if (is_param_set(ED_val_edgeforest_gaussian_amplitude(e))) then + amplitude = ED_val_edgeforest_gaussian_amplitude(e) + mu = ED_val_edgeforest_gaussian_center(e) + sigma = ED_val_edgeforest_gaussian_sigma(e) + write(*, '(a, i2, a)') "Gaussian (bin ",e,"):" + write(*, '(a, E15.6)') " amplitude: ",amplitude + write(*, '(a, E15.6)') " mu: ",mu + write(*, '(a, E15.6)') " sigma: ",sigma + + ! Lognormal + else if (is_param_set(ED_val_edgeforest_lognormal_amplitude(e))) then + bin_found = .true. + amplitude = ED_val_edgeforest_lognormal_amplitude(e) + mu = ED_val_edgeforest_lognormal_center(e) + sigma = ED_val_edgeforest_lognormal_sigma(e) + write(*, '(a, i2, a)') "Lognormal (bin ",e,"):" + write(*, '(a, E15.6)') " amplitude: ",amplitude + write(*, '(a, E15.6)') " mu: ",mu + write(*, '(a, E15.6)') " sigma: ",sigma + + ! Quadratic + else if (is_param_set(ED_val_edgeforest_quadratic_a(e))) then + bin_found = .true. + a = ED_val_edgeforest_quadratic_a(e) + b = ED_val_edgeforest_quadratic_b(e) + c = ED_val_edgeforest_quadratic_c(e) + write(*, '(a, i2, a)') "Quadratic (bin ",e,"):" + write(*, '(a, E15.6)') " a: ",a + write(*, '(a, E15.6)') " b: ",b + write(*, '(a, E15.6)') " c: ",c + end if + end do + end if + + ! calculate fraction in every bin + do i = 1, n_frac_forest + + ! Pre-normalization + call GetFracEdgeForestInEachBin(frac_forest(i), n_bins, & + ED_val_edgeforest_gaussian_amplitude, ED_val_edgeforest_gaussian_sigma, ED_val_edgeforest_gaussian_center, & + ED_val_edgeforest_lognormal_amplitude, ED_val_edgeforest_lognormal_sigma, ED_val_edgeforest_lognormal_center, & + ED_val_edgeforest_quadratic_a, ED_val_edgeforest_quadratic_b, ED_val_edgeforest_quadratic_c, & + frac_in_every_bin(i,:), .false.) + + ! Normalized + call GetFracEdgeForestInEachBin(frac_forest(i), n_bins, & + ED_val_edgeforest_gaussian_amplitude, ED_val_edgeforest_gaussian_sigma, ED_val_edgeforest_gaussian_center, & + ED_val_edgeforest_lognormal_amplitude, ED_val_edgeforest_lognormal_sigma, ED_val_edgeforest_lognormal_center, & + ED_val_edgeforest_quadratic_a, ED_val_edgeforest_quadratic_b, ED_val_edgeforest_quadratic_c, & + frac_in_every_bin_norm(i,:), .true.) + end do + + ! write out data to netcdf file + call WriteEdgeForestData(out_file, n_frac_forest, n_bins, frac_forest, frac_in_bin_gaussian, & + frac_in_bin_lognormal, frac_in_bin_quadratic, frac_in_every_bin, frac_in_every_bin_norm) + +end program FatesTestEdgeForest + +! ---------------------------------------------------------------------------------------- + +subroutine WriteEdgeForestData(out_file, n_frac_forest, n_bins, frac_forest, frac_in_bin_gaussian, & + frac_in_bin_lognormal, frac_in_bin_quadratic, frac_in_every_bin, frac_in_every_bin_norm) + ! + ! DESCRIPTION: + ! Writes out data from the edge forest test + ! + use FatesUnitTestIOMod, only : OpenNCFile, RegisterNCDims, CloseNCFile + use FatesUnitTestIOMod, only : WriteVar + use FatesUnitTestIOMod, only : RegisterVar + use FatesUnitTestIOMod, only : EndNCDef + use FatesUnitTestIOMod, only : type_double, type_int + use FatesConstantsMod, only : r8 => fates_r8 + use FatesEdgeForestParamsMod, only : ED_val_edgeforest_bin_edges + implicit none + + ! ARGUMENTS + character(len=*), intent(in) :: out_file + integer, intent(in) :: n_frac_forest + integer, intent(in) :: n_bins + real(r8), intent(in) :: frac_forest(:) + real(r8), intent(in) :: frac_in_bin_gaussian(:) + real(r8), intent(in) :: frac_in_bin_lognormal(:) + real(r8), intent(in) :: frac_in_bin_quadratic(:) + real(r8), intent(in) :: frac_in_every_bin(:,:) + real(r8), intent(in) :: frac_in_every_bin_norm(:,:) + + ! LOCALS: + ! TODO: Set a local parameter for number of dimensions (2) + integer :: i ! looping index + integer :: ncid ! netcdf file id + character(len=24) :: dim_names(2) ! dimension name(s) + integer :: dimIDs(2) ! dimension ID(s) + integer :: fracforestID, binID ! variable ID(s) for dimensions + integer :: gaussianID, lognormalID, quadraticID + integer :: everybinID, everybinnormID + + ! dimension name(s) + dim_names = [character(len=24) :: 'frac_forest', 'bin'] + + ! open file + call OpenNCFile(trim(out_file), ncid, 'readwrite') + + ! register dimensions + call RegisterNCDims(ncid, dim_names, (/n_frac_forest, n_bins/), 2, dimIDs) + + ! register fraction forest + call RegisterVar(ncid, dim_names(1), dimIDs(1:1), type_double, & + [character(len=20) :: 'units', 'long_name'], & + [character(len=150) :: 'unitless', 'Fraction of site that is forest'], 2, fracforestID) + + ! register bin + call RegisterVar(ncid, dim_names(2), dimIDs(2:2), type_double, & + [character(len=20) :: 'units', 'long_name'], & + [character(len=150) :: 'unitless', 'FATES edge bin min. distance to nonforest'], 2, binID) + + ! register frac_in_bin_gaussian + call RegisterVar(ncid, 'frac_in_bin_gaussian', dimIDs(1:1), type_double, & + [character(len=20) :: 'coordinates', 'units', 'long_name'], & + [character(len=150) :: 'frac_forest', 'unitless', 'Fraction of forest in first bin with Gaussian fit'], & + 3, gaussianID) + + ! register frac_in_bin_lognormal + call RegisterVar(ncid, 'frac_in_bin_lognormal', dimIDs(1:1), type_double, & + [character(len=20) :: 'coordinates', 'units', 'long_name'], & + [character(len=150) :: 'frac_forest', 'unitless', 'Fraction of forest in first bin with lognormal fit'], & + 3, lognormalID) + + ! register frac_in_bin_quadratic + call RegisterVar(ncid, 'frac_in_bin_quadratic', dimIDs(1:1), type_double, & + [character(len=20) :: 'coordinates', 'units', 'long_name'], & + [character(len=150) :: 'frac_forest', 'unitless', 'Fraction of forest in first bin with quadratic fit'], & + 3, quadraticID) + + ! register frac_in_every_bin + call RegisterVar(ncid, 'frac_in_every_bin', dimIDs(1:2), type_double, & + [character(len=20) :: 'coordinates', 'units', 'long_name'], & + [character(len=150) :: 'frac_forest bin', 'unitless', 'Fraction of forest in every bin'], & + 3, everybinID) + + ! register frac_in_every_bin_norm + call RegisterVar(ncid, 'frac_in_every_bin_norm', dimIDs(1:2), type_double, & + [character(len=20) :: 'coordinates', 'units', 'long_name'], & + [character(len=150) :: 'frac_forest bin', 'unitless', 'Fraction of forest in every bin (normalized)'], & + 3, everybinnormID) + + ! finish defining variables + call EndNCDef(ncid) + + ! write out data + call WriteVar(ncid, fracforestID, frac_forest(:)) + call WriteVar(ncid, binID, ED_val_edgeforest_bin_edges(:)) + call WriteVar(ncid, gaussianID, frac_in_bin_gaussian(:)) + call WriteVar(ncid, lognormalID, frac_in_bin_lognormal(:)) + call WriteVar(ncid, quadraticID, frac_in_bin_quadratic(:)) + call WriteVar(ncid, everybinID, frac_in_every_bin(:,:)) + call WriteVar(ncid, everybinnormID, frac_in_every_bin_norm(:,:)) + + ! close the file + call CloseNCFile(ncid) + +end subroutine WriteEdgeForestData diff --git a/testing/functional_testing/edge_forest/edge_forest_test.py b/testing/functional_testing/edge_forest/edge_forest_test.py new file mode 100644 index 0000000000..68e7485e06 --- /dev/null +++ b/testing/functional_testing/edge_forest/edge_forest_test.py @@ -0,0 +1,173 @@ +""" +Concrete class for running the edge forest functional tests for FATES. +""" + +import os +import xarray as xr +import pandas as pd +import numpy as np +import matplotlib.pyplot as plt +from utils import round_up +from utils_plotting import sample_colormap, blank_plot +from functional_class import FunctionalTest + + +class EdgeForestTest(FunctionalTest): + """Quadratic test class""" + + name = "edge_forest" + + def __init__(self, test_dict): + super().__init__( + EdgeForestTest.name, + test_dict["test_dir"], + test_dict["test_exe"], + test_dict["out_file"], + test_dict["use_param_file"], + test_dict["other_args"], + ) + self.plot = True + + def plot_output(self, run_dir: str, save_figs: bool, plot_dir: str): + """Plots all edge forest plots + + Args: + run_dir (str): run directory + out_file (str): output file name + save_figs (bool): whether or not to save the figures + plot_dir (str): plot directory to save the figures to + """ + + # read in edge forest data + edge_forest_dat = xr.open_dataset(os.path.join(run_dir, self.out_file)) + + # Plot all bins + da = edge_forest_dat["frac_in_every_bin"] + da_norm = edge_forest_dat["frac_in_every_bin_norm"] + self.plot_edge_forest_frac_allbins( + da, + da_norm, + "Fraction of forest in each edge bin", + da.attrs["units"], + save_figs, + plot_dir, + ) + + # Plot individual bins + plot_dict = { + "frac_in_bin_gaussian": { + "varname": "Fraction of forest in first bin with Gaussian fit", + "units": "unitless", + }, + "frac_in_bin_lognormal": { + "varname": "Fraction of forest in first bin with lognormal fit", + "units": "unitless", + }, + "frac_in_bin_quadratic": { + "varname": "Fraction of forest in first bin with quadratic fit", + "units": "unitless", + }, + } + for plot, attributes in plot_dict.items(): + self.plot_edge_forest_frac_onebin( + edge_forest_dat[plot], + attributes["varname"], + attributes["units"], + save_figs, + plot_dir, + ) + + @staticmethod + def plot_edge_forest_frac_allbins( + data: xr.Dataset, data_norm: xr.Dataset, varname: str, units: str, save_fig: bool, plot_dir: str = None + ): + """Plot the fraction of forest in all bins + + Args: + data (xarray DataArray): the data array of the variable to plot + data_norm (xarray DataArray): the data array of the normalized variable to plot + var (str): variable name (for data structure) + varname (str): variable name for plot labels + units (str): variable units for plot labels + save_fig (bool): whether or not to write out plot + plot_dir (str): if saving figure, where to write to + """ + + x = data["frac_forest"] + max_x = x.max() + + y = data + y_norm = data_norm + max_y = round_up(y.max()) + + blank_plot(max_x, 0.0, max_y, 0.0, draw_horizontal_lines=True) + + bins = data["bin"].values + + for b, this_bin in enumerate(bins): + plt.plot( + x.values, + y.sel(bin=this_bin).values, + color=sample_colormap("jet_r", len(bins), b), + label=str(this_bin), + ) + + for b, this_bin in enumerate(bins): + plt.plot( + x.values, + y_norm.sel(bin=this_bin).values, + color=sample_colormap("jet_r", len(bins), b), + label="__nolegend__", + linestyle="--", + ) + + plt.xlabel("Frac. forest in site", fontsize=11) + plt.ylabel(f"{varname} ({units})", fontsize=11) + plt.title(f"Simulated {varname} for input parameter file\n(dashed=adjusted)", fontsize=11) + plt.legend(loc="best", title="Bin distance to\nnonforest (m)", alignment="left") + + if save_fig: + fig_name = os.path.join(plot_dir, f"edge_forest_plot_{data.name}.png") + plt.savefig(fig_name) + + @staticmethod + def plot_edge_forest_frac_onebin( + data: xr.Dataset, varname: str, units: str, save_fig: bool, plot_dir: str = None + ): + """Plot the fraction of forest in a given bin + + Args: + data (xarray DataArray): the data array of the variable to plot + var (str): variable name (for data structure) + varname (str): variable name for plot labels + units (str): variable units for plot labels + save_fig (bool): whether or not to write out plot + plot_dir (str): if saving figure, where to write to + """ + + # This is left over from AllometryTest, which had two dimensions + data_frame = pd.DataFrame( + { + "frac_forest": np.tile(data.frac_forest, 1), + data.name: data.values.flatten(), + } + ) + + max_forest = data_frame["frac_forest"].max() + max_var = round_up(data_frame[data.name].max()) + + blank_plot(max_forest, 0.0, max_var, 0.0, draw_horizontal_lines=True) + + plt.plot( + data_frame.frac_forest.values, + data_frame[data.name].values, + lw=2, + ) + + plt.xlabel("Frac. forest in site", fontsize=11) + plt.ylabel(f"{varname} ({units})", fontsize=11) + plt.title(f"Simulated {varname} for input parameter file", fontsize=11) + + if save_fig: + fig_name = os.path.join(plot_dir, f"edge_forest_plot_{data.name}.png") + plt.savefig(fig_name) diff --git a/testing/functional_testing/fire/fuel/FatesTestFuel.F90 b/testing/functional_testing/fire/fuel/FatesTestFuel.F90 index 3f185985aa..3137c2cf37 100644 --- a/testing/functional_testing/fire/fuel/FatesTestFuel.F90 +++ b/testing/functional_testing/fire/fuel/FatesTestFuel.F90 @@ -107,7 +107,8 @@ program FatesTestFuel ! run on time steps do i = 1, n_days - call fireWeather%UpdateIndex(temp_degC(i), precip(i), rh(i), wind(i)) + call fireWeather%UpdateFireWeatherData(temp_degC(i), precip(i), rh(i), wind(i)) + call fireWeather%UpdateIndex() NI(i) = fireWeather%fire_weather_index ! calculate fuel moisture [m3/m3] diff --git a/testing/functional_testing/fire/mortality/fire_mortality_test.py b/testing/functional_testing/fire/mortality/fire_mortality_test.py index 58e6055d53..aa9a7a833d 100644 --- a/testing/functional_testing/fire/mortality/fire_mortality_test.py +++ b/testing/functional_testing/fire/mortality/fire_mortality_test.py @@ -7,7 +7,7 @@ import pandas as pd import matplotlib.pyplot as plt from functional_class import FunctionalTest -from utils import blank_plot, get_color_palette +from utils_plotting import blank_plot, get_color_palette class FireMortTest(FunctionalTest): """Fire mortality test class""" diff --git a/testing/functional_tests.cfg b/testing/functional_tests.cfg index fec8e075d6..a4aface964 100644 --- a/testing/functional_tests.cfg +++ b/testing/functional_tests.cfg @@ -40,3 +40,10 @@ test_exe = FATES_firemort_exe out_file = fire_mortality_out.nc use_param_file = True other_args = [] + +[edge_forest] +test_dir = fates_edge_forest_ftest +test_exe = FATES_edge_forest_exe +out_file = edge_forest_out.nc +use_param_file = True +other_args = [] diff --git a/testing/load_functional_tests.py b/testing/load_functional_tests.py index 3b72dcb2b7..e565466d0c 100644 --- a/testing/load_functional_tests.py +++ b/testing/load_functional_tests.py @@ -8,3 +8,4 @@ from functional_testing.fire.ros.ros_test import ROSTest from functional_testing.patch.patch_test import PatchTest from functional_testing.fire.mortality.fire_mortality_test import FireMortTest +from functional_testing.edge_forest.edge_forest_test import EdgeForestTest diff --git a/testing/testing_shr/FatesFactoryMod.F90 b/testing/testing_shr/FatesFactoryMod.F90 index 5f2cdee5fb..25d10a6817 100644 --- a/testing/testing_shr/FatesFactoryMod.F90 +++ b/testing/testing_shr/FatesFactoryMod.F90 @@ -23,10 +23,13 @@ module FatesFactoryMod use EDParamsMod, only : nclmax use EDParamsMod, only : photo_temp_acclim_timescale use EDParamsMod, only : photo_temp_acclim_thome_time + use EDParamsMod, only : FatesParamsInitForFactory use FatesRunningMeanMod, only : ema_24hr, fixed_24hr, ema_lpa, ema_longterm use FatesRunningMeanMod, only : moving_ema_window, fixed_window use EDCohortDynamicsMod, only : InitPRTObject use PRTParametersMod, only : prt_params + use EDPftvarcon, only : EDPftvarcon_inst + use FatesParameterDerivedMod, only : param_derived use PRTGenericMod, only : element_pos use PRTGenericMod, only : num_elements use PRTGenericMod, only : element_list @@ -64,12 +67,74 @@ module FatesFactoryMod implicit none public :: GetSyntheticPatch + public :: InitializeParams public :: InitializeGlobals contains !--------------------------------------------------------------------------------------- + subroutine InitializeParams() + ! + ! DESCRIPTION: + ! Initialize parameters needed for running factory that usually come from the parameter file + + ! LOCALS: + integer, parameter :: n_pfts = 14 + integer, parameter :: n_leafage_class = 1 + + ! Things from parameter file for prt_params + call FatesParamsInitForFactory() + allocate(prt_params%allom_agb_frac(n_pfts)); prt_params%allom_agb_frac = [0.6, 0.6, 0.6, 0.6, 0.6, 0.6, 0.6, 0.6, 0.6, 0.6, 0.6, 1., 1., 1.] + allocate(prt_params%allom_agb1(n_pfts)); prt_params%allom_agb1 = [0.0673, 0.1364012, 0.0393057, 0.2653695, 0.0673, 0.0728698, 0.06896, 0.06896, 0.06896, 0.06896, 0.06896, 0.001, 0.001, 0.003] + allocate(prt_params%allom_agb2(n_pfts)); prt_params%allom_agb2 = [0.976, 0.9449041, 1.087335, 0.8321321, 0.976, 1.0373211, 0.572, 0.572, 0.572, 0.5289883, 0.6853945, 1.6592, 1.6592, 1.3456] + allocate(prt_params%allom_agb3(n_pfts)); prt_params%allom_agb3 = [1.94, 1.94, 1.94, 1.94, 1.94, 1.94, 1.94, 1.94, 1.94, 2.1010352, 1.7628613, 1.248, 1.248, 1.869] + allocate(prt_params%allom_agb4(n_pfts)); prt_params%allom_agb4 = [0.931, 0.931, 0.931, 0.931, 0.931, 0.931, 0.931, 0.931, 0.931, 0.931, 0.931, -999.9, -999.9, -999.9] + allocate(prt_params%allom_amode(n_pfts)); prt_params%allom_amode = [3, 3, 3, 3, 3, 3, 1, 1, 1, 1, 1, 5, 5, 5] + allocate(prt_params%allom_blca_expnt_diff(n_pfts)); prt_params%allom_blca_expnt_diff = [-0.12, -0.34, -0.32, -0.22, -0.12, -0.35, 0., 0., 0., 0., 0., -0.487, -0.487, -0.259] + allocate(prt_params%allom_cmode(n_pfts)); prt_params%allom_cmode(:) = 1 + allocate(prt_params%allom_d2bl1(n_pfts)); prt_params%allom_d2bl1 = [0.04, 0.07, 0.07, 0.01, 0.04, 0.07, 0.07, 0.07, 0.07, 0.0481934, 0.0481934, 0.0004, 0.0004, 0.0012] + allocate(prt_params%allom_d2bl2(n_pfts)); prt_params%allom_d2bl2 = [1.6019679, 1.5234373, 1.3051237, 1.9621397, 1.6019679, 1.3998939, 1.3, 1.3, 1.3, 1.0600586, 1.7176758, 1.7092, 1.7092, 1.5879] + allocate(prt_params%allom_d2bl3(n_pfts)); prt_params%allom_d2bl3 = [0.55, 0.55, 0.55, 0.55, 0.55, 0.55, 0.55, 0.55, 0.55, 0.55, 0.55, 0.3417, 0.3417, 0.9948] + allocate(prt_params%allom_d2ca_coefficient_max(n_pfts)); prt_params%allom_d2ca_coefficient_max = [0.2715891, 0.3693718, 1.0787259, 0.0579297, 0.2715891, 1.1553612, 0.6568464, 0.6568464, 0.6568464, 0.4363427, 0.3166497, 0.0408, 0.0408, 0.0862] + allocate(prt_params%allom_d2ca_coefficient_min(n_pfts)); prt_params%allom_d2ca_coefficient_min = prt_params%allom_d2ca_coefficient_max + allocate(prt_params%allom_d2h1(n_pfts)); prt_params%allom_d2h1 = [78.4087704, 306.842667, 106.8745821, 104.3586841, 78.4087704, 31.4557047, 0.64, 0.64, 0.64, 0.8165625, 0.778125, 0.1812, 0.1812, 0.3353] + allocate(prt_params%allom_d2h2(n_pfts)); prt_params%allom_d2h2 = [0.8124383, 0.752377, 0.9471302, 1.1146973, 0.8124383, 0.9734088, 0.37, 0.37, 0.37, 0.2316113, 0.4027002, 0.6384, 0.6384, 0.4235] + allocate(prt_params%allom_d2h3(n_pfts)); prt_params%allom_d2h3 = [47.6666164, 196.6865691, 93.9790461, 160.6835089, 47.6666164, 16.5928174, -999.9, -999.9, -999.9, -999.9, -999.9, -999.9, -999.9, -999.9] + allocate(prt_params%allom_dbh_maxheight(n_pfts)); prt_params%allom_dbh_maxheight = [1000., 1000., 1000., 1000., 1000., 1000., 3., 3., 2., 2.4, 1.9, 20., 20., 30.] + allocate(prt_params%allom_fmode(n_pfts)); prt_params%allom_fmode(:) = 1 + allocate(prt_params%allom_hmode(n_pfts)); prt_params%allom_hmode = [5, 5, 5, 5, 5, 5, 1, 1, 1, 1, 1, 3, 3, 3] + allocate(prt_params%allom_l2fr(n_pfts)); prt_params%allom_l2fr = [1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 0.67, 0.67, 1.41] + allocate(prt_params%allom_la_per_sa_int(n_pfts)); prt_params%allom_la_per_sa_int(:) = 0.8 + allocate(prt_params%allom_la_per_sa_slp(n_pfts)); prt_params%allom_la_per_sa_slp(:) = 0. + allocate(prt_params%allom_lmode(n_pfts)); prt_params%allom_lmode = [2, 2, 2, 2, 2, 2, 1, 1, 1, 1, 1, 5, 5, 5] + allocate(prt_params%allom_sai_scaler(n_pfts)); prt_params%allom_sai_scaler(:) = 0.1 + allocate(prt_params%allom_smode(n_pfts)); prt_params%allom_smode = [1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 2, 2, 2] + allocate(prt_params%allom_stmode(n_pfts)); prt_params%allom_stmode(:) = 1 + allocate(prt_params%c2b(n_pfts)); prt_params%c2b(:) = 2 + allocate(prt_params%cushion(n_pfts)); prt_params%cushion = [1.2, 1.2, 1.2, 1.2, 2.4, 1.2, 1.2, 2.4, 1.2, 1.5, 1.4, 1.2, 1.2, 1.2] + allocate(prt_params%leaf_long(n_pfts,n_leafage_class)); prt_params%leaf_long = reshape([1.5, 4., 1., 1.5, 1., 1., 1.5, 1., 1., 1.5, 1., 1., 1., 1.], shape(prt_params%leaf_long)) + allocate(prt_params%leafn_vert_scaler_coeff1(n_pfts)); prt_params%leafn_vert_scaler_coeff1(:) = 0.00963 + allocate(prt_params%leafn_vert_scaler_coeff2(n_pfts)); prt_params%leafn_vert_scaler_coeff2(:) = 2.43 + allocate(prt_params%phen_fnrt_drop_fraction(n_pfts)); prt_params%phen_fnrt_drop_fraction(:) = 0. + allocate(prt_params%phen_leaf_habit(n_pfts)); prt_params%phen_leaf_habit = [1, 1, 2, 1, 3, 2, 1, 3, 2, 1, 2, 2, 3, 3] + allocate(prt_params%phen_stem_drop_fraction(n_pfts)); prt_params%phen_stem_drop_fraction(:) = 0. + allocate(prt_params%slamax(n_pfts)); prt_params%slamax = [0.0954, 0.0954, 0.0954, 0.0954, 0.0954, 0.0954, 0.012, 0.03, 0.03, 0.012, 0.032, 0.05, 0.05, 0.05] + allocate(prt_params%slatop(n_pfts)); prt_params%slatop = [0.012, 0.005, 0.024, 0.009, 0.03, 0.03, 0.012, 0.03, 0.03, 0.01, 0.032, 0.027, 0.05, 0.05] + allocate(prt_params%wood_density(n_pfts)); prt_params%wood_density = [0.548327, 0.44235, 0.454845, 0.754336, 0.548327, 0.566452, 0.7, 0.7, 0.7, 0.7, 0.7, 0.7, 0.7, 0.7] + + ! Things from parameter file for EDPftvarcon_inst + allocate(EDPftvarcon_inst%damage_frac(n_pfts)) + EDPftvarcon_inst%damage_frac = [0.01, 0.01, 0.01, 0.01, 0.01, 0.01, 0.01, 0.01, 0.01, 0.01, & + 0.01, 0.01, 0.01, 0.01] + + ! Derived parameters + call param_derived%Init(n_pfts) + + end subroutine InitializeParams + + !--------------------------------------------------------------------------------------- + subroutine InitializeGlobals(step_size) ! ! DESCRIPTION: @@ -445,7 +510,7 @@ subroutine PatchFactory(patch, age, area, num_swb, num_pft, num_levsoil, else tod_local = tod_default end if - + allocate(patch) call patch%Create(age, area, land_use_label_local, nocomp_pft_local, num_swb, & num_pft, num_levsoil, tod_local, hlm_regeneration_model) @@ -483,6 +548,10 @@ subroutine GetSyntheticPatch(patch_data, num_levsoil, patch) ! create the patch call PatchFactory(patch, patch_age, patch_data%area, num_swb, numpft, num_levsoil) + + ! Apply patch variables + patch%total_tree_area = patch_data%total_tree_area + patch%livegrass = patch_data%livegrass ! add cohorts do i = 1, patch_data%num_cohorts diff --git a/testing/testing_shr/FatesUnitTestParamReaderMod.F90 b/testing/testing_shr/FatesUnitTestParamReaderMod.F90 index d8b655136b..b0598bfa99 100644 --- a/testing/testing_shr/FatesUnitTestParamReaderMod.F90 +++ b/testing/testing_shr/FatesUnitTestParamReaderMod.F90 @@ -8,6 +8,7 @@ module FatesUnitTestParamReaderMod use FatesParametersInterface, only : dimension_shape_scalar, dimension_shape_1d, dimension_shape_2d use EDParamsMod, only : FatesRegisterParams, FatesReceiveParams use SFParamsMod, only : SpitFireRegisterParams, SpitFireReceiveParams + use FatesEdgeForestParamsMod, only : EdgeForestRegisterParams, EdgeForestReceiveParams use PRTInitParamsFatesMod, only : PRTRegisterParams, PRTReceiveParams use PRTParametersMod, only : prt_params use FatesInterfaceTypesMod, only : nleafage @@ -124,6 +125,7 @@ subroutine RetrieveParameters(this) call FatesRegisterParams(fates_params) call SpitFireRegisterParams(fates_params) + call EdgeForestRegisterParams(fates_params) call PRTRegisterParams(fates_params) call FatesSynchronizedParamsInst%RegisterParams(fates_params) call EDPftvarcon_inst%Register(fates_pft_params) @@ -133,6 +135,7 @@ subroutine RetrieveParameters(this) call FatesReceiveParams(fates_params) call SpitFireReceiveParams(fates_params) + call EdgeForestReceiveParams(fates_params) call PRTReceiveParams(fates_params) call FatesSynchronizedParamsInst%ReceiveParams(fates_params) call EDPftvarcon_inst%Receive(fates_pft_params) diff --git a/testing/testing_shr/SyntheticPatchTypes.F90 b/testing/testing_shr/SyntheticPatchTypes.F90 index 64747e5b6d..0401ddfaf2 100644 --- a/testing/testing_shr/SyntheticPatchTypes.F90 +++ b/testing/testing_shr/SyntheticPatchTypes.F90 @@ -9,6 +9,8 @@ module SyntheticPatchTypes private integer, parameter :: chunk_size = 10 + real(r8), public :: forest_tree_fraction_threshold = 0.5 + real(r8), public :: grass_biomass_threshold = 0._r8 ! patch data type to hold data about the synthetic patches type, public :: synthetic_patch_type @@ -20,6 +22,8 @@ module SyntheticPatchTypes real(r8), allocatable :: dbhs(:) ! cohort dbhs [cm] real(r8), allocatable :: densities(:) ! cohort densities [/m2] integer, allocatable :: canopy_layers(:) ! canopy layers + real(r8) :: total_tree_area ! tree cover area [m2] + real(r8) :: livegrass ! total aboveground grass biomass in patch [kgC/m2] integer, allocatable :: pft_ids(:) ! pft ids contains @@ -49,7 +53,7 @@ module SyntheticPatchTypes contains subroutine InitSyntheticPatchData(this, patch_id, patch_name, area, ages, dbhs, & - densities, pft_ids, canopy_layers) + densities, pft_ids, canopy_layers, total_tree_area, livegrass) ! ! DESCRIPTION: ! Initializes a synthetic patch with input characteristics @@ -65,6 +69,8 @@ subroutine InitSyntheticPatchData(this, patch_id, patch_name, area, ages, dbhs, real(r8), intent(in) :: densities(:) ! cohort densities [/m2] integer, intent(in) :: pft_ids(:) ! pft ids integer, intent(in) :: canopy_layers(:) ! canopy layers of cohorts + real(r8), intent(in) :: total_tree_area ! tree cover area [m2] + real(r8), intent(in) :: livegrass ! total aboveground grass biomass in patch [kgC/m2] ! LOCALS: integer :: num_cohorts ! number of cohorts on patch @@ -84,6 +90,8 @@ subroutine InitSyntheticPatchData(this, patch_id, patch_name, area, ages, dbhs, this%num_cohorts = num_cohorts this%patch_id = patch_id this%area = area + this%total_tree_area = total_tree_area + this%livegrass = livegrass do i = 1, num_cohorts this%ages(i) = ages(i) @@ -97,8 +105,8 @@ end subroutine InitSyntheticPatchData ! -------------------------------------------------------------------------------------- - subroutine AddPatch(this, patch_id, patch_name, area, ages, dbhs, densities, pft_ids, & - canopy_layers) + subroutine AddPatch(this, patch_name, area, ages, dbhs, densities, pft_ids, & + canopy_layers, total_tree_area, livegrass) ! ! DESCRIPTION: ! Adds a synthetic patch data to a dynamic array @@ -106,7 +114,6 @@ subroutine AddPatch(this, patch_id, patch_name, area, ages, dbhs, densities, pft ! ARGUMENTS: class(synthetic_patch_array_type), intent(inout) :: this ! array of synthetic patches - integer, intent(in) :: patch_id ! patch id character(len=*), intent(in) :: patch_name ! name of patch real(r8), intent(in) :: area ! patch area real(r8), intent(in) :: ages(:) ! cohort ages [yr] @@ -114,6 +121,8 @@ subroutine AddPatch(this, patch_id, patch_name, area, ages, dbhs, densities, pft real(r8), intent(in) :: densities(:) ! cohort densities [/m2] integer, intent(in) :: pft_ids(:) ! pft ids integer, intent(in) :: canopy_layers(:) ! canopy layers + real(r8), intent(in) :: total_tree_area ! tree cover area [m2] + real(r8), intent(in) :: livegrass ! total aboveground grass biomass in patch [kgC/m2] ! LOCALS: type(synthetic_patch_type) :: patch_data ! synthetic patch data @@ -137,8 +146,8 @@ subroutine AddPatch(this, patch_id, patch_name, area, ages, dbhs, densities, pft this%num_patches = 1 end if - call patch_data%InitSyntheticPatchData(patch_id, patch_name, area, ages, dbhs, & - densities, pft_ids, canopy_layers) + call patch_data%InitSyntheticPatchData(this%num_patches, patch_name, area, ages, dbhs, & + densities, pft_ids, canopy_layers, total_tree_area, livegrass) this%patches(this%num_patches) = patch_data @@ -189,7 +198,7 @@ end function PatchDataPosition ! -------------------------------------------------------------------------------------- - subroutine GetSyntheticPatchData(this) + subroutine GetSyntheticPatchData(this, patch_name_in) ! ! DESCRIPTION: ! Returns an array of hard-coded synthetic patch data @@ -198,41 +207,90 @@ subroutine GetSyntheticPatchData(this) ! ARGUMENTS: class(synthetic_patch_array_type), intent(inout) :: this ! array of synthetic patches + character(len=*), intent(in), optional :: patch_name_in + ! + ! LOCALS: + logical :: add_all + real(r8) :: patch_area = 500 + + add_all = .not. present(patch_name_in) + + if (add_all .or. patch_name_in == 'tropical') then + call this%AddPatch(patch_name='tropical', area=patch_area, & + ages=(/100.0_r8, 80.0_r8, 40.0_r8, 20.0_r8/), & + dbhs=(/60.0_r8, 50.0_r8, 25.0_r8, 10.0_r8/), & + densities=(/0.005_r8, 0.008_r8, 0.02_r8, 0.017_r8/), & + pft_ids=(/1, 1, 1, 1/), & + canopy_layers=(/1, 1, 2, 2/), & + total_tree_area=patch_area, & + livegrass=0._r8) + end if - call this%AddPatch(patch_id=1, patch_name='tropical', area=500.0_r8, & - ages=(/100.0_r8, 80.0_r8, 40.0_r8, 20.0_r8/), & - dbhs=(/60.0_r8, 50.0_r8, 25.0_r8, 10.0_r8/), & - densities=(/0.005_r8, 0.008_r8, 0.02_r8, 0.017_r8/), & - pft_ids=(/1, 1, 1, 1/), & - canopy_layers=(/1, 1, 2, 2/)) - - call this%AddPatch(patch_id=2, patch_name='evergreen', area=500.0_r8, & - ages=(/50.0_r8, 50.0_r8/), & - dbhs=(/30.0_r8, 25.0_r8/), & - densities=(/0.015_r8, 0.015_r8/), & - pft_ids=(/2, 2/), & - canopy_layers=(/1, 1/)) + if (add_all .or. patch_name_in == 'evergreen') then + call this%AddPatch(patch_name='evergreen', area=patch_area, & + ages=(/50.0_r8, 50.0_r8/), & + dbhs=(/30.0_r8, 25.0_r8/), & + densities=(/0.015_r8, 0.015_r8/), & + pft_ids=(/2, 2/), & + canopy_layers=(/1, 1/), & + total_tree_area=patch_area, & + livegrass=0._r8) + end if + + if (add_all .or. patch_name_in == 'savannah') then + call this%AddPatch(patch_name='savannah', area=patch_area, & + ages=(/20.0_r8, 1.0_r8/), & + dbhs=(/15.0_r8, 1.0_r8/), & + densities=(/0.015_r8, 0.015_r8/), & + pft_ids=(/5, 14/), & + canopy_layers=(/1, 2/), & + total_tree_area=patch_area * forest_tree_fraction_threshold, & + livegrass=grass_biomass_threshold) + end if + + if (add_all .or. patch_name_in == 'savannah_woody') then + call this%AddPatch(patch_name='savannah_woody', area=patch_area, & + ages=(/20.0_r8, 1.0_r8/), & + dbhs=(/15.0_r8, 1.0_r8/), & + densities=(/0.030_r8, 0.0075_r8/), & + pft_ids=(/5, 14/), & + canopy_layers=(/1, 2/), & + total_tree_area=patch_area * (forest_tree_fraction_threshold + 0.1), & + livegrass=grass_biomass_threshold - 1.0_r8) + end if - call this%AddPatch(patch_id=3, patch_name='savannah', area=500.0_r8, & - ages=(/20.0_r8, 1.0_r8/), & - dbhs=(/15.0_r8, 1.0_r8/), & - densities=(/0.015_r8, 0.015_r8/), & - pft_ids=(/5, 14/), & - canopy_layers=(/1, 2/)) + if (add_all .or. patch_name_in == 'savannah_grassy') then + call this%AddPatch(patch_name='savannah_grassy', area=patch_area, & + ages=(/20.0_r8, 1.0_r8/), & + dbhs=(/15.0_r8, 1.0_r8/), & + densities=(/0.0075_r8, 0.030_r8/), & + pft_ids=(/5, 14/), & + canopy_layers=(/1, 2/), & + total_tree_area=patch_area * forest_tree_fraction_threshold - 0.1, & + livegrass=grass_biomass_threshold + 1.0_r8) + end if - call this%AddPatch(patch_id=4, patch_name='grassland', area=500.0_r8, & - ages=(/1.0_r8, 2.0_r8/), & - dbhs=(/1.0_r8, 1.0_r8/), & - densities=(/0.015_r8, 0.015_r8/), & - pft_ids=(/13, 13/), & - canopy_layers=(/1, 1/)) + if (add_all .or. patch_name_in == 'grassland') then + call this%AddPatch(patch_name='grassland', area=patch_area, & + ages=(/1.0_r8, 2.0_r8/), & + dbhs=(/1.0_r8, 1.0_r8/), & + densities=(/0.015_r8, 0.015_r8/), & + pft_ids=(/13, 13/), & + canopy_layers=(/1, 1/), & + total_tree_area=0._r8, & + livegrass=grass_biomass_threshold + 2.0_r8) + end if - call this%AddPatch(patch_id=5, patch_name='temperate', area=500.0_r8, & - ages=(/80.0_r8, 50.0_r8, 20.0_r8, 5.0_r8/), & - dbhs=(/50.0_r8, 30.0_r8, 15.0_r8, 3.0_r8/), & - densities=(/0.005_r8, 0.01_r8, 0.015_r8, 0.005_r8/), & - pft_ids=(/6, 2, 2, 9/), & - canopy_layers=(/1, 1, 2, 2/)) + if (add_all .or. patch_name_in == 'temperate') then + call this%AddPatch(patch_name='temperate', area=patch_area, & + ages=(/80.0_r8, 50.0_r8, 20.0_r8, 5.0_r8/), & + dbhs=(/50.0_r8, 30.0_r8, 15.0_r8, 3.0_r8/), & + densities=(/0.005_r8, 0.01_r8, 0.015_r8, 0.005_r8/), & + pft_ids=(/6, 2, 2, 9/), & + canopy_layers=(/1, 1, 2, 2/), & + total_tree_area=patch_area, & + livegrass=0._r8) + end if end subroutine GetSyntheticPatchData diff --git a/testing/unit_testing/ecotypes_test/CMakeLists.txt b/testing/unit_testing/ecotypes_test/CMakeLists.txt new file mode 100644 index 0000000000..f27c5789ef --- /dev/null +++ b/testing/unit_testing/ecotypes_test/CMakeLists.txt @@ -0,0 +1,5 @@ +set(pfunit_sources test_Ecotypes.pf) + +add_pfunit_ctest(Ecotypes + TEST_SOURCES "${pfunit_sources}" + LINK_LIBRARIES fates csm_share) diff --git a/testing/unit_testing/ecotypes_test/test_Ecotypes.pf b/testing/unit_testing/ecotypes_test/test_Ecotypes.pf new file mode 100644 index 0000000000..097f4d37e2 --- /dev/null +++ b/testing/unit_testing/ecotypes_test/test_Ecotypes.pf @@ -0,0 +1,167 @@ +module test_Ecotypes + ! + ! DESCRIPTION: + ! Test the FATES ecotypes code + ! + use FatesConstantsMod, only : r8 => fates_r8 + use FatesEcotypesMod, only : DoesPatchHaveForest_TreeCover + use FatesEcotypesMod, only : DoesPatchHaveForest_GrassBiomass + use FatesEcotypesMod, only : IsPatchForest + use FatesFactoryMod, only : InitializeParams, InitializeGlobals, GetSyntheticPatch + use FatesPatchMod, only : fates_patch_type + use SyntheticPatchTypes, only : synthetic_patch_array_type + use SyntheticPatchTypes, only : forest_tree_fraction_threshold + use SyntheticPatchTypes, only : grass_biomass_threshold + use FatesArgumentUtils, only : command_line_arg + use funit + + implicit none + + ! LOCALS: + integer :: i + logical :: already_initialized = .false. + + ! CONSTANTS: + integer, parameter :: num_levsoil = 10 ! number of soil layers + real(r8), parameter :: step_size = 1800.0_r8 ! step-size [s] + + @TestCase + type, extends(TestCase) :: TestEcotypes + + type(synthetic_patch_array_type) :: patch_data + type(fates_patch_type), pointer :: patch + + contains + procedure :: setUp + + end type TestEcotypes + + real(r8), parameter :: tol = 1.e-7_r8 + real(r8), parameter :: nan = 0._r8 / 0._r8 + + integer, parameter :: n_to_sort = 5 + + + contains + + subroutine setUp(this) + class(TestEcotypes), intent(inout) :: this + + ! Only need to do this for the first test + if (.not. already_initialized) then + + ! initialize some global data we need + call InitializeParams() + call InitializeGlobals(step_size) + + already_initialized = .true. + end if + end subroutine setUp + + @Test + subroutine test_isforest_tropical(this) + ! Should have high tree cover and no grass, so true for all except grass check. + class(TestEcotypes), intent(inout) :: this + + call this%patch_data%GetSyntheticPatchData('tropical') + call GetSyntheticPatch(this%patch_data%patches(1), num_levsoil, this%patch) + + @assertTrue(DoesPatchHaveForest_TreeCover(this%patch, forest_tree_fraction_threshold)) + @assertTrue(IsPatchForest(this%patch, forest_tree_fraction_threshold)) + @assertFalse(DoesPatchHaveForest_GrassBiomass(this%patch, grass_biomass_threshold)) + @assertTrue(IsPatchForest(this%patch, forest_tree_fraction_threshold, grass_biomass_threshold)) + + end subroutine test_isforest_tropical + + @Test + subroutine test_isforest_evergreen(this) + ! Should have high tree cover and no grass, so true for all except grass check. + class(TestEcotypes), intent(inout) :: this + + call this%patch_data%GetSyntheticPatchData('evergreen') + call GetSyntheticPatch(this%patch_data%patches(1), num_levsoil, this%patch) + + @assertTrue(DoesPatchHaveForest_TreeCover(this%patch, forest_tree_fraction_threshold)) + @assertTrue(IsPatchForest(this%patch, forest_tree_fraction_threshold)) + @assertFalse(DoesPatchHaveForest_GrassBiomass(this%patch, grass_biomass_threshold)) + @assertTrue(IsPatchForest(this%patch, forest_tree_fraction_threshold, grass_biomass_threshold)) + + end subroutine test_isforest_evergreen + + @Test + subroutine test_isforest_savannah(this) + ! Exactly at the thresholds? All should be false. + class(TestEcotypes), intent(inout) :: this + + call this%patch_data%GetSyntheticPatchData('savannah') + call GetSyntheticPatch(this%patch_data%patches(1), num_levsoil, this%patch) + + @assertFalse(DoesPatchHaveForest_TreeCover(this%patch, forest_tree_fraction_threshold)) + @assertFalse(IsPatchForest(this%patch, forest_tree_fraction_threshold)) + @assertFalse(DoesPatchHaveForest_GrassBiomass(this%patch, grass_biomass_threshold)) + @assertFalse(IsPatchForest(this%patch, forest_tree_fraction_threshold, grass_biomass_threshold)) + + end subroutine test_isforest_savannah + + @Test + subroutine test_isforest_savannah_woody(this) + ! Should have high tree cover and little grass, so true for all except grass check. + class(TestEcotypes), intent(inout) :: this + + call this%patch_data%GetSyntheticPatchData('savannah_woody') + call GetSyntheticPatch(this%patch_data%patches(1), num_levsoil, this%patch) + + @assertTrue(DoesPatchHaveForest_TreeCover(this%patch, forest_tree_fraction_threshold)) + @assertTrue(IsPatchForest(this%patch, forest_tree_fraction_threshold)) + @assertFalse(DoesPatchHaveForest_GrassBiomass(this%patch, grass_biomass_threshold)) + @assertTrue(IsPatchForest(this%patch, forest_tree_fraction_threshold, grass_biomass_threshold)) + + end subroutine test_isforest_savannah_woody + + @Test + subroutine test_isforest_savannah_grassy(this) + ! Should have low tree cover and plenty of grass, so false for all except grass check. + class(TestEcotypes), intent(inout) :: this + + call this%patch_data%GetSyntheticPatchData('savannah_grassy') + call GetSyntheticPatch(this%patch_data%patches(1), num_levsoil, this%patch) + + @assertFalse(DoesPatchHaveForest_TreeCover(this%patch, forest_tree_fraction_threshold)) + @assertFalse(IsPatchForest(this%patch, forest_tree_fraction_threshold)) + @assertTrue(DoesPatchHaveForest_GrassBiomass(this%patch, grass_biomass_threshold)) + @assertFalse(IsPatchForest(this%patch, forest_tree_fraction_threshold, grass_biomass_threshold)) + + end subroutine test_isforest_savannah_grassy + + @Test + subroutine test_isforest_grassland(this) + ! Should have no trees and plenty of grass, so false for all except grass check. + class(TestEcotypes), intent(inout) :: this + + call this%patch_data%GetSyntheticPatchData('grassland') + call GetSyntheticPatch(this%patch_data%patches(1), num_levsoil, this%patch) + + @assertFalse(DoesPatchHaveForest_TreeCover(this%patch, forest_tree_fraction_threshold)) + @assertFalse(IsPatchForest(this%patch, forest_tree_fraction_threshold)) + @assertTrue(DoesPatchHaveForest_GrassBiomass(this%patch, grass_biomass_threshold)) + @assertFalse(IsPatchForest(this%patch, forest_tree_fraction_threshold, grass_biomass_threshold)) + + end subroutine test_isforest_grassland + + @Test + subroutine test_isforest_temperate(this) + ! Should have high tree cover and no grass, so true for all except grass check. + class(TestEcotypes), intent(inout) :: this + + call this%patch_data%GetSyntheticPatchData('temperate') + call GetSyntheticPatch(this%patch_data%patches(1), num_levsoil, this%patch) + + @assertTrue(DoesPatchHaveForest_TreeCover(this%patch, forest_tree_fraction_threshold)) + @assertTrue(IsPatchForest(this%patch, forest_tree_fraction_threshold)) + @assertFalse(DoesPatchHaveForest_GrassBiomass(this%patch, grass_biomass_threshold)) + @assertTrue(IsPatchForest(this%patch, forest_tree_fraction_threshold, grass_biomass_threshold)) + + end subroutine test_isforest_temperate + + + end module test_Ecotypes diff --git a/testing/unit_testing/edge_forest_test/CMakeLists.txt b/testing/unit_testing/edge_forest_test/CMakeLists.txt new file mode 100644 index 0000000000..63888cccbd --- /dev/null +++ b/testing/unit_testing/edge_forest_test/CMakeLists.txt @@ -0,0 +1,5 @@ +set(pfunit_sources test_EdgeForest.pf) + +add_pfunit_ctest(EdgeForest + TEST_SOURCES "${pfunit_sources}" + LINK_LIBRARIES fates csm_share) diff --git a/testing/unit_testing/edge_forest_test/test_EdgeForest.pf b/testing/unit_testing/edge_forest_test/test_EdgeForest.pf new file mode 100644 index 0000000000..4bfcd2f009 --- /dev/null +++ b/testing/unit_testing/edge_forest_test/test_EdgeForest.pf @@ -0,0 +1,843 @@ +module test_EdgeForest + ! + ! DESCRIPTION: + ! Test the FATES edge forest code + ! + use FatesConstantsMod, only : r8 => fates_r8, nearzero + use FatesEdgeForestMod, only : indexx + use FatesEdgeForestMod, only : GetFracEdgeForestInEachBin + use FatesEdgeForestMod, only : GetFracEdgeForestInEachBin_norm_numerator, GetFracEdgeForestInEachBin_norm_denominator, GetFracEdgeForestInEachBin_quadratic + use FatesEdgeForestMod, only : GetFracEdgeForestInEachBin_norm + use FatesEdgeForestMod, only : AssignPatchToBins + use FatesEdgeForestMod, only : CalcEdgeForestFlam_1var_1bin + use FatesEdgeForestMod, only : CalcEdgeForestFlam_1var + use FatesEdgeForestMod, only : ApplyEdgeForestFlamToPatch_1var + use FatesEdgeForestMod, only : CheckFlamChangeIntended + use funit + + implicit none + + @TestCase + type, extends(TestCase) :: TestEdgeForest + + real(r8), dimension(:), allocatable :: array_to_sort + integer, dimension(:), allocatable :: sorted_indices + + contains + procedure :: setUp + procedure :: tearDown + end type TestEdgeForest + + real(r8), parameter :: tol = 1.e-7_r8 + real(r8), parameter :: nan = 0._r8 / 0._r8 + + integer, parameter :: n_to_sort = 5 + + + contains + + subroutine setUp(this) + class(TestEdgeForest), intent(inout) :: this + allocate(this%array_to_sort(n_to_sort)) + allocate(this%sorted_indices(n_to_sort)) + end subroutine setUp + + subroutine tearDown(this) + class(TestEdgeForest), intent(inout) :: this + if (allocated(this%array_to_sort)) deallocate(this%array_to_sort) + if (allocated(this%sorted_indices)) deallocate(this%sorted_indices) + end subroutine tearDown + + @Test + subroutine indexx_alreadySorted(this) + class(TestEdgeForest), intent(inout) :: this + + this%array_to_sort = (/ 1._r8, 1.62_r8, 2.72_r8, 3.14_r8, 6.28_r8 /) + + call indexx(this%array_to_sort, this%sorted_indices) + + @assertEqual((/ 1, 2, 3, 4, 5 /), this%sorted_indices) + + end subroutine indexx_alreadySorted + + @Test + subroutine indexx_reverseSorted(this) + class(TestEdgeForest), intent(inout) :: this + + this%array_to_sort = (/ 6.28_r8, 3.14_r8, 2.72_r8, 1.62_r8, 1._r8 /) + + call indexx(this%array_to_sort, this%sorted_indices) + + @assertEqual((/ 5, 4, 3, 2, 1 /), this%sorted_indices) + + end subroutine indexx_reverseSorted + + @Test + subroutine indexx_lowTie(this) + class(TestEdgeForest), intent(inout) :: this + + this%array_to_sort = (/ 1._r8, 1._r8, 2.72_r8, 3.14_r8, 6.28_r8 /) + + call indexx(this%array_to_sort, this%sorted_indices) + + @assertEqual((/ 1, 2, 3, 4, 5 /), this%sorted_indices) + + end subroutine indexx_lowTie + + @Test + subroutine indexx_highTie(this) + class(TestEdgeForest), intent(inout) :: this + + this%array_to_sort = (/ 1._r8, 1.62_r8, 2.72_r8, 3.14_r8, 3.14_r8 /) + + call indexx(this%array_to_sort, this%sorted_indices) + + @assertEqual((/ 1, 2, 3, 4, 5 /), this%sorted_indices) + + end subroutine indexx_highTie + + @Test + subroutine indexx_random(this) + class(TestEdgeForest), intent(inout) :: this + + this%array_to_sort = (/ 3._r8, 8._r8, 10._r8, 2._r8, 7._r8 /) + + call indexx(this%array_to_sort, this%sorted_indices) + + @assertEqual((/ 4, 1, 5, 2, 3 /), this%sorted_indices) + + end subroutine indexx_random + + + @Test + subroutine indexx_all_equal(this) + class(TestEdgeForest), intent(inout) :: this + + this%array_to_sort = (/ 1._r8, 1._r8, 1._r8, 1._r8, 1._r8 /) + + call indexx(this%array_to_sort, this%sorted_indices) + + @assertEqual((/ 1, 2, 3, 4, 5 /), this%sorted_indices) + + end subroutine indexx_all_equal + + + @Test + subroutine test_GetFracEdgeForestInEachBin_with_gaussian(this) + class(TestEdgeForest), intent(inout) :: this + real(r8) :: frac_forest = 0.5_r8 + integer, parameter :: nlevedgeforest_tmp = 1 + real(r8), dimension(nlevedgeforest_tmp) :: efb_params_amplitude = (/ 1._r8 /) + real(r8), dimension(nlevedgeforest_tmp) :: efb_params_sigma = (/ 1._r8 /) + real(r8), dimension(nlevedgeforest_tmp) :: efb_params_center = (/ 1._r8 /) + real(r8), dimension(nlevedgeforest_tmp) :: efb_params_nan = (/ nan /) + logical :: norm = .false. ! DON'T normalize; we want the raw output of Gaussian + ! Output + real(r8), dimension(nlevedgeforest_tmp) :: fraction_forest_in_bin + + call GetFracEdgeForestInEachBin(frac_forest, nlevedgeforest_tmp, & + efb_params_amplitude, efb_params_sigma, efb_params_center, & + efb_params_nan, efb_params_nan, efb_params_nan, & + efb_params_nan, efb_params_nan, efb_params_nan, & + fraction_forest_in_bin, norm) + + @assertEqual(0.3520653267642879_r8, fraction_forest_in_bin(1), tol) + + end subroutine test_GetFracEdgeForestInEachBin_with_gaussian + + + @Test + subroutine test_GetFracEdgeForestInEachBin_with_lognorm(this) + class(TestEdgeForest), intent(inout) :: this + real(r8) :: frac_forest = 0.5_r8 + integer, parameter :: nlevedgeforest_tmp = 1 + real(r8), dimension(nlevedgeforest_tmp) :: efb_params_amplitude = (/ 1._r8 /) + real(r8), dimension(nlevedgeforest_tmp) :: efb_params_sigma = (/ 1._r8 /) + real(r8), dimension(nlevedgeforest_tmp) :: efb_params_center = (/ 1._r8 /) + real(r8), dimension(nlevedgeforest_tmp) :: efb_params_nan = (/ nan /) + logical :: norm = .false. ! DON'T normalize; we want the raw output of Lognormal + ! Output + real(r8), dimension(nlevedgeforest_tmp) :: fraction_forest_in_bin + + call GetFracEdgeForestInEachBin(frac_forest, nlevedgeforest_tmp, & + efb_params_nan, efb_params_nan, efb_params_nan, & + efb_params_amplitude, efb_params_sigma, efb_params_center, & + efb_params_nan, efb_params_nan, efb_params_nan, & + fraction_forest_in_bin, norm) + + @assertEqual(0.19029780481010555, fraction_forest_in_bin(1), tol) + + end subroutine test_GetFracEdgeForestInEachBin_with_lognorm + + + @Test + subroutine test_GetFracEdgeForestInEachBin_with_quadratic(this) + class(TestEdgeForest), intent(inout) :: this + real(r8) :: frac_forest = 0.5_r8 + integer, parameter :: nlevedgeforest_tmp = 1 + real(r8), dimension(nlevedgeforest_tmp) :: efb_params_a = (/ 1._r8 /) + real(r8), dimension(nlevedgeforest_tmp) :: efb_params_b = (/ 1._r8 /) + real(r8), dimension(nlevedgeforest_tmp) :: efb_params_c = (/ 1._r8 /) + real(r8), dimension(nlevedgeforest_tmp) :: efb_params_nan = (/ nan /) + logical :: norm = .false. ! DON'T normalize; we want the raw output of Quadratic + ! Output + real(r8), dimension(nlevedgeforest_tmp) :: fraction_forest_in_bin + + call GetFracEdgeForestInEachBin(frac_forest, nlevedgeforest_tmp, & + efb_params_nan, efb_params_nan, efb_params_nan, & + efb_params_nan, efb_params_nan, efb_params_nan, & + efb_params_a, efb_params_b, efb_params_c, & + fraction_forest_in_bin, norm) + + @assertEqual(1.75, fraction_forest_in_bin(1), tol) + + end subroutine test_GetFracEdgeForestInEachBin_with_quadratic + + + @Test + subroutine test_GetFracEdgeForestInEachBin_with_norm(this) + ! Test that normalization works correctly: If all bins have the same parameters, they should + ! get normalized to 1/nbins. + class(TestEdgeForest), intent(inout) :: this + real(r8) :: frac_forest = 0.5_r8 + integer, parameter :: nlevedgeforest_tmp = 3 + real(r8), dimension(nlevedgeforest_tmp) :: efb_params_a = (/ 1._r8, 1._r8, 1._r8 /) + real(r8), dimension(nlevedgeforest_tmp) :: efb_params_b = (/ 1._r8, 1._r8, 1._r8 /) + real(r8), dimension(nlevedgeforest_tmp) :: efb_params_c = (/ 1._r8, 1._r8, 1._r8 /) + real(r8), dimension(nlevedgeforest_tmp) :: efb_params_nan = (/ nan, nan, nan /) + logical :: norm = .true. + ! Output + real(r8), dimension(nlevedgeforest_tmp) :: fraction_forest_in_bin + real(r8) :: expected = 1._r8 / real(nlevedgeforest_tmp, r8) + + call GetFracEdgeForestInEachBin(frac_forest, nlevedgeforest_tmp, & + efb_params_nan, efb_params_nan, efb_params_nan, & + efb_params_nan, efb_params_nan, efb_params_nan, & + efb_params_a, efb_params_b, efb_params_c, & + fraction_forest_in_bin, norm) + + @assertEqual(expected, fraction_forest_in_bin(1), tol) + @assertEqual(expected, fraction_forest_in_bin(2), tol) + @assertEqual(expected, fraction_forest_in_bin(3), tol) + + end subroutine test_GetFracEdgeForestInEachBin_with_norm + + + @Test + subroutine test_GetFracEdgeForestInEachBin_x_near0(this) + ! If frac forest is zero, all forest should be in first edge bin (closest to edge) + class(TestEdgeForest), intent(inout) :: this + real(r8) :: frac_forest = nearzero / 2._r8 + integer, parameter :: nlevedgeforest_tmp = 3 + real(r8), dimension(nlevedgeforest_tmp) :: efb_params_dummy = (/ 1._r8, 2._r8, 3._r8 /) + logical :: norm = .false. ! Shouldn't matter for this test + ! Output + real(r8), dimension(nlevedgeforest_tmp) :: fraction_forest_in_bin + + call GetFracEdgeForestInEachBin(frac_forest, nlevedgeforest_tmp, & + efb_params_dummy, efb_params_dummy, efb_params_dummy, & + efb_params_dummy, efb_params_dummy, efb_params_dummy, & + efb_params_dummy, efb_params_dummy, efb_params_dummy, & + fraction_forest_in_bin, norm) + + @assertEqual( (/ 1._r8, 0._r8, 0._r8 /) , fraction_forest_in_bin) + + end subroutine test_GetFracEdgeForestInEachBin_x_near0 + + @Test + subroutine test_GetFracEdgeForestInEachBin_x_near0_norm(this) + ! If frac forest is zero, all forest should be in first edge bin (closest to edge) + ! Same test as test_GetFracEdgeForestInEachBin_x_near0, except norm=.true. + ! Shouldn't matter! + class(TestEdgeForest), intent(inout) :: this + real(r8) :: frac_forest = nearzero / 2._r8 + integer, parameter :: nlevedgeforest_tmp = 3 + real(r8), dimension(nlevedgeforest_tmp) :: efb_params_dummy = (/ 1._r8, 2._r8, 3._r8 /) + logical :: norm = .true. ! Shouldn't matter for this test + ! Output + real(r8), dimension(nlevedgeforest_tmp) :: fraction_forest_in_bin + + call GetFracEdgeForestInEachBin(frac_forest, nlevedgeforest_tmp, & + efb_params_dummy, efb_params_dummy, efb_params_dummy, & + efb_params_dummy, efb_params_dummy, efb_params_dummy, & + efb_params_dummy, efb_params_dummy, efb_params_dummy, & + fraction_forest_in_bin, norm) + + @assertEqual( (/ 1._r8, 0._r8, 0._r8 /) , fraction_forest_in_bin) + + end subroutine test_GetFracEdgeForestInEachBin_x_near0_norm + + @Test + subroutine test_GetFracEdgeForestInEachBin_x1(this) + ! If frac forest is one, all forest should be in last edge bin ("deep forest") + class(TestEdgeForest), intent(inout) :: this + real(r8) :: frac_forest = 1._r8 + integer, parameter :: nlevedgeforest_tmp = 3 + real(r8), dimension(nlevedgeforest_tmp) :: efb_params_dummy = (/ 1._r8, 2._r8, 3._r8 /) + logical :: norm = .false. ! Shouldn't matter for this test + ! Output + real(r8), dimension(nlevedgeforest_tmp) :: fraction_forest_in_bin + + call GetFracEdgeForestInEachBin(frac_forest, nlevedgeforest_tmp, & + efb_params_dummy, efb_params_dummy, efb_params_dummy, & + efb_params_dummy, efb_params_dummy, efb_params_dummy, & + efb_params_dummy, efb_params_dummy, efb_params_dummy, & + fraction_forest_in_bin, norm) + + @assertEqual( (/ 0._r8, 0._r8, 1._r8 /) , fraction_forest_in_bin) + + end subroutine test_GetFracEdgeForestInEachBin_x1 + + @Test + subroutine test_GetFracEdgeForestInEachBin_x1_norm(this) + ! If frac forest is one, all forest should be in last edge bin ("deep forest"). + ! Same test as test_GetFracEdgeForestInEachBin_x1, except norm=.true. + ! Shouldn't matter! + class(TestEdgeForest), intent(inout) :: this + real(r8) :: frac_forest = 1._r8 + integer, parameter :: nlevedgeforest_tmp = 3 + real(r8), dimension(nlevedgeforest_tmp) :: efb_params_dummy = (/ 1._r8, 2._r8, 3._r8 /) + logical :: norm = .true. ! Shouldn't matter for this test + ! Output + real(r8), dimension(nlevedgeforest_tmp) :: fraction_forest_in_bin + + call GetFracEdgeForestInEachBin(frac_forest, nlevedgeforest_tmp, & + efb_params_dummy, efb_params_dummy, efb_params_dummy, & + efb_params_dummy, efb_params_dummy, efb_params_dummy, & + efb_params_dummy, efb_params_dummy, efb_params_dummy, & + fraction_forest_in_bin, norm) + + @assertEqual( (/ 0._r8, 0._r8, 1._r8 /) , fraction_forest_in_bin) + + end subroutine test_GetFracEdgeForestInEachBin_x1_norm + + @Test + subroutine test_gffeb_lognorm_numerator(this) + class(TestEdgeForest), intent(inout) :: this + real(r8) :: x + real(r8) :: A ! Amplitude + real(r8) :: mu ! Center + real(r8) :: sigma ! Sigma + real(r8) :: expected + real(r8) :: actual + logical :: lognorm + + x = 10._r8 + ! Bin 4 + A = 1.601064269911203 + sigma = 0.8465094354405984 + mu = 1.973996133523811 + expected = 1.4848754270133655 + lognorm = .true. + + actual = GetFracEdgeForestInEachBin_norm_numerator(x, A, mu, sigma, lognorm) + + @assertEqual(expected, actual, tolerance=tol) + + end subroutine test_gffeb_lognorm_numerator + + @Test + subroutine test_gffeb_gaussian_numerator(this) + class(TestEdgeForest), intent(inout) :: this + real(r8) :: x + real(r8) :: A ! Amplitude + real(r8) :: mu ! Center + real(r8) :: sigma ! Sigma + real(r8) :: expected + real(r8) :: actual + logical :: lognorm + + x = 0.87 + A = 2 + sigma = 3 + mu = 4 + expected = 1.160527865802580 + lognorm = .false. + + actual = GetFracEdgeForestInEachBin_norm_numerator(x, A, mu, sigma, lognorm) + + @assertEqual(expected, actual, tolerance=tol) + + end subroutine test_gffeb_gaussian_numerator + + @Test + subroutine test_GetFracEdgeForestInEachBin_norm_lognorm(this) + class(TestEdgeForest), intent(inout) :: this + real(r8) :: x + real(r8) :: A ! Amplitude + real(r8) :: mu ! Center + real(r8) :: sigma ! Sigma + real(r8) :: expected + real(r8) :: actual + logical :: lognorm + + x = 0.87 + A = 2 + sigma = 3 + mu = 4 + expected = 0.11800808319557105 + lognorm = .true. + + actual = GetFracEdgeForestInEachBin_norm(x, A, mu, sigma, lognorm) + + @assertEqual(expected, actual, tolerance=tol) + + end subroutine test_GetFracEdgeForestInEachBin_norm_lognorm + + @Test + subroutine test_GetFracEdgeForestInEachBin_norm_gaussian(this) + class(TestEdgeForest), intent(inout) :: this + real(r8) :: x + real(r8) :: A ! Amplitude + real(r8) :: mu ! Center + real(r8) :: sigma ! Sigma + real(r8) :: expected + real(r8) :: actual + logical :: lognorm + + x = 0.87 + A = 2 + sigma = 3 + mu = 4 + expected = 0.1543278780068184 + lognorm = .false. + + actual = GetFracEdgeForestInEachBin_norm(x, A, mu, sigma, lognorm) + + @assertEqual(expected, actual, tolerance=tol) + + end subroutine test_GetFracEdgeForestInEachBin_norm_gaussian + + @Test + subroutine test_gffeb_lognorm_denominator(this) + class(TestEdgeForest), intent(inout) :: this + real(r8) :: x + real(r8) :: A ! Amplitude + real(r8) :: mu ! Center + real(r8) :: sigma ! Sigma + real(r8) :: expected + real(r8) :: actual + logical :: lognorm + + x = 10._r8 + ! Bin 4 + sigma = 0.8465094354405984 + expected = 21.21884485617329 + lognorm = .true. + + actual = GetFracEdgeForestInEachBin_norm_denominator(x, sigma, lognorm) + + @assertEqual(expected, actual, tolerance=tol) + + end subroutine test_gffeb_lognorm_denominator + + @Test + subroutine test_gffeb_gaussian_denominator(this) + class(TestEdgeForest), intent(inout) :: this + real(r8) :: x + real(r8) :: A ! Amplitude + real(r8) :: mu ! Center + real(r8) :: sigma ! Sigma + real(r8) :: expected + real(r8) :: actual + logical :: lognorm + + x = 0.5_r8 + ! Bin 4 + sigma = 0.8465094354405984 + expected = 2.121884538742686 + lognorm = .false. + + actual = GetFracEdgeForestInEachBin_norm_denominator(x, sigma, lognorm) + + @assertEqual(expected, actual, tolerance=tol) + + end subroutine test_gffeb_gaussian_denominator + + @Test + subroutine test_GetFracEdgeForestInEachBin_quadratic(this) + class(TestEdgeForest), intent(inout) :: this + real(r8) :: x = 0.4_r8 + real(r8) :: a = 1987._r8 + real(r8) :: b = 2025._r8 + real(r8) :: c = 1984._r8 + real(r8) :: expected = 3111.92_r8 + real(r8) :: actual + + actual = GetFracEdgeForestInEachBin_quadratic(x, a, b, c) + + @assertEqual(expected, actual, tolerance=tol) + + end subroutine test_GetFracEdgeForestInEachBin_quadratic + + @Test + subroutine test_AssignPatchToBins_01(this) + ! The site has just one forest patch. All of the site's forest area is in the bin closest to edge. + class(TestEdgeForest), intent(inout) :: this + integer, parameter :: nlevedgeforest_tmp = 3 + + ! The site has 100 area of forest + real(r8) :: area_forest_patches = 100._r8 + + ! The size of this patch is 100 area + real(r8) :: patch_area = 100._r8 + + ! So far none of the site's forest area has been allocated to any bin + real(r8) :: sum_forest_bins_so_far_m2 = 0._r8 + + ! Out + real(r8), dimension(nlevedgeforest_tmp) :: area_in_edgeforest_bins + + ! All of the site's forest is in the bin closest to edge + real(r8), dimension(nlevedgeforest_tmp), target :: fraction_forest_in_each_bin + fraction_forest_in_each_bin = (/ 1._r8, 0._r8, 0._r8 /) + + call AssignPatchToBins(fraction_forest_in_each_bin, area_forest_patches, patch_area, & + nlevedgeforest_tmp, tol, sum_forest_bins_so_far_m2, area_in_edgeforest_bins) + + ! 0+100=100 area of the site's forest has been assigned after this call + @assertEqual(100._r8, sum_forest_bins_so_far_m2, tolerance=tol) + + ! All of the patch's area was assigned to the first edge bin + @assertEqual(100._r8, area_in_edgeforest_bins(1), tolerance=tol) + end subroutine test_AssignPatchToBins_01 + + @Test + subroutine test_AssignPatchToBins_02(this) + ! The site has multiple forest patches. All of the site's forest area is in the bin closest to edge. + class(TestEdgeForest), intent(inout) :: this + integer, parameter :: nlevedgeforest_tmp = 3 + + ! The site has 300 area of forest + real(r8) :: area_forest_patches = 300._r8 + + ! The size of this patch is 100 area + real(r8) :: patch_area = 100._r8 + + ! So far none of the site's forest area has been allocated to any bin + real(r8) :: sum_forest_bins_so_far_m2 = 0._r8 + + ! Out + real(r8), dimension(nlevedgeforest_tmp) :: area_in_edgeforest_bins + + ! All of the site's forest is in the bin closest to edge + real(r8), dimension(nlevedgeforest_tmp), target :: fraction_forest_in_each_bin + fraction_forest_in_each_bin = (/ 1._r8, 0._r8, 0._r8 /) + + call AssignPatchToBins(fraction_forest_in_each_bin, area_forest_patches, patch_area, & + nlevedgeforest_tmp, tol, sum_forest_bins_so_far_m2, area_in_edgeforest_bins) + + ! 0+100=100 area of the site's forest has been assigned after this call + @assertEqual(100._r8, sum_forest_bins_so_far_m2, tolerance=tol) + + ! All of the patch's area was assigned to the first edge bin + @assertEqual(100._r8, area_in_edgeforest_bins(1), tolerance=tol) + @assertEqual(0._r8, area_in_edgeforest_bins(2), tolerance=tol) + @assertEqual(0._r8, area_in_edgeforest_bins(3), tolerance=tol) + end subroutine test_AssignPatchToBins_02 + + @Test + subroutine test_AssignPatchToBins_03(this) + ! The site has just one forest patch. The site's forest split evenly across the two bins closest to edge. + class(TestEdgeForest), intent(inout) :: this + integer, parameter :: nlevedgeforest_tmp = 3 + + ! The site has 100 area of forest + real(r8) :: area_forest_patches = 100._r8 + + ! The size of this patch is 100 area + real(r8) :: patch_area = 100._r8 + + ! So far none of the site's forest area has been allocated to any bin + real(r8) :: sum_forest_bins_so_far_m2 = 0._r8 + + ! Out + real(r8), dimension(nlevedgeforest_tmp) :: area_in_edgeforest_bins + + ! The site's forest split evenly across the two bins closest to edge + real(r8), dimension(nlevedgeforest_tmp), target :: fraction_forest_in_each_bin + fraction_forest_in_each_bin = (/ 0.5_r8, 0.5_r8, 0._r8 /) + + call AssignPatchToBins(fraction_forest_in_each_bin, area_forest_patches, patch_area, & + nlevedgeforest_tmp, tol, sum_forest_bins_so_far_m2, area_in_edgeforest_bins) + + ! 0+100=100 area of the site's forest has been assigned after this call + @assertEqual(100._r8, sum_forest_bins_so_far_m2, tolerance=tol) + + ! Half of the patch's area was assigned to the first edge bin, half to the second + @assertEqual(50._r8, area_in_edgeforest_bins(1), tolerance=tol) + @assertEqual(50._r8, area_in_edgeforest_bins(2), tolerance=tol) + @assertEqual(0._r8, area_in_edgeforest_bins(3), tolerance=tol) + end subroutine test_AssignPatchToBins_03 + + @Test + subroutine test_AssignPatchToBins_04(this) + ! The site has just one forest patch. The site's forest is split evenly across the two bins farthest from edge. + class(TestEdgeForest), intent(inout) :: this + integer, parameter :: nlevedgeforest_tmp = 3 + + ! The site has 100 area of forest + real(r8) :: area_forest_patches = 100._r8 + + ! The size of this patch is 100 area + real(r8) :: patch_area = 100._r8 + + ! So far none of the site's forest area has been allocated to any bin + real(r8) :: sum_forest_bins_so_far_m2 = 0._r8 + + ! Out + real(r8), dimension(nlevedgeforest_tmp) :: area_in_edgeforest_bins + + ! The site's forest is split evenly across the two bins farthest from edge + real(r8), dimension(nlevedgeforest_tmp), target :: fraction_forest_in_each_bin + fraction_forest_in_each_bin = (/ 0._r8, 0.5_r8, 0.5_r8 /) + + call AssignPatchToBins(fraction_forest_in_each_bin, area_forest_patches, patch_area, & + nlevedgeforest_tmp, tol, sum_forest_bins_so_far_m2, area_in_edgeforest_bins) + + ! 0+100=100 area of the site's forest has been assigned after this call + @assertEqual(100._r8, sum_forest_bins_so_far_m2, tolerance=tol) + + ! Half of the patch's area was assigned to the second edge bin, half to the third + @assertEqual(0._r8, area_in_edgeforest_bins(1), tolerance=tol) + @assertEqual(50._r8, area_in_edgeforest_bins(2), tolerance=tol) + @assertEqual(50._r8, area_in_edgeforest_bins(3), tolerance=tol) + end subroutine test_AssignPatchToBins_04 + + @Test + subroutine test_AssignPatchToBins_05(this) + ! The site has multiple forest patches. Some of the site's forest area has already been assigned. The patch isn't big enough to take the rest of the site's forest area. + class(TestEdgeForest), intent(inout) :: this + integer, parameter :: nlevedgeforest_tmp = 3 + + ! The site has 100 area of forest + real(r8) :: area_forest_patches = 100._r8 + + ! The size of this patch is 50 area + real(r8) :: patch_area = 50._r8 + + ! So far 30 of the site's forest area has been allocated to any bin + real(r8) :: sum_forest_bins_so_far_m2 = 30._r8 + + ! Out + real(r8), dimension(nlevedgeforest_tmp) :: area_in_edgeforest_bins + + ! The site's forest is split evenly across the two bins farthest from edge + real(r8), dimension(nlevedgeforest_tmp), target :: fraction_forest_in_each_bin + fraction_forest_in_each_bin = (/ 0._r8, 0.5_r8, 0.5_r8 /) + + call AssignPatchToBins(fraction_forest_in_each_bin, area_forest_patches, patch_area, & + nlevedgeforest_tmp, tol, sum_forest_bins_so_far_m2, area_in_edgeforest_bins) + + ! 30+50=80 area of the site's forest has been assigned after this call + @assertEqual(80._r8, sum_forest_bins_so_far_m2, tolerance=tol) + + ! Some of the patch's area was assigned to the second edge bin, rest to the third + @assertEqual(0._r8, area_in_edgeforest_bins(1), tolerance=tol) + @assertEqual(20._r8, area_in_edgeforest_bins(2), tolerance=tol) + @assertEqual(30._r8, area_in_edgeforest_bins(3), tolerance=tol) + end subroutine test_AssignPatchToBins_05 + + @Test + subroutine test_calculate_edgeforest_flammability_onevar_onebin(this) + ! Test applying a flammability enhancement to one variable for one edge bin + class(TestEdgeForest), intent(inout) :: this + real(r8) :: mult_factor = 2._r8 + real(r8) :: add_factor = 3._r8 + real(r8) :: weather_in = 5._r8 + real(r8) :: weather_out + + weather_out = CalcEdgeForestFlam_1var_1bin(mult_factor, add_factor, weather_in) + + @assertEqual(13._r8, weather_out, tolerance=tol) + end subroutine test_calculate_edgeforest_flammability_onevar_onebin + + @Test + subroutine test_calculate_edgeforest_flammability_onevar_onebin_nochange(this) + ! Test applying a flammability enhancement to one variable for one edge bin, expecting no change + class(TestEdgeForest), intent(inout) :: this + real(r8) :: mult_factor = 1._r8 + real(r8) :: add_factor = 0._r8 + real(r8) :: weather_in = 5._r8 + real(r8) :: weather_out + + weather_out = CalcEdgeForestFlam_1var_1bin(mult_factor, add_factor, weather_in) + + @assertEqual(5._r8, weather_out, tolerance=0._r8) + end subroutine test_calculate_edgeforest_flammability_onevar_onebin_nochange + + @Test + subroutine test_calculate_edgeforest_flammability_onevar(this) + ! Test applying a flammability enhancement to one variable for multiple edge bins + class(TestEdgeForest), intent(inout) :: this + real(r8) :: mult_factors(2) = [2._r8, 0.4_r8] + real(r8) :: add_factors(2) = [3._r8, -1._r8] + real(r8) :: weather_in = 5._r8 + real(r8) :: weather_out(2) + + call CalcEdgeForestFlam_1var(mult_factors, add_factors, weather_in, weather_out) + + @assertEqual(13._r8, weather_out(1), tolerance=tol) + @assertEqual(1._r8, weather_out(2), tolerance=tol) + end subroutine test_calculate_edgeforest_flammability_onevar + + @Test + subroutine test_calculate_edgeforest_flammability_onevar_nochange(this) + ! Test applying a flammability enhancement to one variable for multiple edge bins, expecting no change + class(TestEdgeForest), intent(inout) :: this + real(r8) :: mult_factors(2) = [1._r8, 1._r8] + real(r8) :: add_factors(2) = [0._r8, 0._r8] + real(r8) :: weather_in = 5._r8 + real(r8) :: weather_out(2) + + call CalcEdgeForestFlam_1var(mult_factors, add_factors, weather_in, weather_out) + + @assertEqual(5._r8, weather_out(1), tolerance=tol) + @assertEqual(5._r8, weather_out(2), tolerance=tol) + end subroutine test_calculate_edgeforest_flammability_onevar_nochange + + @Test + subroutine test_apply_ef_flam_2patch_onevar_noforest(this) + ! Test applying a flammability enhancement to one patch with no forest + class(TestEdgeForest), intent(inout) :: this + real(r8) :: weather_by_edge_bin(3) = [2._r8, 2._r8, 10._r8] + real(r8) :: patch_area_each_edge_bin(3) = [0._r8, 0._r8, 0._r8] + real(r8) :: weather_inout = 5._r8 + + call ApplyEdgeForestFlamToPatch_1var(weather_by_edge_bin, patch_area_each_edge_bin, weather_inout) + + @assertEqual(5._r8, weather_inout, tolerance=0._r8) + end subroutine test_apply_ef_flam_2patch_onevar_noforest + + @Test + subroutine test_apply_ef_flam_2patch_onevar_1bin(this) + ! Test applying a flammability enhancement to one patch with forest in 1 bin + class(TestEdgeForest), intent(inout) :: this + real(r8) :: weather_by_edge_bin(3) = [2._r8, 2._r8, 5._r8] + real(r8) :: patch_area_each_edge_bin(3) = [16._r8, 0._r8, 0._r8] + real(r8) :: weather_inout = 5._r8 + + call ApplyEdgeForestFlamToPatch_1var(weather_by_edge_bin, patch_area_each_edge_bin, weather_inout) + + @assertEqual(2._r8, weather_inout, tolerance=tol) + end subroutine test_apply_ef_flam_2patch_onevar_1bin + + @Test + subroutine test_apply_ef_flam_2patch_onevar_allbins(this) + ! Test applying a flammability enhancement to one patch with forest in all bins + class(TestEdgeForest), intent(inout) :: this + real(r8) :: weather_by_edge_bin(3) = [2._r8, 2._r8, 9._r8] + real(r8) :: patch_area_each_edge_bin(3) = [16._r8, 32._r8, 64._r8] + real(r8) :: weather_inout = 9._r8 + + call ApplyEdgeForestFlamToPatch_1var(weather_by_edge_bin, patch_area_each_edge_bin, weather_inout) + + @assertEqual(6._r8, weather_inout, tolerance=tol) + end subroutine test_apply_ef_flam_2patch_onevar_allbins + + @Test + subroutine test_apply_ef_flam_2patch_onevar_allbins_nochange(this) + ! Test applying a flammability enhancement to one patch with forest in all bins, expecting no change + class(TestEdgeForest), intent(inout) :: this + real(r8) :: weather_by_edge_bin(3) = [9._r8, 9._r8, 9._r8] + real(r8) :: patch_area_each_edge_bin(3) = [1.e-30_r8, 32._r8, 64._r8] + real(r8) :: weather_inout = 9._r8 + + call ApplyEdgeForestFlamToPatch_1var(weather_by_edge_bin, patch_area_each_edge_bin, weather_inout) + + @assertEqual(9._r8, weather_inout, tolerance=0._r8) + + @assertTrue(all([9._r8, 9._r8, 9._r8] == 9._r8)) + end subroutine test_apply_ef_flam_2patch_onevar_allbins_nochange + + @Test + subroutine test_check_change_intended_true_justadd(this) + ! Test CheckFlamChangeIntended() returning false with only additive changes + class(TestEdgeForest), intent(inout) :: this + real(r8) :: params_mult(3) = [1._r8, 1._r8, 1._r8] + real(r8) :: params_add(3) = [1.e-30_r8, 32._r8, 64._r8] + real(r8) :: weather_before = 9._r8 + real(r8) :: weather_after = 10._r8 + real(r8) :: tol2 = 1.e-9_r8 + + @assertTrue(CheckFlamChangeIntended(params_mult, params_add, weather_before, weather_after, tol2)) + + end subroutine test_check_change_intended_true_justadd + + @Test + subroutine test_check_change_intended_true_justadd_neg(this) + ! Test CheckFlamChangeIntended() returning false with only negative additive changes + class(TestEdgeForest), intent(inout) :: this + real(r8) :: params_mult(3) = [1._r8, 1._r8, 1._r8] + real(r8) :: params_add(3) = [-1.e-30_r8, -32._r8, -64._r8] + real(r8) :: weather_before = 9._r8 + real(r8) :: weather_after = 10._r8 + real(r8) :: tol2 = 1.e-9_r8 + + @assertTrue(CheckFlamChangeIntended(params_mult, params_add, weather_before, weather_after, tol2)) + + end subroutine test_check_change_intended_true_justadd_neg + + @Test + subroutine test_check_change_intended_true_justmult(this) + ! Test CheckFlamChangeIntended() returning false with only multiplicative changes + class(TestEdgeForest), intent(inout) :: this + real(r8) :: params_mult(3) = [1.2_r8, 1.3_r8, 1.4_r8] + real(r8) :: params_add(3) = [0._r8, 0._r8, 0._r8] + real(r8) :: weather_before = 9._r8 + real(r8) :: weather_after = 10._r8 + real(r8) :: tol2 = 1.e-9_r8 + + @assertTrue(CheckFlamChangeIntended(params_mult, params_add, weather_before, weather_after, tol2)) + + end subroutine test_check_change_intended_true_justmult + + @Test + subroutine test_check_change_intended_true_justmult_neg(this) + ! Test CheckFlamChangeIntended() returning false with only negative multiplicative changes + class(TestEdgeForest), intent(inout) :: this + real(r8) :: params_mult(3) = [-1.2_r8, -1.3_r8, -1.4_r8] + real(r8) :: params_add(3) = [0._r8, 0._r8, 0._r8] + real(r8) :: weather_before = 9._r8 + real(r8) :: weather_after = 10._r8 + real(r8) :: tol2 = 1.e-9_r8 + + @assertTrue(CheckFlamChangeIntended(params_mult, params_add, weather_before, weather_after, tol2)) + + end subroutine test_check_change_intended_true_justmult_neg + + @Test + subroutine test_check_change_intended_true_both(this) + ! Test CheckFlamChangeIntended() returning false with both additive and multiplicative changes + class(TestEdgeForest), intent(inout) :: this + real(r8) :: params_mult(3) = [1.2_r8, 1.3_r8, 1.4_r8] + real(r8) :: params_add(3) = [0._r8, 2._r8, 22._r8] + real(r8) :: weather_before = 9._r8 + real(r8) :: weather_after + real(r8) :: tol2 = 1.e-9_r8 + + ! Check that tolerance works + weather_after = weather_before + tol * (1._r8 + tol * 1.e-3_r8) + + @assertTrue(CheckFlamChangeIntended(params_mult, params_add, weather_before, weather_after, tol2)) + + end subroutine test_check_change_intended_true_both + + @Test + subroutine test_check_change_intended_false(this) + ! Test CheckFlamChangeIntended() returning false with neither additive nor multiplicative changes + class(TestEdgeForest), intent(inout) :: this + real(r8) :: params_mult(3) = [1._r8, 1._r8, 1._r8] + real(r8) :: params_add(3) = [0._r8, 0._r8, 0._r8] + real(r8) :: weather_before = 9._r8 + real(r8) :: weather_after + real(r8) :: tol2 = 1.e-9_r8 + + ! Check that tolerance works + weather_after = weather_before + tol * 1.e-3_r8 + + @assertFalse(CheckFlamChangeIntended(params_mult, params_add, weather_before, weather_after, tol2)) + + end subroutine test_check_change_intended_false + + end module test_EdgeForest diff --git a/testing/unit_testing/fire_weather_test/test_FireWeather.pf b/testing/unit_testing/fire_weather_test/test_FireWeather.pf index 65149a46e3..ebfe49bc37 100644 --- a/testing/unit_testing/fire_weather_test/test_FireWeather.pf +++ b/testing/unit_testing/fire_weather_test/test_FireWeather.pf @@ -43,7 +43,8 @@ module test_FireWeather real(r8) :: wind = 0.0_r8 ! wind speed [m/s] - call this%fireWeatherNesterov%UpdateIndex(tempC, precip, rh, wind) + call this%fireWeatherNesterov%UpdateFireWeatherData(tempC, precip, rh, wind) + call this%fireWeatherNesterov%UpdateIndex() @assertEqual(this%fireWeatherNesterov%fire_weather_index, 0.0_r8, tolerance=tol) @@ -58,7 +59,8 @@ module test_FireWeather real(r8) :: rh = 10.0_r8 ! relative humidity [%] real(r8) :: wind = 0.0_r8 ! wind speed [m/s] - call this%fireWeatherNesterov%UpdateIndex(tempC, precip, rh, wind) + call this%fireWeatherNesterov%UpdateFireWeatherData(tempC, precip, rh, wind) + call this%fireWeatherNesterov%UpdateIndex() @assertGreaterThan(this%fireWeatherNesterov%fire_weather_index, 0.0_r8, tolerance=tol) @@ -74,7 +76,8 @@ module test_FireWeather real(r8) :: wind = 0.0_r8 ! wind speed [m/s] - call this%fireWeatherNesterov%UpdateIndex(tempC, precip, rh, wind) + call this%fireWeatherNesterov%UpdateFireWeatherData(tempC, precip, rh, wind) + call this%fireWeatherNesterov%UpdateIndex() @assertEqual(this%fireWeatherNesterov%fire_weather_index, 0.0_r8, tolerance=tol) @@ -89,7 +92,14 @@ module test_FireWeather real(r8) :: grass_fraction = 0.5_r8 ! grass fraction [0-1] real(r8) :: bare_fraction = 0.0_r8 ! bare fraction [0-1] - call this%fireWeatherNesterov%UpdateEffectiveWindSpeed(wind_speed, tree_fraction, & + call this%fireWeatherNesterov%UpdateFireWeatherData( & + this%fireWeatherNesterov%temp_C, & + this%fireWeatherNesterov%precip, & + this%fireWeatherNesterov%rh, & + wind_speed) + call this%fireWeatherNesterov%UpdateIndex() + + call this%fireWeatherNesterov%UpdateEffectiveWindSpeed(tree_fraction, & grass_fraction, bare_fraction) @assertEqual(this%fireWeatherNesterov%effective_windspeed, 0.0_r8, tolerance=tol) @@ -104,7 +114,14 @@ module test_FireWeather real(r8) :: grass_fraction = 0.5_r8 ! grass fraction [0-1] real(r8) :: bare_fraction = 0.0_r8 ! bare fraction [0-1] - call this%fireWeatherNesterov%UpdateEffectiveWindSpeed(wind_speed, tree_fraction, & + call this%fireWeatherNesterov%UpdateFireWeatherData( & + this%fireWeatherNesterov%temp_C, & + this%fireWeatherNesterov%precip, & + this%fireWeatherNesterov%rh, & + wind_speed) + call this%fireWeatherNesterov%UpdateIndex() + + call this%fireWeatherNesterov%UpdateEffectiveWindSpeed(tree_fraction, & grass_fraction, bare_fraction) @assertLessThan(this%fireWeatherNesterov%effective_windspeed, wind_speed, tolerance=tol) diff --git a/testing/unit_tests.cfg b/testing/unit_tests.cfg index 426ff34874..bd4b1635ce 100644 --- a/testing/unit_tests.cfg +++ b/testing/unit_tests.cfg @@ -1,6 +1,12 @@ [fire_weather] test_dir = fates_fire_weather_utest +[ecotypes] +test_dir = fates_ecotypes_utest + +[edge_forest] +test_dir = fates_edge_forest_utest + [fire_fuel] test_dir = fates_fire_fuel_utest @@ -17,4 +23,4 @@ test_dir = fates_validate_cohorts_utest test_dir = fates_count_cohorts_utest [fire_equations] -test_dir = fates_fire_equations_utest \ No newline at end of file +test_dir = fates_fire_equations_utest diff --git a/testing/utils.py b/testing/utils.py index 55978cc7d0..186e3ab64a 100644 --- a/testing/utils.py +++ b/testing/utils.py @@ -53,6 +53,9 @@ def create_nc_from_cdl(cdl_path: str, run_dir: str) -> str: file_basename = os.path.basename(cdl_path).split(".")[-2] file_nc_name = f"{file_basename}.nc" + if not os.path.exists(run_dir): + os.makedirs(run_dir) + file_gen_command = ["ncgen -o", os.path.join(run_dir, file_nc_name), cdl_path] out = run_cmd_no_fail(" ".join(file_gen_command), combine_output=True) print(out) @@ -109,6 +112,7 @@ def config_to_dict(config_file: str) -> dict: # Define list of config file options that we expect to be paths options_that_are_paths = ["datm_file"] + options_that_are_bools = ["use_param_file"] config = configparser.ConfigParser() config.read(config_file) @@ -123,6 +127,10 @@ def config_to_dict(config_file: str) -> dict: if option in options_that_are_paths: value = get_abspath_from_config_file(value, config_file) + # If the option is one that we expect to be a boolean, convert it from string. + if option in options_that_are_bools: + value = str_to_bool(value) + # Save value to dictionary dictionary[section][option] = value @@ -172,6 +180,8 @@ def str_to_bool(val: str) -> bool: Returns: bool: True or False """ + if isinstance(val, bool): + return val if val.lower() in ("y", "yes", "t", "true", "on", "1"): return True if val.lower() in ("n", "no", "f", "false", "off", "0"): diff --git a/testing/utils_plotting.py b/testing/utils_plotting.py index df38b80617..5436cac353 100644 --- a/testing/utils_plotting.py +++ b/testing/utils_plotting.py @@ -3,6 +3,7 @@ import math import matplotlib.pyplot as plt +from matplotlib import colormaps def blank_plot( @@ -99,3 +100,11 @@ def get_color_palette(number: int) -> list: ] return colors[:number] + + +def sample_colormap(this_colormap: str, n_colors: int, i: int) -> tuple: + """ + Given a colormap and a number of desired colors evenly spaced along it, get the i'th color + """ + color = colormaps[this_colormap](i / (n_colors - 1)) + return color