C    File Version using SCCS:    %W%     (C) %G%
CM  VERSION NUMBER # 2.0,        AUTO.FOR
CM
CM  MODULE: H20
CM  PROTOTYPE: H20 (F,X,Z,B,G)
CM  WRITTEN:       JOSEPH C. COUGHLAN AND DOCUMENTED 5-2-89, 7-20-89.
CM  CONTAINS:  SUBROUTINE H2O
CD    7-20-89:
CD         O  REMOVED COMMON BLOCKS
CD         O  NEW CALL TO PENMON()
  
**ch  Modify : 2/19/90-jcc;
**mdn Notes  : Bug fix: MXTEMP was counted twice in snowmelt.  See delta
**mdn |        for changes.  Bug doubled temp snowmelt.
  
      SUBROUTINE H20 (F,X,Z,B,Gi PIDNUM)
  
      INCLUDE 'auto.blk'
C(************************************)
  
C(* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - *
C  DAILY SIMULATION PROCEDURE CALLED FOR DAILY CARBON AND WATER DYNAMICS
C
C SUMMARY:
C
C    o  COMPUTES DAILY HYDROLOGIC BALANCE
C    o  PPT/SNOW INPUTS TO SYSTEM
C    o  SNOWMELT INPUT TO SOIL
C    o  RADIATION LIMITED EVAPORATION
C    o  TRANSPIRATION
C    o  OUTFLOW
C    o  COMPUTES 1 AVERAGE DAILY CANOPY LEAF (H2O) CONDUCTANCE
C    o  COMPUTES 1 AVERAGE CANOPY MESOPHYLL (CO2) CONDUCTANCE
C    o  COMPUTES DAILY PHOTOSYNTHETIC PRODUCTION
C    o  COMPUTES DAILY MAINTENANCE RESPIRATION LOSSES
C    o  INDICATES THE STATE VARIABLE COMPARTMENT FLOWS
C
C* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - *
C          Z    DESCRIPTION
C          -    -----------
C          1    SNOWPACK ENERGY DEFICIT  (DEG C)
C          2    YEAR DAY OR JD
C          3    PRECIPITATION (M)
C          4    MAX. AIR TEMPERATURE (deg C)
C          5    MIN. AIR TEMPERATURE (deg C)
C          6    RELATIVE HUMIDITY (%)
C          7    SOIL TEMPERATURE, AVE 24 HR TEMP   (deg C)
C          8    SHORTWAVE RADIATION (KJ/m2/day summation)
C          9    SHORTWAVE RADIATION AT FOREST FLOOR
C         10    LAI F(LEAF BIOMASS)
C         14    DAYLIGHT AVERAGE AIR TEMPERATURE(deg C)
C         15    AVERAGE NIGHT MIN TEMPERATURE  (deg C)
C         16    VAPOR PRESSURE DEFICIT        (mb)
C         17    ABSOLUTE HUMIDITY DEFICIT   (mic. gm/m3)
C         18    DAYLENGTH    (sec)
C         19    CANOPY DAILY AVE RADIATION    (J/m2/day)
C         21    LEAF NITROGEN CONCENTRATION
C
C   G          DESCRIPTION
C   -          -----------
C   1          RAIN: M of H2O/HA/DAY
C   2          SNOW: M of H2O/HA/DAY
C   3          SNOWMELT: M of H2O/HA/DAY
C   4          POTENTIAL EVAPORATION OF PPT.: M of H2O/HA/DAY
C   5          EVAPORATION POSSIBLE WITH RADIATION AVAILABLE: M of H2O/HA/DAY
C   6          POTENTIAL PPT EVAP.- ENERGY LIMITED POTENTIAL EVAP.: M of H2O/HA/DAY
C  10          PRE-DAWN LEAF WATER POTENTIAL: -MPa
C  11          LEAF CONDUCTANCE PRE-DAWN LWP REDUCTION  M/SEC
C  12          LEAF CONDUCTANCE NIGHT MINIMUM TEMP. REDUCTION: MULTIPLIER
C  13          LEAF CONDUCTANCE HUMIDITY DEFICIT REDUCTION:        MULTIPLIER
C  14          LEAF CONDUCTANCE RADIATION REDUCTION:  MULTIPLIER
C  15          FINAL LEAF CONDUCTANCE: M/SEC
C  16          PENMAN-MONTHEITH TRANSPIRATION ESTIMATE: M of H20/LAI/SEC
C  17          CANOPY TRANSPIRATION: M of H2O/HA/DAY
C  18          GROUND WATER OUTFLOW: M OF H20/HA/DAY
C  20          LIGHT EFFECT ON C02 CONDUCTANCE: M/SEC
C  21          TEMP. EFFECT ON CO2 CONDUCTANCE: MULTIPLIER
C  22          FINAL MESOPHYLL CONDUCTANCE: M/SEC
C  23          GROSS PSN: KG/LAI
C  24          DAILY GROSS PSN: KG/HA/DAY
C  25          NIGHT RESPIRATION: KG/HA/DAY
C  26          24HR. NET CARBON: KG/HA/DAY
C  30          STEM RESPIRATION: KG/HA/DAY
C  31          ROOT RESPIRATION: KG/HA/DAY
C* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - *)
  
C(* DECLARATION FOR TEMPORARY VARIABLES/FUNCTIONS *)
      REAL MXTEMP, PENMON, LOG
      REAL CANINT, RADINT
      REAL ALBEDO, TM, RM, MNLCJC
      REAL T16
	REAL PIDNUM
	LOGICAL SHUTDWN
      SAVE ALBEDO
      DATA ALBEDO /1.0/
      DATA MNLCJC /0.00005/
99    format(100f15.3)
C   CC   CC   CC   CC   CC   CC   CC   CC   CC   C
C	Definition of a variable to add SCCS WHAT string
	character*80 sccswhat
        DATA sccswhat /' %W% %G%   AU JCC'/
C       End SCCS definition 
C   CC   CC   CC   CC   CC   CC   CC   CC   CC   C

C (* RESET ALBEDO, ASSUMING JAN 1ST IS START OF CLIMATE FILE *)
      IF (Z(2) .LE. 1.0) ALBEDO = 1.0
  
C (* RESET SNOWPACK ENERGY BUCKET IF NO SNOWPACK FROM PREVOIUS DAY *)
      IF (X(1) .LE. 0.0) Z(1) = 0.0
  
C (* RAIN VS SNOW *)
      IF (Z(15) .GT. 0.0 ) THEN
          G(1) =  (Z(3)-Z(10)* B(4)) * B(5)
          IF (G(1) .LT. 0.0) G(1) = 0.0
          G(2) = 0.0
      ELSE
C        (* LAI SNOW STORAGE CANOPY INTERCEPTION IS 1/2 OF RAIN *)
          CANINT =  (Z(10)* B(4)*0.5)
  
C        (* COMPUTE SNOWFALL AND SCALE TO AREA *)
          G(2) = (Z(3)-CANINT) * B(5)
  
C        IF NEGATIVE SNOWFALL THEN SET SNOWFALL TO 0.0; ALL INTERCEPTED
          G(2) = AMAX1(G(2), 0.0)
          G(1) = 0.0
      ENDIF
  
C                                 (* SNOWMELT *)
C (*  TEMPERATURE MELT *)
      IF( Z(1) .GE. 0.0) THEN
          MXTEMP = B(6) * Z(14) * B(5)
          G(3) = AMAX1(MXTEMP, 0.0)
      ELSE
          G(3) = 0.0
      ENDIF
      TM=G(3)
  
C (*  RADIATION MELT SECTION *)
  
C (*  COMPUTE ALBEDO *)
      MXTEMP= AMAX1(Z(1)/(-B(22)),0.0)
      MXTEMP = AMIN1( B(8)+B(8)*MXTEMP, 0.50)
      ALBEDO = AMIN1 ( 1-MXTEMP, ALBEDO )
  
C (*  FRESH SNOW, RESET ALBEDO AND ENERGY BUCKET *)
      IF (G(2) .GT. 0.1)  THEN
          ALBEDO = 1-B(8)
          Z(1) = AMIN1(Z(1), 0.0)
      ENDIF
  
C (*  COMPUTE RADIATION MELT *)
      IF (Z(14) .GT. 0.0) THEN
          MXTEMP = (Z(9)*(1-ALBEDO)/350000.0)*B(5)
          G(3) = AMAX1(MXTEMP, 0.0) + G(3)
          G(8) = 0.0
      ELSE
          MXTEMP = (Z(9)*(1-albedo)/2800000.0)*B(5)
          G(8) = AMAX1(MXTEMP,0.0)
      ENDIF
      RM=G(3)+G(8)-TM
  
C (*  CORRECT SNOWMELT IN CASE MORE SNOW MELTS THAN IS PRESENT *)
      IF (X(1)-G(3)-G(8) .LT. 0.0)  THEN
          G(3) = X(1)
          G(8) = 0.0
      ENDIF
  
C (*  LAI POTENTIAL RAINFALL EVAPORATION *)
      G(4) = (Z(3)* B(5)) - G(1)- G(2)
  
C (*  POTENTIAL EVAPORATION WITH RADIATION LIMIT *)
      G(5) = (Z(8)/2.5E+6) * B(5)
      IF (G(4) .LT. 0.0) G(4) = 0.0
      IF (G(4) .GT. G(5)) THEN
          G(6) = G(4) - G(5)
          G(4) = G(5)
      ELSE
          G(6) = 0.0
      ENDIF
  
C(*********** LEAF CONDUCTANCE, TRANSPIRATION **********)
  
C (*  PRE-DAWN LWP  *)
      MXTEMP = 0.2/(X(2)/B(3))
      G(10) =AMAX1 (MXTEMP,B(9))
  
C (* COLD SOIL TEMPERATURE ROOT RES. REDUCTION *)
      IF (Z(7) .EQ. 0.0) G(10) = G(10) * 2.0
  
C (* PRE-DAWN LWP LC REDUCTION  *)
      MXTEMP = B(11)-(B(11)/(B(12)-B(9)))*(G(10)-B(9))
      G(11) = AMAX1( MXTEMP,MNLCJC)
  
C (* NIGHT MIN TEMP. LC REDUCTION *)
      IF (Z(5) .LT. 0.0) THEN
          MXTEMP = G(11) + 0.0002 * Z(5)
          G(12) = AMAX1 (MXTEMP, MNLCJC)
      ELSE
          G(12) = G(11) + (G(11) *0.00003 * (Z(14) - 10))
      ENDIF
  
C (* ABSHD CONTROL OF LC *)
      MXTEMP = G(12)- (G(12)*B(13)*(Z(17)*1.0E+6 -4.0))
      G(13) = AMAX1(MXTEMP,MNLCJC)
  
C (* RADIATION REDUCTION FRACTION OF LC REDUCTION 1.0 TO 0.0  *)
      G(14) = AMIN1(1/B(10) * Z(19), 1.0)
      IF (G(14) .EQ. 0.0) G(14) = 0.00000001
  
C (* FINAL CANOPY AVG. LC  *)
      G(15) = G(14) * G(13)
  
      IF (G(10) .GT. 2.0) G(15)=0.00000001
  
C (* PENMAN - MONTEITH ESTIMATE OF TRANSPIRATION *)
      G(16) = PENMON( Z(14),Z(16),Z(19),G(15),Z(10),Z(18) )
  
C (* CANOPY TRANSPIRATION  *)
      G(17) = G(16) * Z(10) * B(5) * Z(18)
      if (g(17) .ge. x(2)) then
	g(17) = 0.80*x(2)
	SHUTDWN=.TRUE.
	ELSE
	SHUTDWN=.FALSE.
	ENDIF
  
C (* GROUND WATER OUTFLOW  *)
      MXTEMP = (X(2) + G(1)+G(3)+G(6)) - B(3)
      G(18) = AMAX1( MXTEMP, 0.0)
  
C (* LEAF NITROGEN EFFECT ON CO2 COND *)
      G(19) = 67.0 * Z(21)
  
C (* LIGHT EFFECT ON CO2 COND.  *)
      G(20) = (Z(19) - B(14)) / (Z(19) + B(15))
  
C (* TEMP. EFFECT ON CO2 COND. *)
      MXTEMP = B(23)* (B(18) - Z(14))* (Z(14)- B(17))/
     & ((B(18)- B(17))**2)
      G(21) = AMAX1( MXTEMP, 0.0)
  
C (* FINAL MESOPHYLL COND. *)
      G(22) = B(16) * G(19) * G(20) * G(21)
  
C (* GROSS PSN *)
C  (* rare CS bug, if the deominator is near 0.0)
      T16 = MAX(((G(15)/1.6) + G(22)), 0.000005)
      
C (* GROSS PSN REVISTED *)
      G(23) = ( (0.0006 - 0.00007) * (G(15)/1.6) * G(22))/t16

C (* DAILY GROSS PSN/CM**2 *)
      G(24) = G(23) * Z(18) * Z(10) * B(5)
	if (shutdwn) g(24) =0.0
      
C (* NIGHT RESPIRATION *)
      G(25) = B(19)*EXP(B(25)* Z(15))
     & * ((24.0- (Z(18)/3600)) ) * X(8)
      G(25) = AMAX1( G(25), 0.0)
      G(96) = G(96) + G(25)
  
C (* 24HR. NET C/HA, 0.3 is CO2/C conversion *)
      G(26) = (G(24) - G(25))*0.3
  
C (* MAINTENANCE RESPIRATION OF STEM & ROOT *)
      G(30) = B(20)*EXP(B(25)* Z(7)) * EXP(0.67*LOG(X(9)))
      G(31) = B(21)*EXP(B(25)* Z(7) ) * X(10)
      G(30) = AMAX1  (G(30), 0.0)
      G(31) = AMAX1  (G(31), 0.0)
      G(97) = G(97) + G(30)
      G(98) = G(98) + G(31)
  
C (* ACCUMULATE SEASONAL MAINTENANCE RESPIRATION IN G(100)
      G(100) = G(30) + G(31) + G(100)
 	write(99,*)z(2),x(2),g(10),x(6),g(24)
  
C (*  FLOWS: *)
  
C      (********   WATER   ***********)
  
c      F(2,2)=G(1) + G(6)
c      F(1,1)=G(2)
c      F(5,5)=G(4)
c      F(1,5)=g(8)
c      F(1,2)=G(3)
c      F(2,3)=G(18)
c      F(2,4)=G(17)
      x(1)=x(1)+g(2)-g(8)-g(3)
      x(2)=x(2)+g(1)+g(6)+g(3)-g(18)-g(17)
      x(3)=x(3)+g(18)
      x(4)=x(4)+g(17)
      x(5)=x(5)+g(8)+g(4)
	if (x(2) .LT. 0.0) then
	write(*,*) "error a negative soil value: ", PIDNUM,z(2)
	stop
	endif 
  
C      (********   CARBON   *********)
  
c      F(6,6) = G(26)
c      F(6,7) = F(6,7) + G(30) + G(31)
      x(6)=x(6)+g(26)-g(30)-g(31)
      x(7)=x(7)+g(30)+g(31)
  
      RETURN
      END
C(************************************)
