!***************************************************************************
!
! Distributes potential plant evaporation through the root zone
!     and calculates actual plant water use based on soil water
!     availability.
!
!***************************************************************************
   
subroutine swu(nowcrp,nsl,itype,rtd,solthk,plaint,ep,pintlv, &
          &          pltol, ul4, ul, st, watstr)

implicit none
include 'constants.inc'

!****************************************************************************
!    nowcrp - ?
!    nsl - number of soil layers
!    itype - plant type, plant growth scenario index(?)
!    rtd -  root depth (m)
!    solthk - cumulative thickness of soil layer (m)
!    plaint - interception of rain water by live plants (m)
!    ep -  plant transpiration (m/day)
!    pintlv -  plant interception left over from the day before
!    pltol -  plant drought resistance factor (0 to 1), unitless
!    ul4 - parameter to adjust potential water use by plants
!    ul -  upper limit of water content per soil layer 
!    st -  current available water content per soil layer (m)
!    watstr - water stress parameter for plant growth (0-1)
!
!****************************************************************************

      integer, intent(in) :: nowcrp, nsl, itype(mxcrop)
      real, intent(in) :: solthk(mxnsl)
      real, intent(in) :: ul(mxnsl) 

      real, intent(inout) :: rtd, ep, pintlv, pltol
      real, intent(inout) :: ul4, st(mxnsl), watstr, plaint


!     + + + LOCAL VARIABLES + + +
      real  gx, sum, u(mxnsl),ub, uob, xx    
      integer k,ixx
!
!     + + + LOCAL DEFINITIONS + + +
!       sum   - potential (maximum possible) water uptake by plant
!               roots.
!       u     - actual water uptake by plant roots from each soil
!               layer, m.
!       xx    - total water uptake for this OFE.
!       ixx   - index of deepest soil layer containing roots.
!       gx    - depth of roots in the current layer.
!       ub    - a plant water use rate-depth parameter = 3.065
!               (See eq. 7.3.3)
!       uob   -  Since UB is a constant, "1 - exp(-UB)" is too;
!                ie, 0.953346.
!
!     + + + DATA INITIALIZATIONS + + +
      data uob /0.953346/, ub /3.065/
!
!     + + + END SPECIFICATIONS + + +
!
!      If the roots are all within the soil layers....
      if (rtd.lt.solthk(nsl)) then
!       Initialize U and find deepest soil layer (IXX) containing roots.
!       (Reverse order of loop to find SHALLOWEST layer >= root depth.)
        do 10 k = nsl, 1, -1
          u(k) = 0.
          if (rtd.le.solthk(k)) ixx = k
   10   continue
!
!     If the root depth is greater than the soil layers....
      else
        rtd = solthk(nsl)
        ixx = nsl
      end if
!
!     new adjustment of ep for intercepted rain by live plants(intpla)
!     plaint will evaporate first, reza 7/27/93
!
      if (plaint.gt.0.0) then
        ep = ep - plaint
      if (ep.gt.0.0) pintlv = 0.0
        if (ep.lt.0.0) then
        pintlv = -ep
        ep = 0.0        
      endif
      end if

!     If there is evapotranspiration....
      if (ep.gt.0.) then
        xx = 0.0
!
!       distribution of plant transpiration ep (m) in the root zone rtd (m)
!       (equations 7.3.3-4)
!
!       For all soil layers containing roots....
        do 20 k = 1, ixx
!
          if (k.lt.ixx) then
            gx = solthk(k)
          else
            gx = rtd
          end if
!
!         (eq. 7.3.3)
          if (rtd.gt.0.0) then
            sum = (1.-exp(-ub*gx/rtd)) * ep / uob
          else
            sum = ep / uob
          end if
!
          u(k) = sum - xx
!
!         Determine tolerence to moisture stress for current crop;
!         ie, the fraction of UL that soil moisture reach before
!         moisture stress occurs, and water uptake is reduced.
          if (itype(nowcrp).gt.0) then
!           ---------- if no value is input for PLTOL; ie, PLTOL = 0, set PLTOL
!           to default value of 0.25.
            if (pltol.le.0.) then
              pltol = 0.25
!           ---------- if value input for PLTOL is > 0.4, set it to 0.4.
            else if (pltol.gt.0.4) then
              pltol = 0.4
!           ---------- if value input for PLTOL is < 0.1, set it to 0.1.
            else if (pltol.lt.0.1) then
              pltol = 0.1
            end if
!
!           Determine the threshold for water stress (UL4).
            ul4 = pltol * ul(k)

!         --------- compute water uptake by plants, (not to exceed avail. moisture (ST))
            if (st(k).lt.ul4) u(k) = u(k) * st(k) / ul4
        end if
          if (st(k).lt.u(k)) u(k) = st(k)
          if (u(k).lt.1e-10) u(k) = 0.0
!
!         -------- reduce water content of soil layer to reflect plant uptake.
          st(k) = st(k) - u(k)
          if (st(k).lt.1e-10) st(k) = 0.00
!
          xx = xx + u(k)
!
   20   continue
!
!       Calculate water stress factor (0-1); ie, ratio of actual uptake
!       to potential uptake.
        watstr = xx / ep
!       ------ set evapotranspiration = actual water uptake.
        ep = xx
!
!     If there is no evapotranspiration....
      else
        watstr = 1.0
      end if

      ep = ep + plaint
      if(pintlv.gt.0.0) then
        ep = ep - pintlv
      endif

      plaint = 0.0
      return
      end subroutine
!      end module