From 4fcb869bcca85df79868a493ed9b3da5f9d93028 Mon Sep 17 00:00:00 2001 From: ckoven Date: Thu, 18 Aug 2022 15:49:20 -0600 Subject: [PATCH 1/4] added basal-area and crown-area weghted mean heights --- main/FatesHistoryInterfaceMod.F90 | 35 +++++++++++++++++++++++++++++-- 1 file changed, 33 insertions(+), 2 deletions(-) diff --git a/main/FatesHistoryInterfaceMod.F90 b/main/FatesHistoryInterfaceMod.F90 index 7ab5c9c0ca..ff462a83f7 100644 --- a/main/FatesHistoryInterfaceMod.F90 +++ b/main/FatesHistoryInterfaceMod.F90 @@ -195,6 +195,9 @@ module FatesHistoryInterfaceMod integer :: ih_fates_fraction_si + integer :: ih_ba_weighted_height + integer :: ih_ca_weighted_height + integer :: ih_cwd_elcwd integer :: ih_litter_in_si ! carbon only @@ -1807,6 +1810,8 @@ subroutine update_history_dyn(this,nc,nsites,sites) hio_area_plant_si => this%hvars(ih_area_plant_si)%r81d, & hio_area_trees_si => this%hvars(ih_area_trees_si)%r81d, & hio_fates_fraction_si => this%hvars(ih_fates_fraction_si)%r81d, & + hio_ba_weighted_height => this%hvars(ih_ba_weighted_height)%r81d, & + hio_ca_weighted_height => this%hvars(ih_ca_weighted_height)%r81d, & hio_canopy_spread_si => this%hvars(ih_canopy_spread_si)%r81d, & hio_biomass_si_pft => this%hvars(ih_biomass_si_pft)%r82d, & hio_leafbiomass_si_pft => this%hvars(ih_leafbiomass_si_pft)%r82d, & @@ -2535,17 +2540,21 @@ subroutine update_history_dyn(this,nc,nsites,sites) ! basal area [m2/m2] hio_ba_si_scpf(io_si,scpf) = hio_ba_si_scpf(io_si,scpf) + & - 0.25_r8*3.14159_r8*((dbh/100.0_r8)**2.0_r8)*ccohort%n / m2_per_ha + 0.25_r8*pi_const*((dbh/100.0_r8)**2.0_r8)*ccohort%n / m2_per_ha ! also by size class only hio_ba_si_scls(io_si,scls) = hio_ba_si_scls(io_si,scls) + & - 0.25_r8*3.14159_r8*((dbh/100.0_r8)**2.0_r8)* & + 0.25_r8*pi_const*((dbh/100.0_r8)**2.0_r8)* & ccohort%n / m2_per_ha ! growth increment hio_ddbh_si_scpf(io_si,scpf) = hio_ddbh_si_scpf(io_si,scpf) + & ccohort%ddbhdt*ccohort%n / m2_per_ha * m_per_cm + hio_ba_weighted_height(io_si) = hio_ba_weighted_height(io_si) + & + ccohort%hite * & + 0.25_r8*pi_const*((dbh/100.0_r8)**2.0_r8)*ccohort%n / m2_per_ha + end if ! mortality sums [#/m2] @@ -2753,6 +2762,9 @@ subroutine update_history_dyn(this,nc,nsites,sites) hio_yesterdaycanopylevel_canopy_si_scls(io_si,scls) = & hio_yesterdaycanopylevel_canopy_si_scls(io_si,scls) + & ccohort%canopy_layer_yesterday * ccohort%n / m2_per_ha + + hio_ca_weighted_height(io_si) = hio_ca_weighted_height(io_si) + & + ccohort%hite * ccohort%c_area / m2_per_ha else canlayer hio_nplant_understory_si_scag(io_si,iscag) = hio_nplant_understory_si_scag(io_si,iscag) + ccohort%n / m2_per_ha hio_mortality_understory_si_scag(io_si,iscag) = hio_mortality_understory_si_scag(io_si,iscag) + & @@ -2954,6 +2966,13 @@ subroutine update_history_dyn(this,nc,nsites,sites) cpatch => cpatch%younger end do patchloop !patch loop + ! divide basal-area-weighted height by basal area to get mean + if ( sum(hio_ba_si_scpf(io_si,:)) .gt. tiny ) then + hio_ba_weighted_height(io_si) = hio_ba_weighted_height(io_si) / sum(hio_ba_si_scpf(io_si,:)) + else + hio_ba_weighted_height(io_si) = 0._r8 + endif + ! divide so-far-just-summed but to-be-averaged patch-age-class variables by patch-age-class area to get mean values do ipa2 = 1, nlevage if (hio_area_si_age(io_si, ipa2) .gt. tiny) then @@ -4459,6 +4478,18 @@ subroutine define_history_vars(this, initialize_variables) upfreq=1, ivar=ivar, initialize=initialize_variables, & index=ih_fates_fraction_si, flush_to_zero=.true.) + call this%set_history_var(vname='FATES_BA_WEIGHTED_HEIGHT', units='m', & + long='basal area-weighted mean height of woody plants', use_default='active', & + avgflag='A', vtype=site_r8, hlms='CLM:ALM', & + upfreq=1, ivar=ivar, initialize=initialize_variables, & + index=ih_ba_weighted_heght_si) + + call this%set_history_var(vname='FATES_CA_WEIGHTED_HEIGHT', units='m', & + long='crown area-weighted mean height of canopy plants', use_default='active', & + avgflag='A', vtype=site_r8, hlms='CLM:ALM', & + upfreq=1, ivar=ivar, initialize=initialize_variables, & + index=ih_ca_weighted_heght_si) + call this%set_history_var(vname='FATES_COLD_STATUS', units='', & long='site-level cold status, 0=not cold-dec, 1=too cold for leaves, 2=not too cold', & use_default='active', avgflag='A', vtype=site_r8, hlms='CLM:ALM', & From 4a004f9b307e9026ffd6c5800a4f569d15ba73f3 Mon Sep 17 00:00:00 2001 From: ckoven Date: Thu, 18 Aug 2022 22:08:54 -0600 Subject: [PATCH 2/4] fix typo --- main/FatesHistoryInterfaceMod.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/main/FatesHistoryInterfaceMod.F90 b/main/FatesHistoryInterfaceMod.F90 index ff462a83f7..2941418635 100644 --- a/main/FatesHistoryInterfaceMod.F90 +++ b/main/FatesHistoryInterfaceMod.F90 @@ -4482,13 +4482,13 @@ subroutine define_history_vars(this, initialize_variables) long='basal area-weighted mean height of woody plants', use_default='active', & avgflag='A', vtype=site_r8, hlms='CLM:ALM', & upfreq=1, ivar=ivar, initialize=initialize_variables, & - index=ih_ba_weighted_heght_si) + index=ih_ba_weighted_height_si) call this%set_history_var(vname='FATES_CA_WEIGHTED_HEIGHT', units='m', & long='crown area-weighted mean height of canopy plants', use_default='active', & avgflag='A', vtype=site_r8, hlms='CLM:ALM', & upfreq=1, ivar=ivar, initialize=initialize_variables, & - index=ih_ca_weighted_heght_si) + index=ih_ca_weighted_height_si) call this%set_history_var(vname='FATES_COLD_STATUS', units='', & long='site-level cold status, 0=not cold-dec, 1=too cold for leaves, 2=not too cold', & From 2c2eb561584833c9e221eea13727c9ef4d11b809 Mon Sep 17 00:00:00 2001 From: ckoven Date: Thu, 18 Aug 2022 22:40:07 -0600 Subject: [PATCH 3/4] fixing more typos --- main/FatesHistoryInterfaceMod.F90 | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/main/FatesHistoryInterfaceMod.F90 b/main/FatesHistoryInterfaceMod.F90 index 2941418635..23190290c5 100644 --- a/main/FatesHistoryInterfaceMod.F90 +++ b/main/FatesHistoryInterfaceMod.F90 @@ -195,8 +195,8 @@ module FatesHistoryInterfaceMod integer :: ih_fates_fraction_si - integer :: ih_ba_weighted_height - integer :: ih_ca_weighted_height + integer :: ih_ba_weighted_height_si + integer :: ih_ca_weighted_height_si integer :: ih_cwd_elcwd @@ -1810,8 +1810,8 @@ subroutine update_history_dyn(this,nc,nsites,sites) hio_area_plant_si => this%hvars(ih_area_plant_si)%r81d, & hio_area_trees_si => this%hvars(ih_area_trees_si)%r81d, & hio_fates_fraction_si => this%hvars(ih_fates_fraction_si)%r81d, & - hio_ba_weighted_height => this%hvars(ih_ba_weighted_height)%r81d, & - hio_ca_weighted_height => this%hvars(ih_ca_weighted_height)%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, & hio_canopy_spread_si => this%hvars(ih_canopy_spread_si)%r81d, & hio_biomass_si_pft => this%hvars(ih_biomass_si_pft)%r82d, & hio_leafbiomass_si_pft => this%hvars(ih_leafbiomass_si_pft)%r82d, & @@ -2551,7 +2551,7 @@ subroutine update_history_dyn(this,nc,nsites,sites) hio_ddbh_si_scpf(io_si,scpf) = hio_ddbh_si_scpf(io_si,scpf) + & ccohort%ddbhdt*ccohort%n / m2_per_ha * m_per_cm - hio_ba_weighted_height(io_si) = hio_ba_weighted_height(io_si) + & + hio_ba_weighted_height_si(io_si) = hio_ba_weighted_height_si(io_si) + & ccohort%hite * & 0.25_r8*pi_const*((dbh/100.0_r8)**2.0_r8)*ccohort%n / m2_per_ha @@ -2763,7 +2763,7 @@ subroutine update_history_dyn(this,nc,nsites,sites) hio_yesterdaycanopylevel_canopy_si_scls(io_si,scls) + & ccohort%canopy_layer_yesterday * ccohort%n / m2_per_ha - hio_ca_weighted_height(io_si) = hio_ca_weighted_height(io_si) + & + hio_ca_weighted_height_si(io_si) = hio_ca_weighted_height_si(io_si) + & ccohort%hite * ccohort%c_area / m2_per_ha else canlayer hio_nplant_understory_si_scag(io_si,iscag) = hio_nplant_understory_si_scag(io_si,iscag) + ccohort%n / m2_per_ha @@ -2968,9 +2968,9 @@ subroutine update_history_dyn(this,nc,nsites,sites) ! divide basal-area-weighted height by basal area to get mean if ( sum(hio_ba_si_scpf(io_si,:)) .gt. tiny ) then - hio_ba_weighted_height(io_si) = hio_ba_weighted_height(io_si) / sum(hio_ba_si_scpf(io_si,:)) + hio_ba_weighted_height_si(io_si) = hio_ba_weighted_height_si(io_si) / sum(hio_ba_si_scpf(io_si,:)) else - hio_ba_weighted_height(io_si) = 0._r8 + hio_ba_weighted_height_si(io_si) = 0._r8 endif ! divide so-far-just-summed but to-be-averaged patch-age-class variables by patch-age-class area to get mean values From 82bdb8327631a34ca015ae2c94c04b32403e2c9c Mon Sep 17 00:00:00 2001 From: ckoven Date: Tue, 30 Aug 2022 12:42:46 -0600 Subject: [PATCH 4/4] changed tiny to nearzero --- main/FatesHistoryInterfaceMod.F90 | 13 +++++-------- 1 file changed, 5 insertions(+), 8 deletions(-) diff --git a/main/FatesHistoryInterfaceMod.F90 b/main/FatesHistoryInterfaceMod.F90 index 23190290c5..3d55be3e49 100644 --- a/main/FatesHistoryInterfaceMod.F90 +++ b/main/FatesHistoryInterfaceMod.F90 @@ -1799,7 +1799,6 @@ subroutine update_history_dyn(this,nc,nsites,sites) type(ed_patch_type),pointer :: cpatch type(ed_cohort_type),pointer :: ccohort - real(r8), parameter :: tiny = 1.e-5_r8 ! some small number real(r8), parameter :: reallytalltrees = 1000. ! some large number (m) integer :: tmp @@ -2967,7 +2966,7 @@ subroutine update_history_dyn(this,nc,nsites,sites) end do patchloop !patch loop ! divide basal-area-weighted height by basal area to get mean - if ( sum(hio_ba_si_scpf(io_si,:)) .gt. tiny ) then + if ( sum(hio_ba_si_scpf(io_si,:)) .gt. nearzero ) then hio_ba_weighted_height_si(io_si) = hio_ba_weighted_height_si(io_si) / sum(hio_ba_si_scpf(io_si,:)) else hio_ba_weighted_height_si(io_si) = 0._r8 @@ -2975,7 +2974,7 @@ subroutine update_history_dyn(this,nc,nsites,sites) ! divide so-far-just-summed but to-be-averaged patch-age-class variables by patch-age-class area to get mean values do ipa2 = 1, nlevage - if (hio_area_si_age(io_si, ipa2) .gt. tiny) then + if (hio_area_si_age(io_si, ipa2) .gt. nearzero) then hio_lai_si_age(io_si, ipa2) = hio_lai_si_age(io_si, ipa2) / (hio_area_si_age(io_si, ipa2)*AREA) hio_ncl_si_age(io_si, ipa2) = hio_ncl_si_age(io_si, ipa2) / (hio_area_si_age(io_si, ipa2)*AREA) do i_pft = 1, numpft @@ -3562,7 +3561,6 @@ subroutine update_history_hifrq(this,nc,nsites,sites,bc_in,dt_tstep) real(r8) :: patch_area_by_age(nlevage) ! patch area in each bin for normalizing purposes real(r8) :: canopy_area_by_age(nlevage) ! canopy area in each bin for normalizing purposes real(r8) :: site_area_veg ! area of the site that is not bare-ground - real(r8), parameter :: tiny = 1.e-5_r8 ! some small number integer :: ipa2 ! patch incrementer integer :: cnlfpft_indx, cnlf_indx, ipft, ican, ileaf ! more iterators and indices type(ed_patch_type),pointer :: cpatch @@ -3938,7 +3936,7 @@ subroutine update_history_hifrq(this,nc,nsites,sites,bc_in,dt_tstep) end do !patch loop do ipa2 = 1, nlevage - if (patch_area_by_age(ipa2) .gt. tiny) then + if (patch_area_by_age(ipa2) .gt. nearzero) then hio_gpp_si_age(io_si, ipa2) = hio_gpp_si_age(io_si, ipa2) / (patch_area_by_age(ipa2)) hio_npp_si_age(io_si, ipa2) = hio_npp_si_age(io_si, ipa2) / (patch_area_by_age(ipa2)) else @@ -3947,7 +3945,7 @@ subroutine update_history_hifrq(this,nc,nsites,sites,bc_in,dt_tstep) endif ! Normalize resistance diagnostics - if (canopy_area_by_age(ipa2) .gt. tiny) then + if (canopy_area_by_age(ipa2) .gt. nearzero) then hio_c_stomata_si_age(io_si,ipa2) = & hio_c_stomata_si_age(io_si,ipa2) / canopy_area_by_age(ipa2) @@ -3961,7 +3959,7 @@ subroutine update_history_hifrq(this,nc,nsites,sites,bc_in,dt_tstep) end do ! Normalize resistance diagnostics - if ( sum(canopy_area_by_age(1:nlevage)) .gt. tiny) then + if ( sum(canopy_area_by_age(1:nlevage)) .gt. nearzero) then hio_c_stomata_si(io_si) = hio_c_stomata_si(io_si) / sum(canopy_area_by_age(1:nlevage)) hio_c_lblayer_si(io_si) = hio_c_lblayer_si(io_si) / sum(canopy_area_by_age(1:nlevage)) else @@ -4003,7 +4001,6 @@ subroutine update_history_hydraulics(this,nc,nsites,sites,bc_in,dt_tstep) integer :: ipa ! The local "I"ndex of "PA"tches integer :: ft ! functional type index ! integer :: io_shsl ! The combined "SH"ell "S"oil "L"ayer index in the IO array - real(r8), parameter :: tiny = 1.e-5_r8 ! some small number real(r8) :: ncohort_scpf(nlevsclass*maxpft) ! Bins to count up cohorts counts used in weighting ! should be "hio_nplant_si_scpf" real(r8) :: nplant_scpf(nlevsclass*maxpft) ! Bins to count up cohorts counts used in weighting