C*******************************************************************************
C  MAKE.STREAM.RECHARGE.F77 -- A PROGRAM TO CREATE ARRAYS OF STREAM RECHARGE
C  INPUT IS ANNUAL RUNOFF FACTORS, LONG-TERM INFLOW AMOUNTS, STREAM RECHARGE
C  LOCATIONS, AND PERCENT RECHARGE IN EACH NODE.  WITH SLIGHT MODIFICATIONS
C  THE PROGRAM CAN BE USED TO ALLOCATE HISTORIC STREAM LOSSES. PROGRAM ALSO
C  ACCOUNTS FOR ET LOSS WITHIN THE STREAM CHANNEL.
C
C               BY   WES DANSKIN
C                    LAST REVISION 1/20/89
C
C*******************************************************************************
C  DIMENSIONS REQUIRED
C    FLUX(NROW,NCOL),RUNFAC(NYEARS),RPCT(NSTREAM,NYEARS),RPCTAV(NSTREAM),
C    IR(NSTREAM,NSNODE),IC(NSTREAM,NSNODE),FACNOD(NSTREAM,NSNODE),NSNODE(NSTREAM)
C    PCTABV(NSTREAM),PCTBLW(NSTREAM),SLENG(NSTREAM),AVECFS(NSTREAM),
C    RSTRYR(NSTREAM,NYEARS)
C    NUMBER OF ROWS = 180
C    NUMBER OF COLUMNS = 40
C    NUMBER OF STREAMS = 50
C    NUMBER OF NODES (MAXIMUM) PER STREAM = 35
C    NUMBER OF YEARS = 30
C******************************************************************************
      DIMENSION FLUX(180,40),IR(50,35),IC(50,35),IBOUND(180,40),
     - SNAME(50),RPCT(50,30),RPCTAV(50),NSNODE(50),AVECFS(50),
     - RUNFAC(30),PCTABV(50),PCTBLW(50),SLENG(50),FACNOD(50,35),
     - RSTRYR(50,30)
      CHARACTER*20 SNAME
      CHARACTER*80 COMMNT,BLANK,HEADNG
      COMMON /BIGONE/FLUX,IR,IC,IBOUND,SNAME,RPCT,RPCTAV,NSNODE,
     - AVECFS,FACNOD,RUNFAC,PCTABV,PCTBLW,SLENG,RSTRYR
C DEFINE SIZE OF GRID LOOPS
C      NROW=180
C      NCOL=40
      NSTRM=50
C      NYEARS=26
      NSN=35
C  READ CONTROL PARAMETERS
      READ(29,904)HEADNG
      WRITE(6,904)HEADNG
      READ(29,904)HEADNG
      WRITE(6,904)HEADNG
      READ(29,905)NLAY,NROW,NCOL,NYEARS
      WRITE(6,905)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
        RPCT(I,J)=0.
        RSTRYR(I,J)=0.
   13 CONTINUE
      DO 15 I=1,NSTRM
        AVECFS(I)=0.
        RPCTAV(I)=0.
        PCTABV(I)=0.
        PCTBLW(I)=0.
        SLENG(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
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 GAGE.
C   RPCTAV IS THE PERCENT RECHARGE FOR THE STREAM AS DETERMINED FROM A LINEAR
C     REGRESSION OF GAGED RECORDS.  FOR UNGAGED STREAMS IT IS THE ESTIMATED
C     RECHARGE PERCENTAGE FOR THE WHOLE STREAM.
C   RPCT   IS THE PERCENT RECHARGE FOR THE STREAM FOR INDIVIDUAL YEARS.  NOTE
C     THAT THE AMOUNT OF RECHARGE CALCULATED MAY NOT BE THE SAME AS HISTORIC
C     IF THE RUNOFF FACTOR IS NOT APPLICABLE FOR THE STREAM.
C   PCTABV,PCTBLW ARE THE PERCENTAGES OF STREAM RECHARGE LENGTH THAT OCCUR ABOVE
C     AND BELOW THE GAGED PART OF THE STREAM.
C   LENGTH IS THE RECHARGE LENGTH (IN FEET) OF THE STREAM.
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 IN WHETHER TO USE AVERAGE RECHARGE PERCENTAGE OR ANNUAL VALUES
      READ(5,900) IRPCT
C  READ PARAMETERS FOR COMPUTING ET LOSS FROM STREAM CHANNEL
      READ(5,901)ETWID,ETPCNT,ETRATE
      WRITE(6,901)ETWID,ETPCNT,ETRATE
C  COMPUTE ET LOSS RATE PER FOOT
      ETFOOT=ETWID*ETPCNT/100.*ETRATE/12./365./86400.
      WRITE(6,903)ETFOOT
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.
      READ(5,915)COMMNT
      WRITE(6,915)COMMNT
      DO 100 I=1,NSTRM
        READ(5,920) SNAME(I),AVECFS(I),RPCTAV(I),PCTABV(I),PCTBLW(I),
     -    SLENG(I),NSNODE(I)
        WRITE(6,920) SNAME(I),AVECFS(I),RPCTAV(I),PCTABV(I),PCTBLW(I),
     -    SLENG(I),NSNODE(I)
        READ(5,915)COMMNT
        WRITE(6,915)COMMNT
        READ(5,922) (RPCT(I,J),J=1,NYEARS)
        WRITE(6,922) (RPCT(I,J),J=1,NYEARS)
        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.101.) WRITE(95,982) TOTPCT,SNAME(I)
      IF(TOTPCT.LT.99.)  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.
      TOTET=0.
      DO 200 I=1,NSTRM
         TOTSTR=TOTSTR+AVECFS(I)*RUNFAC(K)/100.
C  NOTE THE TOTAL BASIN RUNOFF IN GAGED AREAS CAN BE COMPUTED BY ADDING
C  RABV TO TOTSTR
         RUN=AVECFS(I)*RUNFAC(K)/100.
         IF(IRPCT.NE.0) GOTO 201
C  USE AVERAGE ANNUAL RECHARGE PERCENTAGE
         RGAG=RUN*RPCTAV(I)/100.
         RABV=RUN*RPCTAV(I)/100.*PCTABV(I)/100.
         RBLW=RUN*RPCTAV(I)/100.*PCTBLW(I)/100.
         GOTO 202
C  USE ANNUAL RECHARGE PERCENTAGES
  201    RGAG=RUN*RPCT(I,K)/100.
         RABV=RUN*RPCT(I,K)/100.*PCTABV(I)/100.
         RBLW=RUN*RPCT(I,K)/100.*PCTBLW(I)/100.
C  CALCULATE ET LOSS
  202    ETLOSS=ETFOOT*SLENG(I)
         TOTET=TOTET+ETLOSS
         REC=RGAG+RABV+RBLW-ETLOSS
C  MAKE SURE ET LOSS DOES NOT EXCEED STREAM LOSS
         IF(REC.LT.0.)REC=0.
         IF(REC.LT.0.)WRITE(95,979)SNAME(I),K
C  WRITE OUT RESULTS FOR EACH STREAM
         IYEAR=1962+K
         IF(I.EQ.1)WRITE(6,923)RUNFAC(K)
         WRITE(6,924)IYEAR,SNAME(I),RABV,RGAG,RBLW,ETLOSS,REC
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
      IYEAR=1962+K
      WRITE(30,912)IYEAR,TOTSTR,TOTREC,TOTET
      WRITE(90,912)IYEAR,TOTSTR,TOTREC,TOTET
      IF(K.EQ.1)WRITE(31,912)IYEAR,TOTSTR,TOTREC,TOTET
      IF(K.EQ.22)WRITE(32,912)IYEAR,TOTSTR,TOTREC,TOTET
C  WRITE NODAL RECHARGE VALUES 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)
  901 FORMAT(3F10.0)
  902 FORMAT(F10.0)
  903 FORMAT('ET LOSS RATE (CFS) PER FOOT OF STREAM CHANNEL = ',G10.4)
  904 FORMAT(A80)
  905 FORMAT(4I10)
  912 FORMAT(I10,'WY  TOTAL STREAMFLOW CFS = ',F10.2,
     - ' TOTAL STREAM RECHARGE CFS = ',F10.2,
     - ' TOTAL STREAM ET LOSS = ',F10.2)
  915 FORMAT(A80)
  916 FORMAT('    STREAM NAME     ',
     - '     RECHARGE IN AC-FT FOR  1963-70WY, 1971-80WY, 1981-88WY')
  917 FORMAT(A20,12X,8F6.0,/,20X,10F6.0,/,20X,10F6.0)
  920 FORMAT(A20,F10.2,4F10.0,I10)
  921 FORMAT(8(2I3,F4.0))
  922 FORMAT(16F5.0)
  923 FORMAT('YEAR ',F4.0,'%    STREAM NAME     ABOVE GAGE    BETWEEN',
     - '    BELOW   ET LOSS      NET')
  924 FORMAT(I5,'WY',3X,A20,5F10.2)
  979 FORMAT('ERROR -- STREAM ',A20,' IN YEAR ',I5,
     - ' HAS NEGATIVE RECHARGE')
  980 FORMAT('ERROR -- NODE ',2I5,' IS NOT ACTIVE')
  981 FORMAT(40I3)
  982 FORMAT('ERROR -- TOTAL PERCENT RECHARGE = ',F10.2,' FOR ',A20)
  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
