C******************************************************************************* C MAKE.CANAL.RECHARGE.F77 -- A PROGRAM TO CREATE ARRAYS OF RECHARGE FROM C CANALS IN OWENS VALLEY. INPUT IS AN ANNUAL RUNOFF FACTOR, ESTIMATES C OF LONG-TERM AVERAGE RECHARGE FOR CANALS, 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),RPCT(NSTREAM,NYEARS),RPCTAV(NSTREAM), C IR(NSTREAM,NSNODE),IC(NSTREAM,NSNODE),FACNOD(NSTREAM,NSNODE),NSNODE(NSTREAM) C AVECFS(NSTREAM),RSTRYR(NSTREAM,NYEARS) C NUMBER OF ROWS = 180 C NUMBER OF COLUMNS = 40 C NUMBER OF STREAMS = 60 C NUMBER OF NODES (MAXIMUM) PER STREAM (CANAL) = 35 C NUMBER OF YEARS = 30 C****************************************************************************** DIMENSION FLUX(180,40),IR(60,35),IC(60,35),IBOUND(180,40), - SNAME(60),RPCT(60,30),RPCTAV(60),NSNODE(60),AVECFS(60), - RUNFAC(30),FACNOD(60,35),RSTRYR(60,30) CHARACTER*30 SNAME CHARACTER*80 COMMNT,HEADNG COMMON /BIGONE/ FLUX,IR,IC,IBOUND,SNAME,RPCT,RPCTAV,NSNODE, - AVECFS,FACNOD,RUNFAC,RSTRYR C DEFINE SIZE OF GRID LOOPS C NROW=180 C NCOL=40 NSTRM=60 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 RPCT(I,J)=0. RSTRYR(I,J)=0. 13 CONTINUE DO 15 I=1,NSTRM AVECFS(I)=0. RPCTAV(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 RPCTAV IS THE PERCENT RECHARGE FOR THE STREAM AS ESTIMATED. C RPCT IS THE PERCENT RECHARGE FOR THE STREAM FOR INDIVIDUAL YEARS. 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 IN WHETHER TO USE FIXED RUNOFF FACTOR OR TO USE ANNUAL RUNOFF VALUES READ(5,900) IRFAC 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),NSNODE(I) WRITE(6,920) SNAME(I),AVECFS(I),RPCTAV(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.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. C USE FIXED RUNOFF FACTOR (IRFAC=0) OR ANNUAL (IRFAC=1) IF(IRFAC.EQ.0)RUN=AVECFS(I)*100/100. IF(IRFAC.NE.0)RUN=AVECFS(I)*RUNFAC(K)/100. IF(IRPCT.NE.0) GOTO 201 C USE AVERAGE ANNUAL RECHARGE PERCENTAGE REC=RUN*RPCTAV(I)/100. GOTO 202 C USE ANNUAL RECHARGE PERCENTAGES 201 REC=RUN*RPCT(I,K)/100. 202 CONTINUE 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 DO 850 J=1,NYEARS TCANAL=0. TSPILL=0. IYR2=1962+J DO 840 I=1,NSTRM IF(I.LT.23)TCANAL=TCANAL+RSTRYR(I,J) IF(I.GE.23)TSPILL=TSPILL+RSTRYR(I,J) 840 CONTINUE WRITE(90,913)IYR2,TCANAL,TSPILL 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 CANAL FLOW CFS = ',F10.2, -' TOTAL CANAL RECHARGE CFS = ',F10.2) 913 FORMAT(I10,'WY CANAL RECHARGE, IN AC-FT/YR = ', - F10.0,' SPILLGATE RECHARGE, IN AC-FT/YR = ',F10.0) 915 FORMAT(A80) 916 FORMAT(' CANAL NAME ', - ' RECHARGE IN AC-FT FOR 1963-70WY, 1971-80WY, 1981-87WY') 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)) 922 FORMAT(16F5.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