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