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

-------