From 714993f651e5f0654e79d6f74ca80ba18170cfcb Mon Sep 17 00:00:00 2001 From: Paul Kimpel Date: Sat, 24 Feb 2018 07:10:01 -0800 Subject: [PATCH] Commit initial transcriptions for example BALGOL programs: 1. Stanford Watershed Model IV. 2. Dirichlet Problem for a bean-shaped region. --- .../BALGOL-Examples/DIRICHLET/DIRICHLET.card | 389 +++++ software/StanfordModelIV/StanfordModelIV.card | 1304 +++++++++++++++++ 2 files changed, 1693 insertions(+) create mode 100644 software/BALGOL/BALGOL-Examples/DIRICHLET/DIRICHLET.card create mode 100644 software/StanfordModelIV/StanfordModelIV.card diff --git a/software/BALGOL/BALGOL-Examples/DIRICHLET/DIRICHLET.card b/software/BALGOL/BALGOL-Examples/DIRICHLET/DIRICHLET.card new file mode 100644 index 0000000..edd4c31 --- /dev/null +++ b/software/BALGOL/BALGOL-Examples/DIRICHLET/DIRICHLET.card @@ -0,0 +1,389 @@ + COMMENT + % DIRICHLET PROBLEM FOR A BEAN-SHAPED REGION. FROM P J DAVIS, + % "ORTHONORMALIZING CODES IN NUMERICAL ANALYSIS" IN J TODD, --SURVEY OF + % NUMERICAL ANLAYSIS--, MCGRAW-HILL, 1962, P.347. P H KIMPEL 8/15/70 + % MODIFICATION LOG: + % 92/03/17 P.KIMPEL, PARADIGM CORP, SAN DIEGO, CA 92117. + % CONVERT FOR UNISYS A-SERIES MCP 3.8.4. + % 2014-11-15 P.KIMPEL + % RETRO-CONVERT FROM UNISYS MCP ALGOL BACK TO BURROUGHS B5500 XALGOL. + % 2018-02-20 P.KIMPEL + % RETRO-CONVERT FROM B5500 TO BURROUGHS 220 BALGOL. + ; + + FORMAT F1 (B30,I3,2X10.3,4X10.5), + F2 (B40,*X*,B9,*Y*,B9,*W*,B8,*BV*,B7,*CBV,*,B7,*DEV*), + FT (W4,B40,*PROCESSOR TIME: *, F6.2,* SEC*); + INTEGER I, J; + REAL SUM, GMDT; + + COMMENT ARRAY DIMENSIONS WERE ORIGINALLY DEFINED AS N=43, M=11, P=11.. + X, % ABSCISSA VALUES. + Y, % ORDINATE VALUES. + W, % WEIGHTS. + CBV[0:N1], % BOUNDARY VALUES CALCULATED FROM ORTHO COEFS. + BV[0:0, 0:N1+P], % GIVEN BOUNDARY VALUES. + Z[0:M1, 0:N1+P], % APPROXIMATING VECTORS. + ORTHV[0:M, 0:N1+P], % ORTHONORMAL VECTORS RETURNED BY "ORTHO" + DEV[0:0, 0:N1], % DEVIATIONS. + COF[0:0, 0:P1], % COEFFICIENTS. + STD[0:0], % STANDARD DEVIATION. + CV[0:P, 0:P1], % COVARIANCE MATRIX. + VCV[0:0, 0:P, 0:P1], % VARIANCE/COVARIANCE MATRIX. + Q[0:0, 0:M], % FOURIER COEFFICIENTS. + Q2, % SQUARED FOURIER COEFFICIENTS. + E, % SUM OF SQUARED RESIDUALS. + EP[0:0, 0:M1], % RESIDUALS. + A[0:M1, 0:P1], % LOWER TRIANGULAR MATRIX USED TO CALC CV. + GF[0:M], % GRAM FACTORS. + ENF[0:M1]; % NORMS OF THE APPROXIMATING VECTORS. + + ARRAY + X(43), + Y(43), + W(43), + CBV(43), + BV(43+11), + Z(11, 43+11), + ORTHV(11, 43+11), + DEV(1, 43), + COF(1, 11), + STD(1), + CV(11+1, 11), + VCV(1, 11+1, 11), + Q(1, 11+1), + Q2(1,11), + E(1,11), + EP(1, 11), + A(11, 11), + GF(11+1), + ENF(11); + + + PROCEDURE ORTHO (W(), Y(,), Z(,), N, FN, M, P, R, AI, AUI, MUI, ZEI; + X(,), DEV(,), COF(,), STD, CV(,), VCV(,,), GMDT, + Q(,), Q2(,), E(,), EP(,), A(,), GF(), ENF()); + BEGIN + REAL FN, GMDT; + INTEGER N, M, P, R, AI, AUI, ZEI, MUI; + COMMENT + ORTHO IS TAKEN FROM ACM ALGORITHM 127 [COMM. ACM, VOL.5, + OCTOBER 1962, P. 511, AUTHOR PHILIP J. WALSH]; + INTEGER NPP, NPM, M1, N2, M2, R1, RBAR, P2, BEI, RHI, I18, GAI, SII, I, + J, DEI, NUI, E1Z2, E1Z1, K, THI, ALI, OMI, NII; + ARRAY PK, XP [N+P], QK[M+1]; + REAL DENOM, SUM, DK2, DK, FI, SS, SSQ; + + NPP = N+P; NPM = N+M; M1 = M-1; N2 = N+1; M2 = M+1; + R1 = 0; RBAR = R; P2 = P+1; + EITHER IF N EQL M; DENOM = 1.0; OTHERWISE; DENOM = SQRT(N-M); + BEI = RHI = I18 = 1; + EITHER IF (P NEQ 0); GAI = SII = 2 OTHERWISE; GAI = SII = 1; + BOX1.. SWITCH AI, (AT1, AT2); + AT1.. FOR J = (1, 1, N); BEGIN + X[2,J] = Z[1,J]; X[1,J] = 1.0 END; + FOR I = (2, 1, M1); BEGIN + FOR J = (1, 1, N); + X[I+1,J] = X[I,J] . X[2,J] END; GO TO BOX2; + AT2.. FOR I = (1, 1, M); BEGIN + FOR J = (1, 1, N); + X[I,J] = Z[I,J] END; + BOX2.. EITHER IF P EQL 0; GO TO BOX3 OTHERWISE; SWITCH AUI, (AU1, AU2); + AU1.. FOR I = (1, 1, M); BEGIN + FOR J = (N2, 1, NPP); + X[I,J] = 0.0; X[I,N+I] = 1.0 END; GO TO BOX3; + AU2.. FOR I = (1, 1, M); BEGIN + FOR J = (N2, 1, NPP); + X[I,J] = Z[I,J] END; + BOX3.. DEI = NUI = E1Z1 = E1Z2 = K = 1; + BOX4.. THI = 1; + BOX5.. ALI = OMI = 1; EITHER IF P EQL 0; GO TO BOX6 OTHERWISE; + FOR J = (1, 1, P); PK[N+J] = 0.0; + BOX6.. GO TO SWITCH MUI, (MU1, MU2); + MU1.. FOR I = (1, 1, N); PK[I] = X[K,I]; + GO TO BOX7; + MU2.. FOR I = (1, 1, N); + PK[I] = X[K,I] . W[I]; GO TO BOX7; + BOX7.. SWITCH OMI, (OM1, OM2); + OM1.. FOR I = (1, 1, K); BEGIN SUM = 0.0; + FOR J = (1, 1, NPP); + SUM = SUM + PK[J] . X[I,J]; QK[I] = SUM END; + GO TO BOX8; + OM2.. DK2 = 0.0; FOR I = (1, 1, NPP); + DK2 = DK2 + PK[I] . X[K,I]; + DK = SQRT(DK2); + GF[I18] = DK; I18 = I18 + 1; + FOR I = (1, 1, NPP); + X[K,I] = X[K,I]/DK;; + OMI = 1; GO TO BOX6; + BOX8.. SWITCH DEI, (DE1, DE2); + DE1.. E1Z1 = -E1Z1; EITHER IF E1Z1 < 0; GO TO BOX8B OTHERWISE; + GO TO BOX8A; + BOX8A.. FOR I = (1, 1, K-1); + QK[I] = -QK[I]; QK[K] = 1.0; + FOR I = (1, 1, NPP); BEGIN + SUM = 0.0; FOR J = (1, 1, K); + SUM = SUM + X[J,I] . QK[J]; + XP[I] = SUM END; GO TO BOX9; + BOX8B.. ENF[I18] = SQRT(QK[K]); GO TO BOX8A; + DE2.. E1Z2 = -E1Z2; EITHER IF E1Z2 < 0; GO TO BOX8C OTHERWISE; + GO TO BOX8A; + BOX8C.. FOR I = (1, 1, M); BEGIN + Q[R1,I] = QK[I]; Q2[R1,I] = QK[I] . QK[I] END; + Q[R1,M2] = QK[M2]; E[R1,1] = Q[R1,M2] - Q2[R1,1]; + FOR J = (2, 1, M); + E[R1,J] = E[R1,J-1] - Q2[R1,J]; + FI = 1.0; + FOR I = (1, 1, M); BEGIN + EITHER IF (FN - FI) > 0.0; BEGIN EITHER IF E[R1,I] < 0.0; + BEGIN EP[R1,I] = -SQRT(ABS(E[R1,I])/(FN - FI)); + GO TO BOX8D; END + OTHERWISE; EP[R1,I] = SQRT(E[R1,I]/(FN - FI)); + GO TO BOX8D; END OTHERWISE; E[R1,I] = -1.0; + BOX8D.. FI = FI + 1.0; END; GO TO BOX8A; + BOX9.. SWITCH THI, (TH1, TH2, TH3); + TH1.. FOR I = (1, 1, NPP); + X[K,I] = XP[I]; GO TO BOX10; + TH2.. FOR I = (1, 1, N); + DEV[R1,I] = XP[I]; + FOR I = (1, 1, P); + COF[R1,I] = -XP[N+I]; THI = 3; GO TO TH1; + TH3.. GO TO BOX11; + BOX10.. SWITCH ALI, (AL1, AL2); + AL1.. OMI = ALI = 2; GO TO BOX6; + AL2.. EITHER IF K < M; BEGIN K = K + 1; GO TO BOX4; END + OTHERWISE; GO TO BOX12; + BOX11.. SWITCH NUI, (NU1, NU2); + NU1.. NUI = 2; GO TO BOX14; + NU2.. SS = DK/DENOM; SSQ = SS . SS; + STD[R1] = SS; GO TO BOX14; + BOX12.. SWITCH BEI, (BE1, BE2); + BE1.. FOR I = (1, 1, M); BEGIN + FOR J = (1, 1, P); + A[I,J] = X[I,N+J] END; + GMDT = 1.0; FOR I = (1, 1, M); + GMDT = GMDT . (GF[I]/ENF[I]); + GMDT = GMDT . GMDT; DEI = BEI = THI = 2; + K = K + 1; GO TO BOX13; + BE2.. GO TO BOX11; + BOX13.. SWITCH GAI, (GA1, GA2); + GA1.. GO TO BOX11; + GA2.. FOR I = (1, 1, P); BEGIN + FOR J = (I, 1, P); BEGIN + SUM = 0.0; + FOR NII = (1, 1, M); + SUM = SUM + A[NII,I] . A[NII,J]; + CV[I,J] = SUM END END; + FOR I = (1, 1, P); + CV[P2,I] = SQRT(CV[I,I]); GAI = 1; GO TO BOX11; + BOX14.. SWITCH RHI, (RH1, RH2); + RH1.. EITHER IF RBAR EQL 0; GO TO FINAL OTHERWISE; RBAR = RBAR - 1; + R1 = R1 + 1; THI = RHI = 2; SWITCH ZEI, (ZE1, ZE2); + ZE1.. FOR I = (1, 1, N); + X[M2,I] = Y[R1,I]; + FOR I = (1, 1, P); + X[M2,N+I] = 0.0; GO TO BOX5; + ZE2.. FOR I = (1, 1, NPP); + X[M2,I] = Y[R1,I]; GO TO BOX5; + RH2.. SWITCH SII, (SI1, SI2); + SI1.. GO TO RH1; + SI2.. FOR I = (1, 1, P); BEGIN + FOR J = (I, 1, P); + VCV[R1,I,J] = SSQ . CV[I,J] END; + FOR I = (1, 1, P); + VCV[R1, P2, I] = SS . CV[P2,I]; GO TO RH1; + FINAL.. RETURN END ORTHO ; + + + PROCEDURE G (I, X, Y); REAL G; + REAL X, Y; INTEGER I; + SWITCH I, (G1, G2, G3, G4, G5, G6, G7, G8, G9, G10, + G11, G12, G13, G14, G15, G16, G17); + G = 0; + RETURN; + G1.. + G = 1; + RETURN; + G2.. + G = X; + RETURN; + G3.. + G = Y; + RETURN; + G4.. + G = X*2 - Y*2; + RETURN; + G5.. + G = 2.0 . X . Y; + RETURN; + G6.. + G = X*3 - 3.0 . X . Y*2; + RETURN; + G7.. + G = 3.0 . X*2 . Y - Y*3; + RETURN; + G8.. + G = X*4 + Y*4 - 6.0 . X*2 . Y*2; + RETURN; + G9.. + G = 4.0 . X*3 . Y - 4.0 . X . Y*3; + RETURN; + G10.. + G = X*5 - 10.0 . X*3 . Y*2 + 5.0 . X . Y*4; + RETURN; + G11.. + G = Y*5 - 10.0 . Y*3 . X*2 + 5.0 . Y . X*4; + RETURN; + G12.. + G = X*6 - 15.0 . X*4 . Y*2 + 15.0 . X*2 . Y*4 - Y*6; + RETURN; + G13.. + G = 6.0 . X*5 . Y + 6.0 . X . Y*5 - 20.0 . X*3 . Y*3; + RETURN; + G14.. + G = X*7 - 21.0 .X*5 . Y*2 + 35.0 . X*3 . Y*4 - 7.0 . X . + Y*6; + RETURN; + G15.. + G = 7.0 . X*6 . Y - 35.0 . X*4 . Y*3 + 21.0 . X*2 . Y*5 - + Y*7; + RETURN; + G16.. + G = X*8 + Y*8 - 28.0 . X*6 . Y*2 + 70.0 . X*4 . Y*4 - 28.0 + . X*2 . Y*6; + RETURN; + G17.. + G = 8.0 . X*7 . Y - 56.0 . X*5 . Y*3 + 56.0 . X*3 . Y*5 + - 8.0 . X . Y*7; + RETURN; + END G; + + + FOR I = (0, 1, N1); + BEGIN + READ (CDS, /, X[I], Y[I], W[I]); + BV[0,I] = EXP(X[I]) . COS(Y[I]) + LOG((1 - Y[I])*2 + X[I]*2); + FOR J = (0, 1, M1); + Z[J,I] = G(J+1, X[I], Y[I]); + END; + CLOSE (CDS); + ORTHO (W, BV, Z, N , N , M , P, 1, 2, 1, 2, 1, ORTHV, DEV, COF, STD, + CV, VCV, GMDT, Q, Q2, E, EP, A, GF, ENF); + FOR I = (0, 1, N1); + BEGIN SUM = 0; + FOR J = (0, 1, M1); SUM = SUM + COF[0,J].G(J+1, X[I], Y[I] + ); + CBV[I] = SUM; + END; + WRITE (PR[DBL], F2); + WRITE (PR, F1, FOR I = (0, 1, N1); [I,X[I],Y[I],W[I], BV[0,I], + CBV[I], (CBV[I]-BV[0,I])]); + WRITE (PR, FT, TIME(2)/60); + QUIT.. + + PROCEDURE DMMP (NAME, ROW, SZ); + VALUE NAME, SZ; + ALPHA NAME, SZ; + ARRAY ROW[0]; + BEGIN + REAL + I, + UB; + FORMAT + F (A6," = ",/*(6E20.11,/)); + UB = SZ-1; + WRITE (PR[DBL]); + WRITE (PR[DBL]); + WRITE (PR, F, NAME, (SZ+5)DIV 6, + FOR I = (0, 1, UB); ROW[I]); + END DMMP; + + ARRAY NR[0:99]; + FOR I = (0, 1, 99); + REPLACE POINTER(NR[I])+6 BY I FOR 2 DIGITS; + + DMMP ("X ", X, N1+1); + DMMP ("Y ", Y, N1+1); + DMMP ("W ", W, N1+1); + DMMP ("CBV ", CBV, N1+1); + DMMP ("BV ", BV[0,*], N1+P+1); + FOR I = (0, 1, M1); + BEGIN + SUM = "Z " & NR[I] [11:12]; + DMMP (SUM, Z[I,*], N1+P+1); + END; + FOR I = (0, 1, M); + BEGIN + SUM = "ORTHV " & NR[I] [11:12]; + DMMP (SUM, ORTHV[I,*], N1+P+1); + END; + DMMP ("DEV ", DEV[0,*], N1+1); + DMMP ("COF ", COF[0,*], P1+1); + DMMP ("STD ", STD, 1); + FOR I = (0, 1, P); + BEGIN + SUM = "CV " & NR[I] [11:12]; + DMMP (SUM, CV[I,*], P1+1); + END; + FOR I = (0, 1, P); + BEGIN + SUM = "VCV " & NR[I] [11:12]; + DMMP (SUM, VCV[0,I,*], P1+1); + END; + DMMP ("EP ", EP[0,*], M1+1); + FOR I = (0, 1, M1); + BEGIN + SUM = "A " & NR[I] [11:12]; + DMMP (SUM, A[I,*], P1+1); + END; + DMMP ("GF ", GF, M+1); + DMMP ("Q ", Q[0,*], M+1); + DMMP ("Q2 ", Q2[0,*], M1+1); + DMMP ("E ", E[0,*], M1+1); + DMMP ("ENF ", ENF, M1+1); + + FINISH; +5 0.000, 0.110, 0.01414, +5-0.050, 0.108, 0.01427, +5-0.100, 0.115, 0.01963, +5-0.160, 0.150, 0.02300, +5-0.220, 0.205, 0.03897, +5-0.320, 0.300, 0.02792, +5-0.400, 0.358, 0.03324, +5-0.500, 0.420, 0.01483, +5-0.550, 0.436, 0.01423, +5-0.600, 0.430, 0.01505, +5-0.644, 0.400, 0.01483, +5-0.660, 0.350, 0.01420, +5-0.655, 0.300, 0.02881, +5-0.635, 0.200, 0.03043, +5-0.595, 0.100, 0.03076, +5-0.552, 0.000, 0.03311, +5-0.500, -0.105, 0.03175, +5-0.440, -0.200, 0.01809, +5-0.400, -0.250, 0.01998, +5-0.350,-0.300, 0.01882, +5-0.300, -0.344, 0.03140, +5-0.204, -0.400, 0.03450, +5-0.100, -0.436, 0.02846, +5 0.000, -0.448, 0.02831, +5 0.100, -0.442, 0.03860, +5 0.230, -0.400, 0.02431, +5 0.300, -0.350, 0.02059, +5 0.353, -0.300, 0.03566, +5 0.430, -0.200, 0.03122, +5 0.477, -0.100, 0.02975, +5 0.510, 0.000, 0.02846, +5 0.522, 0.100, 0.01696, +5 0.520, 0.160, 0.02330, +5 0.500, 0.240, 0.02102, +5 0.456, 0.300, 0.01795, +5 0.400, 0.330, 0.01147, +5 0.360, 0.337, 0.01762, +5 0.300, 0.320, 0.01648, +5 0.250, 0.290, 0.01901, +5 0.300, 0.245, 0.01901, +5 0.150, 0.200, 0.01809, +5 0.100, 0.160, 0.01677, +5 0.050, 0.128, 0.01501, +5 SENTINEL diff --git a/software/StanfordModelIV/StanfordModelIV.card b/software/StanfordModelIV/StanfordModelIV.card new file mode 100644 index 0000000..1303617 --- /dev/null +++ b/software/StanfordModelIV/StanfordModelIV.card @@ -0,0 +1,1304 @@ +2COMMENT Transcribed from Appendix C of +2 DIGITAL SIMULATION IN HYDROLOGY: +2 STANFORD WATERSHED MODEL IV +2 Norman H. Crawford, Ray K. Linsley +2 Department of Civil Engineering, Stanford University +2 Technical Report No. 39, July 1966. +2 http://hydrocomp.com/publications/journals/stanford-watershed/ +2 P.Kimpel, Feburary 2018; +2 +2COMMENT STANFORD WATERSHED MODEL IV, COMBINED VERS1ON OF JULY 12,1966; + COMMENT TAPES PRECIP ON LOGICAL 10 - UNIT B5; 00010 + COMMENT READS PRECIP FROM LOGICAL TAPE 10- UNIT B5 ; + LIBRARY PROCEDURE PLOT(;X,Y,IC); + LIBRARY PROCEDURE SCALE(;A(),N,SMAX,SACT,XMIN,DX); + LIBRARY PROCEDURE AXIS(;X,Y,BCD,N,S,THETA ,XMIN,DX); + LIBRARY PROCEDURE PLOTWRITE(X,Y,H,THETA;;LIST,FMT); + GLOBAL LIBRARY SUBROUTINE PLOT10; + BOOLEAN DCS(),TAB,TABU,TAPES,RUN; + INEGER DD...,DPY,DLY,DAYMO,DAYS,DAY,HOUR,HARP,HAAP,MO,M1,NX..., + QQQ...,YR,STYR,FPYR,SEG,FLOWPINT,SHFT,RINT,DPM(),TAPEMOVE, Z, + MFILX,ST,CN,MOCOUNT,SG,STT,FILX,OBS,I1,I2,YRS, + IC,BCD,N,LABLE; + ARRAY C(99),C22(110),CAS(25), AVER(25),AVAR(25), + EE(24), + DCS(14),DR(367),E(375), EVCR(12), + FLO(367),GWSA(12), + MXRO(21),MXRA(21), + QQQ(12),QQL(12),QQO(12), + REC2(750),K(367),PREC(367),SUMPREC(12),SUMPRECR(12), + LZSA(12),REC1(768),SERR(25), + SERA(25),SQER(25), SPRA(12),SPRMA(12),SGWFA(12),SGWA(12), + SQ(25), + SDIV(367),SGWS(5,10),UZSS(5,10),LZSS(5,10),GWSS(5,10), + SPETA(12),SAETA(12),SINTA(12), + TRS(8884),TRSH(5,200),TR(24),TONE(12),TOND(12),TONN(12), + INFA(12),UZSA(12); + COMMENT SNOWMELT IV ARRAYS; + ARRAY MAXRAD(367),EES(24),SE(367),RAD(367),T(735), + RAS(24), RNMM(12),MSURE(12),RADMES(12),SCOMELTS(12); + ARRAY + RADDIST(24)=(0.0,0.0,0.0,0.0,0.0,0.0,0.019,0.041,0.067,0.088, + 0.102,0.11,0.11,0.11,0.105,0.095,0.081,0.055,0.017, + 0.0,0.0,0.0,0.0,0.0); + ARRAY + LAPSE(24)=(0.6,0.0,0.0,0.0,0.0,0.0,1.0,2.0,3.0,4.0,4.0,4.0,4.0,4.0, + 4.0,4.0,4.0,4.0,4.0,4.0,3.2,2.6,2.0,1.2); + ARRAY + GRAD(24)=(0.04,0.04,0.03,0.02,0.02,0.02,0.02,0.06,0.14,0.18,0.20, + 0.17,0.13,0.06,0.03,0.01,0.05,0.07,0.10,0.13,0.15,0.13,0.12,0.08); + ARRAY DPM(12)=(31,28,31,30,31,30,31,31,30,31,30,31); + ARRAY DDPM(12)=(31,30,31,31,28,31,30,31,30,31,31,30); + ARRAY HARP(12)=(304,334, 0,31,59,90,120,151,181,212,243,273); + ARRAY HAPP(12)=(0,31,59,90,120,151,181,212,243,273,304,334); + ARRAY LABLE(3)=("DISCHARGE C.F.S.D"); + READ (;;COMBO); + INPUT COMBO(TAPES,RUN); + IF TAPES; + BEGIN + COMMENT SECTION READS STORAGE AND HOURLY PRECIPITATION DATA AND +2OUTPUTS WEIGHTED HOURLY RAINFALL ON TAPE 85; 00500 + COMMENT OBS ON 24 HOUR DAY - MIDNIGHT IS 24; + COMMENT REWIND TAPE; + REWIND(10); + DDRECR=1; + P1SUM=0.0; + SIT=MO=0;READ (;;STATYR); + INPUT STATYR (YRS,FILX,SG); + IF FILX GTR 0; MOVEFILE(10,FILX); + FOR DDD=(1,1,YRS); + BEGIN + READ (;;WATYR); + INPUT WATHR (I1,I2); + FOR DD92=(1,1,12); (SUMPREC(DD92)=0; SUMPRECR(DD92)=0;); + YR=0; + MO=0; + DPY=365; DDPM(5)=28; + DPM(2)=28; + IF MOD (I2,4) EQL 0; + BEGIN + DPY=366; + OPM(2)=29; + DDPM(5)=29; + END; + FOR DD10=(1,1,367);PREC(DD10)=0.0; + IF SG GTR 0; UNTIL MO EQL 9; + BEGIN + READ(;;RR); + INPUT RR(STT,YR,MO,WSG,OBS,FOR DD14=(HAAP(MO)+1,1,HAAP(MO)+ + DPM(MO)); PREC(DD14)); + FOR DD15 = ( HAAP(MO) + 1, 1, HAAP(MO)+ DPM(MO)); + SUMPREC(MO) = SUMPREC(MO) + PREC(DD15); + IF MO EQL 2; IF DPM(2) EQL 29; + BEGIN + PREC(366)=PREC(60); + PREC(60)=0.0; + END; + END; + FOR DD85=(1,1,8884); THS(DD85)=0.0; + UNTIL TH GEQ 98; + BEGIN + READ(;;DATA); + FOR DD93 = (1 + 12.(CN-1),1,12+12.(CN-1)); + SUMPRECR(MO) = SUMPRECR(MO) + TRS(24.(HAAP(MO)+DAY-1)+DD93); + IF MO EQL 2; IF DAY EQL 29; + FOR NX91=(1+12.(CN-1),1,12+12.(CN-1)); + BEGIN + TRS(24.(366-1)+NX91)=TRS(24.(60-1)+NX91); + TRS(24.(60-1)+NX91)=0.0; + END; + END; + INPUT DATA(ST,YR, MO,DAY,CN,FOR HOUR=(1+12.(CN-1),1,12+12.(CN-1)); + TRS(24.(HAAP(MO)+DAY-1)+HOUR)); + COMMENT STORAGE GAGE ADJUSTMENT; +2 IF SG GTR 0; 01050 + BEGIN + DDL=273; KK=1.0; + FOR DDY=(274,1,365),(1,1,59),(366,1,DPY),(60,1,273); + BEGIN + FOR NXH=(1,1,24); + BEGIN + P1SUM=P1SUM+TRS(24.(DDY-1)+NXH); + IF NXH EQL OBS; + EITHER IF P1SUM GTR 0.0; + BEGIN + K(DDL)=PREC(DDY).WSG+P1SUM.(1.0-WSG))/P1SUM; + P1SUM=0.0; + END; + OTHERWISE; + + BEGIN + EITHER IF OBS NEQ 1; + TRS(24.(DDY-1)+OBS)=TRS(24.(DDY-1)+OBS-1)= + 0.5.WSG.PREC(DDY); + OTHERWISE; + TRS(24.(DDY-1)+OBS)=WSG.PREC(DDY); + K(DDL)=1.0; + END; + END; + DDL=DDY; + END; + KK=K(273); + FOR DDQ=(274,1,365),(1,1,59),366,1,DPY),(60,1,273); + FOR DDHR=(1,1,24); + BEGIN + TRS(24.(DDQ-1)+DDHR)=KK.TRS(24.(DDQ-1)+DDHR); + IF DDHR EQL OBS;(KK=K(DDQ); IF DQ EQL 273; KK=1.0;); + END; + END; + MOCOUNT=1; DDCOUNT=1; NX=1; RECSUM=0.0; + FOR DDA=(274,1,365),(1,1,59),(366,1,DPY),(60,1,273); + BEGIN + FOR DDR=(1,1,24); + BEGIN + REC1(NX)=TRS(24.(DDA-1)+DDR); + RECSUM=RECSUM+REC1(NX ); + NX=NX+1; + END; + DDCOUNT=DDCOUNT+1; + IF DDCOUNT EQL DDPM(MOCOUNT)+1; + BEGIN + NX=NX-1; + WAIT.. UNTIL CHECKM(10) NEQ 0; GO TO WAIT; + FOR NX5=(1,1,NX); + REC2(NX5)=REC1(NX5); + WRITEM (10,NX;REC2(1)); + EITHER IF MOCOUNT LEQ 3; DDMOC=MOCOUNT+9; + OTHERWISE;DDMOC=MOCOUNT-3; + IF DDMOC EQL 10; +2 BEGIN 01600 + WRITE(;;TITL,TITLF); + OUTPUT TITL(DDRECR); + FORMAT TITLF(*TAPE*,B12,*RECORD*,B1,I3,B2,*GAGE*,W3); + DDRECR=DDRECR+1; + END; + WRITE(;;ANS,ANSF); + OUTPUT ANS(ST,I1,I2,DOMOC,RECSUM,SUMPRECR(DDMOC), + SUMPREC(DDMOC)); + FORMAT ANSF (*STATION*,B2,I8,B2,*WATER YEAR*,B2,I2,B1,I2,B2, + *MONTH(,B2,I2,B2,*TAPE PRECIP*,X8.2,B2,*RECORDER*,X8.2, B2, + *STORAGE GAGE*,X8.2,W2); + RECSUM=0.0; + NX=1; + DDCOUNT=1; + MOCOUNT=MOCOUNT+1; + END; + END; + END; + RZ..UNTIL CHECKM(10) NEQ 0; GO TO RZ; + ENDFILE (10); + IF RUN; REWIND(10); + END; + IF NOT RUN; GO TO LFIN; + ETL=1.0; YR=0; NXSEG=0; + FOR DD28=(1,1,8884);TRS(DD28)=0.0; + READ(;;RUNDAT); + INPUT RUNDAT (FPYR,NXTSEG,MFILX); + REWIND(10); + WAI5..UNTIL CHECKM(10) NEQ 0; GO TO WAI5; + IF MFILX GTR 0; MOVEFILE (10,MFILX); + LINY.. + YR=YR+1; + NXSEG=NXSEG+1; + IF YR GTR FPYR; GO TO LFIN; + FOR DD46=(1,1,25); CAS(DD46)=SERR(DD46)=SQER(DD46)= + AVER(DD46)=AVAR(DD46)=0; + FOR DD107=(1,1,367);SDIV(DD107)=DR(DD107)=0.0; + READ (;;CONTROL); + INPUT CONTROL(DD2,FOR DD1=(1,1,DD2);DCS(DD1),FLOWPOINT, + SEG,TAREA,MAXCFS,TAPEMOVE,SHFT,MINH); + TCFSD=26.9.TAREA; + WAI6..UNTIL CHECKM(10) NEQ 0; GO TO WAI6; + IF ABS(TAPEMOVE) GTR 0; + MOVEM(10,12,TAPEMOVE); + READ (;;NEWY); + INPUT NEWY (DDYR1,DDYR2,YEAR,FOR DD44=(1,1,10);QQD(DD44)); + DPY=DLY=365; EXD=0.0; DPM(2)=28; + IF MOD (DDYR1,4) EQL 0;DLY=366; + IF MOD (DDYR2,4) EQL 0; (DPY=366; DPM(2)=29; EXD=1.0;); + COMMENT CARRYOVER FLOW; + COMMENT BASIC TIME SHIFT; + EITHER IF SHFT GTR 0; + FOR DD4=(24.DPY,-1,1);TRS(DD4+SHFT)=TRS(DD4); + OTHERWISE;FOR DD29=(1,1,8884);TRS(DD29)=0.0; +2FOR DD3=(1,1,200);TRS(DD3)=TRS(DD3)+TRSH(FLOWPOINT,DD3); 02150 + + IF NXSEG LEQ NXTSEG; + READ (;;START); + INPUT START ( FOR DD9=(1,1,SEG);(SGWS(FLOWPOINT,DD9),UZSS(FLOWPOINT, + DD9),LZSS(FLOWPOINT,DD9),GWSS(FLOWPOINT,DD9))); + EITHER IF DCS(3); + BEGIN + READ (;;EVAPM); + INPUT EVAPM (FOR DD11=(1,1,24); EE(DD11)); + DDE3=1; + FOR DDE1=(10,1,12),(1,1,9); + BEGIN + FOR DDE2=(1,1,DPM(DDE1)); + BEGIN + E(HAAP(DDE1)+DDE2)=EE(DDE3); + IF DDE2 EQL 15; DDE3=DDE3+1; + END; + DDE3=DDE3+1; + END + END; + OTHERWISE; READ (;;EVAP); + INPUT EVAP (FOR DD9=(274,1,365),(1,1,59),(366,1,DPY),(60,1,273); + E(DD9)); + READ (;;EVC); + INPUT EVC(FOR DD78=(10,1,12),(1,1,9);EVCR(DD78)); + IF DCS(9); + BEGIN + READ(;;EVAPS); + INPUT EVAPS(FOR DD85=(1,1,24);EES(DD85)); + DDS3=1; + FOR DDS1=(10,1,12),(1,1,9); + BEGIN + FOR DDS2=((1,1,DPM(DDS1)); + BEGIN + SE(HAAP(DDS1)+DDS2)=EES(DDS3); + IF DDS2 EQL 15;DDS3=DDS3+1; + END; + DDS3=DDS3+1; + END; + EITHER IF DCS(10); READ (;;RADIATION); + INPUT RADIATION (FOR DD76=(274,1,365),(1,1,59),(366,1,DPY), + (60,1,273); RAD(DD76)); + OTHERWISE; + BEGIN + READ (;;MRAD); + INPUT MRAD(FOR DDS5=(1,1,24);RAS(DDS5)); + DDX3=1; + FOR DDX1=(10,1,12),(1,1,9); + BEGIN + FOR DDX2=(1,1,DPM(DDX1)); + BEGIN + MAXRAD(HAAP(DDX1)+DDX2)=RAS(DDX3); + IF DDX2 EQL 15;DDX3=DDX3+1; + END; +2 DDX3-DDX3+1; 02700 + END; + END; + READ(;;TEM); + INPUT TEM (FOR DD19=(1,1730+2(DPY-365));T(DD19)); + END; + FOR DD74=(1,1,366);FLO(DD74)=0.0; + IF DCS(4); READ(;;FLOWS); + INPUT FLOWS (FOR DD17=(274,1,365),(1,1,59),366,1,DPS),60,1,273); + FLO(DD17)); + IF DCS(5); READ(;;DIVER); + INPUT DIVER (FOR DD53=(274,1,365),(1,1,59),(366,1,DPY),(60,1,273); + SDIV(DD53)); + + + FOR DDSEG=(1,1,SEG); + BEGIN + + SABC=0.0; + READ (;;TRI); + INPUT TRI ( FOR DD31=(1,1,12); QQQ(DD31)); + READ(;;ARRA1); + INPUT ARRA1 (RINT,Z,FOR DD3=(1,1,Z);C(DD3)); + READ (;;CL1); + INPUT CL1(K1,AREA,A); + READ (;;CL2); + INPUT CLS(EPXM,UZSN ,LZSN,K3,K24L,K24EL,CB,CC,L,SS,NN); + READ (;;CL3); + INPUT CLS3(KS1,IRC,KV,KK24,ETL); + IF DCS(9); READ (;;CL4); + INPUT CL4(RADCON,CONMELT,SCF,ELDIF,IDNS,F,DGM,WC,MPACK,NXTAPM); + WAI7..UNTIL CHECKM(10) NEQ 0; GO TO WAI7; + IF DCS(9); + MOVEM(10,12,NXTAPM); + SGW1=SGW=SGWS(FLOWPOINT,DDSEG); + UZS1=UZS=UZSS(FLOWPOINT,DDSEG); + LZS1=LZS=LZSS(FLOWPOINT,DDSEG); + GWS=GWSS(FLOWPOINT,DDSEG); + SRC=1020.SQRT(SS)/NN.L); + DEC=0.00982.((NN.L/SQRT(SS))*0.6); + CFSD=26.9.REA; + CFS=24.CFSD; + LABEDO=0.75; + TOTELH=0.0; NXSTORMS=0; NXFHI=0; NXFLOW=0; + KK4=KK24*(1.0/96.0); LKK4=1.0-KK4; + IRC4=IRC*(1.0/96.0); LIRC4=1.0-IRC4; + SSGWF=SPR=SPRM=0.0 + TEMP=50.0; NXTF=2; SPX1=0; COMMENT START EACH YEAR; + PA=1.0-A; SABC=SABD=SABM=0.0; + EPX=EPXM; + NXB=1; + WRITE(;;CHECOUT,CHKF); + OUTPUT CHECOUT(SGW,UZS,LZS,GWS,FLO(273),T(730+2.(DPY-365))); + FORMAT CHKF(4(X8.2),B2,*FLOW*,X8.2,B2,*TEMP*,X8.2,W2); + FOR MO=(10,1,12),(1,1,9); +2 BEGIN 03250 + WAZZ..UNTIL CHECKM(10) NEQ 0; GO TO WAZZ; + READM(10,24,DPM(MO);REC1(1)); + SSF=0.0; + WAT..UNTIL CHECKM(10) NEQ 0; GO TO WAT; + CHECKM(10;DDSTAT); + IF DDSTAT EQL 1; WRITE (;;EOF); + FORMAT EOF(*END OF FILE READ ON LOGICAL 10(PRECIP INPUT)*,W2); + IF DDSTAT GTR 1; + WRITE (;;TRB); + FORMAT TRB(*POSSIBLE ERROR ON LOGICAL 10 CHECK PRECIP TOTALS*, + W2); + FOR DAYMO=(1,1,DPM(MO)); + BEGIN + DAY=HAAP(MO)+DAYMO; + EP=EVCR(MO).E(DAY); + SFM=0.0; + REP=0.0; + SCHGWF=PRPR=SFSF=0.0; + FOR HOUR=(1,1,24); + BEGIN + PR=0.0; + NX=24.(DAYMO-1)+HOUR; + EPHRLI=0.0; + IF HOUR GTR 8) AND (HOUR LSS 21); EPHRLI=0.08333333.EP; + ELH=EPHRLI.ETL; + PX=K1.REC1(NX); + IF NOT DCS(11); + SPR=SPR+PX; + IF DCS(9); ENTER SNOWMELTIV; + IF PX GTR 0.0; RNM=RNM+PX; + COMMENT 15 MIN ACCOUNTING AND ROUTING LOOP; + SF=0.0; + FOR DD23=(1,1,4); + BEGIN + EITHER IF DCS(11); + BEGIN + PR=0.0; + IF DD23 EQL 1; + (XX=PX+0.000000001; PX=0.0;); + IF XX GTR 0.0; + BEGIN + PR=0.01.FIX(100.XX); + PX=PX+PR; + SPR=SPR+PR; + XX=100.(XX-PR); + END; + END; + OTHERWISE; + PR=0.25.PX; + EITHER IF PR GTR 0.0; + (PRPR=PRPR+PR; GO TO L1; ); + OR IF RES GTR 0.0; + BEGIN + P3=0.0; GO TO L2; +2 END; 38000 + OR IF SRGX GTR 0.0; + BEGIN + P3=0.0; + RDS=0.0; GO X2 + END; + OTHERWISE; (P3=0.0; GO TO L4;); + L1.. + IF TAB;CUMPREC=CUMPREC+PR; + COMMENT INTERCEPTIONS; + EPX=EPXM-SCEP; + IF EPX LSS 0.0; EPX=0.0; + EITHER IF PR LSS EPX; + BEGIN + SCEP=SCEP+PR; + P3=0.0; + END; + OTHERWISE; + BEGIN + P3=PR=EPX; + SCEP=SCEP+EPX; + END; + COMMENT P3 IS RAIN REACHING TEH GROUND SURFACE; + LNRAT=LZS/LZSN; + COMMENT LOWER ZONE AND GW INFILTRATION; + L2..P4=P3+RES; + EITHER IF LNRAT LSS 1.0; LNRATM=4.LNRAT; + OR IF LNRAD LSS 2.0; LNRATM=4.0+2(LNRAT-1.0); + OTHERWISE; LNRATM=6.0; + D3FV=CB/(2.0*LNRATM); + D4F=0.25.D3FV; + RATIO=CC.(2.0*LNRAT); + IF RATIO LSS 1.0; RATION =1.0; + EITHER IF P4 LSS D4F; + SHRD=P4.P4/(2.0.D4F); + OTHERWISE; SHRD=P4-0.5.D4F; + EITHER IF P4 LSS D4F.RATIO; + RXX=P4.P4/(2.0.D4F.RATIO); + OTHERWISE; RXX=P4=0.5.D4F.RATIO; + EITHER IF UZS LSS 2.0.UZSN; + BEGIN + UZI=2.0.ABS(0.5(UZS/UZSN)-1.0)+1.0; + PRE=(0.5.UZS/UZSN).(1.0/(1.0+UZI))*UZI; + END; + OTHERWISE; + BEGIN + UZI=2.0.ABS(((UZS/UZSN)-1.0)-1.0)+1.0; + PRE=1.0-(1.0/(1.0+UZI))*UZI; + END; + RGXX=SHRD-RXX; + RGX=RXX.PRE; + COMMENT RGX IS THE VOLUME TO INTERFLOW DETENTION STORAGE; + RX=RXX.PRE; + COMMENT RX IS THE VOLUME TO OVERLAND FLOW SURFACE DETENTION; + UZS=UZS+SHRD-RGX-RX; +2 IF DCS(1); IF UZS GTR 1.5(UZSN); IF NOT TAB; 04350 + BEGIN + DDIM=MO; DDID=DAYMO; DDIM=HOUR; + CUMPREC=CUMPREC+0.25.PX; + SCEPS=SCEP; + TAB=1; TABU=1; + END; + EITHER IF RX-RES GTR 0; DE=DEC.((RX-RES)*0.6); + OTHERWISE;DE=(RES+RX)/2.0; + IF (RES+RX) GTR 2.0.DE; DE=(RES+RX)/2.0; + EITHER IF (RES+RX) GTR 0.01; + ROS=0.25.SRC.(((RES+RX)/2.0)*1.67). ((1.0+0.6((RES+RX) + /2.0.DE)*3.0)*1.67); + OTHERWISE; ROS=0.0; + IF ROS GTR 0.75.RX; ROS=0.75.RX; + SROS=SROS+ROS; + IF TAB; SURRO=SURRO+ROS; + RES=RX-ROS; + IF RES LSS 0.001; + BEGIN + LZS=LZS+RES; + IF TAB; LZSIN=LZSIN+RES; + RES=0.0 + END; + LZI=(1.5).ABS((LZS/LZSN)-1.0)+1.0; + PRE=(1.0/(1.0+LZI))*LZI; + IF LZS LSS LZSN; PRE=1.0-PRE.(LZS/LZSN); + COMMENT F3 HELD IN LOWER; + F3=PRE.(P4-SHRD); + F1A=(1.0-PRE).(P4-SHRD); + F1=F1A(1.0-K24L).PA; + IF TAB; INFDIR=INFDIR+F1+F3; + SGW=SGW+F1; + IF TAB;CUMSGWIN=CUMSGWIN+F1; + GWS=GWS+F1; + LZS=LZS+F3; + IF TAB; LZSIN=LZSIN+F3; + COMMENT INTERFLOW STORAGE IS SRGX; + SRGX=SRGX+RGX; + XS..INTF=LIRC4.SRGX; + IF TAB; INTRO=INTRO+INTF; + COMMENT SUM OF INTERFLOW IS SINT; + SINT=SINT+INTF; + SRGX=SRGX-INTF; + IF SRGX LSS 0.0001; + BEGIN + LZS=LZS+SRGX; + IF TAB; LZSIN=LZSIN+SRGX; + SRGX=0.0 + END; + COMMENT GROUNDWATER FLOW CALC; + L4.. + EITHER IF SGW GTR 0.00001; + GWF=SGW.LKK4.(1.0+KV.GWS); + OTHERWISE; GWF=0.0; +2 SCHGWF=SCHGWF=GWF; 04900 + SGW=SGW-GWF; + IF TAB; CUMSGWOUT=CUMSGWOUT+GWF; + SSGWF=SSGWF+GWF; + R=(PA.ROS + P3.A+PA.INTF+GWF=0.25.ELH).CFS; + IF R LSS 0.0; R=0.0; + IF SF=SF+R; + IF TAB; IF R GTR 0.0; CUMEVAP=CUMEVAP+0.25.ELH; + IF TAB;TOTRO=TOTRO+(R/CFS); + IF R GTR 0; TOTELH=TOTELH+0.25.ELH; + COMMENT ENTER STATSUB HERE; + IF DCS(1); + BEGIN + IF DAY EQL 27;IF HOUR EQL 1; IF DD23 EQL 1; + WRITE(;;TITLE,TITLEG); + FORMAT TLESS(B3,*MO*,B5,*DAY*,B5,*TIME*,B6, + *RAIN*,B8,*INTERCEPT*,B3,*INFILT*,B6,*INTERFLOW*,B3, + *SURFACE*,B5,*GROUND*,B6,*TOTAL*,B5,*TOTAL-CFS*,W2); + EITHER IF 4.R LSS MINH; DDEX=1; + OTHERWISE; + BEGIN + IF DDEX EQL 1; (WRITE(;;TLESS); DDEX=0.0;); + DDTIME=100.(HOUR-1)+15.DD23; + IF MOD(DDTIME,100) EQL 60; DDTIME=DDTIME+40; + WRITE(;;DETAIL,DETAILF); + END; + OUTPUT DETAIL(MO,DAYMO,DDTIME,PR, + PR-P3,F1+F3,INTF,ROS,GWF,R/CFS,4.R); + FORMAT DETAILF(I5,I7,I9,7(X12.3),X10.1,W0); + F1=F3=INTF=0.0; + END; + END; + COMMENT END OF 15 MIN LOOP; + SFSF=SFSF+SF; + DDI=NXB; + COMMENT TRANSLATION IN TIME; + SC=SF/CFS; + EITHER IF SC GTR 0.01; + BEGIN + FOR DD=(1,1,Z); + BEGIN + DDX=DDI+RINT(DD-1); + TRS(DDX)=TRS(DDX)+SF.C(DD); + END; + END; + OTHERWISE;TRS(DDI+(Z.RINT/2))=TRS(DDI+(Z.RINT/2))+SF; + SSF=SSF+SF; + IF DCS(7); + BEGIN + IF SC GTR 0.0; + BEGIN + FOR DD33=(20,-1,1); + EITHER IF SC GTR MXRO(DD33);MXRO(DD33+1)=MXRO(DD33); + OTHERWISE; + BEGIN +2 MXRO(DD33+1)=SC; 05450 + GO TO Z100; + END; + MXRO(1)=SC; + END; + Z100.. + IF PX GTR 0.0; + BEGIN + FOR DD34=(20,-1,1); + EITHER IF PX GTR MXRA(DD34); MXRA(DD34+1)=MXRA(DD34); + OTHERWISE; + BEGIN + MXRA(DD34+1)=PX; + GO TO Z200; + END; + MXRA(1)=PX; + END; + Z200.. + END; + IF EPHRLI EQL 0.0; GO TO PASS; + IF SCEP GTR 0.0; + EITHER IF SCEP GTR EPHRLI; + BEGIN + SCEP=SCEP-EPHRLI; + SAET=SAET+EPHRLI; + IF TAB;CUMEVAP=CUMEVAP+EPHRLI; + EPHRLI=0.0; + GO TO PASS; + END; + OTHERWISE; + BEGIN + EPHRLI=EPHRLI-SCEP; + SAET=SAET+SCEP; + IF TAB;CUMEVAP=CUMEVAP+SCEP; + SCEP=0.0; + END; + IF UZS GTR 0.0; + EITHER IF UZS GTR EPHRLI; + BEGIN + UZS=UZS-EPHRLI; + IF UZS LSS 1.5.UZSN; TAB=0; + SAET=SAET+PA.EPHRLI; + IF TAB;CUMEVAP=CUMEVAP+PA.EPHRLI; + EPHRLI=0.0; + GO TO PASS; + END; + OTHERWISE; + BEGIN + EPHRLI=EPHRLI-UZS; + SAET-SAET+PA.UZS; + IF TAB;CUMEVAP=CUMEVAP+PA.UZS; + UZS=0.0; + END; + REP=REP+EPHRLI; + PASS.. +2 DEEPL =(UZS/UZSN)- (LZS/LZSN); 06000 + IF DEEPL GTR 0.0; + BEGIN + LNRAT=LZS/LZSN; + RECE=0.003.CB.UZSN.(DEEPL*3); + UZS=UZS-RECE; + IF UZS LSS 1.5(UZSN); TAB=0; + IF TAB; INFUP=INFUP+RECE; + LZI=(1.5).ABS(LNRAT-1.0)+1.0; + PRE=(1.0/(1.0+LZI))*LZI; + IF LZS LSS LZSN; PRE=1.0-PRE.LNRAT; + F3=PRE.RECE; + F1A=(1.0-PRE).RECE; + F1=F1A.(1.0-K24L).PA; + LZS=LZS+F3; + IF TAB; LZSIN=LZSIN+F3; + SGW=SGW+F1; + IF TAB; CUMSGWIN=CUMSGWIN+F1; + F1=F3=3.0; + GWS=GWS+F1 + END; + COMMENT EVAPORATION 7PM; + IF HOUR EQL 21; + BEGIN + SPET=SPET+EP; + EP=REP; + IF GWS GTR 0.00001; + GWS=0.98.GWS; + LUS=SGW.K24EL.EP.PA; + COMMENT EVAP-TRANS LOSS FROM GROUNDWATER; + SGW=SGW-LOS; + GWS=GWS-LOS; + TOTELH=TOTELH+LOS; + IF GWS LSS 0.0; GWS=0.0; + IF EP NEQ 0.0; + BEGIN + LNRAT=LZS/LZSN; + EITHER IF EP LSS K3.LNRAT; + BEGIN + AETR=EP.(1.0-(EP/(2.0.K3.LNRAT))); + LZS=LZS-AETR; + SAET=SAET+PA.AETR; + END; + OTHERWISE; + BEGIN + EATR=0.5.(K3.LNRAT); + LZS=LZS-AETR; + SAET=SAET+PA.AETR; + END + END + END; + NXB=NXB+1; + IF DCS(1); + BEGIN + FORMAT SAND(B5,*STORM PERIOD*,B5,*PRECIP*,B1,*EVAP*,B1,*SGWIN*,B1, +2 *SGWOUT*,B1,*LZSIN*,B1,*SURF-RO(, B1,*INTER-RO*,B1, 06550 + *TOTAL-RO*,B1,*INFILT-UP*,B1,*INFILT-DIR*,B2,*CB/GW*,B2,*CB/RO*, + B2, + *SGWCOR*,B2,*CB*,B2,*LZRAT*,W2); + IF TAB; GO TO LEND; COMMENT CONTINUING STORM; + IF NOT TABU; GO TO LEND; COMMENT STORM ENDED AND PROCESSED; + IF CUMSGWIN LSS CUMSGWOUT; GO TO RESET; + COMMENT SMALL STORM; + BALNC=CUMPREC-CUMEVAP-CUMSGWIN+CUMSGWOUT-LZSIN.PA-TOTRO+SCEPS + -SCEP; + IF ABS(BALNC) GTR 0.01; + WRITE(;;BALN1,BALN1F); + OUTPUT BALN1 (BALNC); + FORMAT BALN1F (B10,*STORM BALANCE IS*,B2,X7.2,W2); + IF CUMRECFLOW GTR 0.0; + SFRAT=CUMSIMFLOW/CUMRECFLOW; + IF FLO(DAY) GTR 0.0; + BEGIN + GFRAT=SF/FLO(DAY); + IF GFRAT GTR 0.0; + CBGW=CB/GFRAT; + CBRO=CB.SFRAT; + NXSTORMS=NXSTORMS+1; + IF (CBGW LSS 0.9.CB) AND (CBRO GTR 1.1.CB); NXFHI=NXFHI+1; + IF (CBGW GTR 1.1.CB) AND (CBRO LSS 0.9.CB); NXFLOW=NXFLFOW+1; + END; + SGWCUR=0.0; + IF DCS(2); + BEGIN + IF SF GTR 0.0; + BEGIN + NEWSGW=SGW.(FLO(DAY))/SF; + SGWCOR=NEWSGW-SGW; + SGW=NEWSGW; + END; + IF INFDIR GTR 0.33.INFUP; + BEGIN + IF (CBGW LSS 0.9.CB) AND (CBRO LSS 0.9.CB); CB=0.8.CB; + IF (CBGW GTR 1.1.CB) AND (CBRO GTR 1.1.CB); CB=1.2.CB; + END; + END; + WRITE (;;SAND); + WRITE(;;EZQ,EZQF); + OUTPUT EQZ(DDIM,DDID,DDIH,MO,DAYMO,HOUR, + CUMPREC,CUMEVAP,CUMSGWIN,CUMSGWOUT,SZSIN, + SURRO,INTRO,TOTRO,INFUP,INFDIR,CBGW,CBRO, + SGWCOR,CB,LZS/LZSN); + FORMAT EQZF(I2,*/*,I2,*/*,I2,B1,*TO*,B1, + I2,*/*,I2,*/*,I2,B2,X5.2,B1,X4.2,B2,X4.2, + B2,X4.2,B3,X4.2,B2,X4.2,B4,X4.2,B6,X4.2, + B5,X4.2,B7,X4.2,B5,X5.2,B2,X5.2,B3,X5.2,B1,X5.2, + B2,X4.2,W2); + RESET.. CUMPREC=CUMEVAP=CUMSGWIN=CUMSGWOUT=0.0; + LZSIN=SURRO=INTRO=TOTRO=INFUP=INFDIR=0.0; + CBGW=SGWCOR=CBRO=0.0; +2 CUMSIMFLOW=CUMRECFLOW=0.0; 07100 + TABU=0; + LEND.. + END; + END; + COMMENT END OF HOUR LOOP; + IF TAB; + BEGIN + CUMSIMFLOW=CUMSIMFLOW+SFSF; + CUMERCFLOW=CUMRECFLOW+24.FLO(DAY); + END; + END; + COMMENT END OF DAY LOOP; + TONE(MO)=SSF/CFS; + GWSA(MO)=GWS; + SPRA(MO)=SPR; SPR=0.0; + SPRMA(MO)=SPRM; SPRM=0.0; + SGWFA(MO)=SSGWF; SSGWF=0.0; + SINTA(MO)SINT; SINT=0.0; + SPETA(MO)=SPET; SPET=0.0; + SAETA9MO)=SAET; SAET=0.0; + RNMM(MO)=RNM; RNM=0.0; + MSURE(MO)=MSUREVAP; MSUREVAP=0.0; + RADMES(MO)=RADME; RADME=0.0; + SCOMELTA(MO)=SCOMELT; SCOMELT=0.0; + SGWA(MO)=SGW; + UZSA(MO)=UZS; + LZSA(MO)=LZS; + END; + COMMENT END OF MONTH LOOP; + WRITE (;;TRIAL,TRIALF); + OUTPUT TRIAL (FOR DD32=(1,1,12);QQQ(DD32)); + FORMAT TRIALF(B10,A72,W3); + WRITE (;;TITLE,TITLEF); + OUTPUT TITLE(FOR DD45=(1,1,10);QQO(DD45),DDYR1,DDYR2); + FORMAT TITLEF (A60,B3,*WATER YEAR 19*,I2,*-*,I2,B7, + *STANFORD WATERSHED MODEL IV *,W2); + SABC=RNA=TZN=RNB=SSAET=SSPET=SSINT=0.0; + SRADME=SRNM=SMS=SCO=0.0; + FOR DD25=(1,1,12); + BEGIN + SABC=SABC+TONE(DD25); + RNA=RNA+SPRA(DD25); + TZN=TZN+SGWFA(DD25); + RNB=RNB+SPRMA(DD25); + SSAET=SSAET+SAETA(DD25); + SSPET=SPET+SPETA(DD25); + SSINT=SSINT+SINTA(DD25); + SRADME=SRADME+RADMES(DD25); + SCO=SCO+SCOMELTS(DD25); + SMS=SMS+MSURE(DD25); + SRNM=SRNM+RNMM(DD25); + END; + WRITE (;;HSUM); + FORMAT HSUM(B8,*DAY*,B6,*OCT*,B5,*NOV*,B5,*DEC*,B5,*JAN*,B5,*FEB*,B5, +2*MAR*,B5,*APR*,B5,*MAY*,B5,*JUN*,B5,*JUL*,B5,*AUG*,B5,*SEPT*,B9, 07650 + *ANNUAL*,W2); + WRITE (;;YY2,YY2F); + OUTPUT YY2(FOR NX0=(10,1,12),(1,1,9);TONE(NX0),SABC); + FORMAT YY2F (*TOTAL*,B7,12(S8.3),B3,X7.2,B2,*INCHES* ,W); + WRITE ($$YY40,YY40F); + OUTPUT YY40(FOR NX40=(10,1,12),(1,1,9);SINTA(NX40),SSINT); + FORMAT YY40F(*INTERFLOW*,B3),12(S8.3),B3,S7.3,B2,*INCHES* ,W); + WRITE (;;YN5,YN5F); + OUTPUT YN5(FOR DD30=(10,1,12),(1,1,9);SGWFA(DD30),TZN); + FORMAT YN5F(*BASE*,B8,12(S8.3),B3,S7.3,B2,*INCHES* ,W); + WRITE ($$YY15,YY15F); + OUTPUT YY15(FOR NX15=(10,1,12),(1,1,9);SPRA(NX15),RNA); + FORMAT YY15F(*PRECIP*,B6,12X8.2,B2,X8.2,B2,*INCHES* ,W2); + IF DCS(9); + BEGIN + WRITE(;;FR1,FR1F); + OUTPUT FR1(FOR NX1=(10,1,12),(1,1,9);RNMM(NX1),SRNM); + FORMAT FR1F(*RAIN+EF MELT*,12X8.2,B2,X8.2,B2,*INCHES*,W); + WRITE(;;FR2,FR2F); + OUTPUT FR2(FOR NX2=(10,1,12),(1,1,9);RADMES(NX2),SRADME); + FORMAT FR2F(*RAD MELT*,B4,12X8.2,B2,X8.2,B2,*INCHES*,W); + WRITE(;;FR2,FR3F); + OUTPUT FR3(FOR NX3=(10,1,12),(1,1,9);SCOMELTS(NX3),SCO); + FORMAT FR3F(*CONV MELT*,B3,12X8.2,B2,X8.2,B2,*INCHES*,W); + WRITE(;;FR4,FR4F); + OUTPUT FR4(FOR NX4=(10,1,12),(1,1,9);MSURE(NX4),SMS); + FORMAT FR4F(*EVAP-SNOW*,B3,12X8.2,B2,X8.2,B2,*INCHES*,W2); + END; + WRITE($$YY17,YY17F); + OUTPUT YY17(FOR NX27=(10,1,12),(1,1,9);SAETA(NX27),SSAET); + FORMAT YY17F(*EVP/TRAN-NET*,12(S8.3),B3,S7.3,B2,*INCHES* ,W); + WRITE (;;YY18,YY18F); + OUTPUT YY18(FOR NX28=(10,1,12),(1,1,9);SPETA(NX28),SSPET); + FORMAT YY18F(B2,*-POTENTIAL*,12(S8.3),B3,S7.3,B2,*INCHES* W2); + WRITE (;;YY31,YY31F); + OUTPUT YY31(FOR NX21=(10,1,12),(1,1,9);UZSA(NX21)); + FORMAT YY31F(*STORAGES-UZS*,12(S8.3),B12,*INCHES* ,W); + WRITE (;;YY8,YY8F); + OUTPUT YY8(FOR NX8=(10,1,12),(1,1,9);LZSA(NX8)); + FORMAT YY8F(B9,*LZS*,12(S8.3),B12,*INCHES* ,W); + WRITE (;;YY22,YY22F); + OUTPUT YY22(FOR NX17=(10,1,12),(1,1,9);SGWA(NX17)); + FORMAT YY22F(B9,*SGN*,12(S8.3),B12,*INCHES* ,W2); + WRITE (;;YY30,YY30F); + OUTPUT YY30(FOR NX20=(10,1,12),(1,1,9); GWSA(NX20)); + FORMAT YY30F(*INDICES- GWS*,12(S8.3),W); + BAL=(LZS+UZS-LZS1-UZS1).PA+SGW-SGW1+SABC+TOTELH+SSAET -RNA; + WRITE(;;BALOUT,BALOUTF); + OUTPUT BALOUT(BAL); + FORMAT BALOUTF(*BALANCE*,B5,X10.4,B2,*INCHES*,W2); + IF DCS(1); IF DCS(2); + WRITE(;;HHH1,HHH1F); + OUTPUT HHH1(1.0- + (NXFHI+NXFLOW)/FLOAT(NXSTORMS),NXFHI,NXFLOW,NXSTORMS); +2FORMAT HHH1F (*DATA CONSISTENCY INDEX*, B2,X7.2,B2,*HIGH INPUT INDICATI 08200 + ONS*,B2,I5,B2,*LOW INPUT INDICATIONS*,B2,I5,B2,*TOTAL STORMS*,B2,I5,W2) + ; + IF NOT DCS(7); GO LBQ; + COMMENT OUTPUT MAX. RUNOFF,PRECIP. AT END OF YEAR; + WRITE ($$HEADX); + FORMAT HEADX(B10,*TWENTY HIGHEST CLOCKHOUR RAINFALL EVENTS IN THE WA + TER YEAR*,W2); + WRITE(;;RAMAX,RAMAXF); + OUTPUT RAMAX(FOR DD36=(1,1,20);MXRA(DD36)); + WRITE (;;HEADY); + FORMAT HEADY(B10,*TWENTY HIGHEST CLOCKHOUR OVERLAND FLOW RUNOFF EVEN + TS IN THE WATER YEAR*,W2); + OUTPUT ROMAX(FOR DD37=(1,1,20);MXRO(DD37)); + WRITE (;;ROMAX,RAMAXF); + FORMAT RAMAXF (B5,20(X6.3),W2); + FOR DD35=(1,1,20); MXRA(DD35)=MXRO(DD35)=0.0; + LBQ..DDCOM=0; + UZSS(FLOWPOINT,DDSEG)=UZS; + LZSS(FLOWPOINT,DDSEG)=LZS; + SGWS(FLOWPOINT,DDSEG)=SGW; + GWSS(FLOWPOINT,DDSEG)=GWS; + END; + + COMMENT END OF SEGMENT LOOP; + NXC=0; SSABD=0.0; + SSABM=0.0; + WRITE (;;TITLE,TITLEG); + FORMAT TITLEG (A60,B3,*WATER YEAR 19*,I2,*-*,I2,B7, + *STANFORD WATERSHED MODEL IV *,W3); + + FOR M1=(10,1,12),(1,1,9); + BEGIN + SWITCH M1,(1,2,3,4,5,6,7,8,9,10,11,12); + 1..WRITE(;;HJAN);GO W;2..WRITE(;;HFEB);GO W;3..WRITE(;;HMAR); GO W; + 4..WRITE(;;HAPR);GO W;5..WRITE(;;HMAY);GO W;6..WRITE(;;HJUN); GO W; + 7..WRITE(;;HJUL);GO W;8..WRITE(;;HAUG);GO W;9.. WRITE(;;HSEPT);GO W; + 10..WRITE(;;HOCT);GO W;11..WRITE(;;HNOV);GO W;12..WRITE(;;HDEC);GO W; + FORMAT HNOV(*NOVEMBER*,W2); FORMAT HDEC(*DECEMBER*,W2); + FORMAT HJAN(*JANUARY*,W2); FORMAT HFEB(*FEBRUARY*,W2); + FORMAT HMAR(*MARCH*,W2); FORMAT HAPR(*APRIL*,W2); FORMAT HMAY(*MAY*, + W2); FORMAT HJUN(*JUNE*,W2); FORMAT HJUL(*JULY*,W2); + FORMAT HAUG(*AUGUST*,W2); FORMAT HSEPT(*SEPTEMBER*,W2); + FORMAT HOCT(*OCTOBER*,W2); + W.. + SABD=SABM=0.0; + FOR DAYS=(1,1,DPM(M1)); + BEGIN + SUMSF=0.0; + NXPRINT=0; + DAY=HAAP(M1)+DAYS; + IF (DAYS EQL 29) AND (M1 EQL 2); DAY=366; + FOR HOUR=(1,1,24); + BEGIN + NXC=NXC+1; +2 IN=TJS(NXC)+SDIV(DAY); 08750 + EITHER IF IN LSS 0.0000001; + SF=IN; + OTHERWISE; + SF=IN-KS1.(IN-LSF); + IF SF GTR MINH; NXPRINT=1; + LSF=SF; + TR(HOUR)=SF; + TRS(NXC)=SF; + SUMSF=SUMSF+SF; + END; + DRDAY=DR(DAY)=SUMSF/24.0; + IF NXPRINT GTR 0; + BEGIN + WRITE(;;HOURFLOW1,HRF1); + WRITE(;;HOURFLOW2,HRF2); + END; + OUTPUT HOURFLOW1(DAYS ,FOR HOUR=(1,1,12);TR(HOUR)); + OUTPUT HOURFLOW2(FOR HOUR=(13,1,24);TR(HOUR),DRDAY); + FORMAT HRF1(I4,B2,*AM*,B1,6X8.1,B3,6X8.1,W); + FORMAT HRF2(B6,*PM*,B1,6X8.1,B3,7X8.1,W2); + SABD=SABD+FLO(DAY); + SABM=SABM+DR(DAY); + COMMENT STORE ERRORS AND FLOW DURATION; + IF NOT DCS(6); GO TO LBY; + ERR=DR(DAY)=FLO(DAY); + IF ABS(ERR) LSS 0.000001; ERR=0.0; + EITHER IF FLO(DAY) LSS 1.0; IND=1.0; + OTHERWISE; IND=2.LOG(FLO(DAY))+2.0; + CAS(IND)=CAS(IND)+1.0; + SERR(IND)=SERR(IND) +ERR; + SERA(IND)=SERA(IND) +ABS(ERR); + SQER(IND)=SQER(IND)+ERR.ERR; + AVER(IND)=SERR(IND)/CAS(IND); + AVAR(IND)=SERA(IND)/CAS(IND); + EITHER IF CAS(IND) GTR 1; + SQ(IND)=SQRT((SQER(IND)-((SERR(IND))*2)/CAS(IND))/(CAS(IND)-1.0)); + OTHERWISE; + SQ(IND)=0.0; + LBY.. + END; + COMMENT END OF DAYS LOOP; + TONN(M1)=SABM; + SSABM=SSABM+SABM; + TOND(M1)=SABD; + SSABD=SSBD+SABD; + END; + COMMENT END OF M1 LOOP; + FOR NX57=(1,1,200); + TRSH(FLOWPOINT,NX57)=TRS(24.DPY+NX57); + + WRITE (;;TITLE,TITLEG); + WRITE(;;HSUM); + FOR DD27=(1,1,28); + BEGIN +2 EITHER IF MOD(DD27,5) EQL 0;WRITE (;;FLTAB,FLTAB2); 09300 + OTHERWISE;WRITE (;;FLTAB,FLTAB1) + END; + EITHER IF DPY EQL 366; + BEGIN + DD27=29; DR(60)=DR(366); + WRITE(;;FLTAB,FLTAB1); + END; + OTHERWISE; + WRITE (;;DA29,DA29F); + OUTPUT DA29(DR(302),DR(333),DR(363),DR(29),DR(88),DR(119),DR(149), + DR(180),DR210),DR241),DR(272)); + FORMAT DA29F(B7,*29*,B3,4(X8.1),B3,*---*,B2,7(X8.1),W); + WRITE (;;DA30,DA30F); + OUTPUT DA30(DR(303),DR(334),DR(364),DR(30),DR(89),DR(120),DR(150), + DR(181),DR(211),DR(242),DR(273)); + FORMAT DA30F(B7,*30*,B3,4(X8.1),B8,7(X8.1),W); + WRITE (;;DA31,DA31F); + OUTPUT DA31(DR(304),DR(365),DR(31),DR(90),DR(151),DR(212),DR(243)); + FORMAT DA31F(B7,*31*,B3,X8.1,B8,2X8.1,B8,X8.1,B8,X8.1,B8,2X8.1,W2); + OUTPUT FLTAB (DD27,FOR DD26=12,(1,1,11);DR(HARP(DD26)+DD27)); + FORMAT FLTAB1(B3,I6,B3,12(X8.1),W); + FORMAT FLTAB2(B3,I6,B3,12(X8.1),W2); + WRITE (;;YY1,YY1F); + OUTPUT YY1(FOR NX58=(10,1,12),(1,1,9);TONN(NX58),SSABM); + FORMAT YY1F(*SYNTHESIS*,B3,12(X8.0),B1,X9.0,B2,*CFSD*,W); + WRITE (;;YZ1,YZ1F); + OUTPUT YZ1(FOR NX59=(10,1,12),(1,1,9);TONN(NX59)/TCFSD,SSABM/TCFSD); + FORMAT YZ1F(B12,12(S8.3),B2,X8.1,B2,*INCHES*,W ); + WRITE (;;Y23,YY23F); + OUTPUT YY23(1.98.SSABM); + FORMAT YY23F(B109,X9.0,B2,*ACFT*,W2); + IF NOT DCS(4); GO TO OMBY; + WRITE (;;YY10,YY10F); + OUTPUT YY10(FOR NX59=(10,1,12),(1,1,9);TOND(NX59),SSABD); + FORMAT YY10F(*RECORDED*,B4,12(X8.0),B1,X9.0,B2,*CFSD*,W); + WRITE (;;YY24,YY24F); + OUTPUT YY24(FOR NX60=(10,1,12),(1,1,9);TOND(NX60)/TCFSD,SSABD/TCFSD); + FORMAT YY24F(B12,12(S8.3),B2,X8.1,B2,*INCHES*,W); + WRITE (;;YY25,YY25F); + OUTPUT YY25(YEAR,1,98.SSABD); + FORMAT YY25F(B92,*(*,X9.0,B2,*)*,B4,X9.0,B2,*ACFT*,W2); + OMBY.. + IF NOT DCS(6); GO TO DJ; + WRITE (;;ERS); + FORMAT ERS(B10,*DAILY FLOW DURATION AND ERROR TABLE*,W3); + FORMAT ERT (B10,*FLOW INTERVAL*,B5,*CASES*,B3,*AV.ERROR*,B3,*AVR. ABS. + ERROR*,B3,*STANDARD ERROR*,W2); + WRITE (;;ERT); + SCASE=SSERR=SSERA=SSTER=0.0; + FOR DD30=(1,1,25); + BEGIN + EITHER IF DD30 EQL 1; FLOO=0.0; + OR IF DD30 EQL 2; FLOO=1.0; + OTHERWISE; FLOO=EXP((DD30/2.0)-1.0); +2 CAAS=CAS(DD30); 09850 + OUTPUT ERRS1(FLOO,CAAS,SERR(DD30)/CAAS); + OUTPUT ERRS0 (FLOO,CAAS); + OUTPUT ERRS(FLOO,CAAS,SERR(DD30)/CAAS,SERA(DD30)/CAAS, SQ(DD30)); + FORMAT ERRSF( B13,X8.1,*-*,X9.1,X12.1,B5,X8.2,B5,X8.2,W); + EITHER IF CAAS EQL 0.0; WRITE (;;ERRS0,ERRSF); + OR IF CAAS EQL 1.0; WRITE (;;ERRS1,ERRSF); + OTHERWISE;WRITE($$ERRS,ERRSF); + SCASE=SCASE+CAS(DD30); + SSERR=SSERR+SERR(DD30); + SSERA=SSERA+SERA(DD30); + SSTER=SSTER+SQ(DD30); + END; + OUTPUT ERRSUM (SCASE,SSERR,SSERA,SSTER); + FORMAT ERRSUMF(B22,X9.1,X12.1,B3,X10.2,B3,X10.2,W2); + WRITE (;;ERRSUM,ERRSUMF); + MEANSY=SABC/DPY; MEANAC=SABD/DPY; + ZACDIF=ZSYDIF=PRODIF=0.0; + FOR DD38=(1,1,DPY); + BEGIN + ACDIF=FLO(DD38)-MEANAC; + SYDIF=DR(DD38)-MEANSY; + ZACDIF=ZACDIF+ACDIF.ACDIF; + ZSYDIF=ZSYDIF+SYDIF.SYDIF; + PRODIF=PRODIF+ACDIF.SYDIF; + END; + CORCO=PROD1F/SQRT(ZACDIF.ZSYDIF); + OUTPUT COR(CORCO); + WRITE (;;COR,CORF); + FORMAT CORF(B10,*CORRELATION COEFFICIENT (DAILY)*,B3,X10.4,W2); + DJ.. + IF DCS(8); + BEGIN + ENTER PLOT10; + COMMENT DRAW AXIS; + COMMENT HORIZONTAL AXIS; + FOR X=31.0,61.0,92.0,123.0,151.0+EXD,182.0+EXD,212.0+EXD,243.0+EXD, + 273.0+EXD,304.0+EXD,335.0+EXD,365.0+EXD; + BEGIN + PLOT(;X/10.0,0.0,2); + PLOT(;X/10.0,0.2,2); + PLOT(;X/10.0,0.0,2); + END; + DR(367)=FLO(367)=MAXCFS; + FOR DD82=(1,1,366); + BEGIN + IF DR(DD82) GTR MAXCF;DR(DD82)=MAXCFS; + IF FLO(DD82) GTR MAXCFS;FLO(DD82)=MAXCFS; + END; + SCALE(;DR(),367,10.0,SACT,YMIN,DY); + SCALE(;FLO(),367,10.0,SSACT,YYMIN,DYY); + AXIS(;0.0,0.0,LABLE(1),18,SACT,90.0,YMIN,DY); + PLOTWRITE (20.0,8.57,0.14,0.0;;FMT2); + FORMAT FMT2(*STANFORD WATERSHED MODEL IV*,E); + PLOTWRITE (20.0,8.07,0.14,0.0;;PLTX,PLTXF); +2 OUTPUT PLTX(FOR DD76=(1,1,10);QQO(DD76),DDYR1,DDYR2); 10400 + FORMAT PLTXF(A60,B3,*19*,I2,*-*,I2,E); + PLOTWRITE(20.0,7.57,0.14,0.0;;PLTI,PLTIF); + OUTPUT PLTI(FOR DD75=(1,1,12);QQQ(DD75)); + FORMAT PLTIF(A72,E); + PLOT (;1.5,0.0,3); + PLOTWRITE (1.5,-0.2,0.14,0.0;;FMT); + FORMAT FMT(*OCTOBER*,B18,*NOVEMBER*,B17,*DECEMBER*,B17, + *JANUARY*,B18,*FEBRUARY*,B17,*MARCH*,E); + PLOTWRITE(19.5,-0.2,0.14,0.0;;FMTA); + FORMAT FMTA(*APRIL*,B20,*MAY*,B21,*JUNE*,B20,*JULY*,B20,*AUGUST*, + B19,*SEPTEMBER*,E); + PLOT(;0.0,-0.2,3); + PLOT(;0.0,0.0,3); + COMMENT PLOT RECORDED FLOW; + PLOT(;0.0,0.0,3); + X=0.0; + FOR DDAY1=(274,1,365),(1,1,59),(366,1,DPY),(60,1,273); + BEGIN + X=X1.0; + PLOT(;X/10.0,FLO(DDAY1),2); + END; + PLOT(;0.0,0.0,-3); + COMMENT PLOT SYNTHESIS/ CHANGE TO RED; + X=0.0; + FOR DDAY2=(274,1,365),(1,1,59),(366,1,DPY),60,1,273); + BEGIN + X=X+1.0; + PLOT(;X/10.0,DR(DDAY2),2); + END; + PLOT(;(DPY/10.0)+6.0,0.0,-3); + COMMENT CLOSE OUT PLOT; + END; + COMMENT END OF PLOT LOOP; + GO TO LINY; + SUBROUTINE SNOWMELTIV; + BEGIN + M=0.0; + IF DAY EQL 274;IF HOUR EQL 1; WRITE (;;TRIAL,TRIALF); + IF DAY EQL 274; IPACK=0.1.MPACK; + COMMENT CALCULATE CONTIN TEMPERATURE; + TEMPGRAD=GRAD(HOUR).CHANGE); + TEMP=TEMP+TEMPGRAD; + IF (HOUR EQL 6) OR (HOUR EQL 16); + BEGIN + EITHER IF DCS(13); + BEGIN + EITHER IF MOD(NXTF,2) EQL 0;NXTF-NXTF-1; + OTHERWISE;NXTF=NXTF+3; + COMMENT INPUT SERIES IS TMAX, TMIN EACH DAY, TMAX OCCURS + BEFORE OBSERVATION TIME; + END; + OTHERWISE; + NXTF=NXTF+1; + CHANGE=T(NXTF)-TEMP; +2 IF HOUR EQL 6; 10950 + BEGIN + CHAN=CHANGE/27.0; + IF CHAN GTR 1.0; CHAN =1.0; + RADFAC=RADCON.CHAN.MAXRAD(DAY); + END; + END; + COMMENT TEMPX IN ZONE; + LAPS=LAPSE(HOUR); + IF PX GTR 0.05; LAPS=0.75.LAPS; + TEMPX=TEMP-LAPS.ELDIF; TEMPXR=0.557(TEMPX-32.0)+273.0; + IF PX +PACK EQL 0.0; RETURN; + IF PX GTR 0.0; + BEGIN + COMMENT SNOW/RAIN CONTROL IS TEMP AT 750 FT; + IF (TEMPX - 0.750.LAPS) LEQ 32.0; + COMMENT SNOW; + BEGIN + PX=SCF.PX; + SPR=SPR+(SCF-1.0).PX; + EITHER IF TEMPX GTR 0.0; + DNS=IDNS+((TEMPX/100.0)*2.0); + OTHERWISE; DNS=IDNS ; + PACK=PACK+PX ; + IF PACK GTR IPACK; IPACK=PACK; + IF IPACK GTR MPACK; IPACK=MPACK; + ALBEDO=ALBEDO+0.04.PX; + IF ALBEDO GTR 0.75; ALBEDO=0.75; + DEPTH=DEPTH+(PX/DNS); + SUMSNOW=SUMSNOW+PX; + PX=0.0 ; + END ; + END ; + COMMENT FOR TEMPX GTR 32 PX IS UNCHANGED; + IF PACK EQL 0.0; RETURN; + IF SDEN LSS 0.6; DEPTH=DEPTH(1.0-0.00002(DEPTH(0.6-SDEN))); + IF NEGMELT GTR 0.01.PACK; IF LIQW GTR 0.2.WC.PACK; + BEGIN + NEGMELT=NEGMELT-0.01.LIQW; + PACK=PACK+0.01.LIQW; + LIQW=0.99.LIQW; + END; + COMMENT SNOW EVAPORATION; + IF TEMPX LSS 32.0; + BEGIN + EITHER IF PACK GTR IPACK; + SEVAP=SE(DAY); + OTHERWISE;SEVAP=(PACK/IPAC).SE(DAY); + COMMENT ASSUME DAILY SEVAP OCCURS IN 12 HOUR PERIOD; + SEVAP=0.0832.SEVAP; + MSUREVAP=MSUREVAP+SEVAP; + SAET=SAET+SEVAP; + IF PACK GTR SEVAP; + PACK=PACK=SEVAP; + IF SDEN GTR 0.0; +2 DEPTH=DEPTH-(SEVAP/SDEN); + END; + COMMENT REDUCE REGULAR ET; + E1E=E2E=EPHRLI; + EITHER IF PACK GTR IPACK; E1E=0.0; + OTHERWISE;E1E=(1.0-(PACK/IPACK)).E1E; + IF TEMPX LSS 38.0; E2E=0.0; + EPHRLI=(1.0-F).E1E_F.E2E; + COMMENT FIND INCOMING SHORTWAVE; + EITHER IF DCS(10); + RA=RADCON.RAD(DAY).RADDIST(HOUR); + OTHERWISE; RA=RADFAC.RADDIST(HOUR); + COMMENT NET SHORTWAVE; + RA=(1.0-F).(1.0-ALBEDO).RA; + COMMENT CLEAR SKY LONG-WAVE RADIATION EXCHANGE + AND FOREST LONG-WAVE EXCHANGE; + LW=-27.5(1.0-F)(0.76.(TEMXR/273.0)*4.0-1.0) + -27.5(F)((TEMPXR/273.0)*4.0-1.0); + IF LW GTR 28.0;LW=28.0; + HM=RA-LW; + EITHER IF TEMPX LSS 32.0; + NEGMELTM= ((32.0-TEMPX)/288.0).PACK; + OTHERWISE; NEGMELTM=0.0; + EITHER IF HM LSS 0.0; + BEGIN + CHNEGM=-(HM/203.2); + IF PACK LSS IPACK;CHNEGM=(PACK/IPACK).CHNEGM; + IF NEGMELT LSS NEGMELTM; + NEGMELT=NEGMELT+(1.0-(NEGMELT/NEGMELTM)).CHNEGM; + END; + OTHERWISE; + BEGIN + M=HM/203.2; + RADMT=RADME+M; + END; + M=M+CONMELT.(TEMPX-32.0); + SCOMELT=SCOMELT+CONMELT.(TEMPX-32.0); + IF TEMPX -0.75.LAPSE(HOUR) GTR 32.0; + IF PX GTR 0.0; IF TEMPX GTR 32.0; + M=M+((TEMPX-32.0).(PX/144.0)); + IF PACK LSS IPACK; + M=(PACK/IPACK).M; + IF M LSS 0.0; + BEGIN + IF NEGMELT LSS NEGMELTM; + NEGMELT=NEGMELT-(1.0-(NEGMELT/NEGMELTM)).M; + M=0.0; + END; + IF M+PX GTR 0.0; + BEGIN + EITHER IF M LSS LEGMELT; + BEGIN + NEGMELT=NEGMELT-M; + M=0.0; + END; +2 OTHERWISE; + BEGIN + M=M-NEGMELT; + NEGMELT=0.0; + END; + EITHER IF ALBEDO GTR 0.7; ALBEDO=ALBEDO-0.04.M; + OTHERWISE; ALBEDO=ALBEDO-0.02.M; + IF ALBEDO LSS 0.65; ALBEDO=0.65; + EITHER IF PX LSS NEGMELT; + BEGIN + NEGMELT=NEGMELT-PX; + PACK=PACK+PX; PX=0.0; + END; + OTHERWISE; + BEGIN + PX=PX-NEGMELT; + PACK=PACK+NEGMELT; NEGMELT=0.0; + END; + IF PX +M EQL 0.0; GO TO LUPO; + EITHER IF M GEQ PACK; + BEGIN + M=PACK+LIQW; + DEPTH=PACK=LIQM=0.0; + ALBEDO=0.75; + END; + OTHERWISE; + BEGIN + PACK=PACK-M; + IF SDEN GTR 0.0; + DEPTH=DEPTH-(M/SDEN); + IF PACK GEQ 0.9.DEPTH; DEPTH=11.1.PACK; + IF PACK LSS 0.001; PACK=0.0; + LIQS=WC.PACK; + IF SDEN GTR 0.6; LIQS=WC.(3.0-(3.33).SDEN).PACK; + IF LIQS LSS 0.0; LIQS=0.0; + END; + EITHER IF (LIQS+M+PX) GTR LIQS; + BEGIN + PX=M+PX+LIQW-LIQS; + LIQW=LIQS ; + GO TO LUPO; + END; + OTHERWISE ; + BEGIN + LIQW=LIQW+M+PX; + PX=0.0 ; + GO TO LUPO; + END ; + END; + LUPO.. + IF PACK GTR 0.0; IF DEPTH NEQ 0.0; + IF PACK GTR 0.0; IF PACK LSS DEPTH; + SDEN=PACK/DEPTH; + COMMENT GROUND MELT; + IF HOUR EQL 16; +2 BEGIN 12600 + DGMM=DGM; + IF NEGMELT GTR 0.01.PACK; + BEGIN + DGMM=DGM(1.0-(MEGMELT/0.08.PACK)); + NEGMELT=NEGMELT-DGM+DGMM; + END; + EITHER IF PACK GTR DGMM; + BEGIN + PX=PX+DGMM; + PACK=PACK-DGMM; + DEPTH=DEPTH-(DGMM/SDEN); + IF PACK GEQ 0.9.DEPTH; DEPTH=1.11.PACK; + END; + OTHERWISE; + BEGIN + PX=PACK+PX+LIQW; + PACK=DEPTH=LIQW=NEGMELT=0.0; + END; + END; + IF MO NEQ DDMOTO; + BEGIN + WRITE (;;FORMSP); + FORMAT FORMSP (W); + DDMOTO=MO; + END; + IF HOUR EQL 24; IF PACK GTR 0.0; + WRITE(;;NOWA,SNOWF); + OUTPUT SNOWA(MO,DAYMO,PACK,DEPTH,SDEN,ALBEDO,NEGMELT,LIQW); + FORMAT SNOWF(B2,I4,B2,I4,B2,*PACK=*,X8.2,B2, + *DEPTH=*,X8.2,B2,*DENS=*,X6.2,B2, + *ALBEDO=*,X6.2,B2,*NEGMELT=*,X6.2,B2,*LIQW=*,X6.2,W); + RETURN + END; + LFIN..UNLOAD(10); + FINISH;