SUBROUTINE CANRES(SOLAR,SFCTMP,Q2,SFCPRS,SMC,  &
     &                  GC,RC,IVEG,ISOIL,            &
     &                  RSMIN,NROOTS,SMCWLT,SMCREF,  &
     &                  RCS,RCQ,RCT,RCSOIL,SLDPTH)
!
! ######################################################################
!                        SUBROUTINE CANRES
!                        -----------------
!       THIS ROUTINE CALCULATES THE CANOPY RESISTANCE WHICH DEPENDS ON
!       INCOMING SOLAR RADIATION, AIR TEMPERATURE, ATMOSPHERIC WATER
!       VAPOR PRESSURE DEFICIT AT THE LOWEST MODEL LEVEL, AND SOIL
!       MOISTURE (PREFERABLY UNFROZEN SOIL MOISTURE RATHER THAN TOTAL)
! ----------------------------------------------------------------------
!        SOURCE:  JARVIS (1976), JACQUEMIN AND NOILHAN (1990 BLM)
! ----------------------------------------------------------------------
! PROGRAM HISTORY LOG:
!   03-01-17  M EK AND H CHUANG - LIFTED IT FROM MODEL FOR POST 
! ----------------------------------------------------------------------
! INPUT:  SOLAR: INCOMING SOLAR RADIATION
! 	  CH:	  SURFACE EXCHANGE COEFFICIENT FOR HEAT AND MOISTURE
! 	  SFCTMP: AIR TEMPERATURE AT 1ST LEVEL ABOVE GROUND
! 	  Q2:	  AIR HUMIDITY AT 1ST LEVEL ABOVE GROUND
! 	  Q2SAT:  SATURATION AIR HUMIDITY AT 1ST LEVEL ABOVE GROUND
! 	  SFCPRS: SURFACE PRESSURE
! 	  SMC:    VOLUMETRIC SOIL MOISTURE 
! 	  ZSOIL:  SOIL DEPTH (NEGATIVE SIGN, AS IT IS BELOW GROUND)
! 	  NSOIL:  NO. OF SOIL LAYERS
! 	  IROOT:  NO. OF SOIL LAYERS IN ROOT ZONE (1.LE.NROOT.LE.NSOIL)
! 	  XLAI:   LEAF AREA INDEX
! 	  SMCWLT: WILTING POINT
! 	  SMCREF: REFERENCE SOIL MOISTURE
! 		  (WHERE SOIL WATER DEFICIT STRESS SETS IN)
!
! RSMIN, RSMAX, TOPT, RGL, HS: CANOPY STRESS PARAMETERS SET IN
! SUBROUTINE REDPRM
!
!  (SEE EQNS 12-14 AND TABLE 2 OF SEC. 3.1.2 OF 
!       CHEN ET AL., 1996, JGR, VOL 101(D3), 7251-7268)               
!
!        OUTPUT:  PC: PLANT COEFFICIENT
!                 RC: CANOPY RESISTANCE
!                 GC: CANOPY CONDUCTANCE
! ----------------------------------------------------------------------
! ######################################################################

     use params_mod, only: xlai, pq0, a2, a3, a4
     use ctlblk_mod, only: novegtype, nsoil, ivegsrc
!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
      implicit none
!
!      integer,parameter :: nosoiltype=19,novegtype=27
      integer,parameter :: nosoiltype=19
      INTEGER N,K
      INTEGER, allocatable:: IROOT(:)
      INTEGER,intent(in) :: IVEG,ISOIL
      INTEGER,intent(out) :: NROOTS

      real,intent(in) :: SOLAR,SFCTMP,Q2,SFCPRS
      real,dimension(NSOIL),intent(in) :: SMC,SLDPTH
      real,intent(out) :: RCT,RCS,RCQ,RCSOIL,GC,RC,SMCWLT,SMCREF,  &
       RSMIN

      REAL CH
      REAL ZSOIL(NSOIL), PART(NSOIL)
      REAL, allocatable :: RSMN(:),RGL(:),HS(:)
      REAL SMWLT(nosoiltype),SMREF(nosoiltype)     &
     & ,Q2SAT
      REAL TOPT,RSMAX,FF
      REAL P,QS,GX,TAIR4,ST1,SLVCP,RR,DELTA,TBLO,            &
           RCMIN,RCMAX

      DATA RSMAX /5000./
      DATA TOPT /298.0/

!      DATA IROOT /1,3,3,3,3,3,3,3,3,3,4,4,4,4,4,0,2,2,1,3,         &
!     &            3,3,2,1,1,1,1/

!  SSIB VEGETATION TYPES (DORMAN AND SELLERS, 1989; JAM)
!
!   1   Urban and Built-Up Land
!   2   Dryland Cropland and Pasture
!   3   Irrigated Cropland and Pasture
!   4   Mixed Dryland/Irrigated Cropland and Pasture
!   5   Cropland/Grassland Mosaic
!   6   Cropland/Woodland Mosaic
!   7   Grassland
!   8   Shrubland
!   9   Mixed Shrubland/Grassland
!  10   Savanna
!  11   Deciduous Broadleaf Forest
!  12   Deciduous Needleleaf Forest
!  13   Evergreen Broadleaf Forest
!  14   Evergreen Needleleaf Forest
!  15   Mixed Forest
!  16   Water Bodies
!  17   Herbaceous Wetland
!  18   Wooded Wetland
!  19   Barren or Sparsely Vegetated
!  20   Herbaceous Tundra
!  21   Wooded Tundra
!  22   Mixed Tundra
!  23   Bare Ground Tundra
!  24   Snow or Ice
!  25   Playa
!  26   Lava
!  27   White Sand
!
!      DATA RSMN /200.0,  70.0,  70.0,  70.0,  70.0,  70.0,      &  
!     &            70.0, 300.0, 170.0,  70.0, 100.0, 150.0,      &
! MEK MAY 2007
! increase evergreen forest and mixed forest
!     &           150.0, 125.0, 125.0, 100.0,  40.0, 100.0,
!     &           150.0, 250.0, 150.0, 100.0,  40.0, 100.0,      &
!     &           300.0, 150.0, 150.0, 150.0, 200.0, 200.0,      &
!     &            40.0, 100.0, 300.0/
!     
!      DATA RGL /100.0, 100.0, 100.0, 100.0, 100.0,  65.0,       &
!     &          100.0, 100.0, 100.0,  65.0,  30.0,  30.0,       &
!     &           30.0,  30.0,  30.0,  30.0, 100.0,  30.0,       &
!     &          100.0, 100.0, 100.0, 100.0, 100.0, 100.0,       &
!     &          100.0, 100.0, 100.0/
!     
!      DATA HS /42.00, 36.25, 36.25, 36.25, 36.25, 44.14,        &
!     &         36.35, 42.00, 39.18, 54.53, 54.53, 47.35,        &
!     &         41.69, 47.35, 51.93, 51.75, 60.00, 51.93,        &
!     &         42.00, 42.00, 42.00, 42.00, 42.00, 42.00,        &
!     &         36.25, 42.00, 42.00/
!
! SOIL TYPES   ZOBLER (1986)      COSBY ET AL (1984) (quartz cont.(1))
! ----  -------
!   1   SAND
!   2   LOAMY SAND
!   3   SANDY LOAM
!   4   SILT LOAM
!   5   SILT
!   6   LOAM
!   7   SANDY CLAY LOAM
!   8   SILTY CLAY LOAM
!   9   CLAY LOAM
!  10   SANDY CLAY
!  11   SILTY CLAY
!  12   CLAY
!  13   ORGANIC MATERIAL
!  14   WATER
!  15   BEDROCK
!  16   OTHER(land-ice)
!  17   PLAYA
!  18   LAVA
!  19   WHITE SAND

!      DATA SMREF /0.196, 0.248, 0.282, 0.332, 0.332, 0.301,
!     &           0.293, 0.368, 0.361, 0.320, 0.388, 0.389,
!     &           0.319, 0.000, 0.116, 0.248, 0.389, 0.116,
!     &           0.196/
! MEK MAY 2007
      DATA SMREF /0.236, 0.283, 0.312, 0.360, 0.360, 0.329,        &
     &            0.315, 0.387, 0.382, 0.338, 0.404, 0.403,        &
     &            0.348, 0.000, 0.133, 0.283, 0.403, 0.133,        &
     &            0.236/
!     
      DATA SMWLT /0.023, 0.028, 0.047, 0.084, 0.084, 0.066,       &
     &           0.069, 0.120, 0.103, 0.100, 0.126, 0.135,        &
     &           0.069, 0.000, 0.012, 0.028, 0.135, 0.012,        &
     &           0.023/



! ----------------------------------------------------------------------
! INITIALIZE CANOPY CONDUCTANCE TERMS
! ----------------------------------------------------------------------
! allocate data for IROOT RSMN RGL HS
      allocate(IROOT(novegtype))
      allocate(RSMN(novegtype))
      allocate(RGL(novegtype))
      allocate(HS(novegtype))
      if(ivegsrc==1)then  !IGBP veg type
       IROOT=(/4,4,4,4,4,3,3,3,3,3,3,3,1,3,2,3,0,3,3,2/)
       RSMN=(/300.0, 300.0, 300.0, 175.0, 175.0, 225.0, &
             225.0,  70.0,  70.0,  70.0,  40.0,  70.0, &
             400.0,  70.0, 200.0, 400.0, 100.0, 225.0, &
             150.0, 200.0/)
       RGL=(/30.0,  30.0,  30.0,  30.0,  30.0, 100.0,  &
     &          100.0,  65.0,  65.0, 100.0, 100.0, 100.0, & 
     &          100.0, 100.0, 100.0, 100.0,  30.0, 100.0, &
     &          100.0, 100.0/)
       HS=(/47.35, 41.69, 47.35, 54.53, 51.93, 42.00, &
     &         42.00, 42.00, 42.00, 36.35, 60.00, 36.25, &
     &         42.00, 36.25, 42.00, 42.00, 51.75, 42.00, &
     &         42.00, 42.00/)
      else ! asuume the other type is USGS veg type
       IROOT=(/1,3,3,3,3,3,3,3,3,3,4,4,4,4,4,0,2,2,1,3, &
              3,3,2,1/)
       RSMN=(/200.0,  70.0,  70.0,  70.0,  70.0,  70.0, &
     &            70.0, 300.0, 170.0,  70.0, 100.0, 150.0, &
! MEK MAY 2007
! increase evergreen forest and mixed forest
!     &           150.0, 125.0, 125.0, 100.0,  40.0, 100.0,
     &           150.0, 250.0, 150.0, 100.0,  40.0, 100.0,  &
     &           300.0, 150.0, 150.0, 150.0, 200.0, 200.0/) 
       RGL=(/100.0, 100.0, 100.0, 100.0, 100.0,  65.0,  &
     &          100.0, 100.0, 100.0,  65.0,  30.0,  30.0, &
     &           30.0,  30.0,  30.0,  30.0, 100.0,  30.0, &
     &          100.0, 100.0, 100.0, 100.0, 100.0, 100.0/) 
       HS=(/42.00, 36.25, 36.25, 36.25, 36.25, 44.14, &
     &         36.35, 42.00, 39.18, 54.53, 54.53, 47.35, &
     &         41.69, 47.35, 51.93, 51.75, 60.00, 51.93, &
     &         42.00, 42.00, 42.00, 42.00, 42.00, 42.00/) 
      end if

      RCS = 0.0
      RCT = 0.0
      RCQ = 0.0
      RCSOIL = 0.0
      RC = 0.0

!      ZSOIL(1)=-0.1
!      ZSOIL(2)=-0.4
!      ZSOIL(3)=-1.0
!      ZSOIL(4)=-2.0
      
      DO N=1,NSOIL
       IF(N.EQ.1)THEN
        ZSOIL(N)=-1.0*SLDPTH(N)
       ELSE
        ZSOIL(N)=ZSOIL(N-1)-SLDPTH(N)
       END IF
      END DO
! ----------------------------------------------------------------------
! SET SMCWLT, SMCREF, RSMIN, NROOTS VALUES
! ----------------------------------------------------------------------
      SMCWLT = SMWLT(ISOIL)
      SMCREF = SMREF(ISOIL)
      RSMIN = RSMN(IVEG)
      NROOTS = IROOT(IVEG)

! ----------------------------------------------------------------------
! CONTRIBUTION DUE TO INCOMING SOLAR RADIATION
! ----------------------------------------------------------------------

      FF = 0.55*2.0*SOLAR/(RGL(IVEG)*XLAI)
      RCS = (FF + RSMIN/RSMAX) / (1.0 + FF)

      RCS = MAX(RCS,0.0001)
      RCS = MIN(RCS,1.0)

! ----------------------------------------------------------------------
! CONTRIBUTION DUE TO AIR TEMPERATURE AT FIRST MODEL LEVEL ABOVE GROUND
! ----------------------------------------------------------------------

      RCT = 1.0 - 0.0016*((TOPT-SFCTMP)**2.0)

      RCT = MAX(RCT,0.0001)
      RCT = MIN(RCT,1.0)

! ----------------------------------------------------------------------
! CONTRIBUTION DUE TO VAPOR PRESSURE DEFICIT AT FIRST MODEL LEVEL.
! ----------------------------------------------------------------------

!      P = SFCPRS
! Insert QSAT computation used in ETA2P
      TBLO=SFCTMP
      Q2SAT=PQ0/SFCPRS*EXP(A2*(TBLO-A3)/(TBLO-A4)) 
      QS = Q2SAT
! RCQ EXPRESSION FROM SSIB 
      RCQ = 1.0/(1.0+HS(IVEG)*(QS-Q2))

!      RCQ = MAX(RCQ,0.01)
      RCQ = MAX(RCQ,0.0001)
      RCQ = MIN(RCQ,1.0)

! ----------------------------------------------------------------------
! CONTRIBUTION DUE TO SOIL MOISTURE AVAILABILITY.
! DETERMINE CONTRIBUTION FROM EACH SOIL LAYER, THEN ADD THEM UP.
! ----------------------------------------------------------------------

      GX = (SMC(1)-SMCWLT)/(SMCREF-SMCWLT)
      IF (GX .GT. 1.) GX = 1.
      IF (GX .LT. 0.) GX = 0.

!####   USING SOIL DEPTH AS WEIGHTING FACTOR
      PART(1) = (ZSOIL(1)/ZSOIL(NROOTS)) * GX

!#### USING ROOT DISTRIBUTION AS WEIGHTING FACTOR
!C      PART(1) = RTDIS(1) * GX
      
      IF (NROOTS .GT. 1) THEN
       DO K = 2, NROOTS
        GX = (SMC(K)-SMCWLT)/(SMCREF-SMCWLT)
        IF (GX .GT. 1.) GX = 1.
        IF (GX .LT. 0.) GX = 0.
!####   USING SOIL DEPTH AS WEIGHTING FACTOR        
        PART(K) = ((ZSOIL(K)-ZSOIL(K-1))/ZSOIL(NROOTS)) * GX

!#### USING ROOT DISTRIBUTION AS WEIGHTING FACTOR
!C         PART(K) = RTDIS(K) * GX 
               
       END DO
      ENDIF
      DO K = 1, NROOTS
        RCSOIL = RCSOIL+PART(K)
      END DO

      RCSOIL = MAX(RCSOIL,0.0001)
      RCSOIL = MIN(RCSOIL,1.0)

! ----------------------------------------------------------------------
!         DETERMINE CANOPY RESISTANCE DUE TO ALL FACTORS.
!         CONVERT CANOPY RESISTANCE (RC) TO PLANT COEFFICIENT (PC).
! ----------------------------------------------------------------------

!C/98/01/05/........RC = RCMIN/(RCS*RCT*RCQ*RCSOIL)
!      RC = RCMIN(IVEG)/(XLAI*RCS*RCT*RCQ*RCSOIL)

      RCMIN = RSMIN/XLAI
      RCMAX = RSMAX/XLAI
      RC = RCMIN/(RCS*RCT*RCQ*RCSOIL)

      RC = MAX(RCMIN,MIN(RC,RCMAX))

      GC = 1./RC
      
      RETURN
      END