c c subroutine remove i (sr,grainp,cropp,decompp,cutht,bgp, i dstand,dflat,droot,dblwgnd, i stand,roott,yield,nlay, i cropht,rootdt,dstemht, i cropname,croppop,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 + + + KEYWORDS + + + c remove, biomass manipulation *$noereference include 'p1werm.inc' include 's1layr.inc' include 'manage/harv.inc' *$reference c c + + + ARGUMENT DECLARATIONS + + + c real grainp,cropp,decompp,cutht,bgp real dstand(mnbpls),dflat(mnbpls),droot(mnbpls,mnsz), & dblwgnd(mnbpls,mnsz) real stand,roott,yield,dstemht(mnbpls) real cropht,rootdt,croppop c c + + + ARGUMENT DEFINITIONS + + + c c bqp - percent of below ground biomass crop c cropht - current crop height (m) c cropp - percent of crop removed (rest is left as flat residue) c croppop - crop population (number of stems) c cutht - the above ground height that a crop is cut to c a (-1) indicates the crop is below ground c dblwgnd - (decomp) below ground biomass by layer and pool (kg / m^2) c decomp - percent of decoposition material removed c dflat - (decomp) surface biomass by age pool (kg / m^2) c droot - (decomp) root biomass by layer and pool (kg / m^2) c dstand - (decomp) standing biomass by age pool (kg / m^2) c dstemht - (decomp) biomass stem height by pool (m) c flag - flag indicating which type of remove to perform c grainp - percent of grain removed c roott - crop root biomass (kg / m^2) NOT!! by layer c rootdt - crop root depth (m) c stand - standing crop biomass (kg / m^2) c yield - crop yield (kg / m^2) 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 sr,i,lay,nlay,flag real flatmass,standmass,bgmass(mnsz),rtmass(mnsz) c c + + + LOCAL VARIABLE DEFINITIONS + + + c c bgmass - temporary below ground mass / layer (kg / m^2) c flatmass - temporary flatmass pool (kg / m^2) 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 rtmass - temporary rootmass pool / layer (kg / m^2) c standmass - temporary standing mass pool (kg / m^2) c all temporary pools are used when the call to kill (dechrv.for) is c made. The variables get stuck in the first biomass pool. c + + + END SPECIFICATIONS + + + c initialize harvmass to zero before removing biomass. harvmass = 0.0 C *** bad debugging fix flatmass = 0.0 standmass = 0.0 do 991 i = 1, mnsz bgmass(i) = 0.0 rtmass(i) = 0.0 991 continue C *** eodf c c****************************************************************** if (btest(flag,0) ) then c print *, 'Flag 0 is on' c print *, 'Remove standing crop at the harvest height' c Calculate the standing mass that is removed and determine which c pecentage of the mass goes to flat and which is removed totaly c Update the standing and flat mass pools accordingly. Note that c the yield is included in this standing mass. Maybe we should be c seperating this out before these calculations are made???? if (cutht.lt.cropht) then flatmass = flatmass+(1.0-cropp)*(stand-yield)* & (1.0-(cutht/cropht)) standmass = (stand-yield)*(cutht/cropht) harvmass = harvmass+(stand-yield)*(1.0-cutht/cropht) cropht = cutht else c print *, 'Nothing to remove/cut' endif endif c***************************************************************** if (BTEST(flag,1)) then c print *, 'Flag 1 is on' c print *, 'Remove root mass at the harvest depth' if (nlay.eq.0) then c print *, 'your depth is not deep enough to remove anything' c print *, 'make sure you entered a negitive cut height ' goto 201 endif do 200 lay=1,nlay rtmass(lay) = roott/nlay*(1.0 - bgp) c also need to remove roots from decomp pools(1 & 2) do 200 i=1,mnbpls droot(i,lay) = (1.0-bgp)*droot(i,lay) 200 continue endif 201 continue c***************************************************************** if (BTEST(flag,2)) then c print *, 'Flag 2 is on' c print *, 'Remove yield mass from the crop' c Remove the yield from the crop. Most of the yield will be removed c but some may go into the flat pool so we need to update this flatmass = flatmass+yield*(1.0-grainp) harvmass = harvmass+yield endif c**************************************************************** if (BTEST(flag,3)) then c print *, 'Flag 3 is on' c print *, 'Remove all standing mass at the harvest height' c This flag is set when there is a need to remove the c crop at a certain harvest height and other biomass not related c to the crop (ie. stuff in the decomp pools above the harvest c height) c print *, 'cropht', cropht c print *, 'cutht', cutht if (cutht.lt.cropht) then flatmass = flatmass+(1.0-cropp)* & (stand-yield)*(1.0-(cutht/cropht)) standmass = (stand-yield)*(cutht/cropht) harvmass = harvmass+(stand-yield)*(1.0-cutht/cropht) cropht = cutht else c print *, 'Nothing to remove/cut' endif do 40 i=1,mnbpls if (cutht.lt.dstemht(i)) then dflat(i) = dflat(i)+(1.0-decompp)*dstand(i)* & (1.0-cutht/dstemht(i)) dstand(i) = dstand(i)*(cutht/dstemht(i)) dstemht(i) = cutht if (dflat(i).lt.0.0) dflat(i)=0.0 if (dstand(i).lt.0.0) dstand(i)=0.0 if (dstemht(i).lt.0.0) dstemht(i)=0.0 else c print *, 'Nothing to remove/cut in decomp pool',i c pause endif 40 continue endif c**************************************************************** if (BTEST(flag,4)) then c print *, 'Flag 4 is on' c print *, 'Remove all above ground biomass (flat and standing)' c Remove all biomass flat and standing(100%). This includes both the c current crop and the biomass in the decomposition pools standmass = 0.0 flatmass = 0.0 harvmass = harvmass + stand cropht = 0.0 do 50 i = 1,mnbpls dstand(i) = 0.0 dflat(i) = 0.0 dstemht(i) = 0.0 50 continue endif c***************************************************************** if (BTEST(flag,5)) then c print *, 'Flag 5 is on' c print *, 'Remove all flat residue (decomp pools only)' do 60 i=1,(mnbpls) dflat(i) = 0.0 60 continue endif call dechrv(sr,cropname,standmass,flatmass,bgmass(1), & rtmass(1),cutht,croppop) end