From 97889a4fb641b7b739499fb2d3393b029638fa9c Mon Sep 17 00:00:00 2001 From: Marcos Longo Date: Thu, 8 Jan 2026 17:08:01 -0300 Subject: [PATCH] This pull request simply fixes the spelling of "height" throughout the ED2 code. I do not see a reason to call it "hite"... --- ED/Template/Template/patchprops.r | 2 +- ED/Template/compare_qm_profiles.r | 2 +- ED/src/dynamics/canopy_struct_dynamics.f90 | 28 ++--- ED/src/dynamics/disturbance.f90 | 62 +++++------ ED/src/dynamics/events.f90 | 46 ++++---- ED/src/dynamics/fire.f90 | 2 +- ED/src/dynamics/growth_balive.f90 | 30 +++--- ED/src/dynamics/mortality.f90 | 30 +++--- ED/src/dynamics/phenology_aux.f90 | 2 +- ED/src/dynamics/phenology_driv.f90 | 15 +-- ED/src/dynamics/photosyn_driv.f90 | 4 +- ED/src/dynamics/plant_hydro.f90 | 32 +++--- ED/src/dynamics/reproduction.f90 | 24 ++--- ED/src/dynamics/rk4_copy_patch.f90 | 16 +-- ED/src/dynamics/rk4_integ_utils.f90 | 12 +-- ED/src/dynamics/rk4_misc.f90 | 18 ++-- ED/src/dynamics/stem_resp_driv.f90 | 2 +- ED/src/dynamics/structural_growth.f90 | 36 +++---- ED/src/init/ed_bigleaf_init.f90 | 18 ++-- ED/src/init/ed_nbg_init.f90 | 61 +++++------ ED/src/init/ed_params.f90 | 12 +-- ED/src/init/ed_type_init.f90 | 6 +- ED/src/io/ed_init_history.f90 | 4 +- ED/src/io/ed_read_ed10_20_history.f90 | 30 +++--- ED/src/io/ed_read_ed21_history.f90 | 102 +++++++++--------- ED/src/io/ed_read_ed22_initial.f90 | 29 ++--- ED/src/io/ed_xml_config.f90 | 14 +-- ED/src/memory/disturb_coms.f90 | 12 +-- ED/src/memory/ed_state_vars.F90 | 18 ++-- ED/src/memory/pft_coms.f90 | 12 +-- ED/src/utils/allometry.f90 | 118 ++++++++++----------- ED/src/utils/ed_therm_lib.f90 | 12 +-- ED/src/utils/fuse_fiss_utils.f90 | 118 +++++++++++---------- ED/src/utils/hrzshade_utils.f90 | 12 +-- ED/src/utils/stable_cohorts.f90 | 12 +-- ED/src/utils/update_derived_utils.f90 | 33 +++--- R-utils/ptcloud.2.patch.r | 18 ++-- R-utils/read.q.files.r | 4 +- 38 files changed, 512 insertions(+), 496 deletions(-) diff --git a/ED/Template/Template/patchprops.r b/ED/Template/Template/patchprops.r index 1ae619445..9b4894c71 100644 --- a/ED/Template/Template/patchprops.r +++ b/ED/Template/Template/patchprops.r @@ -238,7 +238,7 @@ for (ipy in 1:nplaces){ cpatch[[ipa]]$cai = myhist$CROWN.AREA[icoa:icoz] cpatch[[ipa]]$agb = myhist$AGB.CO[icoa:icoz] cpatch[[ipa]]$ba = myhist$BA.CO[icoa:icoz] - cpatch[[ipa]]$height = myhist$HITE[icoa:icoz] + cpatch[[ipa]]$height = myhist$HEIGHT[icoa:icoz] patch.lai[ipa] = sum(cpatch[[ipa]]$lai) patch.wai[ipa] = sum(cpatch[[ipa]]$wai) patch.tai[ipa] = sum(cpatch[[ipa]]$tai) diff --git a/ED/Template/compare_qm_profiles.r b/ED/Template/compare_qm_profiles.r index b4b2dea99..a26634b86 100644 --- a/ED/Template/compare_qm_profiles.r +++ b/ED/Template/compare_qm_profiles.r @@ -806,7 +806,7 @@ if ( (! file.exists(summary.fullname)) || plot.site){ # Map the height to the closest DART level. # #---------------------------------------------------------------------------# ipft = mymont$PFT - ed.hgt = mymont$HITE + ed.hgt = mymont$HEIGHT dart.hgt = ( zdart.above * (ed.hgt - pft$hgt.min[ipft]) / (pft$hgt.max[ipft] - pft$hgt.min[ipft]) ) dart.hgt = mapply(FUN=closest,x=dart.hgt,MoreArgs=list(A=zdart[-1])) diff --git a/ED/src/dynamics/canopy_struct_dynamics.f90 b/ED/src/dynamics/canopy_struct_dynamics.f90 index e41548af1..04e7bec8c 100644 --- a/ED/src/dynamics/canopy_struct_dynamics.f90 +++ b/ED/src/dynamics/canopy_struct_dynamics.f90 @@ -664,7 +664,7 @@ subroutine canopy_turbulence8(csite,initp,ipa,ibuff) !---------------------------------------------------------------------------------! !----- Find the wind at the top of the canopy. -----------------------------------! uh = reduced_wind8(initp%ustar,initp%zeta,initp%ribulk,rk4site%geoht & - ,initp%veg_displace,dble(cpatch%hite(1)),initp%rough) + ,initp%veg_displace,dble(cpatch%height(1)),initp%rough) !---------------------------------------------------------------------------------! ! In this version we still base ourselves on the Leuning et al. (1995) model, ! @@ -842,8 +842,8 @@ subroutine canopy_turbulence8(csite,initp,ipa,ibuff) !---------------------------------------------------------------------------------! !----- Top of canopy wind speed. -------------------------------------------------! uh = reduced_wind8(initp%ustar,initp%zeta,initp%ribulk,rk4site%geoht & - ,initp%veg_displace,dble(cpatch%hite(1)),initp%rough) - htop = dble(cpatch%hite(1)) + ,initp%veg_displace,dble(cpatch%height(1)),initp%rough) + htop = dble(cpatch%height(1)) do ico=1,cpatch%ncohorts !----- Alias for PFT type. ----------------------------------------------------! @@ -853,8 +853,8 @@ subroutine canopy_turbulence8(csite,initp,ipa,ibuff) !----- Estimate the height center of the crown. -------------------------------! - htopcrown = dble(cpatch%hite(ico)) - hbotcrown = dble(h2crownbh(cpatch%hite(ico),ipft)) + htopcrown = dble(cpatch%height(ico)) + hbotcrown = dble(h2crownbh(cpatch%height(ico),ipft)) hmidcrown = 5.d-1 * (htopcrown + hbotcrown) !------------------------------------------------------------------------------! @@ -965,7 +965,7 @@ subroutine canopy_turbulence8(csite,initp,ipa,ibuff) !---------------------------------------------------------------------------------! ! Find the top layer and the top height. ! !---------------------------------------------------------------------------------! - zcan = min(ncanlyr,ceiling((dble(cpatch%hite(1)) * zztop0i8)**ehgti8)) + zcan = min(ncanlyr,ceiling((dble(cpatch%height(1)) * zztop0i8)**ehgti8)) htop = zztop8(zcan) !---------------------------------------------------------------------------------! @@ -998,7 +998,7 @@ subroutine canopy_turbulence8(csite,initp,ipa,ibuff) else !--use dbh for trees waiuse = 1.d-1 * initp%nplant(ico) * dble(cpatch%sla(ico)) & - * dble(size2bl(cpatch%dbh(ico),cpatch%hite(ico) & + * dble(size2bl(cpatch%dbh(ico),cpatch%height(ico) & ,cpatch%sla(ico),ipft)) end if !---------------------------------------------------------------------------! @@ -1007,8 +1007,8 @@ subroutine canopy_turbulence8(csite,initp,ipa,ibuff) !---------------------------------------------------------------------------! ! Find the heights, and compute the LAD of this cohort. ! !---------------------------------------------------------------------------! - htopcrown = dble(cpatch%hite(ico)) - hbotcrown = dble(h2crownbh(cpatch%hite(ico),cpatch%pft(ico))) + htopcrown = dble(cpatch%height(ico)) + hbotcrown = dble(h2crownbh(cpatch%height(ico),cpatch%pft(ico))) ladcohort = (initp%lai(ico) + waiuse) / (htopcrown - hbotcrown) kapartial = min(ncanlyr,floor ((hbotcrown * zztop0i8)**ehgti8) + 1) kafull = min(ncanlyr,ceiling((hbotcrown * zztop0i8)**ehgti8) + 1) @@ -1064,15 +1064,15 @@ subroutine canopy_turbulence8(csite,initp,ipa,ibuff) !---------------------------------------------------------------------------! ! Find the heights, and compute the LAD of this cohort. ! !---------------------------------------------------------------------------! - htopcrown = dble(cpatch%hite(ico)) - hbotcrown = dble(h2crownbh(cpatch%hite(ico),ipft)) + htopcrown = dble(cpatch%height(ico)) + hbotcrown = dble(h2crownbh(cpatch%height(ico),ipft)) if (dry_grasses) then !------------------------------------------------------------------------! ! Dry grasses only. Create a pseudo TAI so it won't be a ! ! singularity. ! !------------------------------------------------------------------------! tai_drygrass = dble( elongf_min & - * size2bl(cpatch%dbh(ico),cpatch%hite(ico) & + * size2bl(cpatch%dbh(ico),cpatch%height(ico) & ,cpatch%sla(ico),ipft)) ladcohort = tai_drygrass / (htopcrown - hbotcrown) !------------------------------------------------------------------------! @@ -1263,8 +1263,8 @@ subroutine canopy_turbulence8(csite,initp,ipa,ibuff) ipft = cpatch%pft(ico) !----- Find the crown relevant heights. ---------------------------------------! - htopcrown = dble(cpatch%hite(ico)) - hbotcrown = dble(h2crownbh(cpatch%hite(ico),cpatch%pft(ico))) + htopcrown = dble(cpatch%height(ico)) + hbotcrown = dble(h2crownbh(cpatch%height(ico),cpatch%pft(ico))) !------------------------------------------------------------------------------! diff --git a/ED/src/dynamics/disturbance.f90 b/ED/src/dynamics/disturbance.f90 index 44ef4da90..66f14a65e 100644 --- a/ED/src/dynamics/disturbance.f90 +++ b/ED/src/dynamics/disturbance.f90 @@ -49,8 +49,8 @@ subroutine apply_disturbances(cgrid) , lianas_included ! ! intent(in) use disturb_coms , only : min_patch_area & ! intent(in) , plantation_year & ! intent(in) - , treefall_hite_threshold & ! intent(in) - , does_hite_limit_tfpatch & ! intent(in) + , treefall_height_threshold & ! intent(in) + , does_height_limit_tfpatch & ! intent(in) , min_oldgrowth ! ! intent(in) use ed_max_dims , only : n_dist_types & ! intent(in) , n_pft & ! intent(in) @@ -423,8 +423,8 @@ subroutine apply_disturbances(cgrid) lambda_now(3) = 0. !------------------------------------------------------------------------! else - if ( does_hite_limit_tfpatch .and. & - cpatch%hite(1) < treefall_hite_threshold ) then + if ( does_height_limit_tfpatch .and. & + cpatch%height(1) < treefall_height_threshold ) then !----- Tallest cohort is too short to create gaps. -------------------! lambda_now(3) = 0. !---------------------------------------------------------------------! @@ -4037,9 +4037,9 @@ subroutine plant_patch(csite,np,mzg,pft,density,ntext_soil,height_factor,lsl) ! SAS approximation, assign height and use it to find DBH and the structural ! ! (dead) biomass. ! !---------------------------------------------------------------------------------! - cpatch%hite (nc) = hgt_min(cpatch%pft(nc)) * min(1.0,height_factor) - cpatch%dbh (nc) = h2dbh(cpatch%hite(nc),cpatch%pft(nc)) - bdead = size2bd(cpatch%dbh(nc),cpatch%hite(nc),cpatch%pft(nc)) + cpatch%height(nc) = hgt_min(cpatch%pft(nc)) * min(1.0,height_factor) + cpatch%dbh (nc) = h2dbh(cpatch%height(nc),cpatch%pft(nc)) + bdead = size2bd(cpatch%dbh(nc),cpatch%height(nc),cpatch%pft(nc)) cpatch%bdeada(nc) = agf_bs(cpatch%pft(nc)) * bdead cpatch%bdeadb(nc) = (1.0 - agf_bs(cpatch%pft(nc)) ) * bdead !---------------------------------------------------------------------------------! @@ -4049,9 +4049,9 @@ subroutine plant_patch(csite,np,mzg,pft,density,ntext_soil,height_factor,lsl) ! Big leaf approximation, assign the typical DBH and height and use them to ! ! find height and the structural (dead) biomass. ! !---------------------------------------------------------------------------------! - cpatch%hite (nc) = hgt_max(cpatch%pft(nc)) + cpatch%height(nc) = hgt_max(cpatch%pft(nc)) cpatch%dbh (nc) = dbh_bigleaf(cpatch%pft(nc)) - bdead = size2bd(cpatch%dbh(nc),cpatch%hite(nc),cpatch%pft(nc)) + bdead = size2bd(cpatch%dbh(nc),cpatch%height(nc),cpatch%pft(nc)) cpatch%bdeada(nc) = agf_bs(cpatch%pft(nc)) * bdead cpatch%bdeadb(nc) = (1.0 - agf_bs(cpatch%pft(nc)) ) * bdead !---------------------------------------------------------------------------------! @@ -4073,11 +4073,11 @@ subroutine plant_patch(csite,np,mzg,pft,density,ntext_soil,height_factor,lsl) ! phenology (or start with 1.0 if the plant doesn't shed their leaves due to water ! ! stress. ! !------------------------------------------------------------------------------------! - call pheninit_balive_bstorage(mzg,cpatch%pft(nc),cpatch%krdepth(nc),cpatch%hite(nc) & - ,cpatch%dbh(nc),cpatch%sla(nc),csite%soil_water(:,np) & - ,ntext_soil,cpatch%paw_avg(nc),cpatch%elongf(nc) & - ,cpatch%phenology_status(nc),cpatch%bleaf(nc) & - ,cpatch%broot(nc),cpatch%bsapwooda(nc) & + call pheninit_balive_bstorage(mzg,cpatch%pft(nc),cpatch%krdepth(nc) & + ,cpatch%height(nc),cpatch%dbh(nc),cpatch%sla(nc) & + ,csite%soil_water(:,np),ntext_soil,cpatch%paw_avg(nc) & + ,cpatch%elongf(nc),cpatch%phenology_status(nc) & + ,cpatch%bleaf(nc),cpatch%broot(nc),cpatch%bsapwooda(nc) & ,cpatch%bsapwoodb(nc),cpatch%bbarka(nc) & ,cpatch%bbarkb(nc),cpatch%bstorage(nc),cpatch%cb(:,nc) & ,cpatch%cb_lightmax(:,nc),cpatch%cb_moistmax(:,nc) & @@ -4100,11 +4100,12 @@ subroutine plant_patch(csite,np,mzg,pft,density,ntext_soil,height_factor,lsl) !----- Find the new basal area and above-ground biomass. ----------------------------! cpatch%basarea (nc) = pio4 * cpatch%dbh(nc) * cpatch%dbh(nc) cpatch%agb (nc) = ed_biomass(cpatch, nc) - cpatch%btimber (nc) = size2bt(cpatch%dbh(nc),cpatch%hite(nc),cpatch%bdeada(nc) & - ,cpatch%bsapwooda(nc),cpatch%bbarka(nc) & - ,cpatch%pft(nc)) - cpatch%thbark (nc) = size2xb(cpatch%dbh(nc),cpatch%hite(nc),cpatch%bbarka(nc) & - ,cpatch%bbarkb(nc),cpatch%sla(nc),cpatch%pft(nc)) + cpatch%btimber (nc) = size2bt(cpatch%dbh(nc),cpatch%height(nc) & + ,cpatch%bdeada(nc),cpatch%bsapwooda(nc) & + ,cpatch%bbarka(nc),cpatch%pft(nc)) + cpatch%thbark (nc) = size2xb(cpatch%dbh(nc),cpatch%height(nc) & + ,cpatch%bbarka(nc),cpatch%bbarkb(nc) & + ,cpatch%sla(nc),cpatch%pft(nc)) cpatch%leaf_temp (nc) = csite%can_temp (np) cpatch%leaf_temp_pv (nc) = csite%can_temp (np) cpatch%leaf_water (nc) = 0.0 @@ -4249,8 +4250,8 @@ subroutine prune_lianas(csite, np, lsl) !---------------------------------------------------------------------------------! !---------- Loop over cohorts to find the maximum height for trees ---------------! - if (cpatch%hite(ico) > maxh .and. .not. is_liana(ipft)) then - maxh = cpatch%hite(ico) + if (cpatch%height(ico) > maxh .and. .not. is_liana(ipft)) then + maxh = cpatch%height(ico) end if end do cohortloop @@ -4271,8 +4272,8 @@ subroutine prune_lianas(csite, np, lsl) !---------------------------------------------------------------------------------! ! Attention: if maxh turns out to be less than 1 m there's gonna be a problem - ! because cpatch%hite will be increased instead of reduced - if (is_liana(ipft) .and. cpatch%hite(ico) > maxh .and. maxh >= 1.0) then + ! because cpatch%height will be increased instead of reduced + if (is_liana(ipft) .and. cpatch%height(ico) > maxh .and. maxh >= 1.0) then bleaf_in = cpatch%bleaf (ico) bsapa_in = cpatch%bsapwooda (ico) @@ -4288,18 +4289,19 @@ subroutine prune_lianas(csite, np, lsl) !if new root depth is smaller keep the old one keep track of the value ! Lianas of 35m will be reduced to maxh, all - cpatch%hite(ico) = max(cpatch%hite(ico) * h_pruning_factor, 1.0) - cpatch%dbh(ico) = h2dbh (cpatch%hite(ico), ipft) - bleaf_max = size2bl(cpatch%dbh(ico), cpatch%hite(ico) & + cpatch%height(ico) = max(cpatch%height(ico) * h_pruning_factor, 1.0) + cpatch%dbh(ico) = h2dbh (cpatch%height(ico), ipft) + bleaf_max = size2bl(cpatch%dbh(ico), cpatch%height(ico) & ,cpatch%sla(ico), ipft) cpatch%bleaf(ico) = bleaf_max * cpatch%elongf(ico) cpatch%bdeada(ico) = agf_bs(ipft) & - * size2bd(cpatch%dbh(ico), cpatch%hite(ico), ipft) - cpatch%bsapwooda(ico) = agf_bs(ipft) * bleaf_max * qsw(ipft) * cpatch%hite(ico) + * size2bd(cpatch%dbh(ico), cpatch%height(ico), ipft) + cpatch%bsapwooda(ico) = agf_bs(ipft) * bleaf_max * qsw(ipft) & + * cpatch%height(ico) ! (MLO) Manfredo: although qbark is set to zero, check whether these changes ! are consistent with your rationale. cpatch%bbarka (ico) = agf_bs(ipft) * bleaf_max * qbark(ipft) & - * cpatch%hite(ico) + * cpatch%height(ico) !----- Updating LAI, WAI, and CAI. --------------------------------------------! @@ -4311,7 +4313,7 @@ subroutine prune_lianas(csite, np, lsl) cpatch%agb(ico) = ed_biomass(cpatch, ico) !----- Update rooting depth ---------------------------------------------------! - cpatch%krdepth(ico) = size2krdepth(cpatch%hite(ico),cpatch%dbh(ico),ipft,lsl) + cpatch%krdepth(ico) = size2krdepth(cpatch%height(ico),cpatch%dbh(ico),ipft,lsl) !if new root depth is smaller keep the old one !------------------------------------------------------------------------------! diff --git a/ED/src/dynamics/events.f90 b/ED/src/dynamics/events.f90 index 80a454c83..2941e3132 100644 --- a/ED/src/dynamics/events.f90 +++ b/ED/src/dynamics/events.f90 @@ -360,22 +360,23 @@ subroutine event_harvest(agb_frac8,bgb_frac8,fol_frac8,stor_frac8) pft = cpatch%pft(ico) !! calc new pool sizes - ialloc = 1.0 / (1.0 + q(pft) + (qsw(pft)+qbark(pft))*cpatch%hite(ico)) + ialloc = 1.0 & + / (1.0 + q(pft) + (qsw(pft)+qbark(pft))*cpatch%height(ico)) bdeada_new = cpatch%bdeada(ico) * ( 1.0 - agb_frac) bdeada_new = max(0.0, bdeada_new) bdeadb_new = cpatch%bdeadb(ico) * ( 1.0 - bgb_frac) bdeadb_new = max(0.0, bdeadb_new) - bsapa_new = cpatch%balive(ico) * qsw(pft) * cpatch%hite(ico) * ialloc & + bsapa_new = cpatch%balive(ico) * qsw(pft) * cpatch%height(ico) * ialloc & * agf_bs(pft) * (1.0-agb_frac) bsapa_new = max(0.0, bsapa_new) - bsapb_new = cpatch%balive(ico) * qsw(pft) * cpatch%hite(ico) * ialloc & + bsapb_new = cpatch%balive(ico) * qsw(pft) * cpatch%height(ico) * ialloc & * (1.0 - agf_bs(pft)) * (1.0-bgb_frac) bsapb_new = max(0.0, bsapb_new) - bbarka_new = cpatch%balive(ico) * qbark(pft) * cpatch%hite(ico) * ialloc & - * agf_bs(pft) * (1.0-agb_frac) + bbarka_new = cpatch%balive(ico) * qbark(pft) * cpatch%height(ico) & + * ialloc * agf_bs(pft) * (1.0-agb_frac) bbarka_new = max(0.0, bbarka_new) - bbarkb_new = cpatch%balive(ico) * qbark(pft) * cpatch%hite(ico) * ialloc & - * (1.0 - agf_bs(pft)) * (1.0-bgb_frac) + bbarkb_new = cpatch%balive(ico) * qbark(pft) * cpatch%height(ico) & + * ialloc * (1.0 - agf_bs(pft)) * (1.0-bgb_frac) bbarkb_new = max(0.0, bbarkb_new) bstore_new = cpatch%bstorage(ico) * (1.0-stor_frac) @@ -429,17 +430,18 @@ subroutine event_harvest(agb_frac8,bgb_frac8,fol_frac8,stor_frac8) if((cpatch%bdeada(ico) + cpatch%bdeadb(ico)) > tiny(1.0)) then if(is_grass(cpatch%pft(ico)) .and. igrass==1) then - cpatch%hite(ico) = max( hgt_min(pft), & - bl2h(cpatch%bleaf(ico),cpatch%sla(ico),pft)) - cpatch%dbh (ico) = h2dbh(cpatch%hite(ico),pft) + cpatch%height(ico) = max( hgt_min(pft), & + bl2h(cpatch%bleaf(ico),cpatch%sla(ico) & + ,pft) ) + cpatch%dbh (ico) = h2dbh(cpatch%height(ico),pft) else - cpatch%dbh (ico) = bd2dbh(cpatch%pft(ico), cpatch%bdeada(ico) & + cpatch%dbh (ico) = bd2dbh(cpatch%pft(ico), cpatch%bdeada(ico) & ,cpatch%bdeadb(ico)) - cpatch%hite(ico) = dbh2h (cpatch%pft(ico), cpatch%dbh(ico)) + cpatch%height(ico) = dbh2h (cpatch%pft(ico), cpatch%dbh(ico)) end if else - cpatch%dbh(ico) = 0.0 - cpatch%hite(ico) = 0.0 + cpatch%dbh (ico) = 0.0 + cpatch%height(ico) = 0.0 end if !----- Update LAI, WAI, and CAI ------------------------------------------! @@ -447,10 +449,10 @@ subroutine event_harvest(agb_frac8,bgb_frac8,fol_frac8,stor_frac8) !----- Update basal area and above-ground biomass. -----------------------! cpatch%basarea(ico) = pio4 * cpatch%dbh(ico) * cpatch%dbh(ico) - cpatch%btimber(ico) = size2bt(cpatch%dbh(ico),cpatch%hite(ico) & + cpatch%btimber(ico) = size2bt(cpatch%dbh(ico),cpatch%height(ico) & ,cpatch%bdeada(ico),cpatch%bsapwooda(ico) & ,cpatch%bbarka(ico),cpatch%pft(ico)) - cpatch%thbark (ico) = size2xb(cpatch%dbh(ico),cpatch%hite(ico) & + cpatch%thbark (ico) = size2xb(cpatch%dbh(ico),cpatch%height(ico) & ,cpatch%bbarka(ico),cpatch%bbarkb(ico) & ,cpatch%sla(ico),cpatch%pft(ico)) cpatch%agb(ico) = ed_biomass(cpatch, ico) @@ -954,14 +956,14 @@ end subroutine event_till !!$ !!enter values for new cohort !!$ cpatch%pft(ico) = pft !!$ cpatch%nplant(ico) = density -!!$ cpatch%hite(ico) = hgt_min(pft) +!!$ cpatch%height(ico) = hgt_min(pft) !!$ cpatch%dbh(ico) = h2dbh(hgt_min(pft),pft) -!!$ cpatch%bdead(ico) = size2bd(cpatch%dbh(ico),cpatch%hite(ico),pft) -!!$ cpatch%bleaf(ico) = size2bl(cpatch%dbh(ico),cpatch%hite(ico),cpatch%sla(ico),pft) -!!$print*,cpatch%hite(ico),cpatch%dbh(ico),cpatch%bdead(ico),cpatch%bleaf(ico) +!!$ cpatch%bdead(ico) = size2bd(cpatch%dbh(ico),cpatch%height(ico),pft) +!!$ cpatch%bleaf(ico) = size2bl(cpatch%dbh(ico),cpatch%height(ico),cpatch%sla(ico),pft) +!!$print*,cpatch%height(ico),cpatch%dbh(ico),cpatch%bdead(ico),cpatch%bleaf(ico) !!$ cpatch%phenology_status(ico) = 0 !!$ cpatch%balive(ico) = cpatch%bleaf(ico)* & -!!$ & (1.0 + q(pft) + qsw(pft) * cpatch%hite(ico)) +!!$ & (1.0 + q(pft) + qsw(pft) * cpatch%height(ico)) !!$ cpatch%lai(ico) = cpatch%bleaf(ico) * density * sla(pft) !!$ cpatch%bstorage(ico) = 0.0 !!$ cpatch%veg_temp(ico) = csite%can_temp(ipa) @@ -970,7 +972,7 @@ end subroutine event_till !!$ !!update site lai !!$ csite%lai(ipa) = sum(cpatch%lai(1:ico)) !!$print*,csite%lai(ipa),cpatch%lai -!!$ hcapveg = hcapveg_ref * max(cpatch%hite(1),cpatch%hite(ico),heathite_min) * cpatch%lai(ico)/csite%lai(ipa) +!!$ hcapveg = hcapveg_ref * max(cpatch%height(1),cpatch%height(ico),heatheight_min) * cpatch%lai(ico)/csite%lai(ipa) !!$ !!$print*,hcapveg !!$ cpatch%leaf_energy(ico) = hcapveg * (cpatch%leaf_temp(ico)-t3ple) diff --git a/ED/src/dynamics/fire.f90 b/ED/src/dynamics/fire.f90 index b93c9703e..bb2bf89cd 100644 --- a/ED/src/dynamics/fire.f90 +++ b/ED/src/dynamics/fire.f90 @@ -151,7 +151,7 @@ subroutine fire_frequency(cgrid) fuel = csite%fast_grnd_C(ipa) + csite%structural_grnd_C(ipa) fuelcohloop_3: do ico = 1,cpatch%ncohorts ipft = cpatch%pft(ico) - if (is_grass(ipft) .or. cpatch%hite(ico) <= fuel_height_max) then + if (is_grass(ipft) .or. cpatch%height(ico) <= fuel_height_max) then fuel = fuel + cpatch%nplant(ico) * cpatch%agb(ico) end if end do fuelcohloop_3 diff --git a/ED/src/dynamics/growth_balive.f90 b/ED/src/dynamics/growth_balive.f90 index b4309bb59..f4a043327 100644 --- a/ED/src/dynamics/growth_balive.f90 +++ b/ED/src/dynamics/growth_balive.f90 @@ -113,7 +113,7 @@ subroutine dbalive_dt(cgrid,gr_tfact0,year_o_day,veget_dyn_on) real :: balive_in real :: bdeada_in real :: bdeadb_in - real :: hite_in + real :: height_in real :: dbh_in real :: nplant_in real :: bstorage_in @@ -233,7 +233,7 @@ subroutine dbalive_dt(cgrid,gr_tfact0,year_o_day,veget_dyn_on) bsapwoodb_in = cpatch%bsapwoodb (ico) bbarka_in = cpatch%bbarka (ico) bbarkb_in = cpatch%bbarkb (ico) - hite_in = cpatch%hite (ico) + height_in = cpatch%height (ico) dbh_in = cpatch%dbh (ico) nplant_in = cpatch%nplant (ico) bstorage_in = cpatch%bstorage (ico) @@ -376,8 +376,8 @@ subroutine dbalive_dt(cgrid,gr_tfact0,year_o_day,veget_dyn_on) !---------------------------------------------------------------------! ! New grasses may update height and "DBH" every day. ! !---------------------------------------------------------------------! - cpatch%hite(ico) = bl2h(cpatch%bleaf(ico), cpatch%sla(ico), ipft) - cpatch%dbh(ico) = h2dbh(cpatch%hite(ico), ipft) + cpatch%height(ico) = bl2h(cpatch%bleaf(ico), cpatch%sla(ico), ipft) + cpatch%dbh (ico) = h2dbh(cpatch%height(ico), ipft) !---------------------------------------------------------------------! else !---------------------------------------------------------------------! @@ -478,7 +478,7 @@ subroutine dbalive_dt(cgrid,gr_tfact0,year_o_day,veget_dyn_on) cpatch%bsapwoodb (ico) = bsapwoodb_in cpatch%bbarka (ico) = bbarka_in cpatch%bbarkb (ico) = bbarkb_in - cpatch%hite (ico) = hite_in + cpatch%height (ico) = height_in cpatch%dbh (ico) = dbh_in cpatch%nplant (ico) = nplant_in cpatch%bstorage (ico) = bstorage_in @@ -495,7 +495,7 @@ subroutine dbalive_dt(cgrid,gr_tfact0,year_o_day,veget_dyn_on) !----- Update (commercial) timber biomass. ------------------------------! - cpatch%btimber(ico) = size2bt( cpatch%dbh(ico),cpatch%hite(ico) & + cpatch%btimber(ico) = size2bt( cpatch%dbh(ico),cpatch%height(ico) & , cpatch%bdeada(ico),cpatch%bsapwooda(ico) & , cpatch%bbarka(ico),cpatch%pft(ico) ) !------------------------------------------------------------------------! @@ -503,7 +503,7 @@ subroutine dbalive_dt(cgrid,gr_tfact0,year_o_day,veget_dyn_on) !----- Update bark thickness. -------------------------------------------! - cpatch%thbark(ico) = size2xb( cpatch%dbh(ico),cpatch%hite(ico) & + cpatch%thbark(ico) = size2xb( cpatch%dbh(ico),cpatch%height(ico) & , cpatch%bbarka(ico),cpatch%bbarkb(ico) & , cpatch%sla(ico),cpatch%pft(ico) ) !------------------------------------------------------------------------! @@ -1315,8 +1315,8 @@ subroutine get_c_xfers(csite,ipa,ico,npp_actual,green_leaf_factor,gr_tfact0 ! Maximum bleaf that the allometric relationship would allow. If the plant ! ! is drought stressed (elongf<1), we down-regulate allocation to balive. ! !---------------------------------------------------------------------------------! - bleaf_max = size2bl(cpatch%dbh(ico),cpatch%hite(ico),cpatch%sla(ico),ipft) - height_aim = cpatch%hite(ico) + bleaf_max = size2bl(cpatch%dbh(ico),cpatch%height(ico),cpatch%sla(ico),ipft) + height_aim = cpatch%height(ico) !---------------------------------------------------------------------------------! end if bleaf_aim = bleaf_max * green_leaf_factor * cpatch%elongf(ico) @@ -1965,7 +1965,7 @@ subroutine potential_N_uptake(cpatch,ico,npp_pot,N_uptake_pot,green_leaf_factor) ! phenology_status=1 yet. ! ! MLO - I don't see problems as long as phenology(grass) is evergreen. ! !---------------------------------------------------------------------------------! - bl_max = size2bl(cpatch%dbh(ico),cpatch%hite(ico),cpatch%sla(ico),ipft) & + bl_max = size2bl(cpatch%dbh(ico),cpatch%height(ico),cpatch%sla(ico),ipft) & * green_leaf_factor * cpatch%elongf(ico) bl_pot = cpatch%bleaf(ico) + npp_pot @@ -2175,10 +2175,10 @@ subroutine check_balive_cohort(csite,ipa,ico,bleaf_in,broot_in,bsapwooda_in !----- First, find the minimum possible scale for each pool. ------------------------! bleaf_ok_min = size2bl(min_dbh(ipft),hgt_min(ipft),cpatch%sla(ico),ipft) broot_ok_min = q(ipft) * bleaf_ok_min - bsapwooda_ok_min = agf_bs(ipft) * qsw (ipft) * cpatch%hite(ico) * bleaf_ok_min - bsapwoodb_ok_min = (1.-agf_bs(ipft)) * qsw (ipft) * cpatch%hite(ico) * bleaf_ok_min - bbarka_ok_min = agf_bs(ipft) * qbark(ipft) * cpatch%hite(ico) * bleaf_ok_min - bbarkb_ok_min = (1.-agf_bs(ipft)) * qbark(ipft) * cpatch%hite(ico) * bleaf_ok_min + bsapwooda_ok_min = agf_bs(ipft) * qsw (ipft) * cpatch%height(ico) * bleaf_ok_min + bsapwoodb_ok_min = (1.-agf_bs(ipft)) * qsw (ipft) * cpatch%height(ico) * bleaf_ok_min + bbarka_ok_min = agf_bs(ipft) * qbark(ipft) * cpatch%height(ico) * bleaf_ok_min + bbarkb_ok_min = (1.-agf_bs(ipft)) * qbark(ipft) * cpatch%height(ico) * bleaf_ok_min bstorage_ok_min = bleaf_ok_min !------------------------------------------------------------------------------------! @@ -2278,7 +2278,7 @@ subroutine check_balive_cohort(csite,ipa,ico,bleaf_in,broot_in,bsapwooda_in write(unit=*,fmt=fmti ) ' COHORT : ',ico write(unit=*,fmt=fmti ) ' IPFT : ',ipft write(unit=*,fmt=fmtf ) ' DBH : ',cpatch%dbh(ico) - write(unit=*,fmt=fmtf ) ' HITE : ',cpatch%hite(ico) + write(unit=*,fmt=fmtf ) ' HEIGHT : ',cpatch%height(ico) write(unit=*,fmt=fmtl ) ' NEG_BIOMASS : ',neg_biomass write(unit=*,fmt=fmtl ) ' BTOTAL_VIOLATION : ',btotal_violation write(unit=*,fmt='(a)') ' ---------------------------------------------------- ' diff --git a/ED/src/dynamics/mortality.f90 b/ED/src/dynamics/mortality.f90 index 40240a91d..fd59ee899 100644 --- a/ED/src/dynamics/mortality.f90 +++ b/ED/src/dynamics/mortality.f90 @@ -25,7 +25,7 @@ subroutine mortality_rates(cpatch,ico,avg_daily_temp, patch_age,dist_type) , frost_mort & ! intent(in) , cbr_severe_stress ! ! intent(in) use disturb_coms , only : treefall_disturbance_rate & ! intent(in) - , treefall_hite_threshold & ! intent(in) + , treefall_height_threshold & ! intent(in) , time2canopy ! ! intent(in) use ed_max_dims , only : n_pft ! ! intent(in) use physiology_coms,only : carbon_mortality_scheme @@ -92,8 +92,8 @@ subroutine mortality_rates(cpatch,ico,avg_daily_temp, patch_age,dist_type) !------------------------------------------------------------------------------------! if (dist_type == 2) then cpatch%mort_rate(3,ico) = treefall_disturbance_rate - elseif ( cpatch%hite(ico) <= treefall_hite_threshold .and. & - patch_age > time2canopy ) then + elseif ( cpatch%height(ico) <= treefall_height_threshold .and. & + patch_age > time2canopy ) then cpatch%mort_rate(3,ico) = treefall_disturbance_rate else cpatch%mort_rate(3,ico) = 0. @@ -248,17 +248,17 @@ end subroutine disturbance_mortality real function survivorship(new_lu,old_lu,mindbh_harvest,felling_s_gtharv & ,felling_s_ltharv,skid_dbh_thresh,skid_s_gtharv,skid_s_ltharv & ,cpatch,ico) - use ed_state_vars, only : patchtype ! ! structure - use disturb_coms , only : treefall_hite_threshold ! ! intent(in) - use pft_coms , only : treefall_s_ltht & ! intent(in) - , treefall_s_gtht & ! intent(in) - , fire_s_min & ! intent(in) - , fire_s_max & ! intent(in) - , fire_s_inter & ! intent(in) - , fire_s_slope ! ! intent(in) - use ed_max_dims , only : n_pft ! ! intent(in) - use consts_coms , only : lnexp_min & ! intent(in) - , lnexp_max ! ! intent(in) + use ed_state_vars, only : patchtype ! ! structure + use disturb_coms , only : treefall_height_threshold ! ! intent(in) + use pft_coms , only : treefall_s_ltht & ! intent(in) + , treefall_s_gtht & ! intent(in) + , fire_s_min & ! intent(in) + , fire_s_max & ! intent(in) + , fire_s_inter & ! intent(in) + , fire_s_slope ! ! intent(in) + use ed_max_dims , only : n_pft ! ! intent(in) + use consts_coms , only : lnexp_min & ! intent(in) + , lnexp_max ! ! intent(in) implicit none !----- Arguments. -------------------------------------------------------------------! type(patchtype) , target :: cpatch @@ -297,7 +297,7 @@ real function survivorship(new_lu,old_lu,mindbh_harvest,felling_s_gtharv !---------------------------------------------------------------------------------! ! Tree fall. Mortality depends on the cohort height and PFT. ! !---------------------------------------------------------------------------------! - if (cpatch%hite(ico) < treefall_hite_threshold) then + if (cpatch%height(ico) < treefall_height_threshold) then survivorship = treefall_s_ltht(ipft) else survivorship = treefall_s_gtht(ipft) diff --git a/ED/src/dynamics/phenology_aux.f90 b/ED/src/dynamics/phenology_aux.f90 index f91e30ae5..2dc9f1087 100644 --- a/ED/src/dynamics/phenology_aux.f90 +++ b/ED/src/dynamics/phenology_aux.f90 @@ -506,7 +506,7 @@ subroutine first_phenology(cgrid) ! storage. ! !------------------------------------------------------------------------! call pheninit_balive_bstorage(nzg,cpatch%pft(ico),cpatch%krdepth(ico) & - ,cpatch%hite(ico),cpatch%dbh(ico) & + ,cpatch%height(ico),cpatch%dbh(ico) & ,cpatch%sla(ico) & ,csite%soil_water(:,ipa) & ,cpoly%ntext_soil(:,isi) & diff --git a/ED/src/dynamics/phenology_driv.f90 b/ED/src/dynamics/phenology_driv.f90 index a5bfbf3f1..7d3e5db34 100644 --- a/ED/src/dynamics/phenology_driv.f90 +++ b/ED/src/dynamics/phenology_driv.f90 @@ -281,8 +281,9 @@ subroutine update_phenology(doy, cpoly, isi, lat,veget_dyn_on) !----- Get cohort-specific thresholds for prescribed phenology. ------------! call assign_prescribed_phen(cpoly%green_leaf_factor(ipft,isi) & ,cpoly%leaf_aging_factor(ipft,isi) & - ,cpatch%dbh(ico),cpatch%hite(ico),cpatch%sla(ico)& - ,ipft,drop_cold,leaf_out_cold,bl_max) + ,cpatch%dbh(ico),cpatch%height(ico) & + ,cpatch%sla(ico),ipft,drop_cold,leaf_out_cold & + ,bl_max) case default !----- Drop_cold is computed in phenology_thresholds for Botta scheme. -----! if (drop_cold) bl_max = 0.0 @@ -539,7 +540,7 @@ subroutine update_phenology(doy, cpoly, isi, lat,veget_dyn_on) !----- Find the maximum allowed leaf biomass. ------------------------------! - bl_max = elongf_try * size2bl(cpatch%dbh(ico),cpatch%hite(ico) & + bl_max = elongf_try * size2bl(cpatch%dbh(ico),cpatch%height(ico) & ,cpatch%sla(ico),ipft) !---------------------------------------------------------------------------! @@ -743,7 +744,7 @@ subroutine update_phenology(doy, cpoly, isi, lat,veget_dyn_on) ! allow for some fine roots to persist even if all leaves have been shed, ! ! otherwise plants will be unable to extract water once the rains return. ! !---------------------------------------------------------------------------! - bl_full = size2bl(cpatch%dbh(ico),cpatch%hite(ico),cpatch%sla(ico),ipft) + bl_full = size2bl(cpatch%dbh(ico),cpatch%height(ico),cpatch%sla(ico),ipft) bl_max = elongf_try * bl_full if (root_phen_factor > 0.) then br_max = bl_full * q(ipft) & @@ -945,7 +946,7 @@ subroutine update_phenology(doy, cpoly, isi, lat,veget_dyn_on) if (.not. veget_dyn_on) then elongf_try = cpoly%green_leaf_factor(ipft,isi) * cpatch%elongf(ico) cpatch%bleaf(ico) = elongf_try & - * size2bl(cpatch%dbh(ico),cpatch%hite(ico) & + * size2bl(cpatch%dbh(ico),cpatch%height(ico) & ,cpatch%sla(ico),ipft) cpatch%bstorage(ico) = bstorage_in !----- Fix phenology status according to elongation factor. ----------------! @@ -965,7 +966,7 @@ subroutine update_phenology(doy, cpoly, isi, lat,veget_dyn_on) case (5,6) if (root_phen_factor > 0.) then cpatch%broot(ico) = q(ipft) * (elongf_try + root_phen_factor - 1.) & - * size2bl(cpatch%dbh(ico),cpatch%hite(ico) & + * size2bl(cpatch%dbh(ico),cpatch%height(ico) & ,cpatch%sla(ico),ipft) & / root_phen_factor end if @@ -1297,7 +1298,7 @@ subroutine check_bphen_cohort(csite,ipa,ico,bleaf_in,broot_in,bstorage_in write(unit=*,fmt=fmti ) ' COHORT : ',ico write(unit=*,fmt=fmti ) ' IPFT : ',ipft write(unit=*,fmt=fmtf ) ' DBH : ',cpatch%dbh (ico) - write(unit=*,fmt=fmtf ) ' HITE : ',cpatch%hite (ico) + write(unit=*,fmt=fmtf ) ' HEIGHT : ',cpatch%height(ico) write(unit=*,fmt='(a)') ' ---------------------------------------------------- ' write(unit=*,fmt=fmti ) ' IPHEN_SCHEME : ',iphen_scheme write(unit=*,fmt=fmti ) ' PHENOLOGY_STRATEGY : ',phenology(ipft) diff --git a/ED/src/dynamics/photosyn_driv.f90 b/ED/src/dynamics/photosyn_driv.f90 index 5c1b30601..7abfb30c1 100644 --- a/ED/src/dynamics/photosyn_driv.f90 +++ b/ED/src/dynamics/photosyn_driv.f90 @@ -187,7 +187,7 @@ subroutine canopy_photosynthesis(csite,cmet,mzg,ipa,ibuff,ntext_soil,leaf_aging_ ! Find the mean height of the crown (to represent the distance between ! ! the ground and the leaves. ! !------------------------------------------------------------------------------! - mcheight = 0.5 * (cpatch%hite(ico) + h2crownbh(cpatch%hite(ico),ipft)) + mcheight = 0.5 * (cpatch%height(ico) + h2crownbh(cpatch%height(ico),ipft)) !------------------------------------------------------------------------------! @@ -1013,7 +1013,7 @@ subroutine print_photo_details(cmet,csite,ipa,ico,limit_flag,vm,jm,tpm,jact,comp write(unit=57,fmt=bfmt) current_time%year , current_time%month & , current_time%date , current_time%time & , cpatch%pft(ico) , limit_flag & - , cpatch%hite(ico) , cpatch%nplant(ico) & + , cpatch%height(ico) , cpatch%nplant(ico) & , cpatch%bleaf(ico) , cpatch%lai(ico) & , cpatch%leaf_hcap(ico) , cpatch%leaf_water(ico) & , cpatch%leaf_water_im2(ico) , cpatch%leaf_temp(ico) & diff --git a/ED/src/dynamics/plant_hydro.f90 b/ED/src/dynamics/plant_hydro.f90 index 587043c02..ac3d85269 100644 --- a/ED/src/dynamics/plant_hydro.f90 +++ b/ED/src/dynamics/plant_hydro.f90 @@ -321,8 +321,8 @@ subroutine plant_hydro_driver(csite,ipa,lsl,ntext_soil,site_isoilbc) , cpatch%is_small(ico) ) !------------------------------------------------------------------------! else - !----- No leaves, set leaf_psi the same as wood_psi - hite. -------------! - cpatch%leaf_psi(ico) = cpatch%wood_psi(ico) - cpatch%hite(ico) + !----- No leaves, set leaf_psi the same as wood_psi - height. -----------! + cpatch%leaf_psi(ico) = cpatch%wood_psi(ico) - cpatch%height(ico) !------------------------------------------------------------------------! @@ -375,7 +375,7 @@ subroutine plant_hydro_driver(csite,ipa,lsl,ntext_soil,site_isoilbc) write (unit=*,fmt=ifmt ) ' + ICO =',ico write (unit=*,fmt=ifmt ) ' + PFT =',ipft write (unit=*,fmt=ifmt ) ' + KRDEPTH =',cpatch%krdepth(ico) - write (unit=*,fmt=efmt ) ' + HEIGHT =',cpatch%hite(ico) + write (unit=*,fmt=efmt ) ' + HEIGHT =',cpatch%height(ico) write (unit=*,fmt=lfmt ) ' + SMALL =',cpatch%is_small(ico) write (unit=*,fmt='(a)' ) ' ' @@ -457,12 +457,12 @@ subroutine plant_hydro_driver(csite,ipa,lsl,ntext_soil,site_isoilbc) ! Find water fluxes. Note that transp is from last timestep's psi_open ! ! and psi_closed. ! !---------------------------------------------------------------------------! - call calc_plant_water_flux( & + call calc_plant_water_flux( & dtlsm & ! input ,sap_area,cpatch%nplant(ico),ipft & ! input ,cpatch%is_small(ico),cpatch%krdepth(ico) & ! input ,cpatch%bleaf(ico),bsap,cpatch%broot(ico) & ! input - ,cpatch%hite(ico),cpatch%root_frac(:,ico) & ! input + ,cpatch%height(ico),cpatch%root_frac(:,ico) & ! input ,transp,cpatch%leaf_psi(ico),cpatch%wood_psi(ico) & ! input ,soil_psi,soil_cond,lsl,ipa,ico & ! input ,cpatch%wflux_wl(ico),cpatch%wflux_gw(ico) & ! output @@ -568,7 +568,7 @@ end subroutine plant_hydro_driver !---------------------------------------------------------------------------------------! subroutine calc_plant_water_flux(dt & !timestep ,sap_area,nplant,ipft,is_small,krdepth & !plant input - ,bleaf,bsap,broot,hite ,root_frac & !plant input + ,bleaf,bsap,broot,height ,root_frac & !plant input ,transp,leaf_psi,wood_psi & !plant input ,soil_psi,soil_cond,lsl & !soil input ,ipa,ico & !debug input @@ -601,7 +601,7 @@ subroutine calc_plant_water_flux(dt & !timestep real , intent(in) :: bleaf !leaf biomass [ kgC] real , intent(in) :: bsap !sapwood biomass [ kgC/pl] real , intent(in) :: broot !fine root biomass [ kgC/pl] - real , intent(in) :: hite !plant height [ m] + real , intent(in) :: height !plant height [ m] real , dimension(nzg), intent(in) :: root_frac !Root fraction [ m] real , intent(in) :: transp !transpiration [ kg/s] real , intent(in) :: leaf_psi !leaf water pot. [ m] @@ -621,7 +621,7 @@ subroutine calc_plant_water_flux(dt & !timestep real(kind=8) :: bsap_d real(kind=8) :: broot_d real(kind=8) :: nplant_d - real(kind=8) :: hite_d + real(kind=8) :: height_d real(kind=8) :: transp_d real(kind=8) :: leaf_psi_d real(kind=8) :: wood_psi_d @@ -687,7 +687,7 @@ subroutine calc_plant_water_flux(dt & !timestep bsap_d = dble(bsap ) broot_d = dble(broot ) nplant_d = dble(nplant ) - hite_d = dble(hite ) + height_d = dble(height ) transp_d = dble(transp ) leaf_psi_d = dble(leaf_psi ) wood_psi_d = dble(wood_psi ) @@ -810,14 +810,14 @@ subroutine calc_plant_water_flux(dt & !timestep ! considered for leaf water potential of small trees. As a result, this ! can lead to a down-ward sapflow, and potentially over-charging the ! sapwood. We need to zero the flow in this case as well, until - ! leaf_psi_d drops below wood_psi_d - hite_d. + ! leaf_psi_d drops below wood_psi_d - height_d. !---------------------------------------------------------------------------------! zero_flow_wl = ( c_leaf == 0.d0 ) .or. & ! Case 1 - ( leaf_psi_d >= (wood_psi_d - hite_d) .and. & + ( leaf_psi_d >= (wood_psi_d - height_d) .and. & leaf_psi_d <= leaf_psi_lwr_d ) .or. & ! Case 2a - ( leaf_psi_d <= (wood_psi_d - hite_d) .and. & + ( leaf_psi_d <= (wood_psi_d - height_d) .and. & wood_psi_d <= wood_psi_lwr_d ) .or. & ! Case 2b - ( leaf_psi_d > (wood_psi_d - hite_d) ) ! ! Case 3 + ( leaf_psi_d > (wood_psi_d - height_d) ) ! ! Case 3 !---------------------------------------------------------------------------------! @@ -860,7 +860,7 @@ subroutine calc_plant_water_flux(dt & !timestep !----- Calculate stem conductance [kg / s]. -----------------------------------! stem_cond = wood_Kmax_d * plc & ! kg/m/s * sap_area_d & ! conducting area m2 - / (hite_d * vessel_curl_factor_d) ! ! conducting length m + / (height_d * vessel_curl_factor_d) ! ! conducting length m !------------------------------------------------------------------------------! @@ -878,7 +878,7 @@ subroutine calc_plant_water_flux(dt & !timestep ! reference X16 for derivation of the equations. !---------------------------------------------------------------------------! ap = - stem_cond / c_leaf ! [1/s] - bp = ((wood_psi_d - hite_d) * stem_cond - transp_d) / c_leaf ! [m/s] + bp = ((wood_psi_d - height_d) * stem_cond - transp_d) / c_leaf ! [m/s] !----- Project the final leaf psi. -----------------------------------------! exp_term = exp(max(ap * dt_d,lnexp_min8)) @@ -1077,7 +1077,7 @@ subroutine calc_plant_water_flux(dt & !timestep write (unit=*,fmt=ifmt ) ' + ICO =',ico write (unit=*,fmt=ifmt ) ' + PFT =',ipft write (unit=*,fmt=ifmt ) ' + KRDEPTH =',krdepth - write (unit=*,fmt=efmt ) ' + HEIGHT =',hite + write (unit=*,fmt=efmt ) ' + HEIGHT =',height write (unit=*,fmt='(a)' ) ' ' write (unit=*,fmt=lfmt ) ' + IS_SMALL =',is_small diff --git a/ED/src/dynamics/reproduction.f90 b/ED/src/dynamics/reproduction.f90 index 52ab6a4d6..278778b2d 100644 --- a/ED/src/dynamics/reproduction.f90 +++ b/ED/src/dynamics/reproduction.f90 @@ -291,16 +291,16 @@ subroutine reproduction_driver(cgrid,month,veget_dyn_on) ! Recruits start at minimum height and dbh and bleaf are ! ! calculated from that. ! !------------------------------------------------------------------! - rectest%hite = hgt_min(ipft) - rectest%dbh = h2dbh(rectest%hite, ipft) - rectest%krdepth = size2krdepth(rectest%hite,rectest%dbh & + rectest%height = hgt_min(ipft) + rectest%dbh = h2dbh(rectest%height, ipft) + rectest%krdepth = size2krdepth(rectest%height,rectest%dbh & ,rectest%pft,cpoly%lsl(isi)) - rec_bdead = size2bd(rectest%dbh,rectest%hite,ipft) + rec_bdead = size2bd(rectest%dbh,rectest%height,ipft) rectest%bdeada = agf_bs(ipft) * rec_bdead rectest%bdeadb = ( 1.0 - agf_bs(ipft) ) * rec_bdead call pheninit_balive_bstorage(nzg,rectest%pft,rectest%krdepth & - ,rectest%hite,rectest%dbh,SLA(ipft) & + ,rectest%height,rectest%dbh,SLA(ipft) & ,csite%soil_water(:,ipa) & ,cpoly%ntext_soil(:,isi) & ,rectest%paw_avg,rectest%elongf & @@ -447,7 +447,7 @@ subroutine reproduction_driver(cgrid,month,veget_dyn_on) !----- Copy from recruitment table (I). ---------------------------! cpatch%pft (ico) = recruit(inew)%pft - cpatch%hite (ico) = recruit(inew)%hite + cpatch%height(ico) = recruit(inew)%height cpatch%dbh (ico) = recruit(inew)%dbh cpatch%nplant(ico) = recruit(inew)%nplant @@ -544,13 +544,13 @@ subroutine reproduction_driver(cgrid,month,veget_dyn_on) cpatch%agb (ico) = ed_biomass(cpatch, ico) cpatch%balive (ico) = ed_balive(cpatch,ico) cpatch%btimber (ico) = size2bt ( cpatch%dbh (ico) & - , cpatch%hite (ico) & + , cpatch%height (ico) & , cpatch%bdeada (ico) & , cpatch%bsapwooda (ico) & , cpatch%bbarka (ico) & , cpatch%pft (ico) ) cpatch%thbark (ico) = size2xb ( cpatch%dbh (ico) & - , cpatch%hite (ico) & + , cpatch%height (ico) & , cpatch%bbarka (ico) & , cpatch%bbarkb (ico) & , cpatch%sla (ico) & @@ -800,14 +800,14 @@ subroutine reproduction_driver(cgrid,month,veget_dyn_on) ! Will only reproduce/grow if on-allometry so dont' have to ! ! worry about elongation factor. ! !------------------------------------------------------------------! - bleaf_plant = size2bl(cpatch%dbh(ico),cpatch%hite(ico) & + bleaf_plant = size2bl(cpatch%dbh(ico),cpatch%height(ico) & ,cpatch%sla(ico),ipft) broot_plant = bleaf_plant * q (ipft) - bsapwood_plant = bleaf_plant * qsw (ipft) * cpatch%hite(ico) - bbark_plant = bleaf_plant * qbark(ipft) * cpatch%hite(ico) + bsapwood_plant = bleaf_plant * qsw (ipft) * cpatch%height(ico) + bbark_plant = bleaf_plant * qbark(ipft) * cpatch%height(ico) balive_plant = bleaf_plant + broot_plant + bsapwood_plant & + bbark_plant - bdead_plant = size2bd(cpatch%dbh(ico),cpatch%hite(ico),ipft) + bdead_plant = size2bd(cpatch%dbh(ico),cpatch%height(ico),ipft) !------------------------------------------------------------------! diff --git a/ED/src/dynamics/rk4_copy_patch.f90 b/ED/src/dynamics/rk4_copy_patch.f90 index f8d6edffe..9a7873086 100644 --- a/ED/src/dynamics/rk4_copy_patch.f90 +++ b/ED/src/dynamics/rk4_copy_patch.f90 @@ -1251,8 +1251,8 @@ subroutine initp2modelp(hdid,initp,csite,ipa,nighttime,wbudget_loss2atm available_water = 0.d0 do k = kroot, nzg nsoil = rk4site%ntext_soil(k) - mcheight = 5.d-1 * ( dble(cpatch%hite(ico)) & - + dble(h2crownbh(cpatch%hite(ico),ipft)) ) + mcheight = 5.d-1 * ( dble(cpatch%height(ico)) & + + dble(h2crownbh(cpatch%height(ico),ipft)) ) psiplusz = slzt8(k) - mcheight & + matric_potential8(nsoil,initp%soil_water(k)) available_water = available_water & @@ -1543,14 +1543,14 @@ subroutine initp2modelp(hdid,initp,csite,ipa,nighttime,wbudget_loss2atm !------------------------------------------------------------------------! end if !---------------------------------------------------------------------------! - elseif (cpatch%hite(ico) <= csite%total_sfcw_depth(ipa)) then + elseif (cpatch%height(ico) <= csite%total_sfcw_depth(ipa)) then !---------------------------------------------------------------------------! ! For plants buried in snow, fix the leaf and branch temperatures to the ! ! snow temperature of the layer that is the closest to the cohort top. ! !---------------------------------------------------------------------------! kclosest = 1 do k = csite%nlev_sfcwater(ipa), 1, -1 - if (sum(csite%sfcwater_depth(1:k,ipa)) > cpatch%hite(ico)) kclosest = k + if (sum(csite%sfcwater_depth(1:k,ipa)) > cpatch%height(ico)) kclosest = k end do !---------------------------------------------------------------------------! @@ -1771,14 +1771,14 @@ subroutine initp2modelp(hdid,initp,csite,ipa,nighttime,wbudget_loss2atm / sngl(hdid) !---------------------------------------------------------------------------! - elseif (cpatch%hite(ico) <= csite%total_sfcw_depth(ipa)) then + elseif (cpatch%height(ico) <= csite%total_sfcw_depth(ipa)) then !---------------------------------------------------------------------------! ! For plants buried in snow, fix the leaf temperature to the snow ! ! temperature of the layer that is the closest to the leaves. ! !---------------------------------------------------------------------------! kclosest = 1 do k = csite%nlev_sfcwater(ipa), 1, -1 - if (sum(csite%sfcwater_depth(1:k,ipa)) > cpatch%hite(ico)) kclosest = k + if (sum(csite%sfcwater_depth(1:k,ipa)) > cpatch%height(ico)) kclosest = k end do cpatch%leaf_temp(ico) = csite%sfcwater_tempk(kclosest,ipa) if (cpatch%leaf_temp(ico) == t3ple) then @@ -1917,14 +1917,14 @@ subroutine initp2modelp(hdid,initp,csite,ipa,nighttime,wbudget_loss2atm cpatch%wood_gbw(ico) = sngloff(initp%wood_gbw(ico), tiny_offset) !---------------------------------------------------------------------------! - elseif (cpatch%hite(ico) <= csite%total_sfcw_depth(ipa)) then + elseif (cpatch%height(ico) <= csite%total_sfcw_depth(ipa)) then !---------------------------------------------------------------------------! ! For plants buried in snow, fix the wood temperature to the snow ! ! temperature of the layer that is the closest to the branches. ! !---------------------------------------------------------------------------! kclosest = 1 do k = csite%nlev_sfcwater(ipa), 1, -1 - if (sum(csite%sfcwater_depth(1:k,ipa)) > cpatch%hite(ico)) kclosest = k + if (sum(csite%sfcwater_depth(1:k,ipa)) > cpatch%height(ico)) kclosest = k end do cpatch%wood_temp(ico) = csite%sfcwater_tempk(kclosest,ipa) if (cpatch%wood_temp(ico) == t3ple) then diff --git a/ED/src/dynamics/rk4_integ_utils.f90 b/ED/src/dynamics/rk4_integ_utils.f90 index de2ee62d9..aee25c99b 100644 --- a/ED/src/dynamics/rk4_integ_utils.f90 +++ b/ED/src/dynamics/rk4_integ_utils.f90 @@ -2576,7 +2576,7 @@ subroutine rk4_sanity_check(ibuff,y,reject_step, csite,ipa,dydx,h,print_problems write(unit=*,fmt='(a)') '========================================' write(unit=*,fmt='(a,1x,i6)') ' ICO: ',ico write(unit=*,fmt='(a,1x,i6)') ' PFT: ',cpatch%pft(ico) - write(unit=*,fmt='(a,1x,es12.4)') ' HEIGHT: ',cpatch%hite(ico) + write(unit=*,fmt='(a,1x,es12.4)') ' HEIGHT: ',cpatch%height(ico) write(unit=*,fmt='(a,1x,es12.4)') ' LAI: ',y%lai(ico) write(unit=*,fmt='(a,1x,es12.4)') ' WAI: ',y%wai(ico) write(unit=*,fmt='(a,1x,es12.4)') ' TAI: ',y%tai(ico) @@ -2619,7 +2619,7 @@ subroutine rk4_sanity_check(ibuff,y,reject_step, csite,ipa,dydx,h,print_problems write(unit=*,fmt='(a)') '========================================' write(unit=*,fmt='(a,1x,i6)') ' ICO: ',ico write(unit=*,fmt='(a,1x,i6)') ' PFT: ',cpatch%pft(ico) - write(unit=*,fmt='(a,1x,es12.4)') ' HEIGHT: ',cpatch%hite(ico) + write(unit=*,fmt='(a,1x,es12.4)') ' HEIGHT: ',cpatch%height(ico) write(unit=*,fmt='(a,1x,es12.4)') ' LAI: ',y%lai(ico) write(unit=*,fmt='(a,1x,es12.4)') ' WAI: ',y%wai(ico) write(unit=*,fmt='(a,1x,es12.4)') ' TAI: ',y%tai(ico) @@ -2663,7 +2663,7 @@ subroutine rk4_sanity_check(ibuff,y,reject_step, csite,ipa,dydx,h,print_problems write(unit=*,fmt='(a)') '========================================' write(unit=*,fmt='(a,1x,i6)') ' ICO: ',ico write(unit=*,fmt='(a,1x,i6)') ' PFT: ',cpatch%pft(ico) - write(unit=*,fmt='(a,1x,es12.4)') ' HEIGHT: ',cpatch%hite(ico) + write(unit=*,fmt='(a,1x,es12.4)') ' HEIGHT: ',cpatch%height(ico) write(unit=*,fmt='(a,1x,es12.4)') ' LAI: ',y%lai(ico) write(unit=*,fmt='(a,1x,es12.4)') ' WAI: ',y%wai(ico) write(unit=*,fmt='(a,1x,es12.4)') ' TAI: ',y%tai(ico) @@ -2729,7 +2729,7 @@ subroutine rk4_sanity_check(ibuff,y,reject_step, csite,ipa,dydx,h,print_problems write(unit=*,fmt='(a)') '========================================' write(unit=*,fmt='(a,1x,i6)') ' ICO: ',ico write(unit=*,fmt='(a,1x,i6)') ' PFT: ',cpatch%pft(ico) - write(unit=*,fmt='(a,1x,es12.4)') ' HEIGHT: ',cpatch%hite(ico) + write(unit=*,fmt='(a,1x,es12.4)') ' HEIGHT: ',cpatch%height(ico) write(unit=*,fmt='(a,1x,es12.4)') ' LAI: ',y%lai(ico) write(unit=*,fmt='(a,1x,es12.4)') ' WAI: ',y%wai(ico) write(unit=*,fmt='(a,1x,es12.4)') ' TAI: ',y%tai(ico) @@ -2773,7 +2773,7 @@ subroutine rk4_sanity_check(ibuff,y,reject_step, csite,ipa,dydx,h,print_problems write(unit=*,fmt='(a)') '========================================' write(unit=*,fmt='(a,1x,i6)') ' ICO: ',ico write(unit=*,fmt='(a,1x,i6)') ' PFT: ',cpatch%pft(ico) - write(unit=*,fmt='(a,1x,es12.4)') ' HEIGHT: ',cpatch%hite(ico) + write(unit=*,fmt='(a,1x,es12.4)') ' HEIGHT: ',cpatch%height(ico) write(unit=*,fmt='(a,1x,es12.4)') ' LAI: ',y%lai(ico) write(unit=*,fmt='(a,1x,es12.4)') ' WAI: ',y%wai(ico) write(unit=*,fmt='(a,1x,es12.4)') ' TAI: ',y%tai(ico) @@ -2816,7 +2816,7 @@ subroutine rk4_sanity_check(ibuff,y,reject_step, csite,ipa,dydx,h,print_problems write(unit=*,fmt='(a)') '========================================' write(unit=*,fmt='(a,1x,i6)') ' ICO: ',ico write(unit=*,fmt='(a,1x,i6)') ' PFT: ',cpatch%pft(ico) - write(unit=*,fmt='(a,1x,es12.4)') ' HEIGHT: ',cpatch%hite(ico) + write(unit=*,fmt='(a,1x,es12.4)') ' HEIGHT: ',cpatch%height(ico) write(unit=*,fmt='(a,1x,es12.4)') ' LAI: ',y%lai(ico) write(unit=*,fmt='(a,1x,es12.4)') ' WAI: ',y%wai(ico) write(unit=*,fmt='(a,1x,es12.4)') ' TAI: ',y%tai(ico) diff --git a/ED/src/dynamics/rk4_misc.f90 b/ED/src/dynamics/rk4_misc.f90 index 2a083d869..502c7f324 100644 --- a/ED/src/dynamics/rk4_misc.f90 +++ b/ED/src/dynamics/rk4_misc.f90 @@ -3997,7 +3997,7 @@ subroutine print_rk4patch(y,csite,ipa) if (cpatch%leaf_resolvable(ico)) then write(unit=*,fmt='(2(i7,1x),9(es12.4,1x))') & cpatch%pft(ico),cpatch%krdepth(ico) & - ,cpatch%nplant(ico),cpatch%hite(ico),cpatch%dbh(ico),cpatch%bdeada(ico) & + ,cpatch%nplant(ico),cpatch%height(ico),cpatch%dbh(ico),cpatch%bdeada(ico) & ,cpatch%bdeadb(ico),cpatch%bleaf (ico),cpatch%fs_open(ico) & ,cpatch%fsw(ico),cpatch%fsn(ico) end if @@ -4036,7 +4036,7 @@ subroutine print_rk4patch(y,csite,ipa) if (y%leaf_resolvable(ico)) then write(unit=*,fmt='(2(i7,1x),8(es12.4,1x))') & cpatch%pft(ico),cpatch%krdepth(ico) & - ,y%lai(ico),cpatch%hite(ico),y%leaf_temp(ico),y%veg_wind(ico) & + ,y%lai(ico),cpatch%height(ico),y%leaf_temp(ico),y%veg_wind(ico) & ,y%leaf_reynolds(ico),y%leaf_grashof(ico),y%leaf_nussforc(ico) & ,y%leaf_nussfree(ico) end if @@ -4049,7 +4049,7 @@ subroutine print_rk4patch(y,csite,ipa) if (y%leaf_resolvable(ico)) then write(unit=*,fmt='(2(i7,1x),7(es12.4,1x))') & cpatch%pft(ico),cpatch%krdepth(ico) & - ,y%lai(ico),cpatch%hite(ico),y%leaf_gbh(ico),y%leaf_gbw(ico) & + ,y%lai(ico),cpatch%height(ico),y%leaf_gbh(ico),y%leaf_gbw(ico) & ,y%gsw_closed(ico),y%gsw_open(ico),cpatch%fs_open(ico) end if end do @@ -4061,7 +4061,7 @@ subroutine print_rk4patch(y,csite,ipa) if (y%leaf_resolvable(ico)) then write(unit=*,fmt='(2(i7,1x),6(es12.4,1x))') & cpatch%pft(ico),cpatch%krdepth(ico) & - ,y%lai(ico),cpatch%hite(ico),y%rshort_l(ico),y%rlong_l(ico) & + ,y%lai(ico),cpatch%height(ico),y%rshort_l(ico),y%rlong_l(ico) & ,cpatch%par_l_beam(ico),cpatch%par_l_diffuse(ico) end if end do @@ -4080,7 +4080,7 @@ subroutine print_rk4patch(y,csite,ipa) if (cpatch%wood_resolvable(ico)) then write(unit=*,fmt='(2(i7,1x),9(es12.4,1x))') & cpatch%pft(ico),cpatch%krdepth(ico) & - ,cpatch%nplant(ico),cpatch%hite(ico),cpatch%dbh(ico),cpatch%bdeada(ico) & + ,cpatch%nplant(ico),cpatch%height(ico),cpatch%dbh(ico),cpatch%bdeada(ico) & ,cpatch%bdeadb(ico),cpatch%bsapwooda(ico),cpatch%bsapwoodb(ico) & ,cpatch%bbarka(ico),cpatch%bbarkb(ico) end if @@ -4106,7 +4106,7 @@ subroutine print_rk4patch(y,csite,ipa) if (y%wood_resolvable(ico)) then write(unit=*,fmt='(2(i7,1x),8(es12.4,1x))') & cpatch%pft(ico),cpatch%krdepth(ico) & - ,y%wai(ico),cpatch%hite(ico),y%wood_temp(ico),y%veg_wind(ico) & + ,y%wai(ico),cpatch%height(ico),y%wood_temp(ico),y%veg_wind(ico) & ,y%wood_reynolds(ico),y%wood_grashof(ico),y%wood_nussforc(ico) & ,y%wood_nussfree(ico) end if @@ -4119,7 +4119,7 @@ subroutine print_rk4patch(y,csite,ipa) if (y%wood_resolvable(ico)) then write(unit=*,fmt='(2(i7,1x),6(es12.4,1x))') & cpatch%pft(ico),cpatch%krdepth(ico) & - ,y%wai(ico),cpatch%hite(ico),y%wood_gbh(ico),y%wood_gbw(ico) & + ,y%wai(ico),cpatch%height(ico),y%wood_gbh(ico),y%wood_gbw(ico) & ,y%rshort_w(ico),y%rlong_w(ico) end if end do @@ -4580,7 +4580,7 @@ subroutine print_rk4_state(initp,fluxp,csite,ipa,isi,elapsed,hdid) , hdid , cpatch%pft(ico) & , leaf_resolve , wood_resolve & , is_small , initp%nplant(ico) & - , cpatch%hite(ico) , initp%lai(ico) & + , cpatch%height(ico) , initp%lai(ico) & , initp%wai(ico) , initp%crown_area(ico) & , initp%leaf_energy(ico) , initp%leaf_water(ico) & , initp%leaf_water_im2(ico) , initp%leaf_hcap(ico) & @@ -4720,7 +4720,7 @@ subroutine sanity_check_veg_energy(csite,ipa) write (unit=*,fmt=ifmt ) ' + ICO =',ico write (unit=*,fmt=ifmt ) ' + PFT =',cpatch%pft (ico) write (unit=*,fmt=efmt ) ' + DBH =',cpatch%dbh (ico) - write (unit=*,fmt=efmt ) ' + HEIGHT =',cpatch%hite (ico) + write (unit=*,fmt=efmt ) ' + HEIGHT =',cpatch%height (ico) write (unit=*,fmt='(a)' ) ' ' write (unit=*,fmt=lfmt ) ' + LEAF_RESOLVABLE =',cpatch%leaf_resolvable(ico) diff --git a/ED/src/dynamics/stem_resp_driv.f90 b/ED/src/dynamics/stem_resp_driv.f90 index 23a4d6263..22acb528f 100644 --- a/ED/src/dynamics/stem_resp_driv.f90 +++ b/ED/src/dynamics/stem_resp_driv.f90 @@ -60,7 +60,7 @@ subroutine stem_respiration(csite,ipa) ! The resulting stem surface area is comparable to reported values in the ! ! tropics, such as Chambers et al. 2004 Ecological Applicaitons ! !------------------------------------------------------------------------------! - stem_area = ( cpatch%dbh(ico) * 1e-2 * cpatch%hite(ico) * cpatch%nplant(ico) & + stem_area = ( cpatch%dbh(ico) * 1e-2 * cpatch%height(ico) * cpatch%nplant(ico) & + cpatch%wai(ico) ) * pi1 / agf_bs(ipft) cpatch%stem_respiration(ico) = stem_resp_norm(ipft,cpatch%dbh(ico),cpatch%wood_temp(ico)) & * stem_area diff --git a/ED/src/dynamics/structural_growth.f90 b/ED/src/dynamics/structural_growth.f90 index 8f7d458e6..cd11977e2 100644 --- a/ED/src/dynamics/structural_growth.f90 +++ b/ED/src/dynamics/structural_growth.f90 @@ -97,7 +97,7 @@ subroutine dbstruct_dt(cgrid,veget_dyn_on,new_year) real :: bdeada_in real :: bdeadb_in real :: bevery_in - real :: hite_in + real :: height_in real :: dbh_in real :: nplant_in real :: bstorage_in @@ -221,8 +221,8 @@ subroutine dbstruct_dt(cgrid,veget_dyn_on,new_year) !---------------------------------------------------------------------------! maxh = h_edge hcohortloop: do ico = 1,cpatch%ncohorts - if (.not. is_liana(cpatch%pft(ico)) .and. cpatch%hite(ico) > maxh) then - maxh = cpatch%hite(ico) + if (.not. is_liana(cpatch%pft(ico)) .and. cpatch%height(ico) > maxh) then + maxh = cpatch%height(ico) end if end do hcohortloop !---------------------------------------------------------------------------! @@ -275,7 +275,7 @@ subroutine dbstruct_dt(cgrid,veget_dyn_on,new_year) bsapwoodb_in = cpatch%bsapwoodb (ico) bbarka_in = cpatch%bbarka (ico) bbarkb_in = cpatch%bbarkb (ico) - hite_in = cpatch%hite (ico) + height_in = cpatch%height (ico) dbh_in = cpatch%dbh (ico) nplant_in = cpatch%nplant (ico) bstorage_in = cpatch%bstorage (ico) @@ -383,13 +383,13 @@ subroutine dbstruct_dt(cgrid,veget_dyn_on,new_year) !----- Calculate bstorage reserved for future refulushing needs ---------! bstorage_reserve = (1.0 + q(ipft)) * storage_reflush_times(ipft) & - * size2bl(cpatch%dbh(ico),cpatch%hite(ico) & + * size2bl(cpatch%dbh(ico),cpatch%height(ico) & ,cpatch%sla(ico),ipft) !------------------------------------------------------------------------! !----- Determine how to distribute what is in bstorage. -----------------! - call plant_structural_allocation(cpatch%pft(ico),cpatch%hite(ico) & + call plant_structural_allocation(cpatch%pft(ico),cpatch%height(ico) & ,cpatch%dbh(ico),cgrid%lat(ipy) & ,cpatch%phenology_status(ico) & ,cpatch%elongf(ico) & @@ -766,7 +766,7 @@ subroutine dbstruct_dt(cgrid,veget_dyn_on,new_year) cpatch%bsapwoodb (ico) = bsapwoodb_in cpatch%bbarka (ico) = bbarka_in cpatch%bbarkb (ico) = bbarkb_in - cpatch%hite (ico) = hite_in + cpatch%height (ico) = height_in cpatch%dbh (ico) = dbh_in cpatch%nplant (ico) = nplant_in cpatch%bstorage (ico) = bstorage_in @@ -898,7 +898,7 @@ end subroutine dbstruct_dt ! This subroutine will decide the partition of storage biomass into seeds and dead ! ! (structural) biomass. ! !---------------------------------------------------------------------------------------! - subroutine plant_structural_allocation(ipft,hite,dbh,lat,phen_status,elongf,bdeada & + subroutine plant_structural_allocation(ipft,height,dbh,lat,phen_status,elongf,bdeada & ,bdeadb,bstorage,bstorage_reserve,maxh & ,f_bseeds,f_growth,f_bstorage) use pft_coms , only : phenology & ! intent(in) @@ -922,7 +922,7 @@ subroutine plant_structural_allocation(ipft,hite,dbh,lat,phen_status,elongf,bdea implicit none !----- Arguments --------------------------------------------------------------------! integer, intent(in) :: ipft - real , intent(in) :: hite + real , intent(in) :: height real , intent(in) :: dbh real , intent(in) :: lat real , intent(in) :: bdeada !> Current dead biomass @@ -1000,7 +1000,7 @@ subroutine plant_structural_allocation(ipft,hite,dbh,lat,phen_status,elongf,bdea !----- Find the current target for allocation to reproduction. ----------------------! if (r_bang(ipft)) then !----- "Bang" reproduction once plant reaches reproductive maturity. -------------! - if ( hite < ( (1.0-r_tol_trunc) * repro_min_h(ipft) ) ) then + if ( height < ( (1.0-r_tol_trunc) * repro_min_h(ipft) ) ) then r_fract_act = 0.0 else r_fract_act = min(r_fract(ipft), 1.0 - st_fract(ipft)) @@ -1055,8 +1055,8 @@ subroutine plant_structural_allocation(ipft,hite,dbh,lat,phen_status,elongf,bdea ! Decide allocation to seeds and heartwood based on size and life form. ! !------------------------------------------------------------------------------! if (is_liana(ipft)) then - zero_growth = hite >= ( (1.0-r_tol_trunc) * maxh ) - zero_repro = hite < ( (1.0-r_tol_trunc) * repro_min_h(ipft) ) + zero_growth = height >= ( (1.0-r_tol_trunc) * maxh ) + zero_repro = height < ( (1.0-r_tol_trunc) * repro_min_h(ipft) ) !---------------------------------------------------------------------------! ! Lianas: we must check height relative to the rest of the local plant ! @@ -1090,7 +1090,7 @@ subroutine plant_structural_allocation(ipft,hite,dbh,lat,phen_status,elongf,bdea ! New grasses don't growth here (they do in dbalive_dt). Decide ! ! whether they may reproduce or not. ! !---------------------------------------------------------------------------! - zero_repro = hite < ( (1.0-r_tol_trunc) * repro_min_h(ipft) ) + zero_repro = height < ( (1.0-r_tol_trunc) * repro_min_h(ipft) ) if (zero_repro) then f_bseeds = 0.0 else @@ -1105,7 +1105,7 @@ subroutine plant_structural_allocation(ipft,hite,dbh,lat,phen_status,elongf,bdea ! DBH). ! !---------------------------------------------------------------------------! zero_growth = is_grass(ipft) .and. & - hite >= ( (1.0-r_tol_trunc) * hgt_max(ipft) ) + height >= ( (1.0-r_tol_trunc) * hgt_max(ipft) ) !---------------------------------------------------------------------------! @@ -1173,7 +1173,7 @@ subroutine plant_structural_allocation(ipft,hite,dbh,lat,phen_status,elongf,bdea open (unit=66,file=fracfile,status='old',position='append',action='write') write (unit=66,fmt='(6(i6,1x),2(5x,l1,1x),10(f12.6,1x))') & current_time%year,current_time%month,current_time%date,ipft,phenology(ipft) & - ,phen_status,late_spring,is_grass(ipft),hite,repro_min_h(ipft),dbh & + ,phen_status,late_spring,is_grass(ipft),height,repro_min_h(ipft),dbh & ,dbh_crit(ipft),elongf,bdeada+bdeadb,bstorage,f_bstorage,f_bseeds,f_growth close (unit=66,status='keep') end if @@ -1230,7 +1230,7 @@ subroutine bdead_structural_allocation(ipft,bstorage_in,bleaf_in,broot_in,bsapwo real , intent(out) :: f_bdeadb !----- Local variables. -------------------------------------------------------------! real :: dbh_aim - real :: hite_aim + real :: height_aim real :: bleaf_aim real :: broot_aim real :: bsapwooda_aim @@ -1300,7 +1300,7 @@ subroutine bdead_structural_allocation(ipft,bstorage_in,bleaf_in,broot_in,bsapwo select case (istruct_growth_scheme) case (1) !----- Find the new biomass with the storage inputs. -----------------------------! - call expand_bevery(ipft,bevery_aim,dbh_aim,hite_aim,bleaf_aim,broot_aim & + call expand_bevery(ipft,bevery_aim,dbh_aim,height_aim,bleaf_aim,broot_aim & ,bsapwooda_aim,bsapwoodb_aim,bbarka_aim,bbarkb_aim,balive_aim & ,bdeada_aim,bdeadb_aim) !---------------------------------------------------------------------------------! @@ -1507,7 +1507,7 @@ subroutine check_bstruct_cohort(csite,ipa,ico,bleaf_in,broot_in,bsapwooda_in write(unit=*,fmt=fmti ) ' COHORT : ',ico write(unit=*,fmt=fmti ) ' IPFT : ',ipft write(unit=*,fmt=fmtf ) ' DBH : ',cpatch%dbh(ico) - write(unit=*,fmt=fmtf ) ' HITE : ',cpatch%hite(ico) + write(unit=*,fmt=fmtf ) ' HEIGHT : ',cpatch%height(ico) write(unit=*,fmt='(a)') ' ---------------------------------------------------- ' write(unit=*,fmt=fmtf ) ' BLEAF_IN : ',bleaf_in write(unit=*,fmt=fmtf ) ' BROOT_IN : ',broot_in diff --git a/ED/src/init/ed_bigleaf_init.f90 b/ED/src/init/ed_bigleaf_init.f90 index 82765260a..26e78d4a4 100644 --- a/ED/src/init/ed_bigleaf_init.f90 +++ b/ED/src/init/ed_bigleaf_init.f90 @@ -317,23 +317,23 @@ subroutine sas_to_bigleaf(cgrid) cpatch => csite%patch(ipa) call allocate_patchtype(cpatch,1) cpatch%pft (1) = ipft - cpatch%hite (1) = hgt_max(ipft) + cpatch%height (1) = hgt_max(ipft) cpatch%dbh (1) = dbh_bigleaf(ipft) cpatch%sla (1) = sla (ipft) - cpatch%bleaf (1) = size2bl(cpatch%dbh(1),cpatch%hite(1) & + cpatch%bleaf (1) = size2bl(cpatch%dbh(1),cpatch%height(1) & ,cpatch%sla(1),ipft) - bdeadx = size2bd(cpatch%dbh(1),cpatch%hite(1),ipft) + bdeadx = size2bd(cpatch%dbh(1),cpatch%height(1),ipft) cpatch%bdeada (1) = agf_bs(ipft) * bdeadx cpatch%bdeadb (1) = (1. - agf_bs(ipft)) * bdeadx cpatch%broot (1) = cpatch%bleaf(1) * q(ipft) cpatch%bsapwooda(1) = agf_bs(ipft) * cpatch%bleaf(1) & - * qsw(ipft) * cpatch%hite(1) + * qsw(ipft) * cpatch%height(1) cpatch%bsapwoodb(1) = (1.0 - agf_bs(ipft)) * cpatch%bleaf(1) & - * qsw(ipft) * cpatch%hite(1) + * qsw(ipft) * cpatch%height(1) cpatch%bbarka (1) = agf_bs(ipft) * cpatch%bleaf(1) & - * qbark(ipft) * cpatch%hite(1) + * qbark(ipft) * cpatch%height(1) cpatch%bbarkb (1) = (1.0 - agf_bs(ipft)) * cpatch%bleaf(1) & - * qbark(ipft) * cpatch%hite(1) + * qbark(ipft) * cpatch%height(1) cpatch%balive (1) = ed_balive(cpatch,1) cpatch%nplant (1) = lai (ipft,ilu) & / ( cpatch%sla(1) * cpatch%bleaf(1) & @@ -391,10 +391,10 @@ subroutine sas_to_bigleaf(cgrid) !----- Above ground biomass, use the allometry. -------------------! cpatch%agb(1) = ed_biomass(cpatch, 1) cpatch%basarea(1) = pio4 * cpatch%dbh(1) * cpatch%dbh(1) - cpatch%btimber(1) = size2bt(cpatch%dbh(1),cpatch%hite(1) & + cpatch%btimber(1) = size2bt(cpatch%dbh(1),cpatch%height(1) & ,cpatch%bdeada(1),cpatch%bsapwooda(1) & ,cpatch%bbarka(1),cpatch%pft(1)) - cpatch%thbark(1) = size2xb(cpatch%dbh(1),cpatch%hite(1) & + cpatch%thbark(1) = size2xb(cpatch%dbh(1),cpatch%height(1) & ,cpatch%bbarka(1),cpatch%bbarkb(1) & ,cpatch%sla(1),cpatch%pft(1)) !------------------------------------------------------------------! diff --git a/ED/src/init/ed_nbg_init.f90 b/ED/src/init/ed_nbg_init.f90 index b3e1a0393..32d6b63df 100644 --- a/ED/src/init/ed_nbg_init.f90 +++ b/ED/src/init/ed_nbg_init.f90 @@ -296,24 +296,24 @@ subroutine init_nbg_cohorts(csite,lsl,ipa_a,ipa_z,mzg,ntext_soil) ! using the standard allometry for this PFT. ! !------------------------------------------------------------------------------! cpatch%nplant(ico) = init_density(ipft) - cpatch%hite(ico) = hgt_min(ipft) + cpatch%height(ico) = hgt_min(ipft) cpatch%phenology_status(ico) = 0 - cpatch%dbh(ico) = h2dbh(cpatch%hite(ico),ipft) - bdeadx = size2bd(cpatch%dbh(ico),cpatch%hite(ico),ipft) + cpatch%dbh(ico) = h2dbh(cpatch%height(ico),ipft) + bdeadx = size2bd(cpatch%dbh(ico),cpatch%height(ico),ipft) cpatch%bdeada(ico) = agf_bs(ipft) * bdeadx cpatch%bdeadb(ico) = (1. - agf_bs(ipft)) * bdeadx cpatch%sla(ico) = sla(ipft) - cpatch%bleaf(ico) = size2bl(cpatch%dbh(ico),cpatch%hite(ico) & + cpatch%bleaf(ico) = size2bl(cpatch%dbh(ico),cpatch%height(ico) & ,cpatch%sla(ico),ipft) cpatch%broot(ico) = q(ipft) * cpatch%bleaf(ico) cpatch%bsapwooda(ico) = agf_bs(ipft) * cpatch%bleaf(ico) & - * qsw(ipft) * cpatch%hite(ico) + * qsw(ipft) * cpatch%height(ico) cpatch%bsapwoodb(ico) = (1.-agf_bs(ipft)) * cpatch%bleaf(ico) & - * qsw(ipft) * cpatch%hite(ico) + * qsw(ipft) * cpatch%height(ico) cpatch%bbarka(ico) = agf_bs(ipft) * cpatch%bleaf(ico) & - * qbark(ipft) * cpatch%hite(ico) + * qbark(ipft) * cpatch%height(ico) cpatch%bbarkb(ico) = (1.-agf_bs(ipft)) * cpatch%bleaf(ico) & - * qbark(ipft) * cpatch%hite(ico) + * qbark(ipft) * cpatch%height(ico) cpatch%balive(ico) = ed_balive(cpatch,ico) cpatch%bstorage(ico) = max(almost_zero,f_bstorage_init(ipft)) & * cpatch%balive(ico) @@ -360,10 +360,10 @@ subroutine init_nbg_cohorts(csite,lsl,ipa_a,ipa_z,mzg,ntext_soil) call area_indices(cpatch, ico) cpatch%agb (ico) = ed_biomass(cpatch, ico) cpatch%basarea(ico) = pio4 * cpatch%dbh(ico)*cpatch%dbh(ico) - cpatch%btimber(ico) = size2bt(cpatch%dbh(ico),cpatch%hite(ico) & + cpatch%btimber(ico) = size2bt(cpatch%dbh(ico),cpatch%height(ico) & ,cpatch%bdeada(ico),cpatch%bsapwooda(ico) & ,cpatch%bbarka(ico),cpatch%pft(ico)) - cpatch%thbark (ico) = size2xb(cpatch%dbh(ico),cpatch%hite(ico) & + cpatch%thbark (ico) = size2xb(cpatch%dbh(ico),cpatch%height(ico) & ,cpatch%bbarka(ico),cpatch%bbarkb(ico) & ,cpatch%sla(ico),cpatch%pft(ico)) !------------------------------------------------------------------------------! @@ -488,24 +488,24 @@ subroutine init_cohorts_by_layers(csite,lsl,ipa_a,ipa_z,mzg,ntext_soil) ! initial LAI. We then compute the other biomass quantities using the stand- ! ! ard allometry for this PFT. ! !------------------------------------------------------------------------------! - cpatch%hite(ico) = height + cpatch%height(ico) = height cpatch%phenology_status(ico) = 0 - cpatch%dbh(ico) = h2dbh(cpatch%hite(ico),ipft) - bdeadx = size2bd(cpatch%dbh(ico),cpatch%hite(ico),ipft) + cpatch%dbh(ico) = h2dbh(cpatch%height(ico),ipft) + bdeadx = size2bd(cpatch%dbh(ico),cpatch%height(ico),ipft) cpatch%bdeada(ico) = agf_bs(ipft) * bdeadx cpatch%bdeadb(ico) = (1. - agf_bs(ipft)) * bdeadx cpatch%sla(ico) = sla(ipft) - cpatch%bleaf(ico) = size2bl(cpatch%dbh(ico),cpatch%hite(ico) & + cpatch%bleaf(ico) = size2bl(cpatch%dbh(ico),cpatch%height(ico) & ,cpatch%sla(ico),ipft) cpatch%broot(ico) = q(ipft) * cpatch%bleaf(ico) cpatch%bsapwooda(ico) = agf_bs(ipft) * cpatch%bleaf(ico) & - * qsw(ipft) * cpatch%hite(ico) + * qsw(ipft) * cpatch%height(ico) cpatch%bsapwoodb(ico) = (1.-agf_bs(ipft)) * cpatch%bleaf(ico) & - * qsw(ipft) * cpatch%hite(ico) + * qsw(ipft) * cpatch%height(ico) cpatch%bbarka(ico) = agf_bs(ipft) * cpatch%bleaf(ico) & - * qbark(ipft) * cpatch%hite(ico) + * qbark(ipft) * cpatch%height(ico) cpatch%bbarkb(ico) = (1.-agf_bs(ipft)) * cpatch%bleaf(ico) & - * qbark(ipft) * cpatch%hite(ico) + * qbark(ipft) * cpatch%height(ico) cpatch%balive(ico) = ed_balive(cpatch,ico) cpatch%bstorage(ico) = max(almost_zero,f_bstorage_init(ipft)) & * cpatch%balive(ico) @@ -550,10 +550,10 @@ subroutine init_cohorts_by_layers(csite,lsl,ipa_a,ipa_z,mzg,ntext_soil) call area_indices(cpatch, ico) cpatch%agb (ico) = ed_biomass(cpatch, ico) cpatch%basarea(ico) = pio4 * cpatch%dbh(ico)*cpatch%dbh(ico) - cpatch%btimber(ico) = size2bt(cpatch%dbh(ico),cpatch%hite(ico) & + cpatch%btimber(ico) = size2bt(cpatch%dbh(ico),cpatch%height(ico) & ,cpatch%bdeada(ico),cpatch%bsapwooda(ico) & ,cpatch%bbarka(ico),cpatch%pft(ico)) - cpatch%thbark (ico) = size2xb(cpatch%dbh(ico),cpatch%hite(ico) & + cpatch%thbark (ico) = size2xb(cpatch%dbh(ico),cpatch%height(ico) & ,cpatch%bbarka(ico),cpatch%bbarkb(ico) & ,cpatch%sla(ico),cpatch%pft(ico)) !------------------------------------------------------------------------------! @@ -771,24 +771,25 @@ subroutine near_bare_ground_big_leaf_init(cgrid) !------------------------------------------------------------------------! cpatch%nplant(ico) = init_density(ipft) cpatch%dbh(ico) = dbh_bigleaf(ipft) - cpatch%hite(ico) = hgt_max(ipft) + cpatch%height(ico) = hgt_max(ipft) cpatch%phenology_status(ico) = 0 - bdeadx = size2bd(cpatch%dbh(ico),cpatch%hite(ico) & - ,ipft) + bdeadx = size2bd(cpatch%dbh(ico) & + ,cpatch%height(ico),ipft) cpatch%bdeada(ico) = agf_bs(ipft) * bdeadx cpatch%bdeadb(ico) = (1. - agf_bs(ipft)) * bdeadx cpatch%sla(ico) = sla(ipft) - cpatch%bleaf(ico) = size2bl(cpatch%dbh(ico),cpatch%hite(ico) & + cpatch%bleaf(ico) = size2bl(cpatch%dbh(ico) & + ,cpatch%height(ico) & ,cpatch%sla(ico),ipft) cpatch%broot(ico) = q(ipft) * cpatch%bleaf(ico) cpatch%bsapwooda(ico) = agf_bs(ipft) * cpatch%bleaf(ico) & - * qsw(ipft) * cpatch%hite(ico) + * qsw(ipft) * cpatch%height(ico) cpatch%bsapwoodb(ico) = (1.-agf_bs(ipft)) * cpatch%bleaf(ico) & - * qsw(ipft) * cpatch%hite(ico) + * qsw(ipft) * cpatch%height(ico) cpatch%bbarka(ico) = agf_bs(ipft) * cpatch%bleaf(ico) & - * qbark(ipft) * cpatch%hite(ico) + * qbark(ipft) * cpatch%height(ico) cpatch%bbarkb(ico) = (1.-agf_bs(ipft)) * cpatch%bleaf(ico) & - * qbark(ipft) * cpatch%hite(ico) + * qbark(ipft) * cpatch%height(ico) cpatch%balive(ico) = ed_balive(cpatch,ico) cpatch%bstorage(ico) = max(almost_zero,f_bstorage_init(ipft)) & * cpatch%balive(ico) @@ -831,10 +832,10 @@ subroutine near_bare_ground_big_leaf_init(cgrid) call area_indices(cpatch, ico) cpatch%agb (ico) = ed_biomass(cpatch, ico) cpatch%basarea(ico) = pio4 * cpatch%dbh(ico)*cpatch%dbh(ico) - cpatch%btimber(ico) = size2bt(cpatch%dbh(ico),cpatch%hite(ico) & + cpatch%btimber(ico) = size2bt(cpatch%dbh(ico),cpatch%height(ico) & ,cpatch%bdeada(ico),cpatch%bsapwooda(ico) & ,cpatch%bbarka(ico),cpatch%pft(ico)) - cpatch%thbark (ico) = size2xb(cpatch%dbh(ico),cpatch%hite(ico) & + cpatch%thbark (ico) = size2xb(cpatch%dbh(ico),cpatch%height(ico) & ,cpatch%bbarka(ico),cpatch%bbarkb(ico) & ,cpatch%sla(ico),cpatch%pft(ico)) !------------------------------------------------------------------------! diff --git a/ED/src/init/ed_params.f90 b/ED/src/init/ed_params.f90 index b622de3ee..4621380ce 100644 --- a/ED/src/init/ed_params.f90 +++ b/ED/src/init/ed_params.f90 @@ -814,8 +814,8 @@ subroutine init_disturb_params use disturb_coms , only : treefall_disturbance_rate & ! intent(in) , include_fire & ! intent(in) - , treefall_hite_threshold & ! intent(out) - , does_hite_limit_tfpatch & ! intent(out) + , treefall_height_threshold & ! intent(out) + , does_height_limit_tfpatch & ! intent(out) , forestry_on & ! intent(out) , agriculture_on & ! intent(out) , plantation_year & ! intent(out) @@ -842,10 +842,10 @@ subroutine init_disturb_params implicit none !----- Only trees above this height create a gap when they fall. -----------------------! - treefall_hite_threshold = 10.0 + treefall_height_threshold = 10.0 !----- Flag to decide whether or not to limit disturbance to patches with tall trees. --! - does_hite_limit_tfpatch = .true. + does_height_limit_tfpatch = .true. !----- Set to 1 if to do forest harvesting. --------------------------------------------! forestry_on = 0 @@ -5031,9 +5031,9 @@ subroutine init_pft_mort_params() !---------------------------------------------------------------------------------------! ! Treefall survivorship fraction. ! !---------------------------------------------------------------------------------------! - !----- Trees taller than treefall_hite_threshold (liana survivorship: Putz 1983). ------! + !----- Trees taller than treefall_height threshold (liana survivorship: Putz 1983). ----! treefall_s_gtht(:) = merge(0.80,0.00,is_liana(:)) - !----- Trees shorter than treefall_hite_threshold. -------------------------------------! + !----- Trees shorter than treefall_height_threshold. -----------------------------------! select case (economics_scheme) case (1) !------------------------------------------------------------------------------------! diff --git a/ED/src/init/ed_type_init.f90 b/ED/src/init/ed_type_init.f90 index 91822fa17..ce215310d 100644 --- a/ED/src/init/ed_type_init.f90 +++ b/ED/src/init/ed_type_init.f90 @@ -197,7 +197,7 @@ subroutine init_ed_cohort_vars(cpatch,ico, lsl,mzg,ntext_soil) !------------------------------------------------------------------------------------! ! The root depth should be the actual level for the roots. ! !------------------------------------------------------------------------------------! - cpatch%krdepth(ico) = size2krdepth(cpatch%hite(ico),cpatch%dbh(ico),ipft,lsl) + cpatch%krdepth(ico) = size2krdepth(cpatch%height(ico),cpatch%dbh(ico),ipft,lsl) kroot = cpatch%krdepth(ico) !------------------------------------------------------------------------------------! @@ -237,8 +237,8 @@ subroutine init_ed_cohort_vars(cpatch,ico, lsl,mzg,ntext_soil) cpatch%wood_psi(ico) = min(cpatch%wood_psi(ico),soil(ntext)%slpotfc) end do cpatch%wood_psi(ico) = min( 0., max( cpatch%wood_psi(ico) & - , small_psi_min(ipft)+cpatch%hite(ico) ) ) - cpatch%leaf_psi(ico) = min( 0., max( cpatch%wood_psi(ico) - cpatch%hite(ico) & + , small_psi_min(ipft)+cpatch%height(ico) ) ) + cpatch%leaf_psi(ico) = min( 0., max( cpatch%wood_psi(ico) - cpatch%height(ico) & , small_psi_min(ipft) ) ) !---------------------------------------------------------------------------------! diff --git a/ED/src/io/ed_init_history.f90 b/ED/src/io/ed_init_history.f90 index 7453fb2f1..f21d25361 100644 --- a/ED/src/io/ed_init_history.f90 +++ b/ED/src/io/ed_init_history.f90 @@ -5187,8 +5187,8 @@ subroutine fill_history_patch(cpatch,paco_index,ncohorts_global) memoffs (1) = 0_8 call hdf_getslab_r(cpatch%nplant & ,'NPLANT ',dsetrank,iparallel,.true. ,foundvar) - call hdf_getslab_r(cpatch%hite & - ,'HITE ',dsetrank,iparallel,.true. ,foundvar) + call hdf_getslab_r(cpatch%height & + ,'HEIGHT ',dsetrank,iparallel,.true. ,foundvar) call hdf_getslab_r(cpatch%agb & ,'AGB_CO ',dsetrank,iparallel,.true. ,foundvar) call hdf_getslab_r(cpatch%basarea & diff --git a/ED/src/io/ed_read_ed10_20_history.f90 b/ED/src/io/ed_read_ed10_20_history.f90 index 6544d969c..47024cd27 100644 --- a/ED/src/io/ed_read_ed10_20_history.f90 +++ b/ED/src/io/ed_read_ed10_20_history.f90 @@ -148,7 +148,7 @@ subroutine read_ed10_ed20_history_file real , dimension(huge_cohort) :: avgRg real , dimension(huge_cohort) :: bdead real , dimension(huge_cohort) :: nplant - real , dimension(huge_cohort) :: hite + real , dimension(huge_cohort) :: height real , dimension(huge_cohort) :: dbh real , dimension(huge_cohort) :: ctime real , dimension(maxfiles) :: slon_list,slat_list @@ -704,7 +704,7 @@ subroutine read_ed10_ed20_history_file case (1) !----- ED-1.0 file. --------------------------------------------------------! read(unit=12,fmt=*,iostat=ierr) ctime(ic),cpname(ic),cname(ic),dbh(ic) & - ,hite(ic),ipft(ic),nplant(ic),bdead(ic) & + ,height(ic),ipft(ic),nplant(ic),bdead(ic) & ,balive(ic),avgRg(ic),leaves_on(ic) & ,cb(1:12,ic),cb_max(1:12,ic) @@ -716,7 +716,7 @@ subroutine read_ed10_ed20_history_file case (2,3,6) !----- ED-2.0 file. --------------------------------------------------------! read(unit=12,fmt=*,iostat=ierr) ctime(ic),cpname(ic),cname(ic),dbh(ic) & - ,hite(ic),ipft(ic),nplant(ic),bdead(ic) & + ,height(ic),ipft(ic),nplant(ic),bdead(ic) & ,balive(ic),avgRg(ic) !---------------------------------------------------------------------------! ! Check whether the file has hit the end, and if so, leave the loop. ! @@ -851,8 +851,8 @@ subroutine read_ed10_ed20_history_file case (6) !----- Inventory. Read DBH and find the other stuff. ----------! cpatch%dbh(ic2) = max(dbh(ic),min_dbh(ipft(ic))) - cpatch%hite(ic2) = dbh2h(cpatch%pft(ic2),cpatch%dbh(ic2)) - bdead(ic) = size2bd(cpatch%dbh(ic2),cpatch%hite(ic2) & + cpatch%height(ic2) = dbh2h(cpatch%pft(ic2),cpatch%dbh(ic2)) + bdead(ic) = size2bd(cpatch%dbh(ic2),cpatch%height(ic2) & ,ipft(ic)) cpatch%bdeada(ic2) = agf_bs(ipft(ic)) * bdead(ic) cpatch%bdeadb(ic2) = (1.0 - agf_bs(ipft(ic))) * bdead(ic) @@ -871,12 +871,12 @@ subroutine read_ed10_ed20_history_file cpatch%bdeadb(ic2) = (1.0 - agf_bs(ipft(ic))) * bdead(ic) cpatch%dbh(ic2) = bd2dbh(ipft(ic),cpatch%bdeada(ic2) & ,cpatch%bdeadb(ic2)) - cpatch%hite(ic2) = dbh2h(ipft(ic),cpatch%dbh(ic2)) + cpatch%height(ic2) = dbh2h(ipft(ic),cpatch%dbh(ic2)) else cpatch%dbh(ic2) = max(dbh(ic),min_dbh(ipft(ic))) - cpatch%hite(ic2) = dbh2h(ipft(ic),cpatch%dbh(ic2)) + cpatch%height(ic2) = dbh2h(ipft(ic),cpatch%dbh(ic2)) bdead(ic) = size2bd(cpatch%dbh (ic2) & - ,cpatch%hite(ic2),ipft(ic) ) + ,cpatch%height(ic2),ipft(ic) ) cpatch%bdeada(ic2) = agf_bs(ipft(ic)) * bdead(ic) cpatch%bdeadb(ic2) = (1.0 - agf_bs(ipft(ic))) * bdead(ic) end if @@ -902,21 +902,21 @@ subroutine read_ed10_ed20_history_file ! Use allometry to define leaf and the other live biomass ! ! pools. ! !------------------------------------------------------------------! - cpatch%bleaf(ic2) = size2bl(cpatch%dbh(ic2),cpatch%hite(ic2) & + cpatch%bleaf(ic2) = size2bl(cpatch%dbh(ic2),cpatch%height(ic2) & ,cpatch%sla(ic2),ipft(ic)) cpatch%broot(ic2) = cpatch%bleaf(ic2) * q(ipft(ic)) cpatch%bsapwooda(ic2) = agf_bs(ipft(ic)) & * cpatch%bleaf(ic2) & - * qsw(ipft(ic)) * cpatch%hite(ic2) + * qsw(ipft(ic)) * cpatch%height(ic2) cpatch%bsapwoodb(ic2) = (1.-agf_bs(ipft(ic))) & * cpatch%bleaf(ic2) & - * qsw(ipft(ic)) * cpatch%hite(ic2) + * qsw(ipft(ic)) * cpatch%height(ic2) cpatch%bbarka(ic2) = agf_bs(ipft(ic)) & * cpatch%bleaf(ic2) & - * qbark(ipft(ic)) * cpatch%hite(ic2) + * qbark(ipft(ic)) * cpatch%height(ic2) cpatch%bbarkb(ic2) = (1.-agf_bs(ipft(ic))) & * cpatch%bleaf(ic2) & - * qbark(ipft(ic)) * cpatch%hite(ic2) + * qbark(ipft(ic)) * cpatch%height(ic2) !------------------------------------------------------------------! @@ -1006,13 +1006,13 @@ subroutine read_ed10_ed20_history_file cpatch%agb (ic2) = ed_biomass(cpatch, ic2) cpatch%basarea(ic2) = pio4 * cpatch%dbh(ic2) * cpatch%dbh(ic2) cpatch%btimber(ic2) = size2bt( cpatch%dbh (ic2) & - , cpatch%hite (ic2) & + , cpatch%height (ic2) & , cpatch%bdeada (ic2) & , cpatch%bsapwooda (ic2) & , cpatch%bbarka (ic2) & , cpatch%pft (ic2) ) cpatch%thbark (ic2) = size2xb( cpatch%dbh (ic2) & - , cpatch%hite (ic2) & + , cpatch%height (ic2) & , cpatch%bbarka (ic2) & , cpatch%bbarkb (ic2) & , cpatch%sla (ic2) & diff --git a/ED/src/io/ed_read_ed21_history.f90 b/ED/src/io/ed_read_ed21_history.f90 index bba663ff7..997b1c7fd 100644 --- a/ED/src/io/ed_read_ed21_history.f90 +++ b/ED/src/io/ed_read_ed21_history.f90 @@ -694,9 +694,9 @@ subroutine read_ed21_history_file select case (iallom) case (3,4,5) !----- New allometry, initialise with DBH. ------------------! - cpatch%hite(ico) = dbh2h (ipft,cpatch%dbh (ico)) + cpatch%height(ico) = dbh2h (ipft,cpatch%dbh (ico)) bdeadx = size2bd(cpatch%dbh(ico) & - ,cpatch%hite(ico),ipft) + ,cpatch%height(ico),ipft) cpatch%bdeada(ico) = agf_bs(ipft) * bdeadx cpatch%bdeadb(ico) = (1.0 - agf_bs(ipft)) * bdeadx case default @@ -709,7 +709,7 @@ subroutine read_ed21_history_file ! discarded. This does not violate carbon conservation ! ! because this is the initial state of a new run. ! !---------------------------------------------------------! - cpatch%hite (ico) = dbh2h (ipft,cpatch%dbh (ico)) + cpatch%height(ico) = dbh2h (ipft,cpatch%dbh (ico)) cpatch%bdeada(ico) = 0.0 cpatch%bdeadb(ico) = 0.0 !---------------------------------------------------------! @@ -719,18 +719,18 @@ subroutine read_ed21_history_file ! Grasses have bdead in both input and current run ! ! (igrass=0). ! !---------------------------------------------------------! - cpatch%dbh(ico) = bd2dbh(ipft,cpatch%bdeada(ico) & - ,cpatch%bdeadb(ico) ) - cpatch%hite(ico) = dbh2h (ipft,cpatch%dbh (ico) ) + cpatch%dbh (ico) = bd2dbh(ipft,cpatch%bdeada(ico) & + ,cpatch%bdeadb(ico) ) + cpatch%height(ico) = dbh2h (ipft,cpatch%dbh (ico) ) !---------------------------------------------------------! else !---------------------------------------------------------! ! It is either a new grass (igrass=1) in the initial ! ! file, or the value for bdead is missing from the files. ! !---------------------------------------------------------! - cpatch%hite(ico) = dbh2h (ipft,cpatch%dbh (ico)) + cpatch%height(ico) = dbh2h (ipft,cpatch%dbh (ico)) bdeadx = size2bd(cpatch%dbh(ico) & - ,cpatch%hite(ico),ipft) + ,cpatch%height(ico),ipft) cpatch%bdeada(ico) = agf_bs(ipft) * bdeadx cpatch%bdeadb(ico) = (1.0 - agf_bs(ipft)) * bdeadx !---------------------------------------------------------! @@ -755,19 +755,19 @@ subroutine read_ed21_history_file ! Use allometry to define leaf and the other live biomass ! ! pools. ! !---------------------------------------------------------------! - cpatch%bleaf(ico) = size2bl( cpatch%dbh (ico) & - , cpatch%hite(ico) & - , cpatch%sla (ico) & + cpatch%bleaf(ico) = size2bl( cpatch%dbh (ico) & + , cpatch%height(ico) & + , cpatch%sla (ico) & , ipft ) cpatch%broot (ico) = cpatch%bleaf(ico) * q(ipft) cpatch%bsapwooda(ico) = agf_bs(ipft) * cpatch%bleaf(ico) & - * qsw(ipft) * cpatch%hite(ico) + * qsw(ipft) * cpatch%height(ico) cpatch%bsapwoodb(ico) = (1.-agf_bs(ipft)) * cpatch%bleaf(ico) & - * qsw(ipft) * cpatch%hite(ico) + * qsw(ipft) * cpatch%height(ico) cpatch%bbarka(ico) = agf_bs(ipft) * cpatch%bleaf(ico) & - * qbark(ipft) * cpatch%hite(ico) + * qbark(ipft) * cpatch%height(ico) cpatch%bbarkb(ico) = (1.-agf_bs(ipft)) * cpatch%bleaf(ico) & - * qbark(ipft) * cpatch%hite(ico) + * qbark(ipft) * cpatch%height(ico) cpatch%balive (ico) = ed_balive(cpatch,ico) cpatch%bstorage(ico) = max(almost_zero,f_bstorage_init(ipft)) & * cpatch%balive(ico) @@ -937,13 +937,13 @@ subroutine read_ed21_history_file cpatch%agb (ico) = ed_biomass(cpatch, ico) cpatch%basarea(ico) = pio4 * cpatch%dbh(ico) * cpatch%dbh(ico) cpatch%btimber(ico) = size2bt( cpatch%dbh (ico) & - , cpatch%hite (ico) & + , cpatch%height (ico) & , cpatch%bdeada (ico) & , cpatch%bsapwooda(ico) & , cpatch%bbarka (ico) & , cpatch%pft (ico) ) cpatch%thbark(ico) = size2xb( cpatch%dbh (ico) & - , cpatch%hite (ico) & + , cpatch%height (ico) & , cpatch%bbarka (ico) & , cpatch%bbarkb (ico) & , cpatch%sla (ico) & @@ -2101,9 +2101,9 @@ subroutine read_ed21_history_unstruct select case (iallom) case (3,4,5) !----- New allometry, initialise with DBH. ------------------! - cpatch%hite(ico) = dbh2h (ipft,cpatch%dbh (ico)) + cpatch%height(ico) = dbh2h (ipft,cpatch%dbh (ico)) bdeadx = size2bd(cpatch%dbh(ico) & - ,cpatch%hite(ico),ipft) + ,cpatch%height(ico),ipft) cpatch%bdeada(ico) = agf_bs(ipft) * bdeadx cpatch%bdeadb(ico) = (1.0 - agf_bs(ipft)) * bdeadx case default @@ -2116,7 +2116,7 @@ subroutine read_ed21_history_unstruct ! discarded. This does not violate carbon conservation ! ! because this is the initial state of a new run. ! !---------------------------------------------------------! - cpatch%hite (ico) = dbh2h (ipft,cpatch%dbh (ico)) + cpatch%height(ico) = dbh2h (ipft,cpatch%dbh (ico)) cpatch%bdeada(ico) = 0.0 cpatch%bdeadb(ico) = 0.0 !---------------------------------------------------------! @@ -2126,18 +2126,18 @@ subroutine read_ed21_history_unstruct ! Grasses have bdead in both input and current run ! ! (igrass=0). ! !---------------------------------------------------------! - cpatch%dbh(ico) = bd2dbh(ipft,cpatch%bdeada(ico) & - ,cpatch%bdeadb(ico) ) - cpatch%hite(ico) = dbh2h (ipft,cpatch%dbh (ico) ) + cpatch%dbh (ico) = bd2dbh(ipft,cpatch%bdeada(ico) & + ,cpatch%bdeadb(ico) ) + cpatch%height(ico) = dbh2h (ipft,cpatch%dbh (ico) ) !---------------------------------------------------------! else !---------------------------------------------------------! ! It is either a new grass (igrass=1) in the initial ! ! file, or the value for bdead is missing from the files. ! !---------------------------------------------------------! - cpatch%hite(ico) = dbh2h (ipft,cpatch%dbh (ico)) + cpatch%height(ico) = dbh2h (ipft,cpatch%dbh (ico)) bdeadx = size2bd(cpatch%dbh(ico) & - ,cpatch%hite(ico),ipft) + ,cpatch%height(ico),ipft) cpatch%bdeada(ico) = agf_bs(ipft) * bdeadx cpatch%bdeadb(ico) = (1.0 - agf_bs(ipft)) * bdeadx !---------------------------------------------------------! @@ -2161,19 +2161,19 @@ subroutine read_ed21_history_unstruct ! Use allometry to define leaf and the other live biomass ! ! pools. ! !---------------------------------------------------------------! - cpatch%bleaf(ico) = size2bl( cpatch%dbh (ico) & - , cpatch%hite(ico) & - , cpatch%sla (ico) & + cpatch%bleaf(ico) = size2bl( cpatch%dbh (ico) & + , cpatch%height(ico) & + , cpatch%sla (ico) & , ipft ) cpatch%broot(ico) = cpatch%bleaf(ico) * q(ipft) cpatch%bsapwooda(ico) = agf_bs(ipft) * cpatch%bleaf(ico) & - * qsw(ipft) * cpatch%hite(ico) + * qsw(ipft) * cpatch%height(ico) cpatch%bsapwoodb(ico) = (1. - agf_bs(ipft)) * cpatch%bleaf(ico) & - * qsw(ipft) * cpatch%hite(ico) + * qsw(ipft) * cpatch%height(ico) cpatch%bbarka(ico) = agf_bs(ipft) * cpatch%bleaf(ico) & - * qbark(ipft) * cpatch%hite(ico) + * qbark(ipft) * cpatch%height(ico) cpatch%bbarkb(ico) = (1.-agf_bs(ipft)) * cpatch%bleaf(ico) & - * qbark(ipft) * cpatch%hite(ico) + * qbark(ipft) * cpatch%height(ico) cpatch%balive (ico) = ed_balive(cpatch,ico) cpatch%bstorage(ico) = max(almost_zero,f_bstorage_init(ipft)) & * cpatch%balive(ico) @@ -2343,13 +2343,13 @@ subroutine read_ed21_history_unstruct cpatch%agb (ico) = ed_biomass(cpatch, ico) cpatch%basarea(ico) = pio4 * cpatch%dbh(ico) * cpatch%dbh(ico) cpatch%btimber(ico) = size2bt( cpatch%dbh (ico) & - , cpatch%hite (ico) & + , cpatch%height (ico) & , cpatch%bdeada (ico) & , cpatch%bsapwooda(ico) & , cpatch%bbarka (ico) & , cpatch%pft (ico) ) cpatch%thbark(ico) = size2xb( cpatch%dbh (ico) & - , cpatch%hite (ico) & + , cpatch%height (ico) & , cpatch%bbarka (ico) & , cpatch%bbarkb (ico) & , cpatch%sla (ico) & @@ -3491,9 +3491,9 @@ subroutine read_ed21_polyclone select case (iallom) case (3,4,5) !----- New allometry, initialise with DBH. ------------------! - cpatch%hite(ico) = dbh2h (ipft,cpatch%dbh (ico)) + cpatch%height(ico) = dbh2h (ipft,cpatch%dbh (ico)) bdeadx = size2bd(cpatch%dbh(ico) & - ,cpatch%hite(ico),ipft) + ,cpatch%height(ico),ipft) cpatch%bdeada(ico) = agf_bs(ipft) * bdeadx cpatch%bdeadb(ico) = (1.0 - agf_bs(ipft)) * bdeadx case default @@ -3506,7 +3506,7 @@ subroutine read_ed21_polyclone ! discarded. This does not violate carbon conservation ! ! because this is the initial state of a new run. ! !---------------------------------------------------------! - cpatch%hite (ico) = dbh2h (ipft,cpatch%dbh (ico)) + cpatch%height(ico) = dbh2h (ipft,cpatch%dbh (ico)) cpatch%bdeada(ico) = 0.0 cpatch%bdeadb(ico) = 0.0 !---------------------------------------------------------! @@ -3516,18 +3516,18 @@ subroutine read_ed21_polyclone ! Grasses have bdead in both input and current run ! ! (igrass=0). ! !---------------------------------------------------------! - cpatch%dbh(ico) = bd2dbh(ipft,cpatch%bdeada(ico) & - ,cpatch%bdeadb(ico) ) - cpatch%hite(ico) = dbh2h (ipft,cpatch%dbh (ico) ) + cpatch%dbh (ico) = bd2dbh(ipft,cpatch%bdeada(ico) & + ,cpatch%bdeadb(ico) ) + cpatch%height(ico) = dbh2h (ipft,cpatch%dbh (ico) ) !---------------------------------------------------------! else !---------------------------------------------------------! ! It is either a new grass (igrass=1) in the initial ! ! file, or the value for bdead is missing from the files. ! !---------------------------------------------------------! - cpatch%hite(ico) = dbh2h (ipft,cpatch%dbh (ico)) + cpatch%height(ico) = dbh2h (ipft,cpatch%dbh (ico)) bdeadx = size2bd(cpatch%dbh(ico) & - ,cpatch%hite(ico),ipft) + ,cpatch%height(ico),ipft) cpatch%bdeada(ico) = agf_bs(ipft) * bdeadx cpatch%bdeadb(ico) = (1.0 - agf_bs(ipft)) * bdeadx !---------------------------------------------------------! @@ -3552,19 +3552,19 @@ subroutine read_ed21_polyclone ! Use allometry to define leaf and the other live biomass ! ! pools. ! !---------------------------------------------------------------! - cpatch%bleaf(ico) = size2bl( cpatch%dbh (ico) & - , cpatch%hite(ico) & - , cpatch%sla (ico) & + cpatch%bleaf(ico) = size2bl( cpatch%dbh (ico) & + , cpatch%height(ico) & + , cpatch%sla (ico) & , ipft ) cpatch%broot(ico) = cpatch%bleaf(ico) * q(ipft) cpatch%bsapwooda(ico) = agf_bs(ipft) * cpatch%bleaf(ico) & - * qsw(ipft) * cpatch%hite(ico) + * qsw(ipft) * cpatch%height(ico) cpatch%bsapwoodb(ico) = (1. - agf_bs(ipft)) * cpatch%bleaf(ico) & - * qsw(ipft) * cpatch%hite(ico) + * qsw(ipft) * cpatch%height(ico) cpatch%bbarka(ico) = agf_bs(ipft) * cpatch%bleaf(ico) & - * qbark(ipft) * cpatch%hite(ico) + * qbark(ipft) * cpatch%height(ico) cpatch%bbarkb(ico) = (1.-agf_bs(ipft)) * cpatch%bleaf(ico) & - * qbark(ipft) * cpatch%hite(ico) + * qbark(ipft) * cpatch%height(ico) cpatch%balive (ico) = ed_balive(cpatch,ico) cpatch%bstorage(ico) = max(almost_zero,f_bstorage_init(ipft)) & * cpatch%balive(ico) @@ -3733,13 +3733,13 @@ subroutine read_ed21_polyclone cpatch%agb(ico) = ed_biomass(cpatch, ico) cpatch%basarea(ico) = pio4 * cpatch%dbh(ico) * cpatch%dbh(ico) cpatch%btimber(ico) = size2bt( cpatch%dbh (ico) & - , cpatch%hite (ico) & + , cpatch%height (ico) & , cpatch%bdeada (ico) & , cpatch%bsapwooda(ico) & , cpatch%bbarka (ico) & , cpatch%pft (ico) ) cpatch%thbark(ico) = size2xb( cpatch%dbh (ico) & - , cpatch%hite (ico) & + , cpatch%height (ico) & , cpatch%bbarka (ico) & , cpatch%bbarkb (ico) & , cpatch%sla (ico) & diff --git a/ED/src/io/ed_read_ed22_initial.f90 b/ED/src/io/ed_read_ed22_initial.f90 index bcdd1a5ef..28ebc23dc 100644 --- a/ED/src/io/ed_read_ed22_initial.f90 +++ b/ED/src/io/ed_read_ed22_initial.f90 @@ -180,7 +180,7 @@ subroutine read_ed22_initial_file real , dimension(huge_cohort) :: balive real , dimension(huge_cohort) :: bdead real , dimension(huge_cohort) :: nplant - real , dimension(huge_cohort) :: hite + real , dimension(huge_cohort) :: height real , dimension(huge_cohort) :: dbh real , dimension(huge_cohort) :: ctime real , dimension(maxfiles) :: slon_list @@ -336,7 +336,7 @@ subroutine read_ed22_initial_file balive (:) = undef_real bdead (:) = undef_real nplant (:) = undef_real - hite (:) = undef_real + height (:) = undef_real dbh (:) = undef_real ctime (:) = undef_real !---------------------------------------------------------------------------------! @@ -611,7 +611,7 @@ subroutine read_ed22_initial_file !----- Read line. Exit loop when finished reading cohorts. -------------------! read(unit=12,fmt=*,iostat=ierr) ctime(gco),csname(gco),cpname(gco),cname(gco) & - ,dbh(gco),hite(gco),ipft(gco),nplant(gco) & + ,dbh(gco),height(gco),ipft(gco),nplant(gco) & ,bdead(gco),balive(gco),dummy,dummy if (ierr /= 0) exit read_cohorts !------------------------------------------------------------------------------! @@ -1065,8 +1065,9 @@ subroutine read_ed22_initial_file !------ Update allometry to define height and heartwood. ----------------------! - cpatch%hite (ico) = dbh2h(cpatch%pft(ico),cpatch%dbh(ico)) - bdead (gco) = size2bd(cpatch%dbh(ico),cpatch%hite(ico),cpatch%pft(ico)) + cpatch%height(ico) = dbh2h(cpatch%pft(ico),cpatch%dbh(ico)) + bdead (gco) = size2bd(cpatch%dbh(ico),cpatch%height(ico) & + ,cpatch%pft(ico)) cpatch%bdeada(ico) = agf_bs(cpatch%pft(ico)) * bdead(gco) cpatch%bdeadb(ico) = (1.0 - agf_bs(cpatch%pft(ico))) * bdead(gco) !------------------------------------------------------------------------------! @@ -1090,17 +1091,21 @@ subroutine read_ed22_initial_file !------------------------------------------------------------------------------! ! Use allometry to define leaf and the other live biomass pools. ! !------------------------------------------------------------------------------! - cpatch%bleaf (ico) = size2bl(cpatch%dbh(ico),cpatch%hite(ico) & + cpatch%bleaf (ico) = size2bl(cpatch%dbh(ico),cpatch%height(ico) & ,cpatch%sla(ico),ipft(gco)) cpatch%broot (ico) = cpatch%bleaf(ico) * q(ipft(gco)) cpatch%bsapwooda(ico) = agf_bs(ipft(gco)) & - * cpatch%bleaf(ico) * qsw(ipft(gco)) * cpatch%hite(ico) + * cpatch%bleaf(ico) * qsw(ipft(gco)) & + * cpatch%height(ico) cpatch%bsapwoodb(ico) = (1.-agf_bs(ipft(gco))) & - * cpatch%bleaf(ico) * qsw(ipft(gco)) * cpatch%hite(ico) + * cpatch%bleaf(ico) * qsw(ipft(gco)) & + * cpatch%height(ico) cpatch%bbarka(ico) = agf_bs(ipft(gco)) & - * cpatch%bleaf(ico) * qbark(ipft(gco)) * cpatch%hite(ico) + * cpatch%bleaf(ico) * qbark(ipft(gco)) & + * cpatch%height(ico) cpatch%bbarkb(ico) = (1.-agf_bs(ipft(gco))) & - * cpatch%bleaf(ico) * qbark(ipft(gco)) * cpatch%hite(ico) + * cpatch%bleaf(ico) * qbark(ipft(gco)) & + * cpatch%height(ico) !------------------------------------------------------------------------------! @@ -1184,13 +1189,13 @@ subroutine read_ed22_initial_file cpatch%agb (ico) = ed_biomass(cpatch, ico) cpatch%basarea(ico) = pio4 * cpatch%dbh(ico) * cpatch%dbh(ico) cpatch%btimber(ico) = size2bt( cpatch%dbh (ico) & - , cpatch%hite (ico) & + , cpatch%height (ico) & , cpatch%bdeada (ico) & , cpatch%bsapwooda (ico) & , cpatch%bbarka (ico) & , cpatch%pft (ico) ) cpatch%thbark (ico) = size2xb( cpatch%dbh (ico) & - , cpatch%hite (ico) & + , cpatch%height (ico) & , cpatch%bbarka (ico) & , cpatch%bbarkb (ico) & , cpatch%sla (ico) & diff --git a/ED/src/io/ed_xml_config.f90 b/ED/src/io/ed_xml_config.f90 index 6cc735447..33a1d72ac 100644 --- a/ED/src/io/ed_xml_config.f90 +++ b/ED/src/io/ed_xml_config.f90 @@ -1449,10 +1449,10 @@ recursive subroutine read_ed_xml_config(filename) call getConfigREAL ('Time2Canopy','disturbance',i,rval,texist) if(texist) Time2Canopy = sngloff(rval,tiny_offset) - call getConfigREAL ('treefall_hite_threshold','disturbance',i,rval,texist) - if(texist) treefall_hite_threshold = sngloff(rval,tiny_offset) - call getConfigINT ('does_hite_limit_tfpatch' ,'disturbance',i,ival,texist) - if(texist) does_hite_limit_tfpatch = ival == 1 + call getConfigREAL ('treefall_height_threshold','disturbance',i,rval,texist) + if(texist) treefall_height_threshold = sngloff(rval,tiny_offset) + call getConfigINT ('does_height_limit_tfpatch' ,'disturbance',i,ival,texist) + if(texist) does_height_limit_tfpatch = ival == 1 !! FORESTRY call getConfigINT ('plantation_year','disturbance',i,ival,texist) @@ -2468,13 +2468,13 @@ subroutine write_ed_xml_config ! --- Treefall call putConfigREAL("treefall_disturbance_rate",treefall_disturbance_rate) call putConfigSCIENTIFIC("Time2Canopy",Time2Canopy) - call putConfigREAL("treefall_hite_threshold",treefall_hite_threshold) - if (does_hite_limit_tfpatch) then + call putConfigREAL("treefall_height_threshold",treefall_height_threshold) + if (does_height_limit_tfpatch) then ival = 1 else ival = 0 end if - call putConfigINT("does_hite_limit_tfpatch",ival) + call putConfigINT("does_height_limit_tfpatch",ival) ! --- Forestry call putConfigINT("forestry_on",forestry_on) call putConfigINT("agriculture_on",agriculture_on) diff --git a/ED/src/memory/disturb_coms.f90 b/ED/src/memory/disturb_coms.f90 index 2d19bfc06..bc1f738d9 100644 --- a/ED/src/memory/disturb_coms.f90 +++ b/ED/src/memory/disturb_coms.f90 @@ -183,9 +183,9 @@ module disturb_coms ! Patch dynamics variables, to be set in ed_params.f90. ! !---------------------------------------------------------------------------------------! !----- Only trees above this height create a gap when they fall. -----------------------! - real :: treefall_hite_threshold + real :: treefall_height_threshold !----- Flag to decide whether or not to limit disturbance to patches with tall trees. --! - logical :: does_hite_limit_tfpatch + logical :: does_height_limit_tfpatch !---------------------------------------------------------------------------------------! ! Minimum age above which we disregard the disturbance type (land use) and assume ! ! old growth, thus allowing patch fusion to occur. ! @@ -296,13 +296,13 @@ module disturb_coms ! 11 - Primary forest to secondary forest [ 1/yr] ! ! ====== Biomass to be harvested. ====== ! ! 12 - Wood harvest on mature secondary forest land. [ kgC] ! - ! 13 - Wood harvest on mature secondary forest land. [ kgC/m²] ! + ! 13 - Wood harvest on mature secondary forest land. [ kgC/m2] ! ! 14 - Wood harvest on primary forested land. [ kgC] ! - ! 15 - Wood harvest on primary forested land. [ kgC/m²] ! + ! 15 - Wood harvest on primary forested land. [ kgC/m2] ! ! 16 - Wood harvest on young secondary forest land. [ kgC] ! - ! 17 - Wood harvest on young secondary forest land. [ kgC/m²] ! + ! 17 - Wood harvest on young secondary forest land. [ kgC/m2] ! ! 18 - Wood harvest on primary non-forested land. [ kgC] ! - ! 19 - Wood harvest on primary non-forested land. [ kgC/m²] ! + ! 19 - Wood harvest on primary non-forested land. [ kgC/m2] ! ! ====== Special flags. ====== ! ! 12 - Secondary forest is harvested using the probability of harvesting when the ! ! DBH is above the minimum DBH. ! diff --git a/ED/src/memory/ed_state_vars.F90 b/ED/src/memory/ed_state_vars.F90 index 2ee0972c1..9f6a0307f 100644 --- a/ED/src/memory/ed_state_vars.F90 +++ b/ED/src/memory/ed_state_vars.F90 @@ -152,7 +152,7 @@ module ed_state_vars !!2 - Established (DBH > 10 cm for at least two censuses \n !------------------------------------------------------------------------------------! - real ,pointer,dimension(:) :: hite + real ,pointer,dimension(:) :: height ! Diameter at breast height [ cm] - real , intent(in) :: hite !> Height [ m] + real , intent(in) :: height !> Plant height [ m] real , intent(in) :: sla !> Specific leaf area [ m2/kgC] integer, intent(in) :: ipft !> Current PFT [ --] logical, intent(in), optional :: cap_crit !> Force cap at dbh_crit [ T|F] @@ -570,7 +570,7 @@ real function size2ca(dbh,hite,sla,ipft,cap_crit) else !----- make this function generic to size, not just dbh. -------------------------! - loclai = sla * size2bl(dbh,hite,sla,ipft) + loclai = sla * size2bl(dbh,height,sla,ipft) !---------------------------------------------------------------------------------! @@ -602,7 +602,7 @@ real function size2ca(dbh,hite,sla,ipft,cap_crit) !----- Find the nominal crown area. ----------------------------------------------! if (ddh_allom(ipft)) then - size = mdbh * mdbh * hite + size = mdbh * mdbh * height else size = mdbh end if @@ -804,7 +804,7 @@ end function size2xb ! This function find the potential rooting depth (i.e. based only on allometry, and ! ! ignoring soil depth.). ! !---------------------------------------------------------------------------------------! - real function size2prd(hite,dbh,ipft) + real function size2prd(height,dbh,ipft) use ed_misc_coms, only : iallom & ! intent(in) , use_efrd_trtree ! ! intent(in) use pft_coms , only : is_tropical & ! intent(in) @@ -821,7 +821,7 @@ real function size2prd(hite,dbh,ipft) implicit none !----- Arguments --------------------------------------------------------------------! - real , intent(in) :: hite + real , intent(in) :: height real , intent(in) :: dbh integer, intent(in) :: ipft !----- Local variables --------------------------------------------------------------! @@ -879,7 +879,7 @@ real function size2prd(hite,dbh,ipft) ! Original ED-2.1 (I don't know the source for this equation, though). ! ! Grasses get a fixed rooting depth of 70cm. ! !------------------------------------------------------------------------------! - size = dbh * dbh * hite + size = dbh * dbh * height !------------------------------------------------------------------------------! case (3) !------------------------------------------------------------------------------! @@ -900,16 +900,16 @@ real function size2prd(hite,dbh,ipft) !------------------------------------------------------------------------------! if ( is_tropical(ipft) .and. (.not. is_liana(ipft)) ) then dbhuse = min(dbh_crit(ipft),dbh) - size = dbhuse * dbhuse * hite + size = dbhuse * dbhuse * height else - size = hite + size = height end if !------------------------------------------------------------------------------! case default !------------------------------------------------------------------------------! ! Size is always height, regardless of the PFT. ! !------------------------------------------------------------------------------! - size = hite + size = height !------------------------------------------------------------------------------! end select !---------------------------------------------------------------------------------! @@ -936,13 +936,13 @@ end function size2prd !=======================================================================================! ! This function finds the actual rooting depth, which mlimited by soil depth. ! !---------------------------------------------------------------------------------------! - integer function size2krdepth(hite,dbh,ipft,lsl) + integer function size2krdepth(height,dbh,ipft,lsl) use grid_coms , only : nzg ! ! intent(in) use soil_coms , only : slz ! ! intent(in) implicit none !----- Arguments --------------------------------------------------------------------! - real , intent(in) :: hite + real , intent(in) :: height real , intent(in) :: dbh integer, intent(in) :: ipft integer, intent(in) :: lsl @@ -956,7 +956,7 @@ integer function size2krdepth(hite,dbh,ipft,lsl) !------------------------------------------------------------------------------------! ! Find the potential rooting depth, which is only based on allometric equations. ! !------------------------------------------------------------------------------------! - pot_root_depth = size2prd(hite,dbh,ipft) + pot_root_depth = size2prd(height,dbh,ipft) !------------------------------------------------------------------------------------! @@ -1074,7 +1074,7 @@ end function ed_balive ! size (dbh and height) and the PFT. This assumes that cohort is in perfect allometry. ! ! ! !---------------------------------------------------------------------------------------! - real function size2be(dbh,hite,ipft) + real function size2be(dbh,height,ipft) use pft_coms, only : q & ! intent(in) , qsw & ! intent(in) , SLA & ! intent(in) @@ -1083,7 +1083,7 @@ real function size2be(dbh,hite,ipft) !----- Arguments --------------------------------------------------------------------! real , intent(in) :: dbh - real , intent(in) :: hite + real , intent(in) :: height integer , intent(in) :: ipft !----- Local variables --------------------------------------------------------------! real :: bleaf @@ -1094,14 +1094,14 @@ real function size2be(dbh,hite,ipft) !------------------------------------------------------------------------------------! ! Find potential leaf and heartwood biomass. ! !------------------------------------------------------------------------------------! - bleaf = size2bl(dbh,hite,SLA(ipft),ipft) + bleaf = size2bl(dbh,height,SLA(ipft),ipft) !NOTE: here the canopy top SLA is used because size2be is only used in expand_bevery to create !a look up table for biomass allometry. When generating the lut, we do not know the light !environment and thus the trait plasticity in SLA. This can create biases in lut but the only !effect is to slightly reduce fraction allocated to bdead at monthly scale. The total effect !at annual scale should be very small. - bdead = size2bd(dbh,hite,ipft) - size2be = bleaf * (1. + q(ipft) + (qsw(ipft)+qbark(ipft)) * hite) + bdead + bdead = size2bd(dbh,height,ipft) + size2be = bleaf * (1. + q(ipft) + (qsw(ipft)+qbark(ipft)) * height) + bdead !------------------------------------------------------------------------------------! return @@ -1117,7 +1117,7 @@ end function size2be ! This function decomposes total biomass (except for storage) into biomass of each ! ! tissue, plus the dbh and height. ! !---------------------------------------------------------------------------------------! - subroutine expand_bevery(ipft,bevery,dbh,hite,bleaf,broot,bsapa,bsapb,bbarka,bbarkb & + subroutine expand_bevery(ipft,bevery,dbh,height,bleaf,broot,bsapa,bsapb,bbarka,bbarkb & ,balive,bdeada,bdeadb) use pft_coms , only : bevery_crit & ! intent(in) , balive_crit & ! intent(in) @@ -1142,7 +1142,7 @@ subroutine expand_bevery(ipft,bevery,dbh,hite,bleaf,broot,bsapa,bsapb,bbarka,bba integer, intent(in) :: ipft ! PFT type [ ---] real , intent(in) :: bevery ! Biomass (Everything but storage) [ kgC/plant] real , intent(out) :: dbh ! Diameter at breast height [ cm] - real , intent(out) :: hite ! Cohort height [ m] + real , intent(out) :: height ! Plant height [ m] real , intent(out) :: bleaf ! Leaf biomass [ kgC/plant] real , intent(out) :: broot ! Root biomass [ kgC/plant] real , intent(out) :: bsapa ! Above-ground sapwood biomass [ kgC/plant] @@ -1179,18 +1179,18 @@ subroutine expand_bevery(ipft,bevery,dbh,hite,bleaf,broot,bsapa,bsapb,bbarka,bba !----- Use the look-up table to find the best dbh. -------------------------------! finterp = bevery / bevery_lut(1,ipft) dbh = dbh_lut(1,ipft) * bevery / bevery_lut(1,ipft) - hite = dbh2h(ipft,dbh) + height = dbh2h(ipft,dbh) bdeadx = bdead_lut(1,ipft) * bevery / bevery_lut(1,ipft) bdeada = agf_bs(ipft) * bdeadx bdeadb = (1. - agf_bs(ipft)) * bdeadx balive = balive_lut(1,ipft) * bevery / bevery_lut(1,ipft) - salloci = 1. / (1. + q(ipft) + (qsw(ipft)+qbark(ipft)) * hite ) - bleaf = salloci * balive - broot = q (ipft) * salloci * balive - bsapa = agf_bs(ipft) * qsw (ipft) * hite * salloci * balive - bsapb = (1. - agf_bs(ipft)) * qsw (ipft) * hite * salloci * balive - bbarka = agf_bs(ipft) * qbark(ipft) * hite * salloci * balive - bbarkb = (1. - agf_bs(ipft)) * qbark(ipft) * hite * salloci * balive + salloci = 1. / (1. + q(ipft) + (qsw(ipft)+qbark(ipft)) * height ) + bleaf = salloci * balive + broot = q (ipft) * salloci * balive + bsapa = agf_bs(ipft) * qsw (ipft) * height * salloci * balive + bsapb = (1. - agf_bs(ipft)) * qsw (ipft) * height * salloci * balive + bbarka = agf_bs(ipft) * qbark(ipft) * height * salloci * balive + bbarkb = (1. - agf_bs(ipft)) * qbark(ipft) * height * salloci * balive !---------------------------------------------------------------------------------! else if (bevery >= bevery_crit(ipft)) then !---------------------------------------------------------------------------------! @@ -1201,14 +1201,14 @@ subroutine expand_bevery(ipft,bevery,dbh,hite,bleaf,broot,bsapa,bsapb,bbarka,bba bdeada = agf_bs(ipft) * bdeadx bdeadb = (1. - agf_bs(ipft)) * bdeadx dbh = bd2dbh(ipft,bdeada,bdeadb) - hite = hgt_max(ipft) - salloci = 1. / (1. + q(ipft) + (qsw(ipft)+qbark(ipft)) * hite ) - bleaf = salloci * balive - broot = q (ipft) * salloci * balive - bsapa = agf_bs(ipft) * qsw (ipft) * hite * salloci * balive - bsapb = (1. - agf_bs(ipft)) * qsw (ipft) * hite * salloci * balive - bbarka = agf_bs(ipft) * qbark(ipft) * hite * salloci * balive - bbarkb = (1. - agf_bs(ipft)) * qbark(ipft) * hite * salloci * balive + height = hgt_max(ipft) + salloci = 1. / (1. + q(ipft) + (qsw(ipft)+qbark(ipft)) * height ) + bleaf = salloci * balive + broot = q (ipft) * salloci * balive + bsapa = agf_bs(ipft) * qsw (ipft) * height * salloci * balive + bsapb = (1. - agf_bs(ipft)) * qsw (ipft) * height * salloci * balive + bbarka = agf_bs(ipft) * qbark(ipft) * height * salloci * balive + bbarkb = (1. - agf_bs(ipft)) * qbark(ipft) * height * salloci * balive !---------------------------------------------------------------------------------! else !----- Use the look-up table to find the best dbh. -------------------------------! @@ -1224,7 +1224,7 @@ subroutine expand_bevery(ipft,bevery,dbh,hite,bleaf,broot,bsapa,bsapb,bbarka,bba !---------------------------------------------------------------------------------! if (ilwr == iupr) then dbh = dbh_lut(ilwr,ipft) - hite = dbh2h(ipft,dbh) + height = dbh2h(ipft,dbh) else !------ Define the first guess for Regula Falsi (Illinois) method. ------------! dbha = dbh_lut(ilwr,ipft) @@ -1269,8 +1269,8 @@ subroutine expand_bevery(ipft,bevery,dbh,hite,bleaf,broot,bsapa,bsapb,bbarka,bba ! Loop until convergence. ! !------------------------------------------------------------------------------! rfaloop: do it=1,maxfpo - dbh = (funz * dbha - funa * dbhz) / ( funz - funa) - hite = dbh2h(ipft,dbh) + dbh = (funz * dbha - funa * dbhz) / ( funz - funa) + height = dbh2h(ipft,dbh) !---------------------------------------------------------------------------! ! Now that we updated the guess, check whether they are really close. ! @@ -1282,7 +1282,7 @@ subroutine expand_bevery(ipft,bevery,dbh,hite,bleaf,broot,bsapa,bsapb,bbarka,bba !------ Find the new function evaluation. ----------------------------------! - fun = size2be(dbh,hite,ipft) - bevery + fun = size2be(dbh,height,ipft) - bevery !---------------------------------------------------------------------------! @@ -1329,7 +1329,7 @@ subroutine expand_bevery(ipft,bevery,dbh,hite,bleaf,broot,bsapa,bsapb,bbarka,bba write (unit=*,fmt='(a,1x,es14.7)') ' + dbh =',dbh write (unit=*,fmt='(a,1x,es14.7)') ' + dbhz =',dbhz write (unit=*,fmt='(a,1x,es14.7)') ' + hgta =',hgta - write (unit=*,fmt='(a,1x,es14.7)') ' + hite =',hite + write (unit=*,fmt='(a,1x,es14.7)') ' + height =',height write (unit=*,fmt='(a,1x,es14.7)') ' + hgtz =',hgtz write (unit=*,fmt='(a,1x,es14.7)') ' + beverya =',size2be(dbha,hgta,ipft) write (unit=*,fmt='(a,1x,es14.7)') ' + beveryz =',size2be(dbhz,hgtz,ipft) @@ -1348,17 +1348,17 @@ subroutine expand_bevery(ipft,bevery,dbh,hite,bleaf,broot,bsapa,bsapb,bbarka,bba !------ Solution for dbh was determined, derive tissue biomass. ------------------! - bdeadx = size2bd(dbh,hite,ipft) + bdeadx = size2bd(dbh,height,ipft) bdeada = agf_bs(ipft) * bdeadx bdeadb = (1. - agf_bs(ipft)) * bdeadx balive = bevery - bdeadx - salloci = 1. / (1. + q(ipft) + (qsw(ipft)+qbark(ipft)) * hite ) - bleaf = salloci * balive - broot = q (ipft) * salloci * balive - bsapa = agf_bs(ipft) * qsw (ipft) * hite * salloci * balive - bsapb = (1. - agf_bs(ipft)) * qsw (ipft) * hite * salloci * balive - bbarka = agf_bs(ipft) * qbark(ipft) * hite * salloci * balive - bbarkb = (1. - agf_bs(ipft)) * qbark(ipft) * hite * salloci * balive + salloci = 1. / (1. + q(ipft) + (qsw(ipft)+qbark(ipft)) * height ) + bleaf = salloci * balive + broot = q (ipft) * salloci * balive + bsapa = agf_bs(ipft) * qsw (ipft) * height * salloci * balive + bsapb = (1. - agf_bs(ipft)) * qsw (ipft) * height * salloci * balive + bbarka = agf_bs(ipft) * qbark(ipft) * height * salloci * balive + bbarkb = (1. - agf_bs(ipft)) * qbark(ipft) * height * salloci * balive !---------------------------------------------------------------------------------! end if !------------------------------------------------------------------------------------! @@ -1426,7 +1426,7 @@ subroutine area_indices(cpatch, ico) !------------------------------------------------------------------------------------! !----- Find the crown area. ---------------------------------------------------------! - loccai = size2ca(cpatch%dbh(ico),cpatch%hite(ico),cpatch%sla(ico),ipft) + loccai = size2ca(cpatch%dbh(ico),cpatch%height(ico),cpatch%sla(ico),ipft) cpatch%crown_area(ico) = min(1.0, cpatch%nplant(ico) * loccai) !------------------------------------------------------------------------------------! @@ -1447,7 +1447,7 @@ subroutine area_indices(cpatch, ico) !---------------------------------------------------------------------------------! if (is_grass(ipft) .and. igrass == 1) then !---- Use height for new grasses. ---------------------------------------------! - mdbh = min(cpatch%dbh(ico),h2dbh(cpatch%hite(ico),ipft)) + mdbh = min(cpatch%dbh(ico),h2dbh(cpatch%height(ico),ipft)) elseif (is_liana(ipft)) then mdbh = min(cpatch%dbh(ico),liana_dbh_crit) else @@ -1459,7 +1459,7 @@ subroutine area_indices(cpatch, ico) !-----Find WAI. ------------------------------------------------------------------! if (ddh_allom(ipft)) then - size = mdbh * mdbh * cpatch%hite(ico) + size = mdbh * mdbh * cpatch%height(ico) else size = mdbh end if diff --git a/ED/src/utils/ed_therm_lib.f90 b/ED/src/utils/ed_therm_lib.f90 index b3b9793bc..b822b6d13 100644 --- a/ED/src/utils/ed_therm_lib.f90 +++ b/ED/src/utils/ed_therm_lib.f90 @@ -225,14 +225,14 @@ subroutine update_veg_energy_cweh(csite,ipa,ico,old_leaf_hcap,old_wood_hcap cpatch%leaf_water_int(ico) = 0. cpatch%leaf_water_im2(ico) = 0. new_leaf_energy_wat = 0. - if (cpatch%hite(ico) > csite%total_sfcw_depth(ipa)) then + if (cpatch%height(ico) > csite%total_sfcw_depth(ipa)) then !----- Plant is exposed, set temperature to the canopy temperature. -----------! cpatch%leaf_temp(ico) = csite%can_temp(ipa) else !----- Find the snow layer that is the closest to where the leaves would be. --! kclosest = 1 do k = csite%nlev_sfcwater(ipa), 1, -1 - if (sum(csite%sfcwater_depth(1:k,ipa)) >= cpatch%hite(ico)) then + if (sum(csite%sfcwater_depth(1:k,ipa)) >= cpatch%height(ico)) then kclosest = k end if end do @@ -305,7 +305,7 @@ subroutine update_veg_energy_cweh(csite,ipa,ico,old_leaf_hcap,old_wood_hcap write(unit=*,fmt='(a)') ' ' write(unit=*,fmt=ifmt ) ' Cohort: ',ico write(unit=*,fmt=ifmt ) ' PFT: ',cpatch%pft (ico) - write(unit=*,fmt=efmt ) ' Height: ',cpatch%hite (ico) + write(unit=*,fmt=efmt ) ' Height: ',cpatch%height (ico) write(unit=*,fmt=efmt ) ' DBH: ',cpatch%dbh (ico) write(unit=*,fmt=efmt ) ' NPlant: ',cpatch%nplant (ico) write(unit=*,fmt=efmt ) ' LAI: ',cpatch%lai (ico) @@ -350,14 +350,14 @@ subroutine update_veg_energy_cweh(csite,ipa,ico,old_leaf_hcap,old_wood_hcap cpatch%wood_water (ico) = 0. cpatch%wood_water_int(ico) = 0. new_wood_energy_wat = 0. - if (cpatch%hite(ico) > csite%total_sfcw_depth(ipa)) then + if (cpatch%height(ico) > csite%total_sfcw_depth(ipa)) then !----- Plant is exposed, set temperature to the canopy temperature. -----------! cpatch%wood_temp(ico) = csite%can_temp(ipa) else !----- Find the snow layer that is the closest to where the leaves would be. --! kclosest = 1 do k = csite%nlev_sfcwater(ipa), 1, -1 - if (sum(csite%sfcwater_depth(1:k,ipa)) >= cpatch%hite(ico)) then + if (sum(csite%sfcwater_depth(1:k,ipa)) >= cpatch%height(ico)) then kclosest = k end if end do @@ -433,7 +433,7 @@ subroutine update_veg_energy_cweh(csite,ipa,ico,old_leaf_hcap,old_wood_hcap write(unit=*,fmt='(a)') ' ' write(unit=*,fmt=ifmt ) ' Cohort: ',ico write(unit=*,fmt=ifmt ) ' PFT: ',cpatch%pft (ico) - write(unit=*,fmt=efmt ) ' Height: ',cpatch%hite (ico) + write(unit=*,fmt=efmt ) ' Height: ',cpatch%height (ico) write(unit=*,fmt=efmt ) ' DBH: ',cpatch%dbh (ico) write(unit=*,fmt=efmt ) ' NPlant: ',cpatch%nplant (ico) write(unit=*,fmt=efmt ) ' LAI: ',cpatch%lai (ico) diff --git a/ED/src/utils/fuse_fiss_utils.f90 b/ED/src/utils/fuse_fiss_utils.f90 index caff9a989..81f92cb65 100644 --- a/ED/src/utils/fuse_fiss_utils.f90 +++ b/ED/src/utils/fuse_fiss_utils.f90 @@ -54,7 +54,7 @@ subroutine sort_cohorts(cpatch) !------------------------------------------------------------------------------------! sorted = .true. sortcheck: do ico=1,cpatch%ncohorts-1 - sorted = cpatch%hite(ico) >= cpatch%dbh(ico+1) .and. & + sorted = cpatch%height(ico) >= cpatch%dbh(ico+1) .and. & cpatch%dbh(ico) >= cpatch%dbh(ico+1) if (.not. sorted) exit sortcheck end do sortcheck @@ -79,10 +79,10 @@ subroutine sort_cohorts(cpatch) ico = ico + 1 !----- Find the maximum height. --------------------------------------------------! - tophgt = maxval(cpatch%hite) + tophgt = maxval(cpatch%height) !----- Find all cohorts that are at this height. ---------------------------------! - attop = cpatch%hite == tophgt + attop = cpatch%height == tophgt !----- Find the fattest cohort at a given height. --------------------------------! tallco = maxloc(cpatch%dbh,dim=1,mask=attop) @@ -91,8 +91,8 @@ subroutine sort_cohorts(cpatch) call copy_patchtype(cpatch,temppatch,tallco,tallco,ico,ico) !----- Put a non-sense DBH so this will never "win" again. -----------------------! - cpatch%hite(tallco) = -huge(1.) - cpatch%dbh (tallco) = -huge(1.) + cpatch%height(tallco) = -huge(1.) + cpatch%dbh (tallco) = -huge(1.) end do @@ -569,7 +569,8 @@ subroutine terminate_patches(csite,lai_criterion) pat_lai_max = 0.0 do ico=1,cpatch%ncohorts ipft = cpatch%pft(ico) - bleaf_max = size2bl(cpatch%dbh(ico),cpatch%hite(ico),cpatch%sla(ico),ipft) + bleaf_max = size2bl(cpatch%dbh(ico),cpatch%height(ico),cpatch%sla(ico) & + ,ipft) pat_lai_max = pat_lai_max + cpatch%nplant(ico) * SLA(ipft) * bleaf_max end do !------------------------------------------------------------------------------! @@ -772,7 +773,7 @@ subroutine rescale_patches(csite) do ico = 1,cpatch%ncohorts ipft = cpatch%pft(ico) laimax = cpatch%nplant(ico) * cpatch%sla(ico) & - * size2bl(cpatch%dbh(ico),cpatch%hite(ico) & + * size2bl(cpatch%dbh(ico),cpatch%height(ico) & ,cpatch%sla(ico),ipft) patch_laimax(ipa) = patch_laimax(ipa) + laimax * csite%area(ipa) end do @@ -1065,11 +1066,11 @@ subroutine new_fuse_cohorts(csite,ipa, lsl, fuse_initial) else !----- Trees or old grasses. Use on-allometry LAI. ----------------------! donc_lai_max = cpatch%nplant(donc) & - * size2bl(cpatch%dbh(donc),cpatch%hite(donc) & + * size2bl(cpatch%dbh(donc),cpatch%height(donc) & ,cpatch%sla(donc),dpft) & * cpatch%sla(donc) recc_lai_max = cpatch%nplant(recc) & - * size2bl(cpatch%dbh(recc),cpatch%hite(recc) & + * size2bl(cpatch%dbh(recc),cpatch%height(recc) & ,cpatch%sla(recc),rpft) & * cpatch%sla(recc) !------------------------------------------------------------------------! @@ -1099,8 +1100,8 @@ subroutine new_fuse_cohorts(csite,ipa, lsl, fuse_initial) !---------------------------------------------------------------------------! ! Test for similarity. ! !---------------------------------------------------------------------------! - diff_dbh = abs ( cpatch%dbh (donc) - cpatch%dbh (recc) ) - diff_hgt = abs ( cpatch%hite(donc) - cpatch%hite(recc) ) + diff_dbh = abs ( cpatch%dbh (donc) - cpatch%dbh (recc) ) + diff_hgt = abs ( cpatch%height(donc) - cpatch%height(recc) ) dr_may_fuse = ( diff_dbh < (dbh_crit(dpft) * coh_size_tol) ) .and. & ( diff_hgt < (hgt_max (dpft) * coh_size_tol) ) !---------------------------------------------------------------------------! @@ -1121,12 +1122,12 @@ subroutine new_fuse_cohorts(csite,ipa, lsl, fuse_initial) ! inside the donor loop because the receptor may change when we fuse ! ! cohorts. ! !------------------------------------------------------------------------! - recc_bleaf_max = size2bl(cpatch%dbh(recc),cpatch%hite(recc) & + recc_bleaf_max = size2bl(cpatch%dbh(recc),cpatch%height(recc) & ,cpatch%sla(recc),rpft) recc_bsapa_max = agf_bs(rpft) & - * recc_bleaf_max * qsw (rpft) * cpatch%hite(recc) + * recc_bleaf_max * qsw (rpft) * cpatch%height(recc) recc_bbarka_max = agf_bs(rpft) & - * recc_bleaf_max * qbark(rpft) * cpatch%hite(recc) + * recc_bleaf_max * qbark(rpft) * cpatch%height(recc) call calc_veg_hcap(recc_bleaf_max,cpatch%bdeada(recc),recc_bsapa_max & ,recc_bbarka_max,cpatch%nplant(recc),rpft & ,recc_lhcap_max,recc_whcap_max) @@ -1137,12 +1138,12 @@ subroutine new_fuse_cohorts(csite,ipa, lsl, fuse_initial) !------------------------------------------------------------------------! ! Find potential heat capacity -- Donor cohort. ! !------------------------------------------------------------------------! - donc_bleaf_max = size2bl(cpatch%dbh(donc),cpatch%hite(donc) & + donc_bleaf_max = size2bl(cpatch%dbh(donc),cpatch%height(donc) & ,cpatch%sla(donc),dpft) donc_bsapa_max = agf_bs(dpft) & - * donc_bleaf_max * qsw (dpft) * cpatch%hite(donc) + * donc_bleaf_max * qsw (dpft) * cpatch%height(donc) donc_bbarka_max = agf_bs(dpft) & - * donc_bleaf_max * qbark(dpft) * cpatch%hite(donc) + * donc_bleaf_max * qbark(dpft) * cpatch%height(donc) call calc_veg_hcap(donc_bleaf_max,cpatch%bdeada(donc),donc_bsapa_max & ,donc_bbarka_max,cpatch%nplant(donc),dpft & ,donc_lhcap_max,donc_whcap_max) @@ -1153,8 +1154,8 @@ subroutine new_fuse_cohorts(csite,ipa, lsl, fuse_initial) ! In case heat capacity is less than minimum, ignore the size ! ! similarity and fuse the cohort. ! !------------------------------------------------------------------------! - diff_dbh = abs ( cpatch%dbh (donc) - cpatch%dbh (recc) ) - diff_hgt = abs ( cpatch%hite(donc) - cpatch%hite(recc) ) + diff_dbh = abs ( cpatch%dbh (donc) - cpatch%dbh (recc) ) + diff_hgt = abs ( cpatch%height(donc) - cpatch%height(recc) ) dr_may_fuse = ( ( recc_lhcap_max < veg_hcap_min(rpft) ) .or. & ( donc_lhcap_max < veg_hcap_min(dpft) ) ) .and. & ( diff_dbh < (dbh_crit(dpft) * coh_size_tol_max) ) .and. & @@ -1378,7 +1379,7 @@ subroutine old_fuse_cohorts(csite,ipa, lsl, fuse_initial) real :: tolerance_mult ! Multiplication factor integer :: ncohorts_old ! # of coh. before fusion test real :: mean_dbh ! Mean DBH (???) - real :: mean_hite ! Mean height (???) + real :: mean_height ! Mean height (???) real :: new_size ! New size integer :: ntall ! # of tall cohorts (???) integer :: nshort ! # of short cohorts (???) @@ -1398,31 +1399,31 @@ subroutine old_fuse_cohorts(csite,ipa, lsl, fuse_initial) if (maxcohort == 0 .or. cpatch%ncohorts < 2) return !------------------------------------------------------------------------------------! - ! Calculate mean DBH and HITE to help with the normalization of differences mean ! - ! hite is not being used right now, but can be optioned in the future if it seems ! + ! Calculate mean DBH and HEIGHT to help normalise the differences. As of now, ! + ! height is not being used, but it might be used in the future if proved ! ! advantageous. ! !------------------------------------------------------------------------------------! - mean_dbh = 0.0 - mean_hite = 0.0 - nshort = 0 - ntall = 0 + mean_dbh = 0.0 + mean_height = 0.0 + nshort = 0 + ntall = 0 do ico3 = 1,cpatch%ncohorts !---------------------------------------------------------------------------------! ! Get fusion height threshold. Height is a good predictor when plants are ! ! growing in height, but it approaches the maximum height DBH becomes the only ! ! possible predictor because height saturates. ! !---------------------------------------------------------------------------------! - if (cpatch%hite(ico3) < (0.95 * hgt_max(cpatch%pft(ico3))) ) then - mean_hite = mean_hite + cpatch%hite(ico3) - nshort = nshort + 1 + if (cpatch%height(ico3) < (0.95 * hgt_max(cpatch%pft(ico3))) ) then + mean_height = mean_height + cpatch%height(ico3) + nshort = nshort + 1 else mean_dbh = mean_dbh + cpatch%dbh(ico3) ntall = ntall + 1 end if end do !------------------------------------------------------------------------------------! - if (ntall > 0) mean_dbh = mean_dbh / real(ntall) - if (nshort > 0) mean_hite= mean_hite / real(nshort) + if (ntall > 0) mean_dbh = mean_dbh / real(ntall) + if (nshort > 0) mean_height = mean_height / real(nshort) !----- Initialize table. In principle, all cohorts stay. ----------------------------! allocate(fuse_table(cpatch%ncohorts)) @@ -1449,16 +1450,16 @@ subroutine old_fuse_cohorts(csite,ipa, lsl, fuse_initial) ! when the cohort is not approaching the maximum height. If this is the ! ! case, then we use DBH to test. ! !---------------------------------------------------------------------------! - if (cpatch%hite(donc) >= (0.95 * hgt_max(cpatch%pft(donc))) ) then + if (cpatch%height(donc) >= (0.95 * hgt_max(cpatch%pft(donc))) ) then mean_dbh=0.5*(cpatch%dbh(donc)+cpatch%dbh(recc)) fusion_test = ( abs(cpatch%dbh(donc) - cpatch%dbh(recc)))/mean_dbh & < fusetol * tolerance_mult elseif (fuse_relax) then - fusion_test = ( abs(cpatch%hite(donc) - cpatch%hite(recc)) & - / (0.5*(cpatch%hite(donc) + cpatch%hite(recc))) < & + fusion_test = ( abs(cpatch%height(donc) - cpatch%height(recc)) & + / (0.5*(cpatch%height(donc) + cpatch%height(recc))) < & fusetol * tolerance_mult) else - fusion_test = (abs(cpatch%hite(donc) - cpatch%hite(recc)) < & + fusion_test = (abs(cpatch%height(donc) - cpatch%height(recc)) < & fusetol_h * tolerance_mult) end if @@ -1481,10 +1482,10 @@ subroutine old_fuse_cohorts(csite,ipa, lsl, fuse_initial) else !--use dbh for trees lai_max = ( cpatch%nplant(recc) & - * size2bl(cpatch%dbh(recc),cpatch%hite(recc) & + * size2bl(cpatch%dbh(recc),cpatch%height(recc) & ,cpatch%sla(recc),cpatch%pft(recc)) & + cpatch%nplant(donc) & - * size2bl(cpatch%dbh(donc),cpatch%hite(donc) & + * size2bl(cpatch%dbh(donc),cpatch%height(donc) & ,cpatch%sla(donc),cpatch%pft(donc))) & * cpatch%sla(recc) end if @@ -1584,16 +1585,16 @@ subroutine old_fuse_cohorts(csite,ipa, lsl, fuse_initial) !---------------------------------------------------------------------! ! Recalculate the means ! !---------------------------------------------------------------------! - mean_dbh = 0.0 - mean_hite = 0.0 - nshort = 0 - ntall = 0 + mean_dbh = 0.0 + mean_height = 0.0 + nshort = 0 + ntall = 0 recalcloop: do ico3 = 1,cpatch%ncohorts if (.not. fuse_table(ico3)) cycle recalcloop !----- Get fusion height threshold --------------------------------! - if (cpatch%hite(ico3) < (0.95 * hgt_max(cpatch%pft(ico3))) ) then - mean_hite = mean_hite + cpatch%hite(ico3) - nshort = nshort+1 + if (cpatch%height(ico3) < (0.95 * hgt_max(cpatch%pft(ico3))) ) then + mean_height = mean_height + cpatch%height(ico3) + nshort = nshort+1 else mean_dbh = mean_dbh + cpatch%dbh(ico3) ntall=ntall+1 @@ -1749,7 +1750,7 @@ subroutine split_cohorts(csite,ipa,green_leaf_factor,is_initial) ! (green_leaf_factor and SLA). ! !------------------------------------------------------------------------------! bleaf_mp = green_leaf_factor(ipft) & - * size2bl(cpatch%dbh(ico),cpatch%hite(ico),cpatch%sla(ico),ipft) + * size2bl(cpatch%dbh(ico),cpatch%height(ico),cpatch%sla(ico),ipft) tai_mp = cpatch%nplant(ico) * bleaf_mp * cpatch%sla(ico) + cpatch%wai(ico) !------------------------------------------------------------------------------! @@ -1836,13 +1837,13 @@ subroutine split_cohorts(csite,ipa,green_leaf_factor,is_initial) cpatch%bleaf(ico) = cpatch%bleaf(ico) * (1.-epsilon) cpatch%dbh (ico) = bl2dbh(cpatch%bleaf(ico), cpatch%sla(ico) & ,cpatch%pft(ico)) - cpatch%hite (ico) = bl2h(cpatch%bleaf(ico), cpatch%sla(ico) & + cpatch%height(ico) = bl2h(cpatch%bleaf(ico), cpatch%sla(ico) & ,cpatch%pft(ico)) cpatch%bleaf(inew) = cpatch%bleaf(inew) * (1.+epsilon) cpatch%dbh (inew) = bl2dbh(cpatch%bleaf(inew), cpatch%sla(inew) & ,cpatch%pft(inew)) - cpatch%hite (inew) = bl2h (cpatch%bleaf(inew), cpatch%sla(inew) & + cpatch%height(inew) = bl2h (cpatch%bleaf(inew), cpatch%sla(inew) & ,cpatch%pft(inew)) !---------------------------------------------------------------------! else @@ -1851,13 +1852,13 @@ subroutine split_cohorts(csite,ipa,green_leaf_factor,is_initial) cpatch%bdeadb(ico) = cpatch%bdeadb(ico) * (1.-epsilon) cpatch%dbh (ico) = bd2dbh(cpatch%pft(ico),cpatch%bdeada(ico) & ,cpatch%bdeadb(ico)) - cpatch%hite (ico) = dbh2h(cpatch%pft(ico), cpatch%dbh(ico)) + cpatch%height(ico) = dbh2h(cpatch%pft(ico), cpatch%dbh(ico)) cpatch%bdeada(inew) = cpatch%bdeada(inew) * (1.+epsilon) cpatch%bdeadb(inew) = cpatch%bdeadb(inew) * (1.+epsilon) cpatch%dbh (inew) = bd2dbh(cpatch%pft(inew),cpatch%bdeada(inew) & ,cpatch%bdeadb(inew)) - cpatch%hite (inew) = dbh2h(cpatch%pft(inew), cpatch%dbh(inew)) + cpatch%height(inew) = dbh2h(cpatch%pft(inew), cpatch%dbh(inew)) !---------------------------------------------------------------------! end if !------------------------------------------------------------------------! @@ -2178,14 +2179,16 @@ subroutine fuse_2_cohorts(cpatch,donc,recc,can_prss,can_shv,lsl,fuse_initial) !------------------------------------------------------------------------------------! if (is_grass(cpatch%pft(recc)) .and. igrass == 1) then !----- New grass scheme, use bleaf then find DBH and height. --------------------! - cpatch%dbh (recc) = bl2dbh(cpatch%bleaf(recc),cpatch%sla(recc),cpatch%pft(recc)) - cpatch%hite (recc) = bl2h (cpatch%bleaf(recc),cpatch%sla(recc),cpatch%pft(recc)) + cpatch%dbh (recc) = bl2dbh(cpatch%bleaf(recc),cpatch%sla(recc) & + ,cpatch%pft(recc)) + cpatch%height(recc) = bl2h (cpatch%bleaf(recc),cpatch%sla(recc) & + ,cpatch%pft(recc)) !--------------------------------------------------------------------------------! else !----- Trees, or old grass scheme. Use bdead then find DBH and height. ---------! - cpatch%dbh (recc) = bd2dbh(cpatch%pft(recc),cpatch%bdeada(recc) & - ,cpatch%bdeadb(recc)) - cpatch%hite (recc) = dbh2h(cpatch%pft(recc),cpatch%dbh(recc)) + cpatch%dbh (recc) = bd2dbh(cpatch%pft(recc),cpatch%bdeada(recc) & + ,cpatch%bdeadb(recc)) + cpatch%height(recc) = dbh2h(cpatch%pft(recc),cpatch%dbh(recc)) !--------------------------------------------------------------------------------! end if !------------------------------------------------------------------------------------! @@ -2193,7 +2196,7 @@ subroutine fuse_2_cohorts(cpatch,donc,recc,can_prss,can_shv,lsl,fuse_initial) !----- Rooting depth. ---------------------------------------------------------------! - cpatch%krdepth(recc) = size2krdepth(cpatch%hite(recc),cpatch%dbh(recc) & + cpatch%krdepth(recc) = size2krdepth(cpatch%height(recc),cpatch%dbh(recc) & ,cpatch%pft(recc),lsl) !------------------------------------------------------------------------------------! @@ -2226,8 +2229,9 @@ subroutine fuse_2_cohorts(cpatch,donc,recc,can_prss,can_shv,lsl,fuse_initial) !------------------------------------------------------------------------------------! ! Bark thickness is calculated based on the fused size and biomass. ! !------------------------------------------------------------------------------------! - cpatch%thbark(recc) = size2xb(cpatch%dbh(recc),cpatch%hite(recc),cpatch%bbarka(recc) & - ,cpatch%bbarkb(recc),cpatch%sla(recc),cpatch%pft(recc)) + cpatch%thbark(recc) = size2xb(cpatch%dbh(recc),cpatch%height(recc) & + ,cpatch%bbarka(recc),cpatch%bbarkb(recc) & + ,cpatch%sla(recc),cpatch%pft(recc)) !------------------------------------------------------------------------------------! diff --git a/ED/src/utils/hrzshade_utils.f90 b/ED/src/utils/hrzshade_utils.f90 index 68e4f2446..7a99079ef 100644 --- a/ED/src/utils/hrzshade_utils.f90 +++ b/ED/src/utils/hrzshade_utils.f90 @@ -519,19 +519,19 @@ subroutine split_hrzshade(csite,isi) select case (ihrzrad) case (2,4) sz_fact = cpatch%dbh(ico) / min(cpatch%dbh(ico),dbh_crit(ipft)) - hgt_eff = min(cci_hmax, cpatch%hite(ico) * sz_fact * sz_fact) + hgt_eff = min(cci_hmax, cpatch%height(ico) * sz_fact * sz_fact) case default - hgt_eff = cpatch%hite(ico) + hgt_eff = cpatch%height(ico) end select !------------------------------------------------------------------------------! !----- Find horizontal and vertical radii. ------------------------------------! - ca_ind = size2ca(cpatch%dbh(ico),cpatch%hite(ico),cpatch%sla(ico) & + ca_ind = size2ca(cpatch%dbh(ico),cpatch%height(ico),cpatch%sla(ico) & ,cpatch%pft(ico),cap_crit=.false.) rh_ind = sqrt(ca_ind * pii) - ch_fact = h2crownbh(cpatch%hite(ico),cpatch%pft(ico))/cpatch%hite(ico) + ch_fact = h2crownbh(cpatch%height(ico),cpatch%pft(ico))/cpatch%height(ico) rv_ind = 0.5 * hgt_eff * (1.0 - ch_fact) !------------------------------------------------------------------------------! @@ -798,9 +798,9 @@ subroutine split_hrzshade(csite,isi) select case (ihrzrad) case (2,4) sz_fact = max(dbh_crit(ipft),cpatch%dbh(ico))/dbh_crit(ipft) - hgt_eff = min(cci_hmax, cpatch%hite(ico) * sz_fact * sz_fact) + hgt_eff = min(cci_hmax, cpatch%height(ico) * sz_fact * sz_fact) case default - hgt_eff = cpatch%hite(ico) + hgt_eff = cpatch%height(ico) end select !---------------------------------------------------------------------------! diff --git a/ED/src/utils/stable_cohorts.f90 b/ED/src/utils/stable_cohorts.f90 index 4f490ffce..d214b2bf9 100644 --- a/ED/src/utils/stable_cohorts.f90 +++ b/ED/src/utils/stable_cohorts.f90 @@ -198,7 +198,7 @@ subroutine is_resolvable(csite,ipa,ico,is_initial,force_resolvable,called_from) ! 1. Check for cohort height relative to snow/water depth. If the cohort is buried ! ! in snow or has drowned in the standing water, we can't solve it. ! !------------------------------------------------------------------------------------! - exposed = cpatch%hite(ico) > csite%total_sfcw_depth(ipa) + exposed = cpatch%height(ico) > csite%total_sfcw_depth(ipa) !------------------------------------------------------------------------------------! @@ -428,18 +428,18 @@ subroutine is_resolvable(csite,ipa,ico,is_initial,force_resolvable,called_from) ! welcome to modify this term in case leaf_psi shows strong oscillations from ! ! each timestep to another. ! !------------------------------------------------------------------------------! - bleafhydro = size2bl(cpatch%dbh(ico),cpatch%hite(ico),cpatch%sla(ico),ipft) + bleafhydro = size2bl(cpatch%dbh(ico),cpatch%height(ico),cpatch%sla(ico),ipft) broothydro = q(ipft) * bleafhydro sap_frac = dbh2sf(cpatch%dbh(ico),ipft) - bsapwhydro = qsw(ipft) * cpatch%hite(ico) * bleafhydro - bdeadhydro = size2bd(cpatch%dbh(ico),cpatch%hite(ico),ipft) + bsapwhydro = qsw(ipft) * cpatch%height(ico) * bleafhydro + bdeadhydro = size2bd(cpatch%dbh(ico),cpatch%height(ico),ipft) bsapwhydro = ( bsapwhydro + bdeadhydro ) * sap_frac !----- Find leaf and stem capacities. -----------------------------------------! c_leaf = leaf_water_cap(ipft) * C2B * bleafhydro c_stem = wood_water_cap(ipft) * C2B * (broothydro + bsapwhydro) cpatch%is_small(ico) = is_grass(ipft) .or. & c_leaf > (0.5 * c_stem) .or. & - cpatch%hite(ico) == hgt_min(ipft) + cpatch%height(ico) == hgt_min(ipft) cpatch%is_small(ico) = .false. !------------------------------------------------------------------------------! end select @@ -469,7 +469,7 @@ subroutine is_resolvable(csite,ipa,ico,is_initial,force_resolvable,called_from) write(unit=53,fmt=fmti ) ' PHEN_STATUS = ', cpatch%phenology_status(ico) write(unit=53,fmt='(a)') ' ' write(unit=53,fmt=fmtf ) ' DBH = ', cpatch%dbh (ico) - write(unit=53,fmt=fmtf ) ' HITE = ', cpatch%hite (ico) + write(unit=53,fmt=fmtf ) ' HEIGHT = ', cpatch%height(ico) write(unit=53,fmt=fmtf ) ' NPLANT_HA = ', cpatch%nplant(ico) * 10000. write(unit=53,fmt=fmtf ) ' LAI = ', cpatch%lai (ico) write(unit=53,fmt=fmtf ) ' WAI = ', cpatch%wai (ico) diff --git a/ED/src/utils/update_derived_utils.f90 b/ED/src/utils/update_derived_utils.f90 index d465fdc88..0ad9d7e5c 100644 --- a/ED/src/utils/update_derived_utils.f90 +++ b/ED/src/utils/update_derived_utils.f90 @@ -113,12 +113,12 @@ subroutine update_cohort_derived_props(cpatch,ico,lsl,new_year,llspan_toc !----- Get DBH and height -----------------------------------------------------------! if (is_grass(ipft) .and. igrass == 1) then !---- New grasses get dbh_effective and height from bleaf. ----------------------! - cpatch%dbh(ico) = bl2dbh(cpatch%bleaf(ico), cpatch%sla(ico), ipft) - cpatch%hite(ico) = bl2h (cpatch%bleaf(ico), cpatch%sla(ico), ipft) + cpatch%dbh (ico) = bl2dbh(cpatch%bleaf(ico), cpatch%sla(ico), ipft) + cpatch%height(ico) = bl2h (cpatch%bleaf(ico), cpatch%sla(ico), ipft) else !---- Trees and old grasses get dbh from bdead. ---------------------------------! - cpatch%dbh(ico) = bd2dbh(ipft, cpatch%bdeada(ico), cpatch%bdeadb(ico)) - cpatch%hite(ico) = dbh2h (ipft, cpatch%dbh (ico)) + cpatch%dbh (ico) = bd2dbh(ipft, cpatch%bdeada(ico), cpatch%bdeadb(ico)) + cpatch%height(ico) = dbh2h (ipft, cpatch%dbh (ico)) end if !------------------------------------------------------------------------------------! @@ -149,7 +149,7 @@ subroutine update_cohort_derived_props(cpatch,ico,lsl,new_year,llspan_toc if ((.not. is_grass(ipft)) .or. igrass /= 1) then select case (cpatch%phenology_status(ico)) case (0) - bleaf_max = size2bl(cpatch%dbh(ico),cpatch%hite(ico) & + bleaf_max = size2bl(cpatch%dbh(ico),cpatch%height(ico) & ,cpatch%sla(ico),cpatch%pft(ico)) if (cpatch%bleaf(ico) < bleaf_max) cpatch%phenology_status(ico) = 1 end select @@ -183,16 +183,16 @@ subroutine update_cohort_derived_props(cpatch,ico,lsl,new_year,llspan_toc cpatch%balive (ico) = ed_balive (cpatch, ico) cpatch%basarea(ico) = pio4 * cpatch%dbh(ico) * cpatch%dbh(ico) cpatch%agb (ico) = ed_biomass(cpatch, ico) - cpatch%btimber(ico) = size2bt(cpatch%dbh(ico),cpatch%hite(ico),cpatch%bdeada(ico) & + cpatch%btimber(ico) = size2bt(cpatch%dbh(ico),cpatch%height(ico),cpatch%bdeada(ico) & ,cpatch%bsapwooda(ico),cpatch%bbarka(ico) & ,cpatch%pft(ico)) - cpatch%thbark(ico) = size2xb(cpatch%dbh(ico),cpatch%hite(ico),cpatch%bbarka(ico) & + cpatch%thbark(ico) = size2xb(cpatch%dbh(ico),cpatch%height(ico),cpatch%bbarka(ico) & ,cpatch%bbarkb(ico),cpatch%sla(ico),cpatch%pft(ico)) !------------------------------------------------------------------------------------! !----- Update rooting depth ---------------------------------------------------------! - cpatch%krdepth(ico) = size2krdepth(cpatch%hite(ico),cpatch%dbh(ico),ipft,lsl) + cpatch%krdepth(ico) = size2krdepth(cpatch%height(ico),cpatch%dbh(ico),ipft,lsl) !if new root depth is smaller keep the old one !------------------------------------------------------------------------------------! @@ -284,7 +284,7 @@ subroutine update_cohort_plastic_trait(cpatch,ico,is_instant if (ico > 1) then !----- Accumulate LAI from the top cohort to current cohort. ---------------------! do jco = 1,ico-1 - bl_max = size2bl(cpatch%dbh(jco),cpatch%hite(jco) & + bl_max = size2bl(cpatch%dbh(jco),cpatch%height(jco) & ,cpatch%sla(jco),cpatch%pft(jco)) max_cum_lai = max_cum_lai + bl_max * cpatch%sla(jco) * cpatch%nplant(jco) end do @@ -369,7 +369,7 @@ subroutine update_cohort_plastic_trait(cpatch,ico,is_instant !---------------------------------------------------------------------------------! case (-1,-2) !------ SLA is defined at the bottom of canopy, use height to change SLA. --------! - new_sla = sla_toc / (1. + lma_slope(ipft) * cpatch%hite(ico)) + new_sla = sla_toc / (1. + lma_slope(ipft) * cpatch%height(ico)) !---------------------------------------------------------------------------------! case (3) !------------------------------------------------------------------------------------! @@ -409,7 +409,8 @@ subroutine update_cohort_plastic_trait(cpatch,ico,is_instant select case (iallom) case (3,4,5) !---- Maximum leaf biomass. ------------------------------------------------------! - bl_max = size2bl(cpatch%dbh(ico),cpatch%hite(ico),cpatch%sla(ico),cpatch%pft(ico)) + bl_max = size2bl(cpatch%dbh(ico),cpatch%height(ico),cpatch%sla(ico) & + ,cpatch%pft(ico)) !---------------------------------------------------------------------------------! @@ -701,7 +702,7 @@ subroutine update_patch_derived_props(csite,ipa,update_zcaneff) if (csite%opencan_frac(ipa) > 0.0) then weight = cpatch%nplant(ico) * cpatch%basarea(ico) weight_sum = weight_sum + weight - csite%veg_height(ipa) = csite%veg_height(ipa) + cpatch%hite(ico) * weight + csite%veg_height(ipa) = csite%veg_height(ipa) + cpatch%height(ico) * weight csite%opencan_frac(ipa) = csite%opencan_frac(ipa) & * (1.0 - cpatch%crown_area(ico)) end if @@ -2175,7 +2176,7 @@ subroutine patch_pft_size_profile(csite,ipa) ! Check whether this cohort is almost at the minimum height given its PFT. ! ! If it is, then we will skip it. ! !---------------------------------------------------------------------------------! - if (cpatch%hite(ico) < hgt_min(ipft) + 0.2) cycle cohortloop + if (cpatch%height(ico) < hgt_min(ipft) + 0.2) cycle cohortloop !---------------------------------------------------------------------------------! @@ -2186,10 +2187,10 @@ subroutine patch_pft_size_profile(csite,ipa) select case (ihrzrad) case (2,4) sz_fact = max(dbh_crit(ipft),cpatch%dbh(ico))/dbh_crit(ipft) - hgt_eff = min(cci_hmax, cpatch%hite(ico) * sz_fact * sz_fact) + hgt_eff = min(cci_hmax, cpatch%height(ico) * sz_fact * sz_fact) ihgt = min(ff_nhgt,max(1,count(hgt_class < hgt_eff))) case default - ihgt = min(ff_nhgt,max(1,count(hgt_class < cpatch%hite(ico)))) + ihgt = min(ff_nhgt,max(1,count(hgt_class < cpatch%height(ico)))) end select !---------------------------------------------------------------------------------! @@ -2201,7 +2202,7 @@ subroutine patch_pft_size_profile(csite,ipa) else !--use dbh for trees lai_pot = cpatch%nplant(ico) * cpatch%sla(ico) & - * size2bl(cpatch%dbh(ico),cpatch%hite(ico),cpatch%sla(ico),ipft) + * size2bl(cpatch%dbh(ico),cpatch%height(ico),cpatch%sla(ico),ipft) end if !---------------------------------------------------------------------------------! diff --git a/R-utils/ptcloud.2.patch.r b/R-utils/ptcloud.2.patch.r index 1e135a436..b7d7780eb 100644 --- a/R-utils/ptcloud.2.patch.r +++ b/R-utils/ptcloud.2.patch.r @@ -123,7 +123,7 @@ ptcloud.2.patch <<- function( pt.cloud , patch = rep(pname,times=ni.now) , cohort = sequence(ni.now) , dbh = i.now$DBH - , hite = i.now$Htot + , height = i.now$Htot , pft = i.now$pft , n = i.now$nplant , bdead = i.now$bdead @@ -156,7 +156,7 @@ ptcloud.2.patch <<- function( pt.cloud , patch = character(0) , cohort = numeric(0) , dbh = numeric(0) - , hite = numeric(0) + , height = numeric(0) , pft = numeric(0) , n = numeric(0) , bdead = numeric(0) @@ -516,7 +516,7 @@ ptcloud.2.patch <<- function( pt.cloud w.lai = 0. }else{ f.lai = lai.goal / sum(lai.pft) - }#end if (sum(bsa.pft) == 0) + }#end if (sum(lai.pft) == 0) #----- Biomass. Check for singularities before finding the global f. ---------# if (sum(agb.pft) == 0){ f.agb = f.net.def @@ -572,7 +572,7 @@ ptcloud.2.patch <<- function( pt.cloud }else{ b.lai = lai.goal / sum(lai.bft) m.lai = w.lai - }#end if (sum(bsa.bft) == 0) + }#end if (sum(lai.bft) == 0) #----- Biomass. Check for singularities before finding the global f. ---------# if (sum(agb.bft) == 0){ b.agb = f.net.def @@ -661,7 +661,7 @@ ptcloud.2.patch <<- function( pt.cloud , patch = rep(pname,times=nidx) , cohort = sequence(nidx) , dbh = dbh.pft [idx] - , hite = hgt.pft [idx] + , height = hgt.pft [idx] , pft = ipft.pft [idx] , n = npl.pft [idx] , bdead = bdead.pft [idx] @@ -692,7 +692,7 @@ ptcloud.2.patch <<- function( pt.cloud , patch = character(0) , cohort = numeric(0) , dbh = numeric(0) - , hite = numeric(0) + , height = numeric(0) , pft = numeric(0) , n = numeric(0) , bdead = numeric(0) @@ -730,9 +730,9 @@ ptcloud.2.patch <<- function( pt.cloud #----- Aggregate information of the suspicious patch. -------------------# css.agf = pft$agf.bs[cssnow$pft] css.sla = pft$SLA[cssnow$pft] - css.bleaf = with(cssnow,size2bl(dbh=dbh,hgt=hite,sla=css.sla,ipft=pft)) - css.bsap = pft$qsw [cssnow$pft] * cssnow$hite * css.bleaf - css.bbark = pft$qbark [cssnow$pft] * cssnow$hite * css.bleaf + css.bleaf = with(cssnow,size2bl(dbh=dbh,hgt=height,sla=css.sla,ipft=pft)) + css.bsap = pft$qsw [cssnow$pft] * cssnow$height * css.bleaf + css.bbark = pft$qbark [cssnow$pft] * cssnow$height * css.bleaf css.agb = ( css.bleaf + css.agf * ( css.bsap + css.bbark + cssnow$bdead ) )#end css.agb diff --git a/R-utils/read.q.files.r b/R-utils/read.q.files.r index d586142ca..a9be6e2a0 100644 --- a/R-utils/read.q.files.r +++ b/R-utils/read.q.files.r @@ -1050,11 +1050,11 @@ read.q.files <<- function( datum #----- Read the cohort level variables. ------------------------------------------# - showconow = mymont$HITE > pft$hgt.show[pftconow] + showconow = mymont$HEIGHT > pft$hgt.show[pftconow] nplantconow = mymont$NPLANT * as.numeric(showconow) laiconow = mymont$MMEAN.LAI.CO * as.numeric(showconow) waiconow = mymont$WAI.CO * as.numeric(showconow) - heightconow = mymont$HITE + heightconow = mymont$HEIGHT thbarkconow = mymont$MMEAN.THBARK.CO wood.densconow = pft$rho[pftconow] slaconow = mymont$MMEAN.SLA.CO