diff --git a/doc/ChangeLog b/doc/ChangeLog index 10aa517a60..ab2b760ecb 100644 --- a/doc/ChangeLog +++ b/doc/ChangeLog @@ -1,4 +1,59 @@ =============================================================== +Tag name: ctsm5.1.dev138 +Originator(s): slevis (Samuel Levis,UCAR/TSS,303-665-1310) +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 +---------------------------------- + +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 #): +Fixes #2025 "Refactor loops that use max_patch_per_col?" + +Testing summary: +---------------- + [PASS means all tests PASS; OK means tests PASS other than expected fails.] + + regular tests (aux_clm: https://github.com/ESCOMP/CTSM/wiki/System-Testing-Guide#pre-merge-system-testing): + + cheyenne ---- OK + izumi ------- OK + +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.dev137 Originator(s): Ronny Meier, slevis (Samuel Levis,UCAR/TSS,303-665-1310) Date: Tue Aug 22 14:34:53 MDT 2023 diff --git a/doc/ChangeSum b/doc/ChangeSum index fcd0e6bd45..0d9e4d3745 100644 --- a/doc/ChangeSum +++ b/doc/ChangeSum @@ -1,5 +1,6 @@ Tag Who Date Summary ============================================================================================================================ + ctsm5.1.dev138 slevis 08/25/2023 Refactor max_patch_per_col and maxsoil_patches loops ctsm5.1.dev137 slevis 08/23/2023 Surface roughness modifications ctsm5.1.dev136 multiple 08/22/2023 Change order of history fields to improve performance on derecho ctsm5.1.dev135 slevis 08/21/2023 Rename hist fields to track them down more easily diff --git a/src/biogeochem/CNCIsoFluxMod.F90 b/src/biogeochem/CNCIsoFluxMod.F90 index c10659a945..608966d213 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 : 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 !----------------------------------------------------------------------- @@ -578,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) @@ -587,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 @@ -600,7 +597,6 @@ subroutine CIsoFlux2(num_soilc, filter_soilc, num_soilp , filter_soilp, & ! ! !LOCAL VARIABLES: - integer :: fp,pi !----------------------------------------------------------------------- associate( & @@ -720,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) @@ -729,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 @@ -859,14 +853,14 @@ 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 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) @@ -875,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 @@ -1010,14 +1002,14 @@ 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 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, & @@ -1027,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 @@ -1041,7 +1031,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,fp,cc,j,i,fc + integer :: fp,pp,l,cc,j,i !----------------------------------------------------------------------- associate( & @@ -1276,7 +1266,6 @@ 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 fp = 1,num_soilp pp = filter_soilp(fp) cc = patch%column(pp) @@ -1292,11 +1281,7 @@ subroutine CIsoFlux3(num_soilc , filter_soilc, num_soilp , filter_soilp, & 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 @@ -1333,7 +1318,7 @@ subroutine CIsoFlux3(num_soilc , filter_soilc, 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 @@ -1371,7 +1356,7 @@ subroutine CNCIsoLitterToColumn (num_soilp, filter_soilp, & type(cnveg_carbonflux_type) , intent(inout) :: iso_cnveg_carbonflux_inst ! ! !LOCAL VARIABLES: - integer :: c,pi,p,k,j,i,fp + integer :: fp,c,p,k,j,i !----------------------------------------------------------------------- associate( & @@ -1393,11 +1378,10 @@ subroutine CNCIsoLitterToColumn (num_soilp, filter_soilp, & ) do j = 1, nlevdecomp - 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) + & @@ -1406,7 +1390,7 @@ subroutine CNCIsoLitterToColumn (num_soilp, filter_soilp, & ! 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 @@ -1415,7 +1399,7 @@ subroutine CNCIsoLitterToColumn (num_soilp, filter_soilp, & 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 @@ -1426,7 +1410,7 @@ subroutine CNCIsoLitterToColumn (num_soilp, filter_soilp, & 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 @@ -1435,7 +1419,6 @@ subroutine CNCIsoLitterToColumn (num_soilp, filter_soilp, & 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 @@ -1460,7 +1443,7 @@ subroutine CNCIsoGapPftToColumn (num_soilp, filter_soilp, & type(cnveg_carbonflux_type) , intent(inout) :: iso_cnveg_carbonflux_inst ! ! !LOCAL VARIABLES: - integer :: fp,c,pi,p,j,i ! indices + integer :: fp,c,p,j,i ! indices !----------------------------------------------------------------------- associate( & @@ -1501,7 +1484,6 @@ subroutine CNCIsoGapPftToColumn (num_soilp, filter_soilp, & ) do j = 1, nlevdecomp - do fp = 1,num_soilp p = filter_soilp(fp) c = patch%column(p) @@ -1516,7 +1498,7 @@ subroutine CNCIsoGapPftToColumn (num_soilp, filter_soilp, & 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) @@ -1526,7 +1508,7 @@ subroutine CNCIsoGapPftToColumn (num_soilp, filter_soilp, & 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 @@ -1548,7 +1530,7 @@ subroutine CNCIsoGapPftToColumn (num_soilp, filter_soilp, & 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 @@ -1558,7 +1540,7 @@ subroutine CNCIsoGapPftToColumn (num_soilp, filter_soilp, & end subroutine CNCIsoGapPftToColumn !----------------------------------------------------------------------- - subroutine CNCIsoHarvestPftToColumn (num_soilc, filter_soilc, & + subroutine CNCIsoHarvestPftToColumn (num_soilp, filter_soilp, & soilbiogeochem_state_inst, iso_cnveg_carbonflux_inst) ! ! !DESCRIPTION: @@ -1566,13 +1548,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 patches in filter + integer , intent(in) :: filter_soilp(:) ! soil patch filter type(soilbiogeochem_state_type) , intent(in) :: soilbiogeochem_state_inst type(cnveg_carbonflux_type) , intent(inout) :: iso_cnveg_carbonflux_inst ! ! !LOCAL VARIABLES: - integer :: fc,c,pi,p,j,i ! indices + integer :: fp,c,p,j,i ! indices !----------------------------------------------------------------------- associate( & @@ -1613,76 +1595,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 @@ -1690,7 +1656,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: @@ -1698,13 +1664,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 patches in filter + integer , intent(in) :: filter_soilp(:) ! soil patch filter type(soilbiogeochem_state_type) , intent(in) :: soilbiogeochem_state_inst type(cnveg_carbonflux_type) , intent(inout) :: iso_cnveg_carbonflux_inst ! ! !LOCAL VARIABLES: - integer :: fc,c,pi,p,j,i ! indices + integer :: fp,c,p,j,i ! indices !----------------------------------------------------------------------- associate( & @@ -1747,54 +1713,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 - - 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) + do fp = 1,num_soilp + p = filter_soilp(fp) + c = patch%column(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/CNDriverMod.F90 b/src/biogeochem/CNDriverMod.F90 index 0907211add..4ab1e1f51e 100644 --- a/src/biogeochem/CNDriverMod.F90 +++ b/src/biogeochem/CNDriverMod.F90 @@ -696,15 +696,17 @@ subroutine CNDriverNoLeaching(bounds, !-------------------------------------------- if_bgc_vegp1: if(num_bgc_vegp>0)then - + call t_startf('CNGapMortality') - call CNGapMortality (bounds, num_bgc_soilc, filter_bgc_soilc, num_bgc_vegp, filter_bgc_vegp, & + + call CNGapMortality (bounds, num_bgc_vegp, filter_bgc_vegp, & dgvs_inst, cnveg_carbonstate_inst, cnveg_nitrogenstate_inst, soilbiogeochem_nitrogenflux_inst, & cnveg_carbonflux_inst, cnveg_nitrogenflux_inst, canopystate_inst, & leaf_prof_patch=soilbiogeochem_state_inst%leaf_prof_patch(begp:endp, 1:nlevdecomp_full), & froot_prof_patch=soilbiogeochem_state_inst%froot_prof_patch(begp:endp, 1:nlevdecomp_full), & croot_prof_patch=soilbiogeochem_state_inst%croot_prof_patch(begp:endp, 1:nlevdecomp_full), & stem_prof_patch=soilbiogeochem_state_inst%stem_prof_patch(begp:endp, 1:nlevdecomp_full)) + call t_stopf('CNGapMortality') !-------------------------------------------------------------------------- @@ -713,24 +715,25 @@ subroutine CNDriverNoLeaching(bounds, ! and use_soil_matrixcn) but most of the state updates are done after ! the matrix multiply in VegMatrix and SoilMatrix. !-------------------------------------------------------------------------- - + call t_startf('CNUpdate2') + ! Set the carbon isotopic fluxes for gap mortality if ( use_c13 ) then - call CIsoFlux2(num_bgc_soilc, filter_bgc_soilc, num_bgc_vegp, filter_bgc_vegp, & + call CIsoFlux2(num_bgc_vegp, filter_bgc_vegp, & soilbiogeochem_state_inst, cnveg_carbonflux_inst, cnveg_carbonstate_inst, & iso_cnveg_carbonflux_inst=c13_cnveg_carbonflux_inst, & iso_cnveg_carbonstate_inst=c13_cnveg_carbonstate_inst, & isotope='c13') end if if ( use_c14 ) then - call CIsoFlux2(num_bgc_soilc, filter_bgc_soilc, num_bgc_vegp, filter_bgc_vegp, & + call CIsoFlux2(num_bgc_vegp, filter_bgc_vegp, & soilbiogeochem_state_inst, cnveg_carbonflux_inst, cnveg_carbonstate_inst, & iso_cnveg_carbonflux_inst=c14_cnveg_carbonflux_inst, & iso_cnveg_carbonstate_inst=c14_cnveg_carbonstate_inst, & isotope='c14') end if - + ! Update all the prognostic carbon state variables affected by gap-phase mortality fluxes call CStateUpdate2(num_bgc_soilc, filter_bgc_soilc, num_bgc_vegp, filter_bgc_vegp, & cnveg_carbonflux_inst, cnveg_carbonstate_inst, soilbiogeochem_carbonstate_inst, & @@ -745,7 +748,7 @@ subroutine CNDriverNoLeaching(bounds, c14_cnveg_carbonflux_inst, c14_cnveg_carbonstate_inst, c14_soilbiogeochem_carbonstate_inst, & c14_soilbiogeochem_carbonflux_inst) end if - + ! Update all the prognostic nitrogen state variables affected by gap-phase mortality fluxes call NStateUpdate2(num_bgc_soilc, filter_bgc_soilc, num_bgc_vegp, filter_bgc_vegp, & cnveg_nitrogenflux_inst, cnveg_nitrogenstate_inst,soilbiogeochem_nitrogenstate_inst, & @@ -757,23 +760,23 @@ subroutine CNDriverNoLeaching(bounds, ! and use_soil_matrixcn) but most of the state updates are done after ! the matrix multiply in VegMatrix and SoilMatrix. !-------------------------------------------------------------------------- - + ! Set harvest mortality routine if (get_do_harvest()) then - call CNHarvest(num_bgc_soilc, filter_bgc_soilc, num_bgc_vegp, filter_bgc_vegp, & + call CNHarvest(num_bgc_vegp, filter_bgc_vegp, & soilbiogeochem_state_inst, cnveg_carbonstate_inst, cnveg_nitrogenstate_inst, & cnveg_carbonflux_inst, cnveg_nitrogenflux_inst) end if - + if ( use_c13 ) then - call CIsoFlux2h(num_bgc_soilc, filter_bgc_soilc, num_bgc_vegp, filter_bgc_vegp, & + call CIsoFlux2h(num_bgc_vegp, filter_bgc_vegp, & soilbiogeochem_state_inst, & cnveg_carbonflux_inst, cnveg_carbonstate_inst, & c13_cnveg_carbonflux_inst, c13_cnveg_carbonstate_inst, & isotope='c13') end if if ( use_c14 ) then - call CIsoFlux2h(num_bgc_soilc, filter_bgc_soilc, num_bgc_vegp, filter_bgc_vegp, & + call CIsoFlux2h(num_bgc_vegp, filter_bgc_vegp, & soilbiogeochem_state_inst, & cnveg_carbonflux_inst, cnveg_carbonstate_inst, & c14_cnveg_carbonflux_inst, c14_cnveg_carbonstate_inst, & @@ -793,37 +796,37 @@ subroutine CNDriverNoLeaching(bounds, c14_cnveg_carbonflux_inst, c14_cnveg_carbonstate_inst, c14_soilbiogeochem_carbonstate_inst, & c14_soilbiogeochem_carbonflux_inst) end if - + call NStateUpdate2h(num_bgc_soilc, filter_bgc_soilc, num_bgc_vegp, filter_bgc_vegp, & cnveg_nitrogenflux_inst, cnveg_nitrogenstate_inst, soilbiogeochem_nitrogenstate_inst, & soilbiogeochem_nitrogenflux_inst) - + !-------------------------------------------- ! Update2g (gross unrepresented landcover change) !-------------------------------------------- - + ! Set gross unrepresented landcover change mortality routine if (get_do_grossunrep()) then - call CNGrossUnrep(num_bgc_soilc, filter_bgc_soilc, num_bgc_vegp, filter_bgc_vegp, & + call CNGrossUnrep(num_bgc_vegp, filter_bgc_vegp, & soilbiogeochem_state_inst, cnveg_carbonstate_inst, cnveg_nitrogenstate_inst, & cnveg_carbonflux_inst, cnveg_nitrogenflux_inst) end if - + if ( use_c13 ) then - call CIsoFlux2g(num_bgc_soilc, filter_bgc_soilc, num_bgc_vegp, filter_bgc_vegp, & + call CIsoFlux2g(num_bgc_vegp, filter_bgc_vegp, & soilbiogeochem_state_inst, & cnveg_carbonflux_inst, cnveg_carbonstate_inst, & c13_cnveg_carbonflux_inst, c13_cnveg_carbonstate_inst, & isotope='c13') end if if ( use_c14 ) then - call CIsoFlux2g(num_bgc_soilc, filter_bgc_soilc, num_bgc_vegp, filter_bgc_vegp, & + call CIsoFlux2g(num_bgc_vegp, filter_bgc_vegp, & soilbiogeochem_state_inst, & cnveg_carbonflux_inst, cnveg_carbonstate_inst, & c14_cnveg_carbonflux_inst, c14_cnveg_carbonstate_inst, & isotope='c14') end if - + call CStateUpdate2g( num_bgc_soilc, filter_bgc_soilc, num_bgc_vegp, filter_bgc_vegp, & cnveg_carbonflux_inst, cnveg_carbonstate_inst, soilbiogeochem_carbonstate_inst) if ( use_c13 ) then @@ -834,7 +837,7 @@ subroutine CNDriverNoLeaching(bounds, call CStateUpdate2g(num_bgc_soilc, filter_bgc_soilc, num_bgc_vegp, filter_bgc_vegp, & c14_cnveg_carbonflux_inst, c14_cnveg_carbonstate_inst, c14_soilbiogeochem_carbonstate_inst) end if - + call NStateUpdate2g(num_bgc_soilc, filter_bgc_soilc, num_bgc_vegp, filter_bgc_vegp, & cnveg_nitrogenflux_inst, cnveg_nitrogenstate_inst, soilbiogeochem_nitrogenstate_inst) @@ -925,6 +928,7 @@ subroutine CNDriverNoLeaching(bounds, !-------------------------------------------- if_bgc_vegp3: if(num_bgc_vegp>0)then + call t_startf('CNFire') call cnfire_method%CNFireArea(bounds, num_bgc_soilc, filter_bgc_soilc, num_bgc_vegp, filter_bgc_vegp, & num_exposedvegp, filter_exposedvegp, num_noexposedvegp, filter_noexposedvegp, & @@ -935,7 +939,7 @@ subroutine CNDriverNoLeaching(bounds, decomp_cpools_vr_col=soilbiogeochem_carbonstate_inst%decomp_cpools_vr_col(begc:endc,1:nlevdecomp_full,1:ndecomp_pools), & t_soi17cm_col=temperature_inst%t_soi17cm_col(begc:endc)) - call cnfire_method%CNFireFluxes(bounds, num_bgc_soilc, filter_bgc_soilc, num_bgc_vegp, filter_bgc_vegp, & + call cnfire_method%CNFireFluxes(bounds, num_bgc_soilc, filter_bgc_soilc, num_bgc_vegp, filter_bgc_vegp, & num_actfirec, filter_actfirec, num_actfirep, filter_actfirep, & dgvs_inst, cnveg_state_inst, & cnveg_carbonstate_inst, cnveg_carbonflux_inst, cnveg_nitrogenstate_inst, cnveg_nitrogenflux_inst, & @@ -950,6 +954,7 @@ subroutine CNDriverNoLeaching(bounds, somc_fire_col=soilbiogeochem_carbonflux_inst%somc_fire_col(begc:endc)) call t_stopf('CNFire') + !-------------------------------------------------------------------------- ! Update3 ! The state updates are still called for the matrix solution (use_matrixn @@ -959,7 +964,7 @@ subroutine CNDriverNoLeaching(bounds, call t_startf('CNUpdate3') if ( use_c13 ) then - call CIsoFlux3(num_bgc_soilc, filter_bgc_soilc, num_bgc_vegp, filter_bgc_vegp, & + call CIsoFlux3(num_bgc_vegp, filter_bgc_vegp, & soilbiogeochem_state_inst , soilbiogeochem_carbonstate_inst, & cnveg_carbonflux_inst, cnveg_carbonstate_inst, & c13_cnveg_carbonflux_inst, c13_cnveg_carbonstate_inst, & @@ -967,7 +972,7 @@ subroutine CNDriverNoLeaching(bounds, isotope='c13') end if if ( use_c14 ) then - call CIsoFlux3(num_bgc_soilc, filter_bgc_soilc, num_bgc_vegp, filter_bgc_vegp, & + call CIsoFlux3(num_bgc_vegp, filter_bgc_vegp, & soilbiogeochem_state_inst , soilbiogeochem_carbonstate_inst, & cnveg_carbonflux_inst, cnveg_carbonstate_inst, & c14_cnveg_carbonflux_inst, c14_cnveg_carbonstate_inst, & diff --git a/src/biogeochem/CNGapMortalityMod.F90 b/src/biogeochem/CNGapMortalityMod.F90 index ebda9db56d..aa53317fb3 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/biogeochem/CNPhenologyMod.F90 b/src/biogeochem/CNPhenologyMod.F90 index 510f2ba508..070dc0eb0f 100644 --- a/src/biogeochem/CNPhenologyMod.F90 +++ b/src/biogeochem/CNPhenologyMod.F90 @@ -550,7 +550,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) @@ -647,7 +647,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 @@ -832,7 +832,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 @@ -1288,7 +1288,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 @@ -2832,7 +2832,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 !----------------------------------------------------------------------- @@ -2968,7 +2968,7 @@ subroutine CNOffsetLitterfall (num_soilp, filter_soilp, & ! ! !LOCAL VARIABLES: integer :: p, c, k, h ! 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 @@ -3315,7 +3315,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 @@ -3472,7 +3472,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 !----------------------------------------------------------------------- @@ -3690,7 +3690,7 @@ subroutine CNLitterToColumn (bounds, num_bgc_vegp, filter_bgc_vegp, & real(r8) , intent(in) :: froot_prof_patch(bounds%begp:,1:) ! ! !LOCAL VARIABLES: - integer :: fp,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__) @@ -3774,7 +3774,7 @@ subroutine CNLitterToColumn (bounds, num_bgc_vegp, filter_bgc_vegp, & 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) + & @@ -3782,14 +3782,14 @@ subroutine CNLitterToColumn (bounds, num_bgc_vegp, filter_bgc_vegp, & 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) + & @@ -3799,9 +3799,9 @@ subroutine CNLitterToColumn (bounds, num_bgc_vegp, filter_bgc_vegp, & end if end do do_vegp end do do_nlev - + end associate - + end subroutine CNLitterToColumn end module CNPhenologyMod 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 a3ffd72b4e..b868224a60 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) @@ -316,7 +319,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 ), & @@ -1497,7 +1501,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) @@ -1513,12 +1518,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] @@ -1537,8 +1544,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 @@ -1630,79 +1637,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: @@ -1719,44 +1718,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 4aec62ff79..2bcf2ab396 100644 --- a/src/main/clm_driver.F90 +++ b/src/main/clm_driver.F90 @@ -843,6 +843,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 9a15140c76..376f18742b 100644 --- a/src/soilbiogeochem/SoilBiogeochemVerticalProfileMod.F90 +++ b/src/soilbiogeochem/SoilBiogeochemVerticalProfileMod.F90 @@ -71,7 +71,7 @@ subroutine SoilBiogeochemVerticalProfile(bounds, num_bgc_soilc,filter_bgc_soilc, 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 @@ -174,20 +174,12 @@ subroutine SoilBiogeochemVerticalProfile(bounds, num_bgc_soilc,filter_bgc_soilc, ! cinput_rootfr(bounds%begp:bounds%endp, :), & ! col_cinput_rootfr(bounds%begc:bounds%endc, :), & ! 'unity') - - - do fc = 1,num_bgc_soilc - c = filter_bgc_soilc(fc) - if(.not.col%is_fates(c))then - do pi = 1,col%npatches(c) !maxsoil_patches - !if (pi <= col%npatches(c)) then - p = col%patchi(c) + pi - 1 - do j = 1,nlevdecomp - col_cinput_rootfr(c,j) = col_cinput_rootfr(c,j) + cinput_rootfr(p,j) * patch%wtcol(p) - end do - !end if - end do - end if + do fp = 1,num_bgc_vegp + p = filter_bgc_vegp(fp) + 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