PRO^
UNITED STATES ENVIRONMENTAL PROTECTION AGENCY
^ REGION II
26 FEDERAL PLAZA
NEW YORK. NEW YORK 10007
Addendum to ES001:
Source deck for ES002 (for IBM 1130)
Steven C. Chapra, Sanitary Engineer
Systems Analysis Section
Seymour Gordimer, Chief
Computer Systems Section
Data Systems Branch
September, 1973
-------
Requirements for ES002
1. IBM 1130
a. 8K words of core
b. With a disk drive
c. 60 sectors of disk space for temporary
data files.
2. Variable used to designate the input and output units should
conform to the input-output devices at the disposal of the
user.
In this program the variables MX and MY are used for this purpose.-
I
-------
REAL IDJOB,IDATE
40
15
I
11
7
8
50
14
12
10
16
17
18
3
5
4
FAC1.FAC2,FAC3,ITYPE(35>
FILE 1(41,02,U,J5)
2(41,62,U,J5)
4(250, 12, U, Ji>)
5(2,82,U,J5>
6(2,82,U,JS)
7(2,62,U,J5)
8(41,6,U,J 5)
9(41,82,U,J5)
10(1.82.U,J5)
FILE
FILE
F ILE
FILE
FILE
FILE
FILE
FILE
COMMON
DEFINE
DEFINE
DEFINE
OEFINE
DEFINE
OEFINE
DEFINE
DEFINE
DEFINE
ni=i
112=7
J=1
LLL = 1
JBM=41
IC0N=-1
NFLAG=0
CALL DATA1 (NFLAG,NN,IDJOB,IDAfc,I MAX,JMAX,IS2 , 1,I, ICON )
CALL ATPllNFLAG, I MAX,lS2,JMAX,l)
CALL DA1A1( NFLAG,NN, I DJUFs, I DA TE » I MAX, JMAX, I S2 »2» I » I CON)
CALL ATP1(MFLAG,LLL,IS2,JMAX,2)
IF(NFLAG)11,11,1
CALL PRKltlMAX, JMAX, IOJOB, IDATE,0)
CALL PR1(3,I MAX,JMAX,10JOB,I DATE,0)
CALL DATA21IMAX,JMAX,IS2,JBM)
CALL PLACK IS2» JMAX, JBM)
IF(NN)2,2,3
J = 0
K = 0
J = J+1
K=K + 1
CALL MATS(1,2,4,5,J#IS2,JMAX,J)
IF fJ-1)6,6,7
CALL BRIGH(1,IS2,JMAX)
GO TO 3
CALL D«IGH(1,IS2,JMAX)
CALL LST(K,7,I,JMAX)
CALL MATNV(J,JMAX,1,J,7)
K=K+1
CALL LST(K,7,I,JMAX)
CALL BCGH(IS2,JMAX,J,ICON)
IF(ICON-1)12,10,12
IF(J-l)9,9,10
CALL PR 1(I,I MAX,JMAX,IDJOB,I DATE,1)
CALL PR 1(?,I MAX,JMAX,IDJOB,1 DATE,1)
CALL PRl (3,IMAX,JMAX,IDJOB,IDATE,I)
CALL BDOUT(IMAX,IUJ03,IDATE,ICON)
IF( IC0N-4)18,17,18
IC0N=5
GO TO 16
IF( IC0N-2)15,1,15
CALL BR IGH(1,IS2,JMAX)
IF(I)4, 4, 5
1=2
CALL LST(1,7,I,JMAX)
CALL MEMS(JMAX,1,1)
CALL LST(2,7,I,JMAX)
CALL BCGH(IS2,JMAX,l)
CALL DRIGIK 1,IS2,JMAX)
CALL LST(3,7,I,JMAX)
CALL MEMS(JMAX,2,2)
ES002000
ES002001
ES002002
ES002003
ES002004
ES002005
ES002006
ES002007
ES002008
ES002009
ES002010
ES002011
ES002012
ES002U13
ES002014
ES002015
ES002016
ES002017
ES002018
ES002019
ES002020
ES002021
ES002022
ES002023
ES002024
ES002025
ES002026
ESO02027
ES002028
ES0020^9
ES002030
ES002031
ES002032
ES002033
ES002034
ES002035
ES002036
ES002037
ES002038
ES002039
ES002040
ES002041
ES002042
ES002043
ES002044
ES002045
ES002046
ES002047
ES002048
ES002049
ES002050
ES002051
ES002052
ES002053
ES002054
ES002055
ES002056
ES00205 7
ES002056
ES002059
ES002Q60
ES002061
-------
CALL LST(7*I» JMAX) ES002062
GO TO 14 ES002063
END ES002064
-------
SUBROUTINE ATP 1(\FLAG,I MAX,IS2*JMAX
,KK)
AIP1
000
REAL IDKFG(6)»LI(3)*\OA(3),MJ(41)
ATPl
001
REAL IPASS, I FAIL, I DM J13 ( 14) , IDT , IBLNK,KNALB
AT*>1
002
DIMlNSIQM IDJB(3,14),ISV<3)
ATP 1
003
DIMENSION KFO(l),JBV(1),ISA<1),I SB(l»
, I SC11J,AAA»27)
ATP1
004
DATA IDKFQ/ • DtiLE* , * S NI','S Pl','S
CM
S'MISSS'N
CL * /
ATP1
005
DATA IDHJB/'C 2D','C ON'.'C DP',»C
DC
*,•N 2D ' , ' M
DN'r'M OP*,
ATP1
006
1 • M3D1 * • »V?302 », ¦ *! W1' » «MCS1 • , •HCM2*,
¦M1CM' M2CMV
ATP 1
007
DATA IDJB/2*I,5,2,1,5,1,3,5,1,4,5,2*1
,5,2,1,5,1,
3,5t
ATP1
ooa
26*1,It It 5,1,4,5,2*1,4,1,4,5,2*1,4/
ATP 1
009
DATA IPAS S/'PASS'/ ,IFML/'FAIL*/,IBLNK/• */
ATPl
010
KNAL8=IBLNK
ATP1
Oil
MX=5
ATPl
012
KKK=1
ATPl
013
GO TOt34,33),KK
ATPl
014
33
READ( 5 • 2 ) M J
ATPl
015
J = 1
ATPl
016
DO 88 J= 1,JMAX
ATPl
017
R£AD(9»J)Kl,Gl»KFO,G2,G3,JBV,ISA,ISb,
ISC,AAA
ATPl
018
JB=JBV(KKK)
ATPl
019
IZ = 0
ATPl
020
DD 86 LL=1,3
ATPl
021
GO TO (81,82,83),LL
ATPl
022
81
I S=ISA(KKK)
ATPl
023
GO TO 84
ATPl
024
82
1S-ISBIKKK)
ATPl
025
GO TO 84
ATPl
026
83
IS= I SC(KKK)
ATPl
027
84
ISV(LL)=IS
ATPl
028
1 = I s
ATPi
029
IF(I)37,37,23
ATPl
030
23
R£AD(9»l)K1,G2 » KFQ
ATPl
0 31
GO TO 37
ATPl
032
34
DO 11 1 = 1,1 MAX
ATPl
033
READ<9' t )Kl ,Gl,KF0,G2,G3,JSV,ISA,fSB ,
ISC,AAA
ATPl
034
IF|K-FO(1))5,1,2
ATPl
035
37
IF(I)ltl,2
ATPl
0 36
1
NTPS =5
ATPl
037
GO TD 10
ATPl
038
2
IF(1-152)4,4,7
ATPl
039
4
IF(KFD(KKK)-1)5,6,5
ATPl
040
5
NTPS =6
ATPl
041
GO TO 10
ATPl
042
6
NTPS =1
ATPl
043
GO TO 10
ATPl
044
7
IFII-JMAX)8»8»5
ATPl
045
8
IF(KK-2)20,21,21
ATPl
046
20
K=KFO< KKK )
ATPl
047
GO TO 22
ATPl
048
21
K=KF01KKK)
ATPl
049
22
IF(K-1)5,5,3
ATPl
050
3
IF(K-4)9,9,5
ATPl
051
9
NTPS =K
ATPl
052
10
IF(KK-2)35, 36,36
ATPl
053
35
MJ(1)=IDKFO(NTPS)
ATPl
054
IF(MTPS-4)72,72,71
ATPl
055
71
NFLAG=NFLAG+I
ATPl
056
72
WRITEIMX,700) I , IDKFCHNTPS)
ATPl
057
700
FOKHAT{8HOSECTIOM,I5,2Xt2HlSr2X,A8/)
ATPl
058
11
CONT! rjUE
ATPl
059
WRITE(5»11MJ
ATPl
060
RETURN
ATPl
061
-------
36
NTY=NTPS
ATP1
062
LI (LL) = IDKFO(NTY)
ATP 1
063
IDT=1PASS
ATP1
064
NDAILL)=KNALB
ATP1
065
ILB=IDJB(LL|JB)
ATP1
066
IF{NTY-ILO) 65•40» 65
ATP1
067
40
IF(LL-3)86,41,41
ATP 1
068
41
IF C ISVt LL) )42,42,86
ATP 1
069
42
LI (LL)=KNALB
ATP1
070
GO TO 86
ATP 1
071
85
NFLAG = NFLAG+1
ATP1
072
NDA(LL)MDKFOUtB)
ATP1
073
IZ=IZ+1
ATP 1
074
86
CONTINUE
ATP1
0 75
IFUZ) 88,88,87
ATP1
076
87
IDT = I FAIL
ATP1
077
88
rtiUTE(MX,703) J, JB.MJl J) »(ISV(LL) tLMLLJ, NDA(LL) ,LL=I,3) ,IDT
ATP1
0 7tt
703
FGKMAT(9H0EUUATiriN,I5.2X7H0F TYPE,2X12,2XA4,
ATP1
079
13(3X,IH(,12,1H,,2A4,1HI,4X) , IX,A4)
ATP I
080
RETURN
ATP1
081
END
ATP1
082
-------
SUBROUTINE BCGH
BCGH
017
READ(9'N)Kl,G2,KF0
BCGH
018
KF=KFO(1)
BCGH
019
GO T0«11,12,13t12),KF
BCGH
020
11
WRITEJMX,20)
BCGH
021
return
BCGH
022
12
BG(N)=SUL t K)
BCGH
023
CE(N)=0.0
BCGH
024
WRITE(MX,30)I,K,N,BG(N)tCElN)
BCGH
025
20
FORMAT(14H ERROR IN BCGH )
BCGH
026
GO TO 2
8CGH
02 7
13
CE1N)=S OL < K )
BCGH
02B
RGt N)=0.0
BCGH
029
PRINT 30,I,K,N»BG(N),CE(N)
BCGH
030
2
CONTINUE
BCGH
031'
DO 3 1=1iJMAX
BCGH
032-'
IF(KKK-1)4,4,5
BCGH
033
4
READ(9'I)IltGl,I2,G2»G3,KK1,AK1
BCGH
034!
GO TO 3
BCGH
03 5'
5
READ{9'I)Il,Gl,I2,G2,G3,KKl,AK1,
Al, A2
BCGH
036>
8
WRITE(MX,30)I,BG(I),CE{I)
BCGH
037^
30
FORMAT(14,2F15.5)
BCGH
036
3
IF(KKK-1)6,6,7
BCGH
039
6
WRITE!9•I)I It GitI2,G2,G3,KK1,AK1
,0G(I),CE(I)
BCGH
040:
GO TO 3
BCGH
041
7
WRITE!9*I)IL,G1,12,G2,G3,KKl,AKl
,Al,A2,BG( I),
CE(I) BCGH
042
3
CONTINUE
BCGH
043
I F( ICGN-1)16,14,16
BCGH
044
14
DO 15 JJ-1,JMAX
BCGH
045
READ(9« JJ)K1,G1,KF,G2,G3,KK1, 1AKKI >,1 = 1,23),
DD,AK3,SD,VD,B,C,G,H BCGH
046
READ(81 JJ)FAC,ZZ
BCGH
047
00=0.
BCGH
048
SD = 0.
BCGH
049
VD=0.
BCGH
050
G = 0.
BCGH
051
H = 0.
BCGH
052
FAC=0.
BCGH
053
zz=o.
BCGH
054
WRITE (9«JJ)K1 ,G1,KF,G2,G3,KK1, {AKKl )tl = lt23)
,DD>AK3,SOtVOrBtCfGtHBCGH
055
15
WRITE(8*JJ)FAC,ZZ
BCGH
056
16
RETURN
BCGH
057
END
BCGH
058
-------
SUBROUTINE BDOUT(IMAX,IDJ08,I DATE,ICOM)
REAL ID(41>,IDJOB,IDATE
REAL NJD(l),NJU(1>»JJS»JJE
DIMENSION PDEL(1),XJD(1>,XJU(1),AK1(8> tAK2(7),K2(4)
COMMON FACl,FAC2,FAC3,ITYPfc{35)
XMIfJ=lOOO.
XMAX=0.
NUM=0
1 = 1
MX=5
READ16'1)1D
IF(IC0N-4)2,2,l
1 00 29 JJ«1,[MAX
READ(9»JJ)KI,NJU,KF,NJD,G1, K2,XJU,AK1,XJD,AK2,PDEL
JJS=NJU(1)
JJE=NJD(1)
WRIT£(MX,21)
21 FORMATt•1•,40X,'COUPLED SYSTEM OF PREVIOUS 2 COMPONENTS')
WRITgl^X, 321 IDJOB, IDATE
32 FORMAT ( 10X,A8,2LXiJHCOMPUT£O 5XA8//1H0, 2X, 'SECT. • , 14X,
l'SECT.",15X,5HOIST.,15X 3HBOO,13X4HD.0 ,'DEFICIT',12X,«JUNCT
24X,'NO.',15X,'NAME',lfoX,•(Ml)•,14X,1(MG/L)',14X,*(MG/L)',17X,'
33X, • < , 14X, —
48(IN-))
113X,ll(lH-)f
22
23
24
25
26
27
28
29
4
5
6
7
20
33
34
8
NUM=NUM+1
READ(4'NUM)&l,BBX,Gl,DDX,G2,G3
BE$X=BBX + G2
0DX=DDX+G3
WRITE(4'MUM)GltBBX,Gl,DDX
IF(Gl-XJU CI) )23,25,23
IFIGl-XJDl1))24,27,24
WRITE(MX,201JJ,ID«JJ),G1»BBX,DDX
GO TO 22
WRITG
JJE=NJD(1)
WRITE(MX,30)I TYPE,IDJOB,IDATE
DELTA=l.0
IFIPDEL(I ) >5,5,4
DELT A=PDEL(I)
IF(XJU(I)-XMIN)6,6,7
XM[N = X JU(I)
CALL BDD3(JJ,XJU(IJ,BX,DDX,KF)
WRITE(MX,20)JJ,ID(JJ),XJU(1),BBX,DDX,JJS
FORMAT<1H0,I 5,16X,A4,F20.1,2F20.4,17X,A3)
NUM=NUM+ 1
IF(lC0N-4)34,33,34
READ(4'NUM)XJU,G1,XJU,G2
WRITE(4«NUM)XJUiBBX,XJU.DDX,Gl,G2
X JU(1)=XJU(Ll+DELTA
NUM=NUM+1
IFtXJUtl)~XJD(1))9,10,10
BDOUT000
BDOUTOOl
BDDUT002
BD0UT003
BD0UT004
BDOUT 005
BD0UT006
BD0UT007
B00UT008
B00UT009
BDQUT010
BD0UT011
BDOUT 012
BD0UT013
BD0UT014
BD0UT015
BDOUT 016
BD0UT017
BDOUT018
6D0UT019
ION'/ BD0UT020
,'ID'/BD0UT021
12X, BD0UT022
BD0UT023
BD0UTO24
BDOUT 025
BDOUTO°b
BDOUT 027
BD0UT028
BD0UT029
BDDUT030
BDUUr031
BD0UT032
BDOUT033
BDOUT 034
B00UT035
BD0UT036
BDOUT037
BDOUT038
BD0UTO39
BD0UT04C
BDOUT 041'
BD0UT0421
BDOUT 043
BDDUT044
BDOUT 045
BDOUT 046
BD0UT047
BDOUT 048
B00UT049
BDOUT 050
BD0UT05I
BD0UT052
BD0UT053
BDOUT 054
BDOUT055
BDQUT056
BDOUT 057
BD0UT058
BD0UT059
BDOUTO&O
BD0UT061
-------
9 CALL BOUO(JJ,XJU(1),BBX,ODX,KF) BD0UT062
WRITE(MX,20)JJ,[D(JJ),XJU(1),BBX,DOX BD0UT063
IF( IC0M-4J36,35,36 BDOUT064
35 REA0U,NUM)XJU,C.l,XJUtG2 BDOUT065
36 WRI TECf'NUMlXJUtBBX, X JU,l)DX, G1, G2 BD0UT066
GO TO 8 BDOUT067
10 IF(XJDll)-XMAX)12,12,11 BD0UT068
11 XMAX=XJD(1) BDOUT 069
12 CALL BODOt JJ,XJD( 1) »BBX,DDX,KF) B00UT070
WRITE(MX,20)JJ,IDX, ' (MI > • , l*X, • (MG/L ) • , l
-------
SUBROUTINE BODOtI»X»B8B»DDD»KF) BODO 000
DIMENSION FACm.ZZ(l) BODO 001
KsI 6000 002
READ(6'K)FAC»ZZ BODO 003
BBM=PFUN(K,X,l,1., I. ) BODO 004
YDIX=ZZ(l)+FACll)*BBM BODO 005
BBB = BBM + YBU*X) BODO 006
DDM*PFUN(K,X,l,2.,l.l BODO 007
IF(KF-4)1121 2 BODO 008
1 DDD=DDM+YDIX BODO 009
GO TO 3 BODO 010
2 l)DD=DDM BODO Oil
3 CONTINUE BODO 012
PRINT 10, I,X,BBM.YDIXtDOM,BBS,ODD BODO 013
10 FORMAT (5HOBOUO, 19, 6F16.^ ) BODO OH
RETURN BODO 015
END BODO 016
-------
SUBROUTINE BRIGH(LL,IS2,JMAX) &RIGHOOO
DIMENSION F0R(4l>,AA(l8),JBVm,ISA(l),ISBW(1)»0 f 3), K1 ( 4) BRIGH002
MY=2 BRIGHO03
MX = 5 BR1GH004
DO 99 J=1,JMAX BRIGH0C5
READ(9«J)L1,G1»K3,G2,G3,JBV,ISA,I SB,ISC,AA,XSA,XSB,XSC,W,QD,Glt BRIGH006
1BDO BRIGH007
IFU-D 15,15,16 BRIGH008
15 READ(10«1)F0R BRIGH009
16 JB=JBVILL) BRIGHOIO
I = ISA( LL ) BRIGHOU
X=XSA(LL) BRIGH0I2
L=MOSEC(I,IS2) BRIGH013
K =ISB(LL) BRIGH014
Y=XSB(LL) BRIGH015
M=NOS EC(K,IS2) BRIGHOI6
KK = I SC t LL > BRIGH0I7
Z=XSC(LL) BRIGHOld
N=NOSEC(KK,IS2) BRIGH019
READ(9'I ) 11 ,G1, I2,G2»G3,K1,AU,A2,A3,A4,A5,Q(II BRIGH020
READ(9,K)n,Gl,I2,G2,G3,Kl,AU,A2»A3,A4,A5,Q(2) BRIGH021
IF(KK)1H»18,17 BRIGH022
17 REAl)'9*KK)ll,Gl»l2»G2,G3»Kl,AU,A2,A3,A4,A5,Q(3) BRIGH023
CALL OUTLIST(BRIG) BRIGH024
18 GO TO (1,1,1,<~,*. 5, 5, fl, 9,10,11,11,13.131, JB BRIGH025
1 FOR ( J ) =YB ( K, Y >- YBd.X) BRIGHC26
GO TO 99 BRIGH027
4 FOR I J) = -Y3 ( I, X » BRIGH028
GO TO 99 BRIGH029
5 FOR(J) = W(1 )+«(,X)-U<2)*YB(K, Y ) BRIGH030
GO TO 99 BRIGH031
8 FOR(J)=W*YB(K,Y)-Q(3)*YB(KK,Z) BRIGH032
GO TO 99 BRIGH033
9 F0R(J)='wll)+Q(l)*YB(I,X)+Q(3)#YB(KK,Z)-Q(2)*YBCK,Y) BRIGH034
GO TO 99 BRIGH035
10 F0R(J)=QD*B00-Q(2)*YB(K,Y) 6RIGH036
GO TO 99 BRIGH037
11 FOR(J) =W ( 11 -Q(11*YR(I,X) BR 1GHO 38
IF(JB-11)99,99,12 BRIGH039
12 FORIJ)=FOR(J) —Q(2 )*YBfK ,Y> BR1GH040
GO TO 99 BRIGH041
13 FOR (J ) = Vg ( 1 ) +Q ( I > *YB( I , X) BRIGH042
IFIJ3-13)99,99,14 BRIGH043
14 FORIJ)=FOR(J)+0(2)*YBIK,Y) BRIGH044
200 FORMAT!7H0BRIGHT,215,EL2.2) BRIGH045
PRINT 200, J,JB,J=OK( J) f>R!GH046
99 WRITE{MX,200) J, J8,F0t< ( J) BRIGH047
99 CONTINUE BRIGH048
WRITE < 7•1}FOR BRIGH049
RETURN BRIGHOIO
END BRIGH051
-------
33
5
3
11
157
158
30
330
2
73
701
74
75
702
6
10
20
34
SUBROUTINE DATA1(MFLAG,NM,IDJOB,I DATE.I MAX,JMAX,IS2,K,I NO,I COM) DATA1000
REAL MI,^J(41), ICHJB( 14) ,NJU( IJ ,NJD(1) ,JNO< I) 0ATA1001
REAL IDJOB,IDATE,ID(41) , IOJ DATA1002
DIMENSION KFN(l),KF0<1),JIW(1),ISA11),ISB(I), DATA1003
1ISC<1),XJU(1) ,AREA( 1),RK<1),AK<1J,FF(L),Q(1),8D(1),WUC1),TIDE1(1),DArA1004
2XJD(1),AREAD(1),DK<1) ,E<1) ,TEMP(1),PR(1),HT(I),VOL( 1),POEL( 1) , 0ATA1005
3XSA(l),XSB,XSCU>,W(l),QD(L),nD(l),flDD(l),BL(l>,BCIl> DATA1006
COMMON FACl,FAC2,FAC.i, I TYPE { 35) DATA1007.
DATA IDHJD/'C 2D','C DNS'C DP',«C DC'.'M 2D*,,M DN','M DP*, DATA1008
1* M3DI*,•M3D2•,1M DM•.¦HCU •,•MCM2',«M1CM«,«M2CM«/ DATA10C9
MY=2 DATA1010
MX=5 DAT A1011
GO T0(33,34 ),K DATA1012
IF(ICOM) 5 , 9, 9 DATA1013
READ(MY , 3)IDJOB,I0ATE,IS2,1 SI,NN,I NO,ICON,FAC1,FAC2,FAC3»ITYPE OATA1014
GO TO 11 DATA1015
READJM'Y,3) IDJOB, IDATE, IS2,IS1,NN, IND.MOTH, FAC 1, FAC2,FAC3, ITYPE DATA1016
IC0N=4 DATA1017
FORMAT ,WU< H , riDEK I» , IDJ DATA 1032
WRITEIMX,20)NS2,J,KFN,AK = AO{1),DKI I),£(1),TEMPI I),DATA 1040
1PR( I),HT(I)iVOL(1)»POEL(I),10(11) DATA 1041
WRITE(NX,20 INS I,J.KFO(I),NJD(I),XJD( I),AREAOfI),OK(I),E(I), DATA1042
ITEKPtI),PRII),HT
-------
159 FORMAT(• INPUT JUNCTION CARD LI STINGVIX«27R, HT, VUL, PDEL
READ(MY * 50)I,JNO(J),J3V(J),1SA(J),XSA(J),I SB(J),XSB(J),ISC(J),
1XSC(J)»W(J),0D(J),DD(J),RDD(J),8L(J),HC(J)11DJ
WRITE<9«JJ)KFN,NJU,KFO,NJD,JNO,JBV,ISA,I SB,ISC,XJU,AREA,RK,AK,FF,
IQ,BD,KU, TIDE 1 ,XJ[),AREAD,DK,E, TEMP,PR,HT, VOL ,PDEL,XSA,XSB,XSC,rf,
2QD,DD»BCD,BL,BC
JB=JBV(J)
M 1 = IDHJB(JB)
READ(5•2)MJ
MJ{JJ J =M [
WRITE(5"2)MJ
WRITE(MX,60)IfJNO(J),JBV(J),ISA(J),XSA( J),I SB(J>,XSB(J),ISC(J),
IXSC(J)iW(J)» QO(J)»DD(J),BOD(J)»BL(J>,BC(J J,IDJ
50 FORMAT(1X I 2 » A3,13,31I 31F6.L),6F6.0,4X,A4)
60 FORMAT(LHO,14,LX,A3,15, 3(1X,1H(,I5,F8.2,1H),IX>,6F8.1,2XtA4/)
IF( IDJOB-1DJ) 7,8,7
7 WRITE(MX,330)JJ
NFLAG=NFLAG+1
8 CONTINUE
RETURN
END
DATAI062
DATA1063
DAT A1064
DATA1065
DAT A1066
DATA1067
DAT A1068
DATA1069
DAT A1070
DAT A1071
DATA1072
DATA1073
DATA1074
DATA1075
DAT AIO 76
DAT A10 7 7
DAT A1078
DATA1079
DATA1080
DATA108I
DAT A1082
DATA1083
DATA 1084
DATAI085
-------
SUBROUTINE DATAZlIMAX,JKAX,tS2,JBM)
REAL NJU,^JO.JNO
DIMENSION TEMU) ,KTMU) ,S( 1) ,V( 13 , SO IIJ
LOKdl iQ( 11 , ARE AO (1) » WOII) ,HT(1) »VOL ( 1> ,
2EI 1),BD(1),AREA(l)iTENPIl)rFFIl)fPK(l)
COMMON FAC1,FAC2,FAC3,ITYPEC35)
MY=2
MX=5
1 = 1
00 55 KK= I, /MAX
READ! 9' KK)KFM,NJU,KFO,tJJD, JNO, JBV, ISA, I
iQ,BO,WU,TIDEl,XJD,AREAD,DK,E,TEMP,PR»HT
2QD,DD,BDD,BL,aC
AK( I) = AK( I >*FACl**(TEf,P( I 1-20. J
DM I >=0K< I ) *FAC2'** ( T t£ M P ( I >-20. )
RK(I> = RMI>*FAC3**lTEMPtI 1-20.)
NRITE{9'KK)KFN»NJU»KFC»NJD»JN0»JBtf»ISA,
lQ,BD,lftU,TIDEl,XJO,AKtAD,OK,e,T£MP,PR,HT
2Q0,CD * EDO,BL,BC
C PRINT 2000,I,AK([),0MI),RK(I),TEMPII),
C 1WU< I ) »AHEAD{ 11 ,HT{ U,VOL( H,W( I J,QD{ I) ,
55 CONTIMUfc
CA=1.0/(5280.0**2)
CV = l./< 5280.**3>
CF = 3t>00.0*24.0/ 15280.**3)
CL=(1.0i:+6l /t62,4*t>2«0.*#3)
CM=12.0/39.3 7
DC 5 KK=I,JMAX
READ(9'KK1KFN»NJU»KF0jNJD, JNO,JBV,ISA,I
ia,BD,WU,TIDE I,XJD,ARcAO,DK,E,TEMP,PR,HT
2UD,CD,BOO,BL,BC
IF(KK-!MAX»60,60,70
60 AREA!I1=ARE A{I)*CA
Q( I )=U< I )*CF
WUII)=WU1I)*CL
AREAD1I)=AREAO(I)*CA
HT I I >=HTU >*CM
VOL(I)=VOL(I)«CV
70 H( U = «( U*CL
QDII)=QD(I)*CF
C PRINT 2000,I,AKlI1,OKII),RK(I),TEMP(1),
C iWUt I ) ,AREAI)< I ) ,HTU ) ,VOL! I ) ,M( |},QO(I] ,
2000 FORMAT!fcHODATAC.14, 3E14.2,1I £9.2)
WRITE(9' KK 1KfN,NJU,KFO, NJD,JNO, JBV i ISA,
10,BO, WD, T1 Del, X JD t ARE AU,DK,t, J"tMP,PR,HT
2QD,DD,BDDjBL »8C
5 CONTINUE
DO 32 KK= 1,I MAX
REA0(9*Kt\)Kl»Gl, 11, G2 , C,3, KTK, A , B , «K , AK. ,
TEMlI)=DK(I ) *FF(I)/(AK(I)-RK{t))
32 WR I TF. (8 • KK ) T tM
00 33 KK = 1,1 MAX
READ I 3'KK)A I
RE6D19* KK IKFN»G1»Il,G2,G3,KTM,A,ARcA,RK
1G,PR,HT
TEM(I)=0.
IF( KFrVM ) -1)33,31,33
31 AA = BD4 IJ/HTII 1
BB=DM IJ#UUl I 1*FF I I)/ IRK I I )*AREA (ID
TEM < 1 I = (AA+ PR( I }+-BBl/AK(I )
33 MR ITE(8'KK)A I, TEM
DO 1 KK = 1,I MAX
,VD<1)»RK(1),AK( 1),
KFN(l),W(l),wD(L»,
SO,ISC»XJU,AREA,RK,AK,FF,
,VOL.PDEL,XSA,XSB,XSC,rf.
ISB,1SC,XJU,AREA,RK,AK,FF,
»VOL,PUEL,XSA,XSB,XSC,H,
AREAI1},QtI),
DD11),BC11)
SBtISC,XJU,AREA,RKTAK,FF,
,VOL,POEL,XSA,XSB,XSC,W,
AREAlI),Q(I),
DDI U,BC4
DATA2055
DATA2056
DAT A2057
DATA205ti
DATA2059
DATA2060
DAT A2061
-------
c
c
1
10
20
20
READ(
READ (
lQtBDt
2QD»DD
TEM( 1
CALL
CALL
PRINT
PRINT
WRITE
10,BD,
20DtD0
WRITE
CONTI
FORMA
WRITE
FORMA
FORMA
l'JBV'
RETUR
END
J'KK)AI,A2
)'KK)KFN,NJU,KFO,NJD,JNO,JBV,ISA,I SB,ISC,XJU,AREA,RK,AK,FF,
,E(I),AK(I),SD(I),VD(I)
10,l,Q,RK(I),S(I ) ,V( I )
(9,KK)KFM,NJUtKFD,MJD,JNU,JBV,ISA,ISB,ISC,XJU,AREA,RK,AK,FF,
WU,TID6I,XJD,AREA0,0K,E,TEMP,PR,HT,V0L»PDEL,XSAf XSB,XSC,W,
,BDD,BL,bC,S,V,SL),VD
(8'KK)A1.A2.TEM
AU'L. & V 'WL/ » n I > w » w
,BDD,BL,bC,S,V,SL),VD
(8'KK)Al,A2,TEM
NUE
T(4H0SV0 15,7F17.6)
(MX,20)(J,J=I,JWAX)
T(IH1 8X4113)
T(•1',3BX,'SYMBOLIC DO
,2414/13X,2M4)
M
DEFICIT AMD BOD MATRIX • MX, • ROW •, 2X,
DATA2062
DATA2063
DAT A206^
DAT A2065
DAT A2066
DAT A2067
DAT A2068
DATA2069
DAT A2070
DATA2071
DAT A2072
DATA20 73
DATA2074
DAT A2015
DATA2076
DATA2077
DAT A207A
DATA2079
DAT A2080
DATA2081
0ATA2082
-------
SUBROUTINE DRIGHILL,IS2,JV!AX)
DIMENSION F0RIM),KH4),AAI'j>,BBll4),QDIl),DDIl),FF(3),QI3)
l'l)K(3), B (3 J, JHVl 1) , ISA! 1), I SB I 1) * ISC 11J * XS A( 1) . XSB {1), XSC1 1)
MY=2
MX=5
00 99 J=1»JMAX
READ!9•J)L1»G1,K3,G2»G3»JBV»ISA»I SB,ISC,BB,AI,A2,A3,A4,XSA,
1XSC.A5,QD,DD
JB=JBVILL)
1 MSAILL)
X=XSAILL)
L=NOSECtI»IS2)
K = I SB ILL )
Y=XS6ILL)
M=NOSEC(K,IS 2)
KK =ISC(LL)
Z = XSC(LL )
N=NOSEC(KK,IS2)
REAL)(9* I ) 11,G1, I2,G2,G3,Kl,Al,A2,A3,A4,FF ( 1) ,QC1) ,AA,DK( 1) ,
1A7.A8,V0L(1),BB,B(L)
READ! 9'K)I1,G1,I 2,G2,G3,Kl,Al,A2,A3,AA,FF(2 J,Q(2),AA,DKI 2),
1A7,A8,V0L(2),BB,B(2>
IF(KK)13,1H, 17
17 READ(9,KK)Il,Gl»I2»&2»G3,Kl»Al,A2,A3,A4,FF|3>tQI3)fAA»DKI3)
1A7,A8,VOL(3),BB,ttl3>
18 GO TO (1,1,1,4,5,5,5,5,5,10,11,12,13,14) , JB
1 FORIJ)=YnP(K,Y,l) -YDPI I,X,1)
GO TO 99
4 FORIJ)=-Yt)P(I,X,l)
GO TO 99
5 FOR IJ) = QI 1)*YDP11,X,1)- YDPII,X,^)+YDP(K,Y,4)
1- Ql2)~YDP(K,Y,I)
IF (JB-8)99,8,9
8 FORI J)=FOR( J)+YDP(KK,Z,4)-Ul(3)*Y0P|KK,Z,l)
GO T099
9 F0R(J)=F0R|J)+Q<3)*YDPlKK,Z,l)-YDPlKK,Z,4)
GO TO 99
10 FORIJ)= YDPIK,Y,4)-QI2)*YDPIK,Y,1)+QD( 1)*DDI 1)
00 C1)=001 1)
DDI1)=D0(1)
GO TO 99
11 FORI J)=YDP(I,X,4)-Q|1)*YDP(I,X,1)+FFI 2)*DKI 2)*BI 2)*VOL I 2)
GO TO 99
12 FOR I J ) = YDP I 1,X,4)-0I 1)*YDPI I, X, I) ~ FF I 3 ) *DK I 3 ) «B I 3 ) * VOL I 3 )
FORI J)=FOR(J)+YDPIK,Y,4)-U<1)*YOPIK,Y,1)
GO TO 99
13 FOR I J ) = ()( 1) *YDP 11, X, 1) -YDP I I, X, 4 ) + FFI 2) *DKI 2) *B I 2 ) ~VOLl 2)
GO TO 99
14 FORI J) = «(1)*YDP|I,X,1)-YDPI I,X,4)+ FF13)*DKI 3)*BI 3)*V0LI3)
FORIJ)=FCR(J)+UI2)*YDP(K,Y,1)-YDPIK,Y,4>
200 F0RMAT(7H0URIGHT,2I5,E12.2)
PRINT 2001J,JB,FOrtI J)
WRITF. I MX, 200) J, JB,FORI J)
99 CONTINUE
WRITEI7'2)F0R
RETURN
END
ORIGHOOO
, 'DRIGHOOl
,V3L(3)DRIGH002
0R1GH003
DRIGH004
DRIGH005
XSB, 0RIGH006
DRIGH007
DRIGH008
0RIGH009
DRIGH010
DRIGH011
DRIGH012
DRIGH013
0RIGH014
DRIGH015
0RIGH016
0RIGH017
A5,A6» DRIGH018
DRIGH019
A5,A6, DRIGH020
0RIGH021
DRIGH022
,A5,A6,DRIGH023
DR1GH024
DRIGH025
DRIGH026
ORIGH027
DR1GH028
DRIGH029
DRIGH030
DRIGH031
DR1GH0 32
DR1GM033
DRIGH034
DRIGH035
DRIGH036
DR1GH037
DRIGH038
DRIGH039
DR1GH040
DRIGH041
DRIGH042
DRIGH043
DRIGH044
DRIGH045
DR1GH046
DRIGH047
DRIGH048
DRIGH049
DRIGH050
DRIGH051
DR1GH052
DRIGH053
DRIGH054
DRIGH055
OR IGH056
-------
SUBROUTINE 1ST(LLL,KK,KKK,N) LST OOO
DIMENSION A(41),B(41) LST 001
MX=5 LST 002
I=N+1 LST 003
IF!KKK-1)9,20,20 LST 004
20 IF(LLL-3)21,22,22 LST 005
21 MMM=L LST 006
GO TO 23 LST 007
22 MMM = 2 LST 008
23 IF(KKK-l)24»2A,25 LST 009
24 GO T0(1,3,5,7),LLL LST 010
1 WRITE!^X,2) LST Oil
2 FORMAT!»l',51X,•INITIAL BOD MATRIX') LST 012
GO TO 10 LST 013
3 WRITE(MX,4) LST 014
4 F0RNAT!////50X, ' INVERTED BOD MATRIX') LST 01-5
GO TO 10 LST 016
5 WRITE!MX,6) LST 017
6 FORMATl'l'.48X,'INITIAL DO DEFICIT MATRIX') LST 018
GO TO 10 LST 01.9
7 WRITE(MX,8) LST 020
8 FORMAT!////47X,'INVERTED DU DEFICIT MATRIX'.). LST 021
10 WRITE(MX,1000)(J,J=1,N) LST 022
DO 1001 1=1,N LST 023
READ(MMM'I)! A ! J ),J=1,N) LST 024
1001 WRITEtMX,2000)1,(A(J),J=1,N) LST 025
1000' FORMAT! /4X.9I13/) LST 026
25 GO T0(11,14,11,14),LLL LST 027
11 WRITE(MX,12) LST 028
12 FORMAT(/' FORCING FUNCTIONS'/) LST 029
GO TO lfc LST 030
14 WRITEl^X,15) LST 031
15 FORMAT!/' SOLUTIONS FOR UNKNOWN COEFFICIENTS'/) LST 032
16 READ! KK 1 M.MM) ! B! J J , J = I ,N ) LST 033
WRITEIMX.2000)I,(tt(J),J=l,N) LST 034
2000 FORMAT!t3,1X,9E13.5/(4X,9E13.5)) LST 035
9 RETURN LST 036
END LST 037
-------
SUBROUTINE MATNV (ILL,N,M,KKK,KK)
DIMENSION IPV0TI41),A(41),B(41),INDEX(41,2),PIVOT(41),C(10,41)
DETRM=1•
I ND=0
MX=3
I JK= 1
LJK=LLL
DO 20 J = 1,N
20 IPVOT(J)=0
READ(KK*KKK)(C(l,J),J=l»N)
18 DO 550 1=1,N
10 WRITE(3,1)I
1 FORMAT(15)
GO TO 380
110 IPVCT(ICDLM)=IPVOT(ICOLM)+l
INTERCHANGE ROWS TO PUT PIVOT ELEMENT ON DIAGONAL
130 IF (IROW-ICOLM)140,260,140
140 DETRM=DETRM*(-1.)
READ(LLL'IROW)A
READ(LLL•ICOLMJB
150 DO 200 L = 1,N
160 SWAP=A(L)
170 A(L>=B(L)
200 B ( L ) = S W A P
WRIIE(LLL *I ROW)A
WRITE(LLL•ICOLMJB
205 IF(M) 260, 260, 210
210 DO 250 L = 1, M
220 SWAP=C(L,IROW)
230 C(L,IROW)=C(L,ICOLM)
250 C(L,ICOLM)=SWAP
260 INDfcX (1,1)=I ROW
270 INDEX(I,2)3 ICOLM
310 IF(I-N)111,550,550
111 READ(LLLMCflLM) A
PIVOT(I)=A(ICOLM)
320 DETRM=DETRM*PIVOT(()
DIVIDE PIVOT ROW BY PIVOT ELEMENT
330 A(ICOLM)=I.
340 DO 350 L-l , N
350 A(L)=A(L)/PIVOT(I)
WRITEILLL'ICOLM)A
355 IF(M) 360, 380, 360
360 DO 370 L = 1,M
370 C(L,ICOLM)=C(L,ICGLM)/PIVOT(I)
IND=IND+1
IFCIND-1)380,380,>50
REDUCE NON-PIVOT ROWS
SEARCH FOR PIVOT ELEMENT
380 AMAX=0.0
DO 105 J= 1, N
READ(LLL'J ) A
IF CIND-1)82,40,82
82 IF(1-1)31,31,40
MATNVOOO
MATNV001
MATNV002
MATNV003
MATNV004
MATNV005
MATNVOOb
MATNV007
MATNVOba
MATNV009
MATNVOLO
MATNVOll
MATNV012
MATNVOI 3
MATNVO14
MATNV015
MATNV016
MATNVOl7
MATNVOI 8
MATNV019
MATNVOLO
MAT-NV021
MATNV022
MATNV023
MATNV024
MATNV025
MATNVn?6
MATNV027
MATNV028
MATNV029
MATNV030
MATNV031
MATNV032
MATNV033
MATNV034
MATNV035
MATNV036
MATNV037
MATNV038
MATNV039
MATNVOLO
MATNV04I
MATNV042
MATNV043
MATNV044
MATNV045
MATNV046
MATNV04 7
MATNV048
MATNV049
MATNV050
MATNV05I
MATNV052
MATNV053
MATNV054
MATNV055
MATNV056
MATNV057
MATNV058
MATNV059
MATNV060
MATNV061
-------
40
IF5,5»6
MATNV062
5
READ(LLL' ICOLM)B
MATNV063
6
IF(J-N)21 414
MATNV0&4
2
JNU=J+1
MATNV065
FIND(LLL¦JNU)
MATNV066
4
IF( J-ICOLM)400» 31,400
MATNV067
400
T=A(ICOLM)
MATNV068
A105
MATNV075
32
IF ( ipvon J )-l)60, 105,60
MATNV076
60
DO 100 K=1,N
MATNV077
IF(IPVOT(K)-1)80,100.33
MATNV078
33
I JK = 2
MATNV079
GO TO 105
MATNV080
80
IF (ABS(AMAX)-ABSIA(K))J 85.100,100
MATNV081
85
JROV»=J
MATNV082
jcolm=k
MATNV083
95
AMAX=A(K)
MATNV084
100
CONTINUE
MATNV085
105
WRIT:(LLL'J)A
MATNV036
24
IF(I JK-1)34,34,760
MATNV087
34
I.RaVi = JROU
MATNVC28
ICOLM=JCOL M
MATNV069
IF(INO-l)110,560,110
MATNV090
560
INU = 2
MATNV091
GO TO 110
MATNV092
550
CONTINUE
MATNV093
HATNV094
INTERCHANGE COLUMNS
MATNV095
MATNV096
WRITEIKK'KKK)(CI 1.J)»J=1»N)
MATNV097
19
Ml-1
MATNV098
Nl= 10
MATNV099
JJ1=10
MATNV100
1F(N1-N)9,9,16
MATNV101
16
N1 = N
MATNV102
J J1 = N
MATNV103
9
11=0
. MATNV104
DO 3 K=M 1,N1
MATNV105
REAO(LLL'K)A
MATNV106
11=11+1
MATNV107
DO 3 J1= 1, N
MATNV108
3
C(I1«J1)=A(J1)
MATNV109
600
DO 710 I=1,N
MATNV110
610
L = N+1- I
MATNV l'l1
620
IF'(INDEX1L,l)-IN0EX(L,2)) 630, 710, 630
MATNV112
630
JROW = [ Nl)E X ( L , I)
MATNV113
640
JC0LM=INDEX(L,2)
MATNV114
650
DO 705 K=l,JJl
MATNV115
660
SKAP=C(K,JROW)
MATNV116
670
C(K,JROW)=C(K,JCOLM)
MATNV117
700
CJK,JCCLM)=SWAP
MATNV118
705
CONTINUE
MATNV119
710
CONTINUE
MATNV120
LLL=LJK
MATNV121
1=0
MATNV122
11
DO 14 K = M1,N1
MATNV123
-------
1=1+1 MATNV124
DO 12 J 1 = 1»N MATNV125
12 A{J1)=C(ItJl) MATNV126
14 WRITE(LLL'K)A MATNV127
IF(fJl~N)21»760»760 MATNV 128
21 M1=M1+10 MATNV129
N1 = NH-10 MATNV 130
IF(N1-N)9,9,22 MATNV131
22 JJ1=N-N1 MATNV132
N1 = N MATNV133
GO TO 9 MATNV134
760 RETURN MATNV135
END MATNV136
-------
SUBROUTINE MATS(KL,K2,KB,K4,mm,IS2,JMAX,IND) HATS OOO
OIMENSIQM TM(41),Q(3),V0L(3),TIDE1(3),ARK(3),JBV(1),ISA<1), HATS 001
lXSA(l),lSftll)fXSB(l),ISC(l),XSC(l)*SD,A3,A4,Q(2),A5,A6,TIDE1(2),MATS 028
1AA,VOL(2) MATS 029
IF ' KK ) 26 , 26 , 2 7 MATS 030
27 READ(9«KK)I1,G1,I2,G2,C3,M1,A1,A2,ARK(3>,A3,A4,y<3),A5,A6, MATS 031
ITIDElt 3),AA,VOL(3) MATS 032
GO TO 26 MATS 033
25 READ(9'1)I 1,G1,I 2,G2,G3,Ml,A1,A2,A3,ARK(1),A4,Q(1),A5,A6,TIDE1<1),MATS 034
1AA,VOL(1) MATS 03*
READ(9'K)11« G1,I 2,G2,G3,Ml,A1,A2,A3,ARK(2),A4,U(2),A5,A6,TIDE1<2),MATS 036,
1 AA, VOL ( 2 ) MATS 037.
IF(KK J 26,26,21 MATS 038
21 READ(9,KK)I1,G1,12,G2,G3,M1,A1,A2,A3,ARK(3),A4,Q(3),A5,A6, MATS 039
ITIDElt 3),AA,VOL(3) MATS 040
26 GO T0< 1,2,3,4,5,6,7,3,9,10,11, 12, 13,14) ,JB MATS 041s
1 TMIIM)=PFUN(I»X,Kl,SD,VD) MATS 042
TM(L)=PFUN(I,X,K2,SD,VD) MATS 043
TM(KM)=—PFUN(K»Y,K1,SD,VD) MATS 044
TM(K)=-PFUN(K,Y,K2,SD,VD) MATS 045'
GO TO 99 MATS 046
2 TM(L )=PFUN(I,X,K1fSD»VD) MATS 047
T M( KM )=-PFUN(K,Y,K1,SD,VD) MATS 048
TM( M )=-PFUN(K,Y,K2,SD,VD) MATS 049
GO TO 99 MATS 050
3 TM(1M)=PFUN(I,X,K1,SD,VD) MATS 0^>1'
TM(L>=PFUN(I,X,K2,SD,VD) MATS 052
TM(M)=-PFUN(K,Y,K2,SO,VD) MATS 053
GO TO 99 MATS 054
4 TM(IM>=PFUN(I,X,K1,S'D,VD) MATS 055
TM(L)=PFUN(I,X,K2,SD,VD) MATS 056
TM(M)=-1•0 MATS 057
GO TO 99 MATS 058
5 TM I IM)=PFUN
-------
TM(M )
=Q(2)«PFlW(K,Y,K2,SD,VD>-PFUN(K,Y,K4fSDtVD}
MATS
062
GO TO
99
MATS
063
6
TM(L)=
PFUN(I, X, K 3 » SD,VD)-Q(l)*PFUN(I ,X,Kl,SD.VD)
MATS
064
TM{ KM
)=Q<2 >*PFUN(K,Y,Kl,SP,VD)-PFUN(K,YtK3,SDfVD)
MATS
065
TM( M
)=Q(2)*PFUN(K,Y,K2,SU,VD)-PFUN(K,Y,K4,SD,VD)
MATS
066
GO TO
99
MATS
067
7
TM(1M)
=PFUNCI,X,K3,SD,VD)-Q(L>*PFUN(I,X,K1,SD,VD)
MATS
068
TM(L)=
PFUN( I , X,K4,SD,VD)-311)*PFUN( I , X,K2,SD,VD )
MATS
069
TM(M
)=Q(2)«PFUi\l(KfY,K2f SD,VD)-PFUNl<,Y,K4,SD,VD)
MATS
070
GO TO
99
MATS
071
e
TM( IM
)=PFuN(I,X,K3,SD,VD)-Q(1)*PFUn-PFUN(K, Y,K4,SD,VD)
MATS
0 75
28
TM( n
) = Q(3)*PFUN{KK,Z,K2»SD»VD)-pFUN(KK,Z»K4tSD,VD)
MATS
07^6
TM(KKM
)=Q( 3)*PFuN(KK, Z,Kl, SD, VD)-PFUrg( KK, Z, K3, SD, VD )
MATS
077
GO TO
99
MATS
073
9
TM ( IM
J=PFUN(I,X,K3,SO,vO»-Q(ll*PFUN(I,XtKl,SD,VO)
MATS
079
TM (L
)=PFUN(I,X,K4,S0,VD)-U(L)*PFUN(I,X,K2,SD,VD)
mats
080
tm(km
)=Q(2)*PFUN(K,Y,K1 ,SL>, VD)-PFUN(K,Y,K3,SD,VD)
MATS
oei
TM(M
)=Q(2)*PFUN(K,Y,K2,SD,VD)-PFUN{K,Y,K4,SD,VD)
MATS
082
29
TM(KKM
)=PFUN(KK,Z,K3,SDfVD)-Q(3)*PFUN(KK,Z,Kl,SO,VD)
MATS
083
TM (N
)=PFUN«KK,Z,K4,S0,VD)-Q(3)*PFUN(KK,Z,K2,SD,VD)
MATS
08'4
GO TO
99
MATS
085
10
TM {KM
)=Q(2),VD)-PFUN-0<1)*PFUN(I,X,KI,SD,VD)
MATS
106
TM( L
)=PFUN(I,X» K4,SD,VD)-U(I)*PFUN(I,X,K2,SD,VD)
MATS
107
TM (KM
)=PFU.N(K, Y,K3, SD,VD)-9(2 )*PFU.M,VD)-Q(2)*PFUN(K, Y,K2,SD, VD )
MATS
109
TM(N)=
0(3)+V0L(3)*(TIDEI(3)+ARK(3))
MATS
110
99
WRITF(MM•NN)TM
MATS
111
RETURN
MATS
11*
END
MATS
113
-------
SUBROUTI NE MEMS IJMAX tKKiLL > OOO
DIMENSION AUl)tBUl),CUn 001
J=1 M£MS 002
READ! 7*KK )B M£!
R£AD(LL*I)A M6MS 005
HEMS 006
DO 1 K=1* JMAX M£MS 007
1 S=S+AIK>*B
-------
FUNCTION NQSECtIL.IS2I NOSECOOO
IF(Il-lS2ll,l,2 NOSECOOl
1 NDS EC=2*IL NQSEC002
RETURN N0SEC003
2 NOSEC = 2*IS2-M IL-IS2) NOSECOOO
RETURN N0SEC005
END NDSEC006
-------
FUNCTION PFUN17,17,18
PFUN
004
17
READ (9' J)KFN,G1,KF0,G2,G3,K1,A1, AREA, RK, A2» A3,A4,A5»WU,A6,XJD,
PFUN
005
lAREAO,A7,E,Bfcl,SSO,VVD,A8f A9,6,C
PFUN
006
GO TO 19
PFUN
007
18
READ(9,J)KFN,Gl»KF0,G2tG3,Kl»Al»AREA»RK»A2»A3tA4,A5,WU»A6,XJD,
PFUN
008
iAREAD,A7,E,3B,Aa,A9,SSD,VVD,A10,All,B,C
PFUN
009
19
IF(DEF)2,2,3
PFUN
010
2
L=K
PFUN
Oil
IF(K-5)9,9,1
PFUN
012
1
L=K—4
PFUN
013
9
KF=KFN(I)
PFUN
014
GO TO (10,20,30),KF
PFUN
015
10
Y=l.
PFUN
016
GO TO 111,12,13,14,15,16) ,L
PFUN
017
11
PFUN = EXP (XfSSDII))/Y
PFUN
018
PRINT 200,K,KF,I,X,SSD(I), PFUN
PFUN
019
200
FORMAT(I 5,4F12•2)
PFUN
020
GO TO 4
PFUN
021
12
PFUN = EXP (X+VVD(I))/Y
PFUN
022
PRINT 200,K,KF, I ,X,VVl)( I ) ,PFUN
PFUN
023
GO TU 4
PFUN
024
13
PFUN = WUU)/(AREAU)*RK( I ) )
PFUN
025
GO TO 4
PFUN
O.'Zi
14
PFUN=SSD(I)*gXP (X*SSD{I))*E CI)«AREA
-------
22 L-K+1 PFUN 062
ASUM=PFUN*BI 1) PFUN 063
GO TO 9 PFUN 064
23 PFUN=PFUN*C(1J+ASUM PFUN 065
30 RETURN PFUN 066
END PFUN 067
-------
SUBROUTINE PLAC1
PLAC1017
GO TO 14
PLAC 1018
12
KS=ISC(JJ)
PLAC1019
14
IF(KS> 4.4,1
PLAC1020
1
IS=2*KS
PLAC102I
IFIIS-IS2M) 2,2,3
PLAC1022
2
L1NE ( I S ) -= J
PLAC1023
11NE( IS — 1) = J
PLAC1024
GO TO 4
PLAC1025
3
I S= 1S2 + KS
PLAC1026
LINEfIS)=J
PLACL027
4
CONTINUE
PLAC1028
WR[TE(MX,30)KK,JBV(J J I, (LINE( I ), 1 = 1,JMAX>
PLAC1029
30
FORMAT(1H0,2I5,2X,24( 1XA3)/I3X,24(IX,A3))
PLAC1030
30
FORMAT*1H0,214,40A3)
PLAC1031
6
CONTINUE
PLAC1032
RETURN
PLAC1033
END
PLAC1034
-------
SUBROUTINE PR 1(K,I MAX,JMAX,10J0B,I DATE,NK)
PR I
000
REAL MI(41),10(41),NJU(1J,NJO(1),IDJOB,I DATE,JMO(I)
PR1
,001
DIMENSION KFN (1),KFO(1)» JBV(I),ISA(1),I SO(1),
PRl
002
1ISCI L),XJUC1),A«nA(1),RK(1),AK(1),FF(1),Q(1),BD(1),WU(1),TI DEI(I)
, PR1
003
2XJD( 1 ) , ARE AO ( 1>,DK<1>,E<1),TEMP(1J,PR(1),HT(I > , VOL ( 1) , POEL (1 > ,
PR 1
004
3XSA(1),XSB(I),XSC(1>,W<1>,01M 1),DD(1),BDD(1),BL(1),BC(l)
PR 1
005
DIMENSION S(l),V(l),SI)(l)tVD(l),B(l),C(l),G(l),H(l)
PR1
006
COMMON FAC1,FAC2,FAC3,ITYPE(3S)
PRl
007
READ(6'1)10
PR1
008
MY=2
PRl
009
MX=5
PRl
010
GO T0<5,6,7),K
PR 1
Oil
5
IF(MK)6,8,9
PRl
012
8
WRITE(MX,14)I TYPE,IDJOB,IDATE
PRl
013
14
FORMAT(•1*,42X,35Al/' MODEL RUN A8,' COMPUTED',2X,A8,2X,
PRl
014
130HDATA GIVEN IN ORIGINAL UNITS/)
PRl
015
GO TO 11
PRl
016
9
WRITE(MX,15)ITYPf,lDJ06tIDATE
PRl
017
15
FORMAT('l,,42X,35Al/' MODEL RUN ',A8,2X,•COMPUTED',2X,A8,2X
PRl
018
1'DATA GIVEN IN COMPATIBLE UNITS'/)
PRl
019
11
WRITE(MX,10)
PRl
020
READ(5"1)MI
PRl-
021
1 = 1
PRl
022
DO I J=1,IMAX
PRl
023
READ19'J)KFN,NJU,KF0.NJD,JNO,JBV,ISA,I SB,1SC,XJU,AREA ,RK,AK,FF,
PRl
024
10,BD,WU,Tlt)El,XJD,AREAD,DK,Ef TEMP,PR,hT, VOL,PDEL,XSA,XSB,XSC,W,
PRl
025
20btdd»bod,bl,bc
PRl
026
10
FORMAT(///5X7HStCTlON,4H KFN,4H KF0,2X,'JUNCTION ID AND DISTANCE'
, PR 1
027
112X.2HRK,8X2HAK,8X2HDK,9XlHE»aX2HFF,6X.4HTEMP3X,'PDEL'/23X,'ATS
PRl
028
2' ENDS',20X,'REM.RATE RtA.RATE DEO.RATE DISP.RATE
PkI
029
3' ULT/5DAY ',4X,' MILE~INCR•/56X,1 IL/DAY)',3X,'(1/DAY)',3X,
PRl
030
'i • {1/DAY) ' ,2X, • '/)
PRl
031
1
WRITE(MX,20)J,I 0(J),MI(J),KFN(I)»KFO(I),NJDCI),XJD(11,NJU(I),
PRl
032
lXjU(I),RK(I),AK(n,UK(I),E(I), FF21,21,23
PRl
041
21
WRITE(XX,22)
PRl
042
22
FORMAT( 17X, ' (FT**2)',4X,'(FT**2 >«,7X,'(CFS)•, 3X,'(GMS/M2-DAY)*,
PRl
043
12X, »(MG/L-DAY) ' , 16X, •(FT.)«,3X,'(FT**3) 4X, • 1 LBS/DAY-MI ) • )
PRl
044
GG TO 16
PRl
045
23
WRITEI MX,24)
PRl
046
24
FORMAT(17X,'(Ml**2)*,4X,*(MI**2)«4X,'(MI**3/DAY)',2X,
PRl
047
1' (GMS/M2-DAY) ' ,2X,' ( MG/L-DAY) * , 1 5 X , • (MTRS)',2X,' (M I *»3>•,8X,
PRl
048
2'(MG/L)•)
PRl
049
16
DO 2 J=l, IMAX
PRl
050
READ(9< J )KF!M,NJU,KFO,NJO,JNO,JBV,ISA,I SB, ISC,XJU,AREA,RK, AK.FF,
PRl
051
lQ,BD,h'U,T I DEI, XJD, ARE AD, DK,E, TEMP, PR, HT, VOL, PDELiXS A, XSB,XSC,W,
PRl
052'
2Q0,00,BDD,BL»[iC
PRl
053
2
WRITE
-------
lQ,BD,WU,TIOEl,XJD,AREAD,DK,E,TEMP,PR,HT,VOL»PDEl,XSA,XSBfXSC,Wf
PR1
062
2QD,DD,BDD,BL,BC,S,V,SO,VD,B,C,G,H
PR I
063
READ(8•I)FAC,ZZ,U
PR I
064
50 F0RMAT(///'i>X7HS5CTI0N,8X»LHU»9XLHS,9XlHV,8X2HSD,
PR L
065
18X2HVD,9XLH3,9XIHC,9XLHG,9XLHH,5X3HFAC6X2HZZ/)
PRL
066
3 WRITE(MX,60>I,ID(I),MI(I),U,S(L>,V(1),SD(I) , VD<1),B(L),C(I) ,
PRL
067
IG(L),H(L),FAC,ZZ
PR1
068
60 FORMAT(1HO,1211XA4,1XA4,9F10.5,2F8.2)
PR1
069
RETURN
PR1
070
7 WRITE(MX,70)
PR1
07 L
70 F0RMAT(/lH05X8HeQUAnGN,4X, 'JUNCTION 10, SECTIONS ' »4X,
PRL
072
117X1HW,13X2H0D,L0X2H0D,9X3HB0D/18X,'MEETING AT •,
PRL
073
2'JUNCTION,',L9X,'PT-LOAD',7X,'FLOW-DAM',5X,•OEF-DAM',4X,•BOD-DAM'
)PiU
074
IF,XSC(J),W(J),QD(J),DD(J),BDD(J)
PRL
090
80 FORMAT(1H0,I 2,13,IXA4,1XA3,1X,3(1H(,13,F5.1,1H)),6XF12.5,3X,
PRL
09L
13F12.5)
PRL
092
RETURN
PRL
093
END
PR1
094
-------
SUBROUTINE SVD(U»EtA.S#V) SVD OOO
IFIU) 2ti»2 SVD °01
S=SURT U/E) SVD 002
V=_S SVD 003
RETURN SVD 004
SQ=SQRT
-------
FUNCTION YB tI »X)
YB
000
DIMENSION KII4) ,AREAC U,KFNI l),«K< l),WlM 1J
YB
001
READ!9*1)KFN,G1,I2,G2»G3,KI,A1,AR=A,RK,A2,A3»A4»A5.WU
Y8
002
MX = 5
YB
003
KF=KFN(11
YB
00 ,Vt I )tCC tY8B
YB
014
RETURN
YB
015
33
WRITEtMX,100)1
YB
016
100
FORMATt«0 ERROR IN YB, I - • T IS )
YB
017
RETURN
Y6
018
END
YB
019
-------
FUNCTION YDPU.X.K) ™P 000
DIMENSION FACI1)*£Z(1> V°p 001
READ!8'I)FAC t ZZ r0P 002
IFIK-1U, 1,2 ™P 003
1 YDP=FAC(l)*PFUNtI»X»K»l.»L.)+ZZ(l) YDP
XXXXX = FACU> *!?P 005
YYYYY=ZZ(L) ™P 006
GO TO 3 YDP °0'
2 YDP = FAC(l)*PFUN(I,X,K,l.f 1.) Y0P 008
3 RETURN n?o
END Y0P 010
------- |