Skip to content
This repository has been archived by the owner on Sep 14, 2018. It is now read-only.

Commit

Permalink
Merge pull request #1 from rgknox/laicanfix
Browse files Browse the repository at this point in the history 
merge resolutions
  • Loading branch information
@ckoven
ckoven authored Mar 22, 2018
2 parents a181d48 + bb99e67 commit 07a0a7a
Show file tree
Hide file tree
Showing 6 changed files with 502 additions and 402 deletions.
810 changes: 451 additions & 359 deletions biogeochem/EDCanopyStructureMod.F90
View file

Large diffs are not rendered by default.

14 changes: 6 additions & 8 deletions biogeochem/EDPatchDynamicsMod.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -1219,9 +1219,8 @@ subroutine zero_patch(cp_p)
currentPatch%age = nan
currentPatch%age_class = 1
currentPatch%area = nan
currentPatch%canopy_layer_lai(:) = nan
currentPatch%canopy_layer_tai(:) = nan
currentPatch%total_canopy_area = nan
currentPatch%canopy_area = nan
currentPatch%bare_frac_area = nan

currentPatch%tlai_profile(:,:,:) = nan
Expand All @@ -1248,10 +1247,9 @@ subroutine zero_patch(cp_p)
currentPatch%fabd(:) = nan ! fraction of incoming direct radiation that is absorbed by the canopy
currentPatch%fabi(:) = nan ! fraction of incoming diffuse radiation that is absorbed by the canopy

currentPatch%present(:,:) = 999 ! is there any of this pft in this layer?
currentPatch%canopy_mask(:,:) = 999 ! is there any of this pft in this layer?
currentPatch%nrad(:,:) = 999 ! number of exposed leaf layers for each canopy layer and pft
currentPatch%ncan(:,:) = 999 ! number of total leaf layers for each canopy layer and pft
currentPatch%lai = nan ! leaf area index of patch
currentPatch%pft_agb_profile(:,:) = nan

! DISTURBANCE
Expand Down Expand Up @@ -1302,7 +1300,7 @@ subroutine zero_patch(cp_p)
currentPatch%burnt_frac_litter(:) = 0.0_r8
currentPatch%btran_ft(:) = 0.0_r8

currentPatch%canopy_layer_lai(:) = 0.0_r8
currentPatch%canopy_layer_tai(:) = 0.0_r8

currentPatch%seeds_in(:) = 0.0_r8
currentPatch%seed_decay(:) = 0.0_r8
Expand Down Expand Up @@ -1714,13 +1712,13 @@ subroutine terminate_patches(cs_pnt)
! This is only really meant for very old patches.
if(associated(currentPatch%older) )then
write(fates_log(),*) 'fusing to older patch because this one is too small',&
currentPatch%area, currentPatch%lai, &
currentPatch%older%area,currentPatch%older%lai
currentPatch%area, &
currentPatch%older%area
call fuse_2_patches(currentPatch%older, currentPatch)
write(fates_log(),*) 'after fusion to older patch',currentPatch%area
else
write(fates_log(),*) 'fusing to younger patch because oldest one is too small',&
currentPatch%area, currentPatch%lai
currentPatch%area
tmpptr => currentPatch%younger
call fuse_2_patches(currentPatch, currentPatch%younger)
write(fates_log(),*) 'after fusion to younger patch'
Expand Down
28 changes: 14 additions & 14 deletions biogeophys/EDSurfaceAlbedoMod.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -197,10 +197,10 @@ subroutine ED_Norman_Radiation (nsites, sites, bc_in, bc_out )
! Is this pft/canopy layer combination present in this patch?
do L = 1,nclmax
do ft = 1,numpft
currentPatch%present(L,ft) = 0
currentPatch%canopy_mask(L,ft) = 0
do iv = 1, currentPatch%nrad(L,ft)
if (currentPatch%canopy_area_profile(L,ft,iv) > 0._r8)then
currentPatch%present(L,ft) = 1
currentPatch%canopy_mask(L,ft) = 1
!I think 'present' is only used here...
endif
end do !iv
Expand Down Expand Up @@ -260,7 +260,7 @@ subroutine ED_Norman_Radiation (nsites, sites, bc_in, bc_out )
weighted_dif_ratio(L,1:hlm_numSWb) = 0._r8
!Each canopy layer (canopy, understorey) has multiple 'parallel' pft's
do ft =1,numpft
if (currentPatch%present(L,ft) == 1)then !only do calculation if there are the appropriate leaves.
if (currentPatch%canopy_mask(L,ft) == 1)then !only do calculation if there are the appropriate leaves.
!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++!
! Diffuse transmittance, tr_dif, do each layer with thickness elai_z.
! Estimated do nine sky angles in increments of 10 degrees
Expand Down Expand Up @@ -392,7 +392,7 @@ subroutine ED_Norman_Radiation (nsites, sites, bc_in, bc_out )

do L = currentPatch%NCL_p,1, -1 !start at the bottom and work up.
do ft = 1,numpft
if (currentPatch%present(L,ft) == 1)then
if (currentPatch%canopy_mask(L,ft) == 1)then
!==============================================================================!
! Iterative solution do scattering
!==============================================================================!
Expand Down Expand Up @@ -440,7 +440,7 @@ subroutine ED_Norman_Radiation (nsites, sites, bc_in, bc_out )
dif_ratio(L,ft,1,ib) * ftweight(L,ft,1)
!instance where the first layer ftweight is used a proxy for the whole column. FTWA
end do!hlm_numSWb
endif ! currentPatch%present
endif ! currentPatch%canopy_mask
end do!ft
end do!L

Expand All @@ -450,7 +450,7 @@ subroutine ED_Norman_Radiation (nsites, sites, bc_in, bc_out )
do L = 1, currentPatch%NCL_p !work down from the top of the canopy.
weighted_dif_down(L) = 0._r8
do ft = 1, numpft
if (currentPatch%present(L,ft) == 1)then
if (currentPatch%canopy_mask(L,ft) == 1)then
!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++!
! First estimates do downward and upward diffuse flux
!
Expand Down Expand Up @@ -506,7 +506,7 @@ subroutine ED_Norman_Radiation (nsites, sites, bc_in, bc_out )
do L = currentPatch%NCL_p,1 ,-1 !work up from the bottom.
weighted_dif_up(L) = 0._r8
do ft = 1, numpft
if (currentPatch%present(L,ft) == 1)then
if (currentPatch%canopy_mask(L,ft) == 1)then
!Bounce diffuse radiation off soil surface.
iv = currentPatch%nrad(L,ft) + 1
if (L==currentPatch%NCL_p)then !is this the bottom layer ?
Expand Down Expand Up @@ -562,7 +562,7 @@ subroutine ED_Norman_Radiation (nsites, sites, bc_in, bc_out )
do L = 1,currentPatch%NCL_p !working from the top down
weighted_dif_down(L) = 0._r8
do ft =1,numpft
if (currentPatch%present(L,ft) == 1)then
if (currentPatch%canopy_mask(L,ft) == 1)then
! forward diffuse flux within the canopy and at soil, working forward through canopy
! with Dif_up -from previous iteration-. Dif_dn(1) is the forward diffuse flux onto the canopy.
! Note: down = forward flux onto next layer
Expand Down Expand Up @@ -618,7 +618,7 @@ subroutine ED_Norman_Radiation (nsites, sites, bc_in, bc_out )
do L = 1, currentPatch%NCL_p ! working from the top down.
weighted_dif_up(L) = 0._r8
do ft =1,numpft
if (currentPatch%present(L,ft) == 1)then
if (currentPatch%canopy_mask(L,ft) == 1)then
! Upward diffuse flux at soil or from lower canopy (forward diffuse and unscattered direct beam)
iv = currentPatch%nrad(L,ft) + 1
if (L==currentPatch%NCL_p)then !In the bottom canopy layer, reflect off the soil
Expand Down Expand Up @@ -670,7 +670,7 @@ subroutine ED_Norman_Radiation (nsites, sites, bc_in, bc_out )
abs_dir_z(:,:) = 0._r8
abs_dif_z(:,:) = 0._r8
do ft =1,numpft
if (currentPatch%present(L,ft) == 1)then
if (currentPatch%canopy_mask(L,ft) == 1)then
!==============================================================================!
! Compute absorbed flux densities
!==============================================================================!
Expand Down Expand Up @@ -799,7 +799,7 @@ subroutine ED_Norman_Radiation (nsites, sites, bc_in, bc_out )
currentPatch%tr_soil_dir(ib)* &
(1.0_r8-bc_in(s)%albgr_dir_rb(ib)),currentPatch%NCL_p,ib,sum(ftweight(1,1:numpft,1))
write(fates_log(),*) 'albedos',currentPatch%sabs_dir(ib) ,currentPatch%tr_soil_dir(ib), &
(1.0_r8-bc_in(s)%albgr_dir_rb(ib)),currentPatch%lai
(1.0_r8-bc_in(s)%albgr_dir_rb(ib))

do ft =1,3
iv = currentPatch%nrad(1,ft) + 1
Expand All @@ -826,7 +826,7 @@ subroutine ED_Norman_Radiation (nsites, sites, bc_in, bc_out )
lai_reduction(:) = 0.0_r8
do L = 1, currentPatch%NCL_p
do ft =1,numpft
if (currentPatch%present(L,ft) == 1)then
if (currentPatch%canopy_mask(L,ft) == 1)then
do iv = 1, currentPatch%nrad(L,ft)
if (lai_change(L,ft,iv) > 0.0_r8)then
lai_reduction(L) = max(lai_reduction(L),lai_change(L,ft,iv))
Expand Down Expand Up @@ -879,7 +879,7 @@ subroutine ED_Norman_Radiation (nsites, sites, bc_in, bc_out )
write(fates_log(),*) 'bc_in(s)%albgr_dif_rb(ib)',bc_in(s)%albgr_dif_rb(ib)
write(fates_log(),*) 'rhol',rhol(1:numpft,:)
write(fates_log(),*) 'ftw',sum(ftweight(1,1:numpft,1)),ftweight(1,1:numpft,1)
write(fates_log(),*) 'present',currentPatch%present(1,1:numpft)
write(fates_log(),*) 'present',currentPatch%canopy_mask(1,1:numpft)
write(fates_log(),*) 'CAP',currentPatch%canopy_area_profile(1,1:numpft,1)

bc_out(s)%albi_parb(ifp,ib) = bc_out(s)%albi_parb(ifp,ib) + error
Expand Down Expand Up @@ -1003,7 +1003,7 @@ subroutine ED_SunShadeFracs(nsites, sites,bc_in,bc_out)

if(bc_out(s)%fsun_pa(ifp) > 1._r8)then
write(fates_log(),*) 'too much leaf area in profile', bc_out(s)%fsun_pa(ifp), &
cpatch%lai,sunlai,shalai
sunlai,shalai
endif

elai = calc_areaindex(cpatch,'elai')
Expand Down
18 changes: 10 additions & 8 deletions biogeophys/FatesPlantRespPhotosynthMod.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -242,7 +242,7 @@ subroutine FatesPlantRespPhotosynthDrive (nsites, sites,bc_in,bc_out,dtime)
! And then identify which layer/pft combinations have things in them.
! Output:
! currentPatch%ncan(:,:)
! currentPatch%present(:,:)
! currentPatch%canopy_mask(:,:)
call UpdateCanopyNCanNRadPresent(currentPatch)


Expand Down Expand Up @@ -322,12 +322,14 @@ subroutine FatesPlantRespPhotosynthDrive (nsites, sites,bc_in,bc_out,dtime)


! are there any leaves of this pft in this layer?
if(currentPatch%present(cl,ft) == 1)then
if(currentPatch%canopy_mask(cl,ft) == 1)then

if(cl==1)then !are we in the top canopy layer or a shaded layer?
laican = 0._r8
else
laican = sum(currentPatch%canopy_layer_lai(1:cl-1))

laican = sum(currentPatch%canopy_layer_tai(1:cl-1))

end if

! Loop over leaf-layers
Expand Down Expand Up @@ -484,7 +486,7 @@ subroutine FatesPlantRespPhotosynthDrive (nsites, sites,bc_in,bc_out,dtime)
currentCohort%gscan = 0.0_r8
currentCohort%ts_net_uptake(:) = 0.0_r8

end if ! if(currentPatch%present(cl,ft) == 1)then
end if ! if(currentPatch%canopy_mask(cl,ft) == 1)then


! ------------------------------------------------------------------
Expand Down Expand Up @@ -1281,7 +1283,7 @@ subroutine UpdateCanopyNCanNRadPresent(currentPatch)
! ---------------------------------------------------------------------------------
! This subroutine calculates two patch level quanities:
! currentPatch%ncan and
! currentPatch%present
! currentPatch%canopy_mask
!
! currentPatch%ncan(:,:) is a two dimensional array that indicates
! the total number of leaf layers (including those that are not exposed to light)
Expand All @@ -1291,7 +1293,7 @@ subroutine UpdateCanopyNCanNRadPresent(currentPatch)
! the total number of EXPOSED leaf layers, but for all intents and purposes
! in the photosynthesis routine, this appears to be the same as %ncan...
!
! currentPatch%present(:,:) has the same dimensions, is binary, and
! currentPatch%canopy_mask(:,:) has the same dimensions, is binary, and
! indicates whether or not leaf layers are present (by evaluating the canopy area
! profile).
! ---------------------------------------------------------------------------------
Expand Down Expand Up @@ -1334,10 +1336,10 @@ subroutine UpdateCanopyNCanNRadPresent(currentPatch)
! Now loop through and identify which layer and pft combo has scattering elements
do cl = 1,nclmax
do ft = 1,numpft
currentPatch%present(cl,ft) = 0
currentPatch%canopy_mask(cl,ft) = 0
do iv = 1, currentPatch%nrad(cl,ft);
if(currentPatch%canopy_area_profile(cl,ft,iv) > 0._r8)then
currentPatch%present(cl,ft) = 1
currentPatch%canopy_mask(cl,ft) = 1
end if
end do !iv
enddo !ft
Expand Down
29 changes: 18 additions & 11 deletions main/EDTypesMod.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -296,22 +296,31 @@ module EDTypesMod

! LEAF ORGANIZATION
real(r8) :: pft_agb_profile(maxpft,n_dbh_bins) ! binned above ground biomass, for patch fusion: KgC/m2
real(r8) :: canopy_layer_lai(nclmax) ! lai that is shading this canopy layer: m2/m2
real(r8) :: canopy_layer_tai(nclmax) ! total area index of each canopy layer
! used to determine attenuation of parameters during
! photosynthesis m2 veg / m2 of canopy area (patch without bare ground)
real(r8) :: total_canopy_area ! area that is covered by vegetation : m2
real(r8) :: total_tree_area ! area that is covered by woody vegetation : m2
real(r8) :: canopy_area ! area that is covered by vegetation : m2 (is this different to total_canopy_area?
real(r8) :: bare_frac_area ! bare soil in this patch expressed as a fraction of the total soil surface.
real(r8) :: lai ! leaf area index of patch
real(r8) :: zstar ! height of smallest canopy tree -- only meaningful in "strict PPA" mode

real(r8) :: tlai_profile(nclmax,maxpft,nlevleaf) ! total leaf area in each canopy layer, pft, and leaf layer. m2/m2
real(r8) :: elai_profile(nclmax,maxpft,nlevleaf) ! exposed leaf area in each canopy layer, pft, and leaf layer. m2/m2
real(r8) :: tsai_profile(nclmax,maxpft,nlevleaf) ! total stem area in each canopy layer, pft, and leaf layer. m2/m2
real(r8) :: esai_profile(nclmax,maxpft,nlevleaf) ! exposed stem area in each canopy layer, pft, and leaf layer. m2/m2

! UNITS for the ai profiles
! [ m2 leaf / m2 contributing crown footprints]
real(r8) :: tlai_profile(nclmax,maxpft,nlevleaf) ! total leaf area in each canopy layer, pft, and leaf layer.
real(r8) :: elai_profile(nclmax,maxpft,nlevleaf) ! exposed leaf area in each canopy layer, pft, and leaf layer
real(r8) :: tsai_profile(nclmax,maxpft,nlevleaf) ! total stem area in each canopy layer, pft, and leaf layer
real(r8) :: esai_profile(nclmax,maxpft,nlevleaf) ! exposed stem area in each canopy layer, pft, and leaf layer

real(r8) :: layer_height_profile(nclmax,maxpft,nlevleaf)
real(r8) :: canopy_area_profile(nclmax,maxpft,nlevleaf) ! fraction of canopy in each canopy
real(r8) :: canopy_area_profile(nclmax,maxpft,nlevleaf) ! fraction of crown area per canopy area in each layer
! they will sum to 1.0 in the fully closed canopy layers
! but only in leaf-layers that contain contributions
! from all cohorts that donate to canopy_area


! layer, pft, and leaf layer:-
integer :: present(nclmax,maxpft) ! is there any of this pft in this canopy layer?
integer :: canopy_mask(nclmax,maxpft) ! is there any of this pft in this canopy layer?
integer :: nrad(nclmax,maxpft) ! number of exposed leaf layers for each canopy layer and pft
integer :: ncan(nclmax,maxpft) ! number of total leaf layers for each canopy layer and pft

Expand Down Expand Up @@ -682,9 +691,7 @@ subroutine dump_patch(cpatch)
write(fates_log(),*) 'pa%ncl_p = ',cpatch%ncl_p
write(fates_log(),*) 'pa%total_canopy_area = ',cpatch%total_canopy_area
write(fates_log(),*) 'pa%total_tree_area = ',cpatch%total_tree_area
write(fates_log(),*) 'pa%canopy_area = ',cpatch%canopy_area
write(fates_log(),*) 'pa%bare_frac_area = ',cpatch%bare_frac_area
write(fates_log(),*) 'pa%lai = ',cpatch%lai
write(fates_log(),*) 'pa%zstar = ',cpatch%zstar
write(fates_log(),*) 'pa%disturbance_rate = ',cpatch%disturbance_rate
write(fates_log(),*) '----------------------------------------'
Expand Down
Loading

0 comments on commit 07a0a7a

Please sign in to comment.