From 537301019b998e6130f347072143c00f2801dfde Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Thu, 6 Jul 2023 17:08:11 -0700 Subject: [PATCH 1/3] initial refactor of seedlingparpatch This refactor attempts to reduce repeated lines of code --- main/FatesInterfaceMod.F90 | 70 ++++++++++++-------------------------- 1 file changed, 22 insertions(+), 48 deletions(-) diff --git a/main/FatesInterfaceMod.F90 b/main/FatesInterfaceMod.F90 index 01a5c49f55..82d6e39f70 100644 --- a/main/FatesInterfaceMod.F90 +++ b/main/FatesInterfaceMod.F90 @@ -2069,68 +2069,42 @@ subroutine SeedlingParPatch(cpatch, & integer :: ipft ! current PFT index integer :: iv ! lower-most leaf layer index for the cl & pft combo + ! Assuming there is a single canopy layer + seedling_par_high = atm_par + par_high_frac = 1._r8-cpatch%total_canopy_area + par_low_frac = cpatch%total_canopy_area - ! Check that there are cohorts on the current patch as this calculation is - ! not relevant in that case (and will result in an index error due to ncan being zero) - if (cpatch%countcohorts .gt. 0) then - - ! Radiation intensity exiting the layer above the bottom-most + do cl = cpatch%NCL_p,max(1,cpatch%NCL_p-1),-1 upper_par = 0._r8 upper_area = 0._r8 - cl = max(1,cpatch%NCL_p-1) do ipft = 1,numpft iv = cpatch%ncan(cl,ipft) - upper_par = upper_par + cpatch%canopy_area_profile(cl,ipft,1)* & - (cpatch%parprof_pft_dir_z(cl,ipft,iv)+cpatch%parprof_pft_dif_z(cl,ipft,iv)) - upper_area = upper_area + cpatch%canopy_area_profile(cl,ipft,1) + ! Avoid calculating when there are no leaf layers for the given pft + if (iv .ne. 0) then + upper_par = upper_par + cpatch%canopy_area_profile(cl,ipft,1)* & + (cpatch%parprof_pft_dir_z(cl,ipft,iv)+cpatch%parprof_pft_dif_z(cl,ipft,iv)) + upper_area = upper_area + cpatch%canopy_area_profile(cl,ipft,1) + end if end do if(upper_area>nearzero)then upper_par = upper_par/upper_area else upper_par = 0._r8 end if - else - upper_par = fates_unset_r8 - end if - - ! If we do have more than one layer, then we need to figure out - ! the average of light on the exposed ground under the veg - ! Note that newly spawned patches without cohorts have a default - ! NCL_p of one. - if(cpatch%NCL_p>1) then - - cl = cpatch%NCL_p - lower_area = 0._r8 - lower_par = 0._r8 - do ipft = 1,numpft - iv = cpatch%ncan(cl,ipft) - lower_area = lower_area+cpatch%canopy_area_profile(cl,ipft,1) - lower_par = lower_par + & - cpatch%canopy_area_profile(cl,ipft,1)*& - (cpatch%parprof_pft_dir_z(cl,ipft,iv) + cpatch%parprof_pft_dif_z(cl,ipft,iv)) - end do - if(lower_area>nearzero)then - lower_par = lower_par / lower_area + + ! If we do have more than one layer, then we need to figure out + ! the average of light on the exposed ground under the veg + ! Note that newly spawned patches without cohorts have a default + ! NCL_p of one. + if(cl .lt. cpatch%NCL_p) then + seedling_par_high = seedling_par_low + par_high_frac = (1._r8-upper_area) + seedling_par_low = upper_par/upper_area + par_low_frac = upper_area else - lower_par = 0._r8 + seedling_par_low = upper_par end if - seedling_par_high = upper_par - par_high_frac = (1._r8-lower_area) - seedling_par_low = lower_par/lower_area - par_low_frac = lower_area - - else - - ! In the case where the patch is newly spawned and has no cohorts, - ! total_canopy_area should be zero - seedling_par_high = atm_par - par_high_frac = 1._r8-cpatch%total_canopy_area - seedling_par_low = upper_par - par_low_frac = cpatch%total_canopy_area - - end if - return end subroutine SeedlingParPatch From 06b92a97eba85d0ca918c5593acb907e0df7b0a5 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Thu, 6 Jul 2023 23:19:19 -0600 Subject: [PATCH 2/3] add missing end do --- main/FatesInterfaceMod.F90 | 1 + 1 file changed, 1 insertion(+) diff --git a/main/FatesInterfaceMod.F90 b/main/FatesInterfaceMod.F90 index 82d6e39f70..1fca2e0269 100644 --- a/main/FatesInterfaceMod.F90 +++ b/main/FatesInterfaceMod.F90 @@ -2104,6 +2104,7 @@ subroutine SeedlingParPatch(cpatch, & else seedling_par_low = upper_par end if + end do return end subroutine SeedlingParPatch From 7eb363d79b8c79dcb0ea0c3d5631f10e9fc8fcf5 Mon Sep 17 00:00:00 2001 From: Gregory Lemieux Date: Fri, 7 Jul 2023 00:37:24 -0600 Subject: [PATCH 3/3] update names and remove old code --- main/FatesInterfaceMod.F90 | 42 +++++++++++++++++++++----------------- 1 file changed, 23 insertions(+), 19 deletions(-) diff --git a/main/FatesInterfaceMod.F90 b/main/FatesInterfaceMod.F90 index 1fca2e0269..3dd713f5fb 100644 --- a/main/FatesInterfaceMod.F90 +++ b/main/FatesInterfaceMod.F90 @@ -2061,49 +2061,53 @@ subroutine SeedlingParPatch(cpatch, & real(r8), intent(out) :: par_low_frac ! Area fraction with low intensity ! Locals - real(r8) :: upper_par ! The PAR intensity coming from the canopy layer above [w/m2] - real(r8) :: upper_area ! The area fraction of the upper canopy - real(r8) :: lower_par ! The PAR intensity under the lower-most canopy [W/m2] - real(r8) :: lower_area ! The area fractino of the lower canopy + real(r8) :: cl_par ! The PAR intensity coming from the canopy layer [w/m2] + real(r8) :: cl_area ! The area fraction of the given canopy layer integer :: cl ! current canopy layer integer :: ipft ! current PFT index integer :: iv ! lower-most leaf layer index for the cl & pft combo - ! Assuming there is a single canopy layer + ! Start with the assumption that there is a single canopy layer seedling_par_high = atm_par par_high_frac = 1._r8-cpatch%total_canopy_area par_low_frac = cpatch%total_canopy_area + ! Work up through the canopy layers from the bottom layer do cl = cpatch%NCL_p,max(1,cpatch%NCL_p-1),-1 - upper_par = 0._r8 - upper_area = 0._r8 + cl_par = 0._r8 + cl_area = 0._r8 do ipft = 1,numpft iv = cpatch%ncan(cl,ipft) - ! Avoid calculating when there are no leaf layers for the given pft + ! Avoid calculating when there are no leaf layers for the given pft in the current canopy layer if (iv .ne. 0) then - upper_par = upper_par + cpatch%canopy_area_profile(cl,ipft,1)* & + cl_par = cl_par + cpatch%canopy_area_profile(cl,ipft,1)* & (cpatch%parprof_pft_dir_z(cl,ipft,iv)+cpatch%parprof_pft_dif_z(cl,ipft,iv)) - upper_area = upper_area + cpatch%canopy_area_profile(cl,ipft,1) + cl_area = cl_area + cpatch%canopy_area_profile(cl,ipft,1) end if end do - if(upper_area>nearzero)then - upper_par = upper_par/upper_area + + ! Set the cl_par to zero if the area is near zero. Otherwise scale the par by the area + if(cl_area>nearzero)then + cl_par = cl_par/cl_area else - upper_par = 0._r8 + cl_par = 0._r8 end if ! If we do have more than one layer, then we need to figure out ! the average of light on the exposed ground under the veg - ! Note that newly spawned patches without cohorts have a default - ! NCL_p of one. + ! Since we are working up through the canopy layers from the ground, + ! set the par_high to the previous par_low value and update + ! the par_low to the new cl_par value if(cl .lt. cpatch%NCL_p) then seedling_par_high = seedling_par_low - par_high_frac = (1._r8-upper_area) - seedling_par_low = upper_par/upper_area - par_low_frac = upper_area + par_high_frac = (1._r8-cl_area) + seedling_par_low = cl_par + par_low_frac = cl_area + ! If we only have one layer, only set the seedling_par_low else - seedling_par_low = upper_par + seedling_par_low = cl_par end if + end do return