C*******************************************************************************
C  MAKE.AG.RECHARGE.UTM.F77 -- A PROGRAM TO CREATE ARRAYS OF RECHARGE FROM
C  AGRICULTURAL IRRIGATION OR STOCK WATERING AREAS OF OWENS VALLEY.  THIS DOES
C  NOT INCLUDE RECHARGE FROM LARGER NAMED CANALS OR STREAMS IN THESE AREAS.
C  INPUT IS ANNUAL ESTIMATES FOR EACH UTM INTERSECTION POINT
C
C               BY   WES DANSKIN
C                    LAST REVISION 1/20/89
C
C*******************************************************************************
C  DIMENSIONS REQUIRED
C    FLUX(NROW,NCOL),
C    NUMBER OF ROWS = 180
C    NUMBER OF COLUMNS = 40
C    NUMBER OF YEARS = 30
C    NUMBER OF TYPES OF PERCOLATION AREAS = 5 (option not yet used)
C******************************************************************************
      DIMENSION FLUX(180,40),IBOUND(180,40),RECH(30,5)
      CHARACTER*80 COMMNT,BLANK,HEADNG
      COMMON /BIGONE/ FLUX,IBOUND,RECH
C  DEFINE SIZE OF GRID LOOPS
C      NROW=180
C      NCOL=40
C      NYEARS=26
      NPERC=3
C  READ CONTROL PARAMETERS
      READ(29,908)HEADNG
      WRITE(6,908)HEADNG
      READ(29,908)HEADNG
      WRITE(6,908)HEADNG
      READ(29,909)NLAY,NROW,NCOL,NYEARS
      WRITE(6,909)NLAY,NROW,NCOL,NYEARS
C  ZERO VARIABLES AND MATRIXES
      CALL ZERO2D(FLUX,NROW,NCOL)
      DO 10 I=1,NROW
      DO 10 J=1,NCOL
        IBOUND(I,J)=0
   10 CONTINUE
      DO 20 I=1,NYEARS
      DO 20 J=1,NPERC
      RECH(I,J)=0.
   20 CONTINUE
C  DEFINE CONSTANTS
      CONMFT=250.*39.37/12.*250.*39.37/12./365./86400.
C  READ IN IBOUND ARRAY FOR LAYER 1
      DO 50 I=1,NROW
        READ(51,981)(IBOUND(I,J),J=1,NCOL)
   50 CONTINUE
C  CALCULATE FOR EACH WATER YEAR
      DO 300 K=1,NYEARS
      REWIND(8)
      IFLAG=1
      IYEAR=1962+K
      TOTREC=0.
      READ(8,904)BLANK
C  ZERO ARRAY AND ANNUAL AMOUNTS
      CALL ZERO2D(FLUX,NROW,NCOL)
C  READ IN RECHARGE FACTORS FOR EACH WATER YEAR
      REWIND(9)
      READ(9,904)BLANK
      READ(9,904)BLANK
      DO 160 I=1,NYEARS
      READ(9,907)(RECH(I,J),J=1,NPERC)
      WRITE(6,907)(RECH(I,J),J=1,NPERC)
  160 CONTINUE
  200 CONTINUE
C  READ FILE OF IRRIGATED ET DATA IN MODEL COORDINATES (FROM UTM COORDINATES).
C  NOTE:  OPTION WAS PROGRAMMED SO THAT IPERC COULD BE SET TO SPECIFIC INTEGER
C  VALUES IN THIS UTM FILE IN ORDER TO ACCOUNT FOR PERMEABILITY OF UNDERLYING
C  MATERIALS, SUCH AS IMPERMEABLE CONCRETE OR HIGHLY PERMEABLE VOLCANIC MATERIALS.
C  THIS IPERC OPTION IS NOT UTILIZED YET, ONLY IPERC=2.
      READ(8,906,END=210)XROW,YCOL,IWUC
      IPERC=2
C  WRITE(6,906)XROW,YCOL,IWUC,IPERC
C  IF ET DATA POINT IS NOT IRRIGATED ACREAGE (IWUC=1) THEN SKIP
      IF(IWUC.NE.1) GOTO 200
      IROW=INT(XROW)+1
      ICOL=INT(YCOL)+1
      IF(IBOUND(IROW,ICOL).EQ.0) GOTO 200
      AGRECH=RECH(K,IPERC)/12.*CONMFT
C      WRITE(6,901)AGRECH
      FLUX(IROW,ICOL)=FLUX(IROW,ICOL)+AGRECH
      TOTREC=TOTREC+AGRECH
      IF(IFLAG.EQ.1) GOTO 200
  210 CONTINUE
C  USE QUICK MULTIPLIER TO INCREASE PERCOLATION RATE NEAR VOLCANICS
      READ(9,902)N
      WRITE(6,902)N
      READ(9,905)XMULT
      WRITE(6,905)XMULT
      DO 250 I=1,N
      READ(9,903)IROW,ICOL
      WRITE(6,903)IROW,ICOL
      TOTREC=TOTREC + (XMULT-1.0)*FLUX(IROW,ICOL)
      FLUX(IROW,ICOL)=FLUX(IROW,ICOL)*XMULT
  250 CONTINUE
C  USE QUICK INDICATOR METHOD TO ZERO LOCATIONS OF NO POSSIBLE RECHARGE
C  OR REDUNDANT RECHARGE
      READ(9,902)NOUT
      WRITE(6,902)NOUT
      DO 400 I=1,NOUT
      READ(9,903)IROW,ICOL
      WRITE(6,903)IROW,ICOL
      TOTREC=TOTREC-FLUX(IROW,ICOL)
      FLUX(IROW,ICOL)=0.
  400 CONTINUE
C  WRITE TOTALS TO A FILE
      WRITE(30,912)IYEAR,TOTREC
      WRITE(90,912)IYEAR,TOTREC
      IF(K.EQ.1)WRITE(31,912)IYEAR,TOTREC
      IF(K.EQ.22)WRITE(32,912)IYEAR,TOTREC
C  WRITE RECHARGE TO A FILE
      DO 500 I=1,NROW
      WRITE(30,990) (FLUX(I,J),J=1,NCOL)
      IF(K.EQ.1)WRITE(31,990) (FLUX(I,J),J=1,NCOL)
      IF(K.EQ.22)WRITE(32,990) (FLUX(I,J),J=1,NCOL)
      DO 500 J=1,NCOL
      IF(FLUX(I,J).LE.0.)GOTO 500
      IF(IBOUND(I,J).NE.0)GOTO 500
C  WRITE ERROR MESSAGE THAT NODE IS NOT ACTIVE
      WRITE(95,980)I,J
  500 CONTINUE
  300 CONTINUE
  899 CONTINUE
C  FORMAT STATEMENTS
  901 FORMAT(F12.6)
  902 FORMAT(I10)
  903 FORMAT(2I5)
  904 FORMAT(A80)
  905 FORMAT(2F10.0)
  906 FORMAT(20X,2F10.4,10X,I5,I5)
  907 FORMAT(20X,5F10.0)
  908 FORMAT(A80)
  909 FORMAT(4I10)
  912 FORMAT(I10,' TOTAL AGRICULTURAL RECHARGE CFS = ',F10.2)
  980 FORMAT('ERROR -- NODE ',2I5,' IS NOT ACTIVE')
  981 FORMAT(40I3)
  990 FORMAT(8F10.4)
      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