module parameters
    integer, parameter :: dp = kind(1.d0) !selected_real_kind=12
    real(dp), parameter :: pi=4.d0*atan(1d0)

    integer, parameter :: maxnzone = 100
    integer, parameter :: maxnr = 1000
    integer, parameter :: maxlmax = 80000
    integer, parameter :: maxnlay = 88300
    integer, parameter :: maxnslay = 48840
    integer, parameter :: maxnllay = 32040
    integer, parameter :: ilog = 0
    real(dp), parameter :: lmaxdivf = 2.d4
    real(dp), parameter :: shallowdepth = 100.d0
    real(dp), parameter :: flattening = 1.d0 / 298.25d0
    ! specfem flattening is f = 1/299.8

end module parameters


      subroutine gcurve(sdate,iplane,plant,iwarn,ifrost,t2,rgc,plive,
     1    growth)
c
c     + + + PURPOSE + + +
c     Estimates the amount of leaf biomass accrued today (GROWTH).
c     If a killing frost occurs, resets peak live plant biomass to
c     zero.
c
c     GCURVE assumes a bell-shaped growth curve.  The curve's falling
c     side is not required to be symetric to its rising side.  GCURVE
c     models a bi-modal growth curve if requested, following the E-RHYME (sp?)
c     model's approach.  This involves overlaying two bell-shaped
c     curves in the appropriate phase.  The value of CF1 represents
c     the fraction of the season spent in the first growth period
c     (represented by the first curve).  If CF1 is less than one, a
c     bi-modal curve is generated.
c
c     NOTE: Since CS2 is always (1 - CF1), it can be eliminated from
c           GCURVE.  This is a user input, and is used nowhere else
c           in the model, so CF2 can also be eliminated from common
c           block CLIM.  Re: 2/9/93 telcon w/Weltz -- CRM -- 2/9/93.
c
c     NOTE: PLANT is set to ITYPE(NOWCRP,IPLANE) in RANGE.  It should
c           probably be changed to NOWCRP, and ITYPE(NOWCRP,IPLANE)
c           used in its place in RANGE.  -- CRM -- 2/9/93.
c
c     Called from RANGE
c     Author(s): Weltz, Meyer
c     Reference in User Guide: Chapter 8
c                              Also see: paper by Innis & Parton, CSU,
c                                        on mathematics used in E-RHYME
c                                        model.  (Weltz will supply.)
c
c     Changes:
c          1) Introduced TMPVR1, TMPVR2, TMPVR3, & TMPVR4.
c          2) Eliminated variable CF2.
c          3) Eliminated local variable SHAPER.
c          4) The code:
c                if(pscday(plant) .gt. (strrgc(plant)+t1-10.0)) then
c                  pscday(plant) = pscday(plant) - 10.0
c             changed to:
c                if(pscday(plant) .gt. (strrgc(plant)+t1*0.75)) then
c                  pscday(plant) = strrgc(plant)+t1*0.75
c             This eliminates the possibility that the growth peak
c             will occur after the growing season.  RE: 3/16/93 telcon
c             w/Mark Weltz.
c          5) Moved the 4th parameter to the 7th place to conform to
c             WEPP Coding Convention.
c          6) Dimensioned SPRED & SPRED2 to MXCROP, since they are
c             only computed once, on the first day of growth, and
c             added include for PMXCRP.INC.
c          7) Added RGC to list of parameters.  RANGE prints it, so
c             it needs to receive it's value.  RE: telcon w/Weltz
c             3/23/93.
c          8) Moved shape2 and prgc(mxplan) to common block crinpt2.inc
c             jca2 8/31/93
c
c     Version: This module recoded from WEPP Version 92.25.
c     Date recoded: 02/08/93 - 3/17/93.
c     Recoded by: Charles R. Meyer.
c
c     + + + KEYWORDS + + +
c
c     + + + PARAMETERS + + +
      include 'pmxhil.inc'
      include 'pmxpln.inc'
      include 'pntype.inc'
      include 'pmxcrp.inc'
c
c     + + + ARGUMENT DECLARATIONS + + +
      real t2, rgc, plive, growth
      integer sdate, iplane, plant, iwarn, ifrost
c
c     + + + ARGUMENT DEFINITIONS + + +
c     t2     - number of days in second growth period.
c     rgc    - fraction of leaf biomass that has accrued to date for
c              first growing period.
c     plive  - peak standing live plant plant biomass.
c     growth - amount of leaf biomass accrued today
c     sdate  - current Julian date
c     iplane - current OFE
c     plant  - set to ITYPE(NOWCRP,IPLANE) -- Should probably be changed.
c     iwarn  - flag. 0=no warning generated by GCURVE this simulation year
c     ifrost - flag. 1=killing frost has occurred.
c
c     + + + COMMON BLOCKS + + +
      include 'cclim.inc'
c        read: cf1, gtemp, tempmn(ntype), ffp(ntype)
c      modify: pscday(ntype), strrgc(ntype), cshape(ntype), dshape(ntype),
c              scday2(ntype), strgc2(ntype), eshape(ntype), fshape(ntype)
c
      include 'crinpt2.inc'
c        read tmnavg
c
c     + + + LOCAL VARIABLES + + +
      real spred(ntype), spred2(ntype), rgc2, t1, groper, ratioc,
     1    ratiod, ratioe, ratiof, ex, tmpvr1, tmpvr2, tmpvr3, tmpvr4,
     1    fsdate
c     + + + LOCAL DEFINITIONS + + +
c     spred  - growing days required to reach peak standing crop for
c              first growing period.
c     spred2 - growing days required to reach peak standing crop for
c              second growing period.
c     rgc2   - fraction of leaf biomass that has accrued to date for
c              second growing period.
c     t1     - days in first growth period
c     groper - days from start of growth period to today
c     ratioc - constant for rising side of first growth peak
c     ratiod - constant for falling side of first growth peak
c     ratioe - constant for rising side of second growth peak
c     ratiof - constant for falling side of second growth peak
c     ex     - constant used to calculate RGC & RGC2.
c
c     + + + SAVES + + +
      save spred, spred2
c
c     + + + DATA INITIALIZATIONS + + +
c
c     + + + OUTPUT FORMATS + + +
c
c     + + + END SPECIFICATIONS + + +
c
c     Create a real variable using the current integer
c     simulation day - "sdate"    dcf  11-22-99
      fsdate = float(sdate)
c
c
c         Estimate plant growth with relative growth curve
c
c
c      *** L0 IF ***
c      (EXECUTED ONLY ON FIRST DAY OF GROWTH)
c ---- Find first day of growth.  If growth hasn't begun (STRRGC = zero),
c      and if temp. is now adequate, start growth (set STRRGC = current date).
      if ((strrgc(plant).le.0.0).and.(tmnavg.ge.gtemp(plant))) then
        strrgc(plant) = fsdate
c
c       *****************************************************
c       * calculate coefficients for first growing season *
c       *****************************************************
c
c       ------ If the growing season ENDS before the day of peak growth,
c       set day of peak growth to middle of growing season.
        if (strrgc(plant)+ffp(plant).le.pscday(plant)) then
          pscday(plant) = strrgc(plant) + ffp(plant) / 2.0
c         ------ Warn user.
          write (6,1000) pscday(plant)
        end if
c
c       ------ days in 1st growing period
c       (WEPP Equation 8.5.5a)
c       Original Code:
c       (Changed because CF1 + CF2 = 1.)
c       t1 = (cf1(plant)*ffp(plant)) / (cf1(plant)+cf2(plant))
        t1 = (cf1(plant)*ffp(plant))
c
c       ------ If growth peak is later than 75 percent of the way through the
c       growing season, set it there.
        if (pscday(plant).gt.(strrgc(plant)+t1*0.75)) then
          pscday(plant) = strrgc(plant) + t1 * 0.75
c         ------ Warn user.
          write (6,1100) pscday(plant)
        end if
c
c       ------ growing days required to reach peak standing crop (1st curve)
c       (WEPP Equation 8.5.5a)
        spred(plant) = pscday(plant) - strrgc(plant)
c
c       ------ ratio: days_to_peak_1 / days_in_period_1
        tmpvr1 = spred(plant) / t1
c       ------ rising side of 1st curve
c       (WEPP Equation 8.5.4)
        cshape(plant) = 8.515 - 22.279 * tmpvr1 + 16.734 * tmpvr1 ** 2
c       ------ descending side of 1st curve
c       (WEPP Equation 8.5.5)
        dshape(plant) = 12.605 - 63.229 * tmpvr1 + 87.93 * tmpvr1 ** 2
c
c       ******************************************************
c       * calculate coefficients for second growing season *
c       ******************************************************
c
        if (cf1(plant).lt.1.0) then
c         -------- days in 2nd growing period
c         (WEPP Equation 8.5.10)
          t2 = ffp(plant) - t1
c         -------- If the 2nd peak occurs before the second growth period starts...
          if (scday2(plant).le.strrgc(plant)+t1) then
c           ---------- growing days required to reach peak standing crop (2nd curve)
            scday2(plant) = strrgc(plant) + t1 + (0.5*t2)
c           ---------- Warn user.
            write (6,1200) scday2(plant)
          end if
c
c         set begining of second growing season
c
c         (WEPP Equation 8.5.10)
          strgc2(plant) = t1 + strrgc(plant)
c         -------- growing days required to reach peak standing crop (2nd curve)
c         (WEPP Equation 8.5.10)
          spred2(plant) = scday2(plant) - strgc2(plant)
c         -------- ratio: days_to_peak_2 / days_in_period_2
          tmpvr2 = spred2(plant) / t2
c         -------- rising side of 2nd curve
c         (WEPP Equation 8.5.4)
          eshape(plant) = 8.515 - 22.279 * tmpvr2 + 16.794 * tmpvr2 ** 2
c         -------- descending side of 2nd curve
c         (WEPP Equation 8.5.5)
          fshape(plant) = 12.605 - 63.229 * tmpvr2 + 87.93 * tmpvr2 ** 2
          shape2 = eshape(plant) / fshape(plant)
        end if
c
c     *** L0 ENDIF ***
      end if
c
c
c     If the user does not want any plant growth at all to occur
c     (indicated by input of non-positive PSCDAY), the following
c     code will prevent any growth from occuring.
c
      if (pscday(plant).le.0.) then
        strrgc(plant) = 0.0
        plive = 0.0
        pscday(plant) = 0.0
      end if
c
c
c     -- XXX -- Perhaps this could be included in the L0-loop, and IWARN
c     would not be needed. -- CRM -- 3/17/93.
c     ---- warn user if growth peak occurs before growth season
      if ((iwarn.lt.1).and.(pscday(plant).lt.strrgc(plant))) then
        write (6,1300) pscday(plant)
        iwarn = iwarn + 1
      end if
c
c
c     (THE REMAINING CODE IS EXECUTED EACH TIME "GCURVE" IS CALLED.)
c
c     ---- If avg. temp. is below minimum for this plant, and it is after
c     the day of peak growth, assume there has been a killing frost.
      if (tmnavg.le.tempmn(plant).and.fsdate.gt.pscday(plant))ifrost=1
c
c
c     **************************************************************
c     * Calculate single relative growth curve if temperature OK *
c     **************************************************************
c
c     *** M0 IF ***
c     ---- If growth has started; ie, temperature is adequate....
      if (strrgc(plant).gt.0) then
c
c       *** M1 IF ***
c       If there has NOT been a killing frost....
        if (ifrost.eq.0) then
c         -------- growth days so far
          groper = fsdate - strrgc(plant)
          if (groper.lt.0.0) groper = 0.0
          if (cshape(plant).gt.15.0) cshape(plant) = 15.0
          if (dshape(plant).gt.15.0) dshape(plant) = 15.0
          if (cshape(plant).lt.0.7) cshape(plant) = 0.7
          if (dshape(plant).lt.0.7) dshape(plant) = 0.7
c
c         -------- fraction of days completed to peak
          tmpvr3 = groper / spred(plant)
          if (tmpvr3.gt.0.0) then
c           (WEPP Equation 8.5.3)
            ratiod = tmpvr3 ** dshape(plant)
c           (WEPP Equation 8.5.2)
            ratioc = tmpvr3 ** cshape(plant)
          else
            ratiod = 0.0
            ratioc = 0.0
          end if
c
c         -------- Unimodal Potential Growth Curve
c         (WEPP Equation 8.5.1)
          ex = cshape(plant) / dshape(plant) * (1.0-ratiod)
          if (ex.lt.-30.0) ex = -30.0
          rgc = ratioc * exp(ex) * cf1(plant)
c
c         *** M2 IF ***
c         Calculate bimodal relative growth curve if requested.
          if (t2.gt.1) then
c           -------- growth days so far in second growth period
            groper = fsdate - strgc2(plant)
            if (groper.lt.0.) groper = 0.0
            if (eshape(plant).gt.15.0) eshape(plant) = 15.0
            if (fshape(plant).gt.15.0) fshape(plant) = 15.0
            if (eshape(plant).lt.0.70) eshape(plant) = 0.70
            if (fshape(plant).lt.0.70) fshape(plant) = 0.70
c
c           -------- fraction of days completed to peak of second growth period
            tmpvr4 = groper / spred2(plant)
            if (tmpvr4.gt.0.0) then
c             (WEPP Equation 8.5.2)
              ratioe = tmpvr4 ** eshape(plant)
c             (WEPP Equation 8.5.3)
              ratiof = tmpvr4 ** fshape(plant)
            else
              ratioe = 0.0
              ratiof = 0.0
            end if
c
c           (WEPP Equation 8.5.1)
            ex = shape2 * (1.0-ratiof)
            if (ex.lt.-30.0) ex = -30.0
c           (WEPP Equation 8.5.1)
            rgc2 = ratioe * exp(ex) * (1.0-cf1(plant))
            if (rgc.lt.rgc2) rgc = rgc2
c
c         *** M2 ENDIF ***
          end if
c
c       *** M1 ELSE ***
c       If there has been a killing frost....
        else
          rgc = 0.0
          prgc(iplane) = 0.0
c
c       *** M1 ENDIF ***
        end if
c
c     *** M0 ENDIF ***
      end if
c
      growth = rgc - prgc(iplane)
      prgc(iplane) = rgc
c
      return
 1000 format (/,' *** WARNING ***',' first peak (pscday) outside frost',
     1    'free period.',/,' the model recalculated pscday.',f6.1,/,
     1    ' *** WARNING ***',/)
 1100 format (/,' *** WARNING ***',' first peak (pscday) is outside',
     1    ' the first growing period.',/
     1    '  the model recalculated (pscday) =',f6.1,/,
     1    ' *** WARNING ***',/)
 1200 format (/,' *** ERROR ***',/,' second peak (scday2) too early.',/
     1    ' the model calculated a new value for scday2.',f6.1,/,
     1    ' *** ERROR ***',/)
 1300 format (/,' *** WARNING ***',/,' warning: strrgc is greater than',
     1    ' pscday. No plant growth will occur.',/,
     1    ' reason maybe gtemp is too high or pscday is too small.',
     1    f6.1,/,' *** WARNING ***',/)
      end


!===================================================================================
!=================== SUBROUTINE RUNGE - KUTTA 4 ====================================
!=================== VELOCITY - Y ==================================================

subroutine rk4_uky2coh(Nx,Ny,Nh,pi,time,nk,ukx,uky,uky_new,dn_dt,dux_dt,duy_dt)
implicit none
integer ( kind = 4 ) Nx,Ny,Nh, i, j
real ( kind = 8 ) pi,time,dt,Lx,Ly,mux,muy,ms,CS
real ( kind = 8 ) n(Nx,Ny),ux(Nx,Ny),uy(Nx,Ny)
complex ( kind = 8 ) kNLn1(Nh,Ny),kNLn2(Nh,Ny),kNLn3(Nh,Ny),kNLn4(Nh,Ny)
complex ( kind = 8 ) kNLx1(Nh,Ny),kNLx2(Nh,Ny),kNLx3(Nh,Ny),kNLx4(Nh,Ny)
complex ( kind = 8 ) kNLy1(Nh,Ny),kNLy2(Nh,Ny),kNLy3(Nh,Ny),kNLy4(Nh,Ny)
complex ( kind = 8 ) nk(Nh,Ny),ukx(Nh,Ny),uky(Nh,Ny),nk_new(Nh,Ny),ukx_new(Nh,Ny),uky_new(Nh,Ny)
complex ( kind = 8 ) dum_nk(Nh,Ny),dum_ukx(Nh,Ny),dum_uky(Nh,Ny)
complex ( kind = 8 ) dn_dt(Nh,Ny),dux_dt(Nh,Ny),duy_dt(Nh,Ny)
complex ( kind = 8 ) dn_dt_old(Nh,Ny),dux_dt_old(Nh,Ny),duy_dt_old(Nh,Ny)
complex ( kind = 8 ) dn_dt_new(Nh,Ny),dux_dt_new(Nh,Ny),duy_dt_new(Nh,Ny)
common/comm/Lx,Ly,mux,muy,ms,CS,dt

do i = 1,Nh
  do j = 1,Ny
    kNLy1(i,j) = duy_dt(i,j)
    dum_uky(i,j) = uky(i,j) + kNLy1(i,j)*dt/2.0d0
  end do
end do

  call derive2coh(Nx,Ny,Nh,pi,time+dt/2.0d0,nk,ukx,dum_uky, &
  dn_dt_old,dux_dt_old,duy_dt_old,dn_dt_new,dux_dt_new,duy_dt_new)

do i = 1,Nh
  do j = 1,Ny
    kNLy2(i,j) = duy_dt(i,j)
    dum_uky(i,j) = uky(i,j) + kNLy2(i,j)*dt/2.0d0
  end do
end do

  call derive2coh(Nx,Ny,Nh,pi,time+dt/2.0d0,nk,ukx,dum_uky, &
  dn_dt_old,dux_dt_old,duy_dt_old,dn_dt_new,dux_dt_new,duy_dt_new)

do i = 1,Nh
  do j = 1,Ny
    kNLy3(i,j) = duy_dt(i,j)
    dum_uky(i,j) = uky(i,j) + kNLy3(i,j)*dt/2.0d0
  end do
end do

  call derive2coh(Nx,Ny,Nh,pi,time+dt/2.0d0,nk,ukx,dum_uky, &
  dn_dt_old,dux_dt_old,duy_dt_old,dn_dt_new,dux_dt_new,duy_dt_new)

do i = 1,Nh
  do j = 1,Ny
    kNLy4(i,j) = duy_dt(i,j)
    uky_new(i,j) = uky(i,j) + dt/6.0d0*(kNLy1(i,j) + 2.0d0*kNLy2(i,j) + 2.0d0*kNLy3(i,j) + kNLy4(i,j))
  end do
end do

return

end subroutine rk4_uky2coh