C*******************************************************************************
C  MAKE.AG.RECHARGE.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 CANALS OR STREAMS IN THESE AREAS.
C  INPUT IS ANNUAL ESTIMATES FOR EACH AREA WHICH IS DISTRIBUTED TO EACH NODE.
C  NOTE PROGRAM IS SIMILAR TO THE MAKE.STREAM.RECHARGE.F77
C  PROGRAM USED TO DISTRIBUTE GAGED STREAMFLOW RECHARGE.
C
C               BY   WES DANSKIN
C                    LAST REVISION 8/1/88
C
C*******************************************************************************
C  DIMENSIONS REQUIRED
C    FLUX(NROW,NCOL),RUNFAC(NYEARS),RECPCT(NSTREAM),AVECFS(NSTREAM)
C    IR(NSTREAM,NSNODE),IC(NSTREAM,NSNODE),FACNOD(NSTREAM,NSNODE),NSNODE(NSTREAM)
C    RSTRYR(NSTREAM,NYEARS),CFSYR(NSTREAM.NYEARS)
C    NUMBER OF ROWS = 180
C    NUMBER OF COLUMNS = 40
C    NUMBER OF STREAMS = 60
C    NUMBER OF NODES (MAXIMUM) PER STREAM (AREA) = 35
C    NUMBER OF YEARS = 30
C******************************************************************************
      DIMENSION FLUX(180,40),IR(60,35),IC(60,35),IBOUND(180,40),
     - SNAME(60),RECPCT(60),NSNODE(60),AVECFS(60),FACNOD(60,35),
     - RUNFAC(30),RSTRYR(60,30),CFSYR(60,30)
      CHARACTER*30 SNAME
      CHARACTER*80 COMMNT,BLANK
      COMMON /BIGONE/ FLUX,IR,IC,IBOUND,SNAME,RECPCT,NSNODE,AVECFS,
     - FACNOD,RUNFAC,RSTRYR,CFSYR
C DEFINE SIZE OF GRID LOOPS
      NROW=180
      NCOL=40
      NSTRM=60
      NYEARS=22
      NSN=35
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 12 I=1,NYEARS
        RUNFAC(I)=0.
   12 CONTINUE
      DO 13 I=1,NSTRM
      DO 13 J=1,NYEARS
        RSTRYR(I,J)=0.
   13 CONTINUE
      DO 15 I=1,NSTRM
        AVECFS(I)=0.
        RECPCT(I)=0.
        NSNODE(I)=0
      DO 15 J=1,NSN
        IR(I,J)=0
        IC(I,J)=0
        FACNOD(I,J)=0.
   15 CONTINUE
C READ IN IBOUND ARRAY FOR LAYER 1
      DO 5 I=1,NROW
        READ(51,981)(IBOUND(I,J),J=1,NCOL)
    5 CONTINUE
C SUM SMALL STREAM RECHARGES
C   RUNFAC IS THE RUNOFF FACTOR FOR THE PARTICULAR YEAR.
C   AVECFS IS THE AVERAGE CFS AT THE BASE OF MOUNTAINS.
C   PCTREC IS THE PERCENT RECHARGE FOR THE STREAM AS ESTIMATED FROM NEARBY GAGED
C     RECORDS.
C   FACNOD IS THE PERCENT RECHARGE OUT OF 100 FOR A PARTICULAR NODE.
C   NSTRM IS THE TOTAL NUMBER OF STREAMS TO BE READ.
C   NSS IS THE NUMBER OF STREAM NODES.
C   RSTRYR IS THE RECHARGE AMOUNT IN ACFT PER STREAM PER WATER YEAR
C
C  READ RUNOFF FACTORS
C      READ(7,902) (RUNFAC(K),K=1,NYEARS)
C      WRITE(6,902) (RUNFAC(K),K=1,NYEARS)
C  READ NUMBER OF STREAMS
      READ(5,900) NSTRM
      WRITE(6,900) NSTRM
        IF(NSTRM.EQ.0) GOTO 899
C  READ EACH STREAM, AVERAGE FLOW RATE AT BASE OF MOUNTAINS IN CFS,
C  PERCENT OF TOTAL RUNOFF MEASURED, OVERALL RECHARGE FACTOR,
C  AND NUMBER OF NODES. THEN WHICH NODES.
      DO 100 I=1,NSTRM
        READ(5,920) SNAME(I),AVECFS(I),RECPCT(I),NSNODE(I)
        WRITE(6,920) SNAME(I),AVECFS(I),RECPCT(I),NSNODE(I)
C        READ(5,915)COMMNT
C        WRITE(6,915)COMMNT
        READ(5,921) (IR(I,J),IC(I,J),FACNOD(I,J),J=1,NSNODE(I))
        WRITE(6,921) (IR(I,J),IC(I,J),FACNOD(I,J),J=1,NSNODE(I))
        READ(5,903) (CFSYR(I,J),J=1,NYEARS)
        WRITE(6,903) (CFSYR(I,J),J=1,NYEARS)
  100 CONTINUE
C  CHECK THAT THE TOTAL RECHARGE PERCENTAGE OF ALL NODES IS ABOUT
C  100 PERCENT.  WRITE ERROR MESSAGE IF IT IS NOT.
      DO 120 I=1,NSTRM
      TOTPCT=0.
      DO 110 J=1,NSNODE(I)
      TOTPCT=TOTPCT+FACNOD(I,J)
  110 CONTINUE
      IF(TOTPCT.GT.105.) WRITE(95,982) TOTPCT,SNAME(I)
      IF(TOTPCT.LT.95.)  WRITE(95,982) TOTPCT,SNAME(I)
  120 CONTINUE
C  CALCULATE FOR EACH WATER YEAR
      DO 300 K=1,NYEARS
C  ZERO ARRAY AND ANNUAL AMOUNTS
      CALL ZERO2D(FLUX,NROW,NCOL)
      TOTSTR=0.
      TOTREC=0.
      DO 200 I=1,NSTRM
C         TOTSTR=TOTSTR+AVECFS(I)*RUNFAC(K)/100.
         TOTSTR=TOTSTR+CFSYR(I,K)
C         RUN=AVECFS(I)*RUNFAC(K)/100.
C         REC=RUN*RECPCT(I)/100.
         REC=CFSYR(I,K)*RECPCT(I)/100.
C  SUMMARIZE ARRAY FOR EACH STREAM
         RSTRYR(I,K)=REC*86400*365/43560.
C  DISTRIBUTE TOTAL RECHARGE TO INDIVIDUAL NODES
      DO 200 J=1,NSNODE(I)
         CFS=REC*FACNOD(I,J)/100.
         TOTREC=TOTREC+CFS
         II=IR(I,J)
         JJ=IC(I,J)
         FLUX(II,JJ)=FLUX(II,JJ)+CFS
  200 CONTINUE
C WRITE TOTALS TO A FILE
      IYEAR=1962+K
      WRITE(30,912)IYEAR,TOTSTR,TOTREC
      WRITE(90,912)IYEAR,TOTSTR,TOTREC
      IF(K.EQ.1)WRITE(31,912)IYEAR,TOTSTR,TOTREC
      IF(K.EQ.22)WRITE(32,912)IYEAR,TOTSTR,TOTREC
C  WRITE PUMPAGES 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
C  WRITE OUT SUMMARY ARRAY OF RECHARGE
      WRITE(90,916)
      DO 800 I=1,NSTRM
        WRITE(90,917)SNAME(I),(RSTRYR(I,J),J=1,NYEARS)
  800 CONTINUE
  899 CONTINUE
C FORMAT STATEMENTS
  900 FORMAT(I10)
  902 FORMAT(F10.0)
  903 FORMAT(8F10.2)
  912 FORMAT(I10,'WY  TOTAL AGRICULTURAL RECHARGE FLOW CFS = ',F10.2,
     -' TOTAL AGRICULTURAL RECHARGE CFS = ',F10.2)
  915 FORMAT(A80)
  916 FORMAT(' AGRICULTURAL RECHARGE AREA NAME  ',
     - '     RECHARGE IN AC-FT FOR  1963-70WY, 1971-80WY, 1981-84WY')
  917 FORMAT(A30,12X,8F6.0,/,30X,10F6.0,/,30X,4F6.0)
  920 FORMAT(A30,F10.3,F10.0,I10)
  921 FORMAT(8(2I3,F4.0))
  980 FORMAT('ERROR -- NODE ',2I5,' IS NOT ACTIVE')
  981 FORMAT(40I3)
  982 FORMAT('ERROR -- TOTAL PERCENT RECHARGE = ',F10.2,' FOR ',A30)
  990 FORMAT(8F10.3)
      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
