C********************************************************************************
C  MAKE.ET.F77 -- PROGRAM TO TAKE DISCRETIZED ET VALUES FOR THE VALLEYWIDE
C  MODEL AND ASSIGN THEM TO NODES.  ORIGINAL DATA DIGITIZED IN 250 METER
C  INCREMENTS BY LADWP (RAWSON)
C
C               BY   WES DANSKIN
C                    LAST REVISION 2/21/90
C
C*******************************************************************************
C  DESCRIPTION OF VARIABLES
C     TR1984(I,J) TRANSPIRATION VALUES FROM RAWSON/GROENEVEOLD WHICH INCLUDE 50%
C       OF THE PRECIPITATION FOR THAT 15-MINUTE QUAD.
C     ITR84(I,J) INTEGER VALUES OF TR1984
C     ETGW(I,J) JUST ET FROM THE SATURATED GROUND-WATER SYSTEM.  ESTIMATE OF THE
C       50% PRECIPIATION WAS REMOVED FROM THE T1984 VALUES.  THIS VALUE WOULD
C       COMPARE WITH THE ET VALUES FROM THE GROUND-WATER MODEL, EXCEPT IN THE
C       AREAS OF LAKES, PONDS, AND RESERVOIRS.
C     IETGW(I,J) ARE INTEGER VALUES OF ETGW
C*******************************************************************************
      DIMENSION ISIZE(180,40),ETGW(180,40),IBOUND(180,40),IETGW(180,40),
     - ETMAX1(180,40),ETMAX2(180,40),TR1984(180,40),ITR84(180,40),
     - XLSD(180,40),PRECIP(180,40,30),MOISBX(180,40),RECHET(180,40),
     - AVPREC(180,40)
      CHARACTER*80 BLANK,HEADNG
      COMMON /BIG1/ ISIZE,ETGW,IBOUND,IETGW,ETMAX1,ETMAX2,TR1984,ITR84
      COMMON /BIG2/ PRECIP,MOISBX,RECHET,AVPREC,XLSD
C  INITILIZE VARIABLES
C      NYEARS=26
C      NROW=180
C      NCOL=40
      CINCFS=1./12.*2000.*2000./365./86400.
      CCFSAC=1.*365.*86400./43560.
C  READ CONTROL PARAMETERS
      READ(29,913)HEADNG
      WRITE(8,913)HEADNG
      READ(29,913)HEADNG
      WRITE(8,913)HEADNG
      READ(29,914)NLAY,NROW,NCOL,NYEARS
      WRITE(8,914)NLAY,NROW,NCOL,NYEARS
C  ZERO VALUES
      ET1963=0.
      ET1984=0.
      ETMULT=0.
      SNEGET=0.
      SUMET=0.
      SUMT=0.
      SMAX1=0.
      SMAX2=0.
      SUMREC=0.
      SUMGW=0.
      GWUSE=0.
      TMULT=0.
C  ZERO ARRAYS
      DO 10 I=1,NROW
      DO 10 J=1,NCOL
      IBOUND(I,J)=0
      ISIZE(I,J)=0
      ETGW(I,J)=0.
      ETMAX1(I,J)=0.
      ETMAX2(I,J)=0.
      TR1984(I,J)=0.
      IETGW(I,J)=0
      ITR84(I,J)=0
      XLSD(I,J)=0.
      MOISBX(I,J)=0.
      RECHET(I,J)=0.
      AVPREC(I,J)=0.
      DO 10 K=1,NYEARS
      PRECIP(I,J,K)=0.
   10 CONTINUE
      CMFT=(250.*39.37/12.)*(250.*39.37/12.)
C  READ IN DEFAULT VALUE OF ET (INCHES/YR) FOR UNKNOWN AREAS AND
C  SCALE FACTOR FOR TO GET 1963 ET FROM 1984 ET
      READ(5,909) ET1963,ET1984
      READ(5,909) ETMULT
C  READ IN LAYER 1 IBOUND ARRAY
      DO 20 I=1,NROW
      READ(51,902) (IBOUND(I,J),J=1,NCOL)
   20 CONTINUE
C  READ IN LAND SURFACE DATUM
      DO 30 I=1,NROW
      READ(50,915) (XLSD(I,J),J=1,NCOL)
   30 CONTINUE
C  READ IN PRECIPITATION VALUES
      DO 40 K=1,NYEARS
      READ(52,903)BLANK
      DO 40 I=1,NROW
      READ(52,915) (PRECIP(I,J,K),J=1,NCOL)
   40 CONTINUE
C  READ IN LONGTERM AVERAGE PRECIPITATION
      READ(53,903)BLANK
      DO 50 I=1,NROW
      READ(53,915) (AVPREC(I,J),J=1,NCOL)
   50 CONTINUE
C  READ IN ET DATA
      READ(30,903)BLANK
      WRITE(8,903)BLANK
      WRITE(60,903)BLANK
      WRITE(61,903)BLANK
      WRITE(62,903)BLANK
      WRITE(63,903)BLANK
      WRITE(64,903)BLANK
      IFLAG=0.
  100 CONTINUE
C  READ ET VALUES IN FT/YR FOR EACH UTM POINT
      READ(30,900,END=110)XUTM,YUTM,XROW,XCOL,UTMET,IWUC
C      WRITE(8,905)XUTM,YUTM,XROW,XCOL,UTMET,IWUC
C  OUTSIDE MODEL AREA
      IF(XROW.GT.NROW) GOTO 100
      IF(XROW.LT.0.) GOTO 100
      IF(XCOL.GT.NCOL) GOTO 100
      IF(XCOL.LT.0.) GOTO 100
C  IWUC WATER USE CODES
C    IWUC = 0 IS NATIVE VEGETATION
C    IWUC = 1 IS IRRIGATED AGRICULTURE
C    IWUC = 2 IS URBAN
C    IWUC = 3 IS LAKES, PONDS, DRY LAKES
C    IWUC = 4 IS RIPARIAN VEGETATION
      IF(IWUC.EQ.0)UTMET=0.
C      IF(IWUC.EQ.1)UTMET=0.
C      IF(IWUC.EQ.2)UTMET=0.
C      IF(IWUC.EQ.3)UTMET=0.
      IF(IWUC.EQ.4)UTMET=0.
      IF(IWUC.EQ.0)WRITE(60,905)XUTM,YUTM,XROW,XCOL,UTMET,IWUC
      IF(IWUC.EQ.1)WRITE(61,905)XUTM,YUTM,XROW,XCOL,UTMET,IWUC
      IF(IWUC.EQ.2)WRITE(62,905)XUTM,YUTM,XROW,XCOL,UTMET,IWUC
      IF(IWUC.EQ.3)WRITE(63,905)XUTM,YUTM,XROW,XCOL,UTMET,IWUC
      IF(IWUC.EQ.4)WRITE(64,905)XUTM,YUTM,XROW,XCOL,UTMET,IWUC
      IROW=INT(XROW)+1
      ICOL=INT(XCOL)+1
C  CORRECTION FOR PRECIPITATION ADDED TO ET VALUES BY GROENEVELD
C  ASSUME 6 IN/YR OF PRECIPITATION IS AVERAGE (50% = 3 IN/YR).
C  PRECIPITATON IS NOW CALCULATED USING PRECIPITATION REGRESSION
C  FOR AVERAGE YEARS.
C
      UTMT=UTMET
C  OLD CALCULATION USING CONTSTANT 6 IN/YR OF PRECIPITATION
C      UTMET=UTMET-(3./12.)
C  CALCULATES TOTAL TRANSPIRATION FROM SATURATED GW SYSTEM.
C  ASSUMES SAME CONDITIONS AS RAWSON/GROENEVELD.  50% EVAPORATION
C  FROM PRECIPITATION.  THE OTHER 50% OF PRECIPITATION IS USED IN
C  TRANSPIRATION.  THUS UTMET-PRECIPITATION = TRANSPIRATION FROM
C  SATURATED GROUND-WATER SYSTEM.
C      UTMET=UTMET-1.0*AVPREC(IROW,ICOL)/12.
C  CALCULATES TOTAL RAWSON/GROENEVELD T, WITH THEIR ASSUMPTION THAT
C  50% OF PRECIPITATION EVAPORATES DIRECTLY.
C      UTMET=UTMET-0.5*AVPREC(IROW,ICOL)/12.
C  CALCULATES TOTAL RAWSON/GROENEVELD ET
      UTMET=UTMET-0.0*AVPREC(IROW,ICOL)/12.
C  ASSURE ET IS GREATER THAN ZERO FOR THE UTM POINT
      IF(UTMET.LE.0.)SNEGET=SNEGET+UTMET
      IF(UTMET.LE.0.)UTMET=0.
      ETGW(IROW,ICOL)=ETGW(IROW,ICOL)+UTMET
      TR1984(IROW,ICOL)=TR1984(IROW,ICOL)+UTMT
      ISIZE(IROW,ICOL)=ISIZE(IROW,ICOL)+1
      IOUT=70
      CALL SURF2A(UTMET,XUTM,YUTM,IROW,ICOL,IBOUND,IOUT)
      IF(IFLAG.LT.1)GOTO 100
  110 CONTINUE
C  CALCULATE CELL-BY-CELL VALUES OF ET, CONVERT TO IN/YR
      DO 200 I=1,NROW
      DO 200 J=1,NCOL
      IF(ISIZE(I,J).EQ.0) GOTO 190
      IF(IBOUND(I,J).EQ.0) GOTO 190
      ETGW(I,J)=ETGW(I,J)/ISIZE(I,J)*12.
      TR1984(I,J)=TR1984(I,J)/ISIZE(I,J)*12.
C  CREATE INTEGER TO MAP ET AND T, IN IN/YR
C  ADD 0.5 TO ACCOUNT FOR TRUNCATION TO INTEGER
      IETGW(I,J)=INT(ETGW(I,J)+0.5)
      ITR84(I,J)=INT(TR1984(I,J)+0.5)
C  CALCULATED TOTAL ET AND T FROM GROENEVELD/RAWSON
      SUMET=SUMET+(ETGW(I,J)/12.*2000.*2000./43560.)
      SUMT=SUMT+(TR1984(I,J)/12.*2000.*2000./43560.)
  190 CONTINUE
C  MODIFY VALUES FOR MAPS
      IF(IBOUND(I,J).EQ.0)ISIZE(I,J)=99
      IF(IBOUND(I,J).EQ.0)IETGW(I,J)=99
      IF(IBOUND(I,J).EQ.0)ETGW(I,J)=99
      IF(IBOUND(I,J).EQ.0)ITR84(I,J)=99
  200 CONTINUE
      IOUT=80
      CALL PSUM(ETGW,AVPREC,IBOUND,NROW,NCOL,IOUT)
C  CALCULATE MAX ET MATRICES FOR 1963 AND 1984
      DO 300 I=1,NROW
      DO 300 J=1,NCOL
C  ESTIMATE A ET MAXIMUM AT GROUND SURFACE, ASSUME 5 FEET TO WATER
C  AND A 15 FOOT EXTINCTION DEPTH (ETMAX1 = 1963, ETMAX2 = 1984)
      ETMAX2(I,J)=ETGW(I,J)*(15./10.)
C  ESTIMATE MAXIMUM ET VALUES PRIOR TO 1970
      ETMAX1(I,J)=ETMAX2(I,J)*ETMULT
C  CALCULATE TOTAL ET MAX, IN ACRE-FT/YR
      SMAX1=SMAX1+(ETMAX1(I,J)/12.*2000.*2000./43560.)
      SMAX2=SMAX2+(ETMAX2(I,J)/12.*2000.*2000./43560.)
C  INSERT DEFAULT VALUES FOR AREAS OF BASIN WITH NO DATA
      IF(ISIZE(I,J).LE.0)ETMAX1(I,J)=ET1963
      IF(ISIZE(I,J).LE.0)ETMAX2(I,J)=ET1984
  300 CONTINUE
C  WRITE OUT ET TOTALS ESTIMATED FROM GROENEVELD/RAWSON
      WRITE(80,906)SUMET,SNEGET,SMAX1,SMAX2
C  WRITE OUT ET, ET MAXIMUM , AND T MATRICES, IN/YR
      DO 350 I=1,NROW
      WRITE(31,901)(ETGW(I,J),J=1,NCOL)
      WRITE(32,901)(ETMAX1(I,J),J=1,NCOL)
      WRITE(33,901)(ETMAX2(I,J),J=1,NCOL)
      WRITE(34,901)(TR1984(I,J),J=1,NCOL)
  350 CONTINUE
C  WRITE OUT MATRIX SHOWING PRESENCE OF ET VALUES
      WRITE(40,907)
      DO 400 I=1,NROW
      WRITE(40,904)I,(ISIZE(I,J),J=1,NCOL)
  400 CONTINUE
C  WRITE OUT ET MAP AS INTEGER VALUES
      WRITE(40,908)
      WRITE(40,911)SUMET
      DO 500 I=1,NROW
      WRITE(40,904)I,(IETGW(I,J),J=1,NCOL)
  500 CONTINUE
C  WRITE OUT ET AS A SURFACE2 IDXY FILE
      IOUT=70
C      CALL ISURF2(IETGW,NROW,NCOL,IOUT)
C      CALL SURF2(ETGW,NROW,NCOL,IOUT)
C  WRITE OUT T MAP AS INTEGER VALUES
      WRITE(40,910)
      WRITE(40,912)SUMT
      DO 600 I=1,NROW
      WRITE(40,904)I,(ITR84(I,J),J=1,NCOL)
  600 CONTINUE
C  WRITE OUT T AS A SURFACE2 IDXY FILE
      IOUT=70
C      CALL ISURF2(ITR84,NROW,NCOL,IOUT)
C  CALCULATE THE NET INFILITRATION OR DISCHARGE FROM THE SATURATED GW
C  SYSTEM
C
C  READ IN PRECIPITATION CUTOFF
      READ(5,917)PCUTOF
C  READ IN INITIAL AND AVERAGE SIZE OF SOIL MOISTURE BOX, AND MULTIPLIER
C  TO INCREASE TRANSPIRATION HIGHER THAN T1984, PRIOR TO 1977.
      READ(5,917)BXINIT
      READ(5,917)BXSIZE
      READ(5,917)TMULT
C  INITIALIZE SOIL MOISTURE BOX
      DO 650 I=1,NROW
      DO 650 J=1,NCOL
      MOISBX(I,J)=BXINIT*TR1984(I,J)
  650 CONTINUE
C  CALCULATE RECHARGE/ET FOR ALL YEARS
      DO 800 K=1,NYEARS
      IYEAR=1962+K
      IF(IYEAR.GE.1977)TMULT=1.0
      SUMREC=0.
      SUMGW=0.
      SUMNGW=0.
      SUMEXT=0.
      GWUSE=0.
      DO 700 I=1,NROW
      DO 700 J=1,NCOL
C  INITIALIZE RECHARGE/ET ARRAY
      RECHET(I,J)=0.
C  CALCULATE NET RECHARGE IN AREAS OF HIGH PRECIPITATION
C  ESTIMATED TO BE 5 PERCENT OF THE PRECIP OVER 8 INCHES A YEAR.
C  PRECIPITATION RECHARGE IS POSITIVE.
      IF(AVPREC(I,J).GE.PCUTOF) THEN
        RECHET(I,J)=0.05*AVPREC(I,J)
        SUMREC=SUMREC+(RECHET(I,J)*CINCFS*CCFSAC)
        GOTO 690
      ENDIF
C  IF NO T VALUES HAVE BEEN ESTIMATED THEN SKIP
      IF(TR1984(I,J).LE.0) THEN
        GOTO 690
      ENDIF
C  ADD 1/2 OF PRECIPITATION TO SOIL MOISTURE BOX USING 0.5
C  ESTIMATE OF DIRECT EVAPORATION FROM LOWELL'S WORK
      MOISBX(I,J)=MOISBX(I,J)+0.5*PRECIP(I,J,K)
C  CALCULATE TEST VARIABLES
      FULL=BXSIZE*TR1984(I,J)*TMULT
      TRANS=TR1984(I,J)*TMULT
C  IF SUFFICIENT WATER IS AVAILABLE, THEN THE AVERAGE TRANSPIRATION
C  IS USED.  IF THE BOX IS TOO FULL, THEN THE BOX IS REINITIALIZED AND
C  THE REST IS ASSUMED TO BE USED BY THE PLANT OR EVAPORATION
      IF(MOISBX(I,J).GE.TRANS)THEN
        GWUSE=0.
        SUMGW=SUMGW+(GWUSE*CINCFS*CCFSAC)
        SUMNGW=SUMNGW+TRANS*CINCFS*CCFSAC
        RECHET(I,J)=RECHET(I,J)+GWUSE
        MOISBX(I,J)=MOISBX(I,J)-TRANS
        IF(MOISBX(I,J).GT.FULL) THEN
          EXTRA=MOISBX(I,J)-FULL
          SUMEXT=SUMEXT+EXTRA*CINCFS*CCFSAC
          MOISBX(I,J)=FULL
        ENDIF
        GOTO 690
      ENDIF
C  IF BOX WATER IS INSUFFICIENT, THEN GW MUST BE USED
C  BOX IS LEFT EMPTY.
      IF(MOISBX(I,J).LT.TRANS)THEN
        GWUSE=MOISBX(I,J)-TRANS
        SUMGW=SUMGW+(GWUSE*CINCFS*CCFSAC)
        SUMNGW=SUMNGW+MOISBX(I,J)*CINCFS*CCFSAC
        RECHET(I,J)=RECHET(I,J)+GWUSE
        MOISBX(I,J)=0.
        GOTO 690
      ENDIF
  690 CONTINUE
C      WRITE(90,920)SUMGW
  700 CONTINUE
C  WRITE OUT TOTAL RECHARGE AND GW USE
      WRITE(80,916)IYEAR,SUMREC,SUMGW,SUMNGW,SUMEXT
C  WRITE ARRAY FOR MODEL TO READ IN
C  ARRAY INCLUDES BOTH RECHARGE FROM PRECIPITATION AND
C  DISCHARGE FROM ET
      DO 750 I=1,NROW
      WRITE(54,901)(RECHET(I,J),J=1,NCOL)
  750 CONTINUE
  800 CONTINUE
C  FORMAT STATEMENTS
  900 FORMAT(2F10.0,2F10.4,F10.4,I5)
  901 FORMAT(8F10.4)
  902 FORMAT(40I3)
  903 FORMAT(A80)
  904 FORMAT(I3,2X,40I3)
  905 FORMAT(2F10.0,2F10.4,F10.4,I5)
  906 FORMAT('TOTAL GW ET EST. FROM RAWSON IN ACRE-FT/YR = ',F10.0,/,
     -       'TOTAL UNDERESTIMATE OF PRECIP ET = ',F10.0,/,
     -       'TOTAL ET MAX FOR 1963 = ',F10.0,/,
     -       'TOTAL ET MAX FOR 1984 = ',F10.0)
  907 FORMAT('NUMBER OF UTM VALUES PER MODEL CELL')
  908 FORMAT('GW ET IN INCHES -- NEG VALUES SET TO ZERO')
  909 FORMAT(2F10.0)
  910 FORMAT('TOTAL TRANSPIRATION IN INCHES--INCLUDES 1/2 PRECIP')
  911 FORMAT('TOTAL ET ESTIMATE FROM RAWSON',F10.0)
  912 FORMAT('TOTAL T FROM RAWSON',F10.0)
  913 FORMAT(A80)
  914 FORMAT(4I10)
  915 FORMAT(8F10.0)
  916 FORMAT('FOR WATER YEAR = ',I4,/,
     - T5,'TOTAL RECHARGE FROM PRECIPITATION, IN AC-FT = ',F10.0,/,
     - T5,'TOTAL GW DAVID TRANSPIRATION USE, IN AC-FT = ',F10.0,/,
     - T5,'TOTAL NON-GW DAVID TRANSPIRATION USE, IN AC-FT = ',F10.0,/,
     - T5,'TOTAL EXTRA WATER GOTTEN RID OF IN AC-FT = ',F10.0)
  917 FORMAT(F10.0)
  920 FORMAT('GWUSE = ',F10.0)
      STOP
      END
C*****************************************************************************
      SUBROUTINE ISURF2(IVALUE,NROW,NCOL,IOUT)
C*****************************************************************************
      DIMENSION IVALUE(180,40)
C  DEFINE SYBMOL CODES
      N1=-1
      I1=1
      I2=2
      I3=3
      I4=4
      I5=5
      I6=6
C  WRITE OUT SURFACE2 IDXY FILE
      WRITE(IOUT,901)
      DO 100 I=1,NROW
      DO 100 J=1,NCOL
      IF(IVALUE(I,J).LE.0.)
     -  WRITE(IOUT,902)
      IF(IVALUE(I,J).GT.0.AND.IVALUE(I,J).LT.6)
     -  WRITE(IOUT,900)IVALUE(I,J),I1,I1
      IF(IVALUE(I,J).GE.6.AND.IVALUE(I,J).LT.12)
     -  WRITE(IOUT,900)IVALUE(I,J),I1,I3
      IF(IVALUE(I,J).GE.12.AND.IVALUE(I,J).LT.18)
     -  WRITE(IOUT,900)IVALUE(I,J),I1,I4
      IF(IVALUE(I,J).GE.18.AND.IVALUE(I,J).LT.24)
     -  WRITE(IOUT,900)IVALUE(I,J),I1,I5
      IF(IVALUE(I,J).GE.24.AND.IVALUE(I,J).LT.99)
     -  WRITE(IOUT,900)IVALUE(I,J),I1,I2
      IF(IVALUE(I,J).EQ.99)
     -  WRITE(IOUT,903)
      IF(IVALUE(I,J).GT.99)
     -  WRITE(IOUT,904)
  100 CONTINUE
  900 FORMAT(I10,2I10)
  901 FORMAT('*** SURFACE 2 IDXY LIST OF INTEGER VALUES ***')
  902 FORMAT('ERROR--ZERO VALUE')
  903 FORMAT('ERROR--INACTIVE NODE')
  904 FORMAT('ERROR--VALUE OUTSIDE RANGE')
      RETURN
      END
C*****************************************************************************
      SUBROUTINE SURF2(VALUE,NROW,NCOL,IOUT)
C*****************************************************************************
      DIMENSION VALUE(180,40)
C  DEFINE SYBMOL CODES
      N1=-1
      I1=1
      I2=2
      I3=3
      I4=4
      I5=5
      I6=6
C  WRITE OUT SURFACE2 IDXY FILE
      WRITE(IOUT,901)
      DO 100 I=1,NROW
      DO 100 J=1,NCOL
      IF(VALUE(I,J).LE.0.)
     -  WRITE(IOUT,902)
      IF(VALUE(I,J).GT.0.AND.VALUE(I,J).LT.6)
     -  WRITE(IOUT,900)VALUE(I,J),I1,I1
      IF(VALUE(I,J).GE.6.AND.VALUE(I,J).LT.12)
     -  WRITE(IOUT,900)VALUE(I,J),I1,I2
      IF(VALUE(I,J).GE.12.AND.VALUE(I,J).LT.18)
     -  WRITE(IOUT,900)VALUE(I,J),I1,I3
      IF(VALUE(I,J).GE.18.AND.VALUE(I,J).LT.24)
     -  WRITE(IOUT,900)VALUE(I,J),I1,I4
      IF(VALUE(I,J).GE.24.AND.VALUE(I,J).LT.99)
     -  WRITE(IOUT,900)VALUE(I,J),I1,I5
      IF(VALUE(I,J).EQ.99)
     -  WRITE(IOUT,903)
      IF(VALUE(I,J).GT.99.)
     -  WRITE(IOUT,904)
  100 CONTINUE
  900 FORMAT(F10.2,2I10)
  901 FORMAT('*** SURFACE 2 IDXY LIST OF FLOATING POINT VALUES ***')
  902 FORMAT('ERROR--ZERO VALUE')
  903 FORMAT('ERROR--INACTIVE NODE')
  904 FORMAT('ERROR--VALUE OUTSIDE RANGE')
      RETURN
      END
C*****************************************************************************
      SUBROUTINE SURF2A(VALUE,X,Y,IR,IC,IBND,IOUT)
C*****************************************************************************
      DIMENSION IBND(180,40)
C  DEFINE SYBMOL CODES
      N1=-1
      I1=1
      I2=2
      I3=3
      I4=4
      I5=5
      I6=6
C SUM VALUES
      IF(IBND(IR,IC).GT.0)THEN
      SUM=SUM+VALUE*250.*250.*3.2808*3.2808/43560.
      ENDIF
C  WRITE OUT SURFACE2 IDXY FILE
      VALUE=VALUE*12.
      IF(VALUE.LE.0.)
     -  WRITE(IOUT,902)
      IF(VALUE.GT.0.AND.VALUE.LT.6)
     -  WRITE(IOUT,900)X,Y,VALUE,I1,I1,SUM
      IF(VALUE.GE.6.AND.VALUE.LT.12)
     -  WRITE(IOUT,900)X,Y,VALUE,I1,I2,SUM
      IF(VALUE.GE.12.AND.VALUE.LT.18)
     -  WRITE(IOUT,900)X,Y,VALUE,I1,I3,SUM
      IF(VALUE.GE.18.AND.VALUE.LT.24)
     -  WRITE(IOUT,900)X,Y,VALUE,I1,I4,SUM
      IF(VALUE.GE.24.AND.VALUE.LT.99)
     -  WRITE(IOUT,900)X,Y,VALUE,I1,I5,SUM
      IF(VALUE.GE.99.)
     -  WRITE(IOUT,904)
      VALUE=VALUE/12.
  900 FORMAT(2F10.0,F10.2,2I10,F10.0)
  902 FORMAT('ERROR--ZERO VALUE')
  904 FORMAT('ERROR--VALUE OUTSIDE RANGE')
      RETURN
      END
C*****************************************************************************
      SUBROUTINE PSUM(VALUE1,VALUE2,IBND,NROW,NCOL,IOUT)
C*****************************************************************************
      DIMENSION VALUE1(180,40),VALUE2(180,40),IBND(180,40)
C  IF ETGW IS GREATER THAN ZERO, SUM AVERAGE PRECIPITATION FOR THAT NODE
      SUM1=0.
      SUM2=0.
      DO 100 I=1,NROW
      DO 100 J=1,NCOL
      IF(IBND(I,J).EQ.0)GOTO 90
      IF(VALUE1(I,J).EQ.0)GOTO 90
        IF(VALUE1(I,J).LT.0.)WRITE(90,901)I,J,VALUE1(I,J)
        SUM1=SUM1+(VALUE1(I,J)/12.*2000.*2000./43560.)
        SUM2=SUM2+(VALUE2(I,J)/12.*2000.*2000./43560.)
   90 CONTINUE
  100 CONTINUE
      WRITE(IOUT,900)SUM1,SUM2
C  CHECK FOR VALUES OUTSIDE AREA
      DO 200 I=1,NROW
      DO 200 J=1,NCOL
      IF(IBND(I,J).EQ.0)THEN
       IF(VALUE1(I,J).NE.0)THEN
        IF(VALUE1(I,J).NE.99)THEN
         WRITE(90,902)I,J,VALUE1(I,J)
        ENDIF
       ENDIF
      ENDIF
  200 CONTINUE
C  FORMAT STATEMENTS
  900 FORMAT('TOTAL ETGW, WHERE ETGW IS > 0, EQUALS ',F10.2,/,
     -'TOTAL PRECIPITATION, WHERE ETGW IS > 0, EQUALS ',F10.2)
  901 FORMAT('ERROR IN PSUM, NEGATIVE VALUE',2I5,F10.2)
  902 FORMAT('ERROR IN PSUM, OUT OF MODEL AREA',2I5,F10.2)
      RETURN
      END
