c$Author: fredfox $
c$Date: 2003-02-27 19:45:56 $
c$Revision: 1.24.2.1 $
c$Source: /weru/cvs/weps/weps.src/manage/doproc.for,v $

      subroutine   doproc (sr)

c     + + + PURPOSE + + +
c     Doproc is called when a processline is found in the management file
c     Doproc reads in any coefficients associated with the
c     process. Doproc then makes a call to a subroutine which, in turn,
c     modifies the state variables to mimic the processes of doing the
c     process.

c     + + + KEYWORDS + + +
c     tillage, process, management

c     + + + PARAMETERS AND COMMON BLOCKS + + +

      include 'p1werm.inc'
      include 'p1unconv.inc'
      include 'm1flag.inc'
      include 'm1sim.inc'
      include 'm1dbug.inc'
      include 's1layr.inc'
      include 's1layd.inc'
      include 's1agg.inc'
      include 's1sgeo.inc'
      include 's1phys.inc'
      include 's1surf.inc'
      include 's1dbh.inc'
      include 's1dbc.inc'
      include 'c1gen.inc'
      include 'c1db1.inc'
      include 'c1db2.inc'
      include 'c1db3.inc'
      include 'c1glob.inc'
      include 'c1info.inc'
      include 'd1glob.inc'
      include 'd1gen.inc'
      include 'h1hydro.inc'
      include 'h1db1.inc'
      include 'decomp/decomp.inc'
      include 'manage/oper.inc'
      include 'manage/asd.inc'
      include 'manage/man.inc'
      include 'manage/mproc.inc'
      include 'manage/tcrop.inc'
c
c     + + + ARGUMENT DECLARATIONS + + +
      integer sr
c     + + + ARGUMENT DEFINITIONS + + +
c     sr - the subregion being processed
c
c     + + + ACCESSED COMMON BLOCK VARIABLE DEFINITIONS + + +
c
c     acdpop    - crop seeding density
c     acrlai    - crop leaf area index
c     aheaep    - soil air entery potential
c     ahrwc     - soil water content (mass bases)
c     ahrwca    - available soil water content
c     ahrwcf    - 1/3 bar soil water content
c     ahrwcs    - saturation soil water content
c     ahrwcw    - 15 bar soil water content
c     am0cgf    - flag to call crop growth between plant and harvest
c     am0hrvfl  - flag to determine if the crop is perennial and killed
c                 during a harvest.  Values are
c                 0 - no kill being done
c                 1 - perennial crop which is NOT killed
c                 2 - annual or perennial crop which is killed
c                 3 - leaves removed by defoliation
c     am0tdb    - flag for outputing debug information to a file
c                 0 - no output
c                 1 - output to file ../out/tdbug.out
c     am0tfl    - flag for outputing management operations to a file
c                 0 - no output
c                 1 - output to file ../out/manage.out
c     as0ags    - aggr. size geom. mean std. dev.
c     as0ph     - soil Ph
c     asargo    - ridge orientation (clockwise from true North) (degrees)
c     ascmg     - magnesium ion concentration
c     ascna     - sodium ion concentration
c     asdadg    - aggregrate density
c     asdblk    - soil layer bulk density
c     aseags    - dry aggregrate stability
c     asfcce    - fraction of calcium carbonate
c     asfcec    - cation exchange capcity
c     asfcla    - fraction of clay
c     asfesp    - exchangable sodium percentage
c     asfnoh    - organic N concentration of humus
c     asfom     - fraction of organic matter
c     asfpoh    - organic P concentration of humus
c     asfpsp    - fraction of fertilizer P that is labile
c     asfsan    - fraction of sand
c     asfsil    - fraction of silt
c     asfsmb    - sum of bases
c     aslagm    - aggr. size geom. mean diameter (mm)
c     aslagn    - min. aggr. size of each layer (mm)
c     aslagx    - max aggr. size of each layer (mm)
c     aslrr     - Allmaras random roughness parameter (mm)
c     asxrgs    - ridge spacing (mm)
c     asxrgw    - ridge width (mm)
c     aszlyt    - soil layer thickness (mm)
c     aszrgh    - ridge height (mm)
c     prcode    - the process id number
c     prname    - the process name

c     + + + LOCAL VARIABLES + + +
      integer flag,rdgflag,cutflg
      real    massf (msieve+1,mnsz)
      real    alpha, beta, mu, rho
      integer roughflg
      real    rrimpl
c     real    intens, rrimpl
      real    kappa
      real    thinval
      real    tibcp
      real    pyieldf,pstalkf,prootf,rstandf,rflatf,rbgf,rrootf
      real    rdght,rdgwt,dikeht,dikespac
      real    af,cf,mf
      real    afvt(mnrbc), mfvt(mnrbc)
      integer burydistflg
      real    irrig
      real    rdght1
      character*1 prdumy
      character*80  line
      integer  idx, thinflg
      real    dmassres, zmassres, dmassrot, zmassrot
      real    leaffrac, mass_rem, mass_left
c
c     + + + LOCAL VARIABLE DEFINITIONS + + +
c
c     alpha    - parameter reflecting the breakage of all soil
c                aggregrates regardless of size
c     beta     - parameter reflecting the uneveness of breakage among
c                aggregrates in different size classes
c     buryf    - fraction of mass to be buried
c     kappa    - fraction of the crust destroyed during a tillage operation
c     dikeht   - dike height (mm)
c     dikespac - dike spacing (mm)
c     flag     - flag used in the remove subroutine which determines
c                 what needs to be removed
c     fltcoef  - flattening coefficient of an implement
c     pyieldf  - fraction of plant yield to be removed
c     pstalkf  - fraction of plant stalk to be removed
c     prootf   - fraction of plant roots to be removed
c     rstandf  - fraction of standing residue to be removed
c     rflatf   - fraction of flat residue to be removed
c     rbgf      - fraction of below ground residue to be removed
c     rrootf   - fraction of residue roots to be removed
c     harvflag - flag indicating a harvest
c     intens   - tillage intensity factor
c     liftf    - fraction of mass to be lifted
c     massf    - mass fractions of aggregrates within sieve cuts
c                 (sum of all the mass fractions are expected to be 1.0)
c     fracarea - fraction of the surface affected by the process
c     rdght    - ridge height (mm)
c     rdght1   - tmp variable - ridge height (mm)
c     rdgflag  - flag indicating whether ridge modifications are needed
c     rdgwt    - ridge top width (mm)
c     rrimpl   - assigned nominal RR value for the tillage operation (mm)
c     tibcp    - tillage intensity factor used for below tillage compaction
c     mu       - loosening coefficient (0 <= mu <= 1)
c     rho      - mixing coefficient (0 <= rho <= 1)
c     irrig    - irrigation quantity for a day (mm)
c     dmassres - Buried crop residue mass(kg/m^2)
c     zmassres - depth in soil of Buried crop residue mass (mm)
c     dmassrot - Buried root residue mass(kg/m^2)
c     zmassrot - depth in soil of Buried root residue mass (mm)
c     leaffrac - defoliation, fraction of leaves turned into residue
c     mass_rem - mass removed by harvest process (cut,remove)
c
c     + + + SUBROUTINES CALLED + + +
c
c     asd2m     - aggregate size distribution to mass fraction converter
c     burylift  - performs the biomass transfer either into the soil
c                 or from the soil to the surface (deals with decomp
c                 pools only
c     crush     - the crushing process
c     crust     - destroys a cursted surface depending on the operation that
c                 is performed
c     invert    - performs an inversion of the vertical soil layers
c     loosn     - performs the loosen/compact process
c     m2asd     - mass fraction to aggregate size distribution converter
c     mix       - mixes components in specified layers
c     orient    - calculates the oriented roughness
c     remove    - performs the biomass removal during a harvest, burn, etc.
c                 and updates the decomposition pools accordingly.
c     rough     - calculated the post tillage random roughness
c     tdbug     - subroutine which writes out variables for debugging purposes
c
c     + + + FUNCTION DECLARATONS + + +
      integer tillay
      integer skpnam
      integer lentrm
c
c     + + + DATA INITIALIZATIONS + + +
c     None
c
c     + + + OUTPUT FORMATS + + +
2015     format (' Process code ',i2,1x,'Process ',1x,a20 )
c
c     + + + END SPECIFICATIONS + + +

      line = mtbl(mcur(sr))
      read(line, 1001, err=901) prdumy, prcode, prname
 1001 format(a1,1x,i2,1x,a)
C
C      write(*,*)'doprocess1',prcode,prname,
C     &'            am0hrvfl ',am0hrvfl,'idc',ac0idc(sr)
C      if (am0tfl .eq. 1) write (15,2015) prcode,prname
C
C***  print*, 'SR',sr,' Performing process:',
C*** &        prcode,' ',prname

c     Default all flatten, bury, and lift processes to "all" biomass
c     for now.

      bioflg = 15
c
c     process calls follow
      select case (prcode)
C

      case (1)
c-----START crust breakdown process (process code 01)

c     pre-process stuff
        kappa = 1.0 ! *** NOTE that kappa is NOT being read from file

        if (am0tdb .eq. 1) then
          write (29,*)
          write (29,*) '//Before crust breakdown process//'
          call tdbug(sr, nslay(sr),prcode)
        end if

        am0til = .true.  !set flag for surface modification
c     do process
        call crust(kappa,fracarea,asfcr(sr),asflos(sr),asmlos(sr))

c     post-process stuff
        if (am0tdb .eq. 1) then
          write (29,*) '//After crust breakdown process//'
          call tdbug(sr, nslay(sr),prcode)
        end if
c-----END crust breakdown process (process code 01)

      case (2)
c-----START random roughness process (process code 02)

c     pre-process stuff

        if (am0tdb .eq. 1) then
          write (29,*)
          write (29,*) '//Before random roughness process//'
          call tdbug(sr, nslay(sr),prcode)
        end if

c     read the random roughness for the implement. tillage intensity
c     factor, and the fraction of the surface tilled come in as group parameter
c     get additional line of data
        mcur(sr) = mcur(sr) + 1
        line = mtbl(mcur(sr))
        read(line(2:lentrm(line)),* , err=901) roughflg, rrimpl

        am0til = .true.  !set flag for surface modification
c     do process
        call rough(roughflg,rrimpl,ti,fracarea,aslrr(sr),
     &             tlayer, asfcla(1,sr), asfsil(1,sr),
     &             acmrtz(1,sr), tcmrtz(1,sr),
     &             admrtz(1,1,sr), admbgz(1,1,sr),
     &             aszlyd(1,sr))

c     post-process stuff
        if (am0tdb .eq. 1) then
          write (29,*) '//After random roughness process//'
          call tdbug(sr, nslay(sr),prcode)
        end if
c-----END random roughness process (process code 02)

      case (3)
c-----START oriented roughness ridge only process (process code 03)
c     pre-process stuff
        if (am0tdb .eq. 1) then
          write (29,*)
          write (29,*) '//Before oriented roughness1 process//'
          call tdbug(sr, nslay(sr),prcode)
        end if

c     read the oriented roughness (ridge) parameters for the implement
c     get additional line of data
        mcur(sr) = mcur(sr) + 1
        line = mtbl(mcur(sr))
        read(line(2:lentrm(line)),* , err=901)
     &    rdgflag, rdght, imprs, rdgwt

        rdght1 = aszrgh(sr) !keep initial ridge height value
        am0til = .true.  !set flag for surface modification
c     do process
        call orient1(aszrgh(sr),asxrgw(sr),asxrgs(sr),asargo(sr),
     &               rdght,rdgwt,imprs,odir,tdepth,rdgflag)

c     post-process stuff
        !if the ridge height changed or is very small,
        !then assume any dikes got destroyed
		if (rdght1 .ne. aszrgh(sr) .or. (aszrgh(sr) .le. 0.1)) then
		  asxdkh(sr) = 0.0
		  asxdks(sr) = 0.0
        end if

        if (am0tdb .eq. 1) then
		  write (29,*) '//After oriented roughness process//'
          call tdbug(sr, nslay(sr),prcode)
        end if
c-----END oriented roughness process (process code 03)

      case (4)
c-----START oriented roughness process dike only (process code 04)
c     pre-process stuff
        if (am0tdb .eq. 1) then
          write (29,*)
          write (29,*) '//Before oriented roughness2 process//'
          call tdbug(sr, nslay(sr),prcode)
        end if

c     read the oriented roughness (dike) parameters for the implement
        mcur(sr) = mcur(sr) + 1
        line = mtbl(mcur(sr))
        read(line(2:lentrm(line)),* , err=901)
     *    rdgflag, dikeht, dikespac
c NOTE: we don't need rdgflag anymore - LEW

        am0til = .true.  !set flag for surface modification
c     do process
        call orient2(asxdkh(sr),asxdks(sr),dikeht,dikespac)

c     post-process stuff
        if (am0tdb .eq. 1) then
          write (29,*) '//After oriented roughness process//'
          call tdbug(sr, nslay(sr),prcode)
        end if
c-----END oriented roughness dike only process (process code 04)

      case (5)
c-----START oriented roughness process (process code 05)
c     pre-process stuff
        if (am0tdb .eq. 1) then
          write (29,*)
          write (29,*) '//Before oriented roughness process//'
          call tdbug(sr, nslay(sr),prcode)
        end if

c     read the oriented roughness parameters for the implement
        mcur(sr) = mcur(sr) + 1
        line = mtbl(mcur(sr))
        read(line(2:lentrm(line)),* , err=901)
     *    rdgflag, rdght, imprs, rdgwt, dikeht, dikespac

        am0til = .true.  !set flag for surface modification
c     do process
        call orient(aszrgh(sr),asxrgw(sr),asxrgs(sr),asargo(sr),
     &              asxdkh(sr),asxdks(sr),
     &              rdght,rdgwt,imprs,odir,dikeht,dikespac,
     &              tdepth,rdgflag)

c     post-process stuff
        if (am0tdb .eq. 1) then
          write (29,*) '//After oriented roughness process//'
          call tdbug(sr, nslay(sr),prcode)
        end if
c-----END oriented roughness process (process code 05)

      case (11)
c-----START crushing process (process code 11)
c    pre-process stuff
        if (am0tdb .eq. 1) then
          write (29,*)
          write (29,*) '//Before crushing process//'
          call tdbug(sr, nslay(sr),prcode)
        end if
c        write (*,*) '//Before crushing process//'
        if( aslagm(5,sr).gt.aslagx(5,sr) ) then
            write (*,*) 'before crush:',aslagm(5,sr),aslagx(5,sr)
        end if
c        write (*,*) 'dia,sd',aslagm(1,sr),as0ags(1,sr)
c
c       Convert ASD from modified log-normal to sieve classes
        call asd2m(aslagn(1,sr), aslagx(1,sr), aslagm(1,sr),
     &           as0ags(1,sr), nslay(sr), massf)
c
c
c       read the crushing parameters for the implement
        mcur(sr) = mcur(sr) + 1
        line = mtbl(mcur(sr))
        read(line(2:lentrm(line)),* , err=901) alpha, beta

c       check for valid crushing parameters
        if( alpha.lt.beta) then
           write(*,*) 'Process 11:Crushing:Alpha=',alpha,
     &                'must be greater than Beta=',beta
           stop
        endif

c       do process
        call crush(alpha, beta, tlayer, massf)
c
c       post-process stuff
c
c       Convert ASD back from sieve classes to modified log-normal
        call m2asd(massf, nslay(sr),
     &    aslagn(1,sr), aslagx(1,sr), aslagm(1,sr), as0ags(1,sr))

        if( aslagm(5,sr).gt.aslagx(5,sr) ) then
            write (*,*) 'after crush:',aslagm(5,sr),aslagx(5,sr)
        end if
c        write (*,*) 'dia,sd',aslagm(1,sr),as0ags(1,sr)
c
        if (am0tdb .eq. 1) then
          write (29,*) '//After crushing process//'
          call tdbug(sr, nslay(sr),prcode)
        end if
c-----END crushing process (process code 11)

      case (12)
c-----START loosening process (process code 12)
c       pre-process stuff
        if (am0tdb .eq. 1) then
          write (29,*)
          write (29,*) '//Before loosening process//'
          call tdbug(sr, nslay(sr),prcode)
        end if
        if( aslagm(5,sr).gt.aslagx(5,sr) ) then
            write (*,*) 'before loose:',aslagm(5,sr),aslagx(5,sr)
        end if

c       read the loosening parameter for the implement
        mcur(sr) = mcur(sr) + 1
        line = mtbl(mcur(sr))
        read(line(2:lentrm(line)),* , err=901) mu

c       do process
        call loosn(mu,fracarea,tlayer,
     &    asdblk(1,sr),asdsblk(1,sr),aszlyt(1,sr))

c       post-process stuff

c       adjust soil hydraulic properties for change in density
        call param_blkden_adj( tlayer, asdblk(1,sr), asdblk0(1,sr),
     &       asdpart(1,sr), ahrwcf(1,sr), ahrwcw(1,sr), ahrwca(1,sr),
     &       asfcla(1,sr), asfom(1,sr),
     &       ah0cb(1,sr), aheaep(1,sr), ahrsk(1,sr) )

        if (am0tdb .eq. 1) then
          write (29,*) '//After loosening process//'
          call tdbug(sr, nslay(sr),prcode)
        end if
c-----END loosening process (process code 12)

      case (13)
c-----START mixing process (process code 13)
c     pre-process stuff
        if (am0tdb .eq. 1) then
          write (29,*)
          write (29,*) '//Before mixing process//'
          write (29,*) 'Tillage layer depth is', tlayer
          call tdbug(sr, nslay(sr),prcode)
        end if
c        write (*,*) '//Before mixing process//'
        if( aslagm(5,sr).gt.aslagx(5,sr) ) then
            write (*,*) 'before mix:',aslagm(5,sr),aslagx(5,sr)
        end if
c        write (*,*) 'dia,sd',aslagm(1,sr),as0ags(1,sr)

c       read the mixing coefficient from the data file
        mcur(sr) = mcur(sr) + 1
        line = mtbl(mcur(sr))
        read(line(2:lentrm(line)),* , err=901) rho

c       Convert ASD from modified log-normal to sieve classes
        call asd2m(aslagn(1,sr), aslagx(1,sr), aslagm(1,sr),
     &           as0ags(1,sr), nslay(sr), massf)

c       do process
        call mix(rho,fracarea,tlayer,asdblk(1,sr),aszlyt(1,sr),
     &    asfsan(1,sr),
     &    asfsil(1,sr),asfcla(1,sr),as0ph(1,sr),ascmg(1,sr),
     &    ascna(1,sr),asfcce(1,sr),asfcec(1,sr),asfesp(1,sr),
     &    asfom(1,sr),asfnoh(1,sr),asfpoh(1,sr),asfpsp(1,sr),
     &    asfsmb(1,sr),asdagd(1,sr),aseags(1,sr),ahrwc(1,sr),
     &    aheaep(1,sr),ahrwcw(1,sr),ahrwcf(1,sr),ahrwca(1,sr),
     &    ahrwcs(1,sr),ahrsk(1,sr),
     &    admrtz(1,1,sr),admbgz(1,1,sr),
     &    massf)

c     post-process stuff

c       With the change in composition of the layers, it is necessary
c       to update soil properties that are a function of texture
        call proptext( tlayer, asfcla(1,sr), asfsan(1,sr),asfom(1,sr),
     &                 asdsblk(1,sr), asdpart(1,sr) )

c       set matrix potential parameters to match 1/3 bar and 15 bar water contents
        call param_pot_bc( tlayer, asdblk(1,sr), asdpart(1,sr),
     &                     ahrwcf(1,sr), ahrwcw(1,sr),
     &                     asfcla(1,sr), asfom(1,sr),
     &                     ah0cb(1,sr), aheaep(1,sr) )

c       set previous day bulk density for the changed layers since
c       this is a change in composition not in bulk density per se
        call set_prevday_blk( tlayer, asdblk(1,sr), asdblk0(1,sr) )

c       Convert ASD back from sieve classes to modified log-normal
        call m2asd(massf, nslay(sr),
     &    aslagn(1,sr), aslagx(1,sr), aslagm(1,sr), as0ags(1,sr))

c        write (*,*) 'dia,sd',aslagm(1,sr),as0ags(1,sr)

        if (am0tdb .eq. 1) then
          write (29,*) '//After mixing process//'
          call tdbug(sr, nslay(sr),prcode)
        end if

c-----END mixing process (process code 13)
c
      case (14)
c-----START inversion process (process code 14)
c     pre-process stuff
        if (am0tdb .eq. 1) then
          write (29,*)
          write (29,*) '//Before inversion process//'
          call tdbug(sr, nslay(sr),prcode)
        end if
c        write (*,*) '//Before inversion process//'
c        write (*,*) 'dia,sd',aslagm(1,sr),as0ags(1,sr)

c     Convert ASD from modified log-normal to sieve classes
        call asd2m(aslagn(1,sr), aslagx(1,sr), aslagm(1,sr),
     &           as0ags(1,sr), nslay(sr), massf)

c     do process
        call invert(tlayer,asdblk(1,sr),aszlyt(1,sr),asfsan(1,sr),
     &    asfsil(1,sr),asfcla(1,sr),as0ph(1,sr),ascmg(1,sr),
     &    ascna(1,sr),asfcce(1,sr),asfcec(1,sr),asfesp(1,sr),
     &    asfom(1,sr),asfnoh(1,sr),asfpoh(1,sr),asfpsp(1,sr),
     &    asfsmb(1,sr),asdagd(1,sr),aseags(1,sr),ahrwc(1,sr),
     &    aheaep(1,sr),ahrwcw(1,sr),ahrwcf(1,sr),ahrwca(1,sr),
     &    ahrwcs(1,sr),
     &    admrtz(1,1,sr),admbgz(1,1,sr),
     &    massf)

c     post-process stuff

c     Convert ASD back from sieve classes to modified log-normal
        call m2asd(massf, nslay(sr),
     &    aslagn(1,sr), aslagx(1,sr), aslagm(1,sr), as0ags(1,sr))

        if (am0tdb .eq. 1) then
          write (29,*) '//After inversion process//'
          call tdbug(sr, nslay(sr),prcode)
        end if
c-----END inversion process (process code 14)
c
      case (21)
c-----START below layer compaction (process code 21)
c     pre-process stuff
c     do process
c     post-process stuff
        mcur(sr) = mcur(sr) + 1
        line = mtbl(mcur(sr))
        read(line(2:lentrm(line)),* , err=901) tibcp
c-----END below layer compaction (process code 21)
c
      case (24)
c-----START flatten process variable toughness (process code 24)
c     pre-process stuff
        mcur(sr) = mcur(sr) + 1
        line = mtbl(mcur(sr))
        read(line(2:lentrm(line)),* , err=901) bioflg, afvt(1),
     &                      afvt(2), afvt(3), afvt(4), afvt(5)

c     do process
        call flatvt(afvt, fracarea, acrbc(sr), adrbc(1,sr),
     &    acmst(sr), acdstm(sr),
     &    tcmf(sr),
     &    admst(1,sr),admf(1,sr), addstm(1,sr),
     &    bioflg)
c     post-process stuff
c-----END flatten process variable toughness (process code 24)
c
      case (25)
c-----START mass bury process variable toughness (process code 25)
c     pre-process stuff
        mcur(sr) = mcur(sr) + 1
        line = mtbl(mcur(sr))
        read(line(2:lentrm(line)),* , err=901) burydistflg,
     &              mfvt(1), mfvt(2), mfvt(3), mfvt(4), mfvt(5)

c     Default all bury processes to "all" biomass for now.
      bioflg = 0
c     adjust all burial coefficients for speed and depth
      call buryadj(mfvt,mnrbc,
     &             ospeed,ostdspeed,ominspeed,omaxspeed,
     &             tdepth,tstddepth,tmindepth,tmaxdepth)

c     do process
        if (am0tdb .eq. 1) then
          write (29,*)
          write (29,*) '//Before mass bury process//'
          call tdbug(sr, nslay(sr),prcode)
        end if

        call mburyvt(mfvt,fracarea,acrbc(sr),adrbc(1,sr),burydistflg,
     &             tlayer,aszlyt(1,sr),aszlyd(1,sr),admf(1,sr),
     &             admbgz(1,1,sr),tcmf(sr), tcmbgz(1,sr), bioflg)
        if (am0tdb .eq. 1) then
          write (29,*) '//After mass bury process//'
          call tdbug(sr, nslay(sr),prcode)
        end if
c     post-process stuff
c-----END mass bury process variable toughness (process code 25)
c
      case (26)
c-----START re-surface process variable toughness (process code 26)
c     pre-process stuff
        mcur(sr) = mcur(sr) + 1
        line = mtbl(mcur(sr))
        read(line(2:lentrm(line)),* , err=901) mfvt(1), mfvt(2),
     &                                mfvt(3), mfvt(4), mfvt(5)

        mf = mfvt(1)
c     Default all lift processes to only decomp biomass pools for now.
      bioflg = (2**mnbpls - 1) - 1

c     do process
        call liftvt(mfvt, fracarea, adrbc(1,sr), tlayer,
     &    admf(1,sr),admrtz(1,1,sr),admbgz(1,1,sr),
     &    bioflg)
c     post-process stuff
c-----END re-surface process variable toughness (process code 26)
c
      case (31)
c-----START killing process (process code 31)

c     Note that the "kill" process only stops the crop growth
c     submodel and moves the "crop" parameters to the "temporary"
c     crop pool.  The "transfer" process does the final transfer
c     of the "temporary" crop pool values over to the "decomp"
c     pools where they can now begin to decay.

c     pre-process stuff
c       Some operations will not kill certain types of crops,
c       ie., a mowing operation usually will not kill a perennial
c       crop like alfalfa but would kill many annual crops.
c       So, we have a "kill flag" that makes that distinction.
c       This flag may get expanded in the future as new situations
c       arise.

c      set am0hrvfl
c                 0 - no kill being done
c                 1 - annual killed,perennial crop NOT killed
c                 2 - annual or perennial crop which is killed
c                 3 - leaves removed by defoliation
        mcur(sr) = mcur(sr) + 1
        line = mtbl(mcur(sr))
        read(line(2:lentrm(line)),* , err=901) am0hrvfl
c       do process
C      write(*,*)'doprocess2',prcode,prname,
C     &'            am0hrvfl ',am0hrvfl,'idc',ac0idc(sr)
        if ((am0hrvfl.eq.2).or.((am0hrvfl.eq.1).and.((ac0idc(sr).eq.1)
     &     .or.(ac0idc(sr).eq.2).or.(ac0idc(sr).eq.4)
     &     .or.(ac0idc(sr).eq.5)))) then
c          Stop the crop growth (ie. stop calling crop submodel) and
c          transfer crop state to temporary crop pool
           call kill( am0cgf,
     &          acxstm(sr), tcxstm(sr),
     &          acxstmrep(sr), tcxstmrep(sr),
     &          aczht(sr), tczht(sr),
     &          acdstm(sr), tcdstm(sr),
     &          acmst(sr), tcmst(sr),
     &          acmyld(sr), tcmyld(sr),
     &          acmrt(sr), tcmrt(sr),
     &          aczrtd(sr), tczrtd(sr),
     &          acmrtz(1,sr), tcmrtz(1,sr),
     &          nslay(sr),
     &          acrlai(sr))
        endif

c     post-process stuff
c-----END killing process (process code 31)

      case (32)
c-----START cutting to height process (process code 32)
c     pre-process stuff
        mcur(sr) = mcur(sr) + 1
        line = mtbl(mcur(sr))
        read(line(2:lentrm(line)),* , err=901)
     *    cutflg, cutht, pyieldf, pstalkf, rstandf
c     do process
        cutflg = 0
        call cut(cutflg, cutht, pyieldf, pstalkf, rstandf,
     &    aczht(sr), acmyld(sr), acmst(sr),
     &    tczht(sr), tcmyld(sr), tcmst(sr), tcmf(sr),
     &    adzht(1,sr), admst(1,sr), admf(1,sr), mass_rem, mass_left)
c     post-process stuff
c       no harvest report if nothing removed
        if( pyieldf+pstalkf+rstandf.gt.0.0 ) then
            call report_harvest( sr, mass_rem, mass_left )
            call report_hydrobal( sr )
        endif
c-----END cutting to height process (process code 32)

      case (33)
c-----START cutting by fraction process (process code 33)
c     pre-process stuff
        mcur(sr) = mcur(sr) + 1
        line = mtbl(mcur(sr))
        read(line(2:lentrm(line)),* , err=901)
     *    cutht, pyieldf, pstalkf, rstandf
c     do process
        cutflg = 2
        call cut(cutflg, cutht, pyieldf, pstalkf, rstandf,
     &    aczht(sr), acmyld(sr), acmst(sr),
     &    tczht(sr), tcmyld(sr), tcmst(sr), tcmf(sr),
     &    adzht(1,sr), admst(1,sr), admf(1,sr), mass_rem, mass_left)
c     post-process stuff
c       no harvest report if nothing removed
        if( pyieldf+pstalkf+rstandf.gt.0.0 ) then
            call report_harvest( sr, mass_rem, mass_left )
            call report_hydrobal( sr )
        end if
c-----END cutting by fraction process (process code 32)

      case (34)
c-----START flatten process (process code 34)
c     pre-process stuff
        mcur(sr) = mcur(sr) + 1
        line = mtbl(mcur(sr))
        read(line(2:lentrm(line)),* , err=901) bioflg, af

c     Default all flatten processes to "all" biomass for now.
      bioflg = 0

c     do process
        call flat(af,
     &    acmst(sr), acdstm(sr),
     &    tcmf(sr),
     &    admst(1,sr),admf(1,sr), addstm(1,sr),
     &    bioflg)
c     post-process stuff
c-----END flatten process (process code 34)
c
      case (35)
c-----START mass bury process (process code 35)
c     pre-process stuff
        mcur(sr) = mcur(sr) + 1
        line = mtbl(mcur(sr))
        read(line(2:lentrm(line)),* , err=901) mf

c     Default all bury processes to "all" biomass for now.
      bioflg = 0

c     do process
        if (am0tdb .eq. 1) then
          write (29,*)
          write (29,*) '//Before mass bury process//'
          call tdbug(sr, nslay(sr),prcode)
        end if
        call mbury(mf,tlayer,admf(1,sr), admbgz(1,1,sr),
     &             tcmf(sr), tcmbgz(1,sr), bioflg)
        if (am0tdb .eq. 1) then
          write (29,*) '//After mass bury process//'
          call tdbug(sr, nslay(sr),prcode)
        end if
c     post-process stuff
c-----END mass bury process (process code 35)
c
c !!!     case (??) disabled and number replaced
c-----START cover bury process (process code ??)
c     pre-process stuff
c        mcur(sr) = mcur(sr) + 1
c        line = mtbl(mcur(sr))
c        read(line(2:lentrm(line)),* , err=901) cf
c
c     Default all cbury processes to only decomp biomass pools for now.
c      bioflg = (2**mnbpls - 1) - 1
c
c     do process
c        call cbury(cf,tlayer,admf(1,sr), admbgz(1,1,sr),
c     &             tcmf(sr), tcmbgz(1,sr), bioflg)
c     post-process stuff
c-----END cover bury process (process code ??)
c
      case (36)
c-----START re-surface process (process code 36)
c     pre-process stuff
        mcur(sr) = mcur(sr) + 1
        line = mtbl(mcur(sr))
        read(line(2:lentrm(line)),* , err=901) mf

c     Default all lift processes to only decomp biomass pools for now.
      bioflg = (2**mnbpls - 1) - 1

c     do process
        call lift(mf,tlayer,
     &    admf(1,sr),admrtz(1,1,sr),admbgz(1,1,sr),
     &    bioflg)
c     post-process stuff
c-----END re-surface process (process code 36)
c
      case (37)
c-----START thinning to population process (process code 37)
c     pre-process stuff
        mcur(sr) = mcur(sr) + 1
        line = mtbl(mcur(sr))
        read(line(2:lentrm(line)),* , err=901)
     *    thinval, pyieldf, pstalkf, rstandf
c     do process
        thinflg = 1
        call thin(thinflg, thinval, pyieldf, pstalkf, rstandf,
     &    acdstm(sr), acmyld(sr), acmst(sr),
     &    tcdstm(sr), tcmyld(sr), tcmst(sr), tcmf(sr),
     &    addstm(1,sr), admst(1,sr), admf(1,sr), mass_rem, mass_left)
c     post-process stuff
c       no harvest report if nothing removed
        if( pyieldf+pstalkf+rstandf.gt.0.0 ) then
            call report_harvest( sr, mass_rem, mass_left )
            call report_hydrobal( sr )
        end if
c-----END thinning to population process (process code 37)

      case (38)
c-----START thinning by fraction process (process code 38)
c     pre-process stuff
        mcur(sr) = mcur(sr) + 1
        line = mtbl(mcur(sr))
        read(line(2:lentrm(line)),* , err=901)
     *    thinval, pyieldf, pstalkf, rstandf
c     do process
        thinflg = 0
        call thin(thinflg, thinval, pyieldf, pstalkf, rstandf,
     &    acdstm(sr), acmyld(sr), acmst(sr),
     &    tcdstm(sr), tcmyld(sr), tcmst(sr), tcmf(sr),
     &    addstm(1,sr), admst(1,sr), admf(1,sr), mass_rem, mass_left)
c     post-process stuff
c       no harvest report if nothing removed
        if( pyieldf+pstalkf+rstandf.gt.0.0 ) then
            call report_harvest( sr, mass_rem, mass_left )
            call report_hydrobal( sr )
        end if
c-----END thinning by fraction process (process code 38)

      case (40)
c-----START crop to biomass transfer process (process code 40)
c     pre-process stuff
C
c     do process

C put in code to check if a crop is actually "growing" here
C if so, then do the "transfer" process (default action)
C may later want to include a "transfer process" flag that could
C force a "biomass transfer" to occur
C
      if ((tczht(sr)  .gt. 0.0) .or.
     &    (tcdstm(sr) .gt. 0.0) .or.
     &    (tcmst(sr)  .gt. 0.0) .or.
     &    (tcmf(sr)   .gt. 0.0) .or.
     &    (tcmrt(sr)  .gt. 0.0) .or.
     &    (tcmyld(sr) .gt. 0.0)) then   ! assume these are enough to check

C***  if    (tczht(sr)  .gt. 0.0) write(*,*) 'tczht: ', tczht(sr)
C***  if    (tcdstm(sr) .gt. 0.0) write(*,*) 'tcdstm: ', tcdstm(sr)
C***  if    (tcmst(sr)  .gt. 0.0) write(*,*) 'tcmst: ', tcmst(sr)
C***  if    (tcmf(sr)   .gt. 0.0) write(*,*) 'tcmf: ', tcmf(sr)
C***  if    (tcmrt(sr)  .gt. 0.0) write(*,*) 'tcmrt: ', tcmrt(sr)
C***  if    (tcmyld(sr) .gt. 0.0) write(*,*) 'tcmyld: ', tcmyld(sr)

          call trans(
     &         tczht(sr), adzht(1,sr),
     &         tcxstm(sr), adxstm(1,sr),
     &         tcxstmrep(sr), adxstmrep(1,sr),
     &         tcdstm(sr), addstm(1,sr),
     &         tcmyld(sr),
     &         tcmst(sr), admst(1,sr),
     &         tcmf(sr), admf(1,sr),
     &         tcmbg(sr), admbg(1,sr),
     &         tcmrt(sr), admrt(1,sr),
     &         tcmbgz(1,sr), admbgz(1,1,sr),
     &         tcmrtz(1,sr), admrtz(1,1,sr),
     &         cumdds(1,sr), cumddf(1,sr), cumddg(1,1,sr),
     &         acrbc(sr), adrbc(1,sr),
     &         dkrate(1,1,sr), covfact(1,sr),
     &         ddsthrsh(1,sr),
     &         acdkrate(1,sr), accovfact(sr),
     &         acddsthrsh(sr),
     &         ac0nam(sr), ad0nam(sr),
     &         nslay(sr),
     &         acm(sr), acrsai(sr), acrlai(sr),
     &         acrsaz(1,sr), acrlaz(1,sr),
     &         acffcv(sr), acfscv(sr), acftcv(sr) )
      end if

c      do idx=1,mnbpls
c          write(*,*) 'after trans',adzht(idx,sr),addstm(idx,sr),
c     &                     adxstm(idx,sr)
c      end do
c
c     post-process stuff
c
c-----END crop to biomass transfer process (process code 40)
c
      case (50)
c-----START residue initialization process (process code 50)
c     Read surface residue counts and amount
        mcur(sr) = mcur(sr) + 1
        line = mtbl(mcur(sr))
        read(line(2:lentrm(line)),* , err=901)
     *    addstm(1,sr), adzht(1,sr), admst(1,sr), admf(1,sr),
     *    adrbc(1,sr)
c     get additional line of data
        mcur(sr) = mcur(sr) + 1
        line = mtbl(mcur(sr))
c     read buried residue amounts
        read(line(2:lentrm(line)), *, err=901)
     *    dmassres, zmassres, dmassrot, zmassrot
c     place buried residue in pools by layer
      call resinit(dmassrot,zmassrot,nslay(sr),admrtz(1,1,sr),
     &             aszlyt(1,sr))
      call resinit(dmassres,zmassres,nslay(sr),admbgz(1,1,sr),
     &             aszlyt(1,sr))
c     get additional line of data
        mcur(sr) = mcur(sr) + 1
        line = mtbl(mcur(sr))
c     read decomposition parameters for type of residue buried
        read(line(2:lentrm(line)), *, err=901)
     *    dkrate(1,1,sr), dkrate(2,1,sr), dkrate(3,1,sr),
     *    dkrate(4,1,sr), dkrate(5,1,sr),  adxstm(1,sr),
     *    ddsthrsh(1,sr), covfact(1,sr)
c     pre-process stuff
c     do process
c     give residue the proper name
      ad0nam(sr) = cropname
c     post-process stuff
c     set cumulative degree days for residues to zero
      cumdds(1,sr) = 0.0
      cumddf(1,sr) = 0.0
      do idx=1,nslay(sr)
          cumddg(idx,1,sr) = 0.0
      end do
c-----END residue initialization process (process code 50)
c
      case (51)
c-----START planting process (process code 51)
c     pre-process stuff
c     read population, spacing and yield flags
        mcur(sr) = mcur(sr) + 1
        line = mtbl(mcur(sr))
        read(line(2:lentrm(line)),* , err=901)
     &    acrsfg(sr), acxrow(sr), acdpop(sr), acntil(sr),
     &    acbaflg(sr), acytgt(sr), acbaf(sr), acyraf(sr), achyfg(sr)
c       write(*,*)'acrsfg, acxrow, acdpop, acntil, acbaflg, acytgt, acbaf
c     &, acyraf, achyfg'
c      write(*,*) acrsfg(sr), acxrow(sr), acdpop(sr), acntil(sr),
c     &    acbaflg(sr), acytgt(sr), acbaf(sr), acyraf(sr), achyfg(sr)
c     get additional line of data
        mcur(sr) = mcur(sr) + 1
        line = mtbl(mcur(sr))
c     kill and transfer only if existing crop and new crop
      if( am0cgf.and.(acdpop(sr).gt.0.0) ) then
c         In a growth model growing only a single crop, any existing crop must
c         be killed and transferred to residue or all the residue will be lost
c         when the new crop is initialized
c        (remove when multiple species capable)
          call kill( am0cgf,
     &         acxstm(sr), tcxstm(sr),
     &         acxstmrep(sr), tcxstmrep(sr),
     &         aczht(sr), tczht(sr),
     &         acdstm(sr), tcdstm(sr),
     &         acmst(sr), tcmst(sr),
     &         acmyld(sr), tcmyld(sr),
     &         acmrt(sr), tcmrt(sr),
     &         aczrtd(sr), tczrtd(sr),
     &         acmrtz(1,sr), tcmrtz(1,sr),
     &         nslay(sr),
     &         acrlai(sr))
          call trans(
     &         tczht(sr), adzht(1,sr),
     &         tcxstm(sr), adxstm(1,sr),
     &         tcxstmrep(sr), adxstmrep(1,sr),
     &         tcdstm(sr), addstm(1,sr),
     &         tcmyld(sr),
     &         tcmst(sr), admst(1,sr),
     &         tcmf(sr), admf(1,sr),
     &         tcmbg(sr), admbg(1,sr),
     &         tcmrt(sr), admrt(1,sr),
     &         tcmbgz(1,sr), admbgz(1,1,sr),
     &         tcmrtz(1,sr), admrtz(1,1,sr),
     &         cumdds(1,sr), cumddf(1,sr), cumddg(1,1,sr),
     &         acrbc(sr), adrbc(1,sr),
     &         dkrate(1,1,sr), covfact(1,sr),
     &         ddsthrsh(1,sr),
     &         acdkrate(1,sr), accovfact(sr),
     &         acddsthrsh(sr),
     &         ac0nam(sr), ad0nam(sr),
     &         nslay(sr),
     &         acm(sr), acrsai(sr), acrlai(sr),
     &         acrsaz(1,sr), acrlaz(1,sr),
     &         acffcv(sr), acfscv(sr), acftcv(sr) )
      endif
c
      am0hrvfl = 0

c     read yield reporting name
          acynmu(sr) = line(2:71)   !at present, line ends with < symbol at 72
c        read(line(2:lentrm(line)), *, err=901)
c     &    acynmu(sr)
c         write(*,*)'acynmu(sr)',acynmu(sr)
        mcur(sr) = mcur(sr) + 1
        line = mtbl(mcur(sr))
c     read yield reporting values and growth characteristics
        read(line(2:lentrm(line)), *, err=901)
     &    acywct(sr), acycon(sr), ac0idc(sr), acgrf(sr),
     &    ac0ck(sr), acehu0(sr)
c      write(*,*)'acywct,acycon,ac0idc,acgrf,ac0ck,acehu0'
c      write(*,*) acywct(sr),acycon(sr),ac0idc(sr),acgrf(sr),ac0ck(sr),
c     & acehu0(sr)
        mcur(sr) = mcur(sr) + 1
        line = mtbl(mcur(sr))
c     read crop growth parameters
        read(line(2:lentrm(line)), *, err=901)
     &    aczmxc(sr), aczmrt(sr), actmin(sr), actopt(sr),
     &    acthud(sr), actdtm(sr), acthum(sr)
c        write(*,*) 'aczmxc,aczmrt,actmin,actopt,acthud,actdtm,acthum'
c      write(*,*)aczmxc(sr),aczmrt(sr),actmin(sr),actopt(sr),acthud(sr),
c     &actdtm(sr),acthum(sr)
        mcur(sr) = mcur(sr) + 1
        line = mtbl(mcur(sr))
        read(line(2:lentrm(line)), *, err=901)
     &    ac0fd1(1,sr), ac0fd2(1,sr), ac0fd1(2,sr), ac0fd2(2,sr),
     &    ac0be1(2,sr)
c      write(*,*)'ac0fd1,ac0fd2,ac0fd1,ac0fd2,ac0be1(2,sr)'
c      write(*,*) ac0fd1(1,sr),ac0fd2(1,sr),ac0fd1(2,sr),ac0fd2(2,sr),
c     &ac0be1(2,sr)
        mcur(sr) = mcur(sr) + 1
        line = mtbl(mcur(sr))
        read(line(2:lentrm(line)), *, err=901)
     &    ac0alf(sr), ac0blf(sr), ac0clf(sr), ac0dlf(sr),
     &    ac0arp(sr), ac0brp(sr), ac0crp(sr), ac0drp(sr)
c      write(*,*)'ac0alf,ac0blf,ac0clf,ac0dlf,ac0arp,ac0brp,ac0crp,ac0drp
c     &'
c      write(*,*) ac0alf(sr),ac0blf(sr),ac0clf(sr),ac0dlf(sr),
c     &    ac0arp(sr), ac0brp(sr), ac0crp(sr), ac0drp(sr)
        mcur(sr) = mcur(sr) + 1
        line = mtbl(mcur(sr))
        read(line(2:lentrm(line)), *, err=901)
     &    ac0aht(sr), ac0bht(sr), ac0ssa(sr), ac0ssb(sr),
     &    ac0sla(sr), ac0hue(sr), ac0lfe(sr), acrbc(sr)
c       write(*,*)'ac0aht,ac0bht,ac0ssa,ac0ssb,ac0sla,ac0hue,ac0lfe,acrbc
c     &'
c      write(*,*) ac0aht(sr), ac0bht(sr), ac0ssa(sr), ac0ssb(sr),
c     &    ac0sla(sr), ac0hue(sr), ac0lfe(sr), acrbc(sr)
c     convert sla and ssa to cm^2/plant
        ac0sla(sr) = ac0sla(sr) * 10.
        ac0ssa(sr) = ac0ssa(sr) * 10.
        mcur(sr) = mcur(sr) + 1
        line = mtbl(mcur(sr))
        read(line(2:lentrm(line)), *, err=901)
     &    acdkrate(1,sr),acdkrate(2,sr),acdkrate(3,sr),acdkrate(4,sr),
     &    acdkrate(5,sr), acxstm(sr), acddsthrsh(sr), accovfact(sr)

c       write(*,*)acgrf(sr)
c       set row spacing based on flag
        select case( acrsfg(sr) )
        case(0) ! Broadcast Planting
            acxrow(sr) = 0.0
        case(1) ! Use Implement Ridge Spacing
            if(imprs.gt.0.001) then
                acxrow(sr) = imprs*mmtom
            else  ! no ridges, so this is a broadcast crop
                acxrow(sr) = 0.0
            endif
        case(2) ! Use Specified Row Spacing
c           convert incoming mm to meters used in acxrow
            acxrow(sr) = acxrow(sr)*mmtom
        case default
            write(*,*) 'Invalid row spacing flag value'
        end select

c       do process
c       do not initialize crop if no crop is present
        if( acdpop(sr).gt.0 ) then
c         set flag for crop initialization - jt
          am0cif = .true.
c         set crop growth flag on - jt
          am0cgf = .true.
          acdstm(sr) = acdpop(sr) !eventually we will multiply by tillering factor
c         give crop the proper name
          ac0nam(sr) = cropname
        endif
c       post-process stuff
        call report_hydrobal( sr )
c-----END planting process (process code 51)
c
      case (61)
c-----START biomass remove process (process code 61)
c     pre-process stuff
        mcur(sr) = mcur(sr) + 1
        line = mtbl(mcur(sr))
        read(line(2:lentrm(line)),* , err=901)
     &    pyieldf, pstalkf, prootf, rstandf, rflatf, rbgf, rrootf

c     do process
        if (am0tdb .eq. 1) then
          write (29,*)
          write (29,*) '//Before biomass remove process//'
          call tdbug(sr, nslay(sr),prcode)
        end if

        call remove(pyieldf,pstalkf,prootf,rstandf,rflatf,rbgf,rrootf,
     &    aczht(sr),acdstm(sr),acmyld(sr),acmst(sr),
     &    acmrt(sr), acmrtz(1,sr),
     &    tczht(sr),tcdstm(sr),tcmyld(sr),tcmst(sr),tcmf(sr),
     &    tcmbg(sr), tcmbgz(1,sr),tcmrt(sr), tcmrtz(1,sr),
     &    adzht(1,sr),addstm(1,sr),admst(1,sr),admf(1,sr),
     &    admbgz(1,1,sr),admrtz(1,1,sr),
     &    nslay(sr), mass_rem, mass_left)

        if (am0tdb .eq. 1) then
          write (29,*) '//After biomass remove process//'
          call tdbug(sr, nslay(sr),prcode)
        end if
c     post-process stuff
c       no harvest report if nothing removed
        if( pyieldf+pstalkf+prootf+rstandf+rflatf+rbgf+rrootf
     &      .gt.0.0 ) then
            call report_harvest( sr, mass_rem, mass_left )
            call report_hydrobal( sr )
        end if
c-----END biomass remove process (process code 61)
c
      case (71)
c-----START irrigate process (process code 71)
c     pre-process stuff
c        write (*,*) 'prior to irrig -> ahzirr(sr), amt',
c     &               ahzirr(sr), irrig
        mcur(sr) = mcur(sr) + 1
        line = mtbl(mcur(sr))
        read(line(2:lentrm(line)),* , err=901) irrig
		ahzirr(sr) = ahzirr(sr) + irrig
c        write (*,*) 'irrig this much -> ahzirr(sr), amt',
c     &               ahzirr(sr), irrig
c     do process
        if (am0tdb .eq. 1) then
          write (29,*)
          write (29,*) '//Before irrigate process//'
          !call tdbug(sr, nslay(sr),prcode)
        end if
c Hmm, don't really need to "call" an irrigation routine yet.
c       call irrig(am0irr(sr), ahzirr(sr))
c       call irrig(0, 254.0)
        if (am0tdb .eq. 1) then
          write (29,*) '//After irrigate process//'
          !call tdbug(sr, nslay(sr),prcode)
        end if
c     post-process stuff
c-----END irrigate process (process code 71)
c
      case default
        goto 902
      end select
C
C      write(*,*)'doprocess3',prcode,prname,
C     &'            am0hrvfl ',am0hrvfl,'idc',ac0idc(sr)
      return
C
C Error stops
C
  901 write(*,*) 'Error reading parameter ', line
      stop 1003
  902 write(*,*) 'Invalid process ', prname, ' ', prcode
      stop 1003
      end