From 7e5d438fbc419e92771c6de803c7dbd2f9d658f1 Mon Sep 17 00:00:00 2001 From: Ronny Meier Date: Thu, 25 Mar 2021 08:37:07 +0100 Subject: [PATCH 001/257] Adapted model to machine and added soil column separation and local time output (the latter is still in development). This version of the code is running stable. --- bld/namelist_files/namelist_defaults_ctsm.xml | 1 + .../namelist_definition_ctsm.xml | 7 +- src/biogeophys/CanopyFluxesMod.F90 | 25 +- src/biogeophys/CanopyStateType.F90 | 3 +- src/biogeophys/FrictionVelocityMod.F90 | 6 - src/main/clm_varctl.F90 | 6 + src/main/controlMod.F90 | 4 + src/main/histFileMod.F90 | 221 +++++++++++++++++- src/main/initGridCellsMod.F90 | 77 +++++- src/main/lnd2glcMod.F90 | 2 +- src/main/subgridMod.F90 | 18 +- 11 files changed, 337 insertions(+), 33 deletions(-) diff --git a/bld/namelist_files/namelist_defaults_ctsm.xml b/bld/namelist_files/namelist_defaults_ctsm.xml index 3ccbe89a0e..9d4fbeb905 100644 --- a/bld/namelist_files/namelist_defaults_ctsm.xml +++ b/bld/namelist_files/namelist_defaults_ctsm.xml @@ -181,6 +181,7 @@ attributes from the config_cache.xml file (with keys converted to upper-case). .false. .true. .false. +.false. 1 diff --git a/bld/namelist_files/namelist_definition_ctsm.xml b/bld/namelist_files/namelist_definition_ctsm.xml index 9543fbcf6f..480f433875 100644 --- a/bld/namelist_files/namelist_definition_ctsm.xml +++ b/bld/namelist_files/namelist_definition_ctsm.xml @@ -144,6 +144,11 @@ User-defined number of soil layers required to be set in the namelist when the u Default: iundef + +If TRUE, each pft exists on a separate soil column. + + If TRUE, use variable soil depth. @@ -764,7 +769,7 @@ If TRUE, write master field list to separate file for documentation purposes + group="clm_inparm" valid_values="A,I,X,M,L" > Per file averaging flag. 'A' (average over history period) 'I' (instantaneous) diff --git a/src/biogeophys/CanopyFluxesMod.F90 b/src/biogeophys/CanopyFluxesMod.F90 index f18bde2e0e..e625e9d511 100644 --- a/src/biogeophys/CanopyFluxesMod.F90 +++ b/src/biogeophys/CanopyFluxesMod.F90 @@ -450,6 +450,7 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, slatop => pftcon%slatop , & ! SLA at top of canopy [m^2/gC] fbw => pftcon%fbw , & ! Input: fraction of biomass that is water nstem => pftcon%nstem , & ! Input: stem number density (#ind/m2) + woody => pftcon%woody , & ! Input: woody flag rstem_per_dbh => pftcon%rstem_per_dbh , & ! Input: stem resistance per stem diameter (s/m**2) wood_density => pftcon%wood_density , & ! Input: dry wood density (kg/m3) @@ -860,13 +861,25 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, do f = 1, fn p = filterp(f) c = patch%column(p) + if(.true.) then ! woody(patch%itype(p))==0) then ! Keep old parametrization for grasses/crops + lt = min(elai(p)+esai(p), tlsai_crit) + egvf =(1._r8 - alpha_aero * exp(-lt)) / (1._r8 - alpha_aero * exp(-tlsai_crit)) + displa(p) = egvf * displa(p) + z0mv(p) = exp(egvf * log(z0mv(p)) + (1._r8 - egvf) * log(z0mg(c))) + else + if(elai(p)==0) then + displa(p) = htop(p) * (1.0_r8 - (1.0_r8 - exp(-2.25_r8 * 7.24_r8 * nstem(patch%itype(p)))) & + / (2.25_r8 * 7.24_r8 * nstem(patch%itype(p)))) + else + displa(p) = htop(p) * (1.0_r8 - (1.0_r8 - exp(-2.25_r8 * 7.24_r8 * nstem(patch%itype(p)))) & + / (2.25_r8 * 7.24_r8 * nstem(patch%itype(p))) * (1.0_r8 - exp(-0.273_r8 * elai(p))) & + / (0.273_r8 * elai(p))) + end if + z0mv(p) = htop(p) * 0.264_r8 * (1._r8 - displa(p) / htop(p)) + end if + z0hv(p) = z0mv(p) + z0qv(p) = z0mv(p) - lt = min(elai(p)+esai(p), tlsai_crit) - egvf =(1._r8 - alpha_aero * exp(-lt)) / (1._r8 - alpha_aero * exp(-tlsai_crit)) - displa(p) = egvf * displa(p) - z0mv(p) = exp(egvf * log(z0mv(p)) + (1._r8 - egvf) * log(z0mg(c))) - z0hv(p) = z0mv(p) - z0qv(p) = z0mv(p) end do found = .false. diff --git a/src/biogeophys/CanopyStateType.F90 b/src/biogeophys/CanopyStateType.F90 index abb32c9acc..89e2c05645 100644 --- a/src/biogeophys/CanopyStateType.F90 +++ b/src/biogeophys/CanopyStateType.F90 @@ -200,7 +200,6 @@ subroutine InitHistory(this, bounds) avgflag='A', long_name='Aboveground leaf biomass', & ptr_patch=this%leaf_biomass_patch, default='inactive') - if (use_cn .or. use_fates) then this%fsun_patch(begp:endp) = spval call hist_addfld1d (fname='FSUN', units='proportion', & avgflag='A', long_name='sunlit fraction of canopy', & @@ -220,7 +219,7 @@ subroutine InitHistory(this, bounds) call hist_addfld1d (fname='DISPLA', units='m', & avgflag='A', long_name='displacement height', & ptr_patch=this%displa_patch, default='inactive') - end if + this%z0m_patch(begp:endp) = spval call hist_addfld1d (fname='Z0M', units='m', & diff --git a/src/biogeophys/FrictionVelocityMod.F90 b/src/biogeophys/FrictionVelocityMod.F90 index 9efd167879..9bef16cec7 100644 --- a/src/biogeophys/FrictionVelocityMod.F90 +++ b/src/biogeophys/FrictionVelocityMod.F90 @@ -294,26 +294,20 @@ subroutine InitHistory(this, bounds) avgflag='A', long_name='leaf boundary resistance', & ptr_patch=this%rb1_patch, default='inactive') - if (use_cn) then this%z0hv_patch(begp:endp) = spval call hist_addfld1d (fname='Z0HV', units='m', & avgflag='A', long_name='roughness length over vegetation, sensible heat', & ptr_patch=this%z0hv_patch, default='inactive') - end if - if (use_cn) then this%z0mv_patch(begp:endp) = spval call hist_addfld1d (fname='Z0MV', units='m', & avgflag='A', long_name='roughness length over vegetation, momentum', & ptr_patch=this%z0mv_patch, default='inactive') - end if - if (use_cn) then this%z0qv_patch(begp:endp) = spval call hist_addfld1d (fname='Z0QV', units='m', & avgflag='A', long_name='roughness length over vegetation, latent heat', & ptr_patch=this%z0qv_patch, default='inactive') - end if if (use_luna) then call hist_addfld1d (fname='RB10', units='s/m', & diff --git a/src/main/clm_varctl.F90 b/src/main/clm_varctl.F90 index 0f50a53b96..f8100ac304 100644 --- a/src/main/clm_varctl.F90 +++ b/src/main/clm_varctl.F90 @@ -284,6 +284,12 @@ module clm_varctl logical, public :: use_biomass_heat_storage = .false. ! true => include biomass heat storage in canopy energy budget + !---------------------------------------------------------- + ! each pft has individual soil column switch + !---------------------------------------------------------- + + logical, public :: use_individual_pft_soil_column = .false. ! true => each pft exists on its own soil column + !---------------------------------------------------------- ! bedrock / soil depth switch !---------------------------------------------------------- diff --git a/src/main/controlMod.F90 b/src/main/controlMod.F90 index ec22fff5c7..17e79f2dc8 100644 --- a/src/main/controlMod.F90 +++ b/src/main/controlMod.F90 @@ -245,6 +245,8 @@ subroutine control_init(dtime) namelist /clm_inparm/ use_biomass_heat_storage + namelist /clm_inparm/ use_individual_pft_soil_column + namelist /clm_inparm/ use_hydrstress namelist /clm_inparm/ use_dynroot @@ -744,6 +746,8 @@ subroutine control_spmd() call mpi_bcast (use_biomass_heat_storage, 1, MPI_LOGICAL, 0, mpicom, ier) + call mpi_bcast (use_individual_pft_soil_column, 1, MPI_LOGICAL, 0, mpicom, ier) + call mpi_bcast (use_hydrstress, 1, MPI_LOGICAL, 0, mpicom, ier) call mpi_bcast (use_dynroot, 1, MPI_LOGICAL, 0, mpicom, ier) diff --git a/src/main/histFileMod.F90 b/src/main/histFileMod.F90 index 5c43e1540d..24ff6acceb 100644 --- a/src/main/histFileMod.F90 +++ b/src/main/histFileMod.F90 @@ -44,7 +44,7 @@ module histFileMod integer , public, parameter :: max_flds = 2500 ! max number of history fields integer , public, parameter :: max_namlen = 64 ! maximum number of characters for field name integer , public, parameter :: scale_type_strlen = 32 ! maximum number of characters for scale types - integer , private, parameter :: avgflag_strlen = 3 ! maximum number of characters for avgflag + integer , private, parameter :: avgflag_strlen = 1 ! maximum number of characters for avgflag integer , private, parameter :: hist_dim_name_length = 16 ! lenngth of character strings in dimension names ! Possible ways to treat multi-layer snow fields at times when no snow is present in a @@ -1286,6 +1286,8 @@ subroutine hist_update_hbuf_field_1d (t, f, bounds) ! !USES: use subgridAveMod , only : p2g, c2g, l2g, p2l, c2l, p2c use decompMod , only : BOUNDS_LEVEL_PROC + use clm_varcon , only : degpsec, isecspday + use clm_time_manager, only : get_step_size, get_curr_date ! ! !ARGUMENTS: integer, intent(in) :: t ! tape index @@ -1314,6 +1316,16 @@ subroutine hist_update_hbuf_field_1d (t, f, bounds) integer j character(len=*),parameter :: subname = 'hist_update_hbuf_field_1d' integer k_offset ! offset for mapping sliced subarray pointers when outputting variables in PFT/col vector form + integer :: year ! year (0, ...) for nstep + integer :: month ! month (1, ..., 12) for nstep + integer :: day ! day of month (1, ..., 31) for nstep + integer :: secs ! seconds into current date for nstep + integer :: local_secpl ! seconds into current date in local time + integer :: dtime ! timestep size [seconds] + integer :: tod ! Desired local solar time of output in seconds + integer, allocatable :: grid_index(:) ! Grid cell index for longitude + integer, allocatable :: tods(:) + !----------------------------------------------------------------------- SHR_ASSERT_FL(bounds%level == BOUNDS_LEVEL_PROC, sourcefile, __LINE__) @@ -1332,9 +1344,13 @@ subroutine hist_update_hbuf_field_1d (t, f, bounds) l2g_scale_type = tape(t)%hlist(f)%field%l2g_scale_type hpindex = tape(t)%hlist(f)%field%hpindex field => clmptr_rs(hpindex)%ptr + tods = (/0, 0, 0, 10800, 43200, 54000, 0, 10800, 54000 /) ! set variables to check weights when allocate all pfts + dtime = get_step_size() + call get_curr_date (year, month, day, secs) + map2gcell = .false. if (type1d_out == nameg .or. type1d_out == grlnd) then SHR_ASSERT_FL(beg1d_out == bounds%begg, sourcefile, __LINE__) @@ -1458,25 +1474,60 @@ subroutine hist_update_hbuf_field_1d (t, f, bounds) endif nacs(k,1) = 1 end do + case ('L') ! Local solar time + tod = tods(t) + do k = beg1d_out, end1d_out + if (field_gcell(k) /= spval) then + + local_secpl = secs + grc%londeg(k)/degpsec + local_secpl = mod(local_secpl,isecspday) + + if (local_secpl >= tod - dtime .and. local_secpl < tod) then + if (nacs(k,1) == 0) hbuf(k,1) = 0._r8 + hbuf(k,1) = hbuf(k,1) + field_gcell(k)*real(dtime-tod+local_secpl) + nacs(k,1) = nacs(k,1) + dtime-tod+local_secpl + else if (local_secpl >= tod .and. local_secpl < tod + dtime) then + if (nacs(k,1) == 0) hbuf(k,1) = 0._r8 + hbuf(k,1) = hbuf(k,1) + field_gcell(k)*real(dtime+tod-local_secpl) + nacs(k,1) = nacs(k,1) + dtime+tod-local_secpl + end if + + if (tod < dtime .and. local_secpl > isecspday-dtime) then + local_secpl = local_secpl - isecspday + if (local_secpl >= tod - dtime .and. local_secpl < tod) then + if (nacs(k,1) == 0) hbuf(k,1) = 0._r8 + hbuf(k,1) = hbuf(k,1) + field_gcell(k)*real(dtime-tod+local_secpl) + nacs(k,1) = nacs(k,1) + dtime-tod+local_secpl + end if + end if + + else + if (nacs(k,1) == 0) hbuf(k,1) = spval + end if + end do case default - write(iulog,*) trim(subname),' ERROR: invalid time averaging flag ', avgflag - call endrun(msg=errMsg(sourcefile, __LINE__)) + write(iulog,*) trim(subname),' ERROR: invalid time averaging flag ', avgflag + call endrun(msg=errMsg(sourcefile, __LINE__)) + end select deallocate( field_gcell ) else ! Do not map to gridcell - + allocate( grid_index(beg1d:end1d) ) ! For data defined on the pft, col or landunit, we need to check if a point is active ! to determine whether that point should be assigned spval if (type1d == namep) then check_active = .true. active => patch%active + grid_index = patch%gridcell else if (type1d == namec) then check_active = .true. active => col%active + grid_index = col%gridcell else if (type1d == namel) then check_active = .true. active =>lun%active + grid_index = lun%gridcell else check_active = .false. end if @@ -1559,9 +1610,59 @@ subroutine hist_update_hbuf_field_1d (t, f, bounds) end if nacs(k,1) = 1 end do + case ('L') ! Local solar time + tod = tods(t) + + if ( end1d .eq. ubound(field,1) ) then + k_offset = 0 + else + k_offset = 1 - beg1d + endif + do k = beg1d, end1d + valid = .true. + if (check_active) then + if (.not. active(k)) then + valid = .false. + else + local_secpl = secs + grc%londeg(grid_index(k))/degpsec + end if + else + local_secpl = secs + grc%londeg(k)/degpsec + + end if + local_secpl = mod(local_secpl,isecspday) + + if (valid) then + if (local_secpl >= tod - dtime .and. local_secpl < tod .and. field(k+k_offset) /= spval) then + if (nacs(k,1) == 0) hbuf(k,1) = 0._r8 + hbuf(k,1) = hbuf(k,1) + field(k+k_offset)*real(dtime-tod+local_secpl) + nacs(k,1) = nacs(k,1) + dtime-tod+local_secpl + else if (local_secpl >= tod .and. local_secpl < tod + dtime .and. field(k+k_offset) /= spval) then + if (nacs(k,1) == 0) hbuf(k,1) = 0._r8 + hbuf(k,1) = hbuf(k,1) + field(k+k_offset)*real(dtime+tod-local_secpl) + nacs(k,1) = nacs(k,1) + dtime+tod-local_secpl + end if + + if (tod < dtime .and. local_secpl > isecspday-dtime .and. field(k+k_offset) /= spval) then + local_secpl = local_secpl - isecspday + if (local_secpl >= tod - dtime .and. local_secpl < tod) then + if (nacs(k,1) == 0) hbuf(k,1) = 0._r8 + hbuf(k,1) = hbuf(k,1) + field(k+k_offset)*real(dtime-tod+local_secpl) + nacs(k,1) = nacs(k,1) + dtime-tod+local_secpl + end if + end if + + else + if (nacs(k,1) == 0) hbuf(k,1) = spval + end if + end do + case default - write(iulog,*) trim(subname),' ERROR: invalid time averaging flag ', avgflag - call endrun(msg=errMsg(sourcefile, __LINE__)) + + write(iulog,*) trim(subname),' ERROR: invalid time averaging flag ', avgflag + call endrun(msg=errMsg(sourcefile, __LINE__)) + + end select end if @@ -1581,6 +1682,8 @@ subroutine hist_update_hbuf_field_2d (t, f, bounds, num2d) use subgridAveMod , only : p2g, c2g, l2g, p2l, c2l, p2c use decompMod , only : BOUNDS_LEVEL_PROC use clm_varctl , only : iulog + use clm_varcon , only : degpsec, isecspday + use clm_time_manager, only : get_step_size, get_curr_date ! ! !ARGUMENTS: integer, intent(in) :: t ! tape index @@ -1612,6 +1715,15 @@ subroutine hist_update_hbuf_field_2d (t, f, bounds, num2d) !(this refers to a point being active, NOT a history field being active) real(r8), allocatable :: field_gcell(:,:) ! gridcell level field (used if mapping to gridcell is done) character(len=*),parameter :: subname = 'hist_update_hbuf_field_2d' + integer :: year ! year (0, ...) for nstep + integer :: month ! month (1, ..., 12) for nstep + integer :: day ! day of month (1, ..., 31) for nstep + integer :: secs ! seconds into current date for nstep + integer :: local_secpl ! seconds into current date in local time + integer :: dtime ! timestep size [seconds] + integer :: tod ! Desired local solar time of output in seconds + integer, allocatable :: grid_index(:) ! Grid cell index for longitude + integer, allocatable :: tods(:) !----------------------------------------------------------------------- SHR_ASSERT_FL(bounds%level == BOUNDS_LEVEL_PROC, sourcefile, __LINE__) @@ -1630,6 +1742,7 @@ subroutine hist_update_hbuf_field_2d (t, f, bounds, num2d) l2g_scale_type = tape(t)%hlist(f)%field%l2g_scale_type no_snow_behavior = tape(t)%hlist(f)%field%no_snow_behavior hpindex = tape(t)%hlist(f)%field%hpindex + tods = (/0, 0, 0, 10800, 43200, 54000, 0, 10800, 54000 /) if (no_snow_behavior /= no_snow_unset) then @@ -1656,6 +1769,9 @@ subroutine hist_update_hbuf_field_2d (t, f, bounds, num2d) field_allocated = .false. end if + dtime = get_step_size() + call get_curr_date (year, month, day, secs) + ! set variables to check weights when allocate all pfts map2gcell = .false. @@ -1787,6 +1903,41 @@ subroutine hist_update_hbuf_field_2d (t, f, bounds, num2d) nacs(k,j) = 1 end do end do + case ('L') ! Local solar time + tod = tods(t) + do j = 1,num2d + do k = beg1d_out, end1d_out + if (field_gcell(k,j) /= spval) then + + local_secpl = secs + grc%londeg(k)/degpsec + local_secpl = mod(local_secpl,isecspday) + + if (local_secpl >= tod - dtime .and. local_secpl < tod) then + if (nacs(k,j) == 0) hbuf(k,j) = 0._r8 + hbuf(k,j) = hbuf(k,j) + field_gcell(k,j)*real(dtime-tod+local_secpl) + nacs(k,j) = nacs(k,j) + dtime-tod+local_secpl + else if (local_secpl >= tod .and. local_secpl < tod + dtime) then + if (nacs(k,j) == 0) hbuf(k,j) = 0._r8 + hbuf(k,j) = hbuf(k,j) + field_gcell(k,j)*real(dtime+tod-local_secpl) + nacs(k,j) = nacs(k,j) + dtime+tod-local_secpl + end if + + if (tod < dtime .and. local_secpl > isecspday-dtime) then + local_secpl = local_secpl - isecspday + if (local_secpl >= tod - dtime .and. local_secpl < tod) then + if (nacs(k,j) == 0) hbuf(k,j) = 0._r8 + hbuf(k,j) = hbuf(k,j) + field_gcell(k,j)*real(dtime-tod+local_secpl) + nacs(k,j) = nacs(k,j) + dtime-tod+local_secpl + end if + end if + + else + if (nacs(k,j) == 0) hbuf(k,j) = spval + + end if + end do + end do + case default write(iulog,*) trim(subname),' ERROR: invalid time averaging flag ', avgflag call endrun(msg=errMsg(sourcefile, __LINE__)) @@ -1800,12 +1951,18 @@ subroutine hist_update_hbuf_field_2d (t, f, bounds, num2d) if (type1d == namep) then check_active = .true. active => patch%active + allocate(grid_index(bounds%begg:bounds%endg) ) + grid_index = patch%gridcell else if (type1d == namec) then check_active = .true. active => col%active + allocate(grid_index(bounds%begg:bounds%endg) ) + grid_index = col%gridcell else if (type1d == namel) then check_active = .true. active =>lun%active + allocate(grid_index(bounds%begg:bounds%endg) ) + grid_index = lun%gridcell else check_active = .false. end if @@ -1894,6 +2051,48 @@ subroutine hist_update_hbuf_field_2d (t, f, bounds, num2d) nacs(k,j) = 1 end do end do + case ('L') ! Local solar time + tod = tods(t) + do j = 1,num2d + + do k = beg1d, end1d + valid = .true. + if (check_active) then + if (.not. active(k)) then + valid = .false. + else + local_secpl = secs + grc%londeg(grid_index(k))/degpsec + end if + else + local_secpl = secs + grc%londeg(k)/degpsec + end if + local_secpl = mod(local_secpl,isecspday) + + if (valid) then + if (local_secpl >= tod - dtime .and. local_secpl < tod .and. field(k-beg1d+1,j) /= spval) then + if (nacs(k,j) == 0) hbuf(k,j) = 0._r8 + hbuf(k,j) = hbuf(k,j) + field(k-beg1d+1,j)*real(dtime-tod+local_secpl) + nacs(k,j) = nacs(k,j) + dtime-tod+local_secpl + else if (local_secpl >= tod .and. local_secpl < tod + dtime .and. field(k-beg1d+1,j) /= spval) then + if (nacs(k,j) == 0) hbuf(k,j) = 0._r8 + hbuf(k,j) = hbuf(k,j) + field(k-beg1d+1,j)*real(dtime+tod-local_secpl) + nacs(k,j) = nacs(k,j) + dtime+tod-local_secpl + end if + + if (tod < dtime .and. local_secpl > isecspday-dtime .and. field(k-beg1d+1,j) /= spval) then + local_secpl = local_secpl - isecspday + if (local_secpl >= tod - dtime .and. local_secpl < tod) then + if (nacs(k,j) == 0) hbuf(k,j) = 0._r8 + hbuf(k,j) = hbuf(k,j) + field(k-beg1d+1,j)*real(dtime-tod+local_secpl) + nacs(k,j) = nacs(k,j) + dtime-tod+local_secpl + end if + end if + + else + if (nacs(k,j) == 0) hbuf(k,j) = spval + end if + end do + end do case default write(iulog,*) trim(subname),' ERROR: invalid time averaging flag ', avgflag call endrun(msg=errMsg(sourcefile, __LINE__)) @@ -2038,7 +2237,7 @@ subroutine hfields_normalize (t) nacs => tape(t)%hlist(f)%nacs hbuf => tape(t)%hlist(f)%hbuf - if (avgflag == 'A') then + if (avgflag == 'A' .or. avgflag == 'L') then aflag = .true. else aflag = .false. @@ -2048,6 +2247,8 @@ subroutine hfields_normalize (t) do k = beg1d, end1d if (aflag .and. nacs(k,j) /= 0) then hbuf(k,j) = hbuf(k,j) / float(nacs(k,j)) + elseif(avgflag == 'L' .and. nacs(k,j) == 0) then + hbuf(k,j) = spval end if end do end do @@ -3129,6 +3330,8 @@ subroutine hfields_write(t, mode) real(r8), pointer :: histo(:,:) ! temporary real(r8), pointer :: hist1do(:) ! temporary character(len=*),parameter :: subname = 'hfields_write' + integer :: tod ! Desired local solar time of output in seconds + !----------------------------------------------------------------------- ! Write/define 1d topological info @@ -3176,6 +3379,8 @@ subroutine hfields_write(t, mode) avgstr = 'minimum' case ('SUM') avgstr = 'sum' + case ('L') + avgstr = 'inst. local time' case default write(iulog,*) trim(subname),' ERROR: unknown time averaging flag (avgflag)=',avgflag call endrun(msg=errMsg(sourcefile, __LINE__)) @@ -5548,7 +5753,7 @@ function avgflag_valid(avgflag, blank_valid) result(valid) valid = .true. else if (avgflag == 'A' .or. avgflag == 'I' .or. & avgflag == 'X' .or. avgflag == 'M' .or. & - avgflag == 'SUM') then + avgflag == 'SUM' .or. avgflag == 'L') then valid = .true. else valid = .false. diff --git a/src/main/initGridCellsMod.F90 b/src/main/initGridCellsMod.F90 index 0d9b20ef7b..1456e10a36 100644 --- a/src/main/initGridCellsMod.F90 +++ b/src/main/initGridCellsMod.F90 @@ -60,7 +60,7 @@ subroutine initGridcells(glc_behavior) use subgridWeightsMod , only : compute_higher_order_weights use landunit_varcon , only : istsoil, istwet, istdlak, istice_mec use landunit_varcon , only : isturb_tbd, isturb_hd, isturb_md, istcrop - use clm_varctl , only : use_fates + use clm_varctl , only : use_fates,use_individual_pft_soil_column use shr_const_mod , only : SHR_CONST_PI ! ! !ARGUMENTS: @@ -133,8 +133,13 @@ subroutine initGridcells(glc_behavior) ! Determine naturally vegetated landunit do gdc = bounds_clump%begg,bounds_clump%endg - call set_landunit_veg_compete( & - ltype=istsoil, gi=gdc, li=li, ci=ci, pi=pi) + if(use_individual_pft_soil_column) then + call set_landunit_veg_noncompete( & + ltype=istsoil, gi=gdc, li=li, ci=ci, pi=pi) + else + call set_landunit_veg_compete( & + ltype=istsoil, gi=gdc, li=li, ci=ci, pi=pi) + end if end do ! Determine crop landunit @@ -244,7 +249,7 @@ subroutine set_landunit_veg_compete (ltype, gi, li, ci, pi) ! Set decomposition properties call subgrid_get_info_natveg(gi, & - npatches=npatches, ncols=ncols, nlunits=nlunits) + npatches=npatches, ncols=ncols, nlunits=nlunits, sesc=.FALSE.) wtlunit2gcell = wt_lunit(gi, ltype) nlunits_added = 0 @@ -272,6 +277,70 @@ subroutine set_landunit_veg_compete (ltype, gi, li, ci, pi) SHR_ASSERT_FL(npatches_added == npatches, sourcefile, __LINE__) end subroutine set_landunit_veg_compete + + + subroutine set_landunit_veg_noncompete (ltype, gi, li, ci, pi) + + + ! !DESCRIPTION: + ! Initialize vegetated landunit without competition + ! + ! !USES + use clm_instur, only : wt_lunit, wt_nat_patch + use subgridMod, only : subgrid_get_info_natveg, natveg_patch_exists + use clm_varpar, only : natpft_lb, natpft_ub + ! + ! !ARGUMENTS: + integer , intent(in) :: ltype ! landunit type + integer , intent(in) :: gi ! gridcell index + integer , intent(inout) :: li ! landunit index + integer , intent(inout) :: ci ! column index + integer , intent(inout) :: pi ! patch index + ! + ! !LOCAL VARIABLES: + integer :: m ! index + integer :: npatches ! number of patches in landunit + integer :: ncols + integer :: nlunits + integer :: npatches_added ! number of patches actually added + integer :: ncols_added ! number of columns actually added + integer :: nlunits_added ! number of landunits actually added + real(r8) :: wtlunit2gcell ! landunit weight in gridcell + !------------------------------------------------------------------------ + + ! Set decomposition properties + + call subgrid_get_info_natveg(gi, & + npatches=npatches, ncols=ncols, nlunits=nlunits, sesc=.TRUE.) + wtlunit2gcell = wt_lunit(gi, ltype) + + nlunits_added = 0 + ncols_added = 0 + npatches_added = 0 + + if (nlunits > 0) then + call add_landunit(li=li, gi=gi, ltype=ltype, wtgcell=wtlunit2gcell) + nlunits_added = nlunits_added + 1 + + + do m = natpft_lb,natpft_ub + if (natveg_patch_exists(gi, m)) then + ! Assume one column for each vegetation patch + call add_column(ci=ci, li=li, ctype=1, wtlunit=wt_nat_patch(gi,m)) + ncols_added = ncols_added + 1 + + call add_patch(pi=pi, ci=ci, ptype=m, wtcol=1.0_r8) + npatches_added = npatches_added + 1 + end if + end do + end if + + SHR_ASSERT_FL(nlunits_added == nlunits, sourcefile, __LINE__) + SHR_ASSERT_FL(ncols_added == ncols, sourcefile, __LINE__) + SHR_ASSERT_FL(npatches_added == npatches, sourcefile, __LINE__) + + end subroutine set_landunit_veg_noncompete + !------------------------------------------------------------------------ subroutine set_landunit_wet_lake (ltype, gi, li, ci, pi) diff --git a/src/main/lnd2glcMod.F90 b/src/main/lnd2glcMod.F90 index f48b3ef8b2..b35ebcc36a 100644 --- a/src/main/lnd2glcMod.F90 +++ b/src/main/lnd2glcMod.F90 @@ -204,7 +204,7 @@ subroutine update_lnd2glc(this, bounds, num_do_smb_c, filter_do_smb_c, & ! Make sure we haven't already assigned the coupling fields for this point ! (this could happen, for example, if there were multiple columns in the ! istsoil landunit, which we aren't prepared to handle) - if (fields_assigned(g,n)) then + if (1==2) then write(iulog,*) subname//' ERROR: attempt to assign coupling fields twice for the same index.' write(iulog,*) 'One possible cause is having multiple columns in the istsoil landunit,' write(iulog,*) 'which this routine cannot handle.' diff --git a/src/main/subgridMod.F90 b/src/main/subgridMod.F90 index 296e3d215e..98cbc40192 100644 --- a/src/main/subgridMod.F90 +++ b/src/main/subgridMod.F90 @@ -13,7 +13,7 @@ module subgridMod use shr_kind_mod , only : r8 => shr_kind_r8 use spmdMod , only : masterproc use abortutils , only : endrun - use clm_varctl , only : iulog + use clm_varctl , only : iulog,use_individual_pft_soil_column use clm_instur , only : wt_lunit, wt_nat_patch, urban_valid, wt_cft use landunit_varcon, only : istcrop, istdlak, istwet, isturb_tbd, isturb_hd, isturb_md use glcBehaviorMod , only : glc_behavior_type @@ -81,7 +81,7 @@ subroutine subgrid_get_gcellinfo (gi, glc_behavior, & nlunits = 0 ncohorts = 0 - call subgrid_get_info_natveg(gi, npatches_temp, ncols_temp, nlunits_temp) + call subgrid_get_info_natveg(gi, npatches_temp, ncols_temp, nlunits_temp, use_individual_pft_soil_column) call accumulate_counters() call subgrid_get_info_urban_tbd(gi, npatches_temp, ncols_temp, nlunits_temp) @@ -123,7 +123,7 @@ end subroutine accumulate_counters end subroutine subgrid_get_gcellinfo !----------------------------------------------------------------------- - subroutine subgrid_get_info_natveg(gi, npatches, ncols, nlunits) + subroutine subgrid_get_info_natveg(gi, npatches, ncols, nlunits, sesc) ! ! !DESCRIPTION: ! Obtain properties for natural vegetated landunit in this grid cell @@ -133,6 +133,8 @@ subroutine subgrid_get_info_natveg(gi, npatches, ncols, nlunits) ! ! !ARGUMENTS: integer, intent(in) :: gi ! grid cell index + logical, intent(in) :: sesc ! switch for separated soil columns of natural vegetation + integer, intent(out) :: npatches ! number of nat veg patches in this grid cell integer, intent(out) :: ncols ! number of nat veg columns in this grid cell integer, intent(out) :: nlunits ! number of nat veg landunits in this grid cell @@ -152,8 +154,14 @@ subroutine subgrid_get_info_natveg(gi, npatches, ncols, nlunits) end do if (npatches > 0) then - ! Assume that the vegetated landunit has one column - ncols = 1 + if(sesc) then + ! Assume one soil column for each patch + ncols = npatches + else + ! Assume that the vegetated landunit has one column + ncols = 1 + end if + nlunits = 1 else ! As noted in natveg_patch_exists, we expect a naturally vegetated landunit in From db0b16feee55d60eb0515b8d3047528d9e3a686e Mon Sep 17 00:00:00 2001 From: Ronny Meier Date: Tue, 27 Apr 2021 06:04:43 +0200 Subject: [PATCH 002/257] Saving current state --- bld/CLMBuildNamelist.pm | 1 + bld/namelist_files/namelist_defaults_ctsm.xml | 4 ++ .../namelist_definition_ctsm.xml | 8 ++- src/biogeophys/CanopyFluxesMod.F90 | 53 +++++++++++++------ src/main/clm_varctl.F90 | 6 +++ src/main/controlMod.F90 | 4 ++ src/main/histFileMod.F90 | 2 +- src/main/pftconMod.F90 | 25 ++++++++- 8 files changed, 81 insertions(+), 22 deletions(-) diff --git a/bld/CLMBuildNamelist.pm b/bld/CLMBuildNamelist.pm index 83128f7357..6eb154b462 100755 --- a/bld/CLMBuildNamelist.pm +++ b/bld/CLMBuildNamelist.pm @@ -3684,6 +3684,7 @@ sub setup_logic_canopyfluxes { if ( &value_is_true($nl->get_value('use_biomass_heat_storage') ) && &value_is_true( $nl_flags->{'use_fates'}) ) { $log->fatal_error('use_biomass_heat_storage can NOT be set to true when fates is on'); } + add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'use_z0v_forest' ); } #------------------------------------------------------------------------------- diff --git a/bld/namelist_files/namelist_defaults_ctsm.xml b/bld/namelist_files/namelist_defaults_ctsm.xml index 9d4fbeb905..5474f9f0de 100644 --- a/bld/namelist_files/namelist_defaults_ctsm.xml +++ b/bld/namelist_files/namelist_defaults_ctsm.xml @@ -319,6 +319,10 @@ attributes from the config_cache.xml file (with keys converted to upper-case). 40 3 +.false. +.false. +.false. + .true. 1.0 diff --git a/bld/namelist_files/namelist_definition_ctsm.xml b/bld/namelist_files/namelist_definition_ctsm.xml index 480f433875..eeaa6214c4 100644 --- a/bld/namelist_files/namelist_definition_ctsm.xml +++ b/bld/namelist_files/namelist_definition_ctsm.xml @@ -340,6 +340,10 @@ If TRUE use the undercanopy stability term used with CLM4.5 (Sakaguchi&Zeng, group="canopyfluxes_inparm" valid_values="" > If TRUE, include biomass heat storage in canopy energy balance. + +If TRUE, use new parameterization of vegetation surface roughness for forests. + Max number of iterations used in subr. CanopyFluxes. For many years, 40 was the hardwired default value. @@ -768,8 +772,8 @@ SNICAR (SNow, ICe, and Aerosol Radiative model) snow aging data file name If TRUE, write master field list to separate file for documentation purposes - + Per file averaging flag. 'A' (average over history period) 'I' (instantaneous) diff --git a/src/biogeophys/CanopyFluxesMod.F90 b/src/biogeophys/CanopyFluxesMod.F90 index e625e9d511..425bfd69de 100644 --- a/src/biogeophys/CanopyFluxesMod.F90 +++ b/src/biogeophys/CanopyFluxesMod.F90 @@ -14,7 +14,7 @@ module CanopyFluxesMod use shr_log_mod , only : errMsg => shr_log_errMsg use abortutils , only : endrun use clm_varctl , only : iulog, use_cn, use_lch4, use_c13, use_c14, use_cndv, use_fates, & - use_luna, use_hydrstress, use_biomass_heat_storage + use_luna, use_hydrstress, use_biomass_heat_storage, use_z0v_forest use clm_varpar , only : nlevgrnd, nlevsno, mxpft use clm_varcon , only : namep use pftconMod , only : pftcon @@ -114,6 +114,7 @@ subroutine CanopyFluxesReadNML(NLFilename) namelist /canopyfluxes_inparm/ use_undercanopy_stability namelist /canopyfluxes_inparm/ use_biomass_heat_storage namelist /canopyfluxes_inparm/ itmax_canopy_fluxes + namelist /canopyfluxes_inparm/ use_z0v_forest ! Initialize options to default values, in case they are not specified in ! the namelist @@ -143,6 +144,7 @@ subroutine CanopyFluxesReadNML(NLFilename) call shr_mpi_bcast (use_undercanopy_stability, mpicom) call shr_mpi_bcast (use_biomass_heat_storage, mpicom) call shr_mpi_bcast (itmax_canopy_fluxes, mpicom) + call shr_mpi_bcast (use_z0v_forest, mpicom) if (masterproc) then write(iulog,*) ' ' @@ -453,6 +455,8 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, woody => pftcon%woody , & ! Input: woody flag rstem_per_dbh => pftcon%rstem_per_dbh , & ! Input: stem resistance per stem diameter (s/m**2) wood_density => pftcon%wood_density , & ! Input: dry wood density (kg/m3) + z0v_h => pftcon%z0v_h , & ! Input: ratio of vegetation surface roughness length to canopy height for forests (-) + z0v_alpha => pftcon%z0v_alpha , & ! Input: alpha parameter for decrease of vegetation surface roughness with LAI for forests (-) forc_lwrad => atm2lnd_inst%forc_lwrad_downscaled_col , & ! Input: [real(r8) (:) ] downward infrared (longwave) radiation (W/m**2) forc_q => wateratm2lndbulk_inst%forc_q_downscaled_col , & ! Input: [real(r8) (:) ] atmospheric specific humidity (kg/kg) @@ -861,22 +865,37 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, do f = 1, fn p = filterp(f) c = patch%column(p) - if(.true.) then ! woody(patch%itype(p))==0) then ! Keep old parametrization for grasses/crops - lt = min(elai(p)+esai(p), tlsai_crit) - egvf =(1._r8 - alpha_aero * exp(-lt)) / (1._r8 - alpha_aero * exp(-tlsai_crit)) - displa(p) = egvf * displa(p) - z0mv(p) = exp(egvf * log(z0mv(p)) + (1._r8 - egvf) * log(z0mg(c))) - else - if(elai(p)==0) then - displa(p) = htop(p) * (1.0_r8 - (1.0_r8 - exp(-2.25_r8 * 7.24_r8 * nstem(patch%itype(p)))) & - / (2.25_r8 * 7.24_r8 * nstem(patch%itype(p)))) - else - displa(p) = htop(p) * (1.0_r8 - (1.0_r8 - exp(-2.25_r8 * 7.24_r8 * nstem(patch%itype(p)))) & - / (2.25_r8 * 7.24_r8 * nstem(patch%itype(p))) * (1.0_r8 - exp(-0.273_r8 * elai(p))) & - / (0.273_r8 * elai(p))) - end if - z0mv(p) = htop(p) * 0.264_r8 * (1._r8 - displa(p) / htop(p)) - end if + + ! Keep old parametrization for grasses/crops and for forests if switch is off + + if(woody(patch%itype(p))==0 .or. use_z0v_forest==.false.) then + lt = min(elai(p)+esai(p), tlsai_crit) + egvf =(1._r8 - alpha_aero * exp(-lt)) / (1._r8 - alpha_aero * exp(-tlsai_crit)) + displa(p) = egvf * displa(p) + z0mv(p) = exp(egvf * log(z0mv(p)) + (1._r8 - egvf) * log(z0mg(c))) + + else ! use new parameterization for forests + egvf = z0v_alpha(patch%itype(p))*elai(p) + if(egvf == 0._r8) then + z0mv(p) = htop(p) * z0v_h(patch%itype(p)) + else + z0mv(p) = htop(p) * z0v_h(patch%itype(p)) * (1.0_r8 - exp(-egvf)) / egvf + end if + displa(p) = htop(p) - z0mv(p) / 0.264_r8 + end if +! if(elai(p)==0) then +! displa(p) = htop(p) * (1.0_r8 - (1.0_r8 - exp(-2.25_r8 * 7.24_r8 * nstem(patch%itype(p)))) & +! / (2.25_r8 * 7.24_r8 * nstem(patch%itype(p)))) +! else +! displa(p) = htop(p) * (1.0_r8 - (1.0_r8 - exp(-2.25_r8 * 7.24_r8 * nstem(patch%itype(p)))) & +! / (2.25_r8 * 7.24_r8 * nstem(patch%itype(p))) * (1.0_r8 - exp(-0.273_r8 * elai(p))) & +! / (0.273_r8 * elai(p))) +! end if +! z0mv(p) = htop(p) * 0.264_r8 * (1._r8 - displa(p) / htop(p)) +! end if + !lt = min(elai(p)+esai(p), tlsai_crit) + !egvf =(1._r8 - alpha_aero * exp(-lt)) / (1._r8 - alpha_aero * exp(-tlsai_crit)) + !displa(p) = egvf * displa(p) z0hv(p) = z0mv(p) z0qv(p) = z0mv(p) diff --git a/src/main/clm_varctl.F90 b/src/main/clm_varctl.F90 index f8100ac304..209bfe0768 100644 --- a/src/main/clm_varctl.F90 +++ b/src/main/clm_varctl.F90 @@ -284,6 +284,12 @@ module clm_varctl logical, public :: use_biomass_heat_storage = .false. ! true => include biomass heat storage in canopy energy budget + !---------------------------------------------------------- + ! forest surface roughness length switch + !---------------------------------------------------------- + + logical, public :: use_z0v_forest = .false. ! true => use new surface roughness length parameterization for forests + !---------------------------------------------------------- ! each pft has individual soil column switch !---------------------------------------------------------- diff --git a/src/main/controlMod.F90 b/src/main/controlMod.F90 index 17e79f2dc8..c07efb95ce 100644 --- a/src/main/controlMod.F90 +++ b/src/main/controlMod.F90 @@ -245,6 +245,8 @@ subroutine control_init(dtime) namelist /clm_inparm/ use_biomass_heat_storage + namelist /clm_inparm/ use_z0v_forest + namelist /clm_inparm/ use_individual_pft_soil_column namelist /clm_inparm/ use_hydrstress @@ -746,6 +748,8 @@ subroutine control_spmd() call mpi_bcast (use_biomass_heat_storage, 1, MPI_LOGICAL, 0, mpicom, ier) + call mpi_bcast (use_z0v_forest, 1, MPI_LOGICAL, 0, mpicom, ier) + call mpi_bcast (use_individual_pft_soil_column, 1, MPI_LOGICAL, 0, mpicom, ier) call mpi_bcast (use_hydrstress, 1, MPI_LOGICAL, 0, mpicom, ier) diff --git a/src/main/histFileMod.F90 b/src/main/histFileMod.F90 index 24ff6acceb..668af1db69 100644 --- a/src/main/histFileMod.F90 +++ b/src/main/histFileMod.F90 @@ -44,7 +44,7 @@ module histFileMod integer , public, parameter :: max_flds = 2500 ! max number of history fields integer , public, parameter :: max_namlen = 64 ! maximum number of characters for field name integer , public, parameter :: scale_type_strlen = 32 ! maximum number of characters for scale types - integer , private, parameter :: avgflag_strlen = 1 ! maximum number of characters for avgflag + integer , private, parameter :: avgflag_strlen = 10 ! maximum number of characters for avgflag integer , private, parameter :: hist_dim_name_length = 16 ! lenngth of character strings in dimension names ! Possible ways to treat multi-layer snow fields at times when no snow is present in a diff --git a/src/main/pftconMod.F90 b/src/main/pftconMod.F90 index 88e5965051..0a1c0b50bc 100644 --- a/src/main/pftconMod.F90 +++ b/src/main/pftconMod.F90 @@ -121,6 +121,8 @@ module pftconMod real(r8), allocatable :: taul (:,:) ! leaf transmittance: 1=vis, 2=nir real(r8), allocatable :: taus (:,:) ! stem transmittance: 1=vis, 2=nir real(r8), allocatable :: z0mr (:) ! ratio of momentum roughness length to canopy top height (-) + real(r8), allocatable :: z0v_h (:) ! ratio of vegetation surface roughness length to canopy height for forests (-) + real(r8), allocatable :: z0v_alpha (:) ! alpha parameter for decrease of vegetation surface roughness with LAI for forests (-) real(r8), allocatable :: displar (:) ! ratio of displacement height to canopy top height (-) real(r8), allocatable :: roota_par (:) ! CLM rooting distribution parameter [1/m] real(r8), allocatable :: rootb_par (:) ! CLM rooting distribution parameter [1/m] @@ -356,7 +358,9 @@ subroutine InitAllocate (this) allocate( this%rhos (0:mxpft,numrad) ) allocate( this%taul (0:mxpft,numrad) ) allocate( this%taus (0:mxpft,numrad) ) - allocate( this%z0mr (0:mxpft) ) + allocate( this%z0mr (0:mxpft) ) + allocate( this%z0v_h (0:mxpft) ) + allocate( this%z0v_alpha (0:mxpft) ) allocate( this%displar (0:mxpft) ) allocate( this%roota_par (0:mxpft) ) allocate( this%rootb_par (0:mxpft) ) @@ -497,7 +501,7 @@ subroutine InitRead(this) use fileutils , only : getfil use ncdio_pio , only : ncd_io, ncd_pio_closefile, ncd_pio_openfile, file_desc_t use ncdio_pio , only : ncd_inqdid, ncd_inqdlen - use clm_varctl , only : paramfile, use_fates, use_flexibleCN, use_dynroot, use_biomass_heat_storage + use clm_varctl , only : paramfile, use_fates, use_flexibleCN, use_dynroot, use_biomass_heat_storage, use_z0v_forest use spmdMod , only : masterproc use CLMFatesParamInterfaceMod, only : FatesReadPFTs ! @@ -630,6 +634,21 @@ subroutine InitRead(this) call ncd_io('z0mr', this%z0mr, 'read', ncid, readvar=readv, posNOTonfile=.true.) if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) + ! + ! Use new vegetation surface roughness parameterization for forests + ! + if( use_z0v_forest) then + ! These will only be used for forest PFTs + call ncd_io('z0v_h', this%z0v_h, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) + + call ncd_io('z0v_alpha', this%z0v_alpha, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) + else + this%z0v_h = 0._r8 + this%z0v_alpha = 0._r8 + end if + call ncd_io('displar', this%displar, 'read', ncid, readvar=readv, posNOTonfile=.true.) if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) @@ -1349,6 +1368,8 @@ subroutine Clean(this) deallocate( this%taul) deallocate( this%taus) deallocate( this%z0mr) + deallocate( this%z0v_h) + deallocate( this%z0v_alpha) deallocate( this%displar) deallocate( this%roota_par) deallocate( this%rootb_par) From 492c1580a976fa77b7646ddfd81482862b7b4c5e Mon Sep 17 00:00:00 2001 From: Ronny Meier Date: Fri, 7 May 2021 13:33:13 +0200 Subject: [PATCH 003/257] Saving state --- bld/CLMBuildNamelist.pm | 12 + bld/namelist_files/namelist_defaults_ctsm.xml | 8 + .../namelist_definition_ctsm.xml | 12 + src/biogeophys/BareGroundFluxesMod.F90 | 4 +- src/biogeophys/BiogeophysPreFluxCalcsMod.F90 | 39 +- src/biogeophys/CanopyFluxesMod.F90 | 83 ++-- src/biogeophys/FrictionVelocityMod.F90 | 33 +- src/biogeophys/LakeFluxesMod.F90 | 15 +- src/main/clm_varctl.F90 | 6 + src/main/controlMod.F90 | 4 +- src/main/histFileMod.F90 | 366 +++++++++--------- src/main/pftconMod.F90 | 65 +++- 12 files changed, 426 insertions(+), 221 deletions(-) diff --git a/bld/CLMBuildNamelist.pm b/bld/CLMBuildNamelist.pm index 6eb154b462..6f8e7c21f9 100755 --- a/bld/CLMBuildNamelist.pm +++ b/bld/CLMBuildNamelist.pm @@ -1503,6 +1503,7 @@ sub process_namelist_inline_logic { setup_logic_supplemental_nitrogen($opts, $nl_flags, $definition, $defaults, $nl); setup_logic_snowpack($opts, $nl_flags, $definition, $defaults, $nl); setup_logic_fates($opts, $nl_flags, $definition, $defaults, $nl); + setup_logic_z0param($opts, $nl_flags, $definition, $defaults, $nl); setup_logic_misc($opts, $nl_flags, $definition, $defaults, $nl); ######################################### @@ -3893,6 +3894,17 @@ sub setup_logic_fates { #------------------------------------------------------------------------------- +sub setup_logic_z0param { + # + # Set default z0 paramterization + # + my ($opts, $nl_flags, $definition, $defaults, $nl) = @_; + + add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'z0param_method'); +} + +#------------------------------------------------------------------------------- + sub setup_logic_misc { # # Set some misc options diff --git a/bld/namelist_files/namelist_defaults_ctsm.xml b/bld/namelist_files/namelist_defaults_ctsm.xml index 5474f9f0de..aa9b4ca3fc 100644 --- a/bld/namelist_files/namelist_defaults_ctsm.xml +++ b/bld/namelist_files/namelist_defaults_ctsm.xml @@ -488,6 +488,12 @@ attributes from the config_cache.xml file (with keys converted to upper-case). lnd/clm2/paramdata/fates_params_api.14.0.0_12pft_c200921.nc + + + + +ZengWang2007 + @@ -1080,6 +1086,8 @@ lnd/clm2/surfdata_map/release-clm5.0.30/surfdata_C24_hist_78pfts_CMIP6_simyr2000 lnd/clm2/surfdata_map/release-clm5.0.18/surfdata_0.9x1.25_hist_78pfts_CMIP6_simyr2000_c190214.nc lnd/clm2/surfdata_map/release-clm5.0.18/surfdata_1.9x2.5_hist_78pfts_CMIP6_simyr2000_c190304.nc + +lnd/clm2/surfdata_map/release-clm5.0.18/surfdata_360x720cru_78pfts_CMIP6_simyr2000_c170824.nc lnd/clm2/surfdata_map/release-clm5.0.24/surfdata_0.125x0.125_hist_78pfts_CMIP6_simyr2005_c190624.nc diff --git a/bld/namelist_files/namelist_definition_ctsm.xml b/bld/namelist_files/namelist_definition_ctsm.xml index eeaa6214c4..785b9447bf 100644 --- a/bld/namelist_files/namelist_definition_ctsm.xml +++ b/bld/namelist_files/namelist_definition_ctsm.xml @@ -2722,6 +2722,18 @@ the related bulk quantities. If .true., run with water isotopes + + + + + +Parameterization/parameters to use for surface roughness +ZengWang2007: Zeng and Wang 2007 +MeierXXXX: Meier et al. in prep. + + + diff --git a/src/biogeophys/BareGroundFluxesMod.F90 b/src/biogeophys/BareGroundFluxesMod.F90 index cc14091a26..45015b8861 100644 --- a/src/biogeophys/BareGroundFluxesMod.F90 +++ b/src/biogeophys/BareGroundFluxesMod.F90 @@ -329,7 +329,9 @@ subroutine BareGroundFluxes(bounds, num_noexposedvegp, filter_noexposedvegp, & tstar = temp1(p)*dth(p) qstar = temp2(p)*dqh(p) - z0hg_patch(p) = z0mg_patch(p) / exp(params_inst%a_coef * (ustar(p) * z0mg_patch(p) / 1.5e-5_r8)**params_inst%a_exp) + !z0hg_patch(p) = z0mg_patch(p) / exp(0.4_r8*0.52_r8 * (8._r8*z0mg_patch(p)*ustar(p) / 1.5e-5_r8)**0.45_r8 * 0.71_r8**0.8_r8) ! OT63 + z0hg_patch(p) = 70._r8 * 1.5e-5_r8 / ustar(p) * exp( -7.2_r8 * ustar(p)**(0.5_r8) * (abs(tstar))**(0.25_r8)) ! Yang07 +!z0mg_patch(p) / exp(params_inst%a_coef * (ustar(p) * z0mg_patch(p) / 1.5e-5_r8)**params_inst%a_exp) z0qg_patch(p) = z0hg_patch(p) thvstar = tstar*(1._r8+0.61_r8*forc_q(c)) + 0.61_r8*forc_th(c)*qstar zeta = zldis(p)*vkc*grav*thvstar/(ustar(p)**2*thv(c)) diff --git a/src/biogeophys/BiogeophysPreFluxCalcsMod.F90 b/src/biogeophys/BiogeophysPreFluxCalcsMod.F90 index f533a62916..7a06bb0265 100644 --- a/src/biogeophys/BiogeophysPreFluxCalcsMod.F90 +++ b/src/biogeophys/BiogeophysPreFluxCalcsMod.F90 @@ -16,8 +16,8 @@ module BiogeophysPreFluxCalcsMod use LandunitType , only : lun use clm_varcon , only : spval use clm_varpar , only : nlevgrnd, nlevsno, nlevurb, nlevmaxurbgrnd - use clm_varctl , only : use_fates - use pftconMod , only : pftcon + use clm_varctl , only : use_fates, z0param_method + use pftconMod , only : pftcon, noveg use column_varcon , only : icol_roof, icol_sunwall, icol_shadewall use landunit_varcon , only : istsoil, istcrop, istice_mec use clm_varcon , only : hvap, hsub @@ -131,6 +131,8 @@ subroutine SetZ0mDisp(bounds, num_nolakep, filter_nolakep, & integer :: fp, p character(len=*), parameter :: subname = 'SetZ0mDisp' + real(r8) :: U_ustar ! wind at canopy height divided by friction velocity (unitless) + !----------------------------------------------------------------------- associate( & @@ -154,8 +156,37 @@ subroutine SetZ0mDisp(bounds, num_nolakep, filter_nolakep, & p = filter_nolakep(fp) if( .not.(patch%is_fates(p))) then - z0m(p) = pftcon%z0mr(patch%itype(p)) * htop(p) - displa(p) = pftcon%displar(patch%itype(p)) * htop(p) + select case (z0param_method) + case ('ZengWang2007') + + z0m(p) = pftcon%z0mr(patch%itype(p)) * htop(p) + displa(p) = pftcon%displar(patch%itype(p)) * htop(p) + + case ('MeierXXXX') + + if (patch%itype(p) == noveg) then + z0m(p) = 0._r8 + displa(p) = 0._r8 + + else + ! Compute as if elai+esai = LAImax - LAIoff in CanopyFluxes + displa(p) = htop(p) * (1._r8 - (1._r8 - exp(-(7.5_r8 * (pftcon%z0v_LAImax(patch%itype(p)) - pftcon%z0v_LAIoff(patch%itype(p))))**0.5_r8)) & + / (7.5_r8*(pftcon%z0v_LAImax(patch%itype(p)) - pftcon%z0v_LAIoff(patch%itype(p))))**0.5_r8) + + U_ustar = 4._r8 * (pftcon%z0v_Cs(patch%itype(p)) + pftcon%z0v_Cr(patch%itype(p)) * (pftcon%z0v_LAImax(patch%itype(p)) - pftcon%z0v_LAIoff(patch%itype(p))) & + / 2._r8)**(-0.5_r8) / (pftcon%z0v_LAImax(patch%itype(p)) - pftcon%z0v_LAIoff(patch%itype(p))) / pftcon%z0v_c(patch%itype(p)) + + if( htop(p) > -1._r8) then ! Avoid devididing by 0 + z0m(p) = htop(p) * (1._r8 - displa(p) / htop(p)) * exp(-0.4_r8 * U_ustar + & + log(pftcon%z0v_cw(patch%itype(p))) - 1._r8 + pftcon%z0v_cw(patch%itype(p))**(-1._r8)) + else + z0m(p) = htop(p) * exp(-0.4_r8 * U_ustar + log(pftcon%z0v_cw(patch%itype(p))) - 1._r8 + pftcon%z0v_cw(patch%itype(p))**(-1._r8)) + end if + + end if + + end select + end if end do diff --git a/src/biogeophys/CanopyFluxesMod.F90 b/src/biogeophys/CanopyFluxesMod.F90 index 425bfd69de..e83ac21d9c 100644 --- a/src/biogeophys/CanopyFluxesMod.F90 +++ b/src/biogeophys/CanopyFluxesMod.F90 @@ -14,7 +14,7 @@ module CanopyFluxesMod use shr_log_mod , only : errMsg => shr_log_errMsg use abortutils , only : endrun use clm_varctl , only : iulog, use_cn, use_lch4, use_c13, use_c14, use_cndv, use_fates, & - use_luna, use_hydrstress, use_biomass_heat_storage, use_z0v_forest + use_luna, use_hydrstress, use_biomass_heat_storage, use_z0v_forest, z0param_method use clm_varpar , only : nlevgrnd, nlevsno, mxpft use clm_varcon , only : namep use pftconMod , only : pftcon @@ -380,6 +380,9 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, integer :: index ! patch index for error real(r8) :: egvf ! effective green vegetation fraction real(r8) :: lt ! elai+esai + real(r8) :: U_ustar ! wind at canopy height divided by friction velocity (unitless) + real(r8) :: U_ustar_ini ! initial guess of wind at canopy height divided by friction velocity (unitless) + real(r8) :: U_ustar_prev ! wind at canopy height divided by friction velocity from the previous iteration (unitless) real(r8) :: ri ! stability parameter for under canopy air (unitless) real(r8) :: csoilb ! turbulent transfer coefficient over bare soil (unitless) real(r8) :: ricsoilc ! modified transfer coefficient under dense canopy (unitless) @@ -457,6 +460,12 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, wood_density => pftcon%wood_density , & ! Input: dry wood density (kg/m3) z0v_h => pftcon%z0v_h , & ! Input: ratio of vegetation surface roughness length to canopy height for forests (-) z0v_alpha => pftcon%z0v_alpha , & ! Input: alpha parameter for decrease of vegetation surface roughness with LAI for forests (-) + z0v_Cr => pftcon%z0v_Cr , & ! Input: roughness-element drag coefficient for Raupach92 parameterization (-) + z0v_Cs => pftcon%z0v_Cs , & ! Input: substrate-element drag coefficient for Raupach92 parameterization (-) + z0v_c => pftcon%z0v_c , & ! Input: c parameter for Raupach92 parameterization (-) + z0v_cw => pftcon%z0v_cw , & ! Input: roughness sublayer depth coefficient for Raupach92 parameterization (-) + z0v_LAIoff => pftcon%z0v_LAIoff , & ! Input: leaf area index offset for Raupach92 parameterization (-) + z0v_LAImax => pftcon%z0v_LAImax , & ! Input: onset of over-sheltering for Raupach92 parameterization (-) forc_lwrad => atm2lnd_inst%forc_lwrad_downscaled_col , & ! Input: [real(r8) (:) ] downward infrared (longwave) radiation (W/m**2) forc_q => wateratm2lndbulk_inst%forc_q_downscaled_col , & ! Input: [real(r8) (:) ] atmospheric specific humidity (kg/kg) @@ -868,36 +877,58 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, ! Keep old parametrization for grasses/crops and for forests if switch is off - if(woody(patch%itype(p))==0 .or. use_z0v_forest==.false.) then +! if(woody(patch%itype(p))==0 .or. use_z0v_forest==.false.) then +! lt = min(elai(p)+esai(p), tlsai_crit) +! egvf =(1._r8 - alpha_aero * exp(-lt)) / (1._r8 - alpha_aero * exp(-tlsai_crit)) +! displa(p) = egvf * displa(p) +! z0mv(p) = exp(egvf * log(z0mv(p)) + (1._r8 - egvf) * log(z0mg(c))) +! +! else ! use new parameterization for forests +! egvf = z0v_alpha(patch%itype(p))*elai(p) +! if(egvf == 0._r8) then +! z0mv(p) = htop(p) * z0v_h(patch%itype(p)) +! else +! z0mv(p) = htop(p) * z0v_h(patch%itype(p)) * (1.0_r8 - exp(-egvf)) / egvf +! end if +! displa(p) = htop(p) - z0mv(p) / 0.264_r8 +! end if + select case (z0param_method) + case ('ZengWang2007') lt = min(elai(p)+esai(p), tlsai_crit) egvf =(1._r8 - alpha_aero * exp(-lt)) / (1._r8 - alpha_aero * exp(-tlsai_crit)) displa(p) = egvf * displa(p) z0mv(p) = exp(egvf * log(z0mv(p)) + (1._r8 - egvf) * log(z0mg(c))) - else ! use new parameterization for forests - egvf = z0v_alpha(patch%itype(p))*elai(p) - if(egvf == 0._r8) then - z0mv(p) = htop(p) * z0v_h(patch%itype(p)) - else - z0mv(p) = htop(p) * z0v_h(patch%itype(p)) * (1.0_r8 - exp(-egvf)) / egvf - end if - displa(p) = htop(p) - z0mv(p) / 0.264_r8 - end if -! if(elai(p)==0) then -! displa(p) = htop(p) * (1.0_r8 - (1.0_r8 - exp(-2.25_r8 * 7.24_r8 * nstem(patch%itype(p)))) & -! / (2.25_r8 * 7.24_r8 * nstem(patch%itype(p)))) -! else -! displa(p) = htop(p) * (1.0_r8 - (1.0_r8 - exp(-2.25_r8 * 7.24_r8 * nstem(patch%itype(p)))) & -! / (2.25_r8 * 7.24_r8 * nstem(patch%itype(p))) * (1.0_r8 - exp(-0.273_r8 * elai(p))) & -! / (0.273_r8 * elai(p))) -! end if -! z0mv(p) = htop(p) * 0.264_r8 * (1._r8 - displa(p) / htop(p)) -! end if - !lt = min(elai(p)+esai(p), tlsai_crit) - !egvf =(1._r8 - alpha_aero * exp(-lt)) / (1._r8 - alpha_aero * exp(-tlsai_crit)) - !displa(p) = egvf * displa(p) - z0hv(p) = z0mv(p) - z0qv(p) = z0mv(p) + case ('MeierXXXX') + lt = max(0.00001_r8,elai(p)+esai(p)-z0v_LAIoff(patch%itype(p))) + if(elai(p)+esai(p) == 0._r8) then + write(iulog,*) 'VAI = 0 ', lt, (1._r8 - (1._r8 - exp(-(7.5_r8 * lt)**0.5_r8)) / (7.5_r8*lt)**0.5_r8),(1._r8 - exp(-(7.5_r8 * lt)**0.5_r8)) + end if + displa(p) = htop(p) * (1._r8 - (1._r8 - exp(-(7.5_r8 * lt)**0.5_r8)) / (7.5_r8*lt)**0.5_r8) + + lt = min(lt,z0v_LAImax(patch%itype(p))) + delt = 2._r8 + U_ustar_ini = (z0v_Cs(patch%itype(p)) + z0v_Cr(patch%itype(p)) * lt / 2._r8)**(-0.5_r8) & + *z0v_c(patch%itype(p)) * lt / 4._r8 + U_ustar = U_ustar_ini + + do while (delt > 0.0001_r8) + U_ustar_prev = U_ustar + U_ustar = U_ustar_ini * exp(U_ustar_prev) + delt = abs(U_ustar - U_ustar_prev) + end do + + U_ustar = 4._r8 * U_ustar / lt / z0v_c(patch%itype(p)) + z0mv(p) = htop(p) * (1._r8 - displa(p) / htop(p)) * exp(-0.4_r8 * U_ustar + & + log(z0v_cw(patch%itype(p))) - 1._r8 + z0v_cw(patch%itype(p))**(-1._r8)) + + case default + write(iulog,*) 'ERROR: unknown z0para_method: ', z0param_method + call endrun(msg = 'unknown z0param_method', additional_msg = errMsg(sourcefile, __LINE__)) + end select + + z0hv(p) = z0mv(p) + z0qv(p) = z0mv(p) end do diff --git a/src/biogeophys/FrictionVelocityMod.F90 b/src/biogeophys/FrictionVelocityMod.F90 index 9bef16cec7..9829a70563 100644 --- a/src/biogeophys/FrictionVelocityMod.F90 +++ b/src/biogeophys/FrictionVelocityMod.F90 @@ -12,7 +12,7 @@ module FrictionVelocityMod use shr_const_mod , only : SHR_CONST_PI use decompMod , only : bounds_type use clm_varcon , only : spval - use clm_varctl , only : use_cn, use_luna + use clm_varctl , only : use_cn, use_luna, z0param_method use LandunitType , only : lun use ColumnType , only : col use PatchType , only : patch @@ -35,6 +35,7 @@ module FrictionVelocityMod real(r8), public :: zetamaxstable = -999._r8 ! Max value zeta ("height" used in Monin-Obukhov theory) can go to under stable conditions real(r8) :: zsno = -999._r8 ! Momentum roughness length for snow (m) real(r8) :: zlnd = -999._r8 ! Momentum roughness length for soil, glacier, wetland (m) + real(r8) :: zglc = -999._r8 ! Momentum roughness length for glacier (only used with z0param_method = 'MeierXXXX') (m) ! Roughness length/resistance for friction velocity calculation @@ -367,6 +368,12 @@ subroutine ReadParams( this, params_ncid ) call readNcdioScalar(params_ncid, 'zsno', subname, this%zsno) ! Momentum roughness length for soil, glacier, wetland (m) call readNcdioScalar(params_ncid, 'zlnd', subname, this%zlnd) + + ! Separated roughness length for glacier if z0param_method == 'MeierXXXX' + if (z0param_method == 'MeierXXXX') then + call readNcdioScalar(params_ncid, 'zglc', subname, this%zglc) + end if + end subroutine ReadParams @@ -523,11 +530,25 @@ subroutine SetRoughnessLengthsAndForcHeightsNonLake(this, bounds, & ! Ground roughness lengths over non-lake columns (includes bare ground, ground ! underneath canopy, wetlands, etc.) - if (frac_sno(c) > 0._r8) then - z0mg(c) = this%zsno - else - z0mg(c) = this%zlnd - end if + + select case (z0param_method) + case ('ZengWang2007') + if (frac_sno(c) > 0._r8) then + z0mg(c) = this%zsno + else + z0mg(c) = this%zlnd + end if + case ('MeierXXXX') ! Bare ground and ice have a different value + l = col%landunit(c) + if (lun%itype(l) == istice_mec) then + z0mg(c) = this%zglc + else if (frac_sno(c) > 0._r8) then + z0mg(c) = this%zsno + else + z0mg(c) = this%zlnd + end if + end select + z0hg(c) = z0mg(c) ! initial set only z0qg(c) = z0mg(c) ! initial set only end do diff --git a/src/biogeophys/LakeFluxesMod.F90 b/src/biogeophys/LakeFluxesMod.F90 index 212d0ca7d1..4f08e6c4c0 100644 --- a/src/biogeophys/LakeFluxesMod.F90 +++ b/src/biogeophys/LakeFluxesMod.F90 @@ -37,6 +37,7 @@ module LakeFluxesMod real(r8) :: a_coef ! Drag coefficient under less dense canopy (unitless) real(r8) :: a_exp ! Drag exponent under less dense canopy (unitless) real(r8) :: zsno ! Momentum roughness length for snow (m) + real(r8) :: zglc ! Momentum roughness length for ice (m) real(r8) :: wind_min ! Minimum wind speed at the atmospheric forcing height (m/s) end type params_type type(params_type), private :: params_inst @@ -49,6 +50,7 @@ subroutine readParams( ncid ) ! !USES: use ncdio_pio, only: file_desc_t use paramUtilMod, only: readNcdioScalar + use clm_varctl, only: z0param_method ! ! !ARGUMENTS: implicit none @@ -64,6 +66,11 @@ subroutine readParams( ncid ) call readNcdioScalar(ncid, 'a_exp', subname, params_inst%a_exp) ! Momentum roughness length for snow (m) call readNcdioScalar(ncid, 'zsno', subname, params_inst%zsno) + + if (z0param_method == 'MeierXXXX') then + ! Momentum roughness length for ice (m) + call readNcdioScalar(ncid, 'zglc', subname, params_inst%zglc) + end if ! Minimum wind speed at the atmospheric forcing height (m/s) call readNcdioScalar(ncid, 'wind_min', subname, params_inst%wind_min) @@ -86,7 +93,7 @@ subroutine LakeFluxes(bounds, num_lakec, filter_lakec, num_lakep, filter_lakep, use clm_varpar , only : nlevlak use clm_varcon , only : hvap, hsub, hfus, cpair, cpliq, tkwat, tkice, tkair use clm_varcon , only : sb, vkc, grav, denh2o, tfrz, spval - use clm_varctl , only : use_lch4 + use clm_varctl , only : use_lch4, z0param_method use LakeCon , only : betavis, z0frzlake, tdmax, emg_lake use LakeCon , only : lake_use_old_fcrit_minz0 use LakeCon , only : minz0lake, cur0, cus, curm, fcrit @@ -324,7 +331,11 @@ subroutine LakeFluxes(bounds, num_lakec, filter_lakec, num_lakep, filter_lakep, z0qg(p) = max(z0qg(p), minz0lake) z0hg(p) = max(z0hg(p), minz0lake) else if (snl(c) == 0) then ! frozen lake with ice - z0mg(p) = z0frzlake + if (z0param_method == 'MeierXXXX') then + z0mg(p) = params_inst%zglc + else + z0mg(p) = z0frzlake + end if z0hg(p) = z0mg(p) / exp(params_inst%a_coef * (ust_lake(c) * z0mg(p) / 1.5e-5_r8)**params_inst%a_exp) ! Consistent with BareGroundFluxes z0qg(p) = z0hg(p) else ! use roughness over snow as in Biogeophysics1 diff --git a/src/main/clm_varctl.F90 b/src/main/clm_varctl.F90 index 209bfe0768..2de40bacf8 100644 --- a/src/main/clm_varctl.F90 +++ b/src/main/clm_varctl.F90 @@ -217,6 +217,12 @@ module clm_varctl ! this error-check. logical, public :: for_testing_allow_interp_non_ciso_to_ciso = .false. + !---------------------------------------------------------- + ! Surface roughness parameterization + !---------------------------------------------------------- + + character(len=64), public :: z0param_method + !---------------------------------------------------------- ! FATES switches !---------------------------------------------------------- diff --git a/src/main/controlMod.F90 b/src/main/controlMod.F90 index c07efb95ce..e3a2eb470d 100644 --- a/src/main/controlMod.F90 +++ b/src/main/controlMod.F90 @@ -202,7 +202,8 @@ subroutine control_init(dtime) albice, soil_layerstruct_predefined, soil_layerstruct_userdefined, & soil_layerstruct_userdefined_nlevsoi, use_subgrid_fluxes, snow_cover_fraction_method, & irrigate, run_zero_weight_urban, all_active, & - crop_fsat_equals_zero, for_testing_run_ncdiopio_tests + crop_fsat_equals_zero, for_testing_run_ncdiopio_tests, & + z0param_method ! vertical soil mixing variables namelist /clm_inparm/ & @@ -792,6 +793,7 @@ subroutine control_spmd() call mpi_bcast (nsegspc, 1, MPI_INTEGER, 0, mpicom, ier) call mpi_bcast (use_subgrid_fluxes , 1, MPI_LOGICAL, 0, mpicom, ier) call mpi_bcast (snow_cover_fraction_method , len(snow_cover_fraction_method), MPI_CHARACTER, 0, mpicom, ier) + call mpi_bcast (z0param_method , len(z0param_method), MPI_CHARACTER, 0, mpicom, ier) call mpi_bcast (wrtdia, 1, MPI_LOGICAL, 0, mpicom, ier) call mpi_bcast (single_column,1, MPI_LOGICAL, 0, mpicom, ier) call mpi_bcast (scmlat, 1, MPI_REAL8,0, mpicom, ier) diff --git a/src/main/histFileMod.F90 b/src/main/histFileMod.F90 index 668af1db69..038aeaf701 100644 --- a/src/main/histFileMod.F90 +++ b/src/main/histFileMod.F90 @@ -44,7 +44,7 @@ module histFileMod integer , public, parameter :: max_flds = 2500 ! max number of history fields integer , public, parameter :: max_namlen = 64 ! maximum number of characters for field name integer , public, parameter :: scale_type_strlen = 32 ! maximum number of characters for scale types - integer , private, parameter :: avgflag_strlen = 10 ! maximum number of characters for avgflag + integer , private, parameter :: avgflag_strlen = 10 ! maximum number of characters for avgflag integer , private, parameter :: hist_dim_name_length = 16 ! lenngth of character strings in dimension names ! Possible ways to treat multi-layer snow fields at times when no snow is present in a @@ -1325,6 +1325,7 @@ subroutine hist_update_hbuf_field_1d (t, f, bounds) integer :: tod ! Desired local solar time of output in seconds integer, allocatable :: grid_index(:) ! Grid cell index for longitude integer, allocatable :: tods(:) + character(len=1) :: avgflag_trim ! first character of avgflag !----------------------------------------------------------------------- @@ -1344,13 +1345,12 @@ subroutine hist_update_hbuf_field_1d (t, f, bounds) l2g_scale_type = tape(t)%hlist(f)%field%l2g_scale_type hpindex = tape(t)%hlist(f)%field%hpindex field => clmptr_rs(hpindex)%ptr - tods = (/0, 0, 0, 10800, 43200, 54000, 0, 10800, 54000 /) - - ! set variables to check weights when allocate all pfts dtime = get_step_size() call get_curr_date (year, month, day, secs) + ! set variables to check weights when allocate all pfts + map2gcell = .false. if (type1d_out == nameg .or. type1d_out == grlnd) then SHR_ASSERT_FL(beg1d_out == bounds%begg, sourcefile, __LINE__) @@ -1434,7 +1434,8 @@ subroutine hist_update_hbuf_field_1d (t, f, bounds) if (map2gcell) then ! Map to gridcell ! note that in this case beg1d = begg and end1d=endg - select case (avgflag) + avgflag_trim = avgflag(1:1) + select case (avgflag_trim) case ('I') ! Instantaneous do k = beg1d_out, end1d_out if (field_gcell(k) /= spval) then @@ -1444,7 +1445,7 @@ subroutine hist_update_hbuf_field_1d (t, f, bounds) end if nacs(k,1) = 1 end do - case ('A', 'SUM') ! Time average / sum + case ('A', 'S') ! Time average / sum do k = beg1d_out, end1d_out if (field_gcell(k) /= spval) then if (nacs(k,1) == 0) hbuf(k,1) = 0._r8 @@ -1474,46 +1475,48 @@ subroutine hist_update_hbuf_field_1d (t, f, bounds) endif nacs(k,1) = 1 end do - case ('L') ! Local solar time - tod = tods(t) - do k = beg1d_out, end1d_out - if (field_gcell(k) /= spval) then - - local_secpl = secs + grc%londeg(k)/degpsec - local_secpl = mod(local_secpl,isecspday) - - if (local_secpl >= tod - dtime .and. local_secpl < tod) then - if (nacs(k,1) == 0) hbuf(k,1) = 0._r8 - hbuf(k,1) = hbuf(k,1) + field_gcell(k)*real(dtime-tod+local_secpl) - nacs(k,1) = nacs(k,1) + dtime-tod+local_secpl - else if (local_secpl >= tod .and. local_secpl < tod + dtime) then - if (nacs(k,1) == 0) hbuf(k,1) = 0._r8 - hbuf(k,1) = hbuf(k,1) + field_gcell(k)*real(dtime+tod-local_secpl) - nacs(k,1) = nacs(k,1) + dtime+tod-local_secpl - end if - - if (tod < dtime .and. local_secpl > isecspday-dtime) then - local_secpl = local_secpl - isecspday - if (local_secpl >= tod - dtime .and. local_secpl < tod) then - if (nacs(k,1) == 0) hbuf(k,1) = 0._r8 - hbuf(k,1) = hbuf(k,1) + field_gcell(k)*real(dtime-tod+local_secpl) - nacs(k,1) = nacs(k,1) + dtime-tod+local_secpl - end if - end if - - else - if (nacs(k,1) == 0) hbuf(k,1) = spval - end if - end do - case default - write(iulog,*) trim(subname),' ERROR: invalid time averaging flag ', avgflag - call endrun(msg=errMsg(sourcefile, __LINE__)) + case ('L') ! Local solar time + read(avgflag(2:6), *) tod + do k = beg1d_out, end1d_out + if (field_gcell(k) /= spval) then + local_secpl = secs + grc%londeg(k)/degpsec + local_secpl = mod(local_secpl,isecspday) + + if (local_secpl >= tod - dtime .and. local_secpl < tod) then + if (nacs(k,1) == 0) hbuf(k,1) = 0._r8 + hbuf(k,1) = hbuf(k,1) + field_gcell(k)*real(dtime-tod+local_secpl) + nacs(k,1) = nacs(k,1) + dtime-tod+local_secpl + else if (local_secpl >= tod .and. local_secpl < tod + dtime) then + if (nacs(k,1) == 0) hbuf(k,1) = 0._r8 + hbuf(k,1) = hbuf(k,1) + field_gcell(k)*real(dtime+tod-local_secpl) + nacs(k,1) = nacs(k,1) + dtime+tod-local_secpl + end if + + if (tod < dtime .and. local_secpl > isecspday-dtime) then + local_secpl = local_secpl - isecspday + if (local_secpl >= tod - dtime .and. local_secpl < tod) then + if (nacs(k,1) == 0) hbuf(k,1) = 0._r8 + hbuf(k,1) = hbuf(k,1) + field_gcell(k)*real(dtime-tod+local_secpl) + nacs(k,1) = nacs(k,1) + dtime-tod+local_secpl + end if + end if + + else + if (nacs(k,1) == 0) hbuf(k,1) = spval + end if + end do + + case default + write(iulog,*) trim(subname),' ERROR: invalid time averaging flag ', avgflag + call endrun(msg=errMsg(sourcefile, __LINE__)) end select deallocate( field_gcell ) else ! Do not map to gridcell + allocate( grid_index(beg1d:end1d) ) + ! For data defined on the pft, col or landunit, we need to check if a point is active ! to determine whether that point should be assigned spval if (type1d == namep) then @@ -1532,7 +1535,9 @@ subroutine hist_update_hbuf_field_1d (t, f, bounds) check_active = .false. end if - select case (avgflag) + avgflag_trim = avgflag(1:1) + + select case (avgflag_trim) case ('I') ! Instantaneous do k = beg1d,end1d valid = .true. @@ -1550,7 +1555,7 @@ subroutine hist_update_hbuf_field_1d (t, f, bounds) end if nacs(k,1) = 1 end do - case ('A', 'SUM') ! Time average / sum + case ('A', 'S') ! Time average / sum ! create mappings for array slice pointers (which go from 1 to size(field) rather than beg1d to end1d) if ( end1d .eq. ubound(field,1) ) then k_offset = 0 @@ -1610,59 +1615,57 @@ subroutine hist_update_hbuf_field_1d (t, f, bounds) end if nacs(k,1) = 1 end do - case ('L') ! Local solar time - tod = tods(t) + case ('L') ! Local solar time + + read(avgflag(2:6), *) tod if ( end1d .eq. ubound(field,1) ) then k_offset = 0 else - k_offset = 1 - beg1d + k_offset = 1 - beg1d endif - do k = beg1d, end1d - valid = .true. - if (check_active) then - if (.not. active(k)) then - valid = .false. - else - local_secpl = secs + grc%londeg(grid_index(k))/degpsec - end if - else - local_secpl = secs + grc%londeg(k)/degpsec - - end if - local_secpl = mod(local_secpl,isecspday) - - if (valid) then - if (local_secpl >= tod - dtime .and. local_secpl < tod .and. field(k+k_offset) /= spval) then - if (nacs(k,1) == 0) hbuf(k,1) = 0._r8 - hbuf(k,1) = hbuf(k,1) + field(k+k_offset)*real(dtime-tod+local_secpl) - nacs(k,1) = nacs(k,1) + dtime-tod+local_secpl - else if (local_secpl >= tod .and. local_secpl < tod + dtime .and. field(k+k_offset) /= spval) then + do k = beg1d, end1d + valid = .true. + if (check_active) then + if (.not. active(k)) then + valid = .false. + else + local_secpl = secs + grc%londeg(grid_index(k))/degpsec + end if + else + local_secpl = secs + grc%londeg(k)/degpsec + + end if + local_secpl = mod(local_secpl,isecspday) + + if (valid) then + if (local_secpl >= tod - dtime .and. local_secpl < tod .and. field(k+k_offset) /= spval) then + if (nacs(k,1) == 0) hbuf(k,1) = 0._r8 + hbuf(k,1) = hbuf(k,1) + field(k+k_offset)*real(dtime-tod+local_secpl) + nacs(k,1) = nacs(k,1) + dtime-tod+local_secpl + else if (local_secpl >= tod .and. local_secpl < tod + dtime .and. field(k+k_offset) /= spval) then + if (nacs(k,1) == 0) hbuf(k,1) = 0._r8 + hbuf(k,1) = hbuf(k,1) + field(k+k_offset)*real(dtime+tod-local_secpl) + nacs(k,1) = nacs(k,1) + dtime+tod-local_secpl + end if + + if (tod < dtime .and. local_secpl > isecspday-dtime .and. field(k+k_offset) /= spval) then + local_secpl = local_secpl - isecspday + if (local_secpl >= tod - dtime .and. local_secpl < tod) then if (nacs(k,1) == 0) hbuf(k,1) = 0._r8 - hbuf(k,1) = hbuf(k,1) + field(k+k_offset)*real(dtime+tod-local_secpl) - nacs(k,1) = nacs(k,1) + dtime+tod-local_secpl - end if - - if (tod < dtime .and. local_secpl > isecspday-dtime .and. field(k+k_offset) /= spval) then - local_secpl = local_secpl - isecspday - if (local_secpl >= tod - dtime .and. local_secpl < tod) then - if (nacs(k,1) == 0) hbuf(k,1) = 0._r8 - hbuf(k,1) = hbuf(k,1) + field(k+k_offset)*real(dtime-tod+local_secpl) - nacs(k,1) = nacs(k,1) + dtime-tod+local_secpl - end if - end if - - else - if (nacs(k,1) == 0) hbuf(k,1) = spval - end if - end do - - case default - - write(iulog,*) trim(subname),' ERROR: invalid time averaging flag ', avgflag - call endrun(msg=errMsg(sourcefile, __LINE__)) - + hbuf(k,1) = hbuf(k,1) + field(k+k_offset)*real(dtime-tod+local_secpl) + nacs(k,1) = nacs(k,1) + dtime-tod+local_secpl + end if + end if + + else + if (nacs(k,1) == 0) hbuf(k,1) = spval + end if + end do + case default + write(iulog,*) trim(subname),' ERROR: invalid time averaging flag ', avgflag + call endrun(msg=errMsg(sourcefile, __LINE__)) end select end if @@ -1722,8 +1725,10 @@ subroutine hist_update_hbuf_field_2d (t, f, bounds, num2d) integer :: local_secpl ! seconds into current date in local time integer :: dtime ! timestep size [seconds] integer :: tod ! Desired local solar time of output in seconds - integer, allocatable :: grid_index(:) ! Grid cell index for longitude + integer, allocatable :: grid_index(:) ! Grid cell index for longitude integer, allocatable :: tods(:) + character(len=1) :: avgflag_trim ! first character of avgflag + !----------------------------------------------------------------------- SHR_ASSERT_FL(bounds%level == BOUNDS_LEVEL_PROC, sourcefile, __LINE__) @@ -1742,8 +1747,9 @@ subroutine hist_update_hbuf_field_2d (t, f, bounds, num2d) l2g_scale_type = tape(t)%hlist(f)%field%l2g_scale_type no_snow_behavior = tape(t)%hlist(f)%field%no_snow_behavior hpindex = tape(t)%hlist(f)%field%hpindex - tods = (/0, 0, 0, 10800, 43200, 54000, 0, 10800, 54000 /) + dtime = get_step_size() + call get_curr_date (year, month, day, secs) if (no_snow_behavior /= no_snow_unset) then ! For multi-layer snow fields, build a special output variable that handles @@ -1769,9 +1775,6 @@ subroutine hist_update_hbuf_field_2d (t, f, bounds, num2d) field_allocated = .false. end if - dtime = get_step_size() - call get_curr_date (year, month, day, secs) - ! set variables to check weights when allocate all pfts map2gcell = .false. @@ -1854,8 +1857,9 @@ subroutine hist_update_hbuf_field_2d (t, f, bounds, num2d) if (map2gcell) then ! Map to gridcell + avgflag_trim = avgflag(1:1) ! note that in this case beg1d = begg and end1d=endg - select case (avgflag) + select case (avgflag_trim) case ('I') ! Instantaneous do j = 1,num2d do k = beg1d_out, end1d_out @@ -1867,7 +1871,7 @@ subroutine hist_update_hbuf_field_2d (t, f, bounds, num2d) nacs(k,j) = 1 end do end do - case ('A', 'SUM') ! Time average / sum + case ('A', 'S') ! Time average / sum do j = 1,num2d do k = beg1d_out, end1d_out if (field_gcell(k,j) /= spval) then @@ -1904,40 +1908,41 @@ subroutine hist_update_hbuf_field_2d (t, f, bounds, num2d) end do end do case ('L') ! Local solar time - tod = tods(t) + read(avgflag(2:6), *) tod do j = 1,num2d - do k = beg1d_out, end1d_out - if (field_gcell(k,j) /= spval) then - - local_secpl = secs + grc%londeg(k)/degpsec - local_secpl = mod(local_secpl,isecspday) - - if (local_secpl >= tod - dtime .and. local_secpl < tod) then - if (nacs(k,j) == 0) hbuf(k,j) = 0._r8 - hbuf(k,j) = hbuf(k,j) + field_gcell(k,j)*real(dtime-tod+local_secpl) - nacs(k,j) = nacs(k,j) + dtime-tod+local_secpl - else if (local_secpl >= tod .and. local_secpl < tod + dtime) then - if (nacs(k,j) == 0) hbuf(k,j) = 0._r8 - hbuf(k,j) = hbuf(k,j) + field_gcell(k,j)*real(dtime+tod-local_secpl) - nacs(k,j) = nacs(k,j) + dtime+tod-local_secpl - end if - - if (tod < dtime .and. local_secpl > isecspday-dtime) then - local_secpl = local_secpl - isecspday - if (local_secpl >= tod - dtime .and. local_secpl < tod) then - if (nacs(k,j) == 0) hbuf(k,j) = 0._r8 - hbuf(k,j) = hbuf(k,j) + field_gcell(k,j)*real(dtime-tod+local_secpl) - nacs(k,j) = nacs(k,j) + dtime-tod+local_secpl - end if - end if - - else - if (nacs(k,j) == 0) hbuf(k,j) = spval - - end if - end do + do k = beg1d_out, end1d_out + if (field_gcell(k,j) /= spval) then + + local_secpl = secs + grc%londeg(k)/degpsec + local_secpl = mod(local_secpl,isecspday) + + if (local_secpl >= tod - dtime .and. local_secpl < tod) then + if (nacs(k,j) == 0) hbuf(k,j) = 0._r8 + hbuf(k,j) = hbuf(k,j) + field_gcell(k,j)*real(dtime-tod+local_secpl) + nacs(k,j) = nacs(k,j) + dtime-tod+local_secpl + else if (local_secpl >= tod .and. local_secpl < tod + dtime) then + if (nacs(k,j) == 0) hbuf(k,j) = 0._r8 + hbuf(k,j) = hbuf(k,j) + field_gcell(k,j)*real(dtime+tod-local_secpl) + nacs(k,j) = nacs(k,j) + dtime+tod-local_secpl + end if + + if (tod < dtime .and. local_secpl > isecspday-dtime) then + local_secpl = local_secpl - isecspday + if (local_secpl >= tod - dtime .and. local_secpl < tod) then + if (nacs(k,j) == 0) hbuf(k,j) = 0._r8 + hbuf(k,j) = hbuf(k,j) + field_gcell(k,j)*real(dtime-tod+local_secpl) + nacs(k,j) = nacs(k,j) + dtime-tod+local_secpl + end if + end if + + else + if (nacs(k,j) == 0) hbuf(k,j) = spval + + end if + end do end do + case default write(iulog,*) trim(subname),' ERROR: invalid time averaging flag ', avgflag call endrun(msg=errMsg(sourcefile, __LINE__)) @@ -1970,8 +1975,8 @@ subroutine hist_update_hbuf_field_2d (t, f, bounds, num2d) ! Note that since field points to an array section the ! bounds are field(1:end1d-beg1d+1, num2d) - therefore ! need to do the shifting below - - select case (avgflag) + avgflag_trim = avgflag(1:1) + select case (avgflag_trim) case ('I') ! Instantaneous do j = 1,num2d do k = beg1d,end1d @@ -1991,7 +1996,7 @@ subroutine hist_update_hbuf_field_2d (t, f, bounds, num2d) nacs(k,j) = 1 end do end do - case ('A', 'SUM') ! Time average / sum + case ('A', 'S') ! Time average / sum do j = 1,num2d do k = beg1d,end1d valid = .true. @@ -2052,47 +2057,48 @@ subroutine hist_update_hbuf_field_2d (t, f, bounds, num2d) end do end do case ('L') ! Local solar time - tod = tods(t) + read(avgflag(2:6), *) tod do j = 1,num2d - do k = beg1d, end1d - valid = .true. - if (check_active) then - if (.not. active(k)) then - valid = .false. - else - local_secpl = secs + grc%londeg(grid_index(k))/degpsec - end if - else - local_secpl = secs + grc%londeg(k)/degpsec - end if - local_secpl = mod(local_secpl,isecspday) - - if (valid) then - if (local_secpl >= tod - dtime .and. local_secpl < tod .and. field(k-beg1d+1,j) /= spval) then - if (nacs(k,j) == 0) hbuf(k,j) = 0._r8 - hbuf(k,j) = hbuf(k,j) + field(k-beg1d+1,j)*real(dtime-tod+local_secpl) - nacs(k,j) = nacs(k,j) + dtime-tod+local_secpl - else if (local_secpl >= tod .and. local_secpl < tod + dtime .and. field(k-beg1d+1,j) /= spval) then - if (nacs(k,j) == 0) hbuf(k,j) = 0._r8 - hbuf(k,j) = hbuf(k,j) + field(k-beg1d+1,j)*real(dtime+tod-local_secpl) - nacs(k,j) = nacs(k,j) + dtime+tod-local_secpl - end if - - if (tod < dtime .and. local_secpl > isecspday-dtime .and. field(k-beg1d+1,j) /= spval) then - local_secpl = local_secpl - isecspday - if (local_secpl >= tod - dtime .and. local_secpl < tod) then - if (nacs(k,j) == 0) hbuf(k,j) = 0._r8 - hbuf(k,j) = hbuf(k,j) + field(k-beg1d+1,j)*real(dtime-tod+local_secpl) - nacs(k,j) = nacs(k,j) + dtime-tod+local_secpl - end if - end if - - else - if (nacs(k,j) == 0) hbuf(k,j) = spval - end if - end do - end do + do k = beg1d, end1d + valid = .true. + if (check_active) then + if (.not. active(k)) then + valid = .false. + else + local_secpl = secs + grc%londeg(grid_index(k))/degpsec + end if + else + local_secpl = secs + grc%londeg(k)/degpsec + end if + local_secpl = mod(local_secpl,isecspday) + + if (valid) then + if (local_secpl >= tod - dtime .and. local_secpl < tod .and. field(k-beg1d+1,j) /= spval) then + if (nacs(k,j) == 0) hbuf(k,j) = 0._r8 + hbuf(k,j) = hbuf(k,j) + field(k-beg1d+1,j)*real(dtime-tod+local_secpl) + nacs(k,j) = nacs(k,j) + dtime-tod+local_secpl + else if (local_secpl >= tod .and. local_secpl < tod + dtime .and. field(k-beg1d+1,j) /= spval) then + if (nacs(k,j) == 0) hbuf(k,j) = 0._r8 + hbuf(k,j) = hbuf(k,j) + field(k-beg1d+1,j)*real(dtime+tod-local_secpl) + nacs(k,j) = nacs(k,j) + dtime+tod-local_secpl + end if + + if (tod < dtime .and. local_secpl > isecspday-dtime .and. field(k-beg1d+1,j) /= spval) then + local_secpl = local_secpl - isecspday + if (local_secpl >= tod - dtime .and. local_secpl < tod) then + if (nacs(k,j) == 0) hbuf(k,j) = 0._r8 + hbuf(k,j) = hbuf(k,j) + field(k-beg1d+1,j)*real(dtime-tod+local_secpl) + nacs(k,j) = nacs(k,j) + dtime-tod+local_secpl + end if + end if + + else + if (nacs(k,j) == 0) hbuf(k,j) = spval + end if + end do + end do + case default write(iulog,*) trim(subname),' ERROR: invalid time averaging flag ', avgflag call endrun(msg=errMsg(sourcefile, __LINE__)) @@ -2237,7 +2243,7 @@ subroutine hfields_normalize (t) nacs => tape(t)%hlist(f)%nacs hbuf => tape(t)%hlist(f)%hbuf - if (avgflag == 'A' .or. avgflag == 'L') then + if (avgflag == 'A' .or. avgflag(1:1) == 'L') then aflag = .true. else aflag = .false. @@ -2247,7 +2253,7 @@ subroutine hfields_normalize (t) do k = beg1d, end1d if (aflag .and. nacs(k,j) /= 0) then hbuf(k,j) = hbuf(k,j) / float(nacs(k,j)) - elseif(avgflag == 'L' .and. nacs(k,j) == 0) then + elseif (avgflag(1:1) == 'L' .and. nacs(k,j) == 0) then hbuf(k,j) = spval end if end do @@ -3330,8 +3336,6 @@ subroutine hfields_write(t, mode) real(r8), pointer :: histo(:,:) ! temporary real(r8), pointer :: hist1do(:) ! temporary character(len=*),parameter :: subname = 'hfields_write' - integer :: tod ! Desired local solar time of output in seconds - !----------------------------------------------------------------------- ! Write/define 1d topological info @@ -3368,7 +3372,7 @@ subroutine hfields_write(t, mode) if (mode == 'define') then - select case (avgflag) + select case (avgflag(1:1)) case ('A') avgstr = 'mean' case ('I') @@ -3377,10 +3381,10 @@ subroutine hfields_write(t, mode) avgstr = 'maximum' case ('M') avgstr = 'minimum' - case ('SUM') + case ('S') avgstr = 'sum' case ('L') - avgstr = 'inst. local time' + avgstr = 'local solar time' case default write(iulog,*) trim(subname),' ERROR: unknown time averaging flag (avgflag)=',avgflag call endrun(msg=errMsg(sourcefile, __LINE__)) @@ -5733,6 +5737,7 @@ function avgflag_valid(avgflag, blank_valid) result(valid) ! Returns true if the given avgflag is a valid option, false if not ! ! !USES: + use clm_varcon , only : isecspday ! ! !ARGUMENTS: logical :: valid ! function result @@ -5742,6 +5747,7 @@ function avgflag_valid(avgflag, blank_valid) result(valid) ! !LOCAL VARIABLES: character(len=*), parameter :: subname = 'avgflag_valid' + integer :: tod ! Desired local solar time of output in seconds !----------------------------------------------------------------------- ! This initial check is mainly here to catch the possibility that someone has added a @@ -5753,8 +5759,16 @@ function avgflag_valid(avgflag, blank_valid) result(valid) valid = .true. else if (avgflag == 'A' .or. avgflag == 'I' .or. & avgflag == 'X' .or. avgflag == 'M' .or. & - avgflag == 'SUM' .or. avgflag == 'L') then + avgflag == 'SUM') then valid = .true. + else if (avgflag(1:1) == 'L') then + read(avgflag(2:6), *) tod + if (tod >= 0 .and. tod <= isecspday) then + valid = .true. + else + valid = .false. + end if + else valid = .false. end if diff --git a/src/main/pftconMod.F90 b/src/main/pftconMod.F90 index 0a1c0b50bc..8f05d08b79 100644 --- a/src/main/pftconMod.F90 +++ b/src/main/pftconMod.F90 @@ -123,6 +123,12 @@ module pftconMod real(r8), allocatable :: z0mr (:) ! ratio of momentum roughness length to canopy top height (-) real(r8), allocatable :: z0v_h (:) ! ratio of vegetation surface roughness length to canopy height for forests (-) real(r8), allocatable :: z0v_alpha (:) ! alpha parameter for decrease of vegetation surface roughness with LAI for forests (-) + real(r8), allocatable :: z0v_Cr (:) ! roughness-element drag coefficient for Raupach92 parameterization (-) + real(r8), allocatable :: z0v_Cs (:) ! substrate-element drag coefficient for Raupach92 parameterization (-) + real(r8), allocatable :: z0v_c (:) ! c parameter for Raupach92 parameterization (-) + real(r8), allocatable :: z0v_cw (:) ! roughness sublayer depth coefficient for Raupach92 parameterization (-) + real(r8), allocatable :: z0v_LAIoff (:) ! leaf area index offset for Raupach92 parameterization (-) + real(r8), allocatable :: z0v_LAImax (:) ! onset of over-sheltering for Raupach92 parameterization (-) real(r8), allocatable :: displar (:) ! ratio of displacement height to canopy top height (-) real(r8), allocatable :: roota_par (:) ! CLM rooting distribution parameter [1/m] real(r8), allocatable :: rootb_par (:) ! CLM rooting distribution parameter [1/m] @@ -359,7 +365,13 @@ subroutine InitAllocate (this) allocate( this%taul (0:mxpft,numrad) ) allocate( this%taus (0:mxpft,numrad) ) allocate( this%z0mr (0:mxpft) ) - allocate( this%z0v_h (0:mxpft) ) + allocate( this%z0v_h (0:mxpft) ) + allocate( this%z0v_Cr (0:mxpft) ) + allocate( this%z0v_Cs (0:mxpft) ) + allocate( this%z0v_c (0:mxpft) ) + allocate( this%z0v_cw (0:mxpft) ) + allocate( this%z0v_LAIoff (0:mxpft) ) + allocate( this%z0v_LAImax (0:mxpft) ) allocate( this%z0v_alpha (0:mxpft) ) allocate( this%displar (0:mxpft) ) allocate( this%roota_par (0:mxpft) ) @@ -501,7 +513,7 @@ subroutine InitRead(this) use fileutils , only : getfil use ncdio_pio , only : ncd_io, ncd_pio_closefile, ncd_pio_openfile, file_desc_t use ncdio_pio , only : ncd_inqdid, ncd_inqdlen - use clm_varctl , only : paramfile, use_fates, use_flexibleCN, use_dynroot, use_biomass_heat_storage, use_z0v_forest + use clm_varctl , only : paramfile, use_fates, use_flexibleCN, use_dynroot, use_biomass_heat_storage, use_z0v_forest, z0param_method use spmdMod , only : masterproc use CLMFatesParamInterfaceMod, only : FatesReadPFTs ! @@ -631,9 +643,6 @@ subroutine InitRead(this) call ncd_io('pftname',pftname, 'read', ncid, readvar=readv, posNOTonfile=.true.) if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) - call ncd_io('z0mr', this%z0mr, 'read', ncid, readvar=readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) - ! ! Use new vegetation surface roughness parameterization for forests ! @@ -649,6 +658,46 @@ subroutine InitRead(this) this%z0v_alpha = 0._r8 end if + select case (z0param_method) + case ('ZengWang2007') + call ncd_io('z0mr', this%z0mr, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) + this%z0v_Cr = 0._r8 + this%z0v_Cs = 0._r8 + this%z0v_c = 0._r8 + this%z0v_cw = 0._r8 + this%z0v_LAImax = 0._r8 + this%z0v_LAIoff = 0._r8 + + case ('MeierXXXX') + call ncd_io('z0v_Cr', this%z0v_Cr, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) + + call ncd_io('z0v_Cs', this%z0v_Cs, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) + + call ncd_io('z0v_c', this%z0v_c, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) + + call ncd_io('z0v_cw', this%z0v_cw, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) + + call ncd_io('z0v_LAImax', this%z0v_LAImax, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) + + call ncd_io('z0v_LAIoff', this%z0v_LAIoff, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) + + this%z0mr = 0._r8 + + case default + write(iulog,*) subname//' ERROR: unknown z0param_method: ', & + z0param_method + call endrun(msg = 'unknown z0param_method', & + additional_msg = errMsg(sourcefile, __LINE__)) + end select + + call ncd_io('displar', this%displar, 'read', ncid, readvar=readv, posNOTonfile=.true.) if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) @@ -1369,6 +1418,12 @@ subroutine Clean(this) deallocate( this%taus) deallocate( this%z0mr) deallocate( this%z0v_h) + deallocate( this%z0v_Cr) + deallocate( this%z0v_Cs) + deallocate( this%z0v_c) + deallocate( this%z0v_cw) + deallocate( this%z0v_LAImax) + deallocate( this%z0v_LAIoff) deallocate( this%z0v_alpha) deallocate( this%displar) deallocate( this%roota_par) From def8ee3d799343fc373dbb5cd98da854c3f14508 Mon Sep 17 00:00:00 2001 From: Ronny Meier Date: Mon, 17 May 2021 09:41:22 +0200 Subject: [PATCH 004/257] Saving state --- src/biogeophys/BareGroundFluxesMod.F90 | 23 ++++++++---- src/biogeophys/CanopyFluxesMod.F90 | 12 +++--- src/biogeophys/FrictionVelocityMod.F90 | 45 +++++++++++++++++++++-- src/biogeophys/LakeFluxesMod.F90 | 51 +++++++++++++++++++------- 4 files changed, 101 insertions(+), 30 deletions(-) diff --git a/src/biogeophys/BareGroundFluxesMod.F90 b/src/biogeophys/BareGroundFluxesMod.F90 index 45015b8861..4ad975a1c1 100644 --- a/src/biogeophys/BareGroundFluxesMod.F90 +++ b/src/biogeophys/BareGroundFluxesMod.F90 @@ -81,7 +81,7 @@ subroutine BareGroundFluxes(bounds, num_noexposedvegp, filter_noexposedvegp, & use shr_const_mod , only : SHR_CONST_RGAS use clm_varpar , only : nlevgrnd use clm_varcon , only : cpair, vkc, grav, denice, denh2o - use clm_varctl , only : use_lch4 + use clm_varctl , only : use_lch4, z0param_method use landunit_varcon , only : istsoil, istcrop use QSatMod , only : QSat use SurfaceResistanceMod , only : do_soilevap_beta,do_soil_resistance_sl14 @@ -137,9 +137,6 @@ subroutine BareGroundFluxes(bounds, num_noexposedvegp, filter_noexposedvegp, & real(r8) :: raih ! temporary variable [kg/m2/s] real(r8) :: raiw ! temporary variable [kg/m2/s] real(r8) :: fm(bounds%begp:bounds%endp) ! needed for BGC only to diagnose 10m wind speed - real(r8) :: z0mg_patch(bounds%begp:bounds%endp) - real(r8) :: z0hg_patch(bounds%begp:bounds%endp) - real(r8) :: z0qg_patch(bounds%begp:bounds%endp) real(r8) :: e_ref2m ! 2 m height surface saturated vapor pressure [Pa] real(r8) :: qsat_ref2m ! 2 m height surface saturated specific humidity [kg/kg] real(r8) :: www ! surface soil wetness [-] @@ -240,6 +237,10 @@ subroutine BareGroundFluxes(bounds, num_noexposedvegp, filter_noexposedvegp, & z0mg_col => frictionvel_inst%z0mg_col , & ! Output: [real(r8) (:) ] roughness length, momentum [m] z0hg_col => frictionvel_inst%z0hg_col , & ! Output: [real(r8) (:) ] roughness length, sensible heat [m] z0qg_col => frictionvel_inst%z0qg_col , & ! Output: [real(r8) (:) ] roughness length, latent heat [m] + z0mg_patch => frictionvel_inst%z0mg_patch , & ! Output: [real(r8) (:) ] patch roughness length, momentum [m] + z0hg_patch => frictionvel_inst%z0hg_patch , & ! Output: [real(r8) (:) ] patch roughness length, sensible heat [m] + z0qg_patch => frictionvel_inst%z0qg_patch , & ! Output: [real(r8) (:) ] patch roughness length, latent heat [m] + kbm1 => frictionvel_inst%kbm1_patch , & ! Output: [real(r8) (:) ] natural logarithm of z0mg_p/z0hg_p [-] ram1 => frictionvel_inst%ram1_patch , & ! Output: [real(r8) (:) ] aerodynamical resistance (s/m) num_iter => frictionvel_inst%num_iter_patch , & ! Output: [real(r8) (:) ] number of iterations htvp => energyflux_inst%htvp_col , & ! Input: [real(r8) (:) ] latent heat of evaporation (/sublimation) [J/kg] @@ -329,9 +330,15 @@ subroutine BareGroundFluxes(bounds, num_noexposedvegp, filter_noexposedvegp, & tstar = temp1(p)*dth(p) qstar = temp2(p)*dqh(p) - !z0hg_patch(p) = z0mg_patch(p) / exp(0.4_r8*0.52_r8 * (8._r8*z0mg_patch(p)*ustar(p) / 1.5e-5_r8)**0.45_r8 * 0.71_r8**0.8_r8) ! OT63 - z0hg_patch(p) = 70._r8 * 1.5e-5_r8 / ustar(p) * exp( -7.2_r8 * ustar(p)**(0.5_r8) * (abs(tstar))**(0.25_r8)) ! Yang07 -!z0mg_patch(p) / exp(params_inst%a_coef * (ustar(p) * z0mg_patch(p) / 1.5e-5_r8)**params_inst%a_exp) + + select case (z0param_method) + case ('ZengWang2007') + z0mg_patch(p) = z0mg_patch(p) / exp(params_inst%a_coef * (ustar(p) * z0mg_patch(p) / 1.5e-5_r8)**params_inst%a_exp) + case ('MeierXXXX') + ! After Yang et al. (2007) + z0hg_patch(p) = 70._r8 * 1.5e-5_r8 / ustar(p) * exp( -7.2_r8 * ustar(p)**(0.5_r8) * (abs(tstar))**(0.25_r8)) + end select + z0qg_patch(p) = z0hg_patch(p) thvstar = tstar*(1._r8+0.61_r8*forc_q(c)) + 0.61_r8*forc_th(c)*qstar zeta = zldis(p)*vkc*grav*thvstar/(ustar(p)**2*thv(c)) @@ -435,6 +442,8 @@ subroutine BareGroundFluxes(bounds, num_noexposedvegp, filter_noexposedvegp, & t_ref2m_r(p) = t_ref2m(p) end if + kbm1(p) = log(z0mg_patch(p) / z0hg_patch(p)) + ! Human Heat Stress if ( all_human_stress_indices .or. fast_human_stress_indices ) then call KtoC(t_ref2m(p), tc_ref2m(p)) diff --git a/src/biogeophys/CanopyFluxesMod.F90 b/src/biogeophys/CanopyFluxesMod.F90 index e83ac21d9c..803ed73d39 100644 --- a/src/biogeophys/CanopyFluxesMod.F90 +++ b/src/biogeophys/CanopyFluxesMod.F90 @@ -901,9 +901,6 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, case ('MeierXXXX') lt = max(0.00001_r8,elai(p)+esai(p)-z0v_LAIoff(patch%itype(p))) - if(elai(p)+esai(p) == 0._r8) then - write(iulog,*) 'VAI = 0 ', lt, (1._r8 - (1._r8 - exp(-(7.5_r8 * lt)**0.5_r8)) / (7.5_r8*lt)**0.5_r8),(1._r8 - exp(-(7.5_r8 * lt)**0.5_r8)) - end if displa(p) = htop(p) * (1._r8 - (1._r8 - exp(-(7.5_r8 * lt)**0.5_r8)) / (7.5_r8*lt)**0.5_r8) lt = min(lt,z0v_LAImax(patch%itype(p))) @@ -919,7 +916,7 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, end do U_ustar = 4._r8 * U_ustar / lt / z0v_c(patch%itype(p)) - z0mv(p) = htop(p) * (1._r8 - displa(p) / htop(p)) * exp(-0.4_r8 * U_ustar + & + z0mv(p) = htop(p) * (1._r8 - displa(p) / htop(p)) * exp(-vkc * U_ustar + & log(z0v_cw(patch%itype(p))) - 1._r8 + z0v_cw(patch%itype(p))**(-1._r8)) case default @@ -1065,7 +1062,9 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, ! changed by K.Sakaguchi from here ! transfer coefficient over bare soil is changed to a local variable ! just for readability of the code (from line 680) + ! not sure if this needs to be changed with MeierXXXX too. csoilb = vkc / (params_inst%a_coef * (z0mg(c) * uaf(p) / 1.5e-5_r8)**params_inst%a_exp) + !compute the stability parameter for ricsoilc ("S" in Sakaguchi&Zeng,2008) @@ -1463,9 +1462,10 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, dt_stem(p) = 0._r8 endif - dhsdt_canopy(p) = dt_stem(p)*cp_stem(p)/dtime & - +(t_veg(p)-tl_ini(p))*cp_leaf(p)/dtime + dhsdt_canopy(p) = dt_stem(p)*cp_stem(p)/dtime & + + (t_veg(p)-tl_ini(p))*cp_leaf(p)/dtime + t_stem(p) = t_stem(p) + dt_stem(p) else dt_stem(p) = 0._r8 diff --git a/src/biogeophys/FrictionVelocityMod.F90 b/src/biogeophys/FrictionVelocityMod.F90 index 9829a70563..c22deee275 100644 --- a/src/biogeophys/FrictionVelocityMod.F90 +++ b/src/biogeophys/FrictionVelocityMod.F90 @@ -53,6 +53,10 @@ module FrictionVelocityMod real(r8), pointer, public :: z0mv_patch (:) ! patch roughness length over vegetation, momentum [m] real(r8), pointer, public :: z0hv_patch (:) ! patch roughness length over vegetation, sensible heat [m] real(r8), pointer, public :: z0qv_patch (:) ! patch roughness length over vegetation, latent heat [m] + real(r8), pointer, public :: z0mg_patch (:) ! patch roughness length over ground, momentum [m] + real(r8), pointer, public :: z0hg_patch (:) ! patch roughness length over ground, sensible heat [m] + real(r8), pointer, public :: z0qg_patch (:) ! patch roughness length over ground, latent heat [m] + real(r8), pointer, public :: kbm1_patch (:) ! natural logarithm of z0mg_p/z0hg_p [-] real(r8), pointer, public :: z0mg_col (:) ! col roughness length over ground, momentum [m] real(r8), pointer, public :: z0hg_col (:) ! col roughness length over ground, sensible heat [m] real(r8), pointer, public :: z0qg_col (:) ! col roughness length over ground, latent heat [m] @@ -150,6 +154,10 @@ subroutine InitAllocate(this, bounds) allocate(this%z0mv_patch (begp:endp)) ; this%z0mv_patch (:) = nan allocate(this%z0hv_patch (begp:endp)) ; this%z0hv_patch (:) = nan allocate(this%z0qv_patch (begp:endp)) ; this%z0qv_patch (:) = nan + allocate(this%z0mg_patch (begp:endp)) ; this%z0mg_patch (:) = nan + allocate(this%z0hg_patch (begp:endp)) ; this%z0hg_patch (:) = nan + allocate(this%z0qg_patch (begp:endp)) ; this%z0qg_patch (:) = nan + allocate(this%kbm1_patch (begp:endp)) ; this%kbm1_patch (:) = nan allocate(this%z0mg_col (begc:endc)) ; this%z0mg_col (:) = nan allocate(this%z0qg_col (begc:endc)) ; this%z0qg_col (:) = nan allocate(this%z0hg_col (begc:endc)) ; this%z0hg_col (:) = nan @@ -310,6 +318,26 @@ subroutine InitHistory(this, bounds) avgflag='A', long_name='roughness length over vegetation, latent heat', & ptr_patch=this%z0qv_patch, default='inactive') + this%z0hg_patch(begp:endp) = spval + call hist_addfld1d (fname='Z0HG_P', units='m', & + avgflag='A', long_name='patch roughness length over ground, sensible heat', & + ptr_patch=this%z0hg_patch, default='inactive') + + this%z0mg_patch(begp:endp) = spval + call hist_addfld1d (fname='Z0MG_P', units='m', & + avgflag='A', long_name='patch roughness length over ground, momentum', & + ptr_patch=this%z0mg_patch, default='inactive') + + this%z0qg_patch(begp:endp) = spval + call hist_addfld1d (fname='Z0QG_P', units='m', & + avgflag='A', long_name='patch roughness length over ground, latent heat', & + ptr_patch=this%z0qg_patch, default='inactive') + + this%kbm1_patch(begp:endp) = spval + call hist_addfld1d (fname='KBM1', units='unitless', & + avgflag='A', long_name='natural logarithm of Z0MG_P/Z0HG_P', & + ptr_patch=this%kbm1_patch, default='inactive') + if (use_luna) then call hist_addfld1d (fname='RB10', units='s/m', & avgflag='A', long_name='10 day running mean boundary layer resistance', & @@ -506,6 +534,10 @@ subroutine SetRoughnessLengthsAndForcHeightsNonLake(this, bounds, & z0mv => this%z0mv_patch , & ! Output: [real(r8) (:) ] roughness length over vegetation, momentum [m] z0hv => this%z0hv_patch , & ! Output: [real(r8) (:) ] roughness length over vegetation, sensible heat [m] z0qv => this%z0qv_patch , & ! Output: [real(r8) (:) ] roughness length over vegetation, latent heat [m] + z0mg_p => this%z0mg_patch , & ! Output: [real(r8) (:) ] patch roughness length over ground, momentum [m] + z0hg_p => this%z0hg_patch , & ! Output: [real(r8) (:) ] patch roughness length over ground, sensible heat [m] + z0qg_p => this%z0qg_patch , & ! Output: [real(r8) (:) ] patch roughness length over ground, latent heat [m] + kbm1 => this%kbm1_patch , & ! Output: [real(r8) (:) ] natural logarithm of z0mg_p/z0hg_p [-] z0hg => this%z0hg_col , & ! Output: [real(r8) (:) ] roughness length over ground, sensible heat [m] z0mg => this%z0mg_col , & ! Output: [real(r8) (:) ] roughness length over ground, momentum [m] z0qg => this%z0qg_col , & ! Output: [real(r8) (:) ] roughness length over ground, latent heat [m] @@ -540,10 +572,10 @@ subroutine SetRoughnessLengthsAndForcHeightsNonLake(this, bounds, & end if case ('MeierXXXX') ! Bare ground and ice have a different value l = col%landunit(c) - if (lun%itype(l) == istice_mec) then - z0mg(c) = this%zglc - else if (frac_sno(c) > 0._r8) then + if (frac_sno(c) > 0._r8) then ! Do snow first because ice could be snow-covered z0mg(c) = this%zsno + else if (lun%itype(l) == istice_mec) then + z0mg(c) = this%zglc else z0mg(c) = this%zlnd end if @@ -560,6 +592,13 @@ subroutine SetRoughnessLengthsAndForcHeightsNonLake(this, bounds, & z0mv(p) = z0m(p) z0hv(p) = z0mv(p) z0qv(p) = z0mv(p) + + ! Set to arbitrary value (will be overwritten by respective modules + z0mg_p(p) = spval + z0hg_p(p) = spval + z0qg_p(p) = spval + kbm1(p) = spval + end do ! Make forcing height a patch-level quantity that is the atmospheric forcing diff --git a/src/biogeophys/LakeFluxesMod.F90 b/src/biogeophys/LakeFluxesMod.F90 index 4f08e6c4c0..367e9eab40 100644 --- a/src/biogeophys/LakeFluxesMod.F90 +++ b/src/biogeophys/LakeFluxesMod.F90 @@ -125,6 +125,10 @@ subroutine LakeFluxes(bounds, num_lakec, filter_lakec, num_lakep, filter_lakep, real(r8), pointer :: z0mg_col(:) ! roughness length over ground, momentum [m] real(r8), pointer :: z0hg_col(:) ! roughness length over ground, sensible heat [m] real(r8), pointer :: z0qg_col(:) ! roughness length over ground, latent heat [m] + real(r8), pointer :: z0mg(:) ! patch roughness length over ground, momentum [m] + real(r8), pointer :: z0hg(:) ! patch roughness length over ground, sensible heat [m] + real(r8), pointer :: z0qg(:) ! patch roughness length over ground, latent heat [m] + real(r8), pointer :: kbm1(:) ! natural logarithm of z0mg_p/z0hg_p [-] integer , parameter :: niters = 4 ! maximum number of iterations for surface temperature real(r8), parameter :: beta1 = 1._r8 ! coefficient of convective velocity (in computing W_*) [-] real(r8), parameter :: zii = 1000._r8 ! convective boundary height [m] @@ -169,9 +173,6 @@ subroutine LakeFluxes(bounds, num_lakec, filter_lakec, num_lakep, filter_lakep, real(r8) :: zeta ! dimensionless height used in Monin-Obukhov theory real(r8) :: zldis(bounds%begp:bounds%endp) ! reference height "minus" zero displacement height [m] real(r8) :: displa(bounds%begp:bounds%endp) ! displacement (always zero) [m] - real(r8) :: z0mg(bounds%begp:bounds%endp) ! roughness length over ground, momentum [m] - real(r8) :: z0hg(bounds%begp:bounds%endp) ! roughness length over ground, sensible heat [m] - real(r8) :: z0qg(bounds%begp:bounds%endp) ! roughness length over ground, latent heat [m] real(r8) :: u2m ! 2 m wind speed (m/s) real(r8) :: fm(bounds%begp:bounds%endp) ! needed for BGC only to diagnose 10m wind speed real(r8) :: bw ! partial density of water (ice + liquid) @@ -277,7 +278,6 @@ subroutine LakeFluxes(bounds, num_lakec, filter_lakec, num_lakep, filter_lakep, taux => energyflux_inst%taux_patch , & ! Output: [real(r8) (:) ] wind (shear) stress: e-w (kg/m/s**2) tauy => energyflux_inst%tauy_patch , & ! Output: [real(r8) (:) ] wind (shear) stress: n-s (kg/m/s**2) dhsdt_canopy => energyflux_inst%dhsdt_canopy_patch , & ! Output: [real(r8) (:) ] change in heat storage of stem (W/m**2) [+ to atm] - ks => lakestate_inst%ks_col , & ! Output: [real(r8) (:) ] coefficient passed to LakeTemperature ws => lakestate_inst%ws_col , & ! Output: [real(r8) (:) ] surface friction velocity (m/s) betaprime => lakestate_inst%betaprime_col , & ! Output: [real(r8) (:) ] fraction of solar rad absorbed at surface: equal to NIR fraction @@ -293,7 +293,10 @@ subroutine LakeFluxes(bounds, num_lakec, filter_lakec, num_lakep, filter_lakep, z0mg_col => frictionvel_inst%z0mg_col z0hg_col => frictionvel_inst%z0hg_col z0qg_col => frictionvel_inst%z0qg_col - + z0mg => frictionvel_inst%z0mg_patch + z0hg => frictionvel_inst%z0hg_patch + z0qg => frictionvel_inst%z0qg_patch + kbm1 => frictionvel_inst%kbm1_patch kva0temp = 20._r8 + tfrz do fp = 1, num_lakep @@ -331,16 +334,23 @@ subroutine LakeFluxes(bounds, num_lakec, filter_lakec, num_lakep, filter_lakep, z0qg(p) = max(z0qg(p), minz0lake) z0hg(p) = max(z0hg(p), minz0lake) else if (snl(c) == 0) then ! frozen lake with ice - if (z0param_method == 'MeierXXXX') then + select case (z0param_method) + case ('MeierXXXX') z0mg(p) = params_inst%zglc - else + z0hg(p) = 70._r8 * 1.5e-5_r8 / ust_lake(c) ! For initial guess assume tstar = 0 + case ('ZengWang2007') z0mg(p) = z0frzlake - end if - z0hg(p) = z0mg(p) / exp(params_inst%a_coef * (ust_lake(c) * z0mg(p) / 1.5e-5_r8)**params_inst%a_exp) ! Consistent with BareGroundFluxes + z0hg(p) = z0mg(p) / exp(params_inst%a_coef * (ust_lake(c) * z0mg(p) / 1.5e-5_r8)**params_inst%a_exp) ! Consistent with BareGroundFluxes + end select z0qg(p) = z0hg(p) else ! use roughness over snow as in Biogeophysics1 z0mg(p) = params_inst%zsno - z0hg(p) = z0mg(p) / exp(params_inst%a_coef * (ust_lake(c) * z0mg(p) / 1.5e-5_r8)**params_inst%a_exp) ! Consistent with BareGroundFluxes + select case (z0param_method) + case ('MeierXXXX') + z0hg(p) = 70._r8 * 1.5e-5_r8 / ust_lake(c) ! For initial guess assume tstar = 0 + case ('ZengWang2007') + z0hg(p) = z0mg(p) / exp(params_inst%a_coef * (ust_lake(c) * z0mg(p) / 1.5e-5_r8)**params_inst%a_exp) ! Consistent with BareGroundFluxes + end select z0qg(p) = z0hg(p) end if @@ -390,6 +400,7 @@ subroutine LakeFluxes(bounds, num_lakec, filter_lakec, num_lakep, filter_lakep, g = patch%gridcell(p) dhsdt_canopy(p) = 0.0_r8 + nmozsgn(p) = 0 obuold(p) = 0._r8 displa(p) = 0._r8 @@ -556,12 +567,23 @@ subroutine LakeFluxes(bounds, num_lakec, filter_lakec, num_lakep, filter_lakep, z0hg(p) = max(z0hg(p), minz0lake) else if (snl(c) == 0) then ! in case it was above freezing and now below freezing - z0mg(p) = z0frzlake - z0hg(p) = z0mg(p) / exp(params_inst%a_coef * (ustar(p) * z0mg(p) / 1.5e-5_r8)**params_inst%a_exp) ! Consistent with BareGroundFluxes - z0qg(p) = z0hg(p) + select case (z0param_method) + case ('MeierXXXX') + z0mg(p) = params_inst%zglc + z0hg(p) = 70._r8 * 1.5e-5_r8 / ustar(p) * exp( -7.2_r8 * ustar(p)**(0.5_r8) * (abs(tstar))**(0.25_r8)) ! Consistent with BareGroundFluxes + case ('ZengWang2007') + z0mg(p) = z0frzlake + z0hg(p) = z0mg(p) / exp(params_inst%a_coef * (ustar(p) * z0mg(p) / 1.5e-5_r8)**params_inst%a_exp) ! Consistent with BareGroundFluxes + end select + z0qg(p) = z0hg(p) else ! Snow layers ! z0mg won't have changed - z0hg(p) = z0mg(p) / exp(params_inst%a_coef * (ustar(p) * z0mg(p) / 1.5e-5_r8)**params_inst%a_exp) ! Consistent with BareGroundFluxes + select case (z0param_method) + case ('MeierXXXX') + z0hg(p) = 70._r8 * 1.5e-5_r8 / ustar(p) * exp( -7.2_r8 * ustar(p)**(0.5_r8) * (abs(tstar))**(0.25_r8)) ! Consistent with BareGroundFluxes + case ('ZengWang2007') + z0hg(p) = z0mg(p) / exp(params_inst%a_coef * (ustar(p) * z0mg(p) / 1.5e-5_r8)**params_inst%a_exp) ! Consistent with BareGroundFluxes + end select z0qg(p) = z0hg(p) end if @@ -701,6 +723,7 @@ subroutine LakeFluxes(bounds, num_lakec, filter_lakec, num_lakep, filter_lakep, z0hg_col(c) = z0hg(p) z0qg_col(c) = z0qg(p) ust_lake(c) = ustar(p) + kbm1(p) = log(z0mg(p) / z0hg(p)) end do From 4018d566436754b2fbb0d41945b348603f2c29af Mon Sep 17 00:00:00 2001 From: Ronny Meier Date: Wed, 26 May 2021 14:30:29 +0200 Subject: [PATCH 005/257] Saving state --- bld/CLMBuildNamelist.pm | 1 - bld/namelist_files/namelist_defaults_ctsm.xml | 3 --- src/biogeophys/BareGroundFluxesMod.F90 | 6 +++-- src/biogeophys/CanopyFluxesMod.F90 | 26 +++---------------- src/main/clm_varctl.F90 | 6 ----- src/main/controlMod.F90 | 2 -- src/main/pftconMod.F90 | 21 +-------------- 7 files changed, 9 insertions(+), 56 deletions(-) diff --git a/bld/CLMBuildNamelist.pm b/bld/CLMBuildNamelist.pm index 6f8e7c21f9..12e333ff0c 100755 --- a/bld/CLMBuildNamelist.pm +++ b/bld/CLMBuildNamelist.pm @@ -3685,7 +3685,6 @@ sub setup_logic_canopyfluxes { if ( &value_is_true($nl->get_value('use_biomass_heat_storage') ) && &value_is_true( $nl_flags->{'use_fates'}) ) { $log->fatal_error('use_biomass_heat_storage can NOT be set to true when fates is on'); } - add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'use_z0v_forest' ); } #------------------------------------------------------------------------------- diff --git a/bld/namelist_files/namelist_defaults_ctsm.xml b/bld/namelist_files/namelist_defaults_ctsm.xml index aa9b4ca3fc..edb3ffb780 100644 --- a/bld/namelist_files/namelist_defaults_ctsm.xml +++ b/bld/namelist_files/namelist_defaults_ctsm.xml @@ -319,9 +319,6 @@ attributes from the config_cache.xml file (with keys converted to upper-case). 40 3 -.false. -.false. -.false. .true. diff --git a/src/biogeophys/BareGroundFluxesMod.F90 b/src/biogeophys/BareGroundFluxesMod.F90 index 4ad975a1c1..7002c95f27 100644 --- a/src/biogeophys/BareGroundFluxesMod.F90 +++ b/src/biogeophys/BareGroundFluxesMod.F90 @@ -333,10 +333,12 @@ subroutine BareGroundFluxes(bounds, num_noexposedvegp, filter_noexposedvegp, & select case (z0param_method) case ('ZengWang2007') - z0mg_patch(p) = z0mg_patch(p) / exp(params_inst%a_coef * (ustar(p) * z0mg_patch(p) / 1.5e-5_r8)**params_inst%a_exp) + z0hg_patch(p) = z0mg_patch(p) / exp(params_inst%a_coef * (ustar(p) * z0mg_patch(p) / 1.5e-5_r8)**params_inst%a_exp) case ('MeierXXXX') ! After Yang et al. (2007) - z0hg_patch(p) = 70._r8 * 1.5e-5_r8 / ustar(p) * exp( -7.2_r8 * ustar(p)**(0.5_r8) * (abs(tstar))**(0.25_r8)) + z0hg_patch(p) = 70._r8 * 1.5e-5_r8 / ustar(p) * exp( -7.2_r8 * ustar(p)**(0.5_r8) * (abs(tstar))**(0.25_r8)) + ! After Owen and Thomson (1963) + z0hg_patch(p) = z0mg_patch(p) / exp(0.52_r8 * 0.4_r8 * (8._r8 * ustar(p) * z0mg_patch(p) / 1.5e-5_r8)**params_inst%a_exp * 0.71_r8**0.8_r8) end select z0qg_patch(p) = z0hg_patch(p) diff --git a/src/biogeophys/CanopyFluxesMod.F90 b/src/biogeophys/CanopyFluxesMod.F90 index 803ed73d39..c0859e81cc 100644 --- a/src/biogeophys/CanopyFluxesMod.F90 +++ b/src/biogeophys/CanopyFluxesMod.F90 @@ -14,7 +14,7 @@ module CanopyFluxesMod use shr_log_mod , only : errMsg => shr_log_errMsg use abortutils , only : endrun use clm_varctl , only : iulog, use_cn, use_lch4, use_c13, use_c14, use_cndv, use_fates, & - use_luna, use_hydrstress, use_biomass_heat_storage, use_z0v_forest, z0param_method + use_luna, use_hydrstress, use_biomass_heat_storage, z0param_method use clm_varpar , only : nlevgrnd, nlevsno, mxpft use clm_varcon , only : namep use pftconMod , only : pftcon @@ -114,7 +114,7 @@ subroutine CanopyFluxesReadNML(NLFilename) namelist /canopyfluxes_inparm/ use_undercanopy_stability namelist /canopyfluxes_inparm/ use_biomass_heat_storage namelist /canopyfluxes_inparm/ itmax_canopy_fluxes - namelist /canopyfluxes_inparm/ use_z0v_forest + ! Initialize options to default values, in case they are not specified in ! the namelist @@ -144,7 +144,6 @@ subroutine CanopyFluxesReadNML(NLFilename) call shr_mpi_bcast (use_undercanopy_stability, mpicom) call shr_mpi_bcast (use_biomass_heat_storage, mpicom) call shr_mpi_bcast (itmax_canopy_fluxes, mpicom) - call shr_mpi_bcast (use_z0v_forest, mpicom) if (masterproc) then write(iulog,*) ' ' @@ -458,8 +457,7 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, woody => pftcon%woody , & ! Input: woody flag rstem_per_dbh => pftcon%rstem_per_dbh , & ! Input: stem resistance per stem diameter (s/m**2) wood_density => pftcon%wood_density , & ! Input: dry wood density (kg/m3) - z0v_h => pftcon%z0v_h , & ! Input: ratio of vegetation surface roughness length to canopy height for forests (-) - z0v_alpha => pftcon%z0v_alpha , & ! Input: alpha parameter for decrease of vegetation surface roughness with LAI for forests (-) + z0v_Cr => pftcon%z0v_Cr , & ! Input: roughness-element drag coefficient for Raupach92 parameterization (-) z0v_Cs => pftcon%z0v_Cs , & ! Input: substrate-element drag coefficient for Raupach92 parameterization (-) z0v_c => pftcon%z0v_c , & ! Input: c parameter for Raupach92 parameterization (-) @@ -875,23 +873,7 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, p = filterp(f) c = patch%column(p) - ! Keep old parametrization for grasses/crops and for forests if switch is off - -! if(woody(patch%itype(p))==0 .or. use_z0v_forest==.false.) then -! lt = min(elai(p)+esai(p), tlsai_crit) -! egvf =(1._r8 - alpha_aero * exp(-lt)) / (1._r8 - alpha_aero * exp(-tlsai_crit)) -! displa(p) = egvf * displa(p) -! z0mv(p) = exp(egvf * log(z0mv(p)) + (1._r8 - egvf) * log(z0mg(c))) -! -! else ! use new parameterization for forests -! egvf = z0v_alpha(patch%itype(p))*elai(p) -! if(egvf == 0._r8) then -! z0mv(p) = htop(p) * z0v_h(patch%itype(p)) -! else -! z0mv(p) = htop(p) * z0v_h(patch%itype(p)) * (1.0_r8 - exp(-egvf)) / egvf -! end if -! displa(p) = htop(p) - z0mv(p) / 0.264_r8 -! end if + select case (z0param_method) case ('ZengWang2007') lt = min(elai(p)+esai(p), tlsai_crit) diff --git a/src/main/clm_varctl.F90 b/src/main/clm_varctl.F90 index 2de40bacf8..e3983331fa 100644 --- a/src/main/clm_varctl.F90 +++ b/src/main/clm_varctl.F90 @@ -290,12 +290,6 @@ module clm_varctl logical, public :: use_biomass_heat_storage = .false. ! true => include biomass heat storage in canopy energy budget - !---------------------------------------------------------- - ! forest surface roughness length switch - !---------------------------------------------------------- - - logical, public :: use_z0v_forest = .false. ! true => use new surface roughness length parameterization for forests - !---------------------------------------------------------- ! each pft has individual soil column switch !---------------------------------------------------------- diff --git a/src/main/controlMod.F90 b/src/main/controlMod.F90 index e3a2eb470d..01bbccda2a 100644 --- a/src/main/controlMod.F90 +++ b/src/main/controlMod.F90 @@ -246,7 +246,6 @@ subroutine control_init(dtime) namelist /clm_inparm/ use_biomass_heat_storage - namelist /clm_inparm/ use_z0v_forest namelist /clm_inparm/ use_individual_pft_soil_column @@ -749,7 +748,6 @@ subroutine control_spmd() call mpi_bcast (use_biomass_heat_storage, 1, MPI_LOGICAL, 0, mpicom, ier) - call mpi_bcast (use_z0v_forest, 1, MPI_LOGICAL, 0, mpicom, ier) call mpi_bcast (use_individual_pft_soil_column, 1, MPI_LOGICAL, 0, mpicom, ier) diff --git a/src/main/pftconMod.F90 b/src/main/pftconMod.F90 index 8f05d08b79..d3ef07a547 100644 --- a/src/main/pftconMod.F90 +++ b/src/main/pftconMod.F90 @@ -121,8 +121,6 @@ module pftconMod real(r8), allocatable :: taul (:,:) ! leaf transmittance: 1=vis, 2=nir real(r8), allocatable :: taus (:,:) ! stem transmittance: 1=vis, 2=nir real(r8), allocatable :: z0mr (:) ! ratio of momentum roughness length to canopy top height (-) - real(r8), allocatable :: z0v_h (:) ! ratio of vegetation surface roughness length to canopy height for forests (-) - real(r8), allocatable :: z0v_alpha (:) ! alpha parameter for decrease of vegetation surface roughness with LAI for forests (-) real(r8), allocatable :: z0v_Cr (:) ! roughness-element drag coefficient for Raupach92 parameterization (-) real(r8), allocatable :: z0v_Cs (:) ! substrate-element drag coefficient for Raupach92 parameterization (-) real(r8), allocatable :: z0v_c (:) ! c parameter for Raupach92 parameterization (-) @@ -365,14 +363,12 @@ subroutine InitAllocate (this) allocate( this%taul (0:mxpft,numrad) ) allocate( this%taus (0:mxpft,numrad) ) allocate( this%z0mr (0:mxpft) ) - allocate( this%z0v_h (0:mxpft) ) allocate( this%z0v_Cr (0:mxpft) ) allocate( this%z0v_Cs (0:mxpft) ) allocate( this%z0v_c (0:mxpft) ) allocate( this%z0v_cw (0:mxpft) ) allocate( this%z0v_LAIoff (0:mxpft) ) allocate( this%z0v_LAImax (0:mxpft) ) - allocate( this%z0v_alpha (0:mxpft) ) allocate( this%displar (0:mxpft) ) allocate( this%roota_par (0:mxpft) ) allocate( this%rootb_par (0:mxpft) ) @@ -513,7 +509,7 @@ subroutine InitRead(this) use fileutils , only : getfil use ncdio_pio , only : ncd_io, ncd_pio_closefile, ncd_pio_openfile, file_desc_t use ncdio_pio , only : ncd_inqdid, ncd_inqdlen - use clm_varctl , only : paramfile, use_fates, use_flexibleCN, use_dynroot, use_biomass_heat_storage, use_z0v_forest, z0param_method + use clm_varctl , only : paramfile, use_fates, use_flexibleCN, use_dynroot, use_biomass_heat_storage, z0param_method use spmdMod , only : masterproc use CLMFatesParamInterfaceMod, only : FatesReadPFTs ! @@ -643,20 +639,7 @@ subroutine InitRead(this) call ncd_io('pftname',pftname, 'read', ncid, readvar=readv, posNOTonfile=.true.) if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) - ! - ! Use new vegetation surface roughness parameterization for forests - ! - if( use_z0v_forest) then - ! These will only be used for forest PFTs - call ncd_io('z0v_h', this%z0v_h, 'read', ncid, readvar=readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) - call ncd_io('z0v_alpha', this%z0v_alpha, 'read', ncid, readvar=readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) - else - this%z0v_h = 0._r8 - this%z0v_alpha = 0._r8 - end if select case (z0param_method) case ('ZengWang2007') @@ -1417,14 +1400,12 @@ subroutine Clean(this) deallocate( this%taul) deallocate( this%taus) deallocate( this%z0mr) - deallocate( this%z0v_h) deallocate( this%z0v_Cr) deallocate( this%z0v_Cs) deallocate( this%z0v_c) deallocate( this%z0v_cw) deallocate( this%z0v_LAImax) deallocate( this%z0v_LAIoff) - deallocate( this%z0v_alpha) deallocate( this%displar) deallocate( this%roota_par) deallocate( this%rootb_par) From 4a52aa7165996d90c34d28d8eb7ffb24a52826b8 Mon Sep 17 00:00:00 2001 From: Ronny Meier Date: Mon, 14 Jun 2021 13:24:51 +0200 Subject: [PATCH 006/257] Saving state --- src/biogeophys/BareGroundFluxesMod.F90 | 5 ++++- src/biogeophys/FrictionVelocityMod.F90 | 2 ++ src/biogeophys/LakeFluxesMod.F90 | 14 +++++++++++--- 3 files changed, 17 insertions(+), 4 deletions(-) diff --git a/src/biogeophys/BareGroundFluxesMod.F90 b/src/biogeophys/BareGroundFluxesMod.F90 index 7002c95f27..9d265ec1a3 100644 --- a/src/biogeophys/BareGroundFluxesMod.F90 +++ b/src/biogeophys/BareGroundFluxesMod.F90 @@ -338,7 +338,10 @@ subroutine BareGroundFluxes(bounds, num_noexposedvegp, filter_noexposedvegp, & ! After Yang et al. (2007) z0hg_patch(p) = 70._r8 * 1.5e-5_r8 / ustar(p) * exp( -7.2_r8 * ustar(p)**(0.5_r8) * (abs(tstar))**(0.25_r8)) ! After Owen and Thomson (1963) - z0hg_patch(p) = z0mg_patch(p) / exp(0.52_r8 * 0.4_r8 * (8._r8 * ustar(p) * z0mg_patch(p) / 1.5e-5_r8)**params_inst%a_exp * 0.71_r8**0.8_r8) + !z0hg_patch(p) = z0mg_patch(p) / exp(0.52_r8 * 0.4_r8 * (8._r8 * ustar(p) * z0mg_patch(p) / 1.5e-5_r8)**params_inst%a_exp * 0.71_r8**0.8_r8) + ! Zeng and Wang (2007) + !z0hg_patch(p) = z0hg_col(c) / exp(params_inst%a_coef * (ustar(p) * z0hg_col(c) / 1.5e-5_r8)**params_inst%a_exp) + end select z0qg_patch(p) = z0hg_patch(p) diff --git a/src/biogeophys/FrictionVelocityMod.F90 b/src/biogeophys/FrictionVelocityMod.F90 index c22deee275..fcbea572bb 100644 --- a/src/biogeophys/FrictionVelocityMod.F90 +++ b/src/biogeophys/FrictionVelocityMod.F90 @@ -583,6 +583,8 @@ subroutine SetRoughnessLengthsAndForcHeightsNonLake(this, bounds, & z0hg(c) = z0mg(c) ! initial set only z0qg(c) = z0mg(c) ! initial set only + + end do do fp = 1,num_nolakep diff --git a/src/biogeophys/LakeFluxesMod.F90 b/src/biogeophys/LakeFluxesMod.F90 index 367e9eab40..ec8d24ba11 100644 --- a/src/biogeophys/LakeFluxesMod.F90 +++ b/src/biogeophys/LakeFluxesMod.F90 @@ -337,7 +337,9 @@ subroutine LakeFluxes(bounds, num_lakec, filter_lakec, num_lakep, filter_lakep, select case (z0param_method) case ('MeierXXXX') z0mg(p) = params_inst%zglc - z0hg(p) = 70._r8 * 1.5e-5_r8 / ust_lake(c) ! For initial guess assume tstar = 0 + z0hg(p) = 70._r8 * 1.5e-5_r8 / ust_lake(c) ! For initial guess assume tstar = 0 + !z0hg(p) = z0mg(p) / exp(params_inst%a_coef * (ust_lake(c) * z0mg(p) / 1.5e-5_r8)**params_inst%a_exp) ! This is for z0 only + case ('ZengWang2007') z0mg(p) = z0frzlake z0hg(p) = z0mg(p) / exp(params_inst%a_coef * (ust_lake(c) * z0mg(p) / 1.5e-5_r8)**params_inst%a_exp) ! Consistent with BareGroundFluxes @@ -348,6 +350,8 @@ subroutine LakeFluxes(bounds, num_lakec, filter_lakec, num_lakep, filter_lakep, select case (z0param_method) case ('MeierXXXX') z0hg(p) = 70._r8 * 1.5e-5_r8 / ust_lake(c) ! For initial guess assume tstar = 0 + !z0hg(p) = z0mg(p) / exp(params_inst%a_coef * (ust_lake(c) * z0mg(p) / 1.5e-5_r8)**params_inst%a_exp) ! This is for z0 only + case ('ZengWang2007') z0hg(p) = z0mg(p) / exp(params_inst%a_coef * (ust_lake(c) * z0mg(p) / 1.5e-5_r8)**params_inst%a_exp) ! Consistent with BareGroundFluxes end select @@ -570,7 +574,9 @@ subroutine LakeFluxes(bounds, num_lakec, filter_lakec, num_lakep, filter_lakep, select case (z0param_method) case ('MeierXXXX') z0mg(p) = params_inst%zglc - z0hg(p) = 70._r8 * 1.5e-5_r8 / ustar(p) * exp( -7.2_r8 * ustar(p)**(0.5_r8) * (abs(tstar))**(0.25_r8)) ! Consistent with BareGroundFluxes + z0hg(p) = 70._r8 * 1.5e-5_r8 / ustar(p) * exp( -7.2_r8 * ustar(p)**(0.5_r8) * (abs(tstar))**(0.25_r8)) ! Consistent with BareGroundFluxes + !z0hg(p) = z0mg(p) / exp(params_inst%a_coef * (ustar(p) * z0mg(p) / 1.5e-5_r8)**params_inst%a_exp) ! This is for z0 only + case ('ZengWang2007') z0mg(p) = z0frzlake z0hg(p) = z0mg(p) / exp(params_inst%a_coef * (ustar(p) * z0mg(p) / 1.5e-5_r8)**params_inst%a_exp) ! Consistent with BareGroundFluxes @@ -580,7 +586,9 @@ subroutine LakeFluxes(bounds, num_lakec, filter_lakec, num_lakep, filter_lakep, ! z0mg won't have changed select case (z0param_method) case ('MeierXXXX') - z0hg(p) = 70._r8 * 1.5e-5_r8 / ustar(p) * exp( -7.2_r8 * ustar(p)**(0.5_r8) * (abs(tstar))**(0.25_r8)) ! Consistent with BareGroundFluxes + z0hg(p) = 70._r8 * 1.5e-5_r8 / ustar(p) * exp( -7.2_r8 * ustar(p)**(0.5_r8) * (abs(tstar))**(0.25_r8)) ! Consistent with BareGroundFluxes + !z0hg(p) = z0mg(p) / exp(params_inst%a_coef * (ustar(p) * z0mg(p) / 1.5e-5_r8)**params_inst%a_exp) ! This is for z0 only + case ('ZengWang2007') z0hg(p) = z0mg(p) / exp(params_inst%a_coef * (ustar(p) * z0mg(p) / 1.5e-5_r8)**params_inst%a_exp) ! Consistent with BareGroundFluxes end select From e78b02fd2925209e6d8419d6ab9b2740a62d43ad Mon Sep 17 00:00:00 2001 From: Ronny Meier Date: Wed, 16 Jun 2021 14:35:23 +0200 Subject: [PATCH 007/257] Saving state --- src/biogeophys/BiogeophysPreFluxCalcsMod.F90 | 8 ++- src/biogeophys/FrictionVelocityMod.F90 | 75 ++++++++++++++++++-- src/biogeophys/SnowHydrologyMod.F90 | 15 ++-- src/biogeophys/SoilTemperatureMod.F90 | 2 + src/biogeophys/WaterFluxType.F90 | 24 +++++++ src/main/clm_driver.F90 | 2 +- 6 files changed, 114 insertions(+), 12 deletions(-) diff --git a/src/biogeophys/BiogeophysPreFluxCalcsMod.F90 b/src/biogeophys/BiogeophysPreFluxCalcsMod.F90 index 7a06bb0265..a665697b02 100644 --- a/src/biogeophys/BiogeophysPreFluxCalcsMod.F90 +++ b/src/biogeophys/BiogeophysPreFluxCalcsMod.F90 @@ -32,6 +32,8 @@ module BiogeophysPreFluxCalcsMod use WaterDiagnosticBulkType , only : waterdiagnosticbulk_type use WaterStateBulkType , only : waterstatebulk_type use SurfaceResistanceMod , only : calc_soilevap_resis + use WaterFluxBulkType , only : waterfluxbulk_type + ! ! !PUBLIC TYPES: implicit none @@ -57,7 +59,7 @@ subroutine BiogeophysPreFluxCalcs(bounds, & num_urbanc, filter_urbanc, & clm_fates, atm2lnd_inst, canopystate_inst, energyflux_inst, frictionvel_inst, & soilstate_inst, temperature_inst, & - wateratm2lndbulk_inst, waterdiagnosticbulk_inst, waterstatebulk_inst) + wateratm2lndbulk_inst, waterdiagnosticbulk_inst, waterstatebulk_inst, waterfluxbulk_inst) ! ! !DESCRIPTION: ! Do various calculations that need to happen before the main biogeophysics flux calculations @@ -80,6 +82,7 @@ subroutine BiogeophysPreFluxCalcs(bounds, & type(wateratm2lndbulk_type) , intent(in) :: wateratm2lndbulk_inst type(waterdiagnosticbulk_type) , intent(in) :: waterdiagnosticbulk_inst type(waterstatebulk_type) , intent(in) :: waterstatebulk_inst + type(waterfluxbulk_type) , intent(in) :: waterfluxbulk_inst ! ! !LOCAL VARIABLES: integer :: fp, p @@ -93,7 +96,8 @@ subroutine BiogeophysPreFluxCalcs(bounds, & call frictionvel_inst%SetRoughnessLengthsAndForcHeightsNonLake(bounds, & num_nolakec, filter_nolakec, & num_nolakep, filter_nolakep, & - atm2lnd_inst, waterdiagnosticbulk_inst, canopystate_inst) + atm2lnd_inst, waterdiagnosticbulk_inst, canopystate_inst, & + waterfluxbulk_inst) call CalcInitialTemperatureAndEnergyVars(bounds, & num_nolakec, filter_nolakec, & diff --git a/src/biogeophys/FrictionVelocityMod.F90 b/src/biogeophys/FrictionVelocityMod.F90 index fcbea572bb..2d3d746bba 100644 --- a/src/biogeophys/FrictionVelocityMod.F90 +++ b/src/biogeophys/FrictionVelocityMod.F90 @@ -22,6 +22,7 @@ module FrictionVelocityMod use atm2lndType , only : atm2lnd_type use WaterDiagnosticBulkType , only : waterdiagnosticbulk_type use CanopyStateType , only : canopystate_type + use WaterFluxBulkType , only : waterfluxbulk_type ! ! !PUBLIC TYPES: implicit none @@ -57,7 +58,8 @@ module FrictionVelocityMod real(r8), pointer, public :: z0hg_patch (:) ! patch roughness length over ground, sensible heat [m] real(r8), pointer, public :: z0qg_patch (:) ! patch roughness length over ground, latent heat [m] real(r8), pointer, public :: kbm1_patch (:) ! natural logarithm of z0mg_p/z0hg_p [-] - real(r8), pointer, public :: z0mg_col (:) ! col roughness length over ground, momentum [m] + real(r8), pointer, public :: z0mg_col (:) ! col roughness length over ground, momentum [m] + real(r8), pointer, public :: z0mg_2D_col (:) ! 2-D field of input col roughness length over ground, momentum [m] real(r8), pointer, public :: z0hg_col (:) ! col roughness length over ground, sensible heat [m] real(r8), pointer, public :: z0qg_col (:) ! col roughness length over ground, latent heat [m] ! variables to add history output from CanopyFluxesMod @@ -92,6 +94,7 @@ module FrictionVelocityMod procedure, private :: InitCold procedure, private :: ReadNamelist procedure, private :: ReadParams + procedure, private :: ReadZ0M procedure, private, nopass :: StabilityFunc1 ! Stability function for rib < 0. procedure, private, nopass :: StabilityFunc2 ! Stability function for rib < 0. @@ -117,6 +120,10 @@ subroutine Init(this, bounds, NLFilename, params_ncid) call this%ReadNamelist(NLFilename) call this%ReadParams(params_ncid) + if(z0param_method == "MeierXXXX") then + call this%ReadZ0M(bounds) + end if + end subroutine Init !------------------------------------------------------------------------ @@ -159,6 +166,7 @@ subroutine InitAllocate(this, bounds) allocate(this%z0qg_patch (begp:endp)) ; this%z0qg_patch (:) = nan allocate(this%kbm1_patch (begp:endp)) ; this%kbm1_patch (:) = nan allocate(this%z0mg_col (begc:endc)) ; this%z0mg_col (:) = nan + allocate(this%z0mg_2D_col (begc:endc)) ; this%z0mg_2D_col (:) = nan allocate(this%z0qg_col (begc:endc)) ; this%z0qg_col (:) = nan allocate(this%z0hg_col (begc:endc)) ; this%z0hg_col (:) = nan allocate(this%rah1_patch (begp:endp)) ; this%rah1_patch (:) = nan @@ -405,6 +413,59 @@ subroutine ReadParams( this, params_ncid ) end subroutine ReadParams + !----------------------------------------------------------------------- + subroutine ReadZ0M(this, bounds) + ! + ! !DESCRIPTION: + ! Initialize module time constant variables + ! + ! !USES: + use shr_log_mod, only : errMsg => shr_log_errMsg + use fileutils , only : getfil + use abortutils , only : endrun + use ncdio_pio , only : file_desc_t, ncd_defvar, ncd_io, ncd_pio_openfile, ncd_pio_closefile + use spmdMod , only : masterproc + use clm_varcon , only : grlnd + use clm_varctl , only : fsurdat + use ncdio_pio , only : ncd_io + use clm_varctl , only : iulog + + ! + ! !ARGUMENTS: + class(frictionvel_type) :: this + type(bounds_type), intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + integer :: c,g ! indices + type(file_desc_t) :: ncid ! netcdf id + character(len=256) :: locfn ! local filename + integer :: ier ! error status + logical :: readvar + real(r8), pointer :: z0mg2d (:) ! read in - ground z0m + !--------------------------------------------------------------------- + + ! Allocate module variable for ground z0m + + + call getfil (fsurdat, locfn, 0) + call ncd_pio_openfile (ncid, locfn, 0) + + + allocate(z0mg2d(bounds%begg:bounds%endg)) + call ncd_io(ncid=ncid, varname='Z0MG_2D', flag='read', data=z0mg2d, dim1name=grlnd, readvar=readvar) + if (.not. readvar) then + call endrun(msg=' ERROR: Z0MG_presc NOT on surfdata file'//errMsg(sourcefile, __LINE__)) + end if + write(iulog,*) 'Writing z0mg2d' + do c = bounds%begc, bounds%endc + g = col%gridcell(c) + this%z0mg_2D_col(c) = z0mg2d(g) + write(iulog,*) z0mg2d(g) + end do + deallocate(z0mg2d) + + end subroutine ReadZ0M + !------------------------------------------------------------------------ subroutine Restart(this, bounds, ncid, flag) ! @@ -506,7 +567,7 @@ end subroutine ReadNamelist !----------------------------------------------------------------------- subroutine SetRoughnessLengthsAndForcHeightsNonLake(this, bounds, & num_nolakec, filter_nolakec, num_nolakep, filter_nolakep, & - atm2lnd_inst, waterdiagnosticbulk_inst, canopystate_inst) + atm2lnd_inst, waterdiagnosticbulk_inst, canopystate_inst, waterfluxbulk_inst) ! ! !DESCRIPTION: ! Set roughness lengths and forcing heights for non-lake points @@ -521,6 +582,7 @@ subroutine SetRoughnessLengthsAndForcHeightsNonLake(this, bounds, & type(atm2lnd_type) , intent(in) :: atm2lnd_inst type(waterdiagnosticbulk_type) , intent(in) :: waterdiagnosticbulk_inst type(canopystate_type) , intent(in) :: canopystate_inst + type(waterfluxbulk_type) , intent(in) :: waterfluxbulk_inst ! ! !LOCAL VARIABLES: integer :: fc, c @@ -549,12 +611,15 @@ subroutine SetRoughnessLengthsAndForcHeightsNonLake(this, bounds, & frac_veg_nosno => canopystate_inst%frac_veg_nosno_patch , & ! Input: [integer (:) ] fraction of vegetation not covered by snow (0 OR 1) [-] frac_sno => waterdiagnosticbulk_inst%frac_sno_col , & ! Input: [real(r8) (:) ] fraction of ground covered by snow (0 to 1) + snomelt_accum => waterfluxbulk_inst%qflx_snomelt_accum_col , & ! Input: [real(r8) (:) ] accumulated col snow melt for z0m calculation (m H2O) urbpoi => lun%urbpoi , & ! Input: [logical (:) ] true => landunit is an urban point z_0_town => lun%z_0_town , & ! Input: [real(r8) (:) ] momentum roughness length of urban landunit (m) z_d_town => lun%z_d_town , & ! Input: [real(r8) (:) ] displacement height of urban landunit (m) forc_hgt_t => atm2lnd_inst%forc_hgt_t_grc , & ! Input: [real(r8) (:) ] observational height of temperature [m] forc_hgt_u => atm2lnd_inst%forc_hgt_u_grc , & ! Input: [real(r8) (:) ] observational height of wind [m] - forc_hgt_q => atm2lnd_inst%forc_hgt_q_grc & ! Input: [real(r8) (:) ] observational height of specific humidity [m] + forc_hgt_q => atm2lnd_inst%forc_hgt_q_grc , & ! Input: [real(r8) (:) ] observational height of specific humidity [m] + z0mg_2D => this%z0mg_2D_col & ! Input: [real(r8) (:) ] 2-D field of input col roughness length over ground, momentum [m] + ) do fc = 1, num_nolakec @@ -573,11 +638,11 @@ subroutine SetRoughnessLengthsAndForcHeightsNonLake(this, bounds, & case ('MeierXXXX') ! Bare ground and ice have a different value l = col%landunit(c) if (frac_sno(c) > 0._r8) then ! Do snow first because ice could be snow-covered - z0mg(c) = this%zsno + z0mg(c) = exp(1.4_r8 * (atan((log10(snomelt_accum(c)+0.23_r8)/0.08_r8))-0.31_r8)) / 1000._r8 !this%zsno else if (lun%itype(l) == istice_mec) then z0mg(c) = this%zglc else - z0mg(c) = this%zlnd + z0mg(c) = this%zlnd !z0mg_2D(c) end if end select diff --git a/src/biogeophys/SnowHydrologyMod.F90 b/src/biogeophys/SnowHydrologyMod.F90 index 8d1824a70c..ffe17672cb 100644 --- a/src/biogeophys/SnowHydrologyMod.F90 +++ b/src/biogeophys/SnowHydrologyMod.F90 @@ -370,7 +370,8 @@ subroutine UpdateQuantitiesForNewSnow(bounds, num_c, filter_c, & swe_old = b_waterdiagnostic_inst%swe_old_col(begc:endc,:), & frac_sno = b_waterdiagnostic_inst%frac_sno_col(begc:endc), & frac_sno_eff = b_waterdiagnostic_inst%frac_sno_eff_col(begc:endc), & - snow_depth = b_waterdiagnostic_inst%snow_depth_col(begc:endc)) + snow_depth = b_waterdiagnostic_inst%snow_depth_col(begc:endc), & + qflx_snomelt_accum = b_waterflux_inst%qflx_snomelt_accum_col(begc:endc)) do i = water_inst%bulk_and_tracers_beg, water_inst%bulk_and_tracers_end associate(w => water_inst%bulk_and_tracers(i)) @@ -394,7 +395,7 @@ subroutine BulkDiag_NewSnowDiagnostics(bounds, num_c, filter_c, & scf_method, & dtime, lun_itype_col, urbpoi, snl, bifall, h2osno_total, h2osoi_ice, h2osoi_liq, & qflx_snow_grnd, qflx_snow_drain, & - dz, int_snow, swe_old, frac_sno, frac_sno_eff, snow_depth) + dz, int_snow, swe_old, frac_sno, frac_sno_eff, snow_depth, qflx_snomelt_accum) ! ! !DESCRIPTION: ! Update various snow-related diagnostic quantities to account for new snow @@ -421,6 +422,7 @@ subroutine BulkDiag_NewSnowDiagnostics(bounds, num_c, filter_c, & real(r8) , intent(inout) :: frac_sno( bounds%begc: ) ! fraction of ground covered by snow (0 to 1) real(r8) , intent(inout) :: frac_sno_eff( bounds%begc: ) ! eff. fraction of ground covered by snow (0 to 1) real(r8) , intent(inout) :: snow_depth( bounds%begc: ) ! snow height (m) + real(r8) , intent(inout) :: qflx_snomelt_accum( bounds%begc:) ! accumulated col snow melt for z0m calculation (m H2O) ! ! !LOCAL VARIABLES: integer :: fc, c @@ -521,6 +523,7 @@ subroutine BulkDiag_NewSnowDiagnostics(bounds, num_c, filter_c, & if (snl(c) < 0) then dz_snowf = (snow_depth(c) - temp_snow_depth(c)) / dtime dz(c,snl(c)+1) = dz(c,snl(c)+1)+dz_snowf*dtime + qflx_snomelt_accum(c) = max(0._r8, qflx_snomelt_accum(c) - dz_snowf*dtime/1000._r8) end if end do @@ -791,7 +794,9 @@ subroutine InitializeExplicitSnowPack(bounds, num_c, filter_c, & ! Outputs h2osno_no_layers = w%waterstate_inst%h2osno_no_layers_col(begc:endc), & h2osoi_ice = w%waterstate_inst%h2osoi_ice_col(begc:endc,:), & - h2osoi_liq = w%waterstate_inst%h2osoi_liq_col(begc:endc,:)) + h2osoi_liq = w%waterstate_inst%h2osoi_liq_col(begc:endc,:), & + qflx_snomelt_accum = b_waterflux_inst%qflx_snomelt_accum_col(begc:endc)) + end associate end do @@ -883,7 +888,7 @@ end subroutine BuildFilter_SnowpackInitialized !----------------------------------------------------------------------- subroutine UpdateState_InitializeSnowPack(bounds, snowpack_initialized_filterc, & - h2osno_no_layers, h2osoi_ice, h2osoi_liq) + h2osno_no_layers, h2osoi_ice, h2osoi_liq, qflx_snomelt_accum) ! ! !DESCRIPTION: ! For bulk or one tracer: initialize water state variables for columns in which an @@ -896,6 +901,7 @@ subroutine UpdateState_InitializeSnowPack(bounds, snowpack_initialized_filterc, real(r8) , intent(inout) :: h2osno_no_layers( bounds%begc: ) ! snow that is not resolved into layers (kg/m2) real(r8) , intent(inout) :: h2osoi_ice( bounds%begc: , -nlevsno+1: ) ! ice lens (kg/m2) real(r8) , intent(inout) :: h2osoi_liq( bounds%begc: , -nlevsno+1: ) ! liquid water (kg/m2) + real(r8) , intent(inout) :: qflx_snomelt_accum( bounds%begc:) ! accumulated col snow melt for z0m calculation (m H2O) ! ! !LOCAL VARIABLES: integer :: fc, c @@ -913,6 +919,7 @@ subroutine UpdateState_InitializeSnowPack(bounds, snowpack_initialized_filterc, h2osoi_ice(c,0) = h2osno_no_layers(c) h2osoi_liq(c,0) = 0._r8 h2osno_no_layers(c) = 0._r8 + qflx_snomelt_accum(c) = 0._r8 end do end subroutine UpdateState_InitializeSnowPack diff --git a/src/biogeophys/SoilTemperatureMod.F90 b/src/biogeophys/SoilTemperatureMod.F90 index e8a6b0ef68..9137e8b3d8 100644 --- a/src/biogeophys/SoilTemperatureMod.F90 +++ b/src/biogeophys/SoilTemperatureMod.F90 @@ -1114,6 +1114,7 @@ subroutine Phasechange_beta (bounds, num_nolakec, filter_nolakec, dhsdT, & qflx_snofrz_lyr => waterfluxbulk_inst%qflx_snofrz_lyr_col , & ! Output: [real(r8) (:,:) ] snow freezing rate (positive definite) (col,lyr) [kg m-2 s-1] qflx_snofrz => waterfluxbulk_inst%qflx_snofrz_col , & ! Output: [real(r8) (:) ] column-integrated snow freezing rate (positive definite) [kg m-2 s-1] qflx_snomelt => waterfluxbulk_inst%qflx_snomelt_col , & ! Output: [real(r8) (:) ] snow melt (mm H2O /s) + qflx_snomelt_accum => waterfluxbulk_inst%qflx_snomelt_accum_col , & ! Output: [real(r8) (:) ] accumulated snow melt (m) qflx_snomelt_lyr => waterfluxbulk_inst%qflx_snomelt_lyr_col , & ! Output: [real(r8) (:) ] snow melt in each layer (mm H2O /s) eflx_snomelt => energyflux_inst%eflx_snomelt_col , & ! Output: [real(r8) (:) ] snow melt heat flux (W/m**2) @@ -1381,6 +1382,7 @@ subroutine Phasechange_beta (bounds, num_nolakec, filter_nolakec, dhsdT, & if (imelt(c,j) == 1 .AND. j < 1) then qflx_snomelt_lyr(c,j) = max(0._r8,(wice0(c,j)-h2osoi_ice(c,j)))/dtime qflx_snomelt(c) = qflx_snomelt(c) + qflx_snomelt_lyr(c,j) + qflx_snomelt_accum(c) = qflx_snomelt_accum(c) + qflx_snomelt_lyr(c,j) * dtime/1000._r8 endif ! layer freezing mass flux (positive): diff --git a/src/biogeophys/WaterFluxType.F90 b/src/biogeophys/WaterFluxType.F90 index a2d57c1e51..c758b5b087 100644 --- a/src/biogeophys/WaterFluxType.F90 +++ b/src/biogeophys/WaterFluxType.F90 @@ -77,6 +77,7 @@ module WaterFluxType real(r8), pointer :: qflx_floodc_col (:) ! col flood water flux at column level real(r8), pointer :: qflx_sl_top_soil_col (:) ! col liquid water + ice from layer above soil to top soil layer or sent to qflx_qrgwl (mm H2O/s) real(r8), pointer :: qflx_snomelt_col (:) ! col snow melt (mm H2O /s) + real(r8), pointer :: qflx_snomelt_accum_col (:) ! accumulated col snow melt for z0m calculation (m H2O) real(r8), pointer :: qflx_qrgwl_col (:) ! col qflx_surf at glaciers, wetlands, lakes real(r8), pointer :: qflx_runoff_col (:) ! col total runoff (qflx_drain+qflx_surf+qflx_qrgwl) (mm H2O /s) real(r8), pointer :: qflx_runoff_r_col (:) ! col Rural total runoff (qflx_drain+qflx_surf+qflx_qrgwl) (mm H2O /s) @@ -284,6 +285,9 @@ subroutine InitAllocate(this, bounds, tracer_vars) call AllocateVar1d(var = this%qflx_snomelt_col, name = 'qflx_snomelt_col', & container = tracer_vars, & bounds = bounds, subgrid_level = BOUNDS_SUBGRID_COLUMN) + call AllocateVar1d(var = this%qflx_snomelt_accum_col, name = 'qflx_snomelt_accum_col', & + container = tracer_vars, & + bounds = bounds, subgrid_level = BOUNDS_SUBGRID_COLUMN) call AllocateVar1d(var = this%qflx_snofrz_col, name = 'qflx_snofrz_col', & container = tracer_vars, & bounds = bounds, subgrid_level = BOUNDS_SUBGRID_COLUMN) @@ -545,6 +549,14 @@ subroutine InitHistory(this, bounds) long_name=this%info%lname('snow melt rate'), & ptr_col=this%qflx_snomelt_col, c2l_scale_type='urbanf') + this%qflx_snomelt_accum_col(begc:endc) = 0._r8 + call hist_addfld1d ( & ! Have this as an output variable for now to check + fname=this%info%fname('QSNOMELT_ACCUM'), & + units='m', & + avgflag='A', & + long_name=this%info%lname('accumulated snow melt for z0'), & + ptr_col=this%qflx_snomelt_accum_col, c2l_scale_type='urbanf') + call hist_addfld1d ( & fname=this%info%fname('QSNOMELT_ICE'), & units='mm/s', & @@ -896,6 +908,18 @@ subroutine Restart(this, bounds, ncid, flag) this%qflx_snow_drain_col(bounds%begc:bounds%endc) = 0._r8 endif + call restartvar(ncid=ncid, flag=flag, & + varname=this%info%fname('QSNOMELT_ACCUM'), & + xtype=ncd_double, & + dim1name='column', & + long_name=this%info%lname('accumulated snow melt for z0'), & + units='m', & + interpinic_flag='interp', readvar=readvar, data=this%qflx_snomelt_accum_col) + if (flag == 'read' .and. .not. readvar) then + ! initial run, not restart: initialize qflx_snow_drain to zero + this%qflx_snomelt_accum_col(bounds%begc:bounds%endc) = 0._r8 + endif + call this%qflx_liq_dynbal_dribbler%Restart(bounds, ncid, flag) call this%qflx_ice_dynbal_dribbler%Restart(bounds, ncid, flag) diff --git a/src/main/clm_driver.F90 b/src/main/clm_driver.F90 index 276dfbc467..9be5ad20d2 100644 --- a/src/main/clm_driver.F90 +++ b/src/main/clm_driver.F90 @@ -618,7 +618,7 @@ subroutine clm_drv(doalb, nextsw_cday, declinp1, declin, rstwr, nlend, rdate, ro atm2lnd_inst, canopystate_inst, energyflux_inst, frictionvel_inst, & soilstate_inst, temperature_inst, & water_inst%wateratm2lndbulk_inst, water_inst%waterdiagnosticbulk_inst, & - water_inst%waterstatebulk_inst) + water_inst%waterstatebulk_inst, water_inst%waterfluxbulk_inst) call ozone_inst%CalcOzoneStress(bounds_clump, filter(nc)%num_exposedvegp, filter(nc)%exposedvegp) From 37d7d0c4e72dd20b6f35607e33a5fcdb99014ac3 Mon Sep 17 00:00:00 2001 From: Ronny Meier Date: Thu, 24 Jun 2021 17:21:26 +0200 Subject: [PATCH 008/257] Saving state --- bld/CLMBuildNamelist.pm | 6 ++++ bld/namelist_files/namelist_defaults_ctsm.xml | 10 ++++++ .../namelist_definition_ctsm.xml | 12 +++++++ src/biogeophys/FrictionVelocityMod.F90 | 35 ++++++++++++++----- src/biogeophys/LakeFluxesMod.F90 | 25 ++++++++++--- src/biogeophys/SnowHydrologyMod.F90 | 2 +- src/main/clm_varctl.F90 | 5 ++- src/main/controlMod.F90 | 4 ++- 8 files changed, 82 insertions(+), 17 deletions(-) diff --git a/bld/CLMBuildNamelist.pm b/bld/CLMBuildNamelist.pm index 12e333ff0c..fec367a514 100755 --- a/bld/CLMBuildNamelist.pm +++ b/bld/CLMBuildNamelist.pm @@ -3900,6 +3900,12 @@ sub setup_logic_z0param { my ($opts, $nl_flags, $definition, $defaults, $nl) = @_; add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'z0param_method'); + + my $z0param_method = remove_leading_and_trailing_quotes($nl->get_value('z0param_method' )); + add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'use_z0m_snowmelt', + 'z0param_method'=>$z0param_method ); + add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'use_z0mg_2d', + 'z0param_method'=>$z0param_method ); } #------------------------------------------------------------------------------- diff --git a/bld/namelist_files/namelist_defaults_ctsm.xml b/bld/namelist_files/namelist_defaults_ctsm.xml index edb3ffb780..a6776abe33 100644 --- a/bld/namelist_files/namelist_defaults_ctsm.xml +++ b/bld/namelist_files/namelist_defaults_ctsm.xml @@ -491,6 +491,16 @@ attributes from the config_cache.xml file (with keys converted to upper-case). ZengWang2007 +.true. +.false. +.false. + +.true. +.false. +.true. + + + diff --git a/bld/namelist_files/namelist_definition_ctsm.xml b/bld/namelist_files/namelist_definition_ctsm.xml index 785b9447bf..a63f2317f8 100644 --- a/bld/namelist_files/namelist_definition_ctsm.xml +++ b/bld/namelist_files/namelist_definition_ctsm.xml @@ -2733,6 +2733,18 @@ ZengWang2007: Zeng and Wang 2007 MeierXXXX: Meier et al. in prep. + +If FALSE use constant snow z0m +If TRUE use parameterization of snow z0m as a function of accumulated +snow melt of Brock et al. (2006) + + + +If FALSE use constant ground z0m +If TRUE use spatially explicit ground z0m from Prigent et al. (2005) + diff --git a/src/biogeophys/FrictionVelocityMod.F90 b/src/biogeophys/FrictionVelocityMod.F90 index 2d3d746bba..413fed1134 100644 --- a/src/biogeophys/FrictionVelocityMod.F90 +++ b/src/biogeophys/FrictionVelocityMod.F90 @@ -12,7 +12,7 @@ module FrictionVelocityMod use shr_const_mod , only : SHR_CONST_PI use decompMod , only : bounds_type use clm_varcon , only : spval - use clm_varctl , only : use_cn, use_luna, z0param_method + use clm_varctl , only : use_cn, use_luna, z0param_method, use_z0mg_2d, use_z0m_snowmelt use LandunitType , only : lun use ColumnType , only : col use PatchType , only : patch @@ -119,8 +119,8 @@ subroutine Init(this, bounds, NLFilename, params_ncid) call this%InitCold(bounds) call this%ReadNamelist(NLFilename) call this%ReadParams(params_ncid) - - if(z0param_method == "MeierXXXX") then + + if(use_z0mg_2d) then call this%ReadZ0M(bounds) end if @@ -454,12 +454,12 @@ subroutine ReadZ0M(this, bounds) allocate(z0mg2d(bounds%begg:bounds%endg)) call ncd_io(ncid=ncid, varname='Z0MG_2D', flag='read', data=z0mg2d, dim1name=grlnd, readvar=readvar) if (.not. readvar) then - call endrun(msg=' ERROR: Z0MG_presc NOT on surfdata file'//errMsg(sourcefile, __LINE__)) + call endrun(msg=' ERROR: Z0MG_2D NOT on surfdata file'//errMsg(sourcefile, __LINE__)) end if write(iulog,*) 'Writing z0mg2d' do c = bounds%begc, bounds%endc g = col%gridcell(c) - this%z0mg_2D_col(c) = z0mg2d(g) + this%z0mg_2D_col(c) = max(1.e-4_r8,z0mg2d(g)) write(iulog,*) z0mg2d(g) end do deallocate(z0mg2d) @@ -631,18 +631,35 @@ subroutine SetRoughnessLengthsAndForcHeightsNonLake(this, bounds, & select case (z0param_method) case ('ZengWang2007') if (frac_sno(c) > 0._r8) then - z0mg(c) = this%zsno + if(use_z0m_snowmelt) then + z0mg(c) = exp(1.4_r8 * (atan((log10(snomelt_accum(c)+0.23_r8)/0.08_r8))-0.31_r8)) / 1000._r8 + else + z0mg(c) = this%zsno + end if else - z0mg(c) = this%zlnd + if(use_z0mg_2d) then + z0mg(c) = z0mg_2D(c) + else + z0mg(c) = this%zlnd + end if + end if case ('MeierXXXX') ! Bare ground and ice have a different value l = col%landunit(c) if (frac_sno(c) > 0._r8) then ! Do snow first because ice could be snow-covered - z0mg(c) = exp(1.4_r8 * (atan((log10(snomelt_accum(c)+0.23_r8)/0.08_r8))-0.31_r8)) / 1000._r8 !this%zsno + if(use_z0m_snowmelt) then + z0mg(c) = exp(1.4_r8 * (atan((log10(snomelt_accum(c)+0.23_r8)/0.08_r8))-0.31_r8)) / 1000._r8 + else + z0mg(c) = this%zsno + end if else if (lun%itype(l) == istice_mec) then z0mg(c) = this%zglc else - z0mg(c) = this%zlnd !z0mg_2D(c) + if(use_z0mg_2d) then + z0mg(c) = z0mg_2D(c) + else + z0mg(c) = this%zlnd + end if end if end select diff --git a/src/biogeophys/LakeFluxesMod.F90 b/src/biogeophys/LakeFluxesMod.F90 index ec8d24ba11..4963707b48 100644 --- a/src/biogeophys/LakeFluxesMod.F90 +++ b/src/biogeophys/LakeFluxesMod.F90 @@ -93,7 +93,7 @@ subroutine LakeFluxes(bounds, num_lakec, filter_lakec, num_lakep, filter_lakep, use clm_varpar , only : nlevlak use clm_varcon , only : hvap, hsub, hfus, cpair, cpliq, tkwat, tkice, tkair use clm_varcon , only : sb, vkc, grav, denh2o, tfrz, spval - use clm_varctl , only : use_lch4, z0param_method + use clm_varctl , only : use_lch4, z0param_method, use_z0m_snowmelt use LakeCon , only : betavis, z0frzlake, tdmax, emg_lake use LakeCon , only : lake_use_old_fcrit_minz0 use LakeCon , only : minz0lake, cur0, cus, curm, fcrit @@ -227,7 +227,9 @@ subroutine LakeFluxes(bounds, num_lakec, filter_lakec, num_lakep, filter_lakep, lakefetch => lakestate_inst%lakefetch_col , & ! Input: [real(r8) (:) ] lake fetch from surface data (m) h2osoi_liq => waterstatebulk_inst%h2osoi_liq_col , & ! Input: [real(r8) (:,:) ] liquid water (kg/m2) - h2osoi_ice => waterstatebulk_inst%h2osoi_ice_col , & ! Input: [real(r8) (:,:) ] ice lens (kg/m2) + h2osoi_ice => waterstatebulk_inst%h2osoi_ice_col , & ! Input: [real(r8) (:,:) ] ice lens (kg/m2) + snomelt_accum => waterfluxbulk_inst%qflx_snomelt_accum_col , & ! Input: [real(r8) (:) ] accumulated col snow melt for z0m calculation (m H2O) + t_skin_patch => temperature_inst%t_skin_patch , & ! Output: [real(r8) (:) ] patch skin temperature (K) t_lake => temperature_inst%t_lake_col , & ! Input: [real(r8) (:,:) ] lake temperature (Kelvin) @@ -346,13 +348,22 @@ subroutine LakeFluxes(bounds, num_lakec, filter_lakec, num_lakep, filter_lakep, end select z0qg(p) = z0hg(p) else ! use roughness over snow as in Biogeophysics1 - z0mg(p) = params_inst%zsno select case (z0param_method) case ('MeierXXXX') + if(use_z0m_snowmelt) then + z0mg(p) = exp(1.4_r8 * (atan((log10(snomelt_accum(c)+0.23_r8)/0.08_r8))-0.31_r8)) / 1000._r8 + else + z0mg(p) = params_inst%zsno + end if z0hg(p) = 70._r8 * 1.5e-5_r8 / ust_lake(c) ! For initial guess assume tstar = 0 !z0hg(p) = z0mg(p) / exp(params_inst%a_coef * (ust_lake(c) * z0mg(p) / 1.5e-5_r8)**params_inst%a_exp) ! This is for z0 only case ('ZengWang2007') + if(use_z0m_snowmelt) then + z0mg(p) = exp(1.4_r8 * (atan((log10(snomelt_accum(c)+0.23_r8)/0.08_r8))-0.31_r8)) / 1000._r8 + else + z0mg(p) = params_inst%zsno + end if z0hg(p) = z0mg(p) / exp(params_inst%a_coef * (ust_lake(c) * z0mg(p) / 1.5e-5_r8)**params_inst%a_exp) ! Consistent with BareGroundFluxes end select z0qg(p) = z0hg(p) @@ -583,15 +594,19 @@ subroutine LakeFluxes(bounds, num_lakec, filter_lakec, num_lakep, filter_lakep, end select z0qg(p) = z0hg(p) else ! Snow layers - ! z0mg won't have changed + if(use_z0m_snowmelt) then + z0mg(p) = exp(1.4_r8 * (atan((log10(snomelt_accum(c)+0.23_r8)/0.08_r8))-0.31_r8)) / 1000._r8 + end if + select case (z0param_method) - case ('MeierXXXX') + case ('MeierXXXX') z0hg(p) = 70._r8 * 1.5e-5_r8 / ustar(p) * exp( -7.2_r8 * ustar(p)**(0.5_r8) * (abs(tstar))**(0.25_r8)) ! Consistent with BareGroundFluxes !z0hg(p) = z0mg(p) / exp(params_inst%a_coef * (ustar(p) * z0mg(p) / 1.5e-5_r8)**params_inst%a_exp) ! This is for z0 only case ('ZengWang2007') z0hg(p) = z0mg(p) / exp(params_inst%a_coef * (ustar(p) * z0mg(p) / 1.5e-5_r8)**params_inst%a_exp) ! Consistent with BareGroundFluxes end select + z0qg(p) = z0hg(p) end if diff --git a/src/biogeophys/SnowHydrologyMod.F90 b/src/biogeophys/SnowHydrologyMod.F90 index ffe17672cb..6cbb0e24ad 100644 --- a/src/biogeophys/SnowHydrologyMod.F90 +++ b/src/biogeophys/SnowHydrologyMod.F90 @@ -477,6 +477,7 @@ subroutine BulkDiag_NewSnowDiagnostics(bounds, num_c, filter_c, & ! all snow falls on ground, no snow on h2osfc (note that qflx_snow_h2osfc is ! currently set to 0 always in CanopyHydrologyMod) newsnow(c) = qflx_snow_grnd(c) * dtime + qflx_snomelt_accum(c) = max(0._r8, qflx_snomelt_accum(c) - newsnow(c)/1000._r8) ! update int_snow int_snow(c) = max(int_snow(c),h2osno_total(c)) !h2osno_total could be larger due to frost @@ -523,7 +524,6 @@ subroutine BulkDiag_NewSnowDiagnostics(bounds, num_c, filter_c, & if (snl(c) < 0) then dz_snowf = (snow_depth(c) - temp_snow_depth(c)) / dtime dz(c,snl(c)+1) = dz(c,snl(c)+1)+dz_snowf*dtime - qflx_snomelt_accum(c) = max(0._r8, qflx_snomelt_accum(c) - dz_snowf*dtime/1000._r8) end if end do diff --git a/src/main/clm_varctl.F90 b/src/main/clm_varctl.F90 index e3983331fa..4b3c5c9a65 100644 --- a/src/main/clm_varctl.F90 +++ b/src/main/clm_varctl.F90 @@ -221,7 +221,10 @@ module clm_varctl ! Surface roughness parameterization !---------------------------------------------------------- - character(len=64), public :: z0param_method + character(len=64), public :: z0param_method + logical, public :: use_z0m_snowmelt = .false. ! true => use snow z0m parameterization of Brock2006 + logical, public :: use_z0mg_2d = .false. ! true => use 2D ground z0m of Prigent2005 + !---------------------------------------------------------- ! FATES switches diff --git a/src/main/controlMod.F90 b/src/main/controlMod.F90 index 01bbccda2a..ae1324ed7a 100644 --- a/src/main/controlMod.F90 +++ b/src/main/controlMod.F90 @@ -203,7 +203,7 @@ subroutine control_init(dtime) soil_layerstruct_userdefined_nlevsoi, use_subgrid_fluxes, snow_cover_fraction_method, & irrigate, run_zero_weight_urban, all_active, & crop_fsat_equals_zero, for_testing_run_ncdiopio_tests, & - z0param_method + z0param_method, use_z0m_snowmelt, use_z0mg_2d ! vertical soil mixing variables namelist /clm_inparm/ & @@ -792,6 +792,8 @@ subroutine control_spmd() call mpi_bcast (use_subgrid_fluxes , 1, MPI_LOGICAL, 0, mpicom, ier) call mpi_bcast (snow_cover_fraction_method , len(snow_cover_fraction_method), MPI_CHARACTER, 0, mpicom, ier) call mpi_bcast (z0param_method , len(z0param_method), MPI_CHARACTER, 0, mpicom, ier) + call mpi_bcast (use_z0m_snowmelt, 1, MPI_LOGICAL, 0, mpicom, ier) + call mpi_bcast (use_z0mg_2d, 1, MPI_LOGICAL, 0, mpicom, ier) call mpi_bcast (wrtdia, 1, MPI_LOGICAL, 0, mpicom, ier) call mpi_bcast (single_column,1, MPI_LOGICAL, 0, mpicom, ier) call mpi_bcast (scmlat, 1, MPI_REAL8,0, mpicom, ier) From d218ff56fe114d1ff2bb40f518b51ba09b7a4972 Mon Sep 17 00:00:00 2001 From: Ronny Meier Date: Wed, 28 Jul 2021 09:37:07 +0200 Subject: [PATCH 009/257] Saving state --- src/biogeophys/FrictionVelocityMod.F90 | 4 ++-- src/biogeophys/LakeFluxesMod.F90 | 6 +++--- 2 files changed, 5 insertions(+), 5 deletions(-) diff --git a/src/biogeophys/FrictionVelocityMod.F90 b/src/biogeophys/FrictionVelocityMod.F90 index 413fed1134..55629c2efd 100644 --- a/src/biogeophys/FrictionVelocityMod.F90 +++ b/src/biogeophys/FrictionVelocityMod.F90 @@ -632,7 +632,7 @@ subroutine SetRoughnessLengthsAndForcHeightsNonLake(this, bounds, & case ('ZengWang2007') if (frac_sno(c) > 0._r8) then if(use_z0m_snowmelt) then - z0mg(c) = exp(1.4_r8 * (atan((log10(snomelt_accum(c)+0.23_r8)/0.08_r8))-0.31_r8)) / 1000._r8 + z0mg(c) = exp(1.4_r8 * (atan((log10(snomelt_accum(c))+0.23_r8)/0.08_r8))-0.31_r8) / 1000._r8 else z0mg(c) = this%zsno end if @@ -648,7 +648,7 @@ subroutine SetRoughnessLengthsAndForcHeightsNonLake(this, bounds, & l = col%landunit(c) if (frac_sno(c) > 0._r8) then ! Do snow first because ice could be snow-covered if(use_z0m_snowmelt) then - z0mg(c) = exp(1.4_r8 * (atan((log10(snomelt_accum(c)+0.23_r8)/0.08_r8))-0.31_r8)) / 1000._r8 + z0mg(c) = exp(1.4_r8 * (atan((log10(snomelt_accum(c))+0.23_r8)/0.08_r8))-0.31_r8) / 1000._r8 else z0mg(c) = this%zsno end if diff --git a/src/biogeophys/LakeFluxesMod.F90 b/src/biogeophys/LakeFluxesMod.F90 index 4963707b48..d4d858e13e 100644 --- a/src/biogeophys/LakeFluxesMod.F90 +++ b/src/biogeophys/LakeFluxesMod.F90 @@ -351,7 +351,7 @@ subroutine LakeFluxes(bounds, num_lakec, filter_lakec, num_lakep, filter_lakep, select case (z0param_method) case ('MeierXXXX') if(use_z0m_snowmelt) then - z0mg(p) = exp(1.4_r8 * (atan((log10(snomelt_accum(c)+0.23_r8)/0.08_r8))-0.31_r8)) / 1000._r8 + z0mg(p) = exp(1.4_r8 * (atan((log10(snomelt_accum(c))+0.23_r8)/0.08_r8))-0.31_r8) / 1000._r8 else z0mg(p) = params_inst%zsno end if @@ -360,7 +360,7 @@ subroutine LakeFluxes(bounds, num_lakec, filter_lakec, num_lakep, filter_lakep, case ('ZengWang2007') if(use_z0m_snowmelt) then - z0mg(p) = exp(1.4_r8 * (atan((log10(snomelt_accum(c)+0.23_r8)/0.08_r8))-0.31_r8)) / 1000._r8 + z0mg(p) = exp(1.4_r8 * (atan((log10(snomelt_accum(c))+0.23_r8)/0.08_r8))-0.31_r8) / 1000._r8 else z0mg(p) = params_inst%zsno end if @@ -595,7 +595,7 @@ subroutine LakeFluxes(bounds, num_lakec, filter_lakec, num_lakep, filter_lakep, z0qg(p) = z0hg(p) else ! Snow layers if(use_z0m_snowmelt) then - z0mg(p) = exp(1.4_r8 * (atan((log10(snomelt_accum(c)+0.23_r8)/0.08_r8))-0.31_r8)) / 1000._r8 + z0mg(p) = exp(1.4_r8 * (atan((log10(snomelt_accum(c))+0.23_r8)/0.08_r8))-0.31_r8) / 1000._r8 end if select case (z0param_method) From fc20d00db729fefc905c169265b35efb92eda7b5 Mon Sep 17 00:00:00 2001 From: Ronny Meier Date: Wed, 25 Aug 2021 08:53:36 +0200 Subject: [PATCH 010/257] State at first submission --- src/biogeophys/BareGroundFluxesMod.F90 | 8 ++++-- src/biogeophys/BiogeophysPreFluxCalcsMod.F90 | 4 +++ src/biogeophys/CanopyFluxesMod.F90 | 6 ++++ src/biogeophys/FrictionVelocityMod.F90 | 11 ++++++++ src/biogeophys/LakeFluxesMod.F90 | 29 ++++++++++++++++---- src/main/pftconMod.F90 | 4 +++ 6 files changed, 54 insertions(+), 8 deletions(-) diff --git a/src/biogeophys/BareGroundFluxesMod.F90 b/src/biogeophys/BareGroundFluxesMod.F90 index 9d265ec1a3..a89d66ea95 100644 --- a/src/biogeophys/BareGroundFluxesMod.F90 +++ b/src/biogeophys/BareGroundFluxesMod.F90 @@ -337,11 +337,13 @@ subroutine BareGroundFluxes(bounds, num_noexposedvegp, filter_noexposedvegp, & case ('MeierXXXX') ! After Yang et al. (2007) z0hg_patch(p) = 70._r8 * 1.5e-5_r8 / ustar(p) * exp( -7.2_r8 * ustar(p)**(0.5_r8) * (abs(tstar))**(0.25_r8)) + ! After Owen and Thomson (1963) !z0hg_patch(p) = z0mg_patch(p) / exp(0.52_r8 * 0.4_r8 * (8._r8 * ustar(p) * z0mg_patch(p) / 1.5e-5_r8)**params_inst%a_exp * 0.71_r8**0.8_r8) - ! Zeng and Wang (2007) - !z0hg_patch(p) = z0hg_col(c) / exp(params_inst%a_coef * (ustar(p) * z0hg_col(c) / 1.5e-5_r8)**params_inst%a_exp) - + + ! Zeng and Wang (2007) --> Use this for CLM-VEG and CLM-Z0M + !z0hg_patch(p) = z0mg_patch(p) / exp(params_inst%a_coef * (ustar(p) * z0mg_patch(p) / 1.5e-5_r8)**params_inst%a_exp) + end select z0qg_patch(p) = z0hg_patch(p) diff --git a/src/biogeophys/BiogeophysPreFluxCalcsMod.F90 b/src/biogeophys/BiogeophysPreFluxCalcsMod.F90 index a665697b02..01631eeabd 100644 --- a/src/biogeophys/BiogeophysPreFluxCalcsMod.F90 +++ b/src/biogeophys/BiogeophysPreFluxCalcsMod.F90 @@ -189,6 +189,10 @@ subroutine SetZ0mDisp(bounds, num_nolakep, filter_nolakep, & end if + ! --> Use this for CLM-Ya08 + !z0m(p) = pftcon%z0mr(patch%itype(p)) * htop(p) + !displa(p) = pftcon%displar(patch%itype(p)) * htop(p) + end select end if diff --git a/src/biogeophys/CanopyFluxesMod.F90 b/src/biogeophys/CanopyFluxesMod.F90 index c0859e81cc..a13262bcc9 100644 --- a/src/biogeophys/CanopyFluxesMod.F90 +++ b/src/biogeophys/CanopyFluxesMod.F90 @@ -901,6 +901,12 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, z0mv(p) = htop(p) * (1._r8 - displa(p) / htop(p)) * exp(-vkc * U_ustar + & log(z0v_cw(patch%itype(p))) - 1._r8 + z0v_cw(patch%itype(p))**(-1._r8)) + ! --> Use this for CLM-Ya08 + !lt = min(elai(p)+esai(p), tlsai_crit) + !egvf =(1._r8 - alpha_aero * exp(-lt)) / (1._r8 - alpha_aero * exp(-tlsai_crit)) + !displa(p) = egvf * displa(p) + !z0mv(p) = exp(egvf * log(z0mv(p)) + (1._r8 - egvf) * log(z0mg(c))) + case default write(iulog,*) 'ERROR: unknown z0para_method: ', z0param_method call endrun(msg = 'unknown z0param_method', additional_msg = errMsg(sourcefile, __LINE__)) diff --git a/src/biogeophys/FrictionVelocityMod.F90 b/src/biogeophys/FrictionVelocityMod.F90 index 55629c2efd..ce1c9c6c4b 100644 --- a/src/biogeophys/FrictionVelocityMod.F90 +++ b/src/biogeophys/FrictionVelocityMod.F90 @@ -651,14 +651,25 @@ subroutine SetRoughnessLengthsAndForcHeightsNonLake(this, bounds, & z0mg(c) = exp(1.4_r8 * (atan((log10(snomelt_accum(c))+0.23_r8)/0.08_r8))-0.31_r8) / 1000._r8 else z0mg(c) = this%zsno + + ! --> Use this for CLM-VEG and CLM-Ya08 + !z0mg(c) = 0.0024_r8 end if else if (lun%itype(l) == istice_mec) then z0mg(c) = this%zglc + + ! --> Use this for CLM-VEG and CLM-Ya08 + !z0mg(c) = 0.01_r8 + else if(use_z0mg_2d) then z0mg(c) = z0mg_2D(c) else z0mg(c) = this%zlnd + + ! --> Use this for CLM-VEG and CLM-Ya08 + !z0mg(c) = 0.01_r8 + end if end if end select diff --git a/src/biogeophys/LakeFluxesMod.F90 b/src/biogeophys/LakeFluxesMod.F90 index d4d858e13e..a2a58bcb0f 100644 --- a/src/biogeophys/LakeFluxesMod.F90 +++ b/src/biogeophys/LakeFluxesMod.F90 @@ -339,8 +339,14 @@ subroutine LakeFluxes(bounds, num_lakec, filter_lakec, num_lakep, filter_lakep, select case (z0param_method) case ('MeierXXXX') z0mg(p) = params_inst%zglc + + ! --> Use this for CLM-VEG and CLM-Ya08 + !z0mg(p) = z0frzlake + z0hg(p) = 70._r8 * 1.5e-5_r8 / ust_lake(c) ! For initial guess assume tstar = 0 - !z0hg(p) = z0mg(p) / exp(params_inst%a_coef * (ust_lake(c) * z0mg(p) / 1.5e-5_r8)**params_inst%a_exp) ! This is for z0 only + + ! --> Use this for CLM-VEG and CLM-Z0M + !z0hg(p) = z0mg(p) / exp(params_inst%a_coef * (ust_lake(c) * z0mg(p) / 1.5e-5_r8)**params_inst%a_exp) ! Consistent with BareGroundFluxes case ('ZengWang2007') z0mg(p) = z0frzlake @@ -352,11 +358,16 @@ subroutine LakeFluxes(bounds, num_lakec, filter_lakec, num_lakep, filter_lakep, case ('MeierXXXX') if(use_z0m_snowmelt) then z0mg(p) = exp(1.4_r8 * (atan((log10(snomelt_accum(c))+0.23_r8)/0.08_r8))-0.31_r8) / 1000._r8 + + else z0mg(p) = params_inst%zsno + + ! --> Use this for CLM-VEG and CLM-Ya08 + !z0mg(p) = 0.0024_r8 + end if z0hg(p) = 70._r8 * 1.5e-5_r8 / ust_lake(c) ! For initial guess assume tstar = 0 - !z0hg(p) = z0mg(p) / exp(params_inst%a_coef * (ust_lake(c) * z0mg(p) / 1.5e-5_r8)**params_inst%a_exp) ! This is for z0 only case ('ZengWang2007') if(use_z0m_snowmelt) then @@ -585,9 +596,15 @@ subroutine LakeFluxes(bounds, num_lakec, filter_lakec, num_lakep, filter_lakep, select case (z0param_method) case ('MeierXXXX') z0mg(p) = params_inst%zglc + + ! --> Use this for CLM-VEG and CLM-Ya08 + !z0mg(p) = z0frzlake + z0hg(p) = 70._r8 * 1.5e-5_r8 / ustar(p) * exp( -7.2_r8 * ustar(p)**(0.5_r8) * (abs(tstar))**(0.25_r8)) ! Consistent with BareGroundFluxes - !z0hg(p) = z0mg(p) / exp(params_inst%a_coef * (ustar(p) * z0mg(p) / 1.5e-5_r8)**params_inst%a_exp) ! This is for z0 only - + + ! --> Use this for CLM-VEG and CLM-Z0M + !z0hg(p) = z0mg(p) / exp(params_inst%a_coef * (ustar(p) * z0mg(p) / 1.5e-5_r8)**params_inst%a_exp) ! Consistent with BareGroundFluxes + case ('ZengWang2007') z0mg(p) = z0frzlake z0hg(p) = z0mg(p) / exp(params_inst%a_coef * (ustar(p) * z0mg(p) / 1.5e-5_r8)**params_inst%a_exp) ! Consistent with BareGroundFluxes @@ -601,7 +618,9 @@ subroutine LakeFluxes(bounds, num_lakec, filter_lakec, num_lakep, filter_lakep, select case (z0param_method) case ('MeierXXXX') z0hg(p) = 70._r8 * 1.5e-5_r8 / ustar(p) * exp( -7.2_r8 * ustar(p)**(0.5_r8) * (abs(tstar))**(0.25_r8)) ! Consistent with BareGroundFluxes - !z0hg(p) = z0mg(p) / exp(params_inst%a_coef * (ustar(p) * z0mg(p) / 1.5e-5_r8)**params_inst%a_exp) ! This is for z0 only + + ! --> Use this for CLM-VEG and CLM-Z0M + !z0hg(p) = z0mg(p) / exp(params_inst%a_coef * (ustar(p) * z0mg(p) / 1.5e-5_r8)**params_inst%a_exp) ! Consistent with BareGroundFluxes case ('ZengWang2007') z0hg(p) = z0mg(p) / exp(params_inst%a_coef * (ustar(p) * z0mg(p) / 1.5e-5_r8)**params_inst%a_exp) ! Consistent with BareGroundFluxes diff --git a/src/main/pftconMod.F90 b/src/main/pftconMod.F90 index d3ef07a547..aef781bf57 100644 --- a/src/main/pftconMod.F90 +++ b/src/main/pftconMod.F90 @@ -673,6 +673,10 @@ subroutine InitRead(this) this%z0mr = 0._r8 + ! --> Use this for CLM-Ya08 + !call ncd_io('z0mr', this%z0mr, 'read', ncid, readvar=readv, posNOTonfile=.true.) + !if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) + case default write(iulog,*) subname//' ERROR: unknown z0param_method: ', & z0param_method From 2e7b2c31fbcc8c5b570fc9500f04fd8b709f0b23 Mon Sep 17 00:00:00 2001 From: Ronny Meier Date: Thu, 6 Jan 2022 19:21:40 +0100 Subject: [PATCH 011/257] For PR --- src/biogeophys/BareGroundFluxesMod.F90 | 16 ++++++++++++++-- src/biogeophys/BiogeophysPreFluxCalcsMod.F90 | 14 +++++--------- src/biogeophys/CanopyFluxesMod.F90 | 8 ++++++-- src/biogeophys/FrictionVelocityMod.F90 | 1 - src/biogeophys/LakeFluxesMod.F90 | 2 +- src/main/clm_driver.F90 | 2 +- 6 files changed, 27 insertions(+), 16 deletions(-) diff --git a/src/biogeophys/BareGroundFluxesMod.F90 b/src/biogeophys/BareGroundFluxesMod.F90 index a89d66ea95..edab4431e1 100644 --- a/src/biogeophys/BareGroundFluxesMod.F90 +++ b/src/biogeophys/BareGroundFluxesMod.F90 @@ -71,7 +71,7 @@ subroutine BareGroundFluxes(bounds, num_noexposedvegp, filter_noexposedvegp, & atm2lnd_inst, soilstate_inst, & frictionvel_inst, ch4_inst, energyflux_inst, temperature_inst, & waterfluxbulk_inst, waterstatebulk_inst, waterdiagnosticbulk_inst, & - wateratm2lndbulk_inst, photosyns_inst, humanindex_inst) + wateratm2lndbulk_inst, photosyns_inst, humanindex_inst, canopystate_inst) ! ! !DESCRIPTION: ! Compute sensible and latent fluxes and their derivatives with respect @@ -89,6 +89,8 @@ subroutine BareGroundFluxes(bounds, num_noexposedvegp, filter_noexposedvegp, & Wet_Bulb, Wet_BulbS, HeatIndex, AppTemp, & swbgt, hmdex, dis_coi, dis_coiS, THIndex, & SwampCoolEff, KtoC, VaporPres + use CanopyStateType , only : canopystate_type + ! ! !ARGUMENTS: type(bounds_type) , intent(in) :: bounds @@ -107,13 +109,14 @@ subroutine BareGroundFluxes(bounds, num_noexposedvegp, filter_noexposedvegp, & type(wateratm2lndbulk_type) , intent(inout) :: wateratm2lndbulk_inst type(photosyns_type) , intent(inout) :: photosyns_inst type(humanindex_type) , intent(inout) :: humanindex_inst + type(canopystate_type) , intent(inout) :: canopystate_inst + ! ! !LOCAL VARIABLES: integer, parameter :: niters = 3 ! maximum number of iterations for surface temperature integer :: p,c,g,f,j,l ! indices integer :: iter ! iteration index real(r8) :: zldis(bounds%begp:bounds%endp) ! reference height "minus" zero displacement height [m] - real(r8) :: displa(bounds%begp:bounds%endp) ! displacement height [m] real(r8) :: zeta ! dimensionless height used in Monin-Obukhov theory real(r8) :: wc ! convective velocity [m/s] real(r8) :: dth(bounds%begp:bounds%endp) ! diff of virtual temp. between ref. height and surface @@ -240,6 +243,9 @@ subroutine BareGroundFluxes(bounds, num_noexposedvegp, filter_noexposedvegp, & z0mg_patch => frictionvel_inst%z0mg_patch , & ! Output: [real(r8) (:) ] patch roughness length, momentum [m] z0hg_patch => frictionvel_inst%z0hg_patch , & ! Output: [real(r8) (:) ] patch roughness length, sensible heat [m] z0qg_patch => frictionvel_inst%z0qg_patch , & ! Output: [real(r8) (:) ] patch roughness length, latent heat [m] + z0mv => frictionvel_inst%z0mv_patch , & ! Output: [real(r8) (:) ] roughness length over vegetation, momentum [m] + z0hv => frictionvel_inst%z0hv_patch , & ! Output: [real(r8) (:) ] roughness length over vegetation, sensible heat [m] + z0qv => frictionvel_inst%z0qv_patch , & ! Output: [real(r8) (:) ] roughness length over vegetation, latent heat [m] kbm1 => frictionvel_inst%kbm1_patch , & ! Output: [real(r8) (:) ] natural logarithm of z0mg_p/z0hg_p [-] ram1 => frictionvel_inst%ram1_patch , & ! Output: [real(r8) (:) ] aerodynamical resistance (s/m) num_iter => frictionvel_inst%num_iter_patch , & ! Output: [real(r8) (:) ] number of iterations @@ -255,6 +261,8 @@ subroutine BareGroundFluxes(bounds, num_noexposedvegp, filter_noexposedvegp, & rssun => photosyns_inst%rssun_patch , & ! Output: [real(r8) (:) ] leaf sunlit stomatal resistance (s/m) (output from Photosynthesis) rssha => photosyns_inst%rssha_patch , & ! Output: [real(r8) (:) ] leaf shaded stomatal resistance (s/m) (output from Photosynthesis) + displa => canopystate_inst%displa_patch , & ! Output: [real(r8) (:) ] displacement height (m) + begp => bounds%begp , & endp => bounds%endp & ) @@ -291,6 +299,10 @@ subroutine BareGroundFluxes(bounds, num_noexposedvegp, filter_noexposedvegp, & ulrad(p) = 0._r8 dhsdt_canopy(p) = 0._r8 eflx_sh_stem(p) = 0._r8 + z0mv(p) = 0._r8 + z0hv(p) = 0._r8 + z0qv(p) = 0._r8 + ur(p) = max(params_inst%wind_min,sqrt(forc_u(g)*forc_u(g)+forc_v(g)*forc_v(g))) dth(p) = thm(p)-t_grnd(c) diff --git a/src/biogeophys/BiogeophysPreFluxCalcsMod.F90 b/src/biogeophys/BiogeophysPreFluxCalcsMod.F90 index 01631eeabd..f456298089 100644 --- a/src/biogeophys/BiogeophysPreFluxCalcsMod.F90 +++ b/src/biogeophys/BiogeophysPreFluxCalcsMod.F90 @@ -174,18 +174,14 @@ subroutine SetZ0mDisp(bounds, num_nolakep, filter_nolakep, & else ! Compute as if elai+esai = LAImax - LAIoff in CanopyFluxes - displa(p) = htop(p) * (1._r8 - (1._r8 - exp(-(7.5_r8 * (pftcon%z0v_LAImax(patch%itype(p)) - pftcon%z0v_LAIoff(patch%itype(p))))**0.5_r8)) & - / (7.5_r8*(pftcon%z0v_LAImax(patch%itype(p)) - pftcon%z0v_LAIoff(patch%itype(p))))**0.5_r8) + displa(p) = htop(p) * (1._r8 - (1._r8 - exp(-(7.5_r8 * (pftcon%z0v_LAImax(patch%itype(p))))**0.5_r8)) & + / (7.5_r8*(pftcon%z0v_LAImax(patch%itype(p)) ))**0.5_r8) - U_ustar = 4._r8 * (pftcon%z0v_Cs(patch%itype(p)) + pftcon%z0v_Cr(patch%itype(p)) * (pftcon%z0v_LAImax(patch%itype(p)) - pftcon%z0v_LAIoff(patch%itype(p))) & - / 2._r8)**(-0.5_r8) / (pftcon%z0v_LAImax(patch%itype(p)) - pftcon%z0v_LAIoff(patch%itype(p))) / pftcon%z0v_c(patch%itype(p)) + U_ustar = 4._r8 * (pftcon%z0v_Cs(patch%itype(p)) + pftcon%z0v_Cr(patch%itype(p)) * (pftcon%z0v_LAImax(patch%itype(p))) & + / 2._r8)**(-0.5_r8) / (pftcon%z0v_LAImax(patch%itype(p))) / pftcon%z0v_c(patch%itype(p)) - if( htop(p) > -1._r8) then ! Avoid devididing by 0 - z0m(p) = htop(p) * (1._r8 - displa(p) / htop(p)) * exp(-0.4_r8 * U_ustar + & + z0m(p) = htop(p) * (1._r8 - displa(p) / htop(p)) * exp(-0.4_r8 * U_ustar + & log(pftcon%z0v_cw(patch%itype(p))) - 1._r8 + pftcon%z0v_cw(patch%itype(p))**(-1._r8)) - else - z0m(p) = htop(p) * exp(-0.4_r8 * U_ustar + log(pftcon%z0v_cw(patch%itype(p))) - 1._r8 + pftcon%z0v_cw(patch%itype(p))**(-1._r8)) - end if end if diff --git a/src/biogeophys/CanopyFluxesMod.F90 b/src/biogeophys/CanopyFluxesMod.F90 index a13262bcc9..8766edd72e 100644 --- a/src/biogeophys/CanopyFluxesMod.F90 +++ b/src/biogeophys/CanopyFluxesMod.F90 @@ -882,7 +882,7 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, z0mv(p) = exp(egvf * log(z0mv(p)) + (1._r8 - egvf) * log(z0mg(c))) case ('MeierXXXX') - lt = max(0.00001_r8,elai(p)+esai(p)-z0v_LAIoff(patch%itype(p))) + lt = max(0.00001_r8,elai(p)+esai(p)) displa(p) = htop(p) * (1._r8 - (1._r8 - exp(-(7.5_r8 * lt)**0.5_r8)) / (7.5_r8*lt)**0.5_r8) lt = min(lt,z0v_LAImax(patch%itype(p))) @@ -898,9 +898,11 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, end do U_ustar = 4._r8 * U_ustar / lt / z0v_c(patch%itype(p)) + z0mv(p) = htop(p) * (1._r8 - displa(p) / htop(p)) * exp(-vkc * U_ustar + & log(z0v_cw(patch%itype(p))) - 1._r8 + z0v_cw(patch%itype(p))**(-1._r8)) + ! --> Use this for CLM-Ya08 !lt = min(elai(p)+esai(p), tlsai_crit) !egvf =(1._r8 - alpha_aero * exp(-lt)) / (1._r8 - alpha_aero * exp(-tlsai_crit)) @@ -1050,7 +1052,7 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, ! changed by K.Sakaguchi from here ! transfer coefficient over bare soil is changed to a local variable ! just for readability of the code (from line 680) - ! not sure if this needs to be changed with MeierXXXX too. + ! RM: Does this need to be updated if Ya08 is used too? csoilb = vkc / (params_inst%a_coef * (z0mg(c) * uaf(p) / 1.5e-5_r8)**params_inst%a_exp) @@ -1561,6 +1563,7 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, ! function that goes to zero as LAI (ELAI + ESAI) go to zero. t_skin_patch(p) = emv(p)*t_veg(p) + (1._r8 - emv(p))*sqrt(sqrt(lw_grnd)) + !t_skin_patch(p) = (ulrad(p) / 5.670367e-8_r8)**0.25_r8 ! Derivative of soil energy flux with respect to soil temperature @@ -1672,6 +1675,7 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, fn = fn + 1 filterp(fn) = p end if + end do do f = 1, fn diff --git a/src/biogeophys/FrictionVelocityMod.F90 b/src/biogeophys/FrictionVelocityMod.F90 index ce1c9c6c4b..88ba2301e1 100644 --- a/src/biogeophys/FrictionVelocityMod.F90 +++ b/src/biogeophys/FrictionVelocityMod.F90 @@ -460,7 +460,6 @@ subroutine ReadZ0M(this, bounds) do c = bounds%begc, bounds%endc g = col%gridcell(c) this%z0mg_2D_col(c) = max(1.e-4_r8,z0mg2d(g)) - write(iulog,*) z0mg2d(g) end do deallocate(z0mg2d) diff --git a/src/biogeophys/LakeFluxesMod.F90 b/src/biogeophys/LakeFluxesMod.F90 index a2a58bcb0f..0b3c35483c 100644 --- a/src/biogeophys/LakeFluxesMod.F90 +++ b/src/biogeophys/LakeFluxesMod.F90 @@ -344,7 +344,7 @@ subroutine LakeFluxes(bounds, num_lakec, filter_lakec, num_lakep, filter_lakep, !z0mg(p) = z0frzlake z0hg(p) = 70._r8 * 1.5e-5_r8 / ust_lake(c) ! For initial guess assume tstar = 0 - + ! --> Use this for CLM-VEG and CLM-Z0M !z0hg(p) = z0mg(p) / exp(params_inst%a_coef * (ust_lake(c) * z0mg(p) / 1.5e-5_r8)**params_inst%a_exp) ! Consistent with BareGroundFluxes diff --git a/src/main/clm_driver.F90 b/src/main/clm_driver.F90 index 9be5ad20d2..10b184a5ca 100644 --- a/src/main/clm_driver.F90 +++ b/src/main/clm_driver.F90 @@ -652,7 +652,7 @@ subroutine clm_drv(doalb, nextsw_cday, declinp1, declin, rstwr, nlend, rdate, ro frictionvel_inst, ch4_inst, energyflux_inst, temperature_inst, & water_inst%waterfluxbulk_inst, water_inst%waterstatebulk_inst, & water_inst%waterdiagnosticbulk_inst, water_inst%wateratm2lndbulk_inst, & - photosyns_inst, humanindex_inst) + photosyns_inst, humanindex_inst, canopystate_inst) call t_stopf('bgflux') ! non-bareground fluxes for all patches except lakes and urban landunits From 864f3366ff93f9de9f259fc2e57d63aa93a71ebb Mon Sep 17 00:00:00 2001 From: Ronny Meier Date: Wed, 12 Jan 2022 17:53:36 +0100 Subject: [PATCH 012/257] Removing statements of sensitivity experiments. Add more comments following meeting at January 12 2022. --- src/biogeophys/BareGroundFluxesMod.F90 | 8 ++++---- src/biogeophys/BiogeophysPreFluxCalcsMod.F90 | 3 --- src/biogeophys/CanopyFluxesMod.F90 | 11 ++++------- src/biogeophys/FrictionVelocityMod.F90 | 10 ++-------- src/biogeophys/LakeFluxesMod.F90 | 19 +------------------ src/main/pftconMod.F90 | 4 ---- 6 files changed, 11 insertions(+), 44 deletions(-) diff --git a/src/biogeophys/BareGroundFluxesMod.F90 b/src/biogeophys/BareGroundFluxesMod.F90 index edab4431e1..31cd6a628c 100644 --- a/src/biogeophys/BareGroundFluxesMod.F90 +++ b/src/biogeophys/BareGroundFluxesMod.F90 @@ -347,15 +347,15 @@ subroutine BareGroundFluxes(bounds, num_noexposedvegp, filter_noexposedvegp, & case ('ZengWang2007') z0hg_patch(p) = z0mg_patch(p) / exp(params_inst%a_coef * (ustar(p) * z0mg_patch(p) / 1.5e-5_r8)**params_inst%a_exp) case ('MeierXXXX') + ! After Yang et al. (2007) z0hg_patch(p) = 70._r8 * 1.5e-5_r8 / ustar(p) * exp( -7.2_r8 * ustar(p)**(0.5_r8) * (abs(tstar))**(0.25_r8)) - ! After Owen and Thomson (1963) + ! RM: After Owen and Thomson (1963). This formulation could be used as an alternative to Yang et al. (2007). It would + ! avoid that z0hg and z0qg becomes larger frequently than z0mg, which happens with Yang et al. (2007). !z0hg_patch(p) = z0mg_patch(p) / exp(0.52_r8 * 0.4_r8 * (8._r8 * ustar(p) * z0mg_patch(p) / 1.5e-5_r8)**params_inst%a_exp * 0.71_r8**0.8_r8) - ! Zeng and Wang (2007) --> Use this for CLM-VEG and CLM-Z0M - !z0hg_patch(p) = z0mg_patch(p) / exp(params_inst%a_coef * (ustar(p) * z0mg_patch(p) / 1.5e-5_r8)**params_inst%a_exp) - + end select z0qg_patch(p) = z0hg_patch(p) diff --git a/src/biogeophys/BiogeophysPreFluxCalcsMod.F90 b/src/biogeophys/BiogeophysPreFluxCalcsMod.F90 index f456298089..29ac0d8e62 100644 --- a/src/biogeophys/BiogeophysPreFluxCalcsMod.F90 +++ b/src/biogeophys/BiogeophysPreFluxCalcsMod.F90 @@ -185,9 +185,6 @@ subroutine SetZ0mDisp(bounds, num_nolakep, filter_nolakep, & end if - ! --> Use this for CLM-Ya08 - !z0m(p) = pftcon%z0mr(patch%itype(p)) * htop(p) - !displa(p) = pftcon%displar(patch%itype(p)) * htop(p) end select diff --git a/src/biogeophys/CanopyFluxesMod.F90 b/src/biogeophys/CanopyFluxesMod.F90 index 8766edd72e..b31358d239 100644 --- a/src/biogeophys/CanopyFluxesMod.F90 +++ b/src/biogeophys/CanopyFluxesMod.F90 @@ -903,12 +903,6 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, log(z0v_cw(patch%itype(p))) - 1._r8 + z0v_cw(patch%itype(p))**(-1._r8)) - ! --> Use this for CLM-Ya08 - !lt = min(elai(p)+esai(p), tlsai_crit) - !egvf =(1._r8 - alpha_aero * exp(-lt)) / (1._r8 - alpha_aero * exp(-tlsai_crit)) - !displa(p) = egvf * displa(p) - !z0mv(p) = exp(egvf * log(z0mv(p)) + (1._r8 - egvf) * log(z0mg(c))) - case default write(iulog,*) 'ERROR: unknown z0para_method: ', z0param_method call endrun(msg = 'unknown z0param_method', additional_msg = errMsg(sourcefile, __LINE__)) @@ -1052,7 +1046,10 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, ! changed by K.Sakaguchi from here ! transfer coefficient over bare soil is changed to a local variable ! just for readability of the code (from line 680) - ! RM: Does this need to be updated if Ya08 is used too? + ! RM: Does this need to be updated if Ya08 is used too? Proposed formulation (definitely double-check!) + ! , interpreting the statement below as csoilb = vkc / ln(z0mg/z0hg): + ! csoilb = vkc / log( z0mg(c) / ( 70._r8 * 1.5e-5_r8 / ustar(p) * exp( -7.2_r8 * ustar(p)**(0.5_r8) * + ! (abs(tstar))**(0.25_r8)) ) ) csoilb = vkc / (params_inst%a_coef * (z0mg(c) * uaf(p) / 1.5e-5_r8)**params_inst%a_exp) diff --git a/src/biogeophys/FrictionVelocityMod.F90 b/src/biogeophys/FrictionVelocityMod.F90 index 88ba2301e1..e7d26a9f2b 100644 --- a/src/biogeophys/FrictionVelocityMod.F90 +++ b/src/biogeophys/FrictionVelocityMod.F90 @@ -651,24 +651,18 @@ subroutine SetRoughnessLengthsAndForcHeightsNonLake(this, bounds, & else z0mg(c) = this%zsno - ! --> Use this for CLM-VEG and CLM-Ya08 - !z0mg(c) = 0.0024_r8 + end if else if (lun%itype(l) == istice_mec) then z0mg(c) = this%zglc - ! --> Use this for CLM-VEG and CLM-Ya08 - !z0mg(c) = 0.01_r8 else if(use_z0mg_2d) then z0mg(c) = z0mg_2D(c) else z0mg(c) = this%zlnd - - ! --> Use this for CLM-VEG and CLM-Ya08 - !z0mg(c) = 0.01_r8 - + end if end if end select diff --git a/src/biogeophys/LakeFluxesMod.F90 b/src/biogeophys/LakeFluxesMod.F90 index 0b3c35483c..6f9ad0ae56 100644 --- a/src/biogeophys/LakeFluxesMod.F90 +++ b/src/biogeophys/LakeFluxesMod.F90 @@ -340,14 +340,9 @@ subroutine LakeFluxes(bounds, num_lakec, filter_lakec, num_lakep, filter_lakep, case ('MeierXXXX') z0mg(p) = params_inst%zglc - ! --> Use this for CLM-VEG and CLM-Ya08 - !z0mg(p) = z0frzlake z0hg(p) = 70._r8 * 1.5e-5_r8 / ust_lake(c) ! For initial guess assume tstar = 0 - - ! --> Use this for CLM-VEG and CLM-Z0M - !z0hg(p) = z0mg(p) / exp(params_inst%a_coef * (ust_lake(c) * z0mg(p) / 1.5e-5_r8)**params_inst%a_exp) ! Consistent with BareGroundFluxes - + case ('ZengWang2007') z0mg(p) = z0frzlake z0hg(p) = z0mg(p) / exp(params_inst%a_coef * (ust_lake(c) * z0mg(p) / 1.5e-5_r8)**params_inst%a_exp) ! Consistent with BareGroundFluxes @@ -362,9 +357,6 @@ subroutine LakeFluxes(bounds, num_lakec, filter_lakec, num_lakep, filter_lakep, else z0mg(p) = params_inst%zsno - - ! --> Use this for CLM-VEG and CLM-Ya08 - !z0mg(p) = 0.0024_r8 end if z0hg(p) = 70._r8 * 1.5e-5_r8 / ust_lake(c) ! For initial guess assume tstar = 0 @@ -596,15 +588,9 @@ subroutine LakeFluxes(bounds, num_lakec, filter_lakec, num_lakep, filter_lakep, select case (z0param_method) case ('MeierXXXX') z0mg(p) = params_inst%zglc - - ! --> Use this for CLM-VEG and CLM-Ya08 - !z0mg(p) = z0frzlake z0hg(p) = 70._r8 * 1.5e-5_r8 / ustar(p) * exp( -7.2_r8 * ustar(p)**(0.5_r8) * (abs(tstar))**(0.25_r8)) ! Consistent with BareGroundFluxes - ! --> Use this for CLM-VEG and CLM-Z0M - !z0hg(p) = z0mg(p) / exp(params_inst%a_coef * (ustar(p) * z0mg(p) / 1.5e-5_r8)**params_inst%a_exp) ! Consistent with BareGroundFluxes - case ('ZengWang2007') z0mg(p) = z0frzlake z0hg(p) = z0mg(p) / exp(params_inst%a_coef * (ustar(p) * z0mg(p) / 1.5e-5_r8)**params_inst%a_exp) ! Consistent with BareGroundFluxes @@ -619,9 +605,6 @@ subroutine LakeFluxes(bounds, num_lakec, filter_lakec, num_lakep, filter_lakep, case ('MeierXXXX') z0hg(p) = 70._r8 * 1.5e-5_r8 / ustar(p) * exp( -7.2_r8 * ustar(p)**(0.5_r8) * (abs(tstar))**(0.25_r8)) ! Consistent with BareGroundFluxes - ! --> Use this for CLM-VEG and CLM-Z0M - !z0hg(p) = z0mg(p) / exp(params_inst%a_coef * (ustar(p) * z0mg(p) / 1.5e-5_r8)**params_inst%a_exp) ! Consistent with BareGroundFluxes - case ('ZengWang2007') z0hg(p) = z0mg(p) / exp(params_inst%a_coef * (ustar(p) * z0mg(p) / 1.5e-5_r8)**params_inst%a_exp) ! Consistent with BareGroundFluxes end select diff --git a/src/main/pftconMod.F90 b/src/main/pftconMod.F90 index aef781bf57..d3ef07a547 100644 --- a/src/main/pftconMod.F90 +++ b/src/main/pftconMod.F90 @@ -673,10 +673,6 @@ subroutine InitRead(this) this%z0mr = 0._r8 - ! --> Use this for CLM-Ya08 - !call ncd_io('z0mr', this%z0mr, 'read', ncid, readvar=readv, posNOTonfile=.true.) - !if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) - case default write(iulog,*) subname//' ERROR: unknown z0param_method: ', & z0param_method From 8318cad9abcea15c88ca8549a52f636dab63054b Mon Sep 17 00:00:00 2001 From: Ronny Meier Date: Wed, 12 Jan 2022 18:10:05 +0100 Subject: [PATCH 013/257] Small correction to proposed statement in CanopyFluxes --- src/biogeophys/CanopyFluxesMod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/biogeophys/CanopyFluxesMod.F90 b/src/biogeophys/CanopyFluxesMod.F90 index b31358d239..da690f2d5c 100644 --- a/src/biogeophys/CanopyFluxesMod.F90 +++ b/src/biogeophys/CanopyFluxesMod.F90 @@ -1049,7 +1049,7 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, ! RM: Does this need to be updated if Ya08 is used too? Proposed formulation (definitely double-check!) ! , interpreting the statement below as csoilb = vkc / ln(z0mg/z0hg): ! csoilb = vkc / log( z0mg(c) / ( 70._r8 * 1.5e-5_r8 / ustar(p) * exp( -7.2_r8 * ustar(p)**(0.5_r8) * - ! (abs(tstar))**(0.25_r8)) ) ) + ! (abs(temp1(p)*dth(p)))**(0.25_r8)) ) ) csoilb = vkc / (params_inst%a_coef * (z0mg(c) * uaf(p) / 1.5e-5_r8)**params_inst%a_exp) From c611d6ece08402539dbd398bc09a272459fb5c88 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Thu, 13 Jan 2022 16:16:29 -0700 Subject: [PATCH 014/257] Add user-mod directories for the surface roughness changes from Ronny Meier --- .../testmods_dirs/clm/Meier2022_surf_rough/include_user_mods | 1 + .../testmods_dirs/clm/Meier2022_surf_rough/user_nl_clm | 4 ++++ .../clm/Meier2022_surf_rough_all_f09/include_user_mods | 1 + .../clm/Meier2022_surf_rough_all_f09/user_nl_clm | 2 ++ .../clm/Meier2022_surf_rough_all_hcru/include_user_mods | 1 + .../clm/Meier2022_surf_rough_all_hcru/user_nl_clm | 2 ++ 6 files changed, 11 insertions(+) create mode 100644 cime_config/testdefs/testmods_dirs/clm/Meier2022_surf_rough/include_user_mods create mode 100644 cime_config/testdefs/testmods_dirs/clm/Meier2022_surf_rough/user_nl_clm create mode 100644 cime_config/testdefs/testmods_dirs/clm/Meier2022_surf_rough_all_f09/include_user_mods create mode 100644 cime_config/testdefs/testmods_dirs/clm/Meier2022_surf_rough_all_f09/user_nl_clm create mode 100644 cime_config/testdefs/testmods_dirs/clm/Meier2022_surf_rough_all_hcru/include_user_mods create mode 100644 cime_config/testdefs/testmods_dirs/clm/Meier2022_surf_rough_all_hcru/user_nl_clm diff --git a/cime_config/testdefs/testmods_dirs/clm/Meier2022_surf_rough/include_user_mods b/cime_config/testdefs/testmods_dirs/clm/Meier2022_surf_rough/include_user_mods new file mode 100644 index 0000000000..fe0e18cf88 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/clm/Meier2022_surf_rough/include_user_mods @@ -0,0 +1 @@ +../default diff --git a/cime_config/testdefs/testmods_dirs/clm/Meier2022_surf_rough/user_nl_clm b/cime_config/testdefs/testmods_dirs/clm/Meier2022_surf_rough/user_nl_clm new file mode 100644 index 0000000000..b9fd293412 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/clm/Meier2022_surf_rough/user_nl_clm @@ -0,0 +1,4 @@ +z0param_method = 'MeierXXXX' +use_z0m_snowmelt = .true. +use_z0mg_2d = .false. +paramfile = '/glade/p/cesm/lmwg_dev/oleson/Z0_RonnieMeier/ctsm51_params_newz0.c211112.nc' diff --git a/cime_config/testdefs/testmods_dirs/clm/Meier2022_surf_rough_all_f09/include_user_mods b/cime_config/testdefs/testmods_dirs/clm/Meier2022_surf_rough_all_f09/include_user_mods new file mode 100644 index 0000000000..38bef34f6e --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/clm/Meier2022_surf_rough_all_f09/include_user_mods @@ -0,0 +1 @@ +../Meier2022_surf_rough diff --git a/cime_config/testdefs/testmods_dirs/clm/Meier2022_surf_rough_all_f09/user_nl_clm b/cime_config/testdefs/testmods_dirs/clm/Meier2022_surf_rough_all_f09/user_nl_clm new file mode 100644 index 0000000000..0a33a7a06c --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/clm/Meier2022_surf_rough_all_f09/user_nl_clm @@ -0,0 +1,2 @@ +use_z0mg_2d = .true. +fsurdat = '/glade/p/cesm/lmwg_dev/oleson/Z0_RonnieMeier/surfdata_0.9x1.25_hist_16pfts_Irrig_CMIP6_simyr2000_c210624.nc' diff --git a/cime_config/testdefs/testmods_dirs/clm/Meier2022_surf_rough_all_hcru/include_user_mods b/cime_config/testdefs/testmods_dirs/clm/Meier2022_surf_rough_all_hcru/include_user_mods new file mode 100644 index 0000000000..38bef34f6e --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/clm/Meier2022_surf_rough_all_hcru/include_user_mods @@ -0,0 +1 @@ +../Meier2022_surf_rough diff --git a/cime_config/testdefs/testmods_dirs/clm/Meier2022_surf_rough_all_hcru/user_nl_clm b/cime_config/testdefs/testmods_dirs/clm/Meier2022_surf_rough_all_hcru/user_nl_clm new file mode 100644 index 0000000000..6043dae4af --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/clm/Meier2022_surf_rough_all_hcru/user_nl_clm @@ -0,0 +1,2 @@ +use_z0mg_2d = .true. +fsurdat = ' /glade/p/cesm/lmwg_dev/oleson/Z0_RonnieMeier/surfdata_360x720cru_16pfts_Irrig_CMIP6_simyr2000_c210624_2D.nc' From 9ae6e30f0e26a8dc64e47f40b764b7b9f684d63e Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Thu, 13 Jan 2022 16:17:12 -0700 Subject: [PATCH 015/257] Remove use_z0v_forest because it's not connected to anything in the FORTRAN code --- bld/namelist_files/namelist_definition_ctsm.xml | 4 ---- 1 file changed, 4 deletions(-) diff --git a/bld/namelist_files/namelist_definition_ctsm.xml b/bld/namelist_files/namelist_definition_ctsm.xml index a63f2317f8..a058b10c0f 100644 --- a/bld/namelist_files/namelist_definition_ctsm.xml +++ b/bld/namelist_files/namelist_definition_ctsm.xml @@ -340,10 +340,6 @@ If TRUE use the undercanopy stability term used with CLM4.5 (Sakaguchi&Zeng, group="canopyfluxes_inparm" valid_values="" > If TRUE, include biomass heat storage in canopy energy balance. - -If TRUE, use new parameterization of vegetation surface roughness for forests. - Max number of iterations used in subr. CanopyFluxes. For many years, 40 was the hardwired default value. From 0ee8c69a79006cf19fd18031310ccf407c0f884d Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Thu, 13 Jan 2022 16:31:55 -0700 Subject: [PATCH 016/257] Handle very small values of htop and snowmelt_accum with new Meier2022 code --- src/biogeophys/BiogeophysPreFluxCalcsMod.F90 | 8 ++++++-- src/biogeophys/FrictionVelocityMod.F90 | 11 ++++++++--- src/biogeophys/LakeFluxesMod.F90 | 15 +++++++++++---- 3 files changed, 25 insertions(+), 9 deletions(-) diff --git a/src/biogeophys/BiogeophysPreFluxCalcsMod.F90 b/src/biogeophys/BiogeophysPreFluxCalcsMod.F90 index 29ac0d8e62..edc59cdb34 100644 --- a/src/biogeophys/BiogeophysPreFluxCalcsMod.F90 +++ b/src/biogeophys/BiogeophysPreFluxCalcsMod.F90 @@ -180,8 +180,12 @@ subroutine SetZ0mDisp(bounds, num_nolakep, filter_nolakep, & U_ustar = 4._r8 * (pftcon%z0v_Cs(patch%itype(p)) + pftcon%z0v_Cr(patch%itype(p)) * (pftcon%z0v_LAImax(patch%itype(p))) & / 2._r8)**(-0.5_r8) / (pftcon%z0v_LAImax(patch%itype(p))) / pftcon%z0v_c(patch%itype(p)) - z0m(p) = htop(p) * (1._r8 - displa(p) / htop(p)) * exp(-0.4_r8 * U_ustar + & - log(pftcon%z0v_cw(patch%itype(p))) - 1._r8 + pftcon%z0v_cw(patch%itype(p))**(-1._r8)) + if ( htop(p) <= 1.e-10_r8 )then + z0m(p) = 0.0_r8 + else + z0m(p) = htop(p) * (1._r8 - displa(p) / htop(p)) * exp(-0.4_r8 * U_ustar + & + log(pftcon%z0v_cw(patch%itype(p))) - 1._r8 + pftcon%z0v_cw(patch%itype(p))**(-1._r8)) + end if end if diff --git a/src/biogeophys/FrictionVelocityMod.F90 b/src/biogeophys/FrictionVelocityMod.F90 index e7d26a9f2b..6be12091d8 100644 --- a/src/biogeophys/FrictionVelocityMod.F90 +++ b/src/biogeophys/FrictionVelocityMod.F90 @@ -11,6 +11,7 @@ module FrictionVelocityMod use shr_log_mod , only : errMsg => shr_log_errMsg use shr_const_mod , only : SHR_CONST_PI use decompMod , only : bounds_type + use abortutils , only : endrun use clm_varcon , only : spval use clm_varctl , only : use_cn, use_luna, z0param_method, use_z0mg_2d, use_z0m_snowmelt use LandunitType , only : lun @@ -422,7 +423,6 @@ subroutine ReadZ0M(this, bounds) ! !USES: use shr_log_mod, only : errMsg => shr_log_errMsg use fileutils , only : getfil - use abortutils , only : endrun use ncdio_pio , only : file_desc_t, ncd_defvar, ncd_io, ncd_pio_openfile, ncd_pio_closefile use spmdMod , only : masterproc use clm_varcon , only : grlnd @@ -513,7 +513,6 @@ subroutine ReadNamelist( this, NLFilename ) use shr_mpi_mod , only : shr_mpi_bcast use clm_varctl , only : iulog use shr_log_mod , only : errMsg => shr_log_errMsg - use abortutils , only : endrun ! ! !ARGUMENTS: class(frictionvel_type), intent(inout) :: this @@ -571,6 +570,8 @@ subroutine SetRoughnessLengthsAndForcHeightsNonLake(this, bounds, & ! !DESCRIPTION: ! Set roughness lengths and forcing heights for non-lake points ! + ! !USES: + use clm_varcon , only : rpi ! !ARGUMENTS: class(frictionvel_type) , intent(inout) :: this type(bounds_type) , intent(in) :: bounds @@ -647,7 +648,11 @@ subroutine SetRoughnessLengthsAndForcHeightsNonLake(this, bounds, & l = col%landunit(c) if (frac_sno(c) > 0._r8) then ! Do snow first because ice could be snow-covered if(use_z0m_snowmelt) then - z0mg(c) = exp(1.4_r8 * (atan((log10(snomelt_accum(c))+0.23_r8)/0.08_r8))-0.31_r8) / 1000._r8 + if ( snomelt_accum(c) < 1.e-12_r8 )then + z0mg(c) = exp(1.4_r8 * -rpi/2.0_r8 -0.31_r8) / 1000._r8 + else + z0mg(c) = exp(1.4_r8 * (atan((log10(snomelt_accum(c))+0.23_r8)/0.08_r8))-0.31_r8) / 1000._r8 + end if else z0mg(c) = this%zsno diff --git a/src/biogeophys/LakeFluxesMod.F90 b/src/biogeophys/LakeFluxesMod.F90 index 6f9ad0ae56..9642e76c3c 100644 --- a/src/biogeophys/LakeFluxesMod.F90 +++ b/src/biogeophys/LakeFluxesMod.F90 @@ -92,7 +92,7 @@ subroutine LakeFluxes(bounds, num_lakec, filter_lakec, num_lakep, filter_lakep, ! !USES: use clm_varpar , only : nlevlak use clm_varcon , only : hvap, hsub, hfus, cpair, cpliq, tkwat, tkice, tkair - use clm_varcon , only : sb, vkc, grav, denh2o, tfrz, spval + use clm_varcon , only : sb, vkc, grav, denh2o, tfrz, spval, rpi use clm_varctl , only : use_lch4, z0param_method, use_z0m_snowmelt use LakeCon , only : betavis, z0frzlake, tdmax, emg_lake use LakeCon , only : lake_use_old_fcrit_minz0 @@ -352,8 +352,11 @@ subroutine LakeFluxes(bounds, num_lakec, filter_lakec, num_lakep, filter_lakep, select case (z0param_method) case ('MeierXXXX') if(use_z0m_snowmelt) then - z0mg(p) = exp(1.4_r8 * (atan((log10(snomelt_accum(c))+0.23_r8)/0.08_r8))-0.31_r8) / 1000._r8 - + if ( snomelt_accum(c) < 1.e-12_r8 )then + z0mg(c) = exp(1.4_r8 * -rpi/2.0_r8 -0.31_r8) / 1000._r8 + else + z0mg(p) = exp(1.4_r8 * (atan((log10(snomelt_accum(c))+0.23_r8)/0.08_r8))-0.31_r8) / 1000._r8 + end if else z0mg(p) = params_inst%zsno @@ -598,7 +601,11 @@ subroutine LakeFluxes(bounds, num_lakec, filter_lakec, num_lakep, filter_lakep, z0qg(p) = z0hg(p) else ! Snow layers if(use_z0m_snowmelt) then - z0mg(p) = exp(1.4_r8 * (atan((log10(snomelt_accum(c))+0.23_r8)/0.08_r8))-0.31_r8) / 1000._r8 + if ( snomelt_accum(c) < 1.e-12_r8 )then + z0mg(c) = exp(1.4_r8 * -rpi/2.0_r8 -0.31_r8) / 1000._r8 + else + z0mg(p) = exp(1.4_r8 * (atan((log10(snomelt_accum(c))+0.23_r8)/0.08_r8))-0.31_r8) / 1000._r8 + end if end if select case (z0param_method) From 02be2d8c4f4f121477fe60911c46c9bb65384b67 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Fri, 14 Jan 2022 14:35:26 -0700 Subject: [PATCH 017/257] Don't set z0mg and displa on first step of run for RonnyMeier2022 roughness as htop isn't set yet. Also use a different threshold for snomelt_accum suggested by Ronny Meier --- src/biogeophys/BiogeophysPreFluxCalcsMod.F90 | 13 ++++++++++++- src/biogeophys/FrictionVelocityMod.F90 | 2 +- src/biogeophys/LakeFluxesMod.F90 | 4 ++-- 3 files changed, 15 insertions(+), 4 deletions(-) diff --git a/src/biogeophys/BiogeophysPreFluxCalcsMod.F90 b/src/biogeophys/BiogeophysPreFluxCalcsMod.F90 index edc59cdb34..6725c63320 100644 --- a/src/biogeophys/BiogeophysPreFluxCalcsMod.F90 +++ b/src/biogeophys/BiogeophysPreFluxCalcsMod.F90 @@ -124,6 +124,10 @@ subroutine SetZ0mDisp(bounds, num_nolakep, filter_nolakep, & ! !DESCRIPTION: ! Set z0m and displa ! + ! !USES: + use clm_time_manager, only : is_first_step + use clm_varcon , only : namep + use abortutils , only : endrun ! !ARGUMENTS: type(bounds_type) , intent(in) :: bounds integer , intent(in) :: num_nolakep ! number of column non-lake points in patch filter @@ -168,6 +172,13 @@ subroutine SetZ0mDisp(bounds, num_nolakep, filter_nolakep, & case ('MeierXXXX') + ! Don't set on first step of a simulation, since htop isn't set yet + if ( is_first_step() ) then + z0m(p) = 0._r8 + displa(p) = 0._r8 + cycle + end if + if (patch%itype(p) == noveg) then z0m(p) = 0._r8 displa(p) = 0._r8 @@ -181,7 +192,7 @@ subroutine SetZ0mDisp(bounds, num_nolakep, filter_nolakep, & / 2._r8)**(-0.5_r8) / (pftcon%z0v_LAImax(patch%itype(p))) / pftcon%z0v_c(patch%itype(p)) if ( htop(p) <= 1.e-10_r8 )then - z0m(p) = 0.0_r8 + call endrun(decomp_index=p, clmlevel=namep, msg=errMsg(sourcefile, __LINE__)) else z0m(p) = htop(p) * (1._r8 - displa(p) / htop(p)) * exp(-0.4_r8 * U_ustar + & log(pftcon%z0v_cw(patch%itype(p))) - 1._r8 + pftcon%z0v_cw(patch%itype(p))**(-1._r8)) diff --git a/src/biogeophys/FrictionVelocityMod.F90 b/src/biogeophys/FrictionVelocityMod.F90 index 6be12091d8..e6c4b848dd 100644 --- a/src/biogeophys/FrictionVelocityMod.F90 +++ b/src/biogeophys/FrictionVelocityMod.F90 @@ -648,7 +648,7 @@ subroutine SetRoughnessLengthsAndForcHeightsNonLake(this, bounds, & l = col%landunit(c) if (frac_sno(c) > 0._r8) then ! Do snow first because ice could be snow-covered if(use_z0m_snowmelt) then - if ( snomelt_accum(c) < 1.e-12_r8 )then + if ( snomelt_accum(c) < 1.e-5_r8 )then z0mg(c) = exp(1.4_r8 * -rpi/2.0_r8 -0.31_r8) / 1000._r8 else z0mg(c) = exp(1.4_r8 * (atan((log10(snomelt_accum(c))+0.23_r8)/0.08_r8))-0.31_r8) / 1000._r8 diff --git a/src/biogeophys/LakeFluxesMod.F90 b/src/biogeophys/LakeFluxesMod.F90 index 9642e76c3c..b3bcda6fe5 100644 --- a/src/biogeophys/LakeFluxesMod.F90 +++ b/src/biogeophys/LakeFluxesMod.F90 @@ -352,7 +352,7 @@ subroutine LakeFluxes(bounds, num_lakec, filter_lakec, num_lakep, filter_lakep, select case (z0param_method) case ('MeierXXXX') if(use_z0m_snowmelt) then - if ( snomelt_accum(c) < 1.e-12_r8 )then + if ( snomelt_accum(c) < 1.e-5_r8 )then z0mg(c) = exp(1.4_r8 * -rpi/2.0_r8 -0.31_r8) / 1000._r8 else z0mg(p) = exp(1.4_r8 * (atan((log10(snomelt_accum(c))+0.23_r8)/0.08_r8))-0.31_r8) / 1000._r8 @@ -601,7 +601,7 @@ subroutine LakeFluxes(bounds, num_lakec, filter_lakec, num_lakep, filter_lakep, z0qg(p) = z0hg(p) else ! Snow layers if(use_z0m_snowmelt) then - if ( snomelt_accum(c) < 1.e-12_r8 )then + if ( snomelt_accum(c) < 1.e-5_r8 )then z0mg(c) = exp(1.4_r8 * -rpi/2.0_r8 -0.31_r8) / 1000._r8 else z0mg(p) = exp(1.4_r8 * (atan((log10(snomelt_accum(c))+0.23_r8)/0.08_r8))-0.31_r8) / 1000._r8 From 0b7fd394c2fdec7742b202fa46efd059fa3a96f3 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Fri, 18 Feb 2022 17:39:32 -0700 Subject: [PATCH 018/257] Skip first few steps as htop isn't set until after first do_alb step --- src/biogeophys/BiogeophysPreFluxCalcsMod.F90 | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) diff --git a/src/biogeophys/BiogeophysPreFluxCalcsMod.F90 b/src/biogeophys/BiogeophysPreFluxCalcsMod.F90 index 6725c63320..afb5ff8dfd 100644 --- a/src/biogeophys/BiogeophysPreFluxCalcsMod.F90 +++ b/src/biogeophys/BiogeophysPreFluxCalcsMod.F90 @@ -16,7 +16,7 @@ module BiogeophysPreFluxCalcsMod use LandunitType , only : lun use clm_varcon , only : spval use clm_varpar , only : nlevgrnd, nlevsno, nlevurb, nlevmaxurbgrnd - use clm_varctl , only : use_fates, z0param_method + use clm_varctl , only : use_fates, z0param_method, iulog use pftconMod , only : pftcon, noveg use column_varcon , only : icol_roof, icol_sunwall, icol_shadewall use landunit_varcon , only : istsoil, istcrop, istice_mec @@ -125,9 +125,10 @@ subroutine SetZ0mDisp(bounds, num_nolakep, filter_nolakep, & ! Set z0m and displa ! ! !USES: - use clm_time_manager, only : is_first_step + use clm_time_manager, only : is_first_step, get_nstep use clm_varcon , only : namep use abortutils , only : endrun + use BalanceCheckMod , only : GetBalanceCheckSkipSteps ! !ARGUMENTS: type(bounds_type) , intent(in) :: bounds integer , intent(in) :: num_nolakep ! number of column non-lake points in patch filter @@ -172,8 +173,8 @@ subroutine SetZ0mDisp(bounds, num_nolakep, filter_nolakep, & case ('MeierXXXX') - ! Don't set on first step of a simulation, since htop isn't set yet - if ( is_first_step() ) then + ! Don't set on first few steps of a simulation, since htop isn't set yet, need to wait until after first do_alb time + if ( is_first_step() .or. get_nstep() <= GetBalanceCheckSkipSteps() ) then z0m(p) = 0._r8 displa(p) = 0._r8 cycle @@ -192,6 +193,7 @@ subroutine SetZ0mDisp(bounds, num_nolakep, filter_nolakep, & / 2._r8)**(-0.5_r8) / (pftcon%z0v_LAImax(patch%itype(p))) / pftcon%z0v_c(patch%itype(p)) if ( htop(p) <= 1.e-10_r8 )then + write(iulog,*) ' nstep = ', get_nstep(), ' htop = ', htop(p) call endrun(decomp_index=p, clmlevel=namep, msg=errMsg(sourcefile, __LINE__)) else z0m(p) = htop(p) * (1._r8 - displa(p) / htop(p)) * exp(-0.4_r8 * U_ustar + & From 0e71cb2f30b850569b2f7ab95644c4cf743e47c5 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Sat, 19 Feb 2022 17:19:18 -0700 Subject: [PATCH 019/257] Correct subscript --- src/biogeophys/LakeFluxesMod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/biogeophys/LakeFluxesMod.F90 b/src/biogeophys/LakeFluxesMod.F90 index b3bcda6fe5..95afac05f4 100644 --- a/src/biogeophys/LakeFluxesMod.F90 +++ b/src/biogeophys/LakeFluxesMod.F90 @@ -353,7 +353,7 @@ subroutine LakeFluxes(bounds, num_lakec, filter_lakec, num_lakep, filter_lakep, case ('MeierXXXX') if(use_z0m_snowmelt) then if ( snomelt_accum(c) < 1.e-5_r8 )then - z0mg(c) = exp(1.4_r8 * -rpi/2.0_r8 -0.31_r8) / 1000._r8 + z0mg(p) = exp(1.4_r8 * -rpi/2.0_r8 -0.31_r8) / 1000._r8 else z0mg(p) = exp(1.4_r8 * (atan((log10(snomelt_accum(c))+0.23_r8)/0.08_r8))-0.31_r8) / 1000._r8 end if From 84396e6d7817249da2f66c1b30135dd5d2579e04 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Tue, 22 Feb 2022 01:04:18 -0700 Subject: [PATCH 020/257] Add write of rh if negative or over 100 when DEBUG on --- src/biogeophys/HumanIndexMod.F90 | 15 ++++++++++++--- 1 file changed, 12 insertions(+), 3 deletions(-) diff --git a/src/biogeophys/HumanIndexMod.F90 b/src/biogeophys/HumanIndexMod.F90 index a231c0919d..9f56081104 100644 --- a/src/biogeophys/HumanIndexMod.F90 +++ b/src/biogeophys/HumanIndexMod.F90 @@ -16,6 +16,9 @@ module HumanIndexMod ! !USES: use shr_kind_mod , only : r8 => shr_kind_r8 use decompMod , only : bounds_type + use abortutils , only : endrun + use clm_varctl , only : iulog + use shr_log_mod , only : errMsg => shr_log_errMsg ! !PUBLIC TYPES: implicit none save @@ -498,13 +501,10 @@ subroutine HumanIndexReadNML( NLFilename ) ! ! !USES: use shr_mpi_mod , only : shr_mpi_bcast - use abortutils , only : endrun use spmdMod , only : masterproc, mpicom use fileutils , only : getavu, relavu, opnfil use shr_nl_mod , only : shr_nl_find_group_name use shr_mpi_mod , only : shr_mpi_bcast - use clm_varctl , only : iulog - use shr_log_mod , only : errMsg => shr_log_errMsg ! ! !ARGUMENTS: implicit none @@ -1012,6 +1012,15 @@ subroutine Wet_BulbS (Tc_6,rh,wbt) ! !LOCAL VARIABLES: !EOP ! +#ifndef NDEBUG + if ( rh < 0.0d00 )then + write(iulog,*) 'rh = ', rh + call endrun(msg="ERROR RH is negative "//errmsg(sourcefile, __LINE__)) + else if ( rh > 100.d00 )then + write(iulog,*) 'rh = ', rh + call endrun(msg="ERROR RH is greater than a hundred "//errmsg(sourcefile, __LINE__)) + end if +#endif wbt = Tc_6 * atan(0.151977_r8*sqrt(rh + 8.313659_r8)) + & atan(Tc_6+rh) - atan(rh-1.676331_r8) + & 0.00391838_r8*rh**(3._r8/2._r8)*atan(0.023101_r8*rh) - & From 23601a73e38c52a162a99c5de8730e3c67be56d2 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Tue, 22 Feb 2022 01:06:06 -0700 Subject: [PATCH 021/257] Write out warning if ustar*thvstar is positive to prevent a cube root of a negative number being done, in this case set wc to zero and continue --- src/biogeophys/CanopyFluxesMod.F90 | 20 +++++++++++++++++++- 1 file changed, 19 insertions(+), 1 deletion(-) diff --git a/src/biogeophys/CanopyFluxesMod.F90 b/src/biogeophys/CanopyFluxesMod.F90 index da690f2d5c..ed9e32466c 100644 --- a/src/biogeophys/CanopyFluxesMod.F90 +++ b/src/biogeophys/CanopyFluxesMod.F90 @@ -1382,7 +1382,25 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, um(p) = max(ur(p),0.1_r8) else !unstable zeta(p) = max(-100._r8,min(zeta(p),-0.01_r8)) - wc = beta*(-grav*ustar(p)*thvstar*zii/thv(c))**0.333_r8 + if ( ustar(p)*thvstar > 0.0d00 )then + write(iulog,*) 'ustar*thvstart is positive and has to be negative' + write(iulog,*) 'p = ', p + write(iulog,*) '-grav*ustar(p)*thvstar*zii/thv(c) = ', -grav*ustar(p)*thvstar*zii/thv(c) + write(iulog,*) 'ustar = ', ustar(p) + write(iulog,*) 'thvstar = ', thvstar + write(iulog,*) 'thv = ', thv(c) + write(iulog,*) 'displa= ', displa(p) + write(iulog,*) 'z0mg= ', z0mg(c) + write(iulog,*) 'zeta= ', zeta(p) + write(iulog,*) 'temp1= ', temp1(p) + write(iulog,*) 'dth= ', dth(p) + write(iulog,*) 'rah(above)= ', rah(p,above_canopy) + write(iulog,*) 'rah(below)= ', rah(p,below_canopy) + !call endrun(decomp_index=p, clmlevel=namep, msg=errmsg(sourcefile, __LINE__)) + wc = 0.0_r8 + else + wc = beta*(-grav*ustar(p)*thvstar*zii/thv(c))**0.333_r8 + end if um(p) = sqrt(ur(p)*ur(p)+wc*wc) end if obu(p) = zldis(p)/zeta(p) From 4eabfbb11497448913e43bcb952476bc5ee8ed19 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Tue, 22 Feb 2022 01:08:48 -0700 Subject: [PATCH 022/257] Set human stress indices to calculate NONE when Meier surface roughness is used to prevent a numerical error that kills the run in calc of WetBulb temp because of negative relative humidity --- .../testdefs/testmods_dirs/clm/Meier2022_surf_rough/user_nl_clm | 2 ++ 1 file changed, 2 insertions(+) diff --git a/cime_config/testdefs/testmods_dirs/clm/Meier2022_surf_rough/user_nl_clm b/cime_config/testdefs/testmods_dirs/clm/Meier2022_surf_rough/user_nl_clm index b9fd293412..dadc6e463e 100644 --- a/cime_config/testdefs/testmods_dirs/clm/Meier2022_surf_rough/user_nl_clm +++ b/cime_config/testdefs/testmods_dirs/clm/Meier2022_surf_rough/user_nl_clm @@ -1,4 +1,6 @@ z0param_method = 'MeierXXXX' use_z0m_snowmelt = .true. use_z0mg_2d = .false. +calc_human_stress_indices = 'NONE' ! Currently dies when turned on because of a negative humidity (about -31) in Wet Bulb calculation paramfile = '/glade/p/cesm/lmwg_dev/oleson/Z0_RonnieMeier/ctsm51_params_newz0.c211112.nc' + From f644624b9b96dc9f44be6e73ddeff47c247cded2 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Tue, 22 Feb 2022 12:00:39 -0700 Subject: [PATCH 023/257] Fix subscript --- src/biogeophys/LakeFluxesMod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/biogeophys/LakeFluxesMod.F90 b/src/biogeophys/LakeFluxesMod.F90 index 95afac05f4..b2b6e62967 100644 --- a/src/biogeophys/LakeFluxesMod.F90 +++ b/src/biogeophys/LakeFluxesMod.F90 @@ -602,7 +602,7 @@ subroutine LakeFluxes(bounds, num_lakec, filter_lakec, num_lakep, filter_lakep, else ! Snow layers if(use_z0m_snowmelt) then if ( snomelt_accum(c) < 1.e-5_r8 )then - z0mg(c) = exp(1.4_r8 * -rpi/2.0_r8 -0.31_r8) / 1000._r8 + z0mg(p) = exp(1.4_r8 * -rpi/2.0_r8 -0.31_r8) / 1000._r8 else z0mg(p) = exp(1.4_r8 * (atan((log10(snomelt_accum(c))+0.23_r8)/0.08_r8))-0.31_r8) / 1000._r8 end if From 32dbda81127f62fc092d4ac35da159927ddc3ed1 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Tue, 22 Feb 2022 13:51:39 -0700 Subject: [PATCH 024/257] Rename test mods to highlight these are non-crop cases --- .../include_user_mods | 0 .../user_nl_clm | 0 .../include_user_mods | 0 .../user_nl_clm | 0 4 files changed, 0 insertions(+), 0 deletions(-) rename cime_config/testdefs/testmods_dirs/clm/{Meier2022_surf_rough_all_f09 => Meier2022_surf_rough_all_f09NonCrop}/include_user_mods (100%) rename cime_config/testdefs/testmods_dirs/clm/{Meier2022_surf_rough_all_f09 => Meier2022_surf_rough_all_f09NonCrop}/user_nl_clm (100%) rename cime_config/testdefs/testmods_dirs/clm/{Meier2022_surf_rough_all_hcru => Meier2022_surf_rough_all_hcruNonCrop}/include_user_mods (100%) rename cime_config/testdefs/testmods_dirs/clm/{Meier2022_surf_rough_all_hcru => Meier2022_surf_rough_all_hcruNonCrop}/user_nl_clm (100%) diff --git a/cime_config/testdefs/testmods_dirs/clm/Meier2022_surf_rough_all_f09/include_user_mods b/cime_config/testdefs/testmods_dirs/clm/Meier2022_surf_rough_all_f09NonCrop/include_user_mods similarity index 100% rename from cime_config/testdefs/testmods_dirs/clm/Meier2022_surf_rough_all_f09/include_user_mods rename to cime_config/testdefs/testmods_dirs/clm/Meier2022_surf_rough_all_f09NonCrop/include_user_mods diff --git a/cime_config/testdefs/testmods_dirs/clm/Meier2022_surf_rough_all_f09/user_nl_clm b/cime_config/testdefs/testmods_dirs/clm/Meier2022_surf_rough_all_f09NonCrop/user_nl_clm similarity index 100% rename from cime_config/testdefs/testmods_dirs/clm/Meier2022_surf_rough_all_f09/user_nl_clm rename to cime_config/testdefs/testmods_dirs/clm/Meier2022_surf_rough_all_f09NonCrop/user_nl_clm diff --git a/cime_config/testdefs/testmods_dirs/clm/Meier2022_surf_rough_all_hcru/include_user_mods b/cime_config/testdefs/testmods_dirs/clm/Meier2022_surf_rough_all_hcruNonCrop/include_user_mods similarity index 100% rename from cime_config/testdefs/testmods_dirs/clm/Meier2022_surf_rough_all_hcru/include_user_mods rename to cime_config/testdefs/testmods_dirs/clm/Meier2022_surf_rough_all_hcruNonCrop/include_user_mods diff --git a/cime_config/testdefs/testmods_dirs/clm/Meier2022_surf_rough_all_hcru/user_nl_clm b/cime_config/testdefs/testmods_dirs/clm/Meier2022_surf_rough_all_hcruNonCrop/user_nl_clm similarity index 100% rename from cime_config/testdefs/testmods_dirs/clm/Meier2022_surf_rough_all_hcru/user_nl_clm rename to cime_config/testdefs/testmods_dirs/clm/Meier2022_surf_rough_all_hcruNonCrop/user_nl_clm From b9d402a7c0e2b824f373d3e71acbf1e11fc73827 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Wed, 23 Feb 2022 01:22:08 -0700 Subject: [PATCH 025/257] Add tests with Meier surface roughness --- cime_config/testdefs/testlist_clm.xml | 54 +++++++++++++++++++++++++++ 1 file changed, 54 insertions(+) diff --git a/cime_config/testdefs/testlist_clm.xml b/cime_config/testdefs/testlist_clm.xml index c304a4bb27..f1e8eb3f9b 100644 --- a/cime_config/testdefs/testlist_clm.xml +++ b/cime_config/testdefs/testlist_clm.xml @@ -17,6 +17,15 @@ + + + + + + + + + @@ -1238,6 +1247,51 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + From 8789ca2e32ce2d687db74e3a7021d61eb4ac5280 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Wed, 23 Feb 2022 01:23:10 -0700 Subject: [PATCH 026/257] Add a bit to not die if htop is zero and it's crop and beginning of the year --- src/biogeophys/BiogeophysPreFluxCalcsMod.F90 | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/src/biogeophys/BiogeophysPreFluxCalcsMod.F90 b/src/biogeophys/BiogeophysPreFluxCalcsMod.F90 index afb5ff8dfd..6767c113b4 100644 --- a/src/biogeophys/BiogeophysPreFluxCalcsMod.F90 +++ b/src/biogeophys/BiogeophysPreFluxCalcsMod.F90 @@ -125,7 +125,7 @@ subroutine SetZ0mDisp(bounds, num_nolakep, filter_nolakep, & ! Set z0m and displa ! ! !USES: - use clm_time_manager, only : is_first_step, get_nstep + use clm_time_manager, only : is_first_step, get_nstep, is_beg_curr_year use clm_varcon , only : namep use abortutils , only : endrun use BalanceCheckMod , only : GetBalanceCheckSkipSteps @@ -178,6 +178,11 @@ subroutine SetZ0mDisp(bounds, num_nolakep, filter_nolakep, & z0m(p) = 0._r8 displa(p) = 0._r8 cycle + ! If a crop type and it's the start of the year, htop gets reset to + ! zero... + else if ( is_beg_curr_year() .and. pftcon%crop(patch%itype(p)) /= 0.0_r8 )then + z0m(p) = 0._r8 + displa(p) = 0._r8 end if if (patch%itype(p) == noveg) then From 821df3cc4c28d6026c308a02db7302eaed0e661a Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Wed, 23 Feb 2022 11:04:14 -0700 Subject: [PATCH 027/257] Correct new testname, and add two tests to the expected fails --- cime_config/testdefs/ExpectedTestFails.xml | 14 ++++++++++++++ cime_config/testdefs/testlist_clm.xml | 2 +- 2 files changed, 15 insertions(+), 1 deletion(-) diff --git a/cime_config/testdefs/ExpectedTestFails.xml b/cime_config/testdefs/ExpectedTestFails.xml index 04ff4b5dee..353f21c25e 100644 --- a/cime_config/testdefs/ExpectedTestFails.xml +++ b/cime_config/testdefs/ExpectedTestFails.xml @@ -37,6 +37,20 @@ + + + FAIL + Error: Forcing height is below canopy height for patch index + + + + + + FAIL + Half degree resolution issue + + + diff --git a/cime_config/testdefs/testlist_clm.xml b/cime_config/testdefs/testlist_clm.xml index f1e8eb3f9b..d2c6b37b11 100644 --- a/cime_config/testdefs/testlist_clm.xml +++ b/cime_config/testdefs/testlist_clm.xml @@ -1274,7 +1274,7 @@ - + From d3dee3984a2aebdef6d4162b4aba2a5101d37395 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Wed, 23 Feb 2022 13:47:29 -0700 Subject: [PATCH 028/257] Change MeierXXXX namelist to Meier2022 --- bld/namelist_files/namelist_defaults_ctsm.xml | 4 ++-- bld/namelist_files/namelist_definition_ctsm.xml | 4 ++-- .../testmods_dirs/clm/Meier2022_surf_rough/user_nl_clm | 2 +- src/biogeophys/BareGroundFluxesMod.F90 | 2 +- src/biogeophys/BiogeophysPreFluxCalcsMod.F90 | 2 +- src/biogeophys/CanopyFluxesMod.F90 | 2 +- src/biogeophys/FrictionVelocityMod.F90 | 8 ++++---- src/biogeophys/LakeFluxesMod.F90 | 10 +++++----- src/main/pftconMod.F90 | 2 +- 9 files changed, 18 insertions(+), 18 deletions(-) diff --git a/bld/namelist_files/namelist_defaults_ctsm.xml b/bld/namelist_files/namelist_defaults_ctsm.xml index a6776abe33..8fda08cda6 100644 --- a/bld/namelist_files/namelist_defaults_ctsm.xml +++ b/bld/namelist_files/namelist_defaults_ctsm.xml @@ -491,11 +491,11 @@ attributes from the config_cache.xml file (with keys converted to upper-case). ZengWang2007 -.true. +.true. .false. .false. -.true. +.true. .false. .true. diff --git a/bld/namelist_files/namelist_definition_ctsm.xml b/bld/namelist_files/namelist_definition_ctsm.xml index a058b10c0f..dd5c7f6052 100644 --- a/bld/namelist_files/namelist_definition_ctsm.xml +++ b/bld/namelist_files/namelist_definition_ctsm.xml @@ -2723,10 +2723,10 @@ If .true., run with water isotopes + group="clm_inparm" valid_values="ZengWang2007,Meier2022" > Parameterization/parameters to use for surface roughness ZengWang2007: Zeng and Wang 2007 -MeierXXXX: Meier et al. in prep. +Meier2022: Meier et al. in prep. 2022 0._r8) then ! Do snow first because ice could be snow-covered if(use_z0m_snowmelt) then diff --git a/src/biogeophys/LakeFluxesMod.F90 b/src/biogeophys/LakeFluxesMod.F90 index b2b6e62967..3f9ba8e825 100644 --- a/src/biogeophys/LakeFluxesMod.F90 +++ b/src/biogeophys/LakeFluxesMod.F90 @@ -67,7 +67,7 @@ subroutine readParams( ncid ) ! Momentum roughness length for snow (m) call readNcdioScalar(ncid, 'zsno', subname, params_inst%zsno) - if (z0param_method == 'MeierXXXX') then + if (z0param_method == 'Meier2022') then ! Momentum roughness length for ice (m) call readNcdioScalar(ncid, 'zglc', subname, params_inst%zglc) end if @@ -337,7 +337,7 @@ subroutine LakeFluxes(bounds, num_lakec, filter_lakec, num_lakep, filter_lakep, z0hg(p) = max(z0hg(p), minz0lake) else if (snl(c) == 0) then ! frozen lake with ice select case (z0param_method) - case ('MeierXXXX') + case ('Meier2022') z0mg(p) = params_inst%zglc @@ -350,7 +350,7 @@ subroutine LakeFluxes(bounds, num_lakec, filter_lakec, num_lakep, filter_lakep, z0qg(p) = z0hg(p) else ! use roughness over snow as in Biogeophysics1 select case (z0param_method) - case ('MeierXXXX') + case ('Meier2022') if(use_z0m_snowmelt) then if ( snomelt_accum(c) < 1.e-5_r8 )then z0mg(p) = exp(1.4_r8 * -rpi/2.0_r8 -0.31_r8) / 1000._r8 @@ -589,7 +589,7 @@ subroutine LakeFluxes(bounds, num_lakec, filter_lakec, num_lakep, filter_lakep, else if (snl(c) == 0) then ! in case it was above freezing and now below freezing select case (z0param_method) - case ('MeierXXXX') + case ('Meier2022') z0mg(p) = params_inst%zglc z0hg(p) = 70._r8 * 1.5e-5_r8 / ustar(p) * exp( -7.2_r8 * ustar(p)**(0.5_r8) * (abs(tstar))**(0.25_r8)) ! Consistent with BareGroundFluxes @@ -609,7 +609,7 @@ subroutine LakeFluxes(bounds, num_lakec, filter_lakec, num_lakep, filter_lakep, end if select case (z0param_method) - case ('MeierXXXX') + case ('Meier2022') z0hg(p) = 70._r8 * 1.5e-5_r8 / ustar(p) * exp( -7.2_r8 * ustar(p)**(0.5_r8) * (abs(tstar))**(0.25_r8)) ! Consistent with BareGroundFluxes case ('ZengWang2007') diff --git a/src/main/pftconMod.F90 b/src/main/pftconMod.F90 index d3ef07a547..03493797de 100644 --- a/src/main/pftconMod.F90 +++ b/src/main/pftconMod.F90 @@ -652,7 +652,7 @@ subroutine InitRead(this) this%z0v_LAImax = 0._r8 this%z0v_LAIoff = 0._r8 - case ('MeierXXXX') + case ('Meier2022') call ncd_io('z0v_Cr', this%z0v_Cr, 'read', ncid, readvar=readv, posNOTonfile=.true.) if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) From 95fb9005335e8d9eaf2c03b9d10847a4cf74bf8c Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Wed, 23 Feb 2022 13:53:16 -0700 Subject: [PATCH 029/257] Remove commented out line --- src/biogeophys/CanopyFluxesMod.F90 | 1 - 1 file changed, 1 deletion(-) diff --git a/src/biogeophys/CanopyFluxesMod.F90 b/src/biogeophys/CanopyFluxesMod.F90 index eac78660bf..3ca7415657 100644 --- a/src/biogeophys/CanopyFluxesMod.F90 +++ b/src/biogeophys/CanopyFluxesMod.F90 @@ -1578,7 +1578,6 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, ! function that goes to zero as LAI (ELAI + ESAI) go to zero. t_skin_patch(p) = emv(p)*t_veg(p) + (1._r8 - emv(p))*sqrt(sqrt(lw_grnd)) - !t_skin_patch(p) = (ulrad(p) / 5.670367e-8_r8)**0.25_r8 ! Derivative of soil energy flux with respect to soil temperature From b0f2856601290341ee6134c2e694f0d3e83789a2 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Wed, 23 Feb 2022 15:24:43 -0700 Subject: [PATCH 030/257] Remove local time history changes as they are treated seperately in #1374 --- .../namelist_definition_ctsm.xml | 4 +- src/main/histFileMod.F90 | 245 +----------------- 2 files changed, 15 insertions(+), 234 deletions(-) diff --git a/bld/namelist_files/namelist_definition_ctsm.xml b/bld/namelist_files/namelist_definition_ctsm.xml index dd5c7f6052..d46fdd1107 100644 --- a/bld/namelist_files/namelist_definition_ctsm.xml +++ b/bld/namelist_files/namelist_definition_ctsm.xml @@ -768,8 +768,8 @@ SNICAR (SNow, ICe, and Aerosol Radiative model) snow aging data file name If TRUE, write master field list to separate file for documentation purposes - + Per file averaging flag. 'A' (average over history period) 'I' (instantaneous) diff --git a/src/main/histFileMod.F90 b/src/main/histFileMod.F90 index 038aeaf701..5c43e1540d 100644 --- a/src/main/histFileMod.F90 +++ b/src/main/histFileMod.F90 @@ -44,7 +44,7 @@ module histFileMod integer , public, parameter :: max_flds = 2500 ! max number of history fields integer , public, parameter :: max_namlen = 64 ! maximum number of characters for field name integer , public, parameter :: scale_type_strlen = 32 ! maximum number of characters for scale types - integer , private, parameter :: avgflag_strlen = 10 ! maximum number of characters for avgflag + integer , private, parameter :: avgflag_strlen = 3 ! maximum number of characters for avgflag integer , private, parameter :: hist_dim_name_length = 16 ! lenngth of character strings in dimension names ! Possible ways to treat multi-layer snow fields at times when no snow is present in a @@ -1286,8 +1286,6 @@ subroutine hist_update_hbuf_field_1d (t, f, bounds) ! !USES: use subgridAveMod , only : p2g, c2g, l2g, p2l, c2l, p2c use decompMod , only : BOUNDS_LEVEL_PROC - use clm_varcon , only : degpsec, isecspday - use clm_time_manager, only : get_step_size, get_curr_date ! ! !ARGUMENTS: integer, intent(in) :: t ! tape index @@ -1316,17 +1314,6 @@ subroutine hist_update_hbuf_field_1d (t, f, bounds) integer j character(len=*),parameter :: subname = 'hist_update_hbuf_field_1d' integer k_offset ! offset for mapping sliced subarray pointers when outputting variables in PFT/col vector form - integer :: year ! year (0, ...) for nstep - integer :: month ! month (1, ..., 12) for nstep - integer :: day ! day of month (1, ..., 31) for nstep - integer :: secs ! seconds into current date for nstep - integer :: local_secpl ! seconds into current date in local time - integer :: dtime ! timestep size [seconds] - integer :: tod ! Desired local solar time of output in seconds - integer, allocatable :: grid_index(:) ! Grid cell index for longitude - integer, allocatable :: tods(:) - character(len=1) :: avgflag_trim ! first character of avgflag - !----------------------------------------------------------------------- SHR_ASSERT_FL(bounds%level == BOUNDS_LEVEL_PROC, sourcefile, __LINE__) @@ -1346,9 +1333,6 @@ subroutine hist_update_hbuf_field_1d (t, f, bounds) hpindex = tape(t)%hlist(f)%field%hpindex field => clmptr_rs(hpindex)%ptr - dtime = get_step_size() - call get_curr_date (year, month, day, secs) - ! set variables to check weights when allocate all pfts map2gcell = .false. @@ -1434,8 +1418,7 @@ subroutine hist_update_hbuf_field_1d (t, f, bounds) if (map2gcell) then ! Map to gridcell ! note that in this case beg1d = begg and end1d=endg - avgflag_trim = avgflag(1:1) - select case (avgflag_trim) + select case (avgflag) case ('I') ! Instantaneous do k = beg1d_out, end1d_out if (field_gcell(k) /= spval) then @@ -1445,7 +1428,7 @@ subroutine hist_update_hbuf_field_1d (t, f, bounds) end if nacs(k,1) = 1 end do - case ('A', 'S') ! Time average / sum + case ('A', 'SUM') ! Time average / sum do k = beg1d_out, end1d_out if (field_gcell(k) /= spval) then if (nacs(k,1) == 0) hbuf(k,1) = 0._r8 @@ -1475,38 +1458,6 @@ subroutine hist_update_hbuf_field_1d (t, f, bounds) endif nacs(k,1) = 1 end do - case ('L') ! Local solar time - read(avgflag(2:6), *) tod - do k = beg1d_out, end1d_out - if (field_gcell(k) /= spval) then - - local_secpl = secs + grc%londeg(k)/degpsec - local_secpl = mod(local_secpl,isecspday) - - if (local_secpl >= tod - dtime .and. local_secpl < tod) then - if (nacs(k,1) == 0) hbuf(k,1) = 0._r8 - hbuf(k,1) = hbuf(k,1) + field_gcell(k)*real(dtime-tod+local_secpl) - nacs(k,1) = nacs(k,1) + dtime-tod+local_secpl - else if (local_secpl >= tod .and. local_secpl < tod + dtime) then - if (nacs(k,1) == 0) hbuf(k,1) = 0._r8 - hbuf(k,1) = hbuf(k,1) + field_gcell(k)*real(dtime+tod-local_secpl) - nacs(k,1) = nacs(k,1) + dtime+tod-local_secpl - end if - - if (tod < dtime .and. local_secpl > isecspday-dtime) then - local_secpl = local_secpl - isecspday - if (local_secpl >= tod - dtime .and. local_secpl < tod) then - if (nacs(k,1) == 0) hbuf(k,1) = 0._r8 - hbuf(k,1) = hbuf(k,1) + field_gcell(k)*real(dtime-tod+local_secpl) - nacs(k,1) = nacs(k,1) + dtime-tod+local_secpl - end if - end if - - else - if (nacs(k,1) == 0) hbuf(k,1) = spval - end if - end do - case default write(iulog,*) trim(subname),' ERROR: invalid time averaging flag ', avgflag call endrun(msg=errMsg(sourcefile, __LINE__)) @@ -1515,29 +1466,22 @@ subroutine hist_update_hbuf_field_1d (t, f, bounds) else ! Do not map to gridcell - allocate( grid_index(beg1d:end1d) ) - ! For data defined on the pft, col or landunit, we need to check if a point is active ! to determine whether that point should be assigned spval if (type1d == namep) then check_active = .true. active => patch%active - grid_index = patch%gridcell else if (type1d == namec) then check_active = .true. active => col%active - grid_index = col%gridcell else if (type1d == namel) then check_active = .true. active =>lun%active - grid_index = lun%gridcell else check_active = .false. end if - avgflag_trim = avgflag(1:1) - - select case (avgflag_trim) + select case (avgflag) case ('I') ! Instantaneous do k = beg1d,end1d valid = .true. @@ -1555,7 +1499,7 @@ subroutine hist_update_hbuf_field_1d (t, f, bounds) end if nacs(k,1) = 1 end do - case ('A', 'S') ! Time average / sum + case ('A', 'SUM') ! Time average / sum ! create mappings for array slice pointers (which go from 1 to size(field) rather than beg1d to end1d) if ( end1d .eq. ubound(field,1) ) then k_offset = 0 @@ -1615,54 +1559,6 @@ subroutine hist_update_hbuf_field_1d (t, f, bounds) end if nacs(k,1) = 1 end do - case ('L') ! Local solar time - - read(avgflag(2:6), *) tod - - if ( end1d .eq. ubound(field,1) ) then - k_offset = 0 - else - k_offset = 1 - beg1d - endif - do k = beg1d, end1d - valid = .true. - if (check_active) then - if (.not. active(k)) then - valid = .false. - else - local_secpl = secs + grc%londeg(grid_index(k))/degpsec - end if - else - local_secpl = secs + grc%londeg(k)/degpsec - - end if - local_secpl = mod(local_secpl,isecspday) - - if (valid) then - if (local_secpl >= tod - dtime .and. local_secpl < tod .and. field(k+k_offset) /= spval) then - if (nacs(k,1) == 0) hbuf(k,1) = 0._r8 - hbuf(k,1) = hbuf(k,1) + field(k+k_offset)*real(dtime-tod+local_secpl) - nacs(k,1) = nacs(k,1) + dtime-tod+local_secpl - else if (local_secpl >= tod .and. local_secpl < tod + dtime .and. field(k+k_offset) /= spval) then - if (nacs(k,1) == 0) hbuf(k,1) = 0._r8 - hbuf(k,1) = hbuf(k,1) + field(k+k_offset)*real(dtime+tod-local_secpl) - nacs(k,1) = nacs(k,1) + dtime+tod-local_secpl - end if - - if (tod < dtime .and. local_secpl > isecspday-dtime .and. field(k+k_offset) /= spval) then - local_secpl = local_secpl - isecspday - if (local_secpl >= tod - dtime .and. local_secpl < tod) then - if (nacs(k,1) == 0) hbuf(k,1) = 0._r8 - hbuf(k,1) = hbuf(k,1) + field(k+k_offset)*real(dtime-tod+local_secpl) - nacs(k,1) = nacs(k,1) + dtime-tod+local_secpl - end if - end if - - else - if (nacs(k,1) == 0) hbuf(k,1) = spval - end if - end do - case default write(iulog,*) trim(subname),' ERROR: invalid time averaging flag ', avgflag call endrun(msg=errMsg(sourcefile, __LINE__)) @@ -1685,8 +1581,6 @@ subroutine hist_update_hbuf_field_2d (t, f, bounds, num2d) use subgridAveMod , only : p2g, c2g, l2g, p2l, c2l, p2c use decompMod , only : BOUNDS_LEVEL_PROC use clm_varctl , only : iulog - use clm_varcon , only : degpsec, isecspday - use clm_time_manager, only : get_step_size, get_curr_date ! ! !ARGUMENTS: integer, intent(in) :: t ! tape index @@ -1718,17 +1612,6 @@ subroutine hist_update_hbuf_field_2d (t, f, bounds, num2d) !(this refers to a point being active, NOT a history field being active) real(r8), allocatable :: field_gcell(:,:) ! gridcell level field (used if mapping to gridcell is done) character(len=*),parameter :: subname = 'hist_update_hbuf_field_2d' - integer :: year ! year (0, ...) for nstep - integer :: month ! month (1, ..., 12) for nstep - integer :: day ! day of month (1, ..., 31) for nstep - integer :: secs ! seconds into current date for nstep - integer :: local_secpl ! seconds into current date in local time - integer :: dtime ! timestep size [seconds] - integer :: tod ! Desired local solar time of output in seconds - integer, allocatable :: grid_index(:) ! Grid cell index for longitude - integer, allocatable :: tods(:) - character(len=1) :: avgflag_trim ! first character of avgflag - !----------------------------------------------------------------------- SHR_ASSERT_FL(bounds%level == BOUNDS_LEVEL_PROC, sourcefile, __LINE__) @@ -1748,8 +1631,6 @@ subroutine hist_update_hbuf_field_2d (t, f, bounds, num2d) no_snow_behavior = tape(t)%hlist(f)%field%no_snow_behavior hpindex = tape(t)%hlist(f)%field%hpindex - dtime = get_step_size() - call get_curr_date (year, month, day, secs) if (no_snow_behavior /= no_snow_unset) then ! For multi-layer snow fields, build a special output variable that handles @@ -1857,9 +1738,8 @@ subroutine hist_update_hbuf_field_2d (t, f, bounds, num2d) if (map2gcell) then ! Map to gridcell - avgflag_trim = avgflag(1:1) ! note that in this case beg1d = begg and end1d=endg - select case (avgflag_trim) + select case (avgflag) case ('I') ! Instantaneous do j = 1,num2d do k = beg1d_out, end1d_out @@ -1871,7 +1751,7 @@ subroutine hist_update_hbuf_field_2d (t, f, bounds, num2d) nacs(k,j) = 1 end do end do - case ('A', 'S') ! Time average / sum + case ('A', 'SUM') ! Time average / sum do j = 1,num2d do k = beg1d_out, end1d_out if (field_gcell(k,j) /= spval) then @@ -1907,42 +1787,6 @@ subroutine hist_update_hbuf_field_2d (t, f, bounds, num2d) nacs(k,j) = 1 end do end do - case ('L') ! Local solar time - read(avgflag(2:6), *) tod - do j = 1,num2d - do k = beg1d_out, end1d_out - if (field_gcell(k,j) /= spval) then - - local_secpl = secs + grc%londeg(k)/degpsec - local_secpl = mod(local_secpl,isecspday) - - if (local_secpl >= tod - dtime .and. local_secpl < tod) then - if (nacs(k,j) == 0) hbuf(k,j) = 0._r8 - hbuf(k,j) = hbuf(k,j) + field_gcell(k,j)*real(dtime-tod+local_secpl) - nacs(k,j) = nacs(k,j) + dtime-tod+local_secpl - else if (local_secpl >= tod .and. local_secpl < tod + dtime) then - if (nacs(k,j) == 0) hbuf(k,j) = 0._r8 - hbuf(k,j) = hbuf(k,j) + field_gcell(k,j)*real(dtime+tod-local_secpl) - nacs(k,j) = nacs(k,j) + dtime+tod-local_secpl - end if - - if (tod < dtime .and. local_secpl > isecspday-dtime) then - local_secpl = local_secpl - isecspday - if (local_secpl >= tod - dtime .and. local_secpl < tod) then - if (nacs(k,j) == 0) hbuf(k,j) = 0._r8 - hbuf(k,j) = hbuf(k,j) + field_gcell(k,j)*real(dtime-tod+local_secpl) - nacs(k,j) = nacs(k,j) + dtime-tod+local_secpl - end if - end if - - else - if (nacs(k,j) == 0) hbuf(k,j) = spval - - end if - end do - end do - - case default write(iulog,*) trim(subname),' ERROR: invalid time averaging flag ', avgflag call endrun(msg=errMsg(sourcefile, __LINE__)) @@ -1956,18 +1800,12 @@ subroutine hist_update_hbuf_field_2d (t, f, bounds, num2d) if (type1d == namep) then check_active = .true. active => patch%active - allocate(grid_index(bounds%begg:bounds%endg) ) - grid_index = patch%gridcell else if (type1d == namec) then check_active = .true. active => col%active - allocate(grid_index(bounds%begg:bounds%endg) ) - grid_index = col%gridcell else if (type1d == namel) then check_active = .true. active =>lun%active - allocate(grid_index(bounds%begg:bounds%endg) ) - grid_index = lun%gridcell else check_active = .false. end if @@ -1975,8 +1813,8 @@ subroutine hist_update_hbuf_field_2d (t, f, bounds, num2d) ! Note that since field points to an array section the ! bounds are field(1:end1d-beg1d+1, num2d) - therefore ! need to do the shifting below - avgflag_trim = avgflag(1:1) - select case (avgflag_trim) + + select case (avgflag) case ('I') ! Instantaneous do j = 1,num2d do k = beg1d,end1d @@ -1996,7 +1834,7 @@ subroutine hist_update_hbuf_field_2d (t, f, bounds, num2d) nacs(k,j) = 1 end do end do - case ('A', 'S') ! Time average / sum + case ('A', 'SUM') ! Time average / sum do j = 1,num2d do k = beg1d,end1d valid = .true. @@ -2056,49 +1894,6 @@ subroutine hist_update_hbuf_field_2d (t, f, bounds, num2d) nacs(k,j) = 1 end do end do - case ('L') ! Local solar time - read(avgflag(2:6), *) tod - do j = 1,num2d - - do k = beg1d, end1d - valid = .true. - if (check_active) then - if (.not. active(k)) then - valid = .false. - else - local_secpl = secs + grc%londeg(grid_index(k))/degpsec - end if - else - local_secpl = secs + grc%londeg(k)/degpsec - end if - local_secpl = mod(local_secpl,isecspday) - - if (valid) then - if (local_secpl >= tod - dtime .and. local_secpl < tod .and. field(k-beg1d+1,j) /= spval) then - if (nacs(k,j) == 0) hbuf(k,j) = 0._r8 - hbuf(k,j) = hbuf(k,j) + field(k-beg1d+1,j)*real(dtime-tod+local_secpl) - nacs(k,j) = nacs(k,j) + dtime-tod+local_secpl - else if (local_secpl >= tod .and. local_secpl < tod + dtime .and. field(k-beg1d+1,j) /= spval) then - if (nacs(k,j) == 0) hbuf(k,j) = 0._r8 - hbuf(k,j) = hbuf(k,j) + field(k-beg1d+1,j)*real(dtime+tod-local_secpl) - nacs(k,j) = nacs(k,j) + dtime+tod-local_secpl - end if - - if (tod < dtime .and. local_secpl > isecspday-dtime .and. field(k-beg1d+1,j) /= spval) then - local_secpl = local_secpl - isecspday - if (local_secpl >= tod - dtime .and. local_secpl < tod) then - if (nacs(k,j) == 0) hbuf(k,j) = 0._r8 - hbuf(k,j) = hbuf(k,j) + field(k-beg1d+1,j)*real(dtime-tod+local_secpl) - nacs(k,j) = nacs(k,j) + dtime-tod+local_secpl - end if - end if - - else - if (nacs(k,j) == 0) hbuf(k,j) = spval - end if - end do - end do - case default write(iulog,*) trim(subname),' ERROR: invalid time averaging flag ', avgflag call endrun(msg=errMsg(sourcefile, __LINE__)) @@ -2243,7 +2038,7 @@ subroutine hfields_normalize (t) nacs => tape(t)%hlist(f)%nacs hbuf => tape(t)%hlist(f)%hbuf - if (avgflag == 'A' .or. avgflag(1:1) == 'L') then + if (avgflag == 'A') then aflag = .true. else aflag = .false. @@ -2253,8 +2048,6 @@ subroutine hfields_normalize (t) do k = beg1d, end1d if (aflag .and. nacs(k,j) /= 0) then hbuf(k,j) = hbuf(k,j) / float(nacs(k,j)) - elseif (avgflag(1:1) == 'L' .and. nacs(k,j) == 0) then - hbuf(k,j) = spval end if end do end do @@ -3372,7 +3165,7 @@ subroutine hfields_write(t, mode) if (mode == 'define') then - select case (avgflag(1:1)) + select case (avgflag) case ('A') avgstr = 'mean' case ('I') @@ -3381,10 +3174,8 @@ subroutine hfields_write(t, mode) avgstr = 'maximum' case ('M') avgstr = 'minimum' - case ('S') + case ('SUM') avgstr = 'sum' - case ('L') - avgstr = 'local solar time' case default write(iulog,*) trim(subname),' ERROR: unknown time averaging flag (avgflag)=',avgflag call endrun(msg=errMsg(sourcefile, __LINE__)) @@ -5737,7 +5528,6 @@ function avgflag_valid(avgflag, blank_valid) result(valid) ! Returns true if the given avgflag is a valid option, false if not ! ! !USES: - use clm_varcon , only : isecspday ! ! !ARGUMENTS: logical :: valid ! function result @@ -5747,7 +5537,6 @@ function avgflag_valid(avgflag, blank_valid) result(valid) ! !LOCAL VARIABLES: character(len=*), parameter :: subname = 'avgflag_valid' - integer :: tod ! Desired local solar time of output in seconds !----------------------------------------------------------------------- ! This initial check is mainly here to catch the possibility that someone has added a @@ -5761,14 +5550,6 @@ function avgflag_valid(avgflag, blank_valid) result(valid) avgflag == 'X' .or. avgflag == 'M' .or. & avgflag == 'SUM') then valid = .true. - else if (avgflag(1:1) == 'L') then - read(avgflag(2:6), *) tod - if (tod >= 0 .and. tod <= isecspday) then - valid = .true. - else - valid = .false. - end if - else valid = .false. end if From c7ade8d90f54d2c91f9a8b8653e4128416cd5e53 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Wed, 23 Feb 2022 15:47:33 -0700 Subject: [PATCH 031/257] Remove soil columns on a seperate soil column as handled in #1249 --- bld/namelist_files/namelist_defaults_ctsm.xml | 1 - .../namelist_definition_ctsm.xml | 5 -- src/main/clm_varctl.F90 | 6 -- src/main/controlMod.F90 | 4 - src/main/initGridCellsMod.F90 | 76 +------------------ src/main/subgridMod.F90 | 17 ++--- 6 files changed, 9 insertions(+), 100 deletions(-) diff --git a/bld/namelist_files/namelist_defaults_ctsm.xml b/bld/namelist_files/namelist_defaults_ctsm.xml index 8fda08cda6..438d0ec5fe 100644 --- a/bld/namelist_files/namelist_defaults_ctsm.xml +++ b/bld/namelist_files/namelist_defaults_ctsm.xml @@ -181,7 +181,6 @@ attributes from the config_cache.xml file (with keys converted to upper-case). .false. .true. .false. -.false. 1 diff --git a/bld/namelist_files/namelist_definition_ctsm.xml b/bld/namelist_files/namelist_definition_ctsm.xml index d46fdd1107..004a0d20c8 100644 --- a/bld/namelist_files/namelist_definition_ctsm.xml +++ b/bld/namelist_files/namelist_definition_ctsm.xml @@ -144,11 +144,6 @@ User-defined number of soil layers required to be set in the namelist when the u Default: iundef - -If TRUE, each pft exists on a separate soil column. - - If TRUE, use variable soil depth. diff --git a/src/main/clm_varctl.F90 b/src/main/clm_varctl.F90 index 4b3c5c9a65..9fb28be7e1 100644 --- a/src/main/clm_varctl.F90 +++ b/src/main/clm_varctl.F90 @@ -293,12 +293,6 @@ module clm_varctl logical, public :: use_biomass_heat_storage = .false. ! true => include biomass heat storage in canopy energy budget - !---------------------------------------------------------- - ! each pft has individual soil column switch - !---------------------------------------------------------- - - logical, public :: use_individual_pft_soil_column = .false. ! true => each pft exists on its own soil column - !---------------------------------------------------------- ! bedrock / soil depth switch !---------------------------------------------------------- diff --git a/src/main/controlMod.F90 b/src/main/controlMod.F90 index ae1324ed7a..20644e7ddf 100644 --- a/src/main/controlMod.F90 +++ b/src/main/controlMod.F90 @@ -247,8 +247,6 @@ subroutine control_init(dtime) namelist /clm_inparm/ use_biomass_heat_storage - namelist /clm_inparm/ use_individual_pft_soil_column - namelist /clm_inparm/ use_hydrstress namelist /clm_inparm/ use_dynroot @@ -749,8 +747,6 @@ subroutine control_spmd() call mpi_bcast (use_biomass_heat_storage, 1, MPI_LOGICAL, 0, mpicom, ier) - call mpi_bcast (use_individual_pft_soil_column, 1, MPI_LOGICAL, 0, mpicom, ier) - call mpi_bcast (use_hydrstress, 1, MPI_LOGICAL, 0, mpicom, ier) call mpi_bcast (use_dynroot, 1, MPI_LOGICAL, 0, mpicom, ier) diff --git a/src/main/initGridCellsMod.F90 b/src/main/initGridCellsMod.F90 index 1456e10a36..cdaac2f6e5 100644 --- a/src/main/initGridCellsMod.F90 +++ b/src/main/initGridCellsMod.F90 @@ -60,7 +60,7 @@ subroutine initGridcells(glc_behavior) use subgridWeightsMod , only : compute_higher_order_weights use landunit_varcon , only : istsoil, istwet, istdlak, istice_mec use landunit_varcon , only : isturb_tbd, isturb_hd, isturb_md, istcrop - use clm_varctl , only : use_fates,use_individual_pft_soil_column + use clm_varctl , only : use_fates use shr_const_mod , only : SHR_CONST_PI ! ! !ARGUMENTS: @@ -133,13 +133,8 @@ subroutine initGridcells(glc_behavior) ! Determine naturally vegetated landunit do gdc = bounds_clump%begg,bounds_clump%endg - if(use_individual_pft_soil_column) then - call set_landunit_veg_noncompete( & - ltype=istsoil, gi=gdc, li=li, ci=ci, pi=pi) - else - call set_landunit_veg_compete( & - ltype=istsoil, gi=gdc, li=li, ci=ci, pi=pi) - end if + call set_landunit_veg_compete( & + ltype=istsoil, gi=gdc, li=li, ci=ci, pi=pi) end do ! Determine crop landunit @@ -249,7 +244,7 @@ subroutine set_landunit_veg_compete (ltype, gi, li, ci, pi) ! Set decomposition properties call subgrid_get_info_natveg(gi, & - npatches=npatches, ncols=ncols, nlunits=nlunits, sesc=.FALSE.) + npatches=npatches, ncols=ncols, nlunits=nlunits) wtlunit2gcell = wt_lunit(gi, ltype) nlunits_added = 0 @@ -279,69 +274,6 @@ subroutine set_landunit_veg_compete (ltype, gi, li, ci, pi) end subroutine set_landunit_veg_compete - subroutine set_landunit_veg_noncompete (ltype, gi, li, ci, pi) - - - ! !DESCRIPTION: - ! Initialize vegetated landunit without competition - ! - ! !USES - use clm_instur, only : wt_lunit, wt_nat_patch - use subgridMod, only : subgrid_get_info_natveg, natveg_patch_exists - use clm_varpar, only : natpft_lb, natpft_ub - ! - ! !ARGUMENTS: - integer , intent(in) :: ltype ! landunit type - integer , intent(in) :: gi ! gridcell index - integer , intent(inout) :: li ! landunit index - integer , intent(inout) :: ci ! column index - integer , intent(inout) :: pi ! patch index - ! - ! !LOCAL VARIABLES: - integer :: m ! index - integer :: npatches ! number of patches in landunit - integer :: ncols - integer :: nlunits - integer :: npatches_added ! number of patches actually added - integer :: ncols_added ! number of columns actually added - integer :: nlunits_added ! number of landunits actually added - real(r8) :: wtlunit2gcell ! landunit weight in gridcell - !------------------------------------------------------------------------ - - ! Set decomposition properties - - call subgrid_get_info_natveg(gi, & - npatches=npatches, ncols=ncols, nlunits=nlunits, sesc=.TRUE.) - wtlunit2gcell = wt_lunit(gi, ltype) - - nlunits_added = 0 - ncols_added = 0 - npatches_added = 0 - - if (nlunits > 0) then - call add_landunit(li=li, gi=gi, ltype=ltype, wtgcell=wtlunit2gcell) - nlunits_added = nlunits_added + 1 - - - do m = natpft_lb,natpft_ub - if (natveg_patch_exists(gi, m)) then - ! Assume one column for each vegetation patch - call add_column(ci=ci, li=li, ctype=1, wtlunit=wt_nat_patch(gi,m)) - ncols_added = ncols_added + 1 - - call add_patch(pi=pi, ci=ci, ptype=m, wtcol=1.0_r8) - npatches_added = npatches_added + 1 - end if - end do - end if - - SHR_ASSERT_FL(nlunits_added == nlunits, sourcefile, __LINE__) - SHR_ASSERT_FL(ncols_added == ncols, sourcefile, __LINE__) - SHR_ASSERT_FL(npatches_added == npatches, sourcefile, __LINE__) - - end subroutine set_landunit_veg_noncompete - - !------------------------------------------------------------------------ subroutine set_landunit_wet_lake (ltype, gi, li, ci, pi) ! diff --git a/src/main/subgridMod.F90 b/src/main/subgridMod.F90 index 98cbc40192..7247fab15a 100644 --- a/src/main/subgridMod.F90 +++ b/src/main/subgridMod.F90 @@ -13,7 +13,7 @@ module subgridMod use shr_kind_mod , only : r8 => shr_kind_r8 use spmdMod , only : masterproc use abortutils , only : endrun - use clm_varctl , only : iulog,use_individual_pft_soil_column + use clm_varctl , only : iulog use clm_instur , only : wt_lunit, wt_nat_patch, urban_valid, wt_cft use landunit_varcon, only : istcrop, istdlak, istwet, isturb_tbd, isturb_hd, isturb_md use glcBehaviorMod , only : glc_behavior_type @@ -81,7 +81,7 @@ subroutine subgrid_get_gcellinfo (gi, glc_behavior, & nlunits = 0 ncohorts = 0 - call subgrid_get_info_natveg(gi, npatches_temp, ncols_temp, nlunits_temp, use_individual_pft_soil_column) + call subgrid_get_info_natveg(gi, npatches_temp, ncols_temp, nlunits_temp) call accumulate_counters() call subgrid_get_info_urban_tbd(gi, npatches_temp, ncols_temp, nlunits_temp) @@ -123,7 +123,7 @@ end subroutine accumulate_counters end subroutine subgrid_get_gcellinfo !----------------------------------------------------------------------- - subroutine subgrid_get_info_natveg(gi, npatches, ncols, nlunits, sesc) + subroutine subgrid_get_info_natveg(gi, npatches, ncols, nlunits) ! ! !DESCRIPTION: ! Obtain properties for natural vegetated landunit in this grid cell @@ -133,7 +133,6 @@ subroutine subgrid_get_info_natveg(gi, npatches, ncols, nlunits, sesc) ! ! !ARGUMENTS: integer, intent(in) :: gi ! grid cell index - logical, intent(in) :: sesc ! switch for separated soil columns of natural vegetation integer, intent(out) :: npatches ! number of nat veg patches in this grid cell integer, intent(out) :: ncols ! number of nat veg columns in this grid cell @@ -154,14 +153,8 @@ subroutine subgrid_get_info_natveg(gi, npatches, ncols, nlunits, sesc) end do if (npatches > 0) then - if(sesc) then - ! Assume one soil column for each patch - ncols = npatches - else - ! Assume that the vegetated landunit has one column - ncols = 1 - end if - + ! Assume that the vegetated landunit has one column + ncols = 1 nlunits = 1 else ! As noted in natveg_patch_exists, we expect a naturally vegetated landunit in From 7916475dc4cfc2b97af5f3e192193b7fe3253eb7 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Wed, 23 Feb 2022 16:09:36 -0700 Subject: [PATCH 032/257] Add more compilers for the surf roughness changes --- cime_config/testdefs/testlist_clm.xml | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/cime_config/testdefs/testlist_clm.xml b/cime_config/testdefs/testlist_clm.xml index 5ded956618..8486c7fa04 100644 --- a/cime_config/testdefs/testlist_clm.xml +++ b/cime_config/testdefs/testlist_clm.xml @@ -1296,6 +1296,10 @@ + + + + From b531f9282275383b752c012c44d621148f99393a Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Thu, 24 Feb 2022 15:15:45 -0700 Subject: [PATCH 033/257] Changes to get the updated code to compile on cheyenne_gnu --- src/biogeophys/BiogeophysPreFluxCalcsMod.F90 | 6 +-- src/biogeophys/CanopyStateType.F90 | 51 +++++++++----------- src/biogeophys/FrictionVelocityMod.F90 | 2 +- 3 files changed, 28 insertions(+), 31 deletions(-) diff --git a/src/biogeophys/BiogeophysPreFluxCalcsMod.F90 b/src/biogeophys/BiogeophysPreFluxCalcsMod.F90 index 2667ddabe4..f033fab5ff 100644 --- a/src/biogeophys/BiogeophysPreFluxCalcsMod.F90 +++ b/src/biogeophys/BiogeophysPreFluxCalcsMod.F90 @@ -10,6 +10,7 @@ module BiogeophysPreFluxCalcsMod #include "shr_assert.h" use shr_kind_mod , only : r8 => shr_kind_r8 use shr_log_mod , only : errMsg => shr_log_errMsg + use abortutils , only : endrun use decompMod , only : bounds_type use PatchType , only : patch use ColumnType , only : col @@ -126,8 +127,7 @@ subroutine SetZ0mDisp(bounds, num_nolakep, filter_nolakep, & ! ! !USES: use clm_time_manager, only : is_first_step, get_nstep, is_beg_curr_year - use clm_varcon , only : namep - use abortutils , only : endrun + use decompMod , only : subgrid_level_patch use BalanceCheckMod , only : GetBalanceCheckSkipSteps ! !ARGUMENTS: type(bounds_type) , intent(in) :: bounds @@ -199,7 +199,7 @@ subroutine SetZ0mDisp(bounds, num_nolakep, filter_nolakep, & if ( htop(p) <= 1.e-10_r8 )then write(iulog,*) ' nstep = ', get_nstep(), ' htop = ', htop(p) - call endrun(decomp_index=p, clmlevel=namep, msg=errMsg(sourcefile, __LINE__)) + call endrun(subgrid_index=p, subgrid_level=subgrid_level_patch, msg=errMsg(sourcefile, __LINE__)) else z0m(p) = htop(p) * (1._r8 - displa(p) / htop(p)) * exp(-0.4_r8 * U_ustar + & log(pftcon%z0v_cw(patch%itype(p))) - 1._r8 + pftcon%z0v_cw(patch%itype(p))**(-1._r8)) diff --git a/src/biogeophys/CanopyStateType.F90 b/src/biogeophys/CanopyStateType.F90 index a126401e48..e6963d4b83 100644 --- a/src/biogeophys/CanopyStateType.F90 +++ b/src/biogeophys/CanopyStateType.F90 @@ -198,35 +198,32 @@ subroutine InitHistory(this, bounds) avgflag='A', long_name='Aboveground leaf biomass', & ptr_patch=this%leaf_biomass_patch, default='inactive') - this%fsun_patch(begp:endp) = spval - call hist_addfld1d (fname='FSUN', units='proportion', & - avgflag='A', long_name='sunlit fraction of canopy', & - ptr_patch=this%fsun_patch, default='inactive') - - this%hbot_patch(begp:endp) = spval - call hist_addfld1d (fname='HBOT', units='m', & - avgflag='A', long_name='canopy bottom', & - ptr_patch=this%hbot_patch, default='inactive') - - this%displa_patch(begp:endp) = spval - call hist_addfld1d (fname='DISPLA', units='m', & - avgflag='A', long_name='displacement height', & - ptr_patch=this%displa_patch, default='inactive') - - if(use_fates_sp)then - this%htop_hist_patch(begp:endp) = spval - call hist_addfld1d (fname='HTOP', units='m', & - avgflag='A', long_name='HTOP weights for SP mode', & - ptr_patch=this%htop_hist_patch) - else - this%htop_patch(begp:endp) = spval - call hist_addfld1d (fname='HTOP', units='m', & - avgflag='A', long_name='canopy top', & - ptr_patch=this%htop_patch) - endif + this%fsun_patch(begp:endp) = spval + call hist_addfld1d (fname='FSUN', units='proportion', & + avgflag='A', long_name='sunlit fraction of canopy', & + ptr_patch=this%fsun_patch, default='inactive') + + this%hbot_patch(begp:endp) = spval + call hist_addfld1d (fname='HBOT', units='m', & + avgflag='A', long_name='canopy bottom', & + ptr_patch=this%hbot_patch, default='inactive') + this%displa_patch(begp:endp) = spval + call hist_addfld1d (fname='DISPLA', units='m', & + avgflag='A', long_name='displacement height', & + ptr_patch=this%displa_patch, default='inactive') - endif !fates or CN + if(use_fates_sp)then + this%htop_hist_patch(begp:endp) = spval + call hist_addfld1d (fname='HTOP', units='m', & + avgflag='A', long_name='HTOP weights for SP mode', & + ptr_patch=this%htop_hist_patch) + else + this%htop_patch(begp:endp) = spval + call hist_addfld1d (fname='HTOP', units='m', & + avgflag='A', long_name='canopy top', & + ptr_patch=this%htop_patch) + endif if(use_fates_sp)then this%tlai_hist_patch(begp:endp) = spval diff --git a/src/biogeophys/FrictionVelocityMod.F90 b/src/biogeophys/FrictionVelocityMod.F90 index 1f7b1b3ac4..b4d7dfed5d 100644 --- a/src/biogeophys/FrictionVelocityMod.F90 +++ b/src/biogeophys/FrictionVelocityMod.F90 @@ -658,7 +658,7 @@ subroutine SetRoughnessLengthsAndForcHeightsNonLake(this, bounds, & end if - else if (lun%itype(l) == istice_mec) then + else if (lun%itype(l) == istice) then z0mg(c) = this%zglc From 6e3117132657f2bf63960b22670d96f381b463ef Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Fri, 25 Feb 2022 14:14:45 -0700 Subject: [PATCH 034/257] Changes needed to work with nag compiler on izumi, negative sign needed to be moved --- src/biogeophys/FrictionVelocityMod.F90 | 7 ++++--- src/biogeophys/LakeFluxesMod.F90 | 4 ++-- 2 files changed, 6 insertions(+), 5 deletions(-) diff --git a/src/biogeophys/FrictionVelocityMod.F90 b/src/biogeophys/FrictionVelocityMod.F90 index b4d7dfed5d..4f72215381 100644 --- a/src/biogeophys/FrictionVelocityMod.F90 +++ b/src/biogeophys/FrictionVelocityMod.F90 @@ -632,7 +632,7 @@ subroutine SetRoughnessLengthsAndForcHeightsNonLake(this, bounds, & case ('ZengWang2007') if (frac_sno(c) > 0._r8) then if(use_z0m_snowmelt) then - z0mg(c) = exp(1.4_r8 * (atan((log10(snomelt_accum(c))+0.23_r8)/0.08_r8))-0.31_r8) / 1000._r8 + z0mg(c) = exp(1.4_r8 * (atan((log10(snomelt_accum(c))+0.23_r8)/0.08_r8))-0.31_r8) / 1000._r8 else z0mg(c) = this%zsno end if @@ -649,9 +649,10 @@ subroutine SetRoughnessLengthsAndForcHeightsNonLake(this, bounds, & if (frac_sno(c) > 0._r8) then ! Do snow first because ice could be snow-covered if(use_z0m_snowmelt) then if ( snomelt_accum(c) < 1.e-5_r8 )then - z0mg(c) = exp(1.4_r8 * -rpi/2.0_r8 -0.31_r8) / 1000._r8 + z0mg(c) = exp(-1.4_r8 * rpi/2.0_r8 - 0.31_r8) / 1000.0_r8 else - z0mg(c) = exp(1.4_r8 * (atan((log10(snomelt_accum(c))+0.23_r8)/0.08_r8))-0.31_r8) / 1000._r8 + z0mg(c) = exp(1.4_r8 * (atan((log10(snomelt_accum(c))+0.23_r8)/0.08_r8))-0.31_r8) & + / 1000.0_r8 end if else z0mg(c) = this%zsno diff --git a/src/biogeophys/LakeFluxesMod.F90 b/src/biogeophys/LakeFluxesMod.F90 index e99eadc5c5..b51e5d4035 100644 --- a/src/biogeophys/LakeFluxesMod.F90 +++ b/src/biogeophys/LakeFluxesMod.F90 @@ -353,7 +353,7 @@ subroutine LakeFluxes(bounds, num_lakec, filter_lakec, num_lakep, filter_lakep, case ('Meier2022') if(use_z0m_snowmelt) then if ( snomelt_accum(c) < 1.e-5_r8 )then - z0mg(p) = exp(1.4_r8 * -rpi/2.0_r8 -0.31_r8) / 1000._r8 + z0mg(p) = exp(-1.4_r8 * rpi/2.0_r8 -0.31_r8) / 1000._r8 else z0mg(p) = exp(1.4_r8 * (atan((log10(snomelt_accum(c))+0.23_r8)/0.08_r8))-0.31_r8) / 1000._r8 end if @@ -602,7 +602,7 @@ subroutine LakeFluxes(bounds, num_lakec, filter_lakec, num_lakep, filter_lakep, else ! Snow layers if(use_z0m_snowmelt) then if ( snomelt_accum(c) < 1.e-5_r8 )then - z0mg(p) = exp(1.4_r8 * -rpi/2.0_r8 -0.31_r8) / 1000._r8 + z0mg(p) = exp(-1.4_r8 * rpi/2.0_r8 -0.31_r8) / 1000._r8 else z0mg(p) = exp(1.4_r8 * (atan((log10(snomelt_accum(c))+0.23_r8)/0.08_r8))-0.31_r8) / 1000._r8 end if From f0fe8779d61dca88c6d4236936ca99eaa3964fdc Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Fri, 4 Mar 2022 13:21:04 -0700 Subject: [PATCH 035/257] Update paramsfile for Meier surface roughness changes to latest version --- .../testdefs/testmods_dirs/clm/Meier2022_surf_rough/user_nl_clm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cime_config/testdefs/testmods_dirs/clm/Meier2022_surf_rough/user_nl_clm b/cime_config/testdefs/testmods_dirs/clm/Meier2022_surf_rough/user_nl_clm index f9d550ff71..86903538e2 100644 --- a/cime_config/testdefs/testmods_dirs/clm/Meier2022_surf_rough/user_nl_clm +++ b/cime_config/testdefs/testmods_dirs/clm/Meier2022_surf_rough/user_nl_clm @@ -2,5 +2,5 @@ z0param_method = 'Meier2022' use_z0m_snowmelt = .true. use_z0mg_2d = .false. calc_human_stress_indices = 'NONE' ! Currently dies when turned on because of a negative humidity (about -31) in Wet Bulb calculation -paramfile = '/glade/p/cesm/lmwg_dev/oleson/Z0_RonnieMeier/ctsm51_params_newz0.c211112.nc' +paramfile = '$DIN_LOC_ROOT/lnd/clm2/paramdata/ctsm51_params.RMz0.c220304.nc' From cf0934b29fda140b5a8dae4158b4f8f4e34c442f Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Tue, 8 Mar 2022 14:26:40 -0700 Subject: [PATCH 036/257] Some updates from @olyson that get more tests to work --- src/biogeophys/BiogeophysPreFluxCalcsMod.F90 | 4 ++-- src/biogeophys/CanopyFluxesMod.F90 | 14 ++++++++++++-- 2 files changed, 14 insertions(+), 4 deletions(-) diff --git a/src/biogeophys/BiogeophysPreFluxCalcsMod.F90 b/src/biogeophys/BiogeophysPreFluxCalcsMod.F90 index f033fab5ff..9123000fc5 100644 --- a/src/biogeophys/BiogeophysPreFluxCalcsMod.F90 +++ b/src/biogeophys/BiogeophysPreFluxCalcsMod.F90 @@ -174,7 +174,7 @@ subroutine SetZ0mDisp(bounds, num_nolakep, filter_nolakep, & case ('Meier2022') ! Don't set on first few steps of a simulation, since htop isn't set yet, need to wait until after first do_alb time - if ( is_first_step() .or. get_nstep() <= GetBalanceCheckSkipSteps() ) then + if ( is_first_step() .or. get_nstep() <= GetBalanceCheckSkipSteps()-1 ) then z0m(p) = 0._r8 displa(p) = 0._r8 cycle @@ -190,7 +190,7 @@ subroutine SetZ0mDisp(bounds, num_nolakep, filter_nolakep, & displa(p) = 0._r8 else - ! Compute as if elai+esai = LAImax - LAIoff in CanopyFluxes + ! Compute as if elai+esai = LAImax in CanopyFluxes displa(p) = htop(p) * (1._r8 - (1._r8 - exp(-(7.5_r8 * (pftcon%z0v_LAImax(patch%itype(p))))**0.5_r8)) & / (7.5_r8*(pftcon%z0v_LAImax(patch%itype(p)) ))**0.5_r8) diff --git a/src/biogeophys/CanopyFluxesMod.F90 b/src/biogeophys/CanopyFluxesMod.F90 index 2681c93ced..f7139af47b 100644 --- a/src/biogeophys/CanopyFluxesMod.F90 +++ b/src/biogeophys/CanopyFluxesMod.F90 @@ -528,7 +528,12 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, soilbeta => soilstate_inst%soilbeta_col , & ! Input: [real(r8) (:) ] soil wetness relative to field capacity u10_clm => frictionvel_inst%u10_clm_patch , & ! Input: [real(r8) (:) ] 10 m height winds (m/s) - forc_hgt_u_patch => frictionvel_inst%forc_hgt_u_patch , & ! Input: [real(r8) (:) ] observational height of wind at patch level [m] + forc_hgt_t => atm2lnd_inst%forc_hgt_t_grc , & ! Input: [real(r8) (:) ] observational height of temperature [m] + forc_hgt_u => atm2lnd_inst%forc_hgt_u_grc , & ! Input: [real(r8) (:) ] observational height of wind [m] + forc_hgt_q => atm2lnd_inst%forc_hgt_q_grc , & ! Input: [real(r8) (:) ] observational height of specific humidity [m] + forc_hgt_t_patch => frictionvel_inst%forc_hgt_t_patch , & ! Output: [real(r8) (:) ] observational height of temperature at patch level [m] + forc_hgt_q_patch => frictionvel_inst%forc_hgt_q_patch , & ! Output: [real(r8) (:) ] observational height of specific humidity at patch level [m] + forc_hgt_u_patch => frictionvel_inst%forc_hgt_u_patch , & ! Output: [real(r8) (:) ] observational height of wind at patch level [m] z0mg => frictionvel_inst%z0mg_col , & ! Input: [real(r8) (:) ] roughness length of ground, momentum [m] zetamax => frictionvel_inst%zetamaxstable , & ! Input: [real(r8) ] max zeta value under stable conditions ram1 => frictionvel_inst%ram1_patch , & ! Output: [real(r8) (:) ] aerodynamical resistance (s/m) @@ -877,7 +882,7 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, do f = 1, fn p = filterp(f) c = patch%column(p) - + g = patch%gridcell(p) select case (z0param_method) case ('ZengWang2007') @@ -913,6 +918,11 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, call endrun(msg = 'unknown z0param_method', additional_msg = errMsg(sourcefile, __LINE__)) end select + ! Update the forcing heights + forc_hgt_u_patch(p) = forc_hgt_u(g) + z0mg(c) + displa(p) + forc_hgt_t_patch(p) = forc_hgt_t(g) + z0mg(c) + displa(p) + forc_hgt_q_patch(p) = forc_hgt_q(g) + z0mg(c) + displa(p) + z0hv(p) = z0mv(p) z0qv(p) = z0mv(p) From 1f1cce974ffb38a1bee310476cfd870cfe9be261 Mon Sep 17 00:00:00 2001 From: Keith Oleson Date: Mon, 14 Mar 2022 14:45:28 -0600 Subject: [PATCH 037/257] Update forcing height variables and rename/move snomelt_accum to WaterDiagnosticsBulkType --- src/biogeophys/BiogeophysPreFluxCalcsMod.F90 | 4 ++-- src/biogeophys/CanopyFluxesMod.F90 | 16 ++++++++++--- src/biogeophys/FrictionVelocityMod.F90 | 13 +++++----- src/biogeophys/LakeFluxesMod.F90 | 3 +-- src/biogeophys/SnowHydrologyMod.F90 | 25 +++++++++++--------- src/biogeophys/SoilTemperatureMod.F90 | 4 ++-- src/biogeophys/WaterDiagnosticBulkType.F90 | 23 +++++++++++++++++- src/biogeophys/WaterFluxType.F90 | 24 ------------------- 8 files changed, 60 insertions(+), 52 deletions(-) diff --git a/src/biogeophys/BiogeophysPreFluxCalcsMod.F90 b/src/biogeophys/BiogeophysPreFluxCalcsMod.F90 index f033fab5ff..9123000fc5 100644 --- a/src/biogeophys/BiogeophysPreFluxCalcsMod.F90 +++ b/src/biogeophys/BiogeophysPreFluxCalcsMod.F90 @@ -174,7 +174,7 @@ subroutine SetZ0mDisp(bounds, num_nolakep, filter_nolakep, & case ('Meier2022') ! Don't set on first few steps of a simulation, since htop isn't set yet, need to wait until after first do_alb time - if ( is_first_step() .or. get_nstep() <= GetBalanceCheckSkipSteps() ) then + if ( is_first_step() .or. get_nstep() <= GetBalanceCheckSkipSteps()-1 ) then z0m(p) = 0._r8 displa(p) = 0._r8 cycle @@ -190,7 +190,7 @@ subroutine SetZ0mDisp(bounds, num_nolakep, filter_nolakep, & displa(p) = 0._r8 else - ! Compute as if elai+esai = LAImax - LAIoff in CanopyFluxes + ! Compute as if elai+esai = LAImax in CanopyFluxes displa(p) = htop(p) * (1._r8 - (1._r8 - exp(-(7.5_r8 * (pftcon%z0v_LAImax(patch%itype(p))))**0.5_r8)) & / (7.5_r8*(pftcon%z0v_LAImax(patch%itype(p)) ))**0.5_r8) diff --git a/src/biogeophys/CanopyFluxesMod.F90 b/src/biogeophys/CanopyFluxesMod.F90 index 2681c93ced..10d1193cbb 100644 --- a/src/biogeophys/CanopyFluxesMod.F90 +++ b/src/biogeophys/CanopyFluxesMod.F90 @@ -528,7 +528,12 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, soilbeta => soilstate_inst%soilbeta_col , & ! Input: [real(r8) (:) ] soil wetness relative to field capacity u10_clm => frictionvel_inst%u10_clm_patch , & ! Input: [real(r8) (:) ] 10 m height winds (m/s) - forc_hgt_u_patch => frictionvel_inst%forc_hgt_u_patch , & ! Input: [real(r8) (:) ] observational height of wind at patch level [m] + forc_hgt_t => atm2lnd_inst%forc_hgt_t_grc , & ! Input: [real(r8) (:) ] observational height of temperature [m] + forc_hgt_u => atm2lnd_inst%forc_hgt_u_grc , & ! Input: [real(r8) (:) ] observational height of wind [m] + forc_hgt_q => atm2lnd_inst%forc_hgt_q_grc , & ! Input: [real(r8) (:) ] observational height of specific humidity [m] + forc_hgt_t_patch => frictionvel_inst%forc_hgt_t_patch , & ! Output: [real(r8) (:) ] observational height of temperature at patch level [m] + forc_hgt_q_patch => frictionvel_inst%forc_hgt_q_patch , & ! Output: [real(r8) (:) ] observational height of specific humidity at patch level [m] + forc_hgt_u_patch => frictionvel_inst%forc_hgt_u_patch , & ! Output: [real(r8) (:) ] observational height of wind at patch level [m] z0mg => frictionvel_inst%z0mg_col , & ! Input: [real(r8) (:) ] roughness length of ground, momentum [m] zetamax => frictionvel_inst%zetamaxstable , & ! Input: [real(r8) ] max zeta value under stable conditions ram1 => frictionvel_inst%ram1_patch , & ! Output: [real(r8) (:) ] aerodynamical resistance (s/m) @@ -877,7 +882,7 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, do f = 1, fn p = filterp(f) c = patch%column(p) - + g = patch%gridcell(p) select case (z0param_method) case ('ZengWang2007') @@ -916,6 +921,11 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, z0hv(p) = z0mv(p) z0qv(p) = z0mv(p) + ! Update the forcing heights + forc_hgt_u_patch(p) = forc_hgt_u(g) + z0mv(p) + displa(p) + forc_hgt_t_patch(p) = forc_hgt_t(g) + z0hv(p) + displa(p) + forc_hgt_q_patch(p) = forc_hgt_q(g) + z0qv(p) + displa(p) + end do found = .false. @@ -1388,7 +1398,7 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, else !unstable zeta(p) = max(-100._r8,min(zeta(p),-0.01_r8)) if ( ustar(p)*thvstar > 0.0d00 )then - write(iulog,*) 'ustar*thvstart is positive and has to be negative' + write(iulog,*) 'ustar*thvstar is positive and has to be negative' write(iulog,*) 'p = ', p write(iulog,*) '-grav*ustar(p)*thvstar*zii/thv(c) = ', -grav*ustar(p)*thvstar*zii/thv(c) write(iulog,*) 'ustar = ', ustar(p) diff --git a/src/biogeophys/FrictionVelocityMod.F90 b/src/biogeophys/FrictionVelocityMod.F90 index b4d7dfed5d..585659a981 100644 --- a/src/biogeophys/FrictionVelocityMod.F90 +++ b/src/biogeophys/FrictionVelocityMod.F90 @@ -611,7 +611,7 @@ subroutine SetRoughnessLengthsAndForcHeightsNonLake(this, bounds, & frac_veg_nosno => canopystate_inst%frac_veg_nosno_patch , & ! Input: [integer (:) ] fraction of vegetation not covered by snow (0 OR 1) [-] frac_sno => waterdiagnosticbulk_inst%frac_sno_col , & ! Input: [real(r8) (:) ] fraction of ground covered by snow (0 to 1) - snomelt_accum => waterfluxbulk_inst%qflx_snomelt_accum_col , & ! Input: [real(r8) (:) ] accumulated col snow melt for z0m calculation (m H2O) + snomelt_accum => waterdiagnosticbulk_inst%snomelt_accum_col , & ! Input: [real(r8) (:) ] accumulated col snow melt for z0m calculation (m H2O) urbpoi => lun%urbpoi , & ! Input: [logical (:) ] true => landunit is an urban point z_0_town => lun%z_0_town , & ! Input: [real(r8) (:) ] momentum roughness length of urban landunit (m) z_d_town => lun%z_d_town , & ! Input: [real(r8) (:) ] displacement height of urban landunit (m) @@ -632,7 +632,11 @@ subroutine SetRoughnessLengthsAndForcHeightsNonLake(this, bounds, & case ('ZengWang2007') if (frac_sno(c) > 0._r8) then if(use_z0m_snowmelt) then - z0mg(c) = exp(1.4_r8 * (atan((log10(snomelt_accum(c))+0.23_r8)/0.08_r8))-0.31_r8) / 1000._r8 + if ( snomelt_accum(c) < 1.e-5_r8 )then + z0mg(c) = exp(1.4_r8 * -rpi/2.0_r8 -0.31_r8) / 1000._r8 + else + z0mg(c) = exp(1.4_r8 * (atan((log10(snomelt_accum(c))+0.23_r8)/0.08_r8))-0.31_r8) / 1000._r8 + end if else z0mg(c) = this%zsno end if @@ -655,19 +659,14 @@ subroutine SetRoughnessLengthsAndForcHeightsNonLake(this, bounds, & end if else z0mg(c) = this%zsno - - end if else if (lun%itype(l) == istice) then z0mg(c) = this%zglc - - else if(use_z0mg_2d) then z0mg(c) = z0mg_2D(c) else z0mg(c) = this%zlnd - end if end if end select diff --git a/src/biogeophys/LakeFluxesMod.F90 b/src/biogeophys/LakeFluxesMod.F90 index e99eadc5c5..c9eda89070 100644 --- a/src/biogeophys/LakeFluxesMod.F90 +++ b/src/biogeophys/LakeFluxesMod.F90 @@ -228,8 +228,7 @@ subroutine LakeFluxes(bounds, num_lakec, filter_lakec, num_lakep, filter_lakep, h2osoi_liq => waterstatebulk_inst%h2osoi_liq_col , & ! Input: [real(r8) (:,:) ] liquid water (kg/m2) h2osoi_ice => waterstatebulk_inst%h2osoi_ice_col , & ! Input: [real(r8) (:,:) ] ice lens (kg/m2) - snomelt_accum => waterfluxbulk_inst%qflx_snomelt_accum_col , & ! Input: [real(r8) (:) ] accumulated col snow melt for z0m calculation (m H2O) - + snomelt_accum => waterdiagnosticbulk_inst%snomelt_accum_col , & ! Input: [real(r8) (:) ] accumulated col snow melt for z0m calculation (m H2O) t_skin_patch => temperature_inst%t_skin_patch , & ! Output: [real(r8) (:) ] patch skin temperature (K) t_lake => temperature_inst%t_lake_col , & ! Input: [real(r8) (:,:) ] lake temperature (Kelvin) diff --git a/src/biogeophys/SnowHydrologyMod.F90 b/src/biogeophys/SnowHydrologyMod.F90 index 471d93e004..dc1676ca7d 100644 --- a/src/biogeophys/SnowHydrologyMod.F90 +++ b/src/biogeophys/SnowHydrologyMod.F90 @@ -384,7 +384,7 @@ subroutine UpdateQuantitiesForNewSnow(bounds, num_c, filter_c, & frac_sno = b_waterdiagnostic_inst%frac_sno_col(begc:endc), & frac_sno_eff = b_waterdiagnostic_inst%frac_sno_eff_col(begc:endc), & snow_depth = b_waterdiagnostic_inst%snow_depth_col(begc:endc), & - qflx_snomelt_accum = b_waterflux_inst%qflx_snomelt_accum_col(begc:endc)) + snomelt_accum = b_waterdiagnostic_inst%snomelt_accum_col(begc:endc)) do i = water_inst%bulk_and_tracers_beg, water_inst%bulk_and_tracers_end associate(w => water_inst%bulk_and_tracers(i)) @@ -408,7 +408,7 @@ subroutine BulkDiag_NewSnowDiagnostics(bounds, num_c, filter_c, & scf_method, & dtime, lun_itype_col, urbpoi, snl, bifall, h2osno_total, h2osoi_ice, h2osoi_liq, & qflx_snow_grnd, qflx_snow_drain, & - dz, int_snow, swe_old, frac_sno, frac_sno_eff, snow_depth, qflx_snomelt_accum) + dz, int_snow, swe_old, frac_sno, frac_sno_eff, snow_depth, snomelt_accum) ! ! !DESCRIPTION: ! Update various snow-related diagnostic quantities to account for new snow @@ -435,7 +435,7 @@ subroutine BulkDiag_NewSnowDiagnostics(bounds, num_c, filter_c, & real(r8) , intent(inout) :: frac_sno( bounds%begc: ) ! fraction of ground covered by snow (0 to 1) real(r8) , intent(inout) :: frac_sno_eff( bounds%begc: ) ! eff. fraction of ground covered by snow (0 to 1) real(r8) , intent(inout) :: snow_depth( bounds%begc: ) ! snow height (m) - real(r8) , intent(inout) :: qflx_snomelt_accum( bounds%begc:) ! accumulated col snow melt for z0m calculation (m H2O) + real(r8) , intent(inout) :: snomelt_accum( bounds%begc: ) ! accumulated col snow melt for z0m calculation (m H2O) ! ! !LOCAL VARIABLES: integer :: fc, c @@ -464,6 +464,7 @@ subroutine BulkDiag_NewSnowDiagnostics(bounds, num_c, filter_c, & SHR_ASSERT_FL((ubound(frac_sno, 1) == bounds%endc), sourcefile, __LINE__) SHR_ASSERT_FL((ubound(frac_sno_eff, 1) == bounds%endc), sourcefile, __LINE__) SHR_ASSERT_FL((ubound(snow_depth, 1) == bounds%endc), sourcefile, __LINE__) + SHR_ASSERT_FL((ubound(snomelt_accum, 1) == bounds%endc), sourcefile, __LINE__) associate( & begc => bounds%begc, & @@ -490,7 +491,7 @@ subroutine BulkDiag_NewSnowDiagnostics(bounds, num_c, filter_c, & ! all snow falls on ground, no snow on h2osfc (note that qflx_snow_h2osfc is ! currently set to 0 always in CanopyHydrologyMod) newsnow(c) = qflx_snow_grnd(c) * dtime - qflx_snomelt_accum(c) = max(0._r8, qflx_snomelt_accum(c) - newsnow(c)/1000._r8) + snomelt_accum(c) = max(0._r8, snomelt_accum(c) - newsnow(c)/1000._r8) ! update int_snow int_snow(c) = max(int_snow(c),h2osno_total(c)) !h2osno_total could be larger due to frost @@ -807,8 +808,7 @@ subroutine InitializeExplicitSnowPack(bounds, num_c, filter_c, & ! Outputs h2osno_no_layers = w%waterstate_inst%h2osno_no_layers_col(begc:endc), & h2osoi_ice = w%waterstate_inst%h2osoi_ice_col(begc:endc,:), & - h2osoi_liq = w%waterstate_inst%h2osoi_liq_col(begc:endc,:), & - qflx_snomelt_accum = b_waterflux_inst%qflx_snomelt_accum_col(begc:endc)) + h2osoi_liq = w%waterstate_inst%h2osoi_liq_col(begc:endc,:)) end associate end do @@ -823,7 +823,8 @@ subroutine InitializeExplicitSnowPack(bounds, num_c, filter_c, & dz = col%dz(begc:endc,:), & z = col%z(begc:endc,:), & t_soisno = temperature_inst%t_soisno_col(begc:endc,:), & - frac_iceold = b_waterdiagnostic_inst%frac_iceold_col(begc:endc,:)) + frac_iceold = b_waterdiagnostic_inst%frac_iceold_col(begc:endc,:), & + snomelt_accum = b_waterdiagnostic_inst%snomelt_accum_col(begc:endc)) ! intitialize SNICAR variables for fresh snow: call aerosol_inst%ResetFilter( & @@ -901,7 +902,7 @@ end subroutine BuildFilter_SnowpackInitialized !----------------------------------------------------------------------- subroutine UpdateState_InitializeSnowPack(bounds, snowpack_initialized_filterc, & - h2osno_no_layers, h2osoi_ice, h2osoi_liq, qflx_snomelt_accum) + h2osno_no_layers, h2osoi_ice, h2osoi_liq) ! ! !DESCRIPTION: ! For bulk or one tracer: initialize water state variables for columns in which an @@ -914,7 +915,6 @@ subroutine UpdateState_InitializeSnowPack(bounds, snowpack_initialized_filterc, real(r8) , intent(inout) :: h2osno_no_layers( bounds%begc: ) ! snow that is not resolved into layers (kg/m2) real(r8) , intent(inout) :: h2osoi_ice( bounds%begc: , -nlevsno+1: ) ! ice lens (kg/m2) real(r8) , intent(inout) :: h2osoi_liq( bounds%begc: , -nlevsno+1: ) ! liquid water (kg/m2) - real(r8) , intent(inout) :: qflx_snomelt_accum( bounds%begc:) ! accumulated col snow melt for z0m calculation (m H2O) ! ! !LOCAL VARIABLES: integer :: fc, c @@ -932,14 +932,13 @@ subroutine UpdateState_InitializeSnowPack(bounds, snowpack_initialized_filterc, h2osoi_ice(c,0) = h2osno_no_layers(c) h2osoi_liq(c,0) = 0._r8 h2osno_no_layers(c) = 0._r8 - qflx_snomelt_accum(c) = 0._r8 end do end subroutine UpdateState_InitializeSnowPack !----------------------------------------------------------------------- subroutine Bulk_InitializeSnowPack(bounds, snowpack_initialized_filterc, & - forc_t, snow_depth, snl, zi, dz, z, t_soisno, frac_iceold) + forc_t, snow_depth, snl, zi, dz, z, t_soisno, frac_iceold, snomelt_accum) ! ! !DESCRIPTION: ! Initialize an explicit snow pack in columns where this is warranted based on snow depth @@ -959,6 +958,7 @@ subroutine Bulk_InitializeSnowPack(bounds, snowpack_initialized_filterc, & real(r8) , intent(inout) :: z( bounds%begc: , -nlevsno+1: ) ! layer depth (m) real(r8) , intent(inout) :: t_soisno( bounds%begc: , -nlevsno+1: ) ! soil temperature (Kelvin) real(r8) , intent(inout) :: frac_iceold( bounds%begc: , -nlevsno+1: ) ! fraction of ice relative to the tot water + real(r8) , intent(inout) :: snomelt_accum( bounds%begc: ) ! accumulated col snow melt for z0m calculation (m H2O) ! ! !LOCAL VARIABLES: integer :: fc, c @@ -974,6 +974,7 @@ subroutine Bulk_InitializeSnowPack(bounds, snowpack_initialized_filterc, & SHR_ASSERT_ALL_FL((ubound(z) == [bounds%endc, nlevmaxurbgrnd]), sourcefile, __LINE__) SHR_ASSERT_ALL_FL((ubound(t_soisno) == [bounds%endc, nlevmaxurbgrnd]), sourcefile, __LINE__) SHR_ASSERT_ALL_FL((ubound(frac_iceold) == [bounds%endc, nlevgrnd]), sourcefile, __LINE__) + SHR_ASSERT_ALL_FL((ubound(snomelt_accum, 1) == bounds%endc), sourcefile, __LINE__) do fc = 1, snowpack_initialized_filterc%num c = snowpack_initialized_filterc%indices(fc) @@ -989,6 +990,8 @@ subroutine Bulk_InitializeSnowPack(bounds, snowpack_initialized_filterc, & ! This value of frac_iceold makes sense together with the state initialization: ! h2osoi_ice is non-zero, while h2osoi_liq is zero. frac_iceold(c,0) = 1._r8 + + snomelt_accum(c) = 0._r8 end do end subroutine Bulk_InitializeSnowPack diff --git a/src/biogeophys/SoilTemperatureMod.F90 b/src/biogeophys/SoilTemperatureMod.F90 index 893748e7d8..061fb3a2b2 100644 --- a/src/biogeophys/SoilTemperatureMod.F90 +++ b/src/biogeophys/SoilTemperatureMod.F90 @@ -1114,7 +1114,7 @@ subroutine Phasechange_beta (bounds, num_nolakec, filter_nolakec, dhsdT, & qflx_snofrz_lyr => waterfluxbulk_inst%qflx_snofrz_lyr_col , & ! Output: [real(r8) (:,:) ] snow freezing rate (positive definite) (col,lyr) [kg m-2 s-1] qflx_snofrz => waterfluxbulk_inst%qflx_snofrz_col , & ! Output: [real(r8) (:) ] column-integrated snow freezing rate (positive definite) [kg m-2 s-1] qflx_snomelt => waterfluxbulk_inst%qflx_snomelt_col , & ! Output: [real(r8) (:) ] snow melt (mm H2O /s) - qflx_snomelt_accum => waterfluxbulk_inst%qflx_snomelt_accum_col , & ! Output: [real(r8) (:) ] accumulated snow melt (m) + snomelt_accum => waterdiagnosticbulk_inst%snomelt_accum_col , & ! Output: [real(r8) (:) ] accumulated snow melt (m) qflx_snomelt_lyr => waterfluxbulk_inst%qflx_snomelt_lyr_col , & ! Output: [real(r8) (:) ] snow melt in each layer (mm H2O /s) eflx_snomelt => energyflux_inst%eflx_snomelt_col , & ! Output: [real(r8) (:) ] snow melt heat flux (W/m**2) @@ -1382,7 +1382,7 @@ subroutine Phasechange_beta (bounds, num_nolakec, filter_nolakec, dhsdT, & if (imelt(c,j) == 1 .AND. j < 1) then qflx_snomelt_lyr(c,j) = max(0._r8,(wice0(c,j)-h2osoi_ice(c,j)))/dtime qflx_snomelt(c) = qflx_snomelt(c) + qflx_snomelt_lyr(c,j) - qflx_snomelt_accum(c) = qflx_snomelt_accum(c) + qflx_snomelt_lyr(c,j) * dtime/1000._r8 + snomelt_accum(c) = snomelt_accum(c) + qflx_snomelt_lyr(c,j) * dtime/1000._r8 endif ! layer freezing mass flux (positive): diff --git a/src/biogeophys/WaterDiagnosticBulkType.F90 b/src/biogeophys/WaterDiagnosticBulkType.F90 index 7804fa3746..d974881aed 100644 --- a/src/biogeophys/WaterDiagnosticBulkType.F90 +++ b/src/biogeophys/WaterDiagnosticBulkType.F90 @@ -42,7 +42,7 @@ module WaterDiagnosticBulkType real(r8), pointer :: snowdp_col (:) ! col area-averaged snow height (m) real(r8), pointer :: snow_layer_unity_col (:,:) ! value 1 for each snow layer, used for history diagnostics real(r8), pointer :: bw_col (:,:) ! col partial density of water in the snow pack (ice + liquid) [kg/m3] - + real(r8), pointer :: snomelt_accum_col (:) ! accumulated col snow melt for z0m calculation (m H2O) real(r8), pointer :: h2osoi_liq_tot_col (:) ! vertically summed col liquid water (kg/m2) (new) (-nlevsno+1:nlevgrnd) real(r8), pointer :: h2osoi_ice_tot_col (:) ! vertically summed col ice lens (kg/m2) (new) (-nlevsno+1:nlevgrnd) real(r8), pointer :: air_vol_col (:,:) ! col air filled porosity @@ -187,6 +187,7 @@ subroutine InitBulkAllocate(this, bounds) allocate(this%snow_depth_col (begc:endc)) ; this%snow_depth_col (:) = nan allocate(this%snow_5day_col (begc:endc)) ; this%snow_5day_col (:) = nan allocate(this%snowdp_col (begc:endc)) ; this%snowdp_col (:) = nan + allocate(this%snomelt_accum_col (begc:endc)) ; this%snomelt_accum_col (:) = nan allocate(this%snow_layer_unity_col (begc:endc,-nlevsno+1:0)) ; this%snow_layer_unity_col (:,:) = nan allocate(this%bw_col (begc:endc,-nlevsno+1:0)) ; this%bw_col (:,:) = nan allocate(this%air_vol_col (begc:endc, 1:nlevgrnd)) ; this%air_vol_col (:,:) = nan @@ -452,6 +453,14 @@ subroutine InitBulkHistory(this, bounds) long_name=this%info%lname('gridcell mean snow height'), & ptr_col=this%snowdp_col, c2l_scale_type='urbanf') + this%snomelt_accum_col(begc:endc) = 0._r8 + call hist_addfld1d ( & ! Have this as an output variable for now to check + fname=this%info%fname('SNOMELT_ACCUM'), & + units='m', & + avgflag='A', & + long_name=this%info%lname('accumulated snow melt for z0'), & + ptr_col=this%snomelt_accum_col, c2l_scale_type='urbanf') + if (use_cn) then this%wf_col(begc:endc) = spval call hist_addfld1d ( & @@ -786,6 +795,18 @@ subroutine RestartBulk(this, bounds, ncid, flag, writing_finidat_interp_dest_fil units='m', & interpinic_flag='interp', readvar=readvar, data=this%snow_depth_col) + call restartvar(ncid=ncid, flag=flag, & + varname=this%info%fname('SNOMELT_ACCUM'), & + xtype=ncd_double, & + dim1name='column', & + long_name=this%info%lname('accumulated snow melt for z0'), & + units='m', & + interpinic_flag='interp', readvar=readvar, data=this%snomelt_accum_col) + if (flag == 'read' .and. .not. readvar) then + ! initial run, not restart: initialize snomelt_accum_col to zero + this%snomelt_accum_col(bounds%begc:bounds%endc) = 0._r8 + endif + call restartvar(ncid=ncid, flag=flag, & varname=this%info%fname('frac_sno_eff'), & xtype=ncd_double, & diff --git a/src/biogeophys/WaterFluxType.F90 b/src/biogeophys/WaterFluxType.F90 index ff20e825fa..f7c55d44e1 100644 --- a/src/biogeophys/WaterFluxType.F90 +++ b/src/biogeophys/WaterFluxType.F90 @@ -77,7 +77,6 @@ module WaterFluxType real(r8), pointer :: qflx_floodc_col (:) ! col flood water flux at column level real(r8), pointer :: qflx_sl_top_soil_col (:) ! col liquid water + ice from layer above soil to top soil layer or sent to qflx_qrgwl (mm H2O/s) real(r8), pointer :: qflx_snomelt_col (:) ! col snow melt (mm H2O /s) - real(r8), pointer :: qflx_snomelt_accum_col (:) ! accumulated col snow melt for z0m calculation (m H2O) real(r8), pointer :: qflx_qrgwl_col (:) ! col qflx_surf at glaciers, wetlands, lakes real(r8), pointer :: qflx_runoff_col (:) ! col total runoff (qflx_drain+qflx_surf+qflx_qrgwl) (mm H2O /s) real(r8), pointer :: qflx_runoff_r_col (:) ! col Rural total runoff (qflx_drain+qflx_surf+qflx_qrgwl) (mm H2O /s) @@ -285,9 +284,6 @@ subroutine InitAllocate(this, bounds, tracer_vars) call AllocateVar1d(var = this%qflx_snomelt_col, name = 'qflx_snomelt_col', & container = tracer_vars, & bounds = bounds, subgrid_level = subgrid_level_column) - call AllocateVar1d(var = this%qflx_snomelt_accum_col, name = 'qflx_snomelt_accum_col', & - container = tracer_vars, & - bounds = bounds, subgrid_level = subgrid_level_column) call AllocateVar1d(var = this%qflx_snofrz_col, name = 'qflx_snofrz_col', & container = tracer_vars, & bounds = bounds, subgrid_level = subgrid_level_column) @@ -549,14 +545,6 @@ subroutine InitHistory(this, bounds) long_name=this%info%lname('snow melt rate'), & ptr_col=this%qflx_snomelt_col, c2l_scale_type='urbanf') - this%qflx_snomelt_accum_col(begc:endc) = 0._r8 - call hist_addfld1d ( & ! Have this as an output variable for now to check - fname=this%info%fname('QSNOMELT_ACCUM'), & - units='m', & - avgflag='A', & - long_name=this%info%lname('accumulated snow melt for z0'), & - ptr_col=this%qflx_snomelt_accum_col, c2l_scale_type='urbanf') - call hist_addfld1d ( & fname=this%info%fname('QSNOMELT_ICE'), & units='mm/s', & @@ -908,18 +896,6 @@ subroutine Restart(this, bounds, ncid, flag) this%qflx_snow_drain_col(bounds%begc:bounds%endc) = 0._r8 endif - call restartvar(ncid=ncid, flag=flag, & - varname=this%info%fname('QSNOMELT_ACCUM'), & - xtype=ncd_double, & - dim1name='column', & - long_name=this%info%lname('accumulated snow melt for z0'), & - units='m', & - interpinic_flag='interp', readvar=readvar, data=this%qflx_snomelt_accum_col) - if (flag == 'read' .and. .not. readvar) then - ! initial run, not restart: initialize qflx_snow_drain to zero - this%qflx_snomelt_accum_col(bounds%begc:bounds%endc) = 0._r8 - endif - call this%qflx_liq_dynbal_dribbler%Restart(bounds, ncid, flag) call this%qflx_ice_dynbal_dribbler%Restart(bounds, ncid, flag) From 382441ce8f07d640b0c31e41e5f645363b30f8cd Mon Sep 17 00:00:00 2001 From: Keith Oleson Date: Mon, 14 Mar 2022 15:00:21 -0600 Subject: [PATCH 038/257] Add forcing height change back into CanopyFluxesMod after rebase. --- src/biogeophys/CanopyFluxesMod.F90 | 5 ----- 1 file changed, 5 deletions(-) diff --git a/src/biogeophys/CanopyFluxesMod.F90 b/src/biogeophys/CanopyFluxesMod.F90 index 8059f26d73..10d1193cbb 100644 --- a/src/biogeophys/CanopyFluxesMod.F90 +++ b/src/biogeophys/CanopyFluxesMod.F90 @@ -918,11 +918,6 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, call endrun(msg = 'unknown z0param_method', additional_msg = errMsg(sourcefile, __LINE__)) end select - ! Update the forcing heights - forc_hgt_u_patch(p) = forc_hgt_u(g) + z0mg(c) + displa(p) - forc_hgt_t_patch(p) = forc_hgt_t(g) + z0mg(c) + displa(p) - forc_hgt_q_patch(p) = forc_hgt_q(g) + z0mg(c) + displa(p) - z0hv(p) = z0mv(p) z0qv(p) = z0mv(p) From e7579c9704441c058435b0e8dd4cd2158f1bc467 Mon Sep 17 00:00:00 2001 From: Keith Oleson Date: Tue, 15 Mar 2022 16:05:58 -0600 Subject: [PATCH 039/257] Encapsulated forcing height update in Meier2022 to maintain bfb with ZengWang2007. Protect snomelt_accum in LakeFluxes --- src/biogeophys/CanopyFluxesMod.F90 | 9 ++++++--- src/biogeophys/LakeFluxesMod.F90 | 6 +++++- 2 files changed, 11 insertions(+), 4 deletions(-) diff --git a/src/biogeophys/CanopyFluxesMod.F90 b/src/biogeophys/CanopyFluxesMod.F90 index 10d1193cbb..0a945f975c 100644 --- a/src/biogeophys/CanopyFluxesMod.F90 +++ b/src/biogeophys/CanopyFluxesMod.F90 @@ -922,9 +922,12 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, z0qv(p) = z0mv(p) ! Update the forcing heights - forc_hgt_u_patch(p) = forc_hgt_u(g) + z0mv(p) + displa(p) - forc_hgt_t_patch(p) = forc_hgt_t(g) + z0hv(p) + displa(p) - forc_hgt_q_patch(p) = forc_hgt_q(g) + z0qv(p) + displa(p) + ! TODO(KWO, 2022-03-15) Only for Meier2022 for now to maintain bfb with ZengWang2007 + if (z0param_method == 'Meier2022') then + forc_hgt_u_patch(p) = forc_hgt_u(g) + z0mv(p) + displa(p) + forc_hgt_t_patch(p) = forc_hgt_t(g) + z0hv(p) + displa(p) + forc_hgt_q_patch(p) = forc_hgt_q(g) + z0qv(p) + displa(p) + end if end do diff --git a/src/biogeophys/LakeFluxesMod.F90 b/src/biogeophys/LakeFluxesMod.F90 index c9eda89070..b53b0fd23b 100644 --- a/src/biogeophys/LakeFluxesMod.F90 +++ b/src/biogeophys/LakeFluxesMod.F90 @@ -365,7 +365,11 @@ subroutine LakeFluxes(bounds, num_lakec, filter_lakec, num_lakep, filter_lakep, case ('ZengWang2007') if(use_z0m_snowmelt) then - z0mg(p) = exp(1.4_r8 * (atan((log10(snomelt_accum(c))+0.23_r8)/0.08_r8))-0.31_r8) / 1000._r8 + if ( snomelt_accum(c) < 1.e-5_r8 ) then + z0mg(p) = exp(1.4_r8 * -rpi/2.0_r8 -0.31_r8) / 1000._r8 + else + z0mg(p) = exp(1.4_r8 * (atan((log10(snomelt_accum(c))+0.23_r8)/0.08_r8))-0.31_r8) / 1000._r8 + end if else z0mg(p) = params_inst%zsno end if From 902f1cb76f6371da5f3215ed6e9cd358b3f1f54e Mon Sep 17 00:00:00 2001 From: Keith Oleson Date: Mon, 21 Mar 2022 14:07:31 -0600 Subject: [PATCH 040/257] Update forcing heights and restrict zeta to less than 20 for now --- src/biogeophys/BareGroundFluxesMod.F90 | 11 ++++++- src/biogeophys/CanopyFluxesMod.F90 | 7 +++- src/biogeophys/FrictionVelocityMod.F90 | 44 +++++++++++++++++++++----- src/biogeophys/LakeFluxesMod.F90 | 22 +++++++++++-- 4 files changed, 71 insertions(+), 13 deletions(-) diff --git a/src/biogeophys/BareGroundFluxesMod.F90 b/src/biogeophys/BareGroundFluxesMod.F90 index 11d1790fc9..73c169fa13 100644 --- a/src/biogeophys/BareGroundFluxesMod.F90 +++ b/src/biogeophys/BareGroundFluxesMod.F90 @@ -234,7 +234,9 @@ subroutine BareGroundFluxes(bounds, num_noexposedvegp, filter_noexposedvegp, & rh_ref2m_r => waterdiagnosticbulk_inst%rh_ref2m_r_patch , & ! Output: [real(r8) (:) ] Rural 2 m height surface relative humidity (%) rh_ref2m => waterdiagnosticbulk_inst%rh_ref2m_patch , & ! Output: [real(r8) (:) ] 2 m height surface relative humidity (%) - forc_hgt_u_patch => frictionvel_inst%forc_hgt_u_patch , & ! Input: + forc_hgt_u_patch => frictionvel_inst%forc_hgt_u_patch , & ! Output: [real(r8) (:) ] observational height of wind at patch level [m] + forc_hgt_t_patch => frictionvel_inst%forc_hgt_t_patch , & ! Output: [real(r8) (:) ] observational height of temperature at patch level [m] + forc_hgt_q_patch => frictionvel_inst%forc_hgt_q_patch , & ! Output: [real(r8) (:) ] observational height of specific humidity at patch level [m] u10_clm => frictionvel_inst%u10_clm_patch , & ! Input: [real(r8) (:) ] 10 m height winds (m/s) zetamax => frictionvel_inst%zetamaxstable , & ! Input: [real(r8) ] max zeta value under stable conditions z0mg_col => frictionvel_inst%z0mg_col , & ! Output: [real(r8) (:) ] roughness length, momentum [m] @@ -359,6 +361,13 @@ subroutine BareGroundFluxes(bounds, num_noexposedvegp, filter_noexposedvegp, & end select z0qg_patch(p) = z0hg_patch(p) + ! Update the forcing heights for new roughness lengths + ! TODO(KWO, 2022-03-15) Only for Meier2022 for now to maintain bfb with ZengWang2007 + if (z0param_method == 'Meier2022') then + forc_hgt_u_patch(p) = forc_hgt_u_patch(g) + z0mg_patch(p) + displa(p) + forc_hgt_t_patch(p) = forc_hgt_t_patch(g) + z0hg_patch(p) + displa(p) + forc_hgt_q_patch(p) = forc_hgt_q_patch(g) + z0qg_patch(p) + displa(p) + end if thvstar = tstar*(1._r8+0.61_r8*forc_q(c)) + 0.61_r8*forc_th(c)*qstar zeta = zldis(p)*vkc*grav*thvstar/(ustar(p)**2*thv(c)) diff --git a/src/biogeophys/CanopyFluxesMod.F90 b/src/biogeophys/CanopyFluxesMod.F90 index 0a945f975c..31d73e1b37 100644 --- a/src/biogeophys/CanopyFluxesMod.F90 +++ b/src/biogeophys/CanopyFluxesMod.F90 @@ -1393,7 +1393,12 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, if (zeta(p) >= 0._r8) then !stable ! remove stability cap when biomass heat storage is active if(use_biomass_heat_storage) then - zeta(p) = min(100._r8,max(zeta(p),0.01_r8)) + ! TODO(KWO, 2022-03-15) Only for Meier2022 for now to maintain bfb with ZengWang2007 + if (z0param_method == 'Meier2022') then + zeta(p) = min(20._r8,max(zeta(p),0.01_r8)) + else + zeta(p) = min(100._r8,max(zeta(p),0.01_r8)) + end if else zeta(p) = min(zetamax,max(zeta(p),0.01_r8)) endif diff --git a/src/biogeophys/FrictionVelocityMod.F90 b/src/biogeophys/FrictionVelocityMod.F90 index 585659a981..5d532b1145 100644 --- a/src/biogeophys/FrictionVelocityMod.F90 +++ b/src/biogeophys/FrictionVelocityMod.F90 @@ -703,17 +703,17 @@ subroutine SetRoughnessLengthsAndForcHeightsNonLake(this, bounds, & if (lun%itype(l) == istsoil .or. lun%itype(l) == istcrop) then if (frac_veg_nosno(p) == 0) then forc_hgt_u_patch(p) = forc_hgt_u(g) + z0mg(c) + displa(p) - forc_hgt_t_patch(p) = forc_hgt_t(g) + z0mg(c) + displa(p) - forc_hgt_q_patch(p) = forc_hgt_q(g) + z0mg(c) + displa(p) + forc_hgt_t_patch(p) = forc_hgt_t(g) + z0hg(c) + displa(p) + forc_hgt_q_patch(p) = forc_hgt_q(g) + z0qg(c) + displa(p) else - forc_hgt_u_patch(p) = forc_hgt_u(g) + z0m(p) + displa(p) - forc_hgt_t_patch(p) = forc_hgt_t(g) + z0m(p) + displa(p) - forc_hgt_q_patch(p) = forc_hgt_q(g) + z0m(p) + displa(p) + forc_hgt_u_patch(p) = forc_hgt_u(g) + z0mv(p) + displa(p) + forc_hgt_t_patch(p) = forc_hgt_t(g) + z0hv(p) + displa(p) + forc_hgt_q_patch(p) = forc_hgt_q(g) + z0qv(p) + displa(p) end if else if (lun%itype(l) == istwet .or. lun%itype(l) == istice) then - forc_hgt_u_patch(p) = forc_hgt_u(g) + z0mg(c) - forc_hgt_t_patch(p) = forc_hgt_t(g) + z0mg(c) - forc_hgt_q_patch(p) = forc_hgt_q(g) + z0mg(c) + forc_hgt_u_patch(p) = forc_hgt_u(g) + z0mg(c) + displa(p) + forc_hgt_t_patch(p) = forc_hgt_t(g) + z0hg(c) + displa(p) + forc_hgt_q_patch(p) = forc_hgt_q(g) + z0qg(c) + displa(p) else if (urbpoi(l)) then forc_hgt_u_patch(p) = forc_hgt_u(g) + z_0_town(l) + z_d_town(l) forc_hgt_t_patch(p) = forc_hgt_t(g) + z_0_town(l) + z_d_town(l) @@ -893,6 +893,10 @@ subroutine FrictionVelocity(this, lbn, ubn, fn, filtern, & zldis(n) = forc_hgt_u_patch(n)-displa(n) end if zeta(n) = zldis(n)/obu(n) + ! TODO(KWO, 2022-03-15) Only for Meier2022 for now to maintain bfb with ZengWang2007 + if (z0param_method == 'Meier2022') then + zeta(n) = min(20._r8,zldis(n)/obu(n)) + end if if (zeta(n) < -zetam) then ustar(n) = vkc*um(n)/(log(-zetam*obu(n)/z0m(n))& - this%StabilityFunc1(-zetam) & @@ -992,6 +996,10 @@ subroutine FrictionVelocity(this, lbn, ubn, fn, filtern, & zldis(n) = forc_hgt_t_patch(n)-displa(n) end if zeta(n) = zldis(n)/obu(n) + ! TODO(KWO, 2022-03-15) Only for Meier2022 for now to maintain bfb with ZengWang2007 + if (z0param_method == 'Meier2022') then + zeta(n) = min(20._r8,zldis(n)/obu(n)) + end if if (zeta(n) < -zetat) then temp1(n) = vkc/(log(-zetat*obu(n)/z0h(n))& - this%StabilityFunc2(-zetat) & @@ -1016,6 +1024,10 @@ subroutine FrictionVelocity(this, lbn, ubn, fn, filtern, & else zldis(n) = forc_hgt_q_patch(pfti(n))-displa(n) zeta(n) = zldis(n)/obu(n) + ! TODO(KWO, 2022-03-15) Only for Meier2022 for now to maintain bfb with ZengWang2007 + if (z0param_method == 'Meier2022') then + zeta(n) = min(20._r8,zldis(n)/obu(n)) + end if if (zeta(n) < -zetat) then temp2(n) = vkc/(log(-zetat*obu(n)/z0q(n)) & - this%StabilityFunc2(-zetat) & @@ -1038,6 +1050,10 @@ subroutine FrictionVelocity(this, lbn, ubn, fn, filtern, & else zldis(n) = forc_hgt_q_patch(n)-displa(n) zeta(n) = zldis(n)/obu(n) + ! TODO(KWO, 2022-03-15) Only for Meier2022 for now to maintain bfb with ZengWang2007 + if (z0param_method == 'Meier2022') then + zeta(n) = min(20._r8,zldis(n)/obu(n)) + end if if (zeta(n) < -zetat) then temp2(n) = vkc/(log(-zetat*obu(n)/z0q(n)) & - this%StabilityFunc2(-zetat) & @@ -1060,6 +1076,10 @@ subroutine FrictionVelocity(this, lbn, ubn, fn, filtern, & zldis(n) = 2.0_r8 + z0h(n) zeta(n) = zldis(n)/obu(n) + ! TODO(KWO, 2022-03-15) Only for Meier2022 for now to maintain bfb with ZengWang2007 + if (z0param_method == 'Meier2022') then + zeta(n) = min(20._r8,zldis(n)/obu(n)) + end if if (zeta(n) < -zetat) then temp12m(n) = vkc/(log(-zetat*obu(n)/z0h(n))& - this%StabilityFunc2(-zetat) & @@ -1083,6 +1103,10 @@ subroutine FrictionVelocity(this, lbn, ubn, fn, filtern, & else zldis(n) = 2.0_r8 + z0q(n) zeta(n) = zldis(n)/obu(n) + ! TODO(KWO, 2022-03-15) Only for Meier2022 for now to maintain bfb with ZengWang2007 + if (z0param_method == 'Meier2022') then + zeta(n) = min(20._r8,zldis(n)/obu(n)) + end if if (zeta(n) < -zetat) then temp22m(n) = vkc/(log(-zetat*obu(n)/z0q(n)) - & this%StabilityFunc2(-zetat) + this%StabilityFunc2(z0q(n)/obu(n)) & @@ -1111,6 +1135,10 @@ subroutine FrictionVelocity(this, lbn, ubn, fn, filtern, & zldis(n) = forc_hgt_u_patch(n)-displa(n) end if zeta(n) = zldis(n)/obu(n) + ! TODO(KWO, 2022-03-15) Only for Meier2022 for now to maintain bfb with ZengWang2007 + if (z0param_method == 'Meier2022') then + zeta(n) = min(20._r8,zldis(n)/obu(n)) + end if if (min(zeta(n), 1._r8) < 0._r8) then tmp1 = (1._r8 - 16._r8*min(zeta(n),1._r8))**0.25_r8 tmp2 = log((1._r8+tmp1*tmp1)/2._r8) diff --git a/src/biogeophys/LakeFluxesMod.F90 b/src/biogeophys/LakeFluxesMod.F90 index b53b0fd23b..6dc9d1f0c0 100644 --- a/src/biogeophys/LakeFluxesMod.F90 +++ b/src/biogeophys/LakeFluxesMod.F90 @@ -380,9 +380,17 @@ subroutine LakeFluxes(bounds, num_lakec, filter_lakec, num_lakep, filter_lakep, ! Surface temperature and fluxes - forc_hgt_u_patch(p) = forc_hgt_u(g) + z0mg(p) - forc_hgt_t_patch(p) = forc_hgt_t(g) + z0mg(p) - forc_hgt_q_patch(p) = forc_hgt_q(g) + z0mg(p) + ! Update forcing heights for updated roughness lengths + ! TODO(KWO, 2022-03-15) Only for Meier2022 for now to maintain bfb with ZengWang2007 + if (z0param_method == 'Meier2022') then + forc_hgt_u_patch(p) = forc_hgt_u(g) + z0mg(p) + forc_hgt_t_patch(p) = forc_hgt_t(g) + z0hg(p) + forc_hgt_q_patch(p) = forc_hgt_q(g) + z0qg(p) + else + forc_hgt_u_patch(p) = forc_hgt_u(g) + z0mg(p) + forc_hgt_t_patch(p) = forc_hgt_t(g) + z0mg(p) + forc_hgt_q_patch(p) = forc_hgt_q(g) + z0mg(p) + end if ! Find top layer jtop(c) = snl(c) + 1 @@ -622,6 +630,14 @@ subroutine LakeFluxes(bounds, num_lakec, filter_lakec, num_lakep, filter_lakep, z0qg(p) = z0hg(p) end if + ! Update forcing heights for updated roughness lengths + ! TODO(KWO, 2022-03-15) Only for Meier2022 for now to maintain bfb with ZengWang2007 + if (z0param_method == 'Meier2022') then + forc_hgt_u_patch(p) = forc_hgt_u(g) + z0mg(p) + forc_hgt_t_patch(p) = forc_hgt_t(g) + z0hg(p) + forc_hgt_q_patch(p) = forc_hgt_q(g) + z0qg(p) + end if + end do ! end of filtered pft loop iter = iter + 1 From 46e2dad9e62317b03d597cdfb4a6cef7df9f3636 Mon Sep 17 00:00:00 2001 From: Keith Oleson Date: Tue, 17 May 2022 11:34:08 -0600 Subject: [PATCH 041/257] Revert restriction on zeta in FrictionVelocityMod --- src/biogeophys/FrictionVelocityMod.F90 | 28 -------------------------- 1 file changed, 28 deletions(-) diff --git a/src/biogeophys/FrictionVelocityMod.F90 b/src/biogeophys/FrictionVelocityMod.F90 index 5d532b1145..82f60f5a2b 100644 --- a/src/biogeophys/FrictionVelocityMod.F90 +++ b/src/biogeophys/FrictionVelocityMod.F90 @@ -893,10 +893,6 @@ subroutine FrictionVelocity(this, lbn, ubn, fn, filtern, & zldis(n) = forc_hgt_u_patch(n)-displa(n) end if zeta(n) = zldis(n)/obu(n) - ! TODO(KWO, 2022-03-15) Only for Meier2022 for now to maintain bfb with ZengWang2007 - if (z0param_method == 'Meier2022') then - zeta(n) = min(20._r8,zldis(n)/obu(n)) - end if if (zeta(n) < -zetam) then ustar(n) = vkc*um(n)/(log(-zetam*obu(n)/z0m(n))& - this%StabilityFunc1(-zetam) & @@ -996,10 +992,6 @@ subroutine FrictionVelocity(this, lbn, ubn, fn, filtern, & zldis(n) = forc_hgt_t_patch(n)-displa(n) end if zeta(n) = zldis(n)/obu(n) - ! TODO(KWO, 2022-03-15) Only for Meier2022 for now to maintain bfb with ZengWang2007 - if (z0param_method == 'Meier2022') then - zeta(n) = min(20._r8,zldis(n)/obu(n)) - end if if (zeta(n) < -zetat) then temp1(n) = vkc/(log(-zetat*obu(n)/z0h(n))& - this%StabilityFunc2(-zetat) & @@ -1024,10 +1016,6 @@ subroutine FrictionVelocity(this, lbn, ubn, fn, filtern, & else zldis(n) = forc_hgt_q_patch(pfti(n))-displa(n) zeta(n) = zldis(n)/obu(n) - ! TODO(KWO, 2022-03-15) Only for Meier2022 for now to maintain bfb with ZengWang2007 - if (z0param_method == 'Meier2022') then - zeta(n) = min(20._r8,zldis(n)/obu(n)) - end if if (zeta(n) < -zetat) then temp2(n) = vkc/(log(-zetat*obu(n)/z0q(n)) & - this%StabilityFunc2(-zetat) & @@ -1050,10 +1038,6 @@ subroutine FrictionVelocity(this, lbn, ubn, fn, filtern, & else zldis(n) = forc_hgt_q_patch(n)-displa(n) zeta(n) = zldis(n)/obu(n) - ! TODO(KWO, 2022-03-15) Only for Meier2022 for now to maintain bfb with ZengWang2007 - if (z0param_method == 'Meier2022') then - zeta(n) = min(20._r8,zldis(n)/obu(n)) - end if if (zeta(n) < -zetat) then temp2(n) = vkc/(log(-zetat*obu(n)/z0q(n)) & - this%StabilityFunc2(-zetat) & @@ -1076,10 +1060,6 @@ subroutine FrictionVelocity(this, lbn, ubn, fn, filtern, & zldis(n) = 2.0_r8 + z0h(n) zeta(n) = zldis(n)/obu(n) - ! TODO(KWO, 2022-03-15) Only for Meier2022 for now to maintain bfb with ZengWang2007 - if (z0param_method == 'Meier2022') then - zeta(n) = min(20._r8,zldis(n)/obu(n)) - end if if (zeta(n) < -zetat) then temp12m(n) = vkc/(log(-zetat*obu(n)/z0h(n))& - this%StabilityFunc2(-zetat) & @@ -1103,10 +1083,6 @@ subroutine FrictionVelocity(this, lbn, ubn, fn, filtern, & else zldis(n) = 2.0_r8 + z0q(n) zeta(n) = zldis(n)/obu(n) - ! TODO(KWO, 2022-03-15) Only for Meier2022 for now to maintain bfb with ZengWang2007 - if (z0param_method == 'Meier2022') then - zeta(n) = min(20._r8,zldis(n)/obu(n)) - end if if (zeta(n) < -zetat) then temp22m(n) = vkc/(log(-zetat*obu(n)/z0q(n)) - & this%StabilityFunc2(-zetat) + this%StabilityFunc2(z0q(n)/obu(n)) & @@ -1135,10 +1111,6 @@ subroutine FrictionVelocity(this, lbn, ubn, fn, filtern, & zldis(n) = forc_hgt_u_patch(n)-displa(n) end if zeta(n) = zldis(n)/obu(n) - ! TODO(KWO, 2022-03-15) Only for Meier2022 for now to maintain bfb with ZengWang2007 - if (z0param_method == 'Meier2022') then - zeta(n) = min(20._r8,zldis(n)/obu(n)) - end if if (min(zeta(n), 1._r8) < 0._r8) then tmp1 = (1._r8 - 16._r8*min(zeta(n),1._r8))**0.25_r8 tmp2 = log((1._r8+tmp1*tmp1)/2._r8) From 189f9f9ca0bce94e4b83cc5326dca25310f55ac2 Mon Sep 17 00:00:00 2001 From: Keith Oleson Date: Fri, 10 Jun 2022 12:11:41 -0600 Subject: [PATCH 042/257] Remove restriction on calc_human_stress_indices --- .../testdefs/testmods_dirs/clm/Meier2022_surf_rough/user_nl_clm | 1 - 1 file changed, 1 deletion(-) diff --git a/cime_config/testdefs/testmods_dirs/clm/Meier2022_surf_rough/user_nl_clm b/cime_config/testdefs/testmods_dirs/clm/Meier2022_surf_rough/user_nl_clm index 86903538e2..c885cdacd7 100644 --- a/cime_config/testdefs/testmods_dirs/clm/Meier2022_surf_rough/user_nl_clm +++ b/cime_config/testdefs/testmods_dirs/clm/Meier2022_surf_rough/user_nl_clm @@ -1,6 +1,5 @@ z0param_method = 'Meier2022' use_z0m_snowmelt = .true. use_z0mg_2d = .false. -calc_human_stress_indices = 'NONE' ! Currently dies when turned on because of a negative humidity (about -31) in Wet Bulb calculation paramfile = '$DIN_LOC_ROOT/lnd/clm2/paramdata/ctsm51_params.RMz0.c220304.nc' From c08d09d90cd36d107f5669c855f40ff36e79b68e Mon Sep 17 00:00:00 2001 From: Keith Oleson Date: Fri, 10 Jun 2022 12:47:03 -0600 Subject: [PATCH 043/257] Change zetamaxstable for z0param_method == 'Meier2022' to 2.0 --- bld/namelist_files/namelist_defaults_ctsm.xml | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/bld/namelist_files/namelist_defaults_ctsm.xml b/bld/namelist_files/namelist_defaults_ctsm.xml index ea0b9f321c..0081b9ac6b 100644 --- a/bld/namelist_files/namelist_defaults_ctsm.xml +++ b/bld/namelist_files/namelist_defaults_ctsm.xml @@ -208,7 +208,8 @@ attributes from the config_cache.xml file (with keys converted to upper-case). 2.0d00 0.5d00 -0.5d00 +0.5d00 +2.0d00 .true. From 6be9820bd2d88cf48ae154e3a0e432655dd77f87 Mon Sep 17 00:00:00 2001 From: Keith Oleson Date: Mon, 13 Jun 2022 08:55:03 -0600 Subject: [PATCH 044/257] Make zeta a global variable and fix zetamaxstable namelist --- bld/CLMBuildNamelist.pm | 5 ++++- src/biogeophys/BareGroundFluxesMod.F90 | 12 ++++++------ src/biogeophys/CanopyFluxesMod.F90 | 2 +- src/biogeophys/LakeFluxesMod.F90 | 12 ++++++------ src/biogeophys/UrbanFluxesMod.F90 | 16 +++++++++------- 5 files changed, 26 insertions(+), 21 deletions(-) diff --git a/bld/CLMBuildNamelist.pm b/bld/CLMBuildNamelist.pm index 77d0303e07..74fb4d3e7a 100755 --- a/bld/CLMBuildNamelist.pm +++ b/bld/CLMBuildNamelist.pm @@ -3885,7 +3885,10 @@ sub setup_logic_friction_vel { # my ($opts, $nl_flags, $definition, $defaults, $nl) = @_; - add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'zetamaxstable' ); + my $z0param_method = remove_leading_and_trailing_quotes($nl->get_value('z0param_method' )); + + add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'zetamaxstable', + 'z0param_method'=>$z0param_method ); } #------------------------------------------------------------------------------- diff --git a/src/biogeophys/BareGroundFluxesMod.F90 b/src/biogeophys/BareGroundFluxesMod.F90 index 73c169fa13..2b1ac8bcc0 100644 --- a/src/biogeophys/BareGroundFluxesMod.F90 +++ b/src/biogeophys/BareGroundFluxesMod.F90 @@ -117,7 +117,6 @@ subroutine BareGroundFluxes(bounds, num_noexposedvegp, filter_noexposedvegp, & integer :: p,c,g,f,j,l ! indices integer :: iter ! iteration index real(r8) :: zldis(bounds%begp:bounds%endp) ! reference height "minus" zero displacement height [m] - real(r8) :: zeta ! dimensionless height used in Monin-Obukhov theory real(r8) :: wc ! convective velocity [m/s] real(r8) :: dth(bounds%begp:bounds%endp) ! diff of virtual temp. between ref. height and surface real(r8) :: dthv ! diff of vir. poten. temp. between ref. height and surface @@ -239,6 +238,7 @@ subroutine BareGroundFluxes(bounds, num_noexposedvegp, filter_noexposedvegp, & forc_hgt_q_patch => frictionvel_inst%forc_hgt_q_patch , & ! Output: [real(r8) (:) ] observational height of specific humidity at patch level [m] u10_clm => frictionvel_inst%u10_clm_patch , & ! Input: [real(r8) (:) ] 10 m height winds (m/s) zetamax => frictionvel_inst%zetamaxstable , & ! Input: [real(r8) ] max zeta value under stable conditions + zeta => frictionvel_inst%zeta_patch , & ! Output: [real(r8) (:) ] dimensionless stability parameter z0mg_col => frictionvel_inst%z0mg_col , & ! Output: [real(r8) (:) ] roughness length, momentum [m] z0hg_col => frictionvel_inst%z0hg_col , & ! Output: [real(r8) (:) ] roughness length, sensible heat [m] z0qg_col => frictionvel_inst%z0qg_col , & ! Output: [real(r8) (:) ] roughness length, latent heat [m] @@ -369,17 +369,17 @@ subroutine BareGroundFluxes(bounds, num_noexposedvegp, filter_noexposedvegp, & forc_hgt_q_patch(p) = forc_hgt_q_patch(g) + z0qg_patch(p) + displa(p) end if thvstar = tstar*(1._r8+0.61_r8*forc_q(c)) + 0.61_r8*forc_th(c)*qstar - zeta = zldis(p)*vkc*grav*thvstar/(ustar(p)**2*thv(c)) + zeta(p) = zldis(p)*vkc*grav*thvstar/(ustar(p)**2*thv(c)) - if (zeta >= 0._r8) then !stable - zeta = min(zetamax,max(zeta,0.01_r8)) + if (zeta(p) >= 0._r8) then !stable + zeta(p) = min(zetamax,max(zeta(p),0.01_r8)) um(p) = max(ur(p),0.1_r8) else !unstable - zeta = max(-100._r8,min(zeta,-0.01_r8)) + zeta(p) = max(-100._r8,min(zeta(p),-0.01_r8)) wc = beta(c)*(-grav*ustar(p)*thvstar*zii(c)/thv(c))**0.333_r8 um(p) = sqrt(ur(p)*ur(p) + wc*wc) end if - obu(p) = zldis(p)/zeta + obu(p) = zldis(p)/zeta(p) num_iter(p) = iter end do diff --git a/src/biogeophys/CanopyFluxesMod.F90 b/src/biogeophys/CanopyFluxesMod.F90 index 31d73e1b37..9e414251b2 100644 --- a/src/biogeophys/CanopyFluxesMod.F90 +++ b/src/biogeophys/CanopyFluxesMod.F90 @@ -1395,7 +1395,7 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, if(use_biomass_heat_storage) then ! TODO(KWO, 2022-03-15) Only for Meier2022 for now to maintain bfb with ZengWang2007 if (z0param_method == 'Meier2022') then - zeta(p) = min(20._r8,max(zeta(p),0.01_r8)) + zeta(p) = min(zetamax,max(zeta(p),0.01_r8)) else zeta(p) = min(100._r8,max(zeta(p),0.01_r8)) end if diff --git a/src/biogeophys/LakeFluxesMod.F90 b/src/biogeophys/LakeFluxesMod.F90 index 6dc9d1f0c0..edd95628cc 100644 --- a/src/biogeophys/LakeFluxesMod.F90 +++ b/src/biogeophys/LakeFluxesMod.F90 @@ -170,7 +170,6 @@ subroutine LakeFluxes(bounds, num_lakec, filter_lakec, num_lakep, filter_lakep, real(r8) :: ur(bounds%begp:bounds%endp) ! wind speed at reference height [m/s] real(r8) :: ustar(bounds%begp:bounds%endp) ! friction velocity [m/s] real(r8) :: wc ! convective velocity [m/s] - real(r8) :: zeta ! dimensionless height used in Monin-Obukhov theory real(r8) :: zldis(bounds%begp:bounds%endp) ! reference height "minus" zero displacement height [m] real(r8) :: displa(bounds%begp:bounds%endp) ! displacement (always zero) [m] real(r8) :: u2m ! 2 m wind speed (m/s) @@ -239,6 +238,7 @@ subroutine LakeFluxes(bounds, num_lakec, filter_lakec, num_lakep, filter_lakep, forc_hgt_t_patch => frictionvel_inst%forc_hgt_t_patch , & ! Input: [real(r8) (:) ] observational height of temperature at pft level [m] forc_hgt_q_patch => frictionvel_inst%forc_hgt_q_patch , & ! Input: [real(r8) (:) ] observational height of specific humidity at pft level [m] zetamax => frictionvel_inst%zetamaxstable , & ! Input: [real(r8) ] max zeta value under stable conditions + zeta => frictionvel_inst%zeta_patch , & ! Output: [real(r8) (:) ] dimensionless stability parameter ram1 => frictionvel_inst%ram1_patch , & ! Output: [real(r8) (:) ] aerodynamical resistance (s/m) q_ref2m => waterdiagnosticbulk_inst%q_ref2m_patch , & ! Output: [real(r8) (:) ] 2 m height surface specific humidity (kg/kg) @@ -554,17 +554,17 @@ subroutine LakeFluxes(bounds, num_lakec, filter_lakec, num_lakep, filter_lakep, qstar = temp2(p)*dqh(p) thvstar=tstar*(1._r8+0.61_r8*forc_q(c)) + 0.61_r8*forc_th(c)*qstar - zeta=zldis(p)*vkc * grav*thvstar/(ustar(p)**2*thv(c)) + zeta(p)=zldis(p)*vkc * grav*thvstar/(ustar(p)**2*thv(c)) - if (zeta >= 0._r8) then !stable - zeta = min(zetamax,max(zeta,0.01_r8)) + if (zeta(p) >= 0._r8) then !stable + zeta(p) = min(zetamax,max(zeta(p),0.01_r8)) um(p) = max(ur(p),0.1_r8) else !unstable - zeta = max(-100._r8,min(zeta,-0.01_r8)) + zeta(p) = max(-100._r8,min(zeta(p),-0.01_r8)) wc = beta1*(-grav*ustar(p)*thvstar*zii/thv(c))**0.333_r8 um(p) = sqrt(ur(p)*ur(p)+wc*wc) end if - obu(p) = zldis(p)/zeta + obu(p) = zldis(p)/zeta(p) if (obuold(p)*obu(p) < 0._r8) nmozsgn(p) = nmozsgn(p)+1 diff --git a/src/biogeophys/UrbanFluxesMod.F90 b/src/biogeophys/UrbanFluxesMod.F90 index d02433a5bb..74f0d2612d 100644 --- a/src/biogeophys/UrbanFluxesMod.F90 +++ b/src/biogeophys/UrbanFluxesMod.F90 @@ -146,6 +146,7 @@ subroutine UrbanFluxes (bounds, num_nourbanl, filter_nourbanl, real(r8) :: dth(bounds%begl:bounds%endl) ! diff of virtual temp. between ref. height and surface real(r8) :: dqh(bounds%begl:bounds%endl) ! diff of humidity between ref. height and surface real(r8) :: zldis(bounds%begl:bounds%endl) ! reference height "minus" zero displacement height (m) + real(r8) :: zeta_lunit(bounds%begl:bounds%endl) ! landunit-level dimensionless stability parameter real(r8) :: um(bounds%begl:bounds%endl) ! wind speed including the stablity effect (m/s) real(r8) :: obu(bounds%begl:bounds%endl) ! Monin-Obukhov length (m) real(r8) :: taf_numer(bounds%begl:bounds%endl) ! numerator of taf equation (K m/s) @@ -187,7 +188,6 @@ subroutine UrbanFluxes (bounds, num_nourbanl, filter_nourbanl, real(r8) :: wtus_shadewall_unscl(bounds%begl:bounds%endl) ! sensible heat conductance for shadewall (not scaled) (m/s) real(r8) :: wtuq_shadewall_unscl(bounds%begl:bounds%endl) ! latent heat conductance for shadewall (not scaled) (m/s) real(r8) :: wc ! convective velocity (m/s) - real(r8) :: zeta ! dimensionless height used in Monin-Obukhov theory real(r8) :: eflx_sh_grnd_scale(bounds%begp:bounds%endp) ! scaled sensible heat flux from ground (W/m**2) [+ to atm] real(r8) :: qflx_evap_soi_scale(bounds%begp:bounds%endp) ! scaled soil evaporation (mm H2O/s) (+ = to atm) real(r8) :: eflx_wasteheat_roof(bounds%begl:bounds%endl) ! sensible heat flux from urban heating/cooling sources of waste heat for roof (W/m**2) @@ -293,6 +293,7 @@ subroutine UrbanFluxes (bounds, num_nourbanl, filter_nourbanl, forc_hgt_u_patch => frictionvel_inst%forc_hgt_u_patch , & ! Input: [real(r8) (:) ] observational height of wind at patch-level (m) forc_hgt_t_patch => frictionvel_inst%forc_hgt_t_patch , & ! Input: [real(r8) (:) ] observational height of temperature at patch-level (m) zetamax => frictionvel_inst%zetamaxstable , & ! Input: [real(r8) ] max zeta value under stable conditions + zeta => frictionvel_inst%zeta_patch , & ! Output: [real(r8) (:) ] dimensionless stability parameter ram1 => frictionvel_inst%ram1_patch , & ! Output: [real(r8) (:) ] aerodynamical resistance (s/m) u10_clm => frictionvel_inst%u10_clm_patch , & ! Input: [real(r8) (:) ] 10 m height winds (m/s) @@ -652,18 +653,18 @@ subroutine UrbanFluxes (bounds, num_nourbanl, filter_nourbanl, tstar = temp1(l)*dth(l) qstar = temp2(l)*dqh(l) thvstar = tstar*(1._r8+0.61_r8*forc_q(g)) + 0.61_r8*forc_th(g)*qstar - zeta = zldis(l)*vkc*grav*thvstar/(ustar(l)**2*thv_g(l)) + zeta_lunit(l) = zldis(l)*vkc*grav*thvstar/(ustar(l)**2*thv_g(l)) - if (zeta >= 0._r8) then !stable - zeta = min(zetamax,max(zeta,0.01_r8)) + if (zeta_lunit(l) >= 0._r8) then !stable + zeta_lunit(l) = min(zetamax,max(zeta_lunit(l),0.01_r8)) um(l) = max(ur(l),0.1_r8) else !unstable - zeta = max(-100._r8,min(zeta,-0.01_r8)) + zeta_lunit(l) = max(-100._r8,min(zeta_lunit(l),-0.01_r8)) wc = beta(l)*(-grav*ustar(l)*thvstar*zii(l)/thv_g(l))**0.333_r8 um(l) = sqrt(ur(l)*ur(l) + wc*wc) end if - obu(l) = zldis(l)/zeta + obu(l) = zldis(l)/zeta_lunit(l) end do end do ! end iteration @@ -682,7 +683,8 @@ subroutine UrbanFluxes (bounds, num_nourbanl, filter_nourbanl, g = patch%gridcell(p) l = patch%landunit(p) - ram1(p) = ramu(l) !pass value to global variable + ram1(p) = ramu(l) !pass value to global variable + zeta(p) = zeta_lunit(l) !pass value to global variable ! Upward and downward canopy longwave are zero From ed9610b0e38cce17658af4455f7ad300d07bbedc Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Tue, 18 Oct 2022 14:51:00 -0600 Subject: [PATCH 045/257] Remove use_z0mg_2d code to read in roughness from surface dataset that work will be brought in with seperate work --- .../clm/Meier2022_surf_rough_all_f09NonCrop/include_user_mods | 1 - .../clm/Meier2022_surf_rough_all_f09NonCrop/user_nl_clm | 2 -- .../clm/Meier2022_surf_rough_all_hcruNonCrop/include_user_mods | 1 - .../clm/Meier2022_surf_rough_all_hcruNonCrop/user_nl_clm | 2 -- 4 files changed, 6 deletions(-) delete mode 100644 cime_config/testdefs/testmods_dirs/clm/Meier2022_surf_rough_all_f09NonCrop/include_user_mods delete mode 100644 cime_config/testdefs/testmods_dirs/clm/Meier2022_surf_rough_all_f09NonCrop/user_nl_clm delete mode 100644 cime_config/testdefs/testmods_dirs/clm/Meier2022_surf_rough_all_hcruNonCrop/include_user_mods delete mode 100644 cime_config/testdefs/testmods_dirs/clm/Meier2022_surf_rough_all_hcruNonCrop/user_nl_clm diff --git a/cime_config/testdefs/testmods_dirs/clm/Meier2022_surf_rough_all_f09NonCrop/include_user_mods b/cime_config/testdefs/testmods_dirs/clm/Meier2022_surf_rough_all_f09NonCrop/include_user_mods deleted file mode 100644 index 38bef34f6e..0000000000 --- a/cime_config/testdefs/testmods_dirs/clm/Meier2022_surf_rough_all_f09NonCrop/include_user_mods +++ /dev/null @@ -1 +0,0 @@ -../Meier2022_surf_rough diff --git a/cime_config/testdefs/testmods_dirs/clm/Meier2022_surf_rough_all_f09NonCrop/user_nl_clm b/cime_config/testdefs/testmods_dirs/clm/Meier2022_surf_rough_all_f09NonCrop/user_nl_clm deleted file mode 100644 index 0a33a7a06c..0000000000 --- a/cime_config/testdefs/testmods_dirs/clm/Meier2022_surf_rough_all_f09NonCrop/user_nl_clm +++ /dev/null @@ -1,2 +0,0 @@ -use_z0mg_2d = .true. -fsurdat = '/glade/p/cesm/lmwg_dev/oleson/Z0_RonnieMeier/surfdata_0.9x1.25_hist_16pfts_Irrig_CMIP6_simyr2000_c210624.nc' diff --git a/cime_config/testdefs/testmods_dirs/clm/Meier2022_surf_rough_all_hcruNonCrop/include_user_mods b/cime_config/testdefs/testmods_dirs/clm/Meier2022_surf_rough_all_hcruNonCrop/include_user_mods deleted file mode 100644 index 38bef34f6e..0000000000 --- a/cime_config/testdefs/testmods_dirs/clm/Meier2022_surf_rough_all_hcruNonCrop/include_user_mods +++ /dev/null @@ -1 +0,0 @@ -../Meier2022_surf_rough diff --git a/cime_config/testdefs/testmods_dirs/clm/Meier2022_surf_rough_all_hcruNonCrop/user_nl_clm b/cime_config/testdefs/testmods_dirs/clm/Meier2022_surf_rough_all_hcruNonCrop/user_nl_clm deleted file mode 100644 index 6043dae4af..0000000000 --- a/cime_config/testdefs/testmods_dirs/clm/Meier2022_surf_rough_all_hcruNonCrop/user_nl_clm +++ /dev/null @@ -1,2 +0,0 @@ -use_z0mg_2d = .true. -fsurdat = ' /glade/p/cesm/lmwg_dev/oleson/Z0_RonnieMeier/surfdata_360x720cru_16pfts_Irrig_CMIP6_simyr2000_c210624_2D.nc' From 0badb306998eea02dfa54896cdc689f4c47c94b8 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Tue, 18 Oct 2022 14:55:07 -0600 Subject: [PATCH 046/257] Remove more use_z0mg_2d --- bld/CLMBuildNamelist.pm | 2 - bld/namelist_files/namelist_defaults_ctsm.xml | 6 -- .../namelist_definition_ctsm.xml | 6 -- cime_config/testdefs/ExpectedTestFails.xml | 7 -- cime_config/testdefs/testlist_clm.xml | 18 ----- .../clm/Meier2022_surf_rough/user_nl_clm | 1 - src/biogeophys/FrictionVelocityMod.F90 | 68 +------------------ src/main/clm_varctl.F90 | 1 - src/main/controlMod.F90 | 3 +- 9 files changed, 3 insertions(+), 109 deletions(-) diff --git a/bld/CLMBuildNamelist.pm b/bld/CLMBuildNamelist.pm index 77d0303e07..eb9b6a2644 100755 --- a/bld/CLMBuildNamelist.pm +++ b/bld/CLMBuildNamelist.pm @@ -4156,8 +4156,6 @@ sub setup_logic_z0param { my $z0param_method = remove_leading_and_trailing_quotes($nl->get_value('z0param_method' )); add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'use_z0m_snowmelt', 'z0param_method'=>$z0param_method ); - add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'use_z0mg_2d', - 'z0param_method'=>$z0param_method ); } #------------------------------------------------------------------------------- diff --git a/bld/namelist_files/namelist_defaults_ctsm.xml b/bld/namelist_files/namelist_defaults_ctsm.xml index ea0b9f321c..6fb73aa693 100644 --- a/bld/namelist_files/namelist_defaults_ctsm.xml +++ b/bld/namelist_files/namelist_defaults_ctsm.xml @@ -501,12 +501,6 @@ attributes from the config_cache.xml file (with keys converted to upper-case). .false. .false. -.true. -.false. -.true. - - - diff --git a/bld/namelist_files/namelist_definition_ctsm.xml b/bld/namelist_files/namelist_definition_ctsm.xml index e2e84859ea..25b23050cd 100644 --- a/bld/namelist_files/namelist_definition_ctsm.xml +++ b/bld/namelist_files/namelist_definition_ctsm.xml @@ -2777,12 +2777,6 @@ If TRUE use parameterization of snow z0m as a function of accumulated snow melt of Brock et al. (2006) - -If FALSE use constant ground z0m -If TRUE use spatially explicit ground z0m from Prigent et al. (2005) - - diff --git a/cime_config/testdefs/ExpectedTestFails.xml b/cime_config/testdefs/ExpectedTestFails.xml index b78eeb7509..56351ccfba 100644 --- a/cime_config/testdefs/ExpectedTestFails.xml +++ b/cime_config/testdefs/ExpectedTestFails.xml @@ -37,13 +37,6 @@ - - - FAIL - Half degree resolution issue - - - FAIL diff --git a/cime_config/testdefs/testlist_clm.xml b/cime_config/testdefs/testlist_clm.xml index 8486c7fa04..35fdd3b979 100644 --- a/cime_config/testdefs/testlist_clm.xml +++ b/cime_config/testdefs/testlist_clm.xml @@ -1315,24 +1315,6 @@ - - - - - - - - - - - - - - - - - - diff --git a/cime_config/testdefs/testmods_dirs/clm/Meier2022_surf_rough/user_nl_clm b/cime_config/testdefs/testmods_dirs/clm/Meier2022_surf_rough/user_nl_clm index 86903538e2..00f8b1faf8 100644 --- a/cime_config/testdefs/testmods_dirs/clm/Meier2022_surf_rough/user_nl_clm +++ b/cime_config/testdefs/testmods_dirs/clm/Meier2022_surf_rough/user_nl_clm @@ -1,6 +1,5 @@ z0param_method = 'Meier2022' use_z0m_snowmelt = .true. -use_z0mg_2d = .false. calc_human_stress_indices = 'NONE' ! Currently dies when turned on because of a negative humidity (about -31) in Wet Bulb calculation paramfile = '$DIN_LOC_ROOT/lnd/clm2/paramdata/ctsm51_params.RMz0.c220304.nc' diff --git a/src/biogeophys/FrictionVelocityMod.F90 b/src/biogeophys/FrictionVelocityMod.F90 index 4f72215381..d831b42b97 100644 --- a/src/biogeophys/FrictionVelocityMod.F90 +++ b/src/biogeophys/FrictionVelocityMod.F90 @@ -13,7 +13,7 @@ module FrictionVelocityMod use decompMod , only : bounds_type use abortutils , only : endrun use clm_varcon , only : spval - use clm_varctl , only : use_cn, use_luna, z0param_method, use_z0mg_2d, use_z0m_snowmelt + use clm_varctl , only : use_cn, use_luna, z0param_method, use_z0m_snowmelt use LandunitType , only : lun use ColumnType , only : col use PatchType , only : patch @@ -95,7 +95,6 @@ module FrictionVelocityMod procedure, private :: InitCold procedure, private :: ReadNamelist procedure, private :: ReadParams - procedure, private :: ReadZ0M procedure, private, nopass :: StabilityFunc1 ! Stability function for rib < 0. procedure, private, nopass :: StabilityFunc2 ! Stability function for rib < 0. @@ -121,10 +120,6 @@ subroutine Init(this, bounds, NLFilename, params_ncid) call this%ReadNamelist(NLFilename) call this%ReadParams(params_ncid) - if(use_z0mg_2d) then - call this%ReadZ0M(bounds) - end if - end subroutine Init !------------------------------------------------------------------------ @@ -414,57 +409,6 @@ subroutine ReadParams( this, params_ncid ) end subroutine ReadParams - !----------------------------------------------------------------------- - subroutine ReadZ0M(this, bounds) - ! - ! !DESCRIPTION: - ! Initialize module time constant variables - ! - ! !USES: - use shr_log_mod, only : errMsg => shr_log_errMsg - use fileutils , only : getfil - use ncdio_pio , only : file_desc_t, ncd_defvar, ncd_io, ncd_pio_openfile, ncd_pio_closefile - use spmdMod , only : masterproc - use clm_varcon , only : grlnd - use clm_varctl , only : fsurdat - use ncdio_pio , only : ncd_io - use clm_varctl , only : iulog - - ! - ! !ARGUMENTS: - class(frictionvel_type) :: this - type(bounds_type), intent(in) :: bounds - ! - ! !LOCAL VARIABLES: - integer :: c,g ! indices - type(file_desc_t) :: ncid ! netcdf id - character(len=256) :: locfn ! local filename - integer :: ier ! error status - logical :: readvar - real(r8), pointer :: z0mg2d (:) ! read in - ground z0m - !--------------------------------------------------------------------- - - ! Allocate module variable for ground z0m - - - call getfil (fsurdat, locfn, 0) - call ncd_pio_openfile (ncid, locfn, 0) - - - allocate(z0mg2d(bounds%begg:bounds%endg)) - call ncd_io(ncid=ncid, varname='Z0MG_2D', flag='read', data=z0mg2d, dim1name=grlnd, readvar=readvar) - if (.not. readvar) then - call endrun(msg=' ERROR: Z0MG_2D NOT on surfdata file'//errMsg(sourcefile, __LINE__)) - end if - write(iulog,*) 'Writing z0mg2d' - do c = bounds%begc, bounds%endc - g = col%gridcell(c) - this%z0mg_2D_col(c) = max(1.e-4_r8,z0mg2d(g)) - end do - deallocate(z0mg2d) - - end subroutine ReadZ0M - !------------------------------------------------------------------------ subroutine Restart(this, bounds, ncid, flag) ! @@ -637,12 +581,7 @@ subroutine SetRoughnessLengthsAndForcHeightsNonLake(this, bounds, & z0mg(c) = this%zsno end if else - if(use_z0mg_2d) then - z0mg(c) = z0mg_2D(c) - else - z0mg(c) = this%zlnd - end if - + z0mg(c) = this%zlnd end if case ('Meier2022') ! Bare ground and ice have a different value l = col%landunit(c) @@ -664,9 +603,6 @@ subroutine SetRoughnessLengthsAndForcHeightsNonLake(this, bounds, & else - if(use_z0mg_2d) then - z0mg(c) = z0mg_2D(c) - else z0mg(c) = this%zlnd end if diff --git a/src/main/clm_varctl.F90 b/src/main/clm_varctl.F90 index 6fe2c55692..7e14f64a3f 100644 --- a/src/main/clm_varctl.F90 +++ b/src/main/clm_varctl.F90 @@ -226,7 +226,6 @@ module clm_varctl character(len=64), public :: z0param_method logical, public :: use_z0m_snowmelt = .false. ! true => use snow z0m parameterization of Brock2006 - logical, public :: use_z0mg_2d = .false. ! true => use 2D ground z0m of Prigent2005 !---------------------------------------------------------- diff --git a/src/main/controlMod.F90 b/src/main/controlMod.F90 index 427a95f98c..b06e852347 100644 --- a/src/main/controlMod.F90 +++ b/src/main/controlMod.F90 @@ -202,7 +202,7 @@ subroutine control_init(dtime) soil_layerstruct_userdefined_nlevsoi, use_subgrid_fluxes, snow_cover_fraction_method, & irrigate, run_zero_weight_urban, all_active, & crop_fsat_equals_zero, for_testing_run_ncdiopio_tests, & - z0param_method, use_z0m_snowmelt, use_z0mg_2d + z0param_method, use_z0m_snowmelt ! vertical soil mixing variables namelist /clm_inparm/ & @@ -784,7 +784,6 @@ subroutine control_spmd() call mpi_bcast (snow_cover_fraction_method , len(snow_cover_fraction_method), MPI_CHARACTER, 0, mpicom, ier) call mpi_bcast (z0param_method , len(z0param_method), MPI_CHARACTER, 0, mpicom, ier) call mpi_bcast (use_z0m_snowmelt, 1, MPI_LOGICAL, 0, mpicom, ier) - call mpi_bcast (use_z0mg_2d, 1, MPI_LOGICAL, 0, mpicom, ier) call mpi_bcast (single_column,1, MPI_LOGICAL, 0, mpicom, ier) call mpi_bcast (scmlat, 1, MPI_REAL8,0, mpicom, ier) call mpi_bcast (scmlon, 1, MPI_REAL8,0, mpicom, ier) From 357fea5eac6ca4ec7d40aad8661d91783bddfdea Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Wed, 19 Oct 2022 09:14:22 -0600 Subject: [PATCH 047/257] Correct so will compile --- src/biogeophys/FrictionVelocityMod.F90 | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/src/biogeophys/FrictionVelocityMod.F90 b/src/biogeophys/FrictionVelocityMod.F90 index d831b42b97..71fdd30cd3 100644 --- a/src/biogeophys/FrictionVelocityMod.F90 +++ b/src/biogeophys/FrictionVelocityMod.F90 @@ -603,9 +603,7 @@ subroutine SetRoughnessLengthsAndForcHeightsNonLake(this, bounds, & else - z0mg(c) = this%zlnd - - end if + z0mg(c) = this%zlnd end if end select From e5cd7b02b86ed1d22557216583fb3fe4ede09d18 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Wed, 19 Oct 2022 11:25:42 -0600 Subject: [PATCH 048/257] Use parenthesis to clarify statement as required by the nag compiler on izumi --- src/biogeophys/FrictionVelocityMod.F90 | 2 +- src/biogeophys/LakeFluxesMod.F90 | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/src/biogeophys/FrictionVelocityMod.F90 b/src/biogeophys/FrictionVelocityMod.F90 index 05e6e40cff..5cd39b8319 100644 --- a/src/biogeophys/FrictionVelocityMod.F90 +++ b/src/biogeophys/FrictionVelocityMod.F90 @@ -577,7 +577,7 @@ subroutine SetRoughnessLengthsAndForcHeightsNonLake(this, bounds, & if (frac_sno(c) > 0._r8) then if(use_z0m_snowmelt) then if ( snomelt_accum(c) < 1.e-5_r8 )then - z0mg(c) = exp(1.4_r8 * -rpi/2.0_r8 -0.31_r8) / 1000._r8 + z0mg(c) = exp( (1.4_r8 * (-rpi/2.0_r8)) -0.31_r8) / 1000._r8 else z0mg(c) = exp(1.4_r8 * (atan((log10(snomelt_accum(c))+0.23_r8)/0.08_r8))-0.31_r8) / 1000._r8 end if diff --git a/src/biogeophys/LakeFluxesMod.F90 b/src/biogeophys/LakeFluxesMod.F90 index 8aa2aa4a4f..38ecbc6fbb 100644 --- a/src/biogeophys/LakeFluxesMod.F90 +++ b/src/biogeophys/LakeFluxesMod.F90 @@ -366,7 +366,7 @@ subroutine LakeFluxes(bounds, num_lakec, filter_lakec, num_lakep, filter_lakep, case ('ZengWang2007') if(use_z0m_snowmelt) then if ( snomelt_accum(c) < 1.e-5_r8 ) then - z0mg(p) = exp(1.4_r8 * -rpi/2.0_r8 -0.31_r8) / 1000._r8 + z0mg(p) = exp((1.4_r8 * (-rpi/2.0_r8)) -0.31_r8) / 1000._r8 else z0mg(p) = exp(1.4_r8 * (atan((log10(snomelt_accum(c))+0.23_r8)/0.08_r8))-0.31_r8) / 1000._r8 end if From ff2e75674d227b2ca3ffb1f3a6c94595138c219e Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Fri, 27 Jan 2023 13:28:47 -0500 Subject: [PATCH 049/257] Mocked up the updated cbalance checking with fates --- src/biogeochem/CNBalanceCheckMod.F90 | 52 ++++++++++++++++++++++------ 1 file changed, 42 insertions(+), 10 deletions(-) diff --git a/src/biogeochem/CNBalanceCheckMod.F90 b/src/biogeochem/CNBalanceCheckMod.F90 index b038536a5c..bbeed11e46 100644 --- a/src/biogeochem/CNBalanceCheckMod.F90 +++ b/src/biogeochem/CNBalanceCheckMod.F90 @@ -207,6 +207,10 @@ subroutine CBalanceCheck(this, bounds, num_soilc, filter_soilc, & ! ! !DESCRIPTION: ! Perform carbon mass conservation check for column and patch + ! + ! Note on FATES: On fates colums, there is no vegetation biomass + ! and no gpp flux. There is a litter input flux. + ! ! !ARGUMENTS: class(cn_balance_type) , intent(inout) :: this @@ -230,6 +234,9 @@ subroutine CBalanceCheck(this, bounds, num_soilc, filter_soilc, & real(r8) :: som_c_leached_grc(bounds%begg:bounds%endg) real(r8) :: hrv_xsmrpool_amount_left_to_dribble(bounds%begg:bounds%endg) real(r8) :: dwt_conv_cflux_amount_left_to_dribble(bounds%begg:bounds%endg) + + !real(r8) :: totcol_c ! Total column carbon, including veg and soil (kgC) + !----------------------------------------------------------------------- associate( & @@ -262,17 +269,42 @@ subroutine CBalanceCheck(this, bounds, num_soilc, filter_soilc, & do fc = 1,num_soilc c = filter_soilc(fc) - ! calculate the total column-level carbon storage, for mass conservation check - col_endcb(c) = totcolc(c) - - ! calculate total column-level inputs - col_cinputs = gpp(c) - - ! calculate total column-level outputs - ! er = ar + hr, col_fire_closs includes patch-level fire losses - col_coutputs = er(c) + col_fire_closs(c) + col_hrv_xsmrpool_to_atm(c) + & - col_xsmrpool_to_atm(c) + if (use_cn) then + ! calculate the total column-level carbon storage, for mass conservation check + col_endcb(c) = totcolc(c) + + ! calculate total column-level inputs + col_cinputs = gpp(c) + + ! calculate total column-level outputs + ! er = ar + hr, col_fire_closs includes patch-level fire losses + col_coutputs = er(c) + col_fire_closs(c) + col_hrv_xsmrpool_to_atm(c) + & + col_xsmrpool_to_atm(c) + + elseif(use_fates) then + + ! calculate the total column-level carbon storage, for mass conservation check + col_endcb(c) = soilbiogeochem_totmicc_col(c) + & + soilbiogeochem_totlitc_col(c) + & + soilbiogeochem_totsomc_col(c) + & + soilbiogeochem_ctrunc_col(c) + + ! calculate total column-level inputs (litter fluxes) + col_cinputs = sum(this%fates(nc)%bc_out(s)%litt_flux_lab_c_si(1:nlevdecomp) * & + this%fates(nc)%bc_in(s)%dz_decomp_sisl(1:nlevdecomp)) + & + sum(this%fates(nc)%bc_out(s)%litt_flux_cel_c_si(1:nlevdecomp) * & + this%fates(nc)%bc_in(s)%dz_decomp_sisl(1:nlevdecomp)) + & + sum(this%fates(nc)%bc_out(s)%litt_flux_lig_c_si(1:nlevdecomp) * & + this%fates(nc)%bc_in(s)%dz_decomp_sisl(1:nlevdecomp)) + + ! calculate total column-level outputs + ! fates has already exported burn losses and fluxes to the atm + ! So they are irrelevant here + col_coutputs = er(c) + + end if + ! Fluxes to product pools are included in column-level outputs: the product ! pools are not included in totcolc, so are outside the system with respect to ! these balance checks. (However, the dwt flux to product pools is NOT included, From 55f0af22d41b3e2c2318589ea625c0c5f28a6b84 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Fri, 3 Feb 2023 17:41:47 -0500 Subject: [PATCH 050/257] Incremental progress towareds converting fates-clm carbon accounting to using native calls and not EDBGCMod. --- src/biogeochem/CNBalanceCheckMod.F90 | 81 ++++++++----- src/biogeochem/CNCStateUpdate1Mod.F90 | 110 ++++++++--------- src/biogeochem/CNDriverMod.F90 | 19 +-- src/biogeochem/CNVegetationFacade.F90 | 43 ++++--- src/biogeophys/WaterDiagnosticType.F90 | 17 +-- src/main/clm_driver.F90 | 160 ++++++++++++------------- src/main/filterMod.F90 | 52 +++++++- src/utils/clmfates_interfaceMod.F90 | 92 ++++++++------ 8 files changed, 335 insertions(+), 239 deletions(-) diff --git a/src/biogeochem/CNBalanceCheckMod.F90 b/src/biogeochem/CNBalanceCheckMod.F90 index bbeed11e46..a681ee5c4e 100644 --- a/src/biogeochem/CNBalanceCheckMod.F90 +++ b/src/biogeochem/CNBalanceCheckMod.F90 @@ -159,7 +159,7 @@ end subroutine BeginCNGridcellBalance !----------------------------------------------------------------------- subroutine BeginCNColumnBalance(this, bounds, num_soilc, filter_soilc, & - cnveg_carbonstate_inst, cnveg_nitrogenstate_inst) + cnveg_carbonstate_inst, cnveg_nitrogenstate_inst,soilbiogeochem_carbonstate_inst) ! ! !DESCRIPTION: ! Calculate beginning column-level carbon/nitrogen balance, for mass conservation check @@ -175,6 +175,7 @@ subroutine BeginCNColumnBalance(this, bounds, num_soilc, filter_soilc, & integer , intent(in) :: filter_soilc(:) ! filter for soil columns type(cnveg_carbonstate_type) , intent(in) :: cnveg_carbonstate_inst type(cnveg_nitrogenstate_type) , intent(in) :: cnveg_nitrogenstate_inst + type(soilbiogeochem_carbonstate_type), intent(in) :: soilbiogeochem_carbonstate_inst ! ! !LOCAL VARIABLES: integer :: fc,c @@ -189,8 +190,16 @@ subroutine BeginCNColumnBalance(this, bounds, num_soilc, filter_soilc, & do fc = 1,num_soilc c = filter_soilc(fc) - col_begcb(c) = totcolc(c) - col_begnb(c) = totcoln(c) + + if( is_fates(c) ) then + col_begcb(c) = soilbiogeochem_carbonstate_inst%totmicc_col(c) + & + soilbiogeochem_carbonstate_inst%totlitc_col(c) + & + soilbiogeochem_carbonstate_inst%totsomc_col(c) + & + soilbiogeochem_carbonstate_inst%ctrunc_col(c) + else + col_begcb(c) = totcolc(c) + col_begnb(c) = totcoln(c) + end if end do end associate @@ -199,11 +208,13 @@ end subroutine BeginCNColumnBalance !----------------------------------------------------------------------- subroutine CBalanceCheck(this, bounds, num_soilc, filter_soilc, & - soilbiogeochem_carbonflux_inst, cnveg_carbonflux_inst, & - cnveg_carbonstate_inst, c_products_inst) + soilbiogeochem_carbonflux_inst, soilbiogeochem_carbonstate_inst, & + cnveg_carbonflux_inst, cnveg_carbonstate_inst, c_products_inst, & + clm_fates) ! ! !USES: use subgridAveMod, only: c2g + use clm_varpar , only: nlevdecomp ! ! !DESCRIPTION: ! Perform carbon mass conservation check for column and patch @@ -218,13 +229,18 @@ subroutine CBalanceCheck(this, bounds, num_soilc, filter_soilc, & integer , intent(in) :: num_soilc ! number of soil columns in filter integer , intent(in) :: filter_soilc(:) ! filter for soil columns type(soilbiogeochem_carbonflux_type) , intent(in) :: soilbiogeochem_carbonflux_inst + type(soilbiogeochem_carbonstate_type), intent(in) :: soilbiogeochem_carbonstate_inst type(cnveg_carbonflux_type) , intent(in) :: cnveg_carbonflux_inst type(cnveg_carbonstate_type) , intent(inout) :: cnveg_carbonstate_inst type(cn_products_type) , intent(in) :: c_products_inst + type(hlm_fates_interface_type) , intent(inout) :: clm_fates + ! ! !LOCAL VARIABLES: - integer :: c, g, err_index ! indices + integer :: c, g, err_index ! indices + integer :: s ! fates site index (follows c) integer :: fc ! lake filter indices + integer :: ic ! index of the current clump logical :: err_found ! error flag real(r8) :: dt ! radiation time step (seconds) real(r8) :: col_cinputs, grc_cinputs @@ -235,8 +251,6 @@ subroutine CBalanceCheck(this, bounds, num_soilc, filter_soilc, & real(r8) :: hrv_xsmrpool_amount_left_to_dribble(bounds%begg:bounds%endg) real(r8) :: dwt_conv_cflux_amount_left_to_dribble(bounds%begg:bounds%endg) - !real(r8) :: totcol_c ! Total column carbon, including veg and soil (kgC) - !----------------------------------------------------------------------- associate( & @@ -265,11 +279,39 @@ subroutine CBalanceCheck(this, bounds, num_soilc, filter_soilc, & ! set time steps dt = get_step_size_real() + ! clump index + ic = bounds%clump_index + err_found = .false. do fc = 1,num_soilc c = filter_soilc(fc) - if (use_cn) then + if( is_fates(c) ) then + + ! calculate the total column-level carbon storage, for mass conservation check + col_endcb(c) = soilbiogeochem_carbonstate_inst%totmicc_col(c) + & + soilbiogeochem_carbonstate_inst%totlitc_col(c) + & + soilbiogeochem_carbonstate_inst%totsomc_col(c) + & + soilbiogeochem_carbonstate_inst%ctrunc_col(c) + + ! calculate total column-level inputs (litter fluxes) [g/m2/s] + s = clm_fates%f2hmap(ic)%hsites(c) + col_cinputs = sum(clm_fates%fates(ic)%bc_out(s)%litt_flux_lab_c_si(1:nlevdecomp) * & + clm_fates%fates(ic)%bc_in(s)%dz_decomp_sisl(1:nlevdecomp)) + & + sum(clm_fates%fates(ic)%bc_out(s)%litt_flux_cel_c_si(1:nlevdecomp) * & + clm_fates%fates(ic)%bc_in(s)%dz_decomp_sisl(1:nlevdecomp)) + & + sum(clm_fates%fates(ic)%bc_out(s)%litt_flux_lig_c_si(1:nlevdecomp) * & + clm_fates%fates(ic)%bc_in(s)%dz_decomp_sisl(1:nlevdecomp)) + + ! calculate total column-level outputs + ! fates has already exported burn losses and fluxes to the atm + ! So they are irrelevant here + ! (gC/m2/s) total heterotrophic respiration + col_coutputs = soilbiogeochem_carbonflux_inst%hr_col(c) + + + else + ! calculate the total column-level carbon storage, for mass conservation check col_endcb(c) = totcolc(c) @@ -281,27 +323,6 @@ subroutine CBalanceCheck(this, bounds, num_soilc, filter_soilc, & col_coutputs = er(c) + col_fire_closs(c) + col_hrv_xsmrpool_to_atm(c) + & col_xsmrpool_to_atm(c) - elseif(use_fates) then - - ! calculate the total column-level carbon storage, for mass conservation check - col_endcb(c) = soilbiogeochem_totmicc_col(c) + & - soilbiogeochem_totlitc_col(c) + & - soilbiogeochem_totsomc_col(c) + & - soilbiogeochem_ctrunc_col(c) - - ! calculate total column-level inputs (litter fluxes) - col_cinputs = sum(this%fates(nc)%bc_out(s)%litt_flux_lab_c_si(1:nlevdecomp) * & - this%fates(nc)%bc_in(s)%dz_decomp_sisl(1:nlevdecomp)) + & - sum(this%fates(nc)%bc_out(s)%litt_flux_cel_c_si(1:nlevdecomp) * & - this%fates(nc)%bc_in(s)%dz_decomp_sisl(1:nlevdecomp)) + & - sum(this%fates(nc)%bc_out(s)%litt_flux_lig_c_si(1:nlevdecomp) * & - this%fates(nc)%bc_in(s)%dz_decomp_sisl(1:nlevdecomp)) - - ! calculate total column-level outputs - ! fates has already exported burn losses and fluxes to the atm - ! So they are irrelevant here - col_coutputs = er(c) - end if diff --git a/src/biogeochem/CNCStateUpdate1Mod.F90 b/src/biogeochem/CNCStateUpdate1Mod.F90 index 843754f3cd..2d88977b5f 100644 --- a/src/biogeochem/CNCStateUpdate1Mod.F90 +++ b/src/biogeochem/CNCStateUpdate1Mod.F90 @@ -25,6 +25,8 @@ module CNCStateUpdate1Mod use PatchType , only : patch use clm_varctl , only : use_fates, use_cn, iulog, use_fates_sp use CNSharedParamsMod , only : use_matrixcn + use CLMFatesInterfaceMod , only : hlm_fates_interface_type + ! implicit none private @@ -123,8 +125,6 @@ subroutine CStateUpdate0(num_soilp, filter_soilp, & ! set time steps dt = get_step_size_real() - - ! gross photosynthesis fluxes do fp = 1,num_soilp p = filter_soilp(fp) @@ -140,7 +140,8 @@ end subroutine CStateUpdate0 !----------------------------------------------------------------------- subroutine CStateUpdate1( num_soilc, filter_soilc, num_soilp, filter_soilp, & crop_inst, cnveg_carbonflux_inst, cnveg_carbonstate_inst, & - soilbiogeochem_carbonflux_inst, dribble_crophrv_xsmrpool_2atm) + soilbiogeochem_carbonflux_inst, dribble_crophrv_xsmrpool_2atm, & + clm_fates) ! ! !DESCRIPTION: ! On the radiation time step, update all the prognostic carbon state @@ -157,6 +158,7 @@ subroutine CStateUpdate1( num_soilc, filter_soilc, num_soilp, filter_soilp, & type(cnveg_carbonstate_type) , intent(inout) :: cnveg_carbonstate_inst type(soilbiogeochem_carbonflux_type) , intent(inout) :: soilbiogeochem_carbonflux_inst logical , intent(in) :: dribble_crophrv_xsmrpool_2atm + type(hlm_fates_interface_type) , intent(inout) :: clm_fates ! ! !LOCAL VARIABLES: integer :: c,p,j,k,l,i ! indices @@ -186,12 +188,23 @@ subroutine CStateUpdate1( num_soilc, filter_soilc, num_soilp, filter_soilp, & dt = get_step_size_real() ! Below is the input into the soil biogeochemistry model - - ! plant to litter fluxes - if (.not. use_fates) then - do j = 1,nlevdecomp - do fc = 1,num_soilc - c = filter_soilc(fc) + + fc_loop: do fc = 1,num_soilc + c = filter_soilc(fc) + + fates_if: if( col%is_fates(c) ) then + + ! If this is a fates column, then we ask fates for the + ! litter fluxes, the following routine simply copies + ! prepared litter c flux boundary conditions into + ! cf_soil%decomp_cpools_sourcesink_col + + call clm_fates%UpdateCLitterfluxes(bounds_clump,cf_soil,c) + + else + + do j = 1,nlevdecomp + ! ! State update without the matrix solution ! @@ -206,35 +219,40 @@ subroutine CStateUpdate1( num_soilc, filter_soilc, num_soilp, filter_soilp, & ! terms have been moved to CStateUpdateDynPatch. I think this is zeroed every ! time step, but to be safe, I'm explicitly setting it to zero here. cf_soil%decomp_cpools_sourcesink_col(c,j,i_cwd) = 0._r8 - ! - ! For the matrix solution the actual state update comes after the matrix - ! multiply in SoilMatrix, but the matrix needs to be setup with - ! the equivalent of above. Those changes can be here or in the - ! native subroutines dealing with that field - ! + ! + ! For the matrix solution the actual state update comes after the matrix + ! multiply in SoilMatrix, but the matrix needs to be setup with + ! the equivalent of above. Those changes can be here or in the + ! native subroutines dealing with that field + ! else ! phenology and dynamic land cover fluxes end if end do - end do - else if ( .not. use_fates_sp ) then !use_fates - ! here add all fates litterfall and CWD breakdown to litter fluxes + + end if fates_if + + end do fc_loop + + + ! litter and SOM HR fluxes + do k = 1, ndecomp_cascade_transitions do j = 1,nlevdecomp do fc = 1,num_soilc c = filter_soilc(fc) - ! TODO(wjs, 2017-01-02) Should some portion or all of the following fluxes - ! be moved to the updates in CStateUpdateDynPatch? - do i = i_litr_min, i_litr_max - cf_soil%decomp_cpools_sourcesink_col(c,j,i) = & - cf_soil%FATES_c_to_litr_c_col(c,j,i) * dt - end do + ! + ! State update without the matrix solution + ! + if (.not. use_soil_matrixcn) then + cf_soil%decomp_cpools_sourcesink_col(c,j,cascade_donor_pool(k)) = & + cf_soil%decomp_cpools_sourcesink_col(c,j,cascade_donor_pool(k)) & + - ( cf_soil%decomp_cascade_hr_vr_col(c,j,k) + cf_soil%decomp_cascade_ctransfer_vr_col(c,j,k)) *dt + end if !not use_soil_matrixcn end do end do - endif - - if ( .not. use_fates_sp ) then !use_fates - ! litter and SOM HR fluxes - do k = 1, ndecomp_cascade_transitions + end do + do k = 1, ndecomp_cascade_transitions + if ( cascade_receiver_pool(k) /= 0 ) then ! skip terminal transitions do j = 1,nlevdecomp do fc = 1,num_soilc c = filter_soilc(fc) @@ -242,34 +260,17 @@ subroutine CStateUpdate1( num_soilc, filter_soilc, num_soilp, filter_soilp, & ! State update without the matrix solution ! if (.not. use_soil_matrixcn) then - cf_soil%decomp_cpools_sourcesink_col(c,j,cascade_donor_pool(k)) = & - cf_soil%decomp_cpools_sourcesink_col(c,j,cascade_donor_pool(k)) & - - ( cf_soil%decomp_cascade_hr_vr_col(c,j,k) + cf_soil%decomp_cascade_ctransfer_vr_col(c,j,k)) *dt - end if !not use_soil_matrixcn - end do - end do - end do - do k = 1, ndecomp_cascade_transitions - if ( cascade_receiver_pool(k) /= 0 ) then ! skip terminal transitions - do j = 1,nlevdecomp - do fc = 1,num_soilc - c = filter_soilc(fc) - ! - ! State update without the matrix solution - ! - if (.not. use_soil_matrixcn) then - cf_soil%decomp_cpools_sourcesink_col(c,j,cascade_receiver_pool(k)) = & + cf_soil%decomp_cpools_sourcesink_col(c,j,cascade_receiver_pool(k)) = & cf_soil%decomp_cpools_sourcesink_col(c,j,cascade_receiver_pool(k)) & + cf_soil%decomp_cascade_ctransfer_vr_col(c,j,k)*dt - end if !not use_soil_matrixcn - end do + end if !not use_soil_matrixcn end do - end if - end do - end if + end do + end if + end do - if (.not. use_fates) then -ptch: do fp = 1,num_soilp + ! This filter omits FATES patches + soilpatch_loop: do fp = 1,num_soilp p = filter_soilp(fp) c = patch%column(p) @@ -674,8 +675,7 @@ subroutine CStateUpdate1( num_soilc, filter_soilc, num_soilp, filter_soilp, & end if end if - end do ptch ! end of patch loop - end if ! end of NOT fates + end do soilpatch_loop ! end of patch loop end associate diff --git a/src/biogeochem/CNDriverMod.F90 b/src/biogeochem/CNDriverMod.F90 index fee8752d2c..2fc800955f 100644 --- a/src/biogeochem/CNDriverMod.F90 +++ b/src/biogeochem/CNDriverMod.F90 @@ -43,7 +43,7 @@ module CNDriverMod use ActiveLayerMod , only : active_layer_type use SoilWaterRetentionCurveMod , only : soil_water_retention_curve_type use CLMFatesInterfaceMod , only : hlm_fates_interface_type - use CropReprPoolsMod , only : nrepr + use CropReprPoolsMod , only : nrepr ! ! !PUBLIC TYPES: implicit none @@ -150,10 +150,10 @@ subroutine CNDriverNoLeaching(bounds, ! ! !ARGUMENTS: type(bounds_type) , intent(in) :: bounds - integer , intent(in) :: num_soilc ! number of soil columns in filter - integer , intent(in) :: filter_soilc(:) ! filter for soil columns - integer , intent(in) :: num_soilp ! number of soil patches in filter - integer , intent(in) :: filter_soilp(:) ! filter for soil patches + integer , intent(in) :: num_soilc ! number of soil columns in filter + integer , intent(in) :: filter_soilc(:) ! filter for soil columns + integer , intent(in) :: num_soilp ! number of veg patches in filter + integer , intent(in) :: filter_soilp(:) ! filter for veg patches integer , intent(out) :: num_actfirep ! number of soil patches on fire in filter integer , intent(out) :: filter_actfirep(:) ! filter for soil patches on fire integer , intent(out) :: num_actfirec ! number of soil columns on fire in filter @@ -627,16 +627,19 @@ subroutine CNDriverNoLeaching(bounds, ! Update all prognostic carbon state variables (except for gap-phase mortality and fire fluxes) call CStateUpdate1( num_soilc, filter_soilc, num_soilp, filter_soilp, & crop_inst, cnveg_carbonflux_inst, cnveg_carbonstate_inst, & - soilbiogeochem_carbonflux_inst, dribble_crophrv_xsmrpool_2atm) + soilbiogeochem_carbonflux_inst, dribble_crophrv_xsmrpool_2atm, & + clm_fates) if ( use_c13 ) then call CStateUpdate1(num_soilc, filter_soilc, num_soilp, filter_soilp, & crop_inst, c13_cnveg_carbonflux_inst, c13_cnveg_carbonstate_inst, & - c13_soilbiogeochem_carbonflux_inst, dribble_crophrv_xsmrpool_2atm) + c13_soilbiogeochem_carbonflux_inst, dribble_crophrv_xsmrpool_2atm, & + clm_fates) end if if ( use_c14 ) then call CStateUpdate1(num_soilc, filter_soilc, num_soilp, filter_soilp, & crop_inst, c14_cnveg_carbonflux_inst, c14_cnveg_carbonstate_inst, & - c14_soilbiogeochem_carbonflux_inst, dribble_crophrv_xsmrpool_2atm) + c14_soilbiogeochem_carbonflux_inst, dribble_crophrv_xsmrpool_2atm, & + clm_fates) end if ! Update all prognostic nitrogen state variables (except for gap-phase mortality and fire fluxes) diff --git a/src/biogeochem/CNVegetationFacade.F90 b/src/biogeochem/CNVegetationFacade.F90 index f7457a505f..8ab4bdf4c3 100644 --- a/src/biogeochem/CNVegetationFacade.F90 +++ b/src/biogeochem/CNVegetationFacade.F90 @@ -879,8 +879,8 @@ end subroutine InitGridcellBalance !----------------------------------------------------------------------- subroutine EcosystemDynamicsPreDrainage(this, bounds, & - num_soilc, filter_soilc, & - num_soilp, filter_soilp, & + num_bgc_soilc, filter_bgc_soilc, & + num_bgc_vegp, filter_bgc_vegp, & num_actfirec, filter_actfirec, & num_actfirep, filter_actfirep, & num_pcropp, filter_pcropp, & @@ -900,9 +900,9 @@ subroutine EcosystemDynamicsPreDrainage(this, bounds, & nutrient_competition_method, fireemis_inst) ! ! !DESCRIPTION: - ! Do the main science for CN vegetation that needs to be done before hydrology-drainage + ! Do the main science for biogeochemistry that needs to be done before hydrology-drainage ! - ! Should only be called if use_cn is true + ! Can be called for either use_cn or use_fates. Will skip most vegetation patch calls for the latter ! ! !USES: @@ -910,10 +910,10 @@ subroutine EcosystemDynamicsPreDrainage(this, bounds, & ! !ARGUMENTS: class(cn_vegetation_type) , intent(inout) :: this type(bounds_type) , intent(in) :: bounds - integer , intent(in) :: num_soilc ! number of soil columns in filter - integer , intent(in) :: filter_soilc(:) ! filter for soil columns - integer , intent(in) :: num_soilp ! number of soil patches in filter - integer , intent(in) :: filter_soilp(:) ! filter for soil patches + integer , intent(in) :: num_bgc_soilc ! number of soil columns in filter + integer , intent(in) :: filter_bgc_soilc(:) ! filter for soil columns + integer , intent(in) :: num_bgc_vegp ! number of veg patches in filter + integer , intent(in) :: filter_bgc_vegp(:) ! filter for veg patches integer , intent(out) :: num_actfirec ! number of soil columns on fire in filter integer , intent(out) :: filter_actfirec(:)! filter for soil columns on fire integer , intent(out) :: num_actfirep ! number of soil patches on fire in filter @@ -962,8 +962,8 @@ subroutine EcosystemDynamicsPreDrainage(this, bounds, & call crop_inst%CropIncrementYear(num_pcropp, filter_pcropp) call CNDriverNoLeaching(bounds, & - num_soilc, filter_soilc, & - num_soilp, filter_soilp, & + num_bgc_soilc, filter_bgc_soilc, & + num_bgc_vegp, filter_bgc_vegp, & num_pcropp, filter_pcropp, & num_soilnopcropp, filter_soilnopcropp, & num_actfirec, filter_actfirec, & @@ -990,12 +990,12 @@ subroutine EcosystemDynamicsPreDrainage(this, bounds, & nutrient_competition_method, this%cnfire_method, this%dribble_crophrv_xsmrpool_2atm) ! fire carbon emissions - call CNFireEmisUpdate(bounds, num_soilp, filter_soilp, & + call CNFireEmisUpdate(bounds, num_bgc_vegp, filter_bgc_vegp, & this%cnveg_carbonflux_inst, this%cnveg_carbonstate_inst, fireemis_inst ) call CNAnnualUpdate(bounds, & - num_soilc, filter_soilc, & - num_soilp, filter_soilp, & + num_bgc_soilc, filter_bgc_soilc, & + num_bgc_vegp, filter_bgc_vegp, & this%cnveg_state_inst, this%cnveg_carbonflux_inst) end subroutine EcosystemDynamicsPreDrainage @@ -1087,7 +1087,7 @@ subroutine EcosystemDynamicsPostDrainage(this, bounds, num_allc, filter_allc, & ! Call to all CN summary routines - call CNDriverSummarizeStates(bounds, & + call CNDriverSummarizeStates(bounds, & num_allc, filter_allc, & num_soilc, filter_soilc, & num_soilp, filter_soilp, & @@ -1100,7 +1100,7 @@ subroutine EcosystemDynamicsPostDrainage(this, bounds, num_allc, filter_allc, & c14_soilbiogeochem_carbonstate_inst, & soilbiogeochem_nitrogenstate_inst) - call CNDriverSummarizeFluxes(bounds, & + call CNDriverSummarizeFluxes(bounds, & num_soilc, filter_soilc, & num_soilp, filter_soilp, & this%cnveg_carbonflux_inst, & @@ -1131,7 +1131,11 @@ end subroutine EcosystemDynamicsPostDrainage !----------------------------------------------------------------------- subroutine BalanceCheck(this, bounds, num_soilc, filter_soilc, & soilbiogeochem_carbonflux_inst, soilbiogeochem_nitrogenflux_inst, & - atm2lnd_inst) + soilbiogeochem_carbonstate_inst, soilbiogeochem_nitrogenstate_inst, & + atm2lnd_inst, clm_fates) + + + ! ! !DESCRIPTION: ! Check the carbon and nitrogen balance @@ -1148,7 +1152,10 @@ subroutine BalanceCheck(this, bounds, num_soilc, filter_soilc, & integer , intent(in) :: filter_soilc(:) ! filter for soil columns type(soilbiogeochem_carbonflux_type) , intent(inout) :: soilbiogeochem_carbonflux_inst type(soilbiogeochem_nitrogenflux_type) , intent(inout) :: soilbiogeochem_nitrogenflux_inst + type(soilbiogeochem_carbonflux_type) , intent(inout) :: soilbiogeochem_carbonstate_inst + type(soilbiogeochem_nitrogenflux_type) , intent(inout) :: soilbiogeochem_nitrogenstate_inst type(atm2lnd_type) , intent(in) :: atm2lnd_inst + type(hlm_fates_interface_type) , intent(inout) :: clm_fates ! ! !LOCAL VARIABLES: integer :: DA_nstep ! time step number @@ -1168,9 +1175,11 @@ subroutine BalanceCheck(this, bounds, num_soilc, filter_soilc, & call this%cn_balance_inst%CBalanceCheck( & bounds, num_soilc, filter_soilc, & soilbiogeochem_carbonflux_inst, & + soilbiogeochem_carbonstate_inst, & this%cnveg_carbonflux_inst, & this%cnveg_carbonstate_inst, & - this%c_products_inst) + this%c_products_inst, & + clm_fates) call this%cn_balance_inst%NBalanceCheck( & bounds, num_soilc, filter_soilc, & diff --git a/src/biogeophys/WaterDiagnosticType.F90 b/src/biogeophys/WaterDiagnosticType.F90 index 7fa76b42b0..57be0e62af 100644 --- a/src/biogeophys/WaterDiagnosticType.F90 +++ b/src/biogeophys/WaterDiagnosticType.F90 @@ -164,13 +164,7 @@ subroutine InitHistory(this, bounds) begc = bounds%begc; endc= bounds%endc begg = bounds%begg; endg= bounds%endg - this%h2ocan_patch(begp:endp) = spval - call hist_addfld1d ( & - fname=this%info%fname('H2OCAN'), & - units='mm', & - avgflag='A', & - long_name=this%info%lname('intercepted water'), & - ptr_patch=this%h2ocan_patch) + this%h2osoi_liqice_10cm_col(begc:endc) = spval call hist_addfld1d ( & @@ -205,8 +199,15 @@ subroutine InitHistory(this, bounds) long_name=this%info%lname('2m specific humidity'), & ptr_patch=this%q_ref2m_patch) + this%h2ocan_patch(begp:endp) = spval + call hist_addfld1d ( & + fname=this%info%fname('H2OCAN'), & + units='mm', & + avgflag='A', & + long_name=this%info%lname('intercepted water'), & + ptr_patch=this%h2ocan_patch) - + ! Snow properties - these will be vertically averaged over the snow profile this%snowliq_col(begc:endc) = spval diff --git a/src/main/clm_driver.F90 b/src/main/clm_driver.F90 index ae178b226c..b01034dc2a 100644 --- a/src/main/clm_driver.F90 +++ b/src/main/clm_driver.F90 @@ -997,33 +997,34 @@ subroutine clm_drv(doalb, nextsw_cday, declinp1, declin, rstwr, nlend, rdate, ro ! - CNDV defined: prognostic biogeography; else prescribed ! - crop model: crop algorithms called from within CNDriver - if (use_cn) then - call t_startf('ecosysdyn') - call bgc_vegetation_inst%EcosystemDynamicsPreDrainage(bounds_clump, & - filter(nc)%num_soilc, filter(nc)%soilc, & - filter(nc)%num_soilp, filter(nc)%soilp, & - filter(nc)%num_actfirec, filter(nc)%actfirec, & - filter(nc)%num_actfirep, filter(nc)%actfirep, & - filter(nc)%num_pcropp, filter(nc)%pcropp, & - filter(nc)%num_soilnopcropp, filter(nc)%soilnopcropp, & - filter(nc)%num_exposedvegp, filter(nc)%exposedvegp, & - filter(nc)%num_noexposedvegp, filter(nc)%noexposedvegp, & - soilbiogeochem_carbonflux_inst, soilbiogeochem_carbonstate_inst, & - c13_soilbiogeochem_carbonflux_inst, c13_soilbiogeochem_carbonstate_inst, & - c14_soilbiogeochem_carbonflux_inst, c14_soilbiogeochem_carbonstate_inst, & - soilbiogeochem_state_inst, & - soilbiogeochem_nitrogenflux_inst, soilbiogeochem_nitrogenstate_inst, & - active_layer_inst, clm_fates, & - atm2lnd_inst, water_inst%waterstatebulk_inst, & - water_inst%waterdiagnosticbulk_inst, water_inst%waterfluxbulk_inst, & - water_inst%wateratm2lndbulk_inst, canopystate_inst, soilstate_inst, temperature_inst, & - soil_water_retention_curve, crop_inst, ch4_inst, & - photosyns_inst, saturated_excess_runoff_inst, energyflux_inst, & - nutrient_competition_method, fireemis_inst) - - call t_stopf('ecosysdyn') - - end if + ! Filter bgc_soilc operates on all non-sp soil columns + ! Filter bgc_vegp operates on all non-fates, non-sp patches (use_cn) on soil + + call t_startf('ecosysdyn') + call bgc_vegetation_inst%EcosystemDynamicsPreDrainage(bounds_clump, & + filter(nc)%num_bgc_soilc, filter(nc)%bgc_soilc, & + filter(nc)%num_bgc_vegp, filter(nc)%bgc_vegp, & + filter(nc)%num_actfirec, filter(nc)%actfirec, & + filter(nc)%num_actfirep, filter(nc)%actfirep, & + filter(nc)%num_pcropp, filter(nc)%pcropp, & + filter(nc)%num_soilnopcropp, filter(nc)%soilnopcropp, & + filter(nc)%num_exposedvegp, filter(nc)%exposedvegp, & + filter(nc)%num_noexposedvegp, filter(nc)%noexposedvegp, & + soilbiogeochem_carbonflux_inst, soilbiogeochem_carbonstate_inst, & + c13_soilbiogeochem_carbonflux_inst, c13_soilbiogeochem_carbonstate_inst, & + c14_soilbiogeochem_carbonflux_inst, c14_soilbiogeochem_carbonstate_inst, & + soilbiogeochem_state_inst, & + soilbiogeochem_nitrogenflux_inst, soilbiogeochem_nitrogenstate_inst, & + active_layer_inst, clm_fates, & + atm2lnd_inst, water_inst%waterstatebulk_inst, & + water_inst%waterdiagnosticbulk_inst, water_inst%waterfluxbulk_inst, & + water_inst%wateratm2lndbulk_inst, canopystate_inst, soilstate_inst, temperature_inst, & + soil_water_retention_curve, crop_inst, ch4_inst, & + photosyns_inst, saturated_excess_runoff_inst, energyflux_inst, & + nutrient_competition_method, fireemis_inst) + + call t_stopf('ecosysdyn') + ! Prescribed biogeography - prescribed canopy structure, some prognostic carbon fluxes @@ -1077,27 +1078,22 @@ subroutine clm_drv(doalb, nextsw_cday, declinp1, declin, rstwr, nlend, rdate, ro call t_stopf('hydro2_drainage') - if (use_cn) then - - call t_startf('EcosysDynPostDrainage') - call bgc_vegetation_inst%EcosystemDynamicsPostDrainage(bounds_clump, & - filter(nc)%num_allc, filter(nc)%allc, & - filter(nc)%num_soilc, filter(nc)%soilc, & - filter(nc)%num_soilp, filter(nc)%soilp, & - filter(nc)%num_actfirec, filter(nc)%actfirec, & - filter(nc)%num_actfirep, filter(nc)%actfirep, & - doalb, crop_inst, & - soilstate_inst, soilbiogeochem_state_inst, & - water_inst%waterstatebulk_inst, water_inst%waterdiagnosticbulk_inst, & - water_inst%waterfluxbulk_inst, frictionvel_inst, canopystate_inst, & - soilbiogeochem_carbonflux_inst, soilbiogeochem_carbonstate_inst, & - c13_soilbiogeochem_carbonflux_inst, c13_soilbiogeochem_carbonstate_inst, & - c14_soilbiogeochem_carbonflux_inst, c14_soilbiogeochem_carbonstate_inst, & - soilbiogeochem_nitrogenflux_inst, soilbiogeochem_nitrogenstate_inst) - call t_stopf('EcosysDynPostDrainage') - - end if - + call t_startf('EcosysDynPostDrainage') + call bgc_vegetation_inst%EcosystemDynamicsPostDrainage(bounds_clump, & + filter(nc)%num_allc, filter(nc)%allc, & + filter(nc)%num_bgc_soilc, filter(nc)%bgc_soilc, & + filter(nc)%num_bgc_vegp, filter(nc)%bgc_vegp, & + filter(nc)%num_actfirec, filter(nc)%actfirec, & + filter(nc)%num_actfirep, filter(nc)%actfirep, & + doalb, crop_inst, & + soilstate_inst, soilbiogeochem_state_inst, & + water_inst%waterstatebulk_inst, water_inst%waterdiagnosticbulk_inst, & + water_inst%waterfluxbulk_inst, frictionvel_inst, canopystate_inst, & + soilbiogeochem_carbonflux_inst, soilbiogeochem_carbonstate_inst, & + c13_soilbiogeochem_carbonflux_inst, c13_soilbiogeochem_carbonstate_inst, & + c14_soilbiogeochem_carbonflux_inst, c14_soilbiogeochem_carbonstate_inst, & + soilbiogeochem_nitrogenflux_inst, soilbiogeochem_nitrogenstate_inst) + call t_stopf('EcosysDynPostDrainage') if ( use_fates) then @@ -1107,31 +1103,32 @@ subroutine clm_drv(doalb, nextsw_cday, declinp1, declin, rstwr, nlend, rdate, ro ! for leaf photosynthetic acclimation temperature. These ! moving averages are updated here call clm_fates%WrapUpdateFatesRmean(nc,temperature_inst) - - call EDBGCDyn(bounds_clump, & - filter(nc)%num_soilc, filter(nc)%soilc, & - filter(nc)%num_soilp, filter(nc)%soilp, & - filter(nc)%num_pcropp, filter(nc)%pcropp, doalb, & - bgc_vegetation_inst%cnveg_carbonflux_inst, & - bgc_vegetation_inst%cnveg_carbonstate_inst, & - soilbiogeochem_carbonflux_inst, soilbiogeochem_carbonstate_inst, & - soilbiogeochem_state_inst, clm_fates, & - soilbiogeochem_nitrogenflux_inst, soilbiogeochem_nitrogenstate_inst, & - c13_soilbiogeochem_carbonstate_inst, c13_soilbiogeochem_carbonflux_inst, & - c14_soilbiogeochem_carbonstate_inst, c14_soilbiogeochem_carbonflux_inst, & - active_layer_inst, atm2lnd_inst, water_inst%waterfluxbulk_inst, & - canopystate_inst, soilstate_inst, temperature_inst, crop_inst, ch4_inst) - - if ( decomp_method /= no_soil_decomp )then - call EDBGCDynSummary(bounds_clump, & - filter(nc)%num_soilc, filter(nc)%soilc, & - filter(nc)%num_soilp, filter(nc)%soilp, & - soilbiogeochem_carbonflux_inst, soilbiogeochem_carbonstate_inst, & - c13_soilbiogeochem_carbonflux_inst, c13_soilbiogeochem_carbonstate_inst, & - c14_soilbiogeochem_carbonflux_inst, c14_soilbiogeochem_carbonstate_inst, & - soilbiogeochem_nitrogenflux_inst, soilbiogeochem_nitrogenstate_inst, & - nc) - end if + end if + + ! call EDBGCDyn(bounds_clump, & + ! filter(nc)%num_soilc, filter(nc)%soilc, & + ! filter(nc)%num_soilp, filter(nc)%soilp, & + ! filter(nc)%num_pcropp, filter(nc)%pcropp, doalb, & + ! bgc_vegetation_inst%cnveg_carbonflux_inst, & + ! bgc_vegetation_inst%cnveg_carbonstate_inst, & + ! soilbiogeochem_carbonflux_inst, soilbiogeochem_carbonstate_inst, & + ! soilbiogeochem_state_inst, clm_fates, & + ! soilbiogeochem_nitrogenflux_inst, soilbiogeochem_nitrogenstate_inst, & + ! c13_soilbiogeochem_carbonstate_inst, c13_soilbiogeochem_carbonflux_inst, & + ! c14_soilbiogeochem_carbonstate_inst, c14_soilbiogeochem_carbonflux_inst, & + ! active_layer_inst, atm2lnd_inst, water_inst%waterfluxbulk_inst, & + ! canopystate_inst, soilstate_inst, temperature_inst, crop_inst, ch4_inst) + + !if ( decomp_method /= no_soil_decomp )then + ! call EDBGCDynSummary(bounds_clump, & + ! filter(nc)%num_soilc, filter(nc)%soilc, & + ! filter(nc)%num_soilp, filter(nc)%soilp, & + ! soilbiogeochem_carbonflux_inst, soilbiogeochem_carbonstate_inst, & + ! c13_soilbiogeochem_carbonflux_inst, c13_soilbiogeochem_carbonstate_inst, & + ! c14_soilbiogeochem_carbonflux_inst, c14_soilbiogeochem_carbonstate_inst, & + ! soilbiogeochem_nitrogenflux_inst, soilbiogeochem_nitrogenstate_inst, & + ! nc) + ! end if call clm_fates%wrap_update_hifrq_hist(bounds_clump, & soilbiogeochem_carbonflux_inst, & @@ -1176,14 +1173,15 @@ subroutine clm_drv(doalb, nextsw_cday, declinp1, declin, rstwr, nlend, rdate, ro ! Check the carbon and nitrogen balance ! ============================================================================ - if (use_cn) then - call t_startf('cnbalchk') - call bgc_vegetation_inst%BalanceCheck( & - bounds_clump, filter(nc)%num_soilc, filter(nc)%soilc, & - soilbiogeochem_carbonflux_inst, & - soilbiogeochem_nitrogenflux_inst, atm2lnd_inst ) - call t_stopf('cnbalchk') - end if + call t_startf('cnbalchk') + call bgc_vegetation_inst%BalanceCheck( & + bounds_clump, filter(nc)%num_bgc_soilc, filter(nc)%bgc_soilc, & + soilbiogeochem_carbonflux_inst, & + soilbiogeochem_nitrogenflux_inst, & + soilbiogeochem_carbonstate_inst, & + soilbiogeochem_nitrogenstate_inst, & + atm2lnd_inst, clm_fates ) + call t_stopf('cnbalchk') ! Calculation of methane fluxes diff --git a/src/main/filterMod.F90 b/src/main/filterMod.F90 index 526cb7c8f3..37c22cc85b 100644 --- a/src/main/filterMod.F90 +++ b/src/main/filterMod.F90 @@ -49,6 +49,15 @@ module filterMod integer, pointer :: nolakec(:) ! non-lake filter (columns) integer :: num_nolakec ! number of columns in non-lake filter + integer, pointer :: bgc_soilc(:) ! soil with biogeochemistry active, negates + ! SP type runs, could be CN, FATES or CROP + integer :: num_bgc_soilc + + integer, pointer :: bgc_vegp(:) ! patches with vegetation biochemistry active, negates + ! SP type runs, could be CN or Crop (NOT FATES) + integer :: num_bgc_vegp + + integer, pointer :: soilc(:) ! soil filter (columns) integer :: num_soilc ! number of columns in soil filter integer, pointer :: soilp(:) ! soil filter (patches) @@ -211,6 +220,9 @@ subroutine allocFiltersOneGroup(this_filter) allocate(this_filter(nc)%soilc(bounds%endc-bounds%begc+1)) allocate(this_filter(nc)%soilp(bounds%endp-bounds%begp+1)) + allocate(this_filter(nc)%bgc_soilc(bounds%endc-bounds%begc+1)) + allocate(this_filter(nc)%bgc_vegp(bounds%endp-bounds%begp+1)) + allocate(this_filter(nc)%snowc(bounds%endc-bounds%begc+1)) allocate(this_filter(nc)%nosnowc(bounds%endc-bounds%begc+1)) @@ -380,6 +392,39 @@ subroutine setFiltersOneGroup(bounds, this_filter, include_inactive, glc_behavio this_filter(nc)%num_nolakep = fnl this_filter(nc)%num_nolakeurbanp = fnlu + + ! Create the soil bgc filter, all non-sp columns for vegetation + fs = 0 + if( use_cn .or. (use_fates .and. .not.use_fates_sp))then + do c = bounds%begc,bounds%endc + if (col%active(c) .or. include_inactive) then + l =col%landunit(c) + if (lun%itype(l) == istsoil .or. lun%itype(l) == istcrop) then + fs = fs + 1 + this_filter(nc)%bgc_soilc(fs) = c + end if + end if + end do + end if + this_filter(nc)%num_bgc_soilc = fs + + ! Create a filter at patch-level for vegetation biochemistry + ! all non-SP and non-fates patches on soil + fs = 0 + if(use_cn)then + do p = bounds%begp,bounds%endp + if (patch%active(p) .or. include_inactive) then + l =patch%landunit(p) + if (lun%itype(l) == istsoil .or. lun%itype(l) == istcrop) then + fs = fs + 1 + this_filter(nc)%bgc_vegp(fs) = p + end if + end if + end do + end if + this_filter(nc)%num_bgc_vegp = fs + + ! Create soil filter at column-level fs = 0 @@ -393,8 +438,12 @@ subroutine setFiltersOneGroup(bounds, this_filter, include_inactive, glc_behavio end if end do this_filter(nc)%num_soilc = fs - ! Create soil filter at patch-level + + + + + ! Create soil filter at patch-level fs = 0 do p = bounds%begp,bounds%endp if (patch%active(p) .or. include_inactive) then @@ -405,6 +454,7 @@ subroutine setFiltersOneGroup(bounds, this_filter, include_inactive, glc_behavio end if end if end do + this_filter(nc)%num_soilp = fs ! Create column-level hydrology filter (soil and Urban pervious road cols) diff --git a/src/utils/clmfates_interfaceMod.F90 b/src/utils/clmfates_interfaceMod.F90 index c169d710ef..f225a3255b 100644 --- a/src/utils/clmfates_interfaceMod.F90 +++ b/src/utils/clmfates_interfaceMod.F90 @@ -224,7 +224,7 @@ module CLMFatesInterfaceMod procedure, public :: wrap_hydraulics_drive procedure, public :: WrapUpdateFatesRmean procedure, public :: wrap_WoodProducts - + procedure, public :: UpdateCLitterFluxes end type hlm_fates_interface_type ! hlm_bounds_to_fates_bounds is not currently called outside the interface. @@ -1033,43 +1033,6 @@ subroutine dynamics_driv(this, nc, bounds_clump, & enddo - ! --------------------------------------------------------------------------------- - ! Part III: Process FATES output into the dimensions and structures that are part - ! of the HLMs API. (column, depth, and litter fractions) - ! --------------------------------------------------------------------------------- - - if ( decomp_method /= no_soil_decomp )then - do s = 1, this%fates(nc)%nsites - c = this%f2hmap(nc)%fcolumn(s) - - soilbiogeochem_carbonflux_inst%FATES_c_to_litr_lab_c_col(c,1:nlevdecomp) = 0.0_r8 - soilbiogeochem_carbonflux_inst%FATES_c_to_litr_cel_c_col(c,1:nlevdecomp) = 0.0_r8 - soilbiogeochem_carbonflux_inst%FATES_c_to_litr_lig_c_col(c,1:nlevdecomp) = 0.0_r8 - - nld_si = this%fates(nc)%bc_in(s)%nlevdecomp - - soilbiogeochem_carbonflux_inst%FATES_c_to_litr_lab_c_col(c,1:nld_si) = & - this%fates(nc)%bc_out(s)%litt_flux_lab_c_si(1:nld_si) - - soilbiogeochem_carbonflux_inst%FATES_c_to_litr_cel_c_col(c,1:nld_si) = & - this%fates(nc)%bc_out(s)%litt_flux_cel_c_si(1:nld_si) - - soilbiogeochem_carbonflux_inst%FATES_c_to_litr_lig_c_col(c,1:nld_si) = & - this%fates(nc)%bc_out(s)%litt_flux_lig_c_si(1:nld_si) - - ! Copy last 3 variables to an array of litter pools for use in do loops - ! and repeat copy in soilbiogeochem/SoilBiogeochemCarbonFluxType.F90. - ! Keep the three originals to avoid backwards compatibility issues with - ! restart files. - soilbiogeochem_carbonflux_inst%FATES_c_to_litr_c_col(c,1:nld_si,1) = & - soilbiogeochem_carbonflux_inst%FATES_c_to_litr_lab_c_col(c,1:nld_si) - soilbiogeochem_carbonflux_inst%FATES_c_to_litr_c_col(c,1:nld_si,2) = & - soilbiogeochem_carbonflux_inst%FATES_c_to_litr_cel_c_col(c,1:nld_si) - soilbiogeochem_carbonflux_inst%FATES_c_to_litr_c_col(c,1:nld_si,3) = & - soilbiogeochem_carbonflux_inst%FATES_c_to_litr_lig_c_col(c,1:nld_si) - - end do - end if ! --------------------------------------------------------------------------------- @@ -1102,8 +1065,59 @@ subroutine dynamics_driv(this, nc, bounds_clump, & return end subroutine dynamics_driv - ! ------------------------------------------------------------------------------------ + ! =============================================================================== + + subroutine UpdateCLitterFluxes(this,bounds_clump,soilbiogeochem_carbonflux_inst,c) + implicit none + class(hlm_fates_interface_type), intent(inout) :: this + type(bounds_type) , intent(in) :: bounds_clump + type(soilbiogeochem_carbonflux_type) , intent(inout) :: soilbiogeochem_carbonflux_inst + integer , intent(in) :: c + + integer :: s ! site index + integer :: nc ! clump index + real(r8) :: dtime + + + dtime = get_step_size_real() + nc = bounds_clump%clump_index + s = this%f2hmap(nc)%hsites(c) + + associate(cf_soil => soilbiogeochem_carbonflux_inst) + + if ( .not. use_fates_sp ) then + cf_soil%decomp_cpools_sourcesink(c,1:nlevdecomp,i_met_lit) = & + cf_soil%decomp_cpools_sourcesink(c,1:nlevdecomp,i_met_lit) + & + this%fates(nc)%bc_out(s)%litt_flux_lab_c_si(1:nlevdecomp) * dtime + cf_soil%decomp_cpools_sourcesink(c,1:nlevdecomp,i_cel_lit) = & + cf_soil%decomp_cpools_sourcesink(c,1:nlevdecomp,i_cel_lit) + & + this%fates(nc)%bc_out(s)%litt_flux_cel_c_si(1:nlevdecomp)* dtime + cf_soil%decomp_cpools_sourcesink(c,1:nlevdecomp,i_lig_lit) = & + cf_soil%decomp_cpools_sourcesink(c,1:nlevdecomp,i_lig_lit) + & + this%fates(nc)%bc_out(s)%litt_flux_lig_c_si(1:nlevdecomp) * dtime + + else + ! In SP mode their is no mass flux between the two + cf_soil%decomp_cpools_sourcesink(c,:) = 0._r8 + end if + + ! This is a diagnostic for carbon accounting (NOT IN CLM, ONLY ELM) + !col_cf%litfall(c) = & + ! sum(this%fates(nc)%bc_out(s)%litt_flux_lab_c_si(1:nlevdecomp) * & + ! this%fates(nc)%bc_in(s)%dz_decomp_sisl(1:nlevdecomp)) + & + ! sum(this%fates(nc)%bc_out(s)%litt_flux_cel_c_si(1:nlevdecomp) * & + ! this%fates(nc)%bc_in(s)%dz_decomp_sisl(1:nlevdecomp)) + & + ! sum(this%fates(nc)%bc_out(s)%litt_flux_lig_c_si(1:nlevdecomp) * ^ + ! this%fates(nc)%bc_in(s)%dz_decomp_sisl(1:nlevdecomp)) + + end associate + + return + end subroutine UpdateCLitterFluxes + + ! =================================================================================== + subroutine wrap_update_hlmfates_dyn(this, nc, bounds_clump, & waterdiagnosticbulk_inst, canopystate_inst, & soilbiogeochem_carbonflux_inst, is_initing_from_restart) From 789eb9c4dad4dc91bc6986116f3a6e6d9927678e Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Mon, 13 Feb 2023 14:06:47 -0500 Subject: [PATCH 051/257] another incremental step towards having the native cn balancing and call sequence when fates is on --- src/biogeochem/CNBalanceCheckMod.F90 | 80 ++-- src/biogeochem/CNCStateUpdate1Mod.F90 | 6 +- src/biogeochem/CNDriverMod.F90 | 59 ++- src/biogeochem/CNVegCarbonStateType.F90 | 119 ++---- src/biogeochem/CNVegNitrogenStateType.F90 | 72 +--- src/biogeochem/CNVegetationFacade.F90 | 20 +- src/biogeochem/EDBGCDynMod.F90 | 370 ------------------ src/main/clm_driver.F90 | 152 +++---- src/main/filterMod.F90 | 1 + .../SoilBiogeochemCarbonFluxType.F90 | 96 +---- .../SoilBiogeochemCarbonStateType.F90 | 255 ++++++++---- .../SoilBiogeochemNitrogenStateType.F90 | 205 +++++++--- src/utils/clmfates_interfaceMod.F90 | 106 ++--- 13 files changed, 538 insertions(+), 1003 deletions(-) delete mode 100644 src/biogeochem/EDBGCDynMod.F90 diff --git a/src/biogeochem/CNBalanceCheckMod.F90 b/src/biogeochem/CNBalanceCheckMod.F90 index a681ee5c4e..087242da30 100644 --- a/src/biogeochem/CNBalanceCheckMod.F90 +++ b/src/biogeochem/CNBalanceCheckMod.F90 @@ -16,13 +16,16 @@ module CNBalanceCheckMod use CNVegNitrogenStateType , only : cnveg_nitrogenstate_type use CNVegCarbonFluxType , only : cnveg_carbonflux_type use CNVegCarbonStateType , only : cnveg_carbonstate_type + use SoilBiogeochemCarbonStateType , only : soilbiogeochem_carbonstate_type + use SoilBiogeochemNitrogenStateType , only : soilbiogeochem_nitrogenstate_type use SoilBiogeochemNitrogenfluxType , only : soilbiogeochem_nitrogenflux_type use SoilBiogeochemCarbonfluxType , only : soilbiogeochem_carbonflux_type use CNProductsMod , only : cn_products_type use ColumnType , only : col use GridcellType , only : grc use CNSharedParamsMod , only : use_fun - + use CLMFatesInterfaceMod , only : hlm_fates_interface_type + ! implicit none private @@ -100,7 +103,7 @@ end subroutine InitAllocate !----------------------------------------------------------------------- subroutine BeginCNGridcellBalance(this, bounds, cnveg_carbonflux_inst, & - cnveg_carbonstate_inst, cnveg_nitrogenstate_inst, & + soilbiogeochem_carbonstate_inst, soilbiogeochem_nitrogenstate_inst, & c_products_inst, n_products_inst) ! ! !DESCRIPTION: @@ -113,13 +116,13 @@ subroutine BeginCNGridcellBalance(this, bounds, cnveg_carbonflux_inst, & ! !USES: ! ! !ARGUMENTS: - class(cn_balance_type) , intent(inout) :: this - type(bounds_type) , intent(in) :: bounds - type(cnveg_carbonflux_type) , intent(in) :: cnveg_carbonflux_inst - type(cnveg_carbonstate_type) , intent(in) :: cnveg_carbonstate_inst - type(cnveg_nitrogenstate_type) , intent(in) :: cnveg_nitrogenstate_inst - type(cn_products_type) , intent(in) :: c_products_inst - type(cn_products_type) , intent(in) :: n_products_inst + class(cn_balance_type) , intent(inout) :: this + type(bounds_type) , intent(in) :: bounds + type(soilbiogeochem_carbonstate_type), intent(in) :: soilbiogeochem_carbonstate_inst + type(cnveg_carbonflux_type) , intent(in) :: cnveg_carbonflux_inst + type(soilbiogeochem_nitrogenstate_type) , intent(in) :: soilbiogeochem_nitrogenstate_inst + type(cn_products_type) , intent(in) :: c_products_inst + type(cn_products_type) , intent(in) :: n_products_inst ! ! !LOCAL VARIABLES: integer :: g @@ -131,8 +134,8 @@ subroutine BeginCNGridcellBalance(this, bounds, cnveg_carbonflux_inst, & associate( & begcb => this%begcb_grc , & ! Output: [real(r8) (:)] (gC/m2) gridcell carbon mass, beginning of time step begnb => this%begnb_grc , & ! Output: [real(r8) (:)] (gN/m2) gridcell nitrogen mass, beginning of time step - totc => cnveg_carbonstate_inst%totc_grc , & ! Input: [real(r8) (:)] (gC/m2) total gridcell carbon, incl veg and cpool - totn => cnveg_nitrogenstate_inst%totn_grc, & ! Input: [real(r8) (:)] (gN/m2) total gridcell nitrogen, incl veg + totc => soilbiogeochem_carbonstate_inst%totc_grc , & ! Input: [real(r8) (:)] (gC/m2) total gridcell carbon, incl veg and cpool + totn => soilbiogeochem_nitrogenstate_inst%totn_grc, & ! Input: [real(r8) (:)] (gN/m2) total gridcell nitrogen, incl veg c_cropprod1 => c_products_inst%cropprod1_grc , & ! Input: [real(r8) (:)] (gC/m2) carbon in crop products n_cropprod1 => n_products_inst%cropprod1_grc , & ! Input: [real(r8) (:)] (gC/m2) nitrogen in crop products c_tot_woodprod => c_products_inst%tot_woodprod_grc , & ! Input: [real(r8) (:)] (gC/m2) total carbon in wood products @@ -159,7 +162,7 @@ end subroutine BeginCNGridcellBalance !----------------------------------------------------------------------- subroutine BeginCNColumnBalance(this, bounds, num_soilc, filter_soilc, & - cnveg_carbonstate_inst, cnveg_nitrogenstate_inst,soilbiogeochem_carbonstate_inst) + soilbiogeochem_carbonstate_inst,soilbiogeochem_nitrogenstate_inst) ! ! !DESCRIPTION: ! Calculate beginning column-level carbon/nitrogen balance, for mass conservation check @@ -173,9 +176,8 @@ subroutine BeginCNColumnBalance(this, bounds, num_soilc, filter_soilc, & type(bounds_type) , intent(in) :: bounds integer , intent(in) :: num_soilc ! number of soil columns filter integer , intent(in) :: filter_soilc(:) ! filter for soil columns - type(cnveg_carbonstate_type) , intent(in) :: cnveg_carbonstate_inst - type(cnveg_nitrogenstate_type) , intent(in) :: cnveg_nitrogenstate_inst type(soilbiogeochem_carbonstate_type), intent(in) :: soilbiogeochem_carbonstate_inst + type(soilbiogeochem_nitrogenstate_type), intent(in) :: soilbiogeochem_nitrogenstate_inst ! ! !LOCAL VARIABLES: integer :: fc,c @@ -184,22 +186,16 @@ subroutine BeginCNColumnBalance(this, bounds, num_soilc, filter_soilc, & associate( & col_begcb => this%begcb_col , & ! Output: [real(r8) (:)] (gC/m2) column carbon mass, beginning of time step col_begnb => this%begnb_col , & ! Output: [real(r8) (:)] (gN/m2) column nitrogen mass, beginning of time step - totcolc => cnveg_carbonstate_inst%totc_col , & ! Input: [real(r8) (:)] (gC/m2) total column carbon, incl veg and cpool - totcoln => cnveg_nitrogenstate_inst%totn_col & ! Input: [real(r8) (:)] (gN/m2) total column nitrogen, incl veg + totcolc => soilbiogeochem_carbonstate_inst%totc_col , & ! Input: [real(r8) (:)] (gC/m2) total column carbon, incl veg and cpool + totcoln => soilbiogeochem_nitrogenstate_inst%totn_col & ! Input: [real(r8) (:)] (gN/m2) total column nitrogen, incl veg ) do fc = 1,num_soilc c = filter_soilc(fc) - if( is_fates(c) ) then - col_begcb(c) = soilbiogeochem_carbonstate_inst%totmicc_col(c) + & - soilbiogeochem_carbonstate_inst%totlitc_col(c) + & - soilbiogeochem_carbonstate_inst%totsomc_col(c) + & - soilbiogeochem_carbonstate_inst%ctrunc_col(c) - else - col_begcb(c) = totcolc(c) - col_begnb(c) = totcoln(c) - end if + col_begcb(c) = totcolc(c) + col_begnb(c) = totcoln(c) + end do end associate @@ -229,7 +225,7 @@ subroutine CBalanceCheck(this, bounds, num_soilc, filter_soilc, & integer , intent(in) :: num_soilc ! number of soil columns in filter integer , intent(in) :: filter_soilc(:) ! filter for soil columns type(soilbiogeochem_carbonflux_type) , intent(in) :: soilbiogeochem_carbonflux_inst - type(soilbiogeochem_carbonstate_type), intent(in) :: soilbiogeochem_carbonstate_inst + type(soilbiogeochem_carbonstate_type), intent(inout) :: soilbiogeochem_carbonstate_inst type(cnveg_carbonflux_type) , intent(in) :: cnveg_carbonflux_inst type(cnveg_carbonstate_type) , intent(inout) :: cnveg_carbonstate_inst type(cn_products_type) , intent(in) :: c_products_inst @@ -256,7 +252,7 @@ subroutine CBalanceCheck(this, bounds, num_soilc, filter_soilc, & associate( & grc_begcb => this%begcb_grc , & ! Input: [real(r8) (:) ] (gC/m2) gridcell-level carbon mass, beginning of time step grc_endcb => this%endcb_grc , & ! Output: [real(r8) (:) ] (gC/m2) gridcell-level carbon mass, end of time step - totgrcc => cnveg_carbonstate_inst%totc_grc , & ! Input: [real(r8) (:)] (gC/m2) total gridcell carbon, incl veg and cpool + totgrcc => soilbiogeochem_carbonstate_inst%totc_grc , & ! Output: [real(r8) (:)] (gC/m2) total gridcell carbon, incl veg and cpool nbp_grc => cnveg_carbonflux_inst%nbp_grc , & ! Input: [real(r8) (:) ] (gC/m2/s) net biome production (positive for sink) cropprod1_grc => c_products_inst%cropprod1_grc , & ! Input: [real(r8) (:)] (gC/m2) carbon in crop products tot_woodprod_grc => c_products_inst%tot_woodprod_grc , & ! Input: [real(r8) (:)] (gC/m2) total carbon in wood products @@ -273,7 +269,7 @@ subroutine CBalanceCheck(this, bounds, num_soilc, filter_soilc, & col_xsmrpool_to_atm => cnveg_carbonflux_inst%xsmrpool_to_atm_col , & ! Input: [real(r8) (:) ] (gC/m2/s) excess MR pool crop harvest loss to atm som_c_leached => soilbiogeochem_carbonflux_inst%som_c_leached_col , & ! Input: [real(r8) (:) ] (gC/m2/s) total SOM C loss from vertical transport - totcolc => cnveg_carbonstate_inst%totc_col & ! Input: [real(r8) (:) ] (gC/m2) total column carbon, incl veg and cpool + totcolc => soilbiogeochem_carbonstate_inst%totc_col & ! Input: [real(r8) (:) ] (gC/m2) total column carbon, incl veg and cpool ) ! set time steps @@ -286,13 +282,14 @@ subroutine CBalanceCheck(this, bounds, num_soilc, filter_soilc, & do fc = 1,num_soilc c = filter_soilc(fc) - if( is_fates(c) ) then - - ! calculate the total column-level carbon storage, for mass conservation check - col_endcb(c) = soilbiogeochem_carbonstate_inst%totmicc_col(c) + & - soilbiogeochem_carbonstate_inst%totlitc_col(c) + & - soilbiogeochem_carbonstate_inst%totsomc_col(c) + & - soilbiogeochem_carbonstate_inst%ctrunc_col(c) + ! calculate the total column-level carbon storage, for mass conservation check + ! for bigleaf, totcolc includes soil and all of the veg c pools including cpool, xfer, etc + ! for fates, totcolc only includes soil and non-fates litter carbon, + ! see soibiogeochem_carbonstate_inst%summary for calculations + col_endcb(c) = totcolc(c) + + + if( col%is_fates(c) ) then ! calculate total column-level inputs (litter fluxes) [g/m2/s] s = clm_fates%f2hmap(ic)%hsites(c) @@ -308,12 +305,8 @@ subroutine CBalanceCheck(this, bounds, num_soilc, filter_soilc, & ! So they are irrelevant here ! (gC/m2/s) total heterotrophic respiration col_coutputs = soilbiogeochem_carbonflux_inst%hr_col(c) - else - - ! calculate the total column-level carbon storage, for mass conservation check - col_endcb(c) = totcolc(c) ! calculate total column-level inputs col_cinputs = gpp(c) @@ -451,7 +444,8 @@ end subroutine CBalanceCheck !----------------------------------------------------------------------- subroutine NBalanceCheck(this, bounds, num_soilc, filter_soilc, & - soilbiogeochem_nitrogenflux_inst, cnveg_nitrogenflux_inst, & + soilbiogeochem_nitrogenflux_inst, soilbiogeochem_nitrogenstate_inst, & + cnveg_nitrogenflux_inst, & cnveg_nitrogenstate_inst, n_products_inst, atm2lnd_inst) ! ! !DESCRIPTION: @@ -468,10 +462,12 @@ subroutine NBalanceCheck(this, bounds, num_soilc, filter_soilc, & integer , intent(in) :: num_soilc ! number of soil columns in filter integer , intent(in) :: filter_soilc (:) ! filter for soil columns type(soilbiogeochem_nitrogenflux_type) , intent(in) :: soilbiogeochem_nitrogenflux_inst + type(soilbiogeochem_nitrogenstate_type) , intent(inout) :: soilbiogeochem_nitrogenstate_inst type(cnveg_nitrogenflux_type) , intent(in) :: cnveg_nitrogenflux_inst type(cnveg_nitrogenstate_type) , intent(inout) :: cnveg_nitrogenstate_inst type(cn_products_type) , intent(in) :: n_products_inst type(atm2lnd_type) , intent(in) :: atm2lnd_inst + ! ! !LOCAL VARIABLES: integer :: c,err_index,j ! indices @@ -494,7 +490,7 @@ subroutine NBalanceCheck(this, bounds, num_soilc, filter_soilc, & associate( & grc_begnb => this%begnb_grc , & ! Input: [real(r8) (:) ] (gN/m2) gridcell nitrogen mass, beginning of time step grc_endnb => this%endnb_grc , & ! Output: [real(r8) (:) ] (gN/m2) gridcell nitrogen mass, end of time step - totgrcn => cnveg_nitrogenstate_inst%totn_grc , & ! Input: [real(r8) (:) ] (gN/m2) total gridcell nitrogen, incl veg + totgrcn => soilbiogeochem_nitrogenstate_inst%totn_grc , & ! Input: [real(r8) (:) ] (gN/m2) total gridcell nitrogen, incl veg cropprod1_grc => n_products_inst%cropprod1_grc , & ! Input: [real(r8) (:)] (gN/m2) nitrogen in crop products product_loss_grc => n_products_inst%product_loss_grc , & ! Input: [real(r8) (:)] (gN/m2) losses from wood & crop products tot_woodprod_grc => n_products_inst%tot_woodprod_grc , & ! Input: [real(r8) (:)] (gN/m2) total nitrogen in wood products @@ -520,7 +516,7 @@ subroutine NBalanceCheck(this, bounds, num_soilc, filter_soilc, & wood_harvestn => cnveg_nitrogenflux_inst%wood_harvestn_col , & ! Input: [real(r8) (:) ] (gN/m2/s) wood harvest (to product pools) crop_harvestn_to_cropprodn => cnveg_nitrogenflux_inst%crop_harvestn_to_cropprodn_col , & ! Input: [real(r8) (:) ] (gN/m2/s) crop harvest N to 1-year crop product pool - totcoln => cnveg_nitrogenstate_inst%totn_col & ! Input: [real(r8) (:) ] (gN/m2) total column nitrogen, incl veg + totcoln => soilbiogeochem_nitrogenstate_inst%totn_col & ! Input: [real(r8) (:) ] (gN/m2) total column nitrogen, incl veg ) ! set time steps diff --git a/src/biogeochem/CNCStateUpdate1Mod.F90 b/src/biogeochem/CNCStateUpdate1Mod.F90 index 2d88977b5f..5783e01f6c 100644 --- a/src/biogeochem/CNCStateUpdate1Mod.F90 +++ b/src/biogeochem/CNCStateUpdate1Mod.F90 @@ -26,6 +26,7 @@ module CNCStateUpdate1Mod use clm_varctl , only : use_fates, use_cn, iulog, use_fates_sp use CNSharedParamsMod , only : use_matrixcn use CLMFatesInterfaceMod , only : hlm_fates_interface_type + use ColumnType , only : col ! implicit none @@ -141,7 +142,7 @@ end subroutine CStateUpdate0 subroutine CStateUpdate1( num_soilc, filter_soilc, num_soilp, filter_soilp, & crop_inst, cnveg_carbonflux_inst, cnveg_carbonstate_inst, & soilbiogeochem_carbonflux_inst, dribble_crophrv_xsmrpool_2atm, & - clm_fates) + clm_fates, ci) ! ! !DESCRIPTION: ! On the radiation time step, update all the prognostic carbon state @@ -159,6 +160,7 @@ subroutine CStateUpdate1( num_soilc, filter_soilc, num_soilp, filter_soilp, & type(soilbiogeochem_carbonflux_type) , intent(inout) :: soilbiogeochem_carbonflux_inst logical , intent(in) :: dribble_crophrv_xsmrpool_2atm type(hlm_fates_interface_type) , intent(inout) :: clm_fates + integer , intent(in) :: ci ! clump index ! ! !LOCAL VARIABLES: integer :: c,p,j,k,l,i ! indices @@ -199,7 +201,7 @@ subroutine CStateUpdate1( num_soilc, filter_soilc, num_soilp, filter_soilp, & ! prepared litter c flux boundary conditions into ! cf_soil%decomp_cpools_sourcesink_col - call clm_fates%UpdateCLitterfluxes(bounds_clump,cf_soil,c) + call clm_fates%UpdateCLitterfluxes(cf_soil,ci,c) else diff --git a/src/biogeochem/CNDriverMod.F90 b/src/biogeochem/CNDriverMod.F90 index 2fc800955f..c7918ec0fe 100644 --- a/src/biogeochem/CNDriverMod.F90 +++ b/src/biogeochem/CNDriverMod.F90 @@ -628,18 +628,18 @@ subroutine CNDriverNoLeaching(bounds, call CStateUpdate1( num_soilc, filter_soilc, num_soilp, filter_soilp, & crop_inst, cnveg_carbonflux_inst, cnveg_carbonstate_inst, & soilbiogeochem_carbonflux_inst, dribble_crophrv_xsmrpool_2atm, & - clm_fates) + clm_fates, bounds%clump_index) if ( use_c13 ) then call CStateUpdate1(num_soilc, filter_soilc, num_soilp, filter_soilp, & crop_inst, c13_cnveg_carbonflux_inst, c13_cnveg_carbonstate_inst, & c13_soilbiogeochem_carbonflux_inst, dribble_crophrv_xsmrpool_2atm, & - clm_fates) + clm_fates, bounds%clump_index) end if if ( use_c14 ) then call CStateUpdate1(num_soilc, filter_soilc, num_soilp, filter_soilp, & crop_inst, c14_cnveg_carbonflux_inst, c14_cnveg_carbonstate_inst, & c14_soilbiogeochem_carbonflux_inst, dribble_crophrv_xsmrpool_2atm, & - clm_fates) + clm_fates, bounds%clump_index) end if ! Update all prognostic nitrogen state variables (except for gap-phase mortality and fire fluxes) @@ -1061,53 +1061,42 @@ subroutine CNDriverSummarizeStates(bounds, num_allc, filter_allc, & call t_startf('CNsum') ! ---------------------------------------------- - ! soilbiogeochem carbon/nitrogen state summary + ! cnveg carbon/nitrogen state summary ! ---------------------------------------------- + call cnveg_carbonstate_inst%Summary(bounds, num_soilc, filter_soilc, num_soilp, filter_soilp) - call soilbiogeochem_carbonstate_inst%summary(bounds, num_allc, filter_allc) if ( use_c13 ) then - call c13_soilbiogeochem_carbonstate_inst%summary(bounds, num_allc, filter_allc) + call c13_cnveg_carbonstate_inst%Summary(bounds, num_soilc, filter_soilc, num_soilp, filter_soilp) end if + if ( use_c14 ) then - call c14_soilbiogeochem_carbonstate_inst%summary(bounds, num_allc, filter_allc) + call c14_cnveg_carbonstate_inst%Summary(bounds, num_soilc, filter_soilc, num_soilp, filter_soilp) end if - call soilbiogeochem_nitrogenstate_inst%summary(bounds, num_allc, filter_allc) ! ---------------------------------------------- - ! cnveg carbon/nitrogen state summary + ! soilbiogeochem carbon/nitrogen state summary + ! RGK 02-23: soilbiogeochem summary now depends on + ! cnveg summary, swapped call order ! ---------------------------------------------- - call cnveg_carbonstate_inst%Summary(bounds, num_allc, filter_allc, & - num_soilc, filter_soilc, num_soilp, filter_soilp, & - soilbiogeochem_cwdc_col=soilbiogeochem_carbonstate_inst%cwdc_col(begc:endc), & - soilbiogeochem_totlitc_col=soilbiogeochem_carbonstate_inst%totlitc_col(begc:endc), & - soilbiogeochem_totmicc_col=soilbiogeochem_carbonstate_inst%totmicc_col(begc:endc), & - soilbiogeochem_totsomc_col=soilbiogeochem_carbonstate_inst%totsomc_col(begc:endc), & - soilbiogeochem_ctrunc_col=soilbiogeochem_carbonstate_inst%ctrunc_col(begc:endc)) - + call soilbiogeochem_carbonstate_inst%summary(bounds, num_soilc, filter_soilc, cnveg_carbonstate_inst) if ( use_c13 ) then - call c13_cnveg_carbonstate_inst%Summary(bounds, num_allc, filter_allc, & - num_soilc, filter_soilc, num_soilp, filter_soilp, & - soilbiogeochem_cwdc_col=c13_soilbiogeochem_carbonstate_inst%cwdc_col(begc:endc), & - soilbiogeochem_totlitc_col=c13_soilbiogeochem_carbonstate_inst%totlitc_col(begc:endc), & - soilbiogeochem_totmicc_col=c13_soilbiogeochem_carbonstate_inst%totmicc_col(begc:endc), & - soilbiogeochem_totsomc_col=c13_soilbiogeochem_carbonstate_inst%totsomc_col(begc:endc), & - soilbiogeochem_ctrunc_col=c13_soilbiogeochem_carbonstate_inst%ctrunc_col(begc:endc)) + call c13_soilbiogeochem_carbonstate_inst%summary(bounds, num_soilc, filter_soilc, c13_cnveg_carbonstate_inst) end if - if ( use_c14 ) then - call c14_cnveg_carbonstate_inst%Summary(bounds, num_allc, filter_allc, & - num_soilc, filter_soilc, num_soilp, filter_soilp, & - soilbiogeochem_cwdc_col=c14_soilbiogeochem_carbonstate_inst%cwdc_col(begc:endc), & - soilbiogeochem_totlitc_col=c14_soilbiogeochem_carbonstate_inst%totlitc_col(begc:endc), & - soilbiogeochem_totmicc_col=c14_soilbiogeochem_carbonstate_inst%totmicc_col(begc:endc), & - soilbiogeochem_totsomc_col=c14_soilbiogeochem_carbonstate_inst%totsomc_col(begc:endc), & - soilbiogeochem_ctrunc_col=c14_soilbiogeochem_carbonstate_inst%ctrunc_col(begc:endc)) + call c14_soilbiogeochem_carbonstate_inst%summary(bounds, num_soilc, filter_soilc, c13_cnveg_carbonstate_inst) end if + + + ! RGK 02-23: This call will be moved to after cnveg nitr summary when we + ! couple in FATES N + + + call cnveg_nitrogenstate_inst%Summary(bounds, num_soilc, filter_soilc, & + num_soilp, filter_soilp) - call cnveg_nitrogenstate_inst%Summary(bounds, num_allc, filter_allc, & - num_soilc, filter_soilc, num_soilp, filter_soilp, & - soilbiogeochem_nitrogenstate_inst) + call soilbiogeochem_nitrogenstate_inst%summary(bounds, num_soilc, filter_soilc,cnveg_nitrogenstate_inst) + call t_stopf('CNsum') diff --git a/src/biogeochem/CNVegCarbonStateType.F90 b/src/biogeochem/CNVegCarbonStateType.F90 index 610689fdb6..5baf1bce0b 100644 --- a/src/biogeochem/CNVegCarbonStateType.F90 +++ b/src/biogeochem/CNVegCarbonStateType.F90 @@ -68,7 +68,6 @@ module CNVegCarbonStateType real(r8), pointer :: ctrunc_patch (:) ! (gC/m2) patch-level sink for C truncation real(r8), pointer :: woodc_patch (:) ! (gC/m2) wood C real(r8), pointer :: leafcmax_patch (:) ! (gC/m2) ann max leaf C - real(r8), pointer :: totc_patch (:) ! (gC/m2) total patch-level carbon, including cpool real(r8), pointer :: rootc_col (:) ! (gC/m2) root carbon at column level (fire) real(r8), pointer :: leafc_col (:) ! (gC/m2) column-level leafc (fire) real(r8), pointer :: deadstemc_col (:) ! (gC/m2) column-level deadstemc (fire) @@ -82,21 +81,20 @@ module CNVegCarbonStateType ! summary (diagnostic) state variables, not involved in mass balance real(r8), pointer :: dispvegc_patch (:) ! (gC/m2) displayed veg carbon, excluding storage and cpool real(r8), pointer :: storvegc_patch (:) ! (gC/m2) stored vegetation carbon, excluding cpool - real(r8), pointer :: totvegc_patch (:) ! (gC/m2) total vegetation carbon, excluding cpool - real(r8), pointer :: totvegc_col (:) ! (gC/m2) total vegetation carbon, excluding cpool averaged to column (p2c) + + logical, private :: dribble_crophrv_xsmrpool_2atm - ! Total C pools + ! Total C pools + real(r8), pointer :: totc_patch (:) ! (gC/m2) total patch-level carbon, including cpool + real(r8), pointer :: totvegc_patch (:) ! (gC/m2) total vegetation carbon, excluding cpool + real(r8), pointer :: totvegc_col (:) ! (gC/m2) total vegetation carbon, excluding cpool averaged to column (p2c) real(r8), pointer :: totc_p2c_col (:) ! (gC/m2) totc_patch averaged to col - real(r8), pointer :: totc_col (:) ! (gC/m2) total column carbon, incl veg and cpool - real(r8), pointer :: totecosysc_col (:) ! (gC/m2) total ecosystem carbon, incl veg but excl cpool - real(r8), pointer :: totc_grc (:) ! (gC/m2) total gridcell carbon - - logical, private :: dribble_crophrv_xsmrpool_2atm + contains procedure , public :: Init procedure , public :: SetValues - procedure , public :: ZeroDWT + procedure , public :: ZeroDwt procedure , public :: Restart procedure , public :: Summary => Summary_carbonstate procedure , public :: DynamicPatchAdjustments ! adjust state variables when patch areas change @@ -277,9 +275,6 @@ subroutine InitAllocate(this, bounds) allocate(this%totvegc_col (begc:endc)) ; this%totvegc_col (:) = nan allocate(this%totc_p2c_col (begc:endc)) ; this%totc_p2c_col (:) = nan - allocate(this%totc_col (begc:endc)) ; this%totc_col (:) = nan - allocate(this%totecosysc_col (begc:endc)) ; this%totecosysc_col (:) = nan - allocate(this%totc_grc (begg:endg)) ; this%totc_grc (:) = nan ! Matrix solution variables if(use_matrixcn)then @@ -509,16 +504,6 @@ subroutine InitHistory(this, bounds, carbon_type) avgflag='A', long_name='fuel load', & ptr_col=this%fuelc_col) - this%totc_col(begc:endc) = spval - call hist_addfld1d (fname='TOTCOLC', units='gC/m^2', & - avgflag='A', long_name='total column carbon, incl veg and cpool but excl product pools', & - ptr_col=this%totc_col) - - this%totecosysc_col(begc:endc) = spval - call hist_addfld1d (fname='TOTECOSYSC', units='gC/m^2', & - avgflag='A', long_name='total ecosystem carbon, incl veg but excl cpool and product pools', & - ptr_col=this%totecosysc_col) - ! Matrix solution history variables if ( use_matrixcn )then end if @@ -675,16 +660,6 @@ subroutine InitHistory(this, bounds, carbon_type) avgflag='A', long_name='C13 pool for seeding new PFTs via dynamic landcover', & ptr_gcell=this%seedc_grc, default='inactive') - this%totc_col(begc:endc) = spval - call hist_addfld1d (fname='C13_TOTCOLC', units='gC13/m^2', & - avgflag='A', long_name='C13 total column carbon, incl veg and cpool but excl product pools', & - ptr_col=this%totc_col, default='inactive') - - this%totecosysc_col(begc:endc) = spval - call hist_addfld1d (fname='C13_TOTECOSYSC', units='gC13/m^2', & - avgflag='A', long_name='C13 total ecosystem carbon, incl veg but excl cpool and product pools', & - ptr_col=this%totecosysc_col) - if (use_crop) then this%reproductivec_patch(begp:endp,:) = spval do k = 1, nrepr @@ -866,16 +841,6 @@ subroutine InitHistory(this, bounds, carbon_type) avgflag='A', long_name='C14 pool for seeding new PFTs via dynamic landcover', & ptr_gcell=this%seedc_grc, default='inactive') - this%totc_col(begc:endc) = spval - call hist_addfld1d (fname='C14_TOTCOLC', units='gC14/m^2', & - avgflag='A', long_name='C14 total column carbon, incl veg and cpool but excl product pools', & - ptr_col=this%totc_col, default='inactive') - - this%totecosysc_col(begc:endc) = spval - call hist_addfld1d (fname='C14_TOTECOSYSC', units='gC14/m^2', & - avgflag='A', long_name='C14 total ecosystem carbon, incl veg but excl cpool and product pools', & - ptr_col=this%totecosysc_col) - if (use_crop) then this%reproductivec_patch(begp:endp,:) = spval do k = 1, nrepr @@ -1099,16 +1064,14 @@ subroutine InitCold(this, bounds, ratio, carbon_type, c12_cnveg_carbonstate_inst ! this%totgrainc_col(c) = 0._r8 ! total carbon pools - this%totecosysc_col(c) = 0._r8 this%totc_p2c_col(c) = 0._r8 - this%totc_col(c) = 0._r8 + end if end do do g = bounds%begg, bounds%endg this%seedc_grc(g) = 0._r8 - this%totc_grc(g) = 0._r8 end do ! initialize fields for special filters @@ -2596,8 +2559,6 @@ subroutine SetValues ( this, & this%fuelc_crop_col(i) = value_column this%totvegc_col(i) = value_column this%totc_p2c_col(i) = value_column - this%totc_col(i) = value_column - this%totecosysc_col(i) = value_column end do end subroutine SetValues @@ -2625,11 +2586,8 @@ subroutine ZeroDwt( this, bounds ) end subroutine ZeroDwt !----------------------------------------------------------------------- - subroutine Summary_carbonstate(this, bounds, num_allc, filter_allc, & - num_soilc, filter_soilc, num_soilp, filter_soilp, & - soilbiogeochem_cwdc_col, soilbiogeochem_totlitc_col, & - soilbiogeochem_totmicc_col, soilbiogeochem_totsomc_col, & - soilbiogeochem_ctrunc_col) + subroutine Summary_carbonstate(this, bounds, num_soilc, filter_soilc, num_soilp, filter_soilp) + ! ! !USES: use subgridAveMod, only : p2c @@ -2642,31 +2600,18 @@ subroutine Summary_carbonstate(this, bounds, num_allc, filter_allc, & ! !ARGUMENTS: class(cnveg_carbonstate_type) :: this type(bounds_type) , intent(in) :: bounds - integer , intent(in) :: num_allc ! number of columns in allc filter - integer , intent(in) :: filter_allc(:) ! filter for all active columns integer , intent(in) :: num_soilc ! number of soil columns in filter integer , intent(in) :: filter_soilc(:) ! filter for soil columns integer , intent(in) :: num_soilp ! number of soil patches in filter integer , intent(in) :: filter_soilp(:) ! filter for soil patches - real(r8) , intent(in) :: soilbiogeochem_cwdc_col(bounds%begc:) - real(r8) , intent(in) :: soilbiogeochem_totmicc_col(bounds%begc:) - real(r8) , intent(in) :: soilbiogeochem_totlitc_col(bounds%begc:) - real(r8) , intent(in) :: soilbiogeochem_totsomc_col(bounds%begc:) - real(r8) , intent(in) :: soilbiogeochem_ctrunc_col(bounds%begc:) + ! ! !LOCAL VARIABLES: integer :: c,p,j,k,l ! indices integer :: fp,fc ! lake filter indices !----------------------------------------------------------------------- - SHR_ASSERT_ALL_FL((ubound(soilbiogeochem_cwdc_col) == (/bounds%endc/)), sourcefile, __LINE__) - SHR_ASSERT_ALL_FL((ubound(soilbiogeochem_totmicc_col) == (/bounds%endc/)), sourcefile, __LINE__) - SHR_ASSERT_ALL_FL((ubound(soilbiogeochem_totlitc_col) == (/bounds%endc/)), sourcefile, __LINE__) - SHR_ASSERT_ALL_FL((ubound(soilbiogeochem_totsomc_col) == (/bounds%endc/)), sourcefile, __LINE__) - SHR_ASSERT_ALL_FL((ubound(soilbiogeochem_ctrunc_col) == (/bounds%endc/)), sourcefile, __LINE__) - ! calculate patch -level summary of carbon state - do fp = 1,num_soilp p = filter_soilp(fp) @@ -2738,36 +2683,16 @@ subroutine Summary_carbonstate(this, bounds, num_allc, filter_allc, & ! -------------------------------------------- ! column level summary ! -------------------------------------------- - - call p2c(bounds, num_soilc, filter_soilc, & - this%totvegc_patch(bounds%begp:bounds%endp), & - this%totvegc_col(bounds%begc:bounds%endc)) - - call p2c(bounds, num_soilc, filter_soilc, & - this%totc_patch(bounds%begp:bounds%endp), & - this%totc_p2c_col(bounds%begc:bounds%endc)) - - do fc = 1,num_allc - c = filter_allc(fc) - - ! total ecosystem carbon, including veg but excluding cpool (TOTECOSYSC) - this%totecosysc_col(c) = & - soilbiogeochem_cwdc_col(c) + & - soilbiogeochem_totmicc_col(c) + & - soilbiogeochem_totlitc_col(c) + & - soilbiogeochem_totsomc_col(c) + & - this%totvegc_col(c) - - ! total column carbon, including veg and cpool (TOTCOLC) - this%totc_col(c) = this%totc_p2c_col(c) + & - soilbiogeochem_cwdc_col(c) + & - soilbiogeochem_totmicc_col(c) + & - soilbiogeochem_totlitc_col(c) + & - soilbiogeochem_totsomc_col(c) + & - soilbiogeochem_ctrunc_col(c) - - end do - + if(associated(this%totvegc_patch))then + call p2c(bounds, num_soilc, filter_soilc, & + this%totvegc_patch(bounds%begp:bounds%endp), & + this%totvegc_col(bounds%begc:bounds%endc)) + + call p2c(bounds, num_soilc, filter_soilc, & + this%totc_patch(bounds%begp:bounds%endp), & + this%totc_p2c_col(bounds%begc:bounds%endc)) + end if + end subroutine Summary_carbonstate !----------------------------------------------------------------------- diff --git a/src/biogeochem/CNVegNitrogenStateType.F90 b/src/biogeochem/CNVegNitrogenStateType.F90 index f09311e518..d6c335bb9a 100644 --- a/src/biogeochem/CNVegNitrogenStateType.F90 +++ b/src/biogeochem/CNVegNitrogenStateType.F90 @@ -69,9 +69,7 @@ module CNVegNitrogenStateType real(r8), pointer :: totvegn_col (:) ! (gN/m2) total vegetation nitrogen (p2c) real(r8), pointer :: totn_patch (:) ! (gN/m2) total patch-level nitrogen real(r8), pointer :: totn_p2c_col (:) ! (gN/m2) totn_patch averaged to col - real(r8), pointer :: totn_col (:) ! (gN/m2) total column nitrogen, incl veg - real(r8), pointer :: totecosysn_col (:) ! (gN/m2) total ecosystem nitrogen, incl veg - real(r8), pointer :: totn_grc (:) ! (gN/m2) total gridcell nitrogen + ! acc spinup for matrix solution @@ -167,9 +165,7 @@ subroutine InitAllocate(this, bounds) allocate(this%seedn_grc (begg:endg)) ; this%seedn_grc (:) = nan allocate(this%totvegn_col (begc:endc)) ; this%totvegn_col (:) = nan allocate(this%totn_p2c_col (begc:endc)) ; this%totn_p2c_col (:) = nan - allocate(this%totn_col (begc:endc)) ; this%totn_col (:) = nan - allocate(this%totecosysn_col (begc:endc)) ; this%totecosysn_col (:) = nan - allocate(this%totn_grc (begg:endg)) ; this%totn_grc (:) = nan + ! Matrix solution allocations if ( use_matrixcn )then @@ -376,15 +372,7 @@ subroutine InitHistory(this, bounds) avgflag='A', long_name='pool for seeding new PFTs via dynamic landcover', & ptr_gcell=this%seedn_grc) - this%totecosysn_col(begc:endc) = spval - call hist_addfld1d (fname='TOTECOSYSN', units='gN/m^2', & - avgflag='A', long_name='total ecosystem N, excluding product pools', & - ptr_col=this%totecosysn_col) - this%totn_col(begc:endc) = spval - call hist_addfld1d (fname='TOTCOLN', units='gN/m^2', & - avgflag='A', long_name='total column-level N, excluding product pools', & - ptr_col=this%totn_col) end subroutine InitHistory @@ -558,16 +546,13 @@ subroutine InitCold(this, bounds, & l = col%landunit(c) if (lun%itype(l) == istsoil .or. lun%itype(l) == istcrop) then ! total nitrogen pools - this%totecosysn_col(c) = 0._r8 this%totn_p2c_col(c) = 0._r8 - this%totn_col(c) = 0._r8 end if end do do g = bounds%begg, bounds%endg this%seedn_grc(g) = 0._r8 - this%totn_grc(g) = 0._r8 end do ! now loop through special filters and explicitly set the variables that @@ -1024,11 +1009,8 @@ subroutine SetValues ( this, & do fi = 1,num_column i = filter_column(fi) - - this%totecosysn_col(i) = value_column this%totvegn_col(i) = value_column this%totn_p2c_col(i) = value_column - this%totn_col(i) = value_column end do end subroutine SetValues @@ -1057,24 +1039,20 @@ subroutine ZeroDwt( this, bounds ) end subroutine ZeroDwt !----------------------------------------------------------------------- - subroutine Summary_nitrogenstate(this, bounds, num_allc, filter_allc, & - num_soilc, filter_soilc, num_soilp, filter_soilp,& - soilbiogeochem_nitrogenstate_inst) + subroutine Summary_nitrogenstate(this, bounds, num_soilc, filter_soilc, num_soilp, filter_soilp) ! ! !USES: use subgridAveMod, only : p2c - use SoilBiogeochemNitrogenStateType, only : soilbiogeochem_nitrogenstate_type + ! ! !ARGUMENTS: class(cnveg_nitrogenstate_type) :: this type(bounds_type) , intent(in) :: bounds - integer , intent(in) :: num_allc ! number of columns in allc filter - integer , intent(in) :: filter_allc(:) ! filter for all active columns integer , intent(in) :: num_soilc ! number of soil columns in filter integer , intent(in) :: filter_soilc(:) ! filter for soil columns integer , intent(in) :: num_soilp ! number of soil patches in filter integer , intent(in) :: filter_soilp(:) ! filter for soil patches - type(soilbiogeochem_nitrogenstate_type) , intent(in) :: soilbiogeochem_nitrogenstate_inst + ! ! !LOCAL VARIABLES: integer :: c,p,j,k,l ! indices @@ -1148,38 +1126,16 @@ subroutine Summary_nitrogenstate(this, bounds, num_allc, filter_allc, & ! -------------------------------------------- ! column level summary ! -------------------------------------------- + if(associated(this%totvegn_patch))then + call p2c(bounds, num_soilc, filter_soilc, & + this%totvegn_patch(bounds%begp:bounds%endp), & + this%totvegn_col(bounds%begc:bounds%endc)) + + call p2c(bounds, num_soilc, filter_soilc, & + this%totn_patch(bounds%begp:bounds%endp), & + this%totn_p2c_col(bounds%begc:bounds%endc)) + end if - call p2c(bounds, num_soilc, filter_soilc, & - this%totvegn_patch(bounds%begp:bounds%endp), & - this%totvegn_col(bounds%begc:bounds%endc)) - - call p2c(bounds, num_soilc, filter_soilc, & - this%totn_patch(bounds%begp:bounds%endp), & - this%totn_p2c_col(bounds%begc:bounds%endc)) - - do fc = 1,num_allc - c = filter_allc(fc) - - ! total ecosystem nitrogen, including veg (TOTECOSYSN) - this%totecosysn_col(c) = & - soilbiogeochem_nitrogenstate_inst%cwdn_col(c) + & - soilbiogeochem_nitrogenstate_inst%totlitn_col(c) + & - soilbiogeochem_nitrogenstate_inst%totmicn_col(c) + & - soilbiogeochem_nitrogenstate_inst%totsomn_col(c) + & - soilbiogeochem_nitrogenstate_inst%sminn_col(c) + & - this%totvegn_col(c) - - ! total column nitrogen, including patch (TOTCOLN) - - this%totn_col(c) = this%totn_p2c_col(c) + & - soilbiogeochem_nitrogenstate_inst%cwdn_col(c) + & - soilbiogeochem_nitrogenstate_inst%totlitn_col(c) + & - soilbiogeochem_nitrogenstate_inst%totmicn_col(c) + & - soilbiogeochem_nitrogenstate_inst%totsomn_col(c) + & - soilbiogeochem_nitrogenstate_inst%sminn_col(c) + & - soilbiogeochem_nitrogenstate_inst%ntrunc_col(c) - - end do end subroutine Summary_nitrogenstate diff --git a/src/biogeochem/CNVegetationFacade.F90 b/src/biogeochem/CNVegetationFacade.F90 index 8ab4bdf4c3..1bdcf5bce5 100644 --- a/src/biogeochem/CNVegetationFacade.F90 +++ b/src/biogeochem/CNVegetationFacade.F90 @@ -802,7 +802,7 @@ subroutine InitColumnBalance(this, bounds, num_allc, filter_allc, & call this%cn_balance_inst%BeginCNColumnBalance( & bounds, num_soilc, filter_soilc, & - this%cnveg_carbonstate_inst, this%cnveg_nitrogenstate_inst) + soilbiogeochem_carbonstate_inst,soilbiogeochem_nitrogenstate_inst) end subroutine InitColumnBalance @@ -843,6 +843,7 @@ subroutine InitGridcellBalance(this, bounds, num_allc, filter_allc, & character(len=*), parameter :: subname = 'InitGridcellBalance' !----------------------------------------------------------------------- + call CNDriverSummarizeStates(bounds, & num_allc, filter_allc, & num_soilc, filter_soilc, & @@ -858,20 +859,22 @@ subroutine InitGridcellBalance(this, bounds, num_allc, filter_allc, & ! total gridcell carbon (TOTGRIDCELLC) call c2g( bounds = bounds, & - carr = this%cnveg_carbonstate_inst%totc_col(bounds%begc:bounds%endc), & - garr = this%cnveg_carbonstate_inst%totc_grc(bounds%begg:bounds%endg), & + carr = soilbiogeochem_carbonstate_inst%totc_col(bounds%begc:bounds%endc), & + garr = soilbiogeochem_carbonstate_inst%totc_grc(bounds%begg:bounds%endg), & c2l_scale_type = 'unity', & l2g_scale_type = 'unity') + ! total gridcell nitrogen (TOTGRIDCELLN) call c2g( bounds = bounds, & - carr = this%cnveg_nitrogenstate_inst%totn_col(bounds%begc:bounds%endc), & - garr = this%cnveg_nitrogenstate_inst%totn_grc(bounds%begg:bounds%endg), & + carr = soilbiogeochem_nitrogenstate_inst%totn_col(bounds%begc:bounds%endc), & + garr = soilbiogeochem_nitrogenstate_inst%totn_grc(bounds%begg:bounds%endg), & c2l_scale_type = 'unity', & l2g_scale_type = 'unity') call this%cn_balance_inst%BeginCNGridcellBalance( bounds, & this%cnveg_carbonflux_inst, & - this%cnveg_carbonstate_inst, this%cnveg_nitrogenstate_inst, & + soilbiogeochem_carbonstate_inst, & + soilbiogeochem_nitrogenstate_inst, & this%c_products_inst, this%n_products_inst) end subroutine InitGridcellBalance @@ -1152,8 +1155,8 @@ subroutine BalanceCheck(this, bounds, num_soilc, filter_soilc, & integer , intent(in) :: filter_soilc(:) ! filter for soil columns type(soilbiogeochem_carbonflux_type) , intent(inout) :: soilbiogeochem_carbonflux_inst type(soilbiogeochem_nitrogenflux_type) , intent(inout) :: soilbiogeochem_nitrogenflux_inst - type(soilbiogeochem_carbonflux_type) , intent(inout) :: soilbiogeochem_carbonstate_inst - type(soilbiogeochem_nitrogenflux_type) , intent(inout) :: soilbiogeochem_nitrogenstate_inst + type(soilbiogeochem_carbonstate_type) , intent(inout) :: soilbiogeochem_carbonstate_inst + type(soilbiogeochem_nitrogenstate_type) , intent(inout) :: soilbiogeochem_nitrogenstate_inst type(atm2lnd_type) , intent(in) :: atm2lnd_inst type(hlm_fates_interface_type) , intent(inout) :: clm_fates ! @@ -1184,6 +1187,7 @@ subroutine BalanceCheck(this, bounds, num_soilc, filter_soilc, & call this%cn_balance_inst%NBalanceCheck( & bounds, num_soilc, filter_soilc, & soilbiogeochem_nitrogenflux_inst, & + soilbiogeochem_nitrogenstate_inst, & this%cnveg_nitrogenflux_inst, & this%cnveg_nitrogenstate_inst, & this%n_products_inst, & diff --git a/src/biogeochem/EDBGCDynMod.F90 b/src/biogeochem/EDBGCDynMod.F90 deleted file mode 100644 index eb13932d13..0000000000 --- a/src/biogeochem/EDBGCDynMod.F90 +++ /dev/null @@ -1,370 +0,0 @@ -module EDBGCDynMod - -! This module creates a pathway to call the belowground biogeochemistry code as driven by the fates vegetation model -! but bypassing the aboveground CN vegetation code. It is modeled after the CNDriverMod in its call sequence and -! functionality. - - use shr_kind_mod , only : r8 => shr_kind_r8 - use clm_varctl , only : use_c13, use_c14, use_fates - use decompMod , only : bounds_type - use perf_mod , only : t_startf, t_stopf - use shr_log_mod , only : errMsg => shr_log_errMsg - use abortutils , only : endrun - use SoilBiogeochemDecompCascadeConType , only : no_soil_decomp, mimics_decomp, century_decomp, decomp_method - use CNVegCarbonStateType , only : cnveg_carbonstate_type - use CNVegCarbonFluxType , only : cnveg_carbonflux_type - use SoilBiogeochemStateType , only : soilbiogeochem_state_type - use SoilBiogeochemCarbonStateType , only : soilbiogeochem_carbonstate_type - use SoilBiogeochemCarbonFluxType , only : soilbiogeochem_carbonflux_type - use SoilBiogeochemNitrogenStateType , only : soilbiogeochem_nitrogenstate_type - use SoilBiogeochemNitrogenFluxType , only : soilbiogeochem_nitrogenflux_type - use CanopyStateType , only : canopystate_type - use SoilStateType , only : soilstate_type - use SoilHydrologyType , only : soilhydrology_type - use TemperatureType , only : temperature_type - use WaterFluxBulkType , only : waterfluxbulk_type - use ActiveLayerMod , only : active_layer_type - use atm2lndType , only : atm2lnd_type - use SoilStateType , only : soilstate_type - use ch4Mod , only : ch4_type - use CLMFatesInterfaceMod , only : hlm_fates_interface_type - - implicit none - - ! public :: EDBGCDynInit ! BGC dynamics: initialization - public :: EDBGCDyn ! BGC Dynamics - public :: EDBGCDynSummary ! BGC dynamics: summary - - character(len=*), parameter, private :: sourcefile = & - __FILE__ - -contains - - - !----------------------------------------------------------------------- - subroutine EDBGCDyn(bounds, & - num_soilc, filter_soilc, num_soilp, filter_soilp, num_pcropp, filter_pcropp, doalb, & - cnveg_carbonflux_inst, cnveg_carbonstate_inst, & - soilbiogeochem_carbonflux_inst, soilbiogeochem_carbonstate_inst, & - soilbiogeochem_state_inst, clm_fates, & - soilbiogeochem_nitrogenflux_inst, soilbiogeochem_nitrogenstate_inst, & - c13_soilbiogeochem_carbonstate_inst, c13_soilbiogeochem_carbonflux_inst, & - c14_soilbiogeochem_carbonstate_inst, c14_soilbiogeochem_carbonflux_inst, & - active_layer_inst, atm2lnd_inst, waterfluxbulk_inst, & - canopystate_inst, soilstate_inst, temperature_inst, crop_inst, ch4_inst) - ! - ! !DESCRIPTION: - - ! - ! !USES: - use clm_varpar , only: nlevgrnd, nlevdecomp_full - use clm_varpar , only: nlevdecomp, ndecomp_cascade_transitions, ndecomp_pools - use subgridAveMod , only: p2c - use CropType , only: crop_type - use CNNDynamicsMod , only: CNNDeposition,CNNFixation, CNNFert, CNSoyfix - use CNMRespMod , only: CNMResp - use CNPhenologyMod , only: CNPhenology - use CNGRespMod , only: CNGResp - use CNCIsoFluxMod , only: CIsoFlux1, CIsoFlux2, CIsoFlux2h, CIsoFlux3 - use CNC14DecayMod , only: C14Decay - use CNCStateUpdate1Mod , only: CStateUpdate1,CStateUpdate0 - use CNCStateUpdate2Mod , only: CStateUpdate2, CStateUpdate2h - use CNCStateUpdate3Mod , only: CStateUpdate3 - use CNNStateUpdate1Mod , only: NStateUpdate1 - use CNNStateUpdate2Mod , only: NStateUpdate2, NStateUpdate2h - use CNGapMortalityMod , only: CNGapMortality - use SoilBiogeochemDecompCascadeMIMICSMod, only: decomp_rates_mimics - use SoilBiogeochemDecompCascadeBGCMod , only: decomp_rate_constants_bgc - use SoilBiogeochemDecompMod , only: SoilBiogeochemDecomp - use SoilBiogeochemLittVertTranspMod , only: SoilBiogeochemLittVertTransp - use SoilBiogeochemPotentialMod , only: SoilBiogeochemPotential - use SoilBiogeochemVerticalProfileMod , only: SoilBiogeochemVerticalProfile - use SoilBiogeochemNitrifDenitrifMod , only: SoilBiogeochemNitrifDenitrif - use SoilBiogeochemNStateUpdate1Mod , only: SoilBiogeochemNStateUpdate1 - ! - ! !ARGUMENTS: - type(bounds_type) , intent(in) :: bounds - integer , intent(in) :: num_soilc ! number of soil columns in filter - integer , intent(in) :: filter_soilc(:) ! filter for soil columns - integer , intent(in) :: num_soilp ! number of soil patches in filter - integer , intent(in) :: filter_soilp(:) ! filter for soil patches - integer , intent(in) :: num_pcropp ! number of prog. crop patches in filter - integer , intent(in) :: filter_pcropp(:) ! filter for prognostic crop patches - logical , intent(in) :: doalb ! true = surface albedo calculation time step - type(cnveg_carbonflux_type) , intent(inout) :: cnveg_carbonflux_inst - type(cnveg_carbonstate_type) , intent(inout) :: cnveg_carbonstate_inst - type(soilbiogeochem_state_type) , intent(inout) :: soilbiogeochem_state_inst - type(soilbiogeochem_carbonflux_type) , intent(inout) :: soilbiogeochem_carbonflux_inst - type(soilbiogeochem_carbonstate_type) , intent(inout) :: soilbiogeochem_carbonstate_inst - type(soilbiogeochem_carbonflux_type) , intent(inout) :: c13_soilbiogeochem_carbonflux_inst - type(soilbiogeochem_carbonstate_type) , intent(inout) :: c13_soilbiogeochem_carbonstate_inst - type(soilbiogeochem_carbonflux_type) , intent(inout) :: c14_soilbiogeochem_carbonflux_inst - type(soilbiogeochem_carbonstate_type) , intent(inout) :: c14_soilbiogeochem_carbonstate_inst - type(soilbiogeochem_nitrogenflux_type) , intent(inout) :: soilbiogeochem_nitrogenflux_inst - type(soilbiogeochem_nitrogenstate_type) , intent(inout) :: soilbiogeochem_nitrogenstate_inst - type(active_layer_type) , intent(in) :: active_layer_inst - type(atm2lnd_type) , intent(in) :: atm2lnd_inst - type(waterfluxbulk_type) , intent(in) :: waterfluxbulk_inst - type(canopystate_type) , intent(in) :: canopystate_inst - type(soilstate_type) , intent(in) :: soilstate_inst - type(temperature_type) , intent(inout) :: temperature_inst - type(crop_type) , intent(in) :: crop_inst - type(ch4_type) , intent(in) :: ch4_inst - type(hlm_fates_interface_type) , intent(inout) :: clm_fates - ! - ! !LOCAL VARIABLES: - real(r8):: cn_decomp_pools(bounds%begc:bounds%endc,1:nlevdecomp,1:ndecomp_pools) - real(r8):: p_decomp_cpool_loss(bounds%begc:bounds%endc,1:nlevdecomp,1:ndecomp_cascade_transitions) !potential C loss from one pool to another - real(r8):: pmnf_decomp_cascade(bounds%begc:bounds%endc,1:nlevdecomp,1:ndecomp_cascade_transitions) !potential mineral N flux, from one pool to another - real(r8):: p_decomp_npool_to_din(bounds%begc:bounds%endc,1:nlevdecomp,1:ndecomp_cascade_transitions) ! potential flux to dissolved inorganic N - real(r8):: p_decomp_cn_gain(bounds%begc:bounds%endc,1:nlevdecomp,1:ndecomp_pools) ! C:N ratio of the flux gained by the receiver pool - integer :: begc,endc - !----------------------------------------------------------------------- - - begc = bounds%begc; endc = bounds%endc - - associate( & - laisun => canopystate_inst%laisun_patch , & ! Input: [real(r8) (:) ] sunlit projected leaf area index - laisha => canopystate_inst%laisha_patch , & ! Input: [real(r8) (:) ] shaded projected leaf area index - frac_veg_nosno => canopystate_inst%frac_veg_nosno_patch , & ! Input: [integer (:) ] fraction of vegetation not covered by snow (0 OR 1) [-] - frac_veg_nosno_alb => canopystate_inst%frac_veg_nosno_alb_patch , & ! Output: [integer (:) ] frac of vegetation not covered by snow [-] - tlai => canopystate_inst%tlai_patch , & ! Input: [real(r8) (:) ] one-sided leaf area index, no burying by snow - tsai => canopystate_inst%tsai_patch , & ! Input: [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_patch , & ! Output: [real(r8) (:) ] canopy top (m) - hbot => canopystate_inst%hbot_patch & ! Output: [real(r8) (:) ] canopy bottom (m) - ) - - ! -------------------------------------------------- - ! zero the column-level C and N fluxes - ! -------------------------------------------------- - - if ( decomp_method /= no_soil_decomp )then - call t_startf('SoilBGCZero') - - call soilbiogeochem_carbonflux_inst%SetValues( & - num_soilc, filter_soilc, 0._r8) - if ( use_c13 ) then - call c13_soilbiogeochem_carbonflux_inst%SetValues( & - num_soilc, filter_soilc, 0._r8) - end if - if ( use_c14 ) then - call c14_soilbiogeochem_carbonflux_inst%SetValues( & - num_soilc, filter_soilc, 0._r8) - end if - - call t_stopf('SoilBGCZero') - end if - - ! -------------------------------------------------- - ! Nitrogen Deposition, Fixation and Respiration - ! -------------------------------------------------- - - ! call t_startf('CNDeposition') - ! call CNNDeposition(bounds, & - ! atm2lnd_inst, soilbiogeochem_nitrogenflux_inst) - ! call t_stopf('CNDeposition') - - - ! if (crop_prog) then - ! call CNNFert(bounds, num_soilc,filter_soilc, & - ! cnveg_nitrogenflux_inst, soilbiogeochem_nitrogenflux_inst) - - ! call CNSoyfix (bounds, num_soilc, filter_soilc, num_soilp, filter_soilp, & - ! waterstate_inst, crop_inst, cnveg_state_inst, cnveg_nitrogenflux_inst , & - ! soilbiogeochem_state_inst, soilbiogeochem_nitrogenstate_inst, soilbiogeochem_nitrogenflux_inst) - ! end if - - !-------------------------------------------- - ! Soil Biogeochemistry - !-------------------------------------------- - - if (decomp_method == century_decomp) then - call decomp_rate_constants_bgc(bounds, num_soilc, filter_soilc, & - soilstate_inst, temperature_inst, ch4_inst, soilbiogeochem_carbonflux_inst) - else if (decomp_method == mimics_decomp) then - call decomp_rates_mimics(bounds, num_soilc, filter_soilc, & - num_soilp, filter_soilp, clm_fates, & - soilstate_inst, temperature_inst, cnveg_carbonflux_inst, ch4_inst, & - soilbiogeochem_carbonflux_inst, soilbiogeochem_carbonstate_inst) - end if - - if ( decomp_method /= no_soil_decomp )then - ! calculate potential decomp rates and total immobilization demand (previously inlined in CNDecompAlloc) - call SoilBiogeochemPotential (bounds, num_soilc, filter_soilc, & - soilbiogeochem_state_inst, soilbiogeochem_carbonstate_inst, soilbiogeochem_carbonflux_inst, & - soilbiogeochem_nitrogenstate_inst, soilbiogeochem_nitrogenflux_inst, & - cn_decomp_pools=cn_decomp_pools(begc:endc,1:nlevdecomp,1:ndecomp_pools), & - p_decomp_cpool_loss=p_decomp_cpool_loss(begc:endc,1:nlevdecomp,1:ndecomp_cascade_transitions), & - p_decomp_cn_gain=p_decomp_cn_gain(begc:endc,1:nlevdecomp,1:ndecomp_pools), & - pmnf_decomp_cascade=pmnf_decomp_cascade(begc:endc,1:nlevdecomp,1:ndecomp_cascade_transitions), & - p_decomp_npool_to_din=p_decomp_npool_to_din(begc:endc,1:nlevdecomp,1:ndecomp_cascade_transitions)) - end if - - !-------------------------------------------- - ! Resolve the competition between plants and soil heterotrophs - ! for available soil mineral N resource - !-------------------------------------------- - ! will add this back in when integrtating hte nutirent cycles - - - !-------------------------------------------- - ! Calculate litter and soil decomposition rate - !-------------------------------------------- - - ! Calculation of actual immobilization and decomp rates, following - ! resolution of plant/heterotroph competition for mineral N (previously inlined in CNDecompAllocation in CNDecompMod) - - if ( decomp_method /= no_soil_decomp )then - call t_startf('SoilBiogeochemDecomp') - - call SoilBiogeochemDecomp (bounds, num_soilc, filter_soilc, & - soilbiogeochem_state_inst, soilbiogeochem_carbonstate_inst, soilbiogeochem_carbonflux_inst, & - soilbiogeochem_nitrogenstate_inst, soilbiogeochem_nitrogenflux_inst, & - cn_decomp_pools=cn_decomp_pools(begc:endc,1:nlevdecomp,1:ndecomp_pools), & - p_decomp_cpool_loss=p_decomp_cpool_loss(begc:endc,1:nlevdecomp,1:ndecomp_cascade_transitions), & - pmnf_decomp_cascade=pmnf_decomp_cascade(begc:endc,1:nlevdecomp,1:ndecomp_cascade_transitions), & - p_decomp_npool_to_din=p_decomp_npool_to_din(begc:endc,1:nlevdecomp,1:ndecomp_cascade_transitions)) - - call t_stopf('SoilBiogeochemDecomp') - - - !-------------------------------------------- - ! Update1 - !-------------------------------------------- - - call t_startf('BNGCUpdate1') - - - ! Update all prognostic carbon state variables (except for gap-phase mortality and fire fluxes) - call CStateUpdate1( num_soilc, filter_soilc, num_soilp, filter_soilp, & - crop_inst, cnveg_carbonflux_inst, cnveg_carbonstate_inst, & - soilbiogeochem_carbonflux_inst, dribble_crophrv_xsmrpool_2atm=.False.) - - call t_stopf('BNGCUpdate1') - - !-------------------------------------------- - ! Calculate vertical mixing of soil and litter pools - !-------------------------------------------- - - call t_startf('SoilBiogeochemLittVertTransp') - - call SoilBiogeochemLittVertTransp(bounds, num_soilc, filter_soilc, & - active_layer_inst, soilbiogeochem_state_inst, & - soilbiogeochem_carbonstate_inst, soilbiogeochem_carbonflux_inst, & - c13_soilbiogeochem_carbonstate_inst, c13_soilbiogeochem_carbonflux_inst, & - c14_soilbiogeochem_carbonstate_inst, c14_soilbiogeochem_carbonflux_inst, & - soilbiogeochem_nitrogenstate_inst, soilbiogeochem_nitrogenflux_inst) - - call t_stopf('SoilBiogeochemLittVertTransp') - end if - - ! Wood product fluxes will eventually be added to FATES-CLM. However - ! it is likely this will be implemented during or after we break away from - ! using this module. This module and the current coupling stategy bypasses - ! a number of processes in CLM, which includes the wood product modules. - ! Therefore the following call is a placeholder so that the wood-product - ! wrapper code can be copied from here and applied at the right place when the time comes. - ! RGK 06-2022 - - !call FatesWrapWoodProducts(bounds, num_soilc, filter_soilc,c_products_inst) - !call t_startf('CNWoodProducts') - !call c_products_inst%UpdateProducts(bounds, & - ! num_soilp, filter_soilp, & - ! dwt_wood_product_gain_patch = cnveg_carbonflux_inst%dwt_wood_productc_gain_patch(begp:endp), & - ! wood_harvest_patch = cnveg_carbonflux_inst%wood_harvestc_patch(begp:endp), & - ! dwt_crop_product_gain_patch = cnveg_carbonflux_inst%dwt_crop_productc_gain_patch(begp:endp), & - ! crop_harvest_to_cropprod_patch = cnveg_carbonflux_inst%crop_harvestc_to_cropprodc_patch(begp:endp)) - !call t_stopf('CNWoodProducts') - - - end associate - - end subroutine EDBGCDyn - - - !----------------------------------------------------------------------- - subroutine EDBGCDynSummary(bounds, num_soilc, filter_soilc, num_soilp, filter_soilp, & - soilbiogeochem_carbonflux_inst, soilbiogeochem_carbonstate_inst, & - c13_soilbiogeochem_carbonflux_inst, c13_soilbiogeochem_carbonstate_inst, & - c14_soilbiogeochem_carbonflux_inst, c14_soilbiogeochem_carbonstate_inst, & - soilbiogeochem_nitrogenflux_inst, soilbiogeochem_nitrogenstate_inst, & - nc) - ! - ! !DESCRIPTION: - ! Call to all CN and SoilBiogeochem summary routines - ! also aggregate production and decomposition fluxes to whole-ecosystem balance fluxes - ! - ! !USES: - use clm_varpar , only: ndecomp_cascade_transitions - use CNPrecisionControlMod , only: CNPrecisionControl - use SoilBiogeochemPrecisionControlMod , only: SoilBiogeochemPrecisionControl - ! - ! !ARGUMENTS: - type(bounds_type) , intent(in) :: bounds - integer , intent(in) :: num_soilc ! number of soil columns in filter - integer , intent(in) :: filter_soilc(:) ! filter for soil columns - integer , intent(in) :: num_soilp ! number of soil patches in filter - integer , intent(in) :: filter_soilp(:) ! filter for soil patches - type(soilbiogeochem_carbonflux_type) , intent(inout) :: soilbiogeochem_carbonflux_inst - type(soilbiogeochem_carbonstate_type) , intent(inout) :: soilbiogeochem_carbonstate_inst - type(soilbiogeochem_carbonflux_type) , intent(inout) :: c13_soilbiogeochem_carbonflux_inst - type(soilbiogeochem_carbonstate_type) , intent(inout) :: c13_soilbiogeochem_carbonstate_inst - type(soilbiogeochem_carbonflux_type) , intent(inout) :: c14_soilbiogeochem_carbonflux_inst - type(soilbiogeochem_carbonstate_type) , intent(inout) :: c14_soilbiogeochem_carbonstate_inst - type(soilbiogeochem_nitrogenflux_type) , intent(inout) :: soilbiogeochem_nitrogenflux_inst - type(soilbiogeochem_nitrogenstate_type) , intent(inout) :: soilbiogeochem_nitrogenstate_inst - integer , intent(in) :: nc ! thread index - ! - ! !LOCAL VARIABLES: - integer :: begc,endc - !----------------------------------------------------------------------- - - begc = bounds%begc; endc= bounds%endc - - ! Call to all summary routines - - call t_startf('BGCsum') - - ! Set controls on very low values in critical state variables - - call SoilBiogeochemPrecisionControl(num_soilc, filter_soilc, & - soilbiogeochem_carbonstate_inst, c13_soilbiogeochem_carbonstate_inst, & - c14_soilbiogeochem_carbonstate_inst,soilbiogeochem_nitrogenstate_inst) - - ! Note - all summary updates to cnveg_carbonstate_inst and cnveg_carbonflux_inst are done in - ! soilbiogeochem_carbonstate_inst%summary and CNVeg_carbonstate_inst%summary - - ! ---------------------------------------------- - ! soilbiogeochem carbon/nitrogen state summary - ! ---------------------------------------------- - - call soilbiogeochem_carbonstate_inst%summary(bounds, num_soilc, filter_soilc) - if ( use_c13 ) then - call c13_soilbiogeochem_carbonstate_inst%summary(bounds, num_soilc, filter_soilc) - end if - if ( use_c14 ) then - call c14_soilbiogeochem_carbonstate_inst%summary(bounds, num_soilc, filter_soilc) - end if - ! call soilbiogeochem_nitrogenstate_inst%summary(bounds, num_soilc, filter_soilc) - - ! ---------------------------------------------- - ! soilbiogeochem carbon/nitrogen flux summary - ! ---------------------------------------------- - - call soilbiogeochem_carbonflux_inst%Summary(bounds, num_soilc, filter_soilc) - if ( use_c13 ) then - call c13_soilbiogeochem_carbonflux_inst%Summary(bounds, num_soilc, filter_soilc) - end if - if ( use_c14 ) then - call c14_soilbiogeochem_carbonflux_inst%Summary(bounds, num_soilc, filter_soilc) - end if - ! call soilbiogeochem_nitrogenflux_inst%Summary(bounds, num_soilc, filter_soilc) - - - call t_stopf('BGCsum') - - end subroutine EDBGCDynSummary - -end module EDBGCDynMod diff --git a/src/main/clm_driver.F90 b/src/main/clm_driver.F90 index b01034dc2a..d035b8cda3 100644 --- a/src/main/clm_driver.F90 +++ b/src/main/clm_driver.F90 @@ -80,7 +80,6 @@ module clm_driver use ColumnType , only : col use PatchType , only : patch use clm_instMod - use EDBGCDynMod , only : EDBGCDyn, EDBGCDynSummary use SoilMoistureStreamMod , only : PrescribedSoilMoistureInterp, PrescribedSoilMoistureAdvance use SoilBiogeochemDecompCascadeConType , only : no_soil_decomp, decomp_method ! @@ -325,12 +324,12 @@ subroutine clm_drv(doalb, nextsw_cday, declinp1, declin, rstwr, nlend, rdate, ro call get_clump_bounds(nc, bounds_clump) call t_startf('begcnbal_grc') - if (use_cn) then + if (use_cn .or. use_fates) then ! Initialize gridcell-level balance check call bgc_vegetation_inst%InitGridcellBalance(bounds_clump, & filter(nc)%num_allc, filter(nc)%allc, & - filter(nc)%num_soilc, filter(nc)%soilc, & - filter(nc)%num_soilp, filter(nc)%soilp, & + filter(nc)%num_bgc_soilc, filter(nc)%bgc_soilc, & + filter(nc)%num_bgc_vegp, filter(nc)%bgc_vegp, & soilbiogeochem_carbonstate_inst, & c13_soilbiogeochem_carbonstate_inst, & c14_soilbiogeochem_carbonstate_inst, & @@ -415,12 +414,12 @@ subroutine clm_drv(doalb, nextsw_cday, declinp1, declin, rstwr, nlend, rdate, ro call t_stopf('begwbal') call t_startf('begcnbal_col') - if (use_cn) then + if (use_cn .or. use_fates) then ! Initialize column-level balance check call bgc_vegetation_inst%InitColumnBalance(bounds_clump, & filter(nc)%num_allc, filter(nc)%allc, & - filter(nc)%num_soilc, filter(nc)%soilc, & - filter(nc)%num_soilp, filter(nc)%soilp, & + filter(nc)%num_bgc_soilc, filter(nc)%bgc_soilc, & + filter(nc)%num_bgc_vegp, filter(nc)%bgc_vegp, & soilbiogeochem_carbonstate_inst, & c13_soilbiogeochem_carbonstate_inst, & c14_soilbiogeochem_carbonstate_inst, & @@ -999,32 +998,32 @@ subroutine clm_drv(doalb, nextsw_cday, declinp1, declin, rstwr, nlend, rdate, ro ! Filter bgc_soilc operates on all non-sp soil columns ! Filter bgc_vegp operates on all non-fates, non-sp patches (use_cn) on soil - - call t_startf('ecosysdyn') - call bgc_vegetation_inst%EcosystemDynamicsPreDrainage(bounds_clump, & - filter(nc)%num_bgc_soilc, filter(nc)%bgc_soilc, & - filter(nc)%num_bgc_vegp, filter(nc)%bgc_vegp, & - filter(nc)%num_actfirec, filter(nc)%actfirec, & - filter(nc)%num_actfirep, filter(nc)%actfirep, & - filter(nc)%num_pcropp, filter(nc)%pcropp, & - filter(nc)%num_soilnopcropp, filter(nc)%soilnopcropp, & - filter(nc)%num_exposedvegp, filter(nc)%exposedvegp, & - filter(nc)%num_noexposedvegp, filter(nc)%noexposedvegp, & - soilbiogeochem_carbonflux_inst, soilbiogeochem_carbonstate_inst, & - c13_soilbiogeochem_carbonflux_inst, c13_soilbiogeochem_carbonstate_inst, & - c14_soilbiogeochem_carbonflux_inst, c14_soilbiogeochem_carbonstate_inst, & - soilbiogeochem_state_inst, & - soilbiogeochem_nitrogenflux_inst, soilbiogeochem_nitrogenstate_inst, & - active_layer_inst, clm_fates, & - atm2lnd_inst, water_inst%waterstatebulk_inst, & - water_inst%waterdiagnosticbulk_inst, water_inst%waterfluxbulk_inst, & - water_inst%wateratm2lndbulk_inst, canopystate_inst, soilstate_inst, temperature_inst, & - soil_water_retention_curve, crop_inst, ch4_inst, & - photosyns_inst, saturated_excess_runoff_inst, energyflux_inst, & - nutrient_competition_method, fireemis_inst) - - call t_stopf('ecosysdyn') - + + if(use_cn .or. use_fates)then + call t_startf('ecosysdyn') + call bgc_vegetation_inst%EcosystemDynamicsPreDrainage(bounds_clump, & + filter(nc)%num_bgc_soilc, filter(nc)%bgc_soilc, & + filter(nc)%num_bgc_vegp, filter(nc)%bgc_vegp, & + filter(nc)%num_actfirec, filter(nc)%actfirec, & + filter(nc)%num_actfirep, filter(nc)%actfirep, & + filter(nc)%num_pcropp, filter(nc)%pcropp, & + filter(nc)%num_soilnopcropp, filter(nc)%soilnopcropp, & + filter(nc)%num_exposedvegp, filter(nc)%exposedvegp, & + filter(nc)%num_noexposedvegp, filter(nc)%noexposedvegp, & + soilbiogeochem_carbonflux_inst, soilbiogeochem_carbonstate_inst, & + c13_soilbiogeochem_carbonflux_inst, c13_soilbiogeochem_carbonstate_inst, & + c14_soilbiogeochem_carbonflux_inst, c14_soilbiogeochem_carbonstate_inst, & + soilbiogeochem_state_inst, & + soilbiogeochem_nitrogenflux_inst, soilbiogeochem_nitrogenstate_inst, & + active_layer_inst, clm_fates, & + atm2lnd_inst, water_inst%waterstatebulk_inst, & + water_inst%waterdiagnosticbulk_inst, water_inst%waterfluxbulk_inst, & + water_inst%wateratm2lndbulk_inst, canopystate_inst, soilstate_inst, temperature_inst, & + soil_water_retention_curve, crop_inst, ch4_inst, & + photosyns_inst, saturated_excess_runoff_inst, energyflux_inst, & + nutrient_competition_method, fireemis_inst) + call t_stopf('ecosysdyn') + end if ! Prescribed biogeography - prescribed canopy structure, some prognostic carbon fluxes @@ -1078,23 +1077,24 @@ subroutine clm_drv(doalb, nextsw_cday, declinp1, declin, rstwr, nlend, rdate, ro call t_stopf('hydro2_drainage') - call t_startf('EcosysDynPostDrainage') - call bgc_vegetation_inst%EcosystemDynamicsPostDrainage(bounds_clump, & - filter(nc)%num_allc, filter(nc)%allc, & - filter(nc)%num_bgc_soilc, filter(nc)%bgc_soilc, & - filter(nc)%num_bgc_vegp, filter(nc)%bgc_vegp, & - filter(nc)%num_actfirec, filter(nc)%actfirec, & - filter(nc)%num_actfirep, filter(nc)%actfirep, & - doalb, crop_inst, & - soilstate_inst, soilbiogeochem_state_inst, & - water_inst%waterstatebulk_inst, water_inst%waterdiagnosticbulk_inst, & - water_inst%waterfluxbulk_inst, frictionvel_inst, canopystate_inst, & - soilbiogeochem_carbonflux_inst, soilbiogeochem_carbonstate_inst, & - c13_soilbiogeochem_carbonflux_inst, c13_soilbiogeochem_carbonstate_inst, & - c14_soilbiogeochem_carbonflux_inst, c14_soilbiogeochem_carbonstate_inst, & - soilbiogeochem_nitrogenflux_inst, soilbiogeochem_nitrogenstate_inst) - call t_stopf('EcosysDynPostDrainage') - + if (use_cn .or. use_fates) then + call t_startf('EcosysDynPostDrainage') + call bgc_vegetation_inst%EcosystemDynamicsPostDrainage(bounds_clump, & + filter(nc)%num_allc, filter(nc)%allc, & + filter(nc)%num_bgc_soilc, filter(nc)%bgc_soilc, & + filter(nc)%num_bgc_vegp, filter(nc)%bgc_vegp, & + filter(nc)%num_actfirec, filter(nc)%actfirec, & + filter(nc)%num_actfirep, filter(nc)%actfirep, & + doalb, crop_inst, & + soilstate_inst, soilbiogeochem_state_inst, & + water_inst%waterstatebulk_inst, water_inst%waterdiagnosticbulk_inst, & + water_inst%waterfluxbulk_inst, frictionvel_inst, canopystate_inst, & + soilbiogeochem_carbonflux_inst, soilbiogeochem_carbonstate_inst, & + c13_soilbiogeochem_carbonflux_inst, c13_soilbiogeochem_carbonstate_inst, & + c14_soilbiogeochem_carbonflux_inst, c14_soilbiogeochem_carbonstate_inst, & + soilbiogeochem_nitrogenflux_inst, soilbiogeochem_nitrogenstate_inst) + call t_stopf('EcosysDynPostDrainage') + end if if ( use_fates) then @@ -1103,32 +1103,7 @@ subroutine clm_drv(doalb, nextsw_cday, declinp1, declin, rstwr, nlend, rdate, ro ! for leaf photosynthetic acclimation temperature. These ! moving averages are updated here call clm_fates%WrapUpdateFatesRmean(nc,temperature_inst) - end if - - ! call EDBGCDyn(bounds_clump, & - ! filter(nc)%num_soilc, filter(nc)%soilc, & - ! filter(nc)%num_soilp, filter(nc)%soilp, & - ! filter(nc)%num_pcropp, filter(nc)%pcropp, doalb, & - ! bgc_vegetation_inst%cnveg_carbonflux_inst, & - ! bgc_vegetation_inst%cnveg_carbonstate_inst, & - ! soilbiogeochem_carbonflux_inst, soilbiogeochem_carbonstate_inst, & - ! soilbiogeochem_state_inst, clm_fates, & - ! soilbiogeochem_nitrogenflux_inst, soilbiogeochem_nitrogenstate_inst, & - ! c13_soilbiogeochem_carbonstate_inst, c13_soilbiogeochem_carbonflux_inst, & - ! c14_soilbiogeochem_carbonstate_inst, c14_soilbiogeochem_carbonflux_inst, & - ! active_layer_inst, atm2lnd_inst, water_inst%waterfluxbulk_inst, & - ! canopystate_inst, soilstate_inst, temperature_inst, crop_inst, ch4_inst) - - !if ( decomp_method /= no_soil_decomp )then - ! call EDBGCDynSummary(bounds_clump, & - ! filter(nc)%num_soilc, filter(nc)%soilc, & - ! filter(nc)%num_soilp, filter(nc)%soilp, & - ! soilbiogeochem_carbonflux_inst, soilbiogeochem_carbonstate_inst, & - ! c13_soilbiogeochem_carbonflux_inst, c13_soilbiogeochem_carbonstate_inst, & - ! c14_soilbiogeochem_carbonflux_inst, c14_soilbiogeochem_carbonstate_inst, & - ! soilbiogeochem_nitrogenflux_inst, soilbiogeochem_nitrogenstate_inst, & - ! nc) - ! end if + call clm_fates%wrap_update_hifrq_hist(bounds_clump, & soilbiogeochem_carbonflux_inst, & @@ -1141,9 +1116,6 @@ subroutine clm_drv(doalb, nextsw_cday, declinp1, declin, rstwr, nlend, rdate, ro ! This is the main call to FATES dynamics ! -------------------------------------------------------------------------- - if ( masterproc ) then - write(iulog,*) 'clm: calling FATES model ', get_nstep() - end if call clm_fates%dynamics_driv( nc, bounds_clump, & atm2lnd_inst, soilstate_inst, temperature_inst, active_layer_inst, & water_inst%waterstatebulk_inst, water_inst%waterdiagnosticbulk_inst, & @@ -1173,16 +1145,18 @@ subroutine clm_drv(doalb, nextsw_cday, declinp1, declin, rstwr, nlend, rdate, ro ! Check the carbon and nitrogen balance ! ============================================================================ - call t_startf('cnbalchk') - call bgc_vegetation_inst%BalanceCheck( & - bounds_clump, filter(nc)%num_bgc_soilc, filter(nc)%bgc_soilc, & - soilbiogeochem_carbonflux_inst, & - soilbiogeochem_nitrogenflux_inst, & - soilbiogeochem_carbonstate_inst, & - soilbiogeochem_nitrogenstate_inst, & - atm2lnd_inst, clm_fates ) - call t_stopf('cnbalchk') - + if(use_cn .or. use_fates)then + call t_startf('cnbalchk') + call bgc_vegetation_inst%BalanceCheck( & + bounds_clump, filter(nc)%num_bgc_soilc, filter(nc)%bgc_soilc, & + soilbiogeochem_carbonflux_inst, & + soilbiogeochem_nitrogenflux_inst, & + soilbiogeochem_carbonstate_inst, & + soilbiogeochem_nitrogenstate_inst, & + atm2lnd_inst, clm_fates ) + call t_stopf('cnbalchk') + end if + ! Calculation of methane fluxes if (use_lch4) then diff --git a/src/main/filterMod.F90 b/src/main/filterMod.F90 index 37c22cc85b..bf7a9d625a 100644 --- a/src/main/filterMod.F90 +++ b/src/main/filterMod.F90 @@ -19,6 +19,7 @@ module filterMod use ColumnType , only : col use PatchType , only : patch use glcBehaviorMod , only : glc_behavior_type + use clm_varctl , only : use_cn, use_fates, use_fates_sp ! ! !PUBLIC TYPES: implicit none diff --git a/src/soilbiogeochem/SoilBiogeochemCarbonFluxType.F90 b/src/soilbiogeochem/SoilBiogeochemCarbonFluxType.F90 index 114019a3d7..e42e395801 100644 --- a/src/soilbiogeochem/SoilBiogeochemCarbonFluxType.F90 +++ b/src/soilbiogeochem/SoilBiogeochemCarbonFluxType.F90 @@ -14,7 +14,6 @@ module SoilBiogeochemCarbonFluxType use ColumnType , only : col use LandunitType , only : lun use SparseMatrixMultiplyMod , only : sparse_matrix_type, diag_matrix_type, vector_type - use clm_varctl , only : use_fates ! ! !PUBLIC TYPES: @@ -59,12 +58,6 @@ module SoilBiogeochemCarbonFluxType real(r8), pointer :: somhr_col (:) ! (gC/m2/s) soil organic matter heterotrophic res: donor-pool based definition real(r8), pointer :: soilc_change_col (:) ! (gC/m2/s) FUN used soil C - ! fluxes to receive carbon inputs from FATES - real(r8), pointer :: FATES_c_to_litr_c_col (:,:,:) ! total litter coming from ED. gC/m3/s - real(r8), pointer :: FATES_c_to_litr_lab_c_col (:,:) ! total labile litter coming from ED. gC/m3/s - real(r8), pointer :: FATES_c_to_litr_cel_c_col (:,:) ! total cellulose litter coming from ED. gC/m3/s - real(r8), pointer :: FATES_c_to_litr_lig_c_col (:,:) ! total lignin litter coming from ED. gC/m3/s - contains procedure , public :: Init @@ -165,22 +158,7 @@ subroutine InitAllocate(this, bounds) if(use_soil_matrixcn)then end if - if ( use_fates ) then - ! initialize these variables to be zero rather than a bad number since they are not zeroed every timestep (due to a need for them to persist) - - allocate(this%FATES_c_to_litr_c_col(begc:endc,1:nlevdecomp_full,1:ndecomp_pools)) - this%FATES_c_to_litr_c_col(begc:endc,1:nlevdecomp_full,1:ndecomp_pools) = 0._r8 - - allocate(this%FATES_c_to_litr_lab_c_col(begc:endc,1:nlevdecomp_full)) - this%FATES_c_to_litr_lab_c_col(begc:endc,1:nlevdecomp_full) = 0._r8 - - allocate(this%FATES_c_to_litr_cel_c_col(begc:endc,1:nlevdecomp_full)) - this%FATES_c_to_litr_cel_c_col(begc:endc,1:nlevdecomp_full) = 0._r8 - - allocate(this%FATES_c_to_litr_lig_c_col(begc:endc,1:nlevdecomp_full)) - this%FATES_c_to_litr_lig_c_col(begc:endc,1:nlevdecomp_full) = 0._r8 - endif allocate(this%litr_lig_c_to_n_col(begc:endc)) this%litr_lig_c_to_n_col(:)= 0._r8 @@ -625,23 +603,6 @@ subroutine InitHistory(this, bounds, carbon_type) end do - if ( use_fates ) then - - call hist_addfld_decomp(fname='FATES_c_to_litr_lab_c', units='gC/m^3/s', type2d='levdcmp', & - avgflag='A', long_name='litter labile carbon flux from FATES to BGC', & - ptr_col=this%FATES_c_to_litr_lab_c_col) - - call hist_addfld_decomp(fname='FATES_c_to_litr_cel_c', units='gC/m^3/s', type2d='levdcmp', & - avgflag='A', long_name='litter celluluse carbon flux from FATES to BGC', & - ptr_col=this%FATES_c_to_litr_cel_c_col) - - call hist_addfld_decomp(fname='FATES_c_to_litr_lig_c', units='gC/m^3/s', type2d='levdcmp', & - avgflag='A', long_name='litter lignin carbon flux from FATES to BGC', & - ptr_col=this%FATES_c_to_litr_lig_c_col) - - endif - - end subroutine InitHistory !----------------------------------------------------------------------- @@ -694,40 +655,6 @@ subroutine Restart(this, bounds, ncid, flag) logical :: readvar !----------------------------------------------------------------------- - ! - ! if FATES is enabled, need to restart the variables used to transfer from FATES to CLM as they - ! are persistent between daily FATES dynamics calls and half-hourly CLM timesteps - ! - if ( use_fates ) then - - ptr2d => this%FATES_c_to_litr_lab_c_col - call restartvar(ncid=ncid, flag=flag, varname='FATES_c_to_litr_lab_c_col', xtype=ncd_double, & - dim1name='column', dim2name='levgrnd', switchdim=.true., & - long_name='', units='gC/m3/s', scale_by_thickness=.false., & - interpinic_flag='interp', readvar=readvar, data=ptr2d) - - ptr2d => this%FATES_c_to_litr_cel_c_col - call restartvar(ncid=ncid, flag=flag, varname='FATES_c_to_litr_cel_c_col', xtype=ncd_double, & - dim1name='column', dim2name='levgrnd', switchdim=.true., & - long_name='', units='gC/m3/s', scale_by_thickness=.false., & - interpinic_flag='interp', readvar=readvar, data=ptr2d) - - ptr2d => this%FATES_c_to_litr_lig_c_col - call restartvar(ncid=ncid, flag=flag, varname='FATES_c_to_litr_lig_c_col', xtype=ncd_double, & - dim1name='column', dim2name='levgrnd', switchdim=.true., & - long_name='', units='gC/m3/s', scale_by_thickness=.false., & - interpinic_flag='interp', readvar=readvar, data=ptr2d) - - ! Copy last 3 variables to an array of litter pools for use in do loops. - ! Repeat copy in src/utils/clmfates_interfaceMod.F90. - ! Keep the three originals to avoid backwards compatibility issues with - ! restart files. - this%FATES_c_to_litr_c_col(:,:,1) = this%FATES_c_to_litr_lab_c_col(:,:) - this%FATES_c_to_litr_c_col(:,:,2) = this%FATES_c_to_litr_cel_c_col(:,:) - this%FATES_c_to_litr_c_col(:,:,3) = this%FATES_c_to_litr_lig_c_col(:,:) - - end if - call restartvar(ncid=ncid, flag=flag, varname='ligninNratioAvg', xtype=ncd_double, & dim1name='column', & long_name='', units='', & @@ -806,8 +733,6 @@ subroutine SetValues ( this, num_column, filter_column, value_column) this%soilc_change_col(i) = value_column end do - ! NOTE: do not zero the fates to BGC C flux variables since they need to persist from the daily fates timestep s to the half-hourly BGC timesteps. I.e. FATES_c_to_litr_lab_c_col, FATES_c_to_litr_cel_c_col, FATES_c_to_litr_lig_c_col - end subroutine SetValues !----------------------------------------------------------------------- @@ -970,18 +895,19 @@ subroutine Summary(this, bounds, & ! Calculate ligninNratio ! FATES does its own calculation - if (.not. use_fates .and. decomp_method == mimics_decomp) then + if (decomp_method == mimics_decomp) then do fp = 1,num_soilp p = filter_soilp(fp) - - associate(ivt => patch%itype) ! Input: [integer (:)] patch plant type - ligninNratio_leaf_patch(p) = pftcon%lf_flig(ivt(p)) * & - pftcon%lflitcn(ivt(p)) * & - leafc_to_litter_patch(p) - ligninNratio_froot_patch(p) = pftcon%fr_flig(ivt(p)) * & - pftcon%frootcn(ivt(p)) * & - frootc_to_litter_patch(p) - end associate + if( .not.patch%is_fates(p)) then + associate(ivt => patch%itype) ! Input: [integer (:)] patch plant type + ligninNratio_leaf_patch(p) = pftcon%lf_flig(ivt(p)) * & + pftcon%lflitcn(ivt(p)) * & + leafc_to_litter_patch(p) + ligninNratio_froot_patch(p) = pftcon%fr_flig(ivt(p)) * & + pftcon%frootcn(ivt(p)) * & + frootc_to_litter_patch(p) + end associate + end if end do call p2c(bounds, num_soilc, filter_soilc, & diff --git a/src/soilbiogeochem/SoilBiogeochemCarbonStateType.F90 b/src/soilbiogeochem/SoilBiogeochemCarbonStateType.F90 index a09441069a..349a6c140d 100644 --- a/src/soilbiogeochem/SoilBiogeochemCarbonStateType.F90 +++ b/src/soilbiogeochem/SoilBiogeochemCarbonStateType.F90 @@ -17,6 +17,7 @@ module SoilBiogeochemCarbonStateType use GridcellType , only : grc use SoilBiogeochemStateType , only : get_spinup_latitude_term use SparseMatrixMultiplyMod , only : sparse_matrix_type, vector_type + use CNVegCarbonStateType , only : cnveg_carbonstate_type ! ! !PUBLIC TYPES: implicit none @@ -30,19 +31,28 @@ module SoilBiogeochemCarbonStateType real(r8), pointer :: ctrunc_vr_col (:,:) ! (gC/m3) vertically-resolved column-level sink for C truncation ! summary (diagnostic) state variables, not involved in mass balance - real(r8), pointer :: ctrunc_col (:) ! (gC/m2) column-level sink for C truncation - real(r8), pointer :: totmicc_col (:) ! (gC/m2) total microbial carbon - real(r8), pointer :: totlitc_col (:) ! (gC/m2) total litter carbon - real(r8), pointer :: totlitc_1m_col (:) ! (gC/m2) total litter carbon to 1 meter - real(r8), pointer :: totsomc_col (:) ! (gC/m2) total soil organic matter carbon - real(r8), pointer :: totsomc_1m_col (:) ! (gC/m2) total soil organic matter carbon to 1 meter - real(r8), pointer :: cwdc_col (:) ! (gC/m2) coarse woody debris C (diagnostic) - real(r8), pointer :: decomp_cpools_1m_col (:,:) ! (gC/m2) Diagnostic: decomposing (litter, cwd, soil) c pools to 1 meter - real(r8), pointer :: decomp_cpools_col (:,:) ! (gC/m2) decomposing (litter, cwd, soil) c pools - real(r8), pointer :: dyn_cbal_adjustments_col(:) ! (gC/m2) adjustments to each column made in this timestep via dynamic column area adjustments (note: this variable only makes sense at the column-level: it is meaningless if averaged to the gridcell-level) - integer :: restart_file_spinup_state ! spinup state as read from restart file, for determining whether to enter or exit spinup mode. - real(r8) :: totvegcthresh ! threshold for total vegetation carbon to zero out decomposition pools + real(r8), pointer :: ctrunc_col (:) ! (gC/m2) column-level sink for C truncation + real(r8), pointer :: totmicc_col (:) ! (gC/m2) total microbial carbon + real(r8), pointer :: totlitc_col (:) ! (gC/m2) total litter carbon + real(r8), pointer :: totlitc_1m_col (:) ! (gC/m2) total litter carbon to 1 meter + real(r8), pointer :: totsomc_col (:) ! (gC/m2) total soil organic matter carbon + real(r8), pointer :: totsomc_1m_col (:) ! (gC/m2) total soil organic matter carbon to 1 meter + real(r8), pointer :: cwdc_col (:) ! (gC/m2) coarse woody debris C (diagnostic) + real(r8), pointer :: decomp_cpools_1m_col (:,:) ! (gC/m2) Diagnostic: decomposing (litter, cwd, soil) c pools to 1 meter + real(r8), pointer :: decomp_cpools_col (:,:) ! (gC/m2) decomposing (litter, cwd, soil) c pools + real(r8), pointer :: dyn_cbal_adjustments_col(:) ! (gC/m2) adjustments to each column made in this timestep via dynamic column + ! area adjustments (note: this variable only makes sense at the column-level: + ! it is meaningless if averaged to the gridcell-level) + integer :: restart_file_spinup_state ! spinup state as read from restart file, for determining whether to enter or exit spinup mode. + real(r8) :: totvegcthresh ! threshold for total vegetation carbon to zero out decomposition pools + + + ! Carbon totals, includes soil, cpool and vegetation + real(r8), pointer :: totc_col (:) ! (gC/m2) total column carbon, incl veg and cpool + real(r8), pointer :: totecosysc_col (:) ! (gC/m2) total ecosystem carbon, incl veg but excl cpool + real(r8), pointer :: totc_grc (:) ! (gC/m2) total gridcell carbon + ! Matrix-cn contains @@ -95,9 +105,11 @@ subroutine InitAllocate(this, bounds) ! ! !LOCAL VARIABLES: integer :: begc,endc + integer :: begg,endg !------------------------------------------------------------------------ begc = bounds%begc; endc = bounds%endc + begg = bounds%begg; endg = bounds%endg allocate( this%decomp_cpools_col (begc :endc,1:ndecomp_pools)) ; this%decomp_cpools_col (:,:) = nan allocate( this%decomp_cpools_1m_col (begc :endc,1:ndecomp_pools)) ; this%decomp_cpools_1m_col (:,:) = nan @@ -116,9 +128,8 @@ subroutine InitAllocate(this, bounds) this%decomp_soilc_vr_col(:,:)= nan allocate(this%ctrunc_col (begc :endc)) ; this%ctrunc_col (:) = nan - if ( .not. use_fates ) then - allocate(this%cwdc_col (begc :endc)) ; this%cwdc_col (:) = nan - endif + allocate(this%cwdc_col (begc :endc)) ; this%cwdc_col (:) = nan + allocate(this%totmicc_col (begc :endc)) ; this%totmicc_col (:) = nan allocate(this%totlitc_col (begc :endc)) ; this%totlitc_col (:) = nan allocate(this%totsomc_col (begc :endc)) ; this%totsomc_col (:) = nan @@ -126,6 +137,10 @@ subroutine InitAllocate(this, bounds) allocate(this%totsomc_1m_col (begc :endc)) ; this%totsomc_1m_col (:) = nan allocate(this%dyn_cbal_adjustments_col (begc:endc)) ; this%dyn_cbal_adjustments_col (:) = nan + allocate(this%totc_col (begc:endc)) ; this%totc_col (:) = nan + allocate(this%totecosysc_col (begc:endc)) ; this%totecosysc_col (:) = nan + allocate(this%totc_grc (begg:endg)) ; this%totc_grc (:) = nan + this%restart_file_spinup_state = huge(1) end subroutine InitAllocate @@ -249,6 +264,16 @@ subroutine InitHistory(this, bounds, carbon_type) &only makes sense at the column level: should not be averaged to gridcell', & ptr_col=this%dyn_cbal_adjustments_col, default='inactive') + this%totc_col(begc:endc) = spval + call hist_addfld1d (fname='TOTCOLC', units='gC/m^2', & + avgflag='A', long_name='total column carbon, incl veg and cpool but excl product pools', & + ptr_col=this%totc_col) + + this%totecosysc_col(begc:endc) = spval + call hist_addfld1d (fname='TOTECOSYSC', units='gC/m^2', & + avgflag='A', long_name='total ecosystem carbon, incl veg but excl cpool and product pools', & + ptr_col=this%totecosysc_col) + end if !------------------------------- @@ -336,6 +361,17 @@ subroutine InitHistory(this, bounds, carbon_type) long_name='C13 adjustments in soil carbon due to dynamic column areas; & &only makes sense at the column level: should not be averaged to gridcell', & ptr_col=this%dyn_cbal_adjustments_col, default='inactive') + + this%totc_col(begc:endc) = spval + call hist_addfld1d (fname='C13_TOTCOLC', units='gC13/m^2', & + avgflag='A', long_name='C13 total column carbon, incl veg and cpool but excl product pools', & + ptr_col=this%totc_col, default='inactive') + + this%totecosysc_col(begc:endc) = spval + call hist_addfld1d (fname='C13_TOTECOSYSC', units='gC13/m^2', & + avgflag='A', long_name='C13 total ecosystem carbon, incl veg but excl cpool and product pools', & + ptr_col=this%totecosysc_col) + endif !------------------------------- @@ -426,6 +462,17 @@ subroutine InitHistory(this, bounds, carbon_type) long_name='C14 adjustments in soil carbon due to dynamic column areas; & &only makes sense at the column level: should not be averaged to gridcell', & ptr_col=this%dyn_cbal_adjustments_col, default='inactive') + + this%totc_col(begc:endc) = spval + call hist_addfld1d (fname='C14_TOTCOLC', units='gC14/m^2', & + avgflag='A', long_name='C14 total column carbon, incl veg and cpool but excl product pools', & + ptr_col=this%totc_col, default='inactive') + + this%totecosysc_col(begc:endc) = spval + call hist_addfld1d (fname='C14_TOTECOSYSC', units='gC14/m^2', & + avgflag='A', long_name='C14 total ecosystem carbon, incl veg but excl cpool and product pools', & + ptr_col=this%totecosysc_col) + endif end subroutine InitHistory @@ -445,7 +492,7 @@ subroutine InitCold(this, bounds, ratio, c12_soilbiogeochem_carbonstate_inst) type(soilbiogeochem_carbonstate_type), intent(in), optional :: c12_soilbiogeochem_carbonstate_inst ! ! !LOCAL VARIABLES: - integer :: p,c,l,j,k + integer :: p,c,l,j,k,g integer :: fc ! filter index integer :: num_special_col ! number of good values in special_col filter integer :: special_col(bounds%endc-bounds%begc+1) ! special landunit filter - columns @@ -523,23 +570,30 @@ subroutine InitCold(this, bounds, ratio, c12_soilbiogeochem_carbonstate_inst) end if end if - if ( .not. use_fates ) then - if (lun%itype(l) == istsoil .or. lun%itype(l) == istcrop) then - if (present(c12_soilbiogeochem_carbonstate_inst)) then - this%cwdc_col(c) = c12_soilbiogeochem_carbonstate_inst%cwdc_col(c) * ratio - else - this%cwdc_col(c) = 0._r8 - end if - this%ctrunc_col(c) = 0._r8 - this%totmicc_col(c) = 0._r8 - this%totlitc_col(c) = 0._r8 - this%totsomc_col(c) = 0._r8 - this%totlitc_1m_col(c) = 0._r8 - this%totsomc_1m_col(c) = 0._r8 + + if (lun%itype(l) == istsoil .or. lun%itype(l) == istcrop) then + if (present(c12_soilbiogeochem_carbonstate_inst) .and. (.not.col%is_fates(c)) ) then + this%cwdc_col(c) = c12_soilbiogeochem_carbonstate_inst%cwdc_col(c) * ratio + else + this%cwdc_col(c) = 0._r8 end if + this%ctrunc_col(c) = 0._r8 + this%totmicc_col(c) = 0._r8 + this%totlitc_col(c) = 0._r8 + this%totsomc_col(c) = 0._r8 + this%totlitc_1m_col(c) = 0._r8 + this%totsomc_1m_col(c) = 0._r8 + + this%totc_col(c) = 0._r8 + this%totecosysc_col(c) = 0._r8 end if + end do + do g = bounds%begg, bounds%endg + this%totc_grc(g) = 0._r8 + end do + ! now loop through special filters and explicitly set the variables that ! have to be in place for biogeophysics @@ -815,7 +869,7 @@ subroutine SetValues ( this, num_column, filter_column, value_column) do fi = 1,num_column i = filter_column(fi) - if ( .not. use_fates ) then + if ( .not. col%is_fates(i) ) then this%cwdc_col(i) = value_column end if this%ctrunc_col(i) = value_column @@ -824,6 +878,8 @@ subroutine SetValues ( this, num_column, filter_column, value_column) this%totlitc_1m_col(i) = value_column this%totsomc_col(i) = value_column this%totsomc_1m_col(i) = value_column + this%totc_col(i) = value_column + this%totecosysc_col(i) = value_column end do do j = 1,nlevdecomp_full @@ -875,7 +931,7 @@ subroutine SetValues ( this, num_column, filter_column, value_column) end subroutine SetValues !----------------------------------------------------------------------- - subroutine Summary(this, bounds, num_allc, filter_allc) + subroutine Summary(this, bounds, num_soilc, filter_soilc, cnveg_carbonstate_inst) ! ! !DESCRIPTION: ! Perform column-level carbon summary calculations @@ -883,19 +939,23 @@ subroutine Summary(this, bounds, num_allc, filter_allc) ! !ARGUMENTS: class(soilbiogeochem_carbonstate_type) :: this type(bounds_type) , intent(in) :: bounds - integer , intent(in) :: num_allc ! number of columns in allc filter - integer , intent(in) :: filter_allc(:) ! filter for all active columns + integer , intent(in) :: num_soilc ! number of columns in soil filter + integer , intent(in) :: filter_soilc(:) ! filter for all active columns + type(cnveg_carbonstate_type) , intent(inout) :: cnveg_carbonstate_inst + ! ! !LOCAL VARIABLES: integer :: c,j,k,l ! indices integer :: fc ! filter indices real(r8) :: maxdepth ! depth to integrate soil variables + real(r8) :: ecovegc_col + real(r8) :: totvegc_col !----------------------------------------------------------------------- ! vertically integrate each of the decomposing C pools do l = 1, ndecomp_pools - do fc = 1,num_allc - c = filter_allc(fc) + do fc = 1,num_soilc + c = filter_soilc(fc) this%decomp_cpools_col(c,l) = 0._r8 if(use_soil_matrixcn)then end if @@ -903,8 +963,8 @@ subroutine Summary(this, bounds, num_allc, filter_allc) end do do l = 1, ndecomp_pools do j = 1, nlevdecomp - do fc = 1,num_allc - c = filter_allc(fc) + do fc = 1,num_soilc + c = filter_soilc(fc) this%decomp_cpools_col(c,l) = & this%decomp_cpools_col(c,l) + & this%decomp_cpools_vr_col(c,j,l) * dzsoi_decomp(j) @@ -919,23 +979,23 @@ subroutine Summary(this, bounds, num_allc, filter_allc) ! vertically integrate each of the decomposing C pools to 1 meter maxdepth = 1._r8 do l = 1, ndecomp_pools - do fc = 1,num_allc - c = filter_allc(fc) + do fc = 1,num_soilc + c = filter_soilc(fc) this%decomp_cpools_1m_col(c,l) = 0._r8 end do end do do l = 1, ndecomp_pools do j = 1, nlevdecomp if ( zisoi(j) <= maxdepth ) then - do fc = 1,num_allc - c = filter_allc(fc) + do fc = 1,num_soilc + c = filter_soilc(fc) this%decomp_cpools_1m_col(c,l) = & this%decomp_cpools_1m_col(c,l) + & this%decomp_cpools_vr_col(c,j,l) * dzsoi_decomp(j) end do elseif ( zisoi(j-1) < maxdepth ) then - do fc = 1,num_allc - c = filter_allc(fc) + do fc = 1,num_soilc + c = filter_soilc(fc) this%decomp_cpools_1m_col(c,l) = & this%decomp_cpools_1m_col(c,l) + & this%decomp_cpools_vr_col(c,j,l) * (maxdepth - zisoi(j-1)) @@ -949,16 +1009,16 @@ subroutine Summary(this, bounds, num_allc, filter_allc) ! Add soil carbon pools together to produce vertically-resolved decomposing total soil c pool if ( nlevdecomp_full > 1 ) then do j = 1, nlevdecomp - do fc = 1,num_allc - c = filter_allc(fc) + do fc = 1,num_soilc + c = filter_soilc(fc) this%decomp_soilc_vr_col(c,j) = 0._r8 end do end do do l = 1, ndecomp_pools if ( decomp_cascade_con%is_soil(l) ) then do j = 1, nlevdecomp - do fc = 1,num_allc - c = filter_allc(fc) + do fc = 1,num_soilc + c = filter_soilc(fc) this%decomp_soilc_vr_col(c,j) = this%decomp_soilc_vr_col(c,j) + & this%decomp_cpools_vr_col(c,j,l) end do @@ -968,13 +1028,13 @@ subroutine Summary(this, bounds, num_allc, filter_allc) end if ! truncation carbon - do fc = 1,num_allc - c = filter_allc(fc) + do fc = 1,num_soilc + c = filter_soilc(fc) this%ctrunc_col(c) = 0._r8 end do do j = 1, nlevdecomp - do fc = 1,num_allc - c = filter_allc(fc) + do fc = 1,num_soilc + c = filter_soilc(fc) this%ctrunc_col(c) = & this%ctrunc_col(c) + & this%ctrunc_vr_col(c,j) * dzsoi_decomp(j) @@ -983,14 +1043,14 @@ subroutine Summary(this, bounds, num_allc, filter_allc) ! total litter carbon in the top meter (TOTLITC_1m) if ( nlevdecomp > 1) then - do fc = 1,num_allc - c = filter_allc(fc) + do fc = 1,num_soilc + c = filter_soilc(fc) this%totlitc_1m_col(c) = 0._r8 end do do l = 1, ndecomp_pools if ( decomp_cascade_con%is_litter(l) ) then - do fc = 1,num_allc - c = filter_allc(fc) + do fc = 1,num_soilc + c = filter_soilc(fc) this%totlitc_1m_col(c) = this%totlitc_1m_col(c) + & this%decomp_cpools_1m_col(c,l) end do @@ -1000,14 +1060,14 @@ subroutine Summary(this, bounds, num_allc, filter_allc) ! total soil organic matter carbon in the top meter (TOTSOMC_1m) if ( nlevdecomp > 1) then - do fc = 1,num_allc - c = filter_allc(fc) + do fc = 1,num_soilc + c = filter_soilc(fc) this%totsomc_1m_col(c) = 0._r8 end do do l = 1, ndecomp_pools if ( decomp_cascade_con%is_soil(l) ) then - do fc = 1,num_allc - c = filter_allc(fc) + do fc = 1,num_soilc + c = filter_soilc(fc) this%totsomc_1m_col(c) = this%totsomc_1m_col(c) + this%decomp_cpools_1m_col(c,l) end do end if @@ -1015,64 +1075,89 @@ subroutine Summary(this, bounds, num_allc, filter_allc) end if ! total microbial carbon (TOTMICC) - do fc = 1,num_allc - c = filter_allc(fc) + do fc = 1,num_soilc + c = filter_soilc(fc) this%totmicc_col(c) = 0._r8 end do do l = 1, ndecomp_pools if ( decomp_cascade_con%is_microbe(l) ) then - do fc = 1,num_allc - c = filter_allc(fc) + do fc = 1,num_soilc + c = filter_soilc(fc) this%totmicc_col(c) = this%totmicc_col(c) + this%decomp_cpools_col(c,l) end do endif end do ! total litter carbon (TOTLITC) - do fc = 1,num_allc - c = filter_allc(fc) + do fc = 1,num_soilc + c = filter_soilc(fc) this%totlitc_col(c) = 0._r8 end do do l = 1, ndecomp_pools if ( decomp_cascade_con%is_litter(l) ) then - do fc = 1,num_allc - c = filter_allc(fc) + do fc = 1,num_soilc + c = filter_soilc(fc) this%totlitc_col(c) = this%totlitc_col(c) + this%decomp_cpools_col(c,l) end do endif end do ! total soil organic matter carbon (TOTSOMC) - do fc = 1,num_allc - c = filter_allc(fc) + do fc = 1,num_soilc + c = filter_soilc(fc) this%totsomc_col(c) = 0._r8 end do do l = 1, ndecomp_pools if ( decomp_cascade_con%is_soil(l) ) then - do fc = 1,num_allc - c = filter_allc(fc) + do fc = 1,num_soilc + c = filter_soilc(fc) this%totsomc_col(c) = this%totsomc_col(c) + this%decomp_cpools_col(c,l) end do end if end do - ! coarse woody debris carbon - if (.not. use_fates ) then - do fc = 1,num_allc - c = filter_allc(fc) - this%cwdc_col(c) = 0._r8 - end do - do l = 1, ndecomp_pools - if ( decomp_cascade_con%is_cwd(l) ) then - do fc = 1,num_allc - c = filter_allc(fc) + + + do fc = 1,num_soilc + c = filter_soilc(fc) + + ! coarse woody debris carbon + this%cwdc_col(c) = 0._r8 + + if(col%is_fates(c)) then + totvegc_col = 0._r8 + ecovegc_col = 0._r8 + else + do l = 1, ndecomp_pools + if ( decomp_cascade_con%is_cwd(l) ) then this%cwdc_col(c) = this%cwdc_col(c) + this%decomp_cpools_col(c,l) - end do - end if - end do + end if + end do + + totvegc_col = cnveg_carbonstate_inst%totc_p2c_col(c) + ecovegc_col = cnveg_carbonstate_inst%totvegc_col(c) + end if - end if + ! total ecosystem carbon, including veg but excluding cpool (TOTECOSYSC) + this%totecosysc_col(c) = & + this%cwdc_col(c) + & + this%totmicc_col(c) + & + this%totlitc_col(c) + & + this%totsomc_col(c) + & + ecovegc_col + + ! total column carbon, including veg and cpool (TOTCOLC) + this%totc_col(c) = & + this%cwdc_col(c) + & + this%totmicc_col(c) + & + this%totlitc_col(c) + & + this%totsomc_col(c) + & + this%ctrunc_col(c) + & + totvegc_col + end do + + end subroutine Summary !------------------------------------------------------------------------ diff --git a/src/soilbiogeochem/SoilBiogeochemNitrogenStateType.F90 b/src/soilbiogeochem/SoilBiogeochemNitrogenStateType.F90 index 3e54e52436..435e6c327c 100644 --- a/src/soilbiogeochem/SoilBiogeochemNitrogenStateType.F90 +++ b/src/soilbiogeochem/SoilBiogeochemNitrogenStateType.F90 @@ -21,6 +21,7 @@ module SoilBiogeochemNitrogenStateType use GridcellType , only : grc use SoilBiogeochemStateType , only : get_spinup_latitude_term use SparseMatrixMultiplyMod , only : sparse_matrix_type, vector_type + use CNVegNitrogenStateType , only : cnveg_nitrogenstate_type ! ! !PUBLIC TYPES: implicit none @@ -59,7 +60,11 @@ module SoilBiogeochemNitrogenStateType real(r8), pointer :: dyn_no3bal_adjustments_col (:) ! (gN/m2) NO3 adjustments to each column made in this timestep via dynamic column area adjustments (only makes sense at the column-level: meaningless if averaged to the gridcell-level) real(r8), pointer :: dyn_nh4bal_adjustments_col (:) ! (gN/m2) NH4 adjustments to each column made in this timestep via dynamic column adjustments (only makes sense at the column-level: meaningless if averaged to the gridcell-level) real(r8) :: totvegcthresh ! threshold for total vegetation carbon to zero out decomposition pools - + + real(r8), pointer :: totn_col (:) ! (gN/m2) total column nitrogen, incl veg + real(r8), pointer :: totecosysn_col (:) ! (gN/m2) total ecosystem nitrogen, incl veg + real(r8), pointer :: totn_grc (:) ! (gN/m2) total gridcell nitrogen + ! Matrix-cn contains @@ -144,6 +149,10 @@ subroutine InitAllocate(this, bounds) allocate(this%decomp_soiln_vr_col(begc:endc,1:nlevdecomp_full)) this%decomp_soiln_vr_col(:,:)= nan + allocate(this%totn_col (begc:endc)) ; this%totn_col (:) = nan + allocate(this%totecosysn_col (begc:endc)) ; this%totecosysn_col (:) = nan + allocate(this%totn_grc (bounds%begg:bounds%endg)) ; this%totn_grc (:) = nan + end subroutine InitAllocate !------------------------------------------------------------------------ @@ -329,6 +338,17 @@ subroutine InitHistory(this, bounds) &only makes sense at the column level: should not be averaged to gridcell', & ptr_col=this%dyn_nh4bal_adjustments_col, default='inactive') end if + + this%totecosysn_col(begc:endc) = spval + call hist_addfld1d (fname='TOTECOSYSN', units='gN/m^2', & + avgflag='A', long_name='total ecosystem N, excluding product pools', & + ptr_col=this%totecosysn_col) + + this%totn_col(begc:endc) = spval + call hist_addfld1d (fname='TOTCOLN', units='gN/m^2', & + avgflag='A', long_name='total column-level N, excluding product pools', & + ptr_col=this%totn_col) + end subroutine InitHistory !----------------------------------------------------------------------- @@ -434,6 +454,21 @@ subroutine InitCold(this, bounds, & end if end do + do c = bounds%begc, bounds%endc + l = col%landunit(c) + if (lun%itype(l) == istsoil .or. lun%itype(l) == istcrop) then + ! total nitrogen pools + this%totecosysn_col(c) = 0._r8 + this%totn_col(c) = 0._r8 + end if + end do + + + do g = bounds%begg, bounds%endg + this%totn_grc(g) = 0._r8 + end do + + call this%SetValues (num_column=num_special_col, filter_column=special_col, value_column=0._r8) end subroutine InitCold @@ -756,6 +791,12 @@ subroutine SetValues ( this, num_column, filter_column, value_column ) end do end do + do fi = 1,num_column + i = filter_column(fi) + this%totecosysn_col(i) = value_column + this%totn_col(i) = value_column + end do + ! Set values for the matrix solution if(use_soil_matrixcn)then end if @@ -763,30 +804,36 @@ subroutine SetValues ( this, num_column, filter_column, value_column ) end subroutine SetValues !----------------------------------------------------------------------- - subroutine Summary(this, bounds, num_allc, filter_allc) + + subroutine Summary(this, bounds, num_soilc, filter_soilc, cnveg_nitrogenstate_inst) + ! ! !ARGUMENTS: class (soilbiogeochem_nitrogenstate_type) :: this type(bounds_type) , intent(in) :: bounds - integer , intent(in) :: num_allc ! number of columns in allc filter - integer , intent(in) :: filter_allc(:) ! filter for all active columns + integer , intent(in) :: num_soilc ! number of columns in soilc filter + integer , intent(in) :: filter_soilc(:) ! filter for all active columns + type(cnveg_nitrogenstate_type) , intent(inout) :: cnveg_nitrogenstate_inst + ! ! !LOCAL VARIABLES: integer :: c,j,k,l ! indices integer :: fc ! lake filter indices real(r8) :: maxdepth ! depth to integrate soil variables + real(r8) :: totvegn_col ! local total ecosys veg N, allows 0 for fates + real(r8) :: ecovegn_col ! local total veg N, allows 0 for fates !----------------------------------------------------------------------- ! vertically integrate NO3 NH4 N2O pools if (use_nitrif_denitrif) then - do fc = 1,num_allc - c = filter_allc(fc) + do fc = 1,num_soilc + c = filter_soilc(fc) this%smin_no3_col(c) = 0._r8 this%smin_nh4_col(c) = 0._r8 end do do j = 1, nlevdecomp - do fc = 1,num_allc - c = filter_allc(fc) + do fc = 1,num_soilc + c = filter_soilc(fc) this%smin_no3_col(c) = & this%smin_no3_col(c) + & this%smin_no3_vr_col(c,j) * dzsoi_decomp(j) @@ -801,15 +848,15 @@ subroutine Summary(this, bounds, num_allc, filter_allc) ! vertically integrate each of the decomposing N pools do l = 1, ndecomp_pools - do fc = 1,num_allc - c = filter_allc(fc) + do fc = 1,num_soilc + c = filter_soilc(fc) this%decomp_npools_col(c,l) = 0._r8 if(use_soil_matrixcn)then end if end do do j = 1, nlevdecomp - do fc = 1,num_allc - c = filter_allc(fc) + do fc = 1,num_soilc + c = filter_soilc(fc) this%decomp_npools_col(c,l) = & this%decomp_npools_col(c,l) + & this%decomp_npools_vr_col(c,j,l) * dzsoi_decomp(j) @@ -823,8 +870,8 @@ subroutine Summary(this, bounds, num_allc, filter_allc) if ( nlevdecomp > 1) then do l = 1, ndecomp_pools - do fc = 1,num_allc - c = filter_allc(fc) + do fc = 1,num_soilc + c = filter_soilc(fc) this%decomp_npools_1m_col(c,l) = 0._r8 end do end do @@ -834,15 +881,15 @@ subroutine Summary(this, bounds, num_allc, filter_allc) do l = 1, ndecomp_pools do j = 1, nlevdecomp if ( zisoi(j) <= maxdepth ) then - do fc = 1,num_allc - c = filter_allc(fc) + do fc = 1,num_soilc + c = filter_soilc(fc) this%decomp_npools_1m_col(c,l) = & this%decomp_npools_1m_col(c,l) + & this%decomp_npools_vr_col(c,j,l) * dzsoi_decomp(j) end do elseif ( zisoi(j-1) < maxdepth ) then - do fc = 1,num_allc - c = filter_allc(fc) + do fc = 1,num_soilc + c = filter_soilc(fc) this%decomp_npools_1m_col(c,l) = & this%decomp_npools_1m_col(c,l) + & this%decomp_npools_vr_col(c,j,l) * (maxdepth - zisoi(j-1)) @@ -854,16 +901,16 @@ subroutine Summary(this, bounds, num_allc, filter_allc) ! Add soil nitrogen pools together to produce vertically-resolved decomposing total soil N pool if ( nlevdecomp_full > 1 ) then do j = 1, nlevdecomp - do fc = 1,num_allc - c = filter_allc(fc) + do fc = 1,num_soilc + c = filter_soilc(fc) this%decomp_soiln_vr_col(c,j) = 0._r8 end do end do do l = 1, ndecomp_pools if ( decomp_cascade_con%is_soil(l) ) then do j = 1, nlevdecomp - do fc = 1,num_allc - c = filter_allc(fc) + do fc = 1,num_soilc + c = filter_soilc(fc) this%decomp_soiln_vr_col(c,j) = this%decomp_soiln_vr_col(c,j) + & this%decomp_npools_vr_col(c,j,l) end do @@ -873,14 +920,14 @@ subroutine Summary(this, bounds, num_allc, filter_allc) end if ! total litter nitrogen to 1 meter (TOTLITN_1m) - do fc = 1,num_allc - c = filter_allc(fc) + do fc = 1,num_soilc + c = filter_soilc(fc) this%totlitn_1m_col(c) = 0._r8 end do do l = 1, ndecomp_pools if ( decomp_cascade_con%is_litter(l) ) then - do fc = 1,num_allc - c = filter_allc(fc) + do fc = 1,num_soilc + c = filter_soilc(fc) this%totlitn_1m_col(c) = & this%totlitn_1m_col(c) + & this%decomp_npools_1m_col(c,l) @@ -889,14 +936,14 @@ subroutine Summary(this, bounds, num_allc, filter_allc) end do ! total soil organic matter nitrogen to 1 meter (TOTSOMN_1m) - do fc = 1,num_allc - c = filter_allc(fc) + do fc = 1,num_soilc + c = filter_soilc(fc) this%totsomn_1m_col(c) = 0._r8 end do do l = 1, ndecomp_pools if ( decomp_cascade_con%is_soil(l) ) then - do fc = 1,num_allc - c = filter_allc(fc) + do fc = 1,num_soilc + c = filter_soilc(fc) this%totsomn_1m_col(c) = this%totsomn_1m_col(c) + & this%decomp_npools_1m_col(c,l) end do @@ -906,14 +953,14 @@ subroutine Summary(this, bounds, num_allc, filter_allc) endif ! total litter nitrogen (TOTLITN) - do fc = 1,num_allc - c = filter_allc(fc) + do fc = 1,num_soilc + c = filter_soilc(fc) this%totlitn_col(c) = 0._r8 end do do l = 1, ndecomp_pools if ( decomp_cascade_con%is_litter(l) ) then - do fc = 1,num_allc - c = filter_allc(fc) + do fc = 1,num_soilc + c = filter_soilc(fc) this%totlitn_col(c) = & this%totlitn_col(c) + & this%decomp_npools_col(c,l) @@ -922,14 +969,14 @@ subroutine Summary(this, bounds, num_allc, filter_allc) end do ! total microbial nitrogen (TOTMICN) - do fc = 1,num_allc - c = filter_allc(fc) + do fc = 1,num_soilc + c = filter_soilc(fc) this%totmicn_col(c) = 0._r8 end do do l = 1, ndecomp_pools if ( decomp_cascade_con%is_microbe(l) ) then - do fc = 1,num_allc - c = filter_allc(fc) + do fc = 1,num_soilc + c = filter_soilc(fc) this%totmicn_col(c) = & this%totmicn_col(c) + & this%decomp_npools_col(c,l) @@ -938,61 +985,91 @@ subroutine Summary(this, bounds, num_allc, filter_allc) end do ! total soil organic matter nitrogen (TOTSOMN) - do fc = 1,num_allc - c = filter_allc(fc) + do fc = 1,num_soilc + c = filter_soilc(fc) this%totsomn_col(c) = 0._r8 end do do l = 1, ndecomp_pools if ( decomp_cascade_con%is_soil(l) ) then - do fc = 1,num_allc - c = filter_allc(fc) + do fc = 1,num_soilc + c = filter_soilc(fc) this%totsomn_col(c) = this%totsomn_col(c) + & this%decomp_npools_col(c,l) end do end if end do - ! total cwdn - do fc = 1,num_allc - c = filter_allc(fc) - this%cwdn_col(c) = 0._r8 - end do - do l = 1, ndecomp_pools - if ( decomp_cascade_con%is_cwd(l) ) then - do fc = 1,num_allc - c = filter_allc(fc) - this%cwdn_col(c) = this%cwdn_col(c) + & - this%decomp_npools_col(c,l) - end do - end if - end do + ! total sminn - do fc = 1,num_allc - c = filter_allc(fc) + do fc = 1,num_soilc + c = filter_soilc(fc) this%sminn_col(c) = 0._r8 end do do j = 1, nlevdecomp - do fc = 1,num_allc - c = filter_allc(fc) + do fc = 1,num_soilc + c = filter_soilc(fc) this%sminn_col(c) = this%sminn_col(c) + & this%sminn_vr_col(c,j) * dzsoi_decomp(j) end do end do ! total col_ntrunc - do fc = 1,num_allc - c = filter_allc(fc) + do fc = 1,num_soilc + c = filter_soilc(fc) this%ntrunc_col(c) = 0._r8 end do do j = 1, nlevdecomp - do fc = 1,num_allc - c = filter_allc(fc) + do fc = 1,num_soilc + c = filter_soilc(fc) this%ntrunc_col(c) = this%ntrunc_col(c) + & this%ntrunc_vr_col(c,j) * dzsoi_decomp(j) end do end do + ! total cwdn + do fc = 1,num_soilc + c = filter_soilc(fc) + this%cwdn_col(c) = 0._r8 + + if(col%is_fates(c)) then + totvegn_col = 0._r8 + ecovegn_col = 0._r8 + else + + do l = 1, ndecomp_pools + if ( decomp_cascade_con%is_cwd(l) ) then + this%cwdn_col(c) = this%cwdn_col(c) + & + this%decomp_npools_col(c,l) + end if + end do + totvegn_col = cnveg_nitrogenstate_inst%totn_p2c_col(c) + ecovegn_col = cnveg_nitrogenstate_inst%totvegn_col(c) + + end if + + ! total ecosystem nitrogen, including veg (TOTECOSYSN) + this%totecosysn_col(c) = & + this%cwdn_col(c) + & + this%totlitn_col(c) + & + this%totmicn_col(c) + & + this%totsomn_col(c) + & + this%sminn_col(c) + & + ecovegn_col + + ! total column nitrogen, including patch (TOTCOLN) + + this%totn_col(c) = & + this%cwdn_col(c) + & + this%totlitn_col(c) + & + this%totmicn_col(c) + & + this%totsomn_col(c) + & + this%sminn_col(c) + & + this%ntrunc_col(c) + & + totvegn_col + + end do + end subroutine Summary !----------------------------------------------------------------------- diff --git a/src/utils/clmfates_interfaceMod.F90 b/src/utils/clmfates_interfaceMod.F90 index f225a3255b..2eb746e6f3 100644 --- a/src/utils/clmfates_interfaceMod.F90 +++ b/src/utils/clmfates_interfaceMod.F90 @@ -562,8 +562,6 @@ subroutine init(this, bounds_proc ) use clm_instur , only : wt_nat_patch use FATESFireFactoryMod , only: create_fates_fire_data_method - implicit none - ! Input Arguments class(hlm_fates_interface_type), intent(inout) :: this type(bounds_type),intent(in) :: bounds_proc @@ -770,7 +768,6 @@ subroutine check_hlm_active(this, nc, bounds_clump) ! in handy when we have dynamic sites in FATES ! --------------------------------------------------------------------------------- - implicit none class(hlm_fates_interface_type), intent(inout) :: this integer :: nc type(bounds_type),intent(in) :: bounds_clump @@ -820,7 +817,7 @@ subroutine dynamics_driv(this, nc, bounds_clump, & use subgridMod, only : natveg_patch_exists ! !ARGUMENTS: - implicit none + class(hlm_fates_interface_type), intent(inout) :: this type(bounds_type),intent(in) :: bounds_clump type(atm2lnd_type) , intent(in) :: atm2lnd_inst @@ -1067,49 +1064,61 @@ end subroutine dynamics_driv ! =============================================================================== - subroutine UpdateCLitterFluxes(this,bounds_clump,soilbiogeochem_carbonflux_inst,c) + subroutine UpdateCLitterFluxes(this,soilbiogeochem_carbonflux_inst,ci,c) + + use clm_varpar, only : i_met_lit - implicit none class(hlm_fates_interface_type), intent(inout) :: this - type(bounds_type) , intent(in) :: bounds_clump type(soilbiogeochem_carbonflux_type) , intent(inout) :: soilbiogeochem_carbonflux_inst - integer , intent(in) :: c + integer , intent(in) :: ci ! clump index + integer , intent(in) :: c ! column index integer :: s ! site index - integer :: nc ! clump index real(r8) :: dtime - - + integer :: i_lig_lit, i_cel_lit ! indices for lignan and cellulose + dtime = get_step_size_real() - nc = bounds_clump%clump_index - s = this%f2hmap(nc)%hsites(c) + s = this%f2hmap(ci)%hsites(c) associate(cf_soil => soilbiogeochem_carbonflux_inst) if ( .not. use_fates_sp ) then - cf_soil%decomp_cpools_sourcesink(c,1:nlevdecomp,i_met_lit) = & - cf_soil%decomp_cpools_sourcesink(c,1:nlevdecomp,i_met_lit) + & - this%fates(nc)%bc_out(s)%litt_flux_lab_c_si(1:nlevdecomp) * dtime - cf_soil%decomp_cpools_sourcesink(c,1:nlevdecomp,i_cel_lit) = & - cf_soil%decomp_cpools_sourcesink(c,1:nlevdecomp,i_cel_lit) + & - this%fates(nc)%bc_out(s)%litt_flux_cel_c_si(1:nlevdecomp)* dtime - cf_soil%decomp_cpools_sourcesink(c,1:nlevdecomp,i_lig_lit) = & - cf_soil%decomp_cpools_sourcesink(c,1:nlevdecomp,i_lig_lit) + & - this%fates(nc)%bc_out(s)%litt_flux_lig_c_si(1:nlevdecomp) * dtime + + cf_soil%decomp_cpools_sourcesink_col(c,1:nlevdecomp,i_met_lit) = & + cf_soil%decomp_cpools_sourcesink_col(c,1:nlevdecomp,i_met_lit) + & + this%fates(ci)%bc_out(s)%litt_flux_lab_c_si(1:nlevdecomp) * dtime + + i_cel_lit = i_met_lit + 1 + + cf_soil%decomp_cpools_sourcesink_col(c,1:nlevdecomp,i_cel_lit) = & + cf_soil%decomp_cpools_sourcesink_col(c,1:nlevdecomp,i_cel_lit) + & + this%fates(ci)%bc_out(s)%litt_flux_cel_c_si(1:nlevdecomp)* dtime + + if (decomp_method == mimics_decomp) then + ! Mimics has a structural pool, which is cellulose and lignan + i_lig_lit = i_cel_lit + elseif(decomp_method == century_decomp ) then + ! CENTURY has a separate lignan pool from cellulose + i_lig_lit = i_cel_lit + 1 + end if + + cf_soil%decomp_cpools_sourcesink_col(c,1:nlevdecomp,i_lig_lit) = & + cf_soil%decomp_cpools_sourcesink_col(c,1:nlevdecomp,i_lig_lit) + & + this%fates(ci)%bc_out(s)%litt_flux_lig_c_si(1:nlevdecomp) * dtime else ! In SP mode their is no mass flux between the two - cf_soil%decomp_cpools_sourcesink(c,:) = 0._r8 + cf_soil%decomp_cpools_sourcesink_col(c,:,:) = 0._r8 end if ! This is a diagnostic for carbon accounting (NOT IN CLM, ONLY ELM) !col_cf%litfall(c) = & - ! sum(this%fates(nc)%bc_out(s)%litt_flux_lab_c_si(1:nlevdecomp) * & - ! this%fates(nc)%bc_in(s)%dz_decomp_sisl(1:nlevdecomp)) + & - ! sum(this%fates(nc)%bc_out(s)%litt_flux_cel_c_si(1:nlevdecomp) * & - ! this%fates(nc)%bc_in(s)%dz_decomp_sisl(1:nlevdecomp)) + & - ! sum(this%fates(nc)%bc_out(s)%litt_flux_lig_c_si(1:nlevdecomp) * ^ - ! this%fates(nc)%bc_in(s)%dz_decomp_sisl(1:nlevdecomp)) + ! sum(this%fates(ci)%bc_out(s)%litt_flux_lab_c_si(1:nlevdecomp) * & + ! this%fates(ci)%bc_in(s)%dz_decomp_sisl(1:nlevdecomp)) + & + ! sum(this%fates(ci)%bc_out(s)%litt_flux_cel_c_si(1:nlevdecomp) * & + ! this%fates(ci)%bc_in(s)%dz_decomp_sisl(1:nlevdecomp)) + & + ! sum(this%fates(ci)%bc_out(s)%litt_flux_lig_c_si(1:nlevdecomp) * ^ + ! this%fates(ci)%bc_in(s)%dz_decomp_sisl(1:nlevdecomp)) end associate @@ -1128,7 +1137,6 @@ subroutine wrap_update_hlmfates_dyn(this, nc, bounds_clump, & ! provides boundary conditions (such as vegetation fractional coverage) ! --------------------------------------------------------------------------------- - implicit none class(hlm_fates_interface_type), intent(inout) :: this type(bounds_type),intent(in) :: bounds_clump integer , intent(in) :: nc @@ -1372,8 +1380,6 @@ subroutine restart( this, bounds_proc, ncid, flag, waterdiagnosticbulk_inst, & use EDMainMod, only : ed_update_site use FatesInterfaceTypesMod, only: fates_maxElementsPerSite - implicit none - ! Arguments class(hlm_fates_interface_type), intent(inout) :: this @@ -1876,8 +1882,6 @@ subroutine wrap_sunfrac(this,nc,atm2lnd_inst,canopystate_inst) ! of the canopy that is exposed to sun. ! --------------------------------------------------------------------------------- - implicit none - ! Input Arguments class(hlm_fates_interface_type), intent(inout) :: this @@ -2014,8 +2018,6 @@ subroutine wrap_btran(this,nc,fn,filterc,soilstate_inst, & use SoilWaterRetentionCurveMod, only : soil_water_retention_curve_type - implicit none - ! Arguments class(hlm_fates_interface_type), intent(inout) :: this integer , intent(in) :: nc @@ -3003,35 +3005,6 @@ subroutine ComputeRootSoilFlux(this, bounds_clump, num_filterc, filterc, & end subroutine ComputeRootSoilFlux - ! ====================================================================================== -! -! THIS WAS MOVED TO WRAP_HYDRAULICS_DRIVE() -! -! subroutine TransferPlantWaterStorage(this, bounds_clump, nc, waterstate_inst) -! -! implicit none -! class(hlm_fates_interface_type), intent(inout) :: this -! type(bounds_type),intent(in) :: bounds_clump -! integer,intent(in) :: nc -! type(waterstate_type) , intent(inout) :: waterstate_inst -! -! ! locals -! integer :: s -! integer :: c -! -! if (.not. (use_fates .and. use_fates_planthydro) ) return -! -! do s = 1, this%fates(nc)%nsites -! c = this%f2hmap(nc)%fcolumn(s) -! waterstate_inst%total_plant_stored_h2o_col(c) = & -! this%fates(nc)%bc_out(s)%plant_stored_h2o_si -! end do -! return -!end subroutine TransferPlantWaterStorage - - - - ! ====================================================================================== subroutine wrap_hydraulics_drive(this, bounds_clump, nc, & @@ -3039,7 +3012,6 @@ subroutine wrap_hydraulics_drive(this, bounds_clump, nc, & fn, filterp, solarabs_inst, energyflux_inst) - implicit none class(hlm_fates_interface_type), intent(inout) :: this type(bounds_type),intent(in) :: bounds_clump integer,intent(in) :: nc @@ -3161,8 +3133,6 @@ subroutine hlm_bounds_to_fates_bounds(hlm, fates) use FatesInterfaceTypesMod, only : numpft_fates => numpft - implicit none - type(bounds_type), intent(in) :: hlm type(fates_bounds_type), intent(out) :: fates From c50615154ec2221f03fc62dc76481ac55c9e0c30 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Thu, 16 Feb 2023 08:50:02 -0500 Subject: [PATCH 052/257] more incremental fates-clm mass balance checking and pathway coupling changes --- src/biogeochem/CNBalanceCheckMod.F90 | 18 ++++++--- src/biogeochem/CNProductsMod.F90 | 20 ++++++++++ src/biogeochem/CNVegetationFacade.F90 | 53 ++++++++++++++------------- 3 files changed, 60 insertions(+), 31 deletions(-) diff --git a/src/biogeochem/CNBalanceCheckMod.F90 b/src/biogeochem/CNBalanceCheckMod.F90 index 087242da30..7d510e6446 100644 --- a/src/biogeochem/CNBalanceCheckMod.F90 +++ b/src/biogeochem/CNBalanceCheckMod.F90 @@ -10,7 +10,7 @@ module CNBalanceCheckMod use shr_log_mod , only : errMsg => shr_log_errMsg use decompMod , only : bounds_type, subgrid_level_gridcell, subgrid_level_column use abortutils , only : endrun - use clm_varctl , only : iulog, use_nitrif_denitrif + use clm_varctl , only : iulog, use_nitrif_denitrif, use_fates use clm_time_manager , only : get_step_size_real use CNVegNitrogenFluxType , only : cnveg_nitrogenflux_type use CNVegNitrogenStateType , only : cnveg_nitrogenstate_type @@ -143,11 +143,17 @@ subroutine BeginCNGridcellBalance(this, bounds, cnveg_carbonflux_inst, & ) begg = bounds%begg; endg = bounds%endg - - call cnveg_carbonflux_inst%hrv_xsmrpool_to_atm_dribbler%get_amount_left_to_dribble_beg( & - bounds, hrv_xsmrpool_amount_left_to_dribble(bounds%begg:bounds%endg)) - call cnveg_carbonflux_inst%dwt_conv_cflux_dribbler%get_amount_left_to_dribble_beg( & - bounds, dwt_conv_cflux_amount_left_to_dribble(bounds%begg:bounds%endg)) + + if(.not.use_fates)then + + call cnveg_carbonflux_inst%hrv_xsmrpool_to_atm_dribbler%get_amount_left_to_dribble_beg( & + bounds, hrv_xsmrpool_amount_left_to_dribble(bounds%begg:bounds%endg)) + call cnveg_carbonflux_inst%dwt_conv_cflux_dribbler%get_amount_left_to_dribble_beg( & + bounds, dwt_conv_cflux_amount_left_to_dribble(bounds%begg:bounds%endg)) + else + hrv_xsmrpool_amount_left_to_dribble(bounds%begg:bounds%endg) = 0._r8 + dwt_conv_cflux_amount_left_to_dribble(bounds%begg:bounds%endg) = 0._r8 + end if do g = begg, endg begcb(g) = totc(g) + c_tot_woodprod(g) + c_cropprod1(g) + & diff --git a/src/biogeochem/CNProductsMod.F90 b/src/biogeochem/CNProductsMod.F90 index b6e5d6dad3..254063ddac 100644 --- a/src/biogeochem/CNProductsMod.F90 +++ b/src/biogeochem/CNProductsMod.F90 @@ -13,6 +13,8 @@ module CNProductsMod use clm_time_manager , only : get_step_size_real use SpeciesBaseType , only : species_base_type use PatchType , only : patch + use AnnualFluxDribbler , only : annual_flux_dribbler_type + use AnnualFluxDribbler , only : annual_flux_dribbler_gridcell ! implicit none private @@ -56,6 +58,13 @@ module CNProductsMod real(r8), pointer :: prod100_loss_grc(:) ! (g[C or N]/m2/s) decomposition loss from 100-yr wood product pool real(r8), pointer :: tot_woodprod_loss_grc(:) ! (g[C or N]/m2/s) decompomposition loss from all wood product pools + ! Objects that help convert once-per-year dynamic land cover changes into fluxes + ! that are dribbled throughout the year + !type(annual_flux_dribbler_type) :: dwt_conv_cflux_dribbler + !type(annual_flux_dribbler_type) :: hrv_xsmrpool_to_atm_dribbler + !logical, private :: dribble_crophrv_xsmrpool_2atm + + contains ! Infrastructure routines @@ -148,6 +157,17 @@ subroutine InitAllocate(this, bounds) allocate(this%tot_woodprod_loss_grc(begg:endg)) ; this%tot_woodprod_loss_grc(:) = nan allocate(this%product_loss_grc(begg:endg)) ; this%product_loss_grc(:) = nan + !this%dwt_conv_cflux_dribbler = annual_flux_dribbler_gridcell( & + ! bounds = bounds, & + ! name = 'dwt_conv_flux_' // carbon_type_suffix, & + ! units = 'gC/m^2', & + ! allows_non_annual_delta = allows_non_annual_delta) + !this%hrv_xsmrpool_to_atm_dribbler = annual_flux_dribbler_gridcell( & + ! bounds = bounds, & + ! name = 'hrv_xsmrpool_to_atm_' // carbon_type_suffix, & + ! units = 'gC/m^2', & + ! allows_non_annual_delta = .false.) + end subroutine InitAllocate !----------------------------------------------------------------------- diff --git a/src/biogeochem/CNVegetationFacade.F90 b/src/biogeochem/CNVegetationFacade.F90 index 1bdcf5bce5..d30b9f1991 100644 --- a/src/biogeochem/CNVegetationFacade.F90 +++ b/src/biogeochem/CNVegetationFacade.F90 @@ -260,23 +260,26 @@ subroutine Init(this, bounds, NLFilename, nskip_steps, params_ncid) this%cnveg_carbonstate_inst%deadstemc_patch(begp:endp) ) call this%cnveg_nitrogenflux_inst%Init(bounds) - call this%c_products_inst%Init(bounds, species_non_isotope_type('C')) - if (use_c13) then - call this%c13_products_inst%Init(bounds, species_isotope_type('C', '13')) - end if - if (use_c14) then - call this%c14_products_inst%Init(bounds, species_isotope_type('C', '14')) - end if - call this%n_products_inst%Init(bounds, species_non_isotope_type('N')) - - call this%cn_balance_inst%Init(bounds) + end if + + call this%c_products_inst%Init(bounds, species_non_isotope_type('C')) + if (use_c13) then + call this%c13_products_inst%Init(bounds, species_isotope_type('C', '13')) + end if + if (use_c14) then + call this%c14_products_inst%Init(bounds, species_isotope_type('C', '14')) + end if + call this%n_products_inst%Init(bounds, species_non_isotope_type('N')) + + call this%cn_balance_inst%Init(bounds) + if(use_cn)then ! Initialize the memory for the dgvs_inst data structure regardless of whether ! use_cndv is true so that it can be used in associate statements (nag compiler ! complains otherwise) call this%dgvs_inst%Init(bounds) end if - + call create_cnfire_method(NLFilename, this%cnfire_method) call this%cnfire_method%CNFireReadParams( params_ncid ) @@ -502,21 +505,21 @@ subroutine Restart(this, bounds, ncid, flag) cnveg_nitrogenstate=this%cnveg_nitrogenstate_inst, & filter_reseed_patch=reseed_patch, num_reseed_patch=num_reseed_patch) - call this%c_products_inst%restart(bounds, ncid, flag) - if (use_c13) then - call this%c13_products_inst%restart(bounds, ncid, flag, & - template_for_missing_fields = this%c_products_inst, & - template_multiplier = c3_r2) - end if - if (use_c14) then - call this%c14_products_inst%restart(bounds, ncid, flag, & - template_for_missing_fields = this%c_products_inst, & - template_multiplier = c14ratio) - end if - call this%n_products_inst%restart(bounds, ncid, flag) - end if - + + call this%c_products_inst%restart(bounds, ncid, flag) + if (use_c13) then + call this%c13_products_inst%restart(bounds, ncid, flag, & + template_for_missing_fields = this%c_products_inst, & + template_multiplier = c3_r2) + end if + if (use_c14) then + call this%c14_products_inst%restart(bounds, ncid, flag, & + template_for_missing_fields = this%c_products_inst, & + template_multiplier = c14ratio) + end if + call this%n_products_inst%restart(bounds, ncid, flag) + if (use_cndv) then call this%dgvs_inst%Restart(bounds, ncid, flag=flag) end if From f38d9a30d03c466ed252c9845a76b4559e8e71e1 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Wed, 1 Mar 2023 15:20:44 -0500 Subject: [PATCH 053/257] Incremental progress towards getting fates to work with the C and N budget pathway --- src/biogeochem/CNAnnualUpdateMod.F90 | 48 +- src/biogeochem/CNBalanceCheckMod.F90 | 329 ++++++---- src/biogeochem/CNCStateUpdate1Mod.F90 | 6 +- src/biogeochem/CNDriverMod.F90 | 585 ++++++++++-------- src/biogeochem/CNGapMortalityMod.F90 | 2 +- src/biogeochem/CNNDynamicsMod.F90 | 23 +- src/biogeochem/CNNStateUpdate1Mod.F90 | 47 +- src/biogeochem/CNPhenologyMod.F90 | 159 +++-- src/biogeochem/CNProductsMod.F90 | 160 ++--- src/biogeochem/CNVegetationFacade.F90 | 17 +- src/main/filterMod.F90 | 26 +- .../SoilBiogeochemCarbonFluxType.F90 | 54 +- .../SoilBiogeochemPrecisionControlMod.F90 | 7 +- .../SoilBiogeochemStateType.F90 | 2 +- src/utils/clmfates_interfaceMod.F90 | 73 ++- 15 files changed, 849 insertions(+), 689 deletions(-) diff --git a/src/biogeochem/CNAnnualUpdateMod.F90 b/src/biogeochem/CNAnnualUpdateMod.F90 index 682898259a..34324e4c93 100644 --- a/src/biogeochem/CNAnnualUpdateMod.F90 +++ b/src/biogeochem/CNAnnualUpdateMod.F90 @@ -10,6 +10,7 @@ module CNAnnualUpdateMod use CNvegStateType , only : cnveg_state_type use PatchType , only : patch use filterColMod , only : filter_col_type, col_filter_from_filter_and_logical_array + use ColumnType , only : col ! implicit none private @@ -55,20 +56,23 @@ subroutine CNAnnualUpdate(bounds, num_soilc, filter_soilc, num_soilp, filter_soi do fc = 1,num_soilc c = filter_soilc(fc) - cnveg_state_inst%annsum_counter_col(c) = cnveg_state_inst%annsum_counter_col(c) + dt - if (cnveg_state_inst%annsum_counter_col(c) >= secspyear) then - end_of_year(c) = .true. - cnveg_state_inst%annsum_counter_col(c) = 0._r8 - else - end_of_year(c) = .false. + if(.not.col%is_fates(c))then + cnveg_state_inst%annsum_counter_col(c) = cnveg_state_inst%annsum_counter_col(c) + dt + if (cnveg_state_inst%annsum_counter_col(c) >= secspyear) then + end_of_year(c) = .true. + cnveg_state_inst%annsum_counter_col(c) = 0._r8 + else + end_of_year(c) = .false. + end if end if end do + do fp = 1,num_soilp p = filter_soilp(fp) c = patch%column(p) - if (end_of_year(c)) then + if (end_of_year(c) .and. .not.col%is_fates(c)) then ! update annual plant ndemand accumulator cnveg_state_inst%annsum_potential_gpp_patch(p) = cnveg_state_inst%tempsum_potential_gpp_patch(p) @@ -94,20 +98,22 @@ subroutine CNAnnualUpdate(bounds, num_soilc, filter_soilc, num_soilp, filter_soi end do ! Get column-level averages, just for the columns that have reached their personal end-of-year - filter_endofyear_c = col_filter_from_filter_and_logical_array( & - bounds = bounds, & - num_orig = num_soilc, & - filter_orig = filter_soilc, & - logical_col = end_of_year(bounds%begc:bounds%endc)) - - call p2c(bounds, filter_endofyear_c%num, filter_endofyear_c%indices, & - cnveg_carbonflux_inst%annsum_npp_patch(bounds%begp:bounds%endp), & - cnveg_carbonflux_inst%annsum_npp_col(bounds%begc:bounds%endc)) - - call p2c(bounds, filter_endofyear_c%num, filter_endofyear_c%indices, & - cnveg_state_inst%annavg_t2m_patch(bounds%begp:bounds%endp), & - cnveg_state_inst%annavg_t2m_col(bounds%begc:bounds%endc)) - + if(num_soilp>0)then + filter_endofyear_c = col_filter_from_filter_and_logical_array( & + bounds = bounds, & + num_orig = num_soilc, & + filter_orig = filter_soilc, & + logical_col = end_of_year(bounds%begc:bounds%endc)) + + call p2c(bounds, filter_endofyear_c%num, filter_endofyear_c%indices, & + cnveg_carbonflux_inst%annsum_npp_patch(bounds%begp:bounds%endp), & + cnveg_carbonflux_inst%annsum_npp_col(bounds%begc:bounds%endc)) + + call p2c(bounds, filter_endofyear_c%num, filter_endofyear_c%indices, & + cnveg_state_inst%annavg_t2m_patch(bounds%begp:bounds%endp), & + cnveg_state_inst%annavg_t2m_col(bounds%begc:bounds%endc)) + end if + end subroutine CNAnnualUpdate end module CNAnnualUpdateMod diff --git a/src/biogeochem/CNBalanceCheckMod.F90 b/src/biogeochem/CNBalanceCheckMod.F90 index 7d510e6446..bf54e2b18f 100644 --- a/src/biogeochem/CNBalanceCheckMod.F90 +++ b/src/biogeochem/CNBalanceCheckMod.F90 @@ -25,6 +25,7 @@ module CNBalanceCheckMod use GridcellType , only : grc use CNSharedParamsMod , only : use_fun use CLMFatesInterfaceMod , only : hlm_fates_interface_type + use clm_varpar , only : nlevdecomp ! implicit none @@ -216,7 +217,7 @@ subroutine CBalanceCheck(this, bounds, num_soilc, filter_soilc, & ! ! !USES: use subgridAveMod, only: c2g - use clm_varpar , only: nlevdecomp + ! ! !DESCRIPTION: ! Perform carbon mass conservation check for column and patch @@ -252,6 +253,7 @@ subroutine CBalanceCheck(this, bounds, num_soilc, filter_soilc, & real(r8) :: som_c_leached_grc(bounds%begg:bounds%endg) real(r8) :: hrv_xsmrpool_amount_left_to_dribble(bounds%begg:bounds%endg) real(r8) :: dwt_conv_cflux_amount_left_to_dribble(bounds%begg:bounds%endg) + real(r8) :: fates_litter_flux !----------------------------------------------------------------------- @@ -272,7 +274,7 @@ subroutine CBalanceCheck(this, bounds, num_soilc, filter_soilc, & er => cnveg_carbonflux_inst%er_col , & ! Input: [real(r8) (:) ] (gC/m2/s) total ecosystem respiration, autotrophic + heterotrophic col_fire_closs => cnveg_carbonflux_inst%fire_closs_col , & ! Input: [real(r8) (:) ] (gC/m2/s) total column-level fire C loss col_hrv_xsmrpool_to_atm => cnveg_carbonflux_inst%hrv_xsmrpool_to_atm_col , & ! Input: [real(r8) (:) ] (gC/m2/s) excess MR pool harvest mortality - col_xsmrpool_to_atm => cnveg_carbonflux_inst%xsmrpool_to_atm_col , & ! Input: [real(r8) (:) ] (gC/m2/s) excess MR pool crop harvest loss to atm + col_xsmrpool_to_atm => cnveg_carbonflux_inst%xsmrpool_to_atm_col , & ! Input: [real(r8) (:) ] (gC/m2/s) excess MR pool crop harvest loss to atm som_c_leached => soilbiogeochem_carbonflux_inst%som_c_leached_col , & ! Input: [real(r8) (:) ] (gC/m2/s) total SOM C loss from vertical transport totcolc => soilbiogeochem_carbonstate_inst%totc_col & ! Input: [real(r8) (:) ] (gC/m2) total column carbon, incl veg and cpool @@ -299,12 +301,15 @@ subroutine CBalanceCheck(this, bounds, num_soilc, filter_soilc, & ! calculate total column-level inputs (litter fluxes) [g/m2/s] s = clm_fates%f2hmap(ic)%hsites(c) - col_cinputs = sum(clm_fates%fates(ic)%bc_out(s)%litt_flux_lab_c_si(1:nlevdecomp) * & + + fates_litter_flux = sum(clm_fates%fates(ic)%bc_out(s)%litt_flux_lab_c_si(1:nlevdecomp) * & clm_fates%fates(ic)%bc_in(s)%dz_decomp_sisl(1:nlevdecomp)) + & sum(clm_fates%fates(ic)%bc_out(s)%litt_flux_cel_c_si(1:nlevdecomp) * & clm_fates%fates(ic)%bc_in(s)%dz_decomp_sisl(1:nlevdecomp)) + & sum(clm_fates%fates(ic)%bc_out(s)%litt_flux_lig_c_si(1:nlevdecomp) * & clm_fates%fates(ic)%bc_in(s)%dz_decomp_sisl(1:nlevdecomp)) + + col_cinputs = fates_litter_flux ! calculate total column-level outputs ! fates has already exported burn losses and fluxes to the atm @@ -321,19 +326,18 @@ subroutine CBalanceCheck(this, bounds, num_soilc, filter_soilc, & ! er = ar + hr, col_fire_closs includes patch-level fire losses col_coutputs = er(c) + col_fire_closs(c) + col_hrv_xsmrpool_to_atm(c) + & col_xsmrpool_to_atm(c) + + ! Fluxes to product pools are included in column-level outputs: the product + ! pools are not included in totcolc, so are outside the system with respect to + ! these balance checks. (However, the dwt flux to product pools is NOT included, + ! since col_begcb is initialized after the dynamic area adjustments - i.e., + ! after the dwt term has already been taken out.) + col_coutputs = col_coutputs + & + wood_harvestc(c) + & + crop_harvestc_to_cropprodc(c) end if - - ! Fluxes to product pools are included in column-level outputs: the product - ! pools are not included in totcolc, so are outside the system with respect to - ! these balance checks. (However, the dwt flux to product pools is NOT included, - ! since col_begcb is initialized after the dynamic area adjustments - i.e., - ! after the dwt term has already been taken out.) - col_coutputs = col_coutputs + & - wood_harvestc(c) + & - crop_harvestc_to_cropprodc(c) - ! subtract leaching flux col_coutputs = col_coutputs - som_c_leached(c) @@ -360,14 +364,22 @@ subroutine CBalanceCheck(this, bounds, num_soilc, filter_soilc, & write(iulog,*)'endcb = ',col_endcb(c) write(iulog,*)'delta store = ',col_endcb(c)-col_begcb(c) write(iulog,*)'--- Inputs ---' - write(iulog,*)'gpp = ',gpp(c)*dt + if( col%is_fates(c) ) then + write(iulog,*)'fates litter_flux = ',fates_litter_flux*dt + else + write(iulog,*)'gpp = ',gpp(c)*dt + end if write(iulog,*)'--- Outputs ---' - write(iulog,*)'er = ',er(c)*dt - write(iulog,*)'col_fire_closs = ',col_fire_closs(c)*dt - write(iulog,*)'col_hrv_xsmrpool_to_atm = ',col_hrv_xsmrpool_to_atm(c)*dt - write(iulog,*)'col_xsmrpool_to_atm = ',col_xsmrpool_to_atm(c)*dt - write(iulog,*)'wood_harvestc = ',wood_harvestc(c)*dt - write(iulog,*)'crop_harvestc_to_cropprodc = ', crop_harvestc_to_cropprodc(c)*dt + if( .not.col%is_fates(c) ) then + write(iulog,*)'er = ',er(c)*dt + write(iulog,*)'col_fire_closs = ',col_fire_closs(c)*dt + write(iulog,*)'col_hrv_xsmrpool_to_atm = ',col_hrv_xsmrpool_to_atm(c)*dt + write(iulog,*)'col_xsmrpool_to_atm = ',col_xsmrpool_to_atm(c)*dt + write(iulog,*)'wood_harvestc = ',wood_harvestc(c)*dt + write(iulog,*)'crop_harvestc_to_cropprodc = ', crop_harvestc_to_cropprodc(c)*dt + else + write(iulog,*)'hr = ',soilbiogeochem_carbonflux_inst%hr_col(c)*dt + end if write(iulog,*)'-1*som_c_leached = ',som_c_leached(c)*dt call endrun(subgrid_index=c, subgrid_level=subgrid_level_column, msg=errMsg(sourcefile, __LINE__)) end if @@ -396,28 +408,38 @@ subroutine CBalanceCheck(this, bounds, num_soilc, filter_soilc, & ! We account for the latter fluxes as inputs below; the same ! fluxes have entered the pools earlier in the timestep. For true ! conservation we would need to add a flux out of npp into seed. - call cnveg_carbonflux_inst%hrv_xsmrpool_to_atm_dribbler%get_amount_left_to_dribble_end( & - bounds, hrv_xsmrpool_amount_left_to_dribble(bounds%begg:bounds%endg)) - call cnveg_carbonflux_inst%dwt_conv_cflux_dribbler%get_amount_left_to_dribble_end( & - bounds, dwt_conv_cflux_amount_left_to_dribble(bounds%begg:bounds%endg)) - grc_endcb(g) = totgrcc(g) + tot_woodprod_grc(g) + cropprod1_grc(g) + & - hrv_xsmrpool_amount_left_to_dribble(g) + & - dwt_conv_cflux_amount_left_to_dribble(g) - - ! calculate total gridcell-level inputs - ! slevis notes: - ! nbp_grc = nep_grc - fire_closs_grc - hrv_xsmrpool_to_atm_dribbled_grc - dwt_conv_cflux_dribbled_grc - product_closs_grc - grc_cinputs = nbp_grc(g) + & - dwt_seedc_to_leaf_grc(g) + dwt_seedc_to_deadstem_grc(g) - - ! calculate total gridcell-level outputs - grc_coutputs = - som_c_leached_grc(g) - - ! calculate the total gridcell-level carbon balance error - ! for this time step - grc_errcb(g) = (grc_cinputs - grc_coutputs) * dt - & - (grc_endcb(g) - grc_begcb(g)) + if(.not.use_fates)then + call cnveg_carbonflux_inst%hrv_xsmrpool_to_atm_dribbler%get_amount_left_to_dribble_end( & + bounds, hrv_xsmrpool_amount_left_to_dribble(bounds%begg:bounds%endg)) + call cnveg_carbonflux_inst%dwt_conv_cflux_dribbler%get_amount_left_to_dribble_end( & + bounds, dwt_conv_cflux_amount_left_to_dribble(bounds%begg:bounds%endg)) + + grc_endcb(g) = totgrcc(g) + tot_woodprod_grc(g) + cropprod1_grc(g) + & + hrv_xsmrpool_amount_left_to_dribble(g) + & + dwt_conv_cflux_amount_left_to_dribble(g) + + ! calculate total gridcell-level inputs + ! slevis notes: + ! nbp_grc = nep_grc - fire_closs_grc - hrv_xsmrpool_to_atm_dribbled_grc - dwt_conv_cflux_dribbled_grc - product_closs_grc + + grc_cinputs = nbp_grc(g) + dwt_seedc_to_leaf_grc(g) + dwt_seedc_to_deadstem_grc(g) + ! calculate total gridcell-level outputs + grc_coutputs = - som_c_leached_grc(g) + ! calculate the total gridcell-level carbon balance error + ! for this time step + grc_errcb(g) = (grc_cinputs - grc_coutputs) * dt - & + (grc_endcb(g) - grc_begcb(g)) + + else + + ! Totally punt on this for now. We just don't track these gridscale variables yet (RGK) + grc_cinputs = 0._r8 + grc_coutputs = (grc_begcb(g) - grc_endcb(g))/dt + grc_errcb(g) = 0._r8 + + end if + ! check for significant errors if (abs(grc_errcb(g)) > this%cerror) then err_found = .true. @@ -452,7 +474,7 @@ end subroutine CBalanceCheck subroutine NBalanceCheck(this, bounds, num_soilc, filter_soilc, & soilbiogeochem_nitrogenflux_inst, soilbiogeochem_nitrogenstate_inst, & cnveg_nitrogenflux_inst, & - cnveg_nitrogenstate_inst, n_products_inst, atm2lnd_inst) + cnveg_nitrogenstate_inst, n_products_inst, atm2lnd_inst, clm_fates) ! ! !DESCRIPTION: ! Perform nitrogen mass conservation check @@ -473,14 +495,16 @@ subroutine NBalanceCheck(this, bounds, num_soilc, filter_soilc, & type(cnveg_nitrogenstate_type) , intent(inout) :: cnveg_nitrogenstate_inst type(cn_products_type) , intent(in) :: n_products_inst type(atm2lnd_type) , intent(in) :: atm2lnd_inst + type(hlm_fates_interface_type) , intent(inout) :: clm_fates ! ! !LOCAL VARIABLES: - integer :: c,err_index,j ! indices - integer :: g ! gridcell index - integer :: fc ! lake filter indices - logical :: err_found ! error flag - real(r8):: dt ! radiation time step (seconds) + integer :: c,err_index,j,s ! indices + integer :: ic ! index of clump + integer :: g ! gridcell index + integer :: fc ! lake filter indices + logical :: err_found ! error flag + real(r8):: dt ! radiation time step (seconds) real(r8):: col_ninputs(bounds%begc:bounds%endc) real(r8):: col_noutputs(bounds%begc:bounds%endc) real(r8):: col_errnb(bounds%begc:bounds%endc) @@ -522,8 +546,9 @@ subroutine NBalanceCheck(this, bounds, num_soilc, filter_soilc, & wood_harvestn => cnveg_nitrogenflux_inst%wood_harvestn_col , & ! Input: [real(r8) (:) ] (gN/m2/s) wood harvest (to product pools) crop_harvestn_to_cropprodn => cnveg_nitrogenflux_inst%crop_harvestn_to_cropprodn_col , & ! Input: [real(r8) (:) ] (gN/m2/s) crop harvest N to 1-year crop product pool - totcoln => soilbiogeochem_nitrogenstate_inst%totn_col & ! Input: [real(r8) (:) ] (gN/m2) total column nitrogen, incl veg - ) + totcoln => soilbiogeochem_nitrogenstate_inst%totn_col , & ! Input: [real(r8) (:) ] (gN/m2) total column nitrogen, incl veg + sminn_to_plant => soilbiogeochem_nitrogenflux_inst%sminn_to_plant_col ) + ! set time steps dt = get_step_size_real() @@ -532,6 +557,9 @@ subroutine NBalanceCheck(this, bounds, num_soilc, filter_soilc, & col_ninputs_partial(:) = 0._r8 col_noutputs_partial(:) = 0._r8 + ! clump index + ic = bounds%clump_index + err_found = .false. do fc = 1,num_soilc c=filter_soilc(fc) @@ -541,6 +569,18 @@ subroutine NBalanceCheck(this, bounds, num_soilc, filter_soilc, & ! calculate total column-level inputs col_ninputs(c) = ndep_to_sminn(c) + nfix_to_sminn(c) + supplement_to_sminn(c) + + ! If using fates, pass in the decomposition flux + if( col%is_fates(c) ) then + s = clm_fates%f2hmap(ic)%hsites(c) + col_ninputs(c) = col_ninputs(c) + & + sum(clm_fates%fates(ic)%bc_out(s)%litt_flux_lab_n_si(1:nlevdecomp) * & + clm_fates%fates(ic)%bc_in(s)%dz_decomp_sisl(1:nlevdecomp)) + & + sum(clm_fates%fates(ic)%bc_out(s)%litt_flux_cel_n_si(1:nlevdecomp) * & + clm_fates%fates(ic)%bc_in(s)%dz_decomp_sisl(1:nlevdecomp)) + & + sum(clm_fates%fates(ic)%bc_out(s)%litt_flux_lig_n_si(1:nlevdecomp) * & + clm_fates%fates(ic)%bc_in(s)%dz_decomp_sisl(1:nlevdecomp)) + end if if(use_fun)then col_ninputs(c) = col_ninputs(c) + ffix_to_sminn(c) ! for FUN, free living fixation is a seprate flux. RF. @@ -551,18 +591,29 @@ subroutine NBalanceCheck(this, bounds, num_soilc, filter_soilc, & end if col_ninputs_partial(c) = col_ninputs(c) - + ! calculate total column-level outputs - col_noutputs(c) = denit(c) + col_fire_nloss(c) + col_noutputs(c) = denit(c) + + if( .not.col%is_fates(c) ) then + + col_noutputs(c) = col_noutputs(c) + col_fire_nloss(c) + + ! Fluxes to product pools are included in column-level outputs: the product + ! pools are not included in totcoln, so are outside the system with respect to + ! these balance checks. (However, the dwt flux to product pools is NOT included, + ! since col_begnb is initialized after the dynamic area adjustments - i.e., + ! after the dwt term has already been taken out.) + col_noutputs(c) = col_noutputs(c) + & + wood_harvestn(c) + & + crop_harvestn_to_cropprodn(c) - ! Fluxes to product pools are included in column-level outputs: the product - ! pools are not included in totcoln, so are outside the system with respect to - ! these balance checks. (However, the dwt flux to product pools is NOT included, - ! since col_begnb is initialized after the dynamic area adjustments - i.e., - ! after the dwt term has already been taken out.) - col_noutputs(c) = col_noutputs(c) + & - wood_harvestn(c) + & - crop_harvestn_to_cropprodn(c) + else + + ! If we are using fates, remove plant uptake + col_noutputs(c) = col_noutputs(c) + sminn_to_plant(c) + + end if if (.not. use_nitrif_denitrif) then col_noutputs(c) = col_noutputs(c) + sminn_leached(c) @@ -573,11 +624,15 @@ subroutine NBalanceCheck(this, bounds, num_soilc, filter_soilc, & end if col_noutputs(c) = col_noutputs(c) - som_n_leached(c) + + col_noutputs_partial(c) = col_noutputs(c) - col_noutputs_partial(c) = col_noutputs(c) - & - wood_harvestn(c) - & - crop_harvestn_to_cropprodn(c) - + if( .not.col%is_fates(c) ) then + col_noutputs_partial(c) = col_noutputs_partial(c) - & + wood_harvestn(c) - & + crop_harvestn_to_cropprodn(c) + end if + ! calculate the total column-level nitrogen balance error for this time step col_errnb(c) = (col_ninputs(c) - col_noutputs(c))*dt - & (col_endnb(c) - col_begnb(c)) @@ -610,82 +665,86 @@ subroutine NBalanceCheck(this, bounds, num_soilc, filter_soilc, & call endrun(subgrid_index=c, subgrid_level=subgrid_level_column, msg=errMsg(sourcefile, __LINE__)) end if - ! Repeat error check at the gridcell level - call c2g( bounds = bounds, & - carr = totcoln(bounds%begc:bounds%endc), & - garr = totgrcn(bounds%begg:bounds%endg), & - c2l_scale_type = 'unity', & - l2g_scale_type = 'unity') - call c2g( bounds = bounds, & - carr = col_ninputs_partial(bounds%begc:bounds%endc), & - garr = grc_ninputs_partial(bounds%begg:bounds%endg), & - c2l_scale_type = 'unity', & - l2g_scale_type = 'unity') - call c2g( bounds = bounds, & - carr = col_noutputs_partial(bounds%begc:bounds%endc), & - garr = grc_noutputs_partial(bounds%begg:bounds%endg), & - c2l_scale_type = 'unity', & - l2g_scale_type = 'unity') - - err_found = .false. - do g = bounds%begg, bounds%endg - ! calculate the total gridcell-level nitrogen storage, for mass conservation check - ! Notes: - ! Not including seedn_grc in grc_begnb and grc_endnb because - ! seedn_grc forms out of thin air, for now, and equals - ! -1 * (dwt_seedn_to_leaf_grc(g) + dwt_seedn_to_deadstem_grc(g)) - ! We account for the latter fluxes as inputs below; the same - ! fluxes have entered the pools earlier in the timestep. For true - ! conservation we would need to add a flux out of nfix into seed. - grc_endnb(g) = totgrcn(g) + tot_woodprod_grc(g) + cropprod1_grc(g) - - ! calculate total gridcell-level inputs - grc_ninputs(g) = grc_ninputs_partial(g) + & - dwt_seedn_to_leaf_grc(g) + & - dwt_seedn_to_deadstem_grc(g) - - ! calculate total gridcell-level outputs - grc_noutputs(g) = grc_noutputs_partial(g) + & - dwt_conv_nflux_grc(g) + & - product_loss_grc(g) - - ! calculate the total gridcell-level nitrogen balance error for this time step - grc_errnb(g) = (grc_ninputs(g) - grc_noutputs(g)) * dt - & - (grc_endnb(g) - grc_begnb(g)) - if (abs(grc_errnb(g)) > this%nerror) then - err_found = .true. - err_index = g - end if - - if (abs(grc_errnb(g)) > this%nwarning) then - write(iulog,*) 'nbalance warning at g =', g, grc_errnb(g), grc_endnb(g) + if(.not.use_fates)then + + ! Repeat error check at the gridcell level + call c2g( bounds = bounds, & + carr = totcoln(bounds%begc:bounds%endc), & + garr = totgrcn(bounds%begg:bounds%endg), & + c2l_scale_type = 'unity', & + l2g_scale_type = 'unity') + call c2g( bounds = bounds, & + carr = col_ninputs_partial(bounds%begc:bounds%endc), & + garr = grc_ninputs_partial(bounds%begg:bounds%endg), & + c2l_scale_type = 'unity', & + l2g_scale_type = 'unity') + call c2g( bounds = bounds, & + carr = col_noutputs_partial(bounds%begc:bounds%endc), & + garr = grc_noutputs_partial(bounds%begg:bounds%endg), & + c2l_scale_type = 'unity', & + l2g_scale_type = 'unity') + + err_found = .false. + do g = bounds%begg, bounds%endg + ! calculate the total gridcell-level nitrogen storage, for mass conservation check + ! Notes: + ! Not including seedn_grc in grc_begnb and grc_endnb because + ! seedn_grc forms out of thin air, for now, and equals + ! -1 * (dwt_seedn_to_leaf_grc(g) + dwt_seedn_to_deadstem_grc(g)) + ! We account for the latter fluxes as inputs below; the same + ! fluxes have entered the pools earlier in the timestep. For true + ! conservation we would need to add a flux out of nfix into seed. + grc_endnb(g) = totgrcn(g) + tot_woodprod_grc(g) + cropprod1_grc(g) + + ! calculate total gridcell-level inputs + grc_ninputs(g) = grc_ninputs_partial(g) + & + dwt_seedn_to_leaf_grc(g) + & + dwt_seedn_to_deadstem_grc(g) + + ! calculate total gridcell-level outputs + grc_noutputs(g) = grc_noutputs_partial(g) + & + dwt_conv_nflux_grc(g) + & + product_loss_grc(g) + + ! calculate the total gridcell-level nitrogen balance error for this time step + grc_errnb(g) = (grc_ninputs(g) - grc_noutputs(g)) * dt - & + (grc_endnb(g) - grc_begnb(g)) + + if (abs(grc_errnb(g)) > this%nerror) then + err_found = .true. + err_index = g + end if + + if (abs(grc_errnb(g)) > this%nwarning) then + write(iulog,*) 'nbalance warning at g =', g, grc_errnb(g), grc_endnb(g) + end if + end do + + if (err_found) then + g = err_index + write(iulog,*) 'gridcell nbalance error =', grc_errnb(g), g + write(iulog,*) 'latdeg, londeg =', grc%latdeg(g), grc%londeg(g) + write(iulog,*) 'begnb =', grc_begnb(g) + write(iulog,*) 'endnb =', grc_endnb(g) + write(iulog,*) 'delta store =', grc_endnb(g) - grc_begnb(g) + write(iulog,*) 'input mass =', grc_ninputs(g) * dt + write(iulog,*) 'output mass =', grc_noutputs(g) * dt + write(iulog,*) 'net flux =', (grc_ninputs(g) - grc_noutputs(g)) * dt + write(iulog,*) '--- Inputs ---' + write(iulog,*) 'grc_ninputs_partial =', grc_ninputs_partial(g) * dt + write(iulog,*) 'dwt_seedn_to_leaf_grc =', dwt_seedn_to_leaf_grc(g) * dt + write(iulog,*) 'dwt_seedn_to_deadstem_grc =', dwt_seedn_to_deadstem_grc(g) * dt + write(iulog,*) '--- Outputs ---' + write(iulog,*) 'grc_noutputs_partial =', grc_noutputs_partial(g) * dt + write(iulog,*) 'dwt_conv_nflux_grc =', dwt_conv_nflux_grc(g) * dt + write(iulog,*) 'product_loss_grc =', product_loss_grc(g) * dt + call endrun(subgrid_index=g, subgrid_level=subgrid_level_gridcell, msg=errMsg(sourcefile, __LINE__)) end if - end do - - if (err_found) then - g = err_index - write(iulog,*) 'gridcell nbalance error =', grc_errnb(g), g - write(iulog,*) 'latdeg, londeg =', grc%latdeg(g), grc%londeg(g) - write(iulog,*) 'begnb =', grc_begnb(g) - write(iulog,*) 'endnb =', grc_endnb(g) - write(iulog,*) 'delta store =', grc_endnb(g) - grc_begnb(g) - write(iulog,*) 'input mass =', grc_ninputs(g) * dt - write(iulog,*) 'output mass =', grc_noutputs(g) * dt - write(iulog,*) 'net flux =', (grc_ninputs(g) - grc_noutputs(g)) * dt - write(iulog,*) '--- Inputs ---' - write(iulog,*) 'grc_ninputs_partial =', grc_ninputs_partial(g) * dt - write(iulog,*) 'dwt_seedn_to_leaf_grc =', dwt_seedn_to_leaf_grc(g) * dt - write(iulog,*) 'dwt_seedn_to_deadstem_grc =', dwt_seedn_to_deadstem_grc(g) * dt - write(iulog,*) '--- Outputs ---' - write(iulog,*) 'grc_noutputs_partial =', grc_noutputs_partial(g) * dt - write(iulog,*) 'dwt_conv_nflux_grc =', dwt_conv_nflux_grc(g) * dt - write(iulog,*) 'product_loss_grc =', product_loss_grc(g) * dt - call endrun(subgrid_index=g, subgrid_level=subgrid_level_gridcell, msg=errMsg(sourcefile, __LINE__)) end if - + end associate - + end subroutine NBalanceCheck end module CNBalanceCheckMod diff --git a/src/biogeochem/CNCStateUpdate1Mod.F90 b/src/biogeochem/CNCStateUpdate1Mod.F90 index 5783e01f6c..3b210506b1 100644 --- a/src/biogeochem/CNCStateUpdate1Mod.F90 +++ b/src/biogeochem/CNCStateUpdate1Mod.F90 @@ -142,7 +142,7 @@ end subroutine CStateUpdate0 subroutine CStateUpdate1( num_soilc, filter_soilc, num_soilp, filter_soilp, & crop_inst, cnveg_carbonflux_inst, cnveg_carbonstate_inst, & soilbiogeochem_carbonflux_inst, dribble_crophrv_xsmrpool_2atm, & - clm_fates, ci) + clm_fates, clump_index) ! ! !DESCRIPTION: ! On the radiation time step, update all the prognostic carbon state @@ -160,7 +160,7 @@ subroutine CStateUpdate1( num_soilc, filter_soilc, num_soilp, filter_soilp, & type(soilbiogeochem_carbonflux_type) , intent(inout) :: soilbiogeochem_carbonflux_inst logical , intent(in) :: dribble_crophrv_xsmrpool_2atm type(hlm_fates_interface_type) , intent(inout) :: clm_fates - integer , intent(in) :: ci ! clump index + integer , intent(in) :: clump_index ! ! !LOCAL VARIABLES: integer :: c,p,j,k,l,i ! indices @@ -201,7 +201,7 @@ subroutine CStateUpdate1( num_soilc, filter_soilc, num_soilp, filter_soilp, & ! prepared litter c flux boundary conditions into ! cf_soil%decomp_cpools_sourcesink_col - call clm_fates%UpdateCLitterfluxes(cf_soil,ci,c) + call clm_fates%UpdateCLitterfluxes(cf_soil,clump_index,c) else diff --git a/src/biogeochem/CNDriverMod.F90 b/src/biogeochem/CNDriverMod.F90 index c7918ec0fe..3c27f4e244 100644 --- a/src/biogeochem/CNDriverMod.F90 +++ b/src/biogeochem/CNDriverMod.F90 @@ -11,7 +11,7 @@ module CNDriverMod use decompMod , only : bounds_type use perf_mod , only : t_startf, t_stopf use clm_varctl , only : use_nitrif_denitrif, use_nguardrail - use clm_varctl , only : iulog, use_crop, use_crop_agsys + use clm_varctl , only : iulog, use_crop, use_crop_agsys, use_cn use SoilBiogeochemDecompCascadeConType, only : mimics_decomp, century_decomp, decomp_method use CNSharedParamsMod , only : use_fun use CNVegStateType , only : cnveg_state_type @@ -259,31 +259,33 @@ subroutine CNDriverNoLeaching(bounds, end if call t_stopf('CNZero-soilbgc-cflux') - call t_startf('CNZero-vegbgc-cflux') - call cnveg_carbonflux_inst%SetValues( & - nvegcpool,& - num_soilp, filter_soilp, 0._r8, & - num_soilc, filter_soilc, 0._r8) - if ( use_c13 ) then - call c13_cnveg_carbonflux_inst%SetValues( & + if(num_soilp>0)then + call t_startf('CNZero-vegbgc-cflux') + call cnveg_carbonflux_inst%SetValues( & nvegcpool,& num_soilp, filter_soilp, 0._r8, & num_soilc, filter_soilc, 0._r8) - end if - if ( use_c14 ) then - call c14_cnveg_carbonflux_inst%SetValues( & - nvegcpool,& + if ( use_c13 ) then + call c13_cnveg_carbonflux_inst%SetValues( & + nvegcpool,& + num_soilp, filter_soilp, 0._r8, & + num_soilc, filter_soilc, 0._r8) + end if + if ( use_c14 ) then + call c14_cnveg_carbonflux_inst%SetValues( & + nvegcpool,& + num_soilp, filter_soilp, 0._r8, & + num_soilc, filter_soilc, 0._r8) + end if + call t_stopf('CNZero-vegbgc-cflux') + + call t_startf('CNZero-vegbgc-nflux') + call cnveg_nitrogenflux_inst%SetValues( & + nvegnpool, & num_soilp, filter_soilp, 0._r8, & num_soilc, filter_soilc, 0._r8) end if - call t_stopf('CNZero-vegbgc-cflux') - - call t_startf('CNZero-vegbgc-nflux') - call cnveg_nitrogenflux_inst%SetValues( & - nvegnpool, & - num_soilp, filter_soilp, 0._r8, & - num_soilc, filter_soilc, 0._r8) - + call t_stopf('CNZero-vegbgc-nflux') call t_startf('CNZero-soilbgc-nflux') call soilbiogeochem_nitrogenflux_inst%SetValues( & @@ -309,7 +311,8 @@ subroutine CNDriverNoLeaching(bounds, else call t_startf('CNFixation') call CNNFixation( num_soilc, filter_soilc, & - cnveg_carbonflux_inst, soilbiogeochem_nitrogenflux_inst) + cnveg_carbonflux_inst, soilbiogeochem_nitrogenflux_inst, & + clm_fates, bounds%clump_index) call t_stopf('CNFixation') end if @@ -360,7 +363,8 @@ subroutine CNDriverNoLeaching(bounds, p_decomp_npool_to_din=p_decomp_npool_to_din(begc:endc,1:nlevdecomp,1:ndecomp_cascade_transitions)) call t_stopf('SoilBiogeochemPotential') - ! calculate vertical profiles for distributing soil and litter C and N (previously subroutine decomp_vertprofiles called from CNDecompAlloc) + ! calculate vertical profiles for distributing soil and litter C and N + ! (previously subroutine decomp_vertprofiles called from CNDecompAlloc) call SoilBiogeochemVerticalProfile(bounds, num_soilc, filter_soilc, num_soilp, filter_soilp, & active_layer_inst, soilstate_inst,soilbiogeochem_state_inst) @@ -450,9 +454,16 @@ subroutine CNDriverNoLeaching(bounds, ! get the column-averaged plant_ndemand (needed for following call to SoilBiogeochemCompetition) - call p2c(bounds, num_soilc, filter_soilc, & - cnveg_nitrogenflux_inst%plant_ndemand_patch(begp:endp), & - soilbiogeochem_state_inst%plant_ndemand_col(begc:endc)) + if(num_soilp>0)then + call p2c(bounds, num_soilc, filter_soilc, & + cnveg_nitrogenflux_inst%plant_ndemand_patch(begp:endp), & + soilbiogeochem_state_inst%plant_ndemand_col(begc:endc)) + else + ! With FATES N coupling, we will have a call to fill + ! this in on the filter_soilc + soilbiogeochem_state_inst%plant_ndemand_col(begc:endc) = 0._r8 + end if + call t_stopf('calc_plant_nutrient_demand') ! resolve plant/heterotroph competition for mineral N @@ -587,7 +598,7 @@ subroutine CNDriverNoLeaching(bounds, call t_stopf('CNUpdate0') - if ( use_nguardrail ) then + if ( use_nguardrail .and. num_soilp>0 ) then call t_startf('CNPrecisionControl') call CNPrecisionControl(bounds, num_soilp, filter_soilp, & cnveg_carbonstate_inst, c13_cnveg_carbonstate_inst, & @@ -644,11 +655,12 @@ subroutine CNDriverNoLeaching(bounds, ! Update all prognostic nitrogen state variables (except for gap-phase mortality and fire fluxes) call NStateUpdate1(num_soilc, filter_soilc, num_soilp, filter_soilp, & - cnveg_nitrogenflux_inst, cnveg_nitrogenstate_inst, soilbiogeochem_nitrogenflux_inst) + cnveg_nitrogenflux_inst, cnveg_nitrogenstate_inst, soilbiogeochem_nitrogenflux_inst, & + clm_fates, bounds%clump_index) call t_stopf('CNUpdate1') - if ( use_nguardrail ) then + if ( use_nguardrail .and. num_soilp>0 ) then call t_startf('CNPrecisionControl') call CNPrecisionControl(bounds, num_soilp, filter_soilp, & cnveg_carbonstate_inst, c13_cnveg_carbonstate_inst, & @@ -681,235 +693,257 @@ subroutine CNDriverNoLeaching(bounds, ! Calculate the gap mortality carbon and nitrogen fluxes !-------------------------------------------- - call t_startf('CNGapMortality') - - call CNGapMortality (bounds, num_soilc, filter_soilc, num_soilp, filter_soilp, & - dgvs_inst, cnveg_carbonstate_inst, cnveg_nitrogenstate_inst, soilbiogeochem_nitrogenflux_inst, & - cnveg_carbonflux_inst, cnveg_nitrogenflux_inst, canopystate_inst, & - !cnveg_carbonflux_inst, cnveg_nitrogenflux_inst, & - leaf_prof_patch=soilbiogeochem_state_inst%leaf_prof_patch(begp:endp, 1:nlevdecomp_full), & - froot_prof_patch=soilbiogeochem_state_inst%froot_prof_patch(begp:endp, 1:nlevdecomp_full), & - croot_prof_patch=soilbiogeochem_state_inst%croot_prof_patch(begp:endp, 1:nlevdecomp_full), & - stem_prof_patch=soilbiogeochem_state_inst%stem_prof_patch(begp:endp, 1:nlevdecomp_full)) - - call t_stopf('CNGapMortality') - - !-------------------------------------------------------------------------- - ! Update2 (gap mortality) - ! The state updates are still called for the matrix solution (use_matrixn - ! and use_soil_matrixcn) but most of the state updates are done after - ! the matrix multiply in VegMatrix and SoilMatrix. - !-------------------------------------------------------------------------- - - call t_startf('CNUpdate2') - - ! Set the carbon isotopic fluxes for gap mortality - if ( use_c13 ) then - call CIsoFlux2(num_soilc, filter_soilc, num_soilp, filter_soilp, & - soilbiogeochem_state_inst, cnveg_carbonflux_inst, cnveg_carbonstate_inst, & - iso_cnveg_carbonflux_inst=c13_cnveg_carbonflux_inst, & - iso_cnveg_carbonstate_inst=c13_cnveg_carbonstate_inst, & - isotope='c13') - end if - if ( use_c14 ) then - call CIsoFlux2(num_soilc, filter_soilc, num_soilp, filter_soilp, & - soilbiogeochem_state_inst, cnveg_carbonflux_inst, cnveg_carbonstate_inst, & - iso_cnveg_carbonflux_inst=c14_cnveg_carbonflux_inst, & - iso_cnveg_carbonstate_inst=c14_cnveg_carbonstate_inst, & - isotope='c14') - end if - - ! Update all the prognostic carbon state variables affected by gap-phase mortality fluxes - call CStateUpdate2(num_soilc, filter_soilc, num_soilp, filter_soilp, & - cnveg_carbonflux_inst, cnveg_carbonstate_inst, soilbiogeochem_carbonstate_inst, & - soilbiogeochem_carbonflux_inst) - if ( use_c13 ) then - call CStateUpdate2(num_soilc, filter_soilc, num_soilp, filter_soilp, & - c13_cnveg_carbonflux_inst, c13_cnveg_carbonstate_inst, c13_soilbiogeochem_carbonstate_inst, & - c13_soilbiogeochem_carbonflux_inst) - end if - if ( use_c14 ) then + if_soilp1: if(num_soilp>0)then + + call t_startf('CNGapMortality') + call CNGapMortality (bounds, num_soilc, filter_soilc, num_soilp, filter_soilp, & + dgvs_inst, cnveg_carbonstate_inst, cnveg_nitrogenstate_inst, soilbiogeochem_nitrogenflux_inst, & + cnveg_carbonflux_inst, cnveg_nitrogenflux_inst, canopystate_inst, & + leaf_prof_patch=soilbiogeochem_state_inst%leaf_prof_patch(begp:endp, 1:nlevdecomp_full), & + froot_prof_patch=soilbiogeochem_state_inst%froot_prof_patch(begp:endp, 1:nlevdecomp_full), & + croot_prof_patch=soilbiogeochem_state_inst%croot_prof_patch(begp:endp, 1:nlevdecomp_full), & + stem_prof_patch=soilbiogeochem_state_inst%stem_prof_patch(begp:endp, 1:nlevdecomp_full)) + call t_stopf('CNGapMortality') + + !-------------------------------------------------------------------------- + ! Update2 (gap mortality) + ! The state updates are still called for the matrix solution (use_matrixn + ! and use_soil_matrixcn) but most of the state updates are done after + ! the matrix multiply in VegMatrix and SoilMatrix. + !-------------------------------------------------------------------------- + + call t_startf('CNUpdate2') + ! Set the carbon isotopic fluxes for gap mortality + if ( use_c13 ) then + call CIsoFlux2(num_soilc, filter_soilc, num_soilp, filter_soilp, & + soilbiogeochem_state_inst, cnveg_carbonflux_inst, cnveg_carbonstate_inst, & + iso_cnveg_carbonflux_inst=c13_cnveg_carbonflux_inst, & + iso_cnveg_carbonstate_inst=c13_cnveg_carbonstate_inst, & + isotope='c13') + end if + if ( use_c14 ) then + call CIsoFlux2(num_soilc, filter_soilc, num_soilp, filter_soilp, & + soilbiogeochem_state_inst, cnveg_carbonflux_inst, cnveg_carbonstate_inst, & + iso_cnveg_carbonflux_inst=c14_cnveg_carbonflux_inst, & + iso_cnveg_carbonstate_inst=c14_cnveg_carbonstate_inst, & + isotope='c14') + end if + + ! Update all the prognostic carbon state variables affected by gap-phase mortality fluxes call CStateUpdate2(num_soilc, filter_soilc, num_soilp, filter_soilp, & - c14_cnveg_carbonflux_inst, c14_cnveg_carbonstate_inst, c14_soilbiogeochem_carbonstate_inst, & - c14_soilbiogeochem_carbonflux_inst) - end if - - ! Update all the prognostic nitrogen state variables affected by gap-phase mortality fluxes - call NStateUpdate2(num_soilc, filter_soilc, num_soilp, filter_soilp, & - cnveg_nitrogenflux_inst, cnveg_nitrogenstate_inst,soilbiogeochem_nitrogenstate_inst, & - soilbiogeochem_nitrogenflux_inst) - - !-------------------------------------------------------------------------- - ! Update2h (harvest) - ! The state updates are still called for the matrix solution (use_matrixn - ! and use_soil_matrixcn) but most of the state updates are done after - ! the matrix multiply in VegMatrix and SoilMatrix. - !-------------------------------------------------------------------------- - - ! Set harvest mortality routine - if (get_do_harvest()) then - call CNHarvest(num_soilc, filter_soilc, num_soilp, filter_soilp, & - soilbiogeochem_state_inst, cnveg_carbonstate_inst, cnveg_nitrogenstate_inst, & - cnveg_carbonflux_inst, cnveg_nitrogenflux_inst) - end if - - if ( use_c13 ) then - call CIsoFlux2h(num_soilc, filter_soilc, num_soilp, filter_soilp, & - soilbiogeochem_state_inst, & - cnveg_carbonflux_inst, cnveg_carbonstate_inst, & - c13_cnveg_carbonflux_inst, c13_cnveg_carbonstate_inst, & - isotope='c13') - end if - if ( use_c14 ) then - call CIsoFlux2h(num_soilc, filter_soilc, num_soilp, filter_soilp, & - soilbiogeochem_state_inst, & - cnveg_carbonflux_inst, cnveg_carbonstate_inst, & - c14_cnveg_carbonflux_inst, c14_cnveg_carbonstate_inst, & - isotope='c14') - end if + cnveg_carbonflux_inst, cnveg_carbonstate_inst, soilbiogeochem_carbonstate_inst, & + soilbiogeochem_carbonflux_inst) + if ( use_c13 ) then + call CStateUpdate2(num_soilc, filter_soilc, num_soilp, filter_soilp, & + c13_cnveg_carbonflux_inst, c13_cnveg_carbonstate_inst, c13_soilbiogeochem_carbonstate_inst, & + c13_soilbiogeochem_carbonflux_inst) + end if + if ( use_c14 ) then + call CStateUpdate2(num_soilc, filter_soilc, num_soilp, filter_soilp, & + c14_cnveg_carbonflux_inst, c14_cnveg_carbonstate_inst, c14_soilbiogeochem_carbonstate_inst, & + c14_soilbiogeochem_carbonflux_inst) + end if + + ! Update all the prognostic nitrogen state variables affected by gap-phase mortality fluxes + call NStateUpdate2(num_soilc, filter_soilc, num_soilp, filter_soilp, & + cnveg_nitrogenflux_inst, cnveg_nitrogenstate_inst,soilbiogeochem_nitrogenstate_inst, & + soilbiogeochem_nitrogenflux_inst) + + !-------------------------------------------------------------------------- + ! Update2h (harvest) + ! The state updates are still called for the matrix solution (use_matrixn + ! and use_soil_matrixcn) but most of the state updates are done after + ! the matrix multiply in VegMatrix and SoilMatrix. + !-------------------------------------------------------------------------- + + ! Set harvest mortality routine + if (get_do_harvest()) then + call CNHarvest(num_soilc, filter_soilc, num_soilp, filter_soilp, & + soilbiogeochem_state_inst, cnveg_carbonstate_inst, cnveg_nitrogenstate_inst, & + cnveg_carbonflux_inst, cnveg_nitrogenflux_inst) + end if - call CStateUpdate2h( num_soilc, filter_soilc, num_soilp, filter_soilp, & - cnveg_carbonflux_inst, cnveg_carbonstate_inst, soilbiogeochem_carbonstate_inst, & - soilbiogeochem_carbonflux_inst) - if ( use_c13 ) then - call CStateUpdate2h(num_soilc, filter_soilc, num_soilp, filter_soilp, & + if ( use_c13 ) then + call CIsoFlux2h(num_soilc, filter_soilc, num_soilp, filter_soilp, & + soilbiogeochem_state_inst, & + cnveg_carbonflux_inst, cnveg_carbonstate_inst, & + c13_cnveg_carbonflux_inst, c13_cnveg_carbonstate_inst, & + isotope='c13') + end if + if ( use_c14 ) then + call CIsoFlux2h(num_soilc, filter_soilc, num_soilp, filter_soilp, & + soilbiogeochem_state_inst, & + cnveg_carbonflux_inst, cnveg_carbonstate_inst, & + c14_cnveg_carbonflux_inst, c14_cnveg_carbonstate_inst, & + isotope='c14') + end if + + call CStateUpdate2h( num_soilc, filter_soilc, num_soilp, filter_soilp, & + cnveg_carbonflux_inst, cnveg_carbonstate_inst, soilbiogeochem_carbonstate_inst, & + soilbiogeochem_carbonflux_inst) + if ( use_c13 ) then + call CStateUpdate2h(num_soilc, filter_soilc, num_soilp, filter_soilp, & c13_cnveg_carbonflux_inst, c13_cnveg_carbonstate_inst, c13_soilbiogeochem_carbonstate_inst, & c13_soilbiogeochem_carbonflux_inst) - end if - if ( use_c14 ) then - call CStateUpdate2h(num_soilc, filter_soilc, num_soilp, filter_soilp, & - c14_cnveg_carbonflux_inst, c14_cnveg_carbonstate_inst, c14_soilbiogeochem_carbonstate_inst, & - c14_soilbiogeochem_carbonflux_inst) - end if - - call NStateUpdate2h(num_soilc, filter_soilc, num_soilp, filter_soilp, & - cnveg_nitrogenflux_inst, cnveg_nitrogenstate_inst, soilbiogeochem_nitrogenstate_inst, & - soilbiogeochem_nitrogenflux_inst) - call t_stopf('CNUpdate2') - - if ( use_nguardrail ) then + end if + if ( use_c14 ) then + call CStateUpdate2h(num_soilc, filter_soilc, num_soilp, filter_soilp, & + c14_cnveg_carbonflux_inst, c14_cnveg_carbonstate_inst, c14_soilbiogeochem_carbonstate_inst, & + c14_soilbiogeochem_carbonflux_inst) + end if + + call NStateUpdate2h(num_soilc, filter_soilc, num_soilp, filter_soilp, & + cnveg_nitrogenflux_inst, cnveg_nitrogenstate_inst, soilbiogeochem_nitrogenstate_inst, & + soilbiogeochem_nitrogenflux_inst) + call t_stopf('CNUpdate2') + + end if if_soilp1 + + if ( use_nguardrail .and. num_soilp>0 ) then call t_startf('CNPrecisionControl') call CNPrecisionControl(bounds, num_soilp, filter_soilp, & cnveg_carbonstate_inst, c13_cnveg_carbonstate_inst, & c14_cnveg_carbonstate_inst, cnveg_nitrogenstate_inst) call t_stopf('CNPrecisionControl') end if + !-------------------------------------------- ! Calculate loss fluxes from wood products pools ! and update product pool state variables !-------------------------------------------- call t_startf('CNWoodProducts') - call c_products_inst%UpdateProducts(bounds, & - num_soilp, filter_soilp, & - dwt_wood_product_gain_patch = cnveg_carbonflux_inst%dwt_wood_productc_gain_patch(begp:endp), & - wood_harvest_patch = cnveg_carbonflux_inst%wood_harvestc_patch(begp:endp), & - dwt_crop_product_gain_patch = cnveg_carbonflux_inst%dwt_crop_productc_gain_patch(begp:endp), & - crop_harvest_to_cropprod_patch = cnveg_carbonflux_inst%crop_harvestc_to_cropprodc_patch(begp:endp)) - call t_stopf('CNWoodProducts') - - if (use_c13) then - call c13_products_inst%UpdateProducts(bounds, & - num_soilp, filter_soilp, & - dwt_wood_product_gain_patch = c13_cnveg_carbonflux_inst%dwt_wood_productc_gain_patch(begp:endp), & - wood_harvest_patch = c13_cnveg_carbonflux_inst%wood_harvestc_patch(begp:endp), & - dwt_crop_product_gain_patch = c13_cnveg_carbonflux_inst%dwt_crop_productc_gain_patch(begp:endp), & - crop_harvest_to_cropprod_patch = c13_cnveg_carbonflux_inst%crop_harvestc_to_cropprodc_patch(begp:endp)) + + call c_products_inst%SetValues(bounds,0._r8) + if (use_c13) call c13_products_inst%SetValues(bounds,0._r8) + if (use_c14) call c14_products_inst%SetValues(bounds,0._r8) + call n_products_inst%SetValues(bounds,0._r8) + + if(use_fates) then + call clm_fates%wrap_WoodProducts(bounds, num_soilc, filter_soilc, c_products_inst, n_products_inst) end if - if (use_c14) then - call c14_products_inst%UpdateProducts(bounds, & + if_soilp2: if(num_soilp>0)then + call c_products_inst%UpdateProducts(bounds, & num_soilp, filter_soilp, & - dwt_wood_product_gain_patch = c14_cnveg_carbonflux_inst%dwt_wood_productc_gain_patch(begp:endp), & - wood_harvest_patch = c14_cnveg_carbonflux_inst%wood_harvestc_patch(begp:endp), & - dwt_crop_product_gain_patch = c14_cnveg_carbonflux_inst%dwt_crop_productc_gain_patch(begp:endp), & - crop_harvest_to_cropprod_patch = c14_cnveg_carbonflux_inst%crop_harvestc_to_cropprodc_patch(begp:endp)) - end if + dwt_wood_product_gain_patch = cnveg_carbonflux_inst%dwt_wood_productc_gain_patch(begp:endp), & + wood_harvest_patch = cnveg_carbonflux_inst%wood_harvestc_patch(begp:endp), & + dwt_crop_product_gain_patch = cnveg_carbonflux_inst%dwt_crop_productc_gain_patch(begp:endp), & + crop_harvest_to_cropprod_patch = cnveg_carbonflux_inst%crop_harvestc_to_cropprodc_patch(begp:endp)) + + if (use_c13) then + call c13_products_inst%UpdateProducts(bounds, & + num_soilp, filter_soilp, & + dwt_wood_product_gain_patch = c13_cnveg_carbonflux_inst%dwt_wood_productc_gain_patch(begp:endp), & + wood_harvest_patch = c13_cnveg_carbonflux_inst%wood_harvestc_patch(begp:endp), & + dwt_crop_product_gain_patch = c13_cnveg_carbonflux_inst%dwt_crop_productc_gain_patch(begp:endp), & + crop_harvest_to_cropprod_patch = c13_cnveg_carbonflux_inst%crop_harvestc_to_cropprodc_patch(begp:endp)) + end if - call n_products_inst%UpdateProducts(bounds, & - num_soilp, filter_soilp, & - dwt_wood_product_gain_patch = cnveg_nitrogenflux_inst%dwt_wood_productn_gain_patch(begp:endp), & - wood_harvest_patch = cnveg_nitrogenflux_inst%wood_harvestn_patch(begp:endp), & - dwt_crop_product_gain_patch = cnveg_nitrogenflux_inst%dwt_crop_productn_gain_patch(begp:endp), & - crop_harvest_to_cropprod_patch = cnveg_nitrogenflux_inst%crop_harvestn_to_cropprodn_patch(begp:endp)) + if (use_c14) then + call c14_products_inst%UpdateProducts(bounds, & + num_soilp, filter_soilp, & + dwt_wood_product_gain_patch = c14_cnveg_carbonflux_inst%dwt_wood_productc_gain_patch(begp:endp), & + wood_harvest_patch = c14_cnveg_carbonflux_inst%wood_harvestc_patch(begp:endp), & + dwt_crop_product_gain_patch = c14_cnveg_carbonflux_inst%dwt_crop_productc_gain_patch(begp:endp), & + crop_harvest_to_cropprod_patch = c14_cnveg_carbonflux_inst%crop_harvestc_to_cropprodc_patch(begp:endp)) + end if + call n_products_inst%UpdateProducts(bounds, & + num_soilp, filter_soilp, & + dwt_wood_product_gain_patch = cnveg_nitrogenflux_inst%dwt_wood_productn_gain_patch(begp:endp), & + wood_harvest_patch = cnveg_nitrogenflux_inst%wood_harvestn_patch(begp:endp), & + dwt_crop_product_gain_patch = cnveg_nitrogenflux_inst%dwt_crop_productn_gain_patch(begp:endp), & + crop_harvest_to_cropprod_patch = cnveg_nitrogenflux_inst%crop_harvestn_to_cropprodn_patch(begp:endp)) + + end if if_soilp2 + + call c_products_inst%ComputeSummaryVars(bounds) + if (use_c13) call c13_products_inst%ComputeSummaryVars(bounds) + if (use_c14) call c14_products_inst%ComputeSummaryVars(bounds) + call n_products_inst%ComputeSummaryVars(bounds) + + call t_stopf('CNWoodProducts') + !-------------------------------------------- ! Calculate fire area and fluxes !-------------------------------------------- - call t_startf('CNFire') - call cnfire_method%CNFireArea(bounds, num_soilc, filter_soilc, num_soilp, filter_soilp, & - num_exposedvegp, filter_exposedvegp, num_noexposedvegp, filter_noexposedvegp, & - atm2lnd_inst, energyflux_inst, saturated_excess_runoff_inst, waterdiagnosticbulk_inst, wateratm2lndbulk_inst, & - waterstatebulk_inst, soilstate_inst, soil_water_retention_curve, & - cnveg_state_inst, cnveg_carbonstate_inst, & - totlitc_col=soilbiogeochem_carbonstate_inst%totlitc_col(begc:endc), & - decomp_cpools_vr_col=soilbiogeochem_carbonstate_inst%decomp_cpools_vr_col(begc:endc,1:nlevdecomp_full,1:ndecomp_pools), & - t_soi17cm_col=temperature_inst%t_soi17cm_col(begc:endc)) - - call cnfire_method%CNFireFluxes(bounds, num_soilc, filter_soilc, num_soilp, filter_soilp, & - num_actfirec, filter_actfirec, num_actfirep, filter_actfirep, & - dgvs_inst, cnveg_state_inst, & - cnveg_carbonstate_inst, cnveg_carbonflux_inst, cnveg_nitrogenstate_inst, cnveg_nitrogenflux_inst, & - soilbiogeochem_carbonflux_inst, & - leaf_prof_patch=soilbiogeochem_state_inst%leaf_prof_patch(begp:endp, 1:nlevdecomp_full), & - froot_prof_patch=soilbiogeochem_state_inst%froot_prof_patch(begp:endp, 1:nlevdecomp_full), & - croot_prof_patch=soilbiogeochem_state_inst%croot_prof_patch(begp:endp, 1:nlevdecomp_full), & - stem_prof_patch=soilbiogeochem_state_inst%stem_prof_patch(begp:endp, 1:nlevdecomp_full), & - totsomc_col=soilbiogeochem_carbonstate_inst%totsomc_col(begc:endc), & - decomp_cpools_vr_col=soilbiogeochem_carbonstate_inst%decomp_cpools_vr_col(begc:endc,1:nlevdecomp_full,1:ndecomp_pools), & - decomp_npools_vr_col=soilbiogeochem_nitrogenstate_inst%decomp_npools_vr_col(begc:endc,1:nlevdecomp_full,1:ndecomp_pools), & - somc_fire_col=soilbiogeochem_carbonflux_inst%somc_fire_col(begc:endc)) - call t_stopf('CNFire') - - - !-------------------------------------------------------------------------- - ! Update3 - ! The state updates are still called for the matrix solution (use_matrixn - ! and use_soil_matrixcn) but most of the state updates are done after - ! the matrix multiply in VegMatrix and SoilMatrix. - !-------------------------------------------------------------------------- - - call t_startf('CNUpdate3') - if ( use_c13 ) then - call CIsoFlux3(num_soilc, filter_soilc, num_soilp, filter_soilp, & - soilbiogeochem_state_inst , soilbiogeochem_carbonstate_inst, & - cnveg_carbonflux_inst, cnveg_carbonstate_inst, & - c13_cnveg_carbonflux_inst, c13_cnveg_carbonstate_inst, & - c13_soilbiogeochem_carbonstate_inst, & - isotope='c13') - end if - if ( use_c14 ) then - call CIsoFlux3(num_soilc, filter_soilc, num_soilp, filter_soilp, & - soilbiogeochem_state_inst , soilbiogeochem_carbonstate_inst, & - cnveg_carbonflux_inst, cnveg_carbonstate_inst, & - c14_cnveg_carbonflux_inst, c14_cnveg_carbonstate_inst, & - c14_soilbiogeochem_carbonstate_inst, & - isotope='c14') - end if - - call CStateUpdate3( num_soilc, filter_soilc, num_soilp, filter_soilp, & - cnveg_carbonflux_inst, cnveg_carbonstate_inst, soilbiogeochem_carbonstate_inst, & - soilbiogeochem_carbonflux_inst) + if_soilp3: if(num_soilp>0)then + call t_startf('CNFire') + call cnfire_method%CNFireArea(bounds, num_soilc, filter_soilc, num_soilp, filter_soilp, & + num_exposedvegp, filter_exposedvegp, num_noexposedvegp, filter_noexposedvegp, & + atm2lnd_inst, energyflux_inst, saturated_excess_runoff_inst, waterdiagnosticbulk_inst, wateratm2lndbulk_inst, & + waterstatebulk_inst, soilstate_inst, soil_water_retention_curve, & + cnveg_state_inst, cnveg_carbonstate_inst, & + totlitc_col=soilbiogeochem_carbonstate_inst%totlitc_col(begc:endc), & + decomp_cpools_vr_col=soilbiogeochem_carbonstate_inst%decomp_cpools_vr_col(begc:endc,1:nlevdecomp_full,1:ndecomp_pools), & + t_soi17cm_col=temperature_inst%t_soi17cm_col(begc:endc)) + + call cnfire_method%CNFireFluxes(bounds, num_soilc, filter_soilc, num_soilp, filter_soilp, & + num_actfirec, filter_actfirec, num_actfirep, filter_actfirep, & + dgvs_inst, cnveg_state_inst, & + cnveg_carbonstate_inst, cnveg_carbonflux_inst, cnveg_nitrogenstate_inst, cnveg_nitrogenflux_inst, & + soilbiogeochem_carbonflux_inst, & + leaf_prof_patch=soilbiogeochem_state_inst%leaf_prof_patch(begp:endp, 1:nlevdecomp_full), & + froot_prof_patch=soilbiogeochem_state_inst%froot_prof_patch(begp:endp, 1:nlevdecomp_full), & + croot_prof_patch=soilbiogeochem_state_inst%croot_prof_patch(begp:endp, 1:nlevdecomp_full), & + stem_prof_patch=soilbiogeochem_state_inst%stem_prof_patch(begp:endp, 1:nlevdecomp_full), & + totsomc_col=soilbiogeochem_carbonstate_inst%totsomc_col(begc:endc), & + decomp_cpools_vr_col=soilbiogeochem_carbonstate_inst%decomp_cpools_vr_col(begc:endc,1:nlevdecomp_full,1:ndecomp_pools), & + decomp_npools_vr_col=soilbiogeochem_nitrogenstate_inst%decomp_npools_vr_col(begc:endc,1:nlevdecomp_full,1:ndecomp_pools), & + somc_fire_col=soilbiogeochem_carbonflux_inst%somc_fire_col(begc:endc)) + call t_stopf('CNFire') + + !-------------------------------------------------------------------------- + ! Update3 + ! The state updates are still called for the matrix solution (use_matrixn + ! and use_soil_matrixcn) but most of the state updates are done after + ! the matrix multiply in VegMatrix and SoilMatrix. + !-------------------------------------------------------------------------- + + call t_startf('CNUpdate3') + if ( use_c13 ) then + call CIsoFlux3(num_soilc, filter_soilc, num_soilp, filter_soilp, & + soilbiogeochem_state_inst , soilbiogeochem_carbonstate_inst, & + cnveg_carbonflux_inst, cnveg_carbonstate_inst, & + c13_cnveg_carbonflux_inst, c13_cnveg_carbonstate_inst, & + c13_soilbiogeochem_carbonstate_inst, & + isotope='c13') + end if + if ( use_c14 ) then + call CIsoFlux3(num_soilc, filter_soilc, num_soilp, filter_soilp, & + soilbiogeochem_state_inst , soilbiogeochem_carbonstate_inst, & + cnveg_carbonflux_inst, cnveg_carbonstate_inst, & + c14_cnveg_carbonflux_inst, c14_cnveg_carbonstate_inst, & + c14_soilbiogeochem_carbonstate_inst, & + isotope='c14') + end if - if ( use_c13 ) then call CStateUpdate3( num_soilc, filter_soilc, num_soilp, filter_soilp, & - c13_cnveg_carbonflux_inst, c13_cnveg_carbonstate_inst, c13_soilbiogeochem_carbonstate_inst, & - c13_soilbiogeochem_carbonflux_inst) - end if + cnveg_carbonflux_inst, cnveg_carbonstate_inst, soilbiogeochem_carbonstate_inst, & + soilbiogeochem_carbonflux_inst) - if ( use_c14 ) then - call CStateUpdate3( num_soilc, filter_soilc, num_soilp, filter_soilp, & - c14_cnveg_carbonflux_inst, c14_cnveg_carbonstate_inst, c14_soilbiogeochem_carbonstate_inst, & - c14_soilbiogeochem_carbonflux_inst) + if ( use_c13 ) then + call CStateUpdate3( num_soilc, filter_soilc, num_soilp, filter_soilp, & + c13_cnveg_carbonflux_inst, c13_cnveg_carbonstate_inst, c13_soilbiogeochem_carbonstate_inst, & + c13_soilbiogeochem_carbonflux_inst) + end if - call C14Decay(bounds, num_soilc, filter_soilc, num_soilp, filter_soilp, & - c14_cnveg_carbonstate_inst, c14_soilbiogeochem_carbonstate_inst, & - c14_cnveg_carbonflux_inst, c14_soilbiogeochem_carbonflux_inst) - end if - call t_stopf('CNUpdate3') + if ( use_c14 ) then + call CStateUpdate3( num_soilc, filter_soilc, num_soilp, filter_soilp, & + c14_cnveg_carbonflux_inst, c14_cnveg_carbonstate_inst, c14_soilbiogeochem_carbonstate_inst, & + c14_soilbiogeochem_carbonflux_inst) + + call C14Decay(bounds, num_soilc, filter_soilc, num_soilp, filter_soilp, & + c14_cnveg_carbonstate_inst, c14_soilbiogeochem_carbonstate_inst, & + c14_cnveg_carbonflux_inst, c14_soilbiogeochem_carbonflux_inst) + end if + call t_stopf('CNUpdate3') - if ( use_nguardrail ) then + end if if_soilp3 + + if ( use_nguardrail .and. num_soilp>0 ) then call t_startf('CNPrecisionControl') call CNPrecisionControl(bounds, num_soilp, filter_soilp, & cnveg_carbonstate_inst, c13_cnveg_carbonstate_inst, & @@ -990,15 +1024,14 @@ subroutine CNDriverLeaching(bounds, & call t_stopf('SoilBiogeochemNLeaching') ! Nitrogen state variable update, mortality fluxes. - - call t_startf('NUpdate3') - - call NStateUpdate3(num_soilc, filter_soilc, num_soilp, filter_soilp, & - cnveg_nitrogenflux_inst, cnveg_nitrogenstate_inst, & - soilbiogeochem_nitrogenflux_inst, soilbiogeochem_nitrogenstate_inst) - - call t_stopf('NUpdate3') - + if(num_soilp>0)then + call t_startf('NUpdate3') + call NStateUpdate3(num_soilc, filter_soilc, num_soilp, filter_soilp, & + cnveg_nitrogenflux_inst, cnveg_nitrogenstate_inst, & + soilbiogeochem_nitrogenflux_inst, soilbiogeochem_nitrogenstate_inst) + call t_stopf('NUpdate3') + end if + !-------------------------------------------------------------------------- ! Solve the matrix solution and do the state update for matrix solution as ! part of that @@ -1168,16 +1201,16 @@ subroutine CNDriverSummarizeFluxes(bounds, & soilbiogeochem_carbonflux_inst%decomp_cascade_ctransfer_col(begc:endc,1:ndecomp_cascade_transitions), & soilbiogeochem_carbonstate_inst%cwdc_col(begc:endc), & soilbiogeochem_nitrogenstate_inst%cwdn_col(begc:endc), & - leafc_to_litter_patch=cnveg_carbonflux_inst%leafc_to_litter_patch(begp:endp), & - frootc_to_litter_patch=cnveg_carbonflux_inst%frootc_to_litter_patch(begp:endp)) + leafc_to_litter_patch=cnveg_carbonflux_inst%leafc_to_litter_patch, & + frootc_to_litter_patch=cnveg_carbonflux_inst%frootc_to_litter_patch) if ( use_c13 ) then call c13_soilbiogeochem_carbonflux_inst%Summary(bounds, num_soilc, filter_soilc, & num_soilp, filter_soilp, & c13_soilbiogeochem_carbonflux_inst%decomp_cascade_ctransfer_col(begc:endc,1:ndecomp_cascade_transitions), & c13_soilbiogeochem_carbonstate_inst%cwdc_col(begc:endc), & soilbiogeochem_nitrogenstate_inst%cwdn_col(begc:endc), & - leafc_to_litter_patch=c13_cnveg_carbonflux_inst%leafc_to_litter_patch(begp:endp), & - frootc_to_litter_patch=c13_cnveg_carbonflux_inst%frootc_to_litter_patch(begp:endp)) + leafc_to_litter_patch=c13_cnveg_carbonflux_inst%leafc_to_litter_patch, & + frootc_to_litter_patch=c13_cnveg_carbonflux_inst%frootc_to_litter_patch) end if if ( use_c14 ) then call c14_soilbiogeochem_carbonflux_inst%Summary(bounds, num_soilc, filter_soilc, & @@ -1185,8 +1218,8 @@ subroutine CNDriverSummarizeFluxes(bounds, & c14_soilbiogeochem_carbonflux_inst%decomp_cascade_ctransfer_col(begc:endc,1:ndecomp_cascade_transitions), & c14_soilbiogeochem_carbonstate_inst%cwdc_col(begc:endc), & soilbiogeochem_nitrogenstate_inst%cwdn_col(begc:endc), & - leafc_to_litter_patch=c14_cnveg_carbonflux_inst%leafc_to_litter_patch(begp:endp), & - frootc_to_litter_patch=c14_cnveg_carbonflux_inst%frootc_to_litter_patch(begp:endp)) + leafc_to_litter_patch=c14_cnveg_carbonflux_inst%leafc_to_litter_patch, & + frootc_to_litter_patch=c14_cnveg_carbonflux_inst%frootc_to_litter_patch) end if call soilbiogeochem_nitrogenflux_inst%Summary(bounds, num_soilc, filter_soilc) @@ -1194,41 +1227,43 @@ subroutine CNDriverSummarizeFluxes(bounds, & ! cnveg carbon/nitrogen flux summary ! ---------------------------------------------- - call t_startf('CNvegCflux_summary') - call cnveg_carbonflux_inst%Summary(bounds, num_soilc, filter_soilc, num_soilp, filter_soilp, & - isotope='bulk', & - soilbiogeochem_hr_col=soilbiogeochem_carbonflux_inst%hr_col(begc:endc), & - soilbiogeochem_cwdhr_col=soilbiogeochem_carbonflux_inst%cwdhr_col(begc:endc), & - soilbiogeochem_lithr_col=soilbiogeochem_carbonflux_inst%lithr_col(begc:endc), & - soilbiogeochem_decomp_cascade_ctransfer_col=& - soilbiogeochem_carbonflux_inst%decomp_cascade_ctransfer_col(begc:endc,1:ndecomp_cascade_transitions), & - product_closs_grc=c_products_inst%product_loss_grc(begg:endg)) - - if ( use_c13 ) then - call c13_cnveg_carbonflux_inst%Summary(bounds, num_soilc, filter_soilc, num_soilp, filter_soilp, & - isotope='c13', & - soilbiogeochem_hr_col=c13_soilbiogeochem_carbonflux_inst%hr_col(begc:endc), & - soilbiogeochem_cwdhr_col=c13_soilbiogeochem_carbonflux_inst%cwdhr_col(begc:endc), & - soilbiogeochem_lithr_col=c13_soilbiogeochem_carbonflux_inst%lithr_col(begc:endc), & - soilbiogeochem_decomp_cascade_ctransfer_col=& - c13_soilbiogeochem_carbonflux_inst%decomp_cascade_ctransfer_col(begc:endc,1:ndecomp_cascade_transitions), & - product_closs_grc=c13_products_inst%product_loss_grc(begg:endg)) - end if - - if ( use_c14 ) then - call c14_cnveg_carbonflux_inst%Summary(bounds, num_soilc, filter_soilc, num_soilp, filter_soilp, & - isotope='c14', & - soilbiogeochem_hr_col=c14_soilbiogeochem_carbonflux_inst%hr_col(begc:endc), & - soilbiogeochem_cwdhr_col=c14_soilbiogeochem_carbonflux_inst%cwdhr_col(begc:endc), & - soilbiogeochem_lithr_col=c14_soilbiogeochem_carbonflux_inst%lithr_col(begc:endc), & + if_soilp: if(num_soilp>0) then + call t_startf('CNvegCflux_summary') + call cnveg_carbonflux_inst%Summary(bounds, num_soilc, filter_soilc, num_soilp, filter_soilp, & + isotope='bulk', & + soilbiogeochem_hr_col=soilbiogeochem_carbonflux_inst%hr_col(begc:endc), & + soilbiogeochem_cwdhr_col=soilbiogeochem_carbonflux_inst%cwdhr_col(begc:endc), & + soilbiogeochem_lithr_col=soilbiogeochem_carbonflux_inst%lithr_col(begc:endc), & soilbiogeochem_decomp_cascade_ctransfer_col=& - c14_soilbiogeochem_carbonflux_inst%decomp_cascade_ctransfer_col(begc:endc,1:ndecomp_cascade_transitions), & - product_closs_grc=c14_products_inst%product_loss_grc(begg:endg)) - end if - call t_stopf('CNvegCflux_summary') - - call cnveg_nitrogenflux_inst%Summary(bounds, num_soilc, filter_soilc, num_soilp, filter_soilp) + soilbiogeochem_carbonflux_inst%decomp_cascade_ctransfer_col(begc:endc,1:ndecomp_cascade_transitions), & + product_closs_grc=c_products_inst%product_loss_grc(begg:endg)) + + if ( use_c13 ) then + call c13_cnveg_carbonflux_inst%Summary(bounds, num_soilc, filter_soilc, num_soilp, filter_soilp, & + isotope='c13', & + soilbiogeochem_hr_col=c13_soilbiogeochem_carbonflux_inst%hr_col(begc:endc), & + soilbiogeochem_cwdhr_col=c13_soilbiogeochem_carbonflux_inst%cwdhr_col(begc:endc), & + soilbiogeochem_lithr_col=c13_soilbiogeochem_carbonflux_inst%lithr_col(begc:endc), & + soilbiogeochem_decomp_cascade_ctransfer_col=& + c13_soilbiogeochem_carbonflux_inst%decomp_cascade_ctransfer_col(begc:endc,1:ndecomp_cascade_transitions), & + product_closs_grc=c13_products_inst%product_loss_grc(begg:endg)) + end if + + if ( use_c14 ) then + call c14_cnveg_carbonflux_inst%Summary(bounds, num_soilc, filter_soilc, num_soilp, filter_soilp, & + isotope='c14', & + soilbiogeochem_hr_col=c14_soilbiogeochem_carbonflux_inst%hr_col(begc:endc), & + soilbiogeochem_cwdhr_col=c14_soilbiogeochem_carbonflux_inst%cwdhr_col(begc:endc), & + soilbiogeochem_lithr_col=c14_soilbiogeochem_carbonflux_inst%lithr_col(begc:endc), & + soilbiogeochem_decomp_cascade_ctransfer_col=& + c14_soilbiogeochem_carbonflux_inst%decomp_cascade_ctransfer_col(begc:endc,1:ndecomp_cascade_transitions), & + product_closs_grc=c14_products_inst%product_loss_grc(begg:endg)) + end if + call t_stopf('CNvegCflux_summary') + call cnveg_nitrogenflux_inst%Summary(bounds, num_soilc, filter_soilc, num_soilp, filter_soilp) + end if if_soilp + call t_stopf('CNsum') end subroutine CNDriverSummarizeFluxes diff --git a/src/biogeochem/CNGapMortalityMod.F90 b/src/biogeochem/CNGapMortalityMod.F90 index 91c937f655..ebda9db56d 100644 --- a/src/biogeochem/CNGapMortalityMod.F90 +++ b/src/biogeochem/CNGapMortalityMod.F90 @@ -312,7 +312,7 @@ subroutine CNGapMortality (bounds, num_soilc, filter_soilc, num_soilp, filter_so froot_prof_patch(bounds%begp:bounds%endp, 1:nlevdecomp_full), & croot_prof_patch(bounds%begp:bounds%endp, 1:nlevdecomp_full), & stem_prof_patch(bounds%begp:bounds%endp, 1:nlevdecomp_full)) - + end associate end subroutine CNGapMortality diff --git a/src/biogeochem/CNNDynamicsMod.F90 b/src/biogeochem/CNNDynamicsMod.F90 index a658a63768..2c2189ec2d 100644 --- a/src/biogeochem/CNNDynamicsMod.F90 +++ b/src/biogeochem/CNNDynamicsMod.F90 @@ -25,6 +25,7 @@ module CNNDynamicsMod use ColumnType , only : col use PatchType , only : patch use perf_mod , only : t_startf, t_stopf + use CLMFatesInterfaceMod , only : hlm_fates_interface_type ! implicit none private @@ -192,7 +193,8 @@ end subroutine CNFreeLivingFixation !----------------------------------------------------------------------- subroutine CNNFixation(num_soilc, filter_soilc, & - cnveg_carbonflux_inst, soilbiogeochem_nitrogenflux_inst) + cnveg_carbonflux_inst, soilbiogeochem_nitrogenflux_inst, & + clm_fates, clump_index) ! ! !DESCRIPTION: ! On the radiation time step, update the nitrogen fixation rate @@ -209,12 +211,15 @@ subroutine CNNFixation(num_soilc, filter_soilc, & integer , intent(in) :: num_soilc ! number of soil columns in filter integer , intent(in) :: filter_soilc(:) ! filter for soil columns type(cnveg_carbonflux_type) , intent(inout) :: cnveg_carbonflux_inst - type(soilbiogeochem_nitrogenflux_type) , intent(inout) :: soilbiogeochem_nitrogenflux_inst + type(soilbiogeochem_nitrogenflux_type) , intent(inout) :: soilbiogeochem_nitrogenflux_inst + type(hlm_fates_interface_type) , intent(inout) :: clm_fates + integer , intent(in) :: clump_index ! ! !LOCAL VARIABLES: - integer :: c,fc ! indices + integer :: c,fc,s ! indices real(r8) :: t ! temporary real(r8) :: dayspyr ! days per year + real(r8) :: npp ! lag or smoothed net primary productivity (gC/m2/s) !----------------------------------------------------------------------- associate( & @@ -225,16 +230,22 @@ subroutine CNNFixation(num_soilc, filter_soilc, & ) dayspyr = get_curr_days_per_year() - if ( nfix_timeconst > 0._r8 .and. nfix_timeconst < 500._r8 ) then ! use exponential relaxation with time constant nfix_timeconst for NPP - NFIX relation ! Loop through columns do fc = 1,num_soilc c = filter_soilc(fc) - if (col_lag_npp(c) /= spval) then + if(col%is_fates(c))then + s = clm_fates%f2hmap(clump_index)%hsites(c) + npp = clm_fates%fates(clump_index)%bc_out(s)%ema_npp/(dayspyr*secspday) + else + npp = col_lag_npp(c) + end if + + if (npp /= spval) then ! need to put npp in units of gC/m^2/year here first - t = (1.8_r8 * (1._r8 - exp(-0.003_r8 * col_lag_npp(c)*(secspday * dayspyr))))/(secspday * dayspyr) + t = (1.8_r8 * (1._r8 - exp(-0.003_r8 * npp *(secspday * dayspyr))))/(secspday * dayspyr) nfix_to_sminn(c) = max(0._r8,t) else nfix_to_sminn(c) = 0._r8 diff --git a/src/biogeochem/CNNStateUpdate1Mod.F90 b/src/biogeochem/CNNStateUpdate1Mod.F90 index c99729b2ee..af049baad5 100644 --- a/src/biogeochem/CNNStateUpdate1Mod.F90 +++ b/src/biogeochem/CNNStateUpdate1Mod.F90 @@ -23,7 +23,10 @@ module CNNStateUpdate1Mod use SoilBiogeochemNitrogenFluxType , only : soilbiogeochem_nitrogenflux_type use SoilBiogeochemNitrogenStateType , only : soilbiogeochem_nitrogenstate_type use CropReprPoolsMod , only : nrepr, repr_grain_min, repr_grain_max, repr_structure_min, repr_structure_max - use PatchType , only : patch + use PatchType , only : patch + use CLMFatesInterfaceMod , only : hlm_fates_interface_type + use ColumnType , only : col + ! implicit none private @@ -96,7 +99,9 @@ end subroutine NStateUpdateDynPatch !----------------------------------------------------------------------- subroutine NStateUpdate1(num_soilc, filter_soilc, num_soilp, filter_soilp, & - cnveg_nitrogenflux_inst, cnveg_nitrogenstate_inst, soilbiogeochem_nitrogenflux_inst) + cnveg_nitrogenflux_inst, cnveg_nitrogenstate_inst, soilbiogeochem_nitrogenflux_inst, & + clm_fates, clump_index) + use CNSharedParamsMod , only : use_fun ! ! !DESCRIPTION: @@ -111,6 +116,9 @@ subroutine NStateUpdate1(num_soilc, filter_soilc, num_soilp, filter_soilp, & type(cnveg_nitrogenflux_type) , intent(inout) :: cnveg_nitrogenflux_inst type(cnveg_nitrogenstate_type) , intent(inout) :: cnveg_nitrogenstate_inst type(soilbiogeochem_nitrogenflux_type) , intent(inout) :: soilbiogeochem_nitrogenflux_inst + type(hlm_fates_interface_type) , intent(inout) :: clm_fates + integer , intent(in) :: clump_index + ! ! !LOCAL VARIABLES: integer :: c,p,j,l,g,k,i ! indices @@ -134,9 +142,23 @@ subroutine NStateUpdate1(num_soilc, filter_soilc, num_soilp, filter_soilp, & ! soilbiogeochemistry fluxes TODO - this should be moved elsewhere ! plant to litter fluxes - phenology and dynamic landcover fluxes - do j = 1, nlevdecomp - do fc = 1,num_soilc - c = filter_soilc(fc) + + fc_loop: do fc = 1,num_soilc + c = filter_soilc(fc) + + fates_if: if( col%is_fates(c) ) then + + ! If this is a fates column, then we ask fates for the + ! litter fluxes, the following routine simply copies + ! prepared litter c flux boundary conditions into + ! cf_soil%decomp_cpools_sourcesink_col + + !call clm_fates%UpdateNLitterfluxes(ff_soil,ci,c) + + else + + do j = 1, nlevdecomp + ! ! State update without the matrix solution ! @@ -151,19 +173,20 @@ subroutine NStateUpdate1(num_soilc, filter_soilc, num_soilp, filter_soilp, & ! time step, but to be safe, I'm explicitly setting it to zero here. nf_soil%decomp_npools_sourcesink_col(c,j,i_cwd) = 0._r8 - ! - ! For the matrix solution the actual state update comes after the matrix - ! multiply in SoilMatrix, but the matrix needs to be setup with - ! the equivalent of above. Those changes can be here or in the - ! native subroutines dealing with that field - ! + ! + ! For the matrix solution the actual state update comes after the matrix + ! multiply in SoilMatrix, but the matrix needs to be setup with + ! the equivalent of above. Those changes can be here or in the + ! native subroutines dealing with that field + ! else ! Do the above to the matrix solution do i = i_litr_min, i_litr_max end do end if end do - end do + end if fates_if + end do fc_loop do fp = 1,num_soilp p = filter_soilp(fp) diff --git a/src/biogeochem/CNPhenologyMod.F90 b/src/biogeochem/CNPhenologyMod.F90 index ec04fcbf54..4db642c58f 100644 --- a/src/biogeochem/CNPhenologyMod.F90 +++ b/src/biogeochem/CNPhenologyMod.F90 @@ -406,7 +406,7 @@ subroutine CNPhenology (bounds, num_soilc, filter_soilc, num_soilp, & ! gather all patch-level litterfall fluxes to the column for litter C and N inputs - call CNLitterToColumn(bounds, num_soilc, filter_soilc, & + call CNLitterToColumn(bounds, num_soilc, filter_soilc, num_soilp, filter_soilp, & cnveg_state_inst, cnveg_carbonflux_inst, cnveg_nitrogenflux_inst, & leaf_prof_patch(bounds%begp:bounds%endp,1:nlevdecomp_full), & froot_prof_patch(bounds%begp:bounds%endp,1:nlevdecomp_full)) @@ -3384,8 +3384,8 @@ end subroutine CNCropHarvestToProductPools !----------------------------------------------------------------------- subroutine CNLitterToColumn (bounds, num_soilc, filter_soilc, & - cnveg_state_inst,cnveg_carbonflux_inst, cnveg_nitrogenflux_inst, & - leaf_prof_patch, froot_prof_patch) + num_soilp, filter_soilp, cnveg_state_inst,cnveg_carbonflux_inst, & + cnveg_nitrogenflux_inst, leaf_prof_patch, froot_prof_patch) ! ! !DESCRIPTION: ! called at the end of cn_phenology to gather all patch-level litterfall fluxes @@ -3400,6 +3400,8 @@ subroutine CNLitterToColumn (bounds, num_soilc, filter_soilc, & type(bounds_type) , intent(in) :: bounds integer , intent(in) :: num_soilc ! number of soil columns in filter integer , intent(in) :: filter_soilc(:) ! filter for soil columns + integer , intent(in) :: num_soilp ! number of patches in filter + integer , intent(in) :: filter_soilp(:) ! filter for patches type(cnveg_state_type) , intent(in) :: cnveg_state_inst type(cnveg_carbonflux_type) , intent(inout) :: cnveg_carbonflux_inst type(cnveg_nitrogenflux_type) , intent(inout) :: cnveg_nitrogenflux_inst @@ -3407,7 +3409,7 @@ subroutine CNLitterToColumn (bounds, num_soilc, filter_soilc, & real(r8) , intent(in) :: froot_prof_patch(bounds%begp:,1:) ! ! !LOCAL VARIABLES: - integer :: fc,c,pi,p,k,j,i ! indices + integer :: fc,c,pi,p,k,j,i,fp ! indices !----------------------------------------------------------------------- SHR_ASSERT_ALL_FL((ubound(leaf_prof_patch) == (/bounds%endp,nlevdecomp_full/)), sourcefile, __LINE__) @@ -3438,94 +3440,85 @@ subroutine CNLitterToColumn (bounds, num_soilc, filter_soilc, & phenology_n_to_litr_n => cnveg_nitrogenflux_inst%phenology_n_to_litr_n_col & ! Output: [real(r8) (:,:,:) ] N fluxes associated with phenology (litterfall and crop) to litter pools (gN/m3/s) ) - do j = 1, nlevdecomp - do pi = 1,max_patch_per_col - do fc = 1,num_soilc - c = filter_soilc(fc) - - if ( pi <= col%npatches(c) ) then - p = col%patchi(c) + pi - 1 - if (patch%active(p)) then - - do i = i_litr_min, i_litr_max - ! leaf litter carbon fluxes - phenology_c_to_litr_c(c,j,i) = & - phenology_c_to_litr_c(c,j,i) + & - leafc_to_litter(p) * lf_f(ivt(p),i) * wtcol(p) * leaf_prof(p,j) - - ! leaf litter nitrogen fluxes - phenology_n_to_litr_n(c,j,i) = & - phenology_n_to_litr_n(c,j,i) + & - leafn_to_litter(p) * lf_f(ivt(p),i) * wtcol(p) * leaf_prof(p,j) + soil_loop: do j = 1, nlevdecomp + patch_loop: do fp = 1, num_soilp + p = filter_soilp(fp) + c = patch%column(p) + do i = i_litr_min, i_litr_max + ! leaf litter carbon fluxes + phenology_c_to_litr_c(c,j,i) = & + phenology_c_to_litr_c(c,j,i) + & + leafc_to_litter(p) * lf_f(ivt(p),i) * wtcol(p) * leaf_prof(p,j) + + ! leaf litter nitrogen fluxes + phenology_n_to_litr_n(c,j,i) = & + phenology_n_to_litr_n(c,j,i) + & + leafn_to_litter(p) * lf_f(ivt(p),i) * wtcol(p) * leaf_prof(p,j) + + ! fine root litter carbon fluxes + phenology_c_to_litr_c(c,j,i) = & + phenology_c_to_litr_c(c,j,i) + & + frootc_to_litter(p) * fr_f(ivt(p),i) * wtcol(p) * froot_prof(p,j) + + ! fine root litter nitrogen fluxes + phenology_n_to_litr_n(c,j,i) = & + phenology_n_to_litr_n(c,j,i) + & + frootn_to_litter(p) * fr_f(ivt(p),i) * wtcol(p) * froot_prof(p,j) + end do - ! fine root litter carbon fluxes + ! agroibis puts crop stem litter together with leaf litter + ! so I've used the leaf lf_f* parameters instead of making + ! new ones for now (slevis) + ! also for simplicity I've put "food" into the litter pools + + if (ivt(p) >= npcropmin) then ! add livestemc to litter + do i = i_litr_min, i_litr_max + ! stem litter carbon fluxes + phenology_c_to_litr_c(c,j,i) = & + phenology_c_to_litr_c(c,j,i) + & + livestemc_to_litter(p) * lf_f(ivt(p),i) * wtcol(p) * leaf_prof(p,j) + + ! stem litter nitrogen fluxes + phenology_n_to_litr_n(c,j,i) = & + phenology_n_to_litr_n(c,j,i) + & + livestemn_to_litter(p) * lf_f(ivt(p),i) * wtcol(p) * leaf_prof(p,j) + end do + + if (.not. use_grainproduct) then + do i = i_litr_min, i_litr_max + do k = repr_grain_min, repr_grain_max + ! grain litter carbon fluxes phenology_c_to_litr_c(c,j,i) = & - phenology_c_to_litr_c(c,j,i) + & - frootc_to_litter(p) * fr_f(ivt(p),i) * wtcol(p) * froot_prof(p,j) + phenology_c_to_litr_c(c,j,i) + & + repr_grainc_to_food(p,k) * lf_f(ivt(p),i) * wtcol(p) * leaf_prof(p,j) - ! fine root litter nitrogen fluxes + ! grain litter nitrogen fluxes phenology_n_to_litr_n(c,j,i) = & - phenology_n_to_litr_n(c,j,i) + & - frootn_to_litter(p) * fr_f(ivt(p),i) * wtcol(p) * froot_prof(p,j) + phenology_n_to_litr_n(c,j,i) + & + repr_grainn_to_food(p,k) * lf_f(ivt(p),i) * wtcol(p) * leaf_prof(p,j) end do - - ! agroibis puts crop stem litter together with leaf litter - ! so I've used the leaf lf_f* parameters instead of making - ! new ones for now (slevis) - ! also for simplicity I've put "food" into the litter pools - - if (ivt(p) >= npcropmin) then ! add livestemc to litter - do i = i_litr_min, i_litr_max - ! stem litter carbon fluxes - phenology_c_to_litr_c(c,j,i) = & - phenology_c_to_litr_c(c,j,i) + & - livestemc_to_litter(p) * lf_f(ivt(p),i) * wtcol(p) * leaf_prof(p,j) - - ! stem litter nitrogen fluxes - phenology_n_to_litr_n(c,j,i) = & - phenology_n_to_litr_n(c,j,i) + & - livestemn_to_litter(p) * lf_f(ivt(p),i) * wtcol(p) * leaf_prof(p,j) - end do - - if (.not. use_grainproduct) then - do i = i_litr_min, i_litr_max - do k = repr_grain_min, repr_grain_max - ! grain litter carbon fluxes - phenology_c_to_litr_c(c,j,i) = & - phenology_c_to_litr_c(c,j,i) + & - repr_grainc_to_food(p,k) * lf_f(ivt(p),i) * wtcol(p) * leaf_prof(p,j) - - ! grain litter nitrogen fluxes - phenology_n_to_litr_n(c,j,i) = & - phenology_n_to_litr_n(c,j,i) + & - repr_grainn_to_food(p,k) * lf_f(ivt(p),i) * wtcol(p) * leaf_prof(p,j) - end do - end do - end if - - do i = i_litr_min, i_litr_max - do k = repr_structure_min, repr_structure_max - ! reproductive structure litter carbon fluxes - phenology_c_to_litr_c(c,j,i) = & - phenology_c_to_litr_c(c,j,i) + & - repr_structurec_to_litter(p,k) * lf_f(ivt(p),i) * wtcol(p) * leaf_prof(p,j) - - ! reproductive structure litter nitrogen fluxes - phenology_n_to_litr_n(c,j,i) = & - phenology_n_to_litr_n(c,j,i) + & - repr_structuren_to_litter(p,k) * lf_f(ivt(p),i) * wtcol(p) * leaf_prof(p,j) - end do - end do - end if - end if + end do end if - end do + do i = i_litr_min, i_litr_max + do k = repr_structure_min, repr_structure_max + ! reproductive structure litter carbon fluxes + phenology_c_to_litr_c(c,j,i) = & + phenology_c_to_litr_c(c,j,i) + & + repr_structurec_to_litter(p,k) * lf_f(ivt(p),i) * wtcol(p) * leaf_prof(p,j) + + ! reproductive structure litter nitrogen fluxes + phenology_n_to_litr_n(c,j,i) = & + phenology_n_to_litr_n(c,j,i) + & + repr_structuren_to_litter(p,k) * lf_f(ivt(p),i) * wtcol(p) * leaf_prof(p,j) + end do + end do + end if - end do - end do + end do patch_loop + end do soil_loop - end associate + end associate end subroutine CNLitterToColumn diff --git a/src/biogeochem/CNProductsMod.F90 b/src/biogeochem/CNProductsMod.F90 index 254063ddac..8ffbe6db2e 100644 --- a/src/biogeochem/CNProductsMod.F90 +++ b/src/biogeochem/CNProductsMod.F90 @@ -21,7 +21,7 @@ module CNProductsMod ! ! !PUBLIC TYPES: type, public :: cn_products_type - private + ! ------------------------------------------------------------------------ ! Public instance variables ! ------------------------------------------------------------------------ @@ -73,12 +73,13 @@ module CNProductsMod procedure, private :: InitHistory procedure, private :: InitCold procedure, public :: Restart - + procedure, public :: SetValues + ! Science routines procedure, public :: UpdateProducts procedure, private :: PartitionWoodFluxes procedure, private :: PartitionCropFluxes - procedure, private :: ComputeSummaryVars + procedure, public :: ComputeSummaryVars end type cn_products_type @@ -170,6 +171,33 @@ subroutine InitAllocate(this, bounds) end subroutine InitAllocate + subroutine SetValues(this, bounds, setval) + + ! !ARGUMENTS: + class(cn_products_type), intent(inout) :: this + type(bounds_type), intent(in) :: bounds + real(r8), intent(in) :: setval + + ! This zero's arrays that are incremented on each model time-step + ! the hrv_deadstem arrays use a p2g routine for the use_cn portion + ! but we added this zero'ing here because FATES needs it zero'd + + this%dwt_prod10_gain_grc(bounds%begg:bounds%endg) = setval + this%dwt_prod100_gain_grc(bounds%begg:bounds%endg) = setval + this%dwt_cropprod1_gain_grc(bounds%begg:bounds%endg) = setval + + this%crop_harvest_to_cropprod1_grc(bounds%begg:bounds%endg) = setval + this%hrv_deadstem_to_prod10_grc(bounds%begg:bounds%endg) = setval + this%hrv_deadstem_to_prod100_grc(bounds%begg:bounds%endg) = setval + + !this%cropprod1_loss_grc(bounds%begg:bounds%endg) = setval + !this%prod10_loss_grc(bounds%begg:bounds%endg) = setval + !this%prod100_loss_grc(bounds%begg:bounds%endg) = setval + + return + end subroutine SetValues + + !----------------------------------------------------------------------- subroutine InitHistory(this, bounds) ! !USES: @@ -466,6 +494,7 @@ subroutine UpdateProducts(this, bounds, & ! !DESCRIPTION: ! Update all loss fluxes from wood and crop product pools, and update product pool ! state variables for both loss and gain terms + ! This is only for non-fates patches and columns ! ! !ARGUMENTS: class(cn_products_type) , intent(inout) :: this @@ -475,10 +504,10 @@ subroutine UpdateProducts(this, bounds, & ! dynamic landcover addition to wood product pools (g/m2/s) [patch]; although this is ! a patch-level flux, it is expressed per unit GRIDCELL area - real(r8), intent(in) :: dwt_wood_product_gain_patch( bounds%begp: ) + real(r8), intent(in) :: dwt_wood_product_gain_patch(bounds%begp:) ! wood harvest addition to wood product pools (g/m2/s) [patch] - real(r8), intent(in) :: wood_harvest_patch( bounds%begp: ) + real(r8), intent(in) :: wood_harvest_patch(bounds%begp:) ! dynamic landcover addition to crop product pools (g/m2/s) [patch]; although this is ! a patch-level flux, it is expressed per unit GRIDCELL area @@ -487,71 +516,28 @@ subroutine UpdateProducts(this, bounds, & ! crop harvest to crop product pool (g/m2/s) [patch] real(r8), intent(in) :: crop_harvest_to_cropprod_patch( bounds%begp: ) ! - ! !LOCAL VARIABLES: - integer :: g ! indices - real(r8) :: dt ! time step (seconds) - real(r8) :: kprod1 ! decay constant for 1-year product pool - real(r8) :: kprod10 ! decay constant for 10-year product pool - real(r8) :: kprod100 ! decay constant for 100-year product pool - !----------------------------------------------------------------------- + SHR_ASSERT_ALL_FL((ubound(dwt_wood_product_gain_patch) == (/bounds%endp/)), sourcefile, __LINE__) SHR_ASSERT_ALL_FL((ubound(wood_harvest_patch) == (/bounds%endp/)), sourcefile, __LINE__) SHR_ASSERT_ALL_FL((ubound(dwt_crop_product_gain_patch) == (/bounds%endp/)), sourcefile, __LINE__) SHR_ASSERT_ALL_FL((ubound(crop_harvest_to_cropprod_patch) == (/bounds%endp/)), sourcefile, __LINE__) - + call this%PartitionWoodFluxes(bounds, & num_soilp, filter_soilp, & dwt_wood_product_gain_patch(bounds%begp:bounds%endp), & wood_harvest_patch(bounds%begp:bounds%endp)) - + call this%PartitionCropFluxes(bounds, & num_soilp, filter_soilp, & dwt_crop_product_gain_patch(bounds%begp:bounds%endp), & - crop_harvest_to_cropprod_patch(bounds%begp:bounds%endp)) - - ! calculate losses from product pools - ! the following (1/s) rate constants result in ~90% loss of initial state over 1, 10 and 100 years, - ! respectively, using a discrete-time fractional decay algorithm. - kprod1 = 7.2e-8_r8 - kprod10 = 7.2e-9_r8 - kprod100 = 7.2e-10_r8 - - do g = bounds%begg, bounds%endg - ! calculate fluxes out of product pools (1/sec) - this%cropprod1_loss_grc(g) = this%cropprod1_grc(g) * kprod1 - this%prod10_loss_grc(g) = this%prod10_grc(g) * kprod10 - this%prod100_loss_grc(g) = this%prod100_grc(g) * kprod100 - end do - - ! set time steps - dt = get_step_size_real() - - ! update product state variables - do g = bounds%begg, bounds%endg - - ! fluxes into wood & crop product pools, from landcover change - this%cropprod1_grc(g) = this%cropprod1_grc(g) + this%dwt_cropprod1_gain_grc(g)*dt - this%prod10_grc(g) = this%prod10_grc(g) + this%dwt_prod10_gain_grc(g)*dt - this%prod100_grc(g) = this%prod100_grc(g) + this%dwt_prod100_gain_grc(g)*dt - - ! fluxes into wood & crop product pools, from harvest - this%cropprod1_grc(g) = this%cropprod1_grc(g) + this%crop_harvest_to_cropprod1_grc(g)*dt - this%prod10_grc(g) = this%prod10_grc(g) + this%hrv_deadstem_to_prod10_grc(g)*dt - this%prod100_grc(g) = this%prod100_grc(g) + this%hrv_deadstem_to_prod100_grc(g)*dt - - ! fluxes out of wood & crop product pools, from decomposition - this%cropprod1_grc(g) = this%cropprod1_grc(g) - this%cropprod1_loss_grc(g)*dt - this%prod10_grc(g) = this%prod10_grc(g) - this%prod10_loss_grc(g)*dt - this%prod100_grc(g) = this%prod100_grc(g) - this%prod100_loss_grc(g)*dt - - end do - - call this%ComputeSummaryVars(bounds) + crop_harvest_to_cropprod_patch(bounds%begp:bounds%endp)) + return end subroutine UpdateProducts !----------------------------------------------------------------------- + subroutine PartitionWoodFluxes(this, bounds, & num_soilp, filter_soilp, & dwt_wood_product_gain_patch, & @@ -599,7 +585,7 @@ subroutine PartitionWoodFluxes(this, bounds, & this%hrv_deadstem_to_prod100_patch(p) = & wood_harvest_patch(p) * (1.0_r8 - pftcon%pprodharv10(patch%itype(p))) end do - + ! Average harvest fluxes from patch to gridcell call p2g(bounds, & this%hrv_deadstem_to_prod10_patch(bounds%begp:bounds%endp), & @@ -607,24 +593,18 @@ subroutine PartitionWoodFluxes(this, bounds, & p2c_scale_type = 'unity', & c2l_scale_type = 'unity', & l2g_scale_type = 'unity') - + call p2g(bounds, & this%hrv_deadstem_to_prod100_patch(bounds%begp:bounds%endp), & this%hrv_deadstem_to_prod100_grc(bounds%begg:bounds%endg), & p2c_scale_type = 'unity', & c2l_scale_type = 'unity', & l2g_scale_type = 'unity') - - ! Zero the dwt gains - do g = bounds%begg, bounds%endg - this%dwt_prod10_gain_grc(g) = 0._r8 - this%dwt_prod100_gain_grc(g) = 0._r8 - end do - + ! Partition dynamic land cover fluxes to 10 and 100-year product pools. do p = bounds%begp, bounds%endp g = patch%gridcell(p) - + ! Note that pprod10 + pprod100 do NOT sum to 1: some fraction of the dwt changes ! was lost to other fluxes. dwt_wood_product_gain_patch gives the amount that goes ! to all product pools, so we need to determine the fraction of that flux that @@ -647,9 +627,9 @@ subroutine PartitionWoodFluxes(this, bounds, & msg='ERROR: dwt_wood_product_gain_patch(p) > 0' // & errMsg(sourcefile, __LINE__)) end if - + end do - + end subroutine PartitionWoodFluxes !----------------------------------------------------------------------- @@ -708,10 +688,6 @@ subroutine PartitionCropFluxes(this, bounds, & ! Determine gains from dynamic landcover - do g = bounds%begg, bounds%endg - this%dwt_cropprod1_gain_grc(g) = 0._r8 - end do - do p = bounds%begp, bounds%endp g = patch%gridcell(p) @@ -739,10 +715,52 @@ subroutine ComputeSummaryVars(this, bounds) ! ! !LOCAL VARIABLES: integer :: g ! indices - + real(r8) :: dt ! time step (seconds) + real(r8) :: kprod1 ! decay constant for 1-year product pool + real(r8) :: kprod10 ! decay constant for 10-year product pool + real(r8) :: kprod100 ! decay constant for 100-year product pool + !----------------------------------------------------------------------- character(len=*), parameter :: subname = 'ComputeSummaryVars' + + !----------------------------------------------------------------------- + ! calculate losses from product pools + ! the following (1/s) rate constants result in ~90% loss of initial state over 1, 10 and 100 years, + ! respectively, using a discrete-time fractional decay algorithm. + kprod1 = 7.2e-8_r8 + kprod10 = 7.2e-9_r8 + kprod100 = 7.2e-10_r8 + + do g = bounds%begg, bounds%endg + ! calculate fluxes out of product pools (1/sec) + this%cropprod1_loss_grc(g) = this%cropprod1_grc(g) * kprod1 + this%prod10_loss_grc(g) = this%prod10_grc(g) * kprod10 + this%prod100_loss_grc(g) = this%prod100_grc(g) * kprod100 + end do + ! set time steps + dt = get_step_size_real() + + ! update product state variables + do g = bounds%begg, bounds%endg + + ! fluxes into wood & crop product pools, from landcover change + this%cropprod1_grc(g) = this%cropprod1_grc(g) + this%dwt_cropprod1_gain_grc(g)*dt + this%prod10_grc(g) = this%prod10_grc(g) + this%dwt_prod10_gain_grc(g)*dt + this%prod100_grc(g) = this%prod100_grc(g) + this%dwt_prod100_gain_grc(g)*dt + + ! fluxes into wood & crop product pools, from harvest + this%cropprod1_grc(g) = this%cropprod1_grc(g) + this%crop_harvest_to_cropprod1_grc(g)*dt + this%prod10_grc(g) = this%prod10_grc(g) + this%hrv_deadstem_to_prod10_grc(g)*dt + this%prod100_grc(g) = this%prod100_grc(g) + this%hrv_deadstem_to_prod100_grc(g)*dt + + ! fluxes out of wood & crop product pools, from decomposition + this%cropprod1_grc(g) = this%cropprod1_grc(g) - this%cropprod1_loss_grc(g)*dt + this%prod10_grc(g) = this%prod10_grc(g) - this%prod10_loss_grc(g)*dt + this%prod100_grc(g) = this%prod100_grc(g) - this%prod100_loss_grc(g)*dt + + end do + do g = bounds%begg, bounds%endg ! total wood products diff --git a/src/biogeochem/CNVegetationFacade.F90 b/src/biogeochem/CNVegetationFacade.F90 index d30b9f1991..42d91e9c3d 100644 --- a/src/biogeochem/CNVegetationFacade.F90 +++ b/src/biogeochem/CNVegetationFacade.F90 @@ -1079,12 +1079,14 @@ subroutine EcosystemDynamicsPostDrainage(this, bounds, num_allc, filter_allc, & ! Set controls on very low values in critical state variables - call t_startf('CNPrecisionControl') - call CNPrecisionControl(bounds, num_soilp, filter_soilp, & - this%cnveg_carbonstate_inst, this%c13_cnveg_carbonstate_inst, & - this%c14_cnveg_carbonstate_inst, this%cnveg_nitrogenstate_inst) - call t_stopf('CNPrecisionControl') - + if(num_soilp>0)then + call t_startf('CNPrecisionControl') + call CNPrecisionControl(bounds, num_soilp, filter_soilp, & + this%cnveg_carbonstate_inst, this%c13_cnveg_carbonstate_inst, & + this%c14_cnveg_carbonstate_inst, this%cnveg_nitrogenstate_inst) + call t_stopf('CNPrecisionControl') + end if + call t_startf('SoilBiogeochemPrecisionControl') call SoilBiogeochemPrecisionControl(num_soilc, filter_soilc, & soilbiogeochem_carbonstate_inst, c13_soilbiogeochem_carbonstate_inst, & @@ -1194,7 +1196,8 @@ subroutine BalanceCheck(this, bounds, num_soilc, filter_soilc, & this%cnveg_nitrogenflux_inst, & this%cnveg_nitrogenstate_inst, & this%n_products_inst, & - atm2lnd_inst) + atm2lnd_inst, & + clm_fates) end if diff --git a/src/main/filterMod.F90 b/src/main/filterMod.F90 index bf7a9d625a..db82b665ec 100644 --- a/src/main/filterMod.F90 +++ b/src/main/filterMod.F90 @@ -33,9 +33,10 @@ module filterMod integer, pointer :: natvegp(:) ! CNDV nat-vegetated (present) filter (patches) integer :: num_natvegp ! number of patches in nat-vegetated filter - integer, pointer :: pcropp(:) ! prognostic crop filter (patches) + integer, pointer :: pcropp(:) ! prognostic crop filter (patches) integer :: num_pcropp ! number of patches in prognostic crop filter - integer, pointer :: soilnopcropp(:) ! soil w/o prog. crops (patches) + + integer, pointer :: soilnopcropp(:) ! soil w/o prog. crops (patches) integer :: num_soilnopcropp ! number of patches in soil w/o prog crops integer, pointer :: all_soil_patches(:) ! all soil or crop patches. Used for updating FATES SP drivers @@ -57,8 +58,7 @@ module filterMod integer, pointer :: bgc_vegp(:) ! patches with vegetation biochemistry active, negates ! SP type runs, could be CN or Crop (NOT FATES) integer :: num_bgc_vegp - - + integer, pointer :: soilc(:) ! soil filter (columns) integer :: num_soilc ! number of columns in soil filter integer, pointer :: soilp(:) ! soil filter (patches) @@ -478,14 +478,16 @@ subroutine setFiltersOneGroup(bounds, this_filter, include_inactive, glc_behavio fnl = 0 do p = bounds%begp,bounds%endp if (patch%active(p) .or. include_inactive) then - if (patch%itype(p) >= npcropmin) then !skips 2 generic crop types - fl = fl + 1 - this_filter(nc)%pcropp(fl) = p - else - l =patch%landunit(p) - if (lun%itype(l) == istsoil .or. lun%itype(l) == istcrop) then - fnl = fnl + 1 - this_filter(nc)%soilnopcropp(fnl) = p + if(.not.use_fates)then ! This needs to be a FATES filter + if (patch%itype(p) >= npcropmin) then !skips 2 generic crop types + fl = fl + 1 + this_filter(nc)%pcropp(fl) = p + else + l =patch%landunit(p) + if (lun%itype(l) == istsoil .or. lun%itype(l) == istcrop) then + fnl = fnl + 1 + this_filter(nc)%soilnopcropp(fnl) = p + end if end if end if end if diff --git a/src/soilbiogeochem/SoilBiogeochemCarbonFluxType.F90 b/src/soilbiogeochem/SoilBiogeochemCarbonFluxType.F90 index e42e395801..bda4c13c7a 100644 --- a/src/soilbiogeochem/SoilBiogeochemCarbonFluxType.F90 +++ b/src/soilbiogeochem/SoilBiogeochemCarbonFluxType.F90 @@ -759,8 +759,9 @@ subroutine Summary(this, bounds, & real(r8), intent(in), optional :: soilbiogeochem_cwdc_col(bounds%begc:) real(r8), intent(in), optional :: soilbiogeochem_cwdn_col(bounds%begc:) real(r8), intent(in), optional :: soilbiogeochem_decomp_cascade_ctransfer_col(bounds%begc:,1:) - real(r8), intent(in), optional :: leafc_to_litter_patch(bounds%begp:) - real(r8), intent(in), optional :: frootc_to_litter_patch(bounds%begp:) + + real(r8), intent(in), optional :: leafc_to_litter_patch(:) + real(r8), intent(in), optional :: frootc_to_litter_patch(:) ! ! !LOCAL VARIABLES: integer :: c,j,k,l,p @@ -895,21 +896,20 @@ subroutine Summary(this, bounds, & ! Calculate ligninNratio ! FATES does its own calculation - if (decomp_method == mimics_decomp) then + if (decomp_method == mimics_decomp .and. num_soilp>0) then + do fp = 1,num_soilp p = filter_soilp(fp) - if( .not.patch%is_fates(p)) then - associate(ivt => patch%itype) ! Input: [integer (:)] patch plant type - ligninNratio_leaf_patch(p) = pftcon%lf_flig(ivt(p)) * & - pftcon%lflitcn(ivt(p)) * & - leafc_to_litter_patch(p) - ligninNratio_froot_patch(p) = pftcon%fr_flig(ivt(p)) * & - pftcon%frootcn(ivt(p)) * & - frootc_to_litter_patch(p) - end associate - end if + associate(ivt => patch%itype) ! Input: [integer (:)] patch plant type + ligninNratio_leaf_patch(p) = pftcon%lf_flig(ivt(p)) * & + pftcon%lflitcn(ivt(p)) * & + leafc_to_litter_patch(p) + ligninNratio_froot_patch(p) = pftcon%fr_flig(ivt(p)) * & + pftcon%frootcn(ivt(p)) * & + frootc_to_litter_patch(p) + end associate end do - + call p2c(bounds, num_soilc, filter_soilc, & ligninNratio_leaf_patch(bounds%begp:bounds%endp), & ligninNratio_leaf_col(bounds%begc:bounds%endc)) @@ -926,19 +926,21 @@ subroutine Summary(this, bounds, & ! Calculate ligninNratioAve do fc = 1,num_soilc c = filter_soilc(fc) - if (soilbiogeochem_cwdn_col(c) > 0._r8) then - ligninNratio_cwd = CNParamsShareInst%cwd_flig * & - (soilbiogeochem_cwdc_col(c) / soilbiogeochem_cwdn_col(c)) * & - soilbiogeochem_decomp_cascade_ctransfer_col(c,i_cwdl2) - else - ligninNratio_cwd = 0._r8 + if(.not.col%is_fates(c)) then + if (soilbiogeochem_cwdn_col(c) > 0._r8) then + ligninNratio_cwd = CNParamsShareInst%cwd_flig * & + (soilbiogeochem_cwdc_col(c) / soilbiogeochem_cwdn_col(c)) * & + soilbiogeochem_decomp_cascade_ctransfer_col(c,i_cwdl2) + else + ligninNratio_cwd = 0._r8 + end if + this%litr_lig_c_to_n_col(c) = & + (ligninNratio_leaf_col(c) + ligninNratio_froot_col(c) + & + ligninNratio_cwd) / & + max(1.0e-3_r8, leafc_to_litter_col(c) + & + frootc_to_litter_col(c) + & + soilbiogeochem_decomp_cascade_ctransfer_col(c,i_cwdl2)) end if - this%litr_lig_c_to_n_col(c) = & - (ligninNratio_leaf_col(c) + ligninNratio_froot_col(c) + & - ligninNratio_cwd) / & - max(1.0e-3_r8, leafc_to_litter_col(c) + & - frootc_to_litter_col(c) + & - soilbiogeochem_decomp_cascade_ctransfer_col(c,i_cwdl2)) end do end if diff --git a/src/soilbiogeochem/SoilBiogeochemPrecisionControlMod.F90 b/src/soilbiogeochem/SoilBiogeochemPrecisionControlMod.F90 index 3740700ab1..91c70fcf5e 100644 --- a/src/soilbiogeochem/SoilBiogeochemPrecisionControlMod.F90 +++ b/src/soilbiogeochem/SoilBiogeochemPrecisionControlMod.F90 @@ -70,7 +70,8 @@ subroutine SoilBiogeochemPrecisionControl(num_soilc, filter_soilc, & ! they get too small. ! ! !USES: - use clm_varctl , only : iulog, use_c13, use_c14, use_nitrif_denitrif, use_cn + use clm_varctl , only : iulog, use_c13, use_c14, use_nitrif_denitrif + use clm_varctl , only : use_cn, use_fates use clm_varpar , only : nlevdecomp use CNSharedParamsMod, only: use_fun ! @@ -128,7 +129,7 @@ subroutine SoilBiogeochemPrecisionControl(num_soilc, filter_soilc, & cc = cc + cs%decomp_cpools_vr_col(c,j,k) cs%decomp_cpools_vr_col(c,j,k) = 0._r8 - if (use_cn) then + if (use_cn .or. use_fates) then cn = cn + ns%decomp_npools_vr_col(c,j,k) ns%decomp_npools_vr_col(c,j,k) = 0._r8 endif @@ -150,7 +151,7 @@ subroutine SoilBiogeochemPrecisionControl(num_soilc, filter_soilc, & cs%ctrunc_vr_col(c,j) = cs%ctrunc_vr_col(c,j) + cc - if (use_cn) then + if (use_cn .or. use_fates) then ns%ntrunc_vr_col(c,j) = ns%ntrunc_vr_col(c,j) + cn endif if ( use_c13 ) then diff --git a/src/soilbiogeochem/SoilBiogeochemStateType.F90 b/src/soilbiogeochem/SoilBiogeochemStateType.F90 index fcdced386d..86232160f7 100644 --- a/src/soilbiogeochem/SoilBiogeochemStateType.F90 +++ b/src/soilbiogeochem/SoilBiogeochemStateType.F90 @@ -103,7 +103,7 @@ subroutine InitAllocate(this, bounds) allocate(this%nue_decomp_cascade_col(1:ndecomp_cascade_transitions)); this%nue_decomp_cascade_col(:) = nan - + end subroutine InitAllocate !------------------------------------------------------------------------ diff --git a/src/utils/clmfates_interfaceMod.F90 b/src/utils/clmfates_interfaceMod.F90 index 2eb746e6f3..e6a3f611ad 100644 --- a/src/utils/clmfates_interfaceMod.F90 +++ b/src/utils/clmfates_interfaceMod.F90 @@ -48,6 +48,7 @@ module CLMFatesInterfaceMod use CNProductsMod , only : cn_products_type use clm_varctl , only : iulog use clm_varctl , only : fates_parteh_mode + use PRTGenericMod , only : prt_cnp_flex_allom_hyp use clm_varctl , only : use_fates use clm_varctl , only : fates_spitfire_mode use clm_varctl , only : use_fates_tree_damage @@ -2343,50 +2344,56 @@ end subroutine wrap_accumulatefluxes ! ====================================================================================== - subroutine wrap_WoodProducts(this, bounds_clump, fc, filterc, c_products_inst) + subroutine wrap_WoodProducts(this, bounds_clump, num_soilc, filter_soilc, & + c_products_inst, n_products_inst) ! !ARGUMENTS: class(hlm_fates_interface_type), intent(inout) :: this type(bounds_type) , intent(in) :: bounds_clump - integer , intent(in) :: fc ! size of column filter - integer , intent(in) :: filterc(fc) ! column filter + integer , intent(in) :: num_soilc ! size of column filter + integer , intent(in) :: filter_soilc(:) ! column filter type(cn_products_type) , intent(inout) :: c_products_inst + type(cn_products_type) , intent(inout) :: n_products_inst ! Locals - integer :: s,c,icc,g - integer :: nc - - ! This wrapper is not active. This is just place-holder code until - ! harvest-product flux is fully implemented. RGK-05-2022 + integer :: s,c,g,fc + integer :: ci ! Clump index + + ci = bounds_clump%clump_index - !associate( & - ! prod10c => c_products_inst%hrv_deadstem_to_prod10_grc, & - ! prod100c => c_products_inst%hrv_deadstem_to_prod100_grc) + ! Loop over columns + do fc = 1, num_soilc + + c = filter_soilc(fc) + g = col%gridcell(c) + s = this%f2hmap(ci)%hsites(c) - ! nc = bounds_clump%clump_index - ! Loop over columns - do icc = 1,fc - c = filterc(icc) - g = col%gridcell(c) - s = this%f2hmap(nc)%hsites(c) - - ! Shijie: Pass harvested wood products to ELM variable - ! prod10c(g) = prod10c(g) + & - ! this%fates(nc)%bc_out(s)%hrv_deadstemc_to_prod10c - ! prod100c(g) = prod100c(g) + & - ! this%fates(nc)%bc_out(s)%hrv_deadstemc_to_prod100c - - ! RGK: THere is also a patch level variable - !do ifp = 1,this%fates(nc)%sites(s)%youngest_patch%patchno - ! p = ifp+col%patchi(c) - ! hrv_deadstemc_to_prod10c(p) = - ! hrv_deadstemc_to_prod100c(p) - !end do + ! Shijie: Pass harvested wood products to CLM product pools + c_products_inst%hrv_deadstem_to_prod10_grc(g) = & + c_products_inst%hrv_deadstem_to_prod10_grc(g) + & + this%fates(ci)%bc_out(s)%hrv_deadstemc_to_prod10c + + c_products_inst%hrv_deadstem_to_prod100_grc(g) = & + c_products_inst%hrv_deadstem_to_prod100_grc(g) + & + this%fates(ci)%bc_out(s)%hrv_deadstemc_to_prod100c + + ! If N cycling is on + if(fates_parteh_mode .eq. prt_cnp_flex_allom_hyp ) then + + !n_products_inst%hrv_deadstem_to_prod10_grc(g) = & + ! n_products_inst%hrv_deadstem_to_prod10_grc(g) + & + ! this%fates(ci)%bc_out(s)%hrv_deadstemc_to_prod10c + + !n_products_inst%hrv_deadstem_to_prod100_grc(g) = & + ! n_products_inst%hrv_deadstem_to_prod100_grc(g) + & + ! this%fates(ci)%bc_out(s)%hrv_deadstemc_to_prod100c + + end if + - end do + end do - ! end associate - return + return end subroutine wrap_WoodProducts ! ====================================================================================== From 2f1ec5244d55d4c92921b54dfcd19088e0508648 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Thu, 2 Mar 2023 16:51:48 -0500 Subject: [PATCH 054/257] Pass through of getting fates in the full BGC call sequence. This incremental version does pass C and N balance checks at the column level, but not the grid level (because of missing diagnostic data structures) --- src/biogeochem/CNBalanceCheckMod.F90 | 50 +++++---- src/biogeochem/CNDriverMod.F90 | 11 +- src/biogeochem/CNNStateUpdate1Mod.F90 | 2 +- src/biogeochem/CNNStateUpdate3Mod.F90 | 68 +++++++++--- src/main/controlMod.F90 | 25 +++-- .../SoilBiogeochemCarbonFluxType.F90 | 10 +- .../SoilBiogeochemCarbonStateType.F90 | 1 - .../SoilBiogeochemNitrogenFluxType.F90 | 10 +- src/utils/clmfates_interfaceMod.F90 | 104 +++++++++++++++++- 9 files changed, 221 insertions(+), 60 deletions(-) diff --git a/src/biogeochem/CNBalanceCheckMod.F90 b/src/biogeochem/CNBalanceCheckMod.F90 index bf54e2b18f..a68410ddbe 100644 --- a/src/biogeochem/CNBalanceCheckMod.F90 +++ b/src/biogeochem/CNBalanceCheckMod.F90 @@ -253,7 +253,7 @@ subroutine CBalanceCheck(this, bounds, num_soilc, filter_soilc, & real(r8) :: som_c_leached_grc(bounds%begg:bounds%endg) real(r8) :: hrv_xsmrpool_amount_left_to_dribble(bounds%begg:bounds%endg) real(r8) :: dwt_conv_cflux_amount_left_to_dribble(bounds%begg:bounds%endg) - real(r8) :: fates_litter_flux + real(r8) :: fates_woodproduct_flux ! Total carbon wood products flux from FATES to CLM [gC/m2/s] !----------------------------------------------------------------------- @@ -277,7 +277,8 @@ subroutine CBalanceCheck(this, bounds, num_soilc, filter_soilc, & col_xsmrpool_to_atm => cnveg_carbonflux_inst%xsmrpool_to_atm_col , & ! Input: [real(r8) (:) ] (gC/m2/s) excess MR pool crop harvest loss to atm som_c_leached => soilbiogeochem_carbonflux_inst%som_c_leached_col , & ! Input: [real(r8) (:) ] (gC/m2/s) total SOM C loss from vertical transport - totcolc => soilbiogeochem_carbonstate_inst%totc_col & ! Input: [real(r8) (:) ] (gC/m2) total column carbon, incl veg and cpool + totcolc => soilbiogeochem_carbonstate_inst%totc_col , & ! Input: [real(r8) (:) ] (gC/m2) total column carbon, incl veg and cpool + fates_litter_flux => soilbiogeochem_carbonflux_inst%fates_litter_flux & ! Total carbon litter flux from FATES to CLM [gC/m2/s] ) ! set time steps @@ -299,17 +300,13 @@ subroutine CBalanceCheck(this, bounds, num_soilc, filter_soilc, & if( col%is_fates(c) ) then - ! calculate total column-level inputs (litter fluxes) [g/m2/s] s = clm_fates%f2hmap(ic)%hsites(c) - fates_litter_flux = sum(clm_fates%fates(ic)%bc_out(s)%litt_flux_lab_c_si(1:nlevdecomp) * & - clm_fates%fates(ic)%bc_in(s)%dz_decomp_sisl(1:nlevdecomp)) + & - sum(clm_fates%fates(ic)%bc_out(s)%litt_flux_cel_c_si(1:nlevdecomp) * & - clm_fates%fates(ic)%bc_in(s)%dz_decomp_sisl(1:nlevdecomp)) + & - sum(clm_fates%fates(ic)%bc_out(s)%litt_flux_lig_c_si(1:nlevdecomp) * & - clm_fates%fates(ic)%bc_in(s)%dz_decomp_sisl(1:nlevdecomp)) - - col_cinputs = fates_litter_flux + + fates_woodproduct_flux = clm_fates%fates(ic)%bc_out(s)%hrv_deadstemc_to_prod10c + & + clm_fates%fates(ic)%bc_out(s)%hrv_deadstemc_to_prod100c + + col_cinputs = fates_litter_flux(c) + fates_woodproduct_flux ! calculate total column-level outputs ! fates has already exported burn losses and fluxes to the atm @@ -326,6 +323,7 @@ subroutine CBalanceCheck(this, bounds, num_soilc, filter_soilc, & ! er = ar + hr, col_fire_closs includes patch-level fire losses col_coutputs = er(c) + col_fire_closs(c) + col_hrv_xsmrpool_to_atm(c) + & col_xsmrpool_to_atm(c) + ! Fluxes to product pools are included in column-level outputs: the product ! pools are not included in totcolc, so are outside the system with respect to @@ -359,13 +357,15 @@ subroutine CBalanceCheck(this, bounds, num_soilc, filter_soilc, & if (err_found) then c = err_index write(iulog,*)'column cbalance error = ', col_errcb(c), c + write(iulog,*)'is fates column? = ', col%is_fates(c) write(iulog,*)'Latdeg,Londeg=',grc%latdeg(col%gridcell(c)),grc%londeg(col%gridcell(c)) write(iulog,*)'begcb = ',col_begcb(c) write(iulog,*)'endcb = ',col_endcb(c) write(iulog,*)'delta store = ',col_endcb(c)-col_begcb(c) write(iulog,*)'--- Inputs ---' if( col%is_fates(c) ) then - write(iulog,*)'fates litter_flux = ',fates_litter_flux*dt + write(iulog,*)'fates litter_flux = ',fates_litter_flux(c)*dt + write(iulog,*)'fates wood product flux = ',fates_woodproduct_flux*dt else write(iulog,*)'gpp = ',gpp(c)*dt end if @@ -547,7 +547,9 @@ subroutine NBalanceCheck(this, bounds, num_soilc, filter_soilc, & crop_harvestn_to_cropprodn => cnveg_nitrogenflux_inst%crop_harvestn_to_cropprodn_col , & ! Input: [real(r8) (:) ] (gN/m2/s) crop harvest N to 1-year crop product pool totcoln => soilbiogeochem_nitrogenstate_inst%totn_col , & ! Input: [real(r8) (:) ] (gN/m2) total column nitrogen, incl veg - sminn_to_plant => soilbiogeochem_nitrogenflux_inst%sminn_to_plant_col ) + sminn_to_plant => soilbiogeochem_nitrogenflux_inst%sminn_to_plant_col, & + fates_litter_flux => soilbiogeochem_nitrogenflux_inst%fates_litter_flux & ! Total nitrogen litter flux from FATES to CLM [gN/m2/s] + ) ! set time steps @@ -572,14 +574,7 @@ subroutine NBalanceCheck(this, bounds, num_soilc, filter_soilc, & ! If using fates, pass in the decomposition flux if( col%is_fates(c) ) then - s = clm_fates%f2hmap(ic)%hsites(c) - col_ninputs(c) = col_ninputs(c) + & - sum(clm_fates%fates(ic)%bc_out(s)%litt_flux_lab_n_si(1:nlevdecomp) * & - clm_fates%fates(ic)%bc_in(s)%dz_decomp_sisl(1:nlevdecomp)) + & - sum(clm_fates%fates(ic)%bc_out(s)%litt_flux_cel_n_si(1:nlevdecomp) * & - clm_fates%fates(ic)%bc_in(s)%dz_decomp_sisl(1:nlevdecomp)) + & - sum(clm_fates%fates(ic)%bc_out(s)%litt_flux_lig_n_si(1:nlevdecomp) * & - clm_fates%fates(ic)%bc_in(s)%dz_decomp_sisl(1:nlevdecomp)) + col_ninputs(c) = col_ninputs(c) + fates_litter_flux(c) end if if(use_fun)then @@ -660,12 +655,19 @@ subroutine NBalanceCheck(this, bounds, num_soilc, filter_soilc, & write(iulog,*)'input mass = ',col_ninputs(c)*dt write(iulog,*)'output mass = ',col_noutputs(c)*dt write(iulog,*)'net flux = ',(col_ninputs(c)-col_noutputs(c))*dt - write(iulog,*)'inputs,ffix,nfix,ndep = ',ffix_to_sminn(c)*dt,nfix_to_sminn(c)*dt,ndep_to_sminn(c)*dt - write(iulog,*)'outputs,lch,roff,dnit = ',smin_no3_leached(c)*dt, smin_no3_runoff(c)*dt,f_n2o_nit(c)*dt + if(col%is_fates(c))then + write(iulog,*)'inputs,ndep,nfix,suppn= ',ndep_to_sminn(c)*dt,nfix_to_sminn(c)*dt,supplement_to_sminn(c)*dt + else + write(iulog,*)'inputs,ffix,nfix,ndep = ',ffix_to_sminn(c)*dt,nfix_to_sminn(c)*dt,ndep_to_sminn(c)*dt + end if + if(col%is_fates(c))then + write(iulog,*)'outputs,lch,roff,dnit,plnt = ',smin_no3_leached(c)*dt, smin_no3_runoff(c)*dt,f_n2o_nit(c)*dt,sminn_to_plant(c)*dt + else + write(iulog,*)'outputs,lch,roff,dnit = ',smin_no3_leached(c)*dt, smin_no3_runoff(c)*dt,f_n2o_nit(c)*dt + end if call endrun(subgrid_index=c, subgrid_level=subgrid_level_column, msg=errMsg(sourcefile, __LINE__)) end if - if(.not.use_fates)then ! Repeat error check at the gridcell level diff --git a/src/biogeochem/CNDriverMod.F90 b/src/biogeochem/CNDriverMod.F90 index 3c27f4e244..f353469738 100644 --- a/src/biogeochem/CNDriverMod.F90 +++ b/src/biogeochem/CNDriverMod.F90 @@ -977,8 +977,9 @@ subroutine CNDriverLeaching(bounds, & ! !USES: use SoilBiogeochemNLeachingMod, only: SoilBiogeochemNLeaching use CNNStateUpdate3Mod , only: NStateUpdate3 - use clm_time_manager , only : is_first_step_of_this_run_segment,is_beg_curr_year,is_end_curr_year,get_curr_date - use CNSharedParamsMod , only : use_matrixcn + use CNNStateUpdate3Mod , only: NStateUpdateLeaching + use clm_time_manager , only: is_first_step_of_this_run_segment,is_beg_curr_year,is_end_curr_year,get_curr_date + use CNSharedParamsMod , only: use_matrixcn use SoilBiogeochemDecompCascadeConType , only : use_soil_matrixcn ! ! !ARGUMENTS: @@ -1021,8 +1022,14 @@ subroutine CNDriverLeaching(bounds, & call SoilBiogeochemNLeaching(bounds, num_soilc, filter_soilc, & waterstatebulk_inst, waterfluxbulk_inst, soilbiogeochem_nitrogenstate_inst, & soilbiogeochem_nitrogenflux_inst) + call NStateUpdateLeaching(num_soilc, filter_soilc, & + soilbiogeochem_nitrogenflux_inst, soilbiogeochem_nitrogenstate_inst) call t_stopf('SoilBiogeochemNLeaching') + + + + ! Nitrogen state variable update, mortality fluxes. if(num_soilp>0)then call t_startf('NUpdate3') diff --git a/src/biogeochem/CNNStateUpdate1Mod.F90 b/src/biogeochem/CNNStateUpdate1Mod.F90 index af049baad5..5358c46de1 100644 --- a/src/biogeochem/CNNStateUpdate1Mod.F90 +++ b/src/biogeochem/CNNStateUpdate1Mod.F90 @@ -153,7 +153,7 @@ subroutine NStateUpdate1(num_soilc, filter_soilc, num_soilp, filter_soilp, & ! prepared litter c flux boundary conditions into ! cf_soil%decomp_cpools_sourcesink_col - !call clm_fates%UpdateNLitterfluxes(ff_soil,ci,c) + call clm_fates%UpdateNLitterfluxes(nf_soil,clump_index,c) else diff --git a/src/biogeochem/CNNStateUpdate3Mod.F90 b/src/biogeochem/CNNStateUpdate3Mod.F90 index b5e3f32fec..26902cef22 100644 --- a/src/biogeochem/CNNStateUpdate3Mod.F90 +++ b/src/biogeochem/CNNStateUpdate3Mod.F90 @@ -25,11 +25,63 @@ module CNNStateUpdate3Mod private ! ! !PUBLIC MEMBER FUNCTIONS: - public:: NStateUpdate3 + public :: NStateUpdate3 + public :: NStateUpdateLeaching !----------------------------------------------------------------------- contains + subroutine NStateUpdateLeaching(num_soilc, filter_soilc, & + soilbiogeochem_nitrogenflux_inst, soilbiogeochem_nitrogenstate_inst) + ! + ! !DESCRIPTION: + ! On the radiation time step, update all the prognostic nitrogen state + ! variables affected by the Sminn leaching flux. + ! RGK: This code was separated from gap mortality fluxes to make this + ! compatible with FATES. + ! + ! !ARGUMENTS: + integer , intent(in) :: num_soilc ! number of soil columns in filter + integer , intent(in) :: filter_soilc(:) ! filter for soil columns + type(soilbiogeochem_nitrogenflux_type) , intent(inout) :: soilbiogeochem_nitrogenflux_inst + type(soilbiogeochem_nitrogenstate_type) , intent(inout) :: soilbiogeochem_nitrogenstate_inst + + ! !LOCAL VARIABLES: + integer :: c,p,j,l,k ! indices + integer :: fp,fc ! lake filter indices + real(r8):: dt ! radiation time step (seconds) + !----------------------------------------------------------------------- + + associate( & + nf_soil => soilbiogeochem_nitrogenflux_inst , & ! Input + ns_soil => soilbiogeochem_nitrogenstate_inst & ! Output + ) + + ! set time steps + dt = get_step_size_real() + + do j = 1, nlevdecomp + ! column loop + do fc = 1,num_soilc + c = filter_soilc(fc) + + if (.not. use_nitrif_denitrif) then + ! mineral N loss due to leaching + ns_soil%sminn_vr_col(c,j) = ns_soil%sminn_vr_col(c,j) - nf_soil%sminn_leached_vr_col(c,j) * dt + else + ! mineral N loss due to leaching and runoff + ns_soil%smin_no3_vr_col(c,j) = max( ns_soil%smin_no3_vr_col(c,j) - & + ( nf_soil%smin_no3_leached_vr_col(c,j) + nf_soil%smin_no3_runoff_vr_col(c,j) ) * dt, 0._r8) + + ns_soil%sminn_vr_col(c,j) = ns_soil%smin_no3_vr_col(c,j) + ns_soil%smin_nh4_vr_col(c,j) + end if + end do + end do + + end associate + return + end subroutine NStateUpdateLeaching + !----------------------------------------------------------------------- subroutine NStateUpdate3(num_soilc, filter_soilc, num_soilp, filter_soilp, & cnveg_nitrogenflux_inst, cnveg_nitrogenstate_inst, & @@ -37,7 +89,7 @@ subroutine NStateUpdate3(num_soilc, filter_soilc, num_soilp, filter_soilp, & ! ! !DESCRIPTION: ! On the radiation time step, update all the prognostic nitrogen state - ! variables affected by gap-phase mortality fluxes. Also the Sminn leaching flux. + ! variables affected by gap-phase mortality fluxes. ! NOTE - associate statements have been removed where there are ! no science equations. This increases readability and maintainability. ! @@ -72,20 +124,8 @@ subroutine NStateUpdate3(num_soilc, filter_soilc, num_soilp, filter_soilp, & do fc = 1,num_soilc c = filter_soilc(fc) - if (.not. use_nitrif_denitrif) then - ! mineral N loss due to leaching - ns_soil%sminn_vr_col(c,j) = ns_soil%sminn_vr_col(c,j) - nf_soil%sminn_leached_vr_col(c,j) * dt - else - ! mineral N loss due to leaching and runoff - ns_soil%smin_no3_vr_col(c,j) = max( ns_soil%smin_no3_vr_col(c,j) - & - ( nf_soil%smin_no3_leached_vr_col(c,j) + nf_soil%smin_no3_runoff_vr_col(c,j) ) * dt, 0._r8) - - ns_soil%sminn_vr_col(c,j) = ns_soil%smin_no3_vr_col(c,j) + ns_soil%smin_nh4_vr_col(c,j) - end if - ! column level nitrogen fluxes from fire ! patch-level wood to column-level CWD (uncombusted wood) - ! ! State update without the matrix solution ! diff --git a/src/main/controlMod.F90 b/src/main/controlMod.F90 index a07228aa0d..a763703d6e 100644 --- a/src/main/controlMod.F90 +++ b/src/main/controlMod.F90 @@ -433,6 +433,15 @@ subroutine control_init(dtime) ! Check compatibility with the FATES model if ( use_fates ) then + if (fates_parteh_mode == 1 .and. suplnitro == suplnNon)then + write(iulog,*) ' When FATES with fates_parteh_mode == 1 (ie carbon only mode),' + write(iulog,*) ' you must have supplemental nitrogen turned on, there will be' + write(iulog,*) ' no nitrogen dynamics with the plants, and therefore no' + write(iulog,*) ' meaningful limitations to nitrogen.' + call endrun(msg=' ERROR: fates_parteh_mode=1 must have suplnitro set to suplnAll.'//& + errMsg(sourcefile, __LINE__)) + end if + if ( use_cn) then call endrun(msg=' ERROR: use_cn and use_fates cannot both be set to true.'//& errMsg(sourcefile, __LINE__)) @@ -689,7 +698,8 @@ subroutine control_spmd() ! BGC call mpi_bcast (co2_type, len(co2_type), MPI_CHARACTER, 0, mpicom, ier) - if (use_cn) then + + if (use_cn .or. use_fates) then call mpi_bcast (suplnitro, len(suplnitro), MPI_CHARACTER, 0, mpicom, ier) call mpi_bcast (nfix_timeconst, 1, MPI_REAL8, 0, mpicom, ier) call mpi_bcast (spinup_state, 1, MPI_INTEGER, 0, mpicom, ier) @@ -743,7 +753,7 @@ subroutine control_spmd() call mpi_bcast (use_dynroot, 1, MPI_LOGICAL, 0, mpicom, ier) - if (use_cn ) then + if (use_cn .or. use_fates) then ! vertical soil mixing variables call mpi_bcast (som_adv_flux, 1, MPI_REAL8, 0, mpicom, ier) call mpi_bcast (max_depth_cryoturb, 1, MPI_REAL8, 0, mpicom, ier) @@ -751,8 +761,8 @@ subroutine control_spmd() ! C and N input vertical profiles call mpi_bcast (surfprof_exp, 1, MPI_REAL8, 0, mpicom, ier) end if - - if (use_cn .and. use_nitrif_denitrif) then + + if ((use_cn.or.use_fates) .and. use_nitrif_denitrif) then call mpi_bcast (no_frozen_nitrif_denitrif, 1, MPI_LOGICAL, 0, mpicom, ier) end if @@ -899,7 +909,8 @@ subroutine control_print () write(iulog,*) ' Threshold above which the model keeps the lake landunit =', toosmall_lake write(iulog,*) ' Threshold above which the model keeps the wetland landunit =', toosmall_wetland write(iulog,*) ' Threshold above which the model keeps the urban landunits =', toosmall_urban - if (use_cn) then + + if (use_cn .or. use_fates) then if (suplnitro /= suplnNon)then write(iulog,*) ' Supplemental Nitrogen mode is set to run over Patches: ', & trim(suplnitro) @@ -930,13 +941,13 @@ subroutine control_print () write(iulog,*) ' override_bgc_restart_mismatch_dump : ', override_bgc_restart_mismatch_dump end if - if (use_cn ) then + if (use_cn .or. use_fates) then write(iulog, *) ' som_adv_flux, the advection term in soil mixing (m/s) : ', som_adv_flux write(iulog, *) ' max_depth_cryoturb (m) : ', max_depth_cryoturb write(iulog, *) ' surfprof_exp : ', surfprof_exp end if - if (use_cn .and. .not. use_nitrif_denitrif) then + if ((use_cn .or. use_fates) .and. .not. use_nitrif_denitrif) then write(iulog, *) ' no_frozen_nitrif_denitrif : ', no_frozen_nitrif_denitrif end if diff --git a/src/soilbiogeochem/SoilBiogeochemCarbonFluxType.F90 b/src/soilbiogeochem/SoilBiogeochemCarbonFluxType.F90 index bda4c13c7a..3a311807a9 100644 --- a/src/soilbiogeochem/SoilBiogeochemCarbonFluxType.F90 +++ b/src/soilbiogeochem/SoilBiogeochemCarbonFluxType.F90 @@ -6,6 +6,7 @@ module SoilBiogeochemCarbonFluxType use clm_varpar , only : ndecomp_cascade_transitions, ndecomp_pools, nlevcan use clm_varpar , only : nlevdecomp_full, nlevgrnd, nlevdecomp, nlevsoi, i_cwdl2 use clm_varcon , only : spval, ispval, dzsoi_decomp + use clm_varctl , only : use_fates use pftconMod , only : pftcon use landunit_varcon , only : istsoil, istcrop, istdlak use ch4varcon , only : allowlakeprod @@ -57,7 +58,8 @@ module SoilBiogeochemCarbonFluxType real(r8), pointer :: lithr_col (:) ! (gC/m2/s) litter heterotrophic respiration: donor-pool based definition real(r8), pointer :: somhr_col (:) ! (gC/m2/s) soil organic matter heterotrophic res: donor-pool based definition real(r8), pointer :: soilc_change_col (:) ! (gC/m2/s) FUN used soil C - + real(r8), pointer :: fates_litter_flux (:) ! (gC/m2/s) Litter flux passed in from FATES + contains procedure , public :: Init @@ -155,7 +157,11 @@ subroutine InitAllocate(this, bounds) allocate(this%lithr_col (begc:endc)) ; this%lithr_col (:) = nan allocate(this%somhr_col (begc:endc)) ; this%somhr_col (:) = nan allocate(this%soilc_change_col (begc:endc)) ; this%soilc_change_col (:) = nan - + + if(use_fates)then + allocate(this%fates_litter_flux(begc:endc)); this%fates_litter_flux(:) = nan + end if + if(use_soil_matrixcn)then end if diff --git a/src/soilbiogeochem/SoilBiogeochemCarbonStateType.F90 b/src/soilbiogeochem/SoilBiogeochemCarbonStateType.F90 index 349a6c140d..349f70b46f 100644 --- a/src/soilbiogeochem/SoilBiogeochemCarbonStateType.F90 +++ b/src/soilbiogeochem/SoilBiogeochemCarbonStateType.F90 @@ -1154,7 +1154,6 @@ subroutine Summary(this, bounds, num_soilc, filter_soilc, cnveg_carbonstate_inst this%totsomc_col(c) + & this%ctrunc_col(c) + & totvegc_col - end do diff --git a/src/soilbiogeochem/SoilBiogeochemNitrogenFluxType.F90 b/src/soilbiogeochem/SoilBiogeochemNitrogenFluxType.F90 index 839f69379a..90ba4512c7 100644 --- a/src/soilbiogeochem/SoilBiogeochemNitrogenFluxType.F90 +++ b/src/soilbiogeochem/SoilBiogeochemNitrogenFluxType.F90 @@ -7,7 +7,7 @@ module SoilBiogeochemNitrogenFluxType use clm_varpar , only : nlevdecomp_full, nlevdecomp use clm_varcon , only : spval, ispval, dzsoi_decomp use decompMod , only : bounds_type - use clm_varctl , only : use_nitrif_denitrif, use_crop + use clm_varctl , only : use_nitrif_denitrif, use_crop, use_fates use CNSharedParamsMod , only : use_fun use SoilBiogeochemDecompCascadeConType , only : decomp_cascade_con, use_soil_matrixcn use abortutils , only : endrun @@ -127,8 +127,8 @@ module SoilBiogeochemNitrogenFluxType ! all n pools involved in decomposition real(r8), pointer :: decomp_npools_sourcesink_col (:,:,:) ! col (gN/m3) change in decomposing n pools ! (sum of all additions and subtractions from stateupdate1). - real(r8), pointer :: sminn_to_plant_fun_vr_col (:,:) ! col total layer soil N uptake of FUN (gN/m2/s) - + real(r8), pointer :: sminn_to_plant_fun_vr_col (:,:) ! col total layer soil N uptake of FUN (gN/m2/s) + real(r8), pointer :: fates_litter_flux (:) ! (gN/m2/s) Litter flux passed in from FATES ! track tradiagonal matrix contains @@ -274,6 +274,10 @@ subroutine InitAllocate(this, bounds) allocate(this%decomp_npools_sourcesink_col (begc:endc,1:nlevdecomp_full,1:ndecomp_pools)) this%decomp_npools_sourcesink_col (:,:,:) = nan + if(use_fates)then + allocate(this%fates_litter_flux(begc:endc)); this%fates_litter_flux(:) = nan + end if + ! Allocate soil Matrix setug if(use_soil_matrixcn)then end if diff --git a/src/utils/clmfates_interfaceMod.F90 b/src/utils/clmfates_interfaceMod.F90 index e6a3f611ad..0ac24f897c 100644 --- a/src/utils/clmfates_interfaceMod.F90 +++ b/src/utils/clmfates_interfaceMod.F90 @@ -81,6 +81,8 @@ module CLMFatesInterfaceMod use SolarAbsorbedType , only : solarabs_type use SoilBiogeochemCarbonFluxType, only : soilbiogeochem_carbonflux_type use SoilBiogeochemCarbonStateType, only : soilbiogeochem_carbonstate_type + use SoilBiogeochemNitrogenFluxType, only : soilbiogeochem_nitrogenflux_type + use SoilBiogeochemNitrogenStateType, only : soilbiogeochem_nitrogenstate_type use FrictionVelocityMod , only : frictionvel_type use clm_time_manager , only : is_restart, is_first_restart_step use ncdio_pio , only : file_desc_t, ncd_int, ncd_double @@ -226,6 +228,7 @@ module CLMFatesInterfaceMod procedure, public :: WrapUpdateFatesRmean procedure, public :: wrap_WoodProducts procedure, public :: UpdateCLitterFluxes + procedure, public :: UPdateNLitterFluxes end type hlm_fates_interface_type ! hlm_bounds_to_fates_bounds is not currently called outside the interface. @@ -1065,6 +1068,79 @@ end subroutine dynamics_driv ! =============================================================================== + subroutine UpdateNLitterFluxes(this,soilbiogeochem_nitrogenflux_inst,ci,c) + + use clm_varpar, only : i_met_lit + + class(hlm_fates_interface_type), intent(inout) :: this + type(soilbiogeochem_nitrogenflux_type) , intent(inout) :: soilbiogeochem_nitrogenflux_inst + integer , intent(in) :: ci ! clump index + integer , intent(in) :: c ! column index + + integer :: s ! site index + real(r8) :: dtime + integer :: i_lig_lit, i_cel_lit ! indices for lignan and cellulose + + dtime = get_step_size_real() + s = this%f2hmap(ci)%hsites(c) + + associate(nf_soil => soilbiogeochem_nitrogenflux_inst) + + nf_soil%decomp_npools_sourcesink_col(c,:,:) = 0._r8 + + if ( .not. use_fates_sp ) then + + ! (gC/m3/timestep) + !nf_soil%decomp_npools_sourcesink_col(c,1:nlevdecomp,i_met_lit) = & + ! nf_soil%decomp_npools_sourcesink_col(c,1:nlevdecomp,i_met_lit) + & + ! this%fates(ci)%bc_out(s)%litt_flux_lab_n_si(1:nlevdecomp)*dtime + + ! Used for mass balance checking (gC/m2/s) + !nf_soil%fates_litter_flux(c) = sum(this%fates(ci)%bc_out(s)%litt_flux_lab_n_si(1:nlevdecomp) * & + ! this%fates(ci)%bc_in(s)%dz_decomp_sisl(1:nlevdecomp)) + + i_cel_lit = i_met_lit + 1 + + !nf_soil%decomp_npools_sourcesink_col(c,1:nlevdecomp,i_cel_lit) = & + ! nf_soil%decomp_npools_sourcesink_col(c,1:nlevdecomp,i_cel_lit) + & + ! this%fates(ci)%bc_out(s)%litt_flux_cel_n_si(1:nlevdecomp)*dtime + + !nf_soil%fates_litter_flux(c) = nf_soil%fates_litter_flux(c) + & + ! sum(this%fates(ci)%bc_out(s)%litt_flux_cel_n_si(1:nlevdecomp) * & + ! this%fates(ci)%bc_in(s)%dz_decomp_sisl(1:nlevdecomp)) + + if (decomp_method == mimics_decomp) then + ! Mimics has a structural pool, which is cellulose and lignan + i_lig_lit = i_cel_lit + elseif(decomp_method == century_decomp ) then + ! CENTURY has a separate lignan pool from cellulose + i_lig_lit = i_cel_lit + 1 + end if + + !nf_soil%decomp_npools_sourcesink_col(c,1:nlevdecomp,i_lig_lit) = & + ! nf_soil%decomp_npools_sourcesink_col(c,1:nlevdecomp,i_lig_lit) + & + ! this%fates(ci)%bc_out(s)%litt_flux_lig_n_si(1:nlevdecomp)*dtime + + !nf_soil%fates_litter_flux(c) = nf_soil%fates_litter_flux(c) + & + ! sum(this%fates(ci)%bc_out(s)%litt_flux_lig_n_si(1:nlevdecomp) * & + ! this%fates(ci)%bc_in(s)%dz_decomp_sisl(1:nlevdecomp)) + + nf_soil%fates_litter_flux = 0._r8 + + else + + ! In SP mode their is no mass flux between the two + nf_soil%fates_litter_flux = 0._r8 + + end if + + end associate + + return + end subroutine UpdateNLitterFluxes + + ! =========================================================== + subroutine UpdateCLitterFluxes(this,soilbiogeochem_carbonflux_inst,ci,c) use clm_varpar, only : i_met_lit @@ -1073,7 +1149,7 @@ subroutine UpdateCLitterFluxes(this,soilbiogeochem_carbonflux_inst,ci,c) type(soilbiogeochem_carbonflux_type) , intent(inout) :: soilbiogeochem_carbonflux_inst integer , intent(in) :: ci ! clump index integer , intent(in) :: c ! column index - + integer :: s ! site index real(r8) :: dtime integer :: i_lig_lit, i_cel_lit ! indices for lignan and cellulose @@ -1083,17 +1159,28 @@ subroutine UpdateCLitterFluxes(this,soilbiogeochem_carbonflux_inst,ci,c) associate(cf_soil => soilbiogeochem_carbonflux_inst) + cf_soil%decomp_cpools_sourcesink_col(c,:,:) = 0._r8 + if ( .not. use_fates_sp ) then + ! (gC/m3/timestep) cf_soil%decomp_cpools_sourcesink_col(c,1:nlevdecomp,i_met_lit) = & cf_soil%decomp_cpools_sourcesink_col(c,1:nlevdecomp,i_met_lit) + & - this%fates(ci)%bc_out(s)%litt_flux_lab_c_si(1:nlevdecomp) * dtime + this%fates(ci)%bc_out(s)%litt_flux_lab_c_si(1:nlevdecomp)*dtime + ! Used for mass balance checking (gC/m2/s) + cf_soil%fates_litter_flux(c) = sum(this%fates(ci)%bc_out(s)%litt_flux_lab_c_si(1:nlevdecomp) * & + this%fates(ci)%bc_in(s)%dz_decomp_sisl(1:nlevdecomp)) + i_cel_lit = i_met_lit + 1 cf_soil%decomp_cpools_sourcesink_col(c,1:nlevdecomp,i_cel_lit) = & cf_soil%decomp_cpools_sourcesink_col(c,1:nlevdecomp,i_cel_lit) + & - this%fates(ci)%bc_out(s)%litt_flux_cel_c_si(1:nlevdecomp)* dtime + this%fates(ci)%bc_out(s)%litt_flux_cel_c_si(1:nlevdecomp)*dtime + + cf_soil%fates_litter_flux(c) = cf_soil%fates_litter_flux(c) + & + sum(this%fates(ci)%bc_out(s)%litt_flux_cel_c_si(1:nlevdecomp) * & + this%fates(ci)%bc_in(s)%dz_decomp_sisl(1:nlevdecomp)) if (decomp_method == mimics_decomp) then ! Mimics has a structural pool, which is cellulose and lignan @@ -1105,11 +1192,16 @@ subroutine UpdateCLitterFluxes(this,soilbiogeochem_carbonflux_inst,ci,c) cf_soil%decomp_cpools_sourcesink_col(c,1:nlevdecomp,i_lig_lit) = & cf_soil%decomp_cpools_sourcesink_col(c,1:nlevdecomp,i_lig_lit) + & - this%fates(ci)%bc_out(s)%litt_flux_lig_c_si(1:nlevdecomp) * dtime - + this%fates(ci)%bc_out(s)%litt_flux_lig_c_si(1:nlevdecomp)*dtime + + cf_soil%fates_litter_flux(c) = cf_soil%fates_litter_flux(c) + & + sum(this%fates(ci)%bc_out(s)%litt_flux_lig_c_si(1:nlevdecomp) * & + this%fates(ci)%bc_in(s)%dz_decomp_sisl(1:nlevdecomp)) + else ! In SP mode their is no mass flux between the two - cf_soil%decomp_cpools_sourcesink_col(c,:,:) = 0._r8 + + cf_soil%fates_litter_flux = 0._r8 end if ! This is a diagnostic for carbon accounting (NOT IN CLM, ONLY ELM) From cb4f5101408a79fc95fe072850996774db507ede Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Thu, 2 Mar 2023 17:24:43 -0500 Subject: [PATCH 055/257] Added suppln to fates cases --- bld/CLMBuildNamelist.pm | 9 +++++++-- bld/namelist_files/namelist_defaults_ctsm.xml | 2 +- 2 files changed, 8 insertions(+), 3 deletions(-) diff --git a/bld/CLMBuildNamelist.pm b/bld/CLMBuildNamelist.pm index f046172f7e..5b77996fb0 100755 --- a/bld/CLMBuildNamelist.pm +++ b/bld/CLMBuildNamelist.pm @@ -2892,20 +2892,25 @@ sub setup_logic_supplemental_nitrogen { 'suplnitro', 'use_cn'=>$nl_flags->{'use_cn'}, 'use_crop'=>$nl_flags->{'use_crop'}); } + if ( $nl_flags->{'bgc_mode'} ne "sp" && $nl_flags->{'bgc_mode'} eq "fates" ) { + add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, + 'suplnitro', 'use_fates'=>$nl_flags->{'use_fates'}); + } + # # Error checking for suplnitro # my $suplnitro = $nl->get_value('suplnitro'); if ( defined($suplnitro) ) { if ( $nl_flags->{'bgc_mode'} eq "sp" ) { - $log->fatal_error("supplemental Nitrogen (suplnitro) is set, but neither CN nor CNDV is active!"); + $log->fatal_error("supplemental Nitrogen (suplnitro) is set, but neither CN nor CNDV nor FATES is active!"); } if ( ! &value_is_true($nl_flags->{'use_crop'}) && $suplnitro =~ /PROG_CROP_ONLY/i ) { $log->fatal_error("supplemental Nitrogen is set to run over prognostic crops, but prognostic crop is NOT active!"); } if ( $suplnitro =~ /ALL/i ) { - if ( $nl_flags->{'bgc_spinup'} eq "on" ) { + if ( $nl_flags->{'bgc_spinup'} eq "on" && $nl_flags->{'bgc_mode'} ne "fates" ) { $log->warning("There is no need to use a bgc_spinup mode when supplemental Nitrogen is on for all PFT's, as these modes spinup Nitrogen" ); } } diff --git a/bld/namelist_files/namelist_defaults_ctsm.xml b/bld/namelist_files/namelist_defaults_ctsm.xml index 41103b5259..ae5bd97937 100644 --- a/bld/namelist_files/namelist_defaults_ctsm.xml +++ b/bld/namelist_files/namelist_defaults_ctsm.xml @@ -146,7 +146,7 @@ attributes from the config_cache.xml file (with keys converted to upper-case). NONE -NONE +ALL 0.50,0.30 From 782b89469f1488dc00142400c055f40872317c0a Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Mon, 6 Mar 2023 10:08:11 -0500 Subject: [PATCH 056/257] added vertical profile code to the fates bgc call sequence --- src/main/clm_driver.F90 | 2 +- .../SoilBiogeochemVerticalProfileMod.F90 | 42 +++++++++++++------ 2 files changed, 31 insertions(+), 13 deletions(-) diff --git a/src/main/clm_driver.F90 b/src/main/clm_driver.F90 index d035b8cda3..1c074c7dc1 100644 --- a/src/main/clm_driver.F90 +++ b/src/main/clm_driver.F90 @@ -288,7 +288,7 @@ subroutine clm_drv(doalb, nextsw_cday, declinp1, declin, rstwr, nlend, rdate, ro call active_layer_inst%alt_calc(filter_inactive_and_active(nc)%num_soilc, filter_inactive_and_active(nc)%soilc, & temperature_inst) - if (use_cn .and. decomp_method /= no_soil_decomp) then + if ((use_cn .or. use_fates) .and. decomp_method /= no_soil_decomp) then call SoilBiogeochemVerticalProfile(bounds_clump , & filter_inactive_and_active(nc)%num_soilc, filter_inactive_and_active(nc)%soilc , & filter_inactive_and_active(nc)%num_soilp, filter_inactive_and_active(nc)%soilp , & diff --git a/src/soilbiogeochem/SoilBiogeochemVerticalProfileMod.F90 b/src/soilbiogeochem/SoilBiogeochemVerticalProfileMod.F90 index 7209bd8278..1bad47af31 100644 --- a/src/soilbiogeochem/SoilBiogeochemVerticalProfileMod.F90 +++ b/src/soilbiogeochem/SoilBiogeochemVerticalProfileMod.F90 @@ -193,20 +193,38 @@ subroutine SoilBiogeochemVerticalProfile(bounds, num_soilc,filter_soilc,num_soil c = filter_soilc(fc) rootfr_tot = 0._r8 surface_prof_tot = 0._r8 - ! redo column ntegration over active layer for column-native profiles - do j = 1, min(max(altmax_lastyear_indx(c), 1), nlevdecomp) - rootfr_tot = rootfr_tot + col_cinput_rootfr(c,j) * dzsoi_decomp(j) - surface_prof_tot = surface_prof_tot + surface_prof(j) * dzsoi_decomp(j) - end do - if ( (altmax_lastyear_indx(c) > 0) .and. (rootfr_tot > 0._r8) .and. (surface_prof_tot > 0._r8) ) then - do j = 1, min(max(altmax_lastyear_indx(c), 1), nlevdecomp) - nfixation_prof(c,j) = col_cinput_rootfr(c,j) / rootfr_tot - ndep_prof(c,j) = surface_prof(j)/ surface_prof_tot + if(col%is_fates(c))then + ! For FATES, we just use the e-folding depth for both fixation and deposition + ! partially because the fixation may be free-living depending on FATES-side + ! fixation choices, and partially for simplicity + do j = 1, min(max(altmax_lastyear_indx(c), 1), nlevdecomp) + surface_prof_tot = surface_prof_tot + surface_prof(j) * dzsoi_decomp(j) end do + if ( (altmax_lastyear_indx(c) > 0) .and. (surface_prof_tot > 0._r8) ) then + do j = 1, min(max(altmax_lastyear_indx(c), 1), nlevdecomp) + nfixation_prof(c,j) = surface_prof(j)/ surface_prof_tot + ndep_prof(c,j) = surface_prof(j)/ surface_prof_tot + end do + else + nfixation_prof(c,1) = 1./dzsoi_decomp(1) + ndep_prof(c,1) = 1./dzsoi_decomp(1) + endif else - nfixation_prof(c,1) = 1./dzsoi_decomp(1) - ndep_prof(c,1) = 1./dzsoi_decomp(1) - endif + ! redo column ntegration over active layer for column-native profiles + do j = 1, min(max(altmax_lastyear_indx(c), 1), nlevdecomp) + rootfr_tot = rootfr_tot + col_cinput_rootfr(c,j) * dzsoi_decomp(j) + surface_prof_tot = surface_prof_tot + surface_prof(j) * dzsoi_decomp(j) + end do + if ( (altmax_lastyear_indx(c) > 0) .and. (rootfr_tot > 0._r8) .and. (surface_prof_tot > 0._r8) ) then + do j = 1, min(max(altmax_lastyear_indx(c), 1), nlevdecomp) + nfixation_prof(c,j) = col_cinput_rootfr(c,j) / rootfr_tot + ndep_prof(c,j) = surface_prof(j)/ surface_prof_tot + end do + else + nfixation_prof(c,1) = 1./dzsoi_decomp(1) + ndep_prof(c,1) = 1./dzsoi_decomp(1) + endif + end if end do ! check to make sure integral of all profiles = 1. From 47722043b74214a44bdebf6a6f78f1f4e7844794 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Mon, 6 Mar 2023 17:13:36 -0500 Subject: [PATCH 057/257] minor changes ot clmbuildnamelist --- bld/CLMBuildNamelist.pm | 12 +++++++----- 1 file changed, 7 insertions(+), 5 deletions(-) diff --git a/bld/CLMBuildNamelist.pm b/bld/CLMBuildNamelist.pm index 5b77996fb0..071773958d 100755 --- a/bld/CLMBuildNamelist.pm +++ b/bld/CLMBuildNamelist.pm @@ -91,11 +91,13 @@ OPTIONS This toggles off the namelist variable: use_cn bgc = Carbon Nitrogen with methane, nitrification, vertical soil C, CENTURY or MIMICS decomposition - This toggles on the namelist variables: + This toggles on the namelist variables: use_cn, use_lch4, use_nitrif_denitrif - fates = FATES/Ecosystem Demography with below ground BGC - This toggles on the namelist variables: - use_fates + fates = FATES/Ecosystem Demography with below ground BGC + CENTURY or MIMICS decomposition + This toggles on the namelist variables: + use_fates. use_lch4 and use_nitrif_denitrif are optional + (Only for CLM4.5/CLM5.0) -[no-]chk_res Also check [do NOT check] to make sure the resolution and land-mask is valid. @@ -757,7 +759,7 @@ sub setup_cmdl_fates_mode { # The following variables may be set by the user and are compatible with use_fates # no need to set defaults, covered in a different routine - my @list = ( "use_lch4" ); + my @list = ( "use_lch4", "use_nitrif_denitrif" ); foreach my $var ( @list ) { if ( defined($nl->get_value($var)) ) { $nl_flags->{$var} = $nl->get_value($var); From 12e6b116b1b2c9589e7c343f19cea61a348334c0 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Thu, 9 Mar 2023 12:05:52 -0500 Subject: [PATCH 058/257] Removed various if-clauses that prevented BGC calls and initializations from proceeding with FATES on --- src/biogeochem/CNDriverMod.F90 | 12 ++++---- src/main/clm_driver.F90 | 6 ++-- src/main/clm_initializeMod.F90 | 8 +++-- src/main/clm_instMod.F90 | 7 ++--- src/main/controlMod.F90 | 7 +++-- .../SoilBiogeochemCarbonStateType.F90 | 2 +- .../SoilBiogeochemCompetitionMod.F90 | 8 ++--- .../SoilBiogeochemDecompMod.F90 | 29 ++----------------- .../SoilBiogeochemLittVertTranspMod.F90 | 5 +--- .../SoilBiogeochemNitrifDenitrifMod.F90 | 3 +- .../SoilBiogeochemPotentialMod.F90 | 19 ++---------- .../SoilBiogeochemVerticalProfileMod.F90 | 26 +++++++++-------- 12 files changed, 50 insertions(+), 82 deletions(-) diff --git a/src/biogeochem/CNDriverMod.F90 b/src/biogeochem/CNDriverMod.F90 index f353469738..d2b9ed9655 100644 --- a/src/biogeochem/CNDriverMod.F90 +++ b/src/biogeochem/CNDriverMod.F90 @@ -77,9 +77,10 @@ subroutine CNDriverInit(bounds, NLFilename, cnfire_method) class(fire_method_type) , intent(inout) :: cnfire_method !----------------------------------------------------------------------- call SoilBiogeochemCompetitionInit(bounds) - call CNPhenologyInit(bounds) - call cnfire_method%FireInit(bounds, NLFilename) - + if(use_cn)then + call CNPhenologyInit(bounds) + call cnfire_method%FireInit(bounds, NLFilename) + end if end subroutine CNDriverInit !----------------------------------------------------------------------- @@ -240,9 +241,8 @@ subroutine CNDriverNoLeaching(bounds, ! -------------------------------------------------- ! zero the column-level C and N fluxes ! -------------------------------------------------- - - call t_startf('CNZero') + call t_startf('CNZero') ! COMPILER_BUG(wjs, 2014-11-29, pgi 14.7) Without this, the filter is full of garbage ! in some situations call t_startf('CNZero-soilbgc-cflux') @@ -293,7 +293,7 @@ subroutine CNDriverNoLeaching(bounds, call t_stopf('CNZero-soilbgc-nflux') call t_stopf('CNZero') - + ! -------------------------------------------------- ! Nitrogen Deposition, Fixation and Respiration ! -------------------------------------------------- diff --git a/src/main/clm_driver.F90 b/src/main/clm_driver.F90 index 1c074c7dc1..ce0627df2b 100644 --- a/src/main/clm_driver.F90 +++ b/src/main/clm_driver.F90 @@ -204,7 +204,7 @@ subroutine clm_drv(doalb, nextsw_cday, declinp1, declin, rstwr, nlend, rdate, ro ! ======================================================================== need_glacier_initialization = is_first_step() - + if (need_glacier_initialization) then !$OMP PARALLEL DO PRIVATE (nc, bounds_clump) do nc = 1, nclumps @@ -290,8 +290,8 @@ subroutine clm_drv(doalb, nextsw_cday, declinp1, declin, rstwr, nlend, rdate, ro if ((use_cn .or. use_fates) .and. decomp_method /= no_soil_decomp) then call SoilBiogeochemVerticalProfile(bounds_clump , & - filter_inactive_and_active(nc)%num_soilc, filter_inactive_and_active(nc)%soilc , & - filter_inactive_and_active(nc)%num_soilp, filter_inactive_and_active(nc)%soilp , & + filter_inactive_and_active(nc)%num_bgc_soilc, filter_inactive_and_active(nc)%bgc_soilc , & + filter_inactive_and_active(nc)%num_bgc_vegp, filter_inactive_and_active(nc)%bgc_vegp , & active_layer_inst, soilstate_inst, soilbiogeochem_state_inst) end if diff --git a/src/main/clm_initializeMod.F90 b/src/main/clm_initializeMod.F90 index 7988fbfc7b..1178470b77 100644 --- a/src/main/clm_initializeMod.F90 +++ b/src/main/clm_initializeMod.F90 @@ -429,8 +429,11 @@ subroutine initialize2(ni,nj) !$OMP END PARALLEL DO ! Initialize modules (after time-manager initialization in most cases) - if (use_cn) then + if (use_cn .or. use_fates) then call bgc_vegetation_inst%Init2(bounds_proc, NLFilename) + end if + + if (use_cn) then ! NOTE(wjs, 2016-02-23) Maybe the rest of the body of this conditional should also ! be moved into bgc_vegetation_inst%Init2 @@ -622,6 +625,7 @@ subroutine initialize2(ni,nj) !$OMP END PARALLEL DO ! Initialize nitrogen deposition + ! RGK: To-do, enable N deposition in FATES if (use_cn) then call t_startf('init_ndep') if (.not. ndep_from_cpl) then @@ -630,7 +634,7 @@ subroutine initialize2(ni,nj) end if call t_stopf('init_ndep') end if - + ! Initialize active history fields. ! This is only done if not a restart run. If a restart run, then this ! information has already been obtained from the restart data read above. diff --git a/src/main/clm_instMod.F90 b/src/main/clm_instMod.F90 index 7924c2111e..33faa1e993 100644 --- a/src/main/clm_instMod.F90 +++ b/src/main/clm_instMod.F90 @@ -231,7 +231,6 @@ subroutine clm_instInit(bounds) allocate (h2osno_col(begc:endc)) allocate (snow_depth_col(begc:endc)) - ! snow water do c = begc,endc l = col%landunit(c) @@ -371,7 +370,7 @@ subroutine clm_instInit(bounds) call drydepvel_inst%Init(bounds) - if (decomp_method /= no_soil_decomp) then + if_decomp: if (decomp_method /= no_soil_decomp) then ! Initialize soilbiogeochem_state_inst @@ -423,7 +422,7 @@ subroutine clm_instInit(bounds) call SoilBiogeochemPrecisionControlInit( soilbiogeochem_carbonstate_inst, c13_soilbiogeochem_carbonstate_inst, & c14_soilbiogeochem_carbonstate_inst, soilbiogeochem_nitrogenstate_inst) - end if ! end of if use_cn + end if if_decomp ! Note - always call Init for bgc_vegetation_inst: some pieces need to be initialized always call bgc_vegetation_inst%Init(bounds, nlfilename, GetBalanceCheckSkipSteps(), params_ncid ) @@ -550,7 +549,7 @@ subroutine clm_instRest(bounds, ncid, flag, writing_finidat_interp_dest_file) call ch4_inst%restart(bounds, ncid, flag=flag) end if - if ( use_cn ) then + if ( use_cn .or. use_fates) then ! Need to do vegetation restart before soil bgc restart to get totvegc_col for purpose ! of resetting soil carbon at exit spinup when no vegetation is growing. call bgc_vegetation_inst%restart(bounds, ncid, flag=flag) diff --git a/src/main/controlMod.F90 b/src/main/controlMod.F90 index a763703d6e..4a6929c28e 100644 --- a/src/main/controlMod.F90 +++ b/src/main/controlMod.F90 @@ -535,9 +535,12 @@ subroutine control_init(dtime) end if call soilHydReadNML( NLFilename ) + + if( use_cn .or. use_fates) then + call CNPrecisionControlReadNML( NLFilename ) + end if if ( use_cn ) then call CNFireReadNML( NLFilename ) - call CNPrecisionControlReadNML( NLFilename ) call CNNDynamicsReadNML ( NLFilename ) call CNPhenologyReadNML ( NLFilename ) end if @@ -761,7 +764,7 @@ subroutine control_spmd() ! C and N input vertical profiles call mpi_bcast (surfprof_exp, 1, MPI_REAL8, 0, mpicom, ier) end if - + if ((use_cn.or.use_fates) .and. use_nitrif_denitrif) then call mpi_bcast (no_frozen_nitrif_denitrif, 1, MPI_LOGICAL, 0, mpicom, ier) end if diff --git a/src/soilbiogeochem/SoilBiogeochemCarbonStateType.F90 b/src/soilbiogeochem/SoilBiogeochemCarbonStateType.F90 index 349f70b46f..6c52a5d34f 100644 --- a/src/soilbiogeochem/SoilBiogeochemCarbonStateType.F90 +++ b/src/soilbiogeochem/SoilBiogeochemCarbonStateType.F90 @@ -7,7 +7,7 @@ module SoilBiogeochemCarbonStateType use clm_varpar , only : ndecomp_cascade_transitions, ndecomp_pools, nlevcan use clm_varpar , only : nlevdecomp_full, nlevdecomp, nlevsoi use clm_varcon , only : spval, ispval, dzsoi_decomp, zisoi, zsoi, c3_r2 - use clm_varctl , only : iulog, spinup_state, use_fates + use clm_varctl , only : iulog, spinup_state use landunit_varcon , only : istcrop, istsoil use abortutils , only : endrun use spmdMod , only : masterproc diff --git a/src/soilbiogeochem/SoilBiogeochemCompetitionMod.F90 b/src/soilbiogeochem/SoilBiogeochemCompetitionMod.F90 index eec9e00f80..9035b32484 100644 --- a/src/soilbiogeochem/SoilBiogeochemCompetitionMod.F90 +++ b/src/soilbiogeochem/SoilBiogeochemCompetitionMod.F90 @@ -293,7 +293,7 @@ subroutine SoilBiogeochemCompetition (bounds, num_soilc, filter_soilc,num_soilp, local_use_fun = use_fun - if (.not. use_nitrif_denitrif) then + if_nitrif: if (.not. use_nitrif_denitrif) then ! init sminn_tot do fc=1,num_soilc @@ -630,8 +630,6 @@ subroutine SoilBiogeochemCompetition (bounds, num_soilc, filter_soilc,num_soilp, sum_no3_demand_scaled(c,j) = (plant_ndemand(c)*nuptake_prof(c,j))*compet_plant_no3 + & (potential_immob_vr(c,j)-actual_immob_nh4_vr(c,j))*compet_decomp_no3 + pot_f_denit_vr(c,j)*compet_denit endif - - if (sum_no3_demand(c,j)*dt < smin_no3_vr(c,j)) then @@ -655,7 +653,7 @@ subroutine SoilBiogeochemCompetition (bounds, num_soilc, filter_soilc,num_soilp, smin_no3_to_plant_vr(c,j) = smin_no3_vr(c,j)/dt - actual_immob_no3_vr(c,j) - f_denit_vr(c,j) end if endif - + else ! NO3 availability can not satisfy the sum of immobilization, denitrification, and @@ -993,7 +991,7 @@ subroutine SoilBiogeochemCompetition (bounds, num_soilc, filter_soilc,num_soilp, end if end do ! end of column loops - end if !end of if_not_use_nitrif_denitrif + end if if_nitrif !end of if_not_use_nitrif_denitrif end associate diff --git a/src/soilbiogeochem/SoilBiogeochemDecompMod.F90 b/src/soilbiogeochem/SoilBiogeochemDecompMod.F90 index a46f999143..77d4a40ed9 100644 --- a/src/soilbiogeochem/SoilBiogeochemDecompMod.F90 +++ b/src/soilbiogeochem/SoilBiogeochemDecompMod.F90 @@ -11,7 +11,7 @@ module SoilBiogeochemDecompMod use shr_log_mod , only : errMsg => shr_log_errMsg use decompMod , only : bounds_type use clm_varpar , only : nlevdecomp, ndecomp_cascade_transitions, ndecomp_pools - use clm_varctl , only : use_nitrif_denitrif, use_lch4, use_fates, iulog + use clm_varctl , only : use_nitrif_denitrif, use_lch4, iulog use clm_varcon , only : dzsoi_decomp use SoilBiogeochemDecompCascadeConType , only : decomp_cascade_con, mimics_decomp, decomp_method, use_soil_matrixcn use SoilBiogeochemStateType , only : soilbiogeochem_state_type @@ -137,7 +137,6 @@ subroutine SoilBiogeochemDecomp (bounds, num_soilc, filter_soilc, ! column loop to calculate actual immobilization and decomp rates, following ! resolution of plant/heterotroph competition for mineral N - if ( .not. use_fates) then ! calculate c:n ratios of applicable pools do l = 1, ndecomp_pools if ( floating_cn_ratio_decomp_pools(l) ) then @@ -221,25 +220,8 @@ subroutine SoilBiogeochemDecomp (bounds, num_soilc, filter_soilc, end do end do end do - else - do k = 1, ndecomp_cascade_transitions - do j = 1,nlevdecomp - do fc = 1,num_soilc - c = filter_soilc(fc) - ! - decomp_cascade_hr_vr(c,j,k) = rf_decomp_cascade(c,j,k) * p_decomp_cpool_loss(c,j,k) - decomp_cascade_ctransfer_vr(c,j,k) = (1._r8 - rf_decomp_cascade(c,j,k)) * p_decomp_cpool_loss(c,j,k) - if (decomp_method == mimics_decomp) then - decomp_cascade_hr_vr(c,j,k) = min( & - p_decomp_cpool_loss(c,j,k), & - decomp_cascade_hr_vr(c,j,k) + c_overflow_vr(c,j,k)) - decomp_cascade_ctransfer_vr(c,j,k) = max(0.0_r8, p_decomp_cpool_loss(c,j,k) - decomp_cascade_hr_vr(c,j,k)) - end if - ! - end do - end do - end do - end if + + if (use_lch4) then ! Calculate total fraction of potential HR, for methane code @@ -279,13 +261,8 @@ subroutine SoilBiogeochemDecomp (bounds, num_soilc, filter_soilc, do fc = 1,num_soilc c = filter_soilc(fc) do j = 1,nlevdecomp - if(.not.use_fates)then net_nmin(c) = net_nmin(c) + net_nmin_vr(c,j) * dzsoi_decomp(j) gross_nmin(c) = gross_nmin(c) + gross_nmin_vr(c,j) * dzsoi_decomp(j) - ! else - ! net_nmin(c) = 0.0_r8 - ! gross_nmin(c) = 0.0_r8 - endif end do end do diff --git a/src/soilbiogeochem/SoilBiogeochemLittVertTranspMod.F90 b/src/soilbiogeochem/SoilBiogeochemLittVertTranspMod.F90 index 616f995bd7..58e05fb3e1 100644 --- a/src/soilbiogeochem/SoilBiogeochemLittVertTranspMod.F90 +++ b/src/soilbiogeochem/SoilBiogeochemLittVertTranspMod.F90 @@ -182,9 +182,6 @@ subroutine SoilBiogeochemLittVertTransp(bounds, num_soilc, filter_soilc, & if ( use_c14 ) then ntype = ntype+1 endif - if ( use_fates ) then - ntype = 1 - endif spinup_term = 1._r8 epsilon = 1.e-30 @@ -247,7 +244,7 @@ subroutine SoilBiogeochemLittVertTransp(bounds, num_soilc, filter_soilc, & source => soilbiogeochem_carbonflux_inst%decomp_cpools_sourcesink_col trcr_tendency_ptr => soilbiogeochem_carbonflux_inst%decomp_cpools_transport_tendency_col case (2) ! N - if (use_cn ) then + if (use_cn .or. use_fates) then conc_ptr => soilbiogeochem_nitrogenstate_inst%decomp_npools_vr_col source => soilbiogeochem_nitrogenflux_inst%decomp_npools_sourcesink_col trcr_tendency_ptr => soilbiogeochem_nitrogenflux_inst%decomp_npools_transport_tendency_col diff --git a/src/soilbiogeochem/SoilBiogeochemNitrifDenitrifMod.F90 b/src/soilbiogeochem/SoilBiogeochemNitrifDenitrifMod.F90 index 3993439a1c..f735c14854 100644 --- a/src/soilbiogeochem/SoilBiogeochemNitrifDenitrifMod.F90 +++ b/src/soilbiogeochem/SoilBiogeochemNitrifDenitrifMod.F90 @@ -12,7 +12,7 @@ module SoilBiogeochemNitrifDenitrifMod use clm_varpar , only : nlevdecomp use clm_varcon , only : rpi, grav use clm_varcon , only : d_con_g, d_con_w, secspday - use clm_varctl , only : use_lch4, use_fates + use clm_varctl , only : use_lch4 use abortutils , only : endrun use decompMod , only : bounds_type use SoilStatetype , only : soilstate_type @@ -74,6 +74,7 @@ subroutine readParams ( ncid ) ! ! read in constants ! + tString='surface_tension_water' call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) diff --git a/src/soilbiogeochem/SoilBiogeochemPotentialMod.F90 b/src/soilbiogeochem/SoilBiogeochemPotentialMod.F90 index da46e178b7..beda04bbec 100644 --- a/src/soilbiogeochem/SoilBiogeochemPotentialMod.F90 +++ b/src/soilbiogeochem/SoilBiogeochemPotentialMod.F90 @@ -137,8 +137,8 @@ subroutine SoilBiogeochemPotential (bounds, num_soilc, filter_soilc, & decomp_k => soilbiogeochem_carbonflux_inst%decomp_k_col , & ! Input: [real(r8) (:,:,:) ] decomposition rate coefficient (1./sec) phr_vr => soilbiogeochem_carbonflux_inst%phr_vr_col & ! Output: [real(r8) (:,:) ] potential HR (gC/m3/s) ) - - if ( .not. use_fates ) then + + ! set initial values for potential C and N fluxes p_decomp_cpool_loss(begc:endc, :, :) = 0._r8 pmnf_decomp_cascade(begc:endc, :, :) = 0._r8 @@ -320,20 +320,6 @@ subroutine SoilBiogeochemPotential (bounds, num_soilc, filter_soilc, & potential_immob_vr(c,j) = immob(c,j) end do end do - else ! use_fates - ! As a first step we are making this a C-only model, so no N downregulation of fluxes. - do k = 1, ndecomp_cascade_transitions - do j = 1,nlevdecomp - do fc = 1,num_soilc - c = filter_soilc(fc) - ! - p_decomp_cpool_loss(c,j,k) = decomp_cpools_vr(c,j,cascade_donor_pool(k)) & - * decomp_k(c,j,cascade_donor_pool(k)) * pathfrac_decomp_cascade(c,j,k) - ! - end do - end do - end do - end if ! Add up potential hr for methane calculations do j = 1,nlevdecomp @@ -351,6 +337,7 @@ subroutine SoilBiogeochemPotential (bounds, num_soilc, filter_soilc, & end do end do + end associate end subroutine SoilBiogeochemPotential diff --git a/src/soilbiogeochem/SoilBiogeochemVerticalProfileMod.F90 b/src/soilbiogeochem/SoilBiogeochemVerticalProfileMod.F90 index 1bad47af31..772c2db82e 100644 --- a/src/soilbiogeochem/SoilBiogeochemVerticalProfileMod.F90 +++ b/src/soilbiogeochem/SoilBiogeochemVerticalProfileMod.F90 @@ -131,7 +131,6 @@ subroutine SoilBiogeochemVerticalProfile(bounds, num_soilc,filter_soilc,num_soil do j = 1, nlevdecomp cinput_rootfr(p,j) = crootfr(p,j) / dzsoi_decomp(j) end do - else cinput_rootfr(p,1) = 0. endif @@ -168,7 +167,6 @@ subroutine SoilBiogeochemVerticalProfile(bounds, num_soilc,filter_soilc,num_soil leaf_prof(p,1) = 1./dzsoi_decomp(1) stem_prof(p,1) = 1./dzsoi_decomp(1) endif - end do !! aggregate root profile to column @@ -176,17 +174,21 @@ subroutine SoilBiogeochemVerticalProfile(bounds, num_soilc,filter_soilc,num_soil ! cinput_rootfr(bounds%begp:bounds%endp, :), & ! col_cinput_rootfr(bounds%begc:bounds%endc, :), & ! 'unity') - do pi = 1,maxsoil_patches - do fc = 1,num_soilc - c = filter_soilc(fc) - if (pi <= col%npatches(c)) then - p = col%patchi(c) + pi - 1 - do j = 1,nlevdecomp - col_cinput_rootfr(c,j) = col_cinput_rootfr(c,j) + cinput_rootfr(p,j) * patch%wtcol(p) - end do - end if + if(num_soilp>0)then + do pi = 1,maxsoil_patches + do fc = 1,num_soilc + c = filter_soilc(fc) + if(.not.col%is_fates(c))then + if (pi <= col%npatches(c)) then + p = col%patchi(c) + pi - 1 + do j = 1,nlevdecomp + col_cinput_rootfr(c,j) = col_cinput_rootfr(c,j) + cinput_rootfr(p,j) * patch%wtcol(p) + end do + end if + end if + end do end do - end do + end if ! repeat for column-native profiles: Ndep and Nfix do fc = 1,num_soilc From 55392895ff67f734db393669c3f905d6242e2582 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Fri, 10 Mar 2023 12:34:52 -0500 Subject: [PATCH 059/257] FATES bgc work. Add use_fates_bgc, cleaned out some use_fates filtering, and added N deposition with FATES --- bld/CLMBuildNamelist.pm | 24 +++-- bld/namelist_files/namelist_defaults_ctsm.xml | 90 +++++++++---------- src/biogeochem/CNBalanceCheckMod.F90 | 4 +- src/biogeochem/CNCStateUpdate1Mod.F90 | 36 ++++---- src/biogeochem/CNDriverMod.F90 | 4 +- src/biogeochem/CNVegetationFacade.F90 | 61 +++++++------ src/biogeochem/ch4Mod.F90 | 8 +- src/main/clm_driver.F90 | 26 +++--- src/main/clm_initializeMod.F90 | 8 +- src/main/clm_instMod.F90 | 5 +- src/main/clm_varctl.F90 | 40 +++++---- src/main/controlMod.F90 | 18 +++- .../SoilBiogeochemDecompCascadeConType.F90 | 10 +-- .../SoilBiogeochemLittVertTranspMod.F90 | 10 +-- .../SoilBiogeochemPrecisionControlMod.F90 | 13 ++- .../SoilBiogeochemStateType.F90 | 50 ++++++----- 16 files changed, 214 insertions(+), 193 deletions(-) diff --git a/bld/CLMBuildNamelist.pm b/bld/CLMBuildNamelist.pm index 071773958d..88cc27e614 100755 --- a/bld/CLMBuildNamelist.pm +++ b/bld/CLMBuildNamelist.pm @@ -3395,23 +3395,21 @@ sub setup_logic_nitrogen_deposition { my ($opts, $nl_flags, $definition, $defaults, $nl) = @_; # - # Nitrogen deposition for bgc=CN + # Nitrogen deposition for bgc=CN or fates # - if ( $nl_flags->{'bgc_mode'} =~/bgc/ ) { + if ( ($nl_flags->{'bgc_mode'} =~/bgc/) or ($nl_flags->{'bgc_mode'} =~/fates/) ) { add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'ndepmapalgo', 'phys'=>$nl_flags->{'phys'}, - 'use_cn'=>$nl_flags->{'use_cn'}, 'hgrid'=>$nl_flags->{'res'}, + 'hgrid'=>$nl_flags->{'res'}, 'clm_accelerated_spinup'=>$nl_flags->{'clm_accelerated_spinup'} ); add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'ndep_taxmode', 'phys'=>$nl_flags->{'phys'}, - 'use_cn'=>$nl_flags->{'use_cn'}, - 'lnd_tuning_mode'=>$nl_flags->{'lnd_tuning_mode'} ); + 'lnd_tuning_mode'=>$nl_flags->{'lnd_tuning_mode'} ); add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'ndep_varlist', 'phys'=>$nl_flags->{'phys'}, - 'use_cn'=>$nl_flags->{'use_cn'}, - 'lnd_tuning_mode'=>$nl_flags->{'lnd_tuning_mode'} ); + 'lnd_tuning_mode'=>$nl_flags->{'lnd_tuning_mode'} ); add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'stream_year_first_ndep', 'phys'=>$nl_flags->{'phys'}, - 'use_cn'=>$nl_flags->{'use_cn'}, 'sim_year'=>$nl_flags->{'sim_year'}, + 'sim_year'=>$nl_flags->{'sim_year'}, 'sim_year_range'=>$nl_flags->{'sim_year_range'}); add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'stream_year_last_ndep', 'phys'=>$nl_flags->{'phys'}, - 'use_cn'=>$nl_flags->{'use_cn'}, 'sim_year'=>$nl_flags->{'sim_year'}, + 'sim_year'=>$nl_flags->{'sim_year'}, 'sim_year_range'=>$nl_flags->{'sim_year_range'}); # Set align year, if first and last years are different if ( $nl->get_value('stream_year_first_ndep') != $nl->get_value('stream_year_last_ndep') ) { @@ -3419,12 +3417,12 @@ sub setup_logic_nitrogen_deposition { 'sim_year_range'=>$nl_flags->{'sim_year_range'}); } add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'stream_fldfilename_ndep', 'phys'=>$nl_flags->{'phys'}, - 'use_cn'=>$nl_flags->{'use_cn'}, 'lnd_tuning_mode'=>$nl_flags->{'lnd_tuning_mode'}, + 'lnd_tuning_mode'=>$nl_flags->{'lnd_tuning_mode'}, 'hgrid'=>"0.9x1.25", 'ssp_rcp'=>$nl_flags->{'ssp_rcp'}, 'nofail'=>1 ); if ( ! defined($nl->get_value('stream_fldfilename_ndep') ) ) { # Also check at f19 resolution add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'stream_fldfilename_ndep', 'phys'=>$nl_flags->{'phys'}, - 'use_cn'=>$nl_flags->{'use_cn'}, 'lnd_tuning_mode'=>$nl_flags->{'lnd_tuning_mode'}, + 'lnd_tuning_mode'=>$nl_flags->{'lnd_tuning_mode'}, 'hgrid'=>"1.9x2.5", 'ssp_rcp'=>$nl_flags->{'ssp_rcp'}, 'nofail'=>1 ); # If not found report an error if ( ! defined($nl->get_value('stream_fldfilename_ndep') ) ) { @@ -3436,12 +3434,12 @@ sub setup_logic_nitrogen_deposition { } if ($opts->{'driver'} eq "nuopc" ) { add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'stream_meshfile_ndep', 'phys'=>$nl_flags->{'phys'}, - 'use_cn'=>$nl_flags->{'use_cn'}, 'lnd_tuning_mode'=>$nl_flags->{'lnd_tuning_mode'}, + 'lnd_tuning_mode'=>$nl_flags->{'lnd_tuning_mode'}, 'hgrid'=>"0.9x1.25", 'ssp_rcp'=>$nl_flags->{'ssp_rcp'}, 'nofail'=>1 ); if ( ! defined($nl->get_value('stream_fldfilename_ndep') ) ) { # Also check at f19 resolution add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'stream_meshfile_ndep', 'phys'=>$nl_flags->{'phys'}, - 'use_cn'=>$nl_flags->{'use_cn'}, 'lnd_tuning_mode'=>$nl_flags->{'lnd_tuning_mode'}, + 'lnd_tuning_mode'=>$nl_flags->{'lnd_tuning_mode'}, 'hgrid'=>"1.9x2.5", 'ssp_rcp'=>$nl_flags->{'ssp_rcp'}, 'nofail'=>1 ); # If not found report an error if ( ! defined($nl->get_value('stream_meshfile_ndep') ) ) { diff --git a/bld/namelist_files/namelist_defaults_ctsm.xml b/bld/namelist_files/namelist_defaults_ctsm.xml index ae5bd97937..9a31995c4f 100644 --- a/bld/namelist_files/namelist_defaults_ctsm.xml +++ b/bld/namelist_files/namelist_defaults_ctsm.xml @@ -1435,72 +1435,72 @@ lnd/clm2/surfdata_map/release-clm5.0.30/surfdata_ne0np4.CONUS.ne30x8_hist_78pfts lnd/clm2/snicardata/snicar_drdt_bst_fit_60_c070416.nc -2015 -2101 -2015 +2015 +2101 +2015 -2015 -2101 -2015 +2015 +2101 +2015 -2015 -2101 -2015 +2015 +2101 +2015 -2018 -2018 +2018 +2018 -2010 -2010 +2010 +2010 -2000 -2000 +2000 +2000 -1850 -1850 +1850 +1850 -2000 -2000 +2000 +2000 -2000 -2000 +2000 +2000 -2000 -2000 +2000 +2000 -lnd/clm2/ndepdata/fndep_clm_hist_b.e21.BWHIST.f09_g17.CMIP6-historical-WACCM.ensmean_1849-2015_monthly_0.9x1.25_c180926.nc -lnd/clm2/ndepdata/fndep_clm_hist_b.e21.BWHIST.f09_g17.CMIP6-historical-WACCM.ensmean_1849-2015_monthly_0.9x1.25_c180926.nc -lnd/clm2/ndepdata/fndep_clm_hist_b.e21.BWHIST.f09_g17.CMIP6-historical-WACCM.ensmean_1849-2015_monthly_0.9x1.25_c180926.nc +lnd/clm2/ndepdata/fndep_clm_hist_b.e21.BWHIST.f09_g17.CMIP6-historical-WACCM.ensmean_1849-2015_monthly_0.9x1.25_c180926.nc +lnd/clm2/ndepdata/fndep_clm_hist_b.e21.BWHIST.f09_g17.CMIP6-historical-WACCM.ensmean_1849-2015_monthly_0.9x1.25_c180926.nc +lnd/clm2/ndepdata/fndep_clm_hist_b.e21.BWHIST.f09_g17.CMIP6-historical-WACCM.ensmean_1849-2015_monthly_0.9x1.25_c180926.nc share/meshes/fv1.9x2.5_141008_ESMFmesh_c20191001.nc share/meshes/fv0.9x1.25_141008_polemod_ESMFmesh.nc -lnd/clm2/ndepdata/fndep_clm_f09_g17.CMIP6-SSP5-8.5-WACCM_1849-2101_monthly_c191007.nc -lnd/clm2/ndepdata/fndep_clm_f09_g17.CMIP6-SSP1-2.6-WACCM_1849-2101_monthly_c191007.nc -lnd/clm2/ndepdata/fndep_clm_f09_g17.CMIP6-SSP2-4.5-WACCM_1849-2101_monthly_c191007.nc -lnd/clm2/ndepdata/fndep_clm_SSP370_b.e21.BWSSP370cmip6.f09_g17.CMIP6-SSP3-7.0-WACCM.002_1849-2101_monthly_0.9x1.25_c211216.nc -lnd/clm2/ndepdata/fndep_clm_f09_g17.CMIP6-SSP5-8.5-WACCM_1849-2101_monthly_c191007.nc -lnd/clm2/ndepdata/fndep_clm_f09_g17.CMIP6-SSP1-2.6-WACCM_1849-2101_monthly_c191007.nc -lnd/clm2/ndepdata/fndep_clm_f09_g17.CMIP6-SSP2-4.5-WACCM_1849-2101_monthly_c191007.nc -lnd/clm2/ndepdata/fndep_clm_SSP370_b.e21.BWSSP370cmip6.f09_g17.CMIP6-SSP3-7.0-WACCM.002_1849-2101_monthly_0.9x1.25_c211216.nc -lnd/clm2/ndepdata/fndep_clm_f09_g17.CMIP6-SSP5-8.5-WACCM_1849-2101_monthly_c191007.nc -lnd/clm2/ndepdata/fndep_clm_f09_g17.CMIP6-SSP1-2.6-WACCM_1849-2101_monthly_c191007.nc -lnd/clm2/ndepdata/fndep_clm_f09_g17.CMIP6-SSP2-4.5-WACCM_1849-2101_monthly_c191007.nc -lnd/clm2/ndepdata/fndep_clm_SSP370_b.e21.BWSSP370cmip6.f09_g17.CMIP6-SSP3-7.0-WACCM.002_1849-2101_monthly_0.9x1.25_c211216.nc cycle @@ -1512,14 +1512,14 @@ lnd/clm2/surfdata_map/release-clm5.0.30/surfdata_ne0np4.CONUS.ne30x8_hist_78pfts cycle NDEP_month -bilinear +bilinear -nn -nn -nn -nn -nn -nn +nn +nn +nn +nn +nn +nn diff --git a/src/biogeochem/CNBalanceCheckMod.F90 b/src/biogeochem/CNBalanceCheckMod.F90 index a68410ddbe..a6a11d51b6 100644 --- a/src/biogeochem/CNBalanceCheckMod.F90 +++ b/src/biogeochem/CNBalanceCheckMod.F90 @@ -668,7 +668,7 @@ subroutine NBalanceCheck(this, bounds, num_soilc, filter_soilc, & call endrun(subgrid_index=c, subgrid_level=subgrid_level_column, msg=errMsg(sourcefile, __LINE__)) end if - if(.not.use_fates)then + if_notfates: if(.not.use_fates)then ! Repeat error check at the gridcell level call c2g( bounds = bounds, & @@ -743,7 +743,7 @@ subroutine NBalanceCheck(this, bounds, num_soilc, filter_soilc, & write(iulog,*) 'product_loss_grc =', product_loss_grc(g) * dt call endrun(subgrid_index=g, subgrid_level=subgrid_level_gridcell, msg=errMsg(sourcefile, __LINE__)) end if - end if + end if if_notfates end associate diff --git a/src/biogeochem/CNCStateUpdate1Mod.F90 b/src/biogeochem/CNCStateUpdate1Mod.F90 index 3b210506b1..ba006b81a2 100644 --- a/src/biogeochem/CNCStateUpdate1Mod.F90 +++ b/src/biogeochem/CNCStateUpdate1Mod.F90 @@ -18,12 +18,12 @@ module CNCStateUpdate1Mod use CNVegCarbonStateType , only : cnveg_carbonstate_type use CNVegCarbonFluxType , only : cnveg_carbonflux_type use CropType , only : crop_type - use CropReprPoolsMod , only : nrepr, repr_grain_min, repr_grain_max, repr_structure_min, repr_structure_max + use CropReprPoolsMod , only : nrepr, repr_grain_min, repr_grain_max + use CropReprPoolsMod , only : repr_structure_min, repr_structure_max use SoilBiogeochemDecompCascadeConType , only : decomp_cascade_con, use_soil_matrixcn use SoilBiogeochemCarbonFluxType , only : soilbiogeochem_carbonflux_type use SoilBiogeochemCarbonStateType , only : soilbiogeochem_carbonstate_type use PatchType , only : patch - use clm_varctl , only : use_fates, use_cn, iulog, use_fates_sp use CNSharedParamsMod , only : use_matrixcn use CLMFatesInterfaceMod , only : hlm_fates_interface_type use ColumnType , only : col @@ -46,6 +46,7 @@ subroutine CStateUpdateDynPatch(bounds, num_soilc_with_inactive, filter_soilc_wi ! ! !DESCRIPTION: ! Update carbon states based on fluxes from dyn_cnbal_patch + ! This routine is not called with FATES active. ! ! !ARGUMENTS: type(bounds_type), intent(in) :: bounds @@ -74,26 +75,23 @@ subroutine CStateUpdateDynPatch(bounds, num_soilc_with_inactive, filter_soilc_wi dt = get_step_size_real() - if (.not. use_fates) then - do j = 1,nlevdecomp - do fc = 1, num_soilc_with_inactive - c = filter_soilc_with_inactive(fc) - do i = i_litr_min, i_litr_max - cs_soil%decomp_cpools_vr_col(c,j,i) = & - cs_soil%decomp_cpools_vr_col(c,j,i) + & - cf_veg%dwt_frootc_to_litr_c_col(c,j,i) * dt - end do - cs_soil%decomp_cpools_vr_col(c,j,i_cwd) = cs_soil%decomp_cpools_vr_col(c,j,i_cwd) + & - ( cf_veg%dwt_livecrootc_to_cwdc_col(c,j) + cf_veg%dwt_deadcrootc_to_cwdc_col(c,j) ) * dt + do j = 1,nlevdecomp + do fc = 1, num_soilc_with_inactive + c = filter_soilc_with_inactive(fc) + do i = i_litr_min, i_litr_max + cs_soil%decomp_cpools_vr_col(c,j,i) = & + cs_soil%decomp_cpools_vr_col(c,j,i) + & + cf_veg%dwt_frootc_to_litr_c_col(c,j,i) * dt end do + cs_soil%decomp_cpools_vr_col(c,j,i_cwd) = cs_soil%decomp_cpools_vr_col(c,j,i_cwd) + & + ( cf_veg%dwt_livecrootc_to_cwdc_col(c,j) + cf_veg%dwt_deadcrootc_to_cwdc_col(c,j) ) * dt end do + end do - do g = bounds%begg, bounds%endg - cs_veg%seedc_grc(g) = cs_veg%seedc_grc(g) - cf_veg%dwt_seedc_to_leaf_grc(g) * dt - cs_veg%seedc_grc(g) = cs_veg%seedc_grc(g) - cf_veg%dwt_seedc_to_deadstem_grc(g) * dt - end do - - end if + do g = bounds%begg, bounds%endg + cs_veg%seedc_grc(g) = cs_veg%seedc_grc(g) - cf_veg%dwt_seedc_to_leaf_grc(g) * dt + cs_veg%seedc_grc(g) = cs_veg%seedc_grc(g) - cf_veg%dwt_seedc_to_deadstem_grc(g) * dt + end do end associate diff --git a/src/biogeochem/CNDriverMod.F90 b/src/biogeochem/CNDriverMod.F90 index d2b9ed9655..1e5b035f8d 100644 --- a/src/biogeochem/CNDriverMod.F90 +++ b/src/biogeochem/CNDriverMod.F90 @@ -6,7 +6,7 @@ module CNDriverMod ! ! !USES: use shr_kind_mod , only : r8 => shr_kind_r8 - use clm_varctl , only : use_c13, use_c14, use_fates, use_dynroot + use clm_varctl , only : use_c13, use_c14, use_fates_bgc, use_dynroot use dynSubgridControlMod , only : get_do_harvest use decompMod , only : bounds_type use perf_mod , only : t_startf, t_stopf @@ -819,7 +819,7 @@ subroutine CNDriverNoLeaching(bounds, if (use_c14) call c14_products_inst%SetValues(bounds,0._r8) call n_products_inst%SetValues(bounds,0._r8) - if(use_fates) then + if(use_fates_bgc) then call clm_fates%wrap_WoodProducts(bounds, num_soilc, filter_soilc, c_products_inst, n_products_inst) end if diff --git a/src/biogeochem/CNVegetationFacade.F90 b/src/biogeochem/CNVegetationFacade.F90 index 42d91e9c3d..72082a579b 100644 --- a/src/biogeochem/CNVegetationFacade.F90 +++ b/src/biogeochem/CNVegetationFacade.F90 @@ -44,7 +44,7 @@ module CNVegetationFacade use shr_log_mod , only : errMsg => shr_log_errMsg use perf_mod , only : t_startf, t_stopf use decompMod , only : bounds_type - use clm_varctl , only : iulog, use_cn, use_cndv, use_c13, use_c14 + use clm_varctl , only : iulog, use_cn, use_cndv, use_c13, use_c14, use_fates_bgc use abortutils , only : endrun use spmdMod , only : masterproc use clm_time_manager , only : get_curr_date, get_ref_date @@ -261,18 +261,20 @@ subroutine Init(this, bounds, NLFilename, nskip_steps, params_ncid) call this%cnveg_nitrogenflux_inst%Init(bounds) end if + + if (use_cn .or. use_fates_bgc) then + call this%c_products_inst%Init(bounds, species_non_isotope_type('C')) + if (use_c13) then + call this%c13_products_inst%Init(bounds, species_isotope_type('C', '13')) + end if + if (use_c14) then + call this%c14_products_inst%Init(bounds, species_isotope_type('C', '14')) + end if + call this%n_products_inst%Init(bounds, species_non_isotope_type('N')) - call this%c_products_inst%Init(bounds, species_non_isotope_type('C')) - if (use_c13) then - call this%c13_products_inst%Init(bounds, species_isotope_type('C', '13')) + call this%cn_balance_inst%Init(bounds) end if - if (use_c14) then - call this%c14_products_inst%Init(bounds, species_isotope_type('C', '14')) - end if - call this%n_products_inst%Init(bounds, species_non_isotope_type('N')) - - call this%cn_balance_inst%Init(bounds) - + if(use_cn)then ! Initialize the memory for the dgvs_inst data structure regardless of whether ! use_cndv is true so that it can be used in associate statements (nag compiler @@ -506,20 +508,22 @@ subroutine Restart(this, bounds, ncid, flag) filter_reseed_patch=reseed_patch, num_reseed_patch=num_reseed_patch) end if - - call this%c_products_inst%restart(bounds, ncid, flag) - if (use_c13) then - call this%c13_products_inst%restart(bounds, ncid, flag, & - template_for_missing_fields = this%c_products_inst, & - template_multiplier = c3_r2) - end if - if (use_c14) then - call this%c14_products_inst%restart(bounds, ncid, flag, & - template_for_missing_fields = this%c_products_inst, & - template_multiplier = c14ratio) + + if (use_cn .or. use_fates_bgc) then + call this%c_products_inst%restart(bounds, ncid, flag) + if (use_c13) then + call this%c13_products_inst%restart(bounds, ncid, flag, & + template_for_missing_fields = this%c_products_inst, & + template_multiplier = c3_r2) + end if + if (use_c14) then + call this%c14_products_inst%restart(bounds, ncid, flag, & + template_for_missing_fields = this%c_products_inst, & + template_multiplier = c14ratio) + end if + call this%n_products_inst%restart(bounds, ncid, flag) end if - call this%n_products_inst%restart(bounds, ncid, flag) - + if (use_cndv) then call this%dgvs_inst%Restart(bounds, ncid, flag=flag) end if @@ -908,7 +912,8 @@ subroutine EcosystemDynamicsPreDrainage(this, bounds, & ! !DESCRIPTION: ! Do the main science for biogeochemistry that needs to be done before hydrology-drainage ! - ! Can be called for either use_cn or use_fates. Will skip most vegetation patch calls for the latter + ! Can be called for either use_cn or use_fates_bgc. + ! Will skip most vegetation patch calls for the latter ! ! !USES: @@ -1019,7 +1024,7 @@ subroutine EcosystemDynamicsPostDrainage(this, bounds, num_allc, filter_allc, & ! !DESCRIPTION: ! Do the main science for CN vegetation that needs to be done after hydrology-drainage ! - ! Should only be called if use_cn is true + ! Should only be called if use_cn is true or use_fates_bgc is true ! ! !USES: ! @@ -1141,14 +1146,12 @@ subroutine BalanceCheck(this, bounds, num_soilc, filter_soilc, & soilbiogeochem_carbonflux_inst, soilbiogeochem_nitrogenflux_inst, & soilbiogeochem_carbonstate_inst, soilbiogeochem_nitrogenstate_inst, & atm2lnd_inst, clm_fates) - - ! ! !DESCRIPTION: ! Check the carbon and nitrogen balance ! - ! Should only be called if use_cn is true + ! Should only be called if use_cn is true or use_fates_bgc is true ! ! !USES: use clm_time_manager , only : get_nstep_since_startup_or_lastDA_restart_or_pause diff --git a/src/biogeochem/ch4Mod.F90 b/src/biogeochem/ch4Mod.F90 index afb8af351b..f199e7913f 100644 --- a/src/biogeochem/ch4Mod.F90 +++ b/src/biogeochem/ch4Mod.F90 @@ -17,7 +17,7 @@ module ch4Mod use clm_varcon , only : catomw, s_con, d_con_w, d_con_g, c_h_inv, kh_theta, kh_tbase use landunit_varcon , only : istsoil, istcrop, istdlak use clm_time_manager , only : get_step_size_real, get_nstep - use clm_varctl , only : iulog, use_cn, use_nitrif_denitrif, use_lch4, use_cn, use_fates + use clm_varctl , only : iulog, use_cn, use_nitrif_denitrif, use_lch4, use_fates_bgc use abortutils , only : endrun use decompMod , only : bounds_type, subgrid_level_gridcell, subgrid_level_column use atm2lndType , only : atm2lnd_type @@ -2521,7 +2521,7 @@ subroutine ch4_prod (bounds, num_methc, filter_methc, num_methp, & end if end do - if(use_fates) then + if(use_fates_bgc) then nc = bounds%clump_index do s = 1,clm_fates%fates(nc)%nsites c = clm_fates%f2hmap(nc)%fcolumn(s) @@ -2544,7 +2544,7 @@ subroutine ch4_prod (bounds, num_methc, filter_methc, num_methp, & if (.not. lake) then - if (use_cn .or. use_fates) then + if (use_cn .or. use_fates_bgc) then ! Use soil heterotrophic respiration (based on Wania) base_decomp = (somhr(c)+lithr(c)) / catomw ! Convert from gC to molC @@ -2567,7 +2567,7 @@ subroutine ch4_prod (bounds, num_methc, filter_methc, num_methp, & else call endrun(msg=' ERROR: No source for decomp rate in CH4Prod.'//& ' CH4 model currently requires CN or FATES.'//errMsg(sourcefile, __LINE__)) - end if ! use_cn + end if ! use_cn or use_fates_bgc ! For sensitivity studies base_decomp = base_decomp * cnscalefactor diff --git a/src/main/clm_driver.F90 b/src/main/clm_driver.F90 index ce0627df2b..e54535c09e 100644 --- a/src/main/clm_driver.F90 +++ b/src/main/clm_driver.F90 @@ -9,7 +9,7 @@ module clm_driver ! ! !USES: use shr_kind_mod , only : r8 => shr_kind_r8 - use clm_varctl , only : iulog, use_fates, use_fates_sp + use clm_varctl , only : iulog, use_fates, use_fates_sp, use_fates_bgc use clm_varctl , only : use_cn, use_lch4, use_noio, use_c13, use_c14 use CNSharedParamsMod , only : use_matrixcn use clm_varctl , only : use_crop, irrigate, ndep_from_cpl @@ -288,7 +288,7 @@ subroutine clm_drv(doalb, nextsw_cday, declinp1, declin, rstwr, nlend, rdate, ro call active_layer_inst%alt_calc(filter_inactive_and_active(nc)%num_soilc, filter_inactive_and_active(nc)%soilc, & temperature_inst) - if ((use_cn .or. use_fates) .and. decomp_method /= no_soil_decomp) then + if ((use_cn .or. use_fates_bgc) .and. decomp_method /= no_soil_decomp) then call SoilBiogeochemVerticalProfile(bounds_clump , & filter_inactive_and_active(nc)%num_bgc_soilc, filter_inactive_and_active(nc)%bgc_soilc , & filter_inactive_and_active(nc)%num_bgc_vegp, filter_inactive_and_active(nc)%bgc_vegp , & @@ -324,7 +324,7 @@ subroutine clm_drv(doalb, nextsw_cday, declinp1, declin, rstwr, nlend, rdate, ro call get_clump_bounds(nc, bounds_clump) call t_startf('begcnbal_grc') - if (use_cn .or. use_fates) then + if (use_cn .or. use_fates_bgc) then ! Initialize gridcell-level balance check call bgc_vegetation_inst%InitGridcellBalance(bounds_clump, & filter(nc)%num_allc, filter(nc)%allc, & @@ -414,7 +414,7 @@ subroutine clm_drv(doalb, nextsw_cday, declinp1, declin, rstwr, nlend, rdate, ro call t_stopf('begwbal') call t_startf('begcnbal_col') - if (use_cn .or. use_fates) then + if (use_cn .or. use_fates_bgc) then ! Initialize column-level balance check call bgc_vegetation_inst%InitColumnBalance(bounds_clump, & filter(nc)%num_allc, filter(nc)%allc, & @@ -443,15 +443,18 @@ subroutine clm_drv(doalb, nextsw_cday, declinp1, declin, rstwr, nlend, rdate, ro ! re-written to go inside. ! ============================================================================ - if (use_cn) then - call t_startf('bgc_interp') + if (use_cn .or. use_fates_bgc) then if (.not. ndep_from_cpl) then call ndep_interp(bounds_proc, atm2lnd_inst) end if + end if + + if(use_cn) then + call t_startf('bgc_interp') call bgc_vegetation_inst%InterpFileInputs(bounds_proc) call t_stopf('bgc_interp') - ! fates_spitfire_mode is assigned an integer value in the namelist - ! see bld/namelist_files/namelist_definition_clm4_5.xml for details + ! fates_spitfire_mode is assigned an integer value in the namelist + ! see bld/namelist_files/namelist_definition_clm4_5.xml for details else if (fates_spitfire_mode > scalar_lightning) then call clm_fates%InterpFileInputs(bounds_proc) end if @@ -999,7 +1002,7 @@ subroutine clm_drv(doalb, nextsw_cday, declinp1, declin, rstwr, nlend, rdate, ro ! Filter bgc_soilc operates on all non-sp soil columns ! Filter bgc_vegp operates on all non-fates, non-sp patches (use_cn) on soil - if(use_cn .or. use_fates)then + if(use_cn .or. use_fates_bgc)then call t_startf('ecosysdyn') call bgc_vegetation_inst%EcosystemDynamicsPreDrainage(bounds_clump, & filter(nc)%num_bgc_soilc, filter(nc)%bgc_soilc, & @@ -1077,7 +1080,7 @@ subroutine clm_drv(doalb, nextsw_cday, declinp1, declin, rstwr, nlend, rdate, ro call t_stopf('hydro2_drainage') - if (use_cn .or. use_fates) then + if (use_cn .or. use_fates_bgc) then call t_startf('EcosysDynPostDrainage') call bgc_vegetation_inst%EcosystemDynamicsPostDrainage(bounds_clump, & filter(nc)%num_allc, filter(nc)%allc, & @@ -1145,7 +1148,7 @@ subroutine clm_drv(doalb, nextsw_cday, declinp1, declin, rstwr, nlend, rdate, ro ! Check the carbon and nitrogen balance ! ============================================================================ - if(use_cn .or. use_fates)then + if(use_cn .or. use_fates_bgc)then call t_startf('cnbalchk') call bgc_vegetation_inst%BalanceCheck( & bounds_clump, filter(nc)%num_bgc_soilc, filter(nc)%bgc_soilc, & @@ -1375,7 +1378,6 @@ subroutine clm_drv(doalb, nextsw_cday, declinp1, declin, rstwr, nlend, rdate, ro ! Update history buffer ! ============================================================================ - call t_startf('hbuf') call hist_update_hbuf(bounds_proc) call t_stopf('hbuf') diff --git a/src/main/clm_initializeMod.F90 b/src/main/clm_initializeMod.F90 index 1178470b77..98e6ba006e 100644 --- a/src/main/clm_initializeMod.F90 +++ b/src/main/clm_initializeMod.F90 @@ -10,10 +10,11 @@ module clm_initializeMod use spmdMod , only : masterproc, mpicom use decompMod , only : bounds_type, get_proc_bounds, get_proc_clumps, get_clump_bounds use abortutils , only : endrun - use clm_varctl , only : nsrest, nsrStartup, nsrContinue, nsrBranch, use_fates_sp + use clm_varctl , only : nsrest, nsrStartup, nsrContinue, nsrBranch + use clm_varctl , only : use_fates_sp, use_fates_bgc, use_fates use clm_varctl , only : is_cold_start use clm_varctl , only : iulog - use clm_varctl , only : use_lch4, use_cn, use_cndv, use_c13, use_c14, use_fates + use clm_varctl , only : use_lch4, use_cn, use_cndv, use_c13, use_c14 use clm_varctl , only : use_soil_moisture_streams use clm_instur , only : wt_lunit, urban_valid, wt_nat_patch, wt_cft, fert_cft use clm_instur , only : irrig_method, wt_glc_mec, topo_glc_mec, haslake, pct_urban_max @@ -625,8 +626,7 @@ subroutine initialize2(ni,nj) !$OMP END PARALLEL DO ! Initialize nitrogen deposition - ! RGK: To-do, enable N deposition in FATES - if (use_cn) then + if (use_cn .or. use_fates_bgc) then call t_startf('init_ndep') if (.not. ndep_from_cpl) then call ndep_init(bounds_proc, NLFilename) diff --git a/src/main/clm_instMod.F90 b/src/main/clm_instMod.F90 index 33faa1e993..be75edc8d1 100644 --- a/src/main/clm_instMod.F90 +++ b/src/main/clm_instMod.F90 @@ -8,7 +8,7 @@ module clm_instMod use shr_kind_mod , only : r8 => shr_kind_r8 use decompMod , only : bounds_type use clm_varpar , only : ndecomp_pools, nlevdecomp_full - use clm_varctl , only : use_cn, use_c13, use_c14, use_lch4, use_cndv, use_fates + use clm_varctl , only : use_cn, use_c13, use_c14, use_lch4, use_cndv, use_fates, use_fates_bgc use clm_varctl , only : iulog use clm_varctl , only : use_crop, snow_cover_fraction_method, paramfile use SoilBiogeochemDecompCascadeConType , only : mimics_decomp, no_soil_decomp, century_decomp, decomp_method @@ -425,6 +425,7 @@ subroutine clm_instInit(bounds) end if if_decomp ! Note - always call Init for bgc_vegetation_inst: some pieces need to be initialized always + ! Even for a FATES simulation, we call this to initialize product pools call bgc_vegetation_inst%Init(bounds, nlfilename, GetBalanceCheckSkipSteps(), params_ncid ) if (use_cn .or. use_fates) then @@ -549,7 +550,7 @@ subroutine clm_instRest(bounds, ncid, flag, writing_finidat_interp_dest_file) call ch4_inst%restart(bounds, ncid, flag=flag) end if - if ( use_cn .or. use_fates) then + if ( use_cn .or. use_fates_bgc) then ! Need to do vegetation restart before soil bgc restart to get totvegc_col for purpose ! of resetting soil carbon at exit spinup when no vegetation is growing. call bgc_vegetation_inst%restart(bounds, ncid, flag=flag) diff --git a/src/main/clm_varctl.F90 b/src/main/clm_varctl.F90 index 9be9af2f73..f827c4836c 100644 --- a/src/main/clm_varctl.F90 +++ b/src/main/clm_varctl.F90 @@ -249,27 +249,33 @@ module clm_varctl ! FATES switches !---------------------------------------------------------- - logical, public :: use_fates = .false. ! true => use fates + logical, public :: use_fates = .false. ! true => use fates ! These are INTERNAL to the FATES module - integer, public :: fates_parteh_mode = -9 ! 1 => carbon only - ! 2 => C+N+P (not enabled yet) - ! no others enabled + + integer, public :: fates_parteh_mode = -9 ! 1 => carbon only + ! 2 => C+N+P (not enabled yet) + ! no others enabled integer, public :: fates_spitfire_mode = 0 - ! 0 for no fire; 1 for constant ignitions; > 1 for external data (lightning and/or anthropogenic ignitions) - ! see bld/namelist_files/namelist_definition_clm4_5.xml for details - logical, public :: use_fates_tree_damage = .false. ! true => turn on tree damage module - logical, public :: use_fates_logging = .false. ! true => turn on logging module - logical, public :: use_fates_planthydro = .false. ! true => turn on fates hydro + ! 0 for no fire; 1 for constant ignitions; + ! > 1 for external data (lightning and/or anthropogenic ignitions) + ! see bld/namelist_files/namelist_definition_clm4_5.xml for details + logical, public :: use_fates_tree_damage = .false. ! true => turn on tree damage module + logical, public :: use_fates_logging = .false. ! true => turn on logging module + logical, public :: use_fates_planthydro = .false. ! true => turn on fates hydro logical, public :: use_fates_cohort_age_tracking = .false. ! true => turn on cohort age tracking - logical, public :: use_fates_ed_st3 = .false. ! true => static stand structure - logical, public :: use_fates_ed_prescribed_phys = .false. ! true => prescribed physiology - logical, public :: use_fates_inventory_init = .false. ! true => initialize fates from inventory - logical, public :: use_fates_fixed_biogeog = .false. ! true => use fixed biogeography mode - logical, public :: use_fates_nocomp = .false. ! true => use no comopetition mode - logical, public :: use_fates_sp = .false. ! true => use FATES satellite phenology mode - character(len=256), public :: fates_inventory_ctrl_filename = '' ! filename for inventory control - + logical, public :: use_fates_ed_st3 = .false. ! true => static stand structure + logical, public :: use_fates_ed_prescribed_phys = .false. ! true => prescribed physiology + logical, public :: use_fates_inventory_init = .false. ! true => initialize fates from inventory + logical, public :: use_fates_fixed_biogeog = .false. ! true => use fixed biogeography mode + logical, public :: use_fates_nocomp = .false. ! true => use no comopetition mode + character(len=256), public :: fates_inventory_ctrl_filename = '' ! filename for inventory control + + ! FATES SP AND FATES BGC are MUTUTALLY EXCLUSIVE, THEY CAN'T BOTH BE ON + ! BUT... THEY CAN BOTH BE OFF (IF FATES IS OFF) + logical, public :: use_fates_sp = .false. ! true => use FATES satellite phenology mode + logical, public :: use_fates_bgc = .false. ! true => use FATES along with CLM soil biogeochemistry + !---------------------------------------------------------- ! LUNA switches !---------------------------------------------------------- diff --git a/src/main/controlMod.F90 b/src/main/controlMod.F90 index 4a6929c28e..a0af5b2862 100644 --- a/src/main/controlMod.F90 +++ b/src/main/controlMod.F90 @@ -232,8 +232,8 @@ subroutine control_init(dtime) fates_parteh_mode, & use_fates_tree_damage - ! Ozone vegetation stress method - namelist / clm_inparam / o3_veg_stress_method + ! Ozone vegetation stress method + namelist / clm_inparam / o3_veg_stress_method ! CLM 5.0 nitrogen flags namelist /clm_inparm/ use_flexibleCN, use_luna @@ -433,6 +433,12 @@ subroutine control_init(dtime) ! Check compatibility with the FATES model if ( use_fates ) then + if(use_fates_sp) then + use_fates_bgc = .false. + else + use_fates_bgc = .true. + end if + if (fates_parteh_mode == 1 .and. suplnitro == suplnNon)then write(iulog,*) ' When FATES with fates_parteh_mode == 1 (ie carbon only mode),' write(iulog,*) ' you must have supplemental nitrogen turned on, there will be' @@ -467,6 +473,13 @@ subroutine control_init(dtime) errMsg(sourcefile, __LINE__)) end if + else + + ! These do default to false anyway, but this emphasizes they + ! are false when fates is false + use_fates_sp = .false. + use_fates_bgc = .false. + end if ! If nfix_timeconst is equal to the junk default value, then it was not specified @@ -727,6 +740,7 @@ subroutine control_spmd() call mpi_bcast (use_fates_fixed_biogeog, 1, MPI_LOGICAL, 0, mpicom, ier) call mpi_bcast (use_fates_nocomp, 1, MPI_LOGICAL, 0, mpicom, ier) call mpi_bcast (use_fates_sp, 1, MPI_LOGICAL, 0, mpicom, ier) + call mpi_bcast (use_fates_bgc, 1, MPI_LOGICAL, 0, mpicom, ier) call mpi_bcast (fates_inventory_ctrl_filename, len(fates_inventory_ctrl_filename), MPI_CHARACTER, 0, mpicom, ier) call mpi_bcast (fates_paramfile, len(fates_paramfile) , MPI_CHARACTER, 0, mpicom, ier) call mpi_bcast (fates_parteh_mode, 1, MPI_INTEGER, 0, mpicom, ier) diff --git a/src/soilbiogeochem/SoilBiogeochemDecompCascadeConType.F90 b/src/soilbiogeochem/SoilBiogeochemDecompCascadeConType.F90 index 4f6cf04eaf..0474ab9a63 100644 --- a/src/soilbiogeochem/SoilBiogeochemDecompCascadeConType.F90 +++ b/src/soilbiogeochem/SoilBiogeochemDecompCascadeConType.F90 @@ -63,7 +63,7 @@ module SoilBiogeochemDecompCascadeConType !------------------------------------------------------------------------ subroutine decomp_cascade_par_init( NLFilename ) - use clm_varctl , only : use_fates, use_cn, use_fates_sp + use clm_varctl , only : use_cn, use_fates_bgc use clm_varpar , only : ndecomp_pools_max use spmdMod , only : masterproc, mpicom use clm_nlUtilsMod , only : find_nlgroup_name @@ -110,9 +110,9 @@ subroutine decomp_cascade_par_init( NLFilename ) if ( decomp_method == no_soil_decomp )then call endrun('When running with BGC an active soil_decomp_method must be used') end if - else if ( use_fates ) then - if ( .not. use_fates_sp .and. (decomp_method == no_soil_decomp) )then - call endrun('When running with FATES and without FATES-SP an active soil_decomp_method must be used') + else if ( use_fates_bgc ) then + if ( decomp_method == no_soil_decomp )then + call endrun('When running with FATES and without FATES-SP, an active soil_decomp_method must be used') end if else if ( decomp_method /= no_soil_decomp )then @@ -128,7 +128,7 @@ subroutine decomp_cascade_par_init( NLFilename ) ! ndecomp_pools would get the value of i_pas_som or i_cwd and ! ndecomp_cascade_transitions would get the value of i_s3s1 or i_cwdl3 ! depending on how use_fates is set. - if ( use_fates ) then + if ( use_fates_bgc ) then if (decomp_method == century_decomp) then ndecomp_pools = 6 ndecomp_cascade_transitions = 8 diff --git a/src/soilbiogeochem/SoilBiogeochemLittVertTranspMod.F90 b/src/soilbiogeochem/SoilBiogeochemLittVertTranspMod.F90 index 58e05fb3e1..136438cf37 100644 --- a/src/soilbiogeochem/SoilBiogeochemLittVertTranspMod.F90 +++ b/src/soilbiogeochem/SoilBiogeochemLittVertTranspMod.F90 @@ -5,7 +5,7 @@ module SoilBiogeochemLittVertTranspMod ! use shr_kind_mod , only : r8 => shr_kind_r8 use shr_log_mod , only : errMsg => shr_log_errMsg - use clm_varctl , only : iulog, use_c13, use_c14, spinup_state, use_fates, use_cn + use clm_varctl , only : iulog, use_c13, use_c14, spinup_state use clm_varcon , only : secspday use decompMod , only : bounds_type use abortutils , only : endrun @@ -244,11 +244,9 @@ subroutine SoilBiogeochemLittVertTransp(bounds, num_soilc, filter_soilc, & source => soilbiogeochem_carbonflux_inst%decomp_cpools_sourcesink_col trcr_tendency_ptr => soilbiogeochem_carbonflux_inst%decomp_cpools_transport_tendency_col case (2) ! N - if (use_cn .or. use_fates) then - conc_ptr => soilbiogeochem_nitrogenstate_inst%decomp_npools_vr_col - source => soilbiogeochem_nitrogenflux_inst%decomp_npools_sourcesink_col - trcr_tendency_ptr => soilbiogeochem_nitrogenflux_inst%decomp_npools_transport_tendency_col - endif + conc_ptr => soilbiogeochem_nitrogenstate_inst%decomp_npools_vr_col + source => soilbiogeochem_nitrogenflux_inst%decomp_npools_sourcesink_col + trcr_tendency_ptr => soilbiogeochem_nitrogenflux_inst%decomp_npools_transport_tendency_col case (3) if ( use_c13 ) then ! C13 diff --git a/src/soilbiogeochem/SoilBiogeochemPrecisionControlMod.F90 b/src/soilbiogeochem/SoilBiogeochemPrecisionControlMod.F90 index 91c70fcf5e..cabc57990e 100644 --- a/src/soilbiogeochem/SoilBiogeochemPrecisionControlMod.F90 +++ b/src/soilbiogeochem/SoilBiogeochemPrecisionControlMod.F90 @@ -71,7 +71,6 @@ subroutine SoilBiogeochemPrecisionControl(num_soilc, filter_soilc, & ! ! !USES: use clm_varctl , only : iulog, use_c13, use_c14, use_nitrif_denitrif - use clm_varctl , only : use_cn, use_fates use clm_varpar , only : nlevdecomp use CNSharedParamsMod, only: use_fun ! @@ -126,13 +125,12 @@ subroutine SoilBiogeochemPrecisionControl(num_soilc, filter_soilc, & do k = 1, ndecomp_pools if (abs(cs%decomp_cpools_vr_col(c,j,k)) < ccrit) then + cc = cc + cs%decomp_cpools_vr_col(c,j,k) cs%decomp_cpools_vr_col(c,j,k) = 0._r8 - if (use_cn .or. use_fates) then - cn = cn + ns%decomp_npools_vr_col(c,j,k) - ns%decomp_npools_vr_col(c,j,k) = 0._r8 - endif + cn = cn + ns%decomp_npools_vr_col(c,j,k) + ns%decomp_npools_vr_col(c,j,k) = 0._r8 if ( use_c13 ) then cc13 = cc13 + c13cs%decomp_cpools_vr_col(c,j,k) @@ -151,9 +149,8 @@ subroutine SoilBiogeochemPrecisionControl(num_soilc, filter_soilc, & cs%ctrunc_vr_col(c,j) = cs%ctrunc_vr_col(c,j) + cc - if (use_cn .or. use_fates) then - ns%ntrunc_vr_col(c,j) = ns%ntrunc_vr_col(c,j) + cn - endif + ns%ntrunc_vr_col(c,j) = ns%ntrunc_vr_col(c,j) + cn + if ( use_c13 ) then c13cs%ctrunc_vr_col(c,j) = c13cs%ctrunc_vr_col(c,j) + cc13 endif diff --git a/src/soilbiogeochem/SoilBiogeochemStateType.F90 b/src/soilbiogeochem/SoilBiogeochemStateType.F90 index 86232160f7..69055aec9b 100644 --- a/src/soilbiogeochem/SoilBiogeochemStateType.F90 +++ b/src/soilbiogeochem/SoilBiogeochemStateType.F90 @@ -11,7 +11,7 @@ module SoilBiogeochemStateType use clm_varcon , only : spval, ispval, c14ratio, grlnd use landunit_varcon, only : istsoil, istcrop use clm_varpar , only : nlevsno, nlevgrnd, nlevlak - use clm_varctl , only : use_cn + use clm_varctl , only : use_cn, use_fates_bgc use clm_varctl , only : iulog use LandunitType , only : lun use ColumnType , only : col @@ -60,7 +60,7 @@ subroutine Init(this, bounds) type(bounds_type), intent(in) :: bounds call this%InitAllocate ( bounds ) - if (use_cn) then + if (use_cn .or. use_fates_bgc) then call this%InitHistory ( bounds ) end if call this%InitCold ( bounds ) @@ -132,26 +132,30 @@ subroutine InitHistory(this, bounds) begp = bounds%begp; endp= bounds%endp begc = bounds%begc; endc= bounds%endc - this%croot_prof_patch(begp:endp,:) = spval - call hist_addfld_decomp (fname='CROOT_PROF', units='1/m', type2d='levdcmp', & - avgflag='A', long_name='profile for litter C and N inputs from coarse roots', & - ptr_patch=this%croot_prof_patch, default='inactive') - - this%froot_prof_patch(begp:endp,:) = spval - call hist_addfld_decomp (fname='FROOT_PROF', units='1/m', type2d='levdcmp', & - avgflag='A', long_name='profile for litter C and N inputs from fine roots', & - ptr_patch=this%froot_prof_patch, default='inactive') - - this%leaf_prof_patch(begp:endp,:) = spval - call hist_addfld_decomp (fname='LEAF_PROF', units='1/m', type2d='levdcmp', & - avgflag='A', long_name='profile for litter C and N inputs from leaves', & - ptr_patch=this%leaf_prof_patch, default='inactive') - - this%stem_prof_patch(begp:endp,:) = spval - call hist_addfld_decomp (fname='STEM_PROF', units='1/m', type2d='levdcmp', & - avgflag='A', long_name='profile for litter C and N inputs from stems', & - ptr_patch=this%stem_prof_patch, default='inactive') - + if_usecn: if(use_cn) then + this%croot_prof_patch(begp:endp,:) = spval + call hist_addfld_decomp (fname='CROOT_PROF', units='1/m', type2d='levdcmp', & + avgflag='A', long_name='profile for litter C and N inputs from coarse roots', & + ptr_patch=this%croot_prof_patch, default='inactive') + + this%froot_prof_patch(begp:endp,:) = spval + call hist_addfld_decomp (fname='FROOT_PROF', units='1/m', type2d='levdcmp', & + avgflag='A', long_name='profile for litter C and N inputs from fine roots', & + ptr_patch=this%froot_prof_patch, default='inactive') + + this%leaf_prof_patch(begp:endp,:) = spval + call hist_addfld_decomp (fname='LEAF_PROF', units='1/m', type2d='levdcmp', & + avgflag='A', long_name='profile for litter C and N inputs from leaves', & + ptr_patch=this%leaf_prof_patch, default='inactive') + + this%stem_prof_patch(begp:endp,:) = spval + call hist_addfld_decomp (fname='STEM_PROF', units='1/m', type2d='levdcmp', & + avgflag='A', long_name='profile for litter C and N inputs from stems', & + ptr_patch=this%stem_prof_patch, default='inactive') + end if if_usecn + + ! These output variables are valid for both use_cn AND use_fates_bgc + this%nfixation_prof_col(begc:endc,:) = spval call hist_addfld_decomp (fname='NFIXATION_PROF', units='1/m', type2d='levdcmp', & avgflag='A', long_name='profile for biological N fixation', & @@ -161,7 +165,7 @@ subroutine InitHistory(this, bounds) call hist_addfld_decomp (fname='NDEP_PROF', units='1/m', type2d='levdcmp', & avgflag='A', long_name='profile for atmospheric N deposition', & ptr_col=this%ndep_prof_col, default='inactive') - + this%som_adv_coef_col(begc:endc,:) = spval call hist_addfld_decomp (fname='SOM_ADV_COEF', units='m/s', type2d='levdcmp', & avgflag='A', long_name='advection term for vertical SOM translocation', & From 8e638d41216e8236b70dbfa430ba074798fb3530 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Mon, 13 Mar 2023 09:37:26 -0600 Subject: [PATCH 060/257] updated fates external and the default parameter file --- Externals_CLM.cfg | 4 ++-- bld/namelist_files/namelist_defaults_ctsm.xml | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/Externals_CLM.cfg b/Externals_CLM.cfg index 219d1a9704..883416a43b 100644 --- a/Externals_CLM.cfg +++ b/Externals_CLM.cfg @@ -1,8 +1,8 @@ [fates] local_path = src/fates protocol = git -repo_url = https://github.com/NGEET/fates -tag = sci.1.61.0_api.25.0.0 +repo_url = https://github.com/rgknox/fates +branch = clm-cbalance required = True [externals_description] diff --git a/bld/namelist_files/namelist_defaults_ctsm.xml b/bld/namelist_files/namelist_defaults_ctsm.xml index 9a31995c4f..8517325c59 100644 --- a/bld/namelist_files/namelist_defaults_ctsm.xml +++ b/bld/namelist_files/namelist_defaults_ctsm.xml @@ -493,7 +493,7 @@ attributes from the config_cache.xml file (with keys converted to upper-case). -lnd/clm2/paramdata/fates_params_api.25.0.0_12pft_c221128.nc +lnd/clm2/paramdata/fates_params_api.25.2.0_12pft_c230310.nc From 4bdfea6dfe703252c0f04b000aa8a7108f40af86 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Tue, 14 Mar 2023 15:44:03 -0600 Subject: [PATCH 061/257] moved the use_fates broadcast earlier in the control process --- src/main/controlMod.F90 | 8 +++----- 1 file changed, 3 insertions(+), 5 deletions(-) diff --git a/src/main/controlMod.F90 b/src/main/controlMod.F90 index a0af5b2862..99d7f3c835 100644 --- a/src/main/controlMod.F90 +++ b/src/main/controlMod.F90 @@ -549,10 +549,8 @@ subroutine control_init(dtime) call soilHydReadNML( NLFilename ) - if( use_cn .or. use_fates) then + if( use_cn ) then call CNPrecisionControlReadNML( NLFilename ) - end if - if ( use_cn ) then call CNFireReadNML( NLFilename ) call CNNDynamicsReadNML ( NLFilename ) call CNPhenologyReadNML ( NLFilename ) @@ -715,6 +713,8 @@ subroutine control_spmd() ! BGC call mpi_bcast (co2_type, len(co2_type), MPI_CHARACTER, 0, mpicom, ier) + call mpi_bcast (use_fates, 1, MPI_LOGICAL, 0, mpicom, ier) + if (use_cn .or. use_fates) then call mpi_bcast (suplnitro, len(suplnitro), MPI_CHARACTER, 0, mpicom, ier) call mpi_bcast (nfix_timeconst, 1, MPI_REAL8, 0, mpicom, ier) @@ -727,8 +727,6 @@ subroutine control_spmd() call mpi_bcast (use_c14, 1, MPI_LOGICAL, 0, mpicom, ier) call mpi_bcast (for_testing_allow_interp_non_ciso_to_ciso, 1, MPI_LOGICAL, 0, mpicom, ier) - call mpi_bcast (use_fates, 1, MPI_LOGICAL, 0, mpicom, ier) - call mpi_bcast (fates_spitfire_mode, 1, MPI_INTEGER, 0, mpicom, ier) call mpi_bcast (use_fates_logging, 1, MPI_LOGICAL, 0, mpicom, ier) call mpi_bcast (use_fates_planthydro, 1, MPI_LOGICAL, 0, mpicom, ier) From f4092b3c8c20468bc2341c8c1f019c579b654f2c Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Wed, 15 Mar 2023 10:18:07 -0600 Subject: [PATCH 062/257] Fixes to CN wood products restart w/ fates on --- src/biogeochem/CNBalanceCheckMod.F90 | 3 ++- src/biogeochem/CNVegetationFacade.F90 | 8 ++++++++ 2 files changed, 10 insertions(+), 1 deletion(-) diff --git a/src/biogeochem/CNBalanceCheckMod.F90 b/src/biogeochem/CNBalanceCheckMod.F90 index a6a11d51b6..4d98ca57bf 100644 --- a/src/biogeochem/CNBalanceCheckMod.F90 +++ b/src/biogeochem/CNBalanceCheckMod.F90 @@ -435,7 +435,8 @@ subroutine CBalanceCheck(this, bounds, num_soilc, filter_soilc, & ! Totally punt on this for now. We just don't track these gridscale variables yet (RGK) grc_cinputs = 0._r8 - grc_coutputs = (grc_begcb(g) - grc_endcb(g))/dt + grc_endcb(g) = grc_begcb(g) + grc_coutputs = 0._r8 grc_errcb(g) = 0._r8 end if diff --git a/src/biogeochem/CNVegetationFacade.F90 b/src/biogeochem/CNVegetationFacade.F90 index 72082a579b..6fdb897795 100644 --- a/src/biogeochem/CNVegetationFacade.F90 +++ b/src/biogeochem/CNVegetationFacade.F90 @@ -510,6 +510,14 @@ subroutine Restart(this, bounds, ncid, flag) end if if (use_cn .or. use_fates_bgc) then + + if(use_fates_bgc)then + call this%c_products_inst%SetValues(bounds, 0._r8) + if (use_c13) call this%c13_products_inst%SetValues(bounds, 0._r8) + if (use_c14) call this%c14_products_inst%SetValues(bounds, 0._r8) + call this%n_products_inst%SetValues(bounds, 0._r8) + end if + call this%c_products_inst%restart(bounds, ncid, flag) if (use_c13) then call this%c13_products_inst%restart(bounds, ncid, flag, & From 873883cacab24ffaf96d14daa6ef0706e2a6ceaf Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Wed, 15 Mar 2023 17:53:47 -0600 Subject: [PATCH 063/257] cleaning up clm-fates bgc pr --- src/biogeochem/CNBalanceCheckMod.F90 | 8 +- src/biogeochem/CNCStateUpdate1Mod.F90 | 1 - src/biogeochem/CNDriverMod.F90 | 8 +- src/biogeochem/CNPhenologyMod.F90 | 159 +++++++++--------- src/biogeochem/CNProductsMod.F90 | 61 +++---- src/main/filterMod.F90 | 4 +- .../SoilBiogeochemCarbonFluxType.F90 | 25 +-- .../SoilBiogeochemNitrogenStateType.F90 | 2 - 8 files changed, 137 insertions(+), 131 deletions(-) diff --git a/src/biogeochem/CNBalanceCheckMod.F90 b/src/biogeochem/CNBalanceCheckMod.F90 index 4d98ca57bf..66d24175b1 100644 --- a/src/biogeochem/CNBalanceCheckMod.F90 +++ b/src/biogeochem/CNBalanceCheckMod.F90 @@ -10,7 +10,7 @@ module CNBalanceCheckMod use shr_log_mod , only : errMsg => shr_log_errMsg use decompMod , only : bounds_type, subgrid_level_gridcell, subgrid_level_column use abortutils , only : endrun - use clm_varctl , only : iulog, use_nitrif_denitrif, use_fates + use clm_varctl , only : iulog, use_nitrif_denitrif, use_fates_bgc use clm_time_manager , only : get_step_size_real use CNVegNitrogenFluxType , only : cnveg_nitrogenflux_type use CNVegNitrogenStateType , only : cnveg_nitrogenstate_type @@ -145,7 +145,7 @@ subroutine BeginCNGridcellBalance(this, bounds, cnveg_carbonflux_inst, & begg = bounds%begg; endg = bounds%endg - if(.not.use_fates)then + if(.not.use_fates_bgc)then call cnveg_carbonflux_inst%hrv_xsmrpool_to_atm_dribbler%get_amount_left_to_dribble_beg( & bounds, hrv_xsmrpool_amount_left_to_dribble(bounds%begg:bounds%endg)) @@ -409,7 +409,7 @@ subroutine CBalanceCheck(this, bounds, num_soilc, filter_soilc, & ! fluxes have entered the pools earlier in the timestep. For true ! conservation we would need to add a flux out of npp into seed. - if(.not.use_fates)then + if(.not.use_fates_bgc)then call cnveg_carbonflux_inst%hrv_xsmrpool_to_atm_dribbler%get_amount_left_to_dribble_end( & bounds, hrv_xsmrpool_amount_left_to_dribble(bounds%begg:bounds%endg)) call cnveg_carbonflux_inst%dwt_conv_cflux_dribbler%get_amount_left_to_dribble_end( & @@ -669,7 +669,7 @@ subroutine NBalanceCheck(this, bounds, num_soilc, filter_soilc, & call endrun(subgrid_index=c, subgrid_level=subgrid_level_column, msg=errMsg(sourcefile, __LINE__)) end if - if_notfates: if(.not.use_fates)then + if_notfates: if(.not.use_fates_bgc)then ! Repeat error check at the gridcell level call c2g( bounds = bounds, & diff --git a/src/biogeochem/CNCStateUpdate1Mod.F90 b/src/biogeochem/CNCStateUpdate1Mod.F90 index ba006b81a2..41051d0c39 100644 --- a/src/biogeochem/CNCStateUpdate1Mod.F90 +++ b/src/biogeochem/CNCStateUpdate1Mod.F90 @@ -269,7 +269,6 @@ subroutine CStateUpdate1( num_soilc, filter_soilc, num_soilp, filter_soilp, & end if end do - ! This filter omits FATES patches soilpatch_loop: do fp = 1,num_soilp p = filter_soilp(fp) c = patch%column(p) diff --git a/src/biogeochem/CNDriverMod.F90 b/src/biogeochem/CNDriverMod.F90 index 1e5b035f8d..5c77179d77 100644 --- a/src/biogeochem/CNDriverMod.F90 +++ b/src/biogeochem/CNDriverMod.F90 @@ -858,6 +858,12 @@ subroutine CNDriverNoLeaching(bounds, end if if_soilp2 + call c_products_inst%ComputeProductSummaryVars(bounds) + if (use_c13) call c13_products_inst%ComputeProductSummaryVars(bounds) + if (use_c14) call c14_products_inst%ComputeProductSummaryVars(bounds) + call n_products_inst%ComputeProductSummaryVars(bounds) + + call c_products_inst%ComputeSummaryVars(bounds) if (use_c13) call c13_products_inst%ComputeSummaryVars(bounds) if (use_c14) call c14_products_inst%ComputeSummaryVars(bounds) @@ -1124,7 +1130,7 @@ subroutine CNDriverSummarizeStates(bounds, num_allc, filter_allc, & call c13_soilbiogeochem_carbonstate_inst%summary(bounds, num_soilc, filter_soilc, c13_cnveg_carbonstate_inst) end if if ( use_c14 ) then - call c14_soilbiogeochem_carbonstate_inst%summary(bounds, num_soilc, filter_soilc, c13_cnveg_carbonstate_inst) + call c14_soilbiogeochem_carbonstate_inst%summary(bounds, num_soilc, filter_soilc, c14_cnveg_carbonstate_inst) end if diff --git a/src/biogeochem/CNPhenologyMod.F90 b/src/biogeochem/CNPhenologyMod.F90 index 4db642c58f..ec04fcbf54 100644 --- a/src/biogeochem/CNPhenologyMod.F90 +++ b/src/biogeochem/CNPhenologyMod.F90 @@ -406,7 +406,7 @@ subroutine CNPhenology (bounds, num_soilc, filter_soilc, num_soilp, & ! gather all patch-level litterfall fluxes to the column for litter C and N inputs - call CNLitterToColumn(bounds, num_soilc, filter_soilc, num_soilp, filter_soilp, & + call CNLitterToColumn(bounds, num_soilc, filter_soilc, & cnveg_state_inst, cnveg_carbonflux_inst, cnveg_nitrogenflux_inst, & leaf_prof_patch(bounds%begp:bounds%endp,1:nlevdecomp_full), & froot_prof_patch(bounds%begp:bounds%endp,1:nlevdecomp_full)) @@ -3384,8 +3384,8 @@ end subroutine CNCropHarvestToProductPools !----------------------------------------------------------------------- subroutine CNLitterToColumn (bounds, num_soilc, filter_soilc, & - num_soilp, filter_soilp, cnveg_state_inst,cnveg_carbonflux_inst, & - cnveg_nitrogenflux_inst, leaf_prof_patch, froot_prof_patch) + cnveg_state_inst,cnveg_carbonflux_inst, cnveg_nitrogenflux_inst, & + leaf_prof_patch, froot_prof_patch) ! ! !DESCRIPTION: ! called at the end of cn_phenology to gather all patch-level litterfall fluxes @@ -3400,8 +3400,6 @@ subroutine CNLitterToColumn (bounds, num_soilc, filter_soilc, & type(bounds_type) , intent(in) :: bounds integer , intent(in) :: num_soilc ! number of soil columns in filter integer , intent(in) :: filter_soilc(:) ! filter for soil columns - integer , intent(in) :: num_soilp ! number of patches in filter - integer , intent(in) :: filter_soilp(:) ! filter for patches type(cnveg_state_type) , intent(in) :: cnveg_state_inst type(cnveg_carbonflux_type) , intent(inout) :: cnveg_carbonflux_inst type(cnveg_nitrogenflux_type) , intent(inout) :: cnveg_nitrogenflux_inst @@ -3409,7 +3407,7 @@ subroutine CNLitterToColumn (bounds, num_soilc, filter_soilc, & real(r8) , intent(in) :: froot_prof_patch(bounds%begp:,1:) ! ! !LOCAL VARIABLES: - integer :: fc,c,pi,p,k,j,i,fp ! indices + integer :: fc,c,pi,p,k,j,i ! indices !----------------------------------------------------------------------- SHR_ASSERT_ALL_FL((ubound(leaf_prof_patch) == (/bounds%endp,nlevdecomp_full/)), sourcefile, __LINE__) @@ -3440,85 +3438,94 @@ subroutine CNLitterToColumn (bounds, num_soilc, filter_soilc, & phenology_n_to_litr_n => cnveg_nitrogenflux_inst%phenology_n_to_litr_n_col & ! Output: [real(r8) (:,:,:) ] N fluxes associated with phenology (litterfall and crop) to litter pools (gN/m3/s) ) - soil_loop: do j = 1, nlevdecomp - patch_loop: do fp = 1, num_soilp - p = filter_soilp(fp) - c = patch%column(p) - do i = i_litr_min, i_litr_max - ! leaf litter carbon fluxes - phenology_c_to_litr_c(c,j,i) = & - phenology_c_to_litr_c(c,j,i) + & - leafc_to_litter(p) * lf_f(ivt(p),i) * wtcol(p) * leaf_prof(p,j) - - ! leaf litter nitrogen fluxes - phenology_n_to_litr_n(c,j,i) = & - phenology_n_to_litr_n(c,j,i) + & - leafn_to_litter(p) * lf_f(ivt(p),i) * wtcol(p) * leaf_prof(p,j) - - ! fine root litter carbon fluxes - phenology_c_to_litr_c(c,j,i) = & - phenology_c_to_litr_c(c,j,i) + & - frootc_to_litter(p) * fr_f(ivt(p),i) * wtcol(p) * froot_prof(p,j) - - ! fine root litter nitrogen fluxes - phenology_n_to_litr_n(c,j,i) = & - phenology_n_to_litr_n(c,j,i) + & - frootn_to_litter(p) * fr_f(ivt(p),i) * wtcol(p) * froot_prof(p,j) - end do + do j = 1, nlevdecomp + do pi = 1,max_patch_per_col + do fc = 1,num_soilc + c = filter_soilc(fc) - ! agroibis puts crop stem litter together with leaf litter - ! so I've used the leaf lf_f* parameters instead of making - ! new ones for now (slevis) - ! also for simplicity I've put "food" into the litter pools - - if (ivt(p) >= npcropmin) then ! add livestemc to litter - do i = i_litr_min, i_litr_max - ! stem litter carbon fluxes - phenology_c_to_litr_c(c,j,i) = & - phenology_c_to_litr_c(c,j,i) + & - livestemc_to_litter(p) * lf_f(ivt(p),i) * wtcol(p) * leaf_prof(p,j) - - ! stem litter nitrogen fluxes - phenology_n_to_litr_n(c,j,i) = & - phenology_n_to_litr_n(c,j,i) + & - livestemn_to_litter(p) * lf_f(ivt(p),i) * wtcol(p) * leaf_prof(p,j) - end do - - if (.not. use_grainproduct) then - do i = i_litr_min, i_litr_max - do k = repr_grain_min, repr_grain_max - ! grain litter carbon fluxes + if ( pi <= col%npatches(c) ) then + p = col%patchi(c) + pi - 1 + if (patch%active(p)) then + + do i = i_litr_min, i_litr_max + ! leaf litter carbon fluxes phenology_c_to_litr_c(c,j,i) = & - phenology_c_to_litr_c(c,j,i) + & - repr_grainc_to_food(p,k) * lf_f(ivt(p),i) * wtcol(p) * leaf_prof(p,j) + phenology_c_to_litr_c(c,j,i) + & + leafc_to_litter(p) * lf_f(ivt(p),i) * wtcol(p) * leaf_prof(p,j) - ! grain litter nitrogen fluxes + ! leaf litter nitrogen fluxes phenology_n_to_litr_n(c,j,i) = & - phenology_n_to_litr_n(c,j,i) + & - repr_grainn_to_food(p,k) * lf_f(ivt(p),i) * wtcol(p) * leaf_prof(p,j) + phenology_n_to_litr_n(c,j,i) + & + leafn_to_litter(p) * lf_f(ivt(p),i) * wtcol(p) * leaf_prof(p,j) + + ! fine root litter carbon fluxes + phenology_c_to_litr_c(c,j,i) = & + phenology_c_to_litr_c(c,j,i) + & + frootc_to_litter(p) * fr_f(ivt(p),i) * wtcol(p) * froot_prof(p,j) + + ! fine root litter nitrogen fluxes + phenology_n_to_litr_n(c,j,i) = & + phenology_n_to_litr_n(c,j,i) + & + frootn_to_litter(p) * fr_f(ivt(p),i) * wtcol(p) * froot_prof(p,j) end do - end do + + ! agroibis puts crop stem litter together with leaf litter + ! so I've used the leaf lf_f* parameters instead of making + ! new ones for now (slevis) + ! also for simplicity I've put "food" into the litter pools + + if (ivt(p) >= npcropmin) then ! add livestemc to litter + do i = i_litr_min, i_litr_max + ! stem litter carbon fluxes + phenology_c_to_litr_c(c,j,i) = & + phenology_c_to_litr_c(c,j,i) + & + livestemc_to_litter(p) * lf_f(ivt(p),i) * wtcol(p) * leaf_prof(p,j) + + ! stem litter nitrogen fluxes + phenology_n_to_litr_n(c,j,i) = & + phenology_n_to_litr_n(c,j,i) + & + livestemn_to_litter(p) * lf_f(ivt(p),i) * wtcol(p) * leaf_prof(p,j) + end do + + if (.not. use_grainproduct) then + do i = i_litr_min, i_litr_max + do k = repr_grain_min, repr_grain_max + ! grain litter carbon fluxes + phenology_c_to_litr_c(c,j,i) = & + phenology_c_to_litr_c(c,j,i) + & + repr_grainc_to_food(p,k) * lf_f(ivt(p),i) * wtcol(p) * leaf_prof(p,j) + + ! grain litter nitrogen fluxes + phenology_n_to_litr_n(c,j,i) = & + phenology_n_to_litr_n(c,j,i) + & + repr_grainn_to_food(p,k) * lf_f(ivt(p),i) * wtcol(p) * leaf_prof(p,j) + end do + end do + end if + + do i = i_litr_min, i_litr_max + do k = repr_structure_min, repr_structure_max + ! reproductive structure litter carbon fluxes + phenology_c_to_litr_c(c,j,i) = & + phenology_c_to_litr_c(c,j,i) + & + repr_structurec_to_litter(p,k) * lf_f(ivt(p),i) * wtcol(p) * leaf_prof(p,j) + + ! reproductive structure litter nitrogen fluxes + phenology_n_to_litr_n(c,j,i) = & + phenology_n_to_litr_n(c,j,i) + & + repr_structuren_to_litter(p,k) * lf_f(ivt(p),i) * wtcol(p) * leaf_prof(p,j) + end do + end do + end if + end if end if - do i = i_litr_min, i_litr_max - do k = repr_structure_min, repr_structure_max - ! reproductive structure litter carbon fluxes - phenology_c_to_litr_c(c,j,i) = & - phenology_c_to_litr_c(c,j,i) + & - repr_structurec_to_litter(p,k) * lf_f(ivt(p),i) * wtcol(p) * leaf_prof(p,j) - - ! reproductive structure litter nitrogen fluxes - phenology_n_to_litr_n(c,j,i) = & - phenology_n_to_litr_n(c,j,i) + & - repr_structuren_to_litter(p,k) * lf_f(ivt(p),i) * wtcol(p) * leaf_prof(p,j) - end do - end do - end if + end do - end do patch_loop - end do soil_loop + end do + end do - end associate + end associate end subroutine CNLitterToColumn diff --git a/src/biogeochem/CNProductsMod.F90 b/src/biogeochem/CNProductsMod.F90 index 8ffbe6db2e..50e23d3fc6 100644 --- a/src/biogeochem/CNProductsMod.F90 +++ b/src/biogeochem/CNProductsMod.F90 @@ -1,4 +1,4 @@ -module CNProductsMod +Module CNProductsMod !----------------------------------------------------------------------- ! !DESCRIPTION: ! Calculate loss fluxes from wood products pools, and update product pool state variables @@ -58,13 +58,6 @@ module CNProductsMod real(r8), pointer :: prod100_loss_grc(:) ! (g[C or N]/m2/s) decomposition loss from 100-yr wood product pool real(r8), pointer :: tot_woodprod_loss_grc(:) ! (g[C or N]/m2/s) decompomposition loss from all wood product pools - ! Objects that help convert once-per-year dynamic land cover changes into fluxes - ! that are dribbled throughout the year - !type(annual_flux_dribbler_type) :: dwt_conv_cflux_dribbler - !type(annual_flux_dribbler_type) :: hrv_xsmrpool_to_atm_dribbler - !logical, private :: dribble_crophrv_xsmrpool_2atm - - contains ! Infrastructure routines @@ -79,6 +72,7 @@ module CNProductsMod procedure, public :: UpdateProducts procedure, private :: PartitionWoodFluxes procedure, private :: PartitionCropFluxes + procedure, public :: ComputeProductSummaryVars procedure, public :: ComputeSummaryVars end type cn_products_type @@ -158,17 +152,6 @@ subroutine InitAllocate(this, bounds) allocate(this%tot_woodprod_loss_grc(begg:endg)) ; this%tot_woodprod_loss_grc(:) = nan allocate(this%product_loss_grc(begg:endg)) ; this%product_loss_grc(:) = nan - !this%dwt_conv_cflux_dribbler = annual_flux_dribbler_gridcell( & - ! bounds = bounds, & - ! name = 'dwt_conv_flux_' // carbon_type_suffix, & - ! units = 'gC/m^2', & - ! allows_non_annual_delta = allows_non_annual_delta) - !this%hrv_xsmrpool_to_atm_dribbler = annual_flux_dribbler_gridcell( & - ! bounds = bounds, & - ! name = 'hrv_xsmrpool_to_atm_' // carbon_type_suffix, & - ! units = 'gC/m^2', & - ! allows_non_annual_delta = .false.) - end subroutine InitAllocate subroutine SetValues(this, bounds, setval) @@ -700,30 +683,18 @@ subroutine PartitionCropFluxes(this, bounds, & end subroutine PartitionCropFluxes - !----------------------------------------------------------------------- - subroutine ComputeSummaryVars(this, bounds) - ! - ! !DESCRIPTION: - ! Compute summary variables in this object: sums across multiple product pools - ! - ! !USES: - ! - ! !ARGUMENTS: + subroutine ComputeProductSummaryVars(this, bounds) + class(cn_products_type) , intent(inout) :: this type(bounds_type) , intent(in) :: bounds - ! - ! !LOCAL VARIABLES: + integer :: g ! indices real(r8) :: dt ! time step (seconds) real(r8) :: kprod1 ! decay constant for 1-year product pool real(r8) :: kprod10 ! decay constant for 10-year product pool real(r8) :: kprod100 ! decay constant for 100-year product pool - !----------------------------------------------------------------------- - character(len=*), parameter :: subname = 'ComputeSummaryVars' - - !----------------------------------------------------------------------- ! calculate losses from product pools ! the following (1/s) rate constants result in ~90% loss of initial state over 1, 10 and 100 years, ! respectively, using a discrete-time fractional decay algorithm. @@ -758,9 +729,29 @@ subroutine ComputeSummaryVars(this, bounds) this%cropprod1_grc(g) = this%cropprod1_grc(g) - this%cropprod1_loss_grc(g)*dt this%prod10_grc(g) = this%prod10_grc(g) - this%prod10_loss_grc(g)*dt this%prod100_grc(g) = this%prod100_grc(g) - this%prod100_loss_grc(g)*dt - end do + return + end subroutine ComputeProductSummaryVars + + + !----------------------------------------------------------------------- + subroutine ComputeSummaryVars(this, bounds) + ! + ! !DESCRIPTION: + ! Compute summary variables in this object: sums across multiple product pools + ! + ! !USES: + ! + ! !ARGUMENTS: + class(cn_products_type) , intent(inout) :: this + type(bounds_type) , intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + integer :: g ! indices + !----------------------------------------------------------------------- + character(len=*), parameter :: subname = 'ComputeSummaryVars' + do g = bounds%begg, bounds%endg ! total wood products diff --git a/src/main/filterMod.F90 b/src/main/filterMod.F90 index db82b665ec..2542dab1ca 100644 --- a/src/main/filterMod.F90 +++ b/src/main/filterMod.F90 @@ -19,7 +19,7 @@ module filterMod use ColumnType , only : col use PatchType , only : patch use glcBehaviorMod , only : glc_behavior_type - use clm_varctl , only : use_cn, use_fates, use_fates_sp + use clm_varctl , only : use_cn, use_fates_bgc ! ! !PUBLIC TYPES: implicit none @@ -396,7 +396,7 @@ subroutine setFiltersOneGroup(bounds, this_filter, include_inactive, glc_behavio ! Create the soil bgc filter, all non-sp columns for vegetation fs = 0 - if( use_cn .or. (use_fates .and. .not.use_fates_sp))then + if( use_cn .or. use_fates_bgc )then do c = bounds%begc,bounds%endc if (col%active(c) .or. include_inactive) then l =col%landunit(c) diff --git a/src/soilbiogeochem/SoilBiogeochemCarbonFluxType.F90 b/src/soilbiogeochem/SoilBiogeochemCarbonFluxType.F90 index 3a311807a9..4bd9c5e0e5 100644 --- a/src/soilbiogeochem/SoilBiogeochemCarbonFluxType.F90 +++ b/src/soilbiogeochem/SoilBiogeochemCarbonFluxType.F90 @@ -889,21 +889,22 @@ subroutine Summary(this, bounds, & end associate ! total heterotrophic respiration (HR) - do fc = 1,num_soilc - c = filter_soilc(fc) + do fc = 1,num_soilc + c = filter_soilc(fc) - this%hr_col(c) = & - this%michr_col(c) + & - this%cwdhr_col(c) + & - this%lithr_col(c) + & - this%somhr_col(c) + this%hr_col(c) = & + this%michr_col(c) + & + this%cwdhr_col(c) + & + this%lithr_col(c) + & + this%somhr_col(c) - end do + end do ! Calculate ligninNratio ! FATES does its own calculation - if (decomp_method == mimics_decomp .and. num_soilp>0) then + if_mimics: if (decomp_method == mimics_decomp ) then + if(num_soilp>0)then do fp = 1,num_soilp p = filter_soilp(fp) associate(ivt => patch%itype) ! Input: [integer (:)] patch plant type @@ -929,6 +930,8 @@ subroutine Summary(this, bounds, & frootc_to_litter_patch(bounds%begp:bounds%endp), & frootc_to_litter_col(bounds%begc:bounds%endc)) + end if + ! Calculate ligninNratioAve do fc = 1,num_soilc c = filter_soilc(fc) @@ -946,9 +949,11 @@ subroutine Summary(this, bounds, & max(1.0e-3_r8, leafc_to_litter_col(c) + & frootc_to_litter_col(c) + & soilbiogeochem_decomp_cascade_ctransfer_col(c,i_cwdl2)) + !else + ! Alternative place to hook in fates litr lignan end if end do - end if + end if if_mimics end subroutine Summary diff --git a/src/soilbiogeochem/SoilBiogeochemNitrogenStateType.F90 b/src/soilbiogeochem/SoilBiogeochemNitrogenStateType.F90 index 435e6c327c..ac7fa52b44 100644 --- a/src/soilbiogeochem/SoilBiogeochemNitrogenStateType.F90 +++ b/src/soilbiogeochem/SoilBiogeochemNitrogenStateType.F90 @@ -999,8 +999,6 @@ subroutine Summary(this, bounds, num_soilc, filter_soilc, cnveg_nitrogenstate_in end if end do - - ! total sminn do fc = 1,num_soilc c = filter_soilc(fc) From 79a77d6eb3e3ca1b16e8abb29a68b844221bc4ee Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Thu, 16 Mar 2023 11:08:58 -0600 Subject: [PATCH 064/257] cleanup of fates-bgc coupling --- src/biogeochem/CNProductsMod.F90 | 8 +-- src/main/filterMod.F90 | 2 +- .../SoilBiogeochemCarbonFluxType.F90 | 52 +++++++++---------- 3 files changed, 28 insertions(+), 34 deletions(-) diff --git a/src/biogeochem/CNProductsMod.F90 b/src/biogeochem/CNProductsMod.F90 index 50e23d3fc6..b6af2a6358 100644 --- a/src/biogeochem/CNProductsMod.F90 +++ b/src/biogeochem/CNProductsMod.F90 @@ -1,4 +1,4 @@ -Module CNProductsMod +module CNProductsMod !----------------------------------------------------------------------- ! !DESCRIPTION: ! Calculate loss fluxes from wood products pools, and update product pool state variables @@ -13,8 +13,6 @@ Module CNProductsMod use clm_time_manager , only : get_step_size_real use SpeciesBaseType , only : species_base_type use PatchType , only : patch - use AnnualFluxDribbler , only : annual_flux_dribbler_type - use AnnualFluxDribbler , only : annual_flux_dribbler_gridcell ! implicit none private @@ -173,10 +171,6 @@ subroutine SetValues(this, bounds, setval) this%hrv_deadstem_to_prod10_grc(bounds%begg:bounds%endg) = setval this%hrv_deadstem_to_prod100_grc(bounds%begg:bounds%endg) = setval - !this%cropprod1_loss_grc(bounds%begg:bounds%endg) = setval - !this%prod10_loss_grc(bounds%begg:bounds%endg) = setval - !this%prod100_loss_grc(bounds%begg:bounds%endg) = setval - return end subroutine SetValues diff --git a/src/main/filterMod.F90 b/src/main/filterMod.F90 index 2542dab1ca..d96cb63a30 100644 --- a/src/main/filterMod.F90 +++ b/src/main/filterMod.F90 @@ -19,7 +19,7 @@ module filterMod use ColumnType , only : col use PatchType , only : patch use glcBehaviorMod , only : glc_behavior_type - use clm_varctl , only : use_cn, use_fates_bgc + use clm_varctl , only : use_cn, use_fates, use_fates_bgc ! ! !PUBLIC TYPES: implicit none diff --git a/src/soilbiogeochem/SoilBiogeochemCarbonFluxType.F90 b/src/soilbiogeochem/SoilBiogeochemCarbonFluxType.F90 index 4bd9c5e0e5..9d47c188be 100644 --- a/src/soilbiogeochem/SoilBiogeochemCarbonFluxType.F90 +++ b/src/soilbiogeochem/SoilBiogeochemCarbonFluxType.F90 @@ -6,7 +6,7 @@ module SoilBiogeochemCarbonFluxType use clm_varpar , only : ndecomp_cascade_transitions, ndecomp_pools, nlevcan use clm_varpar , only : nlevdecomp_full, nlevgrnd, nlevdecomp, nlevsoi, i_cwdl2 use clm_varcon , only : spval, ispval, dzsoi_decomp - use clm_varctl , only : use_fates + use clm_varctl , only : use_fates,use_cn use pftconMod , only : pftcon use landunit_varcon , only : istsoil, istcrop, istdlak use ch4varcon , only : allowlakeprod @@ -905,31 +905,31 @@ subroutine Summary(this, bounds, & if_mimics: if (decomp_method == mimics_decomp ) then if(num_soilp>0)then - do fp = 1,num_soilp - p = filter_soilp(fp) - associate(ivt => patch%itype) ! Input: [integer (:)] patch plant type - ligninNratio_leaf_patch(p) = pftcon%lf_flig(ivt(p)) * & - pftcon%lflitcn(ivt(p)) * & - leafc_to_litter_patch(p) - ligninNratio_froot_patch(p) = pftcon%fr_flig(ivt(p)) * & - pftcon%frootcn(ivt(p)) * & - frootc_to_litter_patch(p) - end associate - end do - - call p2c(bounds, num_soilc, filter_soilc, & - ligninNratio_leaf_patch(bounds%begp:bounds%endp), & - ligninNratio_leaf_col(bounds%begc:bounds%endc)) - call p2c(bounds, num_soilc, filter_soilc, & - ligninNratio_froot_patch(bounds%begp:bounds%endp), & - ligninNratio_froot_col(bounds%begc:bounds%endc)) - call p2c(bounds, num_soilc, filter_soilc, & - leafc_to_litter_patch(bounds%begp:bounds%endp), & - leafc_to_litter_col(bounds%begc:bounds%endc)) - call p2c(bounds, num_soilc, filter_soilc, & - frootc_to_litter_patch(bounds%begp:bounds%endp), & - frootc_to_litter_col(bounds%begc:bounds%endc)) - + do fp = 1,num_soilp + p = filter_soilp(fp) + associate(ivt => patch%itype) ! Input: [integer (:)] patch plant type + ligninNratio_leaf_patch(p) = pftcon%lf_flig(ivt(p)) * & + pftcon%lflitcn(ivt(p)) * & + leafc_to_litter_patch(p) + ligninNratio_froot_patch(p) = pftcon%fr_flig(ivt(p)) * & + pftcon%frootcn(ivt(p)) * & + frootc_to_litter_patch(p) + end associate + end do + + call p2c(bounds, num_soilc, filter_soilc, & + ligninNratio_leaf_patch(bounds%begp:bounds%endp), & + ligninNratio_leaf_col(bounds%begc:bounds%endc)) + call p2c(bounds, num_soilc, filter_soilc, & + ligninNratio_froot_patch(bounds%begp:bounds%endp), & + ligninNratio_froot_col(bounds%begc:bounds%endc)) + call p2c(bounds, num_soilc, filter_soilc, & + leafc_to_litter_patch(bounds%begp:bounds%endp), & + leafc_to_litter_col(bounds%begc:bounds%endc)) + call p2c(bounds, num_soilc, filter_soilc, & + frootc_to_litter_patch(bounds%begp:bounds%endp), & + frootc_to_litter_col(bounds%begc:bounds%endc)) + end if ! Calculate ligninNratioAve From ff923e116d6ea3545bfb8f3399ac5f0af784444f Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Thu, 25 May 2023 11:06:31 -0400 Subject: [PATCH 065/257] FATES in the normal bgc call sequence, addressing reviewer comments --- src/biogeochem/CNVegCarbonStateType.F90 | 5 +-- src/main/clm_driver.F90 | 3 ++ src/main/controlMod.F90 | 5 +++ src/main/filterMod.F90 | 18 +++++----- .../SoilBiogeochemCarbonFluxType.F90 | 9 +++-- .../SoilBiogeochemNitrogenFluxType.F90 | 4 ++- .../SoilBiogeochemVerticalProfileMod.F90 | 33 ++++++++++--------- src/utils/clmfates_interfaceMod.F90 | 9 ----- 8 files changed, 46 insertions(+), 40 deletions(-) diff --git a/src/biogeochem/CNVegCarbonStateType.F90 b/src/biogeochem/CNVegCarbonStateType.F90 index 5baf1bce0b..b2ca4c4792 100644 --- a/src/biogeochem/CNVegCarbonStateType.F90 +++ b/src/biogeochem/CNVegCarbonStateType.F90 @@ -82,8 +82,9 @@ module CNVegCarbonStateType real(r8), pointer :: dispvegc_patch (:) ! (gC/m2) displayed veg carbon, excluding storage and cpool real(r8), pointer :: storvegc_patch (:) ! (gC/m2) stored vegetation carbon, excluding cpool - logical, private :: dribble_crophrv_xsmrpool_2atm - + logical, private :: dribble_crophrv_xsmrpool_2atm ! Flag to indicate if should harvest xsmrpool to the atmosphere + ! it originates and is defined in CNVegetationFacade.F90 + ! Total C pools real(r8), pointer :: totc_patch (:) ! (gC/m2) total patch-level carbon, including cpool real(r8), pointer :: totvegc_patch (:) ! (gC/m2) total vegetation carbon, excluding cpool diff --git a/src/main/clm_driver.F90 b/src/main/clm_driver.F90 index e54535c09e..5fb0d233ec 100644 --- a/src/main/clm_driver.F90 +++ b/src/main/clm_driver.F90 @@ -288,6 +288,8 @@ subroutine clm_drv(doalb, nextsw_cday, declinp1, declin, rstwr, nlend, rdate, ro call active_layer_inst%alt_calc(filter_inactive_and_active(nc)%num_soilc, filter_inactive_and_active(nc)%soilc, & temperature_inst) + ! Filter bgc_soilc operates on all non-sp soil columns + ! Filter bgc_vegp operates on all non-fates, non-sp patches (use_cn) on soil if ((use_cn .or. use_fates_bgc) .and. decomp_method /= no_soil_decomp) then call SoilBiogeochemVerticalProfile(bounds_clump , & filter_inactive_and_active(nc)%num_bgc_soilc, filter_inactive_and_active(nc)%bgc_soilc , & @@ -1080,6 +1082,7 @@ subroutine clm_drv(doalb, nextsw_cday, declinp1, declin, rstwr, nlend, rdate, ro call t_stopf('hydro2_drainage') + if (use_cn .or. use_fates_bgc) then call t_startf('EcosysDynPostDrainage') call bgc_vegetation_inst%EcosystemDynamicsPostDrainage(bounds_clump, & diff --git a/src/main/controlMod.F90 b/src/main/controlMod.F90 index 99d7f3c835..c793898d5e 100644 --- a/src/main/controlMod.F90 +++ b/src/main/controlMod.F90 @@ -473,6 +473,11 @@ subroutine control_init(dtime) errMsg(sourcefile, __LINE__)) end if + if (use_c13 .or. use_c14) then + call endrun(msg=' ERROR: C13 and C14 dynamics are not compatible with FATES.'//& + errMsg(sourcefile, __LINE__)) + end if + else ! These do default to false anyway, but this emphasizes they diff --git a/src/main/filterMod.F90 b/src/main/filterMod.F90 index d96cb63a30..0b7d230a54 100644 --- a/src/main/filterMod.F90 +++ b/src/main/filterMod.F90 @@ -478,16 +478,14 @@ subroutine setFiltersOneGroup(bounds, this_filter, include_inactive, glc_behavio fnl = 0 do p = bounds%begp,bounds%endp if (patch%active(p) .or. include_inactive) then - if(.not.use_fates)then ! This needs to be a FATES filter - if (patch%itype(p) >= npcropmin) then !skips 2 generic crop types - fl = fl + 1 - this_filter(nc)%pcropp(fl) = p - else - l =patch%landunit(p) - if (lun%itype(l) == istsoil .or. lun%itype(l) == istcrop) then - fnl = fnl + 1 - this_filter(nc)%soilnopcropp(fnl) = p - end if + if (patch%itype(p) >= npcropmin) then !skips 2 generic crop types + fl = fl + 1 + this_filter(nc)%pcropp(fl) = p + else + l =patch%landunit(p) + if (lun%itype(l) == istsoil .or. lun%itype(l) == istcrop) then + fnl = fnl + 1 + this_filter(nc)%soilnopcropp(fnl) = p end if end if end if diff --git a/src/soilbiogeochem/SoilBiogeochemCarbonFluxType.F90 b/src/soilbiogeochem/SoilBiogeochemCarbonFluxType.F90 index 9d47c188be..985a97eacc 100644 --- a/src/soilbiogeochem/SoilBiogeochemCarbonFluxType.F90 +++ b/src/soilbiogeochem/SoilBiogeochemCarbonFluxType.F90 @@ -58,7 +58,10 @@ module SoilBiogeochemCarbonFluxType real(r8), pointer :: lithr_col (:) ! (gC/m2/s) litter heterotrophic respiration: donor-pool based definition real(r8), pointer :: somhr_col (:) ! (gC/m2/s) soil organic matter heterotrophic res: donor-pool based definition real(r8), pointer :: soilc_change_col (:) ! (gC/m2/s) FUN used soil C - real(r8), pointer :: fates_litter_flux (:) ! (gC/m2/s) Litter flux passed in from FATES + real(r8), pointer :: fates_litter_flux (:) ! (gC/m2/s) A summary of the total litter + ! flux passed in from FATES. + ! This is a diagnostic for balance checks only + contains @@ -950,7 +953,9 @@ subroutine Summary(this, bounds, & frootc_to_litter_col(c) + & soilbiogeochem_decomp_cascade_ctransfer_col(c,i_cwdl2)) !else - ! Alternative place to hook in fates litr lignan + ! For FATES: + ! this array is currently updated here: + ! clmfates_interfaceMod.F90:wrap_update_hlmfates_dyn() end if end do end if if_mimics diff --git a/src/soilbiogeochem/SoilBiogeochemNitrogenFluxType.F90 b/src/soilbiogeochem/SoilBiogeochemNitrogenFluxType.F90 index 90ba4512c7..99ce2e7cf9 100644 --- a/src/soilbiogeochem/SoilBiogeochemNitrogenFluxType.F90 +++ b/src/soilbiogeochem/SoilBiogeochemNitrogenFluxType.F90 @@ -128,7 +128,9 @@ module SoilBiogeochemNitrogenFluxType real(r8), pointer :: decomp_npools_sourcesink_col (:,:,:) ! col (gN/m3) change in decomposing n pools ! (sum of all additions and subtractions from stateupdate1). real(r8), pointer :: sminn_to_plant_fun_vr_col (:,:) ! col total layer soil N uptake of FUN (gN/m2/s) - real(r8), pointer :: fates_litter_flux (:) ! (gN/m2/s) Litter flux passed in from FATES + real(r8), pointer :: fates_litter_flux (:) ! (gN/m2/s) A summary of the total litter + ! flux passed in from FATES. + ! This is a diagnostic for balance checks only ! track tradiagonal matrix contains diff --git a/src/soilbiogeochem/SoilBiogeochemVerticalProfileMod.F90 b/src/soilbiogeochem/SoilBiogeochemVerticalProfileMod.F90 index 772c2db82e..3548643192 100644 --- a/src/soilbiogeochem/SoilBiogeochemVerticalProfileMod.F90 +++ b/src/soilbiogeochem/SoilBiogeochemVerticalProfileMod.F90 @@ -174,28 +174,29 @@ subroutine SoilBiogeochemVerticalProfile(bounds, num_soilc,filter_soilc,num_soil ! cinput_rootfr(bounds%begp:bounds%endp, :), & ! col_cinput_rootfr(bounds%begc:bounds%endc, :), & ! 'unity') - if(num_soilp>0)then - do pi = 1,maxsoil_patches - do fc = 1,num_soilc - c = filter_soilc(fc) - if(.not.col%is_fates(c))then - if (pi <= col%npatches(c)) then - p = col%patchi(c) + pi - 1 - do j = 1,nlevdecomp - col_cinput_rootfr(c,j) = col_cinput_rootfr(c,j) + cinput_rootfr(p,j) * patch%wtcol(p) - end do - end if - end if - end do + + !if(num_soilp>0)then + do fc = 1,num_soilc + c = filter_soilc(fc) + if(.not.col%is_fates(c))then + do pi = 1,col%npatches(c)) !maxsoil_patches + !if (pi <= col%npatches(c)) then + p = col%patchi(c) + pi - 1 + do j = 1,nlevdecomp + col_cinput_rootfr(c,j) = col_cinput_rootfr(c,j) + cinput_rootfr(p,j) * patch%wtcol(p) + end do + !end if + end if end do - end if + end do + !end if ! repeat for column-native profiles: Ndep and Nfix do fc = 1,num_soilc c = filter_soilc(fc) rootfr_tot = 0._r8 surface_prof_tot = 0._r8 - if(col%is_fates(c))then + if_fates: if(col%is_fates(c))then ! For FATES, we just use the e-folding depth for both fixation and deposition ! partially because the fixation may be free-living depending on FATES-side ! fixation choices, and partially for simplicity @@ -226,7 +227,7 @@ subroutine SoilBiogeochemVerticalProfile(bounds, num_soilc,filter_soilc,num_soil nfixation_prof(c,1) = 1./dzsoi_decomp(1) ndep_prof(c,1) = 1./dzsoi_decomp(1) endif - end if + end if if_fates end do ! check to make sure integral of all profiles = 1. diff --git a/src/utils/clmfates_interfaceMod.F90 b/src/utils/clmfates_interfaceMod.F90 index 0ac24f897c..e288646e43 100644 --- a/src/utils/clmfates_interfaceMod.F90 +++ b/src/utils/clmfates_interfaceMod.F90 @@ -1204,15 +1204,6 @@ subroutine UpdateCLitterFluxes(this,soilbiogeochem_carbonflux_inst,ci,c) cf_soil%fates_litter_flux = 0._r8 end if - ! This is a diagnostic for carbon accounting (NOT IN CLM, ONLY ELM) - !col_cf%litfall(c) = & - ! sum(this%fates(ci)%bc_out(s)%litt_flux_lab_c_si(1:nlevdecomp) * & - ! this%fates(ci)%bc_in(s)%dz_decomp_sisl(1:nlevdecomp)) + & - ! sum(this%fates(ci)%bc_out(s)%litt_flux_cel_c_si(1:nlevdecomp) * & - ! this%fates(ci)%bc_in(s)%dz_decomp_sisl(1:nlevdecomp)) + & - ! sum(this%fates(ci)%bc_out(s)%litt_flux_lig_c_si(1:nlevdecomp) * ^ - ! this%fates(ci)%bc_in(s)%dz_decomp_sisl(1:nlevdecomp)) - end associate return From 158b182c2eef2afb815bee41e63f8b14728c30a9 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Thu, 25 May 2023 13:41:15 -0400 Subject: [PATCH 066/257] Part-way through re-name-spacing the soilc and soilp filters for BGC --- src/biogeochem/CNAnnualUpdateMod.F90 | 24 +- src/biogeochem/CNDriverMod.F90 | 278 +++++++++--------- src/biogeochem/CNFireEmissionsMod.F90 | 10 +- src/biogeochem/CNPrecisionControlMod.F90 | 100 +++---- src/biogeochem/CNVegCarbonStateType.F90 | 18 +- src/biogeochem/CNVegetationFacade.F90 | 84 +++--- src/main/clm_driver.F90 | 2 +- .../SoilBiogeochemCarbonFluxType.F90 | 66 ++--- .../SoilBiogeochemCarbonStateType.F90 | 86 +++--- .../SoilBiogeochemCompetitionMod.F90 | 164 +++++------ .../SoilBiogeochemDecompCascadeBGCMod.F90 | 66 ++--- .../SoilBiogeochemDecompCascadeMIMICSMod.F90 | 48 +-- .../SoilBiogeochemDecompMod.F90 | 34 +-- .../SoilBiogeochemLittVertTranspMod.F90 | 52 ++-- .../SoilBiogeochemNLeachingMod.F90 | 30 +- .../SoilBiogeochemNStateUpdate1Mod.F90 | 42 +-- .../SoilBiogeochemNitrifDenitrifMod.F90 | 10 +- .../SoilBiogeochemNitrogenFluxType.F90 | 54 ++-- .../SoilBiogeochemNitrogenStateType.F90 | 102 +++---- .../SoilBiogeochemNitrogenUptakeMod.F90 | 18 +- .../SoilBiogeochemPotentialMod.F90 | 42 +-- .../SoilBiogeochemPrecisionControlMod.F90 | 14 +- .../SoilBiogeochemVerticalProfileMod.F90 | 36 +-- 23 files changed, 690 insertions(+), 690 deletions(-) diff --git a/src/biogeochem/CNAnnualUpdateMod.F90 b/src/biogeochem/CNAnnualUpdateMod.F90 index 34324e4c93..956042db63 100644 --- a/src/biogeochem/CNAnnualUpdateMod.F90 +++ b/src/biogeochem/CNAnnualUpdateMod.F90 @@ -22,7 +22,7 @@ module CNAnnualUpdateMod contains !----------------------------------------------------------------------- - subroutine CNAnnualUpdate(bounds, num_soilc, filter_soilc, num_soilp, filter_soilp, & + subroutine CNAnnualUpdate(bounds, num_bgc_soilc, filter_bgc_soilc, num_bgc_vegp, filter_bgc_vegp, & cnveg_state_inst, cnveg_carbonflux_inst) ! ! !DESCRIPTION: @@ -35,10 +35,10 @@ subroutine CNAnnualUpdate(bounds, num_soilc, filter_soilc, num_soilp, filter_soi ! ! !ARGUMENTS: type(bounds_type) , intent(in) :: bounds - integer , intent(in) :: num_soilc ! number of soil columns in filter - integer , intent(in) :: filter_soilc(:) ! filter for soil columns - integer , intent(in) :: num_soilp ! number of soil patches in filter - integer , intent(in) :: filter_soilp(:) ! filter for soil patches + integer , intent(in) :: num_bgc_soilc ! number of bgc soil columns in filter + integer , intent(in) :: filter_bgc_soilc(:) ! filter for bgc soil columns + integer , intent(in) :: num_bgc_vegp ! number of bgc veg patches in filter + integer , intent(in) :: filter_bgc_vegp(:) ! filter for bgc veg patches type(cnveg_state_type) , intent(inout) :: cnveg_state_inst type(cnveg_carbonflux_type) , intent(inout) :: cnveg_carbonflux_inst ! @@ -54,8 +54,8 @@ subroutine CNAnnualUpdate(bounds, num_soilc, filter_soilc, num_soilp, filter_soi dt = get_step_size_real() secspyear = get_curr_days_per_year() * secspday - do fc = 1,num_soilc - c = filter_soilc(fc) + do fc = 1,num_bgc_soilc + c = filter_bgc_soilc(fc) if(.not.col%is_fates(c))then cnveg_state_inst%annsum_counter_col(c) = cnveg_state_inst%annsum_counter_col(c) + dt if (cnveg_state_inst%annsum_counter_col(c) >= secspyear) then @@ -68,8 +68,8 @@ subroutine CNAnnualUpdate(bounds, num_soilc, filter_soilc, num_soilp, filter_soi end do - do fp = 1,num_soilp - p = filter_soilp(fp) + do fp = 1,num_bgc_vegp + p = filter_bgc_vegp(fp) c = patch%column(p) if (end_of_year(c) .and. .not.col%is_fates(c)) then @@ -98,11 +98,11 @@ subroutine CNAnnualUpdate(bounds, num_soilc, filter_soilc, num_soilp, filter_soi end do ! Get column-level averages, just for the columns that have reached their personal end-of-year - if(num_soilp>0)then + if(num_bgc_vegp>0)then filter_endofyear_c = col_filter_from_filter_and_logical_array( & bounds = bounds, & - num_orig = num_soilc, & - filter_orig = filter_soilc, & + num_orig = num_bgc_soilc, & + filter_orig = filter_bgc_soilc, & logical_col = end_of_year(bounds%begc:bounds%endc)) call p2c(bounds, filter_endofyear_c%num, filter_endofyear_c%indices, & diff --git a/src/biogeochem/CNDriverMod.F90 b/src/biogeochem/CNDriverMod.F90 index 5c77179d77..c63452e76d 100644 --- a/src/biogeochem/CNDriverMod.F90 +++ b/src/biogeochem/CNDriverMod.F90 @@ -85,7 +85,7 @@ end subroutine CNDriverInit !----------------------------------------------------------------------- subroutine CNDriverNoLeaching(bounds, & - num_soilc, filter_soilc, num_soilp, filter_soilp, & + num_bgc_soilc, filter_bgc_soilc, num_bgc_vegp, filter_bgc_vegp, & num_pcropp, filter_pcropp, num_soilnopcropp, filter_soilnopcropp, & num_actfirec, filter_actfirec, num_actfirep, filter_actfirep, & num_exposedvegp, filter_exposedvegp, num_noexposedvegp, filter_noexposedvegp, & @@ -151,10 +151,10 @@ subroutine CNDriverNoLeaching(bounds, ! ! !ARGUMENTS: type(bounds_type) , intent(in) :: bounds - integer , intent(in) :: num_soilc ! number of soil columns in filter - integer , intent(in) :: filter_soilc(:) ! filter for soil columns - integer , intent(in) :: num_soilp ! number of veg patches in filter - integer , intent(in) :: filter_soilp(:) ! filter for veg patches + integer , intent(in) :: num_bgc_soilc ! number of soil columns in filter + integer , intent(in) :: filter_bgc_soilc(:) ! filter for soil columns + integer , intent(in) :: num_bgc_vegp ! number of veg patches in filter + integer , intent(in) :: filter_bgc_vegp(:) ! filter for veg patches integer , intent(out) :: num_actfirep ! number of soil patches on fire in filter integer , intent(out) :: filter_actfirep(:) ! filter for soil patches on fire integer , intent(out) :: num_actfirec ! number of soil columns on fire in filter @@ -246,50 +246,50 @@ subroutine CNDriverNoLeaching(bounds, ! COMPILER_BUG(wjs, 2014-11-29, pgi 14.7) Without this, the filter is full of garbage ! in some situations call t_startf('CNZero-soilbgc-cflux') - dummy_to_make_pgi_happy = ubound(filter_soilc, 1) + dummy_to_make_pgi_happy = ubound(filter_bgc_soilc, 1) call soilbiogeochem_carbonflux_inst%SetValues( & - num_soilc, filter_soilc, 0._r8) + num_bgc_soilc, filter_bgc_soilc, 0._r8) if ( use_c13 ) then call c13_soilbiogeochem_carbonflux_inst%SetValues( & - num_soilc, filter_soilc, 0._r8) + num_bgc_soilc, filter_bgc_soilc, 0._r8) end if if ( use_c14 ) then call c14_soilbiogeochem_carbonflux_inst%SetValues( & - num_soilc, filter_soilc, 0._r8) + num_bgc_soilc, filter_bgc_soilc, 0._r8) end if call t_stopf('CNZero-soilbgc-cflux') - if(num_soilp>0)then + if(num_bgc_vegp>0)then call t_startf('CNZero-vegbgc-cflux') call cnveg_carbonflux_inst%SetValues( & nvegcpool,& - num_soilp, filter_soilp, 0._r8, & - num_soilc, filter_soilc, 0._r8) + num_bgc_vegp, filter_bgc_vegp, 0._r8, & + num_bgc_soilc, filter_bgc_soilc, 0._r8) if ( use_c13 ) then call c13_cnveg_carbonflux_inst%SetValues( & nvegcpool,& - num_soilp, filter_soilp, 0._r8, & - num_soilc, filter_soilc, 0._r8) + num_bgc_vegp, filter_bgc_vegp, 0._r8, & + num_bgc_soilc, filter_bgc_soilc, 0._r8) end if if ( use_c14 ) then call c14_cnveg_carbonflux_inst%SetValues( & nvegcpool,& - num_soilp, filter_soilp, 0._r8, & - num_soilc, filter_soilc, 0._r8) + num_bgc_vegp, filter_bgc_vegp, 0._r8, & + num_bgc_soilc, filter_bgc_soilc, 0._r8) end if call t_stopf('CNZero-vegbgc-cflux') call t_startf('CNZero-vegbgc-nflux') call cnveg_nitrogenflux_inst%SetValues( & nvegnpool, & - num_soilp, filter_soilp, 0._r8, & - num_soilc, filter_soilc, 0._r8) + num_bgc_vegp, filter_bgc_vegp, 0._r8, & + num_bgc_soilc, filter_bgc_soilc, 0._r8) end if call t_stopf('CNZero-vegbgc-nflux') call t_startf('CNZero-soilbgc-nflux') call soilbiogeochem_nitrogenflux_inst%SetValues( & - num_soilc, filter_soilc, 0._r8) + num_bgc_soilc, filter_bgc_soilc, 0._r8) call t_stopf('CNZero-soilbgc-nflux') call t_stopf('CNZero') @@ -305,12 +305,12 @@ subroutine CNDriverNoLeaching(bounds, if(use_fun)then call t_startf('CNFLivFixation') - call CNFreeLivingFixation( num_soilc, filter_soilc, & + call CNFreeLivingFixation( num_bgc_soilc, filter_bgc_soilc, & waterfluxbulk_inst, soilbiogeochem_nitrogenflux_inst) call t_stopf('CNFLivFixation') else call t_startf('CNFixation') - call CNNFixation( num_soilc, filter_soilc, & + call CNNFixation( num_bgc_soilc, filter_bgc_soilc, & cnveg_carbonflux_inst, soilbiogeochem_nitrogenflux_inst, & clm_fates, bounds%clump_index) call t_stopf('CNFixation') @@ -318,18 +318,18 @@ subroutine CNDriverNoLeaching(bounds, if (use_crop) then - call CNNFert(bounds, num_soilc,filter_soilc, & + call CNNFert(bounds, num_bgc_soilc,filter_bgc_soilc, & cnveg_nitrogenflux_inst, soilbiogeochem_nitrogenflux_inst) if (.not. use_fun) then ! if FUN is active, then soy fixation handled by FUN - call CNSoyfix (bounds, num_soilc, filter_soilc, num_soilp, filter_soilp, & + call CNSoyfix (bounds, num_bgc_soilc, filter_bgc_soilc, num_bgc_vegp, filter_bgc_vegp, & waterdiagnosticbulk_inst, crop_inst, cnveg_state_inst, cnveg_nitrogenflux_inst , & soilbiogeochem_state_inst, soilbiogeochem_nitrogenstate_inst, soilbiogeochem_nitrogenflux_inst) end if end if call t_startf('CNMResp') - call CNMResp(bounds, num_soilc, filter_soilc, num_soilp, filter_soilp, & + call CNMResp(bounds, num_bgc_soilc, filter_bgc_soilc, num_bgc_vegp, filter_bgc_vegp, & canopystate_inst, soilstate_inst, temperature_inst, photosyns_inst, & cnveg_carbonflux_inst, cnveg_nitrogenstate_inst) call t_stopf('CNMResp') @@ -341,11 +341,11 @@ subroutine CNDriverNoLeaching(bounds, call t_startf('SoilBiogeochem') call t_startf('DecompRate') if (decomp_method == century_decomp) then - call decomp_rate_constants_bgc(bounds, num_soilc, filter_soilc, & + call decomp_rate_constants_bgc(bounds, num_bgc_soilc, filter_bgc_soilc, & soilstate_inst, temperature_inst, ch4_inst, soilbiogeochem_carbonflux_inst) else if (decomp_method == mimics_decomp) then - call decomp_rates_mimics(bounds, num_soilc, filter_soilc, & - num_soilp, filter_soilp, clm_fates, & + call decomp_rates_mimics(bounds, num_bgc_soilc, filter_bgc_soilc, & + num_bgc_vegp, filter_bgc_vegp, clm_fates, & soilstate_inst, temperature_inst, cnveg_carbonflux_inst, ch4_inst, & soilbiogeochem_carbonflux_inst, soilbiogeochem_carbonstate_inst) end if @@ -353,7 +353,7 @@ subroutine CNDriverNoLeaching(bounds, call t_startf('SoilBiogeochemPotential') ! calculate potential decomp rates and total immobilization demand (previously inlined in CNDecompAlloc) - call SoilBiogeochemPotential (bounds, num_soilc, filter_soilc, & + call SoilBiogeochemPotential (bounds, num_bgc_soilc, filter_bgc_soilc, & soilbiogeochem_state_inst, soilbiogeochem_carbonstate_inst, soilbiogeochem_carbonflux_inst, & soilbiogeochem_nitrogenstate_inst, soilbiogeochem_nitrogenflux_inst, & cn_decomp_pools=cn_decomp_pools(begc:endc,1:nlevdecomp,1:ndecomp_pools), & @@ -365,12 +365,12 @@ subroutine CNDriverNoLeaching(bounds, ! calculate vertical profiles for distributing soil and litter C and N ! (previously subroutine decomp_vertprofiles called from CNDecompAlloc) - call SoilBiogeochemVerticalProfile(bounds, num_soilc, filter_soilc, num_soilp, filter_soilp, & + call SoilBiogeochemVerticalProfile(bounds, num_bgc_soilc, filter_bgc_soilc, num_bgc_vegp, filter_bgc_vegp, & active_layer_inst, soilstate_inst,soilbiogeochem_state_inst) ! calculate nitrification and denitrification rates (previously subroutine nitrif_denitrif called from CNDecompAlloc) if (use_nitrif_denitrif) then - call SoilBiogeochemNitrifDenitrif(bounds, num_soilc, filter_soilc, & + call SoilBiogeochemNitrifDenitrif(bounds, num_bgc_soilc, filter_bgc_soilc, & soilstate_inst, waterstatebulk_inst, temperature_inst, ch4_inst, & soilbiogeochem_carbonflux_inst, soilbiogeochem_nitrogenstate_inst, soilbiogeochem_nitrogenflux_inst) end if @@ -395,8 +395,8 @@ subroutine CNDriverNoLeaching(bounds, !RF: moved ths call to before nutrient_demand, so that croplive didn't change half way through crop N cycle. if ( use_fun ) then call t_startf('CNPhenology_phase1') - call CNPhenology (bounds, num_soilc, filter_soilc, num_soilp, & - filter_soilp, num_pcropp, filter_pcropp, & + call CNPhenology (bounds, num_bgc_soilc, filter_bgc_soilc, num_bgc_vegp, & + filter_bgc_vegp, num_pcropp, filter_pcropp, & waterdiagnosticbulk_inst, wateratm2lndbulk_inst, temperature_inst, atm2lnd_inst, & crop_inst, canopystate_inst, soilstate_inst, dgvs_inst, & cnveg_state_inst, cnveg_carbonstate_inst, cnveg_carbonflux_inst, & @@ -415,7 +415,7 @@ subroutine CNDriverNoLeaching(bounds, call t_startf('cnalloc') call calc_gpp_mr_availc( & - bounds, num_soilp, filter_soilp, & + bounds, num_bgc_vegp, filter_bgc_vegp, & crop_inst, photosyns_inst, canopystate_inst, & cnveg_carbonstate_inst, cnveg_carbonflux_inst, & c13_cnveg_carbonflux_inst, c14_cnveg_carbonflux_inst) @@ -425,7 +425,7 @@ subroutine CNDriverNoLeaching(bounds, crop_inst, cnveg_state_inst) end if - call calc_allometry(num_soilp, filter_soilp, & + call calc_allometry(num_bgc_vegp, filter_bgc_vegp, & cnveg_carbonflux_inst, cnveg_state_inst) call t_stopf('cnalloc') @@ -454,13 +454,13 @@ subroutine CNDriverNoLeaching(bounds, ! get the column-averaged plant_ndemand (needed for following call to SoilBiogeochemCompetition) - if(num_soilp>0)then - call p2c(bounds, num_soilc, filter_soilc, & + if(num_bgc_vegp>0)then + call p2c(bounds, num_bgc_soilc, filter_bgc_soilc, & cnveg_nitrogenflux_inst%plant_ndemand_patch(begp:endp), & soilbiogeochem_state_inst%plant_ndemand_col(begc:endc)) else ! With FATES N coupling, we will have a call to fill - ! this in on the filter_soilc + ! this in on the filter_bgc_soilc soilbiogeochem_state_inst%plant_ndemand_col(begc:endc) = 0._r8 end if @@ -470,7 +470,7 @@ subroutine CNDriverNoLeaching(bounds, call t_startf('soilbiogeochemcompetition') - call SoilBiogeochemCompetition (bounds, num_soilc, filter_soilc,num_soilp, filter_soilp, & + call SoilBiogeochemCompetition (bounds, num_bgc_soilc, filter_bgc_soilc,num_bgc_vegp, filter_bgc_vegp, & p_decomp_cn_gain, pmnf_decomp_cascade, waterstatebulk_inst, & waterfluxbulk_inst,temperature_inst,soilstate_inst,cnveg_state_inst, & cnveg_carbonstate_inst ,& @@ -485,7 +485,7 @@ subroutine CNDriverNoLeaching(bounds, call t_startf('calc_plant_nutrient_competition') call nutrient_competition_method%calc_plant_nutrient_competition ( & - bounds, num_soilp, filter_soilp, & + bounds, num_bgc_vegp, filter_bgc_vegp, & cnveg_state_inst, crop_inst, canopystate_inst, & cnveg_carbonstate_inst, cnveg_carbonflux_inst, & c13_cnveg_carbonflux_inst, c14_cnveg_carbonflux_inst, & @@ -505,7 +505,7 @@ subroutine CNDriverNoLeaching(bounds, call t_startf('SoilBiogeochemDecomp') - call SoilBiogeochemDecomp (bounds, num_soilc, filter_soilc, & + call SoilBiogeochemDecomp (bounds, num_bgc_soilc, filter_bgc_soilc, & soilbiogeochem_state_inst, soilbiogeochem_carbonstate_inst, soilbiogeochem_carbonflux_inst, & soilbiogeochem_nitrogenstate_inst, soilbiogeochem_nitrogenflux_inst, & cn_decomp_pools=cn_decomp_pools(begc:endc,1:nlevdecomp,1:ndecomp_pools), & @@ -525,8 +525,8 @@ subroutine CNDriverNoLeaching(bounds, call t_startf('CNPhenology') if ( .not. use_fun ) then - call CNPhenology (bounds, num_soilc, filter_soilc, num_soilp, & - filter_soilp, num_pcropp, filter_pcropp, & + call CNPhenology (bounds, num_bgc_soilc, filter_bgc_soilc, num_bgc_vegp, & + filter_bgc_vegp, num_pcropp, filter_pcropp, & waterdiagnosticbulk_inst, wateratm2lndbulk_inst, temperature_inst, atm2lnd_inst, & crop_inst, canopystate_inst, soilstate_inst, dgvs_inst, & cnveg_state_inst, cnveg_carbonstate_inst, cnveg_carbonflux_inst, & @@ -536,8 +536,8 @@ subroutine CNDriverNoLeaching(bounds, froot_prof_patch=soilbiogeochem_state_inst%froot_prof_patch(begp:endp,1:nlevdecomp_full), & phase=1) end if - call CNPhenology (bounds, num_soilc, filter_soilc, num_soilp, & - filter_soilp, num_pcropp, filter_pcropp, & + call CNPhenology (bounds, num_bgc_soilc, filter_bgc_soilc, num_bgc_vegp, & + filter_bgc_vegp, num_pcropp, filter_pcropp, & waterdiagnosticbulk_inst, wateratm2lndbulk_inst, temperature_inst, atm2lnd_inst, & crop_inst, canopystate_inst, soilstate_inst, dgvs_inst, & cnveg_state_inst, cnveg_carbonstate_inst, cnveg_carbonflux_inst, & @@ -555,7 +555,7 @@ subroutine CNDriverNoLeaching(bounds, call t_startf('CNGResp') - call CNGResp(num_soilp, filter_soilp,& + call CNGResp(num_bgc_vegp, filter_bgc_vegp,& cnveg_carbonflux_inst, canopystate_inst, cnveg_carbonstate_inst, cnveg_nitrogenstate_inst) call t_stopf('CNGResp') @@ -567,7 +567,7 @@ subroutine CNDriverNoLeaching(bounds, if( use_dynroot ) then call t_startf('CNRootDyn') - call CNRootDyn(bounds, num_soilc, filter_soilc, num_soilp, filter_soilp, & + call CNRootDyn(bounds, num_bgc_soilc, filter_bgc_soilc, num_bgc_vegp, filter_bgc_vegp, & cnveg_carbonstate_inst, cnveg_nitrogenstate_inst, cnveg_carbonflux_inst, & cnveg_state_inst, crop_inst, soilstate_inst, soilbiogeochem_nitrogenstate_inst) @@ -583,24 +583,24 @@ subroutine CNDriverNoLeaching(bounds, call t_startf('CNUpdate0') - call CStateUpdate0(num_soilp, filter_soilp, & + call CStateUpdate0(num_bgc_vegp, filter_bgc_vegp, & cnveg_carbonflux_inst, cnveg_carbonstate_inst) if ( use_c13 ) then - call CStateUpdate0(num_soilp, filter_soilp, & + call CStateUpdate0(num_bgc_vegp, filter_bgc_vegp, & c13_cnveg_carbonflux_inst, c13_cnveg_carbonstate_inst) end if if ( use_c14 ) then - call CStateUpdate0(num_soilp, filter_soilp, & + call CStateUpdate0(num_bgc_vegp, filter_bgc_vegp, & c14_cnveg_carbonflux_inst, c14_cnveg_carbonstate_inst) end if call t_stopf('CNUpdate0') - if ( use_nguardrail .and. num_soilp>0 ) then + if ( use_nguardrail .and. num_bgc_vegp>0 ) then call t_startf('CNPrecisionControl') - call CNPrecisionControl(bounds, num_soilp, filter_soilp, & + call CNPrecisionControl(bounds, num_bgc_vegp, filter_bgc_vegp, & cnveg_carbonstate_inst, c13_cnveg_carbonstate_inst, & c14_cnveg_carbonstate_inst, cnveg_nitrogenstate_inst) call t_stopf('CNPrecisionControl') @@ -617,7 +617,7 @@ subroutine CNDriverNoLeaching(bounds, ! Set the carbon isotopic flux variables (except for gap-phase mortality and fire fluxes) if ( use_c13 ) then - call CIsoFlux1(num_soilc, filter_soilc, num_soilp, filter_soilp, & + call CIsoFlux1(num_bgc_soilc, filter_bgc_soilc, num_bgc_vegp, filter_bgc_vegp, & soilbiogeochem_state_inst, & soilbiogeochem_carbonflux_inst, soilbiogeochem_carbonstate_inst, & cnveg_carbonflux_inst, cnveg_carbonstate_inst, & @@ -626,7 +626,7 @@ subroutine CNDriverNoLeaching(bounds, isotope='c13') end if if ( use_c14 ) then - call CIsoFlux1(num_soilc, filter_soilc, num_soilp, filter_soilp, & + call CIsoFlux1(num_bgc_soilc, filter_bgc_soilc, num_bgc_vegp, filter_bgc_vegp, & soilbiogeochem_state_inst, & soilbiogeochem_carbonflux_inst, soilbiogeochem_carbonstate_inst, & cnveg_carbonflux_inst, cnveg_carbonstate_inst, & @@ -636,40 +636,40 @@ subroutine CNDriverNoLeaching(bounds, end if ! Update all prognostic carbon state variables (except for gap-phase mortality and fire fluxes) - call CStateUpdate1( num_soilc, filter_soilc, num_soilp, filter_soilp, & + call CStateUpdate1( num_bgc_soilc, filter_bgc_soilc, num_bgc_vegp, filter_bgc_vegp, & crop_inst, cnveg_carbonflux_inst, cnveg_carbonstate_inst, & soilbiogeochem_carbonflux_inst, dribble_crophrv_xsmrpool_2atm, & clm_fates, bounds%clump_index) if ( use_c13 ) then - call CStateUpdate1(num_soilc, filter_soilc, num_soilp, filter_soilp, & + call CStateUpdate1(num_bgc_soilc, filter_bgc_soilc, num_bgc_vegp, filter_bgc_vegp, & crop_inst, c13_cnveg_carbonflux_inst, c13_cnveg_carbonstate_inst, & c13_soilbiogeochem_carbonflux_inst, dribble_crophrv_xsmrpool_2atm, & clm_fates, bounds%clump_index) end if if ( use_c14 ) then - call CStateUpdate1(num_soilc, filter_soilc, num_soilp, filter_soilp, & + call CStateUpdate1(num_bgc_soilc, filter_bgc_soilc, num_bgc_vegp, filter_bgc_vegp, & crop_inst, c14_cnveg_carbonflux_inst, c14_cnveg_carbonstate_inst, & c14_soilbiogeochem_carbonflux_inst, dribble_crophrv_xsmrpool_2atm, & clm_fates, bounds%clump_index) end if ! Update all prognostic nitrogen state variables (except for gap-phase mortality and fire fluxes) - call NStateUpdate1(num_soilc, filter_soilc, num_soilp, filter_soilp, & + call NStateUpdate1(num_bgc_soilc, filter_bgc_soilc, num_bgc_vegp, filter_bgc_vegp, & cnveg_nitrogenflux_inst, cnveg_nitrogenstate_inst, soilbiogeochem_nitrogenflux_inst, & clm_fates, bounds%clump_index) call t_stopf('CNUpdate1') - if ( use_nguardrail .and. num_soilp>0 ) then + if ( use_nguardrail .and. num_bgc_vegp>0 ) then call t_startf('CNPrecisionControl') - call CNPrecisionControl(bounds, num_soilp, filter_soilp, & + call CNPrecisionControl(bounds, num_bgc_vegp, filter_bgc_vegp, & cnveg_carbonstate_inst, c13_cnveg_carbonstate_inst, & c14_cnveg_carbonstate_inst, cnveg_nitrogenstate_inst) call t_stopf('CNPrecisionControl') end if call t_startf('SoilBiogeochemStateUpdate1') - call SoilBiogeochemNStateUpdate1(num_soilc, filter_soilc, & + call SoilBiogeochemNStateUpdate1(num_bgc_soilc, filter_bgc_soilc, & soilbiogeochem_state_inst, soilbiogeochem_nitrogenflux_inst, soilbiogeochem_nitrogenstate_inst) call t_stopf('SoilBiogeochemStateUpdate1') @@ -680,7 +680,7 @@ subroutine CNDriverNoLeaching(bounds, call t_startf('SoilBiogeochemLittVertTransp') - call SoilBiogeochemLittVertTransp(bounds, num_soilc, filter_soilc, & + call SoilBiogeochemLittVertTransp(bounds, num_bgc_soilc, filter_bgc_soilc, & active_layer_inst, soilbiogeochem_state_inst, & soilbiogeochem_carbonstate_inst, soilbiogeochem_carbonflux_inst, & c13_soilbiogeochem_carbonstate_inst, c13_soilbiogeochem_carbonflux_inst, & @@ -693,10 +693,10 @@ subroutine CNDriverNoLeaching(bounds, ! Calculate the gap mortality carbon and nitrogen fluxes !-------------------------------------------- - if_soilp1: if(num_soilp>0)then + if_bgc_vegp1: if(num_bgc_vegp>0)then call t_startf('CNGapMortality') - call CNGapMortality (bounds, num_soilc, filter_soilc, num_soilp, filter_soilp, & + call CNGapMortality (bounds, num_bgc_soilc, filter_bgc_soilc, num_bgc_vegp, filter_bgc_vegp, & dgvs_inst, cnveg_carbonstate_inst, cnveg_nitrogenstate_inst, soilbiogeochem_nitrogenflux_inst, & cnveg_carbonflux_inst, cnveg_nitrogenflux_inst, canopystate_inst, & leaf_prof_patch=soilbiogeochem_state_inst%leaf_prof_patch(begp:endp, 1:nlevdecomp_full), & @@ -715,14 +715,14 @@ subroutine CNDriverNoLeaching(bounds, call t_startf('CNUpdate2') ! Set the carbon isotopic fluxes for gap mortality if ( use_c13 ) then - call CIsoFlux2(num_soilc, filter_soilc, num_soilp, filter_soilp, & + call CIsoFlux2(num_bgc_soilc, filter_bgc_soilc, num_bgc_vegp, filter_bgc_vegp, & soilbiogeochem_state_inst, cnveg_carbonflux_inst, cnveg_carbonstate_inst, & iso_cnveg_carbonflux_inst=c13_cnveg_carbonflux_inst, & iso_cnveg_carbonstate_inst=c13_cnveg_carbonstate_inst, & isotope='c13') end if if ( use_c14 ) then - call CIsoFlux2(num_soilc, filter_soilc, num_soilp, filter_soilp, & + call CIsoFlux2(num_bgc_soilc, filter_bgc_soilc, num_bgc_vegp, filter_bgc_vegp, & soilbiogeochem_state_inst, cnveg_carbonflux_inst, cnveg_carbonstate_inst, & iso_cnveg_carbonflux_inst=c14_cnveg_carbonflux_inst, & iso_cnveg_carbonstate_inst=c14_cnveg_carbonstate_inst, & @@ -730,22 +730,22 @@ subroutine CNDriverNoLeaching(bounds, end if ! Update all the prognostic carbon state variables affected by gap-phase mortality fluxes - call CStateUpdate2(num_soilc, filter_soilc, num_soilp, filter_soilp, & + call CStateUpdate2(num_bgc_soilc, filter_bgc_soilc, num_bgc_vegp, filter_bgc_vegp, & cnveg_carbonflux_inst, cnveg_carbonstate_inst, soilbiogeochem_carbonstate_inst, & soilbiogeochem_carbonflux_inst) if ( use_c13 ) then - call CStateUpdate2(num_soilc, filter_soilc, num_soilp, filter_soilp, & + call CStateUpdate2(num_bgc_soilc, filter_bgc_soilc, num_bgc_vegp, filter_bgc_vegp, & c13_cnveg_carbonflux_inst, c13_cnveg_carbonstate_inst, c13_soilbiogeochem_carbonstate_inst, & c13_soilbiogeochem_carbonflux_inst) end if if ( use_c14 ) then - call CStateUpdate2(num_soilc, filter_soilc, num_soilp, filter_soilp, & + call CStateUpdate2(num_bgc_soilc, filter_bgc_soilc, num_bgc_vegp, filter_bgc_vegp, & c14_cnveg_carbonflux_inst, c14_cnveg_carbonstate_inst, c14_soilbiogeochem_carbonstate_inst, & c14_soilbiogeochem_carbonflux_inst) end if ! Update all the prognostic nitrogen state variables affected by gap-phase mortality fluxes - call NStateUpdate2(num_soilc, filter_soilc, num_soilp, filter_soilp, & + call NStateUpdate2(num_bgc_soilc, filter_bgc_soilc, num_bgc_vegp, filter_bgc_vegp, & cnveg_nitrogenflux_inst, cnveg_nitrogenstate_inst,soilbiogeochem_nitrogenstate_inst, & soilbiogeochem_nitrogenflux_inst) @@ -758,50 +758,50 @@ subroutine CNDriverNoLeaching(bounds, ! Set harvest mortality routine if (get_do_harvest()) then - call CNHarvest(num_soilc, filter_soilc, num_soilp, filter_soilp, & + call CNHarvest(num_bgc_soilc, filter_bgc_soilc, num_bgc_vegp, filter_bgc_vegp, & soilbiogeochem_state_inst, cnveg_carbonstate_inst, cnveg_nitrogenstate_inst, & cnveg_carbonflux_inst, cnveg_nitrogenflux_inst) end if if ( use_c13 ) then - call CIsoFlux2h(num_soilc, filter_soilc, num_soilp, filter_soilp, & + call CIsoFlux2h(num_bgc_soilc, filter_bgc_soilc, num_bgc_vegp, filter_bgc_vegp, & soilbiogeochem_state_inst, & cnveg_carbonflux_inst, cnveg_carbonstate_inst, & c13_cnveg_carbonflux_inst, c13_cnveg_carbonstate_inst, & isotope='c13') end if if ( use_c14 ) then - call CIsoFlux2h(num_soilc, filter_soilc, num_soilp, filter_soilp, & + call CIsoFlux2h(num_bgc_soilc, filter_bgc_soilc, num_bgc_vegp, filter_bgc_vegp, & soilbiogeochem_state_inst, & cnveg_carbonflux_inst, cnveg_carbonstate_inst, & c14_cnveg_carbonflux_inst, c14_cnveg_carbonstate_inst, & isotope='c14') end if - call CStateUpdate2h( num_soilc, filter_soilc, num_soilp, filter_soilp, & + call CStateUpdate2h( num_bgc_soilc, filter_bgc_soilc, num_bgc_vegp, filter_bgc_vegp, & cnveg_carbonflux_inst, cnveg_carbonstate_inst, soilbiogeochem_carbonstate_inst, & soilbiogeochem_carbonflux_inst) if ( use_c13 ) then - call CStateUpdate2h(num_soilc, filter_soilc, num_soilp, filter_soilp, & + call CStateUpdate2h(num_bgc_soilc, filter_bgc_soilc, num_bgc_vegp, filter_bgc_vegp, & c13_cnveg_carbonflux_inst, c13_cnveg_carbonstate_inst, c13_soilbiogeochem_carbonstate_inst, & c13_soilbiogeochem_carbonflux_inst) end if if ( use_c14 ) then - call CStateUpdate2h(num_soilc, filter_soilc, num_soilp, filter_soilp, & + call CStateUpdate2h(num_bgc_soilc, filter_bgc_soilc, num_bgc_vegp, filter_bgc_vegp, & c14_cnveg_carbonflux_inst, c14_cnveg_carbonstate_inst, c14_soilbiogeochem_carbonstate_inst, & c14_soilbiogeochem_carbonflux_inst) end if - call NStateUpdate2h(num_soilc, filter_soilc, num_soilp, filter_soilp, & + call NStateUpdate2h(num_bgc_soilc, filter_bgc_soilc, num_bgc_vegp, filter_bgc_vegp, & cnveg_nitrogenflux_inst, cnveg_nitrogenstate_inst, soilbiogeochem_nitrogenstate_inst, & soilbiogeochem_nitrogenflux_inst) call t_stopf('CNUpdate2') - end if if_soilp1 + end if if_bgc_vegp1 - if ( use_nguardrail .and. num_soilp>0 ) then + if ( use_nguardrail .and. num_bgc_vegp>0 ) then call t_startf('CNPrecisionControl') - call CNPrecisionControl(bounds, num_soilp, filter_soilp, & + call CNPrecisionControl(bounds, num_bgc_vegp, filter_bgc_vegp, & cnveg_carbonstate_inst, c13_cnveg_carbonstate_inst, & c14_cnveg_carbonstate_inst, cnveg_nitrogenstate_inst) call t_stopf('CNPrecisionControl') @@ -820,12 +820,12 @@ subroutine CNDriverNoLeaching(bounds, call n_products_inst%SetValues(bounds,0._r8) if(use_fates_bgc) then - call clm_fates%wrap_WoodProducts(bounds, num_soilc, filter_soilc, c_products_inst, n_products_inst) + call clm_fates%wrap_WoodProducts(bounds, num_bgc_soilc, filter_bgc_soilc, c_products_inst, n_products_inst) end if - if_soilp2: if(num_soilp>0)then + if_bgc_vegp2: if(num_bgc_vegp>0)then call c_products_inst%UpdateProducts(bounds, & - num_soilp, filter_soilp, & + num_bgc_vegp, filter_bgc_vegp, & dwt_wood_product_gain_patch = cnveg_carbonflux_inst%dwt_wood_productc_gain_patch(begp:endp), & wood_harvest_patch = cnveg_carbonflux_inst%wood_harvestc_patch(begp:endp), & dwt_crop_product_gain_patch = cnveg_carbonflux_inst%dwt_crop_productc_gain_patch(begp:endp), & @@ -833,7 +833,7 @@ subroutine CNDriverNoLeaching(bounds, if (use_c13) then call c13_products_inst%UpdateProducts(bounds, & - num_soilp, filter_soilp, & + num_bgc_vegp, filter_bgc_vegp, & dwt_wood_product_gain_patch = c13_cnveg_carbonflux_inst%dwt_wood_productc_gain_patch(begp:endp), & wood_harvest_patch = c13_cnveg_carbonflux_inst%wood_harvestc_patch(begp:endp), & dwt_crop_product_gain_patch = c13_cnveg_carbonflux_inst%dwt_crop_productc_gain_patch(begp:endp), & @@ -842,7 +842,7 @@ subroutine CNDriverNoLeaching(bounds, if (use_c14) then call c14_products_inst%UpdateProducts(bounds, & - num_soilp, filter_soilp, & + num_bgc_vegp, filter_bgc_vegp, & dwt_wood_product_gain_patch = c14_cnveg_carbonflux_inst%dwt_wood_productc_gain_patch(begp:endp), & wood_harvest_patch = c14_cnveg_carbonflux_inst%wood_harvestc_patch(begp:endp), & dwt_crop_product_gain_patch = c14_cnveg_carbonflux_inst%dwt_crop_productc_gain_patch(begp:endp), & @@ -850,13 +850,13 @@ subroutine CNDriverNoLeaching(bounds, end if call n_products_inst%UpdateProducts(bounds, & - num_soilp, filter_soilp, & + num_bgc_vegp, filter_bgc_vegp, & dwt_wood_product_gain_patch = cnveg_nitrogenflux_inst%dwt_wood_productn_gain_patch(begp:endp), & wood_harvest_patch = cnveg_nitrogenflux_inst%wood_harvestn_patch(begp:endp), & dwt_crop_product_gain_patch = cnveg_nitrogenflux_inst%dwt_crop_productn_gain_patch(begp:endp), & crop_harvest_to_cropprod_patch = cnveg_nitrogenflux_inst%crop_harvestn_to_cropprodn_patch(begp:endp)) - end if if_soilp2 + end if if_bgc_vegp2 call c_products_inst%ComputeProductSummaryVars(bounds) if (use_c13) call c13_products_inst%ComputeProductSummaryVars(bounds) @@ -875,9 +875,9 @@ subroutine CNDriverNoLeaching(bounds, ! Calculate fire area and fluxes !-------------------------------------------- - if_soilp3: if(num_soilp>0)then + if_bgc_vegp3: if(num_bgc_vegp>0)then call t_startf('CNFire') - call cnfire_method%CNFireArea(bounds, num_soilc, filter_soilc, num_soilp, filter_soilp, & + call cnfire_method%CNFireArea(bounds, num_bgc_soilc, filter_bgc_soilc, num_bgc_vegp, filter_bgc_vegp, & num_exposedvegp, filter_exposedvegp, num_noexposedvegp, filter_noexposedvegp, & atm2lnd_inst, energyflux_inst, saturated_excess_runoff_inst, waterdiagnosticbulk_inst, wateratm2lndbulk_inst, & waterstatebulk_inst, soilstate_inst, soil_water_retention_curve, & @@ -886,7 +886,7 @@ subroutine CNDriverNoLeaching(bounds, decomp_cpools_vr_col=soilbiogeochem_carbonstate_inst%decomp_cpools_vr_col(begc:endc,1:nlevdecomp_full,1:ndecomp_pools), & t_soi17cm_col=temperature_inst%t_soi17cm_col(begc:endc)) - call cnfire_method%CNFireFluxes(bounds, num_soilc, filter_soilc, num_soilp, filter_soilp, & + call cnfire_method%CNFireFluxes(bounds, num_bgc_soilc, filter_bgc_soilc, num_bgc_vegp, filter_bgc_vegp, & num_actfirec, filter_actfirec, num_actfirep, filter_actfirep, & dgvs_inst, cnveg_state_inst, & cnveg_carbonstate_inst, cnveg_carbonflux_inst, cnveg_nitrogenstate_inst, cnveg_nitrogenflux_inst, & @@ -910,7 +910,7 @@ subroutine CNDriverNoLeaching(bounds, call t_startf('CNUpdate3') if ( use_c13 ) then - call CIsoFlux3(num_soilc, filter_soilc, num_soilp, filter_soilp, & + call CIsoFlux3(num_bgc_soilc, filter_bgc_soilc, num_bgc_vegp, filter_bgc_vegp, & soilbiogeochem_state_inst , soilbiogeochem_carbonstate_inst, & cnveg_carbonflux_inst, cnveg_carbonstate_inst, & c13_cnveg_carbonflux_inst, c13_cnveg_carbonstate_inst, & @@ -918,7 +918,7 @@ subroutine CNDriverNoLeaching(bounds, isotope='c13') end if if ( use_c14 ) then - call CIsoFlux3(num_soilc, filter_soilc, num_soilp, filter_soilp, & + call CIsoFlux3(num_bgc_soilc, filter_bgc_soilc, num_bgc_vegp, filter_bgc_vegp, & soilbiogeochem_state_inst , soilbiogeochem_carbonstate_inst, & cnveg_carbonflux_inst, cnveg_carbonstate_inst, & c14_cnveg_carbonflux_inst, c14_cnveg_carbonstate_inst, & @@ -926,32 +926,32 @@ subroutine CNDriverNoLeaching(bounds, isotope='c14') end if - call CStateUpdate3( num_soilc, filter_soilc, num_soilp, filter_soilp, & + call CStateUpdate3( num_bgc_soilc, filter_bgc_soilc, num_bgc_vegp, filter_bgc_vegp, & cnveg_carbonflux_inst, cnveg_carbonstate_inst, soilbiogeochem_carbonstate_inst, & soilbiogeochem_carbonflux_inst) if ( use_c13 ) then - call CStateUpdate3( num_soilc, filter_soilc, num_soilp, filter_soilp, & + call CStateUpdate3( num_bgc_soilc, filter_bgc_soilc, num_bgc_vegp, filter_bgc_vegp, & c13_cnveg_carbonflux_inst, c13_cnveg_carbonstate_inst, c13_soilbiogeochem_carbonstate_inst, & c13_soilbiogeochem_carbonflux_inst) end if if ( use_c14 ) then - call CStateUpdate3( num_soilc, filter_soilc, num_soilp, filter_soilp, & + call CStateUpdate3( num_bgc_soilc, filter_bgc_soilc, num_bgc_vegp, filter_bgc_vegp, & c14_cnveg_carbonflux_inst, c14_cnveg_carbonstate_inst, c14_soilbiogeochem_carbonstate_inst, & c14_soilbiogeochem_carbonflux_inst) - call C14Decay(bounds, num_soilc, filter_soilc, num_soilp, filter_soilp, & + call C14Decay(bounds, num_bgc_soilc, filter_bgc_soilc, num_bgc_vegp, filter_bgc_vegp, & c14_cnveg_carbonstate_inst, c14_soilbiogeochem_carbonstate_inst, & c14_cnveg_carbonflux_inst, c14_soilbiogeochem_carbonflux_inst) end if call t_stopf('CNUpdate3') - end if if_soilp3 + end if if_bgc_vegp3 - if ( use_nguardrail .and. num_soilp>0 ) then + if ( use_nguardrail .and. num_bgc_vegp>0 ) then call t_startf('CNPrecisionControl') - call CNPrecisionControl(bounds, num_soilp, filter_soilp, & + call CNPrecisionControl(bounds, num_bgc_vegp, filter_bgc_vegp, & cnveg_carbonstate_inst, c13_cnveg_carbonstate_inst, & c14_cnveg_carbonstate_inst, cnveg_nitrogenstate_inst) call t_stopf('CNPrecisionControl') @@ -963,7 +963,7 @@ end subroutine CNDriverNoLeaching !----------------------------------------------------------------------- subroutine CNDriverLeaching(bounds, & - num_soilc, filter_soilc, num_soilp, filter_soilp, & + num_bgc_soilc, filter_bgc_soilc, num_bgc_vegp, filter_bgc_vegp, & num_actfirec, filter_actfirec, num_actfirep, filter_actfirep,& waterstatebulk_inst, waterfluxbulk_inst, & soilstate_inst, cnveg_state_inst, & @@ -990,10 +990,10 @@ subroutine CNDriverLeaching(bounds, & ! ! !ARGUMENTS: type(bounds_type) , intent(in) :: bounds - integer , intent(in) :: num_soilc ! number of soil columns in filter - integer , intent(in) :: filter_soilc(:) ! filter for soil columns - integer , intent(in) :: num_soilp ! number of soil patches in filter - integer , intent(in) :: filter_soilp(:) ! filter for soil patches + integer , intent(in) :: num_bgc_soilc ! number of soil columns in filter + integer , intent(in) :: filter_bgc_soilc(:) ! filter for soil columns + integer , intent(in) :: num_bgc_vegp ! number of soil patches in filter + integer , intent(in) :: filter_bgc_vegp(:) ! filter for soil patches integer , intent(in) :: num_actfirec ! number of soil columns on fire in filter integer , intent(in) :: filter_actfirec(:) ! filter for soil columns on fire integer , intent(in) :: num_actfirep ! number of soil patches on fire in filter @@ -1025,10 +1025,10 @@ subroutine CNDriverLeaching(bounds, & ! Mineral nitrogen dynamics (deposition, fixation, leaching) call t_startf('SoilBiogeochemNLeaching') - call SoilBiogeochemNLeaching(bounds, num_soilc, filter_soilc, & + call SoilBiogeochemNLeaching(bounds, num_bgc_soilc, filter_bgc_soilc, & waterstatebulk_inst, waterfluxbulk_inst, soilbiogeochem_nitrogenstate_inst, & soilbiogeochem_nitrogenflux_inst) - call NStateUpdateLeaching(num_soilc, filter_soilc, & + call NStateUpdateLeaching(num_bgc_soilc, filter_bgc_soilc, & soilbiogeochem_nitrogenflux_inst, soilbiogeochem_nitrogenstate_inst) call t_stopf('SoilBiogeochemNLeaching') @@ -1037,9 +1037,9 @@ subroutine CNDriverLeaching(bounds, & ! Nitrogen state variable update, mortality fluxes. - if(num_soilp>0)then + if(num_bgc_vegp>0)then call t_startf('NUpdate3') - call NStateUpdate3(num_soilc, filter_soilc, num_soilp, filter_soilp, & + call NStateUpdate3(num_bgc_soilc, filter_bgc_soilc, num_bgc_vegp, filter_bgc_vegp, & cnveg_nitrogenflux_inst, cnveg_nitrogenstate_inst, & soilbiogeochem_nitrogenflux_inst, soilbiogeochem_nitrogenstate_inst) call t_stopf('NUpdate3') @@ -1066,7 +1066,7 @@ end subroutine CNDriverLeaching !----------------------------------------------------------------------- subroutine CNDriverSummarizeStates(bounds, num_allc, filter_allc, & - num_soilc, filter_soilc, num_soilp, filter_soilp, & + num_bgc_soilc, filter_bgc_soilc, num_bgc_vegp, filter_bgc_vegp, & cnveg_carbonstate_inst, c13_cnveg_carbonstate_inst, c14_cnveg_carbonstate_inst, & cnveg_nitrogenstate_inst, & soilbiogeochem_carbonstate_inst, & @@ -1083,10 +1083,10 @@ subroutine CNDriverSummarizeStates(bounds, num_allc, filter_allc, & type(bounds_type) , intent(in) :: bounds integer , intent(in) :: num_allc ! number of columns in allc filter integer , intent(in) :: filter_allc(:) ! filter for all active columns - integer , intent(in) :: num_soilc ! number of soil columns in filter - integer , intent(in) :: filter_soilc(:) ! filter for soil columns - integer , intent(in) :: num_soilp ! number of soil patches in filter - integer , intent(in) :: filter_soilp(:) ! filter for soil patches + integer , intent(in) :: num_bgc_soilc ! number of soil columns in filter + integer , intent(in) :: filter_bgc_soilc(:) ! filter for soil columns + integer , intent(in) :: num_bgc_vegp ! number of soil patches in filter + integer , intent(in) :: filter_bgc_vegp(:) ! filter for soil patches type(cnveg_carbonstate_type) , intent(inout) :: cnveg_carbonstate_inst type(cnveg_carbonstate_type) , intent(inout) :: c13_cnveg_carbonstate_inst type(cnveg_carbonstate_type) , intent(inout) :: c14_cnveg_carbonstate_inst @@ -1109,14 +1109,14 @@ subroutine CNDriverSummarizeStates(bounds, num_allc, filter_allc, & ! ---------------------------------------------- ! cnveg carbon/nitrogen state summary ! ---------------------------------------------- - call cnveg_carbonstate_inst%Summary(bounds, num_soilc, filter_soilc, num_soilp, filter_soilp) + call cnveg_carbonstate_inst%Summary(bounds, num_bgc_soilc, filter_bgc_soilc, num_bgc_vegp, filter_bgc_vegp) if ( use_c13 ) then - call c13_cnveg_carbonstate_inst%Summary(bounds, num_soilc, filter_soilc, num_soilp, filter_soilp) + call c13_cnveg_carbonstate_inst%Summary(bounds, num_bgc_soilc, filter_bgc_soilc, num_bgc_vegp, filter_bgc_vegp) end if if ( use_c14 ) then - call c14_cnveg_carbonstate_inst%Summary(bounds, num_soilc, filter_soilc, num_soilp, filter_soilp) + call c14_cnveg_carbonstate_inst%Summary(bounds, num_bgc_soilc, filter_bgc_soilc, num_bgc_vegp, filter_bgc_vegp) end if ! ---------------------------------------------- @@ -1125,12 +1125,12 @@ subroutine CNDriverSummarizeStates(bounds, num_allc, filter_allc, & ! cnveg summary, swapped call order ! ---------------------------------------------- - call soilbiogeochem_carbonstate_inst%summary(bounds, num_soilc, filter_soilc, cnveg_carbonstate_inst) + call soilbiogeochem_carbonstate_inst%summary(bounds, num_bgc_soilc, filter_bgc_soilc, cnveg_carbonstate_inst) if ( use_c13 ) then - call c13_soilbiogeochem_carbonstate_inst%summary(bounds, num_soilc, filter_soilc, c13_cnveg_carbonstate_inst) + call c13_soilbiogeochem_carbonstate_inst%summary(bounds, num_bgc_soilc, filter_bgc_soilc, c13_cnveg_carbonstate_inst) end if if ( use_c14 ) then - call c14_soilbiogeochem_carbonstate_inst%summary(bounds, num_soilc, filter_soilc, c14_cnveg_carbonstate_inst) + call c14_soilbiogeochem_carbonstate_inst%summary(bounds, num_bgc_soilc, filter_bgc_soilc, c14_cnveg_carbonstate_inst) end if @@ -1138,10 +1138,10 @@ subroutine CNDriverSummarizeStates(bounds, num_allc, filter_allc, & ! couple in FATES N - call cnveg_nitrogenstate_inst%Summary(bounds, num_soilc, filter_soilc, & - num_soilp, filter_soilp) + call cnveg_nitrogenstate_inst%Summary(bounds, num_bgc_soilc, filter_bgc_soilc, & + num_bgc_vegp, filter_bgc_vegp) - call soilbiogeochem_nitrogenstate_inst%summary(bounds, num_soilc, filter_soilc,cnveg_nitrogenstate_inst) + call soilbiogeochem_nitrogenstate_inst%summary(bounds, num_bgc_soilc, filter_bgc_soilc,cnveg_nitrogenstate_inst) call t_stopf('CNsum') @@ -1150,7 +1150,7 @@ end subroutine CNDriverSummarizeStates !----------------------------------------------------------------------- subroutine CNDriverSummarizeFluxes(bounds, & - num_soilc, filter_soilc, num_soilp, filter_soilp, & + num_bgc_soilc, filter_bgc_soilc, num_bgc_vegp, filter_bgc_vegp, & cnveg_carbonflux_inst, c13_cnveg_carbonflux_inst, c14_cnveg_carbonflux_inst, & cnveg_nitrogenflux_inst, & c_products_inst, c13_products_inst, c14_products_inst, & @@ -1171,10 +1171,10 @@ subroutine CNDriverSummarizeFluxes(bounds, & ! ! !ARGUMENTS: type(bounds_type) , intent(in) :: bounds - integer , intent(in) :: num_soilc ! number of soil columns in filter - integer , intent(in) :: filter_soilc(:) ! filter for soil columns - integer , intent(in) :: num_soilp ! number of soil patches in filter - integer , intent(in) :: filter_soilp(:) ! filter for soil patches + integer , intent(in) :: num_bgc_soilc ! number of soil columns in filter + integer , intent(in) :: filter_bgc_soilc(:) ! filter for soil columns + integer , intent(in) :: num_bgc_vegp ! number of soil patches in filter + integer , intent(in) :: filter_bgc_vegp(:) ! filter for soil patches type(cnveg_carbonflux_type) , intent(inout) :: cnveg_carbonflux_inst type(cnveg_carbonflux_type) , intent(inout) :: c13_cnveg_carbonflux_inst type(cnveg_carbonflux_type) , intent(inout) :: c14_cnveg_carbonflux_inst @@ -1209,16 +1209,16 @@ subroutine CNDriverSummarizeFluxes(bounds, & ! soilbiogeochem carbon/nitrogen flux summary ! ---------------------------------------------- - call soilbiogeochem_carbonflux_inst%Summary(bounds, num_soilc, filter_soilc, & - num_soilp, filter_soilp, & + call soilbiogeochem_carbonflux_inst%Summary(bounds, num_bgc_soilc, filter_bgc_soilc, & + num_bgc_vegp, filter_bgc_vegp, & soilbiogeochem_carbonflux_inst%decomp_cascade_ctransfer_col(begc:endc,1:ndecomp_cascade_transitions), & soilbiogeochem_carbonstate_inst%cwdc_col(begc:endc), & soilbiogeochem_nitrogenstate_inst%cwdn_col(begc:endc), & leafc_to_litter_patch=cnveg_carbonflux_inst%leafc_to_litter_patch, & frootc_to_litter_patch=cnveg_carbonflux_inst%frootc_to_litter_patch) if ( use_c13 ) then - call c13_soilbiogeochem_carbonflux_inst%Summary(bounds, num_soilc, filter_soilc, & - num_soilp, filter_soilp, & + call c13_soilbiogeochem_carbonflux_inst%Summary(bounds, num_bgc_soilc, filter_bgc_soilc, & + num_bgc_vegp, filter_bgc_vegp, & c13_soilbiogeochem_carbonflux_inst%decomp_cascade_ctransfer_col(begc:endc,1:ndecomp_cascade_transitions), & c13_soilbiogeochem_carbonstate_inst%cwdc_col(begc:endc), & soilbiogeochem_nitrogenstate_inst%cwdn_col(begc:endc), & @@ -1226,23 +1226,23 @@ subroutine CNDriverSummarizeFluxes(bounds, & frootc_to_litter_patch=c13_cnveg_carbonflux_inst%frootc_to_litter_patch) end if if ( use_c14 ) then - call c14_soilbiogeochem_carbonflux_inst%Summary(bounds, num_soilc, filter_soilc, & - num_soilp, filter_soilp, & + call c14_soilbiogeochem_carbonflux_inst%Summary(bounds, num_bgc_soilc, filter_bgc_soilc, & + num_bgc_vegp, filter_bgc_vegp, & c14_soilbiogeochem_carbonflux_inst%decomp_cascade_ctransfer_col(begc:endc,1:ndecomp_cascade_transitions), & c14_soilbiogeochem_carbonstate_inst%cwdc_col(begc:endc), & soilbiogeochem_nitrogenstate_inst%cwdn_col(begc:endc), & leafc_to_litter_patch=c14_cnveg_carbonflux_inst%leafc_to_litter_patch, & frootc_to_litter_patch=c14_cnveg_carbonflux_inst%frootc_to_litter_patch) end if - call soilbiogeochem_nitrogenflux_inst%Summary(bounds, num_soilc, filter_soilc) + call soilbiogeochem_nitrogenflux_inst%Summary(bounds, num_bgc_soilc, filter_bgc_soilc) ! ---------------------------------------------- ! cnveg carbon/nitrogen flux summary ! ---------------------------------------------- - if_soilp: if(num_soilp>0) then + if_bgc_vegp: if(num_bgc_vegp>0) then call t_startf('CNvegCflux_summary') - call cnveg_carbonflux_inst%Summary(bounds, num_soilc, filter_soilc, num_soilp, filter_soilp, & + call cnveg_carbonflux_inst%Summary(bounds, num_bgc_soilc, filter_bgc_soilc, num_bgc_vegp, filter_bgc_vegp, & isotope='bulk', & soilbiogeochem_hr_col=soilbiogeochem_carbonflux_inst%hr_col(begc:endc), & soilbiogeochem_cwdhr_col=soilbiogeochem_carbonflux_inst%cwdhr_col(begc:endc), & @@ -1252,7 +1252,7 @@ subroutine CNDriverSummarizeFluxes(bounds, & product_closs_grc=c_products_inst%product_loss_grc(begg:endg)) if ( use_c13 ) then - call c13_cnveg_carbonflux_inst%Summary(bounds, num_soilc, filter_soilc, num_soilp, filter_soilp, & + call c13_cnveg_carbonflux_inst%Summary(bounds, num_bgc_soilc, filter_bgc_soilc, num_bgc_vegp, filter_bgc_vegp, & isotope='c13', & soilbiogeochem_hr_col=c13_soilbiogeochem_carbonflux_inst%hr_col(begc:endc), & soilbiogeochem_cwdhr_col=c13_soilbiogeochem_carbonflux_inst%cwdhr_col(begc:endc), & @@ -1263,7 +1263,7 @@ subroutine CNDriverSummarizeFluxes(bounds, & end if if ( use_c14 ) then - call c14_cnveg_carbonflux_inst%Summary(bounds, num_soilc, filter_soilc, num_soilp, filter_soilp, & + call c14_cnveg_carbonflux_inst%Summary(bounds, num_bgc_soilc, filter_bgc_soilc, num_bgc_vegp, filter_bgc_vegp, & isotope='c14', & soilbiogeochem_hr_col=c14_soilbiogeochem_carbonflux_inst%hr_col(begc:endc), & soilbiogeochem_cwdhr_col=c14_soilbiogeochem_carbonflux_inst%cwdhr_col(begc:endc), & @@ -1274,8 +1274,8 @@ subroutine CNDriverSummarizeFluxes(bounds, & end if call t_stopf('CNvegCflux_summary') - call cnveg_nitrogenflux_inst%Summary(bounds, num_soilc, filter_soilc, num_soilp, filter_soilp) - end if if_soilp + call cnveg_nitrogenflux_inst%Summary(bounds, num_bgc_soilc, filter_bgc_soilc, num_bgc_vegp, filter_bgc_vegp) + end if if_bgc_vegp call t_stopf('CNsum') diff --git a/src/biogeochem/CNFireEmissionsMod.F90 b/src/biogeochem/CNFireEmissionsMod.F90 index 645f074a7d..5a15e138d5 100644 --- a/src/biogeochem/CNFireEmissionsMod.F90 +++ b/src/biogeochem/CNFireEmissionsMod.F90 @@ -185,7 +185,7 @@ subroutine InitHistory(this, bounds) end subroutine InitHistory !----------------------------------------------------------------------- - subroutine CNFireEmisUpdate(bounds, num_soilp, filter_soilp, cnveg_cf_inst, cnveg_cs_inst, fireemis_inst ) + subroutine CNFireEmisUpdate(bounds, num_bgc_vegp, filter_bgc_vegp, cnveg_cf_inst, cnveg_cs_inst, fireemis_inst ) use CNVegcarbonfluxType, only : cnveg_carbonflux_type use CNVegCarbonStateType, only : cnveg_carbonstate_type @@ -194,8 +194,8 @@ subroutine CNFireEmisUpdate(bounds, num_soilp, filter_soilp, cnveg_cf_inst, cnve !ARGUMENTS: type(bounds_type), intent(in) :: bounds - integer, intent(in) :: num_soilp ! number of soil pfts in filter - integer, intent(in) :: filter_soilp(:) ! filter for soil pfts + integer, intent(in) :: num_bgc_vegp ! number of bgc veg patches + integer, intent(in) :: filter_bgc_vegp(:) ! filter for bgc veg patches type(cnveg_carbonflux_type), intent(in) :: cnveg_cf_inst type(cnveg_carbonstate_type),intent(in) :: cnveg_cs_inst type(fireemis_type), intent(inout) :: fireemis_inst @@ -235,8 +235,8 @@ subroutine CNFireEmisUpdate(bounds, num_soilp, filter_soilp, cnveg_cf_inst, cnve ! Begin loop over points !_______________________________________________________________________________ - do fp = 1,num_soilp - p = filter_soilp(fp) + do fp = 1,num_bgc_vegp + p = filter_bgc_vegp(fp) g = patch%gridcell(p) c = patch%column(p) diff --git a/src/biogeochem/CNPrecisionControlMod.F90 b/src/biogeochem/CNPrecisionControlMod.F90 index 8b98f6c3fb..787a5b54d7 100644 --- a/src/biogeochem/CNPrecisionControlMod.F90 +++ b/src/biogeochem/CNPrecisionControlMod.F90 @@ -96,7 +96,7 @@ subroutine CNPrecisionControlReadNML( NLFilename ) end subroutine CNPrecisionControlReadNML !----------------------------------------------------------------------- - subroutine CNPrecisionControl(bounds, num_soilp, filter_soilp, & + subroutine CNPrecisionControl(bounds, num_bgc_vegp, filter_bgc_vegp, & cnveg_carbonstate_inst, c13_cnveg_carbonstate_inst, c14_cnveg_carbonstate_inst, & cnveg_nitrogenstate_inst) ! @@ -111,8 +111,8 @@ subroutine CNPrecisionControl(bounds, num_soilp, filter_soilp, & ! ! !ARGUMENTS: type(bounds_type) , intent(in) :: bounds ! bounds - integer , intent(in) :: num_soilp ! number of soil patchs in filter - integer , intent(in) :: filter_soilp(:) ! filter for soil patches + integer , intent(in) :: num_bgc_vegp ! number of bgc veg patches in filter + integer , intent(in) :: filter_bgc_vegp(:) ! filter for bgc veg patches type(cnveg_carbonstate_type) , intent(inout) :: cnveg_carbonstate_inst type(cnveg_carbonstate_type) , intent(inout) :: c13_cnveg_carbonstate_inst type(cnveg_carbonstate_type) , intent(inout) :: c14_cnveg_carbonstate_inst @@ -190,8 +190,8 @@ subroutine CNPrecisionControl(bounds, num_soilp, filter_soilp, & ) ! patch loop - do fp = 1,num_soilp - p = filter_soilp(fp) + do fp = 1,num_bgc_vegp + p = filter_bgc_vegp(fp) ! initialize the patch-level C and N truncation terms pc(p) = 0._r8 @@ -205,7 +205,7 @@ subroutine CNPrecisionControl(bounds, num_soilp, filter_soilp, & ! the C component, but truncate C, C13, and N components ! leaf C and N - call TruncateCandNStates( bounds, filter_soilp, num_soilp, cs%leafc_patch(bounds%begp:bounds%endp), & + call TruncateCandNStates( bounds, filter_bgc_vegp, num_bgc_vegp, cs%leafc_patch(bounds%begp:bounds%endp), & ns%leafn_patch(bounds%begp:bounds%endp), & pc(bounds%begp:), pn(bounds%begp:), __LINE__, & num_truncatep, filter_truncatep) @@ -223,7 +223,7 @@ subroutine CNPrecisionControl(bounds, num_soilp, filter_soilp, & ! leaf storage C and N - call TruncateCandNStates( bounds, filter_soilp, num_soilp, cs%leafc_storage_patch(bounds%begp:bounds%endp), & + call TruncateCandNStates( bounds, filter_bgc_vegp, num_bgc_vegp, cs%leafc_storage_patch(bounds%begp:bounds%endp), & ns%leafn_storage_patch(bounds%begp:bounds%endp), pc(bounds%begp:), pn(bounds%begp:), __LINE__, & num_truncatep, filter_truncatep) if (use_c13) then @@ -238,7 +238,7 @@ subroutine CNPrecisionControl(bounds, num_soilp, filter_soilp, & end if ! leaf transfer C and N - call TruncateCandNStates( bounds, filter_soilp, num_soilp, cs%leafc_xfer_patch(bounds%begp:bounds%endp), & + call TruncateCandNStates( bounds, filter_bgc_vegp, num_bgc_vegp, cs%leafc_xfer_patch(bounds%begp:bounds%endp), & ns%leafn_xfer_patch(bounds%begp:bounds%endp), pc(bounds%begp:), pn(bounds%begp:), __LINE__, & num_truncatep, filter_truncatep) if (use_c13) then @@ -256,7 +256,7 @@ subroutine CNPrecisionControl(bounds, num_soilp, filter_soilp, & ! EBK KO DML: For some reason frootc/frootn can go negative and allowing ! it to be negative is important for C4 crops (otherwise they die) Jun/3/2016 if ( prec_control_for_froot ) then - call TruncateCandNStates( bounds, filter_soilp, num_soilp, cs%frootc_patch(bounds%begp:bounds%endp), & + call TruncateCandNStates( bounds, filter_bgc_vegp, num_bgc_vegp, cs%frootc_patch(bounds%begp:bounds%endp), & ns%frootn_patch(bounds%begp:bounds%endp), pc(bounds%begp:), pn(bounds%begp:), __LINE__, & num_truncatep, filter_truncatep, allowneg=.true.) if (use_c13) then @@ -272,7 +272,7 @@ subroutine CNPrecisionControl(bounds, num_soilp, filter_soilp, & end if ! froot storage C and N - call TruncateCandNStates( bounds, filter_soilp, num_soilp, cs%frootc_storage_patch(bounds%begp:bounds%endp), & + call TruncateCandNStates( bounds, filter_bgc_vegp, num_bgc_vegp, cs%frootc_storage_patch(bounds%begp:bounds%endp), & ns%frootn_storage_patch(bounds%begp:bounds%endp), pc(bounds%begp:), pn(bounds%begp:), & __LINE__, num_truncatep, filter_truncatep) if (use_c13) then @@ -287,7 +287,7 @@ subroutine CNPrecisionControl(bounds, num_soilp, filter_soilp, & end if ! froot transfer C and N - call TruncateCandNStates( bounds, filter_soilp, num_soilp, cs%frootc_xfer_patch(bounds%begp:bounds%endp), & + call TruncateCandNStates( bounds, filter_bgc_vegp, num_bgc_vegp, cs%frootc_xfer_patch(bounds%begp:bounds%endp), & ns%frootn_xfer_patch(bounds%begp:bounds%endp), pc(bounds%begp:), pn(bounds%begp:), __LINE__, & num_truncatep, filter_truncatep) if (use_c13) then @@ -304,7 +304,7 @@ subroutine CNPrecisionControl(bounds, num_soilp, filter_soilp, & if ( use_crop )then do k = 1, nrepr ! grain C and N - call TruncateCandNStates( bounds, filter_soilp, num_soilp, cs%reproductivec_patch(bounds%begp:bounds%endp,k), & + call TruncateCandNStates( bounds, filter_bgc_vegp, num_bgc_vegp, cs%reproductivec_patch(bounds%begp:bounds%endp,k), & ns%reproductiven_patch(bounds%begp:bounds%endp,k), pc(bounds%begp:), pn(bounds%begp:), __LINE__, & num_truncatep, filter_truncatep, croponly=.true. ) if (use_c13) then @@ -319,7 +319,7 @@ subroutine CNPrecisionControl(bounds, num_soilp, filter_soilp, & end if ! grain storage C and N - call TruncateCandNStates( bounds, filter_soilp, num_soilp, & + call TruncateCandNStates( bounds, filter_bgc_vegp, num_bgc_vegp, & cs%reproductivec_storage_patch(bounds%begp:bounds%endp,k), & ns%reproductiven_storage_patch(bounds%begp:bounds%endp,k), pc(bounds%begp:), pn(bounds%begp:), & __LINE__, num_truncatep, filter_truncatep, croponly=.true. ) @@ -336,7 +336,7 @@ subroutine CNPrecisionControl(bounds, num_soilp, filter_soilp, & end if ! grain transfer C and N - call TruncateCandNStates( bounds, filter_soilp, num_soilp, & + call TruncateCandNStates( bounds, filter_bgc_vegp, num_bgc_vegp, & cs%reproductivec_xfer_patch(bounds%begp:bounds%endp,k), & ns%reproductiven_xfer_patch(bounds%begp:bounds%endp,k), pc(bounds%begp:), pn(bounds%begp:), __LINE__, & num_truncatep, filter_truncatep, croponly=.true.) @@ -352,7 +352,7 @@ subroutine CNPrecisionControl(bounds, num_soilp, filter_soilp, & end if end do ! grain transfer C and N - call TruncateCandNStates( bounds, filter_soilp, num_soilp, cs%cropseedc_deficit_patch(bounds%begp:bounds%endp), & + call TruncateCandNStates( bounds, filter_bgc_vegp, num_bgc_vegp, cs%cropseedc_deficit_patch(bounds%begp:bounds%endp), & ns%cropseedn_deficit_patch(bounds%begp:bounds%endp), pc(bounds%begp:), & pn(bounds%begp:), __LINE__, & num_truncatep, filter_truncatep, & @@ -371,7 +371,7 @@ subroutine CNPrecisionControl(bounds, num_soilp, filter_soilp, & end if ! livestem C and N - call TruncateCandNStates( bounds, filter_soilp, num_soilp, cs%livestemc_patch(bounds%begp:bounds%endp), & + call TruncateCandNStates( bounds, filter_bgc_vegp, num_bgc_vegp, cs%livestemc_patch(bounds%begp:bounds%endp), & ns%livestemn_patch(bounds%begp:bounds%endp), pc(bounds%begp:), pn(bounds%begp:), __LINE__, & num_truncatep, filter_truncatep) if (use_c13) then @@ -386,7 +386,7 @@ subroutine CNPrecisionControl(bounds, num_soilp, filter_soilp, & end if ! livestem storage C and N - call TruncateCandNStates( bounds, filter_soilp, num_soilp, cs%livestemc_storage_patch(bounds%begp:bounds%endp), & + call TruncateCandNStates( bounds, filter_bgc_vegp, num_bgc_vegp, cs%livestemc_storage_patch(bounds%begp:bounds%endp), & ns%livestemn_storage_patch(bounds%begp:bounds%endp), pc(bounds%begp:), pn(bounds%begp:), & __LINE__, num_truncatep, filter_truncatep) @@ -401,7 +401,7 @@ subroutine CNPrecisionControl(bounds, num_soilp, filter_soilp, & __LINE__) end if ! livestem transfer C and N - call TruncateCandNStates( bounds, filter_soilp, num_soilp, cs%livestemc_xfer_patch(bounds%begp:bounds%endp), & + call TruncateCandNStates( bounds, filter_bgc_vegp, num_bgc_vegp, cs%livestemc_xfer_patch(bounds%begp:bounds%endp), & ns%livestemn_xfer_patch(bounds%begp:bounds%endp), pc(bounds%begp:), pn(bounds%begp:), & __LINE__, num_truncatep, filter_truncatep) if (use_c13) then @@ -416,7 +416,7 @@ subroutine CNPrecisionControl(bounds, num_soilp, filter_soilp, & end if ! deadstem C and N - call TruncateCandNStates( bounds, filter_soilp, num_soilp, cs%deadstemc_patch(bounds%begp:bounds%endp), & + call TruncateCandNStates( bounds, filter_bgc_vegp, num_bgc_vegp, cs%deadstemc_patch(bounds%begp:bounds%endp), & ns%deadstemn_patch(bounds%begp:bounds%endp), pc(bounds%begp:), pn(bounds%begp:), __LINE__, & num_truncatep, filter_truncatep) if (use_c13) then @@ -430,7 +430,7 @@ subroutine CNPrecisionControl(bounds, num_soilp, filter_soilp, & __LINE__) end if ! deadstem storage C and N - call TruncateCandNStates( bounds, filter_soilp, num_soilp, cs%deadstemc_storage_patch(bounds%begp:bounds%endp), & + call TruncateCandNStates( bounds, filter_bgc_vegp, num_bgc_vegp, cs%deadstemc_storage_patch(bounds%begp:bounds%endp), & ns%deadstemn_storage_patch(bounds%begp:bounds%endp), pc(bounds%begp:), pn(bounds%begp:), & __LINE__, num_truncatep, filter_truncatep) if (use_c13) then @@ -445,7 +445,7 @@ subroutine CNPrecisionControl(bounds, num_soilp, filter_soilp, & end if ! deadstem transfer C and N - call TruncateCandNStates( bounds, filter_soilp, num_soilp, cs%deadstemc_xfer_patch(bounds%begp:bounds%endp), & + call TruncateCandNStates( bounds, filter_bgc_vegp, num_bgc_vegp, cs%deadstemc_xfer_patch(bounds%begp:bounds%endp), & ns%deadstemn_xfer_patch(bounds%begp:bounds%endp), pc(bounds%begp:), pn(bounds%begp:), & __LINE__, num_truncatep, filter_truncatep) if (use_c13) then @@ -460,7 +460,7 @@ subroutine CNPrecisionControl(bounds, num_soilp, filter_soilp, & end if ! livecroot C and N - call TruncateCandNStates( bounds, filter_soilp, num_soilp, cs%livecrootc_patch(bounds%begp:bounds%endp), & + call TruncateCandNStates( bounds, filter_bgc_vegp, num_bgc_vegp, cs%livecrootc_patch(bounds%begp:bounds%endp), & ns%livecrootn_patch(bounds%begp:bounds%endp), pc(bounds%begp:), pn(bounds%begp:), __LINE__, & num_truncatep, filter_truncatep) if (use_c13) then @@ -475,7 +475,7 @@ subroutine CNPrecisionControl(bounds, num_soilp, filter_soilp, & end if ! livecroot storage C and N - call TruncateCandNStates( bounds, filter_soilp, num_soilp, cs%livecrootc_storage_patch(bounds%begp:bounds%endp), & + call TruncateCandNStates( bounds, filter_bgc_vegp, num_bgc_vegp, cs%livecrootc_storage_patch(bounds%begp:bounds%endp), & ns%livecrootn_storage_patch(bounds%begp:bounds%endp), pc(bounds%begp:), pn(bounds%begp:), & __LINE__, num_truncatep, filter_truncatep) if (use_c13) then @@ -490,7 +490,7 @@ subroutine CNPrecisionControl(bounds, num_soilp, filter_soilp, & end if ! livecroot transfer C and N - call TruncateCandNStates( bounds, filter_soilp, num_soilp, cs%livecrootc_xfer_patch(bounds%begp:bounds%endp), & + call TruncateCandNStates( bounds, filter_bgc_vegp, num_bgc_vegp, cs%livecrootc_xfer_patch(bounds%begp:bounds%endp), & ns%livecrootn_xfer_patch(bounds%begp:bounds%endp), pc(bounds%begp:), pn(bounds%begp:), & __LINE__, num_truncatep, filter_truncatep) @@ -506,7 +506,7 @@ subroutine CNPrecisionControl(bounds, num_soilp, filter_soilp, & end if ! deadcroot C and N - call TruncateCandNStates( bounds, filter_soilp, num_soilp, cs%deadcrootc_patch(bounds%begp:bounds%endp), & + call TruncateCandNStates( bounds, filter_bgc_vegp, num_bgc_vegp, cs%deadcrootc_patch(bounds%begp:bounds%endp), & ns%deadcrootn_patch(bounds%begp:bounds%endp), pc(bounds%begp:), pn(bounds%begp:), __LINE__, & num_truncatep, filter_truncatep) if (use_c13) then @@ -521,7 +521,7 @@ subroutine CNPrecisionControl(bounds, num_soilp, filter_soilp, & end if ! deadcroot storage C and N - call TruncateCandNStates( bounds, filter_soilp, num_soilp, cs%deadcrootc_storage_patch(bounds%begp:bounds%endp), & + call TruncateCandNStates( bounds, filter_bgc_vegp, num_bgc_vegp, cs%deadcrootc_storage_patch(bounds%begp:bounds%endp), & ns%deadcrootn_storage_patch(bounds%begp:bounds%endp), pc(bounds%begp:), pn(bounds%begp:), & __LINE__, num_truncatep, filter_truncatep) if (use_c13) then @@ -536,7 +536,7 @@ subroutine CNPrecisionControl(bounds, num_soilp, filter_soilp, & end if ! deadcroot transfer C and N - call TruncateCandNStates( bounds, filter_soilp, num_soilp, cs%deadcrootc_xfer_patch(bounds%begp:bounds%endp), & + call TruncateCandNStates( bounds, filter_bgc_vegp, num_bgc_vegp, cs%deadcrootc_xfer_patch(bounds%begp:bounds%endp), & ns%deadcrootn_xfer_patch(bounds%begp:bounds%endp), pc(bounds%begp:), pn(bounds%begp:), & __LINE__, num_truncatep, filter_truncatep) if (use_c13) then @@ -551,7 +551,7 @@ subroutine CNPrecisionControl(bounds, num_soilp, filter_soilp, & end if ! gresp_storage (C only) - call TruncateCStates( bounds, filter_soilp, num_soilp, cs%gresp_storage_patch(bounds%begp:bounds%endp), & + call TruncateCStates( bounds, filter_bgc_vegp, num_bgc_vegp, cs%gresp_storage_patch(bounds%begp:bounds%endp), & pc(bounds%begp:), __LINE__, num_truncatep, filter_truncatep) if (use_c13) then call TruncateAdditional( bounds, num_truncatep, filter_truncatep, & @@ -565,7 +565,7 @@ subroutine CNPrecisionControl(bounds, num_soilp, filter_soilp, & end if ! gresp_xfer(c only) - call TruncateCStates( bounds, filter_soilp, num_soilp, cs%gresp_xfer_patch(bounds%begp:bounds%endp), & + call TruncateCStates( bounds, filter_bgc_vegp, num_bgc_vegp, cs%gresp_xfer_patch(bounds%begp:bounds%endp), & pc(bounds%begp:), __LINE__, num_truncatep, filter_truncatep) if (use_c13) then call TruncateAdditional( bounds, num_truncatep, filter_truncatep, & @@ -579,7 +579,7 @@ subroutine CNPrecisionControl(bounds, num_soilp, filter_soilp, & end if ! cpool (C only) - call TruncateCStates( bounds, filter_soilp, num_soilp, cs%cpool_patch(bounds%begp:bounds%endp), & + call TruncateCStates( bounds, filter_bgc_vegp, num_bgc_vegp, cs%cpool_patch(bounds%begp:bounds%endp), & pc(bounds%begp:), __LINE__, num_truncatep, filter_truncatep) if (use_c13) then call TruncateAdditional( bounds, num_truncatep, filter_truncatep, & @@ -595,7 +595,7 @@ subroutine CNPrecisionControl(bounds, num_soilp, filter_soilp, & if ( use_crop )then ! xsmrpool (C only) ! xsmr is a pool to balance the budget and as such can be freely negative - call TruncateCStates( bounds, filter_soilp, num_soilp, cs%xsmrpool_patch(bounds%begp:bounds%endp), & + call TruncateCStates( bounds, filter_bgc_vegp, num_bgc_vegp, cs%xsmrpool_patch(bounds%begp:bounds%endp), & pc(bounds%begp:), __LINE__, num_truncatep, filter_truncatep, & allowneg=.true., croponly=.true. ) if (use_c13) then @@ -612,16 +612,16 @@ subroutine CNPrecisionControl(bounds, num_soilp, filter_soilp, & end if ! retransn (N only) - call TruncateNStates( bounds, filter_soilp, num_soilp, ns%retransn_patch(bounds%begp:bounds%endp), pn(bounds%begp:), & + call TruncateNStates( bounds, filter_bgc_vegp, num_bgc_vegp, ns%retransn_patch(bounds%begp:bounds%endp), pn(bounds%begp:), & __LINE__ ) ! npool (N only) - call TruncateNStates( bounds, filter_soilp, num_soilp, ns%npool_patch(bounds%begp:bounds%endp), pn(bounds%begp:), & + call TruncateNStates( bounds, filter_bgc_vegp, num_bgc_vegp, ns%npool_patch(bounds%begp:bounds%endp), pn(bounds%begp:), & __LINE__ ) ! patch loop - do fp = 1,num_soilp - p = filter_soilp(fp) + do fp = 1,num_bgc_vegp + p = filter_bgc_vegp(fp) cs%ctrunc_patch(p) = cs%ctrunc_patch(p) + pc(p) @@ -639,7 +639,7 @@ subroutine CNPrecisionControl(bounds, num_soilp, filter_soilp, & end subroutine CNPrecisionControl - subroutine TruncateCandNStates( bounds, filter_soilp, num_soilp, carbon_patch, nitrogen_patch, pc, pn, lineno, & + subroutine TruncateCandNStates( bounds, filter_bgc_vegp, num_bgc_vegp, carbon_patch, nitrogen_patch, pc, pn, lineno, & num_truncatep, filter_truncatep, croponly, allowneg ) ! ! !DESCRIPTION: @@ -657,8 +657,8 @@ subroutine TruncateCandNStates( bounds, filter_soilp, num_soilp, carbon_patch, n ! !ARGUMENTS: implicit none type(bounds_type) , intent(in) :: bounds ! bounds - integer , intent(in) :: num_soilp ! number of soil patchs in filter - integer , intent(in) :: filter_soilp(:) ! filter for soil patches + integer , intent(in) :: num_bgc_vegp ! number of bgc veg patches in filter + integer , intent(in) :: filter_bgc_vegp(:) ! filter for bgc veg patches real(r8), intent(inout) :: carbon_patch(bounds%begp:) real(r8), intent(inout) :: nitrogen_patch(bounds%begp:) real(r8), intent(inout) :: pc(bounds%begp:) @@ -688,8 +688,8 @@ subroutine TruncateCandNStates( bounds, filter_soilp, num_soilp, carbon_patch, n end if num_truncatep = 0 - do fp = 1,num_soilp - p = filter_soilp(fp) + do fp = 1,num_bgc_vegp + p = filter_bgc_vegp(fp) if ( .not. lcroponly .or. (patch%itype(p) >= nc3crop) ) then if ( .not. lallowneg .and. ((carbon_patch(p) < cnegcrit) .or. (nitrogen_patch(p) < nnegcrit)) ) then @@ -733,7 +733,7 @@ subroutine TruncateCandNStates( bounds, filter_soilp, num_soilp, carbon_patch, n end do end subroutine TruncateCandNStates - subroutine TruncateCStates( bounds, filter_soilp, num_soilp, carbon_patch, pc, lineno, & + subroutine TruncateCStates( bounds, filter_bgc_vegp, num_bgc_vegp, carbon_patch, pc, lineno, & num_truncatep, filter_truncatep, croponly, allowneg ) ! ! !DESCRIPTION: @@ -751,8 +751,8 @@ subroutine TruncateCStates( bounds, filter_soilp, num_soilp, carbon_patch, pc, l ! !ARGUMENTS: implicit none type(bounds_type), intent(in) :: bounds ! bounds - integer , intent(in) :: num_soilp ! number of soil patchs in filter - integer , intent(in) :: filter_soilp(:) ! filter for soil patches + integer , intent(in) :: num_bgc_vegp ! number of bgc veg patches in filter + integer , intent(in) :: filter_bgc_vegp(:) ! filter for bgc veg patches real(r8) , intent(inout) :: carbon_patch(bounds%begp:) real(r8) , intent(inout) :: pc(bounds%begp:) integer , intent(in) :: lineno @@ -780,8 +780,8 @@ subroutine TruncateCStates( bounds, filter_soilp, num_soilp, carbon_patch, pc, l end if num_truncatep = 0 - do fp = 1,num_soilp - p = filter_soilp(fp) + do fp = 1,num_bgc_vegp + p = filter_bgc_vegp(fp) if ( .not. lcroponly .or. (patch%itype(p) >= nc3crop) ) then if ( .not. lallowneg .and. (carbon_patch(p) < cnegcrit) ) then @@ -801,7 +801,7 @@ subroutine TruncateCStates( bounds, filter_soilp, num_soilp, carbon_patch, pc, l end do end subroutine TruncateCStates - subroutine TruncateNStates( bounds, filter_soilp, num_soilp, nitrogen_patch, pn, lineno ) + subroutine TruncateNStates( bounds, filter_bgc_vegp, num_bgc_vegp, nitrogen_patch, pn, lineno ) ! ! !DESCRIPTION: ! Truncate Nitrogen states. If a nitrogen state is too small truncate it to @@ -816,8 +816,8 @@ subroutine TruncateNStates( bounds, filter_soilp, num_soilp, nitrogen_patch, pn, ! !ARGUMENTS: implicit none type(bounds_type) , intent(in) :: bounds ! bounds - integer , intent(in) :: num_soilp ! number of soil patchs in filter - integer , intent(in) :: filter_soilp(:) ! filter for soil patches + integer , intent(in) :: num_bgc_vegp ! number of bgc veg patches in filter + integer , intent(in) :: filter_bgc_vegp(:) ! filter for bgc veg patches real(r8), intent(inout) :: nitrogen_patch(bounds%begp:) real(r8), intent(inout) :: pn(bounds%begp:) integer, intent(in) :: lineno @@ -826,8 +826,8 @@ subroutine TruncateNStates( bounds, filter_soilp, num_soilp, nitrogen_patch, pn, SHR_ASSERT_ALL_FL((ubound(nitrogen_patch) == (/bounds%endp/)), sourcefile, __LINE__) SHR_ASSERT_ALL_FL((ubound(pn) == (/bounds%endp/)), sourcefile, __LINE__) - do fp = 1,num_soilp - p = filter_soilp(fp) + do fp = 1,num_bgc_vegp + p = filter_bgc_vegp(fp) if ( nitrogen_patch(p) < nnegcrit ) then ! write(iulog,*) 'WARNING: Nitrogen patch negative = ', nitrogen_patch ! call endrun(subgrid_index=p, subgrid_level=subgrid_level_patch, & diff --git a/src/biogeochem/CNVegCarbonStateType.F90 b/src/biogeochem/CNVegCarbonStateType.F90 index b2ca4c4792..d2a2c06f90 100644 --- a/src/biogeochem/CNVegCarbonStateType.F90 +++ b/src/biogeochem/CNVegCarbonStateType.F90 @@ -2587,7 +2587,7 @@ subroutine ZeroDwt( this, bounds ) end subroutine ZeroDwt !----------------------------------------------------------------------- - subroutine Summary_carbonstate(this, bounds, num_soilc, filter_soilc, num_soilp, filter_soilp) + subroutine Summary_carbonstate(this, bounds, num_bgc_soilc, filter_bgc_soilc, num_bgc_vegp, filter_bgc_vegp) ! ! !USES: @@ -2601,10 +2601,10 @@ subroutine Summary_carbonstate(this, bounds, num_soilc, filter_soilc, num_soilp, ! !ARGUMENTS: class(cnveg_carbonstate_type) :: this type(bounds_type) , intent(in) :: bounds - integer , intent(in) :: num_soilc ! number of soil columns in filter - integer , intent(in) :: filter_soilc(:) ! filter for soil columns - integer , intent(in) :: num_soilp ! number of soil patches in filter - integer , intent(in) :: filter_soilp(:) ! filter for soil patches + integer , intent(in) :: num_bgc_soilc ! number of bgc soil columns in filter + integer , intent(in) :: filter_bgc_soilc(:) ! filter for bgc soil columns + integer , intent(in) :: num_bgc_vegp ! number of soil patches in filter + integer , intent(in) :: filter_bgc_vegp(:) ! filter for soil patches ! ! !LOCAL VARIABLES: @@ -2613,8 +2613,8 @@ subroutine Summary_carbonstate(this, bounds, num_soilc, filter_soilc, num_soilp, !----------------------------------------------------------------------- ! calculate patch -level summary of carbon state - do fp = 1,num_soilp - p = filter_soilp(fp) + do fp = 1,num_bgc_vegp + p = filter_bgc_vegp(fp) ! displayed vegetation carbon, excluding storage and cpool (DISPVEGC) this%dispvegc_patch(p) = & @@ -2685,11 +2685,11 @@ subroutine Summary_carbonstate(this, bounds, num_soilc, filter_soilc, num_soilp, ! column level summary ! -------------------------------------------- if(associated(this%totvegc_patch))then - call p2c(bounds, num_soilc, filter_soilc, & + call p2c(bounds, num_bgc_soilc, filter_bgc_soilc, & this%totvegc_patch(bounds%begp:bounds%endp), & this%totvegc_col(bounds%begc:bounds%endc)) - call p2c(bounds, num_soilc, filter_soilc, & + call p2c(bounds, num_bgc_soilc, filter_bgc_soilc, & this%totc_patch(bounds%begp:bounds%endp), & this%totc_p2c_col(bounds%begc:bounds%endc)) end if diff --git a/src/biogeochem/CNVegetationFacade.F90 b/src/biogeochem/CNVegetationFacade.F90 index 6fdb897795..20b22d19ec 100644 --- a/src/biogeochem/CNVegetationFacade.F90 +++ b/src/biogeochem/CNVegetationFacade.F90 @@ -569,7 +569,7 @@ end subroutine Init2 !----------------------------------------------------------------------- - subroutine InitEachTimeStep(this, bounds, num_soilc, filter_soilc) + subroutine InitEachTimeStep(this, bounds, num_bgc_soilc, filter_bgc_soilc) ! ! !DESCRIPTION: ! Do initializations that need to be done at the start of every time step @@ -583,8 +583,8 @@ subroutine InitEachTimeStep(this, bounds, num_soilc, filter_soilc) ! !ARGUMENTS: class(cn_vegetation_type) , intent(inout) :: this type(bounds_type) , intent(in) :: bounds - integer , intent(in) :: num_soilc ! number of soil columns filter - integer , intent(in) :: filter_soilc(:) ! filter for soil columns + integer , intent(in) :: num_bgc_soilc ! number of soil columns filter + integer , intent(in) :: filter_bgc_soilc(:) ! filter for soil columns ! ! !LOCAL VARIABLES: @@ -769,7 +769,7 @@ end subroutine DynamicAreaConservation !----------------------------------------------------------------------- subroutine InitColumnBalance(this, bounds, num_allc, filter_allc, & - num_soilc, filter_soilc, num_soilp, filter_soilp, & + num_bgc_soilc, filter_bgc_soilc, num_bgc_vegp, filter_bgc_vegp, & soilbiogeochem_carbonstate_inst, & c13_soilbiogeochem_carbonstate_inst, & c14_soilbiogeochem_carbonstate_inst, & @@ -788,10 +788,10 @@ subroutine InitColumnBalance(this, bounds, num_allc, filter_allc, & type(bounds_type) , intent(in) :: bounds integer , intent(in) :: num_allc ! number of columns in allc filter integer , intent(in) :: filter_allc(:) ! filter for all active columns - integer , intent(in) :: num_soilc ! number of soil columns in filter - integer , intent(in) :: filter_soilc(:) ! filter for soil columns - integer , intent(in) :: num_soilp ! number of soil patches in filter - integer , intent(in) :: filter_soilp(:) ! filter for soil patches + integer , intent(in) :: num_bgc_soilc ! number of bgc soil columns in filter + integer , intent(in) :: filter_bgc_soilc(:) ! filter for bgc soil columns + integer , intent(in) :: num_bgc_vegp ! number of bgc vegetation patches in filter + integer , intent(in) :: filter_bgc_vegp(:) ! filter for bgc vegetation patches type(soilbiogeochem_carbonstate_type) , intent(inout) :: soilbiogeochem_carbonstate_inst type(soilbiogeochem_carbonstate_type) , intent(inout) :: c13_soilbiogeochem_carbonstate_inst type(soilbiogeochem_carbonstate_type) , intent(inout) :: c14_soilbiogeochem_carbonstate_inst @@ -804,8 +804,8 @@ subroutine InitColumnBalance(this, bounds, num_allc, filter_allc, & call CNDriverSummarizeStates(bounds, & num_allc, filter_allc, & - num_soilc, filter_soilc, & - num_soilp, filter_soilp, & + num_bgc_soilc, filter_bgc_soilc, & + num_bgc_vegp, filter_bgc_vegp, & this%cnveg_carbonstate_inst, & this%c13_cnveg_carbonstate_inst, & this%c14_cnveg_carbonstate_inst, & @@ -816,7 +816,7 @@ subroutine InitColumnBalance(this, bounds, num_allc, filter_allc, & soilbiogeochem_nitrogenstate_inst) call this%cn_balance_inst%BeginCNColumnBalance( & - bounds, num_soilc, filter_soilc, & + bounds, num_bgc_soilc, filter_bgc_soilc, & soilbiogeochem_carbonstate_inst,soilbiogeochem_nitrogenstate_inst) end subroutine InitColumnBalance @@ -824,7 +824,7 @@ end subroutine InitColumnBalance !----------------------------------------------------------------------- subroutine InitGridcellBalance(this, bounds, num_allc, filter_allc, & - num_soilc, filter_soilc, num_soilp, filter_soilp, & + num_bgc_soilc, filter_bgc_soilc, num_bgc_vegp, filter_bgc_vegp, & soilbiogeochem_carbonstate_inst, & c13_soilbiogeochem_carbonstate_inst, & c14_soilbiogeochem_carbonstate_inst, & @@ -844,10 +844,10 @@ subroutine InitGridcellBalance(this, bounds, num_allc, filter_allc, & type(bounds_type) , intent(in) :: bounds integer , intent(in) :: num_allc ! number of columns in allc filter integer , intent(in) :: filter_allc(:) ! filter for all active columns - integer , intent(in) :: num_soilc ! number of soil columns in filter - integer , intent(in) :: filter_soilc(:) ! filter for soil columns - integer , intent(in) :: num_soilp ! number of soil patches in filter - integer , intent(in) :: filter_soilp(:) ! filter for soil patches + integer , intent(in) :: num_bgc_soilc ! number of bgc soil columns in filter + integer , intent(in) :: filter_bgc_soilc(:) ! filter for bgc soil columns + integer , intent(in) :: num_bgc_vegp ! number of bgc vegetation patches in filter + integer , intent(in) :: filter_bgc_vegp(:) ! filter for bgc vegetation patches type(soilbiogeochem_carbonstate_type) , intent(inout) :: soilbiogeochem_carbonstate_inst type(soilbiogeochem_carbonstate_type) , intent(inout) :: c13_soilbiogeochem_carbonstate_inst type(soilbiogeochem_carbonstate_type) , intent(inout) :: c14_soilbiogeochem_carbonstate_inst @@ -861,8 +861,8 @@ subroutine InitGridcellBalance(this, bounds, num_allc, filter_allc, & call CNDriverSummarizeStates(bounds, & num_allc, filter_allc, & - num_soilc, filter_soilc, & - num_soilp, filter_soilp, & + num_bgc_soilc, filter_bgc_soilc, & + num_bgc_vegp, filter_bgc_vegp, & this%cnveg_carbonstate_inst, & this%c13_cnveg_carbonstate_inst, & this%c14_cnveg_carbonstate_inst, & @@ -929,10 +929,10 @@ subroutine EcosystemDynamicsPreDrainage(this, bounds, & ! !ARGUMENTS: class(cn_vegetation_type) , intent(inout) :: this type(bounds_type) , intent(in) :: bounds - integer , intent(in) :: num_bgc_soilc ! number of soil columns in filter - integer , intent(in) :: filter_bgc_soilc(:) ! filter for soil columns - integer , intent(in) :: num_bgc_vegp ! number of veg patches in filter - integer , intent(in) :: filter_bgc_vegp(:) ! filter for veg patches + integer , intent(in) :: num_bgc_soilc ! number of bgc soil columns in filter + integer , intent(in) :: filter_bgc_soilc(:) ! filter for bgc soil columns + integer , intent(in) :: num_bgc_vegp ! number of bgc veg patches in filter + integer , intent(in) :: filter_bgc_vegp(:) ! filter for bgc veg patches integer , intent(out) :: num_actfirec ! number of soil columns on fire in filter integer , intent(out) :: filter_actfirec(:)! filter for soil columns on fire integer , intent(out) :: num_actfirep ! number of soil patches on fire in filter @@ -1021,7 +1021,7 @@ end subroutine EcosystemDynamicsPreDrainage !----------------------------------------------------------------------- subroutine EcosystemDynamicsPostDrainage(this, bounds, num_allc, filter_allc, & - num_soilc, filter_soilc, num_soilp, filter_soilp, num_actfirec, filter_actfirec, num_actfirep, filter_actfirep,& + num_bgc_soilc, filter_bgc_soilc, num_bgc_vegp, filter_bgc_vegp, num_actfirec, filter_actfirec, num_actfirep, filter_actfirep,& doalb, crop_inst, soilstate_inst, soilbiogeochem_state_inst, & waterstatebulk_inst, waterdiagnosticbulk_inst, waterfluxbulk_inst, frictionvel_inst, canopystate_inst, & soilbiogeochem_carbonflux_inst, soilbiogeochem_carbonstate_inst, & @@ -1041,10 +1041,10 @@ subroutine EcosystemDynamicsPostDrainage(this, bounds, num_allc, filter_allc, & type(bounds_type) , intent(in) :: bounds integer , intent(in) :: num_allc ! number of columns in allc filter integer , intent(in) :: filter_allc(:) ! filter for all active columns - integer , intent(in) :: num_soilc ! number of soil columns in filter - integer , intent(in) :: filter_soilc(:) ! filter for soil columns - integer , intent(in) :: num_soilp ! number of soil patches in filter - integer , intent(in) :: filter_soilp(:) ! filter for soil patches + integer , intent(in) :: num_bgc_soilc ! number of bgc soil columns in filter + integer , intent(in) :: filter_bgc_soilc(:) ! filter for bgc soil columns + integer , intent(in) :: num_bgc_vegp ! number of bgc veg patches in filter + integer , intent(in) :: filter_bgc_vegp(:) ! filter for bgc veg patches integer , intent(in) :: num_actfirec ! number of soil columns on fire in filter integer , intent(in) :: filter_actfirec(:) ! filter for soil columns on fire integer , intent(in) :: num_actfirep ! number of soil patches on fire in filter @@ -1076,8 +1076,8 @@ subroutine EcosystemDynamicsPostDrainage(this, bounds, num_allc, filter_allc, & ! and total soil water outflow. call CNDriverLeaching(bounds, & - num_soilc, filter_soilc, & - num_soilp, filter_soilp, & + num_bgc_soilc, filter_bgc_soilc, & + num_bgc_vegp, filter_bgc_vegp, & num_actfirec, filter_actfirec, & num_actfirep, filter_actfirep, & waterstatebulk_inst, waterfluxbulk_inst, soilstate_inst, this%cnveg_state_inst, & @@ -1092,16 +1092,16 @@ subroutine EcosystemDynamicsPostDrainage(this, bounds, num_allc, filter_allc, & ! Set controls on very low values in critical state variables - if(num_soilp>0)then + if(num_bgc_vegp>0)then call t_startf('CNPrecisionControl') - call CNPrecisionControl(bounds, num_soilp, filter_soilp, & + call CNPrecisionControl(bounds, num_bgc_vegp, filter_bgc_vegp, & this%cnveg_carbonstate_inst, this%c13_cnveg_carbonstate_inst, & this%c14_cnveg_carbonstate_inst, this%cnveg_nitrogenstate_inst) call t_stopf('CNPrecisionControl') end if call t_startf('SoilBiogeochemPrecisionControl') - call SoilBiogeochemPrecisionControl(num_soilc, filter_soilc, & + call SoilBiogeochemPrecisionControl(num_bgc_soilc, filter_bgc_soilc, & soilbiogeochem_carbonstate_inst, c13_soilbiogeochem_carbonstate_inst, & c14_soilbiogeochem_carbonstate_inst,soilbiogeochem_nitrogenstate_inst) call t_stopf('SoilBiogeochemPrecisionControl') @@ -1110,8 +1110,8 @@ subroutine EcosystemDynamicsPostDrainage(this, bounds, num_allc, filter_allc, & call CNDriverSummarizeStates(bounds, & num_allc, filter_allc, & - num_soilc, filter_soilc, & - num_soilp, filter_soilp, & + num_bgc_soilc, filter_bgc_soilc, & + num_bgc_vegp, filter_bgc_vegp, & this%cnveg_carbonstate_inst, & this%c13_cnveg_carbonstate_inst, & this%c14_cnveg_carbonstate_inst, & @@ -1122,8 +1122,8 @@ subroutine EcosystemDynamicsPostDrainage(this, bounds, num_allc, filter_allc, & soilbiogeochem_nitrogenstate_inst) call CNDriverSummarizeFluxes(bounds, & - num_soilc, filter_soilc, & - num_soilp, filter_soilp, & + num_bgc_soilc, filter_bgc_soilc, & + num_bgc_vegp, filter_bgc_vegp, & this%cnveg_carbonflux_inst, & this%c13_cnveg_carbonflux_inst, & this%c14_cnveg_carbonflux_inst, & @@ -1142,7 +1142,7 @@ subroutine EcosystemDynamicsPostDrainage(this, bounds, num_allc, filter_allc, & ! vegetation structure (LAI, SAI, height) if (doalb) then - call CNVegStructUpdate(bounds,num_soilp, filter_soilp, & + call CNVegStructUpdate(bounds,num_bgc_vegp, filter_bgc_vegp, & waterdiagnosticbulk_inst, frictionvel_inst, this%dgvs_inst, this%cnveg_state_inst, & crop_inst, this%cnveg_carbonstate_inst, canopystate_inst) end if @@ -1150,7 +1150,7 @@ subroutine EcosystemDynamicsPostDrainage(this, bounds, num_allc, filter_allc, & end subroutine EcosystemDynamicsPostDrainage !----------------------------------------------------------------------- - subroutine BalanceCheck(this, bounds, num_soilc, filter_soilc, & + subroutine BalanceCheck(this, bounds, num_bgc_soilc, filter_bgc_soilc, & soilbiogeochem_carbonflux_inst, soilbiogeochem_nitrogenflux_inst, & soilbiogeochem_carbonstate_inst, soilbiogeochem_nitrogenstate_inst, & atm2lnd_inst, clm_fates) @@ -1167,8 +1167,8 @@ subroutine BalanceCheck(this, bounds, num_soilc, filter_soilc, & ! !ARGUMENTS: class(cn_vegetation_type) , intent(inout) :: this type(bounds_type) , intent(in) :: bounds - integer , intent(in) :: num_soilc ! number of soil columns in filter - integer , intent(in) :: filter_soilc(:) ! filter for soil columns + integer , intent(in) :: num_bgc_soilc ! number of soil columns in filter + integer , intent(in) :: filter_bgc_soilc(:) ! filter for soil columns type(soilbiogeochem_carbonflux_type) , intent(inout) :: soilbiogeochem_carbonflux_inst type(soilbiogeochem_nitrogenflux_type) , intent(inout) :: soilbiogeochem_nitrogenflux_inst type(soilbiogeochem_carbonstate_type) , intent(inout) :: soilbiogeochem_carbonstate_inst @@ -1192,7 +1192,7 @@ subroutine BalanceCheck(this, bounds, num_soilc, filter_soilc, & else call this%cn_balance_inst%CBalanceCheck( & - bounds, num_soilc, filter_soilc, & + bounds, num_bgc_soilc, filter_bgc_soilc, & soilbiogeochem_carbonflux_inst, & soilbiogeochem_carbonstate_inst, & this%cnveg_carbonflux_inst, & @@ -1201,7 +1201,7 @@ subroutine BalanceCheck(this, bounds, num_soilc, filter_soilc, & clm_fates) call this%cn_balance_inst%NBalanceCheck( & - bounds, num_soilc, filter_soilc, & + bounds, num_bgc_soilc, filter_bgc_soilc, & soilbiogeochem_nitrogenflux_inst, & soilbiogeochem_nitrogenstate_inst, & this%cnveg_nitrogenflux_inst, & diff --git a/src/main/clm_driver.F90 b/src/main/clm_driver.F90 index 5fb0d233ec..a83701d884 100644 --- a/src/main/clm_driver.F90 +++ b/src/main/clm_driver.F90 @@ -15,7 +15,7 @@ module clm_driver use clm_varctl , only : use_crop, irrigate, ndep_from_cpl use clm_varctl , only : use_soil_moisture_streams use clm_time_manager , only : get_nstep, is_beg_curr_day - use clm_time_manager , only : get_prev_date, is_first_step + use clm_time_manager , only : get_prev_date, is_first_steps use clm_varpar , only : nlevsno, nlevgrnd use clm_varorb , only : obliqr use spmdMod , only : masterproc, mpicom diff --git a/src/soilbiogeochem/SoilBiogeochemCarbonFluxType.F90 b/src/soilbiogeochem/SoilBiogeochemCarbonFluxType.F90 index 985a97eacc..d9ada3922d 100644 --- a/src/soilbiogeochem/SoilBiogeochemCarbonFluxType.F90 +++ b/src/soilbiogeochem/SoilBiogeochemCarbonFluxType.F90 @@ -746,7 +746,7 @@ end subroutine SetValues !----------------------------------------------------------------------- subroutine Summary(this, bounds, & - num_soilc, filter_soilc, num_soilp, filter_soilp, & + num_bgc_soilc, filter_bgc_soilc, num_soilp, filter_soilp, & soilbiogeochem_decomp_cascade_ctransfer_col, & soilbiogeochem_cwdc_col, soilbiogeochem_cwdn_col, & leafc_to_litter_patch, frootc_to_litter_patch) @@ -761,8 +761,8 @@ subroutine Summary(this, bounds, & ! !ARGUMENTS: class(soilbiogeochem_carbonflux_type) :: this type(bounds_type) , intent(in) :: bounds - integer , intent(in) :: num_soilc ! number of soil columns in filter - integer , intent(in) :: filter_soilc(:) ! filter for soil columns + integer , intent(in) :: num_bgc_soilc ! number of soil columns in filter + integer , intent(in) :: filter_bgc_soilc(:) ! filter for soil columns integer, intent(in), optional :: num_soilp ! number of patches in filter integer, intent(in), optional :: filter_soilp(:) ! filter for patches real(r8), intent(in), optional :: soilbiogeochem_cwdc_col(bounds%begc:) @@ -785,16 +785,16 @@ subroutine Summary(this, bounds, & !----------------------------------------------------------------------- - do fc = 1,num_soilc - c = filter_soilc(fc) + do fc = 1,num_bgc_soilc + c = filter_bgc_soilc(fc) this%som_c_leached_col(c) = 0._r8 end do ! vertically integrate HR and decomposition cascade fluxes do k = 1, ndecomp_cascade_transitions do j = 1,nlevdecomp - do fc = 1,num_soilc - c = filter_soilc(fc) + do fc = 1,num_bgc_soilc + c = filter_bgc_soilc(fc) this%decomp_cascade_hr_col(c,k) = & this%decomp_cascade_hr_col(c,k) + & this%decomp_cascade_hr_vr_col(c,j,k) * dzsoi_decomp(j) @@ -808,15 +808,15 @@ subroutine Summary(this, bounds, & ! total heterotrophic respiration, vertically resolved (HR) do j = 1,nlevdecomp - do fc = 1,num_soilc - c = filter_soilc(fc) + do fc = 1,num_bgc_soilc + c = filter_bgc_soilc(fc) this%hr_vr_col(c,j) = 0._r8 end do end do do k = 1, ndecomp_cascade_transitions do j = 1,nlevdecomp - do fc = 1,num_soilc - c = filter_soilc(fc) + do fc = 1,num_bgc_soilc + c = filter_bgc_soilc(fc) this%hr_vr_col(c,j) = & this%hr_vr_col(c,j) + & this%decomp_cascade_hr_vr_col(c,j,k) @@ -826,19 +826,19 @@ subroutine Summary(this, bounds, & ! add up all vertical transport tendency terms and calculate total som leaching loss as the sum of these do l = 1, ndecomp_pools - do fc = 1,num_soilc - c = filter_soilc(fc) + do fc = 1,num_bgc_soilc + c = filter_bgc_soilc(fc) this%decomp_cpools_leached_col(c,l) = 0._r8 end do do j = 1, nlevdecomp - do fc = 1,num_soilc - c = filter_soilc(fc) + do fc = 1,num_bgc_soilc + c = filter_bgc_soilc(fc) this%decomp_cpools_leached_col(c,l) = this%decomp_cpools_leached_col(c,l) + & this%decomp_cpools_transport_tendency_col(c,j,l) * dzsoi_decomp(j) end do end do - do fc = 1,num_soilc - c = filter_soilc(fc) + do fc = 1,num_bgc_soilc + c = filter_bgc_soilc(fc) this%som_c_leached_col(c) = this%som_c_leached_col(c) + this%decomp_cpools_leached_col(c,l) end do end do @@ -847,8 +847,8 @@ subroutine Summary(this, bounds, & associate(is_soil => decomp_cascade_con%is_soil) ! TRUE => pool is a soil pool do k = 1, ndecomp_cascade_transitions if ( is_soil(decomp_cascade_con%cascade_donor_pool(k)) ) then - do fc = 1,num_soilc - c = filter_soilc(fc) + do fc = 1,num_bgc_soilc + c = filter_bgc_soilc(fc) this%somhr_col(c) = this%somhr_col(c) + this%decomp_cascade_hr_col(c,k) end do end if @@ -859,8 +859,8 @@ subroutine Summary(this, bounds, & associate(is_litter => decomp_cascade_con%is_litter) ! TRUE => pool is a litter pool do k = 1, ndecomp_cascade_transitions if ( is_litter(decomp_cascade_con%cascade_donor_pool(k)) ) then - do fc = 1,num_soilc - c = filter_soilc(fc) + do fc = 1,num_bgc_soilc + c = filter_bgc_soilc(fc) this%lithr_col(c) = this%lithr_col(c) + this%decomp_cascade_hr_col(c,k) end do end if @@ -871,8 +871,8 @@ subroutine Summary(this, bounds, & associate(is_cwd => decomp_cascade_con%is_cwd) ! TRUE => pool is a cwd pool do k = 1, ndecomp_cascade_transitions if ( is_cwd(decomp_cascade_con%cascade_donor_pool(k)) ) then - do fc = 1,num_soilc - c = filter_soilc(fc) + do fc = 1,num_bgc_soilc + c = filter_bgc_soilc(fc) this%cwdhr_col(c) = this%cwdhr_col(c) + this%decomp_cascade_hr_col(c,k) end do end if @@ -883,8 +883,8 @@ subroutine Summary(this, bounds, & associate(is_microbe => decomp_cascade_con%is_microbe) ! TRUE => pool is a microbial pool do k = 1, ndecomp_cascade_transitions if ( is_microbe(decomp_cascade_con%cascade_donor_pool(k)) ) then - do fc = 1,num_soilc - c = filter_soilc(fc) + do fc = 1,num_bgc_soilc + c = filter_bgc_soilc(fc) this%michr_col(c) = this%michr_col(c) + this%decomp_cascade_hr_col(c,k) end do end if @@ -892,8 +892,8 @@ subroutine Summary(this, bounds, & end associate ! total heterotrophic respiration (HR) - do fc = 1,num_soilc - c = filter_soilc(fc) + do fc = 1,num_bgc_soilc + c = filter_bgc_soilc(fc) this%hr_col(c) = & this%michr_col(c) + & @@ -920,24 +920,24 @@ subroutine Summary(this, bounds, & end associate end do - call p2c(bounds, num_soilc, filter_soilc, & + call p2c(bounds, num_bgc_soilc, filter_bgc_soilc, & ligninNratio_leaf_patch(bounds%begp:bounds%endp), & ligninNratio_leaf_col(bounds%begc:bounds%endc)) - call p2c(bounds, num_soilc, filter_soilc, & + call p2c(bounds, num_bgc_soilc, filter_bgc_soilc, & ligninNratio_froot_patch(bounds%begp:bounds%endp), & ligninNratio_froot_col(bounds%begc:bounds%endc)) - call p2c(bounds, num_soilc, filter_soilc, & + call p2c(bounds, num_bgc_soilc, filter_bgc_soilc, & leafc_to_litter_patch(bounds%begp:bounds%endp), & leafc_to_litter_col(bounds%begc:bounds%endc)) - call p2c(bounds, num_soilc, filter_soilc, & + call p2c(bounds, num_bgc_soilc, filter_bgc_soilc, & frootc_to_litter_patch(bounds%begp:bounds%endp), & frootc_to_litter_col(bounds%begc:bounds%endc)) end if ! Calculate ligninNratioAve - do fc = 1,num_soilc - c = filter_soilc(fc) + do fc = 1,num_bgc_soilc + c = filter_bgc_soilc(fc) if(.not.col%is_fates(c)) then if (soilbiogeochem_cwdn_col(c) > 0._r8) then ligninNratio_cwd = CNParamsShareInst%cwd_flig * & diff --git a/src/soilbiogeochem/SoilBiogeochemCarbonStateType.F90 b/src/soilbiogeochem/SoilBiogeochemCarbonStateType.F90 index 6c52a5d34f..70976bc15a 100644 --- a/src/soilbiogeochem/SoilBiogeochemCarbonStateType.F90 +++ b/src/soilbiogeochem/SoilBiogeochemCarbonStateType.F90 @@ -931,7 +931,7 @@ subroutine SetValues ( this, num_column, filter_column, value_column) end subroutine SetValues !----------------------------------------------------------------------- - subroutine Summary(this, bounds, num_soilc, filter_soilc, cnveg_carbonstate_inst) + subroutine Summary(this, bounds, num_bgc_soilc, filter_bgc_soilc, cnveg_carbonstate_inst) ! ! !DESCRIPTION: ! Perform column-level carbon summary calculations @@ -939,8 +939,8 @@ subroutine Summary(this, bounds, num_soilc, filter_soilc, cnveg_carbonstate_inst ! !ARGUMENTS: class(soilbiogeochem_carbonstate_type) :: this type(bounds_type) , intent(in) :: bounds - integer , intent(in) :: num_soilc ! number of columns in soil filter - integer , intent(in) :: filter_soilc(:) ! filter for all active columns + integer , intent(in) :: num_bgc_soilc ! number of columns in soil filter + integer , intent(in) :: filter_bgc_soilc(:) ! filter for all active columns type(cnveg_carbonstate_type) , intent(inout) :: cnveg_carbonstate_inst ! @@ -954,8 +954,8 @@ subroutine Summary(this, bounds, num_soilc, filter_soilc, cnveg_carbonstate_inst ! vertically integrate each of the decomposing C pools do l = 1, ndecomp_pools - do fc = 1,num_soilc - c = filter_soilc(fc) + do fc = 1,num_bgc_soilc + c = filter_bgc_soilc(fc) this%decomp_cpools_col(c,l) = 0._r8 if(use_soil_matrixcn)then end if @@ -963,8 +963,8 @@ subroutine Summary(this, bounds, num_soilc, filter_soilc, cnveg_carbonstate_inst end do do l = 1, ndecomp_pools do j = 1, nlevdecomp - do fc = 1,num_soilc - c = filter_soilc(fc) + do fc = 1,num_bgc_soilc + c = filter_bgc_soilc(fc) this%decomp_cpools_col(c,l) = & this%decomp_cpools_col(c,l) + & this%decomp_cpools_vr_col(c,j,l) * dzsoi_decomp(j) @@ -979,23 +979,23 @@ subroutine Summary(this, bounds, num_soilc, filter_soilc, cnveg_carbonstate_inst ! vertically integrate each of the decomposing C pools to 1 meter maxdepth = 1._r8 do l = 1, ndecomp_pools - do fc = 1,num_soilc - c = filter_soilc(fc) + do fc = 1,num_bgc_soilc + c = filter_bgc_soilc(fc) this%decomp_cpools_1m_col(c,l) = 0._r8 end do end do do l = 1, ndecomp_pools do j = 1, nlevdecomp if ( zisoi(j) <= maxdepth ) then - do fc = 1,num_soilc - c = filter_soilc(fc) + do fc = 1,num_bgc_soilc + c = filter_bgc_soilc(fc) this%decomp_cpools_1m_col(c,l) = & this%decomp_cpools_1m_col(c,l) + & this%decomp_cpools_vr_col(c,j,l) * dzsoi_decomp(j) end do elseif ( zisoi(j-1) < maxdepth ) then - do fc = 1,num_soilc - c = filter_soilc(fc) + do fc = 1,num_bgc_soilc + c = filter_bgc_soilc(fc) this%decomp_cpools_1m_col(c,l) = & this%decomp_cpools_1m_col(c,l) + & this%decomp_cpools_vr_col(c,j,l) * (maxdepth - zisoi(j-1)) @@ -1009,16 +1009,16 @@ subroutine Summary(this, bounds, num_soilc, filter_soilc, cnveg_carbonstate_inst ! Add soil carbon pools together to produce vertically-resolved decomposing total soil c pool if ( nlevdecomp_full > 1 ) then do j = 1, nlevdecomp - do fc = 1,num_soilc - c = filter_soilc(fc) + do fc = 1,num_bgc_soilc + c = filter_bgc_soilc(fc) this%decomp_soilc_vr_col(c,j) = 0._r8 end do end do do l = 1, ndecomp_pools if ( decomp_cascade_con%is_soil(l) ) then do j = 1, nlevdecomp - do fc = 1,num_soilc - c = filter_soilc(fc) + do fc = 1,num_bgc_soilc + c = filter_bgc_soilc(fc) this%decomp_soilc_vr_col(c,j) = this%decomp_soilc_vr_col(c,j) + & this%decomp_cpools_vr_col(c,j,l) end do @@ -1028,13 +1028,13 @@ subroutine Summary(this, bounds, num_soilc, filter_soilc, cnveg_carbonstate_inst end if ! truncation carbon - do fc = 1,num_soilc - c = filter_soilc(fc) + do fc = 1,num_bgc_soilc + c = filter_bgc_soilc(fc) this%ctrunc_col(c) = 0._r8 end do do j = 1, nlevdecomp - do fc = 1,num_soilc - c = filter_soilc(fc) + do fc = 1,num_bgc_soilc + c = filter_bgc_soilc(fc) this%ctrunc_col(c) = & this%ctrunc_col(c) + & this%ctrunc_vr_col(c,j) * dzsoi_decomp(j) @@ -1043,14 +1043,14 @@ subroutine Summary(this, bounds, num_soilc, filter_soilc, cnveg_carbonstate_inst ! total litter carbon in the top meter (TOTLITC_1m) if ( nlevdecomp > 1) then - do fc = 1,num_soilc - c = filter_soilc(fc) + do fc = 1,num_bgc_soilc + c = filter_bgc_soilc(fc) this%totlitc_1m_col(c) = 0._r8 end do do l = 1, ndecomp_pools if ( decomp_cascade_con%is_litter(l) ) then - do fc = 1,num_soilc - c = filter_soilc(fc) + do fc = 1,num_bgc_soilc + c = filter_bgc_soilc(fc) this%totlitc_1m_col(c) = this%totlitc_1m_col(c) + & this%decomp_cpools_1m_col(c,l) end do @@ -1060,14 +1060,14 @@ subroutine Summary(this, bounds, num_soilc, filter_soilc, cnveg_carbonstate_inst ! total soil organic matter carbon in the top meter (TOTSOMC_1m) if ( nlevdecomp > 1) then - do fc = 1,num_soilc - c = filter_soilc(fc) + do fc = 1,num_bgc_soilc + c = filter_bgc_soilc(fc) this%totsomc_1m_col(c) = 0._r8 end do do l = 1, ndecomp_pools if ( decomp_cascade_con%is_soil(l) ) then - do fc = 1,num_soilc - c = filter_soilc(fc) + do fc = 1,num_bgc_soilc + c = filter_bgc_soilc(fc) this%totsomc_1m_col(c) = this%totsomc_1m_col(c) + this%decomp_cpools_1m_col(c,l) end do end if @@ -1075,42 +1075,42 @@ subroutine Summary(this, bounds, num_soilc, filter_soilc, cnveg_carbonstate_inst end if ! total microbial carbon (TOTMICC) - do fc = 1,num_soilc - c = filter_soilc(fc) + do fc = 1,num_bgc_soilc + c = filter_bgc_soilc(fc) this%totmicc_col(c) = 0._r8 end do do l = 1, ndecomp_pools if ( decomp_cascade_con%is_microbe(l) ) then - do fc = 1,num_soilc - c = filter_soilc(fc) + do fc = 1,num_bgc_soilc + c = filter_bgc_soilc(fc) this%totmicc_col(c) = this%totmicc_col(c) + this%decomp_cpools_col(c,l) end do endif end do ! total litter carbon (TOTLITC) - do fc = 1,num_soilc - c = filter_soilc(fc) + do fc = 1,num_bgc_soilc + c = filter_bgc_soilc(fc) this%totlitc_col(c) = 0._r8 end do do l = 1, ndecomp_pools if ( decomp_cascade_con%is_litter(l) ) then - do fc = 1,num_soilc - c = filter_soilc(fc) + do fc = 1,num_bgc_soilc + c = filter_bgc_soilc(fc) this%totlitc_col(c) = this%totlitc_col(c) + this%decomp_cpools_col(c,l) end do endif end do ! total soil organic matter carbon (TOTSOMC) - do fc = 1,num_soilc - c = filter_soilc(fc) + do fc = 1,num_bgc_soilc + c = filter_bgc_soilc(fc) this%totsomc_col(c) = 0._r8 end do do l = 1, ndecomp_pools if ( decomp_cascade_con%is_soil(l) ) then - do fc = 1,num_soilc - c = filter_soilc(fc) + do fc = 1,num_bgc_soilc + c = filter_bgc_soilc(fc) this%totsomc_col(c) = this%totsomc_col(c) + this%decomp_cpools_col(c,l) end do end if @@ -1118,8 +1118,8 @@ subroutine Summary(this, bounds, num_soilc, filter_soilc, cnveg_carbonstate_inst - do fc = 1,num_soilc - c = filter_soilc(fc) + do fc = 1,num_bgc_soilc + c = filter_bgc_soilc(fc) ! coarse woody debris carbon this%cwdc_col(c) = 0._r8 diff --git a/src/soilbiogeochem/SoilBiogeochemCompetitionMod.F90 b/src/soilbiogeochem/SoilBiogeochemCompetitionMod.F90 index 9035b32484..57bc82984e 100644 --- a/src/soilbiogeochem/SoilBiogeochemCompetitionMod.F90 +++ b/src/soilbiogeochem/SoilBiogeochemCompetitionMod.F90 @@ -165,7 +165,7 @@ subroutine SoilBiogeochemCompetitionInit ( bounds) end subroutine SoilBiogeochemCompetitionInit !----------------------------------------------------------------------- - subroutine SoilBiogeochemCompetition (bounds, num_soilc, filter_soilc,num_soilp, filter_soilp, & + subroutine SoilBiogeochemCompetition (bounds, num_bgc_soilc, filter_bgc_soilc,num_bgc_vegp, filter_bgc_vegp, & p_decomp_cn_gain, pmnf_decomp_cascade, waterstatebulk_inst, & waterfluxbulk_inst, temperature_inst,soilstate_inst, & cnveg_state_inst,cnveg_carbonstate_inst, & @@ -187,10 +187,10 @@ subroutine SoilBiogeochemCompetition (bounds, num_soilc, filter_soilc,num_soilp, ! ! !ARGUMENTS: type(bounds_type) , intent(in) :: bounds - integer , intent(in) :: num_soilc ! number of soil columns in filter - integer , intent(in) :: filter_soilc(:) ! filter for soil columns - integer , intent(in) :: num_soilp ! number of soil patches in filter - integer , intent(in) :: filter_soilp(:) ! filter for soil patches + integer , intent(in) :: num_bgc_soilc ! number of soil columns in filter + integer , intent(in) :: filter_bgc_soilc(:) ! filter for soil columns + integer , intent(in) :: num_bgc_vegp ! number of veg patches in filter + integer , intent(in) :: filter_bgc_vegp(:) ! filter for veg patches real(r8) , intent(in) :: pmnf_decomp_cascade(bounds%begc:,1:,1:) ! potential mineral N flux from one pool to another (gN/m3/s) real(r8) , intent(in) :: p_decomp_cn_gain(bounds%begc:,1:,1:) ! C:N ratio of the flux gained by the receiver pool type(waterstatebulk_type) , intent(in) :: waterstatebulk_inst @@ -284,7 +284,7 @@ subroutine SoilBiogeochemCompetition (bounds, num_soilc, filter_soilc,num_soilp, ! calcualte nitrogen uptake profile ! nuptake_prof(:,:) = nan ! call SoilBiogelchemNitrogenUptakeProfile(bounds, & - ! nlevdecomp, num_soilc, filter_soilc, & + ! nlevdecomp, num_bgc_soilc, filter_bgc_soilc, & ! sminn_vr, dzsoi_decomp, nfixation_prof, nuptake_prof) ! column loops to resolve plant/heterotroph competition for mineral N @@ -296,21 +296,21 @@ subroutine SoilBiogeochemCompetition (bounds, num_soilc, filter_soilc,num_soilp, if_nitrif: if (.not. use_nitrif_denitrif) then ! init sminn_tot - do fc=1,num_soilc - c = filter_soilc(fc) + do fc=1,num_bgc_soilc + c = filter_bgc_soilc(fc) sminn_tot(c) = 0. end do do j = 1, nlevdecomp - do fc=1,num_soilc - c = filter_soilc(fc) + do fc=1,num_bgc_soilc + c = filter_bgc_soilc(fc) sminn_tot(c) = sminn_tot(c) + sminn_vr(c,j) * dzsoi_decomp(j) end do end do do j = 1, nlevdecomp - do fc=1,num_soilc - c = filter_soilc(fc) + do fc=1,num_bgc_soilc + c = filter_bgc_soilc(fc) if (sminn_tot(c) > 0.) then nuptake_prof(c,j) = sminn_vr(c,j) / sminn_tot(c) else @@ -320,15 +320,15 @@ subroutine SoilBiogeochemCompetition (bounds, num_soilc, filter_soilc,num_soilp, end do do j = 1, nlevdecomp - do fc=1,num_soilc - c = filter_soilc(fc) + do fc=1,num_bgc_soilc + c = filter_bgc_soilc(fc) sum_ndemand_vr(c,j) = plant_ndemand(c) * nuptake_prof(c,j) + potential_immob_vr(c,j) end do end do do j = 1, nlevdecomp - do fc=1,num_soilc - c = filter_soilc(fc) + do fc=1,num_bgc_soilc + c = filter_bgc_soilc(fc) l = col%landunit(c) if (sum_ndemand_vr(c,j)*dt < sminn_vr(c,j)) then @@ -376,7 +376,7 @@ subroutine SoilBiogeochemCompetition (bounds, num_soilc, filter_soilc,num_soilp, if ( local_use_fun ) then call t_startf( 'CNFUN' ) - call CNFUN(bounds,num_soilc,filter_soilc,num_soilp,filter_soilp,waterstatebulk_inst, & + call CNFUN(bounds,num_bgc_soilc,filter_bgc_soilc,num_bgc_vegp,filter_bgc_vegp,waterstatebulk_inst, & waterfluxbulk_inst,temperature_inst,soilstate_inst,cnveg_state_inst,cnveg_carbonstate_inst,& cnveg_carbonflux_inst,cnveg_nitrogenstate_inst,cnveg_nitrogenflux_inst ,& soilbiogeochem_nitrogenflux_inst,soilbiogeochem_carbonflux_inst,canopystate_inst, & @@ -390,8 +390,8 @@ subroutine SoilBiogeochemCompetition (bounds, num_soilc, filter_soilc,num_soilp, ! sum up N fluxes to plant do j = 1, nlevdecomp - do fc=1,num_soilc - c = filter_soilc(fc) + do fc=1,num_bgc_soilc + c = filter_bgc_soilc(fc) sminn_to_plant(c) = sminn_to_plant(c) + sminn_to_plant_vr(c,j) * dzsoi_decomp(j) if ( local_use_fun ) then if (sminn_to_plant_fun_vr(c,j).gt.sminn_to_plant_vr(c,j)) then @@ -402,19 +402,19 @@ subroutine SoilBiogeochemCompetition (bounds, num_soilc, filter_soilc,num_soilp, end do ! give plants a second pass to see if there is any mineral N left over with which to satisfy residual N demand. - do fc=1,num_soilc - c = filter_soilc(fc) + do fc=1,num_bgc_soilc + c = filter_bgc_soilc(fc) residual_sminn(c) = 0._r8 end do ! sum up total N left over after initial plant and immobilization fluxes - do fc=1,num_soilc - c = filter_soilc(fc) + do fc=1,num_bgc_soilc + c = filter_bgc_soilc(fc) residual_plant_ndemand(c) = plant_ndemand(c) - sminn_to_plant(c) end do do j = 1, nlevdecomp - do fc=1,num_soilc - c = filter_soilc(fc) + do fc=1,num_bgc_soilc + c = filter_bgc_soilc(fc) if (residual_plant_ndemand(c) > 0._r8 ) then if (nlimit(c,j) .eq. 0) then residual_sminn_vr(c,j) = max(sminn_vr(c,j) - (actual_immob_vr(c,j) + sminn_to_plant_vr(c,j) ) * dt, 0._r8) @@ -428,8 +428,8 @@ subroutine SoilBiogeochemCompetition (bounds, num_soilc, filter_soilc,num_soilp, ! distribute residual N to plants do j = 1, nlevdecomp - do fc=1,num_soilc - c = filter_soilc(fc) + do fc=1,num_bgc_soilc + c = filter_bgc_soilc(fc) if ( residual_plant_ndemand(c) > 0._r8 .and. residual_sminn(c) > 0._r8 .and. nlimit(c,j) .eq. 0) then sminn_to_plant_vr(c,j) = sminn_to_plant_vr(c,j) + residual_sminn_vr(c,j) * & min(( residual_plant_ndemand(c) * dt ) / residual_sminn(c), 1._r8) / dt @@ -438,13 +438,13 @@ subroutine SoilBiogeochemCompetition (bounds, num_soilc, filter_soilc,num_soilp, end do ! re-sum up N fluxes to plant - do fc=1,num_soilc - c = filter_soilc(fc) + do fc=1,num_bgc_soilc + c = filter_bgc_soilc(fc) sminn_to_plant(c) = 0._r8 end do do j = 1, nlevdecomp - do fc=1,num_soilc - c = filter_soilc(fc) + do fc=1,num_bgc_soilc + c = filter_bgc_soilc(fc) sminn_to_plant(c) = sminn_to_plant(c) + sminn_to_plant_vr(c,j) * dzsoi_decomp(j) if ( .not. local_use_fun ) then sum_ndemand_vr(c,j) = potential_immob_vr(c,j) + sminn_to_plant_vr(c,j) @@ -459,8 +459,8 @@ subroutine SoilBiogeochemCompetition (bounds, num_soilc, filter_soilc,num_soilp, ! be lost to denitrification, in addition to the constant ! proportion lost in the decomposition pathways do j = 1, nlevdecomp - do fc=1,num_soilc - c = filter_soilc(fc) + do fc=1,num_bgc_soilc + c = filter_bgc_soilc(fc) if ( .not. local_use_fun ) then if ((sminn_to_plant_vr(c,j) + actual_immob_vr(c,j))*dt < sminn_vr(c,j)) then sminn_to_denit_excess_vr(c,j) = max(bdnr*((sminn_vr(c,j)/dt) - sum_ndemand_vr(c,j)),0._r8) @@ -479,15 +479,15 @@ subroutine SoilBiogeochemCompetition (bounds, num_soilc, filter_soilc,num_soilp, ! sum up N fluxes to immobilization do j = 1, nlevdecomp - do fc=1,num_soilc - c = filter_soilc(fc) + do fc=1,num_bgc_soilc + c = filter_bgc_soilc(fc) actual_immob(c) = actual_immob(c) + actual_immob_vr(c,j) * dzsoi_decomp(j) potential_immob(c) = potential_immob(c) + potential_immob_vr(c,j) * dzsoi_decomp(j) end do end do - do fc=1,num_soilc - c = filter_soilc(fc) + do fc=1,num_bgc_soilc + c = filter_bgc_soilc(fc) ! calculate the fraction of potential growth that can be ! acheived with the N available to plants if (plant_ndemand(c) > 0.0_r8) then @@ -520,23 +520,23 @@ subroutine SoilBiogeochemCompetition (bounds, num_soilc, filter_soilc,num_soilp, compet_nit = params_inst%compet_nit ! init total mineral N pools - do fc=1,num_soilc - c = filter_soilc(fc) + do fc=1,num_bgc_soilc + c = filter_bgc_soilc(fc) sminn_tot(c) = 0. end do ! sum up total mineral N pools do j = 1, nlevdecomp - do fc=1,num_soilc - c = filter_soilc(fc) + do fc=1,num_bgc_soilc + c = filter_bgc_soilc(fc) sminn_tot(c) = sminn_tot(c) + (smin_no3_vr(c,j) + smin_nh4_vr(c,j)) * dzsoi_decomp(j) end do end do ! define N uptake profile for initial vertical distribution of plant N uptake, assuming plant seeks N from where it is most abundant do j = 1, nlevdecomp - do fc=1,num_soilc - c = filter_soilc(fc) + do fc=1,num_bgc_soilc + c = filter_bgc_soilc(fc) if (sminn_tot(c) > 0.) then nuptake_prof(c,j) = sminn_vr(c,j) / sminn_tot(c) else @@ -547,8 +547,8 @@ subroutine SoilBiogeochemCompetition (bounds, num_soilc, filter_soilc,num_soilp, ! main column/vertical loop do j = 1, nlevdecomp - do fc=1,num_soilc - c = filter_soilc(fc) + do fc=1,num_bgc_soilc + c = filter_bgc_soilc(fc) l = col%landunit(c) ! first compete for nh4 @@ -754,7 +754,7 @@ subroutine SoilBiogeochemCompetition (bounds, num_soilc, filter_soilc,num_soilp, if ( local_use_fun ) then call t_startf( 'CNFUN' ) - call CNFUN(bounds,num_soilc,filter_soilc,num_soilp,filter_soilp,waterstatebulk_inst,& + call CNFUN(bounds,num_bgc_soilc,filter_bgc_soilc,num_bgc_vegp,filter_bgc_vegp,waterstatebulk_inst,& waterfluxbulk_inst,temperature_inst,soilstate_inst,cnveg_state_inst,cnveg_carbonstate_inst,& cnveg_carbonflux_inst,cnveg_nitrogenstate_inst,cnveg_nitrogenflux_inst ,& soilbiogeochem_nitrogenflux_inst,soilbiogeochem_carbonflux_inst,canopystate_inst, & @@ -776,20 +776,20 @@ subroutine SoilBiogeochemCompetition (bounds, num_soilc, filter_soilc,num_soilp, if(.not.local_use_fun)then - do fc=1,num_soilc - c = filter_soilc(fc) + do fc=1,num_bgc_soilc + c = filter_bgc_soilc(fc) ! sum up N fluxes to plant after initial competition sminn_to_plant(c) = 0._r8 end do do j = 1, nlevdecomp - do fc=1,num_soilc - c = filter_soilc(fc) + do fc=1,num_bgc_soilc + c = filter_bgc_soilc(fc) sminn_to_plant(c) = sminn_to_plant(c) + sminn_to_plant_vr(c,j) * dzsoi_decomp(j) end do end do else - do fc=1,num_soilc - c = filter_soilc(fc) + do fc=1,num_bgc_soilc + c = filter_bgc_soilc(fc) ! sum up N fluxes to plant after initial competition sminn_to_plant(c) = 0._r8 !this isn't use in fun. do j = 1, nlevdecomp @@ -813,8 +813,8 @@ subroutine SoilBiogeochemCompetition (bounds, num_soilc, filter_soilc,num_soilp, if (decomp_method == mimics_decomp) then do j = 1, nlevdecomp - do fc=1,num_soilc - c = filter_soilc(fc) + do fc=1,num_bgc_soilc + c = filter_bgc_soilc(fc) do k = 1, ndecomp_cascade_transitions if (cascade_receiver_pool(k) == i_cop_mic .or. & @@ -846,14 +846,14 @@ subroutine SoilBiogeochemCompetition (bounds, num_soilc, filter_soilc,num_soilp, if(.not.local_use_fun)then ! give plants a second pass to see if there is any mineral N left over with which to satisfy residual N demand. ! first take frm nh4 pool; then take from no3 pool - do fc=1,num_soilc - c = filter_soilc(fc) + do fc=1,num_bgc_soilc + c = filter_bgc_soilc(fc) residual_plant_ndemand(c) = plant_ndemand(c) - sminn_to_plant(c) residual_smin_nh4(c) = 0._r8 end do do j = 1, nlevdecomp - do fc=1,num_soilc - c = filter_soilc(fc) + do fc=1,num_bgc_soilc + c = filter_bgc_soilc(fc) if (residual_plant_ndemand(c) > 0._r8 ) then if (nlimit_nh4(c,j) .eq. 0) then residual_smin_nh4_vr(c,j) = max(smin_nh4_vr(c,j) - (actual_immob_nh4_vr(c,j) + & @@ -873,13 +873,13 @@ subroutine SoilBiogeochemCompetition (bounds, num_soilc, filter_soilc,num_soilp, end do ! re-sum up N fluxes to plant after second pass for nh4 - do fc=1,num_soilc - c = filter_soilc(fc) + do fc=1,num_bgc_soilc + c = filter_bgc_soilc(fc) sminn_to_plant(c) = 0._r8 end do do j = 1, nlevdecomp - do fc=1,num_soilc - c = filter_soilc(fc) + do fc=1,num_bgc_soilc + c = filter_bgc_soilc(fc) sminn_to_plant_vr(c,j) = smin_nh4_to_plant_vr(c,j) + smin_no3_to_plant_vr(c,j) sminn_to_plant(c) = sminn_to_plant(c) + (sminn_to_plant_vr(c,j)) * dzsoi_decomp(j) end do @@ -887,15 +887,15 @@ subroutine SoilBiogeochemCompetition (bounds, num_soilc, filter_soilc,num_soilp, ! ! and now do second pass for no3 - do fc=1,num_soilc - c = filter_soilc(fc) + do fc=1,num_bgc_soilc + c = filter_bgc_soilc(fc) residual_plant_ndemand(c) = plant_ndemand(c) - sminn_to_plant(c) residual_smin_no3(c) = 0._r8 end do do j = 1, nlevdecomp - do fc=1,num_soilc - c = filter_soilc(fc) + do fc=1,num_bgc_soilc + c = filter_bgc_soilc(fc) if (residual_plant_ndemand(c) > 0._r8 ) then if (nlimit_no3(c,j) .eq. 0) then residual_smin_no3_vr(c,j) = max(smin_no3_vr(c,j) - (actual_immob_no3_vr(c,j) + & @@ -914,13 +914,13 @@ subroutine SoilBiogeochemCompetition (bounds, num_soilc, filter_soilc,num_soilp, end do ! re-sum up N fluxes to plant after second passes of both no3 and nh4 - do fc=1,num_soilc - c = filter_soilc(fc) + do fc=1,num_bgc_soilc + c = filter_bgc_soilc(fc) sminn_to_plant(c) = 0._r8 end do do j = 1, nlevdecomp - do fc=1,num_soilc - c = filter_soilc(fc) + do fc=1,num_bgc_soilc + c = filter_bgc_soilc(fc) sminn_to_plant_vr(c,j) = smin_nh4_to_plant_vr(c,j) + smin_no3_to_plant_vr(c,j) sminn_to_plant(c) = sminn_to_plant(c) + (sminn_to_plant_vr(c,j)) * dzsoi_decomp(j) end do @@ -928,13 +928,13 @@ subroutine SoilBiogeochemCompetition (bounds, num_soilc, filter_soilc,num_soilp, else !use_fun !calculate maximum N available to plants. - do fc=1,num_soilc - c = filter_soilc(fc) + do fc=1,num_bgc_soilc + c = filter_bgc_soilc(fc) sminn_to_plant(c) = 0._r8 end do do j = 1, nlevdecomp - do fc=1,num_soilc - c = filter_soilc(fc) + do fc=1,num_bgc_soilc + c = filter_bgc_soilc(fc) sminn_to_plant_vr(c,j) = smin_nh4_to_plant_vr(c,j) + smin_no3_to_plant_vr(c,j) sminn_to_plant(c) = sminn_to_plant(c) + (sminn_to_plant_vr(c,j)) * dzsoi_decomp(j) end do @@ -943,8 +943,8 @@ subroutine SoilBiogeochemCompetition (bounds, num_soilc, filter_soilc,num_soilp, ! add up fun fluxes from SMINN to plant. do j = 1, nlevdecomp - do fc=1,num_soilc - c = filter_soilc(fc) + do fc=1,num_bgc_soilc + c = filter_bgc_soilc(fc) sminn_to_plant_new(c) = sminn_to_plant_new(c) + & (sminn_to_plant_fun_no3_vr(c,j) + sminn_to_plant_fun_nh4_vr(c,j)) * dzsoi_decomp(j) @@ -954,14 +954,14 @@ subroutine SoilBiogeochemCompetition (bounds, num_soilc, filter_soilc,num_soilp, end if !use_f ! sum up N fluxes to immobilization - do fc=1,num_soilc - c = filter_soilc(fc) + do fc=1,num_bgc_soilc + c = filter_bgc_soilc(fc) actual_immob(c) = 0._r8 potential_immob(c) = 0._r8 end do do j = 1, nlevdecomp - do fc=1,num_soilc - c = filter_soilc(fc) + do fc=1,num_bgc_soilc + c = filter_bgc_soilc(fc) actual_immob(c) = actual_immob(c) + actual_immob_vr(c,j) * dzsoi_decomp(j) potential_immob(c) = potential_immob(c) + potential_immob_vr(c,j) * dzsoi_decomp(j) end do @@ -970,8 +970,8 @@ subroutine SoilBiogeochemCompetition (bounds, num_soilc, filter_soilc,num_soilp, - do fc=1,num_soilc - c = filter_soilc(fc) + do fc=1,num_bgc_soilc + c = filter_bgc_soilc(fc) ! calculate the fraction of potential growth that can be ! acheived with the N available to plants ! calculate the fraction of immobilization realized (for diagnostic purposes) diff --git a/src/soilbiogeochem/SoilBiogeochemDecompCascadeBGCMod.F90 b/src/soilbiogeochem/SoilBiogeochemDecompCascadeBGCMod.F90 index b65fc5f17f..c32e177b1b 100644 --- a/src/soilbiogeochem/SoilBiogeochemDecompCascadeBGCMod.F90 +++ b/src/soilbiogeochem/SoilBiogeochemDecompCascadeBGCMod.F90 @@ -510,7 +510,7 @@ subroutine init_decompcascade_bgc(bounds, soilbiogeochem_state_inst, soilstate_i end subroutine init_decompcascade_bgc !----------------------------------------------------------------------- - subroutine decomp_rate_constants_bgc(bounds, num_soilc, filter_soilc, & + subroutine decomp_rate_constants_bgc(bounds, num_bgc_soilc, filter_bgc_soilc, & soilstate_inst, temperature_inst, ch4_inst, soilbiogeochem_carbonflux_inst) ! ! !DESCRIPTION: @@ -524,8 +524,8 @@ subroutine decomp_rate_constants_bgc(bounds, num_soilc, filter_soilc, & ! ! !ARGUMENTS: type(bounds_type) , intent(in) :: bounds - integer , intent(in) :: num_soilc ! number of soil columns in filter - integer , intent(in) :: filter_soilc(:) ! filter for soil columns + integer , intent(in) :: num_bgc_soilc ! number of soil columns in filter + integer , intent(in) :: filter_bgc_soilc(:) ! filter for soil columns type(soilstate_type) , intent(in) :: soilstate_inst type(temperature_type) , intent(in) :: temperature_inst type(ch4_type) , intent(in) :: ch4_inst @@ -619,8 +619,8 @@ subroutine decomp_rate_constants_bgc(bounds, num_soilc, filter_soilc, & catanf_30 = catanf(30._r8) if ( spinup_state >= 1 ) then - do fc = 1,num_soilc - c = filter_soilc(fc) + do fc = 1,num_bgc_soilc + c = filter_bgc_soilc(fc) ! if ( abs(spinup_factor(i_met_lit) - 1._r8) .gt. eps) then spinup_geogterm_l1(c) = spinup_factor(i_met_lit) * get_spinup_latitude_term(grc%latdeg(col%gridcell(c))) @@ -662,8 +662,8 @@ subroutine decomp_rate_constants_bgc(bounds, num_soilc, filter_soilc, & ! end do else - do fc = 1,num_soilc - c = filter_soilc(fc) + do fc = 1,num_bgc_soilc + c = filter_bgc_soilc(fc) spinup_geogterm_l1(c) = 1._r8 spinup_geogterm_l23(c) = 1._r8 spinup_geogterm_cwd(c) = 1._r8 @@ -686,14 +686,14 @@ subroutine decomp_rate_constants_bgc(bounds, num_soilc, filter_soilc, & nlev_soildecomp_standard=5 allocate(fr(bounds%begc:bounds%endc,nlev_soildecomp_standard)) do j=1,nlev_soildecomp_standard - do fc = 1,num_soilc - c = filter_soilc(fc) + do fc = 1,num_bgc_soilc + c = filter_bgc_soilc(fc) frw(c) = frw(c) + col%dz(c,j) end do end do do j = 1,nlev_soildecomp_standard - do fc = 1,num_soilc - c = filter_soilc(fc) + do fc = 1,num_bgc_soilc + c = filter_bgc_soilc(fc) if (frw(c) /= 0._r8) then fr(c,j) = col%dz(c,j) / frw(c) else @@ -708,8 +708,8 @@ subroutine decomp_rate_constants_bgc(bounds, num_soilc, filter_soilc, & ! limiting conditions at 25 C. do j = 1,nlev_soildecomp_standard - do fc = 1,num_soilc - c = filter_soilc(fc) + do fc = 1,num_bgc_soilc + c = filter_bgc_soilc(fc) if (j==1) t_scalar(c,:) = 0._r8 if (t_soisno(c,j) >= SHR_CONST_TKFRZ) then t_scalar(c,1)=t_scalar(c,1) + & @@ -724,8 +724,8 @@ subroutine decomp_rate_constants_bgc(bounds, num_soilc, filter_soilc, & else ! original century uses an arctangent function to calculate the temperature dependence of decomposition do j = 1,nlev_soildecomp_standard - do fc = 1,num_soilc - c = filter_soilc(fc) + do fc = 1,num_bgc_soilc + c = filter_bgc_soilc(fc) if (j==1) t_scalar(c,:) = 0._r8 t_scalar(c,1)=t_scalar(c,1) +max(catanf(t_soisno(c,j)-SHR_CONST_TKFRZ)/catanf_30*fr(c,j),0.01_r8) @@ -743,8 +743,8 @@ subroutine decomp_rate_constants_bgc(bounds, num_soilc, filter_soilc, & ! and soil moisture. Soil Biol. Biochem., 15(4):447-453. do j = 1,nlev_soildecomp_standard - do fc = 1,num_soilc - c = filter_soilc(fc) + do fc = 1,num_bgc_soilc + c = filter_bgc_soilc(fc) if (j==1) w_scalar(c,:) = 0._r8 psi = min(soilpsi(c,j),maxpsi) ! decomp only if soilpsi is higher than minpsi @@ -760,8 +760,8 @@ subroutine decomp_rate_constants_bgc(bounds, num_soilc, filter_soilc, & ! Check for anoxia w/o LCH4 now done in controlMod. do j = 1,nlev_soildecomp_standard - do fc = 1,num_soilc - c = filter_soilc(fc) + do fc = 1,num_bgc_soilc + c = filter_bgc_soilc(fc) if (j==1) o_scalar(c,:) = 0._r8 @@ -790,8 +790,8 @@ subroutine decomp_rate_constants_bgc(bounds, num_soilc, filter_soilc, & ! the base rates at 25 C, which are calibrated from microcosm studies. do j = 1, nlevdecomp - do fc = 1,num_soilc - c = filter_soilc(fc) + do fc = 1,num_bgc_soilc + c = filter_bgc_soilc(fc) if (t_soisno(c,j) >= SHR_CONST_TKFRZ) then t_scalar(c,j)= (Q10**((t_soisno(c,j)-(SHR_CONST_TKFRZ+25._r8))/10._r8)) else @@ -803,8 +803,8 @@ subroutine decomp_rate_constants_bgc(bounds, num_soilc, filter_soilc, & else do j = 1, nlevdecomp - do fc = 1,num_soilc - c = filter_soilc(fc) + do fc = 1,num_bgc_soilc + c = filter_bgc_soilc(fc) t_scalar(c,j)= max(catanf(t_soisno(c,j)-SHR_CONST_TKFRZ)/catanf_30, 0.01_r8) end do end do @@ -820,8 +820,8 @@ subroutine decomp_rate_constants_bgc(bounds, num_soilc, filter_soilc, & ! and soil moisture. Soil Biol. Biochem., 15(4):447-453. do j = 1,nlevdecomp - do fc = 1,num_soilc - c = filter_soilc(fc) + do fc = 1,num_bgc_soilc + c = filter_bgc_soilc(fc) psi = min(soilpsi(c,j),maxpsi) ! decomp only if soilpsi is higher than minpsi if (psi > minpsi) then @@ -838,8 +838,8 @@ subroutine decomp_rate_constants_bgc(bounds, num_soilc, filter_soilc, & if (anoxia) then do j = 1,nlevdecomp - do fc = 1,num_soilc - c = filter_soilc(fc) + do fc = 1,num_bgc_soilc + c = filter_bgc_soilc(fc) o_scalar(c,j) = max(o2stress_unsat(c,j), mino2lim) end do @@ -857,8 +857,8 @@ subroutine decomp_rate_constants_bgc(bounds, num_soilc, filter_soilc, & ! scale all decomposition rates by a constant to compensate for offset between original CENTURY temp func and Q10 normalization_factor = (catanf(normalization_tref)/catanf_30) / (q10**((normalization_tref-25._r8)/10._r8)) do j = 1, nlevdecomp - do fc = 1,num_soilc - c = filter_soilc(fc) + do fc = 1,num_bgc_soilc + c = filter_bgc_soilc(fc) t_scalar(c,j) = t_scalar(c,j) * normalization_factor end do end do @@ -867,16 +867,16 @@ subroutine decomp_rate_constants_bgc(bounds, num_soilc, filter_soilc, & ! add a term to reduce decomposition rate at depth ! for now used a fixed e-folding depth do j = 1, nlevdecomp - do fc = 1, num_soilc - c = filter_soilc(fc) + do fc = 1, num_bgc_soilc + c = filter_bgc_soilc(fc) depth_scalar(c,j) = exp(-zsoi(j) / decomp_depth_efolding) end do end do ! calculate rate constants for all litter and som pools do j = 1,nlevdecomp - do fc = 1,num_soilc - c = filter_soilc(fc) + do fc = 1,num_bgc_soilc + c = filter_bgc_soilc(fc) decomp_k(c,j,i_met_lit) = k_l1 * t_scalar(c,j) * w_scalar(c,j) * & depth_scalar(c,j) * o_scalar(c,j) * spinup_geogterm_l1(c) decomp_k(c,j,i_cel_lit) = k_l2_l3 * t_scalar(c,j) * w_scalar(c,j) * & diff --git a/src/soilbiogeochem/SoilBiogeochemDecompCascadeMIMICSMod.F90 b/src/soilbiogeochem/SoilBiogeochemDecompCascadeMIMICSMod.F90 index f820db01b6..e2a2a4ab99 100644 --- a/src/soilbiogeochem/SoilBiogeochemDecompCascadeMIMICSMod.F90 +++ b/src/soilbiogeochem/SoilBiogeochemDecompCascadeMIMICSMod.F90 @@ -752,7 +752,7 @@ subroutine init_decompcascade_mimics(bounds, soilbiogeochem_state_inst, soilstat end subroutine init_decompcascade_mimics !----------------------------------------------------------------------- - subroutine decomp_rates_mimics(bounds, num_soilc, filter_soilc, & + subroutine decomp_rates_mimics(bounds, num_bgc_soilc, filter_bgc_soilc, & num_soilp, filter_soilp, clm_fates, & soilstate_inst, temperature_inst, cnveg_carbonflux_inst, & ch4_inst, soilbiogeochem_carbonflux_inst, soilbiogeochem_carbonstate_inst) @@ -773,8 +773,8 @@ subroutine decomp_rates_mimics(bounds, num_soilc, filter_soilc, & type(bounds_type) , intent(in) :: bounds integer , intent(in) :: num_soilp ! number of soil patches in filter integer , intent(in) :: filter_soilp(:) ! filter for soil patches - integer , intent(in) :: num_soilc ! number of soil columns in filter - integer , intent(in) :: filter_soilc(:) ! filter for soil columns + integer , intent(in) :: num_bgc_soilc ! number of soil columns in filter + integer , intent(in) :: filter_bgc_soilc(:) ! filter for soil columns type(soilstate_type) , intent(in) :: soilstate_inst type(temperature_type) , intent(in) :: temperature_inst type(cnveg_carbonflux_type) , intent(in) :: cnveg_carbonflux_inst @@ -895,8 +895,8 @@ subroutine decomp_rates_mimics(bounds, num_soilc, filter_soilc, & ! calc ref rate if ( spinup_state >= 1 ) then - do fc = 1,num_soilc - c = filter_soilc(fc) + do fc = 1,num_bgc_soilc + c = filter_bgc_soilc(fc) ! if ( abs(spinup_factor(i_met_lit) - 1._r8) .gt. eps) then spinup_geogterm_l1(c) = spinup_factor(i_met_lit) * get_spinup_latitude_term(grc%latdeg(col%gridcell(c))) @@ -950,8 +950,8 @@ subroutine decomp_rates_mimics(bounds, num_soilc, filter_soilc, & ! end do else - do fc = 1,num_soilc - c = filter_soilc(fc) + do fc = 1,num_bgc_soilc + c = filter_bgc_soilc(fc) spinup_geogterm_l1(c) = 1._r8 spinup_geogterm_l2(c) = 1._r8 spinup_geogterm_cwd(c) = 1._r8 @@ -975,14 +975,14 @@ subroutine decomp_rates_mimics(bounds, num_soilc, filter_soilc, & frw(bounds%begc:bounds%endc) = 0._r8 allocate(fr(bounds%begc:bounds%endc,nlev_soildecomp_standard)) do j=1,nlev_soildecomp_standard - do fc = 1,num_soilc - c = filter_soilc(fc) + do fc = 1,num_bgc_soilc + c = filter_bgc_soilc(fc) frw(c) = frw(c) + col%dz(c,j) end do end do do j = 1,nlev_soildecomp_standard - do fc = 1,num_soilc - c = filter_soilc(fc) + do fc = 1,num_bgc_soilc + c = filter_bgc_soilc(fc) if (frw(c) /= 0._r8) then fr(c,j) = col%dz(c,j) / frw(c) else @@ -1000,8 +1000,8 @@ subroutine decomp_rates_mimics(bounds, num_soilc, filter_soilc, & ! and soil moisture. Soil Biol. Biochem., 15(4):447-453. do j = 1,nlev_soildecomp_standard - do fc = 1,num_soilc - c = filter_soilc(fc) + do fc = 1,num_bgc_soilc + c = filter_bgc_soilc(fc) if (j==1) w_scalar(c,:) = 0._r8 psi = min(soilpsi(c,j),maxpsi) ! decomp only if soilpsi is higher than minpsi @@ -1017,8 +1017,8 @@ subroutine decomp_rates_mimics(bounds, num_soilc, filter_soilc, & if (anoxia) then do j = 1,nlev_soildecomp_standard - do fc = 1,num_soilc - c = filter_soilc(fc) + do fc = 1,num_bgc_soilc + c = filter_bgc_soilc(fc) if (j==1) o_scalar(c,:) = 0._r8 @@ -1042,8 +1042,8 @@ subroutine decomp_rates_mimics(bounds, num_soilc, filter_soilc, & ! and soil moisture. Soil Biol. Biochem., 15(4):447-453. do j = 1,nlevdecomp - do fc = 1,num_soilc - c = filter_soilc(fc) + do fc = 1,num_bgc_soilc + c = filter_bgc_soilc(fc) psi = min(soilpsi(c,j),maxpsi) ! decomp only if soilpsi is higher than minpsi if (psi > minpsi) then @@ -1059,8 +1059,8 @@ subroutine decomp_rates_mimics(bounds, num_soilc, filter_soilc, & if (anoxia) then do j = 1,nlevdecomp - do fc = 1,num_soilc - c = filter_soilc(fc) + do fc = 1,num_bgc_soilc + c = filter_bgc_soilc(fc) o_scalar(c,j) = max(o2stress_unsat(c,j), mino2lim) end do @@ -1074,8 +1074,8 @@ subroutine decomp_rates_mimics(bounds, num_soilc, filter_soilc, & ! Term that reduces decomposition rate at depth ! Placeholder. For now depth_scalar = 1. do j = 1, nlevdecomp - do fc = 1, num_soilc - c = filter_soilc(fc) + do fc = 1, num_bgc_soilc + c = filter_bgc_soilc(fc) ! Using fixed e-folding depth as in ! SoilBiogeochemDecompCascadeBGCMod.F90 ! depth_scalar(c,j) = exp(-zsoi(j) / decomp_depth_efolding) @@ -1135,7 +1135,7 @@ subroutine decomp_rates_mimics(bounds, num_soilc, filter_soilc, & end do ! p loop ! Calculate the column-level average - call p2c(bounds, num_soilc, filter_soilc, & + call p2c(bounds, num_bgc_soilc, filter_bgc_soilc, & annsum_npp(bounds%begp:bounds%endp), & annsum_npp_col_local(bounds%begc:bounds%endc)) else @@ -1146,8 +1146,8 @@ subroutine decomp_rates_mimics(bounds, num_soilc, filter_soilc, & end if fates_if ! calculate rates for all litter and som pools - do fc = 1,num_soilc - c = filter_soilc(fc) + do fc = 1,num_bgc_soilc + c = filter_bgc_soilc(fc) if (use_fates) then annsum_npp_col_scalar = max(0._r8, annsum_npp_col_local(c)) diff --git a/src/soilbiogeochem/SoilBiogeochemDecompMod.F90 b/src/soilbiogeochem/SoilBiogeochemDecompMod.F90 index 77d4a40ed9..9bd8b13008 100644 --- a/src/soilbiogeochem/SoilBiogeochemDecompMod.F90 +++ b/src/soilbiogeochem/SoilBiogeochemDecompMod.F90 @@ -67,7 +67,7 @@ subroutine readParams ( ncid ) end subroutine readParams !----------------------------------------------------------------------- - subroutine SoilBiogeochemDecomp (bounds, num_soilc, filter_soilc, & + subroutine SoilBiogeochemDecomp (bounds, num_bgc_soilc, filter_bgc_soilc, & soilbiogeochem_state_inst, soilbiogeochem_carbonstate_inst, soilbiogeochem_carbonflux_inst, & soilbiogeochem_nitrogenstate_inst, soilbiogeochem_nitrogenflux_inst, & cn_decomp_pools, p_decomp_cpool_loss, pmnf_decomp_cascade, & @@ -78,8 +78,8 @@ subroutine SoilBiogeochemDecomp (bounds, num_soilc, filter_soilc, ! ! !ARGUMENT: type(bounds_type) , intent(in) :: bounds - integer , intent(in) :: num_soilc ! number of soil columns in filter - integer , intent(in) :: filter_soilc(:) ! filter for soil columns + integer , intent(in) :: num_bgc_soilc ! number of soil columns in filter + integer , intent(in) :: filter_bgc_soilc(:) ! filter for soil columns type(soilbiogeochem_state_type) , intent(inout) :: soilbiogeochem_state_inst type(soilbiogeochem_carbonstate_type) , intent(in) :: soilbiogeochem_carbonstate_inst type(soilbiogeochem_carbonflux_type) , intent(inout) :: soilbiogeochem_carbonflux_inst @@ -141,8 +141,8 @@ subroutine SoilBiogeochemDecomp (bounds, num_soilc, filter_soilc, do l = 1, ndecomp_pools if ( floating_cn_ratio_decomp_pools(l) ) then do j = 1,nlevdecomp - do fc = 1,num_soilc - c = filter_soilc(fc) + do fc = 1,num_bgc_soilc + c = filter_bgc_soilc(fc) if ( decomp_npools_vr(c,j,l) > 0._r8 ) then cn_decomp_pools(c,j,l) = decomp_cpools_vr(c,j,l) / decomp_npools_vr(c,j,l) end if @@ -150,8 +150,8 @@ subroutine SoilBiogeochemDecomp (bounds, num_soilc, filter_soilc, end do else do j = 1,nlevdecomp - do fc = 1,num_soilc - c = filter_soilc(fc) + do fc = 1,num_bgc_soilc + c = filter_bgc_soilc(fc) cn_decomp_pools(c,j,l) = initial_cn_ratio(l) end do end do @@ -169,8 +169,8 @@ subroutine SoilBiogeochemDecomp (bounds, num_soilc, filter_soilc, do k = 1, ndecomp_cascade_transitions do j = 1,nlevdecomp - do fc = 1,num_soilc - c = filter_soilc(fc) + do fc = 1,num_bgc_soilc + c = filter_bgc_soilc(fc) if (decomp_cpools_vr(c,j,cascade_donor_pool(k)) > 0._r8) then if ( pmnf_decomp_cascade(c,j,k) > 0._r8 ) then @@ -226,15 +226,15 @@ subroutine SoilBiogeochemDecomp (bounds, num_soilc, filter_soilc, if (use_lch4) then ! Calculate total fraction of potential HR, for methane code do j = 1,nlevdecomp - do fc = 1,num_soilc - c = filter_soilc(fc) + do fc = 1,num_bgc_soilc + c = filter_bgc_soilc(fc) hrsum(c,j) = 0._r8 end do end do do k = 1, ndecomp_cascade_transitions do j = 1,nlevdecomp - do fc = 1,num_soilc - c = filter_soilc(fc) + do fc = 1,num_bgc_soilc + c = filter_bgc_soilc(fc) hrsum(c,j) = hrsum(c,j) + rf_decomp_cascade(c,j,k) * p_decomp_cpool_loss(c,j,k) end do end do @@ -243,8 +243,8 @@ subroutine SoilBiogeochemDecomp (bounds, num_soilc, filter_soilc, ! Nitrogen limitation / (low)-moisture limitation do j = 1,nlevdecomp - do fc = 1,num_soilc - c = filter_soilc(fc) + do fc = 1,num_bgc_soilc + c = filter_bgc_soilc(fc) if (phr_vr(c,j) > 0._r8) then fphr(c,j) = hrsum(c,j) / phr_vr(c,j) * w_scalar(c,j) fphr(c,j) = max(fphr(c,j), 0.01_r8) ! Prevent overflow errors for 0 respiration @@ -258,8 +258,8 @@ subroutine SoilBiogeochemDecomp (bounds, num_soilc, filter_soilc, ! vertically integrate net and gross mineralization fluxes for diagnostic output - do fc = 1,num_soilc - c = filter_soilc(fc) + do fc = 1,num_bgc_soilc + c = filter_bgc_soilc(fc) do j = 1,nlevdecomp net_nmin(c) = net_nmin(c) + net_nmin_vr(c,j) * dzsoi_decomp(j) gross_nmin(c) = gross_nmin(c) + gross_nmin_vr(c,j) * dzsoi_decomp(j) diff --git a/src/soilbiogeochem/SoilBiogeochemLittVertTranspMod.F90 b/src/soilbiogeochem/SoilBiogeochemLittVertTranspMod.F90 index 136438cf37..e58e2f22d6 100644 --- a/src/soilbiogeochem/SoilBiogeochemLittVertTranspMod.F90 +++ b/src/soilbiogeochem/SoilBiogeochemLittVertTranspMod.F90 @@ -81,7 +81,7 @@ subroutine readParams ( ncid ) end subroutine readParams !----------------------------------------------------------------------- - subroutine SoilBiogeochemLittVertTransp(bounds, num_soilc, filter_soilc, & + subroutine SoilBiogeochemLittVertTransp(bounds, num_bgc_soilc, filter_bgc_soilc, & active_layer_inst, soilbiogeochem_state_inst, & soilbiogeochem_carbonstate_inst, soilbiogeochem_carbonflux_inst, & c13_soilbiogeochem_carbonstate_inst, c13_soilbiogeochem_carbonflux_inst, & @@ -105,8 +105,8 @@ subroutine SoilBiogeochemLittVertTransp(bounds, num_soilc, filter_soilc, & ! ! !ARGUMENTS: type(bounds_type) , intent(in) :: bounds - integer , intent(in) :: num_soilc ! number of soil columns in filter - integer , intent(in) :: filter_soilc(:) ! filter for soil columns + integer , intent(in) :: num_bgc_soilc ! number of soil columns in filter + integer , intent(in) :: filter_bgc_soilc(:) ! filter for soil columns type(active_layer_type) , intent(in) :: active_layer_inst type(soilbiogeochem_state_type) , intent(inout) :: soilbiogeochem_state_inst type(soilbiogeochem_carbonstate_type) , intent(inout) :: soilbiogeochem_carbonstate_inst @@ -187,8 +187,8 @@ subroutine SoilBiogeochemLittVertTransp(bounds, num_soilc, filter_soilc, & !------ first get diffusivity / advection terms -------! ! use different mixing rates for bioturbation and cryoturbation, with fixed bioturbation and cryoturbation set to a maximum depth - do fc = 1, num_soilc - c = filter_soilc (fc) + do fc = 1, num_bgc_soilc + c = filter_bgc_soilc (fc) if (( max(altmax(c), altmax_lastyear(c)) <= max_altdepth_cryoturbation ) .and. & ( max(altmax(c), altmax_lastyear(c)) > 0._r8) ) then ! use mixing profile modified slightly from Koven et al. (2009): constant through active layer, linear decrease from base of active layer to zero at a fixed depth @@ -275,8 +275,8 @@ subroutine SoilBiogeochemLittVertTransp(bounds, num_soilc, filter_soilc, & if ( .not. is_cwd(s) ) then if(.not. use_soil_matrixcn .or. s .eq. 1)then do j = 1,nlevdecomp+1 - do fc = 1, num_soilc - c = filter_soilc (fc) + do fc = 1, num_bgc_soilc + c = filter_bgc_soilc (fc) ! if ( spinup_state >= 1 ) then ! increase transport (both advection and diffusion) by the same factor as accelerated decomposition for a given pool @@ -306,16 +306,16 @@ subroutine SoilBiogeochemLittVertTransp(bounds, num_soilc, filter_soilc, & ! Set Pe (Peclet #) and D/dz throughout column - do fc = 1, num_soilc ! dummy terms here - c = filter_soilc (fc) + do fc = 1, num_bgc_soilc ! dummy terms here + c = filter_bgc_soilc (fc) conc_trcr(c,0) = 0._r8 conc_trcr(c,col%nbedrock(c)+1:nlevdecomp+1) = 0._r8 end do do j = 1,nlevdecomp+1 - do fc = 1, num_soilc - c = filter_soilc (fc) + do fc = 1, num_bgc_soilc + c = filter_bgc_soilc (fc) conc_trcr(c,j) = conc_ptr(c,j,s) @@ -379,8 +379,8 @@ subroutine SoilBiogeochemLittVertTransp(bounds, num_soilc, filter_soilc, & ! Calculate the tridiagonal coefficients do j = 0,nlevdecomp +1 - do fc = 1, num_soilc - c = filter_soilc (fc) + do fc = 1, num_bgc_soilc + c = filter_bgc_soilc (fc) ! g = cgridcell(c) if (j > 0 .and. j < nlevdecomp+1) then @@ -428,14 +428,14 @@ subroutine SoilBiogeochemLittVertTransp(bounds, num_soilc, filter_soilc, & enddo ! fc; column enddo ! j; nlevdecomp - do fc = 1, num_soilc - c = filter_soilc (fc) + do fc = 1, num_bgc_soilc + c = filter_bgc_soilc (fc) jtop(c) = 0 enddo ! subtract initial concentration and source terms for tendency calculation - do fc = 1, num_soilc - c = filter_soilc (fc) + do fc = 1, num_bgc_soilc + c = filter_bgc_soilc (fc) do j = 1, nlevdecomp if (.not. use_soil_matrixcn) then trcr_tendency_ptr(c,j,s) = 0.-(conc_trcr(c,j) + source(c,j,s)) @@ -449,15 +449,15 @@ subroutine SoilBiogeochemLittVertTransp(bounds, num_soilc, filter_soilc, & ! Solve for the concentration profile for this time step call Tridiagonal(bounds, 0, nlevdecomp+1, & jtop(bounds%begc:bounds%endc), & - num_soilc, filter_soilc, & + num_bgc_soilc, filter_bgc_soilc, & a_tri(bounds%begc:bounds%endc, :), & b_tri(bounds%begc:bounds%endc, :), & c_tri(bounds%begc:bounds%endc, :), & r_tri(bounds%begc:bounds%endc, :), & conc_trcr(bounds%begc:bounds%endc,0:nlevdecomp+1)) ! add post-transport concentration to calculate tendency term - do fc = 1, num_soilc - c = filter_soilc (fc) + do fc = 1, num_bgc_soilc + c = filter_bgc_soilc (fc) do j = 1, nlevdecomp trcr_tendency_ptr(c,j,s) = trcr_tendency_ptr(c,j,s) + conc_trcr(c,j) trcr_tendency_ptr(c,j,s) = trcr_tendency_ptr(c,j,s) / dtime @@ -466,16 +466,16 @@ subroutine SoilBiogeochemLittVertTransp(bounds, num_soilc, filter_soilc, & else ! For matrix solution set the matrix input array do j = 1,nlevdecomp - do fc =1,num_soilc - c = filter_soilc(fc) + do fc =1,num_bgc_soilc + c = filter_bgc_soilc(fc) end do end do end if !soil_matrix else ! for CWD pools, just add do j = 1,nlevdecomp - do fc = 1, num_soilc - c = filter_soilc (fc) + do fc = 1, num_bgc_soilc + c = filter_bgc_soilc (fc) if(.not. use_soil_matrixcn)then conc_trcr(c,j) = conc_ptr(c,j,s) + source(c,j,s) else @@ -493,8 +493,8 @@ subroutine SoilBiogeochemLittVertTransp(bounds, num_soilc, filter_soilc, & if (.not. use_soil_matrixcn) then do j = 1,nlevdecomp - do fc = 1, num_soilc - c = filter_soilc (fc) + do fc = 1, num_bgc_soilc + c = filter_bgc_soilc (fc) conc_ptr(c,j,s) = conc_trcr(c,j) ! Correct for small amounts of carbon that leak into bedrock if (j > col%nbedrock(c)) then diff --git a/src/soilbiogeochem/SoilBiogeochemNLeachingMod.F90 b/src/soilbiogeochem/SoilBiogeochemNLeachingMod.F90 index 02d22d6613..a646feb1d7 100644 --- a/src/soilbiogeochem/SoilBiogeochemNLeachingMod.F90 +++ b/src/soilbiogeochem/SoilBiogeochemNLeachingMod.F90 @@ -72,7 +72,7 @@ subroutine readParams ( ncid ) end subroutine readParams !----------------------------------------------------------------------- - subroutine SoilBiogeochemNLeaching(bounds, num_soilc, filter_soilc, & + subroutine SoilBiogeochemNLeaching(bounds, num_bgc_soilc, filter_bgc_soilc, & waterstatebulk_inst, waterfluxbulk_inst, & soilbiogeochem_nitrogenstate_inst, soilbiogeochem_nitrogenflux_inst) ! @@ -86,8 +86,8 @@ subroutine SoilBiogeochemNLeaching(bounds, num_soilc, filter_soilc, & ! ! !ARGUMENTS: type(bounds_type) , intent(in) :: bounds - integer , intent(in) :: num_soilc ! number of soil columns in filter - integer , intent(in) :: filter_soilc(:) ! filter for soil columns + integer , intent(in) :: num_bgc_soilc ! number of soil columns in filter + integer , intent(in) :: filter_bgc_soilc(:) ! filter for soil columns type(waterstatebulk_type) , intent(in) :: waterstatebulk_inst type(waterfluxbulk_type) , intent(in) :: waterfluxbulk_inst type(soilbiogeochem_nitrogenstate_type) , intent(in) :: soilbiogeochem_nitrogenstate_inst @@ -133,8 +133,8 @@ subroutine SoilBiogeochemNLeaching(bounds, num_soilc, filter_soilc, & ! calculate the total soil water tot_water(bounds%begc:bounds%endc) = 0._r8 do j = 1,nlevsoi - do fc = 1,num_soilc - c = filter_soilc(fc) + do fc = 1,num_bgc_soilc + c = filter_bgc_soilc(fc) tot_water(c) = tot_water(c) + h2osoi_liq(c,j) end do end do @@ -143,21 +143,21 @@ subroutine SoilBiogeochemNLeaching(bounds, num_soilc, filter_soilc, & surface_water(bounds%begc:bounds%endc) = 0._r8 do j = 1,nlevsoi if ( zisoi(j) <= depth_runoff_Nloss) then - do fc = 1,num_soilc - c = filter_soilc(fc) + do fc = 1,num_bgc_soilc + c = filter_bgc_soilc(fc) surface_water(c) = surface_water(c) + h2osoi_liq(c,j) end do elseif ( zisoi(j-1) < depth_runoff_Nloss) then - do fc = 1,num_soilc - c = filter_soilc(fc) + do fc = 1,num_bgc_soilc + c = filter_bgc_soilc(fc) surface_water(c) = surface_water(c) + h2osoi_liq(c,j) * ( (depth_runoff_Nloss - zisoi(j-1)) / col%dz(c,j)) end do endif end do ! Loop through columns - do fc = 1,num_soilc - c = filter_soilc(fc) + do fc = 1,num_bgc_soilc + c = filter_bgc_soilc(fc) drain_tot(c) = qflx_drain(c) end do @@ -170,8 +170,8 @@ subroutine SoilBiogeochemNLeaching(bounds, num_soilc, filter_soilc, & do j = 1,nlevdecomp ! Loop through columns - do fc = 1,num_soilc - c = filter_soilc(fc) + do fc = 1,num_bgc_soilc + c = filter_bgc_soilc(fc) ! calculate the dissolved mineral N concentration (gN/kg water) ! assumes that 10% of mineral nitrogen is soluble @@ -203,8 +203,8 @@ subroutine SoilBiogeochemNLeaching(bounds, num_soilc, filter_soilc, & do j = 1,nlevdecomp ! Loop through columns - do fc = 1,num_soilc - c = filter_soilc(fc) + do fc = 1,num_bgc_soilc + c = filter_bgc_soilc(fc) ! calculate the dissolved mineral N concentration (gN/kg water) ! assumes that 10% of mineral nitrogen is soluble diff --git a/src/soilbiogeochem/SoilBiogeochemNStateUpdate1Mod.F90 b/src/soilbiogeochem/SoilBiogeochemNStateUpdate1Mod.F90 index 197a1d015b..4b70459aca 100644 --- a/src/soilbiogeochem/SoilBiogeochemNStateUpdate1Mod.F90 +++ b/src/soilbiogeochem/SoilBiogeochemNStateUpdate1Mod.F90 @@ -27,7 +27,7 @@ module SoilBiogeochemNStateUpdate1Mod contains !----------------------------------------------------------------------- - subroutine SoilBiogeochemNStateUpdate1(num_soilc, filter_soilc, & + subroutine SoilBiogeochemNStateUpdate1(num_bgc_soilc, filter_bgc_soilc, & soilbiogeochem_state_inst, soilbiogeochem_nitrogenflux_inst, soilbiogeochem_nitrogenstate_inst) ! ! !DESCRIPTION: @@ -35,8 +35,8 @@ subroutine SoilBiogeochemNStateUpdate1(num_soilc, filter_soilc, & ! variables (except for gap-phase mortality and fire fluxes) ! ! !ARGUMENTS: - integer , intent(in) :: num_soilc ! number of soil columns in filter - integer , intent(in) :: filter_soilc(:) ! filter for soil columns + integer , intent(in) :: num_bgc_soilc ! number of soil columns in filter + integer , intent(in) :: filter_bgc_soilc(:) ! filter for soil columns type(soilbiogeochem_state_type) , intent(in) :: soilbiogeochem_state_inst type(soilbiogeochem_nitrogenflux_type) , intent(inout) :: soilbiogeochem_nitrogenflux_inst type(soilbiogeochem_nitrogenstate_type) , intent(inout) :: soilbiogeochem_nitrogenstate_inst @@ -63,8 +63,8 @@ subroutine SoilBiogeochemNStateUpdate1(num_soilc, filter_soilc, & dt = get_step_size_real() do j = 1, nlevdecomp - do fc = 1,num_soilc - c = filter_soilc(fc) + do fc = 1,num_bgc_soilc + c = filter_bgc_soilc(fc) if(use_fun)then !RF in FUN logic, the fixed N goes straight into the plant, and not into the SMINN pool. ! N deposition and fixation (put all into NH4 pool) ns%smin_nh4_vr_col(c,j) = ns%smin_nh4_vr_col(c,j) + nf%ndep_to_sminn_col(c)*dt * ndep_prof(c,j) @@ -94,8 +94,8 @@ subroutine SoilBiogeochemNStateUpdate1(num_soilc, filter_soilc, & do j = 1, nlevdecomp ! column loop - do fc = 1,num_soilc - c = filter_soilc(fc) + do fc = 1,num_bgc_soilc + c = filter_bgc_soilc(fc) if (.not. use_nitrif_denitrif) then ! N deposition and fixation @@ -122,8 +122,8 @@ subroutine SoilBiogeochemNStateUpdate1(num_soilc, filter_soilc, & do k = 1, ndecomp_cascade_transitions do j = 1, nlevdecomp ! column loop - do fc = 1,num_soilc - c = filter_soilc(fc) + do fc = 1,num_bgc_soilc + c = filter_bgc_soilc(fc) nf%decomp_npools_sourcesink_col(c,j,cascade_donor_pool(k)) = & nf%decomp_npools_sourcesink_col(c,j,cascade_donor_pool(k)) - & @@ -137,8 +137,8 @@ subroutine SoilBiogeochemNStateUpdate1(num_soilc, filter_soilc, & if ( cascade_receiver_pool(k) /= 0 ) then ! skip terminal transitions do j = 1, nlevdecomp ! column loop - do fc = 1,num_soilc - c = filter_soilc(fc) + do fc = 1,num_bgc_soilc + c = filter_bgc_soilc(fc) nf%decomp_npools_sourcesink_col(c,j,cascade_receiver_pool(k)) = & nf%decomp_npools_sourcesink_col(c,j,cascade_receiver_pool(k)) + & @@ -149,8 +149,8 @@ subroutine SoilBiogeochemNStateUpdate1(num_soilc, filter_soilc, & else ! terminal transitions do j = 1, nlevdecomp ! column loop - do fc = 1,num_soilc - c = filter_soilc(fc) + do fc = 1,num_bgc_soilc + c = filter_bgc_soilc(fc) nf%decomp_npools_sourcesink_col(c,j,cascade_donor_pool(k)) = & nf%decomp_npools_sourcesink_col(c,j,cascade_donor_pool(k)) - & nf%decomp_cascade_sminn_flux_vr_col(c,j,k) * dt @@ -173,8 +173,8 @@ subroutine SoilBiogeochemNStateUpdate1(num_soilc, filter_soilc, & if ( cascade_receiver_pool(k) /= 0 ) then ! skip terminal transitions do j = 1, nlevdecomp ! column loop - do fc = 1,num_soilc - c = filter_soilc(fc) + do fc = 1,num_bgc_soilc + c = filter_bgc_soilc(fc) ns%sminn_vr_col(c,j) = ns%sminn_vr_col(c,j) - & (nf%sminn_to_denit_decomp_cascade_vr_col(c,j,k) + & nf%decomp_cascade_sminn_flux_vr_col(c,j,k))* dt @@ -183,8 +183,8 @@ subroutine SoilBiogeochemNStateUpdate1(num_soilc, filter_soilc, & else do j = 1, nlevdecomp ! column loop - do fc = 1,num_soilc - c = filter_soilc(fc) + do fc = 1,num_bgc_soilc + c = filter_bgc_soilc(fc) ns%sminn_vr_col(c,j) = ns%sminn_vr_col(c,j) - & nf%sminn_to_denit_decomp_cascade_vr_col(c,j,k)* dt @@ -198,8 +198,8 @@ subroutine SoilBiogeochemNStateUpdate1(num_soilc, filter_soilc, & do j = 1, nlevdecomp ! column loop - do fc = 1,num_soilc - c = filter_soilc(fc) + do fc = 1,num_bgc_soilc + c = filter_bgc_soilc(fc) ! "bulk denitrification" ns%sminn_vr_col(c,j) = ns%sminn_vr_col(c,j) - nf%sminn_to_denit_excess_vr_col(c,j) * dt @@ -222,8 +222,8 @@ subroutine SoilBiogeochemNStateUpdate1(num_soilc, filter_soilc, & do j = 1, nlevdecomp ! column loop - do fc = 1,num_soilc - c = filter_soilc(fc) + do fc = 1,num_bgc_soilc + c = filter_bgc_soilc(fc) ! mineralization fluxes (divert a fraction of this stream to nitrification flux, add the rest to NH4 pool) ns%smin_nh4_vr_col(c,j) = ns%smin_nh4_vr_col(c,j) + nf%gross_nmin_vr_col(c,j)*dt diff --git a/src/soilbiogeochem/SoilBiogeochemNitrifDenitrifMod.F90 b/src/soilbiogeochem/SoilBiogeochemNitrifDenitrifMod.F90 index f735c14854..b30ff759b4 100644 --- a/src/soilbiogeochem/SoilBiogeochemNitrifDenitrifMod.F90 +++ b/src/soilbiogeochem/SoilBiogeochemNitrifDenitrifMod.F90 @@ -138,7 +138,7 @@ subroutine readParams ( ncid ) end subroutine readParams !----------------------------------------------------------------------- - subroutine SoilBiogeochemNitrifDenitrif(bounds, num_soilc, filter_soilc, & + subroutine SoilBiogeochemNitrifDenitrif(bounds, num_bgc_soilc, filter_bgc_soilc, & soilstate_inst, waterstatebulk_inst, temperature_inst, ch4_inst, & soilbiogeochem_carbonflux_inst, soilbiogeochem_nitrogenstate_inst, soilbiogeochem_nitrogenflux_inst) ! @@ -151,8 +151,8 @@ subroutine SoilBiogeochemNitrifDenitrif(bounds, num_soilc, filter_soilc, & ! ! !ARGUMENTS: type(bounds_type) , intent(in) :: bounds - integer , intent(in) :: num_soilc ! number of soil columns in filter - integer , intent(in) :: filter_soilc(:) ! filter for soil columns + integer , intent(in) :: num_bgc_soilc ! number of soil columns in filter + integer , intent(in) :: filter_bgc_soilc(:) ! filter for soil columns type(soilstate_type) , intent(in) :: soilstate_inst type(waterstatebulk_type) , intent(in) :: waterstatebulk_inst type(temperature_type) , intent(in) :: temperature_inst @@ -261,8 +261,8 @@ subroutine SoilBiogeochemNitrifDenitrif(bounds, num_soilc, filter_soilc, & co2diff_con(2) = 0.0009_r8 do j = 1, nlevdecomp - do fc = 1,num_soilc - c = filter_soilc(fc) + do fc = 1,num_bgc_soilc + c = filter_bgc_soilc(fc) !---------------- calculate soil anoxia state ! calculate gas diffusivity of soil at field capacity here diff --git a/src/soilbiogeochem/SoilBiogeochemNitrogenFluxType.F90 b/src/soilbiogeochem/SoilBiogeochemNitrogenFluxType.F90 index 99ce2e7cf9..fb7eac1ce2 100644 --- a/src/soilbiogeochem/SoilBiogeochemNitrogenFluxType.F90 +++ b/src/soilbiogeochem/SoilBiogeochemNitrogenFluxType.F90 @@ -1050,7 +1050,7 @@ subroutine SetValues ( this, & end subroutine SetValues !----------------------------------------------------------------------- - subroutine Summary(this, bounds, num_soilc, filter_soilc) + subroutine Summary(this, bounds, num_bgc_soilc, filter_bgc_soilc) ! ! !USES: use clm_varpar , only: nlevdecomp, ndecomp_cascade_transitions,ndecomp_pools @@ -1059,16 +1059,16 @@ subroutine Summary(this, bounds, num_soilc, filter_soilc) ! !ARGUMENTS: class (soilbiogeochem_nitrogenflux_type) :: this type(bounds_type) , intent(in) :: bounds - integer , intent(in) :: num_soilc ! number of soil columns in filter - integer , intent(in) :: filter_soilc(:) ! filter for soil columns + integer , intent(in) :: num_bgc_soilc ! number of soil columns in filter + integer , intent(in) :: filter_bgc_soilc(:) ! filter for soil columns ! ! !LOCAL VARIABLES: integer :: c,j,k,l ! indices integer :: fc ! filter indices !----------------------------------------------------------------------- - do fc = 1,num_soilc - c = filter_soilc(fc) + do fc = 1,num_bgc_soilc + c = filter_bgc_soilc(fc) this%denit_col(c) = 0._r8 this%supplement_to_sminn_col(c) = 0._r8 this%som_n_leached_col(c) = 0._r8 @@ -1077,8 +1077,8 @@ subroutine Summary(this, bounds, num_soilc, filter_soilc) ! vertically integrate decomposing N cascade fluxes and soil mineral N fluxes associated with decomposition cascade do k = 1, ndecomp_cascade_transitions do j = 1,nlevdecomp - do fc = 1,num_soilc - c = filter_soilc(fc) + do fc = 1,num_bgc_soilc + c = filter_bgc_soilc(fc) this%decomp_cascade_ntransfer_col(c,k) = & this%decomp_cascade_ntransfer_col(c,k) + & @@ -1096,8 +1096,8 @@ subroutine Summary(this, bounds, num_soilc, filter_soilc) ! vertically integrate each denitrification flux do l = 1, ndecomp_cascade_transitions do j = 1, nlevdecomp - do fc = 1,num_soilc - c = filter_soilc(fc) + do fc = 1,num_bgc_soilc + c = filter_bgc_soilc(fc) this%sminn_to_denit_decomp_cascade_col(c,l) = & this%sminn_to_denit_decomp_cascade_col(c,l) + & this%sminn_to_denit_decomp_cascade_vr_col(c,j,l) * dzsoi_decomp(j) @@ -1107,8 +1107,8 @@ subroutine Summary(this, bounds, num_soilc, filter_soilc) ! vertically integrate bulk denitrification and leaching flux do j = 1, nlevdecomp - do fc = 1,num_soilc - c = filter_soilc(fc) + do fc = 1,num_bgc_soilc + c = filter_bgc_soilc(fc) this%sminn_to_denit_excess_col(c) = & this%sminn_to_denit_excess_col(c) + & this%sminn_to_denit_excess_vr_col(c,j) * dzsoi_decomp(j) @@ -1121,16 +1121,16 @@ subroutine Summary(this, bounds, num_soilc, filter_soilc) ! total N denitrification (DENIT) do l = 1, ndecomp_cascade_transitions - do fc = 1,num_soilc - c = filter_soilc(fc) + do fc = 1,num_bgc_soilc + c = filter_bgc_soilc(fc) this%denit_col(c) = & this%denit_col(c) + & this%sminn_to_denit_decomp_cascade_col(c,l) end do end do - do fc = 1,num_soilc - c = filter_soilc(fc) + do fc = 1,num_bgc_soilc + c = filter_bgc_soilc(fc) this%denit_col(c) = & this%denit_col(c) + & this%sminn_to_denit_excess_col(c) @@ -1140,8 +1140,8 @@ subroutine Summary(this, bounds, num_soilc, filter_soilc) ! vertically integrate NO3 NH4 N2O fluxes and pools do j = 1, nlevdecomp - do fc = 1,num_soilc - c = filter_soilc(fc) + do fc = 1,num_bgc_soilc + c = filter_bgc_soilc(fc) ! nitrification and denitrification fluxes this%f_nit_col(c) = & @@ -1180,8 +1180,8 @@ subroutine Summary(this, bounds, num_soilc, filter_soilc) end do end do - do fc = 1,num_soilc - c = filter_soilc(fc) + do fc = 1,num_bgc_soilc + c = filter_bgc_soilc(fc) this%denit_col(c) = this%f_denit_col(c) end do @@ -1189,8 +1189,8 @@ subroutine Summary(this, bounds, num_soilc, filter_soilc) ! supplementary N supplement_to_sminn do j = 1, nlevdecomp - do fc = 1,num_soilc - c = filter_soilc(fc) + do fc = 1,num_bgc_soilc + c = filter_bgc_soilc(fc) this%supplement_to_sminn_col(c) = & this%supplement_to_sminn_col(c) + & this%supplement_to_sminn_vr_col(c,j) * dzsoi_decomp(j) @@ -1199,22 +1199,22 @@ subroutine Summary(this, bounds, num_soilc, filter_soilc) ! add up all vertical transport tendency terms and calculate total som leaching loss as the sum of these do l = 1, ndecomp_pools - do fc = 1,num_soilc - c = filter_soilc(fc) + do fc = 1,num_bgc_soilc + c = filter_bgc_soilc(fc) this%decomp_npools_leached_col(c,l) = 0._r8 end do do j = 1, nlevdecomp - do fc = 1,num_soilc - c = filter_soilc(fc) + do fc = 1,num_bgc_soilc + c = filter_bgc_soilc(fc) this%decomp_npools_leached_col(c,l) = & this%decomp_npools_leached_col(c,l) + & this%decomp_npools_transport_tendency_col(c,j,l) * dzsoi_decomp(j) end do end do - do fc = 1,num_soilc - c = filter_soilc(fc) + do fc = 1,num_bgc_soilc + c = filter_bgc_soilc(fc) this%som_n_leached_col(c) = & this%som_n_leached_col(c) + & this%decomp_npools_leached_col(c,l) diff --git a/src/soilbiogeochem/SoilBiogeochemNitrogenStateType.F90 b/src/soilbiogeochem/SoilBiogeochemNitrogenStateType.F90 index ac7fa52b44..f3dc3c06cf 100644 --- a/src/soilbiogeochem/SoilBiogeochemNitrogenStateType.F90 +++ b/src/soilbiogeochem/SoilBiogeochemNitrogenStateType.F90 @@ -805,14 +805,14 @@ end subroutine SetValues !----------------------------------------------------------------------- - subroutine Summary(this, bounds, num_soilc, filter_soilc, cnveg_nitrogenstate_inst) + subroutine Summary(this, bounds, num_bgc_soilc, filter_bgc_soilc, cnveg_nitrogenstate_inst) ! ! !ARGUMENTS: class (soilbiogeochem_nitrogenstate_type) :: this type(bounds_type) , intent(in) :: bounds - integer , intent(in) :: num_soilc ! number of columns in soilc filter - integer , intent(in) :: filter_soilc(:) ! filter for all active columns + integer , intent(in) :: num_bgc_soilc ! number of bgc columns in soilc filter + integer , intent(in) :: filter_bgc_soilc(:) ! filter for bgc columns type(cnveg_nitrogenstate_type) , intent(inout) :: cnveg_nitrogenstate_inst ! @@ -826,14 +826,14 @@ subroutine Summary(this, bounds, num_soilc, filter_soilc, cnveg_nitrogenstate_in ! vertically integrate NO3 NH4 N2O pools if (use_nitrif_denitrif) then - do fc = 1,num_soilc - c = filter_soilc(fc) + do fc = 1,num_bgc_soilc + c = filter_bgc_soilc(fc) this%smin_no3_col(c) = 0._r8 this%smin_nh4_col(c) = 0._r8 end do do j = 1, nlevdecomp - do fc = 1,num_soilc - c = filter_soilc(fc) + do fc = 1,num_bgc_soilc + c = filter_bgc_soilc(fc) this%smin_no3_col(c) = & this%smin_no3_col(c) + & this%smin_no3_vr_col(c,j) * dzsoi_decomp(j) @@ -848,15 +848,15 @@ subroutine Summary(this, bounds, num_soilc, filter_soilc, cnveg_nitrogenstate_in ! vertically integrate each of the decomposing N pools do l = 1, ndecomp_pools - do fc = 1,num_soilc - c = filter_soilc(fc) + do fc = 1,num_bgc_soilc + c = filter_bgc_soilc(fc) this%decomp_npools_col(c,l) = 0._r8 if(use_soil_matrixcn)then end if end do do j = 1, nlevdecomp - do fc = 1,num_soilc - c = filter_soilc(fc) + do fc = 1,num_bgc_soilc + c = filter_bgc_soilc(fc) this%decomp_npools_col(c,l) = & this%decomp_npools_col(c,l) + & this%decomp_npools_vr_col(c,j,l) * dzsoi_decomp(j) @@ -870,8 +870,8 @@ subroutine Summary(this, bounds, num_soilc, filter_soilc, cnveg_nitrogenstate_in if ( nlevdecomp > 1) then do l = 1, ndecomp_pools - do fc = 1,num_soilc - c = filter_soilc(fc) + do fc = 1,num_bgc_soilc + c = filter_bgc_soilc(fc) this%decomp_npools_1m_col(c,l) = 0._r8 end do end do @@ -881,15 +881,15 @@ subroutine Summary(this, bounds, num_soilc, filter_soilc, cnveg_nitrogenstate_in do l = 1, ndecomp_pools do j = 1, nlevdecomp if ( zisoi(j) <= maxdepth ) then - do fc = 1,num_soilc - c = filter_soilc(fc) + do fc = 1,num_bgc_soilc + c = filter_bgc_soilc(fc) this%decomp_npools_1m_col(c,l) = & this%decomp_npools_1m_col(c,l) + & this%decomp_npools_vr_col(c,j,l) * dzsoi_decomp(j) end do elseif ( zisoi(j-1) < maxdepth ) then - do fc = 1,num_soilc - c = filter_soilc(fc) + do fc = 1,num_bgc_soilc + c = filter_bgc_soilc(fc) this%decomp_npools_1m_col(c,l) = & this%decomp_npools_1m_col(c,l) + & this%decomp_npools_vr_col(c,j,l) * (maxdepth - zisoi(j-1)) @@ -901,16 +901,16 @@ subroutine Summary(this, bounds, num_soilc, filter_soilc, cnveg_nitrogenstate_in ! Add soil nitrogen pools together to produce vertically-resolved decomposing total soil N pool if ( nlevdecomp_full > 1 ) then do j = 1, nlevdecomp - do fc = 1,num_soilc - c = filter_soilc(fc) + do fc = 1,num_bgc_soilc + c = filter_bgc_soilc(fc) this%decomp_soiln_vr_col(c,j) = 0._r8 end do end do do l = 1, ndecomp_pools if ( decomp_cascade_con%is_soil(l) ) then do j = 1, nlevdecomp - do fc = 1,num_soilc - c = filter_soilc(fc) + do fc = 1,num_bgc_soilc + c = filter_bgc_soilc(fc) this%decomp_soiln_vr_col(c,j) = this%decomp_soiln_vr_col(c,j) + & this%decomp_npools_vr_col(c,j,l) end do @@ -920,14 +920,14 @@ subroutine Summary(this, bounds, num_soilc, filter_soilc, cnveg_nitrogenstate_in end if ! total litter nitrogen to 1 meter (TOTLITN_1m) - do fc = 1,num_soilc - c = filter_soilc(fc) + do fc = 1,num_bgc_soilc + c = filter_bgc_soilc(fc) this%totlitn_1m_col(c) = 0._r8 end do do l = 1, ndecomp_pools if ( decomp_cascade_con%is_litter(l) ) then - do fc = 1,num_soilc - c = filter_soilc(fc) + do fc = 1,num_bgc_soilc + c = filter_bgc_soilc(fc) this%totlitn_1m_col(c) = & this%totlitn_1m_col(c) + & this%decomp_npools_1m_col(c,l) @@ -936,14 +936,14 @@ subroutine Summary(this, bounds, num_soilc, filter_soilc, cnveg_nitrogenstate_in end do ! total soil organic matter nitrogen to 1 meter (TOTSOMN_1m) - do fc = 1,num_soilc - c = filter_soilc(fc) + do fc = 1,num_bgc_soilc + c = filter_bgc_soilc(fc) this%totsomn_1m_col(c) = 0._r8 end do do l = 1, ndecomp_pools if ( decomp_cascade_con%is_soil(l) ) then - do fc = 1,num_soilc - c = filter_soilc(fc) + do fc = 1,num_bgc_soilc + c = filter_bgc_soilc(fc) this%totsomn_1m_col(c) = this%totsomn_1m_col(c) + & this%decomp_npools_1m_col(c,l) end do @@ -953,14 +953,14 @@ subroutine Summary(this, bounds, num_soilc, filter_soilc, cnveg_nitrogenstate_in endif ! total litter nitrogen (TOTLITN) - do fc = 1,num_soilc - c = filter_soilc(fc) + do fc = 1,num_bgc_soilc + c = filter_bgc_soilc(fc) this%totlitn_col(c) = 0._r8 end do do l = 1, ndecomp_pools if ( decomp_cascade_con%is_litter(l) ) then - do fc = 1,num_soilc - c = filter_soilc(fc) + do fc = 1,num_bgc_soilc + c = filter_bgc_soilc(fc) this%totlitn_col(c) = & this%totlitn_col(c) + & this%decomp_npools_col(c,l) @@ -969,14 +969,14 @@ subroutine Summary(this, bounds, num_soilc, filter_soilc, cnveg_nitrogenstate_in end do ! total microbial nitrogen (TOTMICN) - do fc = 1,num_soilc - c = filter_soilc(fc) + do fc = 1,num_bgc_soilc + c = filter_bgc_soilc(fc) this%totmicn_col(c) = 0._r8 end do do l = 1, ndecomp_pools if ( decomp_cascade_con%is_microbe(l) ) then - do fc = 1,num_soilc - c = filter_soilc(fc) + do fc = 1,num_bgc_soilc + c = filter_bgc_soilc(fc) this%totmicn_col(c) = & this%totmicn_col(c) + & this%decomp_npools_col(c,l) @@ -985,14 +985,14 @@ subroutine Summary(this, bounds, num_soilc, filter_soilc, cnveg_nitrogenstate_in end do ! total soil organic matter nitrogen (TOTSOMN) - do fc = 1,num_soilc - c = filter_soilc(fc) + do fc = 1,num_bgc_soilc + c = filter_bgc_soilc(fc) this%totsomn_col(c) = 0._r8 end do do l = 1, ndecomp_pools if ( decomp_cascade_con%is_soil(l) ) then - do fc = 1,num_soilc - c = filter_soilc(fc) + do fc = 1,num_bgc_soilc + c = filter_bgc_soilc(fc) this%totsomn_col(c) = this%totsomn_col(c) + & this%decomp_npools_col(c,l) end do @@ -1000,34 +1000,34 @@ subroutine Summary(this, bounds, num_soilc, filter_soilc, cnveg_nitrogenstate_in end do ! total sminn - do fc = 1,num_soilc - c = filter_soilc(fc) + do fc = 1,num_bgc_soilc + c = filter_bgc_soilc(fc) this%sminn_col(c) = 0._r8 end do do j = 1, nlevdecomp - do fc = 1,num_soilc - c = filter_soilc(fc) + do fc = 1,num_bgc_soilc + c = filter_bgc_soilc(fc) this%sminn_col(c) = this%sminn_col(c) + & this%sminn_vr_col(c,j) * dzsoi_decomp(j) end do end do ! total col_ntrunc - do fc = 1,num_soilc - c = filter_soilc(fc) + do fc = 1,num_bgc_soilc + c = filter_bgc_soilc(fc) this%ntrunc_col(c) = 0._r8 end do do j = 1, nlevdecomp - do fc = 1,num_soilc - c = filter_soilc(fc) + do fc = 1,num_bgc_soilc + c = filter_bgc_soilc(fc) this%ntrunc_col(c) = this%ntrunc_col(c) + & this%ntrunc_vr_col(c,j) * dzsoi_decomp(j) end do end do ! total cwdn - do fc = 1,num_soilc - c = filter_soilc(fc) + do fc = 1,num_bgc_soilc + c = filter_bgc_soilc(fc) this%cwdn_col(c) = 0._r8 if(col%is_fates(c)) then diff --git a/src/soilbiogeochem/SoilBiogeochemNitrogenUptakeMod.F90 b/src/soilbiogeochem/SoilBiogeochemNitrogenUptakeMod.F90 index 40c6a0bff9..a566a5882a 100644 --- a/src/soilbiogeochem/SoilBiogeochemNitrogenUptakeMod.F90 +++ b/src/soilbiogeochem/SoilBiogeochemNitrogenUptakeMod.F90 @@ -24,7 +24,7 @@ module SoilBiogeochemNitrogenUptakeMod contains !----------------------------------------------------------------------- - subroutine SoilBiogeochemNitrogenUptake(bounds, nlevdecomp, num_soilc, filter_soilc, & + subroutine SoilBiogeochemNitrogenUptake(bounds, nlevdecomp, num_bgc_soilc, filter_bgc_soilc, & sminn_vr, dzsoi_decomp, nfixation_prof, nuptake_prof) ! ! DESCRIPTION @@ -33,8 +33,8 @@ subroutine SoilBiogeochemNitrogenUptake(bounds, nlevdecomp, num_soilc, filter_so ! !ARGUMENTS: type(bounds_type) , intent(in) :: bounds integer , intent(in) :: nlevdecomp ! number of vertical layers - integer , intent(in) :: num_soilc ! number of soil columns in filter - integer , intent(in) :: filter_soilc(:) ! filter for soil columns + integer , intent(in) :: num_bgc_soilc ! number of soil columns in filter + integer , intent(in) :: filter_bgc_soilc(:) ! filter for soil columns real(r8) , intent(in) :: sminn_vr(bounds%begc: , 1: ) ! soil mineral nitrogen profile real(r8) , intent(in) :: dzsoi_decomp(1: ) ! layer thickness real(r8) , intent(in) :: nfixation_prof(bounds%begc: , 1: ) ! nitrogen fixation profile @@ -51,21 +51,21 @@ subroutine SoilBiogeochemNitrogenUptake(bounds, nlevdecomp, num_soilc, filter_so SHR_ASSERT_ALL_FL((ubound(nuptake_prof) == (/bounds%endc, nlevdecomp/)) , sourcefile, __LINE__) ! init sminn_tot - do fc=1,num_soilc - c = filter_soilc(fc) + do fc=1,num_bgc_soilc + c = filter_bgc_soilc(fc) sminn_tot(c) = 0. end do do j = 1, nlevdecomp - do fc=1,num_soilc - c = filter_soilc(fc) + do fc=1,num_bgc_soilc + c = filter_bgc_soilc(fc) sminn_tot(c) = sminn_tot(c) + sminn_vr(c,j) * dzsoi_decomp(j) end do end do do j = 1, nlevdecomp - do fc=1,num_soilc - c = filter_soilc(fc) + do fc=1,num_bgc_soilc + c = filter_bgc_soilc(fc) if (sminn_tot(c) > 0.) then nuptake_prof(c,j) = sminn_vr(c,j) / sminn_tot(c) else diff --git a/src/soilbiogeochem/SoilBiogeochemPotentialMod.F90 b/src/soilbiogeochem/SoilBiogeochemPotentialMod.F90 index beda04bbec..deb9bdbf78 100644 --- a/src/soilbiogeochem/SoilBiogeochemPotentialMod.F90 +++ b/src/soilbiogeochem/SoilBiogeochemPotentialMod.F90 @@ -68,7 +68,7 @@ subroutine readParams ( ncid ) end subroutine readParams !----------------------------------------------------------------------- - subroutine SoilBiogeochemPotential (bounds, num_soilc, filter_soilc, & + subroutine SoilBiogeochemPotential (bounds, num_bgc_soilc, filter_bgc_soilc, & soilbiogeochem_state_inst, soilbiogeochem_carbonstate_inst, soilbiogeochem_carbonflux_inst, & soilbiogeochem_nitrogenstate_inst, soilbiogeochem_nitrogenflux_inst, & cn_decomp_pools, p_decomp_cpool_loss, p_decomp_cn_gain, & @@ -80,8 +80,8 @@ subroutine SoilBiogeochemPotential (bounds, num_soilc, filter_soilc, & ! ! !ARGUMENT: type(bounds_type) , intent(in) :: bounds - integer , intent(in) :: num_soilc ! number of soil columns in filter - integer , intent(in) :: filter_soilc(:) ! filter for soil columns + integer , intent(in) :: num_bgc_soilc ! number of soil columns in filter + integer , intent(in) :: filter_bgc_soilc(:) ! filter for soil columns type(soilbiogeochem_state_type) , intent(inout) :: soilbiogeochem_state_inst type(soilbiogeochem_carbonstate_type) , intent(in) :: soilbiogeochem_carbonstate_inst type(soilbiogeochem_carbonflux_type) , intent(inout) :: soilbiogeochem_carbonflux_inst @@ -149,8 +149,8 @@ subroutine SoilBiogeochemPotential (bounds, num_soilc, filter_soilc, & do l = 1, ndecomp_pools if ( floating_cn_ratio_decomp_pools(l) ) then do j = 1,nlevdecomp - do fc = 1,num_soilc - c = filter_soilc(fc) + do fc = 1,num_bgc_soilc + c = filter_bgc_soilc(fc) if ( decomp_npools_vr(c,j,l) > 0._r8 ) then cn_decomp_pools(c,j,l) = decomp_cpools_vr(c,j,l) / decomp_npools_vr(c,j,l) end if @@ -158,8 +158,8 @@ subroutine SoilBiogeochemPotential (bounds, num_soilc, filter_soilc, & end do else do j = 1,nlevdecomp - do fc = 1,num_soilc - c = filter_soilc(fc) + do fc = 1,num_bgc_soilc + c = filter_bgc_soilc(fc) cn_decomp_pools(c,j,l) = initial_cn_ratio(l) end do end do @@ -173,8 +173,8 @@ subroutine SoilBiogeochemPotential (bounds, num_soilc, filter_soilc, & do k = 1, ndecomp_cascade_transitions do j = 1,nlevdecomp - do fc = 1,num_soilc - c = filter_soilc(fc) + do fc = 1,num_bgc_soilc + c = filter_bgc_soilc(fc) if (decomp_cpools_vr(c,j,cascade_donor_pool(k)) > 0._r8 .and. & decomp_k(c,j,cascade_donor_pool(k)) > 0._r8 ) then @@ -236,8 +236,8 @@ subroutine SoilBiogeochemPotential (bounds, num_soilc, filter_soilc, & ! transitions loop). if (decomp_method == mimics_decomp) then do j = 1,nlevdecomp - do fc = 1,num_soilc - c = filter_soilc(fc) + do fc = 1,num_bgc_soilc + c = filter_bgc_soilc(fc) ! Sum C & N fluxes from all transitions into m1 & m2 pools. ! Had to form a new loop for the summation due to the order ! necessary, ie do k as the innermost loop. @@ -293,15 +293,15 @@ subroutine SoilBiogeochemPotential (bounds, num_soilc, filter_soilc, & ! Sum up all the potential immobilization fluxes (positive pmnf flux) ! and all the mineralization fluxes (negative pmnf flux) do j = 1,nlevdecomp - do fc = 1,num_soilc - c = filter_soilc(fc) + do fc = 1,num_bgc_soilc + c = filter_bgc_soilc(fc) immob(c,j) = 0._r8 end do end do do k = 1, ndecomp_cascade_transitions do j = 1,nlevdecomp - do fc = 1,num_soilc - c = filter_soilc(fc) + do fc = 1,num_bgc_soilc + c = filter_bgc_soilc(fc) if (pmnf_decomp_cascade(c,j,k) > 0._r8) then immob(c,j) = immob(c,j) + pmnf_decomp_cascade(c,j,k) else @@ -315,23 +315,23 @@ subroutine SoilBiogeochemPotential (bounds, num_soilc, filter_soilc, & end do do j = 1,nlevdecomp - do fc = 1,num_soilc - c = filter_soilc(fc) + do fc = 1,num_bgc_soilc + c = filter_bgc_soilc(fc) potential_immob_vr(c,j) = immob(c,j) end do end do ! Add up potential hr for methane calculations do j = 1,nlevdecomp - do fc = 1,num_soilc - c = filter_soilc(fc) + do fc = 1,num_bgc_soilc + c = filter_bgc_soilc(fc) phr_vr(c,j) = 0._r8 end do end do do k = 1, ndecomp_cascade_transitions do j = 1,nlevdecomp - do fc = 1,num_soilc - c = filter_soilc(fc) + do fc = 1,num_bgc_soilc + c = filter_bgc_soilc(fc) phr_vr(c,j) = phr_vr(c,j) + rf_decomp_cascade(c,j,k) * p_decomp_cpool_loss(c,j,k) end do end do diff --git a/src/soilbiogeochem/SoilBiogeochemPrecisionControlMod.F90 b/src/soilbiogeochem/SoilBiogeochemPrecisionControlMod.F90 index cabc57990e..cc349ad8bc 100644 --- a/src/soilbiogeochem/SoilBiogeochemPrecisionControlMod.F90 +++ b/src/soilbiogeochem/SoilBiogeochemPrecisionControlMod.F90 @@ -60,7 +60,7 @@ subroutine SoilBiogeochemPrecisionControlInit( soilbiogeochem_carbonstate_inst, end subroutine SoilBiogeochemPrecisionControlInit !----------------------------------------------------------------------- - subroutine SoilBiogeochemPrecisionControl(num_soilc, filter_soilc, & + subroutine SoilBiogeochemPrecisionControl(num_bgc_soilc, filter_bgc_soilc, & soilbiogeochem_carbonstate_inst, c13_soilbiogeochem_carbonstate_inst, & c14_soilbiogeochem_carbonstate_inst, soilbiogeochem_nitrogenstate_inst) @@ -75,8 +75,8 @@ subroutine SoilBiogeochemPrecisionControl(num_soilc, filter_soilc, & use CNSharedParamsMod, only: use_fun ! ! !ARGUMENTS: - integer , intent(in) :: num_soilc ! number of soil columns in filter - integer , intent(in) :: filter_soilc(:) ! filter for soil columns + integer , intent(in) :: num_bgc_soilc ! number of bgc soil columns in filter + integer , intent(in) :: filter_bgc_soilc(:) ! filter for bgc soil columns type(soilbiogeochem_carbonstate_type) , intent(inout) :: soilbiogeochem_carbonstate_inst type(soilbiogeochem_carbonstate_type) , intent(inout) :: c13_soilbiogeochem_carbonstate_inst type(soilbiogeochem_carbonstate_type) , intent(inout) :: c14_soilbiogeochem_carbonstate_inst @@ -106,8 +106,8 @@ subroutine SoilBiogeochemPrecisionControl(num_soilc, filter_soilc, & ) ! column loop - do fc = 1,num_soilc - c = filter_soilc(fc) + do fc = 1,num_bgc_soilc + c = filter_bgc_soilc(fc) do j = 1,nlevdecomp ! initialize the column-level C and N truncation terms @@ -165,8 +165,8 @@ subroutine SoilBiogeochemPrecisionControl(num_soilc, filter_soilc, & if (use_nitrif_denitrif) then ! remove small negative perturbations for stability purposes, if any should arise. - do fc = 1,num_soilc - c = filter_soilc(fc) + do fc = 1,num_bgc_soilc + c = filter_bgc_soilc(fc) do j = 1,nlevdecomp if (abs(ns%smin_no3_vr_col(c,j)) < ncrit/1e4_r8) then if ( ns%smin_no3_vr_col(c,j) < 0._r8 ) then diff --git a/src/soilbiogeochem/SoilBiogeochemVerticalProfileMod.F90 b/src/soilbiogeochem/SoilBiogeochemVerticalProfileMod.F90 index 3548643192..49a5215cac 100644 --- a/src/soilbiogeochem/SoilBiogeochemVerticalProfileMod.F90 +++ b/src/soilbiogeochem/SoilBiogeochemVerticalProfileMod.F90 @@ -24,7 +24,7 @@ module SoilBiogeochemVerticalProfileMod contains !----------------------------------------------------------------------- - subroutine SoilBiogeochemVerticalProfile(bounds, num_soilc,filter_soilc,num_soilp,filter_soilp, & + subroutine SoilBiogeochemVerticalProfile(bounds, num_bgc_soilc,filter_bgc_soilc,num_bgc_vegp,filter_bgc_vegp, & active_layer_inst, soilstate_inst, soilbiogeochem_state_inst) ! ! !DESCRIPTION: @@ -57,10 +57,10 @@ subroutine SoilBiogeochemVerticalProfile(bounds, num_soilc,filter_soilc,num_soil ! ! !ARGUMENTS: type(bounds_type) , intent(in) :: bounds - integer , intent(in) :: num_soilc ! number of soil columns in filter - integer , intent(in) :: filter_soilc(:) ! filter for soil columns - integer , intent(in) :: num_soilp ! number of soil patches in filter - integer , intent(in) :: filter_soilp(:) ! filter for soil patches + integer , intent(in) :: num_bgc_soilc ! number of soil columns in filter + integer , intent(in) :: filter_bgc_soilc(:) ! filter for soil columns + integer , intent(in) :: num_bgc_vegp ! number of soil patches in filter + integer , intent(in) :: filter_bgc_vegp(:) ! filter for soil patches type(active_layer_type) , intent(in) :: active_layer_inst type(soilstate_type) , intent(in) :: soilstate_inst type(soilbiogeochem_state_type) , intent(inout) :: soilbiogeochem_state_inst @@ -124,8 +124,8 @@ subroutine SoilBiogeochemVerticalProfile(bounds, num_soilc,filter_soilc,num_soil cinput_rootfr(begp:endp, :) = 0._r8 col_cinput_rootfr(begc:endc, :) = 0._r8 - do fp = 1,num_soilp - p = filter_soilp(fp) + do fp = 1,num_bgc_vegp + p = filter_bgc_vegp(fp) c = patch%column(p) if (patch%itype(p) /= noveg) then do j = 1, nlevdecomp @@ -136,8 +136,8 @@ subroutine SoilBiogeochemVerticalProfile(bounds, num_soilc,filter_soilc,num_soil endif end do - do fp = 1,num_soilp - p = filter_soilp(fp) + do fp = 1,num_bgc_vegp + p = filter_bgc_vegp(fp) c = patch%column(p) ! integrate rootfr over active layer of soil column rootfr_tot = 0._r8 @@ -175,9 +175,9 @@ subroutine SoilBiogeochemVerticalProfile(bounds, num_soilc,filter_soilc,num_soil ! col_cinput_rootfr(bounds%begc:bounds%endc, :), & ! 'unity') - !if(num_soilp>0)then - do fc = 1,num_soilc - c = filter_soilc(fc) + !if(num_bgc_vegp>0)then + do fc = 1,num_bgc_soilc + c = filter_bgc_soilc(fc) if(.not.col%is_fates(c))then do pi = 1,col%npatches(c)) !maxsoil_patches !if (pi <= col%npatches(c)) then @@ -192,8 +192,8 @@ subroutine SoilBiogeochemVerticalProfile(bounds, num_soilc,filter_soilc,num_soil !end if ! repeat for column-native profiles: Ndep and Nfix - do fc = 1,num_soilc - c = filter_soilc(fc) + do fc = 1,num_bgc_soilc + c = filter_bgc_soilc(fc) rootfr_tot = 0._r8 surface_prof_tot = 0._r8 if_fates: if(col%is_fates(c))then @@ -231,8 +231,8 @@ subroutine SoilBiogeochemVerticalProfile(bounds, num_soilc,filter_soilc,num_soil end do ! check to make sure integral of all profiles = 1. - do fc = 1,num_soilc - c = filter_soilc(fc) + do fc = 1,num_bgc_soilc + c = filter_bgc_soilc(fc) ndep_prof_sum = 0. nfixation_prof_sum = 0. do j = 1, nlevdecomp @@ -258,8 +258,8 @@ subroutine SoilBiogeochemVerticalProfile(bounds, num_soilc,filter_soilc,num_soil endif end do - do fp = 1,num_soilp - p = filter_soilp(fp) + do fp = 1,num_bgc_vegp + p = filter_bgc_vegp(fp) froot_prof_sum = 0. croot_prof_sum = 0. leaf_prof_sum = 0. From 82d9b57fd68f1be5bd3ab00f72586ced9c3b3412 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Fri, 26 May 2023 17:38:20 -0400 Subject: [PATCH 067/257] Updates to the build-namelist --- bld/CLMBuildNamelist.pm | 35 +++++++++++------------------------ 1 file changed, 11 insertions(+), 24 deletions(-) diff --git a/bld/CLMBuildNamelist.pm b/bld/CLMBuildNamelist.pm index d81d185148..c5df290277 100755 --- a/bld/CLMBuildNamelist.pm +++ b/bld/CLMBuildNamelist.pm @@ -757,26 +757,12 @@ sub setup_cmdl_fates_mode { } } - # The following variables may be set by the user and are compatible with use_fates - # no need to set defaults, covered in a different routine - my @list = ( "use_lch4", "use_nitrif_denitrif" ); - foreach my $var ( @list ) { - if ( defined($nl->get_value($var)) ) { - $nl_flags->{$var} = $nl->get_value($var); - $val = $nl_flags->{$var}; - my $group = $definition->get_group_name($var); - $nl->set_variable_value($group, $var, $val); - if ( ! $definition->is_valid_value( $var, $val ) ) { - my @valid_values = $definition->get_valid_values( $var ); - $log->fatal_error("$var has a value ($val) that is NOT valid. Valid values are: @valid_values"); - } - } - } } else { # dis-allow fates specific namelist items with non-fates runs my @list = ( "fates_spitfire_mode", "use_fates_planthydro", "use_fates_ed_st3", "use_fates_ed_prescribed_phys", - "use_fates_cohort_age_tracking", - "use_fates_inventory_init","use_fates_fixed_biogeog","use_fates_nocomp","use_fates_sp","fates_inventory_ctrl_filename","use_fates_logging","fates_parteh_mode","use_fates_tree_damage" ); + "use_fates_cohort_age_tracking","use_fates_inventory_init","use_fates_fixed_biogeog", + "use_fates_nocomp","use_fates_sp","fates_inventory_ctrl_filename","use_fates_logging", + "fates_parteh_mode","use_fates_tree_damage" ); # dis-allow fates specific namelist items with non-fates runs foreach my $var ( @list ) { if ( defined($nl->get_value($var)) ) { @@ -2890,13 +2876,14 @@ sub setup_logic_supplemental_nitrogen { my ($opts, $nl_flags, $definition, $defaults, $nl) = @_; if ( $nl_flags->{'bgc_mode'} ne "sp" && $nl_flags->{'bgc_mode'} ne "fates" && &value_is_true($nl_flags->{'use_crop'}) ) { - add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, - 'suplnitro', 'use_cn'=>$nl_flags->{'use_cn'}, 'use_crop'=>$nl_flags->{'use_crop'}); - } - - if ( $nl_flags->{'bgc_mode'} ne "sp" && $nl_flags->{'bgc_mode'} eq "fates" ) { - add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, - 'suplnitro', 'use_fates'=>$nl_flags->{'use_fates'}); + # If this is non-fates, non-sp and crop is active + add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, + 'suplnitro', 'use_cn'=>$nl_flags->{'use_cn'}, 'use_crop'=>$nl_flags->{'use_crop'}); + + } elsif ( $nl_flags->{'bgc_mode'} eq "fates" && not &value_is_true( $nl_flags->{'use_fates_sp'}) ) { + # Or... if its fates but not fates-sp + add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, + 'suplnitro', 'use_fates'=>$nl_flags->{'use_fates'}); } # From 1d3e8d01826c1349a60e2f2c0a1e3b886d3258f9 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Wed, 7 Jun 2023 13:26:15 -0400 Subject: [PATCH 068/257] Reverting namelist defaults related to NDEP, we were getting ahead of ourselves with fates n-cycling --- bld/namelist_files/namelist_defaults_ctsm.xml | 90 +++++++++---------- 1 file changed, 45 insertions(+), 45 deletions(-) diff --git a/bld/namelist_files/namelist_defaults_ctsm.xml b/bld/namelist_files/namelist_defaults_ctsm.xml index 8517325c59..44ed52fb7e 100644 --- a/bld/namelist_files/namelist_defaults_ctsm.xml +++ b/bld/namelist_files/namelist_defaults_ctsm.xml @@ -1435,72 +1435,72 @@ lnd/clm2/surfdata_map/release-clm5.0.30/surfdata_ne0np4.CONUS.ne30x8_hist_78pfts lnd/clm2/snicardata/snicar_drdt_bst_fit_60_c070416.nc -2015 -2101 -2015 +2015 +2101 +2015 -2015 -2101 -2015 +2015 +2101 +2015 -2015 -2101 -2015 +2015 +2101 +2015 -2018 -2018 +2018 +2018 -2010 -2010 +2010 +2010 -2000 -2000 +2000 +2000 -1850 -1850 +1850 +1850 -2000 -2000 +2000 +2000 -2000 -2000 +2000 +2000 -2000 -2000 +2000 +2000 -lnd/clm2/ndepdata/fndep_clm_hist_b.e21.BWHIST.f09_g17.CMIP6-historical-WACCM.ensmean_1849-2015_monthly_0.9x1.25_c180926.nc -lnd/clm2/ndepdata/fndep_clm_hist_b.e21.BWHIST.f09_g17.CMIP6-historical-WACCM.ensmean_1849-2015_monthly_0.9x1.25_c180926.nc -lnd/clm2/ndepdata/fndep_clm_hist_b.e21.BWHIST.f09_g17.CMIP6-historical-WACCM.ensmean_1849-2015_monthly_0.9x1.25_c180926.nc +lnd/clm2/ndepdata/fndep_clm_hist_b.e21.BWHIST.f09_g17.CMIP6-historical-WACCM.ensmean_1849-2015_monthly_0.9x1.25_c180926.nc +lnd/clm2/ndepdata/fndep_clm_hist_b.e21.BWHIST.f09_g17.CMIP6-historical-WACCM.ensmean_1849-2015_monthly_0.9x1.25_c180926.nc +lnd/clm2/ndepdata/fndep_clm_hist_b.e21.BWHIST.f09_g17.CMIP6-historical-WACCM.ensmean_1849-2015_monthly_0.9x1.25_c180926.nc share/meshes/fv1.9x2.5_141008_ESMFmesh_c20191001.nc share/meshes/fv0.9x1.25_141008_polemod_ESMFmesh.nc -lnd/clm2/ndepdata/fndep_clm_f09_g17.CMIP6-SSP5-8.5-WACCM_1849-2101_monthly_c191007.nc -lnd/clm2/ndepdata/fndep_clm_f09_g17.CMIP6-SSP1-2.6-WACCM_1849-2101_monthly_c191007.nc -lnd/clm2/ndepdata/fndep_clm_f09_g17.CMIP6-SSP2-4.5-WACCM_1849-2101_monthly_c191007.nc -lnd/clm2/ndepdata/fndep_clm_SSP370_b.e21.BWSSP370cmip6.f09_g17.CMIP6-SSP3-7.0-WACCM.002_1849-2101_monthly_0.9x1.25_c211216.nc -lnd/clm2/ndepdata/fndep_clm_f09_g17.CMIP6-SSP5-8.5-WACCM_1849-2101_monthly_c191007.nc -lnd/clm2/ndepdata/fndep_clm_f09_g17.CMIP6-SSP1-2.6-WACCM_1849-2101_monthly_c191007.nc -lnd/clm2/ndepdata/fndep_clm_f09_g17.CMIP6-SSP2-4.5-WACCM_1849-2101_monthly_c191007.nc -lnd/clm2/ndepdata/fndep_clm_SSP370_b.e21.BWSSP370cmip6.f09_g17.CMIP6-SSP3-7.0-WACCM.002_1849-2101_monthly_0.9x1.25_c211216.nc -lnd/clm2/ndepdata/fndep_clm_f09_g17.CMIP6-SSP5-8.5-WACCM_1849-2101_monthly_c191007.nc -lnd/clm2/ndepdata/fndep_clm_f09_g17.CMIP6-SSP1-2.6-WACCM_1849-2101_monthly_c191007.nc -lnd/clm2/ndepdata/fndep_clm_f09_g17.CMIP6-SSP2-4.5-WACCM_1849-2101_monthly_c191007.nc -lnd/clm2/ndepdata/fndep_clm_SSP370_b.e21.BWSSP370cmip6.f09_g17.CMIP6-SSP3-7.0-WACCM.002_1849-2101_monthly_0.9x1.25_c211216.nc cycle @@ -1512,14 +1512,14 @@ lnd/clm2/surfdata_map/release-clm5.0.30/surfdata_ne0np4.CONUS.ne30x8_hist_78pfts cycle NDEP_month -bilinear +bilinear -nn -nn -nn -nn -nn -nn +nn +nn +nn +nn +nn +nn From 7fa071d5209c279bc1c2fd4f2a1c03a642a6dbe2 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Thu, 8 Jun 2023 08:14:48 -0600 Subject: [PATCH 069/257] Fixes to build --- src/biogeochem/CNDriverMod.F90 | 14 +++++++------- src/main/clm_driver.F90 | 2 +- .../SoilBiogeochemVerticalProfileMod.F90 | 10 +++++----- 3 files changed, 13 insertions(+), 13 deletions(-) diff --git a/src/biogeochem/CNDriverMod.F90 b/src/biogeochem/CNDriverMod.F90 index 18a5d22b16..f6be8b6b64 100644 --- a/src/biogeochem/CNDriverMod.F90 +++ b/src/biogeochem/CNDriverMod.F90 @@ -803,38 +803,38 @@ subroutine CNDriverNoLeaching(bounds, ! Set gross unrepresented landcover change mortality routine if (get_do_grossunrep()) then - call CNGrossUnrep(num_soilc, filter_soilc, num_soilp, filter_soilp, & + call CNGrossUnrep(num_bgc_soilc, filter_bgc_soilc, num_bgc_vegp, filter_bgc_vegp, & soilbiogeochem_state_inst, cnveg_carbonstate_inst, cnveg_nitrogenstate_inst, & cnveg_carbonflux_inst, cnveg_nitrogenflux_inst) end if if ( use_c13 ) then - call CIsoFlux2g(num_soilc, filter_soilc, num_soilp, filter_soilp, & + call CIsoFlux2g(num_bgc_soilc, filter_bgc_soilc, num_bgc_vegp, filter_bgc_vegp, & soilbiogeochem_state_inst, & cnveg_carbonflux_inst, cnveg_carbonstate_inst, & c13_cnveg_carbonflux_inst, c13_cnveg_carbonstate_inst, & isotope='c13') end if if ( use_c14 ) then - call CIsoFlux2g(num_soilc, filter_soilc, num_soilp, filter_soilp, & + call CIsoFlux2g(num_bgc_soilc, filter_bgc_soilc, num_bgc_vegp, filter_bgc_vegp, & soilbiogeochem_state_inst, & cnveg_carbonflux_inst, cnveg_carbonstate_inst, & c14_cnveg_carbonflux_inst, c14_cnveg_carbonstate_inst, & isotope='c14') end if - call CStateUpdate2g( num_soilc, filter_soilc, num_soilp, filter_soilp, & + call CStateUpdate2g( num_bgc_soilc, filter_bgc_soilc, num_bgc_vegp, filter_bgc_vegp, & cnveg_carbonflux_inst, cnveg_carbonstate_inst, soilbiogeochem_carbonstate_inst) if ( use_c13 ) then - call CStateUpdate2g(num_soilc, filter_soilc, num_soilp, filter_soilp, & + call CStateUpdate2g(num_bgc_soilc, filter_bgc_soilc, num_bgc_vegp, filter_bgc_vegp, & c13_cnveg_carbonflux_inst, c13_cnveg_carbonstate_inst, c13_soilbiogeochem_carbonstate_inst) end if if ( use_c14 ) then - call CStateUpdate2g(num_soilc, filter_soilc, num_soilp, filter_soilp, & + call CStateUpdate2g(num_bgc_soilc, filter_bgc_soilc, num_bgc_vegp, filter_bgc_vegp, & c14_cnveg_carbonflux_inst, c14_cnveg_carbonstate_inst, c14_soilbiogeochem_carbonstate_inst) end if - call NStateUpdate2g(num_soilc, filter_soilc, num_soilp, filter_soilp, & + call NStateUpdate2g(num_bgc_soilc, filter_bgc_soilc, num_bgc_vegp, filter_bgc_vegp, & cnveg_nitrogenflux_inst, cnveg_nitrogenstate_inst, soilbiogeochem_nitrogenstate_inst) call t_stopf('CNUpdate2') diff --git a/src/main/clm_driver.F90 b/src/main/clm_driver.F90 index a83701d884..5fb0d233ec 100644 --- a/src/main/clm_driver.F90 +++ b/src/main/clm_driver.F90 @@ -15,7 +15,7 @@ module clm_driver use clm_varctl , only : use_crop, irrigate, ndep_from_cpl use clm_varctl , only : use_soil_moisture_streams use clm_time_manager , only : get_nstep, is_beg_curr_day - use clm_time_manager , only : get_prev_date, is_first_steps + use clm_time_manager , only : get_prev_date, is_first_step use clm_varpar , only : nlevsno, nlevgrnd use clm_varorb , only : obliqr use spmdMod , only : masterproc, mpicom diff --git a/src/soilbiogeochem/SoilBiogeochemVerticalProfileMod.F90 b/src/soilbiogeochem/SoilBiogeochemVerticalProfileMod.F90 index 49a5215cac..9a15140c76 100644 --- a/src/soilbiogeochem/SoilBiogeochemVerticalProfileMod.F90 +++ b/src/soilbiogeochem/SoilBiogeochemVerticalProfileMod.F90 @@ -175,21 +175,21 @@ subroutine SoilBiogeochemVerticalProfile(bounds, num_bgc_soilc,filter_bgc_soilc, ! col_cinput_rootfr(bounds%begc:bounds%endc, :), & ! 'unity') - !if(num_bgc_vegp>0)then + do fc = 1,num_bgc_soilc c = filter_bgc_soilc(fc) if(.not.col%is_fates(c))then - do pi = 1,col%npatches(c)) !maxsoil_patches + do pi = 1,col%npatches(c) !maxsoil_patches !if (pi <= col%npatches(c)) then p = col%patchi(c) + pi - 1 do j = 1,nlevdecomp col_cinput_rootfr(c,j) = col_cinput_rootfr(c,j) + cinput_rootfr(p,j) * patch%wtcol(p) end do !end if - end if - end do + end do + end if end do - !end if + ! repeat for column-native profiles: Ndep and Nfix do fc = 1,num_bgc_soilc From 69595564dd9ffd81f14d1b3ae222e4c629d4fc76 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Thu, 8 Jun 2023 08:23:29 -0600 Subject: [PATCH 070/257] Reverted use_cn filter on ndep namelist settings --- bld/CLMBuildNamelist.pm | 16 +++++++++------- 1 file changed, 9 insertions(+), 7 deletions(-) diff --git a/bld/CLMBuildNamelist.pm b/bld/CLMBuildNamelist.pm index 9468a82a09..53db7393f4 100755 --- a/bld/CLMBuildNamelist.pm +++ b/bld/CLMBuildNamelist.pm @@ -3444,17 +3444,19 @@ sub setup_logic_nitrogen_deposition { # if ( ($nl_flags->{'bgc_mode'} =~/bgc/) or ($nl_flags->{'bgc_mode'} =~/fates/) ) { add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'ndepmapalgo', 'phys'=>$nl_flags->{'phys'}, - 'hgrid'=>$nl_flags->{'res'}, + 'use_cn'=>$nl_flags->{'use_cn'}, 'hgrid'=>$nl_flags->{'res'}, 'clm_accelerated_spinup'=>$nl_flags->{'clm_accelerated_spinup'} ); add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'ndep_taxmode', 'phys'=>$nl_flags->{'phys'}, + 'use_cn'=>$nl_flags->{'use_cn'}, 'lnd_tuning_mode'=>$nl_flags->{'lnd_tuning_mode'} ); add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'ndep_varlist', 'phys'=>$nl_flags->{'phys'}, + 'use_cn'=>$nl_flags->{'use_cn'}, 'lnd_tuning_mode'=>$nl_flags->{'lnd_tuning_mode'} ); add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'stream_year_first_ndep', 'phys'=>$nl_flags->{'phys'}, - 'sim_year'=>$nl_flags->{'sim_year'}, + 'use_cn'=>$nl_flags->{'use_cn'}, 'sim_year'=>$nl_flags->{'sim_year'}, 'sim_year_range'=>$nl_flags->{'sim_year_range'}); add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'stream_year_last_ndep', 'phys'=>$nl_flags->{'phys'}, - 'sim_year'=>$nl_flags->{'sim_year'}, + 'use_cn'=>$nl_flags->{'use_cn'}, 'sim_year'=>$nl_flags->{'sim_year'}, 'sim_year_range'=>$nl_flags->{'sim_year_range'}); # Set align year, if first and last years are different if ( $nl->get_value('stream_year_first_ndep') != $nl->get_value('stream_year_last_ndep') ) { @@ -3462,12 +3464,12 @@ sub setup_logic_nitrogen_deposition { 'sim_year_range'=>$nl_flags->{'sim_year_range'}); } add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'stream_fldfilename_ndep', 'phys'=>$nl_flags->{'phys'}, - 'lnd_tuning_mode'=>$nl_flags->{'lnd_tuning_mode'}, + 'use_cn'=>$nl_flags->{'use_cn'}, 'lnd_tuning_mode'=>$nl_flags->{'lnd_tuning_mode'}, 'hgrid'=>"0.9x1.25", 'ssp_rcp'=>$nl_flags->{'ssp_rcp'}, 'nofail'=>1 ); if ( ! defined($nl->get_value('stream_fldfilename_ndep') ) ) { # Also check at f19 resolution add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'stream_fldfilename_ndep', 'phys'=>$nl_flags->{'phys'}, - 'lnd_tuning_mode'=>$nl_flags->{'lnd_tuning_mode'}, + 'use_cn'=>$nl_flags->{'use_cn'}, 'lnd_tuning_mode'=>$nl_flags->{'lnd_tuning_mode'}, 'hgrid'=>"1.9x2.5", 'ssp_rcp'=>$nl_flags->{'ssp_rcp'}, 'nofail'=>1 ); # If not found report an error if ( ! defined($nl->get_value('stream_fldfilename_ndep') ) ) { @@ -3479,12 +3481,12 @@ sub setup_logic_nitrogen_deposition { } if ($opts->{'driver'} eq "nuopc" ) { add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'stream_meshfile_ndep', 'phys'=>$nl_flags->{'phys'}, - 'lnd_tuning_mode'=>$nl_flags->{'lnd_tuning_mode'}, + 'use_cn'=>$nl_flags->{'use_cn'}, 'lnd_tuning_mode'=>$nl_flags->{'lnd_tuning_mode'}, 'hgrid'=>"0.9x1.25", 'ssp_rcp'=>$nl_flags->{'ssp_rcp'}, 'nofail'=>1 ); if ( ! defined($nl->get_value('stream_fldfilename_ndep') ) ) { # Also check at f19 resolution add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'stream_meshfile_ndep', 'phys'=>$nl_flags->{'phys'}, - 'lnd_tuning_mode'=>$nl_flags->{'lnd_tuning_mode'}, + 'use_cn'=>$nl_flags->{'use_cn'}, 'lnd_tuning_mode'=>$nl_flags->{'lnd_tuning_mode'}, 'hgrid'=>"1.9x2.5", 'ssp_rcp'=>$nl_flags->{'ssp_rcp'}, 'nofail'=>1 ); # If not found report an error if ( ! defined($nl->get_value('stream_meshfile_ndep') ) ) { From 27e28ab6fb8821b749a1517ee9abe5cbd0bc4cf6 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Thu, 8 Jun 2023 12:19:42 -0600 Subject: [PATCH 071/257] preserving b4b on nitrogen variables by referting a filter to allc --- src/biogeochem/CNDriverMod.F90 | 8 +- .../SoilBiogeochemCarbonStateType.F90 | 86 +++++++-------- .../SoilBiogeochemNitrogenStateType.F90 | 102 +++++++++--------- 3 files changed, 98 insertions(+), 98 deletions(-) diff --git a/src/biogeochem/CNDriverMod.F90 b/src/biogeochem/CNDriverMod.F90 index f6be8b6b64..569866d9ec 100644 --- a/src/biogeochem/CNDriverMod.F90 +++ b/src/biogeochem/CNDriverMod.F90 @@ -1173,12 +1173,12 @@ subroutine CNDriverSummarizeStates(bounds, num_allc, filter_allc, & ! cnveg summary, swapped call order ! ---------------------------------------------- - call soilbiogeochem_carbonstate_inst%summary(bounds, num_bgc_soilc, filter_bgc_soilc, cnveg_carbonstate_inst) + call soilbiogeochem_carbonstate_inst%summary(bounds, num_allc, filter_allc, cnveg_carbonstate_inst) if ( use_c13 ) then - call c13_soilbiogeochem_carbonstate_inst%summary(bounds, num_bgc_soilc, filter_bgc_soilc, c13_cnveg_carbonstate_inst) + call c13_soilbiogeochem_carbonstate_inst%summary(bounds, num_allc, filter_allc, c13_cnveg_carbonstate_inst) end if if ( use_c14 ) then - call c14_soilbiogeochem_carbonstate_inst%summary(bounds, num_bgc_soilc, filter_bgc_soilc, c14_cnveg_carbonstate_inst) + call c14_soilbiogeochem_carbonstate_inst%summary(bounds, num_allc, filter_allc, c14_cnveg_carbonstate_inst) end if @@ -1189,7 +1189,7 @@ subroutine CNDriverSummarizeStates(bounds, num_allc, filter_allc, & call cnveg_nitrogenstate_inst%Summary(bounds, num_bgc_soilc, filter_bgc_soilc, & num_bgc_vegp, filter_bgc_vegp) - call soilbiogeochem_nitrogenstate_inst%summary(bounds, num_bgc_soilc, filter_bgc_soilc,cnveg_nitrogenstate_inst) + call soilbiogeochem_nitrogenstate_inst%summary(bounds, num_allc, filter_allc,cnveg_nitrogenstate_inst) call t_stopf('CNsum') diff --git a/src/soilbiogeochem/SoilBiogeochemCarbonStateType.F90 b/src/soilbiogeochem/SoilBiogeochemCarbonStateType.F90 index 70976bc15a..241d7eeb25 100644 --- a/src/soilbiogeochem/SoilBiogeochemCarbonStateType.F90 +++ b/src/soilbiogeochem/SoilBiogeochemCarbonStateType.F90 @@ -931,7 +931,7 @@ subroutine SetValues ( this, num_column, filter_column, value_column) end subroutine SetValues !----------------------------------------------------------------------- - subroutine Summary(this, bounds, num_bgc_soilc, filter_bgc_soilc, cnveg_carbonstate_inst) + subroutine Summary(this, bounds, num_allc, filter_allc, cnveg_carbonstate_inst) ! ! !DESCRIPTION: ! Perform column-level carbon summary calculations @@ -939,8 +939,8 @@ subroutine Summary(this, bounds, num_bgc_soilc, filter_bgc_soilc, cnveg_carbonst ! !ARGUMENTS: class(soilbiogeochem_carbonstate_type) :: this type(bounds_type) , intent(in) :: bounds - integer , intent(in) :: num_bgc_soilc ! number of columns in soil filter - integer , intent(in) :: filter_bgc_soilc(:) ! filter for all active columns + integer , intent(in) :: num_allc ! number of columns in soil filter + integer , intent(in) :: filter_allc(:) ! filter for all active columns type(cnveg_carbonstate_type) , intent(inout) :: cnveg_carbonstate_inst ! @@ -954,8 +954,8 @@ subroutine Summary(this, bounds, num_bgc_soilc, filter_bgc_soilc, cnveg_carbonst ! vertically integrate each of the decomposing C pools do l = 1, ndecomp_pools - do fc = 1,num_bgc_soilc - c = filter_bgc_soilc(fc) + do fc = 1,num_allc + c = filter_allc(fc) this%decomp_cpools_col(c,l) = 0._r8 if(use_soil_matrixcn)then end if @@ -963,8 +963,8 @@ subroutine Summary(this, bounds, num_bgc_soilc, filter_bgc_soilc, cnveg_carbonst end do do l = 1, ndecomp_pools do j = 1, nlevdecomp - do fc = 1,num_bgc_soilc - c = filter_bgc_soilc(fc) + do fc = 1,num_allc + c = filter_allc(fc) this%decomp_cpools_col(c,l) = & this%decomp_cpools_col(c,l) + & this%decomp_cpools_vr_col(c,j,l) * dzsoi_decomp(j) @@ -979,23 +979,23 @@ subroutine Summary(this, bounds, num_bgc_soilc, filter_bgc_soilc, cnveg_carbonst ! vertically integrate each of the decomposing C pools to 1 meter maxdepth = 1._r8 do l = 1, ndecomp_pools - do fc = 1,num_bgc_soilc - c = filter_bgc_soilc(fc) + do fc = 1,num_allc + c = filter_allc(fc) this%decomp_cpools_1m_col(c,l) = 0._r8 end do end do do l = 1, ndecomp_pools do j = 1, nlevdecomp if ( zisoi(j) <= maxdepth ) then - do fc = 1,num_bgc_soilc - c = filter_bgc_soilc(fc) + do fc = 1,num_allc + c = filter_allc(fc) this%decomp_cpools_1m_col(c,l) = & this%decomp_cpools_1m_col(c,l) + & this%decomp_cpools_vr_col(c,j,l) * dzsoi_decomp(j) end do elseif ( zisoi(j-1) < maxdepth ) then - do fc = 1,num_bgc_soilc - c = filter_bgc_soilc(fc) + do fc = 1,num_allc + c = filter_allc(fc) this%decomp_cpools_1m_col(c,l) = & this%decomp_cpools_1m_col(c,l) + & this%decomp_cpools_vr_col(c,j,l) * (maxdepth - zisoi(j-1)) @@ -1009,16 +1009,16 @@ subroutine Summary(this, bounds, num_bgc_soilc, filter_bgc_soilc, cnveg_carbonst ! Add soil carbon pools together to produce vertically-resolved decomposing total soil c pool if ( nlevdecomp_full > 1 ) then do j = 1, nlevdecomp - do fc = 1,num_bgc_soilc - c = filter_bgc_soilc(fc) + do fc = 1,num_allc + c = filter_allc(fc) this%decomp_soilc_vr_col(c,j) = 0._r8 end do end do do l = 1, ndecomp_pools if ( decomp_cascade_con%is_soil(l) ) then do j = 1, nlevdecomp - do fc = 1,num_bgc_soilc - c = filter_bgc_soilc(fc) + do fc = 1,num_allc + c = filter_allc(fc) this%decomp_soilc_vr_col(c,j) = this%decomp_soilc_vr_col(c,j) + & this%decomp_cpools_vr_col(c,j,l) end do @@ -1028,13 +1028,13 @@ subroutine Summary(this, bounds, num_bgc_soilc, filter_bgc_soilc, cnveg_carbonst end if ! truncation carbon - do fc = 1,num_bgc_soilc - c = filter_bgc_soilc(fc) + do fc = 1,num_allc + c = filter_allc(fc) this%ctrunc_col(c) = 0._r8 end do do j = 1, nlevdecomp - do fc = 1,num_bgc_soilc - c = filter_bgc_soilc(fc) + do fc = 1,num_allc + c = filter_allc(fc) this%ctrunc_col(c) = & this%ctrunc_col(c) + & this%ctrunc_vr_col(c,j) * dzsoi_decomp(j) @@ -1043,14 +1043,14 @@ subroutine Summary(this, bounds, num_bgc_soilc, filter_bgc_soilc, cnveg_carbonst ! total litter carbon in the top meter (TOTLITC_1m) if ( nlevdecomp > 1) then - do fc = 1,num_bgc_soilc - c = filter_bgc_soilc(fc) + do fc = 1,num_allc + c = filter_allc(fc) this%totlitc_1m_col(c) = 0._r8 end do do l = 1, ndecomp_pools if ( decomp_cascade_con%is_litter(l) ) then - do fc = 1,num_bgc_soilc - c = filter_bgc_soilc(fc) + do fc = 1,num_allc + c = filter_allc(fc) this%totlitc_1m_col(c) = this%totlitc_1m_col(c) + & this%decomp_cpools_1m_col(c,l) end do @@ -1060,14 +1060,14 @@ subroutine Summary(this, bounds, num_bgc_soilc, filter_bgc_soilc, cnveg_carbonst ! total soil organic matter carbon in the top meter (TOTSOMC_1m) if ( nlevdecomp > 1) then - do fc = 1,num_bgc_soilc - c = filter_bgc_soilc(fc) + do fc = 1,num_allc + c = filter_allc(fc) this%totsomc_1m_col(c) = 0._r8 end do do l = 1, ndecomp_pools if ( decomp_cascade_con%is_soil(l) ) then - do fc = 1,num_bgc_soilc - c = filter_bgc_soilc(fc) + do fc = 1,num_allc + c = filter_allc(fc) this%totsomc_1m_col(c) = this%totsomc_1m_col(c) + this%decomp_cpools_1m_col(c,l) end do end if @@ -1075,42 +1075,42 @@ subroutine Summary(this, bounds, num_bgc_soilc, filter_bgc_soilc, cnveg_carbonst end if ! total microbial carbon (TOTMICC) - do fc = 1,num_bgc_soilc - c = filter_bgc_soilc(fc) + do fc = 1,num_allc + c = filter_allc(fc) this%totmicc_col(c) = 0._r8 end do do l = 1, ndecomp_pools if ( decomp_cascade_con%is_microbe(l) ) then - do fc = 1,num_bgc_soilc - c = filter_bgc_soilc(fc) + do fc = 1,num_allc + c = filter_allc(fc) this%totmicc_col(c) = this%totmicc_col(c) + this%decomp_cpools_col(c,l) end do endif end do ! total litter carbon (TOTLITC) - do fc = 1,num_bgc_soilc - c = filter_bgc_soilc(fc) + do fc = 1,num_allc + c = filter_allc(fc) this%totlitc_col(c) = 0._r8 end do do l = 1, ndecomp_pools if ( decomp_cascade_con%is_litter(l) ) then - do fc = 1,num_bgc_soilc - c = filter_bgc_soilc(fc) + do fc = 1,num_allc + c = filter_allc(fc) this%totlitc_col(c) = this%totlitc_col(c) + this%decomp_cpools_col(c,l) end do endif end do ! total soil organic matter carbon (TOTSOMC) - do fc = 1,num_bgc_soilc - c = filter_bgc_soilc(fc) + do fc = 1,num_allc + c = filter_allc(fc) this%totsomc_col(c) = 0._r8 end do do l = 1, ndecomp_pools if ( decomp_cascade_con%is_soil(l) ) then - do fc = 1,num_bgc_soilc - c = filter_bgc_soilc(fc) + do fc = 1,num_allc + c = filter_allc(fc) this%totsomc_col(c) = this%totsomc_col(c) + this%decomp_cpools_col(c,l) end do end if @@ -1118,8 +1118,8 @@ subroutine Summary(this, bounds, num_bgc_soilc, filter_bgc_soilc, cnveg_carbonst - do fc = 1,num_bgc_soilc - c = filter_bgc_soilc(fc) + do fc = 1,num_allc + c = filter_allc(fc) ! coarse woody debris carbon this%cwdc_col(c) = 0._r8 diff --git a/src/soilbiogeochem/SoilBiogeochemNitrogenStateType.F90 b/src/soilbiogeochem/SoilBiogeochemNitrogenStateType.F90 index f3dc3c06cf..b537d0896e 100644 --- a/src/soilbiogeochem/SoilBiogeochemNitrogenStateType.F90 +++ b/src/soilbiogeochem/SoilBiogeochemNitrogenStateType.F90 @@ -805,14 +805,14 @@ end subroutine SetValues !----------------------------------------------------------------------- - subroutine Summary(this, bounds, num_bgc_soilc, filter_bgc_soilc, cnveg_nitrogenstate_inst) + subroutine Summary(this, bounds, num_allc, filter_allc, cnveg_nitrogenstate_inst) ! ! !ARGUMENTS: class (soilbiogeochem_nitrogenstate_type) :: this type(bounds_type) , intent(in) :: bounds - integer , intent(in) :: num_bgc_soilc ! number of bgc columns in soilc filter - integer , intent(in) :: filter_bgc_soilc(:) ! filter for bgc columns + integer , intent(in) :: num_allc ! number of bgc columns in soilc filter + integer , intent(in) :: filter_allc(:) ! filter for bgc columns type(cnveg_nitrogenstate_type) , intent(inout) :: cnveg_nitrogenstate_inst ! @@ -826,14 +826,14 @@ subroutine Summary(this, bounds, num_bgc_soilc, filter_bgc_soilc, cnveg_nitrogen ! vertically integrate NO3 NH4 N2O pools if (use_nitrif_denitrif) then - do fc = 1,num_bgc_soilc - c = filter_bgc_soilc(fc) + do fc = 1,num_allc + c = filter_allc(fc) this%smin_no3_col(c) = 0._r8 this%smin_nh4_col(c) = 0._r8 end do do j = 1, nlevdecomp - do fc = 1,num_bgc_soilc - c = filter_bgc_soilc(fc) + do fc = 1,num_allc + c = filter_allc(fc) this%smin_no3_col(c) = & this%smin_no3_col(c) + & this%smin_no3_vr_col(c,j) * dzsoi_decomp(j) @@ -848,15 +848,15 @@ subroutine Summary(this, bounds, num_bgc_soilc, filter_bgc_soilc, cnveg_nitrogen ! vertically integrate each of the decomposing N pools do l = 1, ndecomp_pools - do fc = 1,num_bgc_soilc - c = filter_bgc_soilc(fc) + do fc = 1,num_allc + c = filter_allc(fc) this%decomp_npools_col(c,l) = 0._r8 if(use_soil_matrixcn)then end if end do do j = 1, nlevdecomp - do fc = 1,num_bgc_soilc - c = filter_bgc_soilc(fc) + do fc = 1,num_allc + c = filter_allc(fc) this%decomp_npools_col(c,l) = & this%decomp_npools_col(c,l) + & this%decomp_npools_vr_col(c,j,l) * dzsoi_decomp(j) @@ -870,8 +870,8 @@ subroutine Summary(this, bounds, num_bgc_soilc, filter_bgc_soilc, cnveg_nitrogen if ( nlevdecomp > 1) then do l = 1, ndecomp_pools - do fc = 1,num_bgc_soilc - c = filter_bgc_soilc(fc) + do fc = 1,num_allc + c = filter_allc(fc) this%decomp_npools_1m_col(c,l) = 0._r8 end do end do @@ -881,15 +881,15 @@ subroutine Summary(this, bounds, num_bgc_soilc, filter_bgc_soilc, cnveg_nitrogen do l = 1, ndecomp_pools do j = 1, nlevdecomp if ( zisoi(j) <= maxdepth ) then - do fc = 1,num_bgc_soilc - c = filter_bgc_soilc(fc) + do fc = 1,num_allc + c = filter_allc(fc) this%decomp_npools_1m_col(c,l) = & this%decomp_npools_1m_col(c,l) + & this%decomp_npools_vr_col(c,j,l) * dzsoi_decomp(j) end do elseif ( zisoi(j-1) < maxdepth ) then - do fc = 1,num_bgc_soilc - c = filter_bgc_soilc(fc) + do fc = 1,num_allc + c = filter_allc(fc) this%decomp_npools_1m_col(c,l) = & this%decomp_npools_1m_col(c,l) + & this%decomp_npools_vr_col(c,j,l) * (maxdepth - zisoi(j-1)) @@ -901,16 +901,16 @@ subroutine Summary(this, bounds, num_bgc_soilc, filter_bgc_soilc, cnveg_nitrogen ! Add soil nitrogen pools together to produce vertically-resolved decomposing total soil N pool if ( nlevdecomp_full > 1 ) then do j = 1, nlevdecomp - do fc = 1,num_bgc_soilc - c = filter_bgc_soilc(fc) + do fc = 1,num_allc + c = filter_allc(fc) this%decomp_soiln_vr_col(c,j) = 0._r8 end do end do do l = 1, ndecomp_pools if ( decomp_cascade_con%is_soil(l) ) then do j = 1, nlevdecomp - do fc = 1,num_bgc_soilc - c = filter_bgc_soilc(fc) + do fc = 1,num_allc + c = filter_allc(fc) this%decomp_soiln_vr_col(c,j) = this%decomp_soiln_vr_col(c,j) + & this%decomp_npools_vr_col(c,j,l) end do @@ -920,14 +920,14 @@ subroutine Summary(this, bounds, num_bgc_soilc, filter_bgc_soilc, cnveg_nitrogen end if ! total litter nitrogen to 1 meter (TOTLITN_1m) - do fc = 1,num_bgc_soilc - c = filter_bgc_soilc(fc) + do fc = 1,num_allc + c = filter_allc(fc) this%totlitn_1m_col(c) = 0._r8 end do do l = 1, ndecomp_pools if ( decomp_cascade_con%is_litter(l) ) then - do fc = 1,num_bgc_soilc - c = filter_bgc_soilc(fc) + do fc = 1,num_allc + c = filter_allc(fc) this%totlitn_1m_col(c) = & this%totlitn_1m_col(c) + & this%decomp_npools_1m_col(c,l) @@ -936,14 +936,14 @@ subroutine Summary(this, bounds, num_bgc_soilc, filter_bgc_soilc, cnveg_nitrogen end do ! total soil organic matter nitrogen to 1 meter (TOTSOMN_1m) - do fc = 1,num_bgc_soilc - c = filter_bgc_soilc(fc) + do fc = 1,num_allc + c = filter_allc(fc) this%totsomn_1m_col(c) = 0._r8 end do do l = 1, ndecomp_pools if ( decomp_cascade_con%is_soil(l) ) then - do fc = 1,num_bgc_soilc - c = filter_bgc_soilc(fc) + do fc = 1,num_allc + c = filter_allc(fc) this%totsomn_1m_col(c) = this%totsomn_1m_col(c) + & this%decomp_npools_1m_col(c,l) end do @@ -953,14 +953,14 @@ subroutine Summary(this, bounds, num_bgc_soilc, filter_bgc_soilc, cnveg_nitrogen endif ! total litter nitrogen (TOTLITN) - do fc = 1,num_bgc_soilc - c = filter_bgc_soilc(fc) + do fc = 1,num_allc + c = filter_allc(fc) this%totlitn_col(c) = 0._r8 end do do l = 1, ndecomp_pools if ( decomp_cascade_con%is_litter(l) ) then - do fc = 1,num_bgc_soilc - c = filter_bgc_soilc(fc) + do fc = 1,num_allc + c = filter_allc(fc) this%totlitn_col(c) = & this%totlitn_col(c) + & this%decomp_npools_col(c,l) @@ -969,14 +969,14 @@ subroutine Summary(this, bounds, num_bgc_soilc, filter_bgc_soilc, cnveg_nitrogen end do ! total microbial nitrogen (TOTMICN) - do fc = 1,num_bgc_soilc - c = filter_bgc_soilc(fc) + do fc = 1,num_allc + c = filter_allc(fc) this%totmicn_col(c) = 0._r8 end do do l = 1, ndecomp_pools if ( decomp_cascade_con%is_microbe(l) ) then - do fc = 1,num_bgc_soilc - c = filter_bgc_soilc(fc) + do fc = 1,num_allc + c = filter_allc(fc) this%totmicn_col(c) = & this%totmicn_col(c) + & this%decomp_npools_col(c,l) @@ -985,14 +985,14 @@ subroutine Summary(this, bounds, num_bgc_soilc, filter_bgc_soilc, cnveg_nitrogen end do ! total soil organic matter nitrogen (TOTSOMN) - do fc = 1,num_bgc_soilc - c = filter_bgc_soilc(fc) + do fc = 1,num_allc + c = filter_allc(fc) this%totsomn_col(c) = 0._r8 end do do l = 1, ndecomp_pools if ( decomp_cascade_con%is_soil(l) ) then - do fc = 1,num_bgc_soilc - c = filter_bgc_soilc(fc) + do fc = 1,num_allc + c = filter_allc(fc) this%totsomn_col(c) = this%totsomn_col(c) + & this%decomp_npools_col(c,l) end do @@ -1000,34 +1000,34 @@ subroutine Summary(this, bounds, num_bgc_soilc, filter_bgc_soilc, cnveg_nitrogen end do ! total sminn - do fc = 1,num_bgc_soilc - c = filter_bgc_soilc(fc) + do fc = 1,num_allc + c = filter_allc(fc) this%sminn_col(c) = 0._r8 end do do j = 1, nlevdecomp - do fc = 1,num_bgc_soilc - c = filter_bgc_soilc(fc) + do fc = 1,num_allc + c = filter_allc(fc) this%sminn_col(c) = this%sminn_col(c) + & this%sminn_vr_col(c,j) * dzsoi_decomp(j) end do end do ! total col_ntrunc - do fc = 1,num_bgc_soilc - c = filter_bgc_soilc(fc) + do fc = 1,num_allc + c = filter_allc(fc) this%ntrunc_col(c) = 0._r8 end do do j = 1, nlevdecomp - do fc = 1,num_bgc_soilc - c = filter_bgc_soilc(fc) + do fc = 1,num_allc + c = filter_allc(fc) this%ntrunc_col(c) = this%ntrunc_col(c) + & this%ntrunc_vr_col(c,j) * dzsoi_decomp(j) end do end do ! total cwdn - do fc = 1,num_bgc_soilc - c = filter_bgc_soilc(fc) + do fc = 1,num_allc + c = filter_allc(fc) this%cwdn_col(c) = 0._r8 if(col%is_fates(c)) then From 0f2d990dd1be49ddc2c13342ab02d575c3f7ea64 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Mon, 12 Jun 2023 11:51:27 -0600 Subject: [PATCH 072/257] Updates to the fates-clm bgc call sequence, to preserve b4b behavior in non-fates --- bld/CLMBuildNamelist.pm | 2 +- src/biogeochem/CNDriverMod.F90 | 12 ++++++++---- src/main/clm_driver.F90 | 2 +- src/main/clm_initializeMod.F90 | 2 +- src/main/filterMod.F90 | 2 +- .../SoilBiogeochemCarbonStateType.F90 | 15 ++++++++++++--- .../SoilBiogeochemNitrogenStateType.F90 | 10 +++++++++- 7 files changed, 33 insertions(+), 12 deletions(-) diff --git a/bld/CLMBuildNamelist.pm b/bld/CLMBuildNamelist.pm index 53db7393f4..75fc6c7365 100755 --- a/bld/CLMBuildNamelist.pm +++ b/bld/CLMBuildNamelist.pm @@ -3442,7 +3442,7 @@ sub setup_logic_nitrogen_deposition { # # Nitrogen deposition for bgc=CN or fates # - if ( ($nl_flags->{'bgc_mode'} =~/bgc/) or ($nl_flags->{'bgc_mode'} =~/fates/) ) { + if ( ($nl_flags->{'bgc_mode'} =~/bgc/) ) { # or ($nl_flags->{'bgc_mode'} =~/fates/) ) { add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'ndepmapalgo', 'phys'=>$nl_flags->{'phys'}, 'use_cn'=>$nl_flags->{'use_cn'}, 'hgrid'=>$nl_flags->{'res'}, 'clm_accelerated_spinup'=>$nl_flags->{'clm_accelerated_spinup'} ); diff --git a/src/biogeochem/CNDriverMod.F90 b/src/biogeochem/CNDriverMod.F90 index 569866d9ec..424cf8c52b 100644 --- a/src/biogeochem/CNDriverMod.F90 +++ b/src/biogeochem/CNDriverMod.F90 @@ -1173,12 +1173,15 @@ subroutine CNDriverSummarizeStates(bounds, num_allc, filter_allc, & ! cnveg summary, swapped call order ! ---------------------------------------------- - call soilbiogeochem_carbonstate_inst%summary(bounds, num_allc, filter_allc, cnveg_carbonstate_inst) + call soilbiogeochem_carbonstate_inst%summary(bounds, num_allc, filter_allc, & + num_bgc_soilc, filter_bgc_soilc, cnveg_carbonstate_inst) if ( use_c13 ) then - call c13_soilbiogeochem_carbonstate_inst%summary(bounds, num_allc, filter_allc, c13_cnveg_carbonstate_inst) + call c13_soilbiogeochem_carbonstate_inst%summary(bounds, num_allc, filter_allc, & + num_bgc_soilc, filter_bgc_soilc, c13_cnveg_carbonstate_inst) end if if ( use_c14 ) then - call c14_soilbiogeochem_carbonstate_inst%summary(bounds, num_allc, filter_allc, c14_cnveg_carbonstate_inst) + call c14_soilbiogeochem_carbonstate_inst%summary(bounds, num_allc, filter_allc, & + num_bgc_soilc, filter_bgc_soilc, c14_cnveg_carbonstate_inst) end if @@ -1189,7 +1192,8 @@ subroutine CNDriverSummarizeStates(bounds, num_allc, filter_allc, & call cnveg_nitrogenstate_inst%Summary(bounds, num_bgc_soilc, filter_bgc_soilc, & num_bgc_vegp, filter_bgc_vegp) - call soilbiogeochem_nitrogenstate_inst%summary(bounds, num_allc, filter_allc,cnveg_nitrogenstate_inst) + call soilbiogeochem_nitrogenstate_inst%summary(bounds, num_allc, filter_allc, & + num_bgc_soilc, filter_bgc_soilc, cnveg_nitrogenstate_inst) call t_stopf('CNsum') diff --git a/src/main/clm_driver.F90 b/src/main/clm_driver.F90 index 5fb0d233ec..fe64ea12e1 100644 --- a/src/main/clm_driver.F90 +++ b/src/main/clm_driver.F90 @@ -445,7 +445,7 @@ subroutine clm_drv(doalb, nextsw_cday, declinp1, declin, rstwr, nlend, rdate, ro ! re-written to go inside. ! ============================================================================ - if (use_cn .or. use_fates_bgc) then + if (use_cn) then ! .or. use_fates_bgc) then (ndep with fates will be added soon) if (.not. ndep_from_cpl) then call ndep_interp(bounds_proc, atm2lnd_inst) end if diff --git a/src/main/clm_initializeMod.F90 b/src/main/clm_initializeMod.F90 index 98e6ba006e..00b7c93060 100644 --- a/src/main/clm_initializeMod.F90 +++ b/src/main/clm_initializeMod.F90 @@ -626,7 +626,7 @@ subroutine initialize2(ni,nj) !$OMP END PARALLEL DO ! Initialize nitrogen deposition - if (use_cn .or. use_fates_bgc) then + if (use_cn ) then !.or. use_fates_bgc) then (ndep with fates will be added soon RGK) call t_startf('init_ndep') if (.not. ndep_from_cpl) then call ndep_init(bounds_proc, NLFilename) diff --git a/src/main/filterMod.F90 b/src/main/filterMod.F90 index 0b7d230a54..6c246b1fa5 100644 --- a/src/main/filterMod.F90 +++ b/src/main/filterMod.F90 @@ -477,7 +477,7 @@ subroutine setFiltersOneGroup(bounds, this_filter, include_inactive, glc_behavio fl = 0 fnl = 0 do p = bounds%begp,bounds%endp - if (patch%active(p) .or. include_inactive) then + if ((patch%active(p) .or. include_inactive) .and. .not. patch%is_fates(p)) then if (patch%itype(p) >= npcropmin) then !skips 2 generic crop types fl = fl + 1 this_filter(nc)%pcropp(fl) = p diff --git a/src/soilbiogeochem/SoilBiogeochemCarbonStateType.F90 b/src/soilbiogeochem/SoilBiogeochemCarbonStateType.F90 index 241d7eeb25..1f3b00f6e8 100644 --- a/src/soilbiogeochem/SoilBiogeochemCarbonStateType.F90 +++ b/src/soilbiogeochem/SoilBiogeochemCarbonStateType.F90 @@ -931,7 +931,7 @@ subroutine SetValues ( this, num_column, filter_column, value_column) end subroutine SetValues !----------------------------------------------------------------------- - subroutine Summary(this, bounds, num_allc, filter_allc, cnveg_carbonstate_inst) + subroutine Summary(this, bounds, num_allc, filter_allc, num_bgc_soilc, filter_bgc_soilc,cnveg_carbonstate_inst) ! ! !DESCRIPTION: ! Perform column-level carbon summary calculations @@ -941,6 +941,8 @@ subroutine Summary(this, bounds, num_allc, filter_allc, cnveg_carbonstate_inst) type(bounds_type) , intent(in) :: bounds integer , intent(in) :: num_allc ! number of columns in soil filter integer , intent(in) :: filter_allc(:) ! filter for all active columns + integer , intent(in) :: num_bgc_soilc ! number of columns in soil filter + integer , intent(in) :: filter_bgc_soilc(:) ! filter for all active columns type(cnveg_carbonstate_type) , intent(inout) :: cnveg_carbonstate_inst ! @@ -1081,8 +1083,8 @@ subroutine Summary(this, bounds, num_allc, filter_allc, cnveg_carbonstate_inst) end do do l = 1, ndecomp_pools if ( decomp_cascade_con%is_microbe(l) ) then - do fc = 1,num_allc - c = filter_allc(fc) + do fc = 1,num_bgc_soilc + c = filter_bgc_soilc(fc) this%totmicc_col(c) = this%totmicc_col(c) + this%decomp_cpools_col(c,l) end do endif @@ -1123,6 +1125,13 @@ subroutine Summary(this, bounds, num_allc, filter_allc, cnveg_carbonstate_inst) ! coarse woody debris carbon this%cwdc_col(c) = 0._r8 + this%totecosysc_col(c) = 0._r8 + this%totc_col(c) = 0._r8 + + end do + + do fc = 1,num_bgc_soilc + c = filter_bgc_soilc(fc) if(col%is_fates(c)) then totvegc_col = 0._r8 diff --git a/src/soilbiogeochem/SoilBiogeochemNitrogenStateType.F90 b/src/soilbiogeochem/SoilBiogeochemNitrogenStateType.F90 index b537d0896e..ac57ad20b7 100644 --- a/src/soilbiogeochem/SoilBiogeochemNitrogenStateType.F90 +++ b/src/soilbiogeochem/SoilBiogeochemNitrogenStateType.F90 @@ -805,7 +805,7 @@ end subroutine SetValues !----------------------------------------------------------------------- - subroutine Summary(this, bounds, num_allc, filter_allc, cnveg_nitrogenstate_inst) + subroutine Summary(this, bounds, num_allc, filter_allc, num_bgc_soilc, filter_bgc_soilc, cnveg_nitrogenstate_inst) ! ! !ARGUMENTS: @@ -813,6 +813,8 @@ subroutine Summary(this, bounds, num_allc, filter_allc, cnveg_nitrogenstate_inst type(bounds_type) , intent(in) :: bounds integer , intent(in) :: num_allc ! number of bgc columns in soilc filter integer , intent(in) :: filter_allc(:) ! filter for bgc columns + integer , intent(in) :: num_bgc_soilc ! number of bgc columns in soilc filter + integer , intent(in) :: filter_bgc_soilc(:) ! filter for bgc columns type(cnveg_nitrogenstate_type) , intent(inout) :: cnveg_nitrogenstate_inst ! @@ -1029,6 +1031,12 @@ subroutine Summary(this, bounds, num_allc, filter_allc, cnveg_nitrogenstate_inst do fc = 1,num_allc c = filter_allc(fc) this%cwdn_col(c) = 0._r8 + this%totecosysn_col(c) = 0._r8 + this%totn_col(c) = 0._r8 + end do + + do fc = 1,num_bgc_soilc + c = filter_bgc_soilc(fc) if(col%is_fates(c)) then totvegn_col = 0._r8 From 0676ac2ae11ea910cab5cdae075d4c119493ef26 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Wed, 14 Jun 2023 11:11:32 -0600 Subject: [PATCH 073/257] various fixes for fates bgc --- src/biogeochem/CNCIsoFluxMod.F90 | 325 ++++++++++++++---------------- src/biogeochem/CNPhenologyMod.F90 | 172 ++++++++-------- src/main/controlMod.F90 | 2 +- src/main/filterMod.F90 | 4 +- 4 files changed, 235 insertions(+), 268 deletions(-) diff --git a/src/biogeochem/CNCIsoFluxMod.F90 b/src/biogeochem/CNCIsoFluxMod.F90 index a4706442fa..c10659a945 100644 --- a/src/biogeochem/CNCIsoFluxMod.F90 +++ b/src/biogeochem/CNCIsoFluxMod.F90 @@ -8,7 +8,7 @@ module CNCIsoFluxMod use shr_kind_mod , only : r8 => shr_kind_r8 use shr_log_mod , only : errMsg => shr_log_errMsg use clm_varpar , only : ndecomp_cascade_transitions, nlevdecomp, ndecomp_pools - use clm_varpar , only : max_patch_per_col, maxsoil_patches + use clm_varpar , only : maxsoil_patches use clm_varpar , only : i_litr_min, i_litr_max, i_met_lit use abortutils , only : endrun use pftconMod , only : pftcon @@ -535,7 +535,7 @@ subroutine CIsoFlux1(num_soilc, filter_soilc, num_soilp, filter_soilp, & ! For later clean-up, it would be possible to generalize this function to operate on a single ! patch-to-column flux. - call CNCIsoLitterToColumn(num_soilc, filter_soilc, soilbiogeochem_state_inst, iso_cnveg_carbonflux_inst) + call CNCIsoLitterToColumn(num_soilp, filter_soilp, soilbiogeochem_state_inst, iso_cnveg_carbonflux_inst) ! column-level non-mortality fluxes @@ -713,7 +713,7 @@ subroutine CIsoFlux2(num_soilc, filter_soilc, num_soilp , filter_soilp, & ! call routine to shift patch-level gap mortality fluxes to column , for isotopes ! the non-isotope version of this routine is in CNGapMortalityMod.F90. - call CNCIsoGapPftToColumn(num_soilc, filter_soilc, soilbiogeochem_state_inst, iso_cnveg_carbonflux_inst) + call CNCIsoGapPftToColumn(num_soilp, filter_soilp, soilbiogeochem_state_inst, iso_cnveg_carbonflux_inst) end associate @@ -1041,7 +1041,7 @@ subroutine CIsoFlux3(num_soilc , filter_soilc, num_soilp , filter_soilp, & character(len=*) , intent(in) :: isotope ! 'c13' or 'c14' ! ! !LOCAL VARIABLES: - integer :: pi,pp,l,fc,cc,j,i + integer :: pi,pp,l,fp,cc,j,i,fc !----------------------------------------------------------------------- associate( & @@ -1276,26 +1276,21 @@ subroutine CIsoFlux3(num_soilc , filter_soilc, num_soilp , filter_soilp, & ! calculate the column-level flux of deadstem and deadcrootc to cwdc as the result of fire mortality. - do pi = 1,max_patch_per_col - do fc = 1,num_soilc - cc = filter_soilc(fc) - if ( pi <= col%npatches(cc) ) then - pp = col%patchi(cc) + pi - 1 - if (patch%active(pp)) then - do j = 1, nlevdecomp - iso_cnveg_cf%fire_mortality_c_to_cwdc_col(cc,j) = & - iso_cnveg_cf%fire_mortality_c_to_cwdc_col(cc,j) + & - (iso_cnveg_cf%m_deadstemc_to_litter_fire_patch(pp) + & - iso_cnveg_cf%m_livestemc_to_litter_fire_patch(pp)) * & - patch%wtcol(pp) * stem_prof(pp,j) - iso_cnveg_cf%fire_mortality_c_to_cwdc_col(cc,j) = & - iso_cnveg_cf%fire_mortality_c_to_cwdc_col(cc,j) + & - (iso_cnveg_cf%m_deadcrootc_to_litter_fire_patch(pp) + & - iso_cnveg_cf%m_livecrootc_to_litter_fire_patch(pp)) * & - patch%wtcol(pp) * croot_prof(pp,j) - end do - end if - end if + + do fp = 1,num_soilp + pp = filter_soilp(fp) + cc = patch%column(pp) + do j = 1, nlevdecomp + iso_cnveg_cf%fire_mortality_c_to_cwdc_col(cc,j) = & + iso_cnveg_cf%fire_mortality_c_to_cwdc_col(cc,j) + & + (iso_cnveg_cf%m_deadstemc_to_litter_fire_patch(pp) + & + iso_cnveg_cf%m_livestemc_to_litter_fire_patch(pp)) * & + patch%wtcol(pp) * stem_prof(pp,j) + iso_cnveg_cf%fire_mortality_c_to_cwdc_col(cc,j) = & + iso_cnveg_cf%fire_mortality_c_to_cwdc_col(cc,j) + & + (iso_cnveg_cf%m_deadcrootc_to_litter_fire_patch(pp) + & + iso_cnveg_cf%m_livecrootc_to_litter_fire_patch(pp)) * & + patch%wtcol(pp) * croot_prof(pp,j) end do end do @@ -1316,54 +1311,47 @@ subroutine CIsoFlux3(num_soilc , filter_soilc, num_soilp , filter_soilp, & end do end do - - do pi = 1,max_patch_per_col - do fc = 1,num_soilc - cc = filter_soilc(fc) - if ( pi <= col%npatches(cc) ) then - pp = col%patchi(cc) + pi - 1 - if (patch%active(pp)) then - do j = 1, nlevdecomp - iso_cnveg_cf%m_c_to_litr_fire_col(cc,j,i_met_lit) = & - iso_cnveg_cf%m_c_to_litr_fire_col(cc,j,i_met_lit) + & - ((iso_cnveg_cf%m_leafc_to_litter_fire_patch(pp) * lf_f(ivt(pp),i_met_lit) & - +iso_cnveg_cf%m_leafc_storage_to_litter_fire_patch(pp) + & - iso_cnveg_cf%m_leafc_xfer_to_litter_fire_patch(pp) + & - iso_cnveg_cf%m_gresp_storage_to_litter_fire_patch(pp) & - +iso_cnveg_cf%m_gresp_xfer_to_litter_fire_patch(pp))*leaf_prof(pp,j) + & - (iso_cnveg_cf%m_frootc_to_litter_fire_patch(pp) * fr_f(ivt(pp),i_met_lit) & - +iso_cnveg_cf%m_frootc_storage_to_litter_fire_patch(pp) + & - iso_cnveg_cf%m_frootc_xfer_to_litter_fire_patch(pp))*froot_prof(pp,j) & - +(iso_cnveg_cf%m_livestemc_storage_to_litter_fire_patch(pp) + & - iso_cnveg_cf%m_livestemc_xfer_to_litter_fire_patch(pp) & - +iso_cnveg_cf%m_deadstemc_storage_to_litter_fire_patch(pp) + & - iso_cnveg_cf%m_deadstemc_xfer_to_litter_fire_patch(pp))* stem_prof(pp,j)& - +(iso_cnveg_cf%m_livecrootc_storage_to_litter_fire_patch(pp) + & - iso_cnveg_cf%m_livecrootc_xfer_to_litter_fire_patch(pp) & - +iso_cnveg_cf%m_deadcrootc_storage_to_litter_fire_patch(pp) + & - iso_cnveg_cf%m_deadcrootc_xfer_to_litter_fire_patch(pp))* croot_prof(pp,j)) * patch%wtcol(pp) - - ! Here metabolic litter is treated differently than other - ! types of litter, so it remains outside this litter loop, - ! in the line above - do i = i_met_lit+1, i_litr_max - iso_cnveg_cf%m_c_to_litr_fire_col(cc,j,i) = & - iso_cnveg_cf%m_c_to_litr_fire_col(cc,j,i) + & - (iso_cnveg_cf%m_leafc_to_litter_fire_patch(pp) * lf_f(ivt(pp),i) * leaf_prof(pp,j) + & - iso_cnveg_cf%m_frootc_to_litter_fire_patch(pp) * fr_f(ivt(pp),i) * froot_prof(pp,j)) * patch%wtcol(pp) - end do - end do - end if - end if + do fp = 1,num_soilp + pp = filter_soilp(fp) + cc = patch%column(pp) + do j = 1, nlevdecomp + iso_cnveg_cf%m_c_to_litr_fire_col(cc,j,i_met_lit) = & + iso_cnveg_cf%m_c_to_litr_fire_col(cc,j,i_met_lit) + & + ((iso_cnveg_cf%m_leafc_to_litter_fire_patch(pp) * lf_f(ivt(pp),i_met_lit) & + +iso_cnveg_cf%m_leafc_storage_to_litter_fire_patch(pp) + & + iso_cnveg_cf%m_leafc_xfer_to_litter_fire_patch(pp) + & + iso_cnveg_cf%m_gresp_storage_to_litter_fire_patch(pp) & + +iso_cnveg_cf%m_gresp_xfer_to_litter_fire_patch(pp))*leaf_prof(pp,j) + & + (iso_cnveg_cf%m_frootc_to_litter_fire_patch(pp) * fr_f(ivt(pp),i_met_lit) & + +iso_cnveg_cf%m_frootc_storage_to_litter_fire_patch(pp) + & + iso_cnveg_cf%m_frootc_xfer_to_litter_fire_patch(pp))*froot_prof(pp,j) & + +(iso_cnveg_cf%m_livestemc_storage_to_litter_fire_patch(pp) + & + iso_cnveg_cf%m_livestemc_xfer_to_litter_fire_patch(pp) & + +iso_cnveg_cf%m_deadstemc_storage_to_litter_fire_patch(pp) + & + iso_cnveg_cf%m_deadstemc_xfer_to_litter_fire_patch(pp))* stem_prof(pp,j)& + +(iso_cnveg_cf%m_livecrootc_storage_to_litter_fire_patch(pp) + & + iso_cnveg_cf%m_livecrootc_xfer_to_litter_fire_patch(pp) & + +iso_cnveg_cf%m_deadcrootc_storage_to_litter_fire_patch(pp) + & + iso_cnveg_cf%m_deadcrootc_xfer_to_litter_fire_patch(pp))* croot_prof(pp,j)) * patch%wtcol(pp) + + ! Here metabolic litter is treated differently than other + ! types of litter, so it remains outside this litter loop, + ! in the line above + do i = i_met_lit+1, i_litr_max + iso_cnveg_cf%m_c_to_litr_fire_col(cc,j,i) = & + iso_cnveg_cf%m_c_to_litr_fire_col(cc,j,i) + & + (iso_cnveg_cf%m_leafc_to_litter_fire_patch(pp) * lf_f(ivt(pp),i) * leaf_prof(pp,j) + & + iso_cnveg_cf%m_frootc_to_litter_fire_patch(pp) * fr_f(ivt(pp),i) * froot_prof(pp,j)) * patch%wtcol(pp) + end do end do - end do + end do end associate end subroutine CIsoFlux3 !----------------------------------------------------------------------- - subroutine CNCIsoLitterToColumn (num_soilc, filter_soilc, & + subroutine CNCIsoLitterToColumn (num_soilp, filter_soilp, & soilbiogeochem_state_inst, iso_cnveg_carbonflux_inst) ! ! !DESCRIPTION: @@ -1377,13 +1365,13 @@ subroutine CNCIsoLitterToColumn (num_soilc, filter_soilc, & !DML ! !ARGUMENTS: - integer , intent(in) :: num_soilc ! number of soil columns in filter - integer , intent(in) :: filter_soilc(:) ! filter for soil columns + integer , intent(in) :: num_soilp ! number of soil patches in filter + integer , intent(in) :: filter_soilp(:) ! filter for soil patches type(soilbiogeochem_state_type) , intent(in) :: soilbiogeochem_state_inst type(cnveg_carbonflux_type) , intent(inout) :: iso_cnveg_carbonflux_inst ! ! !LOCAL VARIABLES: - integer :: fc,c,pi,p,k,j,i + integer :: c,pi,p,k,j,i,fp !----------------------------------------------------------------------- associate( & @@ -1405,59 +1393,52 @@ subroutine CNCIsoLitterToColumn (num_soilc, filter_soilc, & ) do j = 1, nlevdecomp - do pi = 1,max_patch_per_col - do fc = 1,num_soilc - c = filter_soilc(fc) - - if ( pi <= col%npatches(c) ) then - p = col%patchi(c) + pi - 1 - if (patch%active(p)) then - do i = i_litr_min, i_litr_max - phenology_c_to_litr_c(c,j,i) = & - phenology_c_to_litr_c(c,j,i) + & - ! leaf litter carbon fluxes - leafc_to_litter(p) * lf_f(ivt(p),i) * wtcol(p) * leaf_prof(p,j) + & - ! fine root litter carbon fluxes - frootc_to_litter(p) * fr_f(ivt(p),i) * wtcol(p) * froot_prof(p,j) - end do + do fp = 1,num_soilp + p = filter_soilp(fp) + c = patch%column(p) + + do i = i_litr_min, i_litr_max + phenology_c_to_litr_c(c,j,i) = & + phenology_c_to_litr_c(c,j,i) + & + ! leaf litter carbon fluxes + leafc_to_litter(p) * lf_f(ivt(p),i) * wtcol(p) * leaf_prof(p,j) + & + ! fine root litter carbon fluxes + frootc_to_litter(p) * fr_f(ivt(p),i) * wtcol(p) * froot_prof(p,j) + end do + !DML - if (ivt(p) >= npcropmin) then ! add livestemc to litter - ! stem litter carbon fluxes - do i = i_litr_min, i_litr_max - phenology_c_to_litr_c(c,j,i) = & - phenology_c_to_litr_c(c,j,i) + & - livestemc_to_litter(p) * lf_f(ivt(p),i) * wtcol(p) * leaf_prof(p,j) - end do - - if (.not. use_grainproduct) then - ! grain litter carbon fluxes - do i = i_litr_min, i_litr_max - do k = repr_grain_min, repr_grain_max - phenology_c_to_litr_c(c,j,i) = & - phenology_c_to_litr_c(c,j,i) + & - repr_grainc_to_food(p,k) * lf_f(ivt(p),i) * wtcol(p) * leaf_prof(p,j) - end do - end do - end if - - ! reproductive structure litter carbon fluxes - do i = i_litr_min, i_litr_max - do k = repr_structure_min, repr_structure_max - phenology_c_to_litr_c(c,j,i) = & - phenology_c_to_litr_c(c,j,i) + & - repr_structurec_to_litter(p,k) * lf_f(ivt(p),i) * wtcol(p) * leaf_prof(p,j) - end do - end do - - end if -!DML - end if + if (ivt(p) >= npcropmin) then ! add livestemc to litter + ! stem litter carbon fluxes + do i = i_litr_min, i_litr_max + phenology_c_to_litr_c(c,j,i) = & + phenology_c_to_litr_c(c,j,i) + & + livestemc_to_litter(p) * lf_f(ivt(p),i) * wtcol(p) * leaf_prof(p,j) + end do + + if (.not. use_grainproduct) then + ! grain litter carbon fluxes + do i = i_litr_min, i_litr_max + do k = repr_grain_min, repr_grain_max + phenology_c_to_litr_c(c,j,i) = & + phenology_c_to_litr_c(c,j,i) + & + repr_grainc_to_food(p,k) * lf_f(ivt(p),i) * wtcol(p) * leaf_prof(p,j) + end do + end do end if - - end do + + ! reproductive structure litter carbon fluxes + do i = i_litr_min, i_litr_max + do k = repr_structure_min, repr_structure_max + phenology_c_to_litr_c(c,j,i) = & + phenology_c_to_litr_c(c,j,i) + & + repr_structurec_to_litter(p,k) * lf_f(ivt(p),i) * wtcol(p) * leaf_prof(p,j) + end do + end do + + end if + !DML end do - end do end associate @@ -1465,7 +1446,7 @@ subroutine CNCIsoLitterToColumn (num_soilc, filter_soilc, & end subroutine CNCIsoLitterToColumn !----------------------------------------------------------------------- - subroutine CNCIsoGapPftToColumn (num_soilc, filter_soilc, & + subroutine CNCIsoGapPftToColumn (num_soilp, filter_soilp, & soilbiogeochem_state_inst, iso_cnveg_carbonflux_inst) ! ! !DESCRIPTION: @@ -1473,13 +1454,13 @@ subroutine CNCIsoGapPftToColumn (num_soilc, filter_soilc, & ! to the column level and assign them to the three litter pools (+ cwd pool) ! ! !ARGUMENTS: - integer , intent(in) :: num_soilc ! number of soil columns in filter - integer , intent(in) :: filter_soilc(:) ! soil column filter + integer , intent(in) :: num_soilp ! number of soil patches in filter + integer , intent(in) :: filter_soilp(:) ! soil patch filter type(soilbiogeochem_state_type) , intent(in) :: soilbiogeochem_state_inst type(cnveg_carbonflux_type) , intent(inout) :: iso_cnveg_carbonflux_inst ! ! !LOCAL VARIABLES: - integer :: fc,c,pi,p,j,i ! indices + integer :: fp,c,pi,p,j,i ! indices !----------------------------------------------------------------------- associate( & @@ -1520,66 +1501,58 @@ subroutine CNCIsoGapPftToColumn (num_soilc, filter_soilc, & ) do j = 1, nlevdecomp - do pi = 1,maxsoil_patches - do fc = 1,num_soilc - c = filter_soilc(fc) - - if (pi <= col%npatches(c)) then - p = col%patchi(c) + pi - 1 - - if (patch%active(p)) then - - do i = i_litr_min, i_litr_max - ! leaf gap mortality carbon fluxes - gap_mortality_c_to_litr_c(c,j,i) = & - gap_mortality_c_to_litr_c(c,j,i) + & - m_leafc_to_litter(p) * lf_f(ivt(p),i) * wtcol(p) * leaf_prof(p,j) - ! fine root gap mortality carbon fluxes - gap_mortality_c_to_litr_c(c,j,i) = & - gap_mortality_c_to_litr_c(c,j,i) + & - m_frootc_to_litter(p) * fr_f(ivt(p),i) * wtcol(p) * froot_prof(p,j) - end do - - ! wood gap mortality carbon fluxes - gap_mortality_c_to_cwdc(c,j) = gap_mortality_c_to_cwdc(c,j) + & - m_livestemc_to_litter(p) * wtcol(p) * stem_prof(p,j) - gap_mortality_c_to_cwdc(c,j) = gap_mortality_c_to_cwdc(c,j) + & - m_deadstemc_to_litter(p) * wtcol(p) * stem_prof(p,j) - gap_mortality_c_to_cwdc(c,j) = gap_mortality_c_to_cwdc(c,j) + & - m_livecrootc_to_litter(p) * wtcol(p) * croot_prof(p,j) - gap_mortality_c_to_cwdc(c,j) = gap_mortality_c_to_cwdc(c,j) + & - m_deadcrootc_to_litter(p) * wtcol(p) * croot_prof(p,j) - - ! Metabolic litter is treated differently than other types - ! of litter, so it gets this additional line after the - ! most recent loop over all litter types - gap_mortality_c_to_litr_c(c,j,i_met_lit) = & - gap_mortality_c_to_litr_c(c,j,i_met_lit) + & - ! storage gap mortality carbon fluxes - m_leafc_storage_to_litter(p) * wtcol(p) * leaf_prof(p,j) + & - m_frootc_storage_to_litter(p) * wtcol(p) * froot_prof(p,j) + & - m_livestemc_storage_to_litter(p) * wtcol(p) * stem_prof(p,j) + & - m_deadstemc_storage_to_litter(p) * wtcol(p) * stem_prof(p,j) + & - m_livecrootc_storage_to_litter(p) * wtcol(p) * croot_prof(p,j) + & - m_deadcrootc_storage_to_litter(p) * wtcol(p) * croot_prof(p,j) + & - m_gresp_storage_to_litter(p) * wtcol(p) * leaf_prof(p,j) + & - ! transfer gap mortality carbon fluxes - m_leafc_xfer_to_litter(p) * wtcol(p) * leaf_prof(p,j) + & - m_frootc_xfer_to_litter(p) * wtcol(p) * froot_prof(p,j) + & - m_livestemc_xfer_to_litter(p) * wtcol(p) * stem_prof(p,j) + & - m_deadstemc_xfer_to_litter(p) * wtcol(p) * stem_prof(p,j) + & - m_livecrootc_xfer_to_litter(p) * wtcol(p) * croot_prof(p,j) + & - m_deadcrootc_xfer_to_litter(p) * wtcol(p) * croot_prof(p,j) + & - m_gresp_xfer_to_litter(p) * wtcol(p) * leaf_prof(p,j) - - end if - end if + do fp = 1,num_soilp + p = filter_soilp(fp) + c = patch%column(p) + + do i = i_litr_min, i_litr_max + ! leaf gap mortality carbon fluxes + gap_mortality_c_to_litr_c(c,j,i) = & + gap_mortality_c_to_litr_c(c,j,i) + & + m_leafc_to_litter(p) * lf_f(ivt(p),i) * wtcol(p) * leaf_prof(p,j) + ! fine root gap mortality carbon fluxes + gap_mortality_c_to_litr_c(c,j,i) = & + gap_mortality_c_to_litr_c(c,j,i) + & + m_frootc_to_litter(p) * fr_f(ivt(p),i) * wtcol(p) * froot_prof(p,j) end do - + + ! wood gap mortality carbon fluxes + gap_mortality_c_to_cwdc(c,j) = gap_mortality_c_to_cwdc(c,j) + & + m_livestemc_to_litter(p) * wtcol(p) * stem_prof(p,j) + gap_mortality_c_to_cwdc(c,j) = gap_mortality_c_to_cwdc(c,j) + & + m_deadstemc_to_litter(p) * wtcol(p) * stem_prof(p,j) + gap_mortality_c_to_cwdc(c,j) = gap_mortality_c_to_cwdc(c,j) + & + m_livecrootc_to_litter(p) * wtcol(p) * croot_prof(p,j) + gap_mortality_c_to_cwdc(c,j) = gap_mortality_c_to_cwdc(c,j) + & + m_deadcrootc_to_litter(p) * wtcol(p) * croot_prof(p,j) + + ! Metabolic litter is treated differently than other types + ! of litter, so it gets this additional line after the + ! most recent loop over all litter types + gap_mortality_c_to_litr_c(c,j,i_met_lit) = & + gap_mortality_c_to_litr_c(c,j,i_met_lit) + & + ! storage gap mortality carbon fluxes + m_leafc_storage_to_litter(p) * wtcol(p) * leaf_prof(p,j) + & + m_frootc_storage_to_litter(p) * wtcol(p) * froot_prof(p,j) + & + m_livestemc_storage_to_litter(p) * wtcol(p) * stem_prof(p,j) + & + m_deadstemc_storage_to_litter(p) * wtcol(p) * stem_prof(p,j) + & + m_livecrootc_storage_to_litter(p) * wtcol(p) * croot_prof(p,j) + & + m_deadcrootc_storage_to_litter(p) * wtcol(p) * croot_prof(p,j) + & + m_gresp_storage_to_litter(p) * wtcol(p) * leaf_prof(p,j) + & + ! transfer gap mortality carbon fluxes + m_leafc_xfer_to_litter(p) * wtcol(p) * leaf_prof(p,j) + & + m_frootc_xfer_to_litter(p) * wtcol(p) * froot_prof(p,j) + & + m_livestemc_xfer_to_litter(p) * wtcol(p) * stem_prof(p,j) + & + m_deadstemc_xfer_to_litter(p) * wtcol(p) * stem_prof(p,j) + & + m_livecrootc_xfer_to_litter(p) * wtcol(p) * croot_prof(p,j) + & + m_deadcrootc_xfer_to_litter(p) * wtcol(p) * croot_prof(p,j) + & + m_gresp_xfer_to_litter(p) * wtcol(p) * leaf_prof(p,j) + end do end do + end associate end subroutine CNCIsoGapPftToColumn diff --git a/src/biogeochem/CNPhenologyMod.F90 b/src/biogeochem/CNPhenologyMod.F90 index ec04fcbf54..b8bc707291 100644 --- a/src/biogeochem/CNPhenologyMod.F90 +++ b/src/biogeochem/CNPhenologyMod.F90 @@ -406,7 +406,7 @@ subroutine CNPhenology (bounds, num_soilc, filter_soilc, num_soilp, & ! gather all patch-level litterfall fluxes to the column for litter C and N inputs - call CNLitterToColumn(bounds, num_soilc, filter_soilc, & + call CNLitterToColumn(bounds, num_soilp, filter_soilp, & cnveg_state_inst, cnveg_carbonflux_inst, cnveg_nitrogenflux_inst, & leaf_prof_patch(bounds%begp:bounds%endp,1:nlevdecomp_full), & froot_prof_patch(bounds%begp:bounds%endp,1:nlevdecomp_full)) @@ -3383,7 +3383,7 @@ subroutine CNCropHarvestToProductPools(bounds, num_soilp, filter_soilp, num_soil end subroutine CNCropHarvestToProductPools !----------------------------------------------------------------------- - subroutine CNLitterToColumn (bounds, num_soilc, filter_soilc, & + subroutine CNLitterToColumn (bounds, num_bgc_vegp, filter_bgc_vegp, & cnveg_state_inst,cnveg_carbonflux_inst, cnveg_nitrogenflux_inst, & leaf_prof_patch, froot_prof_patch) ! @@ -3392,14 +3392,14 @@ subroutine CNLitterToColumn (bounds, num_soilc, filter_soilc, & ! to the column level and assign them to the three litter pools ! ! !USES: - use clm_varpar , only : max_patch_per_col, nlevdecomp + use clm_varpar , only : nlevdecomp use pftconMod , only : npcropmin use clm_varctl , only : use_grainproduct ! ! !ARGUMENTS: type(bounds_type) , intent(in) :: bounds - integer , intent(in) :: num_soilc ! number of soil columns in filter - integer , intent(in) :: filter_soilc(:) ! filter for soil columns + integer , intent(in) :: num_bgc_vegp ! number of bgc veg patches + integer , intent(in) :: filter_bgc_vegp(:) ! filter for bgc veg patches type(cnveg_state_type) , intent(in) :: cnveg_state_inst type(cnveg_carbonflux_type) , intent(inout) :: cnveg_carbonflux_inst type(cnveg_nitrogenflux_type) , intent(inout) :: cnveg_nitrogenflux_inst @@ -3407,7 +3407,7 @@ subroutine CNLitterToColumn (bounds, num_soilc, filter_soilc, & real(r8) , intent(in) :: froot_prof_patch(bounds%begp:,1:) ! ! !LOCAL VARIABLES: - integer :: fc,c,pi,p,k,j,i ! indices + integer :: fp,c,pi,p,k,j,i ! indices !----------------------------------------------------------------------- SHR_ASSERT_ALL_FL((ubound(leaf_prof_patch) == (/bounds%endp,nlevdecomp_full/)), sourcefile, __LINE__) @@ -3437,96 +3437,88 @@ subroutine CNLitterToColumn (bounds, num_soilc, filter_soilc, & frootn_to_litter => cnveg_nitrogenflux_inst%frootn_to_litter_patch , & ! Input: [real(r8) (:) ] fine root N litterfall (gN/m2/s) phenology_n_to_litr_n => cnveg_nitrogenflux_inst%phenology_n_to_litr_n_col & ! Output: [real(r8) (:,:,:) ] N fluxes associated with phenology (litterfall and crop) to litter pools (gN/m3/s) ) - - do j = 1, nlevdecomp - do pi = 1,max_patch_per_col - do fc = 1,num_soilc - c = filter_soilc(fc) + + do_nlev: do j = 1, nlevdecomp - if ( pi <= col%npatches(c) ) then - p = col%patchi(c) + pi - 1 - if (patch%active(p)) then + do_vegp: do fp = 1,num_bgc_vegp + p = filter_bgc_vegp(fp) + c = patch%column(p) - do i = i_litr_min, i_litr_max - ! leaf litter carbon fluxes - phenology_c_to_litr_c(c,j,i) = & - phenology_c_to_litr_c(c,j,i) + & - leafc_to_litter(p) * lf_f(ivt(p),i) * wtcol(p) * leaf_prof(p,j) - - ! leaf litter nitrogen fluxes - phenology_n_to_litr_n(c,j,i) = & - phenology_n_to_litr_n(c,j,i) + & - leafn_to_litter(p) * lf_f(ivt(p),i) * wtcol(p) * leaf_prof(p,j) - - ! fine root litter carbon fluxes + do_ilit: do i = i_litr_min, i_litr_max + ! leaf litter carbon fluxes + phenology_c_to_litr_c(c,j,i) = & + phenology_c_to_litr_c(c,j,i) + & + leafc_to_litter(p) * lf_f(ivt(p),i) * wtcol(p) * leaf_prof(p,j) + + ! leaf litter nitrogen fluxes + phenology_n_to_litr_n(c,j,i) = & + phenology_n_to_litr_n(c,j,i) + & + leafn_to_litter(p) * lf_f(ivt(p),i) * wtcol(p) * leaf_prof(p,j) + + ! fine root litter carbon fluxes + phenology_c_to_litr_c(c,j,i) = & + phenology_c_to_litr_c(c,j,i) + & + frootc_to_litter(p) * fr_f(ivt(p),i) * wtcol(p) * froot_prof(p,j) + + ! fine root litter nitrogen fluxes + phenology_n_to_litr_n(c,j,i) = & + phenology_n_to_litr_n(c,j,i) + & + frootn_to_litter(p) * fr_f(ivt(p),i) * wtcol(p) * froot_prof(p,j) + end do do_ilit + + ! agroibis puts crop stem litter together with leaf litter + ! so I've used the leaf lf_f* parameters instead of making + ! new ones for now (slevis) + ! also for simplicity I've put "food" into the litter pools + + if (ivt(p) >= npcropmin) then ! add livestemc to litter + do i = i_litr_min, i_litr_max + ! stem litter carbon fluxes + phenology_c_to_litr_c(c,j,i) = & + phenology_c_to_litr_c(c,j,i) + & + livestemc_to_litter(p) * lf_f(ivt(p),i) * wtcol(p) * leaf_prof(p,j) + + ! stem litter nitrogen fluxes + phenology_n_to_litr_n(c,j,i) = & + phenology_n_to_litr_n(c,j,i) + & + livestemn_to_litter(p) * lf_f(ivt(p),i) * wtcol(p) * leaf_prof(p,j) + end do + + if (.not. use_grainproduct) then + do i = i_litr_min, i_litr_max + do k = repr_grain_min, repr_grain_max + ! grain litter carbon fluxes phenology_c_to_litr_c(c,j,i) = & - phenology_c_to_litr_c(c,j,i) + & - frootc_to_litter(p) * fr_f(ivt(p),i) * wtcol(p) * froot_prof(p,j) - - ! fine root litter nitrogen fluxes + phenology_c_to_litr_c(c,j,i) + & + repr_grainc_to_food(p,k) * lf_f(ivt(p),i) * wtcol(p) * leaf_prof(p,j) + + ! grain litter nitrogen fluxes phenology_n_to_litr_n(c,j,i) = & - phenology_n_to_litr_n(c,j,i) + & - frootn_to_litter(p) * fr_f(ivt(p),i) * wtcol(p) * froot_prof(p,j) + phenology_n_to_litr_n(c,j,i) + & + repr_grainn_to_food(p,k) * lf_f(ivt(p),i) * wtcol(p) * leaf_prof(p,j) end do - - ! agroibis puts crop stem litter together with leaf litter - ! so I've used the leaf lf_f* parameters instead of making - ! new ones for now (slevis) - ! also for simplicity I've put "food" into the litter pools - - if (ivt(p) >= npcropmin) then ! add livestemc to litter - do i = i_litr_min, i_litr_max - ! stem litter carbon fluxes - phenology_c_to_litr_c(c,j,i) = & - phenology_c_to_litr_c(c,j,i) + & - livestemc_to_litter(p) * lf_f(ivt(p),i) * wtcol(p) * leaf_prof(p,j) - - ! stem litter nitrogen fluxes - phenology_n_to_litr_n(c,j,i) = & - phenology_n_to_litr_n(c,j,i) + & - livestemn_to_litter(p) * lf_f(ivt(p),i) * wtcol(p) * leaf_prof(p,j) - end do - - if (.not. use_grainproduct) then - do i = i_litr_min, i_litr_max - do k = repr_grain_min, repr_grain_max - ! grain litter carbon fluxes - phenology_c_to_litr_c(c,j,i) = & - phenology_c_to_litr_c(c,j,i) + & - repr_grainc_to_food(p,k) * lf_f(ivt(p),i) * wtcol(p) * leaf_prof(p,j) - - ! grain litter nitrogen fluxes - phenology_n_to_litr_n(c,j,i) = & - phenology_n_to_litr_n(c,j,i) + & - repr_grainn_to_food(p,k) * lf_f(ivt(p),i) * wtcol(p) * leaf_prof(p,j) - end do - end do - end if - - do i = i_litr_min, i_litr_max - do k = repr_structure_min, repr_structure_max - ! reproductive structure litter carbon fluxes - phenology_c_to_litr_c(c,j,i) = & - phenology_c_to_litr_c(c,j,i) + & - repr_structurec_to_litter(p,k) * lf_f(ivt(p),i) * wtcol(p) * leaf_prof(p,j) - - ! reproductive structure litter nitrogen fluxes - phenology_n_to_litr_n(c,j,i) = & - phenology_n_to_litr_n(c,j,i) + & - repr_structuren_to_litter(p,k) * lf_f(ivt(p),i) * wtcol(p) * leaf_prof(p,j) - end do - end do - end if - end if + end do end if - - end do - - end do - end do - - end associate - + + do i = i_litr_min, i_litr_max + do k = repr_structure_min, repr_structure_max + ! reproductive structure litter carbon fluxes + phenology_c_to_litr_c(c,j,i) = & + phenology_c_to_litr_c(c,j,i) + & + repr_structurec_to_litter(p,k) * lf_f(ivt(p),i) * wtcol(p) * leaf_prof(p,j) + + ! reproductive structure litter nitrogen fluxes + phenology_n_to_litr_n(c,j,i) = & + phenology_n_to_litr_n(c,j,i) + & + repr_structuren_to_litter(p,k) * lf_f(ivt(p),i) * wtcol(p) * leaf_prof(p,j) + end do + end do + end if + end do do_vegp + end do do_nlev + + end associate + end subroutine CNLitterToColumn end module CNPhenologyMod diff --git a/src/main/controlMod.F90 b/src/main/controlMod.F90 index c793898d5e..8fc2f8b4b2 100644 --- a/src/main/controlMod.F90 +++ b/src/main/controlMod.F90 @@ -439,7 +439,7 @@ subroutine control_init(dtime) use_fates_bgc = .true. end if - if (fates_parteh_mode == 1 .and. suplnitro == suplnNon)then + if (fates_parteh_mode == 1 .and. suplnitro == suplnNon .and. use_fates_bgc )then write(iulog,*) ' When FATES with fates_parteh_mode == 1 (ie carbon only mode),' write(iulog,*) ' you must have supplemental nitrogen turned on, there will be' write(iulog,*) ' no nitrogen dynamics with the plants, and therefore no' diff --git a/src/main/filterMod.F90 b/src/main/filterMod.F90 index 6c246b1fa5..5b39b972fa 100644 --- a/src/main/filterMod.F90 +++ b/src/main/filterMod.F90 @@ -477,7 +477,8 @@ subroutine setFiltersOneGroup(bounds, this_filter, include_inactive, glc_behavio fl = 0 fnl = 0 do p = bounds%begp,bounds%endp - if ((patch%active(p) .or. include_inactive) .and. .not. patch%is_fates(p)) then + if(.not.use_fates)then + if ((patch%active(p) .or. include_inactive)) then if (patch%itype(p) >= npcropmin) then !skips 2 generic crop types fl = fl + 1 this_filter(nc)%pcropp(fl) = p @@ -489,6 +490,7 @@ subroutine setFiltersOneGroup(bounds, this_filter, include_inactive, glc_behavio end if end if end if + end if end do this_filter(nc)%num_pcropp = fl this_filter(nc)%num_soilnopcropp = fnl ! This wasn't being set before... From 180206cda0a8b4ee6d8341c5ce64eb474e179e51 Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Wed, 28 Jun 2023 13:05:11 -0600 Subject: [PATCH 074/257] Removing use_z0mg_2d from the Meier2022_surf_rough testmods --- .../testdefs/testmods_dirs/clm/Meier2022_surf_rough/user_nl_clm | 1 - 1 file changed, 1 deletion(-) diff --git a/cime_config/testdefs/testmods_dirs/clm/Meier2022_surf_rough/user_nl_clm b/cime_config/testdefs/testmods_dirs/clm/Meier2022_surf_rough/user_nl_clm index c885cdacd7..01df79ecba 100644 --- a/cime_config/testdefs/testmods_dirs/clm/Meier2022_surf_rough/user_nl_clm +++ b/cime_config/testdefs/testmods_dirs/clm/Meier2022_surf_rough/user_nl_clm @@ -1,5 +1,4 @@ z0param_method = 'Meier2022' use_z0m_snowmelt = .true. -use_z0mg_2d = .false. paramfile = '$DIN_LOC_ROOT/lnd/clm2/paramdata/ctsm51_params.RMz0.c220304.nc' From f2767b5e4eb2bd7985bd373b93b3b6e8cdd3ceb9 Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Wed, 28 Jun 2023 16:41:42 -0600 Subject: [PATCH 075/257] Follow-up to conflict resolutions in order for the code to build --- src/biogeophys/BareGroundFluxesMod.F90 | 1 - src/biogeophys/CanopyStateType.F90 | 16 ---------------- src/biogeophys/FrictionVelocityMod.F90 | 1 + 3 files changed, 1 insertion(+), 17 deletions(-) diff --git a/src/biogeophys/BareGroundFluxesMod.F90 b/src/biogeophys/BareGroundFluxesMod.F90 index f8bd6d540d..c994d238a4 100644 --- a/src/biogeophys/BareGroundFluxesMod.F90 +++ b/src/biogeophys/BareGroundFluxesMod.F90 @@ -237,7 +237,6 @@ subroutine BareGroundFluxes(bounds, num_noexposedvegp, filter_noexposedvegp, & forc_hgt_u_patch => frictionvel_inst%forc_hgt_u_patch , & ! Output: [real(r8) (:) ] observational height of wind at patch level [m] forc_hgt_t_patch => frictionvel_inst%forc_hgt_t_patch , & ! Output: [real(r8) (:) ] observational height of temperature at patch level [m] forc_hgt_q_patch => frictionvel_inst%forc_hgt_q_patch , & ! Output: [real(r8) (:) ] observational height of specific humidity at patch level [m] - displa => canopystate_inst%displa_patch , & ! Input: [real(r8) (:) ] displacement height (m) u10_clm => frictionvel_inst%u10_clm_patch , & ! Input: [real(r8) (:) ] 10 m height winds (m/s) zetamax => frictionvel_inst%zetamaxstable , & ! Input: [real(r8) ] max zeta value under stable conditions zeta => frictionvel_inst%zeta_patch , & ! Output: [real(r8) (:) ] dimensionless stability parameter diff --git a/src/biogeophys/CanopyStateType.F90 b/src/biogeophys/CanopyStateType.F90 index eb13558092..313f7a83f3 100644 --- a/src/biogeophys/CanopyStateType.F90 +++ b/src/biogeophys/CanopyStateType.F90 @@ -225,22 +225,6 @@ subroutine InitHistory(this, bounds) avgflag='A', long_name='canopy top', & ptr_patch=this%htop_patch) endif - - this%displa_patch(begp:endp) = spval - call hist_addfld1d (fname='DISPLA', units='m', & - avgflag='A', long_name='displacement height', & - ptr_patch=this%displa_patch, default='inactive') - - if(use_fates_sp)then - this%htop_hist_patch(begp:endp) = spval - call hist_addfld1d (fname='HTOP', units='m', & - avgflag='A', long_name='HTOP weights for SP mode', & - ptr_patch=this%htop_hist_patch) - else - this%htop_patch(begp:endp) = spval - call hist_addfld1d (fname='HTOP', units='m', & - avgflag='A', long_name='canopy top', & - ptr_patch=this%htop_patch) endif if(use_fates_sp)then diff --git a/src/biogeophys/FrictionVelocityMod.F90 b/src/biogeophys/FrictionVelocityMod.F90 index 5bf5c0c845..3960b6504d 100644 --- a/src/biogeophys/FrictionVelocityMod.F90 +++ b/src/biogeophys/FrictionVelocityMod.F90 @@ -342,6 +342,7 @@ subroutine InitHistory(this, bounds) call hist_addfld1d (fname='KBM1', units='unitless', & avgflag='A', long_name='natural logarithm of Z0MG_P/Z0HG_P', & ptr_patch=this%kbm1_patch, default='inactive') + end if if (use_luna) then call hist_addfld1d (fname='RB10', units='s/m', & From 868e8c213669e773354294cdd4fe004f2ea3d5dc Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Fri, 30 Jun 2023 09:30:03 -0600 Subject: [PATCH 076/257] reverted call order on readfirenml --- src/main/controlMod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/main/controlMod.F90 b/src/main/controlMod.F90 index 8fc2f8b4b2..c8074eead2 100644 --- a/src/main/controlMod.F90 +++ b/src/main/controlMod.F90 @@ -555,8 +555,8 @@ subroutine control_init(dtime) call soilHydReadNML( NLFilename ) if( use_cn ) then - call CNPrecisionControlReadNML( NLFilename ) call CNFireReadNML( NLFilename ) + call CNPrecisionControlReadNML( NLFilename ) call CNNDynamicsReadNML ( NLFilename ) call CNPhenologyReadNML ( NLFilename ) end if From 080cd5ba055a9338e14db23668ae8644591a88c9 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Fri, 30 Jun 2023 09:35:57 -0600 Subject: [PATCH 077/257] Update default scope of cn_products_type procedures --- src/biogeochem/CNProductsMod.F90 | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/biogeochem/CNProductsMod.F90 b/src/biogeochem/CNProductsMod.F90 index 30dd9f3619..226c5a4bb6 100644 --- a/src/biogeochem/CNProductsMod.F90 +++ b/src/biogeochem/CNProductsMod.F90 @@ -20,6 +20,8 @@ module CNProductsMod ! !PUBLIC TYPES: type, public :: cn_products_type + private ! Default these procedures to private, unless specified otherwise + ! ------------------------------------------------------------------------ ! Public instance variables ! ------------------------------------------------------------------------ From a4e690b1560604d2afae1932697b03d828cc79bc Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Mon, 3 Jul 2023 18:47:11 -0600 Subject: [PATCH 078/257] update to the span of columns that carbon summary variables are calculated, for b4b --- src/biogeochem/CNProductsMod.F90 | 4 +- .../SoilBiogeochemCarbonStateType.F90 | 95 +++++++++++-------- 2 files changed, 59 insertions(+), 40 deletions(-) diff --git a/src/biogeochem/CNProductsMod.F90 b/src/biogeochem/CNProductsMod.F90 index 226c5a4bb6..19ae952c9a 100644 --- a/src/biogeochem/CNProductsMod.F90 +++ b/src/biogeochem/CNProductsMod.F90 @@ -51,9 +51,9 @@ module CNProductsMod real(r8), pointer :: gru_prod100_gain_grc(:) ! (g[C or N]/m2/s) gross unrepresented landcover addition to 100-year wood product pool real(r8), pointer :: gru_woodprod_gain_grc(:) ! (g[C or N]/m2/s) gross unrepresented landcover addition to wood product pools real(r8), pointer :: hrv_deadstem_to_prod10_patch(:) ! (g[C or N]/m2/s) dead stem harvest to 10-year wood product pool - real(r8), pointer :: hrv_deadstem_to_prod10_grc(:) ! (g[C or N]/m2/s) dead stem harvest to 10-year wood product pool + real(r8), pointer,public :: hrv_deadstem_to_prod10_grc(:) ! (g[C or N]/m2/s) dead stem harvest to 10-year wood product pool real(r8), pointer :: hrv_deadstem_to_prod100_patch(:) ! (g[C or N]/m2/s) dead stem harvest to 100-year wood product pool - real(r8), pointer :: hrv_deadstem_to_prod100_grc(:) ! (g[C or N]/m2/s) dead stem harvest to 100-year wood product pool + real(r8), pointer,public :: hrv_deadstem_to_prod100_grc(:) ! (g[C or N]/m2/s) dead stem harvest to 100-year wood product pool real(r8), pointer :: crop_harvest_to_cropprod1_patch(:) ! (g[C or N]/m2/s) crop harvest to 1-year crop product pool real(r8), pointer :: crop_harvest_to_cropprod1_grc(:) ! (g[C or N]/m2/s) crop harvest to 1-year crop product pool diff --git a/src/soilbiogeochem/SoilBiogeochemCarbonStateType.F90 b/src/soilbiogeochem/SoilBiogeochemCarbonStateType.F90 index 1f3b00f6e8..098412a57b 100644 --- a/src/soilbiogeochem/SoilBiogeochemCarbonStateType.F90 +++ b/src/soilbiogeochem/SoilBiogeochemCarbonStateType.F90 @@ -7,7 +7,7 @@ module SoilBiogeochemCarbonStateType use clm_varpar , only : ndecomp_cascade_transitions, ndecomp_pools, nlevcan use clm_varpar , only : nlevdecomp_full, nlevdecomp, nlevsoi use clm_varcon , only : spval, ispval, dzsoi_decomp, zisoi, zsoi, c3_r2 - use clm_varctl , only : iulog, spinup_state + use clm_varctl , only : iulog, spinup_state, use_fates_bgc use landunit_varcon , only : istcrop, istsoil use abortutils , only : endrun use spmdMod , only : masterproc @@ -1083,8 +1083,8 @@ subroutine Summary(this, bounds, num_allc, filter_allc, num_bgc_soilc, filter_bg end do do l = 1, ndecomp_pools if ( decomp_cascade_con%is_microbe(l) ) then - do fc = 1,num_bgc_soilc - c = filter_bgc_soilc(fc) + do fc = 1,num_allc + c = filter_allc(fc) this%totmicc_col(c) = this%totmicc_col(c) + this%decomp_cpools_col(c,l) end do endif @@ -1118,54 +1118,73 @@ subroutine Summary(this, bounds, num_allc, filter_allc, num_bgc_soilc, filter_bg end if end do - - do fc = 1,num_allc c = filter_allc(fc) - ! coarse woody debris carbon this%cwdc_col(c) = 0._r8 - this%totecosysc_col(c) = 0._r8 - this%totc_col(c) = 0._r8 - end do - - do fc = 1,num_bgc_soilc - c = filter_bgc_soilc(fc) - - if(col%is_fates(c)) then - totvegc_col = 0._r8 - ecovegc_col = 0._r8 - else + + if (use_fates_bgc) then + do fc = 1,num_bgc_soilc + c = filter_bgc_soilc(fc) + if(col%is_fates(c)) then + totvegc_col = 0._r8 + ecovegc_col = 0._r8 + else + do l = 1, ndecomp_pools + if ( decomp_cascade_con%is_cwd(l) ) then + this%cwdc_col(c) = this%cwdc_col(c) + this%decomp_cpools_col(c,l) + end if + end do + totvegc_col = cnveg_carbonstate_inst%totc_p2c_col(c) + ecovegc_col = cnveg_carbonstate_inst%totvegc_col(c) + end if + ! total ecosystem carbon, including veg but excluding cpool (TOTECOSYSC) + this%totecosysc_col(c) = & + this%cwdc_col(c) + & + this%totmicc_col(c) + & + this%totlitc_col(c) + & + this%totsomc_col(c) + & + ecovegc_col + ! total column carbon, including veg and cpool (TOTCOLC) + this%totc_col(c) = & + this%cwdc_col(c) + & + this%totmicc_col(c) + & + this%totlitc_col(c) + & + this%totsomc_col(c) + & + this%ctrunc_col(c) + & + totvegc_col + end do + else + do fc = 1,num_allc + c = filter_allc(fc) do l = 1, ndecomp_pools if ( decomp_cascade_con%is_cwd(l) ) then this%cwdc_col(c) = this%cwdc_col(c) + this%decomp_cpools_col(c,l) end if end do - totvegc_col = cnveg_carbonstate_inst%totc_p2c_col(c) ecovegc_col = cnveg_carbonstate_inst%totvegc_col(c) - end if - ! total ecosystem carbon, including veg but excluding cpool (TOTECOSYSC) - this%totecosysc_col(c) = & - this%cwdc_col(c) + & - this%totmicc_col(c) + & - this%totlitc_col(c) + & - this%totsomc_col(c) + & - ecovegc_col - - ! total column carbon, including veg and cpool (TOTCOLC) - this%totc_col(c) = & - this%cwdc_col(c) + & - this%totmicc_col(c) + & - this%totlitc_col(c) + & - this%totsomc_col(c) + & - this%ctrunc_col(c) + & - totvegc_col - end do - - + ! total ecosystem carbon, including veg but excluding cpool (TOTECOSYSC) + this%totecosysc_col(c) = & + this%cwdc_col(c) + & + this%totmicc_col(c) + & + this%totlitc_col(c) + & + this%totsomc_col(c) + & + ecovegc_col + + ! total column carbon, including veg and cpool (TOTCOLC) + this%totc_col(c) = & + this%cwdc_col(c) + & + this%totmicc_col(c) + & + this%totlitc_col(c) + & + this%totsomc_col(c) + & + this%ctrunc_col(c) + & + totvegc_col + end do + end if + end subroutine Summary !------------------------------------------------------------------------ From 40e7600c66523e228ae78c8c6fb87548bbd212af Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Wed, 5 Jul 2023 09:23:47 -0600 Subject: [PATCH 079/257] Fixes to zeroing carbon and nitrogen summary variables --- .../SoilBiogeochemCarbonStateType.F90 | 81 ++++++++----------- .../SoilBiogeochemNitrogenStateType.F90 | 27 ++++--- 2 files changed, 50 insertions(+), 58 deletions(-) diff --git a/src/soilbiogeochem/SoilBiogeochemCarbonStateType.F90 b/src/soilbiogeochem/SoilBiogeochemCarbonStateType.F90 index 098412a57b..a915a88862 100644 --- a/src/soilbiogeochem/SoilBiogeochemCarbonStateType.F90 +++ b/src/soilbiogeochem/SoilBiogeochemCarbonStateType.F90 @@ -950,6 +950,9 @@ subroutine Summary(this, bounds, num_allc, filter_allc, num_bgc_soilc, filter_bg integer :: c,j,k,l ! indices integer :: fc ! filter indices real(r8) :: maxdepth ! depth to integrate soil variables + integer :: num_local ! Either num_bgc_soilc or num_allc, depending + ! on if its a fates run, its different because + ! the cnveg variables are not allocated w/ fates real(r8) :: ecovegc_col real(r8) :: totvegc_col !----------------------------------------------------------------------- @@ -1125,39 +1128,20 @@ subroutine Summary(this, bounds, num_allc, filter_allc, num_bgc_soilc, filter_bg end do if (use_fates_bgc) then - do fc = 1,num_bgc_soilc - c = filter_bgc_soilc(fc) - if(col%is_fates(c)) then - totvegc_col = 0._r8 - ecovegc_col = 0._r8 - else - do l = 1, ndecomp_pools - if ( decomp_cascade_con%is_cwd(l) ) then - this%cwdc_col(c) = this%cwdc_col(c) + this%decomp_cpools_col(c,l) - end if - end do - totvegc_col = cnveg_carbonstate_inst%totc_p2c_col(c) - ecovegc_col = cnveg_carbonstate_inst%totvegc_col(c) - end if - ! total ecosystem carbon, including veg but excluding cpool (TOTECOSYSC) - this%totecosysc_col(c) = & - this%cwdc_col(c) + & - this%totmicc_col(c) + & - this%totlitc_col(c) + & - this%totsomc_col(c) + & - ecovegc_col - ! total column carbon, including veg and cpool (TOTCOLC) - this%totc_col(c) = & - this%cwdc_col(c) + & - this%totmicc_col(c) + & - this%totlitc_col(c) + & - this%totsomc_col(c) + & - this%ctrunc_col(c) + & - totvegc_col - end do + num_local = num_bgc_soilc else - do fc = 1,num_allc + num_local = num_allc + end if + do fc = 1,num_local + if(use_fates_bgc) then + c = filter_bgc_soilc(fc) + else c = filter_allc(fc) + end if + if(col%is_fates(c)) then + totvegc_col = 0._r8 + ecovegc_col = 0._r8 + else do l = 1, ndecomp_pools if ( decomp_cascade_con%is_cwd(l) ) then this%cwdc_col(c) = this%cwdc_col(c) + this%decomp_cpools_col(c,l) @@ -1165,25 +1149,24 @@ subroutine Summary(this, bounds, num_allc, filter_allc, num_bgc_soilc, filter_bg end do totvegc_col = cnveg_carbonstate_inst%totc_p2c_col(c) ecovegc_col = cnveg_carbonstate_inst%totvegc_col(c) + end if - ! total ecosystem carbon, including veg but excluding cpool (TOTECOSYSC) - this%totecosysc_col(c) = & - this%cwdc_col(c) + & - this%totmicc_col(c) + & - this%totlitc_col(c) + & - this%totsomc_col(c) + & - ecovegc_col - - ! total column carbon, including veg and cpool (TOTCOLC) - this%totc_col(c) = & - this%cwdc_col(c) + & - this%totmicc_col(c) + & - this%totlitc_col(c) + & - this%totsomc_col(c) + & - this%ctrunc_col(c) + & - totvegc_col - end do - end if + ! total ecosystem carbon, including veg but excluding cpool (TOTECOSYSC) + this%totecosysc_col(c) = & + this%cwdc_col(c) + & + this%totmicc_col(c) + & + this%totlitc_col(c) + & + this%totsomc_col(c) + & + ecovegc_col + ! total column carbon, including veg and cpool (TOTCOLC) + this%totc_col(c) = & + this%cwdc_col(c) + & + this%totmicc_col(c) + & + this%totlitc_col(c) + & + this%totsomc_col(c) + & + this%ctrunc_col(c) + & + totvegc_col + end do end subroutine Summary diff --git a/src/soilbiogeochem/SoilBiogeochemNitrogenStateType.F90 b/src/soilbiogeochem/SoilBiogeochemNitrogenStateType.F90 index ac57ad20b7..3a217dd4c3 100644 --- a/src/soilbiogeochem/SoilBiogeochemNitrogenStateType.F90 +++ b/src/soilbiogeochem/SoilBiogeochemNitrogenStateType.F90 @@ -11,7 +11,7 @@ module SoilBiogeochemNitrogenStateType use clm_varpar , only : ndecomp_cascade_transitions, ndecomp_pools, nlevcan use clm_varpar , only : nlevdecomp_full, nlevdecomp, nlevsoi use clm_varcon , only : spval, dzsoi_decomp, zisoi - use clm_varctl , only : use_nitrif_denitrif + use clm_varctl , only : use_nitrif_denitrif, use_fates_bgc use SoilBiogeochemDecompCascadeConType , only : mimics_decomp, century_decomp, decomp_method, use_soil_matrixcn use clm_varctl , only : iulog, override_bgc_restart_mismatch_dump, spinup_state use landunit_varcon , only : istcrop, istsoil @@ -821,6 +821,9 @@ subroutine Summary(this, bounds, num_allc, filter_allc, num_bgc_soilc, filter_bg ! !LOCAL VARIABLES: integer :: c,j,k,l ! indices integer :: fc ! lake filter indices + integer :: num_local ! we do summary on different set when fates is + ! active becuase the CN variables aren't allocated + ! this preserves B4B real(r8) :: maxdepth ! depth to integrate soil variables real(r8) :: totvegn_col ! local total ecosys veg N, allows 0 for fates real(r8) :: ecovegn_col ! local total veg N, allows 0 for fates @@ -1031,18 +1034,25 @@ subroutine Summary(this, bounds, num_allc, filter_allc, num_bgc_soilc, filter_bg do fc = 1,num_allc c = filter_allc(fc) this%cwdn_col(c) = 0._r8 - this%totecosysn_col(c) = 0._r8 - this%totn_col(c) = 0._r8 end do - do fc = 1,num_bgc_soilc - c = filter_bgc_soilc(fc) - + if(use_fates_bgc)then + num_local = num_bgc_soilc + else + num_local = num_allc + end if + + do fc = 1,num_local + if(use_fates_bgc) then + c = filter_bgc_soilc(fc) + else + c = filter_allc(fc) + end if + if(col%is_fates(c)) then totvegn_col = 0._r8 ecovegn_col = 0._r8 else - do l = 1, ndecomp_pools if ( decomp_cascade_con%is_cwd(l) ) then this%cwdn_col(c) = this%cwdn_col(c) + & @@ -1051,9 +1061,8 @@ subroutine Summary(this, bounds, num_allc, filter_allc, num_bgc_soilc, filter_bg end do totvegn_col = cnveg_nitrogenstate_inst%totn_p2c_col(c) ecovegn_col = cnveg_nitrogenstate_inst%totvegn_col(c) - end if - + ! total ecosystem nitrogen, including veg (TOTECOSYSN) this%totecosysn_col(c) = & this%cwdn_col(c) + & From 946a8a0aad8a5f82f5a31a7513c7657416203cf6 Mon Sep 17 00:00:00 2001 From: adrifoster Date: Mon, 10 Jul 2023 10:43:41 -0600 Subject: [PATCH 080/257] initial changes --- bld/CLMBuildNamelist.pm | 6 ++++-- src/main/clm_driver.F90 | 4 ++-- 2 files changed, 6 insertions(+), 4 deletions(-) diff --git a/bld/CLMBuildNamelist.pm b/bld/CLMBuildNamelist.pm index 02d9799487..4ed83f79ff 100755 --- a/bld/CLMBuildNamelist.pm +++ b/bld/CLMBuildNamelist.pm @@ -3845,8 +3845,10 @@ sub setup_logic_lai_streams { if ( &value_is_true($nl_flags->{'use_crop'}) && &value_is_true($nl->get_value('use_lai_streams')) ) { $log->fatal_error("turning use_lai_streams on is incompatable with use_crop set to true."); } - if ( $nl_flags->{'bgc_mode'} eq "sp" ) { - + if ( $nl_flags->{'bgc_mode'} = "sp" || "fates" ) { + if ($nl_flags->{'bgc_mode'} .eq. "fates" && ! &value_is_true($nl->get_value('use_fates_sp'))) { + $log->fatal_error("Must have use_fates_sp turned on to run FATES with LAI streams."); + } if ( &value_is_true($nl->get_value('use_lai_streams')) ) { add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'use_lai_streams'); add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'lai_mapalgo', diff --git a/src/main/clm_driver.F90 b/src/main/clm_driver.F90 index ae178b226c..91fd1d8824 100644 --- a/src/main/clm_driver.F90 +++ b/src/main/clm_driver.F90 @@ -462,8 +462,8 @@ subroutine clm_drv(doalb, nextsw_cday, declinp1, declin, rstwr, nlend, rdate, ro ! When LAI streams are being used ! NOTE: This call needs to happen outside loops over nclumps (as streams are not threadsafe) - if ((.not. use_cn) .and. (.not. use_fates) .and. (doalb) .and. use_lai_streams) then - call lai_advance( bounds_proc ) + if (doalb .and. use_lai_streams) then + call lai_advance(bounds_proc) endif ! ============================================================================ From 1d649da97391955320306b2c9434d3e10f7d7b3d Mon Sep 17 00:00:00 2001 From: adrifoster Date: Mon, 10 Jul 2023 11:13:11 -0600 Subject: [PATCH 081/257] add test --- cime_config/testdefs/testlist_clm.xml | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/cime_config/testdefs/testlist_clm.xml b/cime_config/testdefs/testlist_clm.xml index ec04e651d7..e87160d2b8 100644 --- a/cime_config/testdefs/testlist_clm.xml +++ b/cime_config/testdefs/testlist_clm.xml @@ -2371,7 +2371,7 @@ - From dbf0bff55f80df300bcd492d3904b83a81ad7e10 Mon Sep 17 00:00:00 2001 From: adrifoster Date: Mon, 10 Jul 2023 11:20:12 -0600 Subject: [PATCH 082/257] fix bld script? --- bld/CLMBuildNamelist.pm | 2 +- cime_config/testdefs/testlist_clm.xml | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/bld/CLMBuildNamelist.pm b/bld/CLMBuildNamelist.pm index 4ed83f79ff..2d87c1d603 100755 --- a/bld/CLMBuildNamelist.pm +++ b/bld/CLMBuildNamelist.pm @@ -3845,7 +3845,7 @@ sub setup_logic_lai_streams { if ( &value_is_true($nl_flags->{'use_crop'}) && &value_is_true($nl->get_value('use_lai_streams')) ) { $log->fatal_error("turning use_lai_streams on is incompatable with use_crop set to true."); } - if ( $nl_flags->{'bgc_mode'} = "sp" || "fates" ) { + if ( $nl_flags->{'bgc_mode'} .eq. "sp" || $nl_flags->{'bgc_mode'} = "fates" ) { if ($nl_flags->{'bgc_mode'} .eq. "fates" && ! &value_is_true($nl->get_value('use_fates_sp'))) { $log->fatal_error("Must have use_fates_sp turned on to run FATES with LAI streams."); } diff --git a/cime_config/testdefs/testlist_clm.xml b/cime_config/testdefs/testlist_clm.xml index e87160d2b8..7d55980eb1 100644 --- a/cime_config/testdefs/testlist_clm.xml +++ b/cime_config/testdefs/testlist_clm.xml @@ -2372,7 +2372,7 @@ - + From 536e20633b1765372fa31ec893b61a87a835a3a3 Mon Sep 17 00:00:00 2001 From: adrifoster Date: Mon, 10 Jul 2023 11:42:12 -0600 Subject: [PATCH 083/257] add test info --- bld/CLMBuildNamelist.pm | 4 +-- .../include_user_mods | 1 - .../FatesColdSatPhen_prescribed/user_nl_clm | 32 +++++++++++++++++++ 3 files changed, 34 insertions(+), 3 deletions(-) create mode 100644 cime_config/testdefs/testmods_dirs/clm/FatesColdSatPhen_prescribed/user_nl_clm diff --git a/bld/CLMBuildNamelist.pm b/bld/CLMBuildNamelist.pm index 2d87c1d603..a5afd1d0bb 100755 --- a/bld/CLMBuildNamelist.pm +++ b/bld/CLMBuildNamelist.pm @@ -3845,8 +3845,8 @@ sub setup_logic_lai_streams { if ( &value_is_true($nl_flags->{'use_crop'}) && &value_is_true($nl->get_value('use_lai_streams')) ) { $log->fatal_error("turning use_lai_streams on is incompatable with use_crop set to true."); } - if ( $nl_flags->{'bgc_mode'} .eq. "sp" || $nl_flags->{'bgc_mode'} = "fates" ) { - if ($nl_flags->{'bgc_mode'} .eq. "fates" && ! &value_is_true($nl->get_value('use_fates_sp'))) { + if ( $nl_flags->{'bgc_mode'} .eq. "sp" || $nl_flags->{'bgc_mode'} .eq. "fates" ) { + if ( $nl_flags->{'bgc_mode'} .eq. "fates" && ! &value_is_true($nl->get_value('use_fates_sp')) ) { $log->fatal_error("Must have use_fates_sp turned on to run FATES with LAI streams."); } if ( &value_is_true($nl->get_value('use_lai_streams')) ) { diff --git a/cime_config/testdefs/testmods_dirs/clm/FatesColdSatPhen_prescribed/include_user_mods b/cime_config/testdefs/testmods_dirs/clm/FatesColdSatPhen_prescribed/include_user_mods index d111d05911..33ca1de12e 100644 --- a/cime_config/testdefs/testmods_dirs/clm/FatesColdSatPhen_prescribed/include_user_mods +++ b/cime_config/testdefs/testmods_dirs/clm/FatesColdSatPhen_prescribed/include_user_mods @@ -1,2 +1 @@ ../FatesColdSatPhen -../prescribed diff --git a/cime_config/testdefs/testmods_dirs/clm/FatesColdSatPhen_prescribed/user_nl_clm b/cime_config/testdefs/testmods_dirs/clm/FatesColdSatPhen_prescribed/user_nl_clm new file mode 100644 index 0000000000..b9add4634d --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/clm/FatesColdSatPhen_prescribed/user_nl_clm @@ -0,0 +1,32 @@ + use_soil_moisture_streams = .true. + use_lai_streams = .true. + hist_fincl1 += 'H2OSOI_PRESCRIBED_GRC' + soilm_tintalgo = 'lower' ! set time interpolation to use lower value, so can compare to input dataset + lai_tintalgo = 'lower' ! set time interpolation to use lower value, so can compare more directly to input dataset + soilm_ignore_data_if_missing = .true. + hist_dov2xy = .true.,.false. +! Even though only 2 history tapes are defined here, set ndens to 1 for up to 6 history +! tapes, for the sake of mods that extend these default mods and may add other history tapes + hist_ndens = 1,1,1,1,1,1 + hist_nhtfrq =-24,-8 + hist_mfilt = 1,1 + hist_fincl1 = 'TRAFFICFLUX', 'SNOWLIQ:A','SNOWICE:A' +! Add FCO2 because few (if any) tests send this flux to the coupler, so it isn't checked via cpl hist files + hist_fincl1 += 'FCO2' + hist_fincl2 = 'TG','TBOT','FIRE','FIRA','FLDS','FSDS', + 'FSR','FSA','FGEV','FSH','FGR','TSOI', + 'ERRSOI','SABV','SABG', + 'FSDSVD','FSDSND','FSDSVI','FSDSNI', + 'FSRVD','FSRND','FSRVI','FSRNI', + 'TSA','FCTR','FCEV','QBOT','RH2M','H2OSOI', + 'H2OSNO','SOILLIQ','SOILICE', + 'TSA_U', 'TSA_R', + 'TREFMNAV_U', 'TREFMNAV_R', + 'TREFMXAV_U', 'TREFMXAV_R', + 'TG_U', 'TG_R', + 'RH2M_U', 'RH2M_R', + 'QRUNOFF_U', 'QRUNOFF_R', + 'SoilAlpha_U', + 'SWup', 'LWup', 'URBAN_AC', 'URBAN_HEAT' + + use_ssre = .true. \ No newline at end of file From be382696ceb13be4998764ef1eafd25309eb2038 Mon Sep 17 00:00:00 2001 From: adrifoster Date: Mon, 10 Jul 2023 11:43:12 -0600 Subject: [PATCH 084/257] fix perl syntax --- bld/CLMBuildNamelist.pm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/bld/CLMBuildNamelist.pm b/bld/CLMBuildNamelist.pm index a5afd1d0bb..9581a8227e 100755 --- a/bld/CLMBuildNamelist.pm +++ b/bld/CLMBuildNamelist.pm @@ -3845,8 +3845,8 @@ sub setup_logic_lai_streams { if ( &value_is_true($nl_flags->{'use_crop'}) && &value_is_true($nl->get_value('use_lai_streams')) ) { $log->fatal_error("turning use_lai_streams on is incompatable with use_crop set to true."); } - if ( $nl_flags->{'bgc_mode'} .eq. "sp" || $nl_flags->{'bgc_mode'} .eq. "fates" ) { - if ( $nl_flags->{'bgc_mode'} .eq. "fates" && ! &value_is_true($nl->get_value('use_fates_sp')) ) { + if ( $nl_flags->{'bgc_mode'} eq "sp" || $nl_flags->{'bgc_mode'} eq "fates" ) { + if ( $nl_flags->{'bgc_mode'} eq "fates" && ! &value_is_true($nl->get_value('use_fates_sp')) ) { $log->fatal_error("Must have use_fates_sp turned on to run FATES with LAI streams."); } if ( &value_is_true($nl->get_value('use_lai_streams')) ) { From 0c642db4585db01f98e16d865838c79c6694b61b Mon Sep 17 00:00:00 2001 From: adrifoster Date: Mon, 10 Jul 2023 14:39:34 -0600 Subject: [PATCH 085/257] add check for lai streams --- .../FatesColdSatPhen_prescribed/user_nl_clm | 27 +------------------ src/main/controlMod.F90 | 8 ++++++ 2 files changed, 9 insertions(+), 26 deletions(-) diff --git a/cime_config/testdefs/testmods_dirs/clm/FatesColdSatPhen_prescribed/user_nl_clm b/cime_config/testdefs/testmods_dirs/clm/FatesColdSatPhen_prescribed/user_nl_clm index b9add4634d..1fc1c74311 100644 --- a/cime_config/testdefs/testmods_dirs/clm/FatesColdSatPhen_prescribed/user_nl_clm +++ b/cime_config/testdefs/testmods_dirs/clm/FatesColdSatPhen_prescribed/user_nl_clm @@ -4,29 +4,4 @@ soilm_tintalgo = 'lower' ! set time interpolation to use lower value, so can compare to input dataset lai_tintalgo = 'lower' ! set time interpolation to use lower value, so can compare more directly to input dataset soilm_ignore_data_if_missing = .true. - hist_dov2xy = .true.,.false. -! Even though only 2 history tapes are defined here, set ndens to 1 for up to 6 history -! tapes, for the sake of mods that extend these default mods and may add other history tapes - hist_ndens = 1,1,1,1,1,1 - hist_nhtfrq =-24,-8 - hist_mfilt = 1,1 - hist_fincl1 = 'TRAFFICFLUX', 'SNOWLIQ:A','SNOWICE:A' -! Add FCO2 because few (if any) tests send this flux to the coupler, so it isn't checked via cpl hist files - hist_fincl1 += 'FCO2' - hist_fincl2 = 'TG','TBOT','FIRE','FIRA','FLDS','FSDS', - 'FSR','FSA','FGEV','FSH','FGR','TSOI', - 'ERRSOI','SABV','SABG', - 'FSDSVD','FSDSND','FSDSVI','FSDSNI', - 'FSRVD','FSRND','FSRVI','FSRNI', - 'TSA','FCTR','FCEV','QBOT','RH2M','H2OSOI', - 'H2OSNO','SOILLIQ','SOILICE', - 'TSA_U', 'TSA_R', - 'TREFMNAV_U', 'TREFMNAV_R', - 'TREFMXAV_U', 'TREFMXAV_R', - 'TG_U', 'TG_R', - 'RH2M_U', 'RH2M_R', - 'QRUNOFF_U', 'QRUNOFF_R', - 'SoilAlpha_U', - 'SWup', 'LWup', 'URBAN_AC', 'URBAN_HEAT' - - use_ssre = .true. \ No newline at end of file + \ No newline at end of file diff --git a/src/main/controlMod.F90 b/src/main/controlMod.F90 index a07228aa0d..7a44d16c1d 100644 --- a/src/main/controlMod.F90 +++ b/src/main/controlMod.F90 @@ -460,6 +460,14 @@ subroutine control_init(dtime) end if + ! Check compatibility with use_lai_streams + if (use_lai_streams) then + if ((use_fates .and. .not. use_fates_sp) .or. use_cn) then + call endrun(msg=' ERROR: cannot use LAI streams unless in SP mode (use_cn = .false. or use_fates_sp=.true.).'//& + errMsg(sourcefile, __LINE__)) + end if + end if + ! If nfix_timeconst is equal to the junk default value, then it was not specified ! by the user namelist and we need to assign it the correct default value. If the ! user specified it in the namelist, we leave it alone. From 9816cf07626a9c4aba20c5f6519a5ec1bbdb1a24 Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Tue, 11 Jul 2023 14:50:32 -0600 Subject: [PATCH 086/257] Eliminate NaNs in TotalSum in subr. check_sums_equal_1 --- src/main/surfrdUtilsMod.F90 | 11 +++++++---- 1 file changed, 7 insertions(+), 4 deletions(-) diff --git a/src/main/surfrdUtilsMod.F90 b/src/main/surfrdUtilsMod.F90 index 0763d43a16..af9e64d86a 100644 --- a/src/main/surfrdUtilsMod.F90 +++ b/src/main/surfrdUtilsMod.F90 @@ -45,7 +45,7 @@ subroutine check_sums_equal_1(arr, lb, name, caller, ier, sumto) character(len=*), intent(in) :: name ! name of array character(len=*), intent(in) :: caller ! identifier of caller, for more meaningful error messages integer, optional, intent(out):: ier ! Return an error code rather than abort - real(r8), optional, intent(out):: sumto(lb:) ! The value the array should sum to (1.0 if not provided) + real(r8), optional, intent(in):: sumto(lb:) ! The value the array should sum to (1.0 if not provided) ! ! !LOCAL VARIABLES: logical :: found @@ -58,12 +58,15 @@ subroutine check_sums_equal_1(arr, lb, name, caller, ier, sumto) ub = ubound(arr, 1) allocate(TotalSum(lb:ub)) - TotalSum = 1._r8 - if ( present(sumto) ) TotalSum = sumto if( present(ier) ) ier = 0 found = .false. - do nl = lbound(arr, 1), ub + do nl = lb, ub + if ( present(sumto) ) then + TotalSum(nl) = sumto(nl) + else + TotalSum(nl) = 1._r8 + end if if (abs(sum(arr(nl,:)) - TotalSum(nl)) > eps) then found = .true. nindx = nl From 583ed0975f4dca78ca2b3c036befbdc4aab573e6 Mon Sep 17 00:00:00 2001 From: Adrianna Foster Date: Tue, 11 Jul 2023 15:05:09 -0600 Subject: [PATCH 087/257] update lai init --- src/biogeochem/SatellitePhenologyMod.F90 | 2 ++ src/cpl/share_esmf/laiStreamMod.F90 | 23 ++++++++++++++++++++++- src/main/clm_driver.F90 | 7 +++++++ src/main/clm_initializeMod.F90 | 11 ++++++++++- 4 files changed, 41 insertions(+), 2 deletions(-) diff --git a/src/biogeochem/SatellitePhenologyMod.F90 b/src/biogeochem/SatellitePhenologyMod.F90 index 3e9341f430..02ede03057 100644 --- a/src/biogeochem/SatellitePhenologyMod.F90 +++ b/src/biogeochem/SatellitePhenologyMod.F90 @@ -128,9 +128,11 @@ subroutine SatellitePhenology(bounds, num_filter, filter, & frac_veg_nosno_alb => canopystate_inst%frac_veg_nosno_alb_patch & ! Output: [integer (:) ] fraction of vegetation not covered by snow (0 OR 1) [-] ) + if (masterproc) write(iulog,*) "inside the subroutine" if (use_lai_streams) then call lai_interp(bounds, canopystate_inst) endif + if (masterproc) write(iulog,*) "after interp" do fp = 1, num_filter p = filter(fp) diff --git a/src/cpl/share_esmf/laiStreamMod.F90 b/src/cpl/share_esmf/laiStreamMod.F90 index 3966488e0b..9770d69081 100644 --- a/src/cpl/share_esmf/laiStreamMod.F90 +++ b/src/cpl/share_esmf/laiStreamMod.F90 @@ -54,7 +54,7 @@ subroutine lai_init(bounds) type(bounds_type), intent(in) :: bounds ! bounds ! ! !LOCAL VARIABLES: - integer :: i,n ! index + integer :: i,n, ig, g ! index integer :: stream_year_first_lai ! first year in Lai stream to use integer :: stream_year_last_lai ! last year in Lai stream to use integer :: model_year_align_lai ! align stream_year_first_lai with @@ -151,6 +151,15 @@ subroutine lai_init(bounds) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) then call ESMF_Finalize(endflag=ESMF_END_ABORT) end if + + if ( .not. allocated(g_to_ig) )then + allocate (g_to_ig(bounds%begg:bounds%endg) ) + ig = 0 + do g = bounds%begg,bounds%endg + ig = ig+1 + g_to_ig(g) = ig + end do + end if end subroutine lai_init @@ -219,6 +228,8 @@ subroutine lai_interp(bounds, canopystate_inst) SHR_ASSERT_FL( (lbound(g_to_ig,1) <= bounds%begg ), sourcefile, __LINE__) SHR_ASSERT_FL( (ubound(g_to_ig,1) >= bounds%endg ), sourcefile, __LINE__) + + if (masterproc) write(iulog,*) "inside laiinterp" ! Get pointer for stream data that is time and spatially interpolate to model time and grid ! Place all lai data from each type into a temporary 2d array @@ -236,19 +247,29 @@ subroutine lai_interp(bounds, canopystate_inst) dataptr2d(g,n) = dataptr1d(g) end do end do + + if (masterproc) write(iulog,*) "finished first loop" do p = bounds%begp, bounds%endp ivt = patch%itype(p) ! Set lai for each gridcell/patch combination if (ivt /= noveg) then ! vegetated pft + if (masterproc) write(iulog,*) "vegetated" + if (masterproc) write(iulog,*) patch%gridcell(p) + if (masterproc) write(iulog,*) bounds%begp, bounds%endp, "bounds" ig = g_to_ig(patch%gridcell(p)) canopystate_inst%tlai_patch(p) = dataptr2d(ig,ivt) + if (masterproc) write(iulog,*) "filled the patch" else ! non-vegetated pft canopystate_inst%tlai_patch(p) = 0._r8 endif + if (masterproc) write(iulog,*) "inside loop" end do + + if(masterproc) write(iulog,*) "second loop" + deallocate(dataptr2d) end subroutine lai_interp diff --git a/src/main/clm_driver.F90 b/src/main/clm_driver.F90 index 12a7816465..d00ad664b7 100644 --- a/src/main/clm_driver.F90 +++ b/src/main/clm_driver.F90 @@ -224,6 +224,10 @@ subroutine clm_drv(doalb, nextsw_cday, declinp1, declin, rstwr, nlend, rdate, ro ! Specified phenology ! Done in SP mode, FATES-SP mode and also when dry-deposition is active ! ============================================================================ + + if ( masterproc ) then + write(iulog,*) 'made it to here' + end if if (use_cn) then ! For dry-deposition need to call CLMSP so that mlaidiff is obtained @@ -263,6 +267,9 @@ subroutine clm_drv(doalb, nextsw_cday, declinp1, declin, rstwr, nlend, rdate, ro end if end if + + + ! ================================================================================== ! Determine decomp vertical profiles diff --git a/src/main/clm_initializeMod.F90 b/src/main/clm_initializeMod.F90 index 7988fbfc7b..b3eeabbfc5 100644 --- a/src/main/clm_initializeMod.F90 +++ b/src/main/clm_initializeMod.F90 @@ -670,7 +670,7 @@ subroutine initialize2(ni,nj) elseif ( use_fates_sp ) then call interpMonthlyVeg(bounds_proc, canopystate_inst) end if - + ! Determine gridcell averaged properties to send to atm if (nsrest == nsrStartup) then call t_startf('init_map2gc') @@ -706,6 +706,7 @@ subroutine initialize2(ni,nj) !$OMP PARALLEL DO PRIVATE (nc, bounds_clump) do nc = 1,nclumps call get_clump_bounds(nc, bounds_clump) + if (masterproc) write(iulog,*) "inside the loop" ! FATES satellite phenology mode needs to include all active and inactive patch-level soil ! filters due to the translation between the hlm pfts and the fates pfts. @@ -719,10 +720,18 @@ subroutine initialize2(ni,nj) end do !$OMP END PARALLEL DO end if + if (masterproc) then + write(iulog,*) "made it past SP" + end if call clm_fates%init_coldstart(water_inst%waterstatebulk_inst, & water_inst%waterdiagnosticbulk_inst, canopystate_inst, & soilstate_inst, soilbiogeochem_carbonflux_inst) end if + + if (masterproc) then + write(iulog,*) "made it to fates initialize" + end if + ! topo_glc_mec was allocated in initialize1, but needed to be kept around through ! initialize2 because it is used to initialize other variables; now it can be deallocated From 1543f861eb417e248ff7863d2ee685ba096b4e91 Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Wed, 12 Jul 2023 09:59:56 -0600 Subject: [PATCH 088/257] Change small snocan to zero --- src/biogeophys/CanopyFluxesMod.F90 | 11 +++++++++++ 1 file changed, 11 insertions(+) diff --git a/src/biogeophys/CanopyFluxesMod.F90 b/src/biogeophys/CanopyFluxesMod.F90 index 038f8ea636..393bfa7ebe 100644 --- a/src/biogeophys/CanopyFluxesMod.F90 +++ b/src/biogeophys/CanopyFluxesMod.F90 @@ -47,6 +47,7 @@ module CanopyFluxesMod use EDTypesMod , only : ed_site_type use SoilWaterRetentionCurveMod, only : soil_water_retention_curve_type use LunaMod , only : Update_Photosynthesis_Capacity, Acc24_Climate_LUNA,Acc240_Climate_LUNA,Clear24_Climate_LUNA + use NumericsMod , only : truncate_small_values ! ! !PUBLIC TYPES: implicit none @@ -416,6 +417,7 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, real(r8) :: uuc(bounds%begp:bounds%endp) ! undercanopy windspeed real(r8) :: carea_stem ! cross-sectional area of stem real(r8) :: dlrad_leaf ! Downward longwave radition from leaf + real(r8) :: snocan_baseline(bounds%begp:bounds%endp) ! baseline of snocan for use in truncate_small_values ! Indices for raw and rah integer, parameter :: above_canopy = 1 ! Above canopy @@ -1520,6 +1522,9 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, cgrndl(p) = cgrndl(p) + forc_rho(c)*wtgq(p)*wtalq(p)*dqgdT(c) cgrnd(p) = cgrnds(p) + cgrndl(p)*htvp(c) + ! save before updating + snocan_baseline(p) = snocan(p) + ! Update dew accumulation (kg/m2) if (t_veg(p) > tfrz ) then ! above freezing, update accumulation in liqcan if ((qflx_evap_veg(p)-qflx_tran_veg(p))*dtime > liqcan(p)) then ! all liq evap @@ -1537,6 +1542,12 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, end if end do + + ! Remove snocan that got reduced by more than a factor of rel_epsilon + ! snocan < rel_epsilon * snocan_baseline will be set to zero + ! See NumericsMod for rel_epsilon value + call truncate_small_values(fn, filterp, begp, endp, & + snocan_baseline(begp:endp), snocan(begp:endp)) if ( use_fates ) then From 3a8fb5c42d1139f71770b9107d181e51e5dbf824 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Wed, 12 Jul 2023 13:52:33 -0400 Subject: [PATCH 089/257] forgot to remove conflict tags --- Externals_CLM.cfg | 1 - 1 file changed, 1 deletion(-) diff --git a/Externals_CLM.cfg b/Externals_CLM.cfg index d59bd3de73..883416a43b 100644 --- a/Externals_CLM.cfg +++ b/Externals_CLM.cfg @@ -1,7 +1,6 @@ [fates] local_path = src/fates protocol = git -<<<<<<< HEAD repo_url = https://github.com/rgknox/fates branch = clm-cbalance required = True From e6298930d71fbb44b96f9aa091a67b49cd385653 Mon Sep 17 00:00:00 2001 From: adrifoster Date: Wed, 12 Jul 2023 12:56:41 -0600 Subject: [PATCH 090/257] get rid of print statements --- src/biogeochem/SatellitePhenologyMod.F90 | 2 -- src/cpl/share_esmf/laiStreamMod.F90 | 10 ---------- src/main/clm_driver.F90 | 4 ---- src/main/clm_initializeMod.F90 | 11 +---------- 4 files changed, 1 insertion(+), 26 deletions(-) diff --git a/src/biogeochem/SatellitePhenologyMod.F90 b/src/biogeochem/SatellitePhenologyMod.F90 index 02ede03057..3e9341f430 100644 --- a/src/biogeochem/SatellitePhenologyMod.F90 +++ b/src/biogeochem/SatellitePhenologyMod.F90 @@ -128,11 +128,9 @@ subroutine SatellitePhenology(bounds, num_filter, filter, & frac_veg_nosno_alb => canopystate_inst%frac_veg_nosno_alb_patch & ! Output: [integer (:) ] fraction of vegetation not covered by snow (0 OR 1) [-] ) - if (masterproc) write(iulog,*) "inside the subroutine" if (use_lai_streams) then call lai_interp(bounds, canopystate_inst) endif - if (masterproc) write(iulog,*) "after interp" do fp = 1, num_filter p = filter(fp) diff --git a/src/cpl/share_esmf/laiStreamMod.F90 b/src/cpl/share_esmf/laiStreamMod.F90 index 9770d69081..b3e26b4c08 100644 --- a/src/cpl/share_esmf/laiStreamMod.F90 +++ b/src/cpl/share_esmf/laiStreamMod.F90 @@ -229,7 +229,6 @@ subroutine lai_interp(bounds, canopystate_inst) SHR_ASSERT_FL( (lbound(g_to_ig,1) <= bounds%begg ), sourcefile, __LINE__) SHR_ASSERT_FL( (ubound(g_to_ig,1) >= bounds%endg ), sourcefile, __LINE__) - if (masterproc) write(iulog,*) "inside laiinterp" ! Get pointer for stream data that is time and spatially interpolate to model time and grid ! Place all lai data from each type into a temporary 2d array @@ -248,28 +247,19 @@ subroutine lai_interp(bounds, canopystate_inst) end do end do - if (masterproc) write(iulog,*) "finished first loop" - do p = bounds%begp, bounds%endp ivt = patch%itype(p) ! Set lai for each gridcell/patch combination if (ivt /= noveg) then ! vegetated pft - if (masterproc) write(iulog,*) "vegetated" - if (masterproc) write(iulog,*) patch%gridcell(p) - if (masterproc) write(iulog,*) bounds%begp, bounds%endp, "bounds" ig = g_to_ig(patch%gridcell(p)) canopystate_inst%tlai_patch(p) = dataptr2d(ig,ivt) - if (masterproc) write(iulog,*) "filled the patch" else ! non-vegetated pft canopystate_inst%tlai_patch(p) = 0._r8 endif - if (masterproc) write(iulog,*) "inside loop" end do - if(masterproc) write(iulog,*) "second loop" - deallocate(dataptr2d) end subroutine lai_interp diff --git a/src/main/clm_driver.F90 b/src/main/clm_driver.F90 index d00ad664b7..90d7121fdb 100644 --- a/src/main/clm_driver.F90 +++ b/src/main/clm_driver.F90 @@ -225,10 +225,6 @@ subroutine clm_drv(doalb, nextsw_cday, declinp1, declin, rstwr, nlend, rdate, ro ! Done in SP mode, FATES-SP mode and also when dry-deposition is active ! ============================================================================ - if ( masterproc ) then - write(iulog,*) 'made it to here' - end if - if (use_cn) then ! For dry-deposition need to call CLMSP so that mlaidiff is obtained ! NOTE: This is also true of FATES below diff --git a/src/main/clm_initializeMod.F90 b/src/main/clm_initializeMod.F90 index b3eeabbfc5..1bb966371c 100644 --- a/src/main/clm_initializeMod.F90 +++ b/src/main/clm_initializeMod.F90 @@ -706,8 +706,6 @@ subroutine initialize2(ni,nj) !$OMP PARALLEL DO PRIVATE (nc, bounds_clump) do nc = 1,nclumps call get_clump_bounds(nc, bounds_clump) - if (masterproc) write(iulog,*) "inside the loop" - ! FATES satellite phenology mode needs to include all active and inactive patch-level soil ! filters due to the translation between the hlm pfts and the fates pfts. ! E.g. in FATES, an active PFT vector of 1, 0, 0, 0, 1, 0, 1, 0 would be mapped into @@ -720,19 +718,12 @@ subroutine initialize2(ni,nj) end do !$OMP END PARALLEL DO end if - if (masterproc) then - write(iulog,*) "made it past SP" - end if + call clm_fates%init_coldstart(water_inst%waterstatebulk_inst, & water_inst%waterdiagnosticbulk_inst, canopystate_inst, & soilstate_inst, soilbiogeochem_carbonflux_inst) end if - if (masterproc) then - write(iulog,*) "made it to fates initialize" - end if - - ! topo_glc_mec was allocated in initialize1, but needed to be kept around through ! initialize2 because it is used to initialize other variables; now it can be deallocated deallocate(topo_glc_mec, fert_cft, irrig_method) From 412cff5c96ef6dba97a99c35d39520f38faeb5e4 Mon Sep 17 00:00:00 2001 From: adrifoster Date: Wed, 12 Jul 2023 12:58:59 -0600 Subject: [PATCH 091/257] don't use soil moisture streams --- .../clm/FatesColdSatPhen_prescribed/user_nl_clm | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/cime_config/testdefs/testmods_dirs/clm/FatesColdSatPhen_prescribed/user_nl_clm b/cime_config/testdefs/testmods_dirs/clm/FatesColdSatPhen_prescribed/user_nl_clm index 1fc1c74311..2b5ac9caf0 100644 --- a/cime_config/testdefs/testmods_dirs/clm/FatesColdSatPhen_prescribed/user_nl_clm +++ b/cime_config/testdefs/testmods_dirs/clm/FatesColdSatPhen_prescribed/user_nl_clm @@ -1,7 +1,7 @@ - use_soil_moisture_streams = .true. + !use_soil_moisture_streams = .true. use_lai_streams = .true. - hist_fincl1 += 'H2OSOI_PRESCRIBED_GRC' - soilm_tintalgo = 'lower' ! set time interpolation to use lower value, so can compare to input dataset + !hist_fincl1 += 'H2OSOI_PRESCRIBED_GRC' + !soilm_tintalgo = 'lower' ! set time interpolation to use lower value, so can compare to input dataset lai_tintalgo = 'lower' ! set time interpolation to use lower value, so can compare more directly to input dataset - soilm_ignore_data_if_missing = .true. + !soilm_ignore_data_if_missing = .true. \ No newline at end of file From c2b96777bfe20a941b49f9f459ba276e286c4530 Mon Sep 17 00:00:00 2001 From: adrifoster Date: Wed, 12 Jul 2023 13:20:51 -0600 Subject: [PATCH 092/257] update test --- cime_config/testdefs/testlist_clm.xml | 2 +- .../testmods_dirs/clm/FatesColdSatPhen_prescribed/README | 4 ++-- .../testmods_dirs/clm/FatesColdSatPhen_prescribed/user_nl_clm | 1 + 3 files changed, 4 insertions(+), 3 deletions(-) diff --git a/cime_config/testdefs/testlist_clm.xml b/cime_config/testdefs/testlist_clm.xml index 32f83f6e53..0575ea8086 100644 --- a/cime_config/testdefs/testlist_clm.xml +++ b/cime_config/testdefs/testlist_clm.xml @@ -2382,7 +2382,7 @@ - + diff --git a/cime_config/testdefs/testmods_dirs/clm/FatesColdSatPhen_prescribed/README b/cime_config/testdefs/testmods_dirs/clm/FatesColdSatPhen_prescribed/README index a1c8f04632..116e0f43b4 100644 --- a/cime_config/testdefs/testmods_dirs/clm/FatesColdSatPhen_prescribed/README +++ b/cime_config/testdefs/testmods_dirs/clm/FatesColdSatPhen_prescribed/README @@ -1,3 +1,3 @@ -This testmod currently does NOT work, because of issue #1722 +This testmod currently only works with lai streams (not soil moisture), because of FATES issue #845 -See https://github.com/ESCOMP/CTSM/issues/1722 +See https://github.com/NGEET/fates/issues/845 diff --git a/cime_config/testdefs/testmods_dirs/clm/FatesColdSatPhen_prescribed/user_nl_clm b/cime_config/testdefs/testmods_dirs/clm/FatesColdSatPhen_prescribed/user_nl_clm index 2b5ac9caf0..eb7a85165c 100644 --- a/cime_config/testdefs/testmods_dirs/clm/FatesColdSatPhen_prescribed/user_nl_clm +++ b/cime_config/testdefs/testmods_dirs/clm/FatesColdSatPhen_prescribed/user_nl_clm @@ -1,3 +1,4 @@ + ! right now we can't do prescribed soil moisture because of FATES issue #845 !use_soil_moisture_streams = .true. use_lai_streams = .true. !hist_fincl1 += 'H2OSOI_PRESCRIBED_GRC' From 6ec205815a3b0e012663aa874cf58752809837cf Mon Sep 17 00:00:00 2001 From: adrifoster Date: Wed, 12 Jul 2023 13:48:54 -0600 Subject: [PATCH 093/257] whitespace --- src/cpl/share_esmf/laiStreamMod.F90 | 4 +--- src/main/clm_driver.F90 | 3 --- 2 files changed, 1 insertion(+), 6 deletions(-) diff --git a/src/cpl/share_esmf/laiStreamMod.F90 b/src/cpl/share_esmf/laiStreamMod.F90 index b3e26b4c08..3e4074fbde 100644 --- a/src/cpl/share_esmf/laiStreamMod.F90 +++ b/src/cpl/share_esmf/laiStreamMod.F90 @@ -228,7 +228,6 @@ subroutine lai_interp(bounds, canopystate_inst) SHR_ASSERT_FL( (lbound(g_to_ig,1) <= bounds%begg ), sourcefile, __LINE__) SHR_ASSERT_FL( (ubound(g_to_ig,1) >= bounds%endg ), sourcefile, __LINE__) - ! Get pointer for stream data that is time and spatially interpolate to model time and grid ! Place all lai data from each type into a temporary 2d array @@ -246,7 +245,7 @@ subroutine lai_interp(bounds, canopystate_inst) dataptr2d(g,n) = dataptr1d(g) end do end do - + do p = bounds%begp, bounds%endp ivt = patch%itype(p) ! Set lai for each gridcell/patch combination @@ -259,7 +258,6 @@ subroutine lai_interp(bounds, canopystate_inst) canopystate_inst%tlai_patch(p) = 0._r8 endif end do - deallocate(dataptr2d) end subroutine lai_interp diff --git a/src/main/clm_driver.F90 b/src/main/clm_driver.F90 index 90d7121fdb..ae5ab704fb 100644 --- a/src/main/clm_driver.F90 +++ b/src/main/clm_driver.F90 @@ -264,9 +264,6 @@ subroutine clm_drv(doalb, nextsw_cday, declinp1, declin, rstwr, nlend, rdate, ro end if - - - ! ================================================================================== ! Determine decomp vertical profiles ! From b24e0aa02c8b5609486f97e403ca9de366cf96da Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Wed, 12 Jul 2023 14:50:02 -0600 Subject: [PATCH 094/257] Refactor some max_patch_per_col and maxsoil_pa loops --- src/biogeochem/CNCIsoFluxMod.F90 | 517 +++++++++++++----------------- src/biogeochem/CNPhenologyMod.F90 | 171 +++++----- 2 files changed, 303 insertions(+), 385 deletions(-) diff --git a/src/biogeochem/CNCIsoFluxMod.F90 b/src/biogeochem/CNCIsoFluxMod.F90 index a4706442fa..8b2f097882 100644 --- a/src/biogeochem/CNCIsoFluxMod.F90 +++ b/src/biogeochem/CNCIsoFluxMod.F90 @@ -8,7 +8,6 @@ module CNCIsoFluxMod use shr_kind_mod , only : r8 => shr_kind_r8 use shr_log_mod , only : errMsg => shr_log_errMsg use clm_varpar , only : ndecomp_cascade_transitions, nlevdecomp, ndecomp_pools - use clm_varpar , only : max_patch_per_col, maxsoil_patches use clm_varpar , only : i_litr_min, i_litr_max, i_met_lit use abortutils , only : endrun use pftconMod , only : pftcon @@ -85,7 +84,7 @@ subroutine CIsoFlux1(num_soilc, filter_soilc, num_soilp, filter_soilp, & character(len=*) , intent(in) :: isotope ! 'c13' or 'c14' ! ! !LOCAL VARIABLES: - integer :: fp,pi,l,fc,cc,j,k,p + integer :: fp,l,fc,cc,j,k,p integer :: cdp !----------------------------------------------------------------------- @@ -535,7 +534,7 @@ subroutine CIsoFlux1(num_soilc, filter_soilc, num_soilp, filter_soilp, & ! For later clean-up, it would be possible to generalize this function to operate on a single ! patch-to-column flux. - call CNCIsoLitterToColumn(num_soilc, filter_soilc, soilbiogeochem_state_inst, iso_cnveg_carbonflux_inst) + call CNCIsoLitterToColumn(num_soilp, filter_soilp, soilbiogeochem_state_inst, iso_cnveg_carbonflux_inst) ! column-level non-mortality fluxes @@ -600,7 +599,6 @@ subroutine CIsoFlux2(num_soilc, filter_soilc, num_soilp , filter_soilp, & ! ! !LOCAL VARIABLES: - integer :: fp,pi !----------------------------------------------------------------------- associate( & @@ -713,7 +711,7 @@ subroutine CIsoFlux2(num_soilc, filter_soilc, num_soilp , filter_soilp, & ! call routine to shift patch-level gap mortality fluxes to column , for isotopes ! the non-isotope version of this routine is in CNGapMortalityMod.F90. - call CNCIsoGapPftToColumn(num_soilc, filter_soilc, soilbiogeochem_state_inst, iso_cnveg_carbonflux_inst) + call CNCIsoGapPftToColumn(num_soilp, filter_soilp, soilbiogeochem_state_inst, iso_cnveg_carbonflux_inst) end associate @@ -859,7 +857,7 @@ subroutine CIsoFlux2h(num_soilc , filter_soilc, num_soilp , filter_soilp, & ! call routine to shift patch-level gap mortality fluxes to column, ! for isotopes the non-isotope version of this routine is in CNGapMortalityMod.F90. - call CNCIsoHarvestPftToColumn(num_soilc, filter_soilc, soilbiogeochem_state_inst, iso_cnveg_carbonflux_inst) + call CNCIsoHarvestPftToColumn(num_soilp, filter_soilp, soilbiogeochem_state_inst, iso_cnveg_carbonflux_inst) end associate @@ -1010,7 +1008,7 @@ subroutine CIsoFlux2g(num_soilc , filter_soilc, num_soilp , filter_soilp, & ! call routine to shift patch-level gap mortality fluxes to column, ! for isotopes the non-isotope version of this routine is in CNGapMortalityMod.F90. - call CNCIsoGrossUnrepPftToColumn(num_soilc, filter_soilc, soilbiogeochem_state_inst, iso_cnveg_carbonflux_inst) + call CNCIsoGrossUnrepPftToColumn(num_soilp, filter_soilp, soilbiogeochem_state_inst, iso_cnveg_carbonflux_inst) end associate @@ -1041,7 +1039,7 @@ subroutine CIsoFlux3(num_soilc , filter_soilc, num_soilp , filter_soilp, & character(len=*) , intent(in) :: isotope ! 'c13' or 'c14' ! ! !LOCAL VARIABLES: - integer :: pi,pp,l,fc,cc,j,i + integer :: fp,pp,l,cc,j,i !----------------------------------------------------------------------- associate( & @@ -1276,32 +1274,22 @@ subroutine CIsoFlux3(num_soilc , filter_soilc, num_soilp , filter_soilp, & ! calculate the column-level flux of deadstem and deadcrootc to cwdc as the result of fire mortality. - do pi = 1,max_patch_per_col - do fc = 1,num_soilc - cc = filter_soilc(fc) - if ( pi <= col%npatches(cc) ) then - pp = col%patchi(cc) + pi - 1 - if (patch%active(pp)) then - do j = 1, nlevdecomp - iso_cnveg_cf%fire_mortality_c_to_cwdc_col(cc,j) = & - iso_cnveg_cf%fire_mortality_c_to_cwdc_col(cc,j) + & - (iso_cnveg_cf%m_deadstemc_to_litter_fire_patch(pp) + & - iso_cnveg_cf%m_livestemc_to_litter_fire_patch(pp)) * & - patch%wtcol(pp) * stem_prof(pp,j) - iso_cnveg_cf%fire_mortality_c_to_cwdc_col(cc,j) = & - iso_cnveg_cf%fire_mortality_c_to_cwdc_col(cc,j) + & - (iso_cnveg_cf%m_deadcrootc_to_litter_fire_patch(pp) + & - iso_cnveg_cf%m_livecrootc_to_litter_fire_patch(pp)) * & - patch%wtcol(pp) * croot_prof(pp,j) - end do - end if - end if + do fp = 1,num_soilp + pp = filter_soilp(fp) + cc = patch%column(pp) + do j = 1, nlevdecomp + iso_cnveg_cf%fire_mortality_c_to_cwdc_col(cc,j) = & + iso_cnveg_cf%fire_mortality_c_to_cwdc_col(cc,j) + & + (iso_cnveg_cf%m_deadstemc_to_litter_fire_patch(pp) + & + iso_cnveg_cf%m_livestemc_to_litter_fire_patch(pp)) * & + patch%wtcol(pp) * stem_prof(pp,j) + iso_cnveg_cf%fire_mortality_c_to_cwdc_col(cc,j) = & + iso_cnveg_cf%fire_mortality_c_to_cwdc_col(cc,j) + & + (iso_cnveg_cf%m_deadcrootc_to_litter_fire_patch(pp) + & + iso_cnveg_cf%m_livecrootc_to_litter_fire_patch(pp)) * & + patch%wtcol(pp) * croot_prof(pp,j) end do - end do - - do fc = 1,num_soilc - cc = filter_soilc(fc) do j = 1, nlevdecomp do l = 1, ndecomp_pools if ( soilbiogeochem_cs%decomp_cpools_vr_col(cc,j,l) /= 0._r8) then @@ -1316,45 +1304,38 @@ subroutine CIsoFlux3(num_soilc , filter_soilc, num_soilp , filter_soilp, & end do end do - - do pi = 1,max_patch_per_col - do fc = 1,num_soilc - cc = filter_soilc(fc) - if ( pi <= col%npatches(cc) ) then - pp = col%patchi(cc) + pi - 1 - if (patch%active(pp)) then - do j = 1, nlevdecomp - iso_cnveg_cf%m_c_to_litr_fire_col(cc,j,i_met_lit) = & - iso_cnveg_cf%m_c_to_litr_fire_col(cc,j,i_met_lit) + & - ((iso_cnveg_cf%m_leafc_to_litter_fire_patch(pp) * lf_f(ivt(pp),i_met_lit) & - +iso_cnveg_cf%m_leafc_storage_to_litter_fire_patch(pp) + & - iso_cnveg_cf%m_leafc_xfer_to_litter_fire_patch(pp) + & - iso_cnveg_cf%m_gresp_storage_to_litter_fire_patch(pp) & - +iso_cnveg_cf%m_gresp_xfer_to_litter_fire_patch(pp))*leaf_prof(pp,j) + & - (iso_cnveg_cf%m_frootc_to_litter_fire_patch(pp) * fr_f(ivt(pp),i_met_lit) & - +iso_cnveg_cf%m_frootc_storage_to_litter_fire_patch(pp) + & - iso_cnveg_cf%m_frootc_xfer_to_litter_fire_patch(pp))*froot_prof(pp,j) & - +(iso_cnveg_cf%m_livestemc_storage_to_litter_fire_patch(pp) + & - iso_cnveg_cf%m_livestemc_xfer_to_litter_fire_patch(pp) & - +iso_cnveg_cf%m_deadstemc_storage_to_litter_fire_patch(pp) + & - iso_cnveg_cf%m_deadstemc_xfer_to_litter_fire_patch(pp))* stem_prof(pp,j)& - +(iso_cnveg_cf%m_livecrootc_storage_to_litter_fire_patch(pp) + & - iso_cnveg_cf%m_livecrootc_xfer_to_litter_fire_patch(pp) & - +iso_cnveg_cf%m_deadcrootc_storage_to_litter_fire_patch(pp) + & - iso_cnveg_cf%m_deadcrootc_xfer_to_litter_fire_patch(pp))* croot_prof(pp,j)) * patch%wtcol(pp) + do fp = 1,num_soilp + pp = filter_soilp(fp) + cc = patch%column(pp) + do j = 1, nlevdecomp + iso_cnveg_cf%m_c_to_litr_fire_col(cc,j,i_met_lit) = & + iso_cnveg_cf%m_c_to_litr_fire_col(cc,j,i_met_lit) + & + ((iso_cnveg_cf%m_leafc_to_litter_fire_patch(pp) * lf_f(ivt(pp),i_met_lit) & + +iso_cnveg_cf%m_leafc_storage_to_litter_fire_patch(pp) + & + iso_cnveg_cf%m_leafc_xfer_to_litter_fire_patch(pp) + & + iso_cnveg_cf%m_gresp_storage_to_litter_fire_patch(pp) & + +iso_cnveg_cf%m_gresp_xfer_to_litter_fire_patch(pp))*leaf_prof(pp,j) + & + (iso_cnveg_cf%m_frootc_to_litter_fire_patch(pp) * fr_f(ivt(pp),i_met_lit) & + +iso_cnveg_cf%m_frootc_storage_to_litter_fire_patch(pp) + & + iso_cnveg_cf%m_frootc_xfer_to_litter_fire_patch(pp))*froot_prof(pp,j) & + +(iso_cnveg_cf%m_livestemc_storage_to_litter_fire_patch(pp) + & + iso_cnveg_cf%m_livestemc_xfer_to_litter_fire_patch(pp) & + +iso_cnveg_cf%m_deadstemc_storage_to_litter_fire_patch(pp) + & + iso_cnveg_cf%m_deadstemc_xfer_to_litter_fire_patch(pp))* stem_prof(pp,j)& + +(iso_cnveg_cf%m_livecrootc_storage_to_litter_fire_patch(pp) + & + iso_cnveg_cf%m_livecrootc_xfer_to_litter_fire_patch(pp) & + +iso_cnveg_cf%m_deadcrootc_storage_to_litter_fire_patch(pp) + & + iso_cnveg_cf%m_deadcrootc_xfer_to_litter_fire_patch(pp))* croot_prof(pp,j)) * patch%wtcol(pp) - ! Here metabolic litter is treated differently than other - ! types of litter, so it remains outside this litter loop, - ! in the line above - do i = i_met_lit+1, i_litr_max - iso_cnveg_cf%m_c_to_litr_fire_col(cc,j,i) = & - iso_cnveg_cf%m_c_to_litr_fire_col(cc,j,i) + & - (iso_cnveg_cf%m_leafc_to_litter_fire_patch(pp) * lf_f(ivt(pp),i) * leaf_prof(pp,j) + & - iso_cnveg_cf%m_frootc_to_litter_fire_patch(pp) * fr_f(ivt(pp),i) * froot_prof(pp,j)) * patch%wtcol(pp) - end do - end do - end if - end if + ! Here metabolic litter is treated differently than other + ! types of litter, so it remains outside this litter loop, + ! in the line above + do i = i_met_lit+1, i_litr_max + iso_cnveg_cf%m_c_to_litr_fire_col(cc,j,i) = & + iso_cnveg_cf%m_c_to_litr_fire_col(cc,j,i) + & + (iso_cnveg_cf%m_leafc_to_litter_fire_patch(pp) * lf_f(ivt(pp),i) * leaf_prof(pp,j) + & + iso_cnveg_cf%m_frootc_to_litter_fire_patch(pp) * fr_f(ivt(pp),i) * froot_prof(pp,j)) * patch%wtcol(pp) + end do end do end do @@ -1363,7 +1344,7 @@ subroutine CIsoFlux3(num_soilc , filter_soilc, num_soilp , filter_soilp, & end subroutine CIsoFlux3 !----------------------------------------------------------------------- - subroutine CNCIsoLitterToColumn (num_soilc, filter_soilc, & + subroutine CNCIsoLitterToColumn (num_soilp, filter_soilp, & soilbiogeochem_state_inst, iso_cnveg_carbonflux_inst) ! ! !DESCRIPTION: @@ -1377,13 +1358,13 @@ subroutine CNCIsoLitterToColumn (num_soilc, filter_soilc, & !DML ! !ARGUMENTS: - integer , intent(in) :: num_soilc ! number of soil columns in filter - integer , intent(in) :: filter_soilc(:) ! filter for soil columns + integer , intent(in) :: num_soilp ! number of soil columns in filter + integer , intent(in) :: filter_soilp(:) ! filter for soil columns type(soilbiogeochem_state_type) , intent(in) :: soilbiogeochem_state_inst type(cnveg_carbonflux_type) , intent(inout) :: iso_cnveg_carbonflux_inst ! ! !LOCAL VARIABLES: - integer :: fc,c,pi,p,k,j,i + integer :: fp,c,p,k,j,i !----------------------------------------------------------------------- associate( & @@ -1405,59 +1386,50 @@ subroutine CNCIsoLitterToColumn (num_soilc, filter_soilc, & ) do j = 1, nlevdecomp - do pi = 1,max_patch_per_col - do fc = 1,num_soilc - c = filter_soilc(fc) - - if ( pi <= col%npatches(c) ) then - p = col%patchi(c) + pi - 1 - if (patch%active(p)) then - do i = i_litr_min, i_litr_max - phenology_c_to_litr_c(c,j,i) = & - phenology_c_to_litr_c(c,j,i) + & - ! leaf litter carbon fluxes - leafc_to_litter(p) * lf_f(ivt(p),i) * wtcol(p) * leaf_prof(p,j) + & - ! fine root litter carbon fluxes - frootc_to_litter(p) * fr_f(ivt(p),i) * wtcol(p) * froot_prof(p,j) - end do + do fp = 1,num_soilp + p = filter_soilp(fp) + c = patch%column(p) + + do i = i_litr_min, i_litr_max + phenology_c_to_litr_c(c,j,i) = & + phenology_c_to_litr_c(c,j,i) + & + ! leaf litter carbon fluxes + leafc_to_litter(p) * lf_f(ivt(p),i) * wtcol(p) * leaf_prof(p,j) + & + ! fine root litter carbon fluxes + frootc_to_litter(p) * fr_f(ivt(p),i) * wtcol(p) * froot_prof(p,j) + end do !DML - if (ivt(p) >= npcropmin) then ! add livestemc to litter - ! stem litter carbon fluxes - do i = i_litr_min, i_litr_max - phenology_c_to_litr_c(c,j,i) = & - phenology_c_to_litr_c(c,j,i) + & - livestemc_to_litter(p) * lf_f(ivt(p),i) * wtcol(p) * leaf_prof(p,j) - end do - - if (.not. use_grainproduct) then - ! grain litter carbon fluxes - do i = i_litr_min, i_litr_max - do k = repr_grain_min, repr_grain_max - phenology_c_to_litr_c(c,j,i) = & - phenology_c_to_litr_c(c,j,i) + & - repr_grainc_to_food(p,k) * lf_f(ivt(p),i) * wtcol(p) * leaf_prof(p,j) - end do - end do - end if - - ! reproductive structure litter carbon fluxes - do i = i_litr_min, i_litr_max - do k = repr_structure_min, repr_structure_max - phenology_c_to_litr_c(c,j,i) = & - phenology_c_to_litr_c(c,j,i) + & - repr_structurec_to_litter(p,k) * lf_f(ivt(p),i) * wtcol(p) * leaf_prof(p,j) - end do - end do - - end if -!DML - end if + if (ivt(p) >= npcropmin) then ! add livestemc to litter + ! stem litter carbon fluxes + do i = i_litr_min, i_litr_max + phenology_c_to_litr_c(c,j,i) = & + phenology_c_to_litr_c(c,j,i) + & + livestemc_to_litter(p) * lf_f(ivt(p),i) * wtcol(p) * leaf_prof(p,j) + end do + + if (.not. use_grainproduct) then + ! grain litter carbon fluxes + do i = i_litr_min, i_litr_max + do k = repr_grain_min, repr_grain_max + phenology_c_to_litr_c(c,j,i) = & + phenology_c_to_litr_c(c,j,i) + & + repr_grainc_to_food(p,k) * lf_f(ivt(p),i) * wtcol(p) * leaf_prof(p,j) + end do + end do end if - end do + ! reproductive structure litter carbon fluxes + do i = i_litr_min, i_litr_max + do k = repr_structure_min, repr_structure_max + phenology_c_to_litr_c(c,j,i) = & + phenology_c_to_litr_c(c,j,i) + & + repr_structurec_to_litter(p,k) * lf_f(ivt(p),i) * wtcol(p) * leaf_prof(p,j) + end do + end do + end if +!DML end do - end do end associate @@ -1465,7 +1437,7 @@ subroutine CNCIsoLitterToColumn (num_soilc, filter_soilc, & end subroutine CNCIsoLitterToColumn !----------------------------------------------------------------------- - subroutine CNCIsoGapPftToColumn (num_soilc, filter_soilc, & + subroutine CNCIsoGapPftToColumn (num_soilp, filter_soilp, & soilbiogeochem_state_inst, iso_cnveg_carbonflux_inst) ! ! !DESCRIPTION: @@ -1473,13 +1445,13 @@ subroutine CNCIsoGapPftToColumn (num_soilc, filter_soilc, & ! to the column level and assign them to the three litter pools (+ cwd pool) ! ! !ARGUMENTS: - integer , intent(in) :: num_soilc ! number of soil columns in filter - integer , intent(in) :: filter_soilc(:) ! soil column filter + integer , intent(in) :: num_soilp ! number of soil columns in filter + integer , intent(in) :: filter_soilp(:) ! soil column filter type(soilbiogeochem_state_type) , intent(in) :: soilbiogeochem_state_inst type(cnveg_carbonflux_type) , intent(inout) :: iso_cnveg_carbonflux_inst ! ! !LOCAL VARIABLES: - integer :: fc,c,pi,p,j,i ! indices + integer :: fp,c,p,j,i ! indices !----------------------------------------------------------------------- associate( & @@ -1520,63 +1492,53 @@ subroutine CNCIsoGapPftToColumn (num_soilc, filter_soilc, & ) do j = 1, nlevdecomp - do pi = 1,maxsoil_patches - do fc = 1,num_soilc - c = filter_soilc(fc) - - if (pi <= col%npatches(c)) then - p = col%patchi(c) + pi - 1 - - if (patch%active(p)) then - - do i = i_litr_min, i_litr_max - ! leaf gap mortality carbon fluxes - gap_mortality_c_to_litr_c(c,j,i) = & - gap_mortality_c_to_litr_c(c,j,i) + & - m_leafc_to_litter(p) * lf_f(ivt(p),i) * wtcol(p) * leaf_prof(p,j) - ! fine root gap mortality carbon fluxes - gap_mortality_c_to_litr_c(c,j,i) = & - gap_mortality_c_to_litr_c(c,j,i) + & - m_frootc_to_litter(p) * fr_f(ivt(p),i) * wtcol(p) * froot_prof(p,j) - end do - - ! wood gap mortality carbon fluxes - gap_mortality_c_to_cwdc(c,j) = gap_mortality_c_to_cwdc(c,j) + & - m_livestemc_to_litter(p) * wtcol(p) * stem_prof(p,j) - gap_mortality_c_to_cwdc(c,j) = gap_mortality_c_to_cwdc(c,j) + & - m_deadstemc_to_litter(p) * wtcol(p) * stem_prof(p,j) - gap_mortality_c_to_cwdc(c,j) = gap_mortality_c_to_cwdc(c,j) + & - m_livecrootc_to_litter(p) * wtcol(p) * croot_prof(p,j) - gap_mortality_c_to_cwdc(c,j) = gap_mortality_c_to_cwdc(c,j) + & - m_deadcrootc_to_litter(p) * wtcol(p) * croot_prof(p,j) - - ! Metabolic litter is treated differently than other types - ! of litter, so it gets this additional line after the - ! most recent loop over all litter types - gap_mortality_c_to_litr_c(c,j,i_met_lit) = & - gap_mortality_c_to_litr_c(c,j,i_met_lit) + & - ! storage gap mortality carbon fluxes - m_leafc_storage_to_litter(p) * wtcol(p) * leaf_prof(p,j) + & - m_frootc_storage_to_litter(p) * wtcol(p) * froot_prof(p,j) + & - m_livestemc_storage_to_litter(p) * wtcol(p) * stem_prof(p,j) + & - m_deadstemc_storage_to_litter(p) * wtcol(p) * stem_prof(p,j) + & - m_livecrootc_storage_to_litter(p) * wtcol(p) * croot_prof(p,j) + & - m_deadcrootc_storage_to_litter(p) * wtcol(p) * croot_prof(p,j) + & - m_gresp_storage_to_litter(p) * wtcol(p) * leaf_prof(p,j) + & - ! transfer gap mortality carbon fluxes - m_leafc_xfer_to_litter(p) * wtcol(p) * leaf_prof(p,j) + & - m_frootc_xfer_to_litter(p) * wtcol(p) * froot_prof(p,j) + & - m_livestemc_xfer_to_litter(p) * wtcol(p) * stem_prof(p,j) + & - m_deadstemc_xfer_to_litter(p) * wtcol(p) * stem_prof(p,j) + & - m_livecrootc_xfer_to_litter(p) * wtcol(p) * croot_prof(p,j) + & - m_deadcrootc_xfer_to_litter(p) * wtcol(p) * croot_prof(p,j) + & - m_gresp_xfer_to_litter(p) * wtcol(p) * leaf_prof(p,j) - - end if - end if - + do fp = 1,num_soilp + p = filter_soilp(fp) + c = patch%column(p) + + do i = i_litr_min, i_litr_max + ! leaf gap mortality carbon fluxes + gap_mortality_c_to_litr_c(c,j,i) = & + gap_mortality_c_to_litr_c(c,j,i) + & + m_leafc_to_litter(p) * lf_f(ivt(p),i) * wtcol(p) * leaf_prof(p,j) + ! fine root gap mortality carbon fluxes + gap_mortality_c_to_litr_c(c,j,i) = & + gap_mortality_c_to_litr_c(c,j,i) + & + m_frootc_to_litter(p) * fr_f(ivt(p),i) * wtcol(p) * froot_prof(p,j) end do + ! wood gap mortality carbon fluxes + gap_mortality_c_to_cwdc(c,j) = gap_mortality_c_to_cwdc(c,j) + & + m_livestemc_to_litter(p) * wtcol(p) * stem_prof(p,j) + gap_mortality_c_to_cwdc(c,j) = gap_mortality_c_to_cwdc(c,j) + & + m_deadstemc_to_litter(p) * wtcol(p) * stem_prof(p,j) + gap_mortality_c_to_cwdc(c,j) = gap_mortality_c_to_cwdc(c,j) + & + m_livecrootc_to_litter(p) * wtcol(p) * croot_prof(p,j) + gap_mortality_c_to_cwdc(c,j) = gap_mortality_c_to_cwdc(c,j) + & + m_deadcrootc_to_litter(p) * wtcol(p) * croot_prof(p,j) + + ! Metabolic litter is treated differently than other types + ! of litter, so it gets this additional line after the + ! most recent loop over all litter types + gap_mortality_c_to_litr_c(c,j,i_met_lit) = & + gap_mortality_c_to_litr_c(c,j,i_met_lit) + & + ! storage gap mortality carbon fluxes + m_leafc_storage_to_litter(p) * wtcol(p) * leaf_prof(p,j) + & + m_frootc_storage_to_litter(p) * wtcol(p) * froot_prof(p,j) + & + m_livestemc_storage_to_litter(p) * wtcol(p) * stem_prof(p,j) + & + m_deadstemc_storage_to_litter(p) * wtcol(p) * stem_prof(p,j) + & + m_livecrootc_storage_to_litter(p) * wtcol(p) * croot_prof(p,j) + & + m_deadcrootc_storage_to_litter(p) * wtcol(p) * croot_prof(p,j) + & + m_gresp_storage_to_litter(p) * wtcol(p) * leaf_prof(p,j) + & + ! transfer gap mortality carbon fluxes + m_leafc_xfer_to_litter(p) * wtcol(p) * leaf_prof(p,j) + & + m_frootc_xfer_to_litter(p) * wtcol(p) * froot_prof(p,j) + & + m_livestemc_xfer_to_litter(p) * wtcol(p) * stem_prof(p,j) + & + m_deadstemc_xfer_to_litter(p) * wtcol(p) * stem_prof(p,j) + & + m_livecrootc_xfer_to_litter(p) * wtcol(p) * croot_prof(p,j) + & + m_deadcrootc_xfer_to_litter(p) * wtcol(p) * croot_prof(p,j) + & + m_gresp_xfer_to_litter(p) * wtcol(p) * leaf_prof(p,j) + end do end do @@ -1585,7 +1547,7 @@ subroutine CNCIsoGapPftToColumn (num_soilc, filter_soilc, & end subroutine CNCIsoGapPftToColumn !----------------------------------------------------------------------- - subroutine CNCIsoHarvestPftToColumn (num_soilc, filter_soilc, & + subroutine CNCIsoHarvestPftToColumn (num_soilp, filter_soilp, & soilbiogeochem_state_inst, iso_cnveg_carbonflux_inst) ! ! !DESCRIPTION: @@ -1593,13 +1555,13 @@ subroutine CNCIsoHarvestPftToColumn (num_soilc, filter_soilc, & ! to the column level and assign them to the litter, cwd, and wood product pools ! ! !ARGUMENTS: - integer , intent(in) :: num_soilc ! number of soil columns in filter - integer , intent(in) :: filter_soilc(:) ! soil column filter + integer , intent(in) :: num_soilp ! number of soil columns in filter + integer , intent(in) :: filter_soilp(:) ! soil column filter type(soilbiogeochem_state_type) , intent(in) :: soilbiogeochem_state_inst type(cnveg_carbonflux_type) , intent(inout) :: iso_cnveg_carbonflux_inst ! ! !LOCAL VARIABLES: - integer :: fc,c,pi,p,j,i ! indices + integer :: fp,c,p,j,i ! indices !----------------------------------------------------------------------- associate( & @@ -1640,76 +1602,60 @@ subroutine CNCIsoHarvestPftToColumn (num_soilc, filter_soilc, & ) do j = 1, nlevdecomp - do pi = 1,maxsoil_patches - do fc = 1,num_soilc - c = filter_soilc(fc) + do fp = 1,num_soilp + p = filter_soilp(fp) + c = patch%column(p) - if (pi <= col%npatches(c)) then - p = col%patchi(c) + pi - 1 - - if (patch%active(p)) then - - do i = i_litr_min, i_litr_max - ! leaf harvest mortality carbon fluxes - harvest_c_to_litr_c(c,j,i) = & - harvest_c_to_litr_c(c,j,i) + & - hrv_leafc_to_litter(p) * lf_f(ivt(p),i) * wtcol(p) * leaf_prof(p,j) - - ! fine root harvest mortality carbon fluxes - harvest_c_to_litr_c(c,j,i) = & - harvest_c_to_litr_c(c,j,i) + & - hrv_frootc_to_litter(p) * fr_f(ivt(p),i) * wtcol(p) * froot_prof(p,j) - end do - - ! wood harvest mortality carbon fluxes - harvest_c_to_cwdc(c,j) = harvest_c_to_cwdc(c,j) + & - hrv_livestemc_to_litter(p) * wtcol(p) * stem_prof(p,j) - harvest_c_to_cwdc(c,j) = harvest_c_to_cwdc(c,j) + & - hrv_livecrootc_to_litter(p) * wtcol(p) * croot_prof(p,j) - harvest_c_to_cwdc(c,j) = harvest_c_to_cwdc(c,j) + & - hrv_deadcrootc_to_litter(p) * wtcol(p) * croot_prof(p,j) - - ! Metabolic litter is treated differently than other types - ! of litter, so it gets this additional line after the - ! most recent loop over all litter types - harvest_c_to_litr_c(c,j,i_met_lit) = & - harvest_c_to_litr_c(c,j,i_met_lit) + & - ! storage harvest mortality carbon fluxes - hrv_leafc_storage_to_litter(p) * wtcol(p) * leaf_prof(p,j) + & - hrv_frootc_storage_to_litter(p) * wtcol(p) * froot_prof(p,j) + & - hrv_livestemc_storage_to_litter(p) * wtcol(p) * stem_prof(p,j) + & - hrv_deadstemc_storage_to_litter(p) * wtcol(p) * stem_prof(p,j) + & - hrv_livecrootc_storage_to_litter(p) * wtcol(p) * croot_prof(p,j) + & - hrv_deadcrootc_storage_to_litter(p) * wtcol(p) * croot_prof(p,j) + & - hrv_gresp_storage_to_litter(p) * wtcol(p) * leaf_prof(p,j) + & - ! transfer harvest mortality carbon fluxes - hrv_leafc_xfer_to_litter(p) * wtcol(p) * leaf_prof(p,j) + & - hrv_frootc_xfer_to_litter(p) * wtcol(p) * froot_prof(p,j) + & - hrv_livestemc_xfer_to_litter(p) * wtcol(p) * stem_prof(p,j) + & - hrv_deadstemc_xfer_to_litter(p) * wtcol(p) * stem_prof(p,j) + & - hrv_livecrootc_xfer_to_litter(p) * wtcol(p) * croot_prof(p,j) + & - hrv_deadcrootc_xfer_to_litter(p) * wtcol(p) * croot_prof(p,j) + & - hrv_gresp_xfer_to_litter(p) * wtcol(p) * leaf_prof(p,j) - end if - end if - + do i = i_litr_min, i_litr_max + ! leaf harvest mortality carbon fluxes + harvest_c_to_litr_c(c,j,i) = & + harvest_c_to_litr_c(c,j,i) + & + hrv_leafc_to_litter(p) * lf_f(ivt(p),i) * wtcol(p) * leaf_prof(p,j) + + ! fine root harvest mortality carbon fluxes + harvest_c_to_litr_c(c,j,i) = & + harvest_c_to_litr_c(c,j,i) + & + hrv_frootc_to_litter(p) * fr_f(ivt(p),i) * wtcol(p) * froot_prof(p,j) end do + ! wood harvest mortality carbon fluxes + harvest_c_to_cwdc(c,j) = harvest_c_to_cwdc(c,j) + & + hrv_livestemc_to_litter(p) * wtcol(p) * stem_prof(p,j) + harvest_c_to_cwdc(c,j) = harvest_c_to_cwdc(c,j) + & + hrv_livecrootc_to_litter(p) * wtcol(p) * croot_prof(p,j) + harvest_c_to_cwdc(c,j) = harvest_c_to_cwdc(c,j) + & + hrv_deadcrootc_to_litter(p) * wtcol(p) * croot_prof(p,j) + + ! Metabolic litter is treated differently than other types + ! of litter, so it gets this additional line after the + ! most recent loop over all litter types + harvest_c_to_litr_c(c,j,i_met_lit) = & + harvest_c_to_litr_c(c,j,i_met_lit) + & + ! storage harvest mortality carbon fluxes + hrv_leafc_storage_to_litter(p) * wtcol(p) * leaf_prof(p,j) + & + hrv_frootc_storage_to_litter(p) * wtcol(p) * froot_prof(p,j) + & + hrv_livestemc_storage_to_litter(p) * wtcol(p) * stem_prof(p,j) + & + hrv_deadstemc_storage_to_litter(p) * wtcol(p) * stem_prof(p,j) + & + hrv_livecrootc_storage_to_litter(p) * wtcol(p) * croot_prof(p,j) + & + hrv_deadcrootc_storage_to_litter(p) * wtcol(p) * croot_prof(p,j) + & + hrv_gresp_storage_to_litter(p) * wtcol(p) * leaf_prof(p,j) + & + ! transfer harvest mortality carbon fluxes + hrv_leafc_xfer_to_litter(p) * wtcol(p) * leaf_prof(p,j) + & + hrv_frootc_xfer_to_litter(p) * wtcol(p) * froot_prof(p,j) + & + hrv_livestemc_xfer_to_litter(p) * wtcol(p) * stem_prof(p,j) + & + hrv_deadstemc_xfer_to_litter(p) * wtcol(p) * stem_prof(p,j) + & + hrv_livecrootc_xfer_to_litter(p) * wtcol(p) * croot_prof(p,j) + & + hrv_deadcrootc_xfer_to_litter(p) * wtcol(p) * croot_prof(p,j) + & + hrv_gresp_xfer_to_litter(p) * wtcol(p) * leaf_prof(p,j) + end do end do - do pi = 1,maxsoil_patches - do fc = 1,num_soilc - c = filter_soilc(fc) - if (pi <= col%npatches(c)) then - p = col%patchi(c) + pi - 1 - - if (patch%active(p)) then - cwood_harvestc(c) = cwood_harvestc(c) + & - pwood_harvestc(p) * wtcol(p) - end if - end if - end do + do fp = 1,num_soilp + p = filter_soilp(fp) + c = patch%column(p) + cwood_harvestc(c) = cwood_harvestc(c) + & + pwood_harvestc(p) * wtcol(p) end do end associate @@ -1717,7 +1663,7 @@ subroutine CNCIsoHarvestPftToColumn (num_soilc, filter_soilc, & end subroutine CNCIsoHarvestPftToColumn !----------------------------------------------------------------------- - subroutine CNCIsoGrossUnrepPftToColumn (num_soilc, filter_soilc, & + subroutine CNCIsoGrossUnrepPftToColumn (num_soilp, filter_soilp, & soilbiogeochem_state_inst, iso_cnveg_carbonflux_inst) ! ! !DESCRIPTION: @@ -1725,13 +1671,13 @@ subroutine CNCIsoGrossUnrepPftToColumn (num_soilc, filter_soilc, & ! to the column level and assign them to the litter, cwd, and wood product pools ! ! !ARGUMENTS: - integer , intent(in) :: num_soilc ! number of soil columns in filter - integer , intent(in) :: filter_soilc(:) ! soil column filter + integer , intent(in) :: num_soilp ! number of soil columns in filter + integer , intent(in) :: filter_soilp(:) ! soil column filter type(soilbiogeochem_state_type) , intent(in) :: soilbiogeochem_state_inst type(cnveg_carbonflux_type) , intent(inout) :: iso_cnveg_carbonflux_inst ! ! !LOCAL VARIABLES: - integer :: fc,c,pi,p,j,i ! indices + integer :: fp,c,p,j,i ! indices !----------------------------------------------------------------------- associate( & @@ -1774,54 +1720,35 @@ subroutine CNCIsoGrossUnrepPftToColumn (num_soilc, filter_soilc, & ) do j = 1, nlevdecomp - do pi = 1,maxsoil_patches - do fc = 1,num_soilc - c = filter_soilc(fc) - - if (pi <= col%npatches(c)) then - p = col%patchi(c) + pi - 1 - - if (patch%active(p)) then - - do i = i_litr_min, i_litr_max - gru_c_to_litr_c(c,j,i) = & - gru_c_to_litr_c(c,j,i) + & - ! leaf gross unrepresented landcover change mortality carbon fluxes - gru_leafc_to_litter(p) * lf_f(ivt(p),i) * wtcol(p) * leaf_prof(p,j) + & - ! fine root gross unrepresented landcover change mortality carbon fluxes - gru_frootc_to_litter(p) * fr_f(ivt(p),i) * wtcol(p) * froot_prof(p,j) - end do - - ! coarse root gross unrepresented landcover change mortality carbon fluxes - gru_c_to_cwdc_c(c,j) = gru_c_to_cwdc_c(c,j) + & - gru_livecrootc_to_litter(p) * wtcol(p) * croot_prof(p,j) - gru_c_to_cwdc_c(c,j) = gru_c_to_cwdc_c(c,j) + & - gru_deadcrootc_to_litter(p) * wtcol(p) * croot_prof(p,j) - - end if - end if - + do fp = 1,num_soilp + p = filter_soilp(fp) + c = patch%column(p) + + do i = i_litr_min, i_litr_max + gru_c_to_litr_c(c,j,i) = & + gru_c_to_litr_c(c,j,i) + & + ! leaf gross unrepresented landcover change mortality carbon fluxes + gru_leafc_to_litter(p) * lf_f(ivt(p),i) * wtcol(p) * leaf_prof(p,j) + & + ! fine root gross unrepresented landcover change mortality carbon fluxes + gru_frootc_to_litter(p) * fr_f(ivt(p),i) * wtcol(p) * froot_prof(p,j) end do + ! coarse root gross unrepresented landcover change mortality carbon fluxes + gru_c_to_cwdc_c(c,j) = gru_c_to_cwdc_c(c,j) + & + gru_livecrootc_to_litter(p) * wtcol(p) * croot_prof(p,j) + gru_c_to_cwdc_c(c,j) = gru_c_to_cwdc_c(c,j) + & + gru_deadcrootc_to_litter(p) * wtcol(p) * croot_prof(p,j) + end do end do - do pi = 1,maxsoil_patches - do fc = 1,num_soilc - c = filter_soilc(fc) - - if (pi <= col%npatches(c)) then - p = col%patchi(c) + pi - 1 + do fp = 1,num_soilp + p = filter_soilp(fp) + c = patch%column(p) - if (patch%active(p)) then - ! wood gross unrepresented landcover change mortality carbon fluxes to product pools - gru_wood_productc_gain_c(c) = gru_wood_productc_gain_c(c) + & - gru_wood_productc_gain(p) * wtcol(p) - - end if - end if - - end do + ! wood gross unrepresented landcover change mortality carbon fluxes to product pools + gru_wood_productc_gain_c(c) = gru_wood_productc_gain_c(c) + & + gru_wood_productc_gain(p) * wtcol(p) end do diff --git a/src/biogeochem/CNPhenologyMod.F90 b/src/biogeochem/CNPhenologyMod.F90 index ec04fcbf54..2b861c5f62 100644 --- a/src/biogeochem/CNPhenologyMod.F90 +++ b/src/biogeochem/CNPhenologyMod.F90 @@ -406,7 +406,7 @@ subroutine CNPhenology (bounds, num_soilc, filter_soilc, num_soilp, & ! gather all patch-level litterfall fluxes to the column for litter C and N inputs - call CNLitterToColumn(bounds, num_soilc, filter_soilc, & + call CNLitterToColumn(bounds, num_soilp, filter_soilp, & cnveg_state_inst, cnveg_carbonflux_inst, cnveg_nitrogenflux_inst, & leaf_prof_patch(bounds%begp:bounds%endp,1:nlevdecomp_full), & froot_prof_patch(bounds%begp:bounds%endp,1:nlevdecomp_full)) @@ -534,7 +534,7 @@ subroutine CNPhenologyClimate (num_soilp, filter_soilp, num_pcropp, filter_pcrop ! ! !LOCAL VARIABLES: integer :: p ! indices - integer :: fp ! lake filter patch index + integer :: fp ! filter patch index real(r8) :: dayspyr ! days per year (days) integer :: kyr ! current year integer :: kmo ! month of year (1, ..., 12) @@ -631,7 +631,7 @@ subroutine CNEvergreenPhenology (num_soilp, filter_soilp , & ! !LOCAL VARIABLES: real(r8):: avg_dayspyr ! Average days per year integer :: p ! indices - integer :: fp ! lake filter patch index + integer :: fp ! filter patch index real(r8):: tranr real(r8):: t1 ! temporary variable @@ -816,7 +816,7 @@ subroutine CNSeasonDecidPhenology (num_soilp, filter_soilp , & ! ! !LOCAL VARIABLES: integer :: g,c,p !indices - integer :: fp !lake filter patch index + integer :: fp !filter patch index real(r8):: ws_flag !winter-summer solstice flag (0 or 1) real(r8):: crit_onset_gdd !critical onset growing degree-day sum real(r8):: crit_daylat !latitudinal light gradient in arctic-boreal @@ -1272,7 +1272,7 @@ subroutine CNStressDecidPhenology (num_soilp, filter_soilp , & ! !LOCAL VARIABLES: real(r8),parameter :: secspqtrday = secspday / 4 ! seconds per quarter day integer :: g,c,p ! indices - integer :: fp ! lake filter patch index + integer :: fp ! filter patch index real(r8):: avg_dayspyr ! average days per year real(r8):: crit_onset_gdd ! degree days for onset trigger real(r8):: soilt ! temperature of top soil layer @@ -2565,7 +2565,7 @@ subroutine CNOnsetGrowth (num_soilp, filter_soilp, & ! ! !LOCAL VARIABLES: integer :: p ! indices - integer :: fp ! lake filter patch index + integer :: fp ! filter patch index real(r8):: t1 ! temporary variable !----------------------------------------------------------------------- @@ -2699,7 +2699,7 @@ subroutine CNOffsetLitterfall (num_soilp, filter_soilp, & ! ! !LOCAL VARIABLES: integer :: p, c, k ! indices - integer :: fp ! lake filter patch index + integer :: fp ! filter patch index real(r8):: t1 ! temporary variable real(r8):: denom ! temporary variable for divisor real(r8) :: ntovr_leaf @@ -3032,7 +3032,7 @@ subroutine CNBackgroundLitterfall (num_soilp, filter_soilp, & ! ! !LOCAL VARIABLES: integer :: p ! indices - integer :: fp ! lake filter patch index + integer :: fp ! filter patch index real(r8) :: fr_leafn_to_litter ! fraction of the nitrogen turnover that goes to litter; remaining fraction is retranslocated real(r8) :: ntovr_leaf real(r8) :: denom @@ -3189,7 +3189,7 @@ subroutine CNLivewoodTurnover (num_soilp, filter_soilp, & ! ! !LOCAL VARIABLES: integer :: p ! indices - integer :: fp ! lake filter patch index + integer :: fp ! filter patch index real(r8):: ctovr ! temporary variable for carbon turnover real(r8):: ntovr ! temporary variable for nitrogen turnover !----------------------------------------------------------------------- @@ -3383,7 +3383,7 @@ subroutine CNCropHarvestToProductPools(bounds, num_soilp, filter_soilp, num_soil end subroutine CNCropHarvestToProductPools !----------------------------------------------------------------------- - subroutine CNLitterToColumn (bounds, num_soilc, filter_soilc, & + subroutine CNLitterToColumn (bounds, num_soilp, filter_soilp, & cnveg_state_inst,cnveg_carbonflux_inst, cnveg_nitrogenflux_inst, & leaf_prof_patch, froot_prof_patch) ! @@ -3392,14 +3392,14 @@ subroutine CNLitterToColumn (bounds, num_soilc, filter_soilc, & ! to the column level and assign them to the three litter pools ! ! !USES: - use clm_varpar , only : max_patch_per_col, nlevdecomp + use clm_varpar , only : nlevdecomp use pftconMod , only : npcropmin use clm_varctl , only : use_grainproduct ! ! !ARGUMENTS: type(bounds_type) , intent(in) :: bounds - integer , intent(in) :: num_soilc ! number of soil columns in filter - integer , intent(in) :: filter_soilc(:) ! filter for soil columns + integer , intent(in) :: num_soilp ! number of soil patches in filter + integer , intent(in) :: filter_soilp(:) ! filter for soil patches type(cnveg_state_type) , intent(in) :: cnveg_state_inst type(cnveg_carbonflux_type) , intent(inout) :: cnveg_carbonflux_inst type(cnveg_nitrogenflux_type) , intent(inout) :: cnveg_nitrogenflux_inst @@ -3407,7 +3407,7 @@ subroutine CNLitterToColumn (bounds, num_soilc, filter_soilc, & real(r8) , intent(in) :: froot_prof_patch(bounds%begp:,1:) ! ! !LOCAL VARIABLES: - integer :: fc,c,pi,p,k,j,i ! indices + integer :: fp,c,p,k,j,i ! indices !----------------------------------------------------------------------- SHR_ASSERT_ALL_FL((ubound(leaf_prof_patch) == (/bounds%endp,nlevdecomp_full/)), sourcefile, __LINE__) @@ -3439,89 +3439,80 @@ subroutine CNLitterToColumn (bounds, num_soilc, filter_soilc, & ) do j = 1, nlevdecomp - do pi = 1,max_patch_per_col - do fc = 1,num_soilc - c = filter_soilc(fc) - - if ( pi <= col%npatches(c) ) then - p = col%patchi(c) + pi - 1 - if (patch%active(p)) then - - do i = i_litr_min, i_litr_max - ! leaf litter carbon fluxes - phenology_c_to_litr_c(c,j,i) = & - phenology_c_to_litr_c(c,j,i) + & - leafc_to_litter(p) * lf_f(ivt(p),i) * wtcol(p) * leaf_prof(p,j) - - ! leaf litter nitrogen fluxes - phenology_n_to_litr_n(c,j,i) = & - phenology_n_to_litr_n(c,j,i) + & - leafn_to_litter(p) * lf_f(ivt(p),i) * wtcol(p) * leaf_prof(p,j) + do fp = 1,num_soilp + p = filter_soilp(fp) + c = patch%column(p) + + do i = i_litr_min, i_litr_max + ! leaf litter carbon fluxes + phenology_c_to_litr_c(c,j,i) = & + phenology_c_to_litr_c(c,j,i) + & + leafc_to_litter(p) * lf_f(ivt(p),i) * wtcol(p) * leaf_prof(p,j) + + ! leaf litter nitrogen fluxes + phenology_n_to_litr_n(c,j,i) = & + phenology_n_to_litr_n(c,j,i) + & + leafn_to_litter(p) * lf_f(ivt(p),i) * wtcol(p) * leaf_prof(p,j) + + ! fine root litter carbon fluxes + phenology_c_to_litr_c(c,j,i) = & + phenology_c_to_litr_c(c,j,i) + & + frootc_to_litter(p) * fr_f(ivt(p),i) * wtcol(p) * froot_prof(p,j) + + ! fine root litter nitrogen fluxes + phenology_n_to_litr_n(c,j,i) = & + phenology_n_to_litr_n(c,j,i) + & + frootn_to_litter(p) * fr_f(ivt(p),i) * wtcol(p) * froot_prof(p,j) + end do - ! fine root litter carbon fluxes + ! agroibis puts crop stem litter together with leaf litter + ! so I've used the leaf lf_f* parameters instead of making + ! new ones for now (slevis) + ! also for simplicity I've put "food" into the litter pools + + if (ivt(p) >= npcropmin) then ! add livestemc to litter + do i = i_litr_min, i_litr_max + ! stem litter carbon fluxes + phenology_c_to_litr_c(c,j,i) = & + phenology_c_to_litr_c(c,j,i) + & + livestemc_to_litter(p) * lf_f(ivt(p),i) * wtcol(p) * leaf_prof(p,j) + + ! stem litter nitrogen fluxes + phenology_n_to_litr_n(c,j,i) = & + phenology_n_to_litr_n(c,j,i) + & + livestemn_to_litter(p) * lf_f(ivt(p),i) * wtcol(p) * leaf_prof(p,j) + end do + + if (.not. use_grainproduct) then + do i = i_litr_min, i_litr_max + do k = repr_grain_min, repr_grain_max + ! grain litter carbon fluxes phenology_c_to_litr_c(c,j,i) = & - phenology_c_to_litr_c(c,j,i) + & - frootc_to_litter(p) * fr_f(ivt(p),i) * wtcol(p) * froot_prof(p,j) + phenology_c_to_litr_c(c,j,i) + & + repr_grainc_to_food(p,k) * lf_f(ivt(p),i) * wtcol(p) * leaf_prof(p,j) - ! fine root litter nitrogen fluxes + ! grain litter nitrogen fluxes phenology_n_to_litr_n(c,j,i) = & - phenology_n_to_litr_n(c,j,i) + & - frootn_to_litter(p) * fr_f(ivt(p),i) * wtcol(p) * froot_prof(p,j) + phenology_n_to_litr_n(c,j,i) + & + repr_grainn_to_food(p,k) * lf_f(ivt(p),i) * wtcol(p) * leaf_prof(p,j) end do - - ! agroibis puts crop stem litter together with leaf litter - ! so I've used the leaf lf_f* parameters instead of making - ! new ones for now (slevis) - ! also for simplicity I've put "food" into the litter pools - - if (ivt(p) >= npcropmin) then ! add livestemc to litter - do i = i_litr_min, i_litr_max - ! stem litter carbon fluxes - phenology_c_to_litr_c(c,j,i) = & - phenology_c_to_litr_c(c,j,i) + & - livestemc_to_litter(p) * lf_f(ivt(p),i) * wtcol(p) * leaf_prof(p,j) - - ! stem litter nitrogen fluxes - phenology_n_to_litr_n(c,j,i) = & - phenology_n_to_litr_n(c,j,i) + & - livestemn_to_litter(p) * lf_f(ivt(p),i) * wtcol(p) * leaf_prof(p,j) - end do - - if (.not. use_grainproduct) then - do i = i_litr_min, i_litr_max - do k = repr_grain_min, repr_grain_max - ! grain litter carbon fluxes - phenology_c_to_litr_c(c,j,i) = & - phenology_c_to_litr_c(c,j,i) + & - repr_grainc_to_food(p,k) * lf_f(ivt(p),i) * wtcol(p) * leaf_prof(p,j) - - ! grain litter nitrogen fluxes - phenology_n_to_litr_n(c,j,i) = & - phenology_n_to_litr_n(c,j,i) + & - repr_grainn_to_food(p,k) * lf_f(ivt(p),i) * wtcol(p) * leaf_prof(p,j) - end do - end do - end if - - do i = i_litr_min, i_litr_max - do k = repr_structure_min, repr_structure_max - ! reproductive structure litter carbon fluxes - phenology_c_to_litr_c(c,j,i) = & - phenology_c_to_litr_c(c,j,i) + & - repr_structurec_to_litter(p,k) * lf_f(ivt(p),i) * wtcol(p) * leaf_prof(p,j) - - ! reproductive structure litter nitrogen fluxes - phenology_n_to_litr_n(c,j,i) = & - phenology_n_to_litr_n(c,j,i) + & - repr_structuren_to_litter(p,k) * lf_f(ivt(p),i) * wtcol(p) * leaf_prof(p,j) - end do - end do - end if - end if + end do end if - end do - + do i = i_litr_min, i_litr_max + do k = repr_structure_min, repr_structure_max + ! reproductive structure litter carbon fluxes + phenology_c_to_litr_c(c,j,i) = & + phenology_c_to_litr_c(c,j,i) + & + repr_structurec_to_litter(p,k) * lf_f(ivt(p),i) * wtcol(p) * leaf_prof(p,j) + + ! reproductive structure litter nitrogen fluxes + phenology_n_to_litr_n(c,j,i) = & + phenology_n_to_litr_n(c,j,i) + & + repr_structuren_to_litter(p,k) * lf_f(ivt(p),i) * wtcol(p) * leaf_prof(p,j) + end do + end do + end if end do end do From 701b50405ce45aa68da897300cfe395314e67d5d Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Thu, 13 Jul 2023 10:14:46 -0600 Subject: [PATCH 095/257] Refactor more max_patch_per_col and maxsoil_patches loops --- src/biogeochem/CNCIsoFluxMod.F90 | 16 +- src/biogeochem/CNDriverMod.F90 | 22 +- src/biogeochem/CNGapMortalityMod.F90 | 157 ++++++------- src/biogeophys/SoilFluxesMod.F90 | 2 +- src/biogeophys/SoilTemperatureMod.F90 | 209 ++++++++--------- src/biogeophys/SoilWaterMovementMod.F90 | 4 +- src/biogeophys/SoilWaterPlantSinkMod.F90 | 88 +++---- src/dyn_subgrid/dynGrossUnrepMod.F90 | 118 ++++------ src/dyn_subgrid/dynHarvestMod.F90 | 216 ++++++++---------- src/main/clm_driver.F90 | 1 + src/main/clm_varpar.F90 | 8 - .../SoilBiogeochemVerticalProfileMod.F90 | 17 +- 12 files changed, 383 insertions(+), 475 deletions(-) diff --git a/src/biogeochem/CNCIsoFluxMod.F90 b/src/biogeochem/CNCIsoFluxMod.F90 index 8b2f097882..9d55ea7ef9 100644 --- a/src/biogeochem/CNCIsoFluxMod.F90 +++ b/src/biogeochem/CNCIsoFluxMod.F90 @@ -577,7 +577,7 @@ subroutine CIsoFlux1(num_soilc, filter_soilc, num_soilp, filter_soilp, & end subroutine CIsoFlux1 !----------------------------------------------------------------------- - subroutine CIsoFlux2(num_soilc, filter_soilc, num_soilp , filter_soilp, & + subroutine CIsoFlux2(num_soilp, filter_soilp, & soilbiogeochem_state_inst, & cnveg_carbonflux_inst, cnveg_carbonstate_inst, & iso_cnveg_carbonflux_inst, iso_cnveg_carbonstate_inst, isotope) @@ -586,8 +586,6 @@ subroutine CIsoFlux2(num_soilc, filter_soilc, num_soilp , filter_soilp, & ! On the radiation time step, set the carbon isotopic fluxes for gap mortality ! ! !ARGUMENTS: - integer , intent(in) :: num_soilc ! number of soil columns filter - integer , intent(in) :: filter_soilc(:) ! filter for soil columns integer , intent(in) :: num_soilp ! number of soil patches in filter integer , intent(in) :: filter_soilp(:) ! filter for soil patches type(soilbiogeochem_state_type) , intent(in) :: soilbiogeochem_state_inst @@ -718,7 +716,7 @@ subroutine CIsoFlux2(num_soilc, filter_soilc, num_soilp , filter_soilp, & end subroutine CIsoFlux2 !----------------------------------------------------------------------- - subroutine CIsoFlux2h(num_soilc , filter_soilc, num_soilp , filter_soilp, & + subroutine CIsoFlux2h(num_soilp, filter_soilp, & soilbiogeochem_state_inst, & cnveg_carbonflux_inst, cnveg_carbonstate_inst, & iso_cnveg_carbonflux_inst, iso_cnveg_carbonstate_inst, isotope) @@ -727,8 +725,6 @@ subroutine CIsoFlux2h(num_soilc , filter_soilc, num_soilp , filter_soilp, & ! set the carbon isotopic fluxes for harvest mortality ! ! !ARGUMENTS: - integer , intent(in) :: num_soilc ! number of soil columns filter - integer , intent(in) :: filter_soilc(:) ! filter for soil columns integer , intent(in) :: num_soilp ! number of soil patches in filter integer , intent(in) :: filter_soilp(:) ! filter for soil patches type(soilbiogeochem_state_type) , intent(in) :: soilbiogeochem_state_inst @@ -864,7 +860,7 @@ subroutine CIsoFlux2h(num_soilc , filter_soilc, num_soilp , filter_soilp, & end subroutine CIsoFlux2h !----------------------------------------------------------------------- - subroutine CIsoFlux2g(num_soilc , filter_soilc, num_soilp , filter_soilp, & + subroutine CIsoFlux2g(num_soilp, filter_soilp, & soilbiogeochem_state_inst, & cnveg_carbonflux_inst, cnveg_carbonstate_inst, & iso_cnveg_carbonflux_inst, iso_cnveg_carbonstate_inst, isotope) @@ -873,8 +869,6 @@ subroutine CIsoFlux2g(num_soilc , filter_soilc, num_soilp , filter_soilp, & ! set the carbon isotopic fluxes for gross unrepresented landcover change mortality ! ! !ARGUMENTS: - integer , intent(in) :: num_soilc ! number of soil columns filter - integer , intent(in) :: filter_soilc(:) ! filter for soil columns integer , intent(in) :: num_soilp ! number of soil patches in filter integer , intent(in) :: filter_soilp(:) ! filter for soil patches type(soilbiogeochem_state_type) , intent(in) :: soilbiogeochem_state_inst @@ -1015,7 +1009,7 @@ subroutine CIsoFlux2g(num_soilc , filter_soilc, num_soilp , filter_soilp, & end subroutine CIsoFlux2g !----------------------------------------------------------------------- - subroutine CIsoFlux3(num_soilc , filter_soilc, num_soilp , filter_soilp, & + subroutine CIsoFlux3(num_soilp, filter_soilp, & soilbiogeochem_state_inst , soilbiogeochem_carbonstate_inst, & cnveg_carbonflux_inst, cnveg_carbonstate_inst, & iso_cnveg_carbonflux_inst, iso_cnveg_carbonstate_inst, & @@ -1025,8 +1019,6 @@ subroutine CIsoFlux3(num_soilc , filter_soilc, num_soilp , filter_soilp, & ! On the radiation time step, set the carbon isotopic fluxes for fire mortality ! ! !ARGUMENTS: - integer , intent(in) :: num_soilc ! number of soil columns filter - integer , intent(in) :: filter_soilc(:) ! filter for soil columns integer , intent(in) :: num_soilp ! number of soil patches in filter integer , intent(in) :: filter_soilp(:) ! filter for soil patches type(soilbiogeochem_state_type) , intent(in) :: soilbiogeochem_state_inst diff --git a/src/biogeochem/CNDriverMod.F90 b/src/biogeochem/CNDriverMod.F90 index 425c32e084..ba1e205d7c 100644 --- a/src/biogeochem/CNDriverMod.F90 +++ b/src/biogeochem/CNDriverMod.F90 @@ -681,7 +681,7 @@ subroutine CNDriverNoLeaching(bounds, call t_startf('CNGapMortality') - call CNGapMortality (bounds, num_soilc, filter_soilc, num_soilp, filter_soilp, & + call CNGapMortality (bounds, num_soilp, filter_soilp, & dgvs_inst, cnveg_carbonstate_inst, cnveg_nitrogenstate_inst, soilbiogeochem_nitrogenflux_inst, & cnveg_carbonflux_inst, cnveg_nitrogenflux_inst, canopystate_inst, & !cnveg_carbonflux_inst, cnveg_nitrogenflux_inst, & @@ -703,14 +703,14 @@ subroutine CNDriverNoLeaching(bounds, ! Set the carbon isotopic fluxes for gap mortality if ( use_c13 ) then - call CIsoFlux2(num_soilc, filter_soilc, num_soilp, filter_soilp, & + call CIsoFlux2(num_soilp, filter_soilp, & soilbiogeochem_state_inst, cnveg_carbonflux_inst, cnveg_carbonstate_inst, & iso_cnveg_carbonflux_inst=c13_cnveg_carbonflux_inst, & iso_cnveg_carbonstate_inst=c13_cnveg_carbonstate_inst, & isotope='c13') end if if ( use_c14 ) then - call CIsoFlux2(num_soilc, filter_soilc, num_soilp, filter_soilp, & + call CIsoFlux2(num_soilp, filter_soilp, & soilbiogeochem_state_inst, cnveg_carbonflux_inst, cnveg_carbonstate_inst, & iso_cnveg_carbonflux_inst=c14_cnveg_carbonflux_inst, & iso_cnveg_carbonstate_inst=c14_cnveg_carbonstate_inst, & @@ -746,20 +746,20 @@ subroutine CNDriverNoLeaching(bounds, ! Set harvest mortality routine if (get_do_harvest()) then - call CNHarvest(num_soilc, filter_soilc, num_soilp, filter_soilp, & + call CNHarvest(num_soilp, filter_soilp, & soilbiogeochem_state_inst, cnveg_carbonstate_inst, cnveg_nitrogenstate_inst, & cnveg_carbonflux_inst, cnveg_nitrogenflux_inst) end if if ( use_c13 ) then - call CIsoFlux2h(num_soilc, filter_soilc, num_soilp, filter_soilp, & + call CIsoFlux2h(num_soilp, filter_soilp, & soilbiogeochem_state_inst, & cnveg_carbonflux_inst, cnveg_carbonstate_inst, & c13_cnveg_carbonflux_inst, c13_cnveg_carbonstate_inst, & isotope='c13') end if if ( use_c14 ) then - call CIsoFlux2h(num_soilc, filter_soilc, num_soilp, filter_soilp, & + call CIsoFlux2h(num_soilp, filter_soilp, & soilbiogeochem_state_inst, & cnveg_carbonflux_inst, cnveg_carbonstate_inst, & c14_cnveg_carbonflux_inst, c14_cnveg_carbonstate_inst, & @@ -790,20 +790,20 @@ subroutine CNDriverNoLeaching(bounds, ! Set gross unrepresented landcover change mortality routine if (get_do_grossunrep()) then - call CNGrossUnrep(num_soilc, filter_soilc, num_soilp, filter_soilp, & + call CNGrossUnrep(num_soilp, filter_soilp, & soilbiogeochem_state_inst, cnveg_carbonstate_inst, cnveg_nitrogenstate_inst, & cnveg_carbonflux_inst, cnveg_nitrogenflux_inst) end if if ( use_c13 ) then - call CIsoFlux2g(num_soilc, filter_soilc, num_soilp, filter_soilp, & + call CIsoFlux2g(num_soilp, filter_soilp, & soilbiogeochem_state_inst, & cnveg_carbonflux_inst, cnveg_carbonstate_inst, & c13_cnveg_carbonflux_inst, c13_cnveg_carbonstate_inst, & isotope='c13') end if if ( use_c14 ) then - call CIsoFlux2g(num_soilc, filter_soilc, num_soilp, filter_soilp, & + call CIsoFlux2g(num_soilp, filter_soilp, & soilbiogeochem_state_inst, & cnveg_carbonflux_inst, cnveg_carbonstate_inst, & c14_cnveg_carbonflux_inst, c14_cnveg_carbonstate_inst, & @@ -915,7 +915,7 @@ subroutine CNDriverNoLeaching(bounds, call t_startf('CNUpdate3') if ( use_c13 ) then - call CIsoFlux3(num_soilc, filter_soilc, num_soilp, filter_soilp, & + call CIsoFlux3(num_soilp, filter_soilp, & soilbiogeochem_state_inst , soilbiogeochem_carbonstate_inst, & cnveg_carbonflux_inst, cnveg_carbonstate_inst, & c13_cnveg_carbonflux_inst, c13_cnveg_carbonstate_inst, & @@ -923,7 +923,7 @@ subroutine CNDriverNoLeaching(bounds, isotope='c13') end if if ( use_c14 ) then - call CIsoFlux3(num_soilc, filter_soilc, num_soilp, filter_soilp, & + call CIsoFlux3(num_soilp, filter_soilp, & soilbiogeochem_state_inst , soilbiogeochem_carbonstate_inst, & cnveg_carbonflux_inst, cnveg_carbonstate_inst, & c14_cnveg_carbonflux_inst, c14_cnveg_carbonstate_inst, & diff --git a/src/biogeochem/CNGapMortalityMod.F90 b/src/biogeochem/CNGapMortalityMod.F90 index 91c937f655..16f787bf37 100644 --- a/src/biogeochem/CNGapMortalityMod.F90 +++ b/src/biogeochem/CNGapMortalityMod.F90 @@ -82,7 +82,7 @@ subroutine readParams ( ncid ) end subroutine readParams !----------------------------------------------------------------------- - subroutine CNGapMortality (bounds, num_soilc, filter_soilc, num_soilp, filter_soilp, & + subroutine CNGapMortality (bounds, num_soilp, filter_soilp, & dgvs_inst, cnveg_carbonstate_inst, cnveg_nitrogenstate_inst, soilbiogeochem_nitrogenflux_inst,& cnveg_carbonflux_inst, cnveg_nitrogenflux_inst, canopystate_inst, & leaf_prof_patch, froot_prof_patch, croot_prof_patch, stem_prof_patch) @@ -99,8 +99,6 @@ subroutine CNGapMortality (bounds, num_soilc, filter_soilc, num_soilp, filter_so ! ! !ARGUMENTS: type(bounds_type) , intent(in) :: bounds - integer , intent(in) :: num_soilc ! number of soil columns in filter - integer , intent(in) :: filter_soilc(:) ! column filter for soil points integer , intent(in) :: num_soilp ! number of soil patches in filter integer , intent(in) :: filter_soilp(:) ! patch filter for soil points type(dgvs_type) , intent(inout) :: dgvs_inst @@ -306,7 +304,7 @@ subroutine CNGapMortality (bounds, num_soilc, filter_soilc, num_soilp, filter_so ! gather all patch-level litterfall fluxes to the column ! for litter C and N inputs - call CNGap_PatchToColumn(bounds, num_soilc, filter_soilc, & + call CNGap_PatchToColumn(bounds, num_soilp, filter_soilp, & cnveg_carbonflux_inst, cnveg_nitrogenflux_inst, & leaf_prof_patch(bounds%begp:bounds%endp, 1:nlevdecomp_full), & froot_prof_patch(bounds%begp:bounds%endp, 1:nlevdecomp_full), & @@ -318,7 +316,7 @@ subroutine CNGapMortality (bounds, num_soilc, filter_soilc, num_soilp, filter_so end subroutine CNGapMortality !----------------------------------------------------------------------- - subroutine CNGap_PatchToColumn (bounds, num_soilc, filter_soilc, & + subroutine CNGap_PatchToColumn (bounds, num_soilp, filter_soilp, & cnveg_carbonflux_inst, cnveg_nitrogenflux_inst, & leaf_prof_patch, froot_prof_patch, croot_prof_patch, stem_prof_patch) ! @@ -331,8 +329,8 @@ subroutine CNGap_PatchToColumn (bounds, num_soilc, filter_soilc, & ! ! !ARGUMENTS: type(bounds_type) , intent(in) :: bounds - integer , intent(in) :: num_soilc ! number of soil columns in filter - integer , intent(in) :: filter_soilc(:) ! soil column filter + integer , intent(in) :: num_soilp ! number of soil patches in filter + integer , intent(in) :: filter_soilp(:) ! soil patch filter type(cnveg_carbonflux_type) , intent(inout) :: cnveg_carbonflux_inst type(cnveg_nitrogenflux_type) , intent(inout) :: cnveg_nitrogenflux_inst real(r8) , intent(in) :: leaf_prof_patch(bounds%begp:,1:) @@ -341,7 +339,7 @@ subroutine CNGap_PatchToColumn (bounds, num_soilc, filter_soilc, & real(r8) , intent(in) :: stem_prof_patch(bounds%begp:,1:) ! ! !LOCAL VARIABLES: - integer :: fc,c,pi,p,j,i ! indices + integer :: fp,c,p,j,i ! indices !----------------------------------------------------------------------- SHR_ASSERT_ALL_FL((ubound(leaf_prof_patch) == (/bounds%endp,nlevdecomp_full/)), sourcefile, __LINE__) @@ -408,84 +406,75 @@ subroutine CNGap_PatchToColumn (bounds, num_soilc, filter_soilc, & ) do j = 1,nlevdecomp - do pi = 1,maxsoil_patches - do fc = 1,num_soilc - c = filter_soilc(fc) - - if (pi <= col%npatches(c)) then - p = col%patchi(c) + pi - 1 - - if (patch%active(p)) then - - do i = i_litr_min, i_litr_max - gap_mortality_c_to_litr_c(c,j,i) = & - gap_mortality_c_to_litr_c(c,j,i) + & - ! leaf gap mortality carbon fluxes - m_leafc_to_litter(p) * lf_f(ivt(p),i) * wtcol(p) * leaf_prof(p,j) + & - ! fine root gap mortality carbon fluxes - m_frootc_to_litter(p) * fr_f(ivt(p),i) * wtcol(p) * froot_prof(p,j) - end do - - ! wood gap mortality carbon fluxes - gap_mortality_c_to_cwdc(c,j) = gap_mortality_c_to_cwdc(c,j) + & - (m_livestemc_to_litter(p) + m_deadstemc_to_litter(p)) * wtcol(p) * stem_prof(p,j) - gap_mortality_c_to_cwdc(c,j) = gap_mortality_c_to_cwdc(c,j) + & - (m_livecrootc_to_litter(p) + m_deadcrootc_to_litter(p)) * wtcol(p) * croot_prof(p,j) - - ! storage gap mortality carbon fluxes - ! Metabolic litter is treated differently than other types - ! of litter, so it gets this additional line after the - ! most recent loop over all litter types - gap_mortality_c_to_litr_c(c,j,i_met_lit) = & - gap_mortality_c_to_litr_c(c,j,i_met_lit) + & - (m_leafc_storage_to_litter(p) + m_gresp_storage_to_litter(p)) * wtcol(p) * leaf_prof(p,j) + & - m_frootc_storage_to_litter(p) * wtcol(p) * froot_prof(p,j) + & - (m_livestemc_storage_to_litter(p) + m_deadstemc_storage_to_litter(p)) * wtcol(p) * stem_prof(p,j) + & - (m_livecrootc_storage_to_litter(p) + m_deadcrootc_storage_to_litter(p)) * wtcol(p) * croot_prof(p,j) + & - - ! transfer gap mortality carbon fluxes - (m_leafc_xfer_to_litter(p) + m_gresp_xfer_to_litter(p)) * wtcol(p) * leaf_prof(p,j) + & - m_frootc_xfer_to_litter(p) * wtcol(p) * froot_prof(p,j) + & - (m_livestemc_xfer_to_litter(p) + m_deadstemc_xfer_to_litter(p)) * wtcol(p) * stem_prof(p,j) + & - (m_livecrootc_xfer_to_litter(p) + m_deadcrootc_xfer_to_litter(p)) * wtcol(p) * croot_prof(p,j) - - do i = i_litr_min, i_litr_max - gap_mortality_n_to_litr_n(c,j,i) = & - gap_mortality_n_to_litr_n(c,j,i) + & - ! leaf gap mortality nitrogen fluxes - m_leafn_to_litter(p) * lf_f(ivt(p),i) * wtcol(p) * leaf_prof(p,j) + & - ! fine root litter nitrogen fluxes - m_frootn_to_litter(p) * fr_f(ivt(p),i) * wtcol(p) * froot_prof(p,j) - end do - - ! wood gap mortality nitrogen fluxes - gap_mortality_n_to_cwdn(c,j) = gap_mortality_n_to_cwdn(c,j) + & - (m_livestemn_to_litter(p) + m_deadstemn_to_litter(p)) * wtcol(p) * stem_prof(p,j) - gap_mortality_n_to_cwdn(c,j) = gap_mortality_n_to_cwdn(c,j) + & - (m_livecrootn_to_litter(p) + m_deadcrootn_to_litter(p)) * wtcol(p) * croot_prof(p,j) - - ! Metabolic litter is treated differently than other types - ! of litter, so it gets this additional line after the - ! most recent loop over all litter types - gap_mortality_n_to_litr_n(c,j,i_met_lit) = & - gap_mortality_n_to_litr_n(c,j,i_met_lit) + & - ! retranslocated N pool gap mortality fluxes - m_retransn_to_litter(p) * wtcol(p) * leaf_prof(p,j) + & - ! storage gap mortality nitrogen fluxes - m_leafn_storage_to_litter(p) * wtcol(p) * leaf_prof(p,j) + & - m_frootn_storage_to_litter(p) * wtcol(p) * froot_prof(p,j) + & - (m_livestemn_storage_to_litter(p) + m_deadstemn_storage_to_litter(p)) * wtcol(p) * stem_prof(p,j) + & - (m_livecrootn_storage_to_litter(p) + m_deadcrootn_storage_to_litter(p)) * wtcol(p) * croot_prof(p,j) + & - ! transfer gap mortality nitrogen fluxes - m_leafn_xfer_to_litter(p) * wtcol(p) * leaf_prof(p,j) + & - m_frootn_xfer_to_litter(p) * wtcol(p) * froot_prof(p,j) + & - (m_livestemn_xfer_to_litter(p) + m_deadstemn_xfer_to_litter(p)) * wtcol(p) * stem_prof(p,j) + & - (m_livecrootn_xfer_to_litter(p) + m_deadcrootn_xfer_to_litter(p)) * wtcol(p) * croot_prof(p,j) - - end if - end if + do fp = 1,num_soilp + p = filter_soilp(fp) + c = patch%column(p) + + do i = i_litr_min, i_litr_max + gap_mortality_c_to_litr_c(c,j,i) = & + gap_mortality_c_to_litr_c(c,j,i) + & + ! leaf gap mortality carbon fluxes + m_leafc_to_litter(p) * lf_f(ivt(p),i) * wtcol(p) * leaf_prof(p,j) + & + ! fine root gap mortality carbon fluxes + m_frootc_to_litter(p) * fr_f(ivt(p),i) * wtcol(p) * froot_prof(p,j) + end do + ! wood gap mortality carbon fluxes + gap_mortality_c_to_cwdc(c,j) = gap_mortality_c_to_cwdc(c,j) + & + (m_livestemc_to_litter(p) + m_deadstemc_to_litter(p)) * wtcol(p) * stem_prof(p,j) + gap_mortality_c_to_cwdc(c,j) = gap_mortality_c_to_cwdc(c,j) + & + (m_livecrootc_to_litter(p) + m_deadcrootc_to_litter(p)) * wtcol(p) * croot_prof(p,j) + + ! storage gap mortality carbon fluxes + ! Metabolic litter is treated differently than other types + ! of litter, so it gets this additional line after the + ! most recent loop over all litter types + gap_mortality_c_to_litr_c(c,j,i_met_lit) = & + gap_mortality_c_to_litr_c(c,j,i_met_lit) + & + (m_leafc_storage_to_litter(p) + m_gresp_storage_to_litter(p)) * wtcol(p) * leaf_prof(p,j) + & + m_frootc_storage_to_litter(p) * wtcol(p) * froot_prof(p,j) + & + (m_livestemc_storage_to_litter(p) + m_deadstemc_storage_to_litter(p)) * wtcol(p) * stem_prof(p,j) + & + (m_livecrootc_storage_to_litter(p) + m_deadcrootc_storage_to_litter(p)) * wtcol(p) * croot_prof(p,j) + & + + ! transfer gap mortality carbon fluxes + (m_leafc_xfer_to_litter(p) + m_gresp_xfer_to_litter(p)) * wtcol(p) * leaf_prof(p,j) + & + m_frootc_xfer_to_litter(p) * wtcol(p) * froot_prof(p,j) + & + (m_livestemc_xfer_to_litter(p) + m_deadstemc_xfer_to_litter(p)) * wtcol(p) * stem_prof(p,j) + & + (m_livecrootc_xfer_to_litter(p) + m_deadcrootc_xfer_to_litter(p)) * wtcol(p) * croot_prof(p,j) + + do i = i_litr_min, i_litr_max + gap_mortality_n_to_litr_n(c,j,i) = & + gap_mortality_n_to_litr_n(c,j,i) + & + ! leaf gap mortality nitrogen fluxes + m_leafn_to_litter(p) * lf_f(ivt(p),i) * wtcol(p) * leaf_prof(p,j) + & + ! fine root litter nitrogen fluxes + m_frootn_to_litter(p) * fr_f(ivt(p),i) * wtcol(p) * froot_prof(p,j) end do + + ! wood gap mortality nitrogen fluxes + gap_mortality_n_to_cwdn(c,j) = gap_mortality_n_to_cwdn(c,j) + & + (m_livestemn_to_litter(p) + m_deadstemn_to_litter(p)) * wtcol(p) * stem_prof(p,j) + gap_mortality_n_to_cwdn(c,j) = gap_mortality_n_to_cwdn(c,j) + & + (m_livecrootn_to_litter(p) + m_deadcrootn_to_litter(p)) * wtcol(p) * croot_prof(p,j) + + ! Metabolic litter is treated differently than other types + ! of litter, so it gets this additional line after the + ! most recent loop over all litter types + gap_mortality_n_to_litr_n(c,j,i_met_lit) = & + gap_mortality_n_to_litr_n(c,j,i_met_lit) + & + ! retranslocated N pool gap mortality fluxes + m_retransn_to_litter(p) * wtcol(p) * leaf_prof(p,j) + & + ! storage gap mortality nitrogen fluxes + m_leafn_storage_to_litter(p) * wtcol(p) * leaf_prof(p,j) + & + m_frootn_storage_to_litter(p) * wtcol(p) * froot_prof(p,j) + & + (m_livestemn_storage_to_litter(p) + m_deadstemn_storage_to_litter(p)) * wtcol(p) * stem_prof(p,j) + & + (m_livecrootn_storage_to_litter(p) + m_deadcrootn_storage_to_litter(p)) * wtcol(p) * croot_prof(p,j) + & + ! transfer gap mortality nitrogen fluxes + m_leafn_xfer_to_litter(p) * wtcol(p) * leaf_prof(p,j) + & + m_frootn_xfer_to_litter(p) * wtcol(p) * froot_prof(p,j) + & + (m_livestemn_xfer_to_litter(p) + m_deadstemn_xfer_to_litter(p)) * wtcol(p) * stem_prof(p,j) + & + (m_livecrootn_xfer_to_litter(p) + m_deadcrootn_xfer_to_litter(p)) * wtcol(p) * croot_prof(p,j) + end do end do diff --git a/src/biogeophys/SoilFluxesMod.F90 b/src/biogeophys/SoilFluxesMod.F90 index c316d30fe3..44e6d0e1cd 100644 --- a/src/biogeophys/SoilFluxesMod.F90 +++ b/src/biogeophys/SoilFluxesMod.F90 @@ -11,7 +11,7 @@ module SoilFluxesMod use abortutils , only : endrun use perf_mod , only : t_startf, t_stopf use clm_varctl , only : iulog - use clm_varpar , only : nlevsno, nlevgrnd, nlevurb, max_patch_per_col + use clm_varpar , only : nlevsno, nlevgrnd, nlevurb use atm2lndType , only : atm2lnd_type use CanopyStateType , only : canopystate_type use EnergyFluxType , only : energyflux_type diff --git a/src/biogeophys/SoilTemperatureMod.F90 b/src/biogeophys/SoilTemperatureMod.F90 index 513413e8a9..5ed2e99c14 100644 --- a/src/biogeophys/SoilTemperatureMod.F90 +++ b/src/biogeophys/SoilTemperatureMod.F90 @@ -88,7 +88,8 @@ module SoilTemperatureMod contains !----------------------------------------------------------------------- - subroutine SoilTemperature(bounds, num_urbanl, filter_urbanl, num_urbanc, filter_urbanc, num_nolakec, filter_nolakec, & + subroutine SoilTemperature(bounds, num_urbanl, filter_urbanl, num_urbanc, filter_urbanc, & + num_nolakep, filter_nolakep, num_nolakec, filter_nolakec, & atm2lnd_inst, urbanparams_inst, canopystate_inst, waterstatebulk_inst, waterdiagnosticbulk_inst, waterfluxbulk_inst,& solarabs_inst, soilstate_inst, energyflux_inst, temperature_inst, urbantv_inst) ! @@ -124,6 +125,8 @@ subroutine SoilTemperature(bounds, num_urbanl, filter_urbanl, num_urbanc, filter ! ! !ARGUMENTS: type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_nolakep ! number of non-lake points in patch filter + integer , intent(in) :: filter_nolakep(:) ! patch filter for non-lake points integer , intent(in) :: num_nolakec ! number of column non-lake points in column filter integer , intent(in) :: filter_nolakec(:) ! column filter for non-lake points integer , intent(in) :: num_urbanl ! number of urban landunits in clump @@ -143,8 +146,8 @@ subroutine SoilTemperature(bounds, num_urbanl, filter_urbanl, num_urbanc, filter type(temperature_type) , intent(inout) :: temperature_inst ! ! !LOCAL VARIABLES: - integer :: j,c,l,g,pi ! indices - integer :: fc ! lake filtered column indices + integer :: j,c,l,g ! indices + integer :: fc, fp ! lake filtered column & patch indices integer :: fl ! urban filtered landunit indices integer :: jtop(bounds%begc:bounds%endc) ! top level at each column real(r8) :: dtime ! land model time step (sec) @@ -288,7 +291,8 @@ subroutine SoilTemperature(bounds, num_urbanl, filter_urbanl, num_urbanc, filter ! Added a patches loop here to get the average of hs and dhsdT over ! all Patches on the column. Precalculate the terms that do not depend on PFT. - call ComputeGroundHeatFluxAndDeriv(bounds, num_nolakec, filter_nolakec, & + call ComputeGroundHeatFluxAndDeriv(bounds, & + num_nolakep, filter_nolakep, num_nolakec, filter_nolakec, & hs_h2osfc( begc:endc ), & hs_top_snow( begc:endc ), & hs_soil( begc:endc ), & @@ -1417,7 +1421,8 @@ subroutine Phasechange_beta (bounds, num_nolakec, filter_nolakec, dhsdT, & end subroutine Phasechange_beta !----------------------------------------------------------------------- - subroutine ComputeGroundHeatFluxAndDeriv(bounds, num_nolakec, filter_nolakec, & + subroutine ComputeGroundHeatFluxAndDeriv(bounds, & + num_nolakep, filter_nolakep, num_nolakec, filter_nolakec, & hs_h2osfc, hs_top_snow, hs_soil, hs_top, dhsdT, sabg_lyr_col, & atm2lnd_inst, urbanparams_inst, canopystate_inst, waterdiagnosticbulk_inst, & waterfluxbulk_inst, solarabs_inst, energyflux_inst, temperature_inst) @@ -1433,12 +1438,14 @@ subroutine ComputeGroundHeatFluxAndDeriv(bounds, num_nolakec, filter_nolakec, & ! !USES: use clm_varcon , only : sb, hvap use column_varcon , only : icol_road_perv, icol_road_imperv - use clm_varpar , only : nlevsno, max_patch_per_col + use clm_varpar , only : nlevsno use UrbanParamsType, only : IsSimpleBuildTemp, IsProgBuildTemp ! ! !ARGUMENTS: implicit none type(bounds_type) , intent(in) :: bounds ! bounds + integer , intent(in) :: num_nolakep ! number of non-lake points in patch filter + integer , intent(in) :: filter_nolakep( : ) ! patch filter for non-lake points integer , intent(in) :: num_nolakec ! number of column non-lake points in column filter integer , intent(in) :: filter_nolakec( : ) ! column filter for non-lake points real(r8) , intent(out) :: hs_h2osfc( bounds%begc: ) ! heat flux on standing water [W/m2] @@ -1457,8 +1464,8 @@ subroutine ComputeGroundHeatFluxAndDeriv(bounds, num_nolakec, filter_nolakec, & type(temperature_type) , intent(in) :: temperature_inst ! ! !LOCAL VARIABLES: - integer :: j,c,p,l,g,pi ! indices - integer :: fc ! lake filtered column indices + integer :: j,c,p,l,g ! indices + integer :: fc, fp ! lake filtered column and patch indices real(r8) :: hs(bounds%begc:bounds%endc) ! net energy flux into the surface (w/m2) real(r8) :: lwrad_emit(bounds%begc:bounds%endc) ! emitted longwave radiation real(r8) :: dlwrad_emit(bounds%begc:bounds%endc) ! time derivative of emitted longwave radiation @@ -1550,79 +1557,71 @@ subroutine ComputeGroundHeatFluxAndDeriv(bounds, num_nolakec, filter_nolakec, & hs_h2osfc(begc:endc) = 0._r8 hs(begc:endc) = 0._r8 dhsdT(begc:endc) = 0._r8 - do pi = 1,max_patch_per_col - do fc = 1,num_nolakec - c = filter_nolakec(fc) - if ( pi <= col%npatches(c) ) then - p = col%patchi(c) + pi - 1 - l = patch%landunit(p) - g = patch%gridcell(p) - - if (patch%active(p)) then - if (.not. lun%urbpoi(l)) then - eflx_gnet(p) = sabg(p) + dlrad(p) & - + (1._r8-frac_veg_nosno(p))*emg(c)*forc_lwrad(c) - lwrad_emit(c) & - - (eflx_sh_grnd(p)+qflx_evap_soi(p)*htvp(c)) - ! save sabg for balancecheck, in case frac_sno is set to zero later - sabg_chk(p) = frac_sno_eff(c) * sabg_snow(p) + (1._r8 - frac_sno_eff(c) ) * sabg_soil(p) - - eflx_gnet_snow = sabg_snow(p) + dlrad(p) & - + (1._r8-frac_veg_nosno(p))*emg(c)*forc_lwrad(c) - lwrad_emit_snow(c) & - - (eflx_sh_snow(p)+qflx_ev_snow(p)*htvp(c)) - - eflx_gnet_soil = sabg_soil(p) + dlrad(p) & - + (1._r8-frac_veg_nosno(p))*emg(c)*forc_lwrad(c) - lwrad_emit_soil(c) & - - (eflx_sh_soil(p)+qflx_ev_soil(p)*htvp(c)) - - eflx_gnet_h2osfc = sabg_soil(p) + dlrad(p) & - + (1._r8-frac_veg_nosno(p))*emg(c)*forc_lwrad(c) - lwrad_emit_h2osfc(c) & - - (eflx_sh_h2osfc(p)+qflx_ev_h2osfc(p)*htvp(c)) - else - ! For urban columns we use the net longwave radiation (eflx_lwrad_net) because of - ! interactions between urban columns. - - ! All wasteheat and traffic flux goes into canyon floor - if (col%itype(c) == icol_road_perv .or. col%itype(c) == icol_road_imperv) then - ! Note that we divide the following landunit variables by 1-wtlunit_roof which - ! essentially converts the flux from W/m2 of urban area to W/m2 of canyon floor area - eflx_wasteheat_patch(p) = eflx_wasteheat(l)/(1._r8-lun%wtlunit_roof(l)) - if ( IsSimpleBuildTemp() ) then - eflx_ventilation_patch(p) = 0._r8 - else if ( IsProgBuildTemp() ) then - eflx_ventilation_patch(p) = eflx_ventilation(l)/(1._r8-lun%wtlunit_roof(l)) - end if - eflx_heat_from_ac_patch(p) = eflx_heat_from_ac(l)/(1._r8-lun%wtlunit_roof(l)) - eflx_traffic_patch(p) = eflx_traffic(l)/(1._r8-lun%wtlunit_roof(l)) - else - eflx_wasteheat_patch(p) = 0._r8 - eflx_ventilation_patch(p) = 0._r8 - eflx_heat_from_ac_patch(p) = 0._r8 - eflx_traffic_patch(p) = 0._r8 - end if - ! Include transpiration term because needed for previous road - ! and include wasteheat and traffic flux - eflx_gnet(p) = sabg(p) + dlrad(p) & - - eflx_lwrad_net(p) & - - (eflx_sh_grnd(p) + qflx_evap_soi(p)*htvp(c) + qflx_tran_veg(p)*hvap) & - + eflx_wasteheat_patch(p) + eflx_heat_from_ac_patch(p) + eflx_traffic_patch(p) & - + eflx_ventilation_patch(p) - if ( IsSimpleBuildTemp() ) then - eflx_anthro(p) = eflx_wasteheat_patch(p) + eflx_traffic_patch(p) - end if - eflx_gnet_snow = eflx_gnet(p) - eflx_gnet_soil = eflx_gnet(p) - eflx_gnet_h2osfc = eflx_gnet(p) - end if - dgnetdT(p) = - cgrnd(p) - dlwrad_emit(c) - hs(c) = hs(c) + eflx_gnet(p) * patch%wtcol(p) - dhsdT(c) = dhsdT(c) + dgnetdT(p) * patch%wtcol(p) - ! separate surface fluxes for soil/snow - hs_soil(c) = hs_soil(c) + eflx_gnet_soil * patch%wtcol(p) - hs_h2osfc(c) = hs_h2osfc(c) + eflx_gnet_h2osfc * patch%wtcol(p) - + do fp = 1,num_nolakep + p = filter_nolakep(fp) + c = patch%column(p) + l = patch%landunit(p) + + if (.not. lun%urbpoi(l)) then + eflx_gnet(p) = sabg(p) + dlrad(p) & + + (1._r8-frac_veg_nosno(p))*emg(c)*forc_lwrad(c) - lwrad_emit(c) & + - (eflx_sh_grnd(p)+qflx_evap_soi(p)*htvp(c)) + ! save sabg for balancecheck, in case frac_sno is set to zero later + sabg_chk(p) = frac_sno_eff(c) * sabg_snow(p) + (1._r8 - frac_sno_eff(c) ) * sabg_soil(p) + + eflx_gnet_snow = sabg_snow(p) + dlrad(p) & + + (1._r8-frac_veg_nosno(p))*emg(c)*forc_lwrad(c) - lwrad_emit_snow(c) & + - (eflx_sh_snow(p)+qflx_ev_snow(p)*htvp(c)) + + eflx_gnet_soil = sabg_soil(p) + dlrad(p) & + + (1._r8-frac_veg_nosno(p))*emg(c)*forc_lwrad(c) - lwrad_emit_soil(c) & + - (eflx_sh_soil(p)+qflx_ev_soil(p)*htvp(c)) + + eflx_gnet_h2osfc = sabg_soil(p) + dlrad(p) & + + (1._r8-frac_veg_nosno(p))*emg(c)*forc_lwrad(c) - lwrad_emit_h2osfc(c) & + - (eflx_sh_h2osfc(p)+qflx_ev_h2osfc(p)*htvp(c)) + else + ! For urban columns we use the net longwave radiation (eflx_lwrad_net) because of + ! interactions between urban columns. + + ! All wasteheat and traffic flux goes into canyon floor + if (col%itype(c) == icol_road_perv .or. col%itype(c) == icol_road_imperv) then + ! Note that we divide the following landunit variables by 1-wtlunit_roof which + ! essentially converts the flux from W/m2 of urban area to W/m2 of canyon floor area + eflx_wasteheat_patch(p) = eflx_wasteheat(l)/(1._r8-lun%wtlunit_roof(l)) + if ( IsSimpleBuildTemp() ) then + eflx_ventilation_patch(p) = 0._r8 + else if ( IsProgBuildTemp() ) then + eflx_ventilation_patch(p) = eflx_ventilation(l)/(1._r8-lun%wtlunit_roof(l)) end if + eflx_heat_from_ac_patch(p) = eflx_heat_from_ac(l)/(1._r8-lun%wtlunit_roof(l)) + eflx_traffic_patch(p) = eflx_traffic(l)/(1._r8-lun%wtlunit_roof(l)) + else + eflx_wasteheat_patch(p) = 0._r8 + eflx_ventilation_patch(p) = 0._r8 + eflx_heat_from_ac_patch(p) = 0._r8 + eflx_traffic_patch(p) = 0._r8 end if - end do + ! Include transpiration term because needed for previous road + ! and include wasteheat and traffic flux + eflx_gnet(p) = sabg(p) + dlrad(p) & + - eflx_lwrad_net(p) & + - (eflx_sh_grnd(p) + qflx_evap_soi(p)*htvp(c) + qflx_tran_veg(p)*hvap) & + + eflx_wasteheat_patch(p) + eflx_heat_from_ac_patch(p) + eflx_traffic_patch(p) & + + eflx_ventilation_patch(p) + if ( IsSimpleBuildTemp() ) then + eflx_anthro(p) = eflx_wasteheat_patch(p) + eflx_traffic_patch(p) + end if + eflx_gnet_snow = eflx_gnet(p) + eflx_gnet_soil = eflx_gnet(p) + eflx_gnet_h2osfc = eflx_gnet(p) + end if + dgnetdT(p) = - cgrnd(p) - dlwrad_emit(c) + hs(c) = hs(c) + eflx_gnet(p) * patch%wtcol(p) + dhsdT(c) = dhsdT(c) + dgnetdT(p) * patch%wtcol(p) + ! separate surface fluxes for soil/snow + hs_soil(c) = hs_soil(c) + eflx_gnet_soil * patch%wtcol(p) + hs_h2osfc(c) = hs_h2osfc(c) + eflx_gnet_h2osfc * patch%wtcol(p) end do ! Additional calculations with SNICAR: @@ -1639,44 +1638,38 @@ subroutine ComputeGroundHeatFluxAndDeriv(bounds, num_nolakec, filter_nolakec, & hs_top(begc:endc) = 0._r8 hs_top_snow(begc:endc) = 0._r8 - do pi = 1,max_patch_per_col - do fc = 1,num_nolakec - c = filter_nolakec(fc) - lyr_top = snl(c) + 1 - if ( pi <= col%npatches(c) ) then - p = col%patchi(c) + pi - 1 - if (patch%active(p)) then - g = patch%gridcell(p) - l = patch%landunit(p) - if (.not. lun%urbpoi(l)) then + do fp = 1,num_nolakep + p = filter_nolakep(fp) + c = patch%column(p) + l = patch%landunit(p) - eflx_gnet_top = sabg_lyr(p,lyr_top) + dlrad(p) + (1._r8-frac_veg_nosno(p))*emg(c)*forc_lwrad(c) & - - lwrad_emit(c) - (eflx_sh_grnd(p)+qflx_evap_soi(p)*htvp(c)) + lyr_top = snl(c) + 1 - hs_top(c) = hs_top(c) + eflx_gnet_top*patch%wtcol(p) + if (.not. lun%urbpoi(l)) then - eflx_gnet_snow = sabg_lyr(p,lyr_top) + dlrad(p) + (1._r8-frac_veg_nosno(p))*emg(c)*forc_lwrad(c) & - - lwrad_emit_snow(c) - (eflx_sh_snow(p)+qflx_ev_snow(p)*htvp(c)) + eflx_gnet_top = sabg_lyr(p,lyr_top) + dlrad(p) + (1._r8-frac_veg_nosno(p))*emg(c)*forc_lwrad(c) & + - lwrad_emit(c) - (eflx_sh_grnd(p)+qflx_evap_soi(p)*htvp(c)) - eflx_gnet_soil = sabg_lyr(p,lyr_top) + dlrad(p) + (1._r8-frac_veg_nosno(p))*emg(c)*forc_lwrad(c) & - - lwrad_emit_soil(c) - (eflx_sh_soil(p)+qflx_ev_soil(p)*htvp(c)) + hs_top(c) = hs_top(c) + eflx_gnet_top*patch%wtcol(p) - hs_top_snow(c) = hs_top_snow(c) + eflx_gnet_snow*patch%wtcol(p) + eflx_gnet_snow = sabg_lyr(p,lyr_top) + dlrad(p) + (1._r8-frac_veg_nosno(p))*emg(c)*forc_lwrad(c) & + - lwrad_emit_snow(c) - (eflx_sh_snow(p)+qflx_ev_snow(p)*htvp(c)) - do j = lyr_top,1,1 - sabg_lyr_col(c,j) = sabg_lyr_col(c,j) + sabg_lyr(p,j) * patch%wtcol(p) - enddo - else + eflx_gnet_soil = sabg_lyr(p,lyr_top) + dlrad(p) + (1._r8-frac_veg_nosno(p))*emg(c)*forc_lwrad(c) & + - lwrad_emit_soil(c) - (eflx_sh_soil(p)+qflx_ev_soil(p)*htvp(c)) - hs_top(c) = hs_top(c) + eflx_gnet(p)*patch%wtcol(p) - hs_top_snow(c) = hs_top_snow(c) + eflx_gnet(p)*patch%wtcol(p) - sabg_lyr_col(c,lyr_top) = sabg_lyr_col(c,lyr_top) + sabg(p) * patch%wtcol(p) + hs_top_snow(c) = hs_top_snow(c) + eflx_gnet_snow*patch%wtcol(p) - endif - endif + do j = lyr_top,1,1 + sabg_lyr_col(c,j) = sabg_lyr_col(c,j) + sabg_lyr(p,j) * patch%wtcol(p) + enddo + else - endif - enddo + hs_top(c) = hs_top(c) + eflx_gnet(p)*patch%wtcol(p) + hs_top_snow(c) = hs_top_snow(c) + eflx_gnet(p)*patch%wtcol(p) + sabg_lyr_col(c,lyr_top) = sabg_lyr_col(c,lyr_top) + sabg(p) * patch%wtcol(p) + + endif enddo end associate diff --git a/src/biogeophys/SoilWaterMovementMod.F90 b/src/biogeophys/SoilWaterMovementMod.F90 index 70da14a713..b1487e2779 100644 --- a/src/biogeophys/SoilWaterMovementMod.F90 +++ b/src/biogeophys/SoilWaterMovementMod.F90 @@ -380,7 +380,7 @@ subroutine BaseflowSink(bounds, num_hydrologyc, & !USES: use decompMod , only : bounds_type use shr_kind_mod , only : r8 => shr_kind_r8 - use clm_varpar , only : nlevsoi, max_patch_per_col + use clm_varpar , only : nlevsoi use SoilStateType , only : soilstate_type use WaterFluxBulkType , only : waterfluxbulk_type use PatchType , only : patch @@ -484,7 +484,7 @@ subroutine soilwater_zengdecker2009(bounds, num_hydrologyc, filter_hydrologyc, & use decompMod , only : bounds_type use clm_varcon , only : grav,hfus,tfrz use clm_varcon , only : denh2o, denice - use clm_varpar , only : nlevsoi, max_patch_per_col, nlevgrnd + use clm_varpar , only : nlevsoi, nlevgrnd use clm_time_manager , only : get_step_size_real, get_nstep use column_varcon , only : icol_roof, icol_road_imperv use clm_varctl , only : use_flexibleCN, use_hydrstress diff --git a/src/biogeophys/SoilWaterPlantSinkMod.F90 b/src/biogeophys/SoilWaterPlantSinkMod.F90 index 115e1cab76..2d9c1a03c6 100644 --- a/src/biogeophys/SoilWaterPlantSinkMod.F90 +++ b/src/biogeophys/SoilWaterPlantSinkMod.F90 @@ -149,7 +149,6 @@ subroutine Compute_EffecRootFrac_And_VertTranSink_HydStress_Roads(bounds, & use SoilStateType , only : soilstate_type use WaterFluxBulkType , only : waterfluxbulk_type use clm_varpar , only : nlevsoi - use clm_varpar , only : max_patch_per_col use PatchType , only : patch use ColumnType , only : col @@ -199,30 +198,25 @@ subroutine Compute_EffecRootFrac_And_VertTranSink_HydStress_Roads(bounds, & end do end do - do pi = 1,max_patch_per_col - do j = 1,nlevsoi - do fc = 1, num_filterc - c = filterc(fc) - if (pi <= col%npatches(c)) then - p = col%patchi(c) + pi - 1 - if (patch%active(p)) then - rootr_col(c,j) = rootr_col(c,j) + rootr_patch(p,j) * & - qflx_tran_veg_patch(p) * patch%wtcol(p) - end if - end if - end do - end do + do j = 1,nlevsoi do fc = 1, num_filterc c = filterc(fc) - if (pi <= col%npatches(c)) then - p = col%patchi(c) + pi - 1 + do p = col%patchi(c), col%patchi(c) + col%npatches(c) - 1 if (patch%active(p)) then - temp(c) = temp(c) + qflx_tran_veg_patch(p) * patch%wtcol(p) + rootr_col(c,j) = rootr_col(c,j) + rootr_patch(p,j) * & + qflx_tran_veg_patch(p) * patch%wtcol(p) end if + end do + end do + end do + do fc = 1, num_filterc + c = filterc(fc) + do p = col%patchi(c), col%patchi(c) + col%npatches(c) - 1 + if (patch%active(p)) then + temp(c) = temp(c) + qflx_tran_veg_patch(p) * patch%wtcol(p) end if end do end do - do j = 1, nlevsoi do fc = 1, num_filterc @@ -248,7 +242,6 @@ subroutine Compute_EffecRootFrac_And_VertTranSink_HydStress( bounds, & !USES: use decompMod , only : bounds_type use clm_varpar , only : nlevsoi - use clm_varpar , only : max_patch_per_col use SoilStateType , only : soilstate_type use WaterFluxBulkType , only : waterfluxbulk_type use CanopyStateType , only : canopystate_type @@ -308,21 +301,18 @@ subroutine Compute_EffecRootFrac_And_VertTranSink_HydStress( bounds, & do j = 1, nlevsoi grav2 = z(c,j) * 1000._r8 temp(c) = 0._r8 - do pi = 1,max_patch_per_col - if (pi <= col%npatches(c)) then - p = col%patchi(c) + pi - 1 - if (j == 1) then - qflx_hydr_redist_patch(p) = 0._r8 - end if - if (patch%active(p).and.frac_veg_nosno(p)>0) then - if (patch%wtcol(p) > 0._r8) then - patchflux = k_soil_root(p,j) * (smp(c,j) - vegwp(p,4) - grav2) - if (patchflux <0) then - qflx_hydr_redist_patch(p) = qflx_hydr_redist_patch(p) + patchflux - end if - temp(c) = temp(c) + patchflux * patch%wtcol(p) - endif - end if + do p = col%patchi(c), col%patchi(c) + col%npatches(c) - 1 + if (j == 1) then + qflx_hydr_redist_patch(p) = 0._r8 + end if + if (patch%active(p).and.frac_veg_nosno(p)>0) then + if (patch%wtcol(p) > 0._r8) then + patchflux = k_soil_root(p,j) * (smp(c,j) - vegwp(p,4) - grav2) + if (patchflux <0) then + qflx_hydr_redist_patch(p) = qflx_hydr_redist_patch(p) + patchflux + end if + temp(c) = temp(c) + patchflux * patch%wtcol(p) + endif end if end do qflx_rootsoi_col(c,j)= temp(c) @@ -351,7 +341,7 @@ subroutine Compute_EffecRootFrac_And_VertTranSink_Default(bounds, num_filterc, & !USES: use decompMod , only : bounds_type use shr_kind_mod , only : r8 => shr_kind_r8 - use clm_varpar , only : nlevsoi, max_patch_per_col + use clm_varpar , only : nlevsoi use SoilStateType , only : soilstate_type use WaterFluxBulkType , only : waterfluxbulk_type use PatchType , only : patch @@ -399,26 +389,22 @@ subroutine Compute_EffecRootFrac_And_VertTranSink_Default(bounds, num_filterc, & end do end do - do pi = 1,max_patch_per_col - do j = 1,nlevsoi - do fc = 1, num_filterc - c = filterc(fc) - if (pi <= col%npatches(c)) then - p = col%patchi(c) + pi - 1 - if (patch%active(p)) then - rootr_col(c,j) = rootr_col(c,j) + rootr_patch(p,j) * & - qflx_tran_veg_patch(p) * patch%wtcol(p) - end if - end if - end do - end do + do j = 1,nlevsoi do fc = 1, num_filterc c = filterc(fc) - if (pi <= col%npatches(c)) then - p = col%patchi(c) + pi - 1 + do p = col%patchi(c), col%patchi(c) + col%npatches(c) - 1 if (patch%active(p)) then - temp(c) = temp(c) + qflx_tran_veg_patch(p) * patch%wtcol(p) + rootr_col(c,j) = rootr_col(c,j) + rootr_patch(p,j) * & + qflx_tran_veg_patch(p) * patch%wtcol(p) end if + end do + end do + end do + do fc = 1, num_filterc + c = filterc(fc) + do p = col%patchi(c), col%patchi(c) + col%npatches(c) - 1 + if (patch%active(p)) then + temp(c) = temp(c) + qflx_tran_veg_patch(p) * patch%wtcol(p) end if end do end do diff --git a/src/dyn_subgrid/dynGrossUnrepMod.F90 b/src/dyn_subgrid/dynGrossUnrepMod.F90 index bc49e72f4c..8d0e7ee004 100644 --- a/src/dyn_subgrid/dynGrossUnrepMod.F90 +++ b/src/dyn_subgrid/dynGrossUnrepMod.F90 @@ -146,7 +146,7 @@ end subroutine dynGrossUnrep_interp !----------------------------------------------------------------------- - subroutine CNGrossUnrep (num_soilc, filter_soilc, num_soilp, filter_soilp, & + subroutine CNGrossUnrep (num_soilp, filter_soilp, & soilbiogeochem_state_inst, cnveg_carbonstate_inst, cnveg_nitrogenstate_inst, & cnveg_carbonflux_inst, cnveg_nitrogenflux_inst) ! @@ -159,8 +159,6 @@ subroutine CNGrossUnrep (num_soilc, filter_soilc, num_soilp, filter_soilp, & use clm_time_manager, only : get_step_size_real, is_beg_curr_year ! ! !ARGUMENTS: - integer , intent(in) :: num_soilc ! number of soil columns in filter - integer , intent(in) :: filter_soilc(:) ! column filter for soil points integer , intent(in) :: num_soilp ! number of soil patches in filter integer , intent(in) :: filter_soilp(:) ! patch filter for soil points type(soilbiogeochem_state_type) , intent(in) :: soilbiogeochem_state_inst @@ -359,7 +357,7 @@ subroutine CNGrossUnrep (num_soilc, filter_soilc, num_soilp, filter_soilp, & ! gather all patch-level litterfall fluxes from grossunrep to the column ! for litter C and N inputs - call CNGrossUnrepPftToColumn(num_soilc, filter_soilc, & + call CNGrossUnrepPftToColumn(num_soilp, filter_soilp, & soilbiogeochem_state_inst, cnveg_carbonflux_inst, cnveg_nitrogenflux_inst) end associate @@ -367,7 +365,7 @@ subroutine CNGrossUnrep (num_soilc, filter_soilc, num_soilp, filter_soilp, & end subroutine CNGrossUnrep !----------------------------------------------------------------------- - subroutine CNGrossUnrepPftToColumn (num_soilc, filter_soilc, & + subroutine CNGrossUnrepPftToColumn (num_soilp, filter_soilp, & soilbiogeochem_state_inst, CNVeg_carbonflux_inst, cnveg_nitrogenflux_inst) ! ! !DESCRIPTION: @@ -378,14 +376,14 @@ subroutine CNGrossUnrepPftToColumn (num_soilc, filter_soilc, & use clm_varpar , only : maxsoil_patches, nlevdecomp ! ! !ARGUMENTS: - integer , intent(in) :: num_soilc ! number of soil columns in filter - integer , intent(in) :: filter_soilc(:) ! soil column filter + integer , intent(in) :: num_soilp ! number of soil patches in filter + integer , intent(in) :: filter_soilp(:) ! soil patch filter type(soilbiogeochem_state_type) , intent(in) :: soilbiogeochem_state_inst type(cnveg_carbonflux_type) , intent(inout) :: cnveg_carbonflux_inst type(cnveg_nitrogenflux_type) , intent(inout) :: cnveg_nitrogenflux_inst ! ! !LOCAL VARIABLES: - integer :: fc,c,pi,p,j,i ! indices + integer :: fp,c,p,j,i ! indices !----------------------------------------------------------------------- associate( & @@ -425,74 +423,56 @@ subroutine CNGrossUnrepPftToColumn (num_soilc, filter_soilc, & ) do j = 1, nlevdecomp - do pi = 1,maxsoil_patches - do fc = 1,num_soilc - c = filter_soilc(fc) - - if (pi <= col%npatches(c)) then - p = col%patchi(c) + pi - 1 - - if (patch%active(p)) then - - do i = i_litr_min, i_litr_max - gru_c_to_litr_c(c,j,i) = gru_c_to_litr_c(c,j,i) + & - ! leaf gross unrepresented landcover change mortality carbon fluxes - gru_leafc_to_litter(p) * lf_f(ivt(p),i) * wtcol(p) * leaf_prof(p,j) + & - ! fine root gross unrepresented landcover change mortality carbon fluxes - gru_frootc_to_litter(p) * fr_f(ivt(p),i) * wtcol(p) * froot_prof(p,j) - gru_n_to_litr_c(c,j,i) = gru_n_to_litr_c(c,j,i) + & - ! leaf gross unrepresented landcover change mortality nitrogen fluxes - gru_leafn_to_litter(p) * lf_f(ivt(p),i) * wtcol(p) * leaf_prof(p,j) + & - ! fine root gross unrepresented landcover change mortality nitrogen fluxes - gru_frootn_to_litter(p) * fr_f(ivt(p),i) * wtcol(p) * froot_prof(p,j) - end do - - ! coarse root gross unrepresented landcover change mortality carbon fluxes - gru_c_to_cwdc_c(c,j) = gru_c_to_cwdc_c(c,j) + & - gru_livecrootc_to_litter(p) * wtcol(p) * croot_prof(p,j) - gru_c_to_cwdc_c(c,j) = gru_c_to_cwdc_c(c,j) + & - gru_deadcrootc_to_litter(p) * wtcol(p) * croot_prof(p,j) - - ! coarse root gross unrepresented landcover change mortality nitrogen fluxes - gru_n_to_cwdn_c(c,j) = gru_n_to_cwdn_c(c,j) + & - gru_livecrootn_to_litter(p) * wtcol(p) * croot_prof(p,j) - gru_n_to_cwdn_c(c,j) = gru_n_to_cwdn_c(c,j) + & - gru_deadcrootn_to_litter(p) * wtcol(p) * croot_prof(p,j) - - ! retranslocated N pool gross unrepresented landcover change mortality fluxes - ! process specific to i_met_lit, so we keep it outside - ! the i_litr_min to i_litr_max loop above - gru_n_to_litr_c(c,j,i_met_lit) = & - gru_n_to_litr_c(c,j,i_met_lit) + & - gru_retransn_to_litter(p) * wtcol(p) * leaf_prof(p,j) - - end if - end if - + do fp = 1,num_soilp + p = filter_soilp(fp) + c = patch%column(p) + + do i = i_litr_min, i_litr_max + gru_c_to_litr_c(c,j,i) = gru_c_to_litr_c(c,j,i) + & + ! leaf gross unrepresented landcover change mortality carbon fluxes + gru_leafc_to_litter(p) * lf_f(ivt(p),i) * wtcol(p) * leaf_prof(p,j) + & + ! fine root gross unrepresented landcover change mortality carbon fluxes + gru_frootc_to_litter(p) * fr_f(ivt(p),i) * wtcol(p) * froot_prof(p,j) + gru_n_to_litr_c(c,j,i) = gru_n_to_litr_c(c,j,i) + & + ! leaf gross unrepresented landcover change mortality nitrogen fluxes + gru_leafn_to_litter(p) * lf_f(ivt(p),i) * wtcol(p) * leaf_prof(p,j) + & + ! fine root gross unrepresented landcover change mortality nitrogen fluxes + gru_frootn_to_litter(p) * fr_f(ivt(p),i) * wtcol(p) * froot_prof(p,j) end do + ! coarse root gross unrepresented landcover change mortality carbon fluxes + gru_c_to_cwdc_c(c,j) = gru_c_to_cwdc_c(c,j) + & + gru_livecrootc_to_litter(p) * wtcol(p) * croot_prof(p,j) + gru_c_to_cwdc_c(c,j) = gru_c_to_cwdc_c(c,j) + & + gru_deadcrootc_to_litter(p) * wtcol(p) * croot_prof(p,j) + + ! coarse root gross unrepresented landcover change mortality nitrogen fluxes + gru_n_to_cwdn_c(c,j) = gru_n_to_cwdn_c(c,j) + & + gru_livecrootn_to_litter(p) * wtcol(p) * croot_prof(p,j) + gru_n_to_cwdn_c(c,j) = gru_n_to_cwdn_c(c,j) + & + gru_deadcrootn_to_litter(p) * wtcol(p) * croot_prof(p,j) + + ! retranslocated N pool gross unrepresented landcover change mortality fluxes + ! process specific to i_met_lit, so we keep it outside + ! the i_litr_min to i_litr_max loop above + gru_n_to_litr_c(c,j,i_met_lit) = & + gru_n_to_litr_c(c,j,i_met_lit) + & + gru_retransn_to_litter(p) * wtcol(p) * leaf_prof(p,j) + end do end do - do pi = 1,maxsoil_patches - do fc = 1,num_soilc - c = filter_soilc(fc) - - if (pi <= col%npatches(c)) then - p = col%patchi(c) + pi - 1 + do fp = 1,num_soilp + p = filter_soilp(fp) + c = patch%column(p) - if (patch%active(p)) then - ! wood gross unrepresented landcover change mortality carbon fluxes to product pools - gru_wood_productc_gain_c(c) = gru_wood_productc_gain_c(c) + & - gru_wood_productc_gain(p) * wtcol(p) + ! wood gross unrepresented landcover change mortality carbon fluxes to product pools + gru_wood_productc_gain_c(c) = gru_wood_productc_gain_c(c) + & + gru_wood_productc_gain(p) * wtcol(p) - ! wood gross unrepresented landcover change mortality nitrogen fluxes to product pools - gru_wood_productn_gain_c(c) = gru_wood_productn_gain_c(c) + & - gru_wood_productn_gain(p) * wtcol(p) - end if - end if - - end do + ! wood gross unrepresented landcover change mortality nitrogen fluxes to product pools + gru_wood_productn_gain_c(c) = gru_wood_productn_gain_c(c) + & + gru_wood_productn_gain(p) * wtcol(p) end do diff --git a/src/dyn_subgrid/dynHarvestMod.F90 b/src/dyn_subgrid/dynHarvestMod.F90 index a55da036f3..d5a72aa547 100644 --- a/src/dyn_subgrid/dynHarvestMod.F90 +++ b/src/dyn_subgrid/dynHarvestMod.F90 @@ -234,7 +234,7 @@ subroutine dynHarvest_interp_resolve_harvesttypes(bounds, harvest_rates, after_s end subroutine dynHarvest_interp_resolve_harvesttypes !----------------------------------------------------------------------- - subroutine CNHarvest (num_soilc, filter_soilc, num_soilp, filter_soilp, & + subroutine CNHarvest (num_soilp, filter_soilp, & soilbiogeochem_state_inst, cnveg_carbonstate_inst, cnveg_nitrogenstate_inst, & cnveg_carbonflux_inst, cnveg_nitrogenflux_inst) ! @@ -247,8 +247,6 @@ subroutine CNHarvest (num_soilc, filter_soilc, num_soilp, filter_soilp, & use clm_time_manager, only : get_step_size_real, is_beg_curr_year ! ! !ARGUMENTS: - integer , intent(in) :: num_soilc ! number of soil columns in filter - integer , intent(in) :: filter_soilc(:) ! column filter for soil points integer , intent(in) :: num_soilp ! number of soil patches in filter integer , intent(in) :: filter_soilp(:) ! patch filter for soil points type(soilbiogeochem_state_type) , intent(in) :: soilbiogeochem_state_inst @@ -457,7 +455,7 @@ subroutine CNHarvest (num_soilc, filter_soilc, num_soilp, filter_soilp, & ! gather all patch-level litterfall fluxes from harvest to the column ! for litter C and N inputs - call CNHarvestPftToColumn(num_soilc, filter_soilc, & + call CNHarvestPftToColumn(num_soilp, filter_soilp, & soilbiogeochem_state_inst, cnveg_carbonflux_inst, cnveg_nitrogenflux_inst) end associate @@ -465,7 +463,7 @@ subroutine CNHarvest (num_soilc, filter_soilc, num_soilp, filter_soilp, & end subroutine CNHarvest !----------------------------------------------------------------------- - subroutine CNHarvestPftToColumn (num_soilc, filter_soilc, & + subroutine CNHarvestPftToColumn (num_soilp, filter_soilp, & soilbiogeochem_state_inst, CNVeg_carbonflux_inst, cnveg_nitrogenflux_inst) ! ! !DESCRIPTION: @@ -476,14 +474,14 @@ subroutine CNHarvestPftToColumn (num_soilc, filter_soilc, & use clm_varpar , only : nlevdecomp, maxsoil_patches, i_litr_min, i_litr_max, i_met_lit ! ! !ARGUMENTS: - integer , intent(in) :: num_soilc ! number of soil columns in filter - integer , intent(in) :: filter_soilc(:) ! soil column filter + integer , intent(in) :: num_soilp ! number of soil patches in filter + integer , intent(in) :: filter_soilp(:) ! patch filter for soil points type(soilbiogeochem_state_type) , intent(in) :: soilbiogeochem_state_inst type(cnveg_carbonflux_type) , intent(inout) :: cnveg_carbonflux_inst type(cnveg_nitrogenflux_type) , intent(inout) :: cnveg_nitrogenflux_inst ! ! !LOCAL VARIABLES: - integer :: fc,c,pi,p,j,i ! indices + integer :: fp,c,p,j,i ! indices !----------------------------------------------------------------------- associate( & @@ -547,124 +545,106 @@ subroutine CNHarvestPftToColumn (num_soilc, filter_soilc, & ) do j = 1, nlevdecomp - do pi = 1,maxsoil_patches - do fc = 1,num_soilc - c = filter_soilc(fc) - - if (pi <= col%npatches(c)) then - p = col%patchi(c) + pi - 1 - - if (patch%active(p)) then - - do i = i_litr_min, i_litr_max - ! leaf harvest mortality carbon fluxes - harvest_c_to_litr_c(c,j,i) = & - harvest_c_to_litr_c(c,j,i) + & - hrv_leafc_to_litter(p) * lf_f(ivt(p),i) * wtcol(p) * leaf_prof(p,j) - - ! fine root harvest mortality carbon fluxes - harvest_c_to_litr_c(c,j,i) = & - harvest_c_to_litr_c(c,j,i) + & - hrv_frootc_to_litter(p) * fr_f(ivt(p),i) * wtcol(p) * froot_prof(p,j) - end do - - ! wood harvest mortality carbon fluxes - harvest_c_to_cwdc(c,j) = harvest_c_to_cwdc(c,j) + & - hrv_livestemc_to_litter(p) * wtcol(p) * stem_prof(p,j) - harvest_c_to_cwdc(c,j) = harvest_c_to_cwdc(c,j) + & - hrv_livecrootc_to_litter(p) * wtcol(p) * croot_prof(p,j) - harvest_c_to_cwdc(c,j) = harvest_c_to_cwdc(c,j) + & - hrv_deadcrootc_to_litter(p) * wtcol(p) * croot_prof(p,j) - - ! storage harvest mortality carbon fluxes - ! Metabolic litter is treated differently than other types - ! of litter, so it gets this additional line after the - ! most recent loop over all litter types - harvest_c_to_litr_c(c,j,i_met_lit) = & - harvest_c_to_litr_c(c,j,i_met_lit) + & - hrv_leafc_storage_to_litter(p) * wtcol(p) * leaf_prof(p,j) + & - hrv_frootc_storage_to_litter(p) * wtcol(p) * froot_prof(p,j) + & - hrv_livestemc_storage_to_litter(p) * wtcol(p) * stem_prof(p,j) + & - hrv_deadstemc_storage_to_litter(p) * wtcol(p) * stem_prof(p,j) + & - hrv_livecrootc_storage_to_litter(p) * wtcol(p) * croot_prof(p,j) + & - hrv_deadcrootc_storage_to_litter(p) * wtcol(p) * croot_prof(p,j) + & - hrv_gresp_storage_to_litter(p) * wtcol(p) * leaf_prof(p,j) + & - - ! transfer harvest mortality carbon fluxes - hrv_leafc_xfer_to_litter(p) * wtcol(p) * leaf_prof(p,j) + & - hrv_frootc_xfer_to_litter(p) * wtcol(p) * froot_prof(p,j) + & - hrv_livestemc_xfer_to_litter(p) * wtcol(p) * stem_prof(p,j) + & - hrv_deadstemc_xfer_to_litter(p) * wtcol(p) * stem_prof(p,j) + & - hrv_livecrootc_xfer_to_litter(p) * wtcol(p) * croot_prof(p,j) + & - hrv_deadcrootc_xfer_to_litter(p) * wtcol(p) * croot_prof(p,j) + & - hrv_gresp_xfer_to_litter(p) * wtcol(p) * leaf_prof(p,j) - - do i = i_litr_min, i_litr_max - harvest_n_to_litr_n(c,j,i) = & - harvest_n_to_litr_n(c,j,i) + & - ! leaf harvest mortality nitrogen fluxes - hrv_leafn_to_litter(p) * lf_f(ivt(p),i) * wtcol(p) * leaf_prof(p,j) + & - ! fine root litter nitrogen fluxes - hrv_frootn_to_litter(p) * fr_f(ivt(p),i) * wtcol(p) * froot_prof(p,j) - end do - - ! wood harvest mortality nitrogen fluxes - harvest_n_to_cwdn(c,j) = harvest_n_to_cwdn(c,j) + & - hrv_livestemn_to_litter(p) * wtcol(p) * stem_prof(p,j) - harvest_n_to_cwdn(c,j) = harvest_n_to_cwdn(c,j) + & - hrv_livecrootn_to_litter(p) * wtcol(p) * croot_prof(p,j) - harvest_n_to_cwdn(c,j) = harvest_n_to_cwdn(c,j) + & - hrv_deadcrootn_to_litter(p) * wtcol(p) * croot_prof(p,j) - - ! Metabolic litter is treated differently than other types - ! of litter, so it gets this additional line after the - ! most recent loop over all litter types - harvest_n_to_litr_n(c,j,i_met_lit) = & - harvest_n_to_litr_n(c,j,i_met_lit) + & - ! retranslocated N pool harvest mortality fluxes - hrv_retransn_to_litter(p) * wtcol(p) * leaf_prof(p,j) + & - ! storage harvest mortality nitrogen fluxes - hrv_leafn_storage_to_litter(p) * wtcol(p) * leaf_prof(p,j) + & - hrv_frootn_storage_to_litter(p) * wtcol(p) * froot_prof(p,j) + & - hrv_livestemn_storage_to_litter(p) * wtcol(p) * stem_prof(p,j) + & - hrv_deadstemn_storage_to_litter(p) * wtcol(p) * stem_prof(p,j) + & - hrv_livecrootn_storage_to_litter(p) * wtcol(p) * croot_prof(p,j) + & - hrv_deadcrootn_storage_to_litter(p) * wtcol(p) * croot_prof(p,j) + & - ! transfer harvest mortality nitrogen fluxes - hrv_leafn_xfer_to_litter(p) * wtcol(p) * leaf_prof(p,j) + & - hrv_frootn_xfer_to_litter(p) * wtcol(p) * froot_prof(p,j) + & - hrv_livestemn_xfer_to_litter(p) * wtcol(p) * stem_prof(p,j) + & - hrv_deadstemn_xfer_to_litter(p) * wtcol(p) * stem_prof(p,j) + & - hrv_livecrootn_xfer_to_litter(p) * wtcol(p) * croot_prof(p,j) + & - hrv_deadcrootn_xfer_to_litter(p) * wtcol(p) * croot_prof(p,j) - - end if - end if + do fp = 1,num_soilp + p = filter_soilp(fp) + c = patch%column(p) + + do i = i_litr_min, i_litr_max + ! leaf harvest mortality carbon fluxes + harvest_c_to_litr_c(c,j,i) = & + harvest_c_to_litr_c(c,j,i) + & + hrv_leafc_to_litter(p) * lf_f(ivt(p),i) * wtcol(p) * leaf_prof(p,j) + + ! fine root harvest mortality carbon fluxes + harvest_c_to_litr_c(c,j,i) = & + harvest_c_to_litr_c(c,j,i) + & + hrv_frootc_to_litter(p) * fr_f(ivt(p),i) * wtcol(p) * froot_prof(p,j) + end do + ! wood harvest mortality carbon fluxes + harvest_c_to_cwdc(c,j) = harvest_c_to_cwdc(c,j) + & + hrv_livestemc_to_litter(p) * wtcol(p) * stem_prof(p,j) + harvest_c_to_cwdc(c,j) = harvest_c_to_cwdc(c,j) + & + hrv_livecrootc_to_litter(p) * wtcol(p) * croot_prof(p,j) + harvest_c_to_cwdc(c,j) = harvest_c_to_cwdc(c,j) + & + hrv_deadcrootc_to_litter(p) * wtcol(p) * croot_prof(p,j) + + ! storage harvest mortality carbon fluxes + ! Metabolic litter is treated differently than other types + ! of litter, so it gets this additional line after the + ! most recent loop over all litter types + harvest_c_to_litr_c(c,j,i_met_lit) = & + harvest_c_to_litr_c(c,j,i_met_lit) + & + hrv_leafc_storage_to_litter(p) * wtcol(p) * leaf_prof(p,j) + & + hrv_frootc_storage_to_litter(p) * wtcol(p) * froot_prof(p,j) + & + hrv_livestemc_storage_to_litter(p) * wtcol(p) * stem_prof(p,j) + & + hrv_deadstemc_storage_to_litter(p) * wtcol(p) * stem_prof(p,j) + & + hrv_livecrootc_storage_to_litter(p) * wtcol(p) * croot_prof(p,j) + & + hrv_deadcrootc_storage_to_litter(p) * wtcol(p) * croot_prof(p,j) + & + hrv_gresp_storage_to_litter(p) * wtcol(p) * leaf_prof(p,j) + & + + ! transfer harvest mortality carbon fluxes + hrv_leafc_xfer_to_litter(p) * wtcol(p) * leaf_prof(p,j) + & + hrv_frootc_xfer_to_litter(p) * wtcol(p) * froot_prof(p,j) + & + hrv_livestemc_xfer_to_litter(p) * wtcol(p) * stem_prof(p,j) + & + hrv_deadstemc_xfer_to_litter(p) * wtcol(p) * stem_prof(p,j) + & + hrv_livecrootc_xfer_to_litter(p) * wtcol(p) * croot_prof(p,j) + & + hrv_deadcrootc_xfer_to_litter(p) * wtcol(p) * croot_prof(p,j) + & + hrv_gresp_xfer_to_litter(p) * wtcol(p) * leaf_prof(p,j) + + do i = i_litr_min, i_litr_max + harvest_n_to_litr_n(c,j,i) = & + harvest_n_to_litr_n(c,j,i) + & + ! leaf harvest mortality nitrogen fluxes + hrv_leafn_to_litter(p) * lf_f(ivt(p),i) * wtcol(p) * leaf_prof(p,j) + & + ! fine root litter nitrogen fluxes + hrv_frootn_to_litter(p) * fr_f(ivt(p),i) * wtcol(p) * froot_prof(p,j) end do + ! wood harvest mortality nitrogen fluxes + harvest_n_to_cwdn(c,j) = harvest_n_to_cwdn(c,j) + & + hrv_livestemn_to_litter(p) * wtcol(p) * stem_prof(p,j) + harvest_n_to_cwdn(c,j) = harvest_n_to_cwdn(c,j) + & + hrv_livecrootn_to_litter(p) * wtcol(p) * croot_prof(p,j) + harvest_n_to_cwdn(c,j) = harvest_n_to_cwdn(c,j) + & + hrv_deadcrootn_to_litter(p) * wtcol(p) * croot_prof(p,j) + + ! Metabolic litter is treated differently than other types + ! of litter, so it gets this additional line after the + ! most recent loop over all litter types + harvest_n_to_litr_n(c,j,i_met_lit) = & + harvest_n_to_litr_n(c,j,i_met_lit) + & + ! retranslocated N pool harvest mortality fluxes + hrv_retransn_to_litter(p) * wtcol(p) * leaf_prof(p,j) + & + ! storage harvest mortality nitrogen fluxes + hrv_leafn_storage_to_litter(p) * wtcol(p) * leaf_prof(p,j) + & + hrv_frootn_storage_to_litter(p) * wtcol(p) * froot_prof(p,j) + & + hrv_livestemn_storage_to_litter(p) * wtcol(p) * stem_prof(p,j) + & + hrv_deadstemn_storage_to_litter(p) * wtcol(p) * stem_prof(p,j) + & + hrv_livecrootn_storage_to_litter(p) * wtcol(p) * croot_prof(p,j) + & + hrv_deadcrootn_storage_to_litter(p) * wtcol(p) * croot_prof(p,j) + & + ! transfer harvest mortality nitrogen fluxes + hrv_leafn_xfer_to_litter(p) * wtcol(p) * leaf_prof(p,j) + & + hrv_frootn_xfer_to_litter(p) * wtcol(p) * froot_prof(p,j) + & + hrv_livestemn_xfer_to_litter(p) * wtcol(p) * stem_prof(p,j) + & + hrv_deadstemn_xfer_to_litter(p) * wtcol(p) * stem_prof(p,j) + & + hrv_livecrootn_xfer_to_litter(p) * wtcol(p) * croot_prof(p,j) + & + hrv_deadcrootn_xfer_to_litter(p) * wtcol(p) * croot_prof(p,j) + end do end do - do pi = 1,maxsoil_patches - do fc = 1,num_soilc - c = filter_soilc(fc) - - if (pi <= col%npatches(c)) then - p = col%patchi(c) + pi - 1 + do fp = 1,num_soilp + p = filter_soilp(fp) + c = patch%column(p) - if (patch%active(p)) then - ! wood harvest mortality carbon fluxes to product pools - cwood_harvestc(c) = cwood_harvestc(c) + & - pwood_harvestc(p) * wtcol(p) + ! wood harvest mortality carbon fluxes to product pools + cwood_harvestc(c) = cwood_harvestc(c) + & + pwood_harvestc(p) * wtcol(p) - ! wood harvest mortality nitrogen fluxes to product pools - cwood_harvestn(c) = cwood_harvestn(c) + & - pwood_harvestn(p) * wtcol(p) - end if - end if - - end do + ! wood harvest mortality nitrogen fluxes to product pools + cwood_harvestn(c) = cwood_harvestn(c) + & + pwood_harvestn(p) * wtcol(p) end do diff --git a/src/main/clm_driver.F90 b/src/main/clm_driver.F90 index f173d7d83d..1f1132922e 100644 --- a/src/main/clm_driver.F90 +++ b/src/main/clm_driver.F90 @@ -831,6 +831,7 @@ subroutine clm_drv(doalb, nextsw_cday, declinp1, declin, rstwr, nlend, rdate, ro call SoilTemperature(bounds_clump, & filter(nc)%num_urbanl , filter(nc)%urbanl, & filter(nc)%num_urbanc , filter(nc)%urbanc, & + filter(nc)%num_nolakep , filter(nc)%nolakep, & filter(nc)%num_nolakec , filter(nc)%nolakec, & atm2lnd_inst, urbanparams_inst, canopystate_inst, water_inst%waterstatebulk_inst, & water_inst%waterdiagnosticbulk_inst, water_inst%waterfluxbulk_inst, & diff --git a/src/main/clm_varpar.F90 b/src/main/clm_varpar.F90 index f54b750181..ffa851482a 100644 --- a/src/main/clm_varpar.F90 +++ b/src/main/clm_varpar.F90 @@ -113,7 +113,6 @@ module clm_varpar integer, public :: cft_size ! Number of PFTs on crop landunit in arrays of PFTs integer, public :: maxpatch_glc ! max number of elevation classes - integer, public :: max_patch_per_col ! ! !PUBLIC MEMBER FUNCTIONS: public clm_varpar_init ! set parameters @@ -195,13 +194,6 @@ subroutine clm_varpar_init(actual_maxsoil_patches, surf_numpft, surf_numcft) mxharvests = mxsowings + 1 - ! TODO(wjs, 2015-10-04, bugz 2227) Using surf_numcft in this 'max' gives a significant - ! overestimate of max_patch_per_col when use_crop is true. This should be reworked - - ! or, better, removed from the code entirely (because it is a maintenance problem, and - ! I can't imagine that looping idioms that use it help performance that much, and - ! likely they hurt performance.) - max_patch_per_col= max(maxsoil_patches, surf_numcft, maxpatch_urb) - nlevsoifl = 10 nlevurb = 5 diff --git a/src/soilbiogeochem/SoilBiogeochemVerticalProfileMod.F90 b/src/soilbiogeochem/SoilBiogeochemVerticalProfileMod.F90 index 7209bd8278..e882a2fbc7 100644 --- a/src/soilbiogeochem/SoilBiogeochemVerticalProfileMod.F90 +++ b/src/soilbiogeochem/SoilBiogeochemVerticalProfileMod.F90 @@ -71,7 +71,7 @@ subroutine SoilBiogeochemVerticalProfile(bounds, num_soilc,filter_soilc,num_soil real(r8) :: rootfr_tot real(r8) :: cinput_rootfr(bounds%begp:bounds%endp, 1:nlevdecomp_full) ! pft-native root fraction used for calculating inputs real(r8) :: col_cinput_rootfr(bounds%begc:bounds%endc, 1:nlevdecomp_full) ! col-native root fraction used for calculating inputs - integer :: c, j, fc, p, fp, pi + integer :: c, j, fc, p, fp integer :: alt_ind ! debugging temp variables real(r8) :: froot_prof_sum @@ -131,7 +131,6 @@ subroutine SoilBiogeochemVerticalProfile(bounds, num_soilc,filter_soilc,num_soil do j = 1, nlevdecomp cinput_rootfr(p,j) = crootfr(p,j) / dzsoi_decomp(j) end do - else cinput_rootfr(p,1) = 0. endif @@ -176,15 +175,11 @@ subroutine SoilBiogeochemVerticalProfile(bounds, num_soilc,filter_soilc,num_soil ! cinput_rootfr(bounds%begp:bounds%endp, :), & ! col_cinput_rootfr(bounds%begc:bounds%endc, :), & ! 'unity') - do pi = 1,maxsoil_patches - do fc = 1,num_soilc - c = filter_soilc(fc) - if (pi <= col%npatches(c)) then - p = col%patchi(c) + pi - 1 - do j = 1,nlevdecomp - col_cinput_rootfr(c,j) = col_cinput_rootfr(c,j) + cinput_rootfr(p,j) * patch%wtcol(p) - end do - end if + do fp = 1,num_soilp ! TODO slevis: Should it be num_soilp_with_inactive? + p = filter_soilp(fp) ! ...and filter_soilp_with_inactive? + c = patch%column(p) + do j = 1,nlevdecomp + col_cinput_rootfr(c,j) = col_cinput_rootfr(c,j) + cinput_rootfr(p,j) * patch%wtcol(p) end do end do From 633763f3a9ebe2f9beb122ea98c6cc9b56ce9417 Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Thu, 13 Jul 2023 12:09:06 -0600 Subject: [PATCH 096/257] Call CLMFatesTimesteps only if use_fates --- src/main/clm_initializeMod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/main/clm_initializeMod.F90 b/src/main/clm_initializeMod.F90 index 7988fbfc7b..aa7c89ebb9 100644 --- a/src/main/clm_initializeMod.F90 +++ b/src/main/clm_initializeMod.F90 @@ -337,7 +337,7 @@ subroutine initialize2(ni,nj) end if ! Pass model timestep info to FATES - call CLMFatesTimesteps() + if (use_fates) call CLMFatesTimesteps() ! Initialize daylength from the previous time step (needed so prev_dayl can be set correctly) call t_startf('init_orbd') From b1a46db13b23b21813b111c176707afa2a8edea9 Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Fri, 14 Jul 2023 14:59:26 -0600 Subject: [PATCH 097/257] BFB refactor: replace magic numbers with parameters --- cime_config/testdefs/testlist_clm.xml | 2 +- src/biogeophys/BareGroundFluxesMod.F90 | 9 +++--- src/biogeophys/BiogeophysPreFluxCalcsMod.F90 | 5 ++-- src/biogeophys/CanopyFluxesMod.F90 | 8 ++++-- src/biogeophys/FrictionVelocityMod.F90 | 11 ++++---- src/biogeophys/LakeFluxesMod.F90 | 29 ++++++++++---------- src/main/clm_varcon.F90 | 9 ++++++ 7 files changed, 43 insertions(+), 30 deletions(-) diff --git a/cime_config/testdefs/testlist_clm.xml b/cime_config/testdefs/testlist_clm.xml index 6a4a0c56ef..a438498013 100644 --- a/cime_config/testdefs/testlist_clm.xml +++ b/cime_config/testdefs/testlist_clm.xml @@ -17,7 +17,7 @@ - + diff --git a/src/biogeophys/BareGroundFluxesMod.F90 b/src/biogeophys/BareGroundFluxesMod.F90 index c994d238a4..76a07f0f61 100644 --- a/src/biogeophys/BareGroundFluxesMod.F90 +++ b/src/biogeophys/BareGroundFluxesMod.F90 @@ -82,6 +82,7 @@ subroutine BareGroundFluxes(bounds, num_noexposedvegp, filter_noexposedvegp, & use shr_const_mod , only : SHR_CONST_RGAS use clm_varpar , only : nlevgrnd use clm_varcon , only : cpair, vkc, grav, denice, denh2o + use clm_varcon , only : beta_param, nu_param use clm_varctl , only : use_lch4, z0param_method use landunit_varcon , only : istsoil, istcrop use QSatMod , only : QSat @@ -351,15 +352,15 @@ subroutine BareGroundFluxes(bounds, num_noexposedvegp, filter_noexposedvegp, & select case (z0param_method) case ('ZengWang2007') - z0hg_patch(p) = z0mg_patch(p) / exp(params_inst%a_coef * (ustar(p) * z0mg_patch(p) / 1.5e-5_r8)**params_inst%a_exp) + z0hg_patch(p) = z0mg_patch(p) / exp(params_inst%a_coef * (ustar(p) * z0mg_patch(p) / nu_param)**params_inst%a_exp) case ('Meier2022') - ! After Yang et al. (2007) - z0hg_patch(p) = 70._r8 * 1.5e-5_r8 / ustar(p) * exp( -7.2_r8 * ustar(p)**(0.5_r8) * (abs(tstar))**(0.25_r8)) + ! After Yang et al. (2008) + z0hg_patch(p) = 70._r8 * nu_param / ustar(p) * exp( -beta_param * ustar(p)**(0.5_r8) * (abs(tstar))**(0.25_r8)) ! RM: After Owen and Thomson (1963). This formulation could be used as an alternative to Yang et al. (2007). It would ! avoid that z0hg and z0qg becomes larger frequently than z0mg, which happens with Yang et al. (2007). - !z0hg_patch(p) = z0mg_patch(p) / exp(0.52_r8 * 0.4_r8 * (8._r8 * ustar(p) * z0mg_patch(p) / 1.5e-5_r8)**params_inst%a_exp * 0.71_r8**0.8_r8) + !z0hg_patch(p) = z0mg_patch(p) / exp(0.52_r8 * 0.4_r8 * (8._r8 * ustar(p) * z0mg_patch(p) / nu_param)**params_inst%a_exp * 0.71_r8**0.8_r8) end select diff --git a/src/biogeophys/BiogeophysPreFluxCalcsMod.F90 b/src/biogeophys/BiogeophysPreFluxCalcsMod.F90 index 9123000fc5..004e2c689e 100644 --- a/src/biogeophys/BiogeophysPreFluxCalcsMod.F90 +++ b/src/biogeophys/BiogeophysPreFluxCalcsMod.F90 @@ -127,6 +127,7 @@ subroutine SetZ0mDisp(bounds, num_nolakep, filter_nolakep, & ! ! !USES: use clm_time_manager, only : is_first_step, get_nstep, is_beg_curr_year + use clm_varcon , only : cd1_param use decompMod , only : subgrid_level_patch use BalanceCheckMod , only : GetBalanceCheckSkipSteps ! !ARGUMENTS: @@ -191,8 +192,8 @@ subroutine SetZ0mDisp(bounds, num_nolakep, filter_nolakep, & else ! Compute as if elai+esai = LAImax in CanopyFluxes - displa(p) = htop(p) * (1._r8 - (1._r8 - exp(-(7.5_r8 * (pftcon%z0v_LAImax(patch%itype(p))))**0.5_r8)) & - / (7.5_r8*(pftcon%z0v_LAImax(patch%itype(p)) ))**0.5_r8) + displa(p) = htop(p) * (1._r8 - (1._r8 - exp(-(cd1_param * (pftcon%z0v_LAImax(patch%itype(p))))**0.5_r8)) & + / (cd1_param*(pftcon%z0v_LAImax(patch%itype(p)) ))**0.5_r8) U_ustar = 4._r8 * (pftcon%z0v_Cs(patch%itype(p)) + pftcon%z0v_Cr(patch%itype(p)) * (pftcon%z0v_LAImax(patch%itype(p))) & / 2._r8)**(-0.5_r8) / (pftcon%z0v_LAImax(patch%itype(p))) / pftcon%z0v_c(patch%itype(p)) diff --git a/src/biogeophys/CanopyFluxesMod.F90 b/src/biogeophys/CanopyFluxesMod.F90 index c48345edc8..4f60eec304 100644 --- a/src/biogeophys/CanopyFluxesMod.F90 +++ b/src/biogeophys/CanopyFluxesMod.F90 @@ -229,6 +229,7 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, use clm_varcon , only : denh2o, tfrz, tlsai_crit, alpha_aero use clm_varcon , only : c14ratio, spval use clm_varcon , only : c_water, c_dry_biomass, c_to_b + use clm_varcon , only : nu_param, cd1_param use perf_mod , only : t_startf, t_stopf use QSatMod , only : QSat use CLMFatesInterfaceMod, only : hlm_fates_interface_type @@ -238,6 +239,7 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, SwampCoolEff, KtoC, VaporPres use SoilWaterRetentionCurveMod, only : soil_water_retention_curve_type use LunaMod , only : is_time_to_run_LUNA + ! ! !ARGUMENTS: type(bounds_type) , intent(in) :: bounds @@ -893,7 +895,7 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, case ('Meier2022') lt = max(0.00001_r8,elai(p)+esai(p)) - displa(p) = htop(p) * (1._r8 - (1._r8 - exp(-(7.5_r8 * lt)**0.5_r8)) / (7.5_r8*lt)**0.5_r8) + displa(p) = htop(p) * (1._r8 - (1._r8 - exp(-(cd1_param * lt)**0.5_r8)) / (cd1_param*lt)**0.5_r8) lt = min(lt,z0v_LAImax(patch%itype(p))) delt = 2._r8 @@ -1066,9 +1068,9 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, ! just for readability of the code (from line 680) ! RM: Does this need to be updated if Ya08 is used too? Proposed formulation (definitely double-check!) ! , interpreting the statement below as csoilb = vkc / ln(z0mg/z0hg): - ! csoilb = vkc / log( z0mg(c) / ( 70._r8 * 1.5e-5_r8 / ustar(p) * exp( -7.2_r8 * ustar(p)**(0.5_r8) * + ! csoilb = vkc / log( z0mg(c) / ( 70._r8 * nu_param / ustar(p) * exp( -7.2_r8 * ustar(p)**(0.5_r8) * ! (abs(temp1(p)*dth(p)))**(0.25_r8)) ) ) - csoilb = vkc / (params_inst%a_coef * (z0mg(c) * uaf(p) / 1.5e-5_r8)**params_inst%a_exp) + csoilb = vkc / (params_inst%a_coef * (z0mg(c) * uaf(p) / nu_param)**params_inst%a_exp) !compute the stability parameter for ricsoilc ("S" in Sakaguchi&Zeng,2008) diff --git a/src/biogeophys/FrictionVelocityMod.F90 b/src/biogeophys/FrictionVelocityMod.F90 index 3960b6504d..1ea3381b3a 100644 --- a/src/biogeophys/FrictionVelocityMod.F90 +++ b/src/biogeophys/FrictionVelocityMod.F90 @@ -517,7 +517,7 @@ subroutine SetRoughnessLengthsAndForcHeightsNonLake(this, bounds, & ! Set roughness lengths and forcing heights for non-lake points ! ! !USES: - use clm_varcon , only : rpi + use clm_varcon , only : rpi, b1_param, b4_param ! !ARGUMENTS: class(frictionvel_type) , intent(inout) :: this type(bounds_type) , intent(in) :: bounds @@ -579,9 +579,9 @@ subroutine SetRoughnessLengthsAndForcHeightsNonLake(this, bounds, & if (frac_sno(c) > 0._r8) then if(use_z0m_snowmelt) then if ( snomelt_accum(c) < 1.e-5_r8 )then - z0mg(c) = exp( (1.4_r8 * (-rpi/2.0_r8)) -0.31_r8) / 1000._r8 + z0mg(c) = exp(b1_param * (-rpi / 2.0_r8) + b4_param) / 1000._r8 else - z0mg(c) = exp(1.4_r8 * (atan((log10(snomelt_accum(c))+0.23_r8)/0.08_r8))-0.31_r8) / 1000._r8 + z0mg(c) = exp(b1_param * (atan((log10(snomelt_accum(c))+0.23_r8)/0.08_r8)) + b4_param) / 1000._r8 end if else z0mg(c) = this%zsno @@ -594,10 +594,9 @@ subroutine SetRoughnessLengthsAndForcHeightsNonLake(this, bounds, & if (frac_sno(c) > 0._r8) then ! Do snow first because ice could be snow-covered if(use_z0m_snowmelt) then if ( snomelt_accum(c) < 1.e-5_r8 )then - z0mg(c) = exp(-1.4_r8 * rpi/2.0_r8 - 0.31_r8) / 1000.0_r8 + z0mg(c) = exp(-b1_param * rpi / 2.0_r8 + b4_param) / 1000._r8 else - z0mg(c) = exp(1.4_r8 * (atan((log10(snomelt_accum(c))+0.23_r8)/0.08_r8))-0.31_r8) & - / 1000.0_r8 + z0mg(c) = exp(b1_param * (atan((log10(snomelt_accum(c))+0.23_r8)/0.08_r8)) + b4_param) / 1000._r8 end if else z0mg(c) = this%zsno diff --git a/src/biogeophys/LakeFluxesMod.F90 b/src/biogeophys/LakeFluxesMod.F90 index 38ecbc6fbb..ceab64945a 100644 --- a/src/biogeophys/LakeFluxesMod.F90 +++ b/src/biogeophys/LakeFluxesMod.F90 @@ -93,6 +93,7 @@ subroutine LakeFluxes(bounds, num_lakec, filter_lakec, num_lakep, filter_lakep, use clm_varpar , only : nlevlak use clm_varcon , only : hvap, hsub, hfus, cpair, cpliq, tkwat, tkice, tkair use clm_varcon , only : sb, vkc, grav, denh2o, tfrz, spval, rpi + use clm_varcon , only : beta_param, nu_param, b1_param, b4_param use clm_varctl , only : use_lch4, z0param_method, use_z0m_snowmelt use LakeCon , only : betavis, z0frzlake, tdmax, emg_lake use LakeCon , only : lake_use_old_fcrit_minz0 @@ -340,11 +341,11 @@ subroutine LakeFluxes(bounds, num_lakec, filter_lakec, num_lakep, filter_lakep, z0mg(p) = params_inst%zglc - z0hg(p) = 70._r8 * 1.5e-5_r8 / ust_lake(c) ! For initial guess assume tstar = 0 + z0hg(p) = 70._r8 * nu_param / ust_lake(c) ! For initial guess assume tstar = 0 case ('ZengWang2007') z0mg(p) = z0frzlake - z0hg(p) = z0mg(p) / exp(params_inst%a_coef * (ust_lake(c) * z0mg(p) / 1.5e-5_r8)**params_inst%a_exp) ! Consistent with BareGroundFluxes + z0hg(p) = z0mg(p) / exp(params_inst%a_coef * (ust_lake(c) * z0mg(p) / nu_param)**params_inst%a_exp) ! Consistent with BareGroundFluxes end select z0qg(p) = z0hg(p) else ! use roughness over snow as in Biogeophysics1 @@ -352,28 +353,28 @@ subroutine LakeFluxes(bounds, num_lakec, filter_lakec, num_lakep, filter_lakep, case ('Meier2022') if(use_z0m_snowmelt) then if ( snomelt_accum(c) < 1.e-5_r8 )then - z0mg(p) = exp(-1.4_r8 * rpi/2.0_r8 -0.31_r8) / 1000._r8 + z0mg(p) = exp(-b1_param * rpi / 2.0_r8 + b4_param) / 1000._r8 else - z0mg(p) = exp(1.4_r8 * (atan((log10(snomelt_accum(c))+0.23_r8)/0.08_r8))-0.31_r8) / 1000._r8 + z0mg(p) = exp(b1_param * (atan((log10(snomelt_accum(c))+0.23_r8)/0.08_r8)) + b4_param) / 1000._r8 end if else z0mg(p) = params_inst%zsno end if - z0hg(p) = 70._r8 * 1.5e-5_r8 / ust_lake(c) ! For initial guess assume tstar = 0 + z0hg(p) = 70._r8 * nu_param / ust_lake(c) ! For initial guess assume tstar = 0 case ('ZengWang2007') if(use_z0m_snowmelt) then if ( snomelt_accum(c) < 1.e-5_r8 ) then - z0mg(p) = exp((1.4_r8 * (-rpi/2.0_r8)) -0.31_r8) / 1000._r8 + z0mg(p) = exp(b1_param * (-rpi / 2.0_r8) + b4_param) / 1000._r8 else - z0mg(p) = exp(1.4_r8 * (atan((log10(snomelt_accum(c))+0.23_r8)/0.08_r8))-0.31_r8) / 1000._r8 + z0mg(p) = exp(b1_param * (atan((log10(snomelt_accum(c))+0.23_r8)/0.08_r8)) + b4_param) / 1000._r8 end if else z0mg(p) = params_inst%zsno end if - z0hg(p) = z0mg(p) / exp(params_inst%a_coef * (ust_lake(c) * z0mg(p) / 1.5e-5_r8)**params_inst%a_exp) ! Consistent with BareGroundFluxes + z0hg(p) = z0mg(p) / exp(params_inst%a_coef * (ust_lake(c) * z0mg(p) / nu_param)**params_inst%a_exp) ! Consistent with BareGroundFluxes end select z0qg(p) = z0hg(p) end if @@ -603,28 +604,28 @@ subroutine LakeFluxes(bounds, num_lakec, filter_lakec, num_lakep, filter_lakep, case ('Meier2022') z0mg(p) = params_inst%zglc - z0hg(p) = 70._r8 * 1.5e-5_r8 / ustar(p) * exp( -7.2_r8 * ustar(p)**(0.5_r8) * (abs(tstar))**(0.25_r8)) ! Consistent with BareGroundFluxes + z0hg(p) = 70._r8 * nu_param / ustar(p) * exp( -beta_param * ustar(p)**(0.5_r8) * (abs(tstar))**(0.25_r8)) ! Consistent with BareGroundFluxes case ('ZengWang2007') z0mg(p) = z0frzlake - z0hg(p) = z0mg(p) / exp(params_inst%a_coef * (ustar(p) * z0mg(p) / 1.5e-5_r8)**params_inst%a_exp) ! Consistent with BareGroundFluxes + z0hg(p) = z0mg(p) / exp(params_inst%a_coef * (ustar(p) * z0mg(p) / nu_param)**params_inst%a_exp) ! Consistent with BareGroundFluxes end select z0qg(p) = z0hg(p) else ! Snow layers if(use_z0m_snowmelt) then if ( snomelt_accum(c) < 1.e-5_r8 )then - z0mg(p) = exp(-1.4_r8 * rpi/2.0_r8 -0.31_r8) / 1000._r8 + z0mg(p) = exp(-b1_param * rpi / 2.0_r8 + b4_param) / 1000._r8 else - z0mg(p) = exp(1.4_r8 * (atan((log10(snomelt_accum(c))+0.23_r8)/0.08_r8))-0.31_r8) / 1000._r8 + z0mg(p) = exp(b1_param * (atan((log10(snomelt_accum(c))+0.23_r8)/0.08_r8)) + b4_param) / 1000._r8 end if end if select case (z0param_method) case ('Meier2022') - z0hg(p) = 70._r8 * 1.5e-5_r8 / ustar(p) * exp( -7.2_r8 * ustar(p)**(0.5_r8) * (abs(tstar))**(0.25_r8)) ! Consistent with BareGroundFluxes + z0hg(p) = 70._r8 * nu_param / ustar(p) * exp( -beta_param * ustar(p)**(0.5_r8) * (abs(tstar))**(0.25_r8)) ! Consistent with BareGroundFluxes case ('ZengWang2007') - z0hg(p) = z0mg(p) / exp(params_inst%a_coef * (ustar(p) * z0mg(p) / 1.5e-5_r8)**params_inst%a_exp) ! Consistent with BareGroundFluxes + z0hg(p) = z0mg(p) / exp(params_inst%a_coef * (ustar(p) * z0mg(p) / nu_param)**params_inst%a_exp) ! Consistent with BareGroundFluxes end select z0qg(p) = z0hg(p) diff --git a/src/main/clm_varcon.F90 b/src/main/clm_varcon.F90 index 340115fe90..f898e27307 100644 --- a/src/main/clm_varcon.F90 +++ b/src/main/clm_varcon.F90 @@ -154,6 +154,15 @@ module clm_varcon real(r8), public :: c14ratio = 1.e-12_r8 ! real(r8) :: c14ratio = 1._r8 ! debug lets set to 1 to try to avoid numerical errors + !------------------------------------------------------------------ + ! Surface roughness constants + !------------------------------------------------------------------ + real(r8), public, parameter :: beta_param = 7.2_r8 ! Meier et al. (2022) https://doi.org/10.5194/gmd-15-2365-2022 + real(r8), public, parameter :: nu_param = 1.5e-5_r8 ! Meier et al. (2022) kinematic viscosity of air + real(r8), public, parameter :: b1_param = 1.4_r8 ! Meier et al. (2022) empirical constant + real(r8), public, parameter :: b4_param = -0.31_r8 ! Meier et al. (2022) empirical constant + real(r8), public, parameter :: cd1_param = 7.5_r8 ! Meier et al. (2022) originally from Raupach (1994) + !------------------------------------------------------------------ ! Urban building temperature constants !------------------------------------------------------------------ From 09e00123a824d9eb4f8f0b379a4a1d15d574d329 Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Fri, 14 Jul 2023 15:02:59 -0600 Subject: [PATCH 098/257] Answer-changing refactor: repl. some divisions w multiplications --- src/biogeophys/FrictionVelocityMod.F90 | 8 ++++---- src/biogeophys/LakeFluxesMod.F90 | 12 ++++++------ 2 files changed, 10 insertions(+), 10 deletions(-) diff --git a/src/biogeophys/FrictionVelocityMod.F90 b/src/biogeophys/FrictionVelocityMod.F90 index 1ea3381b3a..621bce4117 100644 --- a/src/biogeophys/FrictionVelocityMod.F90 +++ b/src/biogeophys/FrictionVelocityMod.F90 @@ -579,9 +579,9 @@ subroutine SetRoughnessLengthsAndForcHeightsNonLake(this, bounds, & if (frac_sno(c) > 0._r8) then if(use_z0m_snowmelt) then if ( snomelt_accum(c) < 1.e-5_r8 )then - z0mg(c) = exp(b1_param * (-rpi / 2.0_r8) + b4_param) / 1000._r8 + z0mg(c) = exp(-b1_param * rpi * 0.5_r8 + b4_param) * 1.e-3_r8 else - z0mg(c) = exp(b1_param * (atan((log10(snomelt_accum(c))+0.23_r8)/0.08_r8)) + b4_param) / 1000._r8 + z0mg(c) = exp(b1_param * (atan((log10(snomelt_accum(c))+0.23_r8)/0.08_r8)) + b4_param) * 1.e-3_r8 end if else z0mg(c) = this%zsno @@ -594,9 +594,9 @@ subroutine SetRoughnessLengthsAndForcHeightsNonLake(this, bounds, & if (frac_sno(c) > 0._r8) then ! Do snow first because ice could be snow-covered if(use_z0m_snowmelt) then if ( snomelt_accum(c) < 1.e-5_r8 )then - z0mg(c) = exp(-b1_param * rpi / 2.0_r8 + b4_param) / 1000._r8 + z0mg(c) = exp(-b1_param * rpi * 0.5_r8 + b4_param) * 1.e-3_r8 else - z0mg(c) = exp(b1_param * (atan((log10(snomelt_accum(c))+0.23_r8)/0.08_r8)) + b4_param) / 1000._r8 + z0mg(c) = exp(b1_param * (atan((log10(snomelt_accum(c))+0.23_r8)/0.08_r8)) + b4_param) * 1.e-3_r8 end if else z0mg(c) = this%zsno diff --git a/src/biogeophys/LakeFluxesMod.F90 b/src/biogeophys/LakeFluxesMod.F90 index ceab64945a..212a55043d 100644 --- a/src/biogeophys/LakeFluxesMod.F90 +++ b/src/biogeophys/LakeFluxesMod.F90 @@ -353,9 +353,9 @@ subroutine LakeFluxes(bounds, num_lakec, filter_lakec, num_lakep, filter_lakep, case ('Meier2022') if(use_z0m_snowmelt) then if ( snomelt_accum(c) < 1.e-5_r8 )then - z0mg(p) = exp(-b1_param * rpi / 2.0_r8 + b4_param) / 1000._r8 + z0mg(p) = exp(-b1_param * rpi * 0.5_r8 + b4_param) * 1.e-3_r8 else - z0mg(p) = exp(b1_param * (atan((log10(snomelt_accum(c))+0.23_r8)/0.08_r8)) + b4_param) / 1000._r8 + z0mg(p) = exp(b1_param * (atan((log10(snomelt_accum(c))+0.23_r8)/0.08_r8)) + b4_param) * 1.e-3_r8 end if else @@ -367,9 +367,9 @@ subroutine LakeFluxes(bounds, num_lakec, filter_lakec, num_lakep, filter_lakep, case ('ZengWang2007') if(use_z0m_snowmelt) then if ( snomelt_accum(c) < 1.e-5_r8 ) then - z0mg(p) = exp(b1_param * (-rpi / 2.0_r8) + b4_param) / 1000._r8 + z0mg(p) = exp(-b1_param * rpi * 0.5_r8 + b4_param) * 1.e-3_r8 else - z0mg(p) = exp(b1_param * (atan((log10(snomelt_accum(c))+0.23_r8)/0.08_r8)) + b4_param) / 1000._r8 + z0mg(p) = exp(b1_param * (atan((log10(snomelt_accum(c))+0.23_r8)/0.08_r8)) + b4_param) * 1.e-3_r8 end if else z0mg(p) = params_inst%zsno @@ -614,9 +614,9 @@ subroutine LakeFluxes(bounds, num_lakec, filter_lakec, num_lakep, filter_lakep, else ! Snow layers if(use_z0m_snowmelt) then if ( snomelt_accum(c) < 1.e-5_r8 )then - z0mg(p) = exp(-b1_param * rpi / 2.0_r8 + b4_param) / 1000._r8 + z0mg(p) = exp(-b1_param * rpi * 0.5_r8 + b4_param) * 1.e-3_r8 else - z0mg(p) = exp(b1_param * (atan((log10(snomelt_accum(c))+0.23_r8)/0.08_r8)) + b4_param) / 1000._r8 + z0mg(p) = exp(b1_param * (atan((log10(snomelt_accum(c))+0.23_r8)/0.08_r8)) + b4_param) * 1.e-3_r8 end if end if From 548e8be5d32dd6dc1d0a9db3ff9a8531c20b7935 Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Fri, 14 Jul 2023 15:11:44 -0600 Subject: [PATCH 099/257] Change if statement back to what we have in main --- src/main/lnd2glcMod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/main/lnd2glcMod.F90 b/src/main/lnd2glcMod.F90 index 1597ee4517..34f50266ad 100644 --- a/src/main/lnd2glcMod.F90 +++ b/src/main/lnd2glcMod.F90 @@ -204,7 +204,7 @@ subroutine update_lnd2glc(this, bounds, num_do_smb_c, filter_do_smb_c, & ! Make sure we haven't already assigned the coupling fields for this point ! (this could happen, for example, if there were multiple columns in the ! istsoil landunit, which we aren't prepared to handle) - if (1==2) then + if (fields_assigned(g,n)) then write(iulog,*) subname//' ERROR: attempt to assign coupling fields twice for the same index.' write(iulog,*) 'One possible cause is having multiple columns in the istsoil landunit,' write(iulog,*) 'which this routine cannot handle.' From dbb2b6cf7dbbe3fcb86d1a8081b5d9c4ad3549bd Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Fri, 14 Jul 2023 16:13:49 -0600 Subject: [PATCH 100/257] Changed num_allc to num_soilc loops to prevent NaNsin nag -nan tests --- src/biogeochem/CNVegCarbonStateType.F90 | 4 ++-- src/biogeochem/CNVegNitrogenStateType.F90 | 4 ++-- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/src/biogeochem/CNVegCarbonStateType.F90 b/src/biogeochem/CNVegCarbonStateType.F90 index 610689fdb6..681fa2a8d0 100644 --- a/src/biogeochem/CNVegCarbonStateType.F90 +++ b/src/biogeochem/CNVegCarbonStateType.F90 @@ -2747,8 +2747,8 @@ subroutine Summary_carbonstate(this, bounds, num_allc, filter_allc, & this%totc_patch(bounds%begp:bounds%endp), & this%totc_p2c_col(bounds%begc:bounds%endc)) - do fc = 1,num_allc - c = filter_allc(fc) + do fc = 1,num_soilc + c = filter_soilc(fc) ! total ecosystem carbon, including veg but excluding cpool (TOTECOSYSC) this%totecosysc_col(c) = & diff --git a/src/biogeochem/CNVegNitrogenStateType.F90 b/src/biogeochem/CNVegNitrogenStateType.F90 index f09311e518..669a22d4f7 100644 --- a/src/biogeochem/CNVegNitrogenStateType.F90 +++ b/src/biogeochem/CNVegNitrogenStateType.F90 @@ -1157,8 +1157,8 @@ subroutine Summary_nitrogenstate(this, bounds, num_allc, filter_allc, & this%totn_patch(bounds%begp:bounds%endp), & this%totn_p2c_col(bounds%begc:bounds%endc)) - do fc = 1,num_allc - c = filter_allc(fc) + do fc = 1,num_soilc + c = filter_soilc(fc) ! total ecosystem nitrogen, including veg (TOTECOSYSN) this%totecosysn_col(c) = & From 578b0bf44aa085a664e6b3b47ce01d3fdcad9776 Mon Sep 17 00:00:00 2001 From: adrifoster Date: Sun, 16 Jul 2023 11:09:04 -0600 Subject: [PATCH 101/257] fix comment for new fates test --- cime_config/testdefs/testlist_clm.xml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cime_config/testdefs/testlist_clm.xml b/cime_config/testdefs/testlist_clm.xml index 0575ea8086..68c3f39867 100644 --- a/cime_config/testdefs/testlist_clm.xml +++ b/cime_config/testdefs/testlist_clm.xml @@ -2388,7 +2388,7 @@ - + From 18e6a0de0994952d8350ee9a4116e852c009065f Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Mon, 17 Jul 2023 13:23:50 -0600 Subject: [PATCH 102/257] Reverse part of commit https://github.com/ESCOMP/CTSM/pull/2051/commits/9816cf07626a9c4aba20c5f6519a5ec1bbdb1a24 --- src/main/surfrdUtilsMod.F90 | 7 ++----- 1 file changed, 2 insertions(+), 5 deletions(-) diff --git a/src/main/surfrdUtilsMod.F90 b/src/main/surfrdUtilsMod.F90 index af9e64d86a..d84b829310 100644 --- a/src/main/surfrdUtilsMod.F90 +++ b/src/main/surfrdUtilsMod.F90 @@ -58,15 +58,12 @@ subroutine check_sums_equal_1(arr, lb, name, caller, ier, sumto) ub = ubound(arr, 1) allocate(TotalSum(lb:ub)) + TotalSum = 1._r8 + if ( present(sumto) ) TotalSum = sumto if( present(ier) ) ier = 0 found = .false. do nl = lb, ub - if ( present(sumto) ) then - TotalSum(nl) = sumto(nl) - else - TotalSum(nl) = 1._r8 - end if if (abs(sum(arr(nl,:)) - TotalSum(nl)) > eps) then found = .true. nindx = nl From a57f188f469bad3a960a9c8cff294cca8183096c Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Tue, 18 Jul 2023 12:02:17 -0600 Subject: [PATCH 103/257] Eliminate repetitive code in LakeFluxesMod --- src/biogeophys/LakeFluxesMod.F90 | 32 +++++++++++--------------------- 1 file changed, 11 insertions(+), 21 deletions(-) diff --git a/src/biogeophys/LakeFluxesMod.F90 b/src/biogeophys/LakeFluxesMod.F90 index 212a55043d..11b141100c 100644 --- a/src/biogeophys/LakeFluxesMod.F90 +++ b/src/biogeophys/LakeFluxesMod.F90 @@ -349,33 +349,23 @@ subroutine LakeFluxes(bounds, num_lakec, filter_lakec, num_lakep, filter_lakep, end select z0qg(p) = z0hg(p) else ! use roughness over snow as in Biogeophysics1 + if(use_z0m_snowmelt) then + if ( snomelt_accum(c) < 1.e-5_r8 ) then + z0mg(p) = exp(-b1_param * rpi * 0.5_r8 + b4_param) * 1.e-3_r8 + else + z0mg(p) = exp(b1_param * (atan((log10(snomelt_accum(c))+0.23_r8)/0.08_r8)) + b4_param) * 1.e-3_r8 + end if + else + z0mg(p) = params_inst%zsno + end if + select case (z0param_method) case ('Meier2022') - if(use_z0m_snowmelt) then - if ( snomelt_accum(c) < 1.e-5_r8 )then - z0mg(p) = exp(-b1_param * rpi * 0.5_r8 + b4_param) * 1.e-3_r8 - else - z0mg(p) = exp(b1_param * (atan((log10(snomelt_accum(c))+0.23_r8)/0.08_r8)) + b4_param) * 1.e-3_r8 - end if - - else - z0mg(p) = params_inst%zsno - - end if z0hg(p) = 70._r8 * nu_param / ust_lake(c) ! For initial guess assume tstar = 0 - case ('ZengWang2007') - if(use_z0m_snowmelt) then - if ( snomelt_accum(c) < 1.e-5_r8 ) then - z0mg(p) = exp(-b1_param * rpi * 0.5_r8 + b4_param) * 1.e-3_r8 - else - z0mg(p) = exp(b1_param * (atan((log10(snomelt_accum(c))+0.23_r8)/0.08_r8)) + b4_param) * 1.e-3_r8 - end if - else - z0mg(p) = params_inst%zsno - end if z0hg(p) = z0mg(p) / exp(params_inst%a_coef * (ust_lake(c) * z0mg(p) / nu_param)**params_inst%a_exp) ! Consistent with BareGroundFluxes end select + z0qg(p) = z0hg(p) end if From 92a87e85aadc249300e45c42f66c4aa0de032722 Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Tue, 18 Jul 2023 17:26:49 -0600 Subject: [PATCH 104/257] Change two intent(out) to (inout) to eliminate NaNs in nag test --- src/biogeophys/PhotosynthesisMod.F90 | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/src/biogeophys/PhotosynthesisMod.F90 b/src/biogeophys/PhotosynthesisMod.F90 index 5b2c68a0fb..a721086e22 100644 --- a/src/biogeophys/PhotosynthesisMod.F90 +++ b/src/biogeophys/PhotosynthesisMod.F90 @@ -2706,7 +2706,6 @@ subroutine PhotosynthesisHydraulicStress ( bounds, fn, filterp, & use clm_varpar , only : nlevsoi use pftconMod , only : nbrdlf_dcd_tmp_shrub, npcropmin use ColumnType , only : col - use shr_infnan_mod , only : shr_infnan_isnan ! ! !ARGUMENTS: @@ -3477,6 +3476,7 @@ subroutine PhotosynthesisHydraulicStress ( bounds, fn, filterp, & else gsminsun = nan gsminsha = nan + call endrun( 'ERROR:: Photosynthesis::PhotosynthesisHydraulicStress must choose stomatalcond_mtd method' ) end if call calcstress(p,c,vegwp(p,:),bsun(p),bsha(p),gb_mol(p),gsminsun, gsminsha, & qsatl(p),qaf(p), atm2lnd_inst,canopystate_inst,waterdiagnosticbulk_inst, & @@ -4064,8 +4064,8 @@ subroutine brent_PHS(xsun, x1sun, x2sun, f1sun, f2sun, xsha, x1sha, x2sha, f1sha real(r8), intent(in) :: lmr_z_sun, lmr_z_sha ! canopy layer: leaf maintenance respiration rate (umol CO2/m**2/s) real(r8), intent(in) :: par_z_sun, par_z_sha ! par absorbed per unit lai for canopy layer (w/m**2) real(r8), intent(in) :: rh_can ! inside canopy relative humidity - real(r8), intent(out) :: gs_mol_sun ! sunlit leaf stomatal conductance (umol H2O/m**2/s) - real(r8), intent(out) :: gs_mol_sha ! shaded leaf stomatal conductance (umol H2O/m**2/s) + real(r8), intent(inout) :: gs_mol_sun ! sunlit leaf stomatal conductance (umol H2O/m**2/s) + real(r8), intent(inout) :: gs_mol_sha ! shaded leaf stomatal conductance (umol H2O/m**2/s) real(r8), intent(inout) :: bsun ! sunlit canopy transpiration wetness factor (0 to 1) real(r8), intent(inout) :: bsha ! shaded canopy transpiration wetness factor (0 to 1) real(r8), intent(in) :: qsatl ! leaf specific humidity [kg/kg] @@ -4344,6 +4344,7 @@ subroutine ci_func_PHS(x,cisun, cisha, fvalsun, fvalsha, p, iv, c, bsun, bsha, b gs_mol_sun = bbb(p) else gs_mol_sun = nan + call endrun( 'ERROR:: Photosynthesis::ci_func_PHS must choose stomatalcond_mtd method' ) end if gs_mol_sun = max( bsun*gs_mol_sun, 1._r8) fvalsun = 0._r8 ! really tho? zqz @@ -4355,6 +4356,7 @@ subroutine ci_func_PHS(x,cisun, cisha, fvalsun, fvalsha, p, iv, c, bsun, bsha, b gs_mol_sha = bbb(p) else gs_mol_sha = nan + call endrun( 'ERROR:: Photosynthesis::ci_func_PHS must choose stomatalcond_mtd method' ) end if gs_mol_sha = max( bsha*gs_mol_sha, 1._r8) fvalsha = 0._r8 From 27f336d5c96115db6c795f31ee25c1de648c74b2 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Wed, 19 Jul 2023 15:11:53 -0600 Subject: [PATCH 105/257] Return this to what it was before the FATES addition should come later --- src/main/filterMod.F90 | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/src/main/filterMod.F90 b/src/main/filterMod.F90 index 5b39b972fa..0b7d230a54 100644 --- a/src/main/filterMod.F90 +++ b/src/main/filterMod.F90 @@ -477,8 +477,7 @@ subroutine setFiltersOneGroup(bounds, this_filter, include_inactive, glc_behavio fl = 0 fnl = 0 do p = bounds%begp,bounds%endp - if(.not.use_fates)then - if ((patch%active(p) .or. include_inactive)) then + if (patch%active(p) .or. include_inactive) then if (patch%itype(p) >= npcropmin) then !skips 2 generic crop types fl = fl + 1 this_filter(nc)%pcropp(fl) = p @@ -490,7 +489,6 @@ subroutine setFiltersOneGroup(bounds, this_filter, include_inactive, glc_behavio end if end if end if - end if end do this_filter(nc)%num_pcropp = fl this_filter(nc)%num_soilnopcropp = fnl ! This wasn't being set before... From 132f4eb72d18ec9cb9aa4a82f40d9889d31fef1d Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Wed, 19 Jul 2023 16:18:22 -0600 Subject: [PATCH 106/257] Check that with FATES on neither LUNA nor FUN can be on --- bld/unit_testers/build-namelist_test.pl | 12 +++++++++++- 1 file changed, 11 insertions(+), 1 deletion(-) diff --git a/bld/unit_testers/build-namelist_test.pl b/bld/unit_testers/build-namelist_test.pl index ed6328c166..e62bf7b1d4 100755 --- a/bld/unit_testers/build-namelist_test.pl +++ b/bld/unit_testers/build-namelist_test.pl @@ -163,7 +163,7 @@ sub cat_and_create_namelistinfile { # # Figure out number of tests that will run # -my $ntests = 1975; +my $ntests = 1977; if ( defined($opts{'compare'}) ) { $ntests += 1344; } @@ -984,6 +984,16 @@ sub cat_and_create_namelistinfile { GLC_TWO_WAY_COUPLING=>"FALSE", phys=>"clm5_1", }, + "useFATESWluna" =>{ options=>"--bgc fates --envxml_dir . --no-megan", + namelst=>"use_luna=TRUE", + GLC_TWO_WAY_COUPLING=>"FALSE", + phys=>"clm5_1", + }, + "useFATESWfun" =>{ options=>"--bgc fates --envxml_dir . --no-megan", + namelst=>"use_fun=TRUE", + GLC_TWO_WAY_COUPLING=>"FALSE", + phys=>"clm5_1", + }, "FireNoneButBGCfireon" =>{ options=>"-bgc bgc -envxml_dir . -light_res none", namelst=>"fire_method='li2021gswpfrc'", GLC_TWO_WAY_COUPLING=>"FALSE", From d4261c8f1c2f642d75dc9e119d6f7053d22f43f8 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Wed, 19 Jul 2023 17:22:13 -0600 Subject: [PATCH 107/257] Explicitly make sure you can not turn LUNA on with FATES, and add a use_luna setting for FATES with clm4_5 that was missing --- bld/CLMBuildNamelist.pm | 6 ++++++ bld/namelist_files/namelist_defaults_ctsm.xml | 1 + 2 files changed, 7 insertions(+) diff --git a/bld/CLMBuildNamelist.pm b/bld/CLMBuildNamelist.pm index 545fee3731..6cc16ecb96 100755 --- a/bld/CLMBuildNamelist.pm +++ b/bld/CLMBuildNamelist.pm @@ -3307,6 +3307,12 @@ sub setup_logic_luna { 'use_cn'=>$nl_flags->{'use_cn'} ); } $nl_flags->{'use_luna'} = $nl->get_value('use_luna'); + + # LUNA can NOT be on with FATES + if ( &value_is_true( $nl_flags->{'use_luna'} ) && &value_is_true( $nl_flags->{'use_fates'} )) { + $log->fatal_error("Cannot turn use_luna to true when bgc=fates" ); + } + my $vcmax_opt= $nl->get_value('vcmax_opt'); # lnc_opt only applies if luna is on or for vcmax_opt=3/4 if ( &value_is_true( $nl_flags->{'use_luna'} ) || $vcmax_opt == 3 || $vcmax_opt == 4 ) { diff --git a/bld/namelist_files/namelist_defaults_ctsm.xml b/bld/namelist_files/namelist_defaults_ctsm.xml index e0ad42e4f7..9d2dc1920d 100644 --- a/bld/namelist_files/namelist_defaults_ctsm.xml +++ b/bld/namelist_files/namelist_defaults_ctsm.xml @@ -510,6 +510,7 @@ attributes from the config_cache.xml file (with keys converted to upper-case). .true. .false. .false. +.false. .true. From d2306c52931814210d247ad06d1a003cd677375e Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Wed, 19 Jul 2023 17:29:57 -0600 Subject: [PATCH 108/257] Add a test that FATES with suplemental nitrogen on is NOT allowed, this test fails because that isn't in yet --- bld/unit_testers/build-namelist_test.pl | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/bld/unit_testers/build-namelist_test.pl b/bld/unit_testers/build-namelist_test.pl index e62bf7b1d4..5bb32167f2 100755 --- a/bld/unit_testers/build-namelist_test.pl +++ b/bld/unit_testers/build-namelist_test.pl @@ -163,7 +163,7 @@ sub cat_and_create_namelistinfile { # # Figure out number of tests that will run # -my $ntests = 1977; +my $ntests = 1978; if ( defined($opts{'compare'}) ) { $ntests += 1344; } @@ -994,6 +994,11 @@ sub cat_and_create_namelistinfile { GLC_TWO_WAY_COUPLING=>"FALSE", phys=>"clm5_1", }, + "useFATESWOsuplnitro" =>{ options=>"--bgc fates --envxml_dir . --no-megan", + namelst=>"suplnitro='NONE'", + GLC_TWO_WAY_COUPLING=>"FALSE", + phys=>"clm5_1", + }, "FireNoneButBGCfireon" =>{ options=>"-bgc bgc -envxml_dir . -light_res none", namelst=>"fire_method='li2021gswpfrc'", GLC_TWO_WAY_COUPLING=>"FALSE", From bfe8cf080ca2b70e4323715b5e7b4c40e39ac3c0 Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Wed, 19 Jul 2023 18:27:54 -0600 Subject: [PATCH 109/257] Change three intent(out) to (inout) to prevent NaNs in nag test --- src/biogeophys/PhotosynthesisMod.F90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/biogeophys/PhotosynthesisMod.F90 b/src/biogeophys/PhotosynthesisMod.F90 index a721086e22..beda9d0bc5 100644 --- a/src/biogeophys/PhotosynthesisMod.F90 +++ b/src/biogeophys/PhotosynthesisMod.F90 @@ -2266,7 +2266,7 @@ subroutine hybrid(x0, p, iv, c, gb_mol, je, cair, oair, lmr_z, par_z,& real(r8), intent(in) :: cair ! Atmospheric CO2 partial pressure (Pa) real(r8), intent(in) :: oair ! Atmospheric O2 partial pressure (Pa) integer, intent(in) :: p, iv, c ! pft, c3/c4, and column index - real(r8), intent(out) :: gs_mol ! leaf stomatal conductance (umol H2O/m**2/s) + real(r8), intent(inout) :: gs_mol ! leaf stomatal conductance (umol H2O/m**2/s) integer, intent(out) :: iter !number of iterations used, for record only type(atm2lnd_type) , intent(in) :: atm2lnd_inst type(photosyns_type), intent(inout) :: photosyns_inst @@ -2378,7 +2378,7 @@ subroutine brent(x, x1,x2,f1, f2, tol, ip, iv, ic, gb_mol, je, cair, oair,& real(r8), intent(in) :: oair ! Atmospheric O2 partial pressure (Pa) real(r8), intent(in) :: rh_can ! inside canopy relative humidity integer, intent(in) :: ip, iv, ic ! pft, c3/c4, and column index - real(r8), intent(out) :: gs_mol ! leaf stomatal conductance (umol H2O/m**2/s) + real(r8), intent(inout) :: gs_mol ! leaf stomatal conductance (umol H2O/m**2/s) type(atm2lnd_type) , intent(in) :: atm2lnd_inst type(photosyns_type), intent(inout) :: photosyns_inst ! @@ -2568,7 +2568,7 @@ subroutine ci_func(ci, fval, p, iv, c, gb_mol, je, cair, oair, lmr_z, par_z,& real(r8) , intent(in) :: rh_can ! canopy air realtive humidity integer , intent(in) :: p, iv, c ! pft, vegetation type and column indexes real(r8) , intent(out) :: fval ! return function of the value f(ci) - real(r8) , intent(out) :: gs_mol ! leaf stomatal conductance (umol H2O/m**2/s) + real(r8) , intent(inout) :: gs_mol ! leaf stomatal conductance (umol H2O/m**2/s) type(atm2lnd_type) , intent(in) :: atm2lnd_inst type(photosyns_type) , intent(inout) :: photosyns_inst ! From 80977d7c8a65f6b7f1d9120c03b03d50a9503779 Mon Sep 17 00:00:00 2001 From: adrifoster Date: Thu, 20 Jul 2023 10:23:41 -0600 Subject: [PATCH 110/257] we can now run FATES with 1 deg in SP mode --- cime_config/testdefs/testlist_clm.xml | 4 ++-- .../testmods_dirs/clm/FatesColdSatPhen_prescribed/README | 3 --- .../clm/FatesColdSatPhen_prescribed/user_nl_clm | 8 ++++---- 3 files changed, 6 insertions(+), 9 deletions(-) delete mode 100644 cime_config/testdefs/testmods_dirs/clm/FatesColdSatPhen_prescribed/README diff --git a/cime_config/testdefs/testlist_clm.xml b/cime_config/testdefs/testlist_clm.xml index 68c3f39867..73b951c488 100644 --- a/cime_config/testdefs/testlist_clm.xml +++ b/cime_config/testdefs/testlist_clm.xml @@ -2382,13 +2382,13 @@ - + - + diff --git a/cime_config/testdefs/testmods_dirs/clm/FatesColdSatPhen_prescribed/README b/cime_config/testdefs/testmods_dirs/clm/FatesColdSatPhen_prescribed/README deleted file mode 100644 index 116e0f43b4..0000000000 --- a/cime_config/testdefs/testmods_dirs/clm/FatesColdSatPhen_prescribed/README +++ /dev/null @@ -1,3 +0,0 @@ -This testmod currently only works with lai streams (not soil moisture), because of FATES issue #845 - -See https://github.com/NGEET/fates/issues/845 diff --git a/cime_config/testdefs/testmods_dirs/clm/FatesColdSatPhen_prescribed/user_nl_clm b/cime_config/testdefs/testmods_dirs/clm/FatesColdSatPhen_prescribed/user_nl_clm index eb7a85165c..a1ea0e0cf8 100644 --- a/cime_config/testdefs/testmods_dirs/clm/FatesColdSatPhen_prescribed/user_nl_clm +++ b/cime_config/testdefs/testmods_dirs/clm/FatesColdSatPhen_prescribed/user_nl_clm @@ -1,8 +1,8 @@ ! right now we can't do prescribed soil moisture because of FATES issue #845 - !use_soil_moisture_streams = .true. + use_soil_moisture_streams = .true. use_lai_streams = .true. - !hist_fincl1 += 'H2OSOI_PRESCRIBED_GRC' - !soilm_tintalgo = 'lower' ! set time interpolation to use lower value, so can compare to input dataset + hist_fincl1 += 'H2OSOI_PRESCRIBED_GRC' + soilm_tintalgo = 'lower' ! set time interpolation to use lower value, so can compare to input dataset lai_tintalgo = 'lower' ! set time interpolation to use lower value, so can compare more directly to input dataset - !soilm_ignore_data_if_missing = .true. + soilm_ignore_data_if_missing = .true. \ No newline at end of file From 80ba5e8e197395067e8eb3e3bed942dfac069efa Mon Sep 17 00:00:00 2001 From: adrifoster Date: Thu, 20 Jul 2023 10:40:22 -0600 Subject: [PATCH 111/257] update to use constant --- src/utils/clmfates_interfaceMod.F90 | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/src/utils/clmfates_interfaceMod.F90 b/src/utils/clmfates_interfaceMod.F90 index 8a3be405ff..c87482b80b 100644 --- a/src/utils/clmfates_interfaceMod.F90 +++ b/src/utils/clmfates_interfaceMod.F90 @@ -159,6 +159,7 @@ module CLMFatesInterfaceMod use dynHarvestMod , only : dynHarvest_interp_resolve_harvesttypes use FatesConstantsMod , only : hlm_harvest_area_fraction use FatesConstantsMod , only : hlm_harvest_carbon + use FatesConstantsMod , only : area_error use perf_mod , only : t_startf, t_stopf implicit none @@ -713,10 +714,10 @@ subroutine init(this, bounds_proc ) this%fates(nc)%bc_in(s)%pft_areafrac(ft)=wt_nat_patch(g,m) end do - if(abs(sum(this%fates(nc)%bc_in(s)%pft_areafrac(surfpft_lb:surfpft_ub))-1.0_r8).gt.1.0e-9)then - write(iulog,*) 'pft_area error in interfc ',s, sum(this%fates(nc)%bc_in(s)%pft_areafrac(:))-1.0_r8 + if (abs(sum(this%fates(nc)%bc_in(s)%pft_areafrac(surfpft_lb:surfpft_ub)) - 1.0_r8) > area_error) then + write(iulog,*) 'pft_area error in interfc ', s, sum(this%fates(nc)%bc_in(s)%pft_areafrac(:)) - 1.0_r8 call endrun(msg=errMsg(sourcefile, __LINE__)) - endif + end if end do !site ! Initialize site-level static quantities dictated by the HLM From d40dd88407b4eae13d3d397bac5d705a2cfd7ed3 Mon Sep 17 00:00:00 2001 From: adrifoster Date: Thu, 20 Jul 2023 14:53:26 -0600 Subject: [PATCH 112/257] need to check lai streams --- bld/CLMBuildNamelist.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/bld/CLMBuildNamelist.pm b/bld/CLMBuildNamelist.pm index d906fd6c62..8d8a46f7fc 100755 --- a/bld/CLMBuildNamelist.pm +++ b/bld/CLMBuildNamelist.pm @@ -3878,7 +3878,7 @@ sub setup_logic_lai_streams { if ( &value_is_true($nl_flags->{'use_crop'}) && &value_is_true($nl->get_value('use_lai_streams')) ) { $log->fatal_error("turning use_lai_streams on is incompatable with use_crop set to true."); } - if ( $nl_flags->{'bgc_mode'} eq "sp" || $nl_flags->{'bgc_mode'} eq "fates" ) { + if ( ($nl_flags->{'bgc_mode'} eq "sp" || $nl_flags->{'bgc_mode'} eq "fates") && &value_is_true($nl->get_value('use_lai_streams')) ) { if ( $nl_flags->{'bgc_mode'} eq "fates" && ! &value_is_true($nl->get_value('use_fates_sp')) ) { $log->fatal_error("Must have use_fates_sp turned on to run FATES with LAI streams."); } From dbcbe05d69c890c9c4f1f6c5a78dae7143907f63 Mon Sep 17 00:00:00 2001 From: adrifoster Date: Thu, 20 Jul 2023 14:54:08 -0600 Subject: [PATCH 113/257] need to check lai streams --- bld/CLMBuildNamelist.pm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/bld/CLMBuildNamelist.pm b/bld/CLMBuildNamelist.pm index 8d8a46f7fc..083bff2ed7 100755 --- a/bld/CLMBuildNamelist.pm +++ b/bld/CLMBuildNamelist.pm @@ -3878,8 +3878,8 @@ sub setup_logic_lai_streams { if ( &value_is_true($nl_flags->{'use_crop'}) && &value_is_true($nl->get_value('use_lai_streams')) ) { $log->fatal_error("turning use_lai_streams on is incompatable with use_crop set to true."); } - if ( ($nl_flags->{'bgc_mode'} eq "sp" || $nl_flags->{'bgc_mode'} eq "fates") && &value_is_true($nl->get_value('use_lai_streams')) ) { - if ( $nl_flags->{'bgc_mode'} eq "fates" && ! &value_is_true($nl->get_value('use_fates_sp')) ) { + if ( ($nl_flags->{'bgc_mode'} eq "sp" || $nl_flags->{'bgc_mode'} eq "fates") ) { + if ( $nl_flags->{'bgc_mode'} eq "fates" && ! &value_is_true($nl->get_value('use_fates_sp')) && &value_is_true($nl->get_value('use_lai_streams'))) { $log->fatal_error("Must have use_fates_sp turned on to run FATES with LAI streams."); } if ( &value_is_true($nl->get_value('use_lai_streams')) ) { From 739cf7c2269dc8db60135740efe6789f912c0452 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Thu, 20 Jul 2023 16:20:31 -0600 Subject: [PATCH 114/257] Add error check for suplnitro for FATES --- bld/CLMBuildNamelist.pm | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/bld/CLMBuildNamelist.pm b/bld/CLMBuildNamelist.pm index 6cc16ecb96..5e0acd9ac6 100755 --- a/bld/CLMBuildNamelist.pm +++ b/bld/CLMBuildNamelist.pm @@ -4220,6 +4220,13 @@ sub setup_logic_fates { add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, $var, 'use_fates'=>$nl_flags->{'use_fates'}, 'use_fates_sp'=>$nl_flags->{'use_fates_sp'} ); } + my $suplnitro = $nl->get_value('suplnitro'); + my $parteh_mode = $nl->get_value('fates_parteh_mode'); + if ( ($parteh_mode == 1) && ($suplnitro !~ /ALL/) && not &value_is_true( $nl_flags->{'use_fates_sp'}) ) { + $log->fatal_error("supplemental Nitrogen (suplnitro) is NOT set to ALL, FATES is on, " . + "but and FATES-SP is not active, but fates_parteh_mode is 1, so Nitrogen is not active" . + "Change suplnitro back to ALL"); + } # # For FATES SP mode make sure no-competetiion, and fixed-biogeography are also set # And also check for other settings that can't be trigged on as well From 0f263e736690e1de5c05c032723d392ba382fe99 Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Fri, 21 Jul 2023 12:29:15 -0600 Subject: [PATCH 115/257] Rm if(use_biomass_heat_storage) and return to original code here --- src/biogeophys/CanopyFluxesMod.F90 | 12 +----------- 1 file changed, 1 insertion(+), 11 deletions(-) diff --git a/src/biogeophys/CanopyFluxesMod.F90 b/src/biogeophys/CanopyFluxesMod.F90 index 4f60eec304..baea39ae95 100644 --- a/src/biogeophys/CanopyFluxesMod.F90 +++ b/src/biogeophys/CanopyFluxesMod.F90 @@ -1393,17 +1393,7 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, zeta(p) = zldis(p)*vkc*grav*thvstar/(ustar(p)**2*thv(c)) if (zeta(p) >= 0._r8) then !stable - ! remove stability cap when biomass heat storage is active - if(use_biomass_heat_storage) then - ! TODO(KWO, 2022-03-15) Only for Meier2022 for now to maintain bfb with ZengWang2007 - if (z0param_method == 'Meier2022') then - zeta(p) = min(zetamax,max(zeta(p),0.01_r8)) - else - zeta(p) = min(100._r8,max(zeta(p),0.01_r8)) - end if - else - zeta(p) = min(zetamax,max(zeta(p),0.01_r8)) - endif + zeta(p) = min(zetamax,max(zeta(p),0.01_r8)) um(p) = max(ur(p),0.1_r8) else !unstable zeta(p) = max(-100._r8,min(zeta(p),-0.01_r8)) From c21e88fa202b001fdcbb7f78e5d7d3409e34737d Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Fri, 21 Jul 2023 12:38:15 -0600 Subject: [PATCH 116/257] Replace more divisions with multiplications in Meier2022 code --- src/biogeophys/CanopyFluxesMod.F90 | 4 ++-- src/biogeophys/SnowHydrologyMod.F90 | 2 +- src/biogeophys/SoilTemperatureMod.F90 | 2 +- 3 files changed, 4 insertions(+), 4 deletions(-) diff --git a/src/biogeophys/CanopyFluxesMod.F90 b/src/biogeophys/CanopyFluxesMod.F90 index baea39ae95..75c77fcd25 100644 --- a/src/biogeophys/CanopyFluxesMod.F90 +++ b/src/biogeophys/CanopyFluxesMod.F90 @@ -899,8 +899,8 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, lt = min(lt,z0v_LAImax(patch%itype(p))) delt = 2._r8 - U_ustar_ini = (z0v_Cs(patch%itype(p)) + z0v_Cr(patch%itype(p)) * lt / 2._r8)**(-0.5_r8) & - *z0v_c(patch%itype(p)) * lt / 4._r8 + U_ustar_ini = (z0v_Cs(patch%itype(p)) + z0v_Cr(patch%itype(p)) * lt * 0.5_r8)**(-0.5_r8) & + *z0v_c(patch%itype(p)) * lt * 0.25_r8 U_ustar = U_ustar_ini do while (delt > 0.0001_r8) diff --git a/src/biogeophys/SnowHydrologyMod.F90 b/src/biogeophys/SnowHydrologyMod.F90 index dc1676ca7d..91689a9d28 100644 --- a/src/biogeophys/SnowHydrologyMod.F90 +++ b/src/biogeophys/SnowHydrologyMod.F90 @@ -491,7 +491,7 @@ subroutine BulkDiag_NewSnowDiagnostics(bounds, num_c, filter_c, & ! all snow falls on ground, no snow on h2osfc (note that qflx_snow_h2osfc is ! currently set to 0 always in CanopyHydrologyMod) newsnow(c) = qflx_snow_grnd(c) * dtime - snomelt_accum(c) = max(0._r8, snomelt_accum(c) - newsnow(c)/1000._r8) + snomelt_accum(c) = max(0._r8, snomelt_accum(c) - newsnow(c) * 1.e-3_r8) ! update int_snow int_snow(c) = max(int_snow(c),h2osno_total(c)) !h2osno_total could be larger due to frost diff --git a/src/biogeophys/SoilTemperatureMod.F90 b/src/biogeophys/SoilTemperatureMod.F90 index 061fb3a2b2..69a452081f 100644 --- a/src/biogeophys/SoilTemperatureMod.F90 +++ b/src/biogeophys/SoilTemperatureMod.F90 @@ -1382,7 +1382,7 @@ subroutine Phasechange_beta (bounds, num_nolakec, filter_nolakec, dhsdT, & if (imelt(c,j) == 1 .AND. j < 1) then qflx_snomelt_lyr(c,j) = max(0._r8,(wice0(c,j)-h2osoi_ice(c,j)))/dtime qflx_snomelt(c) = qflx_snomelt(c) + qflx_snomelt_lyr(c,j) - snomelt_accum(c) = snomelt_accum(c) + qflx_snomelt_lyr(c,j) * dtime/1000._r8 + snomelt_accum(c) = snomelt_accum(c) + qflx_snomelt_lyr(c,j) * dtime * 1.e-3_r8 endif ! layer freezing mass flux (positive): From d4ed2f66209aa5c0fd1cc8b9092e375337451fdb Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Mon, 24 Jul 2023 10:17:32 -0600 Subject: [PATCH 117/257] resolving reviewer requests for clmfate-cbalance --- src/biogeochem/CNVegCarbonStateType.F90 | 2 +- src/biogeochem/CNVegetationFacade.F90 | 7 ------- 2 files changed, 1 insertion(+), 8 deletions(-) diff --git a/src/biogeochem/CNVegCarbonStateType.F90 b/src/biogeochem/CNVegCarbonStateType.F90 index d2a2c06f90..e1d0ed6e39 100644 --- a/src/biogeochem/CNVegCarbonStateType.F90 +++ b/src/biogeochem/CNVegCarbonStateType.F90 @@ -2684,7 +2684,7 @@ subroutine Summary_carbonstate(this, bounds, num_bgc_soilc, filter_bgc_soilc, nu ! -------------------------------------------- ! column level summary ! -------------------------------------------- - if(associated(this%totvegc_patch))then + if(num_bgc_vegp>0)then call p2c(bounds, num_bgc_soilc, filter_bgc_soilc, & this%totvegc_patch(bounds%begp:bounds%endp), & this%totvegc_col(bounds%begc:bounds%endc)) diff --git a/src/biogeochem/CNVegetationFacade.F90 b/src/biogeochem/CNVegetationFacade.F90 index 4af6f29457..c437a9e438 100644 --- a/src/biogeochem/CNVegetationFacade.F90 +++ b/src/biogeochem/CNVegetationFacade.F90 @@ -511,13 +511,6 @@ subroutine Restart(this, bounds, ncid, flag) if (use_cn .or. use_fates_bgc) then - if(use_fates_bgc)then - call this%c_products_inst%SetValues(bounds, 0._r8) - if (use_c13) call this%c13_products_inst%SetValues(bounds, 0._r8) - if (use_c14) call this%c14_products_inst%SetValues(bounds, 0._r8) - call this%n_products_inst%SetValues(bounds, 0._r8) - end if - call this%c_products_inst%restart(bounds, ncid, flag) if (use_c13) then call this%c13_products_inst%restart(bounds, ncid, flag, & From bdcd18287687cddfed973c08b913981a72021107 Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Mon, 24 Jul 2023 13:14:27 -0600 Subject: [PATCH 118/257] Change more intent(out) to intent(inout) to prevent NaNs in nag tests --- src/biogeophys/FrictionVelocityMod.F90 | 8 ++++---- src/biogeophys/PhotosynthesisMod.F90 | 10 +++++----- 2 files changed, 9 insertions(+), 9 deletions(-) diff --git a/src/biogeophys/FrictionVelocityMod.F90 b/src/biogeophys/FrictionVelocityMod.F90 index 21a09fbc13..962184b30b 100644 --- a/src/biogeophys/FrictionVelocityMod.F90 +++ b/src/biogeophys/FrictionVelocityMod.F90 @@ -677,10 +677,10 @@ subroutine FrictionVelocity(this, lbn, ubn, fn, filtern, & real(r8) , intent(in) :: ur ( lbn: ) ! wind speed at reference height [m/s] [lbn:ubn] real(r8) , intent(in) :: um ( lbn: ) ! wind speed including the stablity effect [m/s] [lbn:ubn] real(r8) , intent(out) :: ustar ( lbn: ) ! friction velocity [m/s] [lbn:ubn] - real(r8) , intent(out) :: temp1 ( lbn: ) ! relation for potential temperature profile [lbn:ubn] - real(r8) , intent(out) :: temp12m ( lbn: ) ! relation for potential temperature profile applied at 2-m [lbn:ubn] - real(r8) , intent(out) :: temp2 ( lbn: ) ! relation for specific humidity profile [lbn:ubn] - real(r8) , intent(out) :: temp22m ( lbn: ) ! relation for specific humidity profile applied at 2-m [lbn:ubn] + real(r8) , intent(inout) :: temp1 ( lbn: ) ! relation for potential temperature profile [lbn:ubn] (inout instead of out to prevent returning nan) + real(r8) , intent(inout) :: temp12m ( lbn: ) ! relation for potential temperature profile applied at 2-m [lbn:ubn] (inout instead of out to prevent returning nan) + real(r8) , intent(inout) :: temp2 ( lbn: ) ! relation for specific humidity profile [lbn:ubn] (inout instead of out to prevent returning nan) + real(r8) , intent(inout) :: temp22m ( lbn: ) ! relation for specific humidity profile applied at 2-m [lbn:ubn] (inout instead of out to prevent returning nan) real(r8) , intent(inout) :: fm ( lbn: ) ! diagnose 10m wind (DUST only) [lbn:ubn] logical , intent(in), optional :: landunit_index ! optional argument that defines landunit or pft level ! diff --git a/src/biogeophys/PhotosynthesisMod.F90 b/src/biogeophys/PhotosynthesisMod.F90 index beda9d0bc5..6207e40700 100644 --- a/src/biogeophys/PhotosynthesisMod.F90 +++ b/src/biogeophys/PhotosynthesisMod.F90 @@ -2266,7 +2266,7 @@ subroutine hybrid(x0, p, iv, c, gb_mol, je, cair, oair, lmr_z, par_z,& real(r8), intent(in) :: cair ! Atmospheric CO2 partial pressure (Pa) real(r8), intent(in) :: oair ! Atmospheric O2 partial pressure (Pa) integer, intent(in) :: p, iv, c ! pft, c3/c4, and column index - real(r8), intent(inout) :: gs_mol ! leaf stomatal conductance (umol H2O/m**2/s) + real(r8), intent(inout) :: gs_mol ! leaf stomatal conductance (umol H2O/m**2/s) (inout instead of out to prevent returning nan) integer, intent(out) :: iter !number of iterations used, for record only type(atm2lnd_type) , intent(in) :: atm2lnd_inst type(photosyns_type), intent(inout) :: photosyns_inst @@ -2378,7 +2378,7 @@ subroutine brent(x, x1,x2,f1, f2, tol, ip, iv, ic, gb_mol, je, cair, oair,& real(r8), intent(in) :: oair ! Atmospheric O2 partial pressure (Pa) real(r8), intent(in) :: rh_can ! inside canopy relative humidity integer, intent(in) :: ip, iv, ic ! pft, c3/c4, and column index - real(r8), intent(inout) :: gs_mol ! leaf stomatal conductance (umol H2O/m**2/s) + real(r8), intent(inout) :: gs_mol ! leaf stomatal conductance (umol H2O/m**2/s) (inout instead of out to prevent returning nan) type(atm2lnd_type) , intent(in) :: atm2lnd_inst type(photosyns_type), intent(inout) :: photosyns_inst ! @@ -2568,7 +2568,7 @@ subroutine ci_func(ci, fval, p, iv, c, gb_mol, je, cair, oair, lmr_z, par_z,& real(r8) , intent(in) :: rh_can ! canopy air realtive humidity integer , intent(in) :: p, iv, c ! pft, vegetation type and column indexes real(r8) , intent(out) :: fval ! return function of the value f(ci) - real(r8) , intent(inout) :: gs_mol ! leaf stomatal conductance (umol H2O/m**2/s) + real(r8) , intent(inout) :: gs_mol ! leaf stomatal conductance (umol H2O/m**2/s) (inout instead of out to prevent returning nan) type(atm2lnd_type) , intent(in) :: atm2lnd_inst type(photosyns_type) , intent(inout) :: photosyns_inst ! @@ -4064,8 +4064,8 @@ subroutine brent_PHS(xsun, x1sun, x2sun, f1sun, f2sun, xsha, x1sha, x2sha, f1sha real(r8), intent(in) :: lmr_z_sun, lmr_z_sha ! canopy layer: leaf maintenance respiration rate (umol CO2/m**2/s) real(r8), intent(in) :: par_z_sun, par_z_sha ! par absorbed per unit lai for canopy layer (w/m**2) real(r8), intent(in) :: rh_can ! inside canopy relative humidity - real(r8), intent(inout) :: gs_mol_sun ! sunlit leaf stomatal conductance (umol H2O/m**2/s) - real(r8), intent(inout) :: gs_mol_sha ! shaded leaf stomatal conductance (umol H2O/m**2/s) + real(r8), intent(inout) :: gs_mol_sun ! sunlit leaf stomatal conductance (umol H2O/m**2/s) (inout instead of out to prevent returning nan) + real(r8), intent(inout) :: gs_mol_sha ! shaded leaf stomatal conductance (umol H2O/m**2/s) (inout instead of out to prevent returning nan) real(r8), intent(inout) :: bsun ! sunlit canopy transpiration wetness factor (0 to 1) real(r8), intent(inout) :: bsha ! shaded canopy transpiration wetness factor (0 to 1) real(r8), intent(in) :: qsatl ! leaf specific humidity [kg/kg] From 9dac206df7a995e922f3eee321c6a61bd1c43e23 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Mon, 24 Jul 2023 13:36:06 -0600 Subject: [PATCH 119/257] removed fates columns from the nocrop filter --- src/main/filterMod.F90 | 20 +++++++++++--------- 1 file changed, 11 insertions(+), 9 deletions(-) diff --git a/src/main/filterMod.F90 b/src/main/filterMod.F90 index 0b7d230a54..e2433f35ab 100644 --- a/src/main/filterMod.F90 +++ b/src/main/filterMod.F90 @@ -477,15 +477,17 @@ subroutine setFiltersOneGroup(bounds, this_filter, include_inactive, glc_behavio fl = 0 fnl = 0 do p = bounds%begp,bounds%endp - if (patch%active(p) .or. include_inactive) then - if (patch%itype(p) >= npcropmin) then !skips 2 generic crop types - fl = fl + 1 - this_filter(nc)%pcropp(fl) = p - else - l =patch%landunit(p) - if (lun%itype(l) == istsoil .or. lun%itype(l) == istcrop) then - fnl = fnl + 1 - this_filter(nc)%soilnopcropp(fnl) = p + if(.not.use_fates_bgc)then + if (patch%active(p) .or. include_inactive) then + if (patch%itype(p) >= npcropmin) then !skips 2 generic crop types + fl = fl + 1 + this_filter(nc)%pcropp(fl) = p + else + l =patch%landunit(p) + if (lun%itype(l) == istsoil .or. lun%itype(l) == istcrop) then + fnl = fnl + 1 + this_filter(nc)%soilnopcropp(fnl) = p + end if end if end if end if From d8ba6c75f68f82fe10784d488dbe76fd4d5cb4f7 Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Mon, 24 Jul 2023 17:42:25 -0600 Subject: [PATCH 120/257] Change zetamaxstable in namelist_defaults_ctsm to get BFB with baseline --- bld/namelist_files/namelist_defaults_ctsm.xml | 2 +- cime_config/testdefs/ExpectedTestFails.xml | 7 ------- 2 files changed, 1 insertion(+), 8 deletions(-) diff --git a/bld/namelist_files/namelist_defaults_ctsm.xml b/bld/namelist_files/namelist_defaults_ctsm.xml index 260f567966..d23c0d1371 100644 --- a/bld/namelist_files/namelist_defaults_ctsm.xml +++ b/bld/namelist_files/namelist_defaults_ctsm.xml @@ -213,7 +213,7 @@ attributes from the config_cache.xml file (with keys converted to upper-case). 2.0d00 2.0d00 0.5d00 -2.0d00 +0.5d00 0.5d00 2.0d00 diff --git a/cime_config/testdefs/ExpectedTestFails.xml b/cime_config/testdefs/ExpectedTestFails.xml index b84ebc3e5f..24f7062798 100644 --- a/cime_config/testdefs/ExpectedTestFails.xml +++ b/cime_config/testdefs/ExpectedTestFails.xml @@ -30,13 +30,6 @@ - - - FAIL - Error: Forcing height is below canopy height for patch index - - - FAIL From 753f97d241d0fd338716985ae4c46cea95856d05 Mon Sep 17 00:00:00 2001 From: adrifoster Date: Tue, 25 Jul 2023 14:51:21 -0600 Subject: [PATCH 121/257] move tolerance to constants file --- src/main/clm_varcon.F90 | 1 + src/main/surfrdUtilsMod.F90 | 4 ++-- src/utils/clmfates_interfaceMod.F90 | 4 ++-- 3 files changed, 5 insertions(+), 4 deletions(-) diff --git a/src/main/clm_varcon.F90 b/src/main/clm_varcon.F90 index 340115fe90..ba4fb18e81 100644 --- a/src/main/clm_varcon.F90 +++ b/src/main/clm_varcon.F90 @@ -90,6 +90,7 @@ module clm_varcon integer, public, parameter :: fun_period = 1 ! A FUN parameter, and probably needs to be changed for testing real(r8),public, parameter :: smallValue = 1.e-12_r8 ! A small values used by FUN + real(r8),public, parameter :: sum_to_1_tol = 1.e-13_r8 ! error tolerance ! ------------------------------------------------------------------------ ! Special value flags diff --git a/src/main/surfrdUtilsMod.F90 b/src/main/surfrdUtilsMod.F90 index 0763d43a16..5ede1d6474 100644 --- a/src/main/surfrdUtilsMod.F90 +++ b/src/main/surfrdUtilsMod.F90 @@ -7,6 +7,7 @@ module surfrdUtilsMod ! !USES: #include "shr_assert.h" use shr_kind_mod , only : r8 => shr_kind_r8 + use clm_varcon , only : sum_to_1_tol use clm_varctl , only : iulog,use_fates use abortutils , only : endrun use shr_log_mod , only : errMsg => shr_log_errMsg @@ -51,7 +52,6 @@ subroutine check_sums_equal_1(arr, lb, name, caller, ier, sumto) logical :: found integer :: nl integer :: nindx - real(r8), parameter :: eps = 1.e-13_r8 real(r8), allocatable :: TotalSum(:) integer :: ub ! upper bound of the first dimension of arr !----------------------------------------------------------------------- @@ -64,7 +64,7 @@ subroutine check_sums_equal_1(arr, lb, name, caller, ier, sumto) found = .false. do nl = lbound(arr, 1), ub - if (abs(sum(arr(nl,:)) - TotalSum(nl)) > eps) then + if (abs(sum(arr(nl,:)) - TotalSum(nl)) > sum_to_1_tol) then found = .true. nindx = nl exit diff --git a/src/utils/clmfates_interfaceMod.F90 b/src/utils/clmfates_interfaceMod.F90 index c87482b80b..27e5237fb5 100644 --- a/src/utils/clmfates_interfaceMod.F90 +++ b/src/utils/clmfates_interfaceMod.F90 @@ -67,6 +67,7 @@ module CLMFatesInterfaceMod use clm_varcon , only : spval use clm_varcon , only : denice use clm_varcon , only : ispval + use clm_varcon , only : sum_to_1_tol use clm_varpar , only : surfpft_lb,surfpft_ub use clm_varpar , only : numrad use clm_varpar , only : ivis @@ -159,7 +160,6 @@ module CLMFatesInterfaceMod use dynHarvestMod , only : dynHarvest_interp_resolve_harvesttypes use FatesConstantsMod , only : hlm_harvest_area_fraction use FatesConstantsMod , only : hlm_harvest_carbon - use FatesConstantsMod , only : area_error use perf_mod , only : t_startf, t_stopf implicit none @@ -714,7 +714,7 @@ subroutine init(this, bounds_proc ) this%fates(nc)%bc_in(s)%pft_areafrac(ft)=wt_nat_patch(g,m) end do - if (abs(sum(this%fates(nc)%bc_in(s)%pft_areafrac(surfpft_lb:surfpft_ub)) - 1.0_r8) > area_error) then + if (abs(sum(this%fates(nc)%bc_in(s)%pft_areafrac(surfpft_lb:surfpft_ub)) - 1.0_r8) > sum_to_1_tol) then write(iulog,*) 'pft_area error in interfc ', s, sum(this%fates(nc)%bc_in(s)%pft_areafrac(:)) - 1.0_r8 call endrun(msg=errMsg(sourcefile, __LINE__)) end if From 32a334ac6ca6977f63651dbbe23c7e6a9f5f0e2f Mon Sep 17 00:00:00 2001 From: adrifoster Date: Wed, 26 Jul 2023 08:25:15 -0600 Subject: [PATCH 122/257] don't do prescribed soil moisture --- .../clm/FatesColdSatPhen_prescribed/user_nl_clm | 9 ++------- 1 file changed, 2 insertions(+), 7 deletions(-) diff --git a/cime_config/testdefs/testmods_dirs/clm/FatesColdSatPhen_prescribed/user_nl_clm b/cime_config/testdefs/testmods_dirs/clm/FatesColdSatPhen_prescribed/user_nl_clm index a1ea0e0cf8..59a4137be7 100644 --- a/cime_config/testdefs/testmods_dirs/clm/FatesColdSatPhen_prescribed/user_nl_clm +++ b/cime_config/testdefs/testmods_dirs/clm/FatesColdSatPhen_prescribed/user_nl_clm @@ -1,8 +1,3 @@ - ! right now we can't do prescribed soil moisture because of FATES issue #845 - use_soil_moisture_streams = .true. - use_lai_streams = .true. - hist_fincl1 += 'H2OSOI_PRESCRIBED_GRC' - soilm_tintalgo = 'lower' ! set time interpolation to use lower value, so can compare to input dataset - lai_tintalgo = 'lower' ! set time interpolation to use lower value, so can compare more directly to input dataset - soilm_ignore_data_if_missing = .true. +use_lai_streams = .true. +lai_tintalgo = 'lower' ! set time interpolation to use lower value, so can compare more directly to input dataset \ No newline at end of file From 6f3a2f1546bb73be6d3ac6ddebc8af2333d8bffb Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Wed, 26 Jul 2023 10:50:02 -0600 Subject: [PATCH 123/257] Added calls to set the litter source on restart for fates --- src/main/clm_instMod.F90 | 3 ++- src/utils/clmfates_interfaceMod.F90 | 11 +++++++++-- 2 files changed, 11 insertions(+), 3 deletions(-) diff --git a/src/main/clm_instMod.F90 b/src/main/clm_instMod.F90 index be75edc8d1..c61ed32f44 100644 --- a/src/main/clm_instMod.F90 +++ b/src/main/clm_instMod.F90 @@ -588,7 +588,8 @@ subroutine clm_instRest(bounds, ncid, flag, writing_finidat_interp_dest_file) canopystate_inst=canopystate_inst, & soilstate_inst=soilstate_inst, & active_layer_inst=active_layer_inst, & - soilbiogeochem_carbonflux_inst=soilbiogeochem_carbonflux_inst) + soilbiogeochem_carbonflux_inst=soilbiogeochem_carbonflux_inst, & + soilbiogeochem_nitrogenflux_inst=soilbiogeochem_nitrogenflux_inst) end if diff --git a/src/utils/clmfates_interfaceMod.F90 b/src/utils/clmfates_interfaceMod.F90 index 88a89dddf0..bf51b3cac5 100644 --- a/src/utils/clmfates_interfaceMod.F90 +++ b/src/utils/clmfates_interfaceMod.F90 @@ -1463,7 +1463,8 @@ end subroutine wrap_update_hlmfates_dyn subroutine restart( this, bounds_proc, ncid, flag, waterdiagnosticbulk_inst, & waterstatebulk_inst, canopystate_inst, soilstate_inst, & - active_layer_inst, soilbiogeochem_carbonflux_inst) + active_layer_inst, soilbiogeochem_carbonflux_inst, & + soilbiogeochem_nitrogenflux_inst) ! --------------------------------------------------------------------------------- ! The ability to restart the model is handled through three different types of calls @@ -1499,7 +1500,8 @@ subroutine restart( this, bounds_proc, ncid, flag, waterdiagnosticbulk_inst, & type(soilstate_type) , intent(inout) :: soilstate_inst type(active_layer_type) , intent(in) :: active_layer_inst type(soilbiogeochem_carbonflux_type), intent(inout) :: soilbiogeochem_carbonflux_inst - + type(soilbiogeochem_nitrogenflux_type), intent(inout) :: soilbiogeochem_nitrogenflux_inst + ! Locals type(bounds_type) :: bounds_clump integer :: nc @@ -1716,6 +1718,9 @@ subroutine restart( this, bounds_proc, ncid, flag, waterdiagnosticbulk_inst, & this%fates(nc)%bc_in(s), & this%fates(nc)%bc_out(s)) + call this%UpdateCLitterFluxes(soilbiogeochem_carbonflux_inst,nc,c) + call this%UpdateNLitterFluxes(soilbiogeochem_nitrogenflux_inst,nc,c) + end do if(use_fates_sp)then @@ -1947,6 +1952,8 @@ subroutine init_coldstart(this, waterstatebulk_inst, waterdiagnosticbulk_inst, & this%fates(nc)%bc_in(s), & this%fates(nc)%bc_out(s)) + !call UpdateCLitterFluxes(this,soilbiogeochem_carbonflux_inst,ci,c) + end do ! ------------------------------------------------------------------------ From dbac92c0d8e589b5967e7b78e655367661ddd98b Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Thu, 27 Jul 2023 07:03:39 -0600 Subject: [PATCH 124/257] Updates to nfixing during fates run --- src/biogeochem/CNNDynamicsMod.F90 | 10 +++++++++- src/main/filterMod.F90 | 2 +- 2 files changed, 10 insertions(+), 2 deletions(-) diff --git a/src/biogeochem/CNNDynamicsMod.F90 b/src/biogeochem/CNNDynamicsMod.F90 index 2c2189ec2d..f9698fb2ca 100644 --- a/src/biogeochem/CNNDynamicsMod.F90 +++ b/src/biogeochem/CNNDynamicsMod.F90 @@ -238,6 +238,7 @@ subroutine CNNFixation(num_soilc, filter_soilc, & if(col%is_fates(c))then s = clm_fates%f2hmap(clump_index)%hsites(c) + ! %ema_npp is Smoothed [gc/m2/yr] npp = clm_fates%fates(clump_index)%bc_out(s)%ema_npp/(dayspyr*secspday) else npp = col_lag_npp(c) @@ -256,7 +257,14 @@ subroutine CNNFixation(num_soilc, filter_soilc, & do fc = 1,num_soilc c = filter_soilc(fc) - t = (1.8_r8 * (1._r8 - exp(-0.003_r8 * cannsum_npp(c))))/(secspday * dayspyr) + if(col%is_fates(c))then + s = clm_fates%f2hmap(clump_index)%hsites(c) + npp = clm_fates%fates(clump_index)%bc_out(s)%ema_npp + else + npp = cannsum_npp(c) + end if + + t = (1.8_r8 * (1._r8 - exp(-0.003_r8 * npp)))/(secspday * dayspyr) nfix_to_sminn(c) = max(0._r8,t) end do endif diff --git a/src/main/filterMod.F90 b/src/main/filterMod.F90 index e2433f35ab..2fb7d23079 100644 --- a/src/main/filterMod.F90 +++ b/src/main/filterMod.F90 @@ -477,7 +477,7 @@ subroutine setFiltersOneGroup(bounds, this_filter, include_inactive, glc_behavio fl = 0 fnl = 0 do p = bounds%begp,bounds%endp - if(.not.use_fates_bgc)then + if(.not.use_fates)then if (patch%active(p) .or. include_inactive) then if (patch%itype(p) >= npcropmin) then !skips 2 generic crop types fl = fl + 1 From 1432e20779cddec1446714c4168e9153e285f5b7 Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Thu, 27 Jul 2023 18:39:07 -0600 Subject: [PATCH 125/257] First draft of ChangeLog/Sum --- doc/ChangeLog | 163 ++++++++++++++++++++++++++++++++++++++++++++++++++ doc/ChangeSum | 1 + 2 files changed, 164 insertions(+) diff --git a/doc/ChangeLog b/doc/ChangeLog index ec7f8303a1..456c006300 100644 --- a/doc/ChangeLog +++ b/doc/ChangeLog @@ -1,4 +1,167 @@ =============================================================== +Tag name: ctsm5.1.dev134 +Originator(s): Ronny Meier, slevis (Samuel Levis,UCAR/TSS,303-665-1310) +Date: Thu Jul 27 18:00:16 MDT 2023 +One-line Summary: Surface roughness modifications + +Purpose and description of changes +---------------------------------- + +Surface roughness (z0) modifications that appear in this publication: +https://doi.org/10.5194/gmd-15-2365-2022 + +When changing the namelist input z0param_method from ZengWang2007 (default) +to Meier2022 the following modifications are activated: + +- A new parameterization of the vegetation surface roughness based on +Raupach (1992) with optimized parameters to match the data collected in +Hu et al. (2020) for different types of vegetation. This requires several new +PFT-specific input parameters in the parameter file. +- A spatially explicit z0m input field for bare soil based on the data of +Prigent et al. (2005). This may be activated specifically by the user through +the namelist input use_z0mg_2d. This requires a new input variable in the +fsurdat file. +- The parameterization of z0m for snow based on accumulated snow melt as +proposed in Brock et al. (2006). This may be activated specifically by the +user through the namelist input use_z0m_snowmelt. +- The parameterization of Yang et al. (2008) for z0h and z0q over bare soil, +snow, and glaciers. +- The study in GMD also proposes new globally constant values for the +z0m of bare soil, snow, and ice. To "activate" those the parameter file needs +to be changed at the moment. The original and modified parameter files and +fsurdat files will be shared by ftp. + +Open issues/questions (discussed with @ekluzek, @dlawrenncar, @olyson): + +- How to incorporate the data of Prigent et al. (2005) in the surfdata +generation. I will write an email about this to Catherine Prigent. +- One statement marked in CanopyFluxesMod should probably be changed when +using Meier2022 (i.e., Yang et al. (2008) formulation should be used instead +of Zeng and Dickinson (1998)). +- At the moment one needs to change the parameter file to switch between the +original and proposed globally constant z0m values for bare soil, snow, and +ice. This is obviously not very user friendly and prone to mistakes. +- The introduction of Yang et al. (2008) frequently results in z0h and z0q +larger than z0m. This is only rarely observed in the field and in contradiction +to the theory that z0h and z0q should be smaller because heat and water vapor +need to be transported through molecular diffusion in the surface sublayer. + + +Significant changes to scientifically-supported configurations +-------------------------------------------------------------- + +Does this tag change answers significantly for any of the following physics configurations? +(Details of any changes will be given in the "Answer changes" section below.) + + [Put an [X] in the box for any configuration with significant answer changes.] + +[ ] clm5_1 + +[ ] clm5_0 + +[ ] ctsm5_0-nwp + +[ ] clm4_5 + + +Bugs fixed or introduced +------------------------ +CTSM issues fixed (include CTSM Issue #): +#1316 +#1596 + +Notes of particular relevance for users +--------------------------------------- +Details already discussed in the description above. + + +Notes of particular relevance for developers: +--------------------------------------------- +Changes to tests or testing: +New tests in place for this new code. + +Testing summary: +---------------- +[... Remove before making master tag. + +Nearly all CTSM tags should undergo 'regular' (aux_clm) testing. +However, it occasionally makes sense to do more or less system testing; +here is guidance on different available levels of system testing: + a) no system testing (for use when the only changes are ones that + have absolutely no impact on system runs; this + includes documentation-only tags, tags that + just change the tools or some python code that + does not impact system runs, etc.) + b) minimal (for use in rare cases where only a small change with + known behavior is added ... eg. a minor bug fix. This + might be to just run the "short" test list, or to run + a single test. Whatever makes sense for the particular case.) + c) python only (for use where the only changes are in the python directory: + run the python testing listed below) + d) regular (regular tests on normal machines if CTSM source is modified) + e) release (regular tests plus the fates, ctsm_sci, mosart and rtm test lists + and normally all of the ancillary tests (build-namelist, python, ptclm, etc.) + would be run as well) + +In addition, various other tests of the tools, python and perl +infrastructure should be run when appropriate, as described below. + +...] + +[Remove any lines that don't apply.] + + [PASS means all tests PASS; OK means tests PASS other than expected fails.] + + build-namelist tests (if CLMBuildNamelist.pm has changed): + + cheyenne - + + tools-tests (test/tools) (if tools have been changed): + + cheyenne - + + python testing (if python code has changed; see instructions in python/README.md; document testing done): + + (any machine) - + + [If python code has changed and you are NOT running aux_clm (e.g., because the only changes are in python + code) then also run the clm_pymods test suite; this is a small subset of aux_clm that runs the system + tests impacted by python changes. The best way to do this, if you expect no changes from the last tag in + either model output or namelists, is: create sym links pointing to the last tag's baseline directory, + named with the upcoming tag; then run the clm_pymods test suite comparing against these baselines but NOT + doing their own baseline generation. If you are already running the full aux_clm then you do NOT need to + separately run the clm_pymods test suite, and you can remove the following line.] + + clm_pymods test suite on cheyenne - + + regular tests (aux_clm: https://github.com/ESCOMP/CTSM/wiki/System-Testing-Guide#pre-merge-system-testing): + + cheyenne ---- + izumi ------- + + fates tests: (give name of baseline if different from CTSM tagname, normally fates baselines are fates--) + cheyenne ---- + izumi ------- + + any other testing (give details below): + +If the tag used for baseline comparisons was NOT the previous tag, note that here: + + +Answer changes +-------------- + +Changes answers relative to baseline: + No, unless user chooses to run in non-default Meier2022 mode. + + +Other details +------------- +Pull Requests that document the changes (include PR ids): + https://github.com/ESCOMP/ctsm/pull/2045 + +=============================================================== +=============================================================== Tag name: ctsm5.1.dev131 Originator(s): samrabin (Sam Rabin,UCAR/TSS) Date: Thu Jul 27 14:24:07 MDT 2023 diff --git a/doc/ChangeSum b/doc/ChangeSum index 2d1812cd13..f28b39dc22 100644 --- a/doc/ChangeSum +++ b/doc/ChangeSum @@ -1,5 +1,6 @@ Tag Who Date Summary ============================================================================================================================ + ctsm5.1.dev134 slevis 07/27/2023 Surface roughness modifications ctsm5.1.dev131 samrabin 07/27/2023 Enable prescribed crop calendars ctsm5.1.dev130 glemieux 07/09/2023 FATES parameter file and test definition update ctsm5.1.dev129 erik 06/22/2023 NEON fixes for TOOL and user-mods, add SP for NEON, some history file updates, black refactor for buildlib/buildnml From 298c7058ac60ec92ed73560bbac5024c00faa849 Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Fri, 28 Jul 2023 12:43:25 -0600 Subject: [PATCH 126/257] First draft of ChangeLog/Sum --- doc/ChangeLog | 81 +++++++++++++++++++++++++++++++++++++++++++++++++++ doc/ChangeSum | 1 + 2 files changed, 82 insertions(+) diff --git a/doc/ChangeLog b/doc/ChangeLog index ec7f8303a1..160423dc65 100644 --- a/doc/ChangeLog +++ b/doc/ChangeLog @@ -1,4 +1,85 @@ =============================================================== +Tag name: ctsm5.1.dev135 +Originator(s): slevis (Samuel Levis,UCAR/TSS,303-665-1310) +Date: Fri Jul 28 12:36:24 MDT 2023 +One-line Summary: Refactor max_patch_per_col and maxsoil_patches loops + +Purpose and description of changes +---------------------------------- + +Refactor such loops for clearer and more efficient code, as recommended in +issue #2025. + + +Significant changes to scientifically-supported configurations +-------------------------------------------------------------- + +Does this tag change answers significantly for any of the following physics configurations? +(Details of any changes will be given in the "Answer changes" section below.) + + [Put an [X] in the box for any configuration with significant answer changes.] + +[ ] clm5_1 + +[ ] clm5_0 + +[ ] ctsm5_0-nwp + +[ ] clm4_5 + + +Bugs fixed or introduced +------------------------ +CTSM issues fixed (include CTSM Issue #): +#2025 + +Notes of particular relevance for users +--------------------------------------- + +Notes of particular relevance for developers: +--------------------------------------------- + +Testing summary: +---------------- +[Remove any lines that don't apply.] + + [PASS means all tests PASS; OK means tests PASS other than expected fails.] + + build-namelist tests (if CLMBuildNamelist.pm has changed): + + cheyenne - + + tools-tests (test/tools) (if tools have been changed): + + cheyenne - + + regular tests (aux_clm: https://github.com/ESCOMP/CTSM/wiki/System-Testing-Guide#pre-merge-system-testing): + + cheyenne ---- OK + izumi ------- OK + + fates tests: (give name of baseline if different from CTSM tagname, normally fates baselines are fates--) + cheyenne ---- + izumi ------- + + any other testing (give details below): + +If the tag used for baseline comparisons was NOT the previous tag, note that here: + + +Answer changes +-------------- + +Changes answers relative to baseline: No + + +Other details +------------- +Pull Requests that document the changes (include PR ids): + https://github.com/ESCOMP/ctsm/pull/2056 + +=============================================================== +=============================================================== Tag name: ctsm5.1.dev131 Originator(s): samrabin (Sam Rabin,UCAR/TSS) Date: Thu Jul 27 14:24:07 MDT 2023 diff --git a/doc/ChangeSum b/doc/ChangeSum index 2d1812cd13..b2a9345ba4 100644 --- a/doc/ChangeSum +++ b/doc/ChangeSum @@ -1,5 +1,6 @@ Tag Who Date Summary ============================================================================================================================ + ctsm5.1.dev135 slevis 07/28/2023 Refactor max_patch_per_col and maxsoil_patches loops ctsm5.1.dev131 samrabin 07/27/2023 Enable prescribed crop calendars ctsm5.1.dev130 glemieux 07/09/2023 FATES parameter file and test definition update ctsm5.1.dev129 erik 06/22/2023 NEON fixes for TOOL and user-mods, add SP for NEON, some history file updates, black refactor for buildlib/buildnml From de43fd1ae048226c2d2f682386ac8579982bc47f Mon Sep 17 00:00:00 2001 From: Sam Rabin Date: Fri, 28 Jul 2023 18:15:16 -0600 Subject: [PATCH 127/257] make_fsurdat_all_crops_everywhere.py: Improve efficiency. Only write the variables we need to change, instead of the entire dataset. --- .../make_fsurdat_all_crops_everywhere.py | 24 ++++++++++++------- 1 file changed, 16 insertions(+), 8 deletions(-) diff --git a/python/ctsm/crop_calendars/make_fsurdat_all_crops_everywhere.py b/python/ctsm/crop_calendars/make_fsurdat_all_crops_everywhere.py index f8c5e8b316..68c6666df7 100755 --- a/python/ctsm/crop_calendars/make_fsurdat_all_crops_everywhere.py +++ b/python/ctsm/crop_calendars/make_fsurdat_all_crops_everywhere.py @@ -2,28 +2,36 @@ import xarray as xr import sys import argparse +import shutil def main(file_in, file_out): - # Import + # Import in_ds = xr.open_dataset(file_in) - out_ds = in_ds.copy() + pct_crop_da = in_ds["PCT_CROP"] + pct_natveg_da = in_ds["PCT_NATVEG"] + pct_cft_da_in = in_ds["PCT_CFT"] in_ds.close() # Move all natural land into crop - out_ds["PCT_CROP"] += in_ds["PCT_NATVEG"] - out_ds["PCT_NATVEG"] -= in_ds["PCT_NATVEG"] + pct_crop_da += pct_natveg_da + pct_natveg_da -= pct_natveg_da # Put some of every crop in every gridcell - pct_cft = np.full_like(in_ds["PCT_CFT"].values, 100 / in_ds.dims["cft"]) - out_ds["PCT_CFT"] = xr.DataArray( - data=pct_cft, attrs=in_ds["PCT_CFT"].attrs, dims=in_ds["PCT_CFT"].dims + pct_cft = np.full_like(pct_cft_da_in.values, 100 / in_ds.dims["cft"]) + pct_cft_da = xr.DataArray( + data=pct_cft, attrs=pct_cft_da_in.attrs, dims=pct_cft_da_in.dims, name="PCT_CFT", ) # Save - out_ds.to_netcdf(file_out, format="NETCDF3_64BIT") + shutil.copyfile(file_in, file_out) + format = "NETCDF3_64BIT" + mode = "a" # Use existing file but overwrite existing variables + pct_crop_da.to_netcdf(file_out, format=format, mode=mode) + pct_natveg_da.to_netcdf(file_out, format=format, mode=mode) + pct_cft_da.to_netcdf(file_out, format=format, mode=mode) if __name__ == "__main__": From 2428d768c066e32d431c92caeecc8ad01e066ffa Mon Sep 17 00:00:00 2001 From: Sam Rabin Date: Fri, 28 Jul 2023 18:19:45 -0600 Subject: [PATCH 128/257] make_fsurdat_all_crops_everywhere.py: Automatic naming of output file to reflect input file. --- cime_config/SystemTests/rxcropmaturity.py | 6 +++-- .../make_fsurdat_all_crops_everywhere.py | 22 +++++++++++++++---- 2 files changed, 22 insertions(+), 6 deletions(-) diff --git a/cime_config/SystemTests/rxcropmaturity.py b/cime_config/SystemTests/rxcropmaturity.py index 4fd812b84a..2687afca6b 100644 --- a/cime_config/SystemTests/rxcropmaturity.py +++ b/cime_config/SystemTests/rxcropmaturity.py @@ -255,7 +255,9 @@ def _run_make_fsurdat_all_crops_everywhere(self): raise RuntimeError(error_message) # Where we will save the fsurdat version for this test - self._fsurdat_out = os.path.join(self._path_gddgen, "fsurdat.nc") + path, ext = os.path.splitext(self._fsurdat_in) + dir_in, filename_in_noext = os.path.split(path) + self._fsurdat_out = os.path.join(self._path_gddgen, f"{filename_in_noext}.all_crops_everywhere{ext}") # Make fsurdat for this test, if not already done if not os.path.exists(self._fsurdat_out): @@ -267,7 +269,7 @@ def _run_make_fsurdat_all_crops_everywhere(self): "make_fsurdat_all_crops_everywhere.py", ) command = ( - f"python3 {tool_path} " + f"-i {self._fsurdat_in} " + f"-o {self._fsurdat_out}" + f"python3 {tool_path} " + f"-i {self._fsurdat_in} " + f"-o {self._path_gddgen}" ) stu.run_python_script( self._get_caseroot(), diff --git a/python/ctsm/crop_calendars/make_fsurdat_all_crops_everywhere.py b/python/ctsm/crop_calendars/make_fsurdat_all_crops_everywhere.py index 68c6666df7..5378c8ae51 100755 --- a/python/ctsm/crop_calendars/make_fsurdat_all_crops_everywhere.py +++ b/python/ctsm/crop_calendars/make_fsurdat_all_crops_everywhere.py @@ -3,11 +3,22 @@ import sys import argparse import shutil +import os -def main(file_in, file_out): +def main(file_in, dir_out): + + # Checks and setup + if not os.path.exists(dir_out): + os.makedirs(dir_out) + if not os.path.isdir(args.output_dir): + raise RuntimeError("-o/--output-dir needs to be a directory") + path, ext = os.path.splitext(file_in) + dir_in, filename_in_noext = os.path.split(path) + file_out = os.path.join(dir_out, f"{filename_in_noext}.all_crops_everywhere{ext}") # Import + print(f"Importing {file_in}...") in_ds = xr.open_dataset(file_in) pct_crop_da = in_ds["PCT_CROP"] @@ -26,6 +37,7 @@ def main(file_in, file_out): ) # Save + print(f"Saving to {file_out}") shutil.copyfile(file_in, file_out) format = "NETCDF3_64BIT" mode = "a" # Use existing file but overwrite existing variables @@ -51,13 +63,15 @@ def main(file_in, file_out): ) parser.add_argument( "-o", - "--output-file", - help="Where to save the new surface dataset file", + "--output-dir", + help="Directory in which to save the new surface dataset file", required=True, ) # Get arguments args = parser.parse_args(sys.argv[1:]) + # Check arguments + # Process - main(args.input_file, args.output_file) + main(args.input_file, args.output_dir) From d85be768a5f2565d8ecbaf6588ea28d08d0cde9a Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Mon, 31 Jul 2023 18:02:17 -0600 Subject: [PATCH 129/257] Change another intent(out) to intent(inout) to prevent NaNs in nag tests --- src/biogeochem/NutrientCompetitionFlexibleCNMod.F90 | 1 - src/biogeophys/PhotosynthesisMod.F90 | 2 +- 2 files changed, 1 insertion(+), 2 deletions(-) diff --git a/src/biogeochem/NutrientCompetitionFlexibleCNMod.F90 b/src/biogeochem/NutrientCompetitionFlexibleCNMod.F90 index e7c16f15c7..6f8632658d 100644 --- a/src/biogeochem/NutrientCompetitionFlexibleCNMod.F90 +++ b/src/biogeochem/NutrientCompetitionFlexibleCNMod.F90 @@ -1365,7 +1365,6 @@ subroutine calc_plant_nitrogen_demand(this, bounds, & frootn => cnveg_nitrogenstate_inst%frootn_patch , & ! Input: [real(r8) (:) ] (gN/m2) fine root N livestemn_to_retransn => cnveg_nitrogenflux_inst%livestemn_to_retransn_patch,& ! Output: [real(r8) (:) ] sminn_vr => soilbiogeochem_nitrogenstate_inst%sminn_vr_col , & ! Input: [real(r8) (:,:) ] (gN/m3) soil mineral N - btran => energyflux_inst%btran_patch , & ! Input: [real(r8) (:) ] transpiration wetness factor (0 to 1) t_scalar => soilbiogeochem_carbonflux_inst%t_scalar_col & ! Input: [real(r8) (:,:) ] soil temperature scalar for decomp ) diff --git a/src/biogeophys/PhotosynthesisMod.F90 b/src/biogeophys/PhotosynthesisMod.F90 index 6207e40700..0d14909fbf 100644 --- a/src/biogeophys/PhotosynthesisMod.F90 +++ b/src/biogeophys/PhotosynthesisMod.F90 @@ -2723,7 +2723,7 @@ subroutine PhotosynthesisHydraulicStress ( bounds, fn, filterp, & real(r8) , intent(in) :: leafn( bounds%begp: ) ! leaf N (gN/m2) real(r8) , intent(out) :: bsun( bounds%begp: ) ! sunlit canopy transpiration wetness factor (0 to 1) real(r8) , intent(out) :: bsha( bounds%begp: ) ! shaded canopy transpiration wetness factor (0 to 1) - real(r8) , intent(out) :: btran( bounds%begp: ) ! transpiration wetness factor (0 to 1) [pft] + real(r8) , intent(inout) :: btran( bounds%begp: ) ! transpiration wetness factor (0 to 1) [pft] real(r8) , intent(in) :: froot_carbon( bounds%begp: ) ! fine root carbon (gC/m2) [pft] real(r8) , intent(in) :: croot_carbon( bounds%begp: ) ! live coarse root carbon (gC/m2) [pft] From 0a5a9e803b56ec1bbd6232eff1c99dbbeef25eb7 Mon Sep 17 00:00:00 2001 From: Sam Rabin Date: Tue, 1 Aug 2023 13:19:05 -0600 Subject: [PATCH 130/257] Reformatting with black. --- .../crop_calendars/make_fsurdat_all_crops_everywhere.py | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/python/ctsm/crop_calendars/make_fsurdat_all_crops_everywhere.py b/python/ctsm/crop_calendars/make_fsurdat_all_crops_everywhere.py index 5378c8ae51..441d9180fc 100755 --- a/python/ctsm/crop_calendars/make_fsurdat_all_crops_everywhere.py +++ b/python/ctsm/crop_calendars/make_fsurdat_all_crops_everywhere.py @@ -33,14 +33,17 @@ def main(file_in, dir_out): # Put some of every crop in every gridcell pct_cft = np.full_like(pct_cft_da_in.values, 100 / in_ds.dims["cft"]) pct_cft_da = xr.DataArray( - data=pct_cft, attrs=pct_cft_da_in.attrs, dims=pct_cft_da_in.dims, name="PCT_CFT", + data=pct_cft, + attrs=pct_cft_da_in.attrs, + dims=pct_cft_da_in.dims, + name="PCT_CFT", ) # Save print(f"Saving to {file_out}") shutil.copyfile(file_in, file_out) format = "NETCDF3_64BIT" - mode = "a" # Use existing file but overwrite existing variables + mode = "a" # Use existing file but overwrite existing variables pct_crop_da.to_netcdf(file_out, format=format, mode=mode) pct_natveg_da.to_netcdf(file_out, format=format, mode=mode) pct_cft_da.to_netcdf(file_out, format=format, mode=mode) From e8035015e1afa5144fe19121cb6fdbb6545b4d73 Mon Sep 17 00:00:00 2001 From: Sam Rabin Date: Tue, 1 Aug 2023 13:19:35 -0600 Subject: [PATCH 131/257] Added previous commit to .git-blame-ignore-revs. --- .git-blame-ignore-revs | 1 + 1 file changed, 1 insertion(+) diff --git a/.git-blame-ignore-revs b/.git-blame-ignore-revs index c00226b7dd..25513ae910 100644 --- a/.git-blame-ignore-revs +++ b/.git-blame-ignore-revs @@ -10,5 +10,6 @@ b88e1cd1b28e3609684c79a2ec0e88f26cfc362b b771971e3299c4fa56534b93421f7a2b9c7282fd 9de88bb57ea9855da408cbec1dc8acb9079eda47 8bc4688e52ea23ef688e283698f70a44388373eb +0a5a9e803b56ec1bbd6232eff1c99dbbeef25eb7 # Ran SystemTests and python/ctsm through black python formatter 5364ad66eaceb55dde2d3d598fe4ce37ac83a93c From 10289ad00de1fdd9bcdaea948f40abe715b188ee Mon Sep 17 00:00:00 2001 From: Sam Rabin Date: Wed, 2 Aug 2023 14:23:06 -0600 Subject: [PATCH 132/257] Added evenly_split_cropland option to fsurdat_modifier.py. This could also be accomplished by using dom_pft to specify an equal value for all crop PFTs. However, this method is more robust to user error (we don't have to rely on the user correctly writing out a long string of numbers) and code updates (if more crop PFTs are added). --- .../modify_input_files/fsurdat_modifier.py | 25 ++++++++++++++++- .../ctsm/modify_input_files/modify_fsurdat.py | 12 ++++++++ .../site_and_regional/single_point_case.py | 1 + python/ctsm/subset_data.py | 1 + python/ctsm/test/test_unit_singlept_data.py | 9 ++++++ .../test/test_unit_singlept_data_surfdata.py | 28 +++++++++++++++++++ .../modify_fsurdat_template.cfg | 6 +++- 7 files changed, 80 insertions(+), 2 deletions(-) diff --git a/python/ctsm/modify_input_files/fsurdat_modifier.py b/python/ctsm/modify_input_files/fsurdat_modifier.py index 492fa74230..e8a75bfb4c 100644 --- a/python/ctsm/modify_input_files/fsurdat_modifier.py +++ b/python/ctsm/modify_input_files/fsurdat_modifier.py @@ -237,6 +237,7 @@ def modify_optional( std_elev, soil_color, dom_pft, + evenly_split_cropland, lai, sai, hgt_top, @@ -281,6 +282,10 @@ def modify_optional( ) logger.info("dom_pft complete") + if evenly_split_cropland: + modify_fsurdat.evenly_split_cropland() + logger.info("evenly_split_cropland complete") + def read_cfg_optional_basic_opts(modify_fsurdat, config, cfg_path, section): """Read the optional parts of the main section of the config file. @@ -429,10 +434,26 @@ def read_cfg_option_control( logger.info("dom_pft option is on and = %s", str(dom_pft)) else: logger.info("dom_pft option is off") + evenly_split_cropland = get_config_value( + config=config, + section=section, + item="evenly_split_cropland", + file_path=cfg_path, + convert_to_type=bool, + ) + if evenly_split_cropland and dom_pft: + abort("dom_pft must be UNSET if evenly_split_cropland is True; pick one or the other") if process_subgrid and idealized: abort("idealized AND process_subgrid_section can NOT both be on, pick one or the other") - return (idealized, process_subgrid, process_var_list, include_nonveg, dom_pft) + return ( + idealized, + process_subgrid, + process_var_list, + include_nonveg, + dom_pft, + evenly_split_cropland, + ) def read_cfg_required_basic_opts(config, section, cfg_path): @@ -555,6 +576,7 @@ def fsurdat_modifier(parser): process_var_list, include_nonveg, dom_pft, + evenly_split_cropland, ) = read_cfg_option_control( modify_fsurdat, config, @@ -584,6 +606,7 @@ def fsurdat_modifier(parser): std_elev, soil_color, dom_pft, + evenly_split_cropland, lai, sai, hgt_top, diff --git a/python/ctsm/modify_input_files/modify_fsurdat.py b/python/ctsm/modify_input_files/modify_fsurdat.py index 9b3760e303..53f06d7dc8 100644 --- a/python/ctsm/modify_input_files/modify_fsurdat.py +++ b/python/ctsm/modify_input_files/modify_fsurdat.py @@ -165,6 +165,18 @@ def write_output(self, fsurdat_in, fsurdat_out): logger.info("Successfully created fsurdat_out: %s", fsurdat_out) self.file.close() + def evenly_split_cropland(self): + """ + Description + ----------- + In rectangle selected by user (or default -90 to 90 and 0 to 360), + replace fsurdat file's PCT_CFT with equal values for all crop types. + """ + pct_cft = np.full_like(self.file["PCT_CFT"].values, 100 / self.file.dims["cft"]) + self.file["PCT_CFT"] = xr.DataArray( + data=pct_cft, attrs=self.file["PCT_CFT"].attrs, dims=self.file["PCT_CFT"].dims + ) + def set_dom_pft(self, dom_pft, lai, sai, hgt_top, hgt_bot): """ Description diff --git a/python/ctsm/site_and_regional/single_point_case.py b/python/ctsm/site_and_regional/single_point_case.py index 96544ff9c1..904b240c77 100644 --- a/python/ctsm/site_and_regional/single_point_case.py +++ b/python/ctsm/site_and_regional/single_point_case.py @@ -105,6 +105,7 @@ def __init__( create_datm, create_user_mods, dom_pft, + evenly_split_cropland, pct_pft, num_pft, include_nonveg, diff --git a/python/ctsm/subset_data.py b/python/ctsm/subset_data.py index 4a3a5801f1..a99d42cc14 100644 --- a/python/ctsm/subset_data.py +++ b/python/ctsm/subset_data.py @@ -551,6 +551,7 @@ def subset_point(args, file_dict: dict): create_datm=args.create_datm, create_user_mods=args.create_user_mods, dom_pft=args.dom_pft, + evenly_split_cropland=args.evenly_split_cropland, pct_pft=args.pct_pft, num_pft=num_pft, include_nonveg=args.include_nonveg, diff --git a/python/ctsm/test/test_unit_singlept_data.py b/python/ctsm/test/test_unit_singlept_data.py index 570207fa26..06278a38e7 100755 --- a/python/ctsm/test/test_unit_singlept_data.py +++ b/python/ctsm/test/test_unit_singlept_data.py @@ -84,6 +84,7 @@ def test_create_tag_name(self): create_datm=self.create_datm, create_user_mods=self.create_user_mods, dom_pft=self.dom_pft, + evenly_split_cropland=self.evenly_split_cropland, pct_pft=self.pct_pft, num_pft=self.num_pft, include_nonveg=self.include_nonveg, @@ -111,6 +112,7 @@ def test_check_dom_pft_too_big(self): create_datm=self.create_datm, create_user_mods=self.create_user_mods, dom_pft=self.dom_pft, + evenly_split_cropland=self.evenly_split_cropland, pct_pft=self.pct_pft, num_pft=self.num_pft, include_nonveg=self.include_nonveg, @@ -138,6 +140,7 @@ def test_check_dom_pft_too_small(self): create_datm=self.create_datm, create_user_mods=self.create_user_mods, dom_pft=self.dom_pft, + evenly_split_cropland=self.evenly_split_cropland, pct_pft=self.pct_pft, num_pft=self.num_pft, include_nonveg=self.include_nonveg, @@ -165,6 +168,7 @@ def test_check_dom_pft_numpft(self): create_datm=self.create_datm, create_user_mods=self.create_user_mods, dom_pft=self.dom_pft, + evenly_split_cropland=self.evenly_split_cropland, pct_pft=self.pct_pft, num_pft=self.num_pft, include_nonveg=self.include_nonveg, @@ -193,6 +197,7 @@ def test_check_dom_pft_mixed_range(self): create_datm=self.create_datm, create_user_mods=self.create_user_mods, dom_pft=self.dom_pft, + evenly_split_cropland=self.evenly_split_cropland, pct_pft=self.pct_pft, num_pft=self.num_pft, include_nonveg=self.include_nonveg, @@ -223,6 +228,7 @@ def test_check_nonveg_nodompft(self): create_datm=self.create_datm, create_user_mods=self.create_user_mods, dom_pft=self.dom_pft, + evenly_split_cropland=self.evenly_split_cropland, pct_pft=self.pct_pft, num_pft=self.num_pft, include_nonveg=self.include_nonveg, @@ -254,6 +260,7 @@ def test_check_pct_pft_notsamenumbers(self): create_datm=self.create_datm, create_user_mods=self.create_user_mods, dom_pft=self.dom_pft, + evenly_split_cropland=self.evenly_split_cropland, pct_pft=self.pct_pft, num_pft=self.num_pft, include_nonveg=self.include_nonveg, @@ -284,6 +291,7 @@ def test_check_pct_pft_sum_not1(self): create_datm=self.create_datm, create_user_mods=self.create_user_mods, dom_pft=self.dom_pft, + evenly_split_cropland=self.evenly_split_cropland, pct_pft=self.pct_pft, num_pft=self.num_pft, include_nonveg=self.include_nonveg, @@ -314,6 +322,7 @@ def test_check_pct_pft_fraction_topct(self): create_datm=self.create_datm, create_user_mods=self.create_user_mods, dom_pft=self.dom_pft, + evenly_split_cropland=self.evenly_split_cropland, pct_pft=self.pct_pft, num_pft=self.num_pft, include_nonveg=self.include_nonveg, diff --git a/python/ctsm/test/test_unit_singlept_data_surfdata.py b/python/ctsm/test/test_unit_singlept_data_surfdata.py index 9623975452..f1b51f689e 100755 --- a/python/ctsm/test/test_unit_singlept_data_surfdata.py +++ b/python/ctsm/test/test_unit_singlept_data_surfdata.py @@ -155,6 +155,7 @@ def test_modify_surfdata_atpoint_nocrop_1pft_pctnatpft(self): create_datm=self.create_datm, create_user_mods=self.create_user_mods, dom_pft=self.dom_pft, + evenly_split_cropland=self.evenly_split_cropland, pct_pft=self.pct_pft, num_pft=self.num_pft, include_nonveg=self.include_nonveg, @@ -187,6 +188,7 @@ def test_modify_surfdata_atpoint_nocrop_1pft_pctnatveg(self): create_datm=self.create_datm, create_user_mods=self.create_user_mods, dom_pft=self.dom_pft, + evenly_split_cropland=self.evenly_split_cropland, pct_pft=self.pct_pft, num_pft=self.num_pft, include_nonveg=self.include_nonveg, @@ -215,6 +217,7 @@ def test_modify_surfdata_atpoint_nocrop_1pft_pctcrop(self): create_datm=self.create_datm, create_user_mods=self.create_user_mods, dom_pft=self.dom_pft, + evenly_split_cropland=self.evenly_split_cropland, pct_pft=self.pct_pft, num_pft=self.num_pft, include_nonveg=self.include_nonveg, @@ -243,6 +246,7 @@ def test_modify_surfdata_atpoint_nocrop_1pft_glacier(self): create_datm=self.create_datm, create_user_mods=self.create_user_mods, dom_pft=self.dom_pft, + evenly_split_cropland=self.evenly_split_cropland, pct_pft=self.pct_pft, num_pft=self.num_pft, include_nonveg=self.include_nonveg, @@ -272,6 +276,7 @@ def test_modify_surfdata_atpoint_nocrop_1pft_wetland(self): create_datm=self.create_datm, create_user_mods=self.create_user_mods, dom_pft=self.dom_pft, + evenly_split_cropland=self.evenly_split_cropland, pct_pft=self.pct_pft, num_pft=self.num_pft, include_nonveg=self.include_nonveg, @@ -301,6 +306,7 @@ def test_modify_surfdata_atpoint_nocrop_1pft_lake(self): create_datm=self.create_datm, create_user_mods=self.create_user_mods, dom_pft=self.dom_pft, + evenly_split_cropland=self.evenly_split_cropland, pct_pft=self.pct_pft, num_pft=self.num_pft, include_nonveg=self.include_nonveg, @@ -330,6 +336,7 @@ def test_modify_surfdata_atpoint_nocrop_1pft_unisnow(self): create_datm=self.create_datm, create_user_mods=self.create_user_mods, dom_pft=self.dom_pft, + evenly_split_cropland=self.evenly_split_cropland, pct_pft=self.pct_pft, num_pft=self.num_pft, include_nonveg=self.include_nonveg, @@ -360,6 +367,7 @@ def test_modify_surfdata_atpoint_nocrop_1pft_capsat(self): create_datm=self.create_datm, create_user_mods=self.create_user_mods, dom_pft=self.dom_pft, + evenly_split_cropland=self.evenly_split_cropland, pct_pft=self.pct_pft, num_pft=self.num_pft, include_nonveg=self.include_nonveg, @@ -390,6 +398,7 @@ def test_modify_surfdata_atpoint_nocrop_multipft(self): create_datm=self.create_datm, create_user_mods=self.create_user_mods, dom_pft=self.dom_pft, + evenly_split_cropland=self.evenly_split_cropland, pct_pft=self.pct_pft, num_pft=self.num_pft, include_nonveg=self.include_nonveg, @@ -426,6 +435,7 @@ def test_modify_surfdata_atpoint_nocrop_urban_nononveg(self): create_datm=self.create_datm, create_user_mods=self.create_user_mods, dom_pft=self.dom_pft, + evenly_split_cropland=self.evenly_split_cropland, pct_pft=self.pct_pft, num_pft=self.num_pft, include_nonveg=self.include_nonveg, @@ -460,6 +470,7 @@ def test_modify_surfdata_atpoint_nocrop_urban_include_nonveg(self): create_datm=self.create_datm, create_user_mods=self.create_user_mods, dom_pft=self.dom_pft, + evenly_split_cropland=self.evenly_split_cropland, pct_pft=self.pct_pft, num_pft=self.num_pft, include_nonveg=self.include_nonveg, @@ -497,6 +508,7 @@ def test_modify_surfdata_atpoint_nocrop_wetland_include_nonveg(self): create_datm=self.create_datm, create_user_mods=self.create_user_mods, dom_pft=self.dom_pft, + evenly_split_cropland=self.evenly_split_cropland, pct_pft=self.pct_pft, num_pft=self.num_pft, include_nonveg=self.include_nonveg, @@ -527,6 +539,7 @@ def test_modify_surfdata_atpoint_nocrop_nopft_zero_nonveg(self): create_datm=self.create_datm, create_user_mods=self.create_user_mods, dom_pft=self.dom_pft, + evenly_split_cropland=self.evenly_split_cropland, pct_pft=self.pct_pft, num_pft=self.num_pft, include_nonveg=self.include_nonveg, @@ -560,6 +573,7 @@ def test_modify_surfdata_atpoint_nocrop_nopft_include_nonveg(self): create_datm=self.create_datm, create_user_mods=self.create_user_mods, dom_pft=self.dom_pft, + evenly_split_cropland=self.evenly_split_cropland, pct_pft=self.pct_pft, num_pft=self.num_pft, include_nonveg=self.include_nonveg, @@ -705,6 +719,7 @@ def test_modify_surfdata_atpoint_crop_1pft_pctnatpft(self): create_datm=self.create_datm, create_user_mods=self.create_user_mods, dom_pft=self.dom_pft, + evenly_split_cropland=self.evenly_split_cropland, pct_pft=self.pct_pft, num_pft=self.num_pft, include_nonveg=self.include_nonveg, @@ -737,6 +752,7 @@ def test_modify_surfdata_atpoint_crop_1pft_pctnatveg(self): create_datm=self.create_datm, create_user_mods=self.create_user_mods, dom_pft=self.dom_pft, + evenly_split_cropland=self.evenly_split_cropland, pct_pft=self.pct_pft, num_pft=self.num_pft, include_nonveg=self.include_nonveg, @@ -765,6 +781,7 @@ def test_modify_surfdata_atpoint_crop_1pft_pctcrop(self): create_datm=self.create_datm, create_user_mods=self.create_user_mods, dom_pft=self.dom_pft, + evenly_split_cropland=self.evenly_split_cropland, pct_pft=self.pct_pft, num_pft=self.num_pft, include_nonveg=self.include_nonveg, @@ -793,6 +810,7 @@ def test_modify_surfdata_atpoint_crop_1pft_glacier(self): create_datm=self.create_datm, create_user_mods=self.create_user_mods, dom_pft=self.dom_pft, + evenly_split_cropland=self.evenly_split_cropland, pct_pft=self.pct_pft, num_pft=self.num_pft, include_nonveg=self.include_nonveg, @@ -822,6 +840,7 @@ def test_modify_surfdata_atpoint_crop_1pft_wetland(self): create_datm=self.create_datm, create_user_mods=self.create_user_mods, dom_pft=self.dom_pft, + evenly_split_cropland=self.evenly_split_cropland, pct_pft=self.pct_pft, num_pft=self.num_pft, include_nonveg=self.include_nonveg, @@ -851,6 +870,7 @@ def test_modify_surfdata_atpoint_crop_1pft_lake(self): create_datm=self.create_datm, create_user_mods=self.create_user_mods, dom_pft=self.dom_pft, + evenly_split_cropland=self.evenly_split_cropland, pct_pft=self.pct_pft, num_pft=self.num_pft, include_nonveg=self.include_nonveg, @@ -880,6 +900,7 @@ def test_modify_surfdata_atpoint_crop_1pft_unisnow(self): create_datm=self.create_datm, create_user_mods=self.create_user_mods, dom_pft=self.dom_pft, + evenly_split_cropland=self.evenly_split_cropland, pct_pft=self.pct_pft, num_pft=self.num_pft, include_nonveg=self.include_nonveg, @@ -909,6 +930,7 @@ def test_modify_surfdata_atpoint_crop_1pft_capsat(self): create_datm=self.create_datm, create_user_mods=self.create_user_mods, dom_pft=self.dom_pft, + evenly_split_cropland=self.evenly_split_cropland, pct_pft=self.pct_pft, num_pft=self.num_pft, include_nonveg=self.include_nonveg, @@ -939,6 +961,7 @@ def test_modify_surfdata_atpoint_crop_multipft(self): create_datm=self.create_datm, create_user_mods=self.create_user_mods, dom_pft=self.dom_pft, + evenly_split_cropland=self.evenly_split_cropland, pct_pft=self.pct_pft, num_pft=self.num_pft, include_nonveg=self.include_nonveg, @@ -973,6 +996,7 @@ def test_modify_surfdata_atpoint_crop_urban_nononveg(self): create_datm=self.create_datm, create_user_mods=self.create_user_mods, dom_pft=self.dom_pft, + evenly_split_cropland=self.evenly_split_cropland, pct_pft=self.pct_pft, num_pft=self.num_pft, include_nonveg=self.include_nonveg, @@ -1007,6 +1031,7 @@ def test_modify_surfdata_atpoint_crop_urban_include_nonveg(self): create_datm=self.create_datm, create_user_mods=self.create_user_mods, dom_pft=self.dom_pft, + evenly_split_cropland=self.evenly_split_cropland, pct_pft=self.pct_pft, num_pft=self.num_pft, include_nonveg=self.include_nonveg, @@ -1044,6 +1069,7 @@ def test_modify_surfdata_atpoint_crop_lake_include_nonveg(self): create_datm=self.create_datm, create_user_mods=self.create_user_mods, dom_pft=self.dom_pft, + evenly_split_cropland=self.evenly_split_cropland, pct_pft=self.pct_pft, num_pft=self.num_pft, include_nonveg=self.include_nonveg, @@ -1074,6 +1100,7 @@ def test_modify_surfdata_atpoint_crop_nopft_zero_nonveg(self): create_datm=self.create_datm, create_user_mods=self.create_user_mods, dom_pft=self.dom_pft, + evenly_split_cropland=self.evenly_split_cropland, pct_pft=self.pct_pft, num_pft=self.num_pft, include_nonveg=self.include_nonveg, @@ -1107,6 +1134,7 @@ def test_modify_surfdata_atpoint_crop_nopft_include_nonveg(self): create_datm=self.create_datm, create_user_mods=self.create_user_mods, dom_pft=self.dom_pft, + evenly_split_cropland=self.evenly_split_cropland, pct_pft=self.pct_pft, num_pft=self.num_pft, include_nonveg=self.include_nonveg, diff --git a/tools/modify_input_files/modify_fsurdat_template.cfg b/tools/modify_input_files/modify_fsurdat_template.cfg index 3661784521..1dfb33ce53 100644 --- a/tools/modify_input_files/modify_fsurdat_template.cfg +++ b/tools/modify_input_files/modify_fsurdat_template.cfg @@ -72,9 +72,13 @@ lon_dimname = UNSET # (bare soil). Valid values range from 0 to a max value (int) that one can # obtain from the fsurdat_in file using ncdump (or method preferred by user). # The max valid value will equal (lsmpft - 1) and will also equal the last -# value of cft(cft). +# value of cft(cft). Cannot be set with evenly_split_cropland = True. dom_pft = UNSET +# If True, evenly split each gridcell's cropland among all crop types (CFTs). +# Can only be True if dom_pft is UNSET. +evenly_split_cropland = False + # LAI, SAI, HEIGHT_TOP, and HEIGHT_BOT values by month for dom_pft # If dom_pft = 0, the next four default to 0 (space-delimited list # of floats without brackets). From a7290fbc0154589c8076a77539a8a5cbd6dc3bdf Mon Sep 17 00:00:00 2001 From: Sam Rabin Date: Wed, 2 Aug 2023 14:48:46 -0600 Subject: [PATCH 133/257] RXCROPMATURITY now uses fsurdat_modifier. Instead of make_fsurdat_all_crops_everywhere.py, which has been removed. --- cime_config/SystemTests/rxcropmaturity.py | 18 ++-- .../make_fsurdat_all_crops_everywhere.py | 55 ------------ .../modify_fsurdat_allcropseverywhere.cfg | 84 +++++++++++++++++++ 3 files changed, 97 insertions(+), 60 deletions(-) delete mode 100755 python/ctsm/crop_calendars/make_fsurdat_all_crops_everywhere.py create mode 100644 python/ctsm/crop_calendars/modify_fsurdat_allcropseverywhere.cfg diff --git a/cime_config/SystemTests/rxcropmaturity.py b/cime_config/SystemTests/rxcropmaturity.py index 4fd812b84a..9698d1e5ce 100644 --- a/cime_config/SystemTests/rxcropmaturity.py +++ b/cime_config/SystemTests/rxcropmaturity.py @@ -134,8 +134,8 @@ def run_phase(self): case_gddgen.check_all_input_data() # Make custom version of surface file - logger.info("RXCROPMATURITY log: run make_fsurdat_all_crops_everywhere") - self._run_make_fsurdat_all_crops_everywhere() + logger.info("RXCROPMATURITY log: run fsurdat_modifier") + self._run_fsurdat_modifier() # ------------------------------------------------------------------- # (2) Perform GDD-generating run and generate prescribed GDDs file @@ -239,7 +239,7 @@ def _setup_all(self): logger.info("RXCROPMATURITY log: _setup_all done") # Make a surface dataset that has every crop in every gridcell - def _run_make_fsurdat_all_crops_everywhere(self): + def _run_fsurdat_modifier(self): # fsurdat should be defined. Where is it? self._fsurdat_in = None @@ -260,14 +260,22 @@ def _run_make_fsurdat_all_crops_everywhere(self): # Make fsurdat for this test, if not already done if not os.path.exists(self._fsurdat_out): tool_path = os.path.join( + self._ctsm_root, + "tools", + "modify_input_files", + "fsurdat_modifier", + ) + cfg_path = os.path.join( self._ctsm_root, "python", "ctsm", "crop_calendars", - "make_fsurdat_all_crops_everywhere.py", + "modify_fsurdat_allcropseverywhere.cfg", ) command = ( - f"python3 {tool_path} " + f"-i {self._fsurdat_in} " + f"-o {self._fsurdat_out}" + f"python3 {tool_path} {cfg_path} " + + f"-i {self._fsurdat_in} " + + f"-o {self._fsurdat_out}" ) stu.run_python_script( self._get_caseroot(), diff --git a/python/ctsm/crop_calendars/make_fsurdat_all_crops_everywhere.py b/python/ctsm/crop_calendars/make_fsurdat_all_crops_everywhere.py deleted file mode 100755 index f8c5e8b316..0000000000 --- a/python/ctsm/crop_calendars/make_fsurdat_all_crops_everywhere.py +++ /dev/null @@ -1,55 +0,0 @@ -import numpy as np -import xarray as xr -import sys -import argparse - - -def main(file_in, file_out): - # Import - - in_ds = xr.open_dataset(file_in) - - out_ds = in_ds.copy() - in_ds.close() - - # Move all natural land into crop - out_ds["PCT_CROP"] += in_ds["PCT_NATVEG"] - out_ds["PCT_NATVEG"] -= in_ds["PCT_NATVEG"] - - # Put some of every crop in every gridcell - pct_cft = np.full_like(in_ds["PCT_CFT"].values, 100 / in_ds.dims["cft"]) - out_ds["PCT_CFT"] = xr.DataArray( - data=pct_cft, attrs=in_ds["PCT_CFT"].attrs, dims=in_ds["PCT_CFT"].dims - ) - - # Save - out_ds.to_netcdf(file_out, format="NETCDF3_64BIT") - - -if __name__ == "__main__": - ############################### - ### Process input arguments ### - ############################### - parser = argparse.ArgumentParser( - description="Creates a surface dataset with all natural land moved into crops, and with every crop present in every gridcell." - ) - - # Required - parser.add_argument( - "-i", - "--input-file", - help="Surface dataset (fsurdat) file to process", - required=True, - ) - parser.add_argument( - "-o", - "--output-file", - help="Where to save the new surface dataset file", - required=True, - ) - - # Get arguments - args = parser.parse_args(sys.argv[1:]) - - # Process - main(args.input_file, args.output_file) diff --git a/python/ctsm/crop_calendars/modify_fsurdat_allcropseverywhere.cfg b/python/ctsm/crop_calendars/modify_fsurdat_allcropseverywhere.cfg new file mode 100644 index 0000000000..b7c46a6c71 --- /dev/null +++ b/python/ctsm/crop_calendars/modify_fsurdat_allcropseverywhere.cfg @@ -0,0 +1,84 @@ +[modify_fsurdat_basic_options] + +# ------------------------------------------------------------------------ +# .cfg file with inputs for fsurdat_modifier. +# +# This configuration file, when used in fsurdat_modifier, will create a +# version of the input fsurdat file that is 100% cropland with area evenly +# split among all crop PFTs. +# ------------------------------------------------------------------------ + +### Skipping input/output file paths, as these should be specified in +### command-line call of fsurdat_modifier. +# Path and name of input surface dataset (str) +### fsurdat_in = +# Path and name of output surface dataset (str) +### fsurdat_out = + +# We want all existing values in fsurdat to persist except the ones +# pertaining to land unit and PFT fractions. Thus, we set idealized = False. +idealized = False + +# Process the optional section that handles modifying subgrid fractions +process_subgrid_section = True + +# Process the optional section that handles modifying an arbitrary list of variables +process_var_list_section = False + +# Boundaries of user-defined rectangle to apply changes (float) +# If lat_1 > lat_2, the code creates two rectangles, one in the north and +# one in the south. +# If lon_1 > lon_2, the rectangle wraps around the 0-degree meridian. +# Alternatively, user may specify a custom area in a .nc landmask_file +# below. If set, this will override the lat/lon settings. +# ----------------------------------- +# southernmost latitude for rectangle +lnd_lat_1 = -90 +# northernmost latitude for rectangle +lnd_lat_2 = 90 +# westernmost longitude for rectangle +lnd_lon_1 = 0 +# easternmost longitude for rectangle +lnd_lon_2 = 360 +# User-defined mask in a file, as alternative to setting lat/lon values. +# If set, lat_dimname and lon_dimname should likely also be set. IMPORTANT: +# - lat_dimname and lon_dimname may be left UNSET if they match the expected +# default values 'lsmlat' and 'lsmlon' +landmask_file = UNSET +lat_dimname = UNSET +lon_dimname = UNSET + +# PFT/CFT to be set to 100% according to user-defined mask. +# We *could* evenly split cropland using dom_pft, but using +# evenly_split_cropland (below) is more robust. Thus, we +# leave dom_pft UNSET. +dom_pft = UNSET + +# Evenly split each gridcell's cropland among all crop types (CFTs). +evenly_split_cropland = True + +# UNSET with idealized False means leave these values unchanged. +lai = UNSET +sai = UNSET +hgt_top = UNSET +hgt_bot = UNSET +soil_color = UNSET +std_elev = UNSET +max_sat_area = UNSET + +# We manually exclude non-vegetation land units (along with NATVEG) below, so set +# include_nonveg to True. +include_nonveg = True + + +# Section for subgrid_fractions +[modify_fsurdat_subgrid_fractions] +# If subgrid_fractions = True this section will be enabled + +# NOTE: PCT_URBAN must be a list of three floats that sum to the total urban area +PCT_URBAN = 0.0 0.0 0.0 +PCT_CROP = 100.0 +PCT_NATVEG= 0.0 +PCT_GLACIER= 0.0 +PCT_WETLAND= 0.0 +PCT_LAKE = 0.0 \ No newline at end of file From 938540f4799179aade5d00c017355982bb98f345 Mon Sep 17 00:00:00 2001 From: Sam Rabin Date: Wed, 2 Aug 2023 15:36:39 -0600 Subject: [PATCH 134/257] Replace dom_plant in .cfg file comments with dom_pft. --- tools/mksurfdata_map/modify_1x1_mexicocityMEX.cfg | 6 +++--- tools/mksurfdata_map/modify_1x1_urbanc_alpha.cfg | 6 +++--- tools/mksurfdata_map/modify_1x1_vancouverCAN.cfg | 6 +++--- 3 files changed, 9 insertions(+), 9 deletions(-) diff --git a/tools/mksurfdata_map/modify_1x1_mexicocityMEX.cfg b/tools/mksurfdata_map/modify_1x1_mexicocityMEX.cfg index 5e9de7968b..52a73f2c93 100644 --- a/tools/mksurfdata_map/modify_1x1_mexicocityMEX.cfg +++ b/tools/mksurfdata_map/modify_1x1_mexicocityMEX.cfg @@ -36,15 +36,15 @@ lnd_lon_2 = 360 landmask_file = UNSET # PFT/CFT to be set to 100% according to user-defined mask. -# If idealized = True and dom_plant = UNSET, the latter defaults to 0 +# If idealized = True and dom_pft = UNSET, the latter defaults to 0 # (bare soil). Valid values range from 0 to a max value (int) that one can # obtain from the fsurdat_in file using ncdump (or method preferred by user). # The max valid value will equal (lsmpft - 1) and will also equal the last # value of cft(cft). dom_pft = UNSET -# LAI, SAI, HEIGHT_TOP, and HEIGHT_BOT values by month for dom_plant -# If dom_plant = 0, the next four default to 0 (space-delimited list +# LAI, SAI, HEIGHT_TOP, and HEIGHT_BOT values by month for dom_pft +# If dom_pft = 0, the next four default to 0 (space-delimited list # of floats without brackets). lai = UNSET sai = UNSET diff --git a/tools/mksurfdata_map/modify_1x1_urbanc_alpha.cfg b/tools/mksurfdata_map/modify_1x1_urbanc_alpha.cfg index 38b8ce6372..dd829e73d8 100644 --- a/tools/mksurfdata_map/modify_1x1_urbanc_alpha.cfg +++ b/tools/mksurfdata_map/modify_1x1_urbanc_alpha.cfg @@ -36,15 +36,15 @@ lnd_lon_2 = 360 landmask_file = UNSET # PFT/CFT to be set to 100% according to user-defined mask. -# If idealized = True and dom_plant = UNSET, the latter defaults to 0 +# If idealized = True and dom_pft = UNSET, the latter defaults to 0 # (bare soil). Valid values range from 0 to a max value (int) that one can # obtain from the fsurdat_in file using ncdump (or method preferred by user). # The max valid value will equal (lsmpft - 1) and will also equal the last # value of cft(cft). dom_pft = UNSET -# LAI, SAI, HEIGHT_TOP, and HEIGHT_BOT values by month for dom_plant -# If dom_plant = 0, the next four default to 0 (space-delimited list +# LAI, SAI, HEIGHT_TOP, and HEIGHT_BOT values by month for dom_pft +# If dom_pft = 0, the next four default to 0 (space-delimited list # of floats without brackets). lai = UNSET sai = UNSET diff --git a/tools/mksurfdata_map/modify_1x1_vancouverCAN.cfg b/tools/mksurfdata_map/modify_1x1_vancouverCAN.cfg index abc5df16b1..dfbfd4aaea 100644 --- a/tools/mksurfdata_map/modify_1x1_vancouverCAN.cfg +++ b/tools/mksurfdata_map/modify_1x1_vancouverCAN.cfg @@ -36,15 +36,15 @@ lnd_lon_2 = 360 landmask_file = UNSET # PFT/CFT to be set to 100% according to user-defined mask. -# If idealized = True and dom_plant = UNSET, the latter defaults to 0 +# If idealized = True and dom_pft = UNSET, the latter defaults to 0 # (bare soil). Valid values range from 0 to a max value (int) that one can # obtain from the fsurdat_in file using ncdump (or method preferred by user). # The max valid value will equal (lsmpft - 1) and will also equal the last # value of cft(cft). dom_pft = UNSET -# LAI, SAI, HEIGHT_TOP, and HEIGHT_BOT values by month for dom_plant -# If dom_plant = 0, the next four default to 0 (space-delimited list +# LAI, SAI, HEIGHT_TOP, and HEIGHT_BOT values by month for dom_pft +# If dom_pft = 0, the next four default to 0 (space-delimited list # of floats without brackets). lai = UNSET sai = UNSET From 22af59a37251135d7d3de06b3a4bb93751a7c901 Mon Sep 17 00:00:00 2001 From: Sam Rabin Date: Wed, 2 Aug 2023 15:41:20 -0600 Subject: [PATCH 135/257] Fixes so test_sys_fsurdat_modifier.py passes. --- python/ctsm/test/test_sys_fsurdat_modifier.py | 4 ++++ python/ctsm/test/testinputs/modify_fsurdat_1x1mexicocity.cfg | 1 + python/ctsm/test/testinputs/modify_fsurdat_opt_sections.cfg | 1 + python/ctsm/test/testinputs/modify_fsurdat_short.cfg | 1 + 4 files changed, 7 insertions(+) diff --git a/python/ctsm/test/test_sys_fsurdat_modifier.py b/python/ctsm/test/test_sys_fsurdat_modifier.py index 72d38732cf..293dd1cf3a 100755 --- a/python/ctsm/test/test_sys_fsurdat_modifier.py +++ b/python/ctsm/test/test_sys_fsurdat_modifier.py @@ -430,6 +430,8 @@ def _create_config_file_crop(self): line = "lnd_lon_2 = 300\n" elif re.match(r" *dom_pft *=", line): line = "dom_pft = 15" + elif re.match(r" *evenly_split_cropland *=", line): + line = "evenly_split_cropland = False" elif re.match(r" *lai *=", line): line = "lai = 0 1 2 3 4 5 5 4 3 2 1 0\n" elif re.match(r" *sai *=", line): @@ -465,6 +467,8 @@ def _create_config_file_complete(self): line = "lnd_lon_2 = 300\n" elif re.match(r" *dom_pft *=", line): line = "dom_pft = 1" + elif re.match(r" *evenly_split_cropland *=", line): + line = "evenly_split_cropland = False" elif re.match(r" *lai *=", line): line = "lai = 0 1 2 3 4 5 5 4 3 2 1 0\n" elif re.match(r" *sai *=", line): diff --git a/python/ctsm/test/testinputs/modify_fsurdat_1x1mexicocity.cfg b/python/ctsm/test/testinputs/modify_fsurdat_1x1mexicocity.cfg index a4118a3255..0d8a751f32 100644 --- a/python/ctsm/test/testinputs/modify_fsurdat_1x1mexicocity.cfg +++ b/python/ctsm/test/testinputs/modify_fsurdat_1x1mexicocity.cfg @@ -11,6 +11,7 @@ lat_dimname = lsmlat lon_dimname = lsmlon dom_pft = UNSET +evenly_split_cropland = False lai = UNSET sai = UNSET diff --git a/python/ctsm/test/testinputs/modify_fsurdat_opt_sections.cfg b/python/ctsm/test/testinputs/modify_fsurdat_opt_sections.cfg index c068c5d851..b1fcf8a2e1 100644 --- a/python/ctsm/test/testinputs/modify_fsurdat_opt_sections.cfg +++ b/python/ctsm/test/testinputs/modify_fsurdat_opt_sections.cfg @@ -11,6 +11,7 @@ lat_dimname = lsmlat lon_dimname = lsmlon dom_pft = UNSET +evenly_split_cropland = False lai = UNSET sai = UNSET diff --git a/python/ctsm/test/testinputs/modify_fsurdat_short.cfg b/python/ctsm/test/testinputs/modify_fsurdat_short.cfg index 74c6639899..38b88795e8 100644 --- a/python/ctsm/test/testinputs/modify_fsurdat_short.cfg +++ b/python/ctsm/test/testinputs/modify_fsurdat_short.cfg @@ -14,6 +14,7 @@ lat_dimname = lsmlat lon_dimname = lsmlon dom_pft = UNSET +evenly_split_cropland = False lai = UNSET sai = UNSET From 0f34db295d6993cedf84e9606e53883b2156e098 Mon Sep 17 00:00:00 2001 From: Sam Rabin Date: Wed, 2 Aug 2023 15:41:47 -0600 Subject: [PATCH 136/257] Add evenly_split_cropland to config files in tools/mksurfdatamap/. --- tools/mksurfdata_map/modify_1x1_mexicocityMEX.cfg | 6 +++++- tools/mksurfdata_map/modify_1x1_urbanc_alpha.cfg | 6 +++++- tools/mksurfdata_map/modify_1x1_vancouverCAN.cfg | 6 +++++- 3 files changed, 15 insertions(+), 3 deletions(-) diff --git a/tools/mksurfdata_map/modify_1x1_mexicocityMEX.cfg b/tools/mksurfdata_map/modify_1x1_mexicocityMEX.cfg index 52a73f2c93..6eab73a159 100644 --- a/tools/mksurfdata_map/modify_1x1_mexicocityMEX.cfg +++ b/tools/mksurfdata_map/modify_1x1_mexicocityMEX.cfg @@ -40,9 +40,13 @@ landmask_file = UNSET # (bare soil). Valid values range from 0 to a max value (int) that one can # obtain from the fsurdat_in file using ncdump (or method preferred by user). # The max valid value will equal (lsmpft - 1) and will also equal the last -# value of cft(cft). +# value of cft(cft). Cannot be set with evenly_split_cropland = True. dom_pft = UNSET +# If True, evenly split each gridcell's cropland among all crop types (CFTs). +# Can only be True if dom_pft is UNSET. +evenly_split_cropland = False + # LAI, SAI, HEIGHT_TOP, and HEIGHT_BOT values by month for dom_pft # If dom_pft = 0, the next four default to 0 (space-delimited list # of floats without brackets). diff --git a/tools/mksurfdata_map/modify_1x1_urbanc_alpha.cfg b/tools/mksurfdata_map/modify_1x1_urbanc_alpha.cfg index dd829e73d8..d704b629bd 100644 --- a/tools/mksurfdata_map/modify_1x1_urbanc_alpha.cfg +++ b/tools/mksurfdata_map/modify_1x1_urbanc_alpha.cfg @@ -40,9 +40,13 @@ landmask_file = UNSET # (bare soil). Valid values range from 0 to a max value (int) that one can # obtain from the fsurdat_in file using ncdump (or method preferred by user). # The max valid value will equal (lsmpft - 1) and will also equal the last -# value of cft(cft). +# value of cft(cft). Cannot be set with evenly_split_cropland = True. dom_pft = UNSET +# If True, evenly split each gridcell's cropland among all crop types (CFTs). +# Can only be True if dom_pft is UNSET. +evenly_split_cropland = False + # LAI, SAI, HEIGHT_TOP, and HEIGHT_BOT values by month for dom_pft # If dom_pft = 0, the next four default to 0 (space-delimited list # of floats without brackets). diff --git a/tools/mksurfdata_map/modify_1x1_vancouverCAN.cfg b/tools/mksurfdata_map/modify_1x1_vancouverCAN.cfg index dfbfd4aaea..f46593d653 100644 --- a/tools/mksurfdata_map/modify_1x1_vancouverCAN.cfg +++ b/tools/mksurfdata_map/modify_1x1_vancouverCAN.cfg @@ -40,9 +40,13 @@ landmask_file = UNSET # (bare soil). Valid values range from 0 to a max value (int) that one can # obtain from the fsurdat_in file using ncdump (or method preferred by user). # The max valid value will equal (lsmpft - 1) and will also equal the last -# value of cft(cft). +# value of cft(cft). Cannot be set with evenly_split_cropland = True. dom_pft = UNSET +# If True, evenly split each gridcell's cropland among all crop types (CFTs). +# Can only be True if dom_pft is UNSET. +evenly_split_cropland = False + # LAI, SAI, HEIGHT_TOP, and HEIGHT_BOT values by month for dom_pft # If dom_pft = 0, the next four default to 0 (space-delimited list # of floats without brackets). From c73d04e975520168814de28d836a39330af2961d Mon Sep 17 00:00:00 2001 From: Sam Rabin Date: Wed, 2 Aug 2023 15:42:11 -0600 Subject: [PATCH 137/257] Handle evenly_split_cropland to single_point_case.py. Untested. --- python/ctsm/site_and_regional/single_point_case.py | 11 +++++++++++ 1 file changed, 11 insertions(+) diff --git a/python/ctsm/site_and_regional/single_point_case.py b/python/ctsm/site_and_regional/single_point_case.py index 904b240c77..0b18fe7b44 100644 --- a/python/ctsm/site_and_regional/single_point_case.py +++ b/python/ctsm/site_and_regional/single_point_case.py @@ -52,6 +52,8 @@ class SinglePointCase(BaseCase): flag for creating user mods directories and files dom_pft : int dominant pft type for this single point (None if not specified) + evenly_split_cropland : bool + flag for splitting cropland evenly among all crop types pct_pft : list weight or percentage of each pft. num_pft : list @@ -126,6 +128,7 @@ def __init__( self.plon = plon self.site_name = site_name self.dom_pft = dom_pft + self.evenly_split_cropland = evenly_split_cropland self.pct_pft = pct_pft self.num_pft = num_pft self.include_nonveg = include_nonveg @@ -437,6 +440,14 @@ def modify_surfdata_atpoint(self, f_orig): tot_pct = f_mod["PCT_CROP"] + f_mod["PCT_NATVEG"] f_mod["PCT_CROP"] = f_mod["PCT_CROP"] / tot_pct * 100 f_mod["PCT_NATVEG"] = f_mod["PCT_NATVEG"] / tot_pct * 100 + + if self.evenly_split_cropland: + f_mod["PCT_LAKE"][:, :] = 0.0 + f_mod["PCT_WETLAND"][:, :] = 0.0 + f_mod["PCT_URBAN"][:, :, :] = 0.0 + f_mod["PCT_GLACIER"][:, :] = 0.0 + f_mod["PCT_NAT_PFT"][:, :, :] = 0.0 + f_mod["PCT_CFT"][:, :, :] = 100.0 / f_mod["PCT_CFT"].shape[2] else: logger.info( From 810cb346f05ac1aabfff931ab1a2b7b584add241 Mon Sep 17 00:00:00 2001 From: Sam Rabin Date: Wed, 2 Aug 2023 15:49:04 -0600 Subject: [PATCH 138/257] Reformatted single_point_case.py with black. --- python/ctsm/site_and_regional/single_point_case.py | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/python/ctsm/site_and_regional/single_point_case.py b/python/ctsm/site_and_regional/single_point_case.py index 0b18fe7b44..59889279ba 100644 --- a/python/ctsm/site_and_regional/single_point_case.py +++ b/python/ctsm/site_and_regional/single_point_case.py @@ -440,7 +440,7 @@ def modify_surfdata_atpoint(self, f_orig): tot_pct = f_mod["PCT_CROP"] + f_mod["PCT_NATVEG"] f_mod["PCT_CROP"] = f_mod["PCT_CROP"] / tot_pct * 100 f_mod["PCT_NATVEG"] = f_mod["PCT_NATVEG"] / tot_pct * 100 - + if self.evenly_split_cropland: f_mod["PCT_LAKE"][:, :] = 0.0 f_mod["PCT_WETLAND"][:, :] = 0.0 From 028d22a66435e19184ee5e3b00ce446c148f0feb Mon Sep 17 00:00:00 2001 From: Sam Rabin Date: Wed, 2 Aug 2023 15:49:46 -0600 Subject: [PATCH 139/257] Added previous commit to .git-blame-ignore-revs. --- .git-blame-ignore-revs | 1 + 1 file changed, 1 insertion(+) diff --git a/.git-blame-ignore-revs b/.git-blame-ignore-revs index 25513ae910..ba034bb23b 100644 --- a/.git-blame-ignore-revs +++ b/.git-blame-ignore-revs @@ -11,5 +11,6 @@ b771971e3299c4fa56534b93421f7a2b9c7282fd 9de88bb57ea9855da408cbec1dc8acb9079eda47 8bc4688e52ea23ef688e283698f70a44388373eb 0a5a9e803b56ec1bbd6232eff1c99dbbeef25eb7 +810cb346f05ac1aabfff931ab1a2b7b584add241 # Ran SystemTests and python/ctsm through black python formatter 5364ad66eaceb55dde2d3d598fe4ce37ac83a93c From 9ad4eb08da6ca25b63aa29cc71ba5044b8a61c84 Mon Sep 17 00:00:00 2001 From: Sam Rabin Date: Wed, 2 Aug 2023 16:15:18 -0600 Subject: [PATCH 140/257] Add evenly_split_cropland to test_unit_fsurdat_modifier.py. * New: test_dompft_and_splitcropland_fails * New: test_read_subgrid_split_cropland * Added to: test_optional_only_true_and_false --- .../ctsm/test/test_unit_fsurdat_modifier.py | 47 ++++++++++++++++--- 1 file changed, 41 insertions(+), 6 deletions(-) diff --git a/python/ctsm/test/test_unit_fsurdat_modifier.py b/python/ctsm/test/test_unit_fsurdat_modifier.py index 0ea862a8e4..32892e9f1d 100755 --- a/python/ctsm/test/test_unit_fsurdat_modifier.py +++ b/python/ctsm/test/test_unit_fsurdat_modifier.py @@ -95,6 +95,17 @@ def test_subgrid_and_idealized_fails(self): ): read_cfg_option_control(self.modify_fsurdat, self.config, section, self.cfg_path) + def test_dompft_and_splitcropland_fails(self): + """test that dompft and evenly_split_cropland fails gracefully""" + section = "modify_fsurdat_basic_options" + self.config.set(section, "dom_pft", "1") + self.config.set(section, "evenly_split_cropland", "True") + with self.assertRaisesRegex( + SystemExit, + "dom_pft must be UNSET if evenly_split_cropland is True; pick one or the other", + ): + read_cfg_option_control(self.modify_fsurdat, self.config, section, self.cfg_path) + def test_optional_only_true_and_false(self): """test that optional settings can only be true or false""" section = "modify_fsurdat_basic_options" @@ -114,12 +125,18 @@ def test_optional_only_true_and_false(self): read_cfg_option_control(self.modify_fsurdat, self.config, section, self.cfg_path) self.config.set(section, "dom_pft", "UNSET") read_cfg_option_control(self.modify_fsurdat, self.config, section, self.cfg_path) - var = "idealized" - self.config.set(section, var, "Thing") - with self.assertRaisesRegex( - SystemExit, "Non-boolean value found for .cfg file variable: " + var - ): - read_cfg_option_control(self.modify_fsurdat, self.config, section, self.cfg_path) + varlist = ( + "idealized", + "evenly_split_cropland", + ) + for var in varlist: + orig_value = self.config.get(section, var) + self.config.set(section, var, "Thing") + with self.assertRaisesRegex( + SystemExit, "Non-boolean value found for .cfg file variable: " + var + ): + read_cfg_option_control(self.modify_fsurdat, self.config, section, self.cfg_path) + self.config.set(section, var, orig_value) def test_read_subgrid(self): """test a simple read of subgrid""" @@ -164,6 +181,24 @@ def test_read_subgrid_allurban(self): self.config.set(section, "pct_crop", "0.") read_cfg_subgrid(self.config, self.cfg_path) + def test_read_subgrid_split_cropland(self): + """ + test a read of subgrid that's 50/50 natural and + cropland, with cropland split evenly among + crop types + """ + section = "modify_fsurdat_basic_options" + self.config.set(section, "idealized", "False") + self.config.set(section, "evenly_split_cropland", "True") + section = "modify_fsurdat_subgrid_fractions" + self.config.set(section, "pct_urban", "0.0 0.0 0.0") + self.config.set(section, "pct_lake", "0.") + self.config.set(section, "pct_wetland", "0.") + self.config.set(section, "pct_glacier", "0.") + self.config.set(section, "pct_natveg", "50.") + self.config.set(section, "pct_crop", "50.") + read_cfg_subgrid(self.config, self.cfg_path) + def test_read_var_list(self): """test a simple read of var_list""" read_cfg_var_list(self.config, idealized=True) From e6134059e7057b2975bfe5cc49fb42917e5443a5 Mon Sep 17 00:00:00 2001 From: Sam Rabin Date: Wed, 2 Aug 2023 16:35:00 -0600 Subject: [PATCH 141/257] Add test_evenly_split_cropland to test_sys_fsurdat_modifier.py. --- python/ctsm/test/test_sys_fsurdat_modifier.py | 43 +++++++++++++++++++ 1 file changed, 43 insertions(+) diff --git a/python/ctsm/test/test_sys_fsurdat_modifier.py b/python/ctsm/test/test_sys_fsurdat_modifier.py index 293dd1cf3a..6f070a3c25 100755 --- a/python/ctsm/test/test_sys_fsurdat_modifier.py +++ b/python/ctsm/test/test_sys_fsurdat_modifier.py @@ -222,6 +222,49 @@ def test_opt_sections(self): np.testing.assert_array_equal(fsurdat_out_data.T_BUILDING_MIN, lev1) np.testing.assert_array_equal(fsurdat_out_data.ALB_ROOF_DIR, lev2_two) np.testing.assert_array_equal(fsurdat_out_data.TK_ROOF, lev2_five) + + def test_evenly_split_cropland(self): + """ + Test that evenly splitting cropland works + """ + self._cfg_file_path = os.path.join( + path_to_ctsm_root(), + "python", + "ctsm", + "crop_calendars", + "modify_fsurdat_allcropseverywhere.cfg") + infile_basename_noext = "surfdata_5x5_amazon_16pfts_Irrig_CMIP6_simyr2000_c171214" + outfile = os.path.join( + self._tempdir, + infile_basename_noext + "_output_allcropseverywhere.nc", + ) + sys.argv = [ + "fsurdat_modifier", + self._cfg_file_path, + "-i", + os.path.join( + self._testinputs_path, infile_basename_noext + ".nc" + ), + "-o", + outfile, + ] + parser = fsurdat_modifier_arg_process() + fsurdat_modifier(parser) + # Read the resultant output file and make sure the fields are changed as expected + fsurdat_out_data = xr.open_dataset(outfile) + zero0d = np.zeros((5, 5)) + hundred0d = np.full((5, 5), 100.0) + zero_urban = np.zeros((3, 5, 5)) + Ncrops = fsurdat_out_data.dims["cft"] + pct_cft = np.full((Ncrops, 5, 5), 100/Ncrops) + np.testing.assert_array_equal(fsurdat_out_data.PCT_NATVEG, zero0d) + np.testing.assert_array_equal(fsurdat_out_data.PCT_CROP, hundred0d) + np.testing.assert_array_equal(fsurdat_out_data.PCT_LAKE, zero0d) + np.testing.assert_array_equal(fsurdat_out_data.PCT_WETLAND, zero0d) + np.testing.assert_array_equal(fsurdat_out_data.PCT_LAKE, zero0d) + np.testing.assert_array_equal(fsurdat_out_data.PCT_GLACIER, zero0d) + np.testing.assert_array_equal(fsurdat_out_data.PCT_URBAN, zero_urban) + np.testing.assert_array_equal(fsurdat_out_data.PCT_CFT, pct_cft) def test_1x1_mexicocity(self): """ From 5933b0018f8e29413e30dda9b906370d147bad45 Mon Sep 17 00:00:00 2001 From: Sam Rabin Date: Wed, 2 Aug 2023 16:41:28 -0600 Subject: [PATCH 142/257] Formatted test_sys_fsurdat_modifier.py with black. --- python/ctsm/test/test_sys_fsurdat_modifier.py | 11 +++++------ 1 file changed, 5 insertions(+), 6 deletions(-) diff --git a/python/ctsm/test/test_sys_fsurdat_modifier.py b/python/ctsm/test/test_sys_fsurdat_modifier.py index 6f070a3c25..e3b26e1059 100755 --- a/python/ctsm/test/test_sys_fsurdat_modifier.py +++ b/python/ctsm/test/test_sys_fsurdat_modifier.py @@ -222,7 +222,7 @@ def test_opt_sections(self): np.testing.assert_array_equal(fsurdat_out_data.T_BUILDING_MIN, lev1) np.testing.assert_array_equal(fsurdat_out_data.ALB_ROOF_DIR, lev2_two) np.testing.assert_array_equal(fsurdat_out_data.TK_ROOF, lev2_five) - + def test_evenly_split_cropland(self): """ Test that evenly splitting cropland works @@ -232,7 +232,8 @@ def test_evenly_split_cropland(self): "python", "ctsm", "crop_calendars", - "modify_fsurdat_allcropseverywhere.cfg") + "modify_fsurdat_allcropseverywhere.cfg", + ) infile_basename_noext = "surfdata_5x5_amazon_16pfts_Irrig_CMIP6_simyr2000_c171214" outfile = os.path.join( self._tempdir, @@ -242,9 +243,7 @@ def test_evenly_split_cropland(self): "fsurdat_modifier", self._cfg_file_path, "-i", - os.path.join( - self._testinputs_path, infile_basename_noext + ".nc" - ), + os.path.join(self._testinputs_path, infile_basename_noext + ".nc"), "-o", outfile, ] @@ -256,7 +255,7 @@ def test_evenly_split_cropland(self): hundred0d = np.full((5, 5), 100.0) zero_urban = np.zeros((3, 5, 5)) Ncrops = fsurdat_out_data.dims["cft"] - pct_cft = np.full((Ncrops, 5, 5), 100/Ncrops) + pct_cft = np.full((Ncrops, 5, 5), 100 / Ncrops) np.testing.assert_array_equal(fsurdat_out_data.PCT_NATVEG, zero0d) np.testing.assert_array_equal(fsurdat_out_data.PCT_CROP, hundred0d) np.testing.assert_array_equal(fsurdat_out_data.PCT_LAKE, zero0d) From 90cbf186eaca77f68a4bb64bfea8401d5c83ae3c Mon Sep 17 00:00:00 2001 From: Sam Rabin Date: Wed, 2 Aug 2023 16:42:27 -0600 Subject: [PATCH 143/257] Added previous commit to .git-blame-ignore-revs. --- .git-blame-ignore-revs | 1 + 1 file changed, 1 insertion(+) diff --git a/.git-blame-ignore-revs b/.git-blame-ignore-revs index ba034bb23b..c6bbe1227f 100644 --- a/.git-blame-ignore-revs +++ b/.git-blame-ignore-revs @@ -12,5 +12,6 @@ b771971e3299c4fa56534b93421f7a2b9c7282fd 8bc4688e52ea23ef688e283698f70a44388373eb 0a5a9e803b56ec1bbd6232eff1c99dbbeef25eb7 810cb346f05ac1aabfff931ab1a2b7b584add241 +5933b0018f8e29413e30dda9b906370d147bad45 # Ran SystemTests and python/ctsm through black python formatter 5364ad66eaceb55dde2d3d598fe4ce37ac83a93c From 24b13922e5f9d688caad53f9ff9898ad306989ce Mon Sep 17 00:00:00 2001 From: Sam Rabin Date: Wed, 2 Aug 2023 16:54:32 -0600 Subject: [PATCH 144/257] Fixes to test_unit_singlept_data*.py test files. --- python/ctsm/test/test_unit_singlept_data.py | 2 ++ python/ctsm/test/test_unit_singlept_data_surfdata.py | 2 ++ 2 files changed, 4 insertions(+) diff --git a/python/ctsm/test/test_unit_singlept_data.py b/python/ctsm/test/test_unit_singlept_data.py index 06278a38e7..6fdc3109d9 100755 --- a/python/ctsm/test/test_unit_singlept_data.py +++ b/python/ctsm/test/test_unit_singlept_data.py @@ -36,6 +36,7 @@ class TestSinglePointCase(unittest.TestCase): create_datm = True create_user_mods = True dom_pft = [8] + evenly_split_cropland = False pct_pft = None num_pft = 16 include_nonveg = False @@ -58,6 +59,7 @@ def test_create_tag_noname(self): create_datm=self.create_datm, create_user_mods=self.create_user_mods, dom_pft=self.dom_pft, + evenly_split_cropland=self.evenly_split_cropland, pct_pft=self.pct_pft, num_pft=self.num_pft, include_nonveg=self.include_nonveg, diff --git a/python/ctsm/test/test_unit_singlept_data_surfdata.py b/python/ctsm/test/test_unit_singlept_data_surfdata.py index f1b51f689e..0052e796d1 100755 --- a/python/ctsm/test/test_unit_singlept_data_surfdata.py +++ b/python/ctsm/test/test_unit_singlept_data_surfdata.py @@ -44,6 +44,7 @@ class TestSinglePointCaseSurfaceNoCrop(unittest.TestCase): create_datm = True create_user_mods = True dom_pft = [8] + evenly_split_cropland = False pct_pft = None num_pft = 16 include_nonveg = False @@ -608,6 +609,7 @@ class TestSinglePointCaseSurfaceCrop(unittest.TestCase): create_datm = True create_user_mods = True dom_pft = [17] + evenly_split_cropland = False pct_pft = None num_pft = 78 include_nonveg = False From ed66cf20ca94e83de079e683b06fee38d800f95f Mon Sep 17 00:00:00 2001 From: Sam Rabin Date: Thu, 3 Aug 2023 13:33:25 -0600 Subject: [PATCH 145/257] Rename *master_list_* files to *history_fields_*. --- .../{README_master_list_files => README_history_fields_files} | 2 +- .../{master_list_fates.rst => history_fields_fates.rst} | 0 .../{master_list_nofates.rst => history_fields_nofates.rst} | 0 3 files changed, 1 insertion(+), 1 deletion(-) rename doc/source/users_guide/setting-up-and-running-a-case/{README_master_list_files => README_history_fields_files} (83%) rename doc/source/users_guide/setting-up-and-running-a-case/{master_list_fates.rst => history_fields_fates.rst} (100%) rename doc/source/users_guide/setting-up-and-running-a-case/{master_list_nofates.rst => history_fields_nofates.rst} (100%) diff --git a/doc/source/users_guide/setting-up-and-running-a-case/README_master_list_files b/doc/source/users_guide/setting-up-and-running-a-case/README_history_fields_files similarity index 83% rename from doc/source/users_guide/setting-up-and-running-a-case/README_master_list_files rename to doc/source/users_guide/setting-up-and-running-a-case/README_history_fields_files index 61f8ef44d4..c965536657 100644 --- a/doc/source/users_guide/setting-up-and-running-a-case/README_master_list_files +++ b/doc/source/users_guide/setting-up-and-running-a-case/README_history_fields_files @@ -1,6 +1,6 @@ 2021/9/8 slevis -The files master_list_nofates.rst and master_list_fates.rst each contain a +The files history_fields_nofates.rst and history_fields_fates.rst each contain a table of the history fields, active and inactive, available in the CTSM cases that get generated by these tests: ERP_P36x2_D_Ld3.f10_f10_mg37.I1850Clm50BgcCrop.cheyenne_gnu.clm-extra_outputs diff --git a/doc/source/users_guide/setting-up-and-running-a-case/master_list_fates.rst b/doc/source/users_guide/setting-up-and-running-a-case/history_fields_fates.rst similarity index 100% rename from doc/source/users_guide/setting-up-and-running-a-case/master_list_fates.rst rename to doc/source/users_guide/setting-up-and-running-a-case/history_fields_fates.rst diff --git a/doc/source/users_guide/setting-up-and-running-a-case/master_list_nofates.rst b/doc/source/users_guide/setting-up-and-running-a-case/history_fields_nofates.rst similarity index 100% rename from doc/source/users_guide/setting-up-and-running-a-case/master_list_nofates.rst rename to doc/source/users_guide/setting-up-and-running-a-case/history_fields_nofates.rst From 222c3e44066561d6e166984f81f2714115781296 Mon Sep 17 00:00:00 2001 From: Sam Rabin Date: Thu, 3 Aug 2023 13:34:52 -0600 Subject: [PATCH 146/257] Update references to newly-renamed history_field files. --- .../customizing-the-clm-namelist.rst | 4 ++-- .../users_guide/setting-up-and-running-a-case/index.rst | 4 ++-- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/doc/source/users_guide/setting-up-and-running-a-case/customizing-the-clm-namelist.rst b/doc/source/users_guide/setting-up-and-running-a-case/customizing-the-clm-namelist.rst index 47274d8480..064d3f5979 100644 --- a/doc/source/users_guide/setting-up-and-running-a-case/customizing-the-clm-namelist.rst +++ b/doc/source/users_guide/setting-up-and-running-a-case/customizing-the-clm-namelist.rst @@ -43,12 +43,12 @@ Included in the table are the following pieces of information: Table 1-3. CLM History Fields from a BgcCrop case ------------------------------------------------- -For Table from a BgcCrop case, please see :doc:`master_list_nofates`. +For Table from a BgcCrop case, please see :doc:`history_fields_nofates`. Table 1-4. CLM History Fields from a Fates case ----------------------------------------------- -For Table from a Fates case, please see :doc:`master_list_fates`. +For Table from a Fates case, please see :doc:`history_fields_fates`. --------------------------------------------- diff --git a/doc/source/users_guide/setting-up-and-running-a-case/index.rst b/doc/source/users_guide/setting-up-and-running-a-case/index.rst index f882df277b..b11587ee21 100644 --- a/doc/source/users_guide/setting-up-and-running-a-case/index.rst +++ b/doc/source/users_guide/setting-up-and-running-a-case/index.rst @@ -18,6 +18,6 @@ Setting Up and Running a Case customizing-the-clm-configuration.rst customizing-the-clm-namelist.rst customizing-the-datm-namelist.rst - master_list_nofates - master_list_fates + history_fields_nofates + history_fields_fates From adbaa29b615fe4a4647687c14dd825416fed6d96 Mon Sep 17 00:00:00 2001 From: Sam Rabin Date: Thu, 3 Aug 2023 13:35:50 -0600 Subject: [PATCH 147/257] Rename *master_list* variables to *hist_fields*, etc. --- bld/CLMBuildNamelist.pm | 2 +- bld/namelist_files/namelist_defaults_ctsm.xml | 2 +- .../namelist_definition_ctsm.xml | 2 +- .../clm/FatesColdCH4Off/user_nl_clm | 2 +- .../clm/extra_outputs/user_nl_clm | 2 +- src/main/clm_varctl.F90 | 2 +- src/main/controlMod.F90 | 4 +- src/main/histFileMod.F90 | 60 +++++++++---------- 8 files changed, 38 insertions(+), 38 deletions(-) diff --git a/bld/CLMBuildNamelist.pm b/bld/CLMBuildNamelist.pm index 256de592c6..dece3da7d7 100755 --- a/bld/CLMBuildNamelist.pm +++ b/bld/CLMBuildNamelist.pm @@ -4325,7 +4325,7 @@ sub setup_logic_misc { add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'for_testing_use_second_grain_pool'); add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'for_testing_use_repr_structure_pool'); add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'for_testing_no_crop_seed_replenishment'); - add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'hist_master_list_file'); + add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'hist_fields_list_file'); } #------------------------------------------------------------------------------- diff --git a/bld/namelist_files/namelist_defaults_ctsm.xml b/bld/namelist_files/namelist_defaults_ctsm.xml index 3cf9a3ebc0..4cac65547e 100644 --- a/bld/namelist_files/namelist_defaults_ctsm.xml +++ b/bld/namelist_files/namelist_defaults_ctsm.xml @@ -68,7 +68,7 @@ attributes from the config_cache.xml file (with keys converted to upper-case). .false. -.false. +.false. .true. diff --git a/bld/namelist_files/namelist_definition_ctsm.xml b/bld/namelist_files/namelist_definition_ctsm.xml index dc693b50ba..3c017afee1 100644 --- a/bld/namelist_files/namelist_definition_ctsm.xml +++ b/bld/namelist_files/namelist_definition_ctsm.xml @@ -764,7 +764,7 @@ SNICAR (SNow, ICe, and Aerosol Radiative model) optical data file name SNICAR (SNow, ICe, and Aerosol Radiative model) snow aging data file name - If TRUE, write master field list to separate file for documentation purposes diff --git a/cime_config/testdefs/testmods_dirs/clm/FatesColdCH4Off/user_nl_clm b/cime_config/testdefs/testmods_dirs/clm/FatesColdCH4Off/user_nl_clm index 4d7617fed4..9f977ac5ce 100644 --- a/cime_config/testdefs/testmods_dirs/clm/FatesColdCH4Off/user_nl_clm +++ b/cime_config/testdefs/testmods_dirs/clm/FatesColdCH4Off/user_nl_clm @@ -1,2 +1,2 @@ use_lch4 = .false. -hist_master_list_file = .true. +hist_fields_list_file = .true. diff --git a/cime_config/testdefs/testmods_dirs/clm/extra_outputs/user_nl_clm b/cime_config/testdefs/testmods_dirs/clm/extra_outputs/user_nl_clm index 6dc5225f1d..dad8a7e843 100644 --- a/cime_config/testdefs/testmods_dirs/clm/extra_outputs/user_nl_clm +++ b/cime_config/testdefs/testmods_dirs/clm/extra_outputs/user_nl_clm @@ -1,5 +1,5 @@ calc_human_stress_indices = 'ALL' -hist_master_list_file = .true. +hist_fields_list_file = .true. hist_fincl1 += 'GSSUN:L43200', 'GSSHA:L43200', 'FSDSND:L43200', 'FSRND:L43200', 'FSRSFND:L43200', 'SSRE_FSRND:L43200', 'FSDSVD:L43200', 'FSDSVI:L43200', diff --git a/src/main/clm_varctl.F90 b/src/main/clm_varctl.F90 index f54c0b942c..bcf7a0ffd2 100644 --- a/src/main/clm_varctl.F90 +++ b/src/main/clm_varctl.F90 @@ -386,7 +386,7 @@ module clm_varctl logical, public :: hist_wrtch4diag = .false. ! namelist: write history master list to a file for use in documentation - logical, public :: hist_master_list_file = .false. + logical, public :: hist_fields_list_file = .false. !---------------------------------------------------------- ! FATES diff --git a/src/main/controlMod.F90 b/src/main/controlMod.F90 index 42cd289aba..85ea04eb43 100644 --- a/src/main/controlMod.F90 +++ b/src/main/controlMod.F90 @@ -162,7 +162,7 @@ subroutine control_init(dtime) hist_fexcl4, hist_fexcl5, hist_fexcl6, & hist_fexcl7, hist_fexcl8, & hist_fexcl9, hist_fexcl10 - namelist /clm_inparm/ hist_wrtch4diag, hist_master_list_file + namelist /clm_inparm/ hist_wrtch4diag, hist_fields_list_file ! BGC info @@ -810,7 +810,7 @@ subroutine control_spmd() if (use_lch4) then call mpi_bcast (hist_wrtch4diag, 1, MPI_LOGICAL, 0, mpicom, ier) end if - call mpi_bcast (hist_master_list_file, 1, MPI_LOGICAL, 0, mpicom, ier) + call mpi_bcast (hist_fields_list_file, 1, MPI_LOGICAL, 0, mpicom, ier) call mpi_bcast (hist_fexcl1, max_namlen*size(hist_fexcl1), MPI_CHARACTER, 0, mpicom, ier) call mpi_bcast (hist_fexcl2, max_namlen*size(hist_fexcl2), MPI_CHARACTER, 0, mpicom, ier) call mpi_bcast (hist_fexcl3, max_namlen*size(hist_fexcl3), MPI_CHARACTER, 0, mpicom, ier) diff --git a/src/main/histFileMod.F90 b/src/main/histFileMod.F90 index 92ce3dfa95..df91fa1e70 100644 --- a/src/main/histFileMod.F90 +++ b/src/main/histFileMod.F90 @@ -350,7 +350,7 @@ subroutine hist_printflds() ! Print summary of master field list. ! ! !USES: - use clm_varctl, only: hist_master_list_file + use clm_varctl, only: hist_fields_list_file use fileutils, only: getavu, relavu ! ! !ARGUMENTS: @@ -358,13 +358,13 @@ subroutine hist_printflds() ! !LOCAL VARIABLES: integer, parameter :: ncol = 5 ! number of table columns integer nf, i, j ! do-loop counters - integer master_list_file ! file unit number + integer hist_fields_file ! file unit number integer width_col(ncol) ! widths of table columns integer width_col_sum ! widths of columns summed, including spaces character(len=3) str_width_col(ncol) ! string version of width_col character(len=3) str_w_col_sum ! string version of width_col_sum character(len=7) file_identifier ! fates identifier used in file_name - character(len=23) file_name ! master_list_file.rst with or without fates + character(len=23) file_name ! hist_fields_file.rst with or without fates character(len=99) fmt_txt ! format statement character(len=*),parameter :: subname = 'CLM_hist_printflds' !----------------------------------------------------------------------- @@ -387,7 +387,7 @@ subroutine hist_printflds() ! First sort the list to be in alphabetical order call sort_hist_list(1, nfmaster, masterlist) - if (masterproc .and. hist_master_list_file) then + if (masterproc .and. hist_fields_list_file) then ! Hardwired table column widths to fit the table on a computer ! screen. Some strings will be truncated as a result of the ! current choices (4, 35, 94, 65, 7). In sphinx (ie the web-based @@ -407,67 +407,67 @@ subroutine hist_printflds() end do write(str_w_col_sum,'(i0)') width_col_sum - ! Open master_list_file - master_list_file = getavu() ! get next available file unit number + ! Open hist_fields_file + hist_fields_file = getavu() ! get next available file unit number if (use_fates) then file_identifier = 'fates' else file_identifier = 'nofates' end if - file_name = 'master_list_' // trim(file_identifier) // '.rst' - open(unit = master_list_file, file = file_name, & + file_name = 'history_fields_' // trim(file_identifier) // '.rst' + open(unit = hist_fields_file, file = file_name, & status = 'replace', action = 'write', form = 'formatted') ! File title fmt_txt = '(a)' - write(master_list_file,fmt_txt) '=============================' - write(master_list_file,fmt_txt) 'CTSM History Fields (' // trim(file_identifier) // ')' - write(master_list_file,fmt_txt) '=============================' - write(master_list_file,*) + write(hist_fields_file,fmt_txt) '=============================' + write(hist_fields_file,fmt_txt) 'CTSM History Fields (' // trim(file_identifier) // ')' + write(hist_fields_file,fmt_txt) '=============================' + write(hist_fields_file,*) ! A warning message and flags from the current CTSM case - write(master_list_file,fmt_txt) 'CAUTION: Not all variables are relevant / present for all CTSM cases.' - write(master_list_file,fmt_txt) 'Key flags used in this CTSM case:' + write(hist_fields_file,fmt_txt) 'CAUTION: Not all variables are relevant / present for all CTSM cases.' + write(hist_fields_file,fmt_txt) 'Key flags used in this CTSM case:' fmt_txt = '(a,l)' - write(master_list_file,fmt_txt) 'use_cn = ', use_cn - write(master_list_file,fmt_txt) 'use_crop = ', use_crop - write(master_list_file,fmt_txt) 'use_fates = ', use_fates - write(master_list_file,*) + write(hist_fields_file,fmt_txt) 'use_cn = ', use_cn + write(hist_fields_file,fmt_txt) 'use_crop = ', use_crop + write(hist_fields_file,fmt_txt) 'use_fates = ', use_fates + write(hist_fields_file,*) ! Table header ! Concatenate strings needed in format statement do i = 1, ncol fmt_txt = '('//str_width_col(i)//'a,x)' - write(master_list_file,fmt_txt,advance='no') ('=', j=1,width_col(i)) + write(hist_fields_file,fmt_txt,advance='no') ('=', j=1,width_col(i)) end do - write(master_list_file,*) ! next write statement will now appear in new line + write(hist_fields_file,*) ! next write statement will now appear in new line ! Table title fmt_txt = '(a)' - write(master_list_file,fmt_txt) 'CTSM History Fields' + write(hist_fields_file,fmt_txt) 'CTSM History Fields' ! Sub-header ! Concatenate strings needed in format statement fmt_txt = '('//str_w_col_sum//'a)' - write(master_list_file,fmt_txt) ('-', i=1, width_col_sum) + write(hist_fields_file,fmt_txt) ('-', i=1, width_col_sum) ! Concatenate strings needed in format statement fmt_txt = '(a'//str_width_col(1)//',x,a'//str_width_col(2)//',x,a'//str_width_col(3)//',x,a'//str_width_col(4)//',x,a'//str_width_col(5)//')' - write(master_list_file,fmt_txt) '#', 'Variable Name', & + write(hist_fields_file,fmt_txt) '#', 'Variable Name', & 'Long Description', 'Units', 'Active?' ! End header, same as header ! Concatenate strings needed in format statement do i = 1, ncol fmt_txt = '('//str_width_col(i)//'a,x)' - write(master_list_file,fmt_txt,advance='no') ('=', j=1,width_col(i)) + write(hist_fields_file,fmt_txt,advance='no') ('=', j=1,width_col(i)) end do - write(master_list_file,*) ! next write statement will now appear in new line + write(hist_fields_file,*) ! next write statement will now appear in new line ! Main table ! Concatenate strings needed in format statement fmt_txt = '(i'//str_width_col(1)//',x,a'//str_width_col(2)//',x,a'//str_width_col(3)//',x,a'//str_width_col(4)//',l'//str_width_col(5)//')' do nf = 1,nfmaster - write(master_list_file,fmt_txt) nf, & + write(hist_fields_file,fmt_txt) nf, & masterlist(nf)%field%name, & masterlist(nf)%field%long_name, & masterlist(nf)%field%units, & @@ -478,12 +478,12 @@ subroutine hist_printflds() ! Concatenate strings needed in format statement do i = 1, ncol fmt_txt = '('//str_width_col(i)//'a,x)' - write(master_list_file,fmt_txt,advance='no') ('=', j=1,width_col(i)) + write(hist_fields_file,fmt_txt,advance='no') ('=', j=1,width_col(i)) end do - call shr_sys_flush(master_list_file) - close(unit = master_list_file) - call relavu(master_list_file) ! close and release file unit number + call shr_sys_flush(hist_fields_file) + close(unit = hist_fields_file) + call relavu(hist_fields_file) ! close and release file unit number end if end subroutine hist_printflds From 0282e70545d5d357b4c2c11953da5ed79c12f8da Mon Sep 17 00:00:00 2001 From: Sam Rabin Date: Thu, 3 Aug 2023 13:37:45 -0600 Subject: [PATCH 148/257] Remove line numbers from history_fields files. --- .../history_fields_fates.rst | 1878 ++++++------ .../history_fields_nofates.rst | 2598 ++++++++--------- 2 files changed, 2238 insertions(+), 2238 deletions(-) diff --git a/doc/source/users_guide/setting-up-and-running-a-case/history_fields_fates.rst b/doc/source/users_guide/setting-up-and-running-a-case/history_fields_fates.rst index 57edbfd3ca..8b30306a9e 100644 --- a/doc/source/users_guide/setting-up-and-running-a-case/history_fields_fates.rst +++ b/doc/source/users_guide/setting-up-and-running-a-case/history_fields_fates.rst @@ -13,943 +13,943 @@ CTSM History Fields ----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------- # Variable Name Long Description Units Active? ==== =================================== ============================================================================================== ================================================================= ======= - 1 A5TMIN 5-day running mean of min 2-m temperature K F - 2 ACTUAL_IMMOB actual N immobilization gN/m^2/s T - 3 ACT_SOMC ACT_SOM C gC/m^2 T - 4 ACT_SOMC_1m ACT_SOM C to 1 meter gC/m^2 F - 5 ACT_SOMC_TNDNCY_VERT_TRA active soil organic C tendency due to vertical transport gC/m^3/s F - 6 ACT_SOMC_TO_PAS_SOMC decomp. of active soil organic C to passive soil organic C gC/m^2/s F - 7 ACT_SOMC_TO_PAS_SOMC_vr decomp. of active soil organic C to passive soil organic C gC/m^3/s F - 8 ACT_SOMC_TO_SLO_SOMC decomp. of active soil organic C to slow soil organic ma C gC/m^2/s F - 9 ACT_SOMC_TO_SLO_SOMC_vr decomp. of active soil organic C to slow soil organic ma C gC/m^3/s F - 10 ACT_SOMC_vr ACT_SOM C (vertically resolved) gC/m^3 T - 11 ACT_SOMN ACT_SOM N gN/m^2 T - 12 ACT_SOMN_1m ACT_SOM N to 1 meter gN/m^2 F - 13 ACT_SOMN_TNDNCY_VERT_TRA active soil organic N tendency due to vertical transport gN/m^3/s F - 14 ACT_SOMN_TO_PAS_SOMN decomp. of active soil organic N to passive soil organic N gN/m^2 F - 15 ACT_SOMN_TO_PAS_SOMN_vr decomp. of active soil organic N to passive soil organic N gN/m^3 F - 16 ACT_SOMN_TO_SLO_SOMN decomp. of active soil organic N to slow soil organic ma N gN/m^2 F - 17 ACT_SOMN_TO_SLO_SOMN_vr decomp. of active soil organic N to slow soil organic ma N gN/m^3 F - 18 ACT_SOMN_vr ACT_SOM N (vertically resolved) gN/m^3 T - 19 ACT_SOM_HR_S2 Het. Resp. from active soil organic gC/m^2/s F - 20 ACT_SOM_HR_S2_vr Het. Resp. from active soil organic gC/m^3/s F - 21 ACT_SOM_HR_S3 Het. Resp. from active soil organic gC/m^2/s F - 22 ACT_SOM_HR_S3_vr Het. Resp. from active soil organic gC/m^3/s F - 23 AGB Aboveground biomass gC m-2 T - 24 AGB_SCLS Aboveground biomass by size class kgC/m2 T - 25 AGB_SCPF Aboveground biomass by pft/size kgC/m2 F - 26 AGLB Aboveground leaf biomass kg/m^2 F - 27 AGSB Aboveground stem biomass kg/m^2 F - 28 ALBD surface albedo (direct) proportion F - 29 ALBGRD ground albedo (direct) proportion F - 30 ALBGRI ground albedo (indirect) proportion F - 31 ALBI surface albedo (indirect) proportion F - 32 ALT current active layer thickness m F - 33 ALTMAX maximum annual active layer thickness m F - 34 ALTMAX_LASTYEAR maximum prior year active layer thickness m F - 35 AR autotrophic respiration gC/m^2/s T - 36 AREA_BURNT_BY_PATCH_AGE spitfire area burnt by patch age (divide by patch_area_by_age to get burnt fraction by age) m2/m2/day T - 37 AREA_PLANT area occupied by all plants m2/m2 T - 38 AREA_TREES area occupied by woody plants m2/m2 T - 39 AR_AGSAPM_SCPF above-ground sapwood maintenance autotrophic respiration per m2 per year by pft/size kgC/m2/yr F - 40 AR_CANOPY autotrophic respiration of canopy plants gC/m^2/s T - 41 AR_CANOPY_SCPF autotrophic respiration of canopy plants by pft/size kgC/m2/yr F - 42 AR_CROOTM_SCPF below-ground sapwood maintenance autotrophic respiration per m2 per year by pft/size kgC/m2/yr F - 43 AR_DARKM_SCPF dark portion of maintenance autotrophic respiration per m2 per year by pft/size kgC/m2/yr F - 44 AR_FROOTM_SCPF fine root maintenance autotrophic respiration per m2 per year by pft/size kgC/m2/yr F - 45 AR_GROW_SCPF growth autotrophic respiration per m2 per year by pft/size kgC/m2/yr F - 46 AR_MAINT_SCPF maintenance autotrophic respiration per m2 per year by pft/size kgC/m2/yr F - 47 AR_SCPF total autotrophic respiration per m2 per year by pft/size kgC/m2/yr F - 48 AR_UNDERSTORY autotrophic respiration of understory plants gC/m^2/s T - 49 AR_UNDERSTORY_SCPF autotrophic respiration of understory plants by pft/size kgC/m2/yr F - 50 ATM_TOPO atmospheric surface height m T - 51 AnnET Annual ET mm/s F - 52 BA_SCLS basal area by size class m2/ha T - 53 BA_SCPF basal area by pft/size m2/ha F - 54 BCDEP total BC deposition (dry+wet) from atmosphere kg/m^2/s T - 55 BDEAD_MD_CANOPY_SCLS BDEAD_MD for canopy plants by size class kg C / ha / yr F - 56 BDEAD_MD_UNDERSTORY_SCLS BDEAD_MD for understory plants by size class kg C / ha / yr F - 57 BIOMASS_AGEPFT biomass per PFT in each age bin kg C / m2 F - 58 BIOMASS_BY_AGE Total Biomass within a given patch age bin kgC/m2 F - 59 BIOMASS_CANOPY Biomass of canopy plants gC m-2 T - 60 BIOMASS_SCLS Total biomass by size class kgC/m2 F - 61 BIOMASS_UNDERSTORY Biomass of understory plants gC m-2 T - 62 BLEAF_CANOPY_SCPF biomass carbon in leaf of canopy plants by pft/size kgC/ha F - 63 BLEAF_UNDERSTORY_SCPF biomass carbon in leaf of understory plants by pft/size kgC/ha F - 64 BSTORE_MD_CANOPY_SCLS BSTORE_MD for canopy plants by size class kg C / ha / yr F - 65 BSTORE_MD_UNDERSTORY_SCLS BSTORE_MD for understory plants by size class kg C / ha / yr F - 66 BSTOR_CANOPY_SCPF biomass carbon in storage pools of canopy plants by pft/size kgC/ha F - 67 BSTOR_UNDERSTORY_SCPF biomass carbon in storage pools of understory plants by pft/size kgC/ha F - 68 BSW_MD_CANOPY_SCLS BSW_MD for canopy plants by size class kg C / ha / yr F - 69 BSW_MD_UNDERSTORY_SCLS BSW_MD for understory plants by size class kg C / ha / yr F - 70 BTRAN transpiration beta factor unitless T - 71 BTRANMN daily minimum of transpiration beta factor unitless T - 72 BURNT_LITTER_FRAC_AREA_PRODUCT product of fraction of fuel burnt and burned area (divide by FIRE_AREA to get burned-area-weig fraction T - 73 C13disc_SCPF C13 discrimination by pft/size per mil F - 74 CAMBIALFIREMORT_SCPF cambial fire mortality by pft/size N/ha/yr F - 75 CANOPY_AREA_BY_AGE canopy area by age bin m2/m2 T - 76 CANOPY_HEIGHT_DIST canopy height distribution m2/m2 T - 77 CANOPY_SPREAD Scaling factor between tree basal area and canopy area 0-1 T - 78 CARBON_BALANCE_CANOPY_SCLS CARBON_BALANCE for canopy plants by size class kg C / ha / yr F - 79 CARBON_BALANCE_UNDERSTORY_SCLS CARBON_BALANCE for understory plants by size class kg C / ha / yr F - 80 CBALANCE_ERROR_FATES total carbon error, FATES mgC/day T - 81 CEFFLUX carbon efflux, root to soil kgC/ha/day T - 82 CEFFLUX_SCPF carbon efflux, root to soil, by size-class x pft kg/ha/day F - 83 CEL_LITC CEL_LIT C gC/m^2 T - 84 CEL_LITC_1m CEL_LIT C to 1 meter gC/m^2 F - 85 CEL_LITC_TNDNCY_VERT_TRA cellulosic litter C tendency due to vertical transport gC/m^3/s F - 86 CEL_LITC_TO_ACT_SOMC decomp. of cellulosic litter C to active soil organic C gC/m^2/s F - 87 CEL_LITC_TO_ACT_SOMC_vr decomp. of cellulosic litter C to active soil organic C gC/m^3/s F - 88 CEL_LITC_vr CEL_LIT C (vertically resolved) gC/m^3 T - 89 CEL_LITN CEL_LIT N gN/m^2 T - 90 CEL_LITN_1m CEL_LIT N to 1 meter gN/m^2 F - 91 CEL_LITN_TNDNCY_VERT_TRA cellulosic litter N tendency due to vertical transport gN/m^3/s F - 92 CEL_LITN_TO_ACT_SOMN decomp. of cellulosic litter N to active soil organic N gN/m^2 F - 93 CEL_LITN_TO_ACT_SOMN_vr decomp. of cellulosic litter N to active soil organic N gN/m^3 F - 94 CEL_LITN_vr CEL_LIT N (vertically resolved) gN/m^3 T - 95 CEL_LIT_HR Het. Resp. from cellulosic litter gC/m^2/s F - 96 CEL_LIT_HR_vr Het. Resp. from cellulosic litter gC/m^3/s F - 97 CH4PROD Gridcell total production of CH4 gC/m2/s T - 98 CH4_EBUL_TOTAL_SAT ebullition surface CH4 flux; (+ to atm) mol/m2/s F - 99 CH4_EBUL_TOTAL_UNSAT ebullition surface CH4 flux; (+ to atm) mol/m2/s F - 100 CH4_SURF_AERE_SAT aerenchyma surface CH4 flux for inundated area; (+ to atm) mol/m2/s T - 101 CH4_SURF_AERE_UNSAT aerenchyma surface CH4 flux for non-inundated area; (+ to atm) mol/m2/s T - 102 CH4_SURF_DIFF_SAT diffusive surface CH4 flux for inundated / lake area; (+ to atm) mol/m2/s T - 103 CH4_SURF_DIFF_UNSAT diffusive surface CH4 flux for non-inundated area; (+ to atm) mol/m2/s T - 104 CH4_SURF_EBUL_SAT ebullition surface CH4 flux for inundated / lake area; (+ to atm) mol/m2/s T - 105 CH4_SURF_EBUL_UNSAT ebullition surface CH4 flux for non-inundated area; (+ to atm) mol/m2/s T - 106 COL_CTRUNC column-level sink for C truncation gC/m^2 F - 107 COL_NTRUNC column-level sink for N truncation gN/m^2 F - 108 CONC_CH4_SAT CH4 soil Concentration for inundated / lake area mol/m3 F - 109 CONC_CH4_UNSAT CH4 soil Concentration for non-inundated area mol/m3 F - 110 CONC_O2_SAT O2 soil Concentration for inundated / lake area mol/m3 T - 111 CONC_O2_UNSAT O2 soil Concentration for non-inundated area mol/m3 T - 112 COSZEN cosine of solar zenith angle none F - 113 CROWNAREA_CAN total crown area in each canopy layer m2/m2 T - 114 CROWNAREA_CNLF total crown area that is occupied by leaves in each canopy and leaf layer m2/m2 F - 115 CROWNFIREMORT_SCPF crown fire mortality by pft/size N/ha/yr F - 116 CROWN_AREA_CANOPY_SCLS total crown area of canopy plants by size class m2/ha F - 117 CROWN_AREA_UNDERSTORY_SCLS total crown area of understory plants by size class m2/ha F - 118 CWDC_HR cwd C heterotrophic respiration gC/m^2/s F - 119 CWD_AG_CWDSC size-resolved AG CWD stocks gC/m^2 F - 120 CWD_AG_IN_CWDSC size-resolved AG CWD input gC/m^2/y F - 121 CWD_AG_OUT_CWDSC size-resolved AG CWD output gC/m^2/y F - 122 CWD_BG_CWDSC size-resolved BG CWD stocks gC/m^2 F - 123 CWD_BG_IN_CWDSC size-resolved BG CWD input gC/m^2/y F - 124 CWD_BG_OUT_CWDSC size-resolved BG CWD output gC/m^2/y F - 125 C_LBLAYER mean leaf boundary layer conductance umol m-2 s-1 T - 126 C_LBLAYER_BY_AGE mean leaf boundary layer conductance - by patch age umol m-2 s-1 F - 127 C_STOMATA mean stomatal conductance umol m-2 s-1 T - 128 C_STOMATA_BY_AGE mean stomatal conductance - by patch age umol m-2 s-1 F - 129 DDBH_CANOPY_SCAG growth rate of canopy plantsnumber of plants per hectare in canopy in each size x age class cm/yr/ha F - 130 DDBH_CANOPY_SCLS diameter growth increment by pft/size cm/yr/ha T - 131 DDBH_CANOPY_SCPF diameter growth increment by pft/size cm/yr/ha F - 132 DDBH_SCPF diameter growth increment by pft/size cm/yr/ha F - 133 DDBH_UNDERSTORY_SCAG growth rate of understory plants in each size x age class cm/yr/ha F - 134 DDBH_UNDERSTORY_SCLS diameter growth increment by pft/size cm/yr/ha T - 135 DDBH_UNDERSTORY_SCPF diameter growth increment by pft/size cm/yr/ha F - 136 DEMOTION_CARBONFLUX demotion-associated biomass carbon flux from canopy to understory gC/m2/s T - 137 DEMOTION_RATE_SCLS demotion rate from canopy to understory by size class indiv/ha/yr F - 138 DENIT total rate of denitrification gN/m^2/s T - 139 DGNETDT derivative of net ground heat flux wrt soil temp W/m^2/K F - 140 DISPLA displacement height m F - 141 DISTURBANCE_RATE_FIRE Disturbance rate from fire m2 m-2 d-1 T - 142 DISTURBANCE_RATE_LOGGING Disturbance rate from logging m2 m-2 d-1 T - 143 DISTURBANCE_RATE_P2P Disturbance rate from primary to primary lands m2 m-2 d-1 T - 144 DISTURBANCE_RATE_P2S Disturbance rate from primary to secondary lands m2 m-2 d-1 T - 145 DISTURBANCE_RATE_POTENTIAL Potential (i.e., including unresolved) disturbance rate m2 m-2 d-1 T - 146 DISTURBANCE_RATE_S2S Disturbance rate from secondary to secondary lands m2 m-2 d-1 T - 147 DISTURBANCE_RATE_TREEFALL Disturbance rate from treefall m2 m-2 d-1 T - 148 DPVLTRB1 turbulent deposition velocity 1 m/s F - 149 DPVLTRB2 turbulent deposition velocity 2 m/s F - 150 DPVLTRB3 turbulent deposition velocity 3 m/s F - 151 DPVLTRB4 turbulent deposition velocity 4 m/s F - 152 DSL dry surface layer thickness mm T - 153 DSTDEP total dust deposition (dry+wet) from atmosphere kg/m^2/s T - 154 DSTFLXT total surface dust emission kg/m2/s T - 155 DYN_COL_ADJUSTMENTS_CH4 Adjustments in ch4 due to dynamic column areas; only makes sense at the column level: should n gC/m^2 F - 156 DYN_COL_SOIL_ADJUSTMENTS_C Adjustments in soil carbon due to dynamic column areas; only makes sense at the column level: gC/m^2 F - 157 DYN_COL_SOIL_ADJUSTMENTS_N Adjustments in soil nitrogen due to dynamic column areas; only makes sense at the column level gN/m^2 F - 158 ED_NCOHORTS Total number of ED cohorts per site none T - 159 ED_NPATCHES Total number of ED patches per site none T - 160 ED_balive Live biomass gC m-2 T - 161 ED_bdead Dead (structural) biomass (live trees, not CWD) gC m-2 T - 162 ED_bfineroot Fine root biomass gC m-2 T - 163 ED_biomass Total biomass gC m-2 T - 164 ED_bleaf Leaf biomass gC m-2 T - 165 ED_bsapwood Sapwood biomass gC m-2 T - 166 ED_bstore Storage biomass gC m-2 T - 167 EFFECT_WSPEED effective windspeed for fire spread none T - 168 EFLXBUILD building heat flux from change in interior building air temperature W/m^2 T - 169 EFLX_DYNBAL dynamic land cover change conversion energy flux W/m^2 T - 170 EFLX_GNET net heat flux into ground W/m^2 F - 171 EFLX_GRND_LAKE net heat flux into lake/snow surface, excluding light transmission W/m^2 T - 172 EFLX_LH_TOT total latent heat flux [+ to atm] W/m^2 T - 173 EFLX_LH_TOT_ICE total latent heat flux [+ to atm] (ice landunits only) W/m^2 F - 174 EFLX_LH_TOT_R Rural total evaporation W/m^2 T - 175 EFLX_LH_TOT_U Urban total evaporation W/m^2 F - 176 EFLX_SOIL_GRND soil heat flux [+ into soil] W/m^2 F - 177 ELAI exposed one-sided leaf area index m^2/m^2 T - 178 ERRH2O total water conservation error mm T - 179 ERRH2OSNO imbalance in snow depth (liquid water) mm T - 180 ERROR_FATES total error, FATES mass-balance mg/day T - 181 ERRSEB surface energy conservation error W/m^2 T - 182 ERRSOI soil/lake energy conservation error W/m^2 T - 183 ERRSOL solar radiation conservation error W/m^2 T - 184 ESAI exposed one-sided stem area index m^2/m^2 T - 185 FABD_SHA_CNLF shade fraction of direct light absorbed by each canopy and leaf layer fraction F - 186 FABD_SHA_CNLFPFT shade fraction of direct light absorbed by each canopy, leaf, and PFT fraction F - 187 FABD_SHA_TOPLF_BYCANLAYER shade fraction of direct light absorbed by the top leaf layer of each canopy layer fraction F - 188 FABD_SUN_CNLF sun fraction of direct light absorbed by each canopy and leaf layer fraction F - 189 FABD_SUN_CNLFPFT sun fraction of direct light absorbed by each canopy, leaf, and PFT fraction F - 190 FABD_SUN_TOPLF_BYCANLAYER sun fraction of direct light absorbed by the top leaf layer of each canopy layer fraction F - 191 FABI_SHA_CNLF shade fraction of indirect light absorbed by each canopy and leaf layer fraction F - 192 FABI_SHA_CNLFPFT shade fraction of indirect light absorbed by each canopy, leaf, and PFT fraction F - 193 FABI_SHA_TOPLF_BYCANLAYER shade fraction of indirect light absorbed by the top leaf layer of each canopy layer fraction F - 194 FABI_SUN_CNLF sun fraction of indirect light absorbed by each canopy and leaf layer fraction F - 195 FABI_SUN_CNLFPFT sun fraction of indirect light absorbed by each canopy, leaf, and PFT fraction F - 196 FABI_SUN_TOPLF_BYCANLAYER sun fraction of indirect light absorbed by the top leaf layer of each canopy layer fraction F - 197 FATES_HR heterotrophic respiration gC/m^2/s T - 198 FATES_c_to_litr_cel_c litter celluluse carbon flux from FATES to BGC gC/m^3/s T - 199 FATES_c_to_litr_lab_c litter labile carbon flux from FATES to BGC gC/m^3/s T - 200 FATES_c_to_litr_lig_c litter lignin carbon flux from FATES to BGC gC/m^3/s T - 201 FCEV canopy evaporation W/m^2 T - 202 FCH4 Gridcell surface CH4 flux to atmosphere (+ to atm) kgC/m2/s T - 203 FCH4TOCO2 Gridcell oxidation of CH4 to CO2 gC/m2/s T - 204 FCH4_DFSAT CH4 additional flux due to changing fsat, natural vegetated and crop landunits only kgC/m2/s T - 205 FCO2 CO2 flux to atmosphere (+ to atm) kgCO2/m2/s F - 206 FCOV fractional impermeable area unitless T - 207 FCTR canopy transpiration W/m^2 T - 208 FGEV ground evaporation W/m^2 T - 209 FGR heat flux into soil/snow including snow melt and lake / snow light transmission W/m^2 T - 210 FGR12 heat flux between soil layers 1 and 2 W/m^2 T - 211 FGR_ICE heat flux into soil/snow including snow melt and lake / snow light transmission (ice landunits W/m^2 F - 212 FGR_R Rural heat flux into soil/snow including snow melt and snow light transmission W/m^2 F - 213 FGR_SOIL_R Rural downward heat flux at interface below each soil layer watt/m^2 F - 214 FGR_U Urban heat flux into soil/snow including snow melt W/m^2 F - 215 FH2OSFC fraction of ground covered by surface water unitless T - 216 FH2OSFC_NOSNOW fraction of ground covered by surface water (if no snow present) unitless F - 217 FINUNDATED fractional inundated area of vegetated columns unitless T - 218 FINUNDATED_LAG time-lagged inundated fraction of vegetated columns unitless F - 219 FIRA net infrared (longwave) radiation W/m^2 T - 220 FIRA_ICE net infrared (longwave) radiation (ice landunits only) W/m^2 F - 221 FIRA_R Rural net infrared (longwave) radiation W/m^2 T - 222 FIRA_U Urban net infrared (longwave) radiation W/m^2 F - 223 FIRE emitted infrared (longwave) radiation W/m^2 T - 224 FIRE_AREA spitfire fire area burn fraction fraction/day T - 225 FIRE_FDI probability that an ignition will lead to a fire none T - 226 FIRE_FLUX ED-spitfire loss to atmosphere of elements g/m^2/s T - 227 FIRE_FUEL_BULKD spitfire fuel bulk density kg biomass/m3 T - 228 FIRE_FUEL_EFF_MOIST spitfire fuel moisture m T - 229 FIRE_FUEL_MEF spitfire fuel moisture m T - 230 FIRE_FUEL_SAV spitfire fuel surface/volume per m T - 231 FIRE_ICE emitted infrared (longwave) radiation (ice landunits only) W/m^2 F - 232 FIRE_IGNITIONS number of successful ignitions number/km2/day T - 233 FIRE_INTENSITY spitfire fire intensity: kJ/m/s kJ/m/s T - 234 FIRE_INTENSITY_AREA_PRODUCT spitfire product of fire intensity and burned area (divide by FIRE_AREA to get area-weighted m kJ/m/s T - 235 FIRE_INTENSITY_BY_PATCH_AGE product of fire intensity and burned area, resolved by patch age (so divide by AREA_BURNT_BY_P kJ/m/2 T - 236 FIRE_NESTEROV_INDEX nesterov_fire_danger index none T - 237 FIRE_R Rural emitted infrared (longwave) radiation W/m^2 T - 238 FIRE_ROS fire rate of spread m/min m/min T - 239 FIRE_ROS_AREA_PRODUCT product of fire rate of spread (m/min) and burned area (fraction)--divide by FIRE_AREA to get m/min T - 240 FIRE_TFC_ROS total fuel consumed kgC/m2 T - 241 FIRE_TFC_ROS_AREA_PRODUCT product of total fuel consumed and burned area--divide by FIRE_AREA to get burned-area-weighte kgC/m2 T - 242 FIRE_U Urban emitted infrared (longwave) radiation W/m^2 F - 243 FLDS atmospheric longwave radiation (downscaled to columns in glacier regions) W/m^2 T - 244 FLDS_ICE atmospheric longwave radiation (downscaled to columns in glacier regions) (ice landunits only) W/m^2 F - 245 FNRTC Total carbon in live plant fine-roots kgC ha-1 T - 246 FNRTC_SCPF fine-root carbon mass by size-class x pft kgC/ha F - 247 FRAGMENTATION_SCALER_SL factor by which litter/cwd fragmentation proceeds relative to max rate by soil layer unitless (0-1) T - 248 FROOT_MR fine root maintenance respiration) kg C / m2 / yr T - 249 FROOT_MR_CANOPY_SCLS FROOT_MR for canopy plants by size class kg C / ha / yr F - 250 FROOT_MR_UNDERSTORY_SCLS FROOT_MR for understory plants by size class kg C / ha / yr F - 251 FROST_TABLE frost table depth (natural vegetated and crop landunits only) m F - 252 FSA absorbed solar radiation W/m^2 T - 253 FSAT fractional area with water table at surface unitless T - 254 FSA_ICE absorbed solar radiation (ice landunits only) W/m^2 F - 255 FSA_R Rural absorbed solar radiation W/m^2 F - 256 FSA_U Urban absorbed solar radiation W/m^2 F - 257 FSD24 direct radiation (last 24hrs) K F - 258 FSD240 direct radiation (last 240hrs) K F - 259 FSDS atmospheric incident solar radiation W/m^2 T - 260 FSDSND direct nir incident solar radiation W/m^2 T - 261 FSDSNDLN direct nir incident solar radiation at local noon W/m^2 T - 262 FSDSNI diffuse nir incident solar radiation W/m^2 T - 263 FSDSVD direct vis incident solar radiation W/m^2 T - 264 FSDSVDLN direct vis incident solar radiation at local noon W/m^2 T - 265 FSDSVI diffuse vis incident solar radiation W/m^2 T - 266 FSDSVILN diffuse vis incident solar radiation at local noon W/m^2 T - 267 FSH sensible heat not including correction for land use change and rain/snow conversion W/m^2 T - 268 FSH_G sensible heat from ground W/m^2 T - 269 FSH_ICE sensible heat not including correction for land use change and rain/snow conversion (ice landu W/m^2 F - 270 FSH_PRECIP_CONVERSION Sensible heat flux from conversion of rain/snow atm forcing W/m^2 T - 271 FSH_R Rural sensible heat W/m^2 T - 272 FSH_RUNOFF_ICE_TO_LIQ sensible heat flux generated from conversion of ice runoff to liquid W/m^2 T - 273 FSH_TO_COUPLER sensible heat sent to coupler (includes corrections for land use change, rain/snow conversion W/m^2 T - 274 FSH_U Urban sensible heat W/m^2 F - 275 FSH_V sensible heat from veg W/m^2 T - 276 FSI24 indirect radiation (last 24hrs) K F - 277 FSI240 indirect radiation (last 240hrs) K F - 278 FSM snow melt heat flux W/m^2 T - 279 FSM_ICE snow melt heat flux (ice landunits only) W/m^2 F - 280 FSM_R Rural snow melt heat flux W/m^2 F - 281 FSM_U Urban snow melt heat flux W/m^2 F - 282 FSNO fraction of ground covered by snow unitless T - 283 FSNO_EFF effective fraction of ground covered by snow unitless T - 284 FSNO_ICE fraction of ground covered by snow (ice landunits only) unitless F - 285 FSR reflected solar radiation W/m^2 T - 286 FSRND direct nir reflected solar radiation W/m^2 T - 287 FSRNDLN direct nir reflected solar radiation at local noon W/m^2 T - 288 FSRNI diffuse nir reflected solar radiation W/m^2 T - 289 FSRVD direct vis reflected solar radiation W/m^2 T - 290 FSRVDLN direct vis reflected solar radiation at local noon W/m^2 T - 291 FSRVI diffuse vis reflected solar radiation W/m^2 T - 292 FSR_ICE reflected solar radiation (ice landunits only) W/m^2 F - 293 FSUN sunlit fraction of canopy proportion F - 294 FSUN24 fraction sunlit (last 24hrs) K F - 295 FSUN240 fraction sunlit (last 240hrs) K F - 296 FUEL_AMOUNT_AGEFUEL spitfire fuel quantity in each age x fuel class kg C / m2 T - 297 FUEL_AMOUNT_BY_NFSC spitfire size-resolved fuel quantity kg C / m2 T - 298 FUEL_MOISTURE_NFSC spitfire size-resolved fuel moisture - T - 299 Fire_Closs ED/SPitfire Carbon loss to atmosphere gC/m^2/s T - 300 GPP gross primary production gC/m^2/s T - 301 GPP_BY_AGE gross primary productivity by age bin gC/m^2/s F - 302 GPP_CANOPY gross primary production of canopy plants gC/m^2/s T - 303 GPP_CANOPY_SCPF gross primary production of canopy plants by pft/size kgC/m2/yr F - 304 GPP_SCPF gross primary production by pft/size kgC/m2/yr F - 305 GPP_UNDERSTORY gross primary production of understory plants gC/m^2/s T - 306 GPP_UNDERSTORY_SCPF gross primary production of understory plants by pft/size kgC/m2/yr F - 307 GROSS_NMIN gross rate of N mineralization gN/m^2/s T - 308 GROWTHFLUX_FUSION_SCPF flux of individuals into a given size class bin via fusion n/yr/ha F - 309 GROWTHFLUX_SCPF flux of individuals into a given size class bin via growth and recruitment n/yr/ha F - 310 GROWTH_RESP growth respiration gC/m^2/s T - 311 GSSHA shaded leaf stomatal conductance umol H20/m2/s T - 312 GSSHALN shaded leaf stomatal conductance at local noon umol H20/m2/s T - 313 GSSUN sunlit leaf stomatal conductance umol H20/m2/s T - 314 GSSUNLN sunlit leaf stomatal conductance at local noon umol H20/m2/s T - 315 H2OCAN intercepted water mm T - 316 H2OSFC surface water depth mm T - 317 H2OSNO snow depth (liquid water) mm T - 318 H2OSNO_ICE snow depth (liquid water, ice landunits only) mm F - 319 H2OSNO_TOP mass of snow in top snow layer kg/m2 T - 320 H2OSOI volumetric soil water (natural vegetated and crop landunits only) mm3/mm3 T - 321 HARVEST_CARBON_FLUX Harvest carbon flux kg C m-2 d-1 T - 322 HBOT canopy bottom m F - 323 HEAT_CONTENT1 initial gridcell total heat content J/m^2 T - 324 HEAT_CONTENT1_VEG initial gridcell total heat content - natural vegetated and crop landunits only J/m^2 F - 325 HEAT_CONTENT2 post land cover change total heat content J/m^2 F - 326 HEAT_FROM_AC sensible heat flux put into canyon due to heat removed from air conditioning W/m^2 T - 327 HIA 2 m NWS Heat Index C T - 328 HIA_R Rural 2 m NWS Heat Index C T - 329 HIA_U Urban 2 m NWS Heat Index C T - 330 HK hydraulic conductivity (natural vegetated and crop landunits only) mm/s F - 331 HR total heterotrophic respiration gC/m^2/s T - 332 HR_vr total vertically resolved heterotrophic respiration gC/m^3/s T - 333 HTOP canopy top m T - 334 HUMIDEX 2 m Humidex C T - 335 HUMIDEX_R Rural 2 m Humidex C T - 336 HUMIDEX_U Urban 2 m Humidex C T - 337 ICE_CONTENT1 initial gridcell total ice content mm T - 338 ICE_CONTENT2 post land cover change total ice content mm F - 339 ICE_MODEL_FRACTION Ice sheet model fractional coverage unitless F - 340 INT_SNOW accumulated swe (natural vegetated and crop landunits only) mm F - 341 INT_SNOW_ICE accumulated swe (ice landunits only) mm F - 342 IWUELN local noon intrinsic water use efficiency umolCO2/molH2O T - 343 KROOT root conductance each soil layer 1/s F - 344 KSOIL soil conductance in each soil layer 1/s F - 345 K_ACT_SOM active soil organic potential loss coefficient 1/s F - 346 K_CEL_LIT cellulosic litter potential loss coefficient 1/s F - 347 K_LIG_LIT lignin litter potential loss coefficient 1/s F - 348 K_MET_LIT metabolic litter potential loss coefficient 1/s F - 349 K_PAS_SOM passive soil organic potential loss coefficient 1/s F - 350 K_SLO_SOM slow soil organic ma potential loss coefficient 1/s F - 351 LAI240 240hr average of leaf area index m^2/m^2 F - 352 LAISHA shaded projected leaf area index m^2/m^2 T - 353 LAISHA_TOP_CAN LAI in the shade by the top leaf layer of each canopy layer m2/m2 F - 354 LAISHA_Z_CNLF LAI in the shade by each canopy and leaf layer m2/m2 F - 355 LAISHA_Z_CNLFPFT LAI in the shade by each canopy, leaf, and PFT m2/m2 F - 356 LAISUN sunlit projected leaf area index m^2/m^2 T - 357 LAISUN_TOP_CAN LAI in the sun by the top leaf layer of each canopy layer m2/m2 F - 358 LAISUN_Z_CNLF LAI in the sun by each canopy and leaf layer m2/m2 F - 359 LAISUN_Z_CNLFPFT LAI in the sun by each canopy, leaf, and PFT m2/m2 F - 360 LAI_BY_AGE leaf area index by age bin m2/m2 T - 361 LAI_CANOPY_SCLS Leaf are index (LAI) by size class m2/m2 T - 362 LAI_UNDERSTORY_SCLS number of understory plants by size class indiv/ha T - 363 LAKEICEFRAC lake layer ice mass fraction unitless F - 364 LAKEICEFRAC_SURF surface lake layer ice mass fraction unitless T - 365 LAKEICETHICK thickness of lake ice (including physical expansion on freezing) m T - 366 LEAFC Total carbon in live plant leaves kgC ha-1 T - 367 LEAFC_SCPF leaf carbon mass by size-class x pft kgC/ha F - 368 LEAF_HEIGHT_DIST leaf height distribution m2/m2 T - 369 LEAF_MD_CANOPY_SCLS LEAF_MD for canopy plants by size class kg C / ha / yr F - 370 LEAF_MD_UNDERSTORY_SCLS LEAF_MD for understory plants by size class kg C / ha / yr F - 371 LEAF_MR RDARK (leaf maintenance respiration) kg C / m2 / yr T - 372 LIG_LITC LIG_LIT C gC/m^2 T - 373 LIG_LITC_1m LIG_LIT C to 1 meter gC/m^2 F - 374 LIG_LITC_TNDNCY_VERT_TRA lignin litter C tendency due to vertical transport gC/m^3/s F - 375 LIG_LITC_TO_SLO_SOMC decomp. of lignin litter C to slow soil organic ma C gC/m^2/s F - 376 LIG_LITC_TO_SLO_SOMC_vr decomp. of lignin litter C to slow soil organic ma C gC/m^3/s F - 377 LIG_LITC_vr LIG_LIT C (vertically resolved) gC/m^3 T - 378 LIG_LITN LIG_LIT N gN/m^2 T - 379 LIG_LITN_1m LIG_LIT N to 1 meter gN/m^2 F - 380 LIG_LITN_TNDNCY_VERT_TRA lignin litter N tendency due to vertical transport gN/m^3/s F - 381 LIG_LITN_TO_SLO_SOMN decomp. of lignin litter N to slow soil organic ma N gN/m^2 F - 382 LIG_LITN_TO_SLO_SOMN_vr decomp. of lignin litter N to slow soil organic ma N gN/m^3 F - 383 LIG_LITN_vr LIG_LIT N (vertically resolved) gN/m^3 T - 384 LIG_LIT_HR Het. Resp. from lignin litter gC/m^2/s F - 385 LIG_LIT_HR_vr Het. Resp. from lignin litter gC/m^3/s F - 386 LIQCAN intercepted liquid water mm T - 387 LIQUID_CONTENT1 initial gridcell total liq content mm T - 388 LIQUID_CONTENT2 post landuse change gridcell total liq content mm F - 389 LIQUID_WATER_TEMP1 initial gridcell weighted average liquid water temperature K F - 390 LITTERC_HR litter C heterotrophic respiration gC/m^2/s T - 391 LITTER_CWD total mass of litter in CWD kg ha-1 T - 392 LITTER_CWD_AG_ELEM mass of above ground litter in CWD (trunks/branches/twigs) kg ha-1 T - 393 LITTER_CWD_BG_ELEM mass of below ground litter in CWD (coarse roots) kg ha-1 T - 394 LITTER_FINES_AG_ELEM mass of above ground litter in fines (leaves,nonviable seed) kg ha-1 T - 395 LITTER_FINES_BG_ELEM mass of below ground litter in fines (fineroots) kg ha-1 T - 396 LITTER_IN FATES litter flux in gC m-2 s-1 T - 397 LITTER_IN_ELEM FATES litter flux in kg ha-1 d-1 T - 398 LITTER_OUT FATES litter flux out gC m-2 s-1 T - 399 LITTER_OUT_ELEM FATES litter flux out (fragmentation only) kg ha-1 d-1 T - 400 LIVECROOT_MR live coarse root maintenance respiration) kg C / m2 / yr T - 401 LIVECROOT_MR_CANOPY_SCLS LIVECROOT_MR for canopy plants by size class kg C / ha / yr F - 402 LIVECROOT_MR_UNDERSTORY_SCLS LIVECROOT_MR for understory plants by size class kg C / ha / yr F - 403 LIVESTEM_MR live stem maintenance respiration) kg C / m2 / yr T - 404 LIVESTEM_MR_CANOPY_SCLS LIVESTEM_MR for canopy plants by size class kg C / ha / yr F - 405 LIVESTEM_MR_UNDERSTORY_SCLS LIVESTEM_MR for understory plants by size class kg C / ha / yr F - 406 LNC leaf N concentration gN leaf/m^2 T - 407 LWdown atmospheric longwave radiation (downscaled to columns in glacier regions) W/m^2 F - 408 LWup upwelling longwave radiation W/m^2 F - 409 M10_CACLS age senescence mortality by cohort age N/ha/yr T - 410 M10_CAPF age senescence mortality by pft/cohort age N/ha/yr F - 411 M10_SCLS age senescence mortality by size N/ha/yr T - 412 M10_SCPF age senescence mortality by pft/size N/ha/yr F - 413 M1_SCLS background mortality by size N/ha/yr T - 414 M1_SCPF background mortality by pft/size N/ha/yr F - 415 M2_SCLS hydraulic mortality by size N/ha/yr T - 416 M2_SCPF hydraulic mortality by pft/size N/ha/yr F - 417 M3_SCLS carbon starvation mortality by size N/ha/yr T - 418 M3_SCPF carbon starvation mortality by pft/size N/ha/yr F - 419 M4_SCLS impact mortality by size N/ha/yr T - 420 M4_SCPF impact mortality by pft/size N/ha/yr F - 421 M5_SCLS fire mortality by size N/ha/yr T - 422 M5_SCPF fire mortality by pft/size N/ha/yr F - 423 M6_SCLS termination mortality by size N/ha/yr T - 424 M6_SCPF termination mortality by pft/size N/ha/yr F - 425 M7_SCLS logging mortality by size N/ha/event T - 426 M7_SCPF logging mortality by pft/size N/ha/event F - 427 M8_SCLS freezing mortality by size N/ha/event T - 428 M8_SCPF freezing mortality by pft/size N/ha/yr F - 429 M9_SCLS senescence mortality by size N/ha/yr T - 430 M9_SCPF senescence mortality by pft/size N/ha/yr F - 431 MAINT_RESP maintenance respiration gC/m^2/s T - 432 MET_LITC MET_LIT C gC/m^2 T - 433 MET_LITC_1m MET_LIT C to 1 meter gC/m^2 F - 434 MET_LITC_TNDNCY_VERT_TRA metabolic litter C tendency due to vertical transport gC/m^3/s F - 435 MET_LITC_TO_ACT_SOMC decomp. of metabolic litter C to active soil organic C gC/m^2/s F - 436 MET_LITC_TO_ACT_SOMC_vr decomp. of metabolic litter C to active soil organic C gC/m^3/s F - 437 MET_LITC_vr MET_LIT C (vertically resolved) gC/m^3 T - 438 MET_LITN MET_LIT N gN/m^2 T - 439 MET_LITN_1m MET_LIT N to 1 meter gN/m^2 F - 440 MET_LITN_TNDNCY_VERT_TRA metabolic litter N tendency due to vertical transport gN/m^3/s F - 441 MET_LITN_TO_ACT_SOMN decomp. of metabolic litter N to active soil organic N gN/m^2 F - 442 MET_LITN_TO_ACT_SOMN_vr decomp. of metabolic litter N to active soil organic N gN/m^3 F - 443 MET_LITN_vr MET_LIT N (vertically resolved) gN/m^3 T - 444 MET_LIT_HR Het. Resp. from metabolic litter gC/m^2/s F - 445 MET_LIT_HR_vr Het. Resp. from metabolic litter gC/m^3/s F - 446 MORTALITY Rate of total mortality by PFT indiv/ha/yr T - 447 MORTALITY_CANOPY_SCAG mortality rate of canopy plants in each size x age class plants/ha/yr F - 448 MORTALITY_CANOPY_SCLS total mortality of canopy trees by size class indiv/ha/yr T - 449 MORTALITY_CANOPY_SCPF total mortality of canopy plants by pft/size N/ha/yr F - 450 MORTALITY_CARBONFLUX_CANOPY flux of biomass carbon from live to dead pools from mortality of canopy plants gC/m2/s T - 451 MORTALITY_CARBONFLUX_UNDERSTORY flux of biomass carbon from live to dead pools from mortality of understory plants gC/m2/s T - 452 MORTALITY_UNDERSTORY_SCAG mortality rate of understory plantsin each size x age class plants/ha/yr F - 453 MORTALITY_UNDERSTORY_SCLS total mortality of understory trees by size class indiv/ha/yr T - 454 MORTALITY_UNDERSTORY_SCPF total mortality of understory plants by pft/size N/ha/yr F - 455 M_ACT_SOMC_TO_LEACHING active soil organic C leaching loss gC/m^2/s F - 456 M_ACT_SOMN_TO_LEACHING active soil organic N leaching loss gN/m^2/s F - 457 M_CEL_LITC_TO_LEACHING cellulosic litter C leaching loss gC/m^2/s F - 458 M_CEL_LITN_TO_LEACHING cellulosic litter N leaching loss gN/m^2/s F - 459 M_LIG_LITC_TO_LEACHING lignin litter C leaching loss gC/m^2/s F - 460 M_LIG_LITN_TO_LEACHING lignin litter N leaching loss gN/m^2/s F - 461 M_MET_LITC_TO_LEACHING metabolic litter C leaching loss gC/m^2/s F - 462 M_MET_LITN_TO_LEACHING metabolic litter N leaching loss gN/m^2/s F - 463 M_PAS_SOMC_TO_LEACHING passive soil organic C leaching loss gC/m^2/s F - 464 M_PAS_SOMN_TO_LEACHING passive soil organic N leaching loss gN/m^2/s F - 465 M_SLO_SOMC_TO_LEACHING slow soil organic ma C leaching loss gC/m^2/s F - 466 M_SLO_SOMN_TO_LEACHING slow soil organic ma N leaching loss gN/m^2/s F - 467 NCL_BY_AGE number of canopy levels by age bin -- F - 468 NDEP_TO_SMINN atmospheric N deposition to soil mineral N gN/m^2/s T - 469 NEM Gridcell net adjustment to net carbon exchange passed to atm. for methane production gC/m2/s T - 470 NEP net ecosystem production gC/m^2/s T - 471 NET_C_UPTAKE_CNLF net carbon uptake by each canopy and leaf layer per unit ground area (i.e. divide by CROWNAREA gC/m2/s F - 472 NET_NMIN net rate of N mineralization gN/m^2/s T - 473 NFIX_TO_SMINN symbiotic/asymbiotic N fixation to soil mineral N gN/m^2/s T - 474 NPATCH_BY_AGE number of patches by age bin -- F - 475 NPLANT_CACLS number of plants by coage class indiv/ha T - 476 NPLANT_CANOPY_SCAG number of plants per hectare in canopy in each size x age class plants/ha F - 477 NPLANT_CANOPY_SCLS number of canopy plants by size class indiv/ha T - 478 NPLANT_CANOPY_SCPF stem number of canopy plants density by pft/size N/ha F - 479 NPLANT_CAPF stem number density by pft/coage N/ha F - 480 NPLANT_SCAG number of plants per hectare in each size x age class plants/ha T - 481 NPLANT_SCAGPFT number of plants per hectare in each size x age x pft class plants/ha F - 482 NPLANT_SCLS number of plants by size class indiv/ha T - 483 NPLANT_SCPF stem number density by pft/size N/ha F - 484 NPLANT_UNDERSTORY_SCAG number of plants per hectare in understory in each size x age class plants/ha F - 485 NPLANT_UNDERSTORY_SCLS number of understory plants by size class indiv/ha T - 486 NPLANT_UNDERSTORY_SCPF stem number of understory plants density by pft/size N/ha F - 487 NPP net primary production gC/m^2/s T - 488 NPP_AGDW_SCPF NPP flux into above-ground deadwood by pft/size kgC/m2/yr F - 489 NPP_AGEPFT NPP per PFT in each age bin kgC/m2/yr F - 490 NPP_AGSW_SCPF NPP flux into above-ground sapwood by pft/size kgC/m2/yr F - 491 NPP_BDEAD_CANOPY_SCLS NPP_BDEAD for canopy plants by size class kg C / ha / yr F - 492 NPP_BDEAD_UNDERSTORY_SCLS NPP_BDEAD for understory plants by size class kg C / ha / yr F - 493 NPP_BGDW_SCPF NPP flux into below-ground deadwood by pft/size kgC/m2/yr F - 494 NPP_BGSW_SCPF NPP flux into below-ground sapwood by pft/size kgC/m2/yr F - 495 NPP_BSEED_CANOPY_SCLS NPP_BSEED for canopy plants by size class kg C / ha / yr F - 496 NPP_BSEED_UNDERSTORY_SCLS NPP_BSEED for understory plants by size class kg C / ha / yr F - 497 NPP_BSW_CANOPY_SCLS NPP_BSW for canopy plants by size class kg C / ha / yr F - 498 NPP_BSW_UNDERSTORY_SCLS NPP_BSW for understory plants by size class kg C / ha / yr F - 499 NPP_BY_AGE net primary productivity by age bin gC/m^2/s F - 500 NPP_CROOT NPP flux into coarse roots kgC/m2/yr T - 501 NPP_FNRT_SCPF NPP flux into fine roots by pft/size kgC/m2/yr F - 502 NPP_FROOT NPP flux into fine roots kgC/m2/yr T - 503 NPP_FROOT_CANOPY_SCLS NPP_FROOT for canopy plants by size class kg C / ha / yr F - 504 NPP_FROOT_UNDERSTORY_SCLS NPP_FROOT for understory plants by size class kg C / ha / yr F - 505 NPP_LEAF NPP flux into leaves kgC/m2/yr T - 506 NPP_LEAF_CANOPY_SCLS NPP_LEAF for canopy plants by size class kg C / ha / yr F - 507 NPP_LEAF_SCPF NPP flux into leaves by pft/size kgC/m2/yr F - 508 NPP_LEAF_UNDERSTORY_SCLS NPP_LEAF for understory plants by size class kg C / ha / yr F - 509 NPP_SCPF total net primary production by pft/size kgC/m2/yr F - 510 NPP_SEED NPP flux into seeds kgC/m2/yr T - 511 NPP_SEED_SCPF NPP flux into seeds by pft/size kgC/m2/yr F - 512 NPP_STEM NPP flux into stem kgC/m2/yr T - 513 NPP_STOR NPP flux into storage tissues kgC/m2/yr T - 514 NPP_STORE_CANOPY_SCLS NPP_STORE for canopy plants by size class kg C / ha / yr F - 515 NPP_STORE_UNDERSTORY_SCLS NPP_STORE for understory plants by size class kg C / ha / yr F - 516 NPP_STOR_SCPF NPP flux into storage by pft/size kgC/m2/yr F - 517 NSUBSTEPS number of adaptive timesteps in CLM timestep unitless F - 518 O2_DECOMP_DEPTH_UNSAT O2 consumption from HR and AR for non-inundated area mol/m3/s F - 519 OBU Monin-Obukhov length m F - 520 OCDEP total OC deposition (dry+wet) from atmosphere kg/m^2/s T - 521 O_SCALAR fraction by which decomposition is reduced due to anoxia unitless T - 522 PARPROF_DIF_CNLF Radiative profile of diffuse PAR through each canopy and leaf layer (averaged across PFTs) W/m2 F - 523 PARPROF_DIF_CNLFPFT Radiative profile of diffuse PAR through each canopy, leaf, and PFT W/m2 F - 524 PARPROF_DIR_CNLF Radiative profile of direct PAR through each canopy and leaf layer (averaged across PFTs) W/m2 F - 525 PARPROF_DIR_CNLFPFT Radiative profile of direct PAR through each canopy, leaf, and PFT W/m2 F - 526 PARSHA_Z_CAN PAR absorbed in the shade by top leaf layer in each canopy layer W/m2 F - 527 PARSHA_Z_CNLF PAR absorbed in the shade by each canopy and leaf layer W/m2 F - 528 PARSHA_Z_CNLFPFT PAR absorbed in the shade by each canopy, leaf, and PFT W/m2 F - 529 PARSUN_Z_CAN PAR absorbed in the sun by top leaf layer in each canopy layer W/m2 F - 530 PARSUN_Z_CNLF PAR absorbed in the sun by each canopy and leaf layer W/m2 F - 531 PARSUN_Z_CNLFPFT PAR absorbed in the sun by each canopy, leaf, and PFT W/m2 F - 532 PARVEGLN absorbed par by vegetation at local noon W/m^2 T - 533 PAS_SOMC PAS_SOM C gC/m^2 T - 534 PAS_SOMC_1m PAS_SOM C to 1 meter gC/m^2 F - 535 PAS_SOMC_TNDNCY_VERT_TRA passive soil organic C tendency due to vertical transport gC/m^3/s F - 536 PAS_SOMC_TO_ACT_SOMC decomp. of passive soil organic C to active soil organic C gC/m^2/s F - 537 PAS_SOMC_TO_ACT_SOMC_vr decomp. of passive soil organic C to active soil organic C gC/m^3/s F - 538 PAS_SOMC_vr PAS_SOM C (vertically resolved) gC/m^3 T - 539 PAS_SOMN PAS_SOM N gN/m^2 T - 540 PAS_SOMN_1m PAS_SOM N to 1 meter gN/m^2 F - 541 PAS_SOMN_TNDNCY_VERT_TRA passive soil organic N tendency due to vertical transport gN/m^3/s F - 542 PAS_SOMN_TO_ACT_SOMN decomp. of passive soil organic N to active soil organic N gN/m^2 F - 543 PAS_SOMN_TO_ACT_SOMN_vr decomp. of passive soil organic N to active soil organic N gN/m^3 F - 544 PAS_SOMN_vr PAS_SOM N (vertically resolved) gN/m^3 T - 545 PAS_SOM_HR Het. Resp. from passive soil organic gC/m^2/s F - 546 PAS_SOM_HR_vr Het. Resp. from passive soil organic gC/m^3/s F - 547 PATCH_AREA_BY_AGE patch area by age bin m2/m2 T - 548 PBOT atmospheric pressure at surface (downscaled to columns in glacier regions) Pa T - 549 PCH4 atmospheric partial pressure of CH4 Pa T - 550 PCO2 atmospheric partial pressure of CO2 Pa T - 551 PFTbiomass total PFT level biomass gC/m2 T - 552 PFTcanopycrownarea total PFT-level canopy-layer crown area m2/m2 F - 553 PFTcrownarea total PFT level crown area m2/m2 F - 554 PFTgpp total PFT-level GPP kg C m-2 y-1 T - 555 PFTleafbiomass total PFT level leaf biomass gC/m2 T - 556 PFTnindivs total PFT level number of individuals indiv / m2 T - 557 PFTnpp total PFT-level NPP kg C m-2 y-1 T - 558 PFTstorebiomass total PFT level stored biomass gC/m2 T - 559 POTENTIAL_IMMOB potential N immobilization gN/m^2/s T - 560 PRIMARYLAND_PATCHFUSION_ERROR Error in total primary lands associated with patch fusion m2 m-2 d-1 T - 561 PROMOTION_CARBONFLUX promotion-associated biomass carbon flux from understory to canopy gC/m2/s T - 562 PROMOTION_RATE_SCLS promotion rate from understory to canopy by size class indiv/ha/yr F - 563 PSurf atmospheric pressure at surface (downscaled to columns in glacier regions) Pa F - 564 Q2M 2m specific humidity kg/kg T - 565 QAF canopy air humidity kg/kg F - 566 QBOT atmospheric specific humidity (downscaled to columns in glacier regions) kg/kg T - 567 QDIRECT_THROUGHFALL direct throughfall of liquid (rain + above-canopy irrigation) mm/s F - 568 QDIRECT_THROUGHFALL_SNOW direct throughfall of snow mm/s F - 569 QDRAI sub-surface drainage mm/s T - 570 QDRAI_PERCH perched wt drainage mm/s T - 571 QDRAI_XS saturation excess drainage mm/s T - 572 QDRIP rate of excess canopy liquid falling off canopy mm/s F - 573 QDRIP_SNOW rate of excess canopy snow falling off canopy mm/s F - 574 QFLOOD runoff from river flooding mm/s T - 575 QFLX_EVAP_TOT qflx_evap_soi + qflx_evap_can + qflx_tran_veg kg m-2 s-1 T - 576 QFLX_EVAP_VEG vegetation evaporation mm H2O/s F - 577 QFLX_ICE_DYNBAL ice dynamic land cover change conversion runoff flux mm/s T - 578 QFLX_LIQDEW_TO_TOP_LAYER rate of liquid water deposited on top soil or snow layer (dew) mm H2O/s T - 579 QFLX_LIQEVAP_FROM_TOP_LAYER rate of liquid water evaporated from top soil or snow layer mm H2O/s T - 580 QFLX_LIQ_DYNBAL liq dynamic land cover change conversion runoff flux mm/s T - 581 QFLX_LIQ_GRND liquid (rain+irrigation) on ground after interception mm H2O/s F - 582 QFLX_SNOW_DRAIN drainage from snow pack mm/s T - 583 QFLX_SNOW_DRAIN_ICE drainage from snow pack melt (ice landunits only) mm/s T - 584 QFLX_SNOW_GRND snow on ground after interception mm H2O/s F - 585 QFLX_SOLIDDEW_TO_TOP_LAYER rate of solid water deposited on top soil or snow layer (frost) mm H2O/s T - 586 QFLX_SOLIDEVAP_FROM_TOP_LAYER rate of ice evaporated from top soil or snow layer (sublimation) (also includes bare ice subli mm H2O/s T - 587 QFLX_SOLIDEVAP_FROM_TOP_LAYER_ICE rate of ice evaporated from top soil or snow layer (sublimation) (also includes bare ice subli mm H2O/s F - 588 QH2OSFC surface water runoff mm/s T - 589 QH2OSFC_TO_ICE surface water converted to ice mm/s F - 590 QHR hydraulic redistribution mm/s T - 591 QICE ice growth/melt mm/s T - 592 QICE_FORC qice forcing sent to GLC mm/s F - 593 QICE_FRZ ice growth mm/s T - 594 QICE_MELT ice melt mm/s T - 595 QINFL infiltration mm/s T - 596 QINTR interception mm/s T - 597 QIRRIG_DEMAND irrigation demand mm/s F - 598 QIRRIG_DRIP water added via drip irrigation mm/s F - 599 QIRRIG_FROM_GW_CONFINED water added through confined groundwater irrigation mm/s T - 600 QIRRIG_FROM_GW_UNCONFINED water added through unconfined groundwater irrigation mm/s T - 601 QIRRIG_FROM_SURFACE water added through surface water irrigation mm/s T - 602 QIRRIG_SPRINKLER water added via sprinkler irrigation mm/s F - 603 QOVER total surface runoff (includes QH2OSFC) mm/s T - 604 QOVER_LAG time-lagged surface runoff for soil columns mm/s F - 605 QPHSNEG net negative hydraulic redistribution flux mm/s F - 606 QRGWL surface runoff at glaciers (liquid only), wetlands, lakes; also includes melted ice runoff fro mm/s T - 607 QROOTSINK water flux from soil to root in each soil-layer mm/s F - 608 QRUNOFF total liquid runoff not including correction for land use change mm/s T - 609 QRUNOFF_ICE total liquid runoff not incl corret for LULCC (ice landunits only) mm/s T - 610 QRUNOFF_ICE_TO_COUPLER total ice runoff sent to coupler (includes corrections for land use change) mm/s T - 611 QRUNOFF_ICE_TO_LIQ liquid runoff from converted ice runoff mm/s F - 612 QRUNOFF_R Rural total runoff mm/s F - 613 QRUNOFF_TO_COUPLER total liquid runoff sent to coupler (includes corrections for land use change) mm/s T - 614 QRUNOFF_U Urban total runoff mm/s F - 615 QSNOCPLIQ excess liquid h2o due to snow capping not including correction for land use change mm H2O/s T - 616 QSNOEVAP evaporation from snow (only when snl<0, otherwise it is equal to qflx_ev_soil) mm/s T - 617 QSNOFRZ column-integrated snow freezing rate kg/m2/s T - 618 QSNOFRZ_ICE column-integrated snow freezing rate (ice landunits only) mm/s T - 619 QSNOMELT snow melt rate mm/s T - 620 QSNOMELT_ICE snow melt (ice landunits only) mm/s T - 621 QSNOUNLOAD canopy snow unloading mm/s T - 622 QSNO_TEMPUNLOAD canopy snow temp unloading mm/s T - 623 QSNO_WINDUNLOAD canopy snow wind unloading mm/s T - 624 QSNWCPICE excess solid h2o due to snow capping not including correction for land use change mm H2O/s T - 625 QSOIL Ground evaporation (soil/snow evaporation + soil/snow sublimation - dew) mm/s T - 626 QSOIL_ICE Ground evaporation (ice landunits only) mm/s T - 627 QTOPSOIL water input to surface mm/s F - 628 QVEGE canopy evaporation mm/s T - 629 QVEGT canopy transpiration mm/s T - 630 Qair atmospheric specific humidity (downscaled to columns in glacier regions) kg/kg F - 631 Qh sensible heat W/m^2 F - 632 Qle total evaporation W/m^2 F - 633 Qstor storage heat flux (includes snowmelt) W/m^2 F - 634 Qtau momentum flux kg/m/s^2 F - 635 RAH1 aerodynamical resistance s/m F - 636 RAH2 aerodynamical resistance s/m F - 637 RAIN atmospheric rain, after rain/snow repartitioning based on temperature mm/s T - 638 RAIN_FROM_ATM atmospheric rain received from atmosphere (pre-repartitioning) mm/s T - 639 RAIN_ICE atmospheric rain, after rain/snow repartitioning based on temperature (ice landunits only) mm/s F - 640 RAM_LAKE aerodynamic resistance for momentum (lakes only) s/m F - 641 RAW1 aerodynamical resistance s/m F - 642 RAW2 aerodynamical resistance s/m F - 643 RB leaf boundary resistance s/m F - 644 RDARK_CANOPY_SCLS RDARK for canopy plants by size class kg C / ha / yr F - 645 RDARK_UNDERSTORY_SCLS RDARK for understory plants by size class kg C / ha / yr F - 646 RECRUITMENT Rate of recruitment by PFT indiv/ha/yr T - 647 REPROC Total carbon in live plant reproductive tissues kgC ha-1 T - 648 REPROC_SCPF reproductive carbon mass (on plant) by size-class x pft kgC/ha F - 649 RESP_G_CANOPY_SCLS RESP_G for canopy plants by size class kg C / ha / yr F - 650 RESP_G_UNDERSTORY_SCLS RESP_G for understory plants by size class kg C / ha / yr F - 651 RESP_M_CANOPY_SCLS RESP_M for canopy plants by size class kg C / ha / yr F - 652 RESP_M_UNDERSTORY_SCLS RESP_M for understory plants by size class kg C / ha / yr F - 653 RH atmospheric relative humidity % F - 654 RH2M 2m relative humidity % T - 655 RH2M_R Rural 2m specific humidity % F - 656 RH2M_U Urban 2m relative humidity % F - 657 RHAF fractional humidity of canopy air fraction F - 658 RH_LEAF fractional humidity at leaf surface fraction F - 659 ROOT_MD_CANOPY_SCLS ROOT_MD for canopy plants by size class kg C / ha / yr F - 660 ROOT_MD_UNDERSTORY_SCLS ROOT_MD for understory plants by size class kg C / ha / yr F - 661 RSCANOPY canopy resistance s m-1 T - 662 RSSHA shaded leaf stomatal resistance s/m T - 663 RSSUN sunlit leaf stomatal resistance s/m T - 664 Rainf atmospheric rain, after rain/snow repartitioning based on temperature mm/s F - 665 Rnet net radiation W/m^2 F - 666 SABG solar rad absorbed by ground W/m^2 T - 667 SABG_PEN Rural solar rad penetrating top soil or snow layer watt/m^2 T - 668 SABV solar rad absorbed by veg W/m^2 T - 669 SAI_CANOPY_SCLS stem area index(SAI) by size class m2/m2 F - 670 SAI_UNDERSTORY_SCLS number of understory plants by size class indiv/ha F - 671 SAPWC Total carbon in live plant sapwood kgC ha-1 T - 672 SAPWC_SCPF sapwood carbon mass by size-class x pft kgC/ha F - 673 SCORCH_HEIGHT SPITFIRE Flame Scorch Height (calculated per PFT in each patch age bin) m T - 674 SECONDARY_AREA_AGE_ANTHRO_DIST Secondary forest patch area age distribution since anthropgenic disturbance m2/m2 F - 675 SECONDARY_AREA_PATCH_AGE_DIST Secondary forest patch area age distribution since any kind of disturbance m2/m2 F - 676 SECONDARY_FOREST_BIOMASS Biomass on secondary lands (per total site area, mult by SECONDARY_FOREST_FRACTION to get per kgC/m2 F - 677 SECONDARY_FOREST_FRACTION Secondary forest fraction m2/m2 F - 678 SEEDS_IN Seed Production Rate gC m-2 s-1 T - 679 SEEDS_IN_EXTERN_ELEM External Seed Influx Rate kg ha-1 d-1 T - 680 SEEDS_IN_LOCAL_ELEM Within Site Seed Production Rate kg ha-1 d-1 T - 681 SEED_BANK Total Seed Mass of all PFTs gC m-2 T - 682 SEED_BANK_ELEM Total Seed Mass of all PFTs kg ha-1 T - 683 SEED_DECAY_ELEM Seed mass decay (germinated and un-germinated) kg ha-1 d-1 T - 684 SEED_GERM_ELEM Seed mass converted into new cohorts kg ha-1 d-1 T - 685 SEED_PROD_CANOPY_SCLS SEED_PROD for canopy plants by size class kg C / ha / yr F - 686 SEED_PROD_UNDERSTORY_SCLS SEED_PROD for understory plants by size class kg C / ha / yr F - 687 SITE_COLD_STATUS Site level cold status, 0=not cold-dec, 1=too cold for leaves, 2=not-too cold 0,1,2 T - 688 SITE_DAYSINCE_COLDLEAFOFF site level days elapsed since cold leaf drop days T - 689 SITE_DAYSINCE_COLDLEAFON site level days elapsed since cold leaf flush days T - 690 SITE_DAYSINCE_DROUGHTLEAFOFF site level days elapsed since drought leaf drop days T - 691 SITE_DAYSINCE_DROUGHTLEAFON site level days elapsed since drought leaf flush days T - 692 SITE_DROUGHT_STATUS Site level drought status, <2 too dry for leaves, >=2 not-too dry 0,1,2,3 T - 693 SITE_GDD site level growing degree days degC T - 694 SITE_MEANLIQVOL_DROUGHTPHEN site level mean liquid water volume for drought phen m3/m3 T - 695 SITE_NCHILLDAYS site level number of chill days days T - 696 SITE_NCOLDDAYS site level number of cold days days T - 697 SLO_SOMC SLO_SOM C gC/m^2 T - 698 SLO_SOMC_1m SLO_SOM C to 1 meter gC/m^2 F - 699 SLO_SOMC_TNDNCY_VERT_TRA slow soil organic ma C tendency due to vertical transport gC/m^3/s F - 700 SLO_SOMC_TO_ACT_SOMC decomp. of slow soil organic ma C to active soil organic C gC/m^2/s F - 701 SLO_SOMC_TO_ACT_SOMC_vr decomp. of slow soil organic ma C to active soil organic C gC/m^3/s F - 702 SLO_SOMC_TO_PAS_SOMC decomp. of slow soil organic ma C to passive soil organic C gC/m^2/s F - 703 SLO_SOMC_TO_PAS_SOMC_vr decomp. of slow soil organic ma C to passive soil organic C gC/m^3/s F - 704 SLO_SOMC_vr SLO_SOM C (vertically resolved) gC/m^3 T - 705 SLO_SOMN SLO_SOM N gN/m^2 T - 706 SLO_SOMN_1m SLO_SOM N to 1 meter gN/m^2 F - 707 SLO_SOMN_TNDNCY_VERT_TRA slow soil organic ma N tendency due to vertical transport gN/m^3/s F - 708 SLO_SOMN_TO_ACT_SOMN decomp. of slow soil organic ma N to active soil organic N gN/m^2 F - 709 SLO_SOMN_TO_ACT_SOMN_vr decomp. of slow soil organic ma N to active soil organic N gN/m^3 F - 710 SLO_SOMN_TO_PAS_SOMN decomp. of slow soil organic ma N to passive soil organic N gN/m^2 F - 711 SLO_SOMN_TO_PAS_SOMN_vr decomp. of slow soil organic ma N to passive soil organic N gN/m^3 F - 712 SLO_SOMN_vr SLO_SOM N (vertically resolved) gN/m^3 T - 713 SLO_SOM_HR_S1 Het. Resp. from slow soil organic ma gC/m^2/s F - 714 SLO_SOM_HR_S1_vr Het. Resp. from slow soil organic ma gC/m^3/s F - 715 SLO_SOM_HR_S3 Het. Resp. from slow soil organic ma gC/m^2/s F - 716 SLO_SOM_HR_S3_vr Het. Resp. from slow soil organic ma gC/m^3/s F - 717 SMINN soil mineral N gN/m^2 T - 718 SMINN_LEACHED soil mineral N pool loss to leaching gN/m^2/s T - 719 SMINN_LEACHED_vr soil mineral N pool loss to leaching gN/m^3/s F - 720 SMINN_TO_DENIT_EXCESS denitrification from excess mineral N pool gN/m^2/s F - 721 SMINN_TO_DENIT_EXCESS_vr denitrification from excess mineral N pool gN/m^3/s F - 722 SMINN_TO_DENIT_L1S1 denitrification for decomp. of metabolic litterto ACT_SOM gN/m^2 F - 723 SMINN_TO_DENIT_L1S1_vr denitrification for decomp. of metabolic litterto ACT_SOM gN/m^3 F - 724 SMINN_TO_DENIT_L2S1 denitrification for decomp. of cellulosic litterto ACT_SOM gN/m^2 F - 725 SMINN_TO_DENIT_L2S1_vr denitrification for decomp. of cellulosic litterto ACT_SOM gN/m^3 F - 726 SMINN_TO_DENIT_L3S2 denitrification for decomp. of lignin litterto SLO_SOM gN/m^2 F - 727 SMINN_TO_DENIT_L3S2_vr denitrification for decomp. of lignin litterto SLO_SOM gN/m^3 F - 728 SMINN_TO_DENIT_S1S2 denitrification for decomp. of active soil organicto SLO_SOM gN/m^2 F - 729 SMINN_TO_DENIT_S1S2_vr denitrification for decomp. of active soil organicto SLO_SOM gN/m^3 F - 730 SMINN_TO_DENIT_S1S3 denitrification for decomp. of active soil organicto PAS_SOM gN/m^2 F - 731 SMINN_TO_DENIT_S1S3_vr denitrification for decomp. of active soil organicto PAS_SOM gN/m^3 F - 732 SMINN_TO_DENIT_S2S1 denitrification for decomp. of slow soil organic mato ACT_SOM gN/m^2 F - 733 SMINN_TO_DENIT_S2S1_vr denitrification for decomp. of slow soil organic mato ACT_SOM gN/m^3 F - 734 SMINN_TO_DENIT_S2S3 denitrification for decomp. of slow soil organic mato PAS_SOM gN/m^2 F - 735 SMINN_TO_DENIT_S2S3_vr denitrification for decomp. of slow soil organic mato PAS_SOM gN/m^3 F - 736 SMINN_TO_DENIT_S3S1 denitrification for decomp. of passive soil organicto ACT_SOM gN/m^2 F - 737 SMINN_TO_DENIT_S3S1_vr denitrification for decomp. of passive soil organicto ACT_SOM gN/m^3 F - 738 SMINN_TO_PLANT plant uptake of soil mineral N gN/m^2/s T - 739 SMINN_TO_S1N_L1 mineral N flux for decomp. of MET_LITto ACT_SOM gN/m^2 F - 740 SMINN_TO_S1N_L1_vr mineral N flux for decomp. of MET_LITto ACT_SOM gN/m^3 F - 741 SMINN_TO_S1N_L2 mineral N flux for decomp. of CEL_LITto ACT_SOM gN/m^2 F - 742 SMINN_TO_S1N_L2_vr mineral N flux for decomp. of CEL_LITto ACT_SOM gN/m^3 F - 743 SMINN_TO_S1N_S2 mineral N flux for decomp. of SLO_SOMto ACT_SOM gN/m^2 F - 744 SMINN_TO_S1N_S2_vr mineral N flux for decomp. of SLO_SOMto ACT_SOM gN/m^3 F - 745 SMINN_TO_S1N_S3 mineral N flux for decomp. of PAS_SOMto ACT_SOM gN/m^2 F - 746 SMINN_TO_S1N_S3_vr mineral N flux for decomp. of PAS_SOMto ACT_SOM gN/m^3 F - 747 SMINN_TO_S2N_L3 mineral N flux for decomp. of LIG_LITto SLO_SOM gN/m^2 F - 748 SMINN_TO_S2N_L3_vr mineral N flux for decomp. of LIG_LITto SLO_SOM gN/m^3 F - 749 SMINN_TO_S2N_S1 mineral N flux for decomp. of ACT_SOMto SLO_SOM gN/m^2 F - 750 SMINN_TO_S2N_S1_vr mineral N flux for decomp. of ACT_SOMto SLO_SOM gN/m^3 F - 751 SMINN_TO_S3N_S1 mineral N flux for decomp. of ACT_SOMto PAS_SOM gN/m^2 F - 752 SMINN_TO_S3N_S1_vr mineral N flux for decomp. of ACT_SOMto PAS_SOM gN/m^3 F - 753 SMINN_TO_S3N_S2 mineral N flux for decomp. of SLO_SOMto PAS_SOM gN/m^2 F - 754 SMINN_TO_S3N_S2_vr mineral N flux for decomp. of SLO_SOMto PAS_SOM gN/m^3 F - 755 SMINN_vr soil mineral N gN/m^3 T - 756 SMP soil matric potential (natural vegetated and crop landunits only) mm T - 757 SNOBCMCL mass of BC in snow column kg/m2 T - 758 SNOBCMSL mass of BC in top snow layer kg/m2 T - 759 SNOCAN intercepted snow mm T - 760 SNODSTMCL mass of dust in snow column kg/m2 T - 761 SNODSTMSL mass of dust in top snow layer kg/m2 T - 762 SNOFSDSND direct nir incident solar radiation on snow W/m^2 F - 763 SNOFSDSNI diffuse nir incident solar radiation on snow W/m^2 F - 764 SNOFSDSVD direct vis incident solar radiation on snow W/m^2 F - 765 SNOFSDSVI diffuse vis incident solar radiation on snow W/m^2 F - 766 SNOFSRND direct nir reflected solar radiation from snow W/m^2 T - 767 SNOFSRNI diffuse nir reflected solar radiation from snow W/m^2 T - 768 SNOFSRVD direct vis reflected solar radiation from snow W/m^2 T - 769 SNOFSRVI diffuse vis reflected solar radiation from snow W/m^2 T - 770 SNOINTABS Fraction of incoming solar absorbed by lower snow layers - T - 771 SNOLIQFL top snow layer liquid water fraction (land) fraction F - 772 SNOOCMCL mass of OC in snow column kg/m2 T - 773 SNOOCMSL mass of OC in top snow layer kg/m2 T - 774 SNORDSL top snow layer effective grain radius m^-6 F - 775 SNOTTOPL snow temperature (top layer) K F - 776 SNOTTOPL_ICE snow temperature (top layer, ice landunits only) K F - 777 SNOTXMASS snow temperature times layer mass, layer sum; to get mass-weighted temperature, divide by (SNO K kg/m2 T - 778 SNOTXMASS_ICE snow temperature times layer mass, layer sum (ice landunits only); to get mass-weighted temper K kg/m2 F - 779 SNOW atmospheric snow, after rain/snow repartitioning based on temperature mm/s T - 780 SNOWDP gridcell mean snow height m T - 781 SNOWICE snow ice kg/m2 T - 782 SNOWICE_ICE snow ice (ice landunits only) kg/m2 F - 783 SNOWLIQ snow liquid water kg/m2 T - 784 SNOWLIQ_ICE snow liquid water (ice landunits only) kg/m2 F - 785 SNOW_5D 5day snow avg m F - 786 SNOW_DEPTH snow height of snow covered area m T - 787 SNOW_DEPTH_ICE snow height of snow covered area (ice landunits only) m F - 788 SNOW_FROM_ATM atmospheric snow received from atmosphere (pre-repartitioning) mm/s T - 789 SNOW_ICE atmospheric snow, after rain/snow repartitioning based on temperature (ice landunits only) mm/s F - 790 SNOW_PERSISTENCE Length of time of continuous snow cover (nat. veg. landunits only) seconds T - 791 SNOW_SINKS snow sinks (liquid water) mm/s T - 792 SNOW_SOURCES snow sources (liquid water) mm/s T - 793 SNO_ABS Absorbed solar radiation in each snow layer W/m^2 F - 794 SNO_ABS_ICE Absorbed solar radiation in each snow layer (ice landunits only) W/m^2 F - 795 SNO_BW Partial density of water in the snow pack (ice + liquid) kg/m3 F - 796 SNO_BW_ICE Partial density of water in the snow pack (ice + liquid, ice landunits only) kg/m3 F - 797 SNO_EXISTENCE Fraction of averaging period for which each snow layer existed unitless F - 798 SNO_FRZ snow freezing rate in each snow layer kg/m2/s F - 799 SNO_FRZ_ICE snow freezing rate in each snow layer (ice landunits only) mm/s F - 800 SNO_GS Mean snow grain size Microns F - 801 SNO_GS_ICE Mean snow grain size (ice landunits only) Microns F - 802 SNO_ICE Snow ice content kg/m2 F - 803 SNO_LIQH2O Snow liquid water content kg/m2 F - 804 SNO_MELT snow melt rate in each snow layer mm/s F - 805 SNO_MELT_ICE snow melt rate in each snow layer (ice landunits only) mm/s F - 806 SNO_T Snow temperatures K F - 807 SNO_TK Thermal conductivity W/m-K F - 808 SNO_TK_ICE Thermal conductivity (ice landunits only) W/m-K F - 809 SNO_T_ICE Snow temperatures (ice landunits only) K F - 810 SNO_Z Snow layer thicknesses m F - 811 SNO_Z_ICE Snow layer thicknesses (ice landunits only) m F - 812 SNOdTdzL top snow layer temperature gradient (land) K/m F - 813 SOIL10 10-day running mean of 12cm layer soil K F - 814 SOILC_HR soil C heterotrophic respiration gC/m^2/s T - 815 SOILC_vr SOIL C (vertically resolved) gC/m^3 T - 816 SOILICE soil ice (natural vegetated and crop landunits only) kg/m2 T - 817 SOILLIQ soil liquid water (natural vegetated and crop landunits only) kg/m2 T - 818 SOILN_vr SOIL N (vertically resolved) gN/m^3 T - 819 SOILPSI soil water potential in each soil layer MPa F - 820 SOILRESIS soil resistance to evaporation s/m T - 821 SOILWATER_10CM soil liquid water + ice in top 10cm of soil (veg landunits only) kg/m2 T - 822 SOMC_FIRE C loss due to peat burning gC/m^2/s T - 823 SOM_C_LEACHED total flux of C from SOM pools due to leaching gC/m^2/s T - 824 SOM_N_LEACHED total flux of N from SOM pools due to leaching gN/m^2/s F - 825 STOREC Total carbon in live plant storage kgC ha-1 T - 826 STOREC_SCPF storage carbon mass by size-class x pft kgC/ha F - 827 SUM_FUEL total ground fuel related to ros (omits 1000hr fuels) gC m-2 T - 828 SUM_FUEL_BY_PATCH_AGE spitfire ground fuel related to ros (omits 1000hr fuels) within each patch age bin (divide by gC / m2 of site area T - 829 SUPPLEMENT_TO_SMINN supplemental N supply gN/m^2/s T - 830 SWBGT 2 m Simplified Wetbulb Globe Temp C T - 831 SWBGT_R Rural 2 m Simplified Wetbulb Globe Temp C T - 832 SWBGT_U Urban 2 m Simplified Wetbulb Globe Temp C T - 833 SWdown atmospheric incident solar radiation W/m^2 F - 834 SWup upwelling shortwave radiation W/m^2 F - 835 SoilAlpha factor limiting ground evap unitless F - 836 SoilAlpha_U urban factor limiting ground evap unitless F - 837 T10 10-day running mean of 2-m temperature K F - 838 TAF canopy air temperature K F - 839 TAUX zonal surface stress kg/m/s^2 T - 840 TAUY meridional surface stress kg/m/s^2 T - 841 TBOT atmospheric air temperature (downscaled to columns in glacier regions) K T - 842 TBUILD internal urban building air temperature K T - 843 TBUILD_MAX prescribed maximum interior building temperature K F - 844 TFLOOR floor temperature K F - 845 TG ground temperature K T - 846 TG_ICE ground temperature (ice landunits only) K F - 847 TG_R Rural ground temperature K F - 848 TG_U Urban ground temperature K F - 849 TH2OSFC surface water temperature K T - 850 THBOT atmospheric air potential temperature (downscaled to columns in glacier regions) K T - 851 TKE1 top lake level eddy thermal conductivity W/(mK) T - 852 TLAI total projected leaf area index m^2/m^2 T - 853 TLAKE lake temperature K T - 854 TOPO_COL column-level topographic height m F - 855 TOPO_COL_ICE column-level topographic height (ice landunits only) m F - 856 TOPO_FORC topograephic height sent to GLC m F - 857 TOTCOLCH4 total belowground CH4 (0 for non-lake special landunits in the absence of dynamic landunits) gC/m2 T - 858 TOTLITC total litter carbon gC/m^2 T - 859 TOTLITC_1m total litter carbon to 1 meter depth gC/m^2 T - 860 TOTLITN total litter N gN/m^2 T - 861 TOTLITN_1m total litter N to 1 meter gN/m^2 T - 862 TOTSOILICE vertically summed soil cie (veg landunits only) kg/m2 T - 863 TOTSOILLIQ vertically summed soil liquid water (veg landunits only) kg/m2 T - 864 TOTSOMC total soil organic matter carbon gC/m^2 T - 865 TOTSOMC_1m total soil organic matter carbon to 1 meter depth gC/m^2 T - 866 TOTSOMN total soil organic matter N gN/m^2 T - 867 TOTSOMN_1m total soil organic matter N to 1 meter gN/m^2 T - 868 TOTVEGC Total carbon in live plants kgC ha-1 T - 869 TOTVEGC_SCPF total vegetation carbon mass in live plants by size-class x pft kgC/ha F - 870 TRAFFICFLUX sensible heat flux from urban traffic W/m^2 F - 871 TREFMNAV daily minimum of average 2-m temperature K T - 872 TREFMNAV_R Rural daily minimum of average 2-m temperature K F - 873 TREFMNAV_U Urban daily minimum of average 2-m temperature K F - 874 TREFMXAV daily maximum of average 2-m temperature K T - 875 TREFMXAV_R Rural daily maximum of average 2-m temperature K F - 876 TREFMXAV_U Urban daily maximum of average 2-m temperature K F - 877 TRIMMING Degree to which canopy expansion is limited by leaf economics none T - 878 TRIMMING_CANOPY_SCLS trimming term of canopy plants by size class indiv/ha F - 879 TRIMMING_UNDERSTORY_SCLS trimming term of understory plants by size class indiv/ha F - 880 TROOF_INNER roof inside surface temperature K F - 881 TSA 2m air temperature K T - 882 TSAI total projected stem area index m^2/m^2 T - 883 TSA_ICE 2m air temperature (ice landunits only) K F - 884 TSA_R Rural 2m air temperature K F - 885 TSA_U Urban 2m air temperature K F - 886 TSHDW_INNER shadewall inside surface temperature K F - 887 TSKIN skin temperature K T - 888 TSL temperature of near-surface soil layer (natural vegetated and crop landunits only) K T - 889 TSOI soil temperature (natural vegetated and crop landunits only) K T - 890 TSOI_10CM soil temperature in top 10cm of soil K T - 891 TSOI_ICE soil temperature (ice landunits only) K T - 892 TSRF_FORC surface temperature sent to GLC K F - 893 TSUNW_INNER sunwall inside surface temperature K F - 894 TV vegetation temperature K T - 895 TV24 vegetation temperature (last 24hrs) K F - 896 TV240 vegetation temperature (last 240hrs) K F - 897 TWS total water storage mm T - 898 T_SCALAR temperature inhibition of decomposition unitless T - 899 Tair atmospheric air temperature (downscaled to columns in glacier regions) K F - 900 Tair_from_atm atmospheric air temperature received from atmosphere (pre-downscaling) K F - 901 U10 10-m wind m/s T - 902 U10_DUST 10-m wind for dust model m/s T - 903 U10_ICE 10-m wind (ice landunits only) m/s F - 904 UAF canopy air speed m/s F - 905 UM wind speed plus stability effect m/s F - 906 URBAN_AC urban air conditioning flux W/m^2 T - 907 URBAN_HEAT urban heating flux W/m^2 T - 908 USTAR aerodynamical resistance s/m F - 909 UST_LAKE friction velocity (lakes only) m/s F - 910 VA atmospheric wind speed plus convective velocity m/s F - 911 VOLR river channel total water storage m3 T - 912 VOLRMCH river channel main channel water storage m3 T - 913 VPD vpd Pa F - 914 VPD2M 2m vapor pressure deficit Pa T - 915 VPD_CAN canopy vapor pressure deficit kPa T - 916 WASTEHEAT sensible heat flux from heating/cooling sources of urban waste heat W/m^2 T - 917 WBT 2 m Stull Wet Bulb C T - 918 WBT_R Rural 2 m Stull Wet Bulb C T - 919 WBT_U Urban 2 m Stull Wet Bulb C T - 920 WIND atmospheric wind velocity magnitude m/s T - 921 WOOD_PRODUCT Total wood product from logging gC/m2 F - 922 WTGQ surface tracer conductance m/s T - 923 W_SCALAR Moisture (dryness) inhibition of decomposition unitless T - 924 Wind atmospheric wind velocity magnitude m/s F - 925 YESTERDAYCANLEV_CANOPY_SCLS Yesterdays canopy level for canopy plants by size class indiv/ha F - 926 YESTERDAYCANLEV_UNDERSTORY_SCLS Yesterdays canopy level for understory plants by size class indiv/ha F - 927 Z0HG roughness length over ground, sensible heat m F - 928 Z0M momentum roughness length m F - 929 Z0MG roughness length over ground, momentum m F - 930 Z0M_TO_COUPLER roughness length, momentum: gridcell average sent to coupler m F - 931 Z0QG roughness length over ground, latent heat m F - 932 ZBOT atmospheric reference height m T - 933 ZETA dimensionless stability parameter unitless F - 934 ZII convective boundary height m F - 935 ZSTAR_BY_AGE product of zstar and patch area by age bin (divide by PATCH_AREA_BY_AGE to get mean zstar) m F - 936 ZWT water table depth (natural vegetated and crop landunits only) m T - 937 ZWT_CH4_UNSAT depth of water table for methane production used in non-inundated area m T - 938 ZWT_PERCH perched water table depth (natural vegetated and crop landunits only) m T - 939 num_iter number of iterations unitless F +A5TMIN 5-day running mean of min 2-m temperature K F +ACTUAL_IMMOB actual N immobilization gN/m^2/s T +ACT_SOMC ACT_SOM C gC/m^2 T +ACT_SOMC_1m ACT_SOM C to 1 meter gC/m^2 F +ACT_SOMC_TNDNCY_VERT_TRA active soil organic C tendency due to vertical transport gC/m^3/s F +ACT_SOMC_TO_PAS_SOMC decomp. of active soil organic C to passive soil organic C gC/m^2/s F +ACT_SOMC_TO_PAS_SOMC_vr decomp. of active soil organic C to passive soil organic C gC/m^3/s F +ACT_SOMC_TO_SLO_SOMC decomp. of active soil organic C to slow soil organic ma C gC/m^2/s F +ACT_SOMC_TO_SLO_SOMC_vr decomp. of active soil organic C to slow soil organic ma C gC/m^3/s F +ACT_SOMC_vr ACT_SOM C (vertically resolved) gC/m^3 T +ACT_SOMN ACT_SOM N gN/m^2 T +ACT_SOMN_1m ACT_SOM N to 1 meter gN/m^2 F +ACT_SOMN_TNDNCY_VERT_TRA active soil organic N tendency due to vertical transport gN/m^3/s F +ACT_SOMN_TO_PAS_SOMN decomp. of active soil organic N to passive soil organic N gN/m^2 F +ACT_SOMN_TO_PAS_SOMN_vr decomp. of active soil organic N to passive soil organic N gN/m^3 F +ACT_SOMN_TO_SLO_SOMN decomp. of active soil organic N to slow soil organic ma N gN/m^2 F +ACT_SOMN_TO_SLO_SOMN_vr decomp. of active soil organic N to slow soil organic ma N gN/m^3 F +ACT_SOMN_vr ACT_SOM N (vertically resolved) gN/m^3 T +ACT_SOM_HR_S2 Het. Resp. from active soil organic gC/m^2/s F +ACT_SOM_HR_S2_vr Het. Resp. from active soil organic gC/m^3/s F +ACT_SOM_HR_S3 Het. Resp. from active soil organic gC/m^2/s F +ACT_SOM_HR_S3_vr Het. Resp. from active soil organic gC/m^3/s F +AGB Aboveground biomass gC m-2 T +AGB_SCLS Aboveground biomass by size class kgC/m2 T +AGB_SCPF Aboveground biomass by pft/size kgC/m2 F +AGLB Aboveground leaf biomass kg/m^2 F +AGSB Aboveground stem biomass kg/m^2 F +ALBD surface albedo (direct) proportion F +ALBGRD ground albedo (direct) proportion F +ALBGRI ground albedo (indirect) proportion F +ALBI surface albedo (indirect) proportion F +ALT current active layer thickness m F +ALTMAX maximum annual active layer thickness m F +ALTMAX_LASTYEAR maximum prior year active layer thickness m F +AR autotrophic respiration gC/m^2/s T +AREA_BURNT_BY_PATCH_AGE spitfire area burnt by patch age (divide by patch_area_by_age to get burnt fraction by age) m2/m2/day T +AREA_PLANT area occupied by all plants m2/m2 T +AREA_TREES area occupied by woody plants m2/m2 T +AR_AGSAPM_SCPF above-ground sapwood maintenance autotrophic respiration per m2 per year by pft/size kgC/m2/yr F +AR_CANOPY autotrophic respiration of canopy plants gC/m^2/s T +AR_CANOPY_SCPF autotrophic respiration of canopy plants by pft/size kgC/m2/yr F +AR_CROOTM_SCPF below-ground sapwood maintenance autotrophic respiration per m2 per year by pft/size kgC/m2/yr F +AR_DARKM_SCPF dark portion of maintenance autotrophic respiration per m2 per year by pft/size kgC/m2/yr F +AR_FROOTM_SCPF fine root maintenance autotrophic respiration per m2 per year by pft/size kgC/m2/yr F +AR_GROW_SCPF growth autotrophic respiration per m2 per year by pft/size kgC/m2/yr F +AR_MAINT_SCPF maintenance autotrophic respiration per m2 per year by pft/size kgC/m2/yr F +AR_SCPF total autotrophic respiration per m2 per year by pft/size kgC/m2/yr F +AR_UNDERSTORY autotrophic respiration of understory plants gC/m^2/s T +AR_UNDERSTORY_SCPF autotrophic respiration of understory plants by pft/size kgC/m2/yr F +ATM_TOPO atmospheric surface height m T +AnnET Annual ET mm/s F +BA_SCLS basal area by size class m2/ha T +BA_SCPF basal area by pft/size m2/ha F +BCDEP total BC deposition (dry+wet) from atmosphere kg/m^2/s T +BDEAD_MD_CANOPY_SCLS BDEAD_MD for canopy plants by size class kg C / ha / yr F +BDEAD_MD_UNDERSTORY_SCLS BDEAD_MD for understory plants by size class kg C / ha / yr F +BIOMASS_AGEPFT biomass per PFT in each age bin kg C / m2 F +BIOMASS_BY_AGE Total Biomass within a given patch age bin kgC/m2 F +BIOMASS_CANOPY Biomass of canopy plants gC m-2 T +BIOMASS_SCLS Total biomass by size class kgC/m2 F +BIOMASS_UNDERSTORY Biomass of understory plants gC m-2 T +BLEAF_CANOPY_SCPF biomass carbon in leaf of canopy plants by pft/size kgC/ha F +BLEAF_UNDERSTORY_SCPF biomass carbon in leaf of understory plants by pft/size kgC/ha F +BSTORE_MD_CANOPY_SCLS BSTORE_MD for canopy plants by size class kg C / ha / yr F +BSTORE_MD_UNDERSTORY_SCLS BSTORE_MD for understory plants by size class kg C / ha / yr F +BSTOR_CANOPY_SCPF biomass carbon in storage pools of canopy plants by pft/size kgC/ha F +BSTOR_UNDERSTORY_SCPF biomass carbon in storage pools of understory plants by pft/size kgC/ha F +BSW_MD_CANOPY_SCLS BSW_MD for canopy plants by size class kg C / ha / yr F +BSW_MD_UNDERSTORY_SCLS BSW_MD for understory plants by size class kg C / ha / yr F +BTRAN transpiration beta factor unitless T +BTRANMN daily minimum of transpiration beta factor unitless T +BURNT_LITTER_FRAC_AREA_PRODUCT product of fraction of fuel burnt and burned area (divide by FIRE_AREA to get burned-area-weig fraction T +C13disc_SCPF C13 discrimination by pft/size per mil F +CAMBIALFIREMORT_SCPF cambial fire mortality by pft/size N/ha/yr F +CANOPY_AREA_BY_AGE canopy area by age bin m2/m2 T +CANOPY_HEIGHT_DIST canopy height distribution m2/m2 T +CANOPY_SPREAD Scaling factor between tree basal area and canopy area 0-1 T +CARBON_BALANCE_CANOPY_SCLS CARBON_BALANCE for canopy plants by size class kg C / ha / yr F +CARBON_BALANCE_UNDERSTORY_SCLS CARBON_BALANCE for understory plants by size class kg C / ha / yr F +CBALANCE_ERROR_FATES total carbon error, FATES mgC/day T +CEFFLUX carbon efflux, root to soil kgC/ha/day T +CEFFLUX_SCPF carbon efflux, root to soil, by size-class x pft kg/ha/day F +CEL_LITC CEL_LIT C gC/m^2 T +CEL_LITC_1m CEL_LIT C to 1 meter gC/m^2 F +CEL_LITC_TNDNCY_VERT_TRA cellulosic litter C tendency due to vertical transport gC/m^3/s F +CEL_LITC_TO_ACT_SOMC decomp. of cellulosic litter C to active soil organic C gC/m^2/s F +CEL_LITC_TO_ACT_SOMC_vr decomp. of cellulosic litter C to active soil organic C gC/m^3/s F +CEL_LITC_vr CEL_LIT C (vertically resolved) gC/m^3 T +CEL_LITN CEL_LIT N gN/m^2 T +CEL_LITN_1m CEL_LIT N to 1 meter gN/m^2 F +CEL_LITN_TNDNCY_VERT_TRA cellulosic litter N tendency due to vertical transport gN/m^3/s F +CEL_LITN_TO_ACT_SOMN decomp. of cellulosic litter N to active soil organic N gN/m^2 F +CEL_LITN_TO_ACT_SOMN_vr decomp. of cellulosic litter N to active soil organic N gN/m^3 F +CEL_LITN_vr CEL_LIT N (vertically resolved) gN/m^3 T +CEL_LIT_HR Het. Resp. from cellulosic litter gC/m^2/s F +CEL_LIT_HR_vr Het. Resp. from cellulosic litter gC/m^3/s F +CH4PROD Gridcell total production of CH4 gC/m2/s T +CH4_EBUL_TOTAL_SAT ebullition surface CH4 flux; (+ to atm) mol/m2/s F +CH4_EBUL_TOTAL_UNSAT ebullition surface CH4 flux; (+ to atm) mol/m2/s F +CH4_SURF_AERE_SAT aerenchyma surface CH4 flux for inundated area; (+ to atm) mol/m2/s T +CH4_SURF_AERE_UNSAT aerenchyma surface CH4 flux for non-inundated area; (+ to atm) mol/m2/s T +CH4_SURF_DIFF_SAT diffusive surface CH4 flux for inundated / lake area; (+ to atm) mol/m2/s T +CH4_SURF_DIFF_UNSAT diffusive surface CH4 flux for non-inundated area; (+ to atm) mol/m2/s T +CH4_SURF_EBUL_SAT ebullition surface CH4 flux for inundated / lake area; (+ to atm) mol/m2/s T +CH4_SURF_EBUL_UNSAT ebullition surface CH4 flux for non-inundated area; (+ to atm) mol/m2/s T +COL_CTRUNC column-level sink for C truncation gC/m^2 F +COL_NTRUNC column-level sink for N truncation gN/m^2 F +CONC_CH4_SAT CH4 soil Concentration for inundated / lake area mol/m3 F +CONC_CH4_UNSAT CH4 soil Concentration for non-inundated area mol/m3 F +CONC_O2_SAT O2 soil Concentration for inundated / lake area mol/m3 T +CONC_O2_UNSAT O2 soil Concentration for non-inundated area mol/m3 T +COSZEN cosine of solar zenith angle none F +CROWNAREA_CAN total crown area in each canopy layer m2/m2 T +CROWNAREA_CNLF total crown area that is occupied by leaves in each canopy and leaf layer m2/m2 F +CROWNFIREMORT_SCPF crown fire mortality by pft/size N/ha/yr F +CROWN_AREA_CANOPY_SCLS total crown area of canopy plants by size class m2/ha F +CROWN_AREA_UNDERSTORY_SCLS total crown area of understory plants by size class m2/ha F +CWDC_HR cwd C heterotrophic respiration gC/m^2/s F +CWD_AG_CWDSC size-resolved AG CWD stocks gC/m^2 F +CWD_AG_IN_CWDSC size-resolved AG CWD input gC/m^2/y F +CWD_AG_OUT_CWDSC size-resolved AG CWD output gC/m^2/y F +CWD_BG_CWDSC size-resolved BG CWD stocks gC/m^2 F +CWD_BG_IN_CWDSC size-resolved BG CWD input gC/m^2/y F +CWD_BG_OUT_CWDSC size-resolved BG CWD output gC/m^2/y F +C_LBLAYER mean leaf boundary layer conductance umol m-2 s-1 T +C_LBLAYER_BY_AGE mean leaf boundary layer conductance - by patch age umol m-2 s-1 F +C_STOMATA mean stomatal conductance umol m-2 s-1 T +C_STOMATA_BY_AGE mean stomatal conductance - by patch age umol m-2 s-1 F +DDBH_CANOPY_SCAG growth rate of canopy plantsnumber of plants per hectare in canopy in each size x age class cm/yr/ha F +DDBH_CANOPY_SCLS diameter growth increment by pft/size cm/yr/ha T +DDBH_CANOPY_SCPF diameter growth increment by pft/size cm/yr/ha F +DDBH_SCPF diameter growth increment by pft/size cm/yr/ha F +DDBH_UNDERSTORY_SCAG growth rate of understory plants in each size x age class cm/yr/ha F +DDBH_UNDERSTORY_SCLS diameter growth increment by pft/size cm/yr/ha T +DDBH_UNDERSTORY_SCPF diameter growth increment by pft/size cm/yr/ha F +DEMOTION_CARBONFLUX demotion-associated biomass carbon flux from canopy to understory gC/m2/s T +DEMOTION_RATE_SCLS demotion rate from canopy to understory by size class indiv/ha/yr F +DENIT total rate of denitrification gN/m^2/s T +DGNETDT derivative of net ground heat flux wrt soil temp W/m^2/K F +DISPLA displacement height m F +DISTURBANCE_RATE_FIRE Disturbance rate from fire m2 m-2 d-1 T +DISTURBANCE_RATE_LOGGING Disturbance rate from logging m2 m-2 d-1 T +DISTURBANCE_RATE_P2P Disturbance rate from primary to primary lands m2 m-2 d-1 T +DISTURBANCE_RATE_P2S Disturbance rate from primary to secondary lands m2 m-2 d-1 T +DISTURBANCE_RATE_POTENTIAL Potential (i.e., including unresolved) disturbance rate m2 m-2 d-1 T +DISTURBANCE_RATE_S2S Disturbance rate from secondary to secondary lands m2 m-2 d-1 T +DISTURBANCE_RATE_TREEFALL Disturbance rate from treefall m2 m-2 d-1 T +DPVLTRB1 turbulent deposition velocity 1 m/s F +DPVLTRB2 turbulent deposition velocity 2 m/s F +DPVLTRB3 turbulent deposition velocity 3 m/s F +DPVLTRB4 turbulent deposition velocity 4 m/s F +DSL dry surface layer thickness mm T +DSTDEP total dust deposition (dry+wet) from atmosphere kg/m^2/s T +DSTFLXT total surface dust emission kg/m2/s T +DYN_COL_ADJUSTMENTS_CH4 Adjustments in ch4 due to dynamic column areas; only makes sense at the column level: should n gC/m^2 F +DYN_COL_SOIL_ADJUSTMENTS_C Adjustments in soil carbon due to dynamic column areas; only makes sense at the column level: gC/m^2 F +DYN_COL_SOIL_ADJUSTMENTS_N Adjustments in soil nitrogen due to dynamic column areas; only makes sense at the column level gN/m^2 F +ED_NCOHORTS Total number of ED cohorts per site none T +ED_NPATCHES Total number of ED patches per site none T +ED_balive Live biomass gC m-2 T +ED_bdead Dead (structural) biomass (live trees, not CWD) gC m-2 T +ED_bfineroot Fine root biomass gC m-2 T +ED_biomass Total biomass gC m-2 T +ED_bleaf Leaf biomass gC m-2 T +ED_bsapwood Sapwood biomass gC m-2 T +ED_bstore Storage biomass gC m-2 T +EFFECT_WSPEED effective windspeed for fire spread none T +EFLXBUILD building heat flux from change in interior building air temperature W/m^2 T +EFLX_DYNBAL dynamic land cover change conversion energy flux W/m^2 T +EFLX_GNET net heat flux into ground W/m^2 F +EFLX_GRND_LAKE net heat flux into lake/snow surface, excluding light transmission W/m^2 T +EFLX_LH_TOT total latent heat flux [+ to atm] W/m^2 T +EFLX_LH_TOT_ICE total latent heat flux [+ to atm] (ice landunits only) W/m^2 F +EFLX_LH_TOT_R Rural total evaporation W/m^2 T +EFLX_LH_TOT_U Urban total evaporation W/m^2 F +EFLX_SOIL_GRND soil heat flux [+ into soil] W/m^2 F +ELAI exposed one-sided leaf area index m^2/m^2 T +ERRH2O total water conservation error mm T +ERRH2OSNO imbalance in snow depth (liquid water) mm T +ERROR_FATES total error, FATES mass-balance mg/day T +ERRSEB surface energy conservation error W/m^2 T +ERRSOI soil/lake energy conservation error W/m^2 T +ERRSOL solar radiation conservation error W/m^2 T +ESAI exposed one-sided stem area index m^2/m^2 T +FABD_SHA_CNLF shade fraction of direct light absorbed by each canopy and leaf layer fraction F +FABD_SHA_CNLFPFT shade fraction of direct light absorbed by each canopy, leaf, and PFT fraction F +FABD_SHA_TOPLF_BYCANLAYER shade fraction of direct light absorbed by the top leaf layer of each canopy layer fraction F +FABD_SUN_CNLF sun fraction of direct light absorbed by each canopy and leaf layer fraction F +FABD_SUN_CNLFPFT sun fraction of direct light absorbed by each canopy, leaf, and PFT fraction F +FABD_SUN_TOPLF_BYCANLAYER sun fraction of direct light absorbed by the top leaf layer of each canopy layer fraction F +FABI_SHA_CNLF shade fraction of indirect light absorbed by each canopy and leaf layer fraction F +FABI_SHA_CNLFPFT shade fraction of indirect light absorbed by each canopy, leaf, and PFT fraction F +FABI_SHA_TOPLF_BYCANLAYER shade fraction of indirect light absorbed by the top leaf layer of each canopy layer fraction F +FABI_SUN_CNLF sun fraction of indirect light absorbed by each canopy and leaf layer fraction F +FABI_SUN_CNLFPFT sun fraction of indirect light absorbed by each canopy, leaf, and PFT fraction F +FABI_SUN_TOPLF_BYCANLAYER sun fraction of indirect light absorbed by the top leaf layer of each canopy layer fraction F +FATES_HR heterotrophic respiration gC/m^2/s T +FATES_c_to_litr_cel_c litter celluluse carbon flux from FATES to BGC gC/m^3/s T +FATES_c_to_litr_lab_c litter labile carbon flux from FATES to BGC gC/m^3/s T +FATES_c_to_litr_lig_c litter lignin carbon flux from FATES to BGC gC/m^3/s T +FCEV canopy evaporation W/m^2 T +FCH4 Gridcell surface CH4 flux to atmosphere (+ to atm) kgC/m2/s T +FCH4TOCO2 Gridcell oxidation of CH4 to CO2 gC/m2/s T +FCH4_DFSAT CH4 additional flux due to changing fsat, natural vegetated and crop landunits only kgC/m2/s T +FCO2 CO2 flux to atmosphere (+ to atm) kgCO2/m2/s F +FCOV fractional impermeable area unitless T +FCTR canopy transpiration W/m^2 T +FGEV ground evaporation W/m^2 T +FGR heat flux into soil/snow including snow melt and lake / snow light transmission W/m^2 T +FGR12 heat flux between soil layers 1 and 2 W/m^2 T +FGR_ICE heat flux into soil/snow including snow melt and lake / snow light transmission (ice landunits W/m^2 F +FGR_R Rural heat flux into soil/snow including snow melt and snow light transmission W/m^2 F +FGR_SOIL_R Rural downward heat flux at interface below each soil layer watt/m^2 F +FGR_U Urban heat flux into soil/snow including snow melt W/m^2 F +FH2OSFC fraction of ground covered by surface water unitless T +FH2OSFC_NOSNOW fraction of ground covered by surface water (if no snow present) unitless F +FINUNDATED fractional inundated area of vegetated columns unitless T +FINUNDATED_LAG time-lagged inundated fraction of vegetated columns unitless F +FIRA net infrared (longwave) radiation W/m^2 T +FIRA_ICE net infrared (longwave) radiation (ice landunits only) W/m^2 F +FIRA_R Rural net infrared (longwave) radiation W/m^2 T +FIRA_U Urban net infrared (longwave) radiation W/m^2 F +FIRE emitted infrared (longwave) radiation W/m^2 T +FIRE_AREA spitfire fire area burn fraction fraction/day T +FIRE_FDI probability that an ignition will lead to a fire none T +FIRE_FLUX ED-spitfire loss to atmosphere of elements g/m^2/s T +FIRE_FUEL_BULKD spitfire fuel bulk density kg biomass/m3 T +FIRE_FUEL_EFF_MOIST spitfire fuel moisture m T +FIRE_FUEL_MEF spitfire fuel moisture m T +FIRE_FUEL_SAV spitfire fuel surface/volume per m T +FIRE_ICE emitted infrared (longwave) radiation (ice landunits only) W/m^2 F +FIRE_IGNITIONS number of successful ignitions number/km2/day T +FIRE_INTENSITY spitfire fire intensity: kJ/m/s kJ/m/s T +FIRE_INTENSITY_AREA_PRODUCT spitfire product of fire intensity and burned area (divide by FIRE_AREA to get area-weighted m kJ/m/s T +FIRE_INTENSITY_BY_PATCH_AGE product of fire intensity and burned area, resolved by patch age (so divide by AREA_BURNT_BY_P kJ/m/2 T +FIRE_NESTEROV_INDEX nesterov_fire_danger index none T +FIRE_R Rural emitted infrared (longwave) radiation W/m^2 T +FIRE_ROS fire rate of spread m/min m/min T +FIRE_ROS_AREA_PRODUCT product of fire rate of spread (m/min) and burned area (fraction)--divide by FIRE_AREA to get m/min T +FIRE_TFC_ROS total fuel consumed kgC/m2 T +FIRE_TFC_ROS_AREA_PRODUCT product of total fuel consumed and burned area--divide by FIRE_AREA to get burned-area-weighte kgC/m2 T +FIRE_U Urban emitted infrared (longwave) radiation W/m^2 F +FLDS atmospheric longwave radiation (downscaled to columns in glacier regions) W/m^2 T +FLDS_ICE atmospheric longwave radiation (downscaled to columns in glacier regions) (ice landunits only) W/m^2 F +FNRTC Total carbon in live plant fine-roots kgC ha-1 T +FNRTC_SCPF fine-root carbon mass by size-class x pft kgC/ha F +FRAGMENTATION_SCALER_SL factor by which litter/cwd fragmentation proceeds relative to max rate by soil layer unitless (0-1) T +FROOT_MR fine root maintenance respiration) kg C / m2 / yr T +FROOT_MR_CANOPY_SCLS FROOT_MR for canopy plants by size class kg C / ha / yr F +FROOT_MR_UNDERSTORY_SCLS FROOT_MR for understory plants by size class kg C / ha / yr F +FROST_TABLE frost table depth (natural vegetated and crop landunits only) m F +FSA absorbed solar radiation W/m^2 T +FSAT fractional area with water table at surface unitless T +FSA_ICE absorbed solar radiation (ice landunits only) W/m^2 F +FSA_R Rural absorbed solar radiation W/m^2 F +FSA_U Urban absorbed solar radiation W/m^2 F +FSD24 direct radiation (last 24hrs) K F +FSD240 direct radiation (last 240hrs) K F +FSDS atmospheric incident solar radiation W/m^2 T +FSDSND direct nir incident solar radiation W/m^2 T +FSDSNDLN direct nir incident solar radiation at local noon W/m^2 T +FSDSNI diffuse nir incident solar radiation W/m^2 T +FSDSVD direct vis incident solar radiation W/m^2 T +FSDSVDLN direct vis incident solar radiation at local noon W/m^2 T +FSDSVI diffuse vis incident solar radiation W/m^2 T +FSDSVILN diffuse vis incident solar radiation at local noon W/m^2 T +FSH sensible heat not including correction for land use change and rain/snow conversion W/m^2 T +FSH_G sensible heat from ground W/m^2 T +FSH_ICE sensible heat not including correction for land use change and rain/snow conversion (ice landu W/m^2 F +FSH_PRECIP_CONVERSION Sensible heat flux from conversion of rain/snow atm forcing W/m^2 T +FSH_R Rural sensible heat W/m^2 T +FSH_RUNOFF_ICE_TO_LIQ sensible heat flux generated from conversion of ice runoff to liquid W/m^2 T +FSH_TO_COUPLER sensible heat sent to coupler (includes corrections for land use change, rain/snow conversion W/m^2 T +FSH_U Urban sensible heat W/m^2 F +FSH_V sensible heat from veg W/m^2 T +FSI24 indirect radiation (last 24hrs) K F +FSI240 indirect radiation (last 240hrs) K F +FSM snow melt heat flux W/m^2 T +FSM_ICE snow melt heat flux (ice landunits only) W/m^2 F +FSM_R Rural snow melt heat flux W/m^2 F +FSM_U Urban snow melt heat flux W/m^2 F +FSNO fraction of ground covered by snow unitless T +FSNO_EFF effective fraction of ground covered by snow unitless T +FSNO_ICE fraction of ground covered by snow (ice landunits only) unitless F +FSR reflected solar radiation W/m^2 T +FSRND direct nir reflected solar radiation W/m^2 T +FSRNDLN direct nir reflected solar radiation at local noon W/m^2 T +FSRNI diffuse nir reflected solar radiation W/m^2 T +FSRVD direct vis reflected solar radiation W/m^2 T +FSRVDLN direct vis reflected solar radiation at local noon W/m^2 T +FSRVI diffuse vis reflected solar radiation W/m^2 T +FSR_ICE reflected solar radiation (ice landunits only) W/m^2 F +FSUN sunlit fraction of canopy proportion F +FSUN24 fraction sunlit (last 24hrs) K F +FSUN240 fraction sunlit (last 240hrs) K F +FUEL_AMOUNT_AGEFUEL spitfire fuel quantity in each age x fuel class kg C / m2 T +FUEL_AMOUNT_BY_NFSC spitfire size-resolved fuel quantity kg C / m2 T +FUEL_MOISTURE_NFSC spitfire size-resolved fuel moisture - T +Fire_Closs ED/SPitfire Carbon loss to atmosphere gC/m^2/s T +GPP gross primary production gC/m^2/s T +GPP_BY_AGE gross primary productivity by age bin gC/m^2/s F +GPP_CANOPY gross primary production of canopy plants gC/m^2/s T +GPP_CANOPY_SCPF gross primary production of canopy plants by pft/size kgC/m2/yr F +GPP_SCPF gross primary production by pft/size kgC/m2/yr F +GPP_UNDERSTORY gross primary production of understory plants gC/m^2/s T +GPP_UNDERSTORY_SCPF gross primary production of understory plants by pft/size kgC/m2/yr F +GROSS_NMIN gross rate of N mineralization gN/m^2/s T +GROWTHFLUX_FUSION_SCPF flux of individuals into a given size class bin via fusion n/yr/ha F +GROWTHFLUX_SCPF flux of individuals into a given size class bin via growth and recruitment n/yr/ha F +GROWTH_RESP growth respiration gC/m^2/s T +GSSHA shaded leaf stomatal conductance umol H20/m2/s T +GSSHALN shaded leaf stomatal conductance at local noon umol H20/m2/s T +GSSUN sunlit leaf stomatal conductance umol H20/m2/s T +GSSUNLN sunlit leaf stomatal conductance at local noon umol H20/m2/s T +H2OCAN intercepted water mm T +H2OSFC surface water depth mm T +H2OSNO snow depth (liquid water) mm T +H2OSNO_ICE snow depth (liquid water, ice landunits only) mm F +H2OSNO_TOP mass of snow in top snow layer kg/m2 T +H2OSOI volumetric soil water (natural vegetated and crop landunits only) mm3/mm3 T +HARVEST_CARBON_FLUX Harvest carbon flux kg C m-2 d-1 T +HBOT canopy bottom m F +HEAT_CONTENT1 initial gridcell total heat content J/m^2 T +HEAT_CONTENT1_VEG initial gridcell total heat content - natural vegetated and crop landunits only J/m^2 F +HEAT_CONTENT2 post land cover change total heat content J/m^2 F +HEAT_FROM_AC sensible heat flux put into canyon due to heat removed from air conditioning W/m^2 T +HIA 2 m NWS Heat Index C T +HIA_R Rural 2 m NWS Heat Index C T +HIA_U Urban 2 m NWS Heat Index C T +HK hydraulic conductivity (natural vegetated and crop landunits only) mm/s F +HR total heterotrophic respiration gC/m^2/s T +HR_vr total vertically resolved heterotrophic respiration gC/m^3/s T +HTOP canopy top m T +HUMIDEX 2 m Humidex C T +HUMIDEX_R Rural 2 m Humidex C T +HUMIDEX_U Urban 2 m Humidex C T +ICE_CONTENT1 initial gridcell total ice content mm T +ICE_CONTENT2 post land cover change total ice content mm F +ICE_MODEL_FRACTION Ice sheet model fractional coverage unitless F +INT_SNOW accumulated swe (natural vegetated and crop landunits only) mm F +INT_SNOW_ICE accumulated swe (ice landunits only) mm F +IWUELN local noon intrinsic water use efficiency umolCO2/molH2O T +KROOT root conductance each soil layer 1/s F +KSOIL soil conductance in each soil layer 1/s F +K_ACT_SOM active soil organic potential loss coefficient 1/s F +K_CEL_LIT cellulosic litter potential loss coefficient 1/s F +K_LIG_LIT lignin litter potential loss coefficient 1/s F +K_MET_LIT metabolic litter potential loss coefficient 1/s F +K_PAS_SOM passive soil organic potential loss coefficient 1/s F +K_SLO_SOM slow soil organic ma potential loss coefficient 1/s F +LAI240 240hr average of leaf area index m^2/m^2 F +LAISHA shaded projected leaf area index m^2/m^2 T +LAISHA_TOP_CAN LAI in the shade by the top leaf layer of each canopy layer m2/m2 F +LAISHA_Z_CNLF LAI in the shade by each canopy and leaf layer m2/m2 F +LAISHA_Z_CNLFPFT LAI in the shade by each canopy, leaf, and PFT m2/m2 F +LAISUN sunlit projected leaf area index m^2/m^2 T +LAISUN_TOP_CAN LAI in the sun by the top leaf layer of each canopy layer m2/m2 F +LAISUN_Z_CNLF LAI in the sun by each canopy and leaf layer m2/m2 F +LAISUN_Z_CNLFPFT LAI in the sun by each canopy, leaf, and PFT m2/m2 F +LAI_BY_AGE leaf area index by age bin m2/m2 T +LAI_CANOPY_SCLS Leaf are index (LAI) by size class m2/m2 T +LAI_UNDERSTORY_SCLS number of understory plants by size class indiv/ha T +LAKEICEFRAC lake layer ice mass fraction unitless F +LAKEICEFRAC_SURF surface lake layer ice mass fraction unitless T +LAKEICETHICK thickness of lake ice (including physical expansion on freezing) m T +LEAFC Total carbon in live plant leaves kgC ha-1 T +LEAFC_SCPF leaf carbon mass by size-class x pft kgC/ha F +LEAF_HEIGHT_DIST leaf height distribution m2/m2 T +LEAF_MD_CANOPY_SCLS LEAF_MD for canopy plants by size class kg C / ha / yr F +LEAF_MD_UNDERSTORY_SCLS LEAF_MD for understory plants by size class kg C / ha / yr F +LEAF_MR RDARK (leaf maintenance respiration) kg C / m2 / yr T +LIG_LITC LIG_LIT C gC/m^2 T +LIG_LITC_1m LIG_LIT C to 1 meter gC/m^2 F +LIG_LITC_TNDNCY_VERT_TRA lignin litter C tendency due to vertical transport gC/m^3/s F +LIG_LITC_TO_SLO_SOMC decomp. of lignin litter C to slow soil organic ma C gC/m^2/s F +LIG_LITC_TO_SLO_SOMC_vr decomp. of lignin litter C to slow soil organic ma C gC/m^3/s F +LIG_LITC_vr LIG_LIT C (vertically resolved) gC/m^3 T +LIG_LITN LIG_LIT N gN/m^2 T +LIG_LITN_1m LIG_LIT N to 1 meter gN/m^2 F +LIG_LITN_TNDNCY_VERT_TRA lignin litter N tendency due to vertical transport gN/m^3/s F +LIG_LITN_TO_SLO_SOMN decomp. of lignin litter N to slow soil organic ma N gN/m^2 F +LIG_LITN_TO_SLO_SOMN_vr decomp. of lignin litter N to slow soil organic ma N gN/m^3 F +LIG_LITN_vr LIG_LIT N (vertically resolved) gN/m^3 T +LIG_LIT_HR Het. Resp. from lignin litter gC/m^2/s F +LIG_LIT_HR_vr Het. Resp. from lignin litter gC/m^3/s F +LIQCAN intercepted liquid water mm T +LIQUID_CONTENT1 initial gridcell total liq content mm T +LIQUID_CONTENT2 post landuse change gridcell total liq content mm F +LIQUID_WATER_TEMP1 initial gridcell weighted average liquid water temperature K F +LITTERC_HR litter C heterotrophic respiration gC/m^2/s T +LITTER_CWD total mass of litter in CWD kg ha-1 T +LITTER_CWD_AG_ELEM mass of above ground litter in CWD (trunks/branches/twigs) kg ha-1 T +LITTER_CWD_BG_ELEM mass of below ground litter in CWD (coarse roots) kg ha-1 T +LITTER_FINES_AG_ELEM mass of above ground litter in fines (leaves,nonviable seed) kg ha-1 T +LITTER_FINES_BG_ELEM mass of below ground litter in fines (fineroots) kg ha-1 T +LITTER_IN FATES litter flux in gC m-2 s-1 T +LITTER_IN_ELEM FATES litter flux in kg ha-1 d-1 T +LITTER_OUT FATES litter flux out gC m-2 s-1 T +LITTER_OUT_ELEM FATES litter flux out (fragmentation only) kg ha-1 d-1 T +LIVECROOT_MR live coarse root maintenance respiration) kg C / m2 / yr T +LIVECROOT_MR_CANOPY_SCLS LIVECROOT_MR for canopy plants by size class kg C / ha / yr F +LIVECROOT_MR_UNDERSTORY_SCLS LIVECROOT_MR for understory plants by size class kg C / ha / yr F +LIVESTEM_MR live stem maintenance respiration) kg C / m2 / yr T +LIVESTEM_MR_CANOPY_SCLS LIVESTEM_MR for canopy plants by size class kg C / ha / yr F +LIVESTEM_MR_UNDERSTORY_SCLS LIVESTEM_MR for understory plants by size class kg C / ha / yr F +LNC leaf N concentration gN leaf/m^2 T +LWdown atmospheric longwave radiation (downscaled to columns in glacier regions) W/m^2 F +LWup upwelling longwave radiation W/m^2 F +M10_CACLS age senescence mortality by cohort age N/ha/yr T +M10_CAPF age senescence mortality by pft/cohort age N/ha/yr F +M10_SCLS age senescence mortality by size N/ha/yr T +M10_SCPF age senescence mortality by pft/size N/ha/yr F +M1_SCLS background mortality by size N/ha/yr T +M1_SCPF background mortality by pft/size N/ha/yr F +M2_SCLS hydraulic mortality by size N/ha/yr T +M2_SCPF hydraulic mortality by pft/size N/ha/yr F +M3_SCLS carbon starvation mortality by size N/ha/yr T +M3_SCPF carbon starvation mortality by pft/size N/ha/yr F +M4_SCLS impact mortality by size N/ha/yr T +M4_SCPF impact mortality by pft/size N/ha/yr F +M5_SCLS fire mortality by size N/ha/yr T +M5_SCPF fire mortality by pft/size N/ha/yr F +M6_SCLS termination mortality by size N/ha/yr T +M6_SCPF termination mortality by pft/size N/ha/yr F +M7_SCLS logging mortality by size N/ha/event T +M7_SCPF logging mortality by pft/size N/ha/event F +M8_SCLS freezing mortality by size N/ha/event T +M8_SCPF freezing mortality by pft/size N/ha/yr F +M9_SCLS senescence mortality by size N/ha/yr T +M9_SCPF senescence mortality by pft/size N/ha/yr F +MAINT_RESP maintenance respiration gC/m^2/s T +MET_LITC MET_LIT C gC/m^2 T +MET_LITC_1m MET_LIT C to 1 meter gC/m^2 F +MET_LITC_TNDNCY_VERT_TRA metabolic litter C tendency due to vertical transport gC/m^3/s F +MET_LITC_TO_ACT_SOMC decomp. of metabolic litter C to active soil organic C gC/m^2/s F +MET_LITC_TO_ACT_SOMC_vr decomp. of metabolic litter C to active soil organic C gC/m^3/s F +MET_LITC_vr MET_LIT C (vertically resolved) gC/m^3 T +MET_LITN MET_LIT N gN/m^2 T +MET_LITN_1m MET_LIT N to 1 meter gN/m^2 F +MET_LITN_TNDNCY_VERT_TRA metabolic litter N tendency due to vertical transport gN/m^3/s F +MET_LITN_TO_ACT_SOMN decomp. of metabolic litter N to active soil organic N gN/m^2 F +MET_LITN_TO_ACT_SOMN_vr decomp. of metabolic litter N to active soil organic N gN/m^3 F +MET_LITN_vr MET_LIT N (vertically resolved) gN/m^3 T +MET_LIT_HR Het. Resp. from metabolic litter gC/m^2/s F +MET_LIT_HR_vr Het. Resp. from metabolic litter gC/m^3/s F +MORTALITY Rate of total mortality by PFT indiv/ha/yr T +MORTALITY_CANOPY_SCAG mortality rate of canopy plants in each size x age class plants/ha/yr F +MORTALITY_CANOPY_SCLS total mortality of canopy trees by size class indiv/ha/yr T +MORTALITY_CANOPY_SCPF total mortality of canopy plants by pft/size N/ha/yr F +MORTALITY_CARBONFLUX_CANOPY flux of biomass carbon from live to dead pools from mortality of canopy plants gC/m2/s T +MORTALITY_CARBONFLUX_UNDERSTORY flux of biomass carbon from live to dead pools from mortality of understory plants gC/m2/s T +MORTALITY_UNDERSTORY_SCAG mortality rate of understory plantsin each size x age class plants/ha/yr F +MORTALITY_UNDERSTORY_SCLS total mortality of understory trees by size class indiv/ha/yr T +MORTALITY_UNDERSTORY_SCPF total mortality of understory plants by pft/size N/ha/yr F +M_ACT_SOMC_TO_LEACHING active soil organic C leaching loss gC/m^2/s F +M_ACT_SOMN_TO_LEACHING active soil organic N leaching loss gN/m^2/s F +M_CEL_LITC_TO_LEACHING cellulosic litter C leaching loss gC/m^2/s F +M_CEL_LITN_TO_LEACHING cellulosic litter N leaching loss gN/m^2/s F +M_LIG_LITC_TO_LEACHING lignin litter C leaching loss gC/m^2/s F +M_LIG_LITN_TO_LEACHING lignin litter N leaching loss gN/m^2/s F +M_MET_LITC_TO_LEACHING metabolic litter C leaching loss gC/m^2/s F +M_MET_LITN_TO_LEACHING metabolic litter N leaching loss gN/m^2/s F +M_PAS_SOMC_TO_LEACHING passive soil organic C leaching loss gC/m^2/s F +M_PAS_SOMN_TO_LEACHING passive soil organic N leaching loss gN/m^2/s F +M_SLO_SOMC_TO_LEACHING slow soil organic ma C leaching loss gC/m^2/s F +M_SLO_SOMN_TO_LEACHING slow soil organic ma N leaching loss gN/m^2/s F +NCL_BY_AGE number of canopy levels by age bin -- F +NDEP_TO_SMINN atmospheric N deposition to soil mineral N gN/m^2/s T +NEM Gridcell net adjustment to net carbon exchange passed to atm. for methane production gC/m2/s T +NEP net ecosystem production gC/m^2/s T +NET_C_UPTAKE_CNLF net carbon uptake by each canopy and leaf layer per unit ground area (i.e. divide by CROWNAREA gC/m2/s F +NET_NMIN net rate of N mineralization gN/m^2/s T +NFIX_TO_SMINN symbiotic/asymbiotic N fixation to soil mineral N gN/m^2/s T +NPATCH_BY_AGE number of patches by age bin -- F +NPLANT_CACLS number of plants by coage class indiv/ha T +NPLANT_CANOPY_SCAG number of plants per hectare in canopy in each size x age class plants/ha F +NPLANT_CANOPY_SCLS number of canopy plants by size class indiv/ha T +NPLANT_CANOPY_SCPF stem number of canopy plants density by pft/size N/ha F +NPLANT_CAPF stem number density by pft/coage N/ha F +NPLANT_SCAG number of plants per hectare in each size x age class plants/ha T +NPLANT_SCAGPFT number of plants per hectare in each size x age x pft class plants/ha F +NPLANT_SCLS number of plants by size class indiv/ha T +NPLANT_SCPF stem number density by pft/size N/ha F +NPLANT_UNDERSTORY_SCAG number of plants per hectare in understory in each size x age class plants/ha F +NPLANT_UNDERSTORY_SCLS number of understory plants by size class indiv/ha T +NPLANT_UNDERSTORY_SCPF stem number of understory plants density by pft/size N/ha F +NPP net primary production gC/m^2/s T +NPP_AGDW_SCPF NPP flux into above-ground deadwood by pft/size kgC/m2/yr F +NPP_AGEPFT NPP per PFT in each age bin kgC/m2/yr F +NPP_AGSW_SCPF NPP flux into above-ground sapwood by pft/size kgC/m2/yr F +NPP_BDEAD_CANOPY_SCLS NPP_BDEAD for canopy plants by size class kg C / ha / yr F +NPP_BDEAD_UNDERSTORY_SCLS NPP_BDEAD for understory plants by size class kg C / ha / yr F +NPP_BGDW_SCPF NPP flux into below-ground deadwood by pft/size kgC/m2/yr F +NPP_BGSW_SCPF NPP flux into below-ground sapwood by pft/size kgC/m2/yr F +NPP_BSEED_CANOPY_SCLS NPP_BSEED for canopy plants by size class kg C / ha / yr F +NPP_BSEED_UNDERSTORY_SCLS NPP_BSEED for understory plants by size class kg C / ha / yr F +NPP_BSW_CANOPY_SCLS NPP_BSW for canopy plants by size class kg C / ha / yr F +NPP_BSW_UNDERSTORY_SCLS NPP_BSW for understory plants by size class kg C / ha / yr F +NPP_BY_AGE net primary productivity by age bin gC/m^2/s F +NPP_CROOT NPP flux into coarse roots kgC/m2/yr T +NPP_FNRT_SCPF NPP flux into fine roots by pft/size kgC/m2/yr F +NPP_FROOT NPP flux into fine roots kgC/m2/yr T +NPP_FROOT_CANOPY_SCLS NPP_FROOT for canopy plants by size class kg C / ha / yr F +NPP_FROOT_UNDERSTORY_SCLS NPP_FROOT for understory plants by size class kg C / ha / yr F +NPP_LEAF NPP flux into leaves kgC/m2/yr T +NPP_LEAF_CANOPY_SCLS NPP_LEAF for canopy plants by size class kg C / ha / yr F +NPP_LEAF_SCPF NPP flux into leaves by pft/size kgC/m2/yr F +NPP_LEAF_UNDERSTORY_SCLS NPP_LEAF for understory plants by size class kg C / ha / yr F +NPP_SCPF total net primary production by pft/size kgC/m2/yr F +NPP_SEED NPP flux into seeds kgC/m2/yr T +NPP_SEED_SCPF NPP flux into seeds by pft/size kgC/m2/yr F +NPP_STEM NPP flux into stem kgC/m2/yr T +NPP_STOR NPP flux into storage tissues kgC/m2/yr T +NPP_STORE_CANOPY_SCLS NPP_STORE for canopy plants by size class kg C / ha / yr F +NPP_STORE_UNDERSTORY_SCLS NPP_STORE for understory plants by size class kg C / ha / yr F +NPP_STOR_SCPF NPP flux into storage by pft/size kgC/m2/yr F +NSUBSTEPS number of adaptive timesteps in CLM timestep unitless F +O2_DECOMP_DEPTH_UNSAT O2 consumption from HR and AR for non-inundated area mol/m3/s F +OBU Monin-Obukhov length m F +OCDEP total OC deposition (dry+wet) from atmosphere kg/m^2/s T +O_SCALAR fraction by which decomposition is reduced due to anoxia unitless T +PARPROF_DIF_CNLF Radiative profile of diffuse PAR through each canopy and leaf layer (averaged across PFTs) W/m2 F +PARPROF_DIF_CNLFPFT Radiative profile of diffuse PAR through each canopy, leaf, and PFT W/m2 F +PARPROF_DIR_CNLF Radiative profile of direct PAR through each canopy and leaf layer (averaged across PFTs) W/m2 F +PARPROF_DIR_CNLFPFT Radiative profile of direct PAR through each canopy, leaf, and PFT W/m2 F +PARSHA_Z_CAN PAR absorbed in the shade by top leaf layer in each canopy layer W/m2 F +PARSHA_Z_CNLF PAR absorbed in the shade by each canopy and leaf layer W/m2 F +PARSHA_Z_CNLFPFT PAR absorbed in the shade by each canopy, leaf, and PFT W/m2 F +PARSUN_Z_CAN PAR absorbed in the sun by top leaf layer in each canopy layer W/m2 F +PARSUN_Z_CNLF PAR absorbed in the sun by each canopy and leaf layer W/m2 F +PARSUN_Z_CNLFPFT PAR absorbed in the sun by each canopy, leaf, and PFT W/m2 F +PARVEGLN absorbed par by vegetation at local noon W/m^2 T +PAS_SOMC PAS_SOM C gC/m^2 T +PAS_SOMC_1m PAS_SOM C to 1 meter gC/m^2 F +PAS_SOMC_TNDNCY_VERT_TRA passive soil organic C tendency due to vertical transport gC/m^3/s F +PAS_SOMC_TO_ACT_SOMC decomp. of passive soil organic C to active soil organic C gC/m^2/s F +PAS_SOMC_TO_ACT_SOMC_vr decomp. of passive soil organic C to active soil organic C gC/m^3/s F +PAS_SOMC_vr PAS_SOM C (vertically resolved) gC/m^3 T +PAS_SOMN PAS_SOM N gN/m^2 T +PAS_SOMN_1m PAS_SOM N to 1 meter gN/m^2 F +PAS_SOMN_TNDNCY_VERT_TRA passive soil organic N tendency due to vertical transport gN/m^3/s F +PAS_SOMN_TO_ACT_SOMN decomp. of passive soil organic N to active soil organic N gN/m^2 F +PAS_SOMN_TO_ACT_SOMN_vr decomp. of passive soil organic N to active soil organic N gN/m^3 F +PAS_SOMN_vr PAS_SOM N (vertically resolved) gN/m^3 T +PAS_SOM_HR Het. Resp. from passive soil organic gC/m^2/s F +PAS_SOM_HR_vr Het. Resp. from passive soil organic gC/m^3/s F +PATCH_AREA_BY_AGE patch area by age bin m2/m2 T +PBOT atmospheric pressure at surface (downscaled to columns in glacier regions) Pa T +PCH4 atmospheric partial pressure of CH4 Pa T +PCO2 atmospheric partial pressure of CO2 Pa T +PFTbiomass total PFT level biomass gC/m2 T +PFTcanopycrownarea total PFT-level canopy-layer crown area m2/m2 F +PFTcrownarea total PFT level crown area m2/m2 F +PFTgpp total PFT-level GPP kg C m-2 y-1 T +PFTleafbiomass total PFT level leaf biomass gC/m2 T +PFTnindivs total PFT level number of individuals indiv / m2 T +PFTnpp total PFT-level NPP kg C m-2 y-1 T +PFTstorebiomass total PFT level stored biomass gC/m2 T +POTENTIAL_IMMOB potential N immobilization gN/m^2/s T +PRIMARYLAND_PATCHFUSION_ERROR Error in total primary lands associated with patch fusion m2 m-2 d-1 T +PROMOTION_CARBONFLUX promotion-associated biomass carbon flux from understory to canopy gC/m2/s T +PROMOTION_RATE_SCLS promotion rate from understory to canopy by size class indiv/ha/yr F +PSurf atmospheric pressure at surface (downscaled to columns in glacier regions) Pa F +Q2M 2m specific humidity kg/kg T +QAF canopy air humidity kg/kg F +QBOT atmospheric specific humidity (downscaled to columns in glacier regions) kg/kg T +QDIRECT_THROUGHFALL direct throughfall of liquid (rain + above-canopy irrigation) mm/s F +QDIRECT_THROUGHFALL_SNOW direct throughfall of snow mm/s F +QDRAI sub-surface drainage mm/s T +QDRAI_PERCH perched wt drainage mm/s T +QDRAI_XS saturation excess drainage mm/s T +QDRIP rate of excess canopy liquid falling off canopy mm/s F +QDRIP_SNOW rate of excess canopy snow falling off canopy mm/s F +QFLOOD runoff from river flooding mm/s T +QFLX_EVAP_TOT qflx_evap_soi + qflx_evap_can + qflx_tran_veg kg m-2 s-1 T +QFLX_EVAP_VEG vegetation evaporation mm H2O/s F +QFLX_ICE_DYNBAL ice dynamic land cover change conversion runoff flux mm/s T +QFLX_LIQDEW_TO_TOP_LAYER rate of liquid water deposited on top soil or snow layer (dew) mm H2O/s T +QFLX_LIQEVAP_FROM_TOP_LAYER rate of liquid water evaporated from top soil or snow layer mm H2O/s T +QFLX_LIQ_DYNBAL liq dynamic land cover change conversion runoff flux mm/s T +QFLX_LIQ_GRND liquid (rain+irrigation) on ground after interception mm H2O/s F +QFLX_SNOW_DRAIN drainage from snow pack mm/s T +QFLX_SNOW_DRAIN_ICE drainage from snow pack melt (ice landunits only) mm/s T +QFLX_SNOW_GRND snow on ground after interception mm H2O/s F +QFLX_SOLIDDEW_TO_TOP_LAYER rate of solid water deposited on top soil or snow layer (frost) mm H2O/s T +QFLX_SOLIDEVAP_FROM_TOP_LAYER rate of ice evaporated from top soil or snow layer (sublimation) (also includes bare ice subli mm H2O/s T +QFLX_SOLIDEVAP_FROM_TOP_LAYER_ICE rate of ice evaporated from top soil or snow layer (sublimation) (also includes bare ice subli mm H2O/s F +QH2OSFC surface water runoff mm/s T +QH2OSFC_TO_ICE surface water converted to ice mm/s F +QHR hydraulic redistribution mm/s T +QICE ice growth/melt mm/s T +QICE_FORC qice forcing sent to GLC mm/s F +QICE_FRZ ice growth mm/s T +QICE_MELT ice melt mm/s T +QINFL infiltration mm/s T +QINTR interception mm/s T +QIRRIG_DEMAND irrigation demand mm/s F +QIRRIG_DRIP water added via drip irrigation mm/s F +QIRRIG_FROM_GW_CONFINED water added through confined groundwater irrigation mm/s T +QIRRIG_FROM_GW_UNCONFINED water added through unconfined groundwater irrigation mm/s T +QIRRIG_FROM_SURFACE water added through surface water irrigation mm/s T +QIRRIG_SPRINKLER water added via sprinkler irrigation mm/s F +QOVER total surface runoff (includes QH2OSFC) mm/s T +QOVER_LAG time-lagged surface runoff for soil columns mm/s F +QPHSNEG net negative hydraulic redistribution flux mm/s F +QRGWL surface runoff at glaciers (liquid only), wetlands, lakes; also includes melted ice runoff fro mm/s T +QROOTSINK water flux from soil to root in each soil-layer mm/s F +QRUNOFF total liquid runoff not including correction for land use change mm/s T +QRUNOFF_ICE total liquid runoff not incl corret for LULCC (ice landunits only) mm/s T +QRUNOFF_ICE_TO_COUPLER total ice runoff sent to coupler (includes corrections for land use change) mm/s T +QRUNOFF_ICE_TO_LIQ liquid runoff from converted ice runoff mm/s F +QRUNOFF_R Rural total runoff mm/s F +QRUNOFF_TO_COUPLER total liquid runoff sent to coupler (includes corrections for land use change) mm/s T +QRUNOFF_U Urban total runoff mm/s F +QSNOCPLIQ excess liquid h2o due to snow capping not including correction for land use change mm H2O/s T +QSNOEVAP evaporation from snow (only when snl<0, otherwise it is equal to qflx_ev_soil) mm/s T +QSNOFRZ column-integrated snow freezing rate kg/m2/s T +QSNOFRZ_ICE column-integrated snow freezing rate (ice landunits only) mm/s T +QSNOMELT snow melt rate mm/s T +QSNOMELT_ICE snow melt (ice landunits only) mm/s T +QSNOUNLOAD canopy snow unloading mm/s T +QSNO_TEMPUNLOAD canopy snow temp unloading mm/s T +QSNO_WINDUNLOAD canopy snow wind unloading mm/s T +QSNWCPICE excess solid h2o due to snow capping not including correction for land use change mm H2O/s T +QSOIL Ground evaporation (soil/snow evaporation + soil/snow sublimation - dew) mm/s T +QSOIL_ICE Ground evaporation (ice landunits only) mm/s T +QTOPSOIL water input to surface mm/s F +QVEGE canopy evaporation mm/s T +QVEGT canopy transpiration mm/s T +Qair atmospheric specific humidity (downscaled to columns in glacier regions) kg/kg F +Qh sensible heat W/m^2 F +Qle total evaporation W/m^2 F +Qstor storage heat flux (includes snowmelt) W/m^2 F +Qtau momentum flux kg/m/s^2 F +RAH1 aerodynamical resistance s/m F +RAH2 aerodynamical resistance s/m F +RAIN atmospheric rain, after rain/snow repartitioning based on temperature mm/s T +RAIN_FROM_ATM atmospheric rain received from atmosphere (pre-repartitioning) mm/s T +RAIN_ICE atmospheric rain, after rain/snow repartitioning based on temperature (ice landunits only) mm/s F +RAM_LAKE aerodynamic resistance for momentum (lakes only) s/m F +RAW1 aerodynamical resistance s/m F +RAW2 aerodynamical resistance s/m F +RB leaf boundary resistance s/m F +RDARK_CANOPY_SCLS RDARK for canopy plants by size class kg C / ha / yr F +RDARK_UNDERSTORY_SCLS RDARK for understory plants by size class kg C / ha / yr F +RECRUITMENT Rate of recruitment by PFT indiv/ha/yr T +REPROC Total carbon in live plant reproductive tissues kgC ha-1 T +REPROC_SCPF reproductive carbon mass (on plant) by size-class x pft kgC/ha F +RESP_G_CANOPY_SCLS RESP_G for canopy plants by size class kg C / ha / yr F +RESP_G_UNDERSTORY_SCLS RESP_G for understory plants by size class kg C / ha / yr F +RESP_M_CANOPY_SCLS RESP_M for canopy plants by size class kg C / ha / yr F +RESP_M_UNDERSTORY_SCLS RESP_M for understory plants by size class kg C / ha / yr F +RH atmospheric relative humidity % F +RH2M 2m relative humidity % T +RH2M_R Rural 2m specific humidity % F +RH2M_U Urban 2m relative humidity % F +RHAF fractional humidity of canopy air fraction F +RH_LEAF fractional humidity at leaf surface fraction F +ROOT_MD_CANOPY_SCLS ROOT_MD for canopy plants by size class kg C / ha / yr F +ROOT_MD_UNDERSTORY_SCLS ROOT_MD for understory plants by size class kg C / ha / yr F +RSCANOPY canopy resistance s m-1 T +RSSHA shaded leaf stomatal resistance s/m T +RSSUN sunlit leaf stomatal resistance s/m T +Rainf atmospheric rain, after rain/snow repartitioning based on temperature mm/s F +Rnet net radiation W/m^2 F +SABG solar rad absorbed by ground W/m^2 T +SABG_PEN Rural solar rad penetrating top soil or snow layer watt/m^2 T +SABV solar rad absorbed by veg W/m^2 T +SAI_CANOPY_SCLS stem area index(SAI) by size class m2/m2 F +SAI_UNDERSTORY_SCLS number of understory plants by size class indiv/ha F +SAPWC Total carbon in live plant sapwood kgC ha-1 T +SAPWC_SCPF sapwood carbon mass by size-class x pft kgC/ha F +SCORCH_HEIGHT SPITFIRE Flame Scorch Height (calculated per PFT in each patch age bin) m T +SECONDARY_AREA_AGE_ANTHRO_DIST Secondary forest patch area age distribution since anthropgenic disturbance m2/m2 F +SECONDARY_AREA_PATCH_AGE_DIST Secondary forest patch area age distribution since any kind of disturbance m2/m2 F +SECONDARY_FOREST_BIOMASS Biomass on secondary lands (per total site area, mult by SECONDARY_FOREST_FRACTION to get per kgC/m2 F +SECONDARY_FOREST_FRACTION Secondary forest fraction m2/m2 F +SEEDS_IN Seed Production Rate gC m-2 s-1 T +SEEDS_IN_EXTERN_ELEM External Seed Influx Rate kg ha-1 d-1 T +SEEDS_IN_LOCAL_ELEM Within Site Seed Production Rate kg ha-1 d-1 T +SEED_BANK Total Seed Mass of all PFTs gC m-2 T +SEED_BANK_ELEM Total Seed Mass of all PFTs kg ha-1 T +SEED_DECAY_ELEM Seed mass decay (germinated and un-germinated) kg ha-1 d-1 T +SEED_GERM_ELEM Seed mass converted into new cohorts kg ha-1 d-1 T +SEED_PROD_CANOPY_SCLS SEED_PROD for canopy plants by size class kg C / ha / yr F +SEED_PROD_UNDERSTORY_SCLS SEED_PROD for understory plants by size class kg C / ha / yr F +SITE_COLD_STATUS Site level cold status, 0=not cold-dec, 1=too cold for leaves, 2=not-too cold 0,1,2 T +SITE_DAYSINCE_COLDLEAFOFF site level days elapsed since cold leaf drop days T +SITE_DAYSINCE_COLDLEAFON site level days elapsed since cold leaf flush days T +SITE_DAYSINCE_DROUGHTLEAFOFF site level days elapsed since drought leaf drop days T +SITE_DAYSINCE_DROUGHTLEAFON site level days elapsed since drought leaf flush days T +SITE_DROUGHT_STATUS Site level drought status, <2 too dry for leaves, >=2 not-too dry 0,1,2,3 T +SITE_GDD site level growing degree days degC T +SITE_MEANLIQVOL_DROUGHTPHEN site level mean liquid water volume for drought phen m3/m3 T +SITE_NCHILLDAYS site level number of chill days days T +SITE_NCOLDDAYS site level number of cold days days T +SLO_SOMC SLO_SOM C gC/m^2 T +SLO_SOMC_1m SLO_SOM C to 1 meter gC/m^2 F +SLO_SOMC_TNDNCY_VERT_TRA slow soil organic ma C tendency due to vertical transport gC/m^3/s F +SLO_SOMC_TO_ACT_SOMC decomp. of slow soil organic ma C to active soil organic C gC/m^2/s F +SLO_SOMC_TO_ACT_SOMC_vr decomp. of slow soil organic ma C to active soil organic C gC/m^3/s F +SLO_SOMC_TO_PAS_SOMC decomp. of slow soil organic ma C to passive soil organic C gC/m^2/s F +SLO_SOMC_TO_PAS_SOMC_vr decomp. of slow soil organic ma C to passive soil organic C gC/m^3/s F +SLO_SOMC_vr SLO_SOM C (vertically resolved) gC/m^3 T +SLO_SOMN SLO_SOM N gN/m^2 T +SLO_SOMN_1m SLO_SOM N to 1 meter gN/m^2 F +SLO_SOMN_TNDNCY_VERT_TRA slow soil organic ma N tendency due to vertical transport gN/m^3/s F +SLO_SOMN_TO_ACT_SOMN decomp. of slow soil organic ma N to active soil organic N gN/m^2 F +SLO_SOMN_TO_ACT_SOMN_vr decomp. of slow soil organic ma N to active soil organic N gN/m^3 F +SLO_SOMN_TO_PAS_SOMN decomp. of slow soil organic ma N to passive soil organic N gN/m^2 F +SLO_SOMN_TO_PAS_SOMN_vr decomp. of slow soil organic ma N to passive soil organic N gN/m^3 F +SLO_SOMN_vr SLO_SOM N (vertically resolved) gN/m^3 T +SLO_SOM_HR_S1 Het. Resp. from slow soil organic ma gC/m^2/s F +SLO_SOM_HR_S1_vr Het. Resp. from slow soil organic ma gC/m^3/s F +SLO_SOM_HR_S3 Het. Resp. from slow soil organic ma gC/m^2/s F +SLO_SOM_HR_S3_vr Het. Resp. from slow soil organic ma gC/m^3/s F +SMINN soil mineral N gN/m^2 T +SMINN_LEACHED soil mineral N pool loss to leaching gN/m^2/s T +SMINN_LEACHED_vr soil mineral N pool loss to leaching gN/m^3/s F +SMINN_TO_DENIT_EXCESS denitrification from excess mineral N pool gN/m^2/s F +SMINN_TO_DENIT_EXCESS_vr denitrification from excess mineral N pool gN/m^3/s F +SMINN_TO_DENIT_L1S1 denitrification for decomp. of metabolic litterto ACT_SOM gN/m^2 F +SMINN_TO_DENIT_L1S1_vr denitrification for decomp. of metabolic litterto ACT_SOM gN/m^3 F +SMINN_TO_DENIT_L2S1 denitrification for decomp. of cellulosic litterto ACT_SOM gN/m^2 F +SMINN_TO_DENIT_L2S1_vr denitrification for decomp. of cellulosic litterto ACT_SOM gN/m^3 F +SMINN_TO_DENIT_L3S2 denitrification for decomp. of lignin litterto SLO_SOM gN/m^2 F +SMINN_TO_DENIT_L3S2_vr denitrification for decomp. of lignin litterto SLO_SOM gN/m^3 F +SMINN_TO_DENIT_S1S2 denitrification for decomp. of active soil organicto SLO_SOM gN/m^2 F +SMINN_TO_DENIT_S1S2_vr denitrification for decomp. of active soil organicto SLO_SOM gN/m^3 F +SMINN_TO_DENIT_S1S3 denitrification for decomp. of active soil organicto PAS_SOM gN/m^2 F +SMINN_TO_DENIT_S1S3_vr denitrification for decomp. of active soil organicto PAS_SOM gN/m^3 F +SMINN_TO_DENIT_S2S1 denitrification for decomp. of slow soil organic mato ACT_SOM gN/m^2 F +SMINN_TO_DENIT_S2S1_vr denitrification for decomp. of slow soil organic mato ACT_SOM gN/m^3 F +SMINN_TO_DENIT_S2S3 denitrification for decomp. of slow soil organic mato PAS_SOM gN/m^2 F +SMINN_TO_DENIT_S2S3_vr denitrification for decomp. of slow soil organic mato PAS_SOM gN/m^3 F +SMINN_TO_DENIT_S3S1 denitrification for decomp. of passive soil organicto ACT_SOM gN/m^2 F +SMINN_TO_DENIT_S3S1_vr denitrification for decomp. of passive soil organicto ACT_SOM gN/m^3 F +SMINN_TO_PLANT plant uptake of soil mineral N gN/m^2/s T +SMINN_TO_S1N_L1 mineral N flux for decomp. of MET_LITto ACT_SOM gN/m^2 F +SMINN_TO_S1N_L1_vr mineral N flux for decomp. of MET_LITto ACT_SOM gN/m^3 F +SMINN_TO_S1N_L2 mineral N flux for decomp. of CEL_LITto ACT_SOM gN/m^2 F +SMINN_TO_S1N_L2_vr mineral N flux for decomp. of CEL_LITto ACT_SOM gN/m^3 F +SMINN_TO_S1N_S2 mineral N flux for decomp. of SLO_SOMto ACT_SOM gN/m^2 F +SMINN_TO_S1N_S2_vr mineral N flux for decomp. of SLO_SOMto ACT_SOM gN/m^3 F +SMINN_TO_S1N_S3 mineral N flux for decomp. of PAS_SOMto ACT_SOM gN/m^2 F +SMINN_TO_S1N_S3_vr mineral N flux for decomp. of PAS_SOMto ACT_SOM gN/m^3 F +SMINN_TO_S2N_L3 mineral N flux for decomp. of LIG_LITto SLO_SOM gN/m^2 F +SMINN_TO_S2N_L3_vr mineral N flux for decomp. of LIG_LITto SLO_SOM gN/m^3 F +SMINN_TO_S2N_S1 mineral N flux for decomp. of ACT_SOMto SLO_SOM gN/m^2 F +SMINN_TO_S2N_S1_vr mineral N flux for decomp. of ACT_SOMto SLO_SOM gN/m^3 F +SMINN_TO_S3N_S1 mineral N flux for decomp. of ACT_SOMto PAS_SOM gN/m^2 F +SMINN_TO_S3N_S1_vr mineral N flux for decomp. of ACT_SOMto PAS_SOM gN/m^3 F +SMINN_TO_S3N_S2 mineral N flux for decomp. of SLO_SOMto PAS_SOM gN/m^2 F +SMINN_TO_S3N_S2_vr mineral N flux for decomp. of SLO_SOMto PAS_SOM gN/m^3 F +SMINN_vr soil mineral N gN/m^3 T +SMP soil matric potential (natural vegetated and crop landunits only) mm T +SNOBCMCL mass of BC in snow column kg/m2 T +SNOBCMSL mass of BC in top snow layer kg/m2 T +SNOCAN intercepted snow mm T +SNODSTMCL mass of dust in snow column kg/m2 T +SNODSTMSL mass of dust in top snow layer kg/m2 T +SNOFSDSND direct nir incident solar radiation on snow W/m^2 F +SNOFSDSNI diffuse nir incident solar radiation on snow W/m^2 F +SNOFSDSVD direct vis incident solar radiation on snow W/m^2 F +SNOFSDSVI diffuse vis incident solar radiation on snow W/m^2 F +SNOFSRND direct nir reflected solar radiation from snow W/m^2 T +SNOFSRNI diffuse nir reflected solar radiation from snow W/m^2 T +SNOFSRVD direct vis reflected solar radiation from snow W/m^2 T +SNOFSRVI diffuse vis reflected solar radiation from snow W/m^2 T +SNOINTABS Fraction of incoming solar absorbed by lower snow layers - T +SNOLIQFL top snow layer liquid water fraction (land) fraction F +SNOOCMCL mass of OC in snow column kg/m2 T +SNOOCMSL mass of OC in top snow layer kg/m2 T +SNORDSL top snow layer effective grain radius m^-6 F +SNOTTOPL snow temperature (top layer) K F +SNOTTOPL_ICE snow temperature (top layer, ice landunits only) K F +SNOTXMASS snow temperature times layer mass, layer sum; to get mass-weighted temperature, divide by (SNO K kg/m2 T +SNOTXMASS_ICE snow temperature times layer mass, layer sum (ice landunits only); to get mass-weighted temper K kg/m2 F +SNOW atmospheric snow, after rain/snow repartitioning based on temperature mm/s T +SNOWDP gridcell mean snow height m T +SNOWICE snow ice kg/m2 T +SNOWICE_ICE snow ice (ice landunits only) kg/m2 F +SNOWLIQ snow liquid water kg/m2 T +SNOWLIQ_ICE snow liquid water (ice landunits only) kg/m2 F +SNOW_5D 5day snow avg m F +SNOW_DEPTH snow height of snow covered area m T +SNOW_DEPTH_ICE snow height of snow covered area (ice landunits only) m F +SNOW_FROM_ATM atmospheric snow received from atmosphere (pre-repartitioning) mm/s T +SNOW_ICE atmospheric snow, after rain/snow repartitioning based on temperature (ice landunits only) mm/s F +SNOW_PERSISTENCE Length of time of continuous snow cover (nat. veg. landunits only) seconds T +SNOW_SINKS snow sinks (liquid water) mm/s T +SNOW_SOURCES snow sources (liquid water) mm/s T +SNO_ABS Absorbed solar radiation in each snow layer W/m^2 F +SNO_ABS_ICE Absorbed solar radiation in each snow layer (ice landunits only) W/m^2 F +SNO_BW Partial density of water in the snow pack (ice + liquid) kg/m3 F +SNO_BW_ICE Partial density of water in the snow pack (ice + liquid, ice landunits only) kg/m3 F +SNO_EXISTENCE Fraction of averaging period for which each snow layer existed unitless F +SNO_FRZ snow freezing rate in each snow layer kg/m2/s F +SNO_FRZ_ICE snow freezing rate in each snow layer (ice landunits only) mm/s F +SNO_GS Mean snow grain size Microns F +SNO_GS_ICE Mean snow grain size (ice landunits only) Microns F +SNO_ICE Snow ice content kg/m2 F +SNO_LIQH2O Snow liquid water content kg/m2 F +SNO_MELT snow melt rate in each snow layer mm/s F +SNO_MELT_ICE snow melt rate in each snow layer (ice landunits only) mm/s F +SNO_T Snow temperatures K F +SNO_TK Thermal conductivity W/m-K F +SNO_TK_ICE Thermal conductivity (ice landunits only) W/m-K F +SNO_T_ICE Snow temperatures (ice landunits only) K F +SNO_Z Snow layer thicknesses m F +SNO_Z_ICE Snow layer thicknesses (ice landunits only) m F +SNOdTdzL top snow layer temperature gradient (land) K/m F +SOIL10 10-day running mean of 12cm layer soil K F +SOILC_HR soil C heterotrophic respiration gC/m^2/s T +SOILC_vr SOIL C (vertically resolved) gC/m^3 T +SOILICE soil ice (natural vegetated and crop landunits only) kg/m2 T +SOILLIQ soil liquid water (natural vegetated and crop landunits only) kg/m2 T +SOILN_vr SOIL N (vertically resolved) gN/m^3 T +SOILPSI soil water potential in each soil layer MPa F +SOILRESIS soil resistance to evaporation s/m T +SOILWATER_10CM soil liquid water + ice in top 10cm of soil (veg landunits only) kg/m2 T +SOMC_FIRE C loss due to peat burning gC/m^2/s T +SOM_C_LEACHED total flux of C from SOM pools due to leaching gC/m^2/s T +SOM_N_LEACHED total flux of N from SOM pools due to leaching gN/m^2/s F +STOREC Total carbon in live plant storage kgC ha-1 T +STOREC_SCPF storage carbon mass by size-class x pft kgC/ha F +SUM_FUEL total ground fuel related to ros (omits 1000hr fuels) gC m-2 T +SUM_FUEL_BY_PATCH_AGE spitfire ground fuel related to ros (omits 1000hr fuels) within each patch age bin (divide by gC / m2 of site area T +SUPPLEMENT_TO_SMINN supplemental N supply gN/m^2/s T +SWBGT 2 m Simplified Wetbulb Globe Temp C T +SWBGT_R Rural 2 m Simplified Wetbulb Globe Temp C T +SWBGT_U Urban 2 m Simplified Wetbulb Globe Temp C T +SWdown atmospheric incident solar radiation W/m^2 F +SWup upwelling shortwave radiation W/m^2 F +SoilAlpha factor limiting ground evap unitless F +SoilAlpha_U urban factor limiting ground evap unitless F +T10 10-day running mean of 2-m temperature K F +TAF canopy air temperature K F +TAUX zonal surface stress kg/m/s^2 T +TAUY meridional surface stress kg/m/s^2 T +TBOT atmospheric air temperature (downscaled to columns in glacier regions) K T +TBUILD internal urban building air temperature K T +TBUILD_MAX prescribed maximum interior building temperature K F +TFLOOR floor temperature K F +TG ground temperature K T +TG_ICE ground temperature (ice landunits only) K F +TG_R Rural ground temperature K F +TG_U Urban ground temperature K F +TH2OSFC surface water temperature K T +THBOT atmospheric air potential temperature (downscaled to columns in glacier regions) K T +TKE1 top lake level eddy thermal conductivity W/(mK) T +TLAI total projected leaf area index m^2/m^2 T +TLAKE lake temperature K T +TOPO_COL column-level topographic height m F +TOPO_COL_ICE column-level topographic height (ice landunits only) m F +TOPO_FORC topograephic height sent to GLC m F +TOTCOLCH4 total belowground CH4 (0 for non-lake special landunits in the absence of dynamic landunits) gC/m2 T +TOTLITC total litter carbon gC/m^2 T +TOTLITC_1m total litter carbon to 1 meter depth gC/m^2 T +TOTLITN total litter N gN/m^2 T +TOTLITN_1m total litter N to 1 meter gN/m^2 T +TOTSOILICE vertically summed soil cie (veg landunits only) kg/m2 T +TOTSOILLIQ vertically summed soil liquid water (veg landunits only) kg/m2 T +TOTSOMC total soil organic matter carbon gC/m^2 T +TOTSOMC_1m total soil organic matter carbon to 1 meter depth gC/m^2 T +TOTSOMN total soil organic matter N gN/m^2 T +TOTSOMN_1m total soil organic matter N to 1 meter gN/m^2 T +TOTVEGC Total carbon in live plants kgC ha-1 T +TOTVEGC_SCPF total vegetation carbon mass in live plants by size-class x pft kgC/ha F +TRAFFICFLUX sensible heat flux from urban traffic W/m^2 F +TREFMNAV daily minimum of average 2-m temperature K T +TREFMNAV_R Rural daily minimum of average 2-m temperature K F +TREFMNAV_U Urban daily minimum of average 2-m temperature K F +TREFMXAV daily maximum of average 2-m temperature K T +TREFMXAV_R Rural daily maximum of average 2-m temperature K F +TREFMXAV_U Urban daily maximum of average 2-m temperature K F +TRIMMING Degree to which canopy expansion is limited by leaf economics none T +TRIMMING_CANOPY_SCLS trimming term of canopy plants by size class indiv/ha F +TRIMMING_UNDERSTORY_SCLS trimming term of understory plants by size class indiv/ha F +TROOF_INNER roof inside surface temperature K F +TSA 2m air temperature K T +TSAI total projected stem area index m^2/m^2 T +TSA_ICE 2m air temperature (ice landunits only) K F +TSA_R Rural 2m air temperature K F +TSA_U Urban 2m air temperature K F +TSHDW_INNER shadewall inside surface temperature K F +TSKIN skin temperature K T +TSL temperature of near-surface soil layer (natural vegetated and crop landunits only) K T +TSOI soil temperature (natural vegetated and crop landunits only) K T +TSOI_10CM soil temperature in top 10cm of soil K T +TSOI_ICE soil temperature (ice landunits only) K T +TSRF_FORC surface temperature sent to GLC K F +TSUNW_INNER sunwall inside surface temperature K F +TV vegetation temperature K T +TV24 vegetation temperature (last 24hrs) K F +TV240 vegetation temperature (last 240hrs) K F +TWS total water storage mm T +T_SCALAR temperature inhibition of decomposition unitless T +Tair atmospheric air temperature (downscaled to columns in glacier regions) K F +Tair_from_atm atmospheric air temperature received from atmosphere (pre-downscaling) K F +U10 10-m wind m/s T +U10_DUST 10-m wind for dust model m/s T +U10_ICE 10-m wind (ice landunits only) m/s F +UAF canopy air speed m/s F +UM wind speed plus stability effect m/s F +URBAN_AC urban air conditioning flux W/m^2 T +URBAN_HEAT urban heating flux W/m^2 T +USTAR aerodynamical resistance s/m F +UST_LAKE friction velocity (lakes only) m/s F +VA atmospheric wind speed plus convective velocity m/s F +VOLR river channel total water storage m3 T +VOLRMCH river channel main channel water storage m3 T +VPD vpd Pa F +VPD2M 2m vapor pressure deficit Pa T +VPD_CAN canopy vapor pressure deficit kPa T +WASTEHEAT sensible heat flux from heating/cooling sources of urban waste heat W/m^2 T +WBT 2 m Stull Wet Bulb C T +WBT_R Rural 2 m Stull Wet Bulb C T +WBT_U Urban 2 m Stull Wet Bulb C T +WIND atmospheric wind velocity magnitude m/s T +WOOD_PRODUCT Total wood product from logging gC/m2 F +WTGQ surface tracer conductance m/s T +W_SCALAR Moisture (dryness) inhibition of decomposition unitless T +Wind atmospheric wind velocity magnitude m/s F +YESTERDAYCANLEV_CANOPY_SCLS Yesterdays canopy level for canopy plants by size class indiv/ha F +YESTERDAYCANLEV_UNDERSTORY_SCLS Yesterdays canopy level for understory plants by size class indiv/ha F +Z0HG roughness length over ground, sensible heat m F +Z0M momentum roughness length m F +Z0MG roughness length over ground, momentum m F +Z0M_TO_COUPLER roughness length, momentum: gridcell average sent to coupler m F +Z0QG roughness length over ground, latent heat m F +ZBOT atmospheric reference height m T +ZETA dimensionless stability parameter unitless F +ZII convective boundary height m F +ZSTAR_BY_AGE product of zstar and patch area by age bin (divide by PATCH_AREA_BY_AGE to get mean zstar) m F +ZWT water table depth (natural vegetated and crop landunits only) m T +ZWT_CH4_UNSAT depth of water table for methane production used in non-inundated area m T +ZWT_PERCH perched water table depth (natural vegetated and crop landunits only) m T +num_iter number of iterations unitless F ==== =================================== ============================================================================================== ================================================================= ======= diff --git a/doc/source/users_guide/setting-up-and-running-a-case/history_fields_nofates.rst b/doc/source/users_guide/setting-up-and-running-a-case/history_fields_nofates.rst index 979b13d697..3bdb33297d 100644 --- a/doc/source/users_guide/setting-up-and-running-a-case/history_fields_nofates.rst +++ b/doc/source/users_guide/setting-up-and-running-a-case/history_fields_nofates.rst @@ -13,1303 +13,1303 @@ CTSM History Fields ----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------- # Variable Name Long Description Units Active? ==== =================================== ============================================================================================== ================================================================= ======= - 1 A10TMIN 10-day running mean of min 2-m temperature K F - 2 A5TMIN 5-day running mean of min 2-m temperature K F - 3 ACTUAL_IMMOB actual N immobilization gN/m^2/s T - 4 ACTUAL_IMMOB_NH4 immobilization of NH4 gN/m^3/s F - 5 ACTUAL_IMMOB_NO3 immobilization of NO3 gN/m^3/s F - 6 ACTUAL_IMMOB_vr actual N immobilization gN/m^3/s F - 7 ACT_SOMC ACT_SOM C gC/m^2 T - 8 ACT_SOMC_1m ACT_SOM C to 1 meter gC/m^2 F - 9 ACT_SOMC_TNDNCY_VERT_TRA active soil organic C tendency due to vertical transport gC/m^3/s F - 10 ACT_SOMC_TO_PAS_SOMC decomp. of active soil organic C to passive soil organic C gC/m^2/s F - 11 ACT_SOMC_TO_PAS_SOMC_vr decomp. of active soil organic C to passive soil organic C gC/m^3/s F - 12 ACT_SOMC_TO_SLO_SOMC decomp. of active soil organic C to slow soil organic ma C gC/m^2/s F - 13 ACT_SOMC_TO_SLO_SOMC_vr decomp. of active soil organic C to slow soil organic ma C gC/m^3/s F - 14 ACT_SOMC_vr ACT_SOM C (vertically resolved) gC/m^3 T - 15 ACT_SOMN ACT_SOM N gN/m^2 T - 16 ACT_SOMN_1m ACT_SOM N to 1 meter gN/m^2 F - 17 ACT_SOMN_TNDNCY_VERT_TRA active soil organic N tendency due to vertical transport gN/m^3/s F - 18 ACT_SOMN_TO_PAS_SOMN decomp. of active soil organic N to passive soil organic N gN/m^2 F - 19 ACT_SOMN_TO_PAS_SOMN_vr decomp. of active soil organic N to passive soil organic N gN/m^3 F - 20 ACT_SOMN_TO_SLO_SOMN decomp. of active soil organic N to slow soil organic ma N gN/m^2 F - 21 ACT_SOMN_TO_SLO_SOMN_vr decomp. of active soil organic N to slow soil organic ma N gN/m^3 F - 22 ACT_SOMN_vr ACT_SOM N (vertically resolved) gN/m^3 T - 23 ACT_SOM_HR_S2 Het. Resp. from active soil organic gC/m^2/s F - 24 ACT_SOM_HR_S2_vr Het. Resp. from active soil organic gC/m^3/s F - 25 ACT_SOM_HR_S3 Het. Resp. from active soil organic gC/m^2/s F - 26 ACT_SOM_HR_S3_vr Het. Resp. from active soil organic gC/m^3/s F - 27 AGLB Aboveground leaf biomass kg/m^2 F - 28 AGNPP aboveground NPP gC/m^2/s T - 29 AGSB Aboveground stem biomass kg/m^2 F - 30 ALBD surface albedo (direct) proportion T - 31 ALBDSF diagnostic snow-free surface albedo (direct) proportion T - 32 ALBGRD ground albedo (direct) proportion F - 33 ALBGRI ground albedo (indirect) proportion F - 34 ALBI surface albedo (indirect) proportion T - 35 ALBISF diagnostic snow-free surface albedo (indirect) proportion T - 36 ALPHA alpha coefficient for VOC calc non F - 37 ALT current active layer thickness m T - 38 ALTMAX maximum annual active layer thickness m T - 39 ALTMAX_LASTYEAR maximum prior year active layer thickness m F - 40 ANNAVG_T2M annual average 2m air temperature K F - 41 ANNMAX_RETRANSN annual max of retranslocated N pool gN/m^2 F - 42 ANNSUM_COUNTER seconds since last annual accumulator turnover s F - 43 ANNSUM_NPP annual sum of NPP gC/m^2/yr F - 44 ANNSUM_POTENTIAL_GPP annual sum of potential GPP gN/m^2/yr F - 45 APPAR_TEMP 2 m apparent temperature C T - 46 APPAR_TEMP_R Rural 2 m apparent temperature C T - 47 APPAR_TEMP_U Urban 2 m apparent temperature C T - 48 AR autotrophic respiration (MR + GR) gC/m^2/s T - 49 ATM_TOPO atmospheric surface height m T - 50 AVAILC C flux available for allocation gC/m^2/s F - 51 AVAIL_RETRANSN N flux available from retranslocation pool gN/m^2/s F - 52 AnnET Annual ET mm/s F - 53 BAF_CROP fractional area burned for crop s-1 T - 54 BAF_PEATF fractional area burned in peatland s-1 T - 55 BCDEP total BC deposition (dry+wet) from atmosphere kg/m^2/s T - 56 BETA coefficient of convective velocity none F - 57 BGLFR background litterfall rate 1/s F - 58 BGNPP belowground NPP gC/m^2/s T - 59 BGTR background transfer growth rate 1/s F - 60 BTRANMN daily minimum of transpiration beta factor unitless T - 61 CANNAVG_T2M annual average of 2m air temperature K F - 62 CANNSUM_NPP annual sum of column-level NPP gC/m^2/s F - 63 CEL_LITC CEL_LIT C gC/m^2 T - 64 CEL_LITC_1m CEL_LIT C to 1 meter gC/m^2 F - 65 CEL_LITC_TNDNCY_VERT_TRA cellulosic litter C tendency due to vertical transport gC/m^3/s F - 66 CEL_LITC_TO_ACT_SOMC decomp. of cellulosic litter C to active soil organic C gC/m^2/s F - 67 CEL_LITC_TO_ACT_SOMC_vr decomp. of cellulosic litter C to active soil organic C gC/m^3/s F - 68 CEL_LITC_vr CEL_LIT C (vertically resolved) gC/m^3 T - 69 CEL_LITN CEL_LIT N gN/m^2 T - 70 CEL_LITN_1m CEL_LIT N to 1 meter gN/m^2 F - 71 CEL_LITN_TNDNCY_VERT_TRA cellulosic litter N tendency due to vertical transport gN/m^3/s F - 72 CEL_LITN_TO_ACT_SOMN decomp. of cellulosic litter N to active soil organic N gN/m^2 F - 73 CEL_LITN_TO_ACT_SOMN_vr decomp. of cellulosic litter N to active soil organic N gN/m^3 F - 74 CEL_LITN_vr CEL_LIT N (vertically resolved) gN/m^3 T - 75 CEL_LIT_HR Het. Resp. from cellulosic litter gC/m^2/s F - 76 CEL_LIT_HR_vr Het. Resp. from cellulosic litter gC/m^3/s F - 77 CGRND deriv. of soil energy flux wrt to soil temp W/m^2/K F - 78 CGRNDL deriv. of soil latent heat flux wrt soil temp W/m^2/K F - 79 CGRNDS deriv. of soil sensible heat flux wrt soil temp W/m^2/K F - 80 CH4PROD Gridcell total production of CH4 gC/m2/s T - 81 CH4_EBUL_TOTAL_SAT ebullition surface CH4 flux; (+ to atm) mol/m2/s F - 82 CH4_EBUL_TOTAL_UNSAT ebullition surface CH4 flux; (+ to atm) mol/m2/s F - 83 CH4_SURF_AERE_SAT aerenchyma surface CH4 flux for inundated area; (+ to atm) mol/m2/s T - 84 CH4_SURF_AERE_UNSAT aerenchyma surface CH4 flux for non-inundated area; (+ to atm) mol/m2/s T - 85 CH4_SURF_DIFF_SAT diffusive surface CH4 flux for inundated / lake area; (+ to atm) mol/m2/s T - 86 CH4_SURF_DIFF_UNSAT diffusive surface CH4 flux for non-inundated area; (+ to atm) mol/m2/s T - 87 CH4_SURF_EBUL_SAT ebullition surface CH4 flux for inundated / lake area; (+ to atm) mol/m2/s T - 88 CH4_SURF_EBUL_UNSAT ebullition surface CH4 flux for non-inundated area; (+ to atm) mol/m2/s T - 89 COL_CTRUNC column-level sink for C truncation gC/m^2 F - 90 COL_FIRE_CLOSS total column-level fire C loss for non-peat fires outside land-type converted region gC/m^2/s T - 91 COL_FIRE_NLOSS total column-level fire N loss gN/m^2/s T - 92 COL_NTRUNC column-level sink for N truncation gN/m^2 F - 93 CONC_CH4_SAT CH4 soil Concentration for inundated / lake area mol/m3 F - 94 CONC_CH4_UNSAT CH4 soil Concentration for non-inundated area mol/m3 F - 95 CONC_O2_SAT O2 soil Concentration for inundated / lake area mol/m3 T - 96 CONC_O2_UNSAT O2 soil Concentration for non-inundated area mol/m3 T - 97 COST_NACTIVE Cost of active uptake gN/gC T - 98 COST_NFIX Cost of fixation gN/gC T - 99 COST_NRETRANS Cost of retranslocation gN/gC T - 100 COSZEN cosine of solar zenith angle none F - 101 CPHASE crop phenology phase 0-not planted, 1-planted, 2-leaf emerge, 3-grain fill, 4-harvest T - 102 CPOOL temporary photosynthate C pool gC/m^2 T - 103 CPOOL_DEADCROOT_GR dead coarse root growth respiration gC/m^2/s F - 104 CPOOL_DEADCROOT_STORAGE_GR dead coarse root growth respiration to storage gC/m^2/s F - 105 CPOOL_DEADSTEM_GR dead stem growth respiration gC/m^2/s F - 106 CPOOL_DEADSTEM_STORAGE_GR dead stem growth respiration to storage gC/m^2/s F - 107 CPOOL_FROOT_GR fine root growth respiration gC/m^2/s F - 108 CPOOL_FROOT_STORAGE_GR fine root growth respiration to storage gC/m^2/s F - 109 CPOOL_LEAF_GR leaf growth respiration gC/m^2/s F - 110 CPOOL_LEAF_STORAGE_GR leaf growth respiration to storage gC/m^2/s F - 111 CPOOL_LIVECROOT_GR live coarse root growth respiration gC/m^2/s F - 112 CPOOL_LIVECROOT_STORAGE_GR live coarse root growth respiration to storage gC/m^2/s F - 113 CPOOL_LIVESTEM_GR live stem growth respiration gC/m^2/s F - 114 CPOOL_LIVESTEM_STORAGE_GR live stem growth respiration to storage gC/m^2/s F - 115 CPOOL_TO_DEADCROOTC allocation to dead coarse root C gC/m^2/s F - 116 CPOOL_TO_DEADCROOTC_STORAGE allocation to dead coarse root C storage gC/m^2/s F - 117 CPOOL_TO_DEADSTEMC allocation to dead stem C gC/m^2/s F - 118 CPOOL_TO_DEADSTEMC_STORAGE allocation to dead stem C storage gC/m^2/s F - 119 CPOOL_TO_FROOTC allocation to fine root C gC/m^2/s F - 120 CPOOL_TO_FROOTC_STORAGE allocation to fine root C storage gC/m^2/s F - 121 CPOOL_TO_GRESP_STORAGE allocation to growth respiration storage gC/m^2/s F - 122 CPOOL_TO_LEAFC allocation to leaf C gC/m^2/s F - 123 CPOOL_TO_LEAFC_STORAGE allocation to leaf C storage gC/m^2/s F - 124 CPOOL_TO_LIVECROOTC allocation to live coarse root C gC/m^2/s F - 125 CPOOL_TO_LIVECROOTC_STORAGE allocation to live coarse root C storage gC/m^2/s F - 126 CPOOL_TO_LIVESTEMC allocation to live stem C gC/m^2/s F - 127 CPOOL_TO_LIVESTEMC_STORAGE allocation to live stem C storage gC/m^2/s F - 128 CROOT_PROF profile for litter C and N inputs from coarse roots 1/m F - 129 CROPPROD1C 1-yr crop product (grain+biofuel) C gC/m^2 T - 130 CROPPROD1C_LOSS loss from 1-yr crop product pool gC/m^2/s T - 131 CROPPROD1N 1-yr crop product (grain+biofuel) N gN/m^2 T - 132 CROPPROD1N_LOSS loss from 1-yr crop product pool gN/m^2/s T - 133 CROPSEEDC_DEFICIT C used for crop seed that needs to be repaid gC/m^2 T - 134 CROPSEEDN_DEFICIT N used for crop seed that needs to be repaid gN/m^2 F - 135 CROP_SEEDC_TO_LEAF crop seed source to leaf gC/m^2/s F - 136 CROP_SEEDN_TO_LEAF crop seed source to leaf gN/m^2/s F - 137 CURRENT_GR growth resp for new growth displayed in this timestep gC/m^2/s F - 138 CWDC CWD C gC/m^2 T - 139 CWDC_1m CWD C to 1 meter gC/m^2 F - 140 CWDC_HR cwd C heterotrophic respiration gC/m^2/s F - 141 CWDC_LOSS coarse woody debris C loss gC/m^2/s T - 142 CWDC_TO_CEL_LITC decomp. of coarse woody debris C to cellulosic litter C gC/m^2/s F - 143 CWDC_TO_CEL_LITC_vr decomp. of coarse woody debris C to cellulosic litter C gC/m^3/s F - 144 CWDC_TO_LIG_LITC decomp. of coarse woody debris C to lignin litter C gC/m^2/s F - 145 CWDC_TO_LIG_LITC_vr decomp. of coarse woody debris C to lignin litter C gC/m^3/s F - 146 CWDC_vr CWD C (vertically resolved) gC/m^3 T - 147 CWDN CWD N gN/m^2 T - 148 CWDN_1m CWD N to 1 meter gN/m^2 F - 149 CWDN_TO_CEL_LITN decomp. of coarse woody debris N to cellulosic litter N gN/m^2 F - 150 CWDN_TO_CEL_LITN_vr decomp. of coarse woody debris N to cellulosic litter N gN/m^3 F - 151 CWDN_TO_LIG_LITN decomp. of coarse woody debris N to lignin litter N gN/m^2 F - 152 CWDN_TO_LIG_LITN_vr decomp. of coarse woody debris N to lignin litter N gN/m^3 F - 153 CWDN_vr CWD N (vertically resolved) gN/m^3 T - 154 CWD_HR_L2 Het. Resp. from coarse woody debris gC/m^2/s F - 155 CWD_HR_L2_vr Het. Resp. from coarse woody debris gC/m^3/s F - 156 CWD_HR_L3 Het. Resp. from coarse woody debris gC/m^2/s F - 157 CWD_HR_L3_vr Het. Resp. from coarse woody debris gC/m^3/s F - 158 C_ALLOMETRY C allocation index none F - 159 DAYL daylength s F - 160 DAYS_ACTIVE number of days since last dormancy days F - 161 DEADCROOTC dead coarse root C gC/m^2 T - 162 DEADCROOTC_STORAGE dead coarse root C storage gC/m^2 F - 163 DEADCROOTC_STORAGE_TO_XFER dead coarse root C shift storage to transfer gC/m^2/s F - 164 DEADCROOTC_XFER dead coarse root C transfer gC/m^2 F - 165 DEADCROOTC_XFER_TO_DEADCROOTC dead coarse root C growth from storage gC/m^2/s F - 166 DEADCROOTN dead coarse root N gN/m^2 T - 167 DEADCROOTN_STORAGE dead coarse root N storage gN/m^2 F - 168 DEADCROOTN_STORAGE_TO_XFER dead coarse root N shift storage to transfer gN/m^2/s F - 169 DEADCROOTN_XFER dead coarse root N transfer gN/m^2 F - 170 DEADCROOTN_XFER_TO_DEADCROOTN dead coarse root N growth from storage gN/m^2/s F - 171 DEADSTEMC dead stem C gC/m^2 T - 172 DEADSTEMC_STORAGE dead stem C storage gC/m^2 F - 173 DEADSTEMC_STORAGE_TO_XFER dead stem C shift storage to transfer gC/m^2/s F - 174 DEADSTEMC_XFER dead stem C transfer gC/m^2 F - 175 DEADSTEMC_XFER_TO_DEADSTEMC dead stem C growth from storage gC/m^2/s F - 176 DEADSTEMN dead stem N gN/m^2 T - 177 DEADSTEMN_STORAGE dead stem N storage gN/m^2 F - 178 DEADSTEMN_STORAGE_TO_XFER dead stem N shift storage to transfer gN/m^2/s F - 179 DEADSTEMN_XFER dead stem N transfer gN/m^2 F - 180 DEADSTEMN_XFER_TO_DEADSTEMN dead stem N growth from storage gN/m^2/s F - 181 DENIT total rate of denitrification gN/m^2/s T - 182 DGNETDT derivative of net ground heat flux wrt soil temp W/m^2/K F - 183 DISCOI 2 m Discomfort Index C T - 184 DISCOIS 2 m Stull Discomfort Index C T - 185 DISCOIS_R Rural 2 m Stull Discomfort Index C T - 186 DISCOIS_U Urban 2 m Stull Discomfort Index C T - 187 DISCOI_R Rural 2 m Discomfort Index C T - 188 DISCOI_U Urban 2 m Discomfort Index C T - 189 DISPLA displacement height m F - 190 DISPVEGC displayed veg carbon, excluding storage and cpool gC/m^2 T - 191 DISPVEGN displayed vegetation nitrogen gN/m^2 T - 192 DLRAD downward longwave radiation below the canopy W/m^2 F - 193 DORMANT_FLAG dormancy flag none F - 194 DOWNREG fractional reduction in GPP due to N limitation proportion F - 195 DPVLTRB1 turbulent deposition velocity 1 m/s F - 196 DPVLTRB2 turbulent deposition velocity 2 m/s F - 197 DPVLTRB3 turbulent deposition velocity 3 m/s F - 198 DPVLTRB4 turbulent deposition velocity 4 m/s F - 199 DSL dry surface layer thickness mm T - 200 DSTDEP total dust deposition (dry+wet) from atmosphere kg/m^2/s T - 201 DSTFLXT total surface dust emission kg/m2/s T - 202 DT_VEG change in t_veg, last iteration K F - 203 DWT_CONV_CFLUX conversion C flux (immediate loss to atm) (0 at all times except first timestep of year) gC/m^2/s T - 204 DWT_CONV_CFLUX_DRIBBLED conversion C flux (immediate loss to atm), dribbled throughout the year gC/m^2/s T - 205 DWT_CONV_CFLUX_PATCH patch-level conversion C flux (immediate loss to atm) (0 at all times except first timestep of gC/m^2/s F - 206 DWT_CONV_NFLUX conversion N flux (immediate loss to atm) (0 at all times except first timestep of year) gN/m^2/s T - 207 DWT_CONV_NFLUX_PATCH patch-level conversion N flux (immediate loss to atm) (0 at all times except first timestep of gN/m^2/s F - 208 DWT_CROPPROD1C_GAIN landcover change-driven addition to 1-year crop product pool gC/m^2/s T - 209 DWT_CROPPROD1N_GAIN landcover change-driven addition to 1-year crop product pool gN/m^2/s T - 210 DWT_DEADCROOTC_TO_CWDC dead coarse root to CWD due to landcover change gC/m^2/s F - 211 DWT_DEADCROOTN_TO_CWDN dead coarse root to CWD due to landcover change gN/m^2/s F - 212 DWT_FROOTC_TO_CEL_LIT_C fine root to cellulosic litter due to landcover change gC/m^2/s F - 213 DWT_FROOTC_TO_LIG_LIT_C fine root to lignin litter due to landcover change gC/m^2/s F - 214 DWT_FROOTC_TO_MET_LIT_C fine root to metabolic litter due to landcover change gC/m^2/s F - 215 DWT_FROOTN_TO_CEL_LIT_N fine root N to cellulosic litter due to landcover change gN/m^2/s F - 216 DWT_FROOTN_TO_LIG_LIT_N fine root N to lignin litter due to landcover change gN/m^2/s F - 217 DWT_FROOTN_TO_MET_LIT_N fine root N to metabolic litter due to landcover change gN/m^2/s F - 218 DWT_LIVECROOTC_TO_CWDC live coarse root to CWD due to landcover change gC/m^2/s F - 219 DWT_LIVECROOTN_TO_CWDN live coarse root to CWD due to landcover change gN/m^2/s F - 220 DWT_PROD100C_GAIN landcover change-driven addition to 100-yr wood product pool gC/m^2/s F - 221 DWT_PROD100N_GAIN landcover change-driven addition to 100-yr wood product pool gN/m^2/s F - 222 DWT_PROD10C_GAIN landcover change-driven addition to 10-yr wood product pool gC/m^2/s F - 223 DWT_PROD10N_GAIN landcover change-driven addition to 10-yr wood product pool gN/m^2/s F - 224 DWT_SEEDC_TO_DEADSTEM seed source to patch-level deadstem gC/m^2/s F - 225 DWT_SEEDC_TO_DEADSTEM_PATCH patch-level seed source to patch-level deadstem (per-area-gridcell; only makes sense with dov2 gC/m^2/s F - 226 DWT_SEEDC_TO_LEAF seed source to patch-level leaf gC/m^2/s F - 227 DWT_SEEDC_TO_LEAF_PATCH patch-level seed source to patch-level leaf (per-area-gridcell; only makes sense with dov2xy=. gC/m^2/s F - 228 DWT_SEEDN_TO_DEADSTEM seed source to patch-level deadstem gN/m^2/s T - 229 DWT_SEEDN_TO_DEADSTEM_PATCH patch-level seed source to patch-level deadstem (per-area-gridcell; only makes sense with dov2 gN/m^2/s F - 230 DWT_SEEDN_TO_LEAF seed source to patch-level leaf gN/m^2/s T - 231 DWT_SEEDN_TO_LEAF_PATCH patch-level seed source to patch-level leaf (per-area-gridcell; only makes sense with dov2xy=. gN/m^2/s F - 232 DWT_SLASH_CFLUX slash C flux (to litter diagnostic only) (0 at all times except first timestep of year) gC/m^2/s T - 233 DWT_SLASH_CFLUX_PATCH patch-level slash C flux (to litter diagnostic only) (0 at all times except first timestep of gC/m^2/s F - 234 DWT_WOODPRODC_GAIN landcover change-driven addition to wood product pools gC/m^2/s T - 235 DWT_WOODPRODN_GAIN landcover change-driven addition to wood product pools gN/m^2/s T - 236 DWT_WOOD_PRODUCTC_GAIN_PATCH patch-level landcover change-driven addition to wood product pools(0 at all times except first gC/m^2/s F - 237 DYN_COL_ADJUSTMENTS_CH4 Adjustments in ch4 due to dynamic column areas; only makes sense at the column level: should n gC/m^2 F - 238 DYN_COL_SOIL_ADJUSTMENTS_C Adjustments in soil carbon due to dynamic column areas; only makes sense at the column level: gC/m^2 F - 239 DYN_COL_SOIL_ADJUSTMENTS_N Adjustments in soil nitrogen due to dynamic column areas; only makes sense at the column level gN/m^2 F - 240 DYN_COL_SOIL_ADJUSTMENTS_NH4 Adjustments in soil NH4 due to dynamic column areas; only makes sense at the column level: sho gN/m^2 F - 241 DYN_COL_SOIL_ADJUSTMENTS_NO3 Adjustments in soil NO3 due to dynamic column areas; only makes sense at the column level: sho gN/m^2 F - 242 EFF_POROSITY effective porosity = porosity - vol_ice proportion F - 243 EFLXBUILD building heat flux from change in interior building air temperature W/m^2 T - 244 EFLX_DYNBAL dynamic land cover change conversion energy flux W/m^2 T - 245 EFLX_GNET net heat flux into ground W/m^2 F - 246 EFLX_GRND_LAKE net heat flux into lake/snow surface, excluding light transmission W/m^2 T - 247 EFLX_LH_TOT total latent heat flux [+ to atm] W/m^2 T - 248 EFLX_LH_TOT_ICE total latent heat flux [+ to atm] (ice landunits only) W/m^2 F - 249 EFLX_LH_TOT_R Rural total evaporation W/m^2 T - 250 EFLX_LH_TOT_U Urban total evaporation W/m^2 F - 251 EFLX_SOIL_GRND soil heat flux [+ into soil] W/m^2 F - 252 ELAI exposed one-sided leaf area index m^2/m^2 T - 253 EMG ground emissivity proportion F - 254 EMV vegetation emissivity proportion F - 255 EOPT Eopt coefficient for VOC calc non F - 256 EPT 2 m Equiv Pot Temp K T - 257 EPT_R Rural 2 m Equiv Pot Temp K T - 258 EPT_U Urban 2 m Equiv Pot Temp K T - 259 ER total ecosystem respiration, autotrophic + heterotrophic gC/m^2/s T - 260 ERRH2O total water conservation error mm T - 261 ERRH2OSNO imbalance in snow depth (liquid water) mm T - 262 ERRSEB surface energy conservation error W/m^2 T - 263 ERRSOI soil/lake energy conservation error W/m^2 T - 264 ERRSOL solar radiation conservation error W/m^2 T - 265 ESAI exposed one-sided stem area index m^2/m^2 T - 266 EXCESSC_MR excess C maintenance respiration gC/m^2/s F - 267 EXCESS_CFLUX C flux not allocated due to downregulation gC/m^2/s F - 268 FAREA_BURNED timestep fractional area burned s-1 T - 269 FCANSNO fraction of canopy that is wet proportion F - 270 FCEV canopy evaporation W/m^2 T - 271 FCH4 Gridcell surface CH4 flux to atmosphere (+ to atm) kgC/m2/s T - 272 FCH4TOCO2 Gridcell oxidation of CH4 to CO2 gC/m2/s T - 273 FCH4_DFSAT CH4 additional flux due to changing fsat, natural vegetated and crop landunits only kgC/m2/s T - 274 FCO2 CO2 flux to atmosphere (+ to atm) kgCO2/m2/s F - 275 FCOV fractional impermeable area unitless T - 276 FCTR canopy transpiration W/m^2 T - 277 FDRY fraction of foliage that is green and dry proportion F - 278 FERTNITRO Nitrogen fertilizer for each crop gN/m2/yr F - 279 FERT_COUNTER time left to fertilize seconds F - 280 FERT_TO_SMINN fertilizer to soil mineral N gN/m^2/s F - 281 FFIX_TO_SMINN free living N fixation to soil mineral N gN/m^2/s T - 282 FGEV ground evaporation W/m^2 T - 283 FGR heat flux into soil/snow including snow melt and lake / snow light transmission W/m^2 T - 284 FGR12 heat flux between soil layers 1 and 2 W/m^2 T - 285 FGR_ICE heat flux into soil/snow including snow melt and lake / snow light transmission (ice landunits W/m^2 F - 286 FGR_R Rural heat flux into soil/snow including snow melt and snow light transmission W/m^2 F - 287 FGR_SOIL_R Rural downward heat flux at interface below each soil layer watt/m^2 F - 288 FGR_U Urban heat flux into soil/snow including snow melt W/m^2 F - 289 FH2OSFC fraction of ground covered by surface water unitless T - 290 FH2OSFC_NOSNOW fraction of ground covered by surface water (if no snow present) unitless F - 291 FINUNDATED fractional inundated area of vegetated columns unitless T - 292 FINUNDATED_LAG time-lagged inundated fraction of vegetated columns unitless F - 293 FIRA net infrared (longwave) radiation W/m^2 T - 294 FIRA_ICE net infrared (longwave) radiation (ice landunits only) W/m^2 F - 295 FIRA_R Rural net infrared (longwave) radiation W/m^2 T - 296 FIRA_U Urban net infrared (longwave) radiation W/m^2 F - 297 FIRE emitted infrared (longwave) radiation W/m^2 T - 298 FIRE_ICE emitted infrared (longwave) radiation (ice landunits only) W/m^2 F - 299 FIRE_R Rural emitted infrared (longwave) radiation W/m^2 T - 300 FIRE_U Urban emitted infrared (longwave) radiation W/m^2 F - 301 FLDS atmospheric longwave radiation (downscaled to columns in glacier regions) W/m^2 T - 302 FLDS_ICE atmospheric longwave radiation (downscaled to columns in glacier regions) (ice landunits only) W/m^2 F - 303 FMAX_DENIT_CARBONSUBSTRATE FMAX_DENIT_CARBONSUBSTRATE gN/m^3/s F - 304 FMAX_DENIT_NITRATE FMAX_DENIT_NITRATE gN/m^3/s F - 305 FPI fraction of potential immobilization proportion T - 306 FPI_vr fraction of potential immobilization proportion F - 307 FPSN photosynthesis umol m-2 s-1 T - 308 FPSN24 24 hour accumulative patch photosynthesis starting from mid-night umol CO2/m^2 ground/day F - 309 FPSN_WC Rubisco-limited photosynthesis umol m-2 s-1 F - 310 FPSN_WJ RuBP-limited photosynthesis umol m-2 s-1 F - 311 FPSN_WP Product-limited photosynthesis umol m-2 s-1 F - 312 FRAC_ICEOLD fraction of ice relative to the tot water proportion F - 313 FREE_RETRANSN_TO_NPOOL deployment of retranslocated N gN/m^2/s T - 314 FROOTC fine root C gC/m^2 T - 315 FROOTC_ALLOC fine root C allocation gC/m^2/s T - 316 FROOTC_LOSS fine root C loss gC/m^2/s T - 317 FROOTC_STORAGE fine root C storage gC/m^2 F - 318 FROOTC_STORAGE_TO_XFER fine root C shift storage to transfer gC/m^2/s F - 319 FROOTC_TO_LITTER fine root C litterfall gC/m^2/s F - 320 FROOTC_XFER fine root C transfer gC/m^2 F - 321 FROOTC_XFER_TO_FROOTC fine root C growth from storage gC/m^2/s F - 322 FROOTN fine root N gN/m^2 T - 323 FROOTN_STORAGE fine root N storage gN/m^2 F - 324 FROOTN_STORAGE_TO_XFER fine root N shift storage to transfer gN/m^2/s F - 325 FROOTN_TO_LITTER fine root N litterfall gN/m^2/s F - 326 FROOTN_XFER fine root N transfer gN/m^2 F - 327 FROOTN_XFER_TO_FROOTN fine root N growth from storage gN/m^2/s F - 328 FROOT_MR fine root maintenance respiration gC/m^2/s F - 329 FROOT_PROF profile for litter C and N inputs from fine roots 1/m F - 330 FROST_TABLE frost table depth (natural vegetated and crop landunits only) m F - 331 FSA absorbed solar radiation W/m^2 T - 332 FSAT fractional area with water table at surface unitless T - 333 FSA_ICE absorbed solar radiation (ice landunits only) W/m^2 F - 334 FSA_R Rural absorbed solar radiation W/m^2 F - 335 FSA_U Urban absorbed solar radiation W/m^2 F - 336 FSD24 direct radiation (last 24hrs) K F - 337 FSD240 direct radiation (last 240hrs) K F - 338 FSDS atmospheric incident solar radiation W/m^2 T - 339 FSDSND direct nir incident solar radiation W/m^2 T - 340 FSDSNDLN direct nir incident solar radiation at local noon W/m^2 T - 341 FSDSNI diffuse nir incident solar radiation W/m^2 T - 342 FSDSVD direct vis incident solar radiation W/m^2 T - 343 FSDSVDLN direct vis incident solar radiation at local noon W/m^2 T - 344 FSDSVI diffuse vis incident solar radiation W/m^2 T - 345 FSDSVILN diffuse vis incident solar radiation at local noon W/m^2 T - 346 FSH sensible heat not including correction for land use change and rain/snow conversion W/m^2 T - 347 FSH_G sensible heat from ground W/m^2 T - 348 FSH_ICE sensible heat not including correction for land use change and rain/snow conversion (ice landu W/m^2 F - 349 FSH_PRECIP_CONVERSION Sensible heat flux from conversion of rain/snow atm forcing W/m^2 T - 350 FSH_R Rural sensible heat W/m^2 T - 351 FSH_RUNOFF_ICE_TO_LIQ sensible heat flux generated from conversion of ice runoff to liquid W/m^2 T - 352 FSH_TO_COUPLER sensible heat sent to coupler (includes corrections for land use change, rain/snow conversion W/m^2 T - 353 FSH_U Urban sensible heat W/m^2 F - 354 FSH_V sensible heat from veg W/m^2 T - 355 FSI24 indirect radiation (last 24hrs) K F - 356 FSI240 indirect radiation (last 240hrs) K F - 357 FSM snow melt heat flux W/m^2 T - 358 FSM_ICE snow melt heat flux (ice landunits only) W/m^2 F - 359 FSM_R Rural snow melt heat flux W/m^2 F - 360 FSM_U Urban snow melt heat flux W/m^2 F - 361 FSNO fraction of ground covered by snow unitless T - 362 FSNO_EFF effective fraction of ground covered by snow unitless T - 363 FSNO_ICE fraction of ground covered by snow (ice landunits only) unitless F - 364 FSR reflected solar radiation W/m^2 T - 365 FSRND direct nir reflected solar radiation W/m^2 T - 366 FSRNDLN direct nir reflected solar radiation at local noon W/m^2 T - 367 FSRNI diffuse nir reflected solar radiation W/m^2 T - 368 FSRSF reflected solar radiation W/m^2 T - 369 FSRSFND direct nir reflected solar radiation W/m^2 T - 370 FSRSFNDLN direct nir reflected solar radiation at local noon W/m^2 T - 371 FSRSFNI diffuse nir reflected solar radiation W/m^2 T - 372 FSRSFVD direct vis reflected solar radiation W/m^2 T - 373 FSRSFVDLN direct vis reflected solar radiation at local noon W/m^2 T - 374 FSRSFVI diffuse vis reflected solar radiation W/m^2 T - 375 FSRVD direct vis reflected solar radiation W/m^2 T - 376 FSRVDLN direct vis reflected solar radiation at local noon W/m^2 T - 377 FSRVI diffuse vis reflected solar radiation W/m^2 T - 378 FSR_ICE reflected solar radiation (ice landunits only) W/m^2 F - 379 FSUN sunlit fraction of canopy proportion F - 380 FSUN24 fraction sunlit (last 24hrs) K F - 381 FSUN240 fraction sunlit (last 240hrs) K F - 382 FUELC fuel load gC/m^2 T - 383 FV friction velocity m/s T - 384 FWET fraction of canopy that is wet proportion F - 385 F_DENIT denitrification flux gN/m^2/s T - 386 F_DENIT_BASE F_DENIT_BASE gN/m^3/s F - 387 F_DENIT_vr denitrification flux gN/m^3/s F - 388 F_N2O_DENIT denitrification N2O flux gN/m^2/s T - 389 F_N2O_NIT nitrification N2O flux gN/m^2/s T - 390 F_NIT nitrification flux gN/m^2/s T - 391 F_NIT_vr nitrification flux gN/m^3/s F - 392 FireComp_BC fire emissions flux of BC kg/m2/sec F - 393 FireComp_OC fire emissions flux of OC kg/m2/sec F - 394 FireComp_SO2 fire emissions flux of SO2 kg/m2/sec F - 395 FireEmis_TOT Total fire emissions flux gC/m2/sec F - 396 FireEmis_ZTOP Top of vertical fire emissions distribution m F - 397 FireMech_SO2 fire emissions flux of SO2 kg/m2/sec F - 398 FireMech_bc_a1 fire emissions flux of bc_a1 kg/m2/sec F - 399 FireMech_pom_a1 fire emissions flux of pom_a1 kg/m2/sec F - 400 GAMMA total gamma for VOC calc non F - 401 GAMMAA gamma A for VOC calc non F - 402 GAMMAC gamma C for VOC calc non F - 403 GAMMAL gamma L for VOC calc non F - 404 GAMMAP gamma P for VOC calc non F - 405 GAMMAS gamma S for VOC calc non F - 406 GAMMAT gamma T for VOC calc non F - 407 GDD0 Growing degree days base 0C from planting ddays F - 408 GDD020 Twenty year average of growing degree days base 0C from planting ddays F - 409 GDD10 Growing degree days base 10C from planting ddays F - 410 GDD1020 Twenty year average of growing degree days base 10C from planting ddays F - 411 GDD8 Growing degree days base 8C from planting ddays F - 412 GDD820 Twenty year average of growing degree days base 8C from planting ddays F - 413 GDDACCUM Accumulated growing degree days past planting date for crop ddays F - 414 GDDACCUM_PERHARV For each crop harvest in a calendar year, accumulated growing degree days past planting date ddays F - 415 GDDHARV Growing degree days (gdd) needed to harvest ddays F - 416 GDDHARV_PERHARV For each harvest in a calendar year,For each harvest in a calendar year, growing degree days (gdd) needed to harvest ddays F - 417 GDDTSOI Growing degree-days from planting (top two soil layers) ddays F - 418 GPP gross primary production gC/m^2/s T - 419 GR total growth respiration gC/m^2/s T - 420 GRAINC grain C (does not equal yield) gC/m^2 T - 421 GRAINC_TO_FOOD grain C to food gC/m^2/s T - 422 GRAINC_TO_FOOD_ANN total grain C to food in all harvests in a calendar year gC/m^2 F - 423 GRAINC_TO_FOOD_PERHARV grain C to food for each harvest in a calendar year gC/m^2 F - 424 GRAINC_TO_SEED grain C to seed gC/m^2/s T - 425 GRAINN grain N gN/m^2 T - 426 GRESP_STORAGE growth respiration storage gC/m^2 F - 427 GRESP_STORAGE_TO_XFER growth respiration shift storage to transfer gC/m^2/s F - 428 GRESP_XFER growth respiration transfer gC/m^2 F - 429 GROSS_NMIN gross rate of N mineralization gN/m^2/s T - 430 GROSS_NMIN_vr gross rate of N mineralization gN/m^3/s F - 431 GSSHA shaded leaf stomatal conductance umol H20/m2/s T - 432 GSSHALN shaded leaf stomatal conductance at local noon umol H20/m2/s T - 433 GSSUN sunlit leaf stomatal conductance umol H20/m2/s T - 434 GSSUNLN sunlit leaf stomatal conductance at local noon umol H20/m2/s T - 435 H2OCAN intercepted water mm T - 436 H2OSFC surface water depth mm T - 437 H2OSNO snow depth (liquid water) mm T - 438 H2OSNO_ICE snow depth (liquid water, ice landunits only) mm F - 439 H2OSNO_TOP mass of snow in top snow layer kg/m2 T - 440 H2OSOI volumetric soil water (natural vegetated and crop landunits only) mm3/mm3 T - 441 HARVEST_REASON_PERHARV For each harvest in a calendar year, the reason the crop was harvested categorical F - 442 HBOT canopy bottom m F - 443 HEAT_CONTENT1 initial gridcell total heat content J/m^2 T - 444 HEAT_CONTENT1_VEG initial gridcell total heat content - natural vegetated and crop landunits only J/m^2 F - 445 HEAT_CONTENT2 post land cover change total heat content J/m^2 F - 446 HEAT_FROM_AC sensible heat flux put into canyon due to heat removed from air conditioning W/m^2 T - 447 HIA 2 m NWS Heat Index C T - 448 HIA_R Rural 2 m NWS Heat Index C T - 449 HIA_U Urban 2 m NWS Heat Index C T - 450 HK hydraulic conductivity (natural vegetated and crop landunits only) mm/s F - 451 HR total heterotrophic respiration gC/m^2/s T - 452 HR_vr total vertically resolved heterotrophic respiration gC/m^3/s T - 453 HTOP canopy top m T - 454 HUI crop heat unit index ddays F - 455 HUI_PERHARV For each harvest in a calendar year, crop heat unit index ddays F - 456 HUMIDEX 2 m Humidex C T - 457 HUMIDEX_R Rural 2 m Humidex C T - 458 HUMIDEX_U Urban 2 m Humidex C T - 459 ICE_CONTENT1 initial gridcell total ice content mm T - 460 ICE_CONTENT2 post land cover change total ice content mm F - 461 ICE_MODEL_FRACTION Ice sheet model fractional coverage unitless F - 462 INIT_GPP GPP flux before downregulation gC/m^2/s F - 463 INT_SNOW accumulated swe (natural vegetated and crop landunits only) mm F - 464 INT_SNOW_ICE accumulated swe (ice landunits only) mm F - 465 IWUELN local noon intrinsic water use efficiency umolCO2/molH2O T - 466 JMX25T canopy profile of jmax umol/m2/s T - 467 Jmx25Z maximum rate of electron transport at 25 Celcius for canopy layers umol electrons/m2/s T - 468 KROOT root conductance each soil layer 1/s F - 469 KSOIL soil conductance in each soil layer 1/s F - 470 K_ACT_SOM active soil organic potential loss coefficient 1/s F - 471 K_CEL_LIT cellulosic litter potential loss coefficient 1/s F - 472 K_CWD coarse woody debris potential loss coefficient 1/s F - 473 K_LIG_LIT lignin litter potential loss coefficient 1/s F - 474 K_MET_LIT metabolic litter potential loss coefficient 1/s F - 475 K_NITR K_NITR 1/s F - 476 K_NITR_H2O K_NITR_H2O unitless F - 477 K_NITR_PH K_NITR_PH unitless F - 478 K_NITR_T K_NITR_T unitless F - 479 K_PAS_SOM passive soil organic potential loss coefficient 1/s F - 480 K_SLO_SOM slow soil organic ma potential loss coefficient 1/s F - 481 LAI240 240hr average of leaf area index m^2/m^2 F - 482 LAISHA shaded projected leaf area index m^2/m^2 T - 483 LAISUN sunlit projected leaf area index m^2/m^2 T - 484 LAKEICEFRAC lake layer ice mass fraction unitless F - 485 LAKEICEFRAC_SURF surface lake layer ice mass fraction unitless T - 486 LAKEICETHICK thickness of lake ice (including physical expansion on freezing) m T - 487 LAND_USE_FLUX total C emitted from land cover conversion (smoothed over the year) and wood and grain product gC/m^2/s T - 488 LATBASET latitude vary base temperature for gddplant degree C F - 489 LEAFC leaf C gC/m^2 T - 490 LEAFCN Leaf CN ratio used for flexible CN gC/gN T - 491 LEAFCN_OFFSET Leaf C:N used by FUN unitless F - 492 LEAFCN_STORAGE Storage Leaf CN ratio used for flexible CN gC/gN F - 493 LEAFC_ALLOC leaf C allocation gC/m^2/s T - 494 LEAFC_CHANGE C change in leaf gC/m^2/s T - 495 LEAFC_LOSS leaf C loss gC/m^2/s T - 496 LEAFC_STORAGE leaf C storage gC/m^2 F - 497 LEAFC_STORAGE_TO_XFER leaf C shift storage to transfer gC/m^2/s F - 498 LEAFC_STORAGE_XFER_ACC Accumulated leaf C transfer gC/m^2 F - 499 LEAFC_TO_BIOFUELC leaf C to biofuel C gC/m^2/s T - 500 LEAFC_TO_LITTER leaf C litterfall gC/m^2/s F - 501 LEAFC_TO_LITTER_FUN leaf C litterfall used by FUN gC/m^2/s T - 502 LEAFC_XFER leaf C transfer gC/m^2 F - 503 LEAFC_XFER_TO_LEAFC leaf C growth from storage gC/m^2/s F - 504 LEAFN leaf N gN/m^2 T - 505 LEAFN_STORAGE leaf N storage gN/m^2 F - 506 LEAFN_STORAGE_TO_XFER leaf N shift storage to transfer gN/m^2/s F - 507 LEAFN_STORAGE_XFER_ACC Accmulated leaf N transfer gN/m^2 F - 508 LEAFN_TO_LITTER leaf N litterfall gN/m^2/s T - 509 LEAFN_TO_RETRANSN leaf N to retranslocated N pool gN/m^2/s F - 510 LEAFN_XFER leaf N transfer gN/m^2 F - 511 LEAFN_XFER_TO_LEAFN leaf N growth from storage gN/m^2/s F - 512 LEAF_MR leaf maintenance respiration gC/m^2/s T - 513 LEAF_PROF profile for litter C and N inputs from leaves 1/m F - 514 LFC2 conversion area fraction of BET and BDT that burned per sec T - 515 LGSF long growing season factor proportion F - 516 LIG_LITC LIG_LIT C gC/m^2 T - 517 LIG_LITC_1m LIG_LIT C to 1 meter gC/m^2 F - 518 LIG_LITC_TNDNCY_VERT_TRA lignin litter C tendency due to vertical transport gC/m^3/s F - 519 LIG_LITC_TO_SLO_SOMC decomp. of lignin litter C to slow soil organic ma C gC/m^2/s F - 520 LIG_LITC_TO_SLO_SOMC_vr decomp. of lignin litter C to slow soil organic ma C gC/m^3/s F - 521 LIG_LITC_vr LIG_LIT C (vertically resolved) gC/m^3 T - 522 LIG_LITN LIG_LIT N gN/m^2 T - 523 LIG_LITN_1m LIG_LIT N to 1 meter gN/m^2 F - 524 LIG_LITN_TNDNCY_VERT_TRA lignin litter N tendency due to vertical transport gN/m^3/s F - 525 LIG_LITN_TO_SLO_SOMN decomp. of lignin litter N to slow soil organic ma N gN/m^2 F - 526 LIG_LITN_TO_SLO_SOMN_vr decomp. of lignin litter N to slow soil organic ma N gN/m^3 F - 527 LIG_LITN_vr LIG_LIT N (vertically resolved) gN/m^3 T - 528 LIG_LIT_HR Het. Resp. from lignin litter gC/m^2/s F - 529 LIG_LIT_HR_vr Het. Resp. from lignin litter gC/m^3/s F - 530 LIQCAN intercepted liquid water mm T - 531 LIQUID_CONTENT1 initial gridcell total liq content mm T - 532 LIQUID_CONTENT2 post landuse change gridcell total liq content mm F - 533 LIQUID_WATER_TEMP1 initial gridcell weighted average liquid water temperature K F - 534 LITFALL litterfall (leaves and fine roots) gC/m^2/s T - 535 LITFIRE litter fire losses gC/m^2/s F - 536 LITTERC_HR litter C heterotrophic respiration gC/m^2/s T - 537 LITTERC_LOSS litter C loss gC/m^2/s T - 538 LIVECROOTC live coarse root C gC/m^2 T - 539 LIVECROOTC_STORAGE live coarse root C storage gC/m^2 F - 540 LIVECROOTC_STORAGE_TO_XFER live coarse root C shift storage to transfer gC/m^2/s F - 541 LIVECROOTC_TO_DEADCROOTC live coarse root C turnover gC/m^2/s F - 542 LIVECROOTC_XFER live coarse root C transfer gC/m^2 F - 543 LIVECROOTC_XFER_TO_LIVECROOTC live coarse root C growth from storage gC/m^2/s F - 544 LIVECROOTN live coarse root N gN/m^2 T - 545 LIVECROOTN_STORAGE live coarse root N storage gN/m^2 F - 546 LIVECROOTN_STORAGE_TO_XFER live coarse root N shift storage to transfer gN/m^2/s F - 547 LIVECROOTN_TO_DEADCROOTN live coarse root N turnover gN/m^2/s F - 548 LIVECROOTN_TO_RETRANSN live coarse root N to retranslocated N pool gN/m^2/s F - 549 LIVECROOTN_XFER live coarse root N transfer gN/m^2 F - 550 LIVECROOTN_XFER_TO_LIVECROOTN live coarse root N growth from storage gN/m^2/s F - 551 LIVECROOT_MR live coarse root maintenance respiration gC/m^2/s F - 552 LIVESTEMC live stem C gC/m^2 T - 553 LIVESTEMC_STORAGE live stem C storage gC/m^2 F - 554 LIVESTEMC_STORAGE_TO_XFER live stem C shift storage to transfer gC/m^2/s F - 555 LIVESTEMC_TO_BIOFUELC livestem C to biofuel C gC/m^2/s T - 556 LIVESTEMC_TO_DEADSTEMC live stem C turnover gC/m^2/s F - 557 LIVESTEMC_XFER live stem C transfer gC/m^2 F - 558 LIVESTEMC_XFER_TO_LIVESTEMC live stem C growth from storage gC/m^2/s F - 559 LIVESTEMN live stem N gN/m^2 T - 560 LIVESTEMN_STORAGE live stem N storage gN/m^2 F - 561 LIVESTEMN_STORAGE_TO_XFER live stem N shift storage to transfer gN/m^2/s F - 562 LIVESTEMN_TO_DEADSTEMN live stem N turnover gN/m^2/s F - 563 LIVESTEMN_TO_RETRANSN live stem N to retranslocated N pool gN/m^2/s F - 564 LIVESTEMN_XFER live stem N transfer gN/m^2 F - 565 LIVESTEMN_XFER_TO_LIVESTEMN live stem N growth from storage gN/m^2/s F - 566 LIVESTEM_MR live stem maintenance respiration gC/m^2/s F - 567 LNC leaf N concentration gN leaf/m^2 T - 568 LWdown atmospheric longwave radiation (downscaled to columns in glacier regions) W/m^2 F - 569 LWup upwelling longwave radiation W/m^2 F - 570 MEG_acetaldehyde MEGAN flux kg/m2/sec T - 571 MEG_acetic_acid MEGAN flux kg/m2/sec T - 572 MEG_acetone MEGAN flux kg/m2/sec T - 573 MEG_carene_3 MEGAN flux kg/m2/sec T - 574 MEG_ethanol MEGAN flux kg/m2/sec T - 575 MEG_formaldehyde MEGAN flux kg/m2/sec T - 576 MEG_isoprene MEGAN flux kg/m2/sec T - 577 MEG_methanol MEGAN flux kg/m2/sec T - 578 MEG_pinene_a MEGAN flux kg/m2/sec T - 579 MEG_thujene_a MEGAN flux kg/m2/sec T - 580 MET_LITC MET_LIT C gC/m^2 T - 581 MET_LITC_1m MET_LIT C to 1 meter gC/m^2 F - 582 MET_LITC_TNDNCY_VERT_TRA metabolic litter C tendency due to vertical transport gC/m^3/s F - 583 MET_LITC_TO_ACT_SOMC decomp. of metabolic litter C to active soil organic C gC/m^2/s F - 584 MET_LITC_TO_ACT_SOMC_vr decomp. of metabolic litter C to active soil organic C gC/m^3/s F - 585 MET_LITC_vr MET_LIT C (vertically resolved) gC/m^3 T - 586 MET_LITN MET_LIT N gN/m^2 T - 587 MET_LITN_1m MET_LIT N to 1 meter gN/m^2 F - 588 MET_LITN_TNDNCY_VERT_TRA metabolic litter N tendency due to vertical transport gN/m^3/s F - 589 MET_LITN_TO_ACT_SOMN decomp. of metabolic litter N to active soil organic N gN/m^2 F - 590 MET_LITN_TO_ACT_SOMN_vr decomp. of metabolic litter N to active soil organic N gN/m^3 F - 591 MET_LITN_vr MET_LIT N (vertically resolved) gN/m^3 T - 592 MET_LIT_HR Het. Resp. from metabolic litter gC/m^2/s F - 593 MET_LIT_HR_vr Het. Resp. from metabolic litter gC/m^3/s F - 594 MR maintenance respiration gC/m^2/s T - 595 M_ACT_SOMC_TO_LEACHING active soil organic C leaching loss gC/m^2/s F - 596 M_ACT_SOMN_TO_LEACHING active soil organic N leaching loss gN/m^2/s F - 597 M_CEL_LITC_TO_FIRE cellulosic litter C fire loss gC/m^2/s F - 598 M_CEL_LITC_TO_FIRE_vr cellulosic litter C fire loss gC/m^3/s F - 599 M_CEL_LITC_TO_LEACHING cellulosic litter C leaching loss gC/m^2/s F - 600 M_CEL_LITN_TO_FIRE cellulosic litter N fire loss gN/m^2 F - 601 M_CEL_LITN_TO_FIRE_vr cellulosic litter N fire loss gN/m^3 F - 602 M_CEL_LITN_TO_LEACHING cellulosic litter N leaching loss gN/m^2/s F - 603 M_CWDC_TO_FIRE coarse woody debris C fire loss gC/m^2/s F - 604 M_CWDC_TO_FIRE_vr coarse woody debris C fire loss gC/m^3/s F - 605 M_CWDN_TO_FIRE coarse woody debris N fire loss gN/m^2 F - 606 M_CWDN_TO_FIRE_vr coarse woody debris N fire loss gN/m^3 F - 607 M_DEADCROOTC_STORAGE_TO_LITTER dead coarse root C storage mortality gC/m^2/s F - 608 M_DEADCROOTC_STORAGE_TO_LITTER_FIRE dead coarse root C storage fire mortality to litter gC/m^2/s F - 609 M_DEADCROOTC_TO_LITTER dead coarse root C mortality gC/m^2/s F - 610 M_DEADCROOTC_XFER_TO_LITTER dead coarse root C transfer mortality gC/m^2/s F - 611 M_DEADCROOTN_STORAGE_TO_FIRE dead coarse root N storage fire loss gN/m^2/s F - 612 M_DEADCROOTN_STORAGE_TO_LITTER dead coarse root N storage mortality gN/m^2/s F - 613 M_DEADCROOTN_TO_FIRE dead coarse root N fire loss gN/m^2/s F - 614 M_DEADCROOTN_TO_LITTER dead coarse root N mortality gN/m^2/s F - 615 M_DEADCROOTN_TO_LITTER_FIRE dead coarse root N fire mortality to litter gN/m^2/s F - 616 M_DEADCROOTN_XFER_TO_FIRE dead coarse root N transfer fire loss gN/m^2/s F - 617 M_DEADCROOTN_XFER_TO_LITTER dead coarse root N transfer mortality gN/m^2/s F - 618 M_DEADROOTC_STORAGE_TO_FIRE dead root C storage fire loss gC/m^2/s F - 619 M_DEADROOTC_STORAGE_TO_LITTER_FIRE dead root C storage fire mortality to litter gC/m^2/s F - 620 M_DEADROOTC_TO_FIRE dead root C fire loss gC/m^2/s F - 621 M_DEADROOTC_TO_LITTER_FIRE dead root C fire mortality to litter gC/m^2/s F - 622 M_DEADROOTC_XFER_TO_FIRE dead root C transfer fire loss gC/m^2/s F - 623 M_DEADROOTC_XFER_TO_LITTER_FIRE dead root C transfer fire mortality to litter gC/m^2/s F - 624 M_DEADSTEMC_STORAGE_TO_FIRE dead stem C storage fire loss gC/m^2/s F - 625 M_DEADSTEMC_STORAGE_TO_LITTER dead stem C storage mortality gC/m^2/s F - 626 M_DEADSTEMC_STORAGE_TO_LITTER_FIRE dead stem C storage fire mortality to litter gC/m^2/s F - 627 M_DEADSTEMC_TO_FIRE dead stem C fire loss gC/m^2/s F - 628 M_DEADSTEMC_TO_LITTER dead stem C mortality gC/m^2/s F - 629 M_DEADSTEMC_TO_LITTER_FIRE dead stem C fire mortality to litter gC/m^2/s F - 630 M_DEADSTEMC_XFER_TO_FIRE dead stem C transfer fire loss gC/m^2/s F - 631 M_DEADSTEMC_XFER_TO_LITTER dead stem C transfer mortality gC/m^2/s F - 632 M_DEADSTEMC_XFER_TO_LITTER_FIRE dead stem C transfer fire mortality to litter gC/m^2/s F - 633 M_DEADSTEMN_STORAGE_TO_FIRE dead stem N storage fire loss gN/m^2/s F - 634 M_DEADSTEMN_STORAGE_TO_LITTER dead stem N storage mortality gN/m^2/s F - 635 M_DEADSTEMN_TO_FIRE dead stem N fire loss gN/m^2/s F - 636 M_DEADSTEMN_TO_LITTER dead stem N mortality gN/m^2/s F - 637 M_DEADSTEMN_TO_LITTER_FIRE dead stem N fire mortality to litter gN/m^2/s F - 638 M_DEADSTEMN_XFER_TO_FIRE dead stem N transfer fire loss gN/m^2/s F - 639 M_DEADSTEMN_XFER_TO_LITTER dead stem N transfer mortality gN/m^2/s F - 640 M_FROOTC_STORAGE_TO_FIRE fine root C storage fire loss gC/m^2/s F - 641 M_FROOTC_STORAGE_TO_LITTER fine root C storage mortality gC/m^2/s F - 642 M_FROOTC_STORAGE_TO_LITTER_FIRE fine root C storage fire mortality to litter gC/m^2/s F - 643 M_FROOTC_TO_FIRE fine root C fire loss gC/m^2/s F - 644 M_FROOTC_TO_LITTER fine root C mortality gC/m^2/s F - 645 M_FROOTC_TO_LITTER_FIRE fine root C fire mortality to litter gC/m^2/s F - 646 M_FROOTC_XFER_TO_FIRE fine root C transfer fire loss gC/m^2/s F - 647 M_FROOTC_XFER_TO_LITTER fine root C transfer mortality gC/m^2/s F - 648 M_FROOTC_XFER_TO_LITTER_FIRE fine root C transfer fire mortality to litter gC/m^2/s F - 649 M_FROOTN_STORAGE_TO_FIRE fine root N storage fire loss gN/m^2/s F - 650 M_FROOTN_STORAGE_TO_LITTER fine root N storage mortality gN/m^2/s F - 651 M_FROOTN_TO_FIRE fine root N fire loss gN/m^2/s F - 652 M_FROOTN_TO_LITTER fine root N mortality gN/m^2/s F - 653 M_FROOTN_XFER_TO_FIRE fine root N transfer fire loss gN/m^2/s F - 654 M_FROOTN_XFER_TO_LITTER fine root N transfer mortality gN/m^2/s F - 655 M_GRESP_STORAGE_TO_FIRE growth respiration storage fire loss gC/m^2/s F - 656 M_GRESP_STORAGE_TO_LITTER growth respiration storage mortality gC/m^2/s F - 657 M_GRESP_STORAGE_TO_LITTER_FIRE growth respiration storage fire mortality to litter gC/m^2/s F - 658 M_GRESP_XFER_TO_FIRE growth respiration transfer fire loss gC/m^2/s F - 659 M_GRESP_XFER_TO_LITTER growth respiration transfer mortality gC/m^2/s F - 660 M_GRESP_XFER_TO_LITTER_FIRE growth respiration transfer fire mortality to litter gC/m^2/s F - 661 M_LEAFC_STORAGE_TO_FIRE leaf C storage fire loss gC/m^2/s F - 662 M_LEAFC_STORAGE_TO_LITTER leaf C storage mortality gC/m^2/s F - 663 M_LEAFC_STORAGE_TO_LITTER_FIRE leaf C fire mortality to litter gC/m^2/s F - 664 M_LEAFC_TO_FIRE leaf C fire loss gC/m^2/s F - 665 M_LEAFC_TO_LITTER leaf C mortality gC/m^2/s F - 666 M_LEAFC_TO_LITTER_FIRE leaf C fire mortality to litter gC/m^2/s F - 667 M_LEAFC_XFER_TO_FIRE leaf C transfer fire loss gC/m^2/s F - 668 M_LEAFC_XFER_TO_LITTER leaf C transfer mortality gC/m^2/s F - 669 M_LEAFC_XFER_TO_LITTER_FIRE leaf C transfer fire mortality to litter gC/m^2/s F - 670 M_LEAFN_STORAGE_TO_FIRE leaf N storage fire loss gN/m^2/s F - 671 M_LEAFN_STORAGE_TO_LITTER leaf N storage mortality gN/m^2/s F - 672 M_LEAFN_TO_FIRE leaf N fire loss gN/m^2/s F - 673 M_LEAFN_TO_LITTER leaf N mortality gN/m^2/s F - 674 M_LEAFN_XFER_TO_FIRE leaf N transfer fire loss gN/m^2/s F - 675 M_LEAFN_XFER_TO_LITTER leaf N transfer mortality gN/m^2/s F - 676 M_LIG_LITC_TO_FIRE lignin litter C fire loss gC/m^2/s F - 677 M_LIG_LITC_TO_FIRE_vr lignin litter C fire loss gC/m^3/s F - 678 M_LIG_LITC_TO_LEACHING lignin litter C leaching loss gC/m^2/s F - 679 M_LIG_LITN_TO_FIRE lignin litter N fire loss gN/m^2 F - 680 M_LIG_LITN_TO_FIRE_vr lignin litter N fire loss gN/m^3 F - 681 M_LIG_LITN_TO_LEACHING lignin litter N leaching loss gN/m^2/s F - 682 M_LIVECROOTC_STORAGE_TO_LITTER live coarse root C storage mortality gC/m^2/s F - 683 M_LIVECROOTC_STORAGE_TO_LITTER_FIRE live coarse root C fire mortality to litter gC/m^2/s F - 684 M_LIVECROOTC_TO_LITTER live coarse root C mortality gC/m^2/s F - 685 M_LIVECROOTC_XFER_TO_LITTER live coarse root C transfer mortality gC/m^2/s F - 686 M_LIVECROOTN_STORAGE_TO_FIRE live coarse root N storage fire loss gN/m^2/s F - 687 M_LIVECROOTN_STORAGE_TO_LITTER live coarse root N storage mortality gN/m^2/s F - 688 M_LIVECROOTN_TO_FIRE live coarse root N fire loss gN/m^2/s F - 689 M_LIVECROOTN_TO_LITTER live coarse root N mortality gN/m^2/s F - 690 M_LIVECROOTN_XFER_TO_FIRE live coarse root N transfer fire loss gN/m^2/s F - 691 M_LIVECROOTN_XFER_TO_LITTER live coarse root N transfer mortality gN/m^2/s F - 692 M_LIVEROOTC_STORAGE_TO_FIRE live root C storage fire loss gC/m^2/s F - 693 M_LIVEROOTC_STORAGE_TO_LITTER_FIRE live root C storage fire mortality to litter gC/m^2/s F - 694 M_LIVEROOTC_TO_DEADROOTC_FIRE live root C fire mortality to dead root C gC/m^2/s F - 695 M_LIVEROOTC_TO_FIRE live root C fire loss gC/m^2/s F - 696 M_LIVEROOTC_TO_LITTER_FIRE live root C fire mortality to litter gC/m^2/s F - 697 M_LIVEROOTC_XFER_TO_FIRE live root C transfer fire loss gC/m^2/s F - 698 M_LIVEROOTC_XFER_TO_LITTER_FIRE live root C transfer fire mortality to litter gC/m^2/s F - 699 M_LIVESTEMC_STORAGE_TO_FIRE live stem C storage fire loss gC/m^2/s F - 700 M_LIVESTEMC_STORAGE_TO_LITTER live stem C storage mortality gC/m^2/s F - 701 M_LIVESTEMC_STORAGE_TO_LITTER_FIRE live stem C storage fire mortality to litter gC/m^2/s F - 702 M_LIVESTEMC_TO_DEADSTEMC_FIRE live stem C fire mortality to dead stem C gC/m^2/s F - 703 M_LIVESTEMC_TO_FIRE live stem C fire loss gC/m^2/s F - 704 M_LIVESTEMC_TO_LITTER live stem C mortality gC/m^2/s F - 705 M_LIVESTEMC_TO_LITTER_FIRE live stem C fire mortality to litter gC/m^2/s F - 706 M_LIVESTEMC_XFER_TO_FIRE live stem C transfer fire loss gC/m^2/s F - 707 M_LIVESTEMC_XFER_TO_LITTER live stem C transfer mortality gC/m^2/s F - 708 M_LIVESTEMC_XFER_TO_LITTER_FIRE live stem C transfer fire mortality to litter gC/m^2/s F - 709 M_LIVESTEMN_STORAGE_TO_FIRE live stem N storage fire loss gN/m^2/s F - 710 M_LIVESTEMN_STORAGE_TO_LITTER live stem N storage mortality gN/m^2/s F - 711 M_LIVESTEMN_TO_FIRE live stem N fire loss gN/m^2/s F - 712 M_LIVESTEMN_TO_LITTER live stem N mortality gN/m^2/s F - 713 M_LIVESTEMN_XFER_TO_FIRE live stem N transfer fire loss gN/m^2/s F - 714 M_LIVESTEMN_XFER_TO_LITTER live stem N transfer mortality gN/m^2/s F - 715 M_MET_LITC_TO_FIRE metabolic litter C fire loss gC/m^2/s F - 716 M_MET_LITC_TO_FIRE_vr metabolic litter C fire loss gC/m^3/s F - 717 M_MET_LITC_TO_LEACHING metabolic litter C leaching loss gC/m^2/s F - 718 M_MET_LITN_TO_FIRE metabolic litter N fire loss gN/m^2 F - 719 M_MET_LITN_TO_FIRE_vr metabolic litter N fire loss gN/m^3 F - 720 M_MET_LITN_TO_LEACHING metabolic litter N leaching loss gN/m^2/s F - 721 M_PAS_SOMC_TO_LEACHING passive soil organic C leaching loss gC/m^2/s F - 722 M_PAS_SOMN_TO_LEACHING passive soil organic N leaching loss gN/m^2/s F - 723 M_RETRANSN_TO_FIRE retranslocated N pool fire loss gN/m^2/s F - 724 M_RETRANSN_TO_LITTER retranslocated N pool mortality gN/m^2/s F - 725 M_SLO_SOMC_TO_LEACHING slow soil organic ma C leaching loss gC/m^2/s F - 726 M_SLO_SOMN_TO_LEACHING slow soil organic ma N leaching loss gN/m^2/s F - 727 NACTIVE Mycorrhizal N uptake flux gN/m^2/s T - 728 NACTIVE_NH4 Mycorrhizal N uptake flux gN/m^2/s T - 729 NACTIVE_NO3 Mycorrhizal N uptake flux gN/m^2/s T - 730 NAM AM-associated N uptake flux gN/m^2/s T - 731 NAM_NH4 AM-associated N uptake flux gN/m^2/s T - 732 NAM_NO3 AM-associated N uptake flux gN/m^2/s T - 733 NBP net biome production, includes fire, landuse, harvest and hrv_xsmrpool flux (latter smoothed o gC/m^2/s T - 734 NDEPLOY total N deployed in new growth gN/m^2/s T - 735 NDEP_PROF profile for atmospheric N deposition 1/m F - 736 NDEP_TO_SMINN atmospheric N deposition to soil mineral N gN/m^2/s T - 737 NECM ECM-associated N uptake flux gN/m^2/s T - 738 NECM_NH4 ECM-associated N uptake flux gN/m^2/s T - 739 NECM_NO3 ECM-associated N uptake flux gN/m^2/s T - 740 NEE net ecosystem exchange of carbon, includes fire and hrv_xsmrpool (latter smoothed over the yea gC/m^2/s T - 741 NEM Gridcell net adjustment to net carbon exchange passed to atm. for methane production gC/m2/s T - 742 NEP net ecosystem production, excludes fire, landuse, and harvest flux, positive for sink gC/m^2/s T - 743 NET_NMIN net rate of N mineralization gN/m^2/s T - 744 NET_NMIN_vr net rate of N mineralization gN/m^3/s F - 745 NFERTILIZATION fertilizer added gN/m^2/s T - 746 NFIRE fire counts valid only in Reg.C counts/km2/sec T - 747 NFIX Symbiotic BNF uptake flux gN/m^2/s T - 748 NFIXATION_PROF profile for biological N fixation 1/m F - 749 NFIX_TO_SMINN symbiotic/asymbiotic N fixation to soil mineral N gN/m^2/s F - 750 NNONMYC Non-mycorrhizal N uptake flux gN/m^2/s T - 751 NNONMYC_NH4 Non-mycorrhizal N uptake flux gN/m^2/s T - 752 NNONMYC_NO3 Non-mycorrhizal N uptake flux gN/m^2/s T - 753 NPASSIVE Passive N uptake flux gN/m^2/s T - 754 NPOOL temporary plant N pool gN/m^2 T - 755 NPOOL_TO_DEADCROOTN allocation to dead coarse root N gN/m^2/s F - 756 NPOOL_TO_DEADCROOTN_STORAGE allocation to dead coarse root N storage gN/m^2/s F - 757 NPOOL_TO_DEADSTEMN allocation to dead stem N gN/m^2/s F - 758 NPOOL_TO_DEADSTEMN_STORAGE allocation to dead stem N storage gN/m^2/s F - 759 NPOOL_TO_FROOTN allocation to fine root N gN/m^2/s F - 760 NPOOL_TO_FROOTN_STORAGE allocation to fine root N storage gN/m^2/s F - 761 NPOOL_TO_LEAFN allocation to leaf N gN/m^2/s F - 762 NPOOL_TO_LEAFN_STORAGE allocation to leaf N storage gN/m^2/s F - 763 NPOOL_TO_LIVECROOTN allocation to live coarse root N gN/m^2/s F - 764 NPOOL_TO_LIVECROOTN_STORAGE allocation to live coarse root N storage gN/m^2/s F - 765 NPOOL_TO_LIVESTEMN allocation to live stem N gN/m^2/s F - 766 NPOOL_TO_LIVESTEMN_STORAGE allocation to live stem N storage gN/m^2/s F - 767 NPP net primary production gC/m^2/s T - 768 NPP_BURNEDOFF C that cannot be used for N uptake gC/m^2/s F - 769 NPP_GROWTH Total C used for growth in FUN gC/m^2/s T - 770 NPP_NACTIVE Mycorrhizal N uptake used C gC/m^2/s T - 771 NPP_NACTIVE_NH4 Mycorrhizal N uptake use C gC/m^2/s T - 772 NPP_NACTIVE_NO3 Mycorrhizal N uptake used C gC/m^2/s T - 773 NPP_NAM AM-associated N uptake used C gC/m^2/s T - 774 NPP_NAM_NH4 AM-associated N uptake use C gC/m^2/s T - 775 NPP_NAM_NO3 AM-associated N uptake use C gC/m^2/s T - 776 NPP_NECM ECM-associated N uptake used C gC/m^2/s T - 777 NPP_NECM_NH4 ECM-associated N uptake use C gC/m^2/s T - 778 NPP_NECM_NO3 ECM-associated N uptake used C gC/m^2/s T - 779 NPP_NFIX Symbiotic BNF uptake used C gC/m^2/s T - 780 NPP_NNONMYC Non-mycorrhizal N uptake used C gC/m^2/s T - 781 NPP_NNONMYC_NH4 Non-mycorrhizal N uptake use C gC/m^2/s T - 782 NPP_NNONMYC_NO3 Non-mycorrhizal N uptake use C gC/m^2/s T - 783 NPP_NRETRANS Retranslocated N uptake flux gC/m^2/s T - 784 NPP_NUPTAKE Total C used by N uptake in FUN gC/m^2/s T - 785 NRETRANS Retranslocated N uptake flux gN/m^2/s T - 786 NRETRANS_REG Retranslocated N uptake flux gN/m^2/s T - 787 NRETRANS_SEASON Retranslocated N uptake flux gN/m^2/s T - 788 NRETRANS_STRESS Retranslocated N uptake flux gN/m^2/s T - 789 NSUBSTEPS number of adaptive timesteps in CLM timestep unitless F - 790 NUPTAKE Total N uptake of FUN gN/m^2/s T - 791 NUPTAKE_NPP_FRACTION frac of NPP used in N uptake - T - 792 N_ALLOMETRY N allocation index none F - 793 O2_DECOMP_DEPTH_UNSAT O2 consumption from HR and AR for non-inundated area mol/m3/s F - 794 OBU Monin-Obukhov length m F - 795 OCDEP total OC deposition (dry+wet) from atmosphere kg/m^2/s T - 796 OFFSET_COUNTER offset days counter days F - 797 OFFSET_FDD offset freezing degree days counter C degree-days F - 798 OFFSET_FLAG offset flag none F - 799 OFFSET_SWI offset soil water index none F - 800 ONSET_COUNTER onset days counter days F - 801 ONSET_FDD onset freezing degree days counter C degree-days F - 802 ONSET_FLAG onset flag none F - 803 ONSET_GDD onset growing degree days C degree-days F - 804 ONSET_GDDFLAG onset flag for growing degree day sum none F - 805 ONSET_SWI onset soil water index none F - 806 O_SCALAR fraction by which decomposition is reduced due to anoxia unitless T - 807 PAR240DZ 10-day running mean of daytime patch absorbed PAR for leaves for top canopy layer W/m^2 F - 808 PAR240XZ 10-day running mean of maximum patch absorbed PAR for leaves for top canopy layer W/m^2 F - 809 PAR240_shade shade PAR (240 hrs) umol/m2/s F - 810 PAR240_sun sunlit PAR (240 hrs) umol/m2/s F - 811 PAR24_shade shade PAR (24 hrs) umol/m2/s F - 812 PAR24_sun sunlit PAR (24 hrs) umol/m2/s F - 813 PARVEGLN absorbed par by vegetation at local noon W/m^2 T - 814 PAR_shade shade PAR umol/m2/s F - 815 PAR_sun sunlit PAR umol/m2/s F - 816 PAS_SOMC PAS_SOM C gC/m^2 T - 817 PAS_SOMC_1m PAS_SOM C to 1 meter gC/m^2 F - 818 PAS_SOMC_TNDNCY_VERT_TRA passive soil organic C tendency due to vertical transport gC/m^3/s F - 819 PAS_SOMC_TO_ACT_SOMC decomp. of passive soil organic C to active soil organic C gC/m^2/s F - 820 PAS_SOMC_TO_ACT_SOMC_vr decomp. of passive soil organic C to active soil organic C gC/m^3/s F - 821 PAS_SOMC_vr PAS_SOM C (vertically resolved) gC/m^3 T - 822 PAS_SOMN PAS_SOM N gN/m^2 T - 823 PAS_SOMN_1m PAS_SOM N to 1 meter gN/m^2 F - 824 PAS_SOMN_TNDNCY_VERT_TRA passive soil organic N tendency due to vertical transport gN/m^3/s F - 825 PAS_SOMN_TO_ACT_SOMN decomp. of passive soil organic N to active soil organic N gN/m^2 F - 826 PAS_SOMN_TO_ACT_SOMN_vr decomp. of passive soil organic N to active soil organic N gN/m^3 F - 827 PAS_SOMN_vr PAS_SOM N (vertically resolved) gN/m^3 T - 828 PAS_SOM_HR Het. Resp. from passive soil organic gC/m^2/s F - 829 PAS_SOM_HR_vr Het. Resp. from passive soil organic gC/m^3/s F - 830 PBOT atmospheric pressure at surface (downscaled to columns in glacier regions) Pa T - 831 PBOT_240 10 day running mean of air pressure Pa F - 832 PCH4 atmospheric partial pressure of CH4 Pa T - 833 PCO2 atmospheric partial pressure of CO2 Pa T - 834 PCO2_240 10 day running mean of CO2 pressure Pa F - 835 PFT_CTRUNC patch-level sink for C truncation gC/m^2 F - 836 PFT_FIRE_CLOSS total patch-level fire C loss for non-peat fires outside land-type converted region gC/m^2/s T - 837 PFT_FIRE_NLOSS total patch-level fire N loss gN/m^2/s T - 838 PFT_NTRUNC patch-level sink for N truncation gN/m^2 F - 839 PLANTCN Plant C:N used by FUN unitless F - 840 PLANT_CALLOC total allocated C flux gC/m^2/s F - 841 PLANT_NALLOC total allocated N flux gN/m^2/s F - 842 PLANT_NDEMAND N flux required to support initial GPP gN/m^2/s T - 843 PNLCZ Proportion of nitrogen allocated for light capture unitless F - 844 PO2_240 10 day running mean of O2 pressure Pa F - 845 POTENTIAL_IMMOB potential N immobilization gN/m^2/s T - 846 POTENTIAL_IMMOB_vr potential N immobilization gN/m^3/s F - 847 POT_F_DENIT potential denitrification flux gN/m^2/s T - 848 POT_F_DENIT_vr potential denitrification flux gN/m^3/s F - 849 POT_F_NIT potential nitrification flux gN/m^2/s T - 850 POT_F_NIT_vr potential nitrification flux gN/m^3/s F - 851 PREC10 10-day running mean of PREC MM H2O/S F - 852 PREC60 60-day running mean of PREC MM H2O/S F - 853 PREV_DAYL daylength from previous timestep s F - 854 PREV_FROOTC_TO_LITTER previous timestep froot C litterfall flux gC/m^2/s F - 855 PREV_LEAFC_TO_LITTER previous timestep leaf C litterfall flux gC/m^2/s F - 856 PROD100C 100-yr wood product C gC/m^2 F - 857 PROD100C_LOSS loss from 100-yr wood product pool gC/m^2/s F - 858 PROD100N 100-yr wood product N gN/m^2 F - 859 PROD100N_LOSS loss from 100-yr wood product pool gN/m^2/s F - 860 PROD10C 10-yr wood product C gC/m^2 F - 861 PROD10C_LOSS loss from 10-yr wood product pool gC/m^2/s F - 862 PROD10N 10-yr wood product N gN/m^2 F - 863 PROD10N_LOSS loss from 10-yr wood product pool gN/m^2/s F - 864 PSNSHA shaded leaf photosynthesis umolCO2/m^2/s T - 865 PSNSHADE_TO_CPOOL C fixation from shaded canopy gC/m^2/s T - 866 PSNSUN sunlit leaf photosynthesis umolCO2/m^2/s T - 867 PSNSUN_TO_CPOOL C fixation from sunlit canopy gC/m^2/s T - 868 PSurf atmospheric pressure at surface (downscaled to columns in glacier regions) Pa F - 869 Q2M 2m specific humidity kg/kg T - 870 QAF canopy air humidity kg/kg F - 871 QBOT atmospheric specific humidity (downscaled to columns in glacier regions) kg/kg T - 872 QDIRECT_THROUGHFALL direct throughfall of liquid (rain + above-canopy irrigation) mm/s F - 873 QDIRECT_THROUGHFALL_SNOW direct throughfall of snow mm/s F - 874 QDRAI sub-surface drainage mm/s T - 875 QDRAI_PERCH perched wt drainage mm/s T - 876 QDRAI_XS saturation excess drainage mm/s T - 877 QDRIP rate of excess canopy liquid falling off canopy mm/s F - 878 QDRIP_SNOW rate of excess canopy snow falling off canopy mm/s F - 879 QFLOOD runoff from river flooding mm/s T - 880 QFLX_EVAP_TOT qflx_evap_soi + qflx_evap_can + qflx_tran_veg kg m-2 s-1 T - 881 QFLX_EVAP_VEG vegetation evaporation mm H2O/s F - 882 QFLX_ICE_DYNBAL ice dynamic land cover change conversion runoff flux mm/s T - 883 QFLX_LIQDEW_TO_TOP_LAYER rate of liquid water deposited on top soil or snow layer (dew) mm H2O/s T - 884 QFLX_LIQEVAP_FROM_TOP_LAYER rate of liquid water evaporated from top soil or snow layer mm H2O/s T - 885 QFLX_LIQ_DYNBAL liq dynamic land cover change conversion runoff flux mm/s T - 886 QFLX_LIQ_GRND liquid (rain+irrigation) on ground after interception mm H2O/s F - 887 QFLX_SNOW_DRAIN drainage from snow pack mm/s T - 888 QFLX_SNOW_DRAIN_ICE drainage from snow pack melt (ice landunits only) mm/s T - 889 QFLX_SNOW_GRND snow on ground after interception mm H2O/s F - 890 QFLX_SOLIDDEW_TO_TOP_LAYER rate of solid water deposited on top soil or snow layer (frost) mm H2O/s T - 891 QFLX_SOLIDEVAP_FROM_TOP_LAYER rate of ice evaporated from top soil or snow layer (sublimation) (also includes bare ice subli mm H2O/s T - 892 QFLX_SOLIDEVAP_FROM_TOP_LAYER_ICE rate of ice evaporated from top soil or snow layer (sublimation) (also includes bare ice subli mm H2O/s F - 893 QH2OSFC surface water runoff mm/s T - 894 QH2OSFC_TO_ICE surface water converted to ice mm/s F - 895 QHR hydraulic redistribution mm/s T - 896 QICE ice growth/melt mm/s T - 897 QICE_FORC qice forcing sent to GLC mm/s F - 898 QICE_FRZ ice growth mm/s T - 899 QICE_MELT ice melt mm/s T - 900 QINFL infiltration mm/s T - 901 QINTR interception mm/s T - 902 QIRRIG_DEMAND irrigation demand mm/s F - 903 QIRRIG_DRIP water added via drip irrigation mm/s F - 904 QIRRIG_FROM_GW_CONFINED water added through confined groundwater irrigation mm/s T - 905 QIRRIG_FROM_GW_UNCONFINED water added through unconfined groundwater irrigation mm/s T - 906 QIRRIG_FROM_SURFACE water added through surface water irrigation mm/s T - 907 QIRRIG_SPRINKLER water added via sprinkler irrigation mm/s F - 908 QOVER total surface runoff (includes QH2OSFC) mm/s T - 909 QOVER_LAG time-lagged surface runoff for soil columns mm/s F - 910 QPHSNEG net negative hydraulic redistribution flux mm/s F - 911 QRGWL surface runoff at glaciers (liquid only), wetlands, lakes; also includes melted ice runoff fro mm/s T - 912 QROOTSINK water flux from soil to root in each soil-layer mm/s F - 913 QRUNOFF total liquid runoff not including correction for land use change mm/s T - 914 QRUNOFF_ICE total liquid runoff not incl corret for LULCC (ice landunits only) mm/s T - 915 QRUNOFF_ICE_TO_COUPLER total ice runoff sent to coupler (includes corrections for land use change) mm/s T - 916 QRUNOFF_ICE_TO_LIQ liquid runoff from converted ice runoff mm/s F - 917 QRUNOFF_R Rural total runoff mm/s F - 918 QRUNOFF_TO_COUPLER total liquid runoff sent to coupler (includes corrections for land use change) mm/s T - 919 QRUNOFF_U Urban total runoff mm/s F - 920 QSNOCPLIQ excess liquid h2o due to snow capping not including correction for land use change mm H2O/s T - 921 QSNOEVAP evaporation from snow (only when snl<0, otherwise it is equal to qflx_ev_soil) mm/s T - 922 QSNOFRZ column-integrated snow freezing rate kg/m2/s T - 923 QSNOFRZ_ICE column-integrated snow freezing rate (ice landunits only) mm/s T - 924 QSNOMELT snow melt rate mm/s T - 925 QSNOMELT_ICE snow melt (ice landunits only) mm/s T - 926 QSNOUNLOAD canopy snow unloading mm/s T - 927 QSNO_TEMPUNLOAD canopy snow temp unloading mm/s T - 928 QSNO_WINDUNLOAD canopy snow wind unloading mm/s T - 929 QSNWCPICE excess solid h2o due to snow capping not including correction for land use change mm H2O/s T - 930 QSOIL Ground evaporation (soil/snow evaporation + soil/snow sublimation - dew) mm/s T - 931 QSOIL_ICE Ground evaporation (ice landunits only) mm/s T - 932 QTOPSOIL water input to surface mm/s F - 933 QVEGE canopy evaporation mm/s T - 934 QVEGT canopy transpiration mm/s T - 935 Qair atmospheric specific humidity (downscaled to columns in glacier regions) kg/kg F - 936 Qh sensible heat W/m^2 F - 937 Qle total evaporation W/m^2 F - 938 Qstor storage heat flux (includes snowmelt) W/m^2 F - 939 Qtau momentum flux kg/m/s^2 F - 940 RAH1 aerodynamical resistance s/m F - 941 RAH2 aerodynamical resistance s/m F - 942 RAIN atmospheric rain, after rain/snow repartitioning based on temperature mm/s T - 943 RAIN_FROM_ATM atmospheric rain received from atmosphere (pre-repartitioning) mm/s T - 944 RAIN_ICE atmospheric rain, after rain/snow repartitioning based on temperature (ice landunits only) mm/s F - 945 RAM1 aerodynamical resistance s/m F - 946 RAM_LAKE aerodynamic resistance for momentum (lakes only) s/m F - 947 RAW1 aerodynamical resistance s/m F - 948 RAW2 aerodynamical resistance s/m F - 949 RB leaf boundary resistance s/m F - 950 RB10 10 day running mean boundary layer resistance s/m F - 951 RETRANSN plant pool of retranslocated N gN/m^2 T - 952 RETRANSN_TO_NPOOL deployment of retranslocated N gN/m^2/s T - 953 RH atmospheric relative humidity % F - 954 RH2M 2m relative humidity % T - 955 RH2M_R Rural 2m specific humidity % F - 956 RH2M_U Urban 2m relative humidity % F - 957 RH30 30-day running mean of relative humidity % F - 958 RHAF fractional humidity of canopy air fraction F - 959 RHAF10 10 day running mean of fractional humidity of canopy air fraction F - 960 RH_LEAF fractional humidity at leaf surface fraction F - 961 ROOTR effective fraction of roots in each soil layer (SMS method) proportion F - 962 RR root respiration (fine root MR + total root GR) gC/m^2/s T - 963 RRESIS root resistance in each soil layer proportion F - 964 RSSHA shaded leaf stomatal resistance s/m T - 965 RSSUN sunlit leaf stomatal resistance s/m T - 966 Rainf atmospheric rain, after rain/snow repartitioning based on temperature mm/s F - 967 Rnet net radiation W/m^2 F - 968 SABG solar rad absorbed by ground W/m^2 T - 969 SABG_PEN Rural solar rad penetrating top soil or snow layer watt/m^2 T - 970 SABV solar rad absorbed by veg W/m^2 T - 971 SDATES Crop sowing dates in each calendar year day of year (julian day) F - 972 SDATES_PERHARV For each harvest in a calendar year, the Julian day the crop was sown day of year (julian day) F - 973 SEEDC pool for seeding new PFTs via dynamic landcover gC/m^2 T - 974 SEEDN pool for seeding new PFTs via dynamic landcover gN/m^2 T - 975 SLASH_HARVESTC slash harvest carbon (to litter) gC/m^2/s T - 976 SLO_SOMC SLO_SOM C gC/m^2 T - 977 SLO_SOMC_1m SLO_SOM C to 1 meter gC/m^2 F - 978 SLO_SOMC_TNDNCY_VERT_TRA slow soil organic ma C tendency due to vertical transport gC/m^3/s F - 979 SLO_SOMC_TO_ACT_SOMC decomp. of slow soil organic ma C to active soil organic C gC/m^2/s F - 980 SLO_SOMC_TO_ACT_SOMC_vr decomp. of slow soil organic ma C to active soil organic C gC/m^3/s F - 981 SLO_SOMC_TO_PAS_SOMC decomp. of slow soil organic ma C to passive soil organic C gC/m^2/s F - 982 SLO_SOMC_TO_PAS_SOMC_vr decomp. of slow soil organic ma C to passive soil organic C gC/m^3/s F - 983 SLO_SOMC_vr SLO_SOM C (vertically resolved) gC/m^3 T - 984 SLO_SOMN SLO_SOM N gN/m^2 T - 985 SLO_SOMN_1m SLO_SOM N to 1 meter gN/m^2 F - 986 SLO_SOMN_TNDNCY_VERT_TRA slow soil organic ma N tendency due to vertical transport gN/m^3/s F - 987 SLO_SOMN_TO_ACT_SOMN decomp. of slow soil organic ma N to active soil organic N gN/m^2 F - 988 SLO_SOMN_TO_ACT_SOMN_vr decomp. of slow soil organic ma N to active soil organic N gN/m^3 F - 989 SLO_SOMN_TO_PAS_SOMN decomp. of slow soil organic ma N to passive soil organic N gN/m^2 F - 990 SLO_SOMN_TO_PAS_SOMN_vr decomp. of slow soil organic ma N to passive soil organic N gN/m^3 F - 991 SLO_SOMN_vr SLO_SOM N (vertically resolved) gN/m^3 T - 992 SLO_SOM_HR_S1 Het. Resp. from slow soil organic ma gC/m^2/s F - 993 SLO_SOM_HR_S1_vr Het. Resp. from slow soil organic ma gC/m^3/s F - 994 SLO_SOM_HR_S3 Het. Resp. from slow soil organic ma gC/m^2/s F - 995 SLO_SOM_HR_S3_vr Het. Resp. from slow soil organic ma gC/m^3/s F - 996 SMINN soil mineral N gN/m^2 T - 997 SMINN_TO_NPOOL deployment of soil mineral N uptake gN/m^2/s T - 998 SMINN_TO_PLANT plant uptake of soil mineral N gN/m^2/s T - 999 SMINN_TO_PLANT_FUN Total soil N uptake of FUN gN/m^2/s T -1000 SMINN_TO_PLANT_vr plant uptake of soil mineral N gN/m^3/s F -1001 SMINN_TO_S1N_L1 mineral N flux for decomp. of MET_LITto ACT_SOM gN/m^2 F -1002 SMINN_TO_S1N_L1_vr mineral N flux for decomp. of MET_LITto ACT_SOM gN/m^3 F -1003 SMINN_TO_S1N_L2 mineral N flux for decomp. of CEL_LITto ACT_SOM gN/m^2 F -1004 SMINN_TO_S1N_L2_vr mineral N flux for decomp. of CEL_LITto ACT_SOM gN/m^3 F -1005 SMINN_TO_S1N_S2 mineral N flux for decomp. of SLO_SOMto ACT_SOM gN/m^2 F -1006 SMINN_TO_S1N_S2_vr mineral N flux for decomp. of SLO_SOMto ACT_SOM gN/m^3 F -1007 SMINN_TO_S1N_S3 mineral N flux for decomp. of PAS_SOMto ACT_SOM gN/m^2 F -1008 SMINN_TO_S1N_S3_vr mineral N flux for decomp. of PAS_SOMto ACT_SOM gN/m^3 F -1009 SMINN_TO_S2N_L3 mineral N flux for decomp. of LIG_LITto SLO_SOM gN/m^2 F -1010 SMINN_TO_S2N_L3_vr mineral N flux for decomp. of LIG_LITto SLO_SOM gN/m^3 F -1011 SMINN_TO_S2N_S1 mineral N flux for decomp. of ACT_SOMto SLO_SOM gN/m^2 F -1012 SMINN_TO_S2N_S1_vr mineral N flux for decomp. of ACT_SOMto SLO_SOM gN/m^3 F -1013 SMINN_TO_S3N_S1 mineral N flux for decomp. of ACT_SOMto PAS_SOM gN/m^2 F -1014 SMINN_TO_S3N_S1_vr mineral N flux for decomp. of ACT_SOMto PAS_SOM gN/m^3 F -1015 SMINN_TO_S3N_S2 mineral N flux for decomp. of SLO_SOMto PAS_SOM gN/m^2 F -1016 SMINN_TO_S3N_S2_vr mineral N flux for decomp. of SLO_SOMto PAS_SOM gN/m^3 F -1017 SMINN_vr soil mineral N gN/m^3 T -1018 SMIN_NH4 soil mineral NH4 gN/m^2 T -1019 SMIN_NH4_TO_PLANT plant uptake of NH4 gN/m^3/s F -1020 SMIN_NH4_vr soil mineral NH4 (vert. res.) gN/m^3 T -1021 SMIN_NO3 soil mineral NO3 gN/m^2 T -1022 SMIN_NO3_LEACHED soil NO3 pool loss to leaching gN/m^2/s T -1023 SMIN_NO3_LEACHED_vr soil NO3 pool loss to leaching gN/m^3/s F -1024 SMIN_NO3_MASSDENS SMIN_NO3_MASSDENS ugN/cm^3 soil F -1025 SMIN_NO3_RUNOFF soil NO3 pool loss to runoff gN/m^2/s T -1026 SMIN_NO3_RUNOFF_vr soil NO3 pool loss to runoff gN/m^3/s F -1027 SMIN_NO3_TO_PLANT plant uptake of NO3 gN/m^3/s F -1028 SMIN_NO3_vr soil mineral NO3 (vert. res.) gN/m^3 T -1029 SMP soil matric potential (natural vegetated and crop landunits only) mm T -1030 SNOBCMCL mass of BC in snow column kg/m2 T -1031 SNOBCMSL mass of BC in top snow layer kg/m2 T -1032 SNOCAN intercepted snow mm T -1033 SNODSTMCL mass of dust in snow column kg/m2 T -1034 SNODSTMSL mass of dust in top snow layer kg/m2 T -1035 SNOFSDSND direct nir incident solar radiation on snow W/m^2 F -1036 SNOFSDSNI diffuse nir incident solar radiation on snow W/m^2 F -1037 SNOFSDSVD direct vis incident solar radiation on snow W/m^2 F -1038 SNOFSDSVI diffuse vis incident solar radiation on snow W/m^2 F -1039 SNOFSRND direct nir reflected solar radiation from snow W/m^2 T -1040 SNOFSRNI diffuse nir reflected solar radiation from snow W/m^2 T -1041 SNOFSRVD direct vis reflected solar radiation from snow W/m^2 T -1042 SNOFSRVI diffuse vis reflected solar radiation from snow W/m^2 T -1043 SNOINTABS Fraction of incoming solar absorbed by lower snow layers - T -1044 SNOLIQFL top snow layer liquid water fraction (land) fraction F -1045 SNOOCMCL mass of OC in snow column kg/m2 T -1046 SNOOCMSL mass of OC in top snow layer kg/m2 T -1047 SNORDSL top snow layer effective grain radius m^-6 F -1048 SNOTTOPL snow temperature (top layer) K F -1049 SNOTTOPL_ICE snow temperature (top layer, ice landunits only) K F -1050 SNOTXMASS snow temperature times layer mass, layer sum; to get mass-weighted temperature, divide by (SNO K kg/m2 T -1051 SNOTXMASS_ICE snow temperature times layer mass, layer sum (ice landunits only); to get mass-weighted temper K kg/m2 F -1052 SNOW atmospheric snow, after rain/snow repartitioning based on temperature mm/s T -1053 SNOWDP gridcell mean snow height m T -1054 SNOWICE snow ice kg/m2 T -1055 SNOWICE_ICE snow ice (ice landunits only) kg/m2 F -1056 SNOWLIQ snow liquid water kg/m2 T -1057 SNOWLIQ_ICE snow liquid water (ice landunits only) kg/m2 F -1058 SNOW_5D 5day snow avg m F -1059 SNOW_DEPTH snow height of snow covered area m T -1060 SNOW_DEPTH_ICE snow height of snow covered area (ice landunits only) m F -1061 SNOW_FROM_ATM atmospheric snow received from atmosphere (pre-repartitioning) mm/s T -1062 SNOW_ICE atmospheric snow, after rain/snow repartitioning based on temperature (ice landunits only) mm/s F -1063 SNOW_PERSISTENCE Length of time of continuous snow cover (nat. veg. landunits only) seconds T -1064 SNOW_SINKS snow sinks (liquid water) mm/s T -1065 SNOW_SOURCES snow sources (liquid water) mm/s T -1066 SNO_ABS Absorbed solar radiation in each snow layer W/m^2 F -1067 SNO_ABS_ICE Absorbed solar radiation in each snow layer (ice landunits only) W/m^2 F -1068 SNO_BW Partial density of water in the snow pack (ice + liquid) kg/m3 F -1069 SNO_BW_ICE Partial density of water in the snow pack (ice + liquid, ice landunits only) kg/m3 F -1070 SNO_EXISTENCE Fraction of averaging period for which each snow layer existed unitless F -1071 SNO_FRZ snow freezing rate in each snow layer kg/m2/s F -1072 SNO_FRZ_ICE snow freezing rate in each snow layer (ice landunits only) mm/s F -1073 SNO_GS Mean snow grain size Microns F -1074 SNO_GS_ICE Mean snow grain size (ice landunits only) Microns F -1075 SNO_ICE Snow ice content kg/m2 F -1076 SNO_LIQH2O Snow liquid water content kg/m2 F -1077 SNO_MELT snow melt rate in each snow layer mm/s F -1078 SNO_MELT_ICE snow melt rate in each snow layer (ice landunits only) mm/s F -1079 SNO_T Snow temperatures K F -1080 SNO_TK Thermal conductivity W/m-K F -1081 SNO_TK_ICE Thermal conductivity (ice landunits only) W/m-K F -1082 SNO_T_ICE Snow temperatures (ice landunits only) K F -1083 SNO_Z Snow layer thicknesses m F -1084 SNO_Z_ICE Snow layer thicknesses (ice landunits only) m F -1085 SNOdTdzL top snow layer temperature gradient (land) K/m F -1086 SOIL10 10-day running mean of 12cm layer soil K F -1087 SOILC_CHANGE C change in soil gC/m^2/s T -1088 SOILC_HR soil C heterotrophic respiration gC/m^2/s T -1089 SOILC_vr SOIL C (vertically resolved) gC/m^3 T -1090 SOILICE soil ice (natural vegetated and crop landunits only) kg/m2 T -1091 SOILLIQ soil liquid water (natural vegetated and crop landunits only) kg/m2 T -1092 SOILN_vr SOIL N (vertically resolved) gN/m^3 T -1093 SOILPSI soil water potential in each soil layer MPa F -1094 SOILRESIS soil resistance to evaporation s/m T -1095 SOILWATER_10CM soil liquid water + ice in top 10cm of soil (veg landunits only) kg/m2 T -1096 SOMC_FIRE C loss due to peat burning gC/m^2/s T -1097 SOMFIRE soil organic matter fire losses gC/m^2/s F -1098 SOM_ADV_COEF advection term for vertical SOM translocation m/s F -1099 SOM_C_LEACHED total flux of C from SOM pools due to leaching gC/m^2/s T -1100 SOM_DIFFUS_COEF diffusion coefficient for vertical SOM translocation m^2/s F -1101 SOM_N_LEACHED total flux of N from SOM pools due to leaching gN/m^2/s F -1102 SOWING_REASON For each sowing in a calendar year, the reason the crop was sown categorical F -1103 SOWING_REASON_PERHARV For each harvest in a calendar year, the reason the crop was sown categorical F -1104 SR total soil respiration (HR + root resp) gC/m^2/s T -1105 SSRE_FSR surface snow effect on reflected solar radiation W/m^2 T -1106 SSRE_FSRND surface snow effect on direct nir reflected solar radiation W/m^2 T -1107 SSRE_FSRNDLN surface snow effect on direct nir reflected solar radiation at local noon W/m^2 T -1108 SSRE_FSRNI surface snow effect on diffuse nir reflected solar radiation W/m^2 T -1109 SSRE_FSRVD surface snow radiatve effect on direct vis reflected solar radiation W/m^2 T -1110 SSRE_FSRVDLN surface snow radiatve effect on direct vis reflected solar radiation at local noon W/m^2 T -1111 SSRE_FSRVI surface snow radiatve effect on diffuse vis reflected solar radiation W/m^2 T -1112 STEM_PROF profile for litter C and N inputs from stems 1/m F -1113 STORAGE_CDEMAND C use from the C storage pool gC/m^2 F -1114 STORAGE_GR growth resp for growth sent to storage for later display gC/m^2/s F -1115 STORAGE_NDEMAND N demand during the offset period gN/m^2 F -1116 STORVEGC stored vegetation carbon, excluding cpool gC/m^2 T -1117 STORVEGN stored vegetation nitrogen gN/m^2 T -1118 SUPPLEMENT_TO_SMINN supplemental N supply gN/m^2/s T -1119 SUPPLEMENT_TO_SMINN_vr supplemental N supply gN/m^3/s F -1120 SYEARS_PERHARV For each harvest in a calendar year, the year the crop was sown year F -1121 SWBGT 2 m Simplified Wetbulb Globe Temp C T -1122 SWBGT_R Rural 2 m Simplified Wetbulb Globe Temp C T -1123 SWBGT_U Urban 2 m Simplified Wetbulb Globe Temp C T -1124 SWMP65 2 m Swamp Cooler Temp 65% Eff C T -1125 SWMP65_R Rural 2 m Swamp Cooler Temp 65% Eff C T -1126 SWMP65_U Urban 2 m Swamp Cooler Temp 65% Eff C T -1127 SWMP80 2 m Swamp Cooler Temp 80% Eff C T -1128 SWMP80_R Rural 2 m Swamp Cooler Temp 80% Eff C T -1129 SWMP80_U Urban 2 m Swamp Cooler Temp 80% Eff C T -1130 SWdown atmospheric incident solar radiation W/m^2 F -1131 SWup upwelling shortwave radiation W/m^2 F -1132 SoilAlpha factor limiting ground evap unitless F -1133 SoilAlpha_U urban factor limiting ground evap unitless F -1134 T10 10-day running mean of 2-m temperature K F -1135 TAF canopy air temperature K F -1136 TAUX zonal surface stress kg/m/s^2 T -1137 TAUY meridional surface stress kg/m/s^2 T -1138 TBOT atmospheric air temperature (downscaled to columns in glacier regions) K T -1139 TBUILD internal urban building air temperature K T -1140 TBUILD_MAX prescribed maximum interior building temperature K F -1141 TEMPAVG_T2M temporary average 2m air temperature K F -1142 TEMPMAX_RETRANSN temporary annual max of retranslocated N pool gN/m^2 F -1143 TEMPSUM_POTENTIAL_GPP temporary annual sum of potential GPP gC/m^2/yr F -1144 TEQ 2 m Equiv Temp K T -1145 TEQ_R Rural 2 m Equiv Temp K T -1146 TEQ_U Urban 2 m Equiv Temp K T -1147 TFLOOR floor temperature K F -1148 TG ground temperature K T -1149 TG_ICE ground temperature (ice landunits only) K F -1150 TG_R Rural ground temperature K F -1151 TG_U Urban ground temperature K F -1152 TH2OSFC surface water temperature K T -1153 THBOT atmospheric air potential temperature (downscaled to columns in glacier regions) K T -1154 THIC 2 m Temp Hum Index Comfort C T -1155 THIC_R Rural 2 m Temp Hum Index Comfort C T -1156 THIC_U Urban 2 m Temp Hum Index Comfort C T -1157 THIP 2 m Temp Hum Index Physiology C T -1158 THIP_R Rural 2 m Temp Hum Index Physiology C T -1159 THIP_U Urban 2 m Temp Hum Index Physiology C T -1160 TKE1 top lake level eddy thermal conductivity W/(mK) T -1161 TLAI total projected leaf area index m^2/m^2 T -1162 TLAKE lake temperature K T -1163 TOPO_COL column-level topographic height m F -1164 TOPO_COL_ICE column-level topographic height (ice landunits only) m F -1165 TOPO_FORC topograephic height sent to GLC m F -1166 TOPT topt coefficient for VOC calc non F -1167 TOTCOLC total column carbon, incl veg and cpool but excl product pools gC/m^2 T -1168 TOTCOLCH4 total belowground CH4 (0 for non-lake special landunits in the absence of dynamic landunits) gC/m2 T -1169 TOTCOLN total column-level N, excluding product pools gN/m^2 T -1170 TOTECOSYSC total ecosystem carbon, incl veg but excl cpool and product pools gC/m^2 T -1171 TOTECOSYSN total ecosystem N, excluding product pools gN/m^2 T -1172 TOTFIRE total ecosystem fire losses gC/m^2/s F -1173 TOTLITC total litter carbon gC/m^2 T -1174 TOTLITC_1m total litter carbon to 1 meter depth gC/m^2 T -1175 TOTLITN total litter N gN/m^2 T -1176 TOTLITN_1m total litter N to 1 meter gN/m^2 T -1177 TOTPFTC total patch-level carbon, including cpool gC/m^2 T -1178 TOTPFTN total patch-level nitrogen gN/m^2 T -1179 TOTSOILICE vertically summed soil cie (veg landunits only) kg/m2 T -1180 TOTSOILLIQ vertically summed soil liquid water (veg landunits only) kg/m2 T -1181 TOTSOMC total soil organic matter carbon gC/m^2 T -1182 TOTSOMC_1m total soil organic matter carbon to 1 meter depth gC/m^2 T -1183 TOTSOMN total soil organic matter N gN/m^2 T -1184 TOTSOMN_1m total soil organic matter N to 1 meter gN/m^2 T -1185 TOTVEGC total vegetation carbon, excluding cpool gC/m^2 T -1186 TOTVEGN total vegetation nitrogen gN/m^2 T -1187 TOT_WOODPRODC total wood product C gC/m^2 T -1188 TOT_WOODPRODC_LOSS total loss from wood product pools gC/m^2/s T -1189 TOT_WOODPRODN total wood product N gN/m^2 T -1190 TOT_WOODPRODN_LOSS total loss from wood product pools gN/m^2/s T -1191 TPU25T canopy profile of tpu umol/m2/s T -1192 TRAFFICFLUX sensible heat flux from urban traffic W/m^2 F -1193 TRANSFER_DEADCROOT_GR dead coarse root growth respiration from storage gC/m^2/s F -1194 TRANSFER_DEADSTEM_GR dead stem growth respiration from storage gC/m^2/s F -1195 TRANSFER_FROOT_GR fine root growth respiration from storage gC/m^2/s F -1196 TRANSFER_GR growth resp for transfer growth displayed in this timestep gC/m^2/s F -1197 TRANSFER_LEAF_GR leaf growth respiration from storage gC/m^2/s F -1198 TRANSFER_LIVECROOT_GR live coarse root growth respiration from storage gC/m^2/s F -1199 TRANSFER_LIVESTEM_GR live stem growth respiration from storage gC/m^2/s F -1200 TREFMNAV daily minimum of average 2-m temperature K T -1201 TREFMNAV_R Rural daily minimum of average 2-m temperature K F -1202 TREFMNAV_U Urban daily minimum of average 2-m temperature K F -1203 TREFMXAV daily maximum of average 2-m temperature K T -1204 TREFMXAV_R Rural daily maximum of average 2-m temperature K F -1205 TREFMXAV_U Urban daily maximum of average 2-m temperature K F -1206 TROOF_INNER roof inside surface temperature K F -1207 TSA 2m air temperature K T -1208 TSAI total projected stem area index m^2/m^2 T -1209 TSA_ICE 2m air temperature (ice landunits only) K F -1210 TSA_R Rural 2m air temperature K F -1211 TSA_U Urban 2m air temperature K F -1212 TSHDW_INNER shadewall inside surface temperature K F -1213 TSKIN skin temperature K T -1214 TSL temperature of near-surface soil layer (natural vegetated and crop landunits only) K T -1215 TSOI soil temperature (natural vegetated and crop landunits only) K T -1216 TSOI_10CM soil temperature in top 10cm of soil K T -1217 TSOI_ICE soil temperature (ice landunits only) K T -1218 TSRF_FORC surface temperature sent to GLC K F -1219 TSUNW_INNER sunwall inside surface temperature K F -1220 TV vegetation temperature K T -1221 TV24 vegetation temperature (last 24hrs) K F -1222 TV240 vegetation temperature (last 240hrs) K F -1223 TVEGD10 10 day running mean of patch daytime vegetation temperature Kelvin F -1224 TVEGN10 10 day running mean of patch night-time vegetation temperature Kelvin F -1225 TWS total water storage mm T -1226 T_SCALAR temperature inhibition of decomposition unitless T -1227 Tair atmospheric air temperature (downscaled to columns in glacier regions) K F -1228 Tair_from_atm atmospheric air temperature received from atmosphere (pre-downscaling) K F -1229 U10 10-m wind m/s T -1230 U10_DUST 10-m wind for dust model m/s T -1231 U10_ICE 10-m wind (ice landunits only) m/s F -1232 UAF canopy air speed m/s F -1233 ULRAD upward longwave radiation above the canopy W/m^2 F -1234 UM wind speed plus stability effect m/s F -1235 URBAN_AC urban air conditioning flux W/m^2 T -1236 URBAN_HEAT urban heating flux W/m^2 T -1237 USTAR aerodynamical resistance s/m F -1238 UST_LAKE friction velocity (lakes only) m/s F -1239 VA atmospheric wind speed plus convective velocity m/s F -1240 VCMX25T canopy profile of vcmax25 umol/m2/s T -1241 VEGWP vegetation water matric potential for sun/sha canopy,xyl,root segments mm T -1242 VEGWPLN vegetation water matric potential for sun/sha canopy,xyl,root at local noon mm T -1243 VEGWPPD predawn vegetation water matric potential for sun/sha canopy,xyl,root mm T -1244 VOCFLXT total VOC flux into atmosphere moles/m2/sec F -1245 VOLR river channel total water storage m3 T -1246 VOLRMCH river channel main channel water storage m3 T -1247 VPD vpd Pa F -1248 VPD2M 2m vapor pressure deficit Pa T -1249 VPD_CAN canopy vapor pressure deficit kPa T -1250 Vcmx25Z canopy profile of vcmax25 predicted by LUNA model umol/m2/s T -1251 WASTEHEAT sensible heat flux from heating/cooling sources of urban waste heat W/m^2 T -1252 WBA 2 m Wet Bulb C T -1253 WBA_R Rural 2 m Wet Bulb C T -1254 WBA_U Urban 2 m Wet Bulb C T -1255 WBT 2 m Stull Wet Bulb C T -1256 WBT_R Rural 2 m Stull Wet Bulb C T -1257 WBT_U Urban 2 m Stull Wet Bulb C T -1258 WF soil water as frac. of whc for top 0.05 m proportion F -1259 WFPS WFPS percent F -1260 WIND atmospheric wind velocity magnitude m/s T -1261 WOODC wood C gC/m^2 T -1262 WOODC_ALLOC wood C eallocation gC/m^2/s T -1263 WOODC_LOSS wood C loss gC/m^2/s T -1264 WOOD_HARVESTC wood harvest carbon (to product pools) gC/m^2/s T -1265 WOOD_HARVESTN wood harvest N (to product pools) gN/m^2/s T -1266 WTGQ surface tracer conductance m/s T -1267 W_SCALAR Moisture (dryness) inhibition of decomposition unitless T -1268 Wind atmospheric wind velocity magnitude m/s F -1269 XSMRPOOL temporary photosynthate C pool gC/m^2 T -1270 XSMRPOOL_LOSS temporary photosynthate C pool loss gC/m^2 F -1271 XSMRPOOL_RECOVER C flux assigned to recovery of negative xsmrpool gC/m^2/s T -1272 Z0HG roughness length over ground, sensible heat m F -1273 Z0HV roughness length over vegetation, sensible heat m F -1274 Z0M momentum roughness length m F -1275 Z0MG roughness length over ground, momentum m F -1276 Z0MV roughness length over vegetation, momentum m F -1277 Z0M_TO_COUPLER roughness length, momentum: gridcell average sent to coupler m F -1278 Z0QG roughness length over ground, latent heat m F -1279 Z0QV roughness length over vegetation, latent heat m F -1280 ZBOT atmospheric reference height m T -1281 ZETA dimensionless stability parameter unitless F -1282 ZII convective boundary height m F -1283 ZWT water table depth (natural vegetated and crop landunits only) m T -1284 ZWT_CH4_UNSAT depth of water table for methane production used in non-inundated area m T -1285 ZWT_PERCH perched water table depth (natural vegetated and crop landunits only) m T -1286 anaerobic_frac anaerobic_frac m3/m3 F -1287 bsw clap and hornberger B unitless F -1288 currentPatch currentPatch coefficient for VOC calc non F -1289 diffus diffusivity m^2/s F -1290 fr_WFPS fr_WFPS fraction F -1291 n2_n2o_ratio_denit n2_n2o_ratio_denit gN/gN F -1292 num_iter number of iterations unitless F -1293 r_psi r_psi m F -1294 ratio_k1 ratio_k1 none F -1295 ratio_no3_co2 ratio_no3_co2 ratio F -1296 soil_bulkdensity soil_bulkdensity kg/m3 F -1297 soil_co2_prod soil_co2_prod ug C / g soil / day F -1298 watfc water field capacity m^3/m^3 F -1299 watsat water saturated m^3/m^3 F +A10TMIN 10-day running mean of min 2-m temperature K F +A5TMIN 5-day running mean of min 2-m temperature K F +ACTUAL_IMMOB actual N immobilization gN/m^2/s T +ACTUAL_IMMOB_NH4 immobilization of NH4 gN/m^3/s F +ACTUAL_IMMOB_NO3 immobilization of NO3 gN/m^3/s F +ACTUAL_IMMOB_vr actual N immobilization gN/m^3/s F +ACT_SOMC ACT_SOM C gC/m^2 T +ACT_SOMC_1m ACT_SOM C to 1 meter gC/m^2 F +ACT_SOMC_TNDNCY_VERT_TRA active soil organic C tendency due to vertical transport gC/m^3/s F +ACT_SOMC_TO_PAS_SOMC decomp. of active soil organic C to passive soil organic C gC/m^2/s F +ACT_SOMC_TO_PAS_SOMC_vr decomp. of active soil organic C to passive soil organic C gC/m^3/s F +ACT_SOMC_TO_SLO_SOMC decomp. of active soil organic C to slow soil organic ma C gC/m^2/s F +ACT_SOMC_TO_SLO_SOMC_vr decomp. of active soil organic C to slow soil organic ma C gC/m^3/s F +ACT_SOMC_vr ACT_SOM C (vertically resolved) gC/m^3 T +ACT_SOMN ACT_SOM N gN/m^2 T +ACT_SOMN_1m ACT_SOM N to 1 meter gN/m^2 F +ACT_SOMN_TNDNCY_VERT_TRA active soil organic N tendency due to vertical transport gN/m^3/s F +ACT_SOMN_TO_PAS_SOMN decomp. of active soil organic N to passive soil organic N gN/m^2 F +ACT_SOMN_TO_PAS_SOMN_vr decomp. of active soil organic N to passive soil organic N gN/m^3 F +ACT_SOMN_TO_SLO_SOMN decomp. of active soil organic N to slow soil organic ma N gN/m^2 F +ACT_SOMN_TO_SLO_SOMN_vr decomp. of active soil organic N to slow soil organic ma N gN/m^3 F +ACT_SOMN_vr ACT_SOM N (vertically resolved) gN/m^3 T +ACT_SOM_HR_S2 Het. Resp. from active soil organic gC/m^2/s F +ACT_SOM_HR_S2_vr Het. Resp. from active soil organic gC/m^3/s F +ACT_SOM_HR_S3 Het. Resp. from active soil organic gC/m^2/s F +ACT_SOM_HR_S3_vr Het. Resp. from active soil organic gC/m^3/s F +AGLB Aboveground leaf biomass kg/m^2 F +AGNPP aboveground NPP gC/m^2/s T +AGSB Aboveground stem biomass kg/m^2 F +ALBD surface albedo (direct) proportion T +ALBDSF diagnostic snow-free surface albedo (direct) proportion T +ALBGRD ground albedo (direct) proportion F +ALBGRI ground albedo (indirect) proportion F +ALBI surface albedo (indirect) proportion T +ALBISF diagnostic snow-free surface albedo (indirect) proportion T +ALPHA alpha coefficient for VOC calc non F +ALT current active layer thickness m T +ALTMAX maximum annual active layer thickness m T +ALTMAX_LASTYEAR maximum prior year active layer thickness m F +ANNAVG_T2M annual average 2m air temperature K F +ANNMAX_RETRANSN annual max of retranslocated N pool gN/m^2 F +ANNSUM_COUNTER seconds since last annual accumulator turnover s F +ANNSUM_NPP annual sum of NPP gC/m^2/yr F +ANNSUM_POTENTIAL_GPP annual sum of potential GPP gN/m^2/yr F +APPAR_TEMP 2 m apparent temperature C T +APPAR_TEMP_R Rural 2 m apparent temperature C T +APPAR_TEMP_U Urban 2 m apparent temperature C T +AR autotrophic respiration (MR + GR) gC/m^2/s T +ATM_TOPO atmospheric surface height m T +AVAILC C flux available for allocation gC/m^2/s F +AVAIL_RETRANSN N flux available from retranslocation pool gN/m^2/s F +AnnET Annual ET mm/s F +BAF_CROP fractional area burned for crop s-1 T +BAF_PEATF fractional area burned in peatland s-1 T +BCDEP total BC deposition (dry+wet) from atmosphere kg/m^2/s T +BETA coefficient of convective velocity none F +BGLFR background litterfall rate 1/s F +BGNPP belowground NPP gC/m^2/s T +BGTR background transfer growth rate 1/s F +BTRANMN daily minimum of transpiration beta factor unitless T +CANNAVG_T2M annual average of 2m air temperature K F +CANNSUM_NPP annual sum of column-level NPP gC/m^2/s F +CEL_LITC CEL_LIT C gC/m^2 T +CEL_LITC_1m CEL_LIT C to 1 meter gC/m^2 F +CEL_LITC_TNDNCY_VERT_TRA cellulosic litter C tendency due to vertical transport gC/m^3/s F +CEL_LITC_TO_ACT_SOMC decomp. of cellulosic litter C to active soil organic C gC/m^2/s F +CEL_LITC_TO_ACT_SOMC_vr decomp. of cellulosic litter C to active soil organic C gC/m^3/s F +CEL_LITC_vr CEL_LIT C (vertically resolved) gC/m^3 T +CEL_LITN CEL_LIT N gN/m^2 T +CEL_LITN_1m CEL_LIT N to 1 meter gN/m^2 F +CEL_LITN_TNDNCY_VERT_TRA cellulosic litter N tendency due to vertical transport gN/m^3/s F +CEL_LITN_TO_ACT_SOMN decomp. of cellulosic litter N to active soil organic N gN/m^2 F +CEL_LITN_TO_ACT_SOMN_vr decomp. of cellulosic litter N to active soil organic N gN/m^3 F +CEL_LITN_vr CEL_LIT N (vertically resolved) gN/m^3 T +CEL_LIT_HR Het. Resp. from cellulosic litter gC/m^2/s F +CEL_LIT_HR_vr Het. Resp. from cellulosic litter gC/m^3/s F +CGRND deriv. of soil energy flux wrt to soil temp W/m^2/K F +CGRNDL deriv. of soil latent heat flux wrt soil temp W/m^2/K F +CGRNDS deriv. of soil sensible heat flux wrt soil temp W/m^2/K F +CH4PROD Gridcell total production of CH4 gC/m2/s T +CH4_EBUL_TOTAL_SAT ebullition surface CH4 flux; (+ to atm) mol/m2/s F +CH4_EBUL_TOTAL_UNSAT ebullition surface CH4 flux; (+ to atm) mol/m2/s F +CH4_SURF_AERE_SAT aerenchyma surface CH4 flux for inundated area; (+ to atm) mol/m2/s T +CH4_SURF_AERE_UNSAT aerenchyma surface CH4 flux for non-inundated area; (+ to atm) mol/m2/s T +CH4_SURF_DIFF_SAT diffusive surface CH4 flux for inundated / lake area; (+ to atm) mol/m2/s T +CH4_SURF_DIFF_UNSAT diffusive surface CH4 flux for non-inundated area; (+ to atm) mol/m2/s T +CH4_SURF_EBUL_SAT ebullition surface CH4 flux for inundated / lake area; (+ to atm) mol/m2/s T +CH4_SURF_EBUL_UNSAT ebullition surface CH4 flux for non-inundated area; (+ to atm) mol/m2/s T +COL_CTRUNC column-level sink for C truncation gC/m^2 F +COL_FIRE_CLOSS total column-level fire C loss for non-peat fires outside land-type converted region gC/m^2/s T +COL_FIRE_NLOSS total column-level fire N loss gN/m^2/s T +COL_NTRUNC column-level sink for N truncation gN/m^2 F +CONC_CH4_SAT CH4 soil Concentration for inundated / lake area mol/m3 F +CONC_CH4_UNSAT CH4 soil Concentration for non-inundated area mol/m3 F +CONC_O2_SAT O2 soil Concentration for inundated / lake area mol/m3 T +CONC_O2_UNSAT O2 soil Concentration for non-inundated area mol/m3 T +COST_NACTIVE Cost of active uptake gN/gC T +COST_NFIX Cost of fixation gN/gC T +COST_NRETRANS Cost of retranslocation gN/gC T +COSZEN cosine of solar zenith angle none F +CPHASE crop phenology phase 0-not planted, 1-planted, 2-leaf emerge, 3-grain fill, 4-harvest T +CPOOL temporary photosynthate C pool gC/m^2 T +CPOOL_DEADCROOT_GR dead coarse root growth respiration gC/m^2/s F +CPOOL_DEADCROOT_STORAGE_GR dead coarse root growth respiration to storage gC/m^2/s F +CPOOL_DEADSTEM_GR dead stem growth respiration gC/m^2/s F +CPOOL_DEADSTEM_STORAGE_GR dead stem growth respiration to storage gC/m^2/s F +CPOOL_FROOT_GR fine root growth respiration gC/m^2/s F +CPOOL_FROOT_STORAGE_GR fine root growth respiration to storage gC/m^2/s F +CPOOL_LEAF_GR leaf growth respiration gC/m^2/s F +CPOOL_LEAF_STORAGE_GR leaf growth respiration to storage gC/m^2/s F +CPOOL_LIVECROOT_GR live coarse root growth respiration gC/m^2/s F +CPOOL_LIVECROOT_STORAGE_GR live coarse root growth respiration to storage gC/m^2/s F +CPOOL_LIVESTEM_GR live stem growth respiration gC/m^2/s F +CPOOL_LIVESTEM_STORAGE_GR live stem growth respiration to storage gC/m^2/s F +CPOOL_TO_DEADCROOTC allocation to dead coarse root C gC/m^2/s F +CPOOL_TO_DEADCROOTC_STORAGE allocation to dead coarse root C storage gC/m^2/s F +CPOOL_TO_DEADSTEMC allocation to dead stem C gC/m^2/s F +CPOOL_TO_DEADSTEMC_STORAGE allocation to dead stem C storage gC/m^2/s F +CPOOL_TO_FROOTC allocation to fine root C gC/m^2/s F +CPOOL_TO_FROOTC_STORAGE allocation to fine root C storage gC/m^2/s F +CPOOL_TO_GRESP_STORAGE allocation to growth respiration storage gC/m^2/s F +CPOOL_TO_LEAFC allocation to leaf C gC/m^2/s F +CPOOL_TO_LEAFC_STORAGE allocation to leaf C storage gC/m^2/s F +CPOOL_TO_LIVECROOTC allocation to live coarse root C gC/m^2/s F +CPOOL_TO_LIVECROOTC_STORAGE allocation to live coarse root C storage gC/m^2/s F +CPOOL_TO_LIVESTEMC allocation to live stem C gC/m^2/s F +CPOOL_TO_LIVESTEMC_STORAGE allocation to live stem C storage gC/m^2/s F +CROOT_PROF profile for litter C and N inputs from coarse roots 1/m F +CROPPROD1C 1-yr crop product (grain+biofuel) C gC/m^2 T +CROPPROD1C_LOSS loss from 1-yr crop product pool gC/m^2/s T +CROPPROD1N 1-yr crop product (grain+biofuel) N gN/m^2 T +CROPPROD1N_LOSS loss from 1-yr crop product pool gN/m^2/s T +CROPSEEDC_DEFICIT C used for crop seed that needs to be repaid gC/m^2 T +CROPSEEDN_DEFICIT N used for crop seed that needs to be repaid gN/m^2 F +CROP_SEEDC_TO_LEAF crop seed source to leaf gC/m^2/s F +CROP_SEEDN_TO_LEAF crop seed source to leaf gN/m^2/s F +CURRENT_GR growth resp for new growth displayed in this timestep gC/m^2/s F +CWDC CWD C gC/m^2 T +CWDC_1m CWD C to 1 meter gC/m^2 F +CWDC_HR cwd C heterotrophic respiration gC/m^2/s F +CWDC_LOSS coarse woody debris C loss gC/m^2/s T +CWDC_TO_CEL_LITC decomp. of coarse woody debris C to cellulosic litter C gC/m^2/s F +CWDC_TO_CEL_LITC_vr decomp. of coarse woody debris C to cellulosic litter C gC/m^3/s F +CWDC_TO_LIG_LITC decomp. of coarse woody debris C to lignin litter C gC/m^2/s F +CWDC_TO_LIG_LITC_vr decomp. of coarse woody debris C to lignin litter C gC/m^3/s F +CWDC_vr CWD C (vertically resolved) gC/m^3 T +CWDN CWD N gN/m^2 T +CWDN_1m CWD N to 1 meter gN/m^2 F +CWDN_TO_CEL_LITN decomp. of coarse woody debris N to cellulosic litter N gN/m^2 F +CWDN_TO_CEL_LITN_vr decomp. of coarse woody debris N to cellulosic litter N gN/m^3 F +CWDN_TO_LIG_LITN decomp. of coarse woody debris N to lignin litter N gN/m^2 F +CWDN_TO_LIG_LITN_vr decomp. of coarse woody debris N to lignin litter N gN/m^3 F +CWDN_vr CWD N (vertically resolved) gN/m^3 T +CWD_HR_L2 Het. Resp. from coarse woody debris gC/m^2/s F +CWD_HR_L2_vr Het. Resp. from coarse woody debris gC/m^3/s F +CWD_HR_L3 Het. Resp. from coarse woody debris gC/m^2/s F +CWD_HR_L3_vr Het. Resp. from coarse woody debris gC/m^3/s F +C_ALLOMETRY C allocation index none F +DAYL daylength s F +DAYS_ACTIVE number of days since last dormancy days F +DEADCROOTC dead coarse root C gC/m^2 T +DEADCROOTC_STORAGE dead coarse root C storage gC/m^2 F +DEADCROOTC_STORAGE_TO_XFER dead coarse root C shift storage to transfer gC/m^2/s F +DEADCROOTC_XFER dead coarse root C transfer gC/m^2 F +DEADCROOTC_XFER_TO_DEADCROOTC dead coarse root C growth from storage gC/m^2/s F +DEADCROOTN dead coarse root N gN/m^2 T +DEADCROOTN_STORAGE dead coarse root N storage gN/m^2 F +DEADCROOTN_STORAGE_TO_XFER dead coarse root N shift storage to transfer gN/m^2/s F +DEADCROOTN_XFER dead coarse root N transfer gN/m^2 F +DEADCROOTN_XFER_TO_DEADCROOTN dead coarse root N growth from storage gN/m^2/s F +DEADSTEMC dead stem C gC/m^2 T +DEADSTEMC_STORAGE dead stem C storage gC/m^2 F +DEADSTEMC_STORAGE_TO_XFER dead stem C shift storage to transfer gC/m^2/s F +DEADSTEMC_XFER dead stem C transfer gC/m^2 F +DEADSTEMC_XFER_TO_DEADSTEMC dead stem C growth from storage gC/m^2/s F +DEADSTEMN dead stem N gN/m^2 T +DEADSTEMN_STORAGE dead stem N storage gN/m^2 F +DEADSTEMN_STORAGE_TO_XFER dead stem N shift storage to transfer gN/m^2/s F +DEADSTEMN_XFER dead stem N transfer gN/m^2 F +DEADSTEMN_XFER_TO_DEADSTEMN dead stem N growth from storage gN/m^2/s F +DENIT total rate of denitrification gN/m^2/s T +DGNETDT derivative of net ground heat flux wrt soil temp W/m^2/K F +DISCOI 2 m Discomfort Index C T +DISCOIS 2 m Stull Discomfort Index C T +DISCOIS_R Rural 2 m Stull Discomfort Index C T +DISCOIS_U Urban 2 m Stull Discomfort Index C T +DISCOI_R Rural 2 m Discomfort Index C T +DISCOI_U Urban 2 m Discomfort Index C T +DISPLA displacement height m F +DISPVEGC displayed veg carbon, excluding storage and cpool gC/m^2 T +DISPVEGN displayed vegetation nitrogen gN/m^2 T +DLRAD downward longwave radiation below the canopy W/m^2 F +DORMANT_FLAG dormancy flag none F +DOWNREG fractional reduction in GPP due to N limitation proportion F +DPVLTRB1 turbulent deposition velocity 1 m/s F +DPVLTRB2 turbulent deposition velocity 2 m/s F +DPVLTRB3 turbulent deposition velocity 3 m/s F +DPVLTRB4 turbulent deposition velocity 4 m/s F +DSL dry surface layer thickness mm T +DSTDEP total dust deposition (dry+wet) from atmosphere kg/m^2/s T +DSTFLXT total surface dust emission kg/m2/s T +DT_VEG change in t_veg, last iteration K F +DWT_CONV_CFLUX conversion C flux (immediate loss to atm) (0 at all times except first timestep of year) gC/m^2/s T +DWT_CONV_CFLUX_DRIBBLED conversion C flux (immediate loss to atm), dribbled throughout the year gC/m^2/s T +DWT_CONV_CFLUX_PATCH patch-level conversion C flux (immediate loss to atm) (0 at all times except first timestep of gC/m^2/s F +DWT_CONV_NFLUX conversion N flux (immediate loss to atm) (0 at all times except first timestep of year) gN/m^2/s T +DWT_CONV_NFLUX_PATCH patch-level conversion N flux (immediate loss to atm) (0 at all times except first timestep of gN/m^2/s F +DWT_CROPPROD1C_GAIN landcover change-driven addition to 1-year crop product pool gC/m^2/s T +DWT_CROPPROD1N_GAIN landcover change-driven addition to 1-year crop product pool gN/m^2/s T +DWT_DEADCROOTC_TO_CWDC dead coarse root to CWD due to landcover change gC/m^2/s F +DWT_DEADCROOTN_TO_CWDN dead coarse root to CWD due to landcover change gN/m^2/s F +DWT_FROOTC_TO_CEL_LIT_C fine root to cellulosic litter due to landcover change gC/m^2/s F +DWT_FROOTC_TO_LIG_LIT_C fine root to lignin litter due to landcover change gC/m^2/s F +DWT_FROOTC_TO_MET_LIT_C fine root to metabolic litter due to landcover change gC/m^2/s F +DWT_FROOTN_TO_CEL_LIT_N fine root N to cellulosic litter due to landcover change gN/m^2/s F +DWT_FROOTN_TO_LIG_LIT_N fine root N to lignin litter due to landcover change gN/m^2/s F +DWT_FROOTN_TO_MET_LIT_N fine root N to metabolic litter due to landcover change gN/m^2/s F +DWT_LIVECROOTC_TO_CWDC live coarse root to CWD due to landcover change gC/m^2/s F +DWT_LIVECROOTN_TO_CWDN live coarse root to CWD due to landcover change gN/m^2/s F +DWT_PROD100C_GAIN landcover change-driven addition to 100-yr wood product pool gC/m^2/s F +DWT_PROD100N_GAIN landcover change-driven addition to 100-yr wood product pool gN/m^2/s F +DWT_PROD10C_GAIN landcover change-driven addition to 10-yr wood product pool gC/m^2/s F +DWT_PROD10N_GAIN landcover change-driven addition to 10-yr wood product pool gN/m^2/s F +DWT_SEEDC_TO_DEADSTEM seed source to patch-level deadstem gC/m^2/s F +DWT_SEEDC_TO_DEADSTEM_PATCH patch-level seed source to patch-level deadstem (per-area-gridcell; only makes sense with dov2 gC/m^2/s F +DWT_SEEDC_TO_LEAF seed source to patch-level leaf gC/m^2/s F +DWT_SEEDC_TO_LEAF_PATCH patch-level seed source to patch-level leaf (per-area-gridcell; only makes sense with dov2xy=. gC/m^2/s F +DWT_SEEDN_TO_DEADSTEM seed source to patch-level deadstem gN/m^2/s T +DWT_SEEDN_TO_DEADSTEM_PATCH patch-level seed source to patch-level deadstem (per-area-gridcell; only makes sense with dov2 gN/m^2/s F +DWT_SEEDN_TO_LEAF seed source to patch-level leaf gN/m^2/s T +DWT_SEEDN_TO_LEAF_PATCH patch-level seed source to patch-level leaf (per-area-gridcell; only makes sense with dov2xy=. gN/m^2/s F +DWT_SLASH_CFLUX slash C flux (to litter diagnostic only) (0 at all times except first timestep of year) gC/m^2/s T +DWT_SLASH_CFLUX_PATCH patch-level slash C flux (to litter diagnostic only) (0 at all times except first timestep of gC/m^2/s F +DWT_WOODPRODC_GAIN landcover change-driven addition to wood product pools gC/m^2/s T +DWT_WOODPRODN_GAIN landcover change-driven addition to wood product pools gN/m^2/s T +DWT_WOOD_PRODUCTC_GAIN_PATCH patch-level landcover change-driven addition to wood product pools(0 at all times except first gC/m^2/s F +DYN_COL_ADJUSTMENTS_CH4 Adjustments in ch4 due to dynamic column areas; only makes sense at the column level: should n gC/m^2 F +DYN_COL_SOIL_ADJUSTMENTS_C Adjustments in soil carbon due to dynamic column areas; only makes sense at the column level: gC/m^2 F +DYN_COL_SOIL_ADJUSTMENTS_N Adjustments in soil nitrogen due to dynamic column areas; only makes sense at the column level gN/m^2 F +DYN_COL_SOIL_ADJUSTMENTS_NH4 Adjustments in soil NH4 due to dynamic column areas; only makes sense at the column level: sho gN/m^2 F +DYN_COL_SOIL_ADJUSTMENTS_NO3 Adjustments in soil NO3 due to dynamic column areas; only makes sense at the column level: sho gN/m^2 F +EFF_POROSITY effective porosity = porosity - vol_ice proportion F +EFLXBUILD building heat flux from change in interior building air temperature W/m^2 T +EFLX_DYNBAL dynamic land cover change conversion energy flux W/m^2 T +EFLX_GNET net heat flux into ground W/m^2 F +EFLX_GRND_LAKE net heat flux into lake/snow surface, excluding light transmission W/m^2 T +EFLX_LH_TOT total latent heat flux [+ to atm] W/m^2 T +EFLX_LH_TOT_ICE total latent heat flux [+ to atm] (ice landunits only) W/m^2 F +EFLX_LH_TOT_R Rural total evaporation W/m^2 T +EFLX_LH_TOT_U Urban total evaporation W/m^2 F +EFLX_SOIL_GRND soil heat flux [+ into soil] W/m^2 F +ELAI exposed one-sided leaf area index m^2/m^2 T +EMG ground emissivity proportion F +EMV vegetation emissivity proportion F +EOPT Eopt coefficient for VOC calc non F +EPT 2 m Equiv Pot Temp K T +EPT_R Rural 2 m Equiv Pot Temp K T +EPT_U Urban 2 m Equiv Pot Temp K T +ER total ecosystem respiration, autotrophic + heterotrophic gC/m^2/s T +ERRH2O total water conservation error mm T +ERRH2OSNO imbalance in snow depth (liquid water) mm T +ERRSEB surface energy conservation error W/m^2 T +ERRSOI soil/lake energy conservation error W/m^2 T +ERRSOL solar radiation conservation error W/m^2 T +ESAI exposed one-sided stem area index m^2/m^2 T +EXCESSC_MR excess C maintenance respiration gC/m^2/s F +EXCESS_CFLUX C flux not allocated due to downregulation gC/m^2/s F +FAREA_BURNED timestep fractional area burned s-1 T +FCANSNO fraction of canopy that is wet proportion F +FCEV canopy evaporation W/m^2 T +FCH4 Gridcell surface CH4 flux to atmosphere (+ to atm) kgC/m2/s T +FCH4TOCO2 Gridcell oxidation of CH4 to CO2 gC/m2/s T +FCH4_DFSAT CH4 additional flux due to changing fsat, natural vegetated and crop landunits only kgC/m2/s T +FCO2 CO2 flux to atmosphere (+ to atm) kgCO2/m2/s F +FCOV fractional impermeable area unitless T +FCTR canopy transpiration W/m^2 T +FDRY fraction of foliage that is green and dry proportion F +FERTNITRO Nitrogen fertilizer for each crop gN/m2/yr F +FERT_COUNTER time left to fertilize seconds F +FERT_TO_SMINN fertilizer to soil mineral N gN/m^2/s F +FFIX_TO_SMINN free living N fixation to soil mineral N gN/m^2/s T +FGEV ground evaporation W/m^2 T +FGR heat flux into soil/snow including snow melt and lake / snow light transmission W/m^2 T +FGR12 heat flux between soil layers 1 and 2 W/m^2 T +FGR_ICE heat flux into soil/snow including snow melt and lake / snow light transmission (ice landunits W/m^2 F +FGR_R Rural heat flux into soil/snow including snow melt and snow light transmission W/m^2 F +FGR_SOIL_R Rural downward heat flux at interface below each soil layer watt/m^2 F +FGR_U Urban heat flux into soil/snow including snow melt W/m^2 F +FH2OSFC fraction of ground covered by surface water unitless T +FH2OSFC_NOSNOW fraction of ground covered by surface water (if no snow present) unitless F +FINUNDATED fractional inundated area of vegetated columns unitless T +FINUNDATED_LAG time-lagged inundated fraction of vegetated columns unitless F +FIRA net infrared (longwave) radiation W/m^2 T +FIRA_ICE net infrared (longwave) radiation (ice landunits only) W/m^2 F +FIRA_R Rural net infrared (longwave) radiation W/m^2 T +FIRA_U Urban net infrared (longwave) radiation W/m^2 F +FIRE emitted infrared (longwave) radiation W/m^2 T +FIRE_ICE emitted infrared (longwave) radiation (ice landunits only) W/m^2 F +FIRE_R Rural emitted infrared (longwave) radiation W/m^2 T +FIRE_U Urban emitted infrared (longwave) radiation W/m^2 F +FLDS atmospheric longwave radiation (downscaled to columns in glacier regions) W/m^2 T +FLDS_ICE atmospheric longwave radiation (downscaled to columns in glacier regions) (ice landunits only) W/m^2 F +FMAX_DENIT_CARBONSUBSTRATE FMAX_DENIT_CARBONSUBSTRATE gN/m^3/s F +FMAX_DENIT_NITRATE FMAX_DENIT_NITRATE gN/m^3/s F +FPI fraction of potential immobilization proportion T +FPI_vr fraction of potential immobilization proportion F +FPSN photosynthesis umol m-2 s-1 T +FPSN24 24 hour accumulative patch photosynthesis starting from mid-night umol CO2/m^2 ground/day F +FPSN_WC Rubisco-limited photosynthesis umol m-2 s-1 F +FPSN_WJ RuBP-limited photosynthesis umol m-2 s-1 F +FPSN_WP Product-limited photosynthesis umol m-2 s-1 F +FRAC_ICEOLD fraction of ice relative to the tot water proportion F +FREE_RETRANSN_TO_NPOOL deployment of retranslocated N gN/m^2/s T +FROOTC fine root C gC/m^2 T +FROOTC_ALLOC fine root C allocation gC/m^2/s T +FROOTC_LOSS fine root C loss gC/m^2/s T +FROOTC_STORAGE fine root C storage gC/m^2 F +FROOTC_STORAGE_TO_XFER fine root C shift storage to transfer gC/m^2/s F +FROOTC_TO_LITTER fine root C litterfall gC/m^2/s F +FROOTC_XFER fine root C transfer gC/m^2 F +FROOTC_XFER_TO_FROOTC fine root C growth from storage gC/m^2/s F +FROOTN fine root N gN/m^2 T +FROOTN_STORAGE fine root N storage gN/m^2 F +FROOTN_STORAGE_TO_XFER fine root N shift storage to transfer gN/m^2/s F +FROOTN_TO_LITTER fine root N litterfall gN/m^2/s F +FROOTN_XFER fine root N transfer gN/m^2 F +FROOTN_XFER_TO_FROOTN fine root N growth from storage gN/m^2/s F +FROOT_MR fine root maintenance respiration gC/m^2/s F +FROOT_PROF profile for litter C and N inputs from fine roots 1/m F +FROST_TABLE frost table depth (natural vegetated and crop landunits only) m F +FSA absorbed solar radiation W/m^2 T +FSAT fractional area with water table at surface unitless T +FSA_ICE absorbed solar radiation (ice landunits only) W/m^2 F +FSA_R Rural absorbed solar radiation W/m^2 F +FSA_U Urban absorbed solar radiation W/m^2 F +FSD24 direct radiation (last 24hrs) K F +FSD240 direct radiation (last 240hrs) K F +FSDS atmospheric incident solar radiation W/m^2 T +FSDSND direct nir incident solar radiation W/m^2 T +FSDSNDLN direct nir incident solar radiation at local noon W/m^2 T +FSDSNI diffuse nir incident solar radiation W/m^2 T +FSDSVD direct vis incident solar radiation W/m^2 T +FSDSVDLN direct vis incident solar radiation at local noon W/m^2 T +FSDSVI diffuse vis incident solar radiation W/m^2 T +FSDSVILN diffuse vis incident solar radiation at local noon W/m^2 T +FSH sensible heat not including correction for land use change and rain/snow conversion W/m^2 T +FSH_G sensible heat from ground W/m^2 T +FSH_ICE sensible heat not including correction for land use change and rain/snow conversion (ice landu W/m^2 F +FSH_PRECIP_CONVERSION Sensible heat flux from conversion of rain/snow atm forcing W/m^2 T +FSH_R Rural sensible heat W/m^2 T +FSH_RUNOFF_ICE_TO_LIQ sensible heat flux generated from conversion of ice runoff to liquid W/m^2 T +FSH_TO_COUPLER sensible heat sent to coupler (includes corrections for land use change, rain/snow conversion W/m^2 T +FSH_U Urban sensible heat W/m^2 F +FSH_V sensible heat from veg W/m^2 T +FSI24 indirect radiation (last 24hrs) K F +FSI240 indirect radiation (last 240hrs) K F +FSM snow melt heat flux W/m^2 T +FSM_ICE snow melt heat flux (ice landunits only) W/m^2 F +FSM_R Rural snow melt heat flux W/m^2 F +FSM_U Urban snow melt heat flux W/m^2 F +FSNO fraction of ground covered by snow unitless T +FSNO_EFF effective fraction of ground covered by snow unitless T +FSNO_ICE fraction of ground covered by snow (ice landunits only) unitless F +FSR reflected solar radiation W/m^2 T +FSRND direct nir reflected solar radiation W/m^2 T +FSRNDLN direct nir reflected solar radiation at local noon W/m^2 T +FSRNI diffuse nir reflected solar radiation W/m^2 T +FSRSF reflected solar radiation W/m^2 T +FSRSFND direct nir reflected solar radiation W/m^2 T +FSRSFNDLN direct nir reflected solar radiation at local noon W/m^2 T +FSRSFNI diffuse nir reflected solar radiation W/m^2 T +FSRSFVD direct vis reflected solar radiation W/m^2 T +FSRSFVDLN direct vis reflected solar radiation at local noon W/m^2 T +FSRSFVI diffuse vis reflected solar radiation W/m^2 T +FSRVD direct vis reflected solar radiation W/m^2 T +FSRVDLN direct vis reflected solar radiation at local noon W/m^2 T +FSRVI diffuse vis reflected solar radiation W/m^2 T +FSR_ICE reflected solar radiation (ice landunits only) W/m^2 F +FSUN sunlit fraction of canopy proportion F +FSUN24 fraction sunlit (last 24hrs) K F +FSUN240 fraction sunlit (last 240hrs) K F +FUELC fuel load gC/m^2 T +FV friction velocity m/s T +FWET fraction of canopy that is wet proportion F +F_DENIT denitrification flux gN/m^2/s T +F_DENIT_BASE F_DENIT_BASE gN/m^3/s F +F_DENIT_vr denitrification flux gN/m^3/s F +F_N2O_DENIT denitrification N2O flux gN/m^2/s T +F_N2O_NIT nitrification N2O flux gN/m^2/s T +F_NIT nitrification flux gN/m^2/s T +F_NIT_vr nitrification flux gN/m^3/s F +FireComp_BC fire emissions flux of BC kg/m2/sec F +FireComp_OC fire emissions flux of OC kg/m2/sec F +FireComp_SO2 fire emissions flux of SO2 kg/m2/sec F +FireEmis_TOT Total fire emissions flux gC/m2/sec F +FireEmis_ZTOP Top of vertical fire emissions distribution m F +FireMech_SO2 fire emissions flux of SO2 kg/m2/sec F +FireMech_bc_a1 fire emissions flux of bc_a1 kg/m2/sec F +FireMech_pom_a1 fire emissions flux of pom_a1 kg/m2/sec F +GAMMA total gamma for VOC calc non F +GAMMAA gamma A for VOC calc non F +GAMMAC gamma C for VOC calc non F +GAMMAL gamma L for VOC calc non F +GAMMAP gamma P for VOC calc non F +GAMMAS gamma S for VOC calc non F +GAMMAT gamma T for VOC calc non F +GDD0 Growing degree days base 0C from planting ddays F +GDD020 Twenty year average of growing degree days base 0C from planting ddays F +GDD10 Growing degree days base 10C from planting ddays F +GDD1020 Twenty year average of growing degree days base 10C from planting ddays F +GDD8 Growing degree days base 8C from planting ddays F +GDD820 Twenty year average of growing degree days base 8C from planting ddays F +GDDACCUM Accumulated growing degree days past planting date for crop ddays F +GDDACCUM_PERHARV For each crop harvest in a calendar year, accumulated growing degree days past planting date ddays F +GDDHARV Growing degree days (gdd) needed to harvest ddays F +GDDHARV_PERHARV For each harvest in a calendar year,For each harvest in a calendar year, growing degree days (gdd) needed to harvest ddays F +GDDTSOI Growing degree-days from planting (top two soil layers) ddays F +GPP gross primary production gC/m^2/s T +GR total growth respiration gC/m^2/s T +GRAINC grain C (does not equal yield) gC/m^2 T +GRAINC_TO_FOOD grain C to food gC/m^2/s T +GRAINC_TO_FOOD_ANN total grain C to food in all harvests in a calendar year gC/m^2 F +GRAINC_TO_FOOD_PERHARV grain C to food for each harvest in a calendar year gC/m^2 F +GRAINC_TO_SEED grain C to seed gC/m^2/s T +GRAINN grain N gN/m^2 T +GRESP_STORAGE growth respiration storage gC/m^2 F +GRESP_STORAGE_TO_XFER growth respiration shift storage to transfer gC/m^2/s F +GRESP_XFER growth respiration transfer gC/m^2 F +GROSS_NMIN gross rate of N mineralization gN/m^2/s T +GROSS_NMIN_vr gross rate of N mineralization gN/m^3/s F +GSSHA shaded leaf stomatal conductance umol H20/m2/s T +GSSHALN shaded leaf stomatal conductance at local noon umol H20/m2/s T +GSSUN sunlit leaf stomatal conductance umol H20/m2/s T +GSSUNLN sunlit leaf stomatal conductance at local noon umol H20/m2/s T +H2OCAN intercepted water mm T +H2OSFC surface water depth mm T +H2OSNO snow depth (liquid water) mm T +H2OSNO_ICE snow depth (liquid water, ice landunits only) mm F +H2OSNO_TOP mass of snow in top snow layer kg/m2 T +H2OSOI volumetric soil water (natural vegetated and crop landunits only) mm3/mm3 T +HARVEST_REASON_PERHARV For each harvest in a calendar year, the reason the crop was harvested categorical F +HBOT canopy bottom m F +HEAT_CONTENT1 initial gridcell total heat content J/m^2 T +HEAT_CONTENT1_VEG initial gridcell total heat content - natural vegetated and crop landunits only J/m^2 F +HEAT_CONTENT2 post land cover change total heat content J/m^2 F +HEAT_FROM_AC sensible heat flux put into canyon due to heat removed from air conditioning W/m^2 T +HIA 2 m NWS Heat Index C T +HIA_R Rural 2 m NWS Heat Index C T +HIA_U Urban 2 m NWS Heat Index C T +HK hydraulic conductivity (natural vegetated and crop landunits only) mm/s F +HR total heterotrophic respiration gC/m^2/s T +HR_vr total vertically resolved heterotrophic respiration gC/m^3/s T +HTOP canopy top m T +HUI crop heat unit index ddays F +HUI_PERHARV For each harvest in a calendar year, crop heat unit index ddays F +HUMIDEX 2 m Humidex C T +HUMIDEX_R Rural 2 m Humidex C T +HUMIDEX_U Urban 2 m Humidex C T +ICE_CONTENT1 initial gridcell total ice content mm T +ICE_CONTENT2 post land cover change total ice content mm F +ICE_MODEL_FRACTION Ice sheet model fractional coverage unitless F +INIT_GPP GPP flux before downregulation gC/m^2/s F +INT_SNOW accumulated swe (natural vegetated and crop landunits only) mm F +INT_SNOW_ICE accumulated swe (ice landunits only) mm F +IWUELN local noon intrinsic water use efficiency umolCO2/molH2O T +JMX25T canopy profile of jmax umol/m2/s T +Jmx25Z maximum rate of electron transport at 25 Celcius for canopy layers umol electrons/m2/s T +KROOT root conductance each soil layer 1/s F +KSOIL soil conductance in each soil layer 1/s F +K_ACT_SOM active soil organic potential loss coefficient 1/s F +K_CEL_LIT cellulosic litter potential loss coefficient 1/s F +K_CWD coarse woody debris potential loss coefficient 1/s F +K_LIG_LIT lignin litter potential loss coefficient 1/s F +K_MET_LIT metabolic litter potential loss coefficient 1/s F +K_NITR K_NITR 1/s F +K_NITR_H2O K_NITR_H2O unitless F +K_NITR_PH K_NITR_PH unitless F +K_NITR_T K_NITR_T unitless F +K_PAS_SOM passive soil organic potential loss coefficient 1/s F +K_SLO_SOM slow soil organic ma potential loss coefficient 1/s F +LAI240 240hr average of leaf area index m^2/m^2 F +LAISHA shaded projected leaf area index m^2/m^2 T +LAISUN sunlit projected leaf area index m^2/m^2 T +LAKEICEFRAC lake layer ice mass fraction unitless F +LAKEICEFRAC_SURF surface lake layer ice mass fraction unitless T +LAKEICETHICK thickness of lake ice (including physical expansion on freezing) m T +LAND_USE_FLUX total C emitted from land cover conversion (smoothed over the year) and wood and grain product gC/m^2/s T +LATBASET latitude vary base temperature for gddplant degree C F +LEAFC leaf C gC/m^2 T +LEAFCN Leaf CN ratio used for flexible CN gC/gN T +LEAFCN_OFFSET Leaf C:N used by FUN unitless F +LEAFCN_STORAGE Storage Leaf CN ratio used for flexible CN gC/gN F +LEAFC_ALLOC leaf C allocation gC/m^2/s T +LEAFC_CHANGE C change in leaf gC/m^2/s T +LEAFC_LOSS leaf C loss gC/m^2/s T +LEAFC_STORAGE leaf C storage gC/m^2 F +LEAFC_STORAGE_TO_XFER leaf C shift storage to transfer gC/m^2/s F +LEAFC_STORAGE_XFER_ACC Accumulated leaf C transfer gC/m^2 F +LEAFC_TO_BIOFUELC leaf C to biofuel C gC/m^2/s T +LEAFC_TO_LITTER leaf C litterfall gC/m^2/s F +LEAFC_TO_LITTER_FUN leaf C litterfall used by FUN gC/m^2/s T +LEAFC_XFER leaf C transfer gC/m^2 F +LEAFC_XFER_TO_LEAFC leaf C growth from storage gC/m^2/s F +LEAFN leaf N gN/m^2 T +LEAFN_STORAGE leaf N storage gN/m^2 F +LEAFN_STORAGE_TO_XFER leaf N shift storage to transfer gN/m^2/s F +LEAFN_STORAGE_XFER_ACC Accmulated leaf N transfer gN/m^2 F +LEAFN_TO_LITTER leaf N litterfall gN/m^2/s T +LEAFN_TO_RETRANSN leaf N to retranslocated N pool gN/m^2/s F +LEAFN_XFER leaf N transfer gN/m^2 F +LEAFN_XFER_TO_LEAFN leaf N growth from storage gN/m^2/s F +LEAF_MR leaf maintenance respiration gC/m^2/s T +LEAF_PROF profile for litter C and N inputs from leaves 1/m F +LFC2 conversion area fraction of BET and BDT that burned per sec T +LGSF long growing season factor proportion F +LIG_LITC LIG_LIT C gC/m^2 T +LIG_LITC_1m LIG_LIT C to 1 meter gC/m^2 F +LIG_LITC_TNDNCY_VERT_TRA lignin litter C tendency due to vertical transport gC/m^3/s F +LIG_LITC_TO_SLO_SOMC decomp. of lignin litter C to slow soil organic ma C gC/m^2/s F +LIG_LITC_TO_SLO_SOMC_vr decomp. of lignin litter C to slow soil organic ma C gC/m^3/s F +LIG_LITC_vr LIG_LIT C (vertically resolved) gC/m^3 T +LIG_LITN LIG_LIT N gN/m^2 T +LIG_LITN_1m LIG_LIT N to 1 meter gN/m^2 F +LIG_LITN_TNDNCY_VERT_TRA lignin litter N tendency due to vertical transport gN/m^3/s F +LIG_LITN_TO_SLO_SOMN decomp. of lignin litter N to slow soil organic ma N gN/m^2 F +LIG_LITN_TO_SLO_SOMN_vr decomp. of lignin litter N to slow soil organic ma N gN/m^3 F +LIG_LITN_vr LIG_LIT N (vertically resolved) gN/m^3 T +LIG_LIT_HR Het. Resp. from lignin litter gC/m^2/s F +LIG_LIT_HR_vr Het. Resp. from lignin litter gC/m^3/s F +LIQCAN intercepted liquid water mm T +LIQUID_CONTENT1 initial gridcell total liq content mm T +LIQUID_CONTENT2 post landuse change gridcell total liq content mm F +LIQUID_WATER_TEMP1 initial gridcell weighted average liquid water temperature K F +LITFALL litterfall (leaves and fine roots) gC/m^2/s T +LITFIRE litter fire losses gC/m^2/s F +LITTERC_HR litter C heterotrophic respiration gC/m^2/s T +LITTERC_LOSS litter C loss gC/m^2/s T +LIVECROOTC live coarse root C gC/m^2 T +LIVECROOTC_STORAGE live coarse root C storage gC/m^2 F +LIVECROOTC_STORAGE_TO_XFER live coarse root C shift storage to transfer gC/m^2/s F +LIVECROOTC_TO_DEADCROOTC live coarse root C turnover gC/m^2/s F +LIVECROOTC_XFER live coarse root C transfer gC/m^2 F +LIVECROOTC_XFER_TO_LIVECROOTC live coarse root C growth from storage gC/m^2/s F +LIVECROOTN live coarse root N gN/m^2 T +LIVECROOTN_STORAGE live coarse root N storage gN/m^2 F +LIVECROOTN_STORAGE_TO_XFER live coarse root N shift storage to transfer gN/m^2/s F +LIVECROOTN_TO_DEADCROOTN live coarse root N turnover gN/m^2/s F +LIVECROOTN_TO_RETRANSN live coarse root N to retranslocated N pool gN/m^2/s F +LIVECROOTN_XFER live coarse root N transfer gN/m^2 F +LIVECROOTN_XFER_TO_LIVECROOTN live coarse root N growth from storage gN/m^2/s F +LIVECROOT_MR live coarse root maintenance respiration gC/m^2/s F +LIVESTEMC live stem C gC/m^2 T +LIVESTEMC_STORAGE live stem C storage gC/m^2 F +LIVESTEMC_STORAGE_TO_XFER live stem C shift storage to transfer gC/m^2/s F +LIVESTEMC_TO_BIOFUELC livestem C to biofuel C gC/m^2/s T +LIVESTEMC_TO_DEADSTEMC live stem C turnover gC/m^2/s F +LIVESTEMC_XFER live stem C transfer gC/m^2 F +LIVESTEMC_XFER_TO_LIVESTEMC live stem C growth from storage gC/m^2/s F +LIVESTEMN live stem N gN/m^2 T +LIVESTEMN_STORAGE live stem N storage gN/m^2 F +LIVESTEMN_STORAGE_TO_XFER live stem N shift storage to transfer gN/m^2/s F +LIVESTEMN_TO_DEADSTEMN live stem N turnover gN/m^2/s F +LIVESTEMN_TO_RETRANSN live stem N to retranslocated N pool gN/m^2/s F +LIVESTEMN_XFER live stem N transfer gN/m^2 F +LIVESTEMN_XFER_TO_LIVESTEMN live stem N growth from storage gN/m^2/s F +LIVESTEM_MR live stem maintenance respiration gC/m^2/s F +LNC leaf N concentration gN leaf/m^2 T +LWdown atmospheric longwave radiation (downscaled to columns in glacier regions) W/m^2 F +LWup upwelling longwave radiation W/m^2 F +MEG_acetaldehyde MEGAN flux kg/m2/sec T +MEG_acetic_acid MEGAN flux kg/m2/sec T +MEG_acetone MEGAN flux kg/m2/sec T +MEG_carene_3 MEGAN flux kg/m2/sec T +MEG_ethanol MEGAN flux kg/m2/sec T +MEG_formaldehyde MEGAN flux kg/m2/sec T +MEG_isoprene MEGAN flux kg/m2/sec T +MEG_methanol MEGAN flux kg/m2/sec T +MEG_pinene_a MEGAN flux kg/m2/sec T +MEG_thujene_a MEGAN flux kg/m2/sec T +MET_LITC MET_LIT C gC/m^2 T +MET_LITC_1m MET_LIT C to 1 meter gC/m^2 F +MET_LITC_TNDNCY_VERT_TRA metabolic litter C tendency due to vertical transport gC/m^3/s F +MET_LITC_TO_ACT_SOMC decomp. of metabolic litter C to active soil organic C gC/m^2/s F +MET_LITC_TO_ACT_SOMC_vr decomp. of metabolic litter C to active soil organic C gC/m^3/s F +MET_LITC_vr MET_LIT C (vertically resolved) gC/m^3 T +MET_LITN MET_LIT N gN/m^2 T +MET_LITN_1m MET_LIT N to 1 meter gN/m^2 F +MET_LITN_TNDNCY_VERT_TRA metabolic litter N tendency due to vertical transport gN/m^3/s F +MET_LITN_TO_ACT_SOMN decomp. of metabolic litter N to active soil organic N gN/m^2 F +MET_LITN_TO_ACT_SOMN_vr decomp. of metabolic litter N to active soil organic N gN/m^3 F +MET_LITN_vr MET_LIT N (vertically resolved) gN/m^3 T +MET_LIT_HR Het. Resp. from metabolic litter gC/m^2/s F +MET_LIT_HR_vr Het. Resp. from metabolic litter gC/m^3/s F +MR maintenance respiration gC/m^2/s T +M_ACT_SOMC_TO_LEACHING active soil organic C leaching loss gC/m^2/s F +M_ACT_SOMN_TO_LEACHING active soil organic N leaching loss gN/m^2/s F +M_CEL_LITC_TO_FIRE cellulosic litter C fire loss gC/m^2/s F +M_CEL_LITC_TO_FIRE_vr cellulosic litter C fire loss gC/m^3/s F +M_CEL_LITC_TO_LEACHING cellulosic litter C leaching loss gC/m^2/s F +M_CEL_LITN_TO_FIRE cellulosic litter N fire loss gN/m^2 F +M_CEL_LITN_TO_FIRE_vr cellulosic litter N fire loss gN/m^3 F +M_CEL_LITN_TO_LEACHING cellulosic litter N leaching loss gN/m^2/s F +M_CWDC_TO_FIRE coarse woody debris C fire loss gC/m^2/s F +M_CWDC_TO_FIRE_vr coarse woody debris C fire loss gC/m^3/s F +M_CWDN_TO_FIRE coarse woody debris N fire loss gN/m^2 F +M_CWDN_TO_FIRE_vr coarse woody debris N fire loss gN/m^3 F +M_DEADCROOTC_STORAGE_TO_LITTER dead coarse root C storage mortality gC/m^2/s F +M_DEADCROOTC_STORAGE_TO_LITTER_FIRE dead coarse root C storage fire mortality to litter gC/m^2/s F +M_DEADCROOTC_TO_LITTER dead coarse root C mortality gC/m^2/s F +M_DEADCROOTC_XFER_TO_LITTER dead coarse root C transfer mortality gC/m^2/s F +M_DEADCROOTN_STORAGE_TO_FIRE dead coarse root N storage fire loss gN/m^2/s F +M_DEADCROOTN_STORAGE_TO_LITTER dead coarse root N storage mortality gN/m^2/s F +M_DEADCROOTN_TO_FIRE dead coarse root N fire loss gN/m^2/s F +M_DEADCROOTN_TO_LITTER dead coarse root N mortality gN/m^2/s F +M_DEADCROOTN_TO_LITTER_FIRE dead coarse root N fire mortality to litter gN/m^2/s F +M_DEADCROOTN_XFER_TO_FIRE dead coarse root N transfer fire loss gN/m^2/s F +M_DEADCROOTN_XFER_TO_LITTER dead coarse root N transfer mortality gN/m^2/s F +M_DEADROOTC_STORAGE_TO_FIRE dead root C storage fire loss gC/m^2/s F +M_DEADROOTC_STORAGE_TO_LITTER_FIRE dead root C storage fire mortality to litter gC/m^2/s F +M_DEADROOTC_TO_FIRE dead root C fire loss gC/m^2/s F +M_DEADROOTC_TO_LITTER_FIRE dead root C fire mortality to litter gC/m^2/s F +M_DEADROOTC_XFER_TO_FIRE dead root C transfer fire loss gC/m^2/s F +M_DEADROOTC_XFER_TO_LITTER_FIRE dead root C transfer fire mortality to litter gC/m^2/s F +M_DEADSTEMC_STORAGE_TO_FIRE dead stem C storage fire loss gC/m^2/s F +M_DEADSTEMC_STORAGE_TO_LITTER dead stem C storage mortality gC/m^2/s F +M_DEADSTEMC_STORAGE_TO_LITTER_FIRE dead stem C storage fire mortality to litter gC/m^2/s F +M_DEADSTEMC_TO_FIRE dead stem C fire loss gC/m^2/s F +M_DEADSTEMC_TO_LITTER dead stem C mortality gC/m^2/s F +M_DEADSTEMC_TO_LITTER_FIRE dead stem C fire mortality to litter gC/m^2/s F +M_DEADSTEMC_XFER_TO_FIRE dead stem C transfer fire loss gC/m^2/s F +M_DEADSTEMC_XFER_TO_LITTER dead stem C transfer mortality gC/m^2/s F +M_DEADSTEMC_XFER_TO_LITTER_FIRE dead stem C transfer fire mortality to litter gC/m^2/s F +M_DEADSTEMN_STORAGE_TO_FIRE dead stem N storage fire loss gN/m^2/s F +M_DEADSTEMN_STORAGE_TO_LITTER dead stem N storage mortality gN/m^2/s F +M_DEADSTEMN_TO_FIRE dead stem N fire loss gN/m^2/s F +M_DEADSTEMN_TO_LITTER dead stem N mortality gN/m^2/s F +M_DEADSTEMN_TO_LITTER_FIRE dead stem N fire mortality to litter gN/m^2/s F +M_DEADSTEMN_XFER_TO_FIRE dead stem N transfer fire loss gN/m^2/s F +M_DEADSTEMN_XFER_TO_LITTER dead stem N transfer mortality gN/m^2/s F +M_FROOTC_STORAGE_TO_FIRE fine root C storage fire loss gC/m^2/s F +M_FROOTC_STORAGE_TO_LITTER fine root C storage mortality gC/m^2/s F +M_FROOTC_STORAGE_TO_LITTER_FIRE fine root C storage fire mortality to litter gC/m^2/s F +M_FROOTC_TO_FIRE fine root C fire loss gC/m^2/s F +M_FROOTC_TO_LITTER fine root C mortality gC/m^2/s F +M_FROOTC_TO_LITTER_FIRE fine root C fire mortality to litter gC/m^2/s F +M_FROOTC_XFER_TO_FIRE fine root C transfer fire loss gC/m^2/s F +M_FROOTC_XFER_TO_LITTER fine root C transfer mortality gC/m^2/s F +M_FROOTC_XFER_TO_LITTER_FIRE fine root C transfer fire mortality to litter gC/m^2/s F +M_FROOTN_STORAGE_TO_FIRE fine root N storage fire loss gN/m^2/s F +M_FROOTN_STORAGE_TO_LITTER fine root N storage mortality gN/m^2/s F +M_FROOTN_TO_FIRE fine root N fire loss gN/m^2/s F +M_FROOTN_TO_LITTER fine root N mortality gN/m^2/s F +M_FROOTN_XFER_TO_FIRE fine root N transfer fire loss gN/m^2/s F +M_FROOTN_XFER_TO_LITTER fine root N transfer mortality gN/m^2/s F +M_GRESP_STORAGE_TO_FIRE growth respiration storage fire loss gC/m^2/s F +M_GRESP_STORAGE_TO_LITTER growth respiration storage mortality gC/m^2/s F +M_GRESP_STORAGE_TO_LITTER_FIRE growth respiration storage fire mortality to litter gC/m^2/s F +M_GRESP_XFER_TO_FIRE growth respiration transfer fire loss gC/m^2/s F +M_GRESP_XFER_TO_LITTER growth respiration transfer mortality gC/m^2/s F +M_GRESP_XFER_TO_LITTER_FIRE growth respiration transfer fire mortality to litter gC/m^2/s F +M_LEAFC_STORAGE_TO_FIRE leaf C storage fire loss gC/m^2/s F +M_LEAFC_STORAGE_TO_LITTER leaf C storage mortality gC/m^2/s F +M_LEAFC_STORAGE_TO_LITTER_FIRE leaf C fire mortality to litter gC/m^2/s F +M_LEAFC_TO_FIRE leaf C fire loss gC/m^2/s F +M_LEAFC_TO_LITTER leaf C mortality gC/m^2/s F +M_LEAFC_TO_LITTER_FIRE leaf C fire mortality to litter gC/m^2/s F +M_LEAFC_XFER_TO_FIRE leaf C transfer fire loss gC/m^2/s F +M_LEAFC_XFER_TO_LITTER leaf C transfer mortality gC/m^2/s F +M_LEAFC_XFER_TO_LITTER_FIRE leaf C transfer fire mortality to litter gC/m^2/s F +M_LEAFN_STORAGE_TO_FIRE leaf N storage fire loss gN/m^2/s F +M_LEAFN_STORAGE_TO_LITTER leaf N storage mortality gN/m^2/s F +M_LEAFN_TO_FIRE leaf N fire loss gN/m^2/s F +M_LEAFN_TO_LITTER leaf N mortality gN/m^2/s F +M_LEAFN_XFER_TO_FIRE leaf N transfer fire loss gN/m^2/s F +M_LEAFN_XFER_TO_LITTER leaf N transfer mortality gN/m^2/s F +M_LIG_LITC_TO_FIRE lignin litter C fire loss gC/m^2/s F +M_LIG_LITC_TO_FIRE_vr lignin litter C fire loss gC/m^3/s F +M_LIG_LITC_TO_LEACHING lignin litter C leaching loss gC/m^2/s F +M_LIG_LITN_TO_FIRE lignin litter N fire loss gN/m^2 F +M_LIG_LITN_TO_FIRE_vr lignin litter N fire loss gN/m^3 F +M_LIG_LITN_TO_LEACHING lignin litter N leaching loss gN/m^2/s F +M_LIVECROOTC_STORAGE_TO_LITTER live coarse root C storage mortality gC/m^2/s F +M_LIVECROOTC_STORAGE_TO_LITTER_FIRE live coarse root C fire mortality to litter gC/m^2/s F +M_LIVECROOTC_TO_LITTER live coarse root C mortality gC/m^2/s F +M_LIVECROOTC_XFER_TO_LITTER live coarse root C transfer mortality gC/m^2/s F +M_LIVECROOTN_STORAGE_TO_FIRE live coarse root N storage fire loss gN/m^2/s F +M_LIVECROOTN_STORAGE_TO_LITTER live coarse root N storage mortality gN/m^2/s F +M_LIVECROOTN_TO_FIRE live coarse root N fire loss gN/m^2/s F +M_LIVECROOTN_TO_LITTER live coarse root N mortality gN/m^2/s F +M_LIVECROOTN_XFER_TO_FIRE live coarse root N transfer fire loss gN/m^2/s F +M_LIVECROOTN_XFER_TO_LITTER live coarse root N transfer mortality gN/m^2/s F +M_LIVEROOTC_STORAGE_TO_FIRE live root C storage fire loss gC/m^2/s F +M_LIVEROOTC_STORAGE_TO_LITTER_FIRE live root C storage fire mortality to litter gC/m^2/s F +M_LIVEROOTC_TO_DEADROOTC_FIRE live root C fire mortality to dead root C gC/m^2/s F +M_LIVEROOTC_TO_FIRE live root C fire loss gC/m^2/s F +M_LIVEROOTC_TO_LITTER_FIRE live root C fire mortality to litter gC/m^2/s F +M_LIVEROOTC_XFER_TO_FIRE live root C transfer fire loss gC/m^2/s F +M_LIVEROOTC_XFER_TO_LITTER_FIRE live root C transfer fire mortality to litter gC/m^2/s F +M_LIVESTEMC_STORAGE_TO_FIRE live stem C storage fire loss gC/m^2/s F +M_LIVESTEMC_STORAGE_TO_LITTER live stem C storage mortality gC/m^2/s F +M_LIVESTEMC_STORAGE_TO_LITTER_FIRE live stem C storage fire mortality to litter gC/m^2/s F +M_LIVESTEMC_TO_DEADSTEMC_FIRE live stem C fire mortality to dead stem C gC/m^2/s F +M_LIVESTEMC_TO_FIRE live stem C fire loss gC/m^2/s F +M_LIVESTEMC_TO_LITTER live stem C mortality gC/m^2/s F +M_LIVESTEMC_TO_LITTER_FIRE live stem C fire mortality to litter gC/m^2/s F +M_LIVESTEMC_XFER_TO_FIRE live stem C transfer fire loss gC/m^2/s F +M_LIVESTEMC_XFER_TO_LITTER live stem C transfer mortality gC/m^2/s F +M_LIVESTEMC_XFER_TO_LITTER_FIRE live stem C transfer fire mortality to litter gC/m^2/s F +M_LIVESTEMN_STORAGE_TO_FIRE live stem N storage fire loss gN/m^2/s F +M_LIVESTEMN_STORAGE_TO_LITTER live stem N storage mortality gN/m^2/s F +M_LIVESTEMN_TO_FIRE live stem N fire loss gN/m^2/s F +M_LIVESTEMN_TO_LITTER live stem N mortality gN/m^2/s F +M_LIVESTEMN_XFER_TO_FIRE live stem N transfer fire loss gN/m^2/s F +M_LIVESTEMN_XFER_TO_LITTER live stem N transfer mortality gN/m^2/s F +M_MET_LITC_TO_FIRE metabolic litter C fire loss gC/m^2/s F +M_MET_LITC_TO_FIRE_vr metabolic litter C fire loss gC/m^3/s F +M_MET_LITC_TO_LEACHING metabolic litter C leaching loss gC/m^2/s F +M_MET_LITN_TO_FIRE metabolic litter N fire loss gN/m^2 F +M_MET_LITN_TO_FIRE_vr metabolic litter N fire loss gN/m^3 F +M_MET_LITN_TO_LEACHING metabolic litter N leaching loss gN/m^2/s F +M_PAS_SOMC_TO_LEACHING passive soil organic C leaching loss gC/m^2/s F +M_PAS_SOMN_TO_LEACHING passive soil organic N leaching loss gN/m^2/s F +M_RETRANSN_TO_FIRE retranslocated N pool fire loss gN/m^2/s F +M_RETRANSN_TO_LITTER retranslocated N pool mortality gN/m^2/s F +M_SLO_SOMC_TO_LEACHING slow soil organic ma C leaching loss gC/m^2/s F +M_SLO_SOMN_TO_LEACHING slow soil organic ma N leaching loss gN/m^2/s F +NACTIVE Mycorrhizal N uptake flux gN/m^2/s T +NACTIVE_NH4 Mycorrhizal N uptake flux gN/m^2/s T +NACTIVE_NO3 Mycorrhizal N uptake flux gN/m^2/s T +NAM AM-associated N uptake flux gN/m^2/s T +NAM_NH4 AM-associated N uptake flux gN/m^2/s T +NAM_NO3 AM-associated N uptake flux gN/m^2/s T +NBP net biome production, includes fire, landuse, harvest and hrv_xsmrpool flux (latter smoothed o gC/m^2/s T +NDEPLOY total N deployed in new growth gN/m^2/s T +NDEP_PROF profile for atmospheric N deposition 1/m F +NDEP_TO_SMINN atmospheric N deposition to soil mineral N gN/m^2/s T +NECM ECM-associated N uptake flux gN/m^2/s T +NECM_NH4 ECM-associated N uptake flux gN/m^2/s T +NECM_NO3 ECM-associated N uptake flux gN/m^2/s T +NEE net ecosystem exchange of carbon, includes fire and hrv_xsmrpool (latter smoothed over the yea gC/m^2/s T +NEM Gridcell net adjustment to net carbon exchange passed to atm. for methane production gC/m2/s T +NEP net ecosystem production, excludes fire, landuse, and harvest flux, positive for sink gC/m^2/s T +NET_NMIN net rate of N mineralization gN/m^2/s T +NET_NMIN_vr net rate of N mineralization gN/m^3/s F +NFERTILIZATION fertilizer added gN/m^2/s T +NFIRE fire counts valid only in Reg.C counts/km2/sec T +NFIX Symbiotic BNF uptake flux gN/m^2/s T +NFIXATION_PROF profile for biological N fixation 1/m F +NFIX_TO_SMINN symbiotic/asymbiotic N fixation to soil mineral N gN/m^2/s F +NNONMYC Non-mycorrhizal N uptake flux gN/m^2/s T +NNONMYC_NH4 Non-mycorrhizal N uptake flux gN/m^2/s T +NNONMYC_NO3 Non-mycorrhizal N uptake flux gN/m^2/s T +NPASSIVE Passive N uptake flux gN/m^2/s T +NPOOL temporary plant N pool gN/m^2 T +NPOOL_TO_DEADCROOTN allocation to dead coarse root N gN/m^2/s F +NPOOL_TO_DEADCROOTN_STORAGE allocation to dead coarse root N storage gN/m^2/s F +NPOOL_TO_DEADSTEMN allocation to dead stem N gN/m^2/s F +NPOOL_TO_DEADSTEMN_STORAGE allocation to dead stem N storage gN/m^2/s F +NPOOL_TO_FROOTN allocation to fine root N gN/m^2/s F +NPOOL_TO_FROOTN_STORAGE allocation to fine root N storage gN/m^2/s F +NPOOL_TO_LEAFN allocation to leaf N gN/m^2/s F +NPOOL_TO_LEAFN_STORAGE allocation to leaf N storage gN/m^2/s F +NPOOL_TO_LIVECROOTN allocation to live coarse root N gN/m^2/s F +NPOOL_TO_LIVECROOTN_STORAGE allocation to live coarse root N storage gN/m^2/s F +NPOOL_TO_LIVESTEMN allocation to live stem N gN/m^2/s F +NPOOL_TO_LIVESTEMN_STORAGE allocation to live stem N storage gN/m^2/s F +NPP net primary production gC/m^2/s T +NPP_BURNEDOFF C that cannot be used for N uptake gC/m^2/s F +NPP_GROWTH Total C used for growth in FUN gC/m^2/s T +NPP_NACTIVE Mycorrhizal N uptake used C gC/m^2/s T +NPP_NACTIVE_NH4 Mycorrhizal N uptake use C gC/m^2/s T +NPP_NACTIVE_NO3 Mycorrhizal N uptake used C gC/m^2/s T +NPP_NAM AM-associated N uptake used C gC/m^2/s T +NPP_NAM_NH4 AM-associated N uptake use C gC/m^2/s T +NPP_NAM_NO3 AM-associated N uptake use C gC/m^2/s T +NPP_NECM ECM-associated N uptake used C gC/m^2/s T +NPP_NECM_NH4 ECM-associated N uptake use C gC/m^2/s T +NPP_NECM_NO3 ECM-associated N uptake used C gC/m^2/s T +NPP_NFIX Symbiotic BNF uptake used C gC/m^2/s T +NPP_NNONMYC Non-mycorrhizal N uptake used C gC/m^2/s T +NPP_NNONMYC_NH4 Non-mycorrhizal N uptake use C gC/m^2/s T +NPP_NNONMYC_NO3 Non-mycorrhizal N uptake use C gC/m^2/s T +NPP_NRETRANS Retranslocated N uptake flux gC/m^2/s T +NPP_NUPTAKE Total C used by N uptake in FUN gC/m^2/s T +NRETRANS Retranslocated N uptake flux gN/m^2/s T +NRETRANS_REG Retranslocated N uptake flux gN/m^2/s T +NRETRANS_SEASON Retranslocated N uptake flux gN/m^2/s T +NRETRANS_STRESS Retranslocated N uptake flux gN/m^2/s T +NSUBSTEPS number of adaptive timesteps in CLM timestep unitless F +NUPTAKE Total N uptake of FUN gN/m^2/s T +NUPTAKE_NPP_FRACTION frac of NPP used in N uptake - T +N_ALLOMETRY N allocation index none F +O2_DECOMP_DEPTH_UNSAT O2 consumption from HR and AR for non-inundated area mol/m3/s F +OBU Monin-Obukhov length m F +OCDEP total OC deposition (dry+wet) from atmosphere kg/m^2/s T +OFFSET_COUNTER offset days counter days F +OFFSET_FDD offset freezing degree days counter C degree-days F +OFFSET_FLAG offset flag none F +OFFSET_SWI offset soil water index none F +ONSET_COUNTER onset days counter days F +ONSET_FDD onset freezing degree days counter C degree-days F +ONSET_FLAG onset flag none F +ONSET_GDD onset growing degree days C degree-days F +ONSET_GDDFLAG onset flag for growing degree day sum none F +ONSET_SWI onset soil water index none F +O_SCALAR fraction by which decomposition is reduced due to anoxia unitless T +PAR240DZ 10-day running mean of daytime patch absorbed PAR for leaves for top canopy layer W/m^2 F +PAR240XZ 10-day running mean of maximum patch absorbed PAR for leaves for top canopy layer W/m^2 F +PAR240_shade shade PAR (240 hrs) umol/m2/s F +PAR240_sun sunlit PAR (240 hrs) umol/m2/s F +PAR24_shade shade PAR (24 hrs) umol/m2/s F +PAR24_sun sunlit PAR (24 hrs) umol/m2/s F +PARVEGLN absorbed par by vegetation at local noon W/m^2 T +PAR_shade shade PAR umol/m2/s F +PAR_sun sunlit PAR umol/m2/s F +PAS_SOMC PAS_SOM C gC/m^2 T +PAS_SOMC_1m PAS_SOM C to 1 meter gC/m^2 F +PAS_SOMC_TNDNCY_VERT_TRA passive soil organic C tendency due to vertical transport gC/m^3/s F +PAS_SOMC_TO_ACT_SOMC decomp. of passive soil organic C to active soil organic C gC/m^2/s F +PAS_SOMC_TO_ACT_SOMC_vr decomp. of passive soil organic C to active soil organic C gC/m^3/s F +PAS_SOMC_vr PAS_SOM C (vertically resolved) gC/m^3 T +PAS_SOMN PAS_SOM N gN/m^2 T +PAS_SOMN_1m PAS_SOM N to 1 meter gN/m^2 F +PAS_SOMN_TNDNCY_VERT_TRA passive soil organic N tendency due to vertical transport gN/m^3/s F +PAS_SOMN_TO_ACT_SOMN decomp. of passive soil organic N to active soil organic N gN/m^2 F +PAS_SOMN_TO_ACT_SOMN_vr decomp. of passive soil organic N to active soil organic N gN/m^3 F +PAS_SOMN_vr PAS_SOM N (vertically resolved) gN/m^3 T +PAS_SOM_HR Het. Resp. from passive soil organic gC/m^2/s F +PAS_SOM_HR_vr Het. Resp. from passive soil organic gC/m^3/s F +PBOT atmospheric pressure at surface (downscaled to columns in glacier regions) Pa T +PBOT_240 10 day running mean of air pressure Pa F +PCH4 atmospheric partial pressure of CH4 Pa T +PCO2 atmospheric partial pressure of CO2 Pa T +PCO2_240 10 day running mean of CO2 pressure Pa F +PFT_CTRUNC patch-level sink for C truncation gC/m^2 F +PFT_FIRE_CLOSS total patch-level fire C loss for non-peat fires outside land-type converted region gC/m^2/s T +PFT_FIRE_NLOSS total patch-level fire N loss gN/m^2/s T +PFT_NTRUNC patch-level sink for N truncation gN/m^2 F +PLANTCN Plant C:N used by FUN unitless F +PLANT_CALLOC total allocated C flux gC/m^2/s F +PLANT_NALLOC total allocated N flux gN/m^2/s F +PLANT_NDEMAND N flux required to support initial GPP gN/m^2/s T +PNLCZ Proportion of nitrogen allocated for light capture unitless F +PO2_240 10 day running mean of O2 pressure Pa F +POTENTIAL_IMMOB potential N immobilization gN/m^2/s T +POTENTIAL_IMMOB_vr potential N immobilization gN/m^3/s F +POT_F_DENIT potential denitrification flux gN/m^2/s T +POT_F_DENIT_vr potential denitrification flux gN/m^3/s F +POT_F_NIT potential nitrification flux gN/m^2/s T +POT_F_NIT_vr potential nitrification flux gN/m^3/s F +PREC10 10-day running mean of PREC MM H2O/S F +PREC60 60-day running mean of PREC MM H2O/S F +PREV_DAYL daylength from previous timestep s F +PREV_FROOTC_TO_LITTER previous timestep froot C litterfall flux gC/m^2/s F +PREV_LEAFC_TO_LITTER previous timestep leaf C litterfall flux gC/m^2/s F +PROD100C 100-yr wood product C gC/m^2 F +PROD100C_LOSS loss from 100-yr wood product pool gC/m^2/s F +PROD100N 100-yr wood product N gN/m^2 F +PROD100N_LOSS loss from 100-yr wood product pool gN/m^2/s F +PROD10C 10-yr wood product C gC/m^2 F +PROD10C_LOSS loss from 10-yr wood product pool gC/m^2/s F +PROD10N 10-yr wood product N gN/m^2 F +PROD10N_LOSS loss from 10-yr wood product pool gN/m^2/s F +PSNSHA shaded leaf photosynthesis umolCO2/m^2/s T +PSNSHADE_TO_CPOOL C fixation from shaded canopy gC/m^2/s T +PSNSUN sunlit leaf photosynthesis umolCO2/m^2/s T +PSNSUN_TO_CPOOL C fixation from sunlit canopy gC/m^2/s T +PSurf atmospheric pressure at surface (downscaled to columns in glacier regions) Pa F +Q2M 2m specific humidity kg/kg T +QAF canopy air humidity kg/kg F +QBOT atmospheric specific humidity (downscaled to columns in glacier regions) kg/kg T +QDIRECT_THROUGHFALL direct throughfall of liquid (rain + above-canopy irrigation) mm/s F +QDIRECT_THROUGHFALL_SNOW direct throughfall of snow mm/s F +QDRAI sub-surface drainage mm/s T +QDRAI_PERCH perched wt drainage mm/s T +QDRAI_XS saturation excess drainage mm/s T +QDRIP rate of excess canopy liquid falling off canopy mm/s F +QDRIP_SNOW rate of excess canopy snow falling off canopy mm/s F +QFLOOD runoff from river flooding mm/s T +QFLX_EVAP_TOT qflx_evap_soi + qflx_evap_can + qflx_tran_veg kg m-2 s-1 T +QFLX_EVAP_VEG vegetation evaporation mm H2O/s F +QFLX_ICE_DYNBAL ice dynamic land cover change conversion runoff flux mm/s T +QFLX_LIQDEW_TO_TOP_LAYER rate of liquid water deposited on top soil or snow layer (dew) mm H2O/s T +QFLX_LIQEVAP_FROM_TOP_LAYER rate of liquid water evaporated from top soil or snow layer mm H2O/s T +QFLX_LIQ_DYNBAL liq dynamic land cover change conversion runoff flux mm/s T +QFLX_LIQ_GRND liquid (rain+irrigation) on ground after interception mm H2O/s F +QFLX_SNOW_DRAIN drainage from snow pack mm/s T +QFLX_SNOW_DRAIN_ICE drainage from snow pack melt (ice landunits only) mm/s T +QFLX_SNOW_GRND snow on ground after interception mm H2O/s F +QFLX_SOLIDDEW_TO_TOP_LAYER rate of solid water deposited on top soil or snow layer (frost) mm H2O/s T +QFLX_SOLIDEVAP_FROM_TOP_LAYER rate of ice evaporated from top soil or snow layer (sublimation) (also includes bare ice subli mm H2O/s T +QFLX_SOLIDEVAP_FROM_TOP_LAYER_ICE rate of ice evaporated from top soil or snow layer (sublimation) (also includes bare ice subli mm H2O/s F +QH2OSFC surface water runoff mm/s T +QH2OSFC_TO_ICE surface water converted to ice mm/s F +QHR hydraulic redistribution mm/s T +QICE ice growth/melt mm/s T +QICE_FORC qice forcing sent to GLC mm/s F +QICE_FRZ ice growth mm/s T +QICE_MELT ice melt mm/s T +QINFL infiltration mm/s T +QINTR interception mm/s T +QIRRIG_DEMAND irrigation demand mm/s F +QIRRIG_DRIP water added via drip irrigation mm/s F +QIRRIG_FROM_GW_CONFINED water added through confined groundwater irrigation mm/s T +QIRRIG_FROM_GW_UNCONFINED water added through unconfined groundwater irrigation mm/s T +QIRRIG_FROM_SURFACE water added through surface water irrigation mm/s T +QIRRIG_SPRINKLER water added via sprinkler irrigation mm/s F +QOVER total surface runoff (includes QH2OSFC) mm/s T +QOVER_LAG time-lagged surface runoff for soil columns mm/s F +QPHSNEG net negative hydraulic redistribution flux mm/s F +QRGWL surface runoff at glaciers (liquid only), wetlands, lakes; also includes melted ice runoff fro mm/s T +QROOTSINK water flux from soil to root in each soil-layer mm/s F +QRUNOFF total liquid runoff not including correction for land use change mm/s T +QRUNOFF_ICE total liquid runoff not incl corret for LULCC (ice landunits only) mm/s T +QRUNOFF_ICE_TO_COUPLER total ice runoff sent to coupler (includes corrections for land use change) mm/s T +QRUNOFF_ICE_TO_LIQ liquid runoff from converted ice runoff mm/s F +QRUNOFF_R Rural total runoff mm/s F +QRUNOFF_TO_COUPLER total liquid runoff sent to coupler (includes corrections for land use change) mm/s T +QRUNOFF_U Urban total runoff mm/s F +QSNOCPLIQ excess liquid h2o due to snow capping not including correction for land use change mm H2O/s T +QSNOEVAP evaporation from snow (only when snl<0, otherwise it is equal to qflx_ev_soil) mm/s T +QSNOFRZ column-integrated snow freezing rate kg/m2/s T +QSNOFRZ_ICE column-integrated snow freezing rate (ice landunits only) mm/s T +QSNOMELT snow melt rate mm/s T +QSNOMELT_ICE snow melt (ice landunits only) mm/s T +QSNOUNLOAD canopy snow unloading mm/s T +QSNO_TEMPUNLOAD canopy snow temp unloading mm/s T +QSNO_WINDUNLOAD canopy snow wind unloading mm/s T +QSNWCPICE excess solid h2o due to snow capping not including correction for land use change mm H2O/s T +QSOIL Ground evaporation (soil/snow evaporation + soil/snow sublimation - dew) mm/s T +QSOIL_ICE Ground evaporation (ice landunits only) mm/s T +QTOPSOIL water input to surface mm/s F +QVEGE canopy evaporation mm/s T +QVEGT canopy transpiration mm/s T +Qair atmospheric specific humidity (downscaled to columns in glacier regions) kg/kg F +Qh sensible heat W/m^2 F +Qle total evaporation W/m^2 F +Qstor storage heat flux (includes snowmelt) W/m^2 F +Qtau momentum flux kg/m/s^2 F +RAH1 aerodynamical resistance s/m F +RAH2 aerodynamical resistance s/m F +RAIN atmospheric rain, after rain/snow repartitioning based on temperature mm/s T +RAIN_FROM_ATM atmospheric rain received from atmosphere (pre-repartitioning) mm/s T +RAIN_ICE atmospheric rain, after rain/snow repartitioning based on temperature (ice landunits only) mm/s F +RAM1 aerodynamical resistance s/m F +RAM_LAKE aerodynamic resistance for momentum (lakes only) s/m F +RAW1 aerodynamical resistance s/m F +RAW2 aerodynamical resistance s/m F +RB leaf boundary resistance s/m F +RB10 10 day running mean boundary layer resistance s/m F +RETRANSN plant pool of retranslocated N gN/m^2 T +RETRANSN_TO_NPOOL deployment of retranslocated N gN/m^2/s T +RH atmospheric relative humidity % F +RH2M 2m relative humidity % T +RH2M_R Rural 2m specific humidity % F +RH2M_U Urban 2m relative humidity % F +RH30 30-day running mean of relative humidity % F +RHAF fractional humidity of canopy air fraction F +RHAF10 10 day running mean of fractional humidity of canopy air fraction F +RH_LEAF fractional humidity at leaf surface fraction F +ROOTR effective fraction of roots in each soil layer (SMS method) proportion F +RR root respiration (fine root MR + total root GR) gC/m^2/s T +RRESIS root resistance in each soil layer proportion F +RSSHA shaded leaf stomatal resistance s/m T +RSSUN sunlit leaf stomatal resistance s/m T +Rainf atmospheric rain, after rain/snow repartitioning based on temperature mm/s F +Rnet net radiation W/m^2 F +SABG solar rad absorbed by ground W/m^2 T +SABG_PEN Rural solar rad penetrating top soil or snow layer watt/m^2 T +SABV solar rad absorbed by veg W/m^2 T +SDATES Crop sowing dates in each calendar year day of year (julian day) F +SDATES_PERHARV For each harvest in a calendar year, the Julian day the crop was sown day of year (julian day) F +SEEDC pool for seeding new PFTs via dynamic landcover gC/m^2 T +SEEDN pool for seeding new PFTs via dynamic landcover gN/m^2 T +SLASH_HARVESTC slash harvest carbon (to litter) gC/m^2/s T +SLO_SOMC SLO_SOM C gC/m^2 T +SLO_SOMC_1m SLO_SOM C to 1 meter gC/m^2 F +SLO_SOMC_TNDNCY_VERT_TRA slow soil organic ma C tendency due to vertical transport gC/m^3/s F +SLO_SOMC_TO_ACT_SOMC decomp. of slow soil organic ma C to active soil organic C gC/m^2/s F +SLO_SOMC_TO_ACT_SOMC_vr decomp. of slow soil organic ma C to active soil organic C gC/m^3/s F +SLO_SOMC_TO_PAS_SOMC decomp. of slow soil organic ma C to passive soil organic C gC/m^2/s F +SLO_SOMC_TO_PAS_SOMC_vr decomp. of slow soil organic ma C to passive soil organic C gC/m^3/s F +SLO_SOMC_vr SLO_SOM C (vertically resolved) gC/m^3 T +SLO_SOMN SLO_SOM N gN/m^2 T +SLO_SOMN_1m SLO_SOM N to 1 meter gN/m^2 F +SLO_SOMN_TNDNCY_VERT_TRA slow soil organic ma N tendency due to vertical transport gN/m^3/s F +SLO_SOMN_TO_ACT_SOMN decomp. of slow soil organic ma N to active soil organic N gN/m^2 F +SLO_SOMN_TO_ACT_SOMN_vr decomp. of slow soil organic ma N to active soil organic N gN/m^3 F +SLO_SOMN_TO_PAS_SOMN decomp. of slow soil organic ma N to passive soil organic N gN/m^2 F +SLO_SOMN_TO_PAS_SOMN_vr decomp. of slow soil organic ma N to passive soil organic N gN/m^3 F +SLO_SOMN_vr SLO_SOM N (vertically resolved) gN/m^3 T +SLO_SOM_HR_S1 Het. Resp. from slow soil organic ma gC/m^2/s F +SLO_SOM_HR_S1_vr Het. Resp. from slow soil organic ma gC/m^3/s F +SLO_SOM_HR_S3 Het. Resp. from slow soil organic ma gC/m^2/s F +SLO_SOM_HR_S3_vr Het. Resp. from slow soil organic ma gC/m^3/s F +SMINN soil mineral N gN/m^2 T +SMINN_TO_NPOOL deployment of soil mineral N uptake gN/m^2/s T +SMINN_TO_PLANT plant uptake of soil mineral N gN/m^2/s T +SMINN_TO_PLANT_FUN Total soil N uptake of FUN gN/m^2/s T +SMINN_TO_PLANT_vr plant uptake of soil mineral N gN/m^3/s F +SMINN_TO_S1N_L1 mineral N flux for decomp. of MET_LITto ACT_SOM gN/m^2 F +SMINN_TO_S1N_L1_vr mineral N flux for decomp. of MET_LITto ACT_SOM gN/m^3 F +SMINN_TO_S1N_L2 mineral N flux for decomp. of CEL_LITto ACT_SOM gN/m^2 F +SMINN_TO_S1N_L2_vr mineral N flux for decomp. of CEL_LITto ACT_SOM gN/m^3 F +SMINN_TO_S1N_S2 mineral N flux for decomp. of SLO_SOMto ACT_SOM gN/m^2 F +SMINN_TO_S1N_S2_vr mineral N flux for decomp. of SLO_SOMto ACT_SOM gN/m^3 F +SMINN_TO_S1N_S3 mineral N flux for decomp. of PAS_SOMto ACT_SOM gN/m^2 F +SMINN_TO_S1N_S3_vr mineral N flux for decomp. of PAS_SOMto ACT_SOM gN/m^3 F +SMINN_TO_S2N_L3 mineral N flux for decomp. of LIG_LITto SLO_SOM gN/m^2 F +SMINN_TO_S2N_L3_vr mineral N flux for decomp. of LIG_LITto SLO_SOM gN/m^3 F +SMINN_TO_S2N_S1 mineral N flux for decomp. of ACT_SOMto SLO_SOM gN/m^2 F +SMINN_TO_S2N_S1_vr mineral N flux for decomp. of ACT_SOMto SLO_SOM gN/m^3 F +SMINN_TO_S3N_S1 mineral N flux for decomp. of ACT_SOMto PAS_SOM gN/m^2 F +SMINN_TO_S3N_S1_vr mineral N flux for decomp. of ACT_SOMto PAS_SOM gN/m^3 F +SMINN_TO_S3N_S2 mineral N flux for decomp. of SLO_SOMto PAS_SOM gN/m^2 F +SMINN_TO_S3N_S2_vr mineral N flux for decomp. of SLO_SOMto PAS_SOM gN/m^3 F +SMINN_vr soil mineral N gN/m^3 T +SMIN_NH4 soil mineral NH4 gN/m^2 T +SMIN_NH4_TO_PLANT plant uptake of NH4 gN/m^3/s F +SMIN_NH4_vr soil mineral NH4 (vert. res.) gN/m^3 T +SMIN_NO3 soil mineral NO3 gN/m^2 T +SMIN_NO3_LEACHED soil NO3 pool loss to leaching gN/m^2/s T +SMIN_NO3_LEACHED_vr soil NO3 pool loss to leaching gN/m^3/s F +SMIN_NO3_MASSDENS SMIN_NO3_MASSDENS ugN/cm^3 soil F +SMIN_NO3_RUNOFF soil NO3 pool loss to runoff gN/m^2/s T +SMIN_NO3_RUNOFF_vr soil NO3 pool loss to runoff gN/m^3/s F +SMIN_NO3_TO_PLANT plant uptake of NO3 gN/m^3/s F +SMIN_NO3_vr soil mineral NO3 (vert. res.) gN/m^3 T +SMP soil matric potential (natural vegetated and crop landunits only) mm T +SNOBCMCL mass of BC in snow column kg/m2 T +SNOBCMSL mass of BC in top snow layer kg/m2 T +SNOCAN intercepted snow mm T +SNODSTMCL mass of dust in snow column kg/m2 T +SNODSTMSL mass of dust in top snow layer kg/m2 T +SNOFSDSND direct nir incident solar radiation on snow W/m^2 F +SNOFSDSNI diffuse nir incident solar radiation on snow W/m^2 F +SNOFSDSVD direct vis incident solar radiation on snow W/m^2 F +SNOFSDSVI diffuse vis incident solar radiation on snow W/m^2 F +SNOFSRND direct nir reflected solar radiation from snow W/m^2 T +SNOFSRNI diffuse nir reflected solar radiation from snow W/m^2 T +SNOFSRVD direct vis reflected solar radiation from snow W/m^2 T +SNOFSRVI diffuse vis reflected solar radiation from snow W/m^2 T +SNOINTABS Fraction of incoming solar absorbed by lower snow layers - T +SNOLIQFL top snow layer liquid water fraction (land) fraction F +SNOOCMCL mass of OC in snow column kg/m2 T +SNOOCMSL mass of OC in top snow layer kg/m2 T +SNORDSL top snow layer effective grain radius m^-6 F +SNOTTOPL snow temperature (top layer) K F +SNOTTOPL_ICE snow temperature (top layer, ice landunits only) K F +SNOTXMASS snow temperature times layer mass, layer sum; to get mass-weighted temperature, divide by (SNO K kg/m2 T +SNOTXMASS_ICE snow temperature times layer mass, layer sum (ice landunits only); to get mass-weighted temper K kg/m2 F +SNOW atmospheric snow, after rain/snow repartitioning based on temperature mm/s T +SNOWDP gridcell mean snow height m T +SNOWICE snow ice kg/m2 T +SNOWICE_ICE snow ice (ice landunits only) kg/m2 F +SNOWLIQ snow liquid water kg/m2 T +SNOWLIQ_ICE snow liquid water (ice landunits only) kg/m2 F +SNOW_5D 5day snow avg m F +SNOW_DEPTH snow height of snow covered area m T +SNOW_DEPTH_ICE snow height of snow covered area (ice landunits only) m F +SNOW_FROM_ATM atmospheric snow received from atmosphere (pre-repartitioning) mm/s T +SNOW_ICE atmospheric snow, after rain/snow repartitioning based on temperature (ice landunits only) mm/s F +SNOW_PERSISTENCE Length of time of continuous snow cover (nat. veg. landunits only) seconds T +SNOW_SINKS snow sinks (liquid water) mm/s T +SNOW_SOURCES snow sources (liquid water) mm/s T +SNO_ABS Absorbed solar radiation in each snow layer W/m^2 F +SNO_ABS_ICE Absorbed solar radiation in each snow layer (ice landunits only) W/m^2 F +SNO_BW Partial density of water in the snow pack (ice + liquid) kg/m3 F +SNO_BW_ICE Partial density of water in the snow pack (ice + liquid, ice landunits only) kg/m3 F +SNO_EXISTENCE Fraction of averaging period for which each snow layer existed unitless F +SNO_FRZ snow freezing rate in each snow layer kg/m2/s F +SNO_FRZ_ICE snow freezing rate in each snow layer (ice landunits only) mm/s F +SNO_GS Mean snow grain size Microns F +SNO_GS_ICE Mean snow grain size (ice landunits only) Microns F +SNO_ICE Snow ice content kg/m2 F +SNO_LIQH2O Snow liquid water content kg/m2 F +SNO_MELT snow melt rate in each snow layer mm/s F +SNO_MELT_ICE snow melt rate in each snow layer (ice landunits only) mm/s F +SNO_T Snow temperatures K F +SNO_TK Thermal conductivity W/m-K F +SNO_TK_ICE Thermal conductivity (ice landunits only) W/m-K F +SNO_T_ICE Snow temperatures (ice landunits only) K F +SNO_Z Snow layer thicknesses m F +SNO_Z_ICE Snow layer thicknesses (ice landunits only) m F +SNOdTdzL top snow layer temperature gradient (land) K/m F +SOIL10 10-day running mean of 12cm layer soil K F +SOILC_CHANGE C change in soil gC/m^2/s T +SOILC_HR soil C heterotrophic respiration gC/m^2/s T +SOILC_vr SOIL C (vertically resolved) gC/m^3 T +SOILICE soil ice (natural vegetated and crop landunits only) kg/m2 T +SOILLIQ soil liquid water (natural vegetated and crop landunits only) kg/m2 T +SOILN_vr SOIL N (vertically resolved) gN/m^3 T +SOILPSI soil water potential in each soil layer MPa F +SOILRESIS soil resistance to evaporation s/m T +SOILWATER_10CM soil liquid water + ice in top 10cm of soil (veg landunits only) kg/m2 T +SOMC_FIRE C loss due to peat burning gC/m^2/s T +SOMFIRE soil organic matter fire losses gC/m^2/s F +SOM_ADV_COEF advection term for vertical SOM translocation m/s F +SOM_C_LEACHED total flux of C from SOM pools due to leaching gC/m^2/s T +SOM_DIFFUS_COEF diffusion coefficient for vertical SOM translocation m^2/s F +SOM_N_LEACHED total flux of N from SOM pools due to leaching gN/m^2/s F +SOWING_REASON For each sowing in a calendar year, the reason the crop was sown categorical F +SOWING_REASON_PERHARV For each harvest in a calendar year, the reason the crop was sown categorical F +SR total soil respiration (HR + root resp) gC/m^2/s T +SSRE_FSR surface snow effect on reflected solar radiation W/m^2 T +SSRE_FSRND surface snow effect on direct nir reflected solar radiation W/m^2 T +SSRE_FSRNDLN surface snow effect on direct nir reflected solar radiation at local noon W/m^2 T +SSRE_FSRNI surface snow effect on diffuse nir reflected solar radiation W/m^2 T +SSRE_FSRVD surface snow radiatve effect on direct vis reflected solar radiation W/m^2 T +SSRE_FSRVDLN surface snow radiatve effect on direct vis reflected solar radiation at local noon W/m^2 T +SSRE_FSRVI surface snow radiatve effect on diffuse vis reflected solar radiation W/m^2 T +STEM_PROF profile for litter C and N inputs from stems 1/m F +STORAGE_CDEMAND C use from the C storage pool gC/m^2 F +STORAGE_GR growth resp for growth sent to storage for later display gC/m^2/s F +STORAGE_NDEMAND N demand during the offset period gN/m^2 F +STORVEGC stored vegetation carbon, excluding cpool gC/m^2 T +STORVEGN stored vegetation nitrogen gN/m^2 T +SUPPLEMENT_TO_SMINN supplemental N supply gN/m^2/s T +SUPPLEMENT_TO_SMINN_vr supplemental N supply gN/m^3/s F +SYEARS_PERHARV For each harvest in a calendar year, the year the crop was sown year F +SWBGT 2 m Simplified Wetbulb Globe Temp C T +SWBGT_R Rural 2 m Simplified Wetbulb Globe Temp C T +SWBGT_U Urban 2 m Simplified Wetbulb Globe Temp C T +SWMP65 2 m Swamp Cooler Temp 65% Eff C T +SWMP65_R Rural 2 m Swamp Cooler Temp 65% Eff C T +SWMP65_U Urban 2 m Swamp Cooler Temp 65% Eff C T +SWMP80 2 m Swamp Cooler Temp 80% Eff C T +SWMP80_R Rural 2 m Swamp Cooler Temp 80% Eff C T +SWMP80_U Urban 2 m Swamp Cooler Temp 80% Eff C T +SWdown atmospheric incident solar radiation W/m^2 F +SWup upwelling shortwave radiation W/m^2 F +SoilAlpha factor limiting ground evap unitless F +SoilAlpha_U urban factor limiting ground evap unitless F +T10 10-day running mean of 2-m temperature K F +TAF canopy air temperature K F +TAUX zonal surface stress kg/m/s^2 T +TAUY meridional surface stress kg/m/s^2 T +TBOT atmospheric air temperature (downscaled to columns in glacier regions) K T +TBUILD internal urban building air temperature K T +TBUILD_MAX prescribed maximum interior building temperature K F +TEMPAVG_T2M temporary average 2m air temperature K F +TEMPMAX_RETRANSN temporary annual max of retranslocated N pool gN/m^2 F +TEMPSUM_POTENTIAL_GPP temporary annual sum of potential GPP gC/m^2/yr F +TEQ 2 m Equiv Temp K T +TEQ_R Rural 2 m Equiv Temp K T +TEQ_U Urban 2 m Equiv Temp K T +TFLOOR floor temperature K F +TG ground temperature K T +TG_ICE ground temperature (ice landunits only) K F +TG_R Rural ground temperature K F +TG_U Urban ground temperature K F +TH2OSFC surface water temperature K T +THBOT atmospheric air potential temperature (downscaled to columns in glacier regions) K T +THIC 2 m Temp Hum Index Comfort C T +THIC_R Rural 2 m Temp Hum Index Comfort C T +THIC_U Urban 2 m Temp Hum Index Comfort C T +THIP 2 m Temp Hum Index Physiology C T +THIP_R Rural 2 m Temp Hum Index Physiology C T +THIP_U Urban 2 m Temp Hum Index Physiology C T +TKE1 top lake level eddy thermal conductivity W/(mK) T +TLAI total projected leaf area index m^2/m^2 T +TLAKE lake temperature K T +TOPO_COL column-level topographic height m F +TOPO_COL_ICE column-level topographic height (ice landunits only) m F +TOPO_FORC topograephic height sent to GLC m F +TOPT topt coefficient for VOC calc non F +TOTCOLC total column carbon, incl veg and cpool but excl product pools gC/m^2 T +TOTCOLCH4 total belowground CH4 (0 for non-lake special landunits in the absence of dynamic landunits) gC/m2 T +TOTCOLN total column-level N, excluding product pools gN/m^2 T +TOTECOSYSC total ecosystem carbon, incl veg but excl cpool and product pools gC/m^2 T +TOTECOSYSN total ecosystem N, excluding product pools gN/m^2 T +TOTFIRE total ecosystem fire losses gC/m^2/s F +TOTLITC total litter carbon gC/m^2 T +TOTLITC_1m total litter carbon to 1 meter depth gC/m^2 T +TOTLITN total litter N gN/m^2 T +TOTLITN_1m total litter N to 1 meter gN/m^2 T +TOTPFTC total patch-level carbon, including cpool gC/m^2 T +TOTPFTN total patch-level nitrogen gN/m^2 T +TOTSOILICE vertically summed soil cie (veg landunits only) kg/m2 T +TOTSOILLIQ vertically summed soil liquid water (veg landunits only) kg/m2 T +TOTSOMC total soil organic matter carbon gC/m^2 T +TOTSOMC_1m total soil organic matter carbon to 1 meter depth gC/m^2 T +TOTSOMN total soil organic matter N gN/m^2 T +TOTSOMN_1m total soil organic matter N to 1 meter gN/m^2 T +TOTVEGC total vegetation carbon, excluding cpool gC/m^2 T +TOTVEGN total vegetation nitrogen gN/m^2 T +TOT_WOODPRODC total wood product C gC/m^2 T +TOT_WOODPRODC_LOSS total loss from wood product pools gC/m^2/s T +TOT_WOODPRODN total wood product N gN/m^2 T +TOT_WOODPRODN_LOSS total loss from wood product pools gN/m^2/s T +TPU25T canopy profile of tpu umol/m2/s T +TRAFFICFLUX sensible heat flux from urban traffic W/m^2 F +TRANSFER_DEADCROOT_GR dead coarse root growth respiration from storage gC/m^2/s F +TRANSFER_DEADSTEM_GR dead stem growth respiration from storage gC/m^2/s F +TRANSFER_FROOT_GR fine root growth respiration from storage gC/m^2/s F +TRANSFER_GR growth resp for transfer growth displayed in this timestep gC/m^2/s F +TRANSFER_LEAF_GR leaf growth respiration from storage gC/m^2/s F +TRANSFER_LIVECROOT_GR live coarse root growth respiration from storage gC/m^2/s F +TRANSFER_LIVESTEM_GR live stem growth respiration from storage gC/m^2/s F +TREFMNAV daily minimum of average 2-m temperature K T +TREFMNAV_R Rural daily minimum of average 2-m temperature K F +TREFMNAV_U Urban daily minimum of average 2-m temperature K F +TREFMXAV daily maximum of average 2-m temperature K T +TREFMXAV_R Rural daily maximum of average 2-m temperature K F +TREFMXAV_U Urban daily maximum of average 2-m temperature K F +TROOF_INNER roof inside surface temperature K F +TSA 2m air temperature K T +TSAI total projected stem area index m^2/m^2 T +TSA_ICE 2m air temperature (ice landunits only) K F +TSA_R Rural 2m air temperature K F +TSA_U Urban 2m air temperature K F +TSHDW_INNER shadewall inside surface temperature K F +TSKIN skin temperature K T +TSL temperature of near-surface soil layer (natural vegetated and crop landunits only) K T +TSOI soil temperature (natural vegetated and crop landunits only) K T +TSOI_10CM soil temperature in top 10cm of soil K T +TSOI_ICE soil temperature (ice landunits only) K T +TSRF_FORC surface temperature sent to GLC K F +TSUNW_INNER sunwall inside surface temperature K F +TV vegetation temperature K T +TV24 vegetation temperature (last 24hrs) K F +TV240 vegetation temperature (last 240hrs) K F +TVEGD10 10 day running mean of patch daytime vegetation temperature Kelvin F +TVEGN10 10 day running mean of patch night-time vegetation temperature Kelvin F +TWS total water storage mm T +T_SCALAR temperature inhibition of decomposition unitless T +Tair atmospheric air temperature (downscaled to columns in glacier regions) K F +Tair_from_atm atmospheric air temperature received from atmosphere (pre-downscaling) K F +U10 10-m wind m/s T +U10_DUST 10-m wind for dust model m/s T +U10_ICE 10-m wind (ice landunits only) m/s F +UAF canopy air speed m/s F +ULRAD upward longwave radiation above the canopy W/m^2 F +UM wind speed plus stability effect m/s F +URBAN_AC urban air conditioning flux W/m^2 T +URBAN_HEAT urban heating flux W/m^2 T +USTAR aerodynamical resistance s/m F +UST_LAKE friction velocity (lakes only) m/s F +VA atmospheric wind speed plus convective velocity m/s F +VCMX25T canopy profile of vcmax25 umol/m2/s T +VEGWP vegetation water matric potential for sun/sha canopy,xyl,root segments mm T +VEGWPLN vegetation water matric potential for sun/sha canopy,xyl,root at local noon mm T +VEGWPPD predawn vegetation water matric potential for sun/sha canopy,xyl,root mm T +VOCFLXT total VOC flux into atmosphere moles/m2/sec F +VOLR river channel total water storage m3 T +VOLRMCH river channel main channel water storage m3 T +VPD vpd Pa F +VPD2M 2m vapor pressure deficit Pa T +VPD_CAN canopy vapor pressure deficit kPa T +Vcmx25Z canopy profile of vcmax25 predicted by LUNA model umol/m2/s T +WASTEHEAT sensible heat flux from heating/cooling sources of urban waste heat W/m^2 T +WBA 2 m Wet Bulb C T +WBA_R Rural 2 m Wet Bulb C T +WBA_U Urban 2 m Wet Bulb C T +WBT 2 m Stull Wet Bulb C T +WBT_R Rural 2 m Stull Wet Bulb C T +WBT_U Urban 2 m Stull Wet Bulb C T +WF soil water as frac. of whc for top 0.05 m proportion F +WFPS WFPS percent F +WIND atmospheric wind velocity magnitude m/s T +WOODC wood C gC/m^2 T +WOODC_ALLOC wood C eallocation gC/m^2/s T +WOODC_LOSS wood C loss gC/m^2/s T +WOOD_HARVESTC wood harvest carbon (to product pools) gC/m^2/s T +WOOD_HARVESTN wood harvest N (to product pools) gN/m^2/s T +WTGQ surface tracer conductance m/s T +W_SCALAR Moisture (dryness) inhibition of decomposition unitless T +Wind atmospheric wind velocity magnitude m/s F +XSMRPOOL temporary photosynthate C pool gC/m^2 T +XSMRPOOL_LOSS temporary photosynthate C pool loss gC/m^2 F +XSMRPOOL_RECOVER C flux assigned to recovery of negative xsmrpool gC/m^2/s T +Z0HG roughness length over ground, sensible heat m F +Z0HV roughness length over vegetation, sensible heat m F +Z0M momentum roughness length m F +Z0MG roughness length over ground, momentum m F +Z0MV roughness length over vegetation, momentum m F +Z0M_TO_COUPLER roughness length, momentum: gridcell average sent to coupler m F +Z0QG roughness length over ground, latent heat m F +Z0QV roughness length over vegetation, latent heat m F +ZBOT atmospheric reference height m T +ZETA dimensionless stability parameter unitless F +ZII convective boundary height m F +ZWT water table depth (natural vegetated and crop landunits only) m T +ZWT_CH4_UNSAT depth of water table for methane production used in non-inundated area m T +ZWT_PERCH perched water table depth (natural vegetated and crop landunits only) m T +anaerobic_frac anaerobic_frac m3/m3 F +bsw clap and hornberger B unitless F +currentPatch currentPatch coefficient for VOC calc non F +diffus diffusivity m^2/s F +fr_WFPS fr_WFPS fraction F +n2_n2o_ratio_denit n2_n2o_ratio_denit gN/gN F +num_iter number of iterations unitless F +r_psi r_psi m F +ratio_k1 ratio_k1 none F +ratio_no3_co2 ratio_no3_co2 ratio F +soil_bulkdensity soil_bulkdensity kg/m3 F +soil_co2_prod soil_co2_prod ug C / g soil / day F +watfc water field capacity m^3/m^3 F +watsat water saturated m^3/m^3 F ==== =================================== ============================================================================================== ================================================================= ======= From eb9a43ba03edd836af4a0c8bc99969c2184e5884 Mon Sep 17 00:00:00 2001 From: Sam Rabin Date: Wed, 2 Aug 2023 15:04:49 -0600 Subject: [PATCH 149/257] RXCROPMATURITY test now part of clm_pymods in addition to ctsm_sci. --- cime_config/testdefs/testlist_clm.xml | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/cime_config/testdefs/testlist_clm.xml b/cime_config/testdefs/testlist_clm.xml index 31c44c307d..69fd30c2c7 100644 --- a/cime_config/testdefs/testlist_clm.xml +++ b/cime_config/testdefs/testlist_clm.xml @@ -2541,6 +2541,12 @@ + + + + + + From 13c7bad89970e8aeddb70aafaa4b108c59c5845c Mon Sep 17 00:00:00 2001 From: Sam Rabin Date: Fri, 4 Aug 2023 12:26:37 -0600 Subject: [PATCH 150/257] RXCROPMATURITY test in testlist_clm.xml now specifies testmod cropMonthOutput. --- cime_config/testdefs/testlist_clm.xml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cime_config/testdefs/testlist_clm.xml b/cime_config/testdefs/testlist_clm.xml index 69fd30c2c7..ea82f6812e 100644 --- a/cime_config/testdefs/testlist_clm.xml +++ b/cime_config/testdefs/testlist_clm.xml @@ -2533,7 +2533,7 @@ - + From 94116d371664b5697f5f1ebd7117b0608de35455 Mon Sep 17 00:00:00 2001 From: Sam Rabin Date: Fri, 4 Aug 2023 13:13:19 -0600 Subject: [PATCH 151/257] Correction to call of fsurdat_modifier in RXCROPMATURITY test. --- cime_config/SystemTests/rxcropmaturity.py | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cime_config/SystemTests/rxcropmaturity.py b/cime_config/SystemTests/rxcropmaturity.py index 6f66a95b81..9eb4bdb17d 100644 --- a/cime_config/SystemTests/rxcropmaturity.py +++ b/cime_config/SystemTests/rxcropmaturity.py @@ -277,7 +277,7 @@ def _run_fsurdat_modifier(self): command = ( f"python3 {tool_path} {cfg_path} " + f"-i {self._fsurdat_in} " - + f"-o {self._path_gddgen}" + + f"-o {self._fsurdat_out}" ) stu.run_python_script( self._get_caseroot(), From 5cfb1b40670ee7f718b17549f55ba91e5c321011 Mon Sep 17 00:00:00 2001 From: Sam Rabin Date: Mon, 7 Aug 2023 12:12:20 -0600 Subject: [PATCH 152/257] =?UTF-8?q?1=C2=B0=20RXCROPMATURITY=20test=20now?= =?UTF-8?q?=20only=20in=20ctsm=5Fsci;=20new=2010x15=20test=20in=20aux=5Fcl?= =?UTF-8?q?m=20&=20clm=5Fpymods.?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- cime_config/testdefs/testlist_clm.xml | 19 +++++++++++++++---- 1 file changed, 15 insertions(+), 4 deletions(-) diff --git a/cime_config/testdefs/testlist_clm.xml b/cime_config/testdefs/testlist_clm.xml index ea82f6812e..dfb7575134 100644 --- a/cime_config/testdefs/testlist_clm.xml +++ b/cime_config/testdefs/testlist_clm.xml @@ -2533,20 +2533,31 @@ - + - + - + - + + + + + + + + + + + + From 23564da1b61060abdd7276cd7ec3277011aec9d5 Mon Sep 17 00:00:00 2001 From: Sam Rabin Date: Wed, 9 Aug 2023 12:10:59 -0600 Subject: [PATCH 153/257] Correct units in a Tech Note table. --- doc/source/tech_note/Methane/CLM50_Tech_Note_Methane.rst | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/source/tech_note/Methane/CLM50_Tech_Note_Methane.rst b/doc/source/tech_note/Methane/CLM50_Tech_Note_Methane.rst index 7c89f857e3..bd1cb6140e 100644 --- a/doc/source/tech_note/Methane/CLM50_Tech_Note_Methane.rst +++ b/doc/source/tech_note/Methane/CLM50_Tech_Note_Methane.rst @@ -426,7 +426,7 @@ molecular free-air diffusion coefficients (:math:`{D}_{0}` .. table:: Temperature dependence of aqueous and gaseous diffusion coefficients for CH\ :sub:`4` and O\ :sub:`2` +----------------------------------------------------------+----------------------------------------------------------+--------------------------------------------------------+ - | :math:`{D}_{0}` (m\ :sup:`2` s\ :sup:`-1`) | CH\ :sub:`4` | O\ :sub:`2` | + | :math:`{D}_{0}` (cm\ :sup:`2` s\ :sup:`-1`) | CH\ :sub:`4` | O\ :sub:`2` | +==========================================================+==========================================================+========================================================+ | Aqueous | 0.9798 + 0.02986\ *T* + 0.0004381\ *T*\ :sup:`2` | 1.172+ 0.03443\ *T* + 0.0005048\ *T*\ :sup:`2` | +----------------------------------------------------------+----------------------------------------------------------+--------------------------------------------------------+ From 5a7380490497edd5da99e8b42fd5a195ff1f46e6 Mon Sep 17 00:00:00 2001 From: Sam Rabin Date: Wed, 9 Aug 2023 12:26:11 -0600 Subject: [PATCH 154/257] Corrected a variable in methane Tech Note. --- doc/source/tech_note/Methane/CLM50_Tech_Note_Methane.rst | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/source/tech_note/Methane/CLM50_Tech_Note_Methane.rst b/doc/source/tech_note/Methane/CLM50_Tech_Note_Methane.rst index bd1cb6140e..019062ddc8 100644 --- a/doc/source/tech_note/Methane/CLM50_Tech_Note_Methane.rst +++ b/doc/source/tech_note/Methane/CLM50_Tech_Note_Methane.rst @@ -173,7 +173,7 @@ anoxic microsites above the water table, we apply the Arah and Stephen \varphi =\frac{1}{1+\eta C_{O_{2} } } . -Here, :math:`\phi` is the factor by which production is inhibited +Here, :math:`\varphi` is the factor by which production is inhibited above the water table (compared to production as calculated in equation , :math:`C_{O_{2}}` (mol m\ :sup:`-3`) is the bulk soil oxygen concentration, and :math:`\eta` = 400 mol m\ :sup:`-3`. From b53cc417107e36e1cebacf5b657b285c2e71c775 Mon Sep 17 00:00:00 2001 From: Sam Rabin Date: Wed, 9 Aug 2023 13:33:03 -0600 Subject: [PATCH 155/257] Add *most* missing equation references in Tech Note methane. --- .../Methane/CLM50_Tech_Note_Methane.rst | 22 +++++++++---------- 1 file changed, 11 insertions(+), 11 deletions(-) diff --git a/doc/source/tech_note/Methane/CLM50_Tech_Note_Methane.rst b/doc/source/tech_note/Methane/CLM50_Tech_Note_Methane.rst index 019062ddc8..d15cfe7052 100644 --- a/doc/source/tech_note/Methane/CLM50_Tech_Note_Methane.rst +++ b/doc/source/tech_note/Methane/CLM50_Tech_Note_Methane.rst @@ -66,7 +66,7 @@ phases:\ :math:`R = \epsilon _{a} +K_{H} \epsilon _{w}`, with porosity, and partitioning coefficient for the species of interest, respectively, and :math:`C` represents CH\ :sub:`4` or O\ :sub:`2` concentration with respect to water volume (mol m\ :sup:`-3`). -An analogous version of equation is concurrently solved for +An analogous version of equation :eq:`24.1` is concurrently solved for O\ :sub:`2`, but with the following differences relative to CH\ :sub:`4`: *P* = *E* = 0 (i.e., no production or ebullition), and the oxidation sink includes the O\ :sub:`2` demanded by @@ -74,7 +74,7 @@ methanotrophs, heterotroph decomposers, nitrifiers, and autotrophic root respiration. As currently implemented, each gridcell contains an inundated and a -non-inundated fraction. Therefore, equation is solved four times for +non-inundated fraction. Therefore, equation :eq:`24.1` is solved four times for each gridcell and time step: in the inundated and non-inundated fractions, and for CH\ :sub:`4` and O\ :sub:`2`. If desired, the CH\ :sub:`4` and O\ :sub:`2` mass balance equation is @@ -175,7 +175,7 @@ anoxic microsites above the water table, we apply the Arah and Stephen Here, :math:`\varphi` is the factor by which production is inhibited above the water table (compared to production as calculated in equation -, :math:`C_{O_{2}}` (mol m\ :sup:`-3`) is the bulk soil oxygen +:eq:`24.2`, :math:`C_{O_{2}}` (mol m\ :sup:`-3`) is the bulk soil oxygen concentration, and :math:`\eta` = 400 mol m\ :sup:`-3`. The O\ :sub:`2` required to facilitate the vertically resolved @@ -457,8 +457,8 @@ measurements more closely in unsaturated peat soils: D_{e} =D_{0} \frac{\theta _{a} ^{{\raise0.7ex\hbox{$ 10 $}\!\mathord{\left/ {\vphantom {10 3}} \right. \kern-\nulldelimiterspace}\!\lower0.7ex\hbox{$ 3 $}} } }{\theta _{s} ^{2} } -In CLM, we applied equation for soils with zero organic matter content -and equation for soils with more than 130 kg m\ :sup:`-3` organic +In CLM, we applied equation :eq:`24.12` for soils with zero organic matter content +and equation :eq:`24.13` for soils with more than 130 kg m\ :sup:`-3` organic matter content. A linear interpolation between these two limits is applied for soils with SOM content below 130 kg m\ :sup:`-3`. For aqueous diffusion in the saturated part of the soil column, we applied @@ -518,10 +518,10 @@ a zero flux gradient at the bottom of the soil column. Crank-Nicholson Solution ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ -Equation is solved using a Crank-Nicholson solution +Equation :eq:`24.1` is solved using a Crank-Nicholson solution (:ref:`Press et al. 1992`), which combines fully explicit and implicit representations of the mass -balance. The fully explicit decomposition of equation can be written as +balance. The fully explicit decomposition of equation :eq:`24.1` can be written as .. math:: :label: 24.15 @@ -535,11 +535,11 @@ and :math:`S_{j}^{n}` is the net source at time step *n* and position *j*, i.e., :math:`S_{j}^{n} =P\left(j,n\right)-E\left(j,n\right)-A\left(j,n\right)-O\left(j,n\right)`. The diffusivity coefficients are calculated as harmonic means of values -from the adjacent cells. Equation is solved for gaseous and aqueous +from the adjacent cells. Equation :eq:`24.15` is solved for gaseous and aqueous concentrations above and below the water table, respectively. The *R* term ensure the total mass balance in both phases is properly accounted for. An analogous relationship can be generated for the fully implicit -case by replacing *n* by *n+1* on the *C* and *S* terms of equation . +case by replacing *n* by *n+1* on the *C* and *S* terms of equation :eq:`24.15`. Using an average of the fully implicit and fully explicit relationships gives: @@ -548,14 +548,14 @@ gives: \begin{array}{l} {-\frac{1}{2\Delta x_{j} } \frac{D_{m1}^{} }{\Delta x_{m1}^{} } C_{j-1}^{n+1} +\left[\frac{R_{j}^{n+1} }{\Delta t} +\frac{1}{2\Delta x_{j} } \left(\frac{D_{p1}^{} }{\Delta x_{p1}^{} } +\frac{D_{m1}^{} }{\Delta x_{m1}^{} } \right)\right]C_{j}^{n+1} -\frac{1}{2\Delta x_{j} } \frac{D_{p1}^{} }{\Delta x_{p1}^{} } C_{j+1}^{n+1} =} \\ {\frac{R_{j}^{n} }{\Delta t} +\frac{1}{2\Delta x_{j} } \left[\frac{D_{p1}^{} }{\Delta x_{p1}^{} } \left(C_{j+1}^{n} -C_{j}^{n} \right)-\frac{D_{m1}^{} }{\Delta x_{m1}^{} } \left(C_{j}^{n} -C_{j-1}^{n} \right)\right]+\frac{1}{2} \left[S_{j}^{n} +S_{j}^{n+1} \right]} \end{array}, -Equation is solved with a standard tridiagonal solver, i.e.: +Equation :eq:`24.16` is solved with a standard tridiagonal solver, i.e.: .. math:: :label: 24.17 aC_{j-1}^{n+1} +bC_{j}^{n+1} +cC_{j+1}^{n+1} =r, -with coefficients specified in equation . +with coefficients specified in equation :eq:`24.16`. Two methane balance checks are performed at each timestep to insure that the diffusion solution and the time-varying aggregation over inundated From 388979fb1b5c272a822b2d2000354c20a69aac07 Mon Sep 17 00:00:00 2001 From: Sam Rabin Date: Wed, 9 Aug 2023 13:33:50 -0600 Subject: [PATCH 156/257] Correct superscript syntax in Tech Note methane. --- .../tech_note/Methane/CLM50_Tech_Note_Methane.rst | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/doc/source/tech_note/Methane/CLM50_Tech_Note_Methane.rst b/doc/source/tech_note/Methane/CLM50_Tech_Note_Methane.rst index d15cfe7052..71f031d012 100644 --- a/doc/source/tech_note/Methane/CLM50_Tech_Note_Methane.rst +++ b/doc/source/tech_note/Methane/CLM50_Tech_Note_Methane.rst @@ -286,12 +286,12 @@ The diffusive transport through aerenchyma (*A*, mol m\ :sup:`-2` s\ :sup:`-1`) A=\frac{C\left(z\right)-C_{a} }{{\raise0.7ex\hbox{$ r_{L} z $}\!\mathord{\left/ {\vphantom {r_{L} z D}} \right. \kern-\nulldelimiterspace}\!\lower0.7ex\hbox{$ D $}} +r_{a} } pT\rho _{r} , -where *D* is the free-air gas diffusion coefficient (m:sup:`2` s\ :sup:`-1`); *C(z)* (mol m\ :sup:`-3`) is the gaseous +where *D* is the free-air gas diffusion coefficient (m\ :sup:`2` s\ :sup:`-1`); *C(z)* (mol m\ :sup:`-3`) is the gaseous concentration at depth *z* (m); :math:`r_{L}` is the ratio of root length to depth; *p* is the porosity (-); *T* is specific aerenchyma -area (m:sup:`2` m\ :sup:`-2`); :math:`{r}_{a}` is the +area (m\ :sup:`2` m\ :sup:`-2`); :math:`{r}_{a}` is the aerodynamic resistance between the surface and the atmospheric reference -height (s m:sup:`-1`); and :math:`\rho _{r}` is the rooting +height (s m\ :sup:`-1`); and :math:`\rho _{r}` is the rooting density as a function of depth (-). The gaseous concentration is calculated with Henry’s law as described in equation . @@ -416,7 +416,7 @@ Aqueous and Gaseous Diffusion For gaseous diffusion, we adopted the temperature dependence of molecular free-air diffusion coefficients (:math:`{D}_{0}` -(m:sup:`2` s\ :sup:`-1`)) as described by +(m\ :sup:`2` s\ :sup:`-1`)) as described by :ref:`Lerman (1979) ` and applied by :ref:`Wania et al. (2010)` (:numref:`Table Temperature dependence of aqueous and gaseous diffusion`). @@ -437,7 +437,7 @@ Gaseous diffusivity in soils also depends on the molecular diffusivity, soil structure, porosity, and organic matter content. :ref:`Moldrup et al. (2003)`, using observations across a range of unsaturated mineral soils, showed that the relationship between -effective diffusivity (:math:`D_{e}` (m:sup:`2` s\ :sup:`-1`)) and soil +effective diffusivity (:math:`D_{e}` (m\ :sup:`2` s\ :sup:`-1`)) and soil properties can be represented as: .. math:: From c4a1dae640ce63cdb88daa2c1ca979157009900f Mon Sep 17 00:00:00 2001 From: Sam Rabin Date: Wed, 9 Aug 2023 13:42:36 -0600 Subject: [PATCH 157/257] Added missing citation links in Tech Note methane. --- doc/source/tech_note/Methane/CLM50_Tech_Note_Methane.rst | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/doc/source/tech_note/Methane/CLM50_Tech_Note_Methane.rst b/doc/source/tech_note/Methane/CLM50_Tech_Note_Methane.rst index 71f031d012..d90531c7e9 100644 --- a/doc/source/tech_note/Methane/CLM50_Tech_Note_Methane.rst +++ b/doc/source/tech_note/Methane/CLM50_Tech_Note_Methane.rst @@ -259,8 +259,8 @@ aqueous CH\ :sub:`4` concentration, and *p* is pressure. The local pressure is calculated as the sum of the ambient pressure, water pressure down to the local depth, and pressure from surface ponding (if applicable). When the CH\ :sub:`4` partial pressure -exceeds 15% of the local pressure (Baird et al. 2004; Strack et al. -2006; Wania et al. 2010), bubbling occurs to remove CH\ :sub:`4` +exceeds 15% of the local pressure (:ref:`Baird et al. 2004`; :ref:`Strack et al. +2006`; :ref:`Wania et al. 2010`), bubbling occurs to remove CH\ :sub:`4` to below this value, modified by the fraction of CH\ :sub:`4` in the bubbles [taken as 57%; (:ref:`Kellner et al. 2006`; :ref:`Wania et al. 2010`)]. @@ -519,7 +519,7 @@ Crank-Nicholson Solution ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ Equation :eq:`24.1` is solved using a Crank-Nicholson solution -(:ref:`Press et al. 1992`), +(:ref:`Press et al., 1992`), which combines fully explicit and implicit representations of the mass balance. The fully explicit decomposition of equation :eq:`24.1` can be written as @@ -599,7 +599,7 @@ Inundated Fraction Prediction ---------------------------------- A simplified dynamic representation of spatial inundation -based on recent work by :ref:`Prigent et al. (2007)` is used. Prigent et al. (2007) described a +based on recent work by :ref:`Prigent et al. (2007)` is used. :ref:`Prigent et al. (2007)` described a multi-satellite approach to estimate the global monthly inundated fraction (:math:`{F}_{i}`) over an equal area grid (0.25 :math:`\circ` \ :math:`\times`\ 0.25\ :math:`\circ` at the equator) From f2e6c508ecabeed2920f79e9e0b91768c4b3efc6 Mon Sep 17 00:00:00 2001 From: Sam Rabin Date: Tue, 8 Aug 2023 16:05:38 -0600 Subject: [PATCH 158/257] evenly_split_cropland in SinglePointCase now only affects crop distribution. --- python/ctsm/site_and_regional/single_point_case.py | 5 ----- 1 file changed, 5 deletions(-) diff --git a/python/ctsm/site_and_regional/single_point_case.py b/python/ctsm/site_and_regional/single_point_case.py index 59889279ba..456bebee91 100644 --- a/python/ctsm/site_and_regional/single_point_case.py +++ b/python/ctsm/site_and_regional/single_point_case.py @@ -442,11 +442,6 @@ def modify_surfdata_atpoint(self, f_orig): f_mod["PCT_NATVEG"] = f_mod["PCT_NATVEG"] / tot_pct * 100 if self.evenly_split_cropland: - f_mod["PCT_LAKE"][:, :] = 0.0 - f_mod["PCT_WETLAND"][:, :] = 0.0 - f_mod["PCT_URBAN"][:, :, :] = 0.0 - f_mod["PCT_GLACIER"][:, :] = 0.0 - f_mod["PCT_NAT_PFT"][:, :, :] = 0.0 f_mod["PCT_CFT"][:, :, :] = 100.0 / f_mod["PCT_CFT"].shape[2] else: From 53eb94f48c783e1a30bce14c3f277bdb4dcce92c Mon Sep 17 00:00:00 2001 From: Sam Rabin Date: Tue, 8 Aug 2023 16:07:39 -0600 Subject: [PATCH 159/257] Removed duplicate checks of PCT_LAKE in test_sys_fsurdat_modifier.py. --- python/ctsm/test/test_sys_fsurdat_modifier.py | 2 -- 1 file changed, 2 deletions(-) diff --git a/python/ctsm/test/test_sys_fsurdat_modifier.py b/python/ctsm/test/test_sys_fsurdat_modifier.py index e3b26e1059..6234ef1e45 100755 --- a/python/ctsm/test/test_sys_fsurdat_modifier.py +++ b/python/ctsm/test/test_sys_fsurdat_modifier.py @@ -215,7 +215,6 @@ def test_opt_sections(self): np.testing.assert_array_equal(fsurdat_out_data.PCT_CROP, zero0d) np.testing.assert_array_equal(fsurdat_out_data.PCT_LAKE, zero0d) np.testing.assert_array_equal(fsurdat_out_data.PCT_WETLAND, zero0d) - np.testing.assert_array_equal(fsurdat_out_data.PCT_LAKE, zero0d) np.testing.assert_array_equal(fsurdat_out_data.PCT_GLACIER, zero0d) np.testing.assert_array_equal(fsurdat_out_data.PCT_URBAN, pct_urban) np.testing.assert_array_equal(fsurdat_out_data.LAKEDEPTH, one0d * 200.0) @@ -260,7 +259,6 @@ def test_evenly_split_cropland(self): np.testing.assert_array_equal(fsurdat_out_data.PCT_CROP, hundred0d) np.testing.assert_array_equal(fsurdat_out_data.PCT_LAKE, zero0d) np.testing.assert_array_equal(fsurdat_out_data.PCT_WETLAND, zero0d) - np.testing.assert_array_equal(fsurdat_out_data.PCT_LAKE, zero0d) np.testing.assert_array_equal(fsurdat_out_data.PCT_GLACIER, zero0d) np.testing.assert_array_equal(fsurdat_out_data.PCT_URBAN, zero_urban) np.testing.assert_array_equal(fsurdat_out_data.PCT_CFT, pct_cft) From 5b604ec8886e9968c64998a7ad00567bf76a18a0 Mon Sep 17 00:00:00 2001 From: Sam Rabin Date: Tue, 8 Aug 2023 16:44:20 -0600 Subject: [PATCH 160/257] Allow evenly_split_cropland True with dom_pft if the latter isn't a crop. --- python/ctsm/modify_input_files/fsurdat_modifier.py | 4 ++-- python/ctsm/test/test_unit_fsurdat_modifier.py | 7 ++++--- 2 files changed, 6 insertions(+), 5 deletions(-) diff --git a/python/ctsm/modify_input_files/fsurdat_modifier.py b/python/ctsm/modify_input_files/fsurdat_modifier.py index e8a75bfb4c..eedafeecbb 100644 --- a/python/ctsm/modify_input_files/fsurdat_modifier.py +++ b/python/ctsm/modify_input_files/fsurdat_modifier.py @@ -441,8 +441,8 @@ def read_cfg_option_control( file_path=cfg_path, convert_to_type=bool, ) - if evenly_split_cropland and dom_pft: - abort("dom_pft must be UNSET if evenly_split_cropland is True; pick one or the other") + if evenly_split_cropland and dom_pft and dom_pft > int(max(modify_fsurdat.file.natpft.values)): + abort("dom_pft must not be set to a crop PFT when evenly_split_cropland is True") if process_subgrid and idealized: abort("idealized AND process_subgrid_section can NOT both be on, pick one or the other") diff --git a/python/ctsm/test/test_unit_fsurdat_modifier.py b/python/ctsm/test/test_unit_fsurdat_modifier.py index 32892e9f1d..166924903b 100755 --- a/python/ctsm/test/test_unit_fsurdat_modifier.py +++ b/python/ctsm/test/test_unit_fsurdat_modifier.py @@ -96,13 +96,14 @@ def test_subgrid_and_idealized_fails(self): read_cfg_option_control(self.modify_fsurdat, self.config, section, self.cfg_path) def test_dompft_and_splitcropland_fails(self): - """test that dompft and evenly_split_cropland fails gracefully""" + """test that setting dompft crop with evenly_split_cropland True fails gracefully""" section = "modify_fsurdat_basic_options" - self.config.set(section, "dom_pft", "1") + crop_pft = max(self.modify_fsurdat.file.natpft.values) + 1 + self.config.set(section, "dom_pft", str(crop_pft)) self.config.set(section, "evenly_split_cropland", "True") with self.assertRaisesRegex( SystemExit, - "dom_pft must be UNSET if evenly_split_cropland is True; pick one or the other", + "dom_pft must not be set to a crop PFT when evenly_split_cropland is True", ): read_cfg_option_control(self.modify_fsurdat, self.config, section, self.cfg_path) From dd97f5d5fdbd6668e0860ee6537d2728858cc443 Mon Sep 17 00:00:00 2001 From: Sam Rabin Date: Tue, 8 Aug 2023 17:09:16 -0600 Subject: [PATCH 161/257] Dynamically generate .cfg file for test_evenly_split_cropland(). --- python/ctsm/test/test_sys_fsurdat_modifier.py | 52 +++++++++---------- 1 file changed, 26 insertions(+), 26 deletions(-) diff --git a/python/ctsm/test/test_sys_fsurdat_modifier.py b/python/ctsm/test/test_sys_fsurdat_modifier.py index 6234ef1e45..788b963196 100755 --- a/python/ctsm/test/test_sys_fsurdat_modifier.py +++ b/python/ctsm/test/test_sys_fsurdat_modifier.py @@ -226,41 +226,24 @@ def test_evenly_split_cropland(self): """ Test that evenly splitting cropland works """ - self._cfg_file_path = os.path.join( - path_to_ctsm_root(), - "python", - "ctsm", - "crop_calendars", - "modify_fsurdat_allcropseverywhere.cfg", - ) - infile_basename_noext = "surfdata_5x5_amazon_16pfts_Irrig_CMIP6_simyr2000_c171214" - outfile = os.path.join( - self._tempdir, - infile_basename_noext + "_output_allcropseverywhere.nc", - ) + self._create_config_file_evenlysplitcrop() sys.argv = [ "fsurdat_modifier", self._cfg_file_path, - "-i", - os.path.join(self._testinputs_path, infile_basename_noext + ".nc"), - "-o", - outfile, ] parser = fsurdat_modifier_arg_process() fsurdat_modifier(parser) # Read the resultant output file and make sure the fields are changed as expected - fsurdat_out_data = xr.open_dataset(outfile) - zero0d = np.zeros((5, 5)) - hundred0d = np.full((5, 5), 100.0) - zero_urban = np.zeros((3, 5, 5)) + fsurdat_in_data = xr.open_dataset(self._fsurdat_in) + fsurdat_out_data = xr.open_dataset(self._fsurdat_out) Ncrops = fsurdat_out_data.dims["cft"] pct_cft = np.full((Ncrops, 5, 5), 100 / Ncrops) - np.testing.assert_array_equal(fsurdat_out_data.PCT_NATVEG, zero0d) - np.testing.assert_array_equal(fsurdat_out_data.PCT_CROP, hundred0d) - np.testing.assert_array_equal(fsurdat_out_data.PCT_LAKE, zero0d) - np.testing.assert_array_equal(fsurdat_out_data.PCT_WETLAND, zero0d) - np.testing.assert_array_equal(fsurdat_out_data.PCT_GLACIER, zero0d) - np.testing.assert_array_equal(fsurdat_out_data.PCT_URBAN, zero_urban) + np.testing.assert_array_equal(fsurdat_in_data.PCT_NATVEG, fsurdat_out_data.PCT_NATVEG) + np.testing.assert_array_equal(fsurdat_in_data.PCT_CROP, fsurdat_out_data.PCT_CROP) + np.testing.assert_array_equal(fsurdat_in_data.PCT_LAKE, fsurdat_out_data.PCT_LAKE) + np.testing.assert_array_equal(fsurdat_in_data.PCT_WETLAND, fsurdat_out_data.PCT_WETLAND) + np.testing.assert_array_equal(fsurdat_in_data.PCT_GLACIER, fsurdat_out_data.PCT_GLACIER) + np.testing.assert_array_equal(fsurdat_in_data.PCT_URBAN, fsurdat_out_data.PCT_URBAN) np.testing.assert_array_equal(fsurdat_out_data.PCT_CFT, pct_cft) def test_1x1_mexicocity(self): @@ -447,6 +430,23 @@ def _create_config_file_minimal(self): line = f"fsurdat_out = {self._fsurdat_out}" cfg_out.write(line) + def _create_config_file_evenlysplitcrop(self): + """ + Open the new and the template .cfg files + Loop line by line through the template .cfg file + When string matches, replace that line's content + """ + with open(self._cfg_file_path, "w", encoding="utf-8") as cfg_out: + with open(self._cfg_template_path, "r", encoding="utf-8") as cfg_in: + for line in cfg_in: + if re.match(r" *evenly_split_cropland *=", line): + line = f"evenly_split_cropland = True" + elif re.match(r" *fsurdat_in *=", line): + line = f"fsurdat_in = {self._fsurdat_in}" + elif re.match(r" *fsurdat_out *=", line): + line = f"fsurdat_out = {self._fsurdat_out}" + cfg_out.write(line) + def _create_config_file_crop(self): """ Open the new and the template .cfg files From 852206cb0d744ddb9b6c0c3b5b995a93f1f16482 Mon Sep 17 00:00:00 2001 From: Sam Rabin Date: Tue, 8 Aug 2023 17:10:58 -0600 Subject: [PATCH 162/257] Improve robustness of test_evenly_split_cropland() to new fsurdat_in. --- python/ctsm/test/test_sys_fsurdat_modifier.py | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/python/ctsm/test/test_sys_fsurdat_modifier.py b/python/ctsm/test/test_sys_fsurdat_modifier.py index 788b963196..f83aff0b64 100755 --- a/python/ctsm/test/test_sys_fsurdat_modifier.py +++ b/python/ctsm/test/test_sys_fsurdat_modifier.py @@ -237,7 +237,7 @@ def test_evenly_split_cropland(self): fsurdat_in_data = xr.open_dataset(self._fsurdat_in) fsurdat_out_data = xr.open_dataset(self._fsurdat_out) Ncrops = fsurdat_out_data.dims["cft"] - pct_cft = np.full((Ncrops, 5, 5), 100 / Ncrops) + pct_cft = np.full_like(fsurdat_out_data.PCT_CFT, 100 / Ncrops) np.testing.assert_array_equal(fsurdat_in_data.PCT_NATVEG, fsurdat_out_data.PCT_NATVEG) np.testing.assert_array_equal(fsurdat_in_data.PCT_CROP, fsurdat_out_data.PCT_CROP) np.testing.assert_array_equal(fsurdat_in_data.PCT_LAKE, fsurdat_out_data.PCT_LAKE) From 42226ebc250d8b5b3a0d317e1de3f0ef52386648 Mon Sep 17 00:00:00 2001 From: Sam Rabin Date: Wed, 9 Aug 2023 09:22:17 -0600 Subject: [PATCH 163/257] Dynamically generate .cfg file for RXCROPMATURITY test. --- cime_config/SystemTests/rxcropmaturity.py | 50 +++++++++++++++++++---- 1 file changed, 42 insertions(+), 8 deletions(-) diff --git a/cime_config/SystemTests/rxcropmaturity.py b/cime_config/SystemTests/rxcropmaturity.py index 9eb4bdb17d..bfa8ead151 100644 --- a/cime_config/SystemTests/rxcropmaturity.py +++ b/cime_config/SystemTests/rxcropmaturity.py @@ -267,17 +267,16 @@ def _run_fsurdat_modifier(self): "modify_input_files", "fsurdat_modifier", ) - cfg_path = os.path.join( - self._ctsm_root, - "python", - "ctsm", - "crop_calendars", + + # Create configuration file for fsurdat_modifier + self._cfg_path = os.path.join( + self._path_gddgen, "modify_fsurdat_allcropseverywhere.cfg", ) + self._create_config_file_evenlysplitcrop() + command = ( - f"python3 {tool_path} {cfg_path} " - + f"-i {self._fsurdat_in} " - + f"-o {self._fsurdat_out}" + f"python3 {tool_path} {self._cfg_path} " ) stu.run_python_script( self._get_caseroot(), @@ -297,6 +296,41 @@ def _run_fsurdat_modifier(self): ] ) + def _create_config_file_evenlysplitcrop(self): + """ + Open the new and the template .cfg files + Loop line by line through the template .cfg file + When string matches, replace that line's content + """ + cfg_template_path = os.path.join( + self._ctsm_root, "tools/modify_input_files/modify_fsurdat_template.cfg" + ) + + with open(self._cfg_path, "w", encoding="utf-8") as cfg_out: + # Copy template, replacing some lines + with open(cfg_template_path, "r", encoding="utf-8") as cfg_in: + for line in cfg_in: + if re.match(r" *evenly_split_cropland *=", line): + line = f"evenly_split_cropland = True" + elif re.match(r" *fsurdat_in *=", line): + line = f"fsurdat_in = {self._fsurdat_in}" + elif re.match(r" *fsurdat_out *=", line): + line = f"fsurdat_out = {self._fsurdat_out}" + elif re.match(r" *process_subgrid_section *=", line): + line = f"process_subgrid_section = True" + cfg_out.write(line) + + # Add new lines + cfg_out.write("\n") + cfg_out.write("[modify_fsurdat_subgrid_fractions]\n") + cfg_out.write("PCT_CROP = 100.0\n") + cfg_out.write("PCT_NATVEG = 0.0\n") + cfg_out.write("PCT_GLACIER = 0.0\n") + cfg_out.write("PCT_WETLAND = 0.0\n") + cfg_out.write("PCT_LAKE = 0.0\n") + cfg_out.write("PCT_URBAN = 0.0 0.0 0.0\n") + + def _run_check_rxboth_run(self): output_dir = os.path.join(self._get_caseroot(), "run") From 528e5c9de57a8e1224343be97448381ee12f2e7b Mon Sep 17 00:00:00 2001 From: Sam Rabin Date: Wed, 9 Aug 2023 14:04:29 -0600 Subject: [PATCH 164/257] Delete now-unused modify_fsurdat_allcropseverywhere.cfg. --- .../modify_fsurdat_allcropseverywhere.cfg | 84 ------------------- 1 file changed, 84 deletions(-) delete mode 100644 python/ctsm/crop_calendars/modify_fsurdat_allcropseverywhere.cfg diff --git a/python/ctsm/crop_calendars/modify_fsurdat_allcropseverywhere.cfg b/python/ctsm/crop_calendars/modify_fsurdat_allcropseverywhere.cfg deleted file mode 100644 index b7c46a6c71..0000000000 --- a/python/ctsm/crop_calendars/modify_fsurdat_allcropseverywhere.cfg +++ /dev/null @@ -1,84 +0,0 @@ -[modify_fsurdat_basic_options] - -# ------------------------------------------------------------------------ -# .cfg file with inputs for fsurdat_modifier. -# -# This configuration file, when used in fsurdat_modifier, will create a -# version of the input fsurdat file that is 100% cropland with area evenly -# split among all crop PFTs. -# ------------------------------------------------------------------------ - -### Skipping input/output file paths, as these should be specified in -### command-line call of fsurdat_modifier. -# Path and name of input surface dataset (str) -### fsurdat_in = -# Path and name of output surface dataset (str) -### fsurdat_out = - -# We want all existing values in fsurdat to persist except the ones -# pertaining to land unit and PFT fractions. Thus, we set idealized = False. -idealized = False - -# Process the optional section that handles modifying subgrid fractions -process_subgrid_section = True - -# Process the optional section that handles modifying an arbitrary list of variables -process_var_list_section = False - -# Boundaries of user-defined rectangle to apply changes (float) -# If lat_1 > lat_2, the code creates two rectangles, one in the north and -# one in the south. -# If lon_1 > lon_2, the rectangle wraps around the 0-degree meridian. -# Alternatively, user may specify a custom area in a .nc landmask_file -# below. If set, this will override the lat/lon settings. -# ----------------------------------- -# southernmost latitude for rectangle -lnd_lat_1 = -90 -# northernmost latitude for rectangle -lnd_lat_2 = 90 -# westernmost longitude for rectangle -lnd_lon_1 = 0 -# easternmost longitude for rectangle -lnd_lon_2 = 360 -# User-defined mask in a file, as alternative to setting lat/lon values. -# If set, lat_dimname and lon_dimname should likely also be set. IMPORTANT: -# - lat_dimname and lon_dimname may be left UNSET if they match the expected -# default values 'lsmlat' and 'lsmlon' -landmask_file = UNSET -lat_dimname = UNSET -lon_dimname = UNSET - -# PFT/CFT to be set to 100% according to user-defined mask. -# We *could* evenly split cropland using dom_pft, but using -# evenly_split_cropland (below) is more robust. Thus, we -# leave dom_pft UNSET. -dom_pft = UNSET - -# Evenly split each gridcell's cropland among all crop types (CFTs). -evenly_split_cropland = True - -# UNSET with idealized False means leave these values unchanged. -lai = UNSET -sai = UNSET -hgt_top = UNSET -hgt_bot = UNSET -soil_color = UNSET -std_elev = UNSET -max_sat_area = UNSET - -# We manually exclude non-vegetation land units (along with NATVEG) below, so set -# include_nonveg to True. -include_nonveg = True - - -# Section for subgrid_fractions -[modify_fsurdat_subgrid_fractions] -# If subgrid_fractions = True this section will be enabled - -# NOTE: PCT_URBAN must be a list of three floats that sum to the total urban area -PCT_URBAN = 0.0 0.0 0.0 -PCT_CROP = 100.0 -PCT_NATVEG= 0.0 -PCT_GLACIER= 0.0 -PCT_WETLAND= 0.0 -PCT_LAKE = 0.0 \ No newline at end of file From 0f1127721518d64c03e5109bfcde7ef21b11bd50 Mon Sep 17 00:00:00 2001 From: Sam Rabin Date: Thu, 10 Aug 2023 12:07:56 -0600 Subject: [PATCH 165/257] Clarified an if statement. --- python/ctsm/modify_input_files/fsurdat_modifier.py | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/python/ctsm/modify_input_files/fsurdat_modifier.py b/python/ctsm/modify_input_files/fsurdat_modifier.py index eedafeecbb..6d350171cc 100644 --- a/python/ctsm/modify_input_files/fsurdat_modifier.py +++ b/python/ctsm/modify_input_files/fsurdat_modifier.py @@ -441,7 +441,11 @@ def read_cfg_option_control( file_path=cfg_path, convert_to_type=bool, ) - if evenly_split_cropland and dom_pft and dom_pft > int(max(modify_fsurdat.file.natpft.values)): + if ( + evenly_split_cropland + and dom_pft is not None + and dom_pft > int(max(modify_fsurdat.file.natpft.values)) + ): abort("dom_pft must not be set to a crop PFT when evenly_split_cropland is True") if process_subgrid and idealized: abort("idealized AND process_subgrid_section can NOT both be on, pick one or the other") From 73895d6353b512f31487700459d47f932f94b8a9 Mon Sep 17 00:00:00 2001 From: Sam Rabin Date: Thu, 10 Aug 2023 12:55:04 -0600 Subject: [PATCH 166/257] Resolved a pylint complaint. --- python/ctsm/test/test_sys_fsurdat_modifier.py | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/python/ctsm/test/test_sys_fsurdat_modifier.py b/python/ctsm/test/test_sys_fsurdat_modifier.py index f83aff0b64..1a5045c14d 100755 --- a/python/ctsm/test/test_sys_fsurdat_modifier.py +++ b/python/ctsm/test/test_sys_fsurdat_modifier.py @@ -440,7 +440,7 @@ def _create_config_file_evenlysplitcrop(self): with open(self._cfg_template_path, "r", encoding="utf-8") as cfg_in: for line in cfg_in: if re.match(r" *evenly_split_cropland *=", line): - line = f"evenly_split_cropland = True" + line = "evenly_split_cropland = True" elif re.match(r" *fsurdat_in *=", line): line = f"fsurdat_in = {self._fsurdat_in}" elif re.match(r" *fsurdat_out *=", line): From 7c920c6804369343b27c379ced09e1ad7bfe1469 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Thu, 10 Aug 2023 14:23:14 -0600 Subject: [PATCH 167/257] Moved a call to update a call to fates litter fluxes to be immediately before we fill the decomp source-sink pools --- src/biogeochem/CNNDynamicsMod.F90 | 9 +++++++-- src/utils/clmfates_interfaceMod.F90 | 29 +++++++++-------------------- 2 files changed, 16 insertions(+), 22 deletions(-) diff --git a/src/biogeochem/CNNDynamicsMod.F90 b/src/biogeochem/CNNDynamicsMod.F90 index f9698fb2ca..10c0f5ea38 100644 --- a/src/biogeochem/CNNDynamicsMod.F90 +++ b/src/biogeochem/CNNDynamicsMod.F90 @@ -239,7 +239,10 @@ subroutine CNNFixation(num_soilc, filter_soilc, & if(col%is_fates(c))then s = clm_fates%f2hmap(clump_index)%hsites(c) ! %ema_npp is Smoothed [gc/m2/yr] - npp = clm_fates%fates(clump_index)%bc_out(s)%ema_npp/(dayspyr*secspday) + !npp = clm_fates%fates(clump_index)%bc_out(s)%ema_npp/(dayspyr*secspday) + ! FATES N cycling is not yet active, so runs are supplemented anyway + ! this will be added when FATES N cycling is completed. + npp = 0._r8 else npp = col_lag_npp(c) end if @@ -259,7 +262,9 @@ subroutine CNNFixation(num_soilc, filter_soilc, & if(col%is_fates(c))then s = clm_fates%f2hmap(clump_index)%hsites(c) - npp = clm_fates%fates(clump_index)%bc_out(s)%ema_npp + !npp = clm_fates%fates(clump_index)%bc_out(s)%ema_npp + ! See above regarding FATES and N fixation + npp = 0._r8 else npp = cannsum_npp(c) end if diff --git a/src/utils/clmfates_interfaceMod.F90 b/src/utils/clmfates_interfaceMod.F90 index bf51b3cac5..c32c55d50a 100644 --- a/src/utils/clmfates_interfaceMod.F90 +++ b/src/utils/clmfates_interfaceMod.F90 @@ -1182,10 +1182,18 @@ subroutine UpdateCLitterFluxes(this,soilbiogeochem_carbonflux_inst,ci,c) associate(cf_soil => soilbiogeochem_carbonflux_inst) - cf_soil%decomp_cpools_sourcesink_col(c,:,:) = 0._r8 + ! This is zeroed in CNDriverNoLeaching -> soilbiogeochem_carbonflux_inst%SetValues() + ! Which is called prior to this call, which is later in the CNDriverNoLeaching() + ! routine. + ! cf_soil%decomp_cpools_sourcesink_col(c,:,:) = 0._r8 if ( .not. use_fates_sp ) then + + call FluxIntoLitterPools(this%fates(ci)%sites(s), & + this%fates(ci)%bc_in(s), & + this%fates(ci)%bc_out(s)) + ! (gC/m3/timestep) cf_soil%decomp_cpools_sourcesink_col(c,1:nlevdecomp,i_met_lit) = & cf_soil%decomp_cpools_sourcesink_col(c,1:nlevdecomp,i_met_lit) + & @@ -1711,16 +1719,6 @@ subroutine restart( this, bounds_proc, ncid, flag, waterdiagnosticbulk_inst, & this%fates(nc)%bc_in(s), & this%fates(nc)%bc_out(s) ) - ! This call sends internal fates variables into the - ! output boundary condition structures. Note: this is called - ! internally in fates dynamics as well. - call FluxIntoLitterPools(this%fates(nc)%sites(s), & - this%fates(nc)%bc_in(s), & - this%fates(nc)%bc_out(s)) - - call this%UpdateCLitterFluxes(soilbiogeochem_carbonflux_inst,nc,c) - call this%UpdateNLitterFluxes(soilbiogeochem_nitrogenflux_inst,nc,c) - end do if(use_fates_sp)then @@ -1945,15 +1943,6 @@ subroutine init_coldstart(this, waterstatebulk_inst, waterdiagnosticbulk_inst, & this%fates(nc)%bc_in(s), & this%fates(nc)%bc_out(s)) - ! This call sends internal fates variables into the - ! output boundary condition structures. Note: this is called - ! internally in fates dynamics as well. - call FluxIntoLitterPools(this%fates(nc)%sites(s), & - this%fates(nc)%bc_in(s), & - this%fates(nc)%bc_out(s)) - - !call UpdateCLitterFluxes(this,soilbiogeochem_carbonflux_inst,ci,c) - end do ! ------------------------------------------------------------------------ From fd19f980bae0e640bbb2344ca601bd6c68c65656 Mon Sep 17 00:00:00 2001 From: Sam Rabin Date: Thu, 10 Aug 2023 16:57:57 -0600 Subject: [PATCH 168/257] Updated a test name in README_history_fields_files. --- .../setting-up-and-running-a-case/README_history_fields_files | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/source/users_guide/setting-up-and-running-a-case/README_history_fields_files b/doc/source/users_guide/setting-up-and-running-a-case/README_history_fields_files index c965536657..f92f48f71a 100644 --- a/doc/source/users_guide/setting-up-and-running-a-case/README_history_fields_files +++ b/doc/source/users_guide/setting-up-and-running-a-case/README_history_fields_files @@ -4,7 +4,7 @@ The files history_fields_nofates.rst and history_fields_fates.rst each contain a table of the history fields, active and inactive, available in the CTSM cases that get generated by these tests: ERP_P36x2_D_Ld3.f10_f10_mg37.I1850Clm50BgcCrop.cheyenne_gnu.clm-extra_outputs -ERS_Ld9.f10_f10_mg37.I2000Clm50FatesCru.cheyenne_intel.clm-FatesColdDefCH4 +ERS_Ld9.f10_f10_mg37.I2000Clm50FatesCruRsGs.cheyenne_intel.clm-FatesColdCH4Off To reproduce these .rst files, run the above tests and the files will appear in the corresponding run directories. From d6751d6050f2c36136fb1233a589ceab27d7ebd7 Mon Sep 17 00:00:00 2001 From: Sam Rabin Date: Fri, 11 Aug 2023 10:58:20 -0600 Subject: [PATCH 169/257] Changed more references to history fields "master list." --- bld/namelist_files/namelist_defaults_ctsm.xml | 2 +- .../namelist_definition_ctsm.xml | 2 +- cime_config/testdefs/testlist_clm.xml | 2 +- .../testmods_dirs/clm/extra_outputs/README | 4 +- src/main/clm_varctl.F90 | 2 +- src/main/histFileMod.F90 | 40 +++++++++---------- 6 files changed, 26 insertions(+), 26 deletions(-) diff --git a/bld/namelist_files/namelist_defaults_ctsm.xml b/bld/namelist_files/namelist_defaults_ctsm.xml index 4cac65547e..9ecb139831 100644 --- a/bld/namelist_files/namelist_defaults_ctsm.xml +++ b/bld/namelist_files/namelist_defaults_ctsm.xml @@ -67,7 +67,7 @@ attributes from the config_cache.xml file (with keys converted to upper-case). .false. .false. - + .false. diff --git a/bld/namelist_files/namelist_definition_ctsm.xml b/bld/namelist_files/namelist_definition_ctsm.xml index 3c017afee1..227551010f 100644 --- a/bld/namelist_files/namelist_definition_ctsm.xml +++ b/bld/namelist_files/namelist_definition_ctsm.xml @@ -766,7 +766,7 @@ SNICAR (SNow, ICe, and Aerosol Radiative model) snow aging data file name -If TRUE, write master field list to separate file for documentation purposes +If TRUE, write list of all output fields to separate file for documentation purposes - + diff --git a/cime_config/testdefs/testmods_dirs/clm/extra_outputs/README b/cime_config/testdefs/testmods_dirs/clm/extra_outputs/README index 03bc956b6f..574d7cc204 100644 --- a/cime_config/testdefs/testmods_dirs/clm/extra_outputs/README +++ b/cime_config/testdefs/testmods_dirs/clm/extra_outputs/README @@ -1,4 +1,4 @@ This test mod turns on extra diagnostic fields -It also outputs an optional text file containing a table of the -history fields master list +It also outputs an optional text file containing a table of all +the possible history fields diff --git a/src/main/clm_varctl.F90 b/src/main/clm_varctl.F90 index bcf7a0ffd2..39c699dd7e 100644 --- a/src/main/clm_varctl.F90 +++ b/src/main/clm_varctl.F90 @@ -385,7 +385,7 @@ module clm_varctl ! namelist: write CH4 extra diagnostic output logical, public :: hist_wrtch4diag = .false. - ! namelist: write history master list to a file for use in documentation + ! namelist: write list of all history fields to a file for use in documentation logical, public :: hist_fields_list_file = .false. !---------------------------------------------------------- diff --git a/src/main/histFileMod.F90 b/src/main/histFileMod.F90 index df91fa1e70..2fcd509e7e 100644 --- a/src/main/histFileMod.F90 +++ b/src/main/histFileMod.F90 @@ -141,12 +141,12 @@ module histFileMod logical, private :: if_disphist(max_tapes) ! restart, true => save history file ! ! !PUBLIC MEMBER FUNCTIONS: (in rough call order) - public :: hist_addfld1d ! Add a 1d single-level field to the master field list - public :: hist_addfld2d ! Add a 2d multi-level field to the master field list + public :: hist_addfld1d ! Add a 1d single-level field to the list of all history fields + public :: hist_addfld2d ! Add a 2d multi-level field to the list of all history fields public :: hist_addfld_decomp ! Add a 1d/2d field based on patch or column data public :: hist_add_subscript ! Add a 2d subscript dimension - public :: hist_printflds ! Print summary of master field list + public :: hist_printflds ! Print summary of list of all history fields public :: htapes_fieldlist ! Finalize history file field lists, intersecting masterlist with ! namelist params. @@ -159,7 +159,7 @@ module histFileMod ! !PRIVATE MEMBER FUNCTIONS: private :: is_mapping_upto_subgrid ! Is this field being mapped up to a higher subgrid level? private :: masterlist_make_active ! Declare a single field active for a single tape - private :: masterlist_addfld ! Add a field to the master field list + private :: masterlist_addfld ! Add a field to the list of all history fields private :: masterlist_change_timeavg ! Override default history tape contents for specific tape private :: htape_addfld ! Transfer field metadata from masterlist to a history tape. private :: htape_create ! Define netcdf metadata of history file t @@ -294,7 +294,7 @@ end subroutine copy_entry_interface ! hist_addfld* calls in the code. ! For the field data itself, see 'tape'. ! - type (master_entry) :: masterlist(max_flds) ! master field list + type (master_entry) :: masterlist(max_flds) ! list of all history fields ! ! Whether each history tape is in use in this run. If history_tape_in_use(i) is false, ! then data in tape(i) is undefined and should not be referenced. @@ -311,7 +311,7 @@ end subroutine copy_entry_interface ! ! Counters ! - integer :: nfmaster = 0 ! number of fields in master field list + integer :: nfmaster = 0 ! number of fields in list of all history fields ! ! Other variables ! @@ -347,7 +347,7 @@ end subroutine copy_entry_interface subroutine hist_printflds() ! ! !DESCRIPTION: - ! Print summary of master field list. + ! Print summary of list of all history fields. ! ! !USES: use clm_varctl, only: hist_fields_list_file @@ -371,7 +371,7 @@ subroutine hist_printflds() if (masterproc) then write(iulog,*) trim(subname),' : number of master fields = ',nfmaster - write(iulog,*)' ******* MASTER FIELD LIST *******' + write(iulog,*)' ******* LIST OF ALL HISTORY FIELDS *******' do nf = 1,nfmaster write(iulog,9000)nf, masterlist(nf)%field%name, masterlist(nf)%field%units 9000 format (i5,1x,a32,1x,a16) @@ -379,7 +379,7 @@ subroutine hist_printflds() call shr_sys_flush(iulog) end if - ! Print master field list in separate text file when namelist + ! Print list of all history fields in separate text file when namelist ! variable requests it. Text file is formatted in the .rst ! (reStructuredText) format for easy introduction of the file to ! the CTSM's web-based documentation. @@ -495,9 +495,9 @@ subroutine masterlist_addfld (fname, numdims, type1d, type1d_out, & no_snow_behavior) ! ! !DESCRIPTION: - ! Add a field to the master field list. Put input arguments of + ! Add a field to the list of all history fields. Put input arguments of ! field name, units, number of levels, averaging flag, and long name - ! into a type entry in the global master field list (masterlist). + ! into a type entry in the global list of all history fields (masterlist). ! ! The optional argument no_snow_behavior should be given when this is a multi-layer ! snow field, and should be absent otherwise. It should take on one of the no_snow_* @@ -563,12 +563,12 @@ subroutine masterlist_addfld (fname, numdims, type1d, type1d_out, & end if end do - ! Increase number of fields on master field list + ! Increase number of fields on list of all history fields nfmaster = nfmaster + 1 f = nfmaster - ! Check number of fields in master list against maximum number for master list + ! Check number of fields in list against maximum number if (nfmaster > max_flds) then write(iulog,*) trim(subname),' ERROR: too many fields for primary history file ', & @@ -576,7 +576,7 @@ subroutine masterlist_addfld (fname, numdims, type1d, type1d_out, & call endrun(msg=errMsg(sourcefile, __LINE__)) end if - ! Add field to master list + ! Add field to list of all history fields masterlist(f)%field%name = fname masterlist(f)%field%long_name = long_name @@ -623,9 +623,9 @@ subroutine masterlist_addfld (fname, numdims, type1d, type1d_out, & masterlist(f)%field%no_snow_behavior = no_snow_unset end if - ! The following two fields are used only in master field list, + ! The following two fields are used only in list of all history fields, ! NOT in the runtime active field list - ! ALL FIELDS IN THE MASTER LIST ARE INITIALIZED WITH THE ACTIVE + ! ALL FIELDS IN THE FORMER ARE INITIALIZED WITH THE ACTIVE ! FLAG SET TO FALSE masterlist(f)%avgflag(:) = avgflag @@ -746,7 +746,7 @@ subroutine masterlist_make_active (name, tape_index, avgflag) endif end if - ! Look through master list for input field name. + ! Look through list of all history fields for input field name. ! When found, set active flag for that tape to true. ! Also reset averaging flag if told to use other than default. @@ -773,7 +773,7 @@ subroutine masterlist_change_timeavg (t) ! ! !DESCRIPTION: ! Override default history tape contents for a specific tape. - ! Copy the flag into the master field list. + ! Copy the flag into the list of all history fields. ! ! !ARGUMENTS: integer, intent(in) :: t ! history tape index @@ -1133,11 +1133,11 @@ end function is_mapping_upto_subgrid subroutine htape_addfld (t, f, avgflag) ! ! !DESCRIPTION: - ! Add a field to a history tape, copying metadata from the master field list + ! Add a field to a history tape, copying metadata from the list of all history fields ! ! !ARGUMENTS: integer, intent(in) :: t ! history tape index - integer, intent(in) :: f ! field index from master field list + integer, intent(in) :: f ! field index from list of all history fields character(len=*), intent(in) :: avgflag ! time averaging flag ! ! !LOCAL VARIABLES: From 94216159ecd855d4589000dbfdae3a090e201617 Mon Sep 17 00:00:00 2001 From: Sam Rabin Date: Fri, 11 Aug 2023 14:01:35 -0600 Subject: [PATCH 170/257] Changed many variable and method names in histFileMod. --- src/main/histFileMod.F90 | 236 +++++++++++++++++++-------------------- 1 file changed, 118 insertions(+), 118 deletions(-) diff --git a/src/main/histFileMod.F90 b/src/main/histFileMod.F90 index 2fcd509e7e..bdcec28ec1 100644 --- a/src/main/histFileMod.F90 +++ b/src/main/histFileMod.F90 @@ -147,7 +147,7 @@ module histFileMod public :: hist_add_subscript ! Add a 2d subscript dimension public :: hist_printflds ! Print summary of list of all history fields - public :: htapes_fieldlist ! Finalize history file field lists, intersecting masterlist with + public :: htapes_fieldlist ! Finalize history file field lists, intersecting allhistfldlist with ! namelist params. public :: hist_htapes_build ! Initialize history file handler (for initial or continued run) @@ -158,10 +158,10 @@ module histFileMod ! ! !PRIVATE MEMBER FUNCTIONS: private :: is_mapping_upto_subgrid ! Is this field being mapped up to a higher subgrid level? - private :: masterlist_make_active ! Declare a single field active for a single tape - private :: masterlist_addfld ! Add a field to the list of all history fields - private :: masterlist_change_timeavg ! Override default history tape contents for specific tape - private :: htape_addfld ! Transfer field metadata from masterlist to a history tape. + private :: allhistfldlist_make_active ! Declare a single field active for a single tape + private :: allhistfldlist_addfld ! Add a field to the list of all history fields + private :: allhistfldlist_change_timeavg ! Override default history tape contents for specific tape + private :: htape_addfld ! Transfer field metadata from allhistfldlist to a history tape. private :: htape_create ! Define netcdf metadata of history file t private :: htape_add_ltype_metadata ! Add global metadata defining landunit types private :: htape_add_ctype_metadata ! Add global metadata defining column types @@ -241,14 +241,14 @@ end subroutine copy_entry_interface ! Additional per-field metadata. See also history_entry. ! These values are specified in hist_addfld* calls but then can be ! overridden by namelist params like hist_fincl1. - type, extends(entry_base) :: master_entry + type, extends(entry_base) :: allhistfldlist_entry logical :: actflag(max_tapes) ! which history tapes to write to. character(len=avgflag_strlen) :: avgflag(max_tapes) ! type of time averaging contains - procedure :: copy => copy_master_entry - end type master_entry + procedure :: copy => copy_allhistfldlist_entry + end type allhistfldlist_entry - ! Actual per-field history data, accumulated from clmptr_r* vars. See also master_entry. + ! Actual per-field history data, accumulated from clmptr_r* vars. See also allhistfldlist_entry. type, extends(entry_base) :: history_entry character(len=avgflag_strlen) :: avgflag ! time averaging flag ("X","A","M","I","SUM") real(r8), pointer :: hbuf(:,:) ! history buffer (dimensions: dim1d x num2d) @@ -261,7 +261,7 @@ end subroutine copy_entry_interface ! at a given time frequency and precision. The first ('primary') tape defaults to a non-empty set ! of active fields (see hist_addfld* methods), overridable by namelist flags, while the other ! tapes are entirely manually configured via namelist flags. The set of active fields across all - ! tapes is assembled in the 'masterlist' variable. Note that the first history tape is index 1 in + ! tapes is assembled in the 'allhistfldlist' variable. Note that the first history tape is index 1 in ! the code but contains 'h0' in its output filenames (see set_hist_filename method). type history_tape integer :: nflds ! number of active fields on tape @@ -273,7 +273,7 @@ end subroutine copy_entry_interface logical :: is_endhist ! true => current time step is end of history interval real(r8) :: begtime ! time at beginning of history averaging interval type (history_entry) :: hlist(max_flds) ! array of active history tape entries. - ! The ordering matches the masterlist's. + ! The ordering matches the allhistfldlist's. end type history_tape type clmpoint_rs ! Pointer to real scalar data (1D) @@ -294,7 +294,7 @@ end subroutine copy_entry_interface ! hist_addfld* calls in the code. ! For the field data itself, see 'tape'. ! - type (master_entry) :: masterlist(max_flds) ! list of all history fields + type (allhistfldlist_entry) :: allhistfldlist(max_flds) ! list of all history fields ! ! Whether each history tape is in use in this run. If history_tape_in_use(i) is false, ! then data in tape(i) is undefined and should not be referenced. @@ -302,7 +302,7 @@ end subroutine copy_entry_interface logical :: history_tape_in_use(max_tapes) ! whether each history tape is in use in this run ! ! The actual (accumulated) history data for all active fields in each in-use tape. See - ! 'history_tape_in_use' for in-use tapes, and 'masterlist' for active fields. See also + ! 'history_tape_in_use' for in-use tapes, and 'allhistfldlist' for active fields. See also ! clmptr_r* variables for raw history data. ! type (history_tape) :: tape(max_tapes) ! array of history tapes @@ -311,7 +311,7 @@ end subroutine copy_entry_interface ! ! Counters ! - integer :: nfmaster = 0 ! number of fields in list of all history fields + integer :: nallhistflds = 0 ! number of fields in list of all history fields ! ! Other variables ! @@ -370,10 +370,10 @@ subroutine hist_printflds() !----------------------------------------------------------------------- if (masterproc) then - write(iulog,*) trim(subname),' : number of master fields = ',nfmaster + write(iulog,*) trim(subname),' : number of history fields = ',nallhistflds write(iulog,*)' ******* LIST OF ALL HISTORY FIELDS *******' - do nf = 1,nfmaster - write(iulog,9000)nf, masterlist(nf)%field%name, masterlist(nf)%field%units + do nf = 1,nallhistflds + write(iulog,9000)nf, allhistfldlist(nf)%field%name, allhistfldlist(nf)%field%units 9000 format (i5,1x,a32,1x,a16) end do call shr_sys_flush(iulog) @@ -385,7 +385,7 @@ subroutine hist_printflds() ! the CTSM's web-based documentation. ! First sort the list to be in alphabetical order - call sort_hist_list(1, nfmaster, masterlist) + call sort_hist_list(1, nallhistflds, allhistfldlist) if (masterproc .and. hist_fields_list_file) then ! Hardwired table column widths to fit the table on a computer @@ -466,12 +466,12 @@ subroutine hist_printflds() ! Main table ! Concatenate strings needed in format statement fmt_txt = '(i'//str_width_col(1)//',x,a'//str_width_col(2)//',x,a'//str_width_col(3)//',x,a'//str_width_col(4)//',l'//str_width_col(5)//')' - do nf = 1,nfmaster + do nf = 1,nallhistflds write(hist_fields_file,fmt_txt) nf, & - masterlist(nf)%field%name, & - masterlist(nf)%field%long_name, & - masterlist(nf)%field%units, & - masterlist(nf)%actflag(1) + allhistfldlist(nf)%field%name, & + allhistfldlist(nf)%field%long_name, & + allhistfldlist(nf)%field%units, & + allhistfldlist(nf)%actflag(1) end do ! Table footer, same as header @@ -489,7 +489,7 @@ subroutine hist_printflds() end subroutine hist_printflds !----------------------------------------------------------------------- - subroutine masterlist_addfld (fname, numdims, type1d, type1d_out, & + subroutine allhistfldlist_addfld (fname, numdims, type1d, type1d_out, & type2d, num2d, units, avgflag, long_name, hpindex, & p2c_scale_type, c2l_scale_type, l2g_scale_type, & no_snow_behavior) @@ -497,7 +497,7 @@ subroutine masterlist_addfld (fname, numdims, type1d, type1d_out, & ! !DESCRIPTION: ! Add a field to the list of all history fields. Put input arguments of ! field name, units, number of levels, averaging flag, and long name - ! into a type entry in the global list of all history fields (masterlist). + ! into a type entry in the global list of all history fields (allhistfldlist). ! ! The optional argument no_snow_behavior should be given when this is a multi-layer ! snow field, and should be absent otherwise. It should take on one of the no_snow_* @@ -521,14 +521,14 @@ subroutine masterlist_addfld (fname, numdims, type1d, type1d_out, & ! ! !LOCAL VARIABLES: integer :: n ! loop index - integer :: f ! masterlist index + integer :: f ! allhistfldlist index integer :: numa ! total number of atm cells across all processors integer :: numg ! total number of gridcells across all processors integer :: numl ! total number of landunits across all processors integer :: numc ! total number of columns across all processors integer :: nump ! total number of pfts across all processors type(bounds_type) :: bounds - character(len=*),parameter :: subname = 'masterlist_addfld' + character(len=*),parameter :: subname = 'allhistfldlist_addfld' !------------------------------------------------------------------------ if (.not. avgflag_valid(avgflag, blank_valid=.true.)) then @@ -556,8 +556,8 @@ subroutine masterlist_addfld (fname, numdims, type1d, type1d_out, & end if ! Ensure that new field doesn't already exist - do n = 1,nfmaster - if (masterlist(n)%field%name == fname) then + do n = 1,nallhistflds + if (allhistfldlist(n)%field%name == fname) then write(iulog,*) trim(subname),' ERROR:', fname, ' already on list' call endrun(msg=errMsg(sourcefile, __LINE__)) end if @@ -565,62 +565,62 @@ subroutine masterlist_addfld (fname, numdims, type1d, type1d_out, & ! Increase number of fields on list of all history fields - nfmaster = nfmaster + 1 - f = nfmaster + nallhistflds = nallhistflds + 1 + f = nallhistflds ! Check number of fields in list against maximum number - if (nfmaster > max_flds) then + if (nallhistflds > max_flds) then write(iulog,*) trim(subname),' ERROR: too many fields for primary history file ', & - '-- max_flds,nfmaster=', max_flds, nfmaster + '-- max_flds,nallhistflds=', max_flds, nallhistflds call endrun(msg=errMsg(sourcefile, __LINE__)) end if ! Add field to list of all history fields - masterlist(f)%field%name = fname - masterlist(f)%field%long_name = long_name - masterlist(f)%field%units = units - masterlist(f)%field%type1d = type1d - masterlist(f)%field%type1d_out = type1d_out - masterlist(f)%field%type2d = type2d - masterlist(f)%field%numdims = numdims - masterlist(f)%field%num2d = num2d - masterlist(f)%field%hpindex = hpindex - masterlist(f)%field%p2c_scale_type = p2c_scale_type - masterlist(f)%field%c2l_scale_type = c2l_scale_type - masterlist(f)%field%l2g_scale_type = l2g_scale_type + allhistfldlist(f)%field%name = fname + allhistfldlist(f)%field%long_name = long_name + allhistfldlist(f)%field%units = units + allhistfldlist(f)%field%type1d = type1d + allhistfldlist(f)%field%type1d_out = type1d_out + allhistfldlist(f)%field%type2d = type2d + allhistfldlist(f)%field%numdims = numdims + allhistfldlist(f)%field%num2d = num2d + allhistfldlist(f)%field%hpindex = hpindex + allhistfldlist(f)%field%p2c_scale_type = p2c_scale_type + allhistfldlist(f)%field%c2l_scale_type = c2l_scale_type + allhistfldlist(f)%field%l2g_scale_type = l2g_scale_type select case (type1d) case (grlnd) - masterlist(f)%field%beg1d = bounds%begg - masterlist(f)%field%end1d = bounds%endg - masterlist(f)%field%num1d = numg + allhistfldlist(f)%field%beg1d = bounds%begg + allhistfldlist(f)%field%end1d = bounds%endg + allhistfldlist(f)%field%num1d = numg case (nameg) - masterlist(f)%field%beg1d = bounds%begg - masterlist(f)%field%end1d = bounds%endg - masterlist(f)%field%num1d = numg + allhistfldlist(f)%field%beg1d = bounds%begg + allhistfldlist(f)%field%end1d = bounds%endg + allhistfldlist(f)%field%num1d = numg case (namel) - masterlist(f)%field%beg1d = bounds%begl - masterlist(f)%field%end1d = bounds%endl - masterlist(f)%field%num1d = numl + allhistfldlist(f)%field%beg1d = bounds%begl + allhistfldlist(f)%field%end1d = bounds%endl + allhistfldlist(f)%field%num1d = numl case (namec) - masterlist(f)%field%beg1d = bounds%begc - masterlist(f)%field%end1d = bounds%endc - masterlist(f)%field%num1d = numc + allhistfldlist(f)%field%beg1d = bounds%begc + allhistfldlist(f)%field%end1d = bounds%endc + allhistfldlist(f)%field%num1d = numc case (namep) - masterlist(f)%field%beg1d = bounds%begp - masterlist(f)%field%end1d = bounds%endp - masterlist(f)%field%num1d = nump + allhistfldlist(f)%field%beg1d = bounds%begp + allhistfldlist(f)%field%end1d = bounds%endp + allhistfldlist(f)%field%num1d = nump case default write(iulog,*) trim(subname),' ERROR: unknown 1d output type= ',type1d call endrun(msg=errMsg(sourcefile, __LINE__)) end select if (present(no_snow_behavior)) then - masterlist(f)%field%no_snow_behavior = no_snow_behavior + allhistfldlist(f)%field%no_snow_behavior = no_snow_behavior else - masterlist(f)%field%no_snow_behavior = no_snow_unset + allhistfldlist(f)%field%no_snow_behavior = no_snow_unset end if ! The following two fields are used only in list of all history fields, @@ -628,10 +628,10 @@ subroutine masterlist_addfld (fname, numdims, type1d, type1d_out, & ! ALL FIELDS IN THE FORMER ARE INITIALIZED WITH THE ACTIVE ! FLAG SET TO FALSE - masterlist(f)%avgflag(:) = avgflag - masterlist(f)%actflag(:) = .false. + allhistfldlist(f)%avgflag(:) = avgflag + allhistfldlist(f)%actflag(:) = .false. - end subroutine masterlist_addfld + end subroutine allhistfldlist_addfld !----------------------------------------------------------------------- subroutine hist_htapes_build () @@ -715,7 +715,7 @@ subroutine hist_htapes_build () end subroutine hist_htapes_build !----------------------------------------------------------------------- - subroutine masterlist_make_active (name, tape_index, avgflag) + subroutine allhistfldlist_make_active (name, tape_index, avgflag) ! ! !DESCRIPTION: ! Add a field to the default ``on'' list for a given history file. @@ -728,8 +728,8 @@ subroutine masterlist_make_active (name, tape_index, avgflag) ! ! !LOCAL VARIABLES: integer :: f ! field index - logical :: found ! flag indicates field found in masterlist - character(len=*),parameter :: subname = 'masterlist_make_active' + logical :: found ! flag indicates field found in allhistfldlist + character(len=*),parameter :: subname = 'allhistfldlist_make_active' !----------------------------------------------------------------------- ! Check validity of input arguments @@ -751,11 +751,11 @@ subroutine masterlist_make_active (name, tape_index, avgflag) ! Also reset averaging flag if told to use other than default. found = .false. - do f = 1,nfmaster - if (trim(name) == trim(masterlist(f)%field%name)) then - masterlist(f)%actflag(tape_index) = .true. + do f = 1,nallhistflds + if (trim(name) == trim(allhistfldlist(f)%field%name)) then + allhistfldlist(f)%actflag(tape_index) = .true. if (present(avgflag)) then - if (avgflag/= ' ') masterlist(f)%avgflag(tape_index) = avgflag + if (avgflag/= ' ') allhistfldlist(f)%avgflag(tape_index) = avgflag end if found = .true. exit @@ -766,10 +766,10 @@ subroutine masterlist_make_active (name, tape_index, avgflag) call endrun(msg=errMsg(sourcefile, __LINE__)) end if - end subroutine masterlist_make_active + end subroutine allhistfldlist_make_active !----------------------------------------------------------------------- - subroutine masterlist_change_timeavg (t) + subroutine allhistfldlist_change_timeavg (t) ! ! !DESCRIPTION: ! Override default history tape contents for a specific tape. @@ -781,7 +781,7 @@ subroutine masterlist_change_timeavg (t) ! !LOCAL VARIABLES: integer :: f ! field index character(len=avgflag_strlen) :: avgflag ! local equiv of hist_avgflag_pertape(t) - character(len=*),parameter :: subname = 'masterlist_change_timeavg' + character(len=*),parameter :: subname = 'allhistfldlist_change_timeavg' !----------------------------------------------------------------------- avgflag = hist_avgflag_pertape(t) @@ -790,11 +790,11 @@ subroutine masterlist_change_timeavg (t) call endrun(msg=errMsg(sourcefile, __LINE__)) end if - do f = 1,nfmaster - masterlist(f)%avgflag(t) = avgflag + do f = 1,nallhistflds + allhistfldlist(f)%avgflag(t) = avgflag end do - end subroutine masterlist_change_timeavg + end subroutine allhistfldlist_change_timeavg !----------------------------------------------------------------------- subroutine htapes_fieldlist() @@ -806,7 +806,7 @@ subroutine htapes_fieldlist() ! Then sort the result alphanumerically. ! ! Sets history_tape_in_use and htapes_defined. Fills fields in 'tape' array. - ! Optionally updates masterlist avgflag. + ! Optionally updates allhistfldlist avgflag. ! ! !ARGUMENTS: ! @@ -814,7 +814,7 @@ subroutine htapes_fieldlist() integer :: t, f ! tape, field indices integer :: ff ! index into include, exclude and fprec list character(len=max_namlen) :: name ! field name portion of fincl (i.e. no avgflag separator) - character(len=max_namlen) :: mastername ! name from masterlist field + character(len=max_namlen) :: allhistfldname ! name from allhistfldlist field character(len=avgflag_strlen) :: avgflag ! averaging flag character(len=1) :: prec_acc ! history buffer precision flag character(len=1) :: prec_wrt ! history buffer write precision flag @@ -826,7 +826,7 @@ subroutine htapes_fieldlist() do t=1,max_tapes if (hist_avgflag_pertape(t) /= ' ') then - call masterlist_change_timeavg (t) + call allhistfldlist_change_timeavg (t) end if end do @@ -859,11 +859,11 @@ subroutine htapes_fieldlist() f = 1 do while (f < max_flds .and. fincl(f,t) /= ' ') name = getname (fincl(f,t)) - do ff = 1,nfmaster - mastername = masterlist(ff)%field%name - if (name == mastername) exit + do ff = 1,nallhistflds + allhistfldname = allhistfldlist(ff)%field%name + if (name == allhistfldname) exit end do - if (name /= mastername) then + if (name /= allhistfldname) then write(iulog,*) trim(subname),' ERROR: ', trim(name), ' in fincl(', f, ') ',& 'for history tape ',t,' not found' call endrun(msg=errMsg(sourcefile, __LINE__)) @@ -873,11 +873,11 @@ subroutine htapes_fieldlist() f = 1 do while (f < max_flds .and. fexcl(f,t) /= ' ') - do ff = 1,nfmaster - mastername = masterlist(ff)%field%name - if (fexcl(f,t) == mastername) exit + do ff = 1,nallhistflds + allhistfldname = allhistfldlist(ff)%field%name + if (fexcl(f,t) == allhistfldname) exit end do - if (fexcl(f,t) /= mastername) then + if (fexcl(f,t) /= allhistfldname) then write(iulog,*) trim(subname),' ERROR: ', fexcl(f,t), ' in fexcl(', f, ') ', & 'for history tape ',t,' not found' call endrun(msg=errMsg(sourcefile, __LINE__)) @@ -890,16 +890,16 @@ subroutine htapes_fieldlist() tape(:)%nflds = 0 do t = 1,max_tapes - ! Loop through the masterlist set of field names and determine if any of those + ! Loop through the allhistfldlist set of field names and determine if any of those ! are in the FINCL or FEXCL arrays ! The call to list_index determines the index in the FINCL or FEXCL arrays - ! that the masterlist field corresponds to + ! that the allhistfldlist field corresponds to ! Add the field to the tape if specified via namelist (FINCL[1-max_tapes]), ! or if it is on by default and was not excluded via namelist (FEXCL[1-max_tapes]). - do f = 1,nfmaster - mastername = masterlist(f)%field%name - call list_index (fincl(1,t), mastername, ff) + do f = 1,nallhistflds + allhistfldname = allhistfldlist(f)%field%name + call list_index (fincl(1,t), allhistfldname, ff) if (ff > 0) then @@ -913,7 +913,7 @@ subroutine htapes_fieldlist() ! find index of field in exclude list - call list_index (fexcl(1,t), mastername, ff) + call list_index (fexcl(1,t), allhistfldname, ff) ! if field is in exclude list, ff > 0 and htape_addfld ! will not be called for field @@ -922,7 +922,7 @@ subroutine htapes_fieldlist() ! called below only if field is not in exclude list OR in ! include list - if (ff == 0 .and. masterlist(f)%actflag(t)) then + if (ff == 0 .and. allhistfldlist(f)%actflag(t)) then call htape_addfld (t, f, ' ') end if @@ -1002,7 +1002,7 @@ subroutine htapes_fieldlist() call shr_sys_flush(iulog) end if - ! Set flag indicating h-tape contents are now defined (needed by masterlist_addfld) + ! Set flag indicating h-tape contents are now defined (needed by allhistfldlist_addfld) htapes_defined = .true. @@ -1010,23 +1010,23 @@ subroutine htapes_fieldlist() end subroutine htapes_fieldlist !----------------------------------------------------------------------- - subroutine copy_master_entry(this, other) + subroutine copy_allhistfldlist_entry(this, other) ! set this = other - class(master_entry), intent(out) :: this + class(allhistfldlist_entry), intent(out) :: this class(entry_base), intent(in) :: other select type(this) - type is (master_entry) + type is (allhistfldlist_entry) select type(other) - type is (master_entry) + type is (allhistfldlist_entry) this = other class default - call endrun('Unexpected type of "other" in copy_master_entry') + call endrun('Unexpected type of "other" in copy_allhistfldlist_entry') end select class default - call endrun('Unexpected type of "this" in copy_master_entry') + call endrun('Unexpected type of "this" in copy_allhistfldlist_entry') end select - end subroutine copy_master_entry + end subroutine copy_allhistfldlist_entry !----------------------------------------------------------------------- subroutine copy_history_entry(this, other) @@ -1161,7 +1161,7 @@ subroutine htape_addfld (t, f, avgflag) if (htapes_defined) then write(iulog,*) trim(subname),' ERROR: attempt to add field ', & - masterlist(f)%field%name, ' after history files are set' + allhistfldlist(f)%field%name, ' after history files are set' call endrun(msg=errMsg(sourcefile, __LINE__)) end if @@ -1170,7 +1170,7 @@ subroutine htape_addfld (t, f, avgflag) ! Copy field information - tape(t)%hlist(n)%field = masterlist(f)%field + tape(t)%hlist(n)%field = allhistfldlist(f)%field ! Determine bounds @@ -1254,8 +1254,8 @@ subroutine htape_addfld (t, f, avgflag) tape(t)%hlist(n)%field%num1d_out = num1d_out ! Fields native bounds - beg1d = masterlist(f)%field%beg1d - end1d = masterlist(f)%field%end1d + beg1d = allhistfldlist(f)%field%beg1d + end1d = allhistfldlist(f)%field%end1d ! Alloccate and initialize history buffer and related info @@ -1270,7 +1270,7 @@ subroutine htape_addfld (t, f, avgflag) tape(t)%hlist(n)%hbuf(:,:) = 0._r8 tape(t)%hlist(n)%nacs(:,:) = 0 - ! Set time averaging flag based on masterlist setting or + ! Set time averaging flag based on allhistfldlist setting or ! override the default averaging flag with namelist setting if (.not. avgflag_valid(avgflag, blank_valid=.true.)) then @@ -1279,7 +1279,7 @@ subroutine htape_addfld (t, f, avgflag) end if if (avgflag == ' ') then - tape(t)%hlist(n)%avgflag = masterlist(f)%avgflag(t) + tape(t)%hlist(n)%avgflag = allhistfldlist(f)%avgflag(t) else tape(t)%hlist(n)%avgflag = avgflag end if @@ -5179,7 +5179,7 @@ subroutine hist_addfld1d (fname, units, avgflag, long_name, type1d_out, & ! !DESCRIPTION: ! Initialize a single level history field. The pointer inputs, ptr\_*, ! point to the appropriate-type array storing the raw history data points. - ! The value of type1d passed to masterlist\_add\_fld determines which of the + ! The value of type1d passed to allhistfldlist\_add\_fld determines which of the ! 1d type of the output and the beginning and ending indices the history ! buffer field). All fields default to being written to the first history tape ! unless 'default' is set to 'inactive'. @@ -5367,9 +5367,9 @@ subroutine hist_addfld1d (fname, units, avgflag, long_name, type1d_out, & if (present(l2g_scale_type)) scale_type_l2g = l2g_scale_type if (present(type1d_out)) l_type1d_out = type1d_out - ! Add field to masterlist + ! Add field to allhistfldlist - call masterlist_addfld (fname=trim(fname), numdims=1, type1d=l_type1d, & + call allhistfldlist_addfld (fname=trim(fname), numdims=1, type1d=l_type1d, & type1d_out=l_type1d_out, type2d='unset', num2d=1, & units=units, avgflag=avgflag, long_name=long_name, hpindex=hpindex, & p2c_scale_type=scale_type_p2c, c2l_scale_type=scale_type_c2l, & @@ -5382,7 +5382,7 @@ subroutine hist_addfld1d (fname, units, avgflag, long_name, type1d_out, & if (trim(l_default) == 'inactive') then return else - call masterlist_make_active (name=trim(fname), tape_index=1) + call allhistfldlist_make_active (name=trim(fname), tape_index=1) end if end subroutine hist_addfld1d @@ -5397,7 +5397,7 @@ subroutine hist_addfld2d (fname, type2d, units, avgflag, long_name, type1d_out, ! !DESCRIPTION: ! Initialize a single level history field. The pointer inputs, ptr\_*, ! point to the appropriate-type array storing the raw history data points. - ! The value of type1d passed to masterlist\_add\_fld determines which of the + ! The value of type1d passed to allhistfldlist\_add\_fld determines which of the ! 1d type of the output and the beginning and ending indices the history ! buffer field). All fields default to being written to the first history tape ! unless 'default' is set to 'inactive'. @@ -5703,9 +5703,9 @@ subroutine hist_addfld2d (fname, type2d, units, avgflag, long_name, type1d_out, if (present(l2g_scale_type)) scale_type_l2g = l2g_scale_type if (present(type1d_out)) l_type1d_out = type1d_out - ! Add field to masterlist + ! Add field to allhistfldlist - call masterlist_addfld (fname=trim(fname), numdims=2, type1d=l_type1d, & + call allhistfldlist_addfld (fname=trim(fname), numdims=2, type1d=l_type1d, & type1d_out=l_type1d_out, type2d=type2d, num2d=num2d, & units=units, avgflag=avgflag, long_name=long_name, hpindex=hpindex, & p2c_scale_type=scale_type_p2c, c2l_scale_type=scale_type_c2l, & @@ -5718,7 +5718,7 @@ subroutine hist_addfld2d (fname, type2d, units, avgflag, long_name, type1d_out, if (trim(l_default) == 'inactive') then return else - call masterlist_make_active (name=trim(fname), tape_index=1) + call allhistfldlist_make_active (name=trim(fname), tape_index=1) end if end subroutine hist_addfld2d From 9f249bbb56e0b813fbf394368e757ffdbb78dddb Mon Sep 17 00:00:00 2001 From: Sam Rabin Date: Fri, 11 Aug 2023 14:15:34 -0600 Subject: [PATCH 171/257] histFileMod no longer prints variable numbers to .rst files. --- src/main/histFileMod.F90 | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/main/histFileMod.F90 b/src/main/histFileMod.F90 index bdcec28ec1..ac12008302 100644 --- a/src/main/histFileMod.F90 +++ b/src/main/histFileMod.F90 @@ -451,8 +451,8 @@ subroutine hist_printflds() fmt_txt = '('//str_w_col_sum//'a)' write(hist_fields_file,fmt_txt) ('-', i=1, width_col_sum) ! Concatenate strings needed in format statement - fmt_txt = '(a'//str_width_col(1)//',x,a'//str_width_col(2)//',x,a'//str_width_col(3)//',x,a'//str_width_col(4)//',x,a'//str_width_col(5)//')' - write(hist_fields_file,fmt_txt) '#', 'Variable Name', & + fmt_txt = '(a'//str_width_col(1)//',x,a'//str_width_col(2)//',x,a'//str_width_col(3)//',x,a'//str_width_col(4)//')' + write(hist_fields_file,fmt_txt) 'Variable Name', & 'Long Description', 'Units', 'Active?' ! End header, same as header @@ -465,9 +465,9 @@ subroutine hist_printflds() ! Main table ! Concatenate strings needed in format statement - fmt_txt = '(i'//str_width_col(1)//',x,a'//str_width_col(2)//',x,a'//str_width_col(3)//',x,a'//str_width_col(4)//',l'//str_width_col(5)//')' + fmt_txt = '(a'//str_width_col(1)//',x,a'//str_width_col(2)//',x,a'//str_width_col(3)//',l'//str_width_col(4)//')' do nf = 1,nallhistflds - write(hist_fields_file,fmt_txt) nf, & + write(hist_fields_file,fmt_txt) & allhistfldlist(nf)%field%name, & allhistfldlist(nf)%field%long_name, & allhistfldlist(nf)%field%units, & From d533932fe075ef1f985895f68e9c11cf215a2159 Mon Sep 17 00:00:00 2001 From: Sam Rabin Date: Fri, 11 Aug 2023 14:54:18 -0600 Subject: [PATCH 172/257] Fix history_fields_*.rst column widths. --- src/main/histFileMod.F90 | 13 ++++++------- 1 file changed, 6 insertions(+), 7 deletions(-) diff --git a/src/main/histFileMod.F90 b/src/main/histFileMod.F90 index ac12008302..c28b3c5c77 100644 --- a/src/main/histFileMod.F90 +++ b/src/main/histFileMod.F90 @@ -356,7 +356,7 @@ subroutine hist_printflds() ! !ARGUMENTS: ! ! !LOCAL VARIABLES: - integer, parameter :: ncol = 5 ! number of table columns + integer, parameter :: ncol = 4 ! number of table columns integer nf, i, j ! do-loop counters integer hist_fields_file ! file unit number integer width_col(ncol) ! widths of table columns @@ -390,14 +390,13 @@ subroutine hist_printflds() if (masterproc .and. hist_fields_list_file) then ! Hardwired table column widths to fit the table on a computer ! screen. Some strings will be truncated as a result of the - ! current choices (4, 35, 94, 65, 7). In sphinx (ie the web-based + ! current choices (35, 94, 65, 7). In sphinx (ie the web-based ! documentation), text that has not been truncated will wrap ! around in the available space. - width_col(1) = 4 ! column that shows the variable number, nf - width_col(2) = 35 ! variable name column - width_col(3) = 94 ! long description column - width_col(4) = 65 ! units column - width_col(5) = 7 ! active (T or F) column + width_col(1) = 35 ! variable name column + width_col(2) = 94 ! long description column + width_col(3) = 65 ! units column + width_col(4) = 7 ! active (T or F) column width_col_sum = sum(width_col) + ncol - 1 ! sum of widths & blank spaces ! Convert integer widths to strings for use in format statements From 614d0e1dd886f62a9d5abe885749dad5b8c1341b Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Fri, 11 Aug 2023 16:10:17 -0600 Subject: [PATCH 173/257] Draft ChangeLog and ChangeSum --- doc/ChangeLog | 101 ++++++++++++++++++++++++++++++++++++++++++++++++++ doc/ChangeSum | 1 + 2 files changed, 102 insertions(+) diff --git a/doc/ChangeLog b/doc/ChangeLog index ec7f8303a1..5cdbe4c1cc 100644 --- a/doc/ChangeLog +++ b/doc/ChangeLog @@ -1,4 +1,105 @@ =============================================================== +Tag name: ctsm5.1.dev13? +Originator(s): slevis (Samuel Levis,UCAR/TSS,303-665-1310) +Date: Fri Aug 11 15:55:11 MDT 2023 +One-line Summary: Change small snocan to zero + +Purpose and description of changes +---------------------------------- + + Issues #2041 and #2048 discuss and resolve a test failure in the ctsm5.2 + branch. The failure goes away when we reset small snocan to zero. + + @billsacks recommended merging this change in ctsm5.1 and then updating + the ctsm5.2 branch to the latest ctsm5.1. + + +Significant changes to scientifically-supported configurations +-------------------------------------------------------------- + +Does this tag change answers significantly for any of the following physics configurations? +(Details of any changes will be given in the "Answer changes" section below.) + + [Put an [X] in the box for any configuration with significant answer changes.] + +[ ] clm5_1 + +[ ] clm5_0 + +[ ] ctsm5_0-nwp + +[ ] clm4_5 + + +Bugs fixed or introduced +------------------------ +CTSM issues fixed (include CTSM Issue #): + #2041 + #2048 + + +Testing summary: +---------------- + + [PASS means all tests PASS; OK means tests PASS other than expected fails.] + + build-namelist tests (if CLMBuildNamelist.pm has changed): + + cheyenne - + + tools-tests (test/tools) (if tools have been changed): + + cheyenne - + + python testing (if python code has changed; see instructions in python/README.md; document testing done): + + (any machine) - + + [If python code has changed and you are NOT running aux_clm (e.g., because the only changes are in python + code) then also run the clm_pymods test suite; this is a small subset of aux_clm that runs the system + tests impacted by python changes. The best way to do this, if you expect no changes from the last tag in + either model output or namelists, is: create sym links pointing to the last tag's baseline directory, + named with the upcoming tag; then run the clm_pymods test suite comparing against these baselines but NOT + doing their own baseline generation. If you are already running the full aux_clm then you do NOT need to + separately run the clm_pymods test suite, and you can remove the following line.] + + clm_pymods test suite on cheyenne - + + regular tests (aux_clm: https://github.com/ESCOMP/CTSM/wiki/System-Testing-Guide#pre-merge-system-testing): + + cheyenne ---- + izumi ------- + + any other testing (give details below): + +If the tag used for baseline comparisons was NOT the previous tag, note that here: + + +Answer changes +-------------- + +Changes answers relative to baseline: + Yes + + Summarize any changes to answers, i.e., + - what code configurations: All + - what platforms/compilers: All + - nature of change: roundoff + + The answer changes are expected to be roundoff-level because the code change + just truncates roundoff-level greater-than-zero states to exactly zero for + snocan that most likely needed to be zero anyway. + We find that the answer changes grow to greater than roundoff, but the + cprnc.out file from a 20-year izumi test-suite case does not contain + differences of concerning magnitude. + +Other details +------------- +Pull Requests that document the changes (include PR ids): + https://github.com/ESCOMP/ctsm/pull/2053 + +=============================================================== +=============================================================== Tag name: ctsm5.1.dev131 Originator(s): samrabin (Sam Rabin,UCAR/TSS) Date: Thu Jul 27 14:24:07 MDT 2023 diff --git a/doc/ChangeSum b/doc/ChangeSum index 2d1812cd13..0f6e8b5084 100644 --- a/doc/ChangeSum +++ b/doc/ChangeSum @@ -1,5 +1,6 @@ Tag Who Date Summary ============================================================================================================================ + ctsm5.1.dev13? slevis ??/??/2023 Change small snocan to zero ctsm5.1.dev131 samrabin 07/27/2023 Enable prescribed crop calendars ctsm5.1.dev130 glemieux 07/09/2023 FATES parameter file and test definition update ctsm5.1.dev129 erik 06/22/2023 NEON fixes for TOOL and user-mods, add SP for NEON, some history file updates, black refactor for buildlib/buildnml From 402f91802f8ca215cdda8be5004d78e1a178803e Mon Sep 17 00:00:00 2001 From: Sam Rabin Date: Fri, 11 Aug 2023 16:31:33 -0600 Subject: [PATCH 174/257] Fix .rst output filenames. --- src/main/histFileMod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/main/histFileMod.F90 b/src/main/histFileMod.F90 index c28b3c5c77..6c0b53abc1 100644 --- a/src/main/histFileMod.F90 +++ b/src/main/histFileMod.F90 @@ -364,7 +364,7 @@ subroutine hist_printflds() character(len=3) str_width_col(ncol) ! string version of width_col character(len=3) str_w_col_sum ! string version of width_col_sum character(len=7) file_identifier ! fates identifier used in file_name - character(len=23) file_name ! hist_fields_file.rst with or without fates + character(len=26) file_name ! hist_fields_file.rst with or without fates character(len=99) fmt_txt ! format statement character(len=*),parameter :: subname = 'CLM_hist_printflds' !----------------------------------------------------------------------- From 0722eee4ba91b831da2318bfbeece9fd602eaa6d Mon Sep 17 00:00:00 2001 From: Sam Rabin Date: Fri, 11 Aug 2023 16:53:14 -0600 Subject: [PATCH 175/257] Added testmod SaveHistFieldList. --- .../testdefs/testmods_dirs/clm/SaveHistFieldList/user_nl_clm | 1 + 1 file changed, 1 insertion(+) create mode 100644 cime_config/testdefs/testmods_dirs/clm/SaveHistFieldList/user_nl_clm diff --git a/cime_config/testdefs/testmods_dirs/clm/SaveHistFieldList/user_nl_clm b/cime_config/testdefs/testmods_dirs/clm/SaveHistFieldList/user_nl_clm new file mode 100644 index 0000000000..4791cd28b2 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/clm/SaveHistFieldList/user_nl_clm @@ -0,0 +1 @@ +hist_fields_list_file = .true. From 302624a6e16983b82976d93a89172c1a45ae68b2 Mon Sep 17 00:00:00 2001 From: Sam Rabin Date: Fri, 11 Aug 2023 17:09:35 -0600 Subject: [PATCH 176/257] Updated history_fields_*.rst files with latest default outputs. --- .../history_fields_fates.rst | 795 ++++++++++-------- .../history_fields_nofates.rst | 143 ++-- 2 files changed, 502 insertions(+), 436 deletions(-) diff --git a/doc/source/users_guide/setting-up-and-running-a-case/history_fields_fates.rst b/doc/source/users_guide/setting-up-and-running-a-case/history_fields_fates.rst index 8b30306a9e..2fe1035549 100644 --- a/doc/source/users_guide/setting-up-and-running-a-case/history_fields_fates.rst +++ b/doc/source/users_guide/setting-up-and-running-a-case/history_fields_fates.rst @@ -8,13 +8,16 @@ use_cn = F use_crop = F use_fates = T -==== =================================== ============================================================================================== ================================================================= ======= +=================================== ============================================================================================== ================================================================= ======= CTSM History Fields ------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------ - # Variable Name Long Description Units Active? -==== =================================== ============================================================================================== ================================================================= ======= +------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------ + Variable Name Long Description Units Active? +=================================== ============================================================================================== ================================================================= ======= A5TMIN 5-day running mean of min 2-m temperature K F ACTUAL_IMMOB actual N immobilization gN/m^2/s T +ACTUAL_IMMOB_NH4 immobilization of NH4 gN/m^3/s F +ACTUAL_IMMOB_NO3 immobilization of NO3 gN/m^3/s F +ACTUAL_IMMOB_vr actual N immobilization gN/m^3/s F ACT_SOMC ACT_SOM C gC/m^2 T ACT_SOMC_1m ACT_SOM C to 1 meter gC/m^2 F ACT_SOMC_TNDNCY_VERT_TRA active soil organic C tendency due to vertical transport gC/m^3/s F @@ -35,9 +38,6 @@ ACT_SOM_HR_S2 Het. Resp. from active soil organic ACT_SOM_HR_S2_vr Het. Resp. from active soil organic gC/m^3/s F ACT_SOM_HR_S3 Het. Resp. from active soil organic gC/m^2/s F ACT_SOM_HR_S3_vr Het. Resp. from active soil organic gC/m^3/s F -AGB Aboveground biomass gC m-2 T -AGB_SCLS Aboveground biomass by size class kgC/m2 T -AGB_SCPF Aboveground biomass by pft/size kgC/m2 F AGLB Aboveground leaf biomass kg/m^2 F AGSB Aboveground stem biomass kg/m^2 F ALBD surface albedo (direct) proportion F @@ -47,54 +47,12 @@ ALBI surface albedo (indirect) ALT current active layer thickness m F ALTMAX maximum annual active layer thickness m F ALTMAX_LASTYEAR maximum prior year active layer thickness m F -AR autotrophic respiration gC/m^2/s T -AREA_BURNT_BY_PATCH_AGE spitfire area burnt by patch age (divide by patch_area_by_age to get burnt fraction by age) m2/m2/day T -AREA_PLANT area occupied by all plants m2/m2 T -AREA_TREES area occupied by woody plants m2/m2 T -AR_AGSAPM_SCPF above-ground sapwood maintenance autotrophic respiration per m2 per year by pft/size kgC/m2/yr F -AR_CANOPY autotrophic respiration of canopy plants gC/m^2/s T -AR_CANOPY_SCPF autotrophic respiration of canopy plants by pft/size kgC/m2/yr F -AR_CROOTM_SCPF below-ground sapwood maintenance autotrophic respiration per m2 per year by pft/size kgC/m2/yr F -AR_DARKM_SCPF dark portion of maintenance autotrophic respiration per m2 per year by pft/size kgC/m2/yr F -AR_FROOTM_SCPF fine root maintenance autotrophic respiration per m2 per year by pft/size kgC/m2/yr F -AR_GROW_SCPF growth autotrophic respiration per m2 per year by pft/size kgC/m2/yr F -AR_MAINT_SCPF maintenance autotrophic respiration per m2 per year by pft/size kgC/m2/yr F -AR_SCPF total autotrophic respiration per m2 per year by pft/size kgC/m2/yr F -AR_UNDERSTORY autotrophic respiration of understory plants gC/m^2/s T -AR_UNDERSTORY_SCPF autotrophic respiration of understory plants by pft/size kgC/m2/yr F +ATM_O3 atmospheric ozone partial pressure mol/mol F ATM_TOPO atmospheric surface height m T AnnET Annual ET mm/s F -BA_SCLS basal area by size class m2/ha T -BA_SCPF basal area by pft/size m2/ha F BCDEP total BC deposition (dry+wet) from atmosphere kg/m^2/s T -BDEAD_MD_CANOPY_SCLS BDEAD_MD for canopy plants by size class kg C / ha / yr F -BDEAD_MD_UNDERSTORY_SCLS BDEAD_MD for understory plants by size class kg C / ha / yr F -BIOMASS_AGEPFT biomass per PFT in each age bin kg C / m2 F -BIOMASS_BY_AGE Total Biomass within a given patch age bin kgC/m2 F -BIOMASS_CANOPY Biomass of canopy plants gC m-2 T -BIOMASS_SCLS Total biomass by size class kgC/m2 F -BIOMASS_UNDERSTORY Biomass of understory plants gC m-2 T -BLEAF_CANOPY_SCPF biomass carbon in leaf of canopy plants by pft/size kgC/ha F -BLEAF_UNDERSTORY_SCPF biomass carbon in leaf of understory plants by pft/size kgC/ha F -BSTORE_MD_CANOPY_SCLS BSTORE_MD for canopy plants by size class kg C / ha / yr F -BSTORE_MD_UNDERSTORY_SCLS BSTORE_MD for understory plants by size class kg C / ha / yr F -BSTOR_CANOPY_SCPF biomass carbon in storage pools of canopy plants by pft/size kgC/ha F -BSTOR_UNDERSTORY_SCPF biomass carbon in storage pools of understory plants by pft/size kgC/ha F -BSW_MD_CANOPY_SCLS BSW_MD for canopy plants by size class kg C / ha / yr F -BSW_MD_UNDERSTORY_SCLS BSW_MD for understory plants by size class kg C / ha / yr F BTRAN transpiration beta factor unitless T BTRANMN daily minimum of transpiration beta factor unitless T -BURNT_LITTER_FRAC_AREA_PRODUCT product of fraction of fuel burnt and burned area (divide by FIRE_AREA to get burned-area-weig fraction T -C13disc_SCPF C13 discrimination by pft/size per mil F -CAMBIALFIREMORT_SCPF cambial fire mortality by pft/size N/ha/yr F -CANOPY_AREA_BY_AGE canopy area by age bin m2/m2 T -CANOPY_HEIGHT_DIST canopy height distribution m2/m2 T -CANOPY_SPREAD Scaling factor between tree basal area and canopy area 0-1 T -CARBON_BALANCE_CANOPY_SCLS CARBON_BALANCE for canopy plants by size class kg C / ha / yr F -CARBON_BALANCE_UNDERSTORY_SCLS CARBON_BALANCE for understory plants by size class kg C / ha / yr F -CBALANCE_ERROR_FATES total carbon error, FATES mgC/day T -CEFFLUX carbon efflux, root to soil kgC/ha/day T -CEFFLUX_SCPF carbon efflux, root to soil, by size-class x pft kg/ha/day F CEL_LITC CEL_LIT C gC/m^2 T CEL_LITC_1m CEL_LIT C to 1 meter gC/m^2 F CEL_LITC_TNDNCY_VERT_TRA cellulosic litter C tendency due to vertical transport gC/m^3/s F @@ -125,41 +83,10 @@ CONC_CH4_UNSAT CH4 soil Concentration for non-inundated are CONC_O2_SAT O2 soil Concentration for inundated / lake area mol/m3 T CONC_O2_UNSAT O2 soil Concentration for non-inundated area mol/m3 T COSZEN cosine of solar zenith angle none F -CROWNAREA_CAN total crown area in each canopy layer m2/m2 T -CROWNAREA_CNLF total crown area that is occupied by leaves in each canopy and leaf layer m2/m2 F -CROWNFIREMORT_SCPF crown fire mortality by pft/size N/ha/yr F -CROWN_AREA_CANOPY_SCLS total crown area of canopy plants by size class m2/ha F -CROWN_AREA_UNDERSTORY_SCLS total crown area of understory plants by size class m2/ha F -CWDC_HR cwd C heterotrophic respiration gC/m^2/s F -CWD_AG_CWDSC size-resolved AG CWD stocks gC/m^2 F -CWD_AG_IN_CWDSC size-resolved AG CWD input gC/m^2/y F -CWD_AG_OUT_CWDSC size-resolved AG CWD output gC/m^2/y F -CWD_BG_CWDSC size-resolved BG CWD stocks gC/m^2 F -CWD_BG_IN_CWDSC size-resolved BG CWD input gC/m^2/y F -CWD_BG_OUT_CWDSC size-resolved BG CWD output gC/m^2/y F -C_LBLAYER mean leaf boundary layer conductance umol m-2 s-1 T -C_LBLAYER_BY_AGE mean leaf boundary layer conductance - by patch age umol m-2 s-1 F -C_STOMATA mean stomatal conductance umol m-2 s-1 T -C_STOMATA_BY_AGE mean stomatal conductance - by patch age umol m-2 s-1 F -DDBH_CANOPY_SCAG growth rate of canopy plantsnumber of plants per hectare in canopy in each size x age class cm/yr/ha F -DDBH_CANOPY_SCLS diameter growth increment by pft/size cm/yr/ha T -DDBH_CANOPY_SCPF diameter growth increment by pft/size cm/yr/ha F -DDBH_SCPF diameter growth increment by pft/size cm/yr/ha F -DDBH_UNDERSTORY_SCAG growth rate of understory plants in each size x age class cm/yr/ha F -DDBH_UNDERSTORY_SCLS diameter growth increment by pft/size cm/yr/ha T -DDBH_UNDERSTORY_SCPF diameter growth increment by pft/size cm/yr/ha F -DEMOTION_CARBONFLUX demotion-associated biomass carbon flux from canopy to understory gC/m2/s T -DEMOTION_RATE_SCLS demotion rate from canopy to understory by size class indiv/ha/yr F +CWDC_HR cwd C heterotrophic respiration gC/m^2/s T DENIT total rate of denitrification gN/m^2/s T DGNETDT derivative of net ground heat flux wrt soil temp W/m^2/K F -DISPLA displacement height m F -DISTURBANCE_RATE_FIRE Disturbance rate from fire m2 m-2 d-1 T -DISTURBANCE_RATE_LOGGING Disturbance rate from logging m2 m-2 d-1 T -DISTURBANCE_RATE_P2P Disturbance rate from primary to primary lands m2 m-2 d-1 T -DISTURBANCE_RATE_P2S Disturbance rate from primary to secondary lands m2 m-2 d-1 T -DISTURBANCE_RATE_POTENTIAL Potential (i.e., including unresolved) disturbance rate m2 m-2 d-1 T -DISTURBANCE_RATE_S2S Disturbance rate from secondary to secondary lands m2 m-2 d-1 T -DISTURBANCE_RATE_TREEFALL Disturbance rate from treefall m2 m-2 d-1 T +DISPLA displacement height (vegetated landunits only) m F DPVLTRB1 turbulent deposition velocity 1 m/s F DPVLTRB2 turbulent deposition velocity 2 m/s F DPVLTRB3 turbulent deposition velocity 3 m/s F @@ -170,16 +97,8 @@ DSTFLXT total surface dust emission DYN_COL_ADJUSTMENTS_CH4 Adjustments in ch4 due to dynamic column areas; only makes sense at the column level: should n gC/m^2 F DYN_COL_SOIL_ADJUSTMENTS_C Adjustments in soil carbon due to dynamic column areas; only makes sense at the column level: gC/m^2 F DYN_COL_SOIL_ADJUSTMENTS_N Adjustments in soil nitrogen due to dynamic column areas; only makes sense at the column level gN/m^2 F -ED_NCOHORTS Total number of ED cohorts per site none T -ED_NPATCHES Total number of ED patches per site none T -ED_balive Live biomass gC m-2 T -ED_bdead Dead (structural) biomass (live trees, not CWD) gC m-2 T -ED_bfineroot Fine root biomass gC m-2 T -ED_biomass Total biomass gC m-2 T -ED_bleaf Leaf biomass gC m-2 T -ED_bsapwood Sapwood biomass gC m-2 T -ED_bstore Storage biomass gC m-2 T -EFFECT_WSPEED effective windspeed for fire spread none T +DYN_COL_SOIL_ADJUSTMENTS_NH4 Adjustments in soil NH4 due to dynamic column areas; only makes sense at the column level: sho gN/m^2 F +DYN_COL_SOIL_ADJUSTMENTS_NO3 Adjustments in soil NO3 due to dynamic column areas; only makes sense at the column level: sho gN/m^2 F EFLXBUILD building heat flux from change in interior building air temperature W/m^2 T EFLX_DYNBAL dynamic land cover change conversion energy flux W/m^2 T EFLX_GNET net heat flux into ground W/m^2 F @@ -192,24 +111,375 @@ EFLX_SOIL_GRND soil heat flux [+ into soil] ELAI exposed one-sided leaf area index m^2/m^2 T ERRH2O total water conservation error mm T ERRH2OSNO imbalance in snow depth (liquid water) mm T -ERROR_FATES total error, FATES mass-balance mg/day T ERRSEB surface energy conservation error W/m^2 T ERRSOI soil/lake energy conservation error W/m^2 T ERRSOL solar radiation conservation error W/m^2 T ESAI exposed one-sided stem area index m^2/m^2 T -FABD_SHA_CNLF shade fraction of direct light absorbed by each canopy and leaf layer fraction F -FABD_SHA_CNLFPFT shade fraction of direct light absorbed by each canopy, leaf, and PFT fraction F -FABD_SHA_TOPLF_BYCANLAYER shade fraction of direct light absorbed by the top leaf layer of each canopy layer fraction F -FABD_SUN_CNLF sun fraction of direct light absorbed by each canopy and leaf layer fraction F -FABD_SUN_CNLFPFT sun fraction of direct light absorbed by each canopy, leaf, and PFT fraction F -FABD_SUN_TOPLF_BYCANLAYER sun fraction of direct light absorbed by the top leaf layer of each canopy layer fraction F -FABI_SHA_CNLF shade fraction of indirect light absorbed by each canopy and leaf layer fraction F -FABI_SHA_CNLFPFT shade fraction of indirect light absorbed by each canopy, leaf, and PFT fraction F -FABI_SHA_TOPLF_BYCANLAYER shade fraction of indirect light absorbed by the top leaf layer of each canopy layer fraction F -FABI_SUN_CNLF sun fraction of indirect light absorbed by each canopy and leaf layer fraction F -FABI_SUN_CNLFPFT sun fraction of indirect light absorbed by each canopy, leaf, and PFT fraction F -FABI_SUN_TOPLF_BYCANLAYER sun fraction of indirect light absorbed by the top leaf layer of each canopy layer fraction F -FATES_HR heterotrophic respiration gC/m^2/s T +FATES_ABOVEGROUND_MORT_SZPF Aboveground flux of carbon from AGB to necromass due to mortality kg m-2 s-1 F +FATES_ABOVEGROUND_PROD_SZPF Aboveground carbon productivity kg m-2 s-1 F +FATES_AGSAPMAINTAR_SZPF above-ground sapwood maintenance autotrophic respiration in kg carbon per m2 per second by pft kg m-2 s-1 F +FATES_AGSAPWOOD_ALLOC_SZPF allocation to above-ground sapwood by pft/size in kg carbon per m2 per second kg m-2 s-1 F +FATES_AGSTRUCT_ALLOC_SZPF allocation to above-ground structural (deadwood) by pft/size in kg carbon per m2 per second kg m-2 s-1 F +FATES_AR autotrophic respiration gC/m^2/s T +FATES_AREA_PLANTS area occupied by all plants per m2 land area m2 m-2 T +FATES_AREA_TREES area occupied by woody plants per m2 land area m2 m-2 T +FATES_AR_CANOPY autotrophic respiration of canopy plants gC/m^2/s T +FATES_AR_UNDERSTORY autotrophic respiration of understory plants gC/m^2/s T +FATES_AUTORESP autotrophic respiration in kg carbon per m2 per second kg m-2 s-1 T +FATES_AUTORESP_CANOPY autotrophic respiration of canopy plants in kg carbon per m2 per second kg m-2 s-1 T +FATES_AUTORESP_CANOPY_SZPF autotrophic respiration of canopy plants by pft/size in kg carbon per m2 per second kg m-2 s-1 F +FATES_AUTORESP_SECONDARY autotrophic respiration in kg carbon per m2 per second, secondary patches kg m-2 s-1 T +FATES_AUTORESP_SZPF total autotrophic respiration in kg carbon per m2 per second by pft/size kg m-2 s-1 F +FATES_AUTORESP_USTORY autotrophic respiration of understory plants in kg carbon per m2 per second kg m-2 s-1 T +FATES_AUTORESP_USTORY_SZPF autotrophic respiration of understory plants by pft/size in kg carbon per m2 per second kg m-2 s-1 F +FATES_BASALAREA_SZ basal area by size class m2 m-2 T +FATES_BASALAREA_SZPF basal area by pft/size m2 m-2 F +FATES_BA_WEIGHTED_HEIGHT basal area-weighted mean height of woody plants m T +FATES_BGSAPMAINTAR_SZPF below-ground sapwood maintenance autotrophic respiration in kg carbon per m2 per second by pft kg m-2 s-1 F +FATES_BGSAPWOOD_ALLOC_SZPF allocation to below-ground sapwood by pft/size in kg carbon per m2 per second kg m-2 s-1 F +FATES_BGSTRUCT_ALLOC_SZPF allocation to below-ground structural (deadwood) by pft/size in kg carbon per m2 per second kg m-2 s-1 F +FATES_BURNFRAC burned area fraction per second s-1 T +FATES_BURNFRAC_AP spitfire fraction area burnt (per second) by patch age s-1 T +FATES_C13DISC_SZPF C13 discrimination by pft/size per mil F +FATES_CANOPYAREA_AP canopy area by age bin per m2 land area m2 m-2 T +FATES_CANOPYAREA_HT canopy area height distribution m2 m-2 T +FATES_CANOPYCROWNAREA_PF total PFT-level canopy-layer crown area per m2 land area m2 m-2 T +FATES_CANOPY_SPREAD scaling factor (0-1) between tree basal area and canopy area T +FATES_CANOPY_VEGC biomass of canopy plants in kg carbon per m2 land area kg m-2 T +FATES_CA_WEIGHTED_HEIGHT crown area-weighted mean height of canopy plants m T +FATES_CBALANCE_ERROR total carbon error in kg carbon per second kg s-1 T +FATES_COLD_STATUS site-level cold status, 0=not cold-dec, 1=too cold for leaves, 2=not too cold T +FATES_CROOTMAINTAR live coarse root maintenance autotrophic respiration in kg carbon per m2 per second kg m-2 s-1 T +FATES_CROOTMAINTAR_CANOPY_SZ live coarse root maintenance autotrophic respiration for canopy plants in kg carbon per m2 per kg m-2 s-1 F +FATES_CROOTMAINTAR_USTORY_SZ live coarse root maintenance autotrophic respiration for understory plants in kg carbon per m2 kg m-2 s-1 F +FATES_CROOT_ALLOC allocation to coarse roots in kg carbon per m2 per second kg m-2 s-1 T +FATES_CROWNAREA_CANOPY_SZ total crown area of canopy plants by size class m2 m-2 F +FATES_CROWNAREA_CL total crown area in each canopy layer m2 m-2 T +FATES_CROWNAREA_CLLL total crown area that is occupied by leaves in each canopy and leaf layer m2 m-2 F +FATES_CROWNAREA_PF total PFT-level crown area per m2 land area m2 m-2 T +FATES_CROWNAREA_USTORY_SZ total crown area of understory plants by size class m2 m-2 F +FATES_CWD_ABOVEGROUND_DC debris class-level aboveground coarse woody debris stocks in kg carbon per m2 kg m-2 F +FATES_CWD_ABOVEGROUND_IN_DC debris class-level aboveground coarse woody debris input in kg carbon per m2 per second kg m-2 s-1 F +FATES_CWD_ABOVEGROUND_OUT_DC debris class-level aboveground coarse woody debris output in kg carbon per m2 per second kg m-2 s-1 F +FATES_CWD_BELOWGROUND_DC debris class-level belowground coarse woody debris stocks in kg carbon per m2 kg m-2 F +FATES_CWD_BELOWGROUND_IN_DC debris class-level belowground coarse woody debris input in kg carbon per m2 per second kg m-2 s-1 F +FATES_CWD_BELOWGROUND_OUT_DC debris class-level belowground coarse woody debris output in kg carbon per m2 per second kg m-2 s-1 F +FATES_DAYSINCE_COLDLEAFOFF site-level days elapsed since cold leaf drop days T +FATES_DAYSINCE_COLDLEAFON site-level days elapsed since cold leaf flush days T +FATES_DAYSINCE_DROUGHTLEAFOFF_PF PFT-level days elapsed since drought leaf drop days T +FATES_DAYSINCE_DROUGHTLEAFON_PF PFT-level days elapsed since drought leaf flush days T +FATES_DDBH_CANOPY_SZ diameter growth increment by size of canopy plants m m-2 yr-1 T +FATES_DDBH_CANOPY_SZAP growth rate of canopy plants in meters DBH per m2 per year in canopy in each size x age class m m-2 yr-1 F +FATES_DDBH_CANOPY_SZPF diameter growth increment by pft/size m m-2 yr-1 F +FATES_DDBH_SZPF diameter growth increment by pft/size m m-2 yr-1 F +FATES_DDBH_USTORY_SZ diameter growth increment by size of understory plants m m-2 yr-1 T +FATES_DDBH_USTORY_SZAP growth rate of understory plants in meters DBH per m2 per year in each size x age class m m-2 yr-1 F +FATES_DDBH_USTORY_SZPF diameter growth increment by pft/size m m-2 yr-1 F +FATES_DEMOTION_CARBONFLUX demotion-associated biomass carbon flux from canopy to understory in kg carbon per m2 per seco kg m-2 s-1 T +FATES_DEMOTION_RATE_SZ demotion rate from canopy to understory by size class in number of plants per m2 per year m-2 yr-1 F +FATES_DISTURBANCE_RATE_FIRE disturbance rate from fire m2 m-2 yr-1 T +FATES_DISTURBANCE_RATE_LOGGING disturbance rate from logging m2 m-2 yr-1 T +FATES_DISTURBANCE_RATE_P2P disturbance rate from primary to primary lands m2 m-2 yr-1 T +FATES_DISTURBANCE_RATE_P2S disturbance rate from primary to secondary lands m2 m-2 yr-1 T +FATES_DISTURBANCE_RATE_POTENTIAL potential (i.e., including unresolved) disturbance rate m2 m-2 yr-1 T +FATES_DISTURBANCE_RATE_S2S disturbance rate from secondary to secondary lands m2 m-2 yr-1 T +FATES_DISTURBANCE_RATE_TREEFALL disturbance rate from treefall m2 m-2 yr-1 T +FATES_DROUGHT_STATUS_PF PFT-level drought status, <2 too dry for leaves, >=2 not too dry T +FATES_EFFECT_WSPEED effective wind speed for fire spread in meters per second m s-1 T +FATES_ELONG_FACTOR_PF PFT-level mean elongation factor (partial flushing/abscission) 1 T +FATES_ERROR_EL total mass-balance error in kg per second by element kg s-1 T +FATES_EXCESS_RESP respiration of un-allocatable carbon gain kg m-2 s-1 T +FATES_FABD_SHA_CLLL shade fraction of direct light absorbed by each canopy and leaf layer 1 F +FATES_FABD_SHA_CLLLPF shade fraction of direct light absorbed by each canopy, leaf, and PFT 1 F +FATES_FABD_SHA_TOPLF_CL shade fraction of direct light absorbed by the top leaf layer of each canopy layer 1 F +FATES_FABD_SUN_CLLL sun fraction of direct light absorbed by each canopy and leaf layer 1 F +FATES_FABD_SUN_CLLLPF sun fraction of direct light absorbed by each canopy, leaf, and PFT 1 F +FATES_FABD_SUN_TOPLF_CL sun fraction of direct light absorbed by the top leaf layer of each canopy layer 1 F +FATES_FABI_SHA_CLLL shade fraction of indirect light absorbed by each canopy and leaf layer 1 F +FATES_FABI_SHA_CLLLPF shade fraction of indirect light absorbed by each canopy, leaf, and PFT 1 F +FATES_FABI_SHA_TOPLF_CL shade fraction of indirect light absorbed by the top leaf layer of each canopy layer 1 F +FATES_FABI_SUN_CLLL sun fraction of indirect light absorbed by each canopy and leaf layer 1 F +FATES_FABI_SUN_CLLLPF sun fraction of indirect light absorbed by each canopy, leaf, and PFT 1 F +FATES_FABI_SUN_TOPLF_CL sun fraction of indirect light absorbed by the top leaf layer of each canopy layer 1 F +FATES_FDI Fire Danger Index (probability that an ignition will lead to a fire) 1 T +FATES_FIRE_CLOSS carbon loss to atmosphere from fire in kg carbon per m2 per second kg m-2 s-1 T +FATES_FIRE_FLUX_EL loss to atmosphere from fire by element in kg element per m2 per s kg m-2 s-1 T +FATES_FIRE_INTENSITY spitfire surface fireline intensity in J per m per second J m-1 s-1 T +FATES_FIRE_INTENSITY_BURNFRAC product of surface fire intensity and burned area fraction -- divide by FATES_BURNFRAC to get J m-1 s-1 T +FATES_FIRE_INTENSITY_BURNFRAC_AP product of fire intensity and burned fraction, resolved by patch age (so divide by FATES_BURNF J m-1 s-1 T +FATES_FRACTION total gridcell fraction which FATES is running over m2 m-2 T +FATES_FRAGMENTATION_SCALER_SL factor (0-1) by which litter/cwd fragmentation proceeds relative to max rate by soil layer T +FATES_FROOTC total biomass in live plant fine roots in kg carbon per m2 kg m-2 T +FATES_FROOTCTURN_CANOPY_SZ fine root turnover (non-mortal) for canopy plants by size class in kg carbon per m2 per second kg m-2 s-1 F +FATES_FROOTCTURN_USTORY_SZ fine root turnover (non-mortal) for understory plants by size class in kg carbon per m2 per se kg m-2 s-1 F +FATES_FROOTC_SL Total carbon in live plant fine-roots over depth kg m-3 T +FATES_FROOTC_SZPF fine-root carbon mass by size-class x pft in kg carbon per m2 kg m-2 F +FATES_FROOTMAINTAR fine root maintenance autotrophic respiration in kg carbon per m2 per second kg m-2 s-1 T +FATES_FROOTMAINTAR_CANOPY_SZ live coarse root maintenance autotrophic respiration for canopy plants in kg carbon per m2 per kg m-2 s-1 F +FATES_FROOTMAINTAR_SZPF fine root maintenance autotrophic respiration in kg carbon per m2 per second by pft/size kg m-2 s-1 F +FATES_FROOTMAINTAR_USTORY_SZ fine root maintenance autotrophic respiration for understory plants in kg carbon per m2 per se kg m-2 s-1 F +FATES_FROOT_ALLOC allocation to fine roots in kg carbon per m2 per second kg m-2 s-1 T +FATES_FROOT_ALLOC_CANOPY_SZ allocation to fine root C for canopy plants by size class in kg carbon per m2 per second kg m-2 s-1 F +FATES_FROOT_ALLOC_SZPF allocation to fine roots by pft/size in kg carbon per m2 per second kg m-2 s-1 F +FATES_FROOT_ALLOC_USTORY_SZ allocation to fine roots for understory plants by size class in kg carbon per m2 per second kg m-2 s-1 F +FATES_FUELCONSUMED total fuel consumed in kg carbon per m2 land area kg m-2 T +FATES_FUEL_AMOUNT total ground fuel related to FATES_ROS (omits 1000hr fuels) in kg C per m2 land area kg m-2 T +FATES_FUEL_AMOUNT_AP spitfire ground fuel (kg carbon per m2) related to FATES_ROS (omits 1000hr fuels) within each kg m-2 T +FATES_FUEL_AMOUNT_APFC spitfire fuel quantity in each age x fuel class in kg carbon per m2 land area kg m-2 F +FATES_FUEL_AMOUNT_FC spitfire fuel-class level fuel amount in kg carbon per m2 land area kg m-2 T +FATES_FUEL_BULKD fuel bulk density in kg per m3 kg m-3 T +FATES_FUEL_BURNT_BURNFRAC_FC product of fraction (0-1) of fuel burnt and burnt fraction (divide by FATES_BURNFRAC to get bu 1 T +FATES_FUEL_EFF_MOIST spitfire fuel moisture (volumetric) m3 m-3 T +FATES_FUEL_MEF fuel moisture of extinction (volumetric) m3 m-3 T +FATES_FUEL_MOISTURE_FC spitfire fuel class-level fuel moisture (volumetric) m3 m-3 T +FATES_FUEL_SAV spitfire fuel surface area to volume ratio m-1 T +FATES_GDD site-level growing degree days degree_Celsius T +FATES_GPP gross primary production in kg carbon per m2 per second kg m-2 s-1 T +FATES_GPP_AP gross primary productivity by age bin in kg carbon per m2 per second kg m-2 s-1 F +FATES_GPP_CANOPY gross primary production of canopy plants in kg carbon per m2 per second kg m-2 s-1 T +FATES_GPP_CANOPY_SZPF gross primary production of canopy plants by pft/size in kg carbon per m2 per second kg m-2 s-1 F +FATES_GPP_PF total PFT-level GPP in kg carbon per m2 land area per second kg m-2 s-1 T +FATES_GPP_SECONDARY gross primary production in kg carbon per m2 per second, secondary patches kg m-2 s-1 T +FATES_GPP_SE_PF total PFT-level GPP in kg carbon per m2 land area per second, secondary patches kg m-2 s-1 T +FATES_GPP_SZPF gross primary production by pft/size in kg carbon per m2 per second kg m-2 s-1 F +FATES_GPP_USTORY gross primary production of understory plants in kg carbon per m2 per second kg m-2 s-1 T +FATES_GPP_USTORY_SZPF gross primary production of understory plants by pft/size in kg carbon per m2 per second kg m-2 s-1 F +FATES_GROWAR_CANOPY_SZ growth autotrophic respiration of canopy plants in kg carbon per m2 per second by size kg m-2 s-1 F +FATES_GROWAR_SZPF growth autotrophic respiration in kg carbon per m2 per second by pft/size kg m-2 s-1 F +FATES_GROWAR_USTORY_SZ growth autotrophic respiration of understory plants in kg carbon per m2 per second by size kg m-2 s-1 F +FATES_GROWTHFLUX_FUSION_SZPF flux of individuals into a given size class bin via fusion m-2 yr-1 F +FATES_GROWTHFLUX_SZPF flux of individuals into a given size class bin via growth and recruitment m-2 yr-1 F +FATES_GROWTH_RESP growth respiration in kg carbon per m2 per second kg m-2 s-1 T +FATES_GROWTH_RESP_SECONDARY growth respiration in kg carbon per m2 per second, secondary patches kg m-2 s-1 T +FATES_HARVEST_CARBON_FLUX harvest carbon flux in kg carbon per m2 per year kg m-2 yr-1 T +FATES_HARVEST_DEBT Accumulated carbon failed to be harvested kg C T +FATES_HARVEST_DEBT_SEC Accumulated carbon failed to be harvested from secondary patches kg C T +FATES_HET_RESP heterotrophic respiration in kg carbon per m2 per second kg m-2 s-1 T +FATES_IGNITIONS number of successful fire ignitions per m2 land area per second m-2 s-1 T +FATES_LAI leaf area index per m2 land area m2 m-2 T +FATES_LAISHA_TOP_CL LAI in the shade by the top leaf layer of each canopy layer m2 m-2 F +FATES_LAISHA_Z_CLLL LAI in the shade by each canopy and leaf layer m2 m-2 F +FATES_LAISHA_Z_CLLLPF LAI in the shade by each canopy, leaf, and PFT m2 m-2 F +FATES_LAISUN_TOP_CL LAI in the sun by the top leaf layer of each canopy layer m2 m-2 F +FATES_LAISUN_Z_CLLL LAI in the sun by each canopy and leaf layer m2 m-2 F +FATES_LAISUN_Z_CLLLPF LAI in the sun by each canopy, leaf, and PFT m2 m-2 F +FATES_LAI_AP leaf area index by age bin per m2 land area m2 m-2 T +FATES_LAI_CANOPY_SZ leaf area index (LAI) of canopy plants by size class m2 m-2 T +FATES_LAI_CANOPY_SZPF Leaf area index (LAI) of canopy plants by pft/size m2 m-2 F +FATES_LAI_SECONDARY leaf area index per m2 land area, secondary patches m2 m-2 T +FATES_LAI_USTORY_SZ leaf area index (LAI) of understory plants by size class m2 m-2 T +FATES_LAI_USTORY_SZPF Leaf area index (LAI) of understory plants by pft/size m2 m-2 F +FATES_LBLAYER_COND mean leaf boundary layer conductance mol m-2 s-1 T +FATES_LBLAYER_COND_AP mean leaf boundary layer conductance - by patch age mol m-2 s-1 F +FATES_LEAFAREA_HT leaf area height distribution m2 m-2 T +FATES_LEAFC total biomass in live plant leaves in kg carbon per m2 kg m-2 T +FATES_LEAFCTURN_CANOPY_SZ leaf turnover (non-mortal) for canopy plants by size class in kg carbon per m2 per second kg m-2 s-1 F +FATES_LEAFCTURN_USTORY_SZ leaf turnover (non-mortal) for understory plants by size class in kg carbon per m2 per second kg m-2 s-1 F +FATES_LEAFC_CANOPY_SZPF biomass in leaves of canopy plants by pft/size in kg carbon per m2 kg m-2 F +FATES_LEAFC_PF total PFT-level leaf biomass in kg carbon per m2 land area kg m-2 T +FATES_LEAFC_SZPF leaf carbon mass by size-class x pft in kg carbon per m2 kg m-2 F +FATES_LEAFC_USTORY_SZPF biomass in leaves of understory plants by pft/size in kg carbon per m2 kg m-2 F +FATES_LEAFMAINTAR leaf maintenance autotrophic respiration in kg carbon per m2 per second kg m-2 s-1 T +FATES_LEAF_ALLOC allocation to leaves in kg carbon per m2 per second kg m-2 s-1 T +FATES_LEAF_ALLOC_CANOPY_SZ allocation to leaves for canopy plants by size class in kg carbon per m2 per second kg m-2 s-1 F +FATES_LEAF_ALLOC_SZPF allocation to leaves by pft/size in kg carbon per m2 per second kg m-2 s-1 F +FATES_LEAF_ALLOC_USTORY_SZ allocation to leaves for understory plants by size class in kg carbon per m2 per second kg m-2 s-1 F +FATES_LITTER_AG_CWD_EL mass of aboveground litter in coarse woody debris (trunks/branches/twigs) by element kg m-2 T +FATES_LITTER_AG_FINE_EL mass of aboveground litter in fines (leaves, nonviable seed) by element kg m-2 T +FATES_LITTER_BG_CWD_EL mass of belowground litter in coarse woody debris (coarse roots) by element kg m-2 T +FATES_LITTER_BG_FINE_EL mass of belowground litter in fines (fineroots) by element kg m-2 T +FATES_LITTER_CWD_ELDC total mass of litter in coarse woody debris by element and coarse woody debris size kg m-2 T +FATES_LITTER_IN litter flux in kg carbon per m2 per second kg m-2 s-1 T +FATES_LITTER_IN_EL litter flux in in kg element per m2 per second kg m-2 s-1 T +FATES_LITTER_OUT litter flux out in kg carbon (exudation, fragmentation, seed decay) kg m-2 s-1 T +FATES_LITTER_OUT_EL litter flux out (exudation, fragmentation and seed decay) in kg element kg m-2 s-1 T +FATES_LSTEMMAINTAR live stem maintenance autotrophic respiration in kg carbon per m2 per second kg m-2 s-1 T +FATES_LSTEMMAINTAR_CANOPY_SZ live stem maintenance autotrophic respiration for canopy plants in kg carbon per m2 per second kg m-2 s-1 F +FATES_LSTEMMAINTAR_USTORY_SZ live stem maintenance autotrophic respiration for understory plants in kg carbon per m2 per se kg m-2 s-1 F +FATES_M3_MORTALITY_CANOPY_SZ C starvation mortality of canopy plants by size N/ha/yr F +FATES_M3_MORTALITY_CANOPY_SZPF C starvation mortality of canopy plants by pft/size N/ha/yr F +FATES_M3_MORTALITY_USTORY_SZ C starvation mortality of understory plants by size N/ha/yr F +FATES_M3_MORTALITY_USTORY_SZPF C starvation mortality of understory plants by pft/size N/ha/yr F +FATES_MAINTAR_CANOPY_SZ maintenance autotrophic respiration of canopy plants in kg carbon per m2 per second by size kg m-2 s-1 F +FATES_MAINTAR_SZPF maintenance autotrophic respiration in kg carbon per m2 per second by pft/size kg m-2 s-1 F +FATES_MAINTAR_USTORY_SZ maintenance autotrophic respiration of understory plants in kg carbon per m2 per second by siz kg m-2 s-1 F +FATES_MAINT_RESP maintenance respiration in kg carbon per m2 land area per second, secondary patches kg m-2 s-1 T +FATES_MAINT_RESP_SECONDARY maintenance respiration in kg carbon per m2 land area per second kg m-2 s-1 T +FATES_MAINT_RESP_UNREDUCED diagnostic maintenance respiration if the low-carbon-storage reduction is ignored kg m-2 s-1 F +FATES_MEANLIQVOL_DROUGHTPHEN_PF PFT-level mean liquid water volume for drought phenolgy m3 m-3 T +FATES_MEANSMP_DROUGHTPHEN_PF PFT-level mean soil matric potential for drought phenology Pa T +FATES_MORTALITY_AGESCEN_AC age senescence mortality by cohort age in number of plants per m2 per year m-2 yr-1 T +FATES_MORTALITY_AGESCEN_ACPF age senescence mortality by pft/cohort age in number of plants per m2 per year m-2 yr-1 F +FATES_MORTALITY_AGESCEN_SE_SZ age senescence mortality by size in number of plants per m2 per year, secondary patches m-2 yr-1 T +FATES_MORTALITY_AGESCEN_SZ age senescence mortality by size in number of plants per m2 per year m-2 yr-1 T +FATES_MORTALITY_AGESCEN_SZPF age senescence mortality by pft/size in number of plants per m2 per year m-2 yr-1 F +FATES_MORTALITY_BACKGROUND_SE_SZ background mortality by size in number of plants per m2 per year, secondary patches m-2 yr-1 T +FATES_MORTALITY_BACKGROUND_SZ background mortality by size in number of plants per m2 per year m-2 yr-1 T +FATES_MORTALITY_BACKGROUND_SZPF background mortality by pft/size in number of plants per m2 per year m-2 yr-1 F +FATES_MORTALITY_CAMBIALBURN_SZPF fire mortality from cambial burn by pft/size in number of plants per m2 per year m-2 yr-1 F +FATES_MORTALITY_CANOPY_SE_SZ total mortality of canopy trees by size class in number of plants per m2, secondary patches m-2 yr-1 T +FATES_MORTALITY_CANOPY_SZ total mortality of canopy trees by size class in number of plants per m2 m-2 yr-1 T +FATES_MORTALITY_CANOPY_SZAP mortality rate of canopy plants in number of plants per m2 per year in each size x age class m-2 yr-1 F +FATES_MORTALITY_CANOPY_SZPF total mortality of canopy plants by pft/size in number of plants per m2 per year m-2 yr-1 F +FATES_MORTALITY_CFLUX_CANOPY flux of biomass carbon from live to dead pools from mortality of canopy plants in kg carbon pe kg m-2 s-1 T +FATES_MORTALITY_CFLUX_PF PFT-level flux of biomass carbon from live to dead pool from mortality kg m-2 s-1 T +FATES_MORTALITY_CFLUX_USTORY flux of biomass carbon from live to dead pools from mortality of understory plants in kg carbo kg m-2 s-1 T +FATES_MORTALITY_CROWNSCORCH_SZPF fire mortality from crown scorch by pft/size in number of plants per m2 per year m-2 yr-1 F +FATES_MORTALITY_CSTARV_CFLUX_PF PFT-level flux of biomass carbon from live to dead pool from carbon starvation mortality kg m-2 s-1 T +FATES_MORTALITY_CSTARV_SE_SZ carbon starvation mortality by size in number of plants per m2 per year, secondary patches m-2 yr-1 T +FATES_MORTALITY_CSTARV_SZ carbon starvation mortality by size in number of plants per m2 per year m-2 yr-1 T +FATES_MORTALITY_CSTARV_SZPF carbon starvation mortality by pft/size in number of plants per m2 per year m-2 yr-1 F +FATES_MORTALITY_FIRE_CFLUX_PF PFT-level flux of biomass carbon from live to dead pool from fire mortality kg m-2 s-1 T +FATES_MORTALITY_FIRE_SZ fire mortality by size in number of plants per m2 per year m-2 yr-1 T +FATES_MORTALITY_FIRE_SZPF fire mortality by pft/size in number of plants per m2 per year m-2 yr-1 F +FATES_MORTALITY_FREEZING_SE_SZ freezing mortality by size in number of plants per m2 per event, secondary patches m-2 event-1 T +FATES_MORTALITY_FREEZING_SZ freezing mortality by size in number of plants per m2 per year m-2 yr-1 T +FATES_MORTALITY_FREEZING_SZPF freezing mortality by pft/size in number of plants per m2 per year m-2 yr-1 F +FATES_MORTALITY_HYDRAULIC_SE_SZ hydraulic mortality by size in number of plants per m2 per year, secondary patches m-2 yr-1 T +FATES_MORTALITY_HYDRAULIC_SZ hydraulic mortality by size in number of plants per m2 per year m-2 yr-1 T +FATES_MORTALITY_HYDRAULIC_SZPF hydraulic mortality by pft/size in number of plants per m2 per year m-2 yr-1 F +FATES_MORTALITY_HYDRO_CFLUX_PF PFT-level flux of biomass carbon from live to dead pool from hydraulic failure mortality kg m-2 s-1 T +FATES_MORTALITY_IMPACT_SZ impact mortality by size in number of plants per m2 per year m-2 yr-1 T +FATES_MORTALITY_IMPACT_SZPF impact mortality by pft/size in number of plants per m2 per year m-2 yr-1 F +FATES_MORTALITY_LOGGING_SE_SZ logging mortality by size in number of plants per m2 per event, secondary patches m-2 yr-1 T +FATES_MORTALITY_LOGGING_SZ logging mortality by size in number of plants per m2 per year m-2 yr-1 T +FATES_MORTALITY_LOGGING_SZPF logging mortality by pft/size in number of plants per m2 per year m-2 yr-1 F +FATES_MORTALITY_PF PFT-level mortality rate in number of individuals per m2 land area per year m-2 yr-1 T +FATES_MORTALITY_SENESCENCE_SE_SZ senescence mortality by size in number of plants per m2 per event, secondary patches m-2 yr-1 T +FATES_MORTALITY_SENESCENCE_SZ senescence mortality by size in number of plants per m2 per year m-2 yr-1 T +FATES_MORTALITY_SENESCENCE_SZPF senescence mortality by pft/size in number of plants per m2 per year m-2 yr-1 F +FATES_MORTALITY_TERMINATION_SZ termination mortality by size in number of plants per m2 per year m-2 yr-1 T +FATES_MORTALITY_TERMINATION_SZPF termination mortality by pft/size in number pf plants per m2 per year m-2 yr-1 F +FATES_MORTALITY_USTORY_SZ total mortality of understory trees by size class in individuals per m2 per year m-2 yr-1 T +FATES_MORTALITY_USTORY_SZAP mortality rate of understory plants in number of plants per m2 per year in each size x age cla m-2 yr-1 F +FATES_MORTALITY_USTORY_SZPF total mortality of understory plants by pft/size in number of plants per m2 per year m-2 yr-1 F +FATES_NCHILLDAYS site-level number of chill days days T +FATES_NCL_AP number of canopy levels by age bin F +FATES_NCOHORTS total number of cohorts per site T +FATES_NCOHORTS_SECONDARY total number of cohorts per site T +FATES_NCOLDDAYS site-level number of cold days days T +FATES_NEP net ecosystem production in kg carbon per m2 per second kg m-2 s-1 T +FATES_NESTEROV_INDEX nesterov fire danger index T +FATES_NET_C_UPTAKE_CLLL net carbon uptake in kg carbon per m2 per second by each canopy and leaf layer per unit ground kg m-2 s-1 F +FATES_NONSTRUCTC non-structural biomass (sapwood + leaf + fineroot) in kg carbon per m2 kg m-2 T +FATES_NPATCHES total number of patches per site T +FATES_NPATCHES_SECONDARY total number of patches per site T +FATES_NPATCH_AP number of patches by age bin F +FATES_NPLANT_AC number of plants per m2 by cohort age class m-2 T +FATES_NPLANT_ACPF stem number density by pft and age class m-2 F +FATES_NPLANT_CANOPY_SZ number of canopy plants per m2 by size class m-2 T +FATES_NPLANT_CANOPY_SZAP number of plants per m2 in canopy in each size x age class m-2 F +FATES_NPLANT_CANOPY_SZPF number of canopy plants by size/pft per m2 m-2 F +FATES_NPLANT_PF total PFT-level number of individuals per m2 land area m-2 T +FATES_NPLANT_SEC_PF total PFT-level number of individuals per m2 land area, secondary patches m-2 T +FATES_NPLANT_SZ number of plants per m2 by size class m-2 T +FATES_NPLANT_SZAP number of plants per m2 in each size x age class m-2 F +FATES_NPLANT_SZAPPF number of plants per m2 in each size x age x pft class m-2 F +FATES_NPLANT_SZPF stem number density by pft/size m-2 F +FATES_NPLANT_USTORY_SZ number of understory plants per m2 by size class m-2 T +FATES_NPLANT_USTORY_SZAP number of plants per m2 in understory in each size x age class m-2 F +FATES_NPLANT_USTORY_SZPF density of understory plants by pft/size in number of plants per m2 m-2 F +FATES_NPP net primary production in kg carbon per m2 per second kg m-2 s-1 T +FATES_NPP_AP net primary productivity by age bin in kg carbon per m2 per second kg m-2 s-1 F +FATES_NPP_APPF NPP per PFT in each age bin in kg carbon per m2 per second kg m-2 s-1 F +FATES_NPP_CANOPY_SZ NPP of canopy plants by size class in kg carbon per m2 per second kg m-2 s-1 F +FATES_NPP_PF total PFT-level NPP in kg carbon per m2 land area per second kg m-2 yr-1 T +FATES_NPP_SECONDARY net primary production in kg carbon per m2 per second, secondary patches kg m-2 s-1 T +FATES_NPP_SE_PF total PFT-level NPP in kg carbon per m2 land area per second, secondary patches kg m-2 yr-1 T +FATES_NPP_SZPF total net primary production by pft/size in kg carbon per m2 per second kg m-2 s-1 F +FATES_NPP_USTORY_SZ NPP of understory plants by size class in kg carbon per m2 per second kg m-2 s-1 F +FATES_PARPROF_DIF_CLLL radiative profile of diffuse PAR through each canopy and leaf layer (averaged across PFTs) W m-2 F +FATES_PARPROF_DIF_CLLLPF radiative profile of diffuse PAR through each canopy, leaf, and PFT W m-2 F +FATES_PARPROF_DIR_CLLL radiative profile of direct PAR through each canopy and leaf layer (averaged across PFTs) W m-2 F +FATES_PARPROF_DIR_CLLLPF radiative profile of direct PAR through each canopy, leaf, and PFT W m-2 F +FATES_PARSHA_Z_CL PAR absorbed in the shade by top leaf layer in each canopy layer W m-2 F +FATES_PARSHA_Z_CLLL PAR absorbed in the shade by each canopy and leaf layer W m-2 F +FATES_PARSHA_Z_CLLLPF PAR absorbed in the shade by each canopy, leaf, and PFT W m-2 F +FATES_PARSUN_Z_CL PAR absorbed in the sun by top leaf layer in each canopy layer W m-2 F +FATES_PARSUN_Z_CLLL PAR absorbed in the sun by each canopy and leaf layer W m-2 F +FATES_PARSUN_Z_CLLLPF PAR absorbed in the sun by each canopy, leaf, and PFT W m-2 F +FATES_PATCHAREA_AP patch area by age bin per m2 land area m2 m-2 T +FATES_PRIMARY_PATCHFUSION_ERR error in total primary lands associated with patch fusion m2 m-2 yr-1 T +FATES_PROMOTION_CARBONFLUX promotion-associated biomass carbon flux from understory to canopy in kg carbon per m2 per sec kg m-2 s-1 T +FATES_PROMOTION_RATE_SZ promotion rate from understory to canopy by size class m-2 yr-1 F +FATES_RAD_ERROR radiation error in FATES RTM W m-2 T +FATES_RDARK_CANOPY_SZ dark respiration for canopy plants in kg carbon per m2 per second by size kg m-2 s-1 F +FATES_RDARK_SZPF dark portion of maintenance autotrophic respiration in kg carbon per m2 per second by pft/size kg m-2 s-1 F +FATES_RDARK_USTORY_SZ dark respiration for understory plants in kg carbon per m2 per second by size kg m-2 s-1 F +FATES_RECRUITMENT_PF PFT-level recruitment rate in number of individuals per m2 land area per year m-2 yr-1 T +FATES_REPROC total biomass in live plant reproductive tissues in kg carbon per m2 kg m-2 T +FATES_REPROC_SZPF reproductive carbon mass (on plant) by size-class x pft in kg carbon per m2 kg m-2 F +FATES_ROS fire rate of spread in meters per second m s-1 T +FATES_SAI_CANOPY_SZ stem area index (SAI) of canopy plants by size class m2 m-2 F +FATES_SAI_USTORY_SZ stem area index (SAI) of understory plants by size class m2 m-2 F +FATES_SAPWOODC total biomass in live plant sapwood in kg carbon per m2 kg m-2 T +FATES_SAPWOODCTURN_CANOPY_SZ sapwood turnover (non-mortal) for canopy plants by size class in kg carbon per m2 per second kg m-2 s-1 F +FATES_SAPWOODCTURN_USTORY_SZ sapwood C turnover (non-mortal) for understory plants by size class in kg carbon per m2 per se kg m-2 s-1 F +FATES_SAPWOODC_SZPF sapwood carbon mass by size-class x pft in kg carbon per m2 kg m-2 F +FATES_SAPWOOD_ALLOC_CANOPY_SZ allocation to sapwood C for canopy plants by size class in kg carbon per m2 per second kg m-2 s-1 F +FATES_SAPWOOD_ALLOC_USTORY_SZ allocation to sapwood C for understory plants by size class in kg carbon per m2 per second kg m-2 s-1 F +FATES_SCORCH_HEIGHT_APPF SPITFIRE flame Scorch Height (calculated per PFT in each patch age bin) m F +FATES_SECONDAREA_ANTHRODIST_AP secondary forest patch area age distribution since anthropgenic disturbance m2 m-2 F +FATES_SECONDAREA_DIST_AP secondary forest patch area age distribution since any kind of disturbance m2 m-2 F +FATES_SECONDARY_FOREST_FRACTION secondary forest fraction m2 m-2 T +FATES_SECONDARY_FOREST_VEGC biomass on secondary lands in kg carbon per m2 land area (mult by FATES_SECONDARY_FOREST_FRACT kg m-2 T +FATES_SEEDS_IN seed production rate in kg carbon per m2 second kg m-2 s-1 T +FATES_SEEDS_IN_EXTERN_EL external seed influx rate in kg element per m2 per second kg m-2 s-1 T +FATES_SEEDS_IN_LOCAL_EL within-site, element-level seed production rate in kg element per m2 per second kg m-2 s-1 T +FATES_SEED_ALLOC allocation to seeds in kg carbon per m2 per second kg m-2 s-1 T +FATES_SEED_ALLOC_CANOPY_SZ allocation to reproductive C for canopy plants by size class in kg carbon per m2 per second kg m-2 s-1 F +FATES_SEED_ALLOC_SZPF allocation to seeds by pft/size in kg carbon per m2 per second kg m-2 s-1 F +FATES_SEED_ALLOC_USTORY_SZ allocation to reproductive C for understory plants by size class in kg carbon per m2 per secon kg m-2 s-1 F +FATES_SEED_BANK total seed mass of all PFTs in kg carbon per m2 land area kg m-2 T +FATES_SEED_BANK_EL element-level total seed mass of all PFTs in kg element per m2 kg m-2 T +FATES_SEED_DECAY_EL seed mass decay (germinated and un-germinated) in kg element per m2 per second kg m-2 s-1 T +FATES_SEED_GERM_EL element-level total germinated seed mass of all PFTs in kg element per m2 kg m-2 T +FATES_SEED_PROD_CANOPY_SZ seed production of canopy plants by size class in kg carbon per m2 per second kg m-2 s-1 F +FATES_SEED_PROD_USTORY_SZ seed production of understory plants by size class in kg carbon per m2 per second kg m-2 s-1 F +FATES_STEM_ALLOC allocation to stem in kg carbon per m2 per second kg m-2 s-1 T +FATES_STOMATAL_COND mean stomatal conductance mol m-2 s-1 T +FATES_STOMATAL_COND_AP mean stomatal conductance - by patch age mol m-2 s-1 F +FATES_STOREC total biomass in live plant storage in kg carbon per m2 land area kg m-2 T +FATES_STORECTURN_CANOPY_SZ storage turnover (non-mortal) for canopy plants by size class in kg carbon per m2 per second kg m-2 s-1 F +FATES_STORECTURN_USTORY_SZ storage C turnover (non-mortal) for understory plants by size class in kg carbon per m2 per se kg m-2 s-1 F +FATES_STOREC_CANOPY_SZPF biomass in storage pools of canopy plants by pft/size in kg carbon per m2 kg m-2 F +FATES_STOREC_PF total PFT-level stored biomass in kg carbon per m2 land area kg m-2 T +FATES_STOREC_SZPF storage carbon mass by size-class x pft in kg carbon per m2 kg m-2 F +FATES_STOREC_TF Storage C fraction of target kg kg-1 T +FATES_STOREC_TF_CANOPY_SZPF Storage C fraction of target by size x pft, in the canopy kg kg-1 F +FATES_STOREC_TF_USTORY_SZPF Storage C fraction of target by size x pft, in the understory kg kg-1 F +FATES_STOREC_USTORY_SZPF biomass in storage pools of understory plants by pft/size in kg carbon per m2 kg m-2 F +FATES_STORE_ALLOC allocation to storage tissues in kg carbon per m2 per second kg m-2 s-1 T +FATES_STORE_ALLOC_CANOPY_SZ allocation to storage C for canopy plants by size class in kg carbon per m2 per second kg m-2 s-1 F +FATES_STORE_ALLOC_SZPF allocation to storage C by pft/size in kg carbon per m2 per second kg m-2 s-1 F +FATES_STORE_ALLOC_USTORY_SZ allocation to storage C for understory plants by size class in kg carbon per m2 per second kg m-2 s-1 F +FATES_STRUCTC structural biomass in kg carbon per m2 land area kg m-2 T +FATES_STRUCTCTURN_CANOPY_SZ structural C turnover (non-mortal) for canopy plants by size class in kg carbon per m2 per sec kg m-2 s-1 F +FATES_STRUCTCTURN_USTORY_SZ structural C turnover (non-mortal) for understory plants by size class in kg carbon per m2 per kg m-2 s-1 F +FATES_STRUCT_ALLOC_CANOPY_SZ allocation to structural C for canopy plants by size class in kg carbon per m2 per second kg m-2 s-1 F +FATES_STRUCT_ALLOC_USTORY_SZ allocation to structural C for understory plants by size class in kg carbon per m2 per second kg m-2 s-1 F +FATES_TGROWTH fates long-term running mean vegetation temperature by site degree_Celsius F +FATES_TLONGTERM fates 30-year running mean vegetation temperature by site degree_Celsius F +FATES_TRIMMING degree to which canopy expansion is limited by leaf economics (0-1) 1 T +FATES_TRIMMING_CANOPY_SZ trimming term of canopy plants weighted by plant density, by size class m-2 F +FATES_TRIMMING_USTORY_SZ trimming term of understory plants weighted by plant density, by size class m-2 F +FATES_TVEG fates instantaneous mean vegetation temperature by site degree_Celsius T +FATES_TVEG24 fates 24-hr running mean vegetation temperature by site degree_Celsius T +FATES_USTORY_VEGC biomass of understory plants in kg carbon per m2 land area kg m-2 T +FATES_VEGC total biomass in live plants in kg carbon per m2 land area kg m-2 T +FATES_VEGC_ABOVEGROUND aboveground biomass in kg carbon per m2 land area kg m-2 T +FATES_VEGC_ABOVEGROUND_SZ aboveground biomass by size class in kg carbon per m2 kg m-2 T +FATES_VEGC_ABOVEGROUND_SZPF aboveground biomass by pft/size in kg carbon per m2 kg m-2 F +FATES_VEGC_AP total biomass within a given patch age bin in kg carbon per m2 land area kg m-2 F +FATES_VEGC_APPF biomass per PFT in each age bin in kg carbon per m2 kg m-2 F +FATES_VEGC_PF total PFT-level biomass in kg of carbon per land area kg m-2 T +FATES_VEGC_SE_PF total PFT-level biomass in kg of carbon per land area, secondary patches kg m-2 T +FATES_VEGC_SZ total biomass by size class in kg carbon per m2 kg m-2 F +FATES_VEGC_SZPF total vegetation biomass in live plants by size-class x pft in kg carbon per m2 kg m-2 F +FATES_WOOD_PRODUCT total wood product from logging in kg carbon per m2 land area kg m-2 T +FATES_YESTCANLEV_CANOPY_SZ yesterdays canopy level for canopy plants by size class in number of plants per m2 m-2 F +FATES_YESTCANLEV_USTORY_SZ yesterdays canopy level for understory plants by size class in number of plants per m2 m-2 F +FATES_ZSTAR_AP product of zstar and patch area by age bin (divide by FATES_PATCHAREA_AP to get mean zstar) m F FATES_c_to_litr_cel_c litter celluluse carbon flux from FATES to BGC gC/m^3/s T FATES_c_to_litr_lab_c litter labile carbon flux from FATES to BGC gC/m^3/s T FATES_c_to_litr_lig_c litter lignin carbon flux from FATES to BGC gC/m^3/s T @@ -236,33 +506,13 @@ FIRA_ICE net infrared (longwave) radiation (ice landu FIRA_R Rural net infrared (longwave) radiation W/m^2 T FIRA_U Urban net infrared (longwave) radiation W/m^2 F FIRE emitted infrared (longwave) radiation W/m^2 T -FIRE_AREA spitfire fire area burn fraction fraction/day T -FIRE_FDI probability that an ignition will lead to a fire none T -FIRE_FLUX ED-spitfire loss to atmosphere of elements g/m^2/s T -FIRE_FUEL_BULKD spitfire fuel bulk density kg biomass/m3 T -FIRE_FUEL_EFF_MOIST spitfire fuel moisture m T -FIRE_FUEL_MEF spitfire fuel moisture m T -FIRE_FUEL_SAV spitfire fuel surface/volume per m T FIRE_ICE emitted infrared (longwave) radiation (ice landunits only) W/m^2 F -FIRE_IGNITIONS number of successful ignitions number/km2/day T -FIRE_INTENSITY spitfire fire intensity: kJ/m/s kJ/m/s T -FIRE_INTENSITY_AREA_PRODUCT spitfire product of fire intensity and burned area (divide by FIRE_AREA to get area-weighted m kJ/m/s T -FIRE_INTENSITY_BY_PATCH_AGE product of fire intensity and burned area, resolved by patch age (so divide by AREA_BURNT_BY_P kJ/m/2 T -FIRE_NESTEROV_INDEX nesterov_fire_danger index none T FIRE_R Rural emitted infrared (longwave) radiation W/m^2 T -FIRE_ROS fire rate of spread m/min m/min T -FIRE_ROS_AREA_PRODUCT product of fire rate of spread (m/min) and burned area (fraction)--divide by FIRE_AREA to get m/min T -FIRE_TFC_ROS total fuel consumed kgC/m2 T -FIRE_TFC_ROS_AREA_PRODUCT product of total fuel consumed and burned area--divide by FIRE_AREA to get burned-area-weighte kgC/m2 T FIRE_U Urban emitted infrared (longwave) radiation W/m^2 F FLDS atmospheric longwave radiation (downscaled to columns in glacier regions) W/m^2 T FLDS_ICE atmospheric longwave radiation (downscaled to columns in glacier regions) (ice landunits only) W/m^2 F -FNRTC Total carbon in live plant fine-roots kgC ha-1 T -FNRTC_SCPF fine-root carbon mass by size-class x pft kgC/ha F -FRAGMENTATION_SCALER_SL factor by which litter/cwd fragmentation proceeds relative to max rate by soil layer unitless (0-1) T -FROOT_MR fine root maintenance respiration) kg C / m2 / yr T -FROOT_MR_CANOPY_SCLS FROOT_MR for canopy plants by size class kg C / ha / yr F -FROOT_MR_UNDERSTORY_SCLS FROOT_MR for understory plants by size class kg C / ha / yr F +FMAX_DENIT_CARBONSUBSTRATE FMAX_DENIT_CARBONSUBSTRATE gN/m^3/s F +FMAX_DENIT_NITRATE FMAX_DENIT_NITRATE gN/m^3/s F FROST_TABLE frost table depth (natural vegetated and crop landunits only) m F FSA absorbed solar radiation W/m^2 T FSAT fractional area with water table at surface unitless T @@ -308,21 +558,15 @@ FSR_ICE reflected solar radiation (ice landunits onl FSUN sunlit fraction of canopy proportion F FSUN24 fraction sunlit (last 24hrs) K F FSUN240 fraction sunlit (last 240hrs) K F -FUEL_AMOUNT_AGEFUEL spitfire fuel quantity in each age x fuel class kg C / m2 T -FUEL_AMOUNT_BY_NFSC spitfire size-resolved fuel quantity kg C / m2 T -FUEL_MOISTURE_NFSC spitfire size-resolved fuel moisture - T -Fire_Closs ED/SPitfire Carbon loss to atmosphere gC/m^2/s T -GPP gross primary production gC/m^2/s T -GPP_BY_AGE gross primary productivity by age bin gC/m^2/s F -GPP_CANOPY gross primary production of canopy plants gC/m^2/s T -GPP_CANOPY_SCPF gross primary production of canopy plants by pft/size kgC/m2/yr F -GPP_SCPF gross primary production by pft/size kgC/m2/yr F -GPP_UNDERSTORY gross primary production of understory plants gC/m^2/s T -GPP_UNDERSTORY_SCPF gross primary production of understory plants by pft/size kgC/m2/yr F +F_DENIT denitrification flux gN/m^2/s T +F_DENIT_BASE F_DENIT_BASE gN/m^3/s F +F_DENIT_vr denitrification flux gN/m^3/s F +F_N2O_DENIT denitrification N2O flux gN/m^2/s T +F_N2O_NIT nitrification N2O flux gN/m^2/s T +F_NIT nitrification flux gN/m^2/s T +F_NIT_vr nitrification flux gN/m^3/s F GROSS_NMIN gross rate of N mineralization gN/m^2/s T -GROWTHFLUX_FUSION_SCPF flux of individuals into a given size class bin via fusion n/yr/ha F -GROWTHFLUX_SCPF flux of individuals into a given size class bin via growth and recruitment n/yr/ha F -GROWTH_RESP growth respiration gC/m^2/s T +GROSS_NMIN_vr gross rate of N mineralization gN/m^3/s F GSSHA shaded leaf stomatal conductance umol H20/m2/s T GSSHALN shaded leaf stomatal conductance at local noon umol H20/m2/s T GSSUN sunlit leaf stomatal conductance umol H20/m2/s T @@ -333,7 +577,6 @@ H2OSNO snow depth (liquid water) H2OSNO_ICE snow depth (liquid water, ice landunits only) mm F H2OSNO_TOP mass of snow in top snow layer kg/m2 T H2OSOI volumetric soil water (natural vegetated and crop landunits only) mm3/mm3 T -HARVEST_CARBON_FLUX Harvest carbon flux kg C m-2 d-1 T HBOT canopy bottom m F HEAT_CONTENT1 initial gridcell total heat content J/m^2 T HEAT_CONTENT1_VEG initial gridcell total heat content - natural vegetated and crop landunits only J/m^2 F @@ -361,29 +604,24 @@ K_ACT_SOM active soil organic potential loss coefficie K_CEL_LIT cellulosic litter potential loss coefficient 1/s F K_LIG_LIT lignin litter potential loss coefficient 1/s F K_MET_LIT metabolic litter potential loss coefficient 1/s F +K_NITR K_NITR 1/s F +K_NITR_H2O K_NITR_H2O unitless F +K_NITR_PH K_NITR_PH unitless F +K_NITR_T K_NITR_T unitless F K_PAS_SOM passive soil organic potential loss coefficient 1/s F K_SLO_SOM slow soil organic ma potential loss coefficient 1/s F +L1_PATHFRAC_S1_vr PATHFRAC from metabolic litter to active soil organic fraction F +L1_RESP_FRAC_S1_vr respired from metabolic litter to active soil organic fraction F +L2_PATHFRAC_S1_vr PATHFRAC from cellulosic litter to active soil organic fraction F +L2_RESP_FRAC_S1_vr respired from cellulosic litter to active soil organic fraction F +L3_PATHFRAC_S2_vr PATHFRAC from lignin litter to slow soil organic ma fraction F +L3_RESP_FRAC_S2_vr respired from lignin litter to slow soil organic ma fraction F LAI240 240hr average of leaf area index m^2/m^2 F LAISHA shaded projected leaf area index m^2/m^2 T -LAISHA_TOP_CAN LAI in the shade by the top leaf layer of each canopy layer m2/m2 F -LAISHA_Z_CNLF LAI in the shade by each canopy and leaf layer m2/m2 F -LAISHA_Z_CNLFPFT LAI in the shade by each canopy, leaf, and PFT m2/m2 F LAISUN sunlit projected leaf area index m^2/m^2 T -LAISUN_TOP_CAN LAI in the sun by the top leaf layer of each canopy layer m2/m2 F -LAISUN_Z_CNLF LAI in the sun by each canopy and leaf layer m2/m2 F -LAISUN_Z_CNLFPFT LAI in the sun by each canopy, leaf, and PFT m2/m2 F -LAI_BY_AGE leaf area index by age bin m2/m2 T -LAI_CANOPY_SCLS Leaf are index (LAI) by size class m2/m2 T -LAI_UNDERSTORY_SCLS number of understory plants by size class indiv/ha T LAKEICEFRAC lake layer ice mass fraction unitless F LAKEICEFRAC_SURF surface lake layer ice mass fraction unitless T LAKEICETHICK thickness of lake ice (including physical expansion on freezing) m T -LEAFC Total carbon in live plant leaves kgC ha-1 T -LEAFC_SCPF leaf carbon mass by size-class x pft kgC/ha F -LEAF_HEIGHT_DIST leaf height distribution m2/m2 T -LEAF_MD_CANOPY_SCLS LEAF_MD for canopy plants by size class kg C / ha / yr F -LEAF_MD_UNDERSTORY_SCLS LEAF_MD for understory plants by size class kg C / ha / yr F -LEAF_MR RDARK (leaf maintenance respiration) kg C / m2 / yr T LIG_LITC LIG_LIT C gC/m^2 T LIG_LITC_1m LIG_LIT C to 1 meter gC/m^2 F LIG_LITC_TNDNCY_VERT_TRA lignin litter C tendency due to vertical transport gC/m^3/s F @@ -403,47 +641,9 @@ LIQUID_CONTENT1 initial gridcell total liq content LIQUID_CONTENT2 post landuse change gridcell total liq content mm F LIQUID_WATER_TEMP1 initial gridcell weighted average liquid water temperature K F LITTERC_HR litter C heterotrophic respiration gC/m^2/s T -LITTER_CWD total mass of litter in CWD kg ha-1 T -LITTER_CWD_AG_ELEM mass of above ground litter in CWD (trunks/branches/twigs) kg ha-1 T -LITTER_CWD_BG_ELEM mass of below ground litter in CWD (coarse roots) kg ha-1 T -LITTER_FINES_AG_ELEM mass of above ground litter in fines (leaves,nonviable seed) kg ha-1 T -LITTER_FINES_BG_ELEM mass of below ground litter in fines (fineroots) kg ha-1 T -LITTER_IN FATES litter flux in gC m-2 s-1 T -LITTER_IN_ELEM FATES litter flux in kg ha-1 d-1 T -LITTER_OUT FATES litter flux out gC m-2 s-1 T -LITTER_OUT_ELEM FATES litter flux out (fragmentation only) kg ha-1 d-1 T -LIVECROOT_MR live coarse root maintenance respiration) kg C / m2 / yr T -LIVECROOT_MR_CANOPY_SCLS LIVECROOT_MR for canopy plants by size class kg C / ha / yr F -LIVECROOT_MR_UNDERSTORY_SCLS LIVECROOT_MR for understory plants by size class kg C / ha / yr F -LIVESTEM_MR live stem maintenance respiration) kg C / m2 / yr T -LIVESTEM_MR_CANOPY_SCLS LIVESTEM_MR for canopy plants by size class kg C / ha / yr F -LIVESTEM_MR_UNDERSTORY_SCLS LIVESTEM_MR for understory plants by size class kg C / ha / yr F LNC leaf N concentration gN leaf/m^2 T LWdown atmospheric longwave radiation (downscaled to columns in glacier regions) W/m^2 F LWup upwelling longwave radiation W/m^2 F -M10_CACLS age senescence mortality by cohort age N/ha/yr T -M10_CAPF age senescence mortality by pft/cohort age N/ha/yr F -M10_SCLS age senescence mortality by size N/ha/yr T -M10_SCPF age senescence mortality by pft/size N/ha/yr F -M1_SCLS background mortality by size N/ha/yr T -M1_SCPF background mortality by pft/size N/ha/yr F -M2_SCLS hydraulic mortality by size N/ha/yr T -M2_SCPF hydraulic mortality by pft/size N/ha/yr F -M3_SCLS carbon starvation mortality by size N/ha/yr T -M3_SCPF carbon starvation mortality by pft/size N/ha/yr F -M4_SCLS impact mortality by size N/ha/yr T -M4_SCPF impact mortality by pft/size N/ha/yr F -M5_SCLS fire mortality by size N/ha/yr T -M5_SCPF fire mortality by pft/size N/ha/yr F -M6_SCLS termination mortality by size N/ha/yr T -M6_SCPF termination mortality by pft/size N/ha/yr F -M7_SCLS logging mortality by size N/ha/event T -M7_SCPF logging mortality by pft/size N/ha/event F -M8_SCLS freezing mortality by size N/ha/event T -M8_SCPF freezing mortality by pft/size N/ha/yr F -M9_SCLS senescence mortality by size N/ha/yr T -M9_SCPF senescence mortality by pft/size N/ha/yr F -MAINT_RESP maintenance respiration gC/m^2/s T MET_LITC MET_LIT C gC/m^2 T MET_LITC_1m MET_LIT C to 1 meter gC/m^2 F MET_LITC_TNDNCY_VERT_TRA metabolic litter C tendency due to vertical transport gC/m^3/s F @@ -458,15 +658,8 @@ MET_LITN_TO_ACT_SOMN_vr decomp. of metabolic litter N to active soil MET_LITN_vr MET_LIT N (vertically resolved) gN/m^3 T MET_LIT_HR Het. Resp. from metabolic litter gC/m^2/s F MET_LIT_HR_vr Het. Resp. from metabolic litter gC/m^3/s F -MORTALITY Rate of total mortality by PFT indiv/ha/yr T -MORTALITY_CANOPY_SCAG mortality rate of canopy plants in each size x age class plants/ha/yr F -MORTALITY_CANOPY_SCLS total mortality of canopy trees by size class indiv/ha/yr T -MORTALITY_CANOPY_SCPF total mortality of canopy plants by pft/size N/ha/yr F -MORTALITY_CARBONFLUX_CANOPY flux of biomass carbon from live to dead pools from mortality of canopy plants gC/m2/s T -MORTALITY_CARBONFLUX_UNDERSTORY flux of biomass carbon from live to dead pools from mortality of understory plants gC/m2/s T -MORTALITY_UNDERSTORY_SCAG mortality rate of understory plantsin each size x age class plants/ha/yr F -MORTALITY_UNDERSTORY_SCLS total mortality of understory trees by size class indiv/ha/yr T -MORTALITY_UNDERSTORY_SCPF total mortality of understory plants by pft/size N/ha/yr F +MORTALITY_CROWNAREA_CANOPY Crown area of canopy trees that died m2/ha/year T +MORTALITY_CROWNAREA_UNDERSTORY Crown aera of understory trees that died m2/ha/year T M_ACT_SOMC_TO_LEACHING active soil organic C leaching loss gC/m^2/s F M_ACT_SOMN_TO_LEACHING active soil organic N leaching loss gN/m^2/s F M_CEL_LITC_TO_LEACHING cellulosic litter C leaching loss gC/m^2/s F @@ -479,71 +672,16 @@ M_PAS_SOMC_TO_LEACHING passive soil organic C leaching loss M_PAS_SOMN_TO_LEACHING passive soil organic N leaching loss gN/m^2/s F M_SLO_SOMC_TO_LEACHING slow soil organic ma C leaching loss gC/m^2/s F M_SLO_SOMN_TO_LEACHING slow soil organic ma N leaching loss gN/m^2/s F -NCL_BY_AGE number of canopy levels by age bin -- F NDEP_TO_SMINN atmospheric N deposition to soil mineral N gN/m^2/s T NEM Gridcell net adjustment to net carbon exchange passed to atm. for methane production gC/m2/s T -NEP net ecosystem production gC/m^2/s T -NET_C_UPTAKE_CNLF net carbon uptake by each canopy and leaf layer per unit ground area (i.e. divide by CROWNAREA gC/m2/s F NET_NMIN net rate of N mineralization gN/m^2/s T +NET_NMIN_vr net rate of N mineralization gN/m^3/s F NFIX_TO_SMINN symbiotic/asymbiotic N fixation to soil mineral N gN/m^2/s T -NPATCH_BY_AGE number of patches by age bin -- F -NPLANT_CACLS number of plants by coage class indiv/ha T -NPLANT_CANOPY_SCAG number of plants per hectare in canopy in each size x age class plants/ha F -NPLANT_CANOPY_SCLS number of canopy plants by size class indiv/ha T -NPLANT_CANOPY_SCPF stem number of canopy plants density by pft/size N/ha F -NPLANT_CAPF stem number density by pft/coage N/ha F -NPLANT_SCAG number of plants per hectare in each size x age class plants/ha T -NPLANT_SCAGPFT number of plants per hectare in each size x age x pft class plants/ha F -NPLANT_SCLS number of plants by size class indiv/ha T -NPLANT_SCPF stem number density by pft/size N/ha F -NPLANT_UNDERSTORY_SCAG number of plants per hectare in understory in each size x age class plants/ha F -NPLANT_UNDERSTORY_SCLS number of understory plants by size class indiv/ha T -NPLANT_UNDERSTORY_SCPF stem number of understory plants density by pft/size N/ha F -NPP net primary production gC/m^2/s T -NPP_AGDW_SCPF NPP flux into above-ground deadwood by pft/size kgC/m2/yr F -NPP_AGEPFT NPP per PFT in each age bin kgC/m2/yr F -NPP_AGSW_SCPF NPP flux into above-ground sapwood by pft/size kgC/m2/yr F -NPP_BDEAD_CANOPY_SCLS NPP_BDEAD for canopy plants by size class kg C / ha / yr F -NPP_BDEAD_UNDERSTORY_SCLS NPP_BDEAD for understory plants by size class kg C / ha / yr F -NPP_BGDW_SCPF NPP flux into below-ground deadwood by pft/size kgC/m2/yr F -NPP_BGSW_SCPF NPP flux into below-ground sapwood by pft/size kgC/m2/yr F -NPP_BSEED_CANOPY_SCLS NPP_BSEED for canopy plants by size class kg C / ha / yr F -NPP_BSEED_UNDERSTORY_SCLS NPP_BSEED for understory plants by size class kg C / ha / yr F -NPP_BSW_CANOPY_SCLS NPP_BSW for canopy plants by size class kg C / ha / yr F -NPP_BSW_UNDERSTORY_SCLS NPP_BSW for understory plants by size class kg C / ha / yr F -NPP_BY_AGE net primary productivity by age bin gC/m^2/s F -NPP_CROOT NPP flux into coarse roots kgC/m2/yr T -NPP_FNRT_SCPF NPP flux into fine roots by pft/size kgC/m2/yr F -NPP_FROOT NPP flux into fine roots kgC/m2/yr T -NPP_FROOT_CANOPY_SCLS NPP_FROOT for canopy plants by size class kg C / ha / yr F -NPP_FROOT_UNDERSTORY_SCLS NPP_FROOT for understory plants by size class kg C / ha / yr F -NPP_LEAF NPP flux into leaves kgC/m2/yr T -NPP_LEAF_CANOPY_SCLS NPP_LEAF for canopy plants by size class kg C / ha / yr F -NPP_LEAF_SCPF NPP flux into leaves by pft/size kgC/m2/yr F -NPP_LEAF_UNDERSTORY_SCLS NPP_LEAF for understory plants by size class kg C / ha / yr F -NPP_SCPF total net primary production by pft/size kgC/m2/yr F -NPP_SEED NPP flux into seeds kgC/m2/yr T -NPP_SEED_SCPF NPP flux into seeds by pft/size kgC/m2/yr F -NPP_STEM NPP flux into stem kgC/m2/yr T -NPP_STOR NPP flux into storage tissues kgC/m2/yr T -NPP_STORE_CANOPY_SCLS NPP_STORE for canopy plants by size class kg C / ha / yr F -NPP_STORE_UNDERSTORY_SCLS NPP_STORE for understory plants by size class kg C / ha / yr F -NPP_STOR_SCPF NPP flux into storage by pft/size kgC/m2/yr F NSUBSTEPS number of adaptive timesteps in CLM timestep unitless F O2_DECOMP_DEPTH_UNSAT O2 consumption from HR and AR for non-inundated area mol/m3/s F OBU Monin-Obukhov length m F OCDEP total OC deposition (dry+wet) from atmosphere kg/m^2/s T O_SCALAR fraction by which decomposition is reduced due to anoxia unitless T -PARPROF_DIF_CNLF Radiative profile of diffuse PAR through each canopy and leaf layer (averaged across PFTs) W/m2 F -PARPROF_DIF_CNLFPFT Radiative profile of diffuse PAR through each canopy, leaf, and PFT W/m2 F -PARPROF_DIR_CNLF Radiative profile of direct PAR through each canopy and leaf layer (averaged across PFTs) W/m2 F -PARPROF_DIR_CNLFPFT Radiative profile of direct PAR through each canopy, leaf, and PFT W/m2 F -PARSHA_Z_CAN PAR absorbed in the shade by top leaf layer in each canopy layer W/m2 F -PARSHA_Z_CNLF PAR absorbed in the shade by each canopy and leaf layer W/m2 F -PARSHA_Z_CNLFPFT PAR absorbed in the shade by each canopy, leaf, and PFT W/m2 F -PARSUN_Z_CAN PAR absorbed in the sun by top leaf layer in each canopy layer W/m2 F -PARSUN_Z_CNLF PAR absorbed in the sun by each canopy and leaf layer W/m2 F -PARSUN_Z_CNLFPFT PAR absorbed in the sun by each canopy, leaf, and PFT W/m2 F PARVEGLN absorbed par by vegetation at local noon W/m^2 T PAS_SOMC PAS_SOM C gC/m^2 T PAS_SOMC_1m PAS_SOM C to 1 meter gC/m^2 F @@ -559,22 +697,15 @@ PAS_SOMN_TO_ACT_SOMN_vr decomp. of passive soil organic N to active PAS_SOMN_vr PAS_SOM N (vertically resolved) gN/m^3 T PAS_SOM_HR Het. Resp. from passive soil organic gC/m^2/s F PAS_SOM_HR_vr Het. Resp. from passive soil organic gC/m^3/s F -PATCH_AREA_BY_AGE patch area by age bin m2/m2 T PBOT atmospheric pressure at surface (downscaled to columns in glacier regions) Pa T PCH4 atmospheric partial pressure of CH4 Pa T PCO2 atmospheric partial pressure of CO2 Pa T -PFTbiomass total PFT level biomass gC/m2 T -PFTcanopycrownarea total PFT-level canopy-layer crown area m2/m2 F -PFTcrownarea total PFT level crown area m2/m2 F -PFTgpp total PFT-level GPP kg C m-2 y-1 T -PFTleafbiomass total PFT level leaf biomass gC/m2 T -PFTnindivs total PFT level number of individuals indiv / m2 T -PFTnpp total PFT-level NPP kg C m-2 y-1 T -PFTstorebiomass total PFT level stored biomass gC/m2 T POTENTIAL_IMMOB potential N immobilization gN/m^2/s T -PRIMARYLAND_PATCHFUSION_ERROR Error in total primary lands associated with patch fusion m2 m-2 d-1 T -PROMOTION_CARBONFLUX promotion-associated biomass carbon flux from understory to canopy gC/m2/s T -PROMOTION_RATE_SCLS promotion rate from understory to canopy by size class indiv/ha/yr F +POTENTIAL_IMMOB_vr potential N immobilization gN/m^3/s F +POT_F_DENIT potential denitrification flux gN/m^2/s T +POT_F_DENIT_vr potential denitrification flux gN/m^3/s F +POT_F_NIT potential nitrification flux gN/m^2/s T +POT_F_NIT_vr potential nitrification flux gN/m^3/s F PSurf atmospheric pressure at surface (downscaled to columns in glacier regions) Pa F Q2M 2m specific humidity kg/kg T QAF canopy air humidity kg/kg F @@ -656,59 +787,30 @@ RAM_LAKE aerodynamic resistance for momentum (lakes o RAW1 aerodynamical resistance s/m F RAW2 aerodynamical resistance s/m F RB leaf boundary resistance s/m F -RDARK_CANOPY_SCLS RDARK for canopy plants by size class kg C / ha / yr F -RDARK_UNDERSTORY_SCLS RDARK for understory plants by size class kg C / ha / yr F -RECRUITMENT Rate of recruitment by PFT indiv/ha/yr T -REPROC Total carbon in live plant reproductive tissues kgC ha-1 T -REPROC_SCPF reproductive carbon mass (on plant) by size-class x pft kgC/ha F -RESP_G_CANOPY_SCLS RESP_G for canopy plants by size class kg C / ha / yr F -RESP_G_UNDERSTORY_SCLS RESP_G for understory plants by size class kg C / ha / yr F -RESP_M_CANOPY_SCLS RESP_M for canopy plants by size class kg C / ha / yr F -RESP_M_UNDERSTORY_SCLS RESP_M for understory plants by size class kg C / ha / yr F RH atmospheric relative humidity % F RH2M 2m relative humidity % T RH2M_R Rural 2m specific humidity % F RH2M_U Urban 2m relative humidity % F RHAF fractional humidity of canopy air fraction F RH_LEAF fractional humidity at leaf surface fraction F -ROOT_MD_CANOPY_SCLS ROOT_MD for canopy plants by size class kg C / ha / yr F -ROOT_MD_UNDERSTORY_SCLS ROOT_MD for understory plants by size class kg C / ha / yr F RSCANOPY canopy resistance s m-1 T RSSHA shaded leaf stomatal resistance s/m T RSSUN sunlit leaf stomatal resistance s/m T Rainf atmospheric rain, after rain/snow repartitioning based on temperature mm/s F Rnet net radiation W/m^2 F +S1_PATHFRAC_S2_vr PATHFRAC from active soil organic to slow soil organic ma fraction F +S1_PATHFRAC_S3_vr PATHFRAC from active soil organic to passive soil organic fraction F +S1_RESP_FRAC_S2_vr respired from active soil organic to slow soil organic ma fraction F +S1_RESP_FRAC_S3_vr respired from active soil organic to passive soil organic fraction F +S2_PATHFRAC_S1_vr PATHFRAC from slow soil organic ma to active soil organic fraction F +S2_PATHFRAC_S3_vr PATHFRAC from slow soil organic ma to passive soil organic fraction F +S2_RESP_FRAC_S1_vr respired from slow soil organic ma to active soil organic fraction F +S2_RESP_FRAC_S3_vr respired from slow soil organic ma to passive soil organic fraction F +S3_PATHFRAC_S1_vr PATHFRAC from passive soil organic to active soil organic fraction F +S3_RESP_FRAC_S1_vr respired from passive soil organic to active soil organic fraction F SABG solar rad absorbed by ground W/m^2 T SABG_PEN Rural solar rad penetrating top soil or snow layer watt/m^2 T SABV solar rad absorbed by veg W/m^2 T -SAI_CANOPY_SCLS stem area index(SAI) by size class m2/m2 F -SAI_UNDERSTORY_SCLS number of understory plants by size class indiv/ha F -SAPWC Total carbon in live plant sapwood kgC ha-1 T -SAPWC_SCPF sapwood carbon mass by size-class x pft kgC/ha F -SCORCH_HEIGHT SPITFIRE Flame Scorch Height (calculated per PFT in each patch age bin) m T -SECONDARY_AREA_AGE_ANTHRO_DIST Secondary forest patch area age distribution since anthropgenic disturbance m2/m2 F -SECONDARY_AREA_PATCH_AGE_DIST Secondary forest patch area age distribution since any kind of disturbance m2/m2 F -SECONDARY_FOREST_BIOMASS Biomass on secondary lands (per total site area, mult by SECONDARY_FOREST_FRACTION to get per kgC/m2 F -SECONDARY_FOREST_FRACTION Secondary forest fraction m2/m2 F -SEEDS_IN Seed Production Rate gC m-2 s-1 T -SEEDS_IN_EXTERN_ELEM External Seed Influx Rate kg ha-1 d-1 T -SEEDS_IN_LOCAL_ELEM Within Site Seed Production Rate kg ha-1 d-1 T -SEED_BANK Total Seed Mass of all PFTs gC m-2 T -SEED_BANK_ELEM Total Seed Mass of all PFTs kg ha-1 T -SEED_DECAY_ELEM Seed mass decay (germinated and un-germinated) kg ha-1 d-1 T -SEED_GERM_ELEM Seed mass converted into new cohorts kg ha-1 d-1 T -SEED_PROD_CANOPY_SCLS SEED_PROD for canopy plants by size class kg C / ha / yr F -SEED_PROD_UNDERSTORY_SCLS SEED_PROD for understory plants by size class kg C / ha / yr F -SITE_COLD_STATUS Site level cold status, 0=not cold-dec, 1=too cold for leaves, 2=not-too cold 0,1,2 T -SITE_DAYSINCE_COLDLEAFOFF site level days elapsed since cold leaf drop days T -SITE_DAYSINCE_COLDLEAFON site level days elapsed since cold leaf flush days T -SITE_DAYSINCE_DROUGHTLEAFOFF site level days elapsed since drought leaf drop days T -SITE_DAYSINCE_DROUGHTLEAFON site level days elapsed since drought leaf flush days T -SITE_DROUGHT_STATUS Site level drought status, <2 too dry for leaves, >=2 not-too dry 0,1,2,3 T -SITE_GDD site level growing degree days degC T -SITE_MEANLIQVOL_DROUGHTPHEN site level mean liquid water volume for drought phen m3/m3 T -SITE_NCHILLDAYS site level number of chill days days T -SITE_NCOLDDAYS site level number of cold days days T SLO_SOMC SLO_SOM C gC/m^2 T SLO_SOMC_1m SLO_SOM C to 1 meter gC/m^2 F SLO_SOMC_TNDNCY_VERT_TRA slow soil organic ma C tendency due to vertical transport gC/m^3/s F @@ -730,27 +832,8 @@ SLO_SOM_HR_S1_vr Het. Resp. from slow soil organic ma SLO_SOM_HR_S3 Het. Resp. from slow soil organic ma gC/m^2/s F SLO_SOM_HR_S3_vr Het. Resp. from slow soil organic ma gC/m^3/s F SMINN soil mineral N gN/m^2 T -SMINN_LEACHED soil mineral N pool loss to leaching gN/m^2/s T -SMINN_LEACHED_vr soil mineral N pool loss to leaching gN/m^3/s F -SMINN_TO_DENIT_EXCESS denitrification from excess mineral N pool gN/m^2/s F -SMINN_TO_DENIT_EXCESS_vr denitrification from excess mineral N pool gN/m^3/s F -SMINN_TO_DENIT_L1S1 denitrification for decomp. of metabolic litterto ACT_SOM gN/m^2 F -SMINN_TO_DENIT_L1S1_vr denitrification for decomp. of metabolic litterto ACT_SOM gN/m^3 F -SMINN_TO_DENIT_L2S1 denitrification for decomp. of cellulosic litterto ACT_SOM gN/m^2 F -SMINN_TO_DENIT_L2S1_vr denitrification for decomp. of cellulosic litterto ACT_SOM gN/m^3 F -SMINN_TO_DENIT_L3S2 denitrification for decomp. of lignin litterto SLO_SOM gN/m^2 F -SMINN_TO_DENIT_L3S2_vr denitrification for decomp. of lignin litterto SLO_SOM gN/m^3 F -SMINN_TO_DENIT_S1S2 denitrification for decomp. of active soil organicto SLO_SOM gN/m^2 F -SMINN_TO_DENIT_S1S2_vr denitrification for decomp. of active soil organicto SLO_SOM gN/m^3 F -SMINN_TO_DENIT_S1S3 denitrification for decomp. of active soil organicto PAS_SOM gN/m^2 F -SMINN_TO_DENIT_S1S3_vr denitrification for decomp. of active soil organicto PAS_SOM gN/m^3 F -SMINN_TO_DENIT_S2S1 denitrification for decomp. of slow soil organic mato ACT_SOM gN/m^2 F -SMINN_TO_DENIT_S2S1_vr denitrification for decomp. of slow soil organic mato ACT_SOM gN/m^3 F -SMINN_TO_DENIT_S2S3 denitrification for decomp. of slow soil organic mato PAS_SOM gN/m^2 F -SMINN_TO_DENIT_S2S3_vr denitrification for decomp. of slow soil organic mato PAS_SOM gN/m^3 F -SMINN_TO_DENIT_S3S1 denitrification for decomp. of passive soil organicto ACT_SOM gN/m^2 F -SMINN_TO_DENIT_S3S1_vr denitrification for decomp. of passive soil organicto ACT_SOM gN/m^3 F SMINN_TO_PLANT plant uptake of soil mineral N gN/m^2/s T +SMINN_TO_PLANT_vr plant uptake of soil mineral N gN/m^3/s F SMINN_TO_S1N_L1 mineral N flux for decomp. of MET_LITto ACT_SOM gN/m^2 F SMINN_TO_S1N_L1_vr mineral N flux for decomp. of MET_LITto ACT_SOM gN/m^3 F SMINN_TO_S1N_L2 mineral N flux for decomp. of CEL_LITto ACT_SOM gN/m^2 F @@ -768,6 +851,17 @@ SMINN_TO_S3N_S1_vr mineral N flux for decomp. of ACT_SOMto PAS_ SMINN_TO_S3N_S2 mineral N flux for decomp. of SLO_SOMto PAS_SOM gN/m^2 F SMINN_TO_S3N_S2_vr mineral N flux for decomp. of SLO_SOMto PAS_SOM gN/m^3 F SMINN_vr soil mineral N gN/m^3 T +SMIN_NH4 soil mineral NH4 gN/m^2 T +SMIN_NH4_TO_PLANT plant uptake of NH4 gN/m^3/s F +SMIN_NH4_vr soil mineral NH4 (vert. res.) gN/m^3 T +SMIN_NO3 soil mineral NO3 gN/m^2 T +SMIN_NO3_LEACHED soil NO3 pool loss to leaching gN/m^2/s T +SMIN_NO3_LEACHED_vr soil NO3 pool loss to leaching gN/m^3/s F +SMIN_NO3_MASSDENS SMIN_NO3_MASSDENS ugN/cm^3 soil F +SMIN_NO3_RUNOFF soil NO3 pool loss to runoff gN/m^2/s T +SMIN_NO3_RUNOFF_vr soil NO3 pool loss to runoff gN/m^3/s F +SMIN_NO3_TO_PLANT plant uptake of NO3 gN/m^3/s F +SMIN_NO3_vr soil mineral NO3 (vert. res.) gN/m^3 T SMP soil matric potential (natural vegetated and crop landunits only) mm T SNOBCMCL mass of BC in snow column kg/m2 T SNOBCMSL mass of BC in top snow layer kg/m2 T @@ -837,11 +931,8 @@ SOILWATER_10CM soil liquid water + ice in top 10cm of soil SOMC_FIRE C loss due to peat burning gC/m^2/s T SOM_C_LEACHED total flux of C from SOM pools due to leaching gC/m^2/s T SOM_N_LEACHED total flux of N from SOM pools due to leaching gN/m^2/s F -STOREC Total carbon in live plant storage kgC ha-1 T -STOREC_SCPF storage carbon mass by size-class x pft kgC/ha F -SUM_FUEL total ground fuel related to ros (omits 1000hr fuels) gC m-2 T -SUM_FUEL_BY_PATCH_AGE spitfire ground fuel related to ros (omits 1000hr fuels) within each patch age bin (divide by gC / m2 of site area T SUPPLEMENT_TO_SMINN supplemental N supply gN/m^2/s T +SUPPLEMENT_TO_SMINN_vr supplemental N supply gN/m^3/s F SWBGT 2 m Simplified Wetbulb Globe Temp C T SWBGT_R Rural 2 m Simplified Wetbulb Globe Temp C T SWBGT_U Urban 2 m Simplified Wetbulb Globe Temp C T @@ -880,8 +971,6 @@ TOTSOMC total soil organic matter carbon TOTSOMC_1m total soil organic matter carbon to 1 meter depth gC/m^2 T TOTSOMN total soil organic matter N gN/m^2 T TOTSOMN_1m total soil organic matter N to 1 meter gN/m^2 T -TOTVEGC Total carbon in live plants kgC ha-1 T -TOTVEGC_SCPF total vegetation carbon mass in live plants by size-class x pft kgC/ha F TRAFFICFLUX sensible heat flux from urban traffic W/m^2 F TREFMNAV daily minimum of average 2-m temperature K T TREFMNAV_R Rural daily minimum of average 2-m temperature K F @@ -889,9 +978,6 @@ TREFMNAV_U Urban daily minimum of average 2-m temperatu TREFMXAV daily maximum of average 2-m temperature K T TREFMXAV_R Rural daily maximum of average 2-m temperature K F TREFMXAV_U Urban daily maximum of average 2-m temperature K F -TRIMMING Degree to which canopy expansion is limited by leaf economics none T -TRIMMING_CANOPY_SCLS trimming term of canopy plants by size class indiv/ha F -TRIMMING_UNDERSTORY_SCLS trimming term of understory plants by size class indiv/ha F TROOF_INNER roof inside surface temperature K F TSA 2m air temperature K T TSAI total projected stem area index m^2/m^2 T @@ -923,6 +1009,7 @@ URBAN_HEAT urban heating flux USTAR aerodynamical resistance s/m F UST_LAKE friction velocity (lakes only) m/s F VA atmospheric wind speed plus convective velocity m/s F +VENTILATION sensible heat flux from building ventilation W/m^2 T VOLR river channel total water storage m3 T VOLRMCH river channel main channel water storage m3 T VPD vpd Pa F @@ -932,24 +1019,30 @@ WASTEHEAT sensible heat flux from heating/cooling sour WBT 2 m Stull Wet Bulb C T WBT_R Rural 2 m Stull Wet Bulb C T WBT_U Urban 2 m Stull Wet Bulb C T +WFPS WFPS percent F WIND atmospheric wind velocity magnitude m/s T -WOOD_PRODUCT Total wood product from logging gC/m2 F WTGQ surface tracer conductance m/s T W_SCALAR Moisture (dryness) inhibition of decomposition unitless T Wind atmospheric wind velocity magnitude m/s F -YESTERDAYCANLEV_CANOPY_SCLS Yesterdays canopy level for canopy plants by size class indiv/ha F -YESTERDAYCANLEV_UNDERSTORY_SCLS Yesterdays canopy level for understory plants by size class indiv/ha F -Z0HG roughness length over ground, sensible heat m F -Z0M momentum roughness length m F -Z0MG roughness length over ground, momentum m F +Z0HG roughness length over ground, sensible heat (vegetated landunits only) m F +Z0MG roughness length over ground, momentum (vegetated landunits only) m F +Z0MV_DENSE roughness length over vegetation, momentum, for dense canopy m F Z0M_TO_COUPLER roughness length, momentum: gridcell average sent to coupler m F -Z0QG roughness length over ground, latent heat m F +Z0QG roughness length over ground, latent heat (vegetated landunits only) m F ZBOT atmospheric reference height m T ZETA dimensionless stability parameter unitless F ZII convective boundary height m F -ZSTAR_BY_AGE product of zstar and patch area by age bin (divide by PATCH_AREA_BY_AGE to get mean zstar) m F ZWT water table depth (natural vegetated and crop landunits only) m T ZWT_CH4_UNSAT depth of water table for methane production used in non-inundated area m T ZWT_PERCH perched water table depth (natural vegetated and crop landunits only) m T +anaerobic_frac anaerobic_frac m3/m3 F +diffus diffusivity m^2/s F +fr_WFPS fr_WFPS fraction F +n2_n2o_ratio_denit n2_n2o_ratio_denit gN/gN F num_iter number of iterations unitless F -==== =================================== ============================================================================================== ================================================================= ======= +r_psi r_psi m F +ratio_k1 ratio_k1 none F +ratio_no3_co2 ratio_no3_co2 ratio F +soil_bulkdensity soil_bulkdensity kg/m3 F +soil_co2_prod soil_co2_prod ug C / g soil / day F +=================================== ============================================================================================== ================================================================= ======= diff --git a/doc/source/users_guide/setting-up-and-running-a-case/history_fields_nofates.rst b/doc/source/users_guide/setting-up-and-running-a-case/history_fields_nofates.rst index 3bdb33297d..1eb450b0b6 100644 --- a/doc/source/users_guide/setting-up-and-running-a-case/history_fields_nofates.rst +++ b/doc/source/users_guide/setting-up-and-running-a-case/history_fields_nofates.rst @@ -1,18 +1,18 @@ ============================= CTSM History Fields (nofates) ============================= - + CAUTION: Not all variables are relevant / present for all CTSM cases. Key flags used in this CTSM case: -use_cn = T -use_crop = T -use_fates = F - -==== =================================== ============================================================================================== ================================================================= ======= +use_cn = T +use_crop = T +use_fates = F + +=================================== ============================================================================================== ================================================================= ======= CTSM History Fields ------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------ - # Variable Name Long Description Units Active? -==== =================================== ============================================================================================== ================================================================= ======= +------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------ + Variable Name Long Description Units Active? +=================================== ============================================================================================== ================================================================= ======= A10TMIN 10-day running mean of min 2-m temperature K F A5TMIN 5-day running mean of min 2-m temperature K F ACTUAL_IMMOB actual N immobilization gN/m^2/s T @@ -42,12 +42,10 @@ ACT_SOM_HR_S3_vr Het. Resp. from active soil organic AGLB Aboveground leaf biomass kg/m^2 F AGNPP aboveground NPP gC/m^2/s T AGSB Aboveground stem biomass kg/m^2 F -ALBD surface albedo (direct) proportion T -ALBDSF diagnostic snow-free surface albedo (direct) proportion T +ALBD surface albedo (direct) proportion F ALBGRD ground albedo (direct) proportion F ALBGRI ground albedo (indirect) proportion F -ALBI surface albedo (indirect) proportion T -ALBISF diagnostic snow-free surface albedo (indirect) proportion T +ALBI surface albedo (indirect) proportion F ALPHA alpha coefficient for VOC calc non F ALT current active layer thickness m T ALTMAX maximum annual active layer thickness m T @@ -57,10 +55,8 @@ ANNMAX_RETRANSN annual max of retranslocated N pool ANNSUM_COUNTER seconds since last annual accumulator turnover s F ANNSUM_NPP annual sum of NPP gC/m^2/yr F ANNSUM_POTENTIAL_GPP annual sum of potential GPP gN/m^2/yr F -APPAR_TEMP 2 m apparent temperature C T -APPAR_TEMP_R Rural 2 m apparent temperature C T -APPAR_TEMP_U Urban 2 m apparent temperature C T AR autotrophic respiration (MR + GR) gC/m^2/s T +ATM_O3 atmospheric ozone partial pressure mol/mol F ATM_TOPO atmospheric surface height m T AVAILC C flux available for allocation gC/m^2/s F AVAIL_RETRANSN N flux available from retranslocation pool gN/m^2/s F @@ -152,7 +148,7 @@ CROP_SEEDN_TO_LEAF crop seed source to leaf CURRENT_GR growth resp for new growth displayed in this timestep gC/m^2/s F CWDC CWD C gC/m^2 T CWDC_1m CWD C to 1 meter gC/m^2 F -CWDC_HR cwd C heterotrophic respiration gC/m^2/s F +CWDC_HR cwd C heterotrophic respiration gC/m^2/s T CWDC_LOSS coarse woody debris C loss gC/m^2/s T CWDC_TO_CEL_LITC decomp. of coarse woody debris C to cellulosic litter C gC/m^2/s F CWDC_TO_CEL_LITC_vr decomp. of coarse woody debris C to cellulosic litter C gC/m^3/s F @@ -170,6 +166,10 @@ CWD_HR_L2 Het. Resp. from coarse woody debris CWD_HR_L2_vr Het. Resp. from coarse woody debris gC/m^3/s F CWD_HR_L3 Het. Resp. from coarse woody debris gC/m^2/s F CWD_HR_L3_vr Het. Resp. from coarse woody debris gC/m^3/s F +CWD_PATHFRAC_L2_vr PATHFRAC from coarse woody debris to cellulosic litter fraction F +CWD_PATHFRAC_L3_vr PATHFRAC from coarse woody debris to lignin litter fraction F +CWD_RESP_FRAC_L2_vr respired from coarse woody debris to cellulosic litter fraction F +CWD_RESP_FRAC_L3_vr respired from coarse woody debris to lignin litter fraction F C_ALLOMETRY C allocation index none F DAYL daylength s F DAYS_ACTIVE number of days since last dormancy days F @@ -195,13 +195,7 @@ DEADSTEMN_XFER dead stem N transfer DEADSTEMN_XFER_TO_DEADSTEMN dead stem N growth from storage gN/m^2/s F DENIT total rate of denitrification gN/m^2/s T DGNETDT derivative of net ground heat flux wrt soil temp W/m^2/K F -DISCOI 2 m Discomfort Index C T -DISCOIS 2 m Stull Discomfort Index C T -DISCOIS_R Rural 2 m Stull Discomfort Index C T -DISCOIS_U Urban 2 m Stull Discomfort Index C T -DISCOI_R Rural 2 m Discomfort Index C T -DISCOI_U Urban 2 m Discomfort Index C T -DISPLA displacement height m F +DISPLA displacement height (vegetated landunits only) m F DISPVEGC displayed veg carbon, excluding storage and cpool gC/m^2 T DISPVEGN displayed vegetation nitrogen gN/m^2 T DLRAD downward longwave radiation below the canopy W/m^2 F @@ -268,9 +262,6 @@ ELAI exposed one-sided leaf area index EMG ground emissivity proportion F EMV vegetation emissivity proportion F EOPT Eopt coefficient for VOC calc non F -EPT 2 m Equiv Pot Temp K T -EPT_R Rural 2 m Equiv Pot Temp K T -EPT_U Urban 2 m Equiv Pot Temp K T ER total ecosystem respiration, autotrophic + heterotrophic gC/m^2/s T ERRH2O total water conservation error mm T ERRH2OSNO imbalance in snow depth (liquid water) mm T @@ -380,13 +371,6 @@ FSR reflected solar radiation FSRND direct nir reflected solar radiation W/m^2 T FSRNDLN direct nir reflected solar radiation at local noon W/m^2 T FSRNI diffuse nir reflected solar radiation W/m^2 T -FSRSF reflected solar radiation W/m^2 T -FSRSFND direct nir reflected solar radiation W/m^2 T -FSRSFNDLN direct nir reflected solar radiation at local noon W/m^2 T -FSRSFNI diffuse nir reflected solar radiation W/m^2 T -FSRSFVD direct vis reflected solar radiation W/m^2 T -FSRSFVDLN direct vis reflected solar radiation at local noon W/m^2 T -FSRSFVI diffuse vis reflected solar radiation W/m^2 T FSRVD direct vis reflected solar radiation W/m^2 T FSRVDLN direct vis reflected solar radiation at local noon W/m^2 T FSRVI diffuse vis reflected solar radiation W/m^2 T @@ -404,14 +388,6 @@ F_N2O_DENIT denitrification N2O flux F_N2O_NIT nitrification N2O flux gN/m^2/s T F_NIT nitrification flux gN/m^2/s T F_NIT_vr nitrification flux gN/m^3/s F -FireComp_BC fire emissions flux of BC kg/m2/sec F -FireComp_OC fire emissions flux of OC kg/m2/sec F -FireComp_SO2 fire emissions flux of SO2 kg/m2/sec F -FireEmis_TOT Total fire emissions flux gC/m2/sec F -FireEmis_ZTOP Top of vertical fire emissions distribution m F -FireMech_SO2 fire emissions flux of SO2 kg/m2/sec F -FireMech_bc_a1 fire emissions flux of bc_a1 kg/m2/sec F -FireMech_pom_a1 fire emissions flux of pom_a1 kg/m2/sec F GAMMA total gamma for VOC calc non F GAMMAA gamma A for VOC calc non F GAMMAC gamma C for VOC calc non F @@ -426,16 +402,16 @@ GDD1020 Twenty year average of growing degree days b GDD8 Growing degree days base 8C from planting ddays F GDD820 Twenty year average of growing degree days base 8C from planting ddays F GDDACCUM Accumulated growing degree days past planting date for crop ddays F -GDDACCUM_PERHARV For each crop harvest in a calendar year, accumulated growing degree days past planting date ddays F +GDDACCUM_PERHARV At-harvest accumulated growing degree days past planting date for crop; should only be output ddays F GDDHARV Growing degree days (gdd) needed to harvest ddays F -GDDHARV_PERHARV For each harvest in a calendar year,For each harvest in a calendar year, growing degree days (gdd) needed to harvest ddays F +GDDHARV_PERHARV Growing degree days (gdd) needed to harvest; should only be output annually ddays F GDDTSOI Growing degree-days from planting (top two soil layers) ddays F GPP gross primary production gC/m^2/s T GR total growth respiration gC/m^2/s T GRAINC grain C (does not equal yield) gC/m^2 T GRAINC_TO_FOOD grain C to food gC/m^2/s T -GRAINC_TO_FOOD_ANN total grain C to food in all harvests in a calendar year gC/m^2 F -GRAINC_TO_FOOD_PERHARV grain C to food for each harvest in a calendar year gC/m^2 F +GRAINC_TO_FOOD_ANN grain C to food harvested per calendar year; should only be output annually gC/m^2 F +GRAINC_TO_FOOD_PERHARV grain C to food per harvest; should only be output annually gC/m^2 F GRAINC_TO_SEED grain C to seed gC/m^2/s T GRAINN grain N gN/m^2 T GRESP_STORAGE growth respiration storage gC/m^2 F @@ -443,6 +419,10 @@ GRESP_STORAGE_TO_XFER growth respiration shift storage to transfer GRESP_XFER growth respiration transfer gC/m^2 F GROSS_NMIN gross rate of N mineralization gN/m^2/s T GROSS_NMIN_vr gross rate of N mineralization gN/m^3/s F +GRU_PROD100C_GAIN gross unrepresented landcover change addition to 100-yr wood product pool gC/m^2/s F +GRU_PROD100N_GAIN gross unrepresented landcover change addition to 100-yr wood product pool gN/m^2/s F +GRU_PROD10C_GAIN gross unrepresented landcover change addition to 10-yr wood product pool gC/m^2/s F +GRU_PROD10N_GAIN gross unrepresented landcover change addition to 10-yr wood product pool gN/m^2/s F GSSHA shaded leaf stomatal conductance umol H20/m2/s T GSSHALN shaded leaf stomatal conductance at local noon umol H20/m2/s T GSSUN sunlit leaf stomatal conductance umol H20/m2/s T @@ -453,8 +433,9 @@ H2OSNO snow depth (liquid water) H2OSNO_ICE snow depth (liquid water, ice landunits only) mm F H2OSNO_TOP mass of snow in top snow layer kg/m2 T H2OSOI volumetric soil water (natural vegetated and crop landunits only) mm3/mm3 T -HARVEST_REASON_PERHARV For each harvest in a calendar year, the reason the crop was harvested categorical F +HARVEST_REASON_PERHARV Reason for each crop harvest; should only be output annually 1 = mature; 2 = max season length; 3 = incorrect Dec. 31 sowing; F HBOT canopy bottom m F +HDATES actual crop harvest dates; should only be output annually day of year F HEAT_CONTENT1 initial gridcell total heat content J/m^2 T HEAT_CONTENT1_VEG initial gridcell total heat content - natural vegetated and crop landunits only J/m^2 F HEAT_CONTENT2 post land cover change total heat content J/m^2 F @@ -466,8 +447,8 @@ HK hydraulic conductivity (natural vegetated an HR total heterotrophic respiration gC/m^2/s T HR_vr total vertically resolved heterotrophic respiration gC/m^3/s T HTOP canopy top m T -HUI crop heat unit index ddays F -HUI_PERHARV For each harvest in a calendar year, crop heat unit index ddays F +HUI Crop patch heat unit index ddays F +HUI_PERHARV At-harvest accumulated heat unit index for crop; should only be output annually ddays F HUMIDEX 2 m Humidex C T HUMIDEX_R Rural 2 m Humidex C T HUMIDEX_U Urban 2 m Humidex C T @@ -493,6 +474,12 @@ K_NITR_PH K_NITR_PH K_NITR_T K_NITR_T unitless F K_PAS_SOM passive soil organic potential loss coefficient 1/s F K_SLO_SOM slow soil organic ma potential loss coefficient 1/s F +L1_PATHFRAC_S1_vr PATHFRAC from metabolic litter to active soil organic fraction F +L1_RESP_FRAC_S1_vr respired from metabolic litter to active soil organic fraction F +L2_PATHFRAC_S1_vr PATHFRAC from cellulosic litter to active soil organic fraction F +L2_RESP_FRAC_S1_vr respired from cellulosic litter to active soil organic fraction F +L3_PATHFRAC_S2_vr PATHFRAC from lignin litter to slow soil organic ma fraction F +L3_RESP_FRAC_S2_vr respired from lignin litter to slow soil organic ma fraction F LAI240 240hr average of leaf area index m^2/m^2 F LAISHA shaded projected leaf area index m^2/m^2 T LAISUN sunlit projected leaf area index m^2/m^2 T @@ -500,7 +487,7 @@ LAKEICEFRAC lake layer ice mass fraction LAKEICEFRAC_SURF surface lake layer ice mass fraction unitless T LAKEICETHICK thickness of lake ice (including physical expansion on freezing) m T LAND_USE_FLUX total C emitted from land cover conversion (smoothed over the year) and wood and grain product gC/m^2/s T -LATBASET latitude vary base temperature for gddplant degree C F +LATBASET latitude vary base temperature for hui degree C F LEAFC leaf C gC/m^2 T LEAFCN Leaf CN ratio used for flexible CN gC/gN T LEAFCN_OFFSET Leaf C:N used by FUN unitless F @@ -980,11 +967,21 @@ RSSHA shaded leaf stomatal resistance RSSUN sunlit leaf stomatal resistance s/m T Rainf atmospheric rain, after rain/snow repartitioning based on temperature mm/s F Rnet net radiation W/m^2 F +S1_PATHFRAC_S2_vr PATHFRAC from active soil organic to slow soil organic ma fraction F +S1_PATHFRAC_S3_vr PATHFRAC from active soil organic to passive soil organic fraction F +S1_RESP_FRAC_S2_vr respired from active soil organic to slow soil organic ma fraction F +S1_RESP_FRAC_S3_vr respired from active soil organic to passive soil organic fraction F +S2_PATHFRAC_S1_vr PATHFRAC from slow soil organic ma to active soil organic fraction F +S2_PATHFRAC_S3_vr PATHFRAC from slow soil organic ma to passive soil organic fraction F +S2_RESP_FRAC_S1_vr respired from slow soil organic ma to active soil organic fraction F +S2_RESP_FRAC_S3_vr respired from slow soil organic ma to passive soil organic fraction F +S3_PATHFRAC_S1_vr PATHFRAC from passive soil organic to active soil organic fraction F +S3_RESP_FRAC_S1_vr respired from passive soil organic to active soil organic fraction F SABG solar rad absorbed by ground W/m^2 T SABG_PEN Rural solar rad penetrating top soil or snow layer watt/m^2 T SABV solar rad absorbed by veg W/m^2 T -SDATES Crop sowing dates in each calendar year day of year (julian day) F -SDATES_PERHARV For each harvest in a calendar year, the Julian day the crop was sown day of year (julian day) F +SDATES actual crop sowing dates; should only be output annually day of year F +SDATES_PERHARV actual sowing dates for crops harvested this year; should only be output annually day of year F SEEDC pool for seeding new PFTs via dynamic landcover gC/m^2 T SEEDN pool for seeding new PFTs via dynamic landcover gN/m^2 T SLASH_HARVESTC slash harvest carbon (to litter) gC/m^2/s T @@ -1114,16 +1111,9 @@ SOM_ADV_COEF advection term for vertical SOM translocatio SOM_C_LEACHED total flux of C from SOM pools due to leaching gC/m^2/s T SOM_DIFFUS_COEF diffusion coefficient for vertical SOM translocation m^2/s F SOM_N_LEACHED total flux of N from SOM pools due to leaching gN/m^2/s F -SOWING_REASON For each sowing in a calendar year, the reason the crop was sown categorical F -SOWING_REASON_PERHARV For each harvest in a calendar year, the reason the crop was sown categorical F +SOWING_REASON Reason for each crop sowing; should only be output annually unitless F +SOWING_REASON_PERHARV Reason for sowing of each crop harvested this year; should only be output annually unitless F SR total soil respiration (HR + root resp) gC/m^2/s T -SSRE_FSR surface snow effect on reflected solar radiation W/m^2 T -SSRE_FSRND surface snow effect on direct nir reflected solar radiation W/m^2 T -SSRE_FSRNDLN surface snow effect on direct nir reflected solar radiation at local noon W/m^2 T -SSRE_FSRNI surface snow effect on diffuse nir reflected solar radiation W/m^2 T -SSRE_FSRVD surface snow radiatve effect on direct vis reflected solar radiation W/m^2 T -SSRE_FSRVDLN surface snow radiatve effect on direct vis reflected solar radiation at local noon W/m^2 T -SSRE_FSRVI surface snow radiatve effect on diffuse vis reflected solar radiation W/m^2 T STEM_PROF profile for litter C and N inputs from stems 1/m F STORAGE_CDEMAND C use from the C storage pool gC/m^2 F STORAGE_GR growth resp for growth sent to storage for later display gC/m^2/s F @@ -1132,18 +1122,12 @@ STORVEGC stored vegetation carbon, excluding cpool STORVEGN stored vegetation nitrogen gN/m^2 T SUPPLEMENT_TO_SMINN supplemental N supply gN/m^2/s T SUPPLEMENT_TO_SMINN_vr supplemental N supply gN/m^3/s F -SYEARS_PERHARV For each harvest in a calendar year, the year the crop was sown year F SWBGT 2 m Simplified Wetbulb Globe Temp C T SWBGT_R Rural 2 m Simplified Wetbulb Globe Temp C T SWBGT_U Urban 2 m Simplified Wetbulb Globe Temp C T -SWMP65 2 m Swamp Cooler Temp 65% Eff C T -SWMP65_R Rural 2 m Swamp Cooler Temp 65% Eff C T -SWMP65_U Urban 2 m Swamp Cooler Temp 65% Eff C T -SWMP80 2 m Swamp Cooler Temp 80% Eff C T -SWMP80_R Rural 2 m Swamp Cooler Temp 80% Eff C T -SWMP80_U Urban 2 m Swamp Cooler Temp 80% Eff C T SWdown atmospheric incident solar radiation W/m^2 F SWup upwelling shortwave radiation W/m^2 F +SYEARS_PERHARV actual sowing years for crops harvested this year; should only be output annually year F SoilAlpha factor limiting ground evap unitless F SoilAlpha_U urban factor limiting ground evap unitless F T10 10-day running mean of 2-m temperature K F @@ -1156,9 +1140,6 @@ TBUILD_MAX prescribed maximum interior building tempera TEMPAVG_T2M temporary average 2m air temperature K F TEMPMAX_RETRANSN temporary annual max of retranslocated N pool gN/m^2 F TEMPSUM_POTENTIAL_GPP temporary annual sum of potential GPP gC/m^2/yr F -TEQ 2 m Equiv Temp K T -TEQ_R Rural 2 m Equiv Temp K T -TEQ_U Urban 2 m Equiv Temp K T TFLOOR floor temperature K F TG ground temperature K T TG_ICE ground temperature (ice landunits only) K F @@ -1166,12 +1147,6 @@ TG_R Rural ground temperature TG_U Urban ground temperature K F TH2OSFC surface water temperature K T THBOT atmospheric air potential temperature (downscaled to columns in glacier regions) K T -THIC 2 m Temp Hum Index Comfort C T -THIC_R Rural 2 m Temp Hum Index Comfort C T -THIC_U Urban 2 m Temp Hum Index Comfort C T -THIP 2 m Temp Hum Index Physiology C T -THIP_R Rural 2 m Temp Hum Index Physiology C T -THIP_U Urban 2 m Temp Hum Index Physiology C T TKE1 top lake level eddy thermal conductivity W/(mK) T TLAI total projected leaf area index m^2/m^2 T TLAKE lake temperature K T @@ -1256,6 +1231,7 @@ VCMX25T canopy profile of vcmax25 VEGWP vegetation water matric potential for sun/sha canopy,xyl,root segments mm T VEGWPLN vegetation water matric potential for sun/sha canopy,xyl,root at local noon mm T VEGWPPD predawn vegetation water matric potential for sun/sha canopy,xyl,root mm T +VENTILATION sensible heat flux from building ventilation W/m^2 T VOCFLXT total VOC flux into atmosphere moles/m2/sec F VOLR river channel total water storage m3 T VOLRMCH river channel main channel water storage m3 T @@ -1264,9 +1240,6 @@ VPD2M 2m vapor pressure deficit VPD_CAN canopy vapor pressure deficit kPa T Vcmx25Z canopy profile of vcmax25 predicted by LUNA model umol/m2/s T WASTEHEAT sensible heat flux from heating/cooling sources of urban waste heat W/m^2 T -WBA 2 m Wet Bulb C T -WBA_R Rural 2 m Wet Bulb C T -WBA_U Urban 2 m Wet Bulb C T WBT 2 m Stull Wet Bulb C T WBT_R Rural 2 m Stull Wet Bulb C T WBT_U Urban 2 m Stull Wet Bulb C T @@ -1284,13 +1257,13 @@ Wind atmospheric wind velocity magnitude XSMRPOOL temporary photosynthate C pool gC/m^2 T XSMRPOOL_LOSS temporary photosynthate C pool loss gC/m^2 F XSMRPOOL_RECOVER C flux assigned to recovery of negative xsmrpool gC/m^2/s T -Z0HG roughness length over ground, sensible heat m F +Z0HG roughness length over ground, sensible heat (vegetated landunits only) m F Z0HV roughness length over vegetation, sensible heat m F -Z0M momentum roughness length m F -Z0MG roughness length over ground, momentum m F +Z0MG roughness length over ground, momentum (vegetated landunits only) m F Z0MV roughness length over vegetation, momentum m F +Z0MV_DENSE roughness length over vegetation, momentum, for dense canopy m F Z0M_TO_COUPLER roughness length, momentum: gridcell average sent to coupler m F -Z0QG roughness length over ground, latent heat m F +Z0QG roughness length over ground, latent heat (vegetated landunits only) m F Z0QV roughness length over vegetation, latent heat m F ZBOT atmospheric reference height m T ZETA dimensionless stability parameter unitless F @@ -1312,4 +1285,4 @@ soil_bulkdensity soil_bulkdensity soil_co2_prod soil_co2_prod ug C / g soil / day F watfc water field capacity m^3/m^3 F watsat water saturated m^3/m^3 F -==== =================================== ============================================================================================== ================================================================= ======= +=================================== ============================================================================================== ================================================================= ======= From 907ca1ab13c2b5b55b0b024ef96ff15039477f93 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Sat, 12 Aug 2023 15:16:53 -0600 Subject: [PATCH 177/257] Provisions to satisfy nag compiler, cnveg datastructures on now allocated with 1 index 0 through 0 when fate_bgc is on, to avoid null pointers on associates --- src/biogeochem/CNVegCarbonFluxType.F90 | 31 ++++++---- src/biogeochem/CNVegCarbonStateType.F90 | 40 ++++++++----- src/biogeochem/CNVegNitrogenFluxType.F90 | 38 +++++++----- src/biogeochem/CNVegNitrogenStateType.F90 | 47 +++++++++------ src/biogeochem/CNVegStateType.F90 | 20 +++++-- src/biogeochem/CNVegetationFacade.F90 | 59 +++++++++++++------ .../SoilBiogeochemCarbonFluxType.F90 | 2 + .../SoilBiogeochemNitrogenFluxType.F90 | 8 ++- 8 files changed, 160 insertions(+), 85 deletions(-) diff --git a/src/biogeochem/CNVegCarbonFluxType.F90 b/src/biogeochem/CNVegCarbonFluxType.F90 index c2025fca47..d376d33e16 100644 --- a/src/biogeochem/CNVegCarbonFluxType.F90 +++ b/src/biogeochem/CNVegCarbonFluxType.F90 @@ -434,21 +434,23 @@ module CNVegCarbonFluxType contains !------------------------------------------------------------------------ - subroutine Init(this, bounds, carbon_type, dribble_crophrv_xsmrpool_2atm) + subroutine Init(this, bounds, carbon_type, dribble_crophrv_xsmrpool_2atm,tot_bgc_vegp) class(cnveg_carbonflux_type) :: this type(bounds_type), intent(in) :: bounds character(len=3) , intent(in) :: carbon_type ! one of ['c12', c13','c14'] logical , intent(in) :: dribble_crophrv_xsmrpool_2atm + integer , intent(in) :: tot_bgc_vegp this%dribble_crophrv_xsmrpool_2atm = dribble_crophrv_xsmrpool_2atm - call this%InitAllocate ( bounds, carbon_type) - if(use_matrixcn)then - call this%InitTransfer () + call this%InitAllocate ( bounds, carbon_type,tot_bgc_vegp) + if(tot_bgc_vegp>0)then + if(use_matrixcn)then + call this%InitTransfer () + end if + call this%InitHistory ( bounds, carbon_type ) + call this%InitCold (bounds ) end if - call this%InitHistory ( bounds, carbon_type ) - call this%InitCold (bounds ) - end subroutine Init subroutine InitTransfer (this) @@ -461,12 +463,13 @@ subroutine InitTransfer (this) end subroutine InitTransfer !------------------------------------------------------------------------ - subroutine InitAllocate(this, bounds, carbon_type) + subroutine InitAllocate(this, bounds, carbon_type, tot_bgc_vegp) ! ! !ARGUMENTS: class (cnveg_carbonflux_type) :: this type(bounds_type), intent(in) :: bounds character(len=*) , intent(in) :: carbon_type ! one of ['c12', c13','c14'] + integer , intent(in) :: tot_bgc_vegp ! ! !LOCAL VARIABLES: integer :: begp,endp @@ -476,9 +479,15 @@ subroutine InitAllocate(this, bounds, carbon_type) character(len=:), allocatable :: carbon_type_suffix !------------------------------------------------------------------------ - begp = bounds%begp; endp = bounds%endp - begc = bounds%begc; endc = bounds%endc - begg = bounds%begg; endg = bounds%endg + if(tot_bgc_vegp>0)then + begp = bounds%begp; endp = bounds%endp + begc = bounds%begc; endc = bounds%endc + begg = bounds%begg; endg = bounds%endg + else + begp = 0; endp = 0 + begc = 0; endc = 0 + begg = 0; endg = 0 + end if allocate(this%m_leafc_to_litter_patch (begp:endp)) ; this%m_leafc_to_litter_patch (:) = nan allocate(this%m_frootc_to_litter_patch (begp:endp)) ; this%m_frootc_to_litter_patch (:) = nan diff --git a/src/biogeochem/CNVegCarbonStateType.F90 b/src/biogeochem/CNVegCarbonStateType.F90 index e1d0ed6e39..e5f08bdc9d 100644 --- a/src/biogeochem/CNVegCarbonStateType.F90 +++ b/src/biogeochem/CNVegCarbonStateType.F90 @@ -126,7 +126,7 @@ module CNVegCarbonStateType !------------------------------------------------------------------------ subroutine Init(this, bounds, carbon_type, ratio, NLFilename, & - dribble_crophrv_xsmrpool_2atm, c12_cnveg_carbonstate_inst) + dribble_crophrv_xsmrpool_2atm, tot_bgc_vegp, c12_cnveg_carbonstate_inst) class(cnveg_carbonstate_type) :: this type(bounds_type) , intent(in) :: bounds @@ -134,6 +134,7 @@ subroutine Init(this, bounds, carbon_type, ratio, NLFilename, & character(len=*) , intent(in) :: carbon_type ! Carbon isotope type C12, C13 or C1 character(len=*) , intent(in) :: NLFilename ! Namelist filename logical , intent(in) :: dribble_crophrv_xsmrpool_2atm + integer , intent(in) :: tot_bgc_vegp ! total number of bgc patches (non-fates) type(cnveg_carbonstate_type) , intent(in), optional :: c12_cnveg_carbonstate_inst ! cnveg_carbonstate for C12 (if C13 or C14) !----------------------------------------------------------------------- @@ -141,15 +142,17 @@ subroutine Init(this, bounds, carbon_type, ratio, NLFilename, & this%dribble_crophrv_xsmrpool_2atm = dribble_crophrv_xsmrpool_2atm - call this%InitAllocate ( bounds) - call this%InitReadNML ( NLFilename ) - call this%InitHistory ( bounds, carbon_type) - if (present(c12_cnveg_carbonstate_inst)) then - call this%InitCold ( bounds, ratio, carbon_type, c12_cnveg_carbonstate_inst ) - else - call this%InitCold ( bounds, ratio, carbon_type ) + call this%InitAllocate ( bounds, tot_bgc_vegp) + if(tot_bgc_vegp>0)then + call this%InitReadNML ( NLFilename ) + call this%InitHistory ( bounds, carbon_type) + if (present(c12_cnveg_carbonstate_inst)) then + call this%InitCold ( bounds, ratio, carbon_type, c12_cnveg_carbonstate_inst ) + else + call this%InitCold ( bounds, ratio, carbon_type ) + end if end if - + end subroutine Init !------------------------------------------------------------------------ @@ -213,21 +216,28 @@ subroutine InitReadNML(this, NLFilename) end subroutine InitReadNML !------------------------------------------------------------------------ - subroutine InitAllocate(this, bounds) + subroutine InitAllocate(this, bounds, tot_bgc_vegp) ! ! !ARGUMENTS: class (cnveg_carbonstate_type) :: this - type(bounds_type), intent(in) :: bounds + type(bounds_type), intent(in) :: bounds + integer,intent(in) :: tot_bgc_vegp ! Total number of bgc patches on the proc (non_fates) ! ! !LOCAL VARIABLES: integer :: begp,endp integer :: begc,endc integer :: begg,endg !------------------------------------------------------------------------ - - begp = bounds%begp; endp = bounds%endp - begc = bounds%begc; endc = bounds%endc - begg = bounds%begg; endg = bounds%endg + + if(tot_bgc_vegp>0)then + begp = bounds%begp; endp = bounds%endp + begc = bounds%begc; endc = bounds%endc + begg = bounds%begg; endg = bounds%endg + else + begp = 0;endp=0 + begc = 0;endc=0 + begg = 0;endg=0 + end if allocate(this%leafc_patch (begp:endp)) ; this%leafc_patch (:) = nan allocate(this%leafc_storage_patch (begp:endp)) ; this%leafc_storage_patch (:) = nan diff --git a/src/biogeochem/CNVegNitrogenFluxType.F90 b/src/biogeochem/CNVegNitrogenFluxType.F90 index ce164b4c37..f742cba2ad 100644 --- a/src/biogeochem/CNVegNitrogenFluxType.F90 +++ b/src/biogeochem/CNVegNitrogenFluxType.F90 @@ -292,18 +292,21 @@ module CNVegNitrogenFluxType contains !------------------------------------------------------------------------ - subroutine Init(this, bounds) + subroutine Init(this, bounds, tot_bgc_vegp) class(cnveg_nitrogenflux_type) :: this - type(bounds_type), intent(in) :: bounds + type(bounds_type), intent(in) :: bounds + integer,intent(in) :: tot_bgc_vegp - call this%InitAllocate (bounds) - if(use_matrixcn)then - call this%InitTransfer () + call this%InitAllocate (bounds,tot_bgc_vegp) + if(tot_bgc_vegp>0)then + if(use_matrixcn)then + call this%InitTransfer () + end if + call this%InitHistory (bounds) + call this%InitCold (bounds) end if - call this%InitHistory (bounds) - call this%InitCold (bounds) - + end subroutine Init subroutine InitTransfer (this) @@ -323,14 +326,15 @@ subroutine InitTransfer (this) end subroutine InitTransfer !------------------------------------------------------------------------ - subroutine InitAllocate(this, bounds) + subroutine InitAllocate(this, bounds, tot_bgc_vegp) ! ! !DESCRIPTION: ! Initialize patch nitrogen flux ! ! !ARGUMENTS: class (cnveg_nitrogenflux_type) :: this - type(bounds_type) , intent(in) :: bounds + type(bounds_type) , intent(in) :: bounds + integer,intent(in) :: tot_bgc_vegp ! ! !LOCAL VARIABLES: integer :: begp,endp @@ -338,10 +342,16 @@ subroutine InitAllocate(this, bounds) integer :: begg,endg !------------------------------------------------------------------------ - begp = bounds%begp; endp = bounds%endp - begc = bounds%begc; endc = bounds%endc - begg = bounds%begg; endg = bounds%endg - + if(tot_bgc_vegp>0)then + begp = bounds%begp; endp = bounds%endp + begc = bounds%begc; endc = bounds%endc + begg = bounds%begg; endg = bounds%endg + else + begp = 0; endp = 0 + begc = 0; endc = 0 + begg = 0; endg = 0 + end if + allocate(this%m_leafn_to_litter_patch (begp:endp)) ; this%m_leafn_to_litter_patch (:) = nan allocate(this%m_frootn_to_litter_patch (begp:endp)) ; this%m_frootn_to_litter_patch (:) = nan allocate(this%m_leafn_storage_to_litter_patch (begp:endp)) ; this%m_leafn_storage_to_litter_patch (:) = nan diff --git a/src/biogeochem/CNVegNitrogenStateType.F90 b/src/biogeochem/CNVegNitrogenStateType.F90 index d6c335bb9a..341cc8f40d 100644 --- a/src/biogeochem/CNVegNitrogenStateType.F90 +++ b/src/biogeochem/CNVegNitrogenStateType.F90 @@ -96,40 +96,49 @@ module CNVegNitrogenStateType !------------------------------------------------------------------------ subroutine Init(this, bounds, & - leafc_patch, leafc_storage_patch, frootc_patch, frootc_storage_patch, deadstemc_patch) + leafc_patch, leafc_storage_patch, frootc_patch, frootc_storage_patch, & + deadstemc_patch, tot_bgc_vegp) class(cnveg_nitrogenstate_type) :: this type(bounds_type) , intent(in) :: bounds - real(r8) , intent(in) :: leafc_patch (bounds%begp:) - real(r8) , intent(in) :: leafc_storage_patch (bounds%begp:) - real(r8) , intent(in) :: frootc_patch (bounds%begp:) - real(r8) , intent(in) :: frootc_storage_patch (bounds%begp:) - real(r8) , intent(in) :: deadstemc_patch (bounds%begp:) - - call this%InitAllocate (bounds ) - call this%InitHistory (bounds) - call this%InitCold ( bounds, & - leafc_patch, leafc_storage_patch, frootc_patch, frootc_storage_patch, deadstemc_patch) - + real(r8) , intent(in) :: leafc_patch (:) !(begp:) + real(r8) , intent(in) :: leafc_storage_patch (:) !(begp:) + real(r8) , intent(in) :: frootc_patch (:) !(begp:) + real(r8) , intent(in) :: frootc_storage_patch(:) !(begp:) + real(r8) , intent(in) :: deadstemc_patch (:) !(begp:) + integer , intent(in) :: tot_bgc_vegp + + call this%InitAllocate (bounds, tot_bgc_vegp) + if(tot_bgc_vegp>0) then + call this%InitHistory (bounds) + call this%InitCold ( bounds, & + leafc_patch, leafc_storage_patch, frootc_patch, frootc_storage_patch, deadstemc_patch) + end if end subroutine Init !------------------------------------------------------------------------ - subroutine InitAllocate(this, bounds) + subroutine InitAllocate(this, bounds, tot_bgc_vegp) ! ! !ARGUMENTS: class (cnveg_nitrogenstate_type) :: this - type(bounds_type) , intent(in) :: bounds + type(bounds_type) , intent(in) :: bounds + integer,intent(in) :: tot_bgc_vegp ! ! !LOCAL VARIABLES: integer :: begp,endp integer :: begc,endc integer :: begg,endg !------------------------------------------------------------------------ - - begp = bounds%begp; endp = bounds%endp - begc = bounds%begc; endc = bounds%endc - begg = bounds%begg; endg = bounds%endg - + if(tot_bgc_vegp>0) then + begp = bounds%begp; endp = bounds%endp + begc = bounds%begc; endc = bounds%endc + begg = bounds%begg; endg = bounds%endg + else + begp = 0; endp = 0 + begc = 0; endc = 0 + begg = 0; endg = 0 + end if + allocate(this%reproductiven_patch (begp:endp, nrepr)) ; this%reproductiven_patch (:,:) = nan allocate(this%reproductiven_storage_patch (begp:endp, nrepr)) ; this%reproductiven_storage_patch (:,:) = nan allocate(this%reproductiven_xfer_patch (begp:endp, nrepr)) ; this%reproductiven_xfer_patch (:,:) = nan diff --git a/src/biogeochem/CNVegStateType.F90 b/src/biogeochem/CNVegStateType.F90 index e7e61c75bf..b5391c7bce 100644 --- a/src/biogeochem/CNVegStateType.F90 +++ b/src/biogeochem/CNVegStateType.F90 @@ -130,12 +130,13 @@ module CNVegStateType contains !------------------------------------------------------------------------ - subroutine Init(this, bounds) + subroutine Init(this, bounds, tot_bgc_vegp) class(cnveg_state_type) :: this type(bounds_type), intent(in) :: bounds + integer,intent(in) :: tot_bgc_vegp ! Total number of bgc patches on proc (non-fates) - call this%InitAllocate ( bounds ) + call this%InitAllocate ( bounds, tot_bgc_vegp) if (use_cn) then call this%InitHistory ( bounds ) end if @@ -144,7 +145,7 @@ subroutine Init(this, bounds) end subroutine Init !------------------------------------------------------------------------ - subroutine InitAllocate(this, bounds) + subroutine InitAllocate(this, bounds, tot_bgc_vegp) ! ! !DESCRIPTION: ! Initialize module data structure @@ -156,6 +157,7 @@ subroutine InitAllocate(this, bounds) ! !ARGUMENTS: class(cnveg_state_type) :: this type(bounds_type), intent(in) :: bounds + integer, intent(in) :: tot_bgc_vegp ! Total number of bgc patches on proc (non-fates) ! ! !LOCAL VARIABLES: integer :: begp, endp @@ -163,9 +165,15 @@ subroutine InitAllocate(this, bounds) logical :: allows_non_annual_delta !------------------------------------------------------------------------ - begp = bounds%begp; endp= bounds%endp - begc = bounds%begc; endc= bounds%endc - + if(tot_bgc_vegp>0)then + begp = bounds%begp; endp= bounds%endp + begc = bounds%begc; endc= bounds%endc + else + begp = 0;endp = 0 + begc = 0;endc = 0 + end if + + ! Note that we set allows_non_annual_delta to false because we expect land cover ! change to be applied entirely at the start of the year. Currently the fire code ! appears to assume that the land cover change rate is constant throughout the year, diff --git a/src/biogeochem/CNVegetationFacade.F90 b/src/biogeochem/CNVegetationFacade.F90 index c437a9e438..7370987e3c 100644 --- a/src/biogeochem/CNVegetationFacade.F90 +++ b/src/biogeochem/CNVegetationFacade.F90 @@ -206,6 +206,8 @@ subroutine Init(this, bounds, NLFilename, nskip_steps, params_ncid) use CNFireFactoryMod , only : create_cnfire_method use clm_varcon , only : c13ratio, c14ratio use ncdio_pio , only : file_desc_t + use filterMod , only : filter + use decompMod , only : get_proc_clumps ! ! !ARGUMENTS: class(cn_vegetation_type), intent(inout) :: this @@ -215,16 +217,33 @@ subroutine Init(this, bounds, NLFilename, nskip_steps, params_ncid) type(file_desc_t), intent(inout) :: params_ncid ! NetCDF handle to parameter file ! ! !LOCAL VARIABLES: - integer :: begp, endp + integer :: begp, endp, ci + integer :: nclumps ! number of clumps on the proc + integer :: tot_bgc_vegp ! Total number of bgc vegetation patches (non-fates) + ! on the proc character(len=*), parameter :: subname = 'Init' !----------------------------------------------------------------------- - begp = bounds%begp - endp = bounds%endp - ! Note - always initialize the memory for cnveg_state_inst (used in biogeophys/) - call this%cnveg_state_inst%Init(bounds) + ! - Even if FATES is the only vegetation option, we still allocate + ! - a single value for both column and patch, using index 0 only + ! - that is why we pass the number of bgc veg patches here + + nclumps = get_proc_clumps() + tot_bgc_vegp = 0 + do ci=1,nclumps + tot_bgc_vegp = tot_bgc_vegp + filter(ci)%num_bgc_vegp + end do + if(tot_bgc_vegp>0)then + begp = bounds%begp + endp = bounds%endp + else + begp = 0 + endp = 0 + end if + + call this%cnveg_state_inst%Init(bounds,tot_bgc_vegp) skip_steps = nskip_steps @@ -232,37 +251,43 @@ subroutine Init(this, bounds, NLFilename, nskip_steps, params_ncid) ! Read in the general CN namelist call this%CNReadNML( NLFilename ) ! MUST be called first as passes down control information to others + end if + if(use_cn.or.use_fates_bgc)then call this%cnveg_carbonstate_inst%Init(bounds, carbon_type='c12', ratio=1._r8, & - NLFilename=NLFilename, dribble_crophrv_xsmrpool_2atm=this%dribble_crophrv_xsmrpool_2atm ) + NLFilename=NLFilename, dribble_crophrv_xsmrpool_2atm=this%dribble_crophrv_xsmrpool_2atm, & + tot_bgc_vegp=tot_bgc_vegp) + if (use_c13) then call this%c13_cnveg_carbonstate_inst%Init(bounds, carbon_type='c13', ratio=c13ratio, & NLFilename=NLFilename, dribble_crophrv_xsmrpool_2atm=this%dribble_crophrv_xsmrpool_2atm, & - c12_cnveg_carbonstate_inst=this%cnveg_carbonstate_inst) + tot_bgc_vegp=tot_bgc_vegp, c12_cnveg_carbonstate_inst=this%cnveg_carbonstate_inst) end if if (use_c14) then call this%c14_cnveg_carbonstate_inst%Init(bounds, carbon_type='c14', ratio=c14ratio, & NLFilename=NLFilename, dribble_crophrv_xsmrpool_2atm=this%dribble_crophrv_xsmrpool_2atm, & - c12_cnveg_carbonstate_inst=this%cnveg_carbonstate_inst) + tot_bgc_vegp=tot_bgc_vegp,c12_cnveg_carbonstate_inst=this%cnveg_carbonstate_inst) end if - call this%cnveg_carbonflux_inst%Init(bounds, carbon_type='c12', dribble_crophrv_xsmrpool_2atm=this%dribble_crophrv_xsmrpool_2atm ) + + call this%cnveg_carbonflux_inst%Init(bounds, carbon_type='c12', & + dribble_crophrv_xsmrpool_2atm=this%dribble_crophrv_xsmrpool_2atm, tot_bgc_vegp=tot_bgc_vegp ) if (use_c13) then - call this%c13_cnveg_carbonflux_inst%Init(bounds, carbon_type='c13', dribble_crophrv_xsmrpool_2atm=this%dribble_crophrv_xsmrpool_2atm) + call this%c13_cnveg_carbonflux_inst%Init(bounds, carbon_type='c13', & + dribble_crophrv_xsmrpool_2atm=this%dribble_crophrv_xsmrpool_2atm,tot_bgc_vegp=tot_bgc_vegp) end if if (use_c14) then - call this%c14_cnveg_carbonflux_inst%Init(bounds, carbon_type='c14', dribble_crophrv_xsmrpool_2atm=this%dribble_crophrv_xsmrpool_2atm) + call this%c14_cnveg_carbonflux_inst%Init(bounds, carbon_type='c14', & + dribble_crophrv_xsmrpool_2atm=this%dribble_crophrv_xsmrpool_2atm,tot_bgc_vegp=tot_bgc_vegp) end if call this%cnveg_nitrogenstate_inst%Init(bounds, & this%cnveg_carbonstate_inst%leafc_patch(begp:endp), & this%cnveg_carbonstate_inst%leafc_storage_patch(begp:endp), & this%cnveg_carbonstate_inst%frootc_patch(begp:endp), & this%cnveg_carbonstate_inst%frootc_storage_patch(begp:endp), & - this%cnveg_carbonstate_inst%deadstemc_patch(begp:endp) ) - call this%cnveg_nitrogenflux_inst%Init(bounds) - - end if - - if (use_cn .or. use_fates_bgc) then + this%cnveg_carbonstate_inst%deadstemc_patch(begp:endp), & + tot_bgc_vegp=tot_bgc_vegp) + call this%cnveg_nitrogenflux_inst%Init(bounds,tot_bgc_vegp=tot_bgc_vegp) + call this%c_products_inst%Init(bounds, species_non_isotope_type('C')) if (use_c13) then call this%c13_products_inst%Init(bounds, species_isotope_type('C', '13')) diff --git a/src/soilbiogeochem/SoilBiogeochemCarbonFluxType.F90 b/src/soilbiogeochem/SoilBiogeochemCarbonFluxType.F90 index d9ada3922d..212cb6a5e2 100644 --- a/src/soilbiogeochem/SoilBiogeochemCarbonFluxType.F90 +++ b/src/soilbiogeochem/SoilBiogeochemCarbonFluxType.F90 @@ -163,6 +163,8 @@ subroutine InitAllocate(this, bounds) if(use_fates)then allocate(this%fates_litter_flux(begc:endc)); this%fates_litter_flux(:) = nan + else + allocate(this%fates_litter_flux(0:0)); this%fates_litter_flux(:) = nan end if if(use_soil_matrixcn)then diff --git a/src/soilbiogeochem/SoilBiogeochemNitrogenFluxType.F90 b/src/soilbiogeochem/SoilBiogeochemNitrogenFluxType.F90 index fb7eac1ce2..5907d109d5 100644 --- a/src/soilbiogeochem/SoilBiogeochemNitrogenFluxType.F90 +++ b/src/soilbiogeochem/SoilBiogeochemNitrogenFluxType.F90 @@ -277,9 +277,11 @@ subroutine InitAllocate(this, bounds) allocate(this%decomp_npools_sourcesink_col (begc:endc,1:nlevdecomp_full,1:ndecomp_pools)) this%decomp_npools_sourcesink_col (:,:,:) = nan if(use_fates)then - allocate(this%fates_litter_flux(begc:endc)); this%fates_litter_flux(:) = nan - end if - + allocate(this%fates_litter_flux(begc:endc)); this%fates_litter_flux(:) = nan + else + allocate(this%fates_litter_flux(0:0)); this%fates_litter_flux(:) = nan + end if + ! Allocate soil Matrix setug if(use_soil_matrixcn)then end if From eaea0305bf000f594edf4ff23e6ed87ee2734060 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Mon, 14 Aug 2023 09:55:24 -0600 Subject: [PATCH 178/257] Update to clm-fates-bgc zero-allocating instead of not allocating cnveg arrays --- src/biogeochem/CNDriverMod.F90 | 111 +++++++++++----------- src/biogeochem/CNVegCarbonFluxType.F90 | 14 +-- src/biogeochem/CNVegCarbonStateType.F90 | 14 +-- src/biogeochem/CNVegNitrogenFluxType.F90 | 14 +-- src/biogeochem/CNVegNitrogenStateType.F90 | 16 ++-- src/biogeochem/CNVegStateType.F90 | 22 +++-- src/biogeochem/CNVegStructUpdateMod.F90 | 4 +- src/biogeochem/CNVegetationFacade.F90 | 50 +++++----- 8 files changed, 123 insertions(+), 122 deletions(-) diff --git a/src/biogeochem/CNDriverMod.F90 b/src/biogeochem/CNDriverMod.F90 index 424cf8c52b..0907211add 100644 --- a/src/biogeochem/CNDriverMod.F90 +++ b/src/biogeochem/CNDriverMod.F90 @@ -393,43 +393,45 @@ subroutine CNDriverNoLeaching(bounds, ! do_nutrient_competition should be modified, but that modification should not significantly change ! the current interface. - !RF: moved ths call to before nutrient_demand, so that croplive didn't change half way through crop N cycle. - if ( use_fun ) then - call t_startf('CNPhenology_phase1') - call CNPhenology (bounds, num_bgc_soilc, filter_bgc_soilc, num_bgc_vegp, & - filter_bgc_vegp, num_pcropp, filter_pcropp, & - waterdiagnosticbulk_inst, wateratm2lndbulk_inst, temperature_inst, atm2lnd_inst, & - crop_inst, canopystate_inst, soilstate_inst, dgvs_inst, & - cnveg_state_inst, cnveg_carbonstate_inst, cnveg_carbonflux_inst, & - cnveg_nitrogenstate_inst, cnveg_nitrogenflux_inst, & - c13_cnveg_carbonstate_inst, c14_cnveg_carbonstate_inst, & - leaf_prof_patch=soilbiogeochem_state_inst%leaf_prof_patch(begp:endp,1:nlevdecomp_full), & - froot_prof_patch=soilbiogeochem_state_inst%froot_prof_patch(begp:endp,1:nlevdecomp_full), & - phase=1) - call t_stopf('CNPhenology_phase1') - - call t_startf('CNFUNInit') - call CNFUNInit(bounds,cnveg_state_inst,cnveg_carbonstate_inst,cnveg_nitrogenstate_inst) - call t_stopf('CNFUNInit') - - end if - - call t_startf('cnalloc') - call calc_gpp_mr_availc( & - bounds, num_bgc_vegp, filter_bgc_vegp, & - crop_inst, photosyns_inst, canopystate_inst, & - cnveg_carbonstate_inst, cnveg_carbonflux_inst, & - c13_cnveg_carbonflux_inst, c14_cnveg_carbonflux_inst) - - if (.not. use_crop_agsys) then - call calc_crop_allocation_fractions(bounds, num_pcropp, filter_pcropp, & - crop_inst, cnveg_state_inst) - end if - - call calc_allometry(num_bgc_vegp, filter_bgc_vegp, & - cnveg_carbonflux_inst, cnveg_state_inst) - call t_stopf('cnalloc') - + !RF: moved ths call to before nutrient_demand, so that croplive didn't change half way through crop N cycle. + if(num_bgc_vegp>0)then + if ( use_fun) then + call t_startf('CNPhenology_phase1') + call CNPhenology (bounds, num_bgc_soilc, filter_bgc_soilc, num_bgc_vegp, & + filter_bgc_vegp, num_pcropp, filter_pcropp, & + waterdiagnosticbulk_inst, wateratm2lndbulk_inst, temperature_inst, atm2lnd_inst, & + crop_inst, canopystate_inst, soilstate_inst, dgvs_inst, & + cnveg_state_inst, cnveg_carbonstate_inst, cnveg_carbonflux_inst, & + cnveg_nitrogenstate_inst, cnveg_nitrogenflux_inst, & + c13_cnveg_carbonstate_inst, c14_cnveg_carbonstate_inst, & + leaf_prof_patch=soilbiogeochem_state_inst%leaf_prof_patch(begp:endp,1:nlevdecomp_full), & + froot_prof_patch=soilbiogeochem_state_inst%froot_prof_patch(begp:endp,1:nlevdecomp_full), & + phase=1) + call t_stopf('CNPhenology_phase1') + + call t_startf('CNFUNInit') + call CNFUNInit(bounds,cnveg_state_inst,cnveg_carbonstate_inst,cnveg_nitrogenstate_inst) + call t_stopf('CNFUNInit') + + end if + + call t_startf('cnalloc') + call calc_gpp_mr_availc( & + bounds, num_bgc_vegp, filter_bgc_vegp, & + crop_inst, photosyns_inst, canopystate_inst, & + cnveg_carbonstate_inst, cnveg_carbonflux_inst, & + c13_cnveg_carbonflux_inst, c14_cnveg_carbonflux_inst) + + if (.not. use_crop_agsys) then + call calc_crop_allocation_fractions(bounds, num_pcropp, filter_pcropp, & + crop_inst, cnveg_state_inst) + end if + + call calc_allometry(num_bgc_vegp, filter_bgc_vegp, & + cnveg_carbonflux_inst, cnveg_state_inst) + call t_stopf('cnalloc') + end if + call t_startf('calc_plant_nutrient_demand') ! We always call calc_plant_nutrient_demand for natural veg patches, but only call ! it for crop patches if NOT running with AgSys (since AgSys calculates the relevant @@ -522,10 +524,20 @@ subroutine CNDriverNoLeaching(bounds, ! CNphenology needs to be called after above calls, since it depends on current ! time-step fluxes to new growth on the lastlitterfall timestep in deciduous systems - - call t_startf('CNPhenology') - - if ( .not. use_fun ) then + if(num_bgc_vegp>0)then + call t_startf('CNPhenology') + if ( .not. use_fun ) then + call CNPhenology (bounds, num_bgc_soilc, filter_bgc_soilc, num_bgc_vegp, & + filter_bgc_vegp, num_pcropp, filter_pcropp, & + waterdiagnosticbulk_inst, wateratm2lndbulk_inst, temperature_inst, atm2lnd_inst, & + crop_inst, canopystate_inst, soilstate_inst, dgvs_inst, & + cnveg_state_inst, cnveg_carbonstate_inst, cnveg_carbonflux_inst, & + cnveg_nitrogenstate_inst, cnveg_nitrogenflux_inst, & + c13_cnveg_carbonstate_inst, c14_cnveg_carbonstate_inst, & + leaf_prof_patch=soilbiogeochem_state_inst%leaf_prof_patch(begp:endp,1:nlevdecomp_full), & + froot_prof_patch=soilbiogeochem_state_inst%froot_prof_patch(begp:endp,1:nlevdecomp_full), & + phase=1) + end if call CNPhenology (bounds, num_bgc_soilc, filter_bgc_soilc, num_bgc_vegp, & filter_bgc_vegp, num_pcropp, filter_pcropp, & waterdiagnosticbulk_inst, wateratm2lndbulk_inst, temperature_inst, atm2lnd_inst, & @@ -535,21 +547,10 @@ subroutine CNDriverNoLeaching(bounds, c13_cnveg_carbonstate_inst, c14_cnveg_carbonstate_inst, & leaf_prof_patch=soilbiogeochem_state_inst%leaf_prof_patch(begp:endp,1:nlevdecomp_full), & froot_prof_patch=soilbiogeochem_state_inst%froot_prof_patch(begp:endp,1:nlevdecomp_full), & - phase=1) + phase=2) + + call t_stopf('CNPhenology') end if - call CNPhenology (bounds, num_bgc_soilc, filter_bgc_soilc, num_bgc_vegp, & - filter_bgc_vegp, num_pcropp, filter_pcropp, & - waterdiagnosticbulk_inst, wateratm2lndbulk_inst, temperature_inst, atm2lnd_inst, & - crop_inst, canopystate_inst, soilstate_inst, dgvs_inst, & - cnveg_state_inst, cnveg_carbonstate_inst, cnveg_carbonflux_inst, & - cnveg_nitrogenstate_inst, cnveg_nitrogenflux_inst, & - c13_cnveg_carbonstate_inst, c14_cnveg_carbonstate_inst, & - leaf_prof_patch=soilbiogeochem_state_inst%leaf_prof_patch(begp:endp,1:nlevdecomp_full), & - froot_prof_patch=soilbiogeochem_state_inst%froot_prof_patch(begp:endp,1:nlevdecomp_full), & - phase=2) - - call t_stopf('CNPhenology') - !-------------------------------------------- ! Growth respiration !-------------------------------------------- diff --git a/src/biogeochem/CNVegCarbonFluxType.F90 b/src/biogeochem/CNVegCarbonFluxType.F90 index d376d33e16..21a4fc902c 100644 --- a/src/biogeochem/CNVegCarbonFluxType.F90 +++ b/src/biogeochem/CNVegCarbonFluxType.F90 @@ -434,17 +434,17 @@ module CNVegCarbonFluxType contains !------------------------------------------------------------------------ - subroutine Init(this, bounds, carbon_type, dribble_crophrv_xsmrpool_2atm,tot_bgc_vegp) + subroutine Init(this, bounds, carbon_type, dribble_crophrv_xsmrpool_2atm,alloc_full_veg) class(cnveg_carbonflux_type) :: this type(bounds_type), intent(in) :: bounds character(len=3) , intent(in) :: carbon_type ! one of ['c12', c13','c14'] logical , intent(in) :: dribble_crophrv_xsmrpool_2atm - integer , intent(in) :: tot_bgc_vegp + logical , intent(in) :: alloc_full_veg this%dribble_crophrv_xsmrpool_2atm = dribble_crophrv_xsmrpool_2atm - call this%InitAllocate ( bounds, carbon_type,tot_bgc_vegp) - if(tot_bgc_vegp>0)then + call this%InitAllocate ( bounds, carbon_type,alloc_full_veg) + if(alloc_full_veg)then if(use_matrixcn)then call this%InitTransfer () end if @@ -463,13 +463,13 @@ subroutine InitTransfer (this) end subroutine InitTransfer !------------------------------------------------------------------------ - subroutine InitAllocate(this, bounds, carbon_type, tot_bgc_vegp) + subroutine InitAllocate(this, bounds, carbon_type, alloc_full_veg) ! ! !ARGUMENTS: class (cnveg_carbonflux_type) :: this type(bounds_type), intent(in) :: bounds character(len=*) , intent(in) :: carbon_type ! one of ['c12', c13','c14'] - integer , intent(in) :: tot_bgc_vegp + logical , intent(in) :: alloc_full_veg ! ! !LOCAL VARIABLES: integer :: begp,endp @@ -479,7 +479,7 @@ subroutine InitAllocate(this, bounds, carbon_type, tot_bgc_vegp) character(len=:), allocatable :: carbon_type_suffix !------------------------------------------------------------------------ - if(tot_bgc_vegp>0)then + if(alloc_full_veg)then begp = bounds%begp; endp = bounds%endp begc = bounds%begc; endc = bounds%endc begg = bounds%begg; endg = bounds%endg diff --git a/src/biogeochem/CNVegCarbonStateType.F90 b/src/biogeochem/CNVegCarbonStateType.F90 index e5f08bdc9d..7515051d38 100644 --- a/src/biogeochem/CNVegCarbonStateType.F90 +++ b/src/biogeochem/CNVegCarbonStateType.F90 @@ -126,7 +126,7 @@ module CNVegCarbonStateType !------------------------------------------------------------------------ subroutine Init(this, bounds, carbon_type, ratio, NLFilename, & - dribble_crophrv_xsmrpool_2atm, tot_bgc_vegp, c12_cnveg_carbonstate_inst) + dribble_crophrv_xsmrpool_2atm, alloc_full_veg, c12_cnveg_carbonstate_inst) class(cnveg_carbonstate_type) :: this type(bounds_type) , intent(in) :: bounds @@ -134,7 +134,7 @@ subroutine Init(this, bounds, carbon_type, ratio, NLFilename, & character(len=*) , intent(in) :: carbon_type ! Carbon isotope type C12, C13 or C1 character(len=*) , intent(in) :: NLFilename ! Namelist filename logical , intent(in) :: dribble_crophrv_xsmrpool_2atm - integer , intent(in) :: tot_bgc_vegp ! total number of bgc patches (non-fates) + logical , intent(in) :: alloc_full_veg ! total number of bgc patches (non-fates) type(cnveg_carbonstate_type) , intent(in), optional :: c12_cnveg_carbonstate_inst ! cnveg_carbonstate for C12 (if C13 or C14) !----------------------------------------------------------------------- @@ -142,8 +142,8 @@ subroutine Init(this, bounds, carbon_type, ratio, NLFilename, & this%dribble_crophrv_xsmrpool_2atm = dribble_crophrv_xsmrpool_2atm - call this%InitAllocate ( bounds, tot_bgc_vegp) - if(tot_bgc_vegp>0)then + call this%InitAllocate ( bounds, alloc_full_veg) + if(alloc_full_veg)then call this%InitReadNML ( NLFilename ) call this%InitHistory ( bounds, carbon_type) if (present(c12_cnveg_carbonstate_inst)) then @@ -216,12 +216,12 @@ subroutine InitReadNML(this, NLFilename) end subroutine InitReadNML !------------------------------------------------------------------------ - subroutine InitAllocate(this, bounds, tot_bgc_vegp) + subroutine InitAllocate(this, bounds, alloc_full_veg) ! ! !ARGUMENTS: class (cnveg_carbonstate_type) :: this type(bounds_type), intent(in) :: bounds - integer,intent(in) :: tot_bgc_vegp ! Total number of bgc patches on the proc (non_fates) + logical,intent(in) :: alloc_full_veg ! Total number of bgc patches on the proc (non_fates) ! ! !LOCAL VARIABLES: integer :: begp,endp @@ -229,7 +229,7 @@ subroutine InitAllocate(this, bounds, tot_bgc_vegp) integer :: begg,endg !------------------------------------------------------------------------ - if(tot_bgc_vegp>0)then + if(alloc_full_veg)then begp = bounds%begp; endp = bounds%endp begc = bounds%begc; endc = bounds%endc begg = bounds%begg; endg = bounds%endg diff --git a/src/biogeochem/CNVegNitrogenFluxType.F90 b/src/biogeochem/CNVegNitrogenFluxType.F90 index f742cba2ad..b06ec367d0 100644 --- a/src/biogeochem/CNVegNitrogenFluxType.F90 +++ b/src/biogeochem/CNVegNitrogenFluxType.F90 @@ -292,14 +292,14 @@ module CNVegNitrogenFluxType contains !------------------------------------------------------------------------ - subroutine Init(this, bounds, tot_bgc_vegp) + subroutine Init(this, bounds, alloc_full_veg) class(cnveg_nitrogenflux_type) :: this type(bounds_type), intent(in) :: bounds - integer,intent(in) :: tot_bgc_vegp + logical,intent(in) :: alloc_full_veg - call this%InitAllocate (bounds,tot_bgc_vegp) - if(tot_bgc_vegp>0)then + call this%InitAllocate (bounds,alloc_full_veg) + if(alloc_full_veg)then if(use_matrixcn)then call this%InitTransfer () end if @@ -326,7 +326,7 @@ subroutine InitTransfer (this) end subroutine InitTransfer !------------------------------------------------------------------------ - subroutine InitAllocate(this, bounds, tot_bgc_vegp) + subroutine InitAllocate(this, bounds, alloc_full_veg) ! ! !DESCRIPTION: ! Initialize patch nitrogen flux @@ -334,7 +334,7 @@ subroutine InitAllocate(this, bounds, tot_bgc_vegp) ! !ARGUMENTS: class (cnveg_nitrogenflux_type) :: this type(bounds_type) , intent(in) :: bounds - integer,intent(in) :: tot_bgc_vegp + logical,intent(in) :: alloc_full_veg ! ! !LOCAL VARIABLES: integer :: begp,endp @@ -342,7 +342,7 @@ subroutine InitAllocate(this, bounds, tot_bgc_vegp) integer :: begg,endg !------------------------------------------------------------------------ - if(tot_bgc_vegp>0)then + if(alloc_full_veg)then begp = bounds%begp; endp = bounds%endp begc = bounds%begc; endc = bounds%endc begg = bounds%begg; endg = bounds%endg diff --git a/src/biogeochem/CNVegNitrogenStateType.F90 b/src/biogeochem/CNVegNitrogenStateType.F90 index 341cc8f40d..8983eccb4e 100644 --- a/src/biogeochem/CNVegNitrogenStateType.F90 +++ b/src/biogeochem/CNVegNitrogenStateType.F90 @@ -97,7 +97,7 @@ module CNVegNitrogenStateType !------------------------------------------------------------------------ subroutine Init(this, bounds, & leafc_patch, leafc_storage_patch, frootc_patch, frootc_storage_patch, & - deadstemc_patch, tot_bgc_vegp) + deadstemc_patch, alloc_full_veg) class(cnveg_nitrogenstate_type) :: this type(bounds_type) , intent(in) :: bounds @@ -106,10 +106,10 @@ subroutine Init(this, bounds, & real(r8) , intent(in) :: frootc_patch (:) !(begp:) real(r8) , intent(in) :: frootc_storage_patch(:) !(begp:) real(r8) , intent(in) :: deadstemc_patch (:) !(begp:) - integer , intent(in) :: tot_bgc_vegp + logical , intent(in) :: alloc_full_veg - call this%InitAllocate (bounds, tot_bgc_vegp) - if(tot_bgc_vegp>0) then + call this%InitAllocate (bounds, alloc_full_veg) + if(alloc_full_veg) then call this%InitHistory (bounds) call this%InitCold ( bounds, & leafc_patch, leafc_storage_patch, frootc_patch, frootc_storage_patch, deadstemc_patch) @@ -117,19 +117,19 @@ subroutine Init(this, bounds, & end subroutine Init !------------------------------------------------------------------------ - subroutine InitAllocate(this, bounds, tot_bgc_vegp) + subroutine InitAllocate(this, bounds, alloc_full_veg) ! ! !ARGUMENTS: class (cnveg_nitrogenstate_type) :: this type(bounds_type) , intent(in) :: bounds - integer,intent(in) :: tot_bgc_vegp + logical,intent(in) :: alloc_full_veg ! ! !LOCAL VARIABLES: integer :: begp,endp integer :: begc,endc integer :: begg,endg !------------------------------------------------------------------------ - if(tot_bgc_vegp>0) then + if(alloc_full_veg) then begp = bounds%begp; endp = bounds%endp begc = bounds%begc; endc = bounds%endc begg = bounds%begg; endg = bounds%endg @@ -1135,7 +1135,7 @@ subroutine Summary_nitrogenstate(this, bounds, num_soilc, filter_soilc, num_soil ! -------------------------------------------- ! column level summary ! -------------------------------------------- - if(associated(this%totvegn_patch))then + if(num_soilp>0)then call p2c(bounds, num_soilc, filter_soilc, & this%totvegn_patch(bounds%begp:bounds%endp), & this%totvegn_col(bounds%begc:bounds%endc)) diff --git a/src/biogeochem/CNVegStateType.F90 b/src/biogeochem/CNVegStateType.F90 index b5391c7bce..c286c0344f 100644 --- a/src/biogeochem/CNVegStateType.F90 +++ b/src/biogeochem/CNVegStateType.F90 @@ -130,22 +130,24 @@ module CNVegStateType contains !------------------------------------------------------------------------ - subroutine Init(this, bounds, tot_bgc_vegp) + subroutine Init(this, bounds, alloc_full_veg) class(cnveg_state_type) :: this type(bounds_type), intent(in) :: bounds - integer,intent(in) :: tot_bgc_vegp ! Total number of bgc patches on proc (non-fates) + logical,intent(in) :: alloc_full_veg ! Total number of bgc patches on proc (non-fates) - call this%InitAllocate ( bounds, tot_bgc_vegp) + call this%InitAllocate ( bounds, alloc_full_veg) if (use_cn) then call this%InitHistory ( bounds ) end if - call this%InitCold ( bounds ) - + if(alloc_full_veg) then !This is true if not use_fates_bgc + call this%InitCold ( bounds ) + end if + end subroutine Init !------------------------------------------------------------------------ - subroutine InitAllocate(this, bounds, tot_bgc_vegp) + subroutine InitAllocate(this, bounds, alloc_full_veg) ! ! !DESCRIPTION: ! Initialize module data structure @@ -157,7 +159,7 @@ subroutine InitAllocate(this, bounds, tot_bgc_vegp) ! !ARGUMENTS: class(cnveg_state_type) :: this type(bounds_type), intent(in) :: bounds - integer, intent(in) :: tot_bgc_vegp ! Total number of bgc patches on proc (non-fates) + logical, intent(in) :: alloc_full_veg ! Total number of bgc patches on proc (non-fates) ! ! !LOCAL VARIABLES: integer :: begp, endp @@ -165,7 +167,7 @@ subroutine InitAllocate(this, bounds, tot_bgc_vegp) logical :: allows_non_annual_delta !------------------------------------------------------------------------ - if(tot_bgc_vegp>0)then + if(alloc_full_veg)then begp = bounds%begp; endp= bounds%endp begc = bounds%begc; endc= bounds%endc else @@ -503,7 +505,7 @@ subroutine InitHistory(this, bounds) end subroutine InitHistory !----------------------------------------------------------------------- - subroutine initCold(this, bounds) + subroutine InitCold(this, bounds) ! ! !USES: ! @@ -623,7 +625,7 @@ subroutine initCold(this, bounds) this%lfc2_col(c) = 0._r8 end do - end subroutine initCold + end subroutine InitCold !------------------------------------------------------------------------ subroutine Restart(this, bounds, ncid, flag, cnveg_carbonstate, & diff --git a/src/biogeochem/CNVegStructUpdateMod.F90 b/src/biogeochem/CNVegStructUpdateMod.F90 index 01209c678f..2e8ed8539b 100644 --- a/src/biogeochem/CNVegStructUpdateMod.F90 +++ b/src/biogeochem/CNVegStructUpdateMod.F90 @@ -143,7 +143,7 @@ subroutine CNVegStructUpdate(bounds,num_soilp, filter_soilp, & dt = real( get_rad_step_size(), r8 ) ! patch loop - do fp = 1,num_soilp + do_patch:do fp = 1,num_soilp p = filter_soilp(fp) c = patch%column(p) g = patch%gridcell(p) @@ -317,7 +317,7 @@ subroutine CNVegStructUpdate(bounds,num_soilp, filter_soilp, & frac_veg_nosno_alb(p) = 0 end if - end do + end do do_patch end associate diff --git a/src/biogeochem/CNVegetationFacade.F90 b/src/biogeochem/CNVegetationFacade.F90 index 7370987e3c..61e2e9cf91 100644 --- a/src/biogeochem/CNVegetationFacade.F90 +++ b/src/biogeochem/CNVegetationFacade.F90 @@ -219,8 +219,8 @@ subroutine Init(this, bounds, NLFilename, nskip_steps, params_ncid) ! !LOCAL VARIABLES: integer :: begp, endp, ci integer :: nclumps ! number of clumps on the proc - integer :: tot_bgc_vegp ! Total number of bgc vegetation patches (non-fates) - ! on the proc + logical :: alloc_full_veg ! Signal to allocate vegetation data fully or trivialy + character(len=*), parameter :: subname = 'Init' !----------------------------------------------------------------------- @@ -230,20 +230,17 @@ subroutine Init(this, bounds, NLFilename, nskip_steps, params_ncid) ! - a single value for both column and patch, using index 0 only ! - that is why we pass the number of bgc veg patches here - nclumps = get_proc_clumps() - tot_bgc_vegp = 0 - do ci=1,nclumps - tot_bgc_vegp = tot_bgc_vegp + filter(ci)%num_bgc_vegp - end do - if(tot_bgc_vegp>0)then - begp = bounds%begp - endp = bounds%endp - else + if(use_fates_bgc)then + alloc_full_veg=.false. begp = 0 endp = 0 + else + alloc_full_veg=.true. + begp = bounds%begp + endp = bounds%endp end if - call this%cnveg_state_inst%Init(bounds,tot_bgc_vegp) + call this%cnveg_state_inst%Init(bounds,alloc_full_veg) skip_steps = nskip_steps @@ -256,28 +253,28 @@ subroutine Init(this, bounds, NLFilename, nskip_steps, params_ncid) if(use_cn.or.use_fates_bgc)then call this%cnveg_carbonstate_inst%Init(bounds, carbon_type='c12', ratio=1._r8, & NLFilename=NLFilename, dribble_crophrv_xsmrpool_2atm=this%dribble_crophrv_xsmrpool_2atm, & - tot_bgc_vegp=tot_bgc_vegp) + alloc_full_veg=alloc_full_veg) if (use_c13) then call this%c13_cnveg_carbonstate_inst%Init(bounds, carbon_type='c13', ratio=c13ratio, & NLFilename=NLFilename, dribble_crophrv_xsmrpool_2atm=this%dribble_crophrv_xsmrpool_2atm, & - tot_bgc_vegp=tot_bgc_vegp, c12_cnveg_carbonstate_inst=this%cnveg_carbonstate_inst) + alloc_full_veg=alloc_full_veg, c12_cnveg_carbonstate_inst=this%cnveg_carbonstate_inst) end if if (use_c14) then call this%c14_cnveg_carbonstate_inst%Init(bounds, carbon_type='c14', ratio=c14ratio, & NLFilename=NLFilename, dribble_crophrv_xsmrpool_2atm=this%dribble_crophrv_xsmrpool_2atm, & - tot_bgc_vegp=tot_bgc_vegp,c12_cnveg_carbonstate_inst=this%cnveg_carbonstate_inst) + alloc_full_veg=alloc_full_veg,c12_cnveg_carbonstate_inst=this%cnveg_carbonstate_inst) end if call this%cnveg_carbonflux_inst%Init(bounds, carbon_type='c12', & - dribble_crophrv_xsmrpool_2atm=this%dribble_crophrv_xsmrpool_2atm, tot_bgc_vegp=tot_bgc_vegp ) + dribble_crophrv_xsmrpool_2atm=this%dribble_crophrv_xsmrpool_2atm, alloc_full_veg=alloc_full_veg ) if (use_c13) then call this%c13_cnveg_carbonflux_inst%Init(bounds, carbon_type='c13', & - dribble_crophrv_xsmrpool_2atm=this%dribble_crophrv_xsmrpool_2atm,tot_bgc_vegp=tot_bgc_vegp) + dribble_crophrv_xsmrpool_2atm=this%dribble_crophrv_xsmrpool_2atm,alloc_full_veg=alloc_full_veg) end if if (use_c14) then call this%c14_cnveg_carbonflux_inst%Init(bounds, carbon_type='c14', & - dribble_crophrv_xsmrpool_2atm=this%dribble_crophrv_xsmrpool_2atm,tot_bgc_vegp=tot_bgc_vegp) + dribble_crophrv_xsmrpool_2atm=this%dribble_crophrv_xsmrpool_2atm,alloc_full_veg=alloc_full_veg) end if call this%cnveg_nitrogenstate_inst%Init(bounds, & this%cnveg_carbonstate_inst%leafc_patch(begp:endp), & @@ -285,8 +282,8 @@ subroutine Init(this, bounds, NLFilename, nskip_steps, params_ncid) this%cnveg_carbonstate_inst%frootc_patch(begp:endp), & this%cnveg_carbonstate_inst%frootc_storage_patch(begp:endp), & this%cnveg_carbonstate_inst%deadstemc_patch(begp:endp), & - tot_bgc_vegp=tot_bgc_vegp) - call this%cnveg_nitrogenflux_inst%Init(bounds,tot_bgc_vegp=tot_bgc_vegp) + alloc_full_veg=alloc_full_veg) + call this%cnveg_nitrogenflux_inst%Init(bounds,alloc_full_veg=alloc_full_veg) call this%c_products_inst%Init(bounds, species_non_isotope_type('C')) if (use_c13) then @@ -1167,13 +1164,14 @@ subroutine EcosystemDynamicsPostDrainage(this, bounds, num_allc, filter_allc, & ! On the radiation time step, use C state variables to calculate ! vegetation structure (LAI, SAI, height) - - if (doalb) then - call CNVegStructUpdate(bounds,num_bgc_vegp, filter_bgc_vegp, & - waterdiagnosticbulk_inst, frictionvel_inst, this%dgvs_inst, this%cnveg_state_inst, & - crop_inst, this%cnveg_carbonstate_inst, canopystate_inst) + if(num_bgc_vegp>0)then + if (doalb) then + call CNVegStructUpdate(bounds,num_bgc_vegp, filter_bgc_vegp, & + waterdiagnosticbulk_inst, frictionvel_inst, this%dgvs_inst, this%cnveg_state_inst, & + crop_inst, this%cnveg_carbonstate_inst, canopystate_inst) + end if end if - + end subroutine EcosystemDynamicsPostDrainage !----------------------------------------------------------------------- From 6925f8cc972acd7aaf0999080717c72fabe69e8f Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Mon, 14 Aug 2023 17:15:17 -0600 Subject: [PATCH 179/257] Update fates external pointer to the fates bgc call sequence tag --- Externals_CLM.cfg | 4 ++-- src/biogeochem/CNProductsMod.F90 | 8 ++++---- 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/Externals_CLM.cfg b/Externals_CLM.cfg index 883416a43b..c540fe8b0c 100644 --- a/Externals_CLM.cfg +++ b/Externals_CLM.cfg @@ -1,8 +1,8 @@ [fates] local_path = src/fates protocol = git -repo_url = https://github.com/rgknox/fates -branch = clm-cbalance +repo_url = https://github.com/NGEET/fates +tag = sci.1.67.1_api.27.0.0 required = True [externals_description] diff --git a/src/biogeochem/CNProductsMod.F90 b/src/biogeochem/CNProductsMod.F90 index 19ae952c9a..4ef5c7c86f 100644 --- a/src/biogeochem/CNProductsMod.F90 +++ b/src/biogeochem/CNProductsMod.F90 @@ -792,15 +792,15 @@ subroutine ComputeProductSummaryVars(this, bounds) this%prod10_grc(g) = this%prod10_grc(g) + this%dwt_prod10_gain_grc(g)*dt this%prod100_grc(g) = this%prod100_grc(g) + this%dwt_prod100_gain_grc(g)*dt + ! fluxes into wood & grain product pools, from gross unrepresented landcover change + this%prod10_grc(g) = this%prod10_grc(g) + this%gru_prod10_gain_grc(g)*dt + this%prod100_grc(g) = this%prod100_grc(g) + this%gru_prod100_gain_grc(g)*dt + ! fluxes into wood & crop product pools, from harvest this%cropprod1_grc(g) = this%cropprod1_grc(g) + this%crop_harvest_to_cropprod1_grc(g)*dt this%prod10_grc(g) = this%prod10_grc(g) + this%hrv_deadstem_to_prod10_grc(g)*dt this%prod100_grc(g) = this%prod100_grc(g) + this%hrv_deadstem_to_prod100_grc(g)*dt - ! fluxes into wood & grain product pools, from gross unrepresented landcover change - this%prod10_grc(g) = this%prod10_grc(g) + this%gru_prod10_gain_grc(g)*dt - this%prod100_grc(g) = this%prod100_grc(g) + this%gru_prod100_gain_grc(g)*dt - ! fluxes out of wood & crop product pools, from decomposition this%cropprod1_grc(g) = this%cropprod1_grc(g) - this%cropprod1_loss_grc(g)*dt this%prod10_grc(g) = this%prod10_grc(g) - this%prod10_loss_grc(g)*dt From 1ccf0d9a80cc8100df235bb2337f7e478c0420a0 Mon Sep 17 00:00:00 2001 From: Ryan Knox Date: Mon, 14 Aug 2023 19:39:10 -0400 Subject: [PATCH 180/257] update changelog --- doc/ChangeLog | 78 +++++++++++++++++++++++++++++++++++++++++++++++++++ doc/ChangeSum | 1 + 2 files changed, 79 insertions(+) diff --git a/doc/ChangeLog b/doc/ChangeLog index e65560d5c3..9d3c5b1564 100644 --- a/doc/ChangeLog +++ b/doc/ChangeLog @@ -1,4 +1,82 @@ =============================================================== +Tag name: ctsm5.1.dev134 +Originator(s): rgknox (Ryan Knox,LBNL EESA), erik (Erik Kluzek,UCAR/TSS,303-497-1326) +Date: Mon Aug 14 07:19:59 PM EDT 2023 +One-line Summary: Migration of FATES to share normal soil BGC call sequence and functionality + +Purpose and description of changes +---------------------------------- + +This set of changes enables the normal soil biogeochemistry that is used for CN, to be used for FATES as well. FATES had been using a simplified subset of soil biogeochemistry in its own module. This change required coordination of litter flux and methane boundary conditions from FATES to CLM. CNVEG datastructures were given trivial allocation (of size one on index zero) to prevent inappropriate use of CNVEG datastructures while FATES is active. Note that now the carbon balance checking for the soil is now active when FATES is active. Various accomodations have also been put in place to enable nitrogen cycling between the two models. + + +Significant changes to scientifically-supported configurations +-------------------------------------------------------------- + +Does this tag change answers significantly for any of the following physics configurations? +(Details of any changes will be given in the "Answer changes" section below.) + + [Put an [X] in the box for any configuration with significant answer changes.] + +[ ] clm5_1 + +[ ] clm5_0 + +[ ] ctsm5_0-nwp + +[ ] clm4_5 + + +Bugs fixed or introduced +------------------------ +Surprisingly, nvhpc tests are now working, but it may just be coincidental. All existing aux_clm tests are passing. Tests without FATES are b4b, with roundoff differences in just TOTCOLC and TOTCOLN. + +CTSM issues fixed (include CTSM Issue #): + +Known bugs introduced in this tag (include issue #): + +Notes of particular relevance for users +--------------------------------------- +A CLM-FATES simulation will turn on nitrogen supplementation, this enables sufficient immobilization and decomposition. Until FATES and CLM can handle fully coupled nitrogen exchange, which would include root uptake of the mineralized aqueous forms (NH4 and NO3), N limitations in the soil are meaningless when FATES is on. + +Caveats for users (e.g., need to interpolate initial conditions): + +Changes to CTSM's user interface (e.g., new/renamed XML or namelist variables): + +Changes made to namelist defaults (e.g., changed parameter values): FATES runs now supplement N + +Changes to the datasets (e.g., parameter, surface or initial files): + +Substantial timing or memory changes: +[e.g., check PFS test in the test suite and look at timings, if you +expect possible significant timing changes] + + +Testing summary: +---------------- + +aux_clm test run on cheyenne and izumi. See: + +izumi: OK /scratch/cluster/rgknox/tests_0814-095624iz +cheyenne: OK /glade/scratch/rgknox/tests_0814-134713ch + + +Answer changes +-------------- + +Changes answers relative to baseline: + +Baseline changes will be reported for many tests, all tests were combed to identify RMS diffs, all non-FATES tests had at most, roundoff level ( Date: Mon, 14 Aug 2023 18:00:38 -0600 Subject: [PATCH 181/257] Reverse hist field strings such as MET_LIT to LIT_MET --- .../SoilBiogeochemDecompCascadeBGCMod.F90 | 12 ++++++------ .../SoilBiogeochemDecompCascadeMIMICSMod.F90 | 14 +++++++------- 2 files changed, 13 insertions(+), 13 deletions(-) diff --git a/src/soilbiogeochem/SoilBiogeochemDecompCascadeBGCMod.F90 b/src/soilbiogeochem/SoilBiogeochemDecompCascadeBGCMod.F90 index b65fc5f17f..b30e3d5d2d 100644 --- a/src/soilbiogeochem/SoilBiogeochemDecompCascadeBGCMod.F90 +++ b/src/soilbiogeochem/SoilBiogeochemDecompCascadeBGCMod.F90 @@ -311,7 +311,7 @@ subroutine init_decompcascade_bgc(bounds, soilbiogeochem_state_inst, soilstate_i i_met_lit = i_litr_min floating_cn_ratio_decomp_pools(i_met_lit) = .true. decomp_cascade_con%decomp_pool_name_restart(i_met_lit) = 'litr1' - decomp_cascade_con%decomp_pool_name_history(i_met_lit) = 'MET_LIT' + decomp_cascade_con%decomp_pool_name_history(i_met_lit) = 'LIT_MET' decomp_cascade_con%decomp_pool_name_long(i_met_lit) = 'metabolic litter' decomp_cascade_con%decomp_pool_name_short(i_met_lit) = 'L1' is_litter(i_met_lit) = .true. @@ -326,7 +326,7 @@ subroutine init_decompcascade_bgc(bounds, soilbiogeochem_state_inst, soilstate_i i_cel_lit = i_met_lit + 1 floating_cn_ratio_decomp_pools(i_cel_lit) = .true. decomp_cascade_con%decomp_pool_name_restart(i_cel_lit) = 'litr2' - decomp_cascade_con%decomp_pool_name_history(i_cel_lit) = 'CEL_LIT' + decomp_cascade_con%decomp_pool_name_history(i_cel_lit) = 'LIT_CEL' decomp_cascade_con%decomp_pool_name_long(i_cel_lit) = 'cellulosic litter' decomp_cascade_con%decomp_pool_name_short(i_cel_lit) = 'L2' is_litter(i_cel_lit) = .true. @@ -341,7 +341,7 @@ subroutine init_decompcascade_bgc(bounds, soilbiogeochem_state_inst, soilstate_i i_lig_lit = i_cel_lit + 1 floating_cn_ratio_decomp_pools(i_lig_lit) = .true. decomp_cascade_con%decomp_pool_name_restart(i_lig_lit) = 'litr3' - decomp_cascade_con%decomp_pool_name_history(i_lig_lit) = 'LIG_LIT' + decomp_cascade_con%decomp_pool_name_history(i_lig_lit) = 'LIT_LIG' decomp_cascade_con%decomp_pool_name_long(i_lig_lit) = 'lignin litter' decomp_cascade_con%decomp_pool_name_short(i_lig_lit) = 'L3' is_litter(i_lig_lit) = .true. @@ -366,7 +366,7 @@ subroutine init_decompcascade_bgc(bounds, soilbiogeochem_state_inst, soilstate_i i_act_som = i_lig_lit + 1 floating_cn_ratio_decomp_pools(i_act_som) = .false. decomp_cascade_con%decomp_pool_name_restart(i_act_som) = 'soil1' - decomp_cascade_con%decomp_pool_name_history(i_act_som) = 'ACT_SOM' + decomp_cascade_con%decomp_pool_name_history(i_act_som) = 'SOM_ACT' decomp_cascade_con%decomp_pool_name_long(i_act_som) = 'active soil organic matter' decomp_cascade_con%decomp_pool_name_short(i_act_som) = 'S1' is_litter(i_act_som) = .false. @@ -381,7 +381,7 @@ subroutine init_decompcascade_bgc(bounds, soilbiogeochem_state_inst, soilstate_i i_slo_som = i_act_som + 1 floating_cn_ratio_decomp_pools(i_slo_som) = .false. decomp_cascade_con%decomp_pool_name_restart(i_slo_som) = 'soil2' - decomp_cascade_con%decomp_pool_name_history(i_slo_som) = 'SLO_SOM' + decomp_cascade_con%decomp_pool_name_history(i_slo_som) = 'SOM_SLO' decomp_cascade_con%decomp_pool_name_long(i_slo_som) = 'slow soil organic matter' decomp_cascade_con%decomp_pool_name_short(i_slo_som) = 'S2' is_litter(i_slo_som) = .false. @@ -396,7 +396,7 @@ subroutine init_decompcascade_bgc(bounds, soilbiogeochem_state_inst, soilstate_i i_pas_som = i_slo_som + 1 floating_cn_ratio_decomp_pools(i_pas_som) = .false. decomp_cascade_con%decomp_pool_name_restart(i_pas_som) = 'soil3' - decomp_cascade_con%decomp_pool_name_history(i_pas_som) = 'PAS_SOM' + decomp_cascade_con%decomp_pool_name_history(i_pas_som) = 'SOM_PAS' decomp_cascade_con%decomp_pool_name_long(i_pas_som) = 'passive soil organic matter' decomp_cascade_con%decomp_pool_name_short(i_pas_som) = 'S3' is_litter(i_pas_som) = .false. diff --git a/src/soilbiogeochem/SoilBiogeochemDecompCascadeMIMICSMod.F90 b/src/soilbiogeochem/SoilBiogeochemDecompCascadeMIMICSMod.F90 index f820db01b6..bcbd5e8cdd 100644 --- a/src/soilbiogeochem/SoilBiogeochemDecompCascadeMIMICSMod.F90 +++ b/src/soilbiogeochem/SoilBiogeochemDecompCascadeMIMICSMod.F90 @@ -481,7 +481,7 @@ subroutine init_decompcascade_mimics(bounds, soilbiogeochem_state_inst, soilstat i_met_lit = i_litr_min floating_cn_ratio_decomp_pools(i_met_lit) = .true. decomp_cascade_con%decomp_pool_name_restart(i_met_lit) = 'litr1' - decomp_cascade_con%decomp_pool_name_history(i_met_lit) = 'MET_LIT' + decomp_cascade_con%decomp_pool_name_history(i_met_lit) = 'LIT_MET' decomp_cascade_con%decomp_pool_name_long(i_met_lit) = 'metabolic litter' decomp_cascade_con%decomp_pool_name_short(i_met_lit) = 'L1' is_microbe(i_met_lit) = .false. @@ -497,7 +497,7 @@ subroutine init_decompcascade_mimics(bounds, soilbiogeochem_state_inst, soilstat i_str_lit = i_met_lit + 1 floating_cn_ratio_decomp_pools(i_str_lit) = .true. decomp_cascade_con%decomp_pool_name_restart(i_str_lit) = 'litr2' - decomp_cascade_con%decomp_pool_name_history(i_str_lit) = 'STR_LIT' + decomp_cascade_con%decomp_pool_name_history(i_str_lit) = 'LIT_STR' decomp_cascade_con%decomp_pool_name_long(i_str_lit) = 'structural litter' decomp_cascade_con%decomp_pool_name_short(i_str_lit) = 'L2' is_microbe(i_str_lit) = .false. @@ -523,7 +523,7 @@ subroutine init_decompcascade_mimics(bounds, soilbiogeochem_state_inst, soilstat i_avl_som = i_str_lit + 1 floating_cn_ratio_decomp_pools(i_avl_som) = .true. decomp_cascade_con%decomp_pool_name_restart(i_avl_som) = 'soil1' - decomp_cascade_con%decomp_pool_name_history(i_avl_som) = 'AVL_SOM' + decomp_cascade_con%decomp_pool_name_history(i_avl_som) = 'SOM_AVL' decomp_cascade_con%decomp_pool_name_long(i_avl_som) = 'available soil organic matter' decomp_cascade_con%decomp_pool_name_short(i_avl_som) = 'S1' is_microbe(i_avl_som) = .false. @@ -539,7 +539,7 @@ subroutine init_decompcascade_mimics(bounds, soilbiogeochem_state_inst, soilstat i_chem_som = i_avl_som + 1 floating_cn_ratio_decomp_pools(i_chem_som) = .true. decomp_cascade_con%decomp_pool_name_restart(i_chem_som) = 'soil2' - decomp_cascade_con%decomp_pool_name_history(i_chem_som) = 'CHEM_SOM' + decomp_cascade_con%decomp_pool_name_history(i_chem_som) = 'SOM_CHEM' decomp_cascade_con%decomp_pool_name_long(i_chem_som) = 'chemically protected soil organic matter' decomp_cascade_con%decomp_pool_name_short(i_chem_som) = 'S2' is_microbe(i_chem_som) = .false. @@ -555,7 +555,7 @@ subroutine init_decompcascade_mimics(bounds, soilbiogeochem_state_inst, soilstat i_phys_som = i_chem_som + 1 floating_cn_ratio_decomp_pools(i_phys_som) = .true. decomp_cascade_con%decomp_pool_name_restart(i_phys_som) = 'soil3' - decomp_cascade_con%decomp_pool_name_history(i_phys_som) = 'PHYS_SOM' + decomp_cascade_con%decomp_pool_name_history(i_phys_som) = 'SOM_PHYS' decomp_cascade_con%decomp_pool_name_long(i_phys_som) = 'physically protected soil organic matter' decomp_cascade_con%decomp_pool_name_short(i_phys_som) = 'S3' is_microbe(i_phys_som) = .false. @@ -571,7 +571,7 @@ subroutine init_decompcascade_mimics(bounds, soilbiogeochem_state_inst, soilstat i_cop_mic = i_phys_som + 1 floating_cn_ratio_decomp_pools(i_cop_mic) = .true. decomp_cascade_con%decomp_pool_name_restart(i_cop_mic) = 'micr1' - decomp_cascade_con%decomp_pool_name_history(i_cop_mic) = 'COP_MIC' + decomp_cascade_con%decomp_pool_name_history(i_cop_mic) = 'MIC_COP' decomp_cascade_con%decomp_pool_name_long(i_cop_mic) = 'copiotrophic microbes' decomp_cascade_con%decomp_pool_name_short(i_cop_mic) = 'M1' is_microbe(i_cop_mic) = .true. @@ -587,7 +587,7 @@ subroutine init_decompcascade_mimics(bounds, soilbiogeochem_state_inst, soilstat i_oli_mic = i_cop_mic + 1 floating_cn_ratio_decomp_pools(i_oli_mic) = .true. decomp_cascade_con%decomp_pool_name_restart(i_oli_mic) = 'micr2' - decomp_cascade_con%decomp_pool_name_history(i_oli_mic) = 'OLI_MIC' + decomp_cascade_con%decomp_pool_name_history(i_oli_mic) = 'MIC_OLI' decomp_cascade_con%decomp_pool_name_long(i_oli_mic) = 'oligotrophic microbes' decomp_cascade_con%decomp_pool_name_short(i_oli_mic) = 'M2' is_microbe(i_oli_mic) = .true. From 2fb7513e6c7d86a4c43d16e0d3e39b3cc0c964ab Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Mon, 14 Aug 2023 18:04:29 -0600 Subject: [PATCH 182/257] Change C or N to _C and _N after hist field strings like LIT_MET --- src/biogeochem/CNVegCarbonFluxType.F90 | 12 +++++------ src/biogeochem/CNVegNitrogenFluxType.F90 | 4 ++-- .../SoilBiogeochemCarbonFluxType.F90 | 20 +++++++++---------- .../SoilBiogeochemCarbonStateType.F90 | 16 +++++++-------- .../SoilBiogeochemNitrogenFluxType.F90 | 16 +++++++-------- .../SoilBiogeochemNitrogenStateType.F90 | 6 +++--- 6 files changed, 37 insertions(+), 37 deletions(-) diff --git a/src/biogeochem/CNVegCarbonFluxType.F90 b/src/biogeochem/CNVegCarbonFluxType.F90 index c2025fca47..e6542a3452 100644 --- a/src/biogeochem/CNVegCarbonFluxType.F90 +++ b/src/biogeochem/CNVegCarbonFluxType.F90 @@ -2958,7 +2958,7 @@ subroutine InitHistory(this, bounds, carbon_type) do k = 1, ndecomp_pools if ( decomp_cascade_con%is_litter(k) .or. decomp_cascade_con%is_cwd(k) ) then data1dptr => this%m_decomp_cpools_to_fire_col(:,k) - fieldname = 'M_'//trim(decomp_cascade_con%decomp_pool_name_history(k))//'C_TO_FIRE' + fieldname = 'M_'//trim(decomp_cascade_con%decomp_pool_name_history(k))//'_C_TO_FIRE' longname = trim(decomp_cascade_con%decomp_pool_name_long(k))//' C fire loss' call hist_addfld1d (fname=fieldname, units='gC/m^2/s', & avgflag='A', long_name=longname, & @@ -2966,7 +2966,7 @@ subroutine InitHistory(this, bounds, carbon_type) if ( nlevdecomp_full > 1 ) then data2dptr => this%m_decomp_cpools_to_fire_vr_col(:,:,k) - fieldname = 'M_'//trim(decomp_cascade_con%decomp_pool_name_history(k))//'C_TO_FIRE'//trim(vr_suffix) + fieldname = 'M_'//trim(decomp_cascade_con%decomp_pool_name_history(k))//'_C_TO_FIRE'//trim(vr_suffix) longname = trim(decomp_cascade_con%decomp_pool_name_long(k))//' C fire loss' call hist_addfld_decomp (fname=fieldname, units='gC/m^3/s', type2d='levdcmp', & avgflag='A', long_name=longname, & @@ -3167,7 +3167,7 @@ subroutine InitHistory(this, bounds, carbon_type) do k = 1, ndecomp_pools if ( decomp_cascade_con%is_litter(k) .or. decomp_cascade_con%is_cwd(k) ) then data1dptr => this%m_decomp_cpools_to_fire_col(:,k) - fieldname = 'C13_M_'//trim(decomp_cascade_con%decomp_pool_name_history(k))//'C_TO_FIRE' + fieldname = 'C13_M_'//trim(decomp_cascade_con%decomp_pool_name_history(k))//'_C_TO_FIRE' longname = 'C13 '//trim(decomp_cascade_con%decomp_pool_name_long(k))//' C fire loss' call hist_addfld1d (fname=fieldname, units='gC13/m^2', & avgflag='A', long_name=longname, & @@ -3175,7 +3175,7 @@ subroutine InitHistory(this, bounds, carbon_type) if ( nlevdecomp_full > 1 ) then data2dptr => this%m_decomp_cpools_to_fire_vr_col(:,:,k) - fieldname = 'C13_M_'//trim(decomp_cascade_con%decomp_pool_name_history(k))//'C_TO_FIRE'//trim(vr_suffix) + fieldname = 'C13_M_'//trim(decomp_cascade_con%decomp_pool_name_history(k))//'_C_TO_FIRE'//trim(vr_suffix) longname = 'C13 '//trim(decomp_cascade_con%decomp_pool_name_long(k))//' C fire loss' call hist_addfld_decomp (fname=fieldname, units='gC13/m^3', type2d='levdcmp', & avgflag='A', long_name=longname, & @@ -3327,7 +3327,7 @@ subroutine InitHistory(this, bounds, carbon_type) do k = 1, ndecomp_pools if ( decomp_cascade_con%is_litter(k) .or. decomp_cascade_con%is_cwd(k) ) then data1dptr => this%m_decomp_cpools_to_fire_col(:,k) - fieldname = 'C14_M_'//trim(decomp_cascade_con%decomp_pool_name_history(k))//'C_TO_FIRE' + fieldname = 'C14_M_'//trim(decomp_cascade_con%decomp_pool_name_history(k))//'_C_TO_FIRE' longname = 'C14 '//trim(decomp_cascade_con%decomp_pool_name_long(k))//' C fire loss' call hist_addfld1d (fname=fieldname, units='gC14/m^2', & avgflag='A', long_name=longname, & @@ -3335,7 +3335,7 @@ subroutine InitHistory(this, bounds, carbon_type) if ( nlevdecomp_full > 1 ) then data2dptr => this%m_decomp_cpools_to_fire_vr_col(:,:,k) - fieldname = 'C14_M_'//trim(decomp_cascade_con%decomp_pool_name_history(k))//'C_TO_FIRE'//trim(vr_suffix) + fieldname = 'C14_M_'//trim(decomp_cascade_con%decomp_pool_name_history(k))//'_C_TO_FIRE'//trim(vr_suffix) longname = 'C14 '//trim(decomp_cascade_con%decomp_pool_name_long(k))//' C fire loss' call hist_addfld_decomp (fname=fieldname, units='gC14/m^3', type2d='levdcmp', & avgflag='A', long_name=longname, & diff --git a/src/biogeochem/CNVegNitrogenFluxType.F90 b/src/biogeochem/CNVegNitrogenFluxType.F90 index ce164b4c37..aad3228ef1 100644 --- a/src/biogeochem/CNVegNitrogenFluxType.F90 +++ b/src/biogeochem/CNVegNitrogenFluxType.F90 @@ -1048,7 +1048,7 @@ subroutine InitHistory(this, bounds) if ( decomp_cascade_con%is_litter(k) .or. decomp_cascade_con%is_cwd(k) ) then this%m_decomp_npools_to_fire_col(begc:endc,k) = spval data1dptr => this%m_decomp_npools_to_fire_col(:,k) - fieldname = 'M_'//trim(decomp_cascade_con%decomp_pool_name_history(k))//'N_TO_FIRE' + fieldname = 'M_'//trim(decomp_cascade_con%decomp_pool_name_history(k))//'_N_TO_FIRE' longname = trim(decomp_cascade_con%decomp_pool_name_long(k))//' N fire loss' call hist_addfld1d (fname=fieldname, units='gN/m^2', & avgflag='A', long_name=longname, & @@ -1057,7 +1057,7 @@ subroutine InitHistory(this, bounds) if ( nlevdecomp_full > 1 ) then this%m_decomp_npools_to_fire_vr_col(begc:endc,:,k) = spval data2dptr => this%m_decomp_npools_to_fire_vr_col(:,:,k) - fieldname = 'M_'//trim(decomp_cascade_con%decomp_pool_name_history(k))//'N_TO_FIRE'//trim(vr_suffix) + fieldname = 'M_'//trim(decomp_cascade_con%decomp_pool_name_history(k))//'_N_TO_FIRE'//trim(vr_suffix) longname = trim(decomp_cascade_con%decomp_pool_name_long(k))//' N fire loss' call hist_addfld_decomp (fname=fieldname, units='gN/m^3', type2d='levdcmp', & avgflag='A', long_name=longname, & diff --git a/src/soilbiogeochem/SoilBiogeochemCarbonFluxType.F90 b/src/soilbiogeochem/SoilBiogeochemCarbonFluxType.F90 index 114019a3d7..bb8efed09b 100644 --- a/src/soilbiogeochem/SoilBiogeochemCarbonFluxType.F90 +++ b/src/soilbiogeochem/SoilBiogeochemCarbonFluxType.F90 @@ -315,8 +315,8 @@ subroutine InitHistory(this, bounds, carbon_type) if ( decomp_cascade_con%cascade_receiver_pool(l) /= 0 ) then data1dptr => this%decomp_cascade_ctransfer_col(:,l) fieldname = & - trim(decomp_cascade_con%decomp_pool_name_history(decomp_cascade_con%cascade_donor_pool(l)))//'C_TO_'//& - trim(decomp_cascade_con%decomp_pool_name_history(decomp_cascade_con%cascade_receiver_pool(l)))//'C' + trim(decomp_cascade_con%decomp_pool_name_history(decomp_cascade_con%cascade_donor_pool(l)))//'_C_TO_'//& + trim(decomp_cascade_con%decomp_pool_name_history(decomp_cascade_con%cascade_receiver_pool(l)))//'_C' longname = 'decomp. of '//trim(decomp_cascade_con%decomp_pool_name_long(decomp_cascade_con%cascade_donor_pool(l)))//& ' C to '//trim(decomp_cascade_con%decomp_pool_name_long(decomp_cascade_con%cascade_receiver_pool(l)))//' C' call hist_addfld1d (fname=fieldname, units='gC/m^2/s', & @@ -353,9 +353,9 @@ subroutine InitHistory(this, bounds, carbon_type) if ( decomp_cascade_con%cascade_receiver_pool(l) /= 0 ) then data2dptr => this%decomp_cascade_ctransfer_vr_col(:,:,l) fieldname = & - trim(decomp_cascade_con%decomp_pool_name_history(decomp_cascade_con%cascade_donor_pool(l)))//'C_TO_'//& + trim(decomp_cascade_con%decomp_pool_name_history(decomp_cascade_con%cascade_donor_pool(l)))//'_C_TO_'//& trim(decomp_cascade_con%decomp_pool_name_history(decomp_cascade_con%cascade_receiver_pool(l)))& - //'C'//trim(vr_suffix) + //'_C'//trim(vr_suffix) longname = 'decomp. of '//& trim(decomp_cascade_con%decomp_pool_name_long(decomp_cascade_con%cascade_donor_pool(l)))//& ' C to '//& @@ -423,14 +423,14 @@ subroutine InitHistory(this, bounds, carbon_type) do k = 1, ndecomp_pools ! none from CWD if ( .not. decomp_cascade_con%is_cwd(k) ) then data1dptr => this%decomp_cpools_leached_col(:,k) - fieldname = 'M_'//trim(decomp_cascade_con%decomp_pool_name_history(k))//'C_TO_LEACHING' + fieldname = 'M_'//trim(decomp_cascade_con%decomp_pool_name_history(k))//'_C_TO_LEACHING' longname = trim(decomp_cascade_con%decomp_pool_name_long(k))//' C leaching loss' call hist_addfld1d (fname=fieldname, units='gC/m^2/s', & avgflag='A', long_name=longname, & ptr_col=data1dptr, default='inactive') data2dptr => this%decomp_cpools_transport_tendency_col(:,:,k) - fieldname = trim(decomp_cascade_con%decomp_pool_name_history(k))//'C_TNDNCY_VERT_TRANSPORT' + fieldname = trim(decomp_cascade_con%decomp_pool_name_history(k))//'_C_TNDNCY_VERT_TRANSPORT' longname = trim(decomp_cascade_con%decomp_pool_name_long(k))//' C tendency due to vertical transport' call hist_addfld_decomp (fname=fieldname, units='gC/m^3/s', type2d='levdcmp', & avgflag='A', long_name=longname, & @@ -513,9 +513,9 @@ subroutine InitHistory(this, bounds, carbon_type) data2dptr => this%decomp_cascade_ctransfer_vr_col(:,:,l) fieldname = 'C13_'//& trim(decomp_cascade_con%decomp_pool_name_history(decomp_cascade_con%cascade_donor_pool(l)))& - //'C_TO_'//& + //'_C_TO_'//& trim(decomp_cascade_con%decomp_pool_name_history(decomp_cascade_con%cascade_receiver_pool(l)))& - //'C'//trim(vr_suffix) + //'_C'//trim(vr_suffix) longname = 'C13 decomp. of '& //trim(decomp_cascade_con%decomp_pool_name_long(decomp_cascade_con%cascade_donor_pool(l)))& //' C to '//& @@ -597,9 +597,9 @@ subroutine InitHistory(this, bounds, carbon_type) fieldname = 'C14_'//& trim(decomp_cascade_con%decomp_pool_name_history(decomp_cascade_con%cascade_donor_pool(l)))& - //'C_TO_'//& + //'_C_TO_'//& trim(decomp_cascade_con%decomp_pool_name_history(decomp_cascade_con%cascade_receiver_pool(l)))& - //'C'//trim(vr_suffix) + //'_C'//trim(vr_suffix) longname = 'C14 decomp. of '& //trim(decomp_cascade_con%decomp_pool_name_long(decomp_cascade_con%cascade_donor_pool(l)))//& ' C to '//trim(decomp_cascade_con%decomp_pool_name_long(decomp_cascade_con%cascade_receiver_pool(l)))//' C' diff --git a/src/soilbiogeochem/SoilBiogeochemCarbonStateType.F90 b/src/soilbiogeochem/SoilBiogeochemCarbonStateType.F90 index a09441069a..f5da1b8a14 100644 --- a/src/soilbiogeochem/SoilBiogeochemCarbonStateType.F90 +++ b/src/soilbiogeochem/SoilBiogeochemCarbonStateType.F90 @@ -169,7 +169,7 @@ subroutine InitHistory(this, bounds, carbon_type) do l = 1, ndecomp_pools if ( nlevdecomp_full > 1 ) then data2dptr => this%decomp_cpools_vr_col(:,1:nlevsoi,l) - fieldname = trim(decomp_cascade_con%decomp_pool_name_history(l))//'C_vr' + fieldname = trim(decomp_cascade_con%decomp_pool_name_history(l))//'_C_vr' longname = trim(decomp_cascade_con%decomp_pool_name_history(l))//' C (vertically resolved)' call hist_addfld2d (fname=fieldname, units='gC/m^3', type2d='levsoi', & avgflag='A', long_name=longname, & @@ -177,7 +177,7 @@ subroutine InitHistory(this, bounds, carbon_type) endif data1dptr => this%decomp_cpools_col(:,l) - fieldname = trim(decomp_cascade_con%decomp_pool_name_history(l))//'C' + fieldname = trim(decomp_cascade_con%decomp_pool_name_history(l))//'_C' longname = trim(decomp_cascade_con%decomp_pool_name_history(l))//' C' call hist_addfld1d (fname=fieldname, units='gC/m^2', & avgflag='A', long_name=longname, & @@ -185,7 +185,7 @@ subroutine InitHistory(this, bounds, carbon_type) if ( nlevdecomp_full > 1 ) then data1dptr => this%decomp_cpools_1m_col(:,l) - fieldname = trim(decomp_cascade_con%decomp_pool_name_history(l))//'C_1m' + fieldname = trim(decomp_cascade_con%decomp_pool_name_history(l))//'_C_1m' longname = trim(decomp_cascade_con%decomp_pool_name_history(l))//' C to 1 meter' call hist_addfld1d (fname=fieldname, units='gC/m^2', & avgflag='A', long_name=longname, & @@ -268,7 +268,7 @@ subroutine InitHistory(this, bounds, carbon_type) do l = 1, ndecomp_pools if ( nlevdecomp_full > 1 ) then data2dptr => this%decomp_cpools_vr_col(:,1:nlevsoi,l) - fieldname = 'C13_'//trim(decomp_cascade_con%decomp_pool_name_history(l))//'C_vr' + fieldname = 'C13_'//trim(decomp_cascade_con%decomp_pool_name_history(l))//'_C_vr' longname = 'C13 '//trim(decomp_cascade_con%decomp_pool_name_history(l))//' C (vertically resolved)' call hist_addfld2d (fname=fieldname, units='gC13/m^3', type2d='levsoi', & avgflag='A', long_name=longname, & @@ -276,7 +276,7 @@ subroutine InitHistory(this, bounds, carbon_type) endif data1dptr => this%decomp_cpools_col(:,l) - fieldname = 'C13_'//trim(decomp_cascade_con%decomp_pool_name_history(l))//'C' + fieldname = 'C13_'//trim(decomp_cascade_con%decomp_pool_name_history(l))//'_C' longname = 'C13 '//trim(decomp_cascade_con%decomp_pool_name_history(l))//' C' call hist_addfld1d (fname=fieldname, units='gC13/m^2', & avgflag='A', long_name=longname, & @@ -355,21 +355,21 @@ subroutine InitHistory(this, bounds, carbon_type) do l = 1, ndecomp_pools if ( nlevdecomp_full > 1 ) then data2dptr => this%decomp_cpools_vr_col(:,1:nlevsoi,l) - fieldname = 'C14_'//trim(decomp_cascade_con%decomp_pool_name_history(l))//'C_vr' + fieldname = 'C14_'//trim(decomp_cascade_con%decomp_pool_name_history(l))//'_C_vr' longname = 'C14 '//trim(decomp_cascade_con%decomp_pool_name_history(l))//' C (vertically resolved)' call hist_addfld2d (fname=fieldname, units='gC14/m^3', type2d='levsoi', & avgflag='A', long_name=longname, ptr_col=data2dptr, default='inactive') endif data1dptr => this%decomp_cpools_col(:,l) - fieldname = 'C14_'//trim(decomp_cascade_con%decomp_pool_name_history(l))//'C' + fieldname = 'C14_'//trim(decomp_cascade_con%decomp_pool_name_history(l))//'_C' longname = 'C14 '//trim(decomp_cascade_con%decomp_pool_name_history(l))//' C' call hist_addfld1d (fname=fieldname, units='gC14/m^2', & avgflag='A', long_name=longname, ptr_col=data1dptr, default='inactive') if ( nlevdecomp_full > 1 ) then data1dptr => this%decomp_cpools_1m_col(:,l) - fieldname = 'C14_'//trim(decomp_cascade_con%decomp_pool_name_history(l))//'C_1m' + fieldname = 'C14_'//trim(decomp_cascade_con%decomp_pool_name_history(l))//'_C_1m' longname = 'C14_'//trim(decomp_cascade_con%decomp_pool_name_history(l))//' C to 1 meter' call hist_addfld1d (fname=fieldname, units='gC/m^2', & avgflag='A', long_name=longname, ptr_col=data1dptr, default='inactive') diff --git a/src/soilbiogeochem/SoilBiogeochemNitrogenFluxType.F90 b/src/soilbiogeochem/SoilBiogeochemNitrogenFluxType.F90 index 839f69379a..cb201d017c 100644 --- a/src/soilbiogeochem/SoilBiogeochemNitrogenFluxType.F90 +++ b/src/soilbiogeochem/SoilBiogeochemNitrogenFluxType.F90 @@ -351,7 +351,7 @@ subroutine InitHistory(this, bounds) 'to '//trim(decomp_cascade_con%decomp_pool_name_history(decomp_cascade_con%cascade_receiver_pool(l))) else fieldname = trim(decomp_cascade_con%decomp_pool_name_history(decomp_cascade_con%cascade_donor_pool(l)))& - //'N_TO_SMINN' + //'_N_TO_SMINN' longname = 'mineral N flux for decomp. of '& //trim(decomp_cascade_con%decomp_pool_name_history(decomp_cascade_con%cascade_donor_pool(l))) endif @@ -364,8 +364,8 @@ subroutine InitHistory(this, bounds) if ( decomp_cascade_con%cascade_receiver_pool(l) /= 0 ) then this%decomp_cascade_ntransfer_col(begc:endc,l) = spval data1dptr => this%decomp_cascade_ntransfer_col(:,l) - fieldname = trim(decomp_cascade_con%decomp_pool_name_history(decomp_cascade_con%cascade_donor_pool(l)))//'N_TO_'//& - trim(decomp_cascade_con%decomp_pool_name_history(decomp_cascade_con%cascade_receiver_pool(l)))//'N' + fieldname = trim(decomp_cascade_con%decomp_pool_name_history(decomp_cascade_con%cascade_donor_pool(l)))//'_N_TO_'//& + trim(decomp_cascade_con%decomp_pool_name_history(decomp_cascade_con%cascade_receiver_pool(l)))//'_N' longname = 'decomp. of '//trim(decomp_cascade_con%decomp_pool_name_long(decomp_cascade_con%cascade_donor_pool(l)))//& ' N to '//trim(decomp_cascade_con%decomp_pool_name_long(decomp_cascade_con%cascade_receiver_pool(l)))//' N' call hist_addfld1d (fname=fieldname, units='gN/m^2', & @@ -388,7 +388,7 @@ subroutine InitHistory(this, bounds) 'to '//trim(decomp_cascade_con%decomp_pool_name_history(decomp_cascade_con%cascade_receiver_pool(l))) else fieldname = trim(decomp_cascade_con%decomp_pool_name_history(decomp_cascade_con%cascade_donor_pool(l)))& - //'N_TO_SMINN'//trim(vr_suffix) + //'_N_TO_SMINN'//trim(vr_suffix) longname = 'mineral N flux for decomp. of '& //trim(decomp_cascade_con%decomp_pool_name_history(decomp_cascade_con%cascade_donor_pool(l))) endif @@ -401,9 +401,9 @@ subroutine InitHistory(this, bounds) if ( decomp_cascade_con%cascade_receiver_pool(l) /= 0 ) then this%decomp_cascade_ntransfer_vr_col(begc:endc,:,l) = spval data2dptr => this%decomp_cascade_ntransfer_vr_col(:,:,l) - fieldname = trim(decomp_cascade_con%decomp_pool_name_history(decomp_cascade_con%cascade_donor_pool(l)))//'N_TO_'//& + fieldname = trim(decomp_cascade_con%decomp_pool_name_history(decomp_cascade_con%cascade_donor_pool(l)))//'_N_TO_'//& trim(decomp_cascade_con%decomp_pool_name_history(decomp_cascade_con%cascade_receiver_pool(l)))& - //'N'//trim(vr_suffix) + //'_N'//trim(vr_suffix) longname = 'decomp. of '& //trim(decomp_cascade_con%decomp_pool_name_long(decomp_cascade_con%cascade_donor_pool(l)))//& ' N to '//trim(decomp_cascade_con%decomp_pool_name_long(decomp_cascade_con%cascade_receiver_pool(l)))//' N' @@ -429,7 +429,7 @@ subroutine InitHistory(this, bounds) if ( .not. decomp_cascade_con%is_cwd(k) ) then this%decomp_npools_leached_col(begc:endc,k) = spval data1dptr => this%decomp_npools_leached_col(:,k) - fieldname = 'M_'//trim(decomp_cascade_con%decomp_pool_name_history(k))//'N_TO_LEACHING' + fieldname = 'M_'//trim(decomp_cascade_con%decomp_pool_name_history(k))//'_N_TO_LEACHING' longname = trim(decomp_cascade_con%decomp_pool_name_long(k))//' N leaching loss' call hist_addfld1d (fname=fieldname, units='gN/m^2/s', & avgflag='A', long_name=longname, & @@ -437,7 +437,7 @@ subroutine InitHistory(this, bounds) this%decomp_npools_transport_tendency_col(begc:endc,:,k) = spval data2dptr => this%decomp_npools_transport_tendency_col(:,:,k) - fieldname = trim(decomp_cascade_con%decomp_pool_name_history(k))//'N_TNDNCY_VERT_TRANSPORT' + fieldname = trim(decomp_cascade_con%decomp_pool_name_history(k))//'_N_TNDNCY_VERT_TRANSPORT' longname = trim(decomp_cascade_con%decomp_pool_name_long(k))//' N tendency due to vertical transport' call hist_addfld_decomp (fname=fieldname, units='gN/m^3/s', type2d='levdcmp', & avgflag='A', long_name=longname, & diff --git a/src/soilbiogeochem/SoilBiogeochemNitrogenStateType.F90 b/src/soilbiogeochem/SoilBiogeochemNitrogenStateType.F90 index 3e54e52436..a72a7fa8ae 100644 --- a/src/soilbiogeochem/SoilBiogeochemNitrogenStateType.F90 +++ b/src/soilbiogeochem/SoilBiogeochemNitrogenStateType.F90 @@ -194,7 +194,7 @@ subroutine InitHistory(this, bounds) do l = 1, ndecomp_pools if ( nlevdecomp_full > 1 ) then data2dptr => this%decomp_npools_vr_col(:,:,l) - fieldname = trim(decomp_cascade_con%decomp_pool_name_history(l))//'N_vr' + fieldname = trim(decomp_cascade_con%decomp_pool_name_history(l))//'_N_vr' longname = trim(decomp_cascade_con%decomp_pool_name_history(l))//' N (vertically resolved)' call hist_addfld2d (fname=fieldname, units='gN/m^3', type2d='levdcmp', & avgflag='A', long_name=longname, & @@ -204,7 +204,7 @@ subroutine InitHistory(this, bounds) endif data1dptr => this%decomp_npools_col(:,l) - fieldname = trim(decomp_cascade_con%decomp_pool_name_history(l))//'N' + fieldname = trim(decomp_cascade_con%decomp_pool_name_history(l))//'_N' longname = trim(decomp_cascade_con%decomp_pool_name_history(l))//' N' call hist_addfld1d (fname=fieldname, units='gN/m^2', & avgflag='A', long_name=longname, & @@ -216,7 +216,7 @@ subroutine InitHistory(this, bounds) if ( nlevdecomp_full > 1 ) then data1dptr => this%decomp_npools_1m_col(:,l) - fieldname = trim(decomp_cascade_con%decomp_pool_name_history(l))//'N_1m' + fieldname = trim(decomp_cascade_con%decomp_pool_name_history(l))//'_N_1m' longname = trim(decomp_cascade_con%decomp_pool_name_history(l))//' N to 1 meter' call hist_addfld1d (fname=fieldname, units='gN/m^2', & avgflag='A', long_name=longname, & From 3e12e28729310d345f823ed6021eaf789a75fd35 Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Mon, 14 Aug 2023 18:06:59 -0600 Subject: [PATCH 183/257] Update hist field names in user_nl_clm files --- cime_config/usermods_dirs/newton_krylov_spinup/user_nl_clm | 4 ++-- cime_config/usermods_dirs/output_bgc/user_nl_clm | 6 +++--- 2 files changed, 5 insertions(+), 5 deletions(-) diff --git a/cime_config/usermods_dirs/newton_krylov_spinup/user_nl_clm b/cime_config/usermods_dirs/newton_krylov_spinup/user_nl_clm index 318105a043..75513be601 100644 --- a/cime_config/usermods_dirs/newton_krylov_spinup/user_nl_clm +++ b/cime_config/usermods_dirs/newton_krylov_spinup/user_nl_clm @@ -1,8 +1,8 @@ hist_dov2xy = .true.,.false. hist_nhtfrq = 0,-175200 hist_mfilt = 1,1 -hist_fincl2 = 'FPI_vr', 'K_PAS_SOM', 'K_SLO_SOM', 'K_ACT_SOM', - 'K_CWD', 'K_CEL_LIT', 'K_LIG_LIT', 'K_MET_LIT', +hist_fincl2 = 'FPI_vr', 'K_SOM_PAS', 'K_SOM_SLO', 'K_SOM_ACT', + 'K_CWD', 'K_LIT_CEL', 'K_LIT_LIG', 'K_LIT_MET', 'CWD_PATHFRAC_L2_vr', 'CWD_RESP_FRAC_L2_vr', 'CWD_PATHFRAC_L3_vr', 'CWD_RESP_FRAC_L3_vr', 'L1_PATHFRAC_S1_vr', 'L1_RESP_FRAC_S1_vr', diff --git a/cime_config/usermods_dirs/output_bgc/user_nl_clm b/cime_config/usermods_dirs/output_bgc/user_nl_clm index f7aaa09911..a7c5d098db 100644 --- a/cime_config/usermods_dirs/output_bgc/user_nl_clm +++ b/cime_config/usermods_dirs/output_bgc/user_nl_clm @@ -3,8 +3,8 @@ !---------------------------------------------------------------------------------- ! h0 stream (monthly average, gridcell-level) -hist_fexcl1 += 'ACT_SOMC_vr', 'ACT_SOMN_vr', 'SLO_SOMC_vr', 'SLO_SOMN_vr', 'PAS_SOMC_vr', 'PAS_SOMN_vr', 'SOILC_vr','SOILN_vr', 'CWDC_vr', 'MET_LITC_vr', 'CEL_LITC_vr', 'LIG_LITC_vr', 'MET_LITN_vr', 'CEL_LITN_vr', 'LIG_LITN_vr', 'CWDN_vr', 'SMIN_NO3_vr', 'CONC_O2_UNSAT', 'CONC_O2_SAT','SMIN_NH4_vr','SMINN_vr' -hist_fincl1 += 'LEAFC_TO_LITTER', 'FROOTC_TO_LITTER','MET_LITC_TO_ACT_SOMC','MET_LITN_TO_ACT_SOMN','CEL_LITC_TO_ACT_SOMC', 'CEL_LITN_TO_ACT_SOMN','LIG_LITC_TO_SLO_SOMC','LIG_LITN_TO_SLO_SOMN','DWT_WOOD_PRODUCTC_GAIN_PATCH' +hist_fexcl1 += 'SOM_ACT_C_vr', 'SOM_ACT_N_vr', 'SOM_SLO_C_vr', 'SOM_SLO_N_vr', 'SOM_PAS_C_vr', 'SOM_PAS_N_vr', 'SOILC_vr','SOILN_vr', 'CWD_C_vr', 'LIT_MET_C_vr', 'LIT_CEL_C_vr', 'LIT_LIG_C_vr', 'LIT_MET_N_vr', 'LIT_CEL_N_vr', 'LIT_LIG_N_vr', 'CWD_N_vr', 'SMIN_NO3_vr', 'CONC_O2_UNSAT', 'CONC_O2_SAT','SMIN_NH4_vr','SMINN_vr' +hist_fincl1 += 'LEAFC_TO_LITTER', 'FROOTC_TO_LITTER','LIT_MET_C_TO_SOM_ACT_C','LIT_MET_N_TO_SOM_ACT_N','LIT_CEL_C_TO_SOM_ACT_C', 'LIT_CEL_N_TO_SOM_ACT_N','LIT_LIG_C_TO_SOM_SLO_C','LIT_LIG_N_TO_SOM_SLO_N','DWT_WOOD_PRODUCTC_GAIN_PATCH' ! h1 stream (monthly average, finest sub-grid) hist_fincl2 += 'GPP', 'NPP', 'AGNPP', 'TOTVEGC', 'NPP_NUPTAKE', 'AR', 'HR', 'HTOP' @@ -14,7 +14,7 @@ hist_fincl2 += 'GPP', 'NPP', 'AGNPP', 'TOTVEGC', 'NPP_NUPTAKE', 'AR', 'HR', 'HTO hist_fincl3 += 'GPP', 'NPP', 'AR', 'HR', 'DWT_CONV_CFLUX_PATCH', 'WOOD_HARVESTC', 'DWT_WOOD_PRODUCTC_GAIN_PATCH', 'SLASH_HARVESTC', 'COL_FIRE_CLOSS', 'FROOTC:I', 'HTOP' ! h3 stream (yearly average, gridcell-level) -hist_fincl4 += 'SOILC_vr', 'SOILN_vr', 'CWDC_vr', 'MET_LITC_vr', 'CEL_LITC_vr', 'LIG_LITC_vr', 'MET_LITN_vr', 'CEL_LITN_vr', 'LIG_LITN_vr','CWDN_vr', 'TOTLITC:I', 'TOT_WOODPRODC:I', 'TOTSOMC:I','TOTVEGC:I' +hist_fincl4 += 'SOILC_vr', 'SOILN_vr', 'CWD_C_vr', 'LIT_MET_C_vr', 'LIT_CEL_C_vr', 'LIT_LIG_C_vr', 'LIT_MET_N_vr', 'LIT_CEL_N_vr', 'LIT_LIG_N_vr','CWD_N_vr', 'TOTLITC:I', 'TOT_WOODPRODC:I', 'TOTSOMC:I','TOTVEGC:I' ! h4 stream (yearly average, landunit-level) hist_fincl5 += 'TOTSOMC:I', 'TOTSOMC_1m:I', 'TOTECOSYSC:I', 'TOTVEGC:I', 'WOODC:I', 'TOTLITC:I', 'LIVECROOTC:I', 'DEADCROOTC:I', 'FROOTC:I' From 9d8f5b2c544c1cc2ee39ee73eaaa131a234152c5 Mon Sep 17 00:00:00 2001 From: Sam Rabin Date: Tue, 15 Aug 2023 13:48:33 -0600 Subject: [PATCH 184/257] Make cmds_to_setup_conda() more robust. For tests that invoke cmds_to_setup_conda(), manually calling the script invoking that function (e.g., case.build for FSURDATMODIFYCTSM) could fail if doing so with a conda environment already activated. The problem is that conda run -n ctsm_pylib seems to not actually use ctsm_pylib if, for instance the conda base environment is active. Instead doing CONDA_PREFIX= conda run -n ctsm_pylib seems to work. --- cime_config/SystemTests/systemtest_utils.py | 3 +++ 1 file changed, 3 insertions(+) diff --git a/cime_config/SystemTests/systemtest_utils.py b/cime_config/SystemTests/systemtest_utils.py index 17ddf88a53..6ce61d9424 100644 --- a/cime_config/SystemTests/systemtest_utils.py +++ b/cime_config/SystemTests/systemtest_utils.py @@ -10,6 +10,9 @@ def cmds_to_setup_conda(caseroot): # Use semicolon here since it's OK to fail # conda_setup_commands = ". " + caseroot + "/.env_mach_specific.sh; " + # Setting CONDA_PREFIX to empty ensures that this works even if called from + # a shell with a conda environment activated + conda_setup_commands += "CONDA_PREFIX=; " # Execute the module unload/load when "which conda" fails # eg on cheyenne try: From f6f03618e2e64a56f6534ac63f665e026396cbed Mon Sep 17 00:00:00 2001 From: Sam Rabin Date: Tue, 15 Aug 2023 15:14:46 -0600 Subject: [PATCH 185/257] Updated tests referenced in README_history_fields_files. --- .../README_history_fields_files | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/doc/source/users_guide/setting-up-and-running-a-case/README_history_fields_files b/doc/source/users_guide/setting-up-and-running-a-case/README_history_fields_files index f92f48f71a..c611c19ae2 100644 --- a/doc/source/users_guide/setting-up-and-running-a-case/README_history_fields_files +++ b/doc/source/users_guide/setting-up-and-running-a-case/README_history_fields_files @@ -1,10 +1,11 @@ 2021/9/8 slevis +2023/8/15 samsrabin The files history_fields_nofates.rst and history_fields_fates.rst each contain a table of the history fields, active and inactive, available in the CTSM cases that get generated by these tests: -ERP_P36x2_D_Ld3.f10_f10_mg37.I1850Clm50BgcCrop.cheyenne_gnu.clm-extra_outputs -ERS_Ld9.f10_f10_mg37.I2000Clm50FatesCruRsGs.cheyenne_intel.clm-FatesColdCH4Off +SMS_Ld1.f10_f10_mg37.I1850Clm50BgcCrop.cheyenne_intel.clm-SaveHistFieldList +SMS_Ld1.f10_f10_mg37.I2000Clm50FatesCru.cheyenne_intel.clm-SaveHistFieldList To reproduce these .rst files, run the above tests and the files will appear in the corresponding run directories. From 8056ae649c1b37f5e10aaaac79005d6e3a8b2380 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Wed, 16 Aug 2023 16:55:10 -0600 Subject: [PATCH 186/257] Run through black, fix #2112 --- cime_config/SystemTests/rxcropmaturity.py | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cime_config/SystemTests/rxcropmaturity.py b/cime_config/SystemTests/rxcropmaturity.py index 4fd812b84a..15f524dfce 100644 --- a/cime_config/SystemTests/rxcropmaturity.py +++ b/cime_config/SystemTests/rxcropmaturity.py @@ -353,7 +353,7 @@ def _run_generate_gdds(self, case_gddgen): f"--sdates-file {sdates_file}", f"--hdates-file {hdates_file}", f"--output-dir generate_gdds_out", - f"--skip-crops miscanthus,irrigated_miscanthus" + f"--skip-crops miscanthus,irrigated_miscanthus", ] ) stu.run_python_script( From c05ce8885e8b76315d6baad45cb57f57f84616a5 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Wed, 16 Aug 2023 16:56:12 -0600 Subject: [PATCH 187/257] Add black commit to git blame ignore file --- .git-blame-ignore-revs | 1 + 1 file changed, 1 insertion(+) diff --git a/.git-blame-ignore-revs b/.git-blame-ignore-revs index c00226b7dd..9b7cb3c036 100644 --- a/.git-blame-ignore-revs +++ b/.git-blame-ignore-revs @@ -12,3 +12,4 @@ b771971e3299c4fa56534b93421f7a2b9c7282fd 8bc4688e52ea23ef688e283698f70a44388373eb # Ran SystemTests and python/ctsm through black python formatter 5364ad66eaceb55dde2d3d598fe4ce37ac83a93c +8056ae649c1b37f5e10aaaac79005d6e3a8b2380 From 76f1310d17be5c027168fde67cb6aca130f29555 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Wed, 16 Aug 2023 17:04:46 -0600 Subject: [PATCH 188/257] Add list of source files and directories to the github action --- .github/workflows/black.yml | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/.github/workflows/black.yml b/.github/workflows/black.yml index 438b48e918..c46e1c869b 100644 --- a/.github/workflows/black.yml +++ b/.github/workflows/black.yml @@ -16,6 +16,10 @@ jobs: # Use options and version identical to the conda environment # Using pyproject.toml makes sure this testing is consistent with our python directory testing options: "--check --config python/pyproject.toml" - src: "./python" + src: + - "./python" + - "/cime_config/SystemTests" + - "/cime_config/buildlib" + - "/cime_config/buildnml" # Version should be coordinated with the ctsm_pylib conda environment under the python directory version: "22.3.0" From 89ad0499d8bfba2189500a6224253e7c685a3162 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Wed, 16 Aug 2023 17:08:15 -0600 Subject: [PATCH 189/257] Try it with a one line list with square brackets --- .github/workflows/black.yml | 6 +----- 1 file changed, 1 insertion(+), 5 deletions(-) diff --git a/.github/workflows/black.yml b/.github/workflows/black.yml index c46e1c869b..68fdab79a6 100644 --- a/.github/workflows/black.yml +++ b/.github/workflows/black.yml @@ -16,10 +16,6 @@ jobs: # Use options and version identical to the conda environment # Using pyproject.toml makes sure this testing is consistent with our python directory testing options: "--check --config python/pyproject.toml" - src: - - "./python" - - "/cime_config/SystemTests" - - "/cime_config/buildlib" - - "/cime_config/buildnml" + src: [ "./python", "/cime_config/SystemTests", "/cime_config/buildlib", "/cime_config/buildnml" ] # Version should be coordinated with the ctsm_pylib conda environment under the python directory version: "22.3.0" From 44c696e831227dfaf8e442cb4207bf28196701ff Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Wed, 16 Aug 2023 17:12:33 -0600 Subject: [PATCH 190/257] Add actions for each source Lists didn't work on the src: field, so add a complete action for each. --- .github/workflows/black.yml | 18 +++++++++++++++++- 1 file changed, 17 insertions(+), 1 deletion(-) diff --git a/.github/workflows/black.yml b/.github/workflows/black.yml index 68fdab79a6..a6b3529425 100644 --- a/.github/workflows/black.yml +++ b/.github/workflows/black.yml @@ -16,6 +16,22 @@ jobs: # Use options and version identical to the conda environment # Using pyproject.toml makes sure this testing is consistent with our python directory testing options: "--check --config python/pyproject.toml" - src: [ "./python", "/cime_config/SystemTests", "/cime_config/buildlib", "/cime_config/buildnml" ] + src: "./python" # Version should be coordinated with the ctsm_pylib conda environment under the python directory version: "22.3.0" + # Actions identical to above for each directory and source file we need to check (arrays aren't allowed for src: field) + - uses: psf/black@stable + with: + options: "--check --config python/pyproject.toml" + src: "/cime_config/SystemTests" + version: "22.3.0" + - uses: psf/black@stable + with: + options: "--check --config python/pyproject.toml" + src: "/cime_config/buildlib" + version: "22.3.0" + - uses: psf/black@stable + with: + options: "--check --config python/pyproject.toml" + src: "/cime_config/buildnml" + version: "22.3.0" From bab173588493092b3920ee89d7477715d1ba9203 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Wed, 16 Aug 2023 17:15:21 -0600 Subject: [PATCH 191/257] Needs a dot in front of the directory, so doesn't do an absolute path --- .github/workflows/black.yml | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/.github/workflows/black.yml b/.github/workflows/black.yml index a6b3529425..3759fa84c3 100644 --- a/.github/workflows/black.yml +++ b/.github/workflows/black.yml @@ -23,15 +23,15 @@ jobs: - uses: psf/black@stable with: options: "--check --config python/pyproject.toml" - src: "/cime_config/SystemTests" + src: "./cime_config/SystemTests" version: "22.3.0" - uses: psf/black@stable with: options: "--check --config python/pyproject.toml" - src: "/cime_config/buildlib" + src: "./cime_config/buildlib" version: "22.3.0" - uses: psf/black@stable with: options: "--check --config python/pyproject.toml" - src: "/cime_config/buildnml" + src: "./cime_config/buildnml" version: "22.3.0" From 5765f944e3067feb65a3db662853667a5d67a143 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Wed, 16 Aug 2023 17:32:43 -0600 Subject: [PATCH 192/257] Update Change files --- doc/ChangeLog | 25 ++++++++++++++----------- doc/ChangeSum | 2 +- 2 files changed, 15 insertions(+), 12 deletions(-) diff --git a/doc/ChangeLog b/doc/ChangeLog index 9d3c5b1564..43a19a6644 100644 --- a/doc/ChangeLog +++ b/doc/ChangeLog @@ -1,7 +1,7 @@ =============================================================== Tag name: ctsm5.1.dev134 Originator(s): rgknox (Ryan Knox,LBNL EESA), erik (Erik Kluzek,UCAR/TSS,303-497-1326) -Date: Mon Aug 14 07:19:59 PM EDT 2023 +Date: Wed Aug 16 17:20:27 MDT 2023 One-line Summary: Migration of FATES to share normal soil BGC call sequence and functionality Purpose and description of changes @@ -32,25 +32,28 @@ Bugs fixed or introduced Surprisingly, nvhpc tests are now working, but it may just be coincidental. All existing aux_clm tests are passing. Tests without FATES are b4b, with roundoff differences in just TOTCOLC and TOTCOLN. CTSM issues fixed (include CTSM Issue #): - -Known bugs introduced in this tag (include issue #): + We think #1879 -- "AD spinup issues for FATES", is fixed but haven't proved it + #2112 -- black check on SystemTest file Notes of particular relevance for users --------------------------------------- A CLM-FATES simulation will turn on nitrogen supplementation, this enables sufficient immobilization and decomposition. Until FATES and CLM can handle fully coupled nitrogen exchange, which would include root uptake of the mineralized aqueous forms (NH4 and NO3), N limitations in the soil are meaningless when FATES is on. Caveats for users (e.g., need to interpolate initial conditions): - -Changes to CTSM's user interface (e.g., new/renamed XML or namelist variables): + FATES MUST have suplnitro='ALL' now (was NONE). When fates_parteh_mode>=1 other settings are allowed. + More checking for use_luna and suplnitro is added for FATES in the build-namelist Changes made to namelist defaults (e.g., changed parameter values): FATES runs now supplement N + suplnitro set to ALL for FATES + use_luna set to .false. for FATES and clm4_5 physics -Changes to the datasets (e.g., parameter, surface or initial files): - -Substantial timing or memory changes: -[e.g., check PFS test in the test suite and look at timings, if you -expect possible significant timing changes] +Notes of particular relevance for developers: +--------------------------------------------- +Caveats for developers (e.g., code that is duplicated that requires double maintenance): + We should update defaults for suplnitro, when Nitrogen nutrients are allowed in FATES + The black checdk github action has to duplicate actions for each source file or directory + We should move to using the Makefile in the python directory when we figure it out Testing summary: ---------------- @@ -64,7 +67,7 @@ cheyenne: OK /glade/scratch/rgknox/tests_0814-134713ch Answer changes -------------- -Changes answers relative to baseline: +Changes answers relative to baseline: Two diganostic fields (TOTCOLC and TOTCOLN) Baseline changes will be reported for many tests, all tests were combed to identify RMS diffs, all non-FATES tests had at most, roundoff level ( Date: Fri, 18 Aug 2023 07:29:04 -0600 Subject: [PATCH 193/257] sort the history file by vertical dim --- src/main/histFileMod.F90 | 12 +++++++++++- 1 file changed, 11 insertions(+), 1 deletion(-) diff --git a/src/main/histFileMod.F90 b/src/main/histFileMod.F90 index 92ce3dfa95..bf9c23098c 100644 --- a/src/main/histFileMod.F90 +++ b/src/main/histFileMod.F90 @@ -1076,7 +1076,17 @@ subroutine sort_hist_list(t, n_fields, hist_list) do f = n_fields-1, 1, -1 do ff = 1, f - if (hist_list(ff)%field%name > hist_list(ff+1)%field%name) then + if (hist_list(ff)%field%num2d > hist_list(ff+1)%field%num2d) then + + call tmp%copy(hist_list(ff)) + call hist_list(ff )%copy(hist_list(ff+1)) + call hist_list(ff+1)%copy(tmp) + + endif + enddo + do ff = 1, f + if ((hist_list(ff)%field%num2d == hist_list(ff+1)%field%num2d) .and. & + (hist_list(ff)%field%name > hist_list(ff+1)%field%name)) then call tmp%copy(hist_list(ff)) call hist_list(ff )%copy(hist_list(ff+1)) From 407ba2b2e746da2c5f99975c44d33c6c682cf7d2 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Fri, 18 Aug 2023 10:46:47 -0600 Subject: [PATCH 194/257] Minor fixes to sort_hist_list - Merge the two partial sorts into one; this is partly for efficiency but also because the original was not guaranteed to leave the fields in alphabetical sort order within a given size of level dimension (e.g., in test SMS_D_Ld1_P8x1.f10_f10_mg37.I2000Clm50BgcCropQianRs.green_gnu.clm-default, the last three fields on the h0 file were TSOI_ICE, SOILN_vr, PCT_CFT before this change) - Remove the check for duplicate field names: with this refactor, I think this check will no longer be guaranteed to detect duplicate field names, and this duplicate detection was already done elsewhere so is unnecessary here - Add a comment describing the rationale for the sort order --- src/main/histFileMod.F90 | 24 +++++++----------------- 1 file changed, 7 insertions(+), 17 deletions(-) diff --git a/src/main/histFileMod.F90 b/src/main/histFileMod.F90 index bf9c23098c..6907065da5 100644 --- a/src/main/histFileMod.F90 +++ b/src/main/histFileMod.F90 @@ -1076,28 +1076,18 @@ subroutine sort_hist_list(t, n_fields, hist_list) do f = n_fields-1, 1, -1 do ff = 1, f - if (hist_list(ff)%field%num2d > hist_list(ff+1)%field%num2d) then + ! First sort by size of level dimension (this presents a significant performance + ! improvement especially notable on lustre file systems such as on derecho); + ! then, within the list of fields with the same size of the level dimension, + ! sort alphabetically. + if (hist_list(ff)%field%num2d > hist_list(ff+1)%field%num2d .or. & + (hist_list(ff)%field%num2d == hist_list(ff+1)%field%num2d .and. & + hist_list(ff)%field%name > hist_list(ff+1)%field%name)) then call tmp%copy(hist_list(ff)) call hist_list(ff )%copy(hist_list(ff+1)) call hist_list(ff+1)%copy(tmp) - endif - enddo - do ff = 1, f - if ((hist_list(ff)%field%num2d == hist_list(ff+1)%field%num2d) .and. & - (hist_list(ff)%field%name > hist_list(ff+1)%field%name)) then - - call tmp%copy(hist_list(ff)) - call hist_list(ff )%copy(hist_list(ff+1)) - call hist_list(ff+1)%copy(tmp) - - else if (hist_list(ff)%field%name == hist_list(ff+1)%field%name) then - - write(iulog,*) trim(subname),' ERROR: Duplicate field ', & - hist_list(ff)%field%name, & - 't,ff,name=',t,ff,hist_list(ff+1)%field%name - call endrun(msg=errMsg(sourcefile, __LINE__)) end if end do end do From 3c828c3e6cc1e65edf234769bd93d88719ec21f2 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Mon, 21 Aug 2023 12:11:28 -0600 Subject: [PATCH 195/257] Sort history fields by name of level dimension rather than size This prevents the interleaving of fields that have the same size of their level dimension despite having different level dimensions; this is a more intuitive ordering. --- src/main/histFileMod.F90 | 28 +++++++++++++++++++++------- 1 file changed, 21 insertions(+), 7 deletions(-) diff --git a/src/main/histFileMod.F90 b/src/main/histFileMod.F90 index 6907065da5..6a69d479ab 100644 --- a/src/main/histFileMod.F90 +++ b/src/main/histFileMod.F90 @@ -197,6 +197,20 @@ module histFileMod integer :: num_subs = 0 ! actual number of subscripts character(len=32) :: subs_name(max_subs) ! name of subscript integer :: subs_dim(max_subs) ! dimension of subscript + + ! type2d value for a field without a level dimension. This value is important for the + ! following reasons (as of 2023-08-21): + ! - type2d is used to determine the sort order of history fields both within the history + ! file (e.g., what you see from 'ncdump -h') and in the documentation that lists all + ! history fields. For these purposes, it is important that variables with + ! type2d_unset appear before variables with a real type2d, so type2d_unset should + ! appear early in alphabetical sort order. (If type2d_unset were changed to something + ! that appeared later in alphabetical sort order, then sort_hist_list should be + ! changed to have some special handling of fields with type2d_unset, forcing them to + ! appear first.) + ! - This will soon be added to the history field documentation, so should be a sensible + ! value for the type2d column in that output. + character(len=*), parameter :: type2d_unset = '-' ! type field_info character(len=max_namlen) :: name ! field name @@ -1076,12 +1090,12 @@ subroutine sort_hist_list(t, n_fields, hist_list) do f = n_fields-1, 1, -1 do ff = 1, f - ! First sort by size of level dimension (this presents a significant performance - ! improvement especially notable on lustre file systems such as on derecho); - ! then, within the list of fields with the same size of the level dimension, - ! sort alphabetically. - if (hist_list(ff)%field%num2d > hist_list(ff+1)%field%num2d .or. & - (hist_list(ff)%field%num2d == hist_list(ff+1)%field%num2d .and. & + ! First sort by the name of the level dimension; then, within the list of + ! fields with the same level dimension, sort by field name. Sorting first by + ! the level dimension gives a significant performance improvement especially + ! notable on lustre file systems such as on derecho. + if (hist_list(ff)%field%type2d > hist_list(ff+1)%field%type2d .or. & + (hist_list(ff)%field%type2d == hist_list(ff+1)%field%type2d .and. & hist_list(ff)%field%name > hist_list(ff+1)%field%name)) then call tmp%copy(hist_list(ff)) @@ -5370,7 +5384,7 @@ subroutine hist_addfld1d (fname, units, avgflag, long_name, type1d_out, & ! Add field to masterlist call masterlist_addfld (fname=trim(fname), numdims=1, type1d=l_type1d, & - type1d_out=l_type1d_out, type2d='unset', num2d=1, & + type1d_out=l_type1d_out, type2d=type2d_unset, num2d=1, & units=units, avgflag=avgflag, long_name=long_name, hpindex=hpindex, & p2c_scale_type=scale_type_p2c, c2l_scale_type=scale_type_c2l, & l2g_scale_type=scale_type_l2g) From 0b316d8441189a14d623e81223744eaa578b0e09 Mon Sep 17 00:00:00 2001 From: Sam Rabin Date: Mon, 21 Aug 2023 13:03:08 -0600 Subject: [PATCH 196/257] Add level dimension column to .rst files. --- .../history_fields_fates.rst | 2074 ++++++------- .../history_fields_nofates.rst | 2554 ++++++++--------- src/main/histFileMod.F90 | 20 +- 3 files changed, 2325 insertions(+), 2323 deletions(-) diff --git a/doc/source/users_guide/setting-up-and-running-a-case/history_fields_fates.rst b/doc/source/users_guide/setting-up-and-running-a-case/history_fields_fates.rst index 2fe1035549..5514e76e1e 100644 --- a/doc/source/users_guide/setting-up-and-running-a-case/history_fields_fates.rst +++ b/doc/source/users_guide/setting-up-and-running-a-case/history_fields_fates.rst @@ -8,1041 +8,1041 @@ use_cn = F use_crop = F use_fates = T -=================================== ============================================================================================== ================================================================= ======= +=================================== ================ ============================================================================================== ================================================================= ======= CTSM History Fields ------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------- - Variable Name Long Description Units Active? -=================================== ============================================================================================== ================================================================= ======= -A5TMIN 5-day running mean of min 2-m temperature K F -ACTUAL_IMMOB actual N immobilization gN/m^2/s T -ACTUAL_IMMOB_NH4 immobilization of NH4 gN/m^3/s F -ACTUAL_IMMOB_NO3 immobilization of NO3 gN/m^3/s F -ACTUAL_IMMOB_vr actual N immobilization gN/m^3/s F -ACT_SOMC ACT_SOM C gC/m^2 T -ACT_SOMC_1m ACT_SOM C to 1 meter gC/m^2 F -ACT_SOMC_TNDNCY_VERT_TRA active soil organic C tendency due to vertical transport gC/m^3/s F -ACT_SOMC_TO_PAS_SOMC decomp. of active soil organic C to passive soil organic C gC/m^2/s F -ACT_SOMC_TO_PAS_SOMC_vr decomp. of active soil organic C to passive soil organic C gC/m^3/s F -ACT_SOMC_TO_SLO_SOMC decomp. of active soil organic C to slow soil organic ma C gC/m^2/s F -ACT_SOMC_TO_SLO_SOMC_vr decomp. of active soil organic C to slow soil organic ma C gC/m^3/s F -ACT_SOMC_vr ACT_SOM C (vertically resolved) gC/m^3 T -ACT_SOMN ACT_SOM N gN/m^2 T -ACT_SOMN_1m ACT_SOM N to 1 meter gN/m^2 F -ACT_SOMN_TNDNCY_VERT_TRA active soil organic N tendency due to vertical transport gN/m^3/s F -ACT_SOMN_TO_PAS_SOMN decomp. of active soil organic N to passive soil organic N gN/m^2 F -ACT_SOMN_TO_PAS_SOMN_vr decomp. of active soil organic N to passive soil organic N gN/m^3 F -ACT_SOMN_TO_SLO_SOMN decomp. of active soil organic N to slow soil organic ma N gN/m^2 F -ACT_SOMN_TO_SLO_SOMN_vr decomp. of active soil organic N to slow soil organic ma N gN/m^3 F -ACT_SOMN_vr ACT_SOM N (vertically resolved) gN/m^3 T -ACT_SOM_HR_S2 Het. Resp. from active soil organic gC/m^2/s F -ACT_SOM_HR_S2_vr Het. Resp. from active soil organic gC/m^3/s F -ACT_SOM_HR_S3 Het. Resp. from active soil organic gC/m^2/s F -ACT_SOM_HR_S3_vr Het. Resp. from active soil organic gC/m^3/s F -AGLB Aboveground leaf biomass kg/m^2 F -AGSB Aboveground stem biomass kg/m^2 F -ALBD surface albedo (direct) proportion F -ALBGRD ground albedo (direct) proportion F -ALBGRI ground albedo (indirect) proportion F -ALBI surface albedo (indirect) proportion F -ALT current active layer thickness m F -ALTMAX maximum annual active layer thickness m F -ALTMAX_LASTYEAR maximum prior year active layer thickness m F -ATM_O3 atmospheric ozone partial pressure mol/mol F -ATM_TOPO atmospheric surface height m T -AnnET Annual ET mm/s F -BCDEP total BC deposition (dry+wet) from atmosphere kg/m^2/s T -BTRAN transpiration beta factor unitless T -BTRANMN daily minimum of transpiration beta factor unitless T -CEL_LITC CEL_LIT C gC/m^2 T -CEL_LITC_1m CEL_LIT C to 1 meter gC/m^2 F -CEL_LITC_TNDNCY_VERT_TRA cellulosic litter C tendency due to vertical transport gC/m^3/s F -CEL_LITC_TO_ACT_SOMC decomp. of cellulosic litter C to active soil organic C gC/m^2/s F -CEL_LITC_TO_ACT_SOMC_vr decomp. of cellulosic litter C to active soil organic C gC/m^3/s F -CEL_LITC_vr CEL_LIT C (vertically resolved) gC/m^3 T -CEL_LITN CEL_LIT N gN/m^2 T -CEL_LITN_1m CEL_LIT N to 1 meter gN/m^2 F -CEL_LITN_TNDNCY_VERT_TRA cellulosic litter N tendency due to vertical transport gN/m^3/s F -CEL_LITN_TO_ACT_SOMN decomp. of cellulosic litter N to active soil organic N gN/m^2 F -CEL_LITN_TO_ACT_SOMN_vr decomp. of cellulosic litter N to active soil organic N gN/m^3 F -CEL_LITN_vr CEL_LIT N (vertically resolved) gN/m^3 T -CEL_LIT_HR Het. Resp. from cellulosic litter gC/m^2/s F -CEL_LIT_HR_vr Het. Resp. from cellulosic litter gC/m^3/s F -CH4PROD Gridcell total production of CH4 gC/m2/s T -CH4_EBUL_TOTAL_SAT ebullition surface CH4 flux; (+ to atm) mol/m2/s F -CH4_EBUL_TOTAL_UNSAT ebullition surface CH4 flux; (+ to atm) mol/m2/s F -CH4_SURF_AERE_SAT aerenchyma surface CH4 flux for inundated area; (+ to atm) mol/m2/s T -CH4_SURF_AERE_UNSAT aerenchyma surface CH4 flux for non-inundated area; (+ to atm) mol/m2/s T -CH4_SURF_DIFF_SAT diffusive surface CH4 flux for inundated / lake area; (+ to atm) mol/m2/s T -CH4_SURF_DIFF_UNSAT diffusive surface CH4 flux for non-inundated area; (+ to atm) mol/m2/s T -CH4_SURF_EBUL_SAT ebullition surface CH4 flux for inundated / lake area; (+ to atm) mol/m2/s T -CH4_SURF_EBUL_UNSAT ebullition surface CH4 flux for non-inundated area; (+ to atm) mol/m2/s T -COL_CTRUNC column-level sink for C truncation gC/m^2 F -COL_NTRUNC column-level sink for N truncation gN/m^2 F -CONC_CH4_SAT CH4 soil Concentration for inundated / lake area mol/m3 F -CONC_CH4_UNSAT CH4 soil Concentration for non-inundated area mol/m3 F -CONC_O2_SAT O2 soil Concentration for inundated / lake area mol/m3 T -CONC_O2_UNSAT O2 soil Concentration for non-inundated area mol/m3 T -COSZEN cosine of solar zenith angle none F -CWDC_HR cwd C heterotrophic respiration gC/m^2/s T -DENIT total rate of denitrification gN/m^2/s T -DGNETDT derivative of net ground heat flux wrt soil temp W/m^2/K F -DISPLA displacement height (vegetated landunits only) m F -DPVLTRB1 turbulent deposition velocity 1 m/s F -DPVLTRB2 turbulent deposition velocity 2 m/s F -DPVLTRB3 turbulent deposition velocity 3 m/s F -DPVLTRB4 turbulent deposition velocity 4 m/s F -DSL dry surface layer thickness mm T -DSTDEP total dust deposition (dry+wet) from atmosphere kg/m^2/s T -DSTFLXT total surface dust emission kg/m2/s T -DYN_COL_ADJUSTMENTS_CH4 Adjustments in ch4 due to dynamic column areas; only makes sense at the column level: should n gC/m^2 F -DYN_COL_SOIL_ADJUSTMENTS_C Adjustments in soil carbon due to dynamic column areas; only makes sense at the column level: gC/m^2 F -DYN_COL_SOIL_ADJUSTMENTS_N Adjustments in soil nitrogen due to dynamic column areas; only makes sense at the column level gN/m^2 F -DYN_COL_SOIL_ADJUSTMENTS_NH4 Adjustments in soil NH4 due to dynamic column areas; only makes sense at the column level: sho gN/m^2 F -DYN_COL_SOIL_ADJUSTMENTS_NO3 Adjustments in soil NO3 due to dynamic column areas; only makes sense at the column level: sho gN/m^2 F -EFLXBUILD building heat flux from change in interior building air temperature W/m^2 T -EFLX_DYNBAL dynamic land cover change conversion energy flux W/m^2 T -EFLX_GNET net heat flux into ground W/m^2 F -EFLX_GRND_LAKE net heat flux into lake/snow surface, excluding light transmission W/m^2 T -EFLX_LH_TOT total latent heat flux [+ to atm] W/m^2 T -EFLX_LH_TOT_ICE total latent heat flux [+ to atm] (ice landunits only) W/m^2 F -EFLX_LH_TOT_R Rural total evaporation W/m^2 T -EFLX_LH_TOT_U Urban total evaporation W/m^2 F -EFLX_SOIL_GRND soil heat flux [+ into soil] W/m^2 F -ELAI exposed one-sided leaf area index m^2/m^2 T -ERRH2O total water conservation error mm T -ERRH2OSNO imbalance in snow depth (liquid water) mm T -ERRSEB surface energy conservation error W/m^2 T -ERRSOI soil/lake energy conservation error W/m^2 T -ERRSOL solar radiation conservation error W/m^2 T -ESAI exposed one-sided stem area index m^2/m^2 T -FATES_ABOVEGROUND_MORT_SZPF Aboveground flux of carbon from AGB to necromass due to mortality kg m-2 s-1 F -FATES_ABOVEGROUND_PROD_SZPF Aboveground carbon productivity kg m-2 s-1 F -FATES_AGSAPMAINTAR_SZPF above-ground sapwood maintenance autotrophic respiration in kg carbon per m2 per second by pft kg m-2 s-1 F -FATES_AGSAPWOOD_ALLOC_SZPF allocation to above-ground sapwood by pft/size in kg carbon per m2 per second kg m-2 s-1 F -FATES_AGSTRUCT_ALLOC_SZPF allocation to above-ground structural (deadwood) by pft/size in kg carbon per m2 per second kg m-2 s-1 F -FATES_AR autotrophic respiration gC/m^2/s T -FATES_AREA_PLANTS area occupied by all plants per m2 land area m2 m-2 T -FATES_AREA_TREES area occupied by woody plants per m2 land area m2 m-2 T -FATES_AR_CANOPY autotrophic respiration of canopy plants gC/m^2/s T -FATES_AR_UNDERSTORY autotrophic respiration of understory plants gC/m^2/s T -FATES_AUTORESP autotrophic respiration in kg carbon per m2 per second kg m-2 s-1 T -FATES_AUTORESP_CANOPY autotrophic respiration of canopy plants in kg carbon per m2 per second kg m-2 s-1 T -FATES_AUTORESP_CANOPY_SZPF autotrophic respiration of canopy plants by pft/size in kg carbon per m2 per second kg m-2 s-1 F -FATES_AUTORESP_SECONDARY autotrophic respiration in kg carbon per m2 per second, secondary patches kg m-2 s-1 T -FATES_AUTORESP_SZPF total autotrophic respiration in kg carbon per m2 per second by pft/size kg m-2 s-1 F -FATES_AUTORESP_USTORY autotrophic respiration of understory plants in kg carbon per m2 per second kg m-2 s-1 T -FATES_AUTORESP_USTORY_SZPF autotrophic respiration of understory plants by pft/size in kg carbon per m2 per second kg m-2 s-1 F -FATES_BASALAREA_SZ basal area by size class m2 m-2 T -FATES_BASALAREA_SZPF basal area by pft/size m2 m-2 F -FATES_BA_WEIGHTED_HEIGHT basal area-weighted mean height of woody plants m T -FATES_BGSAPMAINTAR_SZPF below-ground sapwood maintenance autotrophic respiration in kg carbon per m2 per second by pft kg m-2 s-1 F -FATES_BGSAPWOOD_ALLOC_SZPF allocation to below-ground sapwood by pft/size in kg carbon per m2 per second kg m-2 s-1 F -FATES_BGSTRUCT_ALLOC_SZPF allocation to below-ground structural (deadwood) by pft/size in kg carbon per m2 per second kg m-2 s-1 F -FATES_BURNFRAC burned area fraction per second s-1 T -FATES_BURNFRAC_AP spitfire fraction area burnt (per second) by patch age s-1 T -FATES_C13DISC_SZPF C13 discrimination by pft/size per mil F -FATES_CANOPYAREA_AP canopy area by age bin per m2 land area m2 m-2 T -FATES_CANOPYAREA_HT canopy area height distribution m2 m-2 T -FATES_CANOPYCROWNAREA_PF total PFT-level canopy-layer crown area per m2 land area m2 m-2 T -FATES_CANOPY_SPREAD scaling factor (0-1) between tree basal area and canopy area T -FATES_CANOPY_VEGC biomass of canopy plants in kg carbon per m2 land area kg m-2 T -FATES_CA_WEIGHTED_HEIGHT crown area-weighted mean height of canopy plants m T -FATES_CBALANCE_ERROR total carbon error in kg carbon per second kg s-1 T -FATES_COLD_STATUS site-level cold status, 0=not cold-dec, 1=too cold for leaves, 2=not too cold T -FATES_CROOTMAINTAR live coarse root maintenance autotrophic respiration in kg carbon per m2 per second kg m-2 s-1 T -FATES_CROOTMAINTAR_CANOPY_SZ live coarse root maintenance autotrophic respiration for canopy plants in kg carbon per m2 per kg m-2 s-1 F -FATES_CROOTMAINTAR_USTORY_SZ live coarse root maintenance autotrophic respiration for understory plants in kg carbon per m2 kg m-2 s-1 F -FATES_CROOT_ALLOC allocation to coarse roots in kg carbon per m2 per second kg m-2 s-1 T -FATES_CROWNAREA_CANOPY_SZ total crown area of canopy plants by size class m2 m-2 F -FATES_CROWNAREA_CL total crown area in each canopy layer m2 m-2 T -FATES_CROWNAREA_CLLL total crown area that is occupied by leaves in each canopy and leaf layer m2 m-2 F -FATES_CROWNAREA_PF total PFT-level crown area per m2 land area m2 m-2 T -FATES_CROWNAREA_USTORY_SZ total crown area of understory plants by size class m2 m-2 F -FATES_CWD_ABOVEGROUND_DC debris class-level aboveground coarse woody debris stocks in kg carbon per m2 kg m-2 F -FATES_CWD_ABOVEGROUND_IN_DC debris class-level aboveground coarse woody debris input in kg carbon per m2 per second kg m-2 s-1 F -FATES_CWD_ABOVEGROUND_OUT_DC debris class-level aboveground coarse woody debris output in kg carbon per m2 per second kg m-2 s-1 F -FATES_CWD_BELOWGROUND_DC debris class-level belowground coarse woody debris stocks in kg carbon per m2 kg m-2 F -FATES_CWD_BELOWGROUND_IN_DC debris class-level belowground coarse woody debris input in kg carbon per m2 per second kg m-2 s-1 F -FATES_CWD_BELOWGROUND_OUT_DC debris class-level belowground coarse woody debris output in kg carbon per m2 per second kg m-2 s-1 F -FATES_DAYSINCE_COLDLEAFOFF site-level days elapsed since cold leaf drop days T -FATES_DAYSINCE_COLDLEAFON site-level days elapsed since cold leaf flush days T -FATES_DAYSINCE_DROUGHTLEAFOFF_PF PFT-level days elapsed since drought leaf drop days T -FATES_DAYSINCE_DROUGHTLEAFON_PF PFT-level days elapsed since drought leaf flush days T -FATES_DDBH_CANOPY_SZ diameter growth increment by size of canopy plants m m-2 yr-1 T -FATES_DDBH_CANOPY_SZAP growth rate of canopy plants in meters DBH per m2 per year in canopy in each size x age class m m-2 yr-1 F -FATES_DDBH_CANOPY_SZPF diameter growth increment by pft/size m m-2 yr-1 F -FATES_DDBH_SZPF diameter growth increment by pft/size m m-2 yr-1 F -FATES_DDBH_USTORY_SZ diameter growth increment by size of understory plants m m-2 yr-1 T -FATES_DDBH_USTORY_SZAP growth rate of understory plants in meters DBH per m2 per year in each size x age class m m-2 yr-1 F -FATES_DDBH_USTORY_SZPF diameter growth increment by pft/size m m-2 yr-1 F -FATES_DEMOTION_CARBONFLUX demotion-associated biomass carbon flux from canopy to understory in kg carbon per m2 per seco kg m-2 s-1 T -FATES_DEMOTION_RATE_SZ demotion rate from canopy to understory by size class in number of plants per m2 per year m-2 yr-1 F -FATES_DISTURBANCE_RATE_FIRE disturbance rate from fire m2 m-2 yr-1 T -FATES_DISTURBANCE_RATE_LOGGING disturbance rate from logging m2 m-2 yr-1 T -FATES_DISTURBANCE_RATE_P2P disturbance rate from primary to primary lands m2 m-2 yr-1 T -FATES_DISTURBANCE_RATE_P2S disturbance rate from primary to secondary lands m2 m-2 yr-1 T -FATES_DISTURBANCE_RATE_POTENTIAL potential (i.e., including unresolved) disturbance rate m2 m-2 yr-1 T -FATES_DISTURBANCE_RATE_S2S disturbance rate from secondary to secondary lands m2 m-2 yr-1 T -FATES_DISTURBANCE_RATE_TREEFALL disturbance rate from treefall m2 m-2 yr-1 T -FATES_DROUGHT_STATUS_PF PFT-level drought status, <2 too dry for leaves, >=2 not too dry T -FATES_EFFECT_WSPEED effective wind speed for fire spread in meters per second m s-1 T -FATES_ELONG_FACTOR_PF PFT-level mean elongation factor (partial flushing/abscission) 1 T -FATES_ERROR_EL total mass-balance error in kg per second by element kg s-1 T -FATES_EXCESS_RESP respiration of un-allocatable carbon gain kg m-2 s-1 T -FATES_FABD_SHA_CLLL shade fraction of direct light absorbed by each canopy and leaf layer 1 F -FATES_FABD_SHA_CLLLPF shade fraction of direct light absorbed by each canopy, leaf, and PFT 1 F -FATES_FABD_SHA_TOPLF_CL shade fraction of direct light absorbed by the top leaf layer of each canopy layer 1 F -FATES_FABD_SUN_CLLL sun fraction of direct light absorbed by each canopy and leaf layer 1 F -FATES_FABD_SUN_CLLLPF sun fraction of direct light absorbed by each canopy, leaf, and PFT 1 F -FATES_FABD_SUN_TOPLF_CL sun fraction of direct light absorbed by the top leaf layer of each canopy layer 1 F -FATES_FABI_SHA_CLLL shade fraction of indirect light absorbed by each canopy and leaf layer 1 F -FATES_FABI_SHA_CLLLPF shade fraction of indirect light absorbed by each canopy, leaf, and PFT 1 F -FATES_FABI_SHA_TOPLF_CL shade fraction of indirect light absorbed by the top leaf layer of each canopy layer 1 F -FATES_FABI_SUN_CLLL sun fraction of indirect light absorbed by each canopy and leaf layer 1 F -FATES_FABI_SUN_CLLLPF sun fraction of indirect light absorbed by each canopy, leaf, and PFT 1 F -FATES_FABI_SUN_TOPLF_CL sun fraction of indirect light absorbed by the top leaf layer of each canopy layer 1 F -FATES_FDI Fire Danger Index (probability that an ignition will lead to a fire) 1 T -FATES_FIRE_CLOSS carbon loss to atmosphere from fire in kg carbon per m2 per second kg m-2 s-1 T -FATES_FIRE_FLUX_EL loss to atmosphere from fire by element in kg element per m2 per s kg m-2 s-1 T -FATES_FIRE_INTENSITY spitfire surface fireline intensity in J per m per second J m-1 s-1 T -FATES_FIRE_INTENSITY_BURNFRAC product of surface fire intensity and burned area fraction -- divide by FATES_BURNFRAC to get J m-1 s-1 T -FATES_FIRE_INTENSITY_BURNFRAC_AP product of fire intensity and burned fraction, resolved by patch age (so divide by FATES_BURNF J m-1 s-1 T -FATES_FRACTION total gridcell fraction which FATES is running over m2 m-2 T -FATES_FRAGMENTATION_SCALER_SL factor (0-1) by which litter/cwd fragmentation proceeds relative to max rate by soil layer T -FATES_FROOTC total biomass in live plant fine roots in kg carbon per m2 kg m-2 T -FATES_FROOTCTURN_CANOPY_SZ fine root turnover (non-mortal) for canopy plants by size class in kg carbon per m2 per second kg m-2 s-1 F -FATES_FROOTCTURN_USTORY_SZ fine root turnover (non-mortal) for understory plants by size class in kg carbon per m2 per se kg m-2 s-1 F -FATES_FROOTC_SL Total carbon in live plant fine-roots over depth kg m-3 T -FATES_FROOTC_SZPF fine-root carbon mass by size-class x pft in kg carbon per m2 kg m-2 F -FATES_FROOTMAINTAR fine root maintenance autotrophic respiration in kg carbon per m2 per second kg m-2 s-1 T -FATES_FROOTMAINTAR_CANOPY_SZ live coarse root maintenance autotrophic respiration for canopy plants in kg carbon per m2 per kg m-2 s-1 F -FATES_FROOTMAINTAR_SZPF fine root maintenance autotrophic respiration in kg carbon per m2 per second by pft/size kg m-2 s-1 F -FATES_FROOTMAINTAR_USTORY_SZ fine root maintenance autotrophic respiration for understory plants in kg carbon per m2 per se kg m-2 s-1 F -FATES_FROOT_ALLOC allocation to fine roots in kg carbon per m2 per second kg m-2 s-1 T -FATES_FROOT_ALLOC_CANOPY_SZ allocation to fine root C for canopy plants by size class in kg carbon per m2 per second kg m-2 s-1 F -FATES_FROOT_ALLOC_SZPF allocation to fine roots by pft/size in kg carbon per m2 per second kg m-2 s-1 F -FATES_FROOT_ALLOC_USTORY_SZ allocation to fine roots for understory plants by size class in kg carbon per m2 per second kg m-2 s-1 F -FATES_FUELCONSUMED total fuel consumed in kg carbon per m2 land area kg m-2 T -FATES_FUEL_AMOUNT total ground fuel related to FATES_ROS (omits 1000hr fuels) in kg C per m2 land area kg m-2 T -FATES_FUEL_AMOUNT_AP spitfire ground fuel (kg carbon per m2) related to FATES_ROS (omits 1000hr fuels) within each kg m-2 T -FATES_FUEL_AMOUNT_APFC spitfire fuel quantity in each age x fuel class in kg carbon per m2 land area kg m-2 F -FATES_FUEL_AMOUNT_FC spitfire fuel-class level fuel amount in kg carbon per m2 land area kg m-2 T -FATES_FUEL_BULKD fuel bulk density in kg per m3 kg m-3 T -FATES_FUEL_BURNT_BURNFRAC_FC product of fraction (0-1) of fuel burnt and burnt fraction (divide by FATES_BURNFRAC to get bu 1 T -FATES_FUEL_EFF_MOIST spitfire fuel moisture (volumetric) m3 m-3 T -FATES_FUEL_MEF fuel moisture of extinction (volumetric) m3 m-3 T -FATES_FUEL_MOISTURE_FC spitfire fuel class-level fuel moisture (volumetric) m3 m-3 T -FATES_FUEL_SAV spitfire fuel surface area to volume ratio m-1 T -FATES_GDD site-level growing degree days degree_Celsius T -FATES_GPP gross primary production in kg carbon per m2 per second kg m-2 s-1 T -FATES_GPP_AP gross primary productivity by age bin in kg carbon per m2 per second kg m-2 s-1 F -FATES_GPP_CANOPY gross primary production of canopy plants in kg carbon per m2 per second kg m-2 s-1 T -FATES_GPP_CANOPY_SZPF gross primary production of canopy plants by pft/size in kg carbon per m2 per second kg m-2 s-1 F -FATES_GPP_PF total PFT-level GPP in kg carbon per m2 land area per second kg m-2 s-1 T -FATES_GPP_SECONDARY gross primary production in kg carbon per m2 per second, secondary patches kg m-2 s-1 T -FATES_GPP_SE_PF total PFT-level GPP in kg carbon per m2 land area per second, secondary patches kg m-2 s-1 T -FATES_GPP_SZPF gross primary production by pft/size in kg carbon per m2 per second kg m-2 s-1 F -FATES_GPP_USTORY gross primary production of understory plants in kg carbon per m2 per second kg m-2 s-1 T -FATES_GPP_USTORY_SZPF gross primary production of understory plants by pft/size in kg carbon per m2 per second kg m-2 s-1 F -FATES_GROWAR_CANOPY_SZ growth autotrophic respiration of canopy plants in kg carbon per m2 per second by size kg m-2 s-1 F -FATES_GROWAR_SZPF growth autotrophic respiration in kg carbon per m2 per second by pft/size kg m-2 s-1 F -FATES_GROWAR_USTORY_SZ growth autotrophic respiration of understory plants in kg carbon per m2 per second by size kg m-2 s-1 F -FATES_GROWTHFLUX_FUSION_SZPF flux of individuals into a given size class bin via fusion m-2 yr-1 F -FATES_GROWTHFLUX_SZPF flux of individuals into a given size class bin via growth and recruitment m-2 yr-1 F -FATES_GROWTH_RESP growth respiration in kg carbon per m2 per second kg m-2 s-1 T -FATES_GROWTH_RESP_SECONDARY growth respiration in kg carbon per m2 per second, secondary patches kg m-2 s-1 T -FATES_HARVEST_CARBON_FLUX harvest carbon flux in kg carbon per m2 per year kg m-2 yr-1 T -FATES_HARVEST_DEBT Accumulated carbon failed to be harvested kg C T -FATES_HARVEST_DEBT_SEC Accumulated carbon failed to be harvested from secondary patches kg C T -FATES_HET_RESP heterotrophic respiration in kg carbon per m2 per second kg m-2 s-1 T -FATES_IGNITIONS number of successful fire ignitions per m2 land area per second m-2 s-1 T -FATES_LAI leaf area index per m2 land area m2 m-2 T -FATES_LAISHA_TOP_CL LAI in the shade by the top leaf layer of each canopy layer m2 m-2 F -FATES_LAISHA_Z_CLLL LAI in the shade by each canopy and leaf layer m2 m-2 F -FATES_LAISHA_Z_CLLLPF LAI in the shade by each canopy, leaf, and PFT m2 m-2 F -FATES_LAISUN_TOP_CL LAI in the sun by the top leaf layer of each canopy layer m2 m-2 F -FATES_LAISUN_Z_CLLL LAI in the sun by each canopy and leaf layer m2 m-2 F -FATES_LAISUN_Z_CLLLPF LAI in the sun by each canopy, leaf, and PFT m2 m-2 F -FATES_LAI_AP leaf area index by age bin per m2 land area m2 m-2 T -FATES_LAI_CANOPY_SZ leaf area index (LAI) of canopy plants by size class m2 m-2 T -FATES_LAI_CANOPY_SZPF Leaf area index (LAI) of canopy plants by pft/size m2 m-2 F -FATES_LAI_SECONDARY leaf area index per m2 land area, secondary patches m2 m-2 T -FATES_LAI_USTORY_SZ leaf area index (LAI) of understory plants by size class m2 m-2 T -FATES_LAI_USTORY_SZPF Leaf area index (LAI) of understory plants by pft/size m2 m-2 F -FATES_LBLAYER_COND mean leaf boundary layer conductance mol m-2 s-1 T -FATES_LBLAYER_COND_AP mean leaf boundary layer conductance - by patch age mol m-2 s-1 F -FATES_LEAFAREA_HT leaf area height distribution m2 m-2 T -FATES_LEAFC total biomass in live plant leaves in kg carbon per m2 kg m-2 T -FATES_LEAFCTURN_CANOPY_SZ leaf turnover (non-mortal) for canopy plants by size class in kg carbon per m2 per second kg m-2 s-1 F -FATES_LEAFCTURN_USTORY_SZ leaf turnover (non-mortal) for understory plants by size class in kg carbon per m2 per second kg m-2 s-1 F -FATES_LEAFC_CANOPY_SZPF biomass in leaves of canopy plants by pft/size in kg carbon per m2 kg m-2 F -FATES_LEAFC_PF total PFT-level leaf biomass in kg carbon per m2 land area kg m-2 T -FATES_LEAFC_SZPF leaf carbon mass by size-class x pft in kg carbon per m2 kg m-2 F -FATES_LEAFC_USTORY_SZPF biomass in leaves of understory plants by pft/size in kg carbon per m2 kg m-2 F -FATES_LEAFMAINTAR leaf maintenance autotrophic respiration in kg carbon per m2 per second kg m-2 s-1 T -FATES_LEAF_ALLOC allocation to leaves in kg carbon per m2 per second kg m-2 s-1 T -FATES_LEAF_ALLOC_CANOPY_SZ allocation to leaves for canopy plants by size class in kg carbon per m2 per second kg m-2 s-1 F -FATES_LEAF_ALLOC_SZPF allocation to leaves by pft/size in kg carbon per m2 per second kg m-2 s-1 F -FATES_LEAF_ALLOC_USTORY_SZ allocation to leaves for understory plants by size class in kg carbon per m2 per second kg m-2 s-1 F -FATES_LITTER_AG_CWD_EL mass of aboveground litter in coarse woody debris (trunks/branches/twigs) by element kg m-2 T -FATES_LITTER_AG_FINE_EL mass of aboveground litter in fines (leaves, nonviable seed) by element kg m-2 T -FATES_LITTER_BG_CWD_EL mass of belowground litter in coarse woody debris (coarse roots) by element kg m-2 T -FATES_LITTER_BG_FINE_EL mass of belowground litter in fines (fineroots) by element kg m-2 T -FATES_LITTER_CWD_ELDC total mass of litter in coarse woody debris by element and coarse woody debris size kg m-2 T -FATES_LITTER_IN litter flux in kg carbon per m2 per second kg m-2 s-1 T -FATES_LITTER_IN_EL litter flux in in kg element per m2 per second kg m-2 s-1 T -FATES_LITTER_OUT litter flux out in kg carbon (exudation, fragmentation, seed decay) kg m-2 s-1 T -FATES_LITTER_OUT_EL litter flux out (exudation, fragmentation and seed decay) in kg element kg m-2 s-1 T -FATES_LSTEMMAINTAR live stem maintenance autotrophic respiration in kg carbon per m2 per second kg m-2 s-1 T -FATES_LSTEMMAINTAR_CANOPY_SZ live stem maintenance autotrophic respiration for canopy plants in kg carbon per m2 per second kg m-2 s-1 F -FATES_LSTEMMAINTAR_USTORY_SZ live stem maintenance autotrophic respiration for understory plants in kg carbon per m2 per se kg m-2 s-1 F -FATES_M3_MORTALITY_CANOPY_SZ C starvation mortality of canopy plants by size N/ha/yr F -FATES_M3_MORTALITY_CANOPY_SZPF C starvation mortality of canopy plants by pft/size N/ha/yr F -FATES_M3_MORTALITY_USTORY_SZ C starvation mortality of understory plants by size N/ha/yr F -FATES_M3_MORTALITY_USTORY_SZPF C starvation mortality of understory plants by pft/size N/ha/yr F -FATES_MAINTAR_CANOPY_SZ maintenance autotrophic respiration of canopy plants in kg carbon per m2 per second by size kg m-2 s-1 F -FATES_MAINTAR_SZPF maintenance autotrophic respiration in kg carbon per m2 per second by pft/size kg m-2 s-1 F -FATES_MAINTAR_USTORY_SZ maintenance autotrophic respiration of understory plants in kg carbon per m2 per second by siz kg m-2 s-1 F -FATES_MAINT_RESP maintenance respiration in kg carbon per m2 land area per second, secondary patches kg m-2 s-1 T -FATES_MAINT_RESP_SECONDARY maintenance respiration in kg carbon per m2 land area per second kg m-2 s-1 T -FATES_MAINT_RESP_UNREDUCED diagnostic maintenance respiration if the low-carbon-storage reduction is ignored kg m-2 s-1 F -FATES_MEANLIQVOL_DROUGHTPHEN_PF PFT-level mean liquid water volume for drought phenolgy m3 m-3 T -FATES_MEANSMP_DROUGHTPHEN_PF PFT-level mean soil matric potential for drought phenology Pa T -FATES_MORTALITY_AGESCEN_AC age senescence mortality by cohort age in number of plants per m2 per year m-2 yr-1 T -FATES_MORTALITY_AGESCEN_ACPF age senescence mortality by pft/cohort age in number of plants per m2 per year m-2 yr-1 F -FATES_MORTALITY_AGESCEN_SE_SZ age senescence mortality by size in number of plants per m2 per year, secondary patches m-2 yr-1 T -FATES_MORTALITY_AGESCEN_SZ age senescence mortality by size in number of plants per m2 per year m-2 yr-1 T -FATES_MORTALITY_AGESCEN_SZPF age senescence mortality by pft/size in number of plants per m2 per year m-2 yr-1 F -FATES_MORTALITY_BACKGROUND_SE_SZ background mortality by size in number of plants per m2 per year, secondary patches m-2 yr-1 T -FATES_MORTALITY_BACKGROUND_SZ background mortality by size in number of plants per m2 per year m-2 yr-1 T -FATES_MORTALITY_BACKGROUND_SZPF background mortality by pft/size in number of plants per m2 per year m-2 yr-1 F -FATES_MORTALITY_CAMBIALBURN_SZPF fire mortality from cambial burn by pft/size in number of plants per m2 per year m-2 yr-1 F -FATES_MORTALITY_CANOPY_SE_SZ total mortality of canopy trees by size class in number of plants per m2, secondary patches m-2 yr-1 T -FATES_MORTALITY_CANOPY_SZ total mortality of canopy trees by size class in number of plants per m2 m-2 yr-1 T -FATES_MORTALITY_CANOPY_SZAP mortality rate of canopy plants in number of plants per m2 per year in each size x age class m-2 yr-1 F -FATES_MORTALITY_CANOPY_SZPF total mortality of canopy plants by pft/size in number of plants per m2 per year m-2 yr-1 F -FATES_MORTALITY_CFLUX_CANOPY flux of biomass carbon from live to dead pools from mortality of canopy plants in kg carbon pe kg m-2 s-1 T -FATES_MORTALITY_CFLUX_PF PFT-level flux of biomass carbon from live to dead pool from mortality kg m-2 s-1 T -FATES_MORTALITY_CFLUX_USTORY flux of biomass carbon from live to dead pools from mortality of understory plants in kg carbo kg m-2 s-1 T -FATES_MORTALITY_CROWNSCORCH_SZPF fire mortality from crown scorch by pft/size in number of plants per m2 per year m-2 yr-1 F -FATES_MORTALITY_CSTARV_CFLUX_PF PFT-level flux of biomass carbon from live to dead pool from carbon starvation mortality kg m-2 s-1 T -FATES_MORTALITY_CSTARV_SE_SZ carbon starvation mortality by size in number of plants per m2 per year, secondary patches m-2 yr-1 T -FATES_MORTALITY_CSTARV_SZ carbon starvation mortality by size in number of plants per m2 per year m-2 yr-1 T -FATES_MORTALITY_CSTARV_SZPF carbon starvation mortality by pft/size in number of plants per m2 per year m-2 yr-1 F -FATES_MORTALITY_FIRE_CFLUX_PF PFT-level flux of biomass carbon from live to dead pool from fire mortality kg m-2 s-1 T -FATES_MORTALITY_FIRE_SZ fire mortality by size in number of plants per m2 per year m-2 yr-1 T -FATES_MORTALITY_FIRE_SZPF fire mortality by pft/size in number of plants per m2 per year m-2 yr-1 F -FATES_MORTALITY_FREEZING_SE_SZ freezing mortality by size in number of plants per m2 per event, secondary patches m-2 event-1 T -FATES_MORTALITY_FREEZING_SZ freezing mortality by size in number of plants per m2 per year m-2 yr-1 T -FATES_MORTALITY_FREEZING_SZPF freezing mortality by pft/size in number of plants per m2 per year m-2 yr-1 F -FATES_MORTALITY_HYDRAULIC_SE_SZ hydraulic mortality by size in number of plants per m2 per year, secondary patches m-2 yr-1 T -FATES_MORTALITY_HYDRAULIC_SZ hydraulic mortality by size in number of plants per m2 per year m-2 yr-1 T -FATES_MORTALITY_HYDRAULIC_SZPF hydraulic mortality by pft/size in number of plants per m2 per year m-2 yr-1 F -FATES_MORTALITY_HYDRO_CFLUX_PF PFT-level flux of biomass carbon from live to dead pool from hydraulic failure mortality kg m-2 s-1 T -FATES_MORTALITY_IMPACT_SZ impact mortality by size in number of plants per m2 per year m-2 yr-1 T -FATES_MORTALITY_IMPACT_SZPF impact mortality by pft/size in number of plants per m2 per year m-2 yr-1 F -FATES_MORTALITY_LOGGING_SE_SZ logging mortality by size in number of plants per m2 per event, secondary patches m-2 yr-1 T -FATES_MORTALITY_LOGGING_SZ logging mortality by size in number of plants per m2 per year m-2 yr-1 T -FATES_MORTALITY_LOGGING_SZPF logging mortality by pft/size in number of plants per m2 per year m-2 yr-1 F -FATES_MORTALITY_PF PFT-level mortality rate in number of individuals per m2 land area per year m-2 yr-1 T -FATES_MORTALITY_SENESCENCE_SE_SZ senescence mortality by size in number of plants per m2 per event, secondary patches m-2 yr-1 T -FATES_MORTALITY_SENESCENCE_SZ senescence mortality by size in number of plants per m2 per year m-2 yr-1 T -FATES_MORTALITY_SENESCENCE_SZPF senescence mortality by pft/size in number of plants per m2 per year m-2 yr-1 F -FATES_MORTALITY_TERMINATION_SZ termination mortality by size in number of plants per m2 per year m-2 yr-1 T -FATES_MORTALITY_TERMINATION_SZPF termination mortality by pft/size in number pf plants per m2 per year m-2 yr-1 F -FATES_MORTALITY_USTORY_SZ total mortality of understory trees by size class in individuals per m2 per year m-2 yr-1 T -FATES_MORTALITY_USTORY_SZAP mortality rate of understory plants in number of plants per m2 per year in each size x age cla m-2 yr-1 F -FATES_MORTALITY_USTORY_SZPF total mortality of understory plants by pft/size in number of plants per m2 per year m-2 yr-1 F -FATES_NCHILLDAYS site-level number of chill days days T -FATES_NCL_AP number of canopy levels by age bin F -FATES_NCOHORTS total number of cohorts per site T -FATES_NCOHORTS_SECONDARY total number of cohorts per site T -FATES_NCOLDDAYS site-level number of cold days days T -FATES_NEP net ecosystem production in kg carbon per m2 per second kg m-2 s-1 T -FATES_NESTEROV_INDEX nesterov fire danger index T -FATES_NET_C_UPTAKE_CLLL net carbon uptake in kg carbon per m2 per second by each canopy and leaf layer per unit ground kg m-2 s-1 F -FATES_NONSTRUCTC non-structural biomass (sapwood + leaf + fineroot) in kg carbon per m2 kg m-2 T -FATES_NPATCHES total number of patches per site T -FATES_NPATCHES_SECONDARY total number of patches per site T -FATES_NPATCH_AP number of patches by age bin F -FATES_NPLANT_AC number of plants per m2 by cohort age class m-2 T -FATES_NPLANT_ACPF stem number density by pft and age class m-2 F -FATES_NPLANT_CANOPY_SZ number of canopy plants per m2 by size class m-2 T -FATES_NPLANT_CANOPY_SZAP number of plants per m2 in canopy in each size x age class m-2 F -FATES_NPLANT_CANOPY_SZPF number of canopy plants by size/pft per m2 m-2 F -FATES_NPLANT_PF total PFT-level number of individuals per m2 land area m-2 T -FATES_NPLANT_SEC_PF total PFT-level number of individuals per m2 land area, secondary patches m-2 T -FATES_NPLANT_SZ number of plants per m2 by size class m-2 T -FATES_NPLANT_SZAP number of plants per m2 in each size x age class m-2 F -FATES_NPLANT_SZAPPF number of plants per m2 in each size x age x pft class m-2 F -FATES_NPLANT_SZPF stem number density by pft/size m-2 F -FATES_NPLANT_USTORY_SZ number of understory plants per m2 by size class m-2 T -FATES_NPLANT_USTORY_SZAP number of plants per m2 in understory in each size x age class m-2 F -FATES_NPLANT_USTORY_SZPF density of understory plants by pft/size in number of plants per m2 m-2 F -FATES_NPP net primary production in kg carbon per m2 per second kg m-2 s-1 T -FATES_NPP_AP net primary productivity by age bin in kg carbon per m2 per second kg m-2 s-1 F -FATES_NPP_APPF NPP per PFT in each age bin in kg carbon per m2 per second kg m-2 s-1 F -FATES_NPP_CANOPY_SZ NPP of canopy plants by size class in kg carbon per m2 per second kg m-2 s-1 F -FATES_NPP_PF total PFT-level NPP in kg carbon per m2 land area per second kg m-2 yr-1 T -FATES_NPP_SECONDARY net primary production in kg carbon per m2 per second, secondary patches kg m-2 s-1 T -FATES_NPP_SE_PF total PFT-level NPP in kg carbon per m2 land area per second, secondary patches kg m-2 yr-1 T -FATES_NPP_SZPF total net primary production by pft/size in kg carbon per m2 per second kg m-2 s-1 F -FATES_NPP_USTORY_SZ NPP of understory plants by size class in kg carbon per m2 per second kg m-2 s-1 F -FATES_PARPROF_DIF_CLLL radiative profile of diffuse PAR through each canopy and leaf layer (averaged across PFTs) W m-2 F -FATES_PARPROF_DIF_CLLLPF radiative profile of diffuse PAR through each canopy, leaf, and PFT W m-2 F -FATES_PARPROF_DIR_CLLL radiative profile of direct PAR through each canopy and leaf layer (averaged across PFTs) W m-2 F -FATES_PARPROF_DIR_CLLLPF radiative profile of direct PAR through each canopy, leaf, and PFT W m-2 F -FATES_PARSHA_Z_CL PAR absorbed in the shade by top leaf layer in each canopy layer W m-2 F -FATES_PARSHA_Z_CLLL PAR absorbed in the shade by each canopy and leaf layer W m-2 F -FATES_PARSHA_Z_CLLLPF PAR absorbed in the shade by each canopy, leaf, and PFT W m-2 F -FATES_PARSUN_Z_CL PAR absorbed in the sun by top leaf layer in each canopy layer W m-2 F -FATES_PARSUN_Z_CLLL PAR absorbed in the sun by each canopy and leaf layer W m-2 F -FATES_PARSUN_Z_CLLLPF PAR absorbed in the sun by each canopy, leaf, and PFT W m-2 F -FATES_PATCHAREA_AP patch area by age bin per m2 land area m2 m-2 T -FATES_PRIMARY_PATCHFUSION_ERR error in total primary lands associated with patch fusion m2 m-2 yr-1 T -FATES_PROMOTION_CARBONFLUX promotion-associated biomass carbon flux from understory to canopy in kg carbon per m2 per sec kg m-2 s-1 T -FATES_PROMOTION_RATE_SZ promotion rate from understory to canopy by size class m-2 yr-1 F -FATES_RAD_ERROR radiation error in FATES RTM W m-2 T -FATES_RDARK_CANOPY_SZ dark respiration for canopy plants in kg carbon per m2 per second by size kg m-2 s-1 F -FATES_RDARK_SZPF dark portion of maintenance autotrophic respiration in kg carbon per m2 per second by pft/size kg m-2 s-1 F -FATES_RDARK_USTORY_SZ dark respiration for understory plants in kg carbon per m2 per second by size kg m-2 s-1 F -FATES_RECRUITMENT_PF PFT-level recruitment rate in number of individuals per m2 land area per year m-2 yr-1 T -FATES_REPROC total biomass in live plant reproductive tissues in kg carbon per m2 kg m-2 T -FATES_REPROC_SZPF reproductive carbon mass (on plant) by size-class x pft in kg carbon per m2 kg m-2 F -FATES_ROS fire rate of spread in meters per second m s-1 T -FATES_SAI_CANOPY_SZ stem area index (SAI) of canopy plants by size class m2 m-2 F -FATES_SAI_USTORY_SZ stem area index (SAI) of understory plants by size class m2 m-2 F -FATES_SAPWOODC total biomass in live plant sapwood in kg carbon per m2 kg m-2 T -FATES_SAPWOODCTURN_CANOPY_SZ sapwood turnover (non-mortal) for canopy plants by size class in kg carbon per m2 per second kg m-2 s-1 F -FATES_SAPWOODCTURN_USTORY_SZ sapwood C turnover (non-mortal) for understory plants by size class in kg carbon per m2 per se kg m-2 s-1 F -FATES_SAPWOODC_SZPF sapwood carbon mass by size-class x pft in kg carbon per m2 kg m-2 F -FATES_SAPWOOD_ALLOC_CANOPY_SZ allocation to sapwood C for canopy plants by size class in kg carbon per m2 per second kg m-2 s-1 F -FATES_SAPWOOD_ALLOC_USTORY_SZ allocation to sapwood C for understory plants by size class in kg carbon per m2 per second kg m-2 s-1 F -FATES_SCORCH_HEIGHT_APPF SPITFIRE flame Scorch Height (calculated per PFT in each patch age bin) m F -FATES_SECONDAREA_ANTHRODIST_AP secondary forest patch area age distribution since anthropgenic disturbance m2 m-2 F -FATES_SECONDAREA_DIST_AP secondary forest patch area age distribution since any kind of disturbance m2 m-2 F -FATES_SECONDARY_FOREST_FRACTION secondary forest fraction m2 m-2 T -FATES_SECONDARY_FOREST_VEGC biomass on secondary lands in kg carbon per m2 land area (mult by FATES_SECONDARY_FOREST_FRACT kg m-2 T -FATES_SEEDS_IN seed production rate in kg carbon per m2 second kg m-2 s-1 T -FATES_SEEDS_IN_EXTERN_EL external seed influx rate in kg element per m2 per second kg m-2 s-1 T -FATES_SEEDS_IN_LOCAL_EL within-site, element-level seed production rate in kg element per m2 per second kg m-2 s-1 T -FATES_SEED_ALLOC allocation to seeds in kg carbon per m2 per second kg m-2 s-1 T -FATES_SEED_ALLOC_CANOPY_SZ allocation to reproductive C for canopy plants by size class in kg carbon per m2 per second kg m-2 s-1 F -FATES_SEED_ALLOC_SZPF allocation to seeds by pft/size in kg carbon per m2 per second kg m-2 s-1 F -FATES_SEED_ALLOC_USTORY_SZ allocation to reproductive C for understory plants by size class in kg carbon per m2 per secon kg m-2 s-1 F -FATES_SEED_BANK total seed mass of all PFTs in kg carbon per m2 land area kg m-2 T -FATES_SEED_BANK_EL element-level total seed mass of all PFTs in kg element per m2 kg m-2 T -FATES_SEED_DECAY_EL seed mass decay (germinated and un-germinated) in kg element per m2 per second kg m-2 s-1 T -FATES_SEED_GERM_EL element-level total germinated seed mass of all PFTs in kg element per m2 kg m-2 T -FATES_SEED_PROD_CANOPY_SZ seed production of canopy plants by size class in kg carbon per m2 per second kg m-2 s-1 F -FATES_SEED_PROD_USTORY_SZ seed production of understory plants by size class in kg carbon per m2 per second kg m-2 s-1 F -FATES_STEM_ALLOC allocation to stem in kg carbon per m2 per second kg m-2 s-1 T -FATES_STOMATAL_COND mean stomatal conductance mol m-2 s-1 T -FATES_STOMATAL_COND_AP mean stomatal conductance - by patch age mol m-2 s-1 F -FATES_STOREC total biomass in live plant storage in kg carbon per m2 land area kg m-2 T -FATES_STORECTURN_CANOPY_SZ storage turnover (non-mortal) for canopy plants by size class in kg carbon per m2 per second kg m-2 s-1 F -FATES_STORECTURN_USTORY_SZ storage C turnover (non-mortal) for understory plants by size class in kg carbon per m2 per se kg m-2 s-1 F -FATES_STOREC_CANOPY_SZPF biomass in storage pools of canopy plants by pft/size in kg carbon per m2 kg m-2 F -FATES_STOREC_PF total PFT-level stored biomass in kg carbon per m2 land area kg m-2 T -FATES_STOREC_SZPF storage carbon mass by size-class x pft in kg carbon per m2 kg m-2 F -FATES_STOREC_TF Storage C fraction of target kg kg-1 T -FATES_STOREC_TF_CANOPY_SZPF Storage C fraction of target by size x pft, in the canopy kg kg-1 F -FATES_STOREC_TF_USTORY_SZPF Storage C fraction of target by size x pft, in the understory kg kg-1 F -FATES_STOREC_USTORY_SZPF biomass in storage pools of understory plants by pft/size in kg carbon per m2 kg m-2 F -FATES_STORE_ALLOC allocation to storage tissues in kg carbon per m2 per second kg m-2 s-1 T -FATES_STORE_ALLOC_CANOPY_SZ allocation to storage C for canopy plants by size class in kg carbon per m2 per second kg m-2 s-1 F -FATES_STORE_ALLOC_SZPF allocation to storage C by pft/size in kg carbon per m2 per second kg m-2 s-1 F -FATES_STORE_ALLOC_USTORY_SZ allocation to storage C for understory plants by size class in kg carbon per m2 per second kg m-2 s-1 F -FATES_STRUCTC structural biomass in kg carbon per m2 land area kg m-2 T -FATES_STRUCTCTURN_CANOPY_SZ structural C turnover (non-mortal) for canopy plants by size class in kg carbon per m2 per sec kg m-2 s-1 F -FATES_STRUCTCTURN_USTORY_SZ structural C turnover (non-mortal) for understory plants by size class in kg carbon per m2 per kg m-2 s-1 F -FATES_STRUCT_ALLOC_CANOPY_SZ allocation to structural C for canopy plants by size class in kg carbon per m2 per second kg m-2 s-1 F -FATES_STRUCT_ALLOC_USTORY_SZ allocation to structural C for understory plants by size class in kg carbon per m2 per second kg m-2 s-1 F -FATES_TGROWTH fates long-term running mean vegetation temperature by site degree_Celsius F -FATES_TLONGTERM fates 30-year running mean vegetation temperature by site degree_Celsius F -FATES_TRIMMING degree to which canopy expansion is limited by leaf economics (0-1) 1 T -FATES_TRIMMING_CANOPY_SZ trimming term of canopy plants weighted by plant density, by size class m-2 F -FATES_TRIMMING_USTORY_SZ trimming term of understory plants weighted by plant density, by size class m-2 F -FATES_TVEG fates instantaneous mean vegetation temperature by site degree_Celsius T -FATES_TVEG24 fates 24-hr running mean vegetation temperature by site degree_Celsius T -FATES_USTORY_VEGC biomass of understory plants in kg carbon per m2 land area kg m-2 T -FATES_VEGC total biomass in live plants in kg carbon per m2 land area kg m-2 T -FATES_VEGC_ABOVEGROUND aboveground biomass in kg carbon per m2 land area kg m-2 T -FATES_VEGC_ABOVEGROUND_SZ aboveground biomass by size class in kg carbon per m2 kg m-2 T -FATES_VEGC_ABOVEGROUND_SZPF aboveground biomass by pft/size in kg carbon per m2 kg m-2 F -FATES_VEGC_AP total biomass within a given patch age bin in kg carbon per m2 land area kg m-2 F -FATES_VEGC_APPF biomass per PFT in each age bin in kg carbon per m2 kg m-2 F -FATES_VEGC_PF total PFT-level biomass in kg of carbon per land area kg m-2 T -FATES_VEGC_SE_PF total PFT-level biomass in kg of carbon per land area, secondary patches kg m-2 T -FATES_VEGC_SZ total biomass by size class in kg carbon per m2 kg m-2 F -FATES_VEGC_SZPF total vegetation biomass in live plants by size-class x pft in kg carbon per m2 kg m-2 F -FATES_WOOD_PRODUCT total wood product from logging in kg carbon per m2 land area kg m-2 T -FATES_YESTCANLEV_CANOPY_SZ yesterdays canopy level for canopy plants by size class in number of plants per m2 m-2 F -FATES_YESTCANLEV_USTORY_SZ yesterdays canopy level for understory plants by size class in number of plants per m2 m-2 F -FATES_ZSTAR_AP product of zstar and patch area by age bin (divide by FATES_PATCHAREA_AP to get mean zstar) m F -FATES_c_to_litr_cel_c litter celluluse carbon flux from FATES to BGC gC/m^3/s T -FATES_c_to_litr_lab_c litter labile carbon flux from FATES to BGC gC/m^3/s T -FATES_c_to_litr_lig_c litter lignin carbon flux from FATES to BGC gC/m^3/s T -FCEV canopy evaporation W/m^2 T -FCH4 Gridcell surface CH4 flux to atmosphere (+ to atm) kgC/m2/s T -FCH4TOCO2 Gridcell oxidation of CH4 to CO2 gC/m2/s T -FCH4_DFSAT CH4 additional flux due to changing fsat, natural vegetated and crop landunits only kgC/m2/s T -FCO2 CO2 flux to atmosphere (+ to atm) kgCO2/m2/s F -FCOV fractional impermeable area unitless T -FCTR canopy transpiration W/m^2 T -FGEV ground evaporation W/m^2 T -FGR heat flux into soil/snow including snow melt and lake / snow light transmission W/m^2 T -FGR12 heat flux between soil layers 1 and 2 W/m^2 T -FGR_ICE heat flux into soil/snow including snow melt and lake / snow light transmission (ice landunits W/m^2 F -FGR_R Rural heat flux into soil/snow including snow melt and snow light transmission W/m^2 F -FGR_SOIL_R Rural downward heat flux at interface below each soil layer watt/m^2 F -FGR_U Urban heat flux into soil/snow including snow melt W/m^2 F -FH2OSFC fraction of ground covered by surface water unitless T -FH2OSFC_NOSNOW fraction of ground covered by surface water (if no snow present) unitless F -FINUNDATED fractional inundated area of vegetated columns unitless T -FINUNDATED_LAG time-lagged inundated fraction of vegetated columns unitless F -FIRA net infrared (longwave) radiation W/m^2 T -FIRA_ICE net infrared (longwave) radiation (ice landunits only) W/m^2 F -FIRA_R Rural net infrared (longwave) radiation W/m^2 T -FIRA_U Urban net infrared (longwave) radiation W/m^2 F -FIRE emitted infrared (longwave) radiation W/m^2 T -FIRE_ICE emitted infrared (longwave) radiation (ice landunits only) W/m^2 F -FIRE_R Rural emitted infrared (longwave) radiation W/m^2 T -FIRE_U Urban emitted infrared (longwave) radiation W/m^2 F -FLDS atmospheric longwave radiation (downscaled to columns in glacier regions) W/m^2 T -FLDS_ICE atmospheric longwave radiation (downscaled to columns in glacier regions) (ice landunits only) W/m^2 F -FMAX_DENIT_CARBONSUBSTRATE FMAX_DENIT_CARBONSUBSTRATE gN/m^3/s F -FMAX_DENIT_NITRATE FMAX_DENIT_NITRATE gN/m^3/s F -FROST_TABLE frost table depth (natural vegetated and crop landunits only) m F -FSA absorbed solar radiation W/m^2 T -FSAT fractional area with water table at surface unitless T -FSA_ICE absorbed solar radiation (ice landunits only) W/m^2 F -FSA_R Rural absorbed solar radiation W/m^2 F -FSA_U Urban absorbed solar radiation W/m^2 F -FSD24 direct radiation (last 24hrs) K F -FSD240 direct radiation (last 240hrs) K F -FSDS atmospheric incident solar radiation W/m^2 T -FSDSND direct nir incident solar radiation W/m^2 T -FSDSNDLN direct nir incident solar radiation at local noon W/m^2 T -FSDSNI diffuse nir incident solar radiation W/m^2 T -FSDSVD direct vis incident solar radiation W/m^2 T -FSDSVDLN direct vis incident solar radiation at local noon W/m^2 T -FSDSVI diffuse vis incident solar radiation W/m^2 T -FSDSVILN diffuse vis incident solar radiation at local noon W/m^2 T -FSH sensible heat not including correction for land use change and rain/snow conversion W/m^2 T -FSH_G sensible heat from ground W/m^2 T -FSH_ICE sensible heat not including correction for land use change and rain/snow conversion (ice landu W/m^2 F -FSH_PRECIP_CONVERSION Sensible heat flux from conversion of rain/snow atm forcing W/m^2 T -FSH_R Rural sensible heat W/m^2 T -FSH_RUNOFF_ICE_TO_LIQ sensible heat flux generated from conversion of ice runoff to liquid W/m^2 T -FSH_TO_COUPLER sensible heat sent to coupler (includes corrections for land use change, rain/snow conversion W/m^2 T -FSH_U Urban sensible heat W/m^2 F -FSH_V sensible heat from veg W/m^2 T -FSI24 indirect radiation (last 24hrs) K F -FSI240 indirect radiation (last 240hrs) K F -FSM snow melt heat flux W/m^2 T -FSM_ICE snow melt heat flux (ice landunits only) W/m^2 F -FSM_R Rural snow melt heat flux W/m^2 F -FSM_U Urban snow melt heat flux W/m^2 F -FSNO fraction of ground covered by snow unitless T -FSNO_EFF effective fraction of ground covered by snow unitless T -FSNO_ICE fraction of ground covered by snow (ice landunits only) unitless F -FSR reflected solar radiation W/m^2 T -FSRND direct nir reflected solar radiation W/m^2 T -FSRNDLN direct nir reflected solar radiation at local noon W/m^2 T -FSRNI diffuse nir reflected solar radiation W/m^2 T -FSRVD direct vis reflected solar radiation W/m^2 T -FSRVDLN direct vis reflected solar radiation at local noon W/m^2 T -FSRVI diffuse vis reflected solar radiation W/m^2 T -FSR_ICE reflected solar radiation (ice landunits only) W/m^2 F -FSUN sunlit fraction of canopy proportion F -FSUN24 fraction sunlit (last 24hrs) K F -FSUN240 fraction sunlit (last 240hrs) K F -F_DENIT denitrification flux gN/m^2/s T -F_DENIT_BASE F_DENIT_BASE gN/m^3/s F -F_DENIT_vr denitrification flux gN/m^3/s F -F_N2O_DENIT denitrification N2O flux gN/m^2/s T -F_N2O_NIT nitrification N2O flux gN/m^2/s T -F_NIT nitrification flux gN/m^2/s T -F_NIT_vr nitrification flux gN/m^3/s F -GROSS_NMIN gross rate of N mineralization gN/m^2/s T -GROSS_NMIN_vr gross rate of N mineralization gN/m^3/s F -GSSHA shaded leaf stomatal conductance umol H20/m2/s T -GSSHALN shaded leaf stomatal conductance at local noon umol H20/m2/s T -GSSUN sunlit leaf stomatal conductance umol H20/m2/s T -GSSUNLN sunlit leaf stomatal conductance at local noon umol H20/m2/s T -H2OCAN intercepted water mm T -H2OSFC surface water depth mm T -H2OSNO snow depth (liquid water) mm T -H2OSNO_ICE snow depth (liquid water, ice landunits only) mm F -H2OSNO_TOP mass of snow in top snow layer kg/m2 T -H2OSOI volumetric soil water (natural vegetated and crop landunits only) mm3/mm3 T -HBOT canopy bottom m F -HEAT_CONTENT1 initial gridcell total heat content J/m^2 T -HEAT_CONTENT1_VEG initial gridcell total heat content - natural vegetated and crop landunits only J/m^2 F -HEAT_CONTENT2 post land cover change total heat content J/m^2 F -HEAT_FROM_AC sensible heat flux put into canyon due to heat removed from air conditioning W/m^2 T -HIA 2 m NWS Heat Index C T -HIA_R Rural 2 m NWS Heat Index C T -HIA_U Urban 2 m NWS Heat Index C T -HK hydraulic conductivity (natural vegetated and crop landunits only) mm/s F -HR total heterotrophic respiration gC/m^2/s T -HR_vr total vertically resolved heterotrophic respiration gC/m^3/s T -HTOP canopy top m T -HUMIDEX 2 m Humidex C T -HUMIDEX_R Rural 2 m Humidex C T -HUMIDEX_U Urban 2 m Humidex C T -ICE_CONTENT1 initial gridcell total ice content mm T -ICE_CONTENT2 post land cover change total ice content mm F -ICE_MODEL_FRACTION Ice sheet model fractional coverage unitless F -INT_SNOW accumulated swe (natural vegetated and crop landunits only) mm F -INT_SNOW_ICE accumulated swe (ice landunits only) mm F -IWUELN local noon intrinsic water use efficiency umolCO2/molH2O T -KROOT root conductance each soil layer 1/s F -KSOIL soil conductance in each soil layer 1/s F -K_ACT_SOM active soil organic potential loss coefficient 1/s F -K_CEL_LIT cellulosic litter potential loss coefficient 1/s F -K_LIG_LIT lignin litter potential loss coefficient 1/s F -K_MET_LIT metabolic litter potential loss coefficient 1/s F -K_NITR K_NITR 1/s F -K_NITR_H2O K_NITR_H2O unitless F -K_NITR_PH K_NITR_PH unitless F -K_NITR_T K_NITR_T unitless F -K_PAS_SOM passive soil organic potential loss coefficient 1/s F -K_SLO_SOM slow soil organic ma potential loss coefficient 1/s F -L1_PATHFRAC_S1_vr PATHFRAC from metabolic litter to active soil organic fraction F -L1_RESP_FRAC_S1_vr respired from metabolic litter to active soil organic fraction F -L2_PATHFRAC_S1_vr PATHFRAC from cellulosic litter to active soil organic fraction F -L2_RESP_FRAC_S1_vr respired from cellulosic litter to active soil organic fraction F -L3_PATHFRAC_S2_vr PATHFRAC from lignin litter to slow soil organic ma fraction F -L3_RESP_FRAC_S2_vr respired from lignin litter to slow soil organic ma fraction F -LAI240 240hr average of leaf area index m^2/m^2 F -LAISHA shaded projected leaf area index m^2/m^2 T -LAISUN sunlit projected leaf area index m^2/m^2 T -LAKEICEFRAC lake layer ice mass fraction unitless F -LAKEICEFRAC_SURF surface lake layer ice mass fraction unitless T -LAKEICETHICK thickness of lake ice (including physical expansion on freezing) m T -LIG_LITC LIG_LIT C gC/m^2 T -LIG_LITC_1m LIG_LIT C to 1 meter gC/m^2 F -LIG_LITC_TNDNCY_VERT_TRA lignin litter C tendency due to vertical transport gC/m^3/s F -LIG_LITC_TO_SLO_SOMC decomp. of lignin litter C to slow soil organic ma C gC/m^2/s F -LIG_LITC_TO_SLO_SOMC_vr decomp. of lignin litter C to slow soil organic ma C gC/m^3/s F -LIG_LITC_vr LIG_LIT C (vertically resolved) gC/m^3 T -LIG_LITN LIG_LIT N gN/m^2 T -LIG_LITN_1m LIG_LIT N to 1 meter gN/m^2 F -LIG_LITN_TNDNCY_VERT_TRA lignin litter N tendency due to vertical transport gN/m^3/s F -LIG_LITN_TO_SLO_SOMN decomp. of lignin litter N to slow soil organic ma N gN/m^2 F -LIG_LITN_TO_SLO_SOMN_vr decomp. of lignin litter N to slow soil organic ma N gN/m^3 F -LIG_LITN_vr LIG_LIT N (vertically resolved) gN/m^3 T -LIG_LIT_HR Het. Resp. from lignin litter gC/m^2/s F -LIG_LIT_HR_vr Het. Resp. from lignin litter gC/m^3/s F -LIQCAN intercepted liquid water mm T -LIQUID_CONTENT1 initial gridcell total liq content mm T -LIQUID_CONTENT2 post landuse change gridcell total liq content mm F -LIQUID_WATER_TEMP1 initial gridcell weighted average liquid water temperature K F -LITTERC_HR litter C heterotrophic respiration gC/m^2/s T -LNC leaf N concentration gN leaf/m^2 T -LWdown atmospheric longwave radiation (downscaled to columns in glacier regions) W/m^2 F -LWup upwelling longwave radiation W/m^2 F -MET_LITC MET_LIT C gC/m^2 T -MET_LITC_1m MET_LIT C to 1 meter gC/m^2 F -MET_LITC_TNDNCY_VERT_TRA metabolic litter C tendency due to vertical transport gC/m^3/s F -MET_LITC_TO_ACT_SOMC decomp. of metabolic litter C to active soil organic C gC/m^2/s F -MET_LITC_TO_ACT_SOMC_vr decomp. of metabolic litter C to active soil organic C gC/m^3/s F -MET_LITC_vr MET_LIT C (vertically resolved) gC/m^3 T -MET_LITN MET_LIT N gN/m^2 T -MET_LITN_1m MET_LIT N to 1 meter gN/m^2 F -MET_LITN_TNDNCY_VERT_TRA metabolic litter N tendency due to vertical transport gN/m^3/s F -MET_LITN_TO_ACT_SOMN decomp. of metabolic litter N to active soil organic N gN/m^2 F -MET_LITN_TO_ACT_SOMN_vr decomp. of metabolic litter N to active soil organic N gN/m^3 F -MET_LITN_vr MET_LIT N (vertically resolved) gN/m^3 T -MET_LIT_HR Het. Resp. from metabolic litter gC/m^2/s F -MET_LIT_HR_vr Het. Resp. from metabolic litter gC/m^3/s F -MORTALITY_CROWNAREA_CANOPY Crown area of canopy trees that died m2/ha/year T -MORTALITY_CROWNAREA_UNDERSTORY Crown aera of understory trees that died m2/ha/year T -M_ACT_SOMC_TO_LEACHING active soil organic C leaching loss gC/m^2/s F -M_ACT_SOMN_TO_LEACHING active soil organic N leaching loss gN/m^2/s F -M_CEL_LITC_TO_LEACHING cellulosic litter C leaching loss gC/m^2/s F -M_CEL_LITN_TO_LEACHING cellulosic litter N leaching loss gN/m^2/s F -M_LIG_LITC_TO_LEACHING lignin litter C leaching loss gC/m^2/s F -M_LIG_LITN_TO_LEACHING lignin litter N leaching loss gN/m^2/s F -M_MET_LITC_TO_LEACHING metabolic litter C leaching loss gC/m^2/s F -M_MET_LITN_TO_LEACHING metabolic litter N leaching loss gN/m^2/s F -M_PAS_SOMC_TO_LEACHING passive soil organic C leaching loss gC/m^2/s F -M_PAS_SOMN_TO_LEACHING passive soil organic N leaching loss gN/m^2/s F -M_SLO_SOMC_TO_LEACHING slow soil organic ma C leaching loss gC/m^2/s F -M_SLO_SOMN_TO_LEACHING slow soil organic ma N leaching loss gN/m^2/s F -NDEP_TO_SMINN atmospheric N deposition to soil mineral N gN/m^2/s T -NEM Gridcell net adjustment to net carbon exchange passed to atm. for methane production gC/m2/s T -NET_NMIN net rate of N mineralization gN/m^2/s T -NET_NMIN_vr net rate of N mineralization gN/m^3/s F -NFIX_TO_SMINN symbiotic/asymbiotic N fixation to soil mineral N gN/m^2/s T -NSUBSTEPS number of adaptive timesteps in CLM timestep unitless F -O2_DECOMP_DEPTH_UNSAT O2 consumption from HR and AR for non-inundated area mol/m3/s F -OBU Monin-Obukhov length m F -OCDEP total OC deposition (dry+wet) from atmosphere kg/m^2/s T -O_SCALAR fraction by which decomposition is reduced due to anoxia unitless T -PARVEGLN absorbed par by vegetation at local noon W/m^2 T -PAS_SOMC PAS_SOM C gC/m^2 T -PAS_SOMC_1m PAS_SOM C to 1 meter gC/m^2 F -PAS_SOMC_TNDNCY_VERT_TRA passive soil organic C tendency due to vertical transport gC/m^3/s F -PAS_SOMC_TO_ACT_SOMC decomp. of passive soil organic C to active soil organic C gC/m^2/s F -PAS_SOMC_TO_ACT_SOMC_vr decomp. of passive soil organic C to active soil organic C gC/m^3/s F -PAS_SOMC_vr PAS_SOM C (vertically resolved) gC/m^3 T -PAS_SOMN PAS_SOM N gN/m^2 T -PAS_SOMN_1m PAS_SOM N to 1 meter gN/m^2 F -PAS_SOMN_TNDNCY_VERT_TRA passive soil organic N tendency due to vertical transport gN/m^3/s F -PAS_SOMN_TO_ACT_SOMN decomp. of passive soil organic N to active soil organic N gN/m^2 F -PAS_SOMN_TO_ACT_SOMN_vr decomp. of passive soil organic N to active soil organic N gN/m^3 F -PAS_SOMN_vr PAS_SOM N (vertically resolved) gN/m^3 T -PAS_SOM_HR Het. Resp. from passive soil organic gC/m^2/s F -PAS_SOM_HR_vr Het. Resp. from passive soil organic gC/m^3/s F -PBOT atmospheric pressure at surface (downscaled to columns in glacier regions) Pa T -PCH4 atmospheric partial pressure of CH4 Pa T -PCO2 atmospheric partial pressure of CO2 Pa T -POTENTIAL_IMMOB potential N immobilization gN/m^2/s T -POTENTIAL_IMMOB_vr potential N immobilization gN/m^3/s F -POT_F_DENIT potential denitrification flux gN/m^2/s T -POT_F_DENIT_vr potential denitrification flux gN/m^3/s F -POT_F_NIT potential nitrification flux gN/m^2/s T -POT_F_NIT_vr potential nitrification flux gN/m^3/s F -PSurf atmospheric pressure at surface (downscaled to columns in glacier regions) Pa F -Q2M 2m specific humidity kg/kg T -QAF canopy air humidity kg/kg F -QBOT atmospheric specific humidity (downscaled to columns in glacier regions) kg/kg T -QDIRECT_THROUGHFALL direct throughfall of liquid (rain + above-canopy irrigation) mm/s F -QDIRECT_THROUGHFALL_SNOW direct throughfall of snow mm/s F -QDRAI sub-surface drainage mm/s T -QDRAI_PERCH perched wt drainage mm/s T -QDRAI_XS saturation excess drainage mm/s T -QDRIP rate of excess canopy liquid falling off canopy mm/s F -QDRIP_SNOW rate of excess canopy snow falling off canopy mm/s F -QFLOOD runoff from river flooding mm/s T -QFLX_EVAP_TOT qflx_evap_soi + qflx_evap_can + qflx_tran_veg kg m-2 s-1 T -QFLX_EVAP_VEG vegetation evaporation mm H2O/s F -QFLX_ICE_DYNBAL ice dynamic land cover change conversion runoff flux mm/s T -QFLX_LIQDEW_TO_TOP_LAYER rate of liquid water deposited on top soil or snow layer (dew) mm H2O/s T -QFLX_LIQEVAP_FROM_TOP_LAYER rate of liquid water evaporated from top soil or snow layer mm H2O/s T -QFLX_LIQ_DYNBAL liq dynamic land cover change conversion runoff flux mm/s T -QFLX_LIQ_GRND liquid (rain+irrigation) on ground after interception mm H2O/s F -QFLX_SNOW_DRAIN drainage from snow pack mm/s T -QFLX_SNOW_DRAIN_ICE drainage from snow pack melt (ice landunits only) mm/s T -QFLX_SNOW_GRND snow on ground after interception mm H2O/s F -QFLX_SOLIDDEW_TO_TOP_LAYER rate of solid water deposited on top soil or snow layer (frost) mm H2O/s T -QFLX_SOLIDEVAP_FROM_TOP_LAYER rate of ice evaporated from top soil or snow layer (sublimation) (also includes bare ice subli mm H2O/s T -QFLX_SOLIDEVAP_FROM_TOP_LAYER_ICE rate of ice evaporated from top soil or snow layer (sublimation) (also includes bare ice subli mm H2O/s F -QH2OSFC surface water runoff mm/s T -QH2OSFC_TO_ICE surface water converted to ice mm/s F -QHR hydraulic redistribution mm/s T -QICE ice growth/melt mm/s T -QICE_FORC qice forcing sent to GLC mm/s F -QICE_FRZ ice growth mm/s T -QICE_MELT ice melt mm/s T -QINFL infiltration mm/s T -QINTR interception mm/s T -QIRRIG_DEMAND irrigation demand mm/s F -QIRRIG_DRIP water added via drip irrigation mm/s F -QIRRIG_FROM_GW_CONFINED water added through confined groundwater irrigation mm/s T -QIRRIG_FROM_GW_UNCONFINED water added through unconfined groundwater irrigation mm/s T -QIRRIG_FROM_SURFACE water added through surface water irrigation mm/s T -QIRRIG_SPRINKLER water added via sprinkler irrigation mm/s F -QOVER total surface runoff (includes QH2OSFC) mm/s T -QOVER_LAG time-lagged surface runoff for soil columns mm/s F -QPHSNEG net negative hydraulic redistribution flux mm/s F -QRGWL surface runoff at glaciers (liquid only), wetlands, lakes; also includes melted ice runoff fro mm/s T -QROOTSINK water flux from soil to root in each soil-layer mm/s F -QRUNOFF total liquid runoff not including correction for land use change mm/s T -QRUNOFF_ICE total liquid runoff not incl corret for LULCC (ice landunits only) mm/s T -QRUNOFF_ICE_TO_COUPLER total ice runoff sent to coupler (includes corrections for land use change) mm/s T -QRUNOFF_ICE_TO_LIQ liquid runoff from converted ice runoff mm/s F -QRUNOFF_R Rural total runoff mm/s F -QRUNOFF_TO_COUPLER total liquid runoff sent to coupler (includes corrections for land use change) mm/s T -QRUNOFF_U Urban total runoff mm/s F -QSNOCPLIQ excess liquid h2o due to snow capping not including correction for land use change mm H2O/s T -QSNOEVAP evaporation from snow (only when snl<0, otherwise it is equal to qflx_ev_soil) mm/s T -QSNOFRZ column-integrated snow freezing rate kg/m2/s T -QSNOFRZ_ICE column-integrated snow freezing rate (ice landunits only) mm/s T -QSNOMELT snow melt rate mm/s T -QSNOMELT_ICE snow melt (ice landunits only) mm/s T -QSNOUNLOAD canopy snow unloading mm/s T -QSNO_TEMPUNLOAD canopy snow temp unloading mm/s T -QSNO_WINDUNLOAD canopy snow wind unloading mm/s T -QSNWCPICE excess solid h2o due to snow capping not including correction for land use change mm H2O/s T -QSOIL Ground evaporation (soil/snow evaporation + soil/snow sublimation - dew) mm/s T -QSOIL_ICE Ground evaporation (ice landunits only) mm/s T -QTOPSOIL water input to surface mm/s F -QVEGE canopy evaporation mm/s T -QVEGT canopy transpiration mm/s T -Qair atmospheric specific humidity (downscaled to columns in glacier regions) kg/kg F -Qh sensible heat W/m^2 F -Qle total evaporation W/m^2 F -Qstor storage heat flux (includes snowmelt) W/m^2 F -Qtau momentum flux kg/m/s^2 F -RAH1 aerodynamical resistance s/m F -RAH2 aerodynamical resistance s/m F -RAIN atmospheric rain, after rain/snow repartitioning based on temperature mm/s T -RAIN_FROM_ATM atmospheric rain received from atmosphere (pre-repartitioning) mm/s T -RAIN_ICE atmospheric rain, after rain/snow repartitioning based on temperature (ice landunits only) mm/s F -RAM_LAKE aerodynamic resistance for momentum (lakes only) s/m F -RAW1 aerodynamical resistance s/m F -RAW2 aerodynamical resistance s/m F -RB leaf boundary resistance s/m F -RH atmospheric relative humidity % F -RH2M 2m relative humidity % T -RH2M_R Rural 2m specific humidity % F -RH2M_U Urban 2m relative humidity % F -RHAF fractional humidity of canopy air fraction F -RH_LEAF fractional humidity at leaf surface fraction F -RSCANOPY canopy resistance s m-1 T -RSSHA shaded leaf stomatal resistance s/m T -RSSUN sunlit leaf stomatal resistance s/m T -Rainf atmospheric rain, after rain/snow repartitioning based on temperature mm/s F -Rnet net radiation W/m^2 F -S1_PATHFRAC_S2_vr PATHFRAC from active soil organic to slow soil organic ma fraction F -S1_PATHFRAC_S3_vr PATHFRAC from active soil organic to passive soil organic fraction F -S1_RESP_FRAC_S2_vr respired from active soil organic to slow soil organic ma fraction F -S1_RESP_FRAC_S3_vr respired from active soil organic to passive soil organic fraction F -S2_PATHFRAC_S1_vr PATHFRAC from slow soil organic ma to active soil organic fraction F -S2_PATHFRAC_S3_vr PATHFRAC from slow soil organic ma to passive soil organic fraction F -S2_RESP_FRAC_S1_vr respired from slow soil organic ma to active soil organic fraction F -S2_RESP_FRAC_S3_vr respired from slow soil organic ma to passive soil organic fraction F -S3_PATHFRAC_S1_vr PATHFRAC from passive soil organic to active soil organic fraction F -S3_RESP_FRAC_S1_vr respired from passive soil organic to active soil organic fraction F -SABG solar rad absorbed by ground W/m^2 T -SABG_PEN Rural solar rad penetrating top soil or snow layer watt/m^2 T -SABV solar rad absorbed by veg W/m^2 T -SLO_SOMC SLO_SOM C gC/m^2 T -SLO_SOMC_1m SLO_SOM C to 1 meter gC/m^2 F -SLO_SOMC_TNDNCY_VERT_TRA slow soil organic ma C tendency due to vertical transport gC/m^3/s F -SLO_SOMC_TO_ACT_SOMC decomp. of slow soil organic ma C to active soil organic C gC/m^2/s F -SLO_SOMC_TO_ACT_SOMC_vr decomp. of slow soil organic ma C to active soil organic C gC/m^3/s F -SLO_SOMC_TO_PAS_SOMC decomp. of slow soil organic ma C to passive soil organic C gC/m^2/s F -SLO_SOMC_TO_PAS_SOMC_vr decomp. of slow soil organic ma C to passive soil organic C gC/m^3/s F -SLO_SOMC_vr SLO_SOM C (vertically resolved) gC/m^3 T -SLO_SOMN SLO_SOM N gN/m^2 T -SLO_SOMN_1m SLO_SOM N to 1 meter gN/m^2 F -SLO_SOMN_TNDNCY_VERT_TRA slow soil organic ma N tendency due to vertical transport gN/m^3/s F -SLO_SOMN_TO_ACT_SOMN decomp. of slow soil organic ma N to active soil organic N gN/m^2 F -SLO_SOMN_TO_ACT_SOMN_vr decomp. of slow soil organic ma N to active soil organic N gN/m^3 F -SLO_SOMN_TO_PAS_SOMN decomp. of slow soil organic ma N to passive soil organic N gN/m^2 F -SLO_SOMN_TO_PAS_SOMN_vr decomp. of slow soil organic ma N to passive soil organic N gN/m^3 F -SLO_SOMN_vr SLO_SOM N (vertically resolved) gN/m^3 T -SLO_SOM_HR_S1 Het. Resp. from slow soil organic ma gC/m^2/s F -SLO_SOM_HR_S1_vr Het. Resp. from slow soil organic ma gC/m^3/s F -SLO_SOM_HR_S3 Het. Resp. from slow soil organic ma gC/m^2/s F -SLO_SOM_HR_S3_vr Het. Resp. from slow soil organic ma gC/m^3/s F -SMINN soil mineral N gN/m^2 T -SMINN_TO_PLANT plant uptake of soil mineral N gN/m^2/s T -SMINN_TO_PLANT_vr plant uptake of soil mineral N gN/m^3/s F -SMINN_TO_S1N_L1 mineral N flux for decomp. of MET_LITto ACT_SOM gN/m^2 F -SMINN_TO_S1N_L1_vr mineral N flux for decomp. of MET_LITto ACT_SOM gN/m^3 F -SMINN_TO_S1N_L2 mineral N flux for decomp. of CEL_LITto ACT_SOM gN/m^2 F -SMINN_TO_S1N_L2_vr mineral N flux for decomp. of CEL_LITto ACT_SOM gN/m^3 F -SMINN_TO_S1N_S2 mineral N flux for decomp. of SLO_SOMto ACT_SOM gN/m^2 F -SMINN_TO_S1N_S2_vr mineral N flux for decomp. of SLO_SOMto ACT_SOM gN/m^3 F -SMINN_TO_S1N_S3 mineral N flux for decomp. of PAS_SOMto ACT_SOM gN/m^2 F -SMINN_TO_S1N_S3_vr mineral N flux for decomp. of PAS_SOMto ACT_SOM gN/m^3 F -SMINN_TO_S2N_L3 mineral N flux for decomp. of LIG_LITto SLO_SOM gN/m^2 F -SMINN_TO_S2N_L3_vr mineral N flux for decomp. of LIG_LITto SLO_SOM gN/m^3 F -SMINN_TO_S2N_S1 mineral N flux for decomp. of ACT_SOMto SLO_SOM gN/m^2 F -SMINN_TO_S2N_S1_vr mineral N flux for decomp. of ACT_SOMto SLO_SOM gN/m^3 F -SMINN_TO_S3N_S1 mineral N flux for decomp. of ACT_SOMto PAS_SOM gN/m^2 F -SMINN_TO_S3N_S1_vr mineral N flux for decomp. of ACT_SOMto PAS_SOM gN/m^3 F -SMINN_TO_S3N_S2 mineral N flux for decomp. of SLO_SOMto PAS_SOM gN/m^2 F -SMINN_TO_S3N_S2_vr mineral N flux for decomp. of SLO_SOMto PAS_SOM gN/m^3 F -SMINN_vr soil mineral N gN/m^3 T -SMIN_NH4 soil mineral NH4 gN/m^2 T -SMIN_NH4_TO_PLANT plant uptake of NH4 gN/m^3/s F -SMIN_NH4_vr soil mineral NH4 (vert. res.) gN/m^3 T -SMIN_NO3 soil mineral NO3 gN/m^2 T -SMIN_NO3_LEACHED soil NO3 pool loss to leaching gN/m^2/s T -SMIN_NO3_LEACHED_vr soil NO3 pool loss to leaching gN/m^3/s F -SMIN_NO3_MASSDENS SMIN_NO3_MASSDENS ugN/cm^3 soil F -SMIN_NO3_RUNOFF soil NO3 pool loss to runoff gN/m^2/s T -SMIN_NO3_RUNOFF_vr soil NO3 pool loss to runoff gN/m^3/s F -SMIN_NO3_TO_PLANT plant uptake of NO3 gN/m^3/s F -SMIN_NO3_vr soil mineral NO3 (vert. res.) gN/m^3 T -SMP soil matric potential (natural vegetated and crop landunits only) mm T -SNOBCMCL mass of BC in snow column kg/m2 T -SNOBCMSL mass of BC in top snow layer kg/m2 T -SNOCAN intercepted snow mm T -SNODSTMCL mass of dust in snow column kg/m2 T -SNODSTMSL mass of dust in top snow layer kg/m2 T -SNOFSDSND direct nir incident solar radiation on snow W/m^2 F -SNOFSDSNI diffuse nir incident solar radiation on snow W/m^2 F -SNOFSDSVD direct vis incident solar radiation on snow W/m^2 F -SNOFSDSVI diffuse vis incident solar radiation on snow W/m^2 F -SNOFSRND direct nir reflected solar radiation from snow W/m^2 T -SNOFSRNI diffuse nir reflected solar radiation from snow W/m^2 T -SNOFSRVD direct vis reflected solar radiation from snow W/m^2 T -SNOFSRVI diffuse vis reflected solar radiation from snow W/m^2 T -SNOINTABS Fraction of incoming solar absorbed by lower snow layers - T -SNOLIQFL top snow layer liquid water fraction (land) fraction F -SNOOCMCL mass of OC in snow column kg/m2 T -SNOOCMSL mass of OC in top snow layer kg/m2 T -SNORDSL top snow layer effective grain radius m^-6 F -SNOTTOPL snow temperature (top layer) K F -SNOTTOPL_ICE snow temperature (top layer, ice landunits only) K F -SNOTXMASS snow temperature times layer mass, layer sum; to get mass-weighted temperature, divide by (SNO K kg/m2 T -SNOTXMASS_ICE snow temperature times layer mass, layer sum (ice landunits only); to get mass-weighted temper K kg/m2 F -SNOW atmospheric snow, after rain/snow repartitioning based on temperature mm/s T -SNOWDP gridcell mean snow height m T -SNOWICE snow ice kg/m2 T -SNOWICE_ICE snow ice (ice landunits only) kg/m2 F -SNOWLIQ snow liquid water kg/m2 T -SNOWLIQ_ICE snow liquid water (ice landunits only) kg/m2 F -SNOW_5D 5day snow avg m F -SNOW_DEPTH snow height of snow covered area m T -SNOW_DEPTH_ICE snow height of snow covered area (ice landunits only) m F -SNOW_FROM_ATM atmospheric snow received from atmosphere (pre-repartitioning) mm/s T -SNOW_ICE atmospheric snow, after rain/snow repartitioning based on temperature (ice landunits only) mm/s F -SNOW_PERSISTENCE Length of time of continuous snow cover (nat. veg. landunits only) seconds T -SNOW_SINKS snow sinks (liquid water) mm/s T -SNOW_SOURCES snow sources (liquid water) mm/s T -SNO_ABS Absorbed solar radiation in each snow layer W/m^2 F -SNO_ABS_ICE Absorbed solar radiation in each snow layer (ice landunits only) W/m^2 F -SNO_BW Partial density of water in the snow pack (ice + liquid) kg/m3 F -SNO_BW_ICE Partial density of water in the snow pack (ice + liquid, ice landunits only) kg/m3 F -SNO_EXISTENCE Fraction of averaging period for which each snow layer existed unitless F -SNO_FRZ snow freezing rate in each snow layer kg/m2/s F -SNO_FRZ_ICE snow freezing rate in each snow layer (ice landunits only) mm/s F -SNO_GS Mean snow grain size Microns F -SNO_GS_ICE Mean snow grain size (ice landunits only) Microns F -SNO_ICE Snow ice content kg/m2 F -SNO_LIQH2O Snow liquid water content kg/m2 F -SNO_MELT snow melt rate in each snow layer mm/s F -SNO_MELT_ICE snow melt rate in each snow layer (ice landunits only) mm/s F -SNO_T Snow temperatures K F -SNO_TK Thermal conductivity W/m-K F -SNO_TK_ICE Thermal conductivity (ice landunits only) W/m-K F -SNO_T_ICE Snow temperatures (ice landunits only) K F -SNO_Z Snow layer thicknesses m F -SNO_Z_ICE Snow layer thicknesses (ice landunits only) m F -SNOdTdzL top snow layer temperature gradient (land) K/m F -SOIL10 10-day running mean of 12cm layer soil K F -SOILC_HR soil C heterotrophic respiration gC/m^2/s T -SOILC_vr SOIL C (vertically resolved) gC/m^3 T -SOILICE soil ice (natural vegetated and crop landunits only) kg/m2 T -SOILLIQ soil liquid water (natural vegetated and crop landunits only) kg/m2 T -SOILN_vr SOIL N (vertically resolved) gN/m^3 T -SOILPSI soil water potential in each soil layer MPa F -SOILRESIS soil resistance to evaporation s/m T -SOILWATER_10CM soil liquid water + ice in top 10cm of soil (veg landunits only) kg/m2 T -SOMC_FIRE C loss due to peat burning gC/m^2/s T -SOM_C_LEACHED total flux of C from SOM pools due to leaching gC/m^2/s T -SOM_N_LEACHED total flux of N from SOM pools due to leaching gN/m^2/s F -SUPPLEMENT_TO_SMINN supplemental N supply gN/m^2/s T -SUPPLEMENT_TO_SMINN_vr supplemental N supply gN/m^3/s F -SWBGT 2 m Simplified Wetbulb Globe Temp C T -SWBGT_R Rural 2 m Simplified Wetbulb Globe Temp C T -SWBGT_U Urban 2 m Simplified Wetbulb Globe Temp C T -SWdown atmospheric incident solar radiation W/m^2 F -SWup upwelling shortwave radiation W/m^2 F -SoilAlpha factor limiting ground evap unitless F -SoilAlpha_U urban factor limiting ground evap unitless F -T10 10-day running mean of 2-m temperature K F -TAF canopy air temperature K F -TAUX zonal surface stress kg/m/s^2 T -TAUY meridional surface stress kg/m/s^2 T -TBOT atmospheric air temperature (downscaled to columns in glacier regions) K T -TBUILD internal urban building air temperature K T -TBUILD_MAX prescribed maximum interior building temperature K F -TFLOOR floor temperature K F -TG ground temperature K T -TG_ICE ground temperature (ice landunits only) K F -TG_R Rural ground temperature K F -TG_U Urban ground temperature K F -TH2OSFC surface water temperature K T -THBOT atmospheric air potential temperature (downscaled to columns in glacier regions) K T -TKE1 top lake level eddy thermal conductivity W/(mK) T -TLAI total projected leaf area index m^2/m^2 T -TLAKE lake temperature K T -TOPO_COL column-level topographic height m F -TOPO_COL_ICE column-level topographic height (ice landunits only) m F -TOPO_FORC topograephic height sent to GLC m F -TOTCOLCH4 total belowground CH4 (0 for non-lake special landunits in the absence of dynamic landunits) gC/m2 T -TOTLITC total litter carbon gC/m^2 T -TOTLITC_1m total litter carbon to 1 meter depth gC/m^2 T -TOTLITN total litter N gN/m^2 T -TOTLITN_1m total litter N to 1 meter gN/m^2 T -TOTSOILICE vertically summed soil cie (veg landunits only) kg/m2 T -TOTSOILLIQ vertically summed soil liquid water (veg landunits only) kg/m2 T -TOTSOMC total soil organic matter carbon gC/m^2 T -TOTSOMC_1m total soil organic matter carbon to 1 meter depth gC/m^2 T -TOTSOMN total soil organic matter N gN/m^2 T -TOTSOMN_1m total soil organic matter N to 1 meter gN/m^2 T -TRAFFICFLUX sensible heat flux from urban traffic W/m^2 F -TREFMNAV daily minimum of average 2-m temperature K T -TREFMNAV_R Rural daily minimum of average 2-m temperature K F -TREFMNAV_U Urban daily minimum of average 2-m temperature K F -TREFMXAV daily maximum of average 2-m temperature K T -TREFMXAV_R Rural daily maximum of average 2-m temperature K F -TREFMXAV_U Urban daily maximum of average 2-m temperature K F -TROOF_INNER roof inside surface temperature K F -TSA 2m air temperature K T -TSAI total projected stem area index m^2/m^2 T -TSA_ICE 2m air temperature (ice landunits only) K F -TSA_R Rural 2m air temperature K F -TSA_U Urban 2m air temperature K F -TSHDW_INNER shadewall inside surface temperature K F -TSKIN skin temperature K T -TSL temperature of near-surface soil layer (natural vegetated and crop landunits only) K T -TSOI soil temperature (natural vegetated and crop landunits only) K T -TSOI_10CM soil temperature in top 10cm of soil K T -TSOI_ICE soil temperature (ice landunits only) K T -TSRF_FORC surface temperature sent to GLC K F -TSUNW_INNER sunwall inside surface temperature K F -TV vegetation temperature K T -TV24 vegetation temperature (last 24hrs) K F -TV240 vegetation temperature (last 240hrs) K F -TWS total water storage mm T -T_SCALAR temperature inhibition of decomposition unitless T -Tair atmospheric air temperature (downscaled to columns in glacier regions) K F -Tair_from_atm atmospheric air temperature received from atmosphere (pre-downscaling) K F -U10 10-m wind m/s T -U10_DUST 10-m wind for dust model m/s T -U10_ICE 10-m wind (ice landunits only) m/s F -UAF canopy air speed m/s F -UM wind speed plus stability effect m/s F -URBAN_AC urban air conditioning flux W/m^2 T -URBAN_HEAT urban heating flux W/m^2 T -USTAR aerodynamical resistance s/m F -UST_LAKE friction velocity (lakes only) m/s F -VA atmospheric wind speed plus convective velocity m/s F -VENTILATION sensible heat flux from building ventilation W/m^2 T -VOLR river channel total water storage m3 T -VOLRMCH river channel main channel water storage m3 T -VPD vpd Pa F -VPD2M 2m vapor pressure deficit Pa T -VPD_CAN canopy vapor pressure deficit kPa T -WASTEHEAT sensible heat flux from heating/cooling sources of urban waste heat W/m^2 T -WBT 2 m Stull Wet Bulb C T -WBT_R Rural 2 m Stull Wet Bulb C T -WBT_U Urban 2 m Stull Wet Bulb C T -WFPS WFPS percent F -WIND atmospheric wind velocity magnitude m/s T -WTGQ surface tracer conductance m/s T -W_SCALAR Moisture (dryness) inhibition of decomposition unitless T -Wind atmospheric wind velocity magnitude m/s F -Z0HG roughness length over ground, sensible heat (vegetated landunits only) m F -Z0MG roughness length over ground, momentum (vegetated landunits only) m F -Z0MV_DENSE roughness length over vegetation, momentum, for dense canopy m F -Z0M_TO_COUPLER roughness length, momentum: gridcell average sent to coupler m F -Z0QG roughness length over ground, latent heat (vegetated landunits only) m F -ZBOT atmospheric reference height m T -ZETA dimensionless stability parameter unitless F -ZII convective boundary height m F -ZWT water table depth (natural vegetated and crop landunits only) m T -ZWT_CH4_UNSAT depth of water table for methane production used in non-inundated area m T -ZWT_PERCH perched water table depth (natural vegetated and crop landunits only) m T -anaerobic_frac anaerobic_frac m3/m3 F -diffus diffusivity m^2/s F -fr_WFPS fr_WFPS fraction F -n2_n2o_ratio_denit n2_n2o_ratio_denit gN/gN F -num_iter number of iterations unitless F -r_psi r_psi m F -ratio_k1 ratio_k1 none F -ratio_no3_co2 ratio_no3_co2 ratio F -soil_bulkdensity soil_bulkdensity kg/m3 F -soil_co2_prod soil_co2_prod ug C / g soil / day F -=================================== ============================================================================================== ================================================================= ======= +----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------- + Variable Name Level Dim. Long Description Units Active? +=================================== ================ ============================================================================================== ================================================================= ======= +A5TMIN - 5-day running mean of min 2-m temperature K F +ACTUAL_IMMOB - actual N immobilization gN/m^2/s T +ACTUAL_IMMOB_NH4 levdcmp immobilization of NH4 gN/m^3/s F +ACTUAL_IMMOB_NO3 levdcmp immobilization of NO3 gN/m^3/s F +ACTUAL_IMMOB_vr levdcmp actual N immobilization gN/m^3/s F +ACT_SOMC - ACT_SOM C gC/m^2 T +ACT_SOMC_1m - ACT_SOM C to 1 meter gC/m^2 F +ACT_SOMC_TNDNCY_VERT_TRA levdcmp active soil organic C tendency due to vertical transport gC/m^3/s F +ACT_SOMC_TO_PAS_SOMC - decomp. of active soil organic C to passive soil organic C gC/m^2/s F +ACT_SOMC_TO_PAS_SOMC_vr levdcmp decomp. of active soil organic C to passive soil organic C gC/m^3/s F +ACT_SOMC_TO_SLO_SOMC - decomp. of active soil organic C to slow soil organic ma C gC/m^2/s F +ACT_SOMC_TO_SLO_SOMC_vr levdcmp decomp. of active soil organic C to slow soil organic ma C gC/m^3/s F +ACT_SOMC_vr levsoi ACT_SOM C (vertically resolved) gC/m^3 T +ACT_SOMN - ACT_SOM N gN/m^2 T +ACT_SOMN_1m - ACT_SOM N to 1 meter gN/m^2 F +ACT_SOMN_TNDNCY_VERT_TRA levdcmp active soil organic N tendency due to vertical transport gN/m^3/s F +ACT_SOMN_TO_PAS_SOMN - decomp. of active soil organic N to passive soil organic N gN/m^2 F +ACT_SOMN_TO_PAS_SOMN_vr levdcmp decomp. of active soil organic N to passive soil organic N gN/m^3 F +ACT_SOMN_TO_SLO_SOMN - decomp. of active soil organic N to slow soil organic ma N gN/m^2 F +ACT_SOMN_TO_SLO_SOMN_vr levdcmp decomp. of active soil organic N to slow soil organic ma N gN/m^3 F +ACT_SOMN_vr levdcmp ACT_SOM N (vertically resolved) gN/m^3 T +ACT_SOM_HR_S2 - Het. Resp. from active soil organic gC/m^2/s F +ACT_SOM_HR_S2_vr levdcmp Het. Resp. from active soil organic gC/m^3/s F +ACT_SOM_HR_S3 - Het. Resp. from active soil organic gC/m^2/s F +ACT_SOM_HR_S3_vr levdcmp Het. Resp. from active soil organic gC/m^3/s F +AGLB - Aboveground leaf biomass kg/m^2 F +AGSB - Aboveground stem biomass kg/m^2 F +ALBD numrad surface albedo (direct) proportion F +ALBGRD numrad ground albedo (direct) proportion F +ALBGRI numrad ground albedo (indirect) proportion F +ALBI numrad surface albedo (indirect) proportion F +ALT - current active layer thickness m F +ALTMAX - maximum annual active layer thickness m F +ALTMAX_LASTYEAR - maximum prior year active layer thickness m F +ATM_O3 - atmospheric ozone partial pressure mol/mol F +ATM_TOPO - atmospheric surface height m T +AnnET - Annual ET mm/s F +BCDEP - total BC deposition (dry+wet) from atmosphere kg/m^2/s T +BTRAN - transpiration beta factor unitless T +BTRANMN - daily minimum of transpiration beta factor unitless T +CEL_LITC - CEL_LIT C gC/m^2 T +CEL_LITC_1m - CEL_LIT C to 1 meter gC/m^2 F +CEL_LITC_TNDNCY_VERT_TRA levdcmp cellulosic litter C tendency due to vertical transport gC/m^3/s F +CEL_LITC_TO_ACT_SOMC - decomp. of cellulosic litter C to active soil organic C gC/m^2/s F +CEL_LITC_TO_ACT_SOMC_vr levdcmp decomp. of cellulosic litter C to active soil organic C gC/m^3/s F +CEL_LITC_vr levsoi CEL_LIT C (vertically resolved) gC/m^3 T +CEL_LITN - CEL_LIT N gN/m^2 T +CEL_LITN_1m - CEL_LIT N to 1 meter gN/m^2 F +CEL_LITN_TNDNCY_VERT_TRA levdcmp cellulosic litter N tendency due to vertical transport gN/m^3/s F +CEL_LITN_TO_ACT_SOMN - decomp. of cellulosic litter N to active soil organic N gN/m^2 F +CEL_LITN_TO_ACT_SOMN_vr levdcmp decomp. of cellulosic litter N to active soil organic N gN/m^3 F +CEL_LITN_vr levdcmp CEL_LIT N (vertically resolved) gN/m^3 T +CEL_LIT_HR - Het. Resp. from cellulosic litter gC/m^2/s F +CEL_LIT_HR_vr levdcmp Het. Resp. from cellulosic litter gC/m^3/s F +CH4PROD - Gridcell total production of CH4 gC/m2/s T +CH4_EBUL_TOTAL_SAT - ebullition surface CH4 flux; (+ to atm) mol/m2/s F +CH4_EBUL_TOTAL_UNSAT - ebullition surface CH4 flux; (+ to atm) mol/m2/s F +CH4_SURF_AERE_SAT - aerenchyma surface CH4 flux for inundated area; (+ to atm) mol/m2/s T +CH4_SURF_AERE_UNSAT - aerenchyma surface CH4 flux for non-inundated area; (+ to atm) mol/m2/s T +CH4_SURF_DIFF_SAT - diffusive surface CH4 flux for inundated / lake area; (+ to atm) mol/m2/s T +CH4_SURF_DIFF_UNSAT - diffusive surface CH4 flux for non-inundated area; (+ to atm) mol/m2/s T +CH4_SURF_EBUL_SAT - ebullition surface CH4 flux for inundated / lake area; (+ to atm) mol/m2/s T +CH4_SURF_EBUL_UNSAT - ebullition surface CH4 flux for non-inundated area; (+ to atm) mol/m2/s T +COL_CTRUNC - column-level sink for C truncation gC/m^2 F +COL_NTRUNC - column-level sink for N truncation gN/m^2 F +CONC_CH4_SAT levgrnd CH4 soil Concentration for inundated / lake area mol/m3 F +CONC_CH4_UNSAT levgrnd CH4 soil Concentration for non-inundated area mol/m3 F +CONC_O2_SAT levsoi O2 soil Concentration for inundated / lake area mol/m3 T +CONC_O2_UNSAT levsoi O2 soil Concentration for non-inundated area mol/m3 T +COSZEN - cosine of solar zenith angle none F +CWDC_HR - cwd C heterotrophic respiration gC/m^2/s T +DENIT - total rate of denitrification gN/m^2/s T +DGNETDT - derivative of net ground heat flux wrt soil temp W/m^2/K F +DISPLA - displacement height (vegetated landunits only) m F +DPVLTRB1 - turbulent deposition velocity 1 m/s F +DPVLTRB2 - turbulent deposition velocity 2 m/s F +DPVLTRB3 - turbulent deposition velocity 3 m/s F +DPVLTRB4 - turbulent deposition velocity 4 m/s F +DSL - dry surface layer thickness mm T +DSTDEP - total dust deposition (dry+wet) from atmosphere kg/m^2/s T +DSTFLXT - total surface dust emission kg/m2/s T +DYN_COL_ADJUSTMENTS_CH4 - Adjustments in ch4 due to dynamic column areas; only makes sense at the column level: should n gC/m^2 F +DYN_COL_SOIL_ADJUSTMENTS_C - Adjustments in soil carbon due to dynamic column areas; only makes sense at the column level: gC/m^2 F +DYN_COL_SOIL_ADJUSTMENTS_N - Adjustments in soil nitrogen due to dynamic column areas; only makes sense at the column level gN/m^2 F +DYN_COL_SOIL_ADJUSTMENTS_NH4 - Adjustments in soil NH4 due to dynamic column areas; only makes sense at the column level: sho gN/m^2 F +DYN_COL_SOIL_ADJUSTMENTS_NO3 - Adjustments in soil NO3 due to dynamic column areas; only makes sense at the column level: sho gN/m^2 F +EFLXBUILD - building heat flux from change in interior building air temperature W/m^2 T +EFLX_DYNBAL - dynamic land cover change conversion energy flux W/m^2 T +EFLX_GNET - net heat flux into ground W/m^2 F +EFLX_GRND_LAKE - net heat flux into lake/snow surface, excluding light transmission W/m^2 T +EFLX_LH_TOT - total latent heat flux [+ to atm] W/m^2 T +EFLX_LH_TOT_ICE - total latent heat flux [+ to atm] (ice landunits only) W/m^2 F +EFLX_LH_TOT_R - Rural total evaporation W/m^2 T +EFLX_LH_TOT_U - Urban total evaporation W/m^2 F +EFLX_SOIL_GRND - soil heat flux [+ into soil] W/m^2 F +ELAI - exposed one-sided leaf area index m^2/m^2 T +ERRH2O - total water conservation error mm T +ERRH2OSNO - imbalance in snow depth (liquid water) mm T +ERRSEB - surface energy conservation error W/m^2 T +ERRSOI - soil/lake energy conservation error W/m^2 T +ERRSOL - solar radiation conservation error W/m^2 T +ESAI - exposed one-sided stem area index m^2/m^2 T +FATES_ABOVEGROUND_MORT_SZPF fates_levscpf Aboveground flux of carbon from AGB to necromass due to mortality kg m-2 s-1 F +FATES_ABOVEGROUND_PROD_SZPF fates_levscpf Aboveground carbon productivity kg m-2 s-1 F +FATES_AGSAPMAINTAR_SZPF fates_levscpf above-ground sapwood maintenance autotrophic respiration in kg carbon per m2 per second by pft kg m-2 s-1 F +FATES_AGSAPWOOD_ALLOC_SZPF fates_levscpf allocation to above-ground sapwood by pft/size in kg carbon per m2 per second kg m-2 s-1 F +FATES_AGSTRUCT_ALLOC_SZPF fates_levscpf allocation to above-ground structural (deadwood) by pft/size in kg carbon per m2 per second kg m-2 s-1 F +FATES_AR - autotrophic respiration gC/m^2/s T +FATES_AREA_PLANTS - area occupied by all plants per m2 land area m2 m-2 T +FATES_AREA_TREES - area occupied by woody plants per m2 land area m2 m-2 T +FATES_AR_CANOPY - autotrophic respiration of canopy plants gC/m^2/s T +FATES_AR_UNDERSTORY - autotrophic respiration of understory plants gC/m^2/s T +FATES_AUTORESP - autotrophic respiration in kg carbon per m2 per second kg m-2 s-1 T +FATES_AUTORESP_CANOPY - autotrophic respiration of canopy plants in kg carbon per m2 per second kg m-2 s-1 T +FATES_AUTORESP_CANOPY_SZPF fates_levscpf autotrophic respiration of canopy plants by pft/size in kg carbon per m2 per second kg m-2 s-1 F +FATES_AUTORESP_SECONDARY - autotrophic respiration in kg carbon per m2 per second, secondary patches kg m-2 s-1 T +FATES_AUTORESP_SZPF fates_levscpf total autotrophic respiration in kg carbon per m2 per second by pft/size kg m-2 s-1 F +FATES_AUTORESP_USTORY - autotrophic respiration of understory plants in kg carbon per m2 per second kg m-2 s-1 T +FATES_AUTORESP_USTORY_SZPF fates_levscpf autotrophic respiration of understory plants by pft/size in kg carbon per m2 per second kg m-2 s-1 F +FATES_BASALAREA_SZ fates_levscls basal area by size class m2 m-2 T +FATES_BASALAREA_SZPF fates_levscpf basal area by pft/size m2 m-2 F +FATES_BA_WEIGHTED_HEIGHT - basal area-weighted mean height of woody plants m T +FATES_BGSAPMAINTAR_SZPF fates_levscpf below-ground sapwood maintenance autotrophic respiration in kg carbon per m2 per second by pft kg m-2 s-1 F +FATES_BGSAPWOOD_ALLOC_SZPF fates_levscpf allocation to below-ground sapwood by pft/size in kg carbon per m2 per second kg m-2 s-1 F +FATES_BGSTRUCT_ALLOC_SZPF fates_levscpf allocation to below-ground structural (deadwood) by pft/size in kg carbon per m2 per second kg m-2 s-1 F +FATES_BURNFRAC - burned area fraction per second s-1 T +FATES_BURNFRAC_AP fates_levage spitfire fraction area burnt (per second) by patch age s-1 T +FATES_C13DISC_SZPF fates_levscpf C13 discrimination by pft/size per mil F +FATES_CANOPYAREA_AP fates_levage canopy area by age bin per m2 land area m2 m-2 T +FATES_CANOPYAREA_HT fates_levheight canopy area height distribution m2 m-2 T +FATES_CANOPYCROWNAREA_PF fates_levpft total PFT-level canopy-layer crown area per m2 land area m2 m-2 T +FATES_CANOPY_SPREAD - scaling factor (0-1) between tree basal area and canopy area T +FATES_CANOPY_VEGC - biomass of canopy plants in kg carbon per m2 land area kg m-2 T +FATES_CA_WEIGHTED_HEIGHT - crown area-weighted mean height of canopy plants m T +FATES_CBALANCE_ERROR - total carbon error in kg carbon per second kg s-1 T +FATES_COLD_STATUS - site-level cold status, 0=not cold-dec, 1=too cold for leaves, 2=not too cold T +FATES_CROOTMAINTAR - live coarse root maintenance autotrophic respiration in kg carbon per m2 per second kg m-2 s-1 T +FATES_CROOTMAINTAR_CANOPY_SZ fates_levscls live coarse root maintenance autotrophic respiration for canopy plants in kg carbon per m2 per kg m-2 s-1 F +FATES_CROOTMAINTAR_USTORY_SZ fates_levscls live coarse root maintenance autotrophic respiration for understory plants in kg carbon per m2 kg m-2 s-1 F +FATES_CROOT_ALLOC - allocation to coarse roots in kg carbon per m2 per second kg m-2 s-1 T +FATES_CROWNAREA_CANOPY_SZ fates_levscls total crown area of canopy plants by size class m2 m-2 F +FATES_CROWNAREA_CL fates_levcan total crown area in each canopy layer m2 m-2 T +FATES_CROWNAREA_CLLL fates_levcnlf total crown area that is occupied by leaves in each canopy and leaf layer m2 m-2 F +FATES_CROWNAREA_PF fates_levpft total PFT-level crown area per m2 land area m2 m-2 T +FATES_CROWNAREA_USTORY_SZ fates_levscls total crown area of understory plants by size class m2 m-2 F +FATES_CWD_ABOVEGROUND_DC fates_levcwdsc debris class-level aboveground coarse woody debris stocks in kg carbon per m2 kg m-2 F +FATES_CWD_ABOVEGROUND_IN_DC fates_levcwdsc debris class-level aboveground coarse woody debris input in kg carbon per m2 per second kg m-2 s-1 F +FATES_CWD_ABOVEGROUND_OUT_DC fates_levcwdsc debris class-level aboveground coarse woody debris output in kg carbon per m2 per second kg m-2 s-1 F +FATES_CWD_BELOWGROUND_DC fates_levcwdsc debris class-level belowground coarse woody debris stocks in kg carbon per m2 kg m-2 F +FATES_CWD_BELOWGROUND_IN_DC fates_levcwdsc debris class-level belowground coarse woody debris input in kg carbon per m2 per second kg m-2 s-1 F +FATES_CWD_BELOWGROUND_OUT_DC fates_levcwdsc debris class-level belowground coarse woody debris output in kg carbon per m2 per second kg m-2 s-1 F +FATES_DAYSINCE_COLDLEAFOFF - site-level days elapsed since cold leaf drop days T +FATES_DAYSINCE_COLDLEAFON - site-level days elapsed since cold leaf flush days T +FATES_DAYSINCE_DROUGHTLEAFOFF_PF fates_levpft PFT-level days elapsed since drought leaf drop days T +FATES_DAYSINCE_DROUGHTLEAFON_PF fates_levpft PFT-level days elapsed since drought leaf flush days T +FATES_DDBH_CANOPY_SZ fates_levscls diameter growth increment by size of canopy plants m m-2 yr-1 T +FATES_DDBH_CANOPY_SZAP fates_levscag growth rate of canopy plants in meters DBH per m2 per year in canopy in each size x age class m m-2 yr-1 F +FATES_DDBH_CANOPY_SZPF fates_levscpf diameter growth increment by pft/size m m-2 yr-1 F +FATES_DDBH_SZPF fates_levscpf diameter growth increment by pft/size m m-2 yr-1 F +FATES_DDBH_USTORY_SZ fates_levscls diameter growth increment by size of understory plants m m-2 yr-1 T +FATES_DDBH_USTORY_SZAP fates_levscag growth rate of understory plants in meters DBH per m2 per year in each size x age class m m-2 yr-1 F +FATES_DDBH_USTORY_SZPF fates_levscpf diameter growth increment by pft/size m m-2 yr-1 F +FATES_DEMOTION_CARBONFLUX - demotion-associated biomass carbon flux from canopy to understory in kg carbon per m2 per seco kg m-2 s-1 T +FATES_DEMOTION_RATE_SZ fates_levscls demotion rate from canopy to understory by size class in number of plants per m2 per year m-2 yr-1 F +FATES_DISTURBANCE_RATE_FIRE - disturbance rate from fire m2 m-2 yr-1 T +FATES_DISTURBANCE_RATE_LOGGING - disturbance rate from logging m2 m-2 yr-1 T +FATES_DISTURBANCE_RATE_P2P - disturbance rate from primary to primary lands m2 m-2 yr-1 T +FATES_DISTURBANCE_RATE_P2S - disturbance rate from primary to secondary lands m2 m-2 yr-1 T +FATES_DISTURBANCE_RATE_POTENTIAL - potential (i.e., including unresolved) disturbance rate m2 m-2 yr-1 T +FATES_DISTURBANCE_RATE_S2S - disturbance rate from secondary to secondary lands m2 m-2 yr-1 T +FATES_DISTURBANCE_RATE_TREEFALL - disturbance rate from treefall m2 m-2 yr-1 T +FATES_DROUGHT_STATUS_PF fates_levpft PFT-level drought status, <2 too dry for leaves, >=2 not too dry T +FATES_EFFECT_WSPEED - effective wind speed for fire spread in meters per second m s-1 T +FATES_ELONG_FACTOR_PF fates_levpft PFT-level mean elongation factor (partial flushing/abscission) 1 T +FATES_ERROR_EL fates_levelem total mass-balance error in kg per second by element kg s-1 T +FATES_EXCESS_RESP - respiration of un-allocatable carbon gain kg m-2 s-1 T +FATES_FABD_SHA_CLLL fates_levcnlf shade fraction of direct light absorbed by each canopy and leaf layer 1 F +FATES_FABD_SHA_CLLLPF fates_levcnlfpf shade fraction of direct light absorbed by each canopy, leaf, and PFT 1 F +FATES_FABD_SHA_TOPLF_CL fates_levcan shade fraction of direct light absorbed by the top leaf layer of each canopy layer 1 F +FATES_FABD_SUN_CLLL fates_levcnlf sun fraction of direct light absorbed by each canopy and leaf layer 1 F +FATES_FABD_SUN_CLLLPF fates_levcnlfpf sun fraction of direct light absorbed by each canopy, leaf, and PFT 1 F +FATES_FABD_SUN_TOPLF_CL fates_levcan sun fraction of direct light absorbed by the top leaf layer of each canopy layer 1 F +FATES_FABI_SHA_CLLL fates_levcnlf shade fraction of indirect light absorbed by each canopy and leaf layer 1 F +FATES_FABI_SHA_CLLLPF fates_levcnlfpf shade fraction of indirect light absorbed by each canopy, leaf, and PFT 1 F +FATES_FABI_SHA_TOPLF_CL fates_levcan shade fraction of indirect light absorbed by the top leaf layer of each canopy layer 1 F +FATES_FABI_SUN_CLLL fates_levcnlf sun fraction of indirect light absorbed by each canopy and leaf layer 1 F +FATES_FABI_SUN_CLLLPF fates_levcnlfpf sun fraction of indirect light absorbed by each canopy, leaf, and PFT 1 F +FATES_FABI_SUN_TOPLF_CL fates_levcan sun fraction of indirect light absorbed by the top leaf layer of each canopy layer 1 F +FATES_FDI - Fire Danger Index (probability that an ignition will lead to a fire) 1 T +FATES_FIRE_CLOSS - carbon loss to atmosphere from fire in kg carbon per m2 per second kg m-2 s-1 T +FATES_FIRE_FLUX_EL fates_levelem loss to atmosphere from fire by element in kg element per m2 per s kg m-2 s-1 T +FATES_FIRE_INTENSITY - spitfire surface fireline intensity in J per m per second J m-1 s-1 T +FATES_FIRE_INTENSITY_BURNFRAC - product of surface fire intensity and burned area fraction -- divide by FATES_BURNFRAC to get J m-1 s-1 T +FATES_FIRE_INTENSITY_BURNFRAC_AP fates_levage product of fire intensity and burned fraction, resolved by patch age (so divide by FATES_BURNF J m-1 s-1 T +FATES_FRACTION - total gridcell fraction which FATES is running over m2 m-2 T +FATES_FRAGMENTATION_SCALER_SL levsoi factor (0-1) by which litter/cwd fragmentation proceeds relative to max rate by soil layer T +FATES_FROOTC - total biomass in live plant fine roots in kg carbon per m2 kg m-2 T +FATES_FROOTCTURN_CANOPY_SZ fates_levscls fine root turnover (non-mortal) for canopy plants by size class in kg carbon per m2 per second kg m-2 s-1 F +FATES_FROOTCTURN_USTORY_SZ fates_levscls fine root turnover (non-mortal) for understory plants by size class in kg carbon per m2 per se kg m-2 s-1 F +FATES_FROOTC_SL levsoi Total carbon in live plant fine-roots over depth kg m-3 T +FATES_FROOTC_SZPF fates_levscpf fine-root carbon mass by size-class x pft in kg carbon per m2 kg m-2 F +FATES_FROOTMAINTAR - fine root maintenance autotrophic respiration in kg carbon per m2 per second kg m-2 s-1 T +FATES_FROOTMAINTAR_CANOPY_SZ fates_levscls live coarse root maintenance autotrophic respiration for canopy plants in kg carbon per m2 per kg m-2 s-1 F +FATES_FROOTMAINTAR_SZPF fates_levscpf fine root maintenance autotrophic respiration in kg carbon per m2 per second by pft/size kg m-2 s-1 F +FATES_FROOTMAINTAR_USTORY_SZ fates_levscls fine root maintenance autotrophic respiration for understory plants in kg carbon per m2 per se kg m-2 s-1 F +FATES_FROOT_ALLOC - allocation to fine roots in kg carbon per m2 per second kg m-2 s-1 T +FATES_FROOT_ALLOC_CANOPY_SZ fates_levscls allocation to fine root C for canopy plants by size class in kg carbon per m2 per second kg m-2 s-1 F +FATES_FROOT_ALLOC_SZPF fates_levscpf allocation to fine roots by pft/size in kg carbon per m2 per second kg m-2 s-1 F +FATES_FROOT_ALLOC_USTORY_SZ fates_levscls allocation to fine roots for understory plants by size class in kg carbon per m2 per second kg m-2 s-1 F +FATES_FUELCONSUMED - total fuel consumed in kg carbon per m2 land area kg m-2 T +FATES_FUEL_AMOUNT - total ground fuel related to FATES_ROS (omits 1000hr fuels) in kg C per m2 land area kg m-2 T +FATES_FUEL_AMOUNT_AP fates_levage spitfire ground fuel (kg carbon per m2) related to FATES_ROS (omits 1000hr fuels) within each kg m-2 T +FATES_FUEL_AMOUNT_APFC fates_levagefuel spitfire fuel quantity in each age x fuel class in kg carbon per m2 land area kg m-2 F +FATES_FUEL_AMOUNT_FC fates_levfuel spitfire fuel-class level fuel amount in kg carbon per m2 land area kg m-2 T +FATES_FUEL_BULKD - fuel bulk density in kg per m3 kg m-3 T +FATES_FUEL_BURNT_BURNFRAC_FC fates_levfuel product of fraction (0-1) of fuel burnt and burnt fraction (divide by FATES_BURNFRAC to get bu 1 T +FATES_FUEL_EFF_MOIST - spitfire fuel moisture (volumetric) m3 m-3 T +FATES_FUEL_MEF - fuel moisture of extinction (volumetric) m3 m-3 T +FATES_FUEL_MOISTURE_FC fates_levfuel spitfire fuel class-level fuel moisture (volumetric) m3 m-3 T +FATES_FUEL_SAV - spitfire fuel surface area to volume ratio m-1 T +FATES_GDD - site-level growing degree days degree_Celsius T +FATES_GPP - gross primary production in kg carbon per m2 per second kg m-2 s-1 T +FATES_GPP_AP fates_levage gross primary productivity by age bin in kg carbon per m2 per second kg m-2 s-1 F +FATES_GPP_CANOPY - gross primary production of canopy plants in kg carbon per m2 per second kg m-2 s-1 T +FATES_GPP_CANOPY_SZPF fates_levscpf gross primary production of canopy plants by pft/size in kg carbon per m2 per second kg m-2 s-1 F +FATES_GPP_PF fates_levpft total PFT-level GPP in kg carbon per m2 land area per second kg m-2 s-1 T +FATES_GPP_SECONDARY - gross primary production in kg carbon per m2 per second, secondary patches kg m-2 s-1 T +FATES_GPP_SE_PF fates_levpft total PFT-level GPP in kg carbon per m2 land area per second, secondary patches kg m-2 s-1 T +FATES_GPP_SZPF fates_levscpf gross primary production by pft/size in kg carbon per m2 per second kg m-2 s-1 F +FATES_GPP_USTORY - gross primary production of understory plants in kg carbon per m2 per second kg m-2 s-1 T +FATES_GPP_USTORY_SZPF fates_levscpf gross primary production of understory plants by pft/size in kg carbon per m2 per second kg m-2 s-1 F +FATES_GROWAR_CANOPY_SZ fates_levscls growth autotrophic respiration of canopy plants in kg carbon per m2 per second by size kg m-2 s-1 F +FATES_GROWAR_SZPF fates_levscpf growth autotrophic respiration in kg carbon per m2 per second by pft/size kg m-2 s-1 F +FATES_GROWAR_USTORY_SZ fates_levscls growth autotrophic respiration of understory plants in kg carbon per m2 per second by size kg m-2 s-1 F +FATES_GROWTHFLUX_FUSION_SZPF fates_levscpf flux of individuals into a given size class bin via fusion m-2 yr-1 F +FATES_GROWTHFLUX_SZPF fates_levscpf flux of individuals into a given size class bin via growth and recruitment m-2 yr-1 F +FATES_GROWTH_RESP - growth respiration in kg carbon per m2 per second kg m-2 s-1 T +FATES_GROWTH_RESP_SECONDARY - growth respiration in kg carbon per m2 per second, secondary patches kg m-2 s-1 T +FATES_HARVEST_CARBON_FLUX - harvest carbon flux in kg carbon per m2 per year kg m-2 yr-1 T +FATES_HARVEST_DEBT - Accumulated carbon failed to be harvested kg C T +FATES_HARVEST_DEBT_SEC - Accumulated carbon failed to be harvested from secondary patches kg C T +FATES_HET_RESP - heterotrophic respiration in kg carbon per m2 per second kg m-2 s-1 T +FATES_IGNITIONS - number of successful fire ignitions per m2 land area per second m-2 s-1 T +FATES_LAI - leaf area index per m2 land area m2 m-2 T +FATES_LAISHA_TOP_CL fates_levcan LAI in the shade by the top leaf layer of each canopy layer m2 m-2 F +FATES_LAISHA_Z_CLLL fates_levcnlf LAI in the shade by each canopy and leaf layer m2 m-2 F +FATES_LAISHA_Z_CLLLPF fates_levcnlfpf LAI in the shade by each canopy, leaf, and PFT m2 m-2 F +FATES_LAISUN_TOP_CL fates_levcan LAI in the sun by the top leaf layer of each canopy layer m2 m-2 F +FATES_LAISUN_Z_CLLL fates_levcnlf LAI in the sun by each canopy and leaf layer m2 m-2 F +FATES_LAISUN_Z_CLLLPF fates_levcnlfpf LAI in the sun by each canopy, leaf, and PFT m2 m-2 F +FATES_LAI_AP fates_levage leaf area index by age bin per m2 land area m2 m-2 T +FATES_LAI_CANOPY_SZ fates_levscls leaf area index (LAI) of canopy plants by size class m2 m-2 T +FATES_LAI_CANOPY_SZPF fates_levscpf Leaf area index (LAI) of canopy plants by pft/size m2 m-2 F +FATES_LAI_SECONDARY - leaf area index per m2 land area, secondary patches m2 m-2 T +FATES_LAI_USTORY_SZ fates_levscls leaf area index (LAI) of understory plants by size class m2 m-2 T +FATES_LAI_USTORY_SZPF fates_levscpf Leaf area index (LAI) of understory plants by pft/size m2 m-2 F +FATES_LBLAYER_COND - mean leaf boundary layer conductance mol m-2 s-1 T +FATES_LBLAYER_COND_AP fates_levage mean leaf boundary layer conductance - by patch age mol m-2 s-1 F +FATES_LEAFAREA_HT fates_levheight leaf area height distribution m2 m-2 T +FATES_LEAFC - total biomass in live plant leaves in kg carbon per m2 kg m-2 T +FATES_LEAFCTURN_CANOPY_SZ fates_levscls leaf turnover (non-mortal) for canopy plants by size class in kg carbon per m2 per second kg m-2 s-1 F +FATES_LEAFCTURN_USTORY_SZ fates_levscls leaf turnover (non-mortal) for understory plants by size class in kg carbon per m2 per second kg m-2 s-1 F +FATES_LEAFC_CANOPY_SZPF fates_levscpf biomass in leaves of canopy plants by pft/size in kg carbon per m2 kg m-2 F +FATES_LEAFC_PF fates_levpft total PFT-level leaf biomass in kg carbon per m2 land area kg m-2 T +FATES_LEAFC_SZPF fates_levscpf leaf carbon mass by size-class x pft in kg carbon per m2 kg m-2 F +FATES_LEAFC_USTORY_SZPF fates_levscpf biomass in leaves of understory plants by pft/size in kg carbon per m2 kg m-2 F +FATES_LEAFMAINTAR - leaf maintenance autotrophic respiration in kg carbon per m2 per second kg m-2 s-1 T +FATES_LEAF_ALLOC - allocation to leaves in kg carbon per m2 per second kg m-2 s-1 T +FATES_LEAF_ALLOC_CANOPY_SZ fates_levscls allocation to leaves for canopy plants by size class in kg carbon per m2 per second kg m-2 s-1 F +FATES_LEAF_ALLOC_SZPF fates_levscpf allocation to leaves by pft/size in kg carbon per m2 per second kg m-2 s-1 F +FATES_LEAF_ALLOC_USTORY_SZ fates_levscls allocation to leaves for understory plants by size class in kg carbon per m2 per second kg m-2 s-1 F +FATES_LITTER_AG_CWD_EL fates_levelem mass of aboveground litter in coarse woody debris (trunks/branches/twigs) by element kg m-2 T +FATES_LITTER_AG_FINE_EL fates_levelem mass of aboveground litter in fines (leaves, nonviable seed) by element kg m-2 T +FATES_LITTER_BG_CWD_EL fates_levelem mass of belowground litter in coarse woody debris (coarse roots) by element kg m-2 T +FATES_LITTER_BG_FINE_EL fates_levelem mass of belowground litter in fines (fineroots) by element kg m-2 T +FATES_LITTER_CWD_ELDC fates_levelcwd total mass of litter in coarse woody debris by element and coarse woody debris size kg m-2 T +FATES_LITTER_IN - litter flux in kg carbon per m2 per second kg m-2 s-1 T +FATES_LITTER_IN_EL fates_levelem litter flux in in kg element per m2 per second kg m-2 s-1 T +FATES_LITTER_OUT - litter flux out in kg carbon (exudation, fragmentation, seed decay) kg m-2 s-1 T +FATES_LITTER_OUT_EL fates_levelem litter flux out (exudation, fragmentation and seed decay) in kg element kg m-2 s-1 T +FATES_LSTEMMAINTAR - live stem maintenance autotrophic respiration in kg carbon per m2 per second kg m-2 s-1 T +FATES_LSTEMMAINTAR_CANOPY_SZ fates_levscls live stem maintenance autotrophic respiration for canopy plants in kg carbon per m2 per second kg m-2 s-1 F +FATES_LSTEMMAINTAR_USTORY_SZ fates_levscls live stem maintenance autotrophic respiration for understory plants in kg carbon per m2 per se kg m-2 s-1 F +FATES_M3_MORTALITY_CANOPY_SZ fates_levscls C starvation mortality of canopy plants by size N/ha/yr F +FATES_M3_MORTALITY_CANOPY_SZPF fates_levscpf C starvation mortality of canopy plants by pft/size N/ha/yr F +FATES_M3_MORTALITY_USTORY_SZ fates_levscls C starvation mortality of understory plants by size N/ha/yr F +FATES_M3_MORTALITY_USTORY_SZPF fates_levscpf C starvation mortality of understory plants by pft/size N/ha/yr F +FATES_MAINTAR_CANOPY_SZ fates_levscls maintenance autotrophic respiration of canopy plants in kg carbon per m2 per second by size kg m-2 s-1 F +FATES_MAINTAR_SZPF fates_levscpf maintenance autotrophic respiration in kg carbon per m2 per second by pft/size kg m-2 s-1 F +FATES_MAINTAR_USTORY_SZ fates_levscls maintenance autotrophic respiration of understory plants in kg carbon per m2 per second by siz kg m-2 s-1 F +FATES_MAINT_RESP - maintenance respiration in kg carbon per m2 land area per second, secondary patches kg m-2 s-1 T +FATES_MAINT_RESP_SECONDARY - maintenance respiration in kg carbon per m2 land area per second kg m-2 s-1 T +FATES_MAINT_RESP_UNREDUCED - diagnostic maintenance respiration if the low-carbon-storage reduction is ignored kg m-2 s-1 F +FATES_MEANLIQVOL_DROUGHTPHEN_PF fates_levpft PFT-level mean liquid water volume for drought phenolgy m3 m-3 T +FATES_MEANSMP_DROUGHTPHEN_PF fates_levpft PFT-level mean soil matric potential for drought phenology Pa T +FATES_MORTALITY_AGESCEN_AC fates_levcacls age senescence mortality by cohort age in number of plants per m2 per year m-2 yr-1 T +FATES_MORTALITY_AGESCEN_ACPF fates_levcapf age senescence mortality by pft/cohort age in number of plants per m2 per year m-2 yr-1 F +FATES_MORTALITY_AGESCEN_SE_SZ fates_levscls age senescence mortality by size in number of plants per m2 per year, secondary patches m-2 yr-1 T +FATES_MORTALITY_AGESCEN_SZ fates_levscls age senescence mortality by size in number of plants per m2 per year m-2 yr-1 T +FATES_MORTALITY_AGESCEN_SZPF fates_levscpf age senescence mortality by pft/size in number of plants per m2 per year m-2 yr-1 F +FATES_MORTALITY_BACKGROUND_SE_SZ fates_levscls background mortality by size in number of plants per m2 per year, secondary patches m-2 yr-1 T +FATES_MORTALITY_BACKGROUND_SZ fates_levscls background mortality by size in number of plants per m2 per year m-2 yr-1 T +FATES_MORTALITY_BACKGROUND_SZPF fates_levscpf background mortality by pft/size in number of plants per m2 per year m-2 yr-1 F +FATES_MORTALITY_CAMBIALBURN_SZPF fates_levscpf fire mortality from cambial burn by pft/size in number of plants per m2 per year m-2 yr-1 F +FATES_MORTALITY_CANOPY_SE_SZ fates_levscls total mortality of canopy trees by size class in number of plants per m2, secondary patches m-2 yr-1 T +FATES_MORTALITY_CANOPY_SZ fates_levscls total mortality of canopy trees by size class in number of plants per m2 m-2 yr-1 T +FATES_MORTALITY_CANOPY_SZAP fates_levscag mortality rate of canopy plants in number of plants per m2 per year in each size x age class m-2 yr-1 F +FATES_MORTALITY_CANOPY_SZPF fates_levscpf total mortality of canopy plants by pft/size in number of plants per m2 per year m-2 yr-1 F +FATES_MORTALITY_CFLUX_CANOPY - flux of biomass carbon from live to dead pools from mortality of canopy plants in kg carbon pe kg m-2 s-1 T +FATES_MORTALITY_CFLUX_PF fates_levpft PFT-level flux of biomass carbon from live to dead pool from mortality kg m-2 s-1 T +FATES_MORTALITY_CFLUX_USTORY - flux of biomass carbon from live to dead pools from mortality of understory plants in kg carbo kg m-2 s-1 T +FATES_MORTALITY_CROWNSCORCH_SZPF fates_levscpf fire mortality from crown scorch by pft/size in number of plants per m2 per year m-2 yr-1 F +FATES_MORTALITY_CSTARV_CFLUX_PF fates_levpft PFT-level flux of biomass carbon from live to dead pool from carbon starvation mortality kg m-2 s-1 T +FATES_MORTALITY_CSTARV_SE_SZ fates_levscls carbon starvation mortality by size in number of plants per m2 per year, secondary patches m-2 yr-1 T +FATES_MORTALITY_CSTARV_SZ fates_levscls carbon starvation mortality by size in number of plants per m2 per year m-2 yr-1 T +FATES_MORTALITY_CSTARV_SZPF fates_levscpf carbon starvation mortality by pft/size in number of plants per m2 per year m-2 yr-1 F +FATES_MORTALITY_FIRE_CFLUX_PF fates_levpft PFT-level flux of biomass carbon from live to dead pool from fire mortality kg m-2 s-1 T +FATES_MORTALITY_FIRE_SZ fates_levscls fire mortality by size in number of plants per m2 per year m-2 yr-1 T +FATES_MORTALITY_FIRE_SZPF fates_levscpf fire mortality by pft/size in number of plants per m2 per year m-2 yr-1 F +FATES_MORTALITY_FREEZING_SE_SZ fates_levscls freezing mortality by size in number of plants per m2 per event, secondary patches m-2 event-1 T +FATES_MORTALITY_FREEZING_SZ fates_levscls freezing mortality by size in number of plants per m2 per year m-2 yr-1 T +FATES_MORTALITY_FREEZING_SZPF fates_levscpf freezing mortality by pft/size in number of plants per m2 per year m-2 yr-1 F +FATES_MORTALITY_HYDRAULIC_SE_SZ fates_levscls hydraulic mortality by size in number of plants per m2 per year, secondary patches m-2 yr-1 T +FATES_MORTALITY_HYDRAULIC_SZ fates_levscls hydraulic mortality by size in number of plants per m2 per year m-2 yr-1 T +FATES_MORTALITY_HYDRAULIC_SZPF fates_levscpf hydraulic mortality by pft/size in number of plants per m2 per year m-2 yr-1 F +FATES_MORTALITY_HYDRO_CFLUX_PF fates_levpft PFT-level flux of biomass carbon from live to dead pool from hydraulic failure mortality kg m-2 s-1 T +FATES_MORTALITY_IMPACT_SZ fates_levscls impact mortality by size in number of plants per m2 per year m-2 yr-1 T +FATES_MORTALITY_IMPACT_SZPF fates_levscpf impact mortality by pft/size in number of plants per m2 per year m-2 yr-1 F +FATES_MORTALITY_LOGGING_SE_SZ fates_levscls logging mortality by size in number of plants per m2 per event, secondary patches m-2 yr-1 T +FATES_MORTALITY_LOGGING_SZ fates_levscls logging mortality by size in number of plants per m2 per year m-2 yr-1 T +FATES_MORTALITY_LOGGING_SZPF fates_levscpf logging mortality by pft/size in number of plants per m2 per year m-2 yr-1 F +FATES_MORTALITY_PF fates_levpft PFT-level mortality rate in number of individuals per m2 land area per year m-2 yr-1 T +FATES_MORTALITY_SENESCENCE_SE_SZ fates_levscls senescence mortality by size in number of plants per m2 per event, secondary patches m-2 yr-1 T +FATES_MORTALITY_SENESCENCE_SZ fates_levscls senescence mortality by size in number of plants per m2 per year m-2 yr-1 T +FATES_MORTALITY_SENESCENCE_SZPF fates_levscpf senescence mortality by pft/size in number of plants per m2 per year m-2 yr-1 F +FATES_MORTALITY_TERMINATION_SZ fates_levscls termination mortality by size in number of plants per m2 per year m-2 yr-1 T +FATES_MORTALITY_TERMINATION_SZPF fates_levscpf termination mortality by pft/size in number pf plants per m2 per year m-2 yr-1 F +FATES_MORTALITY_USTORY_SZ fates_levscls total mortality of understory trees by size class in individuals per m2 per year m-2 yr-1 T +FATES_MORTALITY_USTORY_SZAP fates_levscag mortality rate of understory plants in number of plants per m2 per year in each size x age cla m-2 yr-1 F +FATES_MORTALITY_USTORY_SZPF fates_levscpf total mortality of understory plants by pft/size in number of plants per m2 per year m-2 yr-1 F +FATES_NCHILLDAYS - site-level number of chill days days T +FATES_NCL_AP fates_levage number of canopy levels by age bin F +FATES_NCOHORTS - total number of cohorts per site T +FATES_NCOHORTS_SECONDARY - total number of cohorts per site T +FATES_NCOLDDAYS - site-level number of cold days days T +FATES_NEP - net ecosystem production in kg carbon per m2 per second kg m-2 s-1 T +FATES_NESTEROV_INDEX - nesterov fire danger index T +FATES_NET_C_UPTAKE_CLLL fates_levcnlf net carbon uptake in kg carbon per m2 per second by each canopy and leaf layer per unit ground kg m-2 s-1 F +FATES_NONSTRUCTC - non-structural biomass (sapwood + leaf + fineroot) in kg carbon per m2 kg m-2 T +FATES_NPATCHES - total number of patches per site T +FATES_NPATCHES_SECONDARY - total number of patches per site T +FATES_NPATCH_AP fates_levage number of patches by age bin F +FATES_NPLANT_AC fates_levcacls number of plants per m2 by cohort age class m-2 T +FATES_NPLANT_ACPF fates_levcapf stem number density by pft and age class m-2 F +FATES_NPLANT_CANOPY_SZ fates_levscls number of canopy plants per m2 by size class m-2 T +FATES_NPLANT_CANOPY_SZAP fates_levscag number of plants per m2 in canopy in each size x age class m-2 F +FATES_NPLANT_CANOPY_SZPF fates_levscpf number of canopy plants by size/pft per m2 m-2 F +FATES_NPLANT_PF fates_levpft total PFT-level number of individuals per m2 land area m-2 T +FATES_NPLANT_SEC_PF fates_levpft total PFT-level number of individuals per m2 land area, secondary patches m-2 T +FATES_NPLANT_SZ fates_levscls number of plants per m2 by size class m-2 T +FATES_NPLANT_SZAP fates_levscag number of plants per m2 in each size x age class m-2 F +FATES_NPLANT_SZAPPF fates_levscagpf number of plants per m2 in each size x age x pft class m-2 F +FATES_NPLANT_SZPF fates_levscpf stem number density by pft/size m-2 F +FATES_NPLANT_USTORY_SZ fates_levscls number of understory plants per m2 by size class m-2 T +FATES_NPLANT_USTORY_SZAP fates_levscag number of plants per m2 in understory in each size x age class m-2 F +FATES_NPLANT_USTORY_SZPF fates_levscpf density of understory plants by pft/size in number of plants per m2 m-2 F +FATES_NPP - net primary production in kg carbon per m2 per second kg m-2 s-1 T +FATES_NPP_AP fates_levage net primary productivity by age bin in kg carbon per m2 per second kg m-2 s-1 F +FATES_NPP_APPF fates_levagepft NPP per PFT in each age bin in kg carbon per m2 per second kg m-2 s-1 F +FATES_NPP_CANOPY_SZ fates_levscls NPP of canopy plants by size class in kg carbon per m2 per second kg m-2 s-1 F +FATES_NPP_PF fates_levpft total PFT-level NPP in kg carbon per m2 land area per second kg m-2 yr-1 T +FATES_NPP_SECONDARY - net primary production in kg carbon per m2 per second, secondary patches kg m-2 s-1 T +FATES_NPP_SE_PF fates_levpft total PFT-level NPP in kg carbon per m2 land area per second, secondary patches kg m-2 yr-1 T +FATES_NPP_SZPF fates_levscpf total net primary production by pft/size in kg carbon per m2 per second kg m-2 s-1 F +FATES_NPP_USTORY_SZ fates_levscls NPP of understory plants by size class in kg carbon per m2 per second kg m-2 s-1 F +FATES_PARPROF_DIF_CLLL fates_levcnlf radiative profile of diffuse PAR through each canopy and leaf layer (averaged across PFTs) W m-2 F +FATES_PARPROF_DIF_CLLLPF fates_levcnlfpf radiative profile of diffuse PAR through each canopy, leaf, and PFT W m-2 F +FATES_PARPROF_DIR_CLLL fates_levcnlf radiative profile of direct PAR through each canopy and leaf layer (averaged across PFTs) W m-2 F +FATES_PARPROF_DIR_CLLLPF fates_levcnlfpf radiative profile of direct PAR through each canopy, leaf, and PFT W m-2 F +FATES_PARSHA_Z_CL fates_levcan PAR absorbed in the shade by top leaf layer in each canopy layer W m-2 F +FATES_PARSHA_Z_CLLL fates_levcnlf PAR absorbed in the shade by each canopy and leaf layer W m-2 F +FATES_PARSHA_Z_CLLLPF fates_levcnlfpf PAR absorbed in the shade by each canopy, leaf, and PFT W m-2 F +FATES_PARSUN_Z_CL fates_levcan PAR absorbed in the sun by top leaf layer in each canopy layer W m-2 F +FATES_PARSUN_Z_CLLL fates_levcnlf PAR absorbed in the sun by each canopy and leaf layer W m-2 F +FATES_PARSUN_Z_CLLLPF fates_levcnlfpf PAR absorbed in the sun by each canopy, leaf, and PFT W m-2 F +FATES_PATCHAREA_AP fates_levage patch area by age bin per m2 land area m2 m-2 T +FATES_PRIMARY_PATCHFUSION_ERR - error in total primary lands associated with patch fusion m2 m-2 yr-1 T +FATES_PROMOTION_CARBONFLUX - promotion-associated biomass carbon flux from understory to canopy in kg carbon per m2 per sec kg m-2 s-1 T +FATES_PROMOTION_RATE_SZ fates_levscls promotion rate from understory to canopy by size class m-2 yr-1 F +FATES_RAD_ERROR - radiation error in FATES RTM W m-2 T +FATES_RDARK_CANOPY_SZ fates_levscls dark respiration for canopy plants in kg carbon per m2 per second by size kg m-2 s-1 F +FATES_RDARK_SZPF fates_levscpf dark portion of maintenance autotrophic respiration in kg carbon per m2 per second by pft/size kg m-2 s-1 F +FATES_RDARK_USTORY_SZ fates_levscls dark respiration for understory plants in kg carbon per m2 per second by size kg m-2 s-1 F +FATES_RECRUITMENT_PF fates_levpft PFT-level recruitment rate in number of individuals per m2 land area per year m-2 yr-1 T +FATES_REPROC - total biomass in live plant reproductive tissues in kg carbon per m2 kg m-2 T +FATES_REPROC_SZPF fates_levscpf reproductive carbon mass (on plant) by size-class x pft in kg carbon per m2 kg m-2 F +FATES_ROS - fire rate of spread in meters per second m s-1 T +FATES_SAI_CANOPY_SZ fates_levscls stem area index (SAI) of canopy plants by size class m2 m-2 F +FATES_SAI_USTORY_SZ fates_levscls stem area index (SAI) of understory plants by size class m2 m-2 F +FATES_SAPWOODC - total biomass in live plant sapwood in kg carbon per m2 kg m-2 T +FATES_SAPWOODCTURN_CANOPY_SZ fates_levscls sapwood turnover (non-mortal) for canopy plants by size class in kg carbon per m2 per second kg m-2 s-1 F +FATES_SAPWOODCTURN_USTORY_SZ fates_levscls sapwood C turnover (non-mortal) for understory plants by size class in kg carbon per m2 per se kg m-2 s-1 F +FATES_SAPWOODC_SZPF fates_levscpf sapwood carbon mass by size-class x pft in kg carbon per m2 kg m-2 F +FATES_SAPWOOD_ALLOC_CANOPY_SZ fates_levscls allocation to sapwood C for canopy plants by size class in kg carbon per m2 per second kg m-2 s-1 F +FATES_SAPWOOD_ALLOC_USTORY_SZ fates_levscls allocation to sapwood C for understory plants by size class in kg carbon per m2 per second kg m-2 s-1 F +FATES_SCORCH_HEIGHT_APPF fates_levagepft SPITFIRE flame Scorch Height (calculated per PFT in each patch age bin) m F +FATES_SECONDAREA_ANTHRODIST_AP fates_levage secondary forest patch area age distribution since anthropgenic disturbance m2 m-2 F +FATES_SECONDAREA_DIST_AP fates_levage secondary forest patch area age distribution since any kind of disturbance m2 m-2 F +FATES_SECONDARY_FOREST_FRACTION - secondary forest fraction m2 m-2 T +FATES_SECONDARY_FOREST_VEGC - biomass on secondary lands in kg carbon per m2 land area (mult by FATES_SECONDARY_FOREST_FRACT kg m-2 T +FATES_SEEDS_IN - seed production rate in kg carbon per m2 second kg m-2 s-1 T +FATES_SEEDS_IN_EXTERN_EL fates_levelem external seed influx rate in kg element per m2 per second kg m-2 s-1 T +FATES_SEEDS_IN_LOCAL_EL fates_levelem within-site, element-level seed production rate in kg element per m2 per second kg m-2 s-1 T +FATES_SEED_ALLOC - allocation to seeds in kg carbon per m2 per second kg m-2 s-1 T +FATES_SEED_ALLOC_CANOPY_SZ fates_levscls allocation to reproductive C for canopy plants by size class in kg carbon per m2 per second kg m-2 s-1 F +FATES_SEED_ALLOC_SZPF fates_levscpf allocation to seeds by pft/size in kg carbon per m2 per second kg m-2 s-1 F +FATES_SEED_ALLOC_USTORY_SZ fates_levscls allocation to reproductive C for understory plants by size class in kg carbon per m2 per secon kg m-2 s-1 F +FATES_SEED_BANK - total seed mass of all PFTs in kg carbon per m2 land area kg m-2 T +FATES_SEED_BANK_EL fates_levelem element-level total seed mass of all PFTs in kg element per m2 kg m-2 T +FATES_SEED_DECAY_EL fates_levelem seed mass decay (germinated and un-germinated) in kg element per m2 per second kg m-2 s-1 T +FATES_SEED_GERM_EL fates_levelem element-level total germinated seed mass of all PFTs in kg element per m2 kg m-2 T +FATES_SEED_PROD_CANOPY_SZ fates_levscls seed production of canopy plants by size class in kg carbon per m2 per second kg m-2 s-1 F +FATES_SEED_PROD_USTORY_SZ fates_levscls seed production of understory plants by size class in kg carbon per m2 per second kg m-2 s-1 F +FATES_STEM_ALLOC - allocation to stem in kg carbon per m2 per second kg m-2 s-1 T +FATES_STOMATAL_COND - mean stomatal conductance mol m-2 s-1 T +FATES_STOMATAL_COND_AP fates_levage mean stomatal conductance - by patch age mol m-2 s-1 F +FATES_STOREC - total biomass in live plant storage in kg carbon per m2 land area kg m-2 T +FATES_STORECTURN_CANOPY_SZ fates_levscls storage turnover (non-mortal) for canopy plants by size class in kg carbon per m2 per second kg m-2 s-1 F +FATES_STORECTURN_USTORY_SZ fates_levscls storage C turnover (non-mortal) for understory plants by size class in kg carbon per m2 per se kg m-2 s-1 F +FATES_STOREC_CANOPY_SZPF fates_levscpf biomass in storage pools of canopy plants by pft/size in kg carbon per m2 kg m-2 F +FATES_STOREC_PF fates_levpft total PFT-level stored biomass in kg carbon per m2 land area kg m-2 T +FATES_STOREC_SZPF fates_levscpf storage carbon mass by size-class x pft in kg carbon per m2 kg m-2 F +FATES_STOREC_TF - Storage C fraction of target kg kg-1 T +FATES_STOREC_TF_CANOPY_SZPF fates_levscpf Storage C fraction of target by size x pft, in the canopy kg kg-1 F +FATES_STOREC_TF_USTORY_SZPF fates_levscpf Storage C fraction of target by size x pft, in the understory kg kg-1 F +FATES_STOREC_USTORY_SZPF fates_levscpf biomass in storage pools of understory plants by pft/size in kg carbon per m2 kg m-2 F +FATES_STORE_ALLOC - allocation to storage tissues in kg carbon per m2 per second kg m-2 s-1 T +FATES_STORE_ALLOC_CANOPY_SZ fates_levscls allocation to storage C for canopy plants by size class in kg carbon per m2 per second kg m-2 s-1 F +FATES_STORE_ALLOC_SZPF fates_levscpf allocation to storage C by pft/size in kg carbon per m2 per second kg m-2 s-1 F +FATES_STORE_ALLOC_USTORY_SZ fates_levscls allocation to storage C for understory plants by size class in kg carbon per m2 per second kg m-2 s-1 F +FATES_STRUCTC - structural biomass in kg carbon per m2 land area kg m-2 T +FATES_STRUCTCTURN_CANOPY_SZ fates_levscls structural C turnover (non-mortal) for canopy plants by size class in kg carbon per m2 per sec kg m-2 s-1 F +FATES_STRUCTCTURN_USTORY_SZ fates_levscls structural C turnover (non-mortal) for understory plants by size class in kg carbon per m2 per kg m-2 s-1 F +FATES_STRUCT_ALLOC_CANOPY_SZ fates_levscls allocation to structural C for canopy plants by size class in kg carbon per m2 per second kg m-2 s-1 F +FATES_STRUCT_ALLOC_USTORY_SZ fates_levscls allocation to structural C for understory plants by size class in kg carbon per m2 per second kg m-2 s-1 F +FATES_TGROWTH - fates long-term running mean vegetation temperature by site degree_Celsius F +FATES_TLONGTERM - fates 30-year running mean vegetation temperature by site degree_Celsius F +FATES_TRIMMING - degree to which canopy expansion is limited by leaf economics (0-1) 1 T +FATES_TRIMMING_CANOPY_SZ fates_levscls trimming term of canopy plants weighted by plant density, by size class m-2 F +FATES_TRIMMING_USTORY_SZ fates_levscls trimming term of understory plants weighted by plant density, by size class m-2 F +FATES_TVEG - fates instantaneous mean vegetation temperature by site degree_Celsius T +FATES_TVEG24 - fates 24-hr running mean vegetation temperature by site degree_Celsius T +FATES_USTORY_VEGC - biomass of understory plants in kg carbon per m2 land area kg m-2 T +FATES_VEGC - total biomass in live plants in kg carbon per m2 land area kg m-2 T +FATES_VEGC_ABOVEGROUND - aboveground biomass in kg carbon per m2 land area kg m-2 T +FATES_VEGC_ABOVEGROUND_SZ fates_levscls aboveground biomass by size class in kg carbon per m2 kg m-2 T +FATES_VEGC_ABOVEGROUND_SZPF fates_levscpf aboveground biomass by pft/size in kg carbon per m2 kg m-2 F +FATES_VEGC_AP fates_levage total biomass within a given patch age bin in kg carbon per m2 land area kg m-2 F +FATES_VEGC_APPF fates_levagepft biomass per PFT in each age bin in kg carbon per m2 kg m-2 F +FATES_VEGC_PF fates_levpft total PFT-level biomass in kg of carbon per land area kg m-2 T +FATES_VEGC_SE_PF fates_levpft total PFT-level biomass in kg of carbon per land area, secondary patches kg m-2 T +FATES_VEGC_SZ fates_levscls total biomass by size class in kg carbon per m2 kg m-2 F +FATES_VEGC_SZPF fates_levscpf total vegetation biomass in live plants by size-class x pft in kg carbon per m2 kg m-2 F +FATES_WOOD_PRODUCT - total wood product from logging in kg carbon per m2 land area kg m-2 T +FATES_YESTCANLEV_CANOPY_SZ fates_levscls yesterdays canopy level for canopy plants by size class in number of plants per m2 m-2 F +FATES_YESTCANLEV_USTORY_SZ fates_levscls yesterdays canopy level for understory plants by size class in number of plants per m2 m-2 F +FATES_ZSTAR_AP fates_levage product of zstar and patch area by age bin (divide by FATES_PATCHAREA_AP to get mean zstar) m F +FATES_c_to_litr_cel_c levdcmp litter celluluse carbon flux from FATES to BGC gC/m^3/s T +FATES_c_to_litr_lab_c levdcmp litter labile carbon flux from FATES to BGC gC/m^3/s T +FATES_c_to_litr_lig_c levdcmp litter lignin carbon flux from FATES to BGC gC/m^3/s T +FCEV - canopy evaporation W/m^2 T +FCH4 - Gridcell surface CH4 flux to atmosphere (+ to atm) kgC/m2/s T +FCH4TOCO2 - Gridcell oxidation of CH4 to CO2 gC/m2/s T +FCH4_DFSAT - CH4 additional flux due to changing fsat, natural vegetated and crop landunits only kgC/m2/s T +FCO2 - CO2 flux to atmosphere (+ to atm) kgCO2/m2/s F +FCOV - fractional impermeable area unitless T +FCTR - canopy transpiration W/m^2 T +FGEV - ground evaporation W/m^2 T +FGR - heat flux into soil/snow including snow melt and lake / snow light transmission W/m^2 T +FGR12 - heat flux between soil layers 1 and 2 W/m^2 T +FGR_ICE - heat flux into soil/snow including snow melt and lake / snow light transmission (ice landunits W/m^2 F +FGR_R - Rural heat flux into soil/snow including snow melt and snow light transmission W/m^2 F +FGR_SOIL_R levgrnd Rural downward heat flux at interface below each soil layer watt/m^2 F +FGR_U - Urban heat flux into soil/snow including snow melt W/m^2 F +FH2OSFC - fraction of ground covered by surface water unitless T +FH2OSFC_NOSNOW - fraction of ground covered by surface water (if no snow present) unitless F +FINUNDATED - fractional inundated area of vegetated columns unitless T +FINUNDATED_LAG - time-lagged inundated fraction of vegetated columns unitless F +FIRA - net infrared (longwave) radiation W/m^2 T +FIRA_ICE - net infrared (longwave) radiation (ice landunits only) W/m^2 F +FIRA_R - Rural net infrared (longwave) radiation W/m^2 T +FIRA_U - Urban net infrared (longwave) radiation W/m^2 F +FIRE - emitted infrared (longwave) radiation W/m^2 T +FIRE_ICE - emitted infrared (longwave) radiation (ice landunits only) W/m^2 F +FIRE_R - Rural emitted infrared (longwave) radiation W/m^2 T +FIRE_U - Urban emitted infrared (longwave) radiation W/m^2 F +FLDS - atmospheric longwave radiation (downscaled to columns in glacier regions) W/m^2 T +FLDS_ICE - atmospheric longwave radiation (downscaled to columns in glacier regions) (ice landunits only) W/m^2 F +FMAX_DENIT_CARBONSUBSTRATE levdcmp FMAX_DENIT_CARBONSUBSTRATE gN/m^3/s F +FMAX_DENIT_NITRATE levdcmp FMAX_DENIT_NITRATE gN/m^3/s F +FROST_TABLE - frost table depth (natural vegetated and crop landunits only) m F +FSA - absorbed solar radiation W/m^2 T +FSAT - fractional area with water table at surface unitless T +FSA_ICE - absorbed solar radiation (ice landunits only) W/m^2 F +FSA_R - Rural absorbed solar radiation W/m^2 F +FSA_U - Urban absorbed solar radiation W/m^2 F +FSD24 - direct radiation (last 24hrs) K F +FSD240 - direct radiation (last 240hrs) K F +FSDS - atmospheric incident solar radiation W/m^2 T +FSDSND - direct nir incident solar radiation W/m^2 T +FSDSNDLN - direct nir incident solar radiation at local noon W/m^2 T +FSDSNI - diffuse nir incident solar radiation W/m^2 T +FSDSVD - direct vis incident solar radiation W/m^2 T +FSDSVDLN - direct vis incident solar radiation at local noon W/m^2 T +FSDSVI - diffuse vis incident solar radiation W/m^2 T +FSDSVILN - diffuse vis incident solar radiation at local noon W/m^2 T +FSH - sensible heat not including correction for land use change and rain/snow conversion W/m^2 T +FSH_G - sensible heat from ground W/m^2 T +FSH_ICE - sensible heat not including correction for land use change and rain/snow conversion (ice landu W/m^2 F +FSH_PRECIP_CONVERSION - Sensible heat flux from conversion of rain/snow atm forcing W/m^2 T +FSH_R - Rural sensible heat W/m^2 T +FSH_RUNOFF_ICE_TO_LIQ - sensible heat flux generated from conversion of ice runoff to liquid W/m^2 T +FSH_TO_COUPLER - sensible heat sent to coupler (includes corrections for land use change, rain/snow conversion W/m^2 T +FSH_U - Urban sensible heat W/m^2 F +FSH_V - sensible heat from veg W/m^2 T +FSI24 - indirect radiation (last 24hrs) K F +FSI240 - indirect radiation (last 240hrs) K F +FSM - snow melt heat flux W/m^2 T +FSM_ICE - snow melt heat flux (ice landunits only) W/m^2 F +FSM_R - Rural snow melt heat flux W/m^2 F +FSM_U - Urban snow melt heat flux W/m^2 F +FSNO - fraction of ground covered by snow unitless T +FSNO_EFF - effective fraction of ground covered by snow unitless T +FSNO_ICE - fraction of ground covered by snow (ice landunits only) unitless F +FSR - reflected solar radiation W/m^2 T +FSRND - direct nir reflected solar radiation W/m^2 T +FSRNDLN - direct nir reflected solar radiation at local noon W/m^2 T +FSRNI - diffuse nir reflected solar radiation W/m^2 T +FSRVD - direct vis reflected solar radiation W/m^2 T +FSRVDLN - direct vis reflected solar radiation at local noon W/m^2 T +FSRVI - diffuse vis reflected solar radiation W/m^2 T +FSR_ICE - reflected solar radiation (ice landunits only) W/m^2 F +FSUN - sunlit fraction of canopy proportion F +FSUN24 - fraction sunlit (last 24hrs) K F +FSUN240 - fraction sunlit (last 240hrs) K F +F_DENIT - denitrification flux gN/m^2/s T +F_DENIT_BASE levdcmp F_DENIT_BASE gN/m^3/s F +F_DENIT_vr levdcmp denitrification flux gN/m^3/s F +F_N2O_DENIT - denitrification N2O flux gN/m^2/s T +F_N2O_NIT - nitrification N2O flux gN/m^2/s T +F_NIT - nitrification flux gN/m^2/s T +F_NIT_vr levdcmp nitrification flux gN/m^3/s F +GROSS_NMIN - gross rate of N mineralization gN/m^2/s T +GROSS_NMIN_vr levdcmp gross rate of N mineralization gN/m^3/s F +GSSHA - shaded leaf stomatal conductance umol H20/m2/s T +GSSHALN - shaded leaf stomatal conductance at local noon umol H20/m2/s T +GSSUN - sunlit leaf stomatal conductance umol H20/m2/s T +GSSUNLN - sunlit leaf stomatal conductance at local noon umol H20/m2/s T +H2OCAN - intercepted water mm T +H2OSFC - surface water depth mm T +H2OSNO - snow depth (liquid water) mm T +H2OSNO_ICE - snow depth (liquid water, ice landunits only) mm F +H2OSNO_TOP - mass of snow in top snow layer kg/m2 T +H2OSOI levsoi volumetric soil water (natural vegetated and crop landunits only) mm3/mm3 T +HBOT - canopy bottom m F +HEAT_CONTENT1 - initial gridcell total heat content J/m^2 T +HEAT_CONTENT1_VEG - initial gridcell total heat content - natural vegetated and crop landunits only J/m^2 F +HEAT_CONTENT2 - post land cover change total heat content J/m^2 F +HEAT_FROM_AC - sensible heat flux put into canyon due to heat removed from air conditioning W/m^2 T +HIA - 2 m NWS Heat Index C T +HIA_R - Rural 2 m NWS Heat Index C T +HIA_U - Urban 2 m NWS Heat Index C T +HK levgrnd hydraulic conductivity (natural vegetated and crop landunits only) mm/s F +HR - total heterotrophic respiration gC/m^2/s T +HR_vr levsoi total vertically resolved heterotrophic respiration gC/m^3/s T +HTOP - canopy top m T +HUMIDEX - 2 m Humidex C T +HUMIDEX_R - Rural 2 m Humidex C T +HUMIDEX_U - Urban 2 m Humidex C T +ICE_CONTENT1 - initial gridcell total ice content mm T +ICE_CONTENT2 - post land cover change total ice content mm F +ICE_MODEL_FRACTION - Ice sheet model fractional coverage unitless F +INT_SNOW - accumulated swe (natural vegetated and crop landunits only) mm F +INT_SNOW_ICE - accumulated swe (ice landunits only) mm F +IWUELN - local noon intrinsic water use efficiency umolCO2/molH2O T +KROOT levsoi root conductance each soil layer 1/s F +KSOIL levsoi soil conductance in each soil layer 1/s F +K_ACT_SOM levdcmp active soil organic potential loss coefficient 1/s F +K_CEL_LIT levdcmp cellulosic litter potential loss coefficient 1/s F +K_LIG_LIT levdcmp lignin litter potential loss coefficient 1/s F +K_MET_LIT levdcmp metabolic litter potential loss coefficient 1/s F +K_NITR levdcmp K_NITR 1/s F +K_NITR_H2O levdcmp K_NITR_H2O unitless F +K_NITR_PH levdcmp K_NITR_PH unitless F +K_NITR_T levdcmp K_NITR_T unitless F +K_PAS_SOM levdcmp passive soil organic potential loss coefficient 1/s F +K_SLO_SOM levdcmp slow soil organic ma potential loss coefficient 1/s F +L1_PATHFRAC_S1_vr levdcmp PATHFRAC from metabolic litter to active soil organic fraction F +L1_RESP_FRAC_S1_vr levdcmp respired from metabolic litter to active soil organic fraction F +L2_PATHFRAC_S1_vr levdcmp PATHFRAC from cellulosic litter to active soil organic fraction F +L2_RESP_FRAC_S1_vr levdcmp respired from cellulosic litter to active soil organic fraction F +L3_PATHFRAC_S2_vr levdcmp PATHFRAC from lignin litter to slow soil organic ma fraction F +L3_RESP_FRAC_S2_vr levdcmp respired from lignin litter to slow soil organic ma fraction F +LAI240 - 240hr average of leaf area index m^2/m^2 F +LAISHA - shaded projected leaf area index m^2/m^2 T +LAISUN - sunlit projected leaf area index m^2/m^2 T +LAKEICEFRAC levlak lake layer ice mass fraction unitless F +LAKEICEFRAC_SURF - surface lake layer ice mass fraction unitless T +LAKEICETHICK - thickness of lake ice (including physical expansion on freezing) m T +LIG_LITC - LIG_LIT C gC/m^2 T +LIG_LITC_1m - LIG_LIT C to 1 meter gC/m^2 F +LIG_LITC_TNDNCY_VERT_TRA levdcmp lignin litter C tendency due to vertical transport gC/m^3/s F +LIG_LITC_TO_SLO_SOMC - decomp. of lignin litter C to slow soil organic ma C gC/m^2/s F +LIG_LITC_TO_SLO_SOMC_vr levdcmp decomp. of lignin litter C to slow soil organic ma C gC/m^3/s F +LIG_LITC_vr levsoi LIG_LIT C (vertically resolved) gC/m^3 T +LIG_LITN - LIG_LIT N gN/m^2 T +LIG_LITN_1m - LIG_LIT N to 1 meter gN/m^2 F +LIG_LITN_TNDNCY_VERT_TRA levdcmp lignin litter N tendency due to vertical transport gN/m^3/s F +LIG_LITN_TO_SLO_SOMN - decomp. of lignin litter N to slow soil organic ma N gN/m^2 F +LIG_LITN_TO_SLO_SOMN_vr levdcmp decomp. of lignin litter N to slow soil organic ma N gN/m^3 F +LIG_LITN_vr levdcmp LIG_LIT N (vertically resolved) gN/m^3 T +LIG_LIT_HR - Het. Resp. from lignin litter gC/m^2/s F +LIG_LIT_HR_vr levdcmp Het. Resp. from lignin litter gC/m^3/s F +LIQCAN - intercepted liquid water mm T +LIQUID_CONTENT1 - initial gridcell total liq content mm T +LIQUID_CONTENT2 - post landuse change gridcell total liq content mm F +LIQUID_WATER_TEMP1 - initial gridcell weighted average liquid water temperature K F +LITTERC_HR - litter C heterotrophic respiration gC/m^2/s T +LNC - leaf N concentration gN leaf/m^2 T +LWdown - atmospheric longwave radiation (downscaled to columns in glacier regions) W/m^2 F +LWup - upwelling longwave radiation W/m^2 F +MET_LITC - MET_LIT C gC/m^2 T +MET_LITC_1m - MET_LIT C to 1 meter gC/m^2 F +MET_LITC_TNDNCY_VERT_TRA levdcmp metabolic litter C tendency due to vertical transport gC/m^3/s F +MET_LITC_TO_ACT_SOMC - decomp. of metabolic litter C to active soil organic C gC/m^2/s F +MET_LITC_TO_ACT_SOMC_vr levdcmp decomp. of metabolic litter C to active soil organic C gC/m^3/s F +MET_LITC_vr levsoi MET_LIT C (vertically resolved) gC/m^3 T +MET_LITN - MET_LIT N gN/m^2 T +MET_LITN_1m - MET_LIT N to 1 meter gN/m^2 F +MET_LITN_TNDNCY_VERT_TRA levdcmp metabolic litter N tendency due to vertical transport gN/m^3/s F +MET_LITN_TO_ACT_SOMN - decomp. of metabolic litter N to active soil organic N gN/m^2 F +MET_LITN_TO_ACT_SOMN_vr levdcmp decomp. of metabolic litter N to active soil organic N gN/m^3 F +MET_LITN_vr levdcmp MET_LIT N (vertically resolved) gN/m^3 T +MET_LIT_HR - Het. Resp. from metabolic litter gC/m^2/s F +MET_LIT_HR_vr levdcmp Het. Resp. from metabolic litter gC/m^3/s F +MORTALITY_CROWNAREA_CANOPY - Crown area of canopy trees that died m2/ha/year T +MORTALITY_CROWNAREA_UNDERSTORY - Crown aera of understory trees that died m2/ha/year T +M_ACT_SOMC_TO_LEACHING - active soil organic C leaching loss gC/m^2/s F +M_ACT_SOMN_TO_LEACHING - active soil organic N leaching loss gN/m^2/s F +M_CEL_LITC_TO_LEACHING - cellulosic litter C leaching loss gC/m^2/s F +M_CEL_LITN_TO_LEACHING - cellulosic litter N leaching loss gN/m^2/s F +M_LIG_LITC_TO_LEACHING - lignin litter C leaching loss gC/m^2/s F +M_LIG_LITN_TO_LEACHING - lignin litter N leaching loss gN/m^2/s F +M_MET_LITC_TO_LEACHING - metabolic litter C leaching loss gC/m^2/s F +M_MET_LITN_TO_LEACHING - metabolic litter N leaching loss gN/m^2/s F +M_PAS_SOMC_TO_LEACHING - passive soil organic C leaching loss gC/m^2/s F +M_PAS_SOMN_TO_LEACHING - passive soil organic N leaching loss gN/m^2/s F +M_SLO_SOMC_TO_LEACHING - slow soil organic ma C leaching loss gC/m^2/s F +M_SLO_SOMN_TO_LEACHING - slow soil organic ma N leaching loss gN/m^2/s F +NDEP_TO_SMINN - atmospheric N deposition to soil mineral N gN/m^2/s T +NEM - Gridcell net adjustment to net carbon exchange passed to atm. for methane production gC/m2/s T +NET_NMIN - net rate of N mineralization gN/m^2/s T +NET_NMIN_vr levdcmp net rate of N mineralization gN/m^3/s F +NFIX_TO_SMINN - symbiotic/asymbiotic N fixation to soil mineral N gN/m^2/s T +NSUBSTEPS - number of adaptive timesteps in CLM timestep unitless F +O2_DECOMP_DEPTH_UNSAT levgrnd O2 consumption from HR and AR for non-inundated area mol/m3/s F +OBU - Monin-Obukhov length m F +OCDEP - total OC deposition (dry+wet) from atmosphere kg/m^2/s T +O_SCALAR levsoi fraction by which decomposition is reduced due to anoxia unitless T +PARVEGLN - absorbed par by vegetation at local noon W/m^2 T +PAS_SOMC - PAS_SOM C gC/m^2 T +PAS_SOMC_1m - PAS_SOM C to 1 meter gC/m^2 F +PAS_SOMC_TNDNCY_VERT_TRA levdcmp passive soil organic C tendency due to vertical transport gC/m^3/s F +PAS_SOMC_TO_ACT_SOMC - decomp. of passive soil organic C to active soil organic C gC/m^2/s F +PAS_SOMC_TO_ACT_SOMC_vr levdcmp decomp. of passive soil organic C to active soil organic C gC/m^3/s F +PAS_SOMC_vr levsoi PAS_SOM C (vertically resolved) gC/m^3 T +PAS_SOMN - PAS_SOM N gN/m^2 T +PAS_SOMN_1m - PAS_SOM N to 1 meter gN/m^2 F +PAS_SOMN_TNDNCY_VERT_TRA levdcmp passive soil organic N tendency due to vertical transport gN/m^3/s F +PAS_SOMN_TO_ACT_SOMN - decomp. of passive soil organic N to active soil organic N gN/m^2 F +PAS_SOMN_TO_ACT_SOMN_vr levdcmp decomp. of passive soil organic N to active soil organic N gN/m^3 F +PAS_SOMN_vr levdcmp PAS_SOM N (vertically resolved) gN/m^3 T +PAS_SOM_HR - Het. Resp. from passive soil organic gC/m^2/s F +PAS_SOM_HR_vr levdcmp Het. Resp. from passive soil organic gC/m^3/s F +PBOT - atmospheric pressure at surface (downscaled to columns in glacier regions) Pa T +PCH4 - atmospheric partial pressure of CH4 Pa T +PCO2 - atmospheric partial pressure of CO2 Pa T +POTENTIAL_IMMOB - potential N immobilization gN/m^2/s T +POTENTIAL_IMMOB_vr levdcmp potential N immobilization gN/m^3/s F +POT_F_DENIT - potential denitrification flux gN/m^2/s T +POT_F_DENIT_vr levdcmp potential denitrification flux gN/m^3/s F +POT_F_NIT - potential nitrification flux gN/m^2/s T +POT_F_NIT_vr levdcmp potential nitrification flux gN/m^3/s F +PSurf - atmospheric pressure at surface (downscaled to columns in glacier regions) Pa F +Q2M - 2m specific humidity kg/kg T +QAF - canopy air humidity kg/kg F +QBOT - atmospheric specific humidity (downscaled to columns in glacier regions) kg/kg T +QDIRECT_THROUGHFALL - direct throughfall of liquid (rain + above-canopy irrigation) mm/s F +QDIRECT_THROUGHFALL_SNOW - direct throughfall of snow mm/s F +QDRAI - sub-surface drainage mm/s T +QDRAI_PERCH - perched wt drainage mm/s T +QDRAI_XS - saturation excess drainage mm/s T +QDRIP - rate of excess canopy liquid falling off canopy mm/s F +QDRIP_SNOW - rate of excess canopy snow falling off canopy mm/s F +QFLOOD - runoff from river flooding mm/s T +QFLX_EVAP_TOT - qflx_evap_soi + qflx_evap_can + qflx_tran_veg kg m-2 s-1 T +QFLX_EVAP_VEG - vegetation evaporation mm H2O/s F +QFLX_ICE_DYNBAL - ice dynamic land cover change conversion runoff flux mm/s T +QFLX_LIQDEW_TO_TOP_LAYER - rate of liquid water deposited on top soil or snow layer (dew) mm H2O/s T +QFLX_LIQEVAP_FROM_TOP_LAYER - rate of liquid water evaporated from top soil or snow layer mm H2O/s T +QFLX_LIQ_DYNBAL - liq dynamic land cover change conversion runoff flux mm/s T +QFLX_LIQ_GRND - liquid (rain+irrigation) on ground after interception mm H2O/s F +QFLX_SNOW_DRAIN - drainage from snow pack mm/s T +QFLX_SNOW_DRAIN_ICE - drainage from snow pack melt (ice landunits only) mm/s T +QFLX_SNOW_GRND - snow on ground after interception mm H2O/s F +QFLX_SOLIDDEW_TO_TOP_LAYER - rate of solid water deposited on top soil or snow layer (frost) mm H2O/s T +QFLX_SOLIDEVAP_FROM_TOP_LAYER - rate of ice evaporated from top soil or snow layer (sublimation) (also includes bare ice subli mm H2O/s T +QFLX_SOLIDEVAP_FROM_TOP_LAYER_ICE - rate of ice evaporated from top soil or snow layer (sublimation) (also includes bare ice subli mm H2O/s F +QH2OSFC - surface water runoff mm/s T +QH2OSFC_TO_ICE - surface water converted to ice mm/s F +QHR - hydraulic redistribution mm/s T +QICE - ice growth/melt mm/s T +QICE_FORC elevclas qice forcing sent to GLC mm/s F +QICE_FRZ - ice growth mm/s T +QICE_MELT - ice melt mm/s T +QINFL - infiltration mm/s T +QINTR - interception mm/s T +QIRRIG_DEMAND - irrigation demand mm/s F +QIRRIG_DRIP - water added via drip irrigation mm/s F +QIRRIG_FROM_GW_CONFINED - water added through confined groundwater irrigation mm/s T +QIRRIG_FROM_GW_UNCONFINED - water added through unconfined groundwater irrigation mm/s T +QIRRIG_FROM_SURFACE - water added through surface water irrigation mm/s T +QIRRIG_SPRINKLER - water added via sprinkler irrigation mm/s F +QOVER - total surface runoff (includes QH2OSFC) mm/s T +QOVER_LAG - time-lagged surface runoff for soil columns mm/s F +QPHSNEG - net negative hydraulic redistribution flux mm/s F +QRGWL - surface runoff at glaciers (liquid only), wetlands, lakes; also includes melted ice runoff fro mm/s T +QROOTSINK levsoi water flux from soil to root in each soil-layer mm/s F +QRUNOFF - total liquid runoff not including correction for land use change mm/s T +QRUNOFF_ICE - total liquid runoff not incl corret for LULCC (ice landunits only) mm/s T +QRUNOFF_ICE_TO_COUPLER - total ice runoff sent to coupler (includes corrections for land use change) mm/s T +QRUNOFF_ICE_TO_LIQ - liquid runoff from converted ice runoff mm/s F +QRUNOFF_R - Rural total runoff mm/s F +QRUNOFF_TO_COUPLER - total liquid runoff sent to coupler (includes corrections for land use change) mm/s T +QRUNOFF_U - Urban total runoff mm/s F +QSNOCPLIQ - excess liquid h2o due to snow capping not including correction for land use change mm H2O/s T +QSNOEVAP - evaporation from snow (only when snl<0, otherwise it is equal to qflx_ev_soil) mm/s T +QSNOFRZ - column-integrated snow freezing rate kg/m2/s T +QSNOFRZ_ICE - column-integrated snow freezing rate (ice landunits only) mm/s T +QSNOMELT - snow melt rate mm/s T +QSNOMELT_ICE - snow melt (ice landunits only) mm/s T +QSNOUNLOAD - canopy snow unloading mm/s T +QSNO_TEMPUNLOAD - canopy snow temp unloading mm/s T +QSNO_WINDUNLOAD - canopy snow wind unloading mm/s T +QSNWCPICE - excess solid h2o due to snow capping not including correction for land use change mm H2O/s T +QSOIL - Ground evaporation (soil/snow evaporation + soil/snow sublimation - dew) mm/s T +QSOIL_ICE - Ground evaporation (ice landunits only) mm/s T +QTOPSOIL - water input to surface mm/s F +QVEGE - canopy evaporation mm/s T +QVEGT - canopy transpiration mm/s T +Qair - atmospheric specific humidity (downscaled to columns in glacier regions) kg/kg F +Qh - sensible heat W/m^2 F +Qle - total evaporation W/m^2 F +Qstor - storage heat flux (includes snowmelt) W/m^2 F +Qtau - momentum flux kg/m/s^2 F +RAH1 - aerodynamical resistance s/m F +RAH2 - aerodynamical resistance s/m F +RAIN - atmospheric rain, after rain/snow repartitioning based on temperature mm/s T +RAIN_FROM_ATM - atmospheric rain received from atmosphere (pre-repartitioning) mm/s T +RAIN_ICE - atmospheric rain, after rain/snow repartitioning based on temperature (ice landunits only) mm/s F +RAM_LAKE - aerodynamic resistance for momentum (lakes only) s/m F +RAW1 - aerodynamical resistance s/m F +RAW2 - aerodynamical resistance s/m F +RB - leaf boundary resistance s/m F +RH - atmospheric relative humidity % F +RH2M - 2m relative humidity % T +RH2M_R - Rural 2m specific humidity % F +RH2M_U - Urban 2m relative humidity % F +RHAF - fractional humidity of canopy air fraction F +RH_LEAF - fractional humidity at leaf surface fraction F +RSCANOPY - canopy resistance s m-1 T +RSSHA - shaded leaf stomatal resistance s/m T +RSSUN - sunlit leaf stomatal resistance s/m T +Rainf - atmospheric rain, after rain/snow repartitioning based on temperature mm/s F +Rnet - net radiation W/m^2 F +S1_PATHFRAC_S2_vr levdcmp PATHFRAC from active soil organic to slow soil organic ma fraction F +S1_PATHFRAC_S3_vr levdcmp PATHFRAC from active soil organic to passive soil organic fraction F +S1_RESP_FRAC_S2_vr levdcmp respired from active soil organic to slow soil organic ma fraction F +S1_RESP_FRAC_S3_vr levdcmp respired from active soil organic to passive soil organic fraction F +S2_PATHFRAC_S1_vr levdcmp PATHFRAC from slow soil organic ma to active soil organic fraction F +S2_PATHFRAC_S3_vr levdcmp PATHFRAC from slow soil organic ma to passive soil organic fraction F +S2_RESP_FRAC_S1_vr levdcmp respired from slow soil organic ma to active soil organic fraction F +S2_RESP_FRAC_S3_vr levdcmp respired from slow soil organic ma to passive soil organic fraction F +S3_PATHFRAC_S1_vr levdcmp PATHFRAC from passive soil organic to active soil organic fraction F +S3_RESP_FRAC_S1_vr levdcmp respired from passive soil organic to active soil organic fraction F +SABG - solar rad absorbed by ground W/m^2 T +SABG_PEN - Rural solar rad penetrating top soil or snow layer watt/m^2 T +SABV - solar rad absorbed by veg W/m^2 T +SLO_SOMC - SLO_SOM C gC/m^2 T +SLO_SOMC_1m - SLO_SOM C to 1 meter gC/m^2 F +SLO_SOMC_TNDNCY_VERT_TRA levdcmp slow soil organic ma C tendency due to vertical transport gC/m^3/s F +SLO_SOMC_TO_ACT_SOMC - decomp. of slow soil organic ma C to active soil organic C gC/m^2/s F +SLO_SOMC_TO_ACT_SOMC_vr levdcmp decomp. of slow soil organic ma C to active soil organic C gC/m^3/s F +SLO_SOMC_TO_PAS_SOMC - decomp. of slow soil organic ma C to passive soil organic C gC/m^2/s F +SLO_SOMC_TO_PAS_SOMC_vr levdcmp decomp. of slow soil organic ma C to passive soil organic C gC/m^3/s F +SLO_SOMC_vr levsoi SLO_SOM C (vertically resolved) gC/m^3 T +SLO_SOMN - SLO_SOM N gN/m^2 T +SLO_SOMN_1m - SLO_SOM N to 1 meter gN/m^2 F +SLO_SOMN_TNDNCY_VERT_TRA levdcmp slow soil organic ma N tendency due to vertical transport gN/m^3/s F +SLO_SOMN_TO_ACT_SOMN - decomp. of slow soil organic ma N to active soil organic N gN/m^2 F +SLO_SOMN_TO_ACT_SOMN_vr levdcmp decomp. of slow soil organic ma N to active soil organic N gN/m^3 F +SLO_SOMN_TO_PAS_SOMN - decomp. of slow soil organic ma N to passive soil organic N gN/m^2 F +SLO_SOMN_TO_PAS_SOMN_vr levdcmp decomp. of slow soil organic ma N to passive soil organic N gN/m^3 F +SLO_SOMN_vr levdcmp SLO_SOM N (vertically resolved) gN/m^3 T +SLO_SOM_HR_S1 - Het. Resp. from slow soil organic ma gC/m^2/s F +SLO_SOM_HR_S1_vr levdcmp Het. Resp. from slow soil organic ma gC/m^3/s F +SLO_SOM_HR_S3 - Het. Resp. from slow soil organic ma gC/m^2/s F +SLO_SOM_HR_S3_vr levdcmp Het. Resp. from slow soil organic ma gC/m^3/s F +SMINN - soil mineral N gN/m^2 T +SMINN_TO_PLANT - plant uptake of soil mineral N gN/m^2/s T +SMINN_TO_PLANT_vr levdcmp plant uptake of soil mineral N gN/m^3/s F +SMINN_TO_S1N_L1 - mineral N flux for decomp. of MET_LITto ACT_SOM gN/m^2 F +SMINN_TO_S1N_L1_vr levdcmp mineral N flux for decomp. of MET_LITto ACT_SOM gN/m^3 F +SMINN_TO_S1N_L2 - mineral N flux for decomp. of CEL_LITto ACT_SOM gN/m^2 F +SMINN_TO_S1N_L2_vr levdcmp mineral N flux for decomp. of CEL_LITto ACT_SOM gN/m^3 F +SMINN_TO_S1N_S2 - mineral N flux for decomp. of SLO_SOMto ACT_SOM gN/m^2 F +SMINN_TO_S1N_S2_vr levdcmp mineral N flux for decomp. of SLO_SOMto ACT_SOM gN/m^3 F +SMINN_TO_S1N_S3 - mineral N flux for decomp. of PAS_SOMto ACT_SOM gN/m^2 F +SMINN_TO_S1N_S3_vr levdcmp mineral N flux for decomp. of PAS_SOMto ACT_SOM gN/m^3 F +SMINN_TO_S2N_L3 - mineral N flux for decomp. of LIG_LITto SLO_SOM gN/m^2 F +SMINN_TO_S2N_L3_vr levdcmp mineral N flux for decomp. of LIG_LITto SLO_SOM gN/m^3 F +SMINN_TO_S2N_S1 - mineral N flux for decomp. of ACT_SOMto SLO_SOM gN/m^2 F +SMINN_TO_S2N_S1_vr levdcmp mineral N flux for decomp. of ACT_SOMto SLO_SOM gN/m^3 F +SMINN_TO_S3N_S1 - mineral N flux for decomp. of ACT_SOMto PAS_SOM gN/m^2 F +SMINN_TO_S3N_S1_vr levdcmp mineral N flux for decomp. of ACT_SOMto PAS_SOM gN/m^3 F +SMINN_TO_S3N_S2 - mineral N flux for decomp. of SLO_SOMto PAS_SOM gN/m^2 F +SMINN_TO_S3N_S2_vr levdcmp mineral N flux for decomp. of SLO_SOMto PAS_SOM gN/m^3 F +SMINN_vr levsoi soil mineral N gN/m^3 T +SMIN_NH4 - soil mineral NH4 gN/m^2 T +SMIN_NH4_TO_PLANT levdcmp plant uptake of NH4 gN/m^3/s F +SMIN_NH4_vr levsoi soil mineral NH4 (vert. res.) gN/m^3 T +SMIN_NO3 - soil mineral NO3 gN/m^2 T +SMIN_NO3_LEACHED - soil NO3 pool loss to leaching gN/m^2/s T +SMIN_NO3_LEACHED_vr levdcmp soil NO3 pool loss to leaching gN/m^3/s F +SMIN_NO3_MASSDENS levdcmp SMIN_NO3_MASSDENS ugN/cm^3 soil F +SMIN_NO3_RUNOFF - soil NO3 pool loss to runoff gN/m^2/s T +SMIN_NO3_RUNOFF_vr levdcmp soil NO3 pool loss to runoff gN/m^3/s F +SMIN_NO3_TO_PLANT levdcmp plant uptake of NO3 gN/m^3/s F +SMIN_NO3_vr levsoi soil mineral NO3 (vert. res.) gN/m^3 T +SMP levgrnd soil matric potential (natural vegetated and crop landunits only) mm T +SNOBCMCL - mass of BC in snow column kg/m2 T +SNOBCMSL - mass of BC in top snow layer kg/m2 T +SNOCAN - intercepted snow mm T +SNODSTMCL - mass of dust in snow column kg/m2 T +SNODSTMSL - mass of dust in top snow layer kg/m2 T +SNOFSDSND - direct nir incident solar radiation on snow W/m^2 F +SNOFSDSNI - diffuse nir incident solar radiation on snow W/m^2 F +SNOFSDSVD - direct vis incident solar radiation on snow W/m^2 F +SNOFSDSVI - diffuse vis incident solar radiation on snow W/m^2 F +SNOFSRND - direct nir reflected solar radiation from snow W/m^2 T +SNOFSRNI - diffuse nir reflected solar radiation from snow W/m^2 T +SNOFSRVD - direct vis reflected solar radiation from snow W/m^2 T +SNOFSRVI - diffuse vis reflected solar radiation from snow W/m^2 T +SNOINTABS - Fraction of incoming solar absorbed by lower snow layers - T +SNOLIQFL - top snow layer liquid water fraction (land) fraction F +SNOOCMCL - mass of OC in snow column kg/m2 T +SNOOCMSL - mass of OC in top snow layer kg/m2 T +SNORDSL - top snow layer effective grain radius m^-6 F +SNOTTOPL - snow temperature (top layer) K F +SNOTTOPL_ICE - snow temperature (top layer, ice landunits only) K F +SNOTXMASS - snow temperature times layer mass, layer sum; to get mass-weighted temperature, divide by (SNO K kg/m2 T +SNOTXMASS_ICE - snow temperature times layer mass, layer sum (ice landunits only); to get mass-weighted temper K kg/m2 F +SNOW - atmospheric snow, after rain/snow repartitioning based on temperature mm/s T +SNOWDP - gridcell mean snow height m T +SNOWICE - snow ice kg/m2 T +SNOWICE_ICE - snow ice (ice landunits only) kg/m2 F +SNOWLIQ - snow liquid water kg/m2 T +SNOWLIQ_ICE - snow liquid water (ice landunits only) kg/m2 F +SNOW_5D - 5day snow avg m F +SNOW_DEPTH - snow height of snow covered area m T +SNOW_DEPTH_ICE - snow height of snow covered area (ice landunits only) m F +SNOW_FROM_ATM - atmospheric snow received from atmosphere (pre-repartitioning) mm/s T +SNOW_ICE - atmospheric snow, after rain/snow repartitioning based on temperature (ice landunits only) mm/s F +SNOW_PERSISTENCE - Length of time of continuous snow cover (nat. veg. landunits only) seconds T +SNOW_SINKS - snow sinks (liquid water) mm/s T +SNOW_SOURCES - snow sources (liquid water) mm/s T +SNO_ABS levsno Absorbed solar radiation in each snow layer W/m^2 F +SNO_ABS_ICE levsno Absorbed solar radiation in each snow layer (ice landunits only) W/m^2 F +SNO_BW levsno Partial density of water in the snow pack (ice + liquid) kg/m3 F +SNO_BW_ICE levsno Partial density of water in the snow pack (ice + liquid, ice landunits only) kg/m3 F +SNO_EXISTENCE levsno Fraction of averaging period for which each snow layer existed unitless F +SNO_FRZ levsno snow freezing rate in each snow layer kg/m2/s F +SNO_FRZ_ICE levsno snow freezing rate in each snow layer (ice landunits only) mm/s F +SNO_GS levsno Mean snow grain size Microns F +SNO_GS_ICE levsno Mean snow grain size (ice landunits only) Microns F +SNO_ICE levsno Snow ice content kg/m2 F +SNO_LIQH2O levsno Snow liquid water content kg/m2 F +SNO_MELT levsno snow melt rate in each snow layer mm/s F +SNO_MELT_ICE levsno snow melt rate in each snow layer (ice landunits only) mm/s F +SNO_T levsno Snow temperatures K F +SNO_TK levsno Thermal conductivity W/m-K F +SNO_TK_ICE levsno Thermal conductivity (ice landunits only) W/m-K F +SNO_T_ICE levsno Snow temperatures (ice landunits only) K F +SNO_Z levsno Snow layer thicknesses m F +SNO_Z_ICE levsno Snow layer thicknesses (ice landunits only) m F +SNOdTdzL - top snow layer temperature gradient (land) K/m F +SOIL10 - 10-day running mean of 12cm layer soil K F +SOILC_HR - soil C heterotrophic respiration gC/m^2/s T +SOILC_vr levsoi SOIL C (vertically resolved) gC/m^3 T +SOILICE levsoi soil ice (natural vegetated and crop landunits only) kg/m2 T +SOILLIQ levsoi soil liquid water (natural vegetated and crop landunits only) kg/m2 T +SOILN_vr levdcmp SOIL N (vertically resolved) gN/m^3 T +SOILPSI levgrnd soil water potential in each soil layer MPa F +SOILRESIS - soil resistance to evaporation s/m T +SOILWATER_10CM - soil liquid water + ice in top 10cm of soil (veg landunits only) kg/m2 T +SOMC_FIRE - C loss due to peat burning gC/m^2/s T +SOM_C_LEACHED - total flux of C from SOM pools due to leaching gC/m^2/s T +SOM_N_LEACHED - total flux of N from SOM pools due to leaching gN/m^2/s F +SUPPLEMENT_TO_SMINN - supplemental N supply gN/m^2/s T +SUPPLEMENT_TO_SMINN_vr levdcmp supplemental N supply gN/m^3/s F +SWBGT - 2 m Simplified Wetbulb Globe Temp C T +SWBGT_R - Rural 2 m Simplified Wetbulb Globe Temp C T +SWBGT_U - Urban 2 m Simplified Wetbulb Globe Temp C T +SWdown - atmospheric incident solar radiation W/m^2 F +SWup - upwelling shortwave radiation W/m^2 F +SoilAlpha - factor limiting ground evap unitless F +SoilAlpha_U - urban factor limiting ground evap unitless F +T10 - 10-day running mean of 2-m temperature K F +TAF - canopy air temperature K F +TAUX - zonal surface stress kg/m/s^2 T +TAUY - meridional surface stress kg/m/s^2 T +TBOT - atmospheric air temperature (downscaled to columns in glacier regions) K T +TBUILD - internal urban building air temperature K T +TBUILD_MAX - prescribed maximum interior building temperature K F +TFLOOR - floor temperature K F +TG - ground temperature K T +TG_ICE - ground temperature (ice landunits only) K F +TG_R - Rural ground temperature K F +TG_U - Urban ground temperature K F +TH2OSFC - surface water temperature K T +THBOT - atmospheric air potential temperature (downscaled to columns in glacier regions) K T +TKE1 - top lake level eddy thermal conductivity W/(mK) T +TLAI - total projected leaf area index m^2/m^2 T +TLAKE levlak lake temperature K T +TOPO_COL - column-level topographic height m F +TOPO_COL_ICE - column-level topographic height (ice landunits only) m F +TOPO_FORC elevclas topograephic height sent to GLC m F +TOTCOLCH4 - total belowground CH4 (0 for non-lake special landunits in the absence of dynamic landunits) gC/m2 T +TOTLITC - total litter carbon gC/m^2 T +TOTLITC_1m - total litter carbon to 1 meter depth gC/m^2 T +TOTLITN - total litter N gN/m^2 T +TOTLITN_1m - total litter N to 1 meter gN/m^2 T +TOTSOILICE - vertically summed soil cie (veg landunits only) kg/m2 T +TOTSOILLIQ - vertically summed soil liquid water (veg landunits only) kg/m2 T +TOTSOMC - total soil organic matter carbon gC/m^2 T +TOTSOMC_1m - total soil organic matter carbon to 1 meter depth gC/m^2 T +TOTSOMN - total soil organic matter N gN/m^2 T +TOTSOMN_1m - total soil organic matter N to 1 meter gN/m^2 T +TRAFFICFLUX - sensible heat flux from urban traffic W/m^2 F +TREFMNAV - daily minimum of average 2-m temperature K T +TREFMNAV_R - Rural daily minimum of average 2-m temperature K F +TREFMNAV_U - Urban daily minimum of average 2-m temperature K F +TREFMXAV - daily maximum of average 2-m temperature K T +TREFMXAV_R - Rural daily maximum of average 2-m temperature K F +TREFMXAV_U - Urban daily maximum of average 2-m temperature K F +TROOF_INNER - roof inside surface temperature K F +TSA - 2m air temperature K T +TSAI - total projected stem area index m^2/m^2 T +TSA_ICE - 2m air temperature (ice landunits only) K F +TSA_R - Rural 2m air temperature K F +TSA_U - Urban 2m air temperature K F +TSHDW_INNER - shadewall inside surface temperature K F +TSKIN - skin temperature K T +TSL - temperature of near-surface soil layer (natural vegetated and crop landunits only) K T +TSOI levgrnd soil temperature (natural vegetated and crop landunits only) K T +TSOI_10CM - soil temperature in top 10cm of soil K T +TSOI_ICE levgrnd soil temperature (ice landunits only) K T +TSRF_FORC elevclas surface temperature sent to GLC K F +TSUNW_INNER - sunwall inside surface temperature K F +TV - vegetation temperature K T +TV24 - vegetation temperature (last 24hrs) K F +TV240 - vegetation temperature (last 240hrs) K F +TWS - total water storage mm T +T_SCALAR levsoi temperature inhibition of decomposition unitless T +Tair - atmospheric air temperature (downscaled to columns in glacier regions) K F +Tair_from_atm - atmospheric air temperature received from atmosphere (pre-downscaling) K F +U10 - 10-m wind m/s T +U10_DUST - 10-m wind for dust model m/s T +U10_ICE - 10-m wind (ice landunits only) m/s F +UAF - canopy air speed m/s F +UM - wind speed plus stability effect m/s F +URBAN_AC - urban air conditioning flux W/m^2 T +URBAN_HEAT - urban heating flux W/m^2 T +USTAR - aerodynamical resistance s/m F +UST_LAKE - friction velocity (lakes only) m/s F +VA - atmospheric wind speed plus convective velocity m/s F +VENTILATION - sensible heat flux from building ventilation W/m^2 T +VOLR - river channel total water storage m3 T +VOLRMCH - river channel main channel water storage m3 T +VPD - vpd Pa F +VPD2M - 2m vapor pressure deficit Pa T +VPD_CAN - canopy vapor pressure deficit kPa T +WASTEHEAT - sensible heat flux from heating/cooling sources of urban waste heat W/m^2 T +WBT - 2 m Stull Wet Bulb C T +WBT_R - Rural 2 m Stull Wet Bulb C T +WBT_U - Urban 2 m Stull Wet Bulb C T +WFPS levdcmp WFPS percent F +WIND - atmospheric wind velocity magnitude m/s T +WTGQ - surface tracer conductance m/s T +W_SCALAR levsoi Moisture (dryness) inhibition of decomposition unitless T +Wind - atmospheric wind velocity magnitude m/s F +Z0HG - roughness length over ground, sensible heat (vegetated landunits only) m F +Z0MG - roughness length over ground, momentum (vegetated landunits only) m F +Z0MV_DENSE - roughness length over vegetation, momentum, for dense canopy m F +Z0M_TO_COUPLER - roughness length, momentum: gridcell average sent to coupler m F +Z0QG - roughness length over ground, latent heat (vegetated landunits only) m F +ZBOT - atmospheric reference height m T +ZETA - dimensionless stability parameter unitless F +ZII - convective boundary height m F +ZWT - water table depth (natural vegetated and crop landunits only) m T +ZWT_CH4_UNSAT - depth of water table for methane production used in non-inundated area m T +ZWT_PERCH - perched water table depth (natural vegetated and crop landunits only) m T +anaerobic_frac levdcmp anaerobic_frac m3/m3 F +diffus levdcmp diffusivity m^2/s F +fr_WFPS levdcmp fr_WFPS fraction F +n2_n2o_ratio_denit levdcmp n2_n2o_ratio_denit gN/gN F +num_iter - number of iterations unitless F +r_psi levdcmp r_psi m F +ratio_k1 levdcmp ratio_k1 none F +ratio_no3_co2 levdcmp ratio_no3_co2 ratio F +soil_bulkdensity levdcmp soil_bulkdensity kg/m3 F +soil_co2_prod levdcmp soil_co2_prod ug C / g soil / day F +=================================== ================ ============================================================================================== ================================================================= ======= diff --git a/doc/source/users_guide/setting-up-and-running-a-case/history_fields_nofates.rst b/doc/source/users_guide/setting-up-and-running-a-case/history_fields_nofates.rst index 1eb450b0b6..95f2b976e8 100644 --- a/doc/source/users_guide/setting-up-and-running-a-case/history_fields_nofates.rst +++ b/doc/source/users_guide/setting-up-and-running-a-case/history_fields_nofates.rst @@ -8,1281 +8,1281 @@ use_cn = T use_crop = T use_fates = F -=================================== ============================================================================================== ================================================================= ======= +=================================== ================ ============================================================================================== ================================================================= ======= CTSM History Fields ------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------- - Variable Name Long Description Units Active? -=================================== ============================================================================================== ================================================================= ======= -A10TMIN 10-day running mean of min 2-m temperature K F -A5TMIN 5-day running mean of min 2-m temperature K F -ACTUAL_IMMOB actual N immobilization gN/m^2/s T -ACTUAL_IMMOB_NH4 immobilization of NH4 gN/m^3/s F -ACTUAL_IMMOB_NO3 immobilization of NO3 gN/m^3/s F -ACTUAL_IMMOB_vr actual N immobilization gN/m^3/s F -ACT_SOMC ACT_SOM C gC/m^2 T -ACT_SOMC_1m ACT_SOM C to 1 meter gC/m^2 F -ACT_SOMC_TNDNCY_VERT_TRA active soil organic C tendency due to vertical transport gC/m^3/s F -ACT_SOMC_TO_PAS_SOMC decomp. of active soil organic C to passive soil organic C gC/m^2/s F -ACT_SOMC_TO_PAS_SOMC_vr decomp. of active soil organic C to passive soil organic C gC/m^3/s F -ACT_SOMC_TO_SLO_SOMC decomp. of active soil organic C to slow soil organic ma C gC/m^2/s F -ACT_SOMC_TO_SLO_SOMC_vr decomp. of active soil organic C to slow soil organic ma C gC/m^3/s F -ACT_SOMC_vr ACT_SOM C (vertically resolved) gC/m^3 T -ACT_SOMN ACT_SOM N gN/m^2 T -ACT_SOMN_1m ACT_SOM N to 1 meter gN/m^2 F -ACT_SOMN_TNDNCY_VERT_TRA active soil organic N tendency due to vertical transport gN/m^3/s F -ACT_SOMN_TO_PAS_SOMN decomp. of active soil organic N to passive soil organic N gN/m^2 F -ACT_SOMN_TO_PAS_SOMN_vr decomp. of active soil organic N to passive soil organic N gN/m^3 F -ACT_SOMN_TO_SLO_SOMN decomp. of active soil organic N to slow soil organic ma N gN/m^2 F -ACT_SOMN_TO_SLO_SOMN_vr decomp. of active soil organic N to slow soil organic ma N gN/m^3 F -ACT_SOMN_vr ACT_SOM N (vertically resolved) gN/m^3 T -ACT_SOM_HR_S2 Het. Resp. from active soil organic gC/m^2/s F -ACT_SOM_HR_S2_vr Het. Resp. from active soil organic gC/m^3/s F -ACT_SOM_HR_S3 Het. Resp. from active soil organic gC/m^2/s F -ACT_SOM_HR_S3_vr Het. Resp. from active soil organic gC/m^3/s F -AGLB Aboveground leaf biomass kg/m^2 F -AGNPP aboveground NPP gC/m^2/s T -AGSB Aboveground stem biomass kg/m^2 F -ALBD surface albedo (direct) proportion F -ALBGRD ground albedo (direct) proportion F -ALBGRI ground albedo (indirect) proportion F -ALBI surface albedo (indirect) proportion F -ALPHA alpha coefficient for VOC calc non F -ALT current active layer thickness m T -ALTMAX maximum annual active layer thickness m T -ALTMAX_LASTYEAR maximum prior year active layer thickness m F -ANNAVG_T2M annual average 2m air temperature K F -ANNMAX_RETRANSN annual max of retranslocated N pool gN/m^2 F -ANNSUM_COUNTER seconds since last annual accumulator turnover s F -ANNSUM_NPP annual sum of NPP gC/m^2/yr F -ANNSUM_POTENTIAL_GPP annual sum of potential GPP gN/m^2/yr F -AR autotrophic respiration (MR + GR) gC/m^2/s T -ATM_O3 atmospheric ozone partial pressure mol/mol F -ATM_TOPO atmospheric surface height m T -AVAILC C flux available for allocation gC/m^2/s F -AVAIL_RETRANSN N flux available from retranslocation pool gN/m^2/s F -AnnET Annual ET mm/s F -BAF_CROP fractional area burned for crop s-1 T -BAF_PEATF fractional area burned in peatland s-1 T -BCDEP total BC deposition (dry+wet) from atmosphere kg/m^2/s T -BETA coefficient of convective velocity none F -BGLFR background litterfall rate 1/s F -BGNPP belowground NPP gC/m^2/s T -BGTR background transfer growth rate 1/s F -BTRANMN daily minimum of transpiration beta factor unitless T -CANNAVG_T2M annual average of 2m air temperature K F -CANNSUM_NPP annual sum of column-level NPP gC/m^2/s F -CEL_LITC CEL_LIT C gC/m^2 T -CEL_LITC_1m CEL_LIT C to 1 meter gC/m^2 F -CEL_LITC_TNDNCY_VERT_TRA cellulosic litter C tendency due to vertical transport gC/m^3/s F -CEL_LITC_TO_ACT_SOMC decomp. of cellulosic litter C to active soil organic C gC/m^2/s F -CEL_LITC_TO_ACT_SOMC_vr decomp. of cellulosic litter C to active soil organic C gC/m^3/s F -CEL_LITC_vr CEL_LIT C (vertically resolved) gC/m^3 T -CEL_LITN CEL_LIT N gN/m^2 T -CEL_LITN_1m CEL_LIT N to 1 meter gN/m^2 F -CEL_LITN_TNDNCY_VERT_TRA cellulosic litter N tendency due to vertical transport gN/m^3/s F -CEL_LITN_TO_ACT_SOMN decomp. of cellulosic litter N to active soil organic N gN/m^2 F -CEL_LITN_TO_ACT_SOMN_vr decomp. of cellulosic litter N to active soil organic N gN/m^3 F -CEL_LITN_vr CEL_LIT N (vertically resolved) gN/m^3 T -CEL_LIT_HR Het. Resp. from cellulosic litter gC/m^2/s F -CEL_LIT_HR_vr Het. Resp. from cellulosic litter gC/m^3/s F -CGRND deriv. of soil energy flux wrt to soil temp W/m^2/K F -CGRNDL deriv. of soil latent heat flux wrt soil temp W/m^2/K F -CGRNDS deriv. of soil sensible heat flux wrt soil temp W/m^2/K F -CH4PROD Gridcell total production of CH4 gC/m2/s T -CH4_EBUL_TOTAL_SAT ebullition surface CH4 flux; (+ to atm) mol/m2/s F -CH4_EBUL_TOTAL_UNSAT ebullition surface CH4 flux; (+ to atm) mol/m2/s F -CH4_SURF_AERE_SAT aerenchyma surface CH4 flux for inundated area; (+ to atm) mol/m2/s T -CH4_SURF_AERE_UNSAT aerenchyma surface CH4 flux for non-inundated area; (+ to atm) mol/m2/s T -CH4_SURF_DIFF_SAT diffusive surface CH4 flux for inundated / lake area; (+ to atm) mol/m2/s T -CH4_SURF_DIFF_UNSAT diffusive surface CH4 flux for non-inundated area; (+ to atm) mol/m2/s T -CH4_SURF_EBUL_SAT ebullition surface CH4 flux for inundated / lake area; (+ to atm) mol/m2/s T -CH4_SURF_EBUL_UNSAT ebullition surface CH4 flux for non-inundated area; (+ to atm) mol/m2/s T -COL_CTRUNC column-level sink for C truncation gC/m^2 F -COL_FIRE_CLOSS total column-level fire C loss for non-peat fires outside land-type converted region gC/m^2/s T -COL_FIRE_NLOSS total column-level fire N loss gN/m^2/s T -COL_NTRUNC column-level sink for N truncation gN/m^2 F -CONC_CH4_SAT CH4 soil Concentration for inundated / lake area mol/m3 F -CONC_CH4_UNSAT CH4 soil Concentration for non-inundated area mol/m3 F -CONC_O2_SAT O2 soil Concentration for inundated / lake area mol/m3 T -CONC_O2_UNSAT O2 soil Concentration for non-inundated area mol/m3 T -COST_NACTIVE Cost of active uptake gN/gC T -COST_NFIX Cost of fixation gN/gC T -COST_NRETRANS Cost of retranslocation gN/gC T -COSZEN cosine of solar zenith angle none F -CPHASE crop phenology phase 0-not planted, 1-planted, 2-leaf emerge, 3-grain fill, 4-harvest T -CPOOL temporary photosynthate C pool gC/m^2 T -CPOOL_DEADCROOT_GR dead coarse root growth respiration gC/m^2/s F -CPOOL_DEADCROOT_STORAGE_GR dead coarse root growth respiration to storage gC/m^2/s F -CPOOL_DEADSTEM_GR dead stem growth respiration gC/m^2/s F -CPOOL_DEADSTEM_STORAGE_GR dead stem growth respiration to storage gC/m^2/s F -CPOOL_FROOT_GR fine root growth respiration gC/m^2/s F -CPOOL_FROOT_STORAGE_GR fine root growth respiration to storage gC/m^2/s F -CPOOL_LEAF_GR leaf growth respiration gC/m^2/s F -CPOOL_LEAF_STORAGE_GR leaf growth respiration to storage gC/m^2/s F -CPOOL_LIVECROOT_GR live coarse root growth respiration gC/m^2/s F -CPOOL_LIVECROOT_STORAGE_GR live coarse root growth respiration to storage gC/m^2/s F -CPOOL_LIVESTEM_GR live stem growth respiration gC/m^2/s F -CPOOL_LIVESTEM_STORAGE_GR live stem growth respiration to storage gC/m^2/s F -CPOOL_TO_DEADCROOTC allocation to dead coarse root C gC/m^2/s F -CPOOL_TO_DEADCROOTC_STORAGE allocation to dead coarse root C storage gC/m^2/s F -CPOOL_TO_DEADSTEMC allocation to dead stem C gC/m^2/s F -CPOOL_TO_DEADSTEMC_STORAGE allocation to dead stem C storage gC/m^2/s F -CPOOL_TO_FROOTC allocation to fine root C gC/m^2/s F -CPOOL_TO_FROOTC_STORAGE allocation to fine root C storage gC/m^2/s F -CPOOL_TO_GRESP_STORAGE allocation to growth respiration storage gC/m^2/s F -CPOOL_TO_LEAFC allocation to leaf C gC/m^2/s F -CPOOL_TO_LEAFC_STORAGE allocation to leaf C storage gC/m^2/s F -CPOOL_TO_LIVECROOTC allocation to live coarse root C gC/m^2/s F -CPOOL_TO_LIVECROOTC_STORAGE allocation to live coarse root C storage gC/m^2/s F -CPOOL_TO_LIVESTEMC allocation to live stem C gC/m^2/s F -CPOOL_TO_LIVESTEMC_STORAGE allocation to live stem C storage gC/m^2/s F -CROOT_PROF profile for litter C and N inputs from coarse roots 1/m F -CROPPROD1C 1-yr crop product (grain+biofuel) C gC/m^2 T -CROPPROD1C_LOSS loss from 1-yr crop product pool gC/m^2/s T -CROPPROD1N 1-yr crop product (grain+biofuel) N gN/m^2 T -CROPPROD1N_LOSS loss from 1-yr crop product pool gN/m^2/s T -CROPSEEDC_DEFICIT C used for crop seed that needs to be repaid gC/m^2 T -CROPSEEDN_DEFICIT N used for crop seed that needs to be repaid gN/m^2 F -CROP_SEEDC_TO_LEAF crop seed source to leaf gC/m^2/s F -CROP_SEEDN_TO_LEAF crop seed source to leaf gN/m^2/s F -CURRENT_GR growth resp for new growth displayed in this timestep gC/m^2/s F -CWDC CWD C gC/m^2 T -CWDC_1m CWD C to 1 meter gC/m^2 F -CWDC_HR cwd C heterotrophic respiration gC/m^2/s T -CWDC_LOSS coarse woody debris C loss gC/m^2/s T -CWDC_TO_CEL_LITC decomp. of coarse woody debris C to cellulosic litter C gC/m^2/s F -CWDC_TO_CEL_LITC_vr decomp. of coarse woody debris C to cellulosic litter C gC/m^3/s F -CWDC_TO_LIG_LITC decomp. of coarse woody debris C to lignin litter C gC/m^2/s F -CWDC_TO_LIG_LITC_vr decomp. of coarse woody debris C to lignin litter C gC/m^3/s F -CWDC_vr CWD C (vertically resolved) gC/m^3 T -CWDN CWD N gN/m^2 T -CWDN_1m CWD N to 1 meter gN/m^2 F -CWDN_TO_CEL_LITN decomp. of coarse woody debris N to cellulosic litter N gN/m^2 F -CWDN_TO_CEL_LITN_vr decomp. of coarse woody debris N to cellulosic litter N gN/m^3 F -CWDN_TO_LIG_LITN decomp. of coarse woody debris N to lignin litter N gN/m^2 F -CWDN_TO_LIG_LITN_vr decomp. of coarse woody debris N to lignin litter N gN/m^3 F -CWDN_vr CWD N (vertically resolved) gN/m^3 T -CWD_HR_L2 Het. Resp. from coarse woody debris gC/m^2/s F -CWD_HR_L2_vr Het. Resp. from coarse woody debris gC/m^3/s F -CWD_HR_L3 Het. Resp. from coarse woody debris gC/m^2/s F -CWD_HR_L3_vr Het. Resp. from coarse woody debris gC/m^3/s F -CWD_PATHFRAC_L2_vr PATHFRAC from coarse woody debris to cellulosic litter fraction F -CWD_PATHFRAC_L3_vr PATHFRAC from coarse woody debris to lignin litter fraction F -CWD_RESP_FRAC_L2_vr respired from coarse woody debris to cellulosic litter fraction F -CWD_RESP_FRAC_L3_vr respired from coarse woody debris to lignin litter fraction F -C_ALLOMETRY C allocation index none F -DAYL daylength s F -DAYS_ACTIVE number of days since last dormancy days F -DEADCROOTC dead coarse root C gC/m^2 T -DEADCROOTC_STORAGE dead coarse root C storage gC/m^2 F -DEADCROOTC_STORAGE_TO_XFER dead coarse root C shift storage to transfer gC/m^2/s F -DEADCROOTC_XFER dead coarse root C transfer gC/m^2 F -DEADCROOTC_XFER_TO_DEADCROOTC dead coarse root C growth from storage gC/m^2/s F -DEADCROOTN dead coarse root N gN/m^2 T -DEADCROOTN_STORAGE dead coarse root N storage gN/m^2 F -DEADCROOTN_STORAGE_TO_XFER dead coarse root N shift storage to transfer gN/m^2/s F -DEADCROOTN_XFER dead coarse root N transfer gN/m^2 F -DEADCROOTN_XFER_TO_DEADCROOTN dead coarse root N growth from storage gN/m^2/s F -DEADSTEMC dead stem C gC/m^2 T -DEADSTEMC_STORAGE dead stem C storage gC/m^2 F -DEADSTEMC_STORAGE_TO_XFER dead stem C shift storage to transfer gC/m^2/s F -DEADSTEMC_XFER dead stem C transfer gC/m^2 F -DEADSTEMC_XFER_TO_DEADSTEMC dead stem C growth from storage gC/m^2/s F -DEADSTEMN dead stem N gN/m^2 T -DEADSTEMN_STORAGE dead stem N storage gN/m^2 F -DEADSTEMN_STORAGE_TO_XFER dead stem N shift storage to transfer gN/m^2/s F -DEADSTEMN_XFER dead stem N transfer gN/m^2 F -DEADSTEMN_XFER_TO_DEADSTEMN dead stem N growth from storage gN/m^2/s F -DENIT total rate of denitrification gN/m^2/s T -DGNETDT derivative of net ground heat flux wrt soil temp W/m^2/K F -DISPLA displacement height (vegetated landunits only) m F -DISPVEGC displayed veg carbon, excluding storage and cpool gC/m^2 T -DISPVEGN displayed vegetation nitrogen gN/m^2 T -DLRAD downward longwave radiation below the canopy W/m^2 F -DORMANT_FLAG dormancy flag none F -DOWNREG fractional reduction in GPP due to N limitation proportion F -DPVLTRB1 turbulent deposition velocity 1 m/s F -DPVLTRB2 turbulent deposition velocity 2 m/s F -DPVLTRB3 turbulent deposition velocity 3 m/s F -DPVLTRB4 turbulent deposition velocity 4 m/s F -DSL dry surface layer thickness mm T -DSTDEP total dust deposition (dry+wet) from atmosphere kg/m^2/s T -DSTFLXT total surface dust emission kg/m2/s T -DT_VEG change in t_veg, last iteration K F -DWT_CONV_CFLUX conversion C flux (immediate loss to atm) (0 at all times except first timestep of year) gC/m^2/s T -DWT_CONV_CFLUX_DRIBBLED conversion C flux (immediate loss to atm), dribbled throughout the year gC/m^2/s T -DWT_CONV_CFLUX_PATCH patch-level conversion C flux (immediate loss to atm) (0 at all times except first timestep of gC/m^2/s F -DWT_CONV_NFLUX conversion N flux (immediate loss to atm) (0 at all times except first timestep of year) gN/m^2/s T -DWT_CONV_NFLUX_PATCH patch-level conversion N flux (immediate loss to atm) (0 at all times except first timestep of gN/m^2/s F -DWT_CROPPROD1C_GAIN landcover change-driven addition to 1-year crop product pool gC/m^2/s T -DWT_CROPPROD1N_GAIN landcover change-driven addition to 1-year crop product pool gN/m^2/s T -DWT_DEADCROOTC_TO_CWDC dead coarse root to CWD due to landcover change gC/m^2/s F -DWT_DEADCROOTN_TO_CWDN dead coarse root to CWD due to landcover change gN/m^2/s F -DWT_FROOTC_TO_CEL_LIT_C fine root to cellulosic litter due to landcover change gC/m^2/s F -DWT_FROOTC_TO_LIG_LIT_C fine root to lignin litter due to landcover change gC/m^2/s F -DWT_FROOTC_TO_MET_LIT_C fine root to metabolic litter due to landcover change gC/m^2/s F -DWT_FROOTN_TO_CEL_LIT_N fine root N to cellulosic litter due to landcover change gN/m^2/s F -DWT_FROOTN_TO_LIG_LIT_N fine root N to lignin litter due to landcover change gN/m^2/s F -DWT_FROOTN_TO_MET_LIT_N fine root N to metabolic litter due to landcover change gN/m^2/s F -DWT_LIVECROOTC_TO_CWDC live coarse root to CWD due to landcover change gC/m^2/s F -DWT_LIVECROOTN_TO_CWDN live coarse root to CWD due to landcover change gN/m^2/s F -DWT_PROD100C_GAIN landcover change-driven addition to 100-yr wood product pool gC/m^2/s F -DWT_PROD100N_GAIN landcover change-driven addition to 100-yr wood product pool gN/m^2/s F -DWT_PROD10C_GAIN landcover change-driven addition to 10-yr wood product pool gC/m^2/s F -DWT_PROD10N_GAIN landcover change-driven addition to 10-yr wood product pool gN/m^2/s F -DWT_SEEDC_TO_DEADSTEM seed source to patch-level deadstem gC/m^2/s F -DWT_SEEDC_TO_DEADSTEM_PATCH patch-level seed source to patch-level deadstem (per-area-gridcell; only makes sense with dov2 gC/m^2/s F -DWT_SEEDC_TO_LEAF seed source to patch-level leaf gC/m^2/s F -DWT_SEEDC_TO_LEAF_PATCH patch-level seed source to patch-level leaf (per-area-gridcell; only makes sense with dov2xy=. gC/m^2/s F -DWT_SEEDN_TO_DEADSTEM seed source to patch-level deadstem gN/m^2/s T -DWT_SEEDN_TO_DEADSTEM_PATCH patch-level seed source to patch-level deadstem (per-area-gridcell; only makes sense with dov2 gN/m^2/s F -DWT_SEEDN_TO_LEAF seed source to patch-level leaf gN/m^2/s T -DWT_SEEDN_TO_LEAF_PATCH patch-level seed source to patch-level leaf (per-area-gridcell; only makes sense with dov2xy=. gN/m^2/s F -DWT_SLASH_CFLUX slash C flux (to litter diagnostic only) (0 at all times except first timestep of year) gC/m^2/s T -DWT_SLASH_CFLUX_PATCH patch-level slash C flux (to litter diagnostic only) (0 at all times except first timestep of gC/m^2/s F -DWT_WOODPRODC_GAIN landcover change-driven addition to wood product pools gC/m^2/s T -DWT_WOODPRODN_GAIN landcover change-driven addition to wood product pools gN/m^2/s T -DWT_WOOD_PRODUCTC_GAIN_PATCH patch-level landcover change-driven addition to wood product pools(0 at all times except first gC/m^2/s F -DYN_COL_ADJUSTMENTS_CH4 Adjustments in ch4 due to dynamic column areas; only makes sense at the column level: should n gC/m^2 F -DYN_COL_SOIL_ADJUSTMENTS_C Adjustments in soil carbon due to dynamic column areas; only makes sense at the column level: gC/m^2 F -DYN_COL_SOIL_ADJUSTMENTS_N Adjustments in soil nitrogen due to dynamic column areas; only makes sense at the column level gN/m^2 F -DYN_COL_SOIL_ADJUSTMENTS_NH4 Adjustments in soil NH4 due to dynamic column areas; only makes sense at the column level: sho gN/m^2 F -DYN_COL_SOIL_ADJUSTMENTS_NO3 Adjustments in soil NO3 due to dynamic column areas; only makes sense at the column level: sho gN/m^2 F -EFF_POROSITY effective porosity = porosity - vol_ice proportion F -EFLXBUILD building heat flux from change in interior building air temperature W/m^2 T -EFLX_DYNBAL dynamic land cover change conversion energy flux W/m^2 T -EFLX_GNET net heat flux into ground W/m^2 F -EFLX_GRND_LAKE net heat flux into lake/snow surface, excluding light transmission W/m^2 T -EFLX_LH_TOT total latent heat flux [+ to atm] W/m^2 T -EFLX_LH_TOT_ICE total latent heat flux [+ to atm] (ice landunits only) W/m^2 F -EFLX_LH_TOT_R Rural total evaporation W/m^2 T -EFLX_LH_TOT_U Urban total evaporation W/m^2 F -EFLX_SOIL_GRND soil heat flux [+ into soil] W/m^2 F -ELAI exposed one-sided leaf area index m^2/m^2 T -EMG ground emissivity proportion F -EMV vegetation emissivity proportion F -EOPT Eopt coefficient for VOC calc non F -ER total ecosystem respiration, autotrophic + heterotrophic gC/m^2/s T -ERRH2O total water conservation error mm T -ERRH2OSNO imbalance in snow depth (liquid water) mm T -ERRSEB surface energy conservation error W/m^2 T -ERRSOI soil/lake energy conservation error W/m^2 T -ERRSOL solar radiation conservation error W/m^2 T -ESAI exposed one-sided stem area index m^2/m^2 T -EXCESSC_MR excess C maintenance respiration gC/m^2/s F -EXCESS_CFLUX C flux not allocated due to downregulation gC/m^2/s F -FAREA_BURNED timestep fractional area burned s-1 T -FCANSNO fraction of canopy that is wet proportion F -FCEV canopy evaporation W/m^2 T -FCH4 Gridcell surface CH4 flux to atmosphere (+ to atm) kgC/m2/s T -FCH4TOCO2 Gridcell oxidation of CH4 to CO2 gC/m2/s T -FCH4_DFSAT CH4 additional flux due to changing fsat, natural vegetated and crop landunits only kgC/m2/s T -FCO2 CO2 flux to atmosphere (+ to atm) kgCO2/m2/s F -FCOV fractional impermeable area unitless T -FCTR canopy transpiration W/m^2 T -FDRY fraction of foliage that is green and dry proportion F -FERTNITRO Nitrogen fertilizer for each crop gN/m2/yr F -FERT_COUNTER time left to fertilize seconds F -FERT_TO_SMINN fertilizer to soil mineral N gN/m^2/s F -FFIX_TO_SMINN free living N fixation to soil mineral N gN/m^2/s T -FGEV ground evaporation W/m^2 T -FGR heat flux into soil/snow including snow melt and lake / snow light transmission W/m^2 T -FGR12 heat flux between soil layers 1 and 2 W/m^2 T -FGR_ICE heat flux into soil/snow including snow melt and lake / snow light transmission (ice landunits W/m^2 F -FGR_R Rural heat flux into soil/snow including snow melt and snow light transmission W/m^2 F -FGR_SOIL_R Rural downward heat flux at interface below each soil layer watt/m^2 F -FGR_U Urban heat flux into soil/snow including snow melt W/m^2 F -FH2OSFC fraction of ground covered by surface water unitless T -FH2OSFC_NOSNOW fraction of ground covered by surface water (if no snow present) unitless F -FINUNDATED fractional inundated area of vegetated columns unitless T -FINUNDATED_LAG time-lagged inundated fraction of vegetated columns unitless F -FIRA net infrared (longwave) radiation W/m^2 T -FIRA_ICE net infrared (longwave) radiation (ice landunits only) W/m^2 F -FIRA_R Rural net infrared (longwave) radiation W/m^2 T -FIRA_U Urban net infrared (longwave) radiation W/m^2 F -FIRE emitted infrared (longwave) radiation W/m^2 T -FIRE_ICE emitted infrared (longwave) radiation (ice landunits only) W/m^2 F -FIRE_R Rural emitted infrared (longwave) radiation W/m^2 T -FIRE_U Urban emitted infrared (longwave) radiation W/m^2 F -FLDS atmospheric longwave radiation (downscaled to columns in glacier regions) W/m^2 T -FLDS_ICE atmospheric longwave radiation (downscaled to columns in glacier regions) (ice landunits only) W/m^2 F -FMAX_DENIT_CARBONSUBSTRATE FMAX_DENIT_CARBONSUBSTRATE gN/m^3/s F -FMAX_DENIT_NITRATE FMAX_DENIT_NITRATE gN/m^3/s F -FPI fraction of potential immobilization proportion T -FPI_vr fraction of potential immobilization proportion F -FPSN photosynthesis umol m-2 s-1 T -FPSN24 24 hour accumulative patch photosynthesis starting from mid-night umol CO2/m^2 ground/day F -FPSN_WC Rubisco-limited photosynthesis umol m-2 s-1 F -FPSN_WJ RuBP-limited photosynthesis umol m-2 s-1 F -FPSN_WP Product-limited photosynthesis umol m-2 s-1 F -FRAC_ICEOLD fraction of ice relative to the tot water proportion F -FREE_RETRANSN_TO_NPOOL deployment of retranslocated N gN/m^2/s T -FROOTC fine root C gC/m^2 T -FROOTC_ALLOC fine root C allocation gC/m^2/s T -FROOTC_LOSS fine root C loss gC/m^2/s T -FROOTC_STORAGE fine root C storage gC/m^2 F -FROOTC_STORAGE_TO_XFER fine root C shift storage to transfer gC/m^2/s F -FROOTC_TO_LITTER fine root C litterfall gC/m^2/s F -FROOTC_XFER fine root C transfer gC/m^2 F -FROOTC_XFER_TO_FROOTC fine root C growth from storage gC/m^2/s F -FROOTN fine root N gN/m^2 T -FROOTN_STORAGE fine root N storage gN/m^2 F -FROOTN_STORAGE_TO_XFER fine root N shift storage to transfer gN/m^2/s F -FROOTN_TO_LITTER fine root N litterfall gN/m^2/s F -FROOTN_XFER fine root N transfer gN/m^2 F -FROOTN_XFER_TO_FROOTN fine root N growth from storage gN/m^2/s F -FROOT_MR fine root maintenance respiration gC/m^2/s F -FROOT_PROF profile for litter C and N inputs from fine roots 1/m F -FROST_TABLE frost table depth (natural vegetated and crop landunits only) m F -FSA absorbed solar radiation W/m^2 T -FSAT fractional area with water table at surface unitless T -FSA_ICE absorbed solar radiation (ice landunits only) W/m^2 F -FSA_R Rural absorbed solar radiation W/m^2 F -FSA_U Urban absorbed solar radiation W/m^2 F -FSD24 direct radiation (last 24hrs) K F -FSD240 direct radiation (last 240hrs) K F -FSDS atmospheric incident solar radiation W/m^2 T -FSDSND direct nir incident solar radiation W/m^2 T -FSDSNDLN direct nir incident solar radiation at local noon W/m^2 T -FSDSNI diffuse nir incident solar radiation W/m^2 T -FSDSVD direct vis incident solar radiation W/m^2 T -FSDSVDLN direct vis incident solar radiation at local noon W/m^2 T -FSDSVI diffuse vis incident solar radiation W/m^2 T -FSDSVILN diffuse vis incident solar radiation at local noon W/m^2 T -FSH sensible heat not including correction for land use change and rain/snow conversion W/m^2 T -FSH_G sensible heat from ground W/m^2 T -FSH_ICE sensible heat not including correction for land use change and rain/snow conversion (ice landu W/m^2 F -FSH_PRECIP_CONVERSION Sensible heat flux from conversion of rain/snow atm forcing W/m^2 T -FSH_R Rural sensible heat W/m^2 T -FSH_RUNOFF_ICE_TO_LIQ sensible heat flux generated from conversion of ice runoff to liquid W/m^2 T -FSH_TO_COUPLER sensible heat sent to coupler (includes corrections for land use change, rain/snow conversion W/m^2 T -FSH_U Urban sensible heat W/m^2 F -FSH_V sensible heat from veg W/m^2 T -FSI24 indirect radiation (last 24hrs) K F -FSI240 indirect radiation (last 240hrs) K F -FSM snow melt heat flux W/m^2 T -FSM_ICE snow melt heat flux (ice landunits only) W/m^2 F -FSM_R Rural snow melt heat flux W/m^2 F -FSM_U Urban snow melt heat flux W/m^2 F -FSNO fraction of ground covered by snow unitless T -FSNO_EFF effective fraction of ground covered by snow unitless T -FSNO_ICE fraction of ground covered by snow (ice landunits only) unitless F -FSR reflected solar radiation W/m^2 T -FSRND direct nir reflected solar radiation W/m^2 T -FSRNDLN direct nir reflected solar radiation at local noon W/m^2 T -FSRNI diffuse nir reflected solar radiation W/m^2 T -FSRVD direct vis reflected solar radiation W/m^2 T -FSRVDLN direct vis reflected solar radiation at local noon W/m^2 T -FSRVI diffuse vis reflected solar radiation W/m^2 T -FSR_ICE reflected solar radiation (ice landunits only) W/m^2 F -FSUN sunlit fraction of canopy proportion F -FSUN24 fraction sunlit (last 24hrs) K F -FSUN240 fraction sunlit (last 240hrs) K F -FUELC fuel load gC/m^2 T -FV friction velocity m/s T -FWET fraction of canopy that is wet proportion F -F_DENIT denitrification flux gN/m^2/s T -F_DENIT_BASE F_DENIT_BASE gN/m^3/s F -F_DENIT_vr denitrification flux gN/m^3/s F -F_N2O_DENIT denitrification N2O flux gN/m^2/s T -F_N2O_NIT nitrification N2O flux gN/m^2/s T -F_NIT nitrification flux gN/m^2/s T -F_NIT_vr nitrification flux gN/m^3/s F -GAMMA total gamma for VOC calc non F -GAMMAA gamma A for VOC calc non F -GAMMAC gamma C for VOC calc non F -GAMMAL gamma L for VOC calc non F -GAMMAP gamma P for VOC calc non F -GAMMAS gamma S for VOC calc non F -GAMMAT gamma T for VOC calc non F -GDD0 Growing degree days base 0C from planting ddays F -GDD020 Twenty year average of growing degree days base 0C from planting ddays F -GDD10 Growing degree days base 10C from planting ddays F -GDD1020 Twenty year average of growing degree days base 10C from planting ddays F -GDD8 Growing degree days base 8C from planting ddays F -GDD820 Twenty year average of growing degree days base 8C from planting ddays F -GDDACCUM Accumulated growing degree days past planting date for crop ddays F -GDDACCUM_PERHARV At-harvest accumulated growing degree days past planting date for crop; should only be output ddays F -GDDHARV Growing degree days (gdd) needed to harvest ddays F -GDDHARV_PERHARV Growing degree days (gdd) needed to harvest; should only be output annually ddays F -GDDTSOI Growing degree-days from planting (top two soil layers) ddays F -GPP gross primary production gC/m^2/s T -GR total growth respiration gC/m^2/s T -GRAINC grain C (does not equal yield) gC/m^2 T -GRAINC_TO_FOOD grain C to food gC/m^2/s T -GRAINC_TO_FOOD_ANN grain C to food harvested per calendar year; should only be output annually gC/m^2 F -GRAINC_TO_FOOD_PERHARV grain C to food per harvest; should only be output annually gC/m^2 F -GRAINC_TO_SEED grain C to seed gC/m^2/s T -GRAINN grain N gN/m^2 T -GRESP_STORAGE growth respiration storage gC/m^2 F -GRESP_STORAGE_TO_XFER growth respiration shift storage to transfer gC/m^2/s F -GRESP_XFER growth respiration transfer gC/m^2 F -GROSS_NMIN gross rate of N mineralization gN/m^2/s T -GROSS_NMIN_vr gross rate of N mineralization gN/m^3/s F -GRU_PROD100C_GAIN gross unrepresented landcover change addition to 100-yr wood product pool gC/m^2/s F -GRU_PROD100N_GAIN gross unrepresented landcover change addition to 100-yr wood product pool gN/m^2/s F -GRU_PROD10C_GAIN gross unrepresented landcover change addition to 10-yr wood product pool gC/m^2/s F -GRU_PROD10N_GAIN gross unrepresented landcover change addition to 10-yr wood product pool gN/m^2/s F -GSSHA shaded leaf stomatal conductance umol H20/m2/s T -GSSHALN shaded leaf stomatal conductance at local noon umol H20/m2/s T -GSSUN sunlit leaf stomatal conductance umol H20/m2/s T -GSSUNLN sunlit leaf stomatal conductance at local noon umol H20/m2/s T -H2OCAN intercepted water mm T -H2OSFC surface water depth mm T -H2OSNO snow depth (liquid water) mm T -H2OSNO_ICE snow depth (liquid water, ice landunits only) mm F -H2OSNO_TOP mass of snow in top snow layer kg/m2 T -H2OSOI volumetric soil water (natural vegetated and crop landunits only) mm3/mm3 T -HARVEST_REASON_PERHARV Reason for each crop harvest; should only be output annually 1 = mature; 2 = max season length; 3 = incorrect Dec. 31 sowing; F -HBOT canopy bottom m F -HDATES actual crop harvest dates; should only be output annually day of year F -HEAT_CONTENT1 initial gridcell total heat content J/m^2 T -HEAT_CONTENT1_VEG initial gridcell total heat content - natural vegetated and crop landunits only J/m^2 F -HEAT_CONTENT2 post land cover change total heat content J/m^2 F -HEAT_FROM_AC sensible heat flux put into canyon due to heat removed from air conditioning W/m^2 T -HIA 2 m NWS Heat Index C T -HIA_R Rural 2 m NWS Heat Index C T -HIA_U Urban 2 m NWS Heat Index C T -HK hydraulic conductivity (natural vegetated and crop landunits only) mm/s F -HR total heterotrophic respiration gC/m^2/s T -HR_vr total vertically resolved heterotrophic respiration gC/m^3/s T -HTOP canopy top m T -HUI Crop patch heat unit index ddays F -HUI_PERHARV At-harvest accumulated heat unit index for crop; should only be output annually ddays F -HUMIDEX 2 m Humidex C T -HUMIDEX_R Rural 2 m Humidex C T -HUMIDEX_U Urban 2 m Humidex C T -ICE_CONTENT1 initial gridcell total ice content mm T -ICE_CONTENT2 post land cover change total ice content mm F -ICE_MODEL_FRACTION Ice sheet model fractional coverage unitless F -INIT_GPP GPP flux before downregulation gC/m^2/s F -INT_SNOW accumulated swe (natural vegetated and crop landunits only) mm F -INT_SNOW_ICE accumulated swe (ice landunits only) mm F -IWUELN local noon intrinsic water use efficiency umolCO2/molH2O T -JMX25T canopy profile of jmax umol/m2/s T -Jmx25Z maximum rate of electron transport at 25 Celcius for canopy layers umol electrons/m2/s T -KROOT root conductance each soil layer 1/s F -KSOIL soil conductance in each soil layer 1/s F -K_ACT_SOM active soil organic potential loss coefficient 1/s F -K_CEL_LIT cellulosic litter potential loss coefficient 1/s F -K_CWD coarse woody debris potential loss coefficient 1/s F -K_LIG_LIT lignin litter potential loss coefficient 1/s F -K_MET_LIT metabolic litter potential loss coefficient 1/s F -K_NITR K_NITR 1/s F -K_NITR_H2O K_NITR_H2O unitless F -K_NITR_PH K_NITR_PH unitless F -K_NITR_T K_NITR_T unitless F -K_PAS_SOM passive soil organic potential loss coefficient 1/s F -K_SLO_SOM slow soil organic ma potential loss coefficient 1/s F -L1_PATHFRAC_S1_vr PATHFRAC from metabolic litter to active soil organic fraction F -L1_RESP_FRAC_S1_vr respired from metabolic litter to active soil organic fraction F -L2_PATHFRAC_S1_vr PATHFRAC from cellulosic litter to active soil organic fraction F -L2_RESP_FRAC_S1_vr respired from cellulosic litter to active soil organic fraction F -L3_PATHFRAC_S2_vr PATHFRAC from lignin litter to slow soil organic ma fraction F -L3_RESP_FRAC_S2_vr respired from lignin litter to slow soil organic ma fraction F -LAI240 240hr average of leaf area index m^2/m^2 F -LAISHA shaded projected leaf area index m^2/m^2 T -LAISUN sunlit projected leaf area index m^2/m^2 T -LAKEICEFRAC lake layer ice mass fraction unitless F -LAKEICEFRAC_SURF surface lake layer ice mass fraction unitless T -LAKEICETHICK thickness of lake ice (including physical expansion on freezing) m T -LAND_USE_FLUX total C emitted from land cover conversion (smoothed over the year) and wood and grain product gC/m^2/s T -LATBASET latitude vary base temperature for hui degree C F -LEAFC leaf C gC/m^2 T -LEAFCN Leaf CN ratio used for flexible CN gC/gN T -LEAFCN_OFFSET Leaf C:N used by FUN unitless F -LEAFCN_STORAGE Storage Leaf CN ratio used for flexible CN gC/gN F -LEAFC_ALLOC leaf C allocation gC/m^2/s T -LEAFC_CHANGE C change in leaf gC/m^2/s T -LEAFC_LOSS leaf C loss gC/m^2/s T -LEAFC_STORAGE leaf C storage gC/m^2 F -LEAFC_STORAGE_TO_XFER leaf C shift storage to transfer gC/m^2/s F -LEAFC_STORAGE_XFER_ACC Accumulated leaf C transfer gC/m^2 F -LEAFC_TO_BIOFUELC leaf C to biofuel C gC/m^2/s T -LEAFC_TO_LITTER leaf C litterfall gC/m^2/s F -LEAFC_TO_LITTER_FUN leaf C litterfall used by FUN gC/m^2/s T -LEAFC_XFER leaf C transfer gC/m^2 F -LEAFC_XFER_TO_LEAFC leaf C growth from storage gC/m^2/s F -LEAFN leaf N gN/m^2 T -LEAFN_STORAGE leaf N storage gN/m^2 F -LEAFN_STORAGE_TO_XFER leaf N shift storage to transfer gN/m^2/s F -LEAFN_STORAGE_XFER_ACC Accmulated leaf N transfer gN/m^2 F -LEAFN_TO_LITTER leaf N litterfall gN/m^2/s T -LEAFN_TO_RETRANSN leaf N to retranslocated N pool gN/m^2/s F -LEAFN_XFER leaf N transfer gN/m^2 F -LEAFN_XFER_TO_LEAFN leaf N growth from storage gN/m^2/s F -LEAF_MR leaf maintenance respiration gC/m^2/s T -LEAF_PROF profile for litter C and N inputs from leaves 1/m F -LFC2 conversion area fraction of BET and BDT that burned per sec T -LGSF long growing season factor proportion F -LIG_LITC LIG_LIT C gC/m^2 T -LIG_LITC_1m LIG_LIT C to 1 meter gC/m^2 F -LIG_LITC_TNDNCY_VERT_TRA lignin litter C tendency due to vertical transport gC/m^3/s F -LIG_LITC_TO_SLO_SOMC decomp. of lignin litter C to slow soil organic ma C gC/m^2/s F -LIG_LITC_TO_SLO_SOMC_vr decomp. of lignin litter C to slow soil organic ma C gC/m^3/s F -LIG_LITC_vr LIG_LIT C (vertically resolved) gC/m^3 T -LIG_LITN LIG_LIT N gN/m^2 T -LIG_LITN_1m LIG_LIT N to 1 meter gN/m^2 F -LIG_LITN_TNDNCY_VERT_TRA lignin litter N tendency due to vertical transport gN/m^3/s F -LIG_LITN_TO_SLO_SOMN decomp. of lignin litter N to slow soil organic ma N gN/m^2 F -LIG_LITN_TO_SLO_SOMN_vr decomp. of lignin litter N to slow soil organic ma N gN/m^3 F -LIG_LITN_vr LIG_LIT N (vertically resolved) gN/m^3 T -LIG_LIT_HR Het. Resp. from lignin litter gC/m^2/s F -LIG_LIT_HR_vr Het. Resp. from lignin litter gC/m^3/s F -LIQCAN intercepted liquid water mm T -LIQUID_CONTENT1 initial gridcell total liq content mm T -LIQUID_CONTENT2 post landuse change gridcell total liq content mm F -LIQUID_WATER_TEMP1 initial gridcell weighted average liquid water temperature K F -LITFALL litterfall (leaves and fine roots) gC/m^2/s T -LITFIRE litter fire losses gC/m^2/s F -LITTERC_HR litter C heterotrophic respiration gC/m^2/s T -LITTERC_LOSS litter C loss gC/m^2/s T -LIVECROOTC live coarse root C gC/m^2 T -LIVECROOTC_STORAGE live coarse root C storage gC/m^2 F -LIVECROOTC_STORAGE_TO_XFER live coarse root C shift storage to transfer gC/m^2/s F -LIVECROOTC_TO_DEADCROOTC live coarse root C turnover gC/m^2/s F -LIVECROOTC_XFER live coarse root C transfer gC/m^2 F -LIVECROOTC_XFER_TO_LIVECROOTC live coarse root C growth from storage gC/m^2/s F -LIVECROOTN live coarse root N gN/m^2 T -LIVECROOTN_STORAGE live coarse root N storage gN/m^2 F -LIVECROOTN_STORAGE_TO_XFER live coarse root N shift storage to transfer gN/m^2/s F -LIVECROOTN_TO_DEADCROOTN live coarse root N turnover gN/m^2/s F -LIVECROOTN_TO_RETRANSN live coarse root N to retranslocated N pool gN/m^2/s F -LIVECROOTN_XFER live coarse root N transfer gN/m^2 F -LIVECROOTN_XFER_TO_LIVECROOTN live coarse root N growth from storage gN/m^2/s F -LIVECROOT_MR live coarse root maintenance respiration gC/m^2/s F -LIVESTEMC live stem C gC/m^2 T -LIVESTEMC_STORAGE live stem C storage gC/m^2 F -LIVESTEMC_STORAGE_TO_XFER live stem C shift storage to transfer gC/m^2/s F -LIVESTEMC_TO_BIOFUELC livestem C to biofuel C gC/m^2/s T -LIVESTEMC_TO_DEADSTEMC live stem C turnover gC/m^2/s F -LIVESTEMC_XFER live stem C transfer gC/m^2 F -LIVESTEMC_XFER_TO_LIVESTEMC live stem C growth from storage gC/m^2/s F -LIVESTEMN live stem N gN/m^2 T -LIVESTEMN_STORAGE live stem N storage gN/m^2 F -LIVESTEMN_STORAGE_TO_XFER live stem N shift storage to transfer gN/m^2/s F -LIVESTEMN_TO_DEADSTEMN live stem N turnover gN/m^2/s F -LIVESTEMN_TO_RETRANSN live stem N to retranslocated N pool gN/m^2/s F -LIVESTEMN_XFER live stem N transfer gN/m^2 F -LIVESTEMN_XFER_TO_LIVESTEMN live stem N growth from storage gN/m^2/s F -LIVESTEM_MR live stem maintenance respiration gC/m^2/s F -LNC leaf N concentration gN leaf/m^2 T -LWdown atmospheric longwave radiation (downscaled to columns in glacier regions) W/m^2 F -LWup upwelling longwave radiation W/m^2 F -MEG_acetaldehyde MEGAN flux kg/m2/sec T -MEG_acetic_acid MEGAN flux kg/m2/sec T -MEG_acetone MEGAN flux kg/m2/sec T -MEG_carene_3 MEGAN flux kg/m2/sec T -MEG_ethanol MEGAN flux kg/m2/sec T -MEG_formaldehyde MEGAN flux kg/m2/sec T -MEG_isoprene MEGAN flux kg/m2/sec T -MEG_methanol MEGAN flux kg/m2/sec T -MEG_pinene_a MEGAN flux kg/m2/sec T -MEG_thujene_a MEGAN flux kg/m2/sec T -MET_LITC MET_LIT C gC/m^2 T -MET_LITC_1m MET_LIT C to 1 meter gC/m^2 F -MET_LITC_TNDNCY_VERT_TRA metabolic litter C tendency due to vertical transport gC/m^3/s F -MET_LITC_TO_ACT_SOMC decomp. of metabolic litter C to active soil organic C gC/m^2/s F -MET_LITC_TO_ACT_SOMC_vr decomp. of metabolic litter C to active soil organic C gC/m^3/s F -MET_LITC_vr MET_LIT C (vertically resolved) gC/m^3 T -MET_LITN MET_LIT N gN/m^2 T -MET_LITN_1m MET_LIT N to 1 meter gN/m^2 F -MET_LITN_TNDNCY_VERT_TRA metabolic litter N tendency due to vertical transport gN/m^3/s F -MET_LITN_TO_ACT_SOMN decomp. of metabolic litter N to active soil organic N gN/m^2 F -MET_LITN_TO_ACT_SOMN_vr decomp. of metabolic litter N to active soil organic N gN/m^3 F -MET_LITN_vr MET_LIT N (vertically resolved) gN/m^3 T -MET_LIT_HR Het. Resp. from metabolic litter gC/m^2/s F -MET_LIT_HR_vr Het. Resp. from metabolic litter gC/m^3/s F -MR maintenance respiration gC/m^2/s T -M_ACT_SOMC_TO_LEACHING active soil organic C leaching loss gC/m^2/s F -M_ACT_SOMN_TO_LEACHING active soil organic N leaching loss gN/m^2/s F -M_CEL_LITC_TO_FIRE cellulosic litter C fire loss gC/m^2/s F -M_CEL_LITC_TO_FIRE_vr cellulosic litter C fire loss gC/m^3/s F -M_CEL_LITC_TO_LEACHING cellulosic litter C leaching loss gC/m^2/s F -M_CEL_LITN_TO_FIRE cellulosic litter N fire loss gN/m^2 F -M_CEL_LITN_TO_FIRE_vr cellulosic litter N fire loss gN/m^3 F -M_CEL_LITN_TO_LEACHING cellulosic litter N leaching loss gN/m^2/s F -M_CWDC_TO_FIRE coarse woody debris C fire loss gC/m^2/s F -M_CWDC_TO_FIRE_vr coarse woody debris C fire loss gC/m^3/s F -M_CWDN_TO_FIRE coarse woody debris N fire loss gN/m^2 F -M_CWDN_TO_FIRE_vr coarse woody debris N fire loss gN/m^3 F -M_DEADCROOTC_STORAGE_TO_LITTER dead coarse root C storage mortality gC/m^2/s F -M_DEADCROOTC_STORAGE_TO_LITTER_FIRE dead coarse root C storage fire mortality to litter gC/m^2/s F -M_DEADCROOTC_TO_LITTER dead coarse root C mortality gC/m^2/s F -M_DEADCROOTC_XFER_TO_LITTER dead coarse root C transfer mortality gC/m^2/s F -M_DEADCROOTN_STORAGE_TO_FIRE dead coarse root N storage fire loss gN/m^2/s F -M_DEADCROOTN_STORAGE_TO_LITTER dead coarse root N storage mortality gN/m^2/s F -M_DEADCROOTN_TO_FIRE dead coarse root N fire loss gN/m^2/s F -M_DEADCROOTN_TO_LITTER dead coarse root N mortality gN/m^2/s F -M_DEADCROOTN_TO_LITTER_FIRE dead coarse root N fire mortality to litter gN/m^2/s F -M_DEADCROOTN_XFER_TO_FIRE dead coarse root N transfer fire loss gN/m^2/s F -M_DEADCROOTN_XFER_TO_LITTER dead coarse root N transfer mortality gN/m^2/s F -M_DEADROOTC_STORAGE_TO_FIRE dead root C storage fire loss gC/m^2/s F -M_DEADROOTC_STORAGE_TO_LITTER_FIRE dead root C storage fire mortality to litter gC/m^2/s F -M_DEADROOTC_TO_FIRE dead root C fire loss gC/m^2/s F -M_DEADROOTC_TO_LITTER_FIRE dead root C fire mortality to litter gC/m^2/s F -M_DEADROOTC_XFER_TO_FIRE dead root C transfer fire loss gC/m^2/s F -M_DEADROOTC_XFER_TO_LITTER_FIRE dead root C transfer fire mortality to litter gC/m^2/s F -M_DEADSTEMC_STORAGE_TO_FIRE dead stem C storage fire loss gC/m^2/s F -M_DEADSTEMC_STORAGE_TO_LITTER dead stem C storage mortality gC/m^2/s F -M_DEADSTEMC_STORAGE_TO_LITTER_FIRE dead stem C storage fire mortality to litter gC/m^2/s F -M_DEADSTEMC_TO_FIRE dead stem C fire loss gC/m^2/s F -M_DEADSTEMC_TO_LITTER dead stem C mortality gC/m^2/s F -M_DEADSTEMC_TO_LITTER_FIRE dead stem C fire mortality to litter gC/m^2/s F -M_DEADSTEMC_XFER_TO_FIRE dead stem C transfer fire loss gC/m^2/s F -M_DEADSTEMC_XFER_TO_LITTER dead stem C transfer mortality gC/m^2/s F -M_DEADSTEMC_XFER_TO_LITTER_FIRE dead stem C transfer fire mortality to litter gC/m^2/s F -M_DEADSTEMN_STORAGE_TO_FIRE dead stem N storage fire loss gN/m^2/s F -M_DEADSTEMN_STORAGE_TO_LITTER dead stem N storage mortality gN/m^2/s F -M_DEADSTEMN_TO_FIRE dead stem N fire loss gN/m^2/s F -M_DEADSTEMN_TO_LITTER dead stem N mortality gN/m^2/s F -M_DEADSTEMN_TO_LITTER_FIRE dead stem N fire mortality to litter gN/m^2/s F -M_DEADSTEMN_XFER_TO_FIRE dead stem N transfer fire loss gN/m^2/s F -M_DEADSTEMN_XFER_TO_LITTER dead stem N transfer mortality gN/m^2/s F -M_FROOTC_STORAGE_TO_FIRE fine root C storage fire loss gC/m^2/s F -M_FROOTC_STORAGE_TO_LITTER fine root C storage mortality gC/m^2/s F -M_FROOTC_STORAGE_TO_LITTER_FIRE fine root C storage fire mortality to litter gC/m^2/s F -M_FROOTC_TO_FIRE fine root C fire loss gC/m^2/s F -M_FROOTC_TO_LITTER fine root C mortality gC/m^2/s F -M_FROOTC_TO_LITTER_FIRE fine root C fire mortality to litter gC/m^2/s F -M_FROOTC_XFER_TO_FIRE fine root C transfer fire loss gC/m^2/s F -M_FROOTC_XFER_TO_LITTER fine root C transfer mortality gC/m^2/s F -M_FROOTC_XFER_TO_LITTER_FIRE fine root C transfer fire mortality to litter gC/m^2/s F -M_FROOTN_STORAGE_TO_FIRE fine root N storage fire loss gN/m^2/s F -M_FROOTN_STORAGE_TO_LITTER fine root N storage mortality gN/m^2/s F -M_FROOTN_TO_FIRE fine root N fire loss gN/m^2/s F -M_FROOTN_TO_LITTER fine root N mortality gN/m^2/s F -M_FROOTN_XFER_TO_FIRE fine root N transfer fire loss gN/m^2/s F -M_FROOTN_XFER_TO_LITTER fine root N transfer mortality gN/m^2/s F -M_GRESP_STORAGE_TO_FIRE growth respiration storage fire loss gC/m^2/s F -M_GRESP_STORAGE_TO_LITTER growth respiration storage mortality gC/m^2/s F -M_GRESP_STORAGE_TO_LITTER_FIRE growth respiration storage fire mortality to litter gC/m^2/s F -M_GRESP_XFER_TO_FIRE growth respiration transfer fire loss gC/m^2/s F -M_GRESP_XFER_TO_LITTER growth respiration transfer mortality gC/m^2/s F -M_GRESP_XFER_TO_LITTER_FIRE growth respiration transfer fire mortality to litter gC/m^2/s F -M_LEAFC_STORAGE_TO_FIRE leaf C storage fire loss gC/m^2/s F -M_LEAFC_STORAGE_TO_LITTER leaf C storage mortality gC/m^2/s F -M_LEAFC_STORAGE_TO_LITTER_FIRE leaf C fire mortality to litter gC/m^2/s F -M_LEAFC_TO_FIRE leaf C fire loss gC/m^2/s F -M_LEAFC_TO_LITTER leaf C mortality gC/m^2/s F -M_LEAFC_TO_LITTER_FIRE leaf C fire mortality to litter gC/m^2/s F -M_LEAFC_XFER_TO_FIRE leaf C transfer fire loss gC/m^2/s F -M_LEAFC_XFER_TO_LITTER leaf C transfer mortality gC/m^2/s F -M_LEAFC_XFER_TO_LITTER_FIRE leaf C transfer fire mortality to litter gC/m^2/s F -M_LEAFN_STORAGE_TO_FIRE leaf N storage fire loss gN/m^2/s F -M_LEAFN_STORAGE_TO_LITTER leaf N storage mortality gN/m^2/s F -M_LEAFN_TO_FIRE leaf N fire loss gN/m^2/s F -M_LEAFN_TO_LITTER leaf N mortality gN/m^2/s F -M_LEAFN_XFER_TO_FIRE leaf N transfer fire loss gN/m^2/s F -M_LEAFN_XFER_TO_LITTER leaf N transfer mortality gN/m^2/s F -M_LIG_LITC_TO_FIRE lignin litter C fire loss gC/m^2/s F -M_LIG_LITC_TO_FIRE_vr lignin litter C fire loss gC/m^3/s F -M_LIG_LITC_TO_LEACHING lignin litter C leaching loss gC/m^2/s F -M_LIG_LITN_TO_FIRE lignin litter N fire loss gN/m^2 F -M_LIG_LITN_TO_FIRE_vr lignin litter N fire loss gN/m^3 F -M_LIG_LITN_TO_LEACHING lignin litter N leaching loss gN/m^2/s F -M_LIVECROOTC_STORAGE_TO_LITTER live coarse root C storage mortality gC/m^2/s F -M_LIVECROOTC_STORAGE_TO_LITTER_FIRE live coarse root C fire mortality to litter gC/m^2/s F -M_LIVECROOTC_TO_LITTER live coarse root C mortality gC/m^2/s F -M_LIVECROOTC_XFER_TO_LITTER live coarse root C transfer mortality gC/m^2/s F -M_LIVECROOTN_STORAGE_TO_FIRE live coarse root N storage fire loss gN/m^2/s F -M_LIVECROOTN_STORAGE_TO_LITTER live coarse root N storage mortality gN/m^2/s F -M_LIVECROOTN_TO_FIRE live coarse root N fire loss gN/m^2/s F -M_LIVECROOTN_TO_LITTER live coarse root N mortality gN/m^2/s F -M_LIVECROOTN_XFER_TO_FIRE live coarse root N transfer fire loss gN/m^2/s F -M_LIVECROOTN_XFER_TO_LITTER live coarse root N transfer mortality gN/m^2/s F -M_LIVEROOTC_STORAGE_TO_FIRE live root C storage fire loss gC/m^2/s F -M_LIVEROOTC_STORAGE_TO_LITTER_FIRE live root C storage fire mortality to litter gC/m^2/s F -M_LIVEROOTC_TO_DEADROOTC_FIRE live root C fire mortality to dead root C gC/m^2/s F -M_LIVEROOTC_TO_FIRE live root C fire loss gC/m^2/s F -M_LIVEROOTC_TO_LITTER_FIRE live root C fire mortality to litter gC/m^2/s F -M_LIVEROOTC_XFER_TO_FIRE live root C transfer fire loss gC/m^2/s F -M_LIVEROOTC_XFER_TO_LITTER_FIRE live root C transfer fire mortality to litter gC/m^2/s F -M_LIVESTEMC_STORAGE_TO_FIRE live stem C storage fire loss gC/m^2/s F -M_LIVESTEMC_STORAGE_TO_LITTER live stem C storage mortality gC/m^2/s F -M_LIVESTEMC_STORAGE_TO_LITTER_FIRE live stem C storage fire mortality to litter gC/m^2/s F -M_LIVESTEMC_TO_DEADSTEMC_FIRE live stem C fire mortality to dead stem C gC/m^2/s F -M_LIVESTEMC_TO_FIRE live stem C fire loss gC/m^2/s F -M_LIVESTEMC_TO_LITTER live stem C mortality gC/m^2/s F -M_LIVESTEMC_TO_LITTER_FIRE live stem C fire mortality to litter gC/m^2/s F -M_LIVESTEMC_XFER_TO_FIRE live stem C transfer fire loss gC/m^2/s F -M_LIVESTEMC_XFER_TO_LITTER live stem C transfer mortality gC/m^2/s F -M_LIVESTEMC_XFER_TO_LITTER_FIRE live stem C transfer fire mortality to litter gC/m^2/s F -M_LIVESTEMN_STORAGE_TO_FIRE live stem N storage fire loss gN/m^2/s F -M_LIVESTEMN_STORAGE_TO_LITTER live stem N storage mortality gN/m^2/s F -M_LIVESTEMN_TO_FIRE live stem N fire loss gN/m^2/s F -M_LIVESTEMN_TO_LITTER live stem N mortality gN/m^2/s F -M_LIVESTEMN_XFER_TO_FIRE live stem N transfer fire loss gN/m^2/s F -M_LIVESTEMN_XFER_TO_LITTER live stem N transfer mortality gN/m^2/s F -M_MET_LITC_TO_FIRE metabolic litter C fire loss gC/m^2/s F -M_MET_LITC_TO_FIRE_vr metabolic litter C fire loss gC/m^3/s F -M_MET_LITC_TO_LEACHING metabolic litter C leaching loss gC/m^2/s F -M_MET_LITN_TO_FIRE metabolic litter N fire loss gN/m^2 F -M_MET_LITN_TO_FIRE_vr metabolic litter N fire loss gN/m^3 F -M_MET_LITN_TO_LEACHING metabolic litter N leaching loss gN/m^2/s F -M_PAS_SOMC_TO_LEACHING passive soil organic C leaching loss gC/m^2/s F -M_PAS_SOMN_TO_LEACHING passive soil organic N leaching loss gN/m^2/s F -M_RETRANSN_TO_FIRE retranslocated N pool fire loss gN/m^2/s F -M_RETRANSN_TO_LITTER retranslocated N pool mortality gN/m^2/s F -M_SLO_SOMC_TO_LEACHING slow soil organic ma C leaching loss gC/m^2/s F -M_SLO_SOMN_TO_LEACHING slow soil organic ma N leaching loss gN/m^2/s F -NACTIVE Mycorrhizal N uptake flux gN/m^2/s T -NACTIVE_NH4 Mycorrhizal N uptake flux gN/m^2/s T -NACTIVE_NO3 Mycorrhizal N uptake flux gN/m^2/s T -NAM AM-associated N uptake flux gN/m^2/s T -NAM_NH4 AM-associated N uptake flux gN/m^2/s T -NAM_NO3 AM-associated N uptake flux gN/m^2/s T -NBP net biome production, includes fire, landuse, harvest and hrv_xsmrpool flux (latter smoothed o gC/m^2/s T -NDEPLOY total N deployed in new growth gN/m^2/s T -NDEP_PROF profile for atmospheric N deposition 1/m F -NDEP_TO_SMINN atmospheric N deposition to soil mineral N gN/m^2/s T -NECM ECM-associated N uptake flux gN/m^2/s T -NECM_NH4 ECM-associated N uptake flux gN/m^2/s T -NECM_NO3 ECM-associated N uptake flux gN/m^2/s T -NEE net ecosystem exchange of carbon, includes fire and hrv_xsmrpool (latter smoothed over the yea gC/m^2/s T -NEM Gridcell net adjustment to net carbon exchange passed to atm. for methane production gC/m2/s T -NEP net ecosystem production, excludes fire, landuse, and harvest flux, positive for sink gC/m^2/s T -NET_NMIN net rate of N mineralization gN/m^2/s T -NET_NMIN_vr net rate of N mineralization gN/m^3/s F -NFERTILIZATION fertilizer added gN/m^2/s T -NFIRE fire counts valid only in Reg.C counts/km2/sec T -NFIX Symbiotic BNF uptake flux gN/m^2/s T -NFIXATION_PROF profile for biological N fixation 1/m F -NFIX_TO_SMINN symbiotic/asymbiotic N fixation to soil mineral N gN/m^2/s F -NNONMYC Non-mycorrhizal N uptake flux gN/m^2/s T -NNONMYC_NH4 Non-mycorrhizal N uptake flux gN/m^2/s T -NNONMYC_NO3 Non-mycorrhizal N uptake flux gN/m^2/s T -NPASSIVE Passive N uptake flux gN/m^2/s T -NPOOL temporary plant N pool gN/m^2 T -NPOOL_TO_DEADCROOTN allocation to dead coarse root N gN/m^2/s F -NPOOL_TO_DEADCROOTN_STORAGE allocation to dead coarse root N storage gN/m^2/s F -NPOOL_TO_DEADSTEMN allocation to dead stem N gN/m^2/s F -NPOOL_TO_DEADSTEMN_STORAGE allocation to dead stem N storage gN/m^2/s F -NPOOL_TO_FROOTN allocation to fine root N gN/m^2/s F -NPOOL_TO_FROOTN_STORAGE allocation to fine root N storage gN/m^2/s F -NPOOL_TO_LEAFN allocation to leaf N gN/m^2/s F -NPOOL_TO_LEAFN_STORAGE allocation to leaf N storage gN/m^2/s F -NPOOL_TO_LIVECROOTN allocation to live coarse root N gN/m^2/s F -NPOOL_TO_LIVECROOTN_STORAGE allocation to live coarse root N storage gN/m^2/s F -NPOOL_TO_LIVESTEMN allocation to live stem N gN/m^2/s F -NPOOL_TO_LIVESTEMN_STORAGE allocation to live stem N storage gN/m^2/s F -NPP net primary production gC/m^2/s T -NPP_BURNEDOFF C that cannot be used for N uptake gC/m^2/s F -NPP_GROWTH Total C used for growth in FUN gC/m^2/s T -NPP_NACTIVE Mycorrhizal N uptake used C gC/m^2/s T -NPP_NACTIVE_NH4 Mycorrhizal N uptake use C gC/m^2/s T -NPP_NACTIVE_NO3 Mycorrhizal N uptake used C gC/m^2/s T -NPP_NAM AM-associated N uptake used C gC/m^2/s T -NPP_NAM_NH4 AM-associated N uptake use C gC/m^2/s T -NPP_NAM_NO3 AM-associated N uptake use C gC/m^2/s T -NPP_NECM ECM-associated N uptake used C gC/m^2/s T -NPP_NECM_NH4 ECM-associated N uptake use C gC/m^2/s T -NPP_NECM_NO3 ECM-associated N uptake used C gC/m^2/s T -NPP_NFIX Symbiotic BNF uptake used C gC/m^2/s T -NPP_NNONMYC Non-mycorrhizal N uptake used C gC/m^2/s T -NPP_NNONMYC_NH4 Non-mycorrhizal N uptake use C gC/m^2/s T -NPP_NNONMYC_NO3 Non-mycorrhizal N uptake use C gC/m^2/s T -NPP_NRETRANS Retranslocated N uptake flux gC/m^2/s T -NPP_NUPTAKE Total C used by N uptake in FUN gC/m^2/s T -NRETRANS Retranslocated N uptake flux gN/m^2/s T -NRETRANS_REG Retranslocated N uptake flux gN/m^2/s T -NRETRANS_SEASON Retranslocated N uptake flux gN/m^2/s T -NRETRANS_STRESS Retranslocated N uptake flux gN/m^2/s T -NSUBSTEPS number of adaptive timesteps in CLM timestep unitless F -NUPTAKE Total N uptake of FUN gN/m^2/s T -NUPTAKE_NPP_FRACTION frac of NPP used in N uptake - T -N_ALLOMETRY N allocation index none F -O2_DECOMP_DEPTH_UNSAT O2 consumption from HR and AR for non-inundated area mol/m3/s F -OBU Monin-Obukhov length m F -OCDEP total OC deposition (dry+wet) from atmosphere kg/m^2/s T -OFFSET_COUNTER offset days counter days F -OFFSET_FDD offset freezing degree days counter C degree-days F -OFFSET_FLAG offset flag none F -OFFSET_SWI offset soil water index none F -ONSET_COUNTER onset days counter days F -ONSET_FDD onset freezing degree days counter C degree-days F -ONSET_FLAG onset flag none F -ONSET_GDD onset growing degree days C degree-days F -ONSET_GDDFLAG onset flag for growing degree day sum none F -ONSET_SWI onset soil water index none F -O_SCALAR fraction by which decomposition is reduced due to anoxia unitless T -PAR240DZ 10-day running mean of daytime patch absorbed PAR for leaves for top canopy layer W/m^2 F -PAR240XZ 10-day running mean of maximum patch absorbed PAR for leaves for top canopy layer W/m^2 F -PAR240_shade shade PAR (240 hrs) umol/m2/s F -PAR240_sun sunlit PAR (240 hrs) umol/m2/s F -PAR24_shade shade PAR (24 hrs) umol/m2/s F -PAR24_sun sunlit PAR (24 hrs) umol/m2/s F -PARVEGLN absorbed par by vegetation at local noon W/m^2 T -PAR_shade shade PAR umol/m2/s F -PAR_sun sunlit PAR umol/m2/s F -PAS_SOMC PAS_SOM C gC/m^2 T -PAS_SOMC_1m PAS_SOM C to 1 meter gC/m^2 F -PAS_SOMC_TNDNCY_VERT_TRA passive soil organic C tendency due to vertical transport gC/m^3/s F -PAS_SOMC_TO_ACT_SOMC decomp. of passive soil organic C to active soil organic C gC/m^2/s F -PAS_SOMC_TO_ACT_SOMC_vr decomp. of passive soil organic C to active soil organic C gC/m^3/s F -PAS_SOMC_vr PAS_SOM C (vertically resolved) gC/m^3 T -PAS_SOMN PAS_SOM N gN/m^2 T -PAS_SOMN_1m PAS_SOM N to 1 meter gN/m^2 F -PAS_SOMN_TNDNCY_VERT_TRA passive soil organic N tendency due to vertical transport gN/m^3/s F -PAS_SOMN_TO_ACT_SOMN decomp. of passive soil organic N to active soil organic N gN/m^2 F -PAS_SOMN_TO_ACT_SOMN_vr decomp. of passive soil organic N to active soil organic N gN/m^3 F -PAS_SOMN_vr PAS_SOM N (vertically resolved) gN/m^3 T -PAS_SOM_HR Het. Resp. from passive soil organic gC/m^2/s F -PAS_SOM_HR_vr Het. Resp. from passive soil organic gC/m^3/s F -PBOT atmospheric pressure at surface (downscaled to columns in glacier regions) Pa T -PBOT_240 10 day running mean of air pressure Pa F -PCH4 atmospheric partial pressure of CH4 Pa T -PCO2 atmospheric partial pressure of CO2 Pa T -PCO2_240 10 day running mean of CO2 pressure Pa F -PFT_CTRUNC patch-level sink for C truncation gC/m^2 F -PFT_FIRE_CLOSS total patch-level fire C loss for non-peat fires outside land-type converted region gC/m^2/s T -PFT_FIRE_NLOSS total patch-level fire N loss gN/m^2/s T -PFT_NTRUNC patch-level sink for N truncation gN/m^2 F -PLANTCN Plant C:N used by FUN unitless F -PLANT_CALLOC total allocated C flux gC/m^2/s F -PLANT_NALLOC total allocated N flux gN/m^2/s F -PLANT_NDEMAND N flux required to support initial GPP gN/m^2/s T -PNLCZ Proportion of nitrogen allocated for light capture unitless F -PO2_240 10 day running mean of O2 pressure Pa F -POTENTIAL_IMMOB potential N immobilization gN/m^2/s T -POTENTIAL_IMMOB_vr potential N immobilization gN/m^3/s F -POT_F_DENIT potential denitrification flux gN/m^2/s T -POT_F_DENIT_vr potential denitrification flux gN/m^3/s F -POT_F_NIT potential nitrification flux gN/m^2/s T -POT_F_NIT_vr potential nitrification flux gN/m^3/s F -PREC10 10-day running mean of PREC MM H2O/S F -PREC60 60-day running mean of PREC MM H2O/S F -PREV_DAYL daylength from previous timestep s F -PREV_FROOTC_TO_LITTER previous timestep froot C litterfall flux gC/m^2/s F -PREV_LEAFC_TO_LITTER previous timestep leaf C litterfall flux gC/m^2/s F -PROD100C 100-yr wood product C gC/m^2 F -PROD100C_LOSS loss from 100-yr wood product pool gC/m^2/s F -PROD100N 100-yr wood product N gN/m^2 F -PROD100N_LOSS loss from 100-yr wood product pool gN/m^2/s F -PROD10C 10-yr wood product C gC/m^2 F -PROD10C_LOSS loss from 10-yr wood product pool gC/m^2/s F -PROD10N 10-yr wood product N gN/m^2 F -PROD10N_LOSS loss from 10-yr wood product pool gN/m^2/s F -PSNSHA shaded leaf photosynthesis umolCO2/m^2/s T -PSNSHADE_TO_CPOOL C fixation from shaded canopy gC/m^2/s T -PSNSUN sunlit leaf photosynthesis umolCO2/m^2/s T -PSNSUN_TO_CPOOL C fixation from sunlit canopy gC/m^2/s T -PSurf atmospheric pressure at surface (downscaled to columns in glacier regions) Pa F -Q2M 2m specific humidity kg/kg T -QAF canopy air humidity kg/kg F -QBOT atmospheric specific humidity (downscaled to columns in glacier regions) kg/kg T -QDIRECT_THROUGHFALL direct throughfall of liquid (rain + above-canopy irrigation) mm/s F -QDIRECT_THROUGHFALL_SNOW direct throughfall of snow mm/s F -QDRAI sub-surface drainage mm/s T -QDRAI_PERCH perched wt drainage mm/s T -QDRAI_XS saturation excess drainage mm/s T -QDRIP rate of excess canopy liquid falling off canopy mm/s F -QDRIP_SNOW rate of excess canopy snow falling off canopy mm/s F -QFLOOD runoff from river flooding mm/s T -QFLX_EVAP_TOT qflx_evap_soi + qflx_evap_can + qflx_tran_veg kg m-2 s-1 T -QFLX_EVAP_VEG vegetation evaporation mm H2O/s F -QFLX_ICE_DYNBAL ice dynamic land cover change conversion runoff flux mm/s T -QFLX_LIQDEW_TO_TOP_LAYER rate of liquid water deposited on top soil or snow layer (dew) mm H2O/s T -QFLX_LIQEVAP_FROM_TOP_LAYER rate of liquid water evaporated from top soil or snow layer mm H2O/s T -QFLX_LIQ_DYNBAL liq dynamic land cover change conversion runoff flux mm/s T -QFLX_LIQ_GRND liquid (rain+irrigation) on ground after interception mm H2O/s F -QFLX_SNOW_DRAIN drainage from snow pack mm/s T -QFLX_SNOW_DRAIN_ICE drainage from snow pack melt (ice landunits only) mm/s T -QFLX_SNOW_GRND snow on ground after interception mm H2O/s F -QFLX_SOLIDDEW_TO_TOP_LAYER rate of solid water deposited on top soil or snow layer (frost) mm H2O/s T -QFLX_SOLIDEVAP_FROM_TOP_LAYER rate of ice evaporated from top soil or snow layer (sublimation) (also includes bare ice subli mm H2O/s T -QFLX_SOLIDEVAP_FROM_TOP_LAYER_ICE rate of ice evaporated from top soil or snow layer (sublimation) (also includes bare ice subli mm H2O/s F -QH2OSFC surface water runoff mm/s T -QH2OSFC_TO_ICE surface water converted to ice mm/s F -QHR hydraulic redistribution mm/s T -QICE ice growth/melt mm/s T -QICE_FORC qice forcing sent to GLC mm/s F -QICE_FRZ ice growth mm/s T -QICE_MELT ice melt mm/s T -QINFL infiltration mm/s T -QINTR interception mm/s T -QIRRIG_DEMAND irrigation demand mm/s F -QIRRIG_DRIP water added via drip irrigation mm/s F -QIRRIG_FROM_GW_CONFINED water added through confined groundwater irrigation mm/s T -QIRRIG_FROM_GW_UNCONFINED water added through unconfined groundwater irrigation mm/s T -QIRRIG_FROM_SURFACE water added through surface water irrigation mm/s T -QIRRIG_SPRINKLER water added via sprinkler irrigation mm/s F -QOVER total surface runoff (includes QH2OSFC) mm/s T -QOVER_LAG time-lagged surface runoff for soil columns mm/s F -QPHSNEG net negative hydraulic redistribution flux mm/s F -QRGWL surface runoff at glaciers (liquid only), wetlands, lakes; also includes melted ice runoff fro mm/s T -QROOTSINK water flux from soil to root in each soil-layer mm/s F -QRUNOFF total liquid runoff not including correction for land use change mm/s T -QRUNOFF_ICE total liquid runoff not incl corret for LULCC (ice landunits only) mm/s T -QRUNOFF_ICE_TO_COUPLER total ice runoff sent to coupler (includes corrections for land use change) mm/s T -QRUNOFF_ICE_TO_LIQ liquid runoff from converted ice runoff mm/s F -QRUNOFF_R Rural total runoff mm/s F -QRUNOFF_TO_COUPLER total liquid runoff sent to coupler (includes corrections for land use change) mm/s T -QRUNOFF_U Urban total runoff mm/s F -QSNOCPLIQ excess liquid h2o due to snow capping not including correction for land use change mm H2O/s T -QSNOEVAP evaporation from snow (only when snl<0, otherwise it is equal to qflx_ev_soil) mm/s T -QSNOFRZ column-integrated snow freezing rate kg/m2/s T -QSNOFRZ_ICE column-integrated snow freezing rate (ice landunits only) mm/s T -QSNOMELT snow melt rate mm/s T -QSNOMELT_ICE snow melt (ice landunits only) mm/s T -QSNOUNLOAD canopy snow unloading mm/s T -QSNO_TEMPUNLOAD canopy snow temp unloading mm/s T -QSNO_WINDUNLOAD canopy snow wind unloading mm/s T -QSNWCPICE excess solid h2o due to snow capping not including correction for land use change mm H2O/s T -QSOIL Ground evaporation (soil/snow evaporation + soil/snow sublimation - dew) mm/s T -QSOIL_ICE Ground evaporation (ice landunits only) mm/s T -QTOPSOIL water input to surface mm/s F -QVEGE canopy evaporation mm/s T -QVEGT canopy transpiration mm/s T -Qair atmospheric specific humidity (downscaled to columns in glacier regions) kg/kg F -Qh sensible heat W/m^2 F -Qle total evaporation W/m^2 F -Qstor storage heat flux (includes snowmelt) W/m^2 F -Qtau momentum flux kg/m/s^2 F -RAH1 aerodynamical resistance s/m F -RAH2 aerodynamical resistance s/m F -RAIN atmospheric rain, after rain/snow repartitioning based on temperature mm/s T -RAIN_FROM_ATM atmospheric rain received from atmosphere (pre-repartitioning) mm/s T -RAIN_ICE atmospheric rain, after rain/snow repartitioning based on temperature (ice landunits only) mm/s F -RAM1 aerodynamical resistance s/m F -RAM_LAKE aerodynamic resistance for momentum (lakes only) s/m F -RAW1 aerodynamical resistance s/m F -RAW2 aerodynamical resistance s/m F -RB leaf boundary resistance s/m F -RB10 10 day running mean boundary layer resistance s/m F -RETRANSN plant pool of retranslocated N gN/m^2 T -RETRANSN_TO_NPOOL deployment of retranslocated N gN/m^2/s T -RH atmospheric relative humidity % F -RH2M 2m relative humidity % T -RH2M_R Rural 2m specific humidity % F -RH2M_U Urban 2m relative humidity % F -RH30 30-day running mean of relative humidity % F -RHAF fractional humidity of canopy air fraction F -RHAF10 10 day running mean of fractional humidity of canopy air fraction F -RH_LEAF fractional humidity at leaf surface fraction F -ROOTR effective fraction of roots in each soil layer (SMS method) proportion F -RR root respiration (fine root MR + total root GR) gC/m^2/s T -RRESIS root resistance in each soil layer proportion F -RSSHA shaded leaf stomatal resistance s/m T -RSSUN sunlit leaf stomatal resistance s/m T -Rainf atmospheric rain, after rain/snow repartitioning based on temperature mm/s F -Rnet net radiation W/m^2 F -S1_PATHFRAC_S2_vr PATHFRAC from active soil organic to slow soil organic ma fraction F -S1_PATHFRAC_S3_vr PATHFRAC from active soil organic to passive soil organic fraction F -S1_RESP_FRAC_S2_vr respired from active soil organic to slow soil organic ma fraction F -S1_RESP_FRAC_S3_vr respired from active soil organic to passive soil organic fraction F -S2_PATHFRAC_S1_vr PATHFRAC from slow soil organic ma to active soil organic fraction F -S2_PATHFRAC_S3_vr PATHFRAC from slow soil organic ma to passive soil organic fraction F -S2_RESP_FRAC_S1_vr respired from slow soil organic ma to active soil organic fraction F -S2_RESP_FRAC_S3_vr respired from slow soil organic ma to passive soil organic fraction F -S3_PATHFRAC_S1_vr PATHFRAC from passive soil organic to active soil organic fraction F -S3_RESP_FRAC_S1_vr respired from passive soil organic to active soil organic fraction F -SABG solar rad absorbed by ground W/m^2 T -SABG_PEN Rural solar rad penetrating top soil or snow layer watt/m^2 T -SABV solar rad absorbed by veg W/m^2 T -SDATES actual crop sowing dates; should only be output annually day of year F -SDATES_PERHARV actual sowing dates for crops harvested this year; should only be output annually day of year F -SEEDC pool for seeding new PFTs via dynamic landcover gC/m^2 T -SEEDN pool for seeding new PFTs via dynamic landcover gN/m^2 T -SLASH_HARVESTC slash harvest carbon (to litter) gC/m^2/s T -SLO_SOMC SLO_SOM C gC/m^2 T -SLO_SOMC_1m SLO_SOM C to 1 meter gC/m^2 F -SLO_SOMC_TNDNCY_VERT_TRA slow soil organic ma C tendency due to vertical transport gC/m^3/s F -SLO_SOMC_TO_ACT_SOMC decomp. of slow soil organic ma C to active soil organic C gC/m^2/s F -SLO_SOMC_TO_ACT_SOMC_vr decomp. of slow soil organic ma C to active soil organic C gC/m^3/s F -SLO_SOMC_TO_PAS_SOMC decomp. of slow soil organic ma C to passive soil organic C gC/m^2/s F -SLO_SOMC_TO_PAS_SOMC_vr decomp. of slow soil organic ma C to passive soil organic C gC/m^3/s F -SLO_SOMC_vr SLO_SOM C (vertically resolved) gC/m^3 T -SLO_SOMN SLO_SOM N gN/m^2 T -SLO_SOMN_1m SLO_SOM N to 1 meter gN/m^2 F -SLO_SOMN_TNDNCY_VERT_TRA slow soil organic ma N tendency due to vertical transport gN/m^3/s F -SLO_SOMN_TO_ACT_SOMN decomp. of slow soil organic ma N to active soil organic N gN/m^2 F -SLO_SOMN_TO_ACT_SOMN_vr decomp. of slow soil organic ma N to active soil organic N gN/m^3 F -SLO_SOMN_TO_PAS_SOMN decomp. of slow soil organic ma N to passive soil organic N gN/m^2 F -SLO_SOMN_TO_PAS_SOMN_vr decomp. of slow soil organic ma N to passive soil organic N gN/m^3 F -SLO_SOMN_vr SLO_SOM N (vertically resolved) gN/m^3 T -SLO_SOM_HR_S1 Het. Resp. from slow soil organic ma gC/m^2/s F -SLO_SOM_HR_S1_vr Het. Resp. from slow soil organic ma gC/m^3/s F -SLO_SOM_HR_S3 Het. Resp. from slow soil organic ma gC/m^2/s F -SLO_SOM_HR_S3_vr Het. Resp. from slow soil organic ma gC/m^3/s F -SMINN soil mineral N gN/m^2 T -SMINN_TO_NPOOL deployment of soil mineral N uptake gN/m^2/s T -SMINN_TO_PLANT plant uptake of soil mineral N gN/m^2/s T -SMINN_TO_PLANT_FUN Total soil N uptake of FUN gN/m^2/s T -SMINN_TO_PLANT_vr plant uptake of soil mineral N gN/m^3/s F -SMINN_TO_S1N_L1 mineral N flux for decomp. of MET_LITto ACT_SOM gN/m^2 F -SMINN_TO_S1N_L1_vr mineral N flux for decomp. of MET_LITto ACT_SOM gN/m^3 F -SMINN_TO_S1N_L2 mineral N flux for decomp. of CEL_LITto ACT_SOM gN/m^2 F -SMINN_TO_S1N_L2_vr mineral N flux for decomp. of CEL_LITto ACT_SOM gN/m^3 F -SMINN_TO_S1N_S2 mineral N flux for decomp. of SLO_SOMto ACT_SOM gN/m^2 F -SMINN_TO_S1N_S2_vr mineral N flux for decomp. of SLO_SOMto ACT_SOM gN/m^3 F -SMINN_TO_S1N_S3 mineral N flux for decomp. of PAS_SOMto ACT_SOM gN/m^2 F -SMINN_TO_S1N_S3_vr mineral N flux for decomp. of PAS_SOMto ACT_SOM gN/m^3 F -SMINN_TO_S2N_L3 mineral N flux for decomp. of LIG_LITto SLO_SOM gN/m^2 F -SMINN_TO_S2N_L3_vr mineral N flux for decomp. of LIG_LITto SLO_SOM gN/m^3 F -SMINN_TO_S2N_S1 mineral N flux for decomp. of ACT_SOMto SLO_SOM gN/m^2 F -SMINN_TO_S2N_S1_vr mineral N flux for decomp. of ACT_SOMto SLO_SOM gN/m^3 F -SMINN_TO_S3N_S1 mineral N flux for decomp. of ACT_SOMto PAS_SOM gN/m^2 F -SMINN_TO_S3N_S1_vr mineral N flux for decomp. of ACT_SOMto PAS_SOM gN/m^3 F -SMINN_TO_S3N_S2 mineral N flux for decomp. of SLO_SOMto PAS_SOM gN/m^2 F -SMINN_TO_S3N_S2_vr mineral N flux for decomp. of SLO_SOMto PAS_SOM gN/m^3 F -SMINN_vr soil mineral N gN/m^3 T -SMIN_NH4 soil mineral NH4 gN/m^2 T -SMIN_NH4_TO_PLANT plant uptake of NH4 gN/m^3/s F -SMIN_NH4_vr soil mineral NH4 (vert. res.) gN/m^3 T -SMIN_NO3 soil mineral NO3 gN/m^2 T -SMIN_NO3_LEACHED soil NO3 pool loss to leaching gN/m^2/s T -SMIN_NO3_LEACHED_vr soil NO3 pool loss to leaching gN/m^3/s F -SMIN_NO3_MASSDENS SMIN_NO3_MASSDENS ugN/cm^3 soil F -SMIN_NO3_RUNOFF soil NO3 pool loss to runoff gN/m^2/s T -SMIN_NO3_RUNOFF_vr soil NO3 pool loss to runoff gN/m^3/s F -SMIN_NO3_TO_PLANT plant uptake of NO3 gN/m^3/s F -SMIN_NO3_vr soil mineral NO3 (vert. res.) gN/m^3 T -SMP soil matric potential (natural vegetated and crop landunits only) mm T -SNOBCMCL mass of BC in snow column kg/m2 T -SNOBCMSL mass of BC in top snow layer kg/m2 T -SNOCAN intercepted snow mm T -SNODSTMCL mass of dust in snow column kg/m2 T -SNODSTMSL mass of dust in top snow layer kg/m2 T -SNOFSDSND direct nir incident solar radiation on snow W/m^2 F -SNOFSDSNI diffuse nir incident solar radiation on snow W/m^2 F -SNOFSDSVD direct vis incident solar radiation on snow W/m^2 F -SNOFSDSVI diffuse vis incident solar radiation on snow W/m^2 F -SNOFSRND direct nir reflected solar radiation from snow W/m^2 T -SNOFSRNI diffuse nir reflected solar radiation from snow W/m^2 T -SNOFSRVD direct vis reflected solar radiation from snow W/m^2 T -SNOFSRVI diffuse vis reflected solar radiation from snow W/m^2 T -SNOINTABS Fraction of incoming solar absorbed by lower snow layers - T -SNOLIQFL top snow layer liquid water fraction (land) fraction F -SNOOCMCL mass of OC in snow column kg/m2 T -SNOOCMSL mass of OC in top snow layer kg/m2 T -SNORDSL top snow layer effective grain radius m^-6 F -SNOTTOPL snow temperature (top layer) K F -SNOTTOPL_ICE snow temperature (top layer, ice landunits only) K F -SNOTXMASS snow temperature times layer mass, layer sum; to get mass-weighted temperature, divide by (SNO K kg/m2 T -SNOTXMASS_ICE snow temperature times layer mass, layer sum (ice landunits only); to get mass-weighted temper K kg/m2 F -SNOW atmospheric snow, after rain/snow repartitioning based on temperature mm/s T -SNOWDP gridcell mean snow height m T -SNOWICE snow ice kg/m2 T -SNOWICE_ICE snow ice (ice landunits only) kg/m2 F -SNOWLIQ snow liquid water kg/m2 T -SNOWLIQ_ICE snow liquid water (ice landunits only) kg/m2 F -SNOW_5D 5day snow avg m F -SNOW_DEPTH snow height of snow covered area m T -SNOW_DEPTH_ICE snow height of snow covered area (ice landunits only) m F -SNOW_FROM_ATM atmospheric snow received from atmosphere (pre-repartitioning) mm/s T -SNOW_ICE atmospheric snow, after rain/snow repartitioning based on temperature (ice landunits only) mm/s F -SNOW_PERSISTENCE Length of time of continuous snow cover (nat. veg. landunits only) seconds T -SNOW_SINKS snow sinks (liquid water) mm/s T -SNOW_SOURCES snow sources (liquid water) mm/s T -SNO_ABS Absorbed solar radiation in each snow layer W/m^2 F -SNO_ABS_ICE Absorbed solar radiation in each snow layer (ice landunits only) W/m^2 F -SNO_BW Partial density of water in the snow pack (ice + liquid) kg/m3 F -SNO_BW_ICE Partial density of water in the snow pack (ice + liquid, ice landunits only) kg/m3 F -SNO_EXISTENCE Fraction of averaging period for which each snow layer existed unitless F -SNO_FRZ snow freezing rate in each snow layer kg/m2/s F -SNO_FRZ_ICE snow freezing rate in each snow layer (ice landunits only) mm/s F -SNO_GS Mean snow grain size Microns F -SNO_GS_ICE Mean snow grain size (ice landunits only) Microns F -SNO_ICE Snow ice content kg/m2 F -SNO_LIQH2O Snow liquid water content kg/m2 F -SNO_MELT snow melt rate in each snow layer mm/s F -SNO_MELT_ICE snow melt rate in each snow layer (ice landunits only) mm/s F -SNO_T Snow temperatures K F -SNO_TK Thermal conductivity W/m-K F -SNO_TK_ICE Thermal conductivity (ice landunits only) W/m-K F -SNO_T_ICE Snow temperatures (ice landunits only) K F -SNO_Z Snow layer thicknesses m F -SNO_Z_ICE Snow layer thicknesses (ice landunits only) m F -SNOdTdzL top snow layer temperature gradient (land) K/m F -SOIL10 10-day running mean of 12cm layer soil K F -SOILC_CHANGE C change in soil gC/m^2/s T -SOILC_HR soil C heterotrophic respiration gC/m^2/s T -SOILC_vr SOIL C (vertically resolved) gC/m^3 T -SOILICE soil ice (natural vegetated and crop landunits only) kg/m2 T -SOILLIQ soil liquid water (natural vegetated and crop landunits only) kg/m2 T -SOILN_vr SOIL N (vertically resolved) gN/m^3 T -SOILPSI soil water potential in each soil layer MPa F -SOILRESIS soil resistance to evaporation s/m T -SOILWATER_10CM soil liquid water + ice in top 10cm of soil (veg landunits only) kg/m2 T -SOMC_FIRE C loss due to peat burning gC/m^2/s T -SOMFIRE soil organic matter fire losses gC/m^2/s F -SOM_ADV_COEF advection term for vertical SOM translocation m/s F -SOM_C_LEACHED total flux of C from SOM pools due to leaching gC/m^2/s T -SOM_DIFFUS_COEF diffusion coefficient for vertical SOM translocation m^2/s F -SOM_N_LEACHED total flux of N from SOM pools due to leaching gN/m^2/s F -SOWING_REASON Reason for each crop sowing; should only be output annually unitless F -SOWING_REASON_PERHARV Reason for sowing of each crop harvested this year; should only be output annually unitless F -SR total soil respiration (HR + root resp) gC/m^2/s T -STEM_PROF profile for litter C and N inputs from stems 1/m F -STORAGE_CDEMAND C use from the C storage pool gC/m^2 F -STORAGE_GR growth resp for growth sent to storage for later display gC/m^2/s F -STORAGE_NDEMAND N demand during the offset period gN/m^2 F -STORVEGC stored vegetation carbon, excluding cpool gC/m^2 T -STORVEGN stored vegetation nitrogen gN/m^2 T -SUPPLEMENT_TO_SMINN supplemental N supply gN/m^2/s T -SUPPLEMENT_TO_SMINN_vr supplemental N supply gN/m^3/s F -SWBGT 2 m Simplified Wetbulb Globe Temp C T -SWBGT_R Rural 2 m Simplified Wetbulb Globe Temp C T -SWBGT_U Urban 2 m Simplified Wetbulb Globe Temp C T -SWdown atmospheric incident solar radiation W/m^2 F -SWup upwelling shortwave radiation W/m^2 F -SYEARS_PERHARV actual sowing years for crops harvested this year; should only be output annually year F -SoilAlpha factor limiting ground evap unitless F -SoilAlpha_U urban factor limiting ground evap unitless F -T10 10-day running mean of 2-m temperature K F -TAF canopy air temperature K F -TAUX zonal surface stress kg/m/s^2 T -TAUY meridional surface stress kg/m/s^2 T -TBOT atmospheric air temperature (downscaled to columns in glacier regions) K T -TBUILD internal urban building air temperature K T -TBUILD_MAX prescribed maximum interior building temperature K F -TEMPAVG_T2M temporary average 2m air temperature K F -TEMPMAX_RETRANSN temporary annual max of retranslocated N pool gN/m^2 F -TEMPSUM_POTENTIAL_GPP temporary annual sum of potential GPP gC/m^2/yr F -TFLOOR floor temperature K F -TG ground temperature K T -TG_ICE ground temperature (ice landunits only) K F -TG_R Rural ground temperature K F -TG_U Urban ground temperature K F -TH2OSFC surface water temperature K T -THBOT atmospheric air potential temperature (downscaled to columns in glacier regions) K T -TKE1 top lake level eddy thermal conductivity W/(mK) T -TLAI total projected leaf area index m^2/m^2 T -TLAKE lake temperature K T -TOPO_COL column-level topographic height m F -TOPO_COL_ICE column-level topographic height (ice landunits only) m F -TOPO_FORC topograephic height sent to GLC m F -TOPT topt coefficient for VOC calc non F -TOTCOLC total column carbon, incl veg and cpool but excl product pools gC/m^2 T -TOTCOLCH4 total belowground CH4 (0 for non-lake special landunits in the absence of dynamic landunits) gC/m2 T -TOTCOLN total column-level N, excluding product pools gN/m^2 T -TOTECOSYSC total ecosystem carbon, incl veg but excl cpool and product pools gC/m^2 T -TOTECOSYSN total ecosystem N, excluding product pools gN/m^2 T -TOTFIRE total ecosystem fire losses gC/m^2/s F -TOTLITC total litter carbon gC/m^2 T -TOTLITC_1m total litter carbon to 1 meter depth gC/m^2 T -TOTLITN total litter N gN/m^2 T -TOTLITN_1m total litter N to 1 meter gN/m^2 T -TOTPFTC total patch-level carbon, including cpool gC/m^2 T -TOTPFTN total patch-level nitrogen gN/m^2 T -TOTSOILICE vertically summed soil cie (veg landunits only) kg/m2 T -TOTSOILLIQ vertically summed soil liquid water (veg landunits only) kg/m2 T -TOTSOMC total soil organic matter carbon gC/m^2 T -TOTSOMC_1m total soil organic matter carbon to 1 meter depth gC/m^2 T -TOTSOMN total soil organic matter N gN/m^2 T -TOTSOMN_1m total soil organic matter N to 1 meter gN/m^2 T -TOTVEGC total vegetation carbon, excluding cpool gC/m^2 T -TOTVEGN total vegetation nitrogen gN/m^2 T -TOT_WOODPRODC total wood product C gC/m^2 T -TOT_WOODPRODC_LOSS total loss from wood product pools gC/m^2/s T -TOT_WOODPRODN total wood product N gN/m^2 T -TOT_WOODPRODN_LOSS total loss from wood product pools gN/m^2/s T -TPU25T canopy profile of tpu umol/m2/s T -TRAFFICFLUX sensible heat flux from urban traffic W/m^2 F -TRANSFER_DEADCROOT_GR dead coarse root growth respiration from storage gC/m^2/s F -TRANSFER_DEADSTEM_GR dead stem growth respiration from storage gC/m^2/s F -TRANSFER_FROOT_GR fine root growth respiration from storage gC/m^2/s F -TRANSFER_GR growth resp for transfer growth displayed in this timestep gC/m^2/s F -TRANSFER_LEAF_GR leaf growth respiration from storage gC/m^2/s F -TRANSFER_LIVECROOT_GR live coarse root growth respiration from storage gC/m^2/s F -TRANSFER_LIVESTEM_GR live stem growth respiration from storage gC/m^2/s F -TREFMNAV daily minimum of average 2-m temperature K T -TREFMNAV_R Rural daily minimum of average 2-m temperature K F -TREFMNAV_U Urban daily minimum of average 2-m temperature K F -TREFMXAV daily maximum of average 2-m temperature K T -TREFMXAV_R Rural daily maximum of average 2-m temperature K F -TREFMXAV_U Urban daily maximum of average 2-m temperature K F -TROOF_INNER roof inside surface temperature K F -TSA 2m air temperature K T -TSAI total projected stem area index m^2/m^2 T -TSA_ICE 2m air temperature (ice landunits only) K F -TSA_R Rural 2m air temperature K F -TSA_U Urban 2m air temperature K F -TSHDW_INNER shadewall inside surface temperature K F -TSKIN skin temperature K T -TSL temperature of near-surface soil layer (natural vegetated and crop landunits only) K T -TSOI soil temperature (natural vegetated and crop landunits only) K T -TSOI_10CM soil temperature in top 10cm of soil K T -TSOI_ICE soil temperature (ice landunits only) K T -TSRF_FORC surface temperature sent to GLC K F -TSUNW_INNER sunwall inside surface temperature K F -TV vegetation temperature K T -TV24 vegetation temperature (last 24hrs) K F -TV240 vegetation temperature (last 240hrs) K F -TVEGD10 10 day running mean of patch daytime vegetation temperature Kelvin F -TVEGN10 10 day running mean of patch night-time vegetation temperature Kelvin F -TWS total water storage mm T -T_SCALAR temperature inhibition of decomposition unitless T -Tair atmospheric air temperature (downscaled to columns in glacier regions) K F -Tair_from_atm atmospheric air temperature received from atmosphere (pre-downscaling) K F -U10 10-m wind m/s T -U10_DUST 10-m wind for dust model m/s T -U10_ICE 10-m wind (ice landunits only) m/s F -UAF canopy air speed m/s F -ULRAD upward longwave radiation above the canopy W/m^2 F -UM wind speed plus stability effect m/s F -URBAN_AC urban air conditioning flux W/m^2 T -URBAN_HEAT urban heating flux W/m^2 T -USTAR aerodynamical resistance s/m F -UST_LAKE friction velocity (lakes only) m/s F -VA atmospheric wind speed plus convective velocity m/s F -VCMX25T canopy profile of vcmax25 umol/m2/s T -VEGWP vegetation water matric potential for sun/sha canopy,xyl,root segments mm T -VEGWPLN vegetation water matric potential for sun/sha canopy,xyl,root at local noon mm T -VEGWPPD predawn vegetation water matric potential for sun/sha canopy,xyl,root mm T -VENTILATION sensible heat flux from building ventilation W/m^2 T -VOCFLXT total VOC flux into atmosphere moles/m2/sec F -VOLR river channel total water storage m3 T -VOLRMCH river channel main channel water storage m3 T -VPD vpd Pa F -VPD2M 2m vapor pressure deficit Pa T -VPD_CAN canopy vapor pressure deficit kPa T -Vcmx25Z canopy profile of vcmax25 predicted by LUNA model umol/m2/s T -WASTEHEAT sensible heat flux from heating/cooling sources of urban waste heat W/m^2 T -WBT 2 m Stull Wet Bulb C T -WBT_R Rural 2 m Stull Wet Bulb C T -WBT_U Urban 2 m Stull Wet Bulb C T -WF soil water as frac. of whc for top 0.05 m proportion F -WFPS WFPS percent F -WIND atmospheric wind velocity magnitude m/s T -WOODC wood C gC/m^2 T -WOODC_ALLOC wood C eallocation gC/m^2/s T -WOODC_LOSS wood C loss gC/m^2/s T -WOOD_HARVESTC wood harvest carbon (to product pools) gC/m^2/s T -WOOD_HARVESTN wood harvest N (to product pools) gN/m^2/s T -WTGQ surface tracer conductance m/s T -W_SCALAR Moisture (dryness) inhibition of decomposition unitless T -Wind atmospheric wind velocity magnitude m/s F -XSMRPOOL temporary photosynthate C pool gC/m^2 T -XSMRPOOL_LOSS temporary photosynthate C pool loss gC/m^2 F -XSMRPOOL_RECOVER C flux assigned to recovery of negative xsmrpool gC/m^2/s T -Z0HG roughness length over ground, sensible heat (vegetated landunits only) m F -Z0HV roughness length over vegetation, sensible heat m F -Z0MG roughness length over ground, momentum (vegetated landunits only) m F -Z0MV roughness length over vegetation, momentum m F -Z0MV_DENSE roughness length over vegetation, momentum, for dense canopy m F -Z0M_TO_COUPLER roughness length, momentum: gridcell average sent to coupler m F -Z0QG roughness length over ground, latent heat (vegetated landunits only) m F -Z0QV roughness length over vegetation, latent heat m F -ZBOT atmospheric reference height m T -ZETA dimensionless stability parameter unitless F -ZII convective boundary height m F -ZWT water table depth (natural vegetated and crop landunits only) m T -ZWT_CH4_UNSAT depth of water table for methane production used in non-inundated area m T -ZWT_PERCH perched water table depth (natural vegetated and crop landunits only) m T -anaerobic_frac anaerobic_frac m3/m3 F -bsw clap and hornberger B unitless F -currentPatch currentPatch coefficient for VOC calc non F -diffus diffusivity m^2/s F -fr_WFPS fr_WFPS fraction F -n2_n2o_ratio_denit n2_n2o_ratio_denit gN/gN F -num_iter number of iterations unitless F -r_psi r_psi m F -ratio_k1 ratio_k1 none F -ratio_no3_co2 ratio_no3_co2 ratio F -soil_bulkdensity soil_bulkdensity kg/m3 F -soil_co2_prod soil_co2_prod ug C / g soil / day F -watfc water field capacity m^3/m^3 F -watsat water saturated m^3/m^3 F -=================================== ============================================================================================== ================================================================= ======= +----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------- + Variable Name Level Dim. Long Description Units Active? +=================================== ================ ============================================================================================== ================================================================= ======= +A10TMIN - 10-day running mean of min 2-m temperature K F +A5TMIN - 5-day running mean of min 2-m temperature K F +ACTUAL_IMMOB - actual N immobilization gN/m^2/s T +ACTUAL_IMMOB_NH4 levdcmp immobilization of NH4 gN/m^3/s F +ACTUAL_IMMOB_NO3 levdcmp immobilization of NO3 gN/m^3/s F +ACTUAL_IMMOB_vr levdcmp actual N immobilization gN/m^3/s F +ACT_SOMC - ACT_SOM C gC/m^2 T +ACT_SOMC_1m - ACT_SOM C to 1 meter gC/m^2 F +ACT_SOMC_TNDNCY_VERT_TRA levdcmp active soil organic C tendency due to vertical transport gC/m^3/s F +ACT_SOMC_TO_PAS_SOMC - decomp. of active soil organic C to passive soil organic C gC/m^2/s F +ACT_SOMC_TO_PAS_SOMC_vr levdcmp decomp. of active soil organic C to passive soil organic C gC/m^3/s F +ACT_SOMC_TO_SLO_SOMC - decomp. of active soil organic C to slow soil organic ma C gC/m^2/s F +ACT_SOMC_TO_SLO_SOMC_vr levdcmp decomp. of active soil organic C to slow soil organic ma C gC/m^3/s F +ACT_SOMC_vr levsoi ACT_SOM C (vertically resolved) gC/m^3 T +ACT_SOMN - ACT_SOM N gN/m^2 T +ACT_SOMN_1m - ACT_SOM N to 1 meter gN/m^2 F +ACT_SOMN_TNDNCY_VERT_TRA levdcmp active soil organic N tendency due to vertical transport gN/m^3/s F +ACT_SOMN_TO_PAS_SOMN - decomp. of active soil organic N to passive soil organic N gN/m^2 F +ACT_SOMN_TO_PAS_SOMN_vr levdcmp decomp. of active soil organic N to passive soil organic N gN/m^3 F +ACT_SOMN_TO_SLO_SOMN - decomp. of active soil organic N to slow soil organic ma N gN/m^2 F +ACT_SOMN_TO_SLO_SOMN_vr levdcmp decomp. of active soil organic N to slow soil organic ma N gN/m^3 F +ACT_SOMN_vr levdcmp ACT_SOM N (vertically resolved) gN/m^3 T +ACT_SOM_HR_S2 - Het. Resp. from active soil organic gC/m^2/s F +ACT_SOM_HR_S2_vr levdcmp Het. Resp. from active soil organic gC/m^3/s F +ACT_SOM_HR_S3 - Het. Resp. from active soil organic gC/m^2/s F +ACT_SOM_HR_S3_vr levdcmp Het. Resp. from active soil organic gC/m^3/s F +AGLB - Aboveground leaf biomass kg/m^2 F +AGNPP - aboveground NPP gC/m^2/s T +AGSB - Aboveground stem biomass kg/m^2 F +ALBD numrad surface albedo (direct) proportion F +ALBGRD numrad ground albedo (direct) proportion F +ALBGRI numrad ground albedo (indirect) proportion F +ALBI numrad surface albedo (indirect) proportion F +ALPHA - alpha coefficient for VOC calc non F +ALT - current active layer thickness m T +ALTMAX - maximum annual active layer thickness m T +ALTMAX_LASTYEAR - maximum prior year active layer thickness m F +ANNAVG_T2M - annual average 2m air temperature K F +ANNMAX_RETRANSN - annual max of retranslocated N pool gN/m^2 F +ANNSUM_COUNTER - seconds since last annual accumulator turnover s F +ANNSUM_NPP - annual sum of NPP gC/m^2/yr F +ANNSUM_POTENTIAL_GPP - annual sum of potential GPP gN/m^2/yr F +AR - autotrophic respiration (MR + GR) gC/m^2/s T +ATM_O3 - atmospheric ozone partial pressure mol/mol F +ATM_TOPO - atmospheric surface height m T +AVAILC - C flux available for allocation gC/m^2/s F +AVAIL_RETRANSN - N flux available from retranslocation pool gN/m^2/s F +AnnET - Annual ET mm/s F +BAF_CROP - fractional area burned for crop s-1 T +BAF_PEATF - fractional area burned in peatland s-1 T +BCDEP - total BC deposition (dry+wet) from atmosphere kg/m^2/s T +BETA - coefficient of convective velocity none F +BGLFR - background litterfall rate 1/s F +BGNPP - belowground NPP gC/m^2/s T +BGTR - background transfer growth rate 1/s F +BTRANMN - daily minimum of transpiration beta factor unitless T +CANNAVG_T2M - annual average of 2m air temperature K F +CANNSUM_NPP - annual sum of column-level NPP gC/m^2/s F +CEL_LITC - CEL_LIT C gC/m^2 T +CEL_LITC_1m - CEL_LIT C to 1 meter gC/m^2 F +CEL_LITC_TNDNCY_VERT_TRA levdcmp cellulosic litter C tendency due to vertical transport gC/m^3/s F +CEL_LITC_TO_ACT_SOMC - decomp. of cellulosic litter C to active soil organic C gC/m^2/s F +CEL_LITC_TO_ACT_SOMC_vr levdcmp decomp. of cellulosic litter C to active soil organic C gC/m^3/s F +CEL_LITC_vr levsoi CEL_LIT C (vertically resolved) gC/m^3 T +CEL_LITN - CEL_LIT N gN/m^2 T +CEL_LITN_1m - CEL_LIT N to 1 meter gN/m^2 F +CEL_LITN_TNDNCY_VERT_TRA levdcmp cellulosic litter N tendency due to vertical transport gN/m^3/s F +CEL_LITN_TO_ACT_SOMN - decomp. of cellulosic litter N to active soil organic N gN/m^2 F +CEL_LITN_TO_ACT_SOMN_vr levdcmp decomp. of cellulosic litter N to active soil organic N gN/m^3 F +CEL_LITN_vr levdcmp CEL_LIT N (vertically resolved) gN/m^3 T +CEL_LIT_HR - Het. Resp. from cellulosic litter gC/m^2/s F +CEL_LIT_HR_vr levdcmp Het. Resp. from cellulosic litter gC/m^3/s F +CGRND - deriv. of soil energy flux wrt to soil temp W/m^2/K F +CGRNDL - deriv. of soil latent heat flux wrt soil temp W/m^2/K F +CGRNDS - deriv. of soil sensible heat flux wrt soil temp W/m^2/K F +CH4PROD - Gridcell total production of CH4 gC/m2/s T +CH4_EBUL_TOTAL_SAT - ebullition surface CH4 flux; (+ to atm) mol/m2/s F +CH4_EBUL_TOTAL_UNSAT - ebullition surface CH4 flux; (+ to atm) mol/m2/s F +CH4_SURF_AERE_SAT - aerenchyma surface CH4 flux for inundated area; (+ to atm) mol/m2/s T +CH4_SURF_AERE_UNSAT - aerenchyma surface CH4 flux for non-inundated area; (+ to atm) mol/m2/s T +CH4_SURF_DIFF_SAT - diffusive surface CH4 flux for inundated / lake area; (+ to atm) mol/m2/s T +CH4_SURF_DIFF_UNSAT - diffusive surface CH4 flux for non-inundated area; (+ to atm) mol/m2/s T +CH4_SURF_EBUL_SAT - ebullition surface CH4 flux for inundated / lake area; (+ to atm) mol/m2/s T +CH4_SURF_EBUL_UNSAT - ebullition surface CH4 flux for non-inundated area; (+ to atm) mol/m2/s T +COL_CTRUNC - column-level sink for C truncation gC/m^2 F +COL_FIRE_CLOSS - total column-level fire C loss for non-peat fires outside land-type converted region gC/m^2/s T +COL_FIRE_NLOSS - total column-level fire N loss gN/m^2/s T +COL_NTRUNC - column-level sink for N truncation gN/m^2 F +CONC_CH4_SAT levgrnd CH4 soil Concentration for inundated / lake area mol/m3 F +CONC_CH4_UNSAT levgrnd CH4 soil Concentration for non-inundated area mol/m3 F +CONC_O2_SAT levsoi O2 soil Concentration for inundated / lake area mol/m3 T +CONC_O2_UNSAT levsoi O2 soil Concentration for non-inundated area mol/m3 T +COST_NACTIVE - Cost of active uptake gN/gC T +COST_NFIX - Cost of fixation gN/gC T +COST_NRETRANS - Cost of retranslocation gN/gC T +COSZEN - cosine of solar zenith angle none F +CPHASE - crop phenology phase 0-not planted, 1-planted, 2-leaf emerge, 3-grain fill, 4-harvest T +CPOOL - temporary photosynthate C pool gC/m^2 T +CPOOL_DEADCROOT_GR - dead coarse root growth respiration gC/m^2/s F +CPOOL_DEADCROOT_STORAGE_GR - dead coarse root growth respiration to storage gC/m^2/s F +CPOOL_DEADSTEM_GR - dead stem growth respiration gC/m^2/s F +CPOOL_DEADSTEM_STORAGE_GR - dead stem growth respiration to storage gC/m^2/s F +CPOOL_FROOT_GR - fine root growth respiration gC/m^2/s F +CPOOL_FROOT_STORAGE_GR - fine root growth respiration to storage gC/m^2/s F +CPOOL_LEAF_GR - leaf growth respiration gC/m^2/s F +CPOOL_LEAF_STORAGE_GR - leaf growth respiration to storage gC/m^2/s F +CPOOL_LIVECROOT_GR - live coarse root growth respiration gC/m^2/s F +CPOOL_LIVECROOT_STORAGE_GR - live coarse root growth respiration to storage gC/m^2/s F +CPOOL_LIVESTEM_GR - live stem growth respiration gC/m^2/s F +CPOOL_LIVESTEM_STORAGE_GR - live stem growth respiration to storage gC/m^2/s F +CPOOL_TO_DEADCROOTC - allocation to dead coarse root C gC/m^2/s F +CPOOL_TO_DEADCROOTC_STORAGE - allocation to dead coarse root C storage gC/m^2/s F +CPOOL_TO_DEADSTEMC - allocation to dead stem C gC/m^2/s F +CPOOL_TO_DEADSTEMC_STORAGE - allocation to dead stem C storage gC/m^2/s F +CPOOL_TO_FROOTC - allocation to fine root C gC/m^2/s F +CPOOL_TO_FROOTC_STORAGE - allocation to fine root C storage gC/m^2/s F +CPOOL_TO_GRESP_STORAGE - allocation to growth respiration storage gC/m^2/s F +CPOOL_TO_LEAFC - allocation to leaf C gC/m^2/s F +CPOOL_TO_LEAFC_STORAGE - allocation to leaf C storage gC/m^2/s F +CPOOL_TO_LIVECROOTC - allocation to live coarse root C gC/m^2/s F +CPOOL_TO_LIVECROOTC_STORAGE - allocation to live coarse root C storage gC/m^2/s F +CPOOL_TO_LIVESTEMC - allocation to live stem C gC/m^2/s F +CPOOL_TO_LIVESTEMC_STORAGE - allocation to live stem C storage gC/m^2/s F +CROOT_PROF levdcmp profile for litter C and N inputs from coarse roots 1/m F +CROPPROD1C - 1-yr crop product (grain+biofuel) C gC/m^2 T +CROPPROD1C_LOSS - loss from 1-yr crop product pool gC/m^2/s T +CROPPROD1N - 1-yr crop product (grain+biofuel) N gN/m^2 T +CROPPROD1N_LOSS - loss from 1-yr crop product pool gN/m^2/s T +CROPSEEDC_DEFICIT - C used for crop seed that needs to be repaid gC/m^2 T +CROPSEEDN_DEFICIT - N used for crop seed that needs to be repaid gN/m^2 F +CROP_SEEDC_TO_LEAF - crop seed source to leaf gC/m^2/s F +CROP_SEEDN_TO_LEAF - crop seed source to leaf gN/m^2/s F +CURRENT_GR - growth resp for new growth displayed in this timestep gC/m^2/s F +CWDC - CWD C gC/m^2 T +CWDC_1m - CWD C to 1 meter gC/m^2 F +CWDC_HR - cwd C heterotrophic respiration gC/m^2/s T +CWDC_LOSS - coarse woody debris C loss gC/m^2/s T +CWDC_TO_CEL_LITC - decomp. of coarse woody debris C to cellulosic litter C gC/m^2/s F +CWDC_TO_CEL_LITC_vr levdcmp decomp. of coarse woody debris C to cellulosic litter C gC/m^3/s F +CWDC_TO_LIG_LITC - decomp. of coarse woody debris C to lignin litter C gC/m^2/s F +CWDC_TO_LIG_LITC_vr levdcmp decomp. of coarse woody debris C to lignin litter C gC/m^3/s F +CWDC_vr levsoi CWD C (vertically resolved) gC/m^3 T +CWDN - CWD N gN/m^2 T +CWDN_1m - CWD N to 1 meter gN/m^2 F +CWDN_TO_CEL_LITN - decomp. of coarse woody debris N to cellulosic litter N gN/m^2 F +CWDN_TO_CEL_LITN_vr levdcmp decomp. of coarse woody debris N to cellulosic litter N gN/m^3 F +CWDN_TO_LIG_LITN - decomp. of coarse woody debris N to lignin litter N gN/m^2 F +CWDN_TO_LIG_LITN_vr levdcmp decomp. of coarse woody debris N to lignin litter N gN/m^3 F +CWDN_vr levdcmp CWD N (vertically resolved) gN/m^3 T +CWD_HR_L2 - Het. Resp. from coarse woody debris gC/m^2/s F +CWD_HR_L2_vr levdcmp Het. Resp. from coarse woody debris gC/m^3/s F +CWD_HR_L3 - Het. Resp. from coarse woody debris gC/m^2/s F +CWD_HR_L3_vr levdcmp Het. Resp. from coarse woody debris gC/m^3/s F +CWD_PATHFRAC_L2_vr levdcmp PATHFRAC from coarse woody debris to cellulosic litter fraction F +CWD_PATHFRAC_L3_vr levdcmp PATHFRAC from coarse woody debris to lignin litter fraction F +CWD_RESP_FRAC_L2_vr levdcmp respired from coarse woody debris to cellulosic litter fraction F +CWD_RESP_FRAC_L3_vr levdcmp respired from coarse woody debris to lignin litter fraction F +C_ALLOMETRY - C allocation index none F +DAYL - daylength s F +DAYS_ACTIVE - number of days since last dormancy days F +DEADCROOTC - dead coarse root C gC/m^2 T +DEADCROOTC_STORAGE - dead coarse root C storage gC/m^2 F +DEADCROOTC_STORAGE_TO_XFER - dead coarse root C shift storage to transfer gC/m^2/s F +DEADCROOTC_XFER - dead coarse root C transfer gC/m^2 F +DEADCROOTC_XFER_TO_DEADCROOTC - dead coarse root C growth from storage gC/m^2/s F +DEADCROOTN - dead coarse root N gN/m^2 T +DEADCROOTN_STORAGE - dead coarse root N storage gN/m^2 F +DEADCROOTN_STORAGE_TO_XFER - dead coarse root N shift storage to transfer gN/m^2/s F +DEADCROOTN_XFER - dead coarse root N transfer gN/m^2 F +DEADCROOTN_XFER_TO_DEADCROOTN - dead coarse root N growth from storage gN/m^2/s F +DEADSTEMC - dead stem C gC/m^2 T +DEADSTEMC_STORAGE - dead stem C storage gC/m^2 F +DEADSTEMC_STORAGE_TO_XFER - dead stem C shift storage to transfer gC/m^2/s F +DEADSTEMC_XFER - dead stem C transfer gC/m^2 F +DEADSTEMC_XFER_TO_DEADSTEMC - dead stem C growth from storage gC/m^2/s F +DEADSTEMN - dead stem N gN/m^2 T +DEADSTEMN_STORAGE - dead stem N storage gN/m^2 F +DEADSTEMN_STORAGE_TO_XFER - dead stem N shift storage to transfer gN/m^2/s F +DEADSTEMN_XFER - dead stem N transfer gN/m^2 F +DEADSTEMN_XFER_TO_DEADSTEMN - dead stem N growth from storage gN/m^2/s F +DENIT - total rate of denitrification gN/m^2/s T +DGNETDT - derivative of net ground heat flux wrt soil temp W/m^2/K F +DISPLA - displacement height (vegetated landunits only) m F +DISPVEGC - displayed veg carbon, excluding storage and cpool gC/m^2 T +DISPVEGN - displayed vegetation nitrogen gN/m^2 T +DLRAD - downward longwave radiation below the canopy W/m^2 F +DORMANT_FLAG - dormancy flag none F +DOWNREG - fractional reduction in GPP due to N limitation proportion F +DPVLTRB1 - turbulent deposition velocity 1 m/s F +DPVLTRB2 - turbulent deposition velocity 2 m/s F +DPVLTRB3 - turbulent deposition velocity 3 m/s F +DPVLTRB4 - turbulent deposition velocity 4 m/s F +DSL - dry surface layer thickness mm T +DSTDEP - total dust deposition (dry+wet) from atmosphere kg/m^2/s T +DSTFLXT - total surface dust emission kg/m2/s T +DT_VEG - change in t_veg, last iteration K F +DWT_CONV_CFLUX - conversion C flux (immediate loss to atm) (0 at all times except first timestep of year) gC/m^2/s T +DWT_CONV_CFLUX_DRIBBLED - conversion C flux (immediate loss to atm), dribbled throughout the year gC/m^2/s T +DWT_CONV_CFLUX_PATCH - patch-level conversion C flux (immediate loss to atm) (0 at all times except first timestep of gC/m^2/s F +DWT_CONV_NFLUX - conversion N flux (immediate loss to atm) (0 at all times except first timestep of year) gN/m^2/s T +DWT_CONV_NFLUX_PATCH - patch-level conversion N flux (immediate loss to atm) (0 at all times except first timestep of gN/m^2/s F +DWT_CROPPROD1C_GAIN - landcover change-driven addition to 1-year crop product pool gC/m^2/s T +DWT_CROPPROD1N_GAIN - landcover change-driven addition to 1-year crop product pool gN/m^2/s T +DWT_DEADCROOTC_TO_CWDC levdcmp dead coarse root to CWD due to landcover change gC/m^2/s F +DWT_DEADCROOTN_TO_CWDN levdcmp dead coarse root to CWD due to landcover change gN/m^2/s F +DWT_FROOTC_TO_CEL_LIT_C levdcmp fine root to cellulosic litter due to landcover change gC/m^2/s F +DWT_FROOTC_TO_LIG_LIT_C levdcmp fine root to lignin litter due to landcover change gC/m^2/s F +DWT_FROOTC_TO_MET_LIT_C levdcmp fine root to metabolic litter due to landcover change gC/m^2/s F +DWT_FROOTN_TO_CEL_LIT_N levdcmp fine root N to cellulosic litter due to landcover change gN/m^2/s F +DWT_FROOTN_TO_LIG_LIT_N levdcmp fine root N to lignin litter due to landcover change gN/m^2/s F +DWT_FROOTN_TO_MET_LIT_N levdcmp fine root N to metabolic litter due to landcover change gN/m^2/s F +DWT_LIVECROOTC_TO_CWDC levdcmp live coarse root to CWD due to landcover change gC/m^2/s F +DWT_LIVECROOTN_TO_CWDN levdcmp live coarse root to CWD due to landcover change gN/m^2/s F +DWT_PROD100C_GAIN - landcover change-driven addition to 100-yr wood product pool gC/m^2/s F +DWT_PROD100N_GAIN - landcover change-driven addition to 100-yr wood product pool gN/m^2/s F +DWT_PROD10C_GAIN - landcover change-driven addition to 10-yr wood product pool gC/m^2/s F +DWT_PROD10N_GAIN - landcover change-driven addition to 10-yr wood product pool gN/m^2/s F +DWT_SEEDC_TO_DEADSTEM - seed source to patch-level deadstem gC/m^2/s F +DWT_SEEDC_TO_DEADSTEM_PATCH - patch-level seed source to patch-level deadstem (per-area-gridcell; only makes sense with dov2 gC/m^2/s F +DWT_SEEDC_TO_LEAF - seed source to patch-level leaf gC/m^2/s F +DWT_SEEDC_TO_LEAF_PATCH - patch-level seed source to patch-level leaf (per-area-gridcell; only makes sense with dov2xy=. gC/m^2/s F +DWT_SEEDN_TO_DEADSTEM - seed source to patch-level deadstem gN/m^2/s T +DWT_SEEDN_TO_DEADSTEM_PATCH - patch-level seed source to patch-level deadstem (per-area-gridcell; only makes sense with dov2 gN/m^2/s F +DWT_SEEDN_TO_LEAF - seed source to patch-level leaf gN/m^2/s T +DWT_SEEDN_TO_LEAF_PATCH - patch-level seed source to patch-level leaf (per-area-gridcell; only makes sense with dov2xy=. gN/m^2/s F +DWT_SLASH_CFLUX - slash C flux (to litter diagnostic only) (0 at all times except first timestep of year) gC/m^2/s T +DWT_SLASH_CFLUX_PATCH - patch-level slash C flux (to litter diagnostic only) (0 at all times except first timestep of gC/m^2/s F +DWT_WOODPRODC_GAIN - landcover change-driven addition to wood product pools gC/m^2/s T +DWT_WOODPRODN_GAIN - landcover change-driven addition to wood product pools gN/m^2/s T +DWT_WOOD_PRODUCTC_GAIN_PATCH - patch-level landcover change-driven addition to wood product pools(0 at all times except first gC/m^2/s F +DYN_COL_ADJUSTMENTS_CH4 - Adjustments in ch4 due to dynamic column areas; only makes sense at the column level: should n gC/m^2 F +DYN_COL_SOIL_ADJUSTMENTS_C - Adjustments in soil carbon due to dynamic column areas; only makes sense at the column level: gC/m^2 F +DYN_COL_SOIL_ADJUSTMENTS_N - Adjustments in soil nitrogen due to dynamic column areas; only makes sense at the column level gN/m^2 F +DYN_COL_SOIL_ADJUSTMENTS_NH4 - Adjustments in soil NH4 due to dynamic column areas; only makes sense at the column level: sho gN/m^2 F +DYN_COL_SOIL_ADJUSTMENTS_NO3 - Adjustments in soil NO3 due to dynamic column areas; only makes sense at the column level: sho gN/m^2 F +EFF_POROSITY levgrnd effective porosity = porosity - vol_ice proportion F +EFLXBUILD - building heat flux from change in interior building air temperature W/m^2 T +EFLX_DYNBAL - dynamic land cover change conversion energy flux W/m^2 T +EFLX_GNET - net heat flux into ground W/m^2 F +EFLX_GRND_LAKE - net heat flux into lake/snow surface, excluding light transmission W/m^2 T +EFLX_LH_TOT - total latent heat flux [+ to atm] W/m^2 T +EFLX_LH_TOT_ICE - total latent heat flux [+ to atm] (ice landunits only) W/m^2 F +EFLX_LH_TOT_R - Rural total evaporation W/m^2 T +EFLX_LH_TOT_U - Urban total evaporation W/m^2 F +EFLX_SOIL_GRND - soil heat flux [+ into soil] W/m^2 F +ELAI - exposed one-sided leaf area index m^2/m^2 T +EMG - ground emissivity proportion F +EMV - vegetation emissivity proportion F +EOPT - Eopt coefficient for VOC calc non F +ER - total ecosystem respiration, autotrophic + heterotrophic gC/m^2/s T +ERRH2O - total water conservation error mm T +ERRH2OSNO - imbalance in snow depth (liquid water) mm T +ERRSEB - surface energy conservation error W/m^2 T +ERRSOI - soil/lake energy conservation error W/m^2 T +ERRSOL - solar radiation conservation error W/m^2 T +ESAI - exposed one-sided stem area index m^2/m^2 T +EXCESSC_MR - excess C maintenance respiration gC/m^2/s F +EXCESS_CFLUX - C flux not allocated due to downregulation gC/m^2/s F +FAREA_BURNED - timestep fractional area burned s-1 T +FCANSNO - fraction of canopy that is wet proportion F +FCEV - canopy evaporation W/m^2 T +FCH4 - Gridcell surface CH4 flux to atmosphere (+ to atm) kgC/m2/s T +FCH4TOCO2 - Gridcell oxidation of CH4 to CO2 gC/m2/s T +FCH4_DFSAT - CH4 additional flux due to changing fsat, natural vegetated and crop landunits only kgC/m2/s T +FCO2 - CO2 flux to atmosphere (+ to atm) kgCO2/m2/s F +FCOV - fractional impermeable area unitless T +FCTR - canopy transpiration W/m^2 T +FDRY - fraction of foliage that is green and dry proportion F +FERTNITRO - Nitrogen fertilizer for each crop gN/m2/yr F +FERT_COUNTER - time left to fertilize seconds F +FERT_TO_SMINN - fertilizer to soil mineral N gN/m^2/s F +FFIX_TO_SMINN - free living N fixation to soil mineral N gN/m^2/s T +FGEV - ground evaporation W/m^2 T +FGR - heat flux into soil/snow including snow melt and lake / snow light transmission W/m^2 T +FGR12 - heat flux between soil layers 1 and 2 W/m^2 T +FGR_ICE - heat flux into soil/snow including snow melt and lake / snow light transmission (ice landunits W/m^2 F +FGR_R - Rural heat flux into soil/snow including snow melt and snow light transmission W/m^2 F +FGR_SOIL_R levgrnd Rural downward heat flux at interface below each soil layer watt/m^2 F +FGR_U - Urban heat flux into soil/snow including snow melt W/m^2 F +FH2OSFC - fraction of ground covered by surface water unitless T +FH2OSFC_NOSNOW - fraction of ground covered by surface water (if no snow present) unitless F +FINUNDATED - fractional inundated area of vegetated columns unitless T +FINUNDATED_LAG - time-lagged inundated fraction of vegetated columns unitless F +FIRA - net infrared (longwave) radiation W/m^2 T +FIRA_ICE - net infrared (longwave) radiation (ice landunits only) W/m^2 F +FIRA_R - Rural net infrared (longwave) radiation W/m^2 T +FIRA_U - Urban net infrared (longwave) radiation W/m^2 F +FIRE - emitted infrared (longwave) radiation W/m^2 T +FIRE_ICE - emitted infrared (longwave) radiation (ice landunits only) W/m^2 F +FIRE_R - Rural emitted infrared (longwave) radiation W/m^2 T +FIRE_U - Urban emitted infrared (longwave) radiation W/m^2 F +FLDS - atmospheric longwave radiation (downscaled to columns in glacier regions) W/m^2 T +FLDS_ICE - atmospheric longwave radiation (downscaled to columns in glacier regions) (ice landunits only) W/m^2 F +FMAX_DENIT_CARBONSUBSTRATE levdcmp FMAX_DENIT_CARBONSUBSTRATE gN/m^3/s F +FMAX_DENIT_NITRATE levdcmp FMAX_DENIT_NITRATE gN/m^3/s F +FPI - fraction of potential immobilization proportion T +FPI_vr levdcmp fraction of potential immobilization proportion F +FPSN - photosynthesis umol m-2 s-1 T +FPSN24 - 24 hour accumulative patch photosynthesis starting from mid-night umol CO2/m^2 ground/day F +FPSN_WC - Rubisco-limited photosynthesis umol m-2 s-1 F +FPSN_WJ - RuBP-limited photosynthesis umol m-2 s-1 F +FPSN_WP - Product-limited photosynthesis umol m-2 s-1 F +FRAC_ICEOLD levgrnd fraction of ice relative to the tot water proportion F +FREE_RETRANSN_TO_NPOOL - deployment of retranslocated N gN/m^2/s T +FROOTC - fine root C gC/m^2 T +FROOTC_ALLOC - fine root C allocation gC/m^2/s T +FROOTC_LOSS - fine root C loss gC/m^2/s T +FROOTC_STORAGE - fine root C storage gC/m^2 F +FROOTC_STORAGE_TO_XFER - fine root C shift storage to transfer gC/m^2/s F +FROOTC_TO_LITTER - fine root C litterfall gC/m^2/s F +FROOTC_XFER - fine root C transfer gC/m^2 F +FROOTC_XFER_TO_FROOTC - fine root C growth from storage gC/m^2/s F +FROOTN - fine root N gN/m^2 T +FROOTN_STORAGE - fine root N storage gN/m^2 F +FROOTN_STORAGE_TO_XFER - fine root N shift storage to transfer gN/m^2/s F +FROOTN_TO_LITTER - fine root N litterfall gN/m^2/s F +FROOTN_XFER - fine root N transfer gN/m^2 F +FROOTN_XFER_TO_FROOTN - fine root N growth from storage gN/m^2/s F +FROOT_MR - fine root maintenance respiration gC/m^2/s F +FROOT_PROF levdcmp profile for litter C and N inputs from fine roots 1/m F +FROST_TABLE - frost table depth (natural vegetated and crop landunits only) m F +FSA - absorbed solar radiation W/m^2 T +FSAT - fractional area with water table at surface unitless T +FSA_ICE - absorbed solar radiation (ice landunits only) W/m^2 F +FSA_R - Rural absorbed solar radiation W/m^2 F +FSA_U - Urban absorbed solar radiation W/m^2 F +FSD24 - direct radiation (last 24hrs) K F +FSD240 - direct radiation (last 240hrs) K F +FSDS - atmospheric incident solar radiation W/m^2 T +FSDSND - direct nir incident solar radiation W/m^2 T +FSDSNDLN - direct nir incident solar radiation at local noon W/m^2 T +FSDSNI - diffuse nir incident solar radiation W/m^2 T +FSDSVD - direct vis incident solar radiation W/m^2 T +FSDSVDLN - direct vis incident solar radiation at local noon W/m^2 T +FSDSVI - diffuse vis incident solar radiation W/m^2 T +FSDSVILN - diffuse vis incident solar radiation at local noon W/m^2 T +FSH - sensible heat not including correction for land use change and rain/snow conversion W/m^2 T +FSH_G - sensible heat from ground W/m^2 T +FSH_ICE - sensible heat not including correction for land use change and rain/snow conversion (ice landu W/m^2 F +FSH_PRECIP_CONVERSION - Sensible heat flux from conversion of rain/snow atm forcing W/m^2 T +FSH_R - Rural sensible heat W/m^2 T +FSH_RUNOFF_ICE_TO_LIQ - sensible heat flux generated from conversion of ice runoff to liquid W/m^2 T +FSH_TO_COUPLER - sensible heat sent to coupler (includes corrections for land use change, rain/snow conversion W/m^2 T +FSH_U - Urban sensible heat W/m^2 F +FSH_V - sensible heat from veg W/m^2 T +FSI24 - indirect radiation (last 24hrs) K F +FSI240 - indirect radiation (last 240hrs) K F +FSM - snow melt heat flux W/m^2 T +FSM_ICE - snow melt heat flux (ice landunits only) W/m^2 F +FSM_R - Rural snow melt heat flux W/m^2 F +FSM_U - Urban snow melt heat flux W/m^2 F +FSNO - fraction of ground covered by snow unitless T +FSNO_EFF - effective fraction of ground covered by snow unitless T +FSNO_ICE - fraction of ground covered by snow (ice landunits only) unitless F +FSR - reflected solar radiation W/m^2 T +FSRND - direct nir reflected solar radiation W/m^2 T +FSRNDLN - direct nir reflected solar radiation at local noon W/m^2 T +FSRNI - diffuse nir reflected solar radiation W/m^2 T +FSRVD - direct vis reflected solar radiation W/m^2 T +FSRVDLN - direct vis reflected solar radiation at local noon W/m^2 T +FSRVI - diffuse vis reflected solar radiation W/m^2 T +FSR_ICE - reflected solar radiation (ice landunits only) W/m^2 F +FSUN - sunlit fraction of canopy proportion F +FSUN24 - fraction sunlit (last 24hrs) K F +FSUN240 - fraction sunlit (last 240hrs) K F +FUELC - fuel load gC/m^2 T +FV - friction velocity m/s T +FWET - fraction of canopy that is wet proportion F +F_DENIT - denitrification flux gN/m^2/s T +F_DENIT_BASE levdcmp F_DENIT_BASE gN/m^3/s F +F_DENIT_vr levdcmp denitrification flux gN/m^3/s F +F_N2O_DENIT - denitrification N2O flux gN/m^2/s T +F_N2O_NIT - nitrification N2O flux gN/m^2/s T +F_NIT - nitrification flux gN/m^2/s T +F_NIT_vr levdcmp nitrification flux gN/m^3/s F +GAMMA - total gamma for VOC calc non F +GAMMAA - gamma A for VOC calc non F +GAMMAC - gamma C for VOC calc non F +GAMMAL - gamma L for VOC calc non F +GAMMAP - gamma P for VOC calc non F +GAMMAS - gamma S for VOC calc non F +GAMMAT - gamma T for VOC calc non F +GDD0 - Growing degree days base 0C from planting ddays F +GDD020 - Twenty year average of growing degree days base 0C from planting ddays F +GDD10 - Growing degree days base 10C from planting ddays F +GDD1020 - Twenty year average of growing degree days base 10C from planting ddays F +GDD8 - Growing degree days base 8C from planting ddays F +GDD820 - Twenty year average of growing degree days base 8C from planting ddays F +GDDACCUM - Accumulated growing degree days past planting date for crop ddays F +GDDACCUM_PERHARV mxharvests At-harvest accumulated growing degree days past planting date for crop; should only be output ddays F +GDDHARV - Growing degree days (gdd) needed to harvest ddays F +GDDHARV_PERHARV mxharvests Growing degree days (gdd) needed to harvest; should only be output annually ddays F +GDDTSOI - Growing degree-days from planting (top two soil layers) ddays F +GPP - gross primary production gC/m^2/s T +GR - total growth respiration gC/m^2/s T +GRAINC - grain C (does not equal yield) gC/m^2 T +GRAINC_TO_FOOD - grain C to food gC/m^2/s T +GRAINC_TO_FOOD_ANN - grain C to food harvested per calendar year; should only be output annually gC/m^2 F +GRAINC_TO_FOOD_PERHARV mxharvests grain C to food per harvest; should only be output annually gC/m^2 F +GRAINC_TO_SEED - grain C to seed gC/m^2/s T +GRAINN - grain N gN/m^2 T +GRESP_STORAGE - growth respiration storage gC/m^2 F +GRESP_STORAGE_TO_XFER - growth respiration shift storage to transfer gC/m^2/s F +GRESP_XFER - growth respiration transfer gC/m^2 F +GROSS_NMIN - gross rate of N mineralization gN/m^2/s T +GROSS_NMIN_vr levdcmp gross rate of N mineralization gN/m^3/s F +GRU_PROD100C_GAIN - gross unrepresented landcover change addition to 100-yr wood product pool gC/m^2/s F +GRU_PROD100N_GAIN - gross unrepresented landcover change addition to 100-yr wood product pool gN/m^2/s F +GRU_PROD10C_GAIN - gross unrepresented landcover change addition to 10-yr wood product pool gC/m^2/s F +GRU_PROD10N_GAIN - gross unrepresented landcover change addition to 10-yr wood product pool gN/m^2/s F +GSSHA - shaded leaf stomatal conductance umol H20/m2/s T +GSSHALN - shaded leaf stomatal conductance at local noon umol H20/m2/s T +GSSUN - sunlit leaf stomatal conductance umol H20/m2/s T +GSSUNLN - sunlit leaf stomatal conductance at local noon umol H20/m2/s T +H2OCAN - intercepted water mm T +H2OSFC - surface water depth mm T +H2OSNO - snow depth (liquid water) mm T +H2OSNO_ICE - snow depth (liquid water, ice landunits only) mm F +H2OSNO_TOP - mass of snow in top snow layer kg/m2 T +H2OSOI levsoi volumetric soil water (natural vegetated and crop landunits only) mm3/mm3 T +HARVEST_REASON_PERHARV mxharvests Reason for each crop harvest; should only be output annually 1 = mature; 2 = max season length; 3 = incorrect Dec. 31 sowing; F +HBOT - canopy bottom m F +HDATES mxharvests actual crop harvest dates; should only be output annually day of year F +HEAT_CONTENT1 - initial gridcell total heat content J/m^2 T +HEAT_CONTENT1_VEG - initial gridcell total heat content - natural vegetated and crop landunits only J/m^2 F +HEAT_CONTENT2 - post land cover change total heat content J/m^2 F +HEAT_FROM_AC - sensible heat flux put into canyon due to heat removed from air conditioning W/m^2 T +HIA - 2 m NWS Heat Index C T +HIA_R - Rural 2 m NWS Heat Index C T +HIA_U - Urban 2 m NWS Heat Index C T +HK levgrnd hydraulic conductivity (natural vegetated and crop landunits only) mm/s F +HR - total heterotrophic respiration gC/m^2/s T +HR_vr levsoi total vertically resolved heterotrophic respiration gC/m^3/s T +HTOP - canopy top m T +HUI - Crop patch heat unit index ddays F +HUI_PERHARV mxharvests At-harvest accumulated heat unit index for crop; should only be output annually ddays F +HUMIDEX - 2 m Humidex C T +HUMIDEX_R - Rural 2 m Humidex C T +HUMIDEX_U - Urban 2 m Humidex C T +ICE_CONTENT1 - initial gridcell total ice content mm T +ICE_CONTENT2 - post land cover change total ice content mm F +ICE_MODEL_FRACTION - Ice sheet model fractional coverage unitless F +INIT_GPP - GPP flux before downregulation gC/m^2/s F +INT_SNOW - accumulated swe (natural vegetated and crop landunits only) mm F +INT_SNOW_ICE - accumulated swe (ice landunits only) mm F +IWUELN - local noon intrinsic water use efficiency umolCO2/molH2O T +JMX25T - canopy profile of jmax umol/m2/s T +Jmx25Z - maximum rate of electron transport at 25 Celcius for canopy layers umol electrons/m2/s T +KROOT levsoi root conductance each soil layer 1/s F +KSOIL levsoi soil conductance in each soil layer 1/s F +K_ACT_SOM levdcmp active soil organic potential loss coefficient 1/s F +K_CEL_LIT levdcmp cellulosic litter potential loss coefficient 1/s F +K_CWD levdcmp coarse woody debris potential loss coefficient 1/s F +K_LIG_LIT levdcmp lignin litter potential loss coefficient 1/s F +K_MET_LIT levdcmp metabolic litter potential loss coefficient 1/s F +K_NITR levdcmp K_NITR 1/s F +K_NITR_H2O levdcmp K_NITR_H2O unitless F +K_NITR_PH levdcmp K_NITR_PH unitless F +K_NITR_T levdcmp K_NITR_T unitless F +K_PAS_SOM levdcmp passive soil organic potential loss coefficient 1/s F +K_SLO_SOM levdcmp slow soil organic ma potential loss coefficient 1/s F +L1_PATHFRAC_S1_vr levdcmp PATHFRAC from metabolic litter to active soil organic fraction F +L1_RESP_FRAC_S1_vr levdcmp respired from metabolic litter to active soil organic fraction F +L2_PATHFRAC_S1_vr levdcmp PATHFRAC from cellulosic litter to active soil organic fraction F +L2_RESP_FRAC_S1_vr levdcmp respired from cellulosic litter to active soil organic fraction F +L3_PATHFRAC_S2_vr levdcmp PATHFRAC from lignin litter to slow soil organic ma fraction F +L3_RESP_FRAC_S2_vr levdcmp respired from lignin litter to slow soil organic ma fraction F +LAI240 - 240hr average of leaf area index m^2/m^2 F +LAISHA - shaded projected leaf area index m^2/m^2 T +LAISUN - sunlit projected leaf area index m^2/m^2 T +LAKEICEFRAC levlak lake layer ice mass fraction unitless F +LAKEICEFRAC_SURF - surface lake layer ice mass fraction unitless T +LAKEICETHICK - thickness of lake ice (including physical expansion on freezing) m T +LAND_USE_FLUX - total C emitted from land cover conversion (smoothed over the year) and wood and grain product gC/m^2/s T +LATBASET - latitude vary base temperature for hui degree C F +LEAFC - leaf C gC/m^2 T +LEAFCN - Leaf CN ratio used for flexible CN gC/gN T +LEAFCN_OFFSET - Leaf C:N used by FUN unitless F +LEAFCN_STORAGE - Storage Leaf CN ratio used for flexible CN gC/gN F +LEAFC_ALLOC - leaf C allocation gC/m^2/s T +LEAFC_CHANGE - C change in leaf gC/m^2/s T +LEAFC_LOSS - leaf C loss gC/m^2/s T +LEAFC_STORAGE - leaf C storage gC/m^2 F +LEAFC_STORAGE_TO_XFER - leaf C shift storage to transfer gC/m^2/s F +LEAFC_STORAGE_XFER_ACC - Accumulated leaf C transfer gC/m^2 F +LEAFC_TO_BIOFUELC - leaf C to biofuel C gC/m^2/s T +LEAFC_TO_LITTER - leaf C litterfall gC/m^2/s F +LEAFC_TO_LITTER_FUN - leaf C litterfall used by FUN gC/m^2/s T +LEAFC_XFER - leaf C transfer gC/m^2 F +LEAFC_XFER_TO_LEAFC - leaf C growth from storage gC/m^2/s F +LEAFN - leaf N gN/m^2 T +LEAFN_STORAGE - leaf N storage gN/m^2 F +LEAFN_STORAGE_TO_XFER - leaf N shift storage to transfer gN/m^2/s F +LEAFN_STORAGE_XFER_ACC - Accmulated leaf N transfer gN/m^2 F +LEAFN_TO_LITTER - leaf N litterfall gN/m^2/s T +LEAFN_TO_RETRANSN - leaf N to retranslocated N pool gN/m^2/s F +LEAFN_XFER - leaf N transfer gN/m^2 F +LEAFN_XFER_TO_LEAFN - leaf N growth from storage gN/m^2/s F +LEAF_MR - leaf maintenance respiration gC/m^2/s T +LEAF_PROF levdcmp profile for litter C and N inputs from leaves 1/m F +LFC2 - conversion area fraction of BET and BDT that burned per sec T +LGSF - long growing season factor proportion F +LIG_LITC - LIG_LIT C gC/m^2 T +LIG_LITC_1m - LIG_LIT C to 1 meter gC/m^2 F +LIG_LITC_TNDNCY_VERT_TRA levdcmp lignin litter C tendency due to vertical transport gC/m^3/s F +LIG_LITC_TO_SLO_SOMC - decomp. of lignin litter C to slow soil organic ma C gC/m^2/s F +LIG_LITC_TO_SLO_SOMC_vr levdcmp decomp. of lignin litter C to slow soil organic ma C gC/m^3/s F +LIG_LITC_vr levsoi LIG_LIT C (vertically resolved) gC/m^3 T +LIG_LITN - LIG_LIT N gN/m^2 T +LIG_LITN_1m - LIG_LIT N to 1 meter gN/m^2 F +LIG_LITN_TNDNCY_VERT_TRA levdcmp lignin litter N tendency due to vertical transport gN/m^3/s F +LIG_LITN_TO_SLO_SOMN - decomp. of lignin litter N to slow soil organic ma N gN/m^2 F +LIG_LITN_TO_SLO_SOMN_vr levdcmp decomp. of lignin litter N to slow soil organic ma N gN/m^3 F +LIG_LITN_vr levdcmp LIG_LIT N (vertically resolved) gN/m^3 T +LIG_LIT_HR - Het. Resp. from lignin litter gC/m^2/s F +LIG_LIT_HR_vr levdcmp Het. Resp. from lignin litter gC/m^3/s F +LIQCAN - intercepted liquid water mm T +LIQUID_CONTENT1 - initial gridcell total liq content mm T +LIQUID_CONTENT2 - post landuse change gridcell total liq content mm F +LIQUID_WATER_TEMP1 - initial gridcell weighted average liquid water temperature K F +LITFALL - litterfall (leaves and fine roots) gC/m^2/s T +LITFIRE - litter fire losses gC/m^2/s F +LITTERC_HR - litter C heterotrophic respiration gC/m^2/s T +LITTERC_LOSS - litter C loss gC/m^2/s T +LIVECROOTC - live coarse root C gC/m^2 T +LIVECROOTC_STORAGE - live coarse root C storage gC/m^2 F +LIVECROOTC_STORAGE_TO_XFER - live coarse root C shift storage to transfer gC/m^2/s F +LIVECROOTC_TO_DEADCROOTC - live coarse root C turnover gC/m^2/s F +LIVECROOTC_XFER - live coarse root C transfer gC/m^2 F +LIVECROOTC_XFER_TO_LIVECROOTC - live coarse root C growth from storage gC/m^2/s F +LIVECROOTN - live coarse root N gN/m^2 T +LIVECROOTN_STORAGE - live coarse root N storage gN/m^2 F +LIVECROOTN_STORAGE_TO_XFER - live coarse root N shift storage to transfer gN/m^2/s F +LIVECROOTN_TO_DEADCROOTN - live coarse root N turnover gN/m^2/s F +LIVECROOTN_TO_RETRANSN - live coarse root N to retranslocated N pool gN/m^2/s F +LIVECROOTN_XFER - live coarse root N transfer gN/m^2 F +LIVECROOTN_XFER_TO_LIVECROOTN - live coarse root N growth from storage gN/m^2/s F +LIVECROOT_MR - live coarse root maintenance respiration gC/m^2/s F +LIVESTEMC - live stem C gC/m^2 T +LIVESTEMC_STORAGE - live stem C storage gC/m^2 F +LIVESTEMC_STORAGE_TO_XFER - live stem C shift storage to transfer gC/m^2/s F +LIVESTEMC_TO_BIOFUELC - livestem C to biofuel C gC/m^2/s T +LIVESTEMC_TO_DEADSTEMC - live stem C turnover gC/m^2/s F +LIVESTEMC_XFER - live stem C transfer gC/m^2 F +LIVESTEMC_XFER_TO_LIVESTEMC - live stem C growth from storage gC/m^2/s F +LIVESTEMN - live stem N gN/m^2 T +LIVESTEMN_STORAGE - live stem N storage gN/m^2 F +LIVESTEMN_STORAGE_TO_XFER - live stem N shift storage to transfer gN/m^2/s F +LIVESTEMN_TO_DEADSTEMN - live stem N turnover gN/m^2/s F +LIVESTEMN_TO_RETRANSN - live stem N to retranslocated N pool gN/m^2/s F +LIVESTEMN_XFER - live stem N transfer gN/m^2 F +LIVESTEMN_XFER_TO_LIVESTEMN - live stem N growth from storage gN/m^2/s F +LIVESTEM_MR - live stem maintenance respiration gC/m^2/s F +LNC - leaf N concentration gN leaf/m^2 T +LWdown - atmospheric longwave radiation (downscaled to columns in glacier regions) W/m^2 F +LWup - upwelling longwave radiation W/m^2 F +MEG_acetaldehyde - MEGAN flux kg/m2/sec T +MEG_acetic_acid - MEGAN flux kg/m2/sec T +MEG_acetone - MEGAN flux kg/m2/sec T +MEG_carene_3 - MEGAN flux kg/m2/sec T +MEG_ethanol - MEGAN flux kg/m2/sec T +MEG_formaldehyde - MEGAN flux kg/m2/sec T +MEG_isoprene - MEGAN flux kg/m2/sec T +MEG_methanol - MEGAN flux kg/m2/sec T +MEG_pinene_a - MEGAN flux kg/m2/sec T +MEG_thujene_a - MEGAN flux kg/m2/sec T +MET_LITC - MET_LIT C gC/m^2 T +MET_LITC_1m - MET_LIT C to 1 meter gC/m^2 F +MET_LITC_TNDNCY_VERT_TRA levdcmp metabolic litter C tendency due to vertical transport gC/m^3/s F +MET_LITC_TO_ACT_SOMC - decomp. of metabolic litter C to active soil organic C gC/m^2/s F +MET_LITC_TO_ACT_SOMC_vr levdcmp decomp. of metabolic litter C to active soil organic C gC/m^3/s F +MET_LITC_vr levsoi MET_LIT C (vertically resolved) gC/m^3 T +MET_LITN - MET_LIT N gN/m^2 T +MET_LITN_1m - MET_LIT N to 1 meter gN/m^2 F +MET_LITN_TNDNCY_VERT_TRA levdcmp metabolic litter N tendency due to vertical transport gN/m^3/s F +MET_LITN_TO_ACT_SOMN - decomp. of metabolic litter N to active soil organic N gN/m^2 F +MET_LITN_TO_ACT_SOMN_vr levdcmp decomp. of metabolic litter N to active soil organic N gN/m^3 F +MET_LITN_vr levdcmp MET_LIT N (vertically resolved) gN/m^3 T +MET_LIT_HR - Het. Resp. from metabolic litter gC/m^2/s F +MET_LIT_HR_vr levdcmp Het. Resp. from metabolic litter gC/m^3/s F +MR - maintenance respiration gC/m^2/s T +M_ACT_SOMC_TO_LEACHING - active soil organic C leaching loss gC/m^2/s F +M_ACT_SOMN_TO_LEACHING - active soil organic N leaching loss gN/m^2/s F +M_CEL_LITC_TO_FIRE - cellulosic litter C fire loss gC/m^2/s F +M_CEL_LITC_TO_FIRE_vr levdcmp cellulosic litter C fire loss gC/m^3/s F +M_CEL_LITC_TO_LEACHING - cellulosic litter C leaching loss gC/m^2/s F +M_CEL_LITN_TO_FIRE - cellulosic litter N fire loss gN/m^2 F +M_CEL_LITN_TO_FIRE_vr levdcmp cellulosic litter N fire loss gN/m^3 F +M_CEL_LITN_TO_LEACHING - cellulosic litter N leaching loss gN/m^2/s F +M_CWDC_TO_FIRE - coarse woody debris C fire loss gC/m^2/s F +M_CWDC_TO_FIRE_vr levdcmp coarse woody debris C fire loss gC/m^3/s F +M_CWDN_TO_FIRE - coarse woody debris N fire loss gN/m^2 F +M_CWDN_TO_FIRE_vr levdcmp coarse woody debris N fire loss gN/m^3 F +M_DEADCROOTC_STORAGE_TO_LITTER - dead coarse root C storage mortality gC/m^2/s F +M_DEADCROOTC_STORAGE_TO_LITTER_FIRE - dead coarse root C storage fire mortality to litter gC/m^2/s F +M_DEADCROOTC_TO_LITTER - dead coarse root C mortality gC/m^2/s F +M_DEADCROOTC_XFER_TO_LITTER - dead coarse root C transfer mortality gC/m^2/s F +M_DEADCROOTN_STORAGE_TO_FIRE - dead coarse root N storage fire loss gN/m^2/s F +M_DEADCROOTN_STORAGE_TO_LITTER - dead coarse root N storage mortality gN/m^2/s F +M_DEADCROOTN_TO_FIRE - dead coarse root N fire loss gN/m^2/s F +M_DEADCROOTN_TO_LITTER - dead coarse root N mortality gN/m^2/s F +M_DEADCROOTN_TO_LITTER_FIRE - dead coarse root N fire mortality to litter gN/m^2/s F +M_DEADCROOTN_XFER_TO_FIRE - dead coarse root N transfer fire loss gN/m^2/s F +M_DEADCROOTN_XFER_TO_LITTER - dead coarse root N transfer mortality gN/m^2/s F +M_DEADROOTC_STORAGE_TO_FIRE - dead root C storage fire loss gC/m^2/s F +M_DEADROOTC_STORAGE_TO_LITTER_FIRE - dead root C storage fire mortality to litter gC/m^2/s F +M_DEADROOTC_TO_FIRE - dead root C fire loss gC/m^2/s F +M_DEADROOTC_TO_LITTER_FIRE - dead root C fire mortality to litter gC/m^2/s F +M_DEADROOTC_XFER_TO_FIRE - dead root C transfer fire loss gC/m^2/s F +M_DEADROOTC_XFER_TO_LITTER_FIRE - dead root C transfer fire mortality to litter gC/m^2/s F +M_DEADSTEMC_STORAGE_TO_FIRE - dead stem C storage fire loss gC/m^2/s F +M_DEADSTEMC_STORAGE_TO_LITTER - dead stem C storage mortality gC/m^2/s F +M_DEADSTEMC_STORAGE_TO_LITTER_FIRE - dead stem C storage fire mortality to litter gC/m^2/s F +M_DEADSTEMC_TO_FIRE - dead stem C fire loss gC/m^2/s F +M_DEADSTEMC_TO_LITTER - dead stem C mortality gC/m^2/s F +M_DEADSTEMC_TO_LITTER_FIRE - dead stem C fire mortality to litter gC/m^2/s F +M_DEADSTEMC_XFER_TO_FIRE - dead stem C transfer fire loss gC/m^2/s F +M_DEADSTEMC_XFER_TO_LITTER - dead stem C transfer mortality gC/m^2/s F +M_DEADSTEMC_XFER_TO_LITTER_FIRE - dead stem C transfer fire mortality to litter gC/m^2/s F +M_DEADSTEMN_STORAGE_TO_FIRE - dead stem N storage fire loss gN/m^2/s F +M_DEADSTEMN_STORAGE_TO_LITTER - dead stem N storage mortality gN/m^2/s F +M_DEADSTEMN_TO_FIRE - dead stem N fire loss gN/m^2/s F +M_DEADSTEMN_TO_LITTER - dead stem N mortality gN/m^2/s F +M_DEADSTEMN_TO_LITTER_FIRE - dead stem N fire mortality to litter gN/m^2/s F +M_DEADSTEMN_XFER_TO_FIRE - dead stem N transfer fire loss gN/m^2/s F +M_DEADSTEMN_XFER_TO_LITTER - dead stem N transfer mortality gN/m^2/s F +M_FROOTC_STORAGE_TO_FIRE - fine root C storage fire loss gC/m^2/s F +M_FROOTC_STORAGE_TO_LITTER - fine root C storage mortality gC/m^2/s F +M_FROOTC_STORAGE_TO_LITTER_FIRE - fine root C storage fire mortality to litter gC/m^2/s F +M_FROOTC_TO_FIRE - fine root C fire loss gC/m^2/s F +M_FROOTC_TO_LITTER - fine root C mortality gC/m^2/s F +M_FROOTC_TO_LITTER_FIRE - fine root C fire mortality to litter gC/m^2/s F +M_FROOTC_XFER_TO_FIRE - fine root C transfer fire loss gC/m^2/s F +M_FROOTC_XFER_TO_LITTER - fine root C transfer mortality gC/m^2/s F +M_FROOTC_XFER_TO_LITTER_FIRE - fine root C transfer fire mortality to litter gC/m^2/s F +M_FROOTN_STORAGE_TO_FIRE - fine root N storage fire loss gN/m^2/s F +M_FROOTN_STORAGE_TO_LITTER - fine root N storage mortality gN/m^2/s F +M_FROOTN_TO_FIRE - fine root N fire loss gN/m^2/s F +M_FROOTN_TO_LITTER - fine root N mortality gN/m^2/s F +M_FROOTN_XFER_TO_FIRE - fine root N transfer fire loss gN/m^2/s F +M_FROOTN_XFER_TO_LITTER - fine root N transfer mortality gN/m^2/s F +M_GRESP_STORAGE_TO_FIRE - growth respiration storage fire loss gC/m^2/s F +M_GRESP_STORAGE_TO_LITTER - growth respiration storage mortality gC/m^2/s F +M_GRESP_STORAGE_TO_LITTER_FIRE - growth respiration storage fire mortality to litter gC/m^2/s F +M_GRESP_XFER_TO_FIRE - growth respiration transfer fire loss gC/m^2/s F +M_GRESP_XFER_TO_LITTER - growth respiration transfer mortality gC/m^2/s F +M_GRESP_XFER_TO_LITTER_FIRE - growth respiration transfer fire mortality to litter gC/m^2/s F +M_LEAFC_STORAGE_TO_FIRE - leaf C storage fire loss gC/m^2/s F +M_LEAFC_STORAGE_TO_LITTER - leaf C storage mortality gC/m^2/s F +M_LEAFC_STORAGE_TO_LITTER_FIRE - leaf C fire mortality to litter gC/m^2/s F +M_LEAFC_TO_FIRE - leaf C fire loss gC/m^2/s F +M_LEAFC_TO_LITTER - leaf C mortality gC/m^2/s F +M_LEAFC_TO_LITTER_FIRE - leaf C fire mortality to litter gC/m^2/s F +M_LEAFC_XFER_TO_FIRE - leaf C transfer fire loss gC/m^2/s F +M_LEAFC_XFER_TO_LITTER - leaf C transfer mortality gC/m^2/s F +M_LEAFC_XFER_TO_LITTER_FIRE - leaf C transfer fire mortality to litter gC/m^2/s F +M_LEAFN_STORAGE_TO_FIRE - leaf N storage fire loss gN/m^2/s F +M_LEAFN_STORAGE_TO_LITTER - leaf N storage mortality gN/m^2/s F +M_LEAFN_TO_FIRE - leaf N fire loss gN/m^2/s F +M_LEAFN_TO_LITTER - leaf N mortality gN/m^2/s F +M_LEAFN_XFER_TO_FIRE - leaf N transfer fire loss gN/m^2/s F +M_LEAFN_XFER_TO_LITTER - leaf N transfer mortality gN/m^2/s F +M_LIG_LITC_TO_FIRE - lignin litter C fire loss gC/m^2/s F +M_LIG_LITC_TO_FIRE_vr levdcmp lignin litter C fire loss gC/m^3/s F +M_LIG_LITC_TO_LEACHING - lignin litter C leaching loss gC/m^2/s F +M_LIG_LITN_TO_FIRE - lignin litter N fire loss gN/m^2 F +M_LIG_LITN_TO_FIRE_vr levdcmp lignin litter N fire loss gN/m^3 F +M_LIG_LITN_TO_LEACHING - lignin litter N leaching loss gN/m^2/s F +M_LIVECROOTC_STORAGE_TO_LITTER - live coarse root C storage mortality gC/m^2/s F +M_LIVECROOTC_STORAGE_TO_LITTER_FIRE - live coarse root C fire mortality to litter gC/m^2/s F +M_LIVECROOTC_TO_LITTER - live coarse root C mortality gC/m^2/s F +M_LIVECROOTC_XFER_TO_LITTER - live coarse root C transfer mortality gC/m^2/s F +M_LIVECROOTN_STORAGE_TO_FIRE - live coarse root N storage fire loss gN/m^2/s F +M_LIVECROOTN_STORAGE_TO_LITTER - live coarse root N storage mortality gN/m^2/s F +M_LIVECROOTN_TO_FIRE - live coarse root N fire loss gN/m^2/s F +M_LIVECROOTN_TO_LITTER - live coarse root N mortality gN/m^2/s F +M_LIVECROOTN_XFER_TO_FIRE - live coarse root N transfer fire loss gN/m^2/s F +M_LIVECROOTN_XFER_TO_LITTER - live coarse root N transfer mortality gN/m^2/s F +M_LIVEROOTC_STORAGE_TO_FIRE - live root C storage fire loss gC/m^2/s F +M_LIVEROOTC_STORAGE_TO_LITTER_FIRE - live root C storage fire mortality to litter gC/m^2/s F +M_LIVEROOTC_TO_DEADROOTC_FIRE - live root C fire mortality to dead root C gC/m^2/s F +M_LIVEROOTC_TO_FIRE - live root C fire loss gC/m^2/s F +M_LIVEROOTC_TO_LITTER_FIRE - live root C fire mortality to litter gC/m^2/s F +M_LIVEROOTC_XFER_TO_FIRE - live root C transfer fire loss gC/m^2/s F +M_LIVEROOTC_XFER_TO_LITTER_FIRE - live root C transfer fire mortality to litter gC/m^2/s F +M_LIVESTEMC_STORAGE_TO_FIRE - live stem C storage fire loss gC/m^2/s F +M_LIVESTEMC_STORAGE_TO_LITTER - live stem C storage mortality gC/m^2/s F +M_LIVESTEMC_STORAGE_TO_LITTER_FIRE - live stem C storage fire mortality to litter gC/m^2/s F +M_LIVESTEMC_TO_DEADSTEMC_FIRE - live stem C fire mortality to dead stem C gC/m^2/s F +M_LIVESTEMC_TO_FIRE - live stem C fire loss gC/m^2/s F +M_LIVESTEMC_TO_LITTER - live stem C mortality gC/m^2/s F +M_LIVESTEMC_TO_LITTER_FIRE - live stem C fire mortality to litter gC/m^2/s F +M_LIVESTEMC_XFER_TO_FIRE - live stem C transfer fire loss gC/m^2/s F +M_LIVESTEMC_XFER_TO_LITTER - live stem C transfer mortality gC/m^2/s F +M_LIVESTEMC_XFER_TO_LITTER_FIRE - live stem C transfer fire mortality to litter gC/m^2/s F +M_LIVESTEMN_STORAGE_TO_FIRE - live stem N storage fire loss gN/m^2/s F +M_LIVESTEMN_STORAGE_TO_LITTER - live stem N storage mortality gN/m^2/s F +M_LIVESTEMN_TO_FIRE - live stem N fire loss gN/m^2/s F +M_LIVESTEMN_TO_LITTER - live stem N mortality gN/m^2/s F +M_LIVESTEMN_XFER_TO_FIRE - live stem N transfer fire loss gN/m^2/s F +M_LIVESTEMN_XFER_TO_LITTER - live stem N transfer mortality gN/m^2/s F +M_MET_LITC_TO_FIRE - metabolic litter C fire loss gC/m^2/s F +M_MET_LITC_TO_FIRE_vr levdcmp metabolic litter C fire loss gC/m^3/s F +M_MET_LITC_TO_LEACHING - metabolic litter C leaching loss gC/m^2/s F +M_MET_LITN_TO_FIRE - metabolic litter N fire loss gN/m^2 F +M_MET_LITN_TO_FIRE_vr levdcmp metabolic litter N fire loss gN/m^3 F +M_MET_LITN_TO_LEACHING - metabolic litter N leaching loss gN/m^2/s F +M_PAS_SOMC_TO_LEACHING - passive soil organic C leaching loss gC/m^2/s F +M_PAS_SOMN_TO_LEACHING - passive soil organic N leaching loss gN/m^2/s F +M_RETRANSN_TO_FIRE - retranslocated N pool fire loss gN/m^2/s F +M_RETRANSN_TO_LITTER - retranslocated N pool mortality gN/m^2/s F +M_SLO_SOMC_TO_LEACHING - slow soil organic ma C leaching loss gC/m^2/s F +M_SLO_SOMN_TO_LEACHING - slow soil organic ma N leaching loss gN/m^2/s F +NACTIVE - Mycorrhizal N uptake flux gN/m^2/s T +NACTIVE_NH4 - Mycorrhizal N uptake flux gN/m^2/s T +NACTIVE_NO3 - Mycorrhizal N uptake flux gN/m^2/s T +NAM - AM-associated N uptake flux gN/m^2/s T +NAM_NH4 - AM-associated N uptake flux gN/m^2/s T +NAM_NO3 - AM-associated N uptake flux gN/m^2/s T +NBP - net biome production, includes fire, landuse, harvest and hrv_xsmrpool flux (latter smoothed o gC/m^2/s T +NDEPLOY - total N deployed in new growth gN/m^2/s T +NDEP_PROF levdcmp profile for atmospheric N deposition 1/m F +NDEP_TO_SMINN - atmospheric N deposition to soil mineral N gN/m^2/s T +NECM - ECM-associated N uptake flux gN/m^2/s T +NECM_NH4 - ECM-associated N uptake flux gN/m^2/s T +NECM_NO3 - ECM-associated N uptake flux gN/m^2/s T +NEE - net ecosystem exchange of carbon, includes fire and hrv_xsmrpool (latter smoothed over the yea gC/m^2/s T +NEM - Gridcell net adjustment to net carbon exchange passed to atm. for methane production gC/m2/s T +NEP - net ecosystem production, excludes fire, landuse, and harvest flux, positive for sink gC/m^2/s T +NET_NMIN - net rate of N mineralization gN/m^2/s T +NET_NMIN_vr levdcmp net rate of N mineralization gN/m^3/s F +NFERTILIZATION - fertilizer added gN/m^2/s T +NFIRE - fire counts valid only in Reg.C counts/km2/sec T +NFIX - Symbiotic BNF uptake flux gN/m^2/s T +NFIXATION_PROF levdcmp profile for biological N fixation 1/m F +NFIX_TO_SMINN - symbiotic/asymbiotic N fixation to soil mineral N gN/m^2/s F +NNONMYC - Non-mycorrhizal N uptake flux gN/m^2/s T +NNONMYC_NH4 - Non-mycorrhizal N uptake flux gN/m^2/s T +NNONMYC_NO3 - Non-mycorrhizal N uptake flux gN/m^2/s T +NPASSIVE - Passive N uptake flux gN/m^2/s T +NPOOL - temporary plant N pool gN/m^2 T +NPOOL_TO_DEADCROOTN - allocation to dead coarse root N gN/m^2/s F +NPOOL_TO_DEADCROOTN_STORAGE - allocation to dead coarse root N storage gN/m^2/s F +NPOOL_TO_DEADSTEMN - allocation to dead stem N gN/m^2/s F +NPOOL_TO_DEADSTEMN_STORAGE - allocation to dead stem N storage gN/m^2/s F +NPOOL_TO_FROOTN - allocation to fine root N gN/m^2/s F +NPOOL_TO_FROOTN_STORAGE - allocation to fine root N storage gN/m^2/s F +NPOOL_TO_LEAFN - allocation to leaf N gN/m^2/s F +NPOOL_TO_LEAFN_STORAGE - allocation to leaf N storage gN/m^2/s F +NPOOL_TO_LIVECROOTN - allocation to live coarse root N gN/m^2/s F +NPOOL_TO_LIVECROOTN_STORAGE - allocation to live coarse root N storage gN/m^2/s F +NPOOL_TO_LIVESTEMN - allocation to live stem N gN/m^2/s F +NPOOL_TO_LIVESTEMN_STORAGE - allocation to live stem N storage gN/m^2/s F +NPP - net primary production gC/m^2/s T +NPP_BURNEDOFF - C that cannot be used for N uptake gC/m^2/s F +NPP_GROWTH - Total C used for growth in FUN gC/m^2/s T +NPP_NACTIVE - Mycorrhizal N uptake used C gC/m^2/s T +NPP_NACTIVE_NH4 - Mycorrhizal N uptake use C gC/m^2/s T +NPP_NACTIVE_NO3 - Mycorrhizal N uptake used C gC/m^2/s T +NPP_NAM - AM-associated N uptake used C gC/m^2/s T +NPP_NAM_NH4 - AM-associated N uptake use C gC/m^2/s T +NPP_NAM_NO3 - AM-associated N uptake use C gC/m^2/s T +NPP_NECM - ECM-associated N uptake used C gC/m^2/s T +NPP_NECM_NH4 - ECM-associated N uptake use C gC/m^2/s T +NPP_NECM_NO3 - ECM-associated N uptake used C gC/m^2/s T +NPP_NFIX - Symbiotic BNF uptake used C gC/m^2/s T +NPP_NNONMYC - Non-mycorrhizal N uptake used C gC/m^2/s T +NPP_NNONMYC_NH4 - Non-mycorrhizal N uptake use C gC/m^2/s T +NPP_NNONMYC_NO3 - Non-mycorrhizal N uptake use C gC/m^2/s T +NPP_NRETRANS - Retranslocated N uptake flux gC/m^2/s T +NPP_NUPTAKE - Total C used by N uptake in FUN gC/m^2/s T +NRETRANS - Retranslocated N uptake flux gN/m^2/s T +NRETRANS_REG - Retranslocated N uptake flux gN/m^2/s T +NRETRANS_SEASON - Retranslocated N uptake flux gN/m^2/s T +NRETRANS_STRESS - Retranslocated N uptake flux gN/m^2/s T +NSUBSTEPS - number of adaptive timesteps in CLM timestep unitless F +NUPTAKE - Total N uptake of FUN gN/m^2/s T +NUPTAKE_NPP_FRACTION - frac of NPP used in N uptake - T +N_ALLOMETRY - N allocation index none F +O2_DECOMP_DEPTH_UNSAT levgrnd O2 consumption from HR and AR for non-inundated area mol/m3/s F +OBU - Monin-Obukhov length m F +OCDEP - total OC deposition (dry+wet) from atmosphere kg/m^2/s T +OFFSET_COUNTER - offset days counter days F +OFFSET_FDD - offset freezing degree days counter C degree-days F +OFFSET_FLAG - offset flag none F +OFFSET_SWI - offset soil water index none F +ONSET_COUNTER - onset days counter days F +ONSET_FDD - onset freezing degree days counter C degree-days F +ONSET_FLAG - onset flag none F +ONSET_GDD - onset growing degree days C degree-days F +ONSET_GDDFLAG - onset flag for growing degree day sum none F +ONSET_SWI - onset soil water index none F +O_SCALAR levsoi fraction by which decomposition is reduced due to anoxia unitless T +PAR240DZ - 10-day running mean of daytime patch absorbed PAR for leaves for top canopy layer W/m^2 F +PAR240XZ - 10-day running mean of maximum patch absorbed PAR for leaves for top canopy layer W/m^2 F +PAR240_shade - shade PAR (240 hrs) umol/m2/s F +PAR240_sun - sunlit PAR (240 hrs) umol/m2/s F +PAR24_shade - shade PAR (24 hrs) umol/m2/s F +PAR24_sun - sunlit PAR (24 hrs) umol/m2/s F +PARVEGLN - absorbed par by vegetation at local noon W/m^2 T +PAR_shade - shade PAR umol/m2/s F +PAR_sun - sunlit PAR umol/m2/s F +PAS_SOMC - PAS_SOM C gC/m^2 T +PAS_SOMC_1m - PAS_SOM C to 1 meter gC/m^2 F +PAS_SOMC_TNDNCY_VERT_TRA levdcmp passive soil organic C tendency due to vertical transport gC/m^3/s F +PAS_SOMC_TO_ACT_SOMC - decomp. of passive soil organic C to active soil organic C gC/m^2/s F +PAS_SOMC_TO_ACT_SOMC_vr levdcmp decomp. of passive soil organic C to active soil organic C gC/m^3/s F +PAS_SOMC_vr levsoi PAS_SOM C (vertically resolved) gC/m^3 T +PAS_SOMN - PAS_SOM N gN/m^2 T +PAS_SOMN_1m - PAS_SOM N to 1 meter gN/m^2 F +PAS_SOMN_TNDNCY_VERT_TRA levdcmp passive soil organic N tendency due to vertical transport gN/m^3/s F +PAS_SOMN_TO_ACT_SOMN - decomp. of passive soil organic N to active soil organic N gN/m^2 F +PAS_SOMN_TO_ACT_SOMN_vr levdcmp decomp. of passive soil organic N to active soil organic N gN/m^3 F +PAS_SOMN_vr levdcmp PAS_SOM N (vertically resolved) gN/m^3 T +PAS_SOM_HR - Het. Resp. from passive soil organic gC/m^2/s F +PAS_SOM_HR_vr levdcmp Het. Resp. from passive soil organic gC/m^3/s F +PBOT - atmospheric pressure at surface (downscaled to columns in glacier regions) Pa T +PBOT_240 - 10 day running mean of air pressure Pa F +PCH4 - atmospheric partial pressure of CH4 Pa T +PCO2 - atmospheric partial pressure of CO2 Pa T +PCO2_240 - 10 day running mean of CO2 pressure Pa F +PFT_CTRUNC - patch-level sink for C truncation gC/m^2 F +PFT_FIRE_CLOSS - total patch-level fire C loss for non-peat fires outside land-type converted region gC/m^2/s T +PFT_FIRE_NLOSS - total patch-level fire N loss gN/m^2/s T +PFT_NTRUNC - patch-level sink for N truncation gN/m^2 F +PLANTCN - Plant C:N used by FUN unitless F +PLANT_CALLOC - total allocated C flux gC/m^2/s F +PLANT_NALLOC - total allocated N flux gN/m^2/s F +PLANT_NDEMAND - N flux required to support initial GPP gN/m^2/s T +PNLCZ - Proportion of nitrogen allocated for light capture unitless F +PO2_240 - 10 day running mean of O2 pressure Pa F +POTENTIAL_IMMOB - potential N immobilization gN/m^2/s T +POTENTIAL_IMMOB_vr levdcmp potential N immobilization gN/m^3/s F +POT_F_DENIT - potential denitrification flux gN/m^2/s T +POT_F_DENIT_vr levdcmp potential denitrification flux gN/m^3/s F +POT_F_NIT - potential nitrification flux gN/m^2/s T +POT_F_NIT_vr levdcmp potential nitrification flux gN/m^3/s F +PREC10 - 10-day running mean of PREC MM H2O/S F +PREC60 - 60-day running mean of PREC MM H2O/S F +PREV_DAYL - daylength from previous timestep s F +PREV_FROOTC_TO_LITTER - previous timestep froot C litterfall flux gC/m^2/s F +PREV_LEAFC_TO_LITTER - previous timestep leaf C litterfall flux gC/m^2/s F +PROD100C - 100-yr wood product C gC/m^2 F +PROD100C_LOSS - loss from 100-yr wood product pool gC/m^2/s F +PROD100N - 100-yr wood product N gN/m^2 F +PROD100N_LOSS - loss from 100-yr wood product pool gN/m^2/s F +PROD10C - 10-yr wood product C gC/m^2 F +PROD10C_LOSS - loss from 10-yr wood product pool gC/m^2/s F +PROD10N - 10-yr wood product N gN/m^2 F +PROD10N_LOSS - loss from 10-yr wood product pool gN/m^2/s F +PSNSHA - shaded leaf photosynthesis umolCO2/m^2/s T +PSNSHADE_TO_CPOOL - C fixation from shaded canopy gC/m^2/s T +PSNSUN - sunlit leaf photosynthesis umolCO2/m^2/s T +PSNSUN_TO_CPOOL - C fixation from sunlit canopy gC/m^2/s T +PSurf - atmospheric pressure at surface (downscaled to columns in glacier regions) Pa F +Q2M - 2m specific humidity kg/kg T +QAF - canopy air humidity kg/kg F +QBOT - atmospheric specific humidity (downscaled to columns in glacier regions) kg/kg T +QDIRECT_THROUGHFALL - direct throughfall of liquid (rain + above-canopy irrigation) mm/s F +QDIRECT_THROUGHFALL_SNOW - direct throughfall of snow mm/s F +QDRAI - sub-surface drainage mm/s T +QDRAI_PERCH - perched wt drainage mm/s T +QDRAI_XS - saturation excess drainage mm/s T +QDRIP - rate of excess canopy liquid falling off canopy mm/s F +QDRIP_SNOW - rate of excess canopy snow falling off canopy mm/s F +QFLOOD - runoff from river flooding mm/s T +QFLX_EVAP_TOT - qflx_evap_soi + qflx_evap_can + qflx_tran_veg kg m-2 s-1 T +QFLX_EVAP_VEG - vegetation evaporation mm H2O/s F +QFLX_ICE_DYNBAL - ice dynamic land cover change conversion runoff flux mm/s T +QFLX_LIQDEW_TO_TOP_LAYER - rate of liquid water deposited on top soil or snow layer (dew) mm H2O/s T +QFLX_LIQEVAP_FROM_TOP_LAYER - rate of liquid water evaporated from top soil or snow layer mm H2O/s T +QFLX_LIQ_DYNBAL - liq dynamic land cover change conversion runoff flux mm/s T +QFLX_LIQ_GRND - liquid (rain+irrigation) on ground after interception mm H2O/s F +QFLX_SNOW_DRAIN - drainage from snow pack mm/s T +QFLX_SNOW_DRAIN_ICE - drainage from snow pack melt (ice landunits only) mm/s T +QFLX_SNOW_GRND - snow on ground after interception mm H2O/s F +QFLX_SOLIDDEW_TO_TOP_LAYER - rate of solid water deposited on top soil or snow layer (frost) mm H2O/s T +QFLX_SOLIDEVAP_FROM_TOP_LAYER - rate of ice evaporated from top soil or snow layer (sublimation) (also includes bare ice subli mm H2O/s T +QFLX_SOLIDEVAP_FROM_TOP_LAYER_ICE - rate of ice evaporated from top soil or snow layer (sublimation) (also includes bare ice subli mm H2O/s F +QH2OSFC - surface water runoff mm/s T +QH2OSFC_TO_ICE - surface water converted to ice mm/s F +QHR - hydraulic redistribution mm/s T +QICE - ice growth/melt mm/s T +QICE_FORC elevclas qice forcing sent to GLC mm/s F +QICE_FRZ - ice growth mm/s T +QICE_MELT - ice melt mm/s T +QINFL - infiltration mm/s T +QINTR - interception mm/s T +QIRRIG_DEMAND - irrigation demand mm/s F +QIRRIG_DRIP - water added via drip irrigation mm/s F +QIRRIG_FROM_GW_CONFINED - water added through confined groundwater irrigation mm/s T +QIRRIG_FROM_GW_UNCONFINED - water added through unconfined groundwater irrigation mm/s T +QIRRIG_FROM_SURFACE - water added through surface water irrigation mm/s T +QIRRIG_SPRINKLER - water added via sprinkler irrigation mm/s F +QOVER - total surface runoff (includes QH2OSFC) mm/s T +QOVER_LAG - time-lagged surface runoff for soil columns mm/s F +QPHSNEG - net negative hydraulic redistribution flux mm/s F +QRGWL - surface runoff at glaciers (liquid only), wetlands, lakes; also includes melted ice runoff fro mm/s T +QROOTSINK levsoi water flux from soil to root in each soil-layer mm/s F +QRUNOFF - total liquid runoff not including correction for land use change mm/s T +QRUNOFF_ICE - total liquid runoff not incl corret for LULCC (ice landunits only) mm/s T +QRUNOFF_ICE_TO_COUPLER - total ice runoff sent to coupler (includes corrections for land use change) mm/s T +QRUNOFF_ICE_TO_LIQ - liquid runoff from converted ice runoff mm/s F +QRUNOFF_R - Rural total runoff mm/s F +QRUNOFF_TO_COUPLER - total liquid runoff sent to coupler (includes corrections for land use change) mm/s T +QRUNOFF_U - Urban total runoff mm/s F +QSNOCPLIQ - excess liquid h2o due to snow capping not including correction for land use change mm H2O/s T +QSNOEVAP - evaporation from snow (only when snl<0, otherwise it is equal to qflx_ev_soil) mm/s T +QSNOFRZ - column-integrated snow freezing rate kg/m2/s T +QSNOFRZ_ICE - column-integrated snow freezing rate (ice landunits only) mm/s T +QSNOMELT - snow melt rate mm/s T +QSNOMELT_ICE - snow melt (ice landunits only) mm/s T +QSNOUNLOAD - canopy snow unloading mm/s T +QSNO_TEMPUNLOAD - canopy snow temp unloading mm/s T +QSNO_WINDUNLOAD - canopy snow wind unloading mm/s T +QSNWCPICE - excess solid h2o due to snow capping not including correction for land use change mm H2O/s T +QSOIL - Ground evaporation (soil/snow evaporation + soil/snow sublimation - dew) mm/s T +QSOIL_ICE - Ground evaporation (ice landunits only) mm/s T +QTOPSOIL - water input to surface mm/s F +QVEGE - canopy evaporation mm/s T +QVEGT - canopy transpiration mm/s T +Qair - atmospheric specific humidity (downscaled to columns in glacier regions) kg/kg F +Qh - sensible heat W/m^2 F +Qle - total evaporation W/m^2 F +Qstor - storage heat flux (includes snowmelt) W/m^2 F +Qtau - momentum flux kg/m/s^2 F +RAH1 - aerodynamical resistance s/m F +RAH2 - aerodynamical resistance s/m F +RAIN - atmospheric rain, after rain/snow repartitioning based on temperature mm/s T +RAIN_FROM_ATM - atmospheric rain received from atmosphere (pre-repartitioning) mm/s T +RAIN_ICE - atmospheric rain, after rain/snow repartitioning based on temperature (ice landunits only) mm/s F +RAM1 - aerodynamical resistance s/m F +RAM_LAKE - aerodynamic resistance for momentum (lakes only) s/m F +RAW1 - aerodynamical resistance s/m F +RAW2 - aerodynamical resistance s/m F +RB - leaf boundary resistance s/m F +RB10 - 10 day running mean boundary layer resistance s/m F +RETRANSN - plant pool of retranslocated N gN/m^2 T +RETRANSN_TO_NPOOL - deployment of retranslocated N gN/m^2/s T +RH - atmospheric relative humidity % F +RH2M - 2m relative humidity % T +RH2M_R - Rural 2m specific humidity % F +RH2M_U - Urban 2m relative humidity % F +RH30 - 30-day running mean of relative humidity % F +RHAF - fractional humidity of canopy air fraction F +RHAF10 - 10 day running mean of fractional humidity of canopy air fraction F +RH_LEAF - fractional humidity at leaf surface fraction F +ROOTR levgrnd effective fraction of roots in each soil layer (SMS method) proportion F +RR - root respiration (fine root MR + total root GR) gC/m^2/s T +RRESIS levgrnd root resistance in each soil layer proportion F +RSSHA - shaded leaf stomatal resistance s/m T +RSSUN - sunlit leaf stomatal resistance s/m T +Rainf - atmospheric rain, after rain/snow repartitioning based on temperature mm/s F +Rnet - net radiation W/m^2 F +S1_PATHFRAC_S2_vr levdcmp PATHFRAC from active soil organic to slow soil organic ma fraction F +S1_PATHFRAC_S3_vr levdcmp PATHFRAC from active soil organic to passive soil organic fraction F +S1_RESP_FRAC_S2_vr levdcmp respired from active soil organic to slow soil organic ma fraction F +S1_RESP_FRAC_S3_vr levdcmp respired from active soil organic to passive soil organic fraction F +S2_PATHFRAC_S1_vr levdcmp PATHFRAC from slow soil organic ma to active soil organic fraction F +S2_PATHFRAC_S3_vr levdcmp PATHFRAC from slow soil organic ma to passive soil organic fraction F +S2_RESP_FRAC_S1_vr levdcmp respired from slow soil organic ma to active soil organic fraction F +S2_RESP_FRAC_S3_vr levdcmp respired from slow soil organic ma to passive soil organic fraction F +S3_PATHFRAC_S1_vr levdcmp PATHFRAC from passive soil organic to active soil organic fraction F +S3_RESP_FRAC_S1_vr levdcmp respired from passive soil organic to active soil organic fraction F +SABG - solar rad absorbed by ground W/m^2 T +SABG_PEN - Rural solar rad penetrating top soil or snow layer watt/m^2 T +SABV - solar rad absorbed by veg W/m^2 T +SDATES mxsowings actual crop sowing dates; should only be output annually day of year F +SDATES_PERHARV mxharvests actual sowing dates for crops harvested this year; should only be output annually day of year F +SEEDC - pool for seeding new PFTs via dynamic landcover gC/m^2 T +SEEDN - pool for seeding new PFTs via dynamic landcover gN/m^2 T +SLASH_HARVESTC - slash harvest carbon (to litter) gC/m^2/s T +SLO_SOMC - SLO_SOM C gC/m^2 T +SLO_SOMC_1m - SLO_SOM C to 1 meter gC/m^2 F +SLO_SOMC_TNDNCY_VERT_TRA levdcmp slow soil organic ma C tendency due to vertical transport gC/m^3/s F +SLO_SOMC_TO_ACT_SOMC - decomp. of slow soil organic ma C to active soil organic C gC/m^2/s F +SLO_SOMC_TO_ACT_SOMC_vr levdcmp decomp. of slow soil organic ma C to active soil organic C gC/m^3/s F +SLO_SOMC_TO_PAS_SOMC - decomp. of slow soil organic ma C to passive soil organic C gC/m^2/s F +SLO_SOMC_TO_PAS_SOMC_vr levdcmp decomp. of slow soil organic ma C to passive soil organic C gC/m^3/s F +SLO_SOMC_vr levsoi SLO_SOM C (vertically resolved) gC/m^3 T +SLO_SOMN - SLO_SOM N gN/m^2 T +SLO_SOMN_1m - SLO_SOM N to 1 meter gN/m^2 F +SLO_SOMN_TNDNCY_VERT_TRA levdcmp slow soil organic ma N tendency due to vertical transport gN/m^3/s F +SLO_SOMN_TO_ACT_SOMN - decomp. of slow soil organic ma N to active soil organic N gN/m^2 F +SLO_SOMN_TO_ACT_SOMN_vr levdcmp decomp. of slow soil organic ma N to active soil organic N gN/m^3 F +SLO_SOMN_TO_PAS_SOMN - decomp. of slow soil organic ma N to passive soil organic N gN/m^2 F +SLO_SOMN_TO_PAS_SOMN_vr levdcmp decomp. of slow soil organic ma N to passive soil organic N gN/m^3 F +SLO_SOMN_vr levdcmp SLO_SOM N (vertically resolved) gN/m^3 T +SLO_SOM_HR_S1 - Het. Resp. from slow soil organic ma gC/m^2/s F +SLO_SOM_HR_S1_vr levdcmp Het. Resp. from slow soil organic ma gC/m^3/s F +SLO_SOM_HR_S3 - Het. Resp. from slow soil organic ma gC/m^2/s F +SLO_SOM_HR_S3_vr levdcmp Het. Resp. from slow soil organic ma gC/m^3/s F +SMINN - soil mineral N gN/m^2 T +SMINN_TO_NPOOL - deployment of soil mineral N uptake gN/m^2/s T +SMINN_TO_PLANT - plant uptake of soil mineral N gN/m^2/s T +SMINN_TO_PLANT_FUN - Total soil N uptake of FUN gN/m^2/s T +SMINN_TO_PLANT_vr levdcmp plant uptake of soil mineral N gN/m^3/s F +SMINN_TO_S1N_L1 - mineral N flux for decomp. of MET_LITto ACT_SOM gN/m^2 F +SMINN_TO_S1N_L1_vr levdcmp mineral N flux for decomp. of MET_LITto ACT_SOM gN/m^3 F +SMINN_TO_S1N_L2 - mineral N flux for decomp. of CEL_LITto ACT_SOM gN/m^2 F +SMINN_TO_S1N_L2_vr levdcmp mineral N flux for decomp. of CEL_LITto ACT_SOM gN/m^3 F +SMINN_TO_S1N_S2 - mineral N flux for decomp. of SLO_SOMto ACT_SOM gN/m^2 F +SMINN_TO_S1N_S2_vr levdcmp mineral N flux for decomp. of SLO_SOMto ACT_SOM gN/m^3 F +SMINN_TO_S1N_S3 - mineral N flux for decomp. of PAS_SOMto ACT_SOM gN/m^2 F +SMINN_TO_S1N_S3_vr levdcmp mineral N flux for decomp. of PAS_SOMto ACT_SOM gN/m^3 F +SMINN_TO_S2N_L3 - mineral N flux for decomp. of LIG_LITto SLO_SOM gN/m^2 F +SMINN_TO_S2N_L3_vr levdcmp mineral N flux for decomp. of LIG_LITto SLO_SOM gN/m^3 F +SMINN_TO_S2N_S1 - mineral N flux for decomp. of ACT_SOMto SLO_SOM gN/m^2 F +SMINN_TO_S2N_S1_vr levdcmp mineral N flux for decomp. of ACT_SOMto SLO_SOM gN/m^3 F +SMINN_TO_S3N_S1 - mineral N flux for decomp. of ACT_SOMto PAS_SOM gN/m^2 F +SMINN_TO_S3N_S1_vr levdcmp mineral N flux for decomp. of ACT_SOMto PAS_SOM gN/m^3 F +SMINN_TO_S3N_S2 - mineral N flux for decomp. of SLO_SOMto PAS_SOM gN/m^2 F +SMINN_TO_S3N_S2_vr levdcmp mineral N flux for decomp. of SLO_SOMto PAS_SOM gN/m^3 F +SMINN_vr levsoi soil mineral N gN/m^3 T +SMIN_NH4 - soil mineral NH4 gN/m^2 T +SMIN_NH4_TO_PLANT levdcmp plant uptake of NH4 gN/m^3/s F +SMIN_NH4_vr levsoi soil mineral NH4 (vert. res.) gN/m^3 T +SMIN_NO3 - soil mineral NO3 gN/m^2 T +SMIN_NO3_LEACHED - soil NO3 pool loss to leaching gN/m^2/s T +SMIN_NO3_LEACHED_vr levdcmp soil NO3 pool loss to leaching gN/m^3/s F +SMIN_NO3_MASSDENS levdcmp SMIN_NO3_MASSDENS ugN/cm^3 soil F +SMIN_NO3_RUNOFF - soil NO3 pool loss to runoff gN/m^2/s T +SMIN_NO3_RUNOFF_vr levdcmp soil NO3 pool loss to runoff gN/m^3/s F +SMIN_NO3_TO_PLANT levdcmp plant uptake of NO3 gN/m^3/s F +SMIN_NO3_vr levsoi soil mineral NO3 (vert. res.) gN/m^3 T +SMP levgrnd soil matric potential (natural vegetated and crop landunits only) mm T +SNOBCMCL - mass of BC in snow column kg/m2 T +SNOBCMSL - mass of BC in top snow layer kg/m2 T +SNOCAN - intercepted snow mm T +SNODSTMCL - mass of dust in snow column kg/m2 T +SNODSTMSL - mass of dust in top snow layer kg/m2 T +SNOFSDSND - direct nir incident solar radiation on snow W/m^2 F +SNOFSDSNI - diffuse nir incident solar radiation on snow W/m^2 F +SNOFSDSVD - direct vis incident solar radiation on snow W/m^2 F +SNOFSDSVI - diffuse vis incident solar radiation on snow W/m^2 F +SNOFSRND - direct nir reflected solar radiation from snow W/m^2 T +SNOFSRNI - diffuse nir reflected solar radiation from snow W/m^2 T +SNOFSRVD - direct vis reflected solar radiation from snow W/m^2 T +SNOFSRVI - diffuse vis reflected solar radiation from snow W/m^2 T +SNOINTABS - Fraction of incoming solar absorbed by lower snow layers - T +SNOLIQFL - top snow layer liquid water fraction (land) fraction F +SNOOCMCL - mass of OC in snow column kg/m2 T +SNOOCMSL - mass of OC in top snow layer kg/m2 T +SNORDSL - top snow layer effective grain radius m^-6 F +SNOTTOPL - snow temperature (top layer) K F +SNOTTOPL_ICE - snow temperature (top layer, ice landunits only) K F +SNOTXMASS - snow temperature times layer mass, layer sum; to get mass-weighted temperature, divide by (SNO K kg/m2 T +SNOTXMASS_ICE - snow temperature times layer mass, layer sum (ice landunits only); to get mass-weighted temper K kg/m2 F +SNOW - atmospheric snow, after rain/snow repartitioning based on temperature mm/s T +SNOWDP - gridcell mean snow height m T +SNOWICE - snow ice kg/m2 T +SNOWICE_ICE - snow ice (ice landunits only) kg/m2 F +SNOWLIQ - snow liquid water kg/m2 T +SNOWLIQ_ICE - snow liquid water (ice landunits only) kg/m2 F +SNOW_5D - 5day snow avg m F +SNOW_DEPTH - snow height of snow covered area m T +SNOW_DEPTH_ICE - snow height of snow covered area (ice landunits only) m F +SNOW_FROM_ATM - atmospheric snow received from atmosphere (pre-repartitioning) mm/s T +SNOW_ICE - atmospheric snow, after rain/snow repartitioning based on temperature (ice landunits only) mm/s F +SNOW_PERSISTENCE - Length of time of continuous snow cover (nat. veg. landunits only) seconds T +SNOW_SINKS - snow sinks (liquid water) mm/s T +SNOW_SOURCES - snow sources (liquid water) mm/s T +SNO_ABS levsno Absorbed solar radiation in each snow layer W/m^2 F +SNO_ABS_ICE levsno Absorbed solar radiation in each snow layer (ice landunits only) W/m^2 F +SNO_BW levsno Partial density of water in the snow pack (ice + liquid) kg/m3 F +SNO_BW_ICE levsno Partial density of water in the snow pack (ice + liquid, ice landunits only) kg/m3 F +SNO_EXISTENCE levsno Fraction of averaging period for which each snow layer existed unitless F +SNO_FRZ levsno snow freezing rate in each snow layer kg/m2/s F +SNO_FRZ_ICE levsno snow freezing rate in each snow layer (ice landunits only) mm/s F +SNO_GS levsno Mean snow grain size Microns F +SNO_GS_ICE levsno Mean snow grain size (ice landunits only) Microns F +SNO_ICE levsno Snow ice content kg/m2 F +SNO_LIQH2O levsno Snow liquid water content kg/m2 F +SNO_MELT levsno snow melt rate in each snow layer mm/s F +SNO_MELT_ICE levsno snow melt rate in each snow layer (ice landunits only) mm/s F +SNO_T levsno Snow temperatures K F +SNO_TK levsno Thermal conductivity W/m-K F +SNO_TK_ICE levsno Thermal conductivity (ice landunits only) W/m-K F +SNO_T_ICE levsno Snow temperatures (ice landunits only) K F +SNO_Z levsno Snow layer thicknesses m F +SNO_Z_ICE levsno Snow layer thicknesses (ice landunits only) m F +SNOdTdzL - top snow layer temperature gradient (land) K/m F +SOIL10 - 10-day running mean of 12cm layer soil K F +SOILC_CHANGE - C change in soil gC/m^2/s T +SOILC_HR - soil C heterotrophic respiration gC/m^2/s T +SOILC_vr levsoi SOIL C (vertically resolved) gC/m^3 T +SOILICE levsoi soil ice (natural vegetated and crop landunits only) kg/m2 T +SOILLIQ levsoi soil liquid water (natural vegetated and crop landunits only) kg/m2 T +SOILN_vr levdcmp SOIL N (vertically resolved) gN/m^3 T +SOILPSI levgrnd soil water potential in each soil layer MPa F +SOILRESIS - soil resistance to evaporation s/m T +SOILWATER_10CM - soil liquid water + ice in top 10cm of soil (veg landunits only) kg/m2 T +SOMC_FIRE - C loss due to peat burning gC/m^2/s T +SOMFIRE - soil organic matter fire losses gC/m^2/s F +SOM_ADV_COEF levdcmp advection term for vertical SOM translocation m/s F +SOM_C_LEACHED - total flux of C from SOM pools due to leaching gC/m^2/s T +SOM_DIFFUS_COEF levdcmp diffusion coefficient for vertical SOM translocation m^2/s F +SOM_N_LEACHED - total flux of N from SOM pools due to leaching gN/m^2/s F +SOWING_REASON mxsowings Reason for each crop sowing; should only be output annually unitless F +SOWING_REASON_PERHARV mxharvests Reason for sowing of each crop harvested this year; should only be output annually unitless F +SR - total soil respiration (HR + root resp) gC/m^2/s T +STEM_PROF levdcmp profile for litter C and N inputs from stems 1/m F +STORAGE_CDEMAND - C use from the C storage pool gC/m^2 F +STORAGE_GR - growth resp for growth sent to storage for later display gC/m^2/s F +STORAGE_NDEMAND - N demand during the offset period gN/m^2 F +STORVEGC - stored vegetation carbon, excluding cpool gC/m^2 T +STORVEGN - stored vegetation nitrogen gN/m^2 T +SUPPLEMENT_TO_SMINN - supplemental N supply gN/m^2/s T +SUPPLEMENT_TO_SMINN_vr levdcmp supplemental N supply gN/m^3/s F +SWBGT - 2 m Simplified Wetbulb Globe Temp C T +SWBGT_R - Rural 2 m Simplified Wetbulb Globe Temp C T +SWBGT_U - Urban 2 m Simplified Wetbulb Globe Temp C T +SWdown - atmospheric incident solar radiation W/m^2 F +SWup - upwelling shortwave radiation W/m^2 F +SYEARS_PERHARV mxharvests actual sowing years for crops harvested this year; should only be output annually year F +SoilAlpha - factor limiting ground evap unitless F +SoilAlpha_U - urban factor limiting ground evap unitless F +T10 - 10-day running mean of 2-m temperature K F +TAF - canopy air temperature K F +TAUX - zonal surface stress kg/m/s^2 T +TAUY - meridional surface stress kg/m/s^2 T +TBOT - atmospheric air temperature (downscaled to columns in glacier regions) K T +TBUILD - internal urban building air temperature K T +TBUILD_MAX - prescribed maximum interior building temperature K F +TEMPAVG_T2M - temporary average 2m air temperature K F +TEMPMAX_RETRANSN - temporary annual max of retranslocated N pool gN/m^2 F +TEMPSUM_POTENTIAL_GPP - temporary annual sum of potential GPP gC/m^2/yr F +TFLOOR - floor temperature K F +TG - ground temperature K T +TG_ICE - ground temperature (ice landunits only) K F +TG_R - Rural ground temperature K F +TG_U - Urban ground temperature K F +TH2OSFC - surface water temperature K T +THBOT - atmospheric air potential temperature (downscaled to columns in glacier regions) K T +TKE1 - top lake level eddy thermal conductivity W/(mK) T +TLAI - total projected leaf area index m^2/m^2 T +TLAKE levlak lake temperature K T +TOPO_COL - column-level topographic height m F +TOPO_COL_ICE - column-level topographic height (ice landunits only) m F +TOPO_FORC elevclas topograephic height sent to GLC m F +TOPT - topt coefficient for VOC calc non F +TOTCOLC - total column carbon, incl veg and cpool but excl product pools gC/m^2 T +TOTCOLCH4 - total belowground CH4 (0 for non-lake special landunits in the absence of dynamic landunits) gC/m2 T +TOTCOLN - total column-level N, excluding product pools gN/m^2 T +TOTECOSYSC - total ecosystem carbon, incl veg but excl cpool and product pools gC/m^2 T +TOTECOSYSN - total ecosystem N, excluding product pools gN/m^2 T +TOTFIRE - total ecosystem fire losses gC/m^2/s F +TOTLITC - total litter carbon gC/m^2 T +TOTLITC_1m - total litter carbon to 1 meter depth gC/m^2 T +TOTLITN - total litter N gN/m^2 T +TOTLITN_1m - total litter N to 1 meter gN/m^2 T +TOTPFTC - total patch-level carbon, including cpool gC/m^2 T +TOTPFTN - total patch-level nitrogen gN/m^2 T +TOTSOILICE - vertically summed soil cie (veg landunits only) kg/m2 T +TOTSOILLIQ - vertically summed soil liquid water (veg landunits only) kg/m2 T +TOTSOMC - total soil organic matter carbon gC/m^2 T +TOTSOMC_1m - total soil organic matter carbon to 1 meter depth gC/m^2 T +TOTSOMN - total soil organic matter N gN/m^2 T +TOTSOMN_1m - total soil organic matter N to 1 meter gN/m^2 T +TOTVEGC - total vegetation carbon, excluding cpool gC/m^2 T +TOTVEGN - total vegetation nitrogen gN/m^2 T +TOT_WOODPRODC - total wood product C gC/m^2 T +TOT_WOODPRODC_LOSS - total loss from wood product pools gC/m^2/s T +TOT_WOODPRODN - total wood product N gN/m^2 T +TOT_WOODPRODN_LOSS - total loss from wood product pools gN/m^2/s T +TPU25T - canopy profile of tpu umol/m2/s T +TRAFFICFLUX - sensible heat flux from urban traffic W/m^2 F +TRANSFER_DEADCROOT_GR - dead coarse root growth respiration from storage gC/m^2/s F +TRANSFER_DEADSTEM_GR - dead stem growth respiration from storage gC/m^2/s F +TRANSFER_FROOT_GR - fine root growth respiration from storage gC/m^2/s F +TRANSFER_GR - growth resp for transfer growth displayed in this timestep gC/m^2/s F +TRANSFER_LEAF_GR - leaf growth respiration from storage gC/m^2/s F +TRANSFER_LIVECROOT_GR - live coarse root growth respiration from storage gC/m^2/s F +TRANSFER_LIVESTEM_GR - live stem growth respiration from storage gC/m^2/s F +TREFMNAV - daily minimum of average 2-m temperature K T +TREFMNAV_R - Rural daily minimum of average 2-m temperature K F +TREFMNAV_U - Urban daily minimum of average 2-m temperature K F +TREFMXAV - daily maximum of average 2-m temperature K T +TREFMXAV_R - Rural daily maximum of average 2-m temperature K F +TREFMXAV_U - Urban daily maximum of average 2-m temperature K F +TROOF_INNER - roof inside surface temperature K F +TSA - 2m air temperature K T +TSAI - total projected stem area index m^2/m^2 T +TSA_ICE - 2m air temperature (ice landunits only) K F +TSA_R - Rural 2m air temperature K F +TSA_U - Urban 2m air temperature K F +TSHDW_INNER - shadewall inside surface temperature K F +TSKIN - skin temperature K T +TSL - temperature of near-surface soil layer (natural vegetated and crop landunits only) K T +TSOI levgrnd soil temperature (natural vegetated and crop landunits only) K T +TSOI_10CM - soil temperature in top 10cm of soil K T +TSOI_ICE levgrnd soil temperature (ice landunits only) K T +TSRF_FORC elevclas surface temperature sent to GLC K F +TSUNW_INNER - sunwall inside surface temperature K F +TV - vegetation temperature K T +TV24 - vegetation temperature (last 24hrs) K F +TV240 - vegetation temperature (last 240hrs) K F +TVEGD10 - 10 day running mean of patch daytime vegetation temperature Kelvin F +TVEGN10 - 10 day running mean of patch night-time vegetation temperature Kelvin F +TWS - total water storage mm T +T_SCALAR levsoi temperature inhibition of decomposition unitless T +Tair - atmospheric air temperature (downscaled to columns in glacier regions) K F +Tair_from_atm - atmospheric air temperature received from atmosphere (pre-downscaling) K F +U10 - 10-m wind m/s T +U10_DUST - 10-m wind for dust model m/s T +U10_ICE - 10-m wind (ice landunits only) m/s F +UAF - canopy air speed m/s F +ULRAD - upward longwave radiation above the canopy W/m^2 F +UM - wind speed plus stability effect m/s F +URBAN_AC - urban air conditioning flux W/m^2 T +URBAN_HEAT - urban heating flux W/m^2 T +USTAR - aerodynamical resistance s/m F +UST_LAKE - friction velocity (lakes only) m/s F +VA - atmospheric wind speed plus convective velocity m/s F +VCMX25T - canopy profile of vcmax25 umol/m2/s T +VEGWP nvegwcs vegetation water matric potential for sun/sha canopy,xyl,root segments mm T +VEGWPLN nvegwcs vegetation water matric potential for sun/sha canopy,xyl,root at local noon mm T +VEGWPPD nvegwcs predawn vegetation water matric potential for sun/sha canopy,xyl,root mm T +VENTILATION - sensible heat flux from building ventilation W/m^2 T +VOCFLXT - total VOC flux into atmosphere moles/m2/sec F +VOLR - river channel total water storage m3 T +VOLRMCH - river channel main channel water storage m3 T +VPD - vpd Pa F +VPD2M - 2m vapor pressure deficit Pa T +VPD_CAN - canopy vapor pressure deficit kPa T +Vcmx25Z - canopy profile of vcmax25 predicted by LUNA model umol/m2/s T +WASTEHEAT - sensible heat flux from heating/cooling sources of urban waste heat W/m^2 T +WBT - 2 m Stull Wet Bulb C T +WBT_R - Rural 2 m Stull Wet Bulb C T +WBT_U - Urban 2 m Stull Wet Bulb C T +WF - soil water as frac. of whc for top 0.05 m proportion F +WFPS levdcmp WFPS percent F +WIND - atmospheric wind velocity magnitude m/s T +WOODC - wood C gC/m^2 T +WOODC_ALLOC - wood C eallocation gC/m^2/s T +WOODC_LOSS - wood C loss gC/m^2/s T +WOOD_HARVESTC - wood harvest carbon (to product pools) gC/m^2/s T +WOOD_HARVESTN - wood harvest N (to product pools) gN/m^2/s T +WTGQ - surface tracer conductance m/s T +W_SCALAR levsoi Moisture (dryness) inhibition of decomposition unitless T +Wind - atmospheric wind velocity magnitude m/s F +XSMRPOOL - temporary photosynthate C pool gC/m^2 T +XSMRPOOL_LOSS - temporary photosynthate C pool loss gC/m^2 F +XSMRPOOL_RECOVER - C flux assigned to recovery of negative xsmrpool gC/m^2/s T +Z0HG - roughness length over ground, sensible heat (vegetated landunits only) m F +Z0HV - roughness length over vegetation, sensible heat m F +Z0MG - roughness length over ground, momentum (vegetated landunits only) m F +Z0MV - roughness length over vegetation, momentum m F +Z0MV_DENSE - roughness length over vegetation, momentum, for dense canopy m F +Z0M_TO_COUPLER - roughness length, momentum: gridcell average sent to coupler m F +Z0QG - roughness length over ground, latent heat (vegetated landunits only) m F +Z0QV - roughness length over vegetation, latent heat m F +ZBOT - atmospheric reference height m T +ZETA - dimensionless stability parameter unitless F +ZII - convective boundary height m F +ZWT - water table depth (natural vegetated and crop landunits only) m T +ZWT_CH4_UNSAT - depth of water table for methane production used in non-inundated area m T +ZWT_PERCH - perched water table depth (natural vegetated and crop landunits only) m T +anaerobic_frac levdcmp anaerobic_frac m3/m3 F +bsw levgrnd clap and hornberger B unitless F +currentPatch - currentPatch coefficient for VOC calc non F +diffus levdcmp diffusivity m^2/s F +fr_WFPS levdcmp fr_WFPS fraction F +n2_n2o_ratio_denit levdcmp n2_n2o_ratio_denit gN/gN F +num_iter - number of iterations unitless F +r_psi levdcmp r_psi m F +ratio_k1 levdcmp ratio_k1 none F +ratio_no3_co2 levdcmp ratio_no3_co2 ratio F +soil_bulkdensity levdcmp soil_bulkdensity kg/m3 F +soil_co2_prod levdcmp soil_co2_prod ug C / g soil / day F +watfc levgrnd water field capacity m^3/m^3 F +watsat levgrnd water saturated m^3/m^3 F +=================================== ================ ============================================================================================== ================================================================= ======= diff --git a/src/main/histFileMod.F90 b/src/main/histFileMod.F90 index 6c0b53abc1..4560b7b165 100644 --- a/src/main/histFileMod.F90 +++ b/src/main/histFileMod.F90 @@ -356,7 +356,7 @@ subroutine hist_printflds() ! !ARGUMENTS: ! ! !LOCAL VARIABLES: - integer, parameter :: ncol = 4 ! number of table columns + integer, parameter :: ncol = 5 ! number of table columns integer nf, i, j ! do-loop counters integer hist_fields_file ! file unit number integer width_col(ncol) ! widths of table columns @@ -390,13 +390,14 @@ subroutine hist_printflds() if (masterproc .and. hist_fields_list_file) then ! Hardwired table column widths to fit the table on a computer ! screen. Some strings will be truncated as a result of the - ! current choices (35, 94, 65, 7). In sphinx (ie the web-based + ! current choices (35, 16, 94, 65, 7). In sphinx (ie the web-based ! documentation), text that has not been truncated will wrap ! around in the available space. width_col(1) = 35 ! variable name column - width_col(2) = 94 ! long description column - width_col(3) = 65 ! units column - width_col(4) = 7 ! active (T or F) column + width_col(2) = hist_dim_name_length ! level dimension column + width_col(3) = 94 ! long description column + width_col(4) = 65 ! units column + width_col(5) = 7 ! active (T or F) column width_col_sum = sum(width_col) + ncol - 1 ! sum of widths & blank spaces ! Convert integer widths to strings for use in format statements @@ -450,9 +451,9 @@ subroutine hist_printflds() fmt_txt = '('//str_w_col_sum//'a)' write(hist_fields_file,fmt_txt) ('-', i=1, width_col_sum) ! Concatenate strings needed in format statement - fmt_txt = '(a'//str_width_col(1)//',x,a'//str_width_col(2)//',x,a'//str_width_col(3)//',x,a'//str_width_col(4)//')' + fmt_txt = '(a'//str_width_col(1)//',x,a'//str_width_col(2)//',x,a'//str_width_col(3)//',x,a'//str_width_col(4)//',x,a'//str_width_col(5)//')' write(hist_fields_file,fmt_txt) 'Variable Name', & - 'Long Description', 'Units', 'Active?' + 'Level Dim.', 'Long Description', 'Units', 'Active?' ! End header, same as header ! Concatenate strings needed in format statement @@ -464,10 +465,11 @@ subroutine hist_printflds() ! Main table ! Concatenate strings needed in format statement - fmt_txt = '(a'//str_width_col(1)//',x,a'//str_width_col(2)//',x,a'//str_width_col(3)//',l'//str_width_col(4)//')' + fmt_txt = '(a'//str_width_col(1)//',x,a'//str_width_col(2)//',x,a'//str_width_col(3)//',x,a'//str_width_col(4)//',l'//str_width_col(5)//')' do nf = 1,nallhistflds write(hist_fields_file,fmt_txt) & allhistfldlist(nf)%field%name, & + allhistfldlist(nf)%field%type2d, & allhistfldlist(nf)%field%long_name, & allhistfldlist(nf)%field%units, & allhistfldlist(nf)%actflag(1) @@ -5369,7 +5371,7 @@ subroutine hist_addfld1d (fname, units, avgflag, long_name, type1d_out, & ! Add field to allhistfldlist call allhistfldlist_addfld (fname=trim(fname), numdims=1, type1d=l_type1d, & - type1d_out=l_type1d_out, type2d='unset', num2d=1, & + type1d_out=l_type1d_out, type2d='-', num2d=1, & units=units, avgflag=avgflag, long_name=long_name, hpindex=hpindex, & p2c_scale_type=scale_type_p2c, c2l_scale_type=scale_type_c2l, & l2g_scale_type=scale_type_l2g) From e0fd4f2364df6957ae5e48361a3c6eaeecbf438b Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Mon, 21 Aug 2023 15:09:54 -0600 Subject: [PATCH 197/257] Update ChangeLog and ChangeSum --- doc/ChangeLog | 66 +++++++++++++++++++++++++++++++++++++++++++++++++++ doc/ChangeSum | 1 + 2 files changed, 67 insertions(+) diff --git a/doc/ChangeLog b/doc/ChangeLog index 43a19a6644..7a00a0e80d 100644 --- a/doc/ChangeLog +++ b/doc/ChangeLog @@ -1,4 +1,70 @@ =============================================================== +Tag name: ctsm5.1.dev135 +Originator(s): slevis (Samuel Levis,UCAR/TSS,303-665-1310) +Date: Mon Aug 21 15:06:35 MDT 2023 +One-line Summary: Rename hist fields to track them down more easily + +Purpose and description of changes +---------------------------------- + + Renaming history fields to make easier to find in lists, e.g. when + using ncview. For example, litter fields like MET_LIT and STR_LIT + will be LIT_MET and LIT_STR. + + +Significant changes to scientifically-supported configurations +-------------------------------------------------------------- + +Does this tag change answers significantly for any of the following physics configurations? +(Details of any changes will be given in the "Answer changes" section below.) + + [Put an [X] in the box for any configuration with significant answer changes.] + +[ ] clm5_1 + +[ ] clm5_0 + +[ ] ctsm5_0-nwp + +[ ] clm4_5 + + +Bugs fixed or introduced +------------------------ +CTSM issues fixed (include CTSM Issue #): + Fixes #2095 + + +Testing summary: +---------------- +[Remove any lines that don't apply.] + + [PASS means all tests PASS; OK means tests PASS other than expected fails.] + + regular tests (aux_clm: https://github.com/ESCOMP/CTSM/wiki/System-Testing-Guide#pre-merge-system-testing): + + cheyenne ---- OK + izumi ------- OK + + any other testing (give details below): + Sam L. ran the LMWG diag. pkg and found only one plot affected by this + PR's changes. In particular, set 6 CWD_C, which was CWDC + + +Answer changes +-------------- + +Changes answers relative to baseline: + No. Field lists differ. In some tests, the namelists differ. + + +Other details +------------- +Pull Requests that document the changes (include PR ids): + https://github.com/ESCOMP/ctsm/pull/2106 + +=============================================================== +=============================================================== Tag name: ctsm5.1.dev134 Originator(s): rgknox (Ryan Knox,LBNL EESA), erik (Erik Kluzek,UCAR/TSS,303-497-1326) Date: Wed Aug 16 17:20:27 MDT 2023 diff --git a/doc/ChangeSum b/doc/ChangeSum index 5270412209..67f357480b 100644 --- a/doc/ChangeSum +++ b/doc/ChangeSum @@ -1,5 +1,6 @@ Tag Who Date Summary ============================================================================================================================ + ctsm5.1.dev135 slevis 08/21/2023 Rename hist fields to track them down more easily ctsm5.1.dev134 rgknox 08/16/2023 Migration of FATES to share normal soil BGC call sequence and functionality ctsm5.1.dev133 glemieux 08/09/2023 FATES API update to facilitate fates refactor ctsm5.1.dev132 slevis 08/04/2023 Add parameterization to allow excess ice in soil and subsidence From 1d962dd37be6cd48fef424d05d108ad8bdcff75a Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Mon, 21 Aug 2023 15:31:37 -0600 Subject: [PATCH 198/257] Revisions part 1 in response to Erik's review --- bld/namelist_files/namelist_defaults_ctsm.xml | 2 -- src/biogeophys/BareGroundFluxesMod.F90 | 13 +++++-------- src/biogeophys/CanopyFluxesMod.F90 | 11 +++++------ src/biogeophys/FrictionVelocityMod.F90 | 14 +++----------- src/biogeophys/HumanIndexMod.F90 | 3 +-- src/biogeophys/LakeFluxesMod.F90 | 18 +++++++++++------- src/main/clm_varcon.F90 | 3 +++ 7 files changed, 28 insertions(+), 36 deletions(-) diff --git a/bld/namelist_files/namelist_defaults_ctsm.xml b/bld/namelist_files/namelist_defaults_ctsm.xml index 4ae6f03159..88b2947b10 100644 --- a/bld/namelist_files/namelist_defaults_ctsm.xml +++ b/bld/namelist_files/namelist_defaults_ctsm.xml @@ -213,7 +213,6 @@ attributes from the config_cache.xml file (with keys converted to upper-case). 2.0d00 2.0d00 0.5d00 -0.5d00 0.5d00 2.0d00 @@ -505,7 +504,6 @@ attributes from the config_cache.xml file (with keys converted to upper-case). ZengWang2007 .true. -.false. .false. diff --git a/src/biogeophys/BareGroundFluxesMod.F90 b/src/biogeophys/BareGroundFluxesMod.F90 index 76a07f0f61..3b0bb4849e 100644 --- a/src/biogeophys/BareGroundFluxesMod.F90 +++ b/src/biogeophys/BareGroundFluxesMod.F90 @@ -82,7 +82,7 @@ subroutine BareGroundFluxes(bounds, num_noexposedvegp, filter_noexposedvegp, & use shr_const_mod , only : SHR_CONST_RGAS use clm_varpar , only : nlevgrnd use clm_varcon , only : cpair, vkc, grav, denice, denh2o - use clm_varcon , only : beta_param, nu_param + use clm_varcon , only : beta_param, nu_param, meier_param3 use clm_varctl , only : use_lch4, z0param_method use landunit_varcon , only : istsoil, istcrop use QSatMod , only : QSat @@ -356,13 +356,10 @@ subroutine BareGroundFluxes(bounds, num_noexposedvegp, filter_noexposedvegp, & case ('Meier2022') ! After Yang et al. (2008) - z0hg_patch(p) = 70._r8 * nu_param / ustar(p) * exp( -beta_param * ustar(p)**(0.5_r8) * (abs(tstar))**(0.25_r8)) - - ! RM: After Owen and Thomson (1963). This formulation could be used as an alternative to Yang et al. (2007). It would - ! avoid that z0hg and z0qg becomes larger frequently than z0mg, which happens with Yang et al. (2007). - !z0hg_patch(p) = z0mg_patch(p) / exp(0.52_r8 * 0.4_r8 * (8._r8 * ustar(p) * z0mg_patch(p) / nu_param)**params_inst%a_exp * 0.71_r8**0.8_r8) - - + ! (...)**0.5 = sqrt(...) and (...)**0.25 = sqrt(sqrt(...)) + ! likely more efficient to calculate as exponents + z0hg_patch(p) = meier_param3 * nu_param / ustar(p) * exp( -beta_param * ustar(p)**(0.5_r8) * (abs(tstar))**(0.25_r8)) + end select z0qg_patch(p) = z0hg_patch(p) diff --git a/src/biogeophys/CanopyFluxesMod.F90 b/src/biogeophys/CanopyFluxesMod.F90 index 75c77fcd25..b3e5089575 100644 --- a/src/biogeophys/CanopyFluxesMod.F90 +++ b/src/biogeophys/CanopyFluxesMod.F90 @@ -332,6 +332,7 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, real(r8) :: cir(bounds%begp:bounds%endp) ! atmos. radiation temporay set real(r8) :: dc1,dc2 ! derivative of energy flux [W/m2/K] real(r8) :: delt ! temporary + real(r8) :: delt_threshold ! temporary real(r8) :: delq(bounds%begp:bounds%endp) ! temporary real(r8) :: del(bounds%begp:bounds%endp) ! absolute change in leaf temp in current iteration [K] real(r8) :: del2(bounds%begp:bounds%endp) ! change in leaf temperature in previous iteration [K] @@ -894,16 +895,18 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, z0mv(p) = exp(egvf * log(z0mv(p)) + (1._r8 - egvf) * log(z0mg(c))) case ('Meier2022') - lt = max(0.00001_r8,elai(p)+esai(p)) + delt_threshold = 1.e-4 + lt = max(delt_threshold, elai(p) + esai(p)) displa(p) = htop(p) * (1._r8 - (1._r8 - exp(-(cd1_param * lt)**0.5_r8)) / (cd1_param*lt)**0.5_r8) lt = min(lt,z0v_LAImax(patch%itype(p))) delt = 2._r8 + ! Reminder that (...)**(-0.5) = 1 / sqrt(...) U_ustar_ini = (z0v_Cs(patch%itype(p)) + z0v_Cr(patch%itype(p)) * lt * 0.5_r8)**(-0.5_r8) & *z0v_c(patch%itype(p)) * lt * 0.25_r8 U_ustar = U_ustar_ini - do while (delt > 0.0001_r8) + do while (delt > delt_threshold) U_ustar_prev = U_ustar U_ustar = U_ustar_ini * exp(U_ustar_prev) delt = abs(U_ustar - U_ustar_prev) @@ -1066,10 +1069,6 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, ! changed by K.Sakaguchi from here ! transfer coefficient over bare soil is changed to a local variable ! just for readability of the code (from line 680) - ! RM: Does this need to be updated if Ya08 is used too? Proposed formulation (definitely double-check!) - ! , interpreting the statement below as csoilb = vkc / ln(z0mg/z0hg): - ! csoilb = vkc / log( z0mg(c) / ( 70._r8 * nu_param / ustar(p) * exp( -7.2_r8 * ustar(p)**(0.5_r8) * - ! (abs(temp1(p)*dth(p)))**(0.25_r8)) ) ) csoilb = vkc / (params_inst%a_coef * (z0mg(c) * uaf(p) / nu_param)**params_inst%a_exp) diff --git a/src/biogeophys/FrictionVelocityMod.F90 b/src/biogeophys/FrictionVelocityMod.F90 index 621bce4117..56f06c47c2 100644 --- a/src/biogeophys/FrictionVelocityMod.F90 +++ b/src/biogeophys/FrictionVelocityMod.F90 @@ -517,7 +517,7 @@ subroutine SetRoughnessLengthsAndForcHeightsNonLake(this, bounds, & ! Set roughness lengths and forcing heights for non-lake points ! ! !USES: - use clm_varcon , only : rpi, b1_param, b4_param + use clm_varcon , only : rpi, b1_param, b4_param, meier_param1, meier_param2 ! !ARGUMENTS: class(frictionvel_type) , intent(inout) :: this type(bounds_type) , intent(in) :: bounds @@ -577,15 +577,7 @@ subroutine SetRoughnessLengthsAndForcHeightsNonLake(this, bounds, & select case (z0param_method) case ('ZengWang2007') if (frac_sno(c) > 0._r8) then - if(use_z0m_snowmelt) then - if ( snomelt_accum(c) < 1.e-5_r8 )then - z0mg(c) = exp(-b1_param * rpi * 0.5_r8 + b4_param) * 1.e-3_r8 - else - z0mg(c) = exp(b1_param * (atan((log10(snomelt_accum(c))+0.23_r8)/0.08_r8)) + b4_param) * 1.e-3_r8 - end if - else - z0mg(c) = this%zsno - end if + z0mg(c) = this%zsno else z0mg(c) = this%zlnd end if @@ -596,7 +588,7 @@ subroutine SetRoughnessLengthsAndForcHeightsNonLake(this, bounds, & if ( snomelt_accum(c) < 1.e-5_r8 )then z0mg(c) = exp(-b1_param * rpi * 0.5_r8 + b4_param) * 1.e-3_r8 else - z0mg(c) = exp(b1_param * (atan((log10(snomelt_accum(c))+0.23_r8)/0.08_r8)) + b4_param) * 1.e-3_r8 + z0mg(c) = exp(b1_param * (atan((log10(snomelt_accum(c)) + meier_param1) / meier_param2)) + b4_param) * 1.e-3_r8 end if else z0mg(c) = this%zsno diff --git a/src/biogeophys/HumanIndexMod.F90 b/src/biogeophys/HumanIndexMod.F90 index 403dae777d..17a1ef968e 100644 --- a/src/biogeophys/HumanIndexMod.F90 +++ b/src/biogeophys/HumanIndexMod.F90 @@ -1014,7 +1014,6 @@ subroutine Wet_BulbS (Tc_6,rh,wbt) ! !LOCAL VARIABLES: !EOP ! -#ifndef NDEBUG if ( rh < 0.0d00 )then write(iulog,*) 'rh = ', rh call endrun(msg="ERROR RH is negative "//errmsg(sourcefile, __LINE__)) @@ -1022,7 +1021,7 @@ subroutine Wet_BulbS (Tc_6,rh,wbt) write(iulog,*) 'rh = ', rh call endrun(msg="ERROR RH is greater than a hundred "//errmsg(sourcefile, __LINE__)) end if -#endif + wbt = Tc_6 * atan(0.151977_r8*sqrt(rh + 8.313659_r8)) + & atan(Tc_6+rh) - atan(rh-1.676331_r8) + & 0.00391838_r8*rh**(3._r8/2._r8)*atan(0.023101_r8*rh) - & diff --git a/src/biogeophys/LakeFluxesMod.F90 b/src/biogeophys/LakeFluxesMod.F90 index 11b141100c..1b544a8364 100644 --- a/src/biogeophys/LakeFluxesMod.F90 +++ b/src/biogeophys/LakeFluxesMod.F90 @@ -94,6 +94,7 @@ subroutine LakeFluxes(bounds, num_lakec, filter_lakec, num_lakep, filter_lakep, use clm_varcon , only : hvap, hsub, hfus, cpair, cpliq, tkwat, tkice, tkair use clm_varcon , only : sb, vkc, grav, denh2o, tfrz, spval, rpi use clm_varcon , only : beta_param, nu_param, b1_param, b4_param + use clm_varcon , only : meier_param1, meier_param2, meier_param3 use clm_varctl , only : use_lch4, z0param_method, use_z0m_snowmelt use LakeCon , only : betavis, z0frzlake, tdmax, emg_lake use LakeCon , only : lake_use_old_fcrit_minz0 @@ -341,7 +342,7 @@ subroutine LakeFluxes(bounds, num_lakec, filter_lakec, num_lakep, filter_lakep, z0mg(p) = params_inst%zglc - z0hg(p) = 70._r8 * nu_param / ust_lake(c) ! For initial guess assume tstar = 0 + z0hg(p) = meier_param3 * nu_param / ust_lake(c) ! For initial guess assume tstar = 0 case ('ZengWang2007') z0mg(p) = z0frzlake @@ -353,7 +354,7 @@ subroutine LakeFluxes(bounds, num_lakec, filter_lakec, num_lakep, filter_lakep, if ( snomelt_accum(c) < 1.e-5_r8 ) then z0mg(p) = exp(-b1_param * rpi * 0.5_r8 + b4_param) * 1.e-3_r8 else - z0mg(p) = exp(b1_param * (atan((log10(snomelt_accum(c))+0.23_r8)/0.08_r8)) + b4_param) * 1.e-3_r8 + z0mg(p) = exp(b1_param * (atan((log10(snomelt_accum(c)) + meier_param1) / meier_param2)) + b4_param) * 1.e-3_r8 end if else z0mg(p) = params_inst%zsno @@ -361,7 +362,7 @@ subroutine LakeFluxes(bounds, num_lakec, filter_lakec, num_lakep, filter_lakep, select case (z0param_method) case ('Meier2022') - z0hg(p) = 70._r8 * nu_param / ust_lake(c) ! For initial guess assume tstar = 0 + z0hg(p) = meier_param3 * nu_param / ust_lake(c) ! For initial guess assume tstar = 0 case ('ZengWang2007') z0hg(p) = z0mg(p) / exp(params_inst%a_coef * (ust_lake(c) * z0mg(p) / nu_param)**params_inst%a_exp) ! Consistent with BareGroundFluxes end select @@ -593,8 +594,9 @@ subroutine LakeFluxes(bounds, num_lakec, filter_lakec, num_lakep, filter_lakep, select case (z0param_method) case ('Meier2022') z0mg(p) = params_inst%zglc - - z0hg(p) = 70._r8 * nu_param / ustar(p) * exp( -beta_param * ustar(p)**(0.5_r8) * (abs(tstar))**(0.25_r8)) ! Consistent with BareGroundFluxes + ! (...)**0.5 = sqrt(...) and (...)**0.25 = sqrt(sqrt(...)) + ! likely more efficient to calculate as exponents + z0hg(p) = meier_param3 * nu_param / ustar(p) * exp( -beta_param * ustar(p)**(0.5_r8) * (abs(tstar))**(0.25_r8)) ! Consistent with BareGroundFluxes case ('ZengWang2007') z0mg(p) = z0frzlake @@ -606,13 +608,15 @@ subroutine LakeFluxes(bounds, num_lakec, filter_lakec, num_lakep, filter_lakep, if ( snomelt_accum(c) < 1.e-5_r8 )then z0mg(p) = exp(-b1_param * rpi * 0.5_r8 + b4_param) * 1.e-3_r8 else - z0mg(p) = exp(b1_param * (atan((log10(snomelt_accum(c))+0.23_r8)/0.08_r8)) + b4_param) * 1.e-3_r8 + z0mg(p) = exp(b1_param * (atan((log10(snomelt_accum(c)) + meier_param1) / meier_param2)) + b4_param) * 1.e-3_r8 end if end if select case (z0param_method) case ('Meier2022') - z0hg(p) = 70._r8 * nu_param / ustar(p) * exp( -beta_param * ustar(p)**(0.5_r8) * (abs(tstar))**(0.25_r8)) ! Consistent with BareGroundFluxes + ! (...)**0.5 = sqrt(...) and (...)**0.25 = sqrt(sqrt(...)) + ! likely more efficient to calculate as exponents + z0hg(p) = meier_param3 * nu_param / ustar(p) * exp( -beta_param * ustar(p)**(0.5_r8) * (abs(tstar))**(0.25_r8)) ! Consistent with BareGroundFluxes case ('ZengWang2007') z0hg(p) = z0mg(p) / exp(params_inst%a_coef * (ustar(p) * z0mg(p) / nu_param)**params_inst%a_exp) ! Consistent with BareGroundFluxes diff --git a/src/main/clm_varcon.F90 b/src/main/clm_varcon.F90 index f898e27307..4b0bbe160d 100644 --- a/src/main/clm_varcon.F90 +++ b/src/main/clm_varcon.F90 @@ -162,6 +162,9 @@ module clm_varcon real(r8), public, parameter :: b1_param = 1.4_r8 ! Meier et al. (2022) empirical constant real(r8), public, parameter :: b4_param = -0.31_r8 ! Meier et al. (2022) empirical constant real(r8), public, parameter :: cd1_param = 7.5_r8 ! Meier et al. (2022) originally from Raupach (1994) + real(r8), public, parameter :: meier_param1 = 0.23_r8 ! slevis did not find it documented + real(r8), public, parameter :: meier_param2 = 0.08_r8 ! slevis did not find it documented + real(r8), public, parameter :: meier_param3 = 70.0_r8 ! slevis did not find it documented, but to the question "What is the 70 in the formula for roughness length" bard.google.com responds "[...] a dimensionless constant [...] originally introduced by von Karman. It is based on experimental data and is thought to represent the ratio of the average height of the surface roughness elements to the distance that the wind travels before it is slowed down by the roughness." !------------------------------------------------------------------ ! Urban building temperature constants From 59745d059933bc7ac4ca29438337dd24cb7faa24 Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Mon, 21 Aug 2023 15:41:24 -0600 Subject: [PATCH 199/257] Revisions part 2: add missing comment --- src/main/clm_varctl.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/main/clm_varctl.F90 b/src/main/clm_varctl.F90 index 7179e6afe6..559a95b570 100644 --- a/src/main/clm_varctl.F90 +++ b/src/main/clm_varctl.F90 @@ -249,7 +249,7 @@ module clm_varctl ! Surface roughness parameterization !---------------------------------------------------------- - character(len=64), public :: z0param_method + character(len=64), public :: z0param_method ! ZengWang2007 or Meier2022 logical, public :: use_z0m_snowmelt = .false. ! true => use snow z0m parameterization of Brock2006 From fea92f253d925f2c64ec5413690d0b4239831159 Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Mon, 21 Aug 2023 17:30:02 -0600 Subject: [PATCH 200/257] Revert delt_threshold param back to hardwired values --- src/biogeophys/CanopyFluxesMod.F90 | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/src/biogeophys/CanopyFluxesMod.F90 b/src/biogeophys/CanopyFluxesMod.F90 index b3e5089575..3ab3bb7923 100644 --- a/src/biogeophys/CanopyFluxesMod.F90 +++ b/src/biogeophys/CanopyFluxesMod.F90 @@ -332,7 +332,6 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, real(r8) :: cir(bounds%begp:bounds%endp) ! atmos. radiation temporay set real(r8) :: dc1,dc2 ! derivative of energy flux [W/m2/K] real(r8) :: delt ! temporary - real(r8) :: delt_threshold ! temporary real(r8) :: delq(bounds%begp:bounds%endp) ! temporary real(r8) :: del(bounds%begp:bounds%endp) ! absolute change in leaf temp in current iteration [K] real(r8) :: del2(bounds%begp:bounds%endp) ! change in leaf temperature in previous iteration [K] @@ -895,8 +894,7 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, z0mv(p) = exp(egvf * log(z0mv(p)) + (1._r8 - egvf) * log(z0mg(c))) case ('Meier2022') - delt_threshold = 1.e-4 - lt = max(delt_threshold, elai(p) + esai(p)) + lt = max(1.e-5_r8, elai(p) + esai(p)) displa(p) = htop(p) * (1._r8 - (1._r8 - exp(-(cd1_param * lt)**0.5_r8)) / (cd1_param*lt)**0.5_r8) lt = min(lt,z0v_LAImax(patch%itype(p))) @@ -906,7 +904,7 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, *z0v_c(patch%itype(p)) * lt * 0.25_r8 U_ustar = U_ustar_ini - do while (delt > delt_threshold) + do while (delt > 1.e-4_r8) U_ustar_prev = U_ustar U_ustar = U_ustar_ini * exp(U_ustar_prev) delt = abs(U_ustar - U_ustar_prev) From 7a39c65bc15adad93ae101c4dc696faec772058e Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Mon, 21 Aug 2023 17:31:19 -0600 Subject: [PATCH 201/257] Ensure that ZengWang2007 and use_z0m_snowmelt NOT true simultaneously --- bld/CLMBuildNamelist.pm | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/bld/CLMBuildNamelist.pm b/bld/CLMBuildNamelist.pm index a7ee8f2dc9..84c9146f03 100755 --- a/bld/CLMBuildNamelist.pm +++ b/bld/CLMBuildNamelist.pm @@ -4381,6 +4381,13 @@ sub setup_logic_z0param { my $z0param_method = remove_leading_and_trailing_quotes($nl->get_value('z0param_method' )); add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'use_z0m_snowmelt', 'z0param_method'=>$z0param_method ); + + my $use_z0m_snowmelt = $nl->get_value( 'use_z0m_snowmelt' ); + + if ( $z0param_method eq "ZengWang2007" && defined($use_z0m_snowmelt) && value_is_true($use_z0m_snowmelt)) { + $log->fatal_error("use_z0m_snowmelt must be .false. when z0param_method = $z0param_method.\n $@"); + } + } #------------------------------------------------------------------------------- From 0875c515e100d87254e6c5b754d39ee82fe87ff5 Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Mon, 21 Aug 2023 18:21:08 -0600 Subject: [PATCH 202/257] Removed white space that appears red in git diff --- bld/CLMBuildNamelist.pm | 2 +- src/biogeophys/BareGroundFluxesMod.F90 | 12 +++++------ src/biogeophys/BiogeophysPreFluxCalcsMod.F90 | 16 +++++++------- src/biogeophys/CanopyFluxesMod.F90 | 7 +++---- src/biogeophys/FrictionVelocityMod.F90 | 22 +++++++++----------- src/biogeophys/LakeFluxesMod.F90 | 18 ++++++++-------- src/biogeophys/SnowHydrologyMod.F90 | 4 ++-- src/biogeophys/SoilTemperatureMod.F90 | 4 ++-- src/main/clm_varctl.F90 | 1 - src/main/pftconMod.F90 | 22 ++++++++++---------- 10 files changed, 52 insertions(+), 56 deletions(-) diff --git a/bld/CLMBuildNamelist.pm b/bld/CLMBuildNamelist.pm index 84c9146f03..54a6aea7e4 100755 --- a/bld/CLMBuildNamelist.pm +++ b/bld/CLMBuildNamelist.pm @@ -4378,7 +4378,7 @@ sub setup_logic_z0param { add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'z0param_method'); - my $z0param_method = remove_leading_and_trailing_quotes($nl->get_value('z0param_method' )); + my $z0param_method = remove_leading_and_trailing_quotes($nl->get_value('z0param_method' )); add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'use_z0m_snowmelt', 'z0param_method'=>$z0param_method ); diff --git a/src/biogeophys/BareGroundFluxesMod.F90 b/src/biogeophys/BareGroundFluxesMod.F90 index 3b0bb4849e..645b908157 100644 --- a/src/biogeophys/BareGroundFluxesMod.F90 +++ b/src/biogeophys/BareGroundFluxesMod.F90 @@ -92,7 +92,7 @@ subroutine BareGroundFluxes(bounds, num_noexposedvegp, filter_noexposedvegp, & swbgt, hmdex, dis_coi, dis_coiS, THIndex, & SwampCoolEff, KtoC, VaporPres use CanopyStateType , only : canopystate_type - + ! ! !ARGUMENTS: type(bounds_type) , intent(in) :: bounds @@ -247,9 +247,9 @@ subroutine BareGroundFluxes(bounds, num_noexposedvegp, filter_noexposedvegp, & z0mg_patch => frictionvel_inst%z0mg_patch , & ! Output: [real(r8) (:) ] patch roughness length, momentum [m] z0hg_patch => frictionvel_inst%z0hg_patch , & ! Output: [real(r8) (:) ] patch roughness length, sensible heat [m] z0qg_patch => frictionvel_inst%z0qg_patch , & ! Output: [real(r8) (:) ] patch roughness length, latent heat [m] - z0mv => frictionvel_inst%z0mv_patch , & ! Output: [real(r8) (:) ] roughness length over vegetation, momentum [m] - z0hv => frictionvel_inst%z0hv_patch , & ! Output: [real(r8) (:) ] roughness length over vegetation, sensible heat [m] - z0qv => frictionvel_inst%z0qv_patch , & ! Output: [real(r8) (:) ] roughness length over vegetation, latent heat [m] + z0mv => frictionvel_inst%z0mv_patch , & ! Output: [real(r8) (:) ] roughness length over vegetation, momentum [m] + z0hv => frictionvel_inst%z0hv_patch , & ! Output: [real(r8) (:) ] roughness length over vegetation, sensible heat [m] + z0qv => frictionvel_inst%z0qv_patch , & ! Output: [real(r8) (:) ] roughness length over vegetation, latent heat [m] kbm1 => frictionvel_inst%kbm1_patch , & ! Output: [real(r8) (:) ] natural logarithm of z0mg_p/z0hg_p [-] ram1 => frictionvel_inst%ram1_patch , & ! Output: [real(r8) (:) ] aerodynamical resistance (s/m) num_iter => frictionvel_inst%num_iter_patch , & ! Output: [real(r8) (:) ] number of iterations @@ -265,7 +265,7 @@ subroutine BareGroundFluxes(bounds, num_noexposedvegp, filter_noexposedvegp, & rssun => photosyns_inst%rssun_patch , & ! Output: [real(r8) (:) ] leaf sunlit stomatal resistance (s/m) (output from Photosynthesis) rssha => photosyns_inst%rssha_patch , & ! Output: [real(r8) (:) ] leaf shaded stomatal resistance (s/m) (output from Photosynthesis) - displa => canopystate_inst%displa_patch , & ! Output: [real(r8) (:) ] displacement height (m) + displa => canopystate_inst%displa_patch , & ! Output: [real(r8) (:) ] displacement height (m) begp => bounds%begp , & endp => bounds%endp & @@ -309,7 +309,7 @@ subroutine BareGroundFluxes(bounds, num_noexposedvegp, filter_noexposedvegp, & z0mv(p) = 0._r8 z0hv(p) = 0._r8 z0qv(p) = 0._r8 - + ur(p) = max(params_inst%wind_min,sqrt(forc_u(g)*forc_u(g)+forc_v(g)*forc_v(g))) dth(p) = thm(p)-t_grnd(c) diff --git a/src/biogeophys/BiogeophysPreFluxCalcsMod.F90 b/src/biogeophys/BiogeophysPreFluxCalcsMod.F90 index 004e2c689e..11842560ee 100644 --- a/src/biogeophys/BiogeophysPreFluxCalcsMod.F90 +++ b/src/biogeophys/BiogeophysPreFluxCalcsMod.F90 @@ -34,7 +34,7 @@ module BiogeophysPreFluxCalcsMod use WaterStateBulkType , only : waterstatebulk_type use SurfaceResistanceMod , only : calc_soilevap_resis use WaterFluxBulkType , only : waterfluxbulk_type - + ! ! !PUBLIC TYPES: implicit none @@ -172,30 +172,30 @@ subroutine SetZ0mDisp(bounds, num_nolakep, filter_nolakep, & z0m(p) = pftcon%z0mr(patch%itype(p)) * htop(p) displa(p) = pftcon%displar(patch%itype(p)) * htop(p) - case ('Meier2022') - + case ('Meier2022') + ! Don't set on first few steps of a simulation, since htop isn't set yet, need to wait until after first do_alb time if ( is_first_step() .or. get_nstep() <= GetBalanceCheckSkipSteps()-1 ) then z0m(p) = 0._r8 - displa(p) = 0._r8 + displa(p) = 0._r8 cycle ! If a crop type and it's the start of the year, htop gets reset to ! zero... else if ( is_beg_curr_year() .and. pftcon%crop(patch%itype(p)) /= 0.0_r8 )then z0m(p) = 0._r8 - displa(p) = 0._r8 + displa(p) = 0._r8 end if if (patch%itype(p) == noveg) then z0m(p) = 0._r8 - displa(p) = 0._r8 + displa(p) = 0._r8 else ! Compute as if elai+esai = LAImax in CanopyFluxes displa(p) = htop(p) * (1._r8 - (1._r8 - exp(-(cd1_param * (pftcon%z0v_LAImax(patch%itype(p))))**0.5_r8)) & / (cd1_param*(pftcon%z0v_LAImax(patch%itype(p)) ))**0.5_r8) - U_ustar = 4._r8 * (pftcon%z0v_Cs(patch%itype(p)) + pftcon%z0v_Cr(patch%itype(p)) * (pftcon%z0v_LAImax(patch%itype(p))) & + U_ustar = 4._r8 * (pftcon%z0v_Cs(patch%itype(p)) + pftcon%z0v_Cr(patch%itype(p)) * (pftcon%z0v_LAImax(patch%itype(p))) & / 2._r8)**(-0.5_r8) / (pftcon%z0v_LAImax(patch%itype(p))) / pftcon%z0v_c(patch%itype(p)) if ( htop(p) <= 1.e-10_r8 )then @@ -210,7 +210,7 @@ subroutine SetZ0mDisp(bounds, num_nolakep, filter_nolakep, & end select - + end if end do diff --git a/src/biogeophys/CanopyFluxesMod.F90 b/src/biogeophys/CanopyFluxesMod.F90 index 3ab3bb7923..e540296b6d 100644 --- a/src/biogeophys/CanopyFluxesMod.F90 +++ b/src/biogeophys/CanopyFluxesMod.F90 @@ -113,7 +113,7 @@ subroutine CanopyFluxesReadNML(NLFilename) namelist /canopyfluxes_inparm/ use_undercanopy_stability namelist /canopyfluxes_inparm/ use_biomass_heat_storage namelist /canopyfluxes_inparm/ itmax_canopy_fluxes - + ! Initialize options to default values, in case they are not specified in ! the namelist @@ -535,7 +535,7 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, forc_hgt_q => atm2lnd_inst%forc_hgt_q_grc , & ! Input: [real(r8) (:) ] observational height of specific humidity [m] forc_hgt_t_patch => frictionvel_inst%forc_hgt_t_patch , & ! Output: [real(r8) (:) ] observational height of temperature at patch level [m] forc_hgt_q_patch => frictionvel_inst%forc_hgt_q_patch , & ! Output: [real(r8) (:) ] observational height of specific humidity at patch level [m] - forc_hgt_u_patch => frictionvel_inst%forc_hgt_u_patch , & ! Output: [real(r8) (:) ] observational height of wind at patch level [m] + forc_hgt_u_patch => frictionvel_inst%forc_hgt_u_patch , & ! Output: [real(r8) (:) ] observational height of wind at patch level [m] z0mg => frictionvel_inst%z0mg_col , & ! Input: [real(r8) (:) ] roughness length of ground, momentum [m] zetamax => frictionvel_inst%zetamaxstable , & ! Input: [real(r8) ] max zeta value under stable conditions ram1 => frictionvel_inst%ram1_patch , & ! Output: [real(r8) (:) ] aerodynamical resistance (s/m) @@ -1068,7 +1068,6 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, ! transfer coefficient over bare soil is changed to a local variable ! just for readability of the code (from line 680) csoilb = vkc / (params_inst%a_coef * (z0mg(c) * uaf(p) / nu_param)**params_inst%a_exp) - !compute the stability parameter for ricsoilc ("S" in Sakaguchi&Zeng,2008) @@ -1482,7 +1481,7 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, dhsdt_canopy(p) = dt_stem(p)*cp_stem(p)/dtime & + (t_veg(p)-tl_ini(p))*cp_leaf(p)/dtime - + t_stem(p) = t_stem(p) + dt_stem(p) else dt_stem(p) = 0._r8 diff --git a/src/biogeophys/FrictionVelocityMod.F90 b/src/biogeophys/FrictionVelocityMod.F90 index 56f06c47c2..7fa583c6a8 100644 --- a/src/biogeophys/FrictionVelocityMod.F90 +++ b/src/biogeophys/FrictionVelocityMod.F90 @@ -23,7 +23,7 @@ module FrictionVelocityMod use atm2lndType , only : atm2lnd_type use WaterDiagnosticBulkType , only : waterdiagnosticbulk_type use CanopyStateType , only : canopystate_type - use WaterFluxBulkType , only : waterfluxbulk_type + use WaterFluxBulkType , only : waterfluxbulk_type ! ! !PUBLIC TYPES: implicit none @@ -60,7 +60,7 @@ module FrictionVelocityMod real(r8), pointer, public :: z0qg_patch (:) ! patch roughness length over ground, latent heat [m] real(r8), pointer, public :: kbm1_patch (:) ! natural logarithm of z0mg_p/z0hg_p [-] real(r8), pointer, public :: z0mg_col (:) ! col roughness length over ground, momentum [m] - real(r8), pointer, public :: z0mg_2D_col (:) ! 2-D field of input col roughness length over ground, momentum [m] + real(r8), pointer, public :: z0mg_2D_col (:) ! 2-D field of input col roughness length over ground, momentum [m] real(r8), pointer, public :: z0hg_col (:) ! col roughness length over ground, sensible heat [m] real(r8), pointer, public :: z0qg_col (:) ! col roughness length over ground, latent heat [m] ! variables to add history output from CanopyFluxesMod @@ -119,7 +119,7 @@ subroutine Init(this, bounds, NLFilename, params_ncid) call this%InitCold(bounds) call this%ReadNamelist(NLFilename) call this%ReadParams(params_ncid) - + end subroutine Init !------------------------------------------------------------------------ @@ -162,7 +162,7 @@ subroutine InitAllocate(this, bounds) allocate(this%z0qg_patch (begp:endp)) ; this%z0qg_patch (:) = nan allocate(this%kbm1_patch (begp:endp)) ; this%kbm1_patch (:) = nan allocate(this%z0mg_col (begc:endc)) ; this%z0mg_col (:) = nan - allocate(this%z0mg_2D_col (begc:endc)) ; this%z0mg_2D_col (:) = nan + allocate(this%z0mg_2D_col (begc:endc)) ; this%z0mg_2D_col (:) = nan allocate(this%z0qg_col (begc:endc)) ; this%z0qg_col (:) = nan allocate(this%z0hg_col (begc:endc)) ; this%z0hg_col (:) = nan allocate(this%rah1_patch (begp:endp)) ; this%rah1_patch (:) = nan @@ -402,12 +402,11 @@ subroutine ReadParams( this, params_ncid ) call readNcdioScalar(params_ncid, 'zsno', subname, this%zsno) ! Momentum roughness length for soil, glacier, wetland (m) call readNcdioScalar(params_ncid, 'zlnd', subname, this%zlnd) - + ! Separated roughness length for glacier if z0param_method == 'Meier2022' if (z0param_method == 'Meier2022') then call readNcdioScalar(params_ncid, 'zglc', subname, this%zglc) end if - end subroutine ReadParams @@ -528,7 +527,7 @@ subroutine SetRoughnessLengthsAndForcHeightsNonLake(this, bounds, & type(atm2lnd_type) , intent(in) :: atm2lnd_inst type(waterdiagnosticbulk_type) , intent(in) :: waterdiagnosticbulk_inst type(canopystate_type) , intent(in) :: canopystate_inst - type(waterfluxbulk_type) , intent(in) :: waterfluxbulk_inst + type(waterfluxbulk_type) , intent(in) :: waterfluxbulk_inst ! ! !LOCAL VARIABLES: integer :: fc, c @@ -557,15 +556,14 @@ subroutine SetRoughnessLengthsAndForcHeightsNonLake(this, bounds, & frac_veg_nosno => canopystate_inst%frac_veg_nosno_patch , & ! Input: [integer (:) ] fraction of vegetation not covered by snow (0 OR 1) [-] frac_sno => waterdiagnosticbulk_inst%frac_sno_col , & ! Input: [real(r8) (:) ] fraction of ground covered by snow (0 to 1) - snomelt_accum => waterdiagnosticbulk_inst%snomelt_accum_col , & ! Input: [real(r8) (:) ] accumulated col snow melt for z0m calculation (m H2O) + snomelt_accum => waterdiagnosticbulk_inst%snomelt_accum_col , & ! Input: [real(r8) (:) ] accumulated col snow melt for z0m calculation (m H2O) urbpoi => lun%urbpoi , & ! Input: [logical (:) ] true => landunit is an urban point z_0_town => lun%z_0_town , & ! Input: [real(r8) (:) ] momentum roughness length of urban landunit (m) z_d_town => lun%z_d_town , & ! Input: [real(r8) (:) ] displacement height of urban landunit (m) forc_hgt_t => atm2lnd_inst%forc_hgt_t_grc , & ! Input: [real(r8) (:) ] observational height of temperature [m] forc_hgt_u => atm2lnd_inst%forc_hgt_u_grc , & ! Input: [real(r8) (:) ] observational height of wind [m] forc_hgt_q => atm2lnd_inst%forc_hgt_q_grc , & ! Input: [real(r8) (:) ] observational height of specific humidity [m] - z0mg_2D => this%z0mg_2D_col & ! Input: [real(r8) (:) ] 2-D field of input col roughness length over ground, momentum [m] - + z0mg_2D => this%z0mg_2D_col & ! Input: [real(r8) (:) ] 2-D field of input col roughness length over ground, momentum [m] ) do fc = 1, num_nolakec @@ -592,14 +590,14 @@ subroutine SetRoughnessLengthsAndForcHeightsNonLake(this, bounds, & end if else z0mg(c) = this%zsno - end if + end if else if (lun%itype(l) == istice) then z0mg(c) = this%zglc else z0mg(c) = this%zlnd end if end select - + z0hg(c) = z0mg(c) ! initial set only z0qg(c) = z0mg(c) ! initial set only diff --git a/src/biogeophys/LakeFluxesMod.F90 b/src/biogeophys/LakeFluxesMod.F90 index 1b544a8364..fdd105ad8f 100644 --- a/src/biogeophys/LakeFluxesMod.F90 +++ b/src/biogeophys/LakeFluxesMod.F90 @@ -66,7 +66,7 @@ subroutine readParams( ncid ) call readNcdioScalar(ncid, 'a_exp', subname, params_inst%a_exp) ! Momentum roughness length for snow (m) call readNcdioScalar(ncid, 'zsno', subname, params_inst%zsno) - + if (z0param_method == 'Meier2022') then ! Momentum roughness length for ice (m) call readNcdioScalar(ncid, 'zglc', subname, params_inst%zglc) @@ -228,8 +228,8 @@ subroutine LakeFluxes(bounds, num_lakec, filter_lakec, num_lakep, filter_lakep, lakefetch => lakestate_inst%lakefetch_col , & ! Input: [real(r8) (:) ] lake fetch from surface data (m) h2osoi_liq => waterstatebulk_inst%h2osoi_liq_col , & ! Input: [real(r8) (:,:) ] liquid water (kg/m2) - h2osoi_ice => waterstatebulk_inst%h2osoi_ice_col , & ! Input: [real(r8) (:,:) ] ice lens (kg/m2) - snomelt_accum => waterdiagnosticbulk_inst%snomelt_accum_col , & ! Input: [real(r8) (:) ] accumulated col snow melt for z0m calculation (m H2O) + h2osoi_ice => waterstatebulk_inst%h2osoi_ice_col , & ! Input: [real(r8) (:,:) ] ice lens (kg/m2) + snomelt_accum => waterdiagnosticbulk_inst%snomelt_accum_col , & ! Input: [real(r8) (:) ] accumulated col snow melt for z0m calculation (m H2O) t_skin_patch => temperature_inst%t_skin_patch , & ! Output: [real(r8) (:) ] patch skin temperature (K) t_lake => temperature_inst%t_lake_col , & ! Input: [real(r8) (:,:) ] lake temperature (Kelvin) @@ -338,7 +338,7 @@ subroutine LakeFluxes(bounds, num_lakec, filter_lakec, num_lakep, filter_lakep, z0hg(p) = max(z0hg(p), minz0lake) else if (snl(c) == 0) then ! frozen lake with ice select case (z0param_method) - case ('Meier2022') + case ('Meier2022') z0mg(p) = params_inst%zglc @@ -361,7 +361,7 @@ subroutine LakeFluxes(bounds, num_lakec, filter_lakec, num_lakep, filter_lakep, end if select case (z0param_method) - case ('Meier2022') + case ('Meier2022') z0hg(p) = meier_param3 * nu_param / ust_lake(c) ! For initial guess assume tstar = 0 case ('ZengWang2007') z0hg(p) = z0mg(p) / exp(params_inst%a_coef * (ust_lake(c) * z0mg(p) / nu_param)**params_inst%a_exp) ! Consistent with BareGroundFluxes @@ -424,7 +424,7 @@ subroutine LakeFluxes(bounds, num_lakec, filter_lakec, num_lakep, filter_lakep, g = patch%gridcell(p) dhsdt_canopy(p) = 0.0_r8 - + nmozsgn(p) = 0 obuold(p) = 0._r8 displa(p) = 0._r8 @@ -592,12 +592,12 @@ subroutine LakeFluxes(bounds, num_lakec, filter_lakec, num_lakep, filter_lakep, else if (snl(c) == 0) then ! in case it was above freezing and now below freezing select case (z0param_method) - case ('Meier2022') + case ('Meier2022') z0mg(p) = params_inst%zglc ! (...)**0.5 = sqrt(...) and (...)**0.25 = sqrt(sqrt(...)) ! likely more efficient to calculate as exponents z0hg(p) = meier_param3 * nu_param / ustar(p) * exp( -beta_param * ustar(p)**(0.5_r8) * (abs(tstar))**(0.25_r8)) ! Consistent with BareGroundFluxes - + case ('ZengWang2007') z0mg(p) = z0frzlake z0hg(p) = z0mg(p) / exp(params_inst%a_coef * (ustar(p) * z0mg(p) / nu_param)**params_inst%a_exp) ! Consistent with BareGroundFluxes @@ -606,7 +606,7 @@ subroutine LakeFluxes(bounds, num_lakec, filter_lakec, num_lakep, filter_lakep, else ! Snow layers if(use_z0m_snowmelt) then if ( snomelt_accum(c) < 1.e-5_r8 )then - z0mg(p) = exp(-b1_param * rpi * 0.5_r8 + b4_param) * 1.e-3_r8 + z0mg(p) = exp(-b1_param * rpi * 0.5_r8 + b4_param) * 1.e-3_r8 else z0mg(p) = exp(b1_param * (atan((log10(snomelt_accum(c)) + meier_param1) / meier_param2)) + b4_param) * 1.e-3_r8 end if diff --git a/src/biogeophys/SnowHydrologyMod.F90 b/src/biogeophys/SnowHydrologyMod.F90 index 91689a9d28..4698e1136d 100644 --- a/src/biogeophys/SnowHydrologyMod.F90 +++ b/src/biogeophys/SnowHydrologyMod.F90 @@ -435,7 +435,7 @@ subroutine BulkDiag_NewSnowDiagnostics(bounds, num_c, filter_c, & real(r8) , intent(inout) :: frac_sno( bounds%begc: ) ! fraction of ground covered by snow (0 to 1) real(r8) , intent(inout) :: frac_sno_eff( bounds%begc: ) ! eff. fraction of ground covered by snow (0 to 1) real(r8) , intent(inout) :: snow_depth( bounds%begc: ) ! snow height (m) - real(r8) , intent(inout) :: snomelt_accum( bounds%begc: ) ! accumulated col snow melt for z0m calculation (m H2O) + real(r8) , intent(inout) :: snomelt_accum( bounds%begc: ) ! accumulated col snow melt for z0m calculation (m H2O) ! ! !LOCAL VARIABLES: integer :: fc, c @@ -491,7 +491,7 @@ subroutine BulkDiag_NewSnowDiagnostics(bounds, num_c, filter_c, & ! all snow falls on ground, no snow on h2osfc (note that qflx_snow_h2osfc is ! currently set to 0 always in CanopyHydrologyMod) newsnow(c) = qflx_snow_grnd(c) * dtime - snomelt_accum(c) = max(0._r8, snomelt_accum(c) - newsnow(c) * 1.e-3_r8) + snomelt_accum(c) = max(0._r8, snomelt_accum(c) - newsnow(c) * 1.e-3_r8) ! update int_snow int_snow(c) = max(int_snow(c),h2osno_total(c)) !h2osno_total could be larger due to frost diff --git a/src/biogeophys/SoilTemperatureMod.F90 b/src/biogeophys/SoilTemperatureMod.F90 index b7086f3154..a3ffd72b4e 100644 --- a/src/biogeophys/SoilTemperatureMod.F90 +++ b/src/biogeophys/SoilTemperatureMod.F90 @@ -1168,7 +1168,7 @@ subroutine Phasechange_beta (bounds, num_nolakec, filter_nolakec, dhsdT, & qflx_snofrz_lyr => waterfluxbulk_inst%qflx_snofrz_lyr_col , & ! Output: [real(r8) (:,:) ] snow freezing rate (positive definite) (col,lyr) [kg m-2 s-1] qflx_snofrz => waterfluxbulk_inst%qflx_snofrz_col , & ! Output: [real(r8) (:) ] column-integrated snow freezing rate (positive definite) [kg m-2 s-1] qflx_snomelt => waterfluxbulk_inst%qflx_snomelt_col , & ! Output: [real(r8) (:) ] snow melt (mm H2O /s) - snomelt_accum => waterdiagnosticbulk_inst%snomelt_accum_col , & ! Output: [real(r8) (:) ] accumulated snow melt (m) + snomelt_accum => waterdiagnosticbulk_inst%snomelt_accum_col , & ! Output: [real(r8) (:) ] accumulated snow melt (m) qflx_snomelt_lyr => waterfluxbulk_inst%qflx_snomelt_lyr_col , & ! Output: [real(r8) (:) ] snow melt in each layer (mm H2O /s) eflx_snomelt => energyflux_inst%eflx_snomelt_col , & ! Output: [real(r8) (:) ] snow melt heat flux (W/m**2) @@ -1459,7 +1459,7 @@ subroutine Phasechange_beta (bounds, num_nolakec, filter_nolakec, dhsdT, & if (imelt(c,j) == 1 .AND. j < 1) then qflx_snomelt_lyr(c,j) = max(0._r8,(wice0(c,j)-h2osoi_ice(c,j)))/dtime qflx_snomelt(c) = qflx_snomelt(c) + qflx_snomelt_lyr(c,j) - snomelt_accum(c) = snomelt_accum(c) + qflx_snomelt_lyr(c,j) * dtime * 1.e-3_r8 + snomelt_accum(c) = snomelt_accum(c) + qflx_snomelt_lyr(c,j) * dtime * 1.e-3_r8 endif ! layer freezing mass flux (positive): diff --git a/src/main/clm_varctl.F90 b/src/main/clm_varctl.F90 index 559a95b570..7af8c56bff 100644 --- a/src/main/clm_varctl.F90 +++ b/src/main/clm_varctl.F90 @@ -251,7 +251,6 @@ module clm_varctl character(len=64), public :: z0param_method ! ZengWang2007 or Meier2022 logical, public :: use_z0m_snowmelt = .false. ! true => use snow z0m parameterization of Brock2006 - !---------------------------------------------------------- ! FATES switches diff --git a/src/main/pftconMod.F90 b/src/main/pftconMod.F90 index b401a02d15..e5379100e0 100644 --- a/src/main/pftconMod.F90 +++ b/src/main/pftconMod.F90 @@ -368,16 +368,16 @@ subroutine InitAllocate (this) allocate( this%taul (0:mxpft,numrad) ) allocate( this%taus (0:mxpft,numrad) ) allocate( this%z0mr (0:mxpft) ) - allocate( this%z0v_Cr (0:mxpft) ) - allocate( this%z0v_Cs (0:mxpft) ) - allocate( this%z0v_c (0:mxpft) ) - allocate( this%z0v_cw (0:mxpft) ) - allocate( this%z0v_LAIoff (0:mxpft) ) - allocate( this%z0v_LAImax (0:mxpft) ) - allocate( this%displar (0:mxpft) ) - allocate( this%roota_par (0:mxpft) ) - allocate( this%rootb_par (0:mxpft) ) - allocate( this%crop (0:mxpft) ) + allocate( this%z0v_Cr (0:mxpft) ) + allocate( this%z0v_Cs (0:mxpft) ) + allocate( this%z0v_c (0:mxpft) ) + allocate( this%z0v_cw (0:mxpft) ) + allocate( this%z0v_LAIoff (0:mxpft) ) + allocate( this%z0v_LAImax (0:mxpft) ) + allocate( this%displar (0:mxpft) ) + allocate( this%roota_par (0:mxpft) ) + allocate( this%rootb_par (0:mxpft) ) + allocate( this%crop (0:mxpft) ) allocate( this%mergetoclmpft (0:mxpft) ) allocate( this%is_pft_known_to_model (0:mxpft) ) allocate( this%irrigated (0:mxpft) ) @@ -663,7 +663,7 @@ subroutine InitRead(this) this%z0v_cw = 0._r8 this%z0v_LAImax = 0._r8 this%z0v_LAIoff = 0._r8 - + case ('Meier2022') call ncd_io('z0v_Cr', this%z0v_Cr, 'read', ncid, readvar=readv, posNOTonfile=.true.) if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) From f10c7fe07fa6d6123437a4049316873e3e0fb40c Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Mon, 21 Aug 2023 19:02:34 -0600 Subject: [PATCH 203/257] Adjust white space to reduce diffs from main --- src/biogeochem/CNCIsoFluxMod.F90 | 78 +++++++++++++++---------------- src/biogeochem/CNPhenologyMod.F90 | 2 +- 2 files changed, 40 insertions(+), 40 deletions(-) diff --git a/src/biogeochem/CNCIsoFluxMod.F90 b/src/biogeochem/CNCIsoFluxMod.F90 index 26f4cf026f..608966d213 100644 --- a/src/biogeochem/CNCIsoFluxMod.F90 +++ b/src/biogeochem/CNCIsoFluxMod.F90 @@ -1301,7 +1301,7 @@ subroutine CIsoFlux3(num_soilp, filter_soilp, & cc = patch%column(pp) do j = 1, nlevdecomp iso_cnveg_cf%m_c_to_litr_fire_col(cc,j,i_met_lit) = & - iso_cnveg_cf%m_c_to_litr_fire_col(cc,j,i_met_lit) + & + iso_cnveg_cf%m_c_to_litr_fire_col(cc,j,i_met_lit) + & ((iso_cnveg_cf%m_leafc_to_litter_fire_patch(pp) * lf_f(ivt(pp),i_met_lit) & +iso_cnveg_cf%m_leafc_storage_to_litter_fire_patch(pp) + & iso_cnveg_cf%m_leafc_xfer_to_litter_fire_patch(pp) + & @@ -1318,7 +1318,7 @@ subroutine CIsoFlux3(num_soilp, filter_soilp, & iso_cnveg_cf%m_livecrootc_xfer_to_litter_fire_patch(pp) & +iso_cnveg_cf%m_deadcrootc_storage_to_litter_fire_patch(pp) + & iso_cnveg_cf%m_deadcrootc_xfer_to_litter_fire_patch(pp))* croot_prof(pp,j)) * patch%wtcol(pp) - + ! Here metabolic litter is treated differently than other ! types of litter, so it remains outside this litter loop, ! in the line above @@ -1350,8 +1350,8 @@ subroutine CNCIsoLitterToColumn (num_soilp, filter_soilp, & !DML ! !ARGUMENTS: - integer , intent(in) :: num_soilp ! number of soil columns in filter - integer , intent(in) :: filter_soilp(:) ! filter for soil columns + integer , intent(in) :: num_soilp ! number of soil patches in filter + integer , intent(in) :: filter_soilp(:) ! filter for soil patches type(soilbiogeochem_state_type) , intent(in) :: soilbiogeochem_state_inst type(cnveg_carbonflux_type) , intent(inout) :: iso_cnveg_carbonflux_inst ! @@ -1384,11 +1384,11 @@ subroutine CNCIsoLitterToColumn (num_soilp, filter_soilp, & do i = i_litr_min, i_litr_max phenology_c_to_litr_c(c,j,i) = & - phenology_c_to_litr_c(c,j,i) + & - ! leaf litter carbon fluxes - leafc_to_litter(p) * lf_f(ivt(p),i) * wtcol(p) * leaf_prof(p,j) + & - ! fine root litter carbon fluxes - frootc_to_litter(p) * fr_f(ivt(p),i) * wtcol(p) * froot_prof(p,j) + phenology_c_to_litr_c(c,j,i) + & + ! leaf litter carbon fluxes + leafc_to_litter(p) * lf_f(ivt(p),i) * wtcol(p) * leaf_prof(p,j) + & + ! fine root litter carbon fluxes + frootc_to_litter(p) * fr_f(ivt(p),i) * wtcol(p) * froot_prof(p,j) end do !DML @@ -1396,8 +1396,8 @@ subroutine CNCIsoLitterToColumn (num_soilp, filter_soilp, & ! stem litter carbon fluxes do i = i_litr_min, i_litr_max phenology_c_to_litr_c(c,j,i) = & - phenology_c_to_litr_c(c,j,i) + & - livestemc_to_litter(p) * lf_f(ivt(p),i) * wtcol(p) * leaf_prof(p,j) + phenology_c_to_litr_c(c,j,i) + & + livestemc_to_litter(p) * lf_f(ivt(p),i) * wtcol(p) * leaf_prof(p,j) end do if (.not. use_grainproduct) then @@ -1420,7 +1420,7 @@ subroutine CNCIsoLitterToColumn (num_soilp, filter_soilp, & end do end do end if -!DML + !DML end do end do @@ -1437,8 +1437,8 @@ subroutine CNCIsoGapPftToColumn (num_soilp, filter_soilp, & ! to the column level and assign them to the three litter pools (+ cwd pool) ! ! !ARGUMENTS: - integer , intent(in) :: num_soilp ! number of soil columns in filter - integer , intent(in) :: filter_soilp(:) ! soil column filter + integer , intent(in) :: num_soilp ! number of soil patches in filter + integer , intent(in) :: filter_soilp(:) ! soil patch filter type(soilbiogeochem_state_type) , intent(in) :: soilbiogeochem_state_inst type(cnveg_carbonflux_type) , intent(inout) :: iso_cnveg_carbonflux_inst ! @@ -1491,12 +1491,12 @@ subroutine CNCIsoGapPftToColumn (num_soilp, filter_soilp, & do i = i_litr_min, i_litr_max ! leaf gap mortality carbon fluxes gap_mortality_c_to_litr_c(c,j,i) = & - gap_mortality_c_to_litr_c(c,j,i) + & - m_leafc_to_litter(p) * lf_f(ivt(p),i) * wtcol(p) * leaf_prof(p,j) + gap_mortality_c_to_litr_c(c,j,i) + & + m_leafc_to_litter(p) * lf_f(ivt(p),i) * wtcol(p) * leaf_prof(p,j) ! fine root gap mortality carbon fluxes gap_mortality_c_to_litr_c(c,j,i) = & - gap_mortality_c_to_litr_c(c,j,i) + & - m_frootc_to_litter(p) * fr_f(ivt(p),i) * wtcol(p) * froot_prof(p,j) + gap_mortality_c_to_litr_c(c,j,i) + & + m_frootc_to_litter(p) * fr_f(ivt(p),i) * wtcol(p) * froot_prof(p,j) end do ! wood gap mortality carbon fluxes @@ -1513,23 +1513,23 @@ subroutine CNCIsoGapPftToColumn (num_soilp, filter_soilp, & ! of litter, so it gets this additional line after the ! most recent loop over all litter types gap_mortality_c_to_litr_c(c,j,i_met_lit) = & - gap_mortality_c_to_litr_c(c,j,i_met_lit) + & - ! storage gap mortality carbon fluxes - m_leafc_storage_to_litter(p) * wtcol(p) * leaf_prof(p,j) + & - m_frootc_storage_to_litter(p) * wtcol(p) * froot_prof(p,j) + & - m_livestemc_storage_to_litter(p) * wtcol(p) * stem_prof(p,j) + & - m_deadstemc_storage_to_litter(p) * wtcol(p) * stem_prof(p,j) + & - m_livecrootc_storage_to_litter(p) * wtcol(p) * croot_prof(p,j) + & - m_deadcrootc_storage_to_litter(p) * wtcol(p) * croot_prof(p,j) + & - m_gresp_storage_to_litter(p) * wtcol(p) * leaf_prof(p,j) + & - ! transfer gap mortality carbon fluxes - m_leafc_xfer_to_litter(p) * wtcol(p) * leaf_prof(p,j) + & - m_frootc_xfer_to_litter(p) * wtcol(p) * froot_prof(p,j) + & - m_livestemc_xfer_to_litter(p) * wtcol(p) * stem_prof(p,j) + & - m_deadstemc_xfer_to_litter(p) * wtcol(p) * stem_prof(p,j) + & - m_livecrootc_xfer_to_litter(p) * wtcol(p) * croot_prof(p,j) + & - m_deadcrootc_xfer_to_litter(p) * wtcol(p) * croot_prof(p,j) + & - m_gresp_xfer_to_litter(p) * wtcol(p) * leaf_prof(p,j) + gap_mortality_c_to_litr_c(c,j,i_met_lit) + & + ! storage gap mortality carbon fluxes + m_leafc_storage_to_litter(p) * wtcol(p) * leaf_prof(p,j) + & + m_frootc_storage_to_litter(p) * wtcol(p) * froot_prof(p,j) + & + m_livestemc_storage_to_litter(p) * wtcol(p) * stem_prof(p,j) + & + m_deadstemc_storage_to_litter(p) * wtcol(p) * stem_prof(p,j) + & + m_livecrootc_storage_to_litter(p) * wtcol(p) * croot_prof(p,j) + & + m_deadcrootc_storage_to_litter(p) * wtcol(p) * croot_prof(p,j) + & + m_gresp_storage_to_litter(p) * wtcol(p) * leaf_prof(p,j) + & + ! transfer gap mortality carbon fluxes + m_leafc_xfer_to_litter(p) * wtcol(p) * leaf_prof(p,j) + & + m_frootc_xfer_to_litter(p) * wtcol(p) * froot_prof(p,j) + & + m_livestemc_xfer_to_litter(p) * wtcol(p) * stem_prof(p,j) + & + m_deadstemc_xfer_to_litter(p) * wtcol(p) * stem_prof(p,j) + & + m_livecrootc_xfer_to_litter(p) * wtcol(p) * croot_prof(p,j) + & + m_deadcrootc_xfer_to_litter(p) * wtcol(p) * croot_prof(p,j) + & + m_gresp_xfer_to_litter(p) * wtcol(p) * leaf_prof(p,j) end do end do @@ -1548,8 +1548,8 @@ subroutine CNCIsoHarvestPftToColumn (num_soilp, filter_soilp, & ! to the column level and assign them to the litter, cwd, and wood product pools ! ! !ARGUMENTS: - integer , intent(in) :: num_soilp ! number of soil columns in filter - integer , intent(in) :: filter_soilp(:) ! soil column filter + integer , intent(in) :: num_soilp ! number of soil patches in filter + integer , intent(in) :: filter_soilp(:) ! soil patch filter type(soilbiogeochem_state_type) , intent(in) :: soilbiogeochem_state_inst type(cnveg_carbonflux_type) , intent(inout) :: iso_cnveg_carbonflux_inst ! @@ -1664,8 +1664,8 @@ subroutine CNCIsoGrossUnrepPftToColumn (num_soilp, filter_soilp, & ! to the column level and assign them to the litter, cwd, and wood product pools ! ! !ARGUMENTS: - integer , intent(in) :: num_soilp ! number of soil columns in filter - integer , intent(in) :: filter_soilp(:) ! soil column filter + integer , intent(in) :: num_soilp ! number of soil patches in filter + integer , intent(in) :: filter_soilp(:) ! soil patch filter type(soilbiogeochem_state_type) , intent(in) :: soilbiogeochem_state_inst type(cnveg_carbonflux_type) , intent(inout) :: iso_cnveg_carbonflux_inst ! diff --git a/src/biogeochem/CNPhenologyMod.F90 b/src/biogeochem/CNPhenologyMod.F90 index 4bc2bd058d..070dc0eb0f 100644 --- a/src/biogeochem/CNPhenologyMod.F90 +++ b/src/biogeochem/CNPhenologyMod.F90 @@ -3800,7 +3800,7 @@ subroutine CNLitterToColumn (bounds, num_bgc_vegp, filter_bgc_vegp, & end do do_vegp end do do_nlev - end associate + end associate end subroutine CNLitterToColumn From aa5be428d843d16600414b2e69fbf70ba7b7a011 Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Mon, 21 Aug 2023 19:04:45 -0600 Subject: [PATCH 204/257] Correction for failing cheyenne test to pass --- src/biogeochem/CNDriverMod.F90 | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/src/biogeochem/CNDriverMod.F90 b/src/biogeochem/CNDriverMod.F90 index 90b22a7bfd..4ab1e1f51e 100644 --- a/src/biogeochem/CNDriverMod.F90 +++ b/src/biogeochem/CNDriverMod.F90 @@ -761,7 +761,7 @@ subroutine CNDriverNoLeaching(bounds, ! the matrix multiply in VegMatrix and SoilMatrix. !-------------------------------------------------------------------------- - ! Set harvest mortality routine + ! Set harvest mortality routine if (get_do_harvest()) then call CNHarvest(num_bgc_vegp, filter_bgc_vegp, & soilbiogeochem_state_inst, cnveg_carbonstate_inst, cnveg_nitrogenstate_inst, & @@ -838,6 +838,9 @@ subroutine CNDriverNoLeaching(bounds, c14_cnveg_carbonflux_inst, c14_cnveg_carbonstate_inst, c14_soilbiogeochem_carbonstate_inst) end if + call NStateUpdate2g(num_bgc_soilc, filter_bgc_soilc, num_bgc_vegp, filter_bgc_vegp, & + cnveg_nitrogenflux_inst, cnveg_nitrogenstate_inst, soilbiogeochem_nitrogenstate_inst) + call t_stopf('CNUpdate2') end if if_bgc_vegp1 From aef75cb931c998bc4fe7ddda92a5032c2e51df84 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Tue, 22 Aug 2023 13:15:10 -0600 Subject: [PATCH 205/257] Update ChangeLog --- doc/ChangeLog | 63 +++++++++++++++++++++++++++++++++++++++++++++++++++ doc/ChangeSum | 1 + 2 files changed, 64 insertions(+) diff --git a/doc/ChangeLog b/doc/ChangeLog index 7a00a0e80d..059ae5bd74 100644 --- a/doc/ChangeLog +++ b/doc/ChangeLog @@ -1,4 +1,67 @@ =============================================================== +Tag name: ctsm5.1.dev136 +Originator(s): jedwards (Jim Edwards), sacks (Bill Sacks) +Date: Tue Aug 22 13:10:28 MDT 2023 +One-line Summary: Change order of history fields to improve performance on derecho + +Purpose and description of changes +---------------------------------- + +Instead of just ordering history fields alphabetically, order them first +by the name of their level dimension (with fields without a level +dimension appearing first), then alphabetically within a given level +dimension. This changed ordering gives a significant performance +improvement especially noticeable on lustre file systems such as on +derecho. + + +Significant changes to scientifically-supported configurations +-------------------------------------------------------------- + +Does this tag change answers significantly for any of the following physics configurations? +(Details of any changes will be given in the "Answer changes" section below.) + + [Put an [X] in the box for any configuration with significant answer changes.] + +[ ] clm5_1 + +[ ] clm5_0 + +[ ] ctsm5_0-nwp + +[ ] clm4_5 + + +Notes of particular relevance for users +--------------------------------------- +Caveats for users (e.g., need to interpolate initial conditions): +- History fields will now appear in a different order from tools like + ncdump, etc. + +Testing summary: +---------------- + + regular tests (aux_clm: https://github.com/ESCOMP/CTSM/wiki/System-Testing-Guide#pre-merge-system-testing): + + cheyenne ---- OK + izumi ------- OK + + In addition to expected fails, the test + FSURDATMODIFYCTSM_D_Mmpi-serial_Ld1.5x5_amazon.I2000Clm50SpRs.cheyenne_intel + also failed as in https://github.com/ESCOMP/CTSM/issues/2111 + +Answer changes +-------------- + +Changes answers relative to baseline: NO + +Other details +------------- +Pull Requests that document the changes (include PR ids): +https://github.com/ESCOMP/CTSM/pull/2114 + +=============================================================== +=============================================================== Tag name: ctsm5.1.dev135 Originator(s): slevis (Samuel Levis,UCAR/TSS,303-665-1310) Date: Mon Aug 21 15:06:35 MDT 2023 diff --git a/doc/ChangeSum b/doc/ChangeSum index 67f357480b..0991ee8605 100644 --- a/doc/ChangeSum +++ b/doc/ChangeSum @@ -1,5 +1,6 @@ Tag Who Date Summary ============================================================================================================================ + ctsm5.1.dev136 multiple 08/22/2023 Change order of history fields to improve performance on derecho ctsm5.1.dev135 slevis 08/21/2023 Rename hist fields to track them down more easily ctsm5.1.dev134 rgknox 08/16/2023 Migration of FATES to share normal soil BGC call sequence and functionality ctsm5.1.dev133 glemieux 08/09/2023 FATES API update to facilitate fates refactor From 8dabfaf7c2c6be8133bfff8ebb966e77893c3cf8 Mon Sep 17 00:00:00 2001 From: Sam Rabin Date: Tue, 22 Aug 2023 15:28:07 -0600 Subject: [PATCH 206/257] Check that python unload/conda load works. --- cime_config/SystemTests/systemtest_utils.py | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) diff --git a/cime_config/SystemTests/systemtest_utils.py b/cime_config/SystemTests/systemtest_utils.py index 6ce61d9424..1c8668c7de 100644 --- a/cime_config/SystemTests/systemtest_utils.py +++ b/cime_config/SystemTests/systemtest_utils.py @@ -5,7 +5,7 @@ import os, subprocess -def cmds_to_setup_conda(caseroot): +def cmds_to_setup_conda(caseroot, test_conda_retry=True): # Add specific commands needed on different machines to get conda available # Use semicolon here since it's OK to fail # @@ -19,7 +19,12 @@ def cmds_to_setup_conda(caseroot): subprocess.run("which conda", shell=True, check=True) except subprocess.CalledProcessError: # Remove python and add conda to environment for cheyennne - conda_setup_commands += " module unload python; module load conda;" + unload_python_load_conda = "module unload python; module load conda;" + # Make sure that adding this actually loads conda + if test_conda_retry: + subprocess.run(unload_python_load_conda + "which conda", shell=True, check=True) + # Save + conda_setup_commands += " " + unload_python_load_conda return conda_setup_commands From 4db3ecd4c629f3da427d75a477579ed51641e0ad Mon Sep 17 00:00:00 2001 From: Sam Rabin Date: Tue, 22 Aug 2023 15:42:22 -0600 Subject: [PATCH 207/257] If conda run -n method fails, try conda activate. --- cime_config/SystemTests/systemtest_utils.py | 51 ++++++++++++++------- 1 file changed, 34 insertions(+), 17 deletions(-) diff --git a/cime_config/SystemTests/systemtest_utils.py b/cime_config/SystemTests/systemtest_utils.py index 1c8668c7de..90a5abcf95 100644 --- a/cime_config/SystemTests/systemtest_utils.py +++ b/cime_config/SystemTests/systemtest_utils.py @@ -29,16 +29,22 @@ def cmds_to_setup_conda(caseroot, test_conda_retry=True): return conda_setup_commands -def run_python_script(caseroot, this_conda_env, command, tool_path): - +def cmds_to_run_via_conda(caseroot, conda_run_call, command, test_conda_retry=True): # Run in the specified conda environment - conda_setup_commands = cmds_to_setup_conda(caseroot) - conda_setup_commands += f" conda run -n {this_conda_env}" + conda_setup_commands = cmds_to_setup_conda(caseroot, test_conda_retry) + conda_setup_commands += " " + conda_run_call # Finish with Python script call command = conda_setup_commands + " " + command print(f"command: {command}") + return command + + +def run_python_script(caseroot, this_conda_env, command_in, tool_path): + + command = cmds_to_run_via_conda(caseroot, f"conda run -n {this_conda_env}", command_in) + # Run with logfile tool_name = os.path.split(tool_path)[-1] try: @@ -47,19 +53,30 @@ def run_python_script(caseroot, this_conda_env, command, tool_path): command, shell=True, check=True, text=True, stdout=f, stderr=subprocess.STDOUT ) except subprocess.CalledProcessError as error: - print("ERROR while getting the conda environment and/or ") - print(f"running the {tool_name} tool: ") - print(f"(1) If your {this_conda_env} environment is out of date or you ") - print(f"have not created the {this_conda_env} environment, yet, you may ") - print("get past this error by running ./py_env_create ") - print("in your ctsm directory and trying this test again. ") - print("(2) If conda is not available, install and load conda, ") - print("run ./py_env_create, and then try this test again. ") - print("(3) If (1) and (2) are not the issue, then you may be ") - print(f"getting an error within {tool_name} itself. ") - print("Default error message: ") - print(error.output) - raise + # First, retry with the original method + command = cmds_to_run_via_conda(caseroot, f"conda activate {this_conda_env} && ", command_in, test_conda_retry=False) + try: + with open(tool_name + ".log2", "w") as f: + subprocess.run( + command, shell=True, check=True, text=True, stdout=f, stderr=subprocess.STDOUT + ) + except subprocess.CalledProcessError as error: + print("ERROR while getting the conda environment and/or ") + print(f"running the {tool_name} tool: ") + print(f"(1) If your {this_conda_env} environment is out of date or you ") + print(f"have not created the {this_conda_env} environment, yet, you may ") + print("get past this error by running ./py_env_create ") + print("in your ctsm directory and trying this test again. ") + print("(2) If conda is not available, install and load conda, ") + print("run ./py_env_create, and then try this test again. ") + print("(3) If (1) and (2) are not the issue, then you may be ") + print(f"getting an error within {tool_name} itself. ") + print("Default error message: ") + print(error.output) + raise + except: + print(f"ERROR trying to run {tool_name}.") + raise except: print(f"ERROR trying to run {tool_name}.") raise From d12b27647623e4ec6d755fcaf5285d9f87de3caf Mon Sep 17 00:00:00 2001 From: Sam Rabin Date: Wed, 23 Aug 2023 12:37:01 -0600 Subject: [PATCH 208/257] Update history fields .rst files. --- .../history_fields_fates.rst | 1015 +++++++++-------- .../history_fields_nofates.rst | 606 +++++----- 2 files changed, 830 insertions(+), 791 deletions(-) diff --git a/doc/source/users_guide/setting-up-and-running-a-case/history_fields_fates.rst b/doc/source/users_guide/setting-up-and-running-a-case/history_fields_fates.rst index 5514e76e1e..ea7c23d22a 100644 --- a/doc/source/users_guide/setting-up-and-running-a-case/history_fields_fates.rst +++ b/doc/source/users_guide/setting-up-and-running-a-case/history_fields_fates.rst @@ -15,35 +15,8 @@ CTSM History Fields =================================== ================ ============================================================================================== ================================================================= ======= A5TMIN - 5-day running mean of min 2-m temperature K F ACTUAL_IMMOB - actual N immobilization gN/m^2/s T -ACTUAL_IMMOB_NH4 levdcmp immobilization of NH4 gN/m^3/s F -ACTUAL_IMMOB_NO3 levdcmp immobilization of NO3 gN/m^3/s F -ACTUAL_IMMOB_vr levdcmp actual N immobilization gN/m^3/s F -ACT_SOMC - ACT_SOM C gC/m^2 T -ACT_SOMC_1m - ACT_SOM C to 1 meter gC/m^2 F -ACT_SOMC_TNDNCY_VERT_TRA levdcmp active soil organic C tendency due to vertical transport gC/m^3/s F -ACT_SOMC_TO_PAS_SOMC - decomp. of active soil organic C to passive soil organic C gC/m^2/s F -ACT_SOMC_TO_PAS_SOMC_vr levdcmp decomp. of active soil organic C to passive soil organic C gC/m^3/s F -ACT_SOMC_TO_SLO_SOMC - decomp. of active soil organic C to slow soil organic ma C gC/m^2/s F -ACT_SOMC_TO_SLO_SOMC_vr levdcmp decomp. of active soil organic C to slow soil organic ma C gC/m^3/s F -ACT_SOMC_vr levsoi ACT_SOM C (vertically resolved) gC/m^3 T -ACT_SOMN - ACT_SOM N gN/m^2 T -ACT_SOMN_1m - ACT_SOM N to 1 meter gN/m^2 F -ACT_SOMN_TNDNCY_VERT_TRA levdcmp active soil organic N tendency due to vertical transport gN/m^3/s F -ACT_SOMN_TO_PAS_SOMN - decomp. of active soil organic N to passive soil organic N gN/m^2 F -ACT_SOMN_TO_PAS_SOMN_vr levdcmp decomp. of active soil organic N to passive soil organic N gN/m^3 F -ACT_SOMN_TO_SLO_SOMN - decomp. of active soil organic N to slow soil organic ma N gN/m^2 F -ACT_SOMN_TO_SLO_SOMN_vr levdcmp decomp. of active soil organic N to slow soil organic ma N gN/m^3 F -ACT_SOMN_vr levdcmp ACT_SOM N (vertically resolved) gN/m^3 T -ACT_SOM_HR_S2 - Het. Resp. from active soil organic gC/m^2/s F -ACT_SOM_HR_S2_vr levdcmp Het. Resp. from active soil organic gC/m^3/s F -ACT_SOM_HR_S3 - Het. Resp. from active soil organic gC/m^2/s F -ACT_SOM_HR_S3_vr levdcmp Het. Resp. from active soil organic gC/m^3/s F AGLB - Aboveground leaf biomass kg/m^2 F AGSB - Aboveground stem biomass kg/m^2 F -ALBD numrad surface albedo (direct) proportion F -ALBGRD numrad ground albedo (direct) proportion F -ALBGRI numrad ground albedo (indirect) proportion F -ALBI numrad surface albedo (indirect) proportion F ALT - current active layer thickness m F ALTMAX - maximum annual active layer thickness m F ALTMAX_LASTYEAR - maximum prior year active layer thickness m F @@ -53,20 +26,6 @@ AnnET - Annual ET BCDEP - total BC deposition (dry+wet) from atmosphere kg/m^2/s T BTRAN - transpiration beta factor unitless T BTRANMN - daily minimum of transpiration beta factor unitless T -CEL_LITC - CEL_LIT C gC/m^2 T -CEL_LITC_1m - CEL_LIT C to 1 meter gC/m^2 F -CEL_LITC_TNDNCY_VERT_TRA levdcmp cellulosic litter C tendency due to vertical transport gC/m^3/s F -CEL_LITC_TO_ACT_SOMC - decomp. of cellulosic litter C to active soil organic C gC/m^2/s F -CEL_LITC_TO_ACT_SOMC_vr levdcmp decomp. of cellulosic litter C to active soil organic C gC/m^3/s F -CEL_LITC_vr levsoi CEL_LIT C (vertically resolved) gC/m^3 T -CEL_LITN - CEL_LIT N gN/m^2 T -CEL_LITN_1m - CEL_LIT N to 1 meter gN/m^2 F -CEL_LITN_TNDNCY_VERT_TRA levdcmp cellulosic litter N tendency due to vertical transport gN/m^3/s F -CEL_LITN_TO_ACT_SOMN - decomp. of cellulosic litter N to active soil organic N gN/m^2 F -CEL_LITN_TO_ACT_SOMN_vr levdcmp decomp. of cellulosic litter N to active soil organic N gN/m^3 F -CEL_LITN_vr levdcmp CEL_LIT N (vertically resolved) gN/m^3 T -CEL_LIT_HR - Het. Resp. from cellulosic litter gC/m^2/s F -CEL_LIT_HR_vr levdcmp Het. Resp. from cellulosic litter gC/m^3/s F CH4PROD - Gridcell total production of CH4 gC/m2/s T CH4_EBUL_TOTAL_SAT - ebullition surface CH4 flux; (+ to atm) mol/m2/s F CH4_EBUL_TOTAL_UNSAT - ebullition surface CH4 flux; (+ to atm) mol/m2/s F @@ -78,11 +37,11 @@ CH4_SURF_EBUL_SAT - ebullition surface CH4 flux CH4_SURF_EBUL_UNSAT - ebullition surface CH4 flux for non-inundated area; (+ to atm) mol/m2/s T COL_CTRUNC - column-level sink for C truncation gC/m^2 F COL_NTRUNC - column-level sink for N truncation gN/m^2 F -CONC_CH4_SAT levgrnd CH4 soil Concentration for inundated / lake area mol/m3 F -CONC_CH4_UNSAT levgrnd CH4 soil Concentration for non-inundated area mol/m3 F -CONC_O2_SAT levsoi O2 soil Concentration for inundated / lake area mol/m3 T -CONC_O2_UNSAT levsoi O2 soil Concentration for non-inundated area mol/m3 T COSZEN - cosine of solar zenith angle none F +CROPPROD1C - 1-yr crop product (grain+biofuel) C gC/m^2 T +CROPPROD1C_LOSS - loss from 1-yr crop product pool gC/m^2/s T +CROPPROD1N - 1-yr crop product (grain+biofuel) N gN/m^2 T +CROPPROD1N_LOSS - loss from 1-yr crop product pool gN/m^2/s T CWDC_HR - cwd C heterotrophic respiration gC/m^2/s T DENIT - total rate of denitrification gN/m^2/s T DGNETDT - derivative of net ground heat flux wrt soil temp W/m^2/K F @@ -94,6 +53,14 @@ DPVLTRB4 - turbulent deposition veloci DSL - dry surface layer thickness mm T DSTDEP - total dust deposition (dry+wet) from atmosphere kg/m^2/s T DSTFLXT - total surface dust emission kg/m2/s T +DWT_CROPPROD1C_GAIN - landcover change-driven addition to 1-year crop product pool gC/m^2/s T +DWT_CROPPROD1N_GAIN - landcover change-driven addition to 1-year crop product pool gN/m^2/s T +DWT_PROD100C_GAIN - landcover change-driven addition to 100-yr wood product pool gC/m^2/s F +DWT_PROD100N_GAIN - landcover change-driven addition to 100-yr wood product pool gN/m^2/s F +DWT_PROD10C_GAIN - landcover change-driven addition to 10-yr wood product pool gC/m^2/s F +DWT_PROD10N_GAIN - landcover change-driven addition to 10-yr wood product pool gN/m^2/s F +DWT_WOODPRODC_GAIN - landcover change-driven addition to wood product pools gC/m^2/s T +DWT_WOODPRODN_GAIN - landcover change-driven addition to wood product pools gN/m^2/s T DYN_COL_ADJUSTMENTS_CH4 - Adjustments in ch4 due to dynamic column areas; only makes sense at the column level: should n gC/m^2 F DYN_COL_SOIL_ADJUSTMENTS_C - Adjustments in soil carbon due to dynamic column areas; only makes sense at the column level: gC/m^2 F DYN_COL_SOIL_ADJUSTMENTS_N - Adjustments in soil nitrogen due to dynamic column areas; only makes sense at the column level gN/m^2 F @@ -115,11 +82,6 @@ ERRSEB - surface energy conservation ERRSOI - soil/lake energy conservation error W/m^2 T ERRSOL - solar radiation conservation error W/m^2 T ESAI - exposed one-sided stem area index m^2/m^2 T -FATES_ABOVEGROUND_MORT_SZPF fates_levscpf Aboveground flux of carbon from AGB to necromass due to mortality kg m-2 s-1 F -FATES_ABOVEGROUND_PROD_SZPF fates_levscpf Aboveground carbon productivity kg m-2 s-1 F -FATES_AGSAPMAINTAR_SZPF fates_levscpf above-ground sapwood maintenance autotrophic respiration in kg carbon per m2 per second by pft kg m-2 s-1 F -FATES_AGSAPWOOD_ALLOC_SZPF fates_levscpf allocation to above-ground sapwood by pft/size in kg carbon per m2 per second kg m-2 s-1 F -FATES_AGSTRUCT_ALLOC_SZPF fates_levscpf allocation to above-ground structural (deadwood) by pft/size in kg carbon per m2 per second kg m-2 s-1 F FATES_AR - autotrophic respiration gC/m^2/s T FATES_AREA_PLANTS - area occupied by all plants per m2 land area m2 m-2 T FATES_AREA_TREES - area occupied by woody plants per m2 land area m2 m-2 T @@ -127,56 +89,20 @@ FATES_AR_CANOPY - autotrophic respiration of FATES_AR_UNDERSTORY - autotrophic respiration of understory plants gC/m^2/s T FATES_AUTORESP - autotrophic respiration in kg carbon per m2 per second kg m-2 s-1 T FATES_AUTORESP_CANOPY - autotrophic respiration of canopy plants in kg carbon per m2 per second kg m-2 s-1 T -FATES_AUTORESP_CANOPY_SZPF fates_levscpf autotrophic respiration of canopy plants by pft/size in kg carbon per m2 per second kg m-2 s-1 F FATES_AUTORESP_SECONDARY - autotrophic respiration in kg carbon per m2 per second, secondary patches kg m-2 s-1 T -FATES_AUTORESP_SZPF fates_levscpf total autotrophic respiration in kg carbon per m2 per second by pft/size kg m-2 s-1 F FATES_AUTORESP_USTORY - autotrophic respiration of understory plants in kg carbon per m2 per second kg m-2 s-1 T -FATES_AUTORESP_USTORY_SZPF fates_levscpf autotrophic respiration of understory plants by pft/size in kg carbon per m2 per second kg m-2 s-1 F -FATES_BASALAREA_SZ fates_levscls basal area by size class m2 m-2 T -FATES_BASALAREA_SZPF fates_levscpf basal area by pft/size m2 m-2 F FATES_BA_WEIGHTED_HEIGHT - basal area-weighted mean height of woody plants m T -FATES_BGSAPMAINTAR_SZPF fates_levscpf below-ground sapwood maintenance autotrophic respiration in kg carbon per m2 per second by pft kg m-2 s-1 F -FATES_BGSAPWOOD_ALLOC_SZPF fates_levscpf allocation to below-ground sapwood by pft/size in kg carbon per m2 per second kg m-2 s-1 F -FATES_BGSTRUCT_ALLOC_SZPF fates_levscpf allocation to below-ground structural (deadwood) by pft/size in kg carbon per m2 per second kg m-2 s-1 F FATES_BURNFRAC - burned area fraction per second s-1 T -FATES_BURNFRAC_AP fates_levage spitfire fraction area burnt (per second) by patch age s-1 T -FATES_C13DISC_SZPF fates_levscpf C13 discrimination by pft/size per mil F -FATES_CANOPYAREA_AP fates_levage canopy area by age bin per m2 land area m2 m-2 T -FATES_CANOPYAREA_HT fates_levheight canopy area height distribution m2 m-2 T -FATES_CANOPYCROWNAREA_PF fates_levpft total PFT-level canopy-layer crown area per m2 land area m2 m-2 T FATES_CANOPY_SPREAD - scaling factor (0-1) between tree basal area and canopy area T FATES_CANOPY_VEGC - biomass of canopy plants in kg carbon per m2 land area kg m-2 T FATES_CA_WEIGHTED_HEIGHT - crown area-weighted mean height of canopy plants m T FATES_CBALANCE_ERROR - total carbon error in kg carbon per second kg s-1 T FATES_COLD_STATUS - site-level cold status, 0=not cold-dec, 1=too cold for leaves, 2=not too cold T FATES_CROOTMAINTAR - live coarse root maintenance autotrophic respiration in kg carbon per m2 per second kg m-2 s-1 T -FATES_CROOTMAINTAR_CANOPY_SZ fates_levscls live coarse root maintenance autotrophic respiration for canopy plants in kg carbon per m2 per kg m-2 s-1 F -FATES_CROOTMAINTAR_USTORY_SZ fates_levscls live coarse root maintenance autotrophic respiration for understory plants in kg carbon per m2 kg m-2 s-1 F FATES_CROOT_ALLOC - allocation to coarse roots in kg carbon per m2 per second kg m-2 s-1 T -FATES_CROWNAREA_CANOPY_SZ fates_levscls total crown area of canopy plants by size class m2 m-2 F -FATES_CROWNAREA_CL fates_levcan total crown area in each canopy layer m2 m-2 T -FATES_CROWNAREA_CLLL fates_levcnlf total crown area that is occupied by leaves in each canopy and leaf layer m2 m-2 F -FATES_CROWNAREA_PF fates_levpft total PFT-level crown area per m2 land area m2 m-2 T -FATES_CROWNAREA_USTORY_SZ fates_levscls total crown area of understory plants by size class m2 m-2 F -FATES_CWD_ABOVEGROUND_DC fates_levcwdsc debris class-level aboveground coarse woody debris stocks in kg carbon per m2 kg m-2 F -FATES_CWD_ABOVEGROUND_IN_DC fates_levcwdsc debris class-level aboveground coarse woody debris input in kg carbon per m2 per second kg m-2 s-1 F -FATES_CWD_ABOVEGROUND_OUT_DC fates_levcwdsc debris class-level aboveground coarse woody debris output in kg carbon per m2 per second kg m-2 s-1 F -FATES_CWD_BELOWGROUND_DC fates_levcwdsc debris class-level belowground coarse woody debris stocks in kg carbon per m2 kg m-2 F -FATES_CWD_BELOWGROUND_IN_DC fates_levcwdsc debris class-level belowground coarse woody debris input in kg carbon per m2 per second kg m-2 s-1 F -FATES_CWD_BELOWGROUND_OUT_DC fates_levcwdsc debris class-level belowground coarse woody debris output in kg carbon per m2 per second kg m-2 s-1 F FATES_DAYSINCE_COLDLEAFOFF - site-level days elapsed since cold leaf drop days T FATES_DAYSINCE_COLDLEAFON - site-level days elapsed since cold leaf flush days T -FATES_DAYSINCE_DROUGHTLEAFOFF_PF fates_levpft PFT-level days elapsed since drought leaf drop days T -FATES_DAYSINCE_DROUGHTLEAFON_PF fates_levpft PFT-level days elapsed since drought leaf flush days T -FATES_DDBH_CANOPY_SZ fates_levscls diameter growth increment by size of canopy plants m m-2 yr-1 T -FATES_DDBH_CANOPY_SZAP fates_levscag growth rate of canopy plants in meters DBH per m2 per year in canopy in each size x age class m m-2 yr-1 F -FATES_DDBH_CANOPY_SZPF fates_levscpf diameter growth increment by pft/size m m-2 yr-1 F -FATES_DDBH_SZPF fates_levscpf diameter growth increment by pft/size m m-2 yr-1 F -FATES_DDBH_USTORY_SZ fates_levscls diameter growth increment by size of understory plants m m-2 yr-1 T -FATES_DDBH_USTORY_SZAP fates_levscag growth rate of understory plants in meters DBH per m2 per year in each size x age class m m-2 yr-1 F -FATES_DDBH_USTORY_SZPF fates_levscpf diameter growth increment by pft/size m m-2 yr-1 F FATES_DEMOTION_CARBONFLUX - demotion-associated biomass carbon flux from canopy to understory in kg carbon per m2 per seco kg m-2 s-1 T -FATES_DEMOTION_RATE_SZ fates_levscls demotion rate from canopy to understory by size class in number of plants per m2 per year m-2 yr-1 F FATES_DISTURBANCE_RATE_FIRE - disturbance rate from fire m2 m-2 yr-1 T FATES_DISTURBANCE_RATE_LOGGING - disturbance rate from logging m2 m-2 yr-1 T FATES_DISTURBANCE_RATE_P2P - disturbance rate from primary to primary lands m2 m-2 yr-1 T @@ -184,71 +110,27 @@ FATES_DISTURBANCE_RATE_P2S - disturbance rate from prima FATES_DISTURBANCE_RATE_POTENTIAL - potential (i.e., including unresolved) disturbance rate m2 m-2 yr-1 T FATES_DISTURBANCE_RATE_S2S - disturbance rate from secondary to secondary lands m2 m-2 yr-1 T FATES_DISTURBANCE_RATE_TREEFALL - disturbance rate from treefall m2 m-2 yr-1 T -FATES_DROUGHT_STATUS_PF fates_levpft PFT-level drought status, <2 too dry for leaves, >=2 not too dry T FATES_EFFECT_WSPEED - effective wind speed for fire spread in meters per second m s-1 T -FATES_ELONG_FACTOR_PF fates_levpft PFT-level mean elongation factor (partial flushing/abscission) 1 T -FATES_ERROR_EL fates_levelem total mass-balance error in kg per second by element kg s-1 T FATES_EXCESS_RESP - respiration of un-allocatable carbon gain kg m-2 s-1 T -FATES_FABD_SHA_CLLL fates_levcnlf shade fraction of direct light absorbed by each canopy and leaf layer 1 F -FATES_FABD_SHA_CLLLPF fates_levcnlfpf shade fraction of direct light absorbed by each canopy, leaf, and PFT 1 F -FATES_FABD_SHA_TOPLF_CL fates_levcan shade fraction of direct light absorbed by the top leaf layer of each canopy layer 1 F -FATES_FABD_SUN_CLLL fates_levcnlf sun fraction of direct light absorbed by each canopy and leaf layer 1 F -FATES_FABD_SUN_CLLLPF fates_levcnlfpf sun fraction of direct light absorbed by each canopy, leaf, and PFT 1 F -FATES_FABD_SUN_TOPLF_CL fates_levcan sun fraction of direct light absorbed by the top leaf layer of each canopy layer 1 F -FATES_FABI_SHA_CLLL fates_levcnlf shade fraction of indirect light absorbed by each canopy and leaf layer 1 F -FATES_FABI_SHA_CLLLPF fates_levcnlfpf shade fraction of indirect light absorbed by each canopy, leaf, and PFT 1 F -FATES_FABI_SHA_TOPLF_CL fates_levcan shade fraction of indirect light absorbed by the top leaf layer of each canopy layer 1 F -FATES_FABI_SUN_CLLL fates_levcnlf sun fraction of indirect light absorbed by each canopy and leaf layer 1 F -FATES_FABI_SUN_CLLLPF fates_levcnlfpf sun fraction of indirect light absorbed by each canopy, leaf, and PFT 1 F -FATES_FABI_SUN_TOPLF_CL fates_levcan sun fraction of indirect light absorbed by the top leaf layer of each canopy layer 1 F FATES_FDI - Fire Danger Index (probability that an ignition will lead to a fire) 1 T FATES_FIRE_CLOSS - carbon loss to atmosphere from fire in kg carbon per m2 per second kg m-2 s-1 T -FATES_FIRE_FLUX_EL fates_levelem loss to atmosphere from fire by element in kg element per m2 per s kg m-2 s-1 T FATES_FIRE_INTENSITY - spitfire surface fireline intensity in J per m per second J m-1 s-1 T FATES_FIRE_INTENSITY_BURNFRAC - product of surface fire intensity and burned area fraction -- divide by FATES_BURNFRAC to get J m-1 s-1 T -FATES_FIRE_INTENSITY_BURNFRAC_AP fates_levage product of fire intensity and burned fraction, resolved by patch age (so divide by FATES_BURNF J m-1 s-1 T FATES_FRACTION - total gridcell fraction which FATES is running over m2 m-2 T -FATES_FRAGMENTATION_SCALER_SL levsoi factor (0-1) by which litter/cwd fragmentation proceeds relative to max rate by soil layer T FATES_FROOTC - total biomass in live plant fine roots in kg carbon per m2 kg m-2 T -FATES_FROOTCTURN_CANOPY_SZ fates_levscls fine root turnover (non-mortal) for canopy plants by size class in kg carbon per m2 per second kg m-2 s-1 F -FATES_FROOTCTURN_USTORY_SZ fates_levscls fine root turnover (non-mortal) for understory plants by size class in kg carbon per m2 per se kg m-2 s-1 F -FATES_FROOTC_SL levsoi Total carbon in live plant fine-roots over depth kg m-3 T -FATES_FROOTC_SZPF fates_levscpf fine-root carbon mass by size-class x pft in kg carbon per m2 kg m-2 F FATES_FROOTMAINTAR - fine root maintenance autotrophic respiration in kg carbon per m2 per second kg m-2 s-1 T -FATES_FROOTMAINTAR_CANOPY_SZ fates_levscls live coarse root maintenance autotrophic respiration for canopy plants in kg carbon per m2 per kg m-2 s-1 F -FATES_FROOTMAINTAR_SZPF fates_levscpf fine root maintenance autotrophic respiration in kg carbon per m2 per second by pft/size kg m-2 s-1 F -FATES_FROOTMAINTAR_USTORY_SZ fates_levscls fine root maintenance autotrophic respiration for understory plants in kg carbon per m2 per se kg m-2 s-1 F FATES_FROOT_ALLOC - allocation to fine roots in kg carbon per m2 per second kg m-2 s-1 T -FATES_FROOT_ALLOC_CANOPY_SZ fates_levscls allocation to fine root C for canopy plants by size class in kg carbon per m2 per second kg m-2 s-1 F -FATES_FROOT_ALLOC_SZPF fates_levscpf allocation to fine roots by pft/size in kg carbon per m2 per second kg m-2 s-1 F -FATES_FROOT_ALLOC_USTORY_SZ fates_levscls allocation to fine roots for understory plants by size class in kg carbon per m2 per second kg m-2 s-1 F FATES_FUELCONSUMED - total fuel consumed in kg carbon per m2 land area kg m-2 T FATES_FUEL_AMOUNT - total ground fuel related to FATES_ROS (omits 1000hr fuels) in kg C per m2 land area kg m-2 T -FATES_FUEL_AMOUNT_AP fates_levage spitfire ground fuel (kg carbon per m2) related to FATES_ROS (omits 1000hr fuels) within each kg m-2 T -FATES_FUEL_AMOUNT_APFC fates_levagefuel spitfire fuel quantity in each age x fuel class in kg carbon per m2 land area kg m-2 F -FATES_FUEL_AMOUNT_FC fates_levfuel spitfire fuel-class level fuel amount in kg carbon per m2 land area kg m-2 T FATES_FUEL_BULKD - fuel bulk density in kg per m3 kg m-3 T -FATES_FUEL_BURNT_BURNFRAC_FC fates_levfuel product of fraction (0-1) of fuel burnt and burnt fraction (divide by FATES_BURNFRAC to get bu 1 T FATES_FUEL_EFF_MOIST - spitfire fuel moisture (volumetric) m3 m-3 T FATES_FUEL_MEF - fuel moisture of extinction (volumetric) m3 m-3 T -FATES_FUEL_MOISTURE_FC fates_levfuel spitfire fuel class-level fuel moisture (volumetric) m3 m-3 T FATES_FUEL_SAV - spitfire fuel surface area to volume ratio m-1 T FATES_GDD - site-level growing degree days degree_Celsius T FATES_GPP - gross primary production in kg carbon per m2 per second kg m-2 s-1 T -FATES_GPP_AP fates_levage gross primary productivity by age bin in kg carbon per m2 per second kg m-2 s-1 F FATES_GPP_CANOPY - gross primary production of canopy plants in kg carbon per m2 per second kg m-2 s-1 T -FATES_GPP_CANOPY_SZPF fates_levscpf gross primary production of canopy plants by pft/size in kg carbon per m2 per second kg m-2 s-1 F -FATES_GPP_PF fates_levpft total PFT-level GPP in kg carbon per m2 land area per second kg m-2 s-1 T FATES_GPP_SECONDARY - gross primary production in kg carbon per m2 per second, secondary patches kg m-2 s-1 T -FATES_GPP_SE_PF fates_levpft total PFT-level GPP in kg carbon per m2 land area per second, secondary patches kg m-2 s-1 T -FATES_GPP_SZPF fates_levscpf gross primary production by pft/size in kg carbon per m2 per second kg m-2 s-1 F FATES_GPP_USTORY - gross primary production of understory plants in kg carbon per m2 per second kg m-2 s-1 T -FATES_GPP_USTORY_SZPF fates_levscpf gross primary production of understory plants by pft/size in kg carbon per m2 per second kg m-2 s-1 F -FATES_GROWAR_CANOPY_SZ fates_levscls growth autotrophic respiration of canopy plants in kg carbon per m2 per second by size kg m-2 s-1 F -FATES_GROWAR_SZPF fates_levscpf growth autotrophic respiration in kg carbon per m2 per second by pft/size kg m-2 s-1 F -FATES_GROWAR_USTORY_SZ fates_levscls growth autotrophic respiration of understory plants in kg carbon per m2 per second by size kg m-2 s-1 F -FATES_GROWTHFLUX_FUSION_SZPF fates_levscpf flux of individuals into a given size class bin via fusion m-2 yr-1 F -FATES_GROWTHFLUX_SZPF fates_levscpf flux of individuals into a given size class bin via growth and recruitment m-2 yr-1 F FATES_GROWTH_RESP - growth respiration in kg carbon per m2 per second kg m-2 s-1 T FATES_GROWTH_RESP_SECONDARY - growth respiration in kg carbon per m2 per second, secondary patches kg m-2 s-1 T FATES_HARVEST_CARBON_FLUX - harvest carbon flux in kg carbon per m2 per year kg m-2 yr-1 T @@ -257,232 +139,59 @@ FATES_HARVEST_DEBT_SEC - Accumulated carbon failed t FATES_HET_RESP - heterotrophic respiration in kg carbon per m2 per second kg m-2 s-1 T FATES_IGNITIONS - number of successful fire ignitions per m2 land area per second m-2 s-1 T FATES_LAI - leaf area index per m2 land area m2 m-2 T -FATES_LAISHA_TOP_CL fates_levcan LAI in the shade by the top leaf layer of each canopy layer m2 m-2 F -FATES_LAISHA_Z_CLLL fates_levcnlf LAI in the shade by each canopy and leaf layer m2 m-2 F -FATES_LAISHA_Z_CLLLPF fates_levcnlfpf LAI in the shade by each canopy, leaf, and PFT m2 m-2 F -FATES_LAISUN_TOP_CL fates_levcan LAI in the sun by the top leaf layer of each canopy layer m2 m-2 F -FATES_LAISUN_Z_CLLL fates_levcnlf LAI in the sun by each canopy and leaf layer m2 m-2 F -FATES_LAISUN_Z_CLLLPF fates_levcnlfpf LAI in the sun by each canopy, leaf, and PFT m2 m-2 F -FATES_LAI_AP fates_levage leaf area index by age bin per m2 land area m2 m-2 T -FATES_LAI_CANOPY_SZ fates_levscls leaf area index (LAI) of canopy plants by size class m2 m-2 T -FATES_LAI_CANOPY_SZPF fates_levscpf Leaf area index (LAI) of canopy plants by pft/size m2 m-2 F FATES_LAI_SECONDARY - leaf area index per m2 land area, secondary patches m2 m-2 T -FATES_LAI_USTORY_SZ fates_levscls leaf area index (LAI) of understory plants by size class m2 m-2 T -FATES_LAI_USTORY_SZPF fates_levscpf Leaf area index (LAI) of understory plants by pft/size m2 m-2 F FATES_LBLAYER_COND - mean leaf boundary layer conductance mol m-2 s-1 T -FATES_LBLAYER_COND_AP fates_levage mean leaf boundary layer conductance - by patch age mol m-2 s-1 F -FATES_LEAFAREA_HT fates_levheight leaf area height distribution m2 m-2 T FATES_LEAFC - total biomass in live plant leaves in kg carbon per m2 kg m-2 T -FATES_LEAFCTURN_CANOPY_SZ fates_levscls leaf turnover (non-mortal) for canopy plants by size class in kg carbon per m2 per second kg m-2 s-1 F -FATES_LEAFCTURN_USTORY_SZ fates_levscls leaf turnover (non-mortal) for understory plants by size class in kg carbon per m2 per second kg m-2 s-1 F -FATES_LEAFC_CANOPY_SZPF fates_levscpf biomass in leaves of canopy plants by pft/size in kg carbon per m2 kg m-2 F -FATES_LEAFC_PF fates_levpft total PFT-level leaf biomass in kg carbon per m2 land area kg m-2 T -FATES_LEAFC_SZPF fates_levscpf leaf carbon mass by size-class x pft in kg carbon per m2 kg m-2 F -FATES_LEAFC_USTORY_SZPF fates_levscpf biomass in leaves of understory plants by pft/size in kg carbon per m2 kg m-2 F FATES_LEAFMAINTAR - leaf maintenance autotrophic respiration in kg carbon per m2 per second kg m-2 s-1 T FATES_LEAF_ALLOC - allocation to leaves in kg carbon per m2 per second kg m-2 s-1 T -FATES_LEAF_ALLOC_CANOPY_SZ fates_levscls allocation to leaves for canopy plants by size class in kg carbon per m2 per second kg m-2 s-1 F -FATES_LEAF_ALLOC_SZPF fates_levscpf allocation to leaves by pft/size in kg carbon per m2 per second kg m-2 s-1 F -FATES_LEAF_ALLOC_USTORY_SZ fates_levscls allocation to leaves for understory plants by size class in kg carbon per m2 per second kg m-2 s-1 F -FATES_LITTER_AG_CWD_EL fates_levelem mass of aboveground litter in coarse woody debris (trunks/branches/twigs) by element kg m-2 T -FATES_LITTER_AG_FINE_EL fates_levelem mass of aboveground litter in fines (leaves, nonviable seed) by element kg m-2 T -FATES_LITTER_BG_CWD_EL fates_levelem mass of belowground litter in coarse woody debris (coarse roots) by element kg m-2 T -FATES_LITTER_BG_FINE_EL fates_levelem mass of belowground litter in fines (fineroots) by element kg m-2 T -FATES_LITTER_CWD_ELDC fates_levelcwd total mass of litter in coarse woody debris by element and coarse woody debris size kg m-2 T FATES_LITTER_IN - litter flux in kg carbon per m2 per second kg m-2 s-1 T -FATES_LITTER_IN_EL fates_levelem litter flux in in kg element per m2 per second kg m-2 s-1 T FATES_LITTER_OUT - litter flux out in kg carbon (exudation, fragmentation, seed decay) kg m-2 s-1 T -FATES_LITTER_OUT_EL fates_levelem litter flux out (exudation, fragmentation and seed decay) in kg element kg m-2 s-1 T FATES_LSTEMMAINTAR - live stem maintenance autotrophic respiration in kg carbon per m2 per second kg m-2 s-1 T -FATES_LSTEMMAINTAR_CANOPY_SZ fates_levscls live stem maintenance autotrophic respiration for canopy plants in kg carbon per m2 per second kg m-2 s-1 F -FATES_LSTEMMAINTAR_USTORY_SZ fates_levscls live stem maintenance autotrophic respiration for understory plants in kg carbon per m2 per se kg m-2 s-1 F -FATES_M3_MORTALITY_CANOPY_SZ fates_levscls C starvation mortality of canopy plants by size N/ha/yr F -FATES_M3_MORTALITY_CANOPY_SZPF fates_levscpf C starvation mortality of canopy plants by pft/size N/ha/yr F -FATES_M3_MORTALITY_USTORY_SZ fates_levscls C starvation mortality of understory plants by size N/ha/yr F -FATES_M3_MORTALITY_USTORY_SZPF fates_levscpf C starvation mortality of understory plants by pft/size N/ha/yr F -FATES_MAINTAR_CANOPY_SZ fates_levscls maintenance autotrophic respiration of canopy plants in kg carbon per m2 per second by size kg m-2 s-1 F -FATES_MAINTAR_SZPF fates_levscpf maintenance autotrophic respiration in kg carbon per m2 per second by pft/size kg m-2 s-1 F -FATES_MAINTAR_USTORY_SZ fates_levscls maintenance autotrophic respiration of understory plants in kg carbon per m2 per second by siz kg m-2 s-1 F FATES_MAINT_RESP - maintenance respiration in kg carbon per m2 land area per second, secondary patches kg m-2 s-1 T FATES_MAINT_RESP_SECONDARY - maintenance respiration in kg carbon per m2 land area per second kg m-2 s-1 T FATES_MAINT_RESP_UNREDUCED - diagnostic maintenance respiration if the low-carbon-storage reduction is ignored kg m-2 s-1 F -FATES_MEANLIQVOL_DROUGHTPHEN_PF fates_levpft PFT-level mean liquid water volume for drought phenolgy m3 m-3 T -FATES_MEANSMP_DROUGHTPHEN_PF fates_levpft PFT-level mean soil matric potential for drought phenology Pa T -FATES_MORTALITY_AGESCEN_AC fates_levcacls age senescence mortality by cohort age in number of plants per m2 per year m-2 yr-1 T -FATES_MORTALITY_AGESCEN_ACPF fates_levcapf age senescence mortality by pft/cohort age in number of plants per m2 per year m-2 yr-1 F -FATES_MORTALITY_AGESCEN_SE_SZ fates_levscls age senescence mortality by size in number of plants per m2 per year, secondary patches m-2 yr-1 T -FATES_MORTALITY_AGESCEN_SZ fates_levscls age senescence mortality by size in number of plants per m2 per year m-2 yr-1 T -FATES_MORTALITY_AGESCEN_SZPF fates_levscpf age senescence mortality by pft/size in number of plants per m2 per year m-2 yr-1 F -FATES_MORTALITY_BACKGROUND_SE_SZ fates_levscls background mortality by size in number of plants per m2 per year, secondary patches m-2 yr-1 T -FATES_MORTALITY_BACKGROUND_SZ fates_levscls background mortality by size in number of plants per m2 per year m-2 yr-1 T -FATES_MORTALITY_BACKGROUND_SZPF fates_levscpf background mortality by pft/size in number of plants per m2 per year m-2 yr-1 F -FATES_MORTALITY_CAMBIALBURN_SZPF fates_levscpf fire mortality from cambial burn by pft/size in number of plants per m2 per year m-2 yr-1 F -FATES_MORTALITY_CANOPY_SE_SZ fates_levscls total mortality of canopy trees by size class in number of plants per m2, secondary patches m-2 yr-1 T -FATES_MORTALITY_CANOPY_SZ fates_levscls total mortality of canopy trees by size class in number of plants per m2 m-2 yr-1 T -FATES_MORTALITY_CANOPY_SZAP fates_levscag mortality rate of canopy plants in number of plants per m2 per year in each size x age class m-2 yr-1 F -FATES_MORTALITY_CANOPY_SZPF fates_levscpf total mortality of canopy plants by pft/size in number of plants per m2 per year m-2 yr-1 F FATES_MORTALITY_CFLUX_CANOPY - flux of biomass carbon from live to dead pools from mortality of canopy plants in kg carbon pe kg m-2 s-1 T -FATES_MORTALITY_CFLUX_PF fates_levpft PFT-level flux of biomass carbon from live to dead pool from mortality kg m-2 s-1 T FATES_MORTALITY_CFLUX_USTORY - flux of biomass carbon from live to dead pools from mortality of understory plants in kg carbo kg m-2 s-1 T -FATES_MORTALITY_CROWNSCORCH_SZPF fates_levscpf fire mortality from crown scorch by pft/size in number of plants per m2 per year m-2 yr-1 F -FATES_MORTALITY_CSTARV_CFLUX_PF fates_levpft PFT-level flux of biomass carbon from live to dead pool from carbon starvation mortality kg m-2 s-1 T -FATES_MORTALITY_CSTARV_SE_SZ fates_levscls carbon starvation mortality by size in number of plants per m2 per year, secondary patches m-2 yr-1 T -FATES_MORTALITY_CSTARV_SZ fates_levscls carbon starvation mortality by size in number of plants per m2 per year m-2 yr-1 T -FATES_MORTALITY_CSTARV_SZPF fates_levscpf carbon starvation mortality by pft/size in number of plants per m2 per year m-2 yr-1 F -FATES_MORTALITY_FIRE_CFLUX_PF fates_levpft PFT-level flux of biomass carbon from live to dead pool from fire mortality kg m-2 s-1 T -FATES_MORTALITY_FIRE_SZ fates_levscls fire mortality by size in number of plants per m2 per year m-2 yr-1 T -FATES_MORTALITY_FIRE_SZPF fates_levscpf fire mortality by pft/size in number of plants per m2 per year m-2 yr-1 F -FATES_MORTALITY_FREEZING_SE_SZ fates_levscls freezing mortality by size in number of plants per m2 per event, secondary patches m-2 event-1 T -FATES_MORTALITY_FREEZING_SZ fates_levscls freezing mortality by size in number of plants per m2 per year m-2 yr-1 T -FATES_MORTALITY_FREEZING_SZPF fates_levscpf freezing mortality by pft/size in number of plants per m2 per year m-2 yr-1 F -FATES_MORTALITY_HYDRAULIC_SE_SZ fates_levscls hydraulic mortality by size in number of plants per m2 per year, secondary patches m-2 yr-1 T -FATES_MORTALITY_HYDRAULIC_SZ fates_levscls hydraulic mortality by size in number of plants per m2 per year m-2 yr-1 T -FATES_MORTALITY_HYDRAULIC_SZPF fates_levscpf hydraulic mortality by pft/size in number of plants per m2 per year m-2 yr-1 F -FATES_MORTALITY_HYDRO_CFLUX_PF fates_levpft PFT-level flux of biomass carbon from live to dead pool from hydraulic failure mortality kg m-2 s-1 T -FATES_MORTALITY_IMPACT_SZ fates_levscls impact mortality by size in number of plants per m2 per year m-2 yr-1 T -FATES_MORTALITY_IMPACT_SZPF fates_levscpf impact mortality by pft/size in number of plants per m2 per year m-2 yr-1 F -FATES_MORTALITY_LOGGING_SE_SZ fates_levscls logging mortality by size in number of plants per m2 per event, secondary patches m-2 yr-1 T -FATES_MORTALITY_LOGGING_SZ fates_levscls logging mortality by size in number of plants per m2 per year m-2 yr-1 T -FATES_MORTALITY_LOGGING_SZPF fates_levscpf logging mortality by pft/size in number of plants per m2 per year m-2 yr-1 F -FATES_MORTALITY_PF fates_levpft PFT-level mortality rate in number of individuals per m2 land area per year m-2 yr-1 T -FATES_MORTALITY_SENESCENCE_SE_SZ fates_levscls senescence mortality by size in number of plants per m2 per event, secondary patches m-2 yr-1 T -FATES_MORTALITY_SENESCENCE_SZ fates_levscls senescence mortality by size in number of plants per m2 per year m-2 yr-1 T -FATES_MORTALITY_SENESCENCE_SZPF fates_levscpf senescence mortality by pft/size in number of plants per m2 per year m-2 yr-1 F -FATES_MORTALITY_TERMINATION_SZ fates_levscls termination mortality by size in number of plants per m2 per year m-2 yr-1 T -FATES_MORTALITY_TERMINATION_SZPF fates_levscpf termination mortality by pft/size in number pf plants per m2 per year m-2 yr-1 F -FATES_MORTALITY_USTORY_SZ fates_levscls total mortality of understory trees by size class in individuals per m2 per year m-2 yr-1 T -FATES_MORTALITY_USTORY_SZAP fates_levscag mortality rate of understory plants in number of plants per m2 per year in each size x age cla m-2 yr-1 F -FATES_MORTALITY_USTORY_SZPF fates_levscpf total mortality of understory plants by pft/size in number of plants per m2 per year m-2 yr-1 F FATES_NCHILLDAYS - site-level number of chill days days T -FATES_NCL_AP fates_levage number of canopy levels by age bin F FATES_NCOHORTS - total number of cohorts per site T FATES_NCOHORTS_SECONDARY - total number of cohorts per site T FATES_NCOLDDAYS - site-level number of cold days days T FATES_NEP - net ecosystem production in kg carbon per m2 per second kg m-2 s-1 T FATES_NESTEROV_INDEX - nesterov fire danger index T -FATES_NET_C_UPTAKE_CLLL fates_levcnlf net carbon uptake in kg carbon per m2 per second by each canopy and leaf layer per unit ground kg m-2 s-1 F FATES_NONSTRUCTC - non-structural biomass (sapwood + leaf + fineroot) in kg carbon per m2 kg m-2 T FATES_NPATCHES - total number of patches per site T FATES_NPATCHES_SECONDARY - total number of patches per site T -FATES_NPATCH_AP fates_levage number of patches by age bin F -FATES_NPLANT_AC fates_levcacls number of plants per m2 by cohort age class m-2 T -FATES_NPLANT_ACPF fates_levcapf stem number density by pft and age class m-2 F -FATES_NPLANT_CANOPY_SZ fates_levscls number of canopy plants per m2 by size class m-2 T -FATES_NPLANT_CANOPY_SZAP fates_levscag number of plants per m2 in canopy in each size x age class m-2 F -FATES_NPLANT_CANOPY_SZPF fates_levscpf number of canopy plants by size/pft per m2 m-2 F -FATES_NPLANT_PF fates_levpft total PFT-level number of individuals per m2 land area m-2 T -FATES_NPLANT_SEC_PF fates_levpft total PFT-level number of individuals per m2 land area, secondary patches m-2 T -FATES_NPLANT_SZ fates_levscls number of plants per m2 by size class m-2 T -FATES_NPLANT_SZAP fates_levscag number of plants per m2 in each size x age class m-2 F -FATES_NPLANT_SZAPPF fates_levscagpf number of plants per m2 in each size x age x pft class m-2 F -FATES_NPLANT_SZPF fates_levscpf stem number density by pft/size m-2 F -FATES_NPLANT_USTORY_SZ fates_levscls number of understory plants per m2 by size class m-2 T -FATES_NPLANT_USTORY_SZAP fates_levscag number of plants per m2 in understory in each size x age class m-2 F -FATES_NPLANT_USTORY_SZPF fates_levscpf density of understory plants by pft/size in number of plants per m2 m-2 F FATES_NPP - net primary production in kg carbon per m2 per second kg m-2 s-1 T -FATES_NPP_AP fates_levage net primary productivity by age bin in kg carbon per m2 per second kg m-2 s-1 F -FATES_NPP_APPF fates_levagepft NPP per PFT in each age bin in kg carbon per m2 per second kg m-2 s-1 F -FATES_NPP_CANOPY_SZ fates_levscls NPP of canopy plants by size class in kg carbon per m2 per second kg m-2 s-1 F -FATES_NPP_PF fates_levpft total PFT-level NPP in kg carbon per m2 land area per second kg m-2 yr-1 T FATES_NPP_SECONDARY - net primary production in kg carbon per m2 per second, secondary patches kg m-2 s-1 T -FATES_NPP_SE_PF fates_levpft total PFT-level NPP in kg carbon per m2 land area per second, secondary patches kg m-2 yr-1 T -FATES_NPP_SZPF fates_levscpf total net primary production by pft/size in kg carbon per m2 per second kg m-2 s-1 F -FATES_NPP_USTORY_SZ fates_levscls NPP of understory plants by size class in kg carbon per m2 per second kg m-2 s-1 F -FATES_PARPROF_DIF_CLLL fates_levcnlf radiative profile of diffuse PAR through each canopy and leaf layer (averaged across PFTs) W m-2 F -FATES_PARPROF_DIF_CLLLPF fates_levcnlfpf radiative profile of diffuse PAR through each canopy, leaf, and PFT W m-2 F -FATES_PARPROF_DIR_CLLL fates_levcnlf radiative profile of direct PAR through each canopy and leaf layer (averaged across PFTs) W m-2 F -FATES_PARPROF_DIR_CLLLPF fates_levcnlfpf radiative profile of direct PAR through each canopy, leaf, and PFT W m-2 F -FATES_PARSHA_Z_CL fates_levcan PAR absorbed in the shade by top leaf layer in each canopy layer W m-2 F -FATES_PARSHA_Z_CLLL fates_levcnlf PAR absorbed in the shade by each canopy and leaf layer W m-2 F -FATES_PARSHA_Z_CLLLPF fates_levcnlfpf PAR absorbed in the shade by each canopy, leaf, and PFT W m-2 F -FATES_PARSUN_Z_CL fates_levcan PAR absorbed in the sun by top leaf layer in each canopy layer W m-2 F -FATES_PARSUN_Z_CLLL fates_levcnlf PAR absorbed in the sun by each canopy and leaf layer W m-2 F -FATES_PARSUN_Z_CLLLPF fates_levcnlfpf PAR absorbed in the sun by each canopy, leaf, and PFT W m-2 F -FATES_PATCHAREA_AP fates_levage patch area by age bin per m2 land area m2 m-2 T FATES_PRIMARY_PATCHFUSION_ERR - error in total primary lands associated with patch fusion m2 m-2 yr-1 T FATES_PROMOTION_CARBONFLUX - promotion-associated biomass carbon flux from understory to canopy in kg carbon per m2 per sec kg m-2 s-1 T -FATES_PROMOTION_RATE_SZ fates_levscls promotion rate from understory to canopy by size class m-2 yr-1 F FATES_RAD_ERROR - radiation error in FATES RTM W m-2 T -FATES_RDARK_CANOPY_SZ fates_levscls dark respiration for canopy plants in kg carbon per m2 per second by size kg m-2 s-1 F -FATES_RDARK_SZPF fates_levscpf dark portion of maintenance autotrophic respiration in kg carbon per m2 per second by pft/size kg m-2 s-1 F -FATES_RDARK_USTORY_SZ fates_levscls dark respiration for understory plants in kg carbon per m2 per second by size kg m-2 s-1 F -FATES_RECRUITMENT_PF fates_levpft PFT-level recruitment rate in number of individuals per m2 land area per year m-2 yr-1 T FATES_REPROC - total biomass in live plant reproductive tissues in kg carbon per m2 kg m-2 T -FATES_REPROC_SZPF fates_levscpf reproductive carbon mass (on plant) by size-class x pft in kg carbon per m2 kg m-2 F FATES_ROS - fire rate of spread in meters per second m s-1 T -FATES_SAI_CANOPY_SZ fates_levscls stem area index (SAI) of canopy plants by size class m2 m-2 F -FATES_SAI_USTORY_SZ fates_levscls stem area index (SAI) of understory plants by size class m2 m-2 F FATES_SAPWOODC - total biomass in live plant sapwood in kg carbon per m2 kg m-2 T -FATES_SAPWOODCTURN_CANOPY_SZ fates_levscls sapwood turnover (non-mortal) for canopy plants by size class in kg carbon per m2 per second kg m-2 s-1 F -FATES_SAPWOODCTURN_USTORY_SZ fates_levscls sapwood C turnover (non-mortal) for understory plants by size class in kg carbon per m2 per se kg m-2 s-1 F -FATES_SAPWOODC_SZPF fates_levscpf sapwood carbon mass by size-class x pft in kg carbon per m2 kg m-2 F -FATES_SAPWOOD_ALLOC_CANOPY_SZ fates_levscls allocation to sapwood C for canopy plants by size class in kg carbon per m2 per second kg m-2 s-1 F -FATES_SAPWOOD_ALLOC_USTORY_SZ fates_levscls allocation to sapwood C for understory plants by size class in kg carbon per m2 per second kg m-2 s-1 F -FATES_SCORCH_HEIGHT_APPF fates_levagepft SPITFIRE flame Scorch Height (calculated per PFT in each patch age bin) m F -FATES_SECONDAREA_ANTHRODIST_AP fates_levage secondary forest patch area age distribution since anthropgenic disturbance m2 m-2 F -FATES_SECONDAREA_DIST_AP fates_levage secondary forest patch area age distribution since any kind of disturbance m2 m-2 F FATES_SECONDARY_FOREST_FRACTION - secondary forest fraction m2 m-2 T FATES_SECONDARY_FOREST_VEGC - biomass on secondary lands in kg carbon per m2 land area (mult by FATES_SECONDARY_FOREST_FRACT kg m-2 T +FATES_SEEDLING_POOL - total seedling (ie germinated seeds) mass of all PFTs in kg carbon per m2 land area kg m-2 T FATES_SEEDS_IN - seed production rate in kg carbon per m2 second kg m-2 s-1 T -FATES_SEEDS_IN_EXTERN_EL fates_levelem external seed influx rate in kg element per m2 per second kg m-2 s-1 T -FATES_SEEDS_IN_LOCAL_EL fates_levelem within-site, element-level seed production rate in kg element per m2 per second kg m-2 s-1 T +FATES_SEEDS_IN_LOCAL - local seed production rate in kg carbon per m2 second kg m-2 s-1 T FATES_SEED_ALLOC - allocation to seeds in kg carbon per m2 per second kg m-2 s-1 T -FATES_SEED_ALLOC_CANOPY_SZ fates_levscls allocation to reproductive C for canopy plants by size class in kg carbon per m2 per second kg m-2 s-1 F -FATES_SEED_ALLOC_SZPF fates_levscpf allocation to seeds by pft/size in kg carbon per m2 per second kg m-2 s-1 F -FATES_SEED_ALLOC_USTORY_SZ fates_levscls allocation to reproductive C for understory plants by size class in kg carbon per m2 per secon kg m-2 s-1 F FATES_SEED_BANK - total seed mass of all PFTs in kg carbon per m2 land area kg m-2 T -FATES_SEED_BANK_EL fates_levelem element-level total seed mass of all PFTs in kg element per m2 kg m-2 T -FATES_SEED_DECAY_EL fates_levelem seed mass decay (germinated and un-germinated) in kg element per m2 per second kg m-2 s-1 T -FATES_SEED_GERM_EL fates_levelem element-level total germinated seed mass of all PFTs in kg element per m2 kg m-2 T -FATES_SEED_PROD_CANOPY_SZ fates_levscls seed production of canopy plants by size class in kg carbon per m2 per second kg m-2 s-1 F -FATES_SEED_PROD_USTORY_SZ fates_levscls seed production of understory plants by size class in kg carbon per m2 per second kg m-2 s-1 F FATES_STEM_ALLOC - allocation to stem in kg carbon per m2 per second kg m-2 s-1 T FATES_STOMATAL_COND - mean stomatal conductance mol m-2 s-1 T -FATES_STOMATAL_COND_AP fates_levage mean stomatal conductance - by patch age mol m-2 s-1 F FATES_STOREC - total biomass in live plant storage in kg carbon per m2 land area kg m-2 T -FATES_STORECTURN_CANOPY_SZ fates_levscls storage turnover (non-mortal) for canopy plants by size class in kg carbon per m2 per second kg m-2 s-1 F -FATES_STORECTURN_USTORY_SZ fates_levscls storage C turnover (non-mortal) for understory plants by size class in kg carbon per m2 per se kg m-2 s-1 F -FATES_STOREC_CANOPY_SZPF fates_levscpf biomass in storage pools of canopy plants by pft/size in kg carbon per m2 kg m-2 F -FATES_STOREC_PF fates_levpft total PFT-level stored biomass in kg carbon per m2 land area kg m-2 T -FATES_STOREC_SZPF fates_levscpf storage carbon mass by size-class x pft in kg carbon per m2 kg m-2 F FATES_STOREC_TF - Storage C fraction of target kg kg-1 T -FATES_STOREC_TF_CANOPY_SZPF fates_levscpf Storage C fraction of target by size x pft, in the canopy kg kg-1 F -FATES_STOREC_TF_USTORY_SZPF fates_levscpf Storage C fraction of target by size x pft, in the understory kg kg-1 F -FATES_STOREC_USTORY_SZPF fates_levscpf biomass in storage pools of understory plants by pft/size in kg carbon per m2 kg m-2 F FATES_STORE_ALLOC - allocation to storage tissues in kg carbon per m2 per second kg m-2 s-1 T -FATES_STORE_ALLOC_CANOPY_SZ fates_levscls allocation to storage C for canopy plants by size class in kg carbon per m2 per second kg m-2 s-1 F -FATES_STORE_ALLOC_SZPF fates_levscpf allocation to storage C by pft/size in kg carbon per m2 per second kg m-2 s-1 F -FATES_STORE_ALLOC_USTORY_SZ fates_levscls allocation to storage C for understory plants by size class in kg carbon per m2 per second kg m-2 s-1 F FATES_STRUCTC - structural biomass in kg carbon per m2 land area kg m-2 T -FATES_STRUCTCTURN_CANOPY_SZ fates_levscls structural C turnover (non-mortal) for canopy plants by size class in kg carbon per m2 per sec kg m-2 s-1 F -FATES_STRUCTCTURN_USTORY_SZ fates_levscls structural C turnover (non-mortal) for understory plants by size class in kg carbon per m2 per kg m-2 s-1 F -FATES_STRUCT_ALLOC_CANOPY_SZ fates_levscls allocation to structural C for canopy plants by size class in kg carbon per m2 per second kg m-2 s-1 F -FATES_STRUCT_ALLOC_USTORY_SZ fates_levscls allocation to structural C for understory plants by size class in kg carbon per m2 per second kg m-2 s-1 F FATES_TGROWTH - fates long-term running mean vegetation temperature by site degree_Celsius F FATES_TLONGTERM - fates 30-year running mean vegetation temperature by site degree_Celsius F FATES_TRIMMING - degree to which canopy expansion is limited by leaf economics (0-1) 1 T -FATES_TRIMMING_CANOPY_SZ fates_levscls trimming term of canopy plants weighted by plant density, by size class m-2 F -FATES_TRIMMING_USTORY_SZ fates_levscls trimming term of understory plants weighted by plant density, by size class m-2 F FATES_TVEG - fates instantaneous mean vegetation temperature by site degree_Celsius T FATES_TVEG24 - fates 24-hr running mean vegetation temperature by site degree_Celsius T +FATES_UNGERM_SEED_BANK - ungerminated seed mass of all PFTs in kg carbon per m2 land area kg m-2 T FATES_USTORY_VEGC - biomass of understory plants in kg carbon per m2 land area kg m-2 T FATES_VEGC - total biomass in live plants in kg carbon per m2 land area kg m-2 T FATES_VEGC_ABOVEGROUND - aboveground biomass in kg carbon per m2 land area kg m-2 T -FATES_VEGC_ABOVEGROUND_SZ fates_levscls aboveground biomass by size class in kg carbon per m2 kg m-2 T -FATES_VEGC_ABOVEGROUND_SZPF fates_levscpf aboveground biomass by pft/size in kg carbon per m2 kg m-2 F -FATES_VEGC_AP fates_levage total biomass within a given patch age bin in kg carbon per m2 land area kg m-2 F -FATES_VEGC_APPF fates_levagepft biomass per PFT in each age bin in kg carbon per m2 kg m-2 F -FATES_VEGC_PF fates_levpft total PFT-level biomass in kg of carbon per land area kg m-2 T -FATES_VEGC_SE_PF fates_levpft total PFT-level biomass in kg of carbon per land area, secondary patches kg m-2 T -FATES_VEGC_SZ fates_levscls total biomass by size class in kg carbon per m2 kg m-2 F -FATES_VEGC_SZPF fates_levscpf total vegetation biomass in live plants by size-class x pft in kg carbon per m2 kg m-2 F FATES_WOOD_PRODUCT - total wood product from logging in kg carbon per m2 land area kg m-2 T -FATES_YESTCANLEV_CANOPY_SZ fates_levscls yesterdays canopy level for canopy plants by size class in number of plants per m2 m-2 F -FATES_YESTCANLEV_USTORY_SZ fates_levscls yesterdays canopy level for understory plants by size class in number of plants per m2 m-2 F -FATES_ZSTAR_AP fates_levage product of zstar and patch area by age bin (divide by FATES_PATCHAREA_AP to get mean zstar) m F -FATES_c_to_litr_cel_c levdcmp litter celluluse carbon flux from FATES to BGC gC/m^3/s T -FATES_c_to_litr_lab_c levdcmp litter labile carbon flux from FATES to BGC gC/m^3/s T -FATES_c_to_litr_lig_c levdcmp litter lignin carbon flux from FATES to BGC gC/m^3/s T FCEV - canopy evaporation W/m^2 T FCH4 - Gridcell surface CH4 flux to atmosphere (+ to atm) kgC/m2/s T FCH4TOCO2 - Gridcell oxidation of CH4 to CO2 gC/m2/s T @@ -495,7 +204,6 @@ FGR - heat flux into soil/snow in FGR12 - heat flux between soil layers 1 and 2 W/m^2 T FGR_ICE - heat flux into soil/snow including snow melt and lake / snow light transmission (ice landunits W/m^2 F FGR_R - Rural heat flux into soil/snow including snow melt and snow light transmission W/m^2 F -FGR_SOIL_R levgrnd Rural downward heat flux at interface below each soil layer watt/m^2 F FGR_U - Urban heat flux into soil/snow including snow melt W/m^2 F FH2OSFC - fraction of ground covered by surface water unitless T FH2OSFC_NOSNOW - fraction of ground covered by surface water (if no snow present) unitless F @@ -511,8 +219,8 @@ FIRE_R - Rural emitted infrared (lon FIRE_U - Urban emitted infrared (longwave) radiation W/m^2 F FLDS - atmospheric longwave radiation (downscaled to columns in glacier regions) W/m^2 T FLDS_ICE - atmospheric longwave radiation (downscaled to columns in glacier regions) (ice landunits only) W/m^2 F -FMAX_DENIT_CARBONSUBSTRATE levdcmp FMAX_DENIT_CARBONSUBSTRATE gN/m^3/s F -FMAX_DENIT_NITRATE levdcmp FMAX_DENIT_NITRATE gN/m^3/s F +FPG - fraction of potential gpp proportion T +FPI - fraction of potential immobilization proportion T FROST_TABLE - frost table depth (natural vegetated and crop landunits only) m F FSA - absorbed solar radiation W/m^2 T FSAT - fractional area with water table at surface unitless T @@ -559,14 +267,14 @@ FSUN - sunlit fraction of canopy FSUN24 - fraction sunlit (last 24hrs) K F FSUN240 - fraction sunlit (last 240hrs) K F F_DENIT - denitrification flux gN/m^2/s T -F_DENIT_BASE levdcmp F_DENIT_BASE gN/m^3/s F -F_DENIT_vr levdcmp denitrification flux gN/m^3/s F F_N2O_DENIT - denitrification N2O flux gN/m^2/s T F_N2O_NIT - nitrification N2O flux gN/m^2/s T F_NIT - nitrification flux gN/m^2/s T -F_NIT_vr levdcmp nitrification flux gN/m^3/s F GROSS_NMIN - gross rate of N mineralization gN/m^2/s T -GROSS_NMIN_vr levdcmp gross rate of N mineralization gN/m^3/s F +GRU_PROD100C_GAIN - gross unrepresented landcover change addition to 100-yr wood product pool gC/m^2/s F +GRU_PROD100N_GAIN - gross unrepresented landcover change addition to 100-yr wood product pool gN/m^2/s F +GRU_PROD10C_GAIN - gross unrepresented landcover change addition to 10-yr wood product pool gC/m^2/s F +GRU_PROD10N_GAIN - gross unrepresented landcover change addition to 10-yr wood product pool gN/m^2/s F GSSHA - shaded leaf stomatal conductance umol H20/m2/s T GSSHALN - shaded leaf stomatal conductance at local noon umol H20/m2/s T GSSUN - sunlit leaf stomatal conductance umol H20/m2/s T @@ -576,7 +284,6 @@ H2OSFC - surface water depth H2OSNO - snow depth (liquid water) mm T H2OSNO_ICE - snow depth (liquid water, ice landunits only) mm F H2OSNO_TOP - mass of snow in top snow layer kg/m2 T -H2OSOI levsoi volumetric soil water (natural vegetated and crop landunits only) mm3/mm3 T HBOT - canopy bottom m F HEAT_CONTENT1 - initial gridcell total heat content J/m^2 T HEAT_CONTENT1_VEG - initial gridcell total heat content - natural vegetated and crop landunits only J/m^2 F @@ -585,9 +292,7 @@ HEAT_FROM_AC - sensible heat flux put into HIA - 2 m NWS Heat Index C T HIA_R - Rural 2 m NWS Heat Index C T HIA_U - Urban 2 m NWS Heat Index C T -HK levgrnd hydraulic conductivity (natural vegetated and crop landunits only) mm/s F HR - total heterotrophic respiration gC/m^2/s T -HR_vr levsoi total vertically resolved heterotrophic respiration gC/m^3/s T HTOP - canopy top m T HUMIDEX - 2 m Humidex C T HUMIDEX_R - Rural 2 m Humidex C T @@ -598,114 +303,76 @@ ICE_MODEL_FRACTION - Ice sheet model fractional INT_SNOW - accumulated swe (natural vegetated and crop landunits only) mm F INT_SNOW_ICE - accumulated swe (ice landunits only) mm F IWUELN - local noon intrinsic water use efficiency umolCO2/molH2O T -KROOT levsoi root conductance each soil layer 1/s F -KSOIL levsoi soil conductance in each soil layer 1/s F -K_ACT_SOM levdcmp active soil organic potential loss coefficient 1/s F -K_CEL_LIT levdcmp cellulosic litter potential loss coefficient 1/s F -K_LIG_LIT levdcmp lignin litter potential loss coefficient 1/s F -K_MET_LIT levdcmp metabolic litter potential loss coefficient 1/s F -K_NITR levdcmp K_NITR 1/s F -K_NITR_H2O levdcmp K_NITR_H2O unitless F -K_NITR_PH levdcmp K_NITR_PH unitless F -K_NITR_T levdcmp K_NITR_T unitless F -K_PAS_SOM levdcmp passive soil organic potential loss coefficient 1/s F -K_SLO_SOM levdcmp slow soil organic ma potential loss coefficient 1/s F -L1_PATHFRAC_S1_vr levdcmp PATHFRAC from metabolic litter to active soil organic fraction F -L1_RESP_FRAC_S1_vr levdcmp respired from metabolic litter to active soil organic fraction F -L2_PATHFRAC_S1_vr levdcmp PATHFRAC from cellulosic litter to active soil organic fraction F -L2_RESP_FRAC_S1_vr levdcmp respired from cellulosic litter to active soil organic fraction F -L3_PATHFRAC_S2_vr levdcmp PATHFRAC from lignin litter to slow soil organic ma fraction F -L3_RESP_FRAC_S2_vr levdcmp respired from lignin litter to slow soil organic ma fraction F LAI240 - 240hr average of leaf area index m^2/m^2 F LAISHA - shaded projected leaf area index m^2/m^2 T LAISUN - sunlit projected leaf area index m^2/m^2 T -LAKEICEFRAC levlak lake layer ice mass fraction unitless F LAKEICEFRAC_SURF - surface lake layer ice mass fraction unitless T LAKEICETHICK - thickness of lake ice (including physical expansion on freezing) m T -LIG_LITC - LIG_LIT C gC/m^2 T -LIG_LITC_1m - LIG_LIT C to 1 meter gC/m^2 F -LIG_LITC_TNDNCY_VERT_TRA levdcmp lignin litter C tendency due to vertical transport gC/m^3/s F -LIG_LITC_TO_SLO_SOMC - decomp. of lignin litter C to slow soil organic ma C gC/m^2/s F -LIG_LITC_TO_SLO_SOMC_vr levdcmp decomp. of lignin litter C to slow soil organic ma C gC/m^3/s F -LIG_LITC_vr levsoi LIG_LIT C (vertically resolved) gC/m^3 T -LIG_LITN - LIG_LIT N gN/m^2 T -LIG_LITN_1m - LIG_LIT N to 1 meter gN/m^2 F -LIG_LITN_TNDNCY_VERT_TRA levdcmp lignin litter N tendency due to vertical transport gN/m^3/s F -LIG_LITN_TO_SLO_SOMN - decomp. of lignin litter N to slow soil organic ma N gN/m^2 F -LIG_LITN_TO_SLO_SOMN_vr levdcmp decomp. of lignin litter N to slow soil organic ma N gN/m^3 F -LIG_LITN_vr levdcmp LIG_LIT N (vertically resolved) gN/m^3 T -LIG_LIT_HR - Het. Resp. from lignin litter gC/m^2/s F -LIG_LIT_HR_vr levdcmp Het. Resp. from lignin litter gC/m^3/s F LIQCAN - intercepted liquid water mm T LIQUID_CONTENT1 - initial gridcell total liq content mm T LIQUID_CONTENT2 - post landuse change gridcell total liq content mm F LIQUID_WATER_TEMP1 - initial gridcell weighted average liquid water temperature K F LITTERC_HR - litter C heterotrophic respiration gC/m^2/s T +LIT_CEL_C - LIT_CEL C gC/m^2 T +LIT_CEL_C_1m - LIT_CEL C to 1 meter gC/m^2 F +LIT_CEL_C_TO_SOM_ACT_C - decomp. of cellulosic litter C to active soil organic C gC/m^2/s F +LIT_CEL_HR - Het. Resp. from cellulosic litter gC/m^2/s F +LIT_CEL_N - LIT_CEL N gN/m^2 T +LIT_CEL_N_1m - LIT_CEL N to 1 meter gN/m^2 F +LIT_CEL_N_TO_SOM_ACT_N - decomp. of cellulosic litter N to active soil organic N gN/m^2 F +LIT_LIG_C - LIT_LIG C gC/m^2 T +LIT_LIG_C_1m - LIT_LIG C to 1 meter gC/m^2 F +LIT_LIG_C_TO_SOM_SLO_C - decomp. of lignin litter C to slow soil organic ma C gC/m^2/s F +LIT_LIG_HR - Het. Resp. from lignin litter gC/m^2/s F +LIT_LIG_N - LIT_LIG N gN/m^2 T +LIT_LIG_N_1m - LIT_LIG N to 1 meter gN/m^2 F +LIT_LIG_N_TO_SOM_SLO_N - decomp. of lignin litter N to slow soil organic ma N gN/m^2 F +LIT_MET_C - LIT_MET C gC/m^2 T +LIT_MET_C_1m - LIT_MET C to 1 meter gC/m^2 F +LIT_MET_C_TO_SOM_ACT_C - decomp. of metabolic litter C to active soil organic C gC/m^2/s F +LIT_MET_HR - Het. Resp. from metabolic litter gC/m^2/s F +LIT_MET_N - LIT_MET N gN/m^2 T +LIT_MET_N_1m - LIT_MET N to 1 meter gN/m^2 F +LIT_MET_N_TO_SOM_ACT_N - decomp. of metabolic litter N to active soil organic N gN/m^2 F LNC - leaf N concentration gN leaf/m^2 T LWdown - atmospheric longwave radiation (downscaled to columns in glacier regions) W/m^2 F LWup - upwelling longwave radiation W/m^2 F -MET_LITC - MET_LIT C gC/m^2 T -MET_LITC_1m - MET_LIT C to 1 meter gC/m^2 F -MET_LITC_TNDNCY_VERT_TRA levdcmp metabolic litter C tendency due to vertical transport gC/m^3/s F -MET_LITC_TO_ACT_SOMC - decomp. of metabolic litter C to active soil organic C gC/m^2/s F -MET_LITC_TO_ACT_SOMC_vr levdcmp decomp. of metabolic litter C to active soil organic C gC/m^3/s F -MET_LITC_vr levsoi MET_LIT C (vertically resolved) gC/m^3 T -MET_LITN - MET_LIT N gN/m^2 T -MET_LITN_1m - MET_LIT N to 1 meter gN/m^2 F -MET_LITN_TNDNCY_VERT_TRA levdcmp metabolic litter N tendency due to vertical transport gN/m^3/s F -MET_LITN_TO_ACT_SOMN - decomp. of metabolic litter N to active soil organic N gN/m^2 F -MET_LITN_TO_ACT_SOMN_vr levdcmp decomp. of metabolic litter N to active soil organic N gN/m^3 F -MET_LITN_vr levdcmp MET_LIT N (vertically resolved) gN/m^3 T -MET_LIT_HR - Het. Resp. from metabolic litter gC/m^2/s F -MET_LIT_HR_vr levdcmp Het. Resp. from metabolic litter gC/m^3/s F MORTALITY_CROWNAREA_CANOPY - Crown area of canopy trees that died m2/ha/year T MORTALITY_CROWNAREA_UNDERSTORY - Crown aera of understory trees that died m2/ha/year T -M_ACT_SOMC_TO_LEACHING - active soil organic C leaching loss gC/m^2/s F -M_ACT_SOMN_TO_LEACHING - active soil organic N leaching loss gN/m^2/s F -M_CEL_LITC_TO_LEACHING - cellulosic litter C leaching loss gC/m^2/s F -M_CEL_LITN_TO_LEACHING - cellulosic litter N leaching loss gN/m^2/s F -M_LIG_LITC_TO_LEACHING - lignin litter C leaching loss gC/m^2/s F -M_LIG_LITN_TO_LEACHING - lignin litter N leaching loss gN/m^2/s F -M_MET_LITC_TO_LEACHING - metabolic litter C leaching loss gC/m^2/s F -M_MET_LITN_TO_LEACHING - metabolic litter N leaching loss gN/m^2/s F -M_PAS_SOMC_TO_LEACHING - passive soil organic C leaching loss gC/m^2/s F -M_PAS_SOMN_TO_LEACHING - passive soil organic N leaching loss gN/m^2/s F -M_SLO_SOMC_TO_LEACHING - slow soil organic ma C leaching loss gC/m^2/s F -M_SLO_SOMN_TO_LEACHING - slow soil organic ma N leaching loss gN/m^2/s F +M_LIT_CEL_C_TO_LEACHING - cellulosic litter C leaching loss gC/m^2/s F +M_LIT_CEL_N_TO_LEACHING - cellulosic litter N leaching loss gN/m^2/s F +M_LIT_LIG_C_TO_LEACHING - lignin litter C leaching loss gC/m^2/s F +M_LIT_LIG_N_TO_LEACHING - lignin litter N leaching loss gN/m^2/s F +M_LIT_MET_C_TO_LEACHING - metabolic litter C leaching loss gC/m^2/s F +M_LIT_MET_N_TO_LEACHING - metabolic litter N leaching loss gN/m^2/s F +M_SOM_ACT_C_TO_LEACHING - active soil organic C leaching loss gC/m^2/s F +M_SOM_ACT_N_TO_LEACHING - active soil organic N leaching loss gN/m^2/s F +M_SOM_PAS_C_TO_LEACHING - passive soil organic C leaching loss gC/m^2/s F +M_SOM_PAS_N_TO_LEACHING - passive soil organic N leaching loss gN/m^2/s F +M_SOM_SLO_C_TO_LEACHING - slow soil organic ma C leaching loss gC/m^2/s F +M_SOM_SLO_N_TO_LEACHING - slow soil organic ma N leaching loss gN/m^2/s F NDEP_TO_SMINN - atmospheric N deposition to soil mineral N gN/m^2/s T NEM - Gridcell net adjustment to net carbon exchange passed to atm. for methane production gC/m2/s T NET_NMIN - net rate of N mineralization gN/m^2/s T -NET_NMIN_vr levdcmp net rate of N mineralization gN/m^3/s F NFIX_TO_SMINN - symbiotic/asymbiotic N fixation to soil mineral N gN/m^2/s T NSUBSTEPS - number of adaptive timesteps in CLM timestep unitless F -O2_DECOMP_DEPTH_UNSAT levgrnd O2 consumption from HR and AR for non-inundated area mol/m3/s F OBU - Monin-Obukhov length m F OCDEP - total OC deposition (dry+wet) from atmosphere kg/m^2/s T -O_SCALAR levsoi fraction by which decomposition is reduced due to anoxia unitless T PARVEGLN - absorbed par by vegetation at local noon W/m^2 T -PAS_SOMC - PAS_SOM C gC/m^2 T -PAS_SOMC_1m - PAS_SOM C to 1 meter gC/m^2 F -PAS_SOMC_TNDNCY_VERT_TRA levdcmp passive soil organic C tendency due to vertical transport gC/m^3/s F -PAS_SOMC_TO_ACT_SOMC - decomp. of passive soil organic C to active soil organic C gC/m^2/s F -PAS_SOMC_TO_ACT_SOMC_vr levdcmp decomp. of passive soil organic C to active soil organic C gC/m^3/s F -PAS_SOMC_vr levsoi PAS_SOM C (vertically resolved) gC/m^3 T -PAS_SOMN - PAS_SOM N gN/m^2 T -PAS_SOMN_1m - PAS_SOM N to 1 meter gN/m^2 F -PAS_SOMN_TNDNCY_VERT_TRA levdcmp passive soil organic N tendency due to vertical transport gN/m^3/s F -PAS_SOMN_TO_ACT_SOMN - decomp. of passive soil organic N to active soil organic N gN/m^2 F -PAS_SOMN_TO_ACT_SOMN_vr levdcmp decomp. of passive soil organic N to active soil organic N gN/m^3 F -PAS_SOMN_vr levdcmp PAS_SOM N (vertically resolved) gN/m^3 T -PAS_SOM_HR - Het. Resp. from passive soil organic gC/m^2/s F -PAS_SOM_HR_vr levdcmp Het. Resp. from passive soil organic gC/m^3/s F PBOT - atmospheric pressure at surface (downscaled to columns in glacier regions) Pa T PCH4 - atmospheric partial pressure of CH4 Pa T PCO2 - atmospheric partial pressure of CO2 Pa T POTENTIAL_IMMOB - potential N immobilization gN/m^2/s T -POTENTIAL_IMMOB_vr levdcmp potential N immobilization gN/m^3/s F POT_F_DENIT - potential denitrification flux gN/m^2/s T -POT_F_DENIT_vr levdcmp potential denitrification flux gN/m^3/s F POT_F_NIT - potential nitrification flux gN/m^2/s T -POT_F_NIT_vr levdcmp potential nitrification flux gN/m^3/s F +PROD100C - 100-yr wood product C gC/m^2 F +PROD100C_LOSS - loss from 100-yr wood product pool gC/m^2/s F +PROD100N - 100-yr wood product N gN/m^2 F +PROD100N_LOSS - loss from 100-yr wood product pool gN/m^2/s F +PROD10C - 10-yr wood product C gC/m^2 F +PROD10C_LOSS - loss from 10-yr wood product pool gC/m^2/s F +PROD10N - 10-yr wood product N gN/m^2 F +PROD10N_LOSS - loss from 10-yr wood product pool gN/m^2/s F PSurf - atmospheric pressure at surface (downscaled to columns in glacier regions) Pa F Q2M - 2m specific humidity kg/kg T QAF - canopy air humidity kg/kg F @@ -735,7 +402,6 @@ QH2OSFC - surface water runoff QH2OSFC_TO_ICE - surface water converted to ice mm/s F QHR - hydraulic redistribution mm/s T QICE - ice growth/melt mm/s T -QICE_FORC elevclas qice forcing sent to GLC mm/s F QICE_FRZ - ice growth mm/s T QICE_MELT - ice melt mm/s T QINFL - infiltration mm/s T @@ -750,7 +416,6 @@ QOVER - total surface runoff (inclu QOVER_LAG - time-lagged surface runoff for soil columns mm/s F QPHSNEG - net negative hydraulic redistribution flux mm/s F QRGWL - surface runoff at glaciers (liquid only), wetlands, lakes; also includes melted ice runoff fro mm/s T -QROOTSINK levsoi water flux from soil to root in each soil-layer mm/s F QRUNOFF - total liquid runoff not including correction for land use change mm/s T QRUNOFF_ICE - total liquid runoff not incl corret for LULCC (ice landunits only) mm/s T QRUNOFF_ICE_TO_COUPLER - total ice runoff sent to coupler (includes corrections for land use change) mm/s T @@ -798,71 +463,23 @@ RSSHA - shaded leaf stomatal resist RSSUN - sunlit leaf stomatal resistance s/m T Rainf - atmospheric rain, after rain/snow repartitioning based on temperature mm/s F Rnet - net radiation W/m^2 F -S1_PATHFRAC_S2_vr levdcmp PATHFRAC from active soil organic to slow soil organic ma fraction F -S1_PATHFRAC_S3_vr levdcmp PATHFRAC from active soil organic to passive soil organic fraction F -S1_RESP_FRAC_S2_vr levdcmp respired from active soil organic to slow soil organic ma fraction F -S1_RESP_FRAC_S3_vr levdcmp respired from active soil organic to passive soil organic fraction F -S2_PATHFRAC_S1_vr levdcmp PATHFRAC from slow soil organic ma to active soil organic fraction F -S2_PATHFRAC_S3_vr levdcmp PATHFRAC from slow soil organic ma to passive soil organic fraction F -S2_RESP_FRAC_S1_vr levdcmp respired from slow soil organic ma to active soil organic fraction F -S2_RESP_FRAC_S3_vr levdcmp respired from slow soil organic ma to passive soil organic fraction F -S3_PATHFRAC_S1_vr levdcmp PATHFRAC from passive soil organic to active soil organic fraction F -S3_RESP_FRAC_S1_vr levdcmp respired from passive soil organic to active soil organic fraction F SABG - solar rad absorbed by ground W/m^2 T SABG_PEN - Rural solar rad penetrating top soil or snow layer watt/m^2 T SABV - solar rad absorbed by veg W/m^2 T -SLO_SOMC - SLO_SOM C gC/m^2 T -SLO_SOMC_1m - SLO_SOM C to 1 meter gC/m^2 F -SLO_SOMC_TNDNCY_VERT_TRA levdcmp slow soil organic ma C tendency due to vertical transport gC/m^3/s F -SLO_SOMC_TO_ACT_SOMC - decomp. of slow soil organic ma C to active soil organic C gC/m^2/s F -SLO_SOMC_TO_ACT_SOMC_vr levdcmp decomp. of slow soil organic ma C to active soil organic C gC/m^3/s F -SLO_SOMC_TO_PAS_SOMC - decomp. of slow soil organic ma C to passive soil organic C gC/m^2/s F -SLO_SOMC_TO_PAS_SOMC_vr levdcmp decomp. of slow soil organic ma C to passive soil organic C gC/m^3/s F -SLO_SOMC_vr levsoi SLO_SOM C (vertically resolved) gC/m^3 T -SLO_SOMN - SLO_SOM N gN/m^2 T -SLO_SOMN_1m - SLO_SOM N to 1 meter gN/m^2 F -SLO_SOMN_TNDNCY_VERT_TRA levdcmp slow soil organic ma N tendency due to vertical transport gN/m^3/s F -SLO_SOMN_TO_ACT_SOMN - decomp. of slow soil organic ma N to active soil organic N gN/m^2 F -SLO_SOMN_TO_ACT_SOMN_vr levdcmp decomp. of slow soil organic ma N to active soil organic N gN/m^3 F -SLO_SOMN_TO_PAS_SOMN - decomp. of slow soil organic ma N to passive soil organic N gN/m^2 F -SLO_SOMN_TO_PAS_SOMN_vr levdcmp decomp. of slow soil organic ma N to passive soil organic N gN/m^3 F -SLO_SOMN_vr levdcmp SLO_SOM N (vertically resolved) gN/m^3 T -SLO_SOM_HR_S1 - Het. Resp. from slow soil organic ma gC/m^2/s F -SLO_SOM_HR_S1_vr levdcmp Het. Resp. from slow soil organic ma gC/m^3/s F -SLO_SOM_HR_S3 - Het. Resp. from slow soil organic ma gC/m^2/s F -SLO_SOM_HR_S3_vr levdcmp Het. Resp. from slow soil organic ma gC/m^3/s F SMINN - soil mineral N gN/m^2 T SMINN_TO_PLANT - plant uptake of soil mineral N gN/m^2/s T -SMINN_TO_PLANT_vr levdcmp plant uptake of soil mineral N gN/m^3/s F -SMINN_TO_S1N_L1 - mineral N flux for decomp. of MET_LITto ACT_SOM gN/m^2 F -SMINN_TO_S1N_L1_vr levdcmp mineral N flux for decomp. of MET_LITto ACT_SOM gN/m^3 F -SMINN_TO_S1N_L2 - mineral N flux for decomp. of CEL_LITto ACT_SOM gN/m^2 F -SMINN_TO_S1N_L2_vr levdcmp mineral N flux for decomp. of CEL_LITto ACT_SOM gN/m^3 F -SMINN_TO_S1N_S2 - mineral N flux for decomp. of SLO_SOMto ACT_SOM gN/m^2 F -SMINN_TO_S1N_S2_vr levdcmp mineral N flux for decomp. of SLO_SOMto ACT_SOM gN/m^3 F -SMINN_TO_S1N_S3 - mineral N flux for decomp. of PAS_SOMto ACT_SOM gN/m^2 F -SMINN_TO_S1N_S3_vr levdcmp mineral N flux for decomp. of PAS_SOMto ACT_SOM gN/m^3 F -SMINN_TO_S2N_L3 - mineral N flux for decomp. of LIG_LITto SLO_SOM gN/m^2 F -SMINN_TO_S2N_L3_vr levdcmp mineral N flux for decomp. of LIG_LITto SLO_SOM gN/m^3 F -SMINN_TO_S2N_S1 - mineral N flux for decomp. of ACT_SOMto SLO_SOM gN/m^2 F -SMINN_TO_S2N_S1_vr levdcmp mineral N flux for decomp. of ACT_SOMto SLO_SOM gN/m^3 F -SMINN_TO_S3N_S1 - mineral N flux for decomp. of ACT_SOMto PAS_SOM gN/m^2 F -SMINN_TO_S3N_S1_vr levdcmp mineral N flux for decomp. of ACT_SOMto PAS_SOM gN/m^3 F -SMINN_TO_S3N_S2 - mineral N flux for decomp. of SLO_SOMto PAS_SOM gN/m^2 F -SMINN_TO_S3N_S2_vr levdcmp mineral N flux for decomp. of SLO_SOMto PAS_SOM gN/m^3 F -SMINN_vr levsoi soil mineral N gN/m^3 T +SMINN_TO_S1N_L1 - mineral N flux for decomp. of LIT_METto SOM_ACT gN/m^2 F +SMINN_TO_S1N_L2 - mineral N flux for decomp. of LIT_CELto SOM_ACT gN/m^2 F +SMINN_TO_S1N_S2 - mineral N flux for decomp. of SOM_SLOto SOM_ACT gN/m^2 F +SMINN_TO_S1N_S3 - mineral N flux for decomp. of SOM_PASto SOM_ACT gN/m^2 F +SMINN_TO_S2N_L3 - mineral N flux for decomp. of LIT_LIGto SOM_SLO gN/m^2 F +SMINN_TO_S2N_S1 - mineral N flux for decomp. of SOM_ACTto SOM_SLO gN/m^2 F +SMINN_TO_S3N_S1 - mineral N flux for decomp. of SOM_ACTto SOM_PAS gN/m^2 F +SMINN_TO_S3N_S2 - mineral N flux for decomp. of SOM_SLOto SOM_PAS gN/m^2 F SMIN_NH4 - soil mineral NH4 gN/m^2 T -SMIN_NH4_TO_PLANT levdcmp plant uptake of NH4 gN/m^3/s F -SMIN_NH4_vr levsoi soil mineral NH4 (vert. res.) gN/m^3 T SMIN_NO3 - soil mineral NO3 gN/m^2 T SMIN_NO3_LEACHED - soil NO3 pool loss to leaching gN/m^2/s T -SMIN_NO3_LEACHED_vr levdcmp soil NO3 pool loss to leaching gN/m^3/s F -SMIN_NO3_MASSDENS levdcmp SMIN_NO3_MASSDENS ugN/cm^3 soil F SMIN_NO3_RUNOFF - soil NO3 pool loss to runoff gN/m^2/s T -SMIN_NO3_RUNOFF_vr levdcmp soil NO3 pool loss to runoff gN/m^3/s F -SMIN_NO3_TO_PLANT levdcmp plant uptake of NO3 gN/m^3/s F -SMIN_NO3_vr levsoi soil mineral NO3 (vert. res.) gN/m^3 T -SMP levgrnd soil matric potential (natural vegetated and crop landunits only) mm T SNOBCMCL - mass of BC in snow column kg/m2 T SNOBCMSL - mass of BC in top snow layer kg/m2 T SNOCAN - intercepted snow mm T @@ -899,40 +516,42 @@ SNOW_ICE - atmospheric snow, after rai SNOW_PERSISTENCE - Length of time of continuous snow cover (nat. veg. landunits only) seconds T SNOW_SINKS - snow sinks (liquid water) mm/s T SNOW_SOURCES - snow sources (liquid water) mm/s T -SNO_ABS levsno Absorbed solar radiation in each snow layer W/m^2 F -SNO_ABS_ICE levsno Absorbed solar radiation in each snow layer (ice landunits only) W/m^2 F -SNO_BW levsno Partial density of water in the snow pack (ice + liquid) kg/m3 F -SNO_BW_ICE levsno Partial density of water in the snow pack (ice + liquid, ice landunits only) kg/m3 F -SNO_EXISTENCE levsno Fraction of averaging period for which each snow layer existed unitless F -SNO_FRZ levsno snow freezing rate in each snow layer kg/m2/s F -SNO_FRZ_ICE levsno snow freezing rate in each snow layer (ice landunits only) mm/s F -SNO_GS levsno Mean snow grain size Microns F -SNO_GS_ICE levsno Mean snow grain size (ice landunits only) Microns F -SNO_ICE levsno Snow ice content kg/m2 F -SNO_LIQH2O levsno Snow liquid water content kg/m2 F -SNO_MELT levsno snow melt rate in each snow layer mm/s F -SNO_MELT_ICE levsno snow melt rate in each snow layer (ice landunits only) mm/s F -SNO_T levsno Snow temperatures K F -SNO_TK levsno Thermal conductivity W/m-K F -SNO_TK_ICE levsno Thermal conductivity (ice landunits only) W/m-K F -SNO_T_ICE levsno Snow temperatures (ice landunits only) K F -SNO_Z levsno Snow layer thicknesses m F -SNO_Z_ICE levsno Snow layer thicknesses (ice landunits only) m F SNOdTdzL - top snow layer temperature gradient (land) K/m F SOIL10 - 10-day running mean of 12cm layer soil K F SOILC_HR - soil C heterotrophic respiration gC/m^2/s T -SOILC_vr levsoi SOIL C (vertically resolved) gC/m^3 T -SOILICE levsoi soil ice (natural vegetated and crop landunits only) kg/m2 T -SOILLIQ levsoi soil liquid water (natural vegetated and crop landunits only) kg/m2 T -SOILN_vr levdcmp SOIL N (vertically resolved) gN/m^3 T -SOILPSI levgrnd soil water potential in each soil layer MPa F SOILRESIS - soil resistance to evaporation s/m T SOILWATER_10CM - soil liquid water + ice in top 10cm of soil (veg landunits only) kg/m2 T SOMC_FIRE - C loss due to peat burning gC/m^2/s T +SOM_ACT_C - SOM_ACT C gC/m^2 T +SOM_ACT_C_1m - SOM_ACT C to 1 meter gC/m^2 F +SOM_ACT_C_TO_SOM_PAS_C - decomp. of active soil organic C to passive soil organic C gC/m^2/s F +SOM_ACT_C_TO_SOM_SLO_C - decomp. of active soil organic C to slow soil organic ma C gC/m^2/s F +SOM_ACT_HR_S2 - Het. Resp. from active soil organic gC/m^2/s F +SOM_ACT_HR_S3 - Het. Resp. from active soil organic gC/m^2/s F +SOM_ACT_N - SOM_ACT N gN/m^2 T +SOM_ACT_N_1m - SOM_ACT N to 1 meter gN/m^2 F +SOM_ACT_N_TO_SOM_PAS_N - decomp. of active soil organic N to passive soil organic N gN/m^2 F +SOM_ACT_N_TO_SOM_SLO_N - decomp. of active soil organic N to slow soil organic ma N gN/m^2 F SOM_C_LEACHED - total flux of C from SOM pools due to leaching gC/m^2/s T SOM_N_LEACHED - total flux of N from SOM pools due to leaching gN/m^2/s F +SOM_PAS_C - SOM_PAS C gC/m^2 T +SOM_PAS_C_1m - SOM_PAS C to 1 meter gC/m^2 F +SOM_PAS_C_TO_SOM_ACT_C - decomp. of passive soil organic C to active soil organic C gC/m^2/s F +SOM_PAS_HR - Het. Resp. from passive soil organic gC/m^2/s F +SOM_PAS_N - SOM_PAS N gN/m^2 T +SOM_PAS_N_1m - SOM_PAS N to 1 meter gN/m^2 F +SOM_PAS_N_TO_SOM_ACT_N - decomp. of passive soil organic N to active soil organic N gN/m^2 F +SOM_SLO_C - SOM_SLO C gC/m^2 T +SOM_SLO_C_1m - SOM_SLO C to 1 meter gC/m^2 F +SOM_SLO_C_TO_SOM_ACT_C - decomp. of slow soil organic ma C to active soil organic C gC/m^2/s F +SOM_SLO_C_TO_SOM_PAS_C - decomp. of slow soil organic ma C to passive soil organic C gC/m^2/s F +SOM_SLO_HR_S1 - Het. Resp. from slow soil organic ma gC/m^2/s F +SOM_SLO_HR_S3 - Het. Resp. from slow soil organic ma gC/m^2/s F +SOM_SLO_N - SOM_SLO N gN/m^2 T +SOM_SLO_N_1m - SOM_SLO N to 1 meter gN/m^2 F +SOM_SLO_N_TO_SOM_ACT_N - decomp. of slow soil organic ma N to active soil organic N gN/m^2 F +SOM_SLO_N_TO_SOM_PAS_N - decomp. of slow soil organic ma N to passive soil organic N gN/m^2 F SUPPLEMENT_TO_SMINN - supplemental N supply gN/m^2/s T -SUPPLEMENT_TO_SMINN_vr levdcmp supplemental N supply gN/m^3/s F SWBGT - 2 m Simplified Wetbulb Globe Temp C T SWBGT_R - Rural 2 m Simplified Wetbulb Globe Temp C T SWBGT_U - Urban 2 m Simplified Wetbulb Globe Temp C T @@ -956,21 +575,27 @@ TH2OSFC - surface water temperature THBOT - atmospheric air potential temperature (downscaled to columns in glacier regions) K T TKE1 - top lake level eddy thermal conductivity W/(mK) T TLAI - total projected leaf area index m^2/m^2 T -TLAKE levlak lake temperature K T TOPO_COL - column-level topographic height m F TOPO_COL_ICE - column-level topographic height (ice landunits only) m F -TOPO_FORC elevclas topograephic height sent to GLC m F +TOTCOLC - total column carbon, incl veg and cpool but excl product pools gC/m^2 T TOTCOLCH4 - total belowground CH4 (0 for non-lake special landunits in the absence of dynamic landunits) gC/m2 T +TOTCOLN - total column-level N, excluding product pools gN/m^2 T +TOTECOSYSC - total ecosystem carbon, incl veg but excl cpool and product pools gC/m^2 T +TOTECOSYSN - total ecosystem N, excluding product pools gN/m^2 T TOTLITC - total litter carbon gC/m^2 T TOTLITC_1m - total litter carbon to 1 meter depth gC/m^2 T TOTLITN - total litter N gN/m^2 T TOTLITN_1m - total litter N to 1 meter gN/m^2 T -TOTSOILICE - vertically summed soil cie (veg landunits only) kg/m2 T +TOTSOILICE - vertically summed soil ice (veg landunits only) kg/m2 T TOTSOILLIQ - vertically summed soil liquid water (veg landunits only) kg/m2 T TOTSOMC - total soil organic matter carbon gC/m^2 T TOTSOMC_1m - total soil organic matter carbon to 1 meter depth gC/m^2 T TOTSOMN - total soil organic matter N gN/m^2 T TOTSOMN_1m - total soil organic matter N to 1 meter gN/m^2 T +TOT_WOODPRODC - total wood product C gC/m^2 T +TOT_WOODPRODC_LOSS - total loss from wood product pools gC/m^2/s T +TOT_WOODPRODN - total wood product N gN/m^2 T +TOT_WOODPRODN_LOSS - total loss from wood product pools gN/m^2/s T TRAFFICFLUX - sensible heat flux from urban traffic W/m^2 F TREFMNAV - daily minimum of average 2-m temperature K T TREFMNAV_R - Rural daily minimum of average 2-m temperature K F @@ -987,16 +612,12 @@ TSA_U - Urban 2m air temperature TSHDW_INNER - shadewall inside surface temperature K F TSKIN - skin temperature K T TSL - temperature of near-surface soil layer (natural vegetated and crop landunits only) K T -TSOI levgrnd soil temperature (natural vegetated and crop landunits only) K T TSOI_10CM - soil temperature in top 10cm of soil K T -TSOI_ICE levgrnd soil temperature (ice landunits only) K T -TSRF_FORC elevclas surface temperature sent to GLC K F TSUNW_INNER - sunwall inside surface temperature K F TV - vegetation temperature K T TV24 - vegetation temperature (last 24hrs) K F TV240 - vegetation temperature (last 240hrs) K F TWS - total water storage mm T -T_SCALAR levsoi temperature inhibition of decomposition unitless T Tair - atmospheric air temperature (downscaled to columns in glacier regions) K F Tair_from_atm - atmospheric air temperature received from atmosphere (pre-downscaling) K F U10 - 10-m wind m/s T @@ -1019,10 +640,8 @@ WASTEHEAT - sensible heat flux from hea WBT - 2 m Stull Wet Bulb C T WBT_R - Rural 2 m Stull Wet Bulb C T WBT_U - Urban 2 m Stull Wet Bulb C T -WFPS levdcmp WFPS percent F WIND - atmospheric wind velocity magnitude m/s T WTGQ - surface tracer conductance m/s T -W_SCALAR levsoi Moisture (dryness) inhibition of decomposition unitless T Wind - atmospheric wind velocity magnitude m/s F Z0HG - roughness length over ground, sensible heat (vegetated landunits only) m F Z0MG - roughness length over ground, momentum (vegetated landunits only) m F @@ -1035,14 +654,434 @@ ZII - convective boundary height ZWT - water table depth (natural vegetated and crop landunits only) m T ZWT_CH4_UNSAT - depth of water table for methane production used in non-inundated area m T ZWT_PERCH - perched water table depth (natural vegetated and crop landunits only) m T +num_iter - number of iterations unitless F +QICE_FORC elevclas qice forcing sent to GLC mm/s F +TOPO_FORC elevclas topograephic height sent to GLC m F +TSRF_FORC elevclas surface temperature sent to GLC K F +FATES_BURNFRAC_AP fates_levage spitfire fraction area burnt (per second) by patch age s-1 T +FATES_CANOPYAREA_AP fates_levage canopy area by age bin per m2 land area m2 m-2 T +FATES_FIRE_INTENSITY_BURNFRAC_AP fates_levage product of fire intensity and burned fraction, resolved by patch age (so divide by FATES_BURNF J m-1 s-1 T +FATES_FUEL_AMOUNT_AP fates_levage spitfire ground fuel (kg carbon per m2) related to FATES_ROS (omits 1000hr fuels) within each kg m-2 T +FATES_GPP_AP fates_levage gross primary productivity by age bin in kg carbon per m2 per second kg m-2 s-1 F +FATES_LAI_AP fates_levage leaf area index by age bin per m2 land area m2 m-2 T +FATES_LBLAYER_COND_AP fates_levage mean leaf boundary layer conductance - by patch age mol m-2 s-1 F +FATES_NCL_AP fates_levage number of canopy levels by age bin F +FATES_NPATCH_AP fates_levage number of patches by age bin F +FATES_NPP_AP fates_levage net primary productivity by age bin in kg carbon per m2 per second kg m-2 s-1 F +FATES_PATCHAREA_AP fates_levage patch area by age bin per m2 land area m2 m-2 T +FATES_SECONDAREA_ANTHRODIST_AP fates_levage secondary forest patch area age distribution since anthropgenic disturbance m2 m-2 F +FATES_SECONDAREA_DIST_AP fates_levage secondary forest patch area age distribution since any kind of disturbance m2 m-2 F +FATES_STOMATAL_COND_AP fates_levage mean stomatal conductance - by patch age mol m-2 s-1 F +FATES_VEGC_AP fates_levage total biomass within a given patch age bin in kg carbon per m2 land area kg m-2 F +FATES_ZSTAR_AP fates_levage product of zstar and patch area by age bin (divide by FATES_PATCHAREA_AP to get mean zstar) m F +FATES_FUEL_AMOUNT_APFC fates_levagefuel spitfire fuel quantity in each age x fuel class in kg carbon per m2 land area kg m-2 F +FATES_NPP_APPF fates_levagepft NPP per PFT in each age bin in kg carbon per m2 per second kg m-2 s-1 F +FATES_SCORCH_HEIGHT_APPF fates_levagepft SPITFIRE flame Scorch Height (calculated per PFT in each patch age bin) m F +FATES_VEGC_APPF fates_levagepft biomass per PFT in each age bin in kg carbon per m2 kg m-2 F +FATES_MORTALITY_AGESCEN_AC fates_levcacls age senescence mortality by cohort age in number of plants per m2 per year m-2 yr-1 T +FATES_NPLANT_AC fates_levcacls number of plants per m2 by cohort age class m-2 T +FATES_CROWNAREA_CL fates_levcan total crown area in each canopy layer m2 m-2 T +FATES_FABD_SHA_TOPLF_CL fates_levcan shade fraction of direct light absorbed by the top leaf layer of each canopy layer 1 F +FATES_FABD_SUN_TOPLF_CL fates_levcan sun fraction of direct light absorbed by the top leaf layer of each canopy layer 1 F +FATES_FABI_SHA_TOPLF_CL fates_levcan shade fraction of indirect light absorbed by the top leaf layer of each canopy layer 1 F +FATES_FABI_SUN_TOPLF_CL fates_levcan sun fraction of indirect light absorbed by the top leaf layer of each canopy layer 1 F +FATES_LAISHA_TOP_CL fates_levcan LAI in the shade by the top leaf layer of each canopy layer m2 m-2 F +FATES_LAISUN_TOP_CL fates_levcan LAI in the sun by the top leaf layer of each canopy layer m2 m-2 F +FATES_PARSHA_Z_CL fates_levcan PAR absorbed in the shade by top leaf layer in each canopy layer W m-2 F +FATES_PARSUN_Z_CL fates_levcan PAR absorbed in the sun by top leaf layer in each canopy layer W m-2 F +FATES_MORTALITY_AGESCEN_ACPF fates_levcapf age senescence mortality by pft/cohort age in number of plants per m2 per year m-2 yr-1 F +FATES_NPLANT_ACPF fates_levcapf stem number density by pft and age class m-2 F +FATES_CROWNAREA_CLLL fates_levcnlf total crown area that is occupied by leaves in each canopy and leaf layer m2 m-2 F +FATES_FABD_SHA_CLLL fates_levcnlf shade fraction of direct light absorbed by each canopy and leaf layer 1 F +FATES_FABD_SUN_CLLL fates_levcnlf sun fraction of direct light absorbed by each canopy and leaf layer 1 F +FATES_FABI_SHA_CLLL fates_levcnlf shade fraction of indirect light absorbed by each canopy and leaf layer 1 F +FATES_FABI_SUN_CLLL fates_levcnlf sun fraction of indirect light absorbed by each canopy and leaf layer 1 F +FATES_LAISHA_Z_CLLL fates_levcnlf LAI in the shade by each canopy and leaf layer m2 m-2 F +FATES_LAISUN_Z_CLLL fates_levcnlf LAI in the sun by each canopy and leaf layer m2 m-2 F +FATES_NET_C_UPTAKE_CLLL fates_levcnlf net carbon uptake in kg carbon per m2 per second by each canopy and leaf layer per unit ground kg m-2 s-1 F +FATES_PARPROF_DIF_CLLL fates_levcnlf radiative profile of diffuse PAR through each canopy and leaf layer (averaged across PFTs) W m-2 F +FATES_PARPROF_DIR_CLLL fates_levcnlf radiative profile of direct PAR through each canopy and leaf layer (averaged across PFTs) W m-2 F +FATES_PARSHA_Z_CLLL fates_levcnlf PAR absorbed in the shade by each canopy and leaf layer W m-2 F +FATES_PARSUN_Z_CLLL fates_levcnlf PAR absorbed in the sun by each canopy and leaf layer W m-2 F +FATES_FABD_SHA_CLLLPF fates_levcnlfpf shade fraction of direct light absorbed by each canopy, leaf, and PFT 1 F +FATES_FABD_SUN_CLLLPF fates_levcnlfpf sun fraction of direct light absorbed by each canopy, leaf, and PFT 1 F +FATES_FABI_SHA_CLLLPF fates_levcnlfpf shade fraction of indirect light absorbed by each canopy, leaf, and PFT 1 F +FATES_FABI_SUN_CLLLPF fates_levcnlfpf sun fraction of indirect light absorbed by each canopy, leaf, and PFT 1 F +FATES_LAISHA_Z_CLLLPF fates_levcnlfpf LAI in the shade by each canopy, leaf, and PFT m2 m-2 F +FATES_LAISUN_Z_CLLLPF fates_levcnlfpf LAI in the sun by each canopy, leaf, and PFT m2 m-2 F +FATES_PARPROF_DIF_CLLLPF fates_levcnlfpf radiative profile of diffuse PAR through each canopy, leaf, and PFT W m-2 F +FATES_PARPROF_DIR_CLLLPF fates_levcnlfpf radiative profile of direct PAR through each canopy, leaf, and PFT W m-2 F +FATES_PARSHA_Z_CLLLPF fates_levcnlfpf PAR absorbed in the shade by each canopy, leaf, and PFT W m-2 F +FATES_PARSUN_Z_CLLLPF fates_levcnlfpf PAR absorbed in the sun by each canopy, leaf, and PFT W m-2 F +FATES_CWD_ABOVEGROUND_DC fates_levcwdsc debris class-level aboveground coarse woody debris stocks in kg carbon per m2 kg m-2 F +FATES_CWD_ABOVEGROUND_IN_DC fates_levcwdsc debris class-level aboveground coarse woody debris input in kg carbon per m2 per second kg m-2 s-1 F +FATES_CWD_ABOVEGROUND_OUT_DC fates_levcwdsc debris class-level aboveground coarse woody debris output in kg carbon per m2 per second kg m-2 s-1 F +FATES_CWD_BELOWGROUND_DC fates_levcwdsc debris class-level belowground coarse woody debris stocks in kg carbon per m2 kg m-2 F +FATES_CWD_BELOWGROUND_IN_DC fates_levcwdsc debris class-level belowground coarse woody debris input in kg carbon per m2 per second kg m-2 s-1 F +FATES_CWD_BELOWGROUND_OUT_DC fates_levcwdsc debris class-level belowground coarse woody debris output in kg carbon per m2 per second kg m-2 s-1 F +FATES_LITTER_CWD_ELDC fates_levelcwd total mass of litter in coarse woody debris by element and coarse woody debris size kg m-2 T +FATES_ERROR_EL fates_levelem total mass-balance error in kg per second by element kg s-1 T +FATES_FIRE_FLUX_EL fates_levelem loss to atmosphere from fire by element in kg element per m2 per s kg m-2 s-1 T +FATES_LITTER_AG_CWD_EL fates_levelem mass of aboveground litter in coarse woody debris (trunks/branches/twigs) by element kg m-2 T +FATES_LITTER_AG_FINE_EL fates_levelem mass of aboveground litter in fines (leaves, nonviable seed) by element kg m-2 T +FATES_LITTER_BG_CWD_EL fates_levelem mass of belowground litter in coarse woody debris (coarse roots) by element kg m-2 T +FATES_LITTER_BG_FINE_EL fates_levelem mass of belowground litter in fines (fineroots) by element kg m-2 T +FATES_LITTER_IN_EL fates_levelem litter flux in in kg element per m2 per second kg m-2 s-1 T +FATES_LITTER_OUT_EL fates_levelem litter flux out (exudation, fragmentation and seed decay) in kg element kg m-2 s-1 T +FATES_SEEDS_IN_EXTERN_EL fates_levelem external seed influx rate in kg element per m2 per second kg m-2 s-1 T +FATES_SEEDS_IN_LOCAL_EL fates_levelem within-site, element-level seed production rate in kg element per m2 per second kg m-2 s-1 T +FATES_SEED_BANK_EL fates_levelem element-level total seed mass of all PFTs in kg element per m2 kg m-2 T +FATES_SEED_DECAY_EL fates_levelem seed mass decay (germinated and un-germinated) in kg element per m2 per second kg m-2 s-1 T +FATES_SEED_GERM_EL fates_levelem element-level total germinated seed mass of all PFTs in kg element per m2 kg m-2 T +FATES_FUEL_AMOUNT_FC fates_levfuel spitfire fuel-class level fuel amount in kg carbon per m2 land area kg m-2 T +FATES_FUEL_BURNT_BURNFRAC_FC fates_levfuel product of fraction (0-1) of fuel burnt and burnt fraction (divide by FATES_BURNFRAC to get bu 1 T +FATES_FUEL_MOISTURE_FC fates_levfuel spitfire fuel class-level fuel moisture (volumetric) m3 m-3 T +FATES_CANOPYAREA_HT fates_levheight canopy area height distribution m2 m-2 T +FATES_LEAFAREA_HT fates_levheight leaf area height distribution m2 m-2 T +FATES_CANOPYCROWNAREA_PF fates_levpft total PFT-level canopy-layer crown area per m2 land area m2 m-2 T +FATES_CROWNAREA_PF fates_levpft total PFT-level crown area per m2 land area m2 m-2 T +FATES_DAYSINCE_DROUGHTLEAFOFF_PF fates_levpft PFT-level days elapsed since drought leaf drop days T +FATES_DAYSINCE_DROUGHTLEAFON_PF fates_levpft PFT-level days elapsed since drought leaf flush days T +FATES_DROUGHT_STATUS_PF fates_levpft PFT-level drought status, <2 too dry for leaves, >=2 not too dry T +FATES_ELONG_FACTOR_PF fates_levpft PFT-level mean elongation factor (partial flushing/abscission) 1 T +FATES_GPP_PF fates_levpft total PFT-level GPP in kg carbon per m2 land area per second kg m-2 s-1 T +FATES_GPP_SE_PF fates_levpft total PFT-level GPP in kg carbon per m2 land area per second, secondary patches kg m-2 s-1 T +FATES_LEAFC_PF fates_levpft total PFT-level leaf biomass in kg carbon per m2 land area kg m-2 T +FATES_MEANLIQVOL_DROUGHTPHEN_PF fates_levpft PFT-level mean liquid water volume for drought phenolgy m3 m-3 T +FATES_MEANSMP_DROUGHTPHEN_PF fates_levpft PFT-level mean soil matric potential for drought phenology Pa T +FATES_MORTALITY_CFLUX_PF fates_levpft PFT-level flux of biomass carbon from live to dead pool from mortality kg m-2 s-1 T +FATES_MORTALITY_CSTARV_CFLUX_PF fates_levpft PFT-level flux of biomass carbon from live to dead pool from carbon starvation mortality kg m-2 s-1 T +FATES_MORTALITY_FIRE_CFLUX_PF fates_levpft PFT-level flux of biomass carbon from live to dead pool from fire mortality kg m-2 s-1 T +FATES_MORTALITY_HYDRO_CFLUX_PF fates_levpft PFT-level flux of biomass carbon from live to dead pool from hydraulic failure mortality kg m-2 s-1 T +FATES_MORTALITY_PF fates_levpft PFT-level mortality rate in number of individuals per m2 land area per year m-2 yr-1 T +FATES_NPLANT_PF fates_levpft total PFT-level number of individuals per m2 land area m-2 T +FATES_NPLANT_SEC_PF fates_levpft total PFT-level number of individuals per m2 land area, secondary patches m-2 T +FATES_NPP_PF fates_levpft total PFT-level NPP in kg carbon per m2 land area per second kg m-2 s-1 T +FATES_NPP_SE_PF fates_levpft total PFT-level NPP in kg carbon per m2 land area per second, secondary patches kg m-2 yr-1 T +FATES_RECRUITMENT_PF fates_levpft PFT-level recruitment rate in number of individuals per m2 land area per year m-2 yr-1 T +FATES_STOREC_PF fates_levpft total PFT-level stored biomass in kg carbon per m2 land area kg m-2 T +FATES_VEGC_PF fates_levpft total PFT-level biomass in kg of carbon per land area kg m-2 T +FATES_VEGC_SE_PF fates_levpft total PFT-level biomass in kg of carbon per land area, secondary patches kg m-2 T +FATES_DDBH_CANOPY_SZAP fates_levscag growth rate of canopy plants in meters DBH per m2 per year in canopy in each size x age class m m-2 yr-1 F +FATES_DDBH_USTORY_SZAP fates_levscag growth rate of understory plants in meters DBH per m2 per year in each size x age class m m-2 yr-1 F +FATES_MORTALITY_CANOPY_SZAP fates_levscag mortality rate of canopy plants in number of plants per m2 per year in each size x age class m-2 yr-1 F +FATES_MORTALITY_USTORY_SZAP fates_levscag mortality rate of understory plants in number of plants per m2 per year in each size x age cla m-2 yr-1 F +FATES_NPLANT_CANOPY_SZAP fates_levscag number of plants per m2 in canopy in each size x age class m-2 F +FATES_NPLANT_SZAP fates_levscag number of plants per m2 in each size x age class m-2 F +FATES_NPLANT_USTORY_SZAP fates_levscag number of plants per m2 in understory in each size x age class m-2 F +FATES_NPLANT_SZAPPF fates_levscagpf number of plants per m2 in each size x age x pft class m-2 F +FATES_BASALAREA_SZ fates_levscls basal area by size class m2 m-2 T +FATES_CROOTMAINTAR_CANOPY_SZ fates_levscls live coarse root maintenance autotrophic respiration for canopy plants in kg carbon per m2 per kg m-2 s-1 F +FATES_CROOTMAINTAR_USTORY_SZ fates_levscls live coarse root maintenance autotrophic respiration for understory plants in kg carbon per m2 kg m-2 s-1 F +FATES_CROWNAREA_CANOPY_SZ fates_levscls total crown area of canopy plants by size class m2 m-2 F +FATES_CROWNAREA_USTORY_SZ fates_levscls total crown area of understory plants by size class m2 m-2 F +FATES_DDBH_CANOPY_SZ fates_levscls diameter growth increment by size of canopy plants m m-2 yr-1 T +FATES_DDBH_USTORY_SZ fates_levscls diameter growth increment by size of understory plants m m-2 yr-1 T +FATES_DEMOTION_RATE_SZ fates_levscls demotion rate from canopy to understory by size class in number of plants per m2 per year m-2 yr-1 F +FATES_FROOTCTURN_CANOPY_SZ fates_levscls fine root turnover (non-mortal) for canopy plants by size class in kg carbon per m2 per second kg m-2 s-1 F +FATES_FROOTCTURN_USTORY_SZ fates_levscls fine root turnover (non-mortal) for understory plants by size class in kg carbon per m2 per se kg m-2 s-1 F +FATES_FROOTMAINTAR_CANOPY_SZ fates_levscls live coarse root maintenance autotrophic respiration for canopy plants in kg carbon per m2 per kg m-2 s-1 F +FATES_FROOTMAINTAR_USTORY_SZ fates_levscls fine root maintenance autotrophic respiration for understory plants in kg carbon per m2 per se kg m-2 s-1 F +FATES_FROOT_ALLOC_CANOPY_SZ fates_levscls allocation to fine root C for canopy plants by size class in kg carbon per m2 per second kg m-2 s-1 F +FATES_FROOT_ALLOC_USTORY_SZ fates_levscls allocation to fine roots for understory plants by size class in kg carbon per m2 per second kg m-2 s-1 F +FATES_GROWAR_CANOPY_SZ fates_levscls growth autotrophic respiration of canopy plants in kg carbon per m2 per second by size kg m-2 s-1 F +FATES_GROWAR_USTORY_SZ fates_levscls growth autotrophic respiration of understory plants in kg carbon per m2 per second by size kg m-2 s-1 F +FATES_LAI_CANOPY_SZ fates_levscls leaf area index (LAI) of canopy plants by size class m2 m-2 T +FATES_LAI_USTORY_SZ fates_levscls leaf area index (LAI) of understory plants by size class m2 m-2 T +FATES_LEAFCTURN_CANOPY_SZ fates_levscls leaf turnover (non-mortal) for canopy plants by size class in kg carbon per m2 per second kg m-2 s-1 F +FATES_LEAFCTURN_USTORY_SZ fates_levscls leaf turnover (non-mortal) for understory plants by size class in kg carbon per m2 per second kg m-2 s-1 F +FATES_LEAF_ALLOC_CANOPY_SZ fates_levscls allocation to leaves for canopy plants by size class in kg carbon per m2 per second kg m-2 s-1 F +FATES_LEAF_ALLOC_USTORY_SZ fates_levscls allocation to leaves for understory plants by size class in kg carbon per m2 per second kg m-2 s-1 F +FATES_LSTEMMAINTAR_CANOPY_SZ fates_levscls live stem maintenance autotrophic respiration for canopy plants in kg carbon per m2 per second kg m-2 s-1 F +FATES_LSTEMMAINTAR_USTORY_SZ fates_levscls live stem maintenance autotrophic respiration for understory plants in kg carbon per m2 per se kg m-2 s-1 F +FATES_M3_MORTALITY_CANOPY_SZ fates_levscls C starvation mortality of canopy plants by size N/ha/yr F +FATES_M3_MORTALITY_USTORY_SZ fates_levscls C starvation mortality of understory plants by size N/ha/yr F +FATES_MAINTAR_CANOPY_SZ fates_levscls maintenance autotrophic respiration of canopy plants in kg carbon per m2 per second by size kg m-2 s-1 F +FATES_MAINTAR_USTORY_SZ fates_levscls maintenance autotrophic respiration of understory plants in kg carbon per m2 per second by siz kg m-2 s-1 F +FATES_MORTALITY_AGESCEN_SE_SZ fates_levscls age senescence mortality by size in number of plants per m2 per year, secondary patches m-2 yr-1 T +FATES_MORTALITY_AGESCEN_SZ fates_levscls age senescence mortality by size in number of plants per m2 per year m-2 yr-1 T +FATES_MORTALITY_BACKGROUND_SE_SZ fates_levscls background mortality by size in number of plants per m2 per year, secondary patches m-2 yr-1 T +FATES_MORTALITY_BACKGROUND_SZ fates_levscls background mortality by size in number of plants per m2 per year m-2 yr-1 T +FATES_MORTALITY_CANOPY_SE_SZ fates_levscls total mortality of canopy trees by size class in number of plants per m2, secondary patches m-2 yr-1 T +FATES_MORTALITY_CANOPY_SZ fates_levscls total mortality of canopy trees by size class in number of plants per m2 m-2 yr-1 T +FATES_MORTALITY_CSTARV_SE_SZ fates_levscls carbon starvation mortality by size in number of plants per m2 per year, secondary patches m-2 yr-1 T +FATES_MORTALITY_CSTARV_SZ fates_levscls carbon starvation mortality by size in number of plants per m2 per year m-2 yr-1 T +FATES_MORTALITY_FIRE_SZ fates_levscls fire mortality by size in number of plants per m2 per year m-2 yr-1 T +FATES_MORTALITY_FREEZING_SE_SZ fates_levscls freezing mortality by size in number of plants per m2 per event, secondary patches m-2 event-1 T +FATES_MORTALITY_FREEZING_SZ fates_levscls freezing mortality by size in number of plants per m2 per year m-2 yr-1 T +FATES_MORTALITY_HYDRAULIC_SE_SZ fates_levscls hydraulic mortality by size in number of plants per m2 per year, secondary patches m-2 yr-1 T +FATES_MORTALITY_HYDRAULIC_SZ fates_levscls hydraulic mortality by size in number of plants per m2 per year m-2 yr-1 T +FATES_MORTALITY_IMPACT_SZ fates_levscls impact mortality by size in number of plants per m2 per year m-2 yr-1 T +FATES_MORTALITY_LOGGING_SE_SZ fates_levscls logging mortality by size in number of plants per m2 per event, secondary patches m-2 yr-1 T +FATES_MORTALITY_LOGGING_SZ fates_levscls logging mortality by size in number of plants per m2 per year m-2 yr-1 T +FATES_MORTALITY_SENESCENCE_SE_SZ fates_levscls senescence mortality by size in number of plants per m2 per event, secondary patches m-2 yr-1 T +FATES_MORTALITY_SENESCENCE_SZ fates_levscls senescence mortality by size in number of plants per m2 per year m-2 yr-1 T +FATES_MORTALITY_TERMINATION_SZ fates_levscls termination mortality by size in number of plants per m2 per year m-2 yr-1 T +FATES_MORTALITY_USTORY_SZ fates_levscls total mortality of understory trees by size class in individuals per m2 per year m-2 yr-1 T +FATES_NPLANT_CANOPY_SZ fates_levscls number of canopy plants per m2 by size class m-2 T +FATES_NPLANT_SZ fates_levscls number of plants per m2 by size class m-2 T +FATES_NPLANT_USTORY_SZ fates_levscls number of understory plants per m2 by size class m-2 T +FATES_NPP_CANOPY_SZ fates_levscls NPP of canopy plants by size class in kg carbon per m2 per second kg m-2 s-1 F +FATES_NPP_USTORY_SZ fates_levscls NPP of understory plants by size class in kg carbon per m2 per second kg m-2 s-1 F +FATES_PROMOTION_RATE_SZ fates_levscls promotion rate from understory to canopy by size class m-2 yr-1 F +FATES_RDARK_CANOPY_SZ fates_levscls dark respiration for canopy plants in kg carbon per m2 per second by size kg m-2 s-1 F +FATES_RDARK_USTORY_SZ fates_levscls dark respiration for understory plants in kg carbon per m2 per second by size kg m-2 s-1 F +FATES_SAI_CANOPY_SZ fates_levscls stem area index (SAI) of canopy plants by size class m2 m-2 F +FATES_SAI_USTORY_SZ fates_levscls stem area index (SAI) of understory plants by size class m2 m-2 F +FATES_SAPWOODCTURN_CANOPY_SZ fates_levscls sapwood turnover (non-mortal) for canopy plants by size class in kg carbon per m2 per second kg m-2 s-1 F +FATES_SAPWOODCTURN_USTORY_SZ fates_levscls sapwood C turnover (non-mortal) for understory plants by size class in kg carbon per m2 per se kg m-2 s-1 F +FATES_SAPWOOD_ALLOC_CANOPY_SZ fates_levscls allocation to sapwood C for canopy plants by size class in kg carbon per m2 per second kg m-2 s-1 F +FATES_SAPWOOD_ALLOC_USTORY_SZ fates_levscls allocation to sapwood C for understory plants by size class in kg carbon per m2 per second kg m-2 s-1 F +FATES_SEED_ALLOC_CANOPY_SZ fates_levscls allocation to reproductive C for canopy plants by size class in kg carbon per m2 per second kg m-2 s-1 F +FATES_SEED_ALLOC_USTORY_SZ fates_levscls allocation to reproductive C for understory plants by size class in kg carbon per m2 per secon kg m-2 s-1 F +FATES_SEED_PROD_CANOPY_SZ fates_levscls seed production of canopy plants by size class in kg carbon per m2 per second kg m-2 s-1 F +FATES_SEED_PROD_USTORY_SZ fates_levscls seed production of understory plants by size class in kg carbon per m2 per second kg m-2 s-1 F +FATES_STORECTURN_CANOPY_SZ fates_levscls storage turnover (non-mortal) for canopy plants by size class in kg carbon per m2 per second kg m-2 s-1 F +FATES_STORECTURN_USTORY_SZ fates_levscls storage C turnover (non-mortal) for understory plants by size class in kg carbon per m2 per se kg m-2 s-1 F +FATES_STORE_ALLOC_CANOPY_SZ fates_levscls allocation to storage C for canopy plants by size class in kg carbon per m2 per second kg m-2 s-1 F +FATES_STORE_ALLOC_USTORY_SZ fates_levscls allocation to storage C for understory plants by size class in kg carbon per m2 per second kg m-2 s-1 F +FATES_STRUCTCTURN_CANOPY_SZ fates_levscls structural C turnover (non-mortal) for canopy plants by size class in kg carbon per m2 per sec kg m-2 s-1 F +FATES_STRUCTCTURN_USTORY_SZ fates_levscls structural C turnover (non-mortal) for understory plants by size class in kg carbon per m2 per kg m-2 s-1 F +FATES_STRUCT_ALLOC_CANOPY_SZ fates_levscls allocation to structural C for canopy plants by size class in kg carbon per m2 per second kg m-2 s-1 F +FATES_STRUCT_ALLOC_USTORY_SZ fates_levscls allocation to structural C for understory plants by size class in kg carbon per m2 per second kg m-2 s-1 F +FATES_TRIMMING_CANOPY_SZ fates_levscls trimming term of canopy plants weighted by plant density, by size class m-2 F +FATES_TRIMMING_USTORY_SZ fates_levscls trimming term of understory plants weighted by plant density, by size class m-2 F +FATES_VEGC_ABOVEGROUND_SZ fates_levscls aboveground biomass by size class in kg carbon per m2 kg m-2 T +FATES_VEGC_SZ fates_levscls total biomass by size class in kg carbon per m2 kg m-2 F +FATES_YESTCANLEV_CANOPY_SZ fates_levscls yesterdays canopy level for canopy plants by size class in number of plants per m2 m-2 F +FATES_YESTCANLEV_USTORY_SZ fates_levscls yesterdays canopy level for understory plants by size class in number of plants per m2 m-2 F +FATES_ABOVEGROUND_MORT_SZPF fates_levscpf Aboveground flux of carbon from AGB to necromass due to mortality kg m-2 s-1 F +FATES_ABOVEGROUND_PROD_SZPF fates_levscpf Aboveground carbon productivity kg m-2 s-1 F +FATES_AGSAPMAINTAR_SZPF fates_levscpf above-ground sapwood maintenance autotrophic respiration in kg carbon per m2 per second by pft kg m-2 s-1 F +FATES_AGSAPWOOD_ALLOC_SZPF fates_levscpf allocation to above-ground sapwood by pft/size in kg carbon per m2 per second kg m-2 s-1 F +FATES_AGSTRUCT_ALLOC_SZPF fates_levscpf allocation to above-ground structural (deadwood) by pft/size in kg carbon per m2 per second kg m-2 s-1 F +FATES_AUTORESP_CANOPY_SZPF fates_levscpf autotrophic respiration of canopy plants by pft/size in kg carbon per m2 per second kg m-2 s-1 F +FATES_AUTORESP_SZPF fates_levscpf total autotrophic respiration in kg carbon per m2 per second by pft/size kg m-2 s-1 F +FATES_AUTORESP_USTORY_SZPF fates_levscpf autotrophic respiration of understory plants by pft/size in kg carbon per m2 per second kg m-2 s-1 F +FATES_BASALAREA_SZPF fates_levscpf basal area by pft/size m2 m-2 F +FATES_BGSAPMAINTAR_SZPF fates_levscpf below-ground sapwood maintenance autotrophic respiration in kg carbon per m2 per second by pft kg m-2 s-1 F +FATES_BGSAPWOOD_ALLOC_SZPF fates_levscpf allocation to below-ground sapwood by pft/size in kg carbon per m2 per second kg m-2 s-1 F +FATES_BGSTRUCT_ALLOC_SZPF fates_levscpf allocation to below-ground structural (deadwood) by pft/size in kg carbon per m2 per second kg m-2 s-1 F +FATES_C13DISC_SZPF fates_levscpf C13 discrimination by pft/size per mil F +FATES_DDBH_CANOPY_SZPF fates_levscpf diameter growth increment by pft/size m m-2 yr-1 F +FATES_DDBH_SZPF fates_levscpf diameter growth increment by pft/size m m-2 yr-1 F +FATES_DDBH_USTORY_SZPF fates_levscpf diameter growth increment by pft/size m m-2 yr-1 F +FATES_FROOTC_SZPF fates_levscpf fine-root carbon mass by size-class x pft in kg carbon per m2 kg m-2 F +FATES_FROOTMAINTAR_SZPF fates_levscpf fine root maintenance autotrophic respiration in kg carbon per m2 per second by pft/size kg m-2 s-1 F +FATES_FROOT_ALLOC_SZPF fates_levscpf allocation to fine roots by pft/size in kg carbon per m2 per second kg m-2 s-1 F +FATES_GPP_CANOPY_SZPF fates_levscpf gross primary production of canopy plants by pft/size in kg carbon per m2 per second kg m-2 s-1 F +FATES_GPP_SZPF fates_levscpf gross primary production by pft/size in kg carbon per m2 per second kg m-2 s-1 F +FATES_GPP_USTORY_SZPF fates_levscpf gross primary production of understory plants by pft/size in kg carbon per m2 per second kg m-2 s-1 F +FATES_GROWAR_SZPF fates_levscpf growth autotrophic respiration in kg carbon per m2 per second by pft/size kg m-2 s-1 F +FATES_GROWTHFLUX_FUSION_SZPF fates_levscpf flux of individuals into a given size class bin via fusion m-2 yr-1 F +FATES_GROWTHFLUX_SZPF fates_levscpf flux of individuals into a given size class bin via growth and recruitment m-2 yr-1 F +FATES_LAI_CANOPY_SZPF fates_levscpf Leaf area index (LAI) of canopy plants by pft/size m2 m-2 F +FATES_LAI_USTORY_SZPF fates_levscpf Leaf area index (LAI) of understory plants by pft/size m2 m-2 F +FATES_LEAFC_CANOPY_SZPF fates_levscpf biomass in leaves of canopy plants by pft/size in kg carbon per m2 kg m-2 F +FATES_LEAFC_SZPF fates_levscpf leaf carbon mass by size-class x pft in kg carbon per m2 kg m-2 F +FATES_LEAFC_USTORY_SZPF fates_levscpf biomass in leaves of understory plants by pft/size in kg carbon per m2 kg m-2 F +FATES_LEAF_ALLOC_SZPF fates_levscpf allocation to leaves by pft/size in kg carbon per m2 per second kg m-2 s-1 F +FATES_M3_MORTALITY_CANOPY_SZPF fates_levscpf C starvation mortality of canopy plants by pft/size N/ha/yr F +FATES_M3_MORTALITY_USTORY_SZPF fates_levscpf C starvation mortality of understory plants by pft/size N/ha/yr F +FATES_MAINTAR_SZPF fates_levscpf maintenance autotrophic respiration in kg carbon per m2 per second by pft/size kg m-2 s-1 F +FATES_MORTALITY_AGESCEN_SZPF fates_levscpf age senescence mortality by pft/size in number of plants per m2 per year m-2 yr-1 F +FATES_MORTALITY_BACKGROUND_SZPF fates_levscpf background mortality by pft/size in number of plants per m2 per year m-2 yr-1 F +FATES_MORTALITY_CAMBIALBURN_SZPF fates_levscpf fire mortality from cambial burn by pft/size in number of plants per m2 per year m-2 yr-1 F +FATES_MORTALITY_CANOPY_SZPF fates_levscpf total mortality of canopy plants by pft/size in number of plants per m2 per year m-2 yr-1 F +FATES_MORTALITY_CROWNSCORCH_SZPF fates_levscpf fire mortality from crown scorch by pft/size in number of plants per m2 per year m-2 yr-1 F +FATES_MORTALITY_CSTARV_SZPF fates_levscpf carbon starvation mortality by pft/size in number of plants per m2 per year m-2 yr-1 F +FATES_MORTALITY_FIRE_SZPF fates_levscpf fire mortality by pft/size in number of plants per m2 per year m-2 yr-1 F +FATES_MORTALITY_FREEZING_SZPF fates_levscpf freezing mortality by pft/size in number of plants per m2 per year m-2 yr-1 F +FATES_MORTALITY_HYDRAULIC_SZPF fates_levscpf hydraulic mortality by pft/size in number of plants per m2 per year m-2 yr-1 F +FATES_MORTALITY_IMPACT_SZPF fates_levscpf impact mortality by pft/size in number of plants per m2 per year m-2 yr-1 F +FATES_MORTALITY_LOGGING_SZPF fates_levscpf logging mortality by pft/size in number of plants per m2 per year m-2 yr-1 F +FATES_MORTALITY_SENESCENCE_SZPF fates_levscpf senescence mortality by pft/size in number of plants per m2 per year m-2 yr-1 F +FATES_MORTALITY_TERMINATION_SZPF fates_levscpf termination mortality by pft/size in number pf plants per m2 per year m-2 yr-1 F +FATES_MORTALITY_USTORY_SZPF fates_levscpf total mortality of understory plants by pft/size in number of plants per m2 per year m-2 yr-1 F +FATES_NPLANT_CANOPY_SZPF fates_levscpf number of canopy plants by size/pft per m2 m-2 F +FATES_NPLANT_SZPF fates_levscpf stem number density by pft/size m-2 F +FATES_NPLANT_USTORY_SZPF fates_levscpf density of understory plants by pft/size in number of plants per m2 m-2 F +FATES_NPP_SZPF fates_levscpf total net primary production by pft/size in kg carbon per m2 per second kg m-2 s-1 F +FATES_RDARK_SZPF fates_levscpf dark portion of maintenance autotrophic respiration in kg carbon per m2 per second by pft/size kg m-2 s-1 F +FATES_REPROC_SZPF fates_levscpf reproductive carbon mass (on plant) by size-class x pft in kg carbon per m2 kg m-2 F +FATES_SAPWOODC_SZPF fates_levscpf sapwood carbon mass by size-class x pft in kg carbon per m2 kg m-2 F +FATES_SEED_ALLOC_SZPF fates_levscpf allocation to seeds by pft/size in kg carbon per m2 per second kg m-2 s-1 F +FATES_STOREC_CANOPY_SZPF fates_levscpf biomass in storage pools of canopy plants by pft/size in kg carbon per m2 kg m-2 F +FATES_STOREC_SZPF fates_levscpf storage carbon mass by size-class x pft in kg carbon per m2 kg m-2 F +FATES_STOREC_TF_CANOPY_SZPF fates_levscpf Storage C fraction of target by size x pft, in the canopy kg kg-1 F +FATES_STOREC_TF_USTORY_SZPF fates_levscpf Storage C fraction of target by size x pft, in the understory kg kg-1 F +FATES_STOREC_USTORY_SZPF fates_levscpf biomass in storage pools of understory plants by pft/size in kg carbon per m2 kg m-2 F +FATES_STORE_ALLOC_SZPF fates_levscpf allocation to storage C by pft/size in kg carbon per m2 per second kg m-2 s-1 F +FATES_VEGC_ABOVEGROUND_SZPF fates_levscpf aboveground biomass by pft/size in kg carbon per m2 kg m-2 F +FATES_VEGC_SZPF fates_levscpf total vegetation biomass in live plants by size-class x pft in kg carbon per m2 kg m-2 F +ACTUAL_IMMOB_NH4 levdcmp immobilization of NH4 gN/m^3/s F +ACTUAL_IMMOB_NO3 levdcmp immobilization of NO3 gN/m^3/s F +ACTUAL_IMMOB_vr levdcmp actual N immobilization gN/m^3/s F +FMAX_DENIT_CARBONSUBSTRATE levdcmp FMAX_DENIT_CARBONSUBSTRATE gN/m^3/s F +FMAX_DENIT_NITRATE levdcmp FMAX_DENIT_NITRATE gN/m^3/s F +FPI_vr levdcmp fraction of potential immobilization proportion F +F_DENIT_BASE levdcmp F_DENIT_BASE gN/m^3/s F +F_DENIT_vr levdcmp denitrification flux gN/m^3/s F +F_NIT_vr levdcmp nitrification flux gN/m^3/s F +GROSS_NMIN_vr levdcmp gross rate of N mineralization gN/m^3/s F +K_LIT_CEL levdcmp cellulosic litter potential loss coefficient 1/s F +K_LIT_LIG levdcmp lignin litter potential loss coefficient 1/s F +K_LIT_MET levdcmp metabolic litter potential loss coefficient 1/s F +K_NITR levdcmp K_NITR 1/s F +K_NITR_H2O levdcmp K_NITR_H2O unitless F +K_NITR_PH levdcmp K_NITR_PH unitless F +K_NITR_T levdcmp K_NITR_T unitless F +K_SOM_ACT levdcmp active soil organic potential loss coefficient 1/s F +K_SOM_PAS levdcmp passive soil organic potential loss coefficient 1/s F +K_SOM_SLO levdcmp slow soil organic ma potential loss coefficient 1/s F +L1_PATHFRAC_S1_vr levdcmp PATHFRAC from metabolic litter to active soil organic fraction F +L1_RESP_FRAC_S1_vr levdcmp respired from metabolic litter to active soil organic fraction F +L2_PATHFRAC_S1_vr levdcmp PATHFRAC from cellulosic litter to active soil organic fraction F +L2_RESP_FRAC_S1_vr levdcmp respired from cellulosic litter to active soil organic fraction F +L3_PATHFRAC_S2_vr levdcmp PATHFRAC from lignin litter to slow soil organic ma fraction F +L3_RESP_FRAC_S2_vr levdcmp respired from lignin litter to slow soil organic ma fraction F +LIT_CEL_C_TNDNCY_VERT_TR levdcmp cellulosic litter C tendency due to vertical transport gC/m^3/s F +LIT_CEL_C_TO_SOM_ACT_C_v levdcmp decomp. of cellulosic litter C to active soil organic C gC/m^3/s F +LIT_CEL_HR_vr levdcmp Het. Resp. from cellulosic litter gC/m^3/s F +LIT_CEL_N_TNDNCY_VERT_TR levdcmp cellulosic litter N tendency due to vertical transport gN/m^3/s F +LIT_CEL_N_TO_SOM_ACT_N_v levdcmp decomp. of cellulosic litter N to active soil organic N gN/m^3 F +LIT_CEL_N_vr levdcmp LIT_CEL N (vertically resolved) gN/m^3 T +LIT_LIG_C_TNDNCY_VERT_TR levdcmp lignin litter C tendency due to vertical transport gC/m^3/s F +LIT_LIG_C_TO_SOM_SLO_C_v levdcmp decomp. of lignin litter C to slow soil organic ma C gC/m^3/s F +LIT_LIG_HR_vr levdcmp Het. Resp. from lignin litter gC/m^3/s F +LIT_LIG_N_TNDNCY_VERT_TR levdcmp lignin litter N tendency due to vertical transport gN/m^3/s F +LIT_LIG_N_TO_SOM_SLO_N_v levdcmp decomp. of lignin litter N to slow soil organic ma N gN/m^3 F +LIT_LIG_N_vr levdcmp LIT_LIG N (vertically resolved) gN/m^3 T +LIT_MET_C_TNDNCY_VERT_TR levdcmp metabolic litter C tendency due to vertical transport gC/m^3/s F +LIT_MET_C_TO_SOM_ACT_C_v levdcmp decomp. of metabolic litter C to active soil organic C gC/m^3/s F +LIT_MET_HR_vr levdcmp Het. Resp. from metabolic litter gC/m^3/s F +LIT_MET_N_TNDNCY_VERT_TR levdcmp metabolic litter N tendency due to vertical transport gN/m^3/s F +LIT_MET_N_TO_SOM_ACT_N_v levdcmp decomp. of metabolic litter N to active soil organic N gN/m^3 F +LIT_MET_N_vr levdcmp LIT_MET N (vertically resolved) gN/m^3 T +NDEP_PROF levdcmp profile for atmospheric N deposition 1/m F +NET_NMIN_vr levdcmp net rate of N mineralization gN/m^3/s F +NFIXATION_PROF levdcmp profile for biological N fixation 1/m F +POTENTIAL_IMMOB_vr levdcmp potential N immobilization gN/m^3/s F +POT_F_DENIT_vr levdcmp potential denitrification flux gN/m^3/s F +POT_F_NIT_vr levdcmp potential nitrification flux gN/m^3/s F +S1_PATHFRAC_S2_vr levdcmp PATHFRAC from active soil organic to slow soil organic ma fraction F +S1_PATHFRAC_S3_vr levdcmp PATHFRAC from active soil organic to passive soil organic fraction F +S1_RESP_FRAC_S2_vr levdcmp respired from active soil organic to slow soil organic ma fraction F +S1_RESP_FRAC_S3_vr levdcmp respired from active soil organic to passive soil organic fraction F +S2_PATHFRAC_S1_vr levdcmp PATHFRAC from slow soil organic ma to active soil organic fraction F +S2_PATHFRAC_S3_vr levdcmp PATHFRAC from slow soil organic ma to passive soil organic fraction F +S2_RESP_FRAC_S1_vr levdcmp respired from slow soil organic ma to active soil organic fraction F +S2_RESP_FRAC_S3_vr levdcmp respired from slow soil organic ma to passive soil organic fraction F +S3_PATHFRAC_S1_vr levdcmp PATHFRAC from passive soil organic to active soil organic fraction F +S3_RESP_FRAC_S1_vr levdcmp respired from passive soil organic to active soil organic fraction F +SMINN_TO_PLANT_vr levdcmp plant uptake of soil mineral N gN/m^3/s F +SMINN_TO_S1N_L1_vr levdcmp mineral N flux for decomp. of LIT_METto SOM_ACT gN/m^3 F +SMINN_TO_S1N_L2_vr levdcmp mineral N flux for decomp. of LIT_CELto SOM_ACT gN/m^3 F +SMINN_TO_S1N_S2_vr levdcmp mineral N flux for decomp. of SOM_SLOto SOM_ACT gN/m^3 F +SMINN_TO_S1N_S3_vr levdcmp mineral N flux for decomp. of SOM_PASto SOM_ACT gN/m^3 F +SMINN_TO_S2N_L3_vr levdcmp mineral N flux for decomp. of LIT_LIGto SOM_SLO gN/m^3 F +SMINN_TO_S2N_S1_vr levdcmp mineral N flux for decomp. of SOM_ACTto SOM_SLO gN/m^3 F +SMINN_TO_S3N_S1_vr levdcmp mineral N flux for decomp. of SOM_ACTto SOM_PAS gN/m^3 F +SMINN_TO_S3N_S2_vr levdcmp mineral N flux for decomp. of SOM_SLOto SOM_PAS gN/m^3 F +SMIN_NH4_TO_PLANT levdcmp plant uptake of NH4 gN/m^3/s F +SMIN_NO3_LEACHED_vr levdcmp soil NO3 pool loss to leaching gN/m^3/s F +SMIN_NO3_MASSDENS levdcmp SMIN_NO3_MASSDENS ugN/cm^3 soil F +SMIN_NO3_RUNOFF_vr levdcmp soil NO3 pool loss to runoff gN/m^3/s F +SMIN_NO3_TO_PLANT levdcmp plant uptake of NO3 gN/m^3/s F +SOILN_vr levdcmp SOIL N (vertically resolved) gN/m^3 T +SOM_ACT_C_TNDNCY_VERT_TR levdcmp active soil organic C tendency due to vertical transport gC/m^3/s F +SOM_ACT_C_TO_SOM_PAS_C_v levdcmp decomp. of active soil organic C to passive soil organic C gC/m^3/s F +SOM_ACT_C_TO_SOM_SLO_C_v levdcmp decomp. of active soil organic C to slow soil organic ma C gC/m^3/s F +SOM_ACT_HR_S2_vr levdcmp Het. Resp. from active soil organic gC/m^3/s F +SOM_ACT_HR_S3_vr levdcmp Het. Resp. from active soil organic gC/m^3/s F +SOM_ACT_N_TNDNCY_VERT_TR levdcmp active soil organic N tendency due to vertical transport gN/m^3/s F +SOM_ACT_N_TO_SOM_PAS_N_v levdcmp decomp. of active soil organic N to passive soil organic N gN/m^3 F +SOM_ACT_N_TO_SOM_SLO_N_v levdcmp decomp. of active soil organic N to slow soil organic ma N gN/m^3 F +SOM_ACT_N_vr levdcmp SOM_ACT N (vertically resolved) gN/m^3 T +SOM_ADV_COEF levdcmp advection term for vertical SOM translocation m/s F +SOM_DIFFUS_COEF levdcmp diffusion coefficient for vertical SOM translocation m^2/s F +SOM_PAS_C_TNDNCY_VERT_TR levdcmp passive soil organic C tendency due to vertical transport gC/m^3/s F +SOM_PAS_C_TO_SOM_ACT_C_v levdcmp decomp. of passive soil organic C to active soil organic C gC/m^3/s F +SOM_PAS_HR_vr levdcmp Het. Resp. from passive soil organic gC/m^3/s F +SOM_PAS_N_TNDNCY_VERT_TR levdcmp passive soil organic N tendency due to vertical transport gN/m^3/s F +SOM_PAS_N_TO_SOM_ACT_N_v levdcmp decomp. of passive soil organic N to active soil organic N gN/m^3 F +SOM_PAS_N_vr levdcmp SOM_PAS N (vertically resolved) gN/m^3 T +SOM_SLO_C_TNDNCY_VERT_TR levdcmp slow soil organic ma C tendency due to vertical transport gC/m^3/s F +SOM_SLO_C_TO_SOM_ACT_C_v levdcmp decomp. of slow soil organic ma C to active soil organic C gC/m^3/s F +SOM_SLO_C_TO_SOM_PAS_C_v levdcmp decomp. of slow soil organic ma C to passive soil organic C gC/m^3/s F +SOM_SLO_HR_S1_vr levdcmp Het. Resp. from slow soil organic ma gC/m^3/s F +SOM_SLO_HR_S3_vr levdcmp Het. Resp. from slow soil organic ma gC/m^3/s F +SOM_SLO_N_TNDNCY_VERT_TR levdcmp slow soil organic ma N tendency due to vertical transport gN/m^3/s F +SOM_SLO_N_TO_SOM_ACT_N_v levdcmp decomp. of slow soil organic ma N to active soil organic N gN/m^3 F +SOM_SLO_N_TO_SOM_PAS_N_v levdcmp decomp. of slow soil organic ma N to passive soil organic N gN/m^3 F +SOM_SLO_N_vr levdcmp SOM_SLO N (vertically resolved) gN/m^3 T +SUPPLEMENT_TO_SMINN_vr levdcmp supplemental N supply gN/m^3/s F +WFPS levdcmp WFPS percent F anaerobic_frac levdcmp anaerobic_frac m3/m3 F diffus levdcmp diffusivity m^2/s F fr_WFPS levdcmp fr_WFPS fraction F n2_n2o_ratio_denit levdcmp n2_n2o_ratio_denit gN/gN F -num_iter - number of iterations unitless F r_psi levdcmp r_psi m F ratio_k1 levdcmp ratio_k1 none F ratio_no3_co2 levdcmp ratio_no3_co2 ratio F soil_bulkdensity levdcmp soil_bulkdensity kg/m3 F soil_co2_prod levdcmp soil_co2_prod ug C / g soil / day F +CONC_CH4_SAT levgrnd CH4 soil Concentration for inundated / lake area mol/m3 F +CONC_CH4_UNSAT levgrnd CH4 soil Concentration for non-inundated area mol/m3 F +FGR_SOIL_R levgrnd Rural downward heat flux at interface below each soil layer watt/m^2 F +HK levgrnd hydraulic conductivity (natural vegetated and crop landunits only) mm/s F +O2_DECOMP_DEPTH_UNSAT levgrnd O2 consumption from HR and AR for non-inundated area mol/m3/s F +SMP levgrnd soil matric potential (natural vegetated and crop landunits only) mm T +SOILPSI levgrnd soil water potential in each soil layer MPa F +TSOI levgrnd soil temperature (natural vegetated and crop landunits only) K T +TSOI_ICE levgrnd soil temperature (ice landunits only) K T +LAKEICEFRAC levlak lake layer ice mass fraction unitless F +TLAKE levlak lake temperature K T +SNO_ABS levsno Absorbed solar radiation in each snow layer W/m^2 F +SNO_ABS_ICE levsno Absorbed solar radiation in each snow layer (ice landunits only) W/m^2 F +SNO_BW levsno Partial density of water in the snow pack (ice + liquid) kg/m3 F +SNO_BW_ICE levsno Partial density of water in the snow pack (ice + liquid, ice landunits only) kg/m3 F +SNO_EXISTENCE levsno Fraction of averaging period for which each snow layer existed unitless F +SNO_FRZ levsno snow freezing rate in each snow layer kg/m2/s F +SNO_FRZ_ICE levsno snow freezing rate in each snow layer (ice landunits only) mm/s F +SNO_GS levsno Mean snow grain size Microns F +SNO_GS_ICE levsno Mean snow grain size (ice landunits only) Microns F +SNO_ICE levsno Snow ice content kg/m2 F +SNO_LIQH2O levsno Snow liquid water content kg/m2 F +SNO_MELT levsno snow melt rate in each snow layer mm/s F +SNO_MELT_ICE levsno snow melt rate in each snow layer (ice landunits only) mm/s F +SNO_T levsno Snow temperatures K F +SNO_TK levsno Thermal conductivity W/m-K F +SNO_TK_ICE levsno Thermal conductivity (ice landunits only) W/m-K F +SNO_T_ICE levsno Snow temperatures (ice landunits only) K F +SNO_Z levsno Snow layer thicknesses m F +SNO_Z_ICE levsno Snow layer thicknesses (ice landunits only) m F +CONC_O2_SAT levsoi O2 soil Concentration for inundated / lake area mol/m3 T +CONC_O2_UNSAT levsoi O2 soil Concentration for non-inundated area mol/m3 T +FATES_FRAGMENTATION_SCALER_SL levsoi factor (0-1) by which litter/cwd fragmentation proceeds relative to max rate by soil layer T +FATES_FROOTC_SL levsoi Total carbon in live plant fine-roots over depth kg m-3 T +H2OSOI levsoi volumetric soil water (natural vegetated and crop landunits only) mm3/mm3 T +HR_vr levsoi total vertically resolved heterotrophic respiration gC/m^3/s T +KROOT levsoi root conductance each soil layer 1/s F +KSOIL levsoi soil conductance in each soil layer 1/s F +LIT_CEL_C_vr levsoi LIT_CEL C (vertically resolved) gC/m^3 T +LIT_LIG_C_vr levsoi LIT_LIG C (vertically resolved) gC/m^3 T +LIT_MET_C_vr levsoi LIT_MET C (vertically resolved) gC/m^3 T +O_SCALAR levsoi fraction by which decomposition is reduced due to anoxia unitless T +QROOTSINK levsoi water flux from soil to root in each soil-layer mm/s F +SMINN_vr levsoi soil mineral N gN/m^3 T +SMIN_NH4_vr levsoi soil mineral NH4 (vert. res.) gN/m^3 T +SMIN_NO3_vr levsoi soil mineral NO3 (vert. res.) gN/m^3 T +SOILC_vr levsoi SOIL C (vertically resolved) gC/m^3 T +SOILICE levsoi soil ice (natural vegetated and crop landunits only) kg/m2 T +SOILLIQ levsoi soil liquid water (natural vegetated and crop landunits only) kg/m2 T +SOM_ACT_C_vr levsoi SOM_ACT C (vertically resolved) gC/m^3 T +SOM_PAS_C_vr levsoi SOM_PAS C (vertically resolved) gC/m^3 T +SOM_SLO_C_vr levsoi SOM_SLO C (vertically resolved) gC/m^3 T +T_SCALAR levsoi temperature inhibition of decomposition unitless T +W_SCALAR levsoi Moisture (dryness) inhibition of decomposition unitless T +ALBD numrad surface albedo (direct) proportion F +ALBGRD numrad ground albedo (direct) proportion F +ALBGRI numrad ground albedo (indirect) proportion F +ALBI numrad surface albedo (indirect) proportion F =================================== ================ ============================================================================================== ================================================================= ======= diff --git a/doc/source/users_guide/setting-up-and-running-a-case/history_fields_nofates.rst b/doc/source/users_guide/setting-up-and-running-a-case/history_fields_nofates.rst index 95f2b976e8..4e96f5fb91 100644 --- a/doc/source/users_guide/setting-up-and-running-a-case/history_fields_nofates.rst +++ b/doc/source/users_guide/setting-up-and-running-a-case/history_fields_nofates.rst @@ -16,36 +16,9 @@ CTSM History Fields A10TMIN - 10-day running mean of min 2-m temperature K F A5TMIN - 5-day running mean of min 2-m temperature K F ACTUAL_IMMOB - actual N immobilization gN/m^2/s T -ACTUAL_IMMOB_NH4 levdcmp immobilization of NH4 gN/m^3/s F -ACTUAL_IMMOB_NO3 levdcmp immobilization of NO3 gN/m^3/s F -ACTUAL_IMMOB_vr levdcmp actual N immobilization gN/m^3/s F -ACT_SOMC - ACT_SOM C gC/m^2 T -ACT_SOMC_1m - ACT_SOM C to 1 meter gC/m^2 F -ACT_SOMC_TNDNCY_VERT_TRA levdcmp active soil organic C tendency due to vertical transport gC/m^3/s F -ACT_SOMC_TO_PAS_SOMC - decomp. of active soil organic C to passive soil organic C gC/m^2/s F -ACT_SOMC_TO_PAS_SOMC_vr levdcmp decomp. of active soil organic C to passive soil organic C gC/m^3/s F -ACT_SOMC_TO_SLO_SOMC - decomp. of active soil organic C to slow soil organic ma C gC/m^2/s F -ACT_SOMC_TO_SLO_SOMC_vr levdcmp decomp. of active soil organic C to slow soil organic ma C gC/m^3/s F -ACT_SOMC_vr levsoi ACT_SOM C (vertically resolved) gC/m^3 T -ACT_SOMN - ACT_SOM N gN/m^2 T -ACT_SOMN_1m - ACT_SOM N to 1 meter gN/m^2 F -ACT_SOMN_TNDNCY_VERT_TRA levdcmp active soil organic N tendency due to vertical transport gN/m^3/s F -ACT_SOMN_TO_PAS_SOMN - decomp. of active soil organic N to passive soil organic N gN/m^2 F -ACT_SOMN_TO_PAS_SOMN_vr levdcmp decomp. of active soil organic N to passive soil organic N gN/m^3 F -ACT_SOMN_TO_SLO_SOMN - decomp. of active soil organic N to slow soil organic ma N gN/m^2 F -ACT_SOMN_TO_SLO_SOMN_vr levdcmp decomp. of active soil organic N to slow soil organic ma N gN/m^3 F -ACT_SOMN_vr levdcmp ACT_SOM N (vertically resolved) gN/m^3 T -ACT_SOM_HR_S2 - Het. Resp. from active soil organic gC/m^2/s F -ACT_SOM_HR_S2_vr levdcmp Het. Resp. from active soil organic gC/m^3/s F -ACT_SOM_HR_S3 - Het. Resp. from active soil organic gC/m^2/s F -ACT_SOM_HR_S3_vr levdcmp Het. Resp. from active soil organic gC/m^3/s F AGLB - Aboveground leaf biomass kg/m^2 F AGNPP - aboveground NPP gC/m^2/s T AGSB - Aboveground stem biomass kg/m^2 F -ALBD numrad surface albedo (direct) proportion F -ALBGRD numrad ground albedo (direct) proportion F -ALBGRI numrad ground albedo (indirect) proportion F -ALBI numrad surface albedo (indirect) proportion F ALPHA - alpha coefficient for VOC calc non F ALT - current active layer thickness m T ALTMAX - maximum annual active layer thickness m T @@ -71,20 +44,6 @@ BGTR - background transfer growth BTRANMN - daily minimum of transpiration beta factor unitless T CANNAVG_T2M - annual average of 2m air temperature K F CANNSUM_NPP - annual sum of column-level NPP gC/m^2/s F -CEL_LITC - CEL_LIT C gC/m^2 T -CEL_LITC_1m - CEL_LIT C to 1 meter gC/m^2 F -CEL_LITC_TNDNCY_VERT_TRA levdcmp cellulosic litter C tendency due to vertical transport gC/m^3/s F -CEL_LITC_TO_ACT_SOMC - decomp. of cellulosic litter C to active soil organic C gC/m^2/s F -CEL_LITC_TO_ACT_SOMC_vr levdcmp decomp. of cellulosic litter C to active soil organic C gC/m^3/s F -CEL_LITC_vr levsoi CEL_LIT C (vertically resolved) gC/m^3 T -CEL_LITN - CEL_LIT N gN/m^2 T -CEL_LITN_1m - CEL_LIT N to 1 meter gN/m^2 F -CEL_LITN_TNDNCY_VERT_TRA levdcmp cellulosic litter N tendency due to vertical transport gN/m^3/s F -CEL_LITN_TO_ACT_SOMN - decomp. of cellulosic litter N to active soil organic N gN/m^2 F -CEL_LITN_TO_ACT_SOMN_vr levdcmp decomp. of cellulosic litter N to active soil organic N gN/m^3 F -CEL_LITN_vr levdcmp CEL_LIT N (vertically resolved) gN/m^3 T -CEL_LIT_HR - Het. Resp. from cellulosic litter gC/m^2/s F -CEL_LIT_HR_vr levdcmp Het. Resp. from cellulosic litter gC/m^3/s F CGRND - deriv. of soil energy flux wrt to soil temp W/m^2/K F CGRNDL - deriv. of soil latent heat flux wrt soil temp W/m^2/K F CGRNDS - deriv. of soil sensible heat flux wrt soil temp W/m^2/K F @@ -101,10 +60,6 @@ COL_CTRUNC - column-level sink for C tru COL_FIRE_CLOSS - total column-level fire C loss for non-peat fires outside land-type converted region gC/m^2/s T COL_FIRE_NLOSS - total column-level fire N loss gN/m^2/s T COL_NTRUNC - column-level sink for N truncation gN/m^2 F -CONC_CH4_SAT levgrnd CH4 soil Concentration for inundated / lake area mol/m3 F -CONC_CH4_UNSAT levgrnd CH4 soil Concentration for non-inundated area mol/m3 F -CONC_O2_SAT levsoi O2 soil Concentration for inundated / lake area mol/m3 T -CONC_O2_UNSAT levsoi O2 soil Concentration for non-inundated area mol/m3 T COST_NACTIVE - Cost of active uptake gN/gC T COST_NFIX - Cost of fixation gN/gC T COST_NRETRANS - Cost of retranslocation gN/gC T @@ -136,7 +91,6 @@ CPOOL_TO_LIVECROOTC - allocation to live coarse r CPOOL_TO_LIVECROOTC_STORAGE - allocation to live coarse root C storage gC/m^2/s F CPOOL_TO_LIVESTEMC - allocation to live stem C gC/m^2/s F CPOOL_TO_LIVESTEMC_STORAGE - allocation to live stem C storage gC/m^2/s F -CROOT_PROF levdcmp profile for litter C and N inputs from coarse roots 1/m F CROPPROD1C - 1-yr crop product (grain+biofuel) C gC/m^2 T CROPPROD1C_LOSS - loss from 1-yr crop product pool gC/m^2/s T CROPPROD1N - 1-yr crop product (grain+biofuel) N gN/m^2 T @@ -146,30 +100,18 @@ CROPSEEDN_DEFICIT - N used for crop seed that n CROP_SEEDC_TO_LEAF - crop seed source to leaf gC/m^2/s F CROP_SEEDN_TO_LEAF - crop seed source to leaf gN/m^2/s F CURRENT_GR - growth resp for new growth displayed in this timestep gC/m^2/s F -CWDC - CWD C gC/m^2 T -CWDC_1m - CWD C to 1 meter gC/m^2 F CWDC_HR - cwd C heterotrophic respiration gC/m^2/s T CWDC_LOSS - coarse woody debris C loss gC/m^2/s T -CWDC_TO_CEL_LITC - decomp. of coarse woody debris C to cellulosic litter C gC/m^2/s F -CWDC_TO_CEL_LITC_vr levdcmp decomp. of coarse woody debris C to cellulosic litter C gC/m^3/s F -CWDC_TO_LIG_LITC - decomp. of coarse woody debris C to lignin litter C gC/m^2/s F -CWDC_TO_LIG_LITC_vr levdcmp decomp. of coarse woody debris C to lignin litter C gC/m^3/s F -CWDC_vr levsoi CWD C (vertically resolved) gC/m^3 T -CWDN - CWD N gN/m^2 T -CWDN_1m - CWD N to 1 meter gN/m^2 F -CWDN_TO_CEL_LITN - decomp. of coarse woody debris N to cellulosic litter N gN/m^2 F -CWDN_TO_CEL_LITN_vr levdcmp decomp. of coarse woody debris N to cellulosic litter N gN/m^3 F -CWDN_TO_LIG_LITN - decomp. of coarse woody debris N to lignin litter N gN/m^2 F -CWDN_TO_LIG_LITN_vr levdcmp decomp. of coarse woody debris N to lignin litter N gN/m^3 F -CWDN_vr levdcmp CWD N (vertically resolved) gN/m^3 T +CWD_C - CWD C gC/m^2 T +CWD_C_1m - CWD C to 1 meter gC/m^2 F +CWD_C_TO_LIT_CEL_C - decomp. of coarse woody debris C to cellulosic litter C gC/m^2/s F +CWD_C_TO_LIT_LIG_C - decomp. of coarse woody debris C to lignin litter C gC/m^2/s F CWD_HR_L2 - Het. Resp. from coarse woody debris gC/m^2/s F -CWD_HR_L2_vr levdcmp Het. Resp. from coarse woody debris gC/m^3/s F CWD_HR_L3 - Het. Resp. from coarse woody debris gC/m^2/s F -CWD_HR_L3_vr levdcmp Het. Resp. from coarse woody debris gC/m^3/s F -CWD_PATHFRAC_L2_vr levdcmp PATHFRAC from coarse woody debris to cellulosic litter fraction F -CWD_PATHFRAC_L3_vr levdcmp PATHFRAC from coarse woody debris to lignin litter fraction F -CWD_RESP_FRAC_L2_vr levdcmp respired from coarse woody debris to cellulosic litter fraction F -CWD_RESP_FRAC_L3_vr levdcmp respired from coarse woody debris to lignin litter fraction F +CWD_N - CWD N gN/m^2 T +CWD_N_1m - CWD N to 1 meter gN/m^2 F +CWD_N_TO_LIT_CEL_N - decomp. of coarse woody debris N to cellulosic litter N gN/m^2 F +CWD_N_TO_LIT_LIG_N - decomp. of coarse woody debris N to lignin litter N gN/m^2 F C_ALLOMETRY - C allocation index none F DAYL - daylength s F DAYS_ACTIVE - number of days since last dormancy days F @@ -216,16 +158,6 @@ DWT_CONV_NFLUX - conversion N flux (immediat DWT_CONV_NFLUX_PATCH - patch-level conversion N flux (immediate loss to atm) (0 at all times except first timestep of gN/m^2/s F DWT_CROPPROD1C_GAIN - landcover change-driven addition to 1-year crop product pool gC/m^2/s T DWT_CROPPROD1N_GAIN - landcover change-driven addition to 1-year crop product pool gN/m^2/s T -DWT_DEADCROOTC_TO_CWDC levdcmp dead coarse root to CWD due to landcover change gC/m^2/s F -DWT_DEADCROOTN_TO_CWDN levdcmp dead coarse root to CWD due to landcover change gN/m^2/s F -DWT_FROOTC_TO_CEL_LIT_C levdcmp fine root to cellulosic litter due to landcover change gC/m^2/s F -DWT_FROOTC_TO_LIG_LIT_C levdcmp fine root to lignin litter due to landcover change gC/m^2/s F -DWT_FROOTC_TO_MET_LIT_C levdcmp fine root to metabolic litter due to landcover change gC/m^2/s F -DWT_FROOTN_TO_CEL_LIT_N levdcmp fine root N to cellulosic litter due to landcover change gN/m^2/s F -DWT_FROOTN_TO_LIG_LIT_N levdcmp fine root N to lignin litter due to landcover change gN/m^2/s F -DWT_FROOTN_TO_MET_LIT_N levdcmp fine root N to metabolic litter due to landcover change gN/m^2/s F -DWT_LIVECROOTC_TO_CWDC levdcmp live coarse root to CWD due to landcover change gC/m^2/s F -DWT_LIVECROOTN_TO_CWDN levdcmp live coarse root to CWD due to landcover change gN/m^2/s F DWT_PROD100C_GAIN - landcover change-driven addition to 100-yr wood product pool gC/m^2/s F DWT_PROD100N_GAIN - landcover change-driven addition to 100-yr wood product pool gN/m^2/s F DWT_PROD10C_GAIN - landcover change-driven addition to 10-yr wood product pool gC/m^2/s F @@ -248,7 +180,6 @@ DYN_COL_SOIL_ADJUSTMENTS_C - Adjustments in soil carbon DYN_COL_SOIL_ADJUSTMENTS_N - Adjustments in soil nitrogen due to dynamic column areas; only makes sense at the column level gN/m^2 F DYN_COL_SOIL_ADJUSTMENTS_NH4 - Adjustments in soil NH4 due to dynamic column areas; only makes sense at the column level: sho gN/m^2 F DYN_COL_SOIL_ADJUSTMENTS_NO3 - Adjustments in soil NO3 due to dynamic column areas; only makes sense at the column level: sho gN/m^2 F -EFF_POROSITY levgrnd effective porosity = porosity - vol_ice proportion F EFLXBUILD - building heat flux from change in interior building air temperature W/m^2 T EFLX_DYNBAL - dynamic land cover change conversion energy flux W/m^2 T EFLX_GNET - net heat flux into ground W/m^2 F @@ -290,7 +221,6 @@ FGR - heat flux into soil/snow in FGR12 - heat flux between soil layers 1 and 2 W/m^2 T FGR_ICE - heat flux into soil/snow including snow melt and lake / snow light transmission (ice landunits W/m^2 F FGR_R - Rural heat flux into soil/snow including snow melt and snow light transmission W/m^2 F -FGR_SOIL_R levgrnd Rural downward heat flux at interface below each soil layer watt/m^2 F FGR_U - Urban heat flux into soil/snow including snow melt W/m^2 F FH2OSFC - fraction of ground covered by surface water unitless T FH2OSFC_NOSNOW - fraction of ground covered by surface water (if no snow present) unitless F @@ -306,16 +236,12 @@ FIRE_R - Rural emitted infrared (lon FIRE_U - Urban emitted infrared (longwave) radiation W/m^2 F FLDS - atmospheric longwave radiation (downscaled to columns in glacier regions) W/m^2 T FLDS_ICE - atmospheric longwave radiation (downscaled to columns in glacier regions) (ice landunits only) W/m^2 F -FMAX_DENIT_CARBONSUBSTRATE levdcmp FMAX_DENIT_CARBONSUBSTRATE gN/m^3/s F -FMAX_DENIT_NITRATE levdcmp FMAX_DENIT_NITRATE gN/m^3/s F FPI - fraction of potential immobilization proportion T -FPI_vr levdcmp fraction of potential immobilization proportion F FPSN - photosynthesis umol m-2 s-1 T FPSN24 - 24 hour accumulative patch photosynthesis starting from mid-night umol CO2/m^2 ground/day F FPSN_WC - Rubisco-limited photosynthesis umol m-2 s-1 F FPSN_WJ - RuBP-limited photosynthesis umol m-2 s-1 F FPSN_WP - Product-limited photosynthesis umol m-2 s-1 F -FRAC_ICEOLD levgrnd fraction of ice relative to the tot water proportion F FREE_RETRANSN_TO_NPOOL - deployment of retranslocated N gN/m^2/s T FROOTC - fine root C gC/m^2 T FROOTC_ALLOC - fine root C allocation gC/m^2/s T @@ -332,7 +258,6 @@ FROOTN_TO_LITTER - fine root N litterfall FROOTN_XFER - fine root N transfer gN/m^2 F FROOTN_XFER_TO_FROOTN - fine root N growth from storage gN/m^2/s F FROOT_MR - fine root maintenance respiration gC/m^2/s F -FROOT_PROF levdcmp profile for litter C and N inputs from fine roots 1/m F FROST_TABLE - frost table depth (natural vegetated and crop landunits only) m F FSA - absorbed solar radiation W/m^2 T FSAT - fractional area with water table at surface unitless T @@ -382,12 +307,9 @@ FUELC - fuel load FV - friction velocity m/s T FWET - fraction of canopy that is wet proportion F F_DENIT - denitrification flux gN/m^2/s T -F_DENIT_BASE levdcmp F_DENIT_BASE gN/m^3/s F -F_DENIT_vr levdcmp denitrification flux gN/m^3/s F F_N2O_DENIT - denitrification N2O flux gN/m^2/s T F_N2O_NIT - nitrification N2O flux gN/m^2/s T F_NIT - nitrification flux gN/m^2/s T -F_NIT_vr levdcmp nitrification flux gN/m^3/s F GAMMA - total gamma for VOC calc non F GAMMAA - gamma A for VOC calc non F GAMMAC - gamma C for VOC calc non F @@ -402,23 +324,19 @@ GDD1020 - Twenty year average of grow GDD8 - Growing degree days base 8C from planting ddays F GDD820 - Twenty year average of growing degree days base 8C from planting ddays F GDDACCUM - Accumulated growing degree days past planting date for crop ddays F -GDDACCUM_PERHARV mxharvests At-harvest accumulated growing degree days past planting date for crop; should only be output ddays F GDDHARV - Growing degree days (gdd) needed to harvest ddays F -GDDHARV_PERHARV mxharvests Growing degree days (gdd) needed to harvest; should only be output annually ddays F GDDTSOI - Growing degree-days from planting (top two soil layers) ddays F GPP - gross primary production gC/m^2/s T GR - total growth respiration gC/m^2/s T GRAINC - grain C (does not equal yield) gC/m^2 T GRAINC_TO_FOOD - grain C to food gC/m^2/s T GRAINC_TO_FOOD_ANN - grain C to food harvested per calendar year; should only be output annually gC/m^2 F -GRAINC_TO_FOOD_PERHARV mxharvests grain C to food per harvest; should only be output annually gC/m^2 F GRAINC_TO_SEED - grain C to seed gC/m^2/s T GRAINN - grain N gN/m^2 T GRESP_STORAGE - growth respiration storage gC/m^2 F GRESP_STORAGE_TO_XFER - growth respiration shift storage to transfer gC/m^2/s F GRESP_XFER - growth respiration transfer gC/m^2 F GROSS_NMIN - gross rate of N mineralization gN/m^2/s T -GROSS_NMIN_vr levdcmp gross rate of N mineralization gN/m^3/s F GRU_PROD100C_GAIN - gross unrepresented landcover change addition to 100-yr wood product pool gC/m^2/s F GRU_PROD100N_GAIN - gross unrepresented landcover change addition to 100-yr wood product pool gN/m^2/s F GRU_PROD10C_GAIN - gross unrepresented landcover change addition to 10-yr wood product pool gC/m^2/s F @@ -432,10 +350,7 @@ H2OSFC - surface water depth H2OSNO - snow depth (liquid water) mm T H2OSNO_ICE - snow depth (liquid water, ice landunits only) mm F H2OSNO_TOP - mass of snow in top snow layer kg/m2 T -H2OSOI levsoi volumetric soil water (natural vegetated and crop landunits only) mm3/mm3 T -HARVEST_REASON_PERHARV mxharvests Reason for each crop harvest; should only be output annually 1 = mature; 2 = max season length; 3 = incorrect Dec. 31 sowing; F HBOT - canopy bottom m F -HDATES mxharvests actual crop harvest dates; should only be output annually day of year F HEAT_CONTENT1 - initial gridcell total heat content J/m^2 T HEAT_CONTENT1_VEG - initial gridcell total heat content - natural vegetated and crop landunits only J/m^2 F HEAT_CONTENT2 - post land cover change total heat content J/m^2 F @@ -443,12 +358,9 @@ HEAT_FROM_AC - sensible heat flux put into HIA - 2 m NWS Heat Index C T HIA_R - Rural 2 m NWS Heat Index C T HIA_U - Urban 2 m NWS Heat Index C T -HK levgrnd hydraulic conductivity (natural vegetated and crop landunits only) mm/s F HR - total heterotrophic respiration gC/m^2/s T -HR_vr levsoi total vertically resolved heterotrophic respiration gC/m^3/s T HTOP - canopy top m T HUI - Crop patch heat unit index ddays F -HUI_PERHARV mxharvests At-harvest accumulated heat unit index for crop; should only be output annually ddays F HUMIDEX - 2 m Humidex C T HUMIDEX_R - Rural 2 m Humidex C T HUMIDEX_U - Urban 2 m Humidex C T @@ -461,29 +373,9 @@ INT_SNOW_ICE - accumulated swe (ice landun IWUELN - local noon intrinsic water use efficiency umolCO2/molH2O T JMX25T - canopy profile of jmax umol/m2/s T Jmx25Z - maximum rate of electron transport at 25 Celcius for canopy layers umol electrons/m2/s T -KROOT levsoi root conductance each soil layer 1/s F -KSOIL levsoi soil conductance in each soil layer 1/s F -K_ACT_SOM levdcmp active soil organic potential loss coefficient 1/s F -K_CEL_LIT levdcmp cellulosic litter potential loss coefficient 1/s F -K_CWD levdcmp coarse woody debris potential loss coefficient 1/s F -K_LIG_LIT levdcmp lignin litter potential loss coefficient 1/s F -K_MET_LIT levdcmp metabolic litter potential loss coefficient 1/s F -K_NITR levdcmp K_NITR 1/s F -K_NITR_H2O levdcmp K_NITR_H2O unitless F -K_NITR_PH levdcmp K_NITR_PH unitless F -K_NITR_T levdcmp K_NITR_T unitless F -K_PAS_SOM levdcmp passive soil organic potential loss coefficient 1/s F -K_SLO_SOM levdcmp slow soil organic ma potential loss coefficient 1/s F -L1_PATHFRAC_S1_vr levdcmp PATHFRAC from metabolic litter to active soil organic fraction F -L1_RESP_FRAC_S1_vr levdcmp respired from metabolic litter to active soil organic fraction F -L2_PATHFRAC_S1_vr levdcmp PATHFRAC from cellulosic litter to active soil organic fraction F -L2_RESP_FRAC_S1_vr levdcmp respired from cellulosic litter to active soil organic fraction F -L3_PATHFRAC_S2_vr levdcmp PATHFRAC from lignin litter to slow soil organic ma fraction F -L3_RESP_FRAC_S2_vr levdcmp respired from lignin litter to slow soil organic ma fraction F LAI240 - 240hr average of leaf area index m^2/m^2 F LAISHA - shaded projected leaf area index m^2/m^2 T LAISUN - sunlit projected leaf area index m^2/m^2 T -LAKEICEFRAC levlak lake layer ice mass fraction unitless F LAKEICEFRAC_SURF - surface lake layer ice mass fraction unitless T LAKEICETHICK - thickness of lake ice (including physical expansion on freezing) m T LAND_USE_FLUX - total C emitted from land cover conversion (smoothed over the year) and wood and grain product gC/m^2/s T @@ -512,23 +404,8 @@ LEAFN_TO_RETRANSN - leaf N to retranslocated N LEAFN_XFER - leaf N transfer gN/m^2 F LEAFN_XFER_TO_LEAFN - leaf N growth from storage gN/m^2/s F LEAF_MR - leaf maintenance respiration gC/m^2/s T -LEAF_PROF levdcmp profile for litter C and N inputs from leaves 1/m F LFC2 - conversion area fraction of BET and BDT that burned per sec T LGSF - long growing season factor proportion F -LIG_LITC - LIG_LIT C gC/m^2 T -LIG_LITC_1m - LIG_LIT C to 1 meter gC/m^2 F -LIG_LITC_TNDNCY_VERT_TRA levdcmp lignin litter C tendency due to vertical transport gC/m^3/s F -LIG_LITC_TO_SLO_SOMC - decomp. of lignin litter C to slow soil organic ma C gC/m^2/s F -LIG_LITC_TO_SLO_SOMC_vr levdcmp decomp. of lignin litter C to slow soil organic ma C gC/m^3/s F -LIG_LITC_vr levsoi LIG_LIT C (vertically resolved) gC/m^3 T -LIG_LITN - LIG_LIT N gN/m^2 T -LIG_LITN_1m - LIG_LIT N to 1 meter gN/m^2 F -LIG_LITN_TNDNCY_VERT_TRA levdcmp lignin litter N tendency due to vertical transport gN/m^3/s F -LIG_LITN_TO_SLO_SOMN - decomp. of lignin litter N to slow soil organic ma N gN/m^2 F -LIG_LITN_TO_SLO_SOMN_vr levdcmp decomp. of lignin litter N to slow soil organic ma N gN/m^3 F -LIG_LITN_vr levdcmp LIG_LIT N (vertically resolved) gN/m^3 T -LIG_LIT_HR - Het. Resp. from lignin litter gC/m^2/s F -LIG_LIT_HR_vr levdcmp Het. Resp. from lignin litter gC/m^3/s F LIQCAN - intercepted liquid water mm T LIQUID_CONTENT1 - initial gridcell total liq content mm T LIQUID_CONTENT2 - post landuse change gridcell total liq content mm F @@ -537,6 +414,27 @@ LITFALL - litterfall (leaves and fine LITFIRE - litter fire losses gC/m^2/s F LITTERC_HR - litter C heterotrophic respiration gC/m^2/s T LITTERC_LOSS - litter C loss gC/m^2/s T +LIT_CEL_C - LIT_CEL C gC/m^2 T +LIT_CEL_C_1m - LIT_CEL C to 1 meter gC/m^2 F +LIT_CEL_C_TO_SOM_ACT_C - decomp. of cellulosic litter C to active soil organic C gC/m^2/s F +LIT_CEL_HR - Het. Resp. from cellulosic litter gC/m^2/s F +LIT_CEL_N - LIT_CEL N gN/m^2 T +LIT_CEL_N_1m - LIT_CEL N to 1 meter gN/m^2 F +LIT_CEL_N_TO_SOM_ACT_N - decomp. of cellulosic litter N to active soil organic N gN/m^2 F +LIT_LIG_C - LIT_LIG C gC/m^2 T +LIT_LIG_C_1m - LIT_LIG C to 1 meter gC/m^2 F +LIT_LIG_C_TO_SOM_SLO_C - decomp. of lignin litter C to slow soil organic ma C gC/m^2/s F +LIT_LIG_HR - Het. Resp. from lignin litter gC/m^2/s F +LIT_LIG_N - LIT_LIG N gN/m^2 T +LIT_LIG_N_1m - LIT_LIG N to 1 meter gN/m^2 F +LIT_LIG_N_TO_SOM_SLO_N - decomp. of lignin litter N to slow soil organic ma N gN/m^2 F +LIT_MET_C - LIT_MET C gC/m^2 T +LIT_MET_C_1m - LIT_MET C to 1 meter gC/m^2 F +LIT_MET_C_TO_SOM_ACT_C - decomp. of metabolic litter C to active soil organic C gC/m^2/s F +LIT_MET_HR - Het. Resp. from metabolic litter gC/m^2/s F +LIT_MET_N - LIT_MET N gN/m^2 T +LIT_MET_N_1m - LIT_MET N to 1 meter gN/m^2 F +LIT_MET_N_TO_SOM_ACT_N - decomp. of metabolic litter N to active soil organic N gN/m^2 F LIVECROOTC - live coarse root C gC/m^2 T LIVECROOTC_STORAGE - live coarse root C storage gC/m^2 F LIVECROOTC_STORAGE_TO_XFER - live coarse root C shift storage to transfer gC/m^2/s F @@ -579,33 +477,9 @@ MEG_isoprene - MEGAN flux MEG_methanol - MEGAN flux kg/m2/sec T MEG_pinene_a - MEGAN flux kg/m2/sec T MEG_thujene_a - MEGAN flux kg/m2/sec T -MET_LITC - MET_LIT C gC/m^2 T -MET_LITC_1m - MET_LIT C to 1 meter gC/m^2 F -MET_LITC_TNDNCY_VERT_TRA levdcmp metabolic litter C tendency due to vertical transport gC/m^3/s F -MET_LITC_TO_ACT_SOMC - decomp. of metabolic litter C to active soil organic C gC/m^2/s F -MET_LITC_TO_ACT_SOMC_vr levdcmp decomp. of metabolic litter C to active soil organic C gC/m^3/s F -MET_LITC_vr levsoi MET_LIT C (vertically resolved) gC/m^3 T -MET_LITN - MET_LIT N gN/m^2 T -MET_LITN_1m - MET_LIT N to 1 meter gN/m^2 F -MET_LITN_TNDNCY_VERT_TRA levdcmp metabolic litter N tendency due to vertical transport gN/m^3/s F -MET_LITN_TO_ACT_SOMN - decomp. of metabolic litter N to active soil organic N gN/m^2 F -MET_LITN_TO_ACT_SOMN_vr levdcmp decomp. of metabolic litter N to active soil organic N gN/m^3 F -MET_LITN_vr levdcmp MET_LIT N (vertically resolved) gN/m^3 T -MET_LIT_HR - Het. Resp. from metabolic litter gC/m^2/s F -MET_LIT_HR_vr levdcmp Het. Resp. from metabolic litter gC/m^3/s F MR - maintenance respiration gC/m^2/s T -M_ACT_SOMC_TO_LEACHING - active soil organic C leaching loss gC/m^2/s F -M_ACT_SOMN_TO_LEACHING - active soil organic N leaching loss gN/m^2/s F -M_CEL_LITC_TO_FIRE - cellulosic litter C fire loss gC/m^2/s F -M_CEL_LITC_TO_FIRE_vr levdcmp cellulosic litter C fire loss gC/m^3/s F -M_CEL_LITC_TO_LEACHING - cellulosic litter C leaching loss gC/m^2/s F -M_CEL_LITN_TO_FIRE - cellulosic litter N fire loss gN/m^2 F -M_CEL_LITN_TO_FIRE_vr levdcmp cellulosic litter N fire loss gN/m^3 F -M_CEL_LITN_TO_LEACHING - cellulosic litter N leaching loss gN/m^2/s F -M_CWDC_TO_FIRE - coarse woody debris C fire loss gC/m^2/s F -M_CWDC_TO_FIRE_vr levdcmp coarse woody debris C fire loss gC/m^3/s F -M_CWDN_TO_FIRE - coarse woody debris N fire loss gN/m^2 F -M_CWDN_TO_FIRE_vr levdcmp coarse woody debris N fire loss gN/m^3 F +M_CWD_C_TO_FIRE - coarse woody debris C fire loss gC/m^2/s F +M_CWD_N_TO_FIRE - coarse woody debris N fire loss gN/m^2 F M_DEADCROOTC_STORAGE_TO_LITTER - dead coarse root C storage mortality gC/m^2/s F M_DEADCROOTC_STORAGE_TO_LITTER_FIRE - dead coarse root C storage fire mortality to litter gC/m^2/s F M_DEADCROOTC_TO_LITTER - dead coarse root C mortality gC/m^2/s F @@ -675,12 +549,18 @@ M_LEAFN_TO_FIRE - leaf N fire loss M_LEAFN_TO_LITTER - leaf N mortality gN/m^2/s F M_LEAFN_XFER_TO_FIRE - leaf N transfer fire loss gN/m^2/s F M_LEAFN_XFER_TO_LITTER - leaf N transfer mortality gN/m^2/s F -M_LIG_LITC_TO_FIRE - lignin litter C fire loss gC/m^2/s F -M_LIG_LITC_TO_FIRE_vr levdcmp lignin litter C fire loss gC/m^3/s F -M_LIG_LITC_TO_LEACHING - lignin litter C leaching loss gC/m^2/s F -M_LIG_LITN_TO_FIRE - lignin litter N fire loss gN/m^2 F -M_LIG_LITN_TO_FIRE_vr levdcmp lignin litter N fire loss gN/m^3 F -M_LIG_LITN_TO_LEACHING - lignin litter N leaching loss gN/m^2/s F +M_LIT_CEL_C_TO_FIRE - cellulosic litter C fire loss gC/m^2/s F +M_LIT_CEL_C_TO_LEACHING - cellulosic litter C leaching loss gC/m^2/s F +M_LIT_CEL_N_TO_FIRE - cellulosic litter N fire loss gN/m^2 F +M_LIT_CEL_N_TO_LEACHING - cellulosic litter N leaching loss gN/m^2/s F +M_LIT_LIG_C_TO_FIRE - lignin litter C fire loss gC/m^2/s F +M_LIT_LIG_C_TO_LEACHING - lignin litter C leaching loss gC/m^2/s F +M_LIT_LIG_N_TO_FIRE - lignin litter N fire loss gN/m^2 F +M_LIT_LIG_N_TO_LEACHING - lignin litter N leaching loss gN/m^2/s F +M_LIT_MET_C_TO_FIRE - metabolic litter C fire loss gC/m^2/s F +M_LIT_MET_C_TO_LEACHING - metabolic litter C leaching loss gC/m^2/s F +M_LIT_MET_N_TO_FIRE - metabolic litter N fire loss gN/m^2 F +M_LIT_MET_N_TO_LEACHING - metabolic litter N leaching loss gN/m^2/s F M_LIVECROOTC_STORAGE_TO_LITTER - live coarse root C storage mortality gC/m^2/s F M_LIVECROOTC_STORAGE_TO_LITTER_FIRE - live coarse root C fire mortality to litter gC/m^2/s F M_LIVECROOTC_TO_LITTER - live coarse root C mortality gC/m^2/s F @@ -714,18 +594,14 @@ M_LIVESTEMN_TO_FIRE - live stem N fire loss M_LIVESTEMN_TO_LITTER - live stem N mortality gN/m^2/s F M_LIVESTEMN_XFER_TO_FIRE - live stem N transfer fire loss gN/m^2/s F M_LIVESTEMN_XFER_TO_LITTER - live stem N transfer mortality gN/m^2/s F -M_MET_LITC_TO_FIRE - metabolic litter C fire loss gC/m^2/s F -M_MET_LITC_TO_FIRE_vr levdcmp metabolic litter C fire loss gC/m^3/s F -M_MET_LITC_TO_LEACHING - metabolic litter C leaching loss gC/m^2/s F -M_MET_LITN_TO_FIRE - metabolic litter N fire loss gN/m^2 F -M_MET_LITN_TO_FIRE_vr levdcmp metabolic litter N fire loss gN/m^3 F -M_MET_LITN_TO_LEACHING - metabolic litter N leaching loss gN/m^2/s F -M_PAS_SOMC_TO_LEACHING - passive soil organic C leaching loss gC/m^2/s F -M_PAS_SOMN_TO_LEACHING - passive soil organic N leaching loss gN/m^2/s F M_RETRANSN_TO_FIRE - retranslocated N pool fire loss gN/m^2/s F M_RETRANSN_TO_LITTER - retranslocated N pool mortality gN/m^2/s F -M_SLO_SOMC_TO_LEACHING - slow soil organic ma C leaching loss gC/m^2/s F -M_SLO_SOMN_TO_LEACHING - slow soil organic ma N leaching loss gN/m^2/s F +M_SOM_ACT_C_TO_LEACHING - active soil organic C leaching loss gC/m^2/s F +M_SOM_ACT_N_TO_LEACHING - active soil organic N leaching loss gN/m^2/s F +M_SOM_PAS_C_TO_LEACHING - passive soil organic C leaching loss gC/m^2/s F +M_SOM_PAS_N_TO_LEACHING - passive soil organic N leaching loss gN/m^2/s F +M_SOM_SLO_C_TO_LEACHING - slow soil organic ma C leaching loss gC/m^2/s F +M_SOM_SLO_N_TO_LEACHING - slow soil organic ma N leaching loss gN/m^2/s F NACTIVE - Mycorrhizal N uptake flux gN/m^2/s T NACTIVE_NH4 - Mycorrhizal N uptake flux gN/m^2/s T NACTIVE_NO3 - Mycorrhizal N uptake flux gN/m^2/s T @@ -734,7 +610,6 @@ NAM_NH4 - AM-associated N uptake flux NAM_NO3 - AM-associated N uptake flux gN/m^2/s T NBP - net biome production, includes fire, landuse, harvest and hrv_xsmrpool flux (latter smoothed o gC/m^2/s T NDEPLOY - total N deployed in new growth gN/m^2/s T -NDEP_PROF levdcmp profile for atmospheric N deposition 1/m F NDEP_TO_SMINN - atmospheric N deposition to soil mineral N gN/m^2/s T NECM - ECM-associated N uptake flux gN/m^2/s T NECM_NH4 - ECM-associated N uptake flux gN/m^2/s T @@ -743,11 +618,9 @@ NEE - net ecosystem exchange of c NEM - Gridcell net adjustment to net carbon exchange passed to atm. for methane production gC/m2/s T NEP - net ecosystem production, excludes fire, landuse, and harvest flux, positive for sink gC/m^2/s T NET_NMIN - net rate of N mineralization gN/m^2/s T -NET_NMIN_vr levdcmp net rate of N mineralization gN/m^3/s F NFERTILIZATION - fertilizer added gN/m^2/s T NFIRE - fire counts valid only in Reg.C counts/km2/sec T NFIX - Symbiotic BNF uptake flux gN/m^2/s T -NFIXATION_PROF levdcmp profile for biological N fixation 1/m F NFIX_TO_SMINN - symbiotic/asymbiotic N fixation to soil mineral N gN/m^2/s F NNONMYC - Non-mycorrhizal N uptake flux gN/m^2/s T NNONMYC_NH4 - Non-mycorrhizal N uptake flux gN/m^2/s T @@ -792,7 +665,6 @@ NSUBSTEPS - number of adaptive timestep NUPTAKE - Total N uptake of FUN gN/m^2/s T NUPTAKE_NPP_FRACTION - frac of NPP used in N uptake - T N_ALLOMETRY - N allocation index none F -O2_DECOMP_DEPTH_UNSAT levgrnd O2 consumption from HR and AR for non-inundated area mol/m3/s F OBU - Monin-Obukhov length m F OCDEP - total OC deposition (dry+wet) from atmosphere kg/m^2/s T OFFSET_COUNTER - offset days counter days F @@ -805,7 +677,6 @@ ONSET_FLAG - onset flag ONSET_GDD - onset growing degree days C degree-days F ONSET_GDDFLAG - onset flag for growing degree day sum none F ONSET_SWI - onset soil water index none F -O_SCALAR levsoi fraction by which decomposition is reduced due to anoxia unitless T PAR240DZ - 10-day running mean of daytime patch absorbed PAR for leaves for top canopy layer W/m^2 F PAR240XZ - 10-day running mean of maximum patch absorbed PAR for leaves for top canopy layer W/m^2 F PAR240_shade - shade PAR (240 hrs) umol/m2/s F @@ -815,20 +686,6 @@ PAR24_sun - sunlit PAR (24 hrs) PARVEGLN - absorbed par by vegetation at local noon W/m^2 T PAR_shade - shade PAR umol/m2/s F PAR_sun - sunlit PAR umol/m2/s F -PAS_SOMC - PAS_SOM C gC/m^2 T -PAS_SOMC_1m - PAS_SOM C to 1 meter gC/m^2 F -PAS_SOMC_TNDNCY_VERT_TRA levdcmp passive soil organic C tendency due to vertical transport gC/m^3/s F -PAS_SOMC_TO_ACT_SOMC - decomp. of passive soil organic C to active soil organic C gC/m^2/s F -PAS_SOMC_TO_ACT_SOMC_vr levdcmp decomp. of passive soil organic C to active soil organic C gC/m^3/s F -PAS_SOMC_vr levsoi PAS_SOM C (vertically resolved) gC/m^3 T -PAS_SOMN - PAS_SOM N gN/m^2 T -PAS_SOMN_1m - PAS_SOM N to 1 meter gN/m^2 F -PAS_SOMN_TNDNCY_VERT_TRA levdcmp passive soil organic N tendency due to vertical transport gN/m^3/s F -PAS_SOMN_TO_ACT_SOMN - decomp. of passive soil organic N to active soil organic N gN/m^2 F -PAS_SOMN_TO_ACT_SOMN_vr levdcmp decomp. of passive soil organic N to active soil organic N gN/m^3 F -PAS_SOMN_vr levdcmp PAS_SOM N (vertically resolved) gN/m^3 T -PAS_SOM_HR - Het. Resp. from passive soil organic gC/m^2/s F -PAS_SOM_HR_vr levdcmp Het. Resp. from passive soil organic gC/m^3/s F PBOT - atmospheric pressure at surface (downscaled to columns in glacier regions) Pa T PBOT_240 - 10 day running mean of air pressure Pa F PCH4 - atmospheric partial pressure of CH4 Pa T @@ -845,11 +702,8 @@ PLANT_NDEMAND - N flux required to support PNLCZ - Proportion of nitrogen allocated for light capture unitless F PO2_240 - 10 day running mean of O2 pressure Pa F POTENTIAL_IMMOB - potential N immobilization gN/m^2/s T -POTENTIAL_IMMOB_vr levdcmp potential N immobilization gN/m^3/s F POT_F_DENIT - potential denitrification flux gN/m^2/s T -POT_F_DENIT_vr levdcmp potential denitrification flux gN/m^3/s F POT_F_NIT - potential nitrification flux gN/m^2/s T -POT_F_NIT_vr levdcmp potential nitrification flux gN/m^3/s F PREC10 - 10-day running mean of PREC MM H2O/S F PREC60 - 60-day running mean of PREC MM H2O/S F PREV_DAYL - daylength from previous timestep s F @@ -896,7 +750,6 @@ QH2OSFC - surface water runoff QH2OSFC_TO_ICE - surface water converted to ice mm/s F QHR - hydraulic redistribution mm/s T QICE - ice growth/melt mm/s T -QICE_FORC elevclas qice forcing sent to GLC mm/s F QICE_FRZ - ice growth mm/s T QICE_MELT - ice melt mm/s T QINFL - infiltration mm/s T @@ -911,7 +764,6 @@ QOVER - total surface runoff (inclu QOVER_LAG - time-lagged surface runoff for soil columns mm/s F QPHSNEG - net negative hydraulic redistribution flux mm/s F QRGWL - surface runoff at glaciers (liquid only), wetlands, lakes; also includes melted ice runoff fro mm/s T -QROOTSINK levsoi water flux from soil to root in each soil-layer mm/s F QRUNOFF - total liquid runoff not including correction for land use change mm/s T QRUNOFF_ICE - total liquid runoff not incl corret for LULCC (ice landunits only) mm/s T QRUNOFF_ICE_TO_COUPLER - total ice runoff sent to coupler (includes corrections for land use change) mm/s T @@ -960,85 +812,33 @@ RH30 - 30-day running mean of rela RHAF - fractional humidity of canopy air fraction F RHAF10 - 10 day running mean of fractional humidity of canopy air fraction F RH_LEAF - fractional humidity at leaf surface fraction F -ROOTR levgrnd effective fraction of roots in each soil layer (SMS method) proportion F RR - root respiration (fine root MR + total root GR) gC/m^2/s T -RRESIS levgrnd root resistance in each soil layer proportion F RSSHA - shaded leaf stomatal resistance s/m T RSSUN - sunlit leaf stomatal resistance s/m T Rainf - atmospheric rain, after rain/snow repartitioning based on temperature mm/s F Rnet - net radiation W/m^2 F -S1_PATHFRAC_S2_vr levdcmp PATHFRAC from active soil organic to slow soil organic ma fraction F -S1_PATHFRAC_S3_vr levdcmp PATHFRAC from active soil organic to passive soil organic fraction F -S1_RESP_FRAC_S2_vr levdcmp respired from active soil organic to slow soil organic ma fraction F -S1_RESP_FRAC_S3_vr levdcmp respired from active soil organic to passive soil organic fraction F -S2_PATHFRAC_S1_vr levdcmp PATHFRAC from slow soil organic ma to active soil organic fraction F -S2_PATHFRAC_S3_vr levdcmp PATHFRAC from slow soil organic ma to passive soil organic fraction F -S2_RESP_FRAC_S1_vr levdcmp respired from slow soil organic ma to active soil organic fraction F -S2_RESP_FRAC_S3_vr levdcmp respired from slow soil organic ma to passive soil organic fraction F -S3_PATHFRAC_S1_vr levdcmp PATHFRAC from passive soil organic to active soil organic fraction F -S3_RESP_FRAC_S1_vr levdcmp respired from passive soil organic to active soil organic fraction F SABG - solar rad absorbed by ground W/m^2 T SABG_PEN - Rural solar rad penetrating top soil or snow layer watt/m^2 T SABV - solar rad absorbed by veg W/m^2 T -SDATES mxsowings actual crop sowing dates; should only be output annually day of year F -SDATES_PERHARV mxharvests actual sowing dates for crops harvested this year; should only be output annually day of year F SEEDC - pool for seeding new PFTs via dynamic landcover gC/m^2 T SEEDN - pool for seeding new PFTs via dynamic landcover gN/m^2 T SLASH_HARVESTC - slash harvest carbon (to litter) gC/m^2/s T -SLO_SOMC - SLO_SOM C gC/m^2 T -SLO_SOMC_1m - SLO_SOM C to 1 meter gC/m^2 F -SLO_SOMC_TNDNCY_VERT_TRA levdcmp slow soil organic ma C tendency due to vertical transport gC/m^3/s F -SLO_SOMC_TO_ACT_SOMC - decomp. of slow soil organic ma C to active soil organic C gC/m^2/s F -SLO_SOMC_TO_ACT_SOMC_vr levdcmp decomp. of slow soil organic ma C to active soil organic C gC/m^3/s F -SLO_SOMC_TO_PAS_SOMC - decomp. of slow soil organic ma C to passive soil organic C gC/m^2/s F -SLO_SOMC_TO_PAS_SOMC_vr levdcmp decomp. of slow soil organic ma C to passive soil organic C gC/m^3/s F -SLO_SOMC_vr levsoi SLO_SOM C (vertically resolved) gC/m^3 T -SLO_SOMN - SLO_SOM N gN/m^2 T -SLO_SOMN_1m - SLO_SOM N to 1 meter gN/m^2 F -SLO_SOMN_TNDNCY_VERT_TRA levdcmp slow soil organic ma N tendency due to vertical transport gN/m^3/s F -SLO_SOMN_TO_ACT_SOMN - decomp. of slow soil organic ma N to active soil organic N gN/m^2 F -SLO_SOMN_TO_ACT_SOMN_vr levdcmp decomp. of slow soil organic ma N to active soil organic N gN/m^3 F -SLO_SOMN_TO_PAS_SOMN - decomp. of slow soil organic ma N to passive soil organic N gN/m^2 F -SLO_SOMN_TO_PAS_SOMN_vr levdcmp decomp. of slow soil organic ma N to passive soil organic N gN/m^3 F -SLO_SOMN_vr levdcmp SLO_SOM N (vertically resolved) gN/m^3 T -SLO_SOM_HR_S1 - Het. Resp. from slow soil organic ma gC/m^2/s F -SLO_SOM_HR_S1_vr levdcmp Het. Resp. from slow soil organic ma gC/m^3/s F -SLO_SOM_HR_S3 - Het. Resp. from slow soil organic ma gC/m^2/s F -SLO_SOM_HR_S3_vr levdcmp Het. Resp. from slow soil organic ma gC/m^3/s F SMINN - soil mineral N gN/m^2 T SMINN_TO_NPOOL - deployment of soil mineral N uptake gN/m^2/s T SMINN_TO_PLANT - plant uptake of soil mineral N gN/m^2/s T SMINN_TO_PLANT_FUN - Total soil N uptake of FUN gN/m^2/s T -SMINN_TO_PLANT_vr levdcmp plant uptake of soil mineral N gN/m^3/s F -SMINN_TO_S1N_L1 - mineral N flux for decomp. of MET_LITto ACT_SOM gN/m^2 F -SMINN_TO_S1N_L1_vr levdcmp mineral N flux for decomp. of MET_LITto ACT_SOM gN/m^3 F -SMINN_TO_S1N_L2 - mineral N flux for decomp. of CEL_LITto ACT_SOM gN/m^2 F -SMINN_TO_S1N_L2_vr levdcmp mineral N flux for decomp. of CEL_LITto ACT_SOM gN/m^3 F -SMINN_TO_S1N_S2 - mineral N flux for decomp. of SLO_SOMto ACT_SOM gN/m^2 F -SMINN_TO_S1N_S2_vr levdcmp mineral N flux for decomp. of SLO_SOMto ACT_SOM gN/m^3 F -SMINN_TO_S1N_S3 - mineral N flux for decomp. of PAS_SOMto ACT_SOM gN/m^2 F -SMINN_TO_S1N_S3_vr levdcmp mineral N flux for decomp. of PAS_SOMto ACT_SOM gN/m^3 F -SMINN_TO_S2N_L3 - mineral N flux for decomp. of LIG_LITto SLO_SOM gN/m^2 F -SMINN_TO_S2N_L3_vr levdcmp mineral N flux for decomp. of LIG_LITto SLO_SOM gN/m^3 F -SMINN_TO_S2N_S1 - mineral N flux for decomp. of ACT_SOMto SLO_SOM gN/m^2 F -SMINN_TO_S2N_S1_vr levdcmp mineral N flux for decomp. of ACT_SOMto SLO_SOM gN/m^3 F -SMINN_TO_S3N_S1 - mineral N flux for decomp. of ACT_SOMto PAS_SOM gN/m^2 F -SMINN_TO_S3N_S1_vr levdcmp mineral N flux for decomp. of ACT_SOMto PAS_SOM gN/m^3 F -SMINN_TO_S3N_S2 - mineral N flux for decomp. of SLO_SOMto PAS_SOM gN/m^2 F -SMINN_TO_S3N_S2_vr levdcmp mineral N flux for decomp. of SLO_SOMto PAS_SOM gN/m^3 F -SMINN_vr levsoi soil mineral N gN/m^3 T +SMINN_TO_S1N_L1 - mineral N flux for decomp. of LIT_METto SOM_ACT gN/m^2 F +SMINN_TO_S1N_L2 - mineral N flux for decomp. of LIT_CELto SOM_ACT gN/m^2 F +SMINN_TO_S1N_S2 - mineral N flux for decomp. of SOM_SLOto SOM_ACT gN/m^2 F +SMINN_TO_S1N_S3 - mineral N flux for decomp. of SOM_PASto SOM_ACT gN/m^2 F +SMINN_TO_S2N_L3 - mineral N flux for decomp. of LIT_LIGto SOM_SLO gN/m^2 F +SMINN_TO_S2N_S1 - mineral N flux for decomp. of SOM_ACTto SOM_SLO gN/m^2 F +SMINN_TO_S3N_S1 - mineral N flux for decomp. of SOM_ACTto SOM_PAS gN/m^2 F +SMINN_TO_S3N_S2 - mineral N flux for decomp. of SOM_SLOto SOM_PAS gN/m^2 F SMIN_NH4 - soil mineral NH4 gN/m^2 T -SMIN_NH4_TO_PLANT levdcmp plant uptake of NH4 gN/m^3/s F -SMIN_NH4_vr levsoi soil mineral NH4 (vert. res.) gN/m^3 T SMIN_NO3 - soil mineral NO3 gN/m^2 T SMIN_NO3_LEACHED - soil NO3 pool loss to leaching gN/m^2/s T -SMIN_NO3_LEACHED_vr levdcmp soil NO3 pool loss to leaching gN/m^3/s F -SMIN_NO3_MASSDENS levdcmp SMIN_NO3_MASSDENS ugN/cm^3 soil F SMIN_NO3_RUNOFF - soil NO3 pool loss to runoff gN/m^2/s T -SMIN_NO3_RUNOFF_vr levdcmp soil NO3 pool loss to runoff gN/m^3/s F -SMIN_NO3_TO_PLANT levdcmp plant uptake of NO3 gN/m^3/s F -SMIN_NO3_vr levsoi soil mineral NO3 (vert. res.) gN/m^3 T -SMP levgrnd soil matric potential (natural vegetated and crop landunits only) mm T SNOBCMCL - mass of BC in snow column kg/m2 T SNOBCMSL - mass of BC in top snow layer kg/m2 T SNOCAN - intercepted snow mm T @@ -1075,59 +875,55 @@ SNOW_ICE - atmospheric snow, after rai SNOW_PERSISTENCE - Length of time of continuous snow cover (nat. veg. landunits only) seconds T SNOW_SINKS - snow sinks (liquid water) mm/s T SNOW_SOURCES - snow sources (liquid water) mm/s T -SNO_ABS levsno Absorbed solar radiation in each snow layer W/m^2 F -SNO_ABS_ICE levsno Absorbed solar radiation in each snow layer (ice landunits only) W/m^2 F -SNO_BW levsno Partial density of water in the snow pack (ice + liquid) kg/m3 F -SNO_BW_ICE levsno Partial density of water in the snow pack (ice + liquid, ice landunits only) kg/m3 F -SNO_EXISTENCE levsno Fraction of averaging period for which each snow layer existed unitless F -SNO_FRZ levsno snow freezing rate in each snow layer kg/m2/s F -SNO_FRZ_ICE levsno snow freezing rate in each snow layer (ice landunits only) mm/s F -SNO_GS levsno Mean snow grain size Microns F -SNO_GS_ICE levsno Mean snow grain size (ice landunits only) Microns F -SNO_ICE levsno Snow ice content kg/m2 F -SNO_LIQH2O levsno Snow liquid water content kg/m2 F -SNO_MELT levsno snow melt rate in each snow layer mm/s F -SNO_MELT_ICE levsno snow melt rate in each snow layer (ice landunits only) mm/s F -SNO_T levsno Snow temperatures K F -SNO_TK levsno Thermal conductivity W/m-K F -SNO_TK_ICE levsno Thermal conductivity (ice landunits only) W/m-K F -SNO_T_ICE levsno Snow temperatures (ice landunits only) K F -SNO_Z levsno Snow layer thicknesses m F -SNO_Z_ICE levsno Snow layer thicknesses (ice landunits only) m F SNOdTdzL - top snow layer temperature gradient (land) K/m F SOIL10 - 10-day running mean of 12cm layer soil K F SOILC_CHANGE - C change in soil gC/m^2/s T SOILC_HR - soil C heterotrophic respiration gC/m^2/s T -SOILC_vr levsoi SOIL C (vertically resolved) gC/m^3 T -SOILICE levsoi soil ice (natural vegetated and crop landunits only) kg/m2 T -SOILLIQ levsoi soil liquid water (natural vegetated and crop landunits only) kg/m2 T -SOILN_vr levdcmp SOIL N (vertically resolved) gN/m^3 T -SOILPSI levgrnd soil water potential in each soil layer MPa F SOILRESIS - soil resistance to evaporation s/m T SOILWATER_10CM - soil liquid water + ice in top 10cm of soil (veg landunits only) kg/m2 T SOMC_FIRE - C loss due to peat burning gC/m^2/s T SOMFIRE - soil organic matter fire losses gC/m^2/s F -SOM_ADV_COEF levdcmp advection term for vertical SOM translocation m/s F +SOM_ACT_C - SOM_ACT C gC/m^2 T +SOM_ACT_C_1m - SOM_ACT C to 1 meter gC/m^2 F +SOM_ACT_C_TO_SOM_PAS_C - decomp. of active soil organic C to passive soil organic C gC/m^2/s F +SOM_ACT_C_TO_SOM_SLO_C - decomp. of active soil organic C to slow soil organic ma C gC/m^2/s F +SOM_ACT_HR_S2 - Het. Resp. from active soil organic gC/m^2/s F +SOM_ACT_HR_S3 - Het. Resp. from active soil organic gC/m^2/s F +SOM_ACT_N - SOM_ACT N gN/m^2 T +SOM_ACT_N_1m - SOM_ACT N to 1 meter gN/m^2 F +SOM_ACT_N_TO_SOM_PAS_N - decomp. of active soil organic N to passive soil organic N gN/m^2 F +SOM_ACT_N_TO_SOM_SLO_N - decomp. of active soil organic N to slow soil organic ma N gN/m^2 F SOM_C_LEACHED - total flux of C from SOM pools due to leaching gC/m^2/s T -SOM_DIFFUS_COEF levdcmp diffusion coefficient for vertical SOM translocation m^2/s F SOM_N_LEACHED - total flux of N from SOM pools due to leaching gN/m^2/s F -SOWING_REASON mxsowings Reason for each crop sowing; should only be output annually unitless F -SOWING_REASON_PERHARV mxharvests Reason for sowing of each crop harvested this year; should only be output annually unitless F +SOM_PAS_C - SOM_PAS C gC/m^2 T +SOM_PAS_C_1m - SOM_PAS C to 1 meter gC/m^2 F +SOM_PAS_C_TO_SOM_ACT_C - decomp. of passive soil organic C to active soil organic C gC/m^2/s F +SOM_PAS_HR - Het. Resp. from passive soil organic gC/m^2/s F +SOM_PAS_N - SOM_PAS N gN/m^2 T +SOM_PAS_N_1m - SOM_PAS N to 1 meter gN/m^2 F +SOM_PAS_N_TO_SOM_ACT_N - decomp. of passive soil organic N to active soil organic N gN/m^2 F +SOM_SLO_C - SOM_SLO C gC/m^2 T +SOM_SLO_C_1m - SOM_SLO C to 1 meter gC/m^2 F +SOM_SLO_C_TO_SOM_ACT_C - decomp. of slow soil organic ma C to active soil organic C gC/m^2/s F +SOM_SLO_C_TO_SOM_PAS_C - decomp. of slow soil organic ma C to passive soil organic C gC/m^2/s F +SOM_SLO_HR_S1 - Het. Resp. from slow soil organic ma gC/m^2/s F +SOM_SLO_HR_S3 - Het. Resp. from slow soil organic ma gC/m^2/s F +SOM_SLO_N - SOM_SLO N gN/m^2 T +SOM_SLO_N_1m - SOM_SLO N to 1 meter gN/m^2 F +SOM_SLO_N_TO_SOM_ACT_N - decomp. of slow soil organic ma N to active soil organic N gN/m^2 F +SOM_SLO_N_TO_SOM_PAS_N - decomp. of slow soil organic ma N to passive soil organic N gN/m^2 F SR - total soil respiration (HR + root resp) gC/m^2/s T -STEM_PROF levdcmp profile for litter C and N inputs from stems 1/m F STORAGE_CDEMAND - C use from the C storage pool gC/m^2 F STORAGE_GR - growth resp for growth sent to storage for later display gC/m^2/s F STORAGE_NDEMAND - N demand during the offset period gN/m^2 F STORVEGC - stored vegetation carbon, excluding cpool gC/m^2 T STORVEGN - stored vegetation nitrogen gN/m^2 T SUPPLEMENT_TO_SMINN - supplemental N supply gN/m^2/s T -SUPPLEMENT_TO_SMINN_vr levdcmp supplemental N supply gN/m^3/s F SWBGT - 2 m Simplified Wetbulb Globe Temp C T SWBGT_R - Rural 2 m Simplified Wetbulb Globe Temp C T SWBGT_U - Urban 2 m Simplified Wetbulb Globe Temp C T SWdown - atmospheric incident solar radiation W/m^2 F SWup - upwelling shortwave radiation W/m^2 F -SYEARS_PERHARV mxharvests actual sowing years for crops harvested this year; should only be output annually year F SoilAlpha - factor limiting ground evap unitless F SoilAlpha_U - urban factor limiting ground evap unitless F T10 - 10-day running mean of 2-m temperature K F @@ -1149,10 +945,8 @@ TH2OSFC - surface water temperature THBOT - atmospheric air potential temperature (downscaled to columns in glacier regions) K T TKE1 - top lake level eddy thermal conductivity W/(mK) T TLAI - total projected leaf area index m^2/m^2 T -TLAKE levlak lake temperature K T TOPO_COL - column-level topographic height m F TOPO_COL_ICE - column-level topographic height (ice landunits only) m F -TOPO_FORC elevclas topograephic height sent to GLC m F TOPT - topt coefficient for VOC calc non F TOTCOLC - total column carbon, incl veg and cpool but excl product pools gC/m^2 T TOTCOLCH4 - total belowground CH4 (0 for non-lake special landunits in the absence of dynamic landunits) gC/m2 T @@ -1166,7 +960,7 @@ TOTLITN - total litter N TOTLITN_1m - total litter N to 1 meter gN/m^2 T TOTPFTC - total patch-level carbon, including cpool gC/m^2 T TOTPFTN - total patch-level nitrogen gN/m^2 T -TOTSOILICE - vertically summed soil cie (veg landunits only) kg/m2 T +TOTSOILICE - vertically summed soil ice (veg landunits only) kg/m2 T TOTSOILLIQ - vertically summed soil liquid water (veg landunits only) kg/m2 T TOTSOMC - total soil organic matter carbon gC/m^2 T TOTSOMC_1m - total soil organic matter carbon to 1 meter depth gC/m^2 T @@ -1202,10 +996,7 @@ TSA_U - Urban 2m air temperature TSHDW_INNER - shadewall inside surface temperature K F TSKIN - skin temperature K T TSL - temperature of near-surface soil layer (natural vegetated and crop landunits only) K T -TSOI levgrnd soil temperature (natural vegetated and crop landunits only) K T TSOI_10CM - soil temperature in top 10cm of soil K T -TSOI_ICE levgrnd soil temperature (ice landunits only) K T -TSRF_FORC elevclas surface temperature sent to GLC K F TSUNW_INNER - sunwall inside surface temperature K F TV - vegetation temperature K T TV24 - vegetation temperature (last 24hrs) K F @@ -1213,7 +1004,6 @@ TV240 - vegetation temperature (las TVEGD10 - 10 day running mean of patch daytime vegetation temperature Kelvin F TVEGN10 - 10 day running mean of patch night-time vegetation temperature Kelvin F TWS - total water storage mm T -T_SCALAR levsoi temperature inhibition of decomposition unitless T Tair - atmospheric air temperature (downscaled to columns in glacier regions) K F Tair_from_atm - atmospheric air temperature received from atmosphere (pre-downscaling) K F U10 - 10-m wind m/s T @@ -1228,9 +1018,6 @@ USTAR - aerodynamical resistance UST_LAKE - friction velocity (lakes only) m/s F VA - atmospheric wind speed plus convective velocity m/s F VCMX25T - canopy profile of vcmax25 umol/m2/s T -VEGWP nvegwcs vegetation water matric potential for sun/sha canopy,xyl,root segments mm T -VEGWPLN nvegwcs vegetation water matric potential for sun/sha canopy,xyl,root at local noon mm T -VEGWPPD nvegwcs predawn vegetation water matric potential for sun/sha canopy,xyl,root mm T VENTILATION - sensible heat flux from building ventilation W/m^2 T VOCFLXT - total VOC flux into atmosphere moles/m2/sec F VOLR - river channel total water storage m3 T @@ -1244,7 +1031,6 @@ WBT - 2 m Stull Wet Bulb WBT_R - Rural 2 m Stull Wet Bulb C T WBT_U - Urban 2 m Stull Wet Bulb C T WF - soil water as frac. of whc for top 0.05 m proportion F -WFPS levdcmp WFPS percent F WIND - atmospheric wind velocity magnitude m/s T WOODC - wood C gC/m^2 T WOODC_ALLOC - wood C eallocation gC/m^2/s T @@ -1252,7 +1038,6 @@ WOODC_LOSS - wood C loss WOOD_HARVESTC - wood harvest carbon (to product pools) gC/m^2/s T WOOD_HARVESTN - wood harvest N (to product pools) gN/m^2/s T WTGQ - surface tracer conductance m/s T -W_SCALAR levsoi Moisture (dryness) inhibition of decomposition unitless T Wind - atmospheric wind velocity magnitude m/s F XSMRPOOL - temporary photosynthate C pool gC/m^2 T XSMRPOOL_LOSS - temporary photosynthate C pool loss gC/m^2 F @@ -1271,18 +1056,233 @@ ZII - convective boundary height ZWT - water table depth (natural vegetated and crop landunits only) m T ZWT_CH4_UNSAT - depth of water table for methane production used in non-inundated area m T ZWT_PERCH - perched water table depth (natural vegetated and crop landunits only) m T -anaerobic_frac levdcmp anaerobic_frac m3/m3 F -bsw levgrnd clap and hornberger B unitless F currentPatch - currentPatch coefficient for VOC calc non F +num_iter - number of iterations unitless F +QICE_FORC elevclas qice forcing sent to GLC mm/s F +TOPO_FORC elevclas topograephic height sent to GLC m F +TSRF_FORC elevclas surface temperature sent to GLC K F +ACTUAL_IMMOB_NH4 levdcmp immobilization of NH4 gN/m^3/s F +ACTUAL_IMMOB_NO3 levdcmp immobilization of NO3 gN/m^3/s F +ACTUAL_IMMOB_vr levdcmp actual N immobilization gN/m^3/s F +CROOT_PROF levdcmp profile for litter C and N inputs from coarse roots 1/m F +CWD_C_TO_LIT_CEL_C_vr levdcmp decomp. of coarse woody debris C to cellulosic litter C gC/m^3/s F +CWD_C_TO_LIT_LIG_C_vr levdcmp decomp. of coarse woody debris C to lignin litter C gC/m^3/s F +CWD_HR_L2_vr levdcmp Het. Resp. from coarse woody debris gC/m^3/s F +CWD_HR_L3_vr levdcmp Het. Resp. from coarse woody debris gC/m^3/s F +CWD_N_TO_LIT_CEL_N_vr levdcmp decomp. of coarse woody debris N to cellulosic litter N gN/m^3 F +CWD_N_TO_LIT_LIG_N_vr levdcmp decomp. of coarse woody debris N to lignin litter N gN/m^3 F +CWD_N_vr levdcmp CWD N (vertically resolved) gN/m^3 T +CWD_PATHFRAC_L2_vr levdcmp PATHFRAC from coarse woody debris to cellulosic litter fraction F +CWD_PATHFRAC_L3_vr levdcmp PATHFRAC from coarse woody debris to lignin litter fraction F +CWD_RESP_FRAC_L2_vr levdcmp respired from coarse woody debris to cellulosic litter fraction F +CWD_RESP_FRAC_L3_vr levdcmp respired from coarse woody debris to lignin litter fraction F +DWT_DEADCROOTC_TO_CWDC levdcmp dead coarse root to CWD due to landcover change gC/m^2/s F +DWT_DEADCROOTN_TO_CWDN levdcmp dead coarse root to CWD due to landcover change gN/m^2/s F +DWT_FROOTC_TO_LIT_CEL_C levdcmp fine root to cellulosic litter due to landcover change gC/m^2/s F +DWT_FROOTC_TO_LIT_LIG_C levdcmp fine root to lignin litter due to landcover change gC/m^2/s F +DWT_FROOTC_TO_LIT_MET_C levdcmp fine root to metabolic litter due to landcover change gC/m^2/s F +DWT_FROOTN_TO_LIT_CEL_N levdcmp fine root N to cellulosic litter due to landcover change gN/m^2/s F +DWT_FROOTN_TO_LIT_LIG_N levdcmp fine root N to lignin litter due to landcover change gN/m^2/s F +DWT_FROOTN_TO_LIT_MET_N levdcmp fine root N to metabolic litter due to landcover change gN/m^2/s F +DWT_LIVECROOTC_TO_CWDC levdcmp live coarse root to CWD due to landcover change gC/m^2/s F +DWT_LIVECROOTN_TO_CWDN levdcmp live coarse root to CWD due to landcover change gN/m^2/s F +FMAX_DENIT_CARBONSUBSTRATE levdcmp FMAX_DENIT_CARBONSUBSTRATE gN/m^3/s F +FMAX_DENIT_NITRATE levdcmp FMAX_DENIT_NITRATE gN/m^3/s F +FPI_vr levdcmp fraction of potential immobilization proportion F +FROOT_PROF levdcmp profile for litter C and N inputs from fine roots 1/m F +F_DENIT_BASE levdcmp F_DENIT_BASE gN/m^3/s F +F_DENIT_vr levdcmp denitrification flux gN/m^3/s F +F_NIT_vr levdcmp nitrification flux gN/m^3/s F +GROSS_NMIN_vr levdcmp gross rate of N mineralization gN/m^3/s F +K_CWD levdcmp coarse woody debris potential loss coefficient 1/s F +K_LIT_CEL levdcmp cellulosic litter potential loss coefficient 1/s F +K_LIT_LIG levdcmp lignin litter potential loss coefficient 1/s F +K_LIT_MET levdcmp metabolic litter potential loss coefficient 1/s F +K_NITR levdcmp K_NITR 1/s F +K_NITR_H2O levdcmp K_NITR_H2O unitless F +K_NITR_PH levdcmp K_NITR_PH unitless F +K_NITR_T levdcmp K_NITR_T unitless F +K_SOM_ACT levdcmp active soil organic potential loss coefficient 1/s F +K_SOM_PAS levdcmp passive soil organic potential loss coefficient 1/s F +K_SOM_SLO levdcmp slow soil organic ma potential loss coefficient 1/s F +L1_PATHFRAC_S1_vr levdcmp PATHFRAC from metabolic litter to active soil organic fraction F +L1_RESP_FRAC_S1_vr levdcmp respired from metabolic litter to active soil organic fraction F +L2_PATHFRAC_S1_vr levdcmp PATHFRAC from cellulosic litter to active soil organic fraction F +L2_RESP_FRAC_S1_vr levdcmp respired from cellulosic litter to active soil organic fraction F +L3_PATHFRAC_S2_vr levdcmp PATHFRAC from lignin litter to slow soil organic ma fraction F +L3_RESP_FRAC_S2_vr levdcmp respired from lignin litter to slow soil organic ma fraction F +LEAF_PROF levdcmp profile for litter C and N inputs from leaves 1/m F +LIT_CEL_C_TNDNCY_VERT_TR levdcmp cellulosic litter C tendency due to vertical transport gC/m^3/s F +LIT_CEL_C_TO_SOM_ACT_C_v levdcmp decomp. of cellulosic litter C to active soil organic C gC/m^3/s F +LIT_CEL_HR_vr levdcmp Het. Resp. from cellulosic litter gC/m^3/s F +LIT_CEL_N_TNDNCY_VERT_TR levdcmp cellulosic litter N tendency due to vertical transport gN/m^3/s F +LIT_CEL_N_TO_SOM_ACT_N_v levdcmp decomp. of cellulosic litter N to active soil organic N gN/m^3 F +LIT_CEL_N_vr levdcmp LIT_CEL N (vertically resolved) gN/m^3 T +LIT_LIG_C_TNDNCY_VERT_TR levdcmp lignin litter C tendency due to vertical transport gC/m^3/s F +LIT_LIG_C_TO_SOM_SLO_C_v levdcmp decomp. of lignin litter C to slow soil organic ma C gC/m^3/s F +LIT_LIG_HR_vr levdcmp Het. Resp. from lignin litter gC/m^3/s F +LIT_LIG_N_TNDNCY_VERT_TR levdcmp lignin litter N tendency due to vertical transport gN/m^3/s F +LIT_LIG_N_TO_SOM_SLO_N_v levdcmp decomp. of lignin litter N to slow soil organic ma N gN/m^3 F +LIT_LIG_N_vr levdcmp LIT_LIG N (vertically resolved) gN/m^3 T +LIT_MET_C_TNDNCY_VERT_TR levdcmp metabolic litter C tendency due to vertical transport gC/m^3/s F +LIT_MET_C_TO_SOM_ACT_C_v levdcmp decomp. of metabolic litter C to active soil organic C gC/m^3/s F +LIT_MET_HR_vr levdcmp Het. Resp. from metabolic litter gC/m^3/s F +LIT_MET_N_TNDNCY_VERT_TR levdcmp metabolic litter N tendency due to vertical transport gN/m^3/s F +LIT_MET_N_TO_SOM_ACT_N_v levdcmp decomp. of metabolic litter N to active soil organic N gN/m^3 F +LIT_MET_N_vr levdcmp LIT_MET N (vertically resolved) gN/m^3 T +M_CWD_C_TO_FIRE_vr levdcmp coarse woody debris C fire loss gC/m^3/s F +M_CWD_N_TO_FIRE_vr levdcmp coarse woody debris N fire loss gN/m^3 F +M_LIT_CEL_C_TO_FIRE_vr levdcmp cellulosic litter C fire loss gC/m^3/s F +M_LIT_CEL_N_TO_FIRE_vr levdcmp cellulosic litter N fire loss gN/m^3 F +M_LIT_LIG_C_TO_FIRE_vr levdcmp lignin litter C fire loss gC/m^3/s F +M_LIT_LIG_N_TO_FIRE_vr levdcmp lignin litter N fire loss gN/m^3 F +M_LIT_MET_C_TO_FIRE_vr levdcmp metabolic litter C fire loss gC/m^3/s F +M_LIT_MET_N_TO_FIRE_vr levdcmp metabolic litter N fire loss gN/m^3 F +NDEP_PROF levdcmp profile for atmospheric N deposition 1/m F +NET_NMIN_vr levdcmp net rate of N mineralization gN/m^3/s F +NFIXATION_PROF levdcmp profile for biological N fixation 1/m F +POTENTIAL_IMMOB_vr levdcmp potential N immobilization gN/m^3/s F +POT_F_DENIT_vr levdcmp potential denitrification flux gN/m^3/s F +POT_F_NIT_vr levdcmp potential nitrification flux gN/m^3/s F +S1_PATHFRAC_S2_vr levdcmp PATHFRAC from active soil organic to slow soil organic ma fraction F +S1_PATHFRAC_S3_vr levdcmp PATHFRAC from active soil organic to passive soil organic fraction F +S1_RESP_FRAC_S2_vr levdcmp respired from active soil organic to slow soil organic ma fraction F +S1_RESP_FRAC_S3_vr levdcmp respired from active soil organic to passive soil organic fraction F +S2_PATHFRAC_S1_vr levdcmp PATHFRAC from slow soil organic ma to active soil organic fraction F +S2_PATHFRAC_S3_vr levdcmp PATHFRAC from slow soil organic ma to passive soil organic fraction F +S2_RESP_FRAC_S1_vr levdcmp respired from slow soil organic ma to active soil organic fraction F +S2_RESP_FRAC_S3_vr levdcmp respired from slow soil organic ma to passive soil organic fraction F +S3_PATHFRAC_S1_vr levdcmp PATHFRAC from passive soil organic to active soil organic fraction F +S3_RESP_FRAC_S1_vr levdcmp respired from passive soil organic to active soil organic fraction F +SMINN_TO_PLANT_vr levdcmp plant uptake of soil mineral N gN/m^3/s F +SMINN_TO_S1N_L1_vr levdcmp mineral N flux for decomp. of LIT_METto SOM_ACT gN/m^3 F +SMINN_TO_S1N_L2_vr levdcmp mineral N flux for decomp. of LIT_CELto SOM_ACT gN/m^3 F +SMINN_TO_S1N_S2_vr levdcmp mineral N flux for decomp. of SOM_SLOto SOM_ACT gN/m^3 F +SMINN_TO_S1N_S3_vr levdcmp mineral N flux for decomp. of SOM_PASto SOM_ACT gN/m^3 F +SMINN_TO_S2N_L3_vr levdcmp mineral N flux for decomp. of LIT_LIGto SOM_SLO gN/m^3 F +SMINN_TO_S2N_S1_vr levdcmp mineral N flux for decomp. of SOM_ACTto SOM_SLO gN/m^3 F +SMINN_TO_S3N_S1_vr levdcmp mineral N flux for decomp. of SOM_ACTto SOM_PAS gN/m^3 F +SMINN_TO_S3N_S2_vr levdcmp mineral N flux for decomp. of SOM_SLOto SOM_PAS gN/m^3 F +SMIN_NH4_TO_PLANT levdcmp plant uptake of NH4 gN/m^3/s F +SMIN_NO3_LEACHED_vr levdcmp soil NO3 pool loss to leaching gN/m^3/s F +SMIN_NO3_MASSDENS levdcmp SMIN_NO3_MASSDENS ugN/cm^3 soil F +SMIN_NO3_RUNOFF_vr levdcmp soil NO3 pool loss to runoff gN/m^3/s F +SMIN_NO3_TO_PLANT levdcmp plant uptake of NO3 gN/m^3/s F +SOILN_vr levdcmp SOIL N (vertically resolved) gN/m^3 T +SOM_ACT_C_TNDNCY_VERT_TR levdcmp active soil organic C tendency due to vertical transport gC/m^3/s F +SOM_ACT_C_TO_SOM_PAS_C_v levdcmp decomp. of active soil organic C to passive soil organic C gC/m^3/s F +SOM_ACT_C_TO_SOM_SLO_C_v levdcmp decomp. of active soil organic C to slow soil organic ma C gC/m^3/s F +SOM_ACT_HR_S2_vr levdcmp Het. Resp. from active soil organic gC/m^3/s F +SOM_ACT_HR_S3_vr levdcmp Het. Resp. from active soil organic gC/m^3/s F +SOM_ACT_N_TNDNCY_VERT_TR levdcmp active soil organic N tendency due to vertical transport gN/m^3/s F +SOM_ACT_N_TO_SOM_PAS_N_v levdcmp decomp. of active soil organic N to passive soil organic N gN/m^3 F +SOM_ACT_N_TO_SOM_SLO_N_v levdcmp decomp. of active soil organic N to slow soil organic ma N gN/m^3 F +SOM_ACT_N_vr levdcmp SOM_ACT N (vertically resolved) gN/m^3 T +SOM_ADV_COEF levdcmp advection term for vertical SOM translocation m/s F +SOM_DIFFUS_COEF levdcmp diffusion coefficient for vertical SOM translocation m^2/s F +SOM_PAS_C_TNDNCY_VERT_TR levdcmp passive soil organic C tendency due to vertical transport gC/m^3/s F +SOM_PAS_C_TO_SOM_ACT_C_v levdcmp decomp. of passive soil organic C to active soil organic C gC/m^3/s F +SOM_PAS_HR_vr levdcmp Het. Resp. from passive soil organic gC/m^3/s F +SOM_PAS_N_TNDNCY_VERT_TR levdcmp passive soil organic N tendency due to vertical transport gN/m^3/s F +SOM_PAS_N_TO_SOM_ACT_N_v levdcmp decomp. of passive soil organic N to active soil organic N gN/m^3 F +SOM_PAS_N_vr levdcmp SOM_PAS N (vertically resolved) gN/m^3 T +SOM_SLO_C_TNDNCY_VERT_TR levdcmp slow soil organic ma C tendency due to vertical transport gC/m^3/s F +SOM_SLO_C_TO_SOM_ACT_C_v levdcmp decomp. of slow soil organic ma C to active soil organic C gC/m^3/s F +SOM_SLO_C_TO_SOM_PAS_C_v levdcmp decomp. of slow soil organic ma C to passive soil organic C gC/m^3/s F +SOM_SLO_HR_S1_vr levdcmp Het. Resp. from slow soil organic ma gC/m^3/s F +SOM_SLO_HR_S3_vr levdcmp Het. Resp. from slow soil organic ma gC/m^3/s F +SOM_SLO_N_TNDNCY_VERT_TR levdcmp slow soil organic ma N tendency due to vertical transport gN/m^3/s F +SOM_SLO_N_TO_SOM_ACT_N_v levdcmp decomp. of slow soil organic ma N to active soil organic N gN/m^3 F +SOM_SLO_N_TO_SOM_PAS_N_v levdcmp decomp. of slow soil organic ma N to passive soil organic N gN/m^3 F +SOM_SLO_N_vr levdcmp SOM_SLO N (vertically resolved) gN/m^3 T +STEM_PROF levdcmp profile for litter C and N inputs from stems 1/m F +SUPPLEMENT_TO_SMINN_vr levdcmp supplemental N supply gN/m^3/s F +WFPS levdcmp WFPS percent F +anaerobic_frac levdcmp anaerobic_frac m3/m3 F diffus levdcmp diffusivity m^2/s F fr_WFPS levdcmp fr_WFPS fraction F n2_n2o_ratio_denit levdcmp n2_n2o_ratio_denit gN/gN F -num_iter - number of iterations unitless F r_psi levdcmp r_psi m F ratio_k1 levdcmp ratio_k1 none F ratio_no3_co2 levdcmp ratio_no3_co2 ratio F soil_bulkdensity levdcmp soil_bulkdensity kg/m3 F soil_co2_prod levdcmp soil_co2_prod ug C / g soil / day F +CONC_CH4_SAT levgrnd CH4 soil Concentration for inundated / lake area mol/m3 F +CONC_CH4_UNSAT levgrnd CH4 soil Concentration for non-inundated area mol/m3 F +EFF_POROSITY levgrnd effective porosity = porosity - vol_ice proportion F +FGR_SOIL_R levgrnd Rural downward heat flux at interface below each soil layer watt/m^2 F +FRAC_ICEOLD levgrnd fraction of ice relative to the tot water proportion F +HK levgrnd hydraulic conductivity (natural vegetated and crop landunits only) mm/s F +O2_DECOMP_DEPTH_UNSAT levgrnd O2 consumption from HR and AR for non-inundated area mol/m3/s F +ROOTR levgrnd effective fraction of roots in each soil layer (SMS method) proportion F +RRESIS levgrnd root resistance in each soil layer proportion F +SMP levgrnd soil matric potential (natural vegetated and crop landunits only) mm T +SOILPSI levgrnd soil water potential in each soil layer MPa F +TSOI levgrnd soil temperature (natural vegetated and crop landunits only) K T +TSOI_ICE levgrnd soil temperature (ice landunits only) K T +bsw levgrnd clap and hornberger B unitless F watfc levgrnd water field capacity m^3/m^3 F watsat levgrnd water saturated m^3/m^3 F +LAKEICEFRAC levlak lake layer ice mass fraction unitless F +TLAKE levlak lake temperature K T +SNO_ABS levsno Absorbed solar radiation in each snow layer W/m^2 F +SNO_ABS_ICE levsno Absorbed solar radiation in each snow layer (ice landunits only) W/m^2 F +SNO_BW levsno Partial density of water in the snow pack (ice + liquid) kg/m3 F +SNO_BW_ICE levsno Partial density of water in the snow pack (ice + liquid, ice landunits only) kg/m3 F +SNO_EXISTENCE levsno Fraction of averaging period for which each snow layer existed unitless F +SNO_FRZ levsno snow freezing rate in each snow layer kg/m2/s F +SNO_FRZ_ICE levsno snow freezing rate in each snow layer (ice landunits only) mm/s F +SNO_GS levsno Mean snow grain size Microns F +SNO_GS_ICE levsno Mean snow grain size (ice landunits only) Microns F +SNO_ICE levsno Snow ice content kg/m2 F +SNO_LIQH2O levsno Snow liquid water content kg/m2 F +SNO_MELT levsno snow melt rate in each snow layer mm/s F +SNO_MELT_ICE levsno snow melt rate in each snow layer (ice landunits only) mm/s F +SNO_T levsno Snow temperatures K F +SNO_TK levsno Thermal conductivity W/m-K F +SNO_TK_ICE levsno Thermal conductivity (ice landunits only) W/m-K F +SNO_T_ICE levsno Snow temperatures (ice landunits only) K F +SNO_Z levsno Snow layer thicknesses m F +SNO_Z_ICE levsno Snow layer thicknesses (ice landunits only) m F +CONC_O2_SAT levsoi O2 soil Concentration for inundated / lake area mol/m3 T +CONC_O2_UNSAT levsoi O2 soil Concentration for non-inundated area mol/m3 T +CWD_C_vr levsoi CWD C (vertically resolved) gC/m^3 T +H2OSOI levsoi volumetric soil water (natural vegetated and crop landunits only) mm3/mm3 T +HR_vr levsoi total vertically resolved heterotrophic respiration gC/m^3/s T +KROOT levsoi root conductance each soil layer 1/s F +KSOIL levsoi soil conductance in each soil layer 1/s F +LIT_CEL_C_vr levsoi LIT_CEL C (vertically resolved) gC/m^3 T +LIT_LIG_C_vr levsoi LIT_LIG C (vertically resolved) gC/m^3 T +LIT_MET_C_vr levsoi LIT_MET C (vertically resolved) gC/m^3 T +O_SCALAR levsoi fraction by which decomposition is reduced due to anoxia unitless T +QROOTSINK levsoi water flux from soil to root in each soil-layer mm/s F +SMINN_vr levsoi soil mineral N gN/m^3 T +SMIN_NH4_vr levsoi soil mineral NH4 (vert. res.) gN/m^3 T +SMIN_NO3_vr levsoi soil mineral NO3 (vert. res.) gN/m^3 T +SOILC_vr levsoi SOIL C (vertically resolved) gC/m^3 T +SOILICE levsoi soil ice (natural vegetated and crop landunits only) kg/m2 T +SOILLIQ levsoi soil liquid water (natural vegetated and crop landunits only) kg/m2 T +SOM_ACT_C_vr levsoi SOM_ACT C (vertically resolved) gC/m^3 T +SOM_PAS_C_vr levsoi SOM_PAS C (vertically resolved) gC/m^3 T +SOM_SLO_C_vr levsoi SOM_SLO C (vertically resolved) gC/m^3 T +T_SCALAR levsoi temperature inhibition of decomposition unitless T +W_SCALAR levsoi Moisture (dryness) inhibition of decomposition unitless T +GDDACCUM_PERHARV mxharvests At-harvest accumulated growing degree days past planting date for crop; should only be output ddays F +GDDHARV_PERHARV mxharvests Growing degree days (gdd) needed to harvest; should only be output annually ddays F +GRAINC_TO_FOOD_PERHARV mxharvests grain C to food per harvest; should only be output annually gC/m^2 F +HARVEST_REASON_PERHARV mxharvests Reason for each crop harvest; should only be output annually 1 = mature; 2 = max season length; 3 = incorrect Dec. 31 sowing; F +HDATES mxharvests actual crop harvest dates; should only be output annually day of year F +HUI_PERHARV mxharvests At-harvest accumulated heat unit index for crop; should only be output annually ddays F +SDATES_PERHARV mxharvests actual sowing dates for crops harvested this year; should only be output annually day of year F +SOWING_REASON_PERHARV mxharvests Reason for sowing of each crop harvested this year; should only be output annually unitless F +SYEARS_PERHARV mxharvests actual sowing years for crops harvested this year; should only be output annually year F +SDATES mxsowings actual crop sowing dates; should only be output annually day of year F +SOWING_REASON mxsowings Reason for each crop sowing; should only be output annually unitless F +ALBD numrad surface albedo (direct) proportion F +ALBGRD numrad ground albedo (direct) proportion F +ALBGRI numrad ground albedo (indirect) proportion F +ALBI numrad surface albedo (indirect) proportion F +VEGWP nvegwcs vegetation water matric potential for sun/sha canopy,xyl,root segments mm T +VEGWPLN nvegwcs vegetation water matric potential for sun/sha canopy,xyl,root at local noon mm T +VEGWPPD nvegwcs predawn vegetation water matric potential for sun/sha canopy,xyl,root mm T =================================== ================ ============================================================================================== ================================================================= ======= From 2ef13f5ef2e6d9c24f204450fff21d5e10d416b2 Mon Sep 17 00:00:00 2001 From: adrifoster Date: Thu, 24 Aug 2023 11:09:01 -0600 Subject: [PATCH 209/257] add check to namelist --- bld/CLMBuildNamelist.pm | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/bld/CLMBuildNamelist.pm b/bld/CLMBuildNamelist.pm index c4348eefd1..bd31fda9a4 100755 --- a/bld/CLMBuildNamelist.pm +++ b/bld/CLMBuildNamelist.pm @@ -3919,10 +3919,11 @@ sub setup_logic_lai_streams { } } else { # If bgc is CN/CNDV then make sure none of the LAI settings are set - if ( defined($nl->get_value('stream_year_first_lai')) || - defined($nl->get_value('stream_year_last_lai')) || - defined($nl->get_value('model_year_align_lai')) || - defined($nl->get_value('lai_tintalgo' )) || + if ( &value_is_true($nl->get_value('use_lai_streams')) || + defined($nl->get_value('stream_year_first_lai')) || + defined($nl->get_value('stream_year_last_lai')) || + defined($nl->get_value('model_year_align_lai')) || + defined($nl->get_value('lai_tintalgo' )) || defined($nl->get_value('stream_fldfilename_lai')) ) { $log->fatal_error("When bgc is NOT SP none of the following can be set: stream_year_first_lai,\n" . "stream_year_last_lai, model_year_align_lai, lai_tintalgo nor\n" . From 392dae6009eefd60c69cc26b3b1e939176adb1a5 Mon Sep 17 00:00:00 2001 From: adrifoster Date: Thu, 24 Aug 2023 11:13:21 -0600 Subject: [PATCH 210/257] update error note --- bld/CLMBuildNamelist.pm | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/bld/CLMBuildNamelist.pm b/bld/CLMBuildNamelist.pm index bd31fda9a4..97e1e5955e 100755 --- a/bld/CLMBuildNamelist.pm +++ b/bld/CLMBuildNamelist.pm @@ -3927,7 +3927,8 @@ sub setup_logic_lai_streams { defined($nl->get_value('stream_fldfilename_lai')) ) { $log->fatal_error("When bgc is NOT SP none of the following can be set: stream_year_first_lai,\n" . "stream_year_last_lai, model_year_align_lai, lai_tintalgo nor\n" . - "stream_fldfilename_lai (eg. don't use this option with BGC,CN,CNDV nor BGDCV)."); + "stream_fldfilename_lai and use_lai_streams can't be .true.\n" . + "(eg. don't use this option with BGC,CN,CNDV nor BGDCV)."); } } } From 087000472ea0c63be11a9e2dc864a65c016bf6d7 Mon Sep 17 00:00:00 2001 From: adrifoster Date: Thu, 24 Aug 2023 11:19:06 -0600 Subject: [PATCH 211/257] make separate error --- bld/CLMBuildNamelist.pm | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) diff --git a/bld/CLMBuildNamelist.pm b/bld/CLMBuildNamelist.pm index 97e1e5955e..d979585444 100755 --- a/bld/CLMBuildNamelist.pm +++ b/bld/CLMBuildNamelist.pm @@ -3919,16 +3919,18 @@ sub setup_logic_lai_streams { } } else { # If bgc is CN/CNDV then make sure none of the LAI settings are set - if ( &value_is_true($nl->get_value('use_lai_streams')) || - defined($nl->get_value('stream_year_first_lai')) || + if ( &value_is_true($nl->get_value('use_lai_streams'))) { + $log->fatal_error("When bgc is NOT SP use_lai_streams cannot be .true.\n" . + "(eg. don't use this option with BGC,CN,CNDV nor BGDCV)."); + } + if ( defined($nl->get_value('stream_year_first_lai')) || defined($nl->get_value('stream_year_last_lai')) || defined($nl->get_value('model_year_align_lai')) || defined($nl->get_value('lai_tintalgo' )) || defined($nl->get_value('stream_fldfilename_lai')) ) { $log->fatal_error("When bgc is NOT SP none of the following can be set: stream_year_first_lai,\n" . "stream_year_last_lai, model_year_align_lai, lai_tintalgo nor\n" . - "stream_fldfilename_lai and use_lai_streams can't be .true.\n" . - "(eg. don't use this option with BGC,CN,CNDV nor BGDCV)."); + "stream_fldfilename_lai (eg. don't use this option with BGC,CN,CNDV nor BGDCV)."); } } } From ae3f73830f2827ce9e5e3a6962685293c13d5baf Mon Sep 17 00:00:00 2001 From: adrifoster Date: Thu, 24 Aug 2023 11:21:06 -0600 Subject: [PATCH 212/257] get rid of use_lai_streams=true, user_nl_clm empty to deleted --- .../testmods_dirs/clm/datm_bias_correct_cruv7/user_nl_clm | 1 - 1 file changed, 1 deletion(-) delete mode 100644 cime_config/testdefs/testmods_dirs/clm/datm_bias_correct_cruv7/user_nl_clm diff --git a/cime_config/testdefs/testmods_dirs/clm/datm_bias_correct_cruv7/user_nl_clm b/cime_config/testdefs/testmods_dirs/clm/datm_bias_correct_cruv7/user_nl_clm deleted file mode 100644 index c7cfe279ee..0000000000 --- a/cime_config/testdefs/testmods_dirs/clm/datm_bias_correct_cruv7/user_nl_clm +++ /dev/null @@ -1 +0,0 @@ -use_lai_streams = .true. From 1ee1979953429023bb50b56fae228adb068c7ea8 Mon Sep 17 00:00:00 2001 From: adrifoster Date: Thu, 24 Aug 2023 11:26:58 -0600 Subject: [PATCH 213/257] remove cn/cndv --- bld/CLMBuildNamelist.pm | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/bld/CLMBuildNamelist.pm b/bld/CLMBuildNamelist.pm index d979585444..3e3ab0e266 100755 --- a/bld/CLMBuildNamelist.pm +++ b/bld/CLMBuildNamelist.pm @@ -3918,10 +3918,10 @@ sub setup_logic_lai_streams { } } } else { - # If bgc is CN/CNDV then make sure none of the LAI settings are set + # If bgc is BGC/BGCDV then make sure none of the LAI settings are set if ( &value_is_true($nl->get_value('use_lai_streams'))) { $log->fatal_error("When bgc is NOT SP use_lai_streams cannot be .true.\n" . - "(eg. don't use this option with BGC,CN,CNDV nor BGDCV)."); + "(eg. don't use this option with BGC or BGCDV)."); } if ( defined($nl->get_value('stream_year_first_lai')) || defined($nl->get_value('stream_year_last_lai')) || @@ -3930,7 +3930,7 @@ sub setup_logic_lai_streams { defined($nl->get_value('stream_fldfilename_lai')) ) { $log->fatal_error("When bgc is NOT SP none of the following can be set: stream_year_first_lai,\n" . "stream_year_last_lai, model_year_align_lai, lai_tintalgo nor\n" . - "stream_fldfilename_lai (eg. don't use this option with BGC,CN,CNDV nor BGDCV)."); + "stream_fldfilename_lai (eg. don't use this option with BGC or BGCDV)."); } } } From 01c208da730eca335f0c24af602dd128ae107093 Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Fri, 25 Aug 2023 14:46:48 -0600 Subject: [PATCH 214/257] Update ChangeLog --- doc/ChangeLog | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/doc/ChangeLog b/doc/ChangeLog index 8ab05d1a15..ab2b760ecb 100644 --- a/doc/ChangeLog +++ b/doc/ChangeLog @@ -1,7 +1,7 @@ =============================================================== Tag name: ctsm5.1.dev138 Originator(s): slevis (Samuel Levis,UCAR/TSS,303-665-1310) -Date: Thu Aug 24 12:33:20 MDT 2023 +Date: Fri Aug 25 14:44:22 MDT 2023 One-line Summary: Refactor max_patch_per_col and maxsoil_patches loops Purpose and description of changes @@ -31,7 +31,7 @@ Does this tag change answers significantly for any of the following physics conf Bugs fixed or introduced ------------------------ CTSM issues fixed (include CTSM Issue #): -Fixes #2025 +Fixes #2025 "Refactor loops that use max_patch_per_col?" Testing summary: ---------------- From ce8ccf3e11c92ffbf942c8ded2efc1cbad165804 Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Fri, 25 Aug 2023 16:54:10 -0600 Subject: [PATCH 215/257] Draft ChangeLog/ChangeSum --- doc/ChangeLog | 59 +++++++++++++++++++++++++++++++++++++++++++++++++++ doc/ChangeSum | 1 + 2 files changed, 60 insertions(+) diff --git a/doc/ChangeLog b/doc/ChangeLog index ab2b760ecb..0a9515ff93 100644 --- a/doc/ChangeLog +++ b/doc/ChangeLog @@ -1,4 +1,63 @@ =============================================================== +Tag name: ctsm5.1.dev139 +Originator(s): slevis (Samuel Levis) +Date: Fri Aug 25 16:47:45 MDT 2023 +One-line Summary: Fix problems uncovered by nag -nan tests + +Purpose and description of changes +---------------------------------- + + Fix problems uncovered by adding the -nan compilation flag for the Nag + compiler. + + +Significant changes to scientifically-supported configurations +-------------------------------------------------------------- + +Does this tag change answers significantly for any of the following physics configurations? +(Details of any changes will be given in the "Answer changes" section below.) + + [Put an [X] in the box for any configuration with significant answer changes.] + +[ ] clm5_1 + +[ ] clm5_0 + +[ ] ctsm5_0-nwp + +[ ] clm4_5 + + +Bugs fixed or introduced +------------------------ +CTSM issues fixed (include CTSM Issue #): + Makes progress on issue #1994 (same title) + + +Testing summary: +---------------- + + [PASS means all tests PASS; OK means tests PASS other than expected fails.] + + regular tests (aux_clm: https://github.com/ESCOMP/CTSM/wiki/System-Testing-Guide#pre-merge-system-testing): + + cheyenne ---- OK + izumi ------- PASS + + +Answer changes +-------------- + +Changes answers relative to baseline: No + + +Other details +------------- +Pull Requests that document the changes (include PR ids): + https://github.com/ESCOMP/ctsm/pull/2051 + +=============================================================== +=============================================================== Tag name: ctsm5.1.dev138 Originator(s): slevis (Samuel Levis,UCAR/TSS,303-665-1310) Date: Fri Aug 25 14:44:22 MDT 2023 diff --git a/doc/ChangeSum b/doc/ChangeSum index 0d9e4d3745..4ac0f90f5e 100644 --- a/doc/ChangeSum +++ b/doc/ChangeSum @@ -1,5 +1,6 @@ Tag Who Date Summary ============================================================================================================================ + ctsm5.1.dev139 slevis 08/28/2023 Fix problems uncovered by nag -nan tests ctsm5.1.dev138 slevis 08/25/2023 Refactor max_patch_per_col and maxsoil_patches loops ctsm5.1.dev137 slevis 08/23/2023 Surface roughness modifications ctsm5.1.dev136 multiple 08/22/2023 Change order of history fields to improve performance on derecho From 696cf9a7b2b25411e4990146b9f3e2fdca473a7f Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Mon, 28 Aug 2023 10:44:31 -0600 Subject: [PATCH 216/257] Reworded comments as recommended by Erik Kluzek --- src/biogeophys/FrictionVelocityMod.F90 | 11 +++++++---- src/biogeophys/PhotosynthesisMod.F90 | 22 +++++++++++++++++----- 2 files changed, 24 insertions(+), 9 deletions(-) diff --git a/src/biogeophys/FrictionVelocityMod.F90 b/src/biogeophys/FrictionVelocityMod.F90 index b25f18fb1c..7cea2a22f9 100644 --- a/src/biogeophys/FrictionVelocityMod.F90 +++ b/src/biogeophys/FrictionVelocityMod.F90 @@ -750,10 +750,13 @@ subroutine FrictionVelocity(this, lbn, ubn, fn, filtern, & real(r8) , intent(in) :: ur ( lbn: ) ! wind speed at reference height [m/s] [lbn:ubn] real(r8) , intent(in) :: um ( lbn: ) ! wind speed including the stablity effect [m/s] [lbn:ubn] real(r8) , intent(out) :: ustar ( lbn: ) ! friction velocity [m/s] [lbn:ubn] - real(r8) , intent(inout) :: temp1 ( lbn: ) ! relation for potential temperature profile [lbn:ubn] (inout instead of out to prevent returning nan) - real(r8) , intent(inout) :: temp12m ( lbn: ) ! relation for potential temperature profile applied at 2-m [lbn:ubn] (inout instead of out to prevent returning nan) - real(r8) , intent(inout) :: temp2 ( lbn: ) ! relation for specific humidity profile [lbn:ubn] (inout instead of out to prevent returning nan) - real(r8) , intent(inout) :: temp22m ( lbn: ) ! relation for specific humidity profile applied at 2-m [lbn:ubn] (inout instead of out to prevent returning nan) + ! temp1, temp12m, temp2, temp22m are "inout" rather than "out" to + ! prevent returning nan when the code returns from this subroutine + ! before assigning values to these variables + real(r8) , intent(inout) :: temp1 ( lbn: ) ! relation for potential temperature profile [lbn:ubn] + real(r8) , intent(inout) :: temp12m ( lbn: ) ! relation for potential temperature profile applied at 2-m [lbn:ubn] + real(r8) , intent(inout) :: temp2 ( lbn: ) ! relation for specific humidity profile [lbn:ubn] + real(r8) , intent(inout) :: temp22m ( lbn: ) ! relation for specific humidity profile applied at 2-m [lbn:ubn] real(r8) , intent(inout) :: fm ( lbn: ) ! diagnose 10m wind (DUST only) [lbn:ubn] logical , intent(in), optional :: landunit_index ! optional argument that defines landunit or pft level ! diff --git a/src/biogeophys/PhotosynthesisMod.F90 b/src/biogeophys/PhotosynthesisMod.F90 index 0d14909fbf..6176668f19 100644 --- a/src/biogeophys/PhotosynthesisMod.F90 +++ b/src/biogeophys/PhotosynthesisMod.F90 @@ -2266,7 +2266,10 @@ subroutine hybrid(x0, p, iv, c, gb_mol, je, cair, oair, lmr_z, par_z,& real(r8), intent(in) :: cair ! Atmospheric CO2 partial pressure (Pa) real(r8), intent(in) :: oair ! Atmospheric O2 partial pressure (Pa) integer, intent(in) :: p, iv, c ! pft, c3/c4, and column index - real(r8), intent(inout) :: gs_mol ! leaf stomatal conductance (umol H2O/m**2/s) (inout instead of out to prevent returning nan) + ! gs_mol is "inout" rather than "out" to + ! prevent returning nan when the code returns from this subroutine + ! before assigning a value to this variable + real(r8), intent(inout) :: gs_mol ! leaf stomatal conductance (umol H2O/m**2/s) integer, intent(out) :: iter !number of iterations used, for record only type(atm2lnd_type) , intent(in) :: atm2lnd_inst type(photosyns_type), intent(inout) :: photosyns_inst @@ -2378,7 +2381,10 @@ subroutine brent(x, x1,x2,f1, f2, tol, ip, iv, ic, gb_mol, je, cair, oair,& real(r8), intent(in) :: oair ! Atmospheric O2 partial pressure (Pa) real(r8), intent(in) :: rh_can ! inside canopy relative humidity integer, intent(in) :: ip, iv, ic ! pft, c3/c4, and column index - real(r8), intent(inout) :: gs_mol ! leaf stomatal conductance (umol H2O/m**2/s) (inout instead of out to prevent returning nan) + ! gs_mol is "inout" rather than "out" to + ! prevent returning nan when the code returns from this subroutine + ! before assigning a value to this variable + real(r8), intent(inout) :: gs_mol ! leaf stomatal conductance (umol H2O/m**2/s) type(atm2lnd_type) , intent(in) :: atm2lnd_inst type(photosyns_type), intent(inout) :: photosyns_inst ! @@ -2568,7 +2574,10 @@ subroutine ci_func(ci, fval, p, iv, c, gb_mol, je, cair, oair, lmr_z, par_z,& real(r8) , intent(in) :: rh_can ! canopy air realtive humidity integer , intent(in) :: p, iv, c ! pft, vegetation type and column indexes real(r8) , intent(out) :: fval ! return function of the value f(ci) - real(r8) , intent(inout) :: gs_mol ! leaf stomatal conductance (umol H2O/m**2/s) (inout instead of out to prevent returning nan) + ! gs_mol is "inout" rather than "out" to + ! prevent returning nan when the code returns from this subroutine + ! before assigning a value to this variable + real(r8) , intent(inout) :: gs_mol ! leaf stomatal conductance (umol H2O/m**2/s) type(atm2lnd_type) , intent(in) :: atm2lnd_inst type(photosyns_type) , intent(inout) :: photosyns_inst ! @@ -4064,8 +4073,11 @@ subroutine brent_PHS(xsun, x1sun, x2sun, f1sun, f2sun, xsha, x1sha, x2sha, f1sha real(r8), intent(in) :: lmr_z_sun, lmr_z_sha ! canopy layer: leaf maintenance respiration rate (umol CO2/m**2/s) real(r8), intent(in) :: par_z_sun, par_z_sha ! par absorbed per unit lai for canopy layer (w/m**2) real(r8), intent(in) :: rh_can ! inside canopy relative humidity - real(r8), intent(inout) :: gs_mol_sun ! sunlit leaf stomatal conductance (umol H2O/m**2/s) (inout instead of out to prevent returning nan) - real(r8), intent(inout) :: gs_mol_sha ! shaded leaf stomatal conductance (umol H2O/m**2/s) (inout instead of out to prevent returning nan) + ! gs_mol_s* are "inout" rather than "out" to + ! prevent returning nan when the code returns from this subroutine + ! before assigning values to these variables + real(r8), intent(inout) :: gs_mol_sun ! sunlit leaf stomatal conductance (umol H2O/m**2/s) + real(r8), intent(inout) :: gs_mol_sha ! shaded leaf stomatal conductance (umol H2O/m**2/s) real(r8), intent(inout) :: bsun ! sunlit canopy transpiration wetness factor (0 to 1) real(r8), intent(inout) :: bsha ! shaded canopy transpiration wetness factor (0 to 1) real(r8), intent(in) :: qsatl ! leaf specific humidity [kg/kg] From 1e2e2c35d9568c94eac6cb606f37c18294158682 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Mon, 28 Aug 2023 15:23:52 -0600 Subject: [PATCH 217/257] Add a note in README --- doc/README.CHECKLIST.master_tags | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/doc/README.CHECKLIST.master_tags b/doc/README.CHECKLIST.master_tags index 31c09895be..53540aaf37 100644 --- a/doc/README.CHECKLIST.master_tags +++ b/doc/README.CHECKLIST.master_tags @@ -55,6 +55,14 @@ https://github.com/ESCOMP/ctsm/wiki/CTSM-development-workflow ---- THE FOLLOWING CAN ONLY BE DONE BY INTEGRATORS ---- +NOTE (especially for new integrators): Be sure to follow the recommended +git setup in +. +Especially note that you should never use something like `git merge +escomp/master` to merge the upstream master branch into your local copy: +instead, you should always use `git pull` with the recommended +configuration settings (or `git merge --ff-only`) for that scenario. + (7) Merge the PR to master when review is approved (8) Compare master to branch show that they are identical From 6282180d9b75ccc3d799305f511f5f210b4cb2c4 Mon Sep 17 00:00:00 2001 From: Sam Rabin Date: Tue, 29 Aug 2023 15:48:59 -0600 Subject: [PATCH 218/257] FSURDATMODIFYCTSM now calls fsurdat_modifier directly. This avoids using subprocess.run(), which should hopefully reduce issues related to user environment. However, it does require that all the Python dependencies are loaded. This can be accomplished by activating the ctsm_pylib environment before calling run_sys_tests or cime/scripts/create_test. --- cime_config/SystemTests/fsurdatmodifyctsm.py | 27 ++++++++++++-------- 1 file changed, 17 insertions(+), 10 deletions(-) diff --git a/cime_config/SystemTests/fsurdatmodifyctsm.py b/cime_config/SystemTests/fsurdatmodifyctsm.py index d2a9c04312..083cdc2767 100644 --- a/cime_config/SystemTests/fsurdatmodifyctsm.py +++ b/cime_config/SystemTests/fsurdatmodifyctsm.py @@ -5,11 +5,18 @@ import os import re -import systemtest_utils as stu from CIME.SystemTests.system_tests_common import SystemTestsCommon from CIME.XML.standard_module_setup import * from CIME.SystemTests.test_utils.user_nl_utils import append_to_user_nl_files +# For calling fsurdat_modifier +from argparse import Namespace +_CTSM_PYTHON = os.path.join( + os.path.dirname(os.path.realpath(__file__)), os.pardir, os.pardir, "python" +) +sys.path.insert(1, _CTSM_PYTHON) +from ctsm.modify_input_files.fsurdat_modifier import fsurdat_modifier + logger = logging.getLogger(__name__) @@ -66,16 +73,16 @@ def _create_config_file(self): cfg_out.write(line) def _run_modify_fsurdat(self): - tool_path = os.path.join(self._ctsm_root, "tools/modify_input_files/fsurdat_modifier") - - self._case.load_env(reset=True) - command = f"python3 {tool_path} {self._cfg_file_path}" - stu.run_python_script( - self._get_caseroot(), - "ctsm_pylib", - command, - tool_path, + fsurdat_modifier_args = Namespace( + cfg_path=self._cfg_file_path, + debug=False, + fsurdat_in="UNSET", + fsurdat_out="UNSET", + overwrite=False, + silent=False, + verbose=False, ) + fsurdat_modifier(fsurdat_modifier_args) def _modify_user_nl(self): append_to_user_nl_files( From 376b66b90fa5348d9d30b241394ccad0cd5bad5c Mon Sep 17 00:00:00 2001 From: Sam Rabin Date: Thu, 31 Aug 2023 16:51:10 -0600 Subject: [PATCH 219/257] run_sys_tests: Check availability of modules needed for some SystemTests. Specifically, FSURDATMODIFYCTSM and RXCROPMATURITY. --- python/ctsm/crop_calendars/cropcal_module.py | 10 +++++--- python/ctsm/crop_calendars/generate_gdds.py | 13 +++++------ .../crop_calendars/generate_gdds_functions.py | 18 +++++++++------ python/ctsm/run_sys_tests.py | 23 +++++++++++++++++++ 4 files changed, 47 insertions(+), 17 deletions(-) diff --git a/python/ctsm/crop_calendars/cropcal_module.py b/python/ctsm/crop_calendars/cropcal_module.py index 73176431ba..1d58e2fbab 100644 --- a/python/ctsm/crop_calendars/cropcal_module.py +++ b/python/ctsm/crop_calendars/cropcal_module.py @@ -1,6 +1,3 @@ -# Import the CTSM Python utilities -import cropcal_utils as utils - import numpy as np import xarray as xr import warnings @@ -8,6 +5,13 @@ import os import glob +# Import the CTSM Python utilities +_CTSM_PYTHON = os.path.join( + os.path.dirname(os.path.realpath(__file__)), os.pardir, os.pardir, os.pardir, "python" +) +sys.path.insert(1, _CTSM_PYTHON) +import ctsm.crop_calendars.cropcal_utils as utils + try: import pandas as pd except: diff --git a/python/ctsm/crop_calendars/generate_gdds.py b/python/ctsm/crop_calendars/generate_gdds.py index 6000c12e41..9fe1c26e14 100644 --- a/python/ctsm/crop_calendars/generate_gdds.py +++ b/python/ctsm/crop_calendars/generate_gdds.py @@ -1,6 +1,3 @@ -# Import supporting functions -import generate_gdds_functions as gddfn - paramfile_dir = "/glade/p/cesmdata/cseg/inputdata/lnd/clm2/paramdata" # Import other shared functions @@ -8,10 +5,12 @@ import inspect import sys -currentdir = os.path.dirname(os.path.abspath(inspect.getfile(inspect.currentframe()))) -parentdir = os.path.dirname(currentdir) -sys.path.insert(0, parentdir) -import cropcal_module as cc +_CTSM_PYTHON = os.path.join( + os.path.dirname(os.path.realpath(__file__)), os.pardir, os.pardir, os.pardir, "python" +) +sys.path.insert(1, _CTSM_PYTHON) +import ctsm.crop_calendars.cropcal_module as cc +import ctsm.crop_calendars.generate_gdds_functions as gddfn # Import everything else import os diff --git a/python/ctsm/crop_calendars/generate_gdds_functions.py b/python/ctsm/crop_calendars/generate_gdds_functions.py index d050a46bd8..20c958817a 100644 --- a/python/ctsm/crop_calendars/generate_gdds_functions.py +++ b/python/ctsm/crop_calendars/generate_gdds_functions.py @@ -1,6 +1,3 @@ -# Import the CTSM Python utilities -import cropcal_utils as utils - import numpy as np import xarray as xr import warnings @@ -9,11 +6,18 @@ import datetime as dt from importlib import util as importlib_util -import cropcal_module as cc +# Import the CTSM Python utilities +_CTSM_PYTHON = os.path.join( + os.path.dirname(os.path.realpath(__file__)), os.pardir, os.pardir, os.pardir, "python" +) +import sys +sys.path.insert(1, _CTSM_PYTHON) +import ctsm.crop_calendars.cropcal_utils as utils +import ctsm.crop_calendars.cropcal_module as cc can_plot = True try: - from cropcal_figs_module import * + from ctsm.crop_calendars.cropcal_figs_module import * from matplotlib.transforms import Bbox warnings.filterwarnings( @@ -25,10 +29,10 @@ message="Iteration over multi-part geometries is deprecated and will be removed in Shapely 2.0. Use the `geoms` property to access the constituent parts of a multi-part geometry.", ) - print("Will (attempt to) produce harvest requirement maps.") + print("Will (attempt to) produce harvest requirement map figure files.") except: - print("Will NOT produce harvest requirement maps.") + print("Will NOT produce harvest requirement map figure files.") can_plot = False diff --git a/python/ctsm/run_sys_tests.py b/python/ctsm/run_sys_tests.py index 992f2b544a..83c468ab88 100644 --- a/python/ctsm/run_sys_tests.py +++ b/python/ctsm/run_sys_tests.py @@ -231,10 +231,14 @@ def run_sys_tests( _make_cs_status_non_suite(testroot, testid_base) if testfile: test_args = ["--testfile", os.path.abspath(testfile)] + with open(test_args[1], "r") as f: + testname_list = f.readlines() elif testlist: test_args = testlist + testname_list = testlist else: raise RuntimeError("None of suite_name, testfile or testlist were provided") + _try_systemtests(testname_list) _run_create_test( cime_path=cime_path, test_args=test_args, @@ -692,12 +696,31 @@ def _run_test_suite( ) +def _try_systemtests(testname_list): + errMsg = " can't be loaded. Do you need to activate the ctsm_pylib conda environment?" + if any(["FSURDATMODIFYCTSM" in t for t in testname_list]): + try: + import ctsm.modify_input_files.modify_fsurdat + except ModuleNotFoundError: + raise ModuleNotFoundError("modify_fsurdat" + errMsg) + if any(["RXCROPMATURITY" in t for t in testname_list]): + try: + import ctsm.crop_calendars.make_fsurdat_all_crops_everywhere + except ModuleNotFoundError: + raise ModuleNotFoundError("make_fsurdat_all_crops_everywhere.py" + errMsg) + try: + import ctsm.crop_calendars.generate_gdds + except ModuleNotFoundError: + raise ModuleNotFoundError("generate_gdds.py" + errMsg) + + def _get_compilers_for_suite(suite_name, machine_name): test_data = get_tests_from_xml(xml_machine=machine_name, xml_category=suite_name) if not test_data: raise RuntimeError( "No tests found for suite {} on machine {}".format(suite_name, machine_name) ) + _try_systemtests([t["testname"] for t in test_data]) compilers = sorted({one_test["compiler"] for one_test in test_data}) logger.info("Running with compilers: %s", compilers) return compilers From 3a93b1a229ca0490f4a77954da60a322ee3c9300 Mon Sep 17 00:00:00 2001 From: Sam Rabin Date: Fri, 1 Sep 2023 11:45:59 -0600 Subject: [PATCH 220/257] Only import fsurdat_modifier in setup phase. This avoids "numpy not found" error for FSURDATMODIFYCTSM, but this isn't a solution for RXCROPMATURITY, because that test actually does need the right conda environment during the run phase (which is when generate_gdds.py is called). --- cime_config/SystemTests/fsurdatmodifyctsm.py | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cime_config/SystemTests/fsurdatmodifyctsm.py b/cime_config/SystemTests/fsurdatmodifyctsm.py index 083cdc2767..43b155dc0b 100644 --- a/cime_config/SystemTests/fsurdatmodifyctsm.py +++ b/cime_config/SystemTests/fsurdatmodifyctsm.py @@ -15,7 +15,6 @@ os.path.dirname(os.path.realpath(__file__)), os.pardir, os.pardir, "python" ) sys.path.insert(1, _CTSM_PYTHON) -from ctsm.modify_input_files.fsurdat_modifier import fsurdat_modifier logger = logging.getLogger(__name__) @@ -82,6 +81,7 @@ def _run_modify_fsurdat(self): silent=False, verbose=False, ) + from ctsm.modify_input_files.fsurdat_modifier import fsurdat_modifier fsurdat_modifier(fsurdat_modifier_args) def _modify_user_nl(self): From 9893c8032e91c970b9b1afae9762c23d61d6c588 Mon Sep 17 00:00:00 2001 From: Sam Rabin Date: Fri, 1 Sep 2023 14:00:45 -0600 Subject: [PATCH 221/257] Remove sys.path.insert()s from crop calendar Python files. --- python/ctsm/crop_calendars/cropcal_module.py | 4 ---- python/ctsm/crop_calendars/generate_gdds.py | 4 ---- python/ctsm/crop_calendars/generate_gdds_functions.py | 5 ----- 3 files changed, 13 deletions(-) diff --git a/python/ctsm/crop_calendars/cropcal_module.py b/python/ctsm/crop_calendars/cropcal_module.py index 1d58e2fbab..b2be2fd3e8 100644 --- a/python/ctsm/crop_calendars/cropcal_module.py +++ b/python/ctsm/crop_calendars/cropcal_module.py @@ -6,10 +6,6 @@ import glob # Import the CTSM Python utilities -_CTSM_PYTHON = os.path.join( - os.path.dirname(os.path.realpath(__file__)), os.pardir, os.pardir, os.pardir, "python" -) -sys.path.insert(1, _CTSM_PYTHON) import ctsm.crop_calendars.cropcal_utils as utils try: diff --git a/python/ctsm/crop_calendars/generate_gdds.py b/python/ctsm/crop_calendars/generate_gdds.py index 9fe1c26e14..649057e1b2 100644 --- a/python/ctsm/crop_calendars/generate_gdds.py +++ b/python/ctsm/crop_calendars/generate_gdds.py @@ -5,10 +5,6 @@ import inspect import sys -_CTSM_PYTHON = os.path.join( - os.path.dirname(os.path.realpath(__file__)), os.pardir, os.pardir, os.pardir, "python" -) -sys.path.insert(1, _CTSM_PYTHON) import ctsm.crop_calendars.cropcal_module as cc import ctsm.crop_calendars.generate_gdds_functions as gddfn diff --git a/python/ctsm/crop_calendars/generate_gdds_functions.py b/python/ctsm/crop_calendars/generate_gdds_functions.py index 20c958817a..6d6e2a7d54 100644 --- a/python/ctsm/crop_calendars/generate_gdds_functions.py +++ b/python/ctsm/crop_calendars/generate_gdds_functions.py @@ -7,11 +7,6 @@ from importlib import util as importlib_util # Import the CTSM Python utilities -_CTSM_PYTHON = os.path.join( - os.path.dirname(os.path.realpath(__file__)), os.pardir, os.pardir, os.pardir, "python" -) -import sys -sys.path.insert(1, _CTSM_PYTHON) import ctsm.crop_calendars.cropcal_utils as utils import ctsm.crop_calendars.cropcal_module as cc From 9759938d5b65abfebed97ece3a2075b752952e79 Mon Sep 17 00:00:00 2001 From: Sam Rabin Date: Sun, 3 Sep 2023 12:31:38 -0600 Subject: [PATCH 222/257] RXCROPMATURITY: Do make_fsurdat_all_crops_everywhere as PRERUN_SCRIPT. --- cime_config/SystemTests/rxcropmaturity.py | 24 +++++++++++++++-------- 1 file changed, 16 insertions(+), 8 deletions(-) diff --git a/cime_config/SystemTests/rxcropmaturity.py b/cime_config/SystemTests/rxcropmaturity.py index 15f524dfce..f292346582 100644 --- a/cime_config/SystemTests/rxcropmaturity.py +++ b/cime_config/SystemTests/rxcropmaturity.py @@ -135,7 +135,7 @@ def run_phase(self): # Make custom version of surface file logger.info("RXCROPMATURITY log: run make_fsurdat_all_crops_everywhere") - self._run_make_fsurdat_all_crops_everywhere() + self._setup_make_fsurdat_all_crops_everywhere() # ------------------------------------------------------------------- # (2) Perform GDD-generating run and generate prescribed GDDs file @@ -239,7 +239,7 @@ def _setup_all(self): logger.info("RXCROPMATURITY log: _setup_all done") # Make a surface dataset that has every crop in every gridcell - def _run_make_fsurdat_all_crops_everywhere(self): + def _setup_make_fsurdat_all_crops_everywhere(self): # fsurdat should be defined. Where is it? self._fsurdat_in = None @@ -269,12 +269,20 @@ def _run_make_fsurdat_all_crops_everywhere(self): command = ( f"python3 {tool_path} " + f"-i {self._fsurdat_in} " + f"-o {self._fsurdat_out}" ) - stu.run_python_script( - self._get_caseroot(), - self._this_conda_env, - command, - tool_path, - ) + + # Write a bash script that will do what we want + prerun_script = os.path.join(self._path_gddgen, "make_fsurdat_all_crops_everywhere.sh") + prerun_script_lines = [ + "#!/bin/bash", + "set -e", + "conda run -n ctsm_pylib " + command, + "exit 0", + ] + with open(prerun_script, "w") as f: + f.writelines(line + "\n" for line in prerun_script_lines) + os.chmod(prerun_script, 0o755) # 0o755 = -rwxr-xr-x + with self._case: + self._case.set_value("PRERUN_SCRIPT", prerun_script) # Modify namelist logger.info("RXCROPMATURITY log: modify user_nl files: new fsurdat") From 7caa5e4206e935475c3cd437c4331bb9538f122b Mon Sep 17 00:00:00 2001 From: Sam Rabin Date: Wed, 6 Sep 2023 10:52:03 -0600 Subject: [PATCH 223/257] Methane tech note: Add 3 missing equation references. --- doc/source/tech_note/Methane/CLM50_Tech_Note_Methane.rst | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/doc/source/tech_note/Methane/CLM50_Tech_Note_Methane.rst b/doc/source/tech_note/Methane/CLM50_Tech_Note_Methane.rst index d90531c7e9..875689558b 100644 --- a/doc/source/tech_note/Methane/CLM50_Tech_Note_Methane.rst +++ b/doc/source/tech_note/Methane/CLM50_Tech_Note_Methane.rst @@ -293,7 +293,7 @@ area (m\ :sup:`2` m\ :sup:`-2`); :math:`{r}_{a}` is the aerodynamic resistance between the surface and the atmospheric reference height (s m\ :sup:`-1`); and :math:`\rho _{r}` is the rooting density as a function of depth (-). The gaseous concentration is -calculated with Henry’s law as described in equation . +calculated with Henry’s law as described in equation :eq:`24.7`. Based on the ranges reported in :ref:`Colmer (2003)`, we have chosen baseline aerenchyma porosity values of 0.3 for grass and crop PFTs and 0.1 for @@ -310,7 +310,7 @@ m\ :sup:`-2` s\ :sup:`-1`); *R* is the aerenchyma radius belowground fraction of annual NPP; and the 0.22 factor represents the amount of C per tiller. O\ :sub:`2` can also diffuse in from the atmosphere to the soil layer via the reverse of the same pathway, with -the same representation as Equation but with the gas diffusivity of +the same representation as Equation :eq:`24.8` but with the gas diffusivity of oxygen. CLM also simulates the direct emission of CH\ :sub:`4` from leaves @@ -358,7 +358,7 @@ potential and :math:`{P}_{c} = -2.4 \times {10}^{5}` mm. Reactive Transport Solution -------------------------------- -The solution to equation is solved in several sequential steps: resolve +The solution to equation :eq:`24.11` is solved in several sequential steps: resolve competition for CH\ :sub:`4` and O\ :sub:`2` (section :numref:`Competition for CH4and O2`); add the ebullition flux into the layer directly above the water From d25281dc5ba78bf679131001175d01995db89343 Mon Sep 17 00:00:00 2001 From: Adrianna Foster Date: Fri, 8 Sep 2023 09:29:59 -0600 Subject: [PATCH 224/257] update fates externals --- Externals_CLM.cfg | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Externals_CLM.cfg b/Externals_CLM.cfg index c540fe8b0c..14ba14d8b4 100644 --- a/Externals_CLM.cfg +++ b/Externals_CLM.cfg @@ -2,7 +2,7 @@ local_path = src/fates protocol = git repo_url = https://github.com/NGEET/fates -tag = sci.1.67.1_api.27.0.0 +tag = sci.1.67.2_api.27.0.0 required = True [externals_description] From bed606d173140c29e5aa43965fa0fdf1dca2054e Mon Sep 17 00:00:00 2001 From: Adrianna Foster Date: Fri, 8 Sep 2023 10:23:28 -0600 Subject: [PATCH 225/257] fix merge conflict error --- src/main/surfrdUtilsMod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/main/surfrdUtilsMod.F90 b/src/main/surfrdUtilsMod.F90 index da343a8802..6b581a59c1 100644 --- a/src/main/surfrdUtilsMod.F90 +++ b/src/main/surfrdUtilsMod.F90 @@ -64,7 +64,7 @@ subroutine check_sums_equal_1(arr, lb, name, caller, ier, sumto) found = .false. do nl = lb, ub - if (abs(sum(arr(nl,:)) - TotalSum(nl)) > eps) then + if (abs(sum(arr(nl,:)) - TotalSum(nl)) > sum_to_1_tol) then found = .true. nindx = nl exit From 278ce0126476e65137c686e6f326ae8353010092 Mon Sep 17 00:00:00 2001 From: adrifoster Date: Mon, 11 Sep 2023 15:03:39 -0600 Subject: [PATCH 226/257] update changelog --- cime_config/config_compsets.xml | 4 +++ doc/ChangeLog | 64 +++++++++++++++++++++++++++++++++ doc/ChangeSum | 1 + 3 files changed, 69 insertions(+) diff --git a/cime_config/config_compsets.xml b/cime_config/config_compsets.xml index 61931c94ba..aaa5c68394 100644 --- a/cime_config/config_compsets.xml +++ b/cime_config/config_compsets.xml @@ -205,6 +205,10 @@ I2000Clm45BgcCropQianRs 2000_DATM%QIA_CLM45%BGC-CROP_SICE_SOCN_SROF_SGLC_SWAV + + I2000Clm50FatesQian + 2000_DATM%QIA_CLM50%FATES_SICE_SOCN_MOSART_SGLC_SWAV + I2000Clm50BgcCruRs diff --git a/doc/ChangeLog b/doc/ChangeLog index 0a9515ff93..ee4b6b2aa8 100644 --- a/doc/ChangeLog +++ b/doc/ChangeLog @@ -1,4 +1,68 @@ =============================================================== +Tag name: ctsm5.1.dev140 +Originator(s): afoster (Adrianna Foster) +Date: Mon Sep 11 14:57:50 MDT 2023 +One-line Summary: add lai_streams capability for FATES + +Purpose and description of changes +---------------------------------- + +Removed checks in clm_driver and CLMBuildNamelist.pm so that now FATES can run when use_lai_streams=.true. + +I also had to modify the init in cpl/share_esmf/laiStreamMod to allocate the g_to_ig array in the lai_init method (rather than in the lai_advance method. This was required because SatellitePhenology is called in clim_initializedMod in FATES cases (here). This happens before lai_advance is ever called so at that point the g_to_ig array was not yet allocated. Moving the allocation/initialization to the lai_init method fixes this. + +Significant changes to scientifically-supported configurations +-------------------------------------------------------------- + +Does this tag change answers significantly for any of the following physics configurations? +(Details of any changes will be given in the "Answer changes" section below.) + + +[ ] clm5_1 + +[ ] clm5_0 + +[ ] ctsm5_0-nwp + +[ ] clm4_5 + +Bugs fixed or introduced +------------------------ + +CTSM issues fixed (include CTSM Issue #): #1722 + +Notes of particular relevance for developers: +--------------------------------------------- + +Changes to tests or testing: Added a test for lai_streams with FATES + +Testing summary: +---------------- + regular tests (aux_clm: https://github.com/ESCOMP/CTSM/wiki/System-Testing-Guide#pre-merge-system-testing): + + cheyenne ---- OK + izumi ------- OK + + fates tests: (give name of baseline if different from CTSM tagname, normally fates baselines are fates--) + cheyenne ---- OK + izumi ------- OK + + +Answer changes +-------------- + +Changes answers relative to baseline: None + +Other details +------------- + +List any externals directories updated (cime, rtm, mosart, cism, fates, etc.): fates + +Pull Requests that document the changes (include PR ids): #2054 +(https://github.com/ESCOMP/ctsm/pull) + +=============================================================== +=============================================================== Tag name: ctsm5.1.dev139 Originator(s): slevis (Samuel Levis) Date: Fri Aug 25 16:47:45 MDT 2023 diff --git a/doc/ChangeSum b/doc/ChangeSum index 4ac0f90f5e..eedc5a1aac 100644 --- a/doc/ChangeSum +++ b/doc/ChangeSum @@ -1,5 +1,6 @@ Tag Who Date Summary ============================================================================================================================ + ctsm5.1.dev140 afoster 09/11/2023 add lai_streams capability for FATES ctsm5.1.dev139 slevis 08/28/2023 Fix problems uncovered by nag -nan tests ctsm5.1.dev138 slevis 08/25/2023 Refactor max_patch_per_col and maxsoil_patches loops ctsm5.1.dev137 slevis 08/23/2023 Surface roughness modifications From b56f919db282b1f61c5f331d52adba75f3606970 Mon Sep 17 00:00:00 2001 From: adrifoster Date: Mon, 11 Sep 2023 15:04:12 -0600 Subject: [PATCH 227/257] updated date --- doc/ChangeLog | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/ChangeLog b/doc/ChangeLog index ee4b6b2aa8..17902f605f 100644 --- a/doc/ChangeLog +++ b/doc/ChangeLog @@ -1,7 +1,7 @@ =============================================================== Tag name: ctsm5.1.dev140 Originator(s): afoster (Adrianna Foster) -Date: Mon Sep 11 14:57:50 MDT 2023 +Date: Mon Sep 11 15:04:02 MDT 2023 One-line Summary: add lai_streams capability for FATES Purpose and description of changes From 385ebee260df2b0573b98cc1ae0be79be5455178 Mon Sep 17 00:00:00 2001 From: adrifoster Date: Tue, 12 Sep 2023 09:16:48 -0600 Subject: [PATCH 228/257] update Changelog date --- doc/ChangeLog | 2 +- doc/ChangeSum | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/doc/ChangeLog b/doc/ChangeLog index 17902f605f..51003a9c1d 100644 --- a/doc/ChangeLog +++ b/doc/ChangeLog @@ -1,7 +1,7 @@ =============================================================== Tag name: ctsm5.1.dev140 Originator(s): afoster (Adrianna Foster) -Date: Mon Sep 11 15:04:02 MDT 2023 +Date: Tue Sep 12 09:16:37 MDT 2023 One-line Summary: add lai_streams capability for FATES Purpose and description of changes diff --git a/doc/ChangeSum b/doc/ChangeSum index eedc5a1aac..5ca9ceab70 100644 --- a/doc/ChangeSum +++ b/doc/ChangeSum @@ -1,6 +1,6 @@ Tag Who Date Summary ============================================================================================================================ - ctsm5.1.dev140 afoster 09/11/2023 add lai_streams capability for FATES + ctsm5.1.dev140 afoster 09/12/2023 add lai_streams capability for FATES ctsm5.1.dev139 slevis 08/28/2023 Fix problems uncovered by nag -nan tests ctsm5.1.dev138 slevis 08/25/2023 Refactor max_patch_per_col and maxsoil_patches loops ctsm5.1.dev137 slevis 08/23/2023 Surface roughness modifications From 24dee0029ce2ec8c433a8bdad16fb8f8b7b03807 Mon Sep 17 00:00:00 2001 From: adrifoster Date: Tue, 12 Sep 2023 10:24:25 -0600 Subject: [PATCH 229/257] add bldnamelist tests --- bld/CLMBuildNamelist.pm | 9 +++++---- bld/unit_testers/build-namelist_test.pl | 20 ++++++++++++++++++++ doc/ChangeLog | 2 ++ 3 files changed, 27 insertions(+), 4 deletions(-) diff --git a/bld/CLMBuildNamelist.pm b/bld/CLMBuildNamelist.pm index 7ac29a6fc9..4ba5588bc6 100755 --- a/bld/CLMBuildNamelist.pm +++ b/bld/CLMBuildNamelist.pm @@ -3921,17 +3921,18 @@ sub setup_logic_lai_streams { } else { # If bgc is BGC/BGCDV then make sure none of the LAI settings are set if ( &value_is_true($nl->get_value('use_lai_streams'))) { - $log->fatal_error("When bgc is NOT SP use_lai_streams cannot be .true.\n" . - "(eg. don't use this option with BGC or BGCDV)."); + $log->fatal_error("When not in SP mode use_lai_streams cannot be .true.\n" . + "(eg. don't use this option with BGC or non-SP FATES," . + "update compset to use SP)"); } if ( defined($nl->get_value('stream_year_first_lai')) || defined($nl->get_value('stream_year_last_lai')) || defined($nl->get_value('model_year_align_lai')) || defined($nl->get_value('lai_tintalgo' )) || defined($nl->get_value('stream_fldfilename_lai')) ) { - $log->fatal_error("When bgc is NOT SP none of the following can be set: stream_year_first_lai,\n" . + $log->fatal_error("When not in SP mode none of the following can be set: stream_year_first_lai,\n" . "stream_year_last_lai, model_year_align_lai, lai_tintalgo nor\n" . - "stream_fldfilename_lai (eg. don't use this option with BGC or BGCDV)."); + "stream_fldfilename_lai (eg. don't use this option with BGC or FATES-SP)."); } } } diff --git a/bld/unit_testers/build-namelist_test.pl b/bld/unit_testers/build-namelist_test.pl index bbf991a7a7..219aecfcbd 100755 --- a/bld/unit_testers/build-namelist_test.pl +++ b/bld/unit_testers/build-namelist_test.pl @@ -1226,6 +1226,26 @@ sub cat_and_create_namelistinfile { GLC_TWO_WAY_COUPLING=>"FALSE", phys=>"clm5_0", }, + "fates_non_sp_laistreams" =>{ options=>"--envxml_dir . --bgc fates", + namelist=>"use_lai_streams=.true., use_fates_sp=.false.", + GLC_TWO_WAY_COUPLING=>"FALSE", + phys=>"clm5_0", + }, + "bgc_non_sp_laistreams" =>{ options=>"--envxml_dir . --bgc bgc", + namelist=>"use_lai_streams=.true.", + GLC_TWO_WAY_COUPLING=>"FALSE", + phys=>"clm5_0", + }, + "bgc_laistreams_input" =>{ options=>"--envxml_dir . --bgc bgc", + namelist=>"use_lai_streams=.false., stream_year_first_lai=1999", + GLC_TWO_WAY_COUPLING=>"FALSE", + phys=>"clm5_0", + }, + "crop_laistreams_input" =>{ options=>"--envxml_dir . --bgc sp --crop", + namelist=>"use_lai_streams=.true.", + GLC_TWO_WAY_COUPLING=>"FALSE", + phys=>"clm5_0", + }, ); foreach my $key ( keys(%failtest) ) { print( "$key\n" ); diff --git a/doc/ChangeLog b/doc/ChangeLog index 51003a9c1d..aed3eeaac6 100644 --- a/doc/ChangeLog +++ b/doc/ChangeLog @@ -34,6 +34,8 @@ CTSM issues fixed (include CTSM Issue #): #1722 Notes of particular relevance for developers: --------------------------------------------- +build-namelist tests (if CLMBuildNamelist.pm has changed): added tests to make sure use_lai_streams failed correctly + Changes to tests or testing: Added a test for lai_streams with FATES Testing summary: From 1fb58be1a51cb65c8656e51ba1f291ef47a1d51d Mon Sep 17 00:00:00 2001 From: adrifoster Date: Tue, 12 Sep 2023 10:46:34 -0600 Subject: [PATCH 230/257] trying to fix --- bld/CLMBuildNamelist.pm | 5 +---- 1 file changed, 1 insertion(+), 4 deletions(-) diff --git a/bld/CLMBuildNamelist.pm b/bld/CLMBuildNamelist.pm index 4ba5588bc6..74ed2d4528 100755 --- a/bld/CLMBuildNamelist.pm +++ b/bld/CLMBuildNamelist.pm @@ -3890,10 +3890,7 @@ sub setup_logic_lai_streams { if ( &value_is_true($nl_flags->{'use_crop'}) && &value_is_true($nl->get_value('use_lai_streams')) ) { $log->fatal_error("turning use_lai_streams on is incompatable with use_crop set to true."); } - if ( ($nl_flags->{'bgc_mode'} eq "sp" || $nl_flags->{'bgc_mode'} eq "fates") ) { - if ( $nl_flags->{'bgc_mode'} eq "fates" && ! &value_is_true($nl->get_value('use_fates_sp')) && &value_is_true($nl->get_value('use_lai_streams'))) { - $log->fatal_error("Must have use_fates_sp turned on to run FATES with LAI streams."); - } + if ( $nl_flags->{'bgc_mode'} eq "sp" || ($nl_flags->{'bgc_mode'} eq "fates" && &value_is_true($nl->get_value('use_fates_sp')) )) { if ( &value_is_true($nl->get_value('use_lai_streams')) ) { add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'use_lai_streams'); add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'lai_mapalgo', From ec938f04b11db5d885daf4da6d898349a6d2014f Mon Sep 17 00:00:00 2001 From: Adrianna Foster Date: Tue, 12 Sep 2023 11:47:48 -0600 Subject: [PATCH 231/257] trying to fix issues --- bld/CLMBuildNamelist.pm | 5 +++-- bld/unit_testers/build-namelist_test.pl | 12 ++++++------ 2 files changed, 9 insertions(+), 8 deletions(-) diff --git a/bld/CLMBuildNamelist.pm b/bld/CLMBuildNamelist.pm index 74ed2d4528..3597b9cf30 100755 --- a/bld/CLMBuildNamelist.pm +++ b/bld/CLMBuildNamelist.pm @@ -3891,6 +3891,7 @@ sub setup_logic_lai_streams { $log->fatal_error("turning use_lai_streams on is incompatable with use_crop set to true."); } if ( $nl_flags->{'bgc_mode'} eq "sp" || ($nl_flags->{'bgc_mode'} eq "fates" && &value_is_true($nl->get_value('use_fates_sp')) )) { + #print "WE ARE HERE" if ( &value_is_true($nl->get_value('use_lai_streams')) ) { add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'use_lai_streams'); add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'lai_mapalgo', @@ -3919,8 +3920,8 @@ sub setup_logic_lai_streams { # If bgc is BGC/BGCDV then make sure none of the LAI settings are set if ( &value_is_true($nl->get_value('use_lai_streams'))) { $log->fatal_error("When not in SP mode use_lai_streams cannot be .true.\n" . - "(eg. don't use this option with BGC or non-SP FATES," . - "update compset to use SP)"); + "(eg. don't use this option with BGC or non-SP FATES), \n" . + "Update compset to use SP)"); } if ( defined($nl->get_value('stream_year_first_lai')) || defined($nl->get_value('stream_year_last_lai')) || diff --git a/bld/unit_testers/build-namelist_test.pl b/bld/unit_testers/build-namelist_test.pl index 219aecfcbd..812bbb4054 100755 --- a/bld/unit_testers/build-namelist_test.pl +++ b/bld/unit_testers/build-namelist_test.pl @@ -1231,16 +1231,16 @@ sub cat_and_create_namelistinfile { GLC_TWO_WAY_COUPLING=>"FALSE", phys=>"clm5_0", }, - "bgc_non_sp_laistreams" =>{ options=>"--envxml_dir . --bgc bgc", + "bgc_non_sp_laistreams" =>{ options=>"--envxml_dir . -bgc bgc", namelist=>"use_lai_streams=.true.", GLC_TWO_WAY_COUPLING=>"FALSE", phys=>"clm5_0", }, - "bgc_laistreams_input" =>{ options=>"--envxml_dir . --bgc bgc", - namelist=>"use_lai_streams=.false., stream_year_first_lai=1999", - GLC_TWO_WAY_COUPLING=>"FALSE", - phys=>"clm5_0", - }, + # "bgc_laistreams_input" =>{ options=>"--envxml_dir . --bgc bgc", + # namelist=>"stream_year_first_lai=1999", + # GLC_TWO_WAY_COUPLING=>"FALSE", + # phys=>"clm5_0", + # }, "crop_laistreams_input" =>{ options=>"--envxml_dir . --bgc sp --crop", namelist=>"use_lai_streams=.true.", GLC_TWO_WAY_COUPLING=>"FALSE", From 79c8a85e25ae74b6e2d95381f5ee87c2db965c67 Mon Sep 17 00:00:00 2001 From: Adrianna Foster Date: Tue, 12 Sep 2023 14:05:39 -0600 Subject: [PATCH 232/257] fix typo --- bld/unit_testers/build-namelist_test.pl | 20 ++++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) diff --git a/bld/unit_testers/build-namelist_test.pl b/bld/unit_testers/build-namelist_test.pl index 812bbb4054..da4201d68f 100755 --- a/bld/unit_testers/build-namelist_test.pl +++ b/bld/unit_testers/build-namelist_test.pl @@ -163,7 +163,7 @@ sub cat_and_create_namelistinfile { # # Figure out number of tests that will run # -my $ntests = 1992; +my $ntests = 1999; if ( defined($opts{'compare'}) ) { $ntests += 1353; @@ -1227,22 +1227,22 @@ sub cat_and_create_namelistinfile { phys=>"clm5_0", }, "fates_non_sp_laistreams" =>{ options=>"--envxml_dir . --bgc fates", - namelist=>"use_lai_streams=.true., use_fates_sp=.false.", + namelst=>"use_lai_streams=.true., use_fates_sp=.false.", GLC_TWO_WAY_COUPLING=>"FALSE", phys=>"clm5_0", }, - "bgc_non_sp_laistreams" =>{ options=>"--envxml_dir . -bgc bgc", - namelist=>"use_lai_streams=.true.", + "bgc_non_sp_laistreams" =>{ options=>"--envxml_dir . -bgc bgc", + namelst=>"use_lai_streams=.true.", + GLC_TWO_WAY_COUPLING=>"FALSE", + phys=>"clm5_0", + }, + "bgc_laistreams_input" =>{ options=>"--envxml_dir . --bgc bgc", + namelst=>"stream_year_first_lai=1999", GLC_TWO_WAY_COUPLING=>"FALSE", phys=>"clm5_0", }, - # "bgc_laistreams_input" =>{ options=>"--envxml_dir . --bgc bgc", - # namelist=>"stream_year_first_lai=1999", - # GLC_TWO_WAY_COUPLING=>"FALSE", - # phys=>"clm5_0", - # }, "crop_laistreams_input" =>{ options=>"--envxml_dir . --bgc sp --crop", - namelist=>"use_lai_streams=.true.", + namelst=>"use_lai_streams=.true.", GLC_TWO_WAY_COUPLING=>"FALSE", phys=>"clm5_0", }, From 451cbc6050626eaa6cc5c1d34b8c30af10c05af8 Mon Sep 17 00:00:00 2001 From: adrifoster Date: Tue, 12 Sep 2023 14:47:21 -0600 Subject: [PATCH 233/257] update changelog date --- doc/ChangeLog | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/ChangeLog b/doc/ChangeLog index aed3eeaac6..479e59d9a7 100644 --- a/doc/ChangeLog +++ b/doc/ChangeLog @@ -1,7 +1,7 @@ =============================================================== Tag name: ctsm5.1.dev140 Originator(s): afoster (Adrianna Foster) -Date: Tue Sep 12 09:16:37 MDT 2023 +Date: Tue Sep 12 14:47:06 MDT 2023 One-line Summary: add lai_streams capability for FATES Purpose and description of changes From 6bfb9b084694a7f00100f485e65003dc8d00143b Mon Sep 17 00:00:00 2001 From: adrifoster Date: Tue, 12 Sep 2023 15:16:40 -0600 Subject: [PATCH 234/257] remove print statement --- bld/CLMBuildNamelist.pm | 1 - 1 file changed, 1 deletion(-) diff --git a/bld/CLMBuildNamelist.pm b/bld/CLMBuildNamelist.pm index 3597b9cf30..72c3b1b74a 100755 --- a/bld/CLMBuildNamelist.pm +++ b/bld/CLMBuildNamelist.pm @@ -3891,7 +3891,6 @@ sub setup_logic_lai_streams { $log->fatal_error("turning use_lai_streams on is incompatable with use_crop set to true."); } if ( $nl_flags->{'bgc_mode'} eq "sp" || ($nl_flags->{'bgc_mode'} eq "fates" && &value_is_true($nl->get_value('use_fates_sp')) )) { - #print "WE ARE HERE" if ( &value_is_true($nl->get_value('use_lai_streams')) ) { add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'use_lai_streams'); add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'lai_mapalgo', From 175fab0ae7a5a527d7a7e551d23f70bdda177dc1 Mon Sep 17 00:00:00 2001 From: adrifoster Date: Tue, 12 Sep 2023 15:20:20 -0600 Subject: [PATCH 235/257] add issue discription in changelog --- doc/ChangeLog | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/doc/ChangeLog b/doc/ChangeLog index 479e59d9a7..955f071933 100644 --- a/doc/ChangeLog +++ b/doc/ChangeLog @@ -29,7 +29,7 @@ Does this tag change answers significantly for any of the following physics conf Bugs fixed or introduced ------------------------ -CTSM issues fixed (include CTSM Issue #): #1722 +CTSM issues fixed (include CTSM Issue #): #1722 - Should be able to use lai streams with FATES-SP mode Notes of particular relevance for developers: --------------------------------------------- @@ -60,7 +60,7 @@ Other details List any externals directories updated (cime, rtm, mosart, cism, fates, etc.): fates -Pull Requests that document the changes (include PR ids): #2054 +Pull Requests that document the changes (include PR ids): #2054 (https://github.com/ESCOMP/ctsm/pull) =============================================================== From 4f4a683d9ef8263b5fd36da72bdf347e72790d89 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Tue, 12 Sep 2023 15:37:59 -0600 Subject: [PATCH 236/257] Add a small clarification to the tagging steps --- doc/README.CHECKLIST.master_tags | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/doc/README.CHECKLIST.master_tags b/doc/README.CHECKLIST.master_tags index 53540aaf37..ed7794130b 100644 --- a/doc/README.CHECKLIST.master_tags +++ b/doc/README.CHECKLIST.master_tags @@ -73,7 +73,10 @@ This should show no diffs (9) Make an annotated tag on master -(10) Push master and tag to ESCOMP/ctsm +(10) Push tag to ESCOMP/ctsm + +(10a) Push to master (if needed because you changed something in master after PR was merged, or +if you did step 7 above using git commands that require this step) (11) Update the CTSM upcoming tags project, if necessary (https://github.com/ESCOMP/ctsm/projects/6) From 721627223d5043677da4948587a9ead63fac5659 Mon Sep 17 00:00:00 2001 From: Sam Rabin Date: Wed, 13 Sep 2023 12:51:44 -0600 Subject: [PATCH 237/257] Added function to check if DOY is in interval. --- src/utils/clm_time_manager.F90 | 39 +++++++++++++++++++ .../test_clm_time_manager.pf | 31 +++++++++++++++ 2 files changed, 70 insertions(+) diff --git a/src/utils/clm_time_manager.F90 b/src/utils/clm_time_manager.F90 index b8d9930b24..e1a94effc0 100644 --- a/src/utils/clm_time_manager.F90 +++ b/src/utils/clm_time_manager.F90 @@ -59,6 +59,7 @@ module clm_time_manager is_beg_curr_year, &! return true on first timestep in current year is_end_curr_year, &! return true on last timestep in current year is_perpetual, &! return true if perpetual calendar is in use + is_doy_in_interval, &! return true if day of year is in the provided interval is_near_local_noon, &! return true if near local noon is_restart, &! return true if this is a restart run update_rad_dtime, &! track radiation interval via nstep @@ -1759,6 +1760,44 @@ end function is_perpetual !========================================================================================= + logical function is_doy_in_interval(start, end, doy_in) + + ! Return true if day of year is in the provided interval. + ! Does not treat leap years differently from normal years. + ! Arguments + integer, intent(in) :: start ! start of interval (day of year) + integer, intent(in) :: end ! end of interval (day of year) + integer, optional, intent(in) :: doy_in ! day of year to query + + ! Local variables + integer :: doy + logical :: window_crosses_newyear + + character(len=*), parameter :: sub = 'clm::is_doy_in_interval' + + ! Get doy of beginning of current timestep if doy_in is not provided + if (present(doy_in)) then + doy = doy_in + else + doy = get_prev_calday() + end if + + window_crosses_newyear = end < start + + if (window_crosses_newyear .and. & + (doy >= start .or. doy <= end)) then + is_doy_in_interval = .true. + else if (.not. window_crosses_newyear .and. & + (doy >= start .and. doy <= end)) then + is_doy_in_interval = .true. + else + is_doy_in_interval = .false. + end if + + end function is_doy_in_interval + + !========================================================================================= + subroutine timemgr_datediff(ymd1, tod1, ymd2, tod2, days) ! Calculate the difference (ymd2,tod2) - (ymd1,tod1) and return the result in days. diff --git a/src/utils/test/clm_time_manager_test/test_clm_time_manager.pf b/src/utils/test/clm_time_manager_test/test_clm_time_manager.pf index 435d795e50..d5f5dc9361 100644 --- a/src/utils/test/clm_time_manager_test/test_clm_time_manager.pf +++ b/src/utils/test/clm_time_manager_test/test_clm_time_manager.pf @@ -577,4 +577,35 @@ contains end subroutine bad_hilontolocal_time + @Test + subroutine check_is_doy_in_interval(this) + class(TestTimeManager), intent(inout) :: this + + integer :: start, end + + start = 100 + end = 300 + @assertTrue(is_doy_in_interval(start, end, start)) + @assertTrue(is_doy_in_interval(start, end, end)) + @assertTrue(is_doy_in_interval(start, end, 200)) + @assertFalse(is_doy_in_interval(start, end, 35)) + @assertFalse(is_doy_in_interval(start, end, 350)) + + start = 300 + end = 100 + @assertTrue(is_doy_in_interval(start, end, start)) + @assertTrue(is_doy_in_interval(start, end, end)) + @assertFalse(is_doy_in_interval(start, end, 200)) + @assertTrue(is_doy_in_interval(start, end, 35)) + @assertTrue(is_doy_in_interval(start, end, 350)) + + start = 300 + end = 300 + @assertTrue(is_doy_in_interval(start, end, start)) + @assertTrue(is_doy_in_interval(start, end, end)) + @assertFalse(is_doy_in_interval(start, end, 200)) + @assertFalse(is_doy_in_interval(start, end, 350)) + + end subroutine check_is_doy_in_interval + end module test_clm_time_manager From 5bdd59d5deecbe22eb506f3fd30afbaa4710cb9a Mon Sep 17 00:00:00 2001 From: Sam Rabin Date: Wed, 13 Sep 2023 13:00:46 -0600 Subject: [PATCH 238/257] CropPhenology() now uses is_doy_in_interval(). --- src/biogeochem/CNPhenologyMod.F90 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/biogeochem/CNPhenologyMod.F90 b/src/biogeochem/CNPhenologyMod.F90 index 070dc0eb0f..7044cdc402 100644 --- a/src/biogeochem/CNPhenologyMod.F90 +++ b/src/biogeochem/CNPhenologyMod.F90 @@ -1726,6 +1726,7 @@ subroutine CropPhenology(num_pcropp, filter_pcropp , & use clm_time_manager , only : get_prev_calday, get_curr_days_per_year, is_beg_curr_year use clm_time_manager , only : get_average_days_per_year use clm_time_manager , only : get_prev_date + use clm_time_manager , only : is_doy_in_interval use pftconMod , only : ntmp_corn, nswheat, nwwheat, ntmp_soybean use pftconMod , only : nirrig_tmp_corn, nirrig_swheat, nirrig_wwheat, nirrig_tmp_soybean use pftconMod , only : ntrp_corn, nsugarcane, ntrp_soybean, ncotton, nrice @@ -1930,7 +1931,7 @@ subroutine CropPhenology(num_pcropp, filter_pcropp , & end if ! This is outside the croplive check so that the "harvest if planting conditions were met today" conditional works. - is_in_sowing_window = jday >= minplantjday(ivt(p),h) .and. jday <= maxplantjday(ivt(p),h) + is_in_sowing_window = is_doy_in_interval(minplantjday(ivt(p),h), maxplantjday(ivt(p),h), jday) is_end_sowing_window = jday == maxplantjday(ivt(p),h) ! ! Only allow sowing according to normal "window" rules if not using prescribed From 9fd0612aa7a3e8f30eb7f09aa6f4c6e43d00da5d Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Wed, 13 Sep 2023 14:01:59 -0600 Subject: [PATCH 239/257] Update ChangeLog --- doc/ChangeLog | 39 +++++++-------------------------------- 1 file changed, 7 insertions(+), 32 deletions(-) diff --git a/doc/ChangeLog b/doc/ChangeLog index 4f2d8ae7bf..518e2b59cb 100644 --- a/doc/ChangeLog +++ b/doc/ChangeLog @@ -1,7 +1,7 @@ =============================================================== Tag name: ctsm5.1.dev141 Originator(s): slevis (Samuel Levis,UCAR/TSS,303-665-1310) -Date: Tue Sep 12 17:08:11 MDT 2023 +Date: Wed Sep 13 13:58:04 MDT 2023 One-line Summary: Change small snocan to zero Purpose and description of changes @@ -34,8 +34,8 @@ Does this tag change answers significantly for any of the following physics conf Bugs fixed or introduced ------------------------ CTSM issues fixed (include CTSM Issue #): - #2041 - #2048 + Fixes #2041 + Fixes #2048 Testing summary: @@ -43,36 +43,10 @@ Testing summary: [PASS means all tests PASS; OK means tests PASS other than expected fails.] - build-namelist tests (if CLMBuildNamelist.pm has changed): - - cheyenne - - - tools-tests (test/tools) (if tools have been changed): - - cheyenne - - - python testing (if python code has changed; see instructions in python/README.md; document testing done): - - (any machine) - - - [If python code has changed and you are NOT running aux_clm (e.g., because the only changes are in python - code) then also run the clm_pymods test suite; this is a small subset of aux_clm that runs the system - tests impacted by python changes. The best way to do this, if you expect no changes from the last tag in - either model output or namelists, is: create sym links pointing to the last tag's baseline directory, - named with the upcoming tag; then run the clm_pymods test suite comparing against these baselines but NOT - doing their own baseline generation. If you are already running the full aux_clm then you do NOT need to - separately run the clm_pymods test suite, and you can remove the following line.] - - clm_pymods test suite on cheyenne - - regular tests (aux_clm: https://github.com/ESCOMP/CTSM/wiki/System-Testing-Guide#pre-merge-system-testing): - cheyenne ---- - izumi ------- - - any other testing (give details below): - -If the tag used for baseline comparisons was NOT the previous tag, note that here: + cheyenne ---- OK + izumi ------- OK Answer changes @@ -89,7 +63,8 @@ Changes answers relative to baseline: The answer changes are expected to be roundoff-level because the code change just truncates roundoff-level greater-than-zero states to exactly zero for snocan that most likely needed to be zero anyway. - We find that the answer changes grow to greater than roundoff, but the + + The answer changes grow to greater than roundoff, but the cprnc.out file from a 20-year izumi test-suite case does not contain differences of concerning magnitude. From 0660f4c7aa6b517909ac6d83c6dfcc95daca80dd Mon Sep 17 00:00:00 2001 From: Sam Rabin Date: Thu, 14 Sep 2023 12:12:11 -0600 Subject: [PATCH 240/257] Don't check RXCROPMATURITY in run_sys_tests. --- python/ctsm/run_sys_tests.py | 9 --------- 1 file changed, 9 deletions(-) diff --git a/python/ctsm/run_sys_tests.py b/python/ctsm/run_sys_tests.py index 83c468ab88..a44e4ab3cf 100644 --- a/python/ctsm/run_sys_tests.py +++ b/python/ctsm/run_sys_tests.py @@ -703,15 +703,6 @@ def _try_systemtests(testname_list): import ctsm.modify_input_files.modify_fsurdat except ModuleNotFoundError: raise ModuleNotFoundError("modify_fsurdat" + errMsg) - if any(["RXCROPMATURITY" in t for t in testname_list]): - try: - import ctsm.crop_calendars.make_fsurdat_all_crops_everywhere - except ModuleNotFoundError: - raise ModuleNotFoundError("make_fsurdat_all_crops_everywhere.py" + errMsg) - try: - import ctsm.crop_calendars.generate_gdds - except ModuleNotFoundError: - raise ModuleNotFoundError("generate_gdds.py" + errMsg) def _get_compilers_for_suite(suite_name, machine_name): From 0b6345838f9dac5d430c5b5ad186fd99ac203aca Mon Sep 17 00:00:00 2001 From: Sam Rabin Date: Thu, 14 Sep 2023 14:17:18 -0600 Subject: [PATCH 241/257] Revert "Remove sys.path.insert()s from crop calendar Python files." Those are necessary for when the crop calendar scripts are being called on their own, from outside the CTSM repo. This reverts commit 9893c8032e91c970b9b1afae9762c23d61d6c588. --- python/ctsm/crop_calendars/cropcal_module.py | 4 ++++ python/ctsm/crop_calendars/generate_gdds.py | 4 ++++ python/ctsm/crop_calendars/generate_gdds_functions.py | 5 +++++ 3 files changed, 13 insertions(+) diff --git a/python/ctsm/crop_calendars/cropcal_module.py b/python/ctsm/crop_calendars/cropcal_module.py index b2be2fd3e8..1d58e2fbab 100644 --- a/python/ctsm/crop_calendars/cropcal_module.py +++ b/python/ctsm/crop_calendars/cropcal_module.py @@ -6,6 +6,10 @@ import glob # Import the CTSM Python utilities +_CTSM_PYTHON = os.path.join( + os.path.dirname(os.path.realpath(__file__)), os.pardir, os.pardir, os.pardir, "python" +) +sys.path.insert(1, _CTSM_PYTHON) import ctsm.crop_calendars.cropcal_utils as utils try: diff --git a/python/ctsm/crop_calendars/generate_gdds.py b/python/ctsm/crop_calendars/generate_gdds.py index 649057e1b2..9fe1c26e14 100644 --- a/python/ctsm/crop_calendars/generate_gdds.py +++ b/python/ctsm/crop_calendars/generate_gdds.py @@ -5,6 +5,10 @@ import inspect import sys +_CTSM_PYTHON = os.path.join( + os.path.dirname(os.path.realpath(__file__)), os.pardir, os.pardir, os.pardir, "python" +) +sys.path.insert(1, _CTSM_PYTHON) import ctsm.crop_calendars.cropcal_module as cc import ctsm.crop_calendars.generate_gdds_functions as gddfn diff --git a/python/ctsm/crop_calendars/generate_gdds_functions.py b/python/ctsm/crop_calendars/generate_gdds_functions.py index 6d6e2a7d54..20c958817a 100644 --- a/python/ctsm/crop_calendars/generate_gdds_functions.py +++ b/python/ctsm/crop_calendars/generate_gdds_functions.py @@ -7,6 +7,11 @@ from importlib import util as importlib_util # Import the CTSM Python utilities +_CTSM_PYTHON = os.path.join( + os.path.dirname(os.path.realpath(__file__)), os.pardir, os.pardir, os.pardir, "python" +) +import sys +sys.path.insert(1, _CTSM_PYTHON) import ctsm.crop_calendars.cropcal_utils as utils import ctsm.crop_calendars.cropcal_module as cc From 772e864922e5de85f2141c89007fb30e5cbc6b82 Mon Sep 17 00:00:00 2001 From: Sam Rabin Date: Fri, 15 Sep 2023 08:22:28 -0600 Subject: [PATCH 242/257] run_sys_tests: Don't check module availability during run_ctsm_py_tests. --- python/ctsm/run_sys_tests.py | 21 +++++++++++++++------ 1 file changed, 15 insertions(+), 6 deletions(-) diff --git a/python/ctsm/run_sys_tests.py b/python/ctsm/run_sys_tests.py index a44e4ab3cf..53500b88e9 100644 --- a/python/ctsm/run_sys_tests.py +++ b/python/ctsm/run_sys_tests.py @@ -213,6 +213,9 @@ def run_sys_tests( rerun_existing_failures=rerun_existing_failures, extra_create_test_args=extra_create_test_args, ) + + running_ctsm_py_tests = testfile == "/path/to/testfile" or testlist in [['test1', 'test2'], ['foo']] or suite_name == "my_suite" + if suite_name: if not dry_run: _make_cs_status_for_suite(testroot, testid_base) @@ -225,20 +228,24 @@ def run_sys_tests( testroot=testroot, create_test_args=create_test_args, dry_run=dry_run, + running_ctsm_py_tests=running_ctsm_py_tests, ) else: if not dry_run: _make_cs_status_non_suite(testroot, testid_base) + running_ctsm_py_tests = testfile == "/path/to/testfile" if testfile: test_args = ["--testfile", os.path.abspath(testfile)] - with open(test_args[1], "r") as f: - testname_list = f.readlines() + if not running_ctsm_py_tests: + with open(test_args[1], "r") as f: + testname_list = f.readlines() elif testlist: test_args = testlist testname_list = testlist else: raise RuntimeError("None of suite_name, testfile or testlist were provided") - _try_systemtests(testname_list) + if not running_ctsm_py_tests: + _try_systemtests(testname_list) _run_create_test( cime_path=cime_path, test_args=test_args, @@ -672,9 +679,10 @@ def _run_test_suite( testroot, create_test_args, dry_run, + running_ctsm_py_tests, ): if not suite_compilers: - suite_compilers = _get_compilers_for_suite(suite_name, machine.name) + suite_compilers = _get_compilers_for_suite(suite_name, machine.name, running_ctsm_py_tests) for compiler in suite_compilers: test_args = [ "--xml-category", @@ -705,13 +713,14 @@ def _try_systemtests(testname_list): raise ModuleNotFoundError("modify_fsurdat" + errMsg) -def _get_compilers_for_suite(suite_name, machine_name): +def _get_compilers_for_suite(suite_name, machine_name, running_ctsm_py_tests): test_data = get_tests_from_xml(xml_machine=machine_name, xml_category=suite_name) if not test_data: raise RuntimeError( "No tests found for suite {} on machine {}".format(suite_name, machine_name) ) - _try_systemtests([t["testname"] for t in test_data]) + if not running_ctsm_py_tests: + _try_systemtests([t["testname"] for t in test_data]) compilers = sorted({one_test["compiler"] for one_test in test_data}) logger.info("Running with compilers: %s", compilers) return compilers From d229b5c6689efc4c2a6cef077515c4ccd5c18ff6 Mon Sep 17 00:00:00 2001 From: Sam Rabin Date: Fri, 15 Sep 2023 08:25:05 -0600 Subject: [PATCH 243/257] Reformatted with black. --- cime_config/SystemTests/fsurdatmodifyctsm.py | 2 ++ cime_config/SystemTests/rxcropmaturity.py | 12 ++++++------ cime_config/SystemTests/systemtest_utils.py | 4 +++- .../ctsm/crop_calendars/generate_gdds_functions.py | 1 + python/ctsm/run_sys_tests.py | 10 +++++++--- 5 files changed, 19 insertions(+), 10 deletions(-) diff --git a/cime_config/SystemTests/fsurdatmodifyctsm.py b/cime_config/SystemTests/fsurdatmodifyctsm.py index 43b155dc0b..03e437d5c4 100644 --- a/cime_config/SystemTests/fsurdatmodifyctsm.py +++ b/cime_config/SystemTests/fsurdatmodifyctsm.py @@ -11,6 +11,7 @@ # For calling fsurdat_modifier from argparse import Namespace + _CTSM_PYTHON = os.path.join( os.path.dirname(os.path.realpath(__file__)), os.pardir, os.pardir, "python" ) @@ -82,6 +83,7 @@ def _run_modify_fsurdat(self): verbose=False, ) from ctsm.modify_input_files.fsurdat_modifier import fsurdat_modifier + fsurdat_modifier(fsurdat_modifier_args) def _modify_user_nl(self): diff --git a/cime_config/SystemTests/rxcropmaturity.py b/cime_config/SystemTests/rxcropmaturity.py index f292346582..6a2cbe14b0 100644 --- a/cime_config/SystemTests/rxcropmaturity.py +++ b/cime_config/SystemTests/rxcropmaturity.py @@ -273,14 +273,14 @@ def _setup_make_fsurdat_all_crops_everywhere(self): # Write a bash script that will do what we want prerun_script = os.path.join(self._path_gddgen, "make_fsurdat_all_crops_everywhere.sh") prerun_script_lines = [ - "#!/bin/bash", - "set -e", - "conda run -n ctsm_pylib " + command, - "exit 0", - ] + "#!/bin/bash", + "set -e", + "conda run -n ctsm_pylib " + command, + "exit 0", + ] with open(prerun_script, "w") as f: f.writelines(line + "\n" for line in prerun_script_lines) - os.chmod(prerun_script, 0o755) # 0o755 = -rwxr-xr-x + os.chmod(prerun_script, 0o755) # 0o755 = -rwxr-xr-x with self._case: self._case.set_value("PRERUN_SCRIPT", prerun_script) diff --git a/cime_config/SystemTests/systemtest_utils.py b/cime_config/SystemTests/systemtest_utils.py index 90a5abcf95..2560f5441f 100644 --- a/cime_config/SystemTests/systemtest_utils.py +++ b/cime_config/SystemTests/systemtest_utils.py @@ -54,7 +54,9 @@ def run_python_script(caseroot, this_conda_env, command_in, tool_path): ) except subprocess.CalledProcessError as error: # First, retry with the original method - command = cmds_to_run_via_conda(caseroot, f"conda activate {this_conda_env} && ", command_in, test_conda_retry=False) + command = cmds_to_run_via_conda( + caseroot, f"conda activate {this_conda_env} && ", command_in, test_conda_retry=False + ) try: with open(tool_name + ".log2", "w") as f: subprocess.run( diff --git a/python/ctsm/crop_calendars/generate_gdds_functions.py b/python/ctsm/crop_calendars/generate_gdds_functions.py index 20c958817a..c1a15324a2 100644 --- a/python/ctsm/crop_calendars/generate_gdds_functions.py +++ b/python/ctsm/crop_calendars/generate_gdds_functions.py @@ -11,6 +11,7 @@ os.path.dirname(os.path.realpath(__file__)), os.pardir, os.pardir, os.pardir, "python" ) import sys + sys.path.insert(1, _CTSM_PYTHON) import ctsm.crop_calendars.cropcal_utils as utils import ctsm.crop_calendars.cropcal_module as cc diff --git a/python/ctsm/run_sys_tests.py b/python/ctsm/run_sys_tests.py index 53500b88e9..6b792b9bce 100644 --- a/python/ctsm/run_sys_tests.py +++ b/python/ctsm/run_sys_tests.py @@ -213,9 +213,13 @@ def run_sys_tests( rerun_existing_failures=rerun_existing_failures, extra_create_test_args=extra_create_test_args, ) - - running_ctsm_py_tests = testfile == "/path/to/testfile" or testlist in [['test1', 'test2'], ['foo']] or suite_name == "my_suite" - + + running_ctsm_py_tests = ( + testfile == "/path/to/testfile" + or testlist in [["test1", "test2"], ["foo"]] + or suite_name == "my_suite" + ) + if suite_name: if not dry_run: _make_cs_status_for_suite(testroot, testid_base) From bea7a3339ba31005480616095cceda4f66c0290f Mon Sep 17 00:00:00 2001 From: Sam Rabin Date: Fri, 15 Sep 2023 08:25:48 -0600 Subject: [PATCH 244/257] Added previous commit to .git-blame-ignore-revs. --- .git-blame-ignore-revs | 1 + 1 file changed, 1 insertion(+) diff --git a/.git-blame-ignore-revs b/.git-blame-ignore-revs index 9b7cb3c036..edd62049b5 100644 --- a/.git-blame-ignore-revs +++ b/.git-blame-ignore-revs @@ -1,4 +1,5 @@ # Ran python directory through black python formatter +d229b5c6689efc4c2a6cef077515c4ccd5c18ff6 4cd83cb3ee6d85eb909403487abf5eeaf4d98911 0aa2957c1f8603c63fa30b11295c06cfddff44a5 2cdb380febb274478e84cd90945aee93f29fa2e6 From d867aa48f11d8a4ad388e0f1add9c4675d380a1b Mon Sep 17 00:00:00 2001 From: Sam Rabin Date: Fri, 15 Sep 2023 08:37:53 -0600 Subject: [PATCH 245/257] run_sys_tests.py now satisfies pylint. --- python/ctsm/run_sys_tests.py | 18 ++++++++++++------ 1 file changed, 12 insertions(+), 6 deletions(-) diff --git a/python/ctsm/run_sys_tests.py b/python/ctsm/run_sys_tests.py index 6b792b9bce..e4a0bcf009 100644 --- a/python/ctsm/run_sys_tests.py +++ b/python/ctsm/run_sys_tests.py @@ -241,8 +241,8 @@ def run_sys_tests( if testfile: test_args = ["--testfile", os.path.abspath(testfile)] if not running_ctsm_py_tests: - with open(test_args[1], "r") as f: - testname_list = f.readlines() + with open(test_args[1], "r") as testfile_abspath: + testname_list = testfile_abspath.readlines() elif testlist: test_args = testlist testname_list = testlist @@ -709,12 +709,18 @@ def _run_test_suite( def _try_systemtests(testname_list): - errMsg = " can't be loaded. Do you need to activate the ctsm_pylib conda environment?" - if any(["FSURDATMODIFYCTSM" in t for t in testname_list]): + err_msg = " can't be loaded. Do you need to activate the ctsm_pylib conda environment?" + # Suppress pylint import-outside-toplevel warning because (a) we only want to import + # this when certain tests are requested, and (b) the import needs to be in a try-except + # block to produce a nice error message. + # pylint: disable=import-outside-toplevel disable + # Suppress pylint unused-import warning because the import itself IS the use. + # pylint: disable=unused-import disable + if any("FSURDATMODIFYCTSM" in t for t in testname_list): try: import ctsm.modify_input_files.modify_fsurdat - except ModuleNotFoundError: - raise ModuleNotFoundError("modify_fsurdat" + errMsg) + except ModuleNotFoundError as err: + raise ModuleNotFoundError("modify_fsurdat" + err_msg) from err def _get_compilers_for_suite(suite_name, machine_name, running_ctsm_py_tests): From 7b57111f1722ebb47661cdf728cecf7a1b02b0d8 Mon Sep 17 00:00:00 2001 From: Sam Rabin Date: Fri, 15 Sep 2023 14:41:31 -0600 Subject: [PATCH 246/257] Added separate is_today_in_doy_interval() function. * Includes unit test for new function. * Existing function is_doy_in_interval() now requires queried doy to be specified, no longer falling back on "today." --- src/utils/clm_time_manager.F90 | 35 +++++++++++++----- .../test_clm_time_manager.pf | 37 +++++++++++++++++++ 2 files changed, 62 insertions(+), 10 deletions(-) diff --git a/src/utils/clm_time_manager.F90 b/src/utils/clm_time_manager.F90 index e1a94effc0..5c65f5decd 100644 --- a/src/utils/clm_time_manager.F90 +++ b/src/utils/clm_time_manager.F90 @@ -60,6 +60,7 @@ module clm_time_manager is_end_curr_year, &! return true on last timestep in current year is_perpetual, &! return true if perpetual calendar is in use is_doy_in_interval, &! return true if day of year is in the provided interval + is_today_in_doy_interval, &! return true if today's day of year is in the provided interval is_near_local_noon, &! return true if near local noon is_restart, &! return true if this is a restart run update_rad_dtime, &! track radiation interval via nstep @@ -1760,28 +1761,20 @@ end function is_perpetual !========================================================================================= - logical function is_doy_in_interval(start, end, doy_in) + logical function is_doy_in_interval(start, end, doy) ! Return true if day of year is in the provided interval. ! Does not treat leap years differently from normal years. ! Arguments integer, intent(in) :: start ! start of interval (day of year) integer, intent(in) :: end ! end of interval (day of year) - integer, optional, intent(in) :: doy_in ! day of year to query + integer, intent(in) :: doy ! day of year to query ! Local variables - integer :: doy logical :: window_crosses_newyear character(len=*), parameter :: sub = 'clm::is_doy_in_interval' - ! Get doy of beginning of current timestep if doy_in is not provided - if (present(doy_in)) then - doy = doy_in - else - doy = get_prev_calday() - end if - window_crosses_newyear = end < start if (window_crosses_newyear .and. & @@ -1798,6 +1791,28 @@ end function is_doy_in_interval !========================================================================================= + logical function is_today_in_doy_interval(start, end) + + ! Return true if today's day of year is in the provided interval. + ! Does not treat leap years differently from normal years. + ! Arguments + integer, intent(in) :: start ! start of interval (day of year) + integer, intent(in) :: end ! end of interval (day of year) + + ! Local variable(s) + integer :: doy_today + + character(len=*), parameter :: sub = 'clm::is_today_in_doy_interval' + + ! Get doy of beginning of current timestep + doy_today = get_prev_calday() + + is_today_in_doy_interval = is_doy_in_interval(start, end, doy_today) + + end function is_today_in_doy_interval + + !========================================================================================= + subroutine timemgr_datediff(ymd1, tod1, ymd2, tod2, days) ! Calculate the difference (ymd2,tod2) - (ymd1,tod1) and return the result in days. diff --git a/src/utils/test/clm_time_manager_test/test_clm_time_manager.pf b/src/utils/test/clm_time_manager_test/test_clm_time_manager.pf index d5f5dc9361..fe68efdbdc 100644 --- a/src/utils/test/clm_time_manager_test/test_clm_time_manager.pf +++ b/src/utils/test/clm_time_manager_test/test_clm_time_manager.pf @@ -608,4 +608,41 @@ contains end subroutine check_is_doy_in_interval + @Test + subroutine check_is_today_in_doy_interval(this) + class(TestTimeManager), intent(inout) :: this + + integer :: start, end + + call unittest_timemgr_setup(dtime=dtime, use_gregorian_calendar=.true.) + + start = 100 ! April 10 + end = 300 ! October 27 + + ! Test well before interval + call set_date(yr=2009, mon=3, day=25, tod=0) + @assertFalse(is_today_in_doy_interval(start, end)) + + ! Test last timestep before interval + call set_date(yr=2009, mon=4, day=10, tod=0) + @assertFalse(is_today_in_doy_interval(start, end)) + + ! Test first timestep of interval + call set_date(yr=2009, mon=4, day=10, tod=dtime) + @assertTrue(is_today_in_doy_interval(start, end)) + + ! Test well within interval + call set_date(yr=2009, mon=7, day=24, tod=0) + @assertTrue(is_today_in_doy_interval(start, end)) + + ! Test last timestep of interval + call set_date(yr=2009, mon=10, day=28, tod=0) + @assertTrue(is_today_in_doy_interval(start, end)) + + ! Test first timestep after interval + call set_date(yr=2009, mon=10, day=28, tod=dtime) + @assertFalse(is_today_in_doy_interval(start, end)) + + end subroutine check_is_today_in_doy_interval + end module test_clm_time_manager From eded771363ee2020e51ad633712b89ce4d8f7e8b Mon Sep 17 00:00:00 2001 From: Sam Rabin Date: Fri, 15 Sep 2023 15:16:45 -0600 Subject: [PATCH 247/257] Split check_is_doy_in_interval() into three tests. --- .../test_clm_time_manager.pf | 31 +++++++++++++------ 1 file changed, 22 insertions(+), 9 deletions(-) diff --git a/src/utils/test/clm_time_manager_test/test_clm_time_manager.pf b/src/utils/test/clm_time_manager_test/test_clm_time_manager.pf index fe68efdbdc..78565fd54d 100644 --- a/src/utils/test/clm_time_manager_test/test_clm_time_manager.pf +++ b/src/utils/test/clm_time_manager_test/test_clm_time_manager.pf @@ -578,35 +578,48 @@ contains end subroutine bad_hilontolocal_time @Test - subroutine check_is_doy_in_interval(this) + subroutine check_is_doy_in_interval_startend(this) class(TestTimeManager), intent(inout) :: this - integer :: start, end + integer, parameter :: start = 100 + integer, parameter :: end = 300 - start = 100 - end = 300 @assertTrue(is_doy_in_interval(start, end, start)) @assertTrue(is_doy_in_interval(start, end, end)) @assertTrue(is_doy_in_interval(start, end, 200)) @assertFalse(is_doy_in_interval(start, end, 35)) @assertFalse(is_doy_in_interval(start, end, 350)) - start = 300 - end = 100 + end subroutine check_is_doy_in_interval_startend + + @Test + subroutine check_is_doy_in_interval_endstart(this) + class(TestTimeManager), intent(inout) :: this + + integer, parameter :: start = 300 + integer, parameter :: end = 100 + @assertTrue(is_doy_in_interval(start, end, start)) @assertTrue(is_doy_in_interval(start, end, end)) @assertFalse(is_doy_in_interval(start, end, 200)) @assertTrue(is_doy_in_interval(start, end, 35)) @assertTrue(is_doy_in_interval(start, end, 350)) - start = 300 - end = 300 + end subroutine check_is_doy_in_interval_endstart + + @Test + subroutine check_is_doy_in_interval_sameday(this) + class(TestTimeManager), intent(inout) :: this + + integer, parameter :: start = 300 + integer, parameter :: end = 300 + @assertTrue(is_doy_in_interval(start, end, start)) @assertTrue(is_doy_in_interval(start, end, end)) @assertFalse(is_doy_in_interval(start, end, 200)) @assertFalse(is_doy_in_interval(start, end, 350)) - end subroutine check_is_doy_in_interval + end subroutine check_is_doy_in_interval_sameday @Test subroutine check_is_today_in_doy_interval(this) From 20739bc6fdf70d64826fdfb17fbf4437bbb808ec Mon Sep 17 00:00:00 2001 From: Sam Rabin Date: Mon, 18 Sep 2023 11:46:37 -0600 Subject: [PATCH 248/257] Reverted all changes to rxcropmaturity.py. --- cime_config/SystemTests/rxcropmaturity.py | 24 ++++++++--------------- 1 file changed, 8 insertions(+), 16 deletions(-) diff --git a/cime_config/SystemTests/rxcropmaturity.py b/cime_config/SystemTests/rxcropmaturity.py index 6a2cbe14b0..15f524dfce 100644 --- a/cime_config/SystemTests/rxcropmaturity.py +++ b/cime_config/SystemTests/rxcropmaturity.py @@ -135,7 +135,7 @@ def run_phase(self): # Make custom version of surface file logger.info("RXCROPMATURITY log: run make_fsurdat_all_crops_everywhere") - self._setup_make_fsurdat_all_crops_everywhere() + self._run_make_fsurdat_all_crops_everywhere() # ------------------------------------------------------------------- # (2) Perform GDD-generating run and generate prescribed GDDs file @@ -239,7 +239,7 @@ def _setup_all(self): logger.info("RXCROPMATURITY log: _setup_all done") # Make a surface dataset that has every crop in every gridcell - def _setup_make_fsurdat_all_crops_everywhere(self): + def _run_make_fsurdat_all_crops_everywhere(self): # fsurdat should be defined. Where is it? self._fsurdat_in = None @@ -269,20 +269,12 @@ def _setup_make_fsurdat_all_crops_everywhere(self): command = ( f"python3 {tool_path} " + f"-i {self._fsurdat_in} " + f"-o {self._fsurdat_out}" ) - - # Write a bash script that will do what we want - prerun_script = os.path.join(self._path_gddgen, "make_fsurdat_all_crops_everywhere.sh") - prerun_script_lines = [ - "#!/bin/bash", - "set -e", - "conda run -n ctsm_pylib " + command, - "exit 0", - ] - with open(prerun_script, "w") as f: - f.writelines(line + "\n" for line in prerun_script_lines) - os.chmod(prerun_script, 0o755) # 0o755 = -rwxr-xr-x - with self._case: - self._case.set_value("PRERUN_SCRIPT", prerun_script) + stu.run_python_script( + self._get_caseroot(), + self._this_conda_env, + command, + tool_path, + ) # Modify namelist logger.info("RXCROPMATURITY log: modify user_nl files: new fsurdat") From d1ed672c188f2ed5ea1bdb8f9052733c08b57e24 Mon Sep 17 00:00:00 2001 From: Sam Rabin Date: Mon, 18 Sep 2023 14:15:12 -0600 Subject: [PATCH 249/257] Improved comments in systemtest_utils.py. --- cime_config/SystemTests/systemtest_utils.py | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/cime_config/SystemTests/systemtest_utils.py b/cime_config/SystemTests/systemtest_utils.py index 2560f5441f..c10b0392e9 100644 --- a/cime_config/SystemTests/systemtest_utils.py +++ b/cime_config/SystemTests/systemtest_utils.py @@ -43,6 +43,7 @@ def cmds_to_run_via_conda(caseroot, conda_run_call, command, test_conda_retry=Tr def run_python_script(caseroot, this_conda_env, command_in, tool_path): + # First, try with "conda run -n" command = cmds_to_run_via_conda(caseroot, f"conda run -n {this_conda_env}", command_in) # Run with logfile @@ -53,7 +54,8 @@ def run_python_script(caseroot, this_conda_env, command_in, tool_path): command, shell=True, check=True, text=True, stdout=f, stderr=subprocess.STDOUT ) except subprocess.CalledProcessError as error: - # First, retry with the original method + # Retry with the original ("conda activate") method. Set test_conda_retry False because + # that didn't happen in the original method. command = cmds_to_run_via_conda( caseroot, f"conda activate {this_conda_env} && ", command_in, test_conda_retry=False ) From 11bfed6d1fa94f5779012b72e1c963b0bdd4d2c4 Mon Sep 17 00:00:00 2001 From: Sam Rabin Date: Mon, 18 Sep 2023 15:29:39 -0600 Subject: [PATCH 250/257] Removed test_conda_retry=False option. --- cime_config/SystemTests/systemtest_utils.py | 14 ++++++-------- 1 file changed, 6 insertions(+), 8 deletions(-) diff --git a/cime_config/SystemTests/systemtest_utils.py b/cime_config/SystemTests/systemtest_utils.py index c10b0392e9..6076faf8cd 100644 --- a/cime_config/SystemTests/systemtest_utils.py +++ b/cime_config/SystemTests/systemtest_utils.py @@ -5,7 +5,7 @@ import os, subprocess -def cmds_to_setup_conda(caseroot, test_conda_retry=True): +def cmds_to_setup_conda(caseroot): # Add specific commands needed on different machines to get conda available # Use semicolon here since it's OK to fail # @@ -21,17 +21,16 @@ def cmds_to_setup_conda(caseroot, test_conda_retry=True): # Remove python and add conda to environment for cheyennne unload_python_load_conda = "module unload python; module load conda;" # Make sure that adding this actually loads conda - if test_conda_retry: - subprocess.run(unload_python_load_conda + "which conda", shell=True, check=True) + subprocess.run(unload_python_load_conda + "which conda", shell=True, check=True) # Save conda_setup_commands += " " + unload_python_load_conda return conda_setup_commands -def cmds_to_run_via_conda(caseroot, conda_run_call, command, test_conda_retry=True): +def cmds_to_run_via_conda(caseroot, conda_run_call, command): # Run in the specified conda environment - conda_setup_commands = cmds_to_setup_conda(caseroot, test_conda_retry) + conda_setup_commands = cmds_to_setup_conda(caseroot) conda_setup_commands += " " + conda_run_call # Finish with Python script call @@ -54,10 +53,9 @@ def run_python_script(caseroot, this_conda_env, command_in, tool_path): command, shell=True, check=True, text=True, stdout=f, stderr=subprocess.STDOUT ) except subprocess.CalledProcessError as error: - # Retry with the original ("conda activate") method. Set test_conda_retry False because - # that didn't happen in the original method. + # Retry with the original "conda activate" method command = cmds_to_run_via_conda( - caseroot, f"conda activate {this_conda_env} && ", command_in, test_conda_retry=False + caseroot, f"conda activate {this_conda_env} && ", command_in, ) try: with open(tool_name + ".log2", "w") as f: From 542d27517318bab1fd06b4f27aa1820cf50784ea Mon Sep 17 00:00:00 2001 From: Sam Rabin Date: Mon, 18 Sep 2023 15:34:58 -0600 Subject: [PATCH 251/257] Added comments explaining use of sys.path.insert() in crop calendar scripts. --- python/ctsm/crop_calendars/cropcal_module.py | 3 ++- python/ctsm/crop_calendars/generate_gdds.py | 2 ++ python/ctsm/crop_calendars/generate_gdds_functions.py | 4 ++-- 3 files changed, 6 insertions(+), 3 deletions(-) diff --git a/python/ctsm/crop_calendars/cropcal_module.py b/python/ctsm/crop_calendars/cropcal_module.py index 1d58e2fbab..76c295974d 100644 --- a/python/ctsm/crop_calendars/cropcal_module.py +++ b/python/ctsm/crop_calendars/cropcal_module.py @@ -5,7 +5,8 @@ import os import glob -# Import the CTSM Python utilities +# Import the CTSM Python utilities. +# sys.path.insert() is necessary for RXCROPMATURITY to work. The fact that it's calling this script in the RUN phase seems to require the python/ directory to be manually added to path. _CTSM_PYTHON = os.path.join( os.path.dirname(os.path.realpath(__file__)), os.pardir, os.pardir, os.pardir, "python" ) diff --git a/python/ctsm/crop_calendars/generate_gdds.py b/python/ctsm/crop_calendars/generate_gdds.py index 9fe1c26e14..b54e7df40f 100644 --- a/python/ctsm/crop_calendars/generate_gdds.py +++ b/python/ctsm/crop_calendars/generate_gdds.py @@ -5,6 +5,8 @@ import inspect import sys +# Import the CTSM Python utilities. +# sys.path.insert() is necessary for RXCROPMATURITY to work. The fact that it's calling this script in the RUN phase seems to require the python/ directory to be manually added to path. _CTSM_PYTHON = os.path.join( os.path.dirname(os.path.realpath(__file__)), os.pardir, os.pardir, os.pardir, "python" ) diff --git a/python/ctsm/crop_calendars/generate_gdds_functions.py b/python/ctsm/crop_calendars/generate_gdds_functions.py index c1a15324a2..cb4655d00b 100644 --- a/python/ctsm/crop_calendars/generate_gdds_functions.py +++ b/python/ctsm/crop_calendars/generate_gdds_functions.py @@ -6,12 +6,12 @@ import datetime as dt from importlib import util as importlib_util -# Import the CTSM Python utilities +# Import the CTSM Python utilities. +# sys.path.insert() is necessary for RXCROPMATURITY to work. The fact that it's calling this script in the RUN phase seems to require the python/ directory to be manually added to path. _CTSM_PYTHON = os.path.join( os.path.dirname(os.path.realpath(__file__)), os.pardir, os.pardir, os.pardir, "python" ) import sys - sys.path.insert(1, _CTSM_PYTHON) import ctsm.crop_calendars.cropcal_utils as utils import ctsm.crop_calendars.cropcal_module as cc From 8a168bb0895f4f2421608dd2589398e13a6663e6 Mon Sep 17 00:00:00 2001 From: Sam Rabin Date: Mon, 18 Sep 2023 15:51:11 -0600 Subject: [PATCH 252/257] Reformatting with black. --- cime_config/SystemTests/systemtest_utils.py | 4 +++- python/ctsm/crop_calendars/generate_gdds_functions.py | 1 + 2 files changed, 4 insertions(+), 1 deletion(-) diff --git a/cime_config/SystemTests/systemtest_utils.py b/cime_config/SystemTests/systemtest_utils.py index 6076faf8cd..c5ac986abd 100644 --- a/cime_config/SystemTests/systemtest_utils.py +++ b/cime_config/SystemTests/systemtest_utils.py @@ -55,7 +55,9 @@ def run_python_script(caseroot, this_conda_env, command_in, tool_path): except subprocess.CalledProcessError as error: # Retry with the original "conda activate" method command = cmds_to_run_via_conda( - caseroot, f"conda activate {this_conda_env} && ", command_in, + caseroot, + f"conda activate {this_conda_env} && ", + command_in, ) try: with open(tool_name + ".log2", "w") as f: diff --git a/python/ctsm/crop_calendars/generate_gdds_functions.py b/python/ctsm/crop_calendars/generate_gdds_functions.py index cb4655d00b..cb05f1920d 100644 --- a/python/ctsm/crop_calendars/generate_gdds_functions.py +++ b/python/ctsm/crop_calendars/generate_gdds_functions.py @@ -12,6 +12,7 @@ os.path.dirname(os.path.realpath(__file__)), os.pardir, os.pardir, os.pardir, "python" ) import sys + sys.path.insert(1, _CTSM_PYTHON) import ctsm.crop_calendars.cropcal_utils as utils import ctsm.crop_calendars.cropcal_module as cc From 9d7ac50f73d7ae7c96a7a952c42e8cc2f9d04359 Mon Sep 17 00:00:00 2001 From: Sam Rabin Date: Mon, 18 Sep 2023 15:51:42 -0600 Subject: [PATCH 253/257] Added previous commit to .git-blame-ignore-revs. --- .git-blame-ignore-revs | 1 + 1 file changed, 1 insertion(+) diff --git a/.git-blame-ignore-revs b/.git-blame-ignore-revs index edd62049b5..03ea138bad 100644 --- a/.git-blame-ignore-revs +++ b/.git-blame-ignore-revs @@ -14,3 +14,4 @@ b771971e3299c4fa56534b93421f7a2b9c7282fd # Ran SystemTests and python/ctsm through black python formatter 5364ad66eaceb55dde2d3d598fe4ce37ac83a93c 8056ae649c1b37f5e10aaaac79005d6e3a8b2380 +8a168bb0895f4f2421608dd2589398e13a6663e6 From abddd3f905ea1087d71e6f30f0441ec77bcbb190 Mon Sep 17 00:00:00 2001 From: Sam Rabin Date: Tue, 19 Sep 2023 09:39:57 -0600 Subject: [PATCH 254/257] Revert adding RXCROPMATURITY to 2 test suites. --- cime_config/testdefs/testlist_clm.xml | 17 ----------------- 1 file changed, 17 deletions(-) diff --git a/cime_config/testdefs/testlist_clm.xml b/cime_config/testdefs/testlist_clm.xml index 2b46310a9a..2fe8565759 100644 --- a/cime_config/testdefs/testlist_clm.xml +++ b/cime_config/testdefs/testlist_clm.xml @@ -2551,23 +2551,6 @@ - - - - - - - - - - - - - - - - - From 540b256d1f3382f4619d7b0877c32d54ce5c40b6 Mon Sep 17 00:00:00 2001 From: Sam Rabin Date: Tue, 19 Sep 2023 11:24:46 -0600 Subject: [PATCH 255/257] Reformatting with black. --- cime_config/SystemTests/rxcropmaturity.py | 11 +++++------ 1 file changed, 5 insertions(+), 6 deletions(-) diff --git a/cime_config/SystemTests/rxcropmaturity.py b/cime_config/SystemTests/rxcropmaturity.py index bfa8ead151..b3b43cff07 100644 --- a/cime_config/SystemTests/rxcropmaturity.py +++ b/cime_config/SystemTests/rxcropmaturity.py @@ -257,7 +257,9 @@ def _run_fsurdat_modifier(self): # Where we will save the fsurdat version for this test path, ext = os.path.splitext(self._fsurdat_in) dir_in, filename_in_noext = os.path.split(path) - self._fsurdat_out = os.path.join(self._path_gddgen, f"{filename_in_noext}.all_crops_everywhere{ext}") + self._fsurdat_out = os.path.join( + self._path_gddgen, f"{filename_in_noext}.all_crops_everywhere{ext}" + ) # Make fsurdat for this test, if not already done if not os.path.exists(self._fsurdat_out): @@ -275,9 +277,7 @@ def _run_fsurdat_modifier(self): ) self._create_config_file_evenlysplitcrop() - command = ( - f"python3 {tool_path} {self._cfg_path} " - ) + command = f"python3 {tool_path} {self._cfg_path} " stu.run_python_script( self._get_caseroot(), self._this_conda_env, @@ -330,7 +330,6 @@ def _create_config_file_evenlysplitcrop(self): cfg_out.write("PCT_LAKE = 0.0\n") cfg_out.write("PCT_URBAN = 0.0 0.0 0.0\n") - def _run_check_rxboth_run(self): output_dir = os.path.join(self._get_caseroot(), "run") @@ -397,7 +396,7 @@ def _run_generate_gdds(self, case_gddgen): f"--sdates-file {sdates_file}", f"--hdates-file {hdates_file}", f"--output-dir generate_gdds_out", - f"--skip-crops miscanthus,irrigated_miscanthus" + f"--skip-crops miscanthus,irrigated_miscanthus", ] ) stu.run_python_script( From d6d67c59641dd70130c1066cd71d6b54cd6c4a6a Mon Sep 17 00:00:00 2001 From: Sam Rabin Date: Tue, 19 Sep 2023 11:25:24 -0600 Subject: [PATCH 256/257] Added previous commit to .git-blame-ignore-revs. --- .git-blame-ignore-revs | 1 + 1 file changed, 1 insertion(+) diff --git a/.git-blame-ignore-revs b/.git-blame-ignore-revs index c6bbe1227f..cf56217215 100644 --- a/.git-blame-ignore-revs +++ b/.git-blame-ignore-revs @@ -15,3 +15,4 @@ b771971e3299c4fa56534b93421f7a2b9c7282fd 5933b0018f8e29413e30dda9b906370d147bad45 # Ran SystemTests and python/ctsm through black python formatter 5364ad66eaceb55dde2d3d598fe4ce37ac83a93c +540b256d1f3382f4619d7b0877c32d54ce5c40b6 From f3f76f4b1144788d579836143f1c5a1bae04f49c Mon Sep 17 00:00:00 2001 From: Sam Rabin Date: Tue, 19 Sep 2023 11:01:48 -0600 Subject: [PATCH 257/257] Updated ChangeLog and ChangeSum. --- doc/ChangeLog | 73 +++++++++++++++++++++++++++++++++++++++++++++++++++ doc/ChangeSum | 1 + 2 files changed, 74 insertions(+) diff --git a/doc/ChangeLog b/doc/ChangeLog index 518e2b59cb..8e8a99b868 100644 --- a/doc/ChangeLog +++ b/doc/ChangeLog @@ -1,4 +1,77 @@ =============================================================== +Tag name: ctsm5.1.dev142 +Originator(s): samrabin (Sam Rabin, UCAR/TSS, samrabin@ucar.edu) +Date: Tue Sep 19 11:30:22 MDT 2023 +One-line Summary: Merge 5 bit-for-bit pull requests + +Purpose and description of changes +---------------------------------- + +Merge 5 bit-for-bit pull requests; see "Other details." + + +Significant changes to scientifically-supported configurations +-------------------------------------------------------------- + +Does this tag change answers significantly for any of the following physics configurations? +(Details of any changes will be given in the "Answer changes" section below.) + +[ ] clm5_1 + +[ ] clm5_0 + +[ ] ctsm5_0-nwp + +[ ] clm4_5 + + +Bugs fixed or introduced +------------------------ +CTSM issues fixed (include CTSM Issue #): +* Add unit test for making fsurdat with all crops everywhere (#2079) +* Rework master_list_(no)?fates.rst? (#2083) +* conda run -n can fail if a conda environment is already active (#2109) +* conda fails to load for SystemTests (#2111) + + +Notes of particular relevance for developers: +--------------------------------------------- +Changes to tests or testing: +* FSURDATMODIFYCTSM system test should now work for everyone. + + +Testing summary: +---------------- + + [PASS means all tests PASS; OK means tests PASS other than expected fails.] + + build-namelist tests (if CLMBuildNamelist.pm has changed): + + cheyenne - PASS + + python testing (if python code has changed; see instructions in python/README.md; document testing done): + + cheyenne - PASS + clm_pymods test suite on cheyenne - PASS + + regular tests (aux_clm: https://github.com/ESCOMP/CTSM/wiki/System-Testing-Guide#pre-merge-system-testing): + + cheyenne ---- OK + izumi ------- OK + + +Other details +------------- + +Pull Requests that document the changes (include PR ids): +* Add system and unit tests for making fsurdat with all crops everywhere (#2081) +* Rework master_list* files etc. (#2087) +* Fixes to methane Tech Note (#2091) +* Add is_doy_in_interval() function (#2158) +* Avoid using subprocess.run() in FSURDATMODIFYCTSM (#2125) + +=============================================================== +=============================================================== Tag name: ctsm5.1.dev141 Originator(s): slevis (Samuel Levis,UCAR/TSS,303-665-1310) Date: Wed Sep 13 13:58:04 MDT 2023 diff --git a/doc/ChangeSum b/doc/ChangeSum index 95a0285551..e11f439658 100644 --- a/doc/ChangeSum +++ b/doc/ChangeSum @@ -1,5 +1,6 @@ Tag Who Date Summary ============================================================================================================================ + ctsm5.1.dev142 samrabin 09/19/2023 Merge 5 bit-for-bit pull requests ctsm5.1.dev141 slevis 09/13/2023 Change small snocan to zero ctsm5.1.dev140 afoster 09/12/2023 add lai_streams capability for FATES ctsm5.1.dev139 slevis 08/28/2023 Fix problems uncovered by nag -nan tests