subroutine mgt_harvbiomass (jj, iplant, iharvop) !! ~ ~ ~ PURPOSE ~ ~ ~ !! this subroutine performs the harvest operation for above ground biomass (no kill) use organic_mineral_mass_module use soil_module use plant_module use plant_data_module use mgt_operations_module use constituent_mass_module use carbon_module use pesticide_data_module, only : pestdb use output_ls_pesticide_module implicit none integer :: j = 0 !none |HRU number integer :: k = 0 !none |pesticide counter integer :: idp = 0 ! | integer :: npl !none |counter integer, intent (in) :: jj !none |counter integer, intent (in) :: iplant ! |plant number xwalked from hlt_db()%plant and plants.plt integer, intent (in) :: iharvop ! |harvest operation type integer :: ipl = 0 !none |counter real :: clippst = 0. !kg pst/ha |pesticide in clippings real :: yldpst = 0. !kg pst/ha |pesticide removed in yield real :: hi_tot = 0. !(kg/ha)/(kg/ha) |total harvest index = hi_ovr * harveff real :: hi_ovr = 0. !(kg/ha)/(kg/ha) |harvest index target specified at harvest real :: harveff = 0. !0-1 |harvest efficiency real :: clip = 0. !0-1 |1.-harveff real :: yld_rto = 0. !0-1 |yield to total biomass ratio j = jj ipl = iplant idp = pcom(j)%plcur(ipl)%idplt hi_ovr = harvop_db(iharvop)%hi_ovr harveff = harvop_db(iharvop)%eff !! remove yield from seed, leaf, and stem - using hi_ovr for all parts hi_tot = hi_ovr * harveff harv_seed = hi_tot * pl_mass(j)%seed(ipl) harv_leaf = hi_tot * pl_mass(j)%leaf(ipl) harv_stem = hi_tot * pl_mass(j)%stem(ipl) pl_yield = harv_seed + harv_leaf + harv_stem !! check if above ground > minimum biomass to cut if (pl_mass(j)%ab_gr(ipl)%m - pl_yield%m > harvop_db(iharvop)%bm_min) then !! apply pest stress to harvest index - mass lost due to pests - don't add to residue pl_yield = (1. - pcom(j)%plcur(ipl)%pest_stress) * pl_yield !! add plant carbon for printing hrc_d(j)%plant_surf_c = hrc_d(j)%plant_surf_c + pl_yield%c hpc_d(j)%harv_abgr_c = hpc_d(j)%harv_abgr_c + pl_yield%c !! adjust foliar and internal pesticide for plant removal do k = 1, cs_db%num_pests if (pl_mass(j)%tot(ipl)%m > 1.e-6) then yld_rto = (hi_tot * pl_mass(j)%ab_gr(ipl)%m) / pl_mass(j)%tot(ipl)%m yld_rto = Min(yld_rto, 1.) else yld_rto = 0. end if yldpst = yld_rto * (cs_pl(j)%pl_in(ipl)%pest(k) + cs_pl(j)%pl_on(ipl)%pest(k)) hpestb_d(j)%pest(k)%harv_export = hpestb_d(j)%pest(k)%harv_export + yldpst !! BUG FIX: original code kept yld_rto fraction instead of (1-yld_rto) cs_pl(j)%pl_in(ipl)%pest(k) = (1. - yld_rto) * cs_pl(j)%pl_in(ipl)%pest(k) cs_pl(j)%pl_in(ipl)%pest(k) = Max (0., cs_pl(j)%pl_in(ipl)%pest(k)) cs_pl(j)%pl_on(ipl)%pest(k) = (1. - yld_rto) * cs_pl(j)%pl_on(ipl)%pest(k) cs_pl(j)%pl_on(ipl)%pest(k) = Max (0., cs_pl(j)%pl_on(ipl)%pest(k)) !! pl_on clippings always return to soil regardless of sink flag !! (foliar pesticide — not part of the internal uptake pathway) clippst = (1. - harveff) * cs_pl(j)%pl_on(ipl)%pest(k) if (clippst < 0.) clippst = 0. !! add pesticide in clippings to soil surface cs_soil(j)%ly(1)%pest(k) = cs_soil(j)%ly(1)%pest(k) + clippst !! pl_in clippings: return to soil for non-sink only !! for sink: pl_in clippings are permanently immobilized in removed biomass !! and do not return to soil (intentional — this fraction exits the active cycle) if (pestdb(cs_db%pest_num(k))%harvest_sink < 0.5) then clippst = (1. - harveff) * cs_pl(j)%pl_in(ipl)%pest(k) if (clippst < 0.) clippst = 0. !! track internal pesticide returned to soil from harvest clipping hpestb_d(j)%pest(k)%kill_ret = hpestb_d(j)%pest(k)%kill_ret + clippst cs_soil(j)%ly(1)%pest(k) = cs_soil(j)%ly(1)%pest(k) + clippst else !! sink: internal clipping mass is terminally removed from field, !! track it as harvest export (no return to soil) !! this is a guard that should not need to be triggered as pl_in is not !! populated when sink is 1 clippst = (1. - harveff) * cs_pl(j)%pl_in(ipl)%pest(k) if (clippst < 0.) clippst = 0. hpestb_d(j)%pest(k)%harv_export = hpestb_d(j)%pest(k)%harv_export + clippst end if !! BUG FIX: remove clipping fraction from plant storage !! Previously, clippst was added to cs_soil but never removed from cs_pl, !! duplicating mass. After clipping, only harveff fraction remains on plant. cs_pl(j)%pl_in(ipl)%pest(k) = harveff * cs_pl(j)%pl_in(ipl)%pest(k) cs_pl(j)%pl_on(ipl)%pest(k) = harveff * cs_pl(j)%pl_on(ipl)%pest(k) end do !! update remaining plant organic pools pl_mass(j)%seed(ipl) = pl_mass(j)%seed(ipl) - harv_seed pl_mass(j)%leaf(ipl) = pl_mass(j)%leaf(ipl) - harv_leaf pl_mass(j)%stem(ipl) = pl_mass(j)%stem(ipl) - harv_stem pl_mass(j)%tot(ipl) = pl_mass(j)%tot(ipl) - pl_yield pl_mass(j)%ab_gr(ipl) = pl_mass(j)%ab_gr(ipl) - pl_yield !! add clippings (biomass left behind) to surface residue pool clip = 1. - harveff harv_left = clip * pl_yield pl_mass(j)%rsd(ipl) = harv_left + pl_mass(j)%rsd(ipl) !! update total residue pool pl_mass(j)%rsd_tot = orgz do npl = 1, pcom(j)%npl pl_mass(j)%rsd_tot = pl_mass(j)%rsd_tot + pl_mass(j)%rsd(npl) end do !! calculation for dead roots allocations, resetting phenology, updating other pools !! reset leaf area index and fraction of growing season if (pl_mass(j)%tot(ipl)%m > 0.001) then !! assume the lai biomass relationship - 0.5 lai decline for biomass removal pcom(j)%plg(ipl)%lai = pcom(j)%plg(ipl)%lai * (1. - 0.5 * hi_tot) pcom(j)%plcur(ipl)%phuacc = pcom(j)%plcur(ipl)%phuacc * (1. - 0.5 * hi_tot) pcom(j)%plg(ipl)%root_frac = pl_mass(j)%root(ipl)%m / pl_mass(j)%tot(ipl)%m else pl_mass(j)%tot(ipl)%m = 0. pcom(j)%plg(ipl)%lai = 0. pcom(j)%plcur(ipl)%phuacc = 0. end if end if !ab_gr_bm > bm_min return end subroutine mgt_harvbiomass