EPA-450/4-88-006b
April 1988
A Dispersion Model For Elevated Dense
Gas Jet Chemical Releases
Volume II. User's Guide
U.S. ENVIRONMENTAL PROTECTION AGENCY
Office of Air and Radiation
Office of Air Quality Planning and Standards
Research Triangle Park, North Carolina 27711
U.S. Environmental Protection Agency
Bsgion 5, Library (5PL-16)
2.7.0 S. Dearborn Street, Room 1670
rMoago, -IL 60604
-------
DISCLAIMER
This report has been reviewed by the Office of Air Quality Planning and Standards, U.S. Environmental
Protection Agency, and approved for publication as received from Dr. Jerry Havens. Approval does not
signify that the contents necessarily reflect the views and policies of the U. S. Environmental Protection
Agency, nor does mention of trade names or commercial products constitute endorsement or
recommendation for use. Copies of this report are available from the National Technical Information Service
(NTIS).
ACKNOWLEDGEMENTS
The elevated dense gas jet model incorporates methodology published by Ooms and his colleagues at
the Technological University Delft, The Netherlands, along with the DEGADIS dense gas dispersion
model developed at the University of Arkansas. Tom Spicer, my coauthor of DEGADIS, contributed to
the development and was responsible for the modifications to DEGADIS required for interfacing with
Ooms' model.
Jerry Havens
-------
PREFACE
This version of the elevated dense gas dispersion model, Ooms/DEGADIS,
has been developed by Dr. Jerry Havens and Dr. Tom Spicer of the
University of Arkansas with the support of funding from the United States
Environmental Protection Agency (EPA). It represents intermediate
development of a dense gas modeling package which is undergoing further
refinement through additional EPA support. While this model has not been
extensively tested against field data, and is subject to specific
limitations and uncertainties, the EPA is making it publicly available
through the National Technical Information Service (NTIS) as an interim
research tool pending further model evaluation and development.
The Ooms/DEGADIS model has been written in FORTRAN with specific
intent for compilation and execution on a Digital Equipment Corporation
VAX computer. Implementation of this model on any other computer system
may be attempted at the risk of the user. Considerations for such
implementation, however, are discussed in Appendix B of Volume II.
To facilitate dissemination of the model, it is being provided on two
PC-compatible diskettes. The model should be uploaded via modem from a PC
terminal to a host VAX computer, and several files must then be renamed
prior to compilation and execution. Specific information on this process
is contained in the file AAREADME.TXT. Print this file and the
compilation batch file, BUILD.COM, prior to attempting compilation.
It is the concern of the EPA that this model be applied only within
the framework of its intended use. To this end the user is referred to
the specific recommendations in Volume I, Section VII for model
application. These recommendations take advantage of the fact that, in
this version of the Ooms/DEGADIS model, the portion of the model adapted
from Ooms and his colleagues can be executed as a standalone model, as can
the DEGADIS portion. To begin any particular simulation, it is
recommended that the Ooms portion of the model be executed by itself.
-------
This can be accomplished by setting the input variable equal to 1.
If the output from this simulation predicts that the plume will touch down
less than 1 kilometer from the source, the complete Ooms/DEGADIS model may
be appropriately applied (set equal to zero or greater). If the
plume is not predicted to touch down within 1 kilometer, this model should
not be used.
-------
VOLUME II
TABLE OF CONTENTS
Section
List of Tables
List of Figures
List of Symbols
Summary
I. Model Summaries
Ooms Model
DEGADIS Model
Limitations and Cautions
II. Model Inputs
VAX/VMS Command Procedure
Simulation Definition
III. Model Implementation
IV. Example Simulation
Pace
11:
References
Appendix A.
B.
C.
D.
E.
F.
G.
H.
I.
J.
Installation on VAX/VMS
Considerations for Installation on other Systems
DEGADIS Implementation
Standalone DEGADIS Example Simulation
Ooms' Model Code Listing
DEGADIS Code Listing
Ooms-DEGADIS Interface Program Code Listing
Partial Listing of DEGADIS Variables
DEGADIS Diagnostic Messages
Ooms/DEGADIS Example Simulation Output
11
21
25
A-l
B-l
C-l
D-l
E-l
F-l
G-l
H-l
1-1
J-l
-------
LIST OF FIGURES
Figure Page
I.I Schematic Diagram of Ooms' Model 1
1.2 Schematic Diagram of DEGADIS Model 4
II.1 Example DEGADIS Command Procedure on VAX/VMS
for a Steady-State Simulation Named TEST_S 10
II.2 Example DEGADIS Command Procedure on VAX/VMS
for a Transient Simulation Named TEST 10
II.3 RUN_NAME.IN Structure Required by OOMS_IN 13
C.I DEGADISIN Flowchart C-2
C.2 Structure for Free-Formatted RUN_NAME.INP File C-2
C.3 DEGADIS1 Flowchart C-3
C.4 SYS$DEGADIS:EXAMPLE.ER1 Listing C-8
C.5 DEGADIS2 Flowchart C-ll
C.6 SYS$DEGADIS:EXAMPLE.ER2 Listing C-14
C.7 DEGADIS3 Flowchart C-16
C.8 SYS$DEGADIS:EXAMPLE.ER3 Listing C-19
C.9 DEGADIS4 Flowchart C-21
C.10 Structure of Input for DEGADIS C-23
C.ll SDEGADIS2 Flowchart C-25
D.I BURR09S.INP Listing D-14
D.2 BURR09.INP Listing D-15
in
-------
LIST OF TABLES
Table Page
II.1 Representative Monin-Obukhov Lengths and Power Law
Exponents for Different Atmospheric Stabilities 12
D.I Summary of Burro 9 Test Conditions Used in
Example Simulations D-l
-------
LIST OF SYMBOLS
bj characteristic width of plume (radius — b.j/2) , m
c local concentration, kg/m
c~ concentration on plume axis, kg/m
r radial distance to jet/plume axis, m
s distance along plume axis, m
u local velocity in direction of plume axis, m/s
ua wind velocity, m/s
u* plume excess velocity at plume axis,
u(r = 0) - uacos0, m/s
x horizontal coordinate, m
y vertical coordinate, m
a^, 0:2, 0:3 entrainment coefficients
9 angle between plume axis and horizontal, radius
A turbulence Schmidt number, 1.16
p local density, kg/m
o
pa air density, kg/m
p" plume excess density at plume axis,
p(r - 0) - pa, kg/m3
vn
-------
SUMMARY
The mathematical modeling techniques used to predict atmospheric
dispersion of denser-than-air gases in the Ooms and DEGADIS models are
briefly summarized. The Ooms model describes the release and subsequent
dilution and trajectory of an elevated gas jet as a gas plume. If the
plume falls to ground level, DEGADIS describes the resulting ground-
level plume. As well, DEGADIS can be used to describe the release and
dilution from a low-momentum, ground-level release. The necessary
model-input information to simulate a denser-than-air gas release is
summarized. Example simulations of steady-state and transient release
are included. Guidelines for installation of the models are included,
and a listing of the Ooms and DEGADIS models are included along with a
partial list of program variables and diagnostic messages.
IX
-------
I. MODEL SUMMARIES
This section is intended to summarize the critical components of th<=-
formulation of each model and the associated limitations and cautions.
The suggested limitations and guidelines are based on the experience
gained during the development of the models and verification by
comparison with a wide range of denser-than-air gas laboratory and
field-scale dispersion tests.
Poms' Model
Ooms, Mahieu, and Zelis' (1974) model comprises simplified balance
equations for mass and momentum to describe the jet illustrated in
Figure I.I.
y t
axis
Figure I.I. Schematic diagram of Ooms' model.
-------
Gaussian similarity profiles for velocity, density, and concentra-
tion are assumed to apply in the developed jet:
2 2
u(s,r,0) - u cosd + u*(s) e"r /bj(s) (I.I)
3,
2 22
p(s,r,0) - P + P*(s) e'r /A bj(s) (1.2-
cl
2 ..2,2, N
„. ,..-r/AD.(s) / T -> •
c(s,r,0) = c*(s) e ' j ' (1.3;
Balance equations for mass, horizontal and vertical momentum, and energv
are integrated over the radius of the plume, and the resulting ordinary
differential equations are numerically integrated. Initial conditions
are specified at the beginning of the "developed flow" region of the jet
(Figure I.I). The trajectory of the jet to the developed flow region i;'
calculated using wind-tunnel data correlations by Kamotani and Greber
(1972) .
The balance equations for mass and momentum incorporate empirical
coefficients for estimating air entrainment. The coefficients a-\ , 0:9,
and 0:3 provide for entrainment as follows:
<*]_ is the entrainment coefficient for a turbulent free jet. The
value 0.057 was incorporated by Ooms, after Albertson, et al.
(1950).
0:2 accounts for entrainment into the plume at a sufficiently long
distance downwind of the vent where the velocity of the plume
approaches the wind velocity. The value 0.5 was incorporated by
Ooms, after Richards (1963).
a-j accounts for entrainment due to atmospheric turbulence. Ooms
suggested estimation of the entrainment velocity as u' = (eb^) / ,
with specification of e (the eddy energy dissipation) as a function
of height, wind velocity, and atmospheric stability. The eddy
energy dissipation for a neutral atmosphere was recommended by
Briggs (1969):
-------
in the input file.
DEGADIS Summary Description
The DEGADIS (DEnse GAs DISpersion) model combines the principal
features of the Shell HEGADAS model (Colenbrander, 1980, and
Colenbrander and Puttock, 1983) and a box model proposed by van Ulden
(1983). DEGADIS was developed for the U.S. Coast Guard and the Gas
Research Institute and was designed to model the atmospheric dispersion
of denser-than-air gases (Havens and Spicer, 1985, and Spicer and
Havens, 1987). The general application of the model involves formation
of a "secondary" gas source, the subsequent entrainment of gas from that
secondary source by the wind field, and downwind dispersion of the gas
plume or cloud. Figure 1.2 illustrates the general methodology. The
description of the formation and development of the secondary source
utilizes a box model. The entrainment from the secondary source and
subsequent downwind dispersion utilizes the similarity representations
of the cloud concentration and vertical velocity profiles of the HEGADAS
model. Denser-than-air gas releases which cannot be represented as
-------
Ambient
vind
(can be
zero)
Input to
dovnvind dispersion
model
„ , ,
Q*(0
| |"
T(t), C(t), p(t)
R(t)
Secor.darv Source Formation
-T^ )
Frontal
er.tr air.raer.t
velocity u
ISO CONCENTRATION \
CONTOURS \
FOR °-c-
Downwind Dispersion
Figure 1.2. Schematic diagram of DEGADIS model.
-------
steady, continuous releases are modeled as a series of pseudosteady
releases. A complete description of DEGADIS can be found in Havens and
Spicer (1985) or Spicer and Havens (1987).
Application of the model to releases of a denser-than-air gas in
zero wind involves only the box model. The box model treatment of
gravity spreading and associated air entrainment is based on
parameterization of the laboratory still-air experiments described by
Havens and Spicer (1985). For releases in wind, the box model also
describes the source development but provides for entrainment of the
gas-air source cloud into the ambient wind field.
DEGADIS incorporates heat transfer and water transfer when
applicable from the underlying surface to the cloud. Inclusion of these
procedures in the model is optional. Effects of heat transfer on both
the mean cloud buoyancy and the vertical turbulent mixing (air entrain-
ment) are included while direct effect of water transfer is included
only in the mean cloud buoyancy.
DEGADIS is written in Digital Equipment Corporation's VAX/VMS*
Fortran (a superset of ANSI Fortran 77); it is composed of six programs
which communicate using ASCII files (see Section III and Appendix C). A
listing of the code is included as Appendix F, and a partial list of
program variables is given in Appendix H. Considerations for
installation of DEGADIS are discussed in Appendices A and B. DEGADIS
self-diagnostics are listed in Appendix I along with suggested actions.
(Appendix D discusses the input information for a standalone DEGADIS
simulation.)
As a standalone model, DEGADIS application should be limited to the
description of atmospheric dispersion of denser-than-air gas releases at
ground level onto flat, unobstructed terrain or water. Because of the
assumption of flat, unobstructed terrain, when the surface roughness
used in DEGADIS becomes a significant fraction of the depth of the
dispersing layer, this assumption may no longer be satisfied. Applica-
tion to releases from sources above ground level (e.g. overflow from
*VAX and VMS are registered trademarks of Digital Equipment Corporation.
-------
dikes) would be expected to give conservative predictions of the
downwind hazard zones, but this has not been verified.
Demonstration of DEGADIS has been primarily directed to the
prediction of hazard extent defined by gas concentrations in the
hydrocarbon flammable limit range (-1 to 20%). Even though the relation
between peak gas concentration and time-averaged gas concentration is
uncertain, there is some basis for using 2.0 as an estimate of the peak-
to- time-averaged-concentration ratio for determining a flammable gas
concentration zone. If this assumption is made, the predicted distance
to LFL/2 would be the maximum distance at which a flammable gas
concentration would be predicted. Based on the simulations of field
experiments presented in Havens and Spicer (1985), the average ratio of
observed distance to calculated distance for a given time-averaged
concentration level (OBS/PRE) ranged from 0.82 to 1.03 for the 2.5%
level nine out of ten times (i.e. 90% confidence interval); for the 5%
level, the average (OBS/PRE) ranged from 0.73 to 0.96 for a 90%
confidence interval. If for a given release scenario the calculated
distance to the 2.5% average concentration level was 120 m, the distance
to the 2.5% average concentration for nine out of ten realizations of
the same release would be expected to range (on the average) between 98
m and 124 m, which would also represent the range of the downwind extent
of the flammable gas concentration zone for LNG if the peak-to-average
ratio of 2.0 is assumed.
Limitations and Cautions
There are some items which should be considered when using the Ooms
and DEGADIS models. As previously stated, because the Ooms model
equations were derived using the ideal gas equation of state, the
current version of the Ooms model code does not account for changes in
temperature and density associated with moisture condensation or with
contaminant phase changes (contaminant aerosol). Of course, neither
model is currently capable of determining any interactions with
obstacles in the flow. Also, the Ooms model will not approach the
Gaussian plume model as the density and momentum of the released jet
approach ambient values. This is due to the fact that the Ooms model
-------
assumes the jet to be radially symmetric at all times which is not true
for the Gaussian plume model since ay and az are not generally equal.
Finally, because the Ooms model code uses fixed-step integration
routines, duplicate simulations should be made with different step sizes
varying by a factor of about 3 to 5 to ensure the numerical error is
sufficiently small.
The Ooms model portion of the calculation is terminated when
^
(c/c ) = 0.1 at ground level, and the output from the Ooms model is useri
to establish the initial conditions for DEGADIS. In DEGADIS, the source,
^ :—
concentration is set to c , and the source radius is set to v2b^ .
Because the Ooms model calculation is stopped when (c/c ) = 0.1 at
ground level, the jet x-direction momentum may still be significant.
Because DEGADIS describes low initial momentum releases, care should be
taken that the jet x-direction momentum is no longer significant. For
cases when the jet x-direction momentum is not significant when
"k
(c/c ) = 0.1 at ground level, the method of first-order lines has been
proposed to account for the ground interaction (Dodge et al. , 1982).
This has not been implemented since the maximum concentration as a
function of distance may increase over the region of ground interaction
for this method (which is physically impossible).
-------
II. MODEL INPUTS
As implemented under VAX/VMS, the Ooms/DEGADIS models use three
areas of input information:
« VAX/VMS command procedure for execution
• simulation definition
• numerical parameters.
The VAX/VMS command procedure used to execute Ooms/DEGADIS is generated
by OOMS_IN. As well, OOMS_IN is the input module which reads the
simulation definition. An example input session is included in Section
IV. The numerical parameters (convergence criteria, initial increments,
etc.) are supplied to DEGADIS though a series of input files. Although
these numerical parameters are easily changed, the user should need to
change these only rarely with the exception of the time-sort parameters
which are explained in Section IV.
VAX/VMS Command Procedure
The VAX/VMS command procedure generated by OOMS_IN controls the
execution of images for the simulation. Image execution follows one of
two paths, either for a transient (time-limited) release or for a
steady-state release. OOMS_IN will automatically generate the
appropriate command procedure; but first, OOMS_IN requires a simulation
name be specified. The simulation name must be a valid VAX/VMS file
name without a file extension and is designated RUN_NAME. OOMS and
DEGADIS will use this file name with standard extensions for input,
interprocess communication, and output. Figures II.1 and II.2 show
example VAX/VMS command procedures for the run name TEST_S and TEST for
steady-state and transient releases, respectively. The directory which
contains the executable images of the Ooms model and DEGADIS has been
assigned the system logical name SYS$DEGADIS (see Appendix A). The
COPY/LOG command simply copies a file from the first argument to the
second argument, and the RUN command executes the specified image. Of
course, these steps may also be carried out by issuing the commands at a
terminal.
-------
10
$ ASSIGN TEST_S.INO FOR001
$ ASSIGN TEST_S.OUT FOR003
$ ASSIGN TEST_S.IND FOR002
$ RUN SYS$DEGADIS:OOMS
$ DEASSIGN FOR001
$ DEASSIGN FORGO2
$ DEASSIGN FOR003
$ RUN SYS$DEGADIS:DEGBRIDGE
$ TEST_S
$ COPY/LOG SYS$DEGADIS:EXAMPLE.ER1 TEST_S.ER1
$ COPY/LOG SYS$DEGADIS:EXAMPLE.ER2 TEST_S.ER2
$ RUN SYS$DEGADIS:DEGADIS1
TEST_S
$ RUN SYS$DEGADIS:SDEGADIS2
TEST_S
$ COPY/LOG TEST_S.OUT+TEST_S.SCL+TEST_S.SR3 -
TEST S.LIS
Figure II.1. Example DEGADIS command procedure on VAX/VMS
for a steady-state simulation named TEST_S.
$ ASSIGN TEST.INO FOR001
$ ASSIGN TEST.OUT FOR003
$ ASSIGN TEST.IND FOR002
$ RUN SYS$DEGADIS:OOMS
$ DEASSIGN FOR001
$ DEASSIGN FOR002
$ DEASSIGN FOR003
$ RUN SYS$SYSDEGADIS:DEGBRIDGE
TEST
$ COPY/LOG SYS$DEGADIS:EXAMPLE.ER1 TEST.ER1
$ COPY/LOG SYS$DEGADIS:EXAMPLE.ER2 TEST.ER2
$ COPY/LOG SYS$DEGADIS:EXAMPLE.ER3 TEST.ER3
$ RUN SYS$DEGADIS:DEGADIS1
TEST
$ RUN SYS$DEGADIS:DEGADIS2
TEST
$ RUN SYS$DEGADIS:DEGADIS3
TEST
$ COPY/LOG TEST.OUT+TEST.SCL+TEST.SR3 -
TEST.LIS
Figure II. 2. Example DEGADIS command procedure on VAX/VMS
for a transient simulation named TEST.
-------
11
Simulation Definition
OOMS_IN is a method of simulation definition where the user
specifies information about the ambient wind field, the properties of
the released gas, and some details of the release.
The input is carried out using free-formatted files. The use of
this method means that a value of each parameter must be specified in
the input file even if it has no meaning for the simulation at hand. As
well, this form of input allows the user creating the input file to be
able to ignore spacing in the input file. Numbers on a particular line
can be separated by commas, spaces, or tabs. Comments may also be
included at the end of any line in the input file as long as all
required values are given before any comments are included. Lines which
are only comments are not allowed. (Sample input files are included in
Section IV.)
The ambient wind field is characterized by a known velocity UQ at a
given height ZQ, a surface roughness z^, and the Pasquill stability
class or Monin-Obukhov length. The Pasquill stability class is used to
estimate values of the lateral similarity parameter coefficients 5 and ,3
(along with the averaging time as discussed in Spicer and Havens, 1987)
and values of the along-wind similarity coefficients (Beals, 1971). The
Monin-Obukhov length A used by Businger et al. (1971) in their loga-
rithmic velocity profile function V" (Table II.1) is used to calculate
the friction velocity u*. In addition to these specifications, the
ambient temperature, pressure, and humidity must be specified.
The properties of air and the released gas are used to evaluate the
mixture density as a function of temperature and composition. The
desired released gas properties include the molecular weight MWC, the
release temperature TQ , and two constants q^ and p-^ which describe the
heat capacity according to the equation
(MV
-1
3.33 x 10 + q
T - T,
(II.1)
-------
CO
H
Z
Ed
2
O
cu
X
Ed
•2
^
*J CO
Ed
S3 M
Ed H
3 M
O J
Cu 1-1
Q <
Z H
< CO
CO U
-H H OS
• O Ed
W Z E
M Ed 0.
J CO
Ed O
-I > 2
« O H
< E <
3 H
a z
O Ed
1 S3
Z Ed
r— t Lt4
Z fa
O t-t
s o
Ed OS
> O
r""* E— ^
^
H
Z
Ed
CO
Ed
CU
Ed
03
tn n
a r-
cr\
tn iH
CD —
O -H
•U -H U
M-l 0)
cn o Cn
CMC
O & -4
••-i tn
-u U 3
o -H a
0 -4
U M C
IB 0)
Cn >
O -H
>4 CJ
a
tn
.u
c
•— • CO
* c
~ o
a
•H X
(B H
U
•H 3
Cj "3
£-(
1-1
0)
o
G4
tn
01
OJ
c
> tn j=
O (B C Cn
J= O 3
X ,-~-H O
ja — o "s
O C 03 —
1 £ 3 U OS
C -U Cu (B N
•H cn ,>,
r-i -y u
••H -^ O
3 -H cn
tn .a -u
GJ J-> CJ
1
* CN
C
•f
1 ]
+ H
CN
II
•3-
C3
O
i— 1
O
O
iH
C3 CSJ
N
T
•
iH
iH
1
<
rH
^
CN tn
\j
f— t
1
•H
^ . it
^^ n
r-H *— *.
1 (B •<
C \
4J 4J ^*
•H r-
CN 3
1 0 1
II II
•3- -3-
CN o CN m n
.H CN •* o in
rH i-l ,-! CN CN
O O O O O
t-»
iH o r-
m o .H
^3 0^ • fO •
t4 ^3 0^ « ^5 C«
N 8 0 CS H
0 N
• f*1 O
VO ^1 CO •
CN r-l CN VO
II ^H CN
co u o w &•<
£
i— i
0
o
•
o
H-l
0
tn
tn
0)
C
"en
3
O
J-J
5)
O
n3
l-i
3
tn
5
•iH
3
£
a
•-!
4J
(^
tn
£
CO
l-i
0
iw
-------
13
where C (T) is the mean heat capacity (J/kg K) at temperature T. A
Pc
constant heat capacity can also be specified as discussed later in
this section.
In specifying the details of the release, the user must choose to
simulate the release as time-limited (transient) or steady-state. As
well, the jet elevation, diameter, and orientation must be specified.
Figure II.3 summarizes the structure of the input file RUN_NAME.IN
needed by OOMS_IN. The following description is written for each of the
variables in Figure II.3. Variables are written in brackets. After
each line of input, an explanation is included. All units are SI
(meters, kilograms, second) except as specified.
Figure 11. 3. RUN_NAME.IN structure required by
OOMS IN.
-------
i;
Each of , , , and are used
to keep a title block with the output of the raodel(s). Each
are up to 80 characters long.
is the ambient wind velocity at .
is the surface roughness.
This line is used to specify the ambient velocity profile.
is the indicator used to specify whether the
ambient velocity profile is based on:
(1) the Pasquill stability category in using 1
for A, 2 for B, etc.; or
(2) the Monin-Obukhov length in (as a real
number). If a Monin-Obukhov length of infinity is
desired, input a value of 0.0 for .
Note that the Pasquill stability category must be specified
(regardless of ) since is used to estimate
other parameters.
This line specifies the ambient air temperature ( in
y
K), the ambient pressure ( in N/m or atm), and the
ambient relative humidity ( as a percent).
This line specifies the surface temperature (in K). If the
value of is below 250 K, is set to .
-------
15
is a user-generated 3-letter name used to
identify the dispersing gas.
is the gas molecular weight (kg/kmole).
is the averaging time to be used for this particul;
gas. At present, this parameter is used to estimate the
value of DELTA in DEGADIS.
is the temperature of the released gas jet (K).
and are the upper and lower limits (in mole
fraction) used for contour computations at the elevation
. Note that the computations will be carried out to
/2.
is used to determine whether heat transfer with the
ground is included in DEGADIS. Heat transfer is not
included when is set to zero but is included when
is nonzero. and are used to calculate
the gas heat capacity using the specification in DEGADIS as
a function of temperature. (If this function is used, the
average gas temperature is used to specify the mean
(constant) heat capacity in the Ooms model.) If a constant
contaminant heat capacity is desired, is set to 1.0
and is set to the desired heat capacity (in J/kg K).
-------
16
is the mass evolution rate of the pure contaminant
(in kg/s) .
is the initial jet elevation above ground level.
is the initial diameter of the jet.
is the duration of the release. For a steady-state
case, input 0.0 for . If the Ooms model is to be run
alone, input a negative number for .
is the starting value for the jet trajectory
integration. is the step size for the Ooms rr.odel .
is the downwind distance to the first output value.
is the distance between output points in the Ooms
model .
, , and are the parameters used to specify the
initial jet direction as follows:
is used for horizontal jets directed upwind (-1) and
downwind (1); =0 for other orientations.
is used for vertical jets directed upward (+1) and
downward (-1); =0 for other orientations.
is used for horizontal jets directed transverse to the
left (-1) and to the right (+1); =0 for other
orientations .
Note that only one of , , or can be nonzero at
any time.
-------
17
Appendix G contains program listings for OOMS_IN and DEGBRIDGE.
(DEGBRIDGE takes the output from the Ooms model and creates the file
necessary for DEGADIS to complete the calculations as needed.)
-------
19
III. MODEL IMPLEMENTATION
The models described in Section I have been implemented in VAX/VMS
Fortran (a superset of Fortran 77) in the codes OOMS and DEGADIS.
DEGADIS is comprised of six separate programs as follows:
(*) DEGADISIN is the interactive input module which defines the
simulation.
(*) DEGADIS1 determines a and describes the gas source for
transient and steady-state releases.
(*) DEGADIS2 describes the pseudosteady-state downwind dispersion
of the released gas.
(*) DEGADIS3 sorts the results of DEGADIS2 for a transient
release at given times.
(*) DEGADIS4 sorts the results of DEGADIS2 for a transient
release at given positions.
(*) SDEGADIS2 describes the steady-state downwind dispersion of
the released gas.
As indicated in Figures II.1 and II. 2, a steady-state release is
simulated by executing OOMS, DEGADISIN, DEGADISl, and SDEGADIS2, while
time-limited (transient) release is simulated by executing OOMS,
DEGADISIN, DEGADISl, DEGADIS2, and DEGADIS3.
-------
21
IV. EXAMPLE SIMULATION
The example simulation conditions shown in Table IV.1 for the
accidental release of methylisocyanate (MIC) on December 3, 198&, in
Bhopal, India, were reported by Singh (1986). To simulate this release
the MIC was assumed to be released as a pure, ambient temperature gas a:
a steady rate of 6.72 kg/s. For the lowest concentration of interest,
the lethal concentrations to 50% of laboratory animals exposed to MIC
for one and two hours are about 30 and 20 ppm, respectively.
TABLE IV.1
EXAMPLE SIMULATION RELEASE CONDITIONS
Mass of MIC released 40 tons
Duration of release 90 min
Vent elevation 33 m
Vent diameter 0.2 m
Wind velocity at 10 m 2.9 m/s
Atmospheric stability E/F
The input file used to simulate the release conditions of Table IV.1
as a steady-state release is shown in Figure IV.1. Note that comments
can be included at the end of each line as long as the specified values
are entered on the line first; as well, comments can appear at the end
of the file after all values have been entered. A surface roughness of
O.lm has been used. (Note that the surface roughness should not be
larger than the depth of the denser-than-air gas layer in DEGADIS; for
this case, the value of Sz at the beginning of the steady-state DEGADIS
calculation was 33.8 m.) Also, an averaging time of 3600 s has been
used to correspond with the averaging time for the LC^Q; note that the
-------
concentrations of 30 ppm (GASULO.00003 mole fraction) and 20 ppm
(GASLL=0.00002 mole fraction) are to be used to calculate concentration
contours in DEGADIS. The fact that this is a steady-state simulation is
indicated by the value of TEND (0.0). Finally, the jet is assumed to be
oriented vertically upward since Kl, K2, and K3 are all set to 0.
Note that the Ooms/DEGADIS model can be executed interactively or in
batch mode. An example batch command file to run the model under VMS is
shown in Figure IV.2 for the example simulation called EXAMPLE. (The
logical symbol SYS$DEGADIS: is assigned to the directory which contains
the executable image of the model.) Note that any file name may be
used; the same file name will be used throughout the simulation with
different extensions for internal files used by the model. Upon
completion of the simulation, the output of the model is in the file
with the original name and extension LIS; for this example, the output
file will be EXAMPLE.LIS. To run the model interactively, the same
lines shown in Figure IV.2 should be entered at the terminal.
Several lines of output are written to the terminal during the
execution of the model. (In batch mode, the same lines are written to
the batch log file.) As discussed in Section II.1, the program
OOMS_IN reads the input file (EXAMPLE.IN in this case) and generates the
input file to the OOMS program; when OOMS_IN finishes, OOMS_IN writes
the line "OOMS_IN - beginning command file". At this point, the OOMS
program begins; several lines of output are generated showing the values
of various parameters calculated by the program. When OOMS finishes,
DEGBRIDGE begins; DEGBRIDGE writes the line "DEGBRIDGE - beginning
DEGBRIDGE". DEGBRIDGE takes the output of OOMS and generates the
necessary input file for DEGADIS. When DEGBRIDGE finishes, the standard
DEGADIS procedure begins with the copying of the ER1 and ER2 numerical
parameter files. DEGADIS generates several lines of output showing the
values of various numerical parameters calculated by the model. The
last step of the model is to generate the LIS file from the output files
of OOMS and DEGADIS.
For the example case above, the OOMS calculations are terminated at
540 m when the lower edge of the plume reaches ground level. At this
-------
23
* o •)
point, the centerline concentration (c ) is 2.83 x 10 kg/nr. From
this point, the DEGADIS calculation begins; the initial concentration
used in DEGADIS is taken to be 2.83 x 10"3 kg/m3 (from OOMS) and the
value of S at the downwind edge of the DEGADIS source is 33.8 m. The
output of DEGADIS for this example case shows the 30 ppm level reaches
5.76 km and the 20 ppm level reaches 7.22 km. Note that the downwind
distance used in DEGADIS is measured from the DEGADIS source.
Therefore, the distances predicted by the OOMS/DEGADIS model to the 30
and 20 ppm concentration levels for the example case are 6.30 km and
7.76 km, respectively. The complete output listing for this example
simulation can be found in Appendix J. Note that the "width at z=" to
some appropriate mole percent value actually refers to the distance to
that isopleth concentration from the plume centerline (i.e., half-width).
The OOMS code can be run (without DEGADIS) using OOMSIN by specifying
a TEND which is less than zero. For this case, the input file is
identical to the example case shown in Figure IV.1 except that TEND is set
equal to -1. As before, the OOMS calculations are terminated at 540 m
when the boundary of the cloud first reaches ground level.
Simulation of the release of an impure dense gas can be performed by
adjusting the molecular weight and heat capacity inputs to the program.
The molecular weight should be the equivalent molecular weight of the
mixture at the release point, and the heat capacity inputs should be those
of the initial mixture. Concentration (mole fraction) values output by
the program should then be multiplied by the initial mole fraction of
contaminant in the released mixture to obtain actual mole fraction values.
-------
24
This is 3 steady-state test simulation of the OOMS and DEGADIS models.
Methylisocyanate (MIC) release
1. 50,
2,? 10,
0.1
1 6 0
293.
298.
MIC
57.
3600.
298.
0.00003
0 2000.
6.72
33. 0.2
0.0
1. 1. 10. 10.
000
0.00002 0.5
1.
uo» zo
ZR
INDVEL» ISTABj MOLEN
TAMBr PAMB, RELHUM
TSURF
GASNAM
GASMW
AVTIM - based on 1 hr toxic level;
JETTEM
GASUL» GASLLi ZLL
INDHT» CPCr CFP
ERATE
JETELEr JETDIA
TEND
XOr Hf DISTAj DISTAN
Kli K2> K3
Since ONLY one of K2> or K3> MUST be nonzero* OOMS_IN checks these vslue:
to ensure thst these conditions sre met. If they are not met? OOMS.IK forces
one of -CK1» K2» or K3> to be 15 if all are zero> the Jet is assuaed to be
oriented vertically upward.
This is the end of the file. Ana comments can be included here since the
file is not read after the line for Kl et si. above has been read.
Figure IV.1. Listing of EXAMPLE.IN.
$RUN SYS$DEGADIS:OOMS_IN
EXAMPLE
Figure IV.2. Example command file used to
simulate the EXAMPLE simulation.
-------
REFERENCES
Albertson, M. L. , Y. B. Dai, R. A. Jenson, and H. Rouse, "Diffusion of
Submerged Jets," Transactions of American Society of Civil
Engineers, 115. (1950).
Beals, G. A., "A Guide to Local Dispersion of Air Pollutants," Air
Weather Service Technical Report 214, April 1971.
Briggs, G. A., "Plume Rise," AEG Critical Review Series," USAEC Division
of Technical Information Extension, Oak Ridge, Tennessee, 1969.
Businger, J. A., J. C. Wyngaard, Y. Izumi, and E. F. Bradley, "Flux-
Profile Relationships in the Atmospheric Surface Layer," Journal of
the Atmospheric Sciences. 28. March 1971.
Colenbrander, G. W., "A Mathematical Model for the Transient Behavior of
Dense Vapor Clouds," 3rd International Symposium on Loss Prevention
and Safety Promotion in the Process Industries, Basel, Switzerland,
1980.
Colenbrander, G. W. and J. S. Puttock, "Dense Gas Dispersion Behavior:
Experimental Observations and Model -Developments," International
Symposium on Loss Prevention and Safety Promotion in the Process
Industries, Harrogate, England, September 1983.
Havens, J. A. and T. 0. Spicer, "Development of an Atmospheric
Dispersion Model for Heavier-than-Air Gas Mixtures," Final Report
to U.S. Coast Guard, CG-D-23-80, USCG HQ, Washington, DC, May 1985.
Kaimal, J. C., J. C. Wyngaard, D. A. Haugen, 0. R. Cote, and Y. Izumi,
"Turbulence Structure in the Convective Boundary Layer," J. Atmos.
Sci., 33, 1976.
Kamotani, Yasuhiro and Isaac Greber, "Experiments on a Turbulent Jet in
a Cross Flow," AIAA Journal, Vol. 10, No. 11, November 1972.
Ooms, G., A. P. Mahieu, and F. Zelis, "The Plume Path of Vent Gases
Heavier than Air," First International Symposium on Loss Prevention
and Safety Promotion in the Process Industries, (C. H. Buschman,
Editor), Elsevier Press, 1974.
Richards, J. M., "Experiments on the Motion of an Isolated Cylindrical
Thermal through Unstratified Surroundings," International Journal
of Air and Water Pollution, 1_, 1963.
-------
Singh, N. P., presented at G. I. Taylor Centennial Symposium, Cambridge
University, England, March 1986.
Spicer, T. 0. and J. A. Havens, "Development of Vapor Dispersion Models
for Nonneutrally Buoyant Gas Mixtures --Analysis of TFI/NH-j Test
Data," USAF Engineering and Services Laboratory, Draft Final
Report, October 1987.
van Ulden, A. P., "A New Bulk Model for Dense Gas Dispersion: Two-
Dimensional Spread in Still Air," I.U.T.A.M. Symposium on
Atmospheric Dispersion of Heavy Gases and Small Particles. Delft
University of Technology, The Netherlands, August 29-September 2.
1983.
-------
A-l
APPENDIX A
INSTALLATION ON VAX/VMS
DEGADIS was developed under VAX/VMS V3.5 and VAX-11 Fortran V3.5
although there should be no installation difficulty for VAX/VMS V4.0 or
later.
The directory which contains the Fortran source code for DEGADIS
must be equivalenced with the logical name SYS$DEGADIS:. If the full
directory specification is DQAO:[HAGS.DEGADIS], issue the VAX/VMS
command:
$ ASSIGN DQAO:[HAGS.DEGADIS] SYS$DEGADIS:
with either the /PROCESS, /GROUP, or /SYSTEM qualifier (/SYSTEM is
recommended). Once this assignment is made, the files must be compiled
and linked to form DEGADISIN, DEGADIS1, DEGADIS2, DEGADIS3, DEGADIS4,
and SDEGADIS2 according to the specifications in Appendix C. The
process which compiles and links DEGADIS must have READ, WRITE, and
EXECUTE access privileges to SYS$DEGADIS while only READ and EXECUTE
access privileges are needed to execute the existing models.
The process for compilation and linking on the VAX is provided in the
batch file BUILD.COM. To execute, SUBMIT this file to the batch queue on
the VAX computer. The resulting files will be executable according to the
instructions in section II of this User's Guide.
-------
B-l
APPENDIX B
CONSIDERATIONS FOR INSTALLATION OTHER
THAN VAX/VMS
There are two types of problems which may occur when attempting to
install DEGADIS on a different computer or operating system. The first
source of difficulty is the use of non-standard ANSI Fortran 77 language
elements. The second source of difficulty is the use of external
VAX/VMS routines in DEGADIS.
The following list is a collection of the VAX-11 Fortran extensions
which have been used in DEGADIS:
(*) In-line comments--An exclamation mark (!) is used to include
comments at the end of a valid statement.
(*) Special characters--The underscore (_) is used in variable
names.
(*) DO loops--DO loops are used with the structure:
DO v = el,e2[,e3]
END DO
where v is a variable name and el, e2, and e3 are numeric
expressions. The numeric expressions have the standard Fortran
77 meaning.
(*) INCLUDE statements--INCLUDE statements simply allow other
source files to be inserted in the routine being compiled at
this point in the source. The system table '($SSDEF)' is used
to check the status of returning system routines.
(*) OPEN keyword NAME--The OPEN keyword NAME specifies the file
name to be opened.
-------
(*) Fortran descriptors--The Q descriptor obtains the integer
number of characters remaining in the input record during a
READ operation. The dollar sign ($) descriptor suppresses the
carriage return at the end of a line on output.
(*) Continuation lines--Continuation lines have been expressed by
using either a nonblank character in column 6 or by beginning
the line with a tab and a number in the next column.
(*) Concatenation of character strings--Character strings are
concatenated using two slashes (//).
The following VAX/VMS subroutines have been used in DEGADIS:
(*) SECNDS
TIME = SECNDS(TIMED)
SECNDS returns to TIME the difference between the number of
seconds after midnight on the system clock and the value of
TIMEO.
(*) LIB$DATE_TIME
ISTAT = LIB$DATE_TIME (STRING)
LIB$DATE_TIME returns a 24-character ASCII string with the
system date and time. ISTAT is an integer variable which
accepts the return status.
(*) LIB$DO_COMMAND
ISTAT = LIB$DO_COMMAND (STRING)
LIB$DO_COMMAND issues the command STRING (a character string)
to VAX/VMS. If the command is not issued, ISTAT contains the
failure code. If the command is issued, the calling process is
terminated.
-------
C-l
APPENDIX C
DEGADIS IMPLEMENTATION
DEGADIS has been implemented in VAX/VMS Fortran (a superset of
Fortran 77). DEGADIS is comprised of six separate programs as follows1
(*) DEGADISIN is the interactive input module which defines the
simulation.
(*) DEGADIS1 determines a and describes the gas source for
transient and steady-state releases.
(*) DEGADIS2 describes the pseudosteady-state downwind dispersion
of the released gas.
(*) DEGADIS3 sorts the results of DEGADIS2 for a transient release
for specified times.
(*) DEGADIS4 sorts the results of DEGADIS2 for a transient release
for specified positions.
(*) SDEGADIS2 describes the steady-state downwind dispersion of the
released gas.
As indicated in Figures II.1 and II.2, a steady-state release is
simulated by executing DEGADISIN, DEGADIS1, and SDEGADIS2, while a
transient release is simulated by executing DEGADISIN, DEGADISl,
DEGADIS2, and DEGADIS3 (and DEGADIS4 as desired).
-------
C-2
Input Module--DEGADISIN
DEGADISIN is the interactive input module which defines the
simulation; DEGADISIN is composed of two subroutines (Figure C.I):
(*) DEGADISIN contains the program overhead and generates the
command file RUN_NAME.COM which can be used to
control simulation execution (F-38).
(*) IOT
contains the interactive question-and-answer sequence
which defines the simulation; IOT also creates the
file RUN NAME.INP (F-75).
An example of a DEGADISIN query sequence is included in Appendix D. As
this information is gathered, it is written to the file RUN_NAME.INP.
Once DEGADISIN is completed, RUN_NAME. INP may be edited to correct r.rlnor
input mistakes. If major revisions are necessary, the recommended
practice is to execute DEGADISIN again.
Once the information required by DEGADISIN has been entered
properly, DEGADIS may be executed using the command procedure generated
by DEGADISIN under the file name RUN_NAME.COM. If DEGADIS is not to be
run using this command file, the user must enter the simulation name
(RUN_NAME) after each of the programs are begun. As well, the user must
provide copies of the numerical parameter files.
DEGADISIN
F-38
IOT
F-75
Figure C.I. DEGADISIN flowchart.
-------
C-3
If (ISOFI>0) then
(for
external density •
calculations)
NT of these
for steady-state
only
TITLE(l)
TITLE(2)
TITLE(3)
TITLE(4)
UO, ZO, ZR
I STAB
DELTA, BETA,
ML
SIGX_COEFF, SIGX_POW, SIGX_MIN_DIST
TAMB, PAMB, HUMID
ISOFL, TSURF
IHTFL, HTCO
IWTFL, WTCO
GAS_NAME
GAS_MW, GASJTEMP, GAS_RHOE
GAS_CPK, GAS_CPP
GAS_UFL, GAS_LFL, GAS_ZSP
NP
DEN((J,1),J=1,5)
DEN((J,2),J=1,5)
DEN((J,NP),J=1,5)
CCLOW
GMASSO
NT
PTIME(l),ET(1),R1T(1),PWC(1),PTEMP(1),PFRACV(1)
PTIME(2),ET(2),R1T(2),PWC(2),PTEMP(2),PFRACV(2)
PTIME(NT),ET(NT),R1T(NT),PWC(NT),PTEMP(NT),PFRACV(NT)
CHECK1, CHECK2, AGAIN, CHECKS, CHECK4, CHECKS
TINP
ESS, SLEN, SWID
Figure C.2. Structure for free-formatted RUN_NAME.INP file.
Source Module--DEGADIS1
DEGADIS1 estimates values for the friction velocity and ambient wind
profile power a and characterizes the primary gas source for the
remainder of the model; DEGADIS1 is composed of the following
subroutines (Figure C.3):
-------
C-4
DFGAHTS 1
F-13
AFGEN
F-3
GAMMA
F-58
RIPHIF
F-108
DLT1 CT
F-lll
SURFACE
F-180
TPROP
F-184
TRAP
F-207
A TT C 17 \T 9
F-4
TO
F-73
ESTRT1
F-49
AT PH
F-5
SZF
F-182
bRCI
F-140
NOBL
F-92
CRFG
F-8
HF AH
F-63
IRAN Si
F-199
1 RTMI
F-119
PSIF
F-98
Figure C.3. DEGADIS1 flowchart,
-------
C-5
(*) AFGEN
is a utility which linearly interpolates between a
pair of points based on a list of supplied values
(F-3).
(*) AFGEN2
is a utility which linearly interpolates between a
pair of points based on a list of supplied values
(F-4).
(*) ALPH
estimates the ambient wind profile power a by
minimizing the integral of the difference between an
ambient logarithmic velocity profile and the assumed
power law velocity profile (F-5).
(*) CRFG
creates a table of calculated values which will
describe the secondary gas source for the downwind
dispersion calculations (F-8).
(*) DEGADIS1
contains the program overhead and sequentially calls
the routines required to estimate the ambient wind
profile power a and to characterize the primary gas
source (F-14).
(*) ESTRT1
recovers the numerical parameters contained in the
file RUN_NAME.ER1 (F-49).
(*) GAMMA
is a utility function that calculates the gamma
function of the argument (i.e. F(x)) (F-58).
(*) HEAD
writes a formatted output heading to the file
RUN NAME.SCL (F-63).
(*) 10
recovers the simulation definition contained in
RUN NAME.INP (F-73).
-------
C-6
(*) NOBL
estimates gas source behavior when no gas blanket is
present (F-92).
(*) PSIF
calculates the ij> function in the logarithmic velocity
profile (F-98).
(*) RIPHIF
is a series of utilities which calculates the
Richardson number and the value of ^(Ri) (F-108).
(*) RKGST
is a utility routine which performs numerical
integration of a specified system of equations using
a variable - step, modified fourth-order Runge-Kutta
method (F-lll).
(*) RTMI
is a utility routine which solves the roots of an
equation by the Milne method set up by ALPH (F-119)
(*) SRC1
contains the ordinary differential equations which
describe the gas blanket formed as a result of the
primary gas source (F-140).
(*) SURFACE
is a utility routine which estimates heat and water
transfer rates across the bottom surface of the gas
layer (F-180).
(*) SZF
estimates the value of S2 if the primary source can
just form a gas blanket over the source (F-182).
(*) TPROP
is a series of utility routines which estimate the
thermodynamic properties of a given gas mixture
(F-184).
(*) TRANS1
writes the information to continue the next
simulation step to the file RUN_NAME.TR2 (F-199).
-------
07
(*) TRAP
is a utility included for program diagnostics
(F-207).
As input, DEGADIS1 requires two files:
(*) RUN_NAME.ER1
contains various numerical parameters.
For most simulations, a copy of the
SYS$DEGADIS:EXAMPLE.ER1 file will be adequate. (See
Figure II.1 or II.2.) A copy of
SYS$DEGADIS:EXAMPLE.ER1 is included in Figure C.4.
(*) RUN_NAME.INP
contains the simulation definition as discussed in
Appendix D. The format of RUN_NAME.INP is shown in
Figure C.2.
As output, DEGADIS1 generates the following files:
(*) RUN NAME.SCD
contains the calculated values which describe the
secondary gas source. It is generated by SRC1 and
NOEL and is then read by CRFG; it is a temporary
file.
(*) RUN NAME.SCL
is the listed output which describes the input
information for the simulation and the calculated
secondary gas source. It is written by HEAD and
CRFG.
(*) RUN NAME.TR2
contains the information to continue the next
simulation step.
-------
C-8
IThis is en example of how to set UP and use the run parameter
lines start with an exclamation markC1)
The only restrictions for dsts input are
input files. Comment
in the first column.
35 follows.'
1) The data must be entered in the same order
all of the time,
2) Only the number must be between columns 10 and 20,
3) Always include the decimal point in the number
! Column layout;
!23456739012345678901234567890
i j 2 3
I
STPIN
ERBND
STPMX
UTRG
WTTM
WTYA
WTYC
WTEB
WTmB
WTuh
XL I
XRI
EPS
ZLOW
i
STPINZ
1
ERBNDZ
0.01
0.0025
5.12
1,
1,
1,
1,
1,
1.
1,
0.05
0.40
0.001
0.01
-0.02
0,005
MAIN
MAIN
MAIN
MAIN
MAIN
MAIN
MAIN
MAIN
MAIN
MAIN
ALPH
ALPH
ALPH
ALPHI
ALPHI
ALPHI
- RKGST
- RKGST
- RKGST
- RKGST
- RKGST
- RKGST
- RKGST
- RKGST
- RKGST
- RKGST
- LOWER
- UPPER
- ERROR
- maxii
- INIT:
- ERROI
INITIAL STEP SIZE
ERROR BOUND
MAXIMUM STEP SIZE
WEIGHT FOR RG
WEIGHT FOR Total Mass
WEIGHT FOR ya
WEIGHT FOR yc
WEIGHT FOR Energy Balance
WEIGHT FOR Momentum Balance
WEIGHT FOR Ueff*Heff
LOWER LIMIT OF SEARCH FOR ALPHA
UPPER LIMIT OF SEARCH FOR ALPHA
ERROR BOUND USED BY 'RTMI1
maximum BOTTOM HEIGHT FOR FIT OF ALPHA
i
STPMXZ
i
! Note
I
SRCOER
SRCSS
SRCcut
htcut
ERNOBL
NOBLPT
j
i
crfger
-0,04 ALPHI - MAXIMUM STEP FOR RK6ST «K
that comment lines can be mixed with the numbers,
0,007
5.2
,00001
,0
1,0005
100,
0,008
i
epsilon 0,59
CON/
1.15
i
! /SPRB
i
ce
SRC10 - OUTPUT Error criterion
SRC10 - min time for Steady? STPMX
SRC10 - min height for blanket
SRC1 - min height for blanket heat transfer
NOBL - CONVERGENCE ratio
NOBL - NUMBER OF POINTS
USED ON THE LAST PORTION OF THE SOURCE
error criterion in building GEN3 vectors
epsilon USED IN AIR ENTRAINMENT SPECIFICATION
constant in gravity slumping eoustion
Figure C.4. SYS$DEGADIS:EXAMPLE.ERl listing.
-------
r-9
delrhcmin 0.025
stop cloud spread if delrho l)l/(l-f=)» 2)1
ALPHI - Value for slphs if IALPFL = 0
/PHIcorn/
I
iphifl
del laa
i
i
PHIF - celc flas
Raito of Hl/Heff
/VUcom/
vus
vub
vuc
vud
vudelts
i
! End-of-File
1.3
1.2
20,0
,64
0,20
Constant Av in source model
Constant Bv in source model
Constant Ev in source niodel
Constant Dv in source model
Constant DELTAv in source model
Figure C.4. (concluded)
-------
C-10
Pseudosteady-State Module --DEGADIS2
DEGADIS2 performs the downwind dispersion portion of the calculatio:
for each of several observers released successively over the transient
source described by DEGADIS1. (Note that the routines INCGAMMA, GAMMA.
and SERIES are linked in DEGADIS2 but never are called in DEGADIS2.)
DEGADIS2 is composed of the following subroutines (Figure C.5):
(*) AFGEN
is a utility which linearly interpolates between ;
pair of points based on a list of supplied values
(F-3).
(*) AFGEN2
is a utility which linearly interpolates between a
pair of points based on a list of supplied values
(F-4).
(*) DEGADIS2
contains the program overhead and sequentially calls
the routines to recover the information generated in
DEGADISl, recover the numerical parameter file
RUN_NAME.ER2, and perform the simulation (F-23).
(*) ESTRT2
(*) OB
(*) PSS
recovers the numerical parameters contained in the
file RUN_NAME.ER2, particularly the number of
observers NOBS (F-53).
contains the ordinary differential equations which
average the gas source for each observer (F-95).
contains the ordinary differential equations which
describe the portion of the downwind dispersion
calculation when b > 0 (F-99).
(*) PSSOUT
governs the output of calculated points to the file
RUN NAME.PSD when PSS is active (F-102).
-------
C-ll
DEGADIS2
F-22
AFGEN
F-3
AFGEN2
F-4
RIPHIF
F-108
RKGST
F-lll
SURFACE
F-180
TPROP
F-184
TRAP
F-207
TS
F-216
UIT
F-222
STRT2
F-173
ESTRT2
F-53
SSSUP
F-164
TUPF
F-217
OB
F-95
PSS
F-99
SSG
F-153
TRANS2
F-202
Figure C.5. DEGADIS2 flowchart,
PSSOUT
F-102
SSGOUT
F-156
-------
C-12
(*) RIPHIF
is a series of utilities which calculates the
Richardson number and the value of ?S(Ri) (F-108).
(*) RKGST
is a utility routine which performs numerical
integration of a specified system of equations using
a modified fourth-order Runge-Kutta method (F-lll).
(*) SSG
contains the ordinary differential equations which
describe the portion of the downwind dispersion
calculation when b - 0 (F-153).
(*) SSGOUT
governs the output of calculated points to the file
RUN NAME.PSD when SSG is active (F-156).
(*) SSSUP
is a supervisor routine which controls the averaging
of the source for each observer, the portion of the
downwind dispersion calculation when b > 0, and the
portion of the downwind dispersion calculation when
b - 0 (F-164).
(*) STRT2
recovers the information generated in DEGADIS1
contained in the file RUN NAME.TR2 (F-173).
(*) SURFACE
is a utility routine which estimates heat and water
transfer rates across the bottom surface of the gas
layer (F-180).
(*) TPROP
is a series of utility routines which estimate the
thermodynamic properties of a given gas mixture
(F-184).
(*) TRANS2
writes the information necessary for DEGADIS3 to the
file (RUN NAME.TR3) (F-202).
-------
C-13
(*) TRAP
is a utility included for program diagnostics
(F-207).
(*) TS
calculates the time when a given observer will be at
a given downwind distance (F-216).
(*) TUFF
contains the two routines which determine the
intersection of the upwind/downwind edge of the
secondary gas source with a given observer (F-217).
(*) UIT
is a series of routines to calculate observer
position and velocity as a function of time (F-222)
As input, DEGADIS2 requires two files:
(*) RUN NAME.ER2
contains the various numerical parameters,
particularly the number of observers NOBS. For most
simulations, a copy of the SYS$DEGADIS:EXAMPLE.ER2
file will be adequate. (See Figure II.1 or II.2.) A
copy of SYS$DEGADIS:EXAMPLE.ER2 is included in Figure
C.6.
(*) RUN_NAME.TR2 contains the basic simulation definition as well as
calculated secondary source parameters.
DEGADIS2 generates the following output files:
(*) RUN_NAME.OBS contains a summary of the source parameters for each
observer.
-------
C-14
! This is an example for an *ER2' run parameter file,
1 The seme rules apply ss for the 'ER1' files,
!23456789012345678901234567890
! These
i
* SYOER
ERRO
SZOER
UTAIO
WTQOO
WTSZO
* ERRP
* SMXP
* MTSZP
* WTSYP
* WTBEP
* WTDH
* ERRG
* SMXG
ERTDNF
ERTUPF
* WTRUH
* WTDHG
! These
i
STPO
* STPP
* ODLP
* ODLLP
* STPG
* ODLG
* ODLLG
i
— i
values are
0,0
0,005
0,01
1,0
1,0
1,0
0,003
10,
1,0
1,0
1,0
1,0
0,003
10,
0,0005
0,0005
1,0
1,0
values sre
0.05
0.05
0.06
80.
0.05
0,045
80.
! The last variable
1
! Note:
it is read
in comoion area /ERROR/
SSSUP - RKGST - INITIAL SY
SSSUP - RKGST (OBS) - ERROR BOUND
SSSUP - RKGST(OBS) - INITIAL SZ
SSSUP - RKGST (OBS) - WEIGHT FOR A I
SSSUP - RKGST (OBS) - WEIGHT FOR Q
SSSUP - RKGST (OBS) - WEIGHT FOR SZ
SSSUP - RKGST (PSS) - ERROR BOUND
SSSUP - RKGST (PSS) - MAXIMUM STEP
SSSUP - RKGST (PSS) - WEIGHT FOR SZ
SSSUP - RKGST (PSS) - WEIGHT FOR SY
SSSUP - RKGST(PSS) - WEIGHT FOR BEFF
SSSUP - RKGST(PSS) - WEIGHT FOR DH
SSSUP - RKGST (SSG) - ERROR BOUND
SSSUP - RKGST (SSG) - MAXIMUM STEP SIZE
TDNF - CONVERGENCE CRITERION
TUPF - CONVERGENCE CRITERION
SSSUP - RKGST(SSG) - WEIGHT FOR RUH
SSSUP - RKGST(SSG) - WEIGHT FOR DH
in common area /STP/
SSSUP - RKGST (OBS) - INITIAL STEP
SSSUP - RKGST (PSS) - INITIAL STEP
SSSUP - RKGST (PSS) - RELATIVE OUTPUT DELTA
SSSUP-RKGST(PSS)-MAXIMUM DISTANCE BETWEEN OUTPUTS(m)
SSSUP - RKGST(SSG) - INITIAL STEP
SSSUP - RKGST (SSG) - RELATIVE OUTPUT DELTA
SSSUP-RKGST(SSG)-MAXIMUM DISTANCE BETWEEN OUTPUTS(m)
NOBS is in /CNOBS/
in as a real value even though it is integer type
! in the pros ran.
i
NOBS
i
i
1
1 Fnrl-n-
30.
f-Filp
*used by steady-state simulation
Figure C.6. SYS$DEGADIS:EXAMPLE.ER2 listing.
-------
C-15
(*) RUN NAME.PSD
contains the calculated downwind dispersion
parameters for each observer. DEGADIS3 and DEGADIS-
sort this information to determine the downwind
concentration profiles as a function of position and
time.
(*) RUN_NAME . TR3
contains the simulation definition and the number of
each record type written to RUN_NAME. PSD .
Time Sort Modules--DEGADIS3 and DEGADIS4
DEGADIS3 sorts the downwind dispersion calculation for each of
several observers for concentration information at several given times:
the along-wind dispersion correction is then applied as desired.
DEGADIS3 uses the following subroutines (Figure C.7).
(*) DEGADIS3
contains the program overhead and sequentially calls
the routines to recover the information generated in
DEGADIS2, recover the numerical parameter file
RUN_NAME.ER3, sort and apply the along-wind
dispersion correction to the results of DEGADIS2, and
output the results (F-28).
(*) ESTRT3
recovers the numerical parameters contained in the
file RUN_NAME.ER3, particularly the time sort
parameters (F-57).
(*) GAMMA
is a utility function that calculates the gamma
function of the argument (i.e. F(x)) (F-58).
(*) GETTIM
sets the default time sort parameters as needed
(F-60).
(*) INCGAMMA
is a utility function that calculates the incomplete
gamma function of the two arguments (F-69).
-------
C-16
nrr ADT c; ^
F-27
TPROP
F-184
TRAP
F-207
TS
F-216
INCGAMMA
F-69
GAMMA
F-58
SERIES
F-131
STRT3
F-178
ESTRT3
F-57
SORTS
F-132
GETTIM
F-60
SORTS 1
F-135
SRTOUT
F-149
TRANS 3
F-206
Figure C.7. DEGADIS3 flowchart.
-------
C-17
(*) SERIES
evaluates a series needed to estimate the mass of gas
above a given concentration level (F-131).
(*) SORTS
recovers the information in RUN_NAME.PSD and arranges
the information according to the time sort parameters
in the file RUN NAME.ER3 (F-132).
(*) SORTS1
applies the along-wind dispersion correction to the
time-sorted information (F-135).
(*) SRTOUT
generates the formatted output file RUN_NAME.SR3
(F-149).
(*) STRT3
recovers the information generated in DEGADIS2
contained in the file RUN NAME.TR3 (F-178).
(*) TPROP
is a series of utility routines which estimate the
thermodynamic properties of a given gas mixture
(F-184).
(*) TRANS3
writes RUN_NAME.TR4 which contains the necessary
information to recover the other output files for
this simulation (F-206).
(*) TRAP
is a utility included for program diagnostics
(F-207).
(*) TS
calculates the time when a given observer will be at
a given downwind distance (F-216) .
-------
C-18
As input, DEGADIS3 requires three files:
(*) RUN NAME.ER3
contains various numerical parameters including the
time sort parameters and the flag which dictates
whether the along-wind dispersion correction is
applied. A copy of SYS$DEGADIS:EXAMPLE.ER3 file uses
the default time sort parameters and includes the
along-wind dispersion correction which should apply
for most simulations. (See Figure II.2.) A copy of
SYS$DEGADIS:EXAMPLE.ER3 is included in Figure C.8.
(*) RUN NAME.PSD
contains the calculated downwind dispersion
parameters for each observer. DEGADIS3 sorts this
information to determine the downwind concentration
profiles as a function of position at a given time.
(*) RUN_NAME.TR3 contains the number of each record type written to
RUN NAME.PSD as well as the simulation definition.
As output, DEGADIS3 generates two new files:
(*) RUN NAME.SR3
is the formatted output list of the time-sorted
concentration parameters. Concentration contours
generated for the specified upper and lower
flammability at the specified height entered in
DEGADISIN or OOMS_IN. An example is included in
Section IV.
ire
(*) RUN NAME.TR4
contains the necessary information to recover the
other output files to facilitate further processing.
-------
C-19
! This is an example for an "ER31 run parameter file.
! The same rules apply ss for the 'ER11 files,
i
!23456789012345678901234567890
i j 2 3
I
! These values are in common area /ERROR/
i
ERT1 20, FIRST SORT TIME
ERDT 5, SORT TIME DELTA
ERNTIM 20, NUMBER OF TIMES FOR THE SORT
i
! Notet ERNTIM is entered ss s real variable even though
! it is sn integer type variable in the program.
!
! The value of CHECK5 determines whether the above sort parameters
! are used. CHECK5 is initialized through the passed transfer
! files to .FALSE, CHECKS is set to .TRUE, if a real value of 1,
! is passed in this file,
i
CHECKS 0, USE THE DEFAULT TIME PARAMETERS
.'CHECKS 1. USE THE TIME PARAMETERS GIVEN ABOVE
j
i
sigx_flag 1. correction for ;:-direction dispersion is to be made
!sigx_flag 0. no correction for x-direction dispersion
i
i
j
! End-of-File
****
Figure C.8. SYS$DEGADIS:EXAMPLE.ER3 listing.
-------
C-20
DEGADIS4 sorts the downwind dispersion calculation for each of
several observers for concentration information at several given
positions; the along-wind dispersion correction is then applied as
desired. DEGADIS4 uses the following subroutines (Figure C.9):
(*) DEGADIS4
contains the program overhead and sequentially calls
the routines to recover the information generated in
DEGADIS2, recover the numerical parameter file
RUN_NAME.ER3, sort and apply the along-wind
dispersion correction to the results of DEGADIS2, and
output the results (F-33).
(*) DOSOUT
generates the formatted output file RUN_NAME.SR4
(F-44).
(*) ESTRT3
recovers the numerical parameters contained in the
file RUN_NAME.ER3, particularly whether the
x-direction dispersion correction is to be applied
(F-57).
(*) GAMMA
is a utility function that calculates the gamma
function of the argument (i.e. F(x)) (F-58).
(*) GETTIMDOS
sets the time sort parameters as required to output
the concentration time history at the desired
positions (F-62).
(*) INCGAMMA
is a utility function that calculates the incomplete
gamma function of the two arguments (F-69).
(*) SERIES
evaluates a series needed to estimate the mass of gas
above a given concentration level (F-131).
-------
C-21
DEGADIS4
F-32
TPROP
F-184
TRAP
F-207
TS
F-216
INCGAMMA
F-69
GAMMA
F-58
SERIES
F-131
STRT3
F-178
ESTRT3
F-57
SORTS
F-132
GETTIMDOS
F-62
SORTS1
F-135
DOSOUT
F-44
TRANS3
F-206
Figure C.9. DEGADIS4 flowchart.
-------
C-22
(*) SORTS
recovers the information in RUN_NAME.PSD and arranges
the information according to the time sort parameters
(F-132).
(*) SORTS1
applies the x-direction dispersion correction to the
time-sorted information (F-135).
(*) STRT3
recovers the information generated in DEGADIS2
contained in the file RUN NAME.TR3 (F-178).
(*) TPROP
is a series of utility routines which estimate the
thermodynamic properties of a given gas mixture
(F-184).
(*) TRANS3
writes RUN_NAME.TR4 which contains the necessary
information to recover the other output files for
this simulation (F-206).
(*) TRAP
is a utility included for program diagnostics
(F-207).
(*) TS
calculations the time when a given observer will be
at a given downwind distance (F-216).
As input, DEGADIS4 requires three files and input from the terminal:
(*) RUN NAME.ER3
contains the flag which dictates whether the
x-direction dispersion correction is applied. A copy
of SYS$DEGADIS:EXAMPLE.ER3 file includes the
x-direction dispersion correction which should apply
for most simulations. (See Figure II. 2.) A copy of
SYS$DEGADIS:EXAMPLE.ER3 is included in Figure C.8.
-------
C-23
(*) RUN_NAME.PSD
contains the calculated downwind dispersion
parameters for each observer. DEGADIS4 sorts this
information to determine the downwind concentration
time histories at the desired positions.
(*) RUN_NAME.TR3 contains the number of each record type written to
RUN NAME.PSD as well as the simulation definition.
(*) terminal
input
DEGADIS4 prompts the user for the file name to be
used for this run. In addition, DEGADIS4 requests
the number of downwind distances (JDOS). For each
downwind distance, DEGADIS4 asks for the
x-position (DOSDISX(I)). Four positions are allowed
for each downwind distance (DOSDISY(IJ,I) and
DOSDISZ(IJ,I) for IJ-1 to 4). If fewer than four
positions are desired, negative values are entered
for the first position which is not desired. A
summary of this input information is included in
Figure C.10. Note that the same information can be
put in a command file for batch processing. As well,
the same information can be put in a file which can
be associated with FOR005.DAT so that a file can be
used for input.
FOR 1=1 TO JDOS •
RUN_NAME
JDOS
DOSDISX(I)
'DOSDISY(l.I),DOSDISZ(1,I)
DOSDISY(2,I),DOSDISZ(2,I)
DOSDISY(3,I),DOSDISZ(3,I)
DOSDISY(4,I),DOSDISZ(4,I)
*Note that if fewer than four positions are desired, negative values
are entered for the first position which is not desired.
Figure C.10. Structure of input for DEGADIS.
-------
C-24
As output, DEGADIS4 generates two new files:
(*) RUN_NAME.SR4 is the formatted output list of the sorted
concentration time histories. An example is included
in Section IV.
(*) RUN_NAME.TR4 contains the necessary information to recover the
other output files to facilitate further processing.
Steady-State Module--SDEGADIS2
SDEGADIS2 is a simplification of DEGADIS2 which uses many of the
same subroutines. SDEGADIS2 performs the downwind dispersion portion of
the calculation for a steady-state source described by DEGADIS1.
SDEGADIS2 is composed of the following subroutines (Figure C.ll):
(*) AFGEN
is a utility which linearly interpolates between a
pair of points based on a list of supplied values
(F-3).
(*) GAMMA
is a utility function that calculates the gamma
function of the argument (i.e. F(x)) (F-58).
(*) ESTRT2SS
recovers a subset of the numerical parameters
contained in the file RUN_NAME.ER2 as indicated in
Figure C.6 (F-55).
(*) INCGAMMA
is a utility function that calculates the incomplete
gamma function of the two arguments (F-69).
(*) PSS
is the same subroutine used in DEGADIS2; it contains
the ordinary differential equations which describe
the downwind dispersion calculation when b > 0
(F-99).
-------
SDEGADIS2
F-123
AFGEN
F-3
RIPHIF
F-108
RKGST
F-lll
SURFACE
F-180
TPROP
F-184
TRAP
F-207
SSOUT
F-162
GAMMA
F-58
INCGAMMA
F-69
SERIES
F-131
STRT2SS
F-176
ESTRT2SS
F-55
PSS
F-99
SSG
F-153
TRANS2SS
F-204
PSSOUTSS
F-105
SSGOUTSS
F-159
Figure C.ll. SDEGADIS2 flowchart.
-------
026
(*) PSSOUTSS
governs the output of calculated points to the file
RUN NAME.SR3 when PSS is active (F-105).
(*) RIPHIF
is a series of utilities which calculates the
Richardson number and the value of 0(Ri) (F-108).
(*) RKGST
is a utility routine which performs numerical
integration of a specified system of equations using
a modified fourth-order Runge-Kutta method (F-lll).
(*) SDEGADIS2
contains the program overhead and sequentially calls
the routines to recover the information generated in
DEGADIS1, recover the numerical parameters file
RUN_NAME.ER2, and perform the steady-state simulation
(F-123).
(*) SERIES
evaluates a series needed to estimate the mass of gas
above a given concentration level (F-131).
(*) SSG
is the same subroutine used in DEGADIS2; it contains
the ordinary differential equations which describe
the downwind dispersion calculation when b = 0
(F-153).
(*) SSGOUT
governs the output of calculated points to the file
RUN NAME.SR3 when SSG is active (F-156).
(*) SSOUT
writes RUN_NAME.SR3 and calculates the concentration
contours (F-162).
(*) STRT2SS
recovers a subset of the information generated in
DEGADIS1 contained in the file RUN NAME.TR2 (F-176).
-------
C-27
(*) SURFACE
is a utility routine which estimates heat and water
transfer rates across the bottom surface of the gas
layer (F-180).
(*) TPROP
is a series of utility routines which estimate the
thermodynamic properties of a given gas mixture
(F-184)-.
(*) TRANS2SS
(*) TRAP
writes RUN_NAME.TR3 (F-204).
is a utility included for program diagnostics
(F-207).
As input, SDEGADIS2 requires two files:
(*) RUN NAME.ER2
contains various numerical parameters; the steady-
state simulation requires only part of these. For
most simulations, a copy of the
SYS$DEGADIS:EXAMPLE.ER2 file will be adequate.
See Figure II. 1. A copy of SYS$DEGADIS:EXAMPLE.ER2
is included in Figure C.6.
(*) RUN_NAME.TR2 contains the basic simulation definition as well as
calculated secondary source parameters; the steady-
state simulation requires only part of these.
-------
c-;
As output, SDEGADIS2 generates the following files:
(*) RUN NAME.SR3
is the formatted output list of the downwind
concentration parameters. Concentration contours are
generated for the specified upper and lower
flammability at the specified height entered in
DEGADISIN.
(*) RUN_NAME.TR3 contains the necessary information to recover the
other output files to facilitate further processing.
-------
D-l
APPENDIX D
DEGADIS EXAMPLE SIMULATION
In 1980, the U.S. Department of Energy sponsored at China Lake,
California, a series of nine LNG releases referred to as the Burro
series of experiments (Koopman et al., 1982). The release condition
(Table D.I) for the numerical examples in this Appendix are those of
Burro 9 which was modeled both as a steady-state and transient (time-
limited) release. As suggested by the Shell Maplin Sands LNG releases
(Blackmore et al., 1982), the liquid source diameter was determined
o
using a boiling rate of 0.085 kg/m for LNG on water.
TABLE D.I
SUMMARY OF BURRO 9 TEST CONDITIONS
USED IN EXAMPLE SIMULATIONS
Source Rate:
Source Radius:
Wind Speed:
Atmospheric Stability:
Monin-Obukhov Length:
Surface Roughness:
Air Temperature:
Atmospheric Humidity:
Surface Temperature:
130.0 kg/s
22.06 m
6.5 m/s at 8.0 m
C (Pasquill)
-140. m
2.05 x 10'4 m
35.4°C
12.5%
310K
-------
D-2
Example Input Sessions
The input procedures for simulation of the transient release
(RUN_NAME=BURR09) and the steady-state release (RUN_NAME=BURR09S) are
very similar. Therefore, only the specification of the source rate and
extent have been included for the transient release. In the point-by-
point discussion of the input procedure, note the following:
(*) A line terminator (normally a carriage return) must end every
line entered by the user.
(*) The file name specification RUN_NAME must satisfy system
restrictions.
(*) When DEGADISIN requests the user to choose an option, all
acceptable responses are a single character (capital or lower
case). The default responses are denoted by a capital letter
inside angle brackets (e.g. ). When applicable, a menu of
responses is included inside parentheses.
(*) For numerical responses, a comma, space, tab, or line
terminator (carriage return) may separate the numbers.
(*) When a file is used as input (i.e. for the density or transient
source input), DEGADISIN reads the same information from the
file which would be entered at the terminal in the same order
and in the same format.
-------
D-4
Notes on Steadv-State Simulation of BURRO9
fl) Begin the input procedure by execution of DEGADISIN.
©
©
©
©
©
The file name specification must follow system restrictions. The
DEGADIS model uses this file name along with various file
extensions for input and output.
The Title Block is used to carry any desired comments such as
information on the specification of certain parameters.
The wind field parameters include the wind velocity (m/s) at a
specified height (m) and the surface roughness (m).
The Pasquill stability class is used to generate estimates of
other atmospheric parameters which follow.
The averaging time is used to determine the value of S (DELTA) in
the lateral dispersion coefficient specification. Changes to the
values of S are calculated assuming that the effect of averaging
time only influences the lateral plume meander of a steady-state
release. Note that DEGADIS does not currently evaluate time-
averaged concentrations for time-limited releases.
The current settings of pertinent atmospheric parameters are
displayed in this list. If any of these are to be changed, the
first letter of the parameter to be changed is entered. Note that
the default--indicated by --is No for no changes.
The Monin-Obukhov length (Length in the list) is to be changed, so
L is entered in response to the prompt.
The list is redisplayed to verify the change and to request any
further changes. The (default) response of No causes the program
to go to the next question.
(iCi) The ambient temperature and pressure are entered.
11) DEGADISIN calculates the ambient air density for the given input
parameters.
-------
D-5
©
$ Km SYStDEGABISJBEGADISIN
DEnse GAs Dispersion Model input isodule.
Enter the sinulation nsae I [DIR2RUNNAHE BURRQ9S
INPUT MODULE — DEGADIS MODEL
^^^ mtmmmmmmmmmm
(V) Enter Title Block -- UP to 4 lines of SO character;
Tc stop* tape '//'
Steads-state siculation cf BURRO 9
//
ENTER WIND PARAMETERS - UO (B/S)» ZO (B)I and ZR(t)
UO — Kind velocity at reference height ZO
ZR ~ Surface RouShness
£,5>8.»2.05E-4
Enter the Pasauill stability class! (A,BiC»D>E»F) -'^ C
Enter the svera3in3 tisie (s) for estiaatinS DELTA! 0,
The values for the atmospheric paraueters are set as follows!
DELTA: o.i09o
BETA: 0,3940
rionin-Obukhov length I -9,3344 n
SiSts X Coefficient! 0,0200
SiSia X Power! 1,2200
Sisiua X Minimus Distance! 130.0000 a
Do aou wish to change any of these?
(NoiDeltaiBet3»Len3thjCoefficient»Po«erjMiniiu«) \N> L
Note; For infinityi ML = 0.0
Enter the desired Monin-ObuKhov length: (ti) -140,
The values for the atnospheric psraaseters are set ?s follows!
DELTA: 0.1090
BETA: 0.3940
Monin-Obukhov lenath! -140.0000 n
Si5aa X Coefficient: 0.0200
Si3ia X Power! 1,2200
Siasia X MiniBun Distance! 130,0000 m
Do you wish to change any of these?
(No>Delt3iBetsjLenathiCoefficient«Pcwer»rliniaua) \N.>
Enter the atbient tenperature(C) and pressure(sttt): 35,4)0.94
The ambient humidity can be entered as Relative or Absolute.
Enter either R or A :
Enter the relative humidity (ZK 12,5
Anbient Air density is 1.0720 KS/B*t3
-------
D-6
If the release is isothermal, respond "Y". A positive response
causes DEGADISIN to ask for a list of concentration, density, and
mole fraction points for the gas mixture. The default response is
negative.
If the release is simulated as adiabatic, the default negative
response is chosen. For inclusion of heat transfer effects, the
surface temperature and the method of calculating the heat
transfer coefficient must be specified.
Water transfer to the source blanket (if present) can be included
in the calculation.
Enter the three-letter designation of the diffusing gas. The
properties of LNG as methane, LPG as propane, and NH3 (ammonia)
are included among others.
A list of the properties for the specified gas (if available) is
given. If any of the parameters are to be changed, the first
letter of the parameter to be changed in the list is given to the
prompt. Here, the level at which the flammability contours are
calculated is changed from 0.5 m to 1.0 m.
The gas property list is displayed again. The default response is
no change.
The lowest concentration of interest is the concentration at which
the calculations are stopped.
-------
D-7
Is this an Isotherms! spill? \y or K>
jc heat transfer to be included in the calculations
Is water transfer to be included in the source
Enter the code nase of the diffusing species! LNG
The characteristics for the gss sre set as follows!
Molecular weifiht! 16,04
Storage temperature EMJ 111,70
Density at storage tespersture> F'AHB Ckg/BW3]! 1.6845
Mean Heat capacity constant 5.60000E-08
Mean Heat cs?scity power 5.0000
Upper FlssBiebility Liait Ciaole fracJ 0,15000
Lower Flasasbility Liait [sole free] 5.00000E-02
Height of Flaesability Litit Co] 0.50000
Do you wish to change any of these? (Nojriole»TeGPiDen»Hest»PoHer»u>per>LoHeriZ} per FlsMsbilita Liait Eoole frac] 0.15000
Lower Fleatability Liisit Caole fracJ 5.00000E-02
Height of FlaiBcbility Licdt Co3 1.0000
Do you wish to change any of these? (NojMoleiTempjDeruHeatjPower'UpperiLowerjZ) \N>
The suggested LOWEST CONCENTRATION OF INTEREST (gas_lfl/2.)
is 1.52452E-02 Rg/B«3, Enter the desired value! 0.015
-------
The BURR09 case is for a release of "pure" (undiluted) LNG. For
diluted releases, DEGADIS requires the mass fraction of the
contaminant and the mixture temperature.
If a steady-state release is to be simulated, type "Y" to the
prompt. For a steady simulation, the steady-state mass evolution
rate (kg/s) and primary source extent (m) are required.
A note about the numerical parameter files is included. These
files contain various constant values used in the programs to
which the user has access without recompiling the programs.
Access is granted as a convenience.
DEGADISIN will generate a command procedure suitable for running
the model under VMS.
If so desired, DEGADISIN will initiate the command procedure unde:
VMS. If not, the program returns to the operating system.
-------
D-9
Specification of source paraseters,
Is this 3 release of pure (P) or diluted (d) material specified stove? ;P or
Is this s Stesda state siaulstion?
The coBBsnd file will be Generated under the file nerael
BURR09S.COB
Do aou wish to initiate this procedure?
$
-------
D-10
Notes on Transient Simulation of BURRO9
Beginning with the specification of the source rate and extent, the
responses to all of the previous questions except the simulation name
(RUN NAME) are the same for the steady-state case and are not repeated.
The BURR09 case is for a release of "pure" (undiluted) LNG. For
diluted releases, DEGADIS requires the mass fraction of the
contaminant and the mixture temperature.
20j The default response is for a transient release.
(21J An initial mass of gas can be specified over the source. This can
be used to model aboveground releases such as the Thorney Island
trials.
The transient source description consists of ordered triples of
time, evolution rate, and source radius for pure sources. For
diluted sources, values of evolution rate, source radius,
contaminant mass fraction, and source temperature must be
specified as functions of time.
An input file can be used to enter the data triples to avoid
typing errors or to use as output from another model such as a
liquid spreading model. The file format is the same as the
terminal entry format.
The first item is the number of triples used in the description
followed by the triples with the last two values showing no gas
present.
A note about the numerical parameter files is included. These
files contain various constant values used in the programs to
which the user has access without recompiling the programs.
Access is granted as a convenience.
DEGADISIN will generate a command procedure suitable for running
the model under VMS.
If so desired, DEGADISIN will initiate the procedure under VMS.
If not, the program returns to the operating system.
-------
Specification of source parameters. D-ll
(l9j Is this a release of pure (P) or diluted (d) ssterial specified above? -P or d
(20) Is this 3 Stesda state simulation? •'.« or N>
(21} Enter the initial aass of pure Sas over the source. (K=U
(Positive or :eroK 0.
Source Description
The description of the prinsrs source aass
evolution rate E and radius Rl for a transient
release is input by ordered trifles as follows!
first point — t=0» E(t=9)f Rl(t=05 (initial* nonzero values)
second point -- t=tl» E(t=tl)» Ri(t=tl)
last nonrero point ~ t=TEND» E(t=TEND)» Rl(t=TENl!)
next to last point — t=TEND*l,» E=0,» RI=0,
last point -- t=TENl!-r2,» E=0.» Rl=0,
Notet the final tise (TEND) is the last tise when E and Rl are non-zero.
Do vou have an input file for the Source Description7 Cs sr N]
Enter the nuaber of triples (as;;= 30) starting with t=0. and ending
with t=TENDI2, for the source description; 4
- Enter. TIME (sec)i EVOLUTION RATE (ksi/s)> and POOL RADIUS (a)
O.il30,r22,06
Sl.iO.jO,
S2.jO.rO,
In addition to the inforoation Just obtained* DEGADIS
reouires a series of numerical paraneter files which use
the saae naoe as EDIR3RUNNAME siven above.
For convenience! e;:asple paraineter files are included for
each step. Then srel
EXAMPLE, ER1»
EXAMPLE. ER2) and
EXAMPLE. ER3
Note that each of these files can be edited during the course of the
siaulation if a paraneter proves to be out of specification,
Do aou want a coaaand file to be Generated to execute the procedure?
$
-------
D-13
The generated INP files for BURR09S and BURR09 are shown in Figures
IV. 1 and IV.2. If necessary, the user may edit the INP file before
beginning the simulation. The generated command procedures are shown ir
Figures D.I and D.2.
Example Simulation Output
After proper completion of the model, BURR09.LIS and BUPJ109S.LIS
contain the output listing for the transient and steady-state releases.
respectively. A discussion of the steady-state and transient simulatior
listings follows. Because of the similarities between the steady-state
and transient simulation listings, the first portion of the transient
simulation is not included.
-------
D-14
Steady-state siaulstion of BURRO 9
6,500000 8.000000
3
0,1090000 0,8940000
2.GOOOOOOE-02 1,220000
308,5500 0,9400000
0 310,0000
1 O.OOOOOOOEtOO
0 0,OOOCOOOEfOO
ING
16,04000 111,7000
5.6000000E-08 5,000000
0,1500000 5.0000000E-02
1.5000000E-02
O.OOOOOOOEWO
4
O.OOOOOOOEiOO 130,0000
6023,000 130.0000
6024,000 O.OOOOOOOE+00
6025,000 O.OOOOOOOE+00
F F F F T F
20-OCT-1987 14:09:42,08
130.0000 44,12000
2.0500000E-04
-140,0000
130,0000
5.1530502E-03
1.634480
1,000000
22,06000
22,06000
O.OOOOOOGE+00
O.OOOOOOOEtOO
17.32588
1.000000
1.000000
1.000000
1,000000
111,7000
111,7000
111,7000
111,7000
1.000000
1.000000
1,000000
1,000000
Figure D.I. BURR09S.INP listing.
-------
D-15
Tiae-liaited sioulstion of BURRO 9
6,500000 S. 000000
3
0,1090000 0,8940000
2,OOOOOOOE-02 1,220000
308,5500 0,9400000
0 310,0000
1 O.OOOOOOOEtOO
0 O.OOOOOOOEIOO
LNS
16,04000 111.7000
5.6000000E-03 5,000000
0,1500000 5.0000000E-02
1.5000000E-02
O.OOOOOOOEIOO
4
O.OOOOOOOEiOO 130,0000
80.00000 130.0000
81,00000 O.OOOOOOOE-KX)
82,00000 O.OOQOOOOE+00
F F F F F F
20-OCT-1987 14:13:26,51
2.0500000E-04
-140.0000
130,0000
5.1530502E-03
1.684430
1.000000
22.06000
22.06000
O.OOOOOOOE+00
O.OOOOOOOE+00
1,000000
1.000000
1.000000
1.000000
111.7000
111,7000
111.7000
111.7000
1.000000
l.OOCOOO
1.000000
1,000000
Figure D.2. BURR09.INP listing.
-------
©
D-16
Notes on Steady-State Simulation of BURRO9
The date and time DEGADISIN was run are included.
(2J The input information gathered by DEGADISIN is repeated to assist
in documentation of the simulations. Included here are the Title
Block and the atmospheric conditions.
-------
mmmmmmw
mmmmm
Bate input on
Source ?ro£rsB run on
D-17
UOA.DEGADIS MODEL OUTPUT - - VERSION
mmmmm 20-ocT-i?3? 14:14:46,01 mmmmm
20-OCT-1?S7 1450?:42,OS
20-OCM987 14514:46,01
MOTE:
All Calculations are limited to circular liauid sources.
TITLE BLOCK
Steady-state siuulation of BURRO 9
Wind velocity at reference height
Reference height
Surface roughness lenSth
Stability class
Mcnin-Obukhov length
Gaussian distribution constants Delta
Beta
Hind velocity power law constant
Friction velocity
Asbient Temperature
Surface
Aabient Pressure
Asbient Absolute Huaidity
Aibient Relative Htiiidits
Alpha
6,50 a/s
8,00 a
2.050E-04 n
C
-140, a
0.10900 B
O.S9400
0.10532
0,21378 n/s
308.55 K
310.00 K
0.940 3te
5.153E-03 K2/K2 BDA
12,50 Z
Adiabatic Mixing; dole fraction CONCENTRATION OF C
GAS DENSITY
Enthalpy
0,00000
0,00896
0.01786
0.02668
0.04411
0.06128
0,00000
0,00538
0.01073
0,01621
0,02717
0,03825
1,07203
1.07502
1.07300
1.08097
1,08689
1,09279
O.OOOOOEiOO
-2043.4
-4086.7
-6130.1
-10217.
-14304.
304.53
302.56
-------
U-18
Continuing with the input information, the contaminant gas
properties are output.
The specification of the mass evolution rate, source radius,
contaminant mass fraction, and source temperature are output. For
a steady-state release, there is no initial mass in the cloud, and
the source parameters are held constant for an arbitrarily large
period of time.
Finally, certain numerical parameters and calculation flags are
displayed. Some of these are set in DEGADISIN while others are
set in the numerical parameter files.
-------
D-19
0,08653
0,11121
0,14325
0.17435
0.22661
0,26935
0.05508
0,07217
0,09537
0,11903
0,16005
0.19598
1,10163
1.11034
1,12198
1,13358
1.14325
1,15282
-20^34.
-26563,
-34737.
-42911.
-57214.
-69474.
AT. Of'
254. 67
0,38801
0.92334
0.96575
1.00000
1.25418
1,37336
1,53473
1,63448
1.53887
1,57857
1,63269
1.63443
-3.33068EI05
-3.55545Ef05
-3,S4152£i05
-4.08672E+05
118.34
Specified Gas Properties;
Molecular weight!
Storage teapersture!
Density at storage temperature and ancient pressure!
Mean heat capacity constant;
Mesn heat capacity power!
Upper aole fraction contour!
Lower aole fraction contour!
Heisht for isoplethsl
16,040
111.70 K
1,6845 KS/BW3
5.60000E-08
5,0000
0,15000
5.00000E-02
1,0000 K
Source input data points
Initial asss in cloud! O.OOOOOEtOO
Tiae
s
O.OOOOOEtOO
6023,0
6024.0
6025,0
Contaainant
Mass Rate
k2/s
130,00
130,00
O.OOOOOEtOO
O.OOOOOEtOO
Source Radius
n
22.060
22,060
O.OOOOOEtOO
O.OOOOOEtOO
Contaainant
ficss Fraction
R3 contaa/kS ai;:
1.0000
1,0000
1.0000
1.0000
Teoperati
K
111.70
111.70
111,70
111.70
Enthalpy
-4.03672Et05
-4,08672Et05
-4,03672Et05
-4.C3672Et05
Calculation procedure for ALPHA; 1
Entrainaent prescription for PHI I 3
Layer thickness ratio used for averase depth!
Air entrsinaent coefficient used! 0.590
2,1500
-------
©
D-HO
A summary of the calculated secondary source parameters is
included. The secondary source gas radius and height are output
as functions of time along with other secondary parameters
including the source mass flux (Qstar), the vertical concentration
distribution parameter at the downwind edge (SZ(x = L/2.)), the
contaminant mole fraction (Mole frac C), the gas mixture density
(Density), and the Richardson number based on the cloud spreading
velocity (Rich No.).
For a steady-state release, the source calculations are terminated
after the calculated parameters are no longer changing as a
function of time. A summary of the steady-state secondary source
is included.
The downwind portion of the calculations is included. The
distance downwind of the source is given in the first column.
Columns 2 through 6 contain the mole fraction, contaminant
concentration, mixture density, ratio of (p - Pa)/cc (Gamma), and
mixture temperature on the centerline of the gas cloud at ground
level. Columns 7 through 9 contain the contour shape parameters b
(Half Width), S2, and S Finally, columns 10 and 11 contain the
width from the centerline to the indicated concentration levels at
the indicated height. Note that the output is prematurely
terminated. Output actually continues until the centerline,
ground-level concentration drops below the lowest concentration of
interest.
-------
Gravity sluapina velocity coefficient used'. 1.150
NQN Isothermal calculation
Hest trsnsfer calculated with correction! 1
Hater trsnsfer not included
CALCULATED SOURCE PARAMETERS
m«
Tine
sec
O.OOOOOOEtOO
1,60000
3,52000
4,48000
5,12000
6,40000
7,04000
8,96000
15,3600
Gas Radius
B
22.0600
22,4197
23,1805
23,6237
23,9315
24,5615
24,8777
25,3717
25,1948
HeiSht
B
1.103030E-05
1.511141E-02
2.886016E-02
3.352411E-02
3.581163E-02
3.841195E-02
3.878484E-02
3.822614E-02
3.796661E-02
Qstar
k$/aW2/s
6.818148E-02
6.761492E-02
6.658905E-02
6.604830E-02
6.573497E-02
6.514826E-02
6.494597E-02
6.489014E-02
6.520404E-02
SZ(x=L/2.)
IB
0.417234
0,424343
0.440051
0.448937
0,455514
0.468544
0,475763
0,489967
0,483793
Hole frac C
1.00000
0. '98022
0.99445?
0,992791
0,991825
0,990368
0,989921
0.989604
0,989842
Density
kS/»tt3
1 f£70OJj
1 * Gws 0 *)
i. J t £.
25.3
29,2
31,6
34,8
38,0
Mole
Fraction
0,990
0.984
0.962
0.945
0,923
0.897
Concentration Density
(k3/B«3)
1,54
1.52
1.44
1.38
1,30
1,22
(ks7a«3)
1,5681
1.5523
1,513?
1,4982
1,4651
1,4261
Cantsa
0,322
0,316
0,308
0,309
0.302
0,289
Teapersture Half
(K)
121.
123.
128.
131.
136,
143,
Width
(a)
19.8
18.7
17,9
17.8
17,9
13.0
c-
J*-.
8y Width at :
5.00 sole
(B)
0.489
0,490
0,490
0,490
0,495
0,503
(B)
6.53SE-06
1,43
3.75
4.79
5,93
6,93
(a)
19,8
20,6
22,7
°"7.9
25.3
26,6
:= 1,00 a t
;• 15,0
', 3>)
19. S
19.3
20.5
21.0
21,7
T)(7
-------
D-22
Notes on Transient Simulation Output of BURRO9
(fi ) A summary of the calculated secondary source parameters is
included. The secondary source gas radius and height are output
as functions of time along with other secondary parameters
including the source mass flux (Qstar), the vertical concentration
distribution parameter at the downwind edge (SZ(x - L/2.)), the
contaminant mole fraction (Mole frac C), the gas mixture density
(Density), and the Richardson number based on the cloud spreading
velocity (Rich No.). Note that only a. portion of the output is
shown. The source calculation ends when all the primary and
secondary source gas has been taken up in the atmospheric flow.
-------
D-23
L)
TIBS
sec
O.OOOOOOEWO
1 . 250000E-03
2.500000E-03
3.750000E-03
5.000000E-03
6.250000E-03
81.3600
SI, 5200
81,6300
81,8400
81,8600
81,9600
82,0100
82.0325
82,0337
82,0350
82,0378
82,0383
mn
Gss Radius
a
22,0600
22,0600
22,0600
22,0601
22.0601
22.0601
14.8348
12,0742
8,90169
5,27878
4,74160
2,08103
0,828913
0,296554
0,267955
0.245386
0,245386
0,245386
Height
ft
1.103030E-05
2.356897E-05
3.610756E-05
4.S64604E-05
6.118439E-05
7.372261E-05
^ i
2,
1,
1,
1.
4,
2,
7,
7,
6,
1,
1.
780102E-02
360015E-02
823564E-02
147265E-02
039801E-02
857970E-03
052904E-03
756192E-04
042261E-04
OOS303E-04
021048E-04
192880E-05
CALCULATED SOURCE PARAMETERS
Gstsr SZ(>:=L/2.) Mole frsc C
K=
/»W2/s
6.818148E-02
6,
31R144F-0?
6.818139E-02
6,
818133E-02
6.818126E-02
6.818118E-02
0,
0.
0,
0,
0,
0,
0.
0,
0.
0,
0,
0.
109961
125116
143163
160261
183404
172351
162497
153897
153154
152315
148447
144329
a
0,417234
0.417234
0,417234
0,417234
0.417234
0.417234
9
0.606779
0,589903
0.529419
0.336511
0.399503
0.139777
3.258369E-02
3.261293E-02
2.975642E-02
2.748155E-02
2.748155E-02
2.748155E-02
1,00000
1,00000
1.00000
1.00000
1.00000
0.999999
0,931068
0,979136
0,977271
0.975869
0,975860
0,975360
0.975860
0,975360
0.975360
0.975360
0,975860
0.975860
Density
!.
-------
©
©
D-24
An indication of the constants used in the x-direction dispersion
correction is included. The output will also indicate if the
x-direction dispersion correction was not applied.
The concentration field is shown for different times after the
beginning of the spill. Unless otherwise specified, DEGADIS will
choose default values for the time to output the concentration
field. If other times are desired, DEGADIS3 can be executed again
after the appropriate changes to RUN_NAME.ER3 have been made. See
Appendix C for details.
The downwind portion of the calculations is included. The
distance downwind of the source is given in the first column.
Columns 2 through 6 contain the mole fraction, contaminant
concentration, mixture density, ratio of (p - pa)/cc (Gamma), and
mixture temperature on the centerline of the gas cloud at ground
level. Columns 7 through 9 contain the contour shape parameters b
(Half Width), Sz, and S Finally, columns 10 and 11 contain the
width from the centerline to the indicated concentration levels at
the indicated height. Note that the output is prematurely
terminated.
-------
D-25
Sorted values for each specified ti»e,
) X-Direction correction was applied.
Coefficient: 2.00000E-02
Power! 1.2200
Distance! 130.00 i
Tiae after beginning of spill 14.00000 sec
Distance
(B)
36,4
50,9
65,7
80,7
For the UFL
The Bass of
The §355 of
Mole Concentrstion
Fraction
(k«/a«3>
0.929 1,06
0,737 0,759
0,521 0.456
0,248 0,174
of 15,000 sole
Density
(kS/a«3)
1.2102
1.2468
1.2105
1,1286
percenti
contasinant between the UFL arid
contssinant above the
Tiae after beginning of spill
Distance
(a)
35.5
50.0
64,8
79.8
95.0
110.
Hole Concentration
Fraction
0.940 1,07
0,788 0,826
0,670 0,662
0,592 0,544
0,520 0,446
0.429 0.341
LFL is:
Gs&aa
0,130
0,230
0,304
0,324
and the LFL
LFL is!
786,92
TesperEture
•K)
176.
187,
215.
263,
of 5,0000
120,85 k2,
ks,
Half
Width
(a)
16.0
16,2
16.4
12,0
aole
Sz
(B-
0.594
0,651
0.647
0.761
percent:
Sy
(B)
6,25
9,77
12,7
14,0
Width at z= 1,00 e to:
5,00 Bole~ Iv.O 5oie.
(t) (a)
24,3 20,9
2SiS 22,"
29,6
20,7
25.00000 sec
Density
-------
D-27
In addition to the output of the concentration field at specified
times (using DEGADIS3), DEGADIS allows output of concentration time
histories at specified positions using DEGADIS4 for transient releases
(Specifics about DEGADIS4 and its input requirements are included in
Appendix C.) DEGADIS4 can be executed interactively or in batch mode.
An example DEGADIS4 interactive run and output follow.
-------
Notes on Using DEGADIS4
DEGADIS4 can be run interactively as demonstrated here or in batch
mode by supplying the same responses demonstrated here. DEGADIS4
sends the output to RUN_NAME.SR4.
The RUN_NAME of the transient simulation is used here.
The number of downwind positions where output is desired is
entered here. For each downwind distance, questions 4 and 5 are
required.
The x-coordinate is the downwind distance from the source where
output is desired.
At each downwind distance, DEGADIS4 asks for the y- and
z-coordinates desired. DEGADIS4 automatically supplies
information about the centerline concentration (y = 0 and z = 0).
Note that negative numbers signal that no more positions are
desired for this particular downwind distance.
-------
D-29
$ RUN SrS$BEGAIUS;BEGABIS4
Enter the file nsne used for this run: BURRO?
Enter the nuaber of downwind distances desired!
B3x of 10 downwind distances? 4 positions si each distance
1
(A) enter the x coordinate',
100,
(5) enter the a and z coordinate pairs at this distance!
0.) I,/.
30,» 1,
-l»i-i,..
tl! JV'17,000 tf! 98,562 dtl 2,0000 distZ 100,00
FORTRAN STOP
$
-------
D-30
Notes in DEGADIS4 Output
DEGADIS4 indicates the constants used in the x-direction
dispersion correction. The user has the option of not making the
x-direction dispersion correction if desired by making the
appropriate changes to RUN_NAME.ER3. See Appendix C.
At each downwind distance specified, the concentration profile
parameters are output as a function of time. Note that part of
the output has been removed.
-------
D-31
X-Direction correction wss applied.
Coefficient: 2.00000E-02
Power! 1,2200
Hiniuua Distance! 130,00 t
Centerline values for the position —>
100.00 a
Tiae
(s)
Hole Concentration Density
Fraction
19,0
21,0
23,0
25,0
27,0
29.0
31.0
33,0
35.0
37.0
39.0
89.0
91.0
93.0
0.283
0,385
0,465
0,491
0,500
0,502
0,507
0,511
0.512
0,511
0,512
0.512
0.511
0.511
0,210
0,302
0,382
0,411
0.421
0,423
0,429
0,435
0,435
0,433
0,435
0,434
0.434
0.433
'ens its
Jf/Bttt)
1,1320
1.1522
1,1713
1,1755
1.1759
1.1770
1.1780
1.1795
1,1791
1,1781
1.1794
1,1779
1,1783
1.1773
Gaaaa Teaperature Half
0,300
0,264
0,260
0.251
0.246
0,248
0,246
0,246
0.245
0.245
0,246
0.243
0.244
0.245
(K)
259.
242.
229.
225.
224,
224.
223.
TIT
222.
222,
•
222,
222.
OTO
4.^*. *
Width
(is)
15.3
18.5
20.0
20.2
20.4
20.6
20.7
20,6
20.6
20.6
20.6
20,7
20,6
20.6
Sz
(a)
0.891
0.361
0,846
0.850
0.353
0.868
0.875
0.377
0.876 x
0,876
0,878
0.875
0.876
0.876
SB
(B)
17.5
1 O 7
i. U t iJ
18,5
18,5
18.6
18.7
18.7
18.7
18,6
18,7
13.6
18,7
18.7
18,7
Width at := 1.00 2 to I
5,00 dole: 15.0 a:
(a) (o)
30.8
37. ~!
42.2
42.7
43.2
43.4
43.4
43,4
43,4
43.4
31.2
31.4
~> A
U A * T
Z1.3
31,4
43.4
43.4
43.4
31.4
31,4
31.3
95,0
0,485
0,401
1,1673 0.239
227.
20.9
0,893
19.2
44.0
31.1
-------
D-33
Tine
(s)
17.00000
19.00000
21.00000
23.00000
25.00000
27.00000
29,00000
31.00000
33.00000
35.00000
37,00000
39,00000
Hole fraction sit
«= O.OOOOOEWO E
2= 1.0000 B
O.OOOOOOOE+00
0,1060624
0.1424979
0,1730387
0,1860092
0,1921793
0.1952771
0,2000309
0.2026532
0,2026345
0,2019068
0,2030946
Mole fraction at! Hole fraction ait
y= 30.000 B «= -1.0000 a
r= 1.0000 a 2= -1.0000 a
O.OOOOOOOE+00
5.4025235E-02
9.S715379E-02
0.1328462
0,1447582
0,1513815
0.1557802
0.1600196
0.1617373
0.1614892
0,1608361
0,1616422
hole fraction ;t I
s= C.OOOO'Er.;
2= O.OOOOOEIO-:
e
o
89,00000
91,00000
93,00000
0.2021314
0.2021210
0.2015993
0.1614686
0.1613367
0.1608710
95.00000
0,1926055
0.1577260
-------
E-3
nmPROGRAM EPA_NONISO_MAIN*m*
OPEN CUNIT=1'STATUS='OLD')
OPEN (UNIT=3'STATUS='NEW)
C
CALL STEADY
CALL EXIT
END
r
w
INCLUDE 'sys$de2sdis:OOMS_STEADY,FQR/list/
INCLUDE 'sys$deSsdis:OOMS.FOR/11st'
C
c
SUBROUTINE SETJET (YR»UR»QINITfDIAJETfROA»Kl»K2»K3,ALOC>BLOCfDC)
C
C THIS SUBROUTINE TRANSFORMS THE EXIT 'TOPHAT' VELOCITY PROFILE OF
C A CONTINUOUS JET TO THE SIMILARITY (GAUSSIAN) FORM REQUIRED FOR
C INPUT TO THE OOMS MODEL - USES WIND TUNNEL DATA CORRELATIONS BY
C Y, KAMOTANI AND I. GREBERr NASA CONTRACTOR REPORT CR-2392r 3/74,
r
REAL JAY
DIMENSION YR(7)>XOn(10)iZOD<10?jPATHL<10)
YR(4)=3,141592654/2,
J'v'=1.2732*GINIT/((DIAJET/100,0)**2,0)
JAY=(YR(1)/ROA)*(UV/UR)**2,0
Ay=EXP(0.405-165-J-0.207519*ALOG( JAY))
ROW=0,371667-fO, 1775*. (UU/UR)
XOD(0>=0.0
ZOD(0)=0,0
PATHL(0)=0,0
40 I-I-rl
P,'nHL'::)=PATHLa-l)+SQRT((XOD(I)-XOD(I-l))**2.0+(ZOD(D-
1 ZOD(I-1))**2.0)
IF (PATHL(I).LT.ROU) GO TO 40
FXOD=XQD (1-1)1 (XOD( I )-XOD (!-!))*( (ROW-PATHL(I-l) )/(PATHL( I )-
1 PATHL(I-l)))
YR<2)=(DIAJET/100.0)*SQRT(1.0/(4,0*<0.556796+0,486344*UR*
1 COS(YR(4))/UV)))
IF (K3.EQ.1.0R.K3.EO.-1) GO TO 47
YR ( 6 ) =FXOD*DI A JET/ 100 , 0
IF CK1.NE.-1) GO TO 41
YR(6)=-YR(6>
41 IF (R2.EQ.1) GO TO 42
IF (K2.EQ.-1) GO TO 43
YR(7)=BLOC
GO TO 4-1
•42 1iR(7)=-(AV!C((ABS(FXOD))**0,4))*(DIAJET/100,0)+BLOC
~ sys$de23dis:ooms_msirufor 16-NOV-1987 06I29M9
-------
E-4
GG TO A 4
43 YR^?) = (AW(ABS(FXOD)mO,4))*(niAJET/100.0)-f-BLOC
44 CONTINUE
.IF (YR'7).LT.O,0) GO TO 45
IF (YR(7),GT.DC) GO TO 45
IF (IU.ECK1 ,OR, Kl.EQ.-l) YR(4)=0,0
IF =U'v'-UR
YF;(4)-0.0
GO TO 46
47 rp(6?=0»0
YR(7)=ELOC
ALOC=ALOC+FXOD*DI A JET/100,0
IF (K3tEQ.l) YR<4)=ATAN(AV*0.4*(ABS(FXOD>)**<-0,6)>
IF (K3.EQ.-1) YR(4)=-ATAN(AV*0.4*(AES(FXQD))**(-0.6))
YR(3)=UV-UR*COS(YR(4))
YR(4)=0,0
46 YR(7)=-YR(7)
RETURN
END
tttt
16-NOV-1987 06t29M9
-------
E-5
*«**PROGRAM EPA_NGNISO_STEADY*****
C THIS PROGRAM CALCULATES THE TRAJECTORY AND DILUTION OF A
L STEADY BUOYANT GAS JET RELEASED INTO A STATIONARY WIND FIELD
C
•: INPUT VARIABLES:
u
C ACLASS(J) = PROBLEM DESCRIPTION
C ALOC = DISTANCE IN THE Y DIRECTION FROH THE SECTOR CENTERLINE TO
C THE JET ORIGIN? M
C BLOC = VERTICAL DISTANCE FROH THE SECTOR SURFACE TO THE JET
C ORIGIN? M
C DC = DEPTH OF THE ATMOSPHERIC FLOW SECTOR? M
C DENS = JET DENSITY? KG/M**3
C DIAJET = INITIAL JET DIAMETER? CM
C DISTA = INITIAL DOWNWIND DISTANCE TO THE FIRST PRINTOUT? ii
C DISTAN = INCREMENTAL DOWNWIND DISTANCE BETWEEN PRINTOUTS? M
C H = INTEGRATION STEP SIZE? M
C M = INITIAL JET DIRECTION INDICATOR(-H=HORIZONTAL DOWNWIND?
C -1=HORIZONTAL UPWIND?0=ALL OTHER CONDITIONS)
C K2 = INITIAL JET DIRECTION INDICATQR(-H=VERTICAL UPWARDj-i=
C VERTICAL DOWNWARD?0=ALL OTHER CASES)
C K3 = INITIAL JET DIRECTION INDICATOR(+1=HORIZONTAL TRANSVERSE
C TO THE RIGHTf-l=HORIZONTAL TRANSVERSE TO THE LEFT?0=
C ALL OTHER CASES)
C QIHIT = INITIAL JET FLOWRATE? M**3/S
C ROA = AMBIENT AIR DENSITY- KG/M«3
C TESTNO = TEST NUMBER
C TA = AMBIENT TEMPERATURE? DEGREES CELSIUS
C TO = INITIAL JET TEMPERATURE? DEGREES CELSIUS
C UR = MEAN WIND VELOCITY? M/S
C X = STARTING VALUE OF JET TRAJECTORY INTEGRATION? M
C
SUBROUTINE STEADY
C
INTEGER COUNT?RUNGE?HAMING
REAL JAY.MUA ? MWG ? MOLEN? MW? MOLFR
DOUBLE PRECISION ACLASSM) ?TESTNO<1)
DIMENSION TE(7).YR(7).FR(7)?Y(4?7)?F(3?7)?YRS(7)
DIMENSION XOD(10)?ZOD(10)»PATHL(10)
COMMON/PHYS/DCDR?EPS?UPRI?ROA?DENS?G?UR?UA?CPA?CPG?MWA?MWG
COMMON/COEFF/ALFA1>ALFA2?ALFA3
r
w
C .,»,, READ IN DATA FROM FILE **,DAT - ASSIGN **.DAT FOR001
OPEN(UNIT=l>3rATUS='OLD')
READ(1?602) TESTNO(l)
RE AD U? 603) (ACL ASS (J) ? J=l?4)
F;EAD(1?600) X?H?DISTA?DISTAN
READ(1?601) TA?TG?UR?ZO?ZJO
READ(1?611) UST?ZR?MOLEN?ISTAB
li-NOV-1987 06J31t53
-------
E-6
READ (1.. 601) hWA, MWG, CPA, CFG
READ(1.604) DIAJETfQINIT
RHAD(lj606) DC>ALOCrBLOC
READ(lj609) Kl'K2jK3
READ(1..610) ALFA1?ALFA2»ALFA3
C
C INITIALIZE VARIABLES AND ASSIGN VALUES TO CONSTANTS ,,.
G= 9,80665
XINIT= X
PI= 3.141592654
P=1Q1325.
R=9314,
F;Oii=P!i-MWA/R/TA
DENS=P*MWG/R/TG
r
C PRINT VALUES OF PARAMETERS INITIAL CONDITIONS
OPEN*UNIT=3»STATUS='NEW')
WRITE(3,704> DISTAfDISTAN
WRITE(3»736) ROAiDENS»TA»TG»DIAJET
WRITE<3»705) QINIT»DC
WRITE(3f706) ALOC/ELOC
U'RITE(3j712) UR
IF (Kl.EQ.l) WRITE(3>751>
IF (Kl.EQ.-l) WRITE<3>752)
IF (K2.EQ.1) WRITE(3>753)
IF (K2.EO.-1) URITE(3»754)
IF (K3.EQ.1) WRITE(3»755)
IF (r.3.EQ.-l> WRITE(3»756)
URITE(3r71?) ALFA1»ALFA2»ALFA3
WRITE(3f726)
U'RITE(3f711)
l_-
C IF A VALUE FOR Hi THE INTEGRATION STEPSIZEi HAS NOT ...
C ..... INPUT; THEN SET H=0.01*BIAJET/5.0 .....
IF (H.LE.0,001) H= niAJET*0.002
HH= H
C
C CALCULATE MIND SPEED AT THE JET DISCHARGE HEIGHT .....
UA=UST/0.35*(ALOG((ZJOiZR)/ZR)-PSIF(ZJO»MOLEN))
C
C ..... INITIALIZE VARIABLES FOR OOrtS MODEL
13 DO 17 1=1,7
17 YR(I)=0.0
f~- XINIT
YR(1)=DENS
DCDR=1./(1.-ROA/DENS)
YR(5)=YR(1)/DCDR
C
C CALL SETJET TO CALCULATE THE INITIAL CONDITIONS .....
C FOR OOMS MODEL INTEGRATION .....
CALL SETJET(YRjUA»QINITjDIAJET»ROA»Kl»K2>K3iALOC»BLOC»DC)
2 ~ sas$de33dis:oo!r.s_stesda,for 16-NOV-1997 06:31553
-------
E-7
DO 20 1=1,7
TE(I)=0.0
Y(4»I)=YR(I)
F(lf!)=0,0
F(2jl)-0.0
F(3»I)=0.0
20 YRS(1)^0,0
COUNT = 0
C
C CALCULATE CENTERLINE CONCENTRATION? WIDTH, VELOCITY
C DECREMENT. DENSITY DECREMENT. AND ANGLE OF TRAJECTORY
C Yd) THROUGH Y(6) RESPECTIVELY
C
C CALL RUNGE TO INTEGRATE FOR COUNT,LE,3
100 IF X'H),NE,l) GO TO 114
C
C CALCULATE WIND SPEED AT THE JET DISCHARGE HEIGHT
UA=UST/0,35*(ALOG«ZJ
r
C CALL RHS TO CALCULATE RIGHT HAND SIDES
CALL RHS(YRrYRS)
DO 101 K=l»4
101 FR(K)=YRS(K)
FR(5)=YRS<5)
FR(6)=C03(YR(4))
FR(7)---SIN(YR(4))
GO TO 100
114 COUNT = COUNT I 1
I SUB = 4 - COUNT
DO 117 J=l»7
117 Y'lSUBrJ; = YRCJ)
CALCULATE WIND SPEED AT THE POSITION OF THE JET
ZJ=DCIYR(7)
UA=UST/0,35*(ALOG((ZJ+ZR)/ZR)-PSIF(ZJ >MOLEN))
C
C CALCULATE ATMOSPHERIC TURBULENCE ENTRAINMENT VELOCITY
UPRI=UPRI«E(ISTAB»UAiZJ»Y(ISUB»2))
C
CALL RHS(YR>YRS)
DO 120 K=l»4
120 F(ISUB»K)=YRS(K)
F(ISUB»5)=YRS(5)
)= COS(YR(4))
)^- 5IN(YR<4))
123 CONTINUE
IF (COUNT,LE,3) GO TO 133
3 — s
-------
IF (AES(Y(1.1)),LT,DENS/3,0) H=AMAX1(HH»H)
IF ((DENS-ROA)#K2,GT,0,0.AND,Y(1»1).GT,BENS) GO TO 127
IF (<,DENS-ROA)*K1.GT.O.O,AND.YU,1),LT.O,0) GO TO 127
GO TO 129
127 Hl=l
WRITE(3i715)
TYPE #,'JET DIRECTION CHANGED.'
GO TO 13
12° CONTINUE
C
C IF X.LE,DISTA» PRINT LOCATION AND PLUME CENTERLINE
C CONCENTRATION VALUES...RESET DISTA=DISTA+DISTAN
C IF THE JET REACHES THE GROUND* STOP THE COMPUTATION
C ..... IF THE DU DISTANCE .GT.1000 M- STOP THE COMPUTATION .....
IF (Y(l»6),GT.1000,)STOP
C
C CALCULATE THE FLUME CENTERLINE TEMPERATURE
Q=MWA
RATIO=Y(l»l)/tROA>
MOLFR=RATIO*I3/':RATIO*Q-MWG*(RATIO-1,))
MU=MOLFR*«WGK 1. -MOLFF:) *Q
TEMFK=P*MU!/ R/(Y(1•5) tROA)
r
u-
CTRHT=SGRT(2.)*Y(lr2)/COS(Y(lj4»
IF ((Y(1»7)IDC-CTRHT).LE,0,UWRITE(2»*) Y(l» 6) »Y(lr 1)»
1 TEMPKfY(l»2)
IF ((Y(lj7)fDC-CTRHT),LE.0.1) STOP
YCL=Y(1?1)
IF (Y(lf6).GE.DISTA) WRITE(3r734) Y(l»6)»(Y(1»7HBC)»YCL
IF (Y(1>6),GE,DISTA) URITE(6>9999) Y<1»6)f-Y(li7)tYCL»
1 Y(lf2)fY(l»3)fY(l»4)fY(l»5>
IF (Y(lf6),GE.DISTA) DISTA=DISTAfDISTAN
C
133 CONTINUE
C
IF (COUNT,LT,3) GO TO 100
C
C FOR COUNT,GT,3 CALL HAMING TO CONTINUE INTEGRATION
137 M = HAHING(7fY»F»X»HiTE)
DO HO K=l»5
140 YR(K)=Y(1»K)
C
C CALCULATE WIND SPEED AT THE POSITION OF THE JET
ZJ=DC+Y
-------
E-9
DO 143 K=l-5
143 F(1?K)=YRS(K)
F5X»F10,3)
607 FCRMAT(5X»F10,5»5X.F10,5f5XfF10.5)
608 FORMAT(5XFF10,5>5X»F10,5i5X»F10.3j5X»F10,3)
609 FORMAT (5X»I10»5Xr I 10»5X» 110 >
610 FORMAT(5XjF10,3»5X>F10,3j5X>F10,3j5X»F10,4)
611 FOR«AT(5X>F10,3»5XiE10.4»5X»E10.4f5X»I10)
C
C ..... FORMATS FOR OUTPUT STATEMENTS .....
^04 FOR/1AH/6X..40HO DOUNUIND DISTANCE TO FIRST PRINTOUT = ,
1 F4,1»2H M/6Xj31HO DISTANCE BETWEEN PRINTOUTS = »F4,1»2H M)
705 FORMAT(6Xj25HO INITIAL JET FLOURATE = »E11,4»7H M**3/S
2 /6Xi20HO DEPTH OF SECTOR = fF6,l»2H M)
706 FORMAT (6X?48HO DISTANCE FROM THE CENTERLINE TO THE JET ORIGIN
1 /8X^21HIN THE Y DIRECTION = ,F6.1>2H M
2 /6X»52HO DISTANCE FROM THE SECTOR SURFACE TO THE JET ORIGIN
3 /SX»21HIN THE Z DIRECTION = >F6,lr2H M)
708 FORMAT (/2X»10HTEST NO,: >A8)
709 FORMAT13HDESCRIPTIONJ r4A8/)
711 FORMAT(/5Xjl6HJET DEVELOPMENT:
1 //7XflHX.14XflHZ»10Xfl7HCONCENTRATION(CL)/4X»8H< METERS) »7X»
2 8H(METERS)»10Xf9H(KG/M**3)/)
712 FORMAT(6X..30HO MEAN VELOCITY OF THE WIND = »F4.1»4H M/S/
1 6X»24HO ORIENTATION OF THE JET)
715 FORMAT(/3X»21HJET DIRECTION CHANGED/)
719 FORMAT(6Xf26HO ENTRAPMENT COEFFICIENTS/7X> 11H ALFA 1 = ,
1 F8,4/7X»11H ALFA 2=»F8,4/7Xf 11H ALFA 3=»F8.4)
726 FORMAT (/)
734 FORMAT(2X»F12.4i3X»F12,3»7X»Ell,4)
736 FORMAT(6X,24HO AMBIENT AIR DENSITY = fF4,2»8H KG/M**3/6Xt
5 — sas*de2sdis:ooms_ste3da.for 16-NOV-1987 06:31 :53
-------
E-10
1 27HO DISPERSION JET DENSITY = ,F4,2?8H KG/M**3/6X,
2 24HO AMBIENT TEMPERATURE = »F5.1il2H DEC CELSIUS/6Xf
3 2SHO INITIAL JET TEMPERATURE = >F5,1,12H DEG CELSIUS/6X*
4 25HO INITIAL JET DIAMETER = fF5,li3H CM)
751 FGRHAT(6X»24H HORIZONTAL DOWNWIND)
752 FORMAT(6X..22H HORIZONTAL UPWIND)
753 FORMATC6X,2GH VERTICAL UPWARD)
754 FORMAT(6X>22H VERTICAL DOWNWARD)
755 FORMAT(6X.-39H HORIZONTAL TRANSVERSE TO THE RIGHT)
756 FOR«AT(6X»38H HORIZONTAL TRANSVERSE TO THE LEFT)
9999 FORMAT (F10,2»F10,2r5F10.6)
END
C FUNCTION PSI
C
C*** PER COLENBRANDER ***
C
Cm THIS FUNCTION HAS BEEN DERIVED FROM BUSINGERrJ.A.
C#*# WORKSHOP ON MICROMETEOROLOGY> CHAPTER 2» HAUGENjD.A. (ED.)
C*** AMERICAN METEOROLOGICAL SOCIETY,
C
FUNCTION PSIF(ZiML)
C
include 'sastdessdisiDEGADISl.dec'
c
REAL*4 ML
r
L.-
IF( ML ) 10»20»30
C
10 A = (1,-15.*Z/ML)**.25
PSIF = 2.*ALOG((l,fA)/2.) + ALOG((1,fA*A)/2.) - 2,*ATAN(A) t
$ PI/2,
RETURN
C
20 PSIF = 0.
RETURN
C
30 PSIF = -4,7*Z/ML
RETURN
END
C FUNCTION UPRIME
C
ADAPTED FROM OOMS AND MAHIEU (1981):
UPRIHE = (EPSILON*B)**(l/3)
EPSILON = 0,067*UA(Z)/Z (NEUTRAL) - BRIGGS (1969)
= 0.004 (UNSTABLE) - KAIMAL ET AL. (1973)
= 0,0 (STABLE) - KAIMAL ET AL, (1973)
B = JET (RADIAL) CHARACTERISTIC LENGTH
6 -- sys$de2sdis:ooros_stesdy,for 16-NOV-1987 06:31:53
-------
E-ll
C
FUNCTION UPRIHECISTAB»UA.Z>B>
C
if(istab.le.O .or. istsb.st.6) istab = 4
if(istsb.etj.l; then
UFRIME=«),CG4*&)#*(l./3.)
else if(istsb.eG.2) then
UFRIKE=(0,004*B)**(l,/3.)
else if(iEtsb.eo.3) then
L!PRIHE=(0.004*B)l:*(i./3.)
else if(istsb.es.4) then
!JFF;IME=MO,067*UA/Z*B)****(l./3.)
el=2 if(istsb.ea.6) then
L'PRIME=0.0
end if
RETURN
END
16-NOV-1987 06J3i:53
-------
E-12
**WFROGRAM EFA_NONISO_OOMS*****
INTEGER FUNCTION HAMINGC NT Y..F»X,H>TE)
C
C FUNCTION NAMING IS TAKEN FROM 'APPLIED NUMERICAL METHODS' BY
C B. CARNAHANf H,A, LUTHER, AND J,0. UILKES* PUBLISHED BY J, UILEY
C AND SONS? INC, 1969, PAGES 401 TO 402,
C
C MAKING IMPLEMENTS HAMMING'S PREDICTOR-CORRECTOR ALGORITHM TO
C SOLVE N SIMULTANEOUS FIRST-ORDER ORDINARY DIFFERENTIAL
C EQUATIONS, X IS THE INDEPENDENT VARIABLE AND H IS THE
C INTEGRATION STEPSIZE, THE ROUTINE MUST BE CALLED TWICE FOR
C INTEGRATION ACROSS EACH STEP, ON THE FIRST CALLr IT IS ASSUMED
C THAT THE SOLUTION VALUES AND DERIVATIVE VALUES FOR THE N
C EQUATIONS ARE STORED IN THE FIRST N COLUMNS OF THE FIRST
C FOUR ROWS OF THE r MATRIX AND THE FIRST THREE ROWS OF THE F
C MATRIX? RESPECTIVELY. THE ROUTINE COMPUTES THE N PREDICTED
C SOLOTTOHS YPRED(J), INCREMENTS X BY H AND PUSHES ALL
C VALUES IN THE Y AND F MATRICES DOWN ONE ROW, THE PREDICTED
C SOLUTIONS YPRED(J) ARE MODIFIED; USING THE TRUNCATION ERROR
C ESTIMATES TE(J) FROM THE PREVIOUS STEP* AND SAVED IN THE FIRST
C ROW OF THE Y MATRIX. HAMING RETURNS TO THE CALLING PROGRAM WITH
C THE VALUE 1 TO INDICATE THAT ALL DERIVATIVES SHOULD BE COMPUTED
C AND STORED IN THE FIRST ROW OF THE F ARRAY BEFORE THE SECOND
C CALL IS MADE ON HAMING, ON THE SECOND ENTRY TO THE FUNCTION
C (DETERMINED BY THE LOGICAL VARIABLE PRED), HAMING USES THE
C HAMMING CORRECTOR TO COMPUTE NEW SOLUTION ESTIMATES* ESTIMATES
C THE TRUNCATION ERRORS TE(J) FOR THE CURRENT STEPr IMPROVES
C THE CORRECTED SOLUTIONS USING THE NEW TRUNCATION ERROR
C ESTIMATES* SAVES THE IMPROVED SOLUTIONS IN THE FIRST ROW OF THE
C Y MATRIX; AND RETURNS TO THE CALLING PROGRAM WITH A VALUE 2 TO
C INDICATE COMPLETION OF ONE FULL INTEGRATION STEP,
C
LOGICAL FRED
DIMENSION YPREIK20). TE(M;r Y(4;N)> F(3rN)
DATA PRED /.TRUE./
C
C CALL FOR PREDICTOR OR CORRECTOR SECTION
IF (,NOT,PRED) GO TO 4
i_
C PREDICTOR SECTION OF HAMING
C COMPUTE PREDICTED Y(J) VALUES AT NEXT POINT
DO 1 J=1.-N
1 YFRED(J) = Y(4»J) + 4,*H*(2,*F<1,J) - F(2rJ) + 2,*F<3»J))/3.
C
C UPDATE THE Y AND F TABLES ,,,.,
DO 2 J=1/N
DO 2 K5=l»3
K = 5 - K5
Y(K»J) = Y(K-lfJ)
1 — sasfdei'sdisrooms,for 16-NOV-1987 06230:09
-------
E-13
2 IF F(KfJ) = F(K-lfJ)
C
C MODIFY PREDICTED Y(J) VALUES USING THE TRUNCATION
C ERROR ESTIMATES FROM THE PREVIOUS STEP
C INCREMENT X VALUE
DO 3 J=liN
3 YUiJ) = YPRED(J) + 112.*TE(J)/9.
X = X •!• H
C
C SET PRED AND REQUEST UPDATED DERIVATIVE VALUES .....
PRED = .FALSE,
HAMING = 1
RETURN
C
C CORRECTOR SECTION OF MAKING
C COMPUTE CORRECTED AND IMPROVED VALUES OF THE Y(J) .
C SAVE TRUNCATION ERROR ESTIMATES FOR CURRENT STEP .....
4 DO 5 J=1?N
Y(lfJ) = (9.*Y(2>J)-Y(4>J) i 3.*H*(F(l»JH2.*F(2fJ)-F(3»J)))/8,
TE(J) = 9,*(Y(1»J) - YPRED(J))/121.
5 YUrJ) = Y(1»J) - TE(J)
C
C SET PRED AND RETURN WITH SOLUTIONS FOR CURRENT STEP ,..,»
PRED = .TRUE,
HAMIKG = 2
RETURN
END
C
C
INTEGER FUNCTION RUN6E(N»Y»FiX»H)
C
C FUNCTION RUNGE IS TAKEN FRON "APPLIED NUMERICAL METHODS' BY
C B, CARNAHANr H.A, LUTHER, AND J.O, UILKES, PUBLISHED BY J. WILEY
C AND SONSr INC. 1969. PAGES 374 TO 375.
C
C THE FUNCTION RUNGE EMPLOYS THE FOURTH-ORDER RUNGE-KUTTA METHOD
C WITH KUTTA'S COEFFICIENTS TO INTEGRATE A SYSTEM OF N SIMULTAN-
C EOUS FIRST ORDER ORDINARY DIFFERENTIAL EQUATIONS F(J)=DY(J)/DX»
C (J=1»2...»N)» ACROSS ONE STEP OF LENGTH H IN THE INDEPENDENT
C VARIABLE X> SUBJECT TO INITIAL CONDITIONS Y(J)t (J=l»2>,,,»N),
C EACH F(J). THE DERIVATIVE OF Y(J>, MUST BE COMPUTED FOUR TIMES
C PER INTEGRATION STEP BY THE CALLING PROGRAM. THE FUNCTION MUST
C BE CALLED FIVE TIMES PER STEP (PASS(1).,.PASS(5)) SO THAT THE
C INDEPENDENT VARIABLE VALUE (X) AND THE SOLUTION VALUES
C (Y(1)..,Y(N)) CAN BE UPDATED USING THE RUNGE-KUTTA ALGORITHM,
C M IS THE PASS COUNTER. RUNGE RETURNS AS ITS VALUE 1 TO
C SIGNAL THAT ALL DERIVATIVES (THE F(J)) BE EVALUATED OR 0 TO
C SIGNAL THAT THE INTEGRATION PROCESS FOR THE CURRENT STEP IS
C FINISHED. SAVEY(J) IS USED TO SAVE THE INITIAL VALUE OF Y(J)
C AND PHI(J) IS THE INCREMENT FUNCTION FOR THE J(TH) EQUATION.
C AS WRITTEN. N MAY BE NO LARGER THAN 50,
16-NOV-1987 06:30'.09
-------
E-14
DIMENSION PHI (50)' SA'.'EY(50) r Y(N)j F(N)
DATA M/C/
C
H = il I 1
GO TO (l.'2?3>4.5)r M
C
C PASS 1
1 RUNGE = 1
RETURN
r
C PASS 2
2 DO 22 J=lrN
SAUEY(J) = Y(J>
PHI(J) = FiJ)
22 Y(J> = SfU'EY(J) I 0,5#H*F(J>
X = X f 0,5*H
RUNGE = 1
RETURN
C
C ***** F'A-jS 3 *****
3 DO 33 J= liN
PHI(J) = PHI(J) •!• 2,0*F(J)
33 Y(J) = SAVEY(J) f 0»5*H;CF(J)
RUNGE = 1
RETURN
C ,,, „. PASS 4
4 DO 44 J= 1»H
PHKJ) = PHKJ) + 2,0*FCJ)
44 Y(J) = SAVEY(J) t H*F(J)
X = X + 0,5)CH
RUNGE = 1
RETURN
C
C PASS 5
5 DO 55 J = 1»N
55 Y(J) = SAVEY(J) -I- (PHKJ) i F(J))*H/6.0
,M = 0
RUNGE = 0
RETURN
END
FUNCTION SIMUL(N»A»X»EPSjINDIC»NRC)
C
C FUNCTION SIMUL IS TAKEN FROM 'APPLIED NUMERICAL METHODS' BY
C B. CARNAHANr H.A. LUTHER^ AND J»0, MILKES* PUBLISHED BY J, WILEY
C AND SONSr INC. 1969, PAGES 290 TO 291.
C
C WHEN INDIC IS NEGATIVE* SIMUL COMPUTES THE INVERSE OF THE N BY
3 — sssSdeSsdisiooms.for 16-NOV-1987 06:30:09
-------
E-15
C N- MATRIX A IN PLACE, WHEN INDIC IS ZERO? SIMUL COMPUTES THE
C N SOLUTIONS X(1),,,X(N.' CORRESPONDING TO THE SET OF LINEAR
C EQUATIONS WITH AUGMENTED MATRIX OF COEFFICIENTS IN THE N BY
C Nil ARRAY A AND IN ADDITION COMPUTES THE INVERSE OF THE
C COEFFICIENT MATRIX IN PLACE AS ABOVE, IF INDIC IS POSITIVE?
C THE SET OF LINEAR EQUATIONS IS SOLVED BUT THE INVERSE IS NOT
C COMPUTED IN PLACE, THE GAUSS- JORDAN COMPLETE ELIMINATION METHOD
C IS EMPLOYED WITH THE MAXIMUM PIVOT STRATEGY. ROW AND COLUMN
C SUBSCRIPTS OF SUCCESSIVE PIVOT ELEMENTS ARE SAVED IN ORDER IN
C THE IROW AND JCCL ARRAYS RESPECTIVELY. K IS THE PIVOT COUNTER ,
C PIVOT THE ALGEBRAIC VALUE OF THE PIVOT ELEMENT? MAX
Z THE NUMBER OF COLUMNS IN A AND DETER THE DETERMINANT OF THE
C COEFFICIENT MATRIX. THE SOLUTIONS ARE COMPUTED IN THE (J+l) TH
C COLUMN OF A AND THEN UNSCRAMBLED AND PUT IN PROPER ORDER IN
C XCU,.,X(N) USING THE PIVOT SUBSCRIPT INFORMATION AVAILABLE
C IN THE IROW AND JCOL ARRAYS. THE SIGN OF THE DETERMINANT IS
C ADJUSTED? IF NECESSARY: BY DETERMINING IF AN ODD OR EVEN NUMBER
C OF PAIRWISE INTERCHANGES IS REQUIRED TO PUT THE ELEMENTS OF THE
C JORD ARRAY IN ASCENDING SEQUENCE WHERE JORD(IROWd) ) = JCOL(I).
C IF THE INVERSE IS REQUIRED , IT IS UNSCRAMBLED IN PLACE USING
C Y>;l).,,Y(N) AS TEMPORARY STORAGE, THE VALUE OF THE DETERMINANT
C IS RETURNED A3 THE VALUE OF THE FUNCTION, SHOULD THE POTENTIAL
C PIVOT CR LARGEST MAGNITUDE BE SMALLER IN MAGNITUDE THAN EPS?
C THE MATRIX IS CONSIDERED TO BE SINGULAR AND A TRUE ZERO IS
C RETURNED AS THE VALUE OF THE FUNCTION.
I"1
U-
DIMENSION IRQU( 1 5) > JCOL( 15 ) t JORDU5) > Y( 15)
dimension A(6»6) ! ts5 workaround for access violation
dimension X(5) ! ts> workaround for access violation
c dimension A(NRCfNRC)
c dimension X(N)
IF < INDIC, GE.O) MAX=NH
C ..... BEGIN ELIMINATION PROCEDURE .....
DETER=1
DO 18 K=lrN
KH1=K-1
C
C ..... SEARCH FOR THE PIVOT ELEMENT .....
FIVOT=0,
DO 11 1 = 1 ?N
DO 11 J=1?N
C
C ..... SCAN IROW AND JCOL ARRAYS FOR INVALID PIVOT SUBSCRIPTS . . .
IF (K.EQ.l) GO TO 9
DO 8 ISCAN=1»KM1
DO S JSCAN=1»HM1
IF (I.EQ.IROW(ISCAN)) GO TO 11
IF (J.EQ.JCOL(JSCAN)) GO TO 11
4 -- sysSrjegsdis'.ooms.for 16-NOV-1987 06:30109
-------
E-16
S CONTINUE
? IF ( HBS(A(I,J»,LE, ABS(PIVOT)) GO TO 11
FIVOT=A(I..J)
JCOL(K)=J
11 CONTINUE
r
Ur
C ..... INSURE THAT SELECTED PIVOT IS LARGER THAN EPS .....
IF ( ABSCPIVOTKGT.EPS) GO TO 13
WRITE(3,202)
SIMUL=0.
RETURN
C
C ..... UPDATE THE DETERMINANT VALUE .....
13 IRQWK=IROW(K>
JCOLK=JCOL(K)
DETER=DETER*PIVOT
C
C , » , . . NORMALIZE PIVOT ROW ELEMENTS .....
DO 14 J=1,«AX
14 A = -AIJCK/PIVOT
DO 17 J=1»HAX
17 IF (J.NE.JCOLK) A(I»J>=A(I»J>-AIJCK*A
-------
E-17
IF H
DO 2? 1=1. .N
]ROWI=IROW(I)
JCOLI=JCOL(I)
27 Y(JCQLI>=H
C ..... THEN BY COLUMNS .....
DO 30 1=1 »N
DO 29 J=1»N
IRQUJ=IROU(J)
JCOLJ=JCOL(J)
2? "I :iROWJ)=A(l!-JCOLJ)
DO 30 J=1.-N
30 H(IjJ)=Y(J)
f_;
C ..... RETURN FOR INDIC NEGATIVE OR ZERO .....
SIMUL=DETER
RETURN
202 FORMAT (37HOSMALL PIVOT - MATRIX MAY BE SINGULAR)
END
C
C
SUBROUTINE RHS(YiC)
REAL KUA»MWG
DIMENSION Y(7)iA(6»6)
dimension c(7) ! tos
COMHON/PHYS/DCDR i EPS > UPRI , ROA » DENS > G » UR f UA > CPA » CPG > MUA i MUG
COMMON/COEFF/ ALFA1 > ALFA2 , ALFA3
C
C ..... OOMS MODEL EQUATIONS
C
ROAO=ROA
DENSORC=DENS
CSORC=DENS
ST =SIN(Y(4))
ST2 =ST*ST
Cr =COS(Y(4)>
CT2 =CT!CCT
UA2 =UA#UA
16-NOV-1987 06:30J09
-------
E-18
1
f>
c
c
UACT
UAST
Y12
yji
Y33
=UA*CT
=UA*ST
=Y(1)*Y(2)
=Y(2)*Y(2)
=Y(3)*Y(3)
RHOSTR=YC1)/DCDR
RK1
F;K2
RR'3
RK4
RK5
RK6
RK7
RK8
RK9
RK10
RK1I
RK12
RK13
EK14
RK15
PKlo
RK17
*•• + **
=0,772679
=0,412442
=0,864665
=1,043144
=0,556796
=1.729329
=0,490842
=1,113593
=0,363346
=0,981684
=0,726692
=3,458658
=3.129432
=2,227186
=0,521572
=0,432332
=0,273398
Gas Ccmiponi
Aa>l)=Y(2)*(RKl*UACT+RK2*YC3))
A(1.2)=2,*Y(l)*(RKl*UACTiRK2*Y(3))
A(1»3)=RK2*Y12
A(1>4)=-RK1*UA'*Y12*ST
A(l,5)=0.
A(lj6)=0,
C
C ,,,,, Overall Msss Balsnce Eaustion .,,.,
C
A(2fl)=0,
A(2i2)=2,*(2,*UACH-RK3*Y(3)+RK4*Y(5)*UACT/ROA
2 +RK5*Y(5)*Y(3)/ROA)
A(2j3)=Y(2)*(RK3+RK5*Y(5)/ROA)
A(2»4)=Y(2)*(-2»*UAST-RK4*Y(5)*UAST/ROA)
A(2»5)=Y(2)*(RK4*UACTTRK5*Y(3»/ROA
A(276)=2,*(ftLFAl*ABS(Y(3))+ALFA2*UACT*ABS(ST)fALFA3*UPRI)
C
C ,,,,, X-Homentum Balance Eaustion ..,.,
C
A(3»1)=Q.
A(3»2)=2,*Y(3)*CT*(RKi*UACT+RK7*Y(3)+Y(5)/ROA*
-------
E-19
-RK14* Y', 3) *Y (5) /ROA) - Y (2) *Y33*ST* < RK7+RK9*Y (5) /ROA)
) = f(2)*(RK4*UACT*UACT*CT-i-RK8#UACT*Y(3)*CT+RK9*Y33*CT;/ROA
i'-nomentum Sslsnce Eauetion .....
A(4»l)=0.
2 *RK4*UA*UACmX5)/ROAfRK8*UA*Y(3)*Y(5)/ROA)
3 +2 , *STt ( RK7* Y33+RK9* Y 33* Y ( 5 ) /ROA )
A(4..3)=Y(2)*ST*(RK(S#UACTiRK10*Y(3}
2 iY<5}/F:GfY*- 5 ) = Y • 2 ) * -, RK 4*UHCT*UACT*STrRK8* Y ( 3 ) *ST*CT*UA
IF (ST.LT.O.) GO TO 40
SIG=-1,
GO TO 45
Energy Balance Eaustion .....
GROUPl=hUA/HUG-l.
GROUP2=MWG/MUA*CF1G/CPA
GROUF3=1-ROA/ROAO
GROUP4=DENSORC/CSORC/ROAO
RTSIDE=G,
C
ft(5»l)=-RK15*GROUPl*GROUP4*UA*Y22*CT
1 -RK17*GROUP1*GROUP4*Y22*Y(3)
A(5j2)=2,*Y(2)*(UA*GROUP3*CT-RK15*UA/ROAO*CT*Y(5)
1 -RK15*GROUPl*GROUP4*UA*Y(l)*CTfRK16*GROUP3*Y(3)
2 -RK17/ROAO*Y(5)*Y(3)-RK17*GROUP1*GROUP4*Y(3)*Y(D)
A(5f3)=Y22*
1 -RK17*GROUP1*GROUP4*Y(1»
A(5f4)=-ST*(GROUP3*UA*Y22-RK15*UA/ROAO*Y22*Y(5)
1 -RK15*GROUPUGROUP4*.UA*Y22*Y<1))
A(5»5)=-RKi5*UA/ROAO*Y22*CT-RK17/ROAO*Y22*Y(3)
A(5»6)=RTSIDE/((GROUP2fl.)*3.141592654)
C
C SIhUL USED FOR MATRIX INVERSION
C
DETER=SI«LiL(5»A»CiEPS»l»6)
RETURIJ
EUI)
sysfdsssdistoonis.for 16-NOV-1987 06I30I09
-------
F-l
APPENDIX F
DEGADIS CODE LISTING
AFGEN.FOR F-3
AFGEN2.FOR F-4
ALPH.FOR F-5
CRFG.FOR F-8
DEGADIS1.DEC F-13
DEGADIS1.FOR F-14
DEGADIS2.DEC F-22
DEGADIS 2. FOR _F_^23
DEGADIS3.DEC F-27
DEGADIS3.FOR F-28
DEGADIS4.DEC F-32
DEGADIS4.FOR F-33
DEGADISIN.DEC F-38
DEGADISIN.FOR F-39
DOSOUT.FOR F-44
ESTRT1.FOR F-49
ESTRT2.FOR F-53
ESTRT2SS.FOR F-55
ESTRT3.FOR F-57
GAMMA.FOR F-58
GETTIM.FOR F-60
GETTIMDOS.FOR F-62
HEAD.FOR F-63
INCGAMMA.FOR F-69
10.FOR F-73
IOT.FOR F-75
NOBL.FOR F-92
OB.FOR F-95
PSIF.FOR F-98
PSS.FOR F-99
PSSOUT.FOR F-102
PSSOUTSS.FOR F-105
RIPHIF.FOR F-108
RKGST.FOR F-lll
RTMI.FOR F-119
SDEGADIS2.FOR F-123
SERIES.FOR F-131
SORTS.FOR F-132
SORTS1.FOR F-135
SRC1.FOR F-140
SRTOUT.FOR F-149
SSG.FOR F-153
SSGOUT.FOR F-156
SSGOUTSS.FOR F-159
SSOUT.FOR F-162
SSSUP.FOR F-164
STRT2.FOR F-173
STRT2SS.FOR F-176
STRT3.FOR F-178
SURFACE.FOR F-180
SZF.FOR F-182
TPROP.FOR F-184
TRANS1.FOR F-199
TRANS2.FOR F-202
TRANS2SS.FOR F-204
TRANS3.FOR F-206
TRAP.FOR F-207
TS.FOR F-216
TUPF.FOR F-217
UIT.FOR F-222
-------
F-3
C
C THIS FUNCTION LINEARLY INTERPOLATES FROM THE GIVEN
C PAIR OF DATA POINTS.
C
FUNCTION AFGEN Inte2er*4 ( I-N )
include 'sasSdesisdisJDEGADISl , dec'
rif Pound
ter*4 pound
character***) SPEC
DIMENSION TAB(l)
IF(.X ,GE. TAB(D) GO TO 95
URITEdunlaSf 1100) ;;?spec
AF3EN = TAB(2)
RETURN
100 I,; = i'.. + 2
C
IT - IX + 1
IF( TABdXJ.EQ.POUNDN .AND, TAB(IY) .EQ.POUNDN ) GO TO 500
IF(X ,GE, TAB(IX)) GO TO 100
C
I>'P = IX-2
IYP = IXP 4- 1
C
£L = (TAB'IY) - TAB(IYP))/(TAB(IX) - TAB(IXP))
AFGEN = SL*(X - TAB(IXP)) + TAB(IYP)
RETURN
C
500 CONTINUE
If = IX-2
IV - TY-2
I:J' = IX-2
IYP = IY-2
SL = (TAB(IY) - TAB(IYP))/(TAB(IX) - TAB(IXP))
AFGEN = SL#(X - TAB(IXP)) I TAB(IYP)
C
1100 FORMAT(2Xj'?AFGEN? UNDERFLOW; srsument: '»lp2l3.5»5XjA20)
RETURN
END
ttll
— SYS$DEGADIS:AFGEN,FOR 2o-ocT-i?87 00:08:0?
-------
F-4
C » ,,.».,.». ,
C
C THIS FUNCTION LINEARLY INTERPOLATES FROM THE GIVEN
C PAIR OF DATA POINTS.
C
FUNCTION AFGEN2(XTAB..TABfXfSPEC)
Implicit Resl*3 < A-Hj 0-Z )» Inteser#4 ( I-N )
include 'sysJdegsdisJDEGADISl.dec'
comraon/nend/poundn > pound
character**! pound
character***) SPEC
DIMENSION XTAB(1)»TAB(1)
IF(X ,GE, XTAB(l)) GO TO 95
AFGEN2 = TAB(2)
RETURN
C
95 continue
ix = 1
100 Ix = ix + 1
C
IF( XTABdXKEQ.POUNDN ) GO TO 500
IF(X .GE. XTAB(IX)) GO TO 100
C
IXP = IX-1
C
SL = (TAB(IX) - TAB(IXP»/(XTAB(IX) - XTAB(IXP))
AFGEN2 = SL*(X - XTAB(IXP)) <• TAB(IXP)
RETURN
C
500 CONTINUE
IX = IX-1
IXP = IX-1
C
SL = (TAB(IX) - TAB(IXP»/(XTAB(!X) - XTAB(IXP))
AFGEN2 = SL*(X - XTABCIXP)) t TAB (IXP)
C
1100 FORMAT(2X,'?AFGEN2? UNDERFLOW; sr^ument: ' >lF3l3.5»5XrA20)
RETURN
END
****
1 — SYS*DEGADIS:AFGEN2,FOR 20-OCT-19S7 01:25:17
-------
F-5
SUBROUTINES TO CALCULATE THE VALUE OF ALPHA
SUBROUTINE ALPB
Implicit Resl#3 ( A-H> 0-Z )» Inte2er*4 ( I-N )
ir.clude 'sssSdegsdistBEGAOISl ,dec'
COMMON
* /ERROR/STPIH » ERBND , STPMX » UTRG > WTtm r UTy5 , wtyc > wteb » wtsnb » wtuh > XLI
$ XRIjEPS'ZLOU»STPINZ»ERBNDZ>STPMX2»SRCOER»srcssf5rccijt»
$ htcut>ERNOBL»NOBL?t>crf3er»ep£ilon
$/PARM/UOfZO.ZR5HLfUSTAR.KfG»RHOE»RHOA>DELTAfBETA>GAMMAFiCcLOU
hL?K
i:>;TEr;f!AL i-iLPHI
PSI = F3IF(ZO*ML)
UETAR = UO*K/(dL06((ZO+ZR)/ZR) - PSD
if('jO ,ea» 0,5 then
sl?hs = 0»
ustsr = 0.
return
2nd if
if (islff l.ea. 0) then
er.dif
C
CW4. RHT7 'JSED TO DETERMINE THE ROOT OF THE REQUIRED INTEGRAL EQUATION
TEK'D = 40
IER = 0
C
CALL RTMI(X»F»ALPHI>XLI»XRI»EPSfIEND»IER)
IFC IER ,NE. 0 ) CALL trsp(19»IER)
ALPHA - X
RETURN
END
— SYS$DEGADIS:ALPH.FOR 20-ocT-i?s7 oo:os:i9
-------
F-6
C FUNCTION TO EVALUATE THE WEIGHTED EUCLIDEAN NORM OF THE
C ERROR ASSOCIATED WITH THE POWER LAW FIT OF THE WIND PROFILE.
FUNCTION ALPHI(X)
Implicit Resl*8 ( A-H? Q-Z )» Inte2er*4 ( I-N )
C
include 'sys$de^sdis:DEGADISl.dec'
COMMON
1/ERROR/3TPIN ? ERBNDFSTPMX: WTRG»Ultra t UTys»wtyc,wteb > wtmb ? wtuh»XLI..
$ XRIfEPSfZLQW»STPINZ»ERBNDZfSTFMXZfSRCOERfsrcssfsrccut»
$ htcutjERNOEL>NOBLptrcrf^erjepsilon
$ /PARM/UO.- 20;• ZR r ML , BETA »GAMMAFjCcLOW
$/ALP/ALPHA;5lr-h3l
REALMS flL.'K
C
DIMENSION Yd ) jDERYd > fPR«T<5)»AUXC3)
E,,TER!-'AL ARG-ARGOUT
r
i_
ALPHA = X
C
PRfiT\l) - ZO
PF'^T',2) = dffltxl (ZLOW'zr) ! to take csre of Isr^e zr
FRMTC3) = STPINZ
PR«T(-D = ERBNDZ
PRrtT(5) = 3TPMXZ
i'l) = 0,ODOO
DERY<1) = l.ODOO
C
HDIM - 1
IHLF = 0
P
u-
CALL R!;GST(PRMTFY»DERY»NDIM>IKLF»ARG»ARGOUT»AUX)
C
IF'IHLF ,GE, 10) CALL trsp(13iIHLF)
ALPHI - Yd)
RETURN
END
Q
C
r
u + .»». ...»....»»......»..*...»»».».»..».»**»*..».»*»*.»*.....»....*.*
C
C FUNCTION TO EVALUATE THE ARGUMENT OF THE INTEGRAL EXPRESSION
C
SUBROUTINE ARG(Z»Y»DiPRMT)
2 — SYS$DEGADIS:ALFH.FOR 20-ocT-i987 00:09:19
-------
F-7
Implicit Resl*3 ( A-Hj 0-2 )> InielertA ( I-N )
include 'si'stdeSsdis :DEGABIS1 .dec'
CCMhON
$ /FARh/UO > ZO » 2R » ML • USTAR . K , G , RKOE » RHOA » DELTA r BETA i GAHHAF ? CcLOW
^/ALF/ftLPHA-slphsl
REALtS ML-K
DIMENSION Y(l).D(l)jPRHT(l)
WEIGHT FUNCTION USED
L
U = l.DOO/d.DOO I Z)
if(isl?fl,ea. 2) w= l.DOO
C
C:C*.* WIND VELOCITY @ Z ~ BEST FIT
r
UBST = USTAR/K*(dLOG((Z+ZR)/ZR) - FSIF(Z»hL))
L
Ct** UIND VELOCITY g Z ~ POUER LAU APPROXIMATION
C
UALF = UO * (Z/ZO) ** ALPHA
C
DU) = U * (UBST - UALP) * dLOG(Z/ZO) * UALP
RETURN
END
L
C
SUBROUTINE ARGOUT
RETURN
END
tm
3 — SYS«DEGADIS:ALPH,FOR 20-ocT-i?87 oo:os:i?
-------
F-J
C SUBROUTINE TO CREATE RAIiGiGSTR»srcdenr£rcwc»srcws»srcenth DATA LISTS
C
C PARAMETERS ~ TABLE - WORKSPACE VECTOR
C NTAB - DIMENSION OF TABLE DIVIDED BY iout.src
C RER - RELATIVE ERROR BOUND OF CREATED
C DATA PAIRS BY LINEAR INTERPOLATION
C
C VALUES OF TIME, RADGi height? QSTR, SZO.. t-c» as» rho? Ri»
c we'W3.'enthalpy*temp
c ARE READ INTO
C TABLE a) TO TABLE(13) RESPECTIVELY,
C
C ,,
c
SUBROUTINE CRFG(TABLE*NTABirer)
Implicit Rssl#8 ( A-H> 0-Z )> Inte<2er*4 ( I-N )
C
DIMENSION TABLE(1>
C
include 's«s$de23dis:DEGADISl,dec'
psrsroeter (zero= l.e-20)
C
COMMCN
I/SEN'S/ rsd«J(2»n>sxl) > astr(2»nis:,'l) »srcden(2»ni3xl) »srcwc(2jms.';l) ?
5 srcus(2>msxl) jsrcenth(2ini3xl)
$/cciri5t!n/ istsb?tsmbrpsmb>humid»isofl»tsurfilhtf 1 »htco>iwtf 1
» hijnisrc
~/PARMSC/ RM» SZH? EHAX»RMAX>TSC1,ALEPH» TEND
5/PHLAG/ CHECK!»CHECK2,AGAIN?CHECK3>CHECK4»CHECKS
J/HEND/ POUNDN.POUND
ch£r=cter?4 pound
P
LOGICAL CKECKl»CHECK2yAGAIN-CHECKS>CHECK4»CHECKS
C
DATA N.I/1/
r
o'cta iti/1/ ' time - element no 1 in record
dsts irg/2/ ' Rsd3 - element no 2 in record
dsts ios/4/ ! Qstsr - element no 4 in record
dsts idn/3/ ! rho - element no S in record
dst-3 iuc/10/ ! uc - element no 10 in record
dst3 iws/11/ ' us - element no 11 in record
dsts ien/12/ ! isnthelpy - element no 12 in record
c
L
C OUTPUT CREATED VECTORS TO A PRINT FILE
1 — SYSfDEGADIS:CRFG.FOR 20-OCT-1987 OOJOSMS
-------
F-9
READ', ?r * ) (TABLE(J) » J=l t iout_src)
WRITE(S.llil)
URITE(8.-1105>
if •' lief 1 .ea, 1) then
URITE<3.1102)
Ur;ITE(S<1103)
i^ITE; 3-1140) J=lj6)jt3ble(8)»t£ble(9)
' j
URITE<3.1104>
yr:ITE«3fll<0) (TABLEU)»J=1.6)»tsble(8)>t£ble(13)jtsble(9)
end if
ILFe'Cc ~ 1
^
HOO FQRHAT(/.'5X./TiiTie''5X.2>:J'Gss Radius' »2x,4Xf 'Height' »4X»
$4;;. 'Qstsr' »5;:»2;;; 'SZ(x=L/2» ) ' j 2;;. IX. 'Mole f rsc C' »2x»
53;:? 'Density' j4x? l;c» 'Tempersture' .'2x>3;:> 'Rich No. ' ? 3x)
1102 FOR«AT2xi4X> 'Heisht'
J4x-'Gster'.5:;.2:;f 'SZ(.:=L/2,)'.2x>lX»'«ols free C'j2xi
?3,;» 'Density'. 4x»3xi 'Rich No,'j3x)
1103 FOPMATdH -4X» 'sec' f 6X»6X» 'm'»7X'6Xf 'm' »7X»
1104 FORMATdH »4X» 'sec' >6X»6Xf 'is' j7X»6Xi 'm' >7X>
1103 FORMAT' 1H ?23Xi '*****' ?21Xj 'CALCULATED SOURCE PARAMETERS' »21X?
*
Rr'iDGdflJ = 0»
F^.DGCji) = TABLE(2)
OSTFMlfl) = 0,
Q£TR(2rl) = TABLE(4)
ircden(l»l) - 0.
vrcd£nC2jl) = tsble(S)
rrcwc(l.-l) = 0,
srcwc(2»l) = table(lO)
srcwzdfl) = 0,
srcw3(2»l) = tsble(ll)
c-rcenthail) = 0.
-:rc5r,th<2»l) - tsble(12)
(TAELE
-------
F-10
C#*< flG'.'E LAST RECORD READ INTO THE LAST ACTIVE POSITION OF TABLE
HO 130 J = lnout_=rc
KK - lout.src * (1-1) + J
110 TABLE(KK) = TAELE(J)
KK = lout-src * I
C
Cm READ THE NEXT RECORD, INCREMENT L,
r
L = L T 1
READ(? • * ?ENB=90Q) (TABLE(J)>J=l»iout_s re)
DO 140 Kkk = 2»I
KT = iout_src*(Kkk-l) + iti
KRG = icut_src*(Kkk-l) + irs
KGSTR = iout_src*(Kkk-l) + ins
KCA = iout_5rc*(Kkk-l) + idn
N'wc -• iout_src*(Kkk-l) f iwc
Kws = iout_src*(Kkk-l) i iws
timeslot = red^d
= (tsble(kt) - timeslot) / (table(iti) - timeslot)
AHSRG = ( TABLE (irg) - RADG(2rND) * ratio + RADG(2»NI)
ANSQ = (TABLE(ias) - QSTR(2»NI)) * ratio f GSTR(2fNI)
ANSCA - (TABLE(idn) - srcden(2?NI) ) * ratio -i- srcden(2»NI)
ANSwC = (TABLE(iwc) - sreuc(2>ND) * ratio t srcwc(2»NI)
ANSwa = (TAELE(iws) - srcwe(2»NI)) * ratio f srcwa(2»NI)
ANSen = (TABLE(ien) - srcer,th(2..NI) 1 * ratio 7 srcenth(2»NI)
ERRG = ABS(ANSRG - TABLE (KRG) )/TAELE(KRG)
ERQSTR = ABSCANSQ - TABLE(KOSTR) )/(TABLE(KQSTR)+zero)
ERO = dHAXK ERRG. ERQSTR)
ERCA = ABS( ANSCA - TABLE(KCA) )/TABLE(KCA)
ERO = dMAX 1 ( ERO » ERCA)
ERwC = ABS(ANSwC - TABLE(KuC) )/(TABLE(KwC)f nero)
ERO = GrtAXl'ERO.'ERwC)
ERw3 = i-iBS(ANSw-3 - T ABLE (Kwa ))/( TABLE (Kwa)f zero)
ERO = drtAXKERO»ERws)
ERen ~- AP3(ANSen - TAELE(Ken) )/(TABLE(Ken)+ zero)
ERO = dMAX 1C ERO • ERen)
IF 'ERO ,GT, RER) GO TO 150
140 CONTINUE
120 CONTINUE
CVCrt
YS5DE(?ADIS:CRFG,FOR 20-OCT-1987 OOiOSMS
-------
F-ll
:U»' -'LCDRD ,\'EXT DATA PAIR, SINCE ERROR EXCEEDED. RECORD THE LAST
C;*i DATA PAIR UHICH SATISFIED THE ERROR CRITERIA WHICH IS STORED
Cr:.:|' I;! TABLE (KK-dout_src-l)) TO TABLE (KK)
r
\_
ISO HI = NI -i- 1
!• T = KK - iout_src I iti
KRG = KK - iout_src i irS
KQSTR = KK - iout-_=rc i ias
KCA = KK - icut_src f idn
i-,»C = KK - ioui_trc T iwc
Kws = l;t; - iout_src I iws
Ken = KK - iout.src I ien
c
IF(NI ,GT. MAXL> then
writedunlo^j*) ' CRFG? Time out: '»tsble(kt)
CALL trep<5)
endif
C
RADGd-NI' = TABLE (KT)
RAP.GC'fNI) = TABLE '.KRG)
OSTR(lrMI) = TABLE (KT)
OSTR(2rNI) = TABLE(KQSTR)
?rL-den(liNI) = TABLE (KT)
•£rcdan(2.
.1 tsble(ktll2)»t3ble(kttS)
- 1HPSCS I 1
if dsP3ce.ea» 3) then
isFSCG = 0
end if
r
i_-
GO TO 100
r
o
900 CONTINUE ! EOF encountered
A — SYS$DEGADIS:CRFG.FOR 20-OCT-1987 00508:45
-------
F-12
NI = NI II
IF(NH1 ,GT, MAXL) then
write(lur;lo£»#) ' CRFG? Time out: Stabledti)
CALL trsF(5>
endi f
u
RAOGdjND = TABLE(iti)
RADG(2;NI) = TABLE(irs)
QSTR(1»NI) = TABLE(iti)
QSTRi'2.NI) = TABLE das)
srrdendjNI) - TABLE(iti)
srcden(2»NI) = TABLE(idn)
srcwcdfNI) = TABLE(iti)
srcwc(2.NI) = TABLE(iwc)
;rcws(l?NI> = TABLE(iti)
srcws(2»NI) = TABLE(iws)
srcenthdfMI) = TABLE(iti)
srcenth(2rNI) = TABLE den)
if(isofl,ea. 1) then
U;PITE(3?1140) (TABLE(J)»J=l»6)jtsble(8)»tst>le(9)
else
WRITE(8»1140) (TABLE(J)jJ=lj6)>tsble(8)>tebled3)>tsble(9)
endif
15P3C6 = iSP5C6 f 1
if(ispsce.ea. 3) then
ispsce = 0
write(S» 11-11)
endif
'*
NI = NI i 1
DO 910 I =1..2
RADG(I'NI) = POUNDN
OSTR;I,NI) = POUNDN
=rcden(IjNI) = POUNDN
srcuc(IfNI) = POUNDN
?.rcws(I>NI) = POUNDN
srcenth(IiNI) = POUNDN
910 CONTINUE
C
PETURN
r
.1110 FORMAT(' 7CRFG? TABLE exceeded without point selection '»
t'- execution continuing")
1111 FORKAT(1H )
el 140 FORMAT(1H »dPG13.6flX))
1140 FCRMATdH , V( lFG13,6f IX))
END •
SYST-DEGADIS:CRFG.FOR 20-OCT-19S7 00:08:45
-------
F-13
C
C
C
C DIMENSIONS/DECLARATIONS for DEGADIS1
C
include 'sysfdegadisJDEGADISIN.dec'
c
c msxl is the length of the /GEN3/ output vectors
c
psrsaeter ( Iunlo3= 6>
$ sartpi= 1,77 245 3S51DO? ! sart(pi)
$ itisxl= 800»
$ 1113X12= 2*1113X1?
$ iout_src= 13)
— SYS$DEGADIS:DEGADISI.DEC 20-oci-i987 00:47:50
-------
F-1A
iiDAM firpAnr ci
^ 1 1 H 1 1 i.' L. b n JL» j. 3 1
#*WW:W^
m***
M^
c
C Program description:
C
C DEGADI51 estimates the eminent wind profile power alpha snd
C characterizes the primary gas source,
C F rear-am uiase;
C
C Consult Volume III of the Final Report to U. S. Coast Guard
C contract DT-CG-23-SO-C-2Q029 entitled 'Development of an
C AlBiOSPheric Dispersion Model for Heavier-than-Air Gas Mixtures',
C
C J, A, Havens
C T, Of Spicer
C
C University of Arkansas
C Department of Chemical Engineering
C Fsyettevillei AR 72701
C
C April 1985
r
r
•-•
C This project was sponsored by the U. S. Coast Guard and the Gas
C Research Institute under contract DT-CG-23-80-C-20029,
C Disclaimer!
C
C This computer code material was prepared by the University of
C Arkansas as an account of work sponsored by the U. S. Coast Guard
C and the Gas Research Institute. Neither the University of Arkansas*
C nor any person acting on its behalfJ
C
C a. Makes any warranty or representation* express or implied*
C with respect to the accuracy* completeness* or usefulness
C of the information contained in this computer code material*
C or that the use of any apparatus* method- numerical model*
C or process disclosed in this computer code material may not
C infringe privately owned rights* or
C
C b. Assumes any liability with respect to the use of* or for
C damages resulting from the use of* any information*
C apparatus* method* or process disclosed in this computer
C code material,
C
I — SYSSDEGADISfDEGADISl.FOR 20-OCT-1987 00:13:21
-------
F-15
r
p,}-•;•}•$ **7;±:>f***£t;;*^
DIMENSIONS/DECLARATIONS
Implicit Resl*'8 ( A-H? 0-Z > » Inte£er*4 ( I-N )
include 'sysSdegsdisJDEGADISl.dec'
nta-b is the dimension of table divided by iout_src
psrsiaeter ( nt£bO=910<
$ ntsb=ntsbO/iout_src)
include '(Issdef)'
C BLOCK COMMON
C
COMMON
?/GEN3/ r3a'2<2ririS}{l)
f/TITL/ TITLE
S/CEMi/ PTIME(i2en)j
$ PFRACV(i2en)j PENTH(i3en) » PRHO(iSen)
J/GEN2/ DEN(5figen)
*/ITI/ Tl»TINPjTSRCfTOBSiTSRT
* /ERROR/STP IN ? EREND .. STPMX , WTRG > UTtn. , WTas • wtyc > wteb » wtrob i wtuh , XLI »
5 yRI..EPS>ZLOWfSTPINZ>ERBNDZ»STPMXZ»SRCOER»srcss>srccut«
$ htcut? ERNOEL i NOBLpt t erf de r • e?si Ion
5/FARM/ UO » ZO » ZR » ML » USTAR » K , G ? RHOE ? RHOA f DELTA » BETA > GAMMAF , CcLOW
$/SZFC/ szstpO » sre rr > szstpoix • snszO
$/ccni_^p TOP/ ^ss_niw > 5ss_tei6F > 33s_rhoe j Sss_cpk. j SSS.CPF >
$ 33S_(jf 1 > 25S-1 f 1 .' 2££_Z5P I SSS-PlSme
$/comstm/ istsb^tarabjpsitibiihuiiiid; isof 1 jtsurf » ihtf l>htco» iwtf l»wtcor
$ hums re
$ 'PARMSC/ R«jSZM»EMAX»R«AX»TSClfALEPHjTENn
$/CCRI_= = / esi f sleri>swidroijtcc.'outszjoutb>outl »swclf swsl rsenl ?srhl
S /PHLAG/ CHECK1 > CHECK2 . AGAIN r CHECKS > CHECK4 » CHECKS
vus f vub f vuc f vud.« vudel ts > vuf Iss
$/coRi_ENTHAL/ H_m3=
$/NEMD/ POUMDN- POUND
f/ALP/ A
$/r--hiccd/ ir-hifl.dellsy
f/2f-rd_con/ ce' delrhomin
*/COM_SURF/ HTCUTS
—
SY5$DEGADIS:HEGADIS1,FOR 20-OCT-1987 00 t 13: 21
-------
F-16
!fSO TITLE(4)
*4 pound
chsrscter#24 TSRC»TINP»T08Sf TSRT
:-h; rscter-<3 Sss_nsme
re £-1*4 til
REALMS ML»K
LPGICAL CHECK1»CHECK2 > AGAIN»CHECK3»CHECK4> CHECKS
loaicsl vuflsa
logics! reflet
REALMS LrLO
DIMENSION PRMT(25)»Y(7)»DERY<7)iAUX(8»7>
EXTERNAL SRCliSRCIO
char3cter*40 OPHPUP!
chsrscter OPNRUP(40)
c hi rscter« INP , ER1 1 SCD» TR2> scl
dimension tfble(ntsbO)
6ouivslence(opnrup(l ) f
c
p
C
C
C
DATA
DATA POUNDN/-l,D-20/»POUND/'// '/
DATA LISTAR/O.DO/>GAN«AF/O»DO/
DATA G/9,81DO/> K/0.35DO/
DATA GAHMAF/O.DO/
DATA PR«T/25*0,DO/
DATA Y/7*O.DO/» DERY/7»O.DO/
DATA TI«EO/0,DO/»NDIM/0/
DATA EMAX/O.DOATSC1/O.DO/
DATA PTIME/iden*0,DO/
DATA ET/iSen*O.DO/fRlT/igen*0,DO/
DATA PWC/i<2en*0,DO/»PTEMP/i3en*O.DO/
DATA PFRACy/i3en*0,DO/»PENTH/i2en*O.DO/
DATA FRHD/i2en*Q,DQ/
date DEN/i^en*0.DOTisen*0.DO»i2en*0.DO> i3en*0.DO»i^en*0.DO/
u
cats refls^/.truet/
r
DATA INP/'.inp'/jER1/'.erl'/
DATA SCD/'.scd'/»TR2/'(tr2'/
dsts scl/'.scl'/
C
C
3 — SYS$DEGADIS:DEGADISI,FOR 20-OCT-1987 00:13:21
-------
F-17
CW GET THE EXECUTION TIME
C
tl = secnds(Q.)
istst = lib$dste_TIME(TSRC)
ifdstst ine» ss$_norni3l) sto? 'Iib$d3te_time feilure'
C
Cm GET THE FILE NAME FOR FILE CONTROL
C
c WRITE(lur.lo2jll30)
cllZO FORMAT (5X? 'Enter the file nsme being used for this run: '»$)
resd(5f!QOO) nchsrjopnrup ! unit 5 s'ets coraniend file too
1000 fori!i3t(0»40sl)
c
(Itnchsr) // erl(U4)
CALL ESTRTHOFNRUFl)
HTCUT5 = HTCUT
C
opnrupl = opnrtjFl(ltnchsr) // inp(lt4)
CALL IO(tend»£i»3S50»OPMRUPl)
if (check 4) srcoer = 2.S*srcoer
CALL ALPH
C
slphsl = slphs+l*
WRITEdunloSfllOS) ALPHA
1105 FORMAT (5X»' THE VALUE OF ALPHA IS SF6.4)
C
C
GAMMAF = GAMMA (1,/ALPHAl)
TSC1 = TEND
CO"* set the density snd enthslpy functions in TPROP
c
csll setenthsl (h_m3srte>h_3irrte»h_wstrte)
call setden(l.DOO»O.DOO»h_ni3srte)
C
C ............................ , .................... ,
w
C SOURCE INTEGRATION
-------
F-18
C [[[
c
C START THE GAS BLANKET?
C
L = 2,*AFGEN2(FTIME»RlTfTIMEO,'RlT-MN')
QSTRE = AFGEN2(FTIME>ET>TIMEOJ'ET-HN')/(pi*L**2/4,)
PWCP = AFGEN2(PTIME>FWCfTIMEOj'PWC')
HPRIM = AFGEN2CFTIME, PENTH.. TIrtEOf TENTH')
RHOP = AFGEN2(PTIME>PRHO»TIMEO»'PRHO')
CCP = PUCF*RHOF
c
c
ostsr = Of
ifCuO *ne» 0.)
$ ostsr = CCP*M:ustsr*clph3l*dell3y/(delley-l»)/phihet(RHOP>L)
t-
u
c
write (lunlos'f 3010) timeO»l »sz»astsr?ostre
IF(QSTRE.lt.QSTsR ,snd. susssO.eo.O. ) then
tscl = 0,
GOTO 105
sndif
C
100 CONTINUE
chacKJ = (f3lse.
p
C#« INITIAL CONDITIONS
C
if (tifiieO.ne, 0.) then
LO = 2.*AFGEN2(PTIME»RlT,TIMEO»/RlT-MN/>
GSTRE = AFGEN2(PTIME»ETfTIh'EO>'ET-MN/)/(pi*LO**2/4,)
PUCP = AFGEN2(PTIME»PWCfTIMEO»'FWC')
HPRIM = AFGEN2(PTIME»PENTH»TIHEO» 'PENTH')
RHOP = AFGEN2(PTI«E»PRHO>TI«EO»'PRHO')
CCP = PUCP*RHOP
c
cistsr =0.
if(uO,ne. 0.)
$ astsr = CCP*k*ust3r*3lph3l*dellsy/(dell3a-l.)/phihst(RHOP>LO)
c
endif
C
C*** SET UP INTEGRATION PARAMETERS
C
C*** VARIABLE SUBSCRIPT
Cm. RG Yd)
mass Y(2)
ntessc Y(3)
JR3SS3 Y(4)
-------
F-19
C*** Enthalpy Y(5)
cW* moe y(6)
Cm TIME X
C
PRMT(l) = TIMEO
PRMT(2) = 6.023E23
FRMT(3) = STPIN
FRMT(4) = ERBND
Ff;HT(5) = STPMX
C PRMT(d) = EMAX -- OUTPUT
c
do iii = 6?25
F rmt (iii) = 0 .
eridcio
C
Yd) = AF6EN2(PTIMEiRlTfTIMEOf'RlT-MN')
rrosx = y(l)
Y<2) = dmaxK 2msss» (pi*Y(l)**2*i.l*srccut*RHOP) )
vuflss = .fslse»
htod = 3m3ss/RHOP/2./pi/Y(l)**3
p rmt (22) = htod * 2.*Y<1> ! initial height of the tsil
prait(24) = print (22)
preit(23) = 0. ! initial height of the heed
prmt(25) = F rmt (23)
if (htod ,<5t, 0,1) vuflea = .true.
Y(3) = Y(2) * PUCP
PWAP = (1. - PWCP)/(1, + HUHID) ! water from humidity only
Y(4) = Y(2) * PWAP
Y(5) = Y(2) * HPRIH
= 0.0
DERY(l) = WTRB
DERY(2) = UTtm
HERY(3) = WTyc
DERY(4) = WTas
DERY(5) = WTeb
dery(6) = wtmb
C
NDIH = 6
C
CWt PERFORM INTEGRATION
!-!F:ITE(lunlosS»1145)
1145 FORMAT(5X» 'Beginning Integration Step - Gss blanket')
C
CALL RKGST(PRMT»Y»DERYfNBI«»IHLF»SRCl»SRC10»AUX>
C
IFdHLF ,GT, 10) CALL trap(lflHLF)
IF (CHECKS) then
TEND = TSC1
GO TO 110
6 -- SYS$DEGADIS:DEGADISI.FOR 20-OCT-1987 00:13:21
-------
F-20
end if
C
C [[[
C
C RESTART THE GAS BLANKET?
C
TIMEO = TSC1
L = 2.*AFGEN2(PTIMEjRlT»TIMEO»'RlT-MN')
QSTRE = AFGEN2
PUCP = AFGEN2(PTIME»PWC»TIMEO»'PWC')
RHOP = AFGEN2(PTIME>PRHO»TIMEO.. 'FRHO')
CCP = FUCPfRHOP
c
G s t- s r — 0 .
if(uO,ne. 0.)
$ aster = CCP*k*ust3r*slph3l*dell3y/(dellsy-li)/Phih3t(RHOP>L)
write(lunlo2»3010)
3010 forni3t(//»' timeO: ' »lp3l3.5»t40» 'It Mp2l3.5f
$/•' szO: 'jlp2l3,5j/'' astsrl 'jlP2l3»5>t40f 'astre: '»lpssl3.5)
c*J|:* before restsrtin2> check to see if this rosy be s problem child.
c If the current time is less than SRCSS? this msy be s problem
c simulstion. The scheme is to scan the primsry source flux for the
c rest of time. If the flux is never higher? dissble the blanket
c restsrt feature in NOEL with the logics! flsS REFLAG? snd
c force the source to use NOBL*
IF(QSTRE .Gt. QSTAR ,snd» timeO.^e.srcss) then
goto 100
else if(GSTRE .GT. OSTAR) then
do iii=l > isen
if (ptin:e(iii ) ,ea, poundn) goto 100
if(tiroeO »lt. ptime(iii) ) 3oto 101
enddo
100
101 do ii=iii>i2en
if(etCii) ,ea, O.DO) 2oto 102
flux = et(ii)/
-------
F-21
p
C SOURCE INTEGRATION ~ NO GAS BLANKET
P
105 ccr.tinue
URITEClunlo2?1147)
1117 FORMATC5X''Source calculation - No Gss blanket')
C
CALL NOBL(timeout? reflas)
if(checK3) then ! restart blanket calculation
timeO = tinieout
soto 100
end if
110 RHAX = 1.01*RMAX ' GUARANTEE A GOOD VALUE
sleph = 0,
ifCuO ,ne. 0.)
$ ALEPH = UO/BAMMAF*(S2M/ZO)**ALPHA
$ /(SQRTPI/2.*RM +RMAX)**(ALPHA/ALPHA1)
C
c
rewind (unit=9)
opnrur-1 = opnrupl (1 Jnchsr) // scl(lM)
open(unit=9»nanie=opnrupl» type='n3w' t
$ c3rrisSecontrol='fortrsn'? recordtype='variable')
c
call heed(3ffi3=sO)
csll crfs(tsblejntsbjcrfser)
call head(2niassO)
c
CLOSE(UNIT=?-
clo=.e(uriit=S)
C
OFnrupl - cFnrupHlinchsr) // tr2(lt4)
CALL TRANS(OPNRUP1)
r
w
CM*. CALCULATE EXECUTION TIME
P
ttl = tl
tl = Secnds(tTl)/60.
URITE(lunlos?2000) TSRC
WRITE(lunloS?2010) Tl
2000 FORMAKIX.'BEGAN AT '?A24)
2010 FORMATOX?' ***** ELAPSED TIME ***** '?lp2l3,5?' min ')
C
STOP
END
tm
3 — SYS$DEGADIS:DEGADISI,FOR 2o-ocT-i?87 00:13:21
-------
F-22
C
C
C
C DIMENSIONS/DECLARATIONS for DEGADIS2
C
include 'syslde^sdisJBEGADISl.dec/list'
C
C MAXNOB IS THE MAXIMUM NUMBER OF OBSERVERS ALLOWED,
C
psrsmeter( msxnob = 50»
$ RT2= 1.41 421 3562DO* ! sart(2.0)
? sapio2= 1,25 331 4137DO) ! sart(pi/2.)
C
****
— SYS$DEGADIS:DEBADIS2.DEC 20-OCT-1987 OOM7:57
-------
F-23
PROGRAM DEGADIS2
c*******************************************************************^
C4*W-***************************** ********************* W
c
C Program description',
C
C DEGADIS2 performs the downwind dispersion portion of the calculation
C for each of several observers released successively over the transient
C 2ss source described by DEGADIS1.
C
r
C Program usage!
r
*_
C Consult Volume III of the Final Report to U, S, Coast Guard
C contract DT-CG-23-80-C-2002? entitled 'Development of sn
C Atmospheric Dispersion Model for Hesvier-thsn-Air Gas Mixtures",
r
C J, A, Havens
C T, 0, Spicer
C University of Arkansas
C Department of Chemical Engineering
C Fayetteville? AR 72701
C
C A?ril 19S5
C
r
*_•
C 7hi= project wss sponsored by the U, S» Cosst Guard end the Gas
C Research Institute under contract DT-CG-23-SO-C-20029,
C
C
C Disclaimer?
C
C This computer code material was prepared by the University of
C Arkansas a; an account of work sponsored by the U. S» Cosst Guard
C and the Gas Research Institute, Neither the University of Arkansas?
C nor any person acting on its behalfJ
C
C s, Hekes any warranty or representation? express or implied?
C with respect to the accuracy? completeness? or usefulness
C of the information contained in this computer code material?
C or that the use of any apparatus' method? numerical model?
C or process disclosed in this computer code material may not
C infringe privately owned rights? or
r
C b, Assumes cny liability with respect to the use of? or for
C damages resulting from the use of? any information?
C apparatus? method? or process disclosed in this computer
C code material,
i -- SYS2DEGADIS:DEGABIS2.FOR 20-OCT-1987 00:14255
-------
F-24
*:n****m**##*#****##*#w#***#**w
4::m:*:Wm'm:mmT*W
DIMENSIONS/DECLARATIONS
Implicit Res 1*8 ( A-Hj 0-Z )» Inte*er*4 ( I-N )
include 'sasSdegsdis 5 DEGABIS2. dec/list'
include '(fs
COMMON
t -'GENS/ r£d^(2'ffi?;,'l)'astr(2fiii2.':l) j£rcden(2>ms;:l)fsrcwc(2>irisxl)i
I =rcwr(2'B,;.':l > ? =rcenth(2jiB3;:l )
J/5SCOIV HREC ( msxnob » 2 ) > TO ( mexnob ) , X1,1 ( msxnob )
S/TITL/ TITLE
f/GENi/ FTIME(i^en)» ET(is!en)j RlT(i2en)j PWC(iSen)> PTEMP(i^en)
$ PFRACy(iSen). FENTH(i2en)» FRHO(i^en)
f/GEN2/ DENCSfiSen)
f /PftRri/ UO j ZO ? ZR > ML » USTAR ; K ? G » RHOE , RHOA » DELTA > BETA r GAMMAF f CcLOW
J fill/ Tl » TINP • TSRC , TOBS» TSRT
f /ERROR/SYOER .- ERRO > SZOER • UTAIO i WTOOO i UTSZO » ERRP» SMXP »
I WTSZPjyTSYP»WTEEP»UTDH»ERRG»SMXG»ERTDNF»ERTUPF»WTRUH»WTDHG
f/canisLm/ iEtsbf tembypsnibf humid? isof 1 jtsurf »ihtf l>htcojiwtf liwtco»
$ hfjmsrc
$/PARMSC/ RMjSZM»EMAXf RMAX» TSC1 ,ALEPH»TEND
J/3TP/ STPO,STPPiODLPiODLLPjSTPG»ODLG»ODLLG
f /PHLAG/ CHECK 1 , CHECK2 » AGAIN > CHECKS i CHECK4 > CHECKS
t/NEh'D/ POUNDN; POUND
f -'ALP/ ALPHA. slPhsl
?./COM_SURF/ HTCUT
S/STOPIT/ T5TOP
S/CNOBS/ HOBS
C
chsrscter^SO TITLE(4)
Th^rsi-tcrM pound
2 — EYBtr!EGADIS;DEGADIS2.FOR
20-OCT-1987 00 1 14 1 55
-------
c"i = r?cter*24 TINP ,TSRC,TOBS..TSRT
rsslM ttl
REALMS K.ML.'L
LOGICAL CHECK1)CHECK2; AGAIN »CHECK3»CHECK4» CHECKS
TR2»ER2»PSD>TR3j obs
chsrscter OPHRUP(40)
chcrscter*40 OPNRUP1
snuivslence (opnrupd )
C
C DATA
DATA TSTOP/0,/
DATA POUND/'// '/»POUNDN/-1 ,E-2£/ —
DATA TIHEO/0./»NEUM/0/
DATA RADG/ms;;12*0./iQSTR/m3xl2*0./jsrcden/n>3xl2*0./
DATA NREC/ms;:nob*.0 > n,5::nob^0/ > T0/rasxnob*0 . / j XV/msxnob*0 , /
DATA TR2/'.TR2VfER2/',ER2V
DATA PSD/'.PSD'/jTRS/'.TRS'/f obs/ '.DBS'/
C
C MAIN
C
Tl = SECNDS(0.)
istst = lib$dste_TIME(TOBS)
ifdstat »ne» ss$_norm3l) stop'lib$dste_time failure'
r
C*** GET THE FILE NAME FOR FILE CONTROL
C
c WRITE(5.1130)
cl!30 FORMAT (' Enter the file name beinS used for this run.' '»
resd(5»1130) nchsrjopnrup
1130 for(ii3t(Q5403l)
C
o^nrupl = OPNRUPKltnchsr) // er2(lM)
CALL ESTRT2(OPNRUP1)
C
W*. GET THE COMMON VARIABLES CARRIED FROM DEGADIS1
C
opnrupl = OFNRUPHlinchsr) // tr2(114)
CALL STRT2(OPNRUPlrH_mssrte)
C
r
— SYS$DEGADIS:DEGADIS2,FOR 20-OCT-19S7 00:14:55
-------
F-26
C FSEUDO STEADY STATE CALCULATIONS
C INTEGRATION IN SUBROUTINE SUPERVISOR
C
ornrupl = OPNRUP1 (Itnchsr) // psd(i:4)
OFEN(UNIT=9..TrPE='NEU' >NA«E=OPNRUP1 >
5 csrri5sccontrol=' list' »
$ recordtype='v3ri3ble' )
l - OPNRUFlUJnchsr) // obs(lM)
OPEN( UNIT=12» TYPE='NEW'»NAME=OPNRUPli
rscordtype=' vs
CALL SSSUP(K_m?srte)
CLOSE(UNIT=9>
c
c
csll =etden(l.DO»0,DO>H_Bissrte) ! sdiebstic mixing w/ pure stuff
c
C
opnrupl = OPNRUPKltnchsr) // tr3(lM)
CALL TRANS(OPNRUP1)
C
til = tl
Tl = SECNDS(tTl)
Tl = Tl/60,
WRITE(lunloa»4000) TOBS
WRITE(lunloS>4010) Tl
4000 FOR'ttATCZXf 'BEGAN AT '»A40>
4010 FORMAT<3Xi'm ELAPSED TIME *** 'flp613.5»' min')
C
STOP
END
tttf
— SYS$DEGADIS:DE6ADIS2.FOR 20-OCT-1987 00:14:55
-------
F-27
c
c declarations for DEGADIS3
c
include 'st-sf de<3sdis:BEGADIS2.dec/list'
c
parameter ( &ia;:nt=40»
$ ais;ctnob=n.3>;nt^ms;rnob)
c
t«*
1 — SYS$DEGADIS:DEGADIS3.DEC 20-OCT-1987 OOM8501
-------
F-28
PROGRAM DEGADIS3
cwmmmmmmmmmmmmmmmmmmmmnm********
cwmmmmwwmwmmmmwmwwmwmmmmmm.
CW:W*#tW*t*#*.####*******W^
c
C Prosrsro description?
r
i-
C DEGADIS3 sorts the downwind dispersion cslculstion made for each of
C the severs! observers in OEGADIS2, The output concentrations st
C several a'iven times may then be corrected for along-wind dispersion
C =s desired,
C Program usage:
r
w
C Consult Volume III of the Fins! Report to U. S. Cosst Gusrd
C ccntrsct DT-CG-23-80-C-20029 entitled 'Development of sn
C Atmospheric Dispersion Model for Heavier-than-Air Gss Mixtures'.
C J, A, Hsvens
C T, 0, Spicer
C
C University of Arkansas
C Department of Chemical Engineering
C Fayetleville* AR 72701
C
C April 1985
r
r
C This project wss sponsored by the U. S, Coast Guard and the Gas
C Research Institute under contract DT-CG-23-SO-C-20029,
C
C
C Disclaimer?
r
C This computer code material was prepared by the University of
C Arkansas as an account of work sponsored by the U, S. Cosst Guard
C and the Gas Research Institute, Neither the University of Arkansas?
C nor any person acting on its behalf:
C
C s, Makes any warranty or representation* express or implied?
C with respect to the accuracy* completeness* or usefulness
C cf the information contained in this computer code material*
C or that the use of any apparatus* method* numerical model*
C or process disclosed in this computer code material may not
C infringe privately owned rights? or
C
C b, Assumes any liability with respect to the use of* or for
C damages resulting from the use of* any information*
C apparatus? method* or process disclosed in this computer
1 — SYS$DEGADIS:n£GADIS3,FOR 20-OCT-1987 00:i5M4
-------
F-29
L cude mcteriei.
C
C
**t*-m'ra::r£rm.*#***#***************w
r
w
c
Implicit RerUS ( A-H? 0-Z )? Inte2er*4 ( I-N )
include 'sfE$ds2sdis:DEGADIS3,dec/list'
iricluje '(f = Edef)'
C
CUt MINIMUM DIMENSION ON TABLE IS 6 * MAXNOB I 1
r
psrsnister (ntsbO=10*m£;:nob-i-i)
C
COMMON
J.-'cORT'-' TCA(ni£"riobrtii3xnt) 'TCASTR(msxnob>ms;;nt) ?
t** TII^-I'»T^\(-^I^- n — » r- ^ \
•*• i 3 c v [«i c 1111—i L' i fii»/ \ rj w /
$ TSY(ni5::nobiias;;nt) jTSZCrosxriobf ir,sxnt):
$ TBISTO(m3xnob»ms;cnt) jTDIST(n>3xnob>ms);nt)»KSUB(ia3xnt)
$/3SCON/ NREC(fii3;:nob.-2) .-TOdnsxriob) jXV(msxnob)
f/SC'RTIN/ TIri(Bi£;;nt) rNTIMjISTRT
?/GEN"'/ BEN(5" iS^n)
f/PARM/ UOfZO?ZRjKL»USTARjK»GjRHOE»RHOA»DELTA»BETAfGAMHAF»CcLOU
S/cori_ipro.-/ a£5_niwj2ss_tenip»2ss_rhoe133s_cpk..2ss_cPP>
Tl»TINPrTSRCfTOBS»TSRT
S/coiiistir./ istebf tsnibfpsmb » humid ?isofl»tsurf »ihtfl»htco»iwtfl»wtco»
$ hums re
J/FARMSC/ RM»SZMfEMAX»RMAX»TSCl>ALEPHjTEND
f /PHLAG/ CHECK1 • CHECK2 , AGAIN » CHECK3 r CHECK4 » CHECKS
f /ERROR/ ERTlfERDTfERNTIM
5./NEND/ POUNDNi POUND
$/ALP/ ALPHA. slphsl
f/CNOBS/ NOES
r
LOGICAL CHECK1»CHECK2»AGAIN»CHECK3»CHECK4»CHECK5
REALMS HL..K
DIMENSION TABLE(ntcbO)
c
chsrscter*24 tsrc»tinp »
C
chsrscter*4 TR3»PSDf Er3»SR3»Tr4
2 — SYSiDEGADISJDEGADISZ.FOR 20-OCT-1987 00:i5M4
-------
F-30
chsrscter*40 opnrupl
character Or-nruF-(40)
EQUIVALENCE (OPNRUP(1)
DATA
DATA POUNDN/-1.E-20/TFOUND/'// '/
DATA TCA/ffisxtnob#CV»TCASTR/ffi3xtnob*0,/jTSY/n!Sxtnob#0,/
dsts TSI/in3>:triob*0»/>KSUB/ni5xnUO/
DATA TB/issxtnob*0./»TDISTO/flisxtnob*0./jTDIST/nisxtnob*0,/
DATA TR3/',TR3'/,PSD/',PSD'/
DATA Er3/"»Er3'/jSR3/",SR3V>Tr4/',Tr4'/
** UNITS
3 — OUTPUT TO A PRINT FILE
C*** 9 — I/O WITH DISK
L
Tl = SECNDSCO.)
istst = lib*dst.5_time(tsrt)
ifCistat .ne, ss$_normsl) =.top'lib$dete_time failure'
p
C
C*** GET THE FILE NAME FOR FILE CONTROL
C
c URITE(5»1130)
c!130 FORMAT(' Enter the file name used for this runt '>$)
resd(5?1130) nchsr^opnrup
1130 forni3t(c?»40sl)
r
\_-
C**:* GET THE VERSION NUMBER
C
c 100 WRITE(5rll40)
cl!40 FORMAT(' Enter the version number (between 00 snd 99) forS
c $' this sort: '?$)
c CALL GTLIN(DUMMY)
c NCAR = LEN(DUMMY)
c IFCNCAR .EQ, 0) GO TO 110
C
c IF
-------
F-31
c 130 DOT(l) = '060
c DOT(2) = DUMMY(l)
c GO TO 150
r-
>^f
c 140 DOT(l) - DUMMY(l)
c DOT (2) = DLIMHY(2)
C
c ISO CONTINUE
c CALL CONCATCEr3fDQT>Er3)
c CALL CONCAT(Sr3jDOT»Sr3)
c CALL CONCAT(Tr4»DOT>Tr4)
C
C*W NOW» REPLACE THE FILE NAME IN OPNRUP
r
w
c CALL SCOPY(BFILE»OPNRUP)
C
C«# THATS IT
C
opnrupl = opnnjpKl Jnchsr) // tr3(lM)
CALL STRT3(OPNRUP1)
C
opnrupl = opnrupldJncher) // er3(U4)
CALL ESTRT3(OPNRUP1)
C
opnrupl = opnrupl(1 Jnchsr) // psd(U4)
OPEN(UNIT=9!NAME=OPNRUP1,TYPE='OLD')
C
C
C
C TIKE SORT SUPERVISOR — CALCULATE DOWNWIND DISPERSION CORRECTION
C
CALL SORTS(TABLE)
C
CLOSE(UNIT=9)
r
u-
c
c
C OUTPUT SORTED PARAMETERS
C
opnrupl = opnrupl(ltnchsr) // SR3(1J4)
CALL SRTOUTCOFNRUP1. table)
C
opnrupl = opnrupl (1 Jnchsr) // tr4(lM)
CALL TRANS(OPNRUP1)
C
STOP
END
4 ~ SYS$DEGADIS:DEGADIS3.FOR 20-OCT-1987 00:i5M4
-------
F-32
c ,,.,,,.,,.,,, .,,,.,,,
c
c declsrstions for DEGADIS4
c
include 'sys$deS3dis:DEGADIS3.dec/list'
c
parameter (ndos=10)
c
****
— SYS$DEGADIS:BEGADIS4.DEC 20-OCT-1?S7 01224:07
-------
F-33
PROGRAM DEGADIS4
cmmmmmwmmwmmmmmmwmmmwmmmmn;!'.
c
C Program description!
C
C DEGADIS4 sorts the downwind dispersion cslculstion made for esch of
C the several observers in DEGADIS2. The output concentrations at
C seversl given tines may then be corrected for along-wind dispersion
C as desiredf DEGADIS4 slso outputs the concent raticd BE s functicr,
C of time st s given position.
C
C
C Program usage 5
C
C Consult Volume III of the Fins! Report to U, S. Coast Guard
C contract DT-CG-23-80-C-2G029 entitled 'Development of an
C Atmospheric Dispersion Model for Hesvier-t-hsn-Air Ges Mixture;",
C
C J. A. Havens
C T, 0, Spicer
C
C University of Arkansas
C Department of Chemical Engineering
C Fayetteville> AR 72701
C
C April 1985
C
C
C This project wss sponsored by the U. S. Cosst Guard and the Gss
C Research Institute under contract DT-CG-23-80-C-20029,
C
C
C Disclaimer J
C
C This computer code material wss prepared by the University of
C Arkansas as an account of work sponsored by the U. S, Cosst Guard
C and the Gas Research Institute. Neither the University of Arksnscsi
C nor any person acting on its behelft
C
C a. Makes any warranty or representation) express or implied'
C with respect to the accuracy* completeness? or usefulness
C of the information contained in this computer code material?
C or that the use of any apparatus? method* numerical »odel«
C or process disclosed in this computer code material may not
C infringe privately owned rights? or
C
C b. Assumes any liability with respect to the use of > or for
C damages resulting from the use of.< any information ?
1 — SYS$DEGADIS:DEGADIS4.FOR 20-OCT-19S7 01:23116
-------
F-34
C sppsrstusj method.' or process disclosed in this computer
C code material.
C
C
cmmmmmmmmmmmmmwmmmmn'mmmmmrm
Implicit Resl*8 ( A-H, 0-Z )» Inte^eDM ( I-N )
C
C
C
C
include 'sas*deS3dis:DEGADIS4, dec/list'
include '(fssdef)'
C
C*** MINIMUM DIMENSION ON TABLE IS 6 # MAXNOB
C
(ntsbO=10*ms);nob-H )
COMMON
$/SORT/ TCcdriSxnobunsxnt) >TCcSTR(ms;;nob»m3xnt) *
$ Tycdnsxnobunaxnt) fTrho(n,3xnob»iTi3;:ntv j
$ T33miii3(m3xriobf msxnt) rTteniF (sisxnobrmsxnt):
$ TSY(u3xnobfrnsxnt) >TSZdnsxnobmisxnt) *TB(ir.;
$ TDISTO(msxnob»Bi3xnt> rTDIST(ms::nob>ai.';nt):
$/SSCON/ NREC (msxnob j 2), TO (nssxnob) > X1.' (Risxr.ob 5
$/cdos/ idos> dosdisx(ndos)» dosdis(4j2»ridos)
$/SORTIN/ TIM(ii3xnt)»NTIM»ISTRT
*/GEN2/ DEN<5»isen)
$/PARM/ UO»ZO»ZR»HL»USTAR»K»G»RHOEjRHOAfDELTA?BETA*GAMMAFjCcLOU
$/CORl. 5P POP/ woS_IUW ? £$33 —t-GISPf 5£S_rhOS f soS —Crk / a3S —Crr f
$ 5oS —Ufl >^£S—lf*l T 5S5_ ZSP J 2oS_n8IfiE
«/ITI/ TliTINP»TSRC»TOBS5TSRT
$/com£tm/ istsb? t3rab>psmbf huir,id.'i£of 1? tsurf' ihtf 1 >htco'iutf I ?wtcoj
$ humsre
$/PARMSC/ RM»SZM»EMAX»RMAX»TSC1»ALEPH»TEND
$/PHLAG/ CHECK1»CHECK2»AGAINfCHECC.3»CHECK4jCHECKS
$/ERROR/ ERTlfERDTfERNTIH
5/NEND/ POUNDN»POUND
$/ALP/ ALPHA*slphsl
$/CNOBS/ NOBS
C
LOGICAL CHECK1>CHECK2* AGAIN,CHECK3»CHECK4»CHECKS
REAL*S ML;K
DIMENSION TABLE(ntsbO)
c
chsrscter*24 tsrc»tinp?tobsftsrt
C
2 — SYS$DEGADIS:DEGADIS4.FOR 20-OCT-19S7 01J23:i6
-------
F-35
ch3rscter#3 sss-nssie
character*4 TR3»PSD»Er3>SR4»Tr4
charscter*40 opnrur-1
character opnrup(40)
EQUIVALENCE (OFNRUPd
C
C DATA
C
DATA POUNDN/-1,E-20/>POUND/'// '/
DATA TCc/ia3;;tnob*0,/»TCcSTR/ms;,tnob*0,/«TSY/Ri3::tnob*0( '
dsts TSZ/ma: TI'ISTO/iii3;;tnob*0 . /' • TDI 3T/m£;,tncb*0 , /
C
DATA TR3/ ' . TR3 ' / » PSD/ ' , PSD ' /
DATA Er3/'»Er3'/jSR4/'.SR4'/jTr4/'»TM'/
C
UNITS
8 ~ OUTPUT TO A PRINT FILE
9 — I/O WITH DISK
C
Ti = SECNDS(0.)
istst = Iic4dste_tiae(tsrt)
ifdstst ,ne. ss$_noriri3l) stop'lib$dste_tiae fsilure'
r
w
C
C*** GET THE FILE NAME FOR FILE CONTROL
C
URITE(lunlo2»1130)
1130 FORHATC Enter the file name used for this run: '»!)
resd(5jll31) nchsr>opnrup
1131 format(a»403l)
C
C
opnrupl = opnrupld Jnchsr) // tr3(l!4)
CALL STRT3(OPNRUP1)
= opnrupl (1 Inchsr) // er3(U4)
CALL ESTRT3(OPNRUF1)
C
c
C .............. ,»,,,,,,,,.,,, ....... , , , . , , ,
c
c input the position to cslculate the concentration histo^rsros
c
write(6i#) 'Enter the number of downwind distances desired!'
write(6r#) ' rosx of '»ndos»
1 ' downwind distances? 4 positions at esch distance'
read(5»*) Jdos
if(Jdos ,at. ndos) Jdos=ndos
3 ~ SYS$DEGADIS:DEGADIS4.FOR 20-OCT-1987 01523:16
-------
F-36
do ii=lfj'dos
write(6»*) ' '
write(6»*) 'enter the ;: coordinate!'
resd(5»*> dosdis;;(ii)
write(6»*)
1 ' enter the a end : coordinate pairs si this distance:
do iJ=l;4
resd(5»*> (dosdisdJ»JJ»ii)»JJ=1?2<
if(dosdis(iJ»2?ii).le»0. »snd»
1 dosdi£(iJ»l»ii).le,0») 3oto 100
enddo
100 continue
enddo
c
c
opnrupl = OFTirupKUnchsr) // SR4(i:4)
open(unit=8>nsme=opnrupl» type='new' >c
do idos=ljJdos
C
C
C
C TIME SORT SUPERVISOR -- CALCULATE DOWNWIND DISPERSION CORRECTION
C
opnrupl = opnrupKUnchsr) // psd(l!4)
OPEN(UNIT=9»NAME=OPNRUP1»TYPE='OLD')
c
do iJ=l>m3xnt
KSUB(iJ) = 0
do i jk=l T(iis;;nob
TSZ(ijR»iJ) = 0.
enddo
enddo
c
c
CALL SORTS(TABLE)
C
CLOSE(UNIT=9)
C
C ,
C
C OUTPUT SORTED PARAMETERS
C
CALL dosOUT(t3ble)
c
enddo
c
close(unit=S)
c
C
4 — SYS$DEGADISJDEGADIS4.FOR 20-OCT-1987 Oi:23!16
-------
F-38
C..,.,..,.* ..,.,...,, >
C
c declarations for BEGADISIN
C
C
parameterf isen= 30» ! dimension of /aenl/ snd /sen2/
$ pi= 3,14 159 2654DO)
c
****
— SYS$DEGADIS:DEGADISIN.DEC 20-001-1997
-------
F-39
C PROGRAM DEGADISIH
r
U'
C Frosram description:
C
C DEGADISIN sets as en interactive input module to the programs
C which Kiske UF the DEGADIS model. The user is Guided through s
C series of Questions which supply the model with the necessary
C input information*
C Frosirem usaslel
C
C Consult Volume III of the Finsl Report to U, S. Coast Guard
C contract DT-CG-23-SO-C-20029 entitled 'Development of an
C Atmospheric Dispersion Model for Heavier-than-Air Gas Mixtures
C
C J, A, Havens
C T, 0- Spicer
r
C University cf Arkansas
C Department of Chemical Engineering
C Fayetteville? AR 72701
C
C April 1985
C This project was sponsored by the U. S. Coast Guard end the Gas
C Research Institute under contract BT-CG-23-SO-C-20029,
Disclaimer^
C This computer code material wss prepared by the University of
C Arkansas as an account of work sponsored by the U, S, Cosst Guard
C and the Gas Research Institute, Neither the University of Arkansas?
C nor any person sctinS on its behalft
p
C a, Makes any warranty or representation? express or implied?
C with respect to the accuracy? completeness? or usefulness
C of the information contained in this computer code material?
C or that the use of any apparatus? method? numerical niodel?
C or process disclosed in this computer code material may not
C infringe privately owned rights? or
C
C b. Assumes eny liability with respect to the use of? or for
C damages resultinsi from the use of? any information?
C apparatus? method? or process disclosed in this computer
i — SYS*DEGADIS:DEGADISIN.FOR 20-OCT-1987 00:16:35
-------
F-40
r INITIAL INPUT FOR DEGABIS ROUTINES
i_
c ricte.' this series of programs relies on the system wide
c logical 3'.'ii,bol SYSfPEGADIS which denotes the source
c *nd executable code for these images.
C
c
PROGRAM DEGADISIN
Implicit Re=l*8 ( A-H? 0-Z )t Intesier#4 ( I-N )
include 'SYSfDEGADISJdeSedisin.dec'
COMMON
S/TITL.' TITLE
S/GEN1/ PTIfiE(i2en)j ET(iSen)> RlT(i2en)»
$ PFRACV(i2en)» PENTH(iSen)» PRHO(iden)
$/GEN2/ DEN(5»i£en)
I/ITI/ Tl»TINPfTSRC»TOBS»TSRT
UO»ZO»ZR»MLfUSTAR»Kf6fRHOE»RHOAfDELTAfBETA»GAMMAFiCcLOU
$ 2£S_Uf 1 J 23S- 1 f 1 > ^5S
l/coi9_£s/ ess > si en f swid»outccjouts2»outb>outl
$/PHL AG/ CHECK1 r CHECK2 1 AGAIN , CHECK3 > CHECK4 1 CHECKS
$/cci»_si3>:/ sis;:_coeff ;si5x_FOWFSi2;:_miri_distnsi3x_f Issi
$/HEND/ POUNDNt FOUND
C
chsrscter*80 TITLE(4)
C
pound
rW^ TSRCf TINPiTOBS>TSRT
C
REALtS MLfK
LOGICAL CHECK1 » CHECK2 » AGAIN, CHECKS i CHECK4 , CHECKS
u.
c check 1
c check2=t cloud tape release with no liauid source? SRC1 DEGADIS1
c again local communications in SSSUP SSSUP
c checK3 locsl communications between SRC1 and NOBL DEGADIS1
c check4=t steady state simulation DEGADISIN
SYS*DEGADIS:DEGADISIN,FOR 20-ocT-i98? 00:16:35
-------
F-41
c check5=t cperator sets sort parameters ESTRT3
dst a CHECK1/ .false ,/• CHECK2/ .false . / > AGAIN/ .false , /
data CHECK3/ .false,/- CHECK4/ , f si BS , / , CHECKS/ .false , /
p
w
rharacterHOO OPNRUP
character OPNRUPK100)
ea'Ji valence (opnrupl (1 ) ? opnruF )
cha-rscter*4 INF'-erl jer2.-er3>conif scl»sr3> lis
ch£Tecter*4 dummy
ci~,3r;cter*3 plus
uh3r=ctEr)t2 cori
PAT-i POUND/'// '/.POUNDN/-1.E-20/
C
DATA FTIKE/isen#0,DO/
DATA ET/i2en*O.DO/»RlT/iaen*O.DO/
DATA PWC/i3en*0 , DO/ » PTEMP/i2en*0 , DO/
DATA PFRACV/i2en*0 , DO/ >PENTH/iSen*0 . DO/
DATA PRHO/i^en*O.DO/
dsts DEN/isen^O, ?isen*0. ? i3en*0. >i^en*0. f i2en*0./
DATA INP/'.I,NP'/ferl/'.erl'/»er2/',er2//fer3/'.er3//
dst= =cl/' ,scl'/fsr3/' .sr3'/,lis/' ,lis'/
data com/' .com'/'
data plus/" f V»con/' -'/
c
Cm GET THE FILE NAME TO BE USED BY ALL OF THE ROUTINES
C
WRITE (6 i 800)
WRITE(4»81Q)
READ (5.820) NCHARiopnrup
= opnrupd Jnchsr) // inp(lM)
MOIJ GET THE REST OF THE DESIRED INFORMATION
r
L.
CALL I OT( OPNRUP)
WRITE (6> 1000)
if (check 4) then
urite(6j 1001 ) ! continuous
else
if(uO .en, 0.) then
write(6»1009)
else
URITE(6»1002) ! transient
sndif
end if
write(6f!010)
C
Crs:* FORMATS
r
£00 FCRMAT(//,16Xi'DEnse GAs Dispersion Model input module,')
810 FORMAT(/»' Enter the simulation name'*
3 — SYS$DEGADIS:DEGADISIN,FOR 20-OCT-1987 00:16:35
-------
F-42
$' J CDIRJRUNNAME 'ft)
S20 FQRHAT(Q?A40)
1000 FORMAT (' ',/>
f In sddition to the information Just obtained?'?
$' DEGADIS' ?/? ' reauires s series of numerical parameter'?
$' files which use'?/?' the'?
$' same name 35 [DIRHRl'NNAME given above, '?//?
$' For convenience» example parameter files are included for'?/?
%' each step, They are!')
1001 FORMATC10X? 'EXAMPLE, ER1 and' ?/? 10X? 'EXAMPLE, ER2' )
1002 format (1GX? 'EXAMPLE, ER1?'?/?10X? 'EXAMPLE, ER2? and'?/?
$ 1 OX »' EXAMPLE, ER3')
1009 fcm,5t(lC;:f 'EXAMPLE, ER1')
1010 formstC Note that each of >
I' these files can be edited during the course of the'j/j
£'' simulstion if a parameter proves to be out of specification.'?/)
i?
c
write(6?1200)
1200 formate Do you want a command file to be generated to execute'?
$' the procedure? '>$)
RE£d(5»1210) dummy
1210 fonnst(s4)
if (dummy, so, 'n' ,or, dummy, ec?» 'N') goto 3000
GPnrup = opnrupd Jnchar) // com(lJ4)
write(6>1220) opnrup
1220 formate The command file will be generated under the file'?
open ( uni t=S ? nanie=opnrup ? type= ' new ' >
$ carrisgecontrol = ' list' » recordtype=' variable' )
c
Qpnrup = oPnru?(l Inchar) // erl(U4)
c
write(S?1250) (opnrupl(i) ?i=l »nchar-H)
1250 format( '$ copy/log SYSJDEGADISJexsnsple.erl '?403l)
IF(uO ,ea. 0.) then
write(S?12SO)
write(S?1290) (opnrupl(i) ?i=l?nchsr)
2oto 1340
c'ndif
opnrup = opnrupd Jnchar) // er2(U4)
c
w rite (8 > 1260) Copnrupl(i) ?i=l?nchar+4)
1260 formate '$ copy/log SYS$DEGADISJexample,er2 '?40al)
or-nrup = opnrupd Jnchar) // er3(U4)
c
if ( ,not,check4) then ! transient
c
write(8?1270) (opnrupl (i) ?i=l?nchari4)
1270 format('$ copy/log SYSSDEGADISJexsmple.erS '?40al)
A — SYSfDEGADISJDEGADISIN.FOR 20-OCT-1987 00116:35
-------
F-43
write(S»12SO)
1230 forn.st('$ run SYS$DEGADIS:DEGADIS1 ' )
write(8i!290) (opnrupl(i) «i=ljnchsr)
1290 formst(40sl)
write(Si!300)
1300 format ('« run SYS$DEGADIS:DEGADIS2' )
wnte(8»1290) (opnrupl (i ) > i=l»nchsr)
urite(8«1320)
1320 format ('$ run SYSSDEGADISJOEGADISS')
write(Sf 1290) (opnrupl (i ) > i=l »nchsr)
jp = opnrupd tnchsr) // =cl(U4) //
1 r-lu=(i:3) // cp-nrup(i:nchsr) // sr3(lM) // con<152)
write(Sj!370) (opnrupKi ) «i = l »2*nchsr+13)
1370 form3t('$ cc?y/lo2 'flOOsl)
c
opnrup = opnrupd Jnchsr) // lis(lM)
write(S?1390) (opnrupl(i) »i=l»nchsr+4)
1390 formstC '»40sl)
else
writench3r)
write(8»1330)
1330 formstCf run SYS$DEGADIS:SDEGADIS2' )
write(Sj!290) (opnrupl(i) »i=l>nch5r)
u
Or-nrup = opnrup(llnchsr) // scl(li4) //
1 plus '.$)
F;E£-d(5»1210) dummy
if (dummy .en, 'y' ,or. dummy. en. 'Y' ) 3oto 2000
doto 3000
2000 cpnrup = '(?' // opnrupd Incher) // ' '
istst = Iib$do_comm5nd(opnrup )
wr-its(6t2100)
2100 formstC/'' TDEGAHISIN? commend file failed to start.')
c
3000 continue
CALL EXIT
END
5 — SYS$BEGADIS:DEGADISIN,FOR 2o-ocr-i987 00:16:35
-------
F-44
SUBROUTINE dosOUT(tsble)
Implicit Re3l*S ( A-H, 0-Z )» Inte2er*4 ( I-N )
include 'sys$dessdisJDEGADIS4. dec/list'
COMMON /SORT/TCc(m3;rnob>me;:nt)»TCcSTR(m3;cnobjsi3;:nt)»
t Tyc(msxnobf rasxnt) »Trho(iB3::nob»ms;fnt) f
$ TSsniBisdnsxnobjiiiSJcnt) jTteiripdncxnobujisxnt) >
$ TSYd&sxnobuJisxnt) i TSZ(m5::nobji»3xnt) > TB(ir.a:;nobji!ic;;nt) ?
$ TDISTO(m3):nob»i»3xnU »TDIST(i»3xriot>ffie;:nt) jK
f/cdos/ idos» dosdis>.'(ndos) j dosdis(4»
$/SORTIN/TIM(ni3xnt)jNTIM.ISTRT
$
$/coastni/ istsbftsnibjpsmb* humid jisof If tsurf .'ihtflrht.cciiwtfl5wt.cG?
$ hums re
C
dimension tsble(l)
diaension chist(4ii»3xnt)
c
c
ch3rscter#3
C
if (si2x_fls3.ea, 0.) then
write(8»1102)
else
write(8>1104)
write(3> 1105)
endif
= isofl.eo. l.or, ihtfl.eo, 0
cfls2l= isofl.eo.l
if(cfl33) then
csll 3disbst(2;wcjW3«2ss_lf 1 jys>cc_lf 1 > r>w?t ?tt)
csll 3disb3t(2>wcrW5j23s_uf 1 r ysrcc_uf 1 1 r>w.
-------
F-45
WRITE<8»1117>
endif
URITE(8flll9)
IF = 0
DO 110 I=ISTRT>NTIM
II = KSUB(I)
J = 1
disto = tdist(Jfi)
ceo = tccstr(J>i)
rhoo = Trho(J»i)
yco
tempo
semrnso = TSsmmsCjji)
bo = tb(J»i)
szo = tsz(J»i)
syo = tsB(J>i)
if( disto .2t. dosdi=;:(idos) ) then
write(lurilod>*) ' E;:trspolsted point for time'. 'jTim(i)
urite(8f*) ' Records for '«tim(i)f' i, =re roissinS - see source'
goto 110
endif
DO 120 J=2»II
dist = tdist(J>i)
cc = tccstr(J»i)
rho = Trho(J»i)
yc = Tyc(Jii)
temp = Ttemp(J»i)
SSOlRiS - T^3l7iPi3( Jr i )
b = tb(J»i)
52 = tsz(J«i)
ey = tsy(JTi)
blfl = 0,
bufl = 0.
if( dist .It. dosdis;;(idos) ) goto 119
dist = (dosdis;:( idos) - disto)/(dist-disto)
cc = distX(cc-cco) + ceo
rho = dist*(rho-rhoo) + rhoo
yc = distfc(yc-yco) t yco
temp = dist*(teuip-teiapo) I tempo
b = dist*(b-bo) t bo
sz = dist*(sz-szo) T szo
sy = dist#(sy-syo) t syo
c
if(.not.cflss) then
2 — SYS$DEGADIS:DOSOUT.FOR 20-CCT-1987 01:2^:10
-------
F-46
csll sdi3bst(-2f wcrwsf 3ss_lf 1 »ys>cc_lf 1 » r»w»£3i?.n.= «tt '<
call sdisbst(-2jwcjws;^3s_uf 1 >ys»cc_uf 1 • r>wj=:s,i.iri5-tt )
end if
c
c*#* cslc the concentrstion time histories
c
do iJ=l>4
chist(iJ»i) = 0.
if(do=dis(iJ»2>idos) ,Se, 0.) then
srs = (dosdis(iJ>2»idos)/sz)#*3lph3l
if (dosdis(iJ»l.»idos) ,stf b) srs = 3rS I
1 ((dosdis:F(srS)
if(cflss) then
csll sdi3bst(0>xx»3Sj^ccjy3S>chist(iJf i) » rr? ww?2^»tt)
else
csll sdisb3t(-l ?xxj33jyccjyss>chist(i J?i) ? rr? wwrSsmmsj tt)
endif
chist(iJ>i) = ycc
endif
endif
enddo
c
c
srd = (2ss_zsp/sz)**slphsl
.2e, SO.) 2oto 600
ccz = cc/exp(srS)
if(ccz .It, cc.lfl) then
if(cfls^l) then
WRITE(8»1120) tiin(I)»yc»Cc»rho»temp»B»SZ»SY
else
WRITE(3»1120) tin (I) »ac»Cc»rho»2sinnis»temp>EiSZ»SY
endif
goto 600
endif
sr3 = -(dlo2(cc_lfl/cc) f (2ss_zsp/s2)**slFhsl)
blfl = sart(sr2)#sy t b
c
if (ccz ilt. cc_ufl) then
if(cfl3Sl) then
WRITE (8»1120) tiro(I)>yc»Cc>rhojteftp»B»SZ»SYjblfl
else
WRITE(8»1120) tin.(I)»yc.Ccfrho>3sitiiii3jtemp»B!SZjSY.
endif
^oto 600
endif
3r2 = -(dlo^(cc_ufl/cc) i (23s_zsp/sz)*#slphsl)
bufl = sart<3r2)*sy f b
if(cfl32l) then
3 — SYSiDEGADISJDOSOUT.FOR 20-OCT-19S7 01:24:10
-------
F-A7
URITE(S11120) tin.(I) ? yc.• Cc, rho • t eisp >B> SZ? SY ? blf 1»buf 1
else
WRITE(8»1120> tim(I) ?ye>Cc? rho)^5nnr,srleniFf BjSZ»SY»blf 1 'buf 1
endif
c
600 continue
soto 120
11? continue
disto -• tdist(J»i)
ceo = tccstr(jji)
rhoo = Trho(J>i)
yco = Tyc(J'i)
tempo = Tteaip(Jji)
ssmuiso = Tgsni!i3( J»i)
bo = tb(Jji)
sea = tsz(J>i)
syo = tsb'(J?i)
120 CONTINUE
c
ip = IP f 1
if(ip ,ea. 3) then
if = 0
write(8»1119)
endif
110 CONTINUE
C
c*$* output the concen time histories
c
write(8»1119)
write<8i!119)
iii = 0
do iJ=l?4
if(dosdis(iJ?2jidos).St.0. ,end.
1 dosdis(iJr1iiJ>idos)-ij=l>4)jiiJ=l»2)
2100 foririst(lHO»llx>'Time'rll;:j4(4;:..'Hole fraction st:'f5;:)»/»
1 1H r26;:,4(4;.:>'a= 'Ip^l3.5.' m' H-;) i/j
1 1H >llx»'(:s)'»12;:»4(4:;j'z= 'lpSl3,5r' ra'.4;;))
DO I=ISTRT»NTIM
write(812200) tiro(i)t(chist(iJ>i)iiJ-l»iii)
ip = ip + 1
if(ip ,ea. 3) then
ip = 0
write(8»1119)
endif
enddo
4 — SYS$DEGADIS:DOSOUT,FOR 2o-ocT-i?87 01:24:10
-------
F-A8
2200 fon&stdh ?5(6x» Ipsl4,?»6x; )
C
C
1102 formstdHOrSxj 'X-Direction correction wss NOT applied,')
1104 forraetdHOf 5;,'.« 'X-Direction correction wss applied.')
1105 formstdh i5x»5x» 'Coefficient: ' jlr-2l3,5»/>
1 Ih »5x»5x> 'Power: ' »lpsl3.5»A
1 Ih »5x»5x» 'Minimum Distsncel 'jlF2l3»5' m')
1110 FORMATdHOfSX/ 'Center-line values for- the position -->',/,
1 ' x5 '»lF2l3.5j' !»'•/)
1115 FORMATdHOflX.. ' Time ' »2;,-r 3w> 'Hole' , 3x>
1 'Concent ret ion' -I;:? 'Density' y2::»3;:r 'Gsmiae' .'3x7
1 'Tei»per3ture'»3xf /Hslf'>4;:>4;;j'Sz''5::»4x.'Sy'i'5:;5
1 'Width at :='fOpf6.2»' m to! ' »/Mxrllxjl.-;'Frsctior,' »2xf
1 1 lx» 1 lx» 1 Ix > ll;c»3j;»' Width '»3xjllxj?X'
1 2(lPs£9.3»'»iole%'»lx))
1116 FORHATdHOflX,' Time ' »2x»3xf 'Mole' >3x»
1 'Concentrstion' »!:;» 'Density' >2x»
1 'Temperature '»3x» 'Half '»4x»4x» 'Sz'»5x»4xf 'Sa'»5x»
1 'Width st z=SOpf6,2>' ID to! ' »/» lx»llx»lx'Frsction' -2;:..
1 1 lx> 1 lx» 1 lx»3x»' Width '»3x»llxj9xj
1117 FORMATdH *4Xf ' (s) ' > 4xfllx»
1 2(lX>'(k3/ni**3)'jlx)>llx>4x»/(K)'j
HIS FORMATdH »4X, ' (s) ' i4xill;:i
1119 FORMATdH )
1120 FORMATdH »3dX»lPG9.3»lX) j2x»0pf7.4> 2x>lX»lPG10,3ilXj
1 6dXjlPG9.3flX))
C
RETURN
END
****
5 — SYS$DEGADIS:nOSQUT,FOR 20-OCT-19S7 01:24110
-------
F-49
C ROUTINE TO GET RUN PARAMETERS FROM A FILE
C
SUBROUTINE ESTRTKOFNRUP)
Implicit Resl*8 ( A-H> 0-Z )» InteSer*4 ( I-N )
include 'sysSdeSsdistDEGABISl.dec'
C
P3rsir,eter( iend= 22?
1 iendl= iendtlj
1 iiiend= 2»
1 iiiendl= iiiendH*
1 iiend= 2>
1 iieridl= iiendtl?
1 Jend= 4>
1 Jendl= Jendllj
1 iiiend= 5>
1 mendl= mend-H)
c
C BLOCK COMMON
C
COMMON
i /ERROR/STFIN f ERBND f STPMX > UTRG » WTtm » WTas i wtsc > wteb » wtmb > wtuh , XL I »
* XRIjEPS»ZLOW»STPINZfERBNDZ»STP«XZfSRCOER»srcss»srcciJtf
$ htcutjERNOBLfNOBLptfcrfsenepsilon
f / vucom/ vus » vub ? vuc > vud » vudel ts » vuf 1 S3
$ /= z f c/ szstpO > sze rr » ssstpmx » szszO
iphifl»dellsy
$/sprd_con/ ce< delrhomin
r
L.
EQUIVALENCE
*(RLBUFa)»STPIN)» IMAIN - RKGST - INITIAL STEP SIZE
$(RLBUF(2)»ERBND)f IMAIN - RKGST - ERROR BOUND
t(RLBUF(3)TSTFMX)j IMAIN - RKGST - MAXIMUM STEP SIZE
f (RLBUF(4)..WTRG)j IMAIN - RKGST - WEIGHT FOR RG
$'F;LBUF(5')WTtui). IMAIN - RKGST - WEIGHT FOR Total mass
$(RLBUF(6).UTas)f IMAIN - RKGST - WEIGHT FOR Ys
t>F.'LE:UF(7))UTyc)> IMAIN - RKGST - WEIGHT FOR Yc
J(RLBUF(S)»UTeb)j 'MAIN - RKGST - WEIGHT FOR Energy Bslsnce
i(F;LBUF(?)jWTmb)> 'MAIN - RKGST - WEIGHT FOR Momentum Bslsnce
$(RLBUF(10)»UTuh)» IMAIN - RKGST - WEIGHT FOR Ueff*Heff
$(RLBUF(ll)»XLI)f IALFH - LOWER LIMIT OF SEARCH FOR ALPHA
$(RLBUF(12)»XRI)» IALPH - UPPER LIMIT OF SEARCH FOR ALPHA
*
-------
? (RLBUF
4{RLBUF(
3!RLFUF(
*;SRCSS)'
20 )>SRCcut)..
21}'htcuU'
i end )fERr,'OBL
d) jcrfser) ?
( iiiand) jeps
F-50
1ALPKI - ERROR BOUND FOR RKGST
iALPHI - MAXIMUM STEP FOR RKGST
ISRC10 - OUTPUT error criteria
!£RC10 - min time for StesdSf4*STPHX
ISRC1G - min heisht for blanket
!SRC1 - mm height for blanket nest transfer
), INOBL - CONVERGENCE CRITERIA
ICRFG - Error criteria for building tables
ISRC1 - Coefficient in Air entrsinnient
eauivslence
5'. rlbufidJice)- ISRC1 - Coefficient gpsvity slumping EQ
I (F;LBUFa(iiend) .'Qelrhomin) ' stop spreed for delrhcKdelrhomin
' ! SZF - Initial step sire
$(rlfcufl(2)f=rerr)? ! SZF - Error criteria
5(rlbuf1(3)'szstpmx)r ! SZF - Maximum step size
$(rlbufl(4)«szszO) ! SZF - Initial value of rho*dellay*UHeff
rcuivalence
$Crlbuf4(l) »vus) .• ! Constant Av in SRC1
S(rlbuf4(2)yvub)» ' Constant Bv in SRC1
S(rlbuf4(3)jvuc)i ! Constant Ev in SRC1
$(rlbuf4(4)jvud). ! Constant Dv in SRC1
I(rlbuf4(5)fvudelta) ! Constant DELTAv in SRC1
character#40 OPNRUF
character DUMMY(II132)
DIMEMSICN RLBUF(iend)j rlbufi(iiiend)» rlbufa(iiend)
di^ansion rlbufl(Jend)
dimension rlbuf4(mend)
lexical vufla^
OPEN(UNIT=9,NAME^OFNRUP ? TYFE='OLD'»e r r=2000)
CM* READ A LINE AND DETERMINE ITS PURPOSE
C
I = 1
100 CONTINUE
READ (?> 1000 ,END=350) NCHAR» DUMMY
IF(DUMMYd) ,EQ. '!') GO TO 100
DECODE(2Q»1010fDUMMYfERR=400) RLBUF(I)
if(i ,eo. iendl)
GO TO 100
110
110 CONTINUE
READ ( 9 > 1 000 , END=350 ) NCHAR , DUMMY
2 — SYS$DEGADIS:ESTRTI.FOR
20-OCT-1987 00:09M4
-------
F-51
IF (DUMMY d) .EO. '"') GO TO 110
DECODE(20>1010?DUMMY;ERR=400) ptnobl
UGBLFT = INT(PTNOBL)
A "" i
12C CONTINUE
READiOOO.END=350) NCHAR,DUMMY
IF',DUMri:'(l) .EG. '! ') GO TO 120
DECODE >,20.1010 > DUMMY »ERR=400> RLBUFi(I)
1 = 1 + 1
if\i .en. niendl) goto 140
30 TO 120
Cm r;Ef;B A LINE AND DETERMINE ITS PURPOSE for /sprd.con/
C
1-50 I = 1
150 CONTINUE
READ(9-1000>END=350) NCHAR,DUMMY
IF(DUMMYCl) .EG. ''') GO TO 150
DECODE(20jlOiO?DUMMYjERRMOO) RLBUFs(I)
1 = 1 + 1
jf\i .eo. iieno'l) ioto 1
250 CONTINUE
READ(9..1000»END=350) NCHAR?DUMMY
IF(DUMMYd) .EG, '!') GO TO 250
"JECODE(20? 1010? DUMMY»ERR=400) slpco
C'
CM* READ A LINE AND DETERMINE ITS PURPOSE to fill /phicom/
3 — SYSIDEGADISJESTRTl.FOR 20-QCT-1987 00:09t44
-------
F-52
1^0 CONTINUE
F'EAD ( ? » 1 000 ? END=35Q ) NCHAR , DUMMY
IF(DL!hMY(i) ,EG. '!') GO TO 270
DECODE C'C"1 010 , DUMMY .£RR=400) Rphifl
ifhifl = int(rphifl)
275 CONTINUE
READ ( 9 » i 000 .. END =350 ) NCHAR j DUMMY
IF(DUM«Y(1) .EG. '!') GO TO 275
riECOriE(20.1C'iO>BUM«Y,ERR=400) dellsy
C?4::f. READ A LINE AND DETERMINE ITS PURPOSE to fill /vucom/
C
230 I = 1
2?0 CONTINUE
READ ( 9 ? 1 000 » END=350 ) NCHAR » DUMMY
IF(DUHMYd) .EG!, '!') 60 TO 290
DECODE ( 20. 1010»DUMMY»ERR=400) RLEUF4(I)
1 = 111
if(i ,est mendl) Soto 300
GO TO 290
c
C*** EXIT THE PROCEEDINGS
C
300 CONTINUE
CLOSE(UNIT=9)
RETURN
c
350 csll trsp(20)
C
400 CONTINUE
1000 FOR,1AT(Q»132A1)
1010 FORMAT(10X»G10.4)
C
:.000 c£,ll trsp(22)
END
— SYS$DEGADIS:ESTRTI.FOR 20-OCT-19S7 00:09:44
-------
F-53
ROUTINE TO GET RUN PARAMETERS FROM A FILE
SUBROUTINE ESTRT2(OPNRUP)
Implicit Resl*8 ( A-H> 0-Z )» Inte2er*4 ( I-N )
include '=ys$de23disJDEGADIS2. dec/list'
parameter ( iends= 13?
1 iendsl= iendsll?
2 iendb= 7?
3 iendbl= iendb-rl)
common
$/ERROR/SYOER , ERRO , SZOER , UT A 10 , UTQOO , WTSZO » ERRP i SrfXP ,
$ WTSZP»UTSYFjWTBEPfWTDH»ERRG»SMXG'ERTDNF»ERTUPF,UTRUHrWTDHG
S/STP/STPQ > STPP , ODLP t ODLLP , STPG . ODLG » ODLLG
S/CNQBS/NOBS
EQUIVALENCE
$'RLEUFU)»SYOER)r
f (RLBUF(2)jERRO).
*(RLEUF(3)»SZOER)f
$(RLBUF(4)»WTAIO>»
$(RLE:UF(5)»WTQOO)i
$(RLBUF(6)jUTSZO).'
•KRLBUF(7)fERRP)i
tCRLBUF(S)»SMXP)f
$(RLBUF(9)jUTSZP)>
{(RLBUF(lO)fWTSYPS
t(RLEUF(ll)»WTBEP)»
$(RLBUF(12)»UTDH)»
$(RLBUF(13)fERRG)j
$.
f(RL6UF(15).ERTD!\'F;>
f(RLBUF(16)'ERTUPF)»
{(RL£-:UF;i?).WTruh).
$ (RLBUF( iends
E 3 U I VALENCE
J(RLBUFl(l).-STPO>j
$(RLBUFl(2)fSTPP)«
1(RLEUFl<3)jQDLF')>
$(RLBUFK4)yODLLF)f
S(RLBUFK5)jSTPG)j
$(RLBUF1(6)»ODLG5»
! SSSUP
! SSSUP
! SSSUP
! SSSUP
'. SSSUP
! SSSUP
! SSSUP
! SSSUP
! SSSUP
! SSSUP
! SSSUP
! SSSUP
! SSSUP
! SSSUP
ITDNF -
ITUPF -
! SSSUP
i SSSUP
! SSSUP
! SSSUP
! SSSUP
! SSSUP
i SSSUP
' SSSUP
) ! SSSUP
- RKGST - IN
- RKGST (DBS)
- RKGST (DBS)
- RKGST (OBS)
- RKGST (OES)
- RKGST (OBS)
- RKGST (PSS)
- RKGST (PSS)
- RKGST (PSS)
- RKGST (PSS)
- RKGST (PSS)
- RKGST (PSS)
- RKGST (SSG)
- RKGST (SSG)
CONVERGENCE
CONVERGENCE
- RKGST (SSG)
- RKGST (SSG)
- RKGST (OES)
- RKGST (PSS)
- RKGST (PSS)
- RKGST (PSS)
- RKGST (SSG)
- RKGST (SSG)
- RKGST (SSG)
TIAL SY
- ERROR BOUND
- INITIAL SZ
- WEIGHT FOR AI
- WEIGHT FOR Q
- WEIGHT FOR SZ
- ERROR BOUND
- MAXIMUM STEP
- WEIGHT FOR SZ
- WEIGHT FOR SY
- WEIGHT FOR BEFF
- WEIGHT FOR DH
- ERROR BOUND
- MAXIMUM STEP SIZ
CRITERIA
CRITERIA
- WEIGHT FOR RUH
- WEIGHT FOR DH
INITIAL STEP
INITIAL STEP
RELATIVE OUTPUT DELTA
MAXIMUM DISTANCE TO OUT
INITIAL STEP
RELATIVE OUTPUT DELTA
MAXIMUM DISTANCE TO OUT
1 — SYS$DEGhDIS:ESTRT2,FOR
20-OCT-1987 OOJIOJZO
-------
F-54
chancier*-;:' CFNRUP
ch^rrrter du,i,iii-'.l :i32>
DIMEVcIGN RLBUF (lends) ..RLBUF1 (lendb)
OPEN(UNIT-?«Ni-;ttE=OFNRUP> TYPE=' OLD')
CUT FIRST. FILL RLEUF
CUy READ A LINE AND DETERMINE ITS PURPOSE
C
T = 1
100 CONTINUE
F:E'ilH9,1000,-END=300) NCHAR»DUMMY
IF(DU«MY(1) ,EQ, '!') GO TO 100
l!ECODE«20»1010»DUMMYjERR=400) RLBUF(I)
1 = 111
Ir(I .EQ. isndsl) GO TO 200
GO TO 100
C
NOiv'.. FILL RLBUF1
210 CONTINUE
REAH(?»1000,END=300) NCHAR»DUMMY
IF(DUMMYd) .EQ, '!') GO TO 210
rECODE(20»1010»DUMMY>ERR=400) RLBUFKI)
I = I f 1
IF(I ,EQ. iendbl) GO TO 260
GO TO 210
r
•—•
Ct** HOU» PICK UP NOBS
r
4_
260 CONTINUE
PEAD(9.1000»END=300) NCHAR»DUMMY
IF'DUNMY(l) ,EGJ. '!') GO TO 260
H£CQDE(20>lG10rDUMMY»ERR=400) RBUF
NOES = INT(RBUF;
r
u
C*t« EXIT THE PROCEEDINGS
CLOSE(UNIT=9)
RETURN
p
300 cell tr3p(20)
•400 CALL trs?(2l)
C
1000 FORMAT(Qil32Al)
1010 FORMAT* 10X..G10,4)
END
i-ttl
SYSJDEGADISJESTRT2.FOR 20-OCT-1987 00510:30
-------
F-55
C ROUTINE TO GET RUN PARAMETERS FROM A FILE
r
^.
SUBROUTINE ESTRT2SS(QPNRUP)
Implicit Real*8 ( A-H, 0-Z )> InteSer*4 ( I-N )
c
include 'sys$de2sdis:DEG3dis2,dec/list'
c
P3rsmeter( iend3= 18?
1 iend3l= iends-Hf
2 iendb= 7>
3 iendbl= iendb+1)
C
COMMON
*/ERROR7SYOER»ERRP•SMXP,UTSZPFUTSYP>UTBEPFUTDHTERRG,SMXG»
$ WTRUHfWTDHG
f /STF7 STF'P i ODLP > ODLLP»STPG > ODLG»ODLLG
ch^rscter-MO OPNRUP
character DUHMY(i:i32)
DIMENSION RLBUF( lends) jRLBUFKiendb)
C
OPEN(UNIT=9»NAME=OPNRUPfTYPE=/OLD')
C
CUt FIRST. FILL RLEUF
C
Cm READ A LINE AND DETERMINE ITS PURPOSE
C
I = 1
100 CONTINUE
READ (9.«1000 > END=350) NCHAR, DUMMY
IF(DUMMYd) ,EQ. '!') GO TO 100
DECODE(20.1010>DUKMY»ERR=400) RLBUF(I)
1 = 1 + 1
IFDUMMY
IF(DUMMYd) .EQ, '!') GO TO 210
DECODE (201101 OF DUMMY »ERR=400) RLBUFHI)
1 = 111
ifd.ea. iendbl) 2oto 300
GO TO 210
C
eye
YS$DEGi'-.DIS:ESTRT2SS,FOR 20-OCT-1987 00:iO:55
-------
F-56
W EXIT THE PROCEEDINGS
CONTINUE
?sOer =
errp =
£IJI;,P =
wtszp =
wtsyp =
wtbep =
wtDH =
errs =
2in;r5 -
utRUH =
wtDHG =
StPP =
odlp =
ocillp =
stp2 =
cc'12 =
odllsi =
rlbuf (1)
rlbuf(7)
rlbuf(8)
rlbuf(9)
rlbuf(lO)
rlbuf(ll)
rlbuf (12)
rlbuf (13)
rlbuf (14)
rlbuf (17)
rlbuf (IS)
rlbuf 1(2)
rlbuf 1(3)
rlbuf 1(4)
rlbuf 1(5)
rlbuf 1(6)
rlbuf 1(7)
! SSSUF
i SSSUP
! SSSUP
! SSSUP
! SSSUP
! SSSUP
! SSSUP
! SSSUP
! SSSUP
! SSSUP
! SSSUP
! SSSUP
! SSSUP
! SSSUF
! SSSUP
! SSSUP
! SSSUP
- RKGST - IN
- RKGST (PSS)
- RKGST (PSS)
- RKGST (PSS)
- RKGST (PSS)
- RKGST (PSS)
- RKGST (PSS)
- RKGST (SSG)
- RKGST (SSG)
- RKGST (PSS)
- RKGST (PSS)
- RKGST (PSS)
- RKGST (PSS)
- RKGST (PSS)
- RKGST (SSG)
- RKGST (SSG)
- RKGST (SSG)
CL05E(UNIT=?)
RETURN
^
•r
350 call lrap(20) ! prsmsture EOF
-•00 CALL tTCP(21)
lOvO FORMAT(Q.132Hi>
1010 FORMAT(1 OX,G10.4)
ERROR BOUND
MAXIMUM STEP
WEIGHT FOR SZ
WEIGHT FOR SY
UEIGHT FOR BEFF
UEIGHT FOR BEFF
ERROR BOUND
MAXIMUM STEP SIZE
UEIGHT FOR BEFF
UEIGHT FOR BEFF
INITIAL STEP
RELATIVE OUTPUT DELTA
MAXIMUM DISTANCE TO OUT
INITIAL STEP
RELATIVE OUTPUT HELTA
MAXIMUM DISTANCE TO OUT
2 — SYSJDEGADIS:ESTRT2SS.FOR
20-OCT-1987 OOJIOISS
-------
F-57
F'OUTIr'E TO GET RUN PARAMETERS FROM A FILE
SUBROUTINE ESTRT3(OPNRUP)
Implicit Res 1*3 ( A-H* 0-Z )» Inte3er*4 ( I-N )
COMMON
?.THLAG/CHECKl?CHECt;2jAGAINrCHECK3?CHECK4>CHECKS
t/ccni_=i2;:/ 3i2;;_coeff isi2x_?ow»sisj;_min_dist>sisx_fIss
T/ERROR/ERT1.. ERDT • ERNTIM
EQUIVALENCE
S(RLBUF(l).»ERTl)j "FIRST SORT TIME - USER OPTION
$(RLSUF(2)iERDT>, "SORT TIME DELTA - USER OPTION
$(RLBUF(3)jERNTIM) 'NUMBER OF SORT TIMES - USER OPTION
LOGICAL CHECKl»CHECK2iAGAINiCHECK3fCHECK4»CHECKS
chsrscter DUMMY(1t!32)
chsrscter*40 or-nrup
DIMENSION RLBUF(3)»RBUF(6)
OPEN (UNI T=°..NAME=OPNRUP,TYPE=' OLD')
READ A LINE AND DETERMINE ITS PURPOSE
I = 1
100 CONTINUE
READ(5>1000»END=300) NCHAR,DUMMY
IF(DUMrtYd) ,EQ. '!') GO TO 100
DECODE(20»1010>DUMMY»ERR=400) RBUF(I)
1 = 111
GO TO 100
i"1
<-.
CW# EXIT THE PROCEEDINGS AND DETERMINE CHECKS
300 CONTINUE
C
DQ 310 I = 1..3
310 RLBUF(I) = RBUF(I)
CHECKS = .FALSE, ! IN ORDER FOR FLAG TO WORK
IF(RBUF(4> ,EQ, 1.) CHECKS = .TRUE,
C
:-i2:;_fls3 = rbuf(5)
CLOSE(UNIT=9)
RETURN
C
100 CALL tr5r-(21)
1000 FORMAT(Q»132A1)
3010 FDF:HAT(10X»G10.4)
END
stn
1 — 5YS$DEGADIS:ESTRT3.FOR 20-OCT-1987 00*. 11:14
-------
F-58
C
C SUBROUTINE GAMMA
C
c. , .... t ,,,.,, ft,,,,,..,,,,,,,,,,,,,,,.,,,,,,,,,,,,,,,,,,,,,,,,
C
c This routine was originally supplied by Digits! Eauipment
c Corporation as part of the Scientific Subroutine Package
c available for RT-11 ss psrt of the Fortran Enhancement
c Package. It wss upgraded for use in this ^a
c
C PURPOSE
C COMPUTES THE GAMMA FUNCTION FOR A GIVEN ARGUMENT
C
C USAGE
C GF = GAMMA(XX)
C
C DESCRIPTION OF PARAMETERS
C XX -THE ARGUMENT FOR THE GAMMA FUNCTION
C
C IER-RESULTANT ERROR CODE WHERE
C IER=0 NO ERROR
C IER=1 *X IS WITHIN ,000001 OF BEING A NEGATIVE INTEGER
C IER=2 XX GT 34, 5 j OVERFLOW
C IF IER ,NE, 0 PROGRAM TAKES A DIP IN THE POOL!
P
w
C REMARKS
C NONE
C
C SUBROUTINES AND FUNCTION SUBPROGRAMS REQUIRED
C NONE
C METHOD
C THE RECURSION RELATION AND POLYNOMIAL APPROXIMATION
C BY C, HASTINGS* JR. > 'APPROXIMATIONS FOR DIGITAL COMPUTERS'*
C PRINCETON UNIVERSITY PRESS , 1955
C
C MODIFIED TO FUNCTION FORM FROM ORIGINAL SUBROUTINE FORM
C
C ............................... ,,,,,. .................. . ........
C
FUNCTION GAMMA(XX)
Implicit Real*8 ( A-Hj 0-Z )» Inte2er*4 ( I-N )
IF(XX-34.5)6f6i4
4 IER=2
GAMMA=1,E33
1 — SYSSDEGADIS: GAMMA, FOR 20-OCT-1987 00:ilJ25
-------
F-59
GO TO 1000
6 V = XX
EF.R=1.0E-6
IER=C
6i'-,hMA=l,0
IFCX-2.0)50f50..15
10 IF',X-2,0)110.110.15
15 X-X-1,0
3t'ihMA=GA««A*X
30 TO 10
?0 !r(X-l,0)60»120>110
l SEE IF X 13 NEAR NEGATIVE INTEGER OR ZERO
cO IF(X-ERR>62»62>80
62 Y=FLOAT(INT(X))-X
IF(AES(Y)-ERR)130jl30>64
64 IFC1.0-Y-ERR>130»130»70
C
C X NOT NEAR A NEGATIVE INTEGER OR ZERO
C
70 IF(X-l,0)SO»80illO
30 GAMMA=GA,1«A/X
X=XT!.O
GO TO 70
110 Y=<-1,0
GY=1.0iY*(-0,5771017+Y*(+0,9858540+Y*(-0,876421SiY*
$aO»8328212+Y*(-0,5684729+Y*(+Ot2548205iY*(-0.05149930))))
GAM«A=GAMMA*GY
120 RETURN
130 iER=l
100: CONTINUE
IF(IER.EQ.l) WRITE(SfllOO)
IF(IER.EQ,2) WRITE(5»1110)
1100 FORhAT(5X,'7GAHHA?—ARGUMENT LESS THAN 0,000001')
1110 FORHAT(5X»'?GAM«A?--ARGUMENT GREATER THAN 34.5—OVERFLOW)
CALL EXIT
END
tit*
2 — SYS$DEGADIS:GAMMA,FOR 20-OCT-1987 00:11:25
-------
F-60
C SUBROUTINE TO ESTABLISH THE TIME SORT PARAMETERS
C
SUBROUTINE GETTIM
Implicit Real#8 ( A-H? 0-Z )f InteM ( I-N >
include '=ys*degsdis:DEGADIS3.dec/list'
C
COMMON
S/SSCON/ NRECCroaxnob.2>jTO(iTi3xnob)»Xv1NTIM»ISTRT
$/PARMSC/ RM»SZM,EMAXfRMAX.TSC1,ALEPHf TEND
f/PKLAG/ CHECKlfCHECK2fAGAIN»CHECK3»CHECK4»CHECK5
S/ERROR/ ERT1»ERDT»ERNTIM
5/ALP/ ALPHAjslFhil
S/CNOBS/ NOBS
C
LOGICAL CHECK1»CHECK2'CHECKS»CHECK4»CHECKS»AGAIN
P
\_
DATA Tl/O,/»DT/0,/f TF/0./
C
«** IF CHECKS IS SET, GET THE TIME SORT PARAMETERS FROM /ERROR/
C
IF(,NOT*CHECKS) GO TO 90
Tl = ERT1
DT = ERDT
NTIM = INT(ERNTIM)
GO TO 95
This subroutine sets the default time sort windows.
The first sort time is set for potential low wind speed esses»
while the Isst sort time is set for potential hish wind speed
esses. The first sort time is taken to be when the first
observer passes through ;;=RMAX, The last sort time is taken
C>;:tt to be when the last observer pssses through ;;=6*RMAX.
The default value for the number of sort times is set to 10.
Obviously? these values generate some sort times which will be
useless; hopefully> these values will show the user where to
look on the next 20 3round.
The number of times has been doubled to 20 and the time interval
his been doubled in order to give more information for lower
concentrations (for the toxic gas problem), tosj5raarS6
C
90 CONTINUE
C
i — eye
YSfDEGADISJGETTIM.FOR 20-OCT-1987 OOJllM?
-------
F-61
Tl = T0(l> f <2,*RMAX)«(1,/ALFHA1)/ALEFH
TF =• TO (NOES) T •5,.f.RrtHX)**(l,/ALPHAl)/ALEFH
NTIh = 20 ! for toxic sss problem
DT = (TF-T1)/FLOAT(NTIM-1)
DT = 2.1'(TF-T15/FLOAT(NTIH-1) ' for toxic dss problem
DT = FLCAT:iNT(DTi,5))
IF(DT .GE, 5.) GO TO 95
DT = 5.
MTIM = INT((TF - TD/DT) f 1
-5 CONTINUE
Tl = FLQAT(IHTCTl)) IMAKE Tl AN INTEGER VALUE
II = ir,s;;( ntinu2) ! fill in the lowest two times at lesst
DO 100 I = 1,11
TIM(I) = DT*FLOAT(I-1) + Tl
100 CONTINUE
RETURN
END
2 — SYS*DEGADIS:GETTIM.FOR 20-ocT-i?87 00:11:47
-------
F-62
C
C
C SUBROUTINE TO ESTABLISH THE TIME SORT PARAMETERS
C
SUBROUTINE GETTIM
Implicit Real*8 ( A-H» 0-Z ) .• InteSer*4 ( I-N )
include 's«s*de«J3dis:BEGADIS4,dec/list'
C
COMMON
$/SSCON/ NREC (msxnob»2)»TO Cmsxnob)»XV (mexnob)
$/cdos/ idosj dosdisx(ndos)> dosdis(4»2»ndc3)
$/SORTIN/ TIM(ffl3xnt)»NTIM»ISTRT
S/PARMSC/ RH >SZM,EMAX,RMAX»TSC1jALEPH»TEND
$/PHLAG/ CHECK1.CHECK2>AGAIN>CHECK3,CHECK4.CHECKS
$/ERROR/ ERTliERDTfERNTIM
$/ALP/ ALPHAjslphsl
*/CNOBS/ NOBS
C
LOGICAL CHECK11CHECK2»CHECK3»CHECK4>CHECKS..AGAIN
C
DATA Tl/0./iDT/Q./»TF/0./
C
C*** This subroutine sets the time sort windows for concentration ss
C s function of time st a given position.
C
dist = dosdisx(idos)
C
Tl = ts( T0(l)i> dist) ! time first observer crosses o'ist
TF = ts( T0(nobs)f dist) ! time last observer crosses dist
NTIM = 40
C
DT = l.DO)
NTIM = min( INT((TF - TD/DT) + 1» 40)
C
Tl = FLOATdNT(Tl)) IMAKE Tl AN INTEGER VALUE
write(lunlog»1000) tl> tf> dt> dist
1000 formate tlJ '»1PS13.5»' tfj 'flp3l3.5»' dt: '»lp^l3,5>
$' dist: ',lpsl3,5)
C
II = m3;:( ntim»2) ! fill in the lowest two times st lesst
DO 100 I = 1»II
TIM(I) = DT*FLOAT(I-1) t Tl
100 CONTINUE
C
RETURN
END
-- SYS$DEGADIS:GETTIMDOS.FOR 20-ocT-i?87 01:27:22
-------
F-63
SUBROUTINE HEAIKsmsssO)
Implicit Re£l*3 ( A-H? 0-Z )> Inte2er*4 ( I-N )
include 'sssSdegsdistOEGABISl .dec'
include '(fssdef)'
COMMON
$/GEN3/ RADG ( 2 > msj.'l ) > QSTR ( 2 j ms;;l ) ? s rcden < 2 » msxl ) i srcwc ( 2 > IBS::! ) ?
$ srcw£(2jRisxl) >srcenth(2? msxl)
f/TITL/ TITLE
I/6EN1/ PTIME(i2en)? ET(i^en). RlT(i2en>T PUC(i^en)» PTEMPdSen) ,
$ PFRACV(i2en)» PENTH(i^en). PRHO(i^en)
I/GEN2/ DEN(5»i^en)
f/ITI/ TlfTINP»TSF;C»TOES»TSRT
$/ERROR/ STF'INrERBNrijSTPMXjWTRG>WTtnijWTysTwtycjwtebfwtmbfWtu
$ XRI»EP3fZLOU>STPIKrZ..ERBND2;STPMXZfSRCOER.srcssfsrccut»
$ ht cut < ERNOBL t NOBLp t » c rf 2e r » e^si 1 on
J/PARM/ UOs ZO f ZR j«L»USTAR»KfG»RHOEfRHOA» DELTA* BETA »GAMMAF»CcLOU
i/cotTistiTi/ i = t?b j tsiiib ) psffib f humid ? isof 1 j tsurf > ihtf 1 jhtconutf l>wtcc>
* n ; J iii s r c
5.'cDin_;£/ ess »slen?suid?outcc;outsr ioutb>outl jewel >swsl?senl »srhl
f /r--hl32/ check 1 r check2' 3^3 in»chscK3 y check4 j check5
$-'NEMP/ POUNIiN; FOUND
S/ALP/ ALPHA rslphsl
?/5lfhccsi/ islf- f 1 jelpco
t/Fhicc.'T;/ ir-hiflf dell^y
i/cf rd_Ton/ ce> delrhomin
i.h5r£ct.er«'30 TITLE(4)
chsr£cierJ'1 round
ch£-r3cter*24 TINP»TSRC>TOBS»TSRT
ciisrscteiv'f3 3s5_nsme
ch£rsctsr*l 5tsbil(6)
c!' ;rjclev*24 id
logical check 1 )Check.2j3^3in»check3f check4 »check5
REALtS K»ML
dsts iPsrm/0/
C
ifdpsrm .en. 1) goto 170
URITE(S»1100)
1100 FORMAT(1HO> '««****************' »9X»'U OA_DEGADIS'»
$2Xi'M 0 D E L 'f2X»'0 U T P U T ',2X»'- - 'i2Xi'V E R S I 0 N ',
—
SYS$DEGADIS:HEAD.FOR 20-ocT-i?S7 00:12:03
-------
F-64
r:x - ' 2 , c ' .- s.x ? ' ******************** ' )
c
WRITECSfllll)
c
WRITERS ? 1102) is re
1102 FORMAT (1H ,' *##************' .23X?
$ •• * m« mmm ' » i x > ?24 » i x >
$ ' *************** ' > 23X • ' *************** ' )
J~\
L
yRITE(B»lill)
r
l_
tiRITE(S"1112) TINP
URITE(S»1114) T3RC
IF(tOBS(i:2),NE»' ' .end. .not.check4) URITE(8»1116) JOBS
IF(tOBS(i:2).NE.' ' »snd. check4) WRITE<8»1117> TOBS
IF(tSRT(i:2) ,NE. ' ') URITE(Sjlll8) TERT
1112 FORNAK1H r'Dsts input on'»22X»s24)
1114 FORKATdH , 'Source pro^rsm run on'»14X.s24)
1116 FORMATdH »'Pseudo Stesda-Stste proSrsm run on Ss24)
1117 FORMATdH ? 'Steeda-State pro^rsni run on'>7x»s24)
HIS FORMATdH ..'Time sort. ?rogr3m run on'»HX»s24)
URITE(8jllll)
r
write(S.'lll?)
111? fori»3t(//f
llh .•10;;-22( '*****')>/»
21h f!0x» '*'ft!21f '*'»/»
31h '10.-;j '*:'
21h flOx»'*'
21n jiOj;j'*'jtl21r'*'./>
21h .-10:;.'*'.t20f '>'»t25»'All Calculations sre lim'»
3'ited to circular liauid sources, ' >t!21 t '*'>/?
21h ;10xf'*'>tl21»'*'T/»
llh jlO;;.'22( '*****')•//)
UR!TE(3»111Q)
UF;ITE(S»1111)
C
1110 FORHATdHO.lOXj 'TITLE BLOCK')
1111 FORMATdH )
C
DD 100 I = 1.4
U'RITE(Sjll20) TITLE(I)
100 "OrlTINUE
r
t/
1120 FORMATdH ,A80)
r
URITEC8»1111>
WRITE<3»1130) UO
URITE(8ill40) ZO
WRITE(S>1150) ZR
2 — ?YS$DEGADIS:HEAD.FOR 20-OCT-1987 00:12:03
-------
F-65
urite(S»1155) stsbildstsb)
'. f U:l .ne. 0.) then
WRITE(8.1160l HL
alse
nrite(8»1161)
r:r,dif
URITE(Sfil70) DELTA
URITE(8rllSO) BETA
yRITE<8,1190) ALPHA
kRITE<3fl!92> USTAR
LlF1ITE(8fll?4) tssib
if'isofl,ea,0 .snd, ihtfl.ne.O) write(8?1195) tsurf
WRITE(3.1196) pamb
I*F:ITE<8'119S) humid
VSPOPP = 6.029Se-3# exp<5407,* (1,7273,15- 1,/tsmb)) ! etm
relhuroid = 100,* hijmid/(0,622#vsForF / (psmb- VSPOPP))
write(8-1199) pelhumid
C
1130 FORMATUH fSXi'Wind velocity st reference height '»20X»F6,2>2X»
$'m/s')
1140 FORMATdH »5X>'Reference height '»37X»F6.2»2Xf'm')
1150 FOR«AT(1HO?5X>'Surface roughness length 'j25XflP610,3i2X»'ra'-
1155 FORHAT(lHOj5X»'Pssouill Stability class '»25X»4x»sl)
1160 FORMAT<1HO»5Xf'Menin-Obukhov length '»29Xi1PG10.3»2X»'m')
1161 FORMAT(lHO»5X»'«onin-Obukhov length '>31X>'infinite')
1170 FORMATdH »5X»'Gsussisn distribution constants '»4X>'Delta',
$10XjF9,5f2X,'m')
1180 FORMATdH «5Xf 32Xf 4Xr'Bets'»11X»F9.5)
1190 FORMATdHOj5X»'Uind velocity power lew constant'»4X»'Alpha',
$10X?F9.5>
1192 FORMAT(1H ?5Xj'Friction velocity'i15X»4X»5X>10X»F9.5>2X»'m/s')
1194 FORMAT(lHO»5Xf'Ambient Temperature '»34X»F6,2f2X»'K')
-1195 FORMAT(1HO»5X?'Surfsee Temperature '»34X»F6.2»2X»'K')
1196 FORMAT<1H »5X»'Ambient Pressure '»37X>F6.3»2X»'atra')
1193 FORMATdH »5X«'An.bient Absolute Humidity' »25XilPG10,3»2X»
?'kg/kg BDA')
1199 FORMATdH »5X' 'Ambient Relative Huinidita'»25X>4XiF6.2»2X>'%')
i—
\_-
WRITE(Sfllll)
C
if(iscfl ,eQ, 0) goto 135
WRITE(3.1200)
WRITE'3,1205)
ii = -1
I'C 130 I = l>igen
IF'iDENdyD.gt, 1.) 3oTO 143
ii = ii-i-1
if(ii,SQf 3) then
wpite(8«1211)
ii = 0
endif
3 ~ SYS$DEGADIS:HEAD,FOR 20-OCT-1987 00:12:08
-------
F-66
130 WRITE(8«121Q) DEN( 1 » I) »DEN(2» I) »den(3r i )
:3oto 14S
135 write!?; 1207)
write*B..1208)
ii = -1
DO 13S I = IfiSen
IF(DEN(ljI).2t, 1.) ScTO 14S
11 = an
ifdi.eo. 3) then
write(Sil211)
ii = 0
133 WRITE* 3i 1212) OENdrl) »DEN(2>I) »den*3»i> >den*4>i)»den(5>i)
143 continue
C
1200 FORMAT* 1H »5X> 'Input: ' »6X»3x> 'Mole fraction' »4x»
1 'CONCENTRATION OF C'rdX.'GAS DENSITY')
1205 FORMAT* 1H »14X»20x»2(13X» 'k2/m**3' ) )
1207 FORMAT* 1H »5X> ' Adisbstic Mixing: ' »3x> 'Mole f rsction'f3x>
1 'CONCENTRATION OF C'?6X>'GAS DENSITY' »5x»
1 6x» 'Enthslpy'»6x»4x» 'Tempersture')
1203 FORMAT (1H »14Xf20x» 2* 13X» 'K2/mr*3' ) r7;;jS;c. ' J/K2' >3;;»9x.. 'K' )
1210 FORMAT* 1H i 14X»3*12X5F8.5) )
1211 forir,at(lH )
1212 FQRMATdH »14Xj3*12XjF3.5) f6xj3x»lpjJl3.5»7x»lp<3l3,5)
C
!vlRITE*Sjllll)
u ri te * S ? 1 233 ) 3ss_mw » gss-temp • sss_ rhoe > gss_CPk > ^SS_CPP »
$ S?S.ufl»S3S_lfl»g3S_ZSP
WRITE(Sillll)
WRITE (8. -1220) dasssO
WRITE (S? 1230)
w
DO 150 I=lfIGEN
IF*PTIME(I).EQ,POUNDN) GO TO 160
150 WRITE(8»1231) FTIME*I) >ET(I) , R1T*I) » PWC(I) »PTEMP(I) i
f PENTH(I)
IdO CONTINUE
C
1220 FORMAT*1H ..'Source input data points', //>
$ Ih ?15;:» 'Initial mass in cloud: ' »lp2l3.5r//»
i Ih »7Xf 'Time'»10X»'Cont3*in3nt'j
$ 7X> 'Source Rsdius' j2xr3x> 'Contsminsnt' »4);»
$ 3;;, 'Temperature' >4x»5x» 'Enthalpy' »5x»/f
$ lx»18xf4x»'M3ss R3te'f5x»13xf2x»'M3SS Fraction' »3x)
1230 FORMATdH f 9X» 's' »15X> 'k^/s' >16X» 'm'iSx» ' k3 contsm/ks mix '»8x»
$ 'K'»9x»7x»'J/kgS7x)
1231 FORMATdH »6(3X»1FG12,5»3X))
1233 Fornist(lHO»5xf 'Specified Gss Properties: ',//,
HOxj'Moleculsr weight: ' »T65flpSl3.5>/>
110;;,'Stor3Se temperature: ' »T65flpgl3.5> 'K' »/»
4 ~ SYS$DEGADIS:KEAD.FOR 20-OCT-1937 00:12:03
-------
F-67
11 J;:> 'DsriSiti' at storage temperature and srt.bient pressure:'?
1 T,-.3 j 1 r- 2 1 3 . 5 » ' K£/m**3 ' » / >
110"' 'Mean heat capacity constant! ' »TA5? lF3l3,5»/f
HO*-,' 'Mean heet c£F£-c:.ty rower: ' >T65?lp2l3.5»/f
110::.- 'Upper niole frsction contour! ' »T65rlFSl3,5»/»
110-:> 'Lower mole fraction contour: ' jT65> lpgl3.5>/»
110;:« 'Height for iscfleths: ' fT65»lFSl3.5f 'm' F/>
12-! i foria£t(lhO>5;;j'Cslcul3tiori procedure for ALPHA! SI2)
12-12 fcrnistdhOfEx-'Entrsir.nient prescription for PHIt SI2)
12-14 forinst ( lhO'5::' 'Lsyer thicknens rstio used for sversSe depth! 'i
1 1P313.5)
1250 forniat(lhO-5x? 'Air entrainroent coefficient used! '»f5,3)
1251 forjsstdhOfSx.'NON Isotherrasl cslculstion' >
1252 fc:-niet'.lhOf3;:r 'Gravity slumping velocity coefficient used! 'jf5,'>
1233 format (lhO«5xf 'Hest transfer calculated with fixed coefficient!
1 Ipgl3»5»' J/m**2/s/K')
1254 forinst(lhO»5;tj 'Heat transfer not included')
1255 fcrniat(lhOF5;:>'Hest transfer calculated with correlation! '»I2)
1256 foruiatdhO'5;:.' 'Isothermal calculation')
1257 forn.at(lhOj5xj 'Water transfer calculated with fixed coefficient!
125S fcrmetdhO;5;r. 'Water transfer not included')
125? fori»atdhOf5;;j 'Water transfer calculated with correlation')
C
KRITE(3>1111)
write(8f!241) ialpfl
write(S..1244) dellsa
nrite(3?125C') ep-silon
write<9»1252) ce
if(ii.cfl,ee, 0) write(8»1251)
if -isofl.ne. 0) write(3»1256)
if(ihtfl.lt. 0) write(3»1253) htco
ifdhtfl.ecu 0) write(3» 1254)
if ( ihtfl.it, 0) write(S»1255) ihtfl
irdwtfl.lt. 0) write(Sf!257> wtco
ir(iwtfl.eci. 0) write(8j 1253)
if(iwtfl,5t, 0) write(3»1259)
URITECSjllll)
1?0 .or,Linue
i.f ( ,riot,check4) return
RAD = 3QRT(2.*SLEN*SWID/pi)
UF: I TECS? 1300) ESS i RAD
WRITE(S»1320) SLEN»SWID
URITE(3»1340) OUTCcfOUTSZ>astar
nrite(3jl350) swclisw3l»senl»srhl
WRITE(3>1360) OUTL»OUTB
5 -- SYEiDEGADIS! HEAD, FOR 20-OCT-1937 00! 12! 08
-------
F-68
C
r
C
1300 FQRMATUHO*'Source strength Ck«/s3 : 'f18X,lPG13,5iT60>
f'Eauivslerit Primary source rsdius CmJ I '*5xf1PG13.5)
1320 FORHATdH >'Eauivslent Primary source length Cm3 : 'j4X»lFG13,5>
$T60»'EQUivslent Primsry source hslf-width Cm: I '»1X»1PG13,5)
1340 FORHAT(/r' Secondary source concentration Ckg/in**33 J S
$!PG13.5rT60>'Secondary source S2 Cm3 J '»18X»1PG13,5»/A
1 ' Contsminent flu:; rete: 'jlpgl3,5>/)
1350 forroat(/j' Secondary source IT.SSS fractions.,, contaminant I '<
1 Ip£5l3.6j2::»' airt S1^13,5»/i' '»10x»' Enthalpy? '»
1 Ir-2l3.5r5.xj' Density? '..1P313.5./)
1360 FORMATdH »'Secondary source length Cm3 J '»13X»lPG13.5fT60>
f'Secondary source half-width Cm] { 'ilOXi1PG13.5)
C
C
RETURN
END
SYSIDEGADIS:HEAD.FOR 20-OCT-1987 00:12:08
-------
F-69
is snd incomplete ssmma function
c
c routines included in this file!
c GAMING Incomplete ssmnis function
c GAMMLN Natural log of the 33mms function
c GSER computstion procedure
c 3CF computstion procedure
c
c, .. ,,..,,..,,..,.,..,,
c
c These functions return the value for the incomplete Gamma function
c with the arguments (ALPHA>BETA). The functional values are
c calculated with either 3 series representation or a continued
c fraction representation. These routines sre based on?
c
c Press? W.H.j B.P. Planners S.A. Teukolskyi and U.T, Vetterlin^j
c 'Numericsl Recipes"i Cambridge University Press? Cambridge?193A.
function 2sminc(alphaibeta)
irar-licit RealtS (s-h.« o-z)> inte^er*4 (i-n)
cW* ensure the arguments are within the proper bounds.
c
if( beta,It,0. »or, alpha,le.O,) then
write(6>9000) alpha-beta
9000 formstC GAMING? Arufiments are out-of-bounds, ALPHA! '»
$ IPGIZ.S,' BETA: '?iFGi3,5>
STOP
end if
c
ctflf. determine which of the series or continued fraction representation
c is more appropriate,
L
if( beta .It. slph3-H. ) then
c i series
call gser( ae> slpha» beta» 2ln)
else
c ! continued fraction
call 2cf( aa> alphs* beta* aln)
33 = 1, - S3
endif
c
multiply the result by GAMMA(ALPHA) to Set the final value.
— SYS$DEGADIS:iNCGAMMA.FOR 20-OCT-1987 00:i7M2
-------
F-70
famine = a'e.\F ( dlos(£s) + gin)
return
end
c
c
L
subroutine ssert gsmser? slPhs? bets>
c
c This routine cslculstes the incomplete Zemins function using
c the series representation.
c
implicit realms (3-h?o-z)> inte^er#4 (i-n)
L
persiiieter CitKis;:=100> eps=l.d-9)
^ln = 2smiriln(slphs)
if (bets .It, 0.) then
'GSER? BETA is out-of-bounds,'
end if
if (bete ,ea. 0,) then
dsdiser = 0,
return
endif
cufii = l./slphs
del = sum
d3 100 n=lf itffiax
3P = 3P f 1 ,
del = del* bets /SP
sura = sum + del
if( dabs (del) .It. d3bs(sum)*eps) then
s;sijiser = suro#de;:p( -bet3-fslph3*dlog(bet3)
return
endif
100 continue
write(6i*> 'GSER? ALPHA is too Isr^e or ITHAX is too small.'
stop
end
c
c
c
subroutine 2cf( sismcfj slphs» bets> ^ln)
c
c This routine cslculstes the incomplete ^smms function usin3
c the continued frsction representstion.
2 -- SYSSDEGABISJINCGAMMA.FOR 20-OCT-1987 OOJ17M2
-------
F-71
c
implicit res 1*8 (5-h»o-z)T inte2er*4 (i-n)
L
parameter #) 'GCF? ALPHA is too large or ITHAX is too smsll.'
stop
end
c
c
c
function gsminln( alphs )
c
3 — SYSIDEBADISJINCGAHHA.FOR 20-OCT-1987 00:i7M2
-------
F-72
c This routine calculates ln( 3am!Ks( alpha) ) for s
c
implicit reeUS (s-h»o-z)f inteSer#4 (i-n)
c
dimension cof(6)
dsts cof»stp/76,180Q9173DOi -86.50532033DO» 24,Q1409822DO»
$ -1.231739516DO. 0,1208530030-2? -0.536382D-5* 2.50662827465DO/
dats hslf. one. f>f/0,5DO> 1,ODO» 5.5DO/
if( slF-hs ,H. 1) then
( sl?hs
return
endif
;:;; = slpha - one
in,?- = xx •{• fr-f
Imp - (xx f half) * dlo2(tmp) - tmp
Her = one
do 100 J=l»6
;;;; = ;;;; t one
;er = ser f ccf(J)/xx
100 continue
= tmp t
r-eturn
iti*
1 -- SYSSBEGADIStlNCGAMMA.FOR 20-OCT-1987 OOI17M2
-------
F-73
r
;- INPUT SUBROUTINE FOR DEGADIS MODEL
C
SUBROUTINE 10 ( tend i SrnsssO ? OPNRUP )
Implicit Resl*8 ( A-H» 0-2 )> Inte2er*4 ( I-N )
c
include 'sfs$deasdis:DEBADISl.dec'
C BLOCK COMMON
C
COMMON
$/TITL/TITLE
S/GEN1/ PTIME(i2en)» ET(i2en)y RlT(iSen)j PUCdsen)* PTEhPdgen)
$ PFRACV(igen). PENTH(isen) • PRHO(iSen)
I/GEN2/ DEN(5»i2en)
$/ITI/ TlfTINP»TSRCfTOBS»TSRT ____
$ /PARH/ UO , ZO , ZR » ML » USTAR i K > G » RHOE » RHOA » DELTA » BETA > GAMMAF , CcLOU
S g3S_
$/coi»3tiii/ istcbttsnibypsrabf humid > isof 1 jtsurf » ihtf l»htco> iwtf 1? wtcoi
$ hums re
f /com_= s/ ess ? s 1 en ? sw i d » ou tec > outsz » outb > ou 1 1
$/>hl 32/checkl .• check2 ? 3Ssi n » checK3 > check4 » checks
$/coiri_si^x/ si2x_coeff jsi2;c_pow?si
*/NEND/POUNDNiPOUND
f/ICNTL/ IPRINT-IOBSdO)
C
C
ch3recter*SO TITLEC4)
chsrsct9r*''1 pound
ch£r*cter*24 TSRC»TINP»TOBS»TSRT
REALMS MLrK
losicsl checkl jcheck2>s23irucheck.3icheck4?check5
r
chsrscter*40 OPNRUP
C
OPEN(UNIT^?> NAHE=OPNRUP» TYPE='OLD')
P
DO °0 1 = 1 7-1
READ(?f2000) TITLE(I)
90 CONTINUE
2000 FORMAT(ASO)
C
READ(9iif'.) UO.'ZO^r
r.23d(9»:t) istsb
READ(9j*) DELTA. BETA i ml
~ SYS*DEGADISJIO.FDR 20-OCT-1987 00! 18:20
-------
F-74
re sd ( 9 .< )' ) tsmb • F smb » hum i d
hums re = 0.
resdC??*) isofl>tsurf
resd(9»*) ihtfl-htco
rssd(9>#) iwtfljwtco
re1)
dsn(l»np+l) = 2.
r
\--
105 READ<9>*) CcLOW
C
resd(9f*) gmsssO
READ(9»*) NP
DO 110 1=1 »NF
READ(9f*) PTIME(I)»ET(I)»R1T(I)> PWC(I) >PTEMP(I) »PFRACV(I)
UA = <1.DO - FUC( !))/(!. DO + HUMID)
PENTH(I) = ENTHAK PWC(I)» WA> PTEMP(D)
CALL TPROP(-lfPWC(I)j UA»PENTH(I)» YC,YA»UM» PTEMP(I)j PRHO(I)»CP)
110 CONTINUE
TEND = FTIME(NP-2)
PTIME(NP + 1) = POUNDN
C
read ( ? i * ) checkl > check2? s^sin ? checks » check4 > checks
c
tobs = ' '
tsrt = ' '
READ(9»2010) TINP
2010 format (a24)
r
w
ir(check4) reso(9»#)
c
CLOSE(UNIT=9)
RETURN
END
***!
— 3YEfDEGADIS:iO.FOR 20-OCT-1987 00:i8J20
-------
F-75
SUBROUTINE IGT(OPNRUP)
IIBF licit Real*S ( A-H» 0-2 )» Inte2er*4 ( I-N )
C
include 'sysideSadisJDEGADISIN.dec'
c
COMMON
$/TITL/ TITLE
f/GENl/ PTIME(iSen)i ET(i2en)> RlT(i2en)» PUC(i2en)j PTEMP(igen)
$ PFRACV(i2en)» PENTH(iSen). PRHO(i2en)
$/GEN2/ DEN(5»i=!er.)
$/ITI/ TliTINP»TSRCfTOBSiTSRT
S/PARM/ UO»20j2RfMLjUSTARiK»G»RHOE>RHOAjDELTA»BETA»GAMMAF»CcLOU
$/com_2F TOP/ ^35_HiW?sss_te»p»23S_rhoe»sss_cpk.>SSS_CPF ^
$ 2ss_uf1»ges_lf1fSSS-ZSP»Sss_nsme
$/com_5S/ ess»slen»swidFoutccFoutssFoutbFoutl
f/PHLAG/ CHECK1F CHECK2F AGAIN F CHECK3 F CHECK4 F CHECKS
f/com_siS:;/ si2x_coeff »si2/_PowFsi3x_niin_dist»sis;:_fl3S
5/NEND/ POUNDNrPOUND
C
chsrscter^SO TITLED)
chsrscter*3 Sss-nsiue
chsrscter*4 Found
chsrscter*24 TSRC»TINPFTOBSFTSRT
C
REALMS ML»K
LOG ICAL CHECK1F CHECK"F AGAIN F CHECK3 F CHECK4 F CHECKS
C
character*(*) OFNRUP
chsrecter*40 STRING
cherscter#4 dummy
C
WRITE(611100)
URITE(6fillO)
C
Clf^ OPEN THE INPUT FILE
C
OPEN(UNIT=8 FNAME=OPNRUPF TYPE='NEW'>
$ C5rri3gecontrol = 'list'»recordtype='variable')
C
Crt* K'CU GET THE TITLE BLOCK
C
WRITE(6»1120)
URITE(iFll30)
C
DO 100 1=1F4
READ(5;1134) TITLE(I)
dummy = titled)
IF(dumnm(i:4) ,EQ, POUNDdM)) GO TO 110
WRITE(8»1135) TITLE(I)
1 — SYS$DEGADIS:iOT.FOR 20-OCT-1987 OOJ18M3
-------
F-76
100 CONTINUE
GO TO 130
C
110 CONTINUE ! FILL OUT THE BLOCK
II = I
DO 120 I = II>4
TITLE(I) = ' '
URITE(8fll35> TITLE(I)
120 CONTINUE
130 CONTINUE
C
Atmospheric parameters!
URITE(6fll40)
WRITE(6>1142)
READ(5»*> UOjZOfZR
URITE(S>1020) UOiZO»ZR
stability* averaging time for DELTA* and derived parameters
c
URITE(6fll50)
READ(5»1310) NCHARfSTRING
write(6»1152)
resd(5?#) avtime
timesv = drosxK avtimej 20»DO)
istsb = 4 ! default is D stability
IFCSTRING.en.'A' .or. string,eo.'a') istsb=l
IF(STRING.ea,'B' .or. string.eo.'b') istsb=2
IF(STRING,ea.'C' .or, string,eo.'c') istsb=3
IF(STRING.eQ.'D' .or, string.eo.'d') istsb=4
IF(STRING,ect,'E' .or. string.eo.'e') istsb=5
IF(STRING.ea.'F' .or, string,ea,'f') istsb=6
Soto(161jl62jl63fl64fl65.,166) istsb
161 delta = 0,224*(tiraesv/20,DO)**0.2DO ! A
ifCtimeev ,gt. 600,DO) delta = 0,443*(timesv/600,DO)**0,5DO
bets = 0,8?4
ml = -11,43 * zr#*0.103
sis;:_coeff = 0,02
sig:;_?ow = 1,22
si5;;_iain_dist = 130,
£cto 170
162 delts - 0.164*(time3v/20,DO)**0,2DO ! B
if(timesv .gt. 600.DO) delta = 0.324*:_coeff = 0,02
si3;;_pow = 1,22
sisl;;_niin_dist = 130,
^oto 170
163 delts = 0,109*(time3V/20,DO)**0,2DO ! C
if(timesv .at. 600.DO) delta = 0.216*(tiroe3Vx/600,DO)**0,5DO
2 ~ SYS£DEGABIS:iOT,FOR 20-OCT-1987 00118:43
-------
F-77
beta = 0.894
ml = -123,4 * zr**0,304
= i£;:_ccsff = 0.02
si2x_fow =1,22
= i3x_Riin_dist = 130.
*olo 170
164 celts = 0.071***0.5DO
teis = 0.394
isl = 123.4 * zr**0,304
= i£;:_coeff = 0,17
sigx-pow =0.97
sJ2;;_n;in_dist = 50,
EOtC 1?0
166 cielts = 0,036*(timesy/20,nO)**0,2DO ! F
if(tiBiesv .st. 600.DO) delts = 0.07i*ei2:;_coeff>si^x_pow»si^;:_mi
else
WF:ITE(6>1160) delts?bets»si^x_coeff»si2>;_powjsis=x_min_dist
end if
re3d(5>1310) nchsr»strin2
if 1600)
resd(5»#) delts
ioto 172
else if(string,ea,'b' ,or. string.ea,'B') then
write(6>1620)
resd(5»*) bets
goto 172
else if(string,ea.'!' .or, string.ea,'L') then
write(6f!660)
reed(5f*) ml
Sato 172
else if(string.ecu'c' .or, strins.ea.'C') then
3 — SYS$DEGADIS:iOT,FOR 20-OCT-19S7 OOtlSM3
-------
F-78
write<6»16?0>
resd(5f!T) si2;;_coeff
20 to 172
else if (string, eo. 'P' ,or» string. ea, 'P' ) then
write(6»1680)
resd(5f*) sig;:_pow
goto 172
else if (string. ea. 'm' .or. string. ea. 'M') then
write(6..1690)
reed(5?*) sigx_min_dist
goto 172
else if (nchsr.eo.O .or. string, ecu 'n' .or. string, ea. 'N' ) then
WRITE(8rlQ20) DELTA » BETA* ml
URITE(Sjl020) sigx_coeff jsigx_powfsigx_min_dist
else
goto 172
endif
snbient pressure? teniFerstures* snd humidity
w;-ite(6>1500)
tsn;b = tsinb f 273.15 ! K
v£F-orp = 6.0298e-3* exf*(5407.* (1./273.15- l./tamb)) ! stm
sat = 0,622*v3porp / (psrab- VSPOTP)
write(6»1580)
rs3d(5>1310) nchsr? string
if (string, ea. 's' .or, string. eo, 'A' ) then
write(6»1585)
reed(5?*) huuid
re 1 hum id = 100.*humid/s3t
write(6>1586) relhumid
Eoto 200
endif
write(6-1587)
resd'Sf*) relhumid
humid = relhumid/100. * sst
200 rhos = pemfa»:(l.-)-huinid)/(.002833t.004553*huiiiid)/tsmb
write(6>1588) rhos
write(8f 1025) tsnib»PsiDb>huiiiid
isofl = 0
ihtfl = 0
htco = 0.
iwtfl = 0
wtco = 0.
tsurf = tsrnb
write(6»2000)
pesd(5f!310) nchsr»string
if (string. ea. 'V .or. string, ea. 'y') then
-- SYSSDEGADISJIOT.FOR 20-OCT-1987 00:18:43
-------
F-79
isofl = 1
tsurf = tsitib
2oto 250
endif
c
write(6.-2020)
resd(5.-1310) nchsr>strin3
if (string.ea. 'Y' ,or. string, eo. 'y') then
write(6,2030)
read<5»*) tsurf
220 write(6f2Q40>
reed(5?1310) nchar»string
if(string.ecu 'V .or. strinsuea.'v') then
ihtfl = -1 ! constant value
write(6»2050)
reed(5»*> htco
else if(string.ea.'C' ,or, string.ea.'c' ,or» nchsr.ect.O) then
ihtfl = 1 ! locsl correlstion
else if (string, ea. 'L' .or. strinsi.ea.'!') then
ihtfl = 2 ! LLNL correlation
htco = 0.0125 ! C=3m/s
write(6.-2043) htco
resd(5j1310) ncherfstrina
if(string,ea.'Y' .or. strin2.es,'y')
1 resd(5-*) htco
else
3oto 220
endif
else
i'oto 250
endif
c
write(6»2100)
resd(5»1310) nchsr>stririg
if(string.eo.'Y' .or. string,ea.'y') then
iwtfl = 1
write(6»2045)
resd(5?1310) nchsr»strins
if (string, ea. 'V .or, strinsi.ea, 'v') then
iwtfl = -1
write(6»2120)
resd(3>*5 wtco
endif
endif
c
250 continue
write(Sj!060) isofl»tsurf
write(S.1060) ihtfl»htco
write(S»1060) iwtflrwtco
c
C
5 — SYS$DEGADIS:iOT,FOR 20-OCT-1987 00:18:43
-------
F-80
255 chsrscteristics
write(6j!510)
resd(5>1415) gss.nsme
write(8f 1415) Sss-nsnie
dss.&w = 16.04
= 111.7
= l,792*P3inb ! correct to psmb
sss.cpk = 2730,
2ss_cpp =1.00
S3S_Ufl= 0.15
£ss_lfl= 0.05
2ss_rsp= 0.5
if (gss-nsiJie.eo, 'NH3' .or, ass.nsme.ea. 'nh3' ) then
^ss_mw = 17.
s'ss_tenip = tsmb
33S_rhoe = Psmb#2ss_iTiw/0.08205/t3inb ! ideal
2ss_CPk = 3345. ! to Set 807.5 J/kS/K
2ss_cpp = 1.000
Sas_ufl= 2.0E-2
2as_lfl= 2.00E-3
_zsp= 0,5
else if (^ss_nsme,ea, 'LNG' .or, S3s_nsme,ea. 'Ind') then
23s_row = 16.04
2ss_teinp = 111,7
2ss_rhoe = I,792*p3mb ! correct to psmb
2ss_cpk = 5.6e-S
«!SS_CPP = 5,00
= 0,15
= 0,05
2ss_rs?= 0.5
else if(s;3s_ri£me,eQ,'LPG/ ,or. gss.nsnie.ea. '!P^') then
Sss-inw = 44.09
2ss_temp = 231,
3ss_rhoe = 2.400*P3mb ! correct to psmb
2ss_cpk = 15.4
2ss_ufl= 0.10
253 = _lfl= 0.02
_ZSP-- 0.5
else if (23s_n3me.ea.'N02' ,or, Sss-nsme.ea. 'no2') then
23S_/TlW = 46.
2ss_teirip = tsmb
3ss_rhoe = psmb*23s_mw/0.08205/t3mb ! idesl 335
2ss_cpk = 3345. ! to 3et 807.5 J/kS/K
<33S_cpp = 1.000
23S_ufl= 1000. OE-6
SYS$DEGADIS:iOT.FOR 20-OCT-1987 OOJ18J43
-------
F-81
gss_lfl= 500.QOE-6
g?£_2SF= 0.5
else if (25s-.nsiii9.eG, 'N20' .or. ges-nsme.efl. 'n2o' ) then
3ss_fflw = 92.
3ss_rhoe = FS(nb*3ss_niw/0.08205/tsnib ! idesl Sss
gss.cpk = 40990. ! to Set 807,5 J/kg/K
g£S_CFP = 1.000
sss_ufl= 1000. OE-6
g3S_lfl= 500.GOE-6
25£_Z:?= 0.5
else if (s'st-nsnie.eQ. 'CL2' .or.
1 £ss_n3i!ie,ea. 'c!2' .or, Sss-nsise.ea, 'C12' ) then
3ss_ifiW = 70,91
gas-tamp = 238,7
3e=_rhoe = 3.672*P3iftb ! correct to petnb
= 1.000
sss_ufl= 0.1H-4
2ss_lfl= 0.3D-5
gss_rsp= 0.5
else if (gs=_n3tiie,eG, 'MEC' , or.sss.nsirie.eci, 'mec' ) then
23S_mw = 84,94
des_rhoe = 3,53#(298,15/tsirib)*P3Bib ! correct to psm
5ss_CPk = 2730, ! Open to Question?
ass_cpp = 1,000
Sss_ufl= 1000, D-6
sS3S_lfl= 500, D-6
2SS_2SP= 0,5
endif
270 write(6> 1520) 23«_niw>g3s_tempj2ss_rhoer S3s_cpk>2s
1 233_Ufl>23=._lfl J3SS-ZSP
re3d(5»1310) nchsr? string
if (string, eo, 'm' .or, string. ea.'M') then
write(6»1550)
resd(5>*) 2ss_mw
^oto 270
else if (string, ea. 't' .or. string. en. 'T' ) then
wnta(6>1530)
270
else if (string, eo, 'd' .or, string. ea. 'D') then
write(6'1535)
resd(5»*) Sss.rhoe
goto 270
else if (string, ea, 'h' ,or, string, ea, 'H' ) then
write(6»1570)
7 — SYS$DEGADIS:iOT.FOR 20-OCT-1987 00:18:43
-------
F-82
rssd(5>*) gss-cpk
goto 270
else if (strins.ea. '? ' .or. stnng.ea. '?' ) then
write(6f 1571)
else if (strins.ea. 'u' ,or. string, eo, 'IT ) then
urite(6.«1572)
Soto 270
else if (strina.ea. '1 ' ,or, string. eo. 'L' ) then
write(£.1573)
goto 270
else if (string. en. 'z' .or. string. en. 'I') then
wnte(A»1574)
2oto 270
else if (nchsr.eot. 0 ,or, string. en. 'n' .or. string. eo. 'N') then
URITE(8>1020)
write(8»1020)
yRITE(S«1020)
else
goto 270
end if
c
c density curve if isotherms!
c
if(isofl .eo. 0) goto 460
WRITER » 1161)
URITE(6»1162)
WRITE(6>1163)
URITE(6,1164) rhos
WRITE(6»1165)
WRITE(6»1164)
goto 320
C
2SO writs(6f!290)
C
120 LUNIN = 5
URITE(6fl300)
READ (5? 1310) NCHAR» STRING
IF(STRING.EQ»'«' .or. string. ea. 'Y' ) GO TO 360
30 TO 400
360 MRITE(6»1320)
READ (5i 1310) NCHAR» STRING
OPEN(UNIT=10FNAME=STRING»TYPE='OLD'ferr=2SO)
LUNIN = 10
400 CONTINUE
IF
-------
F-83
URITE(Sil040) NP
IFdUNIN .EG. 5) WRITE(6- 1180)
r
\^
DO 440 I-1»NP
den(4fi) =0. ! 0.0 by default for isotherm
den(5»i) = tsmb ! ts&b for isotherm
READi) = 2ss_rhoe
den(3?i) = Sss_rhoe
wpite(6>1341) 2ss_rhoe
end if
ertdif
URITE(8rl025) DENd »I) »DEN(2»I) »DEN(3»I) >Den(4»I) t den(5i i )
440 CONTINUE
IF(LUNIN .EQ. 10) CLOSE(UNIT=10)
C
c
cciiis;; = (2ss_lfl/2,) * d3s_rhoe * (Sss-temp/tsmb)
WRITE(6>1280) ccmsx
READ(5»«) CcLOU
if(cclow ,le, 0.) cclow=0.005 ! don't let 0. Set through
if(cclow ,3t. ccros;;) cclow=cciR3>:
WRITE(8»1010) CcLOU
source description
c
urite(6»1440)
c
write(6»1460)
rssd(5»1410) dummy
if (dummy. eo, 'd' .or. dummy . en .' D ') goto 730
c
check4 = .fslse.
write(6f!400)
reiid(5jl410) dummy
if C dummy. SR. 'y' .or, dummy. ecu 'Y' ) goto 480
goto 520
430 continue
dr.iessO = 0. ! no initial cloud for 3 SS simulation
write<8»1020) gmassO
? -- SYSIDEGADISJIOT.FOR 20-OCT-1987 00218:43
-------
F-8A
write(6»1420)
re3d(5»#) ess
write(6..1430)
r&5ri(5-*:) rlss
HP = 4
tend = 6023. ! C=] sec
PTIME(l) = 0,
et(l) = ess
rlt(l)= rlss
F-wc(l) = 1.
Ftemp(l) = 2ss_tei&p
pfrscvd) = 1.
PTIME(2) = tend
et(2) = ess
rlt(2)= rlss
pwc<2) = 1,
pteitip(2) = gss-temp
pfrscv(2) = 1.
PTIME(3) = tend i 1.
et(3) = 0,
rlt<3>- 0,
pwc<3) = 1,
ptemp(3) = M3
pfrscv(3) = 1,
PTIME(4) = tend
et(4) = 0,
rlt(4)= 0,
?wc(4) = 1.
pfrscv(4) = 1.
slen = 2.*rlss
swid = pi*rlss**2/slen/2,
check4 = .true. ! steady stste run
3oto 790
c
520 continue
C
write(6,1450)
re3d(5f*> 3i»3ss0
write(S?1020) SmsssO
C
URITE(6»1190)
URITE(6fl200)
URITE(6fl210)
URITE(6fl220)
WRITE(6fl221)
WRITE(6»1165)
URITE(6»1223)
URITE(6»1230)
10 — SYS$DEGADIS:iOT.FOR 20-OCT-1987 00518M3
-------
F-85
URITE(6»1240>
URITE<6»1250>
3oto 600
C
560 write<6»1290)
C
600 LUNIN = 5
WRITE(6»1330)
F:EAIK5»1310> NCHAR»STRING
IF(STRING.eG,'Y' .or, string,ea.'y') Soto 640
soto 6SO
640 URITE(6»1320)
READ(5,1310) NCHAR»STRING
OPEN(UNIT=lQfNAME=STRING»TYPE='OLD'»err=560)
LUNIN = 10
630 CONTINUE
IFdUNIN .EQ. 5) URITE(6»1260) isen
REAIKLUNIN**) NP
IFCLUNIN ,EQ. 5) WRITE(6»1270)
C
DO 720 1=1rNP
READ(LUNIN»*> PTIME(I)?ET(I)iR1T(I)
pwc(i) = 1.
ptemp(i) = Sss.temp
pfpscv(i) = It
720 CONTINUE
IF1410) dummy
if (duijiiny,ea• 'y' .or. dummy.ea. 'Y') 3oto 740
goto 750
740 continue
SinsssO = 0. ! no initial cloud for s SS simulation
write(8»1020) 3msssO
write(6»1420)
resd(5j*) ess
write(6?1430)
re3cJ(5?*) rlss
741 URITE(6»1470)
re3d(5,*) PUC(l)
if1480)
resd(5»*) PTEMP(l)
if(pwcd).le.O.DO) 5oto 742
TIP = 4
c
1 — SYS$DEGADIS:iOT.FOR 20-OCT-1987 00:i8J43
-------
F-86
tend = 6023, ! C=] sec
PTIME(l) = 0.
etU) = ess
rlt(l)= rlss
PWC(1)= pwc(l)
PTEMP(1>= Ptemp(l)
PFRACV(1)= 1.0
PTIME(2) = tend
et(2) = ess
rlt(2)= rlss
Fb'C(2)=
FFRACV<2)= 1.0
PTIME(Z) = tend + 1.
st(3) = 0,
rlt(3)= 0,
pyc<3)= pwc(l)
PTEMP(3)=ptemp(l)
PFRACV<3>= 1.0
PTIME(4) = tend + 2.
et(4) = 0,
rlt(4)= 0,
PWC(-1)= pwc(l)
PTE«P(4)=ptei»p(l)
PFRACV(4)= 1.0
slen = 2,*rlss
swid = pi*rlss**2/slen/2.
checK4 = .true. ! steady stste run
790
750 continue
c
write(6>1450)
write(S>1020) SrosssO
C
WRITE(6»1190)
WRITE(6>2200)
WRITE(6»2210)
WRITE(6f2220)
WRITE(6»2221)
URITE(6»1165)
WRITE(6»2223)
WRITE(6.2230)
URITE(6»2240)
WRITE (6f 2250)
soto 760
C
755 write(6>1290)
C
12 -- SYS$DE6ADIS:iOT.FOR 20-OCT-1987 00:18143
-------
F-87
760 LUNIN = 5
WRITE(6F1330)
KEADtSilSlO) NCHARrSTRING
IFCSTRING.ea.'Y' .or, strinS.eo,'y') 2oto 765
goto 770
765 URITE(6Fl320>
READ(5»1310) NCHARiSTRING
QPEN(UNIT=10»NAME=STRING>TYPE='OLD'»err=755)
LUNIN = 10
770 CONTINUE
IFdUNIN ,EQ, 5) WRITE(6fl260) i2en
REAOdUNIN,*) NP
IF(LuNIN ,EQ, 5) URITE(6il270)
C
DO 780 1=1jNP
PFRACV(I) = 1>
READ(LUNINi«) PTIHE(I)>ET(I)iR!T(I)» PUC(I)FPTEMPd)
- 780 CONTINUE
IFdUNIN ,EQ, 10) CLOSE(UNIT=10)
r
w
790 continue
WRITEC8..1040) NP
DO 300 I=-1?NP
300 URITE(8»1030) PTIHE(I)>ET(I)»R1T(I)F PWC(I)>PTEMP(I)fPFRACV(I)
r
\_-
if(ei(l)t6Q»Of ,3nd, SmsssO.ne.O,) check2=,true, ! HSE type spill
w r i te < 8 .• *) check 1 > check2 F sssin > check3 F check4 F checks
C
istst = Iib$d3te_time(tinp)
URITE(8Fl050) TINP
c
if(check4) write(8Fl020) essFsleriFSuid ! stesdy state
c
C
CLOSE(UNIT=S)
C
c
1010 formst(l;;»lP2l4,7)
1020 format(3(ljj»lp2l4.7))
1025 forni3t(5(lxFlpgl4.7»
1030 foriD3t(lj;F5
-------
F-88
1135 FORMAT (ASO)
1140 FORMAT (5X?' ENTER WIND PARAMETERS — DO (ro/s)? ZO ? '?
$'snd ZR(ro) ')
1142 formatCS;:? 'UO — Wind velocity st reference height Z0'»
*/>5Xi'ZR — Surface Roughness')
1150 FORMAT(/?5X? 'Enter the Pssouill stability clsssl (A?B'C?'?
$'D?E>F) ',-$)
1152 formst(' Enter the averaging time (s) for estimating DELTA I '?$)
1159 format (/?' The values for the straospheric parameters' r
$' are set as follows! '?
*/»' DELTA: '?Fi2,4?
$/?' BETA: '?Fi2,4?
$/?' Mcnin-Obukhov length: SF12.4.. ' is' ?
$/?' Sigrns X Coefficient: '?F12.4?
$/?' Sigms X Power: '?F12.4>
$/?' Sigms X Minimuro Distance: '>F12.4»' m'»
$/.•' Do you wish to change sny of these?'?
$/?' (NojDelt.3?Beta>Lerigth5CoefficientfPowerjMinimuni) '»$)
1160 foriJist(/V The values for the atisospheric parameters'?
$' are set SE follows:'?
$/?' DELTA: 'fFi2.4i
$/?' BETA: '»Fi2.4>
$/>' Monin-Obukhov length: infinite'?
$/?' Si Sims X Coefficient: '»F12,4»
$/?' Sigma X Power: SF12.4?
$/?' Sigms X Minimum Distance: SF12.4?' ro'?
$/>' Do you wish to change any of these?'?
*/»' (NorDelts?Bete?LengthfCoefficient»Power?Minimuiii) '?$)
1161 FORMAT(/?5X? 'The density is determined as a function of con'?
f'centration' )
1162 FORMAT (5X?' by s listing of ordered triples supplied by the '?
1163 FORMAT (5X?' Use the following form:')
1164 FORMAT(/?5X?5X? 'first point' ?6X? '— pure sir y=0.0?Cc=0, ? '?
1 'RHOG=RHOA='?F7,5' ks/m«3')
1165 FORMAT(3(15X? '»'?/))
1166 FOF:MAT(5X?5X?'lsst point'?7x»'— pure gas y=l ,0»Cc=RHOE? ' ?
1 'RKOG=RHOE')
1170 FORMAT C/?5X? 'ENTER THE NUMBER OF DATA TRIPLES (msx=' ?i2? ' ) ' ?
*' FOR THE DENSITY FUNCTION: '?$)
1130 FORMAT (/?5X» 'Enter Mole frsc? Cc (kg/m**3>? then RHOG '?
1 '(kg/m**3) by triples')
c
c
1190 FORMAT(/?5X?10X? 'Source Description')
1200 FORMAT(lX?/?5X?'The description of the primary source mass')
1210 FQRMAH5X? 'evolution rate £ snd radius Rl for s transient'?/?
$5;:? 'release is input by ordered triples as follows?')
1220 FORMAT(/?5X?3X? 'first point' ?SX?
$'— t=0? E(t=0)? Rl(t=0) (initial? '?
$'norcero values)')
14 — SYS$DEGADIS:iOT,FOR 20-OCT-1987 00:i8M3
-------
F-89
1221 FORMAT(5Xj3X..'second point'>7X>
f'~ t=tl? E(t=tl)? Rl(t=tl)')
1222 FORMAT (3X..3X? 'Isst nonzero point — S
f't=TEND? E(t=TEND)> Rl(t=TEND)')
1230 FORMAT(5X..3X,'next to last point — t=TENB+l.» E=0.» Rl=0»')
12-10 FORMAT<5X-3X»'last point ~ t=TENDi2.» E=Q.? Rl=0.')
1250 FORMAT(/»5X»'NoteJ the final time (TEND) is the last tine '>
f'when E end Rl are non-zero.'?/)
1260 FORMAT(/»5X» 'Enter the number of triples (ms;:= '»i2»')S
$' starting with t=0. end ending'»/»5;:»'with t=TEND-i-2,' T
$' for the source description? '»$)
1270 FORHAT(/»5X»'Enter TIME (sec); EVOLUTION RATE (kg/s)j 'i
$'and POOL RADIUS (is)')
12SO FGRMAT(/»5Xf'The suggested LOWEST CONCENTRATION OF INTEREST ',
$'/f5:;,' is '»lpSl3»5i
i' k^/m**3« Enter the desired vclueJ '»$)
1290 fornist(/f' This file was not found.')
1300 FORMAT(/j' Do sou neve sn input file for the Density 'i
^'function? Cy or N] '»$)
1310 FORMAT(Q.A20)
1320 FORMATC Enter the file namet CDIR3FILE_NAME.EXT '»$)
1330 FORMATC Do you have an input file for the Source '>
?'Description? Ey or N] '>$)
1340 for,7i3t(/j' Air density corrected to '»lp2l3,5' ks/nt**3'j/)
1341 formst(/y' Contaminant density corrected to '»lP2l3.5' k^/m**3'»/)
c
u
1400 format(//j' Is this a Steady state simulation? '»$)
1410 fcrmat(a4)
1415 forroat(a3)
1420 formst(/»' Enter the desired evolution rate C=O ks/sec t '»$)
1430 for;ii3t(' Enter the desired source radius C=3 ra I S5)
1*140 formst(/j' Specification of source parameters,'?/)
1450 forast(//»' Enter the initial mass of pure 5as'»
S' over the source. (k2)S/i' (Positive or zero): '»$)
1460 fcrmat(/>' Is this a release of pure (P) or diluted (d) material'»
$ ' specified shove? '»$)
1470 FORMATC Enter the desired primary source contaminant mass '»
I 'fraction: '»$)
1480 FORMAT(' Enter the desired primary source temperature [=D K J ')
c
c
1500 formst(/»' Enter the ambient temperature(C) and pressure'?
1 '(stm): '»$)
1510 formet(/>' Enter the code name of the diffusing species.' '?$)
1520 format(/f' The characteristics for the gas are set as follows?'»/»
$' Molecular weight: '»f7.2»/»
$' Storage temperature CK]J '>lpgl3.5»/>
$' Density at storage temperature? PAMB Ckg/m**3]: '»lpg!3.5?/>
$' Mean Heat capacity constant '?lpgl3.5>/»
$' Mean Heat capacity power 'jlpg!3,5>/»
13 — SYS$DEGADIS:iOT.FOR 20-OCT-1987 00:18143
-------
F-90
$' upper Flammability Lindt [mole frscl '*1P213,5*/'
$' Lower Flammability Limit Croole frscJ '»1PS13.5*/*
*' Height of Flammability Limit Cm] ' * lP<2l3,5*/»
5' Do you wish to change any of these? '»
f ' ( No » Mol e » Terip * Den » Hes t > Powe r * Llppe r * Lowe r * Z ) ' *
$' -::N-- '*$)
1530 formatC' Enter the desired Storage Temperature? '*$)
1535 formate Enter the desired Density si Storage '*
1 'Temperature and'?' ambient pressure! '»$)
1550 formate Enter the desired Molecular Weight: '*$)
1570 formate Enter the desired Mean Hest Capacity constant? '»$)
1571 formate Enter the desired Mesn Heat Capacity power? '»$)
1572 f orniatC Enter the desired Upper Flammability Limit? '*$)
1573 formate Enter the desired Lower Flamroability Limit? '*$)
157-4 format(' Enter the desired Height for the flammable limit calcula'*
•i / * .; nr,'- ' ' . * 'i
i v j, o n i- f .»•*'/
15SO formate/*' The smbient humidity can be entered as Relative '.•
1 'or Absolute. '»/»' Enter either R or A ? '»*)
15S5 formate Enter the absolute humidity (k* water/k^ PDA)? '»$)
15S6 fcrraate This is s relative humidity of SlpSl3,5f' '/.' )
1587 formate Enter the relative humidity (2)? '»$)
153S forif:st(/f' Ambient Air density is ',lpgl3.5»' k2/m**3')
c
c
1600 formate Enter the desired DELTA? S$)
1620 formate Enter the desired BETA? '>$)
1660 formate Note? For infinity* ML = 0.0' »/»
$ ' Enter the desired Honin-Obukhov length? (m) '»$)
1670 formate Enter the desired SiSma X Coefficient; '>$)
1630 formate Enter the desired SiSms X Power? '>$)
1690 formate Enter the desired SiSma X Minimum distance? (m) '»$)
t_
-2000 formet(/>' Is this an Isothermal spill? '?$)
2020 fcrrast(/;' Is heat transfer to be included in the'»
1 ' calculations '»$)
2030 formate Enter the surface temperature C=3 K ? 'i$1
2040 formate Do you went to use the built in correlation* ' »
1 ' the LLNL correlation* or'*/*' enter'*
1 ' a particular value?'*/*
1 ' C Cor r*LLNLcorr* Value) '*$)
20-13 foriast(/>' The form of the correlation is?'*/*
1 5xj'3 = (Vh * rho * CP) * area * (tsurf-temp) ' *//*
1 ' with Vh = '*lp^!3.5*' m/s.'*//*
1 ' Do you wish to change the value of Vh? (y or NK '»$)
2045 formate Do you want to use the built in correlation or enter'*
1 ' B particular value?' »/*' '*$)
2050 formate Enter the HT coefficient value [=O J/m**2/s/K ? '*$)
2100 formst(/*' Is water transfer to be included in the'*
1 ' source '*$)
2120 formstC Enter the WT coefficient value C=3 k3/m**2/s ? '*$)
16 — SYSfDEGADISIIOT.FOR 20-OCT-1987 00?18?43
-------
F-91
2200 FQRMAT(lXj/>5Xj'The description of the primary source contain-')
2210 FORMAT(5X»'merit mass rate E> radius Rl> contaminant mess'j/j
$5;:.' 'f rsction Uc^S' and temperature Ts for s transient'»/»
$5x>' release i£- input as a function of time ss follows!')
2220 FORMAT(/j5Xf3Xf'first Point'?SX»
$'-- t=0.s E(t=0)r Rl(t=0)» Wcj£(t=0)j Ts(t=0)'>/»
$ 5;;»3x»18;:flO;:i'(initial> '•
$ 'nonzero vslues)')
2221 FORMAT(5X»3X»'second point'»7X?
$'— t=tl> E(t=tl)f Rl(t=tl)> Ucjs(t=tl)> Ts(t=tl)')
2223 FORMAT(5Xf3X.'lest nonzero point — '»
$'1-TEND. E(t-TEND)» Rl(t=TEND)> Wos(t=TEND)» Ts(t=TEND)')
2230 FORMAT(5Xj3Xj'ne::t to last point — t=TENDtl.» E=0.f Rl=0.»'f
$ ' Ucjs=l.! Ts=Tsmb')
22-s.O FORMAT(5X.3Xj'lsst point — t=TENDf2,» E=0.» Rl=0.»'»
* ' WcfS=l,» Ts=T3Bib')
2250 FORMAT(/?5Xi'Note: the final time (TEND) is the last time ',
f'uhen E and Rl are non-zero,'?/)
2260 FORMAT(/?5Xj'Enter the number of times (ms;:= Si2»')'»
$' starting with t=0, and endins'»/f5;:i'with t=TENDf2,'f
$' for the source description; '.•$)
2270 FORMAT(/»5Xf'Enter TIME (sec), CONTAMINANT MASS RATE (ka C/s>> '
$'POOL RADIUS (ra)'»/jlOX»'CONTAMINANT MASS FRACTION (ka C'»
$ Vka Bii;:)f and TEMPERATURE (K)')
2280 FORMAT(/?5X>'The suaaested LOUEST CONCENTRATION OF INTEREST '»
*'(a3S_lfl/2.)'f/f5x»' is 'jl?2l3f5>
$' ka/iti#*3, Enter the desired value'. '»$)
c
RETURN
END
****
17 — SYS$DEGADIS:iOT,FOR 20-OCT-1987 00:i8M3
-------
F-92
C, ,. ... .......... ,...,...,... ...... . , ... ........ ,,.....,..
C
C SUBROUTINE FOR SOURCE EVALUATION WHEN NO GAS BLANKET
C IS PRESENT.
r
SUBROUTINE NOBL( timeout »
Implicit Resl*3 ( A-H» 0-Z )> Inte3er*4 ( I-N )
include 'sysSdessdisJDEGADISl .dec'
COMMON
S/GENi/ PTIME(isen)» ET(i2en)> Rl!(i«$en)» PWC(i«2en)» FTEMP(i3en> i
$ PFRACV(isen)» PENTH(iSen)» PRHO(iSen)
$ /ERROR/ STPIN»EREND»STPMX»WTR6»WTt»»WTB3fWtyowteb»wt«ibfWtuh»XLI»
$ XRIfEPS»ZLOUfSTPINZfERBNDZfSTPMXZ»SRCOER»srcss»srccutf
$ htcut > ERNOBL » NOBLpt > c rf ge r ? epsi 1 on
S/PARM/ UO»ZO»ZR»«L»USTAR»KfG>RHOEfRHOA»DELTA»BETA»6AMMAF»CcLOW
$/coiB3tm/ istsbr t3mbjpsnib» humid »isof 1? tsurfjihtflj htcojiwtfl >wtcof
$ hums re
f/PARHSC/ RM»SZM»E«AX»RMAX»TSC1»ALEPH»TEND
f /COBI_SS/ ess^slerif swidf outcc;outsz.'outb>outl >swcl
$/phl s^/ checkl > checK2 > s^si n > check3 » check4 > checks
$/ALP/ ALPHAislphel
$/phicom/ iphifl»dells«
REAL*8 MLiK
LOGICAL REV
lo^icsl checkl fchecK2»s3siru check3 »check4f checks
lofiicsl reflsg
DATA REV/. TRUE./
REALMS L
dsts
dsts delt_m in/0.5/
C
DELTA! = (TEND - TSC1) /FLOAT (NOBLPT)
if(deltst .It, delt_min) then
nob IP t = int( (tend-tscl)/delt_min) -f-1
deltst = (tend-tscl)/flost(noblpt)
endif
C
TO = TSC1
IF(DELTAT ,LT, 2.) GO TO 100
C
WRITE(lunlo£»1100>
URITE(lunlo3>*) DELTAT
1100 FORMAT(5X>'!IHE INCREMENT USED ON LAST PORTION OF SOURCE CALC')
C
1 — SYSSDEGADISJNOBL.FOR 20-OCT-1987 OOJ22:05
-------
F-93
100 CONTINUE
r
C ESTABLISH LOOP TO FINISH SOURCE
r
w
DO 110 I = 1»NOBLFT
r
TIME = TO + FLOAT(I)*BELTAT
IF(I .EG. NOBLF'T) TIME = TEND
L = 2,0*AFGEN2(FTIME»RlT»TIME>'RiT-BL')
erste = AFGEN2(PTIME»ET.TIME.'ET-BL')
flu;: = ErsTe/FWC.TIME,'ET-BL')
FUAP = U.DO - PWCP)/(1,DO t HUMID)
HPRIM = AFGEN2(PTIME»PENTHjTIME»'ET-BL')
CALL SETDENCFWCPf FUAP, HPRIM)
RHOF = AFGEN2(PTIMEJPRHO>TIMEJ'RH-BL')
CCF = FUCF * RHOP
c
astsr = CCP * k*ust3r*3lph3l*dell5a/(dell3y-l,)/phih3t(F:HOF,L)
if(sbs(flux/Qst3r) .at, ernobl ,snd. reflss) then
check3 = .true,
timeout = time
return
end if
C
cell szf(f1uxjLiPUCP>sz»eelsy»wclsy>rholsy)
cc = cclsy^dellsy
if(cc.5t.ccp) CC=CCP
c
call sdisbst(0?we• us?ac>ys»cc> rho»wro»enthslpy»teiap)
c
IF(Erste .LT, EMAX) GO TO 220
EMAX = Erste
RM = AFGEH2(PTIME»R1T»TIME»'R1T-BL')
SZH = SZ
220 CONTINUE
RLIST = AFGEN2(FTIMEJRlT,TIMEj'RlT-BL/)
RMAX = dMAXl(RMAX»RLIST)
c
WRITE(9>2000) TIME*RLIST,h»flux»SZ»ac»ys»rho.Ri»we>WB»enthalpy?temp
c
if(i,eQ,3 .end, checK4) goto 500 ! steady
C
110 CONTINUE
RETURN
c
c
500 continue ! stesdy state completion
outcc = cc
swcl = we
3W3l = W3
2 ~ SYS$DEGADIS:NOBL.FOR 20-ocT-i?87 00:22:05
-------
F-94
senl = enthalpy
srhl = rho
outsr = sz
outl = 2. * rlist
outb = pi * rlist**2 /outl/2,
return
2000 fQriD3t(lp2l6.9»lx»lp2l6.9i(lx»lpgl3.6))
END
tttt
3 ~ SYS*DEBADIS:NOBL.FOR 2o-oci-i987 00:22:05
-------
F-95
C
C
C SUBROUTINES OB AND OBOUT ARE USED IN THE OBSERVER INTEGRATIONS
C OVER THE SOURCE.
C
SUBROUTINE OB(time»Y»n»PRUT)
Implicit Resl*8 ( A-Hr 0-Z )» Inte2er*4 ( I-N )
C
include 'sys$de23dis:DEGADIS2.dec'
c
COMMON
I/GEN3/ rad2(2?iii£xl) »astr(2»mexl) isrcden(2»ms:cl) isrcwc(2»msxl)»
$ srcws<2»Bsxl) »srcenth(2jiB3;:l)
$/FARH/UO fZO,ZRiKL,USTAR»K >G,RHOE » RHOAiDELTA»BETA iGAHMAF»CcLOU
f/comstiR/ istsbjtsmbjpsiabjhumid»isofl»tsurf»ihtf 1 fhtcor iwtf 1 ?wtco>
$ hums re
S/FARMSC/ F:MjSZMjEHAXjRHAX>TSCljALEPH»TEND
$/ALP/ALPHA..slr-hsl
$/phicoi?i/ iphifljdellsy
r
REALMS K?ML
Ic^icsl fls2
C
DIHENSION Y(l)iD(l)fPRMT(l)
INTEGER HUIDTH»Mrgte»Crste»BDAr3te»Hrste
DATA HUIDTH/l/.Mr3te/2/»Crst8/3/fBDArste/4/»Hrste/5/
r
C**t PASS TO IN F'RHT<£)
C
fls3 = isofl.ec. i ,or, ihtfl.eo. 0
c
TOL = FRMTC6)
;;UF- = ppmt(7)
XI = XIT(TIME»T01>
RG = AFGEN(RADGiTIMEi'RADG')
RLEN = PRHT(13)
C
BIF'R = 0.
D
-------
F-96
IF(ABS(XI) ,GE. RG) then ! use the last values
PRMT(S) = print (14) ! cclsy
PRMT(9) = Frmt(15) ! wcley
PRMT(IO) = prat (16) ! ualay
PRMT(ll) = prmt(17> ! enthley
FR«T(12) = Frist(lS) ! rholsy
RETURN
sndif
SIPR = i,-irt(RG^RG - XI*X!)
C
UI = UIT'TIMEfTOl)
C
Q = AFGEN(QSTR»TIHE»'QSTR')
we = AFGEN(srcwc»tinej 'srcuc' )
ws - AFGEN(trcw5r time» 'srcws' )
snth = AFGEN(srcenth»tiinej'srcenth')
c
we lea = Y(Crste)/Y(Mrste)
wslsy = Y(BDArst8)/y(Mrste)
if(,not.flss;) enthlsy = Y(Hr3te)/Y(«rste)
csll tproFd 5Wcl3yjwslsaienthlsB»acf «siwn»teifip» rhol3a»cp)
cclsa = wcls
prntt(S) = cclsy
Fr,iit(9) = wclSB
Frist (10)= wslsy
print (11) = enthlsy
priTit(12)= rholsy
r.
cc = cclsyfcdellsy
rho = dellsy*(rholsy-rhos) t rhos
c
szob =0,01
sr<3 = G*(xi-;;up)/cc/(uO*zO/3lPh3l)
if(;:i.3t, XUP .and, srS.st.O.)
1 szob = srg**(l,/3lphsl) * =0
c
HEFF = GAMMAF/ALPHA1* SZOB
RISTR=RIF(RHO»HEFF)
PHI •- PHIF'RISTRfO.)
welsy = del lay * K*USTAR* ALPHA1/PHI
C
D(HWIDTH)= UI * BIPR / RLEN
D(Crste) = D(HUIDTH)*RLEN * Q
D(Mrste) = (Q/wc I rhoa*welsy) * D(HUIDTH)*RLEN
D(BDArate)= (Q*us/wc f rho3*welsy/(l,+huinid)) * D(HWIBTH)*RLEN
if(fls^) return
D(Hrste) = Q * enth/wc * D(HWIDTH)*RLEN
C
2 ~ SYS$DEGADIS:OB.FOR 20-OCT-1987 00:22:31
-------
F-97
1000 FORMATC ?OB? — Velue of XI '>lpQ13,4»'i Value of RG '»
$ 1H313.4)
RETURN
END
SUBROUTINE OBOUT( X? Y» DERY» IHLF? NDIH» PRMT)
C
Implicit ReeUB ( A-H> 0-Z )» Inte3er*4 ( I-N )
DIMENSION X(l)f Y(l)f DERY(1)» PRMT(l)
r
PRHK14) = ?rmt(8) ! cclaa
PRMT(15) = ?rmt(9) ! wclsy
F'RMT(16) = prntt(lO) ! welsy
PRMT(175 = prmtdl) ! enthlsy
PRMT(IS) = pm.t(12) ! rholsy
RETURN
HMD
**tt
3 — SYS$DEGABIS:QB.FOR 20-ocT-i?87 00:22:31
-------
F-98
r ........................ ............ ....
W»*.t*ttttf*»»*t»*T*tt*»*»»*»»»»»f»»*t»»»»t»»t»#*»**t*»#*»»***
r
C FUNCTION PSI
C
C*** AS PER COLENBRANDER --
C
Cm THIS FUNCTION HAS BEEN DERIVED FROM BUSINGERiJ,A,
C*** WORKSHOP ON MICROMETEOROLOOYi CHAPTER 2, HAUGEN»D.A. (ED.)
C*** AMERICAN METEOROLOGICAL SOCIETY,
C
FUNCTION PSIFCZ»ML)
Implicit ResUS ( A-H» 0-Z )» Inte2er*4 ( I-N )
C
include 'sysfdeSsdis.'DEGADISl.dec'
c
REAL*8 ML
C
IF( ML ) 10»20,30
C
10 A = (l.-15.*Z/ML)#*,25
PSIF = 2.*dLOG((l.fA)/2.) + dLOG((1.iA*A)/2,) - 2.*daTAN(A)
$ PI/2,
RETURN
C
20 PSIF = 0,
RETURN
C
30 PSIF = -4,7*Z/ML
RETURN
END
i -- SYS*DEGADIS:PSIF.FOR 20-OCT-1987 00:23:00
-------
F-99
C,
C
C
C
SUBROUTINES FOR PSEUDO-STEADY STATE INTEGRATION.
SUBROUTINE PSS(DIST»YjDERYjPRMT)
Implicit Resl*S ( A-H» 0-Z )» Inte2er*4 ( I-N )
include 'sysJde3sdisJDEGADIS2.dec/list'
parameter (zero=l.D-10» rcrit=2.D-3)
COMMON
5/PARM/ UO >ZO >2R»ML,USTAR >K>G»RHOE >RHOA>DELTA ? BETA»GAMHAF,CcLOU
$/ccm_Sprop/ £3s_niW.«23s_teniF»33s_rhoe»33s_c?k j2a=_cppr
$ 333_Ufl»23S_lfl»23S_ZSP»23S_ri3!Iie
$/coR)stn>/ istsbftsKibfP3(iib»huiiiidf isof 11tsurf»ihtfl»htcc> iwtf 1 -utcor
$ humsre
5/PHLAG/ CHECK!?CHECK2»AGAINiCHECK3»CHECK4»CHECKS
$/ALP/ ALPHA»slphsl
$/phicom/ iphifljdellsy
S/s? ro'.con/ ce» delrhomin
REAU3 K»ML
LOGICAL CHECK!»CHECK2»AGAINfCHECK3»CHECKS CHECKS
DIMENSION Y(1),DERY(1),PRMT(1)
DATA rhouh/1/»SY2/2/?BEFF/3/,dh/4/1Mhi/5/»Mlow/6/
INTEGER rhouh»SY2»BEFF»dh» «hi> Mlow
C
C***
C***
C***
C***
C***
C***
C***
C***
C***
c***
C***
C***
C***
C***
C***
C***
C***
C***
C***
PRMT
I
6
7
Q
w
9
10
11
12
13
14
15
16
17
18
19
20
21
22
I/O SETUP-
VALUE
E
Cc
Bb
CON DERY(BEFF)
CON DERY(SZ)
NREC(I>1)
DIET
yc
rho
temp
S3 (Tin; 3
sz
sz
IN/OUT
IN
OUT
OUT
IN
IN
OUT — STARTS OUTPUT COUNTER
OUT
out
out
out - if recorded
out - if recorded
— SYS*DEGADIS:PSS,FOR
20-OCT-19S7 01J01J17
-------
F-100
C
Erste = FRMT(6)
Bb = Y(BEFF) - SQrtPI/2,*sctrt( Y(SY2) )
c
c using the Isst value for Sz
c
szO = prmt(22)
sz = szO
C
C*** MATERIAL BALANCE
C
iii = 0
100 Cc = Er3te*ALPHAl/2,/UO*(ZO/SZ;**ALFHH/SZ/YCBEFF)
cclsy = cc/dellsy
csll sddhestCcclsy? y(dh) >rholsyjtemlsy? CP)
prod = drosxK Y(rhouh)/rhol3y/priat(18) .« zero)
sz = ( prod )**(!, /slphal) * zO
dif = 3bs(sz - szO)/(3bs(sz)tsbs(szO)izero)
if(dif .2t. rcrit) then
szO = sz
if(iii .St. 20) csll tr3F(32)
goto 100
end if
print (20) = rholsy
prrot(21) = sz
HEFF = GAHMAF/ALFHA1*SZ
csll sdisbst(0f wow3jyc»y3>cc» rho»wi»>erith» temp)
csll 3disb3t(0»wc»w3fycl3yf ys
rit = 0.
if (isofl.ea.O .end. ihtfl.ne.O) then
csll sddhe3t(cc>dellsy#y(dh)
rit = rift(tenip>heff)
endif
RISTR = RIF(RHOfHEFF)
PHI = PHIF(RISTRjrit)
C
C*** CALCULATE DERIVATIVES
C
DERY(BEFF) = 0.
delrho = rho-rhos
IF(delrho ,GT. delrhomin) DERY(BEFF) = PRMT(9)*sart{del rho/rhos)
$ *(SZ/ZO)«(,5 - ALPHA)
C
DERYCSY2) = 8.*BETA/PI*Y(EEFF)**2 *
$
-------
F-101
yw = l.-yclsy-ys
yw = min( ms;;( tfw> O.DO )> l.DO)
call surf3ce(tetiilsyrhei2hj rholsyswrolfC? »yw?wstrt^'Grte)
if (tenip.se. tsurf .or. tenilsy.^e. tsmb) arte = 0.
rhouhb = rhclsy* prrat(lS) * (s=/zO)**3lFhsl * Y(bc-ff;
d_rhouhb = pr&it(19)*y(beff )/phi
dERY(dh) = (arte*Y(beff)/dellcV - Y(dh)*d_rhouhb>/rhouhb
dERY(rhouh) = (d-rhouhb-Y(rhouh)MERY(beff) )/Y(beff)
c
c*** Cslculste the derivative for the total mess ebcve the UFL snd LFL
c
Ssmnis = (rho-rhos)/cc ! Ssmms
if(check4) then
DERY(mloM) = 0.
DERY(mhi) = 0.
if( isofl.eo.l .or, ihtfl.eo.O ) then
csll sdisbst(2j3Sfdd>53s_ufl>eejchi
csll sdisbst(2>ss>dd)Sss_lfljee»clow»
else
csll 3disbst(-2'S£»ddj53S_uf1?ee»chi
csll 3di3bat(-2»33tdd»33s_lfI>ee»clo
endif
^smhi = 2.DO* Cc * Bb * Sr / slphel
ssnunsx = 2.DO* Cc * Sz * GAMMAF/slphsl * (Bb+sc5rt?i/2.DO*=Grt(Y(Sy2»)
if(cc.gt.clow) then
ulow = Dlo3(cc/clow)
23!tilow = 38minc(l.DO/3lphsl> wlow ) * a'scihi
DERY(alow)= ssrolou + 2.DO*clow*sQrt(Y(Sy2))*3z/aL=h3l*ssrie5(wlow)
DERY(silow)= DMINK DERY(mlow)» ^smms:; )
endif
if(cc.3t.chi) then
whi = Dlos(cc/chi )
25inhi = ^siiiiricd.DO/slphslr whi ) * ^sinhi
DERY(mhi) = asmhi f 2.DO*chi *SQrt(Y(Sy2))*Sz/3lFhsl*series(whi ^
DERY(mhi) = DMINK DERYCmhi )» Ssmsnajc )
endif
endif
C
C*** RETURNED VALUES
C
PRMTC7) = Cc
PRMTO) = Bb
print (14)= ac
prn>t(15)= rho
prmt(16)= temp
prtnt(17)= 33Rint3
RETURN
END
****
3 ~ SYS$DEGADIS:PSS.FOR 2o-ocT-i9s? 01:01:1?
-------
F-102
C [[[ , .........
C
C SUBROUTINE FSSOUT
C
SUBROUTINE PSSOUT(Xf Y»B»IHLF»NDIM»PRMT>
Implicit Resl*8 ( A-H» 0-Z )» Inte2er*4 ( I-N )
C
include 'sys$de2sdis:BEGADIS2,dec'
c
parameter (np=s=9f zero=l .e-10)
c
COMMON
$/PARM/UOfZQ»ZR»ML»USTAR»KiG»RHOE»RHOA»DELTA»BETAiGAMMAF»CcLOW
$/coiiistiTi/ istsb»t3mbfpsmbjhumid>isof If tsurfiihtflfhtcofiwtflfwtco.'
$ huasrc
$/STP/STPO ? STPP > ODLP i ODLLP » STPG , ODLG > ODLLG
S/PHLAG/CHECK1 , CHECK2» AGAIN , CHECKS > CHECK4 » CHECKS
$/STOPIT/TSTOP
c
REAU3 K,ML
LOGICAL CHECKlrCKECK2»AGAIN» CHECKS t CHECKS » CHECKS
DIMENSION Y(l).D(l)jPRMT(l),BKSP(npss)fOUT
-------
F-103
CURNT<3) = PRMT(7) ! cc
curnt(4) = prnitdS) ! rho
currit<5) = pr»t(17) ! S3 rams
curnt(6) = prmt(16) ! temp
CURNT(7) = prrat(21) ! sz
CURNT(S) = sort(Y(2» ' sy2
CURNT(9) = PRMT(S) ! b
IF(pri»t(8> .LE. 0.) CALL trsp(16)
90 CONTINUE
r
CUl STOP INTEGRATION WHEN THE HALF UIDTH B < 0.
C
IF( PRUT(8) .LE, 0.) GO TO 1000
r
C*** SET THE CURRENT AND PREVIOUS RECORD
C
DO 100 11=1»npss
100 BKSFdl) = CURNT(II)
C
CURNT(l) = X
curnt(2) = prmtd4) ! yc
CURNT(3) = PR«T(7) ! cc
c'jrnt(4) = prmtdS) ! rho
curnt(5) = print d7) ! Ssmina
curnt(6^ = prmtd6) ! temp
CURNT(7) = prn,t(21) ! sz
CURNTO) = sart(Y<2)> ! sy2
CURNT(9) = FRMT(B) ! b
C
C*** STOP INTEGRATION AND GET A NEW OBSERVER WHEN Cc
-------
F-104
IFdl ,EG, 5) II = II + 1 ! skip TEMP J 6
IF(II ,LT, ripss) GO TO 110
Cm RECORD POINT IF ODLP IS EXCEEDED OR SO METERS SINCE LAST RECORD
CW RECORD FIRST POINT
C
DX = CURNT(l) - OUT(l)
IFC RI.NE.l. .AND, ERM.LT.ODLP .AND. DX.LE.ODLLP) RETURN
C
IF THE NEXT INTEGRATION AFTER A POINT IS RECORDED VIOLATES THE
ERROR BOUND » THE CURRENT POINT MUST BE RECORDED, OTHERWISE* THE
C*M LAST POINT TO SATISFY THE ERROR LIMITS IS RECORDED,
r
DO 120 II=linpss
IF(RI ,EQ. Rll-fl.) BKSP(II) = CURNT(II)
120 OUT(II) = BKSPdl)
C
RI = RII
PRMTdl) = PRMT(ll) + 1,
C
URITE(9»*)
RETURN
C
1000 CONTINUE
C
C*#* STOP INTEGRATION
C
PRMT(12) = X
C
IF(CURNTd) .EQ. OUTd)) GO TO 130
C
PRMT(ll) = PRMTdl) + 1.
WRITE<9>*> (CURNT(II)>II=l>npss)
r
^
130 CONTINUE
PRMTC5) = 1.
RETURN
END
tm
3 ~ SYS$DEGADIS:PSSOUT.FOR 20-OCT-1987 00:23:44
-------
F-105
C SUBROUTINE PSSOUT
C
SUBROUTINE PSSOUT(X, Y»DERY>IHLF,N[iIM»PRMT)
Implicit Resl*3 ( A-H? 0-Z )> Inte2er*4 ( I-N )
C
include 'sys$deSsdis:OEGAHIS2»dec/list'
c
parameter (npss=9» zero=l.e-10)
c
COMMON
$/FARM/UO>Z(hZR»MLjUSTARjKjGjRHOEjRHOAfDELTA>BETA*GAMMAF>CcLOU
$/STF7STPPrODLPfODLLP>STPG,ODLG,OOLLG
$/PHLAG/CHECKi»CHECK2.AGAIN,CHECKS,CHECK4 >CHECKS
$/COiB-fl/ CflS2..ClflfCUfl
«/ALP/ALPHAislPhsl
C
logics! cflsg
LOGICAL CHECK15CHECK2»AGAIN,CHECK3»CHECK4>CHECKS
C
REALSS MLfK
C
DIMENSION Yd ) »DERY( 1) »PRMT( 1)
dimension BKSP(nPSs)»OUT(npss)fCURNT(npss)
C
CW* OUTPUT PARAMETERS
r
*_•
err* FROM PSS OUTPUT TO MODEL
cm
en* x DIST
PRMT(7) Cc
Yd) SZ
C*** Y(2) SY2
C*'** PRMT(S) B
C
ERM = 0.
Fruit (22) = print (21)
C
IF(PRMTdl) ,NE. 0.) GO TO 90
C
CUt STARTUP FOR THE OUTPUT ROUTINE
C
RII = -100./STPP
RI = 0,
CURNTd) = X
CURNT(2) = PRMTU4) ! yc
CURNT(3) = prmt(7) ! cc
CURNK4) = prratdS) ! rho
1 — SYS$DE6ADIS!PSSOUTSS.FOR 20-OCT-1987 00:24:17
-------
F-106
CURNTC5) = PRHTC17) !
curnt(6) = print(16) ! temp
curnt(7) = prmt(S) ! b
curnt(S) = prmt(21) ! sz
curnt<9) = sart(Y<2» ! sa2
C
90 CONTINUE
C
C*** STOP INTEGRATION WHEN THE HALF WIDTH B < 0.
C
IF( PRMT(S) .LE. 0.) GO TO 1000
C
C*** STOP INTEGRATION when Cc
-------
F-107
IF( RI,NE,1, .AND, ERM.LT.ODLP ,AND. DX.LE.ODLLP) RETURN
C
Cm IF THE NEXT INTEGRATION AFTER A POINT IS RECORDED VIOLATES THE
C*** ERROR BOUNDf THE CURRENT POINT MUST BE RECORDED, OTHERWISE? THE
C#M LAST POINT TO SATISFY THE ERROR LIMITS IS RECORDED.
C
BO 120 Il=l>npss
IF(RI ,EQ, RIH1.) BKSP(II) = CURNT(II)
120 OUT(II) = EKSP(II)
C
RI = RII
PRHT(ll) = FRrtTCll) + 1.
C
csll ssout(out)
RETURN
r
w
1000 CONTINUE
C
C**# STOP INTEGRATION
C
PRMTC12) = X
C
IFCRI ,EQ. 0.) CALL t^^p(16)
C
IF(CURNTd) ,EQ. OUT(D) GO TO 130
C
PRMT(ll) = PRhT(ll) t 1.
csll ssout(out)
r
130 CONTINUE
PRMT(5) = 1.
C
RETURN
END
— SYS$DEGADIS:PSSOUTSS,FOR 2o-ocT-i?87 00:24:17
-------
F-108
C,. ,..,,,* , ,..,,..,,, ,
r
i_
C RICHARDSON NUMBER (RI*)
C
FUNCTION RIFfRHOGfHEFF)
Implicit Resl*8 ( A-H» 0-Z ), Inte2er*4 ( I-N )
C
COMMON
$ /PARM/UOiZO»ZR»MLiUSTARfKjG»RHOE»RHOA»BELTA»BETA»GAMMAF>CcLOU
C
REALMS MLiK
C
RIF = G*(RHOG-RHOA)/RHOA*HEFF/USTAR/USTAR
C
RETURN
END
c
C
C
C RICHARDSON NUMBER (RIt)
C
FUNCTION RIFt(teiap»HEFF)
Implicit Resl*S ( A-H? 0-Z ), InteSer*4 ( I-N )
COMMON
$ /FARM/ UO»ZOiZR»MLfUSTARfKfGiRHOE»RHOAfDELTA»BETAiBAMMAF»CcLOM
$/comstm/ istobjtsnibjpsmbjh'Jinidjisof 1 ftsurf>ihtf 1 >htco»iwtf 1 rutco>
$ hums re
$/S!P/ Blphcjslphsl
C
REAL*9 MLfK
C
wind = uO*(heff/zO)**3lphs
RIFt = dro5xl 0-Z )» Inte3er*4 ( I-N )
c
~ SYS$DEGADIS:RIPHIF.FOR 20-ocT-i?87 00:24:45
-------
F-109
coiuifion /phicora/ iphif 1 j
C
F-hif= 0.
Soto(10>1000»2000»3000»9000)>iphifl
2oto 9000
L
10 IF(RI) 100>200?300
C
100 PHIF = 0,747(1, t 0,65*ABS(RI)**,6)
RETURN
C
200 PHIF =0,74
RETURN
C
300 PHIF = 0,74 + 0,25*(RI)**0,7 + 1.2E-7*RI*RI*RI
RETURN
c
C
1000 IF(RI) 1100?1200fl300
C
1100 PHIF = 0,8S/(1, -f 0,65*ABS(RI)**.6>
RETURN
C
1200 PHIF =0,88
RETURN
C
1300 PHIF = 0.8S + 9,9e-2*(RI)**1.04 + 1.4E-25*RI**5,7
RETURN
c
c
e
2000 corrl = 0,25* rit**.666666 + 1,
carr = sart(corrl)
riw = ri/corrl
IF(RI) 2100»2200f2300
C
2100 PHIF = 0,S8/(1, + 0.65*ABS(RIw)**,6)/corr
RETURN
C
2200 PHIF = 0,88/corr
RETURN
C
2300 PHIF = (0,88 i 9,9e-2*(RIw)**l,04 f l,4E-25*RIw**5.7)/corr
RETURN
c
c
3000 corrl = 0,25* rit**,666666 t 1,
corr = sort(corrl)
riw = ri/corrl
IF(RI) 3100»3200»3300
C
2 — SYStDEGADISJRIPHIF.FOR 20-OCT-1987 00:24M5
-------
F-110
3100 PHIF = 0,88/corr
RETURN
C
3200 PHIF = 0,88/corr
RETURN
C
3300 PHIF = (0,88 + 9,9e-2*(RIw)**l,04 + 1,4E-25*RIw**5,7)/corr
RETURN
c
c
9000 csll trsp(29)
return
END
c
c
C, , • , t ,,,,,.»,.,.,,,,,,,, , .,,.,. t ,,.,,,,,..,,,,..,, , , , , , , , , ,
c
c
function phihst(rho»fetch)
Implicit Resl*8 ( A-H> 0-Z )» Inteser*4 ( I-N )
c
k?S.« rhoe> rhos > de 1 ts> bets j^smmsf »cc low
$/phicom/ iFhifljdellsy
dst3 phic/3.1/
if(rho ,le, rhos) then
phihst = 0,83
return
endif
FOW = l,/?lFhsl
pi = 1,04/zlphsl
Ci = 2t(rho-rhos)/rhos*rO/ust3r**2*3smiri3f/3lph3l
Ci =Ci* (k*ustsr*3lphsl**2 /uO/zO/ phic*dellsy/(dell3y-l, )) ** POU
GIF = 0,099*Ci**l,04
phihst = dlo2((.88i Cip*fetch**pl)/,88)/Cip/fetch
phihst = 1, /Phihst
return
end
tm
3 ~ SYS$DEGADIS:RIPHIF.FOR 20-OCT-1987 00:24:45
-------
F-lll
C "
r
C SUBROUTINE RKGST
C
c...... •
c
c This routine wss originally supplied by Digits! Ectuipment
c Corporstion as part of the Scientific Subroutine Package
c svsilsble for RT-11 ss pert of the Fortran Enhancement
c Package. It uss upgraded for use ss the integration
c routine in this pscksge,
c
c.
v_
C PURPOSE
C TO SOLVE A SYSTEM OF FIRST ORDER ORDINARY DIFFERENTIAL
C EQUATIONS WITH GIVEN INITIAL VALUES.
_C
C USAGE
C CALL RKGST (PRMT,Y«DERY>NDIMjIHLF>FCT>OUTP»AUX)
C PARAMETERS FCT AND OUTP REQUIRE AN EXTERNAL STATEMENT.
C
C DESCRIPTION OF PARAMETERS
C
C PRMT AN INPUT AND OUTPUT VECTOR WITH DIMENSION GREATER
C OR EQUAL TO 5i WHICH SPECIFIES THE PARAMETERS OF
C THE INTERVAL AND OF ACCURACY AND WHICH SERVES FOR
C COMMUNICATION BETWEEN SUBROUTINES CUTP AND FCT
C (FURNISHED BY THE USER) AND SUBROUTINE RKGST,
C EXCEPT PRMT(5) THE COMPONENTS ARE NOT DESTROYED
C BY SUBROUTINE RKGST AND THEY ARE:
C PRMT(l) LOWER BOUND OF THE INTERVAL (INPUT),
C PRMT<2) UPPER BOUND OF THE INTERVAL (INPUT),
C PRMT(3> INITIAL INCREMENT OF THE INDEPENDENT VARIABLE
C (INPUT).
C PRMT(4> UPPER ERROR BOUND (INPUT). IF RELATIVE ERROR IS
C GREATER THAN PRMT<4)t INCREMENT GETS HALVED,
C IF RELATIVE ERROR LESS THAN PRMT(4)*EXPAND>
C INCREMENT GETS DOUBLED,
C THE USER MAY CHANGE PRMT(4) BY MEANS OF HIS
C OUTPUT SUBROUTINE.
C FRMT(5) MAXIMUM STEP SIZE ORDER OF MAGNITUDE (INPUT),
C SUBROUTINE RKGST INITIALIZES
C PRMT(5)=0, IF THE USER WANTS TO TERMINATE
C SUBROUTINE RKGST AT ANY OUTPUT POINTr HE HAS TO
C CHANGE PRMT(5) TO NON-ZERO BY MEANS OF SUBROUTINE
C OUTP. FURTHER COMPONENTS OF VECTOR PRMT ARE
C FEASIBLE IF ITS DIMENSION IS DEFINED GREATER
C THAN 5, HOWEVER SUBROUTINE RKGST DOES NOT REQUIRE
C AND CHANGE THEM, NEVERTHELESS THEY MAY BE USEFUL
C FOR HANDING RESULT VALUES TO THE MAIN PROGRAM
1 — SYSSDEGADISIRKGST.FOR 20-OCT-1987 OOJ25:i3
-------
F-112
C (CALLING RKGST) WHICH ARE OBTAINED BY SPECIAL
C MANIPULATIONS WITH OUTPUT DATA IN SUBROUTINE OUTP.
C Y INPUT VECTOR OF INITIAL VALUES, (DESTROYED)
C LATER, Y IE THE RESULTING VECTOR OF DEPENDENT
C VARIABLES COMPUTED AT INTERMEDIATE POINTS X,
C DERY INPUT VECTOR OF ERROR WEIGHTS, (DESTROYED)
C ERROR WEIGHTS ARE CENTERED AT ONE, IF ONE PARA-
C METER NEEDS A TIGHTER ERROR CRITERIA,THE WEIGHT IS
C GREATER THAN ONE, IF A PARAMETER NEED NOT BE DETER-
C MINED SO PRECISELY,THE WEIGHT SHOULD BE LESS
C THAN ONE.IN OTHER WORDS,
C ERROR CRITERIA(I) = PRMTC4) / WEIGHT(I)
C WHERE I IS THE SUBSCRIPT OF A DEPENDENT VARIABLE,
C LATER? DERY IS THE VECTOR OF DERIVATIVES* WHICH
C BELONG TO FUNCTION VALUES Y AT A POINT X,
C NDIM AN INPUT VALUE, WHICH SPECIFIES THE NUMBER OF
C EQUATIONS IN THE SYSTEM,
'C IHLF AN OUTPUT VALUE, WHICH SPECIFIES THE NUMBER OF
C BISECTIONS OF THE INITIAL INCREMENT, IF IHLF BE-
C COMES GREATER THAN 10> SUBROUTINE RKGST RETURNS THE
C ERROR MESSAGE IHLF=11 INTO MAIN PROGRAM. ERROR
C MESSAGE IHLF=12 OR IHLF=13 APPEARS IN CASE
C PRMT(3)=0 OR IN CASE SI6N(PRMT(3)),NE,SIGN(FRMT(2)-
C FRMT(D) RESPECTIVELY.
C FCT THE NAME OF AN EXTERNAL SUBROUTINE USED. THIS
C SUBROUTINE COMPUTES THE RIGHT HAND SIDES DERY OF
C THE SYSTEM TO GIVEN VALUES X AND Y. ITS PARAMETER
C LIST MUST BE X»Y,DERY,PRMT, SUBROUTINE FCT SHOULD
C NOT DESTROY X AND Y,
C OUTP THE NAME OF AN EXTERNAL OUTPUT SUBROUTINE USED.
C ITS PARAMETER LIST MUST BE X,Y,DERY,IHLF,NDIM,PRMT.
C NOME OF THESE PARAMETERS (EXCEPT, IF NECESSARY,
C PRMT(4),PRMT(5),.,.) SHOULD BE CHANGED BY
C SUBROUTINE OUTP. IF PRMT(5) IS CHANGED TO NON-ZERO,
C SUBROUTINE RKGST IS TERMINATED,
C AUX AN AUXILIARY STORAGE ARRAY WITH 8 ROWS AND NDIM
C COLUMNS,
C
C REMARKS
r
w
C THE PROCEDURE TERMINATES AND RETURNS TO CALLING PROGRAM, IF
C (1) MORE THAN 10 BISECTIONS OF THE INITIAL INCREMENT ARE
C NECESSARY TO GET SATISFACTORY ACCURACY (ERROR MESSAGE
C IHLF=11)»
C (2) INITIAL INCREMENT IS EQUAL TO 0 OR HAS WRONG SIGN
C (ERROR MESSAGES IHLF=12 OR IHLF=13)»
C (3) THE WHOLE INTEGRATION INTERVAL IS WORKED THROUGH,
C (4) SUBROUTINE OUTP HAS CHANGED PRMT(5) TO NON-ZERO.
C
C SUBROUTINES AND FUNCTION SUBPROGRAMS REQUIRED
C THE EXTERNAL SUBROUTINES FCT(X»Y,DERY,PRMT) AND
2 — SYS$DEGADIS:RKGST.FOR 20-OCT-1987 00:25:13
-------
F-113
C OUTF'(XjY,DERYfIHLFrNDIM,FRMT) MUST BE FURNISHED BY THE USER,
C
C METHOD
C EVALUATION IS DONE BY MEANS OF FOURTH ORDER RUNGE-KUTTA
C FORMULAE IN THE MODIFICATION DUE TO GILL, ACCURACY IS
C TESTED COMPARING THE RESULTS OF THE PROCEDURE WITH SINGLE
C AND DOUBLE INCREMENT,
C SUBROUTINE RKGST AUTOMATICALLY ADJUSTS THE INCREMENT DURING
C THE WHOLE COMPUTATION BY HALVING OR DOUBLING, IF MORE THAN
C 10 BISECTIONS OF THE INCREMENT ARE NECESSARY TO GET
C SATISFACTORY ACCURACY? THE SUBROUTINE RETURNS WITH
C ERROR MESSAGE IHLF=li INTO MAIN PROGRAM.
C TO GET FULL FLEXIBILITY IN OUTPUT* AN OUTPUT SUBROUTINE
C MUST BE FURNISHED BY THE USER,
C FOR REFERENCE- SEE
C RALSTON/WILF» MATHEMATICAL METHODS FOR DIGITAL COMPUTERS?
C WILEY* NEW YORK/LONDON? 1960; PFM10-120,
C
C SOME NOTES ON THE PROGRAM/RALSTON AND WILF
C
C AUX
C AUXCljI) ~ CURRENT VALUE OF Y
C AUX(2>I) -- CURRENT VALUE OF Y'
C AUX(3rI) ~ LAST GOOD VALUES OF Q
C AUX(4,I) — Y AFTER ONE RK STEP H
C AUX(SiI) — Y AFTER ONE OR TWO RK STEPS OF H/2,
C AUX(6..I) -- CURRENT VALUES OF Q
C AUX(7,I) -- Y' AFTER ONE OR TWO RK STEPS OF H/2.
C AUX(8?I) — 2/15 * WEIGHTS
C
C A(4)»B<4)fC(4)
C
C
C Y = Y i A *Y )
C 3 02
3 — SYS$DEGADIS:RKGST.FOR 20-OCT-1987 00:25:13
-------
F-114
C
C K = H * F(X +H»Y )
C 4 03
C
C RELATIVE ERROR
C
C
C AS PER RICHARDSON QUOTED IN RALSTON/WILF (F117),
C
C ABS ERROR = WEIGHT/15*ABSFCT»OUTP»AUX)
Implicit Resl*8 ( A-H, 0-2 ), Inte«Jer*4 ( I-N )
C
C
PARAMETER (EXPAND=0,05)
DATA ERRSET/1./ ! dummy value
C
DIMENSION Y(l)fDERY(D«AUX(8»NDIM)»A(4),B<4)»C(4)»PRMTCD
C
DO 10 I=1,NDIM
10 AUX(8»I)=,133333333333333333DO * DERY(I)
X=PRMT(1)
XEND=PRMT(2)
H=PRMT(3)
IHLFMX = INT(dLOG(ABS(PRMT(5)/PRMT(3)))/,6931472 + ,5)
PRMT(5)=0.
CALL FCT(XtY»DERYiPRMT)
C
C*** ERROR TEST
C
IF(H*(XEND-X))380»370f20
C
C*** PREPARATIONS FOR RUNGE-KUTTA METHOD
4 — SYS$DEGADIS:RKGST,FOR 20-OCT-1987 00:25:13
-------
F-115
20
AU> = ,5
A(2)= 1
A(3)= 1
A(4)= 1
B(l)=2.
B(2)=l.
2(3)=1.
B<4)=2.
.DO -
.DO I
. DO/6 .
DSQRT(
DSQRT(
DO
0.5DO )
0.5DO )
C(2)= A(2)
C(3)= A(3)
C(4)=,5
r
C*** PREPARATIONS OF FIRST RUNGE-KUTTA STEP
r
w
DO 30 I=1»NDIM
AUX(lfI)=Y(I)
AUX(2»I)=DERY(I)
AUX(3fI)=0.
30 AUX(6»I>=0,
IREC=0
H=HfK
IHLF=-1
ISTEP=0
IEND=0
C
C*** START OF A RUNGE-KUTTA STEP
C*** STEP = 2 * SPECIFIED STEP
C
40 IF«X+H-XEND)*H)70»60i50
50 H=XEND-X
60 IEND=1
C
C*** RECORDING OF INITIAL VALUES OF THIS STEP
C
70 CALL FCT(XjY»DERY»PRMT)
CALL OUTP(XfY»DERYiIREC»NDIMfPRMT>
IF(PRMT(5»400»80i400
SO ITEST=0
90 ISTEP=ISTEP+1
C
C*** START OF INNERMOST RUNGE-KUTTA LOOP
C
J=l
100 AJ=A(J)
BJ=B(J)
CJ=C(J)
DO 110 I=1,NDIM
R1=H*DERY(I)
R2=AJ*(R1-BJ*AUX<6»D)
5 — SYS$DEGADIS:RKGST,FOR 2o-ocT-i?87 00:25:13
-------
F-116
Y(I)=Y(mR2
R2=R2+R2+R2
110 AUX(6»I)=AUX(6»I)+R2-CJ*R1
IF(J-4)120»150>150
120 J=J+1
IF(J-3)130»140»130
130 X=XtH/2.
140 CALL FCKXfYiDERYiPRHT)
GOTO 100
r
i_-
C*« END OF INNERMOST RUNGE-KUTTA LOOP
C
C*** TEST OF ACCURACY
C
150 IF=Y(I>
ITEST=1
ISTEP=ISTEP-HSTEP-2
180 IHLF=IHLFH
X=X-H
H=H/2.
DO 190 I=1»NDIM
Y(I)=AUX(1»I)
DERY(I)=AUX(2>I)
190 AUX(6>I)=AUX(3fI>
GOTO 90
IN CASE ITEST=1 TESTING OF ACCURACY IS POSSIBLE ONLY IF EACH
HALF OF THE INTERVAL IS DONE(I.E.»IFF ISTEP IS EVEN)
C
200 IMOD=ISTEP/2
IF(ISTEP-IMOB-IMOD)210i230»210
210 CALL FCT(X»Y»DERYfPRMT)
DO 220 I=1»NDIH
AUX(5>I)=Y(I)
220 AUX(7»I)=DERY(I)
GOTO 90
ORIGINAL VERSION? absolute error
C
C COMPUTATION OF TEST VALUE DELT
C 230 DELT=0. .'Good so fsr
C DO 240 I=1»NDIH
C 240 DELT=DELTtAUX(8»I)*ABS(AUX(4iI)-Y(I))
C IF(DELT-PRMT(4))280»280»250
C
6 — SYS$DEGADIS:RKGST,FQR 20-OCT-1987 00:25:13
-------
F-117
C*** RELATIVE ERROR
C
230 DELT = 0,
DO 240 I=lfNDIH
ARG = ABS(AUX(4»I) + Yd))
IF(ARG .EQ, 0.) sra = .25*ABSsux(4»i)=y(i)=0,05 rer=0,
RER = AUX(8»I)*ABS
-------
F-118
330 IMOD=ISTEP/2
IF(ISTEP-IMOD-IMOI040j340,40
EXPAND H DUE TO LOW ERROR VALUE
ONLY IF TWO CONSECUTIVE STEPS WITHOUT MENTION OF ERROR HAVE
COMPLETED, FACTOR USED FOR EXPANSION (EXPAND) WAS SHOWN TO WORK
REASONABLY WELL FOR A PERIODIC FUNCTION, VALUES AS HIGH AS
C*** EXPAND=.5 WILL PRODUCE GOOD RESULTS FOR MONOTONIC FUNCTIONS,
C
340 IF(DELT-EXPAND*PRMT(4)) 350,350,40
350 IHLF=IHLF-1
ISTEP=ISTEP/2
H=HtH
GOTO 40
C
Cm RETURNS TO CALLING PROGRAM
C
360 IHLF=li
CALL FCT(X»Y,DERY»PRMT>
GOTO 390
370 IHLF=12
GOTO 390
3SO IHLF=13
390 CALL FCT(X»Y»DERYiPRHT)
CALL OUTP(X,Y/DERY,IHLF,NDIM,PRMT)
400 RETURN
END
****
SYS$DEGADIS:RKGST,FOR 20-ocT-i?87 00:25:13
-------
F-119
C
C SUBROUTINE RTHI
C
c..., » ,.,,,,,,,,,, f
C
c This routine wss orisinslly supplied by Digital Eouipinent
c Corporation ss part of the Scientific Subroutine Package
c available for RT-11 ss part of the Fortran Enhancement
c PscksSe, It wss adopted for use in this package,
i_
c,,,,,,,,,,,,,,,,,, , », ,,,,, ,,,,»,»,»,»»,,
c
C PURPOSE
C TO SOLVE GENERAL NONLINEAR EQUATIONS OF THE FORM FCT(X)=0
C BY MEANS OF MUELLER-S ITERATION METHOD.
C
C USAGE
C CALL RTMI (X»F»FCT»XLI»XRI»EPSjIENB»IER)
C PARAMETER FCT REQUIRES AN EXTERNAL STATEMENT,
C
C DESCRIPTION OF PARAMETERS
C X RESULTANT ROOT OF EQUATION FCT(X)=0,
C F - RESULTANT FUNCTION VALUE AT ROOT X,
C FCT - NAME OF THE EXTERNAL FUNCTION SUBPROGRAM USED,
C XLI - INPUT VALUE WHICH SPECIFIES THE INITIAL LEFT BOUND
C OF THE ROOT X,
C XRI - INPUT VALUE WHICH SPECIFIES THE INITIAL RIGHT BOUND
C OF THE ROOT X,
C EPS - INPUT VALUE WHICH SPECIFIES THE UPPER BOUND OF THE
C ERROR OF RESULT X,
C IEND - MAXIMUM NUMBER OF ITERATION STEPS SPECIFIED.
C IER - RESULTANT ERROR PARAMETER CODED AS FOLLOWS
C IER=0 - NO ERROR»
C IER=1 - NO CONVERGENCE AFTER IEND ITERATION STEPS
C FOLLOWED BY IEND SUCCESSIVE STEPS OF
C BISECTION?
C IER=2 - BASIC ASSUMPTION FCT(XLI)*FCT(XRI) LESS
C THAN OR EQUAL TO ZERO IS NOT SATISFIED,
C
C REMARKS
C THE PROCEDURE ASSUMES THAT FUNCTION VALUES AT INITIAL
C BOUNDS XLI AND XRI HAVE NOT THE SAME SIGN, IF THIS BASIC
C ASSUMPTION IS NOT SATISFIED BY INPUT VALUES XLI AND XRI» THE
C PROCEDURE IS BYPASSED AND GIVES THE ERROR MESSAGE IER=2,
C
C SUBROUTINES AND FUNCTION SUBPROGRAMS REQUIRED
C THE EXTERNAL FUNCTION SUBPROGRAM FCT(X) MUST BE FURNISHED
C BY THE USER,
C
1 — SYSSDEGADIS:RTMI,FOR 20-OCT-1987 00526:51
-------
F-120
C METHOD
C SOLUTION OF EQUATION FCT(X)=0 IS DONE BY MEANS OF MUELLER-S
C ITERATION METHOD OF SUCCESSIVE BISECTIONS AND INVERSE
C PARABOLIC INTERPOLATION? WHICH STARTS AT THE INITIAL BOUNDS
C XLI AND XRI, CONVERGENCE IS QUADRATIC IF THE DERIVATIVE OF
C FCT(X) AT ROOT X IS NOT EQUAL TO ZERO. ONE ITERATION STEP
C REQUIRES TWO EVALUATIONS OF FCT(X). FOR TEST ON SATISFACTORY
C ACCURACY SEE FORMULAE (3,4) OF MATHEMATICAL DESCRIPTION.
C FOR REFERENCE.. SEE G, K. KRISTIANSEN, ZERO OF ARBITRARY
C FUNCTION, BIT, VOL. 3 (1963), PP.205-206.
C
C
SUBROUTINE RTMI(X,F,FCT,XLI,XRI,EPS,IEND,IER)
Implicit Resl*S ( A-H» 0-Z ), Inte«ier*4 ( I-N )
C
C
C PREPARE ITERATION
IER=0
XL=XLI
XR=XRI
X=XL
TOL=X
F=FCT(TOL)
IF(F)l,16rl
i FL=F
X=XR
TOL=X
F=FCT
-------
F-121
INTERCHANGE XL AND XR IN ORDER TO GET THE SAME SIGN IN F AND FR
6 TOL=XL
XL=XR
XR=TOL
TOL=FL
FL=FR
FR=TOL
7 TOL=F-FL
A=A-i-A
IF(A-FR*(FR-FL))8,9»9
8 IF(I-IEND)17»17>9
? XR=X
FR=F
C
C TEST ON SATISFACTORY ACCURACY IN BISECTION LOOP
TOL=EPS
A=ABS(XR)
10 TOL=TOL*A
11 IF(DABS(XR-XL)-TOL)12»12»13
12 IF16»18
C
C TEST ON SATISFACTORY ACCURACY IN ITERATION LOOP
IS TOL=EPS
A=ABS(X)
IF(A-l,)20»20fl9
19 TOL=TOLtA
20 IF(dABS(DX)-TOL)21>21»22
3 ~ SYSJDEGADIS:RTMI.FOR 2o-ocT-i?87 00:26:51
-------
F-122
21 IF(dABS(F)-TQLF)16fl6i22
C
C PREPARATION OF NEXT BISECTION LOOP
22 IF23»24
23 XR=X
FR-F
GO TO 4
24 XL=X
FL=F
XR=XM
FR=FM
GO TO 4
C END OF ITERATION LOOP
C
C
C ERROR RETURN IN CASE OF WRONG INPUT DATA
25 IER=2
RETURN
END
****
4 ~ SYSfDEGADis:RTMi,FOR 20-ocT-i?87 00:26:51
-------
F-123
PROGRAM SDEGADIS2
c
cmmmmmmmmmmmmmMmmmmmmmmmmm*
#*w
c
C Program description:
C
C SDEGADIS2 is s simplification of DEGADIS2 which performs the downwind
C dispersion portion of the calculation for s stesdy stste source
C described by DEGADIS1,
C
C
C Program ussSet
C
C Consult Volume III of the Final Report to U, S, Coast Guard
C contract DT-CG-23-30-C-20029 entitled 'Development of sn
C ____ Atmospheric Dispersion Model for Heavier-thsn-Air Gss Mixtures'.
C
C J, A. Havens
C T, 0* Spicer
C
C University of Arkansas
C Department of Chemical Engineering
C Fsyetteville? AR 72701
C
C April 1935
C
C
C This project was sponsored by the U, S. Coast Guard snd the Gas
C Research Institute under contract BT-CG-23-80-C-20029.
C
C
C Disclaimer!
C
C This computer code material was prepared by the University of
C Arkansas as an account of work sponsored by the U. S. Coast Guard
C and the Gas Research Institute. Neither the University of Arkansas?
C nor any person acting on its behalf:
C
C s. Makes any warranty or representation* express or implied?
C with respect to the accuracy.' completeness? or usefulness
C of the information contained in this computer code material?
C or that the use of any apparatus? method? numerical model?
C or process disclosed in this computer code material may not
C infringe privately owned rights? or
C
C b, Assumes any liability with respect to the use of? or for
C damages resulting from the use of? any information?
C apparatus? method? or process disclosed in this computer
C code material.
1 — SYS$DEGADIS:SDEGADIS2,FOR 20-OCT-1987 OOJ55J21
-------
F-124
Implicit Resl*8 ( A-H> 0-Z )» Inte«ier*4 ( I-N )
include 'sas*deS3dis:DEGADIS2.dec'
include '($ssdef)'
EXTERNAL PSS t PSSOUT , SSG t SSGOUT
COMMON
$/TITL/ TITLE
S/BEN2/ DEN(SiiSen)
$/PARM/ UOiZO»ZRf ML »USTAR»KiG»RHOEiRHOAf DELTA iBETAf6AMMAF»CcLOW
$ 23S_Ufl»33S_lfl>23S_ZSP»S3S_ri3IIie
$/ITI/ T1»TINP»TSRC»TOBS
*/coBistni/ i stsb » tamb » psmb > humi d ? i sof 1 1 tsu r f > ihtf 1 ? htco » i wtf 1 » wtco »
$ hums re
$ /ERROR/ SYOER F ERRP » SMXP 5 WTSZP f UTS YP » WTBEP » WTDH > ERRG » SMXG »
$ WTRUH»UTDHG
$/STP/ STPP » ODLP » ODLLP i STPG i ODL6 > ODLLG
*/com_ss/ ESS»SLEN>SUID»OUTCc»OUTSZ»OUTBiOUTLjswcl»sw3ljsenljsrhl
$/PHLAG/ CHECK1 i CHECK2f AGAIN F CHECKS fCHECK4» CHECKS
$/com_fl/ cfls2>clfl»cufl
S/NEND/ POUNDNiPOUND
f/ALP/ ALPHAFslphsl
$/phicoa/ iphifl»delley
$/sprd_con/ ce> delrhooin
*/COM_SURF/ HTCUT
C
C
C DIMENSIONS/DECLARATIONS
C
logics! cfl32
ttl
PEAL*8 KfML»L
LOGICAL CHECK1FCHECK2FAGAINFCHECK3FCHECK4FCHECK5
c
chsrscter*24 tinp?tsrotobs
chsrscter*SO title<4)
ch3rscter#4 pound
ch3rscter*3 23s_nsrae
C
ch3rscter*4 TR2»ER2>Sr3»SSD»TR3
C
2 — SYS$DEGADIS:SDEGADIS2.FOR 20-OCT-1987 OOJ55:21
-------
F-125
cherscter
EQUIVALENCE (OPNRUP(1>» OFn TUP1)
c
dimension prmt(22) ?y(6) »dery(6) jsux(8j(£)
C
C
C
C DATA
C
DATA POUND/'// V.POUNDN/-1,D-20/
C
DATA TI«EO/0./»NDIM/0/
C
DATA TR2/',TR2'/»ER2/',ER2'/
DATA Sr3/'.Sr3'/
DATA SSD/'.SSD'/»TR3/',TR3'/
C
C MAIN
C
Tl = SECNDS(0.)
istst = lib$d3te_tiroe(TOBS)
if(istst .ne. 5st_noriftsl) stop'libtdste-tiaie fsilure'
C
C*** GET THE FILE NAME FOR FILE CONTROL
C
resd(5>1135) nchsr>opnrup
1135 for(iist(Qj40sl)
C
opnrupl = opnrupldtnchsr) // ER2C1J4)
CALL ESTRT2ss(OPNRUPl)
C
C*** GET THE COMMON VARIABLES CARRIED FROM DEGADIS1
C
opnrupl = oFnrupldJnchsr) // tr2(lM)
CALL STRT2(OPNRUP1»H.inssrte..CCP)
C
opnrupl = opnnjpldJnchsr) // sr3(i:4)
OPEN(UNIT=8fTYPE='NEU'fNAME=OPNRUPl»
$ CARRIAGECONTROL='FORTRAN')
c
cflsd = isofl.ea. l.or. ihtfl.ea, 0
C
URITE(8flll9)
if(cflsa) then
WRITE(8flll6) ^3S_zspf(100,*23s_lfl)f(100,*23
HRITE(8flll8)
else
3 ~ SYS$DEGADISJSDEGADIS2.FOR 20-OCT-1987 OOJ55J21
-------
F-126
WRITE* 8, 11 15) S3S_zsp»dOO.*33s_lfl).»dOO.*S3s_ufl>
WRITE(8flll7)
end if
URITE(S,1119)
c
C
C
1115 FORMATdHO»lX» 'Distance' »2xf3xi 'Mole'*3xr
1 'Concentration' »lx» 'Density' i 2x?3x> 'Gamma' »4x>
1 'Temperature '>3xj 'Half '» 4x> 4x>'Sz'f5xf4xr'Sy'>5:c>
1 'Width st z='»0pf6.2j' is tot ' ,/»lxr llxjlx'Frsction' »2x»
1 llx»llxjllxillxf3x»'Width'»3x>llx»9x»
1 2(lp29,3»'»oleZ'flx))
1116 FORMATdHO* IX? 'Distance' »2x*3x» 'Mole' »3x»
1 'Concentration' > !:;» 'Density' >2x»
1 'Temperature 'r3x» 'Half '>4x»4x»'Sz/t5x»4x»'Sy'f5x»
1 'Width st z='»0pf6»2»' nt to! 'f/jlxrllx>lx'Fraction'f2xj
1 llxjll;:Jll;:»3x»'Width'J3x»llx,9x,
1117 FORMATUH »4Xf '(«) 'i4x» llxi
1 2(lX»'(kS/m**3)'»lx)»12x»4x>'
1113 FORMATdH
1 2(1X» ' (k^/ni**3) ' » Ix) >4xf ' (K)
1 5(8X»'(ro)'»
1119 FORMATdH )
c
c
c
C STEADY STATE CALCULATIONS
opnrupl = opnrupldtnchar) // ssddM)
c OPEN(UNIT=91TYPE='NEW',NAME=OPNRUP1)
C
C
AGAIN = .FALSE,
L = OUTL
B = OUTB
SZO = OUTSZ
Erate = ESS
QSTRO = Erste/2.DO/L/B
Cc = OUTCc
we = swcl
WS = SMSl
snth = senl
rho = srhl
4 -- SYS$DEGADIS:SDEBADIS2,FOR 20-OCT-1987 00:55J21
-------
F-127
c
if(cc»3t, CCP) then
write(lunlos«1126) CCICCF
1126 fornist(/»' ' »10( '#***') >/r ' cci 'ilpgl3,5»' is
1 ' than CCP: 'flFdl3,5,/f' ' 1 10( '****')>/)
CC =CCP
endif
C
rstiol= uOfczO/slphsl/ zO#*slph3l * cc /b/ostrO/1
ratio = rstiol* szO**3lphsl * (B + sart?i/2.DO*syOer)
if(rstio,lt, l.DO) then
syOer = w3l3y>ycl3yf yslsyj cclsy » rholsyjwjenthlsyjt)
c
C
let everyone Know
URITE(lunlo2fH70) L»B
WRITE(lunloS»1130) QSTRO^SZO
write(lunlo2»1135) wclsyjwslsyfrholsyj cclsy ft
write(lijnlo2»HS6) wcfW3>rhorcc
c
1170 FORMAT (' LENGTH: 'ilpG13.5i' BEFF: MpG13,5)
1180 FORHATC TAKEUF FLUX: MpG13.5f' SZO: SlpG13,5)
1185 formstC wclsy: '»lFgl2,5f' wslsyl '»lp^!2,5»
1 ' rholsyJ '»lpgl2.5»' Cclsy: ' »lpgl2,5f/i
1 ' temlsy: '»1P313.5)
1136 formstC we: '»1?S12.5>' ws: ' r lPdl3.5»/>
1 ' rhol '»lP3l2.5»' Cc: S1P212.5)
C
C*** PREPARE FOR STEADY STATE INTEGRATION.
C
PRMT(l) = L/2.DO
PRMT(2) = 6.023D13
PRMT(3) = STPP
PRMT(4) = ERRP
5 — SYS$DEGADIS:SDEGADIS2.FOR 20-OCT-1987 00555:21
-------
F-128
F'RMT(5) = SMXP
PRMT(6) = Erste
PRHT(7) = Cc ! OUTPUT
PRMT(S) = B ! OUTPUT
r
u
C*** PRMT(9) 8 PRMT(IO) ARE CONSTANTS FOR D(SY) S D(SZ)
C
PRMT(9) = Ce*sart(G*ZO/ALPHAl*GAMMAF) *GAMMAF/UO
FRMT<10)= ZO**ALPHA*K*USTAR*ALPHA1 * ALPHA1/UO
C PRMT(11)= NREC
C PRMT(12)=
C PRMT(13)=
printClS)= uO*rO/3lphsl
print (19) = rho3#k#ust3r#3lph3l
prmt(20)= rholsy
prn,t(21) = srO
prmt(22)= szO
C
Yd) = rholsy*prmt(18)*(SZO/zQ)**slph3l ! rhol3y*ueff*heff
Y(2) = SYOER*syOer
Y(3) = B + sGrtpi/2.DO*saOer
Y(4) = 0» ! sdded hest
Y(5) = 0. ! rnsss sbove UFL
Y<6) = 0. ! ffisss sbove LFL
C
DERY(l) = WTSZP
DERY(2) = WTSYP
DERYC3) = UTBEP
dery(4) = wtdh
dery(5) = l.DO
dery(6> = l.DO
C
c NDIM = 4
ndiffi=6 ! to integrate the mass sbove LFL and UFL
C
URITE(lunlog»1130)
1130 FORMAT(' Enterir.3 InteSrstion Step — B > 0. ')
C
C*** PERFORM INTEGRATION
C
CALL RK6ST(PRMT»Y»DERYiNDIM»IHLF»PSS»PSSOUT»AUX)
C
IFdHLF ,GE, 10) CALL tr3p(9»IHLF)
C
NREC = INT(PRMTdl))
URITE(lunlo2»1100)NREC
1100 FORMAT(3Xi'NUMBER OF RECORDS IN PSS = '110)
C
IF(AGAIN) THEN
Y(3) = Y(5) ! mass sbove UFL
Y<4) = Y(6) ! »sss sbove LFL
6 — SYS$DEGADIS:SDEGADIS2,FOR 20-OCT-1987 00:55221
-------
F-129
GO TO 120
END IF
C
C*** GAUSIAN COhPLETION OF THE INTEGRATION
C
C*#* PSSOUT FORCES THE ABOVE INTEGRATION TO FINISH WHEN B<0 FOR THE
FIRST TIME. THE STEP BEFORE THIS OCCURS IS RECORDED ON UNIT 7,
THE STEP WHEN B GOES NEGATIVE IS CURRENTLY IN Y,
THE CALCULATION METHOD CHANGES THE CURRENT VALUE OF SY TO A VALUE
CALCULATED AS IF BEFF=SY RETAINING THE LAST VALUE OF Cc IN THE
MATERIAL BALANCE,
C
nest = Y(4)
rholsy = ?rmt(20)
Cc = FRMT(7)
rhouh = Yd)
SZ = ( rhouh/rholay/prmtdS) >**
-------
F-130
YC4) = Y(6) ! asss sbove LFL
P
w
DERYC1) = wtr-uh
der«(2) = wldh*
dsfi'(3) = i.DO
dery(4> = I.DO
r
Ur
c NDIM = 2
ndini=-1 ! to ir,le=!rste the insss sbove LFL and UFL
C
1140 FORMATC Entering Gs^sian SUie cf Integration ')
C
C*** PERFORM INTEGRATION
C
CALL RKGST(PRMT,Y,DERY»NDIM,IKLFiSSG»SSGOUT»AUX)
C
IFdHLF >GE, 10) CALL trspClO? IHLF)
C
NREC = INT(PRMTdl))
C
120 CONTINUE
c
c*** summarize the informstion about the ffisss sbove the LFL.• UFL
c
w ri te (S»SOOO) 100»'*2as_uf 1 »100.$2ss_lf1T Y(4)-Y(3)? Y(4)
SOOO format1P213,3»' mole percent:'»
$//»' The mass of contaminant between the UFL snd LFL iz".'
ir' KS»'»/»' The rnsss cf cor.lsaiincnl £-bove the LFL is! ' .•
t1 k3.'>
C
C
C.,, ,
c
c CLOSE(UNIT=9)
CLOSE(UNIT=S)
C
opnrupl = opnrupldtnchsr) // trZ(lM)
CALL TRANS(OPNRUP1)
C
ttl = tl
Tl = SECNDS(tTl)/60,
WRITEdunlo2»4000) TOBS
URITE(lunloa»4010) Tl
4000 FOR«AT(//j'SDEGADIS2 —>'>//>3Xf'BEGAN AT ',A40)
4010 FORMAT<3X»'*H: ELAPSED TIME ##* '»lpG13.5»' ain')
C
STOP-
END
S — SYS*DEGADIS:SDEGADIS2.FOR 20-OCT-19S7 00:55:21
-------
F-131
function
This function estimates the infinite series used in the evaluation
of the mass ebove a certain concentration level.
c
c
c*** WARNING; This routine will overflow for arguments greater than 13.8
c
implicit realms (s-h?o-z)y inte2er*4 (i-n)
C
parameter (kmax= 100» error=l.d-4)
c
coiiiiiion/alF/ alpha jalphal
c
initialize some variables
PP = l.DO/elphal
pprod = PF ! for p*(p+l)*. , ,*
-------
F-132
C
C
C TIME SORT SUPERVISOR
C
SUBROUTINE SORTS(TABLE)
Implicit Resl*8 ( A-H> 0-Z )> Inteser*4 ( I-N )
include 'sys*deS3dis:DEGADIS3,dec/list'
C
COMMON
$/SORT/ TCc(msxnob>msxnt)tTCcSTR(msxnob»msxnt)»
$ Tyc< msxnob ?ia3xnt)»Trho(Bi3xnob»ni3xnt) >
f- T^siDnis(m3xnob>msxnt) jTtempdnsxnobimsxnt)»
$ TSY((iiSxnob»ni3xnt) >TSZ(ra3xnobfiJi3xnt) ?TB(msxnobmsxnt) i
$ TDISTO(maxnob >msxnt)»TDIST(msxnob > msxnt)»KSUB(msxnt)
$/SSCON/ NREC((nsxnob»2)jTO(msxnob)jXlvl(ni3xnob)
$/SORTIN/ TIM(a3xnt)iNTIMfISTRT
$/PARM/ UO»20»ZR»MLjUSTAR»K»GfRHOE>RHOA>DELTAfBETA»GAHMAF>CcLOW
$/CNCBS/ NOBS
C
DIMENSION TABLE(l)
C
REAL*8 ML»K
C
CALL GETTIM
C
r
^
C##* TABLE(I) VALUES
C*** I PARAMETER
cm —
C*** 1 11 BIST 1 TO 10 CURRENT READ
c*** 2 12 Yc
C*** 3 13 Cc 11 TO 20 PREVIOUS READ
4 14 rho
5 15 23mni3
d 16 temp
7 17 SZ
8 IS SY
C*** 9 19 B
C*** 10 20 TS
C
cm 21 BISTO
C*** 22 INTERPOLATION FRACTION
C
BO 100 I = 1»NOBS
C
IT = 0
C
BO 105 J=l?20
1 --• SYS$BEGADIS:SORTS.FOR 20-OCT-1987 00129:22
-------
F-133
105 TABLE(J) = 0,
C
II = NREC(Ifl)
if( ii .ecu 0) Soto 130
c
c*** resd first record
c
resd(9>*) (tsble(Kl)>kl=l»9)
tsbledO) = ts( tO(I)» tsbled) )
tsble(21) = tsbled)
c
c*** loop through snd reed esch record even if not pertinent
c
DO 110 J = 2iII
C
DO Kl = 1»10
KK = Kl + 10
TABLE(KK) = TABLE(Kl)
enddo
C
READ<9,*) (TABLE(Kl)fKl=l»9)
TABLEdO) = TS( TO(I)i TABLEd) )
C
itl = int( (t3bledO)-tim(D) / 1 ! do all points in rsn3e
C
C*** RECORD AN INTERPOLATED TIME SORTED POINT.
C
KSUB(IT) = KSUB(IT) t 1
C
TABLE(22) = (TIM(IT) - TABLE(20))/(TABLE(10) - TABLE(20))
C
TDISTO(I»IT) = TABLE(21)
TDIST(I»IT) = TABLEdl) + (TABLEd) - TABLEdD) * TABLE(22)
Tyc(I»IT) = TABLE(12) -f (TABLE(2) - TABLE(12)) * TABLE(22)
TCc(I>IT) = TABLE(13) i (TABLE(3) - TABLE(13)) * TABLE(22)
Trho(I»IT) = TABLE(14) + (TABLE(4) - TABLE(14)) * TABLE(22)
T^ammsdflT) = TABLEdS) + (TABLEO) - TABLE(15)) * TABLE(22)
Ttemp(I,IT) = TABLE(16) f (TABLE(6) - TABLE(16)) * TABLE(22)
TSZdfIT) = TABLEd?) + (TABLE(7) - TABLEd?)) * TABLE(22)
TSY(I»IT) = TABLEdS) + (TABLE(8) - TABLEdS)) * TABLE(22)
TB(I»IT> = TABLE(19) t (TABLE(9) - TABLE(19)) * TABLE(22)
C
enddo
110 CONTINUE
C
2 -- SYSfDEGADISJSORTS.FOR 20-OCT-1987 00529J22
-------
F-13A
130 II = NRECd..2)
IFdl .ED. 0) GO TO 100
DO 200 J=ljII
DO Kl = 1»10
KK = Kl t 10
TABLE(KK) = TABLE(Kl)
enddo
READ(9>#) (TABLE(Kl)jKl=l>7)
TABLE(S) = RT2*DELTA*(TABLE(1)
TABLE(9) = 0.
TABLE(IO) = TS(TOd)jTABLEd))
XVd))**BETA
itl = int( (tsble(lO)-tim(l)) / (tira(2)-tim(l» + 0.9999999 )
itl = min( ntim> itl)
itf = int( (tsble(20)-tiro(D) / (tim(2)-tin>(l)) + 0.9999999 ) -f 1
itf = ms>:( li itf)
do it = itf» itlf 1 ! do sll points in
C*** RECORD A TIME SORTED VALUE
C
KSUBdT) = KSUBdT) + 1
TABLE(22) = (TIMdT) - TABLE(20) )/(TABLE(10) - TABLE(20))
C
TDISTOdfIT) = TABLE(21)
TDISTCI»IT) = TABLE(ll) I (TABLE(l) - TABLE(ll)) * TABLE(22)
TacdrlT) = TABLE(12) + (TABLE(2) - TABLE(12)) * TABLE(22)
TCcdfIT)
TrhodjIT)
= TABLE(13)
= TABLE(14)
= TABLE(15)
Tten.pd,IT) = TABLE(16)
TSZ(I>IT) = TABLE(17)
TSYd/IT)
TBd-IT)
(TABLE(3) - TABLE(13)) * TABLE(22)
(TABLE(4) - TABLE(14)) * TABLE(22)
(TABLE(5) - TABLE(15)) * TABLE(22)
(TABLE(6) - TABLE(16)) * TABLE(22)
(TABLEC7) - TABLE(17)) * TABLE(22)
= TABLE(IS) f (TABLE(S) - TABLE(IS)) * TABLE<22)
= TABLE(19) t (TABLE(9) - TABLE(19)) * TABLE(22)
enddo
200 CONTINUE
100 CONTINUE
CALL SORTSKTABLE)
RETURN
END
3 — SYSfDEGADIS:SORTS.FOR
20-OCT-1987 00:29:22
-------
F-135
r
C
SUBROUTINE SORTS1(TABLE)
Implicit Re3l*S ( A-Hf 0-Z )r Inteder*4 ( I-N )
include 'sys$de23dis:DEGADIS3,dec/list'
C
COMMON
$/SORT/ TCc(msxnobfmsxnt)rTCcSTRdnsxnobjmsxnt)i
$ Tyc(msxnob»msxnt) »Trho(iti3xnob>iJi3xnt)»
$ T2£!miia(msxnobnii3xnt) jTtemp(msxnobnii3xnt)»
$ TSYdiisxnobf iTisxnt) >TSZ(ni3xnob>issxnt) t TB(m3xnob» msxnt) i
f TDISTO(msxnob>msxnt) t TDIST(insxnob?uisxnt) ?KSUB(msxnt)
$/SSCON/ NREC(n.3xr.obf2)>TO(B.3xnob)>xy(nisxnob)
$/SORTIN/ TIH(m3xnt)fNTIM»ISTRT
?/FARM/ UO,ZO,IR,ML,USTAR j K,G,RHOE fRHOA > DELTA,BETA>GAMMAF,CcLOW
f/com_SP TOP/ 2ss_mw > 33s_temp»Sss_ rhoe»^ss_CPk f 3ss_cpp»
$ 23s_ufljd3s_lfl>23s_zspf235_nsme
f/com3tm/ i£t3b»tenibjF3nibjhumid»isofl»tsurf>ihtf 1 jhtcojiwtf 1 jwtco?
$ huiTiSrc
$/PARMSC/R«,SZM >EMAX»RMAX > TSC1,ALEPH»TEND
$/coni_si3x/ sisx_coeff»si3x_powfsi3x_rain_distfsisx_fl32
$/ALP/ ALPHA»slph3l
$/CNOBS/NOBS
C
DIMENSION TABLE(l)
r
u-
REAL*8 ML?K
losicsl cflss
C
C*** DETERMINE IF ANY TIME VECTORS HAVE NO ENTRIES
C
DO 192 I=1?NTIM
1?2 IF(KSUB(I).GT, 2) GO TO 194 ! Ior2 points is of little value
call trsF-(23)
194 ISTRT = I
DO 196 I=ISTRT»NTIM
196 IF(KSUB(I),LE. 2) 60 TO 198
GO TO 199
193 NTIM =1-1
199 CONTINUE
C
C*** REVERSE TIME SORTED VECTORS
r
•-rf
At this point? the results from Observer *1 is located in the
first row of each vector. But the information contributed by
Observer *1 is the infon&stion which is the farthest (TIUST)
from the source * If the output is printed by time* the
1 -- SYSfDEGADISJSORTSl.FOR 20-OCT-1987 00:29157
-------
F-136
distances will decrease instead of increase. Soi we need to
reverse each of the columns so that the downwind distances
c***
c***
cm
c
C
C
c
170
ISO
C
c
c
190
C
C
c
210
200
increase as you move down the column. At the same
ensure that ell of the
the to? of the column.
DO 200 Kl = ISTRT»NTIM
II = KSUB(Kl)
DO 170 J = 1»NOBS
IF(TDIST(J.K1),NE,0, ,OR
IF( Tsr(J..Kl).NE,0. ) GO
CONTINUE
II = II + J - I
DO 190 J = 1>II
TABLEdl + i 1 -
TABLEdl + NOBS t 1 -
TABLEdl + 2*NOBS + 1 -
TABLEdl f 3*NOBS f 1 -
TABLEdl f 4*NOBS i 1 -
TABLEdl * 5*NOBS * 1 -
TABLEdl -i- 6*NOBS + 1 -
TABLEdl + 7*NOBS f 1 -
TABLEdl + 8*NOBS -f 1 -
TABLE (I I + 9*NOBS + 1 -
CONTINUE
DO 210 J = l.II
TCc(J»Kl) = TABLE(J)
Tyc(JfKl) = TABLEU +
Trho(JiKl) = TABLE(J t
TSaiTiiii3( Jf K'l) = TABLE(J +
Tt=mpKl)
J) = TteiriF(JjKl)
J) = TSY(J»K1)
J) = TSZ(J»K1)
J) = TB(JfKl)
J) = TDISTO(J»K1)
J) = TDIST(J»K1)
NOBS)
2*NOBS)
3*NOBS)
4*NOBS)
5*HOBS)
6*NOBS)
7*NOBS)
8*NOBS)
9*NOBS)
if(si3x_fla2.ea. 0.) then ! no correction
c
writedunlo^»*) ' No X-direction dispersion correction'
2 — SYS$DEGADIS:SORTS1,FOR 20-OCT-1987 00:29!57
-------
F-137
DO 220 Kl = ISTRT>NTIM
II = KSUB(Kl)
DO 220 I = 1>II
TCcSTR(I»Kl) = TCc(i»kl)
220 CONTINUE
goto 400
endif
C
C*** GENERATE TCcSTR — CENTER LINE CONCENTRATION CORRECTED FOR
C*** DOWNWIND DISPERSION,
C
DO 230 Kl = ISTRT»NTIM
C
II = KSUB(Kl)
DO 240 I = 1»II
C
c calculation for XP = TDIST(I»K1)
c
TCcSTR(IiKl) = 0,
C
DO 260 J = 1»II
C
TABLE*J) = 0,
c DIST = TDISKJiKl) + RMAX
DIST = TDIST(JiKl) - TdistO(JiKl)
deltax = ABS(tdist(i»kl) - tdist(J»kl))
c
if(distfltf si2;;_min_dist) then
if(i.en. J) then ! i.e. deltsx = 0.
tsble(J) = (tdist(J+l»kl)- tdist(J-l»kl))/2.
if(J.ea.l)t3bleKl) = TABLE(l)* (TDIST(2»KD- TDIST(1»K1))/2.
TCcSTR(IfKl) = TABLE(iii)* (TDIST(iiifKl)- TDIST(iii-lfKD)
1 + TCcSTR(IfKl)
3 — SYSJDEGADIStSORTSl.FOR 20-OCT-1987 00:29157
-------
F-138
lii = ksub(kl) - 1
C
DO 280 J = 2,111
C
TCcSTR(IjKl) = TABLE(J)* (TDIST rho» snd temp values
c
cc = Tccstr(ifkl)
if(isofl.ea. 1 .or, ihtfl.eo. 0) then
cell 3di3b3t(0»wc>wsjycfys»cc> rho > win»enth»temp)
else
enth = T33mni3(i>Kl)
cell sdi sbst(-1> we r ws ? yc > as»cc»rho > wm >enth»temp)
end if
Tyc(i.'Kl) = yc
Trho(i»Kl)= rho
C
240 CONTINUE
C
230 CONTINUE
C
C
C*** Estimate the msss between the UFL snd LFL
C
400 continue
c
cfls£ = isofl.eo.l .or. ihtfl.ea.O
if(cfl3£l) then
csll 3disb3t(2»33>dd>33s_ufl>ee»chi
csll 3di3bst(2T33>ddf235_lfIfeejclo
endif
c
DO 430 Kl = ISTRTfNTIM
kk = kl+2*»3xnob
l-.kl = kH-3*Bisxnob
tsble(kk) = 0.
tsble(kkl)= 0.
C
II = KSUB(Kl)
DO 460 J = 1»II ! evaluate the function st esch point in spsce
C
c initialize some values
c
TABLE(J) = 0.
JJ = Jtmaxnob
4 — SYS$DEGADIS:SORTS1.FOR 20-OCT-1987 00:29:57
-------
F-139
TABLE (JJ> = 0,
cc = TCcstr(J>kl)
bb = tb(Jfkl)
sy = tsy(Jjkl)
sz = tsz(J»kl)
l)
if ( .not.cf 133) then
csll sdisbst(-2j33fdd»2ss_uf l»ee»chi
call 3di3b3t(-2>33jdd»Sss_lfljee>clow»32jhh>S3niiji3»oo)
endif
Cslculste the derivstive for the totsl msss sbove the UFL snd LFL
ssmhi = 2. DO* Cc * Bb * Sz / slphsl
X = 2. DO *Cc *Sr *GAMMAF /slphsl *(Bb tsQrtPi/2,DO *S«)
if (cc.2t.clow) then
wlow = Dlo2(cc/clow)
^snilow = Saminc (l.DO/slphsl» wlow
tsble(J)= ssrolow + 2.DO*clow*Sy*Sz/3lPhsl#series(wlow)
tsble(J)= DHINK tablet J)» ^eramex )
endif
if (cc.2t.chi) then
whi = Dlostcc/chi )
2emhi = famine (l.DO/slF-hsl j whi ) * 23i»hi
tsble(JJ) = Ssmhit 2.DO*chi *Sy*Sz/slph3l*series(whi)
tsble(JJ)= DMINlt tsble(JJ)» S
endif
c
460 continue
c
now? finish the inte3r3tion
DO 450 J = 2>II ! intesrste in spsce st one vslue of time
;:x = (tdist(Jykl) - tdist(J-l»kl))
sralow = (tsbletJ) 4- tsble(J-l))/2.
srshi = (table(Jtmaxnob) f tsbletJ-Hmsxnob) )/2,
tsble(kk) = srshi fxx + tsble(kk)
tsble(kkl) = 5r«lou*xx t tsble(kkl)
450 continue
c
430 continue
C
RETURN
END
ttft
5 -- SYS$DEGADIS:SORTS1.FOR 20-OCT-1987 00:29:57
-------
F-140
SOURCE EQUATIONS ~ Gss Blanket present
SUBROUTINE SRCKtimej Y>D»PRMT)
Implicit Real*S ( A-Hf 0-Z )» Inte2er*4 ( I-N )
include 'sas$de23dis:DEGADISl.dec'
parameter^ delt= 0.1HO?
1 delto2= delt/2.DO»
2
zero= 1,
rcrit= 0.002DO)
COMMON
$/GEHl/ PTIME(i3en)j ET(i<3en)> RlT(i3en)> PWC(i2en)» PTEMP(iSen) »
$ PFRACV(i3en)j PENTH STPMX > UTRG , WTtm » UTya » wtyc > wteb » wtmb , wtUH , XLI ..
$ XRI»EPS»ZLOWfSTPINZ»ERBNDZfSTPMXZ>SRCOER»srcssjsrccutj
$ htcut > ERNOBL » NOBLpt » c rf 3e r ? epsi Ion
$/PARM/ UO » ZO » ZR , ML > USTAR » K » G » RHOE t RHOA , DELTA , BETA > GAMMAF » CcLOW
$/PAR«SC/ RH»SZM>EHAXjRHAX»TSCliALEPHjTEND
$/comstfii/ istsb ; tsmb ?F srob > humid* isofl jtsurf >intfl»htco»iwtfl »wtco>
$ hums re
$/PHLAG/ CHECK1 1 CHECK2 » AGAIN » CHECK3 » CHECK4 » CHECK5
$/VIJCOIB/ vus I vub > vue > vud > vude 1 ts > vuf 1 sa
$/com_enthsl/ h_m3srtejh_3irrte>h_wstrte
t/ALP/ ALPHA? slphsl
f'/fhicosi/ iphif 1 jdellsy
$/sprd_con/ ce» delrhoroin
LOGICAL CHECKl>CHECK2fAGAIN»CHECK3jCHECK4 i CHECKS
loaicsl
REALMS MLrK
REALMS LjUi3srte>mole
INTEGER R>mesSfm=.S£C»iri5Sss>ebslnribsl
DIMENSION Y(7)»D(7)>PRMT(25>
DATA R/l/> mass/2/ jms£sc/3/r»sss3/4/»eb3l/5/>mbsl/6/
if( ppiBt(20).lt. O.DO) vuflsa = .false.
if(Y(msss) ,le. O.DO) then
we = dm3xl(prnt(15)..l.d-10)
if(wc.st. 1.) wc=l,d-10
W3 = l.DO - WC
enthalpy = wcfch-inssrte ! sir contributes nothing
else
WC = Y(lJl3SSC)/Y(fll3SS)
us = Y(ra3SS3)/Y(ni3ss)
SYS$DEGADIS:SRCI,FOR 20-OCT-1987 00:30:54
-------
F-1A1
enthslpa = Y(ebsl)/Y(msss)
endif
humsrc = (l.DO - we - ws*(l .DO+humid) )/wc
call t-propd jwcfwsjentholpyyyc jysunole? tempj rho»cp)
RADP = AFGEN2(PTIHEfRlT»TIMEi'RlTSRC'>
hei = dmsxK Y(msss)/pi/Y(r)/Y(r)/rho i O.ODO )
delrho = rho-rhos
= S#delrho/rhoa
C*** CALCULATE D(R) »sirrte»vel
D(R) = 0,00
vel = O.DO
sirrte = O.DO
Ri = O.PO
D(mbsl) = O.BO
IF(Gprime.GT. O.DO) then
slump = Ce*5Qrt(Gpriroe)
if(vuflssi) then ! momentuni bslsnce
iii = 0 ! initialize loop counter
vel = prmt<14) ! old velocity vslue
velifiin = O.DO
velmex= dmsxK slump? 0.1DO* vel)
100 hh = vel*vel/Ce/Ce/2/ (delrho/rhos)
rh = Y( r)-vus*vub#hh
value = Y(r)**2/rh**2
if(prmt(25),2e. prmt(24)) then ! hh ,^e. ht
ht = 2.DO*(vslue*hei - vu3*hh*(v3lue-l,)) - hh
velc = YCmbsl)/(0.4BO*pi*rho*(2,DO/3.nO*ht + hh)*rh**3/Y(r)
1 t 2,BO/3,DO*pi*vus*rho*hh* (Y(r)**2 - rh*rh*rh/Y(r) )
D(mbsl) = pi*2*delrho*Y(r)*ht**2
1 - vu5*vud#pi#rho3*Y(r)*hh*vel**2
• else
ht = vslue*hei - vus*hh*(vslue-l.DO)
velc = Y(mb3l)/<2,DO/3.BO*pi*rho*ht*rh**3/Y
-------
F-142
sum = sb=(vel) + sbs(velc) 4- zero
if (dif/suni . le. rcrit) then
vel = (veHvelc)/2.DO
Friat(13) = vel
if(vel .2t, O.DO) then
Ri = gprime / vel**2
3irrte= 2.*Pi# epsilon/Ri *rhos*Y(r)*hei* vel
B(r) = vel
Frir,t(20) = slump
endif
else
dif = vel-velc
if(velc.lt.velmin) velmin= dui3xl(velc» O.DO)
if(velc.gt.velmsx) velra3X=velc
if(dif ,2t. O.DO) then
veliasx = vel
c vel = 0.5DO*(velui3::-velniin) + velain
vel = 0»3S2DO*(velmsx-veli!iin) f velmin
else
velmin = velc
c _ vel = (l,DO-0.5DO)#(velmsx-velmiri) I velmin
vel = (l.DO-0,382DO)*(velmsx-velniin) f velmin
endif
iii = iiifl
if(iii .St. 40) stop'SRCl velocity loop'
goto 100
endif
else
vel= slump ! Srsvita slumping
hh = hei
ht = hei
Ri = gprime / vel#*2
eirrte= 2.DO*pi* ePsilon/Ri *rhos*Y(r)*hei* vel
D(r) = vel
endif
endif
c
IF(delrho.Lt.delrhofflin ,snd. .not.(check2 .or, uO.eo.O.))
1 D(R) = 0. ! not for HSE types or no wind esses
c
ares = pi * (Y(r)**2 - radp**2>
IF(Y(R).Le. RADP) THEN
3 — SYS$DEGADIS:SRC1.FOR 20-OCT-1987 00:30554
-------
F-143
AREA = O.DO
Y(R) = RADP •(• zero
IF(tiir,e.2t. delto2) then ! delt> num prob
D(R) = dn.sxKO.DO>
1 (RlT>TIMEIdelto2>'R1TSRD')-
2 AFGEN2(PTIME>R1T» (TIME-delto2>> 'RITSRe'))/ delt))
else
D(R) = d0.s:;l(O.DO>
1 ('RITSRe'))/ delto2))
endif
END IF
c
c cslculsle totrteout
c
mssrte = AFGEN2(PTIMEiET»TIME»'srcl')
PUCP = AFGEN2(PTIME>PHC»TIHE»'srcl')
TOTPRT = MASRTE/PWCP
HPRIM = AFGEN2(PTIME»PENTH»TIME»'srcl')
L = 2.0DO * Y(R)
C
cc = wc£rho
ostrmx = O.DO
if(uO .ne. O.DO)
1 astrmx = cc*K*USTAR*ALPHAl*dell3y/(dellsy-l,DO)/phih3t(rho>L)
c
c
^
astrll = ctstririx * pi*L*L/4.DO
totrteout = ostrll/wc
u
c surface effects
c
wstrte = O.DO
surfsce_Q = O.DO
yw = l.-ys-yc
aw = min( msx(yw» O.ODO)» l.ODO)
csll surfsee(temp»hei»rho>mole>cp>yw>w3trte>surf3ce_o)
surfece_Q = ares # surfsce_a
if(surf3ce_Q.lt. O.DO) surf3ce_o = O.DO ! don't let the cloud cool
ustrte = sres * ustrte
c
500 totrtein = sirrte 4- TOTPRT 4- watrte
c
IF(totrtein.It.totrteout .snd. .not,checK2
1 ) then ! checK2 is True for HSE type spills
D(R) = 0.
if(hei.St.srccut .snd. Y(r).^t.srccut) then
dHdt = (totrtein - totrtecut)/3.DO/pi/ Y(r)/Y(r)/rho
4 — SYSfDEGADIS:SRCl.FOR 20-OCT-1987 00:30254
-------
F-144
D(R) = Y(R)/Hei * dHdt
c ! Let cloud radius shrink when...
endif ! cloud heisht is decreasing unless...
if( Y(R).le.0.01DO*ri»3x .snd. mssrte.ea.O.DO) D(R) = 0, ! the primsry source...
endif ! has stopped. tos»6nisrS6
u
c CALCULATE B(msss) jD(iusssc) jDdnssss) »D( anything left)
c
D(msss) = totrtein - totrteout
D(msssc) = nissrte - astrll
Ddnssss) = (sirrte + MASRTE*(1.DO/PWCP - l,DO))/(l.DO+humid)
$ - ws/wc*astrll
D(ebal) = O.DO
ifCihtfl.ne, 0) ! eauivalent to adiabatic mixing from TPROP for ihtfl=0
$ D(ebal) = HPRIM*TOTPRT + h_sirrte*sirrte
$ + h_w3trte*wstrte - enthslpy*totrteout t surfsce.n
c
c
uheff = Gstrmx*L/cc
52 = O.DO
if(uO .ne. O.DO) zz = ( uheff*slph3l/uO/zO )**(!.DO/slphsl) * so
c
c
C
PRMK6) = QSTRMX
print (7) = sz
prmt(8) = hei
Frir.t(?) = rho
pr-rnt (10)= Ri
prrat(ll)= -=c
Frmt(12)= ys
prffit(13)= D(r)
print (16) = we
prmt(17) = us
prmt(lS) = enthalpy
print (19) = temp
?mit(21) = mssrte
prrat(22) = ht
prmt(23) = hh
RETURN
END
c
C
C
C SUBROUTINE FOR OUTPUT FROM SOURCE in the presence of a Blanket
C
SUBROUTINE SRC10(TIME>Y»DERY»IHLF»NDIM»PRMT)
Implicit Real*8 ( A-H» 0-Z )» Inteder*4 ( I-N )
5 — SYS$DEGADIS:SRC1,FOR 20-OCT-1987 00{30:54
-------
include 'sus$de2sdis:DEGADISl.dec'
COMMON
$/ERROR/STPIN ? ERBND » STPMX j UTRG » WTtm » WTas > wtyc > wteb > wtmb » wtuh > XLI »
$ XRIiEPSiZLOW»STPINZiERBNDZiSTPHXZ»SRCOER»srcss»srccut»
$ htcut » ERNOBL » NOBLpt » erf Se r i epsi 1 on
$/P ARM/ 1)0 f ZO » ZR .• ML , USTAR » K > G » RHOE » RHOA i DELTA f BET A » G AMMAF » CcLOW
$/PARHSC/ RM » SZM » EMAX » RMAX » TSC1 » ALEPH > TEND
$/co»_ss/ ess?slerijswid>outccjoutszfoutb>outl>swcl»swsl>senlf5rhl
$/PHLAG/ CHECK1 » CHECK2 » AGAI N » CHECKS » CHECK4 , CHECKS
I/ALP/ ALPHAjslphsl
LOGICAL CHECK1 » CHECK2 t AGAIN , CHECKS i CHECK4 i CHECKS
DIMENSION Y(6)»DERY(6)fPRMT(25)
DIMENSION CURNTK
INTEGER R > mass > BISSSC » IDSSSB > ebsl
D ATA R/ 1 / » nsss/2/ > msssc/3/ » mssss/4/ » ebs 1 /5/
d=ts nrecl/0/
III =111+1
C
astr = prmt(6)
sz = prmt(7)
hei = print (8)
r'no = prmt(9)
Ri = pr»t(10)
ac = prmt(ll)
ys = prmt(12)
vel = prmt(lS)
prrot(14) = vel
if(vel .3t, prmt(20» prmt(20) = -prmt(20)
print (15) = prnt<16) ! we
we = prmt(16)
cc = uc * rho
ws = pr»t(17)
enthalpy = prat(lS)
temp = print (19)
print (24) = prmt(22) ! ht
prmt(25> = prmt(23) ! hn
c
IF(hei ,Le. O.ODO) GO TO 1000
C
6 — SYS*DEGADISJSRC1,FOR 20-OCT-1987 00:30J54
-------
F-146
QSAV = Pm = astr
CURNT(5) = sz
CURNT(6) = yc
CURNT(7> = ya
CURNTO) = rho
CURNT(9) = ri
CURNT(10)= we
CURNT(11)= wa
CURNT(12)= enthalpy
CURNT(13)= temp
C
ERM = 0,
ermss = 0.
DO 120 II=2»iout_src
div = curnt(ii)
7 ~ SYS$DEBADIS:SRC1.FOR 20-OCT-1987 00:30t54
-------
if(div ,ea, 0.) div = srcoer
ER1 = ABS< (CURNT(II)-BKSP(II))/div )
ER2 = ABS< (CURNT(II)-OUTP(II))/div )
if(II.ne.3 .snd. ii.ne.? .snd. ii.ne»12 .snd. ii,ne.7 .end. ii.ne.ll)
1 ermss = dMAXHERl»ER2»ERMss> ! ex hei»QSTR»Ri»enth>ws»ys for SS
120 ERM = dMAXKERl>ER2»ERM)
C
if(check4) then ! stesdy stste
if( .not. (vel.ee?. 0. .snd.tiine.St.srcss)) Soto 124
122 check3 = .true.
outcc = we * rho
swcl = we
swsl = ws
srhl = rho
senl = enthalpy
outl = 2.0DO * Y(r)
Qstsr = prmt(21)/F-i/Y(r)**2
ifdjO.ne. 0.) sz= (slFhsl/uO/zOKQstsrtoutl/outccmU.DO/alphsl)* zO
outsz = sz
outb = pi*Y(r)**2 /out1/2.DO
goto 1000
124 if(erm=£ ,£t. srcoer) goto 125
if( tirae-tlsst ,3t, srcss) goto 122
return
end if
c
IF(ERM .LT. SRCOER) RETURN
C
125 CONTINUE
tlast = time
DO 130 II=l>iout_src
IF(III.EQ.l) BKSP(II) = CURNT(II)
130 OUTP(II) = EKSP(II)
f»
^
III = 0
NREC1 = NREC1 i 1
URITE(9>2000) (OUTP(II)»II=1»iout_src)
RETURN
C
1000 CONTINUE
I = -1
IFCTIME ,GE. TEND) CHECK3 = .TRUE.
NREC1 = NREC1 f 1
URITE(lunloa>1100)
WRITEdunloa,*) Hei>TIME
TSC1 = TIME
if(hei ,le, 0.) then
hei = 0,
y(r) = dn>inl(rmsx>y(r))
3 — SYS$DEGADIS:SRC1.FOR 20-OCT-1787 OOJ30:54
-------
F-148
endif
WRITE(9,2000)
1 TIME?Y(R)>hei»Qstr>sz>yc>ys> rho» ri »we?us?enthalpy? temp
URlTE(lunlo3flllO) NREC1
C
PRMTC5) = 1,
C
RETURN
1100 FORMAT(5Xf'VALUE OF Hei AT SOURCE TERMINATION ~ 0 TIME')
1110 FORMAT(5Xj'NUMBER OF LINES —> MS)
2000 for
END
9 -- SYS$DEGADIS:SRC1,FOR 20-OCT-1987 00:30J54
-------
SUBROUTINE SRTOUT(OPNRUP» table)
Implicit Resl*S ( A-H> 0-Z )r Inte=Ser*4 ( I-N )
include 'sys$de23dis:DEGADIS3. dec/ list'
COMMON /SORT/TCc ( msxnob > msxnt ) » TCcSTR ( mexnob » msxnt ) >
$ Tyc(m3xncbjmsxrit) »Trho(iusxnob»msxnt) »
$ T230HB3 ( mexnob » msxnt ) » Tteap ( msxnob > msxnt ) »
$ TSY( mexnob » msxnt) ?TSZ( msxnob >rosxnt) »TB(msxnobf itisxnt)
$ TDISTO ( msxnob » mexnt ) » TDIST ( maxnob » msxnt ) » KSUE ( msxnt )
$/SORTIN/TIM(»sxnt)»NTIMfISTRT
f/coffistm/ istsbjtsmbjpscibj humid? isof 1» tsurf jihtfl »htco»iwtf l»wtco>
$ hums re
$/com_si2x/ si2x_coeff isi5x_
$/S!P/ s
dimension tsble(l)
logical cfls
ch3rscter#3
chsrscter*40 OPNRUP
C
OPEN ( UNIT=8 > TYFE= ' NEW ' > NAME=OPNRUP > CARRI AGECONTROL= ' FORTRAN ' )
C
URITE(SfllOO)
if (si2x_f Iss.eo. 0.) then
write(8ill02)
else
write(S»1104)
write (8 y 1105) si2x_coeff >si2x_pou»si3x_min_dist
end if
'_
cfl32 = isofl.ea. l.or. ihtfl.eo. 0
cfls2l= isofl.ea. 1
ifwc»ws»gss_lfl »y3»cc_lfl
csll 3disb3t(2»wcjW3»23S_uf l»ys»cc_uf 1
end if
C
DO 110 I=ISTRT,NTIM
C
WRITE(8»1119)
URITE(8.1119)
URITECBjlllO) TIH(I)
if(cflssl) then
URITE(8»1H6)
SYS$DEGADIS:SRTOUT.FOR 20-OCT-1987 00t32{25
-------
F-150
URITE(8illl8)
else
WRITE(8»1115> 2ss_zsp»(100,*£!3s_lfl)»<100,*=f3s_ufl)
URITE(8»1H7>
end if
WRITE<8»1119>
i? = 0
II = KSUB(I)
c
DO 120 J=1»II
c
cc = tccstr(Jji)
rho = Trho(J»i)
yc = Tyc(Jii)
teisp = Ttei8p(J»i>
gamins = T5sBuns(Jji)
b = tb(Jii)
sz = tsz(Jji)
sy = tsy(J>i)
blfl = 0,
bufl = 0,
\_
if(,not,cfls2) then
csll
csll
endif
if(sr3 ,3e. 80* ) soto 600
ccz = cc/e:rp(sr^)
if(ccz .It. ce.lfl) then
ifCcflssl) then
WRITE(8»1120) TDIST(J»I)»ac»Cci rho»temp»BfSZiSY
else
URITE(Sill20) TDIST(JfI)»ac»Ccfrho»23mm3fte»p»B»SZ»SY
endif
goto 600
endif
3rg = -(dloa(cc_lfl/cc) i (S3S_zsp/sz)**slph3l)
blfl = snrt(sr3)*sy I b
if(ccz .It. cc_ufl) then
if(efls3l) then
URITE(8»1120) TDIST(J»I)»ac»Cc>rhOftemp>BiSZiSY»blfl
else
WRITE (8? 1120) TDIST(JjI)»yc»Cc»rho>Ssnim3>teiDP»BfSZ»SY>blfl
endif
3oto 600
endif
= -(dlog
-------
bufl = sart<3rs)*sy + b
if(cflsgl) then
WRITE(8»1120) TBIST( J»I) ?yc»Cc» rho»terop»B»SZ»SY»blfl»bufl
else
WRITE (S 1 1120) TBIST(J»I)»yc»Cc»rho»g3intt3»teniF'»B»5Z»SY»blfl»bufl
endif
c
600 continue
IP = ip + 1
if(ip .eci. 3) then
if = 0
write(S»1119)
endif
120 CONTINUE
c
summarize the mass above the UFL snd LFL
sufl = table(i+2*msxnob)
slfl = tsble(i+3*ni3xnob)
write(SfSOOO) 100.*3as_ufljlOO.*<23s_lfl jalfl-suf l»a
SOOO formst(//V For the UFL of '»lpsl3.5>' mole percent* andS
*' the LFL of '»lp2l3,5»' mole percent: '»
3r' K2.'f/f' The rosss of contaminant above the LFL is! '>
r' kg.')
110 CONTINUE
C
CLCSE(UNIT=S)
C
C
1100 FORMAT(!HOf5X»'Sorted values for each specified time.')
1102 formstdHOjSxf'X-Direction correction was NOT applied.')
1104 formatdHOjSxj'X-Birection correction was spplied.')
1105 fcrmetdh f5x?5x»'Coefficient: '»lps!3.5»/»
1 Ih i5x»5x»'Power! '>lp2l3.5»/>
1 Ih »5xf5x;'Minimum Bistance: '»lp2l3.5' m')
1110 FORMATdHOjSX^'Tin.e sfter bedinnin^ of spill '»G14.7>' sec')
1115 FORMAT(1HO,IXj'Distance'»2x»3x»'Mole'f3x»
1 'Concentration'»!;;?'Density'»2x»3x>'Gamma'»3x»
1 'Temperature'»3x?'Half 14x»4x»'Sz'>5x»4x»'Sy'»5x»
1 'Width at z='»0pf6..2»' m to!',/, l:c,ll::»lx'Fraction' >2::>
1 Hx»ll;cFllx»llXf3x» 'Width' »3x»llx»9xy
1116 FORMAT(1HO»1X? 'Distance' j2;:j3;;f 'Mole' »3xf
1 'Concentration' >!;:» 'Density' »2x>
1 'Temperature' »3x» 'Half 'f4x»4x»'Sz/»5x»4x»/Sa'»5xj
1 'Width at z='»0pf6.2»' B to! ' »/»lXf llxi Ix'Frsction' »2xi
1 1 lx»llx>ll:;»3j;»' Width' >3xfllx»9x»
1 2
1117 FORMATdH »4X> ' (n) ' >4x»llx»
1 2(1X> ' (kg/m«3) ' i Ix) » llx»4x» ' (K) ' »
3 — SYSfDEGADISJSRTOUT.FOR 20-OCT-1987 00!32:25
-------
F-152
1 5(8X,'(m)'»
HIS FORHATC1H ,4X, ' (IB) ' »4x»llx»
1 2 (IX) ' (kS/Di**3) ' » lx) »4x? ' (K) S
1119 FORMATdH )
1120 FORMATdH i3(lX» 1PB?.3» IX) 1 2;:f Opf7.4»2xf IXf IPGlO.SilXp
1 6(lX»lP69,3flX))
C
RETURN
END
mt
4 — SYS$DEGADIS:SRTOUT,FOR 20-OCT-1987 00:32525
-------
c
c
c
c
SUBROUTINE SSG(DISTfY>Dery»PRMT)
Implicit Re3l*S ( A-H» 0-Z )» Inte2er*4 ( I-N )
DIMENSION Y(l)»Der«U)»PRMT
include 'sys$des23dis:DEGADIS2,dec'
psrsoieter (zero=l.D-10» rcrit=2.5D-3)
COMMON
$/PARM/UO»ZO»ZR»MLjUSTARiK»GiRHOEfRHOA»DELTA»BETA>6AMMAFiCcLOW
$/coiri_2prop/ 23s_mw>sss.tenp»£ss_rhoe• 2ss_cpK>33s_cpp>
$ Sss.ijf 1 >2ss_lf 1»5SS-2SP?5ss_nsirie
$/corostni/ istsbftanibfFsmbfhumidf isoflftsurf>ihtfIfhtcOf iwtfl>wtco?
$ hunisrc
$/F'HLAG/ CHECK 1»CHECK2»AGAIN,CHECK3>CHECK4,CHECKS
«/ALP/ ALPHA>slphsl
$/phicom/ iphifl»dellsy
REALMS KiML
LOGICAL CHECK1>CHECK2»AGAIN»CHECKS»CHECK4>CHECKS
INTEGER rhouh>dh> mhi» mlow
DATA rhouh/l/»dh/2/» mhi/3/i alow/4/
PRMT(I) I/O
I
VALUE
IN/OUT
L***
C*:**
C***
C***
C***
C***
cm
CM*
c***
c***
c***
c***
c***
c***
c***
c***
c***
C
&~
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
E
Cc
XV (I)
TO(I)
-
NREC(Ii2>
DIST
sz
yc
rho
temp
asffims
rholsy
52
IN
OUT
IN
IN
-
OUT — STARTS OUTPUT UNIT=9
OUT
out
out
out
out
SYS$DEGADISJSSG.FOR
20-OCT-1987 00:33:05
-------
F-154
XVI = PRMT(S)
SY = RT2*DELTA*(IHST t XV1)**BETA
Erste = PRMT(6)
c
v_
SZO = PP!Dt(22)
SZ = SZO
c
C*** MATERIAL BALANCE
C
iii = 0
100 Cc = Erste*ALPHAl*(ZO/SZ)**ALPHA/UO/SZ/SGRTPI/SY
c
cclsy = cc/dellsy
csll 3ddhe3t(ccl3y>Y(dh)»rhol3y»terolsy»cp)
prod = dmsxK Y(rhouh)/rhol3y/prmt(18)i zero)
sz = ( prod ) **wc>w3>ycl3yfye?cclsyjrholsmtwml>enthftemlsm)
pit = 0*
c
if(isofl.ea.O .snd. ihtfl.ne.O) then
csll sddhest(cc»dell3y#Y(dh)»rho»temp»cp)
rit = rift(te»p>heff)
endif
C
RISTR = RIF(RHO»HEFF)
PHI = PHIF(RISTR»riU
C
dera(rhouh) = ppmt(19)/phi
he:3h = heff^dellsa
yw = l.-vclsy-ys
aw = ntin( rasx( yw> O.ODO)i l.ODO)
cell surfsceCterolsyfheishirhol3y>wral»cpryw>w3trte»Qrte)
if(teitip.ae. tsurf .or. te»lsy.3e» tsrob) orte = 0,
depy(dh) = ( Grte/dellsy-Y(dh)*Dery(rhouh) )/Y(rhouh)
C
c
Cslculste the derivstive for the totsl insss sbove the UFL snd LFL
2 ~ SYS$DEBADIS:SSB.FOR 20-OCT-1987 00:33105
-------
1 J. _/ ->
= (rho-rhos)/cc
if(check4) then
BERY(ulow) = 0.
DERYUhi) = 0,
if( isofl.eoul ior, ihtfl.ea.O ) then
csll 3di3bst(2»33fdd»S3S_33jdd»d3s_lfl>ee»clow»2S»hh»ppjoo)
else
csll sdi3b3t(-2?eSfdd>5ss_uf1?ee»chi »32>hh»23inm3
cell sdisb3t(-2»33fdd>33s_lfl»eejclowf2g»hhjg3i&R3»oo)
endif
^smmsx = sortpi * Cc * Sz * Sy * GAMMAF / slfhsl
if(cc.2t.clow) then
wlow = Dlo2(cc/clow)
DERY(i»low)= 2.DO*clow*Sy*Sz/3lph3l*series(wlow)
DERY(ialou)= DMINK DERY(ialow)» SSMSX )
endif
if(cc.^t.chi ) then
whi = Dlo2(cc/chi )
DERY(mhi) = 2.BO*chi *Sy*S2/3lphsl*series(whi )
DERY(ishi) = BMINK DERYdnhi )» Ssmmsx )
endif
endif
FRMK7) = Cc
FRMK12) = DIST
prmt(14) = «c
prnit(15) = rho
pp«it(16) = temp
priatd?) =
RETURN
END
3 ~ SYSSDEGADISJSSG.FOR 20-OCT-1987 00:33J05
-------
F-156
c
SUBROUTINE SSGOUT(X»YfD»IHLF»NDI«fPRHT)
C
Implicit ResltS ( A-H> 0-Z )> Inte<3er*4 ( I-N )
include '3ys$de23dis:DEGADI32fdec'
c
psrsmeter (nss3=7« zero=l.e-10)
c
DIMENSION Y(l)»D(l)fPRMT(l)»BKSP(nssS)iOUT(nssa)fCURNT(nss3)
C
COMMON
$/PARM/ UOiZOiZR,ML,USTAR,K»G»RHOE»RHOA»DELTA,BETA»GAMMAF»CcLOW
$/comst(ii/ istsbftsBit>»p3nibfhuirddfisof 1 jtsurf >ihtfl>htco»iwtfl>wtco>
$ humsre
$/STP/ STPO»STPPfODLPiODLLP»STPG»ODLOfODLLS
*/STOPIT/ TSTOP
c
REAL*8 K»ML
C
C*** PARAMETER OUTPUT
C
FROM SSG OUTPUT TO MODEL
cm x DIST
C*** PRMT(7) Cc
C*** Yd) SZ
c*** prmt(14) yc
c*** prmt(15) rho
C*** pr«t<16) temp
cK!** prmtd?) ssfflms
C
ERM = 0.
T01 = PRMT(9)
TSL = TS(TOlfX)
prmt(22) = prmt(21) ! sz
C
IF(PRMT<11) ,NE. 0.) GO TO 90
C
C*** STARTUP FOR OUTPUT ROUTINE
C
RII = -100./STPG
RI = 0.
CURNTd) = X
curnt<2) = prmt(14)
CURNT(3) = PRMT(7)
curnt(4) =
curnt(5) = prmt(17)
curnt(6) = pri»t(16)
yc
cc
rho
temp
1 ~ SYS$DEGADIS:SSGOUT,FOR 20-OCT-1987 00:33'.35
-------
CURNTC7) = pr»t<21) ! sz
C
90 CONTINUE
r^
L
C*** RECORD THE CURRENT AND PREVIOUS RECORDS
C
RI = RI + 1,
C
DO 100 II=l»nss3
100 bksp(II) = curnt(II)
c
CURNTU) = X
curnt(2) = prmt<14) ! yc
CURNT(3) = PRMT(7) ! cc
curnt(4) = prnit(15) ! rho
curnt(5) = prmt(17) ! Asinine
curnt<6) = prrat(16) ! temp
CURNT(7) = prmt(21) ! sz
C
c*** stop integration when cc*) (OUT(II)»II=l»nss3)
RETURN
C
1000 CONTINUE
C
2 -- SYS$DEGADIS:SSGOUT,FOR 20-OCT-1987 00:33535
-------
F-158
C*** STOP INTEGRATION
r
L/
PRHT(12) = X
TSTOP = TSL
PRMT(ll) = PRMT(ll) + 1.
WRITE(9i«) (CURNT(II)»II=lfnss3)
C
PRHTC5) = 1.
C
RETURN
END
****
3 — SYS$DEGADIS:SSGOUT.FOR 20-OCT-1987 00533535
-------
SUBROUTINE SSGOUT Inte<3er*4 ( I-N )
psrsmeter (nss2=9f zero=l.e-10)
C
DIMENSION Y(l)»D(l)»PRMT(l)»BKSP(nssa)»OUT(nss3)»CURNT(nss2)
C
include ' sss$de2sdis : BEGAD I S2 . dec/1 ist '
c
COMMON
$/PARM/UOiZOiZRpMLiUSTAR»K»GrRHOEfRHOAiDELTAiBETA»6AMMAFiCcLOU
I/STP/STPP i ODLP i ODLLP i STPG 1 0DLG » ODLLG
$/ALP/ALPHA»3lPh3l
c
c
C
c###
c
cm
c***
c***
c##*
en*
REAL*8 ML»K
PARAMETER OUTPUT
FROM SSG OUTPUT TO MODEL
X DIST
PRMT(7) Cc
Yd) SZ
PRMT(S) XV
C
ERM = 0,
prmt(22) = prnt<21>
C
IF(PRMTdl) ,NE. 0.) GO TO 90
C
C«* STARTUP FOR OUTPUT ROUTINE
C
RII = -100,/STFG
RI = 0,
CURNT(l) = X
CURNT(2) = PRMT(14)
CURNTC3) = prmt(7)
CL'RNT(4) = PRMT<15)
curnt(5) = prmt(17)
curnt(6) = pr»t(16)
yc
cc
rho
temp
curnt(7) =0,0 ! b
curnt(S) = prrot(21) ! sz
curnt<9) = rt2*delts*(::+prn.t(8))**bet3 ! sy
C
90 CONTINUE
C
1 — SYSfDE6ADIS:SSGOUTSS,FOR 20-OCT-1987 00534:01
-------
F-160
C*** RECORD THE CURRENT AND PREVIOUS RECORDS
C
RI = RI + 1,
r
o
DO 100 II=l,nsssf
100 BKSP(II) = CURNT(II)
CURNT(l) = X
CURNT(2) = PRMTC14)
CURNT(3> = print (7)
CURNT(4) = PRMT(15)
curnt<5) = pr»t(17)
curnt(6) =
yc
cc
rho
Samma
temp
curnt(7) = 0.0 ! b
curnt(S) = prrat(21) ! s:
cumt(9) = rt2*delt3*(xtprait(S))**bet3 ! sy
C
Cm STOP INTEGRATION WHEN Cc < CcLOW
C
IF(PRMT(7).LT.CcLOU) GO TO 1000
C
C*** CHECK FOR OUTPUT
C
DO 110 II=2»nss<3
if(ii.ea.7) 2oto 110
ER1 = ABS( (CURNT(II)-BKSP(II))/(CURNT(II)+zero) )
ER2 = ABS( r.ss2
IF(RI ,EQ. Rim.) BKSP(II) = CURNT(II)
120 OUT(II) = BKSP(II)
C
RI = RII
PRMT(ll) = PRMT(ll) f 1.
C
call ssout(out)
RETURN
C
1000 CONTINUE
C
C*** STOP INTEGRATION
C
2 — SYS$DEGADIS:SSGOUTSS.FOR 2Q-OCT-1987 00534:01
-------
PRUT(12) = X
PRMT(ll) = PRMT(ll) + 1.
c
csll ssout(curnt)
C
C
PRMT(5)
RETURN
END
= 1,
t*t*
3 — SYSSDEGADISJSSGOUTSS.FOR 20-OCT-1987 00534:01
-------
F-162
subroutine ssout(out)
Implicit Resl*8 ( A-Hf 0-Z )» Inte2er*4 < I-N )
dimension out(9)
common
$/com_Sprop/ 23s_
$/com_fl/ cfl32»clfl»eufl
dsts ip/0/
cflsS
c
c
dist = out(l)
yc = out (2)
cc = out (3)
rho = out (4)
2 smins = out (5)
temp = out (6)
b = out (7)
sz = out (8)
SH = out(9)
C
if(.not,cfls3) then
call 3disb3t(-2»wcfW3»S3S_lfl»a3»clfl»r>w>S3mm3»tt)
call 3disbst(-2»wc>W3>^3s_uf l»ys»cuf 1
endif
r2 .2et SO,) 2oto 600
ccs = cc/exp(srS)
if(cc= .It, clfl) then
if(cflsa) then
URITE(S»1120) DIST»«c»Cc» rho » temp »B»SZ»SY
else
WRITE (8» 1125) DIST>yc>Cc»rho523min3>teii.p>B»SZ7SY
endif
3oto 600
endif
3T2 = -(dlo2(clfl/CC) f (53S_ZSP/S2)**3lPh3l)
blfl = sart(sr3)*sy t b
if(ccz ,lt, cufl) then
~ SYS*DEGADIS:SSOUT,FOR 20-OCT-1987 00 : 34 J 25
-------
F-163
if(cfls2) then
WRITE(8»1120) DISTfycjCc»rhojtea!p»B>SZ»SY>blfl
else
WRITE(S>1125) DISTfyc»Cc>rhoj23inaisjteii!p»B»SZFSYjblfl
endif
Soto 600
endif
srs = -blfl»bufl
else
WRITE(8>1125) DISTiyc»Cc»rhoiasmnia»temp»B»SZjSY»blf1»bufl
endif
c
600 continue
IF = i? f 1
if(ip .eo, 3) then
ip = 0
write(8illl9>
endif
C
C
1119 FORMATdH )
1120 FORMATUH »IKlXi lPG9,3f IX))
1125 FORMATdH »3(lXilPS9.3fIX)»2x»OPF7,4f2xtIXtIPGlO.St
1 A(lXflP69.3flX))
C
return
end
2 ~ SYSIDEGADIS5SSOUT.FOR 20-OCT-1987 00534:25
-------
F-164
C ,
C
C PSEUDO-STEADY STATE SUPERVISOR
C
SUBROUTINE SSSUP(H_mssrte)
Implicit Re3l*8 ( A-H» 0-Z )» Inte=fer*4 ( I-N )
include 'sys$de3sdis:DEGADIS2,dec/nolist'
COMMON
I/GEN3/ rsd2(2jui3xl) jrastr(2»msxl) »srcden(2»i»3xl)isrcwc(2n!>3xl) >
$ $ rcws ( 2 > rasxl ) ? s rcenth ( 2 » msxl )
f /SSCON/ NREC ( msxnob > 2 ) r TO ( msxnob ) » XV ( msxnob )
$/GENl/ PTIME(iSen)» ET(iSen)> RlT(i3en)» PWC(i3en)j PTEMP(iaen)»
$ PFRACV(i2en)» PENTH(i^en), PRHO(i^en)
$/5en2/ den(5>:3en)
$/co»_gp TOP/ ^ss_inw » ^ss_ temp > ^es_ rhoe > 23s_cpk t ^SS_CPP »
$/FARM/ UOfZOjZRiMLfUSTAR»KfG»RHOEjRHOAf DEL TA» BETA? GAMMAF»CcLOW
«/ERROR/S YOER f ERRO , SZOER f WT A 1 0 ; WTQOO , WTSZO , ERRP » SMXF ,
$ UTSZP i WTS YF , WTEEF » WTDH , ERRG , SMXG i ERTDNF » ERTUPF » WTRUH r UTDHG
$/coni3tm/ istsbf tsiiibtpsmb^huniidf isofl jtsurf >ihtfl»htco»iwtfl>wtcof
$ hums re
$/PARMSC/ RMjSZMjEMAX»RMAXjTSCl»ALEPH»TEND
$/STP/ STPO»STPP»ODLP»ODLLP»STPG»ODLG»ODLLG
*/FHLAG/ CHECK1»CHECK2» AGAIN? CHECK3fCHECK4» CHECKS
$/nend/ poundn? pound
*/ALP/ ALPHA >slphsl
$/=prd_con/ ce» delrhooiin
S/STOPIT/ TSTOP
f/CKOB£/ NOBS
REAU8 K»«L»L
LOGICAL CHECK1»CHECK2» AGAIN » CHECKS tCHECK4i CHECKS
lo^icsl
chsr3Cter*4 pound
chsrscter*3 as
c
EXTERNAL PSS » FSSOUT , SSG > SSGOUT » OB > OBOUT
C
DIMENSION PRMK22) i Y(5) i DERY(5) »AUX(8t 5)
C
DATA RTOT/0,/
dsts wms/2S.96/» wmw/18.0/
C
c
c*** Estimste the esrliest snd Istest time sn observer csn be relessed
1 — SYSfDEGADIS:SSSUP,FOR 20-OCT-1987 OOJ34M3
-------
c##* over the source.
c
R = AFGEN(RADG? O.ODO* 'RADG')
T01 = TOOE(R> O.QDO)
c
c** For low wind speed esses which form s blanket? earlier times
c*# thsn T01 msy be possible. Check each of the points in RAD6.
c
do i=2>m3xl
if ( rsdsdf i) .ea.poundn .snd. reds(2»i) .ea.poundn) goto 20
TOP = T0ob( rsdg(2>i)» radg(l»i) )
if ( TOF .It. T01) T01 = TOF
enddo
c
c** Now? calculate the last possible time sn observer can be released.
c
20 continue
XEND = AFGEN(RADG»TENDf'RADG')
TOF = TOOEK-XEND»TEND)
C
c'*** Now? divide the total possible time amona the observers.
c
DTOB = (TOF-T01)/FLOAT(NOBS-M)
T01 = T01 -I- DTOB
C
C*** perform the calculation for each observer
c
write(12»ll£2)
c
DO 120 I = 1»NOBS
C
C*** RESET AGAIN
C
AGAIN = .FALSE,
C
TO(I) = DTOB*dble
-------
F-166
R = AFGEN(RABG>O.OnO>'RADG')
IF(tO(i).le.O. ,3nd. XIT(O.ODO»TOd)) ,3t.-R) then
PUP = .fslse,
TUP = O.OBO
end if
c
if (PUP) TUP = TUPF(TOd))
if(pdn) TDOWN = TDNFdOd))
C
XBOUN = XIT(TOOUN»TOd))
XUP = XIT(TUP>TO(D)
WRITE(lunlo<2>1160) TUP>XUP»TDOWN»XDOWN
C
C*** SET UP INTEGRATION PARAMETERS FOR EACH OBSERVER.
C
do iJk=lf22
prr&UiJk) =0,DO
enddo
do iJk=lf5
»(iJk) = O.DO
dery(iJk)= O.DO
c'c ijkl=lj3
suxdJkl/iJk) = O.DO
enddo
snddo
PRHT(l) = TUP
PRMT<2) = TDOUN
PRMT(3) = STPO
FRMT(4) = ERRO
PR«T(5) = dMAXld.DO>(TDOWN-TUP)/50.DO)
PRMT(6) = TOd)
prmt(?) = XUP
PR«T(13)= XDOWN - XUP
C
Yd) = szOer ! tosf3msr86
Y(2) = szOer ! Mrste
y(3) = szOer * AFGEN(srcwc»tup»'1C') ! Crste
y(4) = szOer * AFGEN(srcws»tup»'1C') t l.D-6 ! BDArste
y(5) = szOer * AFGEN(srcenth»tup»'1C') ! Hrste
C
DERYd) = UTAIO
DERY(2) = WTQOO
DERY(3) = WTSZO
DERY(4) = l.DO
DERY(5) = l.DO
C
NDIM = 4
ifdsofl.ea. 0 .snd. ihtfl.ne, 0) ndin=5
C
3 — SYS$BEGADIS:SSSUP,FOR 20-OCT-1987 00:34M3
-------
C*** PERFORM INTEGRATION,
r
w
WRITE(lunlo3jll20) I
1120 FORMAT(/»' Entering Observer InteSrstion Step for Observer * '»
$ 13)
C
CALL RKBST
C
IFdHLF .BE, 10) CALL trsp<8>IHLF)
c
writedunloSfll25)
1125 formstC '> IQx? 'Observer Integration complete,,,')
c
c
c**# Establish initisl conditions
c
cclsy = prmt(14)
cc = cclsyfcdellsy
wclsy = prmtd5)
wslsy = prmtdA)
enthlsy=prnit(17)
rholsy = pritit(lS)
C
L = XDOUN - XUP
B = Yd)
AREA = B*L
QSTRO = Y(3)/sre3
Erst-e = 2,PO*GstrO*L*b
cc = min(cc» rhoe)
UCP = AFGEN2(PTIME»PWC»TDOUN»'SSS-UC')
RHOP = AFSEN2(PTI«EfPRHO»TDOUN»'SSS-RH')
CCF = UCP*RHOP
if(cc ,3t. CCP) cc = CCP
szO = (ostrO*L/cc * slphsl/uO/zO)**(l,DO/3lph3l) * zO
rstiol= uO*zO/ALPHAl/ ZO**ALPHA1 *Cc /B/astrO/L
rstio = rstiol* S20**3lph3l * (B + sartFi/2.DO*syOer)
if(rstio,le, l.DO) then
svOer = (l,DO/(RATI01*ssO**3lPhsl) - b)*2,DO/sartPi
else
szO = d,DO/((B+ sartpi/2.DO*syOer)*r5tiol))**(l,DO/3lphsl)
end if
Estsblish the thermodynsmic properties of mixtures of sir snd
the 233 mixture (UCLAY»UALAY»ENTHLAY) sssuminS 3disb3tic
mixiriS. This is sccomplished with the csll to SETDEN,
Thera extrspolste the properties to the centerline*
Ground level concentrstion,
c
4 -- SYS$DEBADIS:SSSUP,FOR 20-OCT-1987 OOJ34M3
-------
F-168
hums re = (1 .DO-wclay-walsyfU.DO+humid) )/wclay
cell setden(wcl3y>wslay?enthl£y)
ifdsofl.ea, 1) Soto 200
Scan through the srrsy DEN for the last value* and establish 3 new
final value based on the centerline.' ground level concentration.
do iii= Ifisen
if(den(ljiii) ,2t. l.DO) then
ii = iii+1
rholay = den(3»iii-l)
temlsy = den(5?iii-l)
if(ii .at, isen ,or, iii.lef3) call trap(2)
cc = cclay*dellay ! exact due to profile assumptions
if(cc»3t» rhoe) then
write(lunlog»1126) cc?rhoe
1126 forastC/f' 'ilOC** «')»/i' cc; '»1P313,5»' is greater'*
$ ' than rhoe: '»lJ»sl3,5»/»' 'ilOC* ** *')»/)
cc =rhos
end if
rho = cc#(rholay-rho3)/cclay + rhoa ! assumes 2amnia=con
we = cc/rho
w2 = den(2»iii-2)/den(3»iii-2)
wl = den(2>iii-l)/den(3»iii-l)
wa = (l.DO-iii) = Yc
d8n(2fiii) = cc
den(3fiii) = rho
now? determine the enthalpy and tesiperature of such 3 mixture.
Bsss both enthslpa and temperature on the fsct that
(yc/rho) is proportional to temperature (and therefore enthalpy).
c
dencm = den(l»iii-2)/den(3jiii-2)-den(l»iii-l)/den(3»iii-l)
if(denom,ne. O.DO) then
slope = (yc/rho-den(l»iii-l)/den(3»iii-l))/denom
den(4.«iii) = slope*(den(4»iii-2)-den(4»iii-l))+den(4>iii-l)
den(4»iii) = dminK diri3xl(h_m3srte»den(4»iii))» O.DO)
den(5>iii) = slope*(den(5>iii-2)-den(5>iii-l))tden(5>iii-l)
den(5»iii) = dminK diii3xl(23S_te»Prden(5>iii))» tsmb)
else
den(4fiii) = den(4>iii-l)
den(5?iii) = den(Sfiii-l)
end if
temp = den(5>iii)
den(lfii) = 2.DO .' end-of-record
c if(cc,2t. rhoe) call trsp(31)
2oto 200
5 — SYS$DEGADIS:SSSUP.FOR 20-OCT-1987 00:34.'43
-------
end if
snddo
C
200 CONTINUE
IF(Cc .GT, RHOE) then
URITE(lunlo<3jll27) GSTRO»SZO»Cc» rhoe
1127 forrasU/j' MOC**** '),/,' astro: '>lP2l3,5>
$ ' ssO: '»lPE!l3.5f/»
$ /..' cc: '»lpsl3.5>' is greater'?
$ ' thsn rhoet ' »1P213. 5»//» ' ',10('**** ')»./)
c call tr3?(30)
end if
C
C*** SHOW THE OPERATOR WHAT IS GOING ON
C
WR ITE ( 1 un los > 1160) TUP»XUP»TDOUNiXDOWN
WRITEUunloS»1170> AREAfL^B
URITEQunloSilieO) QSTRO.SZOjsyOer
writedunlog? 1185) uclsy»w3lsy» rholsy»cclsy»temlsy
write(lunlo^>HS6) wo rhoycotemp
write(12>1161) i»tO' TUP! '»lpG13,5»' XUP: '»lpG13.5»' TDOWNt ',
$ ipGis.Sf' XDOWN: '»ipGi3.5)
1161 formate '»I3»lx»f8.1»lxi6(lx»fA.l»lx)»lx»f5,3»lx»lx»
$ f5,l»lXFlxif5.2)
1162 formstCA' ' > 'obs'»4x» 'T0'»4x»2x» 'Tup'»3x»lx» 'Tdown' »2x>
$ lx>'Xdown'»2x»lx» 'Length' >lx»lx»'HUidth'»lx»lx»'E- rste'»lx»
$ 'Mess fp'flxi'Temp'f2x»2x»'S20S//)
1170 FORMATC Half AREA? MpQ13.5»' LENGTH: '»lpG13.5>' Bt 'ilpG13.5>
1180 FORMATC TAKEUP FLUX: 'flpB12.5f' SZO: '»lpG12,5i
$ ' syO: '»1PS12,5)
1185 formstC wclsy: '»1F212,5»' wslsy: '»lp«sl2,5j
$ ' rholsy: 'flpal2.5i' Cclsy: '»lpal2.5f/i
$ ' tealsa! MP213.5)
1186 formstC we: '>lpgl2,5»
$ ' rho: Mpgl2.5»' Cc: '»lp2l2.5»' tempJ SlPdl2,5)
C
C*** PREPARE FOR PSEUDO-STEADY STATE INTEGRATION.
C
do iJk=l,22
Frmt(iJK) =O.DO
enddo
do iJk=l»5
a ( i Jk ) = 0 . DO
dery(iJk)= O.DO
do iJkl=lr8
sux(iJklf iJk) = O.DO
enddo
6 ~ SYS$DEGADIS:SSSUP,FOR 20-OCT-1987 00{34J43
-------
F-170
snddo
PRMT(l) = XDOWN
FR«T(2) = 6.023D23
FRMT(3) = STPP
PRMT<4) = ERRP
FRMTC5) = SMXP
PRMT(6) = Erste
FRMT(7) = Cc ! ~ OUTPUT
PRMT(S) = B ! -- OUTPUT
PRMT(9) S PRMTC10) ARE CONSTANTS FOR D(SY) 5 D(SZ)
r
PRMT(9) = Ce*sart(G*ZO/ALPHAl*GAMMAF)*GAh«AF/UO
PRMTdO) = ZO**ALPHA*K*USTAR*ALPHA1*ALPHA1/UO
PRMT(11)= NREC(l5l)
C PRMT<12)= DIST AT COMPLETION ~ OUTPUT
PRMT(13)= TO(I)
c prrat(14)= sc ! output
c prut (15)= rho ! output
c F>rrot(16)= temp ! output; not recorded if isofl=l
c prnit(17)= ssBiHis ! output; not recorded if isofl=l »or. ihtfl=0
prmt(18)= uQ*zO/3lphsl
prmt(19)= rho3*K*ustsr*3lphsl
prmt(20)= rholsy
prmt(21)= szO
pritit(22)= srO
C
Yd) = rhol3B*prmt(18)*(SZO/zO)**3lPh3l ! rho*ueff*heff
Y(2) = SYOER*SYOER
Y(3) = B t sartpi/2.DO*syOer
y(4) = 0, ! sdded best
C
DERY(l) = UTSZP
B£RY<2) = WTSYP
DERY(3) = WTBEP
dery(4) = UTDH
C
HDIM = 4
C
1130 FORMATC Entering Integration Step — B > 0, ')
C
C*** PERFORM INTEGRATION
C
CALL RKGST(PRMT,Y,DERY>NDIM>IHLF»PSS»PSSOUT,AUX)
C
IFdHLF ,GE. 10) CALL trsp(9»IHLF)
C
NREC(I»1) = INT(PRMTdl))
URITEdunlo3>1100) NREC(Iil) >TO(I)
7 — SYS$riEGADIS:SSSUP,FOR 20-OCT-1987 OOJ34M3
-------
F-171
1100 FORMAT (3X i 'NUMBER OF RECORDS IN PSS = 'I10>' FOR TO='lP2l3.5)
r
Ly
IF(AGAIN) GO TO 119
C
C*#* GAUSIAN COMPLETION OF THE INTEGRATION
C
FSSOUT FORCES THE ABOVE INTEGRATION TO FINISH WHEN B<0 FOR THE
FIRST TIME. THE STEP BEFORE THIS OCCURS IS RECORDED ON UNIT 7,
C*** THE STEP WHEN B GOES NEGATIVE IS CURRENTLY IN Y,
C
C*** THE CALCULATION METHOD CHANGES THE CURRENT VALUE OF SY TO A VALUE
C*** CALCULATED AS IF BEFF=sartPi*SY/2. RETAINING THE LAST VALUE OF Cc IN THE
C*** MATERIAL BALANCE,
C
nest = «(4>
rholsa = priat<20)
Cc = PRMT(7)
rhouh = Yd)
=2 = ( rhouh/rholsy/prmtdS) )**8
suxdJklf iJk) = O.DO
enddo
enddo
c
FRMT(l) = XT
PRMT(2) = 6.023D23
PF:MT(3) = STPG
PRMT(4) = ERRG
PRMT(5) = SMXG
PRMT(6) = Erste
PRHT(7) = Cc ! — OUTPUT
PRMT(S) = XV(I)
PRMT(9) = TO(I)
C PRMT(10)= 'BLANK1
PRMT(11)= NREC(I>2)
C PRMT(12)= DIST AT COMPLETION ~ OUTPUT
c prmt(13)= 'blank'
c prmt(14)= yc ! output
S ~ SYS$DEBADIS:SSSUP.FOR 20-OCT-1987 00:34243
-------
F-172
c
c
c
! output
! output
! output
print (15)= rho
Frmt(16)= temp
print (17)= Ssfliins
prmt(18)=
Frmt(19)=
prnit(20)= rholsa
print (21)= sz
F-rmt(22) = sz
Yd) = phouh
Y(2) = hest
DERY(l) = WTRUH
dery(2) = UTDHG
NDIM = 2
WRITE(lunlo2»1140)
1140 FORMAT (' Entering Gaussian Sts^e of Integration ')
PERFORM INTEGRATION
CALL RKGST(PRMT,Y»nERYfNDIM»IHLFjSSGFSSGOUTfAUX)
IFdHLF .GE, 10) CALL trsp(10»IHLF)
C
C
C
C
C
C
C
NREC(I>2) = INT(PRMTdl))
RTOT = RTOT + FLOAT(NREC(I>1) + NREC(I»2))
WRITE(lunloSilllO) RTOT»I
1110 FORMAT (5X»' TOTAL NUMBER OF RECORDS = '»lpG13.4»' THROUGH'?
$' OPS * SI3)
IFCRTOT ,GT. 120000.) CALL trsp(ll)
119 CONTINUE
write(lunlo3» 1150) tstop» Prmt(12)
1150 formsU/f' Lsst time Observer wss active? '>lp2l3.5>' s st '»
$ Ipsl3.5i' m')
120 CONTINUE
C
C
RETURN
END
****
9 — SYS$DEGADIS:SSSUP,FOR
0-OCT-1987 00134543
-------
c
c
SUBROUTINE STRT2(OPNRUP»H.assrte)
Implicit ReBl*8 ( A-H» 0-Z )» InteSer*4 ( I-N )
include 'sys$deSsdis:DEGADIS2.dec'
COMMON
*/GEN3/ redd(2>ms;:l)?Qstr(2jmsxl)>srcden(2>ins;:l)jsrcwc(2>m3xl)>
t srcw5(2jms;:l)>srcenth(2nBSxl)
$/TITL/ TITLE
S/6EN1/ PTIME(iSen)» ET(i2en), RlT(isen), PUC(i3en)j PTEMP(iSen) ,
$ PFRACV(iSen), PENTH(i3en), PRHO(iSen)
$/GEN2/ DEN(5»iaen)
t/ITI/ TljTINP,TSRC,TOBS,TSRT
$/ERROR/SYOER » ERRO , SZOER F UTAIO » WTQOO , WTSZO » ERRPi SHXP >
$ UTSZP , WTSYP » WTBEP , UTDH » ERRG » SMXG » ERTDNF » ERTUPF > UTRUH , WTDHG
*/PARM/ UO > ZO » ZR » ML f UST AR » K » G » RHOE » RHOA > DELTA , BET A » GAHMAF , CcLOU
$ 23s_ufl>23s_lfl»S3S_zspf2ss_nsme
$/co(Ti3tni/ istsb > tsmbi psnib > humid »isofl jtsurf rihtf 1 jhtccuiwtf 1 »wtco>
$ hums re
$/P ARHSC/ RM » SZM > EMAX » RMAX > TSC 1 > ALEPH » TEND
$ /PHL AS/ CHECK 1 , CKECK2 » AGAIN > CHECK3 » CHECK4 , CHECKS
$/NEND/ POUNDNi POUND
*/ftLP/ ALPHA, slphsl
$ /phi com/ iphif 1 jdellsy
f/sprd_ccn/ ce» delrhoniin
*/COM_SURF/ HTCUT
ch£rscter*80 TITLE(4)
chsr3cter*4 pound
chsr3cter*24 TINP>TSRC>TOBSfTSRT
REAL*3 K»ML
LOGICAL CHECK1 , CHECK2 1 AGAIN , CHECK3» CHECK4 » CHECK5
c
chsrscter*40 OPNRUP
C
OPEN ( UN I T=9 i NAME=OPNRUP , TYPE= ' OLD ' )
C
DO 90 I = 1,4
90 READ(9,1000) TITLE(I)
1000 FORMAT(ASO)
C
READ<9»*) NP
1 — SYS$DEGADIS:STRT2.FOR 20-OCT-1987 00536:26
-------
F-174
DO 100 1=1 i NP
100 READ<9»*) PTIHE(I)»ET(I)»R1T(I)» PWC(I)» PTEMP(I),
$ PFRACV(I>» PENTH(I); PRHO(I)
PTIME(NP +1) = POUNDN
REAEK9,*) NP
DO 220 I=1»NP
220 READ(9i*) BENd»I) »DEN(2»I) »den(3il) iden<4ii),den<5ii>
dend>np-H) = 2,
READ(9>*) NP
DO 300 1=1 >NP
READ(9»*) rsdsid»I)»r3d2(2»I)iastr<2»I)»srcden(2iI)isrcwc<2»i)»
1 srcw3(2»i)»srcenth(2»i)
Qstr(l»I) = rsdS(lfl)
srcden(ljl) = rsds(l>I)
srcwc(lji) = r3d£(l»i)
srcws(l>i) = rsd=s*) KfG»RHOE»RHOA> DELTA
) BETAiGAM«AF>CcLOW
READ ( 9 » * ) RM » SZM » EMAX » RHAX » TSC1
) ALEPH»TEND
READ(9>«) CHECKl»CHECK2i AGAIN. CHECK3»CHECK4i CHECKS
READ(9i*> ALPHA
= slphs + 1.
resd(9>1020)
2 — SYS$DEGADIS:STRT2,FOR 20-OCT-1987 00 : 36? 26
-------
resd(9?*)
resd(9>*) istsb
resd(9»*) tsmbf
humsrc = 0>DO
resd(9;*) isoflftsurf
resd(9y<:) ihtfl>htco
resd(9j*) iwtfl>wtco
c
resd(7>*) si^x.coeff
c
resd(9»*) iphif l»dellsy
c
hLmssrte = 0.
ifdsofl.eo, 0) resd(9»*) H_m3srte
C
REAB(9»*> HTCUT> ce» delrhomin
c
1010 for»st(2(s24»lx»
1020 forn3t(s3)
C
CLOSE(UNIT=9)
C
RETURN
END
3 ~ SYS$DEGADIS:STRT2,FOR 20-OCT-1987 00536:26
-------
F-176
C
C
SUBROUTINE STRT2H_i»ssrte«CCP)
C
Implicit ResUS ( A-K, 0-Z )» Inte*er*4 ( I-N )
INCLUDE 's«s$des!sdi 5 :DEGADIS2. DEC/LIST'
C
C .
C
C BLOCK COMMON
C
COMMON
I/TITL/ TITLE
S/GEN2/ DEN<5,IGEN)
$/ITI/ Tl,TINPrTSRC,TOBS
$/PARM/ UOiZQfZRiMLiUSTAR»KfGiRHOEiRHOA>DELTAiBETAiGAMMAF»CcLQU
*/coB_ss/ ESSfSLEN»SWIDfOUTCciOUTSZ»OUTBfOUTL»swclf£wsl,£enlisrhl
$/PHLAG/ CHECK1»CHECK2,AGAIN.CHECK3»CHECK4>CHECKS
$/cois_2prop/ sss_niw>23
$ SSS_Uf 1) 33S-1 f 1J 2SS-ZS?'
$/coisstni/ istsbftsisb/psmb;humid'isof 1 >tsurf»ihtf 1 »htco»iwtf 1 ?wtco«
$ humsrc
f/NEND/ POUNDN»POUND
*/ALP/ ALPHAislphsl
*/Fhicon>/ iphifljdellsy
$/sprd_con/ ce.» delrhoniin
*/COM_SURF/ HTCUT
P
W
chsrscter*80 TITLEC4)
chspscter*24 TSRC»TINPfTOBS
chsr3cter*40 OPNRUP
chsrscter*3 sss-nsrae
charscter*4 pound
C
REAL*8 K»ML
LOGICAL CHECK!,CHECK2;AGAIN* CHECKS,CHECK4>CHECKS
C
OPEN(UNIT=9»NAME=OFNRUP»TYPE='OLD')
C
DO 90 I = 1?4
90 READ(9»1000) TITLE(I)
1000 FORMAT(ASO)
C
reed(9»#) np
do 100 i = l.«np
resd(9»*) dummy! >du»ma2»dumma31PWC> FTEHP.-PFRACV?FENTHi FRHO
100 IF(I ,EQ. 1) CCP = PWC*PRHO
c
READ(9»«) NP
DO 120 1=1,NP
1 ~ SYS$HEGAPISJSTRT2SS.FOR 20-OCT-1987 00:56157
-------
F-177
120 READ ( 9 , * ) DEN (!>!)» DEN ( 2ili > der* ( 3 , i } • der, ( 4 » i ) , den i 5 •
I = NP i 1
DEN(1»I) = 2.
c
reed(9»*) nf
do 140 i=ljnF
1 40 resd ( 9 » * ) dumoi«l » dummy2 » duniinyS ? duiriifcy-4 r dus.5 s dusid > d'Jia?
C
resd(?fllOO) tin?>tsc
resd(9»1100) tobs>tsrt
1100 formst(s24fl;:re24)
c
READ ( 9 > * ) UO > ZO > ZR > ML » USTAR
Resd ( 9 » * ) K .. G » RHOE » RHOA , DELTA
resd(9»*) BETAiGAMMAFjCcLOW
c
resd(9»#)
resd(9>*>
c
READ ( 9 1 * ) CHECK1 ? CHECK2 , AGA IN > CHECKS ? CHECK4 » CHECKS
c
READ(9f») ALPHA
= alpha t 1.
resd(9»1200)
resd(9»#) 2ss_
resd(9>*> 2ss_
resd(9>*) isteb
resd(9»*) tsiib»P5n>b»huRiid
hum&rc = 0*DO
resd(9.«*) isofljtsurf
resd<9»*) ihtflfhtco
resd(9>*) iwtfl»wtco
READ(9»*) ESS.SLENfSUID
rsso ( 9 1 * ) OUTCc ? OUTSZ ? CUTS » DUTL
swcl »swsl»serilf srlil
resd(9>*) iphif 1 >dellsy
h-Hissrte = 0.
ifCisofl.en. 0) r
READ(9>*) HTCUT? ce> delrhomin
CLOSE(UNIT=9)
RETURN
1200 formst(s3)
END
****
2 — SYS$DEBADIStSTRT2SS.FOR 20-OCT-19S7 0
-------
F-178
C
C
SUBROUTINE STRT3(OPNRUP)
Implicit Real*3 ( A-H» 0-Z >> Inteser*4 ( I-N )
include 'sys$de23dis:DEGADIS3. dec/1 1st'
C
C BLOCK COMMON
C
COMMON
$/SSCON/ NREC ( msxnob 1 2 ) > TO ( rosxnob ) » XV < msxnob )
$/GEN2/ DEN(5fiSen)
$/PARM/ UO»ZO»ZR»MLFUSTAR»Ki6»RHOEiRHOAiDELTAiBETA»GAMMAF»CcLOH
$/ccia_2prop/ 2ss_raw > Sss_ temp » 2ss_ rhoe f Sss.cpk » 3ss_cpp »
S/ITI/ Tl»TINP>TSRC»TOBSrTSRT
$/comstm/ ist3b»tsfflb»psnib»humid»isofljtsurf >ihtfl»htco>iwtflfwtco»
$ hums re
$/F ARMSC/ RM » SZM > EMAX > RMAX > TSC1 » ALEPH » TEND
f/PHLAG/ CHECK1 » CHECK2» AGAIN > CHECKS »CHECK4» CHECKS
$/coiii_si3;:/ sisx-coeff jsi^;c_
I/NEND/ POUNDN? POUND
$/ALP/ ALPHA islphel
f/CNOBS/ NOES
chsrscterWO QFNRUP
chsrecter*24 TINP»TSRCiTOBSiTSRT
C
REALMS K>ML
LOGICAL CHECK ltCHECK2» AGAIN , CHECKS tCHECK4i CHECKS
C
OPEN ( UNI T=9 , NAME=OPNRUP » TYPE= ' OLD ' )
r
^
READ (9,*) NOBS
DO 125 I=1;NOBS
125 REAIK9,*) NREC (I ?1) »NREC(I»2) »TO(I)> XV(I)
c
READ(9»«) Npts
DO 140 I=l»Npts
140 READ(9»«) den(l»i)>den(2»i)»den(3»i)>den(4»i)»den(5>i)
den(l»npts-H) = 2.
c
REAB<9»») UO»ZO.ZR»ML»USTAR
re3d(9f*) K»6»RHOEiRHOA»DELTA
resd(9>*) BETA>GAMMAF>CcLOW
c
READ(9rl010) TINPfTSRC
resd(9,1010) TOBS»TSRT
1 -- SYS*DEGADIS:STRT3.FOR 20-OCT-1987 00:37:18
-------
F-179
1010 forn.st(2(s24flx))
c
READ(9>*) RM,SZMjEMAX»RMAX>TSCl
resd(9>*) ALEPHfTEND
resd(9»1020)
resd(9?*)
resd(9»*)
resd(9>*) istsb
re3d(9»*) tsm
hums re = O.DO
reed(9>*) ihtflfhtco
iwtfljwtco
1020 formst(s3)
c
READ(9>*) CHECK1»CHECK2»AGAIN> CHECKS »CHECK4j CHECKS
READ(9,!C) ALPHA
elphsl = alpha + 1.
C
CLOSE(UNIT=9)
C
RETURN
END
2 — SYS$DEGADISJSTRT3,FOR 20-OCT-1987 00:37!18
-------
F-180
C Surfsce effects
C
SUBROUTINE Surfsce(temp>hei 2ht> rhotroole>CP>yw>wstrte»a rte)
Implicit Resl*8 ( A-Hi 0-2 )» Inte3er*4 ( I-N )
include 'sysideslsdisJDEGADISl.dec'
c
C
COMMON
S/PARM/ UO»ZOfZR»MLFUSTARfKfG»RHOE»RHOA»DELTA»BETA»GAMHAF»CcLOW
$/co»stffi/ istabjtsrobjpsnibfhuniidf isof l»tsurf ?ihtfl>htco> iwtf l^wtco?
$ hums re
$/ALP/ ALPHA* slphsl
$/phicom/ iphiflfdellsy
$/COM.SURF/ HTCUT
C
c
P.EAU8 MLiK
REALMS Lf mssrte>raole
x) = 6,0298e-3* exp(5407, *<1,/273.15- 1,/txxx))
c
c
c
wstrte = 0.
a rte = 0.
if (isofl .ea.l .or. ihtfl.eo.O) return
if (height, le. htcut) return
delts_t = tsurf - temp
ifCdelts-t .It, 0.) return
top_vel = uO * Chei2ht/zO)**slph3
prod.nst = «rho/oole)**2 * sbs(delt3_t» ** 0,333333
if(ihtfl ,ec. 1) then ! local correlation
hn = 13, * prod.nst
hf = 0.
hf = 1.22 * rho*cp * (ustsr/uO)**2 * top.vel
ho = dB3>tl(hn»hf)
else if(ihtfl ,eo, 2) then ! LLNL correlation
ho = htco* rho* CP
else ifCihtfl .eo. 3) then ! Colenbrander's method
sv_teuip= (tsurf + temp)/2.
hn = 89. *(delts_t/av_teinp**2)**. 33333
ulO = uO*(10,/sO)**slph3
hf = 1,22 * rho*cp * ustsr**2/ulO
ho = d»3xl(hn»hf)
else
ho = htco ! ihtfl=-l
end if
1 -- SYSSDEGADIS: SURFACE. FOR 20-OCT-1987 00 J 37 J 38
-------
t-IBi
arts = ho * tielts.t
if Carte ,lt, 0.) arte = 0,
! since correlations sre not vslid for arte<0.
wstrte = 0.
if(iwtfl .ecu 0) return
fo = wtco
ifCiwtfl .2t, 0) then
fn = 9.9e-3 * prod.nst
ff = 20.7 * ho /cf /mole
fo = dmsxHfnjff)
endif
watrte = min( vspor_p(temp)> yw*psmb )
wstrte = fo *
-------
F-182
C
C FUNCTION TO RETURN SZO CALCULATED over the source without
c 3 blanket present underneath
c
c NOTE! Uses the integration package RKGST and cannot be used
c with any other routine without a local copy of RKGST.
C
sub routine S2F (Q ? L» WCP»sz > ccl ay > we 1 ay > rhol ay)
c
Implicit Real*8 ( A-H> 0-2 )» Inte<2er*4 ( I-H 5
external szlocal»szloco
C
REALMS L
C
include 'sasSdeSadisJBEGADISl.dec'
C
COMMON
$/szfc/ szstpOjszerr»szstpm::jszszO
C
dimension Y(l)»D(l)rPRMT(17)»sux(8>l)
c
prmt(l) = 0.
prmt(2) = L
prnit(3) = szstpO
pririt(4) = szerr
prmt(5) = szstpiax
prut(6) = Q
PRMK7) = UCP
c
Yd) = szs;0 ! rhondel*uO*zO/(l,+alph3)*(sz/zO)**(l,+3lpha)
D<1) = 1.
c
ndim = 1
c
call rk2st(prnitfy»d»ridiiri»ihlfjszlocel»szlocofaux)
c
if(ihlf.2e, 10) call trsp(3iihlf)
c
cclay = prmt(13)
wclay = pr;jit(14)
rholsy = prmt(15)
cc = prnit(16)
sz = pr».t«17)
C
RETURN
END
c
c
subroutine szlocal(x>y»d»prmt)
c
1 — SYS$DEGADIS:SZF.FOR 20-OCT-1987 01:01151
-------
F-183
Implicit Resl*S ( A-H» 0-Z ), Inteser*4 < I-N )
dimension y(l) >d(l) »?rnit(l^
$/P3Pm/ uO»zOf zr>ml justsrjk«3j -hoe? rhos i del te> bets j2smmsf»cclow
$/slp/ 3lphs»3lphsl
$/phicoR/ i?>hifl»dell£y
integer rhouhlsa/l/
Q = ppi»t(6)
UCP = PRMT(7)
wclaa = Q#;:/Y(rhouhlzy)
csll edisbst(l»wclsyrw2l5y?ycjys'cclsyj rholsaiwnuenthjteiiiF)
cc = ccl3y*dellsy
csll 3disbst(0f wowe.'vcjys^ccf rhoj wnuenth? temp) ! centerline
uheff = Y(rhouhlsy)/rhol3y/dellsy
sz = ( uheff /uO/zO*(3lph3l> )$*(! ,/slphsl) * zO
heff = 33Bini3f*s2/slph3l
ristsr = rif deryjihlf »ndia> prat)
Implicit ResltS ( A-H» 0-Z )» Inte2er#4 ( I-N )
diaension a(l)» depy(l)» prat(l)
c
PPOltdS) = PPBltO)
pritit(14) = prmt(9)
prmt(15) = prmt(lO)
prmt(16) = ppfflt(ll)
prmt(17) = ppat(12)
return
end
****
2 — SYS$DEGADIS:SZF.FOR 20-OCT-1V87
-------
F-184
subroutine tprop(if 1 1 we f ws» enthalpy ;yc»ys> win r temp* rhorcp)
c
c subroutine to return!
c nole fractions (y's)
c molecular weight Cwn>)
c temperature (tempC=3K)
c density (rhoC=3K2/ro**3)
c heat cspscity (cp-C=3J/k3/K)
c
c for s mixture fronu
c msss frsctions (w's)
c tempersture (K) for ifl.lt.O
c
c for 3 mixture from 5
c mass frsctions (w's)
c enthalpy (J/k2) for ifl.se.O
c
c sdisbatic mixing of: emitted sas & sas-temp
c entrained ambient humid sir (? taab
c entrained water from surface @ tsurf
c for ifl»eo.O calculate snd return
c
c sdiabstic lookup CALL ADIABAT
c for isofl»eo.l ,or. ihtflfea.O.and.if I.eQf 1
c
Implicit Real*8 ( A-H> 0-Z )> Inte2er*4 ( I-N )
include 'sys$de2sdis:DEGADISl,dec'
c
parameter (tf rac=0,618DOf tf racl=l.DO-tf rso
rcrit=0.0005DOi acrit=l.DO> zero=l.D-20)
c
common
S/GEN2/ DEN(5>iSen)
$/com_^p TOP/ 2as_raw » sss_ temp 1 2ss_ rhoe » gas_cpk » 3as_cpp »
$ __ __
f/ccnn3tm/ istsbjtsmbjpsmbfhumidiisofl » tsurf »ihtfl»htco»iwtfl»wtcoj
* hums re
charscter*3 2ss_nanie
dets for sir/water sys
dats wms/2S,96DO/ ! molecular weight of air
data wmw/13»02DO/ ! molecular weisht of water
data rho.water/lOOO.rrtV ! liouid water density C=3 ks/m*#3
data CP3/1.0063D3/ ! heat capacity of air C=3J/k3/K
data CPW/1865.DO/ ! heat capacity of water vsport=3J/k3/K
dsta dhvap/2.5023D6/ .'latent heat of vap C=]J/k3 water
data dhfus/0,33D6/ .'latent heat of fus C=3J/kS water
— SYS$DEGADIS:TPROP,FOR 2o-ocr-i987 00:39:16
-------
F-185
rev
c
c
vspor_p(t::;:;:) = 6.Q298D-3* e;;p(5407,DO *(1,DO/273,15DO- l.DO/txxx))
S3t_hum(p_tot..p_vp) = 0,622BO* P_VP/ humxx) =
(.002B33DO+ ,004553DO*humxx)/p_tot/(l,DO-Huiirixx> ! m**3/ks /K
c
c
ww = 1,00-wc-ws
wm = 1, OQ/(wc/3ss_iJiw -I- ws/wms + ww/wmw)
yc = wm/2ss
'-js = wm/wros
c
c
if(isofl.es, 1) then
cell 3disb3t(l>wc»w3jyc»«3»cc»rho>witijenth3lpyftemp)
return ! inter? density from we
end if
c
c
if(ifl,ea, 0)
$ enthslpy = wc*cpc(23s_temp)*(s'ss_temp - tsmb)
$ -I- (ww - ws*hu(iiid)*cpw*(tsijrf - tsrob)
$ + ws*(l.DOthijBiid)*CP3*(tsiiib - tarob) ! TR=tsmb
if(ifl»ea, 1 ,snd. ihtfl.eo.O) then
csl1 sdi sbst(1»we»ws»yciys»cc» rho > wm»enthslpy ttemp)
return ! interp density from we
end if
c
if(ifl ,ea, -1) goto 400
c
c
rev = .fslse,
100 continue
tmin = dminl(23s_teuiP» tsurfr tsmb)
tminO = tmin
tins;: = dms;:l(2ss_temp» tsurf> tsmb)
trasxO = tms;;
temp = (tniin-)-tm3x)/2,DO
C
do 300 J=li35
suess = enthsKwcjwsftemp)
dif = enthslpy - 2uess
SUBI = (sbsCenthslpy) + sbs(^uess))/2,DO + zero
if(sbs(dif)/suw.le,rcrit ,or, sbs(dif>,le,scrit) soto 400
2 -- SYS$DEGADIS:TPROP,FOR 20-001-1937 00:33:16
-------
F-186
if(dif.lt, O.DO) then
if (rev) taax = temp
if (.not* rev) tmin = temp
temp = tndn f (tmsx-tmin) * tfrac
else
if(rev) tmin = temp
if(,not*rev) tmax = temp
temp = tmin + (tmax-tmin) * tfracl
end if
c
300 continue
rev = .not.rev
if(rev) goto 100
write(lunloS>8050) wo W3> enthalpy
S050 formate TPROP? we.* ' >lp«3i2,5>lx»
1 'us: '»lp2l2,5flx,'enthalpy} ',lp<3l2.5)
slow = enthal(wc>ws>tminO)
if(enthalpy.lt. elow) then ! cstch out of bounds numbers
temp = tminO
enthalpy = elow
ssoto 400
endif
elow = enthsl(wow3»tmsxO)
if(enthslpy.st. elow) then
temp = troexO
enthalpy = elow
goto 400
sndif
c
call trsp(24)
c
c
400 continue ! density calculation
VP = vapor_p(tei»p)
=it = dmsxK vp/pamb» O.DO)
conden = (ww - 5at)/(l.DO - sat)*wniw/wm
conden = dmsxK 0,DO> conden)
wwstar = (ww-conden)/(l.DO-conden)
if(wa.st.Q.BO) sat = dmaxK wwstar/ws* O.DO)
rho = l.DO/(temF*ropw_3ir(p3mbfS3t)*w3*(l*DOfsat)
. t wc*temp/33S_temp/33S_rhoe + conden/rho_water)
c
tmin = temp i 10.
if (tmin .2t. totsxO) tmin = temp - 10.
if(tmin .It. tminO) train = temp t .1
c
tmax = enthal(wc?w3»tmin)
CP = (enthalpy - tmax)/(temp - tmin)
if(cp .It. CPS) CP = cpa ! nominal vslue of air
3 — SYS$DEGADIS:TPROP.FOR 20-OCT-1987 00138:16
-------
F-187
return
end
c
c
function CPC(temp)
c
Implicit Resl*8 ( A-H» 0-Z )> Inte3er*4 ( I-N )
COIBBlOn
_mw > 2ss_teinp > 23s_rhoe » 33s_cpk > SSS.CPP »
$ 23s_ufl>3'3S_lfl»23S_rsp»33s_n3»ie
dsts con/3, 33D4/
chsrscter*3
CPC = con
if(tefflp ,ne. 2ss_teap) then
CPC = con + sss_cpk*
sndif
CPC = cpc/gss.mw
return
end
c
c
function enthsKwowsfterop) ! used by TPROP
Implicit Real*8 ( A-H» 0-Z )> Ir.te^er*4 ( I-N )
psrsmeter (delts=10.DO)
common
$/cotn_2P TOP/ 23s_mw > ^ss^tenip > ass_ rhoe » 2ss_cpk » ^S
$ 2ss_uf l>3ss_lf li 2ss_zsFf ^ss_nsiiie
$/comstm/ i£t3b»tsmb>paiiib>huiiiidjisofl>tsurf >ihtf 1 jhtcojiwtfl»wtco»
$ hums re
charscter*3 Sss_
d£ts CP3/1006.3DO/ ! hest capacity of sir C=3J/ks/K
dsts cpu/1865. DO/ ! hest capacity of wster v3PorC=3J/ks=/K
dsts dhvsp/2.5023D6/ llstent heat of VSP C=3J/k3 wster
dsta dhfus/0,33n6/ (Istent best of fus C=3J/ks wster
dsts witis/28 . 96DO/ ! moleculsr weight of sir
dsts wrow/18.02DO/ ! uioleculsp weisht of wster
c
c
ww = l.DO-ws-wc
4 — SYS$DEGADIS:TPROP,FOR 20-001-1997 00:38:16
-------
F-188
VP = 6.029SB-3* e;;p(5407,DO *(1.DO/273,15DO- 1,PO/terap))
sst = 0.622DO * vf/ (psrnb - VP) ! k2 w/K2 BDA
wwstsr = us * sst
c
dh = dhvsp
frsc = 0.
imefliP ,lt, 273.15DO) free = dminH (273,15DO-teoip)/deltsfl.DG)
dh = dhvsp I dhfus*frac
wm = l.IiQ/(wc/2ss_mw -f wa/wma -f- ww/wmw)
sst = vp/psirib
conden = (ww-sst)/(l,DO-=3t)#wniw/wiD
conden = dma;;l( O.DO> conden)
c
1000 enthsl = wc*cpc(temp)*'(teirip - tsmb)
5 - condentdh
f I (ww- ws*:huniid)5Ccpw*(teniP - tsmb)
$ f ws*(l,DO'fh'jmid)*cp5*(temp - tarab) ! TR=tsmb
c
return
end
subroutine sdisbstdf 1 jwc>ws»b'cjbfs>ccj rhoJWBJenthalpy >tern?)
u
c subroutine to return?
c msss fractions (w's)
c mole fractions (a's)
c concentration (ccC=3kd/is**3)
c density
-------
F-189
common
*/GEN2/ DEN(5iiSen)
$/p£ rm/ uO ? 20 » z r » m 1 » us ts r » k ? s ? rhoe » rhos » del ts » bets » Ssmmsf > cclow
$/coni_3F TOP/ Sss_mw > S3S_temp > Sss.rhoe > Sss_cpk > SSS.CPP >
$ sss_uf 1 ? Sss_lf 1 i S3s_rsp'2£s_n3me
S/comstm/ istsb^tsnibfpsiiib'humidj isof 1 jtsurf f ihtf l»htco»iwtf 1 1 wtco«
$ hums re
resl*S ml-K
c
c*** data for sir/wster
dsts wms/28.96DO/ ! niolecul3r weight of sir
dst3 wmw/lSf02DO/ ! moleculsr weight of wster
iftifl.ne. 0) soto 1000
ccl = cc
if(cc .It. 0.) ccl=0,
i = 2
30 if(dendii) .2t. 1.) then
t. den(2»i)) ccl=den(2»i)
goto 50
end if
if(cc.le. den(2»i)) Soto 50 ! lookup in concentrstion
Soto 30
50 slope = (den(3>i)-den(3>i-D) / (den(2»i)-den(2»i-l)) ! interp in cone
rho = (ccl - den(2»i-l))#slope + den(3»i-l)
wcl = ccl / rho
we = wcl
ws = (l,DO-(l,DOihuijisrc)*wc)/(i,nO+huiTiid)
ww = l.DO - us - we
wm = 1,DO/(wc/S3s_mw + ws/wma + ww/wmw)
yC = WBI/S3S_fflW * WC
ys = win/wins * ws
Soto 8000
e
e
1000 ifUfl.ne. -1) Soto 1500
ccl = cc
ifCccl.lt. 0.) ccl=0.
Ssniras = enthslpy
we = ccl/(rhos+cclJSsmms)
ws = (l.DO-(l.DO+hu»src)*wc)/
-------
F-190
ys = wra/wros * ws
rho = ccl/wc
return
c
i_
1500 ifdfl.ne, -2) Soto 1700
ycl = yc
if (yd. It. 0.) ycl=0,DO
33Hims = enthalpy
y s = ( 1 . DO- ( 1 . BOtS3s_mw*hums rc/wmw ) #yc !)/(!,
yw = l.DO-ys-ycl
we = SS5_ntw/wm * ycl
wa = wins/win * ys
cc = wc#rhos/(l . DO - 3ssini3*wc)
rho = cc/wc
return
c
c
1700 ifdfl.ne. 2) goto 2000
ycl = yc
if(yc .It, 0.) then
ycl = 0.
ws = l.DO/d.DO+huaid)
ww = 1.00-W3
wm = l.DO/(wiD3/w3 + wmw/wu)
ys = um/wma * ws
endif
if(yc ,3t. 1.) then
ycl = l.DO
ys = 0»DO
endif
i = 2
1730 if(den(l»i) »3t. 1.) then
i = i-1
^oto 1750 ! extrspolste
endif
if(yc.le. den(l»i)) goto 1750 ! lookup in mole free
1730
1750 slope = (den(2>i)-den(2»i-l) ) / (dend»i>-den(l >i-l) ) ! interp in y
cc = (ycl - den(l»i-D) *slope + den(2»i-l)
slope = (den(3»i)-den(3»i-l) ) / (den(l»i)-den(l5i-l) ) ! interp in y
rho = (ycl - dend»i-l ) )*slope t den(3»i-l)
we = cc/rho
wm = ycl#^3s_niw + ys^wnis + (l,DO-ycl-ys)*wmw
ws =
i = 2
1760 if(dendfi) .at. 1.) then
7 ~ SYS$DE6ADISJTPROP.FOR 20-OCT-1987 00238:16
-------
F-191
i = i-1
Soto 1300 ! extrapolate
end if
cwc = den(2»i)/den(3»i)
if(wcfle. cwc) Soto 1800 ! lookup in mass frsc
soto 1760
1SOO wl = den<2»i-l)/den(3»i-l)
u2 = den(2>i)/den(3fi)
slope = (den(4»i)-den(4 »i-l) ) / (w2 - wl) ! inter? in w
enthalpy = (we - wl) *;lope t den(4»i-l)
slope = (den(5f i)-den<5»i-l) ) / (w2 - wl) ! inter? in w
temp = (we - wl) #slope + den(5»i-l)
c
return
c
c
2000 if(ifl.ne, 1) Soto 9000
wcl = we
if (we .It, 0.) then
wcl = 0,
wa = l.DO/Cl.BO+humid)
end if
if (we ,St, 1.) then
wcl = l.DQ
ws = O.DO
end if
ww = l.DO-ws-wcl
win = 1 ,DO/(wcl/2ss_niw + ws/wms + ww/wmw)
yc = w(n/3ss_»w *wcl
ys = WBi/wms *ws
i = 2
2030 if(denClfi) ,3t. 1.) then
i = i-1
Soto 2050 ! extrspolste
endif
if(yc.le« den(l»i)) Soto 2050 ! lookup in mole frsc
Soto 2030
2050 slope = (den(3»i)-den(3»i-D) / (dend i i)-den(l»i-l) )
rho = (ac-den(l»i-l))*slope i den(3»i-l>
slope = (den(2fi)-den(2»i-l)) / (dendi i)-den(l»i-l) )
cc = (yc-den(l ? i-1) )*slo?e f den(2n-l)
i = 2
2060 if
-------
F-192
2oto 2060
c
c
8000 wl = den(2>i-l)/den(3»i-l)
w2 = den(2fi)/den(3»i)
slope = (den(4?i)-den(4f i-1) ) / (w2 - wl) ! inter? in w
enthalpy = (wcl - wl) *slope + den(4»i-l)
slope = (den(5ji)-den(5»i-D) / (w2 - wl) ! inter? in w
temp = (wcl - wl) *slope t den(5»i-l)
c
return
c
9000 call trap(26)
end
c
c
subroutine setenthal (h_niasrtejh_airrte»h_w3trte)
c
c subroutine to losd /com_ENTHAL/ through passed arguments if needed
c
c
Implicit Real*8 ( A-H> 0-Z )» InteSer*4 ( I-N )
include 'systdeSadisJDEGADISIN.dec'
c
common
_mw > 3as_temp >
i/comstm/ istab»tsmb»p3nibjhuaid>isofl>tsurf »ihtfl»htcof iwtfl>wtco»
$ hums re
chsrscter*3 3ss_nsme
data for sir/water sas
c
dsta CF3/1.00A3D3/ ! heat capscita of air C=OJ/k«3/K
dats CPW/1S65.DO/ ! heat capacita of wster vaporC=3J/k2/K
c
h-masrte = O.DO
h_airrte = O.DO
h_wetrte = O.DO
c
if (isofl.ea. 1) return
c
h.masrte = cpc(2as_temp)*(3as_temp - tamb) ! TR=tamb
c
c h-airrte = (l,thumid)*cpa*(t3Hib - tsmb) = 0.
c
ifCiwatfl ,eoi 0) return
h-watrte = cpw*(tsurf - tsmb)
9 — SYS$DEGADIS:TPROP.FOR 2o-oci-i987 00:39:16
-------
F-193
return
end
subroutine setden(wc»w3»enth3lpy)
c
c subroutine to load /GEN2/ ss needed
c
c sdisbstic mixing oft WC
c WA
c WW (? specified enthalpy
c
c with smbient humid sir P tsmb
c
c den(lri) mole frsction (yc)
c den(2>i) concentration (cc [=3 ks c/m**3)
c den(3>i) mixture density (rho C=O ks mix/Bi#*3)
c den(4»i) mixture enthalpy (enthalpy C=3
c den(5>i) mixture temperature (temp [=] K)
c
c
Implicit Real*8 ( A-H» 0-Z )> Inte2er*4 ( I-N )
include 'sysideSsdisIDEGADISIM.dec'
c
psrsmeter (tcrit=0,002DO» 2ero=l,D-20)
parameter (iils=200» ils=iils-l» ibsck=25)
c
common
$/6EN2/ DEN(5ii3en)
$/com_2P TOP/ ^ss_mw»3ss_temp»3as_rhoe»Sas.cpk > 2a
$ 23S-ufl>3as_lfl >aas_zsp»S3S-.n3Bie
$/comatm/ istsbftamb»p3Hib»humid»isofljtsurf»ihtfl»htco»iwtfl»wtco>
$ humsre
c
chsr3cter*3 2as_name
c
dimension curnt(5)»b3cksp(5»ibsck)
c
ct*t data for air/wster sys
c
dsts wm3/28.96DO/ ! molecular weight of sir
dsts wmw/18.02DO/ ! moleculsp weiaht of wster
dsts CPS/1.0063D3/ ! hest cspscity of 3ir C=DJ/ks/K
data CPW/1865.DO/ ! heat capscity of wster vsporC=]J/k^/K
c
c
c
10 -- SYS$DEGADIS:TPROP.FOR 20-oci-i987 00:33:16
-------
F-19A
if(isofl,ea, 1) return
c
c
k = 1
den(lik) = O.ODO ! yc
den(2»k) = O.ODO ! cc
den(3>k) = Psmb*(l,DO-f-huroid)/( .002S33DO+ ,004553DO*huniid)/t3mb ! rhos
den(4»k) = O.ODO ! enthslpy of snbient sir? TR=tsmb
den(5»k) = tsmb
c
c
do 300 i= ilsflf-l
zbds = (flost(i)/flost(iils)) / (1.-Humid)
zw = zbdsfchumid
z2 = l.DO-zbds-zw
c
c enmix = z2*enthslpy -f zbds*(l,DOthumid)*cps*ts0ib ! TR=tsmb
enmix =
zbde = zbds t z2*ws
csll tp POP ( 2 > z2 > zbde > enraix i yc » y a » wm > temp > rho i
cc = z3#rho
c
c
curnt(l)
curnt(2)
curnt(3)
curnt(4)
curnt(5)
= yc
= cc
= rho
= enrol x
= temp
if(i . eo, ils) then
ind = 1
do 150 JJ= 1>5
150 bscksp(JJjind) = curnt(JJ)
3oto 300
endif
c
c ADIAEAT interpolstion scheme
c
err = 0,
do 180 iind = liind
yc = bsckspdriind)
cc = bscksp(2>iind)
rho = bscksp(3»iind)
enmix = bzcksp(4>iind)
temp = bscksp(5fiind)
slope = (den(2rk)- curnt(2)) / (den(l>k)- curnt(l))
ccint = (ac - curnt(l))*slope + curnt(2)
err = dnisxl(err>2,DO* sbs(cc - ccint)/(sbs(cc t ccint) i zero))
slope = k)- curnt(D)
11 — SYS$DEGADIS:TPROP.FOR 2o-ocr-i987 00:33:16
-------
F-195
rhoint = (ac - curnt(l))#slope I curnt(3)
err = dms;;l (err>2.DO# sbs(rho - rhoint)/(3bs(rho + rhoint) f zero))
wccsl = cc / rhoint
wl = curnt(2)/curnt(3)
w2 = den<2ik)/den(3»k)
slope = (den(4ik)- curnt(4)) / (w2 - wl)
entint = (wccsl - wl)*slope + curnt(4)
err = dmsxl(err»2.DO* 3b5(enmix - entint)/(3bs(enmix + entint) + zero))
slope = (den(Srk) - curnt(5)) / (w2 - wl)
temint = (wccsl - wDflslope -I- curnt(5)
err = d(tisxl(err»2.DO* sbsCtemp - temint)/(sbs(tern? + temint) I zero))
ISO continue
c
if(err ,le. tcrit) then
if(ind ,2e, ibsck) Soto 200
ind = ind + 1
do 190 JJ=1?5
190 bscksp(JJ»ind) = curnt(JJ)
2oto 300
endif
c
c record s point in DEN
c
c
200 k = k+1
if(k,Se, i2en) call trsp(28)
do 250 JJ=1»5
den(JJ>k) = bscksp(JJ»ind)
250 bscksF(JJfl) = curnt(JJ)
ind = 1
c
300 continue
c
k = k+1
ifCk.Se. isen) csll trsp(28)
ifCwc.ea. l.DOO) then
den(l»k) = l.DOO ! yc
den(2>k) = 335_rhoe ! cc
den(3»k) = 3ss_rhoe ! rhoe
den(4»k) = enthslpy ! enthslpy
den(Sfk) = Sss-temp ! temp
else
csll tprop(2»wcjW3»enthslpy»den(l>k)>ys»wmjden(5»k)»den(3?k)>CP)
den(2»k) = wc*den<3>k) ! cc
den(4»k) = enthslpy
endif
den(l>kil) = 2. ! .St. 1. end-of-record indicator
c
return
end
12 — SYS$DEGADIS:TPROP.FOR 20-001-1937 00:38:16
-------
F-196
c
c
c
subroutine sddhest(cc»dhjrho>teoip»cp)
Implicit Real*8 ( A-H» 0-Z )> Integer*4 C I-N )
include 'sysfcdegsdisJPEGADISl.dec'
c
F-arsmeter (tf rac=0,618DOj tfrscl=l,BQ-tfrsc»
rcrit=0.005DOf 3crit=l,DOf zero=l.D-20)
c
common
5/GEN2/ riEN(5rigen)
$/com_gprop/ gss-raw»gss_tempi gss_rhoe»gss_cpkiSS
$ Sss_ufl.»sss_lfl>sss_25P>sss_nsnie
S/ccmstm/ istsbftanibjpsmbjhuroidfisofljtsurf>ihtfljhtcofiwtfIjwtco?
$ humsre
c
chsrscter*3 ^ss-neme
c
c*** dsts for sir/wster sas
c
dsts wms/2S.96DQ/ ! molecular weight of sir
dsts wrow/18.02DO/ ! molecular weight of wster
dats rho_wster/1000.DO/ ! liouid wster density C=3 k3/m**3
dsts CPS/1.0063D3/ ! hest cspscity of sir C=3J/kS/K
dsts CPW/1S65.DO/ ! hest cspecity of wster vsporC=3J/kg/K
dsts dhvsp/2,5023D6/ llstent hest of vs? C=]J/k3 water
dste dhfus/0.33D6/ 'latent heat of fus C=3J/kg wster
c
logical rev
c
c
V3por_p(txxx) = 5.0298D-3* e;:p(5407,DO *(1.DO/273,15DO- l.DO/txxx))
sst_hum(p_totfp_vp) = 0.622DO* P_VP/ (p_tot- P_VP) ! k2 w/kg BDA
ropw_sir(p_tot»humxx) =
(.002833DO-1- ,004553DO*humxx)/p_tot/(l,DO+hunixx) ! n:**3/kg /K
c
c
CP = CF3
rhos = den<3fl)
c
csll odisbst(0»wc>ws»yc>yaicc» rho>w»fenthalpy>sat)
ww = l.DO - we - ws
temp = smt
IF(isofl.eo»l .or. ihtfl.ea.O) return ! adisbatic mixing is valid
if(dh.le. 0,) return ! catch colder surface temperatures
enthslpu = enthalpy + dh
c
13 ~ SYS$DEGADIS:TPROP,FOR 20-oci-i987 oo;38:i6
-------
c
if(enthalpy.gt. 0.) then
temp = tamb
goto 400
endif
c
c
c
100 continue
tmin = amt ! adiabatic mixing temp
tainO = train
tins;; = dmaxl(gas_tempj tsurf* tsmb)
tmsxO = tissx
temp = (tmin+tmsx)/2.DO
c
do 300 J=l»35
guess = enthsl(wcjws»tem?)
dif = enthalpy - guess
sum = (sbs(enthalpy) + sbs(guess))/2.DO + zero
if (sbs(dif )/suni.le.rcrit .or. sbs(dif).le.acrit) Soto 400
c
if(dif.lt. 0.) then
if(rev) tmsx = temp
if(.not.rev) tmin = temp
temp = train + (tmax-tmin) * tfrsc
else
if(rev) tmin = temp
if(.not.rev) tmax = temp
temp = train + (tinsx-tmin) * tfracl
endif
c
300 continue
rev = .not.rev
if(rev) 2oto 100
c urite(lunlo3»8050) wows?enthalpy*guess*temp
cSOSO forraatC ADDHEAT? we: Mp2i2.5»lxi
c 1 'wa: '»lp2l2.5>lx»'enthalpy: 'jlp2l2.5»/»
c 1 ' guess: '»lp3l3.5f' temp: 7»lpgl3.5)
if(temp,lt. amt) call trap(17)
elow = enthaKwowaitminO)
if(enthalpy,It, elow) then ! catch out of bounds numbers
temp = tminO
enthalpy = elow
Soto 400
endif
elow = enthal(wc»w3>tmaxO)
if(enthalpy,gt. elow) then
temp = tmaxO
enthalpy = elow
goto 400
endif
14 — SYS$DEGADIS:TPROP,FOR 20-oci-i987 00:39:16
-------
F-198
cell trsp(17)
c
c
400 continue ! density cslculstion
VP = v3Por_p(tenip)
sst = doisxK vp/psffibj O.DO)
conden = (ww - sst)/(l.DO - sst)*w(hw/wm
conden = drosxK O.DO» conden)
wwstsr = (ww-conden)/(l.DO-conden)
if(w3 ,^t, O.DO) sst = wwstsr/ws
rho = l,DO/(teniP*ropw_3ir(p3fl)brS3t)*u3*(l.DO*s3t)
. I wc*temp/=5s_tenip/2ss_rhoe i conden/rho_wster)
if (teap.ne.smt) c? = dm3xl(dh/(tenip-3iiit)
c
c
c
return
end
****
15 — SYS$DEGADIS:TFROP,FOR 2o-oci-i987 00:39:16
-------
F-199
c
c
C FILE NAME TRANS1 ~ FOR USE IN DEGADIS1
C
C
C
SUBROUTINE TRANS(FILE)
C
Implicit Resl*8 ( A-H> 0-Z )» Inteaer*4 ( I-N )
include 'sBS$deS3dis:DEGAIUSl,dec'
c
C BLOCK COMMON
C
COMMON
$/GEN3/ r sd£(2>msxl)tostr(2»msxl)?srcden(2>mexl)»srcwc(2>rosxl)>
f srcw3(2»ni3xl) >srcenth(2>msxl)
$/TITL/TITLE
5/GEN1/ PTIME(iSen)» ET(i3en)» RlT(i^en)» PUC(i2en)> PTEMP(i3en)»
$ PFRACV(i2en)» PENTH(i2en)i PRHO(iaen)
$/GEN2/ DEN(5»iaen)
$/ITI/Tl»TINPfTSRC»TOBSfTSRT
$/ERROR/STPIN»ERBND>STPMX»WTRG>WTtntfWTa3»wtyc>wtebfwtmb»wtuhjXLI»
$ XRIfEPS»ZLOW»STPINZfERBNDZiSTPMXZfSRCOER»srcss»spccut»
$ htcut>ERNOBL»MOBLpt»crfaer»epsilon
I/PARM/UO > ZO, ZR j ML, USTAR > K»G > RHOE»RHOA»DELTA»BETA i GAMM AF > CcLOW
f/cootstm/ istsb>tainbfpsoib>huitiidj i=-of 1 jtsurf >ihtfl»htco»iwtfl»wtco>
$ humsre
J/PARMSC/ P.M»SZM ? EMAX > RMAX»TSC1»ALEPHf TEND
$/coa_ss/ ess>sleniswid>outccjoijtss»outb>outl>swclfswsl>senlfsrhl
$/PHLAG/CHECK1»CHECK2»AGAIN»CHECKS»CHECK41CHECKS
$/coB_si2x/ si2x_coeff>si3x_pow>sisx_min_dist)
$/com_enthsl/ h_8t3srtefH_3irrte»H_w3trte
$/NEND/ POUNDNfPOUND
f/ALP/ ALPHA»slphsl
1/rhicoB/ iphiflfdellsy
$/sprd_con/ ce> delrhondn
f/COM_3URF/ HTCUTS
C
chsrscter*80 TITLEC4)
C
cherscter*4 pound
chsrscter*24 TSRC,TINP»TOBS»TSRT
c-h3rscter#3
REALMS ML.K
LOGICAL CHECK1,CHECK2»AGAIN»CHECK3»CHECK4»CHECKS
c
i ~ SYS*DEGADIS:TRANSI.FOR 20-oci-i987 00:41:02
-------
F-200
chsracter*(*) file
C
OPEN(UNIT=8,NAME=FILE,TYPE='NEU'J
$ csrrissecontrol='list'i
$ recordtype=/variable')
C
URITE<8,1000) (TITLE(I),1=1,4)
1000 FOR«AT(A80)
C
DO 100 I=l,i3en
100 IF(FTIME(I),EQ.POUNDN) GO TO 105
write(6,*) ' POUND WAS NOT DETECTED '
105 NF = I - 1
WRITE(S>1040) NP
DO 110 1=1,NP
110 URITE(S»1030) PTIME(I),ET(I),R1TDEN(2»I)»den(3>i)»den(4>i)»den(5>i)
write(6>*) ' density function blew the loop'
125 NP = I - 1
WRITE(8,1040) NP
DO 130 1=1»NF
130 URITE(8»1060) DEN(1»I) >DEN(2>I) »den(3»i)..den(4>i),den(5»i)
c
DO 140 I=l,n.3>cl
c cc = srcwc(2»i)*srcden(2,i)
c if(cc.lt. cclow) then
c fee = 0.
c do ii=i-fIfm3xl
c fee = 3ia3xl(srcwc(2,ii)*srcden(2»ii)»fcc)
c enddo
c if(fcc.2e, cc) 2oto 140
c np = i
c tend = srcuc(lfi)
c 2oto 146
c endif
140 IF(r3d2(l,I),EQ,FOUNDN .AND. rsd^(2,I).EQ.POUNDN) GO TO 145
write(6,*) ' FOUND UAS NOT DETECTED '
145 NP = I - 1
146 WRITE(S,1040) NP
DO 150 I=liNP
150 WRITE(8,1060) rsd2(l,i),rsda(2,i)»astr(2»i),srcden(2»i),srcwc(2,i)
1 ,srcws(2»i),srcenth(2,i)
c
1020 forrost(lx»i4»lx,lP2l4.7)
1030 foriB3t(8(lx,lp3l4.7))
1040 forra3t(lx»i4)
2 — SYS$DEGADIS:TRANSI.FOR 20-OCT-1987 00:41:02
-------
F-201
1050 formst(2(s24flx))
1060 forni3t(lx»lPS23.16»7(lxflp2l4,7))
1070 formst(lx?lPSl4,7)
10SO formst(33)
c
URITE(8fl050) TINP»TSRC
write(S»1050) TOBS,TSRT
WRITE(8>1060) UO»ZO»ZR>«LfUSTAR
write<8»1060) K»G»RHOE?RHOA> DELTA
write(8r!030) BETA>6AHHAFfCcLOW
URITE(S»1060) RMfSZMiEMAXfRMAX»TSCl
write(3>1030) ALEPH>TEND
URITE(8»*) CHECKlfCHECK2>AGAIN»CHECK3»CHECK4»CHECK5
WRITE(S»1070) ALPHA
write(S»1080) 23s_nsme
urite<8> 1030) 33s_ffiw»S3s_teniPr Sss_rhoe
write(S»1030)
writs<:S»1030)
write';3>1040) istsb
write(8» 1030)
write(8>1020) isofl»tsurf
write(8f!020) ihtfl»htco
write(8»102Q) iwtfl»wtco
write(8>1030) sisx_coeff >si3x_
if(check4) then
wpite(8»1030) ess»slen»swid
wpite(S>1060) outcc.«outs2»oijtb»oijtl
write(8> 1060) swcl>sw3l»senl »srhl
end if
write(B»1020) iphif lidellss
if (isofl.ea. 0) write(8»1030) H_mssrte
URITE(8»1030) HTCUTS. ce» delrhomin
CLQSE(UNIT=8)
RETURN
END
****
3 — SYS$DEGADIS:TRANSI,FOR 20-ocT-i?87 00:41:02
-------
F-202
C ....
c
C FILE NAME TRANS2 ~ USE WITH DE6ADIS2
C
SUBROUTINE TRANS(FILE)
Implicit Resl*8 ( A-H> 0-Z )» Inte3er*4 ( I-N )
include 'sys$de5sdis:DEGADIS2.dec'
COMMON
f /SSCON/ NREC ( msxnob > 2 ) » TO ( msxnob ) i XV ( msxnob )
S/GEN2/ DEN(5»isen)
$/ITI/ Tl»TINP>TSRCfTOBS»TSRT
$/PARM/ UO i ZO » ZR i ML , USTAR , K » G , RHOE » RHOA , DELTA > BETA , GAMMAF i CcLOU
$/coui3tm/ i stab > tsmb > psmb > humid >isofl>tsurf >ihtfl »htco»iwtfl»wtcot
f hums re
$/PARMSC/ RM i SZM t EMAX i RMAX » TSC1 » ALEPH » TEND
5/PHLAG/ CHECK 1 j CHECK2 f AGA IN > CHECK3 > CHECK4 , CHECKS
f/cora_=.iSx/ siS;:_coeff >
f/nend/ poundn» pound
f/ALP/ ALPHA »slph3l
$/CNOBS/ NOBS
chsrscter*80 TITLEC4)
c-h3Pscter*24 TINP>TSRC»TOBS»TSRT
chsrscterSW file
c
REAL*8 KfML
LOGICAL CHECK 1,CHECK2» AGAIN, CHECK3»CHECK4» CHECKS
r
Is
OPEN(UNIT=9fNAME=FILE»TYPE=/NEH'»
$ C3rris2econtrol='list' »
$ recordtyF-e='vsri3ble')
C
URITE(9fl040) NOBS
DO 125 1= 1; NOBS
125 URITE(9»1010) NREC(Iil) >NREC(I>2) »TO(I) >XV(I)
c
DO 140 I=l»isen
140 IF*) ' density function error in TRANS'
145 NP = I - 1
URITE(9»1040) NP
DO 150 1=1 »NP
150 URITE(9»1060) DEN(1»I) »DEN(2»I) »den(3»i) »den(4>i) »den(5»i)
C
1 — SYS$DEGADIS:TRANS2.FOR 20-OCT-1987 OOMi:36
-------
F-203
URITE(9il060) UOfZO»ZRiML»USTAR
write(9»1060) K»G»RHOE»RHOA»DELTA
write(9?1030) &ETArGAHMAF»CcLOW
URITE(9»1050) TINPiTSRC
write(9>1050) TQFS.TSRT
URITE(9fl060) RMiSZMiEHAX»R«AXfTSCl
write(9»1020) ALEPHiTEND
writs(9j!080) aes.nsme
writs(9>1030) 23s_mw»233_tempf2ss_rhoe
urite<9>1020) S3s_cpk»2ss_cpp
write<9r1030) ass_ufIi3ss_lfl»g3s_zsp
write(9i!040) istsb
write(9»1025) isofl»tsurf
write(9f!025) ihtfljhtco
write(9i!025) iwtfl»wtco
write(9»1030) si2;:_cceff>sisx_powisisx_Bin_dist
c
WRITE(9>*) CHECK1»CHECK2»AGAINiCHECK3»CHECK4>CHECKS
C
WR!TE(9il070) ALPHA
c
1010 form3t(lx»i8ilxii8»2(lxilp^l4,7))
1025 fcrni3t(lx»i4»lx>lp3l4,7)
1030 for«8t(3(lx»lp3l4.7))
1040 fornist(lxii4)
1050 forffi3t(2(s24flx))
1060 for»3t<5(lXFlp2l4.7))
1070 forrost(lxFlPSl4.7)
10SO form£t(s3ilx)
C
CLOSE(UNIT=9)
RETURN
END
~ SYS$DEBADIS:TRANS2,FOR 20-OCT-1987 OOMi:36
-------
F-204
C
C
C FILE NAME TRANS2 ~ USE WITH SDEGADIS2
C
SUBROUTINE TRANS(FILE)
C
C
C
C
Implicit Resl*8 ( A-H» 0-Z )» Inte2er*4 ( I-N )
COMMON
$/PARM/ UOfZOfZRfML»USTARtK»GfRHOE»RHOAfDELTAiBETA»GAMMAF»CcLOW
$/com_2prop/
$ 23s_uflj2s=
S/ccmstm/ istsbjtsntbfpsmb>humid* isof 1 »tsurf> ihtfl>htco»iwtfl»wtco»
$ humsre
$/ITI/ tl»TINP»TSRCfTOBS
$/PHLAG/CHECKlfCHECK2»AGAIN»CHECKS»CHECK4»CHECKS
$/ALP/ALPHA>slphsl
C
chsrscter*24 TSRC»TINP>TOBS
chsrscter*3 235_n3me
chsrsctsr*(*) file
C
REAL*8 K»ML
LOGICAL CHECK1fCHECK2»AGAIN»CHECKS >CHECK4»CHECKS
C
OPEN(UNIT=9»NAME=FILE»TYPE='NEW)
C
WRITE(9»1060) UO»ZO»ZR»ML»USTAR
write(9>1060) K»G»RHOE»RHOA»DELTA
write(9>1030) BETA»GAMMAF>CcLOU
c
URITE(9fl050) TINP>TSRC
write<9>1050) TOBS
write(9»10SO)
writs(9> 1030)
write(9»1020) 2ss_
write(9»1030)
write(9>1040) istsb
write(9»1030)
write(9>1025) isofl»tsurf
write(9i!025) ihtflfhtco
write(9>1025) iwtfl»wtco
c
1 — SYS$DEGADISJTRANS2SS.FOR 20-OCT-1987 OOM1J58
-------
F-205
URITE<9>*) CHECKl»CHECK2»AGAINfCHECK3fCHECK4»CHECK5
UF:lTE(9jl070) ALPHA
C
CLOSE(UNIT=9)
c
1020 form3t<2(lx>lP2l4,7))
1025 form3tip2l4.7)
1080 fcrn;st(£3flx>
C
RETURN
END
2 — SYS$DEGADIS:TRANS2SS,FOR 20-OCT-1987 OOM1J58
-------
F-206
C FILE NAME TRANS3 FOR USE WITH DEGADIS3
C
C
C
SUBROUTINE TRANS(OPNRUP)
Implicit Re3l*S ( A-H» 0-2 )» Inte2er*4 ( I-N )
include 'sys$deSsdisJDEGADIS3.dec/list'
C
COMMON /SORT/TCc(msxnobtmsxnt)»TCcSTR(msxnob»nsxnt)>
$ Tuc(iD3xnob*ro3xnt) >Trha(m3xnobrmsxnt)»
$ TSsmitie- (msxnob f msxnt)»Ttemp(msxnob > msxnt) >
$ TSY(msxnobfmsxnt)iTSZ(naxnob>msxnt)»TB(rosxnobTmsxnt)
$ TDISTO(iriexnobnnsxrit)»TDISTm3xrit)>KSUB(nisxnt)
*/SORTIN/TIM
-------
F-207
c
C SUBROUTINE TRAP — DIAGNOSTICS
C
SUBROUTINE trsp(N»Nl)
Implicit Resl*8 ( A-H» 0-Z )* Inteser*4 < I-N )
include 's«s$de3sdis:DEGAniS2.dec'
c
COMMON /ITI/TIfTINPiTSRC»TOBS»TSRT
reel*4 ttl
c
chsrscter*24 TINP»TSRC»TOBS»TSRT
c
chsrscter*24 tt
chsrscter#SO dd
C
WRITE(lunlo2»1100)
WRITEaunlc3»1110)
write(lurilo2»1115) n
c
check to see if the operstor is resdy to resd the text of the error
ntesssse
c
write(lunloSflOOO)
irtn = Iib$3et_coniiti3nd( dd ) ! Set 3 line fron the terrain3l
10 write(lunlo2?10Q2)
C
IF(N ,EQ, 1 ) then
WRITE(lunloS»2010) Nl
WRITE(lunlogf2011)
else IF(N ,EQ. 2 ) then
WRITE(lunlO£!f2020>
else IF(N ,EQ» 3 ) then
URITE(lunlos»2030) Nl
else IF(N ,EQ» 4 ) then
URITE(lunlogi2040>
else IFCN ^EQ, 5 ) then
WRITE(lunlo2»2050)
else IF(N ,EQ. 6 ) then
WRITE(lunlosJ»20AO>
else IF(N ,EQ, 7 ) then
WRITE2070)
else IF(N ,EQ» 8 ) then
WRITE(lunlostf2080> Nl
WRITE(lunlo3i2081)
else IF(N ,EQ, 9 ) then
WRITE(lunlogi2090) Nl
1 — SYSfDEGADISJTRAP.FOR 20-OCT-1987 OOJ42J24
-------
F-208
WRITE(lunloS»2091)
else IFCN .EG, 10) then
WRITE*lunlos?2100) Nl
WRITE*lunlog»2101>
endif
IFCN ,EQ, 11) WRITEClunloS>2110>
IF(N ,EQ. 12) URITE(lunlo3»2120)
IFCN .EQ. 13) WRITE(lunloS»2130)
IF(N ,EQ. 14) WRITE(lunlosS»2140)
IF(N ,EQ, 15) WRITE(lunlos»2150>
IF(N ,EQ, 16) URITE(lunlog»2160)
IFCN ,EQ. 17) WRITE(lunlo3»2170>
IF(N ,EQ. IS) then
WRITE*! unless, 2180) Nl
WRITE*Iunlo2>2181)
endif
IF(N ,EQ. 1?) WRITE*lunlos»2190) Nl
IF(N .EQ, 20) WRITE(lunlodf2200)
IFCN ,EQ, 21) URITE(lunlo2»2210)
IFCN ,EQ» 22) URITEClunlo3f2220)
IFCN ,EQ, 23) then
URITE(lunlo^»2230) msxnob
URITEaunloSi223l)
endif
IFCN .EQ. 24) WRITEClunlo2>2240)
IFCN ,EQ. 25) WRITE(lunlo3»2250)
IFCN .EQ. 26) WRITEClunlo5>2260)
IFCN .EQ. 27) URITE(lunlos»2270>
IFCN ,EQ, 28) WRITE(lunlo2>2280)
IFCN .EQ. 29) URITEClunlo2f2290)
IFCN .EQ. 30) URITE(lunlo2»2300)
IFCN .EQ. 31) URITE(lunloSf2310)
IFCN .EQ. 32) URITE(lunloS»2320)
IFCN .EQ, 33) WRITEClunlo3»2330)
C
1000 fori»3t(/j5x»'Ready for the text of the error messsSe? '»$)
1002 formstC/)
1100 FORMATC5X>'The best laid plans of mice and men...')
1110 FORMAT<5X»'You have entered a TRAP -- the land of no RETURN.')
1115 formate Code: '»i4)
2010 FORMATC5X»'DEGADIS1? Source integration has returned IHLF='»I3>/»
./»' This error occurs during integration of the eouations'?/>
.' which describe the 3as source, IHLF is an error code'f/>
.' returned by the integration package RKGST.S/A
,' When IHLF=11> more than 10 bisections of the initial'»/»
,' increment of the independent variable were necessary to »ake'»/»
,' an integration step within the specified error. Reduce the'»/»
.' initial step sire of the independent variable'i/f
.' (STPIN in the ER1 file). If this does not work»'f/»
,' it will be necessary to either increase the error criteria'*/*
2 -- SYSfDEBADISJTRAP.FOR 20-OCT-1987 OOJ42:24
-------
F-209
,' for all of the dependent vsrisbles being integrated'?/?
,' (ERBNB in the ER1 file) or increase the error criteria'?/?
,' for the vsrisble violating the criteria by decreasing the'?/'
,' error weight for thst vsrisble (one of the following UTRG?'?/?
.' WTTM? UTYA? WTYC? WTEB? UTMB? or WTUH in the ER1 file).'?/)
2011 format*
,' When IHLF=12? the initial increment of the independent'?/*
,' vsrisble (STPIN) is 0. Correct the ER1 file and execute the'?/?
.' progrsm sgsin.'?//?
When IHLF=13? the initisl increment of the independent'?/?
,' vsrisble (STPIN) is not the same sign ss the difference'?/?
.' between the upper bound of the interval end the lower bound'?/?
>' of the interval. STPIN must be positive. Correct the ER1'?/?
»' file snd execute the program sgsin.'?//)
2020 FORMAT<5X?'Reserved')
,__2030 forniet(5x?'SZF? Locsl integration failed? IHLF='?I3?/?
,/?' This error occurs during estimation of SZ over the'?/?
,' source when no gas is present. IHLF is an error code'?/?
.' returned by the integration package RKGST.'*//?
.' When IHLF=11- more than 10 bisections of the initials/?
.' increment of the independent variable were necessary to make'?/?
.' sn integration step within the specified error. Reduce the'?/»
.' initial step size of the independent variable'f/r
.' (SZSTPO in the ER1 file). If this does not work?'»/>
.' increase the error criteria for all of the dependent'»/?
,' vsrisbles being integrated (SZERR in the ER1 file).'i//»
.' When IHLF=12» the initisl increment of the independent'?/?
.' vsrisble (SZSTPO) is 0. Correct the ER1 file snd execute the'?/?
.' progrsra sgsin.'?//?
,' When IHLF=13? the initial increment of the independent'?/?
.' vsrisble (SZSTPO) is not the same sign as the difference'?/?
.' between the upper bound of the interval and the lower bound'?/?
.' of the interval, SZSTPO must be positive. Correct the ER1'?/?
.' file snd execute the program sgain.'?//)
2040 formst(5x?'SURFACE? Negative QRTE for positive DELTA.T'?//?
.' This is a diagnostic message indicsting sn error in'?/?
.' estimation of the hest cspscity» Check the input'?/?
.' to the model and execute the program again.'?//)
2050 FORMAT(5X»'CRFG? MORE POINTS FOR GEN3 WERE NEEDED'?//?
The COMMON srea /GEN3/ stores representative vslues'?/?
.' of the calculated source parsmeters. If this message'?/?
.' occurs? relsx the CRFG error criteria (CRFGER) in the'?/?
.' ER1 file. If this is a common problem? the length of the'?/?
,' /GEN3/ vectors csn be increased by changing the value of'?/?
.' MAXL in DEGADIS1.DEC snd reinstalling DEGADIS.'?//)
2060 FORMAT(5X?'TUPF? OBSERVER CALCULATIONS — TUPF FAILED'?//?
3 — SYS$DEGADIS:TRAP.FOR 20-ocT-m? 00:42:24
-------
F-210
.' The trial ?nd error search sssocisted with finding the'*/*
»' upwind edge of the gss source for sn observer failed.'*/*
.' Often? this problem csn be svoided by adding one or two'?/*
.' additional observers to the present number of observers'*/?
*' (which changes the conditions for the trial snd error).'*/?
.' Another possibility is to increase the error criteria for'*/*
,' this function (ERTUPF) in the ER2 file.'i//)
2070 FORMAT(SX.'TUPF? OBSERVER CALCULATIONS — TDNF FAILED'*//.
.' The trisl snd error search sssocisted with finding the'*/*
.' downwind edge of the gss source for en observer failed.'?/*
»' Often? this problem can be avoided ba sdding one or two'?/*
>' sdditionsl observers to the present number of observers'?/*
»' (which changes the conditions for the trisl snd error),'*/?
»' Another possibility is to increase the error criteria for'*/?
.' this function (ERTDNF) in the ER2 file,'*//)
2030 FORMATC5X*'SSSUP? OBSERVER INTEGRATION FAILED* IHLF='?I3*//*
.' This error occurs during integration of the five'*/*
.' differential eauations which average the source for each'?/?
.' observer. IHLF is an error code returned by the'*/?
.' integration psckage RKGST,'*//*
.' When IHLF=11* more than 10 bisections of the initial'*/>
.' increment of the independent variable were necessary to raske'*/*
,' sn integration step within the specified error. Reduce the'»/»
.' initial step size of the independent variable'*/?
.' (STPO in the ER2 file). If this does not work»'»/>
.' it will be necessary to either increase the error criteria'*/*
.' for all of the dependent vsrisbles beinS integrated'*/*
.' (ERRO in the ER2 file) or increase the error criteria'*/»
.' for the vsriable violating the criteria by decreasing the'*/*
.' error weight for thst variable (one of the following! UTAIO*'*/*
.' WTQOO* or UTSZO in the ER2 file).'*/)
20S1 format(
.' When IHLF=12» the initisl increment of the independent'*/>
,' variable (STPO) is 0. Correct the ER2 file and execute the'*/*
,' program again,'*//*
,' Uhen IHLF=13* the initial increment of the independent'*/*
.' vsriable (STPO) is net the same sign as the difference'*/*
>' between the upper bound of the interval snd the lower bound'*/*
.' of the interval. STPO must be positive. Correct the ER2'*/*
.' file snd execute the progrsm sgsin,'*//)
2090 FORMAT(5X*'SSSUP/SDEGADIS2? PSEUDO-STEADY INTEG FAILED* IHLF='*I3*
,//*' This error occurs during integration of the four'*/*
.' differential eouations describing the portion of the'*/*
.' downwind calculation when b>0. The routine calling TRAP is'*/*
.' SSSUP if a transient simulation is being executed* if a'*/»
,' steady state simulation is being executed* the calling'*/*
.' routine is SDEGADIS2. IHLF is an error code returned by the'*/*
.' integration psckage RKGST.'*//*
4 — SYS$DEGADIS:TRAP.FOR 20-OCT-1987 00.'42:24
-------
F-211
.' When IHLF=11? more than 10 bisections of the initial'?/?
.' increment of the independent variable were necessary to make'?/?
. ' sn integration step within the specified error. Reduce the'?/?
»' initial step size of the independent variable'?/?
, ' (STPP in the ER2 file). If this does not work?'?/?
.' it will be necessary to either increase the error criteria' >/>
.' for all of the dependent variables being integrated'?/?
.' (ERRP in the ER2 file) or increase the error criteria' ?/?
. ' for the variable violating the criteria by decreasing the'?/?
. ' error weight for that variable (one of the following? UTSZP?'?/?
.' WTSYP? UTBEP? or UTDH in the ER2 file).'?/)
2091 format (
.' When IHLF=12> the initial increment of the independent'?/?
.' variable (STPP) is 0. Correct the ER2 file and execute the'?/?
.' program again,'?//?
,' When IKLF=13? the initial increment of the independent'?/?
,' variable (STPP) is not the same sign as the difference'?/?
.' between the upper bound of the interval and the lower bound'?/?
.' of the interval. STPP must be positive, Correct the ER2'?/?
.' file and execute the program
2100 FORttAT(5X?'SSSUP/SDEGABIS2? GAUSSIAN INTEGRATION FAIL? IHLF='?I3?
,//?' This error occurs during integration of the'?/?
.' differential eouations describing the portion of the'?/?
.' downwind calculation when b=0. The routine calling TRAP is'?/?
.' SSSUP if a transient simulation is being executed? if 3'?/?
.' steady state simulation is being executed? the calling'?/?
.' routine is SDEGADIS2. IHLF is an error code returned by the'?/?
.' integration package RKGST,'?//?
.' Uhen IHLF=11? more than 10 bisections of the initial'?/?
.' increment of the independent variable were necessary to make'?/?
.' an integration step within the specified error. Reduce the'?/?
<• ' initial step sire of the independent variable'?/?
,' (STPG in the ER2 file). If this does not work?'?/?
.' it will be necessary to either increase the error criteria'?/?
,' for all of the dependent variables being integrated'?/?
.' (ERRG in the ER2 file) or increase the error criteria'?/?
.' for the variable violating the criteria by decreasing the'?/?
,' error weight for that variable (either UTRUH or UTBHG'?/?
.' in the ER2 file).'?//)
2101 format(
.' Uhen IHLF=12? the initial increment of the independent'?/?
.' variable (STFG) is 0. Correct the ER2 file and execute the'?/?
.' program again,'?//?
.' When IHLF=13? the initial increment of the independent'?/?
.' variable (STPG) is not the sane sign as the difference'?/?
.' between the upper bound of the interval and the lower bound'?/?
.' of the interval. STPG must be positive. Correct the ER2'?/?
.' file and execute the program again,'?//)
2110 FORMAT(5X?'SSSUP/SBEGADIS2? TOTAL No. OF RECORDS EXCEED 120000'?
5 — SYSfDEGABIS: TRAP. FOR 20-OCT-1987 00 { 42 524
-------
F-212
.//?' This is an arbitrary stopping point for the process',/,
»' in order to keep 3 runaway simulation frois filling UP disk',/'
, ' space. Relax the output specifications (ODLP? ODLLP? ODLG,',/,
.' or ODLLG) in the ER2 file in order to generate less output' ?/?
. ' if the input parameters ere valid.'?//)
2120 FORMATOX? 'Reserved')
2130 FORMATOX, 'Reserved')
2140 FORMAT (5X,' Reserved')
2150 FORMAT (5X,' Reserved')
2160 FORMAT(5X?'PSSOUT/PSSOUTSS? PSS STARTED WITH B<0,',//,
This condition is checked st the beginning of the'?/?
. ' downwind calculation in order to confirm proper handling of'?/?
.' the movement to the Gsussisn phase of the downwind '*/»
.' calculation. Check the initial conditions and execute the'?/?
, ' program
2170 for!L3t(5x?'TPROP/ADIiHEAT? Enthalpy out of bounds' ?//?
.' Diagnostic message indication an enthalpy lower' »/?
.' than the adiabatic mixing enthalpy was passed to ADDHEAT.'?/?
.' Check the input conditions and execute the program again.'?//)
21SO FORMAT (5X?'ALPH? ALPHA INTEGRATION FAILED. IHLF=' ,I3?//,
.' The integration which determines the integral least'?/?
.' ssuares fit for ALPHA has failed. Note that small values' >/»
.' of the Monin-Obukhov length ( ML < 0(lm) ) in combination' >A
.' with stable atmospheric conditions maa cause this f allure, 'r/t
.' IHLF is 3n error code returned by the integration package' t/>
.' RKGST.'j/A
.' When IHLF=llf more than 10 bisections of the initial '»/»
.' increment of the independent variable were necessary to make'»/»
.' en integration step within the specified error. Reduce the'?/»
.' absolute value of the initial step size of the independent' >/i
.' vsrieble (STPINZ in the ER1 file). If this does not work»'>/»
.' it will be necessary to increase the error criteria' >/r
. ' (ERBNDZ in the ER1 file).',//)
21S1 format(
.' When IHLF=12? the initial increment of the independent' »/»
.' variable (STPINZ) is 0, Correct the ER1 file and execute'?/,
,' the program again.'?//,
.' When IHLF=13? the initial increment of the independent'?/?
.' variable (STPINZ) is not the same sign as the difference',/?
.' between the upper bound of the interval and the lower bound'?/?
.' of the interval. STPINZ must be negative. Correct the ER1',/,
.' file and execute the program again. This error will also'?/?
.' occur if the surface roughness ZR is greater than the',/?
.' reference height Z0»'?//)
2190 FORMAT (5X,'ALFH? RTMI has failed to locate ALPHA IERR: ',I4?//?
.' The sesrch procedure which determines ALPHA has failed.',/,
6 -- SYSfDEGADIS: TRAP. FOR 20-OCT-1987 OOM2t24
-------
F-213
,' This error rosy be the result of an unusual velocity'?/?
.' specification such as small values of the Monin-Obukvov'?/?
.' length ( ML < 0(1,m) ) or smsll reference heights'?/?
*' ( ZO < 0(10, # ML) ). IERR is an error code returned by'?/?
,' the routine RTMI.'?//?
When IERR=1? the search for ALPHA failed after a'?/?
,' specified number of iterations. Increase the error bound'?/?
,' used by RTMI (EPS in ER1 file),'?//?
,' When IERR=2? the basic assumption that the function which'?/?
,' governs the search fop ALPHA changes sign over the specified'?/?
,' interval is false, Increase the search interval by'?/«
,' decreasing the lower bound of ALPHA (XLI in the ER1 file)'?/*
.' and increasing the upper bound (XRI in the ER1 file),'?//)
2200 formst(5:;j'ESTRT? Premature EOF in RUN.NAME.ER1 or RUN_NAME,ER2,'
,?//?' The portion of the program which reads ER1 and'?/?
.' ER2 files encountered an end-of-file mark before all of'?/?
,' the information had been read, Confirm these files and'?/?
,' execute the program again, If necessary? copy and edit'?/?
.' the appropriate EXAMPLE file and execute the program again,'?//)
2210 FORMAT(5X?'ESTRT1/ESTRT2/ESTRT2SS/ESTRT3? DECODE failed'?//?
,' The portion of the program which reads the ER1? ER2?'?/?
,' or the ER3 file failed to understand a numerical entry.'?/?
,' The numbers must appear in columns 11-20 of the line with'?/?
,' no alphabetic characters in the field. (Note that'?/?
,' exponential notation is not allowed,) This restriction'?/?
,' does not apply to comment lines which have an exclamation'?/?
,' point (!) in the first column.'?//)
2220 fornstfSxi'ESTRTl? The parameter file RUN.NAME.ERl '?
,'was not found.'?//?
.' The ER1 file was not found for the current simualtion'?/?
.' (RUN_NAME). Copy the file EXAMPLE.ER1 file to RUN.NAME.ERT ?/?
.' and edit it as necessary. Execute the program again.'?//)
2230 format(5x?'SORTSl? Fewer than 3 points sorted for any time,'?//?
.' Only one or two simualtion points were applicable for'?/?
,' the sort tiroes specified. There are three possible causes'?/?
.' for this condition?'?//?
,' (1) If this message appears when the sort times are'?/?
.' defaulted (CHECKS is set to 0. in the ER3 file)? the'?/?
,' number of observers will probably have to be increased'?/?
,' to give a good resolution of the downwind concentration'?/?
.' field, (The number of observers is NOBS in the ER2 file'?/?
,' with a maximum of '?I3?' (MAXNOB) in DEGADIS2.DEC.)'?/?
,' As a rule of thumb? one gets good resolution of the downwind'?/?
.' concentration field if the ratioJ'?/?
,' (secondary source duration / number of observers) is less'?/?
»' than about 10 seconds (or 20 at most).'?//?
(2) The sort times specified in the ER3 file were'?/?
7 -- SYS$DEGADIS:TRAP,FOR 2o-ocT-i?87 00:42:24
-------
F-21A
.' before the simulation had developed significantly.'?/>
.' This is only applicable when the user is specifying the sort'*/*
.' times (i.e. when CHECKS is set to 1. in the ER3 file).'»/i
.' Increase the time of the first sort (ERTD* end rerun the'?/?
.' program.' */)
2231 forosK
,' (3) The sort times specified in the ER3 file were'*/*
.' after the gas was below the lowest concentration of interest'*/?
.' This is only applicable when the user is specifying the sort'*/*
.' times (i.e. when CHECKS is set to 1, in the ER3 file).'*/*
,' Increase the time of the first sort (ERTD* and rerun the'*/*
.' program. If additions! results sre desired for later'*/*
.' times» restart the simulation and specify a lower'»/*
.' concentration of interest in the input step ( lower'»/»
.' CCLOW in DEGADISIN).'*//)
2240 format(Sx*'TPROP? Trial and error loop compromised'*//*
.' TPROP estimates the temperature of a mixture based'>/>
.' upon the composition and enthalpy of the mixture. Ensure'*/*
.' the properties for the diffusing species are entered'»/*
.' correctly snd execute the simulation sgsin.'i//)
2250 formst(5x*'TPROP? Isothermal density loop compromised'*//*
.' This error should never occur* but if it does* rebuild'*/*
.' the model from the original files and run the simulation'*/*
.' over.'*//)
2260 formsUSx*'TPROP? Invalid entry flag in ADIABAT'*//*
.' This is 3 programming diagnostic and should never occur.'»/>
.' If it does* rebuild the model from the origins! files.'*//)
2270 formst(5x*'Reserved')
22SO format(5x*'TPROP? IGEN reauest too large in SETDEN'»//»
The subroutine SETDEN (in TPROP) performs a series of'*/*
.' adisbstic mixing calculations with a specified gas mixture'>/>
.' snd ambient air and places the result in the array'*/*
.' BEN(5»IGEN). This error indicates more points are needed in'*/*
.' DEN than were originally rectuested. Incresse the sllocsticn'*/*
.' for DEN by changing the value of IGEN in DEGADISIN.DEC and'*/»
.' reinstalling DEGADIS,'*//)
2290 formst(5x»'PHIF? flag IPHIFL is out of bounds'*//*
,' Proper values of IPHIFL sre integers between 1 and 5 '*/>
.' inclusive, Although values of IPHIFL sre entered in the ERl'»/>
,' file as real numbers* they should be in this range. Check'*/*
.' the ER1 file and execute the program sgsin.'*//)
2300 formst(5;c*'SSSUP/SDEGADIS2? concentration greater than RHOE'»//»
.' If the concentration of the contsminsnt becomes'*/*
.' greater thsn the pure component density for an isothermal'*/*
3 — SYS$DEGADISJTRAP,FOR 20-OCT-1987 00:42524
-------
F-215
.' simulation? this error will occur. However? this situation'?/?
,' should never occur. Check the input conditions and execute'?/?
.' the profirsm sSsin.'?//)
2310 forn.at(5x?'SSSUP? concentration greater than RHOE'?//»
.' If the concentrstion of the contaminant becomes'?/?
»' greater than the pure component density for sn isothermal' ?/?
.' simulation? this error will occur. However? this situation'?/?
.' should never occur. Check the input conditions and execute'?/?
. ' the program again.'?//)
2320 format (5x?'PSS? Sz convergence failure.'?//?
This is s programming diagnostic and should never occur.'?/?
.' If it does? check the input conditions and execute the'?/?
,' program
2330 formatOxj'SSG? Sz convergence failure. '»//»
»' This is a proSraniniina diagnostic and should never occur.'?/?
.' If it does? check the input conditions and execute the'?/?
,' program as'ain.'?//)
C
CLOSE(UNIT=9)
C
CALL TRANS( 'trap. DBG')
C
islet = lib$dste_time(TT)
ttl = tl
ttine = secnds(ttl)/60.
C
140 URITEQunlo2?3000) TT
WRITE(lunloSf3010) Ttine
3000 FORHATdX?' — ENDin^ AT '?A24)
3010 FORMAT(5X?' ***** ELAPSED TIME ***** '?1?313.5>' MIN ')
C
irtn = LIB$DO_COMMAND( 'Exit' ) ! this issues the command EXIT to VMS
c ! which should cancel any pending
c ! programs in a command file.
CALL EXIT
END
****
9 ~ SYS$DEGADIS4.TRAP.FOR 20-OCT-1987 OOM2524
-------
F-216
C ,
c
C FUNCTION TO CALCULATE A SPECIFIED TIME
C
FUNCTION TS(TOlfBIST)
C
Implicit Resl*S ( A-H? 0-2 >» Inte2er*4 ( I-N )
COMMON
$/FARMSC/RM tSZM»EMAX»RMAX >TSC1»ALEPH >TEND
*/ALP/ALPHAfSlFhsl
r
^
TS = T01 + (DIST+RMAX)«(1,/ALPHA1) /ALEPH
C
RETURN
END
t***
— SYS$DEGADIS:TS.FOR 2o-ocT-i98? 00:44:55
-------
F-217
C [[[
c
C OBSERVER TRIAL AND ERROR FUNCTIONS
C — TUPF ---- TDNF —
c
c Modified 30 Jan 86 for more general trial and error scheme, ts
C
FUNCTION TUPF (TOD
C
Implicit Real*8 ( A-H? 0-Z )» Integer*4 ( I-N )
include 'sys$deg3dis:DEGADIS2,dec'
c
COMMON
$/GEN3/ rsdg<2»nisxl) i astr(2jmsxl) »srcden(2jmsxl) >srcwc(2jmsxl) »
$ srcw3(2>msxl) jsrcenth(2jmsxl)
I/ERROR/SYOER j ERRO » SZOER i UTAIO. WTOOO > WTSZO» ERRP » SMXP»
$ WTSZP , WTS YP , UTBEP , WTDH » ERRG , SMXG , ERTDNF » ERTUPF , WTRUH , UTDHG
$ /PARMSC/RM , SZM » EMAX , RMAX , TSC1 1 ALEPH i TEND
$/ALP/ALPHAislphsl
C
LOGICAL pflsd ! for diagnostic output
2 = .false*
TMAX = RMAX** (1./ALPHA1) /ALEPH + TOL
TMIN = TOL
IFCTQL ,LT. 0.) TMIN = 0.
TMIN end TMAX represent the first snd last time this observer could
encounter the upwind ed2e of the source. TMAX is the time when the
observer passes over x=0» snd TMIN is the time the observer is
released (unless set to zero because the spill hss not yet begun).
Nowi refine the guess of TMIN snd TMAX by dividing the intervsl
into 20 segments snd checking if the observer crosses the upwind
edge over the smaller interval starting with TMIN.
c
DT = (TMAX - TMIN) / 20,
TL = TMIN
DO 10 1=1 j 19 ! I don't have to check the Isst interval.
TL = TL f DT
XO - XIT(TL» TOL)
XG = -AFGEN(RADG» TL> 'tupf')
DIF = XO - XG
IF(DIF .LT, 0.) GOTO 10 ! observer hss not yet resched upwind edge
TMAX = TL ! now observer hss resched upwind edge
TMIN = TL - DT
DIFATMAX = DIF ! DIF st MAX
GOTO 20
10 CONTINUE
TMIN = TMAX - DT
-------
F-218
DIFATMAX = DIF
20 CONTINUE
c
Now perform bisection search to get desired convergence between new TMAX
snd TMIN
c
TL = (TMAX + TMIN)/2,
C
DO 100 I = 1,20
II = 0
110 XG = -AFGEN(RADGjTLj'tupf')
XO = XIT(TLjTOL)
IF(XO .LT. 0.) GO TO 120
TL = xg»xo
5020 forisetC til ' » Ipgl3,5, ' tOl." »lpg!3.5» ' xgJMpgl3.5..
1 ' xo:'«ipgl3.5)
IFUI.EQ. 20) GOTO 101 ! Kill the program.
GO TO 110
C
120 CONTINUE
DIF = XO - XG
sum = abs(xo + >:2)/2, \ ERTUPF
IF(ABS(DIF)/sum .LT. ERTUPF) GO TO 1000
if(pfleg) write(6>5040) tmin>tni3X>tl>xo»xg
5040 formstC tmin: '»lP2l3.5» ' tmsx: '»lP3l3,5f ' ti: '»lpgl3.5>
IF( DIF*DIFATMAX ,GT. 0.) THEN
TMAX = TL ! 3 new nsxinun for the range
DIFATMAX = DIF ! s new DIF for the maximum
ELSE
TMIN = TL ! s new minimum for the rsnge
ENDIF
C
100 TL = (TMAX + TMIN)/2.
C
The sbove sesrch scheme fsiled. Before killing the progrsmj check to
see if the desired point falls on s transition from a blanket to a
non-blanket situation.
tl = TL-K01
T2 = TL-,01
XG1 = AFGEN(RADG>T1> 'tupf')
;;g2 = AFGEN(RADG»T2,'tupf)
dif = abs(xgl-xg2)
if(dif.gt, 100, .AND. (XO.GE.XG2 .AND. XO.LE.XG1)) then
tupf = t2 ! Jump from blanket to non-blanket occured
RETURN
ENDIF
SYSJDEGADIS: TUPF. FOR 20-OCT-1987 00145500
-------
F-219
c
c*** Kill the program.
101 if(pflag) write<6»4000) RM»SZM»EMAX»R«AX»TSCliALEPH»TEND»slPhs
4000 formate rnl' > Ipgl3,5j' szm." > Ipgl3,5»' eraaxt '»lpgl3,5»/»
1 ' rmax:'>lpgl3.5>' tsclt'»lpg!3.5»' aleph:'ilpgl3.5>/»
2 ' tendt'»lpgl3,5..' alpha!'»lpg!3.5)
if(pflag) write(6»4010) tmaxjtmin
4010 formate tmax: 'flpgl3.5»' train: '>lpg!3.5)
CALL trsp(6)
C
c*** successful completion
c
1000 TUPF = TL
RETURN
END
C
c
c
FUNCTION TDNF(TOL)
C
Implicit Real*S ( A-Hi 0-Z )» Integer*4 ( I-N )
include 'sys$degadis:DEGADIS2.dec'
c
COMMON
$/GEN3/ radg(2jmaxl)jQstr(2»maxl)>srcden(2imsxl)>srcwc(2jma;:l)»
$ srcwa(2>i»3xl) >srcenth(2»iaaxl)
$/ERROR/SYOERfERRO»SZOER»WTAIOfUTQOOfMTSZO»ERRPiSMXPi
$ UTSZP >UTSYP,UTBEP,UTDH,ERRG,SMXG,ERTDNF»ERTUPFiWTRUH»WTDHG
$/PARMSC/RM> SZM,EMAX»RMAX»TSC1,ALEPH,TEND
$/ALP/ALPHA»slphsl
LOGICAL
pflss = .FALSE.
THIN = RMAX**(1./ALPHA1)/ALEPH i TOL
IF(T«IN ,LT. 0.) THIN = 0.
THAX = (2.*RMAX)**(1,/ALPHA1)/ALEPH + TOL
THIN end TMAX represent the first and last time this observer could
encounter the downwind ed3e of the source. TMAX is the time when the
observer passes over x=+RMAX» and TMIN is the time the observer
c*** passes over x=0 (unless set to zero because the spill has not begun
c*** yet). NOWJ refine the guess of TMIN snd TMAX by dividing the interval
c*** into 20 segments and checking if the observer crosses the downwind
c*** edge over the smaller interval starting from TMAX.
c
DT = (TMAX - TMIN) / 20.
3 -- SYSSDEGADIS:TUPF.FOR 20-OCT-1987 00:45?00
-------
F-220
TL = TMAX
) write(6»*) 'taiBXt tmin> dt? 'jtBisx» tudn» dt
DO 10 1=1 i 19 ! I don't have to check the Isst interval.
TL = TL - DT
XO = XIT(TL» TOL)
XB = AFGEN(RADG> TL» 'tupf')
DIF = XO - XG
if(pflsg) write(6>*) 'tl> xo» x2» dif:'»tli xo» x2» dif
IF(DIF ,GT, 0.) GOTO 10 ! observer has passed the downwind edae
TMIN = TL ! now observer is sbout to reach downwind ed2e
TMAX = TL t DT
GOTO 20
10 CONTINUE
c
TMAX = TMIN + DT
20 CONTINUE
Xa = XIT(TMAX» TOL)
XG = AFGEN(RADG> TMAXr 'tupf )
DIFATMAX = XO - XG
iffpflssO then
write(6>*) '205 troax» tmint 'rtmax* tain
write(6f*) 'difatmsxi '»difstniax
end if
Now perform bisection search to Set desired convergence between new TMAX
and TMIN,
c
TL = (TMAX i TMIN)/2,
C
DO 100 I = 1»20
n = o
110 XG = AFGEN(RADG> TL> 'tdnf')
XO = XIT(TL»TOL)
C
IFCXO ,GT. 0,) GO TO 120
TL = (TMAX -i- TD/2.
II = II + 1
if(pfla^) write(6»5020) tl»t01»xS»xo
5020 formate ti: '»1?213,5> ' tOU SlP3l3,5f ' xSl ' >1P313,5»
IFdI.EQ. 20) GOTO 101 ! Kill the
GO TO 110
C
120 CONTINUE
C
DIF = XO - XG
sum = sbs(xo+xs)/2, + ERTDNF
IF(ABS(DIF)/sun> .LT, ERTDNF) GO TO 1000
if(pfla3) write(6»5040) tmim tmsxi tl»xo»xa
5040 formate tmin: '»1P313,5> ' tnaxJ '»lp3l3.5> ' ti:'»lpSl3.5»
4 — SYS$DEGADIS:TUPF.FOR 20-OCT-1987 OOMSJOO
-------
F-221
»' xaJ ' »1PS13.5)
C
IF( DIF*BIFATMAX .GT, 0.) THEN
TMAX = TL ! 3 new maximum for the range
DIFATMAX = IHF ! s new DIP for the maximum
ELSE
THIN = TL ! s new minimum for the range
ENDIF
C
100 TL = (TMAX + TMIN)/2,
C
The sbove sesrch scheme fsiled, Before Rilling the program? check to
see if the desired point falls on s transition from s blanket to s
non-blanket situation.
tl = TL-f.Ol
T2 = TL-,01
XG1 = AFBEN(RADGfTli'tupf )
X32 = AFGEN
dif = sbs(xgl-xa2)
if(dif.gt, 100, .AND, (XO.LE.XG2 .AND. XO.GE.XG1)> then
tdnf = t2 ! Jump from blanket to non-blanket occured
RETURN
ENDIF
c
c*** Kill the program.
c
101 if(pflag) write(6»4000) R«»SZM»EMAX.RMAXiTSCli ALEPHiTEND»alpha
4000 formate rm.* '»lpgl3,5» ' szm: 't Ip2l3,5> ' emaxJ 'ilpal3,5»/»
1 ' pmex:'flpal3.5»' tsci: '»lpal3.5i ' aleph:'
2 ' tendr'flpSlS.Si' alpha: Mp3l3.5)
if(pflsa) write(6?4010) ti»a::> train
4010 formate tmsx? 'jlpgl3.5»' tminJ '»lpai3,5)
CALL trap(7)
C
c*** successful completion
c
1000 TDNF = TL
RETURN
END
****
5 ~ SYS$DEGADIS:TUPF,FOR 20-OCT-1987 00:45:00
-------
F-222
C »
c
C FUNCTIONS ASSOCIATED WITH THE OBSERVER CALCULATIONS
C
C ,
c
C FUNCTION TO RETURN OBSERVER VELOCITY AS A FUNCTION OF TIME
C
FUNCTION UIT(TfTOl)
Implicit Re3l*8 ( A-H» 0-Z )» Inte<3er*4 ( I-N )
COMMON
$/PARMSC/RM»SZM»EMAX > RMAX»TSC1»ALEPH > TEND
$/ALP/ALPHAi3lPhaI
C
UIT = ALPHA1 * ALEPH**ALPHA1 *
-------
F-223
FUNCTION TOOB(XfT)
C
Implicit Resl*8 ( A-H» 0-Z )> Inte2er*4 ( I-N )
COMMON
$/PARNSC/RMiSZM» EMAX»RMAX,TSC1»ALEPH,TEND
*/ALP/ALPHA»3lph3l
C
ARG = 0,
CHECK = ABS((ABS(X)-ABS(R«AX)))/(ABS(X)fABS(RMAX))
IF(CHECK ,GT, 0,001) ARG = (X + RMAX)**(1,/ALPHAl)/ALEPH
TOOB = T - ARG
RETURN
END
SYS$DEGADIS:UIT,FOR 20-OCT-1987 OOM6:00
-------
G-3
Program ooms_in
c
c
c OOMS-IN is designed to perform two tasks including;
c
c a) Reed the input file for the OQMS/DEGADIS model input. From
c this information; OOMS_IN prepares the necessary file to run the
c QOMS model. The information necessary for DEGADIS is also included
c in the single input file to minimize the user effort reouired*
c
c b) Generate a command file to execute the OOMS/DEGADIS model from
C the input information. This portion is highly dependent on the
c VAX/VMS environment because of the manipulation of character strings
c and the commands necessary.
c
c
L.
c This program can be invoked interactively or in a command file
c submitted to batch. For either case? the syntax ist
c
c $ RUN SYS$DEGADISJOOMS_IN
c RUN-NAME
c
c where RUN_NAME is the file name given to the particular simulation,
c The input file RUN_NAME.IN is to be created before this program
c is invoked using free formats. The order of input is as follows!
c
c
C
C
C
r
C
C
C ••JND'.'EL:-
C -:;PAMB>
C
C
C
C <{?ASMW>
C
c --JETTEM;-
c :GASUL>
C aNDHT>
c
c •;ERATE>
c -:JETELE>
c
c
C
C
1 ~ sysfdeSedis.'ooms-in.for 16-NOV-1987 06:28511
-------
G-4
C Note thst for readability* blank, lines were inserted between the
c input sections specifying s simulation title? atmospheric conditions*
c slss properties* and the particular release conditions, Symbol
c definitions are as follows!
c * » * and are four lines of UP
c to SO characters each of s title for this simulation*
c
c (m/s) is the ambient wind velocity at (si).
c
c is the surface roughness (m).
c
c -»IHDVEL> is an indicator which determines the method of calculation
c for the ambient velocity profile in Doras' model ss follows!
c
c For using 1 for A* 2 for B* etc.) is used
c along with to determine the Monin-ObuKhov length
c J the log velocity profile is then determined
c using ,
c
c For =2» the Monin-Obukhov length is supplied
c by the user? the log velocity profile is then determined
c using .
c
c <7AMB>f » and are the ambient temperature (K)* the
c ambient pressure (atm or N/m#*2>* and the relative humidity (%)»
c respectively.
c
c is the surface temperature (K)J if < 250 K» is
c set to .
c
c \GASNAMx is s three-letter designation for the contasiinent's name.
c
c is the contaminant's molecular weight (Rg/kmole).
c
c is the averaging time (s). At present* this parameter is
c used to estimate the value of in DEGADIS.
c
c is the temperature of the Jet (K),
c
c- \GASUL> snd are the concentrations to be used for estimating
c contours for an upper and lower concentration level in
c DEGADIS. The calculations are made for the elevation
c . Note that the DEGADIS computations will be carried
c out to /2.
c
c is used to include heat transfer in the DEGADIS computations.
c Heat transfer is not included for =0. For =1>
c hest transfer is included* and the heat transfer coefficient
c is calculated by DEGADIS. and are used to
2 — sys$degedis:ooms_in.for 16-NOV-19S7 06!28tll
-------
G-5
c calculate the hest capacity in DEGADIS ss a function of
c temperature according to the correction included in
c DEGADIS. (If this function is used» the average gas
c temperature is used to estimate the mean (constant) heat
c capacity in Qoms' model.) If a constant heat capacity is
c desired? set \CPF:- to 1.0 and to the desired heat
c capacity ( J/k2 K) .
c
c is the initial
c Jet diameter (m) .
c
c is the duration of the release. For steady-state releases?
c set to O.f to run the Ooms model only? set
c to s negative number.
c
c is the starting value of Jet trajectory integration (m). -,'H>
c is the step size for Oonis' model (m). is the
c downwind distance to the first output value (a). is
c the distance between output points (m).
c
c » - end determine the orientation of the Jet with
c respect to the aitibient wind velocity ss follows:
c
c is for horizontal Jets directed upwind (-1) and
c downwind (-H)f =0 for other directions.
c
c is for vertical Jets directed upward (il) and
c downward (-l)J =0 for other directions.
c
c is for horizontal Jets directed to the left (-1) and
c to the right (-H)J =0 for other directions.
c
c Note thet only one of > > or can be nonzero
c at any time.
c
L
c T. Spice r
c University of Arkansas
c Department of Chemical Engineering
c Faaetteviller AR 72701
c
c (501) 575-4951
c
Implicit Realms ( A-H> 0-Z )> Inte^er*4 ( I-N )
C
real mwa? mw^» molen* Jettem> Jetele»Jetdia
C
3 ~ sys$de£3dis:ooins_in.for 16-NOV-1987 06:28:11
-------
G-6
icsl check4
c
chsrscter*80 TITLE(4)
C
chsrscter*3 sss.nsme
C
chsrscterfciOO OPNRUP
chsrscter QPNRUFK100)
eouivslence (opnrupl(l) »opnrup)
chsrscter*4 IN»erl>er2»er3»coni?sclf sr3* lis
chsrscter*4 dummy
ch3rscter*3 P!US» Sssnsra
ch3recter*2 con
DATA POUND/'// 'APOUNDN/-1 ,E-20/
C
DATA IN/'. IN '/jerl//.erl'/fer2/',er2//rer3/',er3'/
dets scl/'.scl'/fsrS/'.srS'/flis/'.lis'/
dst3 com/' .com'/
dsts Plus/' t V»con/' -V
C
C*** GET THE FILE NAME TO BE USED BY ALL OF THE ROUTINES
C
READ (5» 820) NCHARi opnrup
opnrup = opnrup<15nchsr) // in(lM)
C
C*** Now 2et the rest of the desired information from RUN_NA«E,IN
C
open ( uni t=S » n3me=opnrup » type= ' old ' )
resd<3f8000) titled)
resd(8>8000) title(2)
r83d(8»8000) title(3)
resd(8»3000) title(4)
SOOO fori»3t(530)
8010 fors.st(s3)
resd(8>*) uO> zO
resd(8»*) rr
indvel> istsb» molen
if( indvel.ne.l .or. indvel»ne.2) indvel = 1
if( istsb.le.O ,or, istsb.at.d) istab = 4
if(indvel .ea» 1) then
if (istsb.ea.l) then
molen = -11.43 * zr**0.103
else if (ist3b.ea.2) then
molen = -25.98 * zr**0,171
else if (istsb.ea.3) then
molen = -123.4 * zr**0.304
else if (istsb.ecif4) then
molen = 0.0
else if (istsb.eo.5) then
4 — sys$de23dis:ooras_in,for 16-NOV-1987 06528:11
-------
G-7
Mien = 123,4 * zr**0,304
else if (istsb.eo.6) then
HiOlen = 25,98 * zr**0.171
endif
end if
vkcon = 0,35
ustsr = uO*vkcon/(dlo2((zOizr)/zr) - psif (zO>molen))
resd<8>*) tsmb» psrab» relhum
iff tsmb.le.O, ) tsmb = tsn.bi273.15DO
if( psrob.sst.l.l ) psmb = Psmb/101325.DO
if( relhum. It ,0, ,or. relhum. 2t. 100. ) relhun = 50,
resd(Sf*) tsurf
if( tsurf, It. 250. ) tsurf = tsrab
Sssnsm
svtiro
reed(8i*) Jettem
resd(8f*) Sssul* 3ssllr zll
if( Sesll.le.O, ) Sssll = 0.01
l.ODO)
) indht» CPC» CPP
resd(8?*> erste
resd(8»*) Jetele» Jetdis
re3d(3>*) tend
chsck4 = .true.'
if (tend ,s!t. 0.) check4 = .fslse,
resd(8»#) ;:0» h» dist3» distsn
resd(3>*) kl> k2» k3
if( kl.eo.O ,snd« k2,eo.O .snd. k3.ea.O ) then
k2 = +1 ! vertical upward
else if( kl.ne.O ) then
k2 = 0
k3 = 0
else if( k2,ne,0 ) then
kl = 0
k3 = 0
else if( k3»ne,0 ) then
kl = 0
k2 = 0
endif
It is time to prepsre the input file for the OQMS model.
opnrup = opnrupfltnchsr) // ',ino'
open(unit=l»n3ae=opnrup>type=/new' )
5 -- sas$de3sdis:oo»s_in.for 16-NOV-1987 06:28211
-------
G-i
write(l»*) '
write(lj603) title ts» ur» zO» Jetele
ust = ustsr
wnte ust» zr? moleru istsb
rows = 2S.96DO
CPB = 1006,3
if( cf-f .eo. 1.) then
CP^ = CPC
else
tinesn = (tsiBb+Jettea)/2.
c?2 = (3.33D4 t cpc*(truesn**cpp - JetteiB#*cpp)/
. (tmesn - Jettem)
endif
write(l»601) mwsj mw2» CPS?
rhoe = p3i»b*101325.DO*33smw/8314.nO/JeUea
disJet = Jetdis*100.DO
ainit = erste/rhoe
write(l?604) disJetj oinit
dc = 1000,
sloe = 0,
bloc = dc - Jetsle
write(l?£06) dc? sloe? bloc
write(1..609)
slfsl = 0.057
3lf32 = 0,5
alfs3 = 1.0
write(lj610) slfal> slfs2» slfs3
600 form3t(4(5::r flO.3))
601 format (5 (5x» flO.3))
603 fornist(s80)
604 format (5;j» f!0.3» 5;;» elO,3» 5x> flO.3)
606 fop«i3t(3(5x» flO.3))
609 formst(3(5x» 110))
610 forB3t(3(5x» flO,3)» 5:;» flO.4)
611 foririst(5x» f!0.3» 2(5x» e!0.4)> 5x» ilO)
close(unit=l )
6 — 5ys$de^3dis:ooms_in.for 1&-NOV-1987 06:28'.ll
-------
G-9
c
c*** Now» prepare the command file
c
C
C*** FORMATS
C
320 FORKAT(Q»A40)
r*
c
1210 format (34)
opnrup = opnrupd Jnchsr) // comdJ4)
c
open ( uni t=S r nsiBe=opnrup » tape= ' new ' »
$ csrri3£econtrol='list' » recordtype='vsri3ble')
c
cm Lines to stsrt the Ooms model and invoke DEGBRIBGE
c
opnrup = opnrupd Jnchsr) // ',ino forOOl'
write(3»1100) (of=-nnjpl(i)>i = lrnchsr-Hl)
1100 forastCf assign '»51sl)
opnrup = opnrupdJnchsr) // 'tout for003'
write(3»1100) (opnrupl(i) >i=l»nchsr+ll)
opnrup = opnrupd Jnchsr) // '.ind for002'
write(8»1100) (opnrupl(i) »i=l»nch3r-Hl)
write(S»1160)
1160 formst('$ run sysfdeSsdisJooms')
write(3>1170)
1170 fornist('$ desssi^n forOOl'f/j '$ deessiSn for002'»/»
for003')
if (tend .It, 0.) goto 3000
write(3»HSO)
1180 formstCJ run sysSdegsdi
write(S»1290) (opnrupl(i)»i=l»nchsr)
c
C
c
c
opnrup = opnrupd Jnchsr) // erl(U4)
c
write(8»1250) (opnrupl(i) »i=l»nchsrf4)
1250 forrostCS copy/lo3 SYS$DEGADISJexsniPle,erl
IF(uO .eo. 0.) then
urite(3»12SO)
write(S»1290) (opnrupl(i)ri=l» nchsr)
goto 1340
end if
opnrup = opnrupd Jnchsr) // er2(U4)
write(8>1260)
7 — sys$degsdisJooms_in.for 16-NOV-1987 06J28J11
-------
G-10
1260 formstCf copy/lo2 SYSIDEGADIS: example. er2 '»40al)
opnrup = opnrup1290) (opnrupl (i) » i=l jnchsr)
1290 formst(40sl)
write(8»1300)
1300 forrostCS run SYS*DEOADIS:DEGADIS2')
write(3>1290) (opnrupl(i)»i=l»nch3r)
write(8»1320)
1320 formstCf run SYS$DEGADIS:DEGADIS3')
write(8»1290) (opnrupl(i) »i=l »nchsr)
c
else
write(Srl2SO)
w rite (B» 1290) (oFnrupl(i) ? i=l»nch3r)
c
write<8»1330)
1330 for«st<'$ run SYS$DEGADISJSDEGADIS2' )
write(S»1290) (opnrupl(i) r i=l»nchsr)
c
endif
opnrup = opnrupdJnchsr) // '.out' //
plusdJS) //opnrupdJnchsr) // scl(lM) //
plus(l!3) // opnrupdtnchsr) // sr3(lM) // con(i:2)
write(8>1370) (opnrupl(i) »i=l»3*nchsr+20)
1370 formst( '$ copy/lo<* SlOOal)
opnrup = opnrupd Jnchar) // lis(lM)
write(8>1390) (opnrupl(i) >i=ljnch3r+4)
1390 formate 'i40sl)
c
1340 close2100)
2100 fori»st(/>' ?OOMS_IN? command file failed to stsrt.')
c
CALL EXIT
END
ft**
S — sys$de2sdis:ooms_in.for 16-NOV-1987 06:28:11
-------
G-ll
Program DEGBRIDGE
c
c
c...»....«. ». i .................................
c
c
c DEGBRIDGE is designed resd the input file for the
c OOMS/DEGADIS model input. From this information and the
c output from Coins' modelt DEGBRIDGE prepares the necessary
c file to run DEGADIS
c
c where is the distance to the centerline touchdown (m)?
c is the centerline concentration f
c is the centerline temperature (K) at > and
c is the value of Ooms' b (m) at ,
c
c To establish the initial conditions for DEGADIS* the source
c concentration is assumed to be > and the source
c rsdius is sctrt(2.)# which is consistent with Ooms'
c development.
c
c
c T. Spicer
c University of Arkansas
c Department of Chemical Engineering
c Fasetteville; AR 72701
c
c (501) 575-4951
c
Implicit ReaUS ( A-Hj 0-Z )> Inte2er*4 ( I-N )
include 'sys$de2adis:DEGADISIN.dec'
COHHON
$/TITL/ TITLE
f/GENl/ PTIME(i2en)» ET(i3en)> RlT(i3en)> PUC(i^en)> PTE«P(i<2en)
$ PFRACV(i^en)» PENTH(i3en)» PRHO(i<3en)
f/GEN2/ DEN(5>i2en)
$/ITI/ T1»TINP»TSRC»TOBS»TSRT
f/P ARM/ UO > ZO j ZR » ML » USTAR » K > G t RHOE F RHOA > DEL TA » BETA » GAMMAF » CcLOW
_2p TOP/ 2as_mw > 3as_temp > 2as_ rhoe > Sas.cpk 1 3ss_cpp »
1 -- SYSfDEGADISJDEGBRIDGE.FOR 16-NOV-1987 06:21126
-------
G-12
$
$/com_ss/ e= = rsleruSHid>outcc>outsz»outb»osi2;:_niin_dist»si2;-
$/NEND/ POUNDN?POUND
C
P
w
resl mwsT mw^j molen? Jettem»Jetele>Jetdis
C
REALMS MLiK
LOGICAL CHECK1,CHECK2»AGAIN,CHECKS>CHECK4»CHECKS
c
ch£rscter*80 TITLEC4)
chsrscter*3 dss-nsme
cJisrecter*4 Found
chspscter*24 TSRCiTINPfTOBSiTSRT
r
w
chsrscter*100 OF'NRUP
chsrscter OPNRUPK100)
eauivelence (opnrupl (1)
chsrscter*4
ch£rc-cter#4 du-iima
chsr=cter*3 plus?
ch£P5cter*2 con
Wii,w/13,02DO/
dsts WB.3/28.96DO/
DATA POUND/'// '/jPOUNON/-l.B-2Q/
DATA IN/',IN '/iepl/'.epl'/iep2/'.ep2'/iep3/'.er3'/
dets com/'.com'/
dsts plus/' f 'Aeon/' -V
GET THE FILE NAME
r
urite(6»*> 'Be3innin2 DEGBRIDGE'
READ(5fS20) NCHARfOpnrup
opnrup = opnrupdJnchsr) // in(U4)
C
C*:** Now *et the rest of the desired information from RUN_NAME.IN
C
operi(unit=8>nsnie=oprirup» type='old')
resd(8»SOOO> titled)
re3d(8>8000) title(2)
re3d(8»8000) title(3)
resd(8»8000) title(4)
8000 format(sSO)
8010 formst(s3)
2 ~ SYS$DEGADIS:DEGBRIBGE,FOR i6-Nov-i?87 06:21:26
-------
G-13
resd(S»*) uO> zO
resd(8»*) rr
read(S»*) indvelj istsb? roolen
if( indvel.ne.l .or, indvel.ne.2) indvel = 1
if( istsb.le.O ,or. isteb.at.d) istsb = 4
if (indvel ,ea, 1) then
if (istsb. ea.l) then
roolen = -11,43 * sr**0,103
else if (istsb, ea, 2) then
molen = -25.98 * zr**Q.171
else if (istsb. ea. 3) then
molen = -123.4 * ;r**0,3G4
else if (istsb, eo»4) then
molen =0,0
else if (istsb. ea. 5) then
molen = 123,4 * :r**0,304
else if (istsb. ea. 6) then
molen = 25,93 * nr**0,171
endif
endi f
vkcor; = 0,35
•jsUr = uO*v!',ecn/(a'lo2<(z(ttzr)/zr) - psif (z
resd(3f*) tsab? pembf relhuro
if( U-ir,b,le,0. ) tsmb = tsinb+273,15DO
if( F-srib.3t,l.l ) P3reb = psnib/ 101325, DO
if( relhunult.O. ,or, relhum.^t.lOO, ) relhum = 50,
vspor? = 6,029Se-3* exp<5407** (1, 7273, 15- 1,/tsmb)) ! 3tm
set = 0,622*vsporp / (psmb- VSPOTP)
humid = relhuin/100. * sst
re£d(S?#) tsurf
if( tsurf, It, 250, ) tsurf = tsmb
resd<8>8010) Sssnsm
resd(S>#) sesmw
svtim
Jettem
resd(S«*) Sssul; Sssllf zll
:f( ^3sll,le,0. ) sssll = 0,01
if( sssul.le.assll ) gssul = dmsxK l,lDO*3ssll» l.ODO)
resd(8»*) indht* CPCI CPP
if (indht.ne.O ,or, indht.ne.l .or, indht,ne,2) indht=l
if (CPP .ecu l.DO) CPC = cpcKdssmw - 3.33D4
) erste
resd(8j*) Jetele? Jetdis
resd(8»*) tend
3 ~ SYS$DEGADIS:DEGBRIDGE.FOR i6-wov-i987 06:21:26
-------
G-14
check4 = .true.
if(tend ,2t, 0.) check4 = .false.
resd(3.'#) ;:0> h> dists? distsn
resd(8j*) kl» k2» k3
if( kl.ea.O .snd. K2.eo.O .snd. K3.en.O ) then
k2 = tl ! verticsl upward
else if( kl.ne.O ) then
K2 = 0
k3 = 0
else if( k2.ne.O ) then
hi = 0
k3 = 0
else if( k3.ne,0 ) then
kl = 0
K2 = 0
end if
c
elo£etape='old')
resd(3i#) odist» ocon> otenip» ob
close(unit=8)
yc = ocon*8314.DO*otemp/101325.DO/p3mb/rfssmw
ys = (I,ri0-yc)/(l.n0-fhuinid*w»3/wiiiw)
yw = l»DO-yc-ya
u% = yc#3ss(iiw t y3*unis f yw*wmw
we = sissmw/wm * yc
rho = 101325,DO*Psnib*w!t./8314,DO/otemp
c
c*** It is time to prepare the input file for DEGADIS
c
opnrup = opnrijp( 1 tnchsr) // '.inp'
OPEN(UNIT=8 > NAME=OPNRUP>TYPE='NEW',
$ C3rrisgecontrol='list'» recordtype='varisble')
C
DO 100 1=1t4
100 U6ITE(8*1135) TITLE(I)
C
c*** Atmospheric parameters:
c
URITE(8»1020) UO»ZO»ZR
WRITE<8>1040) istab
C
2oto(161»162»163»164»165>166> istab
161 delta = 0.224 ! A
beta = 0.894
4 ~ SYS$DEGADIS:DEGBRIDGE.FOR 16-NOV-1987 06:21:26
-------
G-15
si3;;_coeff = 0.02
si2;:_pow = 1.22
£i3:;_niin_dist = 130.
Sotc 170
162 delta = 0.164 ! B
bets = 0.894
j::2x_coeff = 0.02
si2x_?ow = 1.22
£i£!.x_iiin_dist = 130.
£cto 170
163 delts = 0.109 ! C
bets = 0.394
si2x_coeff = 0.02
si2;:_pow = 1.22
si£i;;_min_dist = 130.
goto 170
164 delte = 0.071 ! D
bets = 0.894
sigx_coeff =0.04
si3;;_pow = 1.14
si«J;:_inin_dist = 100.
2oto 170
165 delts = 0,053 ! E
bets = O.S94
sig>:_coeff = 0.17
si£x_pow =0.97
sii!;-:_min_dist = 50.
goto 170
166 delts = 0.036 ! F
bets = O.S94
si2x_coeff =0.17
si2;:_FGW = 0,97
sis!x_niin_dist = 50.
170 continue
ml = molen
URITE(8il020) DELTA » BETA? ml
WRITE(8»1020)
c
c*** smbient pressure^ temperatures? and humidity
c
write<8»1025) tsnib»psrob>huniid
c
isofl = 0
ihtfl = indht
htco = 0.
iwtfl = 0
wtco = 0.
c
5 -- SYS$DEGADIS:DEGBRIDGE.FOR id-Nov-1987 06:21:26
-------
G-16
write(8f 1060) isofl»tsurf
write(8>1060) ihtfl»htco
write(S>10£0) iwtflrwtco
£ss chsrscteristics
write<8>1415)
E'iS-mw - sissmw
23S_ten;p = Jetten
= 101325. nO*P3n.b/8314,DO*23sinw/Jettein
1010) CcLOW
c
c
source description FOR A DILUTED SOURCE ...
2ffisssO = 0. ! no initisl cloud rosss
wriie(Sf!020) ^msssO
HP = 4
if(checM) tend = 6023, ! C=3 sec
ess = erste
rlss = 1.414213 * ob ! snrt(2, >*ob
FWC(l) = WC
ptenip ( 1 ) = otemp
pfrscv(l) = 1.0
PTIME(l) = 0.
et(l) = ess
rlt(l)= rlss
FUC(1)= pwc(l)
PTEMP(1)= Ptenp(l)
PFRACV(1)= l.ODO
PTIMEC2) = tend
et(2) = ess
rlt<2)= rlss
PWC(2)= pwc(l)
SYS*DE6ADISJDE6BRID6E,FOR 16-NOV-1987 06:21526
-------
G-17
PTEMP(2)=pte»p(l)
PFRACV<2)= l.ODO
PTIMEC3) = tend •{• 1.
et(3) = 0,
rlt(3)= 0.
PWC(3)= pwc(l)
PTEhP(3)=pte»p(l)
PFRAC'v>(3) = l.ODO
PTIMEC4) = tend t 2,
et(4) = 0.
rit(4)= 0.
PWCC4)= pwc(l)
P7EMP(4}=pte»pcheck3?check4>checks
C
istst = Iib*d3te_tinie(tinp)
write(8>1070) tinp
c
if(check4) write<8»1020) essislenrswid ! stesdy state
c
C
CLOSE(UNIT=8)
C
P
u
C*** FORMATS
C
820 FORHAT(Q>A40)
c
1010 formst(l;:>lp^l4.7)
1020 for»3t(3(lx»lPSl4.7»
1025 formst(5(lxrlP5l4.7))
1030 fori»st(lxf5(lp2l4.7»l;;)»lP3l4.7)
1040 formstdxflS)
1050 formst(s24)
1060 formst(l>:»i4»lx»lpsl4.7)
1070 form3t(s24)
c
1134 FORMAT(A80)
1135 FORMAT(ASO)
c
c
c
1415 formst(33)
7 —
SYS$DEGADIS:DEGBRIDGE.FOR i6-Nov-i?87 06:21:26
-------
H-l
APPENDIX H
PARTIAL LISTING OF PROGRAM VARIABLES
Variable
AGAIN
ALEPH
ALPHA
ALPHA1
BETA
CCLOW
CHECK1
CHECK2
CHECK3
CHECK4
CHECKS
DELTA
DEN(l.I)
DEN(2,I)
Data Type
LOGICAL
REAL
-REAL
REAL
REAL
REAL
LOGICAL
LOGICAL
LOGICAL
LOGICAL
LOGICAL
REAL
REAL
REAL
Symbol
a
(1.0 + a)
Units Comments
Local communications
in SSSUP
Collection of constants
to calculate observer
position and velocity
n/a
n/a
n/a
kg/m-
m
1-/9
Power law velocity
profile power
Lateral similarity
power
Lowest mixture concen-
tration of interest
Unused logical flag
When true, release
type without a
liquid source
Local communications
flag used in DEGADIS1
When true, steady-
state simulation
When true, user sets
time-sort parameters
Lateral similarity
coefficient
mole Contaminant mole
fraction fraction
kg/m Contaminant concentra-
tion for the given mole
fraction
-------
Variable
DEN(3,I)
DEN(4,I)
DEN(5,I)
EMAX
ESS
ET(I)
GAMMAF
GAS_CPK
GAS_CPP
GAS_LFL
GAS_MW
GAS_NAME
GAS_RHOE
GAS_TEMP
GAS UFL
Data Type
REAL
REAL
REAL
REAL
REAL
REAL
REAL
REAL
REAL
REAL
REAL
REAL
CHARACTER*3
REAL
REAL
REAL
Symbol Units
p kg/m3
h J/kg
T K
kg/s
E kg/s
E(t) kg/s
g
m/s^
n/a
F
q, J/kmol K
Pi n/a
mole
fraction
MWr
kg/kmol
kg/nr
K
mole
fraction
Comments
Mixture density for
the given mole fraction
Mixture enthalpy for the
given mole fraction
Mixture temperature for
the given mole fraction
Maximum of secondary
source mass evolution
rate
Steady-state release
rate
Source mass evolution
rate as a function of
time PTIME(I)
Acceleration due to
gravity
Constant for contaminant
heat capacity
Power for contaminant
heat capacity
Lower contaminant con-
centration level for
estimating contours
Contaminant molecular
weight
Name of contaminant
Saturated vapor density
of contaminant at TQ
Contaminant storage
temperature
Upper contaminant con-
centration level for
estimating contours
-------
H-3
Variable
GAS_ZSP
GMASSO
HTCO
HUMID
IHTFL
ISOFL
I STAB
IWTFL
K
LUNLOG
MAXNOB
ML
NOBS
Data Type
REAL
REAL
REAL
Symbol
REAL
INTEGER
INTEGER
INTEGER
INTEGER
REAL
INTEGER
INTEGER
REAL
INTEGER
V;
H
Units
m
J/m2sK
m/s
kg water/
kg dry air
Comments
Height for estimating
contours
Initial mass of gas over
the primary source
Constant coefficient
when IHTFL=-1
LLNL heat transfer
velocity when IHTFL=2
Ambient absolute
humidity
Heat transfer flag:
IHTFL=-1 constant coefficient
IHTFL=0 no heat transfer
IHTFL=1 DEGADIS correlation
IHTFL-2 LLNL correlation
Isothermal release when
ISOFL-1
Pasquill atmospheric
stability indicator
(ISTAB-1 for A,
(ISTAB-2 for B, etc.)
Water transfer flag
IWTFL=-1 constant coefficient
IWTFL=0 no water transfer
IWTFL=1 DEGADIS correlation
n/a von Karman's constant,
0.35
Fortran logical unit
number which acts as a
simulation log
Maximum number of
observers
m Monin-Obukhov length
Number of observers for
the pseudosteady-state
simulation
-------
H-4
Variable
NREC(I,1)
NREC(I,2)
PAMB
POUND
Data Type Symbol
INTEGER
INTEGER
REAL p
CHARACTER*4
Units Comments
Number of records
generated in PSSOUT for
observer I
Number of records
generated in SSGOUT for
observer I
atm Ambient pressure
Character string to
signal end of data
POUNDN
QSTR(l.I)
QSTR(2,I)
RADG(1,I)
RADG(2,I)
RELHUMID
RHOA
RM
RMAX
RT2
R1SS
REAL
REAL
REAL
REAL
REAL
REAL
REAL
REAL
REAL
REAL
REAL
Q*
nax
72.
2
kg/m s
m
%
kg/nr
m
m
n/a
m
Numerical value to
signal end of data
(-1.E-20)
Independent variable
time for ordered
pairs QSTR
Atmospheric takeup rate
as a function of time
Independent variable
time for ordered pairs
RADG
Secondary source radius
as a function of time
Ambient relative
humidity
Ambient air density
Radius at EMAX (when
secondary source mass
evolution rate is a
maximum)
Maximum secondary
source radius
Constant
Steady-state primary
source radius
-------
H-5
Variable Data Tvpe
R1T(I) REAL
SIGX_COEFF REAL
SIG_MIN_DIST REAL
SIGX_POW REAL
SLEN REAL
SQPI02 REAL
SQRTPI REAL
SRCDEN(1,I) REAL
SRCDEN(2,I) REAL
SRCENTH(1,I) REAL
SRCENTH(2,I) REAL
SRCWA(l.I)
SRCWA(2,I)
SRCWC(l.I)
REAL
REAL
REAL
Symbol Units Comments
RP m Primary source radius
as a function of time
PTIME(I)
Along-wind similarity
coefficient
m Minimum distance to
apply x-direction
dispersion correction
n/a Along-wind similarity
power
L m Steady-state source
length
yir/2". n/a Constant
Jn n/a Constant
t s Independent variable
time for ordered
pairs SRCDEN
o
p kg/m Secondary source
density as a function
of time
t s Independent variable
time for ordered
pairs SRCENTH
h J/kg Secondary source
enthalpy as a function
of time
t s Independent variable
time for ordered
pairs SRCWA
wa mass Secondary source air
fraction mass fraction as a
function of time
t s Independent variable
time for ordered
pairs SRCWC
-------
H-6
Variable
SRCWC(2,I)
SWID
SZM
WTCO
XV(I)
Data Type Symbol
REAL
Units
Comments
w.
REAL
REAL
'zOm
REAL
REAL
mass Secondary source
fraction contaminant mass
fraction as a function
of time
m
m
TAMB
TEND
TINP
TITLE(1:4)
TO(I)
TSURF
US TAR
UO
REAL T
REAL
CHARACTER*24
CHARACTER*80
REAL
REAL Ts
REAL u*
REAL uQ
K
s
s
K
m/s
m/s
kg/m^s
m
zo
ZR
REAL
REAL
20
ZR
m
m
Steady-state source
half-width
Value of SzQ at EMAX
(when secondary source
mass evolution rate is
a maximum)
Ambient temperature
Termination time of
secondary source
Time DEGADISIN was
executed
Text title block 4
lines of 80 spaces
Time of release for
observer I
Surface temperature
Friction velocity
Ambient velocity at
height ZQ
Mass transfer
coefficient when
IWTFL—1
Virtual source
position for estimation
of S in SSG
Height for velocity UQ
Roughness length
-------
1-1
APPENDIX I
DEGADIS DIAGNOSTIC MESSAGES
To assist the user in determining the source of any problems, a
diagnostic procedure has been included in DEGADIS. The subroutine TRAP
is meant to cause an orderly termination of the program for many
detected errors. It performs two basic functions: TRAP displays an
error code and a single line diagnostic message giving the reason for
premature termination, and TRAP forces an output of the COMMON area data
sets to the file TRAP.DBG.
The first three lines sent to the execution log (default-TERMINAL)
include the TRAP introductory lines and the error code number:
The best laid plans of mice and men . . .
You have entered a TRAP--THE LAND OF NO RETURN
CODE: NN
where NN represents the code of the error message which follows in the
log. The error message begins with the name of the calling routine.
The following is a list of the error codes, error messages, and
suggested actions for each problem.
Code: 1
DEGADIS1? Source integration has returned IHLF-NN
Action: This error occurs during integration of the equations which
describe the gas source. IHLF is an error code returned by the
integration package RKGST.
When IHLF-11, more than 10 bisections of the initial increment of
the independent variable were necessary to make an integration step
within the specified error. Reduce the initial step size of the
independent variable (STPIN in the ER1 file). If this does not work, it
will be necessary to either increase the error criteria for all of the
dependent variables being integrated (ERBND in the ER1 file) or increase
the error criteria for the variable violating the criteria by decreasing
the error weight for that variable (one of the following: WTRG, WTTM,
WTYA, WTYC, WTEB, WTMB, or WTUH in the ER1 file).
When IHLF=12, the initial increment of the independent variable
(STPIN) is 0. Correct the ER1 file and execute the program again.
-------
1-2
When IHLF-13, the initial increment of the independent variable
(STPIN) is not the same sign as the difference between the upper bound
of the interval and the lower bound of the interval. STPIN must be
positive. Correct the ER1 file and execute the program again.
Code: 2
Reserved
Code: 3
SZF? Local integration failed; IHLF-NN
Action: This error occurs during estimation of SZ over the source when
no gas is present. IHLF is an error code returned by the integration
package RKGST.
When IHLF=11, more than 10 bisections of the initial increment of
the independent variable were necessary to make an integration step
within the specified error. Reduce the initial step size of the
independent variable (SZSTPO in the ER1 file). If this does not work,
increase the error criteria for all of the dependent variables being
integrated (SZERR in the ER1 file).
When IHLF=12, the initial increment of the independent variable
(SZSTPO) is 0. Correct the ER1 file and execute the program again.
When IHLF-13, the initial increment of the independent variable
(SZSTPO) is not the same sign as the difference between the upper bound
of the interval and the lower bound of the interval. SZSTPO must be
positive. Correct the ER1 file and execute the program again.
Code: 4
SURFACE? Negative QRTE for positive DELTAJT.
Action: This is a diagnostic message indicating an error in estimation
of the heat capacity. Check the input to the model and execute the
program again.
Code: 5
CRFG? More points for GEN3 were needed.
Action: The COMMON area /GEN3/ stores representative values of the
calculated source parameters. If this message occurs, relax the CRFG
error criteria (CRFGER) in the ER1 file. If this is a common problem,
the length of the /GEN3/ vectors can be increased by changing the value
of MAXL in DEGADIS1.DEC and reinstalling DEGADIS.
-------
1-3
Code: 6
TUPF? Observer calculations--TUPF failed
Action: The trial-and-error search associated with finding the upwind
edge of the gas source for an observer failed. Often this problem can
be avoided by adding one or two additional observers to the present
number of observers (which changes the conditions for the trial and
error). Another possibility is to increase the error criteria for this
function (ERTUPF) in the ER2 file.
Code: 7
TDNF? Observer calculations--TDNF failed
Action: The trial-and-error search associated with finding the downwind
edge of the gas source for an observer failed. Often this problem can
be solved by adding one or two additional observers to the present
number of observers (which changes the conditions for the trial and
error). Another possibility is to increase the error criteria for this
function (ERTDNF) in the ER2 file.
Code: 8
SSSUP? Observer Integration failed, IHLF=NN
Action: This error occurs during integration of the five differential
equations which average the source for each observer. IHLF is an error
code returned by the integration package RKGST.
When IHLF-11, more than 10 bisections of the initial increment of
the independent variable were necessary to make an integration step
within the specified error. Reduce the initial step size of the
independent variable (STPO in the ER2 file). If this does not work, it
will be necessary to either increase the error criteria for all of the
dependent variables being integrated (ERRO in the ER2 file) or increase
the error criteria for the variables violating the criteria by
decreasing the error weight for that variable (one of the following:
WTAIO, WTQOO, or WTSZO in the ER2 file).
When IHLF=12, the initial increment of the independent variable
(STPO) is 0. Correct the ER2 file and execute the program again.
When IHLF=13, the initial increment of the independent variable
(STPO) is not the same sign as the difference between the upper bound of
the interval and the lower bound of the interval. STPO must be
positive. Correct the ER2 file and execute the program again.
-------
1-4
Code: 9
SSSUP/SDEGADIS2? Pseudosteady Integration failed, IHLF=NN
Action: This error occurs during integration of the four differential
equations describing the portion of the downwind calculation when b > 0.
The routine calling TRAP is SSSUP if a transient simulation is being
executed; if a steady-state simulation is being executed, the calling
routine is SDEGADIS2. IHLF is an error code returned by the integration
package RKGST.
When IHLF=11, more than 10 bisections of the initial increment of
the independent variable were necessary to make an integration step
within the specified error. Reduce the initial step size of the
independent variable (STPP in the ER2 file). If this does not work, it
will be necessary to either increase the error criteria for all of the
dependent variables being integrated (ERRP in the ER2 file) or increase
the error criteria for the variable violating the criteria by decreasing
the error weight for that variable (one of the following: WTSZP, WTSYP,
WTBEP, or WTDH in the ER2 file).
When IHLF=12, the initial increment of the independent variable
(STPP) is 0. Correct the ER2 file and execute the program again.
When IHLF=13, the initial increment of the independent variable
(STPP) is not the same sign as the difference between the upper bound of
the interval and the lower bound of the interval. STPP must be
positive. Correct the ER2 file and execute the program again.
Code: 10
SSSUP/SDEGADIS2? Gaussian Integration fail, IHLF=nn
Action: This error occurs during integration of the differential
equations describing the portion of the downwind calculation when b=0.
The routine calling TRAP is SSSUP if a transient simulation is being
executed; if a steady-state simulation is being executed, the calling
routine is SDEGADIS2. IHLF is an error code returned by the integration
package RKGST.
When IHLF—11, more than 10 bisections of the initial increment of
the independent variable were necessary to make an integration step
within the specified error. Reduce the initial step size of the
independent variable. (STPG in the ER2 file). If this does not work,
it will be necessary to either increase the error criteria for all of
the dependent variables being integrated (ERRG in the ER2 file) or
increase the error criteria for the variable violating the criteria by
decreasing the error weight for that variable (either WTRUH or WTDHG in
the ER2 file).
When IHLF—12, the initial increment of the independent variable
(STPG) is 0. Correct the ER2 file and execute the program again.
When IHLF-13, the initial increment of the dependent variable (STPG)
is not the same sign as the difference between the upper bound of the
interval and the lower bound of the interval. STPG must be positive.
Correct the ER2 file, and execute the program again.
-------
1-5
Code: 11
SSSUP/SDEGADIS2 Total No. of Records exceeds 120,000
Action: This is an arbitrary stopping point for the process in order to
keep a runaway simulation from filling up disk space. Relax the output
specification (ODLP, ODLLP, ODLG, or, DLLG) in the ER2 file in order to
generate less output if the input parameters are valid.
Code: 12
Reserved
Code: 13
Reserved
Code: 14
Reserved
Code: 15
Reserved
Code: 16
PSSOUT/PSSOUTSS? PSS started with B < 0.
Action: This condition is checked at the beginning of the downwind
calculation in order to confirm proper handling of the movement to the
Gaussian phase of the downwind calculation. Check the initial
conditions and execute the program again.
Code: 17
TPROP/ADDHEAT? Enthalpy out of bounds
Action: Diagnostic message indicating that an enthalpy lower than the
adiabatic mixing enthalpy was passed to ADDHEAT. Check the input
conditions and execute the program again.
-------
1-6
Code: 18
ALPH? ALPHA integration failed, IHLF-NN
Action: The integration which determines the integral least squares fit
for ALPHA has failed. Note that small values of the Monin-Obukhov
length ( ML < 0(lm) ) in combination with stable atmospheric conditions
may cause this failure. IHLF is an error code returned by the
integration package RKGST.
When IHLF-11, more than 10 bisections of the initial increment of
the independent variable were necessary to make an integration step
within the specified error. Reduce the absolute value of the initial
step size of the independent variable (STPINZ in the ER1 file). If this
does not work, it will be necessary to increase the error criteria
(ERBNDZ in the ER1 file).
When IHLF-12, the initial increment of the independent variable
(STPINZ) is 0. Correct the ER1 file and execute the program again.
When IHLF-13, the initial increment of the independent variable
(STPINZ) is not the same sign as the difference between the upper bound
of the interval and the lower bound of the interval. STPINZ must be
negative. Correct the ER1 file and execute the program again. This
error will also occur if the surface roughness ZR is greater than the
reference height ZO.
Code: 19
ALPH? RTMI has failed to locate ALPHA IERR:NN
Action: The search procedure which determines ALPHA has failed. This
error may be the result of an unusual velocity specification such as
small values of the Monin-Obukhov length ( ML < 0(1.m) ) or small
reference heights ( ZO < 0(10. * ML) ). IERR is an error code returned
by the routine RTMI.
When IERR-1, the search for ALPHA failed after a specified number of
iterations. Increase the error bound used by RTMI (EPS in the ER1
file) .
When IERR=2, the basic assumption that the function which governs
the search for ALPHA changes sign over the specified interval is false.
Increase the search interval by decreasing the lower bound of ALPHA (XLI
in the ER1 file) and increasing the upper bound (XRI in the ER1 file).
Code: 20
ESTRT? Premature EOF in RUN_NAME.ER1 or RUN_NAME.ER2
Action: The portion of the program which reads ER1 and ER2 files
encountered an end-of-file mark before all of the information had been
read. Confirm these files and execute the program again. If necessary,
copy and edit the appropriate EXAMPLE file and execute the program
again.
-------
1-7
Code: 21
ESTRT1/ESTRT2/ESTRT2SS/ESTRT3? DECODE failed.
Action: The portion of the program which reads the ER1, ER2, or the ER3
file failed to understand a numerical entry. The numbers must appear in
columns 11-20 of the line with no alphabetic characters in the field.
(Note that exponential notation is not allowed.) This restriction does
not apply to comment lines which have an exclamation point (!) in the
first column.
Code: 22
ESTRT1? The parameter file RUN_NAME.ER1 was not found.
Action: The ER1 file was not found for the current simulation
(RUN_NAME). Copy the file EXAMPLE.ER1 to RUN_NAME.ERl and edit it as
necessary. Execute the program again.
Code: 23
SORTS1? Fewer than 3 points sorted for any time.
Action: Only one or two simulation points were applicable for the sort
times specified. There are three possible causes for this condition:
(1) if this message appears when the sort times are defaulted
(CHECKS is set to 0. in the ER3 file), the number of observers will
probably have to be increased to give a good resolution of the downwind
concentration field. (The number of observers is NOBS in the ER2 file
with a maximum (MAXNOB) given in DEGADIS2.DEC.). As a rule of thumb,
one gets good resolution of the downwind concentration field if the
ratio: (secondary source duration / number of observers) is less than
about 10 seconds (or 20 at most).
(2) The sort times specified in the ER3 file were before the
simulation had developed significantly. This is only applicable when
the user is specifying the sort times (i.e. when CHECKS is set to 1. in
the ER3 file). Increase the time of the first sort (ERT1), and rerun
the program.
(3) The sort times specified in the ER3 file were after the gas was
below the lowest concentration of interest. This is only applicable
when the user is specifying the sort times (i.e. when CHECKS is set to
1. in the ER3 file). Increase the time of the first sort (ERT1), and
rerun the program. If additional results are desired for later times,
restart the simulation and specify a lower concentration of interest in
the input step (lower CCLOW in DEGADISIN).
Code: 24
TPROP? Trial and error loop compromised.
Action: TPROP estimates the temperature of a mixture based upon the
composition and enthalpy of the mixture. Ensure the properties for the
diffusing species are entered correctly and execute the simulation
again.
-------
I-i
Code: 25
TPROP? Isothermal density loop compromised.
Action: This error should never occur, but if it does, rebuild the
model from the original files and run the simulation over.
Code: 26
TPROP? Invalid entry flag in ADIABAT.
Action: This is a programming diagnostic and should never occur. If it
does, rebuild the model from the original files.
Code: 27
Reserved
Code: 28
TPROP? IGEN request too large in SETDEN.
Action: The subroutine SETDEN (in TPROP) performs a series of adiabatic
mixing calculations with a specified gas mixture and ambient air and
places the result in the array DEN(5,IGEN). This error indicates more
points are needed in DEN than were originally requested. Increase the
allocation for DEN by changing the value of IGEN in DEGADISIN.DEC and
reinstalling DEGADIS.
Code: 29
PHIF? Flag IPHIFL is out of bounds.
Action: Proper values of IPHIFL are integers between 1 and 5 inclusive.
Although values of IPHIFL are entered in the ER1 file as real numbers,
they should be in this range. Check the ER1 file and execute the
program again.
Code: 30
SSSUP/SDEADIS2? Concentration greater than RHOE.
Action: If the concentration of the contaminant becomes greater than
the pure component density for an isothermal simulation, this error will
occur. However, this situation should never occur. Check the input
conditions and execute the program again.
-------
1-9
Code: 31
SSSUP? Concentration greater than RHOE.
Action: If the concentration of the contaminant becomes greater than
the pure component density for an isothermal simulation, this error will
occur. However, this situation should never occur. Check the input
conditions and execute the program again.
Code: 32
PSS? Sz convergence failure.
Action: This is a programming diagnostic and should never occur. If it
does, check the input conditions and execute the program again.
Code: 33
SSG? Sz convergence failure.
Action: This is a programming diagnostic and should never occur. If it
does, check the input conditions and execute the program again.
-------
J-l
APPENDIX J
OOMS/DEGADIS
EXAMPLE SIMULATION OUTPUT
(corresponds to example in Section IV of this volume)
-------
J-2
O
ooooooooooooooooooooooooooooooooo
I I I I I I I I I I I I I I I I I I I I I I I I I I I I I I I I I
H f*1 F*1 M til f'l f 1 frl M Frl M f'1 trl H DJ M T*T f*l f*l M M M f*1 M f*1 T'l T*1 F'l M M M T*1 T*T
O
u
—• OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO
a
u
EH
oooooooooo
u
b
O
J
u
>
u
a
E-.
u
l-l
a
u
u
ooooooooooooooooooooooooooooooooo
-------
J-3
o
o<
S!
0
M
in
tt
u
r>
H
a
P<
f
s
o
J
u
a
0
s
i/i
M
OOOOOOOOOOOOOOOOOOOOO
1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 •<
" " S22S "SSSS SSSSS "SS " S o
SSESSSSSSSSSESSSSSSSS u
ooooooooooooooooooooo
<
o
D
SwMSSS5SSSSSSK£Z!5SS^5
o oi oi oj r^ r>' vo ui in ^' in r^ rvj rt o o o> oo i^ r-' «j
f*t O) <"-J rvlfNlfNIPJJfNfNfNfN fN fNl^irvlrvli— (^Hi— liH r-4
5oiin2S'5oSS«5o'I5S^rS?NiriSS?i
r*ir-ico^omi-ia>vo'9>fH^Ko*3'<-^o>^O'^<*o~4«Nm*T
•K
•K
«
*
«
*
«
•k
•K
«
*
«
*
0
H «H
«
« flO
* r-l *H
* 1 1
: 11
i i
t^. r-
fH i-l
C
O
c
3
u
e
O U«
-U O
3 ^
a a
c
•H 9
U
m u
«J O
Q (0
i
VI
a
u
LJ
3
o
to
*O
D1
•H '
rH
U iH
m a
rH P.
3 0
U J3
U CD
•H *—
O
0
O Ul
4J tO
9
•o ^
O O
jj LI
-H
B U
-H M
rH £
a
u vi
i O
JJ ^H
H d)
^H C
-------
J-4
Cu
H
o o o
o o o
ooo
ooo
ooo
ooo
oo eo oo ao eo oo eo ao eo
at a* a* at 0* o* a* 01 o>
fN fl (N fN fN fN fN fN 1 OOO OOO OOO
Oi •*• + •(• + + + + + +
~4 CPU UU UUU UUU
MJCOOO ooo ooo
j: Xo o o ooo ooo
4i >-l O O O OOO OOO
B ooo ooo ooo
u ooo ooo ooo
o o o o
o o o o
>. + + + +
Qi U U U U
-H O>0 000
id .* o o o o
A \0 000
•U >-)0000
C o o o o
u ....
o o o o
ooo
EH
55 * r- in m
w B r- in •a-
Q \ *-* CN m
ooo
ooo
r- r* m
co o m
o
o
O O (N O
o o o o
00 . W O
en 1-1 o\ in
m r- m
t-tiNi1
r>ir>iin
IJ • >
T)
c
3 ••
•U 4J
a B
I
o o o o
o o o o
eo eo eo oo
o* m o* o\
i i i i
IB *> J< U U U Id
C U \ VO « « ^O
-H m 6 T ^« TT *r
B K 10 T TT •]• •O'
IQ [M V «T ^T ^T ^3"
•p c M m m m
B 10 O • • • •
o in u IN rsi (N (N
u a
E o*
o o
o
o
u
o
o
o
TJ
•a
•o
a
OS
a
u
u
3
O
ut
o o
o o
+ +
u u
m m o o
I at at o o
ao oa o o
• -oo
in in o o
o<
m fl
>
M n
O
in
-u
B
•o -o
JJ WOOD
a n n u >
K U 3 3 -rt
4) « in »H *J
Qt Qi in o id
E g ID en —i
Q) OJ U J3 O
E-< H O* < K
U B B B «
flj (D V 0) J2
. >. o o
fl H -H 4J 4J .
a) u u u u u
O< u O
H a jj o, o, u u
o a in n) Q u u
o o
4J O O
cm -t- +
(U -U U Ed
C , ai ai g e
3 tnjJ fi jc
O J-l d) 1> 1) Qj ' '
o
a
3
a
c
I
1. 0000
S ul o • • •
H o m -3* »n
E-i o rsi rsi
-------
J-5
ac C Density Temperature Rich Ho
kg/m**3 K
Ul
<
_.
to
VI
in
N
U (N
(11 *
•P *
in S
o* *\
U*
J*
Jj
J5
D>
H e
a>
X
01
3
••-t
TJ
n)
M S
in
fl
O
0)
6 U
•H 0)
H in
-q« «qt
«j» «r
•-I rH
in in
r- r*
o o
0 0
0 0
0 0
OO 03
ot at
fM fM
r- p-
03 00
p- p*
•H r-4
0 O
1 1
W W
OO 03
rn ro
m in
03 03
rH <-H
•H iH
o m
in m
m o
n oo
03 •
• at
rH fM
^r ^*
0 0
I I
u u
m m
fM fM
P* P*
rH rH
at at
^i TJ«
> •
-H rH
m
o
1
CJ
O *!•
O *-l
O fM
O f-4
O •
iH ro
,— 1
rj rsi
at at
00 OO
m m
o
o
+
0 0
0 0
O 0
0 03
O \O
0 •
* p*
o
source radius [n] : 15.893
source half-width [m] : 12.482
>* >i
n u
cd tit
e s
•H -H
Id U
ex o.
B B
0> 0>
a id
> >
•H -H
? 3
U M
o m
O 03
fM P»
p- •
• rH
vo m
• t
g
b_l
J5
Jj
CP
C
41
•H
9)
• • o
— 3
in o
X «
^4 >i
fl
J= E
en u
B Q<
0)
U 4J
•U B
tn 4)
~4.
0 n
u >
h -H
3 3
U) U
VO
o
CO
en
rsl
e
M
W
a
o
u
3
O
in
>.
u
fl
•o
B
O
U
,
u
fl
•o
B
O
U
91
Wl
m
0
1
u
0
in
rH
in
VO
VO
a>
^j
fl
Xi
3
^
4J
B
fl
B
-H
a
B
O
en
vo
p-
CO
en
o
L4
•H
fl
m
0
1
U P-
m co
vo p-
^ i
4J -U
B 'H
fl in
B B
•H «
e a
ta
ti
K
o
u
• o
• o
Ul u
C o
O 0
-4 0
4J 0
O 0
« •
u o
in
in ••
fl >.
E a
rH
4> fl
U £
3 B
O Cd
in
>,
u
fl
•o
B
O
U
a>
VI
(M
CO
•*3*
IN
(-4
la
X
4J
TJ
•H
3
1
>u
rH
a
X
o
u
u
3
O
in
>.
u
fl
B
O
U
O
Ul
in
co
p-
i
«H
m
— ~
• •
^j
tr
B
,H
vV
U
3
O
in
>,
u
fl
TJ
C
O
u
t/i
•• o
o 6
*J m
o
a t
w —
o o S
m o —
4J O
fl S —
•a u
•H O
» o
o
10 m f
*j* in v
p» m «N
vo 00 ot
CO (N VO
n m PO
co ao in
*t> in vo
in in
CM in m
oo r- r-
r- n 01
CTl (N f
m IN O)
03 CO 03
a\ a\ o\
m in
at at
03 00 03 03 CO 03
at ot at at ^ o\
n fM m fM fM M
ao 03 co
at at at
(N
,X
OOO
1 1 1
CJ CJ U
ro m IN
vo vo vo
p- p" p*
000
t 1 1
CJ LJ CJ
O VO -T
vo in tn
r- r- P-
o o o
1 1 I
CJ CJ CJ
o^ in tn
T r*} r^i
P- P* P-
O O O
f 1 1
CJ OJ CJ
vo vo P*
>— * O O>
r- r- vo
m rt rn
ooo
1 1 1
U CJ CJ
ao oo CT>
ao p- vo
vo vo vo
OOO
1 1 t
CJ CJ CJ
O «-l (N
vo in -T
VO vO VO
ooo
1 1 1
CJ CJ CJ
ro rr in
p-l pg rH
VO VO VO
ro rn m
ooo
1 1 I
CJ CJ CJ
o 01 oo
vo in in
ooo
1 1 1
CJ CJ CJ
co P* vp
m m m
O O
S fl
o
« 63
4J ~-
in
i*i <*t n
ooo
1 1 I
U U CJ
in in tn
CO OO CO
m n-> m
OOO
1 1 1
CJ CJ U
*r CN 1-1
03 ao oo
m m on
ooo
1 I 1
CJ CJ CJ
at m a^
r- r- vo
ft m rn
ooo
1 1 1
CJ CJ CJ
m -H r-
vo vo m
ro r*i m
ooo
I 1 1
CJ CJ U
m
-------
J-6
m .H o o* r* m fn«-»« r- in n o r- in O\ CT> O*» (Tl CT» O> O> O\ O^ C3\ Ol W O> O^O\O^ O^ Ch O\ O^ ^ O\ <3\ O\ O\ O\ O% A W W O^ O> O^ O\ CT» A Q\ O\ O\ O\ O\ O\ O\ A O\ O> 0) O> O^ O> A CTt W O% ON O^ O>O>O> Cl Ol CT"i
o o o o o o o o o ooo ooo o o o o o o ooo o o o o o o o o o ooo ooo o o o ooo ooo
vo vo in in in ^* ^* m ft m cj 0*1 r*j ^H I-H i—4 «H o o o o o at at at at at co oo co oo oo co p* p* p» p* p* p* p* P* vo vovovo vovovo
co 03 oo oo co co cococo oo co oo co co oo co ao oo co co co co p- p* P- p* p- r-P-r- r- P- P- r-p-P- P- P* P- P- r- r- r* P- P* P- P- p-
ooo
1 1 1
u u w
in co vo
in *3* m
ooo
1 I !
U] U U]
o o m
O\ CO
ooo
1 1 1
f'1 f*1 M
vo co in
CO P* VO
ooo
1 1 1
u u u
in at in
vo in in
ooo
I 1 1
r*i f*i M
in p- •-)
^<*m
000
I 1 1
u u u
P- CO
m (N
o
1
(•1
rsi
in
o o
1 1
U3 r*i
m in
.H CO
ooo
1 1 1
U U C«J
p- p* m
-r <-t eg
00 CO P-
ooo
I I I
[i] U U
TT O OS
in m o
ooo
I I I
[U M f'7
o m r-
oo vo m
OOO
I I I
CJ CJ W
-r (Ti co
^H CO VD
OOO
1 1 I
iH oo vo
-T f-l O> Ov
000
1 1 1
U Cd Cd
r~ rvi en
P" *T* O
CO CO CO
000
1 1 1
U Cd Cd
eo ch rv)
r- *3« rM
r- r- p-
000
1 1 1
Cd Cd Cd
(^ (N en
en P^ ^
VO vo vo
000
1 1 1
U Cd Cd
OO 1^ CO
rvi o 03
vo vo in
ooo
1 1 1
Cd Cd Cd
cn rvi in
vo in m
in in in
ooo
1 1 1
Cd Cd Cd
^ O 03
in in ^~
000
1 1 1
Cd Cd Cd
r«4 m in
vo T PsJ
1 -.' -f
000
I I I
U U £tl
co rM P~
0 <^ P-
«• r*l m
OOO
I I I
Ctl U U
m o P*
m m m
000
1 1 1
u u u
in -31 m
CM r-t O
m m m
OOO
1 1 1
Ctl U U
at oo p-
fM rs| fM
ooo
1 1 1
U U U
Cl
fM i-l — (
m mmm mmm mmm mmm mmm mmm mmm
O OOO OOO OOO OOO OOO OOO OOO
+ + + + + + + + + + + + + + + + + + + + + •»•
U UUU UUU] UUU 1*3 U CJ Uh3U Ub3U U1UU
. .. ... ..^r mf-tat co vo in m»no cop-in VOP-CI o«-tfst mmvo
co^rm m^-4c^ p»sot-t mo*imm m^^1 mmvo VOP*P* coooo\
-------
J-7
r» «3* .-t a\ r* *t> o r-» m covco m r- »-i tn«oo nn^« •* *n to to *c v> *o v> in in in^r^1 m o *ovor- p* p*« P* r-p-r*- p» p* r- r*» p*- p- r*« r* r- p~ p- p» p* p* p- p* p*- p* r*» r* p» p* r* to
p* r- r- r* vo in «a» *N o co P-* in m o P* m m in o <* <& r* *-* rpvo
p. p. p* r* O*O»O» O»OtO> Ol tf» OS OS OS O> OS OS OS OS CQ CO OOOO
intnin ininin
m«orn comr-
... .•*
^*inr« COO*H
in invo
000
ooo
Cd Cd Cd
OOO
OOO
000
000
r~r-«
000
ooo
Cd Cd Cd
OOO
OOO
000
000
CO at m
lfN|r>( (NfMfN r*r-IO* r-4<>IOI (N(N
,3* -j» -j,
ooo
1 1 1
Cd Cd Cd
o* in oo
m •& n
ooo
1 1 1
cd cd cd
rH -O
rH O O
n*> m m
ooo
4- 4- 4-
Cd Cd Cd
O» \O ro
(N 0 CO
P- CO CO
n«
O VO ^O rO
r- r- r-
o-l r*i oi
OOO
4-4-4-
Cd Cd Cd
rH P* "^
in Oi m
ooo
1 1 f
Cd Cd Cd
rsi ^o (N
O CO >~O
r- 'c >c
01 m m
OOO
4-4-4-
Cd Cd Cd
rH co in
in oi o
^ r- co
"31 T T
OOO
1 1 1
Cd Cd Cd
r^ oo •— i
ooo
1 1 1
Cd Cd td
o co r-
("n rH O>
'C1 >c in
m on m
OOO
4-4-4-
Cd Cd Cd
t-H co ui
co in m
eo en o
rr TT TT
ooo
1 t 1
cd cd eg
rj. O ^3
OOO
1 1 1
Cd Cd Cd
in (N GO
r- m rp
u~i m in
OOO
4-4-4-
Cd Cd Cd
(N 01 in
r>t CO U)
rH rH r-J
^I1 -^ *3*
000
1 1 1
cd cd cd
«
^« rH OS
^ ^ -^
ooo
I i I
M M M
oo m -j1
rH co m
^ 0 0
000
1 1 1
U M Cd
in vo (N
r- vo m
n m on
ooo
4- 4- 4-
Cd Cd Cd
n o\ »«
r- T *n
CN) in oo
ooo
1 1 1
cd Cd Cd
•^ r\i -^
m rv| rH
-t- -^ -^
ooo
4-4-4-
Cd td Cd
o co in
CO CO Ol
in in in
ooo
I i I
Cd Cd Cd
rs o r-
rg p1- r-i
000
1 1 1
td cd cd
O CTi CO
*^* m on
m on on
ooo
4-4-4-
U Cd Cd
m o r*
on M co
O i-H «H
m m
o o
I t
Cd Cd
S 5
CO CO
o o
| I
CU Cd
O^ on
on n
O O
4- 4-
Cd Cd
vo ^
-------
J-8
VO in 03
o ^ m
vo m o vo «-i m oocno en P* m p- en eo
r 0t O\ Ot O> O^ (Tt O^ O\ O\ O\ O\ O\ OS O\
o
en
<*
o
^
p*
rH
•H
in
O
1
U
m
m
m co
r\i cr\ vo
^o in m
M r*> m
O 0 0
r*i H M
en vo fi
m m r-H
co eo co
CO OO CO
O O O
m m in
o o o
1 t 1
M H M
•7' r*t T
CT^ ro p«
m m -T
m m m
m m m
o o o
1 1 I
WWW
^ vo 0
m m -v
m m m
o o o
u u u
en vo m
CO VO -3*
CO CO CO
CO CO CO
o o o
m m m
o o o
1 I 1
p- «H VD
^-t ^o o
-T ro m
mmm
in m m
o o o
1 1 1
M f'1 CT!
^ fN CO
VO "T iH
T -p -r
m M f»i
000
u u u
o P* m
rsi en P*
CO CO CO
iH
CO
-r
o
<3«
p-
p-
in
o
1
U
m
in
-------
J-9
oo oo oo oo o* o* 0*0*0* 0*0*0 ooo ooo
r^coo* at o 1-4 -H IN m m *i« in in vo D
+ + + + + + + + + + + + + + + + 4- + + + + + + «H
U U UUU U M U UUU UUU UUU UUU UUU O
oo ooo ooo ooo ooo ooo ooo ooo e
00 OOO 000 000 OOO 000 OOO OOO
00 OOO OOO OOO OOO OOO 000 000 m
o
OO OOO OOO OOO OOO OOO OOO OOO I
w
«ooo cocoa) coooco eococo coeoco cococo cooooo cooaeo rvi
a* o* o\ o\ o^o*
(NfN fNfM(N MfN(N rMrslM
O
.J
oo ooo ooo ooo ooo ooo ooo ooo
•o
G
T3
4J «••
c w
o u.
« a.
a » J
mm minm mmm in m in in in in minm minm mmm •—t x
OO OOO OOO OOO OOO OOO OOO OOO O C -*J
t i tit 111 111 111 111 111 111 e d)
U U UUU UUU UUU UUU UUU UUU UUU of^i CO-^TI-I r^*vo r-^rM o -MO
rsiH *Hoo ototco cor-r* p»vovx> uitnm •q'-a*iv mnrn | to &
mm mmm pjfNfN rMrgrM rMfMr«j rMfMCM rsir^jiN r-iCMr^ o
O 4J -U
O C C
mm m m in mmm mutm in in in in in in minm in in ^ o to to
oo ooo ooo ooo ooo ooo ooo ooo o cc
II III lit III III III III III ' H H
UU UUU UUU UUU UUU UUU UUU UUU m 66
r-rn moco ^omm »HO>P- in^f-i oo^r* vo^m rnoco -1-14-1
'u 00
OO OOO OOO OOO OOO OOO OOO OOO D
+ + + + + + + + + + + + + + +-*•+ + + + + + + inw
UU UUU UUU UUU UUU UUU UUU UUU 0) Ultn
O.-H ^ifNm ^rrm vor^r* eooto ooo ooo ooo
U W O\ O\ ^4 «H«-<«^< «^HrHrH «-HiHfH O j£ J2
-------
TECHNICAL REPORT DATA
(Please read Instructions on the reverse before completing)
1 REPORT NO.
EPA 450/4-88-006b
3. RECIPIENT'S ACCESSION NO.
4. TITLE AND SUBTITLE
A Dispersion Model for Elevated Dense Gas Jet
Chemical Releases—Volume II, User's Guide
5. REPORT DATE
April 1988
6. PERFORMING ORGANIZATION CODE
7. AUTHOR(S)
Dr. Jerry Havens
a. PERFORMING ORGANIZATION REPORT NO.
9. PERFORMING ORGANIZATION NAME AND ADDRESS
10. PROGRAM ELEMENT NO.
11, CONTRACT/GRANT NO
P.O. #6D2746NASA
12. SPONSORING AGENCY NAME AND ADDRESS
13. TYPE OF REPORT AND PERIOD COVERED
U.S. Environmental Protection Agency
Office of Air Quality Planning and Standards
Source Receptor Analysis Branch
Research Triangle Park. N.C. 27711
14. SPONSORING AGENCY CODE
15. SUPPLEMENTARY NOTES
EPA Project Officer: Dave Guinnup
16. ABSTRACT
This document is the second of two volumes describing the development and use
of a computer program designed to model the dispersion of heavier-than-air gases
which are emitted into the atmosphere with significant velocity through elevated
ports. Volume II addresses the user aspects of the program, discussing model
inputs and outputs and describing the installation of the code onto the user's
VAX computer. An example simulation is carried out to provide the user with a
benchmark for the model's operation.
17.
KEY WORDS AND DOCUMENT ANALYSIS
DESCRIPTORS
b.lDENTIFIERS/OPEN ENDED TERMS C. COSATI Field/Group
Air pollution
Dense gas
Mathematical model
Computer model
Dispersion
Elevated sources
18. DISTRIBUTION STATEMENT
Release unlimited
19. SECURITY CLASS (Tins Report/
21. NO. OF PAGES
394
20 SECURITY CLASS (Thispagei
22. PRICE
EPA Form 2220-1 (R«v. 4-77) PREVIOUS EDITION is OBSOLETE
------- |