C******************************************************************************* C MAKE.GW.RECHARGE.F77 -- A PROGRAM TO CREATE ARRAYS OF RECHARGE FROM C GROUND-WATER RECHARGE AREAS OF OWENS VALLEY. INPUT IS ANNUAL ESTIMATES C 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 3/14/89 C C******************************************************************************* C DIMENSIONS REQUIRED C FLUX(NROW,NCOL),RUNFAC(NYEARS),RECPCT(NSTREAM),PCT(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),PCT(60),FACNOD(60,35), - RUNFAC(30),RSTRYR(60,30),CFSYR(60,30),AV6369(60),AV7084(60), - SCOMMT(60) CHARACTER*30 SNAME CHARACTER*80 SCOMMT CHARACTER*80 COMMNT,BLANK,HEADNG COMMON /BIGONE/ FLUX,IR,IC,IBOUND,SNAME,RECPCT,NSNODE,PCT, - FACNOD,RUNFAC,RSTRYR,CFSYR,AV6369,AV7084,SCOMMT C READ CONTROL PARAMETERS READ(29,901)HEADNG WRITE(6,901)HEADNG READ(29,901)HEADNG WRITE(6,901)HEADNG READ(29,904)NLAY,NROW,NCOL,NYEARS WRITE(6,904)NLAY,NROW,NCOL,NYEARS C DEFINE SIZE OF GRID LOOPS C NROW=180 C NCOL=40 NSTRM=60 C NYEARS=26 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 PCT(I)=0. RECPCT(I)=0. NSNODE(I)=0 AV6369(I)=0. AV7084(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),RECPCT(I),PCT(I),NSNODE(I),SCOMMT(I) WRITE(6,920) SNAME(I),RECPCT(I),PCT(I),NSNODE(I),SCOMMT(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.100.) WRITE(95,982) TOTPCT,SNAME(I) IF(TOTPCT.LT.100.) 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.*PCT(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 IF(K.EQ.23)WRITE(33,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) IF(K.EQ.23)WRITE(33,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 810 J=1,NYEARS DO 810 I=1,NSTRM IF(J.LE.7)AV6369(I)=AV6369(I)+RSTRYR(I,J) IF((J.GT.7).AND.(J.LE.22))AV7084(I)=AV7084(I)+RSTRYR(I,J) 810 CONTINUE DO 820 I=1,NSTRM AV6369(I)=AV6369(I)/7 AV7084(I)=AV7084(I)/15 WRITE(90,913)SCOMMT(I),SNAME(I),AV6369(I),AV7084(I) 820 CONTINUE C DO 830 J=1,NYEARS C DO 830 I=1,NSTRM C AVE(J)=AVE(J)+RSTRYR(I,J) C 830 CONTINUE 899 CONTINUE C FORMAT STATEMENTS 900 FORMAT(I10) 901 FORMAT(A80) 902 FORMAT(F10.0) 903 FORMAT(8F10.2) 904 FORMAT(4I10) 912 FORMAT(I10,'WY TOTAL GROUND-WATER RECHARGE FLOW CFS = ',F10.2, -' TOTAL GROUND-WATER RECHARGE CFS = ',F10.2) 913 FORMAT(A80,/,A30,/, - T30,'RECHARGE FOR 1963-69WY = ',F10.0,10X, - 'RECHARGE FOR 1970-84WY = ',F10.0) 915 FORMAT(A80) 916 FORMAT(' GROUND-WATER RECHARGE AREA NAME ', - ' RECHARGE IN AC-FT FOR 1963-70WY, 1971-80WY, 1981-84WY') 917 FORMAT(A30,12X,8F6.0,/,30X,10F6.0,/,30X,10F6.0) 920 FORMAT(A30,F10.0,F10.0,I10,A80) 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