From b73443f36dc0d5da1bc0d1f3320dbf6338d6cf8c Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Thu, 24 Apr 2025 11:50:29 -0400 Subject: [PATCH 1/2] Fixes to rad_error to accomodate zenith and do-albedo consistency --- biogeochem/EDPatchDynamicsMod.F90 | 4 - biogeochem/FatesPatchMod.F90 | 17 +- main/FatesHistoryInterfaceMod.F90 | 313 ++++++++++++++------------- main/FatesInterfaceMod.F90 | 12 +- radiation/FatesNormanRadMod.F90 | 6 +- radiation/FatesRadiationDriveMod.F90 | 60 ++--- 6 files changed, 203 insertions(+), 209 deletions(-) diff --git a/biogeochem/EDPatchDynamicsMod.F90 b/biogeochem/EDPatchDynamicsMod.F90 index b1fc9af66d..b37b080ea4 100644 --- a/biogeochem/EDPatchDynamicsMod.F90 +++ b/biogeochem/EDPatchDynamicsMod.F90 @@ -3213,10 +3213,6 @@ subroutine fuse_2_patches(csite, dp, rp) rp%c_stomata = (dp%c_stomata*dp%area + rp%c_stomata*rp%area) * inv_sum_area rp%c_lblayer = (dp%c_lblayer*dp%area + rp%c_lblayer*rp%area) * inv_sum_area - ! Radiation - rp%rad_error(1) = (dp%rad_error(1)*dp%area + rp%rad_error(1)*rp%area) * inv_sum_area - rp%rad_error(2) = (dp%rad_error(2)*dp%area + rp%rad_error(2)*rp%area) * inv_sum_area - rp%area = rp%area + dp%area !THIS MUST COME AT THE END! !insert donor cohorts into recipient patch diff --git a/biogeochem/FatesPatchMod.F90 b/biogeochem/FatesPatchMod.F90 index 9b3b9ef919..a0b6b3ac1a 100644 --- a/biogeochem/FatesPatchMod.F90 +++ b/biogeochem/FatesPatchMod.F90 @@ -128,8 +128,8 @@ module FatesPatchMod real(r8) :: c_stomata ! mean stomatal conductance of all leaves in the patch [umol/m2/s] real(r8) :: c_lblayer ! mean boundary layer conductance of all leaves in the patch [umol/m2/s] - real(r8),allocatable :: nrmlzd_parprof_pft_dir_z(:,:,:,:) !num_rad_stream_types,nclmax,maxpft,nlevleaf) - real(r8),allocatable :: nrmlzd_parprof_pft_dif_z(:,:,:,:) !num_rad_stream_types,nclmax,maxpft,nlevleaf) + real(r8),allocatable :: nrmlzd_parprof_pft_dir_z(:,:,:) ! nclmax,maxpft,nlevleaf) + real(r8),allocatable :: nrmlzd_parprof_pft_dif_z(:,:,:) ! nclmax,maxpft,nlevleaf) !--------------------------------------------------------------------------- @@ -369,8 +369,8 @@ subroutine ReAllocateDynamics(this) allocate(this%fabd_sha_z(ncan,numpft,nveg)) allocate(this%fabi_sun_z(ncan,numpft,nveg)) allocate(this%fabi_sha_z(ncan,numpft,nveg)) - allocate(this%nrmlzd_parprof_pft_dir_z(num_rad_stream_types,ncan,numpft,nveg)) - allocate(this%nrmlzd_parprof_pft_dif_z(num_rad_stream_types,ncan,numpft,nveg)) + allocate(this%nrmlzd_parprof_pft_dir_z(ncan,numpft,nveg)) + allocate(this%nrmlzd_parprof_pft_dif_z(ncan,numpft,nveg)) allocate(this%ed_parsun_z(ncan,numpft,nveg)) allocate(this%ed_parsha_z(ncan,numpft,nveg)) allocate(this%ed_laisun_z(ncan,numpft,nveg)) @@ -393,8 +393,8 @@ subroutine NanDynamics(this) this%tlai_profile(:,:,:) = nan this%tsai_profile(:,:,:) = nan this%canopy_area_profile(:,:,:) = nan - this%nrmlzd_parprof_pft_dir_z(:,:,:,:) = nan - this%nrmlzd_parprof_pft_dif_z(:,:,:,:) = nan + this%nrmlzd_parprof_pft_dir_z(:,:,:) = nan + this%nrmlzd_parprof_pft_dif_z(:,:,:) = nan this%fabd_sun_z(:,:,:) = nan this%fabd_sha_z(:,:,:) = nan @@ -521,8 +521,8 @@ subroutine ZeroDynamics(this) this%fabi_sun_z(:,:,:) = 0._r8 this%fabd_sha_z(:,:,:) = 0._r8 this%fabi_sha_z(:,:,:) = 0._r8 - this%nrmlzd_parprof_pft_dir_z(:,:,:,:) = 0._r8 - this%nrmlzd_parprof_pft_dif_z(:,:,:,:) = 0._r8 + this%nrmlzd_parprof_pft_dir_z(:,:,:) = 0._r8 + this%nrmlzd_parprof_pft_dif_z(:,:,:) = 0._r8 ! Added this%elai_profile(:,:,:) = 0._r8 @@ -562,7 +562,6 @@ subroutine ZeroValues(this) this%c_lblayer = 0.0_r8 ! RADIATION - this%rad_error(:) = 0.0_r8 this%tr_soil_dir_dif(:) = 0.0_r8 this%fab(:) = 0.0_r8 this%fabi(:) = 0.0_r8 diff --git a/main/FatesHistoryInterfaceMod.F90 b/main/FatesHistoryInterfaceMod.F90 index 454e89c899..e3f6ffa668 100644 --- a/main/FatesHistoryInterfaceMod.F90 +++ b/main/FatesHistoryInterfaceMod.F90 @@ -4962,14 +4962,13 @@ subroutine update_history_hifrq1(this,nc,nsites,sites,bc_in,bc_out,dt_tstep) sum_area_rad = sum(age_area_rad(:)) - if_anyrad: if(sum_area_rad sites(s)%oldest_patch do while(associated(cpatch)) if( abs(cpatch%rad_error(ivis))>nearzero ) then @@ -4979,7 +4978,7 @@ subroutine update_history_hifrq1(this,nc,nsites,sites,bc_in,bc_out,dt_tstep) cpatch%rad_error(ivis)*cpatch%total_canopy_area/sum_area_rad hio_nir_rad_err_si(io_si) = hio_nir_rad_err_si(io_si) + & cpatch%rad_error(inir)*cpatch%total_canopy_area/sum_area_rad - + end if cpatch => cpatch%younger end do @@ -5125,7 +5124,8 @@ subroutine update_history_hifrq2(this,nc,nsites,sites,bc_in,bc_out,dt_tstep) real(r8) :: clllpf_area ! area footprint (m2) for the current cl x ll x pft bin real(r8) :: clll_area ! area footprint (m2) for the cl x ll bin (ie adds up pfts in parallel) real(r8) :: cl_area ! total weight of all ll x pft bins in the canopy layer - + real(r8) :: parprof_pft_dir_z,parprof_pft_dif_z ! PAR intensity for dir/diff for pft/canopy/leaf layer (w/m2) + type(fates_patch_type),pointer :: cpatch type(fates_cohort_type),pointer :: ccohort real(r8) :: dt_tstep_inv ! Time step in frequency units (/s) @@ -5302,8 +5302,8 @@ subroutine update_history_hifrq2(this,nc,nsites,sites,bc_in,bc_out,dt_tstep) endif end associate endif - -!!! canopy leaf carbon balance + + ! canopy leaf carbon balance ican = ccohort%canopy_layer do ileaf=1,ccohort%nv cnlf_indx = ileaf + (ican-1) * nlevleaf @@ -5315,88 +5315,96 @@ subroutine update_history_hifrq2(this,nc,nsites,sites,bc_in,bc_out,dt_tstep) enddo ! cohort loop - ! summarize radiation profiles through the canopy - ! -------------------------------------------------------------------- + ! Radiation diagnostics + ! Only process diagnostics if the sun is out + if_zenith1: if( sites(s)%coszen>0._r8 ) then - do_pft1: do ipft=1,numpft - do_canlev1: do ican=1,cpatch%ncl_p - do_leaflev1: do ileaf=1,cpatch%nleaf(ican,ipft) + do_pft1: do ipft=1,numpft + do_canlev1: do ican=1,cpatch%ncl_p + do_leaflev1: do ileaf=1,cpatch%nrad(ican,ipft) - ! calculate where we are on multiplexed dimensions - clllpf_indx = ileaf + (ican-1) * nlevleaf + (ipft-1) * nlevleaf * nclmax - cnlf_indx = ileaf + (ican-1) * nlevleaf + ! calculate where we are on multiplexed dimensions + clllpf_indx = ileaf + (ican-1) * nlevleaf + (ipft-1) * nlevleaf * nclmax + cnlf_indx = ileaf + (ican-1) * nlevleaf - ! canopy_area_profile is the fraction of the total canopy area that - ! is occupied by this bin. If you add up the top leaf layer bins in the - ! top canopy layers, for all pfts, that should equal to 1 + ! canopy_area_profile is the fraction of the total canopy area that + ! is occupied by this bin. If you add up the top leaf layer bins in the + ! top canopy layers, for all pfts, that should equal to 1 - clllpf_area = cpatch%canopy_area_profile(ican,ipft,ileaf)*cpatch%total_canopy_area + clllpf_area = cpatch%canopy_area_profile(ican,ipft,ileaf)*cpatch%total_canopy_area - ! Canopy by leaf by pft level diagnostics - ! ------------------------------------------------------------------- - hio_parsun_z_si_cnlfpft(io_si,clllpf_indx) = hio_parsun_z_si_cnlfpft(io_si,clllpf_indx) + & - cpatch%ed_parsun_z(ican,ipft,ileaf) * clllpf_area + ! Canopy by leaf by pft level diagnostics + ! ------------------------------------------------------------------- + hio_parsun_z_si_cnlfpft(io_si,clllpf_indx) = hio_parsun_z_si_cnlfpft(io_si,clllpf_indx) + & + cpatch%ed_parsun_z(ican,ipft,ileaf) * clllpf_area - hio_parsha_z_si_cnlfpft(io_si,clllpf_indx) = hio_parsha_z_si_cnlfpft(io_si,clllpf_indx) + & - cpatch%ed_parsha_z(ican,ipft,ileaf) * clllpf_area + hio_parsha_z_si_cnlfpft(io_si,clllpf_indx) = hio_parsha_z_si_cnlfpft(io_si,clllpf_indx) + & + cpatch%ed_parsha_z(ican,ipft,ileaf) * clllpf_area - ! elai_profile is the m2 of leaf inside the m2 of bin. + ! elai_profile is the m2 of leaf inside the m2 of bin. - hio_laisun_clllpf(io_si, clllpf_indx) = hio_laisun_clllpf(io_si, clllpf_indx) + & - cpatch%elai_profile(ican,ipft,ileaf)*cpatch%f_sun(ican,ipft,ileaf)*clllpf_area + hio_laisun_clllpf(io_si, clllpf_indx) = hio_laisun_clllpf(io_si, clllpf_indx) + & + cpatch%elai_profile(ican,ipft,ileaf)*cpatch%f_sun(ican,ipft,ileaf)*clllpf_area - hio_laisha_clllpf(io_si,clllpf_indx) = hio_laisha_clllpf(io_si,clllpf_indx) + & - cpatch%elai_profile(ican,ipft,ileaf)*(1._r8-cpatch%f_sun(ican,ipft,ileaf))*clllpf_area + hio_laisha_clllpf(io_si,clllpf_indx) = hio_laisha_clllpf(io_si,clllpf_indx) + & + cpatch%elai_profile(ican,ipft,ileaf)*(1._r8-cpatch%f_sun(ican,ipft,ileaf))*clllpf_area - hio_parprof_dir_si_cnlfpft(io_si,clllpf_indx) = hio_parprof_dir_si_cnlfpft(io_si,clllpf_indx) + & - cpatch%parprof_pft_dir_z(ican,ipft,ileaf) * clllpf_area + parprof_pft_dir_z = bc_in(s)%solad_parb(ifp,ipar) * & + cpatch%nrmlzd_parprof_pft_dir_z(ican,ipft,ileaf) - hio_parprof_dif_si_cnlfpft(io_si,clllpf_indx) = hio_parprof_dif_si_cnlfpft(io_si,clllpf_indx) + & - cpatch%parprof_pft_dif_z(ican,ipft,ileaf) * clllpf_area + parprof_pft_dif_z = bc_in(s)%solai_parb(ifp,ipar) * & + cpatch%nrmlzd_parprof_pft_dif_z(ican,ipft,ileaf) - ! The fractional area of Canopy layer and PFTs can be used - ! do upscale the CLLLPF properties - hio_crownfrac_clllpf(io_si,clllpf_indx) = hio_crownfrac_clllpf(io_si,clllpf_indx) + & - clllpf_area + hio_parprof_dir_si_cnlfpft(io_si,clllpf_indx) = hio_parprof_dir_si_cnlfpft(io_si,clllpf_indx) + & + parprof_pft_dir_z * clllpf_area + hio_parprof_dif_si_cnlfpft(io_si,clllpf_indx) = hio_parprof_dif_si_cnlfpft(io_si,clllpf_indx) + & + parprof_pft_dif_z * clllpf_area - ! Canopy by leaf layer (mean across pfts) level diagnostics - ! ---------------------------------------------------------------------------- - hio_parprof_dir_si_cnlf(io_si,cnlf_indx) = hio_parprof_dir_si_cnlf(io_si,cnlf_indx) + & - cpatch%parprof_pft_dir_z(ican,ipft,ileaf) * clllpf_area + ! The fractional area of Canopy layer and PFTs can be used + ! do upscale the CLLLPF properties + hio_crownfrac_clllpf(io_si,clllpf_indx) = hio_crownfrac_clllpf(io_si,clllpf_indx) + & + clllpf_area + + + ! Canopy by leaf layer (mean across pfts) level diagnostics + ! ---------------------------------------------------------------------------- + hio_parprof_dir_si_cnlf(io_si,cnlf_indx) = hio_parprof_dir_si_cnlf(io_si,cnlf_indx) + & + parprof_pft_dir_z * clllpf_area - hio_parprof_dif_si_cnlf(io_si,cnlf_indx) = hio_parprof_dif_si_cnlf(io_si,cnlf_indx) + & - cpatch%parprof_pft_dif_z(ican,ipft,ileaf) * clllpf_area + hio_parprof_dif_si_cnlf(io_si,cnlf_indx) = hio_parprof_dif_si_cnlf(io_si,cnlf_indx) + & + parprof_pft_dif_z * clllpf_area - hio_parsun_z_si_cnlf(io_si,cnlf_indx) = hio_parsun_z_si_cnlf(io_si,cnlf_indx) + & - cpatch%ed_parsun_z(ican,ipft,ileaf) * clllpf_area + hio_parsun_z_si_cnlf(io_si,cnlf_indx) = hio_parsun_z_si_cnlf(io_si,cnlf_indx) + & + cpatch%ed_parsun_z(ican,ipft,ileaf) * clllpf_area - hio_parsha_z_si_cnlf(io_si,cnlf_indx) = hio_parsha_z_si_cnlf(io_si,cnlf_indx) + & - cpatch%ed_parsha_z(ican,ipft,ileaf) * clllpf_area + hio_parsha_z_si_cnlf(io_si,cnlf_indx) = hio_parsha_z_si_cnlf(io_si,cnlf_indx) + & + cpatch%ed_parsha_z(ican,ipft,ileaf) * clllpf_area - hio_laisun_z_si_cnlf(io_si,cnlf_indx) = hio_laisun_z_si_cnlf(io_si,cnlf_indx) + & - cpatch%f_sun(ican,ipft,ileaf)*clllpf_area + hio_laisun_z_si_cnlf(io_si,cnlf_indx) = hio_laisun_z_si_cnlf(io_si,cnlf_indx) + & + cpatch%f_sun(ican,ipft,ileaf)*clllpf_area - hio_laisha_z_si_cnlf(io_si,cnlf_indx) = hio_laisha_z_si_cnlf(io_si,cnlf_indx) + & - (1._r8-cpatch%f_sun(ican,ipft,ileaf))*clllpf_area + hio_laisha_z_si_cnlf(io_si,cnlf_indx) = hio_laisha_z_si_cnlf(io_si,cnlf_indx) + & + (1._r8-cpatch%f_sun(ican,ipft,ileaf))*clllpf_area - ! Canopy mean diagnostics - ! -------------------------------------------------------------- + ! Canopy mean diagnostics + ! -------------------------------------------------------------- - hio_parsun_si_can(io_si,ican) = hio_parsun_si_can(io_si,ican) + & - cpatch%ed_parsun_z(ican,ipft,ileaf) * clllpf_area - hio_parsha_si_can(io_si,ican) = hio_parsha_si_can(io_si,ican) + & - cpatch%ed_parsha_z(ican,ipft,ileaf) * clllpf_area + hio_parsun_si_can(io_si,ican) = hio_parsun_si_can(io_si,ican) + & + cpatch%ed_parsun_z(ican,ipft,ileaf) * clllpf_area + hio_parsha_si_can(io_si,ican) = hio_parsha_si_can(io_si,ican) + & + cpatch%ed_parsha_z(ican,ipft,ileaf) * clllpf_area - hio_laisun_si_can(io_si,ican) = hio_laisun_si_can(io_si,ican) + & - cpatch%f_sun(ican,ipft,ileaf)*cpatch%elai_profile(ican,ipft,ileaf) * clllpf_area - hio_laisha_si_can(io_si,ican) = hio_laisha_si_can(io_si,ican) + & - (1._r8-cpatch%f_sun(ican,ipft,ileaf))*cpatch%elai_profile(ican,ipft,ileaf) * clllpf_area + hio_laisun_si_can(io_si,ican) = hio_laisun_si_can(io_si,ican) + & + cpatch%f_sun(ican,ipft,ileaf)*cpatch%elai_profile(ican,ipft,ileaf) * clllpf_area + hio_laisha_si_can(io_si,ican) = hio_laisha_si_can(io_si,ican) + & + (1._r8-cpatch%f_sun(ican,ipft,ileaf))*cpatch%elai_profile(ican,ipft,ileaf) * clllpf_area - end do do_leaflev1 - end do do_canlev1 - end do do_pft1 + end do do_leaflev1 + end do do_canlev1 + end do do_pft1 + end if if_zenith1 cpatch => cpatch%younger end do !patch loop @@ -5404,97 +5412,98 @@ subroutine update_history_hifrq2(this,nc,nsites,sites,bc_in,bc_out,dt_tstep) ! Normalize the radiation multiplexed diagnostics ! Set values that dont have canopy elements to ignore ! ---------------------------------------------------------------------------- - - do_ican2: do ican = 1,nclmax - - cl_area = 0._r8 - do_ileaf2: do ileaf = 1,nlevleaf - - clll_area = 0._r8 - do_ipft2: do ipft = 1,numpft - - clllpf_indx = ileaf + (ican-1) * nlevleaf + (ipft-1) * nlevleaf * nclmax - if( hio_crownfrac_clllpf(io_si,clllpf_indx)0._r8 ) then + do_ican2: do ican = 1,nclmax + + cl_area = 0._r8 + do_ileaf2: do ileaf = 1,nlevleaf + + clll_area = 0._r8 + do_ipft2: do ipft = 1,numpft + + clllpf_indx = ileaf + (ican-1) * nlevleaf + (ipft-1) * nlevleaf * nclmax + if( hio_crownfrac_clllpf(io_si,clllpf_indx)0._r8 )then select case(hlm_radiation_model) @@ -189,8 +191,26 @@ subroutine FatesNormalizedCanopyRadiation(sites, bc_in, bc_out ) call endrun(msg=errMsg(sourcefile, __LINE__)) end if end if - end do + + ! Fill in the diagnostic arrays for normalized radiation profiles + do_cl: do cl = 1,twostr%n_lyr + do_icol: do icol = 1,twostr%n_col(cl) + ft = twostr%scelg(cl,icol)%pft + nv = minloc(dlower_vai, DIM=1, MASK=(dlower_vai>vai)) + area_frac = twostr%scelg(cl,icol)%area + ! WAIT FOR THE BIN INDEXING PR TO GO IN ... + do iv = 1, nv + vai_top = dlower_vai(iv) + cpatch%nrmlzd_parprof_pft_dir_z(cl,ft,iv) = cpatch%nrmlzd_parprof_pft_dir_z(cl,ft,iv) + & + area_frac*twostr%GetRb(cl,icol,ivis,vai_top) + cpatch%nrmlzd_parprof_pft_dif_z(cl,ft,iv) = cpatch%nrmlzd_parprof_pft_dif_z(cl,ft,iv) + & + area_frac*twostr%GetRdDn(cl,icol,ivis,vai_top) + & + area_frac*twostr%GetRdUp(cl,icol,ivis,vai_top) + end do + end do do_icol + end do do_cl + end associate end select endif if_zenith_flag @@ -251,8 +271,6 @@ subroutine FatesSunShadeFracs(nsites, sites,bc_in,bc_out) cpatch%ed_parsha_z(:,:,:) = 0._r8 cpatch%ed_laisun_z(:,:,:) = 0._r8 cpatch%ed_laisha_z(:,:,:) = 0._r8 - cpatch%parprof_pft_dir_z(:,:,:) = 0._r8 - cpatch%parprof_pft_dif_z(:,:,:) = 0._r8 if_norm_twostr: if (hlm_radiation_model.eq.norman_solver) then @@ -317,29 +335,7 @@ subroutine FatesSunShadeFracs(nsites, sites,bc_in,bc_out) end do !ft end do !cl - ! Convert normalized radiation error units from fraction of radiation to W/m2 - do ib = 1,num_swb - cpatch%rad_error(ib) = cpatch%rad_error(ib) * & - (bc_in(s)%solad_parb(ifp,ib) + bc_in(s)%solai_parb(ifp,ib)) - end do - ! output the actual PAR profiles through the canopy for diagnostic purposes - do cl = 1, cpatch%ncl_p - do ft = 1,numpft - do iv = 1, cpatch%nrad(cl,ft) - cpatch%parprof_pft_dir_z(cl,ft,iv) = (bc_in(s)%solad_parb(ifp,ipar) * & - cpatch%nrmlzd_parprof_pft_dir_z(idirect,cl,ft,iv)) + & - (bc_in(s)%solai_parb(ifp,ipar) * & - cpatch%nrmlzd_parprof_pft_dir_z(idiffuse,cl,ft,iv)) - - cpatch%parprof_pft_dif_z(cl,ft,iv) = (bc_in(s)%solad_parb(ifp,ipar) * & - cpatch%nrmlzd_parprof_pft_dif_z(idirect,cl,ft,iv)) + & - (bc_in(s)%solai_parb(ifp,ipar) * & - cpatch%nrmlzd_parprof_pft_dif_z(idiffuse,cl,ft,iv)) - - end do ! iv - end do ! ft - end do ! cl else ! if_norm_twostr @@ -383,12 +379,6 @@ subroutine FatesSunShadeFracs(nsites, sites,bc_in,bc_out) vai_top = dlower_vai(iv)-dinc_vai(iv) vai_bot = min(dlower_vai(iv),twostr%scelg(cl,icol)%sai+twostr%scelg(cl,icol)%lai) - cpatch%parprof_pft_dir_z(cl,ft,iv) = cpatch%parprof_pft_dir_z(cl,ft,iv) + & - area_frac*twostr%GetRb(cl,icol,ivis,vai_top) - cpatch%parprof_pft_dif_z(cl,ft,iv) = cpatch%parprof_pft_dif_z(cl,ft,iv) + & - area_frac*twostr%GetRdDn(cl,icol,ivis,vai_top) + & - area_frac*twostr%GetRdUp(cl,icol,ivis,vai_top) - call twostr%GetAbsRad(cl,icol,ipar,vai_top,vai_bot, & Rb_abs,Rd_abs,Rd_abs_leaf,Rb_abs_leaf,R_abs_stem,R_abs_snow,leaf_sun_frac,call_fail) @@ -418,10 +408,6 @@ subroutine FatesSunShadeFracs(nsites, sites,bc_in,bc_out) do ft = 1,numpft do_iv: do iv = 1,cpatch%nleaf(cl,ft) if(area_vlpfcl(iv,ft,cl) Date: Tue, 6 May 2025 12:04:46 -0400 Subject: [PATCH 2/2] initializing radiation error diagnostics as ignore instead of zero. --- biogeochem/FatesPatchMod.F90 | 1 + main/FatesHistoryInterfaceMod.F90 | 12 ++++++++---- main/FatesRestartInterfaceMod.F90 | 3 ++- radiation/FatesRadiationDriveMod.F90 | 4 ++-- 4 files changed, 13 insertions(+), 7 deletions(-) diff --git a/biogeochem/FatesPatchMod.F90 b/biogeochem/FatesPatchMod.F90 index a0b6b3ac1a..0334dfc989 100644 --- a/biogeochem/FatesPatchMod.F90 +++ b/biogeochem/FatesPatchMod.F90 @@ -568,6 +568,7 @@ subroutine ZeroValues(this) this%fabd(:) = 0.0_r8 this%sabs_dir(:) = 0.0_r8 this%sabs_dif(:) = 0.0_r8 + this%rad_error(:) = hlm_hio_ignore_value ! ROOTS this%btran_ft(:) = 0.0_r8 diff --git a/main/FatesHistoryInterfaceMod.F90 b/main/FatesHistoryInterfaceMod.F90 index 436b735a34..8658adfc52 100644 --- a/main/FatesHistoryInterfaceMod.F90 +++ b/main/FatesHistoryInterfaceMod.F90 @@ -4978,6 +4978,11 @@ subroutine update_history_hifrq1(this,nc,nsites,sites,bc_in,bc_out,dt_tstep) ! We do not call the radiation solver if ! a) there is no vegetation ! b) there is no light! (ie cos(zenith) ~= 0) + ! c) the "do albedo" flag is true...but, this + ! may be false in coupled runs on alternate time-steps + ! and it is ok to carry over the previous errors + ! and diagnostics between these steps + age_area_rad(:) = 0._r8 cpatch => sites(s)%oldest_patch do while(associated(cpatch)) @@ -4986,7 +4991,7 @@ subroutine update_history_hifrq1(this,nc,nsites,sites,bc_in,bc_out,dt_tstep) ! solver was called. The solver will be called for NIR ! if VIS is called, and likewise the same for conservation ! error. So the check on VIS solve error will catch all. - if( abs(cpatch%rad_error(ivis))>nearzero ) then + if( abs(cpatch%rad_error(ivis)-hlm_hio_ignore_val)>nearzero ) then age_class = get_age_class_index(cpatch%age) age_area_rad(age_class) = age_area_rad(age_class) + cpatch%total_canopy_area end if @@ -4995,7 +5000,7 @@ subroutine update_history_hifrq1(this,nc,nsites,sites,bc_in,bc_out,dt_tstep) sum_area_rad = sum(age_area_rad(:)) - if_anyrad: if(sum_area_rad sites(s)%oldest_patch do while(associated(cpatch)) - if( abs(cpatch%rad_error(ivis))>nearzero ) then - age_class = get_age_class_index(cpatch%age) + if( abs(cpatch%rad_error(ivis)-hlm_hio_ignore_val)>nearzero ) then hio_vis_rad_err_si(io_si) = hio_vis_rad_err_si(io_si) + & cpatch%rad_error(ivis)*cpatch%total_canopy_area/sum_area_rad diff --git a/main/FatesRestartInterfaceMod.F90 b/main/FatesRestartInterfaceMod.F90 index f2c78051a1..9a6c9fcde1 100644 --- a/main/FatesRestartInterfaceMod.F90 +++ b/main/FatesRestartInterfaceMod.F90 @@ -29,6 +29,7 @@ module FatesRestartInterfaceMod use FatesInterfaceTypesMod, only : hlm_use_potentialveg use FatesInterfaceTypesMod, only : fates_maxElementsPerSite use FatesInterfaceTypesMod, only : hlm_use_tree_damage + use FatesInterfaceTypesMod, only : hlm_hio_ignore_val use FatesHydraulicsMemMod, only : nshell use FatesHydraulicsMemMod, only : n_hypool_ag use FatesHydraulicsMemMod, only : n_hypool_troot @@ -3875,7 +3876,7 @@ subroutine update_3dpatch_radiation(this, nsites, sites, bc_out) ! zero diagnostic radiation profiles currentPatch%nrmlzd_parprof_pft_dir_z(:,:,:,:) = 0._r8 currentPatch%nrmlzd_parprof_pft_dif_z(:,:,:,:) = 0._r8 - currentPatch%rad_error(:) = 0._r8 + currentPatch%rad_error(:) = hlm_hio_ignore_val if_notbareground: if(currentPatch%nocomp_pft_label.ne.nocomp_bareground) then diff --git a/radiation/FatesRadiationDriveMod.F90 b/radiation/FatesRadiationDriveMod.F90 index 28bf779bf6..d65c852219 100644 --- a/radiation/FatesRadiationDriveMod.F90 +++ b/radiation/FatesRadiationDriveMod.F90 @@ -32,7 +32,7 @@ module FatesRadiationDriveMod use TwoStreamMLPEMod, only : normalized_upper_boundary use FatesTwoStreamUtilsMod, only : FatesPatchFSun use FatesTwoStreamUtilsMod, only : CheckPatchRadiationBalance - use FatesInterfaceTypesMod , only : hlm_hio_ignore_val + use FatesInterfaceTypesMod, only : hlm_hio_ignore_val use EDParamsMod , only : dinc_vai,dlower_vai use EDParamsMod , only : nclmax use EDParamsMod , only : nlevleaf @@ -132,7 +132,7 @@ subroutine FatesNormalizedCanopyRadiation(sites, bc_in, bc_out ) currentPatch%gnd_alb_dif(1:num_swb) = bc_in(s)%albgr_dif_rb(1:num_swb) currentPatch%gnd_alb_dir(1:num_swb) = bc_in(s)%albgr_dir_rb(1:num_swb) currentPatch%fcansno = bc_in(s)%fcansno_pa(ifp) - currentPatch%rad_error(:) = 0._r8 + currentPatch%rad_error(:) = hlm_hio_ignore_val if_zenith_flag: if( bc_in(s)%coszen>0._r8 )then