C*******************************************************************************
C  MAKE.UNGAGED.RECHARGE.F77 -- A PROGRAM TO CREATE ARRAYS OF RECHARGE FROM
C  UNGAGED AREAS OF OWENS VALLEY.  INPUT IS AN ANNUAL RUNOFF FACTOR, ESTIMATES
C  OF LONG-TERM UNGAGED FLOW AND RUNOFF AMOUNT AND LOCATIONS,  AND PERCENT RECHARGE
C  IN EACH NODE. NOTE PROGRAM IS NEARLY IDENTICAL TO THE MAKE.STREAM.RECHARGE.F77
C  PROGRAM USED TO DISTRIBUTE GAGED STREAMFLOW RECHARGE.
C
C               BY   WES DANSKIN
C                    LAST REVISION 3/1/89
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)
C    NUMBER OF ROWS = 180
C    NUMBER OF COLUMNS = 40
C    NUMBER OF STREAMS = 70
C    NUMBER OF NODES (MAXIMUM) PER STREAM (AREA) = 35
C    NUMBER OF YEARS = 30
C******************************************************************************
      DIMENSION FLUX(180,40),IR(70,35),IC(70,35),IBOUND(180,40),
     - SNAME(70),RECPCT(70),NSNODE(70),AVECFS(70),FACNOD(70,35),
     - RUNFAC(30),RSTRYR(70,30)
      CHARACTER*30 SNAME
      CHARACTER*80 COMMNT,BLANK,HEADNG
      COMMON /BIGONE/ FLUX,IR,IC,IBOUND,SNAME,RECPCT,NSNODE,AVECFS,
     - FACNOD,RUNFAC,RSTRYR
C DEFINE SIZE OF GRID LOOPS
C      NROW=180
C      NCOL=40
      NSTRM=70
C      NYEARS=26
      NSN=35
C  READ CONTROL PARAMETERS
      READ(29,901)HEADNG
      WRITE(6,901)HEADNG
      READ(29,901)HEADNG
      WRITE(6,901)HEADNG
      READ(29,903)NLAY,NROW,NCOL,NYEARS
      WRITE(6,903)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 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
      READ(7,902) (RUNFAC(K),K=1,NYEARS)
      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)
        READ(5,915)COMMNT
        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))
  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
         TOTSTR=TOTSTR+AVECFS(I)*RUNFAC(K)/100.
         RUN=AVECFS(I)*RUNFAC(K)/100.
         REC=RUN*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)
C         CFS=REC*FACNOD(I,J)/100.
         CFS=REC/NSNODE(I)
         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
      DO 850 J=1,NYEARS
      TOTMTN=0.
      TOTBED=0.
      IYR2=1962+J
      DO 840 I=1,NSTRM
      IF(I.LT.50)TOTMTN=TOTMTN+RSTRYR(I,J)
      IF(I.GE.50)TOTBED=TOTBED+RSTRYR(I,J)
  840 CONTINUE
      WRITE(90,913)IYR2,TOTMTN,TOTBED
  850 CONTINUE
  899 CONTINUE
C FORMAT STATEMENTS
  900 FORMAT(I10)
  901 FORMAT(A80)
  902 FORMAT(F10.0)
  903 FORMAT(4I10)
  912 FORMAT(I10,'WY  TOTAL UNGAGED FLOW CFS = ',F10.2,
     -' TOTAL UNGAGED RECHARGE CFS = ',F10.2)
  913 FORMAT(I10,'WY  UNGAGED MOUNTAIN-FRONT RECHARGE, IN AC-FT/YR = ',
     - F10.0,' UNGAGED LOCAL BEDROCK RECHARGE, IN AC-FT/YR = ',F10.0)
  915 FORMAT(A80)
  916 FORMAT(' UNGAGED AREA NAME  ',
     - '     RECHARGE IN AC-FT FOR  1963-70WY, 1971-80WY, 1981-88WY')
  917 FORMAT(A30,12X,8F6.0,/,30X,10F6.0,/,30X,10F6.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
