c
c
      subroutine flatvt
     i                 (fltcoef, tillf, bcrbc, bdrbc,
     m                  cstand, cstems,
     o                  tflat,
     m                  dstand, dflat, dstems,
     i                  bflg)


c     + + + PURPOSE + + +
c     Process # 33 called from doeffect.for
c
c     This subroutine performs the biomass manipulation process of transferring
c     standing biomass to flat biomass based upon a flatenning coefficient.
c     The standing component (either crop or a biomass pool) flattened
c     is determined by a flag which is set before the call to this
c     subroutine.  The flag may contain any number of combinations
c     found below.
c
c            Flags values (binary #'s actually)
c   bit no.                                          decimal value
c     x  - flatten standing material in all pools         (0)
c     0  - flatten standing crop                          (1)
c     1  - flatten standing residue in decomp pool #1     (2)
c     2  - flatten standing residue in decomp pool #2     (4)
c     3  - flatten standing residue in decomp pool #3     (8)
c
c     Note that biomass for any of these pools that are flattened
c     is transfered to the cooresponding flat pool.
c
c     + + + KEYWORDS + + +
c     flatten, biomass manipulation

      include 'p1werm.inc'
c
c     + + + ARGUMENT DECLARATIONS + + +
      real    fltcoef(mnrbc)
      real    tillf
      integer bcrbc
      integer bdrbc(mnbpls)
      real    cstand
      real    cstems
      real    tflat
      real    dstand(mnbpls),dflat(mnbpls),dstems(mnbpls)
      integer bflg
c
c     + + + ARGUMENT DEFINITIONS + + +
c
c     fltcoef   - flattening coefficients of implement for
c                 different residue burial classes (m^2/m^2)
c     tillf    - fraction of soil area tilled by the machine
c     bcrbc     - residue burial class for standing crop
c     bdrbc     - residue burial class for residue

c     cstand    - (crop pool) standing biomass (kg/m^2)
c     cstems    - (crop pool) number of standing crop stems (#/m^2)

c     tflat     - (temporary crop pool) flat biomass (kg/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     dstems    - (decomp pool) number of standing residue stems (#/m^2)
c
c     bflg      - flag indicating what to flatten
c       0 - All standing material is flatttened (both crop and residue)
c       1 - Crop is flattened
c       2 - 1'st residue pool
c       4 - 2'nd residue pool
c       8 - 3'rd residue pool
c       Note that any combination of pools or crop may be used
c       A bit test is done on the binary number to see what to modify
c
c     + + + ACCESSED COMMON BLOCK VARIABLE DEFINITIONS + + +
c
c     mnrbc         - max number of residue burial classes
c     mnbpls        - max number of biomass pools
c
c     + + + PARAMETERS + + +
c
c     + + + LOCAL VARIABLES + + +
c
      integer  i
      integer  tflg
      real     flatfrac
c
c     + + + LOCAL VARIABLE DEFINITIONS + + +
c
c     i     - loop variable for decomp pools (3 pools total)
c     tflg  - temporary biomass flag
c     flatfrac - fraction of material to be flattened
c
c     + + + END SPECIFICATIONS + + +
c
c      do i=1,mnrbc
c          write(*,*) 'fltcoef', fltcoef(i)
c      end do
c      write(*,*) 'bcrbc', bcrbc
c      do i=1,mnbpls
c          write(*,*) 'bdrbc',bdrbc(i)
c      end do
c      write(*,*) 'cstand', cstand
c      write(*,*) 'cstems', cstems
c      write(*,*) 'tflat', tflat
c      do i=1,mnbpls
c          write(*,*) 'dstand, dflat, dstems',
c     &                dstand(i), dflat(i), dstems(i)
c      end do
c      write(*,*) 'bflg', bflg
c
c     set tflg bits correctly for "all" pools if bflg=0
      if (bflg .eq. 0) then
          tflg = 1                   ! crop pool
          do 10 i=1,mnbpls
             tflg = tflg + 2**i      ! decomp pools
10        continue
      else
          tflg = bflg
      endif

c     check for proper indexes in bcrbc
      if( (bcrbc.ge.1).and.(bcrbc.le.mnrbc) ) then
          if (BTEST(tflg,0)) then              ! flatten standing crop
              flatfrac = fltcoef(bcrbc) * tillf
              tflat = tflat + cstand * flatfrac
              cstand = cstand * (1.0 - flatfrac)
              cstems = cstems * (1.0 - flatfrac)  ! reduce # of crop stems
          endif
      endif
c
      do 40 i=1,mnbpls               ! flatten standing residue
c         check for proper indexes in bdrbc
          if( (bdrbc(i).ge.1).and.(bdrbc(i).le.mnrbc) ) then
              if (BTEST(tflg,i)) then       ! from specified decomp pools 
                  flatfrac = fltcoef(bdrbc(i)) * tillf
                  dflat(i) = dflat(i) + dstand(i) * flatfrac
                  dstand(i) = dstand(i) * (1.0 - flatfrac)
                  dstems(i) = dstems(i) * (1.0 - flatfrac)  ! reduce # of residue stalks
              endif
          endif
 40   continue
c      print *, 'tflat after flatvt:', tflat
c      print *, 'dstand after flatvt:', dstand(1), dstand(2),dstand(3)
c      print *, 'dflat after flatvt:', dflat(1), dflat(2),dflat(3)

 60   return
      end