subroutine trans(
     m         bczht, bdzht,
     m         bcxstm, bdxstm,
     m         bcxstmrep, bdxstmrep,
     m         bcdstm, bddstm,
     m         bcmyld,
     m         bcmst, bdmst,
     m         bcmf, bdmf,
     m         bcmbg, bdmbg,
     m         bcmrt, bdmrt,
     m         bcmbgz, bdmbgz,
     m         bcmrtz, bdmrtz,

     m         bcumdds, bcumddf, bcumddg,
     m         bcrbc, bdrbc,
     m         bdkrate, bcovfact,
     m         bddsthrsh,

     m         bcdkrate, bccovfact,
     m         bcddsthrsh,

     m         bc0nam, bd0nam,
     i         nlay,
     m         acm, acrsai, acrlai,
     m         acrsaz, acrlaz,
     m         acffcv, acfscv, acftcv)

c     + + + PURPOSE + + +
c
c     This subroutine performs the biomass manipulation of transferring
c     biomass.  Transfer of biomass is performed on both the standing
c     or above ground biomass and the root biomass.  The transfer is
c     from the "temporary" crop pool to the decomp biomass pools
c     (when called from within "doeffect".
c
c
c     + + + KEYWORDS + + +
c     transfer, biomass manipulation

      include 'p1werm.inc'

c
c     + + + ARGUMENT DECLARATIONS + + +
c
      real     bczht, bdzht(mnbpls)
      real     bcxstm, bdxstm(mnbpls)
      real     bcxstmrep, bdxstmrep(mnbpls)
      real     bcdstm, bddstm(mnbpls)
      real     bcmyld
      real     bcmst, bdmst(mnbpls)
      real     bcmf, bdmf(mnbpls)
      real     bcmbg, bdmbg(mnbpls)
      real     bcmbgz(mnsz), bdmbgz(mnsz,mnbpls)
      real     bcmrt, bdmrt(mnbpls)
      real     bcmrtz(mnsz), bdmrtz(mnsz,mnbpls)

      real     bcumdds(mnbpls), bcumddf(mnbpls), bcumddg(mnsz,mnbpls)
      integer  bcrbc, bdrbc(mnbpls)
      real     bdkrate(mndk,mnbpls), bcovfact(mnbpls)
      real     bddsthrsh(mnbpls)

      real     bcdkrate(mndk), bccovfact
      real     bcddsthrsh

      character  bc0nam*80
      character  bd0nam*80

      integer  nlay
      real     acm, acrsai, acrlai
      real     acrsaz(mncz), acrlaz(mncz)
      real     acffcv, acfscv, acftcv

c
c     + + + ARGUMENT DEFINITIONS + + +
c
c     nlay       - number of soil layers
c
c     + + + ACCESSED COMMON BLOCK VARIABLE DEFINITIONS + + +
c
c     mnbpls        - max number of decomposition pools (currently=3)
c     mnsz          - max number of soil layers
c
c     + + + PARAMETERS + + +
c
c     + + + LOCAL VARIABLES + + +
c
      character cropname*80
      integer lay, ip, idk, idx
c
c     + + + LOCAL VARIABLE DEFINITIONS + + +
c

c     lay        - soil layer index
c     ip         - decomp pool index
c     idk        - dkrate components index
c     idx        - crop mass by height index

c     + + + END SPECIFICATIONS + + +

! transfer standing residue height 
      do 100 ip=mnbpls,2,-1
         bdzht(ip) = bdzht(ip-1)
100   continue
      bdzht(1) = bczht
      bczht = 0.0

! transfer stem numbers and their stem diameter size
      bddstm(mnbpls) = bddstm(mnbpls) + bddstm(mnbpls-1)
      do 200 ip=mnbpls-1,2,-1
         bddstm(ip) = bddstm(ip-1)
         bdxstm(ip) = bdxstm(ip-1)
         bdxstmrep(ip) = bdxstmrep(ip-1)
200   continue
      bddstm(1) = bcdstm
      bdxstm(1) = bcxstm
      bdxstmrep(1) = bcxstmrep
      bcdstm = 0.0
      bcxstm = 0.0
      bcxstmrep = 0.0

! throw away any unharvest crop yield mass at this time
! what else can I do?
      bcmyld = 0.0

! transfer standing, flat, root, and below ground  mass
      bdmst(mnbpls) = bdmst(mnbpls) + bdmst(mnbpls-1)
      bdmf(mnbpls) = bdmf(mnbpls) + bdmf(mnbpls-1)
      bdmrt(mnbpls) = bdmrt(mnbpls) + bdmrt(mnbpls-1)
      bdmbg(mnbpls) = bdmbg(mnbpls) + bdmbg(mnbpls-1)
      do 500 ip=mnbpls-1,2,-1
         bdmst(ip) = bdmst(ip-1)
         bdmf(ip) = bdmf(ip-1)
         bdmrt(ip) = bdmrt(ip-1)
         bdmbg(ip) = bdmbg(ip-1)
500   continue
      bdmst(1) = bcmst
      bdmf(1) = bcmf
      bdmrt(1) = bcmrt
      bdmbg(1) = bcmbg
      bcmst = 0.0
      bcmf = 0.0
      bcmrt = 0.0
      bcmbg = 0.0

! transfer below ground and root mass in each soil layer
      do 1001 lay=1,nlay
         bdmbgz(lay,mnbpls) = bdmbgz(lay,mnbpls) + bdmbgz(lay,mnbpls-1)
         bdmrtz(lay,mnbpls) = bdmrtz(lay,mnbpls) + bdmrtz(lay,mnbpls-1)
         do 1000 ip=mnbpls-1,2,-1
            bdmbgz(lay,ip) = bdmbgz(lay,ip-1)
            bdmrtz(lay,ip) = bdmrtz(lay,ip-1)
1000     continue
1001  continue
      do 1002 lay=1,nlay
         bdmbgz(lay,1) = bcmbgz(lay)
         bdmrtz(lay,1) = bcmrtz(lay)
         bcmbgz(lay) = 0.0
         bcmrtz(lay) = 0.0
1002  continue


! transfer CUMM DDAYS for s standing, f flat, and g below ground pools
      do 1500 ip=mnbpls,2,-1
         bcumdds(ip) = bcumdds(ip-1)
         bcumddf(ip) = bcumddf(ip-1)
1500  continue
      bcumdds(1) = 0.0    ! reset cummdds to zero
      bcumddf(1) = 0.0    ! reset cummddf to zero

      do 1502 lay=1,nlay
         do 1501 ip=mnbpls,2,-1
            bcumddg(lay,ip) = bcumddg(lay,ip-1)
1501     continue
1502  continue
      do 1503 lay=1,nlay
         bcumddg(lay,1) = 0.0    ! reset cummddg to zero
1503  continue

! transfer decay rates for standing, flat, below ground, roots, and stem_no pools
! Note that the oldest decomp pool uses a constant decay rate (don't need to set)
      do 2001 idk=1,mndk
         !well, supposed to have a constant decay rate (zero doesn't cut it though - LEW)
         !do 2000 ip=mnbpls-1,2,-1
         do 2000 ip=mnbpls,2,-1
            bdkrate(idk,ip) = bdkrate(idk,ip-1)
            !print *, 'bdkrate(idk,ip) ',idk, ip, bdkrate(idk,ip)
2000     continue
2001  continue
      do 2002 idk=1,mndk
         bdkrate(idk,1) = bcdkrate(idk)
            !print *, 'bdkrate(idk,1) ',idk, ' 1 ', bdkrate(idk,1)
            !print *, 'bdkrate(idk,3) ',idk, ' 3 ', bdkrate(idk,3)
2002  continue

      do 2500 ip=mnbpls,2,-1
         bdrbc(ip) = bdrbc(ip-1)
         bcovfact(ip) = bcovfact(ip-1)
         bddsthrsh(ip) = bddsthrsh(ip-1)
2500  continue
      bdrbc(1) = bcrbc
      bcovfact(1) = bccovfact
      bddsthrsh(1) = bcddsthrsh

      bd0nam = bc0nam  !evidently only keeping track of 1st decomp pool name

C    zero these "dependent" values - they will be updated by crop if necessary
      acm = 0.0
      acrsai = 0.0
      acrlai = 0.0
      do 667 idx=1,mncz
         acrsaz(idx) = 0.0
         acrlaz(idx) = 0.0
667   continue
      acffcv = 0.0
      acfscv = 0.0
      acftcv = 0.0

      end