Skip to content
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
2 changes: 1 addition & 1 deletion ED/Template/Template/patchprops.r
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down
2 changes: 1 addition & 1 deletion ED/Template/compare_qm_profiles.r
Original file line number Diff line number Diff line change
Expand Up @@ -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]))
Expand Down
28 changes: 14 additions & 14 deletions ED/src/dynamics/canopy_struct_dynamics.f90
Original file line number Diff line number Diff line change
Expand Up @@ -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, !
Expand Down Expand Up @@ -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. ----------------------------------------------------!
Expand All @@ -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)
!------------------------------------------------------------------------------!

Expand Down Expand Up @@ -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)
!---------------------------------------------------------------------------------!

Expand Down Expand Up @@ -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
!---------------------------------------------------------------------------!
Expand All @@ -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)
Expand Down Expand Up @@ -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)
!------------------------------------------------------------------------!
Expand Down Expand Up @@ -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)))
!------------------------------------------------------------------------------!


Expand Down
62 changes: 32 additions & 30 deletions ED/src/dynamics/disturbance.f90
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down Expand Up @@ -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.
!---------------------------------------------------------------------!
Expand Down Expand Up @@ -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
!---------------------------------------------------------------------------------!
Expand All @@ -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
!---------------------------------------------------------------------------------!
Expand All @@ -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) &
Expand All @@ -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
Expand Down Expand Up @@ -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
Expand All @@ -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)
Expand All @@ -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. --------------------------------------------!
Expand All @@ -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
!------------------------------------------------------------------------------!

Expand Down
Loading
Loading