c$Author: fredfox $ c$Date: 2001-12-06 00:22:15 $ c$Revision: 1.8 $ c$Source: /weru/cvs/weps/weps.src/mproc/cut.for,v $ subroutine cut i (cutflg, cutht, grainf, cropf, standf, m cstemht, cyld, cstand, o tstemht, tyld, tstand, tflat, m dstemht, dstand, dflat, & tot_mass_rem, sel_mass_left) c + + + PURPOSE + + + c Process # 32 called from doproc.for c This subroutine performs the biomass manipulation of cutting c biomass. The component (either crop or a biomass pool) removed c is determined by flag which is set before the call to this c subroutine. c 0 - cut height is measured from ground up c 1 - cut height is measured from plant top down c 2 - cut height is fraction of plant height from top down c ie 0.7 means 70% of plant is cut off c Note that biomass for any of these pools that are cut is c either transferred to the coresponding flat pool or removed c depending on the three removal fraction values input c + + + KEYWORDS + + + c cut, transfer, biomass manipulation include 'p1werm.inc' include 'p1unconv.inc' c + + + ARGUMENT DECLARATIONS + + + integer cutflg real cutht, grainf, cropf, standf real cstemht,cyld,cstand real tstemht,tyld,tstand,tflat real dstemht(mnbpls),dstand(mnbpls),dflat(mnbpls) real tot_mass_rem, sel_mass_left c + + + ARGUMENT DEFINITIONS + + + c cutflg - cut height definition flag c cutht - above ground height standing crop and/or c residue is cut to (mm) or fraction c grainf - fraction of cut grain mass removed from field c cropf - fraction of cut growing crop mass removed from field c (stems not grain) c standf - fraction of cut standing residue removed from field c cstemht - (crop pool) current crop height (m) c cstand - (crop pool) standing biomass (kg/m^2) c tstemht - (temporary crop pool) stem height (m) c tstand - (temporary crop pool) standing biomass (kg/m^2) c tflat - (temporary crop pool) flat biomass (kg/m^2) c dstemht - (decomp pool) biomass stem height by pool (m) 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 sel_mass_left - mass of material left in pools from which mass is removed c by this harvest operation (kg/m^2) c + + + ACCESSED COMMON BLOCK VARIABLE DEFINITIONS + + + c mnbpls - max number of decomposition pools (currently=3) c + + + PARAMETERS + + + c + + + LOCAL VARIABLES + + + integer i, pool_flag real mass_cut, mass_rem c + + + LOCAL VARIABLE DEFINITIONS + + + c i - loop variable for decomp pools (3 pools total) c tot_mass_rem - total of all mass removed from the field c mass_cut - mass cut by cutting operation c mass_rem - mass removed from field by harvest operation c + + + END SPECIFICATIONS + + + c convert cut height based on cutflg and also change mm to meters c in this conversion, make it always from the ground up, and using c the max of either crop or temporary crop pools to make sure a c height greater than zero exists select case(cutflg) case(0) cutht = cutht*mmtom case(1) cutht = cutht*mmtom cutht = max(cstemht,tstemht) - cutht if(cutht.lt.0.0) cutht = 0.0 case(2) cutht = (1.0-cutht)*max(cstemht,tstemht) case default write(*,*) 'Invalid cutht flag, nothing cut' end select C*** print *, 'cut tflg: ', tflg C*** print *, 'tflat before cutting: ', tflat C*** print *, 'cutht/cstemht/tstemht: ', cutht,cstemht,tstemht C!!!!!!!!!!!!!!!!!!! C For now, until the crop database can be updated to include some C indication of yield location, all yield will be available for removal C if the cut height gets at least the top quarter of the plant, otherwise C the amount will be linearly reduced until it is zero when cut height C equals crop height. tot_mass_rem = 0.0 sel_mass_left = 0.0 pool_flag = 0 if (cutht.lt.cstemht) then ! cut crop pool c yield fraction if( cutht.ge.0.75*cstemht ) then mass_rem = cyld * ((cstemht-cutht)/(0.25*cstemht)) endif mass_rem = cyld * grainf if( mass_rem.gt.0.0 ) then pool_flag = 1 cyld = cyld - mass_rem tot_mass_rem = tot_mass_rem + mass_rem end if c stem fraction mass_cut = cstand * (1.0 - (cutht/cstemht)) mass_rem = mass_cut * cropf tflat = tflat + mass_cut - mass_rem if( mass_rem.gt.0.0 ) then pool_flag = 1 cstand = cstand - mass_cut tot_mass_rem = tot_mass_rem + mass_rem end if c stem height cstemht = cutht endif c add biomass to selected mass if biomass was removed from pool if( pool_flag.eq.1 ) then sel_mass_left = sel_mass_left + cyld + cstand pool_flag = 0 end if if (cutht.lt.tstemht) then ! cut temporary crop pool c yield fraction if( cutht.ge.0.75*tstemht ) then mass_rem = tyld * ((tstemht-cutht)/(0.25*tstemht)) endif mass_rem = tyld * grainf if( mass_rem.gt.0.0 ) then pool_flag = 1 tyld = tyld - mass_rem tot_mass_rem = tot_mass_rem + mass_rem end if c stem fraction mass_cut = tstand * (1.0 - (cutht/tstemht)) mass_rem = mass_cut * cropf tflat = tflat + mass_cut - mass_rem if( mass_rem.gt.0.0 ) then pool_flag = 1 tstand = tstand - mass_cut tot_mass_rem = tot_mass_rem + mass_rem end if c stem height tstemht = cutht endif c add biomass to selected mass if biomass was removed from pool if( pool_flag.eq.1 ) then sel_mass_left = sel_mass_left + tyld + tstand pool_flag = 0 end if c if ((cutht.ge.cstemht) .and. (cutht.ge.tstemht)) then ! no crop to cut C print *, 'No crop biomass to cut', cutht, cstemht, tstemht c endif C print *, 'tflat after cutting: ', tflat C print *, 'cutht/cstemht/tstemht: ', cutht,cstemht,tstemht c Now need to check and see if we need to cut the decomp pools (1-3) c for each individual pool check to see if there is biomass above the c proposed cut height, if so, adjust the pool as necessary. do 40 i=1,mnbpls if (cutht.lt.dstemht(i)) then c stem fraction mass_cut = dstand(i) * (1.0 - (cutht/dstemht(i))) mass_rem = mass_cut * cropf dflat(i) = dflat(i) + mass_cut - mass_rem dstand(i) = dstand(i) - mass_cut tot_mass_rem = tot_mass_rem + mass_rem c stem height dstemht(i) = cutht endif 40 continue end