Initial Mixing Characteristics of Municipal Ocean Discharges Volume II. Computer Programs


unueu oldies
Environmental Protection
Agency
Research and Development
environmental nesearcn
Laborarory
Narragansett Rl 02882
erA/ ouu/ j-dD/ u /c
November 1985
Initial Mixing
Characteristics of
Municipal Ocean
Discharges:
Volume II.
Computer Programs

-------
EPA-600/3-85-073b
November 1985
INITIAL MIXING CHARACTERISTICS OF MUNICIPAL OCEAN DISCHARGES
VOLUME II - COMPUTER PROGRAMS
by
W.P. Muellenhoff, A.M. Soldate, Jr., D.J. Baumgartner
M.D. Schuldt, L.R. Davis, and W.E. Frick
PACIFIC DIVISION
ENVIRONMENTAL RESEARCH LABORATORY, NARRAGANSETT
OFFICE OF RESEARCH AND DEVELOPMENT
U.S. ENVIRONMENTAL PROTECTION AGENCY
NEWPORT, OREGON 97365

-------
The information in this document has been funded by the United States
Environmental Protection Agency Office of Research and Development, and
the Office of Marine and Estuarine Protection through contract numbers
68-01-5906 and 68-01-6922 to Tetra Tech, Inc. Agency Project Officers
for these contracts are Dr. John Pai and Mr. Barry Burgan, respectively.
The report has been subject to the Agency's peer and administrative review,
and it has been approved as an EPA document.
11

-------
FORWARD
A portion of this document is based on an earlier version by A.M. Teeter
and D.J. Baumgartner (1979), which it supersedes. The technical reviews
and resultant suggestions of A.R. Agg, W.A. Faisst, Irwin Haydock and P.J.
Roberts resulted in many improvements and arj gratefully acknowledged.
We are also thankful to S.J. Wrignt, V.H. Chu, and other scientists who
have indirectly contributed to the report in the form of fruitful dialogue
during its development. Their continued inputs are encouraged, and will
ensure timely publication of addenda and further improvements in future
editions.
W.P. Muellenhoff is the Director, Corvallis Office, Tetra Tech, Inc.,
and A.M. Soldate, Jr. is a Senior Scientist in Environmental Systems Engineering
at Tetra Tech, Inc., Bellevue, WA. D.J. Baumgartner, M.D. Schuldt, and
W.E. Frick are with the U.S. Environmental Protection Agency, Pacific Division
(Newport, OR). L.R. Davis is Professor, Mechanical Engineering Department,
Oregon State University.
Users of this document or the models described herein are encouraged
to report any errors to enable appropriate corrections to be made. Direct
all correspondence to D.J. Baumgartner, U.S. Environmental Protection Agency,
Hatfield Marine Science Center, Newport, Oregon 93765. Holders of the
document should notify the above to receive errata or future revisions
to the document.
111

-------
ABSTRACT
This report (Volume II) contains a description of the Universal Data
File and complete program listings of five mathematical models that provide
flux-average dilution and rise-height of a wastewater pluine discharged
into waters of greater density. The companion report (Volume I) contains
analytical solutions and detailed descriptions of the models. Guidance
is provided for the range of values within which the analytical solutions
provide acceptable estimates. Use of the models is recommended for conditions
outside these ranges and for detailed analysis.
Volumes I and II are available in hardcopy from the National Technical
Information Service (5285 Port Royal Road, Springfield, VA, 22161; 703-487-
4650). Volume II is also available from NTIS on a 9-track tape or diskette
(703-487-4763). The IBM-PC compatible diskette has the programs slightly
altered to compile using Microsoft FORTRAN (Version 3.1 or higher) or IBM
Personal Computer Professional FORTRAN (8087 or 80287 chip required).
iv

-------
CONTENTS
Page
Forward	iii
Abstract	iv
SECTIONS
1.	Universal Data File	1
2.	UPLUME Listing	4
3.	UOLFTPLM Listing	22
4.	UDKHOEN Listing	.	38
5.	UMERGE Listing	72
6.	ULINE Listing	89
v

-------
SECTION 1
Universal Data File
i

-------
UNIVERSAL DATA FILE (UDF) "CARD" DECK
THE DATA ENTERED ON CARDS Z THROUGH 7 HAY BE EITHER IN THE
FORIUT REQUIRED BY EACH CARD OR EACH VALUE ON THE CARD HAY
BE SEPARATED BY A COMMA (SHORT FIELD TERMINATION).
AN EXPLICIT DECIMAL POINT OVERRIDES THE FIELD DESCRIPTOR*
CARD 1 FORMAT(10A8)
IDENTIFICATION OF A 3ATA SET WITHIN THE UDF.
CARD 2 FORMATC8I2)
INTER *1 INTERACTIVE CONTROL OF CARDS 3 AND 4 PARAMETERS.
*0 "SINGLE" RUN USING PARAMETERS IN DATA SET ONLY.
IDFP »1 PRINT "CARD IMAGE" OF DATA SET.
»0 DO NOT PRINT CARD IMAGE OF DATA SET.
IGJTOP «1 USE OPTIONAL CARD 5 TO CHANGE CONTROL PARAMETERS FROM
THE DEFAULT VALUES.
*0 DO NOT F.EAD A CARD 5 (THUS CARD 5 WST BE OMITTED).
IPI	INPUT PRINTOUT CONTROL FOR UPLUME
101	"	UOUTPLM
IDI	"	UDICHDEN (SEE NOTE 1)
IMI	"	UMERGE
ILI	"	ULINE
IPO*IPI	OUTPUT PRINTOUT CONTROL FOR UPLUME
IOC^IOI	"	UOUTPLM
IDiKIDI	"	UDICHDEN (SEE NOTE 1)
IMO=IMI	"	UMERGE
ILCMLI	"	ULINE
FOR EACH OF THE PARAMETERS IPI TO ILI
=0 USE NEW (8.5 X 11) FORMAT.
*1 USE 0RI6INAL FORMAT.
*2 USE CONDENSED FORMAT (USEFUL IN INTERACTIVE MODE).
NOTE! 1) IDI AND IDO ALLOWED FOR BUT PRESENTLY NOT USED
IN UDICHDEN, ENTER THE SAME VALUE AS THE OTHERS.
CARD 3 FORMAT(F10.0,110,3F10.0)
QT	TOTAL EFFLUENT FLOU (CUBIC METERS PER SEC).
NP	NUMBER OF PORTS (SEE NOTE 2).
PDIA	PORT DIAMETER (M), EFFECTIVE DIAMETER IF KNOWN.
VANG	VERTICAL ANGLE (DEG) OF PORT RELATIVE TO THE
HORIZONTAL (90 DEGREES FOR A VERTICAL PORT).
ULINE ASSUMES VANG*90 DEG.
PDEP	PORT DEPTH (N) MUST BE GREATER THAN 0.0 AND
LESS THAN OR EQUAL TO THE DEEPEST DEPTH OF THE
AMBIENT DENSITY PROFILE.
KOTE! 2) ULINE REQUIRES TWO OR MORE PORTS, FOR THE
OTHERS, IF NP=1 SPACE=1000.0 (DEFAULT) MAKING
THE MERGING FLAGS INACTIVE.
CARD 4 FORMAT(3F10.0)
UW	HORIZONTAL CURRENT SPEED (M/S) (USED IN UOUTPLM ONLY)*
HANG	ANGLE (DEG) OF CURRENT DIRECTION WITH RESPECT TO DIFFUSER
AXIS (90 DEGREES CORRESPONDS TO A CURRENT DIRECTION
PERPENDICULAR TO THE DIFFUSER AXIS AND IF VANG=0, BOTH
THE CURRENT AND THE DISCHARGE ARE IN THE SAME DIRECTION)
(SEE NOTE 3).
SPACE DISTANCE (H) BETWEEN ADJACENT PORTS (SEE NOTE 2).
NOTE! 3) HAN6 NOT USED IN UPLUME. UOUTPLM AND UMERGE
ASSUME 90 DEG. UDKHDEN RANGE 45 - 135 DEG FOR
MORE THAN ONE PORT AND 0 - 180 DEG FOR A SINGLE
PORT (NOTE, SINGLE PORT ONLY: FOR VALUES 6REATER
2

-------
THAN 90 DEG BUT LESS THAN OR EQUAL TO 180 DEG, THE
PROGRAM SETS HANG EQUAL TO THE SUPPLEMENTARY ANGLE).
ULINE RANGE 0 - 180 DEG.
CARD 5 OPTIONAL (INCLUDE THIS CARD ONLY IF ICUTOP =1)
F0RNATCF5 .0,2X5 ,312,6 F5.C.-i.T5)
USED IN UMER6E
A
ASPIRATION COEFFICIENT


0.1
BY
DEFAULT
ITER
MAXIMUM NUMBER OF ITERATIONS


5000
BY
DEFAULT
IFRQ
ITERATION PRINTOUT FREQUENCY


150
BY
DEFAULT
NAA
PRINT ARRAY AA IF *1, DO NOT
IF
=0
0
BY
DEFAULT
NAB
PRINT ARRAY AB IF =1, DO NOT
IF
-0
0
BY
DEFAULT
MAC
PRINT ARRAY AC IF *1, DO NOT
IF
=0
0
BY
DEFAULT
(SEE LISTING OF PROGRAM UMERGE FOR CONTENTS OF ARRAYS
AA, AS, AC WHICH ARE MAINLY DEBUGGING AIDS.)
USED IN UPLUME
PS	PRINTOUT "INTERVAL"
USED IN ULINE
RK	RATIO OF SA/SM IN ROBERTS' EXPERIMENTS
DH	INTEGRATION STEP SIZE  IF T NOT EQUAL TO ZERO
EFFLUENT DENSITY (G/CM3) Ir T=0
T	EFFLUENT TEMPERAPJRE (DEGREES CELSIUS).
IF T=0 PROGRAMS ASSUME S IS EFFLUENT DENSITY IN
G/CH3, SEE NOTE 4.
CARD 7 FORMAT(4 F10.0)
DP( )	DEPTH IN METERS, *JST HAVE DATA FOR DP( )=0.0
SAC )	AMBIENT SALINITY (PPT) IF TA( ) NOT EQUAL TO ZERO
AMBIENT DENSITY (G/CM3) IF TA( )=0
TA( 5 AMBIENT TEMPERATURE (DEGREES CELSIUS).
IF TA( )=0 PROGRAMS ASSUME SA( ) IS AMBIENT DENSITY
IN G/CM3, SEE NOTE 4.
UA( ) HORIZONTAL AMBIENT CURRENT SPEED (M/S) (USED IN UMERGE,
UDKHDEN, AND ULINE).
NOTE! 4) THERE MUST BE NPTS IMAGES OF CARD 7. ALSO, EITHER
ALL TA(I) MUST BE ZERO OR ALL NOT ZERO, OR ERRORS
IN THE INTERPRETATION OF SAC ) AND TA( ) WILL OCCUR.
IF, FOR SOME I, SA(I) IS DESIRED TO REPRESENT
AMBIENT SALINITY AND TA(I) SHOULD BE EXACTLY 0, SET
TACI) EQUAL TO A SMALL NUMBER INSTEAD C0.000001 FOR
INSTANCE). THIS APPLIES TO S AND T AS WELL.
3

-------
SECTION 2
UPLUME Listing
4

-------
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
6S
PROG RAW UPLime
PROGRAM UPLUME
c
C UP-TO-DATE AS OF AUGUST 1985 (NO CHANGES SINCE 7-26-85).
C JULY 26, 1985 MODIFIED OUTPUT WHEN PLUMES MERGE AFTER TRAPPING.
C JULY 21, 1985 REVISED TO TERMINATE SOME COMPUTATIONS AT 0.9*DEPTH
C TO ACCOMMODATE BLOCKING NEAR THE WATER SURFACE.
C JUNE 17, 1985 REVISED INTERACTIVE DATA INPUT SO USER MAY CORRECT
C ERRORS BEFORE RERUNNING THE PROGRAM.
C MAY 15, 1985 DELETED PRINTING OF TIME AND PLUME DIAMETER WHEN
C PRINTING OF DILUTION CEASES. REVISED OUTPUT WHEN MERGING OCCURS
C BEFORE TRAPPING.
C MARCH 27, 1985 CHAN6E ANGLE OF DISCHARGE LIMITS FROM 0 TO 90 DEG
C TO -5 TO 90 DEG.
C MARCH 19, 1985 RELOCATED THE INTERACTIVE RECYCLE STATEMENT
C C3 WRITE) TO 3 CONTINUE, THE FIRST STATEMENT UNDER INTERACTIVE
C CONTROL. ADDED STATEMENTS IN SUBROUTINE LIMITS TO DETECT
C ERRONEOUS RESPONSES TO PROGRAM PROMPTS I.E. *NE. TO YES OR NO.
C
C PLUME MODIFIED TO USE UNIVERSAL DATA FILE WITH OPTIONS
C
C SUBROUTINES RPLUME, NPLUME, LIMITS, USORT, SIGMAT, SDERIV
C
COMMON G,FK,FM,COSTH^INTH,COSTHE,DS,C1 ,C2,E13,FLAG,GRAV
*,ICEASE
COMMON/AVAR/DP(30),SAC30),TAC30),RHO(30),DENPPC30)
COMMON/VAR/INTER,IDFP,ICUTOP,IPSF,IPI,IPO,ANGLE,Q,DIA,
•DEPTH,RHOJ,FN,PS,SPACE,SI,TI,NPTS,RFDD,U0,NQ
COMMON/COUNT/NWO,NW
COMMON/INOUT/IN,IO,IT
DIMENSION ZD(30),DG(30)
REAL*8 TITLt(10),TITLlC10)
INTEGER CHGDEK,ANS,TRAPPD,FLAG,BLOC
BYTE IFILEC20),0FILE(2Q)
COMMON/TVAR/TITLE,TITLI,IFILE
COMMON CUBRT,TWOTHD
DATA IFILE(20)/0/,OFILEC20)/0/
C
C:::::INITIALI2E CONSTANTS AND A VARIABLE.
C
C IN THIS PROGRAM CPDP SYSTEM - FORTRAN IV-PLUS),
C LOGICAL UNIT IN IS THE INPUT FILE.
C	"	10 IS THE OUTPUT FILE.
C	"	IT IS THE USER TERMINAL.
C
IN=1
I<«
rr*5
c
NVObO
NW*0
GRAV9.81
OJBRT=1./3.
TV0THD=2./3.
NOCASE=0
c
C:::::OPEN FILES
C
WRITE(IT,554)
554	F0RMAT(/1X,* •~•••PROGRAM UPLUME, AUGUST 1985*****')
WRITECIT,555)
555	F0RMATC/1X,' ENTER UDF NA-E: »,S)
READ(IT,556)(IFILECIX),IK*1,1?)
556	FORMATOSA1)
WRITECIT,557)
557	FORMATOX,1 ENTER OUTPUT FILE NAME:
5

-------
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
"25
126
127
128
129
130
PROGRAM UPLUME
READ(IT,556)C0FILECIK),IK=1,19)
opencunit=in,name=ifile,type='old*)
opencunit=io,name=ofile,type='new')
c
C:::::85 IS RECYCLE STATEMENT. SET/RESET COUNTERS, INITIALIZE
C	LIMIT FLAG.
C
85 CONTINUE
NU0=NU0+NW
NCV=0
LIMIT*0
c
C:::::READ/SORT/CHEOC LIMITS OF DATA SET.
C
CALL RPLUMEC1,LIMIT)
CALL US0RTCDP,SA,TA,RHO,NPTS)
CALL LIMITSC1,DEPTH,ANGLE,TI,SI,NPTS,INTER,TITLE,TITLI,
•IEXIT,LIBIT)
IFCIEXIT .EQ. 0)GO TO 21
CALL RPLL'MEC2,LIMm
GO TO 85
C
C:::::IF DATA CHECKS OK, START COMPUTATIONS.
C
21 CONTINUE
C
C:::::IS AMBIENT ENTERED AS DENSITY OR TEMP. AND SALINITY?
C
IFLAG»1
IFCTA(NPTS) .EQ. 0.)IFLAG=0
IF CI FLAG .EQ. 0)G0 TO 1
C
C:::::IT'S TEMP. AND SALINITY, COMPUTE DENSITY AND INITIALIZE
C	DENSITY AND SIGMA T ARRAYS.
C
DO 1000 I=1,NPTS
DENPP(I)=SIGMATCSACI),TACI))
RHOCI)=1.~0,001*DENPPCI)
1000	CONTINUE
GO TO 2
C
C:::::IT"S DENSITY, INITIALIZE DENSITY AND SIGMA T ARRAYS.
C
1	DO 1001 1=1,NPTS
RH0
-------
PROGRAM UPLUME
131	? FORMATCA1)
132	IFCANS .EQ. ,Y,560 TO 11
133	IFCANS .EQ. aN*)60 TO 85
134	WRITECIT,12)
135	12 FORMATC/1X,1	YOU BADE A MISTAKE, TRY A6AXN #****•)
136	60 TO 3
137	11 CONTINUE
138	IFCNCtf .EQ. 0)WRITEClT/7) CTITLEC IK) ,IIC*1,10)
139	7 F0RMATC/1X,' CASE IDENTIFICATION:'/
140	*2X,10A8)
141	WRITECIT,13)
142	13 F0RMATC1X,' WHAT IS THE TITLE OF THIS INTERACTIVE RUN? '/
143	*2X,S>
144	READCIT,6)CTITLICIlO,IIC*1/IO)
145	6 FORBAT<10A8)
146	IFCNCU .EQ. 0)60 TO 22
147	14 CONTINUE
148	NP=FN
149	WRITE(IT/I10)Q,NP,DIA,SPACE,AN6LE,DEPTH
150	110 F0RMATC/1X/ YOUR PRESENT INPUT VARIABLES ARE:*//
151	*1X,# 1. EFFLUENT FLOW (CHS)	Q =*,F10.4/
152	»1X,f 2. NUMBER OF PORTS	NP =',15/
153	*1X,f 3. PORT DIAMETER (M)	DIA »',F10.4/
154	*1X#* 4. PORT SPACIN6 (M)	SPACE = ',F9.3/
155	*1X,# 5. VERTICAL AN6LE W/HORZ (DE6) ANGLE = ',F9.3/
156	*1X,' 6. PORT DEPTH (M)	DEPTH »',F8.2)
157	IFCTI .EQ. 0.)WRITE(IT,111)SI
158	111 FORftATC
159	•Ix,' 7. EFFLUENT DENSITY C6/CH5)	SI = ',F11.5>
160	IFCTI .NE. 0.)WRITECIT,112)SI/TI
161	112 FORflATC
162	«1X,* 7. EFFLUENT SAL CO/OO)	SI =',*8.2/
163	~IX,' 8. EFFLUENT TEMP (DE6 C)	TI = ',F8.2)
164	WRITECIT/I13)
165	113 F0RMATC/1X,' ENTER THE NUMBER OF THE VARIABLE
166	* YOU WISH TO CHANGE. ',$)
167	READ(IT,115)NUMBER
168	115 F0RMATCI1)
169	IFCTI .EQ. 0. .AND. NUMBER .6E. 1 .AND. NUMBER .LE. 7)60 TO 15
170	IFCTI «NE. 0. .AND. NUMBER .6E. 1 .AND. NUMBER .LE. 8)60 TO 15
171	WRITECIT,12>
172	60 TO 14
173	15 CONTINUE
174	WRITE(IT,16)
175	16 F0RMATC1X,' WHAT IS THE VALUE OF THIS VARIABLE?
176	READ C IT/! 8) VALUE
177	18 F0RMATCF10.0)
178	IF(NUMBER .EQ. 1)0-VALUE
179	IFCNUM8ER .EQ. 2)FN«VALUE
180	IF(NUMBER «EQ. 3)DIA>VALUE
181	IFCNUWER .EQ. 4)SPACE^VALUE
182	IF(FN .EQ. 1.)SPACE=1000.
183	IFCNUMBER .EQ. 5)ANGLE*VALUE
184	IF(NUMBER .EQ. 6)DEPTH=VALUE
185	IFCNUMBER .EQ. 7)SI=VALUE
186	IFCNUMBER .EQ. 8)TI=VALUE
187	19 CONTINUE
188	WRITEQT/l?)
189	17 F0RMATC1X,' DO YOU WISH TO CHANGE ANOTHER VARIABLE?
190	* YES OR NO: *,S)
191	READCIT,9)ANS
192	IFCANS .EQ. ,N,)60 TO 8
193	IFCANS .EQ. fYf>GO TO 14
194	WRITECIT/J2)
195	60 TO 19
(
-------
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
PROGRAM UPLUrtE
8 CONTINUE
CALL LIMITSC2,DEPTH,ANGLE,TI,SI,NPTS,
•INTER,TITLE,TITLI,IEXIT,LIMIT)
IFCIEXIT .EQ. 0)G0 TO 22
CALL RPLUMEC2,LIMIT>
GO TO 85
22 NCW*1
C
C:::::SET INITIAL CONDITIONS.
C
20 CONTINUE
NO* FN
N0CASE=N0CASE+1
2FD=0.
FD=0«
C
C:::::is THE EFFLUENT ENTERED AS DENSITY OR TEW». AND SALINITY?
C
IFCTI .EQ. 0.)RHOJ=SI
IFCTI .NE. 0.)RHOJ=1.*0.001*SIGMATCSI,TI)
C
C:i:::FIND THE PROFILE DEPTH THAT IS EQUAL TO OR GREATER
C	THAN THE DEPTH OF DISCHARGE.
C
DO 1200 1=1,NPTS
IFCDPCI) .GE. DEPTH5GO TO 32
1200	CONTINUE
32 NP*I
NM=I-1
C
C:::::COPTUTE THE DENSITY AT THE DEPTH OF DISCHARGE (RHOB) AND THE
C	DIFFERENCE CDISP) BETUEEN THE EFFLUENT (RHOJ) AND THE
C	AMBIENT AT THE DEPTH OF DISCHARGE.
C
RHO^CDEPTH*DPCNM) )*CRHOCNP)—RHOCNM))/ CDPCNP)—DPCNM)}+RH0CNM)
DISP=RHOJ-RHOB
C
C:::::INITIALIZE ZD t DG ARRARYS.
C
DO 1201 1=1,NM
J=NP-I
ZDCI)=(DEPTH-DPCJ))/DIA
DGCI) = CRH0(J-M)-RH0(J>>*DIA/CDISP*
-------
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
PROGRAM UPLUME
35	TE*P=ATAN(1.416667»S/FD)
THETA0«(AN6LE/90.)*(1-5708-TEW>)«-TENP
COSTHE*COS(THETAO)
SINTHE«SIN(THETAO)
C
C:::::COMPUTE INTEGRATION STEP LENGTH (DSD.
C
DSI=DEPTH/(177.*DIA)
1FCDGC1) .Efl. O.)60 TO 36
DGTENP=«01/DG(1)
IFCDGTEHP .LE. 0 .)DGTERP*—DGTEHP
DSI=.12*1.6**(At0610(FD/10.))*2(AL0G10(D6TENP) )
C
C:::::INITIALIZE PRINTOUT CONTROL (NPO) AND ADDITIONAL
C	VARIABLES AND CONTROL FLAGS*
c
36	NP)
C
C::: ::WRITE INITIAL CONDITIONS
C
IFCIPI .EQ. 1)60 TO 45
IFCKPAGE .EQ. 1)60 TO 41
CALL RPLUNE(2,LINIT)
WRITEUO,130)
130	FORNATdHl ,' UPLUNE VERSION 1.0 AUGUST 1985 (BASED ON 0S3
* VERSION 2.3 9/12/77) ',/lX,4(18(• •"),2X))
WRITE(I0,561)(IFILE(IK),IK=1,19)
561 FORNATdX," UNIVERSAL DATA FILE: *,19A1)
WRITE(10,131)(TITLE(IK),IK«1 ,1 0)
131	F0RHAT(2X,'CASE I.D. #,10A8)
IF(INTER .EQ. 1>WRITE(I0,134)(TITLI(IK),IK=1,10)
134 F0RNAT(2X,1 RUN TITLE: ",10A8)
CALL NPLUWEC1,1 FLAG)
GO TO 43
41	IFdPI .EQ. 2)GO TO 42
CALL RPLUNE(2^IMT>
WRITECIO/130)
WRITE(I0,561)CIFILE(IK) ,IK=1,19)
WRITE (10,131) (TITLE(I*),IK*1 ,10)
WRITE( 10,134) (TITLK IK) ,IK=1,10)
CALL NPLUHE(1,1FUAG)
GO TO 43
42	CALL NPLUNE(3,IFLAG)
43	IF(IPO .EQ. C)WRITE(10,133)
9
-------
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
36C
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
PROGRAM UPLUME
133 F0RMAT(/72X,'FLUX-AVE*,/7X,'T*,9*,'S',9X,fX*,9X/Z",
*8X,•DXA*,8X,•H* ,7X,'THETA',2X,*DILUTION*,/5X,•(SEC)1,
+6X,% (M)1/FX?'(M)',7X,' CM)1,7X,*CM)1*7X,# CM)* *6X,a(DEG)*)
GO TO 46
45 CALL RPLUMEC2,LIMIT)
WRITEC10,200)
200	F0RMATC1H1,1X,'0S3 PLUME VERSION 2.3 9/12/77
*	(MODIFIED FOR UNIVERSAL DATA FILE, AUGUST 1985.)')
WRITECI0,2015
201	F0RMAT(1X,#
*	****•«*»*••*****«* BUOYANT PLUME IN A
*	DENSITY STRATIFIED MEDIA****~************")
WRITECI0,561) (IFILE(IIC),IIC=1,19)
WRITECI0,205) (TITLE(IK) ,IK=1 ,10)
205	F0RMATC1X,' CASE I.D. '/lOAS)
IFCINTER .EQ. 1)WRITECI0,134)(TITLICIK),IK=1,10)
WRITE(10,206)NOCASE
206	F0RMATC/1X,' CASE NO.'^n,* WITHIN THE UDF, UNITS: HCS,
* INITIAL CONDITIONS**..a/)
WRITE<10,208)ANGLE,RFDD,SP,DSIP,PS
208	FORMATC
*40H PORT ANGLE	,F7.1/
*40H FROUDE NUMBER	, F7 .1 /
*40H LENGTH FOR FLOW ESTABLISHMENT. . . .,F8.2/
•40H INTEGRATION STEP LENGTH	,F9.3/
*40H PRINTOUT INTERVAL	,F8.2)
WRITE(10,308) XP,ZP,RHOJ ,DEPTH
308 FORflATC
*40H XO	,F8.2/
•40H ZO	,F8.2/
*40H DISCHARGE DENSITY	,F11.5/
•40H PORT DEPTH	,F8.2)
WRITEUO,209)Q,NQ,U0,DlA
209	FORMATC
*40h FLOWRATE	,F10-4/
•40H NUMBER OF PORTS	,15/
*40H DISCHARGE VELOCITY	,F8.2/
•40H PORT DIAMETER	,F10.4)
IF(NQ .GT. 1)WRITE(10,202)SPACE
202	FORMAT(
*40H PORT SPACING	,F9.3)
IFCNQ .EQ. 1)WRITE(I0,203)
203	FORMAT( 4X ,1PORT SPACING 	 1000.0 (DEFAULT)1)
WRITECI0,210)C(DPCI),RHO(I)),I=1 ,NPTS)
210	F0RMATC/1X," DENSITY STRATIFICATION: DEPTH-	RHO'//
*(26X,F6.2,F11 .5))
C
C:::::MAIN COMPUTATIONAL SCHEME
C
46 DS*DSI
ICEASE=0
IMR=0
BLOC=0
NBLOC=0
NTRAP=0
NMERGE=0
BNEW=.308*SP
ASPAC=SPACE
IFCIPO .EQ. 1)WRITE(I0,211)
211	F0RMAT(/1X,6X,,T,,9X,,S,,9X,'X,,9X,,Z,,9X,,D,^X,,ELEV',
•SX^'THETA'^X^'DILNCCL) ,,2X,,DILN(AVE) ')
GO TO 55
51	DS=DSI
52	DELX=COSTH*DS
DELZsSINTH*DS
10
-------
PROGRAM UPLUME
391


DELE*FK
392


delt*fr
393


SPDS2*S*DS*.5
394
C


395
C:

:4TH ORDER RUNGE-KUTTA INTEGRATION.
396
C


397


DO 2000 1*1JZ
398


CALL SDERIVCSPDS2,E+.5*FK,R*.5*FW)
399


delx*delx+2.*costh*ds
400


D£LZ«DELZ*2.*SINTH*DS
401


DELE»DELE+2.*FK
402


DELT*DELT+2.*FH
403
2000
CONTINUE
404
C


405


CALL SDERIV(S*DS,E*FK,R4-FP0
406


ZLAST=Z
407


ZINCR*(DELZ*SINTH*DS)/6.
408


Z»Z+ZINCR
409


IF CCHGDEN „EQ. 1)G0 TO 71
410


IF CZ .GT. ZLXIOGO TC 70
411

53
CONTINUE
412


0LDX3X
413


X*X*CDELX*COSTH*DS)/6«
414


EOLD*E
415


E»Et(DELE+FK)/6.
416


R*R+CDELT+FW)/6.
417


IFCE .LE. 0.)E«0.
418


DT".218*DIA*DS/OiO*(EOLD**CUBRT/S+E**CUBRT/3)
419


OLDT=T
420


T*T+DT
421


s®s+ds
422


TF(E .GT. 0.)60 TO 54
423


FLAG-1
424


IFCE .EQ. 0.)ICEASE=1
425
C


426
C:

:THIS STOPPING CRITERIA IS BASED ON VELOCITY GOING TO
427
C


428

54
IFCFLAG .EQ. 1)G0 TO 59
429

55
CONTINUE
430


0LDSIN=SINTH
431


OLDCOS=COSTH
432


CALL SDERIV(S,E,R)
433


IFCTRAPPD .EQ. 1 .OR. BLOC .GT. 0)G0 TO 57
434


IFCR .GT. 0.)60 TO 56
435


RAT«R/(RO-R>
436


El 3TRP* El 3+( El 3-E130) *R AT
437


ZTRAP»DEPTH-CZ+ZINCR*RAT)*DIA
438


SKTRAP=.245* CS*DS*RAT> *E13TRP
439


SHTRA-1 .77«S«TRAP
440


PDEPTH=100.-CZTRAP/DEPTH*100.)
441


FINALB=.308*CS*DS*RAT)*DIA
442


FINALT»OLDT+RAT* CT-OLDT)
443


TRAPPD=1
444


NTRAP=N
445


GO TO 57
446

56
R0LD=R0
447


ROR
448


E23SE130
449


E130*E13
450

57
1
451
c


452
C:

:ARE PLUHES FROW ADJACENT PORTS HERGING?
453
C


454


BOLD*BNEV
455


BNEW=.308*S*DIA
-------
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
48:
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
PROGRAM (JPLUIE
IF(BLOC .GT. 0)G0 TO 58
IFCIMR .GT. 0)GO TO 80
IFCBNEV .LT. ASP AO GO TO 80
NMERGE=N-1
RAT2=CSPACE-B0LD)/C8NEV-B0LD>
ZZMR»DIA*CZ-ZLAST)»RAT2
emr=zzmr*zlast*dia
ZMR=DEPT*-EMR
XMR=D1A» C0LDX*RAT2*CX-0LDX))
TMR=0LDT+RAT2*CT-0LDT)
BMR=ASPAC
SINMR*0LDSIN+RAT2*CSINTH-0LDSIN)
C0SMR*0LDC0S+RAT2*(C0STH-0LDC0S)
THETAM«ATAN2RAT2*CE13-E23))
DILMR=1.77*CLMR
IFCTRAPPO .EQ. 0)IMR=1
IFCTRAPPD .EQ. 1 .AND. NTRAP .NE. NMERGE)IMR=2
IFCTRAPPD .EQ. 1 -AND. NTRAP .EQ. NMERGE)IMR=3
IFCIPO .EQ. 2)GO TO 80
IFCIMR .EQ. 2)WRITE(10,213)
213	F0RMATC1X,' PLUMES MERGED')
IFCIMR .EQ. 1)WRITE(10,214)
214	F0RMATC1X,' PLUMES MERGED, PARAMETERS AT THAT TIME WERE:')
IFCIPO .EQ. 0 .AND. IMR .EQ. 1)WRITE(10,220)
»TMR,SMR,XMR,ZNR,8MR,EMR,THETAM,DILMR
IFCIPO .EQ. 1 .AND. IMR .EQ. 1)WRITE(10,220)
*TMR,SMR,XMR,ZMR,BMR,EM9,THETAM,CLMR,DILMR
xFCIMR .NE. 3)WRITE
THETAB=ATAN2CSINBL0,C0SBL0)*57^958
SNEtf=S-DS*C1 .-RAT3)
IFCANGLE .EQ. 90.)SBLOC=EBLOC
IFCANGLE .NE. 90.)SBLOCsSNEW*DlA
CLBLOC*-245*SNEW*(El3*RAT3* CE13-E23))
DBL0C=1.77*CLBL0C
IFCIMR .EQ. 0)BL0C=1
IFCIMR .EQ. 1 .AND. NMERGE .LT. NBL0C)BL0C=2
IFCIMR .EQ. 1 .AND. NMERGE .EQ. NBL0C)BL0C=3
IFCIPO .EQ. 2)GO TO 59
IFCBLOC .EQ. 2)WRITEC10,249)
249	F0RHATC1X,1 BLOCKING HAS BEGUN')
IFCBLOC .EQ. 1)WRITE(10,250)
250	FORMATCIX,' BLOCKING ZONE REACHED, PARAMETERS AT THAT TIME WERE:1)
12
-------
PROGRAW UPLUME
521	IFCIPO *EQ. 0 .AND. BLOC *EQ. 1)WRITECiO,220)
522	~TBL0C,SBL0C,XBL0C,ZBL0C,BBL0C,EBL0C,THETA3,DBL0C
523	. IFCIPO «EQ. 1 .AND* BLOC .EQ. 1)WRITECI0,220)
524	*TBLOC,SBLOC,XBLOC,2BLOC,BBLOC,EBLOC/rHETAB,CLBLOC,DBLOC
525	IF(BLOC .EQ. 3)WRITECIO,251)
526	251 FORMATC1X,' BLOCKING ZONE REACHED AND PLUMES MERGED
527	* AT THE SANE TIKE.')
528	IFCIMR .EQ. 1 .OR. BLOC .EQ. 1)60 TO 51
529	C
530	C:::::IS XT TIME TO PRINT A LINE OF DATA?
531	C
532	58 IF(N-CN/NPO)*NPO .NE. 0)60 TO 51
533	59 XP»X*DIA
534	ELEV*Z*DIA
535	ZP«DEPTH-ELEV
536	SP=S*DIA
537	B».308*SP
538	DILN».245*S*E13
539	DILNA=1.77*DILN
SAO	THETA»ATAN2CSINTH,X0STH)*57.2958
541	IFCIPO .EG. 2)60 TO 61
542	IF(TRAPPD .EQ. 0 .AND. BLOC *EQ. 0)GO TO 60
543	WRITEC10,217) SP,XP,ZP,ELEV,THETA
544	217 F0RMATC10X,3F10.2/10X,F10.2,F10.1)
545	GO TO 61
546	60 IFCIPO .EQ. OGO TO 64
547	WRITEClO,219)T,SP,XP,ZP,B#ELEV#THFrA,DILNA
548	219 FORMATC6F10.2,F10.1,F10.2)
549	GO TO 61
550	64 WRITECIO,220)T,SP,XP,2P,8,ELEV,THETA,DILN#DILNA
551	220 FORMATC6F10.2,F10.1,2F10.2)
552	C
553	C:::::PRINT RESULTS.
554	C
555	61 IFCFLAG .EQ. 0>G0 TO 51
556	IFCIPO .NE. 1)60 TO 62
557	WRITECI0^221)
558	IFCTRAPPD .EQ. 1 .AND. IMS *NE. 3>*RITECI0,222)ZTRAP,
559	•SWTRAP,SMTRA,FINALT,FINALB
560	IFCIHR .EQ. 3)WRITECI0/218)ZTRAP,SMTRAP,SMTRA
561	IFCTKAPPD .EQ. 0)WRITECIO,224)
562	IFCTRAPPD .EQ. 1)WRITEC:0,223)PDEPTH
563	IFCBLOC *GT. 0)60 TO 81
564	GO TO 63
565	62 IFCXCEASE .EQ. DWRITEC 10,240)
566	IFCXCEASE .EQ. 2>WRITECI0,241)
567	XFCICEASE .EQ. 3)WRITEC10,242)
568	IFCIHR .EQ. 1 .AND. IPO .EQ. 2)WRITECI0,243)DILNR,ZNR
569	IFCBLOC .GT. 0)60 TO 81
570	IFCIMR .EQ. 3)WRITECI0,248)ZTRAP,SMTRA
571	IFCIMR .EQ. 2)WRITECI0,244)ZNR
572	IFCTRAPPD .EQ. 1 .AND. IRR .NE. 3)WRITECI0,245)ZTRAP,SMTRA,
573	*FINALT,FINALB
574	IFCTRAPPD .EQ. 0 .AND. IMR .LT. 2)WRITEC10,246)D1LNA
575	KPAGE=INTER
576	„ GO TO 63
577	81 CONTINUE
578	WRITECI0,252)
579	IFCBLOC .EQ. 3)WRITE(I0,253)
580	WRITECIO,254)ZBLOC,DBLOC
581	IFCBLOC .EQ. 2)WRITE(I0,255)
582	252 F0RMATC1X,1 BLOCKING ZONE REACHED")
583	253 F0RMA7C1X,* AND MERGING OCCURRED')
584	255 F0RMATC1X,' AFTER MERGING OCCURRED')
585	254 F0RHATC1X,' AT ',F7.2,a H BELOW WATER SURFACE,
13
-------
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
63*
643
6^1
6-2
643
644
645
646
647
648
649
650
PROGRAM UPLUME
*	WITH AVE* DILUTION OF ',F6.1>
63 CONTINUE
IFCINTER .EQ. 0)GO TO 85
IFCICEASE .EQ. 1)WRITEWRITECIT^55)
SO TO 3
C
218 FORMATdX,' MERGING AND TRAPPING LEVEL IS: ',F7„2,* M BELOW
*	WATER SURFACEV1X,' WITH CL DILUTION OF ',F6.1„' AND
*	AVE. DILUTION OF ',F6.D
221	F0RMATC1X,' LAST LINE ABOVE IS FOR MAXIMUM HEI6HT OF RISE.')
222	F0RMATC1X,' TRAPPING LEVEL IS'#F7.2,
*' H WITH CL DILUTION 0F*,F7.1,' AND AVE. DILUTION 0F',F7.1/
~IX,' TIME TO TRAP:',F6.2,' SEC. PLUME DIA AT THE TRAPPING
*	LEVEL:'*F6.2,' M')
223	F0RMATC1X*' HEIGHT OF RISE=',F5.1PERCENT OF DEPTH')
224	F0RMATC1X," TRAPPING LEVEL IS NOT REACHED')
240	F0RMATC/1X,' COAPTATIONS CEASE: PLUME VELOCITY IS ZERO')
241	F0RHATC/1X,1 COMPUTATIONS CEASE: PLUME SURFACES')
242	F0RHATC/1X,' COMPUTATIONS CEASE: PLUME TRAJECTORY IS',
•' HORIZONTAL')
243	F0RMATC/1X,' NOTE: AVERAGE DILUTION WAS',F6.1„' WHEN PLUMES' /
*1X,' MERGED AT',F7.2,' M BELOW THE WATER SURFACE.'/
*1X,' TRAPPING LEVEL NOT YET REACHED. AVE. DILUTION'/
*1X,' SHOWN BELOW DOES NOT ACCOUNT FOR MERGING.')
244	F0RMATC/1X,' PLUMES MERGED AT DEPTH',F7.2,' M, AFTER TRAPPING
*	LEVEL REACHED.')
245	F0RMATC/1X,' TRAPPING LEVEL =,,F7.2,' M BELOW WATER SURFACE.'/
*1X,' AVERA6E DILUTION = ',F6.1/
*1X,' TIME TO TRAP:',F6.2,' SEC. PLUME DIA AT THE TRAPPING
*	LEVEL:',F6^„' M')
246	F0RMATC/1X,' AVERAGE DILUTION =',F7.1>
248 F0RMATC/1X,' PLUMES MERGES AND TRAPPED AT THE SAME TIME',
*F7.2,'M BELOW'/IX,' WATER SURFACE WITH AVERAGE DILUTION
*= #,F5.1)
C
C:::::FIND NEXT STRATIFICATION AND RECOMPUTE LAST STEP IF
C	NECESSARY.
C
70	DS=DS*CZLIW-ZLAST)/CZ-ZLAST)
CALL SDERIV(S,E,R)
CHGDEN=1
Z=ZLAST
GO TO 52
71	CNGDEN=0
IPTS=IPTS*1
IFCIPTS .GT. NM)G0 TO 72
G=DGCIPTS)
zl:m=zd(ipts)
GO TO 53
C
14
-------
651
652
653
654
655
656
657
655
659
660
661
662
663
664.
665
666
66?
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
PR06RAM UPLUME
72 XFCIPO .EQ. 1)WRITE(IO,230)
230 FORMATCIX,* PLUME HITS SURFACE'/
*1X,? HEISHT OF RISE*100.0 PERCENT OF DEPTH")
FLA6*1
ICEASE=2
60 TO 53
END
C
SUBROUTINE RPLUMECK,LIMIT)
C
C:::::READ UNIVERSAL DATA FILE AND CONVERT DATA FOR USE ZN PROGRAM UPLUME
C
COMMON/AVAR/DPC30),SAC30),TA C33),RHOC30),DENPPC30)
COMMON/VAR/INTER,IDFP,ICUTOP,IPSF,IPI,IPO,ANGLE,Q,DIA,
•DEPTH,RHOJ,FN,PS,SPACE,SI,TI,NPTS,RFDD,Ua,NQ
common/sav/ii(5)
COPWON/COCNT/NWO,NW
COMMON/INOUT/IN,IO,IT
REALMS TITLE(10),TITLI<10),AA<10)
BYTE IFILEC20),OFILE(20)
COMMON/TVAR/TITLE,TITLI,I FILE
DATA IFlLEC20)/0/,0FlLEC20)/0/
IF(K .EQ. 2)60 TO 40
READ(IN,200,END*99,ERR-999)CTITLE,ICUT0P,ClI <(DP
XP1*IXC1)
IPCMPI
QbQT
ANGLE-VANG
DIA*PDIA
DEPTH-PDEP
SI«S
TIaT
FN*NP
IFCICUTOP .EQ. 0)60 TO 38
IPSF*1
IFCPS) 38,38,39
38	PS=3.
IPSF*0
50 CONTINUE
39	RETURN
40	N^NPTS+S+IOJTOP
IFCLIMIT .EQ. 0 .AND. IDFP .EQ. 1>WRITEC10,403)
403 F0RMATC1H1)
IFCIDFP .EQ. 0)60 TO 50
VRITEC10,400)CIFILECIK),IK=1,19)
400 F0RMAT(/1X,# UNIVERSAL DATA FILE: ',19A1/)
IFCINTER .EQ. 1)WRITE(10,10)
15
-------
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
PROGRAM UPLUME
10 FORMATC
*1X ,1	*/
•1X,* •	NOTE, THIS IS THE ORIGINAL FILE. *¦/
*1X,' *	IT DOES NOT REFLECT CHANGES MADE INTERACTIVELY. *'/
*1X,' *	THOSE CHANGES ARE SHOWN IN THE OUTPUT HEADING. *'/
REWIND IN
IFCNWO .EG. 0)GO TO 41
DO 1001 I=1,NWO
READ(IN,401)(AA C J),J=1,10)
1001 CONTINUE
41 DO 1000 1=1,NW
READ(IN,401) (AA(J),J=1 ,10)
401	F0RMATC10A8)
WRITE(IO,402)CAA(J),J=1,10)
402	FORMAT(1 X,1OAS)
1000 CONTINUE
GO TO 50
999 WRITE(10,403)
WRITE(10,998)CTITLECIK),IK«1,10)
998 F0RMAT(1X,t COMPUTATIONS CEASE FOR:V2X,'CASE I.D. ',10*8/
*1X,' INPUT ERROR, CHECK DATA FILE')
IFCINTER .EQ. 1)WRITE(IT,998)CTITLE(IK),IK=1,10)
99 CALL EXIT
END
C
SUBROUTINE NPLUME(K,IFLAG)
C
C:::::PRINTS INPUT DATA FOR UPLUME IN NEW FORMAT.
C
COMMON/AVAR/DPC30),SAC30),TAC30),DENP(30),DENPPC30)
COMMON/VAR/INTER,ID FP,I CUT0P,IPS F,IPI,IP0,ANGLE,Q,DIA,
*DEPTH,RHOJ,FN,PS,SPACE,SI,TI,NPTS,RFDD,UO,NQ
REAL*8 TITLEC10),TITLI<10)
BTTE IFILEC20),OFILE(20)
C0MM0N/TVAR/TITLE,TITLI,IFILE
COMMON/IN0UT/IN,I0,IT
DATA IFILE(20)/0/,OFILE(20)/0/
C
IF(IC—2) 1,2,3
1	IFCIPO .EQ. 2)GO TO 122
IFCIPSF .EQ. 0)WRITEC10,110)PS
IFCIPSF .EQ. 1)WRITECI0,111)PS
122 WRITE(I0,4)
IF(TI .NE. 0)WRITEU0,123)TI
I F(TI .NE. 0.)WRITECIO,124)SI
WRITECIO,125)RHOJ
WRITE(10,133)UO
WRITE(I0,134)RFDD
IFCIFLAG .EQ. 1)WRITEC 10,13D
IFCIFLAG .EQ. 1)WRITE(10,132)CCDPCI),SA(I),TA(I),DENPP(I)),
~I=1,NPTS)
IFCIFLAG .EQ. 0)WRITE(I0,135)
IFCIFLAG .EQ. 0)WRITE(I0,136)CCDPCI),SA(I)),1=1,NPTS)
2	WRITE(I0,200)
writecio^odq
WRITEC10,202)NQ
WRITECI0,203)DIA
IFCNQ .GT. 1)WRITE(10,121)SPACE
IFCNQ .EQ. 1)WRITE(10,126)
WRITE(I0,204)ANGLE
WRITE(IO,205)DEPTH
RETURN
3	CONTINUE
WRITE(10,210)(TITLICIK),IK=1,10)
16
-------
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
PROGRAM UPLUME
WRITE(10,134)RFDD
€0 TO 2
C
4 FORMAT(IX)
110	F0RMAT(/2X,'PRINTOUT INTERVAL',19X,'*',F7.0,6X,'(DEFAULT)•)
111	F0RMATC/2X,'PRINTOUT INTERVAL',19X,'«',F7.0)
121 F0RMAT(2X,'P0RT SPACING*,24X,'»',F9.2," M'>
123	F0RMATC2X,' INITIAL TEW»ERATURE OF THE PLUME'^X,'*'^^^,
•'DEGREES CENTIGRADE1)
124	F0RHATC2X,'INITIAL SALINITY OF THE PLUME',7X,,«',F9.2,# PPT")
125	F0RMAT(2X,'INITIAL DENSITY OF THE PLUME'^X,'"',F12.5,' 6/CK3')
126	FORMAT(2X,'PORT SPACING',24X,'= 1000,0 M(DEFAULT)1)
131	F0RMAT(/3X,'DEPTH* ,4X,'SALIN',5X,f TEMP",3X,"SXGMAT9,/4X,f(M)
*5X,' (PPT) '^X,' (C) ',/)
132	F0RMAT(1X,F7.2,3F9.2>
133	FORMATC2X,'DISCHARGE VELOCITY',18X,,=',F10*3,' M/S')
134	F0RMAT(2X,'FR0UDE NUMBER',23X,,=',F8.1)
135	F0RMAT(/3X,'DEPTH',4X,'DENSITY')
136	FORMAT(1X,F7.2,F11.5)
200	FORMATdX)
201	FORMAT( 2X ,'TOTAL EFFLUENT FLOW,17X,'»',F11 .4/ CMS')
202	FORMAT(2X,"NUMBER OF PORTS'^IX,'*',^
203	FORMAT(2X,'PORT DIAMETER',23X,'*',F11.4," M')
204	FORMAT(2X,'VERTICAL PORT ANGLE FROM HORIZONTAL = ',F8.1,5X,
*'DE6REES')
205	FORMAT( 2X ,'PORT DEPT^^X,'-'^^,' M')
210 F0RMATC/2X^70C,X')//2X^'RUN TITLE: ',10A8/)
END
C
SUBROUTINE LIMITS(KK,PDIEF,VANG,T,S,NPTS,INTER,TITLE,TITLI,
*ie3cit,umit)
C
C THIS SUBROUTINE CHECKS LIMITS OF PORT DEPTH (GREATER THAN 0. AND
C LESS THAN OR EQUAL TO PROFILE DEPTH), DISCHARGE ANGLE (EQUAL TO
C OR GREATER THAN -5 DEG BUT LESS THAN OR EQUAL TO 90 DEG,
C VERTICAL, AND IF NEGATIVE, THAT THERE IS AT LEAST ONE PROFILE
C DATA POINT AT LEAST ONE METER BELOW THE PORT DEPTH)• THAT THE
C EFFLUENT DENSITY IS LESS THAN THE AMBIENT DENSITY AND THAT THERE
C ARE AMBIENT PROFILE VALUES FOR THE SURFACE, IF INTER=1, THE PORT
C DEPTH, ANGLE AND EFFLUENT DENSITY CAN BE CORRECTED INTERACTIVELY
C BUT SURFACE DATA AND PROFILE DEPTH CORRECTIONS MUST BE HADE TO
C THE DATA SET(S) AND REENTERED. IF INTER=0, ALL CORRECTION MUST BE
C MADE TO THE DATA SET(S) AND REENTERED.
C
COMMON/AVAR/DP(30),SA(30),TA(30),RHO(30),DENPP(30)
C0MH0N/IN0UT/IN,I0,IT
REAL*8 TITLE(10),TITLIC10)
LIMIT*0
IDEEP*0
IVANG=0
NEGANG=0
IRHO=0
INS=0
IEXIT=0
100 IF(PDEP .EQ. 0. .OR. DP(NPTS) .LT. PDEP)G0 TO 1
10 IFCVAWG .LT. 0. .OR. VANG .GT. 90.)G0 TO 101
30	IF(T .EQ. 0.)RHOE*S
IF(T .NE. 0.)RHOE=1.+0.001«SIGMAT(S,T)
DO 31 J*2,NPTS
IF(PDEP .LE. DP(J))GO TO 32
31	CONTINUE
GO TO 40
32	JK=J
PR(^(PDEP-DP(JK-1))/(DP(JK)-DP(JK-1))
TT*TA(JK—1)*PR0*(TA( JO~TA(JIC—D)
17
-------
-O'O'O<6'O>OO0C9O»O»O»QOO»q»O»OO
-*Qooooooooo^wr\j-*0'OOo->jO*cn^WfN>-*o
ss
3 00
OOOOOOOOQOQQQOQOOOOOOOOOOOOOODOOOOOO
ooooooooOoOoOooonnN
OOSO>UIM^NU0^09-Ui^
-g -g
ODOOCSOOQOQOQQteQOQOQOQQOOQOOOOOOOOQOOOOOOOOOOOOQOQOQOQO
0JrJ-*o<009N&ui?i/Jr\j-to<06»>j0t
nnnnn
ST1 X)	T1 C
o m	o 3
n > n h
H 3 V	3 H
o > ^ > m
H »-»	H
^ A H	^ H
O t» >	-* H
o *N	M S
• W* 0>
O 7)	• *-*
v u	_
m	z
i?	r*>
c
O T1 ^1 T1
m a a
rn z z z
"5 > » £
IT z z Z
rv v> 
o m	o
9 >	9
JO	3
> « >
—I M	—4
M
-A
• *
o % 5
m Oo jo
•g • 3
H ** J»
zs -I
¦
T» H
^ %
O	y%
TO	rs
3	*0
»	o
» X »*> U
z m ^
o -»•
ro -»
«
HHflHr
n o ^ o n h
Z 9 A Z ^ 3
>1T)HHN
Z > O M Z -f
o H m z h ii
m a t c m -*
m x
ffl -n
CI st
> o
*D

z
Z
m —'
^ X
w
X

5
X
o
6
X
m
•
m
m
D
Z\

\
•
30
%
H
30 ^
o
m
•
•
•
5
•
m
o
o
n
•
•
H
•
•
c
•
m
•
¦
l/> c
CO
n
9
M
T
o o
M
o

-<
-<
Z
>
% H
O

r
O
•
m
m
«
o

•

z
•
30
-A
m
3D


30
V

V
w

H
O



H
•
H
o
c
0>
O
C
C)

3 nt
>
c
o

>
a:

33
o
o
30
o
•1
w

9
!D
o
z
•
o
M


H

o
\ >
z
M
•o
m
o
•
M
H
H
H
H
H

-4 m
H
H
*0
•

v>
m
o
O
M
O
3
n •
o
m
X



n





>
x ^
>
A

X
o

X
M
-J
—M
>-«
-*
H
> -*
H
>-«


T>

>
H
o
M
H
o
m
z x
M
o
m
A
A

3D
X,





ff» *
<
Xi
\
•
z

O



n
m •
m
¦n >
•o

m


•o r
o m
jo >
H?
o
m o
-o z
H m
x
-a
o
0	w *
*-•	*0 M
(/»	o s
n	m •
1	T
>	* X
SOW
	X *
Z H >
QMZ
r «-» ci
m m
%
"D
H O
X X)
i3
53
H O
*0 X
2D
O «"»
O (/>
• w
rv>
T>
M O
c/> m
T>
© w
m c
m a?
T) M
m h
» m
x h
> \
Z w
a V
^ -v
o
m
u
\
] CD H
m m -*i
H o
m > r
SCO
o z
o m h
m so
rn m o
H r
m -
(a
-4 z
z m z
> en o
*?-•
2 < 2
m m «/>
>	t/>
T)	m
O T> O
3D »
H O H
-*1 o
9 M
m r -*
¦q m -*
~? oN
<
*0 >
H Z
A
S'«
t/i m
H •
09 I
m u»
•
>
s
(/i r
o
z o
m •
S) V i% c
o m o »
> 30 H
H O	3 H
o	» m
H	—4 /¦»
W H « h
ON	sH
 n	h	> x H
-I O 3	H	O 3 H
O o >	m	*¦> > m
H H	>*«	H H ^
W H a n	H a w
0% -* H > *-» H
3	^ ^
M • Ul	(•
a ii n
I A n
?5S
N z z
tl L0
^ m	jo
A >	H
Z O	H
»	fT*
z H	A
W H	N
%	-«
•
m ^	r*
ID Z	^
• £
• I/)
Oi
w
•
^ n C
X O 30
s a h
• 3 H
» m
cn c
o 9
C/) *>. H
l/l >i \
X u
H> 01
X
S30
m x
, ¦" o
H -*» m
z r >
m c »
m x
5 z o
3 H >
CD
M o
m m
5 *
H u>
M
S3
A •
• Kn
s *
3 *
> O
*a
Q ^
O M r M M M
O ^ H 30 H 1
Z A 3 X A A
fl 52
O A
> <-
M Z
Z H II
c	in -»
m »
H CO
22
§§
m
m	+
o	*T?
•	JO
0	9
1	A
5.
• S
30 •
X
o o
m •
w w
CI 30 n >
o x 5 ~
OOU
H > > A
o II II W
-* c» I
CI (/)
>
I" I
O 4
o
•
o
o
-------
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
943
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
PROGRAM UPLUME
11	IVAN6=1
LIMIT=1
IP(INTER .EQ. 0)60 TO 30
122 CONTINUE
write < nyi 25 VANS
12	FORMATC/lX,' DISCHARGE ANGLE C%F6.1,*3 IS NOT IN THE
*	RANGE OF -5 TO 90 DEG*)
WRITE(IT,4)
READCIT,5)NANS
IF(NANS .EQ. 'N*)60 TO 30
IF(NANS .NE. "T" )WRITE(IT ,200)
IF (NANS .WE. 'YMeO TO 122
1VAN6=2
WRITE(IT,6)
READ(IT,7)VANG
60 TO 10
40	IFCDPd) .EQ. 0.560 TO 50
IN0=1
LINIT=1
IFCINTER .EQ. 0)60 TO 50
WRITECIT,41) (TITLE ClC),K=1,10)
41	F0RMAT£1H1/1X,* COMPUTATIONS CEASE FOR'/IX,' CASE I.D. %10A85
WRITE
-------
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
PROGRAM UPLUME
*1X,' BE GREATER THAN ZERO BUT LESS THAN OR EQUAL TO THE PROFILE
*	DEPTH.'/
*1X,' IF THE DISCHARGE ANGLE IS NEGATIVE, THE PORT DEPTH MUST'/
•IX,* BE AT LEAST ONE METER LESS THAN THE PROFILE DEPTH.')
57	F0RMATC1X,' PORT DEPTH CHANGED TO: ',F6.2,' M*)
58	FORMATdX,' DISCHARGE ANGLE C',F6.1,')
*	MUST BE .GE. -5 BUT .LE. 90 DEG'>
59	F0RMATC1X,' DISCHARGE ANGLE CHANGED TO: ',F4.1,' DEG')
64	FORMATdX,' EFFLUENT DENSITY RJST BE „LT. AMBIENT
*	DENSITY AT THE DISCHARGE DEPTH')
65	FORMATdX,' EFFLUENT DENSITY CHANGED TO: ',F7.5,' G/CM3')
66	F0RMATdH1/lX,' COMPUTATIONS CONTINUE F0R'/1X,' CASE I.D. ',10A8)
71 FORMATdX,' CORRECTIONS WERE INTERACTIVELY MADE TO
*	THE FOLLOWING:'/>
200 F0RMATC/1X,' *****YOU MADE A MISTAKE, TRY AGAIN*****')
75 IFCIEXIT .EQ. 1)WRITE(I0,43>
70 RETURN
END
C
SUBROUTINE USORTCDP,X,Y,Z,N?TS)
C
C:::::THIS SUBROUTINE SORTS THE AMBIENT PROFILE ON DEPTH,
C	SHALLOW TO DEEP.
C
DIMENSION DPC30),XC30),YC30),ZC30>
NESTED=NPTS
L=NESTEt>-1
DO 1000 P^1,L
NESTED=NESTED-1
DO 1000 1=1,NESTED
IF(DPCI) .LE. DPCI«-1))G0 TO 1000
DUMMY=DPCI)
DP*SAL*.8149>*SAL-0.093
B=1.E-6*T*U.01667*T-.8164)*T*18.03)
A=.001*T*(C.0010843*T-.09818)*T*4.7867)
SUMT=CT-3.98)*CT-3.98)*CT+283.)/C503.57*CT*67.26>>
SIGMAT=(SIGO+.1324)*C1.-A*B*CSIGO-.1324))-SUMT
RETURN
END
C
SUBROUTINE SDERIV(S,E,R)
C
C:::::THIS SUBROUTINE IS PART OF THE 4TH ORDER
C	RUNGE-KUTTA INTEGRATION.
20
-------
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
PROGRAM UPLUME
COMMON G,FK,Fn,C0STW,SXNTH,C0STHE,DS,C1 ,C2,E13,FLAG,GRAV
*,1CEASE
COMMON CUBRT,TVOTHD
INTEGER FLAG
El 3=0.
IFCE .LE. 0.)GO TO 3
E13=E**CUBRT
COSTH=COSTME*C1/CE13*E13>
IFCCOSTH .LT. 1.)G0 TO 1
::THIS STOPPING CRITERIA IS BASED ON PLUME BECOMING HORIZONTAL
AGAIN*
FLAG=1
ITEASE*3
SINTH=0.
C0STK»1.
GO TO 3
1 SINTK*SQRTC1.-C0STH»C0STH>
3 FK*C2*S*R*SINTH»DS
Ff^.109«S«E13*G*DS*SINTH
RETURN
END
21
-------
SECTION 3
UOUTPLM Listing
22
-------
1
2
3
4
5
6
7
6
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
43
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
PROGRAM UOUTPLM
PROGRAM UOUTP
C
C THIS IS PROGRAM UOUTPLM. IN THE ABOVE, PROGRAM NAME KJST
C NOT BE MORE THAN SIX CHARACTERS.
C
C OUTPLH MODIFIED TO USE UNIVERSAL DATA FILE WITH OPTIONS
C
C UP-TO-DATE AS OF AU6UST 1985 (NO CHANGES SINCE 7-31-85).
C JULY 31, 1985 REMOVED/MODIFIED ALL STATEMENTS INVOLVING ICEASE=1
C (NO DENSITY DATA FOR A GIVEN DEPTH) AS THAT CONDITION IS
C DETECTED IN SUBROUTINE LIMITS AND EITHER CORRECTED INTERACTIVELY
C OR THE PROGRAM 60ES TO THE NEXT DATA SET*
C JUNE 18, 1985 REVISED INTERACTIVE DATA INPUT SO USER MAY CORRECT
C ERRORS BEFORE RERUNNING THE PROGRAM.
C MARCH 27, 1985 CHANGE ANGLE OF DISCHARGE LIMITS FROM 0 TO 90 DSG
C TO -5 TO 90 DEG. AND THAT DZ CAN BE NEGATIVE IF 2 .GE. PDEP
C MARCH 19, 1985 RELOCATED THE INTERACTIVE RECYCLE STATEMENT
C C3 WRITE) TO 3 CONTINUE, THE FIRST STATEMENT UNDER INTERACTIVE
C CONTROL. ADDED STATEMENTS IN SUBROUTINE LIMITS TO DETECT
C ERRONEOUS RESPONSES TO PROGRAM PROMPTS I.E. .NE. TO YES OR NO.
C FEB 7, 1985. REVISED THE CALCULATION OF
C AK AND EINS IN THE MAIN COMPUTATIONAL SCHEME.
C
C0MM0N/WRITE/DPW(30),SAW(30),TAW(30),DENPW(30),DENPPWC3C)
COMMON/AVAR/DP(30),SA(30),TA(30>,DENP(30),DENPP(30)
COMMON/VAR/INTER,IDFP,ICUTOP,IOI,IOO,IHF,IEF,IAF,IIF,IIRF,QT,NP,
~PDIA,VANG,PDEP,UW,IR,HANG,SPACE,H,E,A,ITERB,NPTS,T,S,DEN,FR
COMMON/COUNT/NWO ,NW
COMMON/INOUT/IN,IO,IT
REAL*8 TITLEC10),TITLIC10)
BYTE IFILEC20),0FILE(20)
COMMON/TVAR/TITLE,TITLI,I FILE
DATA IFILEC20)/0/,OFILE(20)/0/
C
C;::::INITIALIZE CONSTANTS AND VARIABLES.
C
C IN THIS PROGRAM (POP SYSTEM - FORTRAN IV-PLUS),
C LOGICAL UNIT IN IS THE INPUT FILE.
C	"	10 IS THE OUTPUT FILE.
C	w	IT IS THE USER TERMINAL.
C
1^1
10*2
11*5
C
NWO=0
NW=0
6*9.807
ZERO*0.
TW0=2.
PI=3.1416
TORAD*PI/180.
C
C OPEN FILES
C
WRITECIT,554)
554	FORMAT(/IX,# •~~~~PROGRAM UOUTPLM, AUGUST 1985*^^^')
WRITECIT,555)
555	F0RMATC/1X," ENTER UDF NAME: ¦,S>
READ(IT#556)ClFILECI),1=1,19)
556	FORMAT(19A1)
WRITE(IT,557)
557	F0RMATC1X,1 ENTER OUTPUT FILE NAME: #,S>
READ (IT,556) (0 FILE( I) ,1=1 ,19)
openCunitsin^ame^ifil^type-'old1 )
23
-------
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
95
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
PROGRAM UOUTFLH
OPENCUNITsIO,NA*EsOFILE/nrPEs,NEU,>
C
C READ DATA FILE
C
85 NH0=Ni*>*N¥
NC'«#=0
LI*IT=0
KPAGE=0
CALL R0UTPC1^LIMIT)
XSCALE=0.
ZSCALE=0.
CALL USGRT(DP^SA#TA^DENP^NPTS)
DO 1003 J*1,NPTS
DPW(J)*DPCJ)
SAUCJ3-SACJ)
TAW(J)=TAU)
1003 CONTINUE
CALL LIKITSa*PBEP*VANG/r,$,NFrS,INTER#TITLE#TITLX,
*IEXIT,LIKIT>
IFCIEXIT .EQ. 0>G0 TO 38
CALL R0UTP<2,LINIT>
GO TO 85
3S IFLAG=1
IFCTACNPTS5 .EQ, 0.>IFLA&=0
KFLAG=1
IFCT .EQ. 0.3KFLAG=Q
IF CI FLAG .EG. 0>60 TO 1
DO 1000 I=1,NPTS
BENPCD-IOOO.-t-SISKATCSAd) #TACI>5
BENPWCl)=DENPtI>
1000	CONTINUE
GO TO 2
1	DO 1001 I=1#NPTS
DENPCX)=1000.*SA(I)
DENPUC2>=DEWPCI>
1001	CONTINUE
2	DO 1002 1=1,NPTS
DENPPCI)=DENPCI)-10D0-
DENPPtt(I)=DENPP(I)
1002	CONTINUE
C
C IF ONLY ONE DISCHARGE P0RT# PORT SPACING IS SET
C EQUAL TO 1000. TO PREVENT PLUSES MERGING FLAG.
C
IFCNP .EQ. 1)SPACE=1000.
IF(INTER .EQ. 0>G0 TO 19
C
C INTERACTIVE CONTROL
C
3	CONTINUE
IFCNCW .EQ. 0)TQ=T
IFCNCW .EQ. 0>SQ=S
IFCNCW *EQ. 05G0 TO 11
WRITECIT#103 CTITLECIK)#IK-1#10)
10	F0RWATC/1X," DO YOU WISH TO CHANGE ANT INPUT VARIABLES AND RERUN?1
+nt0* CASE I»D« %10A8/1X#* YES TO RERUN OR NO FOR NEXT CASE: '*$>
READ CIT#93 ANS
9 F0RWATCA1)
IFCANS -EQ. "T")G0 TO 11
- IFCANS .EQ. *N*>G0 TO 85
W*ITECIT,12)
12 P0RRATC/1X,' ***** TOU HADE A MISTAKE, TRY AGAIN ******>
50 TO 3
11	CONTINUE
IFCNCW .EQ. 0)WRITECIT,7> CTITLECIK)#IK=1,10>
24
-------
131
132
133
134
135
136
137
13a
139
140
141
142
143
144
145
146
14?
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
16?
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
PROGRAM UOUTPLM
7	F0RMATC/1X,1 CASE IDENTIFICATION:'/
•2X,1QA85
HRITECIT/13)
13	F0RMATC1X,* ¥NAT IS THE TITLE OF THIS INTERACTIVE RUN? •/
*2X^1)
*EAD(IT,6) CTITLlUlC>,IK»1,10>
6 FORMATC1OAS)
IFCNCW .EQ. 0)S0 TO 131
14	CONTINUE
URITECIT,110)OT^NP^PDIA#SPACE#VANG#PDEP,UW
110 F0RMATC/1X,' TOUR PRESENT INPUT VARIABLES ARE:*//
*1X#* 1. EFFLUENT FLOW (CMS)	«T *'^10.4/
•1X,# 2. NUMBER OF PORTS	NP =*,15/
*1X„' 3. PORT DIAMETER CM)	PDIA **,F10.4/
*1X^* 4. PORT SPACING CM)	SPACE *f,F9.3/
»1X,« 5. VERTICAL ANGLE W/HORZ CDEG) VANG =',F9.3/
*1X^§ 6. PORT DEPTH CM)	PDEP = *,F8.2/
•1X,* 7. AMBIENT CURRENT SPEED CM/SEC) U* =',F10.4>
IFCTQ .EQ. Q.)yRITECIT,130)SG
130 FORMATC
*1X,' 8. EFFLUENT DENSITY (S/CM3)	S *%F!1.5>
IFCTta .NE. 0.)HRITECIT#112)Sa#TQ
112 FORMATC
»1X," 8. EFFLUENT SAL (0/00)	S =,,F8-2/
*lX,t 9» EFFLUENT TEMP CDEG C)	T =',F8.2)
t*ITECZT,132)
132	F0RMATC/1X,' ENTER THE NUPBER OF THE VARIABLE
*	YOU WISH TO CHANGE* ',*)
REAM IT,! 15) NUMBER
115 F0RMATCI1)
tfCTH .EQ. 0. •AND. NUMBER .GE. 1 .AND. NUMBER JLE. 8)60 TO 15
IFCTQ .NE. 0. .AND. NUMBER .GE. 1 .AND. NUMBER .LE. 9)G0 TO 15
MtITEUT,12>
GO TO 14
15	CONTINUE
WRITEUT#16)
16	F0RMATC1X,* WHAT IS THE VALUE OF THIS VARIABLE?
READCIT#1S>VALUE
18 FORMATCF10.0)
IF (NUMBER .EQ. 1)QT*VALUE
IF(NUMBER .EQ. 2>NP=VALUE
IF(NUMBER .£Q. 3)PDIA»VALUE
IF(NUMBER .EQ. 4)SPACE*VALUE
IFCNP .EQ. 1.)SPACE*1000.
IF(NUMBER .EQ. 5)VANG=VALUE
IF(NUMBER .EQ. 6)PDEP*VALUE
IF (NUMBER .EQ. 75 UPVALUE
IFCNUMBER .EQ. 8)50=VALUE
IFCNUMBER .EQ. 9)TQ=VALUE
133	CONTINUE
MRITECIT/I7)
17	FORMATdX,* DO YOU WISH TO CHANGE ANOTHER VARIABLE?
•	YES OR NO: *,S)
READCIT,9)ANS
IFCANS .EQ. •*•>60 TO 8
ifCans .eq. *y#)go to 14
¥RITE(IT,12)
60 TO 133
8	CONTINUE
T&TQ
S=SG
CALL LIMITS(2,PDEP#VANS,T,S,NPTS,INTER,TITLE/nTLI,IEXIT,LrMIT)
IFCIEXIT .EQ. 0)60 TO 131
CALL R0UTPC2^LIMIT)
GO TO 85
25
-------
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
PROGRAM UOUTPLM
131 NC^1
C
C SETUP, AND PRINT INPUT DATA
C
19 CONTINUE
KIC=0
DO 120 K=1,NPTS
DPCK)=DPW(K)
SACO=SAWCK)
TA(K)=TAW(K)
DENPCK)=DENPWCK)
I F(KJC .GT. 0)G0 TO 120
IFCDP(K> .GE. PDEP3KK=K
120 CONTINUE
PRODIS* CPDEP-DPCKIC—1) ) / CDP(ICK)-DP(KK-1) )
XFCXFLAG .EQ. 1)G0 TO 123
DENA=DCNP(KK—1)~PRODIS* CDENP(KK)—DENPCK-1))
DENA=10C0.+SIGHAT(SAA/TAA)
124	CONTINUE
IFCT .EQ. 0.)DEW=S*1000.
IFCT .NE. 0.>DE^1000.+SIG*ATCS/T)
RHO=DEN
DENDI==DENA-DEN
DEN0L^=DENDIF
B=PDIA*0.5
SPAC2=SPACE*0.5
BSNEH=-B-SPAC2
VEL=(QT/NP)/(PI*B*B)
U=VEL*COSCVANG*TORAD>
V=VEL*SINCVANG*TORAD)
IFCVAN6 -EQ. 90.)U=0.
Ir(VANG .EQ. 0.)V=0.
V1=VEL
FR=VEL/SQRTCDENDIF/DEW*TWO*B*G3
ZVEI-ZERO
BSAVE=ZERO
X=ZERO
DB=1.
DD=1.
DT=1.
Z=PDEP
IFCKFLAG^IFLAG .EQ. 1)DEL=T—TA(NPTS)
DIL=1.
PnO=PI*B*B*H*DEN
P^PMO
G=Pn/DEN»VEL/H
AJC=9999.
IF(ABSCUU) .NE. ZERO)AK=VEL/UU
UO=U
ITRAP=0
ILAP=0
ILAPP=0
JPK=0
JTL*0
IFCIOI .EQ. 15G0 TO 22
IFOCPAGE .EQ. DGO TO 20
CALL R0UTP(2,LIHIT)
WRITECI0/102)
102 F0RHATC1K1/IX/U0UTPLK VERSION 1.0 AUGUST 1985 (BASED ON 0S3'
VERSION 2.3 5-16-79) V/!X,4(18('.'>,.2X))
WRITE(I0,119)CIFILE„IK=1/I9>
119 FORHATdX,' UNIVERSAL DATA FILE: '/I9A1>
I
26
-------
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
2 77
278
279
28C
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
PROGRAM UOUTPLM
WRITE(I0,111)(TITLE(IK),IK*1,10)
111 FORMATC2X,'CASE I.D. '/lOAS)
IFCINTER .EQ. 1 )WRITE(I0,113) (TITLICIK) ,IK=1,10)
113 FORMAT(2X,'RUN TITLES ',10A8)
CALL NOUTP(1,1 FLAG)
GO TO 23
20	XFCXOI .EQ. 2)60 TO 21
CALL ROUTP(2,LINIT)
WRITE(I0,102)
WRITECI0,119)(IFILE(IK),IK=1,19)
WRITE(IO,111)(TITLE(IK),IK»1,10)
IFCINTER .EQ. 1)URITE(I0,113) (TITLI(IK),IK*1,10)
CALL NOUTPC1,1FLA6)
GO TO 23
21	CALL N0UTP(3,IFLAG)
GO TO 23
22	CALL R0UTPC2,LIMIT)
WRITE(I0,101)
101 F0RMATC1 Hi ,1X, •		
•OUTFALL BUOYANT (JET) PLUME IN FLOWING, STRATIFIED AMBIENT
* •/
•1X,9 UOUTPLM VERSION 1.0 AU6UST 1985 (BASED ON 0S3 VERSION 23
•	5-16-79)')
WRITE<10,119)(IFILECIK),IK*1,19)
WRITE(I0,111) (TITLE(I), 1=1,10)
IFCINTER .EQ. 1)WRITE(I0,113)(TITLlCIK),IKx1,10)
WRITEC10,100)E,A,ITERB,IR
100 F0RMATC/1X,' E*',F5.2," A*'^^,' ITERe»',I5,' IR»*,I4)
IFCNP .EQ. 1)VRITE(10,43)PDIA,VANG
43	FORKATdX,1 PORT SPACING CM) ¦ 1000.0 (DEFAULT),',2X,
•'PORT DIA (M) «',F7.4,', PORT ANGLE CDEG) *',F5.1)
IFCNP .6T. 1) WRITE (10,4-4) SPACE,PDI A,VANG
44	F0RMATC1X,' PORT SPACING (M) * *#F6.2,
PORT DIA (M) *',F7.4,', PORT ANGLE CDEG) **,F5.1)
IF CI FLAG .EQ.DGO TO 105
WRITE(I0,117)
117 F0RMATC/1X,' AWIENT STRATIFICATION DEPTHS SIGMAT1)
WRITE(10,104)C(DPW(I),DENPPW(I)),1=1,NPTS)
104	FORMATC26X,F7.2,F8.2)
GO TO 23
105	WRITE (10,107)
107 F0RMATC/1X,' AMBIENT STRATIFICATION DEPTH,M SALIN
•	TEMP,C SIGMAT')
WRITE(I0,103) C(DPW(I),SAW(I),TAW(I),DENPPW(I)),I=1 ,NPTS)
103 F0RMAT(26X,2F7.2,2F8.2)
23	KPAGE=INTER
IFCIOO .EQ. 1)WRITE(10,200)AK,FR,Q,UW
200	F0RMAT(/2X,a	'/
••	K FROUDE	Q CURRENT'/1X,4(1PE9.2)//2X,
•	'	MODEL INPUT (LINE 1) AND MODEL OUTPUT	'/'	X
•	2	B THICK MASS EINS ZWEI DILUTION
•	DENDIFF HOR VEL VER VEL TOT VEL')
IFCIOO .EQ. 1 .AND. KFLAG*IFLAG .EQ. 1)WRITEC10,201)
201	FORHAT(1H+,110X,'TEW>DIF')
IFCIOO .EQ. 0)WRITEC10/210)
210 F0RMAT(//,7X,'X'^X,'Z,^X,'PLUME'^X,'DILl>-'^X,'DENDIFF,^X,
•'HORIZ'^X,'VERT',4X,'TOTAL',/,22X,'RADIUS',5X,'TI0N',15X,'VEL#,
•6X,,VEL,^X,'VEL,,/^X,'(M),^X,,CM)'^X,'(M),,13X,,(SIGMA)t^X,
*'(M/S)',4X,'CM/S)'yCX,'(M/S)1,/)
C
C MAIN COMPUTATIONAL SCHEME
C
DO 2000 J=1,ITERB
DO 2001 I=1,NPTS
IF (DP(I) .GE. 2)60 TO 24
27
-------
326
327
328
329
330
331
332
333
334
335
336
337
333
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
PROGRAM UOUTPLM
2001 CONTINUE
24 LL«I
LU»I-1
PRODIS»(Z-DPCLU))/CDPCLL)-DPCLU))
IFCIFLAG .EQ. 0)GO TO 26
TT=TA(LU)+PRODIS*CTA(LL)-TA(LU))
SS=SA(LU)~PRODIS*(SA(LL)—SA(LU))
DENA=1000.*SlGHAT(SSyTT)
GO TO 27
26	DENA=DENP(LU)+PRODIS*
27	EINS=E*DENA*DT*B*H»CABS(UW»TWO*V)/VEL*'UW*PI/DD*CU*DB/VEL*'B/TVO»
•CU/VEL-U0/V1)))
ZWEI=TVO*PI*DENA*H*B*ABSCVEL-UW*U/VEL)*A*DT
O^EINS
IF (ZWEI .GT. EINS) DF^ZtfEI
GAPWA=D«/.0069555/PW
BT^OT/GAHMA
EINS=EINS/GANHA
DM/GAMMA
IFCJ .GT. 1)60 TO 29
IF(IOO .EQ. 2)G0 TO 29
IFUOO .EQ. 1 .AND. KFLAG*IFLAG .EQ. 1)WRITECI0,230>X,Z,B,H,
~PW,EINS,ZWEI,DIL,DENDIF,U,V,VEL,DEL
230	F0RMATClX/t4C1PE9.2>)
IFCIOO .EQ. 1 -AND. ICFLAG*IFLAG .EQ. 0)WRITEC10,230)X#Z,B,H,
*P«,EINS,ZVEI,DIL,DENDIF,U#V,VEL
IF
-------
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
PROGRAM IKHJTPLM
ZTRAO=ZOL^TTRAP* CZ-ZOLD)
DILTAP»DILOL£H-TTRAP* CDIL-DILOLD)
If(100 .N6. 2)WRITECIO,84)
84 F0RMATC1X,' •••••NORMAL TRAPPING LEVEL REACHED')
80	CONTINUE
BSOLD»BSNEW
BSNEtf=B-SPAC2
IFCBSNEtf .LT. 0)60 TO 82
IFCILAP .EQ. 1)60 TO 82
ILAP*1
JPmj
IFCITRAP .EQ. 0)ILAPP=1
IFCITRAP .EQ. 1)ILAPP=2
X1»B-BSAVE
X2-SPAC2-BSAVE
Y1-Z0LD-Z
Y2-X2*Y1/X1
ZMR=Z0L0-Y2
DILf*DIL0LD+CDIL-DIL0LD)*X2/Xl
IFCIOO .EQ. 2)G0 TO 82
IFULAPP -EQ. 1)WRITE(10,240)ZMR,DILM
240	F0RMATC1X,f -••••PLUMES MER6E AT#,F7.2,' M BELOW THE
•	SURFACE WITH AN AVE. DILUTION 0Ff,F6.1/
•1X,' •••••FOLLOWING CALCULATIONS DO NOT ACCOUNT FORNSERGING')
IFCILAPP .EQ. 2)WRITEC 10,242)
242 F0RMATC1X,* •••••PLUMES MERGE, WHICH IS NOT ACCOUNTED FOR
*	IN THE FOLLOWING CALCULATIONS1)
IFCJPM .EQ. JTL .AND. JTL .6T. 0)WRITE<10,241)
241	F0RMATC1X," •••••PLUMES MERGED AND TRAPPED AT THE SAME TIME")
82 CONTINUE
DZZ'DZOLD
DZOLD*DZ
ZOLDZ=ZOLD
ZOLD=Z
DENOI'DENOLD
DENOLD=DENDIF
DILZ=DIL0LD
DILOLD*DIL
IFCJ .EQ. DGO TO 81
IFCJ/IR -CJ-D/IR .NE. 1)60 TO 2000
81	IFCKFLAG*IFLAG .EQ. 1 .AND. 100 .EQ. 1)WRITECI0,230)X,Z,B,H
•PM,EINS,ZWEI,DIL,DENDIF,U,V,VEL,DEL
IFOC FLAG*I FLAG .EQ. 0 .AND. 100 .EQ. 1>WRITECI0,230)X,Z,B,K
•PM,EINS,ZWEI,DIL,DENDIF,U,V,VEL
IFCIOO .EQ. 0)WRITECIO,231)X,Z,B,DIL,DENDIF,U,V,VEL
2000 CONTINUE
ICEASE=4
90 CONTINUE
C
C:::::PRINT FINAL RESULTS
C
IFOC FLAG*IFLAG .EQ. 1 .AND. 100 .EQ* 1)WRITECI0,230)X,Z,B,H
•PM,EINS,ZWEI,DIL,DENDIF,U,V,VEL,DEL
IFCKFLAG*IFLA6 .EQ. 0 .AND. 100 .EQ. 1)WRITECI0,230)X,Z,B,H
•PM,EINS,ZWEI,DIL,DENDIC,U,V,VEL
IFCIOO .EQ. 0)WRITE-I0,231)X,Z,B,DIL,DENDIF,U,V,VEL
WRITECIO,250)J
IFCICEASE .EQ. 4)WRITECI0,254)ITERS
IFCICEASE .EQ. 4)60 TO 91
IFCICEASE .EQ. 2)WRITECI0,252)
C
C:::::IF THE VERTICAL VELOCITY WENT THRU ZERO, BUT DID NOT TRAP,
C	CALCULATE THE DILUTION WHEN VERTICAL VELOCITY WAS ZERO.
C
IFCITRAP .EQ. 0 .AND. ICEASE .EQ. 2)
29
-------
PROGRAM UOUTPLM
456	*DILD2SDILOLD+DZOLD*C (DIL0Lt>"DIL2)/ CDZZ—D20LD) )
457	249 CONTINUE
458	IFCICEASE .EQ. 3)WRITE(IO,253)
459	C	^
460	C:::::IF THE PLUME SURFACED BUT DID NOT TRAP, CALCULATE THE
461	C	DILUTION AT THE SURFACE.
462	C
463	IFUTRAP .EQ. 0 .AND. ICEASE .EQ. 3)
464	•dilsur=dilold+zold*ccdilol^dilz>/czoldz-26ld))
465	C
466	C:::::IF JPffcJTL AND NOT ZERO, MERGING ANO TRAPPING
467	C	OCCURRED AT THE SANE TIME.
468	C
469	IFCJPM .EQ. JTL .AND. vTL -GT. 0)60 TO 264
470	C
471	IFCITRAP .EQ. 0 .AND. ILAP .EQ. 0)WRITECI0,248)
472	IFCITRAP .EQ.'O .AND. ILAP .EQ. 1 .AND. ICEASE .EQ. 2)
473	*WRITEC10,246? "
474	IFCIT^'.EQ. 0 .AND. ILAP .EQ. 1 .AND. ICEASE .EQ. 33
475	*WR ITE G10,263)
476	^IrCITRAP .EQ. 1 .AND. ILAPP .EQ. 1)WRITECI0,261)
477	* IFCITRAP .EQ. 1 -AND. ILAPP .EQ. 2)WRITECI0,267)
478	IFCJPM .LT. JTL .AND. 100 .EQ. 2)WRITE(I0,268) DILM,ZMR
4r7	IFCITRAP .EQ. 1)WRITECIO,260)ZTRAP,DILTAP
'480	IFCITRAP .EQ. 0 .AND. ICEASE .EQ. 2)WRITE(10,247)DILD2
481	IFCITRAP #EQ. 0 .AND. ICEASE .EQ. 3)WRITECI0,262)DILSUR
482	GO TO 91
483	C
484	264 CONTINUE
485	WRITE(10,265)ZTRAP,DILTAP
486	C
487	91 CONTINUE
488	IFCINTER .EQ. 0)GO TO 70
489	IFCICEASE .EQ. 4)WRITECIT,254)ITERB
490	IFCICEASE .EQ. 4)60 TO 70
491	IFCICEASE .EQ. 2)WRITE(IT,252)
492	IFCICEASE .EQ. 3)WRITECIT,253)
493	IFCJPM .EQ. JTL .AND. JTL .GT. 0)60 TO 266
494	IFCITRAP .EQ. 0 .AND. ILAP .EQ. 0) WRITECIT,2^)
495	IFCITRAP .EQ. 0 .AND. ILAP .EQ. 1 .AND. ICEASE .EQ. 2)
496	*WRITECIT,246)
497	IFCITRAP .EQ. 0 .AND. ILAP .EQ. 1 .AND. ICEASE .EQ. 3)
498	*WRITECIT,263)
499	IFCITRAP .EQ. 1 .AND. ILAPP .EQ. 1)WRITE(IT,261)
500	IFCITRAP .EQ. 1 .AND. ILAPP .EQ. 2)WRITECIT#267)
501	IFCJPM .LT. JTL .AND. 100 .EQ. 2)URITECIT,268)DILM,ZMR
502	IFCITRAP .EQ. 1>WRITECIT,260)ZTRAP,DILTAP
503	IFCITRAP .EQ. 0 .AND. ICEASE .EQ. 2)WRITECIT,247>DILDZ
504	IFCITRAP .EQ. 0 .AND. ICEASE .EQ. 3)WRITECIT,262)DILSUR
505	GO TO 70
506	266 WRITECIT,265)ZTRAP,DILTAP
507	C
508	C
509	246 F0RMATC/1X," PLUMES MERGED BEFORE VERTICAL VELOCITY WENT
510	* THRU ZERO")
511	247 F0RMATC1X,' WHEN V=0, DILUTION = ',F10.2)
512	248 F0RMATC/1X,' PLUMES DID NOT TRAP OR MERGE')
513	250 F0RMATC/1X,* NUMBER OF STEPS='I5)
514	252 F0RMATC/1X," COMPUTATIONS CEASE; VERTICAL PLUME VELOCITY
515	* WENT THRU ZERO')
516	253 F0RMATC/1X,' COMPUTATIONS CEASE: PLUME HITS WATER SURFACE')
517	254 F0RMATC/1X,' COMPUTATIONS CEASE: NUMBER OF STEPS EXCEEDS*,15,
518	*' CPARAMETER ITERS)')
519	260 F0RMATC/1X," TRAPPING LHVEL=t,F7.2,* M BELOW WATER SURFACE,
520	* DILUTION*1,F7.2)
30
-------













"S.




t

u>




S

W



K.
•

C
o


•
H

3
m
a


•
UJ
Z
S\
s!
UJ


K
o
O

X


M
M
UJ
Z
CI


H
H
X
UJ
<

r*

5
u
£
UJ

•
UJ
J
<
5 '
OC

UJ
c
M
UJ



u
3
a
a
•
_J

<

• K
UJ
UJ
UJ
•
UJ
u
O
C
3
f
Li
<
U.
a
%
10
*
S2
K
OC

•
z
•
2
<
3
u>
V)
M
H
M

R
z
<
a.

X
a

M
9
Q,
Z
u
UJ
a
0.


o
<
a.
o
a
Z
a
M
UJ
a,
-j
<
O
H
t
a
«
UJ
pt
M

b

p
m

»-
UJ
_i
UJ
P


3
OC
H
oc

K
a
-J
O
A
o
o

UJ
M
u.

ik
z

h
o
UJ
s
UJ
«c
\
L

00

03

rvj
<
UJ

UJ

a
•

i9
a
CI
o
UJ
K
A
<
UJ
<
UJ
U)
Ik
UJ
OC
10
Ik
19
OC
SiO
UJ
a
OC
•k
tiJ
m
OC
> 1
UJ
m
8
UJ
c
K
H
UJ
K
<



to
J


V)
iu
in
u
UJ
vt
II 1
UJ
c
UJ
E
>
UJ
UJ
E
3
E
3
UJ
c
H
a
J
3
•J

3
9

a.
•J
a.


Z
0.

ft.

a
a.


«

•
z


—
s
m

H
•
%
*
K
\
X
fl.
%
K
X
T-
X
r-
0,
X

r*
V.

*s.
<

*s.
V/
w
w


w
V
•-
K
h-
H
h-
H
H
<
<
<
<

<
<
2
C
£
£

£
r '
oc
a
oc
oc

OC
5
o
o
o
O
K O
o
Ik
Ik
ik
ik
T**
u.
u.
r*
f\J
n
IA
ft
N
*9

o

H H f-
£883
o m a o a t-
tS'XCXS
Ik V «
<• H A || H I || H »
l!k U. u. uL C£ ilk r u> O
< H H
£11	M • ||
Ik «- u.
4X II UJ	II
M UJ H	<
r-	(VJ ro ^	IA
N	r\j rg rvj	fu
m inj J3 fsi
V>IAIOIA
IA«K«0O>aT-rJhW^«N«0{*OT-<>l^^in^N0g(>Or-ru»^ain<0N«0aqr-Nn*iA^NCg'Qr»<>Jj0;4
IN/NNNNMMMWMMKihMM't'l^'I'i'l^^sf'llrtlAlAIOlftlAIAlAIAin'O'O'O'O'O'O'O'O^'O^KKSNNNNSNjSJOIOJOfP
-------
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
PROGRAM UOUTPLM
IAF=0
26	IF
-------
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
66?
663
669
670
671
672
673
674
675
676
677
678
679
680
681
682
633
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
70S
706
707
708
709
710
711
712
713
714
715
PROGRAM UOUTPLN
COMMON/ TVAR/TITLE ,TITLI ,1 FILE
COMWON/INOUT/IN,IO,IT
DATA IFIL£C20>/0/,OFILEC203/0/
IFCK-231,2,3
1	IFCIHF .EG. 03*i*ITECl0,1113
IFCIHF .EQ. 13WRITECIO,1123H
IFCIEF .EQ. 05WRITE(10,1133E
IFCIEF .EQ. 1)WRITEaO,1143E
IFCIAF .EQ. 03WRITECIO,1153A
IFCIAF .EQ. 1)WRITE(10,116)A
IFCIIF .EQ. 0)WRITE(I0,1173ITERS
IFCIIF .EQ. 13WRITEC10,1185 ITERB
IFCIOO .EQ. 23GO TO 128
IFCIIRF .EQ. 03WRITE(I0,1193IR
IFCIIRF .EQ. 13WRITE(10,1203IR
128 WRITE(10,122)UW
IF(T .NE. 03WR1TE(I0,1233T
IF(T .NE. 0.3WRITECIO,1243S
DEN1*DEN-1000.
WRITEao,12S)DEN1
WRITE(XO,1263FR
IF(IFLAG .EQ. 0360 TO 134
WR1TECI0,1313
WRITEClO,1323CCDPWCI3,SAWCX3,TAWCl3,DENPPWCI3 3,I=l,NPTS3
SO TO 2
134 WRITEC10,1353
WRITEC 10,1333 CCDPWCI3,DENP*WCI)3,I=1 ,NPTS3
2	WRITEC10,2003
WRITEC10,2013QT
WRITEC10,2023 HP
WRXTE(10,203)PDIA
IFCNP .ST. 13WRITEC10,1213SPACE
IFCNP .E«. 13WRITEC10,1273
WRITES10,204)VANG
WRITECIO«2053FDEP
RETURN
3	CONTINUE
WRITEC 10,210) CTITLI < IK3 ,IK=1,103
WRITEC 10,1263 Ft
60 TO 2
111	F0RMATC/2X,"INITIAL THICKNESS OF PLUME ELEMENT * PORT RADIUS *
*,* C&EFAULT3 * 3
112	F0RNATC/2X,*INITIAL THICKNESS OF PLUME ELEMENT ««,F9.2,t N*3
113	F0RNATC2X,'IMPINGEMENT ENTRAINMENT COEFFICIENT =%F9.2,4X,
**(DEFAULT3 *3
114	F0RMATC2X,'IMPINGEMENT ENTRAINMENT COEFFICIENT =*,F9.23
115	F0RNATC2X,'ASPIRATION ENTRAINNENT COEFFICIENT -f,F9.2,4X,
*•(DEFAULT3')
116	F0RHAT(2X,#ASPIRATION ENTRAINNENT COEFFICIENT =%F9.23
117	FORNATCZX,1NUMBER OF STEPS ALLOWED*,13X,#=",16,TX,*CDEFAULT3 *3
118	FORMAT(2X,* NUMBER OF STEPS ALLOWED1,13X,,= i,163
119	F0RBATC2X,'PRINTOUT INTERVAL*,19X,*=#,I6,7X,* (DEFAULT) *3
120	F ORM AT £ 2X,* PRINTOUT INTERVAL',19X,*=',163
121	F0RMATC2X,• PORT SPACING',24X,*=f,F9.2,' N"3
122	F0RMATC/2X,1 AMBIENT CURRENT SPEE0,,15X,t=,,F9.2,' N/S"3
123	F0RMATC2X,'INITIAL TEMPERATURE OF THE PLUME•,4X,'**.!!9.2,4X,
••DEGREES CENTIGRADE^
124	F0RMATC2X,*INITIAL SALINITY OF THE PLUME,,7Xrt=,,F9.2," PPT1)
125	F0RMATC2X,1 INITIAL DENSITY OF THE PLUME,^X,,«#,F11 .4,
*• SISMAT UNITS*3
126	FGRMATC1X,* ?ROUDE NUMBER,^3X,,=,,F8.13
127	F0RMATC2X,* PORT SPACING*,24X,,= 1000.0 NCDEFAULT)•)
131 F0RWATC/3X,* DEPTH1,4X,* SALIN*,SX,* TEMP',3X,1S1GNAT*,/,4X,
33
-------
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
PROGRAM UOUTPLM
~' (M) 1,5X,'(PPT)•,5X,'(C)',/)
132	F0RMAT(1X,F7.2,3F9.2>
133	F0RMATC1X,F7.2,F9.2)
135 F0RMATC/3X,'DEPTH*,3X,'SIGMAT'/4X,'(M)")
200	FORMAT(lX)
201	FORMATC2X,'TOTAL EFFLUENT FL0W',17X,' = ',F11 .4,' CHS*)
202	F0RMATC2X,1NUMBER OF PORTS',21X,'»',16)
203	FORMAT(2X,'PORT DIAMETER',23X,' = '^11 .4,' M*)
204	F0RMATC2X,1VERTICAL PORT ANGLE FROM HORIZONTAL = ',F8.1,5X,
~'DEGREES')
205	FORMATC2X,'PORT DEPTH',26X,'=',F9.2,' M'>
210 FORMATC/2X,70CX"),//2X,'RUN TITLE: ',10AS)
END
C
SUBROUTINE LIMITSUIC,PDEP,VANG,T,S,NPTS,INTER,TITLE,TITLI,
•IEXIT^IMIT)
C
C THIS SUBROUTINE CHECKS LIMITS .OF PORT DEPTH (GREATER THAN 0- AND
C LESS THAN OR EQUAL TO PROFILE DEPTH), DISCHARGE ANGLE (EQUAL TO
C OR GREATER THAN -5 DEG BUT LESS THAN OR EQUAL TO 90 DEG,
C VERTICAL, AND IF NEGATIVE, THAT THERE IS AT LEAST ONE PROFILE
C DATA POINT AT LEAST ONE METER BELOW THE PORT DEPTH). THAT THE
C EFFLUENT DENSITY IS LESS THAN THE AMBIENT DENSITY AND THAT THERE
C ARE AK3IENT PROFILE VALUES FOR THE SURFACE, IF INTER=1, THE PORT
C DEPTH, ANGLE AND EFFLUENT DENSITY CAN BE CORRECTED INTERACTIVELY
C BUT SURFACE DATA AND PROFILE DEPTH CORRECTIONS MUST BE MADE TO
C THE DATA SETCSS AND REENTERED. IF INTER=0, ALL CORRECTION MUST BE
C MADE TO THE DATA SETCS) AND REENTERED.
C
COHMON/WRITE/DPW(30),SAW(30),TAW(30),DENPWC30),DENPPW(30)
COMMON/IN0UT/IN,I0,IT
REAL*8 TITLEC10),TITLI(10)
LIMIT=0
IDEEP=0
IVANS=0
HEGANG=0
IRHO=0
IN0=0
IEXIT=0
100 IF(PDEP .EQ. 0. .OR. DPWCNPTS) .LT. PDEP)G0 TO 1
10 1F(VANG .LT. G. .OR. VANG .ST. 90.)G0 TO 101
30	IF(T .EQ. 0.)RHOE=S
IF(T .NE. 0.)RH0E=1.+0.001*SIGMAT(S,T)
DO 31 /-2,NPTS
IF(PDEP .LE. DPW(J))G0 TO 32
31	CONTINUE
GO TO 40
32	JK»J
PRfr=CPDEP-DPWCJK-1)>/(DPW(J>0-DPWCJK-1>>
TT«TAW C J K-1)+PRO* C- A'J ( J K)-TAW ( J K-1) )
SS=SAW(JK-1)+PR0*(Sr\W
-------
PR06RAN UOUTPLH
781
782
783
784
IFCNANS .NE. 'Y#>60 TO 120
IRH02
IFCT .EQ. 0.)G0 TO 36
WRITECIT,34)
785	34 F0RHATC/1X,' NEW EFFLUENT TEW> VALUE? ',*)
786	READCIT,7)T
787	WRITECIT,35)
788	35 F0RHATC1X,' NEW EFFLUENT SAL VALUE? ",S>
789	READCIT,7)S
790	GO TO 30
791	36 WRITECIT,37)
792	37 FORHATC/1X,f NEW EFFLUENT DENSITY VALUE? *,$)
793	READCIT,7)S
794	GO TO 30
795	101 IFCVANG .LT. -5, .OR. VANG .GT. 90.)G0 TO 11
796	C
797	C:::::IF CONTROL IS NOT PASSED TO 11, VANG .GE. -5. BUT .LT. 0.
798	C	BECAUSE IT'S NEGATIVE, PROFILE DEPTH BUST BE AT LEAST ONE
799	C	METER DEEPER THAN THE PORT DEPTH.
800	C
801	IFCDPWCNPTS)—PDEP .GE. 1.05GO TO 30
802	NE6ANG=1
803	C
804	1 IDEEP*1
805	LIHIT*1
806	IFCINTER .EQ. 0)60 TO 10
807	121 CONTINUE
808	IFCPDEP .EQ. 0.)WRITECIT,2)
809	2 F0RNATC/1X,' ZERO DISCHARGE DEPTH NOT ALLOWED,
810	* CHANGE PORT DEPTH.1)
811	IFCPDEP .GT. 0. .AND. OPW(NPTS) .LT. PDEP)
812	~WRITECIT^) PDEP,DPWCNPTS)
813	3 F0RHATC/1X,' PORT DEPTH C',F6.2,' H> IS DEEPER THAN'/
814	*1X," THE PROFILE DEPTH Ci,F6.2," B), CHANGE PORT DEPTH.')
815	IFCNEGANG .EQ. 1)WRITECI0,21>PDEP,DPWCNPTS)
816	21 FORNATC/lX,f FOR A NEGATIVE DISCHARGE ANGLE, THE PORT DEPTH C
817	*,F8^,f N) BUST BE ATV1X,* LEAST ONE HETER LESS THAN THE PROFILE
818	* DEPTH C',F8.4,f «), CHANGE PORT DEPTH.')
819	WRITECIT,4)
820	4 F0RMATC/1X,' WANT TO RAKE CORRECTION? YES/NO ',*)
821	READ(IT,5)NANS
822	5 FORMAT CAD
823	IFCNANS .EQ. 'N')GO TO 10
824	IFCNANS .NE. 'Y'JWRITECIT^OO)
825	IFCNANS .NE. 'Y')GO TO 121
826	IDEEP=2
827	WRITECIT^)
828	6 F0RHATC1X,' NEW VALUE? ",S)
829	READCIT,73PDEP
830	7 F0RBATCF7.0)
831	GO TO 100
832	11 IVANG-1
833	LIHIT=1
834	IFCINTER .EQ. 0)G0 TO 30
835	122 CONTINUE
836	WRITE CIT,12)VANG
837	12 F0RHATC/1X,' DISCHARGE ANGLE C',F6.1,') IS NOT IN THE
838	« RANGE OF —5 TO 90 DEG')
839	WRITECIT,4>
840	READ(IT,5)NANS
841	IFCNANS .EQ. *N'3G0 TO 30
842	IFCNANS .NE. 'Y')WRITECIT,200)
843	IFCNANS .NE. 'Y^GO TO 122
844	IVANG=2
845	WRITE(IT^)
35
-------
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
PROGRAM UOUTPLM
READCIT,7)VANG
GO TO 10
40	IFCDPWC1) .EQ. 0.)G0 TO 50
IN0*1
LI*IT=1
IFCINTER .EQ. 0>G0 TO 50
WRITECIT,4D CTITLEU) ,K=1,10)
41	FORMAT(1 Hi/1X,• COMPUTATIONS CEASE F0RV1X,' CASE I.D. ',10A8)
WRITECIT,44) CTITLICK) ,K=1 ,10)
44 F0RMATC1X,' RUN TITLE: B,1QA8)
WRITECIT,42)
42	FORMATC/1X,* NO SURFACE DATA FOR THE AMBIENT DENSITY/CURRENT
*	PROFILE.'/1X," WITHOUT THESE DATA, COMPUTATIONAL ERRORS
*	MAT OCCUR.V1X,1 MAKE CORRECTIONS TO DATA SET(S) AND REENTER.*)
WRITECIT,43)
43	FORMATC/1X," GOING TO NEXT DATA SET IF THERE IS ONE.')
50	IFCLIMIT .EQ. 0)GC TO 70
IFCINTER .EQ. DGO TO 69
51	WRITECIO,4DCTITLECK),K=1,10)
IFCINTER -EQ. 0)G0 TO 73
IFCKIC .EQ. 2)WRITE(I0,44)CTITLlClO,IC=1,10)
WRITECIT,41)(TITLECK),K=1,10)
IFCKK .EQ. 2)WRITECIT,44)CTITLICK),K=1,10)
WRITECIT,74)
74 F0RHATC/1X,1 NECESSARY CORRECTIONS NOT MADE!')
WRITE(IT,43)
73 WRITEC10,67)
67	F0RMATC/1X,' CORRECT THE FOLLOWING AND REENTER DATA.')
IEXIT=1
68	IFCIDEEP .EQ. 0)G0 TO 52
IFUDEEP -EQ. 1)WRITEC10,56)PDEP
IFCIDEEP .EQ. 2)WRITEC10,57)PDEP
52	IFCIVANG .EQ. 0)GO TO 54
IFCIVANG .EQ. DWRITEC 10,58)VANG
IFCIVANG *EQ* 2)URITECI0,59)VANG
54	IFCIRHO .EQ. 0)G0 TO 55
IFCIRHO .EQ. DWRITEC 10/643
IFCIRHO .EQ. 2>WRITEC10,65)RHOE
55	IFCINO .EQ. 0)60 TO 75
WRITECI0,42)
WRITECI0,43)
60 TC 70
69	IFCIDEEP .EQ. 1 .OR. IVANG .EQ. 1 .OR. IRHO .EQ. 1
*.0R. INO .EQ. DGO TO 51
WRITEC10/66)CTITLE CO,K=1,10)
IFCOC .EQ. 2)WRITECI0,44)CTITLICK),K=1,10)
WRITEC10,71)
GO TO 68
56	FORMATS
~IX,* PORT DEPTH WAS ENTERED AS ',F6.2,' METERS:"/
~IX,' IF THE DISCHARGE ANGLE IS POSITIVE. THE PORT DEPTH *JST'/
~IX,' BE GREATER THAN ZERO BUT LESS t>;aN OR EQUAL TO THE PROFILE
*	DEPTH.V
*1X,' IF THE DISCHARGE ANGLE IS NEGATIVE, THE PORT DEPTH WST'/
*1X,' BE AT LEAST ONE METER LESS THAN THE PROFILE DEPTH.')
57	F0RHATC1X,' PORT DEPTH CHANGED TO: ,,F6-2,' M')
58	F0RMATC1X,' DISCHARGE ANGLE C#,F6.1,')
» MUST BE .GE. -5 BUT .LE. 90 DEG*)
59	FORMATCIX,* DISCHARGE ANGLE CHANGED TO: ,,F4.1,' DEG')
64	F0RMATC1X,' EFFLUENT DENSITY MUST BE .LT. AMBIENT
» DENSITY AT THE DISCHARGE DEPTH')
65	F0RMATC1X,' EFFLUENT DENSITY CHANGED TO: ',F7.5,' G/CM3')
66	FORMATC1H1/1X,' COMPUTATIONS CONTINUE F0R'/1X,' CASE I.D. *,10A8)
71 F0RMATC1X,' CORRECTIONS WERE INTERACTIVELY MADE TO
*	THE FOLLOWING:'/)
36
-------
PR0GRAH UOUTPLH
911
200
F0RHATC/1X,1 ~~•~~YOU HADE A MISTAKE, TRY AGAIH******)
912
75
IFCIEXIT .EQ. 1)WRITEC10,43)
913
70
RETURN
914

END
915
C

916

SUBROUTINE USORT
917

DIMENSION DP(30),XC30)/rC30>,Z<30>
918

NESTED=NPTS
919

L*NESTED-1
920

DO 1000 f^1,L
921

NESTED*NESTED-1
922

DO 1000 1«1^NESTED
923

IFCDPCI) .LE. DPCI+D5G0 TO 1000
924

DUHHY-DPCI)
925

DP(I)=DPCI*1)
926

DP«XCI+D
929

XCI*1)=DUH«Y
930

DUPWY=YCI)
931

Y(I>*YCI*1)
932

Y(I*1)=DU«Mr
933

DUPWY=Z(I)
934

ZC)*2(I+1)
935

zci+o*dunky
936
1000
CONTINUE
937

RETURN
938

END
939
c

940

FUNCTION SI6HAT(SAL,T)
941

SIG0=
-------
SECTION 4
UDKHDEN Listing
38
-------
PROGRAM UDKHDEN
1	PROGRAM UDKHDE
2	C
3	C THIS IS PROGRAM UDKHDEN WRITTEN FOR A POP 11/70 (FORTRAN IV-PLUS).
4	C IN THE ABOVE, PROGRAM NAME MUST NOT BE MORE THAN SIX CHARACTERS.
5	C
6	C UP-TO-DATE AS OF AU6UST 1985 (NO CHANGES SINCE 6-19-85).
7	C JUNE 19, 1985 CHANGED CO TO COE IN TWO WRITE LISTS, ONE IS THE
8	C OUTPUT HEADING AND THE OTHER IS THE INTERACTIVE LIST. ADDED TWO
9	C IF STATEMENTS SETTING COE=CO AND TOE=TO FOLLOWING INPUT CHANGES
10	C IN THE INTERACTIVE MODE. ADDED THE BOXED NOTE FOLLOWING THE TITLE
11	C OF THE UNIVERSAL DATA FILE NAME. REWROTE THE OUTPUT MESSAGE WHEN
12	C PORT DEPTH WAS TOO DEEP.
13	C APRIL 17, 1985 MODIFIED PROGRAM TO ACCEPT A NEGATIVE DISCHARGE
14	C ANGLE I.E. VANG *GE. -5 .AND. .LE. 130 OEG. THIS REQUIRED CHANGES
15	C IN SUBROUTINES ZFE (ADDED ONE STATEMENT) AND LIMITS (ADDED SEVERAL
16	C STATEMENTS AND CHANGED SOME). ALSO, REMOVED MANY STATEMENTS FROM
17	C SUBROUTINE 0UTP1 THAT CALCULATED VARIABLES IN THE ZONE OF FLOW
18	C ESTABLISHMENT AND OUTPUT THEM IN THE OLD VERSION (DKHPLM).
19	C MARCH 19, 1985 ADDED STATEMENTS IN SUBROUTINE LIMITS TO DETECT
20	C ERRONEOUS RESPONSES TO PROGRAM PROMPTS I.E. .NE. TO YES OR NO.
21	C MARCH 12, 1985. ADDED A WRITE *****PROGRAM UDKHDEN, ??? 1985*****
22	C FEBRUARY 20, 1985* CHANGED GM/CC TO G/CM3.
23	C JANUARY 28, 1985. CONVERTED FROM SINGLE TO DOUBLE PRECISION
24	C AND CHANGED FOUR OUTPUT ~IFC~ STATEMENTS INVOLVING ISURF AND ITRAP.
25	C JANUARY 23, 1985. CALL USORT ARGUMENT PI CHANGED TO ZUA.
26	C JAKUARY 17, 1985. COMMENTS ADDED RE LOGICAL UNITS **INM, "IOUT-
27	C AND -ITERM". ALL ~READ(3," CHANGED TO "READCIN," AND ALL READC5
28	C AND WRITE(5 CHANGED TO READCITERM AND WRITE(ITERM .
29	C REVISED OCTOBER 10, 1984.
30	C LIMIT OF THE VERTICAL DISCHARGE ANGLE (VANG) CHANGED TO RANGE
31	C FROM GREATER THAN OR EQUAL TO 0 DEG TO LESS THAN OR EQUAL TO
32	C 130 DEG. ALSO CHANGED THE SUBROUTINE SIGMAT (ONE PLACE) FROM
33	C (T—3.98)**2 TO (T-3.98)*(T-3.98). THE LATTER GIVES CLOSER
34	C AGREEMENT WITH H.O. PUB. NO. 615. TABLES FOR SEA WATER DENSITY.
35	C
36	C THIS PROGRAM CALCULATES THE CHARACTERISTICS OF A LINE OF EQUALLY
37	C SPACED BUOYANT DISCHARGES INTO A FLOWING STRATIFIED AMBIENT WATERS.
38	C THE METHOD OF SOL*N INVOLVES 7 ORDINARY DIFFERENTIAL EQUATIONS
39	C WHICH ARE 1. CONSERVATION OF MASS 2. CONSERVATIONS OF ENERGY
40	C 3. CONSERVATION OF CONCENTRATION 4. DENSITY DEFICIENCY
41	C 5.6.7. MOMENTUM EQNS IN THE Z (AXIAL), K (VERTICAL) J (HORIZONTAL
42	C AND PARALLEL TO AMBIENT CURRENT DIRECTION) EQN 4 IS USED ONLY
43	C IN ALGEBRAIC FORM. THE SIX OTHER EQUATIONS ARE WRITTEN FOR
44	C A CONTROL VOLUME WHICH IS FINITE IN A DIRECTION PERPENDICULAR
45	C TO THE JET AND INFINITESIMAL IN THE DIRECTION OF THE JET AXIS.
46	C OUTPUT IN THE ZONE OF FLOW ESTABLISHMENT HAS BEEN SUPPRESSED.
47	C
48	C
49	C
50	C
51	C
52	C
53	C
54	C
55	C
56	C
57	C
58	C
59	C
60	C
61	C THIS IS A UNIVERSAL DATA FILE (UDF). IT IS THE INPUT FILE
62	C PRESENTLY USED BY FOUR OTHER PLUME PROGRAMS.
63	C INPUT CONSISTS OF FIVE (OR SIX) CARDS AND AN AMBIENT TABLE
64	C FOR EACH RUN. SETS OF CARDS CAN BE STACKED FOR MULTIPLE RUNS.
65	C
***** THREE INPUT OPTIONS ARE AVAILABLE *****
1.	THE USER NAY ENTER THE TEMPERATURE AND SALINITY OF THE
DISCHARGE AND AMBIENT. DENSITIES ARE CALCULATED INTERNALLY.
2.	OR THE USER MAY ENTER THE DENSITY OF THE
DISCHARGE AND AMBIENT DIRECTLY.
3.	OR THE USER MAY ENTER THE TEMPERATURE AND SALINITY
OF EITHER ONE AND THE DENSITY OF THE OTHER.
39
-------
66
67
63
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
1C9
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
PROGRAM UOKHDEN
***** INPUT VARIABLES
*** CARD NO. 1 *** FORMAT 20*4
1- THIS CARD CONTAINS AMY INFORMATION THE USER WISHES TO HAVE
PRINTED OUT AT THE TOP OF EACH PAGE. VARIABLE Nil.'
THE DATA ENTERED ON CARDS 2 THROUGH 7 HAY BE EITHER IN THE
FORMAT REQUIRED BY EACH CARD OR EACH VALUE ON THE CARD MAY ^
BE SEPARATED BY A COMMA (SHORT FIELD TERMINATION).
*** CARD NO. 2 *** FORMAT 312
1.	INTER. IF INTER-O, ONLY ONE RUN OF THE PRESENT CASE IS
TO BE MADE. IF INTER=1, ONE OR MORE RUNS USING THE INPUT
DATA FOR THIS CASE ARE TO BE MADE WITH ONE OR MORE OF
THE INPUT VARIABLES CHAKSED. THE USER WILL BE PROMPTED AT
THE END OF EACH RUN WHICH VARIABLES HE WISHES TO CHANGE.
2.	IDFP. IF IDFP=1, THE INPUT FILE IS PRINTED AS PART OF
THE OUTPUT. IF IDFP=0, IT IS NOT PRINTED.
3.	ICUTOP. NOT USED IN THIS PROGRAM. HOWEVER,
AS THIS IS A CKIVERSAL DATA FILE AND IF ICUT0P=1, THE
PROGRAM EXPECTS AN EXTRA CARD, I.E. CARD NO. 5.
*** CARD NO. 3 *** FORMAT F10.0,I10,3F10.0
1.	QT^TOTAL DISCHARGE FLOW RATE CCUBIC METERS PER SEC)
2.	NP=NUMBER OF DISCHARGE PORTS
3.	PDIA=DISCHARGE PORT DIAMETER CM)
4.	VANG=VERTICAL ANGLE (DEG) OF PORTS RELATIVE TO HORIZONTAL
<90 DEGREES IS VERTICAL, RANGE 0-130 DEG>.
5.	PDEP=PORT DEPTH CM) AND *JST BE GREATER THAN 0.0
*** CARD NO. 4 *** FORMAT 3F10.0
1.	UW NOT USED IN THIS PROGRAM.
2.	HANG=ANGLE CDEG) OF CURRENT DIRECTION WITH RESPECT TO DIFFUSER
AXIS (90 DEGREES CORRESPONDS TO A CURRENT HAVING A DIRECTION
PERPENDICULAR TO THE DIFFUSER AXIS, RANGE 45 - 135 DEG).
3.	SPACE=DISTANCE BETWEEN ADJACENT PORTS 
-------
PROGRAM UDKHDEN
131	C
132	C	THERE KJST BE NPTS (CARD NO. 6) IMAGES OF CARD NO. 7.
133	C	ONE CARD FOR EACH ELEVATION WHERE AMBIENT CONDITIONS
134	C	ARE GIVEN. AT LEAST 2 CARDS BUT NOT MORE THAN 30.
135	C 1. DPC )*DEPTH TO DATA POINT CM) STARTING AT THE SURFACE
136	C	AND WORKING DOWN TO OR BELOW THE DISCHARGE DEPTH.
137	C	THE LAST ENTRY PtJST BE FOR A DEPTH EQUAL TO OR GREATER THAN
138	C	THE DISCHARGE DEPTH. MUST HAVE DATA FOR DPC1)*0.0 OR
139	C	COMPUTATIONAL ERRORS MAY OCCUR.
140	C 2. SAC )-AMBIENT SALINITY CPPT5 AT THIS DEPTH IF THE
141	C	TEMPERATURE/SALINITY OPTION USED OR
142	C	AMBIENT DENSITY C6/CK3) IF DENSITY OPTION USED.
143	C 3. TA( )"AMBIENT TEMPERATURE CDE6 C) AT THIS DEPTH IF TEMPERATURE/
144	C	SALINITY OPTION USED OR ZERO CO.O) IF DENSITY OPTION USED.
145	C 4. UA< )=AMBIENT VELOCITY AT THIS DEPTH CM/S)
146	C
147	C	REGARDING CARD NO 6 AND 7, WHEN USING THE TEMPERATURE/SALINITY
148	C	OPTION, IF FOR AN SAC ) OR S, THE TAC ) OR T IS REALLY ZERO,
149	C	6IVE TAC ) OR T A SMALL VALUE LIKE 0.000001.
150	C
151	C	THE ABOVE VARIABLE NAMES HATCH THE DESCRIPTION OF THE UNIVERSAL
152	C	DATA FILE. IN THIS PROGRAM SOME OF THEM ARE CHANGED SO BE
153	C	CAREFUL IF YOU MAKE ANY MODIFICATIONS.
154	C
155	C 			
156	C
157	IMPLICIT REAL*8CA-H,0-Z)
158	REAL*8 111 ,112,113,114
159	EXTERNAL DERIV,0UTP
160	LOGICAL IDEN
161	DIMENSION PRMTC5),AUXC16,6),F<6>,FPC6),AAC10)
162	INTEGERS N11C20),N12 C20>
163	COMMON/AP62/XZC30),XTAC30),XCAC30),XUA(30),DO,UO
164	COttMON/INPUT/ZZ<30>,ZTAC30),ZCA(30>,ZUAC30>
165	COMMON/AMB/CIO,TIO,PIO,RHOO,AL,TO,CO,FR,R1,FRL,TIS
166	COMMON/OUT/L,TH1,TH2,H,Z,SNEW,DS,K,N11,J2,J5,JJ,SPACE,SIGMA
167	*,D0,CD,A7,XXX,I0UT,ITERM
168	COMMON/ PLTE/J6,J7,J8,J9 ,J10,X1 M,Y1 M,X2M,Y2M,Y3H
169	C0MM0N/ZF9/SET,XE,YE,ZE,BBE,DCE,DTE,RUE,RTE,RCE,T1E,T2E
170	COMMON/STR95/II,M,R3
171	COMMON/CONS/111,112,113,114,111
172	common/vgm/mergoc,rovo
173	common/opt/iden
174	common/tpdat/ztrap,diltp,pdep,itrap,dilsf,isurf,inter
175	BYTE FNOUT(20),FNAMEC205
176	DATA FNOUTC20)/0/,FNAMEC20)/0/
177	C
178	C ASSIGN VALUES TO LOGICAL UNITS "IN" AND "IOTT
179	C
18C	C	IN THIS PROGRAM (PDP SYSTEM - FORTRAN IV-PLUS),
181	C	LOGICAL UNIT IN IS THE INPUT FILE.
182	C	w	I OUT IS THE OUTPUT FILE.
183	C	"	ITERM IS THE USER TERMINAL.
184	C
185	11^1
186	I0UT*2
187	ITER»*S
188	C
189	C OPEN FILES
190	C
191	WRITE ClTERM,5 54)
192	554 F0RMATC/1X,' •••~•PROGRAM UDKHDEN, AUGUST 1985*****«)
193	WRITECITERM,3)
194	3 F0RMATC/1X,' ENTER UDF NAME: #,S)
195	READCITERM,4> CFNAMECJJ),JJ*1,19)
41
-------
PROGRAM UDICHDEN
196

4
F0RMATC19A1)
197


WRITECITERM,5)
198

5
FORMATdX,' ENTER OUTPUT FILE NAME:
199


READ INTER,IOFP,ICUTOP
218
8100
F0RMAT(3I2)
219


IF(INTER .EQ. 05GO TO 500
220


WRITECITERM,7997)
221
C

N12 IS INTERACTIVE RUN TITLE FOR CASE N1
222


READCITERM,102)N12
223

500
CONTINUE
224
c


225
c

SET INITIAL VALUES
226
c


227


L=0
228


K=0
229


J 7=0
230


J2=0
231


J9=0
232


J10=0
233


CIO=0.
234


TIO=0.
235


PIO=0-
236


AL=0.
237


R1=0.
238


2-0.
239


SNEW-O.
240


R=0.
241


SIGMA=0.
242


X1*=G.
243


YIF^O.
244


X2*=0.
245


Y2*=0.
246


rsmom
247


srr=o.
248


XE=0.
249


YE=0.
250


ZE=0.
251


BBE=0.
252


DCE=0.
253


OTE=0.
254


RUE=0.
255


RTE=0.
256


RCE=0.
257


T1E=0.
258


T2E=0.
259


R3=0.
260


ROVO=0.
42
-------
PROGRAH UDKHDEN
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
J 5*0
CD*2.
DS«4.
JJ*1
J6*0
IX*1
SF*1000.
IF(LOOP* EG.0)TIS=0-
111*1
ITRAP*0
ISURF=0
RERGCK*0
IF(LOOP.6T.0)60 TO 37
IDENE*0
IDENA=0
IDE**.FALSE.
278	C
279	READ( IN,8101 ,ERR=999) QT,NP,PDIA,VANG,PDEP
280	8101 FORMATC F10 .0 ,110 ,3 F10 .0)
281	READ(IN ,8102,ERR»999)UW,HANG,HSPACE
282	8102 F0RRAT(3F10.0>
283	IFUCUT0P.GT.0)READ(IN,8104,ERR3999>IDU«4
284	8104 FORMATCII)
285	READ C IN,8103,ERR=999) NPTS,CO,TO
286	8103 FORBATC110,2 F10.05
£87	T0E=70
268	COE=CO
289	ZFCTO.EQ.O.)IDENE=1
290	C
291	C	READ IN ANBIENT PROFILE TABLE
292	C	DEPTH BELOW SURFACE, DENSITY, AND VELOCITY
293	C
294	READCIN,8105,ERR«999>CZZCII>,ZCACII>,ZTACII),ZUACII),II=1,NPTS)
295	8105 F0RHATC4 F10.0)
296	CALL USORT(ZZ,ZCA,ZTA,ZUA,NPTS)
297	NW»NPTS+5+ICUT0P
298	IFCIDFP.EQ.05GO TO 42
299	WRITECI0UT,15KFHANECJJ),JJ=1,195
300	15 F0RHATC1H1/1X," UNIVERSAL DATA FILE: *,19a1/>
301	IFCINTER .EQ. 1>WRITECI0UT,26)
302	26 FORMATC
304	•ix'^ * NOTE, THIS IS THE ORIGINAL FILE.	*'/
305	*1X,* * IT DOES NOT REFLECT CHANGES WADE INTERACTIVELY. *¦/
306	*1X," * THOSE CHANGES ARE SHOWN IN THE OUTPUT HEADING*	•'/
307	*1X,f						
308	REWIND IN
309	IFCNWO.EQ.05GO TO 16
310	DO 17 JK=1 ,NWO
311	READCIN,19>CAACUC),LK*1,10>
312	19 F0RMATC10A8)
313	17 CONTINUE
314	16 DO 18 JK=1,NW
315	READ CIN,195 CAA CLK),LK=1,10)
316	WRITE(IOUT,22>CAA(LK) ,LK«1,10)
317	22 FORMATC1X,10A8>
318	18 CONTINUE
319	42 CALL LINITSC1,PDEP,VANG,HANG,T0E,C0E,NPTS,INTER,N11 ,N12,
320	*IEXIT,IOUT,ITERW,TO,CO,LOOP,NP}
321	IFClEXIT	15G0 TO 1
322	IFCZTAC1) .EQ. 0.)IDENA=1
323	IFCIOENE .EQ. 1 .AND. IDENA .EQ. 05G0 TO 11
324	IF(IDENE .EQ. 0 .AND. IDENA .EQ. DGO TO 12
325	1FCIDENE .EQ. 0 .AND. IDENA .EQ. 0)60 TO 13
43
-------
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
343
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
PROGRAM UDfCHDEN
IDEN=#TRUE.
60 TO 13
11	00 14 Js1,NPTS
CALL SIGMAT(PI,ZTACJ>,ZCA(J>)
zcacj:=pi
zta=o.
14 CONTINUE
IDE^.TRUE.
60 TO 13
12	CALL SIGMAT(PI,TO,CO)
CO*PI
TO=Q.
IDE** .TRUE.
13	IF(IDEN)TO«CO
37 IF(IDEN)CO».001
IF (CO .LT • *001) C>= .001
XO=0.
Y0=0.
ZO=0.
TH1=HANG
TH2=VANG
TH1G=TW1
TH2(^TH2
C IF ONLY ONE DISCHARGE PORT, PORT SPACING IS SET
C TO 1000- TO PREVENT PLUME MERGING CALCULATIONS.
IFCNP.EQ.13 HSPACE=1000.0
SPACE=HSPACE
DUC^I.
DRG=1.
DC0=1.
DT*=0.
WRIfE(IOUT^200)
200 F0RMATC1Hi,/42X,*PROGRAM UDICHDEN'/
*25X/SOLUTION TO WLTIPlE BUOYANT DISCHARGE PROBLEM WITH1/ '
*25X,"AMBIENT CURRENTS AND VERTICAL GRADIENTS. AUG 19851/)
WRITECI0UT,23> (FNAMECJJ5 ,J J=1 ,19)
23	F0RMATC4X,"UNIVERSAL DATA FILE: *,19M)
WRITECI0UT,24>N11
24	F09MATC4X,1CASE I.D. 1,20A4>
m7
IFCINTER.EQ.1)WRITECI0UT^5)N12
25	F0RMATC4X," RUN TITLE: ",20A4>
IFCINTER«EQ .1)M=FH1
IFCNP.GT.DGO TO 2003
WRITE(IOUT^004)
2004 F0RMATC/10X,'SINGLE PORT DISCHARGE CASE*)
2003 IF(IDEN)WRITECI0UT,2000)QT,T0,PDIA,NP„HSPACE,PDEP
2000	F0RMATC1H	DISCHARGE^',F7.4," CU-M/S DENSITY*1
*,P7.5,# G/CM3 ** DIAMETER='#F7.4,'-M#,/1X,
*• ~* NUMBER OF P0RTS=,,I4,t ** SPACINe=",F7.2,f-H ** DEPTH
*=*,F7.2,#-M')
IFC.NOT.IDEN) WRITE(IOUT,2001>QT,TO,COE,PDIA,NP,HSPACE,PDEP
2001	FORMATC1H ,* DISCHARGE=',F7.4," CLHM/S •* TEWERATURE='
*,F6.2,,-C',' ** SALINITY=',F6^,'-PPT ** DIAMETER=",F7.4,
•/IX," ** NUMBER OF PORTSs',14," »• SPACING=,,F7^,,-M
* ** DEPTK=,,F7.2,,-M1)
W«M*2
DIL»1.
D^PDIA
^PDEP
ENN»NP
UO=0T/CENN*3.1415926*&O*D0/4.)
IFCLOOP.GT.O)WRITECIOUT^200)
3200 FGRMATC/3X,' STRATICICATION TABLE FROM PREVIOUS RUN USED*/)
44
-------
PROGRAM UDKHDEN
391

IFCLOOP.GT.03mM
392

IFCL00P.ST.03SO TO 3001
393

2FCIDEN3URITEC20UT,30063
394

IFC.NOT.IDEN3WRITECIOUT,30093
395
3006
FORMATCIHQ,1QX,'AMBIENT STRATIFICATION PROFILE* /
396
*,5X,fDEPTH CM3 DENSITY CG/CW33 VELOCITY <«/$>')
39?
3009
F0RMATC1HO ,1OX,1AMBIENT STRATIFICATION PROFILE',/
398
4
>,7X,#DEPTH CM) TEMP CO SALINITY *>
400


401

CO 400 11*1 ,NPTS
402

IFCIDEN3ZTACII)*ZCA,2CACII)3
407

IFCIDEN3WRITECIOUT,30073ZZCII3,ZTACII),ZUACII3
408

IFC.NOT.IDEN3WRITECIOUT,30083ZZCII3,ZTAUI3,ZCAUI>,PI,ZUA
409
3008
F0RMATC1X,F13.2,2F15.2,F15.5,F16.33
410
3007
?0RMATCF13.2,F15.5,F16.33
411
400
CONTINUE
412

M*M*NPT$
413
3001
CONTINUE
414

DO 4000 1*1 ,NPTS
415

J»NPTS-*»1
416

XZ<1>~N-ZZCJ)
41?

XTACI)=ZTA FR
43$
8200
F0RMAT/C~PIZ3
449
92
WRITE CIOU'^06) FR,SPACE
450
206
FORMATC1HO,# FROUDE NC*', F6 .2,1 .1,2X,
451
~•PORT SPACING/PORT DIA=',F10*2,1,,*,$3
452

M*M*2
453

FR=2»*FR*FR
454

SPACE=2.~SPACE
455

DS11=DS
45
-------
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
S17
518
519
520
PROGRAM UDKHDEN
TTTIsTHl
TTT2*TH2
R3=R*SIN(0.01745329*TH1)*COS(0.01745329*TH2)
IFCR3-1.0)60,61,60
61 R3=0.0
60 CALL ZFECIHLF)
C ZFE TAKES CARE OF COMPUTING IC AT END OF ZFE.
IFCIHLF .GE. 11)60 TO 9
DS=DS11
TH1=TTT1*0.01745329
TH2=TTT2*0.01745329
T1 E=T1 E*0.01745329
T2 E= T2 E*0.01745329
C CONVERT TH FROM DEGREES TO RADIANS
C TH ANGLE AT S=0, TE=ANGLE AT SE
S1=SINCT1E)
C2»C0SCT2E)
CALL AMBIENCZ,CI,TI,PI,TIZ,CIZ,PIZ,VTI,VCI,VUI,VVI,R)
RS12=R*S1*C2
IFCRE-1.0E*4)20,21,21
20	WRITE(I0UT,214)RE
214 F0RMATC1H ,* FLOW HAY NOT BE FULLY TURBULENT, RE=',F8.0,/)
21	PRHTC1)=SET
PRMTC2)=SF
PRMTC3)=DS
PRMTC4)=0.1
L3-1
Hr.fi
C L=-1 USED TO INITIALIZE OUTP. *=NUMBER OF DFFERENTIAL EQNS.
K=0
C K COUNTS NO OF INTEGRATIONS,
DO 2 1=1,6
2 FP(I)=C.1666667
SIGMA=BBE
BBE2=BBE*BBE
F(1)=BBE2*CII1+(.5—II1)*RS12)
FC2)=DTE*BBE2*(II2+(II1—II2)*RS125
F(3)=DCE*BBE2*(II2+(II1—II2)*RS12>
F(4)=BBE2*II2* CI .—RS12)**2*2.*(1 .—RSI 2)*RS12*BBE2*II1
~~RSI 2*RS12*BBE2*.5
FC5)=T1E
FC6)=T2E
WRITECI0UT,210)
210 FORMAT(/4X,'ALL LENGTHS ARE IN METERS-TIME IN SEC.
*	FIRST LINE ARE INITIAL CONDITIONS.')
IF(IDEN)WRITECI0UT,208)
IF(.N0T.IDEN>WRITECI0UT,2C9)
208	FORMATOH ,5X, "X* ,7X,*Y* ,7X,' Z' ,6X,"TH1' ,5X,,TH2I ,5X,
WIDTH*,5X,,DUCL,,5X,,DRHO,,5X,,DCCL,^X,1 TIME",3X," DILUTION'/
*)
209	FORMATdH ,5X,*X* ,7X,'Y",7X,* Z* ,6X,'TH1' ,5X,'TH2" ,5X,
••WIDTH*,5X,*DRH0* ,5X,'DTCL* ,5X,* DSCL*,6X,'TIME" ,3X,* DILUTION*/
*)
WRITECI0UT,4001)X0,Y0,Z0,TH10,TH20,D0,DU0,DR0,DC0,DTM,DIL
4001 FORMATS H ,5F8.2,1X,F8.2,3F9.3,1X,2F9.2>
rt=M*5
CALL OUTP(PRMTCI),F,FP,IHLF,N,PRMT)
CALL HPCG(PRMT,F,FP,N,IHLF,DERIV,0UTP,AUX)
IFCIHLF .LT. 1DG0 TO 27
9 WRITE(IOUT,10)IHLF
10 F0RMATC1X,1 ERROR IN HPCG, IHLF= *,12/
*1X,* SEE UNDER IHLF IN COMMENT SECTION OF SUBROUTINE HPCG,
*	GOING TO NEXT DATA SET.')
IF(INTER .EQ. 1)WRITE(ITERM,10)IHLF
46
-------
PROGRAM UDKHDEN
521	LOOP=0
522	60 TO 1
523	27 IFCITRAP .EQ. 1)WRITE(I0UT,6>ZTRAP,DILTP
524	6 FOR«ATClX,t TRAPPING LEVEL®*#F7.2#' METERS BELOW SURFACE,
525	• DILUTION*, F7 .2)
526	IFUSURF .EQ. 1 .AND. ITRAP .EQ. 0)WRITECI0UT,8>DILSF
527	8 F0RMATC1X,1 DILUTION,F7.2)
528	IFCINTER.EQ.O)GO TO 1
529	IFCITRAP .EQ. 1)WRITE(ITERM,6)ZTRAP^DILTP
530	IFCISURF .EQ. 1 .AND. ITRAP .EQ. 0)WRITE N11
532	8006 F0RMATC/lX,f DO YOU WISH TO CHANGE ANY INPUT VARIABLES AND RERUN',
533	CASE I.D. '^ZOAA/IX,1 YES TO RERUN OR NO FOR NEXT CASE ',*)
534	READ CITERM,7,ERR®999)WW
535	7 F0RMATCA1)
536	IFL00P=0
537	IFCMM.EQ.'N#)GO TO 1
538	IF (MM.NE•# Y')WRITE (ITERM,201)
539	IF(MM.NE.'T*>60 TO 8005
540	201 F0RNATC/1X,' *****TOU ROE A MISTAKE, TRY AGAIN*****")
541	WRITE(ITERM,7997)
542	7997 F0RMATC1X,* WHAT IS THE TITLE OF THIS INTERACTIVE RUN?V2X^)
543	READ(ITERM,102) N12
544	7999 IFC.NOT-IDEN)WRITE(ITERM,8000)QT,NP,PDIA,PDEP,VANG,
545	*HANG,COE,TO,HSPACE
546	IFaDEN)WRITEClTERM,80O1)QT,NP,PDIA,PDEP,VANG,HANG,T0,HSPACE
547	8001 F0RMATC1X,' YOUR PRESENT INPUT VARIABLES ARE:'//
548	*1X," 1. EFFLUENT FLOW (CMS)	=',F15.4/
549	*1X," 2. NUMBER OF DISCHARGE PORTS =*,110/
550	*1X,f 3. PORT DIAMETER (M)	«,/F15.4/
551	*1X,B 4. DISCHARGE DEPTH CM)	=*,"3.2/
532	*1X,J 5. VERTICAL DISCHARGE ANGLE «',F12.1/
553	*1X,# 6. ANGLE OF CURRENT RELATIVE TO DIFFUSER «',F6.1/
554	*1X,» 7. EFFLUENT DENSITY (6/CM3) »',F16.5/
555	*1X,' 8. PORT SPACING 	= #,F13.2//)
556	8000 F0RMATC1X,* YOUR PRESENT INPUT VARIABLES ARE:"//
557	*1X,' 1. EFFLUENT FLOW CCMS)	*',F15.4/
558	*1X,' 2. NUMBER OF DISCHARGE PORTS =",110/
559	*1X,* 3. PORT DIA.1ETER CM)	*',F15.4/
560	*1X,# 4. DISCHARGE DEPTH CM)	= ',F13.2/
561	«1X,' 5. VERTICAL DISCHARGE ANGLE = ',F12-1/
562	*1X,# 6. ANGLE OF CURRENT RELATIVE TO DIFFUSER = ',F6.1/
563	*1X," 7. EFFLUENT SALINITY CPPT) *',F14.3/
564	*1X,' 8. EFFLUENT TEMPERATURE 
566	WRITE(ITERM,7998)
567	7998 F0RMATC1X,' ENTER THE NUMBER OF THE
568	• VARIABLE YOU WISH TO CHANGE: ',$)
569	READ(ITERM,8106)INUM
570	8106 FORMATCII)
571	WRITE(ITERM,7996)
572	7996 F0RMATC1X' WHAT IS THE NEW VALUE OF THIS VARIABLE? ",S)
573	READ(ITERM,8107,ERR=7999)VALUE
574	8107 F0RMATCF10.0)
575	IFCINUM.EQ.1JQT»VALUE
576	IFCINUM.EQ.2)NP=VALUE
577	IF CINUM.EQ.3)PDIA=VALUE
578	IFCINUM.EQ.4)PDEP=VALUE
579	IFCINUM.EQ.5)VANG=VALUE
580	IF(INUM.EQ.6)HANG=VALUE
581	IFC.NOT.IDEN.AND.INUM.EQ.7)C0=VALUE
582	IF C.NOT.IDEN. AND.INUM.EQ .7) C0c=C0
583	IFC.NOT.IDEN.AND.INUM.EQ.8)T0=VALUE
584	IFC.NOT.IDEN.AND.INUM.EQ.8)T0E=T0
585	IF(IDEN.AND.INUR.EQ.7)G0 TO 501
47
-------
586
587
583
S89
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
6*1
642
643
644
645
646
647
648
649
650
PROGRAM UDKHDEN
502 IF(IDEN.AND.INUK.EQ.8)HSPACE=VALUE
IF(.N0T.IDEN.AND.INUM.EQ.9)HSPACE=VALUE
202 WRITE(ITERM,7995)
7995 FORMATdX,' DO YOU WISH TO CHANGE ANOTHER VARIABLE?
•YES OR NO: ',S)
READ(ITERM,7)MM
IF(MM.EQ."Y*)GO TO 7999
IF(MM.NE."N" )WRITE(ITERM,201)
IF(MM.NE.* N*)GO TO 202
L00P=1
CALL LIMITS(2,PDEP,VANG,HANG,TOE,COE,NPTS,INTER,N11 ,N12,
*IEXIT,IOUT,ITERM,TO,CO,LOOP,NP)
IF(IEXIT .EQ. DLOOP-O
GO TO 1
501 TO=VALUE
TOE=0.
COE=TO
GO TO 502
999 WRITECI0UT,9999)
9999 FORMATdX,' ERROR IN INPUT DATA. PLEASE CHECK FILE*)
221 CALL EXIT
END
C
SUBROUTINE LIMITS(KK,PDEP,VANG,HANG,T0E,C0E,NPTS,INTER,N11,N12,
*IEXIT,IOUT,ITERM /TO,CO,L00P,NP)
C
C THIS SUBROUTINE CHECKS LIMITS OF PORT DEPTH (GREATER THAN 0. AND LESS
C THAN OR EQUAL TO PROFILE DEPTH), DISCHARGE ANGLE (EQUAL TO OR GREATER
C THAN -5 DEG BUT LESS THAN OR EQUAL TO 130 DEG, AND IF NEGATIVE, THAT
C THERE IS AT LEAST ONE PROFILE DATA POINT ONE METER OR MORE BELOW THE
C PORT DEPTH.) (COMPUTATIONAL PROBLEMS MAY OCCUR WITH LARGER DISCHARGE
C A:JGLES, I.E. SQUARE ROOT Oh A NEGATIVE NUMBER, AND PROGRAM WOULD
C EXIT), AND CURRENT ANGLE RELATIVE TO THE DIFFUSER (EQUAL TO OR GREATER
C THAN 45 BUT LESS THAN OR EQUAL TO 135 DEG. 90 DEG IS PERPENDICULAR TO
C THE DIFFUSER). HOWEVER, IF ITS A SINGLE PORT DISCHARGE ANY CURRENT
C ANGLE IN THE RANGE CF 0 TO 180 IS OK, BUT TOR ANGLES GREATER THAN 90
C DEG THE PROGRAM SETS THE CURRENT ANGLE (HANG) EQUAL TO THE
C SUPPLEMENTARY ANGLE. THAT THE EFFLUENT DENSITY IS LESS THAN THE
C AMBIENT DENSITY AND THAT THERE ARE AMBIENT PROFILE VALUES FOR THE
C SURFACE, I.E. DPC1)=0. IF INTER=1, THE PORT DEPTH, ANGLES AND EFFLUENT
C DENSITY CAN BE CORRECTED INTERACTIVELY BUT SURFACE DATA CORRECTION
C MUST BE MADE TO THE DATA SET(S) AND REENTERED. IF INTER=0, ALL
C CORRECTION MUST BE MADE TO THE DATA SET(S) AND REENTERED.
C
IMPLICIT REAL«8(A-H,0-Z)
COMMON/INPUT/ZZ(30>,ZTA(30),ZCA(30),ZUA(30)
INTEGERS N11(20),N12(20)
LIMIT=0
IDEEP=0
IVANG=0
NEGAN6=0
IHANG=0
IHANG1=0
IRHO=0
INO=0
IEXIT=0
100 IF(POEP .EQ. 0. .OR. ZZ(NPTS) .LT. PDEP)GO TO 1
10 IFCVANG .LT. 0. .OR. VANG «GT. 130.)G0 TO 101
110 IF(NP .GT. DGO TO 20
. IF(HANG .GT. 90.)HANG=180.-HANG
IF(HANG .LT. 0. .OR. HANG .GT. 90.)G0 TO 111
GO TO 30
20 CONTINUE
IF(HANG .LT. 45. .OR. HANG .GT. 135.)GO TO 21
30 CONTINUE
48
-------
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
PROGRAM UDKHDEN
1FCT0E .E0. 0.)RH0E=C0E
IFCTOE .NE. 0.)CALL SIGNATCRHOE,TOE,COE)
DO 31 J*2,NPTS
IFCPDEP .LE. ZZ(J))G0 TO 32
31	CONTINUE
GO TO 40
32	JKXJ
PR0=CPDEP-ZZCjK-m/CZZCjlC)-ZZCjlC-1))
TT=ZTACJK-1)+PR0*CZTACJIC)-ZTACJIC-1))
SS=ZCA(JK-1)+PR0«CZCACJIC)-ZCA(JIC-1))
IFtHC .EQ. 2)GO TO 38
IFCZTA(JK) .EQ. 0.)RHOA=SS
lFCZTA(JK) .NE. 0.)CALL SIGHAT(RH0A,TT,SS)
GO TO 39
38	IFCZCACJK) .EQ. 0.)RHOA«TT
IFCZCACJK) .NE. O.KALL SIGHAT(RHOA,TT,SS)
39	IFCRHOA .GT. RHOE)GO TO 40
IRH0=1
LIMIT=1
IFCINTER .EQ. 0)60 TO 40
120	CONTINUE
WRITECITERM,33)RH0E,RH0A
33	F0RHATC/1X,' EFFLUENT DENSITY C9,f7m5^ G/CH3) MUST BE'/
•IX,* LESS THAN THE AMBIENT DENSITY	6/CH3)')
WRITECITER*,4)
READCITERM,5)NANS
IF(NANS .EQ. 'N")G0 TO 40
IFCNANS .NE. ¦YMWRITECITERN^OO)
IFCNANS .NE. #r,)60 TO 120
IRH^2
IFCTOE .EQ. 0.)G0 TO 36
WRITECITERH,34)
34	F0RKATC/1X,' NEW EFFLUENT TE*> VALUE? *,S)
READ CITERH,7)TO
TOE=TO
WRITECITERN,35)
35	F0RNATC1X,' NEW EFFLUENT SAL VALUE? ,^S)
READCITERH,7)CO
C0E3C0
GO TO 30
36	WRITECITERH,37)
37	F0RMATC/1X,* NEW EFFLUENT DENSITY VALUE? *,S)
READCITERN,7)CO
IFOCJC .EQ. 2)T0*C0
C0E=C0
60 TO 30
101 IF (VANG .LT. -5. .OR. VANG .6T. 13C.)G0 TO 11
C
C IF CONTROL IS NOT PASSED TO 11, VANG .GE. -5. BUT .LT. 0.
C BECAUSE IT'S NEGATIVE, PROFILE OEPTH BUST BE AT LEAST ONE
C METER DEEPER THAN THE PORT DEPTH.
C
IFCZZ(NPTS)—PDEP .GE. 1.0)60 TO 110
NE6ANG-1
C
1	IDEEP=1
LIBIT=1
IFCINTER .EQ. 0)GO TO 10
121	CONTINUE
IFCPDEP .EQ. 0.)WRITECITERfl,2)
2	F0RHATC/1X,' ZERO DISCHARGE DEPTH NOT ALLOWED,
• CHANGE PORT DEPTH.1)
IFCPDEP .GT. 0. .AND. ZZCNPTS) .LT. PDEP)
•WRITECITERH,3)PDEP,ZZ CNPTS)
3	F0RMATC/1X," PORT DEPTH C,,F6.2,1 H) IS DEEPER THAN*/
49
-------
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
?65
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
PROGRAM UDKHDEN
*?X,' THE PROPILE DEPTH (i#F6.2#l M>, CHANGE POkT DEPTH.*>
XFCNEGANG .EQ. 1>WRITECITER*,23>PDEP„2ZCNPTS3
23 F0RHAT MUST BE AT'/IX," LEAST ONE METER LESS THAN THE PROFILE
*	DEPTH C%ra.4#" M), CHANGE PORT DEPTH.')
WRITE(ITERM#4?
4	F0RHATC/1X#* WANT TO WAKE CORRECTION? TES/NC
READCIT£RM,53 NANS
5	FORMATCAl)
XFCNANS ,EQ. 'N*)GO TO 10
XFCNANS .NE. • Y* >WRITECITERM,20Q3
IF(NANS .NE. ,Y*3GO TO 121
XDEEP=2
WRITE(ITERM*,6>
6	F0RMATC1X,* NEW VALUE?
READ C ITERM#7> PD EP
7	FORMATCF7.05
GO TO 100
11	IVANG=1
LI HI 1=1
IFCINTER .EQ. 0)G0 TO 110
122	CONTINUE
WRITECITERM/I2)
12	F0RMATC/1X#' DISCHARGE ANGLE IS NOT IN THE
*	RANGE OF -5 TO 130 BEG*)
URITECITERN^)
READ CITERM#5J NANS
XFCNANS -EQ- »N'3G0 TO 110
XFCNANS .NE. •T*3MRITEClTERn(200>
XFCNANS .NE. 'Y'JGO TO 122
IVANG=2
ifRITEC ITERW,6)
READCITERW^VANG
GO TO 10
111	IHANG1=1
LIMIT=1
IFCINTER .EQ. 0)GO TO 20
123	CONTINUE
1IRIT£CXT£RM,1125
112	FORMATC/
#1X#* CURRENT ANGLE RELATIVE TO THE DIFFUSER IS NOT IN THE*/
*1X#» RANGE OF 0 TO 180 DEG FOR A SINGLE PORT DISCHARGE. If*/
•IX,' INPUT ANGLE .ST. 90. PROGRAM SETS HANG=SUPPLEMENTARY ANGLE.#>
WRITEUTER*,4>
READNANS
XFCNANS .EQ. *N#)GO TO 20
XFCNANS .NE. *Y*)tfRITECIT£RM,200>
XFCNANS .NE. #Y")GO TO 123
IHANG1=2
WRITECITERM^)
READCITER*,7)HANG
GO TO 110
21	IHANG=1
LIHIT=1
"r(INTER .EG). 0>SQ TO 30
124	CONTINUE
VRITEClTERNr22)
22	F0RMATC/1 X#* CURRENT ANGLE RELATIVE TO THE DIFFUSER
*	IS NOT IN THE RANGE OF 45 TO 135 DEG')
WRITE CITERM,4)
READ(ITERM,5)NANS
XFCNANS .EQ. #M*)GO TO 30
XFCNANS .NE. ' Y') WRITECITERM^OO)
XFCNANS .NE. *Yf5G0 TO 124
XHANG-2
50
-------
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
81C
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
PROGRAM UDKHDEN
WRITECITERH,6)
READCITERM,7)KANG
GO TO 20
40 1FC2ZC1) .EQ. 0.56O TO 50
INO=1
LINIT=1
IFCINTER .EQ. 0)60 TO 50
VRITEClTcRH^DNT
4* FGRftATC/lX,' COMPUTATIONS CEASE F0RV1X,* CASE I.D. ',20*0
WRITEC ITERM,44) N12
44 F0RMATC1X/ RUN TITLE: f^20A4)
WRITECITERM,42)
42	F0RHATC/1X,' NO SURFACE DATA FOR THE AMBIENT DENSITY/CURRENT
*	PR0FILE.V1X,' WITHOUT THESE DATA, COMPUTATIONAL ERRORS
*	HAY OCCUR.'/1X,# MAKE CORRECTIONS TO DATA SET(S) AND REENTER.*)
WRIT£CITERM,43)
43	F0RMATC/1X,' GOING TO NEXT DATA SET IF THERE IS ONE.'")
50	IFCLIWIT .EG. 0)60 TO 7C
IFCINTER .EQ. 1)60 TO 69
51	IFCLOOP .EQ. 1)WRITECIOUT,72)
72	F0RMATC1H1)
WRITECI0UT,41)N11
IFCINTER .EQ. 0)G0 TO 73
WRITECI0UT,44)N12
VRITECITERM,41)N11
WRITECITERM,44)N12
k'RITEC ITERM,74)
74 FORMAT'SIX,* NECESSARY CORRECTIONS NOT HADE!'2
WRITECITERN,43>
73	WRITECI0UT,67>
67	F0RMATC/1X,' CORRECT THE FOLLCVING AND REENTER »ATA.'>
IEXaT*1
68	IFCIDEEP .EQ. 0)60 TO 52
IFCIDEEP .EQ. 1)WRITECI0UT,56>PDEP
IFCIDEEP .EQ. 2)WRITECI0UT,57)PDEP
52	IFCIVANG .EQ. 0)GO TO 520
IFCIVANG .EQ. 1)WRITECI0UT,58>
IFCIVANG .EQ. 23WRITECI0UT,59)VANG
520 IFCIHANG1 .EQ. 0)G0 TO 53
IFCIHANG1 .EQ. 1)WRITECI0UT,521>
IFCHANG1 .EQ. 2)WRITECI0UT,63) HAN6
53	IFCIHANG .EQ. 0)60 TO 54
IFCIHANG .EQ. 1)WR:TECl0lrT,62)
IFCIHANG .EQ. 2)WRITECI0UT,63>HANG
54	IFCIRHO .EQ. 0)G0 TO 55
IFCIRHO .EQ. 1)WRITECIOUT,64)
IFCIRHO .EQ. 2)WRITECIOUT,65)RHOE
55	IFCINO .EQ. 0)GO TO 75
WRITEC I0UT,42)
WRITECI0UT,43)
GO TO 70
69	IFCIDEEP .EQ. 1 .OR. IVAN6 .EQ. 1 .OR. IHANG1 .EQ. 1
*.0R. IHANG .EQ. 1 .OR. IRHO .EQ. 1 .OR. INO .EQ. 1)60 TO 51
IFCLOOP .EQ. 1)WRITECI0UT,72)
WRITECI0UT,66)N11
IFCINTER .EQ. 1)WRITECI0UT,44)N12
WRITECI0UT,71)
GO TO 68
56	FORMATC
•1X,* PORT DEPTH WAS ENTERED AS -,F6.2,' METERS:1/
*1X," IF THE DISCHARGE ANGLE IS POSITIVE, THE PORT DEPTH HJSTV
•1X,* BE GREATER THAN ZERO BUT LESS THAN OR EQUAL TO THE PROFILE
*	DEPTH.*/
•IX,* IF THE DISCHARGE ANGLE IS NEGATIVE, THE PORT DEPTH MUST'/
•1X,' BE AT LEAST ONE METER LESS THAN THE PROFILE DEPTH.')
51
-------
PROGRAM UDKHDEN
846	57 F0RMATC1X,' PORT DEPTH CHANGED TO: ',F6.2,* M')
847	58 FORMATCIX,* DISCHARGE ANGLE W$T 0E .GE. -5 BUT .IE. 130 DEG')
848	59 F0RMATC1X,' DISCHARGE ANGLE CHANGED TO:	DEG')
849	521 F0RMATC1X,' CURRENT ANGLE RELATIVE TO THE DIFFUSER
850	* MUST BE .GE. 0 BUT .LE. 180 DEG'/IX,
851	*' FOR A SINGLE PORT DISCHARGE*)
852	62 FORMATC1X," CURRENT ANGLE RELATIVE TO THE DIFFUSER
853	* MUST BE .GE. 45 BUT .LE. 135 DEG')
854	63 F0SMATC1X,' CURRENT ANGLE RELATIVE TO THE DIFFUSER
855	* CHANGED TO: ,,F6.2,' DEG')
856	64 FORMATCIX,' EFFLUENT DENSITY MUST BE .LE. AMBIENT
857	* DENSITY AT THE DISCHARGE DEPTH'5
858	65 F0RMAU1X,' EFFLUENT DENSITY CHANGED TO: ',F7.5,B 6/CO
859	66 FORMATC/1X,' COMPUTATIONS CONTINUE FOR'/1X,' CASE I.D. *,20A4)
860	71 FORMATdX,' CORRECTIONS WERE INTERACTIVELY HADE TO
861	* THE FOLLOWING:'/)
862	200 F0RMATC/1X,' ***** YOU MADE A MI STAKE, TRY AGAIN*****')
863	75 IFCIEXIT .EQ. 1)WRITECI0UT,43)
864	70 RETURN
865	END
866	C
867	SUBROUTINE SIGMATCRHO,T,S)
868	IMPLICIT REAL*8CA-H„0-Z)
869	SIGC^CCC6.8E-6*S)-4.82E-4)*S+.8149)*S-.093
870	C=1.E-6*T*(C.01667*T-.8164)*T+18.03)
871	D=.001 *T« C <.D010843* T-.09818)* T+4.7867)
872	SUMT=(T—3.98)*(T-3.98)* CT+283.)/(503.57*(T+67.26))
873	RHC^(SIG0+.1324)*<1.-D*C*(SIG0-.1324))-SUMT
874	RHO=RH0/1000.+1.
875	RETURN
876	END
877	C
878	SUBROUTINE DERIVCS„F,FP>
879	IMPLICIT REAL*8 CA-*,0-Z)
880	DIMENSION FC6),FP(6)
881	INTEGER*4 N1K20)
882	COMMON/0UT/L,TH1 ,Th2,H,Z,SOLD,DS,JC,N11 ,J2,J5,JJ ,SPACE,SIGMA
883	*,D0,CD,A7,XXX,I0UT,ITERM
884	S1 = SIN(FC5))
885	S2=SINCFC6))
886	C1=C0SCFC5))
887	C2=C0SCFC6))
888	21=2*S2* CS-SOLD)
889	CALL AMBIEN(Z1,CI,TI,PI,TIZ,CIZ,PIZ,VTI,VCI,VUI,WI,R)
890	C AMBIENT COMPUTES GRADIENTS OF T,C 8 TURBULENCE QUANTITIES IN FR STREAM.
891	CALL PRFLE(F,F8,E,B>
892	C PRFLE COMPUTES INTEGRAL QUANTITIES WITHIN THE JET
893	C F8 IS THE INTEGRAL OF DENSITY DIFFERENCE, AND B THE WIDTH OF TE JET
894	FPC1)=E
895	FPC2:=-FC1)*TIZ*S2+VT1
896	FPC3)»-F<1)*CIZ*S2+VCI
897	FPC4)»E*R*S1*C2+F8*S2+YUI
898	F9»FC4)-0.25*E*E+WI
899	IF(ABSCC2)-0.01>1,1,2
900	1 FC5)=FC6)
901	FP(5)=0.0
902	GO TO 3
903	2 FDY=0.
904	UNX=-C C2**2* C1* S1)
905	UNY= S2**2* C2** 2 * C1**2
906	UNZ=-(S2*C2*S1)
907	UN=SQ RT(UNX**2*UNY**2+UNZ ** 2)
908	CDP=CD*SPACE/B
909	IFCSPACE/B.GE.2.)CDP=CD*B/SPACE
910	FD= CDP*B*R* R*UN/6.2832
52
-------
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
9JO
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
PROGRAM UDKHDEN
YY«ABS(C1*C2>
IFCYY.GT.O.)FDY"FD* CS2**2*C2**2*C1**2—S1**2*S2**2)/(F9*C1*C2)
FP(5)«CE*R*C1)/
DIMENSION XA<13),XI1C12),XI2C12>
DATA XA/1.0E-10,1 .,1.1,1.2,1.3,1.4,1.5,1 .6,1.7,1.8,1 .9,
•2.0,100./
DATA X11 / .4314, .4314,.4285, .4259, .4238,.4221 ,.4209,
*.4201,.4196,.4194,.4193,.4193/
DATA XI2/.436,.3905„.3576,
••3348^.3201 ,.3114,.3068, .3047,.304, .3038, .3G377,.30377/
1	IFCA—XACI))2,3,4
2	1=1-1
60 TO 1
3	F1 INT*XI1 (I)
F2INT=XI2CI)
GO TO 8
4	IF*CA-XA(I)>
F2IVT*XI2(I)+(XI2(I+1)-XI2(I))/CXACI+1)-XA(I))*CA-XA(I)>
ft F3lNT«A*SQRTC1.-CA/2.>~2>/2.*ASIN,X<30>,Y(30>,ZC30)
NESTED=NPTS
L*NESTED-1
DO 1000 f*1,L
NESTED=NESTED-1
DO 1000 1=1 RESTED
IF(DPCI) .LE. DP(I*1))G0 TO 1000
DUMMY=DPCI>
DP(I5=DPC*1>
DP(I+1)*DUMMY
DUMMY=X(I)
XCI)=X(I+1)
XCI*1)=DUMWY
DUMMY=TCD
Y(I)=YCI+1)
Y(I+1)=DUMMY
DUMMY*Z(I)
ZCI>«ZU*1)
ZCI+1)=DUMHY
1000 CONTINUE
RETURN
END
C
SUBROUTINE AMBIENCZ,CI,TI,PI,TIZ,CIZ,PI2,VTI,VCI,VUI,WI,R)
C AMBIENT COMPUTES THE VALUES OF PARAMETERS IN THE FREE STREAM
C LOCAL DENSITY, VELOCITY AND THEIR GRADIENTS
C
53
-------
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
PROGRAM UDKHDEN
IMPLICIT REAL*8CA-H,0-Z)
COMMON/AMB2/XZ(30),XTAC30>,XCA(3Q),XUA(30>,DO,UO
C0MM0N/AMB/CI0,TI0,PI0,RH00,AL,T0,C0,FR,R1,FRL,TIS
COMMON/TPDAT/ZTRAP,DILTP,PDEP,ITRAP,DILSF,ISURF,INTER
COMMON/OPT/IDEN
LOGICAL IDEN
DO=D0
1=1
Z1=Z*D0/2.
IFCZ1 .GE. PDEP)Z13R0EP
1	IFCZ1.GT.XZCX+1))G0 TO 2
TIZ=/CXZCIV!)-XZ(I>)
CIZ=(XCA(1+1)—XCA(I))/(XZ Cl+1)—XZ(I))
UIZ=/>
CI=XCA(tt+CIZ*CZ1-XZCI>)
TI»XTA(I)+TIZ*CZ1-XZ(I>)
R»(XUA(I)+UIZ*CZ1-XZCI)))/U0
IF(.NOT.10EN) CALL SIGHATCPI,TI,CI>
IF(.NOT.IDEN)CALL SIGMAT(PI1,XTA(I),XCA(I))
IF(.NOT.IDEN)CALL SI6MATCPI2,XTA(I*1) ,XCAQ*1) )
IF<.NOT.IDEN)PIZ=))
TI=TI/T0
IF(.HOT.IDEN)CI=CI/CO
I F(.NOT.IDEN)PI=PI/RH00
TIZ=TIZ*D0/C2.*T0)
IF(.NOT.IDEN)CIZ=CIZ*D0/C2.*C0)
IFCIDEN)PI=TI
IF(IDEN)PIZ=TIZ
C
C VTI, VCI, VUI, AND WI ARE AMBIENT TURBULENCE TERRS, PRESENTLY
C NOT USED AS THEY ARE NOT IMPORTANT IN THE NEAR FIELD. THUS,
C THEY ARE SET EQUAL TO ZERO.
C
VTI=0.
VCI=0.
VUI=0.
WI=Q.
C
RETURN
2	1*1+1
GO TO 1
END
C
SUBROUTINE PRFLECF,F8,E,B)
IMPLICIT REAL*8CA-H,0-Z)
REAL*8 111,112,113,114
DIMENSION FC6)
:mTEGER*4 N11C20)
COMMON/CONS/111,112,113,114,111
COMMON/AMB/CIO,TIO,PIO,RHOO,AL,TO,CO,FR,R1,FRL,TIS
COMMON/0UT/L,TH1 ,TH2,H,Z,SNEW,DS,JC,N11 ,J2,J5,J J ,SPACE,SIGMA
*,D0,CD,A7,XXX,I0UT,ITERM
COMMON/OPT/IDEN
LOGICAL IDEN
1=111
Pt=3.14159
IF
-------
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
PROGRAM UDICHDEN
C2*Ul2/2.
C3-II2
C4»2.*U12*II1
C5»U12*lfl2/2.
C6»II2
C7*U12*II1
60 TO 504
C •*** MERGING PLUME •***
502	CALL XXNT/C1-C3*2.«C2*F(1)/C1/C1-F<4>
CC»C3*F(1WC1)/C1/C1
RADCL=88*B&-4.*AA*CC
IF(RADCL.LE.O•)RADCL=0*
BSQR»-BB-SQRT(RADCL>
BSQR«BSQR/ C2.*AA)
12	^sqrtcbsqr;
SIGMA-B
DLU^ F CI) / (8SQR*C15-C2/ CI
UCL*DLimMJl2
DTCL=FC2>/CBSQR*(0LUM«C6*C7))
OCCL*FC3>/vSSQR*CDLJ*«C6+C7) )
TCL*CDTCL+TI)*T0
IFC.M0T.IDElOCCL*C0CCL*CI)*C0
IF (.NOT.IDEM) CALL SI6MATCPICL,TCL„CCL>
IF C.NOT.IDEM)PICL*RHO-PICL/RHOO
IFCIOEIOPICL»-DTCL
IFCFR-0.98E*6*/1,2,2
1	IF(A.6T*2.>F8=PICL*BSQ**II1/>
IFU.LE..95)F8*F8*AI3/All/2-14068
c comrrE fs-integral of density difference-
FRLI«PICL*B/CFR* CPI0-1 JJ)*UCL*UCL)
60 TO 3
2	FSxO.0
FRLI«0.0
3	IF(ABS(FRLI)-10.0*AB$C1.0/FRL) 510,13,13
13	FRLI»1.0/FRL
10 CONTINUE
A1-.05
A22*0.0
AA*A1*A22*FRLI*SIN(F<6))
CC*A7*R*SQRT(1,0-S12*S12)
B8=B*ABSCUCL-R*S12)
XFCA.6E,2.>E*AA*(BB*(1.*XXX/A)+CC*B)
55
-------
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
113?
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
11T6
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
PROGRAM UDKHDEN
IFU.LT.2.)E=AA«ute e-entrainment function
RETURN
END
C
SUBROUTINE OUTPCS,F,FP,IH,N,PRMT)
IMPLICIT REAL*8
REAL*8 III,1X2,113,114
DIMENSION FC6),FPC6),PRMT<5),S0C4),SN<4)
INTEGERS Nil <20)
COMMON/OUT/L,TH1,TH2,W,Z,S1,DS,K,N11,J2,J5,JJ,SPACE,SIGMA
•,D0,CD,A7,XXX,10UT,ITERM
COMMON/AMB/CIO,TIO,PIO,RHOO,AL,TO,CO,FR,R1,FRL,TIS
COMMON/PLTE/J6,J7,J8,J9,J10,X1M,Y1*,X2M,Y2M,Y3M
COMMON/ZF9/SET,XE,YE,ZE,BBE,DCE,DTE,RUE,RTE,RCE, HE,T2E
COMMON/STR95/II,M,R3
COMMON/CONS/111 ,II2,II3,II4,UI
COMMON/WGM/MERGCK,ROVO
COMMON/OPT/IDEN
COMMON/TPDAT/ZTRAP,DlLTP,PDEP,ITRAP,DILSF,ISURF,INTER
LOGICAL IDEN
I=III
PII=3.14159
IFCL)64F8,7
6	L=0
L19*3
Ml a-1
M2=0
Z1»-DS
SNE^PRMTCD
SNC1)*SIN(T1 E)
SNC2)=SINCT2E>
SN<3)=C0SCT1E)
SN(43 = C0SCT2E)
TIME=SET
X=XE
Y=TE
Z=ZE
UCC=1.0
S1=PRMT(1)
T3I=TI0
C3I=0.
IFC.N0T.IDEN)C3I=CI0
IFCCIO-1-O.LT..0000015C3I-0.
IFCTI0-1.0)63,64,63
64 T31=0-0
63 GO TO 10
8 L=1
SNEW=DS«-S1
SO(1)-SN(1)
SOC2)-SN<2)
SOC3)=SN(3)
S0(4)«SN<4)
7	IF>
SN(2)=SIN(F(6))
SN(3)=C0SSNC4>«-SO<3)«$0(4))*
-------
PROGRAM UDKHDEN
1171


Y"Y*0,5*(SNC1)*$N(4)+SO<1)*SOC4))»(S—S1)
1172


Z1»Z
1173


Z*Z*0.5*(SN(2)+S0(2))*(S-S1)
1174


DO 9 1*1 ,4
1175

9
SO(I)-SNCI)
1176

10
CALL AMBIEN(Z,CI,TI,PI,TIZ,CIZ,PIZ,VTI,VCI,VUI,WI,R)
1177


IF(F(4))21,21,55
1178

55
R14»R*SN(1)*SN(4)
1-79


A»SPACE/SIGMA
1'j 80


IFCA-2.3501,500,500
1181

501
IF(A-.95)503,503,502
ns2
C

~ SINGLE PUJME •***
.1183

500
C1*II1
1184


C2*Rl4/2»
1185


C3*II2
1186


C4=2.*R14*111
1187


C5=Rl4*R14/2.
1188


C6=II2
1189


C7*II1*R14
1190


GO TO 504
1191
C

» MERGING PLUMES ~***
1192

502
CALL XINT(I,A,AI1,AI2,AI3>
1193


IF MERGED PLUMES
1206

503
CALL XINT(I,A,AI1,AI2,AI3)
1207


CT*-45«AX3/PII
1208


C2*R14«AI3/PII
1209


C3*.31558*AI3/PII
1210


C4*2.*R14*C1
1211


C5»R14*C2
1212


C6=C3
1213


C7«0.5»C4
1214

504
IF(ABSCR14)-.001)12,12,99
1215

12
BSQR=FC1)«FC1)*C3/(FC4)*C1*C1)
1216


GO TO 15
1217

99
AA* C3* C2* C2/C1/CI-C4*C2/ CI ~ C5
1218


BB«C4*F<1)/C1-C3*2.*C2*FC1)/C1/C1-FC4)
1219


CC»C3*FC1)*F(1)/C1/C1
1220


BSQR»-B8-SQRTCBB*BB-4.*AA*CC>
1221


BSQR*BSQR/C2.*AA>
1222

15
^SQRT(BSQR)
1223


SIGMAsB
1224


SIGMAO*SIGMA*DO
1225


DLW* F(1)/CBSQR*C1)-C2/C1
1226


UCL*DLUM*-R14
1227


DTCL-F(2)/(BSQR* CDLUM»C6*C7>)
1228


DCCL*F<3)/(BSQR*CDLUN«C6*C7))
1229
c
THE
ABOVE CARDS DEFINE THE COEFFICIENTS OF THE CONTINUITY,MOMENTUM
1230
c
AND
ENERGY EQUATION FOR THE SINGLE PLUME, MERGING PLUME AND
1231
c
MERGED PLUME REGIONS BASED ON PROFILES OF THE FORM (1 .-CX/BW3/2)
1232
c
SQUARED
1233


DELU*CUCL-R14)/<1.0-R3)
1234


DELT*OTCU (1 .0-T3I)
1235


DELC»DCCL/(1.-C3I)
57
-------
PROGRAM UDKHDEN
1236


TCL=CDTCL*TI)*TO
1237


IFC.NOT.IDEN)CCL=(DCCL+CI)*CO
1238


ifc.not.idenkall sigmatcpcl,tcl,ccl)
1239


IFC.NOT.IDEN)PCL=PCL/RHOO
1240


TCL=TCL/T0
1241


IFCIDEN)PCL=TCL
1242


IF(IDEN)CCL=DCCL
1243


IF(,NOT.IDEN)CCL-CCL/CO
1244
C
D£LU*CUCLHJI*S1*C2>//CTlr-TI)
1245


F55*F(5)*57.29578
1246


F66=F(6)*57.29578
1247
c
CONVERT ANGLES BACK TO DEGREES
1248


UMA=0.5*(UCL>UCC)
1249


TIME=TIME* C S-S1)/UKA
1250


FRL=FR
1251


IFCFR-0.98E+6) 110,112,112
1252

110
IFCABSC(PI-PCL)*B)-1.0E-6*ABS(UCl**2*FR*(PIO-1.0>))112,'
1253

113
FRL=FR**UCL*UCL/CCPI-PCL)*B>
1254

112
CONTINUE
1255
c


1256
c

SOO IS THE DISTANCE ALONG THE PLUME CENTER LINE, IT IS 1
1257
c

OUTPUT IN THIS VERSION, IT WAS IN DICHPLM CS).
1258
c

112 SOO=S/2.*DO
1259
c


1260


*0=X/2.*D0
1261


T0=r/2.*D0
1262


20L0=2NEU
1263


Z0*Z/2.*D0
1264


ZNEtf=20
1265


TIMER=TIME*ROVO
1266


RQOLD=RQ
1267


RQ»2.*FC1)
1268


DENOLD»DEN
1269


PICL=PI-PCL
1270


piao=pio-i.o
1271


DEN=PICL/PICLO
1272


xdum=i.
1273


IF40,40,42
1274

40
IF-DSIGNCXDUM,PICL0>>41,42,41
1275

41
DS=0,0
1276


*1=0
1277


*2=1
1278


ITRAP=1
1279


WRITECI0UT,213)
1280

213
FORMAT(/4X,1 PLUMES HAVE REACHED EQUILIBRIUM HEIGHT
1281

* • STRATIFIED ENVIRONMENT'/)
1282



1283


IFCINTER .EQ. 1)HRITECITERH,213)
1284


PRO=DENOLD/(DENOLD-DEN)
1285


DlLTP=RQ0LD-PR0*CR00Lt>-RQ)
1286


ZP=ZOLD-PRO*CZOLD-ZNEU)
1287


ZTRAP=PDEP-ZP
1288

42
IF(L19 .LT. 3)60 TO 71
1289


IF(IDEN)WRITE
-------
PROGRAM UDKHDEN
1301	DS»2.0*DS
1302	36 IFC2>3*3*31
1303	31 IF(N2390*90*91
1304	91 IFC2-215 21,90*90
1305	21 PRWTC5>=1.0
1306	WRITE(I0UT*212)
1307	212 F0RMATC/3X** PLUMES HAVE REACHED MAXIMUM HEIGHT -« ,
1308	* ¦ stratified ENVIRONMENT*,/)
1309	IFCJ6>83,83*81
1310	90 IFa~H>3,3*4
131!	4 PRMTC5>=1-0
1312	WITE(I0UT^14>
1313	214 F0RMAT
1316	ISURF-1
131?	PR01-C20L0-PDEP)/< Z0LD-2NEW)
1318	DXLSF*RQ0LD-PRG1* (RQGL&-RQ3
1319	IFCJ63 83 #23 *81
1320	3 SNE^SNEW*DS
1321	S1®S
1322	UCC=UCL
1323	IF(H2)52*S2*51
1324	51 DS=0.0
1325	M1-0
1326	52 IFCM-S9>2*13*13
1327	13 WRITE C I0tTT*2075 Hi 1
1328	207 FORMATt1 Hi */10X *20 A4)
1329	IF(IDEN)WRITE CI0UT*2Q83
1330	IFC»N0T.IBEN)WRITEU0UT*209>
1331	208 FORMAT (1jCjr5X#,X,,?X**Y,,?X*iZ**6X*#THl ,*SX*,TH2,*6X#*WIDTH*,
1332	^X^DUCL^X^DRHO^SX^DCCL'^X^TIME^X,1DILUTION*/)
1333	209 FORMATClX*5X#,X,*?X#ly<.7X,*2*#6X**THl*,5X**TH2,^X<,'WIDTH**
1334	*4X**DRH0*^X*'DTCL"*5X**DSCL**?X*,TIME,*3X*'DILUTI0N'/>
1335	*4
1336	2 IFCJ6>83*83*34
1337	84 IF (SNEW-PRMT(2) ) 80*81 *81
1338	81 CONTINUE
1339	PRM7(5>=1.0
1340	RETURN
1341	80 IFCM2-D83*85*83
1342	85 IF 81 *83*83
1343	83 RETURN
1344	END
1345	C
1346	SUBROUTINE 2FECIHLF)
1347	C THIS PROGRAM COMPUTES THE SOLUTION TO BUOYANT JET PROBLEMS WITHIN
1348	C THE 20N6 OF FLOW ESTABLISHMENT, I.E. UP TO XE.
1349	C THE SOLUTION CALCULATES RU#RT*RC*B*TH1*TH2 AS FUNCTIONS OF S.
1350	IMPLICIT REAL«8CA-H,0-Z)
1351	DIMENSION PRMT<5)*AUXC16*6)*F(6),FPC6>
1352	INTEGER»4 N11C20)
1353	COMMON/AMB/CIO*TIO*PIO*RHOO,AL*TO*CO,FR,R1*FRL*TIS
1354	COMMON/OUT/L*TH1,TM2*H,2#SNEW,OS*K*N11*J2*J5*4 J *SPACE*SI6MA
1355	#*D0rCD*A7*XXX*I0UT*ITERM
1356	C0MH0N/ZF9/SET *XE#YE*ZE*6BE*DCE*DTE*RUE,RTE*RCE*T1 E*T2E
1357	EXTERNAL DERIV1 *0UTP1
1358	CALL AMBIENC2*CI*TI,PI*TI2,CIZ*PI2,VTI*VCI*VUI#WI*R>
1359	TH1=0.01745329# THl
1360	TH2=0.01745329* TH2
1361	PRMT(1)*OJO
1362	PRMTC2)*100.0
1363	PRMT<3)«0.1
1364	PRMTC4)-0.001
1365	IF
-------
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1330
1381
1382
1383
1384
1385
1386
1387
1388
:389
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413
1414
1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
PROGRAM UDKHDEN
1	TH1=TH2
2	^6
L=0
00 3 1=1,6
3	FPU) =0.16666667
FC1)=1.0
FC2)*1.0
F<3)-1.0
FC4)=Q.0
F(5)=TH1
FC6)=TH2
C FC1)=RU, FC2)=RT, FC3)=RC, FC4)=B, F(5)=TH1, FC6)=TH2
IHLF=0
CALL OUTP1(PRMTC1),F,FP,IHLF^N,PRMT)
CALL HPC6CPRMT,F,FP,N,IHLF,DERIV1,0UTP1,AUX5
IFCIHLF .6E. 11)60 TO 95
F(1)=RUE
IF,AC4,4),a2C3,3),A3C3,3)
INTEGERS Nil (20)
COMMON/AMB/CIO,TIO,PIO,RHOO,AL,TO,CO,FR,R1,FRL,TIS
COMMON/0UT/L,TH1,TH2,H,Z,SNEU,DS,IC,N11 ,J2,J5,JJ,SPACE,SIGMA
*,D0,CD,A7,XXX,I0UT,ITERM
C0MM0N/ZF9/SET,XE,TE,ZE,BBE,DCE,DTE,RUE,RTE,RCE,T1E,T2E
C
El-1.06
E2=34.0
E3-6.0
E4=,4
S1 = SIN)
S12=S1«C2
call AMBIEN(Z,CI,TI,PI,TIZ,CIZ,PIZ,VTE,VCE,VUE,VVE,R)
R12= R* SI *C2
OTO=1 ,-TI
DC0=1 .-CI
E=E1«(0.0204*0.0144*F(4))*C1.0+E2*S2/FR)*
-------
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
'484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
PROGRAH UDKHDEN
02s.31558+.13442*R12
D3=2.*C.06676+.06181*R12>
D4=.31558* *26884*R12*.41558* R12* R12
D5=2.*C.06676+.12362*R12+.30962*R12*R12>
O6=CPI-1.0)*CFC2)*FC2)*0-5*0.12857*FC4)*FC4)4..45*FC2)*FC4)>
®=0.5*F(1)*F(1>*F(1)*F(4)»D4*FC4)*F(4)*0.5*D5—0.25*E*E
AAI=0.5*F(1)*FC1>+D1*F<1)*FC4)*D11*0.5-F<4)*FC4)
A<1,1)*FC1>+D1*F<4)
AC1#2>»0.0
AC1,3>«0.0
AC1,4>=£>1*F(1)+D11*F(4)
C FIRST EQUATION IS CONTINUITY.
AC2,1>*0.D
AC2*2>*DT0*F(2)+D2*DT0*F C4)
AC2^3)X0.0
A(2,4)=DTO*(D2*F(2)*D3*F C4))
C SECOND EQUATION IS ENERGY.
A<3,1>=0.0
AC3,2>=0.0
AC3*3)=DCO*(FC3)*D2*F<4>)
AC3#4)=DCO*(D2*F(3)*03*FC4)5
C THIRD EQUATON IS CONCENTRATION.
AC4/t)=FC1)+D4*FC4)
A<4^2)=0.0
A(4^3)=0.0
AC4,4>=D4*FC1>*D5*F(4>
C FOURTH EQUATION IS NORENTUn
FP(1)=E
TIZZ=TIZ
FPC2>=T1ZZ*S2*<-AAI*0.5*FC2>**2*FC2)*FC4)*D2*0.5*FC4)»*2*D3)
FP(2)=FP'2)+VTE
FP(3)»CIZ*S2wr-AAI+0.5*FC3)**2+FC3)*FC4)*D2*0.5*F(4)**2*D3)
FPC3)*FPC3HVCE
IFCL-2>3,4,3
4 A(2^2>«0.5*D3*FC4)**2
A<2yO=D3*FC2)*FC4)
AC3^3)=A(2^2)
A
GO TO 13
12	F8=0.0
13	FP(4)*F8*S2*E*R12«-VUE
J =4
IF(DCO.EQ.O..AND.DTO.EQ.O.)GO TO 10
IF(DTO.EQ.O.)GO TO 6
IFCDCO.EQ.0.)60 TO 20
CALL SXRQ(A,FP,J,IC)
GO TO 7
10 J»2
A2C1,1>«AC1,1)
A2(1#2)«A(1^4)
A2(2,*)*A(4,1)
A2(2,2)=A<4,4)
FP(2)=FP(4)
CALL SINQ(A2,FP,J,JC>
GO TO 7
20 J*3
A3C1,1)*A<1/I>
A3(1^2)=0.
A3(1,3>=A<1,4>
>CC2,1)=0.
61
-------
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
151V
*.513
1519
152C
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1?43
1544
1545
1546
1547
1548
1549
1550
1551
1552
1553
1554
1555
1556
1557
1558
1559
1560
PROGRAM UDKHOEN
A3(2,2)=AC2,2>
A3(2,3)=A(2,4)
A3C3,1)=AC4,1)
A3C3,2)=0.
A3C3,3)=AC4,0
FPC3) = FPU)
CALL SI*Q(A3,FP,J,lO
60 TO 7
6	J=3
A3C1„1)=A(1,1)
A3(1,2)=0-
A3C1,3)=A(1,4)
A3C2,1)=0.
A3(2,2)=A<3,3)
A3C2,3)=A<3,4)
A3C3,1)=A<4,1)
A3<3,25«0.
A3(3^3)*A(4,4)
FP(2)= FPC3)
FPC3) = FP(4)
CALL SINQCA3,FP,J,K)
7	IF(K) 1 ^2^1
2 IF(J-3)131,132,136
131	FP(4) = FP(2)
FPC3)=0.
FPC2)=0.
GO TO 136
132	IFCDCO.NE.0.5GO TO 134
FPC4)=FPC3)
FPC3)=0.
GO TO 136
134 FPC4) = FPC3>
FP(3)=FPC2)
FP(2)=0.
136 UNX=-(C2**2*C1*S1)
UNY= S2**2*C2**2*C1**2
UNZ=-(S>C2*S1)
UN=SQRTCUNX**2+UNY**2+UNZ**2>
CDP«CD/SPACE
FD»CDP*R*R*UN/6.2832
FDr»0-
YY=ABSCC1*C2)
IFCYY.GT.O.) FDY=FD*(S2**2*C2**2*C1**2—S1**2*S2**2) / (Q*C1*C2)
FPC5)=E*R*C1/(Q*C2) + FDY
FPC6)=CF8*C2-CE*R+FD)*S1*S2)/Q
RETURN
1 WRITECIOUT/100)
100 FORHATCIX,1 SINGULAR MATRIX-EXECUTION TERMINATED AT THIS POINT')
CALL EXIT
END
SUBROUTINE 0UTP1CS,F,FP,IH,N,PRMT)
IMPLICIT REAL*8CA-M,CHZ)
COMMON/ AMe/CIO/nO,PIO,RHOO„AL,TO,CO,FR,R1,FRL,TIS
COMMON/0UT/L,TH1 ,TH2 ,H,Z,SNEW,DS,)C,N11 ,J2,J5 ,J J ,SPACE,SIGMA
*,D0,CD,A7,XXX,I0UT„2TERM
C0MM0N/ZF9/SET,XE,YE,ZE,BBE,DCE,,DTE,RUE,RTE,RCE/nE,T2E
COMMON/STR95/II,M,R3
COMMON/WGM/MERGCK,ROVO
DIMENSION FC6),FP<6),PRMTC5>,S0<4),SN(4)
INTEGERS N1K20)
IF
SN(2)=SIN(TH2)
SN<3)=C0S(TH1>
62
-------
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570
1571
1572
1573
1574
1575
1576
1577
1578
1579
1580
1581
1582
1583
1584
1S85
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
1599
1600
1601
1602
1603
1604
1605
1606
1607
1608
1609
1610
1611
1612
1613
1614
1615
1616
1617
1618
1619
1620
1621
1622
1623
1624
1625
PROGRAM UDKHDEN
SN(4)*C0SCTH2>
TJ=PRHTC1>
DS*PIWTC3>
RUVM).0
RTK=0.0
RCW=0.0
BW=1 .0
SSK=0.0
T1f*TH1 *57.29578
T2**TH2*57 .29578
XN*0.0
YN=0.0
ZN=0.0
X=0.0
r«o.o
z«o.o
C	JP=100
IF(L)30,31,30
31 L*1
60 TO 6
30 L=2
X=XE
t=ye
Z=ZE
60 TO 6
2	IFUBSCS-TJ)-0.01)3,3,4
3	SN<1>*SIN(FC5>>
$NC2)=SIN>
SN(3)=C0S(F(5))
SN(4)=C0S(F(6))
X*X+0.5*(SN(33*$N(4)+S0C3)*S0C4))*DS
Y»Y+0.5*CSNC1)*SNU>«'S0C1>*S0C4))*DS
2=2+0.5*(SN<2)*S0C2))*DS
6 00 5 1=1#4
5 S0(I)~SN(I)
TIHE=S
CALL AnBIEN(Z,CX,TI,PX,TIZ,CIZ,PIZ,VTX,VCX,VUI,Wl,R)
F55sFC5)*57.29578
F66=F(6) *57 .29578
C
C FC2)=RT OR CTW-TD/TO, F<3> SAME FOR C
C
RUO=RUN
RT(^RTN
RCORCN
BO=8N
SS=SSN
TlO=TlN
T20=T2N
XO=XN
YO=YN
ZO^ZN
RIM^FCI)
RTN*FC2>
RCN=F(3)
BW=FC4)
SSN=S
T1^F55
. T2N=F66
Xf^X
YH* t
ZN=Z
IF(L-2>20,21^20
20 IF(FC2))14/l4/!3
14 CONTINUE
63
-------
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570
1571
1572
1573
1574
1575
1576
1577
1578
1579
1580
1581
1582
1583
1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
1599
1600
1601
1602
1603
1604
1605
1606
1607
1608
1609
1610
1611
1612
1613
1614
1615
1616
1617
1618
1619
1620
1621
1622
1623
1624
1625
PROGRAM UDKHDEN
SNC4)»C0S(TH2)
TJ*PRMT<1)
D$*PRMTC3>
RUN*0.0
RTtt=0.0
RC*=0.0
BN=1.0
SS^O.O
T1W=TH1*57.29578
T2N=TH2*57.29578
XWMD.O
YM=0.0
ZM=0.0
*=0.0
Y*0.0
Z-0.0
C	JP-100
IF(L)30,31 ,30
31 L®1
60 TO 6
30 L=2
X-XE
T=YE
Z3ZE
60 TO 6
2	IFCABSCS-TJ)-0.01)3,3,4
3	SNC1)=SINCFC5))
SNC2)=SIN(FC6))
$NC3>=C0SCF<5>)
SN(4)=C0SCF(6))
*=X*0.5*fSNC3^*SHC4)*S0(3>S0(4)5»DS
Y=Y+0.5*tSMC1)*SN(4)+S0(13*S0C4))^DS
2*Z+0.5*D$
6 DO 5 1*1,4
5 SOCI)*SN(I)
TIME-S
CALL AMBXENCZ,C1,TI,PI,TXZ,CXZ,PXZ,VT1,VC1,VUI,WI,R)
F55=F(5)*57.29578
F66=F(6)*57.29578
C
C FC2)=RT OR CTH-TD/TO, FC3) SAME FOR C
C
RUOcRUN
RTO=RTN
RCO=RCN
BO=BN
SS=SSN
ri^riN
T2OT2N
Xfr=XN
YO=YN
ZO=ZN
RUM=F(1)
RTM»F(2)
RCK=F(3)
BJ*F(4>
SSW=S
T1W»F55
. T2N-F66
XH=X
Y#«Y
ZI*=Z
IFCL-2) 20,21,20
20 IF
-------
PROGRAM UDICHDEN
1626	SET=SSN-RTN*(SSN-SS)/(RTN-RTO>
1627	RU£=RU(H(SET-SS)*CRUO-RUN)/CSS-SSN)
1628	RTE=RTO**(RCO-RCN)/(SS-SSN)
1630	BBE=BO*(SET-SS)*(BO-BN>/CSS-SSN)
1631	T1E=T10**(T10-T1N)/CSS-SSN)
1632	T2E=T2CWSET-SS)*CT2&-T2N)/CSS-SSN)
1633	XE=XO+(SET-SS)*(XO-XN)/(SS-SSN)
1634	YE*YO*(SET-SS)*CYO-YN)/(SS-SSN)
1635	2ES20+ ( SET—SS) * (20-2N) t (SS-SSN)
1636	S00*SET/2.*D0
1637	WRITE(IOUT,200)SOO
163S	200 F0RMATC1H+,57X,'STARTING LENGTH=',F9.3)
1639	L=-2
1640	PRMTC5)=1.0
1641	RETURN
1642	13 TJ=TJ«-PRMTC3)
1643	RETURN
1644	4C TJ=TJ*PRMTC3)
1645	RETURN
1646	21 IF
1649	RUE=RUO*CSET-SS)*CRUO-RUN)/CSS-SSN)
1650	BBE=B0*:SET-SSW30-BN)/(SS-SSN)
1651	OTE=RT(HCSET-SS)*CRTO-RTN)/CSS-SSN)
1652	DCE=RC£*-CSET-SS)«,B(6)	SIMQ
1668	C	sim
1669	C	FORWARD SOLUTION SIMQ
1670	C	SIHQ
1671	TOL=0.0	SIMQ
1672	KS=C	SIMQ
1673	JJ=-N	SIWQ
1674	DO 65 J=1,H	SIMQ
1675	JY=J*1	SIMQ
1676	J J=J J+N*1	SIMQ
1677	BIGA=0	SIMQ
1678	IT=J J—J	SIMQ
1679	DO 30 I»J,N	SIMQ
1680	C	SIMQ
1681	C	SEARCH FOR MAXIHUM COEFFICIENT IN COLUMN SIMQ
1682	C	SIMQ
1683	IJ=IT+I	SIMQ
1684	IF 20,30,30	SIMQ
1685	20 BIGA=ACIJ)	SIMQ
1686	IMAX=I	SIMQ
1687	30 CONTINUE	SIMQ
1688	C	SIMQ
1689	C	TEST FOR PIVOT LESS THAN TOLERANCE (SINGULAR MATRIX) SIMQ
1690	C	SIMQ
64
-------
1691
1692
1693
1694
1695
1696
1697
1698
1699
1700
1701
1702
1703
1704
1705
1706
1707
1708
1709
1710
1711
1712
1713
1714
1715
1716
1717
1718
1719
1720
1721
1722
1723
1724
1725
1726
1727
1728
1729
1730
1731
1732
1733
1734
1735
1736
1737
1738
1739
1740
1741
1742
1743
1744
1745
1746
1747
1748
1749
1750
1751
1752
1753
1754
1755
PROGRAM UDKHDEN
IF CASSCBI6A)-TOL)35,35,40	SIM
35 KS=1	SIM
return	sim
c	sim
C INTERCHANGE ROWS IF NECESSARY	SIM
C	SIM
40 I1«J+N*(J-2>	sim
IT* I RAX—J	Sim
DO SO K*J,N	SIM
11*114*	sim
I2*I1*IT	SIM
SAVE*ACI1)	SIM
A(H)«A	SIM
A(I2)*SAVE	SIM
C	SIM
C DIVIDE EQUATION BY LEADING COEFFICIENT	SIM
C	SIM
50 A(I1)zA(I1)/BIGA	SIM
SAVE=BCIMAX)	SIM
B(IMAXJ=B	SIM
B(J>=SAVE/BIGA	SIM
C	SIM
C ELIMINATE NEXT VARIABLE	SIM
C	SIM
IFC J—N) 55,70,55	SIM
55 IQS=N* CJ—1)	SIM
DO 65 IX=JT,N	SIM
IXJ*IQS+IX	SIM
IT=J-IX	SIM
DO 60 JX=JY,N	SIM
IXJ X=N*( JX—D*IX	SIM
JJX=IXJX*IT	SIM
60 A(IXJX)=A(IXJX)-CACIXJ)*ACJJX))	SIPQ
65 B(IX)=B(IX)-CBCJ)*A(IXJ))	SIM
C	SIM
C BACK SOLUTION	SIM
C	SIM
70 NY=N-1	SIM
IT=W*N	SIM
DO 80 J*1,NT	SIM
I A= IT-J	SIM
IB=N-J	SIM
IC*N	SIM
DO 80 IC=1,J	SIM
BCIB)-B-A
-------
PROGRAH UDKHDEN
THE INTERVAL AND OF ACCURACY AND WHICH SERVES FOR	HPCG
COMPLICATION BETUEEN OUTPUT SUBROUTINE CFURNISHED	HPCG
BY THE USER) AND SUBROUTINE HPCG. EXCEPT PRMT(5)	HPCG
THE COMPONENTS ARE NOT DESTROYED BY SUBROUTINE	HPCG
HPCG AND THEY ARE	HPCG
PRTTd)- LOWER BOUND OF THE INTERVAL (INPUT),	HPCG
PRMT(2)— UPPER BOUND OF THE INTERVAL (INPUT),	HPCG
PRWTC3)- INITIAL INCREMENT OF THE INDEPENDENT VARIABLE	HPCG
(INPUT),	HPCG
PRMTU)- UPPER ERROR SOUND (INPUT). IF ABSOLUTE ERROR IS	HPCG
GREATER THAN PRMTU), INCREMENT GETS HALVED.	HPCG
IF INCREMENT IS LESS THAN PRMTC3) AND ABSOLUTE	HPCG
ERROR LESS THAN PRMTU)/50, INCREMENT GETS DOUBLED.HPCG
THE USER MAY CHANGE PRUT(4) BY MEANS OF HIS	HPCG
OUTPUT SUBROUTINE*	HPCG
PRHTC5)- NO INPUT PARAMETER. SUBROUTINE HPCG INITIALIZES	HPCG
PRMT(5)=0. IF THE USER WANTS TO TERMINATE	HPCG
SUBROUTINE HPCG AT ANY OUTPUT POINT, HE HAS TO	HPCG
CHANGE PRHTC5) TO NONZERO BY MEANS OF SUBROUTINE	HPCG
OUTP. FURTHER COMPONENTS OF VECTOR PRMT ARE	HPCG
FEASIBLE IF ITS DIMENSION IS DEFINED GREATER	HPCG
THAN 5. HOWEVER SUBROUTINE HPCG DOES NOT REQUIRE	HPCG
AND CHANGE THEM. NEVERTHELESS THEY MAY BE USEFUL	HPCG
FOR HANDING RESULT VALUES TO THE MAIN PROGRAM	HPCG
(CALLING HPCG) WHICH ARE OBTAINED BY SPECIAL	HPCG
MANIPULATIONS WITH OUTPUT DATA IN SUBROUTINE OUTP.	HPCG
Y - INPUT VECTOR OF INITIAL VALUES. (DESTROYED)	HPCG
LATER ON Y IS THE RESULTING VECTOR OF DEPENDENT	HPCG
VARIABLES COMPUTED AT INTERMEDIATE POINTS X.	HPCG
DERY - INPUT VECTOR OF ERROR WEIGHTS. (DESTROYED)	HPCG
THE SUM OF ITS COMPONENTS MUST BE EQUAL TO 1.	HPCG
LATER ON DERY IS THE VECTOR OF DERIVATIVES, WHICH	HPCG
BELONG TO FUNCTION VALUES Y AT A POINT X.	HPCG
NDIM - AN INPUT VALUE, WHICH SPECIFIES THE NUMBER OF	HPCG
EQUATIONS IN THE SYSTEM.	HPCG
IHLF - AN OUTPUT VALUE, WHICH SPECIFIES THE NUMBER OF	HPCG
BISECTIONS OF THE INITIAL INCREMENT. IF IHLF GETS	HPCG
GREATER THAN 10, SUBROUTINE HPCG RETURNS WITH	HPCG
ERROR MESSAGE IHLF=11 INTO MAIN PROGRAM.	HPCG
ERROR MESSAGE IHLF=.2 OR IHLF=13 APPEARS IN CASE	HPCG
PRMT(3)=0 OR IN CASE SIGN(PRMT(3)).NE.SIGN(PRMT(2)-HPCG
PRMTC1)) RESPECTIVELY.	HPCG
FCT - THE NAME OF AN EXTERNAL SUBROUTINE USED. IT	HPCG
COMPUTES THE RIGHT HAND SIDES DERY OF THE SYSTEM	HPCG
TO GIVEN VALUES OF X AND Y. ITS PARAMETER LIST	HPCG
MUST BE X,Y,DERY. THE SUBROUTINE SHOULD NOT	HPCG
DESTROY X AND Y.	HPCG
OUTP - THE NAME OF AN EXTERNAL OUTPUT SUBROUTINE USED.	HPCG
ITS PARAMETER LIST WST BE X,Y,DERY,IHLF,NDIM,PRMT.HPCG
NONE OF THESE PARAMETERS (EXCEPT, IF NECESSARY,	HPCG
PRMTU),PRMT(5),...) SHOULD BE CHANGED BY	HPCG
SUBROUTINE OUTP. IF PRMTC5) IS CHANGED TO NON-ZERO,HPCG
SUBROUTINE HPCG IS TERMINATED.	HPCG
AUX * AN AUXILIARY STORAGE ARRAY WITH 16 ROWS AND NDIM	HPCG
COLUMNS.	HPCG
HPCG
REMARKS	HPCG
THE PROCEDURC TERMINATES AND RETURNS TO CALLING PROGRAM, IF HPCG
(1)	MORE THAN 10 BISECTIONS OF THE INITIAL INCREMENT ARE	HPCG
NECESSARY TO GET SATISFACTORY ACCURACY (ERROR MESSAGE HPCG
IHLF=11),	HPCG
(2)	INITIAL INCREMENT IS EQUAL TO 0 OR HAS WRONG SIGN	HPCG
(ERROR MESSAGES IHLF=12 OR IHLF=13),	HPCG
(3)	THE WHOLE INTEGRATION INTERVAL IS WORKED THROUGH,	HPCG
(4)	SUBROUTINE OUTP HAS CHANGED PRMT(5) TO NON-ZERO.	HPCG
66
-------
PROGRAM UDICHDEN
1821
C
1822
C
1823
C
1824
C
1825
C
1826
C
1827
C
1828
C
1829
C
1830
c
1831
c
1832
c
1833
c
1834
c
1835
c
1836
c
1837
c
1838
c
1839
c
1840
c
1841
c
1842
c
1843
c
1844
c
1845
c
1846
c
1847
c
1848

1849

1850
c
1851
c
1852

1853

1854

1855

1856

1857

1858

1859

1860

1861

1862
c
1863
c
1864

1865

1866

1867
c
1868
c
1869

1870
c
1871
c
1872

1873

1874

1875

1876

1877

1878
c
1879
c
1880

1881

1882
c
1883

1884

1885

SUBROUTINES AND FUNCTION SUBPROGRAMS REQUIRED
THE EXTERNAL SUBROUTINES FCTCX,Y,DERY> AND
OUTPCX,Y,DERY,IHLF,NDIM,PRMT> BUST BE FURNISHED BY THE USER
METHOD
EVALUATION IS DONE BY MEANS OF HAMMINGS MODIFIED PREDICTOR-
CORRECTOR METHOD. IT IS A FOURTH ORDER METHOD, USING 4
PRECEEDING POINTS FOR COMPUTATION OF A NEU VECTOR Y OF THE
DEPENDENT VARIABLES.
FOURTH ORDER RUNGE-KUTTA METHOD SUGGESTED BY RALSTON IS
USED FOR ADJUSTMENT OF THE INITIAL INCREMENT AND FOR
COMPUTATION OF STARTING VALUES.
SUBROUTINE HPCG AUTOMATICALLY ADJUSTS THE INCREMENT DURING
THE WHOLE"* COPWTATION BY HALVING OR DOUBLING.
TO GET FULL FLEXIBILITY IN "OUTPUT, AN OUTPUT SUBROUTINE
MUST BE CODED BY THE USER*
FOR REFERENCE, SEE
(1) RALSTON/WILF, MATHEMATICAL METHODS FOR DIGITAL
^ COMPUTERS, OTLEY, NEW YORK/LONDON, 1960, PP.95-109.
<2> RALSTQJU RUNGE-tCUTTA METHODS WITH MINIMUM ERROR BOUNDS
MTAC, VOL.16, ISS.80 C1962), PP.431-437.
IMPLICIT REAL*8CA-H,0-Z>
DIMENSION PRMT(5),Y(6),DERY(6),AUX(16,6)
f*1
IHLF=0
X*PRMT(1>
H-PRMTC3)
PRMT(5)*0.
DO 1 1*1,NDIM
AUXC16,I>=0.
AUXC15,I>=DERY(I>
1	AUXC1,I)*Y(I>
IF(H* CPRMT(2)—X> >3,2,4
ERROR RETURNS
2	IHLF=12
6CT0 4
3	IHLF=13
COMPUTATION OF DERY FOR STARTING VALUES
4	CALL FCTCX,Y,DERt)
RECORDING OF STARTING VALUES
CALL OUTP(X,Y,DERY,IHLF,NDIM,PRMT)
XF(PRMT(5>>6,5,6
5	IFCIHLF>7,7,6
6	RETURN
7	DO 8 I=1,NDIM
8	AUXC8,I>"DERYCI>
COMPUTATION OF AUX(2,I>
IS*1
GOTO 100
9	X=X*H
DO 10 I=1,NDIM
10 AUX(2,I>»Y(I>
HPCG
HPCG
HPCG
.HPCG
HPCG
HPCG
HPCG
HPCG
HPCG
HPCG
HPCG
HPCG
HPCG
HPCG
HPCG
HPCG
HPCG
HPCG
HPCG
HPCG
,HPCG
HPCG
HPCG
.HPCG
K*>CG
HPCG
HPCG
HPCG
HPCG
HPCG
HPCG
HPCG
HPCG
HPCG
HPCG
HPCG
HPCG
HPCG
HPCG
HPCG
HPCG
HPCG
HPCG
HPCG
HPCG
HPCG
HPCG
HPCG
HPCG
HPCG
HPCG
HPCG
HPCG
HPCG
HPCG
HPCG
HPCG
HPCG
HPCG
HPCG
HPCG
HPCG
HPCG
HPCG
67
-------
PROGRAM UDKHDEN
18*6
C


1887
C

INCREMENT H IS TESTED BY MEANS OF BISECTION
1888

11
IHLF=IHLF+1
1889


X=X—H
1890


00 12 I=1,NDIM
1891

12
AUXC4,I)=AUXC2,I>
1892


H».5*H
1893


^1
1894


XSh*2
1895


GOTO 100
1896
C


1897

13
X*X+H
1898


CALL FCT(X,Y,DERY)
1899


*=2
1900


DO 14 I*1,NDIH
1901


AUXC2,I)»YCI)
1902

14
AUXC9,I)=DERY(I)
1903


ISW=3
1904


GOTO 100
1905
C


1906
C

COMPUTATION OF TEST VALUE DELT
1907

15
DELT=0-
1908


DO 16 1=1,WOIM
1909

16
DELT=DELTfAUXC15,I)*ABSCYCl>-AUXC4,I>>
1910


DELT=.06666667*DELT
1911


IF(DELT-PRMTC4>)19,19,17
1912

17
IF(IHLF-10>11,18,18
1913
c


1914
c

NO SATISFACTORY ACCURACY AFTER 10 BISECTIONS- 1
1915

18
IHLF*11
1916


X=X+H
1917


GOTw 4
1918
c


1919
c

THERE IS SATISFACTORY ACCURACY AFTER LESS THAN
1920

19
X=X+H
1921


CALL FCT(X,Y,DERY)
1922


DO 20 I=1,NDIM
1923


AUX<3,I)=YCI>
1924

20
AUX(10,I)=DERY(I)
1925


W=3
1926


ISW=A
1927


GOTO 100
1928
c


1929

21
W= 1
1930


X=X*H
1931


CALL FCTCX,Y,DERY)
1932


X=PRMTC1)
1933


DO 22 1=1 ,NDIM
1934


AUX(11,I>=0ERYCI)
1935

22
Y
1937

23
X»X*H
1938


(*nm
1939


CALL FCT
1940


CALL OUTPCX,Y,DERY,IHLF,NDIM,PRWT)
1941


IFCPRWTC5>)6,24,6
1942

24
IF C N-4)25,200,200
1943

25
DO 26 1=1,NDIM
1944


AUX(N,I)=Y(I)
1945

26
AUX(W*7,I)=DERY
1946


IF27,29,200
1947
c


1948

27
DO 28 I=1,NDIM
1949


0ELT=AUX(9,I)*AUX<9,I3
1950


DELT=DELT+DELT
HPCG
HPCG
HPCG
HPCG
HPCG
HPCG
HPCG
HPCG
HPCG
HPCG
HPCG
HPCG
HPCG
HPCG
HPCG
HPCG
HPCG
HPCG
HPCG
HPCG
HPCG
HPCG
HPCG
HPCG
HPCG
HPCG
HPCG
HPCG
HPCG
HPCG
HPCG
HPCG
HPCG
HPCG
HPCG
HPCG
HPCG
HPCG
HPCG
HPCG
HPCG
HPCG
HPCG
HPCG
HPCG
HPCG
HPCG
HPCG
HPCG
HPCG
HPCG
HPCG
HPCG
HPCG
HPCG
HPCG
HPCG
HPCG
HPCG
HPCG
HPCG
HPCG
HPCG
HPCG
HPCG
68
-------
PROGRAM UDKHDEN
1951

28
Y(I)*AUXC1,I)+«3333333+H*(AUX(8,I)+DELT+AUX(10,I))
HPCG
1952


GOTO 23
HPCG
1953
C


HPCG
1954

29
DO 30 I>1,NDXM
HPCG
1955


DELT«AUXC9,I>*AUXC10,I5
HPCG
1956


delt*delt*delt»delt
HPCG
1957

30
y;i>»AUXC1,I)*.375*H*CAUXC8,I)*DELT*AUXC11,I))
HPCG
1958


60T0 23
HPCG
1959
c


HPCG
1960
c

THE FOLLOWING PART OF SUBROUTINE HPC6 COMPUTES BY WANS OF
HPCG
1961
c

RUNGE-KUTTA METHOD STARTING VALUES FOR THE NOT SELF-STARTING
HPCG
1962
c

PREDICTOR-CORRECTOR METHOD,
HPCG
1963

100
DO 101 I«1,NDIH
HPCG
1964


Z"H*AUXO*7,I>
HPCG
1965


AUXC5,I)»Z
HPCG
1966

101
YCI>*AUXCN,I>+.4«Z
HPCG
1967
c

2 IS AN AUXILIARY STORAGE LOCATION
HPCG
1968
c


HPCG
1969


Z"X*.4*H
HPCG
1970


CALL FCTCZ,Y,DERY)
HPCG
1971


DO 102 I*1,NDin
HPCG
1972


2*H»DERY(I)
HPCG
1973


AUX(6,I)*Z
HPCG
1974

102
Y(I)*AUX(N^I)+»2969776*AUX(5,I)*.1587596*Z
HPCG
1975
c


HPCG
1976


Z»X*.4557372*H
HPCG
1977


CALL FCT(Z,Y^DERY>
HPCG
1978


DO 103 I"1,NDIH
HPCG
1979


>H*DERYCI>
HPCG
1980


AUX(7,I)*2
HPCG
1981

103
Y(r»AUXCN^I)+.2181004*AUXC5,I)-3.050965*AUXC6,I)*3.832865*Z
HPCG
1982
c


HPCG
1983


Z*X+H
HPCG
1984


CALL FCT(Z,Y,DERY>
HPCG
1985


DO 104 X*1,NDIR
HPCG
1986

104
YCI>*AUX
HPCG
1987

~1 •205536*AUX(7,X)+«1711848+H*DERY(I)
HPCG
1988


G0T0C9/J3,15,21),ISW
HPCG
1989
c


HPCG
1990
c

POSSIBLE BREAK-POINT FOR LINKAGE
HPCG
1991
c


HPCG
1992
c

STARTING VALUES ARE COMPUTED.
HPCG
1993
c

NOW START HARMINGS MODIFIED PREDICTOR-CORRECTOR METHOD.
HPCG
1994

200
ISTEP=3
HPCG
1995

201
IF(N-8>204^02^04
HPCG
1996
c


HPCG
1997
c

N*8 CAUSES THE ROWS OF AUX TO CHANGE THEIR STORAGE LOCATIONS
HPCG
1998

202
DO 203 ^2,7
HPCG
1999


DO 203 I*1,NDIR
HPCG
2000


AUXCN-1,J>*AUXCN,I)
HPCG
2001

203
AUX(W*6,I)»AUX(N+7,I)
HPCG
2002


N»7
HPCG
2003
c


HPCG
2004
c

N LESS THAN 8 CAUSES N*1 TO GET N
HPCG
2005

204

HPCG
2006
c


HPCG
2007
c

COMPUTATION OF NEXT VECTOR Y
HPCG
2008


DO 205 I*1,NDin
HPCG
2009


AUXCN-1#I>*YCl>
HPCG
2010

205
AUX(N+6,I)=DERY(I)
HPCG
2011


X*X*H
HPCG
2012

206
ISTEP=ISTEP*1
HPCG
2013


DO 207 I=1,NDXM
HPCG
2014


DELTSAUX(N-4#I)^1•333333*H*CAUXCW*6,I)*AUXCN*6-I3—AUX(M*5.I)+
HPCG
2015

*AUXCN*4,I>*AUXCN*4,I>)
HPCG
-------
PROGRAM UDKHDEN
2016	T(I)»DELT-.9256198*AUX<16*I>	HPCG
2Q17	207 AUXC16*I5»DELT	HPCG
2018	C	PREDICTOR IS NOW GENERATED IN ROW 16 OF AUX, MODIFIED PREDICTOR HPCG
2019	C	IS GENERATED IN Y. DELT MEANS AN AUXILIARY STORAGE.	HPCG
2020	C	HPCG
2021	CALL FCT(X*Y,DERY)	HPCG
2022	C	DERIVATIVE OF MODIFIED PREDICTOR IS GENERATED IN DERY	HPCG
2023	C	HPCG
2024	DO 208 I=1*NDIN	HPCG
2025	DELT*.125*C9.*AUXCN-1,I)-AUXCN-3*I>+3.*H*CDERY(I)+A1JX(N«-6*I> +	HPCG
2026	*AUX(N+6,I)-AUXC»*5,I>>)	HPCG
2027	AUXC16*I)=AUX(16,I)-DELT	HPCG
2028	208 YCl)=OELT*.07438017*AUX(16,I)	HPCG
2029	C	HPCG
2030	C	TEST WHETHER H PUST BE HALVED OR DOUBLED	HPCG
2031	DELT=0.	HPCG
2032	DO 209 I=1,NDIM	HPCG
2033	209 DELT=DELT+AUXC15,I)*ABS)	HPCG
2034	IF(DELT-PRBT(4>)210*222*222	HPCG
2035	C	HPCG
2036	C	H HJST NOT BE HALVED. THAT BEANS Y(I) ARE GOOD.	HPCG
2037	210 CALL FCTCX*Y,DERT)	HPCG
2038	CALL OUTP(X*Y*DERY*IHLF,NDIB*PRMT>	HPCG
2039	IF(PRffT(5) 5212*211*212	HPCG
2040	211 IF CIHL F—11)213 *212 *212	HPCG
2041	212 RETURN	HPCG
2042	213 IF(H*CX-PRffTC2)>5214,212,212	HPCG
2043	214 IF (ABSC X~PRMT(2) )—.1 *ABS( H) > 212 *215,215	HPCG
2044	215 IF(DELT».02*PRPTT(4)3216,216*201	HPCG
2045	C	HPCG
2046	C	HPCG
2047	C	H COULD BE DOUBLED IF ALL NECESSARY PRECEDING VALUES ARE	HPCG
2048	C	AVAILABLE	HPCG
2049	216 IFCIHLF)201^01*217	HPCG
2050	217 IF CN-7)201,218 *218	HPCG
2051	218 IF(ISTEP—4)201 *219,219	HPCG
2052	219 IN0D=ISTEP/2	HPCG
2053	IF (ISTEP-IWOD- IHOD) 201 ,220*201	HPCG
2054	220 K=H+H	HPCG
2055	IHLF=IHLF-1	HPCG
2056	ISTEP-0	HPCG
2057	DO 221 I*1*NDIH	HPCG
2058	AUX=8.962963*>	HPCG
2068	GOTO 201	HPCG
2069	C	HPCG
2070	C	HPCG
2071	C	H MUST BE HALVED	HPCG
2072	222 IHLF=IHLF+1	HPCG
2073	IFClHLP-10)223*223*210	HPCG
2074	223 K=.5*M	HPCG
2075	ISTEP=0	HPCG
2076	DO 224 I=1,NDIM	HPCG
2077	YCI)=.00390625*(80.*AUX(N-1 *I)+135.*AUX<^2,I)+40.*AUXCn-3*I)«- HPCG
2078	*AUXCN-4,I))-.1171875*CAUXCN*6*I)-6.*AUXCN*5*I)-AUXCN*4,I))*H	HPCG
2079	AUXCN-4,I)».00390625*C12.*AUX(N-1#I)*135.*AUXC*-2,I)«-	HPCG
2080	*108.*AUX(N-3,I) + AUXCN-4,I)) —.0234375* (AUX	8.*AUX(W* 5,1) — HPCG
70
-------

PROG ft API UOKHDEN

2081
*9.*AUX<^4#X)J*H
HPCG
2082
AUX 
HPCG
2083
224 AU3C
HPCG
2084
X*X-H
NPCS
2085
DELT*X*»( W*M)
MPCG
2086
CALL FCT*m)
HPCG
2089
AUX<»*5,I5«DE*UI>
HPCG
2090
225 YCX)*AUXC»»4,tt
HPCG
2091
dclt*delt-(k+h)
HPCG
2092
CALL FCT1,HQin
HPCG
2094
DELT«AIIX<#*5,X54AUXCK*4,I>
HPCG
2095
BiLT*OEl?*DELT*DEl.T
HPCG
2096
AiiXC16#I) *8.962963* (AUXC^-1 ,I>«*Ya>5-3.361111*H*+DELT
HPCG
2097
•+DERYC2>3
HPCG
2098
226 AUXCN+3#X>*DERY(X)
HPCG
2099
GOTO 206

21 CO
END

71
-------
SECTION 5
UMERGE Listing
72
-------
PROGRAM 'JMERGE
1

PROGRAM UMERGE
2
C

3
Z
c
r
PROGRAM MERGE—8 JAN 81—BY WALTER E FRICIC—MERGING IN CROSS FLOW
%
5
X
C
r
MERGE MODIFIED TO USE UNIVERSAL DATA FILE WITH OPTIONS
o
7
c
UP-TO-DATE AS OF AUGUST 1985 
28

DATA IFILEC20)/0/,OFILEC20)/0/
29
c

30
C:
;:::INITIALIZE CONSTANTS AND VARIABLES.
31
c

32
c
IN THIS PROGRAM (PDP SYSTEM - FORTRAN IV-PLUS),
33
c
LOGICAL UNIT IN IS THE INPUT FILE.
34
c
10 IS THE OUTPUT FILE.
35
c
" IT IS THE USER TERMINAL.
36
c

37

If*=1
38

10=2
39

IT=5
40
c

41

NWO=0
42

N*=0
43

6=9-807
44

ZERCM).
45

0NE=1.
46

TW0=2.
47

PI=3.1416
48

BINTC^O.0069555
49

SHALL=1.0&-6
50

JCASE-0
51

T0RAD=PI/180.
52
c

53
c
OPEN FILES
54
c

55

VRITE
-------
66
67
6S
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
PROGRAM UMERGE
C
85 NUO=NWQ*Ntf
NCW=0
LIMIT^O
KPASE=0
JCASE=JCASE*1
CAUL RMERGEC1,LIMIT)
IFCA .LE. SMALL)A=0.1
CALL USORTCDPR,SAR,TAR,UAR,NPTS>
CALL LXMITS<1,PDEP,VAN6,T,S,NPTS,INTER,TrrL£,TlTLI,
*IEXIT ,Lf MIT)
IFCIEXIT .EQ. 0)60 TO 38
CALL RMERGE<2,LIMIT)
60 TO 85
38 IFLAG=1
IFCTARCNPT5) .EQ. 0.3IFLAS=0
JFLA6=1
XFCT .EQ. 0.)JFLAG=0
DO 1000 I=1,NPTS
IFCIFLA6 .EQ. 0)60 TO 1
DENPP C I)-SI6MAT C SAR CI),TARC 13)
60 TO 1000
1 DENPPCI5=CSAR(I)-1.)*1000.
1000 CONTINUE
C
C IF ONLY ONE DISCHARGE PORT, PORT SPACING IS SET
C EQUAL TO 1000. TO PREVENT MERGING PLUME CALCULATIONS.
IFCNP .£Q. 1)SPC=1000.
c
IFCINTER .EQ. 0360 TO 20
C
C INTERACTIVE CONTROL
C	w
3 CONTINUE
IFCNCW .EQ. 0)TQQ=T
IFCNCW .EG. 0)SQ=S
IFCNCW .EQ. 0)65 TO 11
WRITECIT,1Q) nTfLEClK>,lK=1,1G3
10	F0RMATC/1X,' DO YOU WISH TO CHANGE ANT INPUT VARIABLES AND RERUN?1
•/IX,' CASE I.D. -,10A8/1X,* TES TO RERUN OR NO FOR NEXT CASE: *,S)
READ CIT,9? ANS
9 FORMATCA13
ifcans .eq. ' y')go to 11
IFCANS .EQ. #N'360 TO 85
WRITECIT,12)
12	F0RMATC/1X,' +**+• TOU MADE A MISTAKE, TRT AGAIN #****•)
60 TO 3	-	.
11	CONTINUE
IFCNCW .EQ. 05imiTEClT,7)CTITLE
READCIT*6> CTITLIC IK),IK=1,10)
6 FORMATC10A8)	,
IFCNCW .EQ. 0)60 TO 39 «-
14	CONTINUE
WRITEUT#110)QT,NP,PDIA,SPC,VANG,PDEP
110 F0RMATC/1X,' TOUR PRESENT INPUT VARIABLES ARE:'//
•IX,'
1.
EFFLUENT FLOW CCWS)
QT
=*#no.4/
•IX,*
2.
NUMBER OF PORTS
NP
=•,15/
«1X,*
3.
PORT DIAMETER CM)
PDIA
= •^10.4/

4.
PORT SPACING £M>
SPC
= ^F9.3/
*1X,"
5.
VERTICAL ANGLE W/HORZ CDE63
VANG
=,,F9.3/
74
-------
131
132
133
134
135
136
137
138
'.39
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
18'
182
183
184
185
186
187
188
189
190
191
192
193
194
195
PROGRAM UMERGE
•1X,1 6. PORT DEPTH CM)	POEP = *,F8.2)
IFCTQQ .EQ. 0.)WRITECIT,109)SQ
109 FORMATC
*1X,# 7. EFFLUENT DENSITY CG/CM3)	S = ',F11.5)
IFCTQQ .NE. 0.)WRITECIT,112)SQ,TQQ
112	FORMATC
*1X„' 7. EFFLUENT SAL C0/00>	S =',F8.2/
•1X," 8« EFFLUENT TEMP CDEG C)	T =,,F8.2)
WRITECIT/113)
113	F0RMATC/1X,1 ENTER THE NUMBER OF THE VARIABLE
*	YOU WISH TO CHANGE. ',*)
READCIT,114)NUMBER
114	FORMAT C ID
IFCTQQ .EQ. 0. .AND. NUMBER .GE. 1 .AND. NUMBER .LE. 7)GO TO 15
IF(TQQ .NE. 0. .AND. NUMBER .68. 1 .AND. NUMBER .LE. 8)GO TO 15
WRITEUT/12)
GO TO 14
15	CONTINUE
WRITECIT/I6)
16	F0RMATC1X," WHAT IS THE VALUE OF THIS VARIABLE?
READCIT,18)VALUE
18 FORMATCF10.0)
IF(NUMBER .EQ. 1>QT=VALUE
IFCNUMBER .EQ. 2)NP=VALUE
IF(NUMBER .EQ. 3>PDIA=VALUE
IFCNUMBER .EQ. 4)SPC=VALUE
IFCNP .EQ. 1.)SPC=1000.
IFCNUMBER .EQ. 5)VANG=VALUE
IFCNUMBER .EQ. 6)PDEP=VALUE
IFCNUMBER .EQ. 7)SQ=VALUE
IFCNUMBER .EQ. 8)TQQ=VALUE
111 CONTINUE
WRITECIT/I7)
17	F0RMATC1X,1 DO YOU WISH TO CHANGE ANOTHER VARIABLE?
*	YES OR NO:
READ(IT,9)ANS
IF CANS .EQ. "N*)G0 TO 8
IFCANS .EQ. 1Y*)60 TO 14
WRITECIT,12)
GO TO 111
8 CONTINUE
T=TQQ
S=SQ
CALL LIMITSC2,PDEP,VANG/T,S.,NPTS,INTER/nTLE,TITLI,IEXIT*LIMIT)
IFCIEXI7 .EQ. OJGO TO 39
CALL RWERGEC2,LIMIT)
60 TO 85
39 NCW=1
20 CONTINUE
C
C SETUP, AND PRINT INPUT DATA
C
IFCT .EQ. Q.)DC=CS-1•>*1000.
IFCT .NE. 0.)DC=SIG*ATCS/T)
B=PDIA*0.5
VEL=CQT/NP)/(PI*B*B)
IPVEL* COS C VANG* TORAD)
V=VEL*SINCVANG*TORAD)
IK-0
DO 1100 1=1 ^TS
DPCI)=DPRCI)
SACI)=SAR(I)
TACI)=TARCI)
DA(I)=DENf>P(I)
UACI)=UAR(I)
75
-------
196
197
198
199
200
201
202
203
204
205
206
20?
208
209
210
211
212
213
214
215
216
21?
218
219
220
221
222
223
224
225
226
22?
228
229
230
231
232
233
234
235
236
23?
238
239
240
241
242
243
244
245
246
24?
248
249
250
251
252
253
254
255
256
25?
258
259
260
PROGRAM UMERGE
DENPCl5=0ENPP)
UAA*UACIU5+PR0DIS*CUA-TAUU>5
SA*=SACIU5*PR0DIS*CSACIL)-SACIU)5
OE*AS=SIGMATCSAA,TAA)
26	CONTINUE
IFCIMI .60. 1>G0 TO 31
SO TO 33
122 CONTINUE
IFCKPAGE .EQ. 1 .AND. IMI .EQ. 2)G0 TO 29
CAUL RMERGEC2,LI«IT)
WRITECI0#1203
120	F0RMATC1H1,# UMERGE VERSION 1.0 AUGUST 198S.*/2X,4C18C*),2X)5
WRITEC10,1255 CIFILE(I),1=1,19)
125 F0RMATC1X,* UNIVERSAL DATA FILE: *,,19A1)
WRITECIO,1215CTITLECI5,I=1,105
121	F0RMATC2X,*CASE I.D. #,10A8)
IF (INTER .EQ. 15WR2TECI0,2Q2) (TITLICD ,1=1,10)
CALL NMERGEC1,IFLAG)
KPAGE=INTER
GO T0 30
29	CONTINUE
CALL NMERGEC3#!FLAG)
30	IFCIMO -£Q- 2)GO TO 2002
WRITEf10/1325
132 F0RMATC/1X,* FIRST LINE OF OUTPUT ARE INITIAL CONDITIONS*5
WRITE(I0#130)
130	F0RnATC/4X#,X,,8X#'Z'#6X#,PLUBE,,4X#,DILl>-,#3X#'DENDIFF,<3X,
*'HORIZ *,4X, * VERT*,5X, • TOTAL'^X,* AMBIENT"/18X,* DIAMETER TION*
*,15X,*VEL*,6X,*VEL*,6X,"VEL*,5X,® CURRENT*/3X,* CM)r,6X,* CM)*,6X,
*•(M5•,12X,i CSIGMAT5• ,3X,# CN/S5 *,4X,* CM/S)* *4X,* CM/S)* ^SX,1CM/S)*/)
WRITEC10,400)X,Z,POIA,DILV,DHHO^J,V,VEL,UW
GO TO 2002
31	CONTINUE
CALL RMERGEC2,LIMIT)
WRITECI0,131)
131	F0RMATC1H1,* UMERGE VERSION 1.0 AUGUST 1985.'5
WRITECXO,200)4 CASE
WRITECI0,125)CIFILECD,I-1,195
WRITEC10,201)CTITLECI),X»1,105
IFCINTCR .EQ. 1)WRITECI0,202)CTITLICI),1=1,10)
W?ITECI0,203)NPTS,A,ITER,IFRQ,NAA,NAB,NAC
IFCIFLAG .NE. 05GO TO 34
WRITEC10,209)
209	F0RMATC/1X," AMBIENT STRATIFICATION*//' DEPTH SIGMAT
*	UV* CM)	CM/S)')
WRITEC 10,36) CDPRC5 ,DENPPC 15 ,UARC 15 ,1=1 ,NPTS5
36 F0RWATC1X,F7.2,F9.2*F9.3)
GO TO 33
34 WRITE(10,210)
210	F0RMATC/1X,' AMBIENT STRATIFICATION"//* DEPTH SALIN
*	TEMP SIGMAT	U'/* CM)	CPPT)	CO
*	CM/S)1)
WRITEC10,37)CDPRCI5,SARCI),TARCI),DENPPCI),UA(I5,1=1,NPTS)
76
-------
PROGRAM UHERGE
261	3? F0RHAT(1X,F7.2,,3P9.2,F9.3)
262	C
263	33 CONTINUE
264	K=B/10.
265	DT=0.01
266	DILV=1•
267	A2=0NE
268	A3-0NE
269	A4» ONE
270	TESMER=ONE
271	II-O
272	PHI=ZER0
273	TARE*=ZERO
274	XsZERO
275	DB=XERO
276	5ELS=ZERQ
277	T1ME=2ER0
278	SPC02=SPC/TWG
279	UO=U
280	vO=V
281	UI^UAA
282	2=PDEP
283	IFCJFLAG .EQ. 1 .AND. IFLAG «EQ. 1)DELT=T-TAA
284	V1=SQRTCV*V+U*U)
285	VEL=V1
286	DD=VEL*DT
287	DENSFO10Q0.+DAU)
288	DE**1000.*DC
289	DENA~10OO»"*DENAS
290	BRHD=DENA-DEN
291	DE^iOT=DEN
292	P*=PI»B*B*H*DEN
293	PWO=PH
294	B=P*/DEN*VEL/H
295	SP=99999.
296	FR=99999.
297	AK=99999.
298	IFCABS/DEN)*7WD*B*G)
300	IFCABSCBENA-DENSFC) .GT. SHALL)SP=DEN*PDEP/TyQ/B/CDENA
301	•—DENS FC)
302	tftini .NE. 1)60 TO 122
303	«RITE
315	202 F0RNATC2X,'RUN TITLE: ',10A8)
316	203 F0RNA7C/1X,* NPTSs'^a,' A=%F6.3,' lTER=#rI5/ IFRQ=*,I4/lXr
317	*• NAA=*,I2,* NAB=%I2^* NAC=',I2)
318	206 FORHATC/
319	*1X„* EFFLUX TO CURRENT RATIOCO . . .»',F10.1/
320	*1X
-------
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
PROGRAM UMERGE
*1X,' CURRENT SPEED(M/S)	= *,F12.3/
~IX,' PORT RADIUSCM)	= ',F13.4/
*1X,' NUMBER OF PORTS	= ',18/
*1X,' VERTICAL DISCHARGE ANGLE ... .= ',F10.1>
211	FORHATOX,' PORT SPACING(M)	= 1000.0'>
212	FORMATC1X,' PORT SPACINGCM)	= ',F11.2)
207	FORWAT(1X^62C* -,3//26Xrf.,nOOEL OUTPUT AFTER -J- ITERATIONS
*(MKS UNITS) J=0 ARE INITIAL CONDITIONS'//
*' J HOR CORCX) DEPTHC2) DIAMETER VOL OIL HOR VELCU)
* VER VELCV) TOTAL VEL DEN DIFF	TIME CURRENT*)
208	FORNAT<1X,I4/!OF12.3>
C
C MAIN COMPUTATIONAL SCHEME
C
2002 IP^O
ITL=0
JPmO
JTL=0
TT»0
SS=0
DO 2000 J=1,ITER
DO 2001 I=1,NPTS
IF(DP(I) .GE. Z)GO TO 40
2001 CONTINUE
40	LL=I
Ltf=I-1
TRATI^ONE
IF(V .GT. ZER0)TRATI^CDPCLL5-DP(LU))/V
TITER=TRATIM/DT
BINT=BINTO
TFCTITER .LT. 25.)BINT=BINTO*TRATIM/25./DT
IFCBINT .LT. BINTO/5.)BINT=BINTO/5.
PR0DIS=(Z-DPCLU5)/(DPCLL)-DPCLU))
UWsUA(LU)*PRODIS*CUA(LL)-UA(LU))
IFCIFLAG .EQ. 0>G0 TO 21
TT*TACLU)+PRODIS*(TACLL)-TACLU)>
SS=SA(LU)+PRODIS*CSA(LL)-SACLU)>
RR=»SIGMAT(SS^m
DENA=10Q0.+RR
GO TO 22
21	RR=DACLU)~PRODIS*(DA(LL5—DACLU))
DENA=1000.+RR
22	STH=V/VEL
CTK=U/VEL
IFCB .LE. SPC02)G0 TO 41
PHI=ATAN(SQRTCB*B-SPC02*SPC02)/SPC02)
A2=ONE-TWO*PHI/PI
A3=SPC02/B
A4=ONE-TWO*PHI/PI+SIN
-------
39*
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
41<>
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
PROGRAR UffERGE
GAHHAaDR/BINT/PH
DT=DT/GAMMA
1FCDT .GT. TWO)GAfWA=GAHHA*DT/TUO
IFCOT .GT. TWO)OT=TWO
EINS=EINS/GAHMA
2UEI=ZWEI/GA«MA
DF*=DH/GAHMA
TIHE=TIHE*OT
DTK=CSTH*UO"CTH*VO)/V1*H/DD
TQ=H-ABS(B*DTH)
UC*U
V(*V
C PW*IH D**UW) / sun
IFCJ FLAG .EQ. 0 .OR. I FLAG .EQ. 0)G0 TO 23
T^cpt*T*Dw*rn /sun
s=cpn*s+D**ss)/sun
DELT^T-TT
DELS=S-SS
DC=SIGnATCS,T)
DEW=1000.~DC
GO TO 24
23	DC=CPW»DC*Dn*RR)/SUH
0E^1000.*0C
24	0RH00=0RH0
DRHO=DENA-DEN
DENTST=DRHOO*DRHO
V=PW*V/SUFHDRHO*G/DEN*DT
V1=VEL
p*=sun
VEl=SQRTCU*lHV*V)
02»V*DT
TESW^TESnER
TES*ER=SPC02-B
PROnER=TESnER*TESnO
DX=U*DT
DD=VEL*DT
9SAVE=B
B=SQRT(Pn/CDEM*PI*H))
IFCB .GT. SPC02)B=B*SQRTCPI/CPI-TVO*PHI«-TVO*COSCPHI)«SIN(PHI)))
OB=0-BSAVE
H=VEL/V1*H
X=X+DX
ZOLD*ZO
ZO=Z
2=2-D2
OILZ=DILVO
OILVO=DILV
DILV=(Pn/PnO)*OENNOT/DEN
IFCPROWER .LE. ZERO)GO TO 43
42 IF(OENTST .LE. ZERO)GO TO 44
IFCPROnER .LE. ZERO)GO TO 45
46 IFCJ .EQ. 1)60 TO 45
IFCZ .LE. ZERO)GO TO 45
IFCDZ .LE. ZERO .AND. Z .LT. PDEP)GO TO 45
IFCJ/IFRO-CJ-D/IFRQ .NE. DGO TO 2000

GO TO 45


43
IFCIPH
•NE.
0)GO TO 4c

IFCITL
•EQ.
0)IPF*1

IFCITL
• EQ.
1)ip«=2

JPf*=J



iFCino
•NE.
2)uR2TEC10,271)

GO TO 42


44
IFCITL
.EQ.
DGO TO 46
JTL=j
79
-------
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
-78
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
PROGRAM UMERGE
IFCIHO .NE. 2)WRITEC10,270)
ITL=1
XL*-DRHOO/ ORHO-DRHOO)
TL=ZO*XL*(2-205
SATL=DILVO*XL*(DILV—DILVO)
45 DILF^PH/PHO
DIA=TWO*B
VDIA=OIA*CTH
11*11+1
IJCII)=J
IFCNAA .NE. 1)60 TO 50
C IF IFLA6=0, TT=0
AA(1,II)=TT
AAC2,II)=VDIA
AAC3,I1)=H
AAC4,H)=pn
AA(5,II)=DW
C DELS AND DELT HAVE NO NEANING UNLESS IFLAG=JFLAG=1
AAC6,II)=DELS
AA<7,II)=DELT
AAC8,II)-TAREA
AA(9,II)=BINT
AAC10,II)=PHI
AA(11,II)=ANGL
50	CONTINUE
IFCNAB .NE. 1)60 TO 51
1FCXFLAG .EQ. 1)ABC1,II)=SS
IF«A2
ABU,II)=A3
ABC5,II)=A4
ABC6,II)=CYL
ABC7,II)=RGR0
ABC8,II)=CURV
AB(9„II)=EINS
ABOO,II) = ZWEI
ABC11,II)=UV
51	CONTINUE
IF(NAC .NE. 1)60 TO 52
ACC1,II)=PR0HER
ACC2,II)=DILM
ACC3,II)«VEN
ACU,II) "GAMMA
ACC5,IX)*DT
C IF JFLAG=0, T=0
AC'.6,II)=T
XFCJFLA6 .EQ- 1)AC(7,II)=S
IFCJ FLAG *EQ. 0)ACC7,II)=DEN
AC<8,II)=DENTST
AC(9,II)=TQ
AC(10,I I)=DO
ACC11,IX)=DB
52	CONTINUE
IFC2 .LE. ZERO)60 TO 70
IFCDZ .LE. ZERO .AND. Z .LT. PDEP)60 TO 70
XFCXHO .EQ. 1)WRITE(I0,208)J,X,,Z,DIA,DILV,U,V,VEL,DRH0,TIWE,UU
XFCIWO -EQ. 0)WRITE(I0,400)X,Z,DIA,DILV,DRH0,U,V,VEL,UW
400 FOR«AT(1X,F6.2,F9.2,F9.3,5F9.2,F10.3)
2000 CONTINUE
WRITE<10,500)ITER
500 F0RHATC/1X,1 C0W>UTATI0KS CEASE: NUMBER OF STEPS EXCEEDS4,15)
IFCINTER .EQ. 0)GO TO 85
WRITE(IT,500)ITER
60 TO 3
80
-------
uiu*uiuiuiuiuiviviviviviviv»\/ivivnuiuiuiuiuiuiuiviu»u»\/iviviuiuiuiuiviuiuiui«£ui££V»viv'£^£J2X!tt}2}J},3tf},2KilSJSi3ifl*!i££Ki
ww^^^o^w>Io^wi*o3fvJ-^o,oc»-vjo»Lnf»w'\J-*oooo->j<>vi^wro-*a-»o>ow-^o
3
c



H
H
-1



A
^ >
H




Z
z

9

^ c
o
ro

a)
9
-1
"C.S
• r
*o
H O
3
m
v
^5 O
>
3
»
-*	O
• *
ft	*n
O	O
jo	w
33
H H
*»
^ C- %
SS
(I
I
ui
•j
~ *
-* *n
>< O
» 30
•	3
>
"0 X
M %
5 •
r r
r w
II 3
•	m
\s
•v m
• o
M
S-S
O
3
CD id
p?
O -0
c ro
o
e»
» H
ro
S3
m m
«i
1/1
>
o 3
m m
r*
C H
H M
SS
z •
• »
X
O *
r*
53
o $
z o
u
?S
N m
w r-
n
vi VI
-4 -J
N -*
VI VI
o o
M -»
8
^H4u4nn^nHT1t ff)
XOXOXOOXOt/lOO O
; s
O X O X	o
v % 90 %	n
2-3 - 3
»	»
-I 9 H H	H
a h ^ n	^
*•» r- *s >	^
-* C -* T>	-*
>< 3 X <0	X
% H % M \
•i _s •
?igrg
5/125
m -n rn m m
w n w r w
• ii
3 M O -9
m ^ M % M
S "¦"°
> >
3 m
id"
PS
o >
C *0
*0
g,H
JO o
T1
>• r
a a
»• ro
3
S fo 5
H \ H
3 3 3
m m
son
0) m ci
m r m
**•=
hS
30 JO
> -n
*0 >
• n
m
O x o
jo s JO
3*3
» »
H HH
« » A
s > s
^ *0 -4
X "0 X
% M %
• z -
o
?r>?
525
rn m m
w r vi
3 ii s
rn • ro
axis
m Nm
o • o
\ f\>
*	»
o ¦ m
m	*n
o 3	o
J0
z OB m
o m
Hss
H C >
JO D
522
*. JO Z
n	en
>
ci n	r
m m	m
r* *•	<
5 P
M 9
O ~« 50
z r* m
ct >
II •! n
•MX
% o ro
3zo-
• II n.
r\j -
^ >
ro
I/) O o
r	55
m > >
t/> H H
M A A
xxx
O o n
- o o
c c
ii
H H
H M
if
i/> v>
o	n
m	m
»	>
t/i	 c
H. 3
m m
o i/i
? t/»
c
"0 9
r -n
c >
3 m
< ^
m
r
o
o
O T1 T1 T1
AAA
ton z z
viz > >
H n n
m
x I t
m m
• DO
m ¦ •
o
^ X J0
CI M M
O H H
m m
—f A A
o •-« m
o o
wvw
o o
O KM
8S
m m
s
C v
A A ** A
Z Z Z	Z
> > >	>
m cd >	>
u u w w
c c c c
M M M M
H H H H
m m m m
o o o o
o o o o
o r\j o
* A A A
I AAA
[ H H H
' t. Ci (.
A ^1 A
C- C.J •-
si W
% \
AAA
S ffi 5
AAA
M M M
% « «
CUL
H M M M	« M
O T> "H "H	"" "H
A ^ A A A
00 M M M	M M
O "0 "flU	T t
3 3	3 3
t> u t ti rfl
A A A A A
(¦ON
M
z o
m
WOO-1-*
c •	• •	•
» > > > >
M z z z z
H o O o O
m •	# •	•
•T1 r* r* r| «- «
Ul	I -t
t r	m
mm*
Ci «
•	Mm
n	m c
*- m	jo •
H »	O
r a^O
v (	v
•	C »	ff»
> S H	O
Z M H
o H m H
m r\ o
O *»i *n ~n "*1 ti
A A A /> A
UIMHHHHU
n m m m m rn
OOO0OO
•n m
A A
9 M
N O
Ul
-*••••
ui rn in nt in
«-» D O O O
H • • • •
\ O -» O -*
(/) ^
> c c c c
H » 90 JO 9
r H H H N

«- H H 00
3H S O
% VI
Ul o
• O -A
ff» f\J *-•
H H -t H
s % \ >
Ul U> Ul Ul
W M -*
w w ^ w
9 H 9 H
h r h r
r % r~ *
£2 > c? £
Am
9
»-« •
CI
3?
MOO
M Z Z
H 9 9
m • •

-» ^ c.	ro
•	• P	o
> >	^
z z •	c
9 o >	30
t • Z	*H
9	H
mm*	m
F* F1 <-	«
•D	O
•	• 3	*
m m	ui
o o •	o
•	• 6)	W
\ o
in w w#
> c c
H JO JO
I M M
-* O -A •
c c o
JO » ^
HHn
H H O
ni m m m
A A A A
M M M M o
O O O O
* \ \ * U!
Ul VI Ul Ul o
^ ^ ^ s 04
#» w w J
w w w
ZPZ?
n * f- \
CI CI M M
c > c >
JO H JO H
r r-
• J0
A O
A W
9 CI
M O
h
9 Ul
PS
i
-------
^9>0>9,9l0kO0,0,0«0>0'0>0k^0>O^0>(>^^^>^0>(^0«0>(h0>0>O0l'^0k^0>O<^^»O>^0>(^0*O0«U1V/iUiUiU)UiUiUIU)UiuiUiuiUt
^f^ffffl<^hfUUUGlUljl0(U0IUINNNNNNMNNN-*^^^^^-«-*-*-»QOOpOOOOOQ'0*0>0J-iO'0(»-^otn^wr\j-*o>000->j(>uif-WN»-iO«Ow-vJC>v/i^t»jrj-*Q^D09-^Ov-n^wrvJ-*09 30 30 30
30
O JO
30

IH H
z
J
H
M


3 3
3 3 3 3 3
3
m 3
3
H
H H
H
c
-1
H
M
M
> >
> > > > >
>
-n >
>
O
m m
H
3D
m
m
-*»
-n
H -H
H H H H H
H
i -<
H

A A
z
Z
A

<-*

r\ r%
r> a a a r*
a
C a
o
C\J
HMC

M
M
Z
z
M r«j
n r\j rv> r\j ro
¦»*
r *n
•A

o o
m

o
o
*0
%
X X
X H M X M
rj
H M X

% H


>
\


\ s
H % S * %
X
« X


-* Kj


Ki
N •
•


*
• s


iM -»


o a
m

>






V
i
•
M M
m m m 3 3
v\
(a


T1 A


*0
<


z z
z » jo a) a)
•o
•v


30 ~f


9
>


H H
H > > m m
M
M


M


m
z
w
w

H H <0 3D
3D
30


H


¦g
o
C
c
> >
> M M
>
>


r




X3
30
JO 30
30 O O O O

H


M




M
H
30
30 Z Z *n ti
H
M







H
H
> >
>
o
O


M




m
m
-< -<
-< *0 D 
SSS'S'S
2
m
z


s
H




O
*
O
%
H -1 W l/l
H
H


7*




-4
—»
r» n
^ o o
30
30


II





w
flfl

»
M
>
H


•4




w
NiS
•A
w
Z Z
z r r
z
z








ei
o o
o *n -n O o
3
3


o





*0
% %
\ 30 30 C C
m
m








>

m rn fT) rn
z
z








n
a u
o o o o
-5









m
II II
M C C • •











•< -<
-< m rn \ •»
o
n









m m
m z z -* «*
o
o









MMwnnWi^
m
m










w ^ -< X >{
-*i
¦n









« •
¦ - -N >
-n
*n









* \
S H \ • •
M
M









CO 0Q 00 00 00 II II
r>
O









X X
X X X - •
M
M









\ \
% * % H \
m
m










• ••»-« M
s.
z









II II
II II II O 0»
-i
H










- - - vy>











s %
% \ \ *>|











M M
M W M X
H
II









o. o
o o o %

•









% ^
1 -
%
s









•*J
X
>J N *
X M D
3










s
\ \ n*
•
•









•
• - T%
inj
rj









rs
^
w
\









O
o o C

V









m
m m r~

X










•n -n H

%









>
> > ^











c
c c -











r
r r ~











H
V
d d











w
W V











5CCCCC
30 3D 30 30 30
o o o	o o o
o o a	g r» *•»
\M M -»	O W J*
W W V W v w
-0*0 <-t
O T> H «
m	a
>	'v
jo
gee
O 3 S3
M M
H H H
o m m
ri r*
Nhh
o o
% s
-J u
*
M
55
H M w
m -n -*»
H m m m
m *n -n -n
a ^ ^ ^ ^
^in"fln"nii*nnnnii
H H N H h > rn
^*r*«Ar%o<\A
o
% • •
C3SS
** •
o z z z z
\ > > £ >
^ o o 09 a>
Z z
3 M M >
5 H H *n
A A
> 7
¦n N
rri • • m m
3) o
m O
?3
• O
OB Z
M M	H H
r r	m <
m m	H >
a a r jo
n N m
• •
n n z h
O O > Z
3ln>
3% n
oozn
Z Z *0\
•v N H O
m n i/i H
z o s %
SCHZ
Z \ -U
H H W S
o n o
O O O
z z z
s s s
< > o
» < <
30 > >
111 3

w •



•
•
•
•
•
•
m
m
o
m
m
£>
o Kj
o
O /*> H ^
v \ -n z o o


'C
•n a
O
a
03
m
m
m
m
m
O
O
•
O
o
•
• i.
w
>4 H H
z
O O *0 *0
9
A
p
30 «
•
w
O
o
o
ID
o
0
•
•

•
•


> O H Z
c

>
o
•

w
c
•
•
•
•
•
•


rsi



o
o
o w r %
o
% > » W A
\ O y
S < H V £)
H
u


c
30







o


o



•n ^ m m
\
>
30
o

3D
M
•i
o

O
•*
o
w
w
 o s «
7»
M
0)

H
m
c
c
c
c
c
c
3
3D

30
30
H
H
¦n
m h m w

Z 5 VI %
O T) > l/»
o
w
O

m
o
30
90
3
30
30
3D
M
M
H
M
M
H
H
M
r h H

30
%


/-*
M
M
M
M
H
M
M
H
H
O
H
-1
m
m
r
N h r

% s *

(A
H

M
o
H
H
H
H
H
H
m
m

.1
m

/¦*
m
O A H

3 H W 30
c
>
O

o
%
m
m
m
m
m
m
A
»->

<%
A
•M
M
o


O rt O a
3
30


%

#->
A
*•>

r\
o
H
M
M
M
M
O
o
IS»
O M

H5rB
m
/-\


_»
w
M
H
M
M
H
M
o
O

o
o
s
s
o
^ T1

30
»-4


Ol
N
O
o
o
o
o
O
\
%

%
%
•A
-*
V
M

tgsc
6)
Sm»
o

V4
>_*
%

s
%
%
%
m*



•«
•*
_A
¦>>
r

m
%


w
H
oJ
m*

mA
«4
m*




—A
rsj
-A
a
m

C » A H
H


U)

fs)
ro
M
-A



cn

1^
KM


•s,

% M W >
M
>



M
•A
O
o
00
•g
W


V

>



HjOj)
z
30




V
V


SJ
V
M
H

M
M





JO H ^ A

A




Z
Z
Z
z
z
Z
T1


H
H





% \ % w
z
M




>
>
>
>
>
>
5
30

m
m





X M c o
m
V
S




n
n
w
a
>
>
S
O

3D
30





sgsr
c
o




















CT > W C
-n
m




















^ M o »
VI > o so
"0 -n % a
O
30
3
•o




















> > 0 04
>





















o m m o
••<
M




















m m z

s>




















\ H T

S




















> *n ^

c




















H \ 04

>




















M M O

JO




















H w «

<"¦»




















ro ti >

M




















30 -n o

w




















^ % m

\>




















M M z






















i% Z "0

H




















5 »• -u

II




















O > A






















% -n W






















z % o





















)» M V

*0




















> z

H




















V »

(/)




















Z OB






















> n

-------
PROGRAM UMERGE
651	120 F0RMATC2X,'PRINT ARRAY AB (ONO, 1=YES) * ,8X,'=' ,16)
652	121 F0RMAT(2X,'PRINT ARRAY AC CO-NO, 1=YES)'^X,'^,16,7X,'(DEFAULT)')
653	122 FORMAT(2X,'PRINT ARRAY AC (C^NO, 1=YES)' ^X,'*' ,16)
654	123 FORMATC2X,'PORT SPACING',24X,'= 1000.0	M(DEFAULT)')
655	131 FORMAT(2X,• PORT SPACING,x2CX,, = ,^F9.2,' M')
656	132 F0RMAT(2X,'INITIAL T£F*»ERATURE OF THE PLUME',4X,'=',F9.2,4X,
657	*'DEGREES CENTIGRADE')
658	133 FORMATC2X,'INITIAL SALINITY OF THE PLUME',7x,' = ',F9.2,' PPT')
659	134 FORMAT(2X,'INITIAL DENSITY OF THE PLUME',8X,#=',F11.4,
660	•' SIGMAT UNITS')
661	135 F0RMAT(2x,'FR0UDE NUMBER',23X,' = ',F8.1)
662	141 F0RMA7C/3X,'DEPTH',4x,'SALIN',4X,'TEMP',4X,1SIGMAT',6X,'U'/,
663	*4X,'(M)',5X#*(PPT)',5X,¦(C)*,14X,'(H/S)',/)
664	142 F0RMA-(1X,F7.2,3F9.2,F9.3)
665	144 FORMATC/3X,1DEPTH',3X,'SIGMAT",6X,'U"/4X,'(M),^14X,f CH/S)'/)
666	143 FORMAT C1X , F7 .2 , F9 .2 , F9 .3 )
667	200 F0RMA7C1X)
668	201 FORMATC2X,'TOTAL EFFLUENT FLOW,17X,,=",F11 .4,' CFC')
669	202 F0RMATC2X,'NUMBER OF P0RTS'^21X,'=',I6)
670	203 FORMATC2X,'PORT DIAMETER*,23X,'=',F11.4,' M')
671	204 FORMAT< 2X,1 VERTICAL PORT ANGLE FROM HORIZONTAL = ',F8.1,5X,
672	*'DEGREES')
673	205 F0RMATC2X,"P0RT DEPTH,^26X#'=,#F9.2#' M')
674	210 FORMATC/2X,70('X')//2X#,RUN TITLE: f,10A3)
675	END
676	C
677	SUBROUTINE RMERGE(£,L1MIT)
678	C
679	C	READ UNIVERSAL DATA FILE AND CONVERT DATA FOR USE IN PROGRAM UHERGE
680	C
681	C0mON/OVAR/DPR(30),SAR(30),TARC30),UAR(30)
682	COMMON/A*AR/DPC30),SA<30),TA(30),UAC30),DENPC30),DENPP(30)
683	COMMON/VAR/INTERrIDFP,ICUTOP,IMI,IMO,IAF,IITF,IIFF,lNAAF,INABF,
684	*INACF,QT,NP,PDIA,VANG,PDEP,UW,IR,HANG,SPACE,A,ITER,IFRQ,NAA,NAB,
685	•NAC,NPTS,T,S,DC,FR
686	COMMON/COUNT/NUO JiU
687	COMMON/IN0U7/IN,I0,IT
688	C0MM0N/TVAR/TITLE,TITLI,1 FILE
689	REAL*8 TITLEU0),TITLI(10),AA(10)
690	BYTE IFILEC202,0FILE(20)
691	DIMENSION 11(5)
692	DATA IFILEC20)/O/,0FILE(20)/O/ 7
693	IF(IC .EQ. 2)GC TO 40	/
694	READ(IN,200,END=99,ERR=999)(TITLE(I),I=1,10)
695	200 F0RMATC10A8)
696	READ(IN,201,ERR=999)INTER,IDFP,ICUT0P,CII(J),J=1,5)
697	201 F0RMAT(8I2)
698	READ(IN,202,ERR=999)QT,NP,PDIA,.VANG,PDEP
699	202 FORMAT(F10.0,110^3 F1C.0)
700	READ(IN,203,ERR=999)UV,HANG,SPACE
701	203 F0RMATC3 F10.0)
7C2	IFdCUTCP .EQ. 1) READ(IN^213,ERR*999) A,ITER,I FRQ,NAA,NAB,NAC
703	213 FORMAT C F5 .0 A15 A12)
704	READ CI N^204 ,E RR=999) NPTS ,S ,T
705	204 FORMATC110^2 F10.0)
706	READCIN,205,ERR=999)(CDPR(I)#SAR(I),TAR(I),UAR(I)),1=1,NPTS)
707	2C5 F0RMATC4F10.0)
708	IFdCUTOP .EQ. 0)G0 TO 34
709	IAF=1
710	IITF-1
711	IIFF=1
712	INAAF=1
713	INABF=1
714	INACF=1
715	IFCA)21rf21#22
83
-------
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
?66
767
768
769
770
771
772
773
774
775
776
777
778
779
780
PROGRAM UBERGE
21	A=0.1
IAF=0
22	IF(ITER)23,23,24
23	ITER=5000
IITF=0
24	IF(IFRQ)25,25,26
25	IFRG=150
IIFF=0
26	IF(NAA)27,27,28
27	MAA=0
INAAF=0
28	IF(NAB)30,30,31
30	NAB=0
INABF=0
31	IFWRITE(10,403)
403 F0RHATC1H1)
IFCIDFP .EQ. 0)GO TO 50
WRITEWRITE(IO,10)
10 FORMATC
*1X,*
*1X,' * MOTE, THIS IS THE ORIGINAL FILE.	*'/
*1X,* ~ IT DOES NOT REFLECT CHANGES HADE INTERACTIVELY. ~'/
*1X,P * THOSE CHANGES ARE SHOWN IN THE OUTPUT HEADING.	*'/
^1X,"
REWIND IN
IFCNWO .EQ. 0)G0 TO 41
DO 1001 1*1,NWO
READ(IN,401)CAA(J),J=1,10)
1001 CONTINUE
41	DO 1000 1=1,NW
READCIN,401>(AACJ),J=1,10)
401	F0RHATC10A8)
WRITE CIO,402)(AACJ),J=1,10)
1000 CONTINUE
402	FORMATd X,10A8)
GO TO SO
999 WRITECI0,403)
WRITECI0,998)(TITLECIK),IK=1,10)
998 FORMATdX," COMPUTATIONS CEASE FOF:•/2X,'CASE I.D. ',10A8/
*1X,' INPUT CONVERSION ERROR, CHECK DATA FILE')
IFCINTER .EQ. 1)WRITE(IT,998)(TITLE(IK),IK=1,10)
99 CALL EXIT
84
-------
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
307
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
8?4
825
82w
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
PROGRAM UMERGE
END
C
SUBROUTINE LXHXTS,TARC30)#UARC30>
COMMON/INOUT/IN,IO,IT
REALMS TITLSn0),TITLI<10>
LIKIT=0
IDEEP=0
IV AN5=0
NEGANG^O
IRHO=0
INO«0
IEXIT*0
100 I*CPDEP »EQ. 0. .OR. DPRCNPTS) .LT. PDEP3G0 TO 1
10 IFCVANG .LT. 0. .OR. VANG .GT. 90.JGO TO 101
30	IFCT «EQ« 0.)RHOE=S
IFCT .NE. O.)RH0E=1.-K).QQ1*SIGMAT-OPRCJK-1))
TT=TAR(JK-1)<*PR0*(TARCJK)-TARCJIC-1>>
SS= SAR ( J K—1 > ~PRO* (SAR(J O •"'SAR ( JIC— 1) )
IFCTARCjO .Eft. 0.)RH0A=SS
XFCTARCJK) .NE. 0.>RH0A=1.+0.001«SI6MATCSS,TT>
IFCRHOA .ST. RH0E5G0 TO 40
IRH0=1
LIMIT=1
IFCINTER «.EQ. 0)60 TO 40
120 CONTINUE
WRITE(IT,33)RHOE,RHOA
33	F0RMATC/1X,* EFFLUENT DENSITY Cf,F7.5,' G/CFG) MUST BE'/
•IX,f LESS THAN THE AMBIENT DENSITY C',F7.5,' S/CM3)')
WRIT£{IT,4)
READ CIT,5)NANS
IFCHANS -EC. ,N,)GO TO 40
IFCNANS .NE. 'Y'JWRITECIT^O)
IFCHANS wNE. 'Y')GO TO 120
IRH0=2
IF(T .Eft. 0-)60 TO 36
MRITECIT#34)
34	F0RMAT VALUE? '^5
READtIT,7)T
WRITE
85
-------
^-O'OO'O-O-O'O'O'O'OOpOOOOCDODaDasODCSODOOQOOOQOOOOOOOlJOOOQOOOOOOOOaOOOOOOOOOOOOOOOOOOOOOOOOOOOQOOOOlOOOOOOOOOOOOOOOOOOoOopoOOQO
~kQOOOOOOOOO^^),0;0,0'0,0'0^^>OOOtt(MOoeopoCoCOOOOONNNN*^'<^NNN-^0'9*9>0<^0,Q«UiUiUiUiV/1uiuiU1V/>UI^^/>r>
o*'Oo*^o>v/t*sojr\j-*ojouir»i>jr\j.-Ao»ooo-gov>Fwfo~*0'OOd->j^uir*LJr,J-»o>ow-*jfr^*,,,wrvJ--»o,ooo-j>cn#>>Cif\j-*o,ooo->jo>
o n n n o
-?1 C T\ t ¦« C
O *> O 30 o JO
S N 30 M ^ W
HH1H
> m > m > m
H «"> H «-» H *"» H
ahahahui
h ^ H to
*	X *
*> 3 •
^ n. -• m
v ^ v o
X r* 9
H % H
H IH O
H H ^
r n r o
HOfflO
« J «
w C ^ O
*	H*
« > K U1
ii h ii a
H	I	^ W
-n	h	Z	-n
«-> a	o
H	H	II	O
-»> X
X f*s
\ M -
o









ru

IM


•A



a








M
o
30 £
M
M
IH
M
JO
c


C
n
M
r
H
ff)
*n
30

C
M
M
M
n -n
JO
u
c
-n
o
m 3
<
n
T>
*n
m
3o

o
X)
o
T1
H
<
o
O
m
o
3
D
•n

*T» O
m
O
»


> M
>


/•»
>
M
>
JO
M
z
o
a
>

JO
>
JO
H
m

*-s
^ JO
>
JO
H

H
O H
z
z
z
z
o
H
Z
3
H
H
H
M
Z
H
X
o
3
H
m
z
Z
Z 3
o
3
H
*0
o
^ m
$
~
>
>
»¦>
m
c>
>
m
M
z
H
9
O
>

>
m

>
>
> >
*-»
>
m
a

M O
II
z
z
z
H
a
m
H
o
Z
H
II
II

H
H
H

iT
z
z
Z H
M
H
A

-4
H M
fV»
t*
u>

U)
(/> r*
H

M
-4
o
\ H




\
-4
o

H
m



o
Tl
%
•A
H



>
%
>•
H


3V

•
z
1
z
•
m
\A
V
V
1»
-*
X
%

•


o
•

X
\
a

•
z
•
z
• -*
m«'

X
>
#>•
•

< w

m
ft,
JD
Z

1
N
rj

m



o
*D

w

m
m
o
Z H
V
m

>

i
•
•
>

Ul



o




O



•
i
•
>
•

D

Z




z



<

§




m
z





Z


•

o

•
•
•
tA

H
9
>







m


•
•
•
(/I
c





-<
-<
z


O
N
Z

o





c


~<
-<
z

>

O



m
•
m



to
o










•
•
«

z

•





W


«o
r>


Cl





<



w
w

5

r\>
-A	w
« *	~ *
% n H J 71 C M
oijO'nMOn'n
inOlx	SO H ^
?Z	• 3 H 2
m	> oi o
H ^
nOti
X n o
> 3 "0
z > o
o n
z <-»
% o%
O tA O
o c 
o S o
M
H H H
o m o
«»%
U H OI
MHO
O
o
O X
>
o JO
m  m
0) c
O JO
O m
-* H
M H
"V.
o
o
X %
H
O H H A
m
o
H
m
Z H

•
r*
> X M
T)
m

4i
c m
/•%

•v
z n h




m ji

a
mA

73 X U
•
-o

•

%

X

o
X
rn
•
3

%
I »> ^
H
JO %
o
m
a
•
mo - "0
•
H
•
•
©
•
c

O ty o




•


-n
* P3!3
O
o
N
o

%
H
o
•
m
m
•
o


73
J m J9*

•p
90

w

00

w HO
•
H
o
c
0)
3
m
>
CO Tl
>
X

30
o



jD ffl O J9
H v n n
H H " Z
z
•
o
M

%
>
Z
o
m
H
H
H

H
m
•

iA
m
O
n

Cl
m x H u


o
r>

X
•»»
>
A no

X
M
•>4
>

H
w /> tn
•o

>
H
o
z
X
M
o • ^ ^
JO

9
\#

CI *
<
% \ •
A

fft

m
"
m
rj -Ti s
•* o
5

m
w

3r o
m
X) >
HUJ
o
m o
*o z
H m
X
•	a
H D N i
co o \ ro
S
>	* > -
n	o W 1
O	T) \ ^
m	ao
Z X	(/>
>
H Z	9
u> o	m
m w m m
k	d
•o m
o »
jo
I
m H
H X
tA m
z
~ >
3*.
z
M
S
CD
M
m
O
fl
m
m
Tl
o
H
o

>
O
m
>
O
Z
5?
D
JO
c
CO
S
ii
r»
o
m
H

s
m

»


m
H
O

-1
D
H
r

V)
m
»


c
»
VI
M

I


CO


-4
Z


o
X
m
z

<3
S

>
H
o
H

•
H
M
*0

ff)
X
<
>

m
m
m
CO

•
T
%
CO
m


O
•Q
o

•
JO
JO


o

o
H



¦n
o

a
o
N


o
m
r



T
m
—A

H
H

%

O
X
•
o
m
<
•0 >
a-o
w m
H •
(D I
m ui
H?
f~ H
O
Z O
m •
M CI 30
o m
»-> ^
< H O
> O <"
Z M
CI W H
OS
• *M
P ^
H tA
-------
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
9"%
975
PROGRAM UMERGE
•	PROFILE.'/1X,1 WITHOUT THESE DATA/ COMPUTATIONAL ERRORS
*	BAY OCCUR.'/1X,' BAKE CORRECTIONS TO DATA SETCS) AND REENTER.1)
WRITE(IT,43>
43 FORMATC/1X,' GOING TO NEXT DATA SET IF THERE IS ONE.')
50	IFCLIMIT .EQ. 0>G0 TO 70
IFCINTER .EQ. DGO TO 69
51	WRITECIO,41)CTITLECK),K=1,10)
IFCINTER .EQ. 0)GO TO 73
IFCKK .EQ. 2)WRITECIO,44)CTITLICK),K=1,10)
WRITECIT,41>CTITLECK),K=1,10)
IFCKK .EQ. 2)WRITECIT,44)CTITLICK),K=1,10)
WRITECIT,74>
74	F0RMATC/1X," NECESSARY CORREC:.ONS NOT HADE!')
WRITECIT,43?
73 WRITECI0,67)
67	F0RBATC/1X," CORRECT THE FOLLOWING AND REENTER DATA.')
IEXIT=1
68	IFCIDEEP .EQ. 0)G0 TO 52
IFCIDEEP .EQ. 1)WRITECIO,56)PDEP
IFCIDEEP .EQ. 2)WRITECI0,57)PDEP
52	IFCIVANG .EQ. 0)GO TO 54
IFCIVANG .EQ. 1)WRITECI0,58)VANG
IFCIVANG .EQ. 2)WRIT£CI0,59)VANG
54	IFCIRHO .EQ. 0)G0 TO 55
IFCIRHO .EQ. 1)WRITECI0,64)
IFCIRHO .EQ. 2)WRITEC10,65)RHOE
55	IFCINO .EQ. 0)GO TO 75
WRITEC10,42)
WRITEC10,43)
GO TO 70
69	IFCIDEEP .EQ. 1 .OR. IVANG .EQ. 1 .OR. IRHO .EQ. 1
*.0R. INO .EQ. DGO TO 51
WRITECI0*66)CTITLfcCK),K=1,10)
IFCKK .EQ. 2)WRITECIO,44)CTITLICK),K=1,10)
WRITECI9,71)
GO TO 68
56	FORMATC
•1X,' PORT DEPTH WAS ENTERED AS *,F6.2,' METERS:'/
~1X,' IF THE DISCHARGE ANGLE IS POSITIVE, THE PORT DEPTH HJSTV
•1X,' BE GREATER THAN ZERO BUT LESS THAN OR EQUAL TO THE PROFILE
•	DEPTH.'/
•1X,' IF THE DISCHARGE ANGLE IS NEGATIVE, THE PORT DEPTH MUST"/
•1X,' BE AT LEAST ONE METER LESS THAN THE PROFILE DEPTH.*5
57	F0RBATC1X,* PORT DEPTH CHANGED TO: ',F6.2,' B')
58	F0RMATC1X,' DISCHARGE ANGLE C',F6.1,')
*	MUST BE .GE. -5 BUT .LE. 90 DEG*)
59	F0RMATC1X,' DISCHARGE AN6LE CHANGED TO: ',F4.1,' DEG#)
64	F0RMATC1X," EFFLUENT DENSITY MJST BE .LT. AMBIENT
•	DENSITY AT THE DISCHARGE DEPTH')
65	F0RMATC1X,' EFFLUENT DENSITY CHANGED TO: *,*7.5,' G/CM3*)
66	F0RMATC1H1/1X,' COMPUTATIONS CONTINUE FOR'/IX,' CASE I.D. *,10A8)
71 F0RBATC1X," CORRECTIONS WERE INTERACTIVELY BADE TO
~	THE FOLLOWING:'/)
200 F0RMATC/1X,' ••~~~YOU BADE A MISTAKE, TRY AGAIN^^***')
75	IFCIEXIT .EQ. 1)WRITECI0,43)
70	RETURN
END
SUBROUTINE USCRTCDP,X,Y,Z,NPTS)
DIMENSION DPC30),XC30),YC30),ZC30)
NESTED=NPTS
L=NESTED-1
DO 1000 W=1,L
NESTED=NESTED-1
DO 1000 1=1,NESTED
I
87	— --
\
-------
976
977
978
979
980
981
982
983
984
985
986
98?
988
989
990
991
992
993
994
995
996
997
998
999
1000
PROGRAM UPERGE
IF(DPCI) .LE. DP( 1+1))€0 TO 1000
DUHWY=DPCI>
&PPU«*1)
DP(I+1)=0UWY
0UNHY=XCI)
XCI>=*CM)
XCI+1>=DUKWr
&ufwr*Ycn
YCI)=fCI+1)
TC2+i)=eunm
DUff*Y=ZCI>
2Q>=ZCI+1)
2Cl+1)=BU«fTf
1000 CONTINUE
RETURN
END
C
FUNCTION $X6HATCSM.,T)
SISO=*SAL-0.093
B= 1 • £**6* T* ( C .01667*T— .8164) *T+ 18 ~OS)
A=.001*T*C (.0010843* T-.09818)»T*4 .78675
SUi!T=3-SUHT
RETURN
END
88
-------
SECTION 6
ULINE Listing
89
-------
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
bS
54
55
56
57
58
59
60
61
62
63
64
65
PROGRAM ULINE
PROGRAM ULINE
C
C UP-TO-DATE AS OF AUGUST 1985 (NO CHANGE SINCE 6-18-85).
C JUNE 18, 1985 REVISED INTERACTIVE DATA INPUT SO USER RAY CORRECT
C ERRORS BEFORE RERUNNING THE PROGRAM.
C MARCH 19. 1985 RELOCATED THE INTERACTIVE RECYCLE SfAT
C (3 WRITE) TO 3 CONTINUE, THE FIRST STATEMENT UNDER 1 kACTIVE
C CONTROL. ADDED STATEMENTS IN SUBROUTINE LIMITS TO DETECT
C ERRONEOUS RESPONSES TO PROGRAM PROMTS I.E. .NE. TO YES OR NO.
C
C THE DIFFUSER IS APPROXIMATED AS A LINF SOURCE OF BUOYANCY
C FLUX ONLY.
C
C SUBROUTINES USORT, LIMITS, SIGMAT, CALC, RLINE, NLINE
C
COMMON/AVAR/DPC30),SAC30),TA(30),UA<30),DENP(30)
COMMON/VAR/INTER,IDFP,ILI,lLO,IRKF,QT,NP,PDEP,U,SPACE,NPTS,T,S,
*HANG,RHOE,RK,DH,IDH,FR
COMMON/COUNT/NWO,NW
COMMON/INOUT/IN,IO,IT
DIMENSION D(30),RH0(3Q),AR(30),BR(30:,HMC30),AUC30>,BUC3Q>
REAL*8 T:TLEC10),TITLI(10>
BYTE IFILEC20),0FILE(20)
C0MM0N/TVAR/TITLE,TITLI#IFILE
DATA IFILEC20)/0/,OFILEC20)/0/
C
C IN THIS PROGRAM (POP SYSTEM - FORTRAN IV-PLUS),
C LOGICAL UNIT XN IS THE INPUT FILE.
C	"	10 IS THE OUTPUT FILE.
C	-	IT IS THE USER TERMINAL.
C
11*1
10*2
IT* 5
NWCW3
m^o
T13=1./3.
C
C OPEN FILES
c
MRITE(IT^54)
554	F0RMATC/1X,* ~***PROGRAM ULINE, AUGUST 1985*****'/
*1X,9 A LINE SOURCE OF BUOYANCY FlUX ONLY*)
WRITE(IT,55S)
555	F0RMAT(/1X,# ENTER UDF NAME: ',S)
R£AD(IT,556)(IFILE(I),1*1,19)
556	F0RMAT(19A1)
WRITE(IT,557)
557	FORMATdX,* ENTER OUTPUT FILE NA«E: • ,S)
READ(IT^56X0FlLECi:,I*1 ,19)
OPEN(UWIT*IN,NAHE=IFILE,TYPE=*OLD,>
OPEN( UMIT= 10 ,i*AME*0 FILE ,TYPE"# NEW* )
c
85 N'J^NWCHMW
NCW*0
LIMTT=0
CALL RLINE(1 ,LIMIT)
CALL USORTCDP,SA,TA,UA,NPTS)
CALL LIMITS(1,NP,PDEP,H\NG,T,S,W»TS,
•inter,title,titli,iex:t,limit)
IF52,51,52
51	KFLAG-0
90
-------
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
PROGRAM ULXNE
RH0E«S
GO TO 53
52	KFLAG=1
RHOE-1 .~0.001«SIGMATCS,T)
53	IFCTACNPTS) >55 ,54,55
54	IFLAGxO
GO TO 1
55	IFLAG=1
00 1000 I=1,NPTS
DENPCI)=1.«-.001*SIGMATCSACI),TACI))
1000	CONTINUE
60 TO 2
1	DO 1001 I*1,NPTS
DENPCI)*SACI)
1001	CONTINUE
2	KPAGE=0
IFCINTER -EQ. 0)G0 TO 20
C
C INTERACTIVE CONTROL
C
3	CONTINUE
IFCNCW .EQ. 0)G0 TC 11
WRITECIT,10>CTITLEClO,I>C=1,10)
10	F0RMATC/1X,# DO YOU WISH TO CHANGE ANY INPUT VARIABLES AND RERUN?1
*/1X," CASE I.D. ',10A8/1 X,* YES TO RERUN OR NO FOR NEXT CASE: ',S)
READCIT,9)ANS
9 FORMAT(A1>
IFCANS .EQ. 'Y*)G0 TO 11
IF CANS .EQ. ,N,)GO TO 85
wr;tecit,12>
12 F0R"ATC/1X,* ***~~ YOU MADE A MISTAKE, TRY AGAIN ~*~**•)
GO TO 3
11	CONTINUE
IFCNCW «EQ« 0>WRITECIT,7)CTITLEClO ,IK=1,10)
7 F0RMATC/1X,' CASE IDENTIFICATION:'/
*2X,10A8)
WRITECIT,13)
F0RMATC1X,* WHAT IS THE TITLE OF THIS INTERACTIVE RUN? '/
~2X,S)
READUT,6> CTITLICIK),IIC=1,10)
6 F0RMATC10A8)
IFCNCW .EQ. 0)GG TO 19
14 CONTINUE
WRITEC IT ,100) QT,NP,SPACE,HAN6,PDEP
100 F0RMATC/1X,' YOUR PRESENT INPUT VARIABLES ARE:*//
»1X,« 1. effluent flow (CMS)
QT
*• ,F10.4/
*1X,' 2. NUMBER OF PORTS
NP
=•,15/
*1X,' 3. PORT SPACING CM)
SPACE
»',F9.3/
*1X," 4. H0R2 ANGLE OF THE OJSRENTV


•1X," WITH THE DIFFUSER CDEG)
HANG
=',F9.2 /
*1X,* 5. PORT DEPTH CM)
PDEP
=",F8.2)
IFCT .EQ. 0.)WRITECIT,99) S


» FORMATC


•1X,' 6. EFFLUENT DENSITY CG/CM3)
S
=',m.5)
IFCT .NE. 0.)WRITECIT,101)S,T


1 FORMATC


~IX,' 6. EFFLUENT SAL CO/OO)
S
= ',F8.2/
*1X,' 7. EFFLUENT TEMP CDEG C)
T
= ,,F8.2)
WRITEUT,21>
21	FORMATC/1X,# ENTER THE NUTOER OF THE VARIABLE
~ YOU WISH TO CHANGE. ',*>
READCIT,22)NUMBER
22	F0RMATCI1)
IFCT .EQ. 0. .AND. MJMBER .GE. 1 .AND. NUMBER .LE. 6)GO TO 15
IFCT .NE. 0. .AND. NUMBER .GE. 1 .AND. NUMBER .LE. 7)60 TO 15
91
-------
131
132
133
134
135
176
127
133
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
PROGRAM JLINE
WRITECIT/J2)
GO TO 14
15	CONTINUE
WRITECIT/I6)
16	FORKATdX,' WHAT IS THE VALUE OF THIS VARIABLE?
READ(IT/13)VALUS
18	FORMAT(FIO.O)
IFCNUMBER _eq. 1)QT»VALUE
Ic'CNUHBER .EQ. 2)NP=VALUE
IFCNUMBEP .EQ. 3)SPACE=VALUE
IFCNUMBER .EQ. 4)HANG=VALUE
IFCNUMBER .EQ. 5)PDEP=VALUE
IFCNUM3ER .EQ. 6)S=VALUE
IFCN>;MBER .EQ. 7)T=VALUE
23 C0NTINJ6
WRITECIT,17)
17	F0RMATC1X,' 00 YOU WISH TO CHANGE ANOTHER VARIABLE?
* YES OR NO: *,S)
READ(IT,9)ANS
IFCANS .EQ. "N')GO TO 8
IFUNS .EQ. *Yf>GO TO 14
YRITECIT,12)
GO *^0 23
8 CONTINUE
CALL LIHITSC2,NP,PDEP,HANG/r„S,NPTS,lNTER,TITLE/nTLI,IEXIT,LIMIT)
IFCIEXIT .EQ. 0)60 TO 19
CALL RLINEC2,LIMIT)
GO TO 85
19	NCV^1
20	THETA=HANG
TFCHANG .GT. 90.)THETA=180.-HANG
MAIN COMPUTATIONAL SCHEME
W=NPTS
00 1010 1=1,NPTS
DCI)=DP(I)
RH0CI)*0£NP(I)
IFCPDEP .GT. DCI)'GO TO 1010
DCI)=PDEP
RHO(I)=(DENPCI)—DENPCI—1))/(DP(I)—DPCI-1))*
*CPDEP-0PCI-1))*OENPCI-1>
N=I
GO TO 30
1010 CONTINUE
30 NK1=N-1
QL=QT/(SPACE* CNP-D)
00 1100 I=1,NM1
II=N-I
ARCII)=RHO(1*1)
BRCII)»-CRH0(I)-RH0C>1))/C0(I)-0CI+1))
AUCII)=UA(I+1)
BUCII)»-(UACI)-UA(I+1))/CI>CI)-DCI+1))
HHCH) = 0(N)-DCIr1 »
1100 CONTINUE
HK(N)=D(N)
ARCN)=RH0(1)
6=9.81
GP=G*
-------
196
197
198
199
SCO
201
202
203
204
205
206
207
208
209
210
211
2*2
il3
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
2*4
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
PROGRAM ULINE
*1=2
36	K2=K1+1
K«0
l^AUCD
F=U*U*U/<6P*GL>
FR=F
IFCU .EQ. 0.)*LPH=RX«Q.27*RB3/QL
IFCU .GT. 0.3ALFH=RK*U*(1.-F1>*CALCCF„>C2>5/GL
SUW=0.
sum=o.
HI=0
RI-ARtl)
DO 2000 1=1 ,um
XNK=(HHCI+15—KHCt))/DH
IFCXNH .GT. f0O.)XNH*500.
IFCXNH .LT. <.)XNtt=1.
Mmxm
DHI»CHHCI*1>-HM(I5)/NH
DH2=BHI/2.
DO 2000 J=1,NH
K-K+1
HI1=KI*S>KI
RI1=ARCI3^BRCI)*CHI1-«NCI5>
U=AU
IFCJ) 37,37 ,38
37	ALPH1sRK*0•27*RB3/SL
60 TO 39
38	F=U*U*U/CGP*QL>
FF=n*CALC(F,Kl5-f(1.-n)*CALCCF^2)
ALPM1=RK*U*FF/QL
39	SUW=5UW*tALPH*RI-*ALPHl*Rm*DH2
SU*1=SU*1* (ALP** ALPH15*DH2
Rpn=CRHOE^(suw/sum>«csum-i))/sum
IFCRPI1-RID4Q ,45*45
40	SUM0=SUH1
ALPH*ALPH1
RX-RI1
HI=HI1
RPI=RPI1
2000 CONTINUE
TL=0
SAA=SUH1
ISUR=1
GO TO 46
45	A1=CRI1-RX)/DMX
S1=RI
A2=(RPI1-RPD/DHI
82s RP2
2=(B2—BD / -CHI+Z*DHI>
SAA=SUW>CI.-Z)+SUH1*2
ISUR^O
46	CONTINUE
C
C FRIMT FINAL RESULTS
C
IFCKPAGE .EO. 1 .AND. 2LI *E0. 23S0 TO 61
CALL RLlNE<2,Ll«IT5
WRITICIO^OI)
201 F0RMATC1M1 ,1X,"JLINE VERSION 2.0 AUGUST 1985
~ A LINE SOURCE OF BUOYANCY FLUX 0NLY'/2X,4C15C#>,2X>>
WRITE(I0^205>?IFILE
205 F0RBAT<1X#* UNIVERSAL DATA FILEi *,19A1)
WRITE,ItC=1,10>
?02 F0RHATC2X,'CASE X.D. *#10A8)
93
-------
261
262
Z6 3
264
265
266
267
268
269
270
271
272
273
274
275
276
Z77
278
279
28C
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
PROGRAM ULZNE
IF(INTER .EQ. 1)WRITECIO,203)CTITLICIO,IK=1,T0)
203 cORMATC2X,a RUN TITLE: ',10*8)
CAUL NLINEC1,IFLAG)
GO TO 62
61	CALL NLINE(3,IFLAG)
62	IFCISUR .EQ. 0)WRITE(10,210)TL,SAA
210	FORMATC/1 X,• TRAPPING LEVEL =%,T?3.,% M BELOU HATER SURFACE, '
•^'DILUTION = f,F7.2)
IFCISUR .EQ. 1)WRITEC10,211)SAA
211	F0RMATC/1X," PLUME SURFACES, DILUTION =',F7.2)
IFCINTER .EQ. 0)G0 TO 85
IFCISUR .EQ. 0)WRITECIT,210)TL,SAA
IFCISUR .EQ. 15WRITECIT,2115SAA
KPAGE=1
GO TO 3
END
C
SUBROUTINE LIM1TSCK>C,NP,PDEP,HANG,T,S,NPTS,INTER,TITLE,TITLI,
«IEXIT,LIMIT)
c
C THIS SUBROUTINE CHECKS LIMITS OF PORT DEPTH CGREATER THAN 0. AND
C LESS THAN OR EQUAL TO PROFILE DEPTH), THAT THERE ARE TWO OR MORE
C PORTS, CURRENT ANGLE RELATIVE TO THE DIFFUSER CEQUAL TO OR GREATER
C THAN 0. BUT LESS THAK OR EQUAL TO 180. DEG., 90 DEG. IS PERPEN-
C DICULAR TO THE DIFFUSER, WITHIN THE PROGRAM THIS ANGLE IS FURTHER
C LIMITED TO 0 - 90 DEG.), THAT THE EFFLUENT DENSITY IS EQUAL TO OF
C LESS THAN THE AMBIENT DENSITY AND THAT THERE ARE AMBIENT PROFILE
C VALUES FOR THE SURFACE, I.E. DP(1)=0. IF INTER=1, THE PORT DEPTH,
C NUMBER OF PORTS, ANGLE AND EFFLUENT DENSITY CAN BE CORRECTED
C INTERACTIVELY BUT SURFACE DATA CORRECTION MUST BE KADE TO THE
C DATA SETCS) AND REENTERED. IF INTER=0, ALL CORRECTION MUST BE MADE
C TO THE DATA SETCS) AND REENTERED.
C
COMMON/AVAR/DPC30),SAC30),TAC30),UAC30),DENPC30)
COMMON/INOUT/IN,10,IT
REAL*8 TITLEC10),TITLIC10>
lim:t=o
IDEEP=0
IHANG=0
IRHO=0
INO=0
INP=0
IEXIT=0
100 IFCPDEP .EQ. 0. .OR. DPCNPTS) .LT. PDEP)GO TO 1
10 IF CHANG .LT. 0. .OR. HANG .GT. 180.)GO TO 11
20 IFCNP .LT. 2)GO TO 21
30	IFCT .EQ. 0.)RH0E»S
IFCT .NE. 0.)RHOE=1.+0.001*SI6MATCS,T)
DO 31 J=2,NPTS
IFCPDEP .LE. DPCJ))G0 TO 32
31	CONTINUE
GO TO 40
32	JK=J
PR^CPDEP-DPCJK-1))/CDPCjlO-DPCjlC-1>)
TT=TA C J K-1) «-PRO* CTA C J O-T A C J K-1) )
SS=SACJK-D+PR0*CSACJ«-SACJIC-1))
IFCTACJK) .EQ. 0.)RHOA=SS
IFCTAC.'O .NE. 0.)RHOA=1.«-0.001*SlGHATCSS,TT)
IFCRHOA .5E. RHOE)GO TO 40
IRH0=1
LIMIT=1
IFCINTER -EQ. 0)G0 TO 40
120 CONTINUE
WRITECIT,33)RHOE,RHOA
33	F0RMATC/1X,* EFFLUENT DENSITY C,,F7.5,1 G/CM3) IS GREATER1/
94
-------
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
373
374
375
376
377
378
T79
380
381
382
383
384
385
336
387
388
389
390
PROGRAM ULINE
*1X#' THAN THE AW8IENT DENSITY C'^F7.5#* 6/CW32*)
WRITECIT,*)
READCIT„53NANS
IFCHANS .Eft. * N* 3 GO TO 40
IFCNANS .NE. *Y# 3WRITEUT,2003
IFCNANS .NE. fY')eO TO 120
IRHQ=2
IF
READ(IT^75S
60 TO 30
36	WRITECIT^37>
37	FORWATC/1X,.1 NEW DENSITY VALUE? ',*)
READCIT,7)S
SO TO 30
1	IDEEP*1
LIRIT»1
IFCINTER .EG. 03G0 TO 10
121	CONTINUE
JFCPDEP .EQ. C^WRITEUT^)
2	F0RRATC/1X## ZERO DISCHARGE DEPTH NOT ALLOWED.*)
IFCPDEP .GT. 0.>WRITECIT,33PDEP#DP IS DEEPER THAW/
*1X,f THE PROFILE DEPTH C«,F6.2## *>.•)
WRITEUT#43
4	FORMATC/lX^* WANT TO MAKE CORRECTION? YES/NO ',53
REAOCIT r5)NANS
5	F0RWATCA1)
IFCNANS .EG, •N'JGO TO 10
ZFCNANS .NE. ' Y# 3MRITEC ST,200)
IFCNANS .NE. "T^GO TO 121
IDEEP=2
WRZTECIT#6>
6	FORHATClX#f NEW VALUE? *^S>
R£AD60 TO 122
IHANGS2
WRITECIT^)
READUT,73HANG
GO TO "0
21	INP=1
LIWT«1
IFCINTER .EQ. 03GO TO 30
123	CONTINUE
WRITECIT*22)
22	F0RWATC/1X,* MODEL REQUIRES TWO OR MORE PORTS')
WRITECIT#43
READQT,5)NANS
95
-------
391
392
393
394
395
396
39?
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
41S
416
41?
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
43?
438
439
440
441
442
443
444
445
446
44?
448
449
450
451
452
453
454
455
PROGRAM ULINE
IFCNANS .ECU 'NOGO TO 30
IFCNANS -HE. * Y* )I#RITEC IT,2003
IFCNANS .NE. ,Y*3G0 TO 123
INP=2
WRXTECI7,6>
READCIT,233NP
23 F0RMATCI4)
£0 TO
40	IFCDPC1) .EQ- 0.560 TO 50
IN0*1
LIMITS
IFCINTER .EQ. 0?GO TO 50
WRITEUT,41) ( TITLE ClO,IC=1,10)
41	F0RMATC1H1/1X,- COAPTATIONS CEASE FOR'/lX,1 CASE I.D. '/I0A83
WRITECI7,443 CTITLIClC),K=1,1Q3
44 FORMATC1X,* RON TITLE: ^lOAS)
WRITECIT,42)
42	F0RM*TC/1X," m surface data for the AMBIENT DENSITY/CURRENT
*	PROFILE.V1X,* WITHOUT THESE DATA, COMPUTATIONAL ERRORS
*	MAY 0CCUR.*/1X,# MAKE CORRECTIONS TO DATA SETCS) AND REENTER.*)
WRITECIT,433
43	FORMATC/fX,* SOINS TO NEXT DATA SET IF THERE IS ONE-*)
50	IFCLIMIT .EQ. 0)60 TO 70
IFCINTER .EQ. 1>60 TO 69
51	WRITE(I0,41) (TITLECIC3 ,1C=1 *103
IFCINTER .EQ. 0)50 TO 73
IFCIOC .EQ. 23WRITE(I0,44KTITLI
67	FORMATC/1X,' CORRECT THE FOLLOWING AND REENTER DATA.')
IEXIT=1
68	IFCIDEEP .EQ. 0)60 TO 52
IFCIDEEP .EQ. 13WRITE(IO,563PDEP
IFCIDEEP .EQ. 23WRITEC 10,57)PDEP
52	IFCIHANG .EQ. 0)GO TO 53
IFCIHANG .EQ. 13WRITEC10,583
IFCIHANG .EQ. 2)WRITE CIO,59)VANG
53	IFCINP .EQ. 0)GO TO 54
IFCINP .EQ. 13WRITEC10,623
IFCINP .EQ. 23WRITE(10,633NP
54	IFCIRHO .EQ. 0>G0 TO 55
IFCIRHO .EQ. 1>WRITEC10,64)
IFCIRMC .EQ- 23WRITEC10,653RHOE
55	IFCINO .EQ. 03G0 TO 75
WRITEU0,42)
WRITECI0,433
GO TO 70
69	IFCIDEEP .EQ. 1 .OR. IHANG .EQ. 1 .OR. IRHO .EQ. 1
•.OR. INO .EQ. 1 .OR. INP .EQ. 13G0 TO 51
WRITECI0,66)CTITLECK),K=1,10)
IFCICK .EQ. 23WRITE(10,443 CTITLlClC),K-1,10)
WRITECIO.,713
GO TO 68
56	FORMATS
*1X,1 PORT DEPTH WAS ENTERED AS ,,F6.2,i METERS;*/
*1X,' THE PORT DEPTH BUST BE GREATER THAN ZERO BUT*/
~IX,* LESS THAN OR EQUAL TO THE PROFILE DEPTH.')
5? FORMATC1X,f PORT DEPTH CHANGED TO; '^6.2,* M'3
53 F0RMATC1X,* CURRENT ANGLE RELATIVE TO THE DIFFUSER
*	MUST BE .GE. 0 8UT .LE. 180 DEG')
59 P0RMATC1X,* CURRENT ANGLE RELATIVE TO THE DIFFUSER
96
-------
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
PROGRAM ULINE
*	CHANGED TO: ,,F6.2„' DEG')
62	F0RMATC1X," MODEL REQUIRES TWO OR WORE PORTS')
63	F0RMATC1X,' NUMBER OF PORTS CHANGED TO: 1,14)
64	FORMAT(1X,f EFFLUENT DENSITY HJST BE .LE. APBIENT
*	DENSITY AT THE DISCHARGE DEPTH')
65	F0RMATC1X,' EFFLUENT DENSITY CHANGED TO: ",F7.5,' G/CH3')
66	F0RMATC1H1/1X,* COMPUTATIONS CONTINUE FOR'/IX,' CASE I.D. '/1CA8)
71 F0RMATC1X,' CORRECTIONS WERE INTERACTIVELY MADE TO
*	THE FOLLOWING:'/)
200 FORMAT(/'iX,z ¦¦¦¦¦tOu piadE A ftlSTAiCE, TRY	5
75 IFCIEXIT .EQ. 1)WRITE(I0,43)
70 RETURN
END
C
SUBROUTINE RLINE'IC,LIMIT)
C
C READ UNIVERSAL DATA FILE AND CONVERT DATA FOR USE IN PROGRAM ULINE
C
COMMON/AVAR/DP(30),SA(30),TAC30),UA(30),DENP(30)
COMMON/VAR/INTER,IDFP,ILI,ILO,IRJ(F,QT,NP,PDEP,U,SPACE,NPTS,T,S,
*HANG,RHOE,RK,DH,IDH,FR
COMMON/SAV/11(5 >,1CUTOP
COMMON/COUNT/NW0,NW
COMMON/INOUT/IN^IO^IT
REAL*8 TITLEC10),TITLI(10),AA(10)
BYTE IFILE<20),0FILEC20)
COMMON/TVAR/TITLS/TITLI,I FILE
DATA IFILE(20)/0/,OFILE(2G)/0/
C
IF(K .EQ. 2)GO TO 40
DK=0.
READ(IN,200,END=99,ERR=999) (TITLE(I),I=1/I0)
200	FORMATC10A8)
READCIN^201 ,ERR=999) INTER,IDFP,ICUTOP,(II
205	F0RMAT(4F1C-0)
ILI=II<5)
IL0=ILI
IFCIOITOP .EQ. 0)GO TO 35
IDW=1
IRK F*1
IF C R1C)35,35,36
35	IRKF-0
RK»1.41
36	IF(DH)37,37,38
37	IDH=0
D*=0.1
50 CONTINUE
38	RETURrJ
40 NV=NPTS*5*ICUT0P
97
-------
5?8S™833^0'W?olN-*0^<»SO»W>?'WN.*0'OaSO,W#'WfO^O'06#M»w}'WN-*0,009-JO'^l^
*• *~ w w
9
uiuiuiini/tt/imuit/iutuiin
wwwNMrorjrjrjrorjrvj
N-^o^ooe-^ov/if-ww-*
n n n r»
rvi
Ch
•n C
O 30
30 ~-«
m 3 -| M
t> > m *n
0	^ A
M r"» M H
•g W O
r x * •
>s -» Z
q «wm
n •
1	o ^
m CO -n O
o m n <
• 33 ^
_ H C
O l/> JO
O T1
O »
O
H C
o o
a


*





fl

•
*T>




o

a
o

O

O
50

m
JO

JO

30
m a
H
cn
3
M
3
M
3
¦n >

jo
?

s
*n
>
« -4

in
H
A
H
*->
H
—1 o
H
m
»»N
H

M

rj


M

r\j
©
rj
* x
t

X
•
X
Z
M
m %
Z
r»
*
Z
*

%
o -
m
m
•
m
¦
¦
•
• M
•
z
M
•
H

H
z

—i
z

z
6
z
O M
o
M
M
o
H
•

• H
•
a\
H
•
m

ro
W H

30
•H
w

•A
Cl
c >
c
*

C

V
9
jo r
30
o
r
29
>
c
>
H
M
m

M
H
JO
H
H (A
H
•
H
H
M
M
14
m >
m
w
m
m
O
H
O
W ^ W A W
x -n x *n
• \ % -*
m - • • • >
o » m » m M
• o o o o >
CO $ CD • W
o m m
^ jo -* so o
c H *+ H	~
v>
lMS
in
r\ z »"»	r	<"»
H M M	H H
O M o	z	o
% HS	M	%
u	j a
m rvi	-<	m
mow	r»
«-• -n ^	O »-»
9 I/)	l) V)
i^zinzm
"
m
>
m n m
 m
H M H
O H O O H O H
% ro > » o a> o
t % *
-»	J
*» l/> Ol > -* > -*
H ^ S N S
o
(/I
in
H
O
m
* m z
3 Z
B 3
£



• 7
* •
m

>
N
%
%
H
- *
_»

•*
*0
X
Ul

o>
a
r
m
K
K
H
X
c

*
\
%
*
3
T>
•
m
•
•
m
r-
II
II
II
ii

e




%
a
*
%
%
%
a
m

3
3

%
*
•
•
•
•

*•

rvj
r\)
ro
i"
X
*
\
v.
V

V
%
•

K

H
3
II
•

>
¦

%
*4
\

rs

<-*
•
3

O

C7
*•

m

m
\
•



*n
3
f\l
V
M
\

&
r
H
w

>
c
r
H
H


•

m





«~
V


V,






*




9
n
o

90 X
n
n

(A
>
o
o
•<
m >
o
o

C
H
3
1
H
> z
3
3
M
Q
>
1
O
§
m

2
1
5
73
O
M
2.
T
M
00 30
z
z
in
C
T
*«%
•n.
n
X
v.


-1
M
H

M
H O
C
>
M
H
r
y
<
r
m ro
>
<
X
z
m
rt
>
m

73
>
"D
m
r>
5
30
r\
r s
v.
30
c

M
H
v.
ro
ro X
M
v.
H
2
a

H
O
^ %
z
a

r

M
M

-» a
H
X
O
M

z
H
>
o X
m
r*
>
z
o

r
o
^ N
90
u
H
m
«>k
M
m
¦n
% M
%
o
>

\
O
H
H
H 17
M
V

k
Os
H
r*
M X
O
%
n
%
1%
M
M
m
?%¦


O
M
M
H
H

>
10
?
r

r
3
w n
%


m

M



s
w
•«
r
a
r
0)
IM

M

o
M

M

o

•n


S
%
z

w

M


H
H
ro

•s,

r


r
»


a

m


O
r»
H

•«»




%
OJ
z






»-• o







5
w
z







%
ro






•y%
C
c






s
>







o







%
a
H







in







o
m
z
T»


fcB
* w
>
o ro o
o m
00 W
f
m ro
»m ii
n m
m vi
-------
586
587
588
589
590
591
592
593
594
595
596
59?
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
62S
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
PROGRAM ULINE
VRITECI0,131)
131	FORMAT 03X,* DEPTH *,4X," SALIN* ^SX^'TEHP" ,4X,* DENSITY*,6X,*U*/
*4X#»CM) •*5X,,,#SxVfC>,,6X,,CG/CK3>##3X,.•(*/$>•/)
aaiTEENPCl>,UAU)),I=1,NPTS)
132	F0MITC1X,F7.2,??9.2,F11.5,F9.3)
GO TO 2
134	WRITE
WRXTEC,DENPCtt,UACX)),Is1,NPTS)
133	F0RMATC1X,F7.2,M0.5,F8.3)
2	WRXTE<10,200)
200	F0RMATC1X)
WRITE<10,201)CT
201	F0RMAT(2X,#T0TAL EFFLUENT FL0V*,17X,'**,F11.4,* CMS*>
WRITeC10,202)HP
202	F0RMATC2X,*NUMBER OF PORTS',21X,"=',16)
WRITE(10,203)SPACE
203	F0RMAT(2X,'P0RT SPACING* ^X^^O^S,* M«5
MRITECIO,2043HANG
204	F0RMATC2X,'HORIZONTAL ANGLE*,20X,*=*,F8.1,5X,'DEGREES')
HRITEC10,2053PDEP
205	FORMATC2X,"PORT DEPTH*,26X,'=,rF9.2,# M")
RETURN
3	WRITECl0,21Q)CTlTLiaiC>,lr=1,10)
210 F0RJ1ATC/2X,66C*XI3//2X,"RUN TITLE: §#10A8/)
WRITEC10,12£>FR
GO TO 2
END
SUBROUTINE US0RTrDP,X,Y,Z,NPTS3
DIMENSION DPC305,XC30),Y<30),Z<303
NESTEB=NPTS
L-NESTEB-1
DO 1000 M=1,L
NESTED=NESTED-1
DO 1000 I=1,NESTED
IFCDPCI) -LE. DPCI+1>>G0 TO 1000
DUNMY=DPU)
DPCI)=DPCI«-1)
DPQ*1)=0UMMY
DUMMY-XCI)
XCI3==XCI+13
X*T*13.P3>
A«,00t*r»(0010o43*T-.09818)^T*4.7867)
SUMT=CT-3.983*CT-3,98)«a*2S3.3/C503.5?*CT*67„2©))
SIGMAT=CSIG0^.1324)*C1.-A^B*
-------
651
652
<•53
654
655
656
657
658
65*
660
661
662
663
664
665
666
667
663
669
PROGRAM ULINE
FUNCTION CALCCF^C)
c
C0PW0N/XX/FFC4^3)^AAU^J) ,BBC4,3> „2ZC3) ,NN<3>
DATA rF/.2/13.84#30„/IOO.#.13,.3,.6„100.,.07,.13„100.,0./
DATA AA/.27#.3167,.2387,.17,.27„.3536,.3936..412S,.27,,
*.4367,.5879,0./
DATA B8/.3333,.2346,*127,.02723,.3333,.2020,-1131*-0213,.3333,
•.1525,*0067,0./
DATA 2Z/.150,.3?4,.570/
DATA NN/4,4,3/
#=KN(K}
DO 1000 1=1,N
IFCF-FF
RETURN
1 CALC=AA<2,iO*
RETURN
END
100
-------
wir*' iu'
REPORT DOCUMENTATION » report no. j 2.
PAGE 	^A/W!^S6/9l2b _ j
4. Title and Subtitle
Initial Mixing Characteristics of Mmicipnl Ocoan Discharge
^ol'jmc TI: Computer Programs
X Recipient** Accession No.
PB86-157460
S. Report Date
r6.
8. Performing Organization Rept. No.
7. Authors M-I). Schuldt, L.R. Davis, and W.!i. Frick
W. P. Muellenhoff, A. M. Soldate, Jr. P.J. Baiimeartner
9. Performing Organisation Name and Address
Pacific Division, Environmental Research I.ab.
Narragansett Office of Records f, Pcvelopmort
IJ. S. Hnvironmental Protection Agency
Newport, UP 97565
12. Sponsoring Organisation N«mj and Address
20. Proiect/Tast/Work Unit No-
ll. ContractfO or Grant(G) No.
(C)
(G)
13. Type of Report & period Covered
14.
	 	 		I
15. Supplementary Note*
__ [:or magnetic tape see PBS6-157494	L:PI_IUskcttc see PB86-1574Sh
16. Abstract (Limit: 200 words*
This report (Volume II) contains a description of U"™f*al °®"
a* de'ia,^ ^'SVcrsthi%?a%uceirso^onnci
jroSiS^afcepraOleSrtiStes.'Vro^'thrmodels is recorded for conditions
outside these, ranges and for detailed analysis.
17. Document Analysis a. Descriptors
p. Identifters/Open-Ended Terms
c. COSATI Field/Croup
18. Availability Statement
19. Security Class (This Report)
21. No,»f PH«*




2C. Security Class (This-Pago)
22. Pr*e». •
(S«c ANSI—Z39 2 8)	S«« Instructor* on Revers#	T OPHOHAL FORM ZTZ (
„ (Mnmrty NTTS-35)
•' oepefttwit of Comnw
-------