c    file: dechrv.for

      subroutine dechrv (
     &                    isr)
c    &                    isr, cropname, standmass, flatmass,
c    &                    bgmass, rtmass, hrvht, croppop)

c   + + + PURPOSE + + +

c   transferes of mass, stem numbers, dkrates and other information from one
c   pool to the next following crop harvest.
c   It can be called from tillage or decomp.

c + + +  Global  Variables + + +

*$noereference
      include 'p1werm.inc'
      include 's1layr.inc'
      include 'c1info.inc'
      include 'd1gen.inc'
      include 'd1glob.inc'
      include 'd1mass.inc'

      include 'decomp/decomp.inc'
*$reference

c  + + + ARGUMENT DECLARATIONS + + +

c     character cropname*80
      integer isr
c     real standmass
c     real flatmass
c     real bgmass(mnsz)
c     real rtmass(mnsz)
c     real hrvht
c     real croppop

c   + + +  ARGUMENT DEFINITIONS + + +

c     cropname - name of crop harvested
c     standmass- mass of standing residue
c     flatmass - amount of residue on the surface
c     bgmass   - mass belowground
c     rtmass   - root mass
c     hrvht    - harvest height height of standing residue
c     croppop  - number of standing stems

c      + + + LOCAL VARIABLE DECLARATION + + +

c      character infile2*80
      character resname*80
      character line*80
      integer i,lchar
c      logical fexist

c     + + +  LOCAL VARIABLE DEFINITIONS + + +

C     infile - decomposition initialization file name
c     line   - holds the contents of each line as it is read
c     lchar  - character holder
c     infile2- decomposition parameters
c     resname- name of harvested crop

c   + + + DATA INITIALIZATION + + +

c     infile2 = '../run/decomp.dat'

c + + +  END OF SPECIFICATIONS + + +

c Increment harvest flag

      hrvflag = hrvflag + 1

c  Use harvest flag to increment residue pools

      if (hrvflag.eq.1) then
         ipool=2
         ipoolf=2
      else
         ipool=2
         ipoolf=3
      end if

c Move CUMM DDAYS to next age pool for s standing, f flat, and
c g below ground pools

      cumdds(2,isr) = cumdds(1,isr)
      cumdds(1,isr) = 0

      cumddf(2,isr) = cumddf(1,isr)
      cumddf(1,isr) = 0

      do 10 isz = 1, nslay(isr)
         cumddg(2, isz,isr) = cumddg(1,isz,isr)
         cumddg(1, isz,isr) = 0
 10   continue

c MOVE MASS to next pool for standing, flat, and belowground
c and root residues.  Initalize new residue mass.
c NEED VARIABLE NAMES FOR CROP BIOMASS FOLLOWING HARVEST ??????

      dmfbm(3,isr) = dmfbm(2,isr) +dmfbm(3,isr) + dmsbm(2,isr)
      dmfbm(2,isr) = dmfbm(1,isr)
c    !  variable name ??
c     dmfbm(1,isr) = flatmass
      dmfbm(1,isr) = admf(1,isr)

      dmsbm(2,isr) = dmsbm(1,isr)
c     variable name ???
c     dmsbm(1,isr) = standmass
      dmsbm(1,isr) = admst(1,isr)

      do 20 isz = 1, nslay(isr)
         dmgbm(2,isz,isr) = dmgbm(2,isz,isr) + dmgbm(1,isz,isr)
c         variable NAME ???
c        dmgbm(1,isz,isr) = bgmass(isz)
         dmgbm(1,isz,isr) = admb(1,isz,isr)
         dmrbm(2,isz,isr) = dmrbm(2,isz,isr) + dmrbm(1,isz,isr)
c        variable  name ??
c        dmrbm(1,isz,isr) = rtmass(isz)
         dmrbm(1,isz,isr) = admr(1,isz,isr)

  20  continue

c
c  Initialize and move stem numbers, diameters and ht
c
      stmno(2,isr) = stmno(1,isr)
      stmdiam(2,isr) = stmdiam(1,isr)
      stmht(2,isr) =  stmht(1,isr)
c     NAME ?
c     stmno(1,isr) = croppop
      stmno(1,isr) = addstm(1,isr)
C     Name ?
c      stmht(1,isr)  = hrvht
      stmht(1,isr)  = adzhht(1,isr)

c  move decomposition rate from pool 1 to 2 to 3
c  dkrate (position, age)  stand, flat, buried, roots, stem no 1-5
c                    position  1,   2 ,    3,      4,      5
c                     max age  2,   3 ,    2,      2,      2
c standing

      dkrate(1,2,isr)=dkrate(1,1,isr)

c flat
c pool 3 decomposes at a constant rate not related to crop type

      dkrate(2,3,isr)= .0010
      dkrate(2,2,isr)=dkrate(2,1,isr)

c buried

      dkrate(3,2,isr)=dkrate(3,1,isr)

c roots

      dkrate(4,2,isr)=dkrate(4,1,isr)

c stem numbers

      dkrate(5,2,isr)=dkrate(5,1,isr)

c Transfer coefficient for estimation of soil surface cover

      covfact(2,isr)= covfact(1,isr)

c     Change crop residue id for initializing dkrates

c     ad0nam(isr) = cropname
      ad0nam(isr) = ac0nam(isr)
c      write (*,*) ac0nam(isr), ad0nam(isr)

c  The next section gets the paramters needed by the decomp model
c  for the new crop residue type. The data is retrieved from the
c  decomp.dat file.

c      inquire(file=infile2, exist=fexist)
c      if(.not.fexist) write(*,*) infile2, 'not found'
c      if(.not.fexist) goto 80
c      open (unit = 54, file = infile2)

  205 read (31,'(a)') line
      if (line(1:1) .eq. '#') go to 205
      lchar = 0

  207 lchar=lchar+1
      if (line(lchar:lchar) .eq. ' ') goto 207
      read (line(lchar:), '(a)',err=80) resname
c       write(*,*) 'harv ', resname
c     if harvest before first plant use default values
      if (resname .eq. 'no_crop') then
         write(*,*) '  the selected crop - ',ad0nam(isr),' is not in the
     &database -- using winter wheat dk rates'
         go to 208
      end if
      if(resname .ne. ad0nam(isr)) goto 205
c     skip crop parameters
      do 209 i=1,5
         read (31,'(a)') line
  209 continue
  208 read (31,*,err=80) dkrate(1,1,isr), dkrate(2,1,isr),
     & dkrate(3,1,isr), dkrate(4,1,isr), dkrate(5,1,isr),
     & stmdiam(1,isr), ddsthrsh(1,isr), covfact(1,isr)
c      go back to top of file to be ready for next crop
       rewind(unit = 31)

      goto 900
   80 write(*,*) 'error reading crop.db file decomp parameters'

  900 continue

      return
      end