C*******************************************************************************
C  PRE.PRECIPET.F77 -- A PROGRAM TO CREATE NEW RECHARGE FILES
C  USING PRECIPITATION AND EVAPOTRANSPIRATION
C               BY   WES DANSKIN
C                    LAST REVISION 3/1/89
C
C  CURRENT VERSION OF THE MODEL IS NOT USED MUCH, EXCEPT TO CALCULATE
C  INFILTRATION RATES FOR PRECIPITATION--PRECIPITATION RECHARGE IS 5 PERCENT
C  OF LONGTERM AVERAGE PRECIPITATION OVER 8 IN/YR.
C
C  OLDER VERSION OF PROGRAM (NOW COMMENTED OUT) ASSIGNS FIXED ANNUAL VALUES OF
C  ET AND PRECIPITATION RECHARGE BASED ON THE PARTICULAR HYDROGEOLOGIC AREA
C  (DEFINED BY THE FILE=MODEL.ZONE.PARAMETERS).  IN THE OLDER VERSION--
C  AREAS IN THE CENTER OF THE VALLEY USE ONLY THE ET FROM THE ET FUNCTION
C  OF THE MODEL.  ALSO CALCULATED IS A CONSTANT SMALL INFILTRATION RATE
C  FOR UPLAND AREAS BASED ON THE ASSUMPTION ESSENTIALLY ALL PRECIPITATION
C  IS USED UP AS EVAPOTRANSPIRATION.  THIS IS NO LONGER A PART OF THE MODEL.ZONE.
C  PARAMETERS FILE.
C*******************************************************************************
C  FILES
C     5  PRE.PRECIPET.IN -- INPUT VALUES OF PRECIP, ET, AND NET INFILTRATION
C     6  PRE.PRECIPET.CHECK
C    51  MODEL.IBOUND.LAYER1
C    59  MODEL.RECH.RATES -- CONSTANT RECHARGE RATES
C    61  MODEL.ET.MAX -- MAXIMUM ET RATE
C    67  PRECIP.ARRAY.1963-84WY-- PRECIPITATION VALUES PER NODE
C    94  PRE.PRECIPET.TOTALS
C    95  PRE.ERRORS
C*******************************************************************************
      DIMENSION IBOUND(180,40),PREC(180,40),ETMAX(180,40),
     - RECH(180,40),AETMAX(60),ANET(60),AVPREC(180,40)
      CHARACTER*80 BLANK
      CHARACTER*30 ANAME(60)
      COMMON /BIGX/ PREC,ETMAX,RECH,AETMAX,ANET,AVPREC
      COMMON /BIGI/ IBOUND
C  INITILIZE VARIABLES
C      NROW=180
C      NCOL=40
C      NLAY=2
      NAREAS=60
      IONE=1
      ITWO=2
      FT2=2000.*2000./12.
      TIME=1./365./86400.
C  READ CONTROL PARAMETERS
      IOUT=6
      READ(30,903)HEADNG
      WRITE(IOUT,903)HEADNG
      READ(30,903)HEADNG
      WRITE(IOUT,903)HEADNG
      READ(30,904)NLAY,NROW,NCOL,NYEARS
      WRITE(IOUT,904)NLAY,NROW,NCOL,NYEARS
C  ZERO CONSTANTS AND ARRAYS
      NUMOUT=0
      NUMNET=0
      NUMET=0
      SUMNET=0.
      SUMET=0.
      DO 20,I=1,NROW
      DO 20, J=1,NCOL
      IBOUND(I,J)=0.
   20 CONTINUE
      CALL ZERO2D(ETMAX,NROW,NCOL)
      CALL ZERO2D(PREC,NROW,NCOL)
      CALL ZERO2D(AVPREC,NROW,NCOL)
      CALL ZERO2D(RECH,NROW,NCOL)
      DO 22 K=1,NAREAS
      AETMAX(K)=0.
      ANET(K)=0.
   22 CONTINUE
C  READ IN IBOUND ARRAY FOR LAYER 1
      DO 30 I=1,NROW
      READ(51,911) (IBOUND(I,J),J=1,NCOL)
   30 CONTINUE
C  READ IN LONG-TERM AVERAGE PRECIPITATION ARRAY
      IN=66
      IOUT=6
      SCALE=1.0
      READ(IN,900)IYEAR
      WRITE(IOUT,923)IYEAR
      CALL READ2D(AVPREC,NROW,NCOL,IN,SCALE)
      CALL WRIT2D(AVPREC,NROW,NCOL,IOUT)
C  READ MAXIMUM ET AND NET INFILTRATION VALUES TO APPLY TO EACH AREA
C  WITH SIMILAR HYDROGEOLOGIC CHARACTERISTICS.
C  IBOUND VALUES FROM MODEL ARE USED TO ASSIGN NODAL VALUES OF
C  PRECIPITATION AND EVAPOTRANSPIRATION
      READ(5,912)BLANK
      WRITE(6,912)BLANK
      DO 40 I=1,NAREAS
      READ(5,909) ANAME(I),AETMAX(I),ANET(I)
      WRITE(6,909) ANAME(I),AETMAX(I),ANET(I)
   40 CONTINUE
C  DO-LOOP FOR YEARS OF SIMULATION
      DO 800 KYEAR=1,NYEARS
C  RE-ZERO ARRAYS AND VARIABLES
      NUMOUT=0
      NUMNET=0
      NUMET=0
      SUMNET=0.
      SUMET=0.
      AVET=0.
      AVNET=0.
      TETREC=0.
      CALL ZERO2D(ETMAX,NROW,NCOL)
      CALL ZERO2D(PREC,NROW,NCOL)
      CALL ZERO2D(RECH,NROW,NCOL)
C  READ INDIVIDUAL NODAL PRECIPITATION RATES
      IN=67
      IOUT=6
      SCALE=1.0
      READ(IN,900)IYEAR
      WRITE(IOUT,923)IYEAR
C  CHECK THAT DATASET FOR CORRECT YEAR IS READ
      ITEST=1962+KYEAR
      IF(IYEAR.NE.ITEST) WRITE(95,913)IYEAR,KYEAR
      CALL READ2D(PREC,NROW,NCOL,IN,SCALE)
      CALL WRIT2D(PREC,NROW,NCOL,IOUT)
C  CALCULATE RECHARGE RATE FROM ESTIMATED PRECIPITATION AND NET
C  INFILTRATION ASSUMPTION
      DO 200 I=1,NROW
      DO 200 J=1,NCOL
      M=IABS(IBOUND(I,J))
C  WRITE ERROR IF M IS NOT DEFINED
      IF(M.GT.NAREAS) WRITE(95,920)M,I,J
C  OUTSIDE MODEL AREA
      IF(M.EQ.0) GOTO 190
C  USE NET INFILTRATION -- GOTO LINE 110
C  USE ET FUNCTION -- GOTO LINE 120
C  USE BOTH NET AND ET FUNCTION -- GOTO LINE 130
      IF(M.EQ.1)  GOTO 130
      IF(M.EQ.2)  GOTO 130
      IF(M.EQ.3)  GOTO 130
      IF(M.EQ.4)  GOTO 130
      IF(M.EQ.5)  GOTO 130
      IF(M.EQ.6)  GOTO 130
      IF(M.EQ.7)  GOTO 130
      IF(M.EQ.8)  GOTO 130
      IF(M.EQ.9)  GOTO 130
      IF(M.EQ.10) GOTO 130
      IF(M.EQ.11) GOTO 130
      IF(M.EQ.12) GOTO 130
      IF(M.EQ.13) GOTO 130
      IF(M.EQ.14) GOTO 130
      IF(M.EQ.15) GOTO 130
      IF(M.EQ.16) GOTO 130
      IF(M.EQ.17) GOTO 130
      IF(M.EQ.18) GOTO 130
      IF(M.EQ.19) GOTO 130
      IF(M.EQ.20) GOTO 130
      IF(M.EQ.21) GOTO 130
      IF(M.EQ.22) GOTO 130
      IF(M.EQ.23) GOTO 130
      IF(M.EQ.24) GOTO 130
      IF(M.EQ.25) GOTO 130
      IF(M.EQ.26) GOTO 130
      IF(M.EQ.27) GOTO 130
      IF(M.EQ.28) GOTO 130
      IF(M.EQ.29) GOTO 130
      IF(M.EQ.30) GOTO 130
      IF(M.EQ.31) GOTO 130
      IF(M.EQ.32) GOTO 130
      IF(M.EQ.33) GOTO 130
      IF(M.EQ.34) GOTO 130
      IF(M.EQ.35) GOTO 130
      IF(M.EQ.36) GOTO 130
      IF(M.EQ.37) GOTO 130
      IF(M.EQ.38) GOTO 130
      IF(M.EQ.39) GOTO 130
      IF(M.EQ.40) GOTO 130
      IF(M.EQ.41) GOTO 130
      IF(M.EQ.42) GOTO 130
      IF(M.EQ.43) GOTO 130
      IF(M.EQ.44) GOTO 130
      IF(M.EQ.45) GOTO 130
      IF(M.EQ.46) GOTO 130
      IF(M.EQ.47) GOTO 130
      IF(M.EQ.48) GOTO 130
      IF(M.EQ.49) GOTO 130
      IF(M.EQ.50) GOTO 130
      IF(M.EQ.51) GOTO 130
      IF(M.EQ.52) GOTO 130
      IF(M.EQ.53) GOTO 130
      IF(M.EQ.54) GOTO 130
      IF(M.EQ.55) GOTO 130
      IF(M.EQ.56) GOTO 130
      IF(M.EQ.57) GOTO 130
      IF(M.EQ.58) GOTO 130
      IF(M.EQ.59) GOTO 130
      IF(M.EQ.60) GOTO 130
C  WRITE ERROR -- M IS NOT DEFINED
      WRITE(95,920)M,I,J
C  AREA WITH NET INFILTRATION
  110 RECH(I,J)=ANET(M)
      ETMAX(I,J)=0.
      NUMNET=NUMNET+1
      SUMNET=SUMNET+ANET(M)
      GOTO 200
C  AREA WITH ET FUNCTION
  120 RECH(I,J)=PREC(I,J)
      TETREC=TETREC+PREC(I,J)
      ETMAX(I,J)=AETMAX(M)
      NUMET=NUMET+1
      SUMET=SUMET+AETMAX(M)
      GOTO 200
C  AREA WITH POTENTIALLY BOTH NET AND ET FUNCTION
  130 CONTINUE
      ETCUT=8.0
      RECH(I,J)=0.
C  PRECIPITATION RECHARGE IS DETERMINED BY VALUE IN MODEL.ZONE.PARAMETERS TABLE
C  AND IS BASED ON AVERAGE VALUES
C      IF(AVPREC(I,J).GT.ETCUT) RECH(I,J)=ANET(M)
C  PRECIPITATION RECHARGE IS DETERMINED BY VALUE IN MODEL.ZONE.PARAMETERS TABLE
C  AND IS BASED ON ANNUAL VALUES
C      IF(PREC(I,J).GT.ETCUT) RECH(I,J)=ANET(M)
C  PRECIPITATION RECHARGE IS 5 PERCENT OF AVERAGE PRECIPETATION OVER 8 IN/YR
      IF(AVPREC(I,J).GT.ETCUT) RECH(I,J)=0.05*AVPREC(I,J)
      TETREC=TETREC+RECH(I,J)
C  ET MAXIMUM IS SET BASED ON MODEL.ZONE.PARAMETERS TABLE
      ETMAX(I,J)=AETMAX(M)
      NUMET=NUMET+1
      SUMET=SUMET+AETMAX(M)
      GOTO 200
C  AREA OUTSIDE THE MODEL BOUNDARIES
  190 RECH(I,J)=0.
      ETMAX(I,J)=0.
      NUMOUT=NUMOUT+1
      GOTO 200
  200 CONTINUE
C  WRITE OUT FILE FOR FIXED NET INFILTRATION RATE FOR EACH YEAR
      IOUT=59
      CALL WRIT2D(RECH,NROW,NCOL,IOUT)
C  WRITE OUT NEW MAX ET RATE FILE
      IOUT=61
      IF(KYEAR.EQ.1) CALL WRIT2D(ETMAX,NROW,NCOL,IOUT)
C  CALCULATE SUMMARY OF FLUXES
      IF(NUMET.GT.0)AVET=SUMET/NUMET
      SUMET=SUMET*FT2*TIME
      TETREC=TETREC*FT2*TIME
      IF(NUMNET.GT.0)AVNET=SUMNET/NUMNET
      SUMNET=SUMNET*FT2*TIME
C  WRITE OUT SUMMARY OF FLUXES
      WRITE(94,901)IYEAR
      WRITE(94,902)AVET,NUMET,TETREC,SUMET,AVNET,NUMNET,SUMNET
C  END OF MAJOR DO-LOOP
  800 CONTINUE
C  FORMAT STATEMENTS
  900 FORMAT(I10)
  901 FORMAT(I10,' = WATER YEAR')
  902 FORMAT('AVERAGE MAX ET  IN/YR   = ',F10.3,/,
     -       'TOTAL NUMBER OF ET NODES = ',I10,/,
     -       'TOTAL PRECIPITATION RECHARGE IN CFS',F10.3,/,
     -       'TOTAL MAX ET FROM ET NODES IN CFS     = ',F10.3,/,
     -       'AVERAGE NET INFILTRATION  IN/YR  = ',F10.3,/,
     -       'TOTAL NUMBER OF NET NODES = ',I10,/,
     -       'TOTAL NET INFILTRATION  CFS    = ',F10.3)
  903 FORMAT(A80)
  904 FORMAT(4I10)
  909 FORMAT(A30,50X,2F10.0)
  911 FORMAT(40I3)
  912 FORMAT(A80)
  913 FORMAT('ERROR -- INCORRECT YEAR IS READ IN ',2I10)
  920 FORMAT('ERROR -- HYDROGEOLOGIC AREA IS NOT DEFINED, M = ',I5,
     -' ROW = ',I5,'COLUMN= ',I5)
  923 FORMAT(I10,' = WATER YEAR')
      STOP
      END
C*****************************************************************************
      SUBROUTINE ZERO2D(BUF,NROW,NCOL)
C*****************************************************************************
      DIMENSION BUF(180,40)
C      COMMON /ZERO2/ BUF
C--ZERO 2-DIMENSIONAL BUFFER
      DO 100 I=1,NROW
      DO 100 J=1,NCOL
        BUF(I,J)=0.
  100 CONTINUE
      RETURN
      END
C*****************************************************************************
      SUBROUTINE READ2D(BUF,NROW,NCOL,IN,SCALE)
C*****************************************************************************
      DIMENSION BUF(180,40)
C      COMMON /READ2/ BUF
C--READ 2-DIMENISONAL ARRAY
      DO 100 I=1,NROW
      READ(IN,900) (BUF(I,J),J=1,NCOL)
  100 CONTINUE
      DO 200 I=1,NROW
      DO 200 J=1,NCOL
      BUF(I,J)=BUF(I,J)*SCALE
  200 CONTINUE
  900 FORMAT(8F10.0)
      RETURN
      END
C*****************************************************************************
      SUBROUTINE WRIT2D(BUF,NROW,NCOL,IOUT)
C*****************************************************************************
      DIMENSION BUF(180,40)
C      COMMON /WRIT2/ BUF
C--WRITE 2-DIMENISONAL ARRAY
      DO 100 I=1,NROW
      WRITE(IOUT,900) (BUF(I,J),J=1,NCOL)
  100 CONTINUE
  900 FORMAT(8F10.3)
      RETURN
      END
