From b24e0aa02c8b5609486f97e403ca9de366cf96da Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Wed, 12 Jul 2023 14:50:02 -0600 Subject: [PATCH 1/6] 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 2/6] 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 298c7058ac60ec92ed73560bbac5024c00faa849 Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Fri, 28 Jul 2023 12:43:25 -0600 Subject: [PATCH 3/6] 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 f10c7fe07fa6d6123437a4049316873e3e0fb40c Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Mon, 21 Aug 2023 19:02:34 -0600 Subject: [PATCH 4/6] 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 5/6] 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 01c208da730eca335f0c24af602dd128ae107093 Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Fri, 25 Aug 2023 14:46:48 -0600 Subject: [PATCH 6/6] 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: ----------------