c$Author: fredfox $
c$Date: 2001-12-06 00:22:15 $
c$Revision: 1.3 $
c$Source: /weru/cvs/weps/weps.src/mproc/thin.for,v $

      subroutine thin
     i                 (thinflg, thinval, grainf, cropf, standf,
     m                  cstems, cyld, cstand,
     o                  tstems, tyld, tstand, tflat,
     m                  dstems, dstand, dflat,
     &                  tot_mass_rem, sel_mass_left)

c     + + + PURPOSE + + +
c     Process # 37 called from doproc.for

c     This subroutine performs the biomass manipulation of thinning
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     thinflg
c     0  - Remove fraction of Plants, thinval = fraction
c     1  - Thin to Plant Population, thinval = population

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     thin, transfer, biomass manipulation

      include 'p1werm.inc'
      include 'p1unconv.inc'

c     + + + ARGUMENT DECLARATIONS + + +

      integer thinflg
      real    thinval, grainf, cropf, standf
      real    cstems, cyld, cstand
      real    tstems, tyld, tstand, tflat
      real    dstems(mnbpls),dstand(mnbpls),dflat(mnbpls)
      real    tot_mass_rem, sel_mass_left

c     + + + ARGUMENT DEFINITIONS + + +

c     thinflg   - thinning value definition flag
c     thinval   - above ground height standing crop and/or
c                 residue is cut to (mm) or fraction

c     grainf    - of thinned material, fraction of reproductive mass removed
c     cropf     - of thinned material, fraction of standing crop plants removed
c     standf    - of thinned material, fraction of standing residue removed

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     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     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     tot_mass_rem - mass of material removed by this harvest operation (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_thin, mass_rem

c     + + + LOCAL VARIABLE DEFINITIONS + + +

c     i     - loop variable for decomp pools (3 pools total)

c     + + + END SPECIFICATIONS + + +

c     convert thinning value for all cases to fraction of plant
c     population to remain
      select case(thinflg)
      case(0)
          thinval = 1.0-thinval
      case(1)
          if(cstems.gt.0.0) then
              thinval = min(1.0, thinval/cstems)
          else
              thinval = 0.0
          end if
      case default
          write(*,*) 'Invalid thinning flag, nothing thinned'
      end select

C***  print *, 'cut tflg: ', tflg
C***  print *, 'tflat before cutting: ', tflat
C***  print *, 'cutht/cstemht/tstemht: ', cutht,cstemht,tstemht

C!!!!!!!!!!!!!!!!!!!!!!!!!!!!
C     This thinning is applied to all standing pools,
C     like a cutting device, it is not discriminate in any way

      tot_mass_rem = 0.0
      sel_mass_left = 0.0
      pool_flag = 0

c     thin crop pool
c     yield mass
      mass_thin = cyld * (1.0-thinval)
      mass_rem = mass_thin * grainf
      if( mass_rem.gt.0.0 ) then 
          pool_flag = 1
          tot_mass_rem = tot_mass_rem + mass_rem
      end if
      cyld = cyld - mass_thin
      tflat = tflat + mass_thin - mass_rem

c     standing stem and leaf mass
      mass_thin = cstand * (1.0-thinval) 
      mass_rem =  mass_thin * cropf
      if( mass_rem.gt.0.0 ) then 
          pool_flag = 1
          tot_mass_rem = tot_mass_rem + mass_rem
      end if
      cstand = cstand - mass_thin
      tflat = tflat + mass_thin - mass_rem

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

c     modify stem count (population) to reflect change
      cstems = cstems * thinval

c     thin temporary pool
c     yield mass
      mass_thin = tyld * (1.0-thinval)
      mass_rem = mass_thin * grainf
      if( mass_rem.gt.0.0 ) then 
          pool_flag = 1
          tot_mass_rem = tot_mass_rem + mass_rem
      end if
      tyld = tyld - mass_thin
      tflat = tflat + mass_thin - mass_rem

c     standing stem and leaf mass
      mass_thin = tstand * (1.0-thinval) 
      mass_rem =  mass_thin * cropf
      if( mass_rem.gt.0.0 ) then 
          pool_flag = 1
          tot_mass_rem = tot_mass_rem + mass_rem
      end if
      tstand = tstand - mass_thin
      tflat = tflat + mass_thin - mass_rem

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     modify stem count (population) to reflect change
      tstems = tstems * thinval

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 i=1,mnbpls
          mass_thin = dstand(i) * (1.0-thinval)
          mass_rem =  mass_thin * standf
          if( mass_rem.gt.0.0 ) then 
              pool_flag = 1
              tot_mass_rem = tot_mass_rem + mass_rem
          end if
          dstand(i) = dstand(i) - mass_thin
          dflat(i) = dflat(i) + mass_thin - mass_rem 
c         add biomass to selected mass if biomass was removed from pool
          if( pool_flag.eq.1 ) then
              sel_mass_left = sel_mass_left + dstand(i)
              pool_flag = 0
          end if
      end do

      end