c c subroutine remove i (yldfr,cstfr,dstfr,bgfr,cutht, m cstemht, cstems, cyld, cstand, m croot, crootz, m tstemht, tstems, tyld, tstand, tflat, m tbg, tbgz, troot, trootz, m dstemht, dstems, dstand, dflat, m dbgz, drootz, i nlay, flag) c + + + PURPOSE + + + c c This subroutine performs the biomass manipulation of removing c biomass. Removal can be from one or more of the following c processes: harvest, graze, burns and in the harvest process c the following can be removed: grain, crop, or all. The component c removed is determined by flag which is set before the call to c this subroutine. The flag may contain any number of combinations c found below. c c Flags (binary #'s actually) c 0 - remove standing crop at harvest height (1) c 1 - remove root mass of crop (2) c 2 - remove yield from a standing crop (4) c 3 - remove all standing mass (crop and decomp pools) at a c harvest height (16) c 4 - remove all above ground biomass (flat and standing) (32) c 5 - remove flat residue only (64) c c Notes for future enhancements: c c I think that we will want/need more flexibility in this process effect c in the future. My thoughts on how this can possibly be accomplished are: c c 1. Introduce more than one "flag" to handle the variety of potential c options required to be able to simulate most harvest processes correctly. c a) bioflg - selects which age pools will be processed. Probably the c same definition as other biomass manipulation process effects use. c b) xxlocflg - selects the individual mass component pools that are c being effected (material being removed in this case). There would c likely need to be more than one of these flags, possibly one for each c "age" pool. Example settings could be: c c crlocflg (st,yld,flt,bg,rt) decomp1locflg (st,flt,bg,rt) c c bit val bit val c x st+yld+flt 0 x st+flt 0 c 0 yld*fract 1 0 - 1 c 1 st*fract 2 1 st*fract 2 c 2 fl*fract 4 2 fl*fract 4 c 3 bg*fract 8 3 bg*fract 8 c 4 rt*fract 16 4 rt*fract 16 c 5 st*cutht 32 5 st*cutht 32 c c 2. It appears likely to me that many harvest operations may require c multiple "remove" effect calls to adequately simulate their effects. c This would help simplify the logic within the "remove" effect, but c will require more code in the user interface to interact with the c user and to display all the "remove" effects with their appropriate c parameters and values. c + + + KEYWORDS + + + c remove, biomass manipulation *$noereference include 'p1werm.inc' include 's1layr.inc' include 'manage/harv.inc' *$reference c c + + + ARGUMENT DECLARATIONS + + + c real yldfr,cstfr,dstfr,bgfr,cutht real cstemht, cstems, cyld, cstand real croot, crootz(mnsz) real tstemht, tstems, tyld, tstand, tflat real tbg, tbgz(mnsz), troot, trootz(mnsz) real dstemht(mnbpls), dstems(mnbpls) real dstand(mnbpls), dflat(mnbpls) real dbgz(mnsz,mnbpls), drootz(mnsz,mnbpls) integer flag c c + + + ARGUMENT DEFINITIONS + + + c c yldfr - fraction of yield (reproductive components) removed (kg/kg) c cstfr - fraction of standing crop removed (kg/kg) c dstfr - fraction of standing residue removed (kg/kg) c bgfr - fraction of below ground biomass material (including roots) removed (kg/kg) c cutht - the above ground height that biomass is cut to (m) c cstemht - current crop height (m) c cstems - crop population (# stems/m^2) c cyld - (crop pool) yield biomass (kg/m^2) c cstand - (crop pool) standing biomass (kg/m^2) c croot - (crop pool) total root biomass (kg/m^2) c crootz - (crop pool) root biomass by layer (kg/m^2) c tstemht - (temporary crop pool) current (dead) crop height (m) c tstems - (temporary crop pool) stem population (# stems/m^2) c tyld - (temporary crop pool) yield biomass (kg/m^2) c tstand - (temporary crop pool) standing biomass (kg/m^2) c tflat - (temporary crop pool) flat biomass (kg/m^2) c tbg - (temporary crop pool) total below ground biomass (kg/m^2) c tbgz - (temporary crop pool) below ground biomass by layer (kg/m^2) c troot - (temporary crop pool) total root biomass (kg/m^2) c trootz - (temporary crop pool) root biomass by layer (kg/m^2) c dstemht - (decomp pool) standing residue height (m) c dstems - (decomp pool) number of standing residue stems (#/m^2) c dstand - (decomp pool) standing biomass by age pool (kg/m^2) c dflat - (decomp pool) surface biomass by age pool (kg/m^2) c dbgz - (decomp pool) buried biomass by age pool & layer (kg/m^2) c drootz - (decomp pool) root biomass by age pool & layer (kg/m^2) c flag - flag indicating which type of remove to perform c c + + + ACCESSED COMMON BLOCK VARIABLE DEFINITIONS + + + c c mnbpls - max number of decomposition pools (currently=3) c mnsz - max number of soil layers c nslay - number of soil layers used in a subregion c c + + + PARAMETERS + + + c c + + + LOCAL VARIABLES + + + c character cropname*80 integer i,lay,nlay c c + + + LOCAL VARIABLE DEFINITIONS + + + c c i - loop variable for decomp pools (3 pools total) c lay - number of layers in a specified subregion c nlay - number of layers in the tillage zone c + + + END SPECIFICATIONS + + + c****************************************************************** c Determine the amount of standing crop mass above cutht to be removed. c Update the new crop stem height parameters. c (note that both the crop and temporary crop pools are updated) if (BTEST(flag,0)) then ! cut and remove standing crop if (cutht.lt.cstemht) then cstand = cstand * (1.0 - cutht/cstemht) cstemht = cutht tstand = tstand * (1.0 - cutht/cstemht) tstemht = cutht else c print *, 'No crop biomass to cut and remove' endif endif c***************************************************************** c Remove fraction (bgfr) of crop root mass from each soil layer if (BTEST(flag,1)) then do 200 lay=1,nlay crootz(lay) = crootz(lay) * (1.0 - bgfr) trootz(lay) = trootz(lay) * (1.0 - bgfr) 200 continue croot = croot * (1.0 - bgfr) troot = troot * (1.0 - bgfr) endif c***************************************************************** c Remove fraction (yldfr) of crop yield mass if (BTEST(flag,2)) then cyld = cyld * (1.0 - yldfr) tyld = tyld * (1.0 - yldfr) endif c**************************************************************** c Determine the amount of standing residue mass above cutht to be removed. c Update the new residue stem height parameters. c (note that all decomp pools are checked and updated) if (BTEST(flag,3)) then ! cut and remove standing residue do 300 i=1,mnbpls if (cutht.lt.dstemht(i)) then dstand(i) = dstand(i) * (1.0 - cutht/dstemht(i)) dstemht(i) = cutht else c print *, 'No crop biomass to cut and remove' endif 300 continue endif c**************************************************************** c Determine the amount of standing stems (crop and residue) that are removed c Note that crop and residue pools are both processed here, but they c may have different removal fractions if (BTEST(flag,4)) then ! remove fraction of standing stems cstems = cstems * (1.0 - cstfr) tstems = tstems * (1.0 - cstfr) do 50 i = 1,mnbpls dstems(i) = dstems(i) * (1.0 - dstfr) 50 continue endif c***************************************************************** c Remove fraction of all flat residue (temporary and decomp pools) if (BTEST(flag,5)) then tflat = tflat * (1.0 - dstfr) do 60 i=1,(mnbpls) dflat(i) = dflat(i) * (1.0 - dstfr) 60 continue endif end