subroutine cut
     i                 (cutflg, cutht, grainf, cropf, standf,
     m                  cstemht, cyld, cstand,
     o                  tstemht, tyld, tstand, tflat,
     m                  dstemht, dstand, dflat)

c     + + + PURPOSE + + +
c     Process # 32 called from doproc.for
c
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
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
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
c     + + + KEYWORDS + + +
c     cut, transfer, biomass manipulation

      include 'p1werm.inc'
      include 'p1unconv.inc'
c
c     + + + ARGUMENT DECLARATIONS + + +
c
      integer cutflg
      real    cutht, grainf, cropf, standf
      real    cstemht,cyld,cstand
      real    tstemht,tyld,tstand,tflat
      real    dstemht(mnbpls),dstand(mnbpls),dflat(mnbpls)
c
c     + + + ARGUMENT DEFINITIONS + + +
c
c     cutflg    - cut height definition flag
c     cutht     - above ground height standing crop and/or
c                 residue is cut to (mm) or fraction
c
c     cstemht   - (crop pool) current crop height (m)
c     cstand    - (crop pool) standing biomass (kg/m^2)
c
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
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
c     + + + ACCESSED COMMON BLOCK VARIABLE DEFINITIONS + + +
c
c     mnbpls        - max number of decomposition pools (currently=3)
c
c     + + + PARAMETERS + + +
c
c     + + + LOCAL VARIABLES + + +
c
      integer  i
c
c     + + + LOCAL VARIABLE DEFINITIONS + + +
c
c     i     - loop variable for decomp pools (3 pools total)

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
      select case(cutflg)
      case(0)
          cutht = cutht*mmtom
      case(1)
          cutht = cutht*mmtom
          cutht = cstemht - cutht
          if(cutht.lt.0.0) cutht = 0.0
      case(2)
          cutht = (1.0-cutht)*cstemht
      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.

      if (cutht.lt.cstemht) then        ! cut crop pool
          if( cutht.ge.0.75*cstemht ) then
              cyld = cyld * (1.0-(cstemht-cutht)/(0.25*cstemht))
          endif
          tflat = tflat+cstand*(1.0-(cutht/cstemht))*(1.0-cropf)
          cstand = cstand*cutht/cstemht
          cstemht = cutht
      endif
      if (cutht.lt.tstemht) then        ! cut temporary crop pool
          if( cutht.gt.0.75*tstemht ) then
              tyld = tyld * ((tstemht-cutht)/(0.75*tstemht))
          endif
          tyld = tyld * (1.0-grainf)
          tflat = tflat+tstand*(1.0-(cutht/tstemht))*(1.0-cropf)
          tstand = tstand*cutht/tstemht
          tstemht = cutht
      endif
      if ((cutht.ge.cstemht) .and. (cutht.ge.tstemht)) then ! no crop to cut
C***    print *, 'No crop biomass to cut', cutht, cstemht, tstemht
       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
              dflat(i) = dflat(i)+dstand(i)*
     &               (1.0-cutht/dstemht(i))*(1.0-standf)
              dstand(i) = dstand(i)*cutht/dstemht(i)
              dstemht(i) = cutht
          else
C***      print *, 'Nothing to cut in decomp pool',i
          endif
 40   continue

      end