c
c
      subroutine mburyvt
     i              (buryf,tillf,bcrbc,bdrbc,burydistflg,
     i               nlay,lthick,ldepth,
     i               dflat,dbgz,tflat,tbgz,bflg)


c     + + + PURPOSE + + +
c
c     This subroutine performs the biomass manipulation process of transfering
c     the above ground biomass into the soil or the inverse process of bringing
c     buried biomass to the surface.  It deals only with the biomass
c     pools (ie no live crop is involved)
c
c     + + + KEYWORDS + + +
c     bury, lift, biomass manipulation

      include 'p1werm.inc'
c
c     + + + ARGUMENT DECLARATIONS + + +
      real    buryf(mnrbc)
      real    tillf
      integer bcrbc
      integer bdrbc(mnbpls)
      integer burydistflg
      integer nlay
      real    lthick(mnsz)
      real    ldepth(mnsz)
      real    dflat(mnbpls),dbgz(mnsz,mnbpls)
      real    tflat,tbgz(mnsz)
      integer bflg
c
c
c     + + + ARGUMENT DEFINITIONS + + +
c
c     buryf     - fraction of flat material buried 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 classes for residue
c     nlay      - number of soil layers used in the operation(s)
c     lthick    - distance from soil surface to bottom of layer
c                 for each soil layer
c     tbgz      - (crop) below ground residue / layer and decomp
c                 pool (kg / m^2)
c     tflat     - (crop) flat residue pools (kg / m^2)
c     dbgz      - (decomp) below ground residue / layer and decomp
c                 pool (kg / m^2)
c     dflat     - (decomp) flat residue pools (kg / m^2)
c     bflg      - flag indicating what to cut
c       0 - All standing material is cut (both crop and residue)
c       1 - Crop is cut
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     mnsz          - max number of soil layers
c
c     + + + FUNCTIONS + + +
      real burydist
c
c     + + + LOCAL VARIABLES + + +
c
      integer  lay,i,tflg
      real     bury(mnbpls)
      real     tbury
      real     fracbury(nlay)
c
c     + + + LOCAL VARIABLE DEFINITIONS + + +
c
c     bury      - mass of biomass that is buried
c     tbury      - mass of crop biomass that is buried
c     i         - biomass pools (1-3)
c     lay       - number of layers in a specified subregion
c     tflg      - temporary biomass flag
c
c     + + + END SPECIFICATIONS + + +
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     calculate fractions of total to be buried in each layer
      do 40 lay=1,nlay
          fracbury(lay) = burydist(lay,burydistflg,lthick,ldepth,nlay)
 40   continue
      !perform the burying of biomass
c      print *, 'mbury tflg/bflg: ', tflg, bflg
c      print *, 'tflat before mbury: ', tflat
c      print *, 'dflat before mbury: ', dflat(1), dflat(2),dflat(3)

c     check for proper indexes in bcrbc
      if( (bcrbc.ge.1).and.(bcrbc.le.mnrbc) ) then
          if (BTEST(tflg,0)) then       ! crop pool
              tbury=tflat*buryf(bcrbc)*tillf
              do lay=1,nlay
                  tbgz(lay) = tbgz(lay)+tbury*fracbury(lay)
              end do
             tflat=tflat-tbury
          endif
      endif

      do 100 i = 1, mnbpls
c         check for proper indexes in bdrbc
          if( (bdrbc(i).ge.1).and.(bdrbc(i).le.mnrbc) ) then
              if (BTEST(tflg,i)) then
                  bury(i)=dflat(i)*buryf(bdrbc(i))*tillf
                  do lay=1,nlay
                      dbgz(lay,i) = dbgz(lay,i)+bury(i)*fracbury(lay)
                  end do
                  dflat(i)=dflat(i)-bury(i)
              endif
          endif
100   continue

c      print *, 'tflat after mbury: ', tflat
c      print *, 'dflat after mbury: ', dflat(1), dflat(2),dflat(3)
 200  return
      end