From 0cc6c76c1a781b4286eebeb45a686e7f9c7403dc Mon Sep 17 00:00:00 2001 From: Adrianna Foster Date: Wed, 5 Feb 2025 14:10:33 -0700 Subject: [PATCH] update to use new array --- src/biogeochem/SatellitePhenologyMod.F90 | 145 +++++++++++++++-------- src/cpl/share_esmf/laiStreamMod.F90 | 4 +- src/utils/clmfates_interfaceMod.F90 | 45 +++---- 3 files changed, 115 insertions(+), 79 deletions(-) diff --git a/src/biogeochem/SatellitePhenologyMod.F90 b/src/biogeochem/SatellitePhenologyMod.F90 index 4bedbe9709..f4f7a96237 100644 --- a/src/biogeochem/SatellitePhenologyMod.F90 +++ b/src/biogeochem/SatellitePhenologyMod.F90 @@ -88,7 +88,7 @@ subroutine SatellitePhenologyInit (bounds) end subroutine SatellitePhenologyInit !================================================================ - subroutine SatellitePhenology(bounds, num_filter, filter, & + subroutine GetSatellitePhenologyInputs(bounds, num_filter, filter, & waterdiagnosticbulk_inst, canopystate_inst) ! ! !DESCRIPTION: @@ -117,15 +117,10 @@ subroutine SatellitePhenology(bounds, num_filter, filter, & !----------------------------------------------------------------------- associate( & - frac_sno => waterdiagnosticbulk_inst%frac_sno_col , & ! Input: [real(r8) (:) ] fraction of ground covered by snow (0 to 1) - snow_depth => waterdiagnosticbulk_inst%snow_depth_col , & ! Input: [real(r8) (:) ] snow height (m) - tlai => canopystate_inst%tlai_input_patch , & ! Output: [real(r8) (:) ] one-sided leaf area index, no burying by snow - tsai => canopystate_inst%tsai_input_patch , & ! Output: [real(r8) (:) ] one-sided stem area index, no burying by snow - elai => canopystate_inst%elai_patch , & ! Output: [real(r8) (:) ] one-sided leaf area index with burying by snow - esai => canopystate_inst%esai_patch , & ! Output: [real(r8) (:) ] one-sided stem area index with burying by snow - htop => canopystate_inst%htop_input_patch , & ! Output: [real(r8) (:) ] canopy top (m) - hbot => canopystate_inst%hbot_input_patch , & ! Output: [real(r8) (:) ] canopy bottom (m) - frac_veg_nosno_alb => canopystate_inst%frac_veg_nosno_alb_patch & ! Output: [integer (:) ] fraction of vegetation not covered by snow (0 OR 1) [-] + tlai_driver => canopystate_inst%tlai_input_patch , & ! Output: [real(r8) (:) ] one-sided leaf area index, no burying by snow + tsai_driver => canopystate_inst%tsai_input_patch , & ! Output: [real(r8) (:) ] one-sided stem area index, no burying by snow + htop_driver => canopystate_inst%htop_input_patch , & ! Output: [real(r8) (:) ] canopy top (m) + hbot_driver => canopystate_inst%hbot_input_patch , & ! Output: [real(r8) (:) ] canopy bottom (m) ) if (use_lai_streams) then @@ -153,53 +148,105 @@ subroutine SatellitePhenology(bounds, num_filter, filter, & ! bottom height HBOT <- mhvb1 and mhvb2 if (.not. use_lai_streams) then - tlai(p) = timwt(1)*mlai2t(p,1) + timwt(2)*mlai2t(p,2) + tlai_driver(p) = timwt(1)*mlai2t(p,1) + timwt(2)*mlai2t(p,2) endif - tsai(p) = timwt(1)*msai2t(p,1) + timwt(2)*msai2t(p,2) - htop(p) = timwt(1)*mhvt2t(p,1) + timwt(2)*mhvt2t(p,2) - hbot(p) = timwt(1)*mhvb2t(p,1) + timwt(2)*mhvb2t(p,2) - - ! adjust lai and sai for burying by snow. if exposed lai and sai - ! are less than 0.05, set equal to zero to prevent numerical - ! problems associated with very small lai and sai. - - ! snow burial fraction for short vegetation (e.g. grasses, crops) changes with vegetation height - ! accounts for a 20% bending factor, as used in Lombardozzi et al. (2018) GRL 45(18), 9889-9897 - - ! NOTE: The following snow burial code is duplicated in CNVegStructUpdateMod. - ! Changes in one place should be accompanied by similar changes in the other. - - if (patch%itype(p) > noveg .and. patch%itype(p) <= nbrdlf_dcd_brl_shrub ) then - ol = min( max(snow_depth(c)-hbot(p), 0._r8), htop(p)-hbot(p)) - fb = 1._r8 - ol / max(1.e-06_r8, htop(p)-hbot(p)) - else - fb = 1._r8 - (max(min(snow_depth(c),max(0.05,htop(p)*0.8_r8)),0._r8)/(max(0.05,htop(p)*0.8_r8))) - endif - - ! area weight by snow covered fraction - if(.not.use_fates_sp)then + tsai_driver(p) = timwt(1)*msai2t(p,1) + timwt(2)*msai2t(p,2) + htop_driver(p) = timwt(1)*mhvt2t(p,1) + timwt(2)*mhvt2t(p,2) + hbot_driver(p) = timwt(1)*mhvb2t(p,1) + timwt(2)*mhvb2t(p,2) + + end do + end associate + + end subroutine GetSatellitePhenologyInputs + + !============================================================================== + + subroutine SetSPModeCanopyStructs(bounds, num_filter, filter, & + waterdiagnosticbulk_inst, canopystate_inst) + ! + ! !DESCRIPTION: + ! Ecosystem dynamics: phenology, vegetation + ! Sets the canopystate_inst% data structure for non-FATES runs + ! + ! !USES: + use pftconMod , only : noveg, nbrdlf_dcd_brl_shrub + use WaterDiagnosticBulkType , only : waterdiagnosticbulk_type + use CanopyStateType , only : canopystate_type + use PatchType , only : patch + use clm_varctl , only : use_fates_sp + + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_filter ! number of column points in patch filter + integer , intent(in) :: filter(bounds%endp-bounds%begp+1) ! patch filter points + type(waterdiagnosticbulk_type) , intent(in) :: waterdiagnosticbulk_inst + type(canopystate_type) , intent(inout) :: canopystate_inst + + if (use_fates_sp) then + return ! we should not be here + end if + + associate( & + frac_sno => waterdiagnosticbulk_inst%frac_sno_col , & ! Input: [real(r8) (:) ] fraction of ground covered by snow (0 to 1) + snow_depth => waterdiagnosticbulk_inst%snow_depth_col , & ! Input: [real(r8) (:) ] snow height (m) + tlai_driver => canopystate_inst%tlai_input_patch , & ! Input: [real(r8) (:) ] SP driver data for one-sided leaf area index, no burying by snow + tsai_driver => canopystate_inst%tsai_input_patch , & ! Input: [real(r8) (:) ] SP driver data for one-sided stem area index, no burying by snow + tlai => canopystate_inst%tlai_patch, & ! Output: [real(r8) (:)] one-sided leaf area index, no burying by snow + tsai => canopystate_inst%tsai_patch, & ! Output: [real(r8) (:)] one-sided stem area index, no burying by snow + elai => canopystate_inst%elai_patch , & ! Output: [real(r8) (:) ] one-sided leaf area index with burying by snow + esai => canopystate_inst%esai_patch , & ! Output: [real(r8) (:) ] one-sided stem area index with burying by snow + htop_driver => canopystate_inst%htop_input_patch , & ! Input: [real(r8) (:) ] SP driver data for canopy top (m) + hbot_driver => canopystate_inst%hbot_input_patch , & ! Input: [real(r8) (:) ] SP driver data for canopy bottom (m) + htop => canopystate_inst%htop_patch , & ! Output: [real(r8) (:) ] canopy top (m) + hbot => canopystate_inst%hbot_patch , & ! Output: [real(r8) (:) ] canopy bottom (m) + frac_veg_nosno_alb => canopystate_inst%frac_veg_nosno_alb_patch & ! Output: [integer (:) ] fraction of vegetation not covered by snow (0 OR 1) [-] + ) + + do fp = 1, num_filter + + p = filter(fp) + c = patch%column(p) + + ! for regular CLM (non-FATES), this is just a 1:1 mapping + tlai(p) = tlai_driver + tsai(p) = tsai_driver + htop(p) = htop_driver + hbot(p) = hbot_driver + + ! adjust lai and sai for burying by snow. if exposed lai and sai + ! are less than 0.05, set equal to zero to prevent numerical + ! problems associated with very small lai and sai. + + ! snow burial fraction for short vegetation (e.g. grasses, crops) changes with vegetation height + ! accounts for a 20% bending factor, as used in Lombardozzi et al. (2018) GRL 45(18), 9889-9897 + + ! NOTE: The following snow burial code is duplicated in CNVegStructUpdateMod. + ! Changes in one place should be accompanied by similar changes in the other. + + if (patch%itype(p) > noveg .and. patch%itype(p) <= nbrdlf_dcd_brl_shrub) then + ol = min(max(snow_depth(c) - hbot(p), 0.0_r8), htop(p) - hbot(p)) + fb = 1._r8 - ol / max(1.e-06_r8, htop(p)-hbot(p)) + else + fb = 1._r8 - (max(min(snow_depth(c),max(0.05,htop(p)*0.8_r8)),0._r8)/(max(0.05,htop(p)*0.8_r8))) + endif - ! Do not set these in FATES_SP mode as they turn on the 'vegsol' filter and also - ! are duplicated by the FATE variables (in the FATES IFP indexing space) - elai(p) = max(tlai(p)*(1.0_r8 - frac_sno(c)) + tlai(p)*fb*frac_sno(c), 0.0_r8) - esai(p) = max(tsai(p)*(1.0_r8 - frac_sno(c)) + tsai(p)*fb*frac_sno(c), 0.0_r8) - if (elai(p) < 0.05_r8) elai(p) = 0._r8 - if (esai(p) < 0.05_r8) esai(p) = 0._r8 + elai(p) = max(tlai(p)*(1.0_r8 - frac_sno(c)) + tlai(p)*fb*frac_sno(c), 0.0_r8) + esai(p) = max(tsai(p)*(1.0_r8 - frac_sno(c)) + tsai(p)*fb*frac_sno(c), 0.0_r8) + if (elai(p) < 0.05_r8) elai(p) = 0._r8 + if (esai(p) < 0.05_r8) esai(p) = 0._r8 - ! Fraction of vegetation free of snow + ! Fraction of vegetation free of snow + if ((elai(p) + esai(p)) >= 0.05_r8) then + frac_veg_nosno_alb(p) = 1 + else + frac_veg_nosno_alb(p) = 0 + end if - if ((elai(p) + esai(p)) >= 0.05_r8) then - frac_veg_nosno_alb(p) = 1 - else - frac_veg_nosno_alb(p) = 0 - end if - endif !fates_sp - end do ! end of patch loop + end do ! end of patch loop end associate - end subroutine SatellitePhenology + end subroutine SetSPModeCanopyStructs !============================================================================== subroutine interpMonthlyVeg (bounds, canopystate_inst) diff --git a/src/cpl/share_esmf/laiStreamMod.F90 b/src/cpl/share_esmf/laiStreamMod.F90 index d471481c6f..64ee045390 100644 --- a/src/cpl/share_esmf/laiStreamMod.F90 +++ b/src/cpl/share_esmf/laiStreamMod.F90 @@ -259,10 +259,10 @@ subroutine lai_interp(bounds, canopystate_inst) if (ivt /= noveg) then ! vegetated pft ig = g_to_ig(patch%gridcell(p)) - canopystate_inst%tlai_patch(p) = dataptr2d(ig,ivt) + canopystate_inst%tlai_input_patch(p) = dataptr2d(ig,ivt) else ! non-vegetated pft - canopystate_inst%tlai_patch(p) = 0._r8 + canopystate_inst%tlai_input_patch(p) = 0._r8 endif end do deallocate(dataptr2d) diff --git a/src/utils/clmfates_interfaceMod.F90 b/src/utils/clmfates_interfaceMod.F90 index 269189d1b7..4da3972142 100644 --- a/src/utils/clmfates_interfaceMod.F90 +++ b/src/utils/clmfates_interfaceMod.F90 @@ -1172,9 +1172,9 @@ subroutine dynamics_driv(this, nc, bounds_clump, & do ft = surfpft_lb,surfpft_ub ! here we are mapping from P space in the HLM to FT space in the sp_input arrays. p = ft + col%patchi(c) ! for an FT of 1 we want to use - this%fates(nc)%bc_in(s)%hlm_sp_tlai(ft) = canopystate_inst%tlai_patch(p) - this%fates(nc)%bc_in(s)%hlm_sp_tsai(ft) = canopystate_inst%tsai_patch(p) - this%fates(nc)%bc_in(s)%hlm_sp_htop(ft) = canopystate_inst%htop_patch(p) + this%fates(nc)%bc_in(s)%hlm_sp_tlai(ft) = canopystate_inst%tlai_input_patch(p) + this%fates(nc)%bc_in(s)%hlm_sp_tsai(ft) = canopystate_inst%tsai_input_patch(p) + this%fates(nc)%bc_in(s)%hlm_sp_htop(ft) = canopystate_inst%htop_input_patch(p) if(canopystate_inst%htop_patch(p).lt.1.0e-20)then ! zero htop causes inifinite/nans. This is this%fates(nc)%bc_in(s)%hlm_sp_htop(ft) = 0.01_r8 endif @@ -1593,15 +1593,10 @@ subroutine wrap_update_hlmfates_dyn(this, nc, bounds_clump, & esai(col%patchi(c):col%patchf(c)) = 0.0_r8 hbot(col%patchi(c):col%patchf(c)) = 0.0_r8 - if(use_fates_sp)then - canopystate_inst%tlai_hist_patch(col%patchi(c):col%patchf(c)) = 0.0_r8 - canopystate_inst%tsai_hist_patch(col%patchi(c):col%patchf(c)) = 0.0_r8 - canopystate_inst%htop_hist_patch(col%patchi(c):col%patchf(c)) = 0.0_r8 - else - tlai(col%patchi(c):col%patchf(c)) = 0.0_r8 - tsai(col%patchi(c):col%patchf(c)) = 0.0_r8 - htop(col%patchi(c):col%patchf(c)) = 0.0_r8 - endif + tlai(col%patchi(c):col%patchf(c)) = 0.0_r8 + tsai(col%patchi(c):col%patchf(c)) = 0.0_r8 + htop(col%patchi(c):col%patchf(c)) = 0.0_r8 + ! FATES does not dictate bare-ground so turbulent ! variables are not over-written. @@ -1646,17 +1641,11 @@ subroutine wrap_update_hlmfates_dyn(this, nc, bounds_clump, & esai(p) = this%fates(nc)%bc_out(s)%esai_pa(ifp) hbot(p) = this%fates(nc)%bc_out(s)%hbot_pa(ifp) - if(use_fates_sp)then - canopystate_inst%tlai_hist_patch(p) = this%fates(nc)%bc_out(s)%tlai_pa(ifp) - canopystate_inst%tsai_hist_patch(p) = this%fates(nc)%bc_out(s)%tsai_pa(ifp) - canopystate_inst%htop_hist_patch(p) = this%fates(nc)%bc_out(s)%htop_pa(ifp) - else - tlai(p) = this%fates(nc)%bc_out(s)%tlai_pa(ifp) - tsai(p) = this%fates(nc)%bc_out(s)%tsai_pa(ifp) - htop(p) = this%fates(nc)%bc_out(s)%htop_pa(ifp) - endif + tlai(p) = this%fates(nc)%bc_out(s)%tlai_pa(ifp) + tsai(p) = this%fates(nc)%bc_out(s)%tsai_pa(ifp) + htop(p) = this%fates(nc)%bc_out(s)%htop_pa(ifp) - if(use_fates_sp.and.abs(canopystate_inst%tlai_hist_patch(p) - & + if(use_fates_sp.and.abs(canopystate_inst%tlai_patch(p) - & this%fates(nc)%bc_out(s)%tlai_pa(ifp)).gt.1e-09)then write(iulog,*) 'fates lai not like hlm lai',tlai(p),this%fates(nc)%bc_out(s)%tlai_pa(ifp),ifp endif @@ -1951,9 +1940,9 @@ subroutine restart( this, bounds_proc, ncid, flag, waterdiagnosticbulk_inst, & do ft = surfpft_lb,surfpft_ub !set of pfts in HLM ! here we are mapping from P space in the HLM to FT space in the sp_input arrays. p = ft + col%patchi(c) ! for an FT of 1 we want to use - this%fates(nc)%bc_in(s)%hlm_sp_tlai(ft) = canopystate_inst%tlai_patch(p) - this%fates(nc)%bc_in(s)%hlm_sp_tsai(ft) = canopystate_inst%tsai_patch(p) - this%fates(nc)%bc_in(s)%hlm_sp_htop(ft) = canopystate_inst%htop_patch(p) + this%fates(nc)%bc_in(s)%hlm_sp_tlai(ft) = canopystate_inst%tlai_input_patch(p) + this%fates(nc)%bc_in(s)%hlm_sp_tsai(ft) = canopystate_inst%tsai_input_patch(p) + this%fates(nc)%bc_in(s)%hlm_sp_htop(ft) = canopystate_inst%htop_input_patch(p) if(canopystate_inst%htop_patch(p).lt.1.0e-20)then ! zero htop causes inifinite/nans. This is this%fates(nc)%bc_in(s)%hlm_sp_htop(ft) = 0.01_r8 endif @@ -2106,9 +2095,9 @@ subroutine init_coldstart(this, waterstatebulk_inst, waterdiagnosticbulk_inst, & do ft = surfpft_lb,surfpft_ub ! here we are mapping from P space in the HLM to FT space in the sp_input arrays. p = ft + col%patchi(c) ! for an FT of 1 we want to use - this%fates(nc)%bc_in(s)%hlm_sp_tlai(ft) = canopystate_inst%tlai_patch(p) - this%fates(nc)%bc_in(s)%hlm_sp_tsai(ft) = canopystate_inst%tsai_patch(p) - this%fates(nc)%bc_in(s)%hlm_sp_htop(ft) = canopystate_inst%htop_patch(p) + this%fates(nc)%bc_in(s)%hlm_sp_tlai(ft) = canopystate_inst%tlai_input_patch(p) + this%fates(nc)%bc_in(s)%hlm_sp_tsai(ft) = canopystate_inst%tsai_input_patch(p) + this%fates(nc)%bc_in(s)%hlm_sp_htop(ft) = canopystate_inst%htop_input_patch(p) if(canopystate_inst%htop_patch(p).lt.1.0e-20)then ! zero htop causes inifinite/nans. This is this%fates(nc)%bc_in(s)%hlm_sp_htop(ft) = 0.01_r8 endif