EPA-R4-73-025b

May 1973                   Environmental Monitoring Series
Tests of an Urban
Meteorological-Pollutant Model
Using CO Validation Data
in the Los Angeles Metropolitan Area
Volume II, Fortran Program
and Input/Output Specification
                         Office of Research and Monitoring
                         U.S. Environmental Protection Agency
                         Washington, D.C. 20460

-------
                                           EPA-R4-73-025L

             Tests of  an  Urban

     Meteorological-Pollutant Model

       Using CO Validation Data
in the Los Angeles Metropolitan  Area

       Volume  II, Fortran  Program

     and  Input/Output  Specification
                        by
            Joseph P. Pandolfo and Clifford A. Jacobs
           The Center for the Environment and Man, Inc .
                    275 Windsor St.
                Hartford, Connecticut 06120
                  Contract No. 68-02-0223
                Program Element No. A11009
             EPA Project Officer: Kenneth L. Calder

                  Meteorology Laboratory
             National Environmental Research Center
           Research Triangle Park, North Carolina 27711
                     Prepared for

             OFFICE OF RESEARCH AND MONITORING
           U.S. ENVIRONMENTAL PROTECTION AGENCY
                 WASHINGTON, B.C. 20460

                      May 1973

-------
This report has been reviewed by the Environmental Protection Agency and




approved for publication.  Approval does not signify that the contents




necessarily reflect the views and policies of the Agency, nor does




mention of trade names or commercial products constitute endorsement




or recommendation for use.

-------
                            TABLE OF CONTENTS
Section

 1.0
 1.1
 1.2

 2.0

 3.0

 4.0

 4.1
 4.2

 4.3
                      Title
THREE-DIMENSIONAL BOUNDARY LAYER MODEL COMPUTER PROGRAMS    1
Vertical and Horizontal Grids                               1
Input Deck Setup                                            3
MAIN  PROGRAM:  RIGID LID Version
MAIN  PROGRAM:  FREE SURFACE Version
13
62
ANALYSIS PROGRAM FOR THE THREE-DIMENSIONAL BOUNDARY
LAYER MODEL                                               119
Introduction                                              119
Card Input                                                119
  Input Deck Setup for Analysis and Gridpoint Format      122
FORTRAN Listing of ANALYSIS Program                       124
                          LIST OF ILLUSTRATIONS
Figure                         Description
   1        Notation Used in Height Indices.
   2        5x5 Sample Horizontal Grid Network.
                                                          Page
                                                            1
                                                            2
                             LIST OF TABLES
Table                          Description
   1        Variable Indicator.
   2        Contouring Parameter.
                                                          Page
                                                          120
                                                          121
                                   111

-------
1.0  THREE-DIMENSIONAL BOUNDARY LAYER MODEL COMPUTER PROGRAMS

J..1  Vertical and Horizontal Grids

     The vertical grid at each horizontal grid point is shown in Figure 1 below,

with the notation used for the height indices.  This grid is identical for each

grid point in the horizontal array.  A sample 5x5 horizontal grid is shown in

Figure 2.
                        Top of boundary layer
       Z(NP1)   —

       Z(NX)    —
       Z(IP2+1) —

       Z(IP2)   —
       Z(IM2)
       Z(2)     —
                      Bottom of boundary layer
                                                           Atmospheric
                                                            Boundary
                                                             Layer
                                                          Interface
                                                          Ocean/Land
                                                            Boundary
                                                             Layer
     Figure 1.  Notation Used in Height Indices.  All height indices are
               referred to the bottom grid level in the ocean/land (z(l) in
               the diagram above).  There are two grid levels (z(IX) = Z(IP1)
               = 0 cm)  defined at the interface.  Z(IX) = 0  is the water/land
               interface and  Z(IP1) = 0  is the air interface.

-------
Start
1,1 1,2
t
XD
4-
2,1 t- XD -> 2,2
3,1 (Q)
4,1 4,2
5,1 5,2
1,3 1,4 1,5
^
2,3 2,4 2,5
3,3 3,4 3,5
4,3 4,4 4,5
5,3 5,4 5,5
        XD = 12.874752 km
Figure 2.  5x5 Sample Horizontal Grid Network.  The routine called
           TEMPRT can be optioned to printout any and/or all of the
           grid points in the grid areas.  The circled point indicates
           the initial profiles input point which can be anywhere in
           the grid area and not necessarily at a given grid point.

-------
 1.2  Input Deck Setup

      The input for each simulation is given by the following card sets.

 Units are given and the notation, n.d., implies nondimensional.
 CARD TYPE  (number  ( ) of cards in set)
       Type
      Number    Format    Columns
       KD
18A4
1-72
Program
Symbols

  C0M
   Program Designates

Comment Card.
       2(1)
1415
1-5
                            6-10
                           41-45
  NX
                      IX
11-15
16-20
21-25
26-30
NT
IMAX
JMAX
NTIME
                           31-35      NVAR6

                           36-40     ITESTP
                     IP0L
Number of levels in the
boundary layer minus one
(NX <_ 29).

Height index at the inter-
face (IX >_ 4) (n.d.).

Number of time steps.

Number of horizontal grid
points (x-direction).

Number of horizontal grid
points (y-direction).

-1:  No meteorological
input as a function of time.
0:  Meteorological input.*

Not used.

Interval time step for
printout (n.d.).
Pollutants present (0,1,2)
(n.d.).
The following card is only used when columns 26-30, Card 2, is 0.
      2M(1)      1415       1-5     NVCHS(l)     +1:  u and v wind and water
                                                 current components are
                                                 specified.
                                                 0:  Not specified.
 *  This option has not been fully tested.

-------
                           9-10    NVCHS(2)



                          14-15    NVCHS(3)

                          19-20    NVCHS(4)
                      +1:  Temperature and speci-
                      fic humidity are specified.
                      0:  Not specified.

                      Not used.

                      +1:  Interface tempera-
                      ture is specified.*
                      0:  Not specified.
      3(1)     6F12.4
 1-12       DT        Time step 
-------
Cards 6-11 assume the initial values to be at the horizontal grid point,

XIIN, XJIN  given on Card 3.
     6(N/6)    6F12.4
                      1-12
                          61-72
                     Initial values of eastward
                     wind or current component
                     (cm/sec).  Values of  U(IX)
                     and U(IPl) must be equal.
7(N/6)    6F12.4      1-12

                       t
                       •
                       •
                     61-72
                                                Initial values of northward
                                                wind or current component
                                                (cm/sec).  Values of  V(IX)
                                                and V(IP1) must be equal.
     8(N/6)    6F12.4
                      1-12
                          61-72
                     Initial values of the atmo-
                     spheric and oceanic tempera-
                     tures (°K).  Values of T(IX)
                     and T(IP1) must be equal.
     9(N/6)    6F12.4
                      1-12
                          61-72
                     Initial values of oceanic
                     salinity (g/kg),  N-l, IX;
                     and values of atmospheric
                     humidity (g/kg), N=IP1, NP1.
                     In most cases, W(IX) and W(IP1)
                     will not have numerically
                     equal values.
    10(N/6)    6F12.4
                      1-12
                       •
                       • '
                       •
                     61-72
PP12 (j=l,N)
                     Initial values of pollutant
                     1 (yg/m3).  Values from 1 to
                     IP1 are not used.
    ll(N/6)    6F12.4
1-12   PP22 (j=l,N)
                          61-72
                                           Initial values  of pollutant
                                           2 (yg/m3).   Values from 1 to
                                           IP1 are not  used.
Cards 12-15 are information relating to the initial and peripheral horizontal

gradients.  The card set consisting of Cards 12-15 are repeated for each of

the following parameters in the order in which they appear:

     j = 1   Oceanic and atmospheric - u-gradients (cm/sec/cm)
         2   Oceanic and atmospheric - v-gradients (cm/sec/cm)
         3   Oceanic and atmospheric temperature gradients (°K/cm)
         4   Oceanic salinity and atmospheric humidity gradients (g/kg/cm)
         5   Pollutant 1 gradients (yg/m3/cm)
         6   Pollutant 2 gradients (yg/m3/cm).

-------
NOTE;  The horizontal gradients at the interface should be repeated if the
subsurface and the atmospheric horizontal gradients are different at the
interface.  Whenever there is only one input level, the horizontal gradient
is assumed to be constant at all height levels.
     12(1)
1415
1-5
    13(N/6)    6E12.5
           1-12
                          61-72
                                      (1=1,
Number of grid levels at
which gradients are input
for appropriate parameter
where j on, cards 12,13,14,
15 is defined on bottom of
previous page (K <_ 30).

Height (cm) of input hori-
zontal gradient levels in
ascending order.  A minus
sign indicates values below
the interface.
    14(N/6)    6E12.5
           1-12
            •

          61-72
        ZDIX(i)      x-horizontal gradients in
           (1=1,K.)  ascending order.  Units
                     are defined above.
    15(N/6)    6E12.5
           1-12
            •
            •

          61-72
        ZDIY(i)      y-horizontal gradients in
           (1=1,K.)  ascending order.  Units
                                                are defined above.
     16(1)     4F10.2
1-10
11-20
21-30
31-40
S0AB
•S0SC
XN0
C0C0B
                                Solar absorption coeffi-
                                cient (km"1).

                                Solar backscatter coeffi-
                                cient (km"1).
                                Infrared absorption coeffi-
                                cient (km"1).

                                Mie initialization factor
                                (g air/1010g pollutant).
                                A constant that depends on
                                the density and specific
                                volume of an aerosol dis-
                                tribution.
     17(1)
1415
1-5       NLAP       Number of levels above NP1
                     in the atmospheric sounding
                     for input (n.d.) (<_ 20).

6-10       NPU       Indicator of the reference
                     level for pressure computa-
                     tions (see input card type

-------
NOTE;  Cards are repeated NLAP times.
    18(NLAP)   4F10.2
1-10
11-20
21-30
31-40
PA
TA
QA
C0B
                       Pressure  (mb).

                       Temperature  (°K)

                       Humidity  (g/kg).
                       0.
The first set of cards, 30M to 33M, are input here only when columns 26

to 30, Card 2, is 0 (see Card 30M).  The following cards  (19-28) are re-

peated for each horizontal grid point in the order 1,1; 1,2; ... 2,1 ...

as indicated in Figure 2.


     19(1)       1415       1-5       NTF0R      Number of cloud input
                                                cards (n.d.)(<_ 10).

                           6-10        NCL       Number of cloud layers
                                                (n.d.)(<. 4).

                          11-15       NTCUV      Number of geostrophic wind
                                                current component input
                                                cards (n.d.)(<. 20).

                          16-20       IP0I       Number of pollutants
                                                source types  at this grid
                                                point (n.d.)(0,l,2).

                          21-25       IG0NY      Water/land option indicator
                                                (-2  =» coastal corner, -1 =>
                                                coastal, 0 »  water, 1 = land.

                          26-30       ISSI1      Number of input time steps
                                                used for pollutant 1 (n.d.)
                                                (if  IP0I«=1,2)(<_ 20).

                          31-35       ISSI2       Number of input time steps
                                                used for pollutant 2 (n.d.)
                                                (if  IP0I=2)(<.20).
     20(1)      4F10.2
 1-10      PSFA       Pressure at surface (mb)
                      NPU=0; or pressure at upper
                      boundary (mb) NPU=1.
11-20      XLAM       Wavelength of the character-
                      istic turbulent wave (-ZQ
                      if land)(cm).
21-30       DEL       Steepness of the character-
                      istic turbulent wave (0 if
                      land)(n.d.).

-------
     20a(l)    6E12.4      1-12      SL0PX      Slope of the land surface
                                                at the interface in the
                                                x-direction.
                          13-24      SL0PY      Slope of the land surface
                                                at the interface in the
                                                y-direction.
                          25-36     HEIGHT      Height of land or depth
                                                of water from an absolute
                                                reference surface (e.g.,
                                                mean sea level) land ele-
                                                vation positive, water
                                                depth negative (m).
                          37-48     ETAINX      Elevation of water surface
                                                at open boundaries (N-S
                                                boundaries, cm).
                          49-60     ETAINY      Elevation of water surface
                                                at open boundaries (E-W
                                                boundaries, cm).

                          61-72      IANV       See below.
            IANV = 0   For coastal corner  (IG0NY = -2)
                       For water           (IG0NY =  0)
                       For land            (IG0NY - +1)

                 = 1   For a coastal station  (IG0NY = -1)
                       which lies parallel to the latitude
                       (EAST-WEST DIRECTED).

                 » 2   For a coastal station  (IG0NY «= -1)
                       which lies perpendicular to the
                       latitude (NORTH-SOUTH DIRECTED).
NOTE;  In the following card set, linear interpolation in time is used to
compute the geostrophic winds and currents at each time step from the input
values.  When only one value is input, the values are assumed constant.
    21(NTCUV) (I5,4F10.2,2A4)

                           1-5       ICUV       Input time step for geo-
                                                strophic wind current
                                                (n.d.).

                           6-15      X0CU       Eastward component of geo-
                                                strophic current at Z(IX)
                                                (cm/sec).
                          16-25      X0CV       Northward component of
                                                geostrophic current at
                                                Z(IX)(cm/sec).

                          26-35      XACU       Eastward component of geo-
                                                strophic wind at Z(NP1)
                                                (cm/sec).

-------
                           36-45      XACV       Northward component of
                                                 geostrophic wind at Z(NP1)
                                                 (cm/sec).
                           46-53      T1.T2      Not used in program.  Used
                                                 to identify station in
                                                 deck and printout.
 NOTE;  The following card set is included only when NCL on Card 19 is not
 equal to zero.  Linear interpolation is used to compute the cloud amounts
 at each level and the rainfall rate at each time step from the clouds and
 rainfall rate specified at the input time steps.  When only one time step
 is input, the values are held constant.
     22(NTF0R)  (I4,I2,F6.2,5(I3,F4.1,F4.0))
                            1-4       ISTEP
                            5-6
           NXN
                     Input time step for clouds
 Number of cloud layers
                            7-12
                           13-15
          RAINI

          LLCI
                           16-20      ECLI


                           21-24      TCLI
 Rainfall rate (cm/sec) .
 Index for the grid level at
 which cloud layer occurs.
 Cloud amount at level
 (tenths).   .
 Cloud type at level
 (1, ... 9).*
 Repeated for NXN levels as needed.
25-27
28-32
33-36
37-39
40-44
45-48
49-51
52-56
57-60
LLCI
ECLI
TCLI
LLCI
ECLI
TCLI
LLCI
ECLI
TCLI
Level 2
Amount 2
Type 2
Level 3
Amount 3
Type 3
Level 4
Amount 4
Type 4.
*Cloud type is defined as

      1)  Fog
      2)  Stratus
      3)  Strato Cumulus
4)  Cumulus
5)  Cumulonimbus
6)  Alto Stratus
7)  Alto Cumulus
8)  Cirrus
9)  Cirro Stratus

-------
NOTE:  Include Cards 23 and 24 only when IG0NY on Card 19 is 1  (i.e. land).


     23(1)     7F10.2      1-10       SRS       Surface albedo  (n.d.)
                                                (0 <. r <. 1) .

                          11-20       R0W       Surface density  (g/cm3)
                                                (n.d.).

                          21-30       CW        Surface specific heat
                                                (n.d.) (cal/cm/sec).

                          31-40       XMQ       Moisture parameter  (n.d.)
                         s--                     (0 <.m <_ 1).
                          41-50      RADMX      Artificial heat source due
                                                to combustion by man (n.d.).


     24(1)     7F10.2      1-10  XKT^i-l.IMl)  Thermal diffusivity for
                                                soil layers (cm2/sec).


Cards 25 to 27 are included only when IP0I on Card 19 is 1 or 2.  When IP0I

is 2, the set is repeated for the second pollutant source.
NOTE;  Linear interpolation in time is used to compute the pollutant source
at each time step from input values identified on the following cards (25 and
26).  If one value is used, the value is constant.
     25(1)      1415       1-5       ITS1       Time step for input pollutant
                            .                   source (n.d.).  There are
                                                ISSI1 (Card 19) values in the
                          65-70                 first set and ISSI2 in the
                                                second set, if  IP01=2.
     26(1)     7F10.2      1-10      S0U1       Strength of pollutant source
                                                emissions (yg/m2/sec) for
                            I                   pollutant 1 in the first set
                          61-70                 and pollutant 2 if the
                                                second set is used.
     27(1)     6F10.2      1-10    SHl(l-6)     Fractional source emission
                                                at each height level from
                            *                   the interface to the 5th
                          51-60                 atmospheric level for
                                                pollutant 1 (2 if second set)
                                                (n.d.).
                                    10

-------
NOTE;  Include Card 28 only when  IG0NY =1   (i.e. land).
     28(1)    , 6F12.4      1-12     YY(I,3)     Temperatures in the soil
                                                at each level  (1 to IP1).
                             •

                          61-72

     29(1)     6E12.4      1-12     YY(I,5)     Pollutants for individual
                                                stations  (I = IX.NP1).
                                                See IP0L  (Card type 2).
                                                0:  none read.
                                                1:  set (1) read YY(I,5).
                                                2:  set (2) read YY(I,6).
The following are included only when columns 26-30, Card 2 is 0, and the

card set 30-33 repeated for each input time step; i.e., specified meteoro-

logical variables are input at all time steps.  The first card set, 30M

to 33M will be input after Card 18.  All other sets follow Card 29.
     30M(1)     1415       1-5       NTIME      Time step for input vari-
                                                able.
                            10         K        Number of input gradient
                                                levels for each.
The following cards are repeated for each level i ° 1,NP1 .  Only the input

variables need be specified.
     3111(1)    7F10.2      1-10   VARIN(i.l)    Input value at NTIME for
                                                u-component (cm/sec).
                          11-20   VARIN(i,2)    Input value at NTIME for
                                                y-component (cm/sec).
                          21-30   VARIN(i,3)    Input value at NTIME for
                                                temperature (°K).

                          31-40   VARIN(i,4)    Input value at NTIME for
                                                specific humidity (g/kg).
The following set of 2 cards each are read for each level that there is a

gradient.  There are "K" sets of cards.  Include Card 1 when NVCHS(l) = 1

(see Card 2M).
                                    11

-------
    32M(1)
7F10.2
 1-10
11-20
21-30
31-40
41-50
Height of gradient  (cm).
u-gradient in x-direction.
u-gradient in y-direction.
v-gradient in x-direction.
v-gradient in y-direction.
Include following in each set when  NVCHS(2) - 1 .  See card 2M.
    33M(1)     7F10.2
            1-10
           11-20

         .  21-30

           31-40

           41-50
                      Height gradient (cm).
                      Temperature gradient in
                      the x-direction.
                      Temperature gradient in
                      the y-direction.
                      Specific humidity gradient
                      in the x-direction.
                      Specific humidity gradient
                      in the y-direction.
The set of cards (30M - 33M) is repeated at each input time step until the
time step on 30M (NTIME) is greater or equal to the last time step of the
simulation (NT on Card 2).
                                    12

-------
2.0  MAIN  PROGRAM;  RIGID LID Version

     This section contains a flow diagram  (Figure 3) which shows  the  op-
erations in the numerical model MAIN Program, RIGID LID version,  for  the
atmosphere-ocean planetary boundary layer with land option and pollutants,
Following the flow diagram is its accompanying program listing.
     The symbols used in the diagram are, for the most part, those which
have become standard flow chart symbols.  The explanation of the  symbols
is as follows:
                 Q
                C
Program steps.

Subroutine call.

Content self-explained.
    i
Punched cards (input).

Decision on symbol content,

Magnetic tape (output).

Multiple entrance branch.

Disk (temporary storage).


Printed (output).
                                   13

-------
 Head Initial
Data Pollutante
 Soil, etc.
 Figure 3.  Flow  Diagram MAIN  Program, RIGID LID Version:
             Air-sea-land  interaction model.
                                   14

-------
     RIGID LID Program Listing
C      MAIN PROGRAM AIR-SEA INTERACTION  WITH  LAND OPTION               MAINOOO
C  1972 VERSION     TAPE OUTPUT  AT YOU GO .                              MAIN001
      INTEGER RDRUM«5DRUM»TDRUM                                          MAIN002
      DOUBLE PRECISION A.8»C»CST»D»DTO»DWO»DST»DT1»FA.GWO.PP11»PQl2      MAIN003
     1   »PP13»PP21»PP22»PP23»SST»TTl»TT2»TT3»TTO»TSC»U2iV2»Wl»W2»W3     MAJN004
     2   iWO»WSC»XKT»XYY»YY»GTO                                          MAIN005
COMMON-DOUBLE PRECISION NOT ON DISK OR RESTART                           MAIN006
      COMMON XYY<30»6»5) »A(30) »B(30) »C ( 30 ) »CST 1 30 ) »D(30) »DTO(3,0)         MAIN007
     1   iDWO<30)tDST(30)»FA(30)»GTO<30),GWO(30)»PP13<30)tPP23130)       MAIN008
     2   »TT3(30) .W3(30)»SST                                             MAIN009
COMMON-FOR PRINT ONLY                   •                                • MAIN010
      COMMON RI(30) »DT1(30)»YY(30»6)»SLOPX»SLOPYiHEIGHT»ETA1tETA2fXETA2• MA I NO 11
     1YETA2»IHT»IANV»IGOG»ETAINX«ETAINY»CSOUT(2)»CRSiRAA»TOUPRA»H3»CF»CE MA I NO 12
     2»WS(30)»UST»CW»HAI»HSI»RANS»RABNS»RABS»CRNS»TRAUS»XT2              MAIN013
COMMON-FOR RESTART AND PRINTOUT                                          MAIN014
      COMMON XKUI30) iVVELOO) » SRS .RADMX . IGOGO»ROW »XMQ»DEL                MAIN015
     1   »Xl.AMiRSUM<15) ,B1»B2                                            MAIN016
COMMON-NEEDED FOR RESTART ONLY                                           MAIN017
      COMMON PP11(3C)»PP2K30) »TT1 < 30) »TTO< 30) »TSC(30)»W1(30) iWOOOJ     MAIN018
     1   .WSC(30)tXKT(30).CU(30)»CV(30)»DTDT(30).OTTI30)»U1 < 30) »VH 30 )   MA I NO 19
     2   »ZDL2(30)tSOUl(20)iSOU2(20)»SH1(20)»SH2(20)»NCLI»I SSI 1»I SSI 2    MAIN020
     3   ,1TS2(20).ITS1(20),ECLI(10»4),LLCI(10»5)tTCLI(10 »4),I STEP<10 I   MAIN021
     4   »RAINI(10) . I CUV(20)»XOCU(20).XOCV(20).XACUI20)»XACV(20)         MAIN022
     5   »NXN(10)»TTW»DECL.COCOB»ICK»NTFOR,GSF.GFR»DTSF»SF               MAIN023
     6   »PHIR.GD2iISTR»SOSC«SCAB»XNO»CPH»SPH»PHI»H»IGONYiNTCUV          MAIN024
COMMON-OTHER THAN DOUBLE PRECISION-PRINT OR RESTART                      MAIN025
     7  »Z«30)»ZA«301tDZ(30) tDS(30> iPAU5)»TAU5)»QAU5) »COBU5) • COM (IB) MAIN026
      COMMON U3J30) iV3(30)»TBC(30)•WBO(30)»CKO(30)fCSW(30)tPSS(30)       MAIN027
     1   »E(30»2»2)iF(30«2).FST(30»2)»R(30.2»2 ) »BR(30)»TTI(30)»EC(5)     MAIN028
     2   «TCL(5)  »LLC(6) .STM501 »DST4{50) iDUW(SO) .05(50) »RAI (20)tPST(30l  MAIN029
      COMMON ITIMESI20)iIXTRAiMARAYI20).PSFAIN120)                       MAIN030
      COMMON SAVE»TDEL»XDTl.DT«XD»DECLX»DCHG.PHIBOT»HWEST»EM»ZWiC5»C6    MAIN031
     1  iNXUX»NT»IMAX«JMAX»NPl»IPl»NP2»NMl»NM2»IP2»IP3»IMl»IM2»IM3      MAIN032
     2  .l4,IA»RDRUM»SDRUM»TDRUM»IGRIDtIMARA.RTIME»IPOL.PI2»CFAR»NTIME   MAIN033
     3  •EX2»EX3»EX6»XNV»XNT»BETV»BETT»DT2«DTA.DTA2»G«CP»PI»GAM»GAM2     MAIN03^
     /»  iROAfALF»XKl»XK2fRALF»RC.CC»C32»XKl2»SH.HKK«HK2»Al»A2            MAIN035
     5  iNWSYY»NTOPl»DELH»   TW.INEW»ITAPE»I RATiINEWC                    MAIN036
      COMMON BG.AR.AW»SIG.ATC»SK»IZW»IZWl»IY»IRtLY»NCS»NCR«NLAPiNCL      MAIN037
     1   »NTOP»MAiNATAL»LAND»NVARl»NVAR6»CPP»ITESTP                      MAIN038
      COMMON Tl.T2iT3»T4,T5»T6»T7»T8»T9»TlOtTll»Tl2»XHN»XJlN»TE»T20     MAIN039
     2    »  T13.T14.T15.T16.XD1.YD1    .                                MAIN040
     3  iIS»RAlNX»ET»AT»ST»PT»NUX.LOCXYY(5)iNUlX                         MAINO^l
      COMMON  CUTiCVT»Cl»QST«NE»IGET»NNl»NU»ITM»Il»I2»I3»I5»IT»MS»NS»II  MAIN042
      COMMON COA(50) .CGA<50) «PAAB(50) .PASA(iJO) »RA( 30 ) »RB ( 30 ) »FN»30)       MAIN043
     1 i IlIHTt 12IHT.I3IHT.I4IHT                                         MAINO<»<*
      DIMENSION U2t30)tV2(30)»TT2(30)»W2(30)»PP12(30)»PP22(30)           MAIN045
      EQUIVALENCE (YY(1 ,1)»U2(1)).(YYl1»2)tV2(D) • (YY(1.6)»PP22<1))       MAIN046
     1  t(YY(li3) »TT2d) ) »(YY( lt«PP2Y(30)»CUX(30)»CUY(30)»CVX«30)»CVY(30)                MA1N053
     3  ,CTX<30).CTY(30).CWX(30)fCWY(30).CP1X(30).CP1Y(30)               MAIN054
                                       15

-------
C
C
C
 4  »CP2X(30)»CP2Y(30)
  EQUIVALENCE  IGXY(1»
  EQUIVALENCE
  EQUIVALENCE
  EQUIVALENCE
  EQUIVALENCE
  EQUIVALENCE
  EQUIVALENCE
  EQUIVALENCE
  EQUIVALENCE
  EQUIVALENCE
  EQUIVALENCE
  EQUIVALENCE
  EQUIVALENCE
UNITS 99*96 FOR
        )»2E1(1»1
CTX  «1
(CGXY(1»4)iCWX  (1
(CGXY(li5)»CPlX(l
(CGXY(1»6J.CP2X(1
 YY  TO  STORE  FOR
                                   ).(GXY(1.7)
                                   •   * NCS
    U3(2) = JMAX
    U3J3)= I MAX
    U3U) » IPOL + 11
    U3(5) » NP1
    U316) « IX
    usm « or
    DO- 703 I = l»20
703 U3II+7) = ITIMES(I)
    U3I28) » XD » loE-5
    WRITE (95    > (Z(I)»I»1»NCS>
MAIN055
MAINOD6
MAIN057
MAIN058
MAIN059
MAIN060
MAIN061
MAIN062
MAIN063
MAIN064
MAIN065
MAIN066
MAIN067
MAIN068
MAIN069
MAIN070
MAIN071
MAIN072
MAIN073
MAIN074
MAIN075
MAIN076
MAIN077
MAIN078
MAIN079
MAIN080
MAIN081
MAIN082
MAIN083
MAIN084
MAIN085
MAIN086
MAIN087
MAIN088
MAIN089
MAIN090
MAIN091
MAIN092
MAIN093
MAIN094
MAIN095
MAIN096
MAIN097
MAIN098
MAIN099
MAIN100
MAIN101
MAIN102
MAIN103
MAIN104
MAIN105
MAIN106
MAIN107
MAIN108
MAIN109
                                        16

-------
   41 00 98 NS'ltJMAX
      DO 98 MS=1»IMAX
      IS e (NS-1) * IMAX + MS
      CALL SDATA
      IF (IS.GT.l) GO TO 90
      Tl « TDEL /(I.424214*01)
      PRINT 335»ITM»OT.T1
      IF 336
 1112 PRINT 31
      GO TO 80
  336 NU1X » Tl
      IFUTM+NU1X.GT.NT)NU1X = NT-ITM
      IF(NTIME.GT.O.AND.ITM+NU1X»GT.NTIM£1NU1X « NTIME-ITM
      NUX = NSTART + NU1X
   90 IFUTM4LE.O) GO TO 47
C    READ FILE 1 FOR RESTART
      READ (98'IS) (XKUII)»I=I»NCR)
      IGONY = IGOGO-3
   47 IF (NTIME.LT.O.OR.IGET.NEtlTM) GO TO 319
      XM » MS
      YM » NS
      XD1 = XD*(XIIN-XM)
      YD1 =-XD»(XJlN-YM)
      XT1* NTIME-IGET
      XTIME « 1./XT1
      00 315 1-ltNPl
      IF (NVCHS(l).NE.l)  GO TO 312
C  COMPUTE NEW INPUT U3»V3
      U3(I   a VARIN(Iil)-GNVU»2»*YDl-GNV< I»1)*XD1
      V3U   = VARIN(I»2)-GNV(I»4)*Y01-GNVII»3)#XD1
      UKI  » U2U )-XTIME*(U3( I)-U2«I) >
      VKI  = V2(N-XT1ME*(V3( I)-V2(I))
  312 IF 
-------
  35 CALL EXCK
     H <= H * .017453293
     RSUMU5)  « XKTINX)
     RSUMI14)  » XKT(l)
  40 CALL BIV
  45 CALL GWC
     STORE INITIAL TIME STEP DATA FOR ALL STATIONS FOR PRINT FILE 3
     IF US.GT.l)  GO TO 46
     MARAY(IXTRA)  * MARAY< IXTRAK1
     PRINT 132. ITM.IXTRA,(MARAY{I)»I»1»IXTRA)
  46 WRITE (95) JRK I ) » 1 = 1 .NCS)          .
     CALL TEMPRT
     PRINT 101»ETA2»DELZ.XETA2.YETA2»CUUX),CV ) *(DZUM1 )/2» >              .
     DO 209 I=2»IX                       •
     K-IX-I+1                                .
     SUM2 = SUM2 + (CUX'(K)+CVY(IO)*{DZ<,K-l.,),+D2(K))/2»
 209 VVEL(K)  « SUM2                      :i  : '
     VVE'L(IX)»0«   .                       ,
     IF(ITM.GT.l)  GO TO 202            /2.
     VVELd) « SUM1                  '
 208 CONTINUE                 •   . "   '    -  »    •*
     VVEL(NX)  =• SUM1 -  (CUX(NX)  + CVY(NX ) ) *
-------
114
116

117
111
129
131
113
119

118
120
121
202 VVEL(IPl) =• 0.0
    VVELIIP2) a
   K(DZUPl) + DZIIP2M/2.)
   • SUM1 = VVELIIP2)
    DO 203 K»IP3»NP1
    SUM1 » SUM1 - (CUXIK)  + CVYIIO )*«DZ(K-1)
    VVELIK) * SUM1
203 CONTINUE
    VVELINX) B SUM1 - (CUX(NX)+ CVY(NX) )MDZ (NP1)/2.)

    IF(IGONY.EQ.l) DELZ=0.0
    IF(NVCHS(4J.NE.l) CALL RAD  -
    CALL TTSO
    IF (NTIME.LT.O) GO TO  117
    DO 116I=1»NP1
    IF  - Ul(I)
    V3II) * 2.*V2(I) - VKI)
    IF(NVCHS(2).NE.1)GO TO 116
    W3(I) =  2«*W2(I)-W1(I)
    TT3(I)  » 2.»TT2(I J-TTKI)
    CONTINUE
    IF (NVCHSll).EQ.l)  GO TO 52
    GO TO (112.111,111»112)»IGOGO
    II - 1
    II «2
    IT-IM2
    I2«IM3
                                              - « 0.0
II - IP1
MAIN225
MAIN226
MAIN227
MAIN228
MAIN229
MAIN230
MAIN231
MAIN232
MAIN233
MAIN234
MAIN235
MA1N236
MAIN237
MAIN238
MAIN239
MAIN240
MAIN241
MAIN242
MAIN243
MAIN244
MAIN245
MAIN246
MAIN247
MAIN248
MAIN249
MAIN250
MAIN251
MAIN252
MAIN253
MAIN254
MAIN255
MAIN256
MAIN257
MAIN256
MAIN259
MAIN260
MAIN261
MAIN262
MAIN263
MAIN264
MAIN265
MAIN266
MAIN267
MAIN268
MAIN269
MAIN270
MAIN271
MAIN272
MAIN273
MAIN274
                                      19

-------
 51
 52
II>=IP2
IT=NM1
I2=NM2
I3 = NX
I5 = IA
CALL CUV
GO TO (51.52)»LY
DTA - 2.*DTA
OTA2 » 2.*DTA2
C5 * 1.5
C6 • 2.
GD2 » .5
LY*2
CONTINUE
      I=1»NP1
 65
 70
701
           • TT2 I)
            U2(
            V2<
            W2(
           » TT3 I)
            U3(
            V3(
            W3(
            = PP12II)
            a PP22U)
              PP23II1
    DO 5'
    TT1C
    UK I
    VIII
    WKI
    TT2<
    U2(l
    V2II
    W2(I
    PP1KI) «
    PP2KI) «
    PP12H) «
    PP22(I) '
    CONTINUE
    ETA1  * ETA2
    IF(NVCHSU).EQ.l)
    TT2(1X) a XT2
    TT2(IP1) => XT2
    CALL  EXCK
    CALL  BIV
    CALL  GWC
    IF(ITM-ICK)94»70»70
    ICK = ICK+ 1TESTP
    RSUMU4) = XKT(l)
    RSUM115) a XKT(NX)
    IF (1S.GT.1)  GO TO 701
    MARAY(IXTRA)  - MARAYlIXTRA)+1
    PRINT 132. ITM.IXTRA,(MARAY(I).I=1.IXTRA)
    CALL  TEMPRT
    PRINT 101.ETA2.DELZ.XETA2.YETA2.CU(IX).CV(IX).IHT.IGOGO
                      XT2 = TT3UX)
101 FORMATI//'   ETA2 «='.E18«8»/'
   1 YETA2 »'»El8.8»/«  CU(.IX) a
   2»I10»/»   IGOGO =' »I10)
    WRITE (95)  (Rill)»I=1,NCS)
 9^f IF(ITM.EQ.NT) GO TO 97
    IF(ITM.NE.NU) GO TO 50
    STORING  COMPUTED VALUES ON DRUM
    WRITE (98'IS) (XKU(I).Ial.NCR)
    DO' 59 1 = 1.NP1
    Tl a U2(I)**2+V2(l)**2
    IF (Tl)  59.59.159
DELZ =• .E18.8,/'
          CV(IX)
                                                    XETA2
                                                   •SE18.
                                                      =l»E18.8i/1
                                                      8»/«
                                                                       MAIN275
                                                                       MAIN276
                                                                       MA1N277
                                                                       MAIN278
                                                                       MAIN279
                                                                       MAIN280
                                                                       MAIN281
                                                                       MAIN282
                                                                       MAIN283
MAIN285
MAIN286
MAIN287
MAIN288
MAIN289
MAIN290
MA1N291
MAIN292
MAIN293
MAIN294
MAIN295
MAIN296
MAIN297
MAIN298
MAIN299
MAIN300
MAIN301
MAIN302
MAIN303
MAIN304
MAIN305
MAIN306
MAIN307
MAIN308
MAIN309
MAIN310
MAIN311
MAIN312
MA1N313
MAIN3U
MAIN315
MAIN316
MAIN317
MAIN318
MAINS 19
MAIN320
MAIN321
MAIN322
MAIN323
                                FOR RESTART OF EACH GRID STATION A
                                                                       MAIN325
                                                                       MAIN326
                                                                       MAIN327
                                                                       MAIN328
                                                                       MAIN329
                                      20'

-------
159 Tl » SQRT(T1J
    JF (Tl.GT.SAVE)   SAVE  »  Tl
 59 CONTINUE
    TDEL = XO/SAVE
  WRITE YY ON DISK USING DIRECT  ACCESS
    I GOG « IGOGO
    WRITE (SDRUM'IS)  ( YIN( I ) » 1=1 »NWSYY)
 97 1F( JTM.EQ.NT.AND.IS.EQ.IGRID)  GO TO  80
    IFUS.EQ.IGRID)  GO TO  98
    ITM = ITM - NU1X
 98 CONTINUE
  SWITCH FILE UNITS  FOR RESTART
    I  = RDRUM
    RDRUM = SDRUM
    SDRUM =» I
    IFJMARAY(IXTRA).NE.O)  IXTRA  »  IXTRA  +  1
    NSTART » NU
    GO TO 41
 80 PRINT 132» ITM»IXTRA.(MARAYm»I«l»IXTRA)
    END FILE 95
    REWIND 95
 99
 31
132
    STOP
    FORMAT
    FORMAT
           <'1RUN STOPPED— NEW  DT  NEEDED')
           ClTIME STEP  STARTING * '»I5.» VALUES
IN MARAY =»»I5/'  MARA
   1Y IS1
335 FORMAT
    END
           ( '  ITM1 1 16 i ' tDT ' »E12.4» • »T1 '
MAIN330
MAIN331
MAIN332
MAIN333
MAIN334
MAIN335
MAIN336
MAIN337
MAIN338
MAIN339
MAIN3'tO
MAIN341
MAIN342
MAIN343
MAIN344
MAI.N345
MAIN346
MAIN347
MAIN348
MAIN349
MAIN350
MAIN351
MAIN352
MAIN353
MAIN354
MAIN355
MAIN356
                                      21

-------
 SUBROUTINE GREAD                                                  GREAOOOO
 INTEGER RORUM»SDRUM»TDRUM                                         GREA0001
 DOUBLE PRECISION A»B»C»CST.DiDTO»DWO.DST»DT1.FA»GWO»PP11»PP12     GREAD002
1   »PP13»PP21»PP22.PP23.SST»TT1»TT2»TT3»TTO»TSC»U2.V2»W1»W2»W3    GREAD003
2   .WO.WSC.XKT.XYY.YY.GTO                                         GREAD004
 COMMON XYY(30»6i5)iA(30)»B<30)iCt30)»CST(30>,D(30)iDTO(30)        GREAD005
1   »DWO(30)»DST(30)»FA<30)»GTOt30)»GWO<30)»PP13(30)iPP23(30)      GREAD006
2   »TT3(30)»W3(30)»SST                                            GREA0007
 COMMON RI(30)»DT1<30)•YY(30.6).SLOPX»SLOPY»HEIGHT»ETA1»ETA2»XETA2»GREA0008
1YETA2»IHT«IANV»IGOG.£TA1NX»ETAINY»CSOUT(2)»CRSiRAA»TOUPRAiH3»CF»CEGREA'0009
2»WS(30)lUSTtCW.HAI»HSI»RANS»RA8NS»RABS»CRNS.TRAUS.XT2
 COMMON XKU(30)»VVEL130)iSRS»RADMX»IGOGO,ROW»XMQ»DEL
1   »XLAM»RSUM(15)iBl»B2
 COMMON PPll<30)iPP21<30) .TTK30) .TTOOO) »T5C(30).W1(30)»WO(30)
1
2
3
4
5
6
7
»WSC(30)»XKT(30)iCUt30)»CV(30)»DTDT<30)»DTTI 30)»U1(30).VI(30)
»ZDL2(30).SOU1(20)»50U2(20)»SH1(20)iSH2(20)»NCLI»I SSI 111 SSI 2
»ITS2<20) »ITS1(20),ECLI<10,4) .LLCI dO ,5 ) »TCLl d6»4 ) »ISTEP< 10 )
fRAIN I(10)»I CUVi20)tXOCU(20)»XOCV(20)iXACU(20)»XACV(20)
»NXN(10)»TTWfDECL»COCOB»ICK»NTFOR.GSF.GFR.DTSF»SF
•PHlR»GD2»ISTR»SOSC»SOAB»XNO»CPH»SPHfPHI»H.1GONY.NTCUV
iZ(30)»ZA(30) »OZ(30) iDS(30) »PA(45)
                                                                GREAD010
                                                                GREAD011
                                                                GREAD012
                                                                GREAD013
                                                                GREADOU
                                                                GREA0015
                                                                GREAD016
                                                                GREAD017
                                                                GSEAD018
                                                                GKEA0019
                                               »COBU5) »COM( 18JGREAD020
 COMMON U3I30)»V3(30)»TBO(30).WBOI30)»CKO(30)»CSW(30) .PSSI30)
1   »E(30»2.2)»F(30»2).FST(30»2)»R(30•2»2)»BR(30 ) iTTI(30) lEC(5 )
2   »TCU5) »LLC(6) >ST^(50) »DSTM50) »DUW150) «OS( 50) »RAI ( 20) »PST(30)
 COMMON ITIMES(20)»IXTRA»MARAY(20).PSFAIN(20)
 COMMON SAVE»TD£L»XDTliDT»XD«OECLX.DCHG,PHIBOT»HWESTtEM,ZWiC5tC6
1  fNX»IX»NT»IMAX»JMAX»NPl»IPl»,NP2»NMl»NM2.IP2»IP3iIMl»IM2iIM3
2  »I4»IA»RDRUMtSDRUM»TDRUM»IGRIDiIMARAiRTIME•IPOL»PI2»CFAR»NTIME
3  »EX2»EX3iEX6»XNV»XNT»BETV.BETT»DT2»DTA»DTA2tG»CP,PI»GAM»GAM2
4  »ROAtALF»XKliXK2»RALF»RC»CCiC32«XK12iSH»HKKiHK2»Al>A2
5  tNWSYY»NTOPl»OELH»    TW»INEWiITAPEoIRAT»INEWC
 COMMON BG»AR.AW»SIG»ATC»SK»IZW»IZWl»IY.IRtLYtNCS»NCR»NLAPiNCL
1   »NTOPtMA.NATAL »LAND »NVAR1iNVAR6 >CPP•ITESTP
 COMMON Tl.T2»T3»U.T5.T6»T7»T8iT9»T10.TlltT12iXIlN»XjlNiTE»T20
2    t  Tl3.TU.T15»Tl6.X01tYDl
3  «IS»RAlNX.ETtAT»STfPT.NUX,LOCXYY(5).NU1X
 COMMON  CUTtCVT»Cl»QST»NE»IGET»NNl»NU»ITMtIl»I2»I3»I5»ITiMS»NS»II
 COMMON COA<50).CGA(50)»PAAB(50)»PASA|50)»RA(30)iRB(30)»FN<30)
1 i I1IHT»I2IHT»I3IHT.HIHT
 DIMENSION U2(30)tV2(30)iTT2(30)»W2(30)«PP12(30).PP22(30)
 EQUIVALENCE (YY( 1 tl) »U2 (1) >»I YY( 1 »2 ) t.V2( 1 > ) i (YY( 116) »PP22H) )
1  •(YY(l»3>»TT2(l))»(YY(l»PP1Y(30)
2  »XP2(30).PP2Y(30)iCUX(30)»CUY(30)«CVX(30)»CVY<30)
3  »CTX(30) «CTY(30)»CWX<30) iCWY(30) iCPlXOO) >CP1Y(30)
4  iCP2X(30)«CP2Y(30)
 EQUIVALENCE
 EQUIVALENCE
 EQUIVALENCE
 EQUIVALENCE
 EQUIVALENCE
          (GXY(lfl)iZEl(l.l) ). »ZE2dil
          (PGXY(1.1),PUX(1)).  (PGXY(1»7)»PUY(1)
          (PGXYU»2> »PVX(1) ) ,  (PCXYd.8) »PVY(1)
          (PGXY(1.3)»PTX(1)) •  (PGXY(1,9).PTY(1)
          (PGXY(li4)iPWX(l) ) »  (PGXY(l.lO) iPWYd
                                                                GREAD021
                                                                GREAD022
                                                                GREAD023
                                                                GREAD02
-------
    EQUIVALENCE
    EQUIVALENCE
    EQUIVALENCE
    EQUIVALENCE
    EQUIVALENCE
    EQUIVALENCE
    EQUIVALENCE
    EQUIVALENCE
                                 IPGXYd.m.PPlYll)
                                 «PGXY»ZDIX
-------
     PRINT 122. (ZDIY(1}»!«1»I21)
     DO 418 I=1»NP1
     Tl « Z(I)
     IF (I-IX) 417t416.417
 416 Tl * T1-. 00001
     GO TO 1418
 417 IF (I-IP1) 1418.2418.1418
2418 Tl » T1+. 00001
1418 CALL XINEAR ( Tl »Zl »2 »IZ1 »L»ZD1X,GXY( I ,K) »ZDI Y»GXY{ I »K+6 )
    1  .T4.T4.T4.T4)
     IF(K.LE,4) GO TO 231
     GXY(I.K)  a GXY(I»K)  / ROA / 100.
     GXYU.K+6) = GXYU.K+6) /ROA / 100.
 231 PGXY(IiK) = GXYU.K)
     CGXY(I.K) «= GXY(IiK)
     PGXYU.K+6) = GXYU.K+6)
     CGXYU.K+6) a GXYd.K+6)
 418 CONTINUE
 420 CONTINUE
     READ 119»SOAB.SOSC»XNO»COCOB
     PRINT 119«SOA3.SOSCiXNO.COCOB
     IY • IP1
     NP2-NX+2
     NM1-NX-1
     NM2»NX-2
     IP2-IX+2
     lP3»IX+3
     IM2»IX-2
     IM3 " IX-3
     IA»NM1-1P1
     EX2»-l./2.
EX3
EX6 «
XNV
XNT
BETV
           1./3.
           -1./6.
           .5
           1.5
            10.
     BETT » 10. /3.
     DT2 « 2.*DT
     G • 980.
     CP • .239
     PI a 3.1415927
     GAM a .98E-4
     GAM2 a 2«*GAM
     ALF « -3.
     XK1 » .4
     XK2a.l4
     RALF a -l./ALF
     RC « RALF/7*
     T2 • (1. + ALF*RC)*#2
     T3 « RC*»EX3
     CC a 3««T3*T2
     T4 « 3./CC
     C32 « T4«*<-.5)
GREAD110
GREAD111
GREAD112
GREAD113
GREAD114
GREAD115
GREAD116
GREAD117
GREAD118
GREAD119
GREAD120
GREAD121
GREAD122
GREAD123
GREAD124
GREAD125
GREAD126
GREAD127
GREAD128
GREAD129
GREAD130
GREAD131
GREAD132
GREAD1.33
GREAD134
GREAD135
GREAD136
GREAD137
GREAD138
GREAD139
GREAD140
GREAD141
GREAD142
GREAD143
GREAD144
GREAD145
GREAD146
GREAD147
GREAD148
GREAD149
GREAD150
GREAD151
GREAD152
GREAD153
GREAD154
GREAD155
GREAD156
GREAD157
GREAD158
GREAD159
GREAD160
GREAD161
GREAD162
GREAD163
GREAD164

-------
     T4 » T4««1.5
     XK12 » XK1**2
     SH « XK12»T4
     HKK » SH»XK2»*2/XK12
     HK2 « SH/XK12
     HKK*HKK*10.
     CPP«-CP»1.0E06
     SIG«1.354E-12
     AW=»1000.*G
     ARa2.87E+06
     NTOP»NLAP+NP1
     ATC '» .001
     SK » 0.86933E-06
     PI2 » PI # 2.
     DELH = IDT/86400.) » PI2
            » DECL / .017453293
           = DCHG  / .017453293
           » H     / .017453293
           126. PDECL. PDCHG»EM»PRINH
            I"i,NX
                      Z(!)
   1 PDECL
     PDCHG
     PRINH
     PRINT
     DO 117
     Tl « (
     ZAU) « A8StI»ltNPl)»ZW
     CALL EXIT
 132 IZW1»IZW-1
     T20»ALOG(ZUZW)/ZUZW1))
     Al « ALOGI1950.  /Z(IZW1))/T20
     A2 « ALOG(Z(IZW)/1950.   1/T20
  99 RETURN
 100 FORMAT(18A4)
 101 FORMAT(1X18A4///)
 110 FORMAT(14I5)
 111 FORMAT (4H NX«»I3/4H IX»»I3/4H NT=»I3/7H
 112 FORMAT (11H  XlIN   » F10.4/11H   XJIN
    1/11H DELTA T «  F6.1/10H  DISTANCE".F7.2)
 119 FORMAT(6F12.4)
     FORMAT (6E12.5)
     FORMAT COX-GRAD    S6E12.5)
     FORMAT COY-GRAD    S6E12.5).
     FQRMAT «'0'i3A^(' GRADIENTS—INPUT VALUES1/
120
121
122
123
126
                                                                  GREAD165
                                                                  GREAD166
                                                                  GKEAD167
                                                                  GREAD168
                                                                  GREAD169
                                                                  GREAD170
                                                                  GREAD171
                                                                  GREAD172
                                                                  GREAD173
                                                                  GREAD174
                                                                  GREAD175
                                                                  GREAD176
                                                                  GREAD177
                                                                  GREAD178
                                                                  GREAD179
                                                                  GREAD180
                                                                  GREAD181
                                                                  GREAD182
                                                                  GREAD183
                                                                  GREAD184
                                                                  GREAD185
                                                                  GREAD186
                                                                  GREAD187
                                                                  GREAD188
                                                                  GREAD189
                                                                  GREAD190
                                                                  GREAD191
                                                                  GREAD192
                                                                  GREAD193
                                                                  GREAD194
                                                                  GREAD195
                                                                  GREAD196
                                                                  GREAD197
                                                                  GREAD198
                                                                  GREAD199
                                                                  GREAD200
                                                                  GREAD201
                                                                  GREAD202
                                                                  GREAD203
                                                                  GREAD204
                                                                  GREAD205
                                                                  GREAD206
                                                                  GREAD207
                                                                  GREAD208
                                         GRID  »»I3)                GREAD209
                                          F10.4/11H  PHI      «  F8.2GREA0210
                                                                  GREAD211
                                                                  GREAD212
                                                                  GREAD213
                                                                  GREAD214
                                                                  GREAD215
                                            HEIGHTSIM)S11F10.2)  GREAD216
     FORMAT! 13H DECLINATION iE12i4/8H CHANGE  .E12.4/  36H  INFRARED
    1IVITY OF THE SURFACE .E12.4/12H HOUR  ANGLE  iE12.4)
1000 FORMATUH1.'   ZW VALUE IS INCORRECT ---  HEIGHT ARRAY  FOLLOWS1//
1212
FORMAT
END
            I'OTIME STEP FOR RADIATION IS'tFlO.2*1  MINUTES1)
EMISSGREAD217
     GREAD218
     GREAD219
     GREAD220
     GREAD221
     GREAD222
                                       25

-------
    SUBROUTINE RAD                                                      RADOOO
    SUBROUTINE TO COMPUTE TEMPERATURE CHANGES DUE TO RADIATION          RAD001
    INTEGER RDRUM.SDRUM.TDRUM                                           RAD002
    DOUBLE PRECISION A»8»CiCST.D.DTO.DWOiDST»DT1.FA.GWO.PP11iPP12       RAD003
   1   »PP13»PP21»PP22.PP23.SST.TTl»TT2»TT3»TTO»TSCfU2»V2»Wl.W2.W3      RADOOO
   2   »WO»WSC»XKT»XYY»YY.GTO                                           RAD005
    COMMON XYY(30.6»5).A<30).8(30)»C(30)»CST<30),D(30).DTOI30)          RAD006
   1   »DWO(30)»DST(30)»FA(30)»GTO(30)tGWO(30).PP13(30)»PP23(30)        RAD007
   2   »TT3(30)iW3(30)»SST                                              RAD008
    COMMON RI(30).DTI(30).YY(30»6)»SLOPX.SLOPY.HEIGHT.ETA1»ETA2»XETA2.  RAD009
   1YETA2»IHT»IANV.IGOG»ETAINX»ETAINY»CSOUT<2) .CRS»RAA»TOUPRA'»H3 .CF.CE  RAD010
   2»WS(30).UST,CW»HAI»HSI»RANS«RABNS.RABS»CRNS»TRAUS»XT2               RADOH
    COMMON XKU(30)»VVEL(30)iSRS.RADMX»IGOGO.ROW.XMQ.DEL                 RAD012
   1   »XLAM.RSUM(15)»EltB2                                              RAD013
    COMMON PP11{30)»PP2K30) »TT1 ( 301 »TTO( 30) .TSC ( 30 ) »W1 ( 30 ) »WO(30)      RAD014
   1   »WSC(30)»XKT(30)»CU(30)»CV(30)»DTDT(30)»DTT<30)»U1(30).VI<30)     RAD015
   2   »ZDL2«30)«SOU1(20).SOU2(20),SHl(20)»SH2(20),NCLl.I SSI 1.1 SSI 2     RAD016
   3   »ITS2<20) ,ITS1<20).£CLI(10»4)»LLCI<10,5>»TCLI(10.4)»ISTEP(10)     RAD017
   4   .RAIN I(10)»I CUV(20).XOCUI20)»XOCV(20)»XACU(20)»XACV(20)          RAD018
   5   tNXN(10)»TTW.DECL.COCOB.ICK»NTFOR,GSF.GFR»DTSF»SF                 RAD019
   6   »PHIR.GD2.ISTR»SOSC»SOAB»XNO.CPH.SPH.PHI»H»IGONY.NTCUV           RAD020
   7  »Z(30) »ZA(30) .02(30) »DS(30)»PA(45) .TAU5) »QAU5) iCOB(45) .COM(18)  RAD021
    COMMON U3(30)»V3«30)»TBO(30)»WBO(30).CKO(30)»CSW(30)»PSS<30)        RAD022
   1   tE(30.2.2).F(30.2)»FST(30»2).R(30.2.2)»BR(30).TTI(30),EC(5)      RAD023
   2   iTCL(5) .LLC(6) .5TM50) »DST^(50) »DUW(50) »QS (50) .RAI (20) »PST(30)   RAD024
    COMMON ITIMES(20).IXTRA»MARAY(20)»PSFAIN(20)                        RAD025
    COMMON SAVE.TDEL.XDT1»DT»XD.DECLX.DCHG.PHIBOT.HWEST.EM»ZW»C5»C6     RAD026
   1  »NXtlX.NT»IMAX.JMAX»NPl»lPl»NP2.NMl.NM2»IP2.IP3»IMl»IM2»IM3       RAD027
   2  »I4.IA»RDRUM«SDRUM.TDRUM»IGRID»IMARA»RTIME»IPOL.PI2.CFAR»NTIME    RAD028
   3  »EX2»EX3»EX6»XNV.XNTfBETV.BETT.DT2.DTA.DTA2.G.CP.PI.GAM.GAM2      RAD029
   4  tROA»ALF.XKl.XK2,RALF»RC»CC.C32.XK12»SH.HKK;.HK2tAl»A2              RAD030
   5  »NWSYY»NTOPl»DELHi   TWi1NEW»I TAPE.IRAT.INEWC                     RAD031
    COMMON BG»AR.AW.SIG»ATC»SK.IZW»IZW1»IY.IR.LY.NCS.NCR»NLAP»NCL       RAD032
   1   .NTOP»MAiNATAL»LAND»NVARl»NVAR6»CPP»ITESTP                       RAD033
    COMMON Tl»T2.T3.T4,T5,T6.T7»T8,T9.T10.Tll»T12.XllN»XJlNiTE.T20      RAD034
   2    »  T13»T14»T15.T16.XD1»YD1                                      RAD035
   3  .IS.RAINX.ET.AT.ST.PT.NUX.LOCXYYI5).NU1X                          RAD036
    COMMON  CUT»CVT.C1.0ST«NE»IGET»NNl«NU»ITM.Il.I2.l3»I5.IT.MS»NSfII   RAD037
    COMMON COAI50)»CGA(50)»PAAB(50)»PASA(50)»RA(30).RBI 30)»FN(30)       RAD038
   1 » IlIHT»I2IHTtI3IHT.I4IHT                                          RAD039
    DIMENSION U2(30)»V2(30).TT2(30).W2(30),PP12«30).PP22<30)            RAD040
    EQUIVALENCE (YY(1»1)»U2(1))»(YY(1.2)»V2(1))»ISTEP.1»NTFOR.  LtRAINI»RAINX»T4»T4»T4»T4»T4»T4)     RAD051
    NCL " NXN(L)                                                        RAD052
    DO 934 I«1»NCL                                                      RAD053
    CALL LINEARUTMsI STEP »1»NTFOR.L»ECLI( I.I ) .EC (I) »T4 »T4 .T4.T4.T4 ,T4 )  RAD054
                                       26

-------
  934
 1108
  107
C  FOLLOWING
 1407 I COM
  112

 1505

 1507
 1408
      TCL(I) « TCLKLiI)                                                  RAD055
      LLC(I) « LLCI(L»I)                                                  RAD056
      CX » 1. -EC(NCL)                                                    RAD057
      LLCtNCL+1) » 61                                                     RAD058
      DO 107I=IM1.NP1                                                     RA0059
      TA(I)=TT2(I)                                                        RAD060
      QA(I)«W2m                                                         RAD061
      COB(I) a PP12(I)*COCOB                                              RAD062
      CONTINUE                                                            RA0063
             RECOMUTES EMISSIUIY H20.C02 ATEACH STATION WHEN XO.GT.50KM   RAD064
             -1                                                           RAD065
      IF (XO.GT. 50tE5) GO TO 112                                         RAD066
      IF(IS.NE.l) GO TO 1507                                              RA0067
      INEWC > 1NEWC+1                                                     RAD068
      IF UNEWC-INEW) 1507il505»1505                                      RAD069
      INEWC * 0                                                           RA0070
      ICOM « 1                                                            RAD071
      CONTINUE                                                            RAD072
      Cl = 3.7943/PAUP1)                                                 RAD073
C  COMPUTE PATH LENGTHS«ST4iQS                                            RAD074
      TTW * TW                                                            RAD075
      DO 104 LMP1.NP1                                                    RAD076
      K-L-IX                                                              RAD077
      IF UCOM) 501.501.702                                               RAD078
  702 DUW(K)«(PA(L)-PA(L+1))*(QA(L)+QA                                   RAD082
      IF (IPOL) 499.499.709                                               RAD083
      CGA(K) « 0.                                                         RAD084
      PAAB(K) •» 0.                                                        RAD085
      PASA(K) =» 0*                                                        RAD086
      GO TO 502                                                           RAD087
      T8  » CCOB(L}+COB(L+l))/2.*DZ(L)«l.E-5                              RAD088
      CGA(K) ~ T8»1»66«XNO                 '                               RAD089
      PAAB(K) « T8»SOAB                 -      .                            RAD090
      PASA(K) » T8*SOSC                                                   RAD091
      ST4CL) " SIG*TA(L)#»4                                               RAD092
      DST4(L) » SIG#((TA(L)+TA(L+lJ)/2.)*«4                               RAD093
      CXPA = 3»7943/PA(L»                                                 RAD094
      TEX » 3.0 + 7t5 «(TA{L)-273tl6)/(TA(L)-35.66)                       RAD095
      OSJLI =« CXPA * 10.0«*TEX                                            RAD096
      CONTINUE                                                            RAD097
      KA = NP1-IX   +1                                                    RAD098
      IF (ICOM.EO.l) CALL INFRAI(DUW.COA.KA.NATAL)                         RAD099
      IF (ITM-1) 212.212.297                                              RAD100
  212 PRINT 213. (PA(I).QSII).         I-IY.NPD                          RAD101
C  **# SOLAR RADIATION COMPUTATIONS                                       RAD102
  297 T3 »- COS(H)                                                         RADIOS
      T4 « COS(DECL)                                                      RAD104
      T6 * SIN(DECL)                                                      RADIOS
      T5 « SPH*T6+CPH»T3»T4                                               RAD106
      COSZ » T5                                                           RAD107
      H * H «• DELH                                                        RADIOS
      IF(H.LE.PI) GO TO 2                                                 RAD109
  501
  499
  709
  502
  104
                                         27

-------
     H = H-PI2
     DECL" DECL+ DCHG
     POECL » DECL/.017453293
     PRINT 299iITM»PDECL
 299 FORMAT RAI(I)«0»0
     T100 • -AK*ZA(I-1)*SECZ/100.
     IF(T100.LE.-40.0) T100 = -40iO
              « RAI(IX)#EXP(T100)
              RAIU) - RAKI-1)
              RAI(l)
                                      0*0
  25
    DTR(I)
    DTR(l)
    DO 27I=1»IM1
    M=IX-I+1
 27 DTDT(I) = DTR(I) / DS(M)
    RH * RAI(IX) - RAKIMU
 INFRARED SURFACE FLUX
 99 CALL INFRA (1 »DST4( IP1) »ST4( IP1) »LLC»EC»DTT iPAUPl) «RA»RB»CGA)
    RAA » RA(D + RADMX
    RSUMJ6) <= DT*RA(1) '+ RSUM(6)
 #*» HEAT BALANCE
    LOOP « 0
    TG1= TAIIP1)
    IF1TG1- 273.16)855»855»860
855 XLT a 677*
    GO TO 861
860 XLT s 597.3 - 0.57#{TG1-273*16>
RAD110
RAD111
RAD112
RAD113
RAD114
RAD115
RAD116
RAD117
RAD118
RAD119
RAD120
RAD121
RAD122
RAD123
RAD124
RAD125
RAD126
RAD127
RAD128
RAD129
RAD130
RAD131
RAD132
RAD133
RAD134
RAD135
RAD136
RAD137
RAD138
RAD139
RAD140
RAD141
RAD142
RAD143
RAD144
RAD145
RAD146
RAD147
RAD148
RAD149
RAD150
RAD151
RAD152
RAD153
RAD154
RAD155
RAD156
RAD157
RAD158
RAD159
RAD160
RAD161
RAD162
RAD163
RAD164
                                        28

-------
861
862
                         862
863

864
865
532
  74
  75
 870
 871
 199
 200

 105

 186
1106
 191
 192
 184

 193

 202


 203
T5 « 1. / (EM * SIGJ
IF(RAINX.GT.O) GO TO
TRW » TAUP1)
GO TO 865
TWBAR » 0.
NC « 0
RAINFALL THROUGH LAYER COMPUTATION
DO 864I-IP2»NP1
ZWS " Z(I)
IFIZW.GT.ZWS.ANO.ZWS.GT.O, )  GO TO 863
SN « NC
TRW = TWBAR/SN             -----
GO TO 865
NC = NC+1
TWBAR = TWBAR + ( TA( I )-XLT»l»E-03/CP * (QS( I)-QA( I ) ) )
CONTINUE
ET1 » -.001 * ROA * XKT(IPl)
N » 1
ATI « -ROA * CP * XKTJIP11
ST1 » ROW * CW * XKT(IMl)
CONTINUE
ET " ET1 * <(W2(IP2) - W2(IPD)
AT » ATI * ( (TAUP2) - TA(IPD)
ST » ST1 * UTAIIP1) - TA(IMl))
RAIN EFFECT TERM  -PT-
PT » «935#RAINX*(TRW-TA( IP1) )
T4 a T5 *
-------
181
                 + 1
884
 882
  97
 150
                                   / (TG-35.66)
      LOOP « LOOP
      TG2 =» TG
      IF(LOOP-25)884»884»97
      TEX = 3.0 + 7.5 * (TG-273.16)
      OSG » C1*10.0**TEX
      W2(1P1) = QSG*XMQ+(1.-XMQ)*W2(IP2)
      TA(IP1> » TG
      GO TO 532
      CONTINUE
      IF (W2(IP1).GT.QSG) W2RH» SRS»TG FOLLOW »/8E12. 4)
  404 1X1 » IX+2
  405 II « NP1-IX
C  ***  INFRARED ATMOSPHERIC COOLING
      CALL INFRA(NX»DST4(IPl),ST4{IPl),LLC.EC»DTTtPA(IPl)»RA»RB»CGA)
 1607 DO 1621 1«IX1»NP1
      L « I-IX
 1621 DTIII) =« DTDTU)+DTT(L)
      DO 4999K»1»IM1
 4999 DTKK) = O'TDT(K)
      TSCUX)     TG      TTO(IPl)
      TSC(IPl) « TSCUX)
    .  TEX » 3.0 + 7.5 * (TG-273.16) / (TG-35.66)
      QSG » C1*10«0**TEX
      W2IIP1) « QSG
      W2(IP1)»W2UP1)#XMQ-K1.-XMQ)#W^(IP2J
      WSCUP1) = W2(IP1)-WO(IP1)
C  RADIATION AND HEAT BALANCE SUMS
                                    XLT
RSUM1
RSUM(
RSUMI
1
2
3
)
)
)
=
n
s
RSUM(4) =
RSUM4
RSUMI
RSUM(
RSUM(
^
7
8
9
4
)
)
)
a
n
a
a
RSUM<1)
RSUM(2)
RSUM13)
RSUMI4)
RSUM(5)
RSUM(7)
RSUMI8)
RSUMI9)-
+
+
+
+
+
+
+
t-01
DT
DT
DT
DT
DT
DT
DT
r*(
*
*
*
#
*
*
*
TE-
ET
AT
ST
PT
RH
*




RADMX
TG**4
TOL
JPR,
                                    * SIG * EM
     K «. NP1-IX + 1
     RSUM(10)» RSUM(10)+DT»(RA(K)-RB(K))
     XT2 « TSC(IX)
    RANS «
    RABNS*
    RAOS =
    CRNS =•
    TRAUS=
    DO 5000
             RA(K) * 1.E3
             RB(K) * 1.E3-
             RB(1) # 1.E3
             TE * 1.E3
             (RB(K)-RA(K)
               I=1»NP1
                           CRS*SRS) * 1.E3
     TT2(I)=TSC(I>
5000 W2U)=WSC(I)
     HA I = AT
     HSI« ST
     CE » ET - RAINX
     RETURN
     END
RA0220
RAD221
RAD222
RA0223
RAD224
RAD225
RA0226
RAD227
RAD228
RAD229
RAD230
RAD231
RAD232
RA0233
RAD234
RA0235
RAD236
RAD237
RAD238
RA0239
RAD240
RAD241
RAD242
RAD243
RAD244
RAD245
RAD246
RAD247
RAD248
RA0249
RAD250
RAD251
RAD252
RAD253
RAD254
RAD255
RAD256
RAD257
RAD258
RAD259
RA0260
RAD261
RAD262
RA0263
RAD264
RAD265
RAD266
RA0267
RAD268
RA0269
RAD270
RA0271
RAD272
RAD273
RAD274
RAD275
RAD276
RAD277
                                        30

-------
     SUBROUTINE EXCK
     INTEGER RDRUM.SDRUM.TDRUM
     DOUBLE PRECISION A.B.C»CST»D*DTO,DWO»DST»DT1»FA»GWO»PP11»PP12
    1   •PPl3»PP21»PP22»PP23»SST»TTl»TT2»TT3»TTO»TSCiU2»V2»WliW2»W3
    2   .WO.WSCtXKT.XYYiYY.GTO
     COMMON XYY(30f6»5)»A<30).B<30)»C(30)»CST(30)iD(30)»DTO(30)
    1   »DWOI30) »DST(30J iFA I 30) »GTOOO) »GWO(30) »PP13(30) »PP23(30)
    2   .TT3(30)»W3(30)»SST
     COMMON RIOO) fDTlOO) »YYC30»6) iSLOPX tSLOPY iHE IGHT «ETA1 »ETA2 »XETA2 »
    lYETA2»lHT»lANV»IGOG»ETAINXtETAINY.CSOUT(2) »CRS»RAA »TOUPRA,»H3 »CF tCE
    2»WS(30)»UST»CW»HAIfHSItRANS.RABNS»RABS»CRNS»TRAUS»XT2
     COMMON XKUI30) »VVEL<30)»SRStRADMX*IGOGO.ROW»XMQ»DEL
    1   »XLAM»RSUMU5) »B1»B2
     COMMON PP11J30)»PP21(30)»TT1<30)«TTO(30)»TSC(30)»Wl(30)»WO(30)
    1   »WSC(30)»XKT(30).CU(30).CV(30).DTDTOO)»DTT(30)lUl(30)»V1(30)
    2   tZDL2(30).SOUl(20)»SOU2(20)»SH1(20)»SH2(20)»NCLl»I SSIliI SSI 2
    3   .ITS2I20)  iITSl(20)»ECLl(10,4),LLCI(10,5)»TCLniO»4),ISTEP(10)
    k   »RAINI(10)fI CUV(20)»XOCU(20)»XOCV(20).XACU120).XACVI20)
    5   fNXN(lO) iTTWtDECL.COCOB»ICK»NTFORfGSF»GFR»OTSF»SF
    6   »PHIR»GD2»ISTRtSOSC»SOAB«XNO»CPHtSPH.PHl»HiIGONY«NTCUV
    7  »Z(30)iZA(30)»DZ(30)»DS(30)»PA(45)»TA(45)»QA(45)»COB(45)»COM(18)
     COMMON U3I30)»V3(30)»TBO(30)»WBO(30)»CKO(30)iCSW(30)»PSS(30)
    1   ,E(30i2i2) »F(30»2) tFST(30»2) »R(30»2»2) »OR<3-0) »TTI (30) »EC(5)
    2   »TCL(5)»LLC(6)»ST4(50).DST4150)iDUW(50)»QS(50)»RAI(20)»PST(30)
     COMMON I TIMES(20) i JXTRA.MARAY(20)»PSFAIN(20)
     COMMON SAVE»TDEL»XDT1»DT.XD»DECLX»DCHG»PHIBOT»HWEST»EM»ZW»C5»C6
    1  iNX»IX»NTiIMAX.JMAX«NPl»IPl.NP2tNMl.NM2»IP2»IP3»IMl»IM2»IM3
    2  »I4»IAtRDRUMiSDRUM*TDRUM»IGRlD»IMARA»RTIMEiIPOLiPI2»CFARiNTIME
    3  t£X2»EX3.EX6.XNVfXNTiBETV.BETT»DT2tDTA,OTA2»G»CP,PI,GAM«GAM2
    4  •ROA»ALF»XKlfXK2»RALF»RC»CC»C32.XK12tSH»HKKiHK.2iAl»A2
    5  •N'A'SYY.NTOPlfDELHt   TWt INEWiITAPEt IRATi INEWC
     COMMON BG»AR,AW.SIG.ATC»SK.I2WiIZWl»IY»IR.LY»NCS»NCR»NLAP«NCL
    1   »NTOPtMA»NATAL»LANDfNVARl»NVAR6»CPPiITESTP
     COMMON Tl.T2iT3»T4tT5»T6iT7»T8»T9»TlO.Tll,T12.XIIN»XJlNiTE»T20
    2    i   Tl3»T14.Tl5iTl6»XDl.YDl
    3  i!S»RAINX»ETfATiST.PT.NUX.LOCXYY(5)iNUlX
     COMMON  CUTiCVTiCl»QSTiNE»lGETiNNl»NU»ITM»Il»I2«l3tI5»IT»MS»NSiII
     COMMON COA(50)iCGA(50)»PAAB(50»«PASA(50)»RA(30)«RB<30)iFN(30)
    1 i I1IHT»I2IHT,13IHT»I4IHT
     DIMENSION U2«30)»V2(30)»TT2(30)iW2<30)»PP12(30)»PP22(30)
     EQUIVALENCE  ( YY( 1,1) ,U2 ( 1) ) . ( YY( 1,2 ) ,.V2( 1) ) »( YY (1.6) »PP22(1)J
    1  »(YY(1»3)»TT2(1) )»(YY(l»4)»W2d) )»(YY(1»5) »PP12(D )
     DOUBLE PRECISION AAI9)
     PST  AND  PSS  TABLES FOR TALOP  REPLACED BY -AA-
     DATA AA/0.79701864»0.131710842E-03»-0«611831499E-07».588194023E-01
    X»-0.25310441E-02»0.287971530E-05»-0.81i.Or389187483E-04,
    X.47660041E-04/
3000 DO 1  I*1»NP1
     IF (DABS(U2(I )).LT.< l.E-35))
     IF (OABS(V2( I )).LT.( l.E-35))
  86 T1=U2(I)**2 + V2(I)**2
     WSII )  =• SQRT(Tl)
   1 CONTINUE
     IFIXLAMI106.105*106
 105 W9«WS( lZW)*Al-*-WS(I2Wl)*A2
U2(I)=0.
V2(I)-0*
EXCKOOO
EXCK001
EXCK002
EXCK003
EXCK004
EXCK005
EXCK006
EXCK007
EXCK008
EXCK009
EXCK010
EXCK011
EXCK012
EXCK013
EXCK014
EXCK015
EXCK016
EXCK017
EXCK018
EXCK019
EXCK020
EXCK021
EXCK022
EXCK023
EXCK024
EXCK025
EXCK026
EXCK027
EXCK028
EXCK029
EXCK030
EXCK031
EXCK032
EXCK033
EXCK034
EXCK035
EXCK036
EXCK037
EXCK038
EXCK039
EXCK040
EXCK041
EXCK042
EXCK043
EXCK044
EXCK045
EXCK046
EXCK047
EXCK048
EXCK049
EXCK050
EXCK051
EXCK052
EXCK053
EXCK054
                                        31

-------
  401 H8AR=1.54165E~04#-ZA( I )*2.*PI*DEL/HBAR
      IF (T24+75.1  300»301»301
  300 CSW(I)=0.
      GO TO 100
  301 CSW(1)=T23*T22*EXP
  101 CONTINUE
  409 DO 102  I=IP1»NX
      T26 = ZAdl+HBAR/2.
      CKO(I)=XK12*   1HT -  1
      IFUMA.EQ.O)  IMA»1
      1IPP1 » IP1-IMA  +  1
      GO TO(4l2*413«413i412)»IGOGO
  412 IMA » IP1
      1IPP1 = IP1
      J2 «  NX
  413 DO 41 J=IMA»1P2»1IPP1
      DO 40 I=JiJ2
      Tl =  (_U2«H-U  - U2(I))/DZ(I)
      IF~TATS(T1> «LT.(l.E-35))   Tl  "  0*
  131 Tl »  Tl**2
  132 T2 =  «V2(I+1)  -V2II))/DZ(I)
      IF (ABSJT2) .LT.U.E-35) )   T2  »  0*
  141 T2 «  T2#*2
  142 T3 *  Tl + T2
      XCS =  SQRT
-------
    4 CL =  CL+GAM+GTOU )+.00061#TB*( (W2(1+1)-W2(1 ) )/OZ( I )+GWO(I))
      T7 =  TB»T7
      Tile  G*CL/T8
      T12 = HK2#CKOU)
      TEST  = RALF
      GO TO 8
:   OCEANIC
   •6 SS =  (W2(I+l)+W2m)/2«+WBO(l)
      TTB=  TB-273.16
      PST(I) «  AA(4)+2t*AAm*TTB+AA(5)*SB    +3.*AA(9)*TTB**2 +
     X 2.«AA(8)*SB   *TTB  +  AA(6)#SB   **2
      PSS(I) =  AA(1)+AA(5)*TTB+2.*AA(2)*SB    *AA(8)*TTB#*2+2.*AA(6)*
     X SB   *TT8 + 3.*AA(3)*S8    **2
      IF (SB.LE.O)  PSSdlsO.
      T4 «  PST(I)«CL+PST(I)#GTO(I)
      T5 »  PSS(I)*(W2U-H) - W2(I) J/DZ«1)+PSS(I)*GWO(I)
      CL »  -.001*(T4+T5)
      Til = G*CL
      TEST  = 1.E16
      T12 * HK2 * ZDL21I)
    8 IF(T7)1003.1003.1004
1003 IF (CL) 35.19.10
1004 IF (CL) 1030.19.1031
   19 RI(I) » 0.
      GO TO 15
I      CHECK MAGNITUDE OF CLID/T7  TO RESTRICT OVERFLOW  EXCEPTION
1030 CLL1  = ABS(CL)
      CLL=ALOG10(CLL1)
      GO TO 1032
1031 CLL  - ALOGIO(CL)
1032 T7L«ALOG10«T7>
      CHECK1 =  CLL-T7L
      IF(CHECK 1-13.11024.10.10
1024 RKI)= G*CL/T7
      IF(RI(I)-T£ST)15.15ilO
   10 RKI) » TEST
   15 IFCRKI ) 125.20.20
:   RI G.T.  ZERO
   20 IF(1-IX)21»21»22
:   OCEANIC
   21 EV =  BETV
      ET »  BETT
      XV «  -XNV
      XT «  -XNT
      GO TO 23
:   ATMOSPHERIC
  22
  23
     ALF
     ALF
     2.
     2*
     (1.
     (1.
XKU(I)  »
XKT(l)  =
GO TO 40
EV
ET
XV
XT
T8
T9-
+ EV*R1(IJ »*#XV
+ ET*RKI ) )#»XT
T6*T8
T6#T9
EXCK110
EXCK111
EXCK112
EXCK113
EXCK114
EXCK115
•EXCK116
EXCK117
EXCK118
EXCK119
EXCK120
EXCK121
EXCK122
EXCK123
EXCK124
EXCK125
EXCK126
EXCK127
EXCK128
EXCK129
EXCK130
EXCK131
EXCK132
EXCK133
EXCK134
EXCK135
EXCK136
EXCK137
EXCK138
EXCK139
EXCK140
EXCK141
EXCK142
EXCK143
EXCK144
EXCK145
EXCK146
EXCK147
EXCK148
EXCK149
EXCK150
EXCK151
EXCK152
EXCK153
EXCK154
EXCK155
EXCK156
EXCK157
EXCK158
EXCK159
EXCK160
EXCK161
EXCK162
EXCK163
EXCK164
                                        33

-------
    25  IF(RKI)  +  RC)35»35»30
 C   RI  G.T. -RC. AND  L.T. ZERO
    30  T10 =  1.  -  ALF*RI(I)
       XKU(I)  »  T6/T10*»2
       XKTIII  *  XKU(I)/T10
       GO TO  40
 C   RI  L.E. -RC
    35  Til *  ABS(Tll)
       XKT(I)  =  T12*SQRT«T11)
       IF
-------
 SUBROUTINE 01 V
 •INTEGER RORUM»SORUM»TORUM
 DOUBLE PRECISION A.B.C »CST .D.DTO.DWO.DST »DT1 »FA .GWO.PP11 iPP12
 1    »PP13iPP21»PP22»PP23iSSTtTTl»TT2tTT3»TTO»TSC»U2tV.2tWl»W2»W3
 2    iWO.WSC»XKT»XYY,YY»GTO
 COMMON XYY(30»6»5).A(30) »B ( 30 ) »C < 30 ) »CST ( 30 ) »D( 30 ) .DTOI30)
 1    tDWOOO) »DST(30)»FA(30) »GT0130) .GWOJ30) »PP13(30) »PP23(30)
 2    »TT3(30) »W3(30) »SST
 COMMON RI (30) »DT1 ( 30 ) » YY ( 30»6 ) .SLOPX.SLOPY .HE IGHT »ETA1 «ETA2 »XETA2 »
 1YETA2.IHT»IANV»IGOG»ETAINX»ETAINY»CSOUT(2) .CRS..RAA.TOUPRA.H3 »CF »CE
 2»WS(30) »UST»CWiHAI »HSI .RANS.RABNS.RABS .CRNS.TRAUS »XT2   • '
 COMMON XKUI30) iVVELOO) » SRS.RADMX » IGOGO.ROW.XMQ.DEL      •
 1    »XLAM»RSUM(15) »B1.B2
. COMMON PP1K30) .PP21OO) .TTK30) .TTOI30) »TSC<30) .WK30) »WO<30)
 1    »WSC(30),XKT(30)iCU(30) »CV ( 30 ) »DTDT ( 30 > »DTT(30) .Ul ( 30) »V1 ( 30 )
 2    ,2DL2(30) »SOU1 (20) .SOU2I20) .SHI (20) .SH2(20) .NCLI . I SSI 1 . ISS 12
 3    .1TS2(20) .ITSK20) »ECLI ( 10 .4 ) .LLCI (10.5) .TCLI I 10.4 ) . I STEP ( 10 )
 4    ,RAINI(10).ICUV(20) fXOCUt20),XOCV(20) ,XACU(20) ,XACV<20)
 5    »NXN(10) .TTW.DECL.COCOB.ICK.NTFOR.GSF.GFR.DTSF.SF
 6    .PHIR.GD2.ISTR.SOSC.SOAB.XMC.CPH.SPH. PHI .H . IGONY.NTCUV       •
 7   iZ(30) »ZA(30) .DZ130) .05(20) .PAU5J ,TAC»5) .QAU5) .COBU5 ) f COM( 18 )
 COMMON U3I30) »V3(30) .TBOI30) »WBO(30) «CKO ( 30) »CSW( 30) .PSS(30)
 1    .£(30.2.2) .F{30.2)»FST(30»2).R(30.2»2).BR(30)»TTI(30)»EC<5)
 2    .TCL(5) »LLC(6) »ST^(50).DST4(50) .DUWI50) .05(50) .RAK20) .PST(30)
 COMMON ITIMESI20) »IXTRA»MARAY(20) »PSFAIN(20)
 COMMON SAVE. TDEL.XDT1.DT.XD. DECLX.DCHG. PHI BOT»HWEST» EM. ZW»C5.C6
 1   »NX»IX»NT.IMAX»JMAX.iNPl.IPl.NP2»NMl.NM2.IP2»IP3»IMl»IM2»IM3
 2   i 14 .lA.RDRUMtSDRUM.TDRUM.IGRID. IMARA .RTIME.IPOL..PI2.CFAR.NTIME
 3   .EX2.EX3.EX6»XNV.XNT.BETV.BETT.DT2.DTA.OTA2»G,CP»PI .GAM.GAM2
 4   .ROA.ALF.XK1.XK2.RALF.RC.CC.C32.XK12.SH.HKK.HK2.A1IA2
 5   »NWSYY.NTOP1.DELH»    TW» INEWi ITAPE. IRATt INEWC
 COMMON BG.AR.AW.SIG.ATC.SK.IZW.IZWl.IY.IR.LY.NCS.NCRtNLAPiNCL
 1    »NTOP»MA,NATAL»LAND.NVAR1.NVAR6.CPP»ITESTP
 COMMON T1,T2»T3.T4»T5.T6»T7.T8.T9.T10.T11.T12»XIIN.XJ1N»TE.T20
 2     »  T13.T14.T15.T16.XD1.YD1                    .
 3   »IS»RAINX»ET.AT»ST.PT»NUX.LOCXYY(5) fNUlX
 COMMON  CUT.CVT.Cl»QST.NE.IGET.NNl»NU.ITM.Il.I2»I3iI5»IT.MS»NS.lI
 COMMON COA(50)»CGA(50) »PAAB ( 50) .PASAI 50) .RAI30) »RB (30) »FN(30)
 1  »  11IHT.I2IHT.I3IHT.I4IHT
 DIMENSION  U2(30).V2(30).TT2(30).W2(30)»PP12(30).PP22(30)
 EQUIVALENCE  ( YY( 1 • 1 ) »U2 ( 1 ) ) . ( YY( 1 .2 ) » V2« 1 ) ) » < YY ( 1 .6 ) .PP22U) )
                                                  *******
  1
111
112
                  **##«• BIV    ******
 T41 » TT2UP1) - 273.16  •»• TTOdPU
 T21 » TT2(IP1) -  35.66  + TTO(IPl)
 T31 =• 3.0   + 7.5  *T41/T21
 QSG » C1*10.**T31 ,
 COMPUTE  W  SCALE FACTORS AT  INTERFACE  IN  INITIAL  TIME  STEP
 IF (ITM-1)  1»2.2
 IF (IGONY)  111.111.112
 WO(IPl) » QSG
 W2(IP1) =0.0           .
 DWO(IP1)=WO( IP2)-WO(IP1)
 GWO(IP1)=DWO(IP1)/Z( IP2)
 GO TO 11
                                  8IVQOO
                                  BIV001
                                  B1V002
                                  BIV003
                                  BIV004
                                  BIV005
                                  BIV006
                                  BIV007
                                  BIV008
                                  BIV009
                                  BIV010
                                  BIV011
                                  BIV012
                                  BIV013
                                  BIV014
                                  B1V015
                                  BIV016
                                  BIV017
                                  BIV018
                                  BIV019
                                  BIV020
                                  BIV021
                                  BIV022
                                  BIV023
                                  B1V024
                                  BIV025
                                  BIV026
                                  BIV027
                                  BIV028
                                  BIV029
                                  BIV030
                                  BIV031
                                  B1V032
                                  BIV033
                                  BIV034
                                  BIV035
                                  BIV036
                                  BIV037
                                  BIV038
                                  BIV039
                                  BIV040
                                  BIV041
                                  BIV042
                                  BIV043
                                  BIV044
                                  BIV045
                                  B1V046
                                  BIV047
                                  BIV048
                                  BIV049
                                  BIV050
                                  BIV051
                                  BIV052
                                  BIV053
                                  BIV054
35

-------
 2
11
SEC.
20 Tl
   T2
   T3
   T4
   T5
     W2UP1)=QSG*XMCH{1«-XMQ)*(W2< 1P2)+WO( IP2) )-WO(IPI)
     lF(DEL)20»40i20
        3*3*1
        « ROA*XKUCIP1)  / DZUP1)
        « ROW*XKUUM1)  / OZ(IMl)
        * T1*U2(IP2)  +  T2*U2< IM1)
        = T1*V2(IP2)  +  T2«V2(IM1)
        « Tl + T2
     U2UX)  = T3/T5
     V2UX)  » T4/T5
     GO TO (60.61.6^.60) tIGOGO
  61 IFUANV.EQ.l)  GO TO 62
     U2(IX)= 0*0
     U2IIP1) = U2(IX)
     V2UP1) = V2UX)
     GO TO 70
  62 V2UX)  « 0.0
     V2(IP1) = V2UX)
     U2UP1) » U2UX)
     GO TO 70
  60 U2UX)  «0.0
     U2(IP1) = 0.0
     V2(IX)  * 0.0
     V2UPD 3 0.0
     GO TO 70
  64 U2IIP1) 3 U2(IX)
     V2(IP1) = V2(IX)
  70 T10 = U2UXJ**2  +  V2(IX)*#2
     WS(IX)  = SQRT(TIO)
     WSI1P1) - WS(IX)
1001 TS = 1. - (W2UM1) + WO(IMD)  « l.E-3
     IF(ITM.EQ.O) CE  »  0.
     CF=W2( IM1 >*CE/T8+WO< IM1)*CE/T8
     T9 = +CF/ROW/XiaCIMl)
30

32



31
C SEC
40



41

142

141

42

43
W2UX) -
IFUTM-1
WO(IX) «
W2(IX) =
DWO(IMl)
GWO(IMl)
GO TO 99
. 3.3.2
CONTINUE
T3 « 81
T4 » WS<
IF
-------
- U2(IM1))*T6
- V2UM1) )*T6
/ ABS(WS( IXI-WSJ IMD) * (ROA/ROW)
      T5 » WSUP2) - WS <* V2UX)
      QST » (W2UP2) - W2UP1) )/Bl+DWO(IPl)/81
      T7 * AOS(UST)
      IFUTM.EQ.O) RA1NX=0.
      CE «<~ROA*T7*QST/1000.)-RAINX "
      T8 * 1* - (W2UM1) + WO(IMl)) * l.E-3
      CF » W2(IM1J#CE/T8+WO(IM1)*CE/T8
      XKU(IPl) = UST**2 * DZUP1) / WS/XKT(IP1)/ROA+PP12(IP2)
  999 RETURN
C ****«»*              ##### CTW    *«*»**             #*##*##
      ENTRY CTW(X1,X2»X3.XO>
C     COMPUTE COEFFICIENTS FOR T.W  IN ATMOSPHERE OR OCEAN
      DOUBLE PRECISION 21»Z2.Z3.AD.AAO.AAAO
      DOUBLE PRECISION XI»X2.X3.XO.CX
      DIMENSION Xl(l) .X2(l).X3tl).XO(l)
      A(I1)=0.
      Z1=DT2/(DZ(1I)+DZUU)
      Z2=XKT(I1)/DZ(I1) + 0.5»VVEL(II)
      Z3«XKT«II)/DZ(II) - Ot5«VVELUI)
      C(I1)«-Z1*Z3
      B(ID=C5+Z1*(Z3+Z2)
      AD»C6*X2( II )i-Z2*Zl*(X2( ID+XOdl) )-GD2»«XI(11))
      AAD»DT*FA(II)
      AAAO"(B(11)-C5)#XO{11)+C(11)#XO( II + l>
      D( I1)=AD+AAD-AAAD
      D0210  J=II»1T
      Z1=OT2/(DZ(J-H)+DZU))
BIV110
BIV111
BIV112
BIVI13
BIV114
BIV115
BIV116
BIV117
B1V118
BIV119
BIV120
BIV121
BIV122
BIV123
BIV124
BIV125
8IV126
BIV127
BIV128
BIV129
B1V130
BIV131
BIV132
BIV133
BIV134
BIV135
BIV136
BIV137
BIV138
BIV139
BIV140
BIV141
BIV142
BIV143
BIV144
BIV145
BIV146
BIV147
BIV148
BIV149
BIV150
BIV151
BIV152
BIV153
BIV154
BIV155
BIV156
B1V157
BIV158
BIV159
BIV160
BIV161
BIV162
BIV163
BIV164
       37

-------
Z2*XKT(J)/DZ(J)
                       0«5*VVEL(J+1>
                      )  - 0*5*VVEL(J+1)
    A(J)»-Z1*Z2
    CU)»-Z1*Z3
    B
221 X31NR+1) = CX + OST(NR)
    RETURN
    END
8IV165
B1V166
BIV167
BIV168
B1V169
BIV170
BIV171
BIV172
BIV173
BIV174
B1V175
BIV176
B1V177
BIV178
BIV179
BIV180
BIV181
8IV182
BIV183
BIV184
BIV185
BIV186
BIV187
BIV188
B1V189
BIV190
BIV191
BIV192
BIV193
BIV194
B1V195
                                       38

-------
 SUBROUTINE TEMPRT                                                 TMPRTOOO
 INTEGER RDRUM»SDRUM»TDRUM                                         TMPRT001
 DOUBLE PRECISION A.B .C.CST .D.DTO.DWO.DST.DTI.FA.GWO.PP11»PP12     TMPRT002
1   .PP13.PP21.PP22.PP23.SST.TTl.TT2.TT3.TTO.TSC.U2.V2.Wl9W2.W3    TMPRT003
2   »WO»WSC»XKT.XYY.YY.GTO                                         TMPRTOOO
 COMMON XYY(30»6»5)»A(30)»B(30)»C(30)»CST(30)»D(30)»DTO<30)        TMPRT005
1   »DWO(30).DSTI30).FA(30)»GTO(30)»GWO(30)»PP13(30>.PP23(30)      TMPRT006
2   .TT3(30)»W3(30)»SST                                            TMPRT007
 COMMON Rl(30)»DT1(30)iYY(30»6).SLOPX.SLOPY»HEIGHT»ETA1iETA2»XETA2•TMPRT008
1YETA2»IHT»IANV»IGOG»ETAINX»ETAINY»CSOUT<2).CRS.RAA.TOUPRA.H3»CF.CETMPRT009
2»WS(30)»UST»CW»HAI.H5I.RANS.RABNS.RABS.CRNS»TRAUS.XT2
 COMMON XKU(30)»VVEL<30)»SRS«RADMX»IGOGO.ROW.XMQ.DEL
1   »XLAMtRSUM(15).81.82
 COMMON PP11(30)»PP2H30)»TT11 30)»TTO(30).TSC(30).Wl(30)»WO(30)
1
2
3
4
5
6
7
 .WSCI30)»XKT(30)»CU(30).CV(30).DTDT130)»DTT(30)»U11 30)»V1(30)
 »ZDL2(30)»SOU1(20)»SOU2(20)»SH1(20)«SH2(20)»NCLl»I SSI 1.1 SSI 2
 >ITS2<20) • ITS1(20).ECLI(10»4),LLCI(10,5)»TCLH10.»4),ISTEP110)
 iRAIN I(10) »ICUV<20).XOCUI20)»XOCV(20)«XACU(20)oXACV(20)
 »NXN(10).TTW.DECL.COCOB.ICK.NTFOR.GSF.GFR.DTSF.SF
 •PHIR»GD2»ISTR.SOSC»SOA8»XNO»CPH»SPH»PH1.H»IGONY»NTCUV
TMPRT010
TMPRT011
TMPRT012
TMPRT013
TMPRT014
TMPRT015
TMPRT016
TMPRT017
TMPRT018
TMPRT019
»Z<30)»ZA<30)»DZ(30)»DS(30)»PA<45)»TA<45).QA<45).COB(45)»COM(18)TMPRT020
 COMMON U3(30) .V3(30)«TBO(30)»WBO(30).CKOI30).CSWI30).PSS(30)      TMPRT021
1   »E(30»2»2) »F(30.2)»FST(30.2).R(30»2.2).BR(30)»TT1(30)»EC(5)    TMPRT022
2   »TCL(5) »LLC(6) »ST^(50) »DST4(50) >DUW(50) »OS( 50> iRAI (20) .PSTOO) TMPRT023
 COMMON ITIMES(20)•IXTRA.MARAYJ20).PSFAIN(20)                      TMPRT024
 COMMON SAVE«TDEL»XDTliDT»XD»DECLX.DCHG»PHIBOT.HWEST.EM»ZW»C5.C6   TMPRT025
1  »NX.IX»NT«IMAX»JMAX»NPl»IPl»NP2»NMl.NM2.IP2iIP3.IMl.IM2»IM3     TMPRT026
2  »14•IA.RDRUM»SORUM»TDRUM.IGRID.IMARA.RTIME.1POL.PI2»CFAR.NTIME  TMPRT027
3  .EX2.EX3.EX6.XNV.XNT.BETV.BETT.DT2.DTA.DTA2.G.CP.PI.GAM.GAM2    TMPRT028
4  »ROA»ALF»XK1»XK2.RALF»RC»CC»C32»XIU2»SH»HKK»HIC2»A1»A2           TMPRT029
5  .NW5YY.NTOP1.DELH.    TW.INEW.ITAPE.IRAT»INEWC                   TMPRT030
 COMMON BG.AR.AW»SIGiATC»SK.IZW.I2Wl.:Y»IR»LY»NCS.NCR»NLAP.NCL     TMPRT031
1   .NTOP.MA. NATAL.LAND»NVAR1.NVAR6»CPP.ITESTP                     TMPRT032
 COMMON T1.T2.T3.T4,T5.T6.T7.T8.T9.T10.T11.T12»XIIN.XJIN»TE.T20    TMPRT033
2    .  T13.T14.T15.T16.XD1.YD1                                    TMPRT034
3  .1S.RAINX.ET»AT.ST»PT»NUX»LOCXYY(5)»NU1X                        TMPRT035
 COMMON  CUT«CVT»C1»QST.NE.IGET.NNl.NU.ITM.il.12.I3.I5.IT.MS.NS.il TMPRT036
 COMMON COA(50).CGA(50).PAAB(50)»PASA(50)»RAC30)»RB(30).FN(30)     TMPRT037
1 » I1IHT.I2IHT.I3IHT.I4IHT          '                              TMPRT038
 DIMENSION U2(30).V2(30).TT2(30).W2(30).PP12(30)«PP22(30)          TMPRT039
 EQUIVALENCE (YY(1,1),U2(1))»(YY(1,2).V2(1)).(YY(1•6).PP22(1)>     TMPRT040
1  i(YY(1.3)»TT2(1)).(YY(1,4).W2(1))»(YY(1.5)»PPi2(l))             TMPRT041
 COMMON /TAPBLK / IUAR96.IUAR97.IUAR98.IUAR99                      TMPRT042
 COMMON/INPUT/ VARIN(20.4)»NVCHS(5)»GNV(30.8)                      TMPRT043
 COMMON /GRDNTS / GXY(30•12).PGXY(30.12).CGXY(30.12)  .       .     TMPRT044
 DIMENSION ZE1(30.6).ZE2(30»6).PUXI30)»PUY(30)»PVX(30).PVYOO)     TMPRT045
1  .PTX130) .PTY(30).PWX(30) .PWY(30) .XPK30) »PP1Y(30)               TMPRT046
2  .XP2I30)»PP2Y(30).CUX(30).CUY(30).CVX(30)»CVY(30)               TMPRT047
3  .CTX130) .CTY(30).CWX(30) .CWY(30) .CP1XOO) .CP1YS30)          •    TMPRT048
4  »CP2X(30).CP2Y130)                                               TMPRT049
 EQUIVALENCE  (GXY(1.1),ZE111.1)).(GXYI1.7)»ZE2(1.1))              TMPRT050
 EQUIVALENCE  (PGXY(1.1).PUX(1))  (PGXY(1.7)»PUY(1))               TMPRT051
 EQUIVALENCE  (PGXYl1.2)»PVX(1))  (PGXY{1,8).PVY(1))               TMPRT052
 EQUIVALENCE  (PGXY(1.3)»PTX(1))  
-------
    EQUIVALENCE
    EQUIVALENCE
    EQUIVALENCE
    EQUIVALENCE
                • CGXYU»3) iCTX (1))»(CGXYU«9 ) tCTY (1))
                »CP1X(1)).(CGXY(1,11),CP1Y(1))
                (CGXY(1»6)»CP2X(1))»(CGXY(1»12)»CP2Y(1) )
    IFUTM.LE.niCTR « 0
    ICTR = 1CTR + 1
    IFUCTR.LTtllGO TO 808
    ICTR " 0
    PRINT 1* ITM«NS»MS
  1 FORMAT C1TIME STEP'»I5i' FOR STATION' i2I5)'
    GO TO (550»551»552»553)iIGOGO
550 PRINT 554                        I
    GO TO 501
554 FORMAT!1H+.40X*'(COASTAL CORNER STATION)1)
551 PRINT 555
    GO TO 501
555 FORMAT(lH+i40X»'(COASTAL STATION)')
552 PRINT 556     .
    GO TO 501                                          '
556 FORMAT(1H+.40X*1(WATER STATION)')
553 PRINT 557
557 FORMAT HH+f40X»'(LAND STATION)')
501 PRINT 4
    DO 10 1P=1»NP1
    PRINT 2» Z(IP)»U2(IP)fV2(IP)»TT2(IP)iW2(IP)tXKT(IP)»PP12(IP)»
   1  VVEL(IP)»OTUIP)
 10 CONTINUE
              RANS.RABNStRABS.RAAiCRNS.CRS.TOUPRA
                    RANS             RABNS               RABS
                          CRNS              CRS              TOUPRA'/
                                             TMPRT059
                                             TMPRT060
                                             TMPRT061
                                             TMPRT062
                                             TMPRT063
                                             TMPRT064
                                             TMPRT065
                                             TMPRT066
                                             TMPRT067
                                             TMPRT068
   PRINT 13«
13 FORMAT(/'
  1    RAA
  2  7E18.8)
   PRINT 14i
14 FORMAT!/'
  1    HAI
  2  7E18.8)
   PRINT 15»
15 FORMAT(/«
  1
              SRS.CE»CF»HAliHSI»H3»TRAUS
                    SRS
              (RSUM(1)»I<
                    LE
                R(1-A)
             CE
  HSI

It8)
                                             H3
   2 •/ 8E16t6)
  A FORMAT(//'  HEIGHT
   1  W2            XKT
  2 FORMAT(9E14.5>
                             U2
           A
          RA
                                 PP1
                   V2
  S
MAN
                       VVEL
                                                     RESTART'/'
                                                          PTX
888 RETURN
    ENTRY TEMGRA
    PRINT 5
 - 5 FORMAT (' THE FOLLOWING ARE COMPUTED GRADIENTS FOR
   1UX           PUY           PVX           PVY
   2  «PTY           PWX           PWY       HEIGHT'/)
    DO 6I»ltNPl
    PRINT 7t PUXmiPUYU) »PVX ( I) »PVY( I J .PTX U ) »PTY( 1 1 *PWX( I ) «PWY ( I J »
   1 Z(D
  6 CONTINUE
    PRINT 778
    DO 777 l«liNPl
    PRINT 7.CUX(I),CUY(I)tCVX(I)iCVY(I).CTX(I)»CTY(I)»CWX(n,CWY(I)
   l.Z(I)
777 CONTINUE
778 FORMAT I'OCENTERED GRADIENTS')
  7 FORMAT(8E14a5»F8.0)
    RETURN
    END
            TMPRT070
            TMPRT071
            TMPRT072
            TMPRT073
            TMPRT074
            TMPRT075
            TMPRT076
            TMPRT077
            TMPRT078
            TMPRT079
            TMPRT080
            TMPRT081
            TMPRT082
            TMPRT083
            TMPRT084
            TMPRT085
            TMPRT086
            TMPRT087
            TMPRT088
            TMPRT089
            TMPRT090
CF          TMPRT091
   TRAUS '/ TMPRT092
            TMPRT093
            TMPRT094
          P TMPRT095
       T2**4TMPRT096
            TMPRT097
TEMP        TMPRT098
     DTI '/ITMPRT099
            TMPRT100
            TMPRT101
            TMPRT102
            TMPRT103
           PTMPRT104
            TMPRT105
            TMPRT106
            TMPRT107
            TMPRT108
            TMPRT109
            TMPRT110
            TMPRT111
            TMPRT112
            TMPRT113
            TMPRT114
            TMPRT115
            TMPRT116
            TMPWT117
            TMPRT118
            TMPRT119

-------
 SUBROUTINE TTSQ                                                    TTSQOOO
 COMPUTE FCN  A  AND SET INDICES                                    TTSQ001
 INTEGER RDRUMtSDRUMoTDRUM                                          TTSQ002
 DOUBLE PRECISION Z1»Z2                                             TTSQ003
 DOUBLE PRECISION AZER136)                                          TTSQ004
 DOUBLE PRECISION A»B.C»CST»D»DTOsDWO»DSTtDTl .FA»GWO.PP11 .PP12      TTSQ005
1   *PPl3»PP21»PP22»PP23»SST»mtTT2»TT3tTTO»TSC»U2»V2»Wl.W2»W3     TTSQ006
2   .WO»WSC»XKT»XYYiYY»GTO                                          TTSQ007
 COMMON XYY<30»6»5)iA(30)»B<30)»C<30)»CST<30)iD(30)»DTO(30)         TTSQ008
1   »DWO(30)»DST<30)iFA<30)«GTCC30)»GWO(30)»PP13(30)»PP23<30)       TTSQ009
2   »TT3(30) .W3C30J.SST                                  '          TTSQ010
 COMMON RK30) iDTl ( 30)»YY (30i6 I iSLOPX»SLOPY»HEIGHT»ETAl»ETA2»XETA2» TTSQ011
lYETA2«IHTfIA.NV»lGOGiETAINX.ETAINYiCSOUT<2)»CRS»RAA»TOUPRA.H3»CF»CE TTSQ012
2»WS(30)iUST»CW»HAItHSItRANS.RABNS«RABS»CRNS»TRAUS»XT2              TTSQ013
 COMMON XKU(30)»VVEL(30)iSRS»RADMXiIGOGOiROW»XMQ»DEL                TTSQ014
1   »XLAM»RSUM(15)»81.B2             '                               TTSQ015
 COMMON PP1K30) .PP2K30) *TT1<30> »TTO(30) »TSC ( 30 ) »Wl ( 30) iWO( 30 >     TTSQ016
1   iWSC(30)»XKT(30).CU(30)»CV(30).DTDT<30).DTT(30 I»U1(30).VI(30)   TTSQ017
2   »2DL2(30) »SOUU20)»SOU2(,.20) iSHK20) »SH2(20) iNCLI»I SSI 111 SSI 2    TTS0018
3   »ITS2(20) »I TS1 ( 20 )»ECL H10.4) .LLCI (10 .5 ) . TCL I< 10. <>) . I STEP ( 10)   TTSQ019
4   iRAINKlO) »ICUV(20) »XOCU(20) »XOCV(20) »XACU( 20) »XACV( 20)         TTSQ020
5   »NXN(10)»TTWiDECL»COCOB.ICK.NTFOR.GSF,GFR»DTSF»SF                TTSQ021
6   »PHIRfGD2.ISTR,SOSC»SOAB.XNO»CPH.SPH«PHI.^i IGONYtNTCUV          TTSQ022
7  »2(30) »2A(30) »D2(30) tDSOO) .PAI45 ) »TA(^5 ) »OA(^5) »COBU5) »COM(18) TTSQ023
 COMMON U3(30)«V3(30)»TBOI30)iWBOJ30)»CKO(30)»CSW(30)iPSS(30)       TTSQ024
1   .E<30t2i2)»F(30«2)»FST(30»2)»R«30i2»2)»BR(30)»TTI(30)»EC(5)     TTSQ025
2   iTCL(5) »LLC(6) »ST^»( 50 ) iDSTM 50) iDUW(50) »QS( 50 ) »RAI(20) »PST(30)  TTSQ026
 COMMON ITIMES(20)»IXTRA»MARAY(20).PSFAIN(20)                       TTSQ027
 COMMON SAVE»TDELiXDTliDT»XD»DECLX»DCHG»PHlBOTiHWEST»EMtZW»C5.C6    TTSQ028
1  .NX»IX»NT»IMAX»JMAXfNPl»IPl.NP2.NMl»NM2»IP2»IP3iIMl.IM2tIM3      TTSQ029
2  iU»lAiRDRUMiSDRUM»TDRUM»IGRIDilMARA»l »PP22U) >      TTSQ043
1  .(YYU.3) iTT2(l) J»(YY(l»/»)tW2(U)»(YY«li5)tPPl2(l»              TTS0044
 COMMON /TAPBLK / IUAR96.IUAR97 . IUAR98,IUAR99                       TTSQ045
 COMMON/INPUT/ VARINI 30»4)»NVCHS<5)»GNV(30»8)                       TTSQ046
 COMMON /CRDNTS / GXY(30t12)«PGXY<30»12)»CGXY«30»12>                 TTSQ047
 DIMENSION ZEK30i6)»ZE2(30f6)»PUX(30) .PUY«30) iPVXl 30 ) »PVY(30)      TTSQ048
1  »PTX(30) »PTY(30)»PWX(30)«PWY(30)«XPK30) »PP1Y(30)                 TTSQ049
2  iXP2<30) .PP2Y(30)»CUX(30) .CUYI30) »CVX(30) .CVYOO)                 TTSQ050
3  iCTX(30)«CTY(30).CWX(30)»CWY(30)»CP1X«30)»CP1Y<30>                TTSQ051
4  »CP2X(30)»CP2Y(30)                                               TTSQ052
 EQUIVALENCE  
-------
    EQUIVALENCE
    EQUIVALENCE
    EQUIVALENCE
    EQUIVALENCE
    EQUIVALENCE
    EQUIVALENCE
    EQUIVALENCE
    EQUIVALENCE
    EQUIVALENCE
    EQUIVALENCE
    EQUIVALENCE
**#»*#*
                 (PGXYd.2)»PVXd)
                  »PTX(1)
                 (PGXYd .4)»PWX(1)
                 (PCXY<1»5> tXPld)
                 (PGXY(l,6)iXP2(l>
                 (CGXY(l.l)»CUX U
                 (CGXYd»2)«CVX (1
                 (CGXYd.3J.CTX (1
                 (CGXYd»4)»CWX (1
                 (CGXYd.5) .CPlXd
                 (CGXY(1»6>»CP2X(1
                     *#*#* TTSQ
                    TO 18
   (PGXYd
   tPGXYd
   (PGXYd
   (PGXYd
   (PGXYd
   (CGXYll
   (CGXYd
   (CGXYd
   I CGXYd
   (CGXYd
   (CGXYd
***#**
• 8)»PVYd»
.9) »PTYd) )
.10) .PWYdM
• ID.PPlYd)
• 12)»PP2Yd)
.7 ),CUY (1)
.8 J.CVY (1)
.9 ).CTY (1)
.10)»CWY d)
.11) .CPlYd)
»12)»CP2Y(1)
         »**•*«*#
117
 18
110
146
131
    IF (ITM.GT.l)GO
    D0117 1=1.36
    AZERd)  «0.
    IF(NVCHS(2).EQ.1)GO TO 41
    T— OCEAN
    D0110  J»2»IM1
    21=U2(J)*PTX(J>+V2(J)*PTY(J)
    FA(J)=-Z1+DT1(J)
    CONTINUE
    IT»1M2
    I2»1M3
130
145
140
 41
    IFUGONY.EQ.1J GO TO 146
    15 « IT-  IHT+1
    IF(IHT.GT.2J GO TO 131
    15 » 1M3
    II « 1
    II <• 2
    CALL CTW(TT1,TT2.TT3.TTO»
    JF(IGONY»EQ.1> GO TO 145
    W*S  OCEAN
    00130 J«2.IM1
    Z1«U2(JJ*PWX(J>+V2(J)*PWYJJ)
    FA(J)=-Z1
    CONTINUE
    CALL CTW(W1.W2.W3«WO)
    W=Q  ATMOSPHERE
    D0140 J=IP2.NX
    Z1«U2(J)*PWXU)+V2(J)«PWY(J)
    FA(J)=-Z1
    CONTINUE
    11 « IP1
    IT«NM1
    12»NM2
    13-NX
    I5»IA
    IF(NVCHS(2).EQ.1)GO TO
    CALL CTW(W1.W2.W3»WO)
    T— ATMOSPHERE -
                           22
TTSQ055
TTSQ056
TTSQ057
TTSQ058
TTSQ059
TTSQ060
TTSQ061
TTSQ062
TTSQ063
TTSQ064
TTSQ065
TTSQ066
TTSQ067
TTSQ068
TTSQ069
TTSQ070
TTSQ071
TTSQ072
TTSQ073
TTSQ074
TTSQ075
TTSQ076
TTSQ077
TTSQ078
TTSQ079
TTSQ080
TTSQ081
TTSQ082
TTSQ083
TTSQ084
TTSQ08t>
TTSQ086
TTSQ087
TTSQ088
TTSQ089
TTSQ090
TTSQ091
TTSQ092
TTSQ093
TTSQ094
TTSQ095
TTSQ096
TTSQ097
TTSQ098
TTSQ099
TTSQ100
TTSQ101
TTSQ102
TTSQ103
TTSQ104
TTSQ105
TTSQ106
TTSQ107
TTSQ108
TTSQ109

-------
      00120  J-IP2iNX                                                     TTSQ110
      Z1=U2< J)*PTX)                               TTSQ138
:      STORE  SCALED T AND W TEMPORARILY                                   TTSQ139
  371 D03100  I=1»NP1                     \                                TTSQ140
      TSC(It«TT2(I)                                                       TTSQ141
      WSC(I)=W2(I)                                                       TTSQ142
I      COMPUTE UNSCALED  T AND  W  FOR  GWC«RAD»STOR                           TTSQ143
      TT2m=TT2m-fTTOU)                              '                  TTSQ144
3100 W2(n«W2(I)4WO(ll                 •                                  TTS0145
      DO  310I=1P3»NX                 .                                    TTS0146
      Tl  « DZ(I-1)/TT2(II**2              •                                TTSQ147
      T101 » (TT2  «  (CTY(I) - T101  *  SLOPY)  *  Tl                                TTSQ152
  310 CONTINUE                                                     .       TTSQ153
      Tl  » DZ(NX)/TT2(NP1)**2                                             TTSQ154
      XCTX * CTX(NPl) - <(TT2(NP1)  - TT2(NX))/DZ(NX) )*SLOPX               TTSQ155
      YCTY » CTY(NPl) - UTT21NP1)  - TT2(NX)J/DZJNX) )*SLOPY               TTSQ156
      SXJNP1) » T1*XCTX                                            •     TTS0157
      SY(NPl) « T1*YCTY                                                  TTSQ158
      CALL LINEAR  ( ITM. ICUV.4.NTCUV.J,XOCU.CU(IX).XOCV.CV(IX>.XACU.       TTSQ159
     1   CU(NPl).XACV.CV(NPl))                                            TTSQ160
      CUT «  CU(NP1)/TTO(NP1)                                              TTSO161
      CVT *  CV(NP1)/TTO(NP1)                                              TTS0162
      D0330  J»IP2»NX                                                     TTSQ163
      SUMX =• 0«                                                          TTSQ164
                                         43

-------
315
320
330
850
851
340
    SUMY » 0»
    J1»J+1
    D0320 1«=J1»NP1
    SUMX » SUMX + SXU)
    SUMY » SUMY + SYU)
    CONTINUE
    Tl » GSF*TT2(J)
    TX «• T1«SUMX
    TY « T1#SUMY
    CU(J) « CUT»TT2U) + TY
    CV(J) * CVT*TT2(J) - TX
    CONTINUE                 ...
    GO TO (399i  1»1*399»» IGOGO
    IFUHT.GTtl) GO TO 850
    XETA2 a CV( IX1/GSF
    YETA2 *-CU( IX)/GSF
    GO TO 851
    CV(IX) » GSF # XETA2
    CU(IX) a -GSF » YETA2
    D0340 I»2»IX
    T3 n(CTYU) + CTYU-1M/2.
    T4 «(CWY( I) + CWYU-1) )/2.
    Tl » PST(1-1)*T3 + PSSU-1)*T4
    T5 « (CTXI I) + CTX(I-l) )/2.
    T6 = (CWX( 1 ) + CWX( 1-1) )/2.
    T2 = PST(I-1)«T5 + PSS(I-1)*T6
    SX«I) * .001*T2*DZ(I-1)
    SY(I) = »001*T1*DZ(I-1)
    CONTINUE
    00350 K=2tIX
    SUMX = 0«
    SUMY « 0.
    00345 J=IiIMl
    SUMX » SUMX + SX(J+1)
    SUMY » SUMY + SY(J+1)
345
350
399
                     GFR*SUMY
                     GFR#SUMX
                     #*### CUV
    CONTINUE
    CUU) = CUUX1
    CV
-------
36
11
12
13
                            (V2dD-CVdlM
                            (CUUD-U2U1))
                                      G02 * UK III
                                      * PUYdl))
 U3(I) o 0,
 V3d) » 0.
 GO TO 13
 U3dl)  « U2U1) + DTSF *
 V3dl)  =» V2(ll) + OTSF *
 GO TO 13
 U3UT+2) » CUdT+2J
 V3dT+2) = CVI IT+21
 Z4 » C6 * U2(II)  - OTSF **CVdI)  -
1 - OT * IU2IIII * PUXUI)' + V2dl)
 Z5 = Zl*Z2*U2dl)
 Z6 » C6*V2dI)  +  DTSF#CU(II)  - GD2*VKII)
1 - DT # (U2« III * PVXUI1  + V2(II) * PVYdlll
 Z7 « Z1*Z2#V2(I1I
 F(Ilil) » 24  +  25
 F
* PUYd+ll I
- GD2*Vld + l)
          -Z1*Z2
           C5 + 21»(Z3 + 22)
          -Z1«Z3
          = C6»U2d + l> - DTSF*CVd + l>
           
  1 - OT *
   Fd»2J
  1 - OT * CU2(
30 CONTINUE
   CUT) » Ot
   FUT»1I » FUTill
   FUT»2) » FUT»2)
   21 « l./(BRUl)**2
          C6*V2d + l
                         DTSF*CU(I-HJ
                     PVXJI + 1I+ V2d+ll* PVYII+ll)
                       Zl*Z3»U2UT+2»
                       Zl*23»V2UT+2)
                        BG**2I
   E(I1*1«1) » Zl#BRdl)
   EUlil»2) = -21*BG
   Edl.2.1) « -Edl.1.2)
   Edl.2,2) = Edl.1,1)
   FSTU1.1)
   FSTU1.2)
   EUltlil)
   Edl.1.2)
   E
              -E(l.1.2)
              Ed,1,1)
TTS0220
TTSQ221
TTSQ222
TTS0223
TTSQ224
TTSQ225
TTSQ226
TTSQ227
TTSQ228
TTSQ229
TTS0230
TTSQ231
TTSQ232
TTSQ233
TTS0234
TTSQ235
TTSQ236
TTSQ237
TTSQ238
TTSQ239
TTSQ240
TTSQ241
TTSQ242
TTSQ243
TTSQ244
TTSQ245
                                TTSQ247
                                TTSQ248
                                TTSQ2A9
                                TTSQ250
                                TTSQ251
                                TTSQ252
                                TTSQ253
                                TTSQ254
                                TTSQ255
                                TTSQ256
                                TTSQ257
                                TTSQ258
                                TTSQ259
                                TTSQ260
                                TTSQ261
                                TTSQ262
                                TTSQ263
                                TTSQ264
                                TTSQ265
                                TTSQ266
                                TTSQ267
                                TTSQ268
                                TTSQ269
                                TTSQ270
                                TTSQ271
                                TTSQ272
                                TTS0273
                                TTSQ274

-------
Zl » A(IT)*E(I2»l»ll  + BR(IT)
22 » A(IT)*E(I2»li2)  + BG
Z3 » Zl**2 -f Z2*#2
R(ITiltl) " Z1/Z3
RUT»1»2) » -Z2/Z3
R(IT»2»1) » -RJIT»1»2)
R(IT>2*2) ° R(IT»1.1)
DO 10 I-II.IT
FU.l)  = F(I.l)  - A
   FSTUtl)
   FSTUi2)
10 CONTINUE
   U3(I3) »
   V3U3) »
   00 20 I = H»I5
   NRaIT-I
   EU3 « E(NR»1»1) *U3(NR>2)
    EV3 = EINR»1,2) «V3(NR+2)
   U3(NR-t-l)=EU3+EV3 + FST(NR»l)
   EU3 = E *U3(NR+2)
   EV3 = E(NR,2»2) * V3(NR+2)
   V3
-------
 SUBROUTINE SDATA                                                  SOATAOOO
 INTEGER RDRUM»SDRUM.TORUM                                         SDATA001
 DOUBLE PRECISION A*B»C.CST.D.DTO.DWO.DST»DT1iFA»GWO»PPl1»PP12     SDATA002
1   iPP13iPP21»PP22»PP23.SST»TTl»TT2»TT3»TTO»TSC.U2»V2.Wl»W2»W3    SDATA003
2   «WO»KSCiXia»XYY»YY»GTO                                         SDATA004
 COMMON XYY<30»6i5l»A(30) iB (30 ) »C( 30) »CST (30) »D(30) tDTOOO)        SDATA005
1   »DWO(30)»DST(30).FA<30)iGTOlSO).GWOI30)»PPl3<30>»PP23<30)      SDATA006
2   «TT3(30)«W3(30)»SST                                            SDATA007
 COMMON Rn30)»DTl(30).YY<30.6)»SLOPX,SLOPY»HEIGHT»ETAl»ETA2.XETA2.SDATA008
lYETA2»IHT»IANV.IGOG.ETAINX»ETAINYfCSOUT(2)»CRS.RAA.TOUPRA,»H3»CF»CESDATA009
2iWS(30J .UST.CW.HAI»HSI»RANS.RABNS.RABS.CRNS.TRAUS»XT2
 COMMON XKU<30)»VVEL(30)»SRS»RADMX»JGOGO»ROW»XMQ.DEL
1   tXLAM.RSUMdS) .B1.B2
 COMMON PPll(30)»PP2l(30).TT1(30)»TTO(30)»TSC(30)»Wl(30)iWO(30 )
1
2
3
4
5
6
7
»WSC(30).XKT(30I.CU<30)»CV(30)tDTDT(30)»DTT(30)tUl(30)»V1(30)
|ZDL2(30).SOU1(20)»SOU2(20),SH1<20).SH2120)»NCLI.ISSI1.ISSI2
»ITS2<20) »ITSlt20),ECLl(10,4)»LLCH10,5) iTCLl (10.4) . ISTEP (10 )
»RAINI(10)iICUV(20)»XOCU(20)»XOCV<20)»XACU(20).XACVJ20)
iNXN(lO)»TTW.DECL»COCOB»1CK.NTFOR,GSF»GFR»DTSF»SF
tPHIR»GD2»ISTR»SOSC»SOAB»XNO»CPH.SPHtPHI»H•IGONY»NTCUV
                                                                SDATA010
                                                                SDATA011
                                                                SDATA012
                                                                SDATA013
                                                                SDATAOH
                                                                SOATA015
                                                                SDATA016
                                                                SDATA017
                                                                SDATA018
                                                                SDATA019
• Z(30)»ZA(30}»02(30) .DS(30> »PA(45 }
                                               »COB(45) »COM( 18 )SDATA020
 COMMON U3(30)«V3I30)»TBO(30).WBO(30)»CKO(30)»CSW(30)»PSS<30!
1   »E(30»2»2)»F(30»2)»FST(30«2).R(30»2.2)»BR(30)tTTI(30)»EC(5)
2   «TCL(5)»LLC<6)»ST4(50)iDST4(50)iDUWl50)»QS(50)»RAI(20)»PST(30)
 COMMON ITIMESJ20)•IXTRA«MARAY{20)»PSFAIN(20)
 COMMON SAVE»TDEL»XDTltOT»XO»DECLXiOCHG»PHlBOT»HWEST.EM»ZW»C5»C6
1  »NX»IXtNT»IMAX»JMAXiNPliIPl»NP2iNMliNM2iIP2»IP3tIMl>IM2«IM3
2  »I4iJA»RORUMtSORUM»TDRUM»lGRIO.IMARA»RTlME.IPOL»PI2.CFAR»NTIME
3  .EX2«EX3,EX6»XNV,XNT»BETV,BETT.OT2.DTA,OTA2»G.CP.PI»GAM»GAM2
4  »ROA»ALFfXKl»XK2iRALFiRC»CC»C32iXK12»SHiHKK»HK2«AltA2
5  «NWSYY»NTOP1»OELH«   TWi INEW» ITAPEi IRAT • INEV/C
 COMMON BG»AR»AW»SIG«ATC»SK»IZW»IZWl»IY»IR*LY»NCS»NCR»NLAPtNCL
1   »NTOP»MA.NATAL.LAND«NVAR1»NVAR6»CPP. ITESTP
 COMMON Tl»T2iT3«T4«T5»T6.T7tT8iT9fT10»Tll»T12tXIIN.XJIN»TE.T20
2    •  Tl3tTl4tT15»Tl6»XDl»YDl
3  iIS»RAlNX»ET.AT,STiPT.NUX.LCCXYY(5).NU1X
 COMMON  CUT»CVT.C1»OST»NE.IGET»NN1.NU»ITM»I1.I2.I3.I5»IT.MS«NS»II
 COMMON COA(50) .C6AC50) »PAAB« 50) .PASA-( 50) .RAC30) .RB(30) »FN<30)  .
1 i I1IHT.I2IHT.I3IHT.I4IHT
 DIMENSION U2(30).V2I30)»TT2C30)»W2(30)»PP12(30).PP22I30)
 EQUIVALENCE (YY(1.1)«U2(1)),(YY(1,2>»V2(1)),(YY(1.6)»PP22(1))
1  i(YY(l«3) >TT2(1) )««YY( 1.4) .W2HJ) »(YY(l»5)iPP12d) I
 COMMON /TAP8LK / IUAR96iIUAR97»IUAR98»IUAR99
 COMMON/INPUT/ VARIN«30»4)iNVCHS(5)»GNV(30»8)
 COMMON /GRDNTS / GXY(30.12).PGXY(30.12)iCGXYJ30f12)
 DIMENSION ZEK30.6J.ZE2I30.6) »PUX(30) .PUY(30) »PVXC 30) »PVY< 30)
1  »PTX(30)«PTY(30)iPWX(30) .PWYOO) .XP1 ( 30 ) »PP1Y ( 30
2  iXP2(30),PP2Y(30).CUXI30).CUYI30)»CVX(30)»CVY(30
3  fCTXt30)iCTYJ30)»CWX(30)tCWY(30).CPlX(30)»CPlY«30)
4  »CP2X(30)»CP2Y(30)
 EQUIVALENCE
 EQUIVALENCE
 EQUIVALENCE
 EQUIVALENCE
 EQUIVALENCE
          (GXY(l.l)»ZE1(1»1)).(GXY11.7)»ZE2(1.1
          (PGXY«1•1).PUX(1))•  (PGXY <1»7).PUY(1)
          •PGXY(1.2)»PVX(1)).  (PGXY(1»8).PVY(l)
          (PGXY(1.3),PTX(1))»  (PGXY(1.9)»PTY(1)
          (PGXY«1»4) .PWX(l) )»  (PGXY(1.10) »PWYd
                                                                SDATA021
                                                                SDATA022
                                                                SDATA023
                                                                SDATA024
                                                                SDATA025
                                                                SDATA026
                                                                SDATA027
                                                                SDATA028
                                                                SDATA029
                                                                SDATA030
                                                                SDATA031
                                                                SDATA032
                                                                SDATA033
                                                                SDATA034
                                                                SDATA035
                                                                SDATA036
                                                                SDATA037
                                                                SDATA038
                                                                SDATA039
                                                                SDATA040
                                                                SDATA041
                                                                SDATA042
                                                                SDATA043
                                                                SDATA044
                                                                SDATA045
                                                                SDATA046
                                                                SDATA047
                                                                SDATA048
                                                                SDATA049
                                                                SDATA050
                                                                SDATA051
                                                                SDATA052
                                                                SDATA053
                                                                SDATA054
                                   47

-------
EQUIVALENCE
EQUIVALENCE
EQUIVALENCE
EQUIVALENCE
EQUIVALENCE
EQUIVALENCE
EQUIVALENCE
EQUIVALENCE
1) )»
1) }.
(1))
(1))
(11)
U)J
m>
(i))
(PGXYdill
(PGXYJ1.12
(CGXYdi7
(CGXYd»8
(CGXYd»9
(CGXYdilO
(CGXY(1»11
(CGXYd.12
»PP1Y(1)
•PP2Y11)
»CUY (1)
»CVY (1)
•CTY (1)
»CWY (1)
»CP1Y(1J
iCP2Y( 1)
                    (PGXYd»5>
                    (PGXY(1»6) iXP2(U
                     »YIN5«1))
      DIMENSION VAR3I50)
      DIMENSION ALLd2»5> tIALL(12»5>
      EQUIVALENCE  (VAR3 11) ,C( 1) ) » dALLd .1) fALLd »11 )
      DOUBLE PRECISION XTJMEiXTl
C  SUBROUTINE TO SET DATA AT EACH STATION INITIALLY AND AT EACH RESTART
      IF (ITMJ  11»11»301
   11 IF (IS-1J 12il2»1313
C  READ IN INITIAL TIME ONLY        FOLLOWING FOR ALL STATIONS
   12 CONTINUE
      READ 2»NLAP»NPU
      NTOP = NLAP+NPl
      NATAL " NTOP-IX
      DO 13I=NP2»NTOP
      READ 1. PA(I).TA(I),QA(I ) .COBI I )
      PRINT 1»PAU)«TA< I )»QA(I ).COB( I)
   13 CONTINUE
      STMNP2)=SIG*TA
-------
  303
    IF (NVCHS(2).EQ.l) READ 1 »V3< I J * (El I t J»l ) » J=l >4)
    CONTINUE
    DO 30* I=liNPl
    Tl « Z(I)
    IF (I.EQoIX) T1"T1-»00001
    IF «I.EO.IP1)T1»T1+. 00001
    IF INVCHSUJ.NE.l) GO TO 305
    CALL XINEAR ( Tl »BRt'»»K»L fR ( 1 » 1 »U »GNV( I »1 ) »
305
        R(1.2il>»GNV<
      GXYd»l> » GNV<
      GXYdi?) « GNV(
      GXYd»2> » GNV(
      GXY(Ii8) ». GNV(
      IF (NVCHSm.NE
.2
»1
• 2
i3
• 4
11
»R(l»3»l)tGNVd»3)
GO TO 304
                                                  »GNVd ,4))
    CALL XINEAR < Tl tV3 . »XAOMI) .XACVd ) iTl »T2
   30 PRINT 5.ICUVd)»XOCU(I) ,XOCV(I) tXACU( I ) iXACV( I) »T1 »T2
      IF (NTFOR«LE.O) NTFOR » 1
SDATA110
SDATA111
SDATA112
SDATA113
SDATA114
SDATA115
SDATA116
SDATA117
SDATA118
SDATA119
SDATA120
SDATA121
SDATA122
SDATA123
SDATA124
SDATA125
SDATA126
SDATA127
SDATA128
SDATA129
SDATA130
SDATA131
SDATA132
SDATA133
SDATA134
SDATA135
SDATA136
SDATA137
SDATA138
SDATA139
SDATA140
SDATA141
SDATA142
SDATA143
SDATA144
SDATA145
SDATA146
SDATA147
SDATA148
SDATA149
SDATA150
SDATA151
SDATA152
SDATA153
SDATA154
SDATA155
SDATA156
SDATA157
SDATA158
SDATA159
SDATA160
SDATA161
SDATA162
SDATA163
SDATA164
                                      49

-------
      ISTEPI1J = 601                                                     SOATA165
      IF(NCL)ll*ill4»115                                                 SDATA166
C     NUMBER OF CLOUD LAYERS*AMOUNTS AND RAINFALL  RATE  INPUT             SDATA167
  115 DO 933 I»1»NTFOR                                                   SDATA168
      READ  3»ISTEP(I) »NXN( I) iRAINU I ) »( LLC III »L ) »ECLI ( I »L ) »TCLM I »L ) •   SDATA169
     1  L»1»NCL)                                                         SDATA170
      PRINT 3»ISTEP(I1»NXN(I)tRAINIU)»«LLCIIIiLI»ECLI 0.                                                       SDATA185
      IFI1.GT.6) GO TO  699                                               SDATA186
      SH1U) « 0.                                                        SDATA187
      SH2(I) « 0*                                                        SDATA1.88
  699 CONTINUE                                                           SDATA189
      IFUPOI)700»700»701                                                SDATA190
  701 READ 2« (ITSKI)i -lilSSIl)                                        SDATA191
      PRINT 2»(ITS1(I). alilSSIl)                                        SDATA192
      READ 1  t (SOUKI iI = l»ISSIl)                                      SDATA193
      PRINT 1  «(SOU1(I »I=1«ISS11)                                      SDATA194
      READ 1  »ISH1(I)» =1»6)                                            SDATA195
      PRINT 1  .(SH1(I)»I=1,6)                                           SDATA196
      IF(IPOI.EQ.l) GO  TO 700                                            SDATA197
      READ 2«  IITS2(I)tI'l»ISSI2)                                       SDATA198
      PRINT 2» (ITS2(I).I=1»ISSI2)                                       SDATA199
      READ 1  •  (SOU2(I)»1«1»I55I2) •                                    SDATA200
      PRINT 1  i «SOU2(I)»I«1.1SSI2)                                     SDATA201
      READ 1  »(SH2m»I = l»6»                                            SDATA202
      PRINT 1  »«SH2(I)»I=1»6)                                           SDATA203
  700 DO 117  L=NP2»NTOP1                                                SDATA204
      IFIQAIL+II.LE.O.O) QAtL+l) «  0*001                                 SDATA205
      Tl * (QA(L)+QA(L-H))/2.*{PA(L)-PA(L+1))/G                          SDATA206
      TW « TW + Tl                                                       SDATA207
      K«L-IX                                                      .       SDATA208
      DUW(K) « Tl                                                        SDATA209
      COAOO » .41A8239*(PA(L)-PA(L+D)                                  SDATA210
C     T8 « (COB(K)-KCOB(K-H) )/2.*DZ«L)*l«E-5                              SDATA211
C  DZ(L) NOT SET ABOVE  THE TOP PREDICTION LEVEL                          SDATA212
      T8 « (COB»*<>)                                          SDATA219
                                        50

-------
117
223

 23
108

101
109

111

102
110
113
103

150

.51
  4
 52
 33
284
290
 28

291
 29
795
DST4(L> "
CONTINUE
DO 23 N-l.JMAX
00 23 M«1»IMAX
XD1 « XO+YDl*ZE2(I.2)+XYYCI»2»2I
   »  T1**2+T2*#2
   -Z(in
T2  »AR* 0*
GO TO 52
ROW » 1*
CW  « .935
XMO "It
IF (XLAM) 52.4.52
DEL-.055
CONTINUE
XM • MS-1
YM » NS-1
XD1 « XD*XM
YD1 «-XD*YM
DO 29 J»l<6
I « J
DO 28 K>l.NPl
YY«»J  ) = XYY(K»J»2)
IF (J-4) 291,29.29
YYdPl.JJ =» YY(IX.J)
CONTINUE
ALL INITIAL DATA SET
GO TO 1797»796»796»795)»IGOGO
DO 14 J«1.4
                       +ZE2
-------
     DO 14I»1»IX
  14 YY(IiJ)  » 0.
     GO TO 1114
 797 00 798 J«li2
     DO 798 I«liIX
 798 YYUiJl  » 0.
     GO TO 1114
 796 IQI « 5
     IF(W2(IXi.EQ.O.O)  IQI  -4
     DO 141J-IQI»6
     DO 1411»1,IX
 141 YY(IiJ)  = 0»
     1FUHT.EQ.1) GO TO 122
     IIHT » IHT - 1
     DO 121 I«1»IIHT
     U2II) *>  0.0
 121 V2(I) -0.0
 122 IF(IGONY.EQ.O) GO  TO 1114
     IFUANV.GT.l) GO TO 118
     DO 119 I=1»IX
 119 V2U) »  0.0
     GO TO 1114
 118 DO 120 1 = 1.IX
 120 U2U) «  0«0
1114 READ 16>  (YY(It3)tI-ltIPl)
  16 FORMAT(6E12.4)
     IFUPOL.EQ.O) GO TO 350
     READ 16»  (YY(I»5).I=IX»NP1»
     DO 351 I=IXiNPl
     YY(I»5)  = YY(I»5)/ROA/100.
 351 CONTINUE
     IF(lPOL.EQ.l) GO TO 350
     READ 16»  (YY( I»6).I = IX»NP1)
     DO 352 J«JX.NP1
     YYU.6)  » YY(I»6)/ROA/100.

                       TO 10
352 CONTINUE
350 IF(IGONY.EQ.O)
U2UP1) « 0«
V2(IP1) = 0.
. 10 DO^JjLUNPl
TTO(
TT2<
TTK
UK
VK
W0(
W2(
Wl(
TT3
U3(
V3<
W3I
PP21
PP11
) = TT2( I)
)=0.
) « TT2U)
» U2(IJ
» V2II)
=W2 ( I )
= 0.
« W2( I
) » TT2 I)
«= U2t I
» V2(I
» W2( I
I) » PP22(
I) « PP12<
PP131I) » PP12J
GO














I)
I)
I)
SDATA275
SDATA276
SDATA277
SDATA278
SDATA279
SDATA280
SDATA281
SDATA282
SDATA283
SDATA284
SDATA285
SDATA286
SDATA287
SDATA288
SDATA289
SDATA290
SDATA291
SDATA292
SDATA293
SDATA294
SDATA295
SDATA296
SDATA297
SDATA298
SDATA299
SDATA300
SDATA301
SDATA302
SDATA303
SDATA304
SDATA305
SDATA306
SDATA307
SDATA308
SDATA309
SDATA310
SDATA311
SDATA312
SDATA313
SDATA314
SDATA315
SDATA316
SDATA317
SDATA318
SDATA319
SDATA320
SDATA321
SDATA322
SDATA323
SDATA324
SDATA325
SDATA326
SDATA327
SDATA328
SDATA329
                                       52

-------
     PP23U) • PP22II)
   9 CONTINUE
     1CK » ITESTP
     ISTR«0
     LY"1
     C5 - 1.
     C6 - 1.
     GD2 » o.
     PHI » PHIBOT + XDT1*(JMAX~NS)
     Tl« PHI « 4017453293
     H* HWEST + (MS-1) * XDTi/COS(Tll
     PHIR o Tl
     CPH => COS(PHIR)
     SPH « SIN(PHIR)
     SF = 14.584E-5*SIN(T1)
     OTSF » DT#SF
     Cl « 3.7943/PAUP1)
     GSF » G/SF
     GFR =GSF/ROW
     OTA * DT
     OTA2 =• 2.*DT
     T10 « XLAM*DEL/2«
     00 720 I*1»NX
     2DL21I) « IZAd.) + T10)  **2
 720 CONTINUE
     TK » XK2»*2
     DO 725 t«l»IMl
     CKO(I) » TK#ZDL2tH
 725 CONTINUE
     TK » XK12:
     00 735 l=IPliNX
     CKO(I) « TK#ZOL2«I)
 735 CONTINUE
     DO 20001»ltl5
2000 RSUM(I) « 0*
     RANS = 0.
     RABNS » 0*
     RABS « 0.
     CRNS * 0.
     CRS « Ot
     RAA « 0.
     TOUPRA « 0.
     IFIXLAM) 45»99»45
     IF(DEL)60.50»60
45
50
  54
  60
T6 « ZHP2)/XLAM
T6 f ABS(T6)
81 « 1»/XK1#ALOGIT6J
T7 « Z(IM1)/XLAM
T7 a ABSU7)
B2 » l./XKl#ALOG(T7)
GO TO 70
T8 = XLAM/2./PI
T16aT8»*EX2
T9«SQRT(G)«OEL*T16
DO 65 I«1*NX
SOATA330
SDATA331
SDATA332
SDATA333
SDATA334
SDATA335
SDATA336
SOATA337
SDATA338
SDATA339
SOATA340
SDATA341
SDATA342
SDATA343
SDATA344
SDATA345
SDATA346
SDATA347
SDATA348
SDATA349
SOATA350
SDATA351
SDATA352
SDATA353
SDATA354
SDATA355
SDATA356
SDATA357
SDATA358
SDATA359
SDATA360
SDATA361
SDATA362
SDATA363
SDATA364
SOATA365
SOATA366
SDATA367
SDATA368
SDATA369
SDATA370
SDATA371
SDATA372
SDATA373
SOATA374
SOATA375
SDATA376
SOATA377
SDATA378
SDATA379
SDATA380
SDATA381
SOATA382
SDATA383
SOATA384

-------
 65
 70

500
               CKOUPll'CSWUPll
               XKUUP1)
               CKOUM1)*CSWUM1)
               XKU(IMl)
T10 » -ZA(I)/T8
CSW(I) « T9*EXPU10)
CONTINUE
XKUUP1)
XKTUP1)
XKU(IMl)
XKT(IMl)
CONTINUE
GO TO 99
CONTINUE
NVAR1 « 1
NVAR6 « 6
DO 585 1 » 1»NP1
U3U  » 0.
585
V3<1
TT3(
W3(I
PP13
PP23U)
CONTINUE
         )  '

         I)
0.
 Oi
0.
  0*
  0*
                                                                        SOATA385
                                                                        SDATA386
                                                                        SDATA387
                                                                        SDATA388
                                                                        SOATA389
                                                                        SDATA390
                                                                        SDATA391
                                                                        SDATA392
                                                                        SDATA393
                                                                        SDATA394
                                                                        SDATA395
                                                                        SOATA396
                                                                        SOATA397
                                                                        SDATA398
                                                                        SDATA399
                                                                        SDATA400
                                                                        SDATA401
                                                                        SDATA402
                                                                        SDATA403
                                                                        SDATA404
C**»* FLOATING GRID STATIONS ARE ASSIGNED THE FOLLOWING NUMBERS ********SDATA406
C                                                                       SDATA407
C                                647                                SDATA408
C                                                                       SDATA409
C                                123                                SDATA410
C                                    -                                   SDATA411
C                                859                                SDATA412
C                                                                       SDATA413
C**** WHERE THE COMPUTED GRADIENTS ARE APPLIED AT STATION 2 ***#*******#SDATA414
£**#****#********#*****#*#*#**•*****#*#*«#»»*#*###*#*»###***#*#*«##**»***SDATA415
      DO 666  I«lt5                                                      SDATA416
      IF(I.EQ.2.0R.I.EQ.3) GO TO 666                                    SDATA417
      DO 666  J«l»12                                                     SDATA418
      ALL(JiI) « 0.                        .                             SDATA419
-  666 CONTINUE                                                          SDATA420
C  SET DATA FROM RESTART                                                SDATA421
C   COMPUTES  THE CENTERED AND UPWIND GRADIENTS                          SDATA422
      IU3 " 3                                                           SDATA423
      IF (MS-2) 511f501t501                                             SDATA424
 SETS STATION 2   MS-1
511 READ (RDRUMMS)
    DO 600 I-l»12
    ALL(I.2) « YIN3JI)
600 CONTINUE
    SLOPX « ALL(1»2)
    SLOPY » ALL(2»2J
                          (YIN2in»I-l»NWSYY»
      HEIGHT
      ETA1
      ETA2
      XETA2
      YETA2
      IHT
      IANV
      IGOGO
             ALL(3«2)
             ALL(4»2)
             ALL(5i2)
             ALL(6«2)
             ALH7.2J
            IALLI8.2)
            IALL(9»2)
            IALL(ia,2)
                                                                  SDATA425
                                                                  SDATA426
                                                                  SDATA427
                                                                  SDATA428
                                                                  SDATA429
                                                                  SDATA430
                                                                  SDATA431
                                                                  SDATA432
                                                                  SDATA433
                                                                  SDATA434
                                                                  SDATA435
                                                                  SDATA436
                                                                  SDATA437
                                                                  SDATA438
                                                                  SDATA439
                                         54

-------
     IGONY=IGOGO-3
     ETAINX • ALLU1.2)
     ETAINY » ALL(12»2)
     LOCXYY(2) « -1
     IU3 > 2
     ALL(11*1) « ALL<11»2)
     ALU12.1) * ALLI12.2)
  SETS STATION 3   MS GT 1
 501 DO 503 J»NVARltNVAR6
     DO 503 K=1»NP1
     IF (MS.EQ.l) GO TO 1603
     XYY(K»Jtl) « XYY(K»J»2)
     XYYIK»J»21 •« XYY(K»J»3)
1603
 503
1610
 604
 610

 515
 560
 601

 561
YY(K.J)   » XYY(K.JiIU3)
CONTINUE
PP23(NP1) a PP221NP1)
PP13(NP1) a PP12(NP1)
IFIMS.EQ.l) GO TO 610
DO 604 I«l»12
IMI.EQ.8.0R.I.EQ.10) GO TO 1610
ALL(I>1) « ALL(Ii2)
ALL(I,2) « AILII.3)
GO TO 604
lALL(Itl) a 1ALHI.2)
IALLd.2) a 1ALK1.3)
CONTINUE
SLOPX a ALL!1.2)
SLOPY « ALL(2»2)
HEIGHT « ALL(3»2)
ETA1   « ALL(4«2)
ETA2   ' ALL<5»2)
XETA2  « ALL(6,2)
YETA2  « ALL(7»2)
IHT    «IALL(8.2)
IANV   «IALU9.2)
IGOGO  aiALL(10i2)
IGONY»IGOGO-3
ETAINX » ALLdl.2)
ETAINY a ALLU2.2)
LOCXYY(l) = LOCXYYJ2)
LOCXYYJ2) a is
IF (MS-IMAXJ 560»561»561
LOCXYYOJ a is+1
READ (RDRUM'IS-t-1)   (YIN3( I). 1=1 .NWSYY)
DO 601 1=1.12
ALLU.3) e YIN4(I)
CONTINUE
GO TO 562
LOCXYYO) a -l
   STATIONS 1-3 SET   NOW SET 4-5
 562 IF (NS-1) 563.563(564
 563
LOCXYY(4)
ALLfll.4)
AUL(12*4)
GO TO 565
-1
ALLdl.2)
ALL(12i2)
SDATA440
SDATA441
SDATA442
SDATA443
SDATA444
SDATA445
SDATA446
SDATA447
SDATA448
SDATA449
SDATA450
SDATA451
SDATA452
SDATA453
SDATA454
SDATA455
SDATA456
SDATA457
SDATA458
SDATA459
SDATA460
SDATA461
SDATA462
SDATA463
SDATA464
SDATA465
SDATA466
SOATA467
SDATA468
SDATA469
SDATA470
SDATA471
SDATA472
SDATA473
SDATA474
SDATA475
SDATA476
SDATA477
SDATA478
SDATA479
SDATA480
SDATA481
SDATA482
SDATA483
SDATA484
SDATA485
SDATA486
SDATA487
SDATA488
SDATA489
SDATA490
SDATA491
SDATA492
SDATA493
SDATA494
                                       55

-------
564 LOCXYYU) * IS-IMAX
    READ 
SDATA495
SDATA496
SDATA497
SDATA498
SDATA499
SDATA500
SDATA501
SDATA502
SDATA503
SDATA504
SDATA505
SDATA506
SDATA507
SDATA508
SDATA509
SDATA510
SDATA511
SDATA512
SDATA513
SDATA514
SDATA515
SDATA516
SDATA517
SDATA518
SDATA519
SDATA520
SDATA521
SDATA522
SDATA523
SDATA524
SDATA525
SDATA526
SDATA527
SDATA528
SDATA529
SDATA530
SDATA531
SDATA532
SDATA533
SDATA534
SDATA535
SDATA536
SDATA537
SDATA538
SDATA539
SDATA540
SDATA541
SDATA542
SDATA543
SDATA544
SDATA545
SDATA546
SDATA547
SDATA548
SDATA549
                                       56

-------
  607
  608
  620
 1501
  521

  522
  523
  524

  525

 1502
 1521

 1522
 2521
 1524
                        I2IHT- IALL(8»J)
                        13IHT » IALL(8»J)
    IFUIHT.GT.I2IHT)
    CONTINUE
    DO 608 J = 4»5
    1IHT «= IALLJ8.J)
    IFUIHT.GT.I3IHT)
    CONTINUE
    DO 599 IJXY=1,2
    IXY =(IJXY-1)*6
    IF tIJXY-1) 1501»1501.1502
    IF (LOCXYY(3)J 521»521.522
    IU3 «= 2
    GO TO 523
    IU3 « 3
    IF (LOCXYY(ll)
    IU1 o 2
    GO TO 1505
    IU1 * 1
    GO TO 1505
    IF (LOCXYYU))
    IU3 » 2
    GO TO 2521
    IU3 = 4
    IF (LOCXYY(5»
    IU1 = 2
    GO TO 1505
    IU1 =» 5
        DIFFERENCE IN  X( IJXY«1 )/Y( IJXY=2)  DIRECTION
                     524.524*525
                     1521.1521,1522
                     1524»1524»1525
 1525
C  UPWIND
 1505 IKI » 1
      IFtIGONY.EQ.il IKI=IP2
      DO 550  LR=IKI»NP1
      IF«XYY(LR»lJXYi2) I 531f532i536
C ABOVE CHECKS U/V  NOW INFLOW CONDITION CHECK
  531 IF UU3-2) 435i532f435
  435 IU3U = IU3
      IU2 * 2
      GO TO 534
C  UPWIND IS INFLOW— SET TO INPUT
  532 DO 533 J=NVAR1»NVAR6
      K = IXY+J
                   GXY(LR»K)
533
  536
  537
  538
               537i532»538
      PGXY(LR»K)
      GO TO 540
      IF (IU1-2)
      IU3U =2
      IU2 =» 1
      GO TO 534
      IU3U = 2                    .'.-'-'
      IU2  » 5
C  UPWIND DIFFERENCE
  534 DO 535 J=NVAR1*NVAR6
      K = IXY+J
      PGXY(LR»K) « XMD*(XYY(LR»J»IU3U)-XYY(LR»J»IU2))
      CONTINUE
      COMPUTE CENTERED DIFFERENCE.
      DO 547 J=NVARliNVAR6
      K = IXY+J
  535
    C
  540
SDATA550
SDATA551
SDATA552
SDATA553
SDATA554
SDATA555
SDATA556
SDATA557
SDATA558
SDATAS59
SDATA560
SDATA561
SDATA562
SDATA563
SDATA564
SDATA565
SDATA566
SDATA567
SDATA568
SDATA569
SDATA570
SDATA571
SDATA572
SDATA573
SDATA574
SDATA575
SDATA576
SDATA577
SDATA578
SDATA579
SDATA580
SDATA581
SDATA582
SDATA583
SDATA584
SDATA585
SDATA586
SDATA587
SDATA588
SDATA589
SDATA590
SDATA591
SDATA592
SDATA593
SDATA594
SDATA595
SDATA596
SDATA597
SDATA598
SDATA599
SDATA600
SOATA601
SDATA602
SDATA603
SDATA604
                                          57

-------
     CGXY(LRiK) =((XYY(LR«J»1U3) - XYY(LR»Ji2))                        SDATA605
    1  -HXYY*XMD/2.                           SDATA606
     IFUGONY.LT.O)  GO TO 547                          -                SDATA607
     IF (IU3.EQ.2.0R .IU1.E0.2) CGXY(LR.K) =PGXY(LR»K)                 SDATA608
 547 CONTINUE                                                          SDATA609
 550 CONTINUE                            	                            SDATA610
 599 CONTINUE                                                          SDATA611
  99 RETURN                                                            SDATA612
   2 FORMAT ( 1415)                                                     SDATA613
   3 FORKAT(I4,I2.F6.2t5(I3tF5.1iF4.0n                       ,        SDATA614
   5 FCRMAT(I5»4F10.2»2A4)                •                              SOATA615
1111 FORMAT(' SFC P  = '>F10.4/•  LAMBDA =',F10.4/'  DELTA ='»F10.4/» SLOPXSDATA616
    l='iFl0.4/( SLOPY ='»F10.4/' HEIGHT 1 + )/DEPTH(-) ='»F10.4/« THE 1NPUSDATA617
    2T SURFACE HEIGHT FOR OPEN WATER BOUNDARIES'/1 INPUT X-ETA ='»F10.4SDATA618
    3/1 INPUT Y-ETA  s'»F10.4/'  IANV «='»I10//)                   '       SDATA619
     END                 .                                              SDATA620
                                         58

-------
      SUBROUTINE INFRAUWA »COA»CGA»KA»NTOP)
C   CALL INFRAI PRIOR TO CALLING INFRA  WHEN USING A GIVEN DELTA
C   PATH LENGTHS ARE   WA  FOR WATER VAPOR
C                      COA  FOR CAR80RN DIOXIDE
C                      CGA FOR AEROSOLS
      DIMENSION WA(1)«COAU) »CGA(1) .DTAUF ( 25 • 16 ) »TOTAU(16)
      DIMENSION STe(l)»ST4(l),LLC(l)*EC
      DO 70 LR=1»KSAV
      KUHN
      UW =
      UC »
      TP n
      UAA»
  137
  136
  135
  245
  153
     0*
     0*
     1*
     0*
     0«
D0135 I«LR»MM1
UW = UW+WAU )  •
UC » UC+COAU)
UAA« UAA+CGAU)
Tl a «.32«UC#*.4
TC *I1«-EXP(T1))*.185
IF (UAA) 136,136*137
TP = EXP(-UAA)
CALL XUHN(UW.EW»KUHN)
Tl « EW+TC
TT « (l.-TU*TP
DEW = l.-TT
DTAUF(IiLR) = DEW-DEP
DEP = DEW
CONTINUE
IF (LR-1)
                70*70.245
KUHN
UC «
UW *
UAA*
II «
TP »
DEP >
 m  1
 04
 0*
 04
 LR-1
 1,
> 04
D0155 I«1.I1
K = LR-1
UW » WA(K)+UW
UC » COA(K)+UC
UAA» CGA(K)-t-UAA
TC « 1.-EXP(-.32«UC»*.4)
CALL XUHN (UW,EW*KUHN)
IF (UAA) 154,154*153
TP » EXP(-UAA)
Tl » EW^TC   *4l85
TT « »1.-T1)*TP
DEW » l.-TT
       INFRAOOO
EMISSIV1NFRA001
       INFRA002
       INFRA003
       INFRA004
       INFRA005
       INFRA006
       INFRA007
       INFRA008
       INFRA009
       INFRA010
       INFRA011
       1NFRA012
       INFRA013
       INFRA014
       1NFRA015
       INFRA016
       1NFRA017
       INFRA018
       INFRA019
       INFRA020
       INFRA021
       INFRA022
       INFRA023
       INFRA024
       INFRA025
       INFRA026
       INFRA027
       INFRA028
       INFRA029
       INFRA030
       INFRA031
       INFRA032
       INFRA033
       INFRA034
       INFRA035
       INFRA03*6
       INFRA037
       INFRA038
       INFRA039
       INFRA040
       1NFRA041
       INFRA042
       INFRA043
       INFRA044
       INFRA045
       INFRA046
       INFRA047
       INFRA048
       INFRA049
       INFRA050
       INFRA051
       INFRA052
       1NFRA053
       INFRA054

-------
   SUBROUTINE SOLAR I(  P »TW.CSZI)TE)
   DIMENSION DUWU) »PAd) iPASA'. 1) »PAAB<1)»DTDU(1)iSTHE(25)
   ATWAUPtAC) =• SORT!I.000949*AP+.051J/AC)
   C03 =• 980./ 239.
   XIO - 1.95/60.
   COSZ = CSZI
   IF (COSZ-.17365) lli!2»12
11 VALUE = COSZ/.17365
   COSZ * .17365
   GO TO 13
12 VALUE ° 1.
13 TAU1 = 1.041-0.16*ATWA(P»COSZ)
   TAU1 a .5+.5*TAUl
   TAU2 »  .077*.GT.O.)  DIPA»XIN5*« l.-l./EXP(PAAB( I )/COS2 ) )
   XIN6 » XIN5-DIPA
   XIN6 = AMAXl(XIN6tO.)
   IF (PASA(I).GT.O.)  OIPS=XIN6#(1.-1./EXP(PASA(IJ/COS2
   STHE(I) » C03»(OIW+DIPA)/(PA(I)-PA(1+1)  )
   XIN5 = XlN5-(OIZ+DIW-f-DIPA+DIPS)
   TOPRA = TOPRA+DIPS+DIZ
   XIN5—=^AMAX1(XIN5»0.)
30 CONTINUE
   00 80 I=2tNLAY
   Tl = (PA(I»-PA(I-1))/(PA(I+1J-PA(I-1)J
   DTOT(I> = STHE(I-1)+T1*(STHE(I)-STHE(I-1))
80 CONTINUE
   RETURN
   END
SOLAROOO
SOLAR001
SOLAR002
SOLAR003
SOLAR004
SOLAR005
SOLAR006
SOLAR007
SOLAR008
SOLAR009
SOLAR010
SOLAR011
SOLAR012
SOLAR013
SOLAR014
SOLAR015
SOLAR016
SOLAR017
SOLAR018
SOLAR019
SOLAR020
SOLAR021
SOLAR022
SOLAR023
SOLAR024
SOLAR025
SOLAR026
SOLAR027
SOLAR028
SOLAR029
SOLAR030
SOLAR031
SOLAR032
SOLAR033
SOLAR034
SOLAR035
SOLAR036
SOLAR037
SOLAR038
SOLAR039
SOLAR040
SOLAR041
SOLAR042
SOLAR043
SOLAR044
SOLAR045
                                      60

-------
     The following named subprograms used in the RIGID LID model can be

found in the FREE SURFACE model listing of this report.

     Program Name                     .            Page Number

       SOLAR2                                      111,  112

       LINEAR                                         115
                                                        y
       XUHN                                           116

       TRANS                                          117

       FILES                                          118
                                   61

-------
3.0  MAIN  PROGRAM:  FREE SURFACE Version

     This section contains a flow diagram (Figure 4) which shows Che opera-

tion in the numerical model MAIN Program, FREE SURFACE version, for the

atmosphere-water planetary boundary layer with land option and pollutants.

Following the flow diagram is its accompanying program listing.
                                                          /
     The symbols used in the diagram are, for the most part, those which

have become standard flow chart symbols.  The explanation of the symbols

is as follows:

                ~"jg"           Flow direction.
                              Program steps.


                              Subroutine call.


                              Disk (temporary storage).

                              Switch disk (temporary storage)


                              Decision on symbol contents.


                              Multiple entrance branch.


                              Contents self-explained.


                              Printed (output).


                                      i,
                              Magnetic tape (output).
                                 Figure 3.  Flow Diagram MAIN Program,
                                            FREE SURFACE Version:  Air-
                                            sea-land interaction model.-
                                    62

-------
IITM - 0
rspo-

Do 2778
Loop
Compute
DT0.TB0, etc.
T «' 1 MY
»-
Do 777
Loop
IS - IS+1


I
SDATA
                                                                                            Print 31
                                                                                           Run Stopped
                                                                                             New DT
                                                                                             Needed
r /", Write (^
V 98,97 \J *

N0





"*


Call
Advect


/^ R*ad~7\^
< V98, 97V^


IK) J


j
y^
P

i
           YES
                                                      Tope or Disk
                                                       can be used
                                          63

-------
FREE SERVICE Program listing
C      MAIN PROGRAM AIR-SEA INTERACTION  WITH  LAND OPTION              MAIN
C  1972 VERSION     TAPE OUTPUT  AT YOU CO                    '          MAIN
      INTEGER RDRUM»SDRUM»TDRUM                                         MAIN
      DOUBLE PRECISION A»B.C»CST»D»DTO»DWO»DST.DTI»FA»GWO»PP11.PP12     MAIN
     1   »PPl3»PP21»PP22tPP23»SST»TTl»TT2.TT3»TTO»TSC»U2»V2.Wl.W2tW3    MAIN
     2   »WO»WSC»XKT»XYY»YY»GTO                                         MAIN
COMMON-DOUBLE PRECISION NOT ON DISK OR RESTART                          MAIN
      COMMON XYY(30»6»51.A(30) »B<30)iC(30),CST<30)»D<30) »DTO(30)        MAIN
     1   iDWO(30)»DST(30).FA130).GTOI30)«GWO(30)»PP13<30>»PP23(30)      MAIN
     2   ,TT3<30)»W3(30)»SST                                    .        MAIN
COMMON-FOR PRINT ONLY                                                   MAIN
      COMMON RIC30)»DT1C30)•YY(30»6)•SLOPX.SLOPY.HEIGHTiETAl»ETA2»XETA2.MAIN
     lYETA2»IHTiIANViIGOG»ETAINX»ETAINY»CSOUT<2)»CRS»RAA»TOUPRA»H3»CF»CEMAIN
     2»WS(30).UST.CW»HAI»HSI»RANStRABNS»RABS»CRNS»TRAUS»XT2             MAIN
COMMON-FOR RESTART AND PRINTOUT        .                                 MAIN
      COMMON XKU(30)iVVEL(30)fSRS»RADMX»IGOGO»ROW.XMQ»DEL               MAIN
     1   .XLAM.RSUMU5) »B1»B2                  '                          MAIN
COMMON-NEEDED FOR RESTART ONLY                                          MAIN
      COMMON PP1K30) iPP21(30) »TT1 ( 30 ) »TTO( 30) »TSC(30) *Wl( 30 ) »WOC 30 )    MAIN
     1   .WSC(30) »XKT(30) »CU<30) .CVJ30) »DTDT(30) tDTTOO) »U1 < 30) iVU 30 )  MAIN
     2   tZDL2(30)iSOUl(20)»SOU2(20) »SH1<20) »SH2(20) »NCLl»I SSI 1»I SSI 2   MAIN
     3   tITS2<20) tITSK20) .ECLIU0.4) »LLCI (10.5) »TCLK10»4) »I STEP (10)  MAIN
     4   tRAINI(10) .ICUVI20)iXOCU<20)»XOCV<20)»XACU<20)»XACV(20)        MAIN
     5   »NXN(10)iTTW.DECL»COCOB»DELZ»NTFCR»GSF.GFR»DTSF»SF             MAIN
     6   fPHIR.GD2»ISTR»SOSC»SOAB»XNO»CPH»SPHtPHI»H»IGONY»NTCUV         MAIN
     7 . PGXY(30il2)»CGXY<30»12)i!2IHT,I3IHT                            MAIN
COMMON-OTHER THAN DOUBLE PRECISION-PRINT OR RESTART                     MAIN
     7  fZ(30) »ZA(30) »DZ<30) .05(30) »PA<45) tTA<45) »QA<45) »COB(45) »COMU8)MAIN
      COMMON U3I30) »V3(30) »TBO<30) iWBO(30) »CK0130) »CSW(30) iPSSOO)      MAIN
     1   »E(30»2.2)»F(30»2).FSTI30.2) »R(30»2»2)»BR<30) »TTI(30)»EC«5>    MAIN
     2   ,TCL(5)»LLC(6>»STM50) »DST4(50) »DUW(50) »QS ( 50) t.RAH 20) »PST I 301 MAIN
      COMMON ITIMESI20)•IXTRAtMARAY(20)»PSFAIN(20)                      MAIN
      COMMON SAVEtTDEL»XDTl»DT.XD»DECLX»DCHG»PHIBOTiHWESTiEM.ZW»C5»C6   MAIN
     1  iNX»lX»NT»IMAX»JMAX»NPl»IPl»NP2»NMl»NM2»IP2«IP3tIMliIM2»IM3     MAIN
     2  »U»IA»RDRUMiSDRUM»TDRUM»lGRID»IMARA»RTIME»IPOL»Pl2»CFAR»NTIME  MAIN
     3  »EX2»EX3»EX6»XNVfXNT»BETV»BETT»DT2»DTA»DTA2»G»CP»PI»GAM»GAM2    MAIN
     4  »ROA»ALFiXKl»XK2»RALF»RC»CC.C32fXK12»SHtHKK»HK2»Al»A2           MAIN
     5  »NWSYY«NTOP1»DELH.   TW»INEWi I TAPEiIRAT.INEWC                   MAIN
      COMMON BG»AR»AWiSIGtATC»SK»IZW»IZlvl»IY»IRiLY»NCS»NCRfNLAP»NCL     MAIN
     1   »NTOP»MA»NATAL»LAND»NVAR1»NVAR6»CPP»ITESTP                     MAIN
      COMMON TltT2»T3»T4»T5tT6»T7»T8»T9»Tiq»Tll»T12»XIIN»XJlN«TE»T20    MAIN
     2    »  T13»T14»T15»T16»XD1»YD1                                    MAIN
     3  .IS»RA-INX»ET»AT»ST»PT»NUX«LOCXYY(5) »NU1X                        MATN
      COMMON  CUT»CVT.C1»QST»NE»IGET»NN1»NU»ITM»I1»I2»I3»I5»IT.MS»NS»II MAIN
      COMMON COA(SO)»CGA(50)»PAAB(50)»PASA(50)«RA(30)»RB(30)»FN(30)     MAIN
     1 » IlIHTiUIHT                                                   .MAIN
      DIMENSION U2(30)»V2(30)»TT2(30)»W2(30)»PP12I 30)»PP22(30)         'MAIN
      EQUIVALENCE ( YY( 1»1) »U2 ( 1) ) »< YY( 1 »2 ) »V2 ( 1) ) • I YY< 1 • 6) .PP22U) )     MAIN
     1  »(YY(lf3)»TT2(1))»(YY<1.4)»W2(D)»(YY<1»5)»PP12(1))             MAIN
      COMMON /TAPBLK /  IUAR96»IUAR97»IUAR98.IUAR99                      MAIN
      COMMON/INPUT/ VARIN(30.4 ) »NVCHS(5)»GNV(30»8)                      MAIN
      COMMON /GRDNTS /  GXY(30»12)                                        MAIN
      DIMENSION .ZE1<30»6)»ZE2< 30»6)»PUX(30)»PUY(301»PVX(30)»PVY(30)     MAIN
     1  iPTXOOJ »PTY(30) »PWX(30) iPWYOO) »XPH30)»PP1Y(30)               MAIN
     2  »XP2(30).PP2Y(30)»CUX<30)»CUY(30)»CVX(30)»CVY(30>               MAIN
 000
 001
 002
 003
 004
 005
 006
 007
 008
 009
 010
 Oil
 012
.013
 014
 OL5
 016
 OL7
 018
 019
 020
 021
 Q2.2
 023
 OZ4
 025
 026
 027
 028
 029
 030
 031
 032
 033
 034
 035
 036
 037
 038
 039
 040
 041
 042
 043
 044
 045
 046
 047
 048
 049
 050
 051
 052
 053
 054
                                         64

-------
     3  .CTX(30).CTY(30).CWX<30).CWY<30).CP1X(30).CP1Y<30)
     4  »CP2X(30).CP2Y<30)
C
C
C
  EQUIVALENCE
  EQUIVALENCE
  EQUIVALENCE
  EQUIVALENCE
  EQUIVALENCE
  EQUIVALENCE
  EQUIVALENCE
  EQUIVALENCE.
  EQUIVALENCE
 . EQUIVALENCE
  EQUIVALENCE
  EQUIVALENCE
  EQUIVALENCE
UNITS 99.96 FOR
                   (GXY(l.l) »ZE1<1»1) ).»PVX(1))
                   .PTX(1))
                   (PGXYd.4)fPWX(l))
                   (PGXYU.5)»XP1(1))
                   (PGXY<1»6)»XP2I1))
                   (CGXY(l.l)»CUX
                   )
                                  (PGXY(l.lO).PWY(U)
                                  (PGXY(l.ll).PPlY(l)
                                  IPGXY<1.12).PP2Y(1>
                             (1) )»(CGXY(1»7 J.CUY  (1)
                             (1) ).(CGXY(1.8 )tCVY  (1)
              (CGXY(1.3)»CTX (1)).(CGXY(1,9 ).CTY (1)
              )
    DO 555 1=1.6989
555 ZEROCM(I) • 0.
    CALL FILES
    SDRUM
    RDRUM
                    12
 NWSYY
 DELZ =
TIMES 2
 IXTRA
          99
          96
          .180*2
         0*0
         FOR DOUBLE
          1
                        PRECISION ONLY
                      AND READ IN DATA FOR THE GRID
      NCR = 1717
      NCR1 = 753  '
      NCS =  594
      TDEL « 0.
      IK » 0
      COMPUTE GRADIENTS
      CALL GREAD
      I = 0
      DO 702 J=1.20
      ITIMESU) = 1 ..........     ...  .  .
  702 I = I+ITESTP
      ITM = 0
      IF ( IT1MESC20).LT.NT) GO TO 80
      NSTART = 0
      INDIVIDUAL STATION PREDICTION FILE 1
      XDT1 « XD/110,8 * liE-5
      SAVE = 0.01
      U3(l) = NCS
      U3I2) = JMAX
      U3(3)= IMAX
      U3(4) = IPOL+11
      U3I5) = NP1
      U3(6) = IX
      U3(7) = DT
      DO 703 1=1.20
   KAIN 055
   MAIN 056
   MAIN 057
   MAIN 058
   MAIN 059
   MAIN 060
   MAIN 061
   MAIN 062
   MAIN 063
   MAIN 064
   MAIN 065
   MAIN 066
   MAIN 067
   MAIN 068
   MAIN 069
ACCMAIN 070
   MAIN 071
   MAIN 072
   MAIN 073
   MAIN 074
   MAIN 075.
   MAIN 076
   MAIN 077
   MAIN 078
   MAIN 079
   MAIN 080
   MAIN 081
   MAIN 082
   MAIN 083
   MAIN 084
   MAIN 085
   MAIN 086
   MAIN 087
   MAIN 088
   MAIN 089
   MAIN 090
   MAIN 091
   MAIN 092
   MAIN 093
   MAIN 094
   MAIN 095
   MAIN 096
   MAIN 097
   MAI'N 098
   MAIN 099
   MAIN 100
   MAIN 101
   MAIN 102
   MAIN 103
   MAIN 104
   MAIN 105
   MAIN 106
   MAIN 107
   MAIN 108
   MAIN 109
                                         65

-------
  703  U3U+7)  =  ITIMEStU                                                MAIN 110
      U3(28)  » XD  * l.E-5                                                MAIN 111
      WRITE  (95     )  (Z                                      MAIN 112
      DO  777  NS=1»JMAX                                                   MAIN 113
      DO  777  MS=1»IMAX                                                   MAIN 114
      IS  =  -WOm                                             MAIN 122
      GTO(I)=DTO(I)/DZ(I)                                                MAIN 123
      GWOII)=DWO(I1/DZI I)                                                MAIN 124
 2778  CONTINUE                                                          MAIN 125
      H3  =  0.                                                            MAIN 126
:     INEWC  =  INEW                                                       MAIN 127
      IRAT  a  IMARA                                                       MAIN 128
   35  CALL  EXCK                                                          MAIN 129
      H = H  * .017453293                                                 MAIN 130
      RSUMU5) = XKT(NX)                                                 MAIN 131
      RSUM114) * XKTm                                                  MAIN 132
   40  CALL  BIV                                                          MAIN 133
      D03101   I=ltNPl                                                    MAIN 134
      TSCU)=TT2(n                                                     MAIN 135
      WSC+1                                      MAIN 143
      PRINT  132. ITM»IXTRA.(MARAYU)»I*1»IXTRAI                          MAIN 144
   46  WRITE  (95) (RI(I).I=1»NCS)                                         MAIN 145
      CALL  TEMPRT                                                        MAIN 146
      PRINT  101.ETA2.DELZ.XETA2.YETA2.CUUX) .CV(IX) »IHT»IGOGO           MAIN 147
      WRITE  (98'IS) (  Rid ) »I = 1»NCR)                    .                 MAIN 148
      WRITE(97'IS)  (NXN(IJ»I=1»NCR1»                                     MAIN 149
      WRITE  (SDRUM'ISJ  (YINU)»1=1.NWSYY)                                MAIN 150
  777  CONTINUE                                                          MAIN 151
      ICK »  IT£STP                                                       MAIN 152
I     SWITCH  FILE  UNITS  FOR  ADVECT  READ                                 MAIN 153
      I = RDRUM                                                          MAIN 154
      RDRUM  =  SDRUM                                                     MAIN 155
      SDRUM  =  I                                                         'MAIN 156
 8000  ITM =  ITM  +  1                                                     MAIN 157
      I11HT  «  0                                                          MAIN 158
      Tl  =  TDEL  /(1.424214»DT)                                          MAIN 159
      PRINT  335.ITM.DT.T1                                                MAIN 160
      IF  (Tl-l«)1112flll2»336                                           MAIN 161
 1112  PRINT  31                                                          MAIN 162
      GO  TO  80                                                          MAIN 163
  336  NU1X  »   1                                                          MAIN 164
                                        66

-------
      IFIITM+NU1X.GT.NTJNU1X = NT-ITM
      IF(NTIME.GT.O.AND.ITM+NU1X.GT.NTIME)NU1X = NTIME-ITM
      NUX = NSTART + NU1X
       IFIITM.NE.2) GO TO 49
   51 DTA * 2.*DTA
      DTA2 » 2.#DTA2
      C5 - 1.5
      C6 « 2*
      GD2 • .5
      LY»2
   49 NU « NUX
   41 DO 98 NS=1»JMAX
      DO 98 MS=X»IMAX
      IS « (NS-D * IMAX + MS
      DO 585 I » 1»NP1
      U3(I) « 0.
      V3(I) = 0.
      TT3U) > 0.
      W31I) * 0*
      PP13JI) « 0.
      PP23II) » 0.
  585 CONTINUE
C    READ FILE 1 FOR RESTART
       READ (98 * IS) < RI(I)»I = 1»NCR)
       READ(97'IS) 
-------
      GTOm»DTO( Il/DZU »
      GWOI I )=OWOl I )/DZ( I )
 2000  CONTINUE
      H3  »  0»
I      INEWC  «  INEW
      1RAT  » IMARA
      IF(IGONY.EQ.l)  DELZ=0.0
      IF(NVCHSU).NE.l)  CALL RAD
      CALL  TTSQ
      IF    =  2.*W2in-Wim
      TT3(I)  » 2.*TT2(I I-TT1U)
  116  CONTINUE
      IF  (NVCHS(l)»EQ.l)   GO TO 52
  117  GO  TO  (112.111»111»112) .IGOGO
  111  II  *  1
      11=2
      IT»IM2
      I2-IM3
      I3=IM1
  129  15  »  IT -    IHT  +  1
      IF(   IHT.GT«2)  GO  TO 131
      15  *  IMS
      II  a  1
      II  *  2
  131  CALL CUV
      IF(IGONY.EQ.O)  GO  TO 121
  113  IF( IANV.GT.1) GO TO 118
      00  119 I=IHT»IX
      V3-J-M-  =0.0
  119  CONTINUE
      GO  TO  112
  118  DO  120 I=IHTtIX
      U3( I )  = 0.0
  120  CONTINUE
      GO  TO  112
  121  IF(IHT.EQ.l) GO  TO 112
      IFII2IHT.LE.IHT)  GO TO 123
      IIHT =  I2IHT-1
      DO  124 I»  IHT»  IIHT
  124  U3( I )  = 0.0
  123  IFII3IHT.LE.IHT1GO  TO  112
      IIHT =  I3IHT-1
      DO  125  1=  IHT»  IIHT
  125  V3(D*  0.0
  112  II  »  IP1
      IT=NM1
      I2-NM2
      I3*NX
MAIN 220
MAIN 221
MAIN 222
MAIN 223
MAIN 224
MAIN 225
MAIN 226
MAIN 227
MAIN 228
MAIN 229
MAIN 230
MAIN 231
MAIN 232
MAIN 233
MAIN 234
MAIN 235
MAIN 236
MAIN 237
MAIN 238
MAIN 239
MAIN 240
MAIN 241
MAIN 242
MAIN 243
MAIN 244
MAIN 245
MAIN 246
MAIN 247
MAIN 248
MAIN 249
MAIN 250
MAIN 251
MAIN 252
MAIN 253
MAIN 254
MAIN 255
MAIN 256
MAIN 257
MAIN 258
MAIN 259
MAIN 260
MAIN 261
MAIN 262
MAIN 263
MAIN 264
MAIN 265
MAIN 266
MAIN 267
MAIN 268
MAIN 269
MAIN 270
MAIN 271
MAIN 272
MAIN 273
MAIN 274
                                       68

-------
52
      I5 = 1A
      CALL CUV
      CONTINUE
      DO  54 I»1»NP1
   TT1
   UK
   Vl(
   Wll
   TT2
          I)
          )  i
          I)
I)
•  TT2  I)
U2
V2
W21
•  TT3
U3I
V3
W3I
« PP12(I>
= PP22(I>
= PP13(I)
= PP23II)
                     XT2 = TT3UXJ
      U2(
      M2(
      W2(
      PPlim
      PP2K I)
      PP12
      WRITE(97«IS)  (NXN( I) ».!=»! »NCR1»
      DO  59  I=liNPl
      Tl  =  U2   SAVE « Tl
   59  CONTINUE
      TDEL  «= XD/SAVE
I    WRITE YY ON  DISK USING  DIRECT ACCESS
      WRITE  (SDRUM'IS) (YINI I)»I»l»NWSYY>
   98  CONTINUE
:    SWITCH  FILE  UNITS  FOR RESTART
      I = RDRUM
      RDRUM  =  SDRUM
      SDRUM  *  I
      I1IHT  «  1
      DO  779 NS=1»JMAX
      DO  779 MS=1»IMAX
      IS  "  (NS-1)*IMAX +  MS
      READ  (98'IS) (  RI(I),I=1.NCR)
      READI97MS)  (NXN ( I I »I =1 »NCR1)
      CALL  ADVECT
  857  IFUGONY.GT.O) GO  TO  202
      IF(IHT.GT.l)  GO  TO  201
      SUM2  -  (CUX( IX)-(-CVY( IX) )*(DZ(
                      MAIN 275
                      MAIN 276
                      MAIN 277
                      MAIN 278
                      MAIN 279
                      MAIN 280
                      MAIN 281
                      MAIN 282
                      MAIN 283
                      MAIN 284
                      MAIN 285
                      MAIN 286
                      MAIN 287
                      MAIN 288
                      MAIN 289
                      MAIN 290
                      MAIN 291
                      MAIN 292
                      MAIN 293
                      MAIN 294
                      MAIN 295
                      MAIN 296
                      MAIN 297
                      MAIN 298
                      MAIN 299
                      MAIN 300
                      MAIN 301
                      MAIN 302
OF EACH GRID STATION AMAIN 303
                      MAIN 304
                      MAIN 305
                      MAIN 306
                      MAIN 307
                      MAIN 308
                      MAIN 309
                      MAIN 310
                      MAIN 311
                      MAIN 312
                      MAIN 313
                      MAIN 314
                      MAIN 315
                      MAIN 316
                      MAI-N 317
                      MAIN 318
                      MAIN 319
                      MAIN 320
                     'MAIN 321
                      MAIN 322
                      MAIN 323
                      MAIN 324
                      MAIN 325
                      MAIN 326
                      MAIN 327
                      MAIN 328
                      MAIN 329
                                     69

-------
    DO 209 I=2»IX
    K=1X-I+1
    SUM2 = SUM2 + (CUXIK)-t-CVY(K) ) * < 02 ( K-l ) +DZ ( K) )/2.
209 VVEL(K) » SUM2
    VVEL(IX)=0.
    IF(ITM.GT.l) GO TO 202
    ETA2 * 0.
    DEL2 * 0.
    SLOPX= tt.
    SLOPY« 0.                    '
    GO TO 202
201 00 267 I=1»IX
267 VVEU I ) = -0.0
    SUM1 - 0.
    IIHT = IHT
    IFUGONY.EQ.-2)  IIHT =» 2
    DO 200 K=IIHT»IM1
    SUM1 = SUM1 - ICUXIK) + CVY(K))*
    VVEU IP1) = VVEL(IX)
    ETA2 = ETA1 + VVEL(IX)*DT
    DEL2 * ETA2 - ETA1
    ETA1 = ETA2
    IF(ABS(ETA2).GT.500..AND .IGOGO.NE.D GO TO 206
    GO TO 205
206 PRINT 207.ETA2
207 FORMATdX.'THE WATER SURFACE
   1'  DEL2 » • iF12«3
   2/1 VVEL(IX) = •iF12«3/1 ITM
    GO TO 99
205 SUM! = VVEL( IP1)
    DO 208 I=IP2iNPl
    SUM1 = SUM1 - (CUX(I) + CVYI I) )«(D2(I-1)
    VVEL( I ) = SUM1
208 CONTINUE
    VVEL(NX) = SUM1  - (CUX(NX) + CVY ( NX ) ) * (02 ( NP1 ) /2. )
    GO TO 50
202 VVELI IP1) = 0.0
    VVEHIP2) =         .
   K(DZdPl) + D2(IP2))/2.)
    SUM1 = VVELI IP2)
    DO 203 K'=IP3tNPl
    SUM1 •" SUM1 - (CUX(K) + CVY(K) )*(«OZ(K-1)
    VVELI K) = SUM1
203 CONTINUE
    VVELINX) = SUM1  - (CUXINX)+ CVY I NX ) )* I 02 (NP1 ) /2« )
 50 WRITE (98»IS>  I  R I ( I ) . I =1 .NCR )
    WRITEI97»IS) (NXNI I)»I«1»NCR1) •
    WRITE (SDRUM'IS) I YIN! I ) » 1 = 1 »NWSYY )
779 CONTINUE
    SWITCH FILE UNITS  FOR AOVECT READ
    I  » RDRUM
    RDRUM •» SDRUM
      • DEL2.VVELIIX)iITM»IS»IGOGO
ELEVATION ETA2 ISSF12.3./

 '.I10/« IS = '»I10/' IGOGO » ».I10)
              D2(I))/2.
             - (CUXtIP2)+ CVY(IP2))*
               D2(K))/2.)
MAIN 330
MAIN 331
MAIN 332
MAIN 333
MAIN 334
MAIN 335
MAIN 336
MAIN 337
MAIN 338
MAIN 339
MAIN 340
MAIN 341
MAIN 342
MAIN 343
MAIN 344
MAIN 345
MAIN 346
MAIN 347
MAIN 348
MAIN 349
MAIN 350
MAIN 351
MAIN 352
MAIN 353
MAIN 354
MAIN 355
MAIN 356
MAIN 357
MAIN 358
MAIN 359
MAIN 360
MAIN 361
MAIN 362
MAIN 363
MAIN .364
MAIN 365
MAIN 366
MAIN 367
MAIN 368
MAIN 369
MAIN 370
MAIN 371
MAIN 372
MAI'N 373
MAIN 374
MAIN 375
MAIN 376
MAIN 377
MAIN 378
MAIN 379
MAIN 380
MAIN 381
MAIN 382
MAIN 383
MAIN 384
     70

-------
  65
  70
 701
 101
 SDRUM » I
 I1IHT » 2
 DO 792 NS=1.JMAX
 00 792 MSal.IMAX
 IS • (NS-1)*IMAX «• MS
  READ (98'IS) ( RHI).1 = 1.NCR)
  READ(97'IS) (NXN(I)»I»1.NCR1)
 CALL ADVECT
 CALL GWC
 WRITE (98'IS) ( RI
-------
 SUBROUTINE GREAD                                                  GREADOOO
 INTEGER RDRUM.SDRUMiTDRUM                                         GREAD001
 DOUBLE PRECISION A»B»C»CST»D.DTO»DWO.DST.DTI»FAtGWO.PP11»PP12     GREAD002
1   •PP13.PP21»PP22tPP23tSST»TTltTT2»TT3»TTO.TSC»U2»V2»Wl.W2»W3    GREA0003
2.   »WOtWSCiXKT»XYY»YY»GTO                                         GREADOOO
 COMMON XYY(30»6»5),A(30) ,B(30) ,C( 30 ) iCST'(30) ,D(30) ,DTO(30)        GREAD005
1   »DWO(30)»DST(30).FA130)»GTO(30)»GWO(30)»PP13(30)»PP23(30)      GREAD006
2   .TT3I30)tW3(30).SST              .                              GREAD007
 COMMON RI(30)»DT11 30).YY(30»6)»SLOPX»SLOPY»HEIGHT»ETA1»ETA2.XETA2»GREAD008
lYETA2,lHT»IANViIGOG»ETAINX»ETAINY»CSOUT(2)»CRSiRAA»TOUPRA»H3»CF»CEGREAD009
2»WS(30)»USTtCW»HAI.HSI»RANS»RABNStRABS»CRNS»TRAUS»XT2
 COMMON XKU(30)»VVELI30> »SRS»RADMX»IGOGO»ROWtXMQ»DEL
1   »XLAM»RSUM.(15) »B1»B2
 COMMON PP1K30) .PP2K30) .TT1(30)iTTOt30) »TSC(30) »Wl(30)»WO<30)
1
2
3
4
5
6
7
.7
    iWSC(30)»XKT(30)»CU(30)iCV(30).DTDTt30)«DTT<30)»U1<30)»V1(30)
    .ZDL2130).SOU1120J.SOU2I20)tSHl(20)»SH2<20)»NCLI»I SSI 1»ISS12
    iITS2(20) »ITSl(20)»ECLl<10»4)tLLCIllO,5).TCLI<10»4).ISTEP(10)
    .RAINK10) »I CUV (20) »XOCU(20) iXOCV(20) »XACU(20) »XACV(20)
    • NXN(IO) »TT'.V»DECL«COCOB»ICK»NTFOR.GSFiGFRtDTSFiSF
    .PHIR»GD2tISTR»SOSC»SOAB»XNO»CPH»SPH»PHI»H»IGONY»NTCUV
    PGXY(30»12)»CGXY(30.12)fI2IHT»I3IHT
GREAD010
GREAD011
GREAD012
GREA0013
GREAD014
GREAD015
GREAD016
GREAD017
GREAD018
GREA0019
GREAD020
   »Z<30) »ZA(30) iDZOO) tDS(30) »PA(45)»TA(45) tQA(45).COB(45)»COM(18 1GREAD021
 COMMON U3130) iV3(30)»TBO(30).WB0130).CKO(30)»CSW(30)»PSS(30)      GREAD022
1   »E(30.2»2)»F(30»2)fFST(30»2)»R(30»2»2)»BR(30)tTTI(30)»EC(5)    GREAD023
2   »TCL(5)tLLC(6).ST4(50).DST4(50)tDUW(50),QS(50)iRAI(20)»PST(30) GREAD024
 COMMON ITIMESI20)»IXTRA»MARAY(20)»PSFAIN(20)                       GREAD025
 COMMON SAVE»TDEL»XDTl.DT»XD»DECLX»DCHGiPHlBOT»HWEST»EM»ZW»C5iC6'  GREAD026
1  »NX»IX»NT»IMAX»JMAX,NPl»IPl.NP2.NMliNM2iIP2.IP3»IMl»IM2»IM3     GREAD027
2  »I4»IA»RDRUM»SDRUM»TDRUM»IGRID»IMARA»RTIME»IPOL»PI2»CFAR»NTIME  GREAD028
3  iEX2»EX3»EX6iXNV»XNT»BETV.BETT»DT2.DTA»DTA2.G»CP.PI»GAM»GAM2    GREAD029
4  »ROA»ALFfXKl,XK2,RALF,RC»CC.C32»XKl2.SH.HKK»HK2»Al»A2           GREAD030
5  »NWSYY«NTOPliDELHt  '  TW»INEW.I TAPE»I RAT»INEWC                   GREAD031
 COMMON BGtAR»AW»SIG»ATC»SK»IZW»IZWl»IY»IRiLY»NCSiNCR»NLAP»NCL     GREAD032
1   »NTOPtMA»NATAL»LAND»NVARltNVAR6«CPP»ITESTP                     GREAD033
 COMMON Tl»T2»T3»T4»T5»T6»T7»T8iT9»T10»TlltT12»XIlN»XJIN»TE»T20    GREAD034
2    »  T13»T14.T15»T16»XD1»YD1                                    GREAD035
3  •IS«RAlNX»ET»AT»ST»PTiNUX»LOCXYY(5)iNUlX                         GREAD036
 COMMON  CUT»CVTiCl»QST»NE»IGET«NNl»NU»ITM,Il»I2il3»I5»IT»MS.NS.II GREAD037
 COMMON COA(50)»CGA(50> »PAAB(50)tPASA(50)»RA(301»RB(30)»FN<30)     GREAD038
1 » I1IHT»I4IHT :                                                    GREAD039
 DIMENSION U2130)»V2(30).TT2(30) .W2(30)»PP12(30) iPP22(30)          GREAD040
 EQUIVALENCE (YY(1»1)»U2(1))»(YY(1.2 I»V2(1)).(YY11.6)»PP22ll))     GREAD041
1  »(YY(ti3) »TT2(1) ) i(YY( 1.4) »W2d) ) »(YY(1»5) »PP12t 1) )             GRE.AD042
 COMMON /TAPBLK / IUAR96»IUAR97,IUAR98»IUAR99                       GREAD043
 COMMON/INPUT/ VARIN(30.4)»NVCHS(5)»GNV(30»8)                       GREAD044
 COMMON /GRDNTS / GXY(30»12)                                       GREAD045
 DIMENSION ZEK30.6) .ZE2O0.6) .PUX130) .PUY130) .PVX130) .PVY(30)    ' GREAD046
1  »PTX(30) .PTYI30) »PWX(30) ,PWY(30) .XPK30) .PP1Y(30)                GREAD047
2  »XP2(30)iPP2Y(30).CUXI30)»CUY(30)»CVX(30).CVYI30)                GREAD048
3  »CTX(30) »CTY(30) tCWXOO) »CWY(30) »CP1X(30) tCPlYOO)              GREAD049
4  »CP2X(30)«CP2Y(30)                                               GREAD050
 EQUIVALENCE  (GXY (1 »1) tZEl (1 • 1 ».t (GXY (1.7) .ZE2 (1»1))              GREAD051
 EQUIVALENCE  (PGXY(1.1)»PUX(1))« (PGXY(1»7)»PUY(1) )                GREAD052
 EQUIVALENCE  (PGXY(1»2)iPVX(1))» (PGXY11.8).PVY(1)>                GREAD053
 EQUIVALENCE  (PGXY<1»3)»PTX(1))» (PGXY11»9)»PTY(1))                GREAD054
                                    72

-------
    EQUIVALENCE
    EQUIVALENCE
    EQUIVALENCE
    EQUIVALENCE
    EQUIVALENCE
    EQUIVALENCE
    EQUIVALENCE
    EQUIVALENCE
    EQUIVALENCE
(PGXYIlflO) iPWYdl)
(PGXYdill) »PP1Y( 1)
(PGXYd»12) »PP2Y< 1)
(CGXYd.7  l.CUY (1)
(CGXYd.8  )»CVY (1)
(CGXYd.9  I.CTY (1)
(CGXYd.ll)iCPlYd)
(CGXY(lil2) »CP2Yd)
700
230
              (PGXYd»4) ,PWX(1) ) »
              (PGXYd.5) »XPid) It
              (PGXYd»6J »XP2d) ) t
              (CGXYdil) »CUX d)
              (CGXYd»2) »CVX (1)
              (CGXYd.3) iCTX d)
              (CGXYd,4).CWX (1)
              (CGXYd.5) .CPlX(l)
              (CGXYd»6)»CP2Xd)
 DIMENSION ZI(30)»ZDIX(30).ZDIY(30).ARPRTd8)
 EQUIVALENCE < A d ) »ZI d ) > • < Bd ) .ZDIX d ) ) • (Cd > »ZD1 Y d ) )
 DATA ARPRT' /4HU CO»4HMPON»4HENT »4HV C0.4HMPOM»4HENT »4HTEMP»
IT »4HURE t   4HSALI»4HN./Ht4HUMID,4HPOLL.4HUTAN.4HT 1  .4HPOLL
2ANi4HT 2 /
 READ 100* (COMtl).1=1.18)
 PRINT 101.(COMU)»I = 1»18)
 ROA > «001
 READ 110. NX.IX»NT.IMAX.JMAX.NTIME»NVAR6»ITESTP»IPOL
 DO 2I«1»5
 NVCHSd) » 0
 IF(NTIME.GE.O)READ110,(NVCHS«I).I=1»5)
 IGRID = JMAX « IMAX
 PRINT llli NX.IX.NT.IGRID
 IGRID IS THE NUMBER OF STATIONS IN THIS MODEL GRID NETWORK
 READ 119.DT.XD.OECLX.DCHG.XIIN.XJIN
 DECL = DECLX* .017453293
 DCHG « DCHG # .017453293
 READ 119»PHIBOT»HWEST»EM»ZW.RTIME
 H * HWEST » .017453293
 PRINT 112» XIIN.XJIN.PHIBOT»DT»XD
 DT = DT*60.
 PRINT 1212* RTIME
 IFtRTIME.LE.O.)  RTIME = DT/60.
 IMARA = RTIME/DT#60.  +.5
 XD = XD * 1.E5
 NP1«=NX+1
 IS " 0
 IP1 = IX+1
 INITIAL STATION DATA INPUT    It  T»  U»   V»  W
 READ 119.(Z( I).I = 1.NPD
 DO 6 J»l»6
 READ 119,» (YY(I,J),I=1»NPU
 CONTINUE
 DO 230 I=5»6
 DO 230 N=1.NP1
 .YY(N.I) = YY(N.I)  / ROA / 100.
 COMPUTE PERIPHERAL GRADIENTS
 DO 420  K=l»6
 READ 110»IZ1
 READ 120. (ZIU)«I°1«IZ1)
 READ 120» (ZDIXd ) .I=1»IZ1)
 READ 120. (ZDIYd).I=l.lZl)
 K2 = 3»K
 Kl =• K2-2
    PRINT 123* IZ1)
     GREAD055
     GREAD056
     GREAD057
     GREAD058
     GREAD059
     GREAD060
     GREAD061
     GREAD062
     GREAD063
     GREAD064
     GREAD065
4HERAGREAD066
•4HUTGREAD067
     GREADQ68
     GREAD069
     GREAD070
     GREAD071
     GREAD072
     GREAD073
     GREAD074
     GREAD075
     GREAD076
     GREAD077
     GREAD078
     GREAD079
     GREAD080
     GREADOai
     GREAD082
     GREAD083
     GREAD084
     GREAD085
     GREAD086
     GREAD087
     GREAD088
     GREADQ89
     GREAD090
     GREAD091
     GREAD092
     GREAD093
     GREAD094
     GREAD095
     GREAD096
     GRE"AD097
     GREAD098
     GREAD099
     GREAD100
     GREAD101
     GREAD102
     GREAD103
     GREAD104
     GREAD105
     GREAD106
     GREAD107
     GREAD108
     GREAD109
                                       73

-------
 417
2418
1418
 231
 418
 420
 PRINT 121*  (ZD1X( I) »I*1*IZ1)
 PRINT 122.  (ZDIY
-------
     C32 = T4«»(-.5)
     T4 • T4**l«5
     XK12 = XK1**2
     SH = XK12*T4
     HKK = SH«XK2**2/XK12
     HK2 = SH/XK12
     HKK»HKK*10»
     CPP=-CP*1.0E06
AW=1000.*G
AR=2.87E+06
NTOP=NLAP-»-NPl
ATC » .001-
SK a 0.86933E-06
PI2 » PI * 2.
DELH » «DT/86400.)  * PI2
PDECL  = DECL / .017453293
PDCHG » DCHG  / .017453293
PRINH = H     / .017453293
PRINT 126»PDECLtPDCHG»£MiPRINH
DO 117 1»1»NX
Tl = (Z(I) + Z(I-H))/2.
ZAU) » ABS(Tl)
DZ«I> « Z(I + 1) - Z-JIJ
CONTINUE
DO 23K«1»IM1
 117
  23 DSIK)   a ZA(I)-ZAU+1)
     DS(IX)   * ABSIZIIM  - ZA(1)
     DO 715  I«IP1«NP1
     TE«Z(I)-ZW
     IF (TE)715.10,715
  10 IZW«I
     GO TO 132
 715 CONTINUE
     PRINT 1000»  (Z(l)»I=1»NP1)
  .   CALL EXIT
 132 IZW1=IZW-1                         .
     T20»ALOG(ZJIZW)/Z«1ZWD)
     Al = ALOGH950.   /Z( IZW1))/T20
     A2 » ALOGJZMZWJ/195.0.   J/T20
  99 RETURN
 100 FORMATU8A4)
 101 FORMA T11-X18A4///)
 110 FORMAT(14I5)
 111 FORMAT  (4H NX=.I3/4H IX*»I3/4H NT«.I3/7H
 112 FORMAT  (11H  X1IN   = F10.4/11H   XJIN
    1/11H DELTA T  = F6.1/10H DISTANCED.F7.2)
 119 FORMAT(6F12.4)
 120 FORMAT  (6E12.5)
 121 FORMAT  COX-GRAD    S6E12.5)
 122 FORMAT  I'OY-GRAD    '»6E12.5)
 123 FORfAAT  I '0 ' 13A41' GRADIENTS—INPUT VALUES1/'
 126 FORXATC13H DECLINATION  «E12.4/8H CHANGE  tE12
                         GREAD165
                         GREAD166
                         GREAD167
                         GREAD168
                         GREAD169
                         GREAD170
                         GREAD171
                         GREAD172
                         GREAD173
                         GREAD174
                         GREAD175
                         GREAD176
                         GREAD177
                         GREAD178
                         GREAD179
                         GREAD180
                         GREAD181
                         GREAD182
                         GREAD183
                         GREAD184
                         GREAD185
                         GREAD186
                         GREAD187
                         GREAD188
                         GREAD189
                         GREAD190
                         GREAD191
                         GREAD192
                         GREAD193
                         GREAD194
                         GREAD195
                         GREAD196
                         GREAD197
                         GREAD198
                         GREAD199
                         GREAD200
                         GREAD201
                         GREAD202
                         GREAD203
                         GREAD204
                         GREAD205
                         GREAD206
                         GREAD207
                         GRE-AD208
                         GREAD209
GRID n, 13)               GREAD210
 F10.4/11H PHI     » F8.2GREAD211
                     .   'GREAD212
                         GREAD213
                         GREAD214
                         GREAD215
                         GREAD216
    HEIGHTS(M)'»11F10.2) GREAD217
    4/ 36H INFRARED EMISSGREAD218
    1IVITY OF THE  SURFACE  »E12.4/12H HOUR ANGLE  »E12.4J
1000 FORMATdHli'    ZW VALUE IS INCORRECT-— HEIGHT ARRAY FOLLOWS1//
    1  (6F12.41)
1212 FORMAT {•OTIME STEP FOR RADIATION IS'»F10.2.'  MINUTES')
     END
                         GREAD219
                         GREAD220
                         GREAD221
                         GREAD222
                         GREAD223
                                        75

-------
  SUBROUTINE ADVECT                                                ADVCTOOO
 INTEGER RDRUM.SDRUM.TDRUM                                         ADVCT001
 DOUBLE PRECISION A»B»C»CST»D»DTO»DWO»DST»DT1iFA»GWO»PP11tPP12     ADVCT002
1   »PP13tPP21.PP22»PP23.S5T»TTl»TT2»TT3»TTO»TSC.U2»V2»Wl»W2tW3    ADVCT003
2   »WO.WSC»XKT»XYY»YY.GTO                                         ADVCT004
 COMMON XYYI30.6.5)iA(30).8(30!»C<30),CST(30 I»D(30)»DTO(30)        ADVCT005
1   »DWO(30)iDST(30) .FA (30) »GTO( 30) »GWO<30) »PP13 ( 30 ) .PP23OO)      AOVCT006
2   »TT3(30)»W3(30)»SST                                            ADVCT007
 COMMON RI(30>.DTl(30).YY(30.6)iSLOPX.SLOPY,HEIGHT.ETAl.ETA2.XETA2.ADVCT008
!YETA2»IHT«IANVtIGOG»ETAINX»ETAINY»CSOUT(2)»CRS»RAA»TOUPRA.H3»CF»CEADVCT009
2.WS130).UST.CW.HAI.HSI.RANS.RABNS.RABS .CRNS .TRAUS»XT2
 COMMON XKU(30)»VVEL(30)»SRS»RADMX.IGOGO.ROW.XMQiDEL
1   .XLAMtRSUMdS) »B1»B2
 COMMON PP11(30).PP2K30) »TT1 ( 30 ) »TTO( 30) »TSC( 30) »Wl ( 30) »WO( 30 )
1
2
3
4
5
6
7
7
    »WSC(30)»XKT(30)iCU(30)«CV<30)»DTDT(30)»OTT(30)»U1(30)»Vl(30)
    ,ZDLZ(30).SOU1(20)»50U2<20>.SHI(20)»SH2<20)iNCLI.I SSI 1•I SSI 2
    i!TS2(20) . ITS1(20)»ECLK10»4)«LLCI (10.5) .TCLK10.4) . I STEP (10)
    .RAINK10) , ICUVI20) tXOCU(20) *XOCV(20> «XACU(20) .XACVI20)
    .NXN(10).TTW.DECL»COCOB»ICK»NTFOR»GSF.GFR.DTSF»SF
    »PHIR.GD2.ISTR»SOSC.SOAB.XNb»CPH,SPH»PHI.H.IGONY.NTCUV
    PGXY(30»12)»CGXY(30»12)»I2IHT»I3IHT
                                                                   ADVCT010
                                                                   ADVCT011
                                                                   ADVCT012
                                                                   ADVCT013
                                                                   ADVCT014
                                                                   ADVCT015
                                                                   ADVCT016
                                                                   ADVCT017
                                                                   ADVCT018
                                                                   AOVCT019
                                                                   ADVCT020
   •ZC30)»ZA(30).DZ(30)«DS(30)tPA(45)»TA(45).QA(45).COB
                                                           .COMU81ADVCT021
 COMMON U3I30)»V3(30)»TBO<30).WBO(30)»CKO(30).CSW<30).PSSI30)      ADVCT022
1   ,E(30.2.2),F(30.2),FST(30,2),R(30.2.2).BR(30).TTI(30) .EC(5)    ADVCT023
2   »TCL(5).LLC!6)»ST4(50),DST4(50),DUW(50).05(50)»RAI(20).PST(30) ADVCT024
 COMMON ITIMES(20).IXTRA.MARAY(20)»PSFAIN(20)                      ADVCT025
 COMMON SAVE.TDEL.XDT1.DT.XD.DECLX.DCHG.PHIBOT.HWEST.EM.ZW.C5.C6   ADVCT026
1  .NX,IX.NT.IMAX.JMAX.NP1,IP1.NP2»NM1.NM2»IP2.IP3»IM1.IM2.IM3     ADVCT027
2  .I4.IA.RDRUM.SDRUM.TDRUM.IGRID.IMARA.RTIME.IPOL.PI2.CFAR.NTIME  ADVCT028
3  .EX2.EX3.EX6.XNV.XNT.BETV.BETT.DT2.DTA.DTA2.G.CP.PI.GAM.GAM2    ADVCT029
4  .ROA.ALF.XK1.XK2.RALF.RC.CC.C32.XK12.SH.HKK.HK2.A1.A2           ADVCT030
5  .NWSYY.NTOP1.DELH.   TW.INEW.I TAPE.IRAT.INEWC                   ADVCT031
 COMMON BG.AR.AW.SIG»ATC.SK.IZW»IZW1.IY.IR»LY»NCS.NCR.NLAP»NCL     ADVCT032
1   »NTOP»MA»NATAL.LAND»NVAR1»NVAR6.CPP»ITESTP                     ADVCT033
 COMMON T1.T2»T3»T4.T5 .T6.T7.T8.T9.no .Til,T12 .XIIN.XJ IN. TE.T20    ADVCT034
2    •  T13.T14.T15.T16.XD1.YD1                                    ADVCT035
3  »ISiRAINX»ET.AT.ST.PT»NUX»LOCXYY(5)»NU1X                         ADVCT036
 COMMON  CUTfCVT.Cl.QST.NE»IGET,NNl,NU.ITM,Il.I2»I3.I5.IT,MS.NS.ir ADVCT037
 COMMON COA(50)»CGA(50)»PAAB(50).PASA(50)»RAI 30)»RB(30)»FN(30)     ADVCT038
1 . I1IHT.I4IHT                                                    ADVCT039
 DIMENSION U2(30).V2(30)»TT2(30)»W2(30)»PP12(30)»PP22(30)          ADVCT040
 EQUIVALENCE (YY(1,1),U2(1)),(YY(1»2)tV2(1)).(YY(1.6),PP22(1))     ADVCT041
1  »(YY(lt3> .TT211)) »(YY( 1.4) »W2(1) > «
-------
      EQUIVALENCE
      EQUIVALENCE
      EQUIVALENCE
      EQUIVALENCE
      EQUIVALENCE
      EQUIVALENCE
      EQUIVALENCE
      EQUIVALENCE
      EQUIVALENCE
                 (PGXYU.4) .PWXll)
                 (PGXY(1»5) .XPK1)
                 (PGXYd.6) »XP2ll)
                 (CGXYdil) tCUX (1
                 «CGXY(1.2)»CVX »1
                 «CGXY(lt3).CTX
                 (CGXY(1,4).CWX
   .  (PGXY(l.lO).PWYll))
   .  (PGXY(l.H) .PPlY(l)
   .  (PGXY(1»12).PP2Y(1)
   Jt(CGXY(li7  J.CUY (1)
(1)).(CGXYll.e  )»CVY (1)
(1) ). .YIN2 < 1) ) »(XYY (1»1»3 > »YIN3< 1
           »»YINS<1)I
    DIMENSION VAR3<50)
    DIMENSION ALL(12»5)  tIALL(12»5>
    EQUIVALENCE (VAR3<1)»C11))  .(I ALL(1.1 ) »ALLl1»1) )
    DOUBLE PRECISION XTIMEiXTl
    NVAR1 » 1
    NVAR6 « 6
    DO 585 I « 1»NP1             .       .       .     .






585
C-IHHHH
C****
C
C
C
C
C
C
C
c**#*
U3(I
V3II
TT3(
W31I
PP13
PP23(
CONTI
(#####
FLOAT







WHERE
= 0.
a 0.
) > 0.
* 0.
I) • 0.
I) « 0.
NUE
»#**##•*
ING GRI







THE CO
ADVCT055
ADVCTC56
ADVCT057
ADVCT058
ADVCT059
ADVCT060
ADVCT061
ADVCT062
ADVCT063
ADVCT064
ADVCT065
ADVCT066
ADVCT067
ADVCT068
ADVCT069
ADVCT070
ADVCT071
ADVCT072
ADVCT073
ADVCT074
ADVCT075
ADVCT076
ADVCT077
ADVCT078
ADVCT079
ADVCT080
                    STATIONS ARE ASSIGNED THE FOLLOWING NUMBERS *»****«*ADVCT082
                                                                        ADVCT083
                                 647                                ADVCT084
                                                                        ADVCT085
                                 123                                ADVCT086
                                                                        ADVCT087
                                 859'                   AOVCT088
                                                  .                      ADVCT089
                COMPUTED GRADIENTS ARE APPLIED AT STATION 2 *»***»****«*ADVCT090
C##*#**#»***#*#*##*##*#*##***#******»*»#************#**»*********##»»###ADVCT091
      DO 666 I=l»5                                                      ADVCT092
      IF(I.EQ.2.0R.I.EQ.3) GO TO 666                                    ADVCT093
      DO 666 J = l»12  	_	-	    	   ADVCT094
      ALL(Jtl) = 0.                                                     ADVCT095
  666 CONTINUE                                                          ADVCT096
C  SET DATA FROM RESTART                       .           '              ADVCT097
                          (YIN2II)»I=liNWSYY)
  COMPUTES THE CENTERED AND UPWIND GRADIENTS
    IU3 » 3
    IF (MS-2) 511.501»501
 SETS STATION 2   MS=1
511 READ (RDRUM'IS)
    DO 600 1=1.12
    ALL!I .2) » YIN31I)
600 CONTINUE
    SLOPX = ALL(li2)
    SLOPY * ALL(2i2)
    HEIGHT « ALL(3»2)
    ETA1   " ALL(4.2)
                                      ADVCT098
                                      ADVCT099
                                      ADVCT100
                                      ADVCT101
                                      ADVCT102
                                      ADVCT103
                                      ADVCT104
                                      ADVCT105
                                      ADVCT106
                                      ADVCT107
                                      ADVCT108
                                      ADVCT109
                                          77

-------
    ETA2
    XETA2
    YETA2
    IHT
    1ANV
    ETAINX
    ETAINY
    I GOG »
    LOCXYY(2)
    IU3 « 2
    ALL(ll.l)
    ALL(12il)
 SETS STATION
501 DO 503
    DO 503
    IF
            » ALLI5.2)
            * ALL(6»2)
            » ALLI7,2)
            »IALL(8»2)
            =IALL19»2)
            » ALLdl.2)
            » ALL(12»2)
            IGOGO
               , -1

               = ALK11.2)
               « ALLI12.2)
               3   MS GT 1
            J=NVAR1»NVAR6
            K*1»NP1
        (MS.EQ.l) GO TO 1603
1603
 503
     XYYlK.Jfl)
     XYY(K»J»2)
     YY«»J)
     CONTINUE
     PP23(NP1>  =
     PP131NP1)  =
     IF(MS.EQ.l)
     DO 604 1=1*12
     IF( I.EQ.8.0R.I.EQ.10)
                 XYY(K*Ji2)
                 XYY(K»J,3)
                XYY(K»J»IU3)

                PP22(NP1)
                PP12(NP1)
                GO TO 610
                          GO TO 1610
                ALL(I»2)
                ALL(I»3)
1610
 604
    ALLUtl)
    ALL11.2)
    GO TO 604
    IALL< III)
    1ALLH.2)
    CONTINUE
    SLOPX = ALLU»2>
    SLOPY = ALL(2.2)
                 IALLU»2)
                 IALLII»3)










610

515
560
-HE.I.GHT
ETA1
ETA2
XETA2
YETA2
IHT
IANV
ETAINX
ETAINY
I GOG =
LOCXYYI
LOCXYYl
a ALL
= ALL
« ALL
» ALL
= ALL
"IALL
= IALL
= ALL
= ALL
I-GOGO
1) =
2) »
IF (MS-IMAX)
LOCXYYt
3) =
(3.2)
(4*2)
(5*2)
(6*2)
(7.2)
(8*2)
(9*2)
(11*2)
(12.2)

LOCXYY(2)
IS
560*561.
IS+1
     READ (RDRUM'IS-H)    < YlN3(. I ) »
     DO 601 1=1.12
     ALL! I »3)  = YIN4U )
 601 CONTINUE
     GO TO  562
 561 LOCXYYO) = -1
   STATIONS 1-3 SET   NOW SET 4-5
 562 IF (NS-1) 563.563,564
                                    iNWSYY)
ADVCT110
ADVCT111
ADVCT112
ADVCT113
ADVCT114
ADVCT115
ADVCT116
ADVCT117
ADVCT118
ADVCT119
ADVCT120
ADVCT121
ADVCT122
ADVCT123
ADVCT1Z4-
ADVCT125
ADVCT126
ADVCT127
ADVCT1Z8
ADVCT129
ADVCTL30
ADVCT131
ADVCT132
ADVCT133
ADVCT134
ADVCT135
ADVCT136
ADVCT13.7
ADVCT138
ADVCT139
ADVCT140
ADVCT141
ADVCT14-2
ADVCT143
ADVCT144.
ADVCT145
ADVCT146
ADVCT147
ADVCT148
ADVCT149
ADVCT150
ADVCT151
ADVCT152
ADVCT153
ADVCT154
ADVCT155
ADVCT156
ADVCTI57
ADVCT158
ADVCT159
ADVCT160
ADVCT161
ADVCT162
ADVCT163
ADVCT164
                                       78

-------
  563 LOCXYYI4) = -1
      ALLU1»4) = ALL(llf2)
      ALLI12»4) « ALL(12.2)
      GO TO 565
  564 LOCXYYU) = IS-IMAX
      READ (RDRUM'LOCXYYUJ)
      00 602 1=1.12
      ALLU.4) • YIN5(I )
  602 CONTINUE
  565 IF (NS-JMAX) 566t567»567
  566 LOCXYY15).» IS+IMAX
      READ (RDRUM'LOCXYY(5))
      DO 603 L«l»12
      < » NWSYY - 12 + L
      ALL(L.S) » YIN5(K)
  603 CONTINUE
                           (YIN4m»I»l»NWSYY)
                           (YIN5(I)tI=l.NWSYYJ
      GO TO 568
  567 LOCXYYI5) •
      ALLdl.5) -
      ALL112.5) >
C  ENTIRE XYY NOW
  568 CONTINUE
  619 S02 « SQRT(2.)
                -1
                ALL(11»2)
                ALL(12»2)
                SET FOR UPWIND
    UPWIND/CENTERED DIFFERENCE ROUTINE FOR UP TO 6 VARIABLES
      XMD = It /XD
      DO 649 I«l»12
      DO 649 J=1.30
      PGXYUtI) » 0.
      CGXYIJ*!) » 0.
  649 CONTINUE
      GO TO (620.642.642.620)»IGOGO
  642 IF(I1IHT.LT«2> GO TO 41
      II » 6
      IJ - 1
      IK « 3
      IL = 11
      DO 644 KK = 1,2
      IF«LOCXYYUJ>.LT.O.OR.LOCXYY(IK).LT.O) GO TO 645
      ALL(IIi2) « (ALL(5»IK) - ALL(5. IJ))*XMD/2.
      GO TO 615
      IF(LOCXYY(IJ).LT.O.AND«LOCXYY(IKJ.LT.O) GO TO 646
      IF(LOCXYY(IJ>.LT.O> GO TO 647
      IF(LOCXYY
-------
   I2IHT- IALL(BiJ)
   I3IHT = IALL(8.J)
      IF(I1IHT.EQ.2) RETURN
   41 IF(IGONY.EQ.-l) GO TO 620
      IF(ITM.GT.l) GO TO 620
      IF(IlIHT.EQ.l) GO TO 620
  641 I2IHT = IHT
      I3IHT » IHT
      DO 607 J»1.3
      IIHT = IALL(8»J)
      IF(IIHT.GT.I2IHT)
  607 CONTINUE
      DO 608 J=4.5
      IIHT * IALL(8*J)
      IF(IIHT.GT.13IHT)
 . 608 CONTINUE
  620 DO 599 IJXY»1,2
      IXY »UJXY-1)*6
      IF (IJXY-1) 1501*1501*1502
 1501 IF (LOCXYYUM 521*521*522
  521 IU3 » 2
      GO TO 523
  522 IU3 « 3
  523 IF (LOCXYY(l))
  524 IU1 » 2
      GO TO 1505
  525 IU1 » 1
      GO TO 1505
 1502 IF (LOCXYYUM
 1521 IU3 » 2
      GO TO 2521
 1522 IU3 ° 4
 2521 IF 
 1524 IU1 » 2
      GO TO 1505
 1525 IU1 * 5
C  UPWIND DIFFERENCE IN XU JXY = 11/Y( IJXY = 2 )  DIRECTION
 1505 IKI = 1
      IF( IGONY.EQ.l) IKIMP2
      DO 550  LR=IKI»NP1
      IF(XYY(LR.IJXY»2)) 531.532*536
C ABOVE CHECKS U/V  NOW INFLOW CONDITION CHECK
  531 IF (IU3-2) 435.532*435
  435 IU3U = IU3
      IU2 » 2,
      GO TO 534
C  UPWIND IS INFLOW—SET TO INPUT
  532 DO 533 J=NVAR1»NVAR6
      K = IXY+J
  533 PGXY(LR.K) * GXYtLRtK)
      GO TO 540
  536 IF UU1-2) 537*532*538
  537 IU3U = 2
      1U2 = 1
      GO TO 534
  538 IU3U « 2
      IU2  * 5
524*524.525
1521*1521*1522
1524.1524*1525
ADVCT220
ADVCT221
ADVCT222
ADVCT223
ADVCT224
ADVCT225
AOVCT226
ADVCT227
ADVCT228
ADVCT229
ADVCT230
ADVCT231
ADVCT232
ADVCT233
ADVCT234
ADVCT235
AOVCT236
ADVCT237
ADVCT238
ADVCT239
ADVCT240
ADVCT241
ADVCT242
ADVCT243
ADVCT244
ADVCT245
ADVCT246
ADVCT247
ADVCT248
ADVCT249
ADVCT250
ADVCT251
ADVCT252
ADVCT253
ADVCT254
ADVCT255
ADVCT256
ADVCT257
ADVCT258
ADVCT259
ADVCT260
ADVCT261
ADVCT262
ADVCT263
ADVCT264
ADVCT265
ADVCT266
ADVCT267
ADVCT268
ADVCT269
ADVCT270
ADVCT271
ADVCT272
ADVCT273
ADVCT274
                    80

-------
 UPWIND DIFFERENCE                                                    ADVCT275
534 DO 535 J=NVARltNVAR6                                              ADVCT276
    K = IXY+J                                                         ADVCT277
    PGXYJLR»M » XMD»CXYY(LRtJ»IU3U)-XYY(LR»J»IU2M                   ADVCT278
535 CONTINUE                                                          ADVCT279
  C COMPUTE CENTERED DIFFERENCE                                       ADVCT280
540 DO 547 J=NVAR1»NVAR6       .                                       ADVCT281
    K » IXY+O                                                         ADVCT282
    CGXY
-------
    SUBROUTINE RAD                                                    RAO  000
    SUBROUTINE TO COMPUTE TEMPERATURE CHANGES DUE TO RADIATION        RAD  001
    INTEGER RDRUM.5DRUM.TDRUM                                         RAD  002
    DOUBLE PRECISION A.B»C»CST»D»DTO.DWO»DST»DT1.FA.GWO.PP11,PP12     RAD  003
   1   .PP13tPP21fPP22.PP23iSST.TTl.TT2.TT3.TTO.TSC.U2.V2.Wl.W2.W3    RAD  004
   2   .WO.WSC.XKT.XYY.YY.GTO                                         RAD  005
    COMMON XYY130.6.5)»A(30>»B(30)«C(30)»CST<30).0(30).DT0130)        RAD  006
   1   »DWO(30)»DST(30)»FA(30)»GTO(30)tGWO(30)»PP13(30)tPP23(30)      RAD  007
   2   iTT3(30)»W3(30).SST                                            RAD  008
    COMMON RH30) tDTl ( 30) iYY ( 30»6 > .SLOPX.SLOPY.HEIGHT.ETA1.ETA2.XETA2»RAD  009
   1YETA2.IHT.IANV.IGOG»ETAINX.ETAINY.CSOUT(2)»CRS»RAA»TOUPRA.H3tCF.CERAD  010
   2.WS130)»UST»CW»HAI.HSI»RANS»RABNS»RABS»CRNS»TRAUS.XT2             RAD  Oil
    COMMON XKU(30) .VVELI30).SRS.RADMX.IGOGO.ROW.XMQ.DEL               RAD  012
   1   .XLAM.RSUMU5) .B1.B2                                           RAD  013
    COMMON PP1K30) »PP21<30) .TT1<30)»TTO(30) »TSC ( 30 ) iWl ( 30 > »WO(30)    RAD  OK
   1   »WSC(30).XKT(30)»CU(30).CV(30)»DTDT(30)»DTT<30>»U1(30)»V1(30)  RAD  015
   2   .ZDL2OO)  .SOUK20) »SOU2(20) »SHK20) ,SH2(20) .NCLI.ISSI1.ISSI2   RAD  016
   3   »ITS2(20)  .ITS1<20).ECLK10»4)»LLCI (10.5)  .TCLK10.4) .ISTEPUO)  RAD  017
   4   .RAINH10).ICUVI20)»XOCU(201»XOCV(20)»XACU(20)»XACV(20)        RAD  018
   5   .NXNUOJ.TTW.DECL.COCOB.ICK.NTFOR.GSF.GFR.DTSF.SF              RAD  019
   6   »PHIR»GD2»ISTR»SOSC»SOAB»XNO,CPH.SPH»PHI«H.IGONY»NTCUV         RAD  020
   7 * PGXY(30»12).CGXY(30»12).I2IHT.I3IHT                            RAD  021
   7  »ZC30)»ZA(30).DZI30).DS130).PA<45>.TA(45)»QA(45) .COB (45) .COM(18) RAD  022
    COMMON U3130) .V3130)»TBO(30)»WBO<30).CKOI30)»CSW<30)»PSS<30)      RAD  023
   1   .E130.2.2) »F(30»2)»FST(30»2).R(30.2 .2)»BR(30).TTI(30)»EC<5)    RAD  024
   2   .TCL(5).LLC16)»ST4(50).DST4150)»DUW(50)»QS(50).RAI(20)»PST<30) RAD  025
    COMMON ITIMES(20).IXTRA.MARAYt20)»PSFAIN(20)                      RAD  026
    COMMON SAVE.TDEL.XDT1.DT.XD.DECLX.DCHG.PHIBOT.HWEST.EM.ZW.C5.C6   RAD  027
   1  »NX»IX.NT.IMAX»JMAX»NP1»IP1.NP2.NM1.NM2«IP2.IP3.IM1»IM2»IM3     RAD  028
   2  »I4»IA»RDRUM»SDRUM»TDRUM.IGRID»IMARA,RTIME.IPOL»PI2»CFAR»NTIME  RAD  029
   3  .EX2.EX3.EX6.XNV.XNT.BETV.BETT.DT2.DTA.DTA2.G.CP.PI.GAM.GAM2    RAD  .030
   4  .ROA.ALF.XK1.XK2.RALF.RC.CC.C32.XK12.SH.HKK.HK2.A1.A2           RAD  031
   5  .NWSYY.NTOP1.DELH.    TWtINEW.ITAPE.I RAT•INEWC                   RAD  032
    COMMON BG.AR.AW.SIG.ATC.SK.IZW.IZW1.IY.IR.LY.NCS.NCR.NLAP.NCL     RAD  033
   1   .NTOP.MA,NATAL.LAND.NVAR1.NVAR6»CPP»ITESTP                     RAD  034
    COMMON T1»T2»T3»T4»T5»T6»T7»T8»T9»T10»T11»T12»XIIN»XJIN»TE»T20    RAD  035
   2    .  T13.T14.T15.T16.XD1.YD1                                    RAD  036
   3  »IS»RAINX.ET»AT.ST.PT»NUX»LOCXYY(5).NU1X                        RAD  037
    COMMON  CUT.CVT.C1.QST.NE.IGET.NNl.NU.ITM.il.12.13.15.IT.MS.NS.il RAD  038
    COMMON COAI50)»CGA(50).PAAB(50)»PASA(50)»RA<30 ) ,RB(30).FN(30)     RAD  039
   1 » I1IHT.I4IHT                                                    RAD  040
    DIMENSION U2(30)»V2(30).TT2I30) »W2(30) .PP12(30) .PP22I30)          RAD  041
    EQUIVALENCE                                                         RAD  053
    DO 934 I»1»NCL                                                    RAD  054
                                      82

-------
      CALL LINEAR I I TM« I STEP» 1 iNTFOR »L«ECLH 1 • I )t£CU ) ,T4«T4.T4»T4 tT4»T4 )RAD  055
      TCL(I) = TCLKLtl)                                                RAD  056
  934 LLC(I) = LLCKL*!)                                                RAO  057
      CX - 1. -EC(NCL)                                                  RAD  058
 1108 LLCINCL+1) » 61                         ,                          RAD  059
      DO 107I=»IM1»NP1                                                   RAD  060
      TA(II»TT2(I)               .                                       RAD  061
      OA(I)=W2(I)                         •                              RAD  062
      COBU) * PP12(I)*COCOB       -                                     RAD  063
  107 CONTINUE                                                          RAD  064
C  FOLLOWING RECOMUTES EMISSIUIY H20»C02 ATEACH STATION WHEN XD.GT.50KM RAD  065
 1407 ICOM = -1                                                         RAD  066
      IF (XD.GT. 50.E5) GO TO 112                    .                   RAD  067
      IF(IS.NE.l) GO TO 1507                                            RAD  068
  112 INEWC » INEWC+1                                                   RAD  069
      IF UNEWC-INEW) 1507»1505.1505                                    RAD  070
 1505 INEWC =0                   •                                      RAD  071
      ICOM » 1                                                          RAD  072
 1507 CONTINUE                                                          RAD  073
 1408 Cl = 3.7943/PAUP1)                  •                             RAD"  074
C  COMPUTE PATH LENGTHStST4,QS                                          RAD  075
      TTW = TW                                                          RAD  076
      DO 104 L=IPliNPl                                                  RAD  077
      K=L-IX      .                                                      RAD  078
      IF (ICOM) 501»501»702                                             RAD ,079
  702 DUWU) = -PA(L+lM*-PA*l.E-5                            RAD  089
      CGA(K) * T8»1.66*XNO                                              RAD  090
      PAAB(K) = T8*SOAB                                                 RAD  091
      PASA(K> = T8*SOSC                                                 RAD  092
  502 ST4JL) « SIG«TA(L)»*4                                             RAD  093
      DST4IL) « SIG»UTA(L)+TA(L+l))/2.)«#4                             RAD  094
      CXPA « 3«7943/PA«L)                                               RAD  095
      TEX = 3.0 + 7.5 #(TA(L)-273.16)/(TA(L)-35.66)                     RAD  096
      QS(L) « -CXPA * 10.0**TEX                                          RA&  097
  104 CONTINUE                                                          RAD  098
      KA « NP1-IX   +1                                                  RAD  099
      IF UCOM.EQ.l) CALL INFRAI(DUW»COA»KAiNATAL>                       RAD  100
      IF (ITM-1) 212»212»297                                           "RAD  101
  212 PRINT 213» (PA(I)*OS(I)i         I=IY»NP1)                        RAD  102
C  *** SOLAR RADIATION COMPUTATIONS  -              -                     RAD  103
  297 T3 = COS(H)                       .                                RAD  104
      T4 * COS(DECL)                                                    RAD  105
      T6 * SIN(DECL)                                                    RAD  106
      T5 » SPH»T6+CPH#T3#T4                                             RAD  107
      COSZ » T5                                                         RAD  108
      H » H + DELH                                                      RAD  109
                                         83

-------
      IF(H.LE.PI)  GO TO 2                            V                 RAD  110
      H *  H-PI2             '                                  '          RAD  111
      DECL"  DECL +  DCHG                                                  RAD  112
      PDECL  =  DECL/.017453293                                    •       RAD  113
      PRINT  299»ITM»PD£CL                                               RAD  114
  299  FORMATl//1 MIDNIGHT OCCURS AT TIME STEP'»I5»'  NEW. DECLINATION IS' RAD  115
     1.E12.4)                     .                                       RAD  116
    2  IF»EXP(T100)                                      RAD  148
   25  DTRU) = RAI(I) - RAKI-1)                                        RAD  149
      DTR(l) « RAI(1)                                                   RAD  150
      DO 27I=ltIMl                                                      RAD  151
      M=IX-I+1'                                                          RAD  152
   27  DTDT(l)  * DTR(I)  / DS(M)                                           RAD  153
      RH = RAHIX) - RAKIM1)                                            RAD  154
:   INFRARED  SURFACE  FLUX                                                RAD  155
   99  CALL INFRA  (1 ,DST4(IP1).ST4(IP1)»LLC»EC»DTT,PA(IP1)»RA,RB»CGA)    'RAD  156
      RAA  =  RA(l)  +  RADMX                                               RAD  157
      RSUM(6)  = DT*RAtl) +  RSUM(6)   -                                   RAD  158
I   **» HEAT  BALANCE                                                      RAD  159
    .  LOOP = 0                                                          RAD  160
      TG1= TA(IP1>                                                      RAD  161
      IFITG1-  273.16)855t855»860                                        RAD  162
  855  XLT  =  677.                                                         RAD  163
      GO TO  861                                                         RAD  164
                                        84

-------
  860  XLT  =  597.3  - 0.57*(TG1-273.16)                                    RAD   165
  861  T5 =  1.  /  (EM *  SIG)                                               RAD   166
      IF(RAINX.GT.O) GO  TO 862                                           RAD   167
      TRW  =  TACIP1)                                                      RAD   168
      GO TO  865                   ,                                       RAD   169
  862  TWBAR  =  0.                                                         RAD   170
      NC =  0                              .                      .        RAD   171
I      RAINFALL THROUGH LAYER  COMPUTATION                                 RAD   172
      DO 864I«IP2»NP1                                                    RAD   173
      ZWS  »  Z(I)                                                         RAD   174
      IF1ZW.GT.ZWS.AND.ZWS.GT.O.)  GO  TO 863                              RAD   175
      SN =  NC                                                            RAD   176
      TRW  =•  TWBAR/SN                                                    RAD   177
      GO TO  865                                                          RAD   178
  863  NC =  NC+1                                                          RAD   179
      TWBAR  =  TWBAR +  (TA(I)-XLT*1.E-03/CP *  (QSd)-QA(im              RAD   180
  864  CONTINUE                                                          RAD   181
  865  ET1  =  -.001  * ROA  *  XKTUP1)                                       RAD   182
      N *  1                                                              RAD   183
      ATI  =  -ROA * CP  *  XKT(IPl)                                         RAD   184-
      ST1  «  ROW *  CW » XKT(IMl)                                          RAD   185
  532  CONTINUE                                                          RAD   186
      ET =•  ET1 *  KW2UP2)  -  W2UPD)  / Z(1P2))                          RAD   187
      AT =  ATI *  ((TAIIP2)  -  TA(IPD)  / DZ(IPl)   +  GAM  )                 RAD   188
      ST "  ST1 *  UTAUP1)  -  TA(IMD)  / DZ(IMD)                         RAD   189
:      RAIN  EFFECT  TERM  -PT-                                             RAD   190
      PT *  ,935*RAINX*(TRW-TA( IP1))                                      RAD   191
      T4 =  T5  *(RH + RAA - AT -  ST -XLT*ET +  PT)                         RAD   192
      IF(T4)74.74i870                                                    RAD   193
   74  IF(LOOP)75»75»203                                                  RAD   194
   75  PRINT  150»ITM»ETtATtST»XLT»  RAA  »RH»SRS                           RAD   195
      TG3  »  TGI/2.                                                      RAD   196
      GO TO  871                                                          RAD   197
  870  TG3  »  T4**.25                                                     RAD   198
  871  GO TO  (199»200»200)»N                                              RAD   199
  199  N-*  2                                        "                      RAD   200
      DET1  « TG3-TG1                                                     RAD   201
      TG «  TG3                                                          RAD   202
      IF(ABS(DETl)-ATC)882»882il81             .                          RAD   203
  200  DET2  » TG3-TG2                                .                     RAD   204
      1F(ABS(DET2)-ATC)105«105.186                                       RAD   205
  105  TG »  (TG2+TG31/2.                                                  RAD   206
      GO TO  882                                                          RAD   207
  186  IF(ABS(DET1)-ATC)882.882*1106                                      RAD   208
1106  IF(DETl)191»882il92                                                RAD   209
  191  IF(DET2)193»193»184                                              : RAD   210
  192  IFIDET21184.193.193                                                RAD   211
  184  N=3                                                                RAD   212
      GO TO  203                      '                                   RAD   213
  193  TGI  =  TG2                                                          RAD   214
      GO TO  (199.202.203),N                     .                         RAD   215
  202  TG »  TG3                                                          RAD   216
      DET1  = DET2                                                        RAD   217
      GO TO  181                                                          RAD   218
  203  DET1  = DET1/2.                                                     RAD   219
                                         85

-------
      TG = TGI + DET1                                                   RAD  220
  181 LOOP => LOOP + 1                                                   RAD  221
      TG2 = TG                                                          RAD  222
      IF(LOOP-25)884»884»97                                             RAD  223
  884 TEX - 3.0 + 7.5 * (TG-273.16) / (TG-35.66)                        RAD  224
      OSG = C1*10.0**TEX                                                RAD  225
      W2UP11 = QSG*XMQ-H1.-XMQ)*W2UP2)                                RAD  226
      TAUP1) « TG                        '                              RAD  227
      GO TO 532                   "                                     RAD  228
  882 CONTINUE              '     '                                       RAD  229
      IF (W2UP1UGT.QSG) W2(IPD » QSG                                 RAD  230
      GO TO 404 '                                                        RAD  231
   97 PRINT 151.1TM»ETiAT»STtXLTt RAA »RH»SRS »TG                       RAD  232
  150 FORMATI15H  IN TIME STEP »I3»» T**4 INITIALLY COMPUTED LESS THAN ZRAD  233
     XERO1//" VALUES OF ET»AT»ST»XLT. RAA »RH AND SRS FOLLOW/7E12.4)    RAD  234
  151 FORMAT(15H  IN TIME STEP »I3»' AFTER 25 ITERATIONS T(Z=0) DID NOT RAD  235
     XCONVERGE TO WITHIN THE SPECIFIED TOLERANCE'//'VALUES OF ET»AT»ST»XRAD  236
     XLT» RAA »RHi SRS.TG FOLLOW ./8E12.4)                              RAD  237
  404 1X1 * IX+2                                                        RAD  238
  405 II = NP1-1X                                          ,             RAD  239
C  *** INFRARED ATMOSPHERIC COOLING                                     RAD  240
      CALL INFRA*XMQ+(1.-XMQ)*W2(IP2)                            .  RAD  252
      WSC(IPl) = W2(IP1)-WO(IP1)                                  '       RAD  '253
C  RADIATION AND HEAT BALANCE  SUMS                          '            RAD  254
      RSUM(l) = RSUM(l) + DT * ET * XLT                                 RAD  255
      RSUM12) = RSUM(2) + DT * AT                         .              RAD  256
      RSUM<3) = RSUM(3) + DT * ST                                       RAD  257
      RSUMUJ = RSUMJ4) + DT * PT     .  .  ' .                             RAD  258
      RSUM(5) = RSUM15) +-OT * RH    .                                   RAD  259
      RSUM(7j = RSUM<7) + DT * RADMX                                    RAD  260
      RSUMJ8J = RSUM(8) + DT * TG**4 * SIG *  EM                         RAD  261
      RSUMC9) '= RSUM(9J+DT*(TE-TOUPRA)                                   RAD"  262
      K = NP1-IX+1                                                      RAD  263
      RSUM(10)= R5UM(10}+DT#lRA{K)-RBlia )                               RAD  264
      XT2 = TSC(IX)                                                      RAD  265
      RANS =  RAJK) * 1.E3                                               RAD  266
      RABNS=  RB(K) * 1.E3                                               RAD  267
      RABS =  RBU) * 1.E3           '                                   RAD  268
      CRNS =  TE * 1.E3                                                  RAD  269
      TRAUS=  (RB(K)-RA«K)  + CRS*SRS)  » 1.E3         •                     RAD  270
      DO 5000  I=1»NP1         .                                         RAD  271
      TT2UJ=TSCm                                                      RAD  272
 5000 W2(I)=W5CU )                                                      RAD  273
      HAI » AT       .                                                  RAD  274
      HSIS  ST                                                            RAD  275
      CE  =  ET  -  RAINX                                                    RAD  276
      RETURN                                                             RAD  277
      END                                                               RAD  278
                                           86

-------
 SUBROUTINE SOATA                                                  SDATAOOO
 INTEGER RDRUV|»SDRUM«TDRUM                                         aQATAOOl
 DOUBLE PRECISION A»B»C»CST»D»DTO.DWO»bST»DTL.FA»GWO»PPLL.PPi2     SDATA002
1   .PP13»PP21iPP22.PP23»SST»TTl»TT2»TT3»TTQ»TSC»U2»V2»Wl»W2»W3    SDATA003
2   .WOtWSC.XKTtXYYiYY.GTO                                         SDATA004
 COMMON XYYOO.6.5)»A(30).6(30)tC(30)rCST(2Q> r£»(30)»DTO(30)        SDATA005
1   .DW0130) iDSTOO) iFA(30) »GTO(30) .GWQ13QI »PP13< 30 ) »PP23t 30)      SDATA006
2   »TT3(30)»W3(30)»SST                                            SDATA007
 COMMON RI(30)iDTl(30)»YY(30»6).SLOPX.SLOPY.HEIGHT.ETAlrETA2 »XETA2 »SDATA008
1YETA2.IHT»IANV.IGOG»ETAINX.ETAINY»CSOUT12UCRS»RAA»TOUPRA»H3»CF»CESDATA009
2.WSOO) .UST.CW.HAI .HSI .RANS.RABNS»RABS»CRNS»TRAUS»XT2
 COMMON XKU<30).VVELI30)»SRS.RADMX»IGOGQ.ROW»XMQ»DEL
1   .XLAM.RSUM115).B1.B2
 COMMON PP1K30) .PP2K30) .TTK30) »TTO( 30) »TSCt 30) tWLl 30 ) »WO( 30)
1
2
3
5
6
7
7
,WSC(30)»XKT(30)iCU(30)»CV(30)»DTDT(30),DTT(30)tUK30)»V1(30»
»ZDL2(30)iSOU1(20).SOU2120)»SHl(20)»SH2(20)»NCLI»ISSI1»ISSI2
.ITS2(20),ITSl<201.ECLI(10»4),LLCmO»5>»TCLH10.4)»ISTEP<10»
iRAINKlO) , I CUV (20) ,XOCU ( 20 ) .XOCV 120) »XACU( 20) »XACV(2QI
•NXN(10)«TTW»DECL»COCOB.ICK»NTFOR»GSF»GFR»DTSF»SF
,PHlR.GD2tISTR»SOSC»SOAB.XNO»CPH,SPH»PHI»H»IGONY»NTCUV
PGXY(30.12)»CGXY(30.12).121HT.I3IHT
                                                                SDATA010
                                                                SDATA011
                                                                SDATA012
                                                                SDATA013
                                                                SDATA014-
                                                                SDATA015
                                                                SOATA016
                                                                SOATA017
                                                                SOATA018
                                                                SDATA019
                                                                SOATA020
»Z(30) iZA(30) »DZ(30) .OS( 30 ) »PAU5 ) .TAU5
                                                       »COMt 181SDATA021
 COMMON U3I30) »V3(30) .TBOI30) »WBOC30) »CK.O (30 ) »CSWl 30) »PSS(30)      SDATA022
1   tE(30t2t2)»F(30»2).FST(30t2)»R(30.2»2)iBRC30)»TTI(30).EC(51    SDATA023
2   .TCL<5).LLC(6).STM50)»DSTM50).DUW(50) ,QSC50» »RAI ( 20) »PST(30J SOATAOZ'f
 COMMON ITIMESI20)»IXTRA,MARAY(20)»PSFAIN(20)                      SDATA025
 COMMON SAVEtTDELiXOTl»DT»XD»DECUX»OCHG»PHIBOT»HWEST»EM»ZW»C5»C&   SOATA026
1  »NX»IXiNT»IMAX»JMAX»NPl*IPl»NP2*NMl»NM2»IP2tIP3tIMl»IM2»IM3     SOATAQ27
2  »I^»IA»RDRUM»SDRUM»TDRUMiIGRID»IMARAtRTIME»IPOL»PI2»CFAR»NTIME,  SDATA028
3  »EX2»EX3.EX6»XNV»XNT»BETV»BETTt-DT2fOTA»OTA2»G»CP»PI »GAM»GAM2    SOATA029
4  .ROA.ALF»XK1«X<2»RALF,RC»CC»C32»XK12»SH»HICK«HK2»A1»A2           SDATA030
5  >NWSYY»NTOPl»DELHi   TW»INEWiITAPE.I RAT»INEWC                   SOATA031
 COMMON BG.AR,AW»SIG.ATC.SK.IZW.IZW1»IY.IR»LY.NCS»NCR»NLAP»NCL     SDATA032
1   »NTOP»KA.NATALiLANO»NVARl»NVAR6»CPP»ITESTP                     SDATA033
 COMMON Tl.T2»T3»T4»T5»T6»T7»T8»T9»T10»Tll»T12»XIIN»XjrN»TE»T20    SDATA034
2    t  T13.T14»T15»T16.XD1»YD1                                    SDATA035
3  »IS»RAINX»ET.AT.ST»PTfNUX»LOCXYY(5)»NUIX                        SOATA036
 COMMON  CUT.CVT»C1.QST.NE»IGET,NNl.NU.ITM,II,12»I3.I5.IT.MS.NS.il SDATA037
 COMMON COA150),CGA(50).PAAB(50).PASA(5Q).RA(30)»RBI 30) .FN130)     SDATAQ38
1 . I1IHT»I41HT                                                    SOATA039
 DIMENSION U2(30)»V2(30) »TT2(30) »W2<30) »PP12(30) .PP22OOI          SDATA040
 EQUIVALENCE  (YY(1,11,U2(1)),IYY(1.2),V2(1))»(YY(1.6)»PP221IIJ     SDATAO^l
1  »(YY(1»3) »TT2(D ) tJYYdi^J »W2(1) ) ,(YY(1.5) »PP12(1> )             SDATAO               SDATA047
2  iXP2(30) .PP2YI30) iCUXOO) iCUYOO) .CVX(30) .CVY130I               SDATA048
3  »CTX(30).CTY(30)»CWXt30).CWY(30r»CPlX(30)»CPlYC30>              SDATA0^9
4  »CP2X(30).CP2YI30)                                              SDATA050
 EQUIVALENCE  (GXY(1.1)»Z£1(1.1)).(GXY(1.7)»ZE2(1»1))              SDATA051
 EQUIVALENCE  (PGXY(1.1)»PUX(1)). (PGXY(1.7)»PUY(1)»               SDATA052
 EQUIVALENCE  (PGXY(1.2).PVX<1)). (PGXY(1.8)»PVY11))               SDATA053
 EQUIVALENCE  (PGXYI1*3)»PTX(1»» (PGXY(1»9).PTY(1))       '        SDATA054
                                    87

-------
    EQUIVALENCE
    EQUIVALENCE
    EQUIVALENCE
    EQUIVALENCE
    EQUIVALENCE
    EQUIVALENCE
    EQUIVALENCE
    EQUIVALENCE
    EQUIVALENCE
 (PGXYd»10) »PWY(L.U
 (PGXYd»ll)fPPl*HJi
 (PGXYd.12
i(CGXYd»7
• tCGXYd»8
.(CGXY(1,9
.(CGXYd.10
tCUY
»CVY
•CTY
»CWY
                                                        (LI)
                                                        cm
                                                        (1) )
                                                        (1) )
                                       »(CGXY(l,ll),CPlYd) )
                                       • (CGXYd.12) tCP2Yll) J
                   (PGXYI1.4) ,PWXll) ) «
                   XPld) ) .
                   (PGXYU.6) .XP2H) ) i
                   (CGXY(ltl) iCUX (1)
                   (CGXYd.2) .CVX (1)
                   (CGXYdiS) «CTX 11)
                   (CGXYU.4) tCWX (!)
                   (CGXYdiS) »CPlXd)
                   (CGXYd.6) »CP2XH)
      DIMENSION YIN2d) »YIN3d)iYIN4d)»YIN5d)
      EQUIVALENCE ( XYY d »1 .2 ) • Y IN2 d ) ) » < XYY ( 1 t 1 »3 ) » YIN3 d ) )
     1       . (XYYd»l»M.YINMl))»(XYYd»l»5>»YIN5d»
      DIMENSION VAR3150)
      DIMENSION ALLd2»5) tIALL(12t5>
      EQUIVALENCE (VAR3d).Cd)l . d ALLd »1 ) .ALL d »1 ) )
      DOUBLE PRECISION XTIMEtXTl
C  SUBROUTINE TO SET DATA AT EACH STATION INITIALLY AND AT EACH RESTART
      IF (ITM) 11»11»301
   11 IF (IS-1) 12fl2»1313
C  READ IN INITIAL TIME ONLY        FOLLOWING FOR ALL STATIONS
   12 CONTINUE
      READ 2»NLAP»NPU   ......
      NTOP = NLAP+NP1
      NATAL = NTOP-IX
      DO 13I=NP2fNTOP
      READ It PA( I ).TA( I) ,QA( I ItCOBI I )  v
      PRINT l.PAd )»TA(I)»QAd)»COB(I)
      CONTINUE
      STMNP2)=SIG*TA(NP2)**4
      NTOP1=NTOP-1
      TW «* 0.    .
      IF (XIIN.EQ.1..AND.XJIN.EQ.1.  ) GO TO 19
      XYY(LEVEV»        VARIABLE IN YY  tSTATION)
      XD1 = XD*(X1IN-1«)   .                      .....
      YD1 «-XD»(XJIN-l«)
      DO 191J»1»6
      I = J
      DO 18 K=1»NP1
      XYY(K»J,2) » YY(IC»J  ) "ZE2 ( K> I )#YD1-ZE1 (K » I )*XD1
      IF (J-4) 192»191»191                 ...... -  .
 13
190
 18
  192 XYY(IPliJ»2)
  191 CONTINUE
      GO TO 25,
   19 DO 20 J=l»6
      DO 20 I=liNPl
   20 XYY( I»J  »2)  =
C  ALL CARDS READ IN
C  FOLLOWING AT EACH
   25 IF (NTIME.LT.O)
                 * XYYUX*J»2>
                       YY( I iJ)
                   AFTER ALL STATIONS STARTED
                   STATION  AT TIME STEP ZERO
                    GO TO 1313
  301 IF (ITM.NE.NTIME«OR.IS.GT.l)
      IGET = ITM
      READ 2» NTIMEtK
      DO 302 I»liNPl
  302 READ l»(VARINd»J) iJ»l»4>
      DO 303 I'liK
                                 GO TO 389
SDATA055
SDATA056
SDATA057
SDATA058
SDATA059
SDATA060
SDATA061
SDATA062
SDATA063
SDATA064
SDATA065
SDATA066
SDATA067
SDATA068
SDATA069
SDATA070
SDATA071
SDATA072
SDATA073
SDATA074
SDATA075
SDATA076
SDATA077
SDATA078
SDATA079
SDATA080
SDATA081
SDATAQ82
SDAfA083
SDATA084
SDATA085
SDATA086
SDATA087
SDATA088
SDATA089
SDATA090
SDATA091
SDATA092
SDATA093
SDATA094
SDATA095
SDATA096
SDA.TA097
SDATA098
SDATA099
SDATA100
SDATA101
SDATA102
SDATA103
SDATA104
SDATA105
SDATA106
SDATA107
SDATA108
SDATA109
                                       88

-------
      IF (NVCHS(l).EQ.l) READ 1 .BR(I),(R(I,J.1).J=1.4)
      IF (NVCHS(2).EQ.l) READ 1.V3(I),IE(I,J«1).J=1.4)
  303 CONTINUE
      DO 304 I=1(NP1
      Tl « Zd)
      IF (I.EO.IX) T1*T1-«00001
      IF d.E0.1Pl)Tl = Tl + .00001
      IF (NVCHSd) .NE.l) GO TO 305
      CALL XINEAR (Tl»BR*4»K»L»R(1•1»1)«GNV(I•1)»
     1  R (1»2»1) ,GNVl I»2).R(1.3.1) »GNV( I,3),Rd,4.1) *GNV( 1*4) )
      GXYd.l) = GNVdd)
      GXYd.7) « GNV(I»2)
      GXYd.2) = GNVd»3)
      GXYd.8) « GNVd.4)
      IF (NVCHSI2).NE.l) GO TO 304
      CALL XINEAR (Tl»V3.4.K.L,Et1,1,1),GNVd.5)»
        Ed *2»1) *GNVd»6) (Ed * 3d) .GNVd»7) .Ed »4» 1) .GNV (I .8 ) )
305
)
                GNV(I.5)
                GNV1I.6)
                GNV(I»7)
                GNVd.8)

             1313,1313,500
      GXYd.3
      GXY(I.9 )
      GXYd»4 I
      GXYd»10)
  304 CONTINUE
  389 IF (ITM)
 1313 CONTINUE
      IRAT » IMARA
      INEW = 10 *IMARA
      INEWC - INEW
C  READ FOR EACH STATION   CLOUDS FROM RAD
C                          THERMAL CONDUCTIVI  IF LAND
C             ANY OTHER VARIABLE REQUIRE FOR A PARTICULAR RUN
C  READ STATION VALUES              FOLLOWING AT STATION START
      READ 2, NTFOR.NCLiNTCUV»IPOI.IGONY.ISSIl.ISSI2
      READ 67.PSFA.XLAM.DEL
      READ 68»              SLOPX»SLOPY»HEIGHT.ETAINX»ETAINY.IANV
      FORMAT(5E12t5»I12)
      FORMATI8F10.2)
      FORMAT(7F10.2)
      PRINT llll.PSFA.XLAM»DEL»SLOPX»SLOPY.HEIGHT»ETAINX»ETAINY.IANV
      IGOGO = IGONY + 3
      IGOG  «= IGOGO
      HEIGHT = HEIGHT#100.
      IF(HEIGHT.EQ.O.O) GO TO 313
      DO 34 1=1. IX
      K => IX-I-t-1
      IFlHEIGHT.LT.Z(K) ) GO TO 34
      IHT = K *1
      GO TO 36
   34 CONTINUE
      1HT = 1
      GO TO 36
  313 IHT * IP1
   36 CONTINUE
      DO 30 I-l.NTCUV
      READ  5. ICUVt I ) ,XOCU( I ) ,XOCV( I ) ,XACU( I ) ,XACV( I ) ,T1,T2
      PRINT 5»ICUVd) .XOCUd) »XOCV« I ) »XACU( I )»XACV(I I »T1.T2
 68
 67
  1
 30
 SDATA110
 SDATA111
 SDATA112
 SDATA113
 SDATA114
 SDATA115
 SDATA116
 SDATA117
 SDATA118
 SDATA119
 SDATA120
 SDATA121
 SDATA122
 SDATA123
 SDATA124
 SDATA125
 SDATA126,
 SDATA127
 SDATA128
 SDATA129
 SDATA130
 SDATA131
 SDATA132
 SDATA133
 SDATA134
 SDATA135
 SDATA136
 SDATA137
 SDATA138
 SDATA139
 SDATA140
 SDATA141
 SDATA142
 SDATA143
 SDATA144
 SDATA145
 SDATA146
 SDATA147
 SDATA148
 SDATA149
 SDATA150
 SDATA151
 SDATA152
 SDATA153
 SDATA154
 SDATA155
'SDATA156
 SDATA157
 SDATA158
 SDATA159
 SDATA160
 SDATA161
 SDATA162
 SDATA163
 SDATA164
                                       89

-------
      IF (NTFOR.UE.O) NTFOR « 1                                         SDATA165
      ISTEPll) = 601                                                    SDATA166
      IFINCD114.114.115                                                SDATA167
 I     NUMBER OF CLOUD LAYERStAMOUNTS AND RAINFALL RATE INPUT            SDATA168
  115 DO 933 I=1*NTFOR                         '                         SDATA169
      READ  3.ISTEPII l.NXNd ) .RAINI ( I ) , ( LLCI ( ULl.ECLl 11 »L1 *TCLtf I »Li »  SQATA170
     1  L'liNCL)                                                        SOATA171
      PRINT 3»ISTEPd)»NXN(I) iRAINK I 1.1LLCI (£»L)»ECLr(I»L)»rCLItr»L>r SDATA172
     1  L*1»NCL)                    '                                    SDATA173
      DO 933 LL=1»NCL            .                                       SDATA174
  933 LLCKItLL) » LLCIUtLL)    -IX                                    SDATA-175
  114 NCLI = NCL              .                                          SDATA176
      LLCK1»NCL+1) « 61                                                SDATA177
      GO TO (1520.1520.1520*1510)»IGOGO                                 SDATA176
 1510 READ 1  . SRS.ROW.CW.XMQ.RADMX  .                                  SDATA179
      PRINT 1  .SRS.ROW.CW.XMQ.RADMX                                    SDATAL80
      READ  1  . (XKTd ),! = !, IML>                                       SDATAL81
      PRINT 1  . (XKTd ).I*1»IMU                                       SDATA182
 1520 CONTINUE                                                          SDATA183
      DO 6991=1.20                                                      SDATAL84
      SOUK I) ' 0.                                                      SDATAI85
      SOU2(I) « 0.                                                      SDATA186
      IFd.GT.6) GO TO 699                                              SDATA187
      SHKI) « 0. •                                                      SDATA188
      SH21I) « Of                                                       SDATAI89
  699 CONTINUE                                                          SDATAL90
      IFdPOI )700i700.701                                               SDATAL91
  701 READ 2. (ITSld il-ltlSSIZ)                                       SDATA19Z
      PRINT 2,(ITSld »I = 1.ISSI1)                                       SDATA193
      READ 1  . (SOU1 I>.I=1»ISSI1>                                     SDATA194
      PRINT 1  »(SOU1 I)»I=liISSID                                     SDATAL95
      READ 1  .(SHKI .1 = 1.6)-                                           SDATA196
      PRINT 1  »(SHK )»I=1»6)                                           SDATAL97
      IFdP01.EQ.il GO TO 700                                           SDATA198
      READ 2.  dTS2( ).I = liISSI2)                                       SDATA199
                        I=1,1SSI2)                                       SDATA200
              •  (SOU2II).I=1.ISSI2>                                    SOATA201
               » (SOU2d) »I«1»ISSI2)                                    SDATA202
              .(SH2(I)»I«1»6)                                           SDATA203
               ,ISH2(I).1=1.6)                                           SDATA204
  700 DO 117  L=NP2.NTOP1                                               SDATA205
      IF(QAIL-t-l) .LE.0.0) OA(L-H) "  0.001                                SDATA206
      Tl » (QA'(L)+QA(L+1> J/2.*IPA(L)-PA(L-H) 1/G                         SDATA207
      TW = TW + Tl                                                      SDATA208
      K=L-IX                                                            SDATA209
      DUW(K) » Tl                                                      . SDATA210
      COA(K) » .4148239*(PA(L)-PA(L-»-in                                'SDATA211
C     T8 " (COB(K)+COB(K+1))/2.*DZ(L)*l.E-5                             SDATA212
C  DZ(L) NOT SET ABOVE THE TOP  PREDICTION LEVEL     '                    SDATA213
      T8 " (COB(L)+COB(L+1))/2.*l.E-5  *AR/G*TA(L)/PA(L)*               SDATA214
     1    
-------
             SIG*(TA(L + 1
              (ST4(LH-ST4(L+1))*.5
117
223

 23
108

101
109

111

102
110
113
103

150

 51
  4
 52
 33
284
290
 28

291
 29
ST4(L-H)
DST41L)
CONTINUE
00 23 N=1*JMAX
00 23 M»1»IMAX
XD1 = XD*(M-1)
YD1 <=-XD*(N-l)
DO 23 I»1,NP1
   * X01»ZElU*l»+YDl»ZE2n*l)+XYYU»l»2)
   = XD1*ZE1(I»2)+YD1*ZE2(I»2)+XYY<1»2»2)
   »  T1#*2+T2«*2
   (T3) 23*23*223
   « SQRT(T3)
                 SAVE " T3
Tl
T2
T3
IF
T3
IF (T3.GT.SAVE)
CONTINUE
TOEL = XD/SAVE
SAVE •= 0*01
DO 108  I«IY»NX
Tl  = -2.*G*(ZU+l)-Z(I))
T2  *AR*(TT2(I)+TT2(I + i
VAR3JI)  = EXP(T1/T2)
IF (NPU) 101*101*102
PAUP1)* PSFA
DO 111  I-IY.NX
PA(I-H)=PA( I)#VAR3(1)
CONTINUE
GO TO 103
PA(NPl)  = PSFA
00 113 I=IY»NX
< « NX - I + IY
PA(K) =VAR3(K)/PA(K+l)
CONTINUE
CONTINUE
IF (IGONY) 51*51*150
DEL = 0.
GO TO 52
ROW = 1.
CW  = .935
XMQ =1*
IF (XLAM) 52*4*52
OEL-.055
CONTINUE
XM = MS-1
YM = NS-1
XD1 « XD*XM
YD1 =-XD»YM
DO 29 J=1.6
I • J
DO 28 K«1,NP1
YYU*J  ) » XYY(K»J*2)
IF (J-4J 291*29*29
YY(IPl.J) = YYIIX.J)
CONTINUE
ALL INITIAL DATA SET
GO TO (797*796.796.795).IGOGO
                       +ZE2(K.I)*YD1+ZE1(K.I)*XD1
SDATA220
SDATA221
SDATA222
SDATA223
SDATA224
SDATA225
SDATA226
SDATA227
SDATA228
SDATA229
SDATA230
SDATA231
SDATA232
SDATA233
SDATA234
SDATA235
SDATA236
SDATA237
SDATA238
SDATA239
SDATA240
SDATA241
SDATA242
SOATA243
SOATA244
SDATA245
SDATA246
SDATA247
SDATA248
SDATA249
SDATA250
SDATA251
SDATA252
SDATA253
SDATA254
SDATA255
SDATA256
SDATA257
SDATA258
SDATA259
SDATA260
SDATA261
SDATA262
SDATA263
SDATA264
SDATA265
SDATA266
SDATA267
SDATA268
SDATA269
SDATA270
SDATA271
SDATA272
SDATA273
SDATA274
                                       91

-------
 795 DO 14 J=l,4
     DO 141 = 1.IX
  14 YYU.J) » 0.
     GO TO 1114
 797 DO 798 J«1.2
     DO 798 1=1»IX
 798 YYU.J) * 0*
     GO TO 1114
 796 IQI - 5
     IFIW2IIX1.EQ.O.O) 101 «4
     DO 141J=IQI»6
     DO 1411=1,IX
 141 YYU.J) « 0»
     IFUHT.EQ.l) GO TO 122
     IIHT » IHT - 1
     DO 121 1=1.IIHT
     U2U ) » 0.0
 121 V2U) »0.0
 122 IFUGONY.EQ.O) GO TO 1114
     IFUANV.GT.l) GO TO 118
     DO 119 1 = 1.IX
 119 V2U) = 0.0
     GO TO 1114
 118 DO 120 1 = 1,IX
 120 U2U) = 0.0
1114 READ 16, (YY«I»3),I»1.IP1)
  16 FORMAT(6E12«4)
     IFUGONY.EQ.O) GO TO 10
     U2UP1) = o«
     V2UP1) » 0*
  10 DO 91 = 1.NP1
     TTOm»TT2U)
     TT2U)=0.
     TT1U) » TT2U)
     U1U ) = U2U)
     V1U) = V2( I)
     WO(I)=W2(I)
     W2(I)=0.
     Wit I) = W2(I
     TT3U) » TT2 I)
     U3( I) = U2(I
     V3U) =,V2(I
     W3( I ) = W2(I
     PP2K I) = PP22U)
     PP1K I) a PP12U)
     PP13( I) = PP12U)
     PP23( I ) = PP22II)
   9 CONTINUE
     ICK = ITESTP
     ISTR»0
C5 «
C6 «
GD2
PHI
 1.
 1.
> 0.
' PHIBOT
                    XDT1*(JMAX-NS)
SOATA275
SDATA276
SDATA277
SDATA278
SDATA279
SDATA280
SOATA281
SDATA282
SDATA283
SDATA284
SDATA285
SDATA286
SDATA287
SDATA288
SDATA289
SDATA290
SDATA291
SDATA292
SDATA293
SDATA294
SDATA295
SDATA296
SDATA297
SDATA298
SDATA299
SDATA300
SDATA301
SDATA302
SDATA303
SDATA304
SDATA305
SDATA306
SDATA307
SDATA308
SDATA309
SDATA310
SDATA311
SDATA312
SDATA313
SDATA314
SDATA315
SDATA316
5DATA317
SDATA318
SDATA319
SDATA320
SOATA321
SDATA322
SDATA323
SOATA324
SDATA325
SDATA326
SDATA327
SDATA328
SDATA329
                                       92

-------
      Tl*  PHI  *  .017453293
      H» HWEST •»• (MS-1J  * XDT1/COSIT1)
      PHIR "  Tl
      CPH  » COS(PHIR)
      SPH  " SIN(PHIR)
      SF = 14.584E-5*SIN(T1)
      DTSF »  OT#SF
      Cl » 3.7943/PAUP1)
      GSF  = G/SF                 ,  '
      GFR  »GSF/ROW
      DTA  » DT
      DTA2 «  2.*DT
      T10  - XLAM*DEL/2.
      DO 720  I»1.NX
      ZDL2(I)  =  (ZA(JJ + T10) **2
 720  CONTINUE
      TK » XK2*#2
      DO 725  1=1.IM1
      CKO(I)  «= TK*ZDL2U>
 725  CONTINUE
      TK « XK12
      DO 735  I»IP1.NX
      CKOU)  = TK*ZDL2U)
 735  CONTINUE
      DO 20001*1.15
2000  RSUMU)  =0.
      RANS =  0.
      RABNS *  0.
      RABS «  0.
      CRNS «  0.
      CRS  - 0.
      RAA  « 0.
      TOUPRA * 0«   '     -
      IF(XLAM) 45»99»45
  45  IF(DEL)60»50.60
  50  T6 » ZUP2J/XLAM
      T6 « ABS(T6)
      Bl « 1«/XK1*ALOG(T6)
      T7 = Z(IM1J/XLAM
      T7 » ABS(T7J
  54  82 * l./XKl*ALOG(T7)
      GO TO 70
  60  T8 « XLAM/2i/PI
      T16»T8»*EX2
      T9«SQRT
-------
    EQUIVALENCE
    EQUIVALENCE
    EQUIVALENCE
    EQUIVALENCE
    EQUIVALENCE
    EQUIVALENCE
    EQUIVALENCE
    EQUIVALENCE
    EQUIVALENCE
    EQUIVALENCE
    EQUIVALENCE
    EQUIVALENCE
*******
*PTXU)+V2U>*PTY(J)
    FAU)«-Z1+DT1(J)
    CONTINUE
    11 = 1
    II«2
    IT=IM2
    12=IM3
                       131
146
131
130
145
140
 41
    14=1
    IFUGONY.EQ.l)  GO TO 146
    15 a IT-  IHT+1
    IFUHT.GT.2)  GO TO
    15 = IM3
    II » 1
    II » 2
    CALL CTW(TT1,TT2»TT3»TTOI
    IFUGONY.EQ.l)  GO TO 145
    W=S  OCEAN
    00130 J«2»IM1
    Z1=U2(J)*PWX(J)+V2(J)#PWY(J)
    FA(J)=-Z1
    CONTINUE
    CALL CTW.(W1»W2.W3»WO>
    W=Q  ATMOSPHERE
    D0140 J=IP2»NX
    Z1=U2(J)#PWX(J)+V2(J)*PWY(J)
    FA(J)=-Z1
    CONTINUE
    II = IP1
    IT=NM1
    I2«=NM2
    I3-NX
    I5 = IA
    IF(NVCHS(2).EQ.1)GO TO
    CALL CTW(W1»W2»W3»WO)
                           22
TTSQ 055
TTSQ 056
TTSQ 057
TTSQ 058
TTSQ 059
TTSQ 060
TTSQ 061
TTSQ 062
TTSQ 063
TTSQ 064
TTSQ 065
TTSQ 066
TTSQ 067
TTSQ 068
TTSQ 069
TTSQ 070
TTSQ 071
TTSQ 072
TTSQ 073
TTSQ 074
TTSQ 075
TTSQ 076
TTSQ 077
TTSQ 078
TTSQ 079
TTSQ 080
TTSQ OBI
TTSQ 062
TTSQ 083
TTSQ 084
TTSQ 085
TTSQ 086
TTSQ 087
TTSQ 088
TTSQ 089
TTSQ 090
TTSQ 091
TTSQ 092
TTSQ 093
TTSQ 094
TTSQ 095
TTSfl 096
TTSQ 097
TTSQ 098
TTSQ 099
TTSQ 100
TTSQ 101
TTSQ 102
TTSQ 103
TTSQ 104
TTSQ 105
TTSQ 106
TTSQ 107
TTSQ 108
TTSQ 109
                                       95

-------
    T— ATMOSPHERE
    D0120 JMP2.NX
    Z1=U2(J)»PTXU)+V2U)*PTY(J)
    Z2«GAM2/(DZ(J)+DZ(J-1) ) * ( XKT ( J)-XKT ( J-l ) )
    Z3=U2 ( J ) *SLOPX+V2 ( J ) «SLOPY
    FA(J)=-Z1+Z2+DT1U) - VVELU) * GAM-Z3*GAM
120 CONTINUE
    CALL CTW(TTl»TT2»TT3tTTO)
 22 IF(IPOL-1)169»164»161
161 00162 J=IP2iNX
    Zl = U2(J)*XP2 = -Z1+Z2
    CALL CTW IPP21»PP22»PP23»AZER')
164 D0165 J=IP2»NX
    Zl » U2U)*XP1(J)+V2(J)»PP1Y( J)
    Z2 » 0.
    IF ( (J-IXI.GT.6) GO TO 165
    Z2 = SH1(20)*SH1U-1X) / (Z< J+l )-Z( J-l ) )*2./ROA
165 FA(J) = -Z1+Z2
    CALL CTW (PPll.PP12»PP13iAZER)
169 CONTINUE
    RETURN                            i
##*####              *##*# GWC    ***»#*             *•»####*
    ENTRY GWC
    COMPUTE GEOSTROPHIC WINDS AND CURRENTS
    DIMENSION SX(30)»SY(30)
    EQUIVALENCE ( A( 1 > »SX( 1 ) ) • ( B( 1 ) »SY< 1 ) )
    STORE SCALED T AND W TEMPORARILY
    D0310 I=IP3»NP1
    Tl * DZ(I-1)/TT2U)**2
    SX(I) = T1*GXY(I»3>
    SY(I) = T1*GXYU»9)
310 CONTINUE
    CALL LINEAR ( ITM. ICUVi4»NTCUV» J»XOCU»CU( IX » »XOCV»CVl IX I iXACUt
   1   CU(NPl) iXACVfCV
    TX » T1*SUMX
    TY » T1#SUMY
    CU(J) = CUT*TT2«J) + TY
    CV(J) » CVT*TT2(J) - TX
330 CONTINUE
    GO TO (399»  1«1»399)» IGOGO
TTSQ 110
TTSO 111
TTSQ 112
TTSQ 113
TTSQ 114
TTSQ 115
TTSQ 116
TTSQ 117
TTSQ 118
TTSQ 119
TTSQ 120
TTSQ 121
TTSQ 122
TTSQ 123
TTSQ 124
TTSQ 125
TTSQ 126
TTSQ 127
TTSQ 128
TTSQ 129
TTSQ 130
TTSQ 131
TTSO 132
TTSQ 133
TTSQ 134
TTSQ 135
TTSQ 136
TTSQ 137
TTSQ 138
TTSQ 139
TTSQ 140
TTSQ 141
TTSQ 142
TTSQ'143
TTSQ 144
TTSQ 145
TTSQ 146
TTSQ 147
TTSQ 148
TTSQ 149
TTSQ 150
TTSQ 151
TTSQ 152
TTSQ 153
TTSQ 154
TTSQ 155
TTSQ 156
TTSQ 157
TTSQ 158
TTSQ 159
TTSQ 160
TTSQ 161
TTSQ 162
TTSQ 163
TTSQ 164
                                       96

-------
  850

  851
  340
    IF(IHT.GT.l) GO TO 850
    XETA2 = CV(IX)/GSF
    YETA2 «-CU< IX)/GSF
    GO TO 851
    CV(IX) « GSF * XETA2
    CU(1X) « -GSF * YETA2
    D0340 I«2tIX
    T3  (CTY(I> + CTY(I-l) )/2.
    T4  (CWY(I) ••• CWY(I-l) J/2.
    Tl   PST(I-1)*T3 + PSSU-1)»T4
    T5   (CTX(I) + CTX » CV(IX) -
      CONTINUE
      RETURN
C *******
      ENTRY CUV                    .
C     COMPUTE U AND V COEFFICIENTS FOR GAUSSIAN ELIMINATION  SCHEME
      A(ll) * 0.
      Zl > OT2/(DZ( II) + DZ(II »
      Z2 » XKU(I1)/OZ(I1)
      Z3 a XKU( II)/DZ(II)
      BR(Il) » C5 + 21*<23
      BG     = -DTSF
      C(ID =» -Z1*Z3
      IF(Il-l) 111,111*12
      IFUHT.EQ.l) GO TO 11
      IIHT » IHT -1
      DO 36 I=r»IIHT
              0.
                           Z2)
111
 35
 36
 11
12

13
          13
  1
U3II)
V3U)
GO TO
U3(I1) =
V31I1) »
GO TO 13
U3IIT+2)
V3UT+2)
Z4 « C6
 - DT *
               U2U1) + DTSF *  (V2(I1)-CVUD)
               V2II1) + DTSF *  (CUU1)-U2< II))
                 CUCIT+2)
                 CV( IT+2)
              * U2III) - OTSF *
              (U2(II) * PUXUI)
                              CV(II) -
                              + V2(II)
GD2 * UKII)
* PUYCII))
    Z5 « Z1*Z2*U2U1)
    Z6 - C6#V2(II) •«• DTSF*CUUI) - GD2*V1( 11 ) .
   1 - DT *  * PVX(II) * V2(II) * PVYUI))
 TTSO  165
 TTSQ  166
 TTSQ  167
 TTSQ  168
 TTSQ  169
 TTSQ  170
 TTSQ  171
 TTSQ  172
 TTSO  173
 TTSQ  174
 TTSQ  175
 TTSQ  176
 TTSQ  177
 TTSQ  178
 TTSQ  179
 TTSQ  180
 TTSQ  181
 TTSQ  182
 TTSQ  183
 TTSQ  184
 TTSQ  185
 TTSQ  186
 TTSQ  187
 TTSQ  188
 TTSQ  189
 TTSQ  190
 TTSQ  191
 TTSQ  192
 TTSQ  193
 TTSQ  194
 TTSQ  195
 TTSQ  196
 TTSQ  197
 TTSQ  198
 TTSQ  199
 TTSQ  200
 TTSQ  201
 TTSQ  202
 TTSQ  203
 TTSQ  204
 TTSQ  205
 TTSQ  206
 TTSQ  207
 TTSQ  208
.TTSQ  209
 TTSQ  210
 TTSQ  211
 TTSQ  212
 TTSQ  213
 TTSQ  214
 TTSQ  215
 TTSQ  216
 TTSQ  217
 TTSQ  218
 TTSQ  219
                                         97

-------
   27 a Z1*Z2*V2(I1)
   F(Iltl) = Z4 + Z5
   Fill. 2) = Z6 + Z7
   DO 30 1 = 1 1 » IT
   Zl = DT2/JDZU) + DZU + 1M
   Z2 a XKUm/DZU) + 0.5»VVELll+l»
   Z3 * XKUU+D/DZd-H) - 0.5»VVEL(I + 1)
   A( I) a -Z1*Z2
   BR(I) • C5 + Z1«(Z3 + Z2)
   CJI) • -Z1*Z3
   F(I.l) a C6*U2(I + 1) - DTSF«CVU + 1> - GD2*U1 < 1+1 )
  1 - OT * (U2U+1)* PUXU+1J + V2U + U* PUYU + D)
   Fd.2) = C6*V2CI+1) + DTSF*CU(I+11 - GD2*V1(I+1)
  1 - DT * IU2U+1)* PVXII + 1K V2«I + D* PVY(I-H))
30 CONTINUE
C(IT) «
F(IT.l)
F«IT»2)
Zl = l.
EU1.1.1)
Edl.1.2)
Edl.2.1)
           0.
          F(ITi2)
            Il)**2
                       Zl*Z3*U2(IT-f2)
                       Zl*Z3*V2IIT+2>
                        BG**2>
               Z1*BR(I1)
               -Z1#BG
               -E(Ilil»2)
FSTU1»2>
EUl»lfl)
E(I1»1»2)
£111,2,1)
E(I1,2»2)
             = E(I1.2»1)#F(11,1) + Edl»2»2)*Fdl»2)
               -E(I1,1,2)
               E(Ilflil)
DO
Zl
Z2
Z3
R
     I=II»I2
     Ad)*Ed-l»l»l)
     Ad)*Ed-l»l»2)
     Zl**2 + Z2**2
     ^1) = Z1/Z3
R(I»l»2> = -Z2/Z3
Rd»2»l) = -Rdfl»2)
R( 1,2,2) » R(
                          BR(I)
                          BG
10
El I ,1,2) = -Rd ,l»2)*Cd )
Ed,2,1) a -Ed,1,2)
Ed,2,2) > Ed,1,1)
CONTINUE
Zl » AdT)*E(I2»l,H + BR(IT)
Z2 = A(IT)*E(12,1,2) + BG
23 = Zl*#2 + Z2#*2
R( IT,1,1) » Z1/Z3
R( IT,1,2) - -12/13
R(IT,2,1) a -RdT,l,2)
R(IT,2»2) = R(IT»1,1)
DO 10 I=II»IT
F(I,1) • Fd,l) - Ad)*FSTd-l,l)
Fd,2) = Fd»2) - Ad)*FST(I-l,2)
FST(I»1) a Rd,l»l)*F( 1,1) + R(I,1,1    	
FSTd,2) ° Rd,2»l)*Fd »1) + Rd,2,2)*F(I,2)
CONTINUE
 TTSQ 220
 TTSQ 221
 TTSQ 222
 TTSQ 223
 TTSQ 224
 TTSQ 225
 TTSQ 226
 TTSQ 227
 TTSQ 228
 TTSQ 229
 TTSQ 230
 TTSQ 231
 TTSQ 232
 TTSQ 233
 TTSQ 234
 TTSQ 235
 TTSQ 236
 TTSQ 237
 TTSQ 238
 TTSQ 239
 TTSQ 240
 TTSQ 241
 TTSQ 242
 TTSQ 243
 TTSQ 244
 TTSQ 245
 TTSQ 246
 TTSQ 247
 TTSQ 248
 TTSQ 249
 TTSQ 250
 TTSQ 251
 TTSQ 252
 TTSQ 253
 TTSQ 254
 TTSQ 255
 TTSQ 256
 TTSQ 257
 TTSQ 258
 TTSQ 259
 TTSQ 260
 TTSQ 261
 TTSQ 262
 TTSQ 263
 TTSQ 264
, TTSQ 265
 TTSQ 266
 TTSQ 267
 TTSQ 268
 TTSQ 269
 TTSQ 270
 TTSQ 271
 TTSQ 272
 TTSQ 273
 TTSQ 274
                                       98

-------
   U3JI3) « FST(IT»1)                                                 TTSQ 275
   V3(I3) = FSTI1T.2)                                                 TTSQ 276
   DO 20 I«U»I5                                                      TTSQ 277
   NR=IT-I                                                            TTSQ 278
   EU3 = E.= EU3+EV3+FST
-------
     SUBROUTINE EXCK                                                   EXCK
     INTEGER RDRUM.SDRUMiTDRUM                                         EXCK
     DOUBLE PRECISION A»B»C»CST»D»DTOiDWO.DST»DT1iFAiGWO.PPlliPP12     EXCK
    1   »PP13iPP21«PP22»PP23»SSTiTTl»TT2fTT3iTTOiTSC»U2»V2iWl»W2»W3    EXCK
    2   »WO»WSC»XKTtXYY»YY,GTO                                         EXCK
     COMMON XYY130.6.5)»A(30).8(30)iC(30)»CST(30)»0(30).DTO(30)        EXCK
    1   .DW0130).DSTI30).FA130),GTO(30).GWO(30)tPP13(30)iPP23(30)      EXCK
    2   »TT3(30)tW3(30)»SST                                            EXCK
     COMMON RI(30)»DT1(30).YY(30»6)»SLOPX.SLOPY»HEIGHT»ETA1.ETA2»XETA2»EXCK
    1YETA2»IHT«IANV»IGOG»ETAINX»ETAINY»CSOUT<2)tCRS»RAA»TOUPRA»H3»CF.CEEXCK
    2.WSI30)»UST»CW»HAIiHSI»RANS»RABNSiRABS.CRNSiTRAUS»XT2
     COMMON XKUI30)»VVEL<30)»SRS»RADMX»IGOGO»ROW.XMQiDEL
    1   tXLAM«RSUM(15)tBl»B2
     COMMON PP11(30)»PP21(30)iTTl(30>»TTO<30)»TSC(30>»Wl(30)»WO(30>
    1
    2
    3
    4
    5
    6
    7
    7
    »WSC(30)*XKT(30)»CU(30)»CV(30)»DTDT(30)»DTT(30)tUl(30).VI(30)
    • ZDL2130) .SOUK20) »SOU2(20) ,SHl ( 20 ) »SH2 < 20 ) »NCLI • I SSI li I SSI 2
    ,ITS2(20).ITS1<20).ECL1110.4).LLCI<10»5) »TCLI (10,4 ) , I STEP < 10 )
    ,RAINI<10>.ICUV120)»XCCU<20).XOCVI20)iXACUl20)tXACVt20)
    tNXNCIO)»TTW.DECL.COCOBtICK»NTFOR,GSF,GFR.DTSF»SF
    »PHlR»GD2fISTRiSOSCtSOAB»XNO»CPH»SPHiPHl»H»IGONY»NTCUV
    PGXY<30.12)»CGXY(30.12)»I2IHT»I3IHT
EXCK
EXCK
EXCK
EXCK
EXCK
EXCK
EXCK
EXCK
EXCK
EXCK
EXCK
   •Z(30).ZA(30)»DZ(30)»DS(30)»PA(45).TA(45).QA<45).COB(45).COM(18)EXCK
 COMMON U3130).V3(30)»TBO(30)»WBO(30)»CKO(30),CSW(30)»PSS(30)      EXCK
1   »E(30»2»2)»F(30f2),FST(30.2)fR(30.2.2)»BR(30)»TTI(30).EC(5)    EXCK
2   .TCL(5).LLC(6)»ST4(50).DST4(50).DU«(50).QS(50)»RAI(20)»PST(30) EXCK
 COMMON ITIMES(20)iIXTRA»MARAY(20).PSFAIN(20)                      EXCK
 COMMON SAVE.TDEL»XDTl.DT«XD»DECLX»DCHG»PHIBOTiHWEST.EM»ZW»C5.C6   EXCK
1  »NX»lX»NT.IMAX»JMAX»NPl.IPliNP2»NMl.NM2»IP2.IP3.IMl.IM2»IM3     EXCK
2  . 14, IA.RDRUM»SDRUM»TDRUM»IGRID.iMARA.RTIME.IPOL.PI2.CFAR.NTIME  EXCK
3  »EX2.EX3»EX6»XNViXNTiBETV.BETT.DT2iDTA.DTA2.GiCP»PI .GAM.GAM2    EXCK
4  ,ROA»ALF.XK1,XK2.RALF.RC.CC»C32.XK12»SH»HKK.HK2»A1»A2           EXCK
5  .NWSYY.NTOP1.DELH.   TW.INEW.I TAPE»IRAT.INEWC                   EXCK
 COMMON BG*AR»AWiSIGiATC»SKiIZW«IZWl»IY«IR»LYiNCS»NCR»NLAP»NCL     EXCK
1  -rNTOP»MA»NATAL.LAND»NVARl»NVAR6»CPP»ITESTP                     EXCK
 COMMON T1»T2»T3.T4.T5»T6»T7»T8»T9»T10»T11.T12.XIIN.XJIN»TE»T20    EXCK
2    i  T13»T14.T15»T16»XD1»YD1                                    EXCK
3  ,IS.RAINX,ET»AT»ST»PT»NUX»LOCXYY(5)»NU1X                        EXCK
 COMMON  CUT.CVT.C1.QST«NE.IGET.NN1»NU»ITM»I1.12.13»I5»IT»MS»NS»II EXCK
 COMMON COA(50)»CGA(50)»PAAB(50) .PASA(50)»RA(30)tRB<30)»FN(30)     EXCK
1 »IlIHTiI4IHT                                                     EXCK
 DIMENSION U2(30)»V2(30)»TT2(30)»W2(30) »PP12(30)»PP22(30)          EXCK
 EQUIVALENCE (YY<1,1) ,U2I 1))»IYY(112>»V2<1))»
-------
  105 W9»WS(IZW)*A1+WSIIZW1)*A2
  401 HBAR=1.54165E-04*(W9*#2)
      H3=1.39536*HBAR
  405 T23 = SQRT(G)
  403 DO 100   1 = 1.NP1
      T21»HBAR/(DEL*2.*PI)
      IFIT2111001. 1001.1002
 1001 CSW(I)=Oi
      GO TO 100
1002  T22=1./SORT
  101 CONTINUE
  409 DO 102   IMP1.NX
      T26 » ZA( I l-t-HBAR/2.
      CKOU )=XK12*(T26**2)
  102 CONTINUE
  411 XKU(IP1)»CKO(IP1)*CSW(IP1)
      XKTUP1)«XKU(IP1)
      XKUUM1)=CKO( IM1)»CSW( I Ml I
      XKT( IM1)«XKUUM1)
  106 J2=IM2
      IMA     IHT - 1
      IFUMA.EO.O) IMA-1
      IIPP1 " IP1-IMA  +  1
      GO TOI412.413.413.412).IGOGO
  412 IMA * IP1
      IIPP1 » IP1
           NX
           I J«IMA.IP2.IIPP1
           ) I=J.J2
                  )  - U2(I»/DZ(I)
                  .LT.I1.E-35))  Tl « 0.
           Tl»»2
            0.
           T2«*2
           Tl +  T2
             SQRT(T3)
         U.EQ.l) CSOUTI1)  =  XCS
          I.EQ.NX1CSOUT121  «  XCS
            (TT2< I+D+TT2II) J/2.+TBOUJ
           XCS    + CSW(I)
           T6**2
           CKO(I)»T6
            (TT2t I + D-TT2U) >/DZU)
    3 IFU-IX)6»40.4

413



131
132

141
142








J2
DO
DO
Tl
IF
Tl
T2
IF
T2
T3
XCS
IF
IF
TB
T6
T7
T6
CL
at
4
4
3
(
a
•
(
•
a

t
(
a
a
3
8
«
                               EXCK 055
                               EXCK 056
                               EXCK. 057
                               EXCK 058
                               EXCK 059
                               EXCK 060
                               EXCK 061
                               EXCK 062
                               EXCK 063
                               EXCK 064
                               EXCK 065
                               EXCK 066
                               EXCK 067
                               EXCK 068
                               EXCK 069
                               EXCK 070
                               EXCK 071
                               EXCK 072
                               EXCK 073
                               EXCK 074
                               EXCK 075
                               EXCK 076
                               EXCK 077
                               EXCK 078
                               EXCK 079
                               EXCK 080
                               EXCK 081
                               EXCK 082
                               EXCK 083
                               EXCK 084
                               EXCK 085
                               EXCK 086
                               EXCK 087
                               EXCK 088
                               EXCK 089
                               EXCK 090
                               EXCK 091
                               EXCK 092
                               EXCK 093
                               EXCK 094
                               EXCK 095
                               EXCK 096
                               EXCK 097
                               EXCK 098
                               EXCK 099
                               EXCK 100
                               EXCK 101
                               EXCK 102
                               EXCK 103
                               EXCK 104
                               EXCK 105
                               EXCK 106
                               EXCK 107
                               EXCK 108
                               EXCK 109
101

-------
  ATMOSPHERIC
   4 CL  = CL+GAM+GTOU)+.00061*TB*((W2(I+1)-W2 G#CL
      TEST =  1.E16
      T12 = HK2 * ZDL2U)
                        - W2( I))/DZ(I)+PSS(I)*GWO(I)
    8
 1003
 1004
   19
   IF(T7)1003»1003fl004
   IF (CL) 35.19.10
   IF (CL) 1030.19*1031
   Rid )  » 0.
   GO TO 15
   CHECK MAGNITUDE OF CL(I)/T7 TO RESTRICT OVERFLOW EXCEPTION
   CLL1 = ABS(CL)
   CLL=ALOG1Q(CLL1)
   GO TO 1032
   CLL  = ALOGIO(CL)
   T7L«ALOG1Q(T7)
   CHEC<1 = CLL-T7L
   IF(CHECK1-13.)1024.10.10
   RI (!)•= G#CL/T7
   IF(RI(I)-TEST)15.15.10
   RKI)  = TEST
   IF(RI(I)125.20.20
   G.T. ZERO
   1FII-IXJ21.21.22
OCEANIC
21 EV
   ET
 1030
 1031
 1032
 1024

   10
   15
:   RI
   20
          BETA/
          BETT
     XV  * -XNV
     XT  = -XNT
     GO  TO 23
  ATMOSPHERIC
  22
   23
        ALF
        ALF
        2.
        2.
        (1.
       ' (1*
       I)  =
   XKT(I)  =
EV
ET
XV
XT
T8
T9
+ EV*RI
-------
      GO TO 40
   25 IFIRKI) + RO35.35.30
C  RI G.T. -RC» AND L.T. ZERO
   30 T10 - 1. - ALF#RId)
      XKUd) = T6/T10«»2
      XKTd ) " XKU(I)/T10
      GO TO 40
C  RI L.E. -RC
   35 Til » ABS(Tll)
      XKTd) = T12*SQRT(T11)
      1F(T7)1006.1006»1007
 1006 XKUd )=0.
      GO TO 40
 1007 T13 » ABS(R1( I))
      T13 = T13**EX6
    '  XKUd) » XKTd)»C32*T13
   40 CONTINUE
      J2-NX
   41 CONTINUE                	
C  SET LIM.ITS ON ATMOSPHIC .  K
      T13 » 1.E7
      TEST « lOOt
  415 DO 60 I=IP1.NX
      IF 
-------
    SUBROUTINE BIV                                                    BIV  000
    INTEGER RDRUM.SDRUM»TDRUM                                         BIV  001
    DOUBLE PRECISION A«B»C»CST»DtDTO»DWO»DST»DTliFA»GWO»PPll»PP12     BIV  002
   1   »PP13.PP21»PP22.PP23iSST»TTl»TT2.TT3«TTO.TSC»U2»V2iWlfW2»W3    BIV  003
   2   .WO.WSC.XKT»XYY»YY.GTO               '                          BIV  004
    COMMON XYY(30,6»5)»A(30)fB(30)iC(30).CST130).0(30).DT0130)        BIV  003
   1   »DWO(30)»DST(30)»FA(30)»GTO(30)»GWO(30).PP13(30)»PP23(30)      BIV  006
   2   .TT3<30)»W3(30)»SST  .                                          BIV  007
    COMMON RI(30).DTl<30)»YY(30.6)iSLOPX.5LOPY.HEIGHTtETAl.ETA2.XETA2.BIV  008
   1YETA2.IHT»IANV,IGOG.ETAINX.ETAINY»CSOUT(2).CRStRAA»TOUPRA»H3«CFiCEBIV  009
   2.WS(30)»UST.CW.HAI,HSItRANS.RABNS»RABS.CRNS»TRAUS.XT2             BIV  010
    COMMON XKUI30)»VVEL(30)»SRS»RADMX.IGOGO.ROW,XMQtDEL               BIV  Oil
   1   .XLAM.RSUMU5)»B1»B2                                           BIV  012
    COMMON PP1H30) iPP2H30) »TT1<30)»TTO(30> »TSC( 30) »WU 30) »WO<30)    BIV  013
   1   »WSC(30) .XKT130).CU130)»CV<30).DTDT130)»DTT(30)»U1<30>»V1(30>  BIV  014
   2   .ZDL2(30).SOUU20).SOU2(20) .SHK20) »SH2(20) .NCLl»I SSI 1. 1SSI2   BIV  015
   3   »ITS2(20).ITS1(20)»ECLI<10,4),LLCI(10,5).TCLK10.4),ISTEP(10)  BIV  016
   4   .RAINK10) »ICUV<20) .XOCU120) .XOCVJ20) »XACU(20> .XACVI20)        BIV  017
   5   .NXN110)tTTW»DECL.COCOB»ICK,NTFOR,GSF.GFR.DTSF»SF              BIV  018
   6   »PH1R»GD2.ISTR«SOSC»SOAB»XNO»CPH.SPH.PHIiHiIGONY»NTCUV         BIV 019
   7 » PGXY(30.12).CGXY(30.12)»I2IHT»I3IHT                            BIV  020
   7  iZ(30).ZA(30) iDZOO) »DS(30) »PA(45)»TA<45) .QAJ45)iCOB(45) .COMU81BIV  021
    COMMON U3(30)»V3(30)«TBO(30).WBO(30)»C<0(30) iCSWOOJ .PSSI30)      BIV  022
   1   .EI30.2.2) ,F(30.2),FST(30»2),R(30»2,2).BRI30)»TTI(30).EC(5)    BIV  023
   2   »TCL(5)«LLC«6)iST4(50)»DST4(50)»DUW(50)»QS(50)«RAI(20)»PST(30) BIV  024
    COMMON ITIMESJ20)•IXTRA.MARAYI 20).PSFAIN120)                      BIV  025
    COMMON SAVE»TDELiXDTl»DT»XD»DECLX»DCHG.PHIBOTtHWEST,EM»ZW»C5»C6   BIV  026
   1  »NX.IX»NTiIMAXiJMAX.NPl.IPl.NP2.NMl.NM2iIP2,IP3»IMl,IM2iIM3     BIV  027
   2  »I4»IA»RDRUM»SORUM»TDRUM.IGRID»IMARA»RTIME.IPOL»PI2»CFAR.NTIME  BIV  028
   3  iEX2»EX3»EX6»XNViXNT»BETViBETTiOT2,DTA»DTA2.G»CP»PI»GAM»GAM2    BIV  029
   4  iROA,ALF,XKl,XK2,RALF»RC,CC.C32»XK12tSH»HKKiHK2»Al»A2           BIV  030
  . 5  iNWSYY»NTOPl»DELH»   TW»INEw»I TAPE»I RAT»INEWC                   BIV  031
    COMMON BG»AR»AW.SIG»ATC»SKtIZW»IZWl»IY,IR»LY»NCS»NCR.NLAP»NCL     BIV  032
   1   »NTOP»MAiNATAL»LANDiNVARl,NVAR6.CPPiITESTP                     BIV  033
    COMMON Tl»T2»T3»T4tT5»T6»T7tT8»T9»T10»Tll»T12»XIlNiXJlN»TE»T20    BIV  034
   2    •  T13»T14»T15«T16»X01»Y01                                    BIV  035
   3  »IS,RAINX»ET»AT»ST»PTfNUX»LOCXYY«5)iNUlX                        BIV  036
    COMMON  CUTiCVT»Cl»QST.NE»IGET»NNl.NU.ITM»Il»I2»I3»I5,IT,MS.NS,II BIV  037
    COMMON COA(50)iCGA(50)»PAAB(50)»PASA(50).RAI30)*RB<30)»FN(30)      BIV  038
   1 • IlIHTtI4IHT                                                    BIV  039
    DIMENSION U2<30)»V2(30)»TT2t30) ,W2(30)fPP12(30)»PP22(30)          BIV  040
    EQUIVALENCE  * QSG                                                     BIV  051
112 W2UP1) »0.0                                                      BIV  052
    DWO(IP1)=WO(IP2)-WO(IP1)                                           BIV  053
    GWOUP1)=DWO( IPD/ZUP21                                           BIV  054
                                       104

-------
   GO TO 11                                                          BIV  055
 2 W2(IPl>=QSG»XMQ+                                       BIV  062
           Tl  * T2               .                                        BIV  063
      U2UXI - T3/T5          .                                           BIV  064
      V2( IX) • T.4/T5                                                     BIV  065
      GO  TO (60*61*64*60)»IGOGO                                         BIV  066
   61  IF(IANV.EQ.l) GO TO  62                                             BIV  067
      U2UX)«  0*0                                                       BIV  068
      U2(IP1)  > U2(IX)                                                   BIV  069
      V2IIP1)  = V2UX)                                                   BIV  070
      GO  TO 70                                                          BIV  071
   62  V2UX) • 0*0                                                       BIV  072
      V2CIP1)  - V2(IX)                                                   BIV  073
      U2IIP1)  - U2(IX)                                                   BIV  074
      GO  TO 70                                                          BIV  075
   60  U2UX) -0.0       .    .   .                                        BIV  076
      U2UP1)  -0.0                 .                                     BIV  077
      V2UX) » 0*0                                         .              BIV  078
      V2(IP1)  -0.0                  .    v	             BIV  079
      GO  TO 70                                                        .  BIV  080
   64  U2IIP1)  ' U2IIX)                                                   BIV  081
      V2UP1)  = V2(IX)                                                   BIV  082
   70  T10  = U2(IX)*»2  •«• V2(IX)**2                                        BIV  083
      WS(IX) * SQRT(TIO)                                                 BIV  084
      WSUP1)  » WSUX)                              '                     BIV  085
 1001  T8  - 1.  - (W2UM1) + WO(IMD) *  l.E-3                              BIV  086
      IF(ITM.EQ.O) CE  » 0.                                              BIV .087
      CF»W2(IM1)*CE/T8+WO(IM1)«CE/T8                                     BIV  088
      T9  « +CF/ROW/XKTJIM1)                                              BIV  089
   30  W2IIX) * 19 » DZ(IMl) •*• W2IIM1)  - OWO(IMl)                         BIV  090
      IF(ITM-1)32»99*99                 .                           .     BIV  091
   32  WOIIX) » T9 * DZ(IMl) + WO(IMl)                                    BIV  092
      W2(IX) • 0*0                                                       BIV  093
      DWO(IMl) » WO(IX)  -'WO(IMI)        .                                BIV  094
      GWOtlMl) « DWO(IMl)  /(-Z(IMD)                                     BIV  095
   31  GO  TO 99                                                          BIV  096
:  SEC.   3.3.2                                                          BIV  097
   40  CONTINUE                                                          BIV  098
      T3  *> Bl  + SQRTCROA/ROW)  » B2                                       BIV  099
      T4  » WSJIP2) - WS(IMl)                                           '  BIV  100
      IF(XLAM) 41*41»42                                                 BIV  101
   41  UST  = WSUP2)/ Bl             -                                    BIV  102
      GO  TO (  141*141*141*142)*IGOGO                                     BIV  103
  142  WSIIX) = 0.                                                       BIV  104
      GO  TO 43                                                          BIV  105
 141   WSUX) = WS(IMl)  + SQRTIROA/ROW)  » UST  *  B2                        BIV  106
      GO  TO 43                                                          BIV  107
   42  UST  » T4/T3                                                       BIV  108
      WSUX) = WS( IP2)-UST»B1                                            BIV  109
                                      105

-------
 43 WStlPl) « WS -0.                  . ..                                   BIV   117
 44 U2(IP1) » U2 0*0                                                      BIV   135
    DWO(IMl) > WO(IX) - WO(IMl)                                       BIV   136
    GWO(IMl) = DWO(IMl) /(-Z(IMl)l                                    BIV   137
 99 IF (IPOL-1) 999»992»990                                           BIV   138
990 CALL LINEAR  = Tl                                                      BIV   144
    Tl - SHK1) « Tl                                                  BIV   145
    PP12UP1) = T1#DZ( IP1)/XKT(IP1)/ROA+PP12                                               BIV   159
    AD«C6*X2(II)+Z2*Zl*(X2(Il)+XO(Il»-GD2*(Xl«in)                   BIV   160
    AAD»DT*FAUI)                                                     BIV   161
    AAAD=(BU1)-C5)#XO(II)+C(I1)*XO( II + l)                             BIV   162
    D
-------
    Z1=DT2/(DZU+1)+DZ  + 0»5*VVEL(Jt-l)                                  BIV   166
    Z3»XKT(J+1)/DZU+1) - 0.5*VVEL(J+1>                               BIV   167
    AU)«-Z1*Z2                                                       BIV   168
    C(J)a-Zl*Z3                                                       BIV   169
    BtJ)»C5+Zl*-GD2*X1U-I-1H-DT*FAU+1)                            BIV   171
    D(J>=DU>-UU)»XOU)+(8U)-C5»*XO»D(IT)+Zl»Z3*(X2(IT+2)+XO(IT+2) )+C< IT)*XO( 1T+2)              BIV   174
    CUT»=0.                                                          BIV   175
    CST(I1)—CU1)/BU1)                                              BIV   176
    DST(I1)«DU1)/B(I1)                                               BIV   177
    D0211 J»II»I2                                                     BIV   178
    Zl«AU>*CSTt J-IKB(J)                                             BIV   179
    CST«J)«-C(J)/Z1                         .                          BIV   180
    Z2=D< J)-AU)»DSTU-1)                                             BIV   181
211 DST(J) a Z2/Z1                                                    BIV   182
    Zl»DnT)-A(IT)*DST(I2)                                            BIV   183
    Z2=A(IT)»CST(I2)*B(IT)                                            BIV-   184
    X3(I3)=Z1/Z2                                                      BIV   185
    IF(IGONY.GT.O) GO TO 212   .     .                                  BIV   186
    IF (IHT.EQ.l) GO TO 212                                           BIV   187
    IIHT » IHT rl                                                     BIV   188
    DO 256 I=1»1IHT                                                   BIV   189
256 X3(I) = 0.                                                        BIV   190
212 00221 J-U.I5                                                     BIV   191
    NR-IT-J                                                           BIV   192
    CX « CST(NR) * X31NR+2)                                           BIV   193
221 X3(NR+1) n CX + DSTJNR)                                           BIV   194
    RETURN        .       .                   .                          BIV   195
 .   END                                                               BIV   196
                                       107

-------
 SUBROUTINE TEMPRT                                                 TMPRTOOO
 INTEGER RDRUM.SDRUM.TDRUM                                         TMPRT001
 DOUBLE PRECISION A.B»C.CST.D.DTO.DWO.DST.DT1»FA»GWO»PP11»PP12     TMPRT002
1   •PP13»PP21»PP22»PP23»SST»TT1»TT2.TT3.TTO.TSC.U2»V2»W1.W2»W3    TMPRT003
2   »WO»WSC.XKT»XYY»YY»GTO                                         TMPRT004
 COMMON XYY(30.6.5)»A<30) »B(.30 ) »C( 30) »CST (30 ) tO( 30 ) »DTO(30)        TMPRT005
1   «DWO(20)»DST(30)»FA(30)»GTO(30)»GWO(30)»PP13(30)»PP23I 30)      TMPRT006
2   »TT3(30).W3<30).SST                                            TMPRT007
 COMMON RI(30)»DT1<30).YY(30.6).SLOPX»SLOPY.HEIGHT»ETA1.ETA2.XETA2.TMPRT008
1YETA2.IHT.IANV»IGOG»ETAINX.ETA1NY.CSOUT<2)»CRS.RAA»TOUPRA.H3,CF.CETMPRT009
2»WSI30).UST.CW.HAI»HSI»RANS»RABNS»RABS.CRNS.TRAUS»XT2
 COMMON XKUI30) »VVEL<30) f SRSiRADMX . IGOGO.ROW iXMQ iDEL
1   »XLAM»RSUM(15)»B1»B2
 COMMON PP1K30) »PP21(30) »TT1 ( 30) »TTO( 30) »TSC ( 30 ) »Wl ( 30) tWO( 30 I
    »WSC(30).XKT130)»CU(30)»CV(30)»DTDT(30)»DTT(30)»U1«30)»V1(30)
    .ZDL2OO) ,SOU1(20).SOU2(20) .SH1I20) ,5H2(20) .NCLI.ISSI1.ISSI2
    . ITS2I20) . ITSK20) .ECLK10.4) .LLCI (10.5) .TCLIU0.4) »I STEP (10)
    »RAINI(10)»I CUV(20).XOCUt20).XOCV(20)»XACU(20)»XACV(20)
    »NXN(10)»TTW.DECL.COCOB.ICH»NTFOR,GSF,GFR.DTSF»SF
    »PHIR»GD2»ISTR»SOSC»SOAB.XNO»CPH»SPH.PHIiM»IGONY»NTCUV
  » PGXY(30.12)»CGXY(30»12).I2IHT.I3IHT
TMPRT010
TMPRTOLL
TMPRT012
TMPRT013
TMPRT014
TMPRT015
TMPRT016
TMPRTOL7
TMPRT018
TMPRT019
TMPRT020
   »Z(30).ZA(30)»DZ(30) .05(30) .PAU5 ) »TAU5 ) »QA( 
-------
(PGXY(1»4) tPWXllI

(PGXY(1»6)»XP2(1)

-------
   1 ZII)                                                              TMPRT110
  6 CONTINUE                                                          TMPRT111
    PRINT  778                                                         TMPRT112
    DO 777 I-ltNPl                                                    TMPRT113
    PRINT  7»CUX
-------
    SUBROUTINE INFRA1 (WA.COA.KA»NTOP)                                INFRAOOO
 SET TRANSMISSION VALUES FOR C02 AND H20                              INFRA001
    DIMENSION WA(1)iCOA(l)»CGA(1),STB(1)»ST4 (1)»LLCll)»EC11)»DTT(1)   INFRA002
   1 iRA(l)tRBd) »PA(1)                                                INFRA003
    DIMENSION TAUF(50»20)                                             INFRA004
    DATA AW /4.0833333/                                                INFRA005
    MM1 » NTOP-1                                                      INFRA006
    IF (KA.GT.20) GO TO 999                                           INFRA007
    KSAV « KA  .                                                       INFRA008
    DO 70 LR=1»KSAV                                                   INFRA009
    KUHN » 1                                                          INFRA010
    UW » 0.   '                                                        INFRA011
    UC » 0*                                                           INFRA012
    D0135 I«LR.MM1                                                    INFRA013
    UW « UW+WACI)                                                     INFRA014
    UC « UC+COAU)                                                    INFRA015
    TC = .185»EXP(-.32*UC**.4)                                        INFRA016
136 CALL XUHN(UW»EWtKUHN)                                             INFRA017
135 TAUF(I.LR) « ,815-EW+TC                                           INFRA018
    IF (LR-1)  70.70.245                                                INFRA019
245 KUHN « 1                                                          INFRA020
    UC » 0.                                                           INFRA021
    UW « 0.                                                           INFRA022
    II • LR-1                                                          INFRA023
    D0155 I-1.I1                                                      INFRA024
    K » LR-I                                                          INFRA025
    UW * WAOO+UW                                                     INFRA026
    UC » COA
-------
    ECP « ECP#(1.-EC(LU>
    LL = LL+1
 33 IF (CGAII l.LE.O) GO TO 34
    UAA = UAA+CGAU)
    TP » EXP(-UAA)
 34 TT « TP»TAUF(I»LR)
    RA(LR) « RAILR)+STBm*(E2-TT)*ECP
    E2 « TT
 35 CONTINUE
    RA(LR> » RA(LR)+RCL
    IF (N1P1.LE.1) GO TO 99
    IF (LR.EQ.l) GO TO 40
    II » LR-1
    RB(LR) « 0.
    RCL <* 0.
    ECP * 1.
    E2 » 1.
    UAA <* 0*
    LL » LSAV -1
    TP » 1.
    DO 60 K-1»I1
    I » LR-K
    IF (LL.LT.l) GO TO 55
 ASSUMES CLD TOP IS AT LEVEL ABOVE CLD BASE
    IF (LLC(LL).NE.I)  GO TO 55
    RCL = RCL+EC(LL)*ST
    LL » LL-1
 55 IF (CGAU).LE.O) GO TO 56
    UAA » UAA+CGAd)
    TP = EXP(-UAA>
 56 TT « TP»TAUF(I»LR)
    RB = ST4(1)
    DO 80 LR=3iNlPl
    TT « RB(LR)-RA(LR)
    E2 = AW*(TT-T1)/(PA(LR)-PA(LR-D)
    Tl » TT
    IF (LR.EQ.3)  ECP = E2
    IF(LR»EQ«2) GO TO 79
    DTT«LR-H = (PA(LR-l)-PA(LR-2))/«PA
-------
    SUBROUTINE LINEAR (ITM.ISTEP.NV.NA.I.VAR1. ACl»VAR2t AC2.
   1   VAR3, AC3.VAR4, AC4)
    DIMENSION  STEP! 1) .VARK1)»VAR2(1)»VAR3(1).VAR4(1)»ISTEP(1)
    MM » -1
    GO TO 19
    ENTRY      XINEAR (XTM.STEP.NV.NA.I»VAR1»AC1.VAR2»AC2.VAR3»AC3.
   1 VAR4.AC4)
    MM • 1
 19 IF (NA.LE.l) GO TO 60
    DO 40 L*2*NA
    I « L-l
    IF (MM) 25*25.26
 26 IF (XTM-STEP(LM131«30»40
 25 IF (ITM-ISTEP(D) 31.30*40
 30 I « L
    TIMES • 0.
    GO TO 49
 40 CONTINUE
131 TSTART » XTM-STEPU)
    TFINAL = STEP(I+1)-STEP(I)
    GO TO 127
 31 TSTART * ITM - ISTEP(I)
    TFINAL " ISTEPd + 1)  - ISTEP(I)
                                - VAR4U)1*TIMES
                                - VAR31I))«TIMES
                                - VAR2
-------
»PA»DUW»PASA»PAAB»EC »TCL »LLCtCSZI tDTDT t
   SUBROUTINE SOLAR2 (NP1
  1 XIN5«TEiTOPRAtNTOP>
   DIMENSION PA(l) iDUWH) fPASAH) »PAABU) »EC«D »TCL< 1
   ATWA(APtAC) a SQRTt («000949«AP+.051)/AC)
   C03 * 980. /240.
   XIO a 1.95/60*
   COSZ = CSZI
 COMPUTE TRANSMISSION THROUGH' CLDS  ABOVE  BOY LAYER
   VALUE * It
   IF (COSZ. GT. 0.17365) GO TO. 13
   VALUE • COSZ/. 17365
   COSZ a •17365
13 TC » 1.
   XMP a PAID/1013. 5/COSZ
   LSAV a 0
   00 20 I»l»6                                  '
   IF (LLCUUGT.NTOP)  GO TO 21
   IF (LLCU).LT.NPl) GO TO 18
   K a TCLU)                        '
   CALL TRANS(XMP»T2»K)
   TC » TC*(1»-EC(I)#(1«-T2))
   GO TO  20
18 LSAV » 1                       "
20 CONTINUE
21 K   « NTOP-1
   UT » 0«                           v
   UAB" 0.
   USC= 0.
   DTDT(l) « 0.
   DO 24 I«NP1»K
   UT » UT+DUWU)
   UAB = UAB-t-PAAB(I)
24 USC * USC+PASAII)
   UT » UT-OUW(NPl)
   TPS  a l,
   TPA  a 1.           '
   IF (UAB.GT.O) TPA  « EXP(-UAB)
   IF (USC.GT.O) TPS  « EXP(-USC)
   TPAM = TPA
   TPSM » TPS
   XCV = XIO*COSZ*VALUE
   TOPRA = 0.
   TCM a TC
   DO 50 K»liNPl
   I * NP1-IO1
   Tl = 1. 041-0. 16*ATWA(PA( 1  )tCOSZJ
   TAU1 » .485+.515*Tl
   UT  » UT -t-DUW (I)
   TAU2 = .077*(UT/COSZ)*»»3
   A « TC*TPA*TPS
   GNM = XCV*TAU1
   WNM =-XCV*TAU2
   Tl a A*(GNM+WNM)
   IF (K.GT.l) GO TO 31
   TE a Tl
                               SOLAROOO
                     •          SOLAR001
                 »LLCU ) »DTDT 1 1 ISOLAR002
                               SOLAR003
                               SOLAROOO
                               SOLAR005
                               SOLAR006
                               SOLAR007
                               SOLAR008
                               SOLAR009
                               SOLAR010
                               SOLAR01L
                               SOLAR012
                               SOLAR013
                               SOLAR014
                               SOLAR015
                               SOLAR016
                     '          SOLAR017
                               SOLAR018
                               SOLAR019
                               SOLAR020
                               SOLAR021
                               SOLAR022
                               SOLAR023
                               SOLAR02<»-
                               SOLAR025
                              . SOLAR026
                               SOLAR027
                               SOLAR028
                               SOLAR029
                               SCLAR030
                               SOLAR031
                               SOLAR032
                     •          SOLAR033
                               SOLAR034
                               SOLAR035
                               SOLAR036
                               SCLAR037
                               SOLAR038
                               SOLAR039
                               SOLAR040
                               SOLAR041
                               SOLAR042
                               SOLAR043
                               SOLAR044
                               SOLAR045
                              > SOLAR046
                               SOLAR047
                               SOLAR048
                               SOLAR049
                               SOLAR050
                               SOLAR051
                               SOLAR052
                               SOLAR053
                               SOLAR054
114

-------
31
XIN5
GO TO
UAB •
USC »
•  TE
41
UAB+PAABU)
USOPA5AU)
   IF (PAABID.GT.O) TPAM = EXP(-UAB)
   IF (PASAtI).GT.O) TPSM • EXP(-USC)
   IF (LSAV.EQ.OI  GO TO 29
   IF (LLC(LSAV).NE.I> GO TO 29
   LR « TCL(LSAV)
   CALL TRANS(XMP»T3tLR)
   TCM » TC*(1.-EC(LSAV)*(1.-T3»
   LSAV • LSAV-1             ' .
29 T2 « T1*(1.-TC+TCM)
   T3 «  T2*(1.-TPS+TPSM)
   TOPRA » TOPRA+A#(GN-GNM)+0..9*T1*(TC-TCM>+T2*(TPS-TPSM)
   RAAB " A*(WN-WNM) + 0. 1*T1».( TC-TCM) +T3*C TPA-TPAM)
   TAU1 = C03«RAAB/(PA«I>-PA(I+1)J
   IF (K.GT.2)  DTDTU+1) « TAU1+(PAI 1 + 1 )-PA( I) )/(PA( 1+2 )-PA( I) >*
  1 (DTU-TAU1J
   XIN5 « T3#(1.-TPA+TPAM)
41 TPA « TPAM
 ,  TPS « TPSM
   TC • TCM
   GN • GNM
   WN • WNM
   DTU " TAU1
50 CONTINUE
   RETURN
   END
SOLAR055
SOLAR056
SOLAR057
SOLAR058
SOLAR059
SOLAR060
SOLAR061
SOLAR062
SOLAR063
SOLAR064
SOLAR065
SOLAR066
SOLAR067
SOLAR068
SOLAR069
SOLAR070
SOLAR071
SOLAR072
SOLAR073
SOLAR074
SOLAR075
SOLAR076
SOLAR077
SOLAR078
SOLAR079
SOLAR080
SOLAR081
SOLAR082
SOLAR083
                                      115

-------
   SUBROUTINE XUHN (UW.EW.KUHN)
   Tl = ALOG10 (UW)
   GO TO <31.33.35»37»39.42>»KUHN
31 IF Ul+4.) 32»33»33
32 EW » .11288 * ALOG10U + 12.635«UW)
   GO TO 49
33 IF (Tl+3.) 34»35i35
34 KUHN « 2
   EW = 0*104 * Tl + 0*442
   GO TO 49
35 IF (Tl+1.5) 36i37»37
36 KUHN = 3
   EW = 0.121 * Tl + 0.491
   GO TO 49
37 IF {Tl+1.) 38»39»39
38 KUHN » 4
   EW = 0.146 * Tl+0.527
   GO TO 49
39 IF(T1) 40t41.41
40 KUHN =» 5
   EW » 0.161*T1 + 0.542
   GO TO 49
41 KUHN » 6
42 EW « 0*136 * Tl+0.542
49 RETURN
   END
XUHN
XUHN
XUHN
XUHN
XUHN
XUHN
XUHN
XUHN
XUHN
XUHN
XUHN
XUHN
XUHN
XUHN
XUHN
XUHN
XUHN
XUHN
XUHN
XUHN
XUHN
XUHN
XUHN
XUHN
XUHN
XUHN
000
001
002
003
004
005
006
007
008
009
010
Oil
012
013
014
015
016
017
018
019
020
021
022
023
024
025
                                      116

-------
SUBROUTINE
A = XMP
              TRANS! XMP»PS1 iNCT )
 8

 9
98

99
15

13

10
14
50
                       » A
               - .0149 * A

               - .0149 « A
                 •0145 » A
            - .0179 * A
NBR
GO TO
PS1 »
GO TO
PS1
GO TO
PS1
GO TO
PS1
GO TO
PS1
GO TO
PS1
GO TO
PS1
GO TO
PS1
GO TO
PS1
PS1
PS1
RETURN
ENTRY      KAPPA(ZIN.XOUT)
DIMENSION AK(6).Z(6)
DATA AK /.637*.351..235».165*.116*.0977/
DATA Z  /2.0,5.0.10.0,20.0.50.0.100.O/
IF(ZIN.LE.2«> GO TO 50
IF
-------
      SUBROUTINE FILES                                                  FILESOOO
C        THIS ROUTINE DEFINES FILES FOR VARIOUS RUNS WITHOUT            FIUES001
C        RECOMPILATIONS OF MAJOR PROGRAMS                               FILES002
      COMMON /TAPBLK/ IUAR96»IUAR97.IUAR98»IUAR99                       FILES003
C   UNIT  95  STORAGE FILE FOR PRINT — TAPE OR DISK SEQUENTIAL         FILES004
C     DEFINE FILE 95(36 i2376»L»IUAR97)       NOT USED FOR SEQUENTIAL     FILES005
C   UNITS 99»96 FOR YY TO STORE FOR COMPUTATION OF GRADIENTS—DIRECT ACCFILES006
      DEFINE FILE 961 36 »K88 »L »IUAR96)                                   FILES007
C     DEFINE FILE 98INO. STATIONS.4«NCR.L»IUAR98)                       FILES008
C   UNIT  98  FOR RESTART VARIABLES — DIRECT ACCESS                    FILES009
      DEFINE FILE 97(36i3012»L»IUAR97)                                   FILES010
      DEFINE FILE 98< 36 16868. L »IUAR98 )                                   FILESOH
C     DEFINE FILE 96/991NO. STATIONS»<»*NWSYY»LiIUAR96/IUAR99)           FILES012
      DEFINE FILE 99136tl468*LtIUAR99)                                   FILES013
      RETURN                                                            FILES014
      END                                                               FILES015
                                        118

-------
4.0  ANALYSIS PROGRAM FOR THE THREE-DIMENSIONAL BOUNDARY LAYER MODEL


A.I  Introduction


     The program is designed to.»accept a tape written by the three-dimen-


sional boundary layer model in Section 2.0 and to print the simulated re-


sults in a variety of formats to permit analysis of the results.  The
                                                          /

results may be in a time series (t), a map format (x-y), a height space


cross section (z-x), and a height time cross section for a horizontal grid


point (z-t).



4.2  Card Input


     The card input contains one general card and up to four sets of cards.


In all cases, a variable indicator is used to define the variable.  The


variable indicator is listed in Table 1.  The analysis sets listed in


Table 1 refer to time series (1), map format (2), height space cross sec-


tions (3), and height.time cross sections (4).


     The analysis sets for map format (2) and the height space cross sec-


tions (3) have an option to contour print the variable.  The value of the


contouring parameters is given in Table 2.
                                   119

-------
      TABLE 1
Variable Indicator
T , . Valid Program Name
Indicator AnalvBis Sets Section 1<2
1 4
2 4
3 1,2,3,4 U
4
5
6
7
8
9
10
11
12
13 ^
V
T
q/s
w
.XKU
WEL
RI
DTI
. PP1
' ' PP2
14 2 RADMX
15
16
17
^
18 '
ROW
V
XMQ
DEL
f
' XLAM
19 1,2 RANS
20
21
22
23
24
25
26
27
28
29
30
31
32 1
RABNS
.
RABS
RAA
CRNS
CRS
TOUPRA
SRS
TAWAS
TAWIS
TAWWS
HAS
rHAIS
I1SIS
Program Name
Description
Variables 14-37.
Variables 50-56.
Eastward velocity.
Northward velocity.
Temperature.
Humidity/salinity.
Horizontal, velocity.
Vertical momentum coefficient.
Vertical velocity.
Richardson number.
Radiative heating rate.
Pollutant 1.
Pollutant 2.
Artificial heat source.
density of surface.
Moisture parameter.
Wave steepness.
Wavelength.
Downward infrared flux (ZN).
Upward infrared flux (ZN>.
Upward infrared flux (z=0).
Downward infrared flux (z=0).
Downward solar flux-(zN).
Downward solar flux (z=0).
Upward solar flux (ZN).»
Albedo.
Eddy stress (ZN).
Eddy stress (z=0).
Eddy stress (zi).
Eddy heat flux to atmos.(z.,)-
Eddy heat flux to atmos.(z=0).
Eddy heat flux to subsf c. (z=0).
        120

-------
Table 1 (Continued).  Variable Indicator
T j . Valid Program Name
Indicator ^^ Set£J Section 1<2
33 1,2 HSS
34
35
36
37
38
39

, 40
41
42
43-49
50
51
52
53
54
55
56
57
58
»
59 1
CES
CEAS
CFNS
CF
H3S
ETA2

XETA2
. YETA2
HEIGHT

RSUM(l) '
2
3
4
5 "
6
7
8
9
f
' 10
Program Name
Description
Eddy heat flux to subsurface (z^) .
Eddy water vapor flux into atmo-
sphere (ZN).
Eddy water vapor -flux into atmo-
sphere (z=0) .
Eddy salinity flux into ocean
(z=0).
Eddy salinity flux to bottom (z.) .
Height of characteristic wave.
Departure of water surface from
mean.
3n/3x .
3n/3y .
See card 20 (a), Cols. 25-36 for
model input of Section .
Not used.
Time sum for latent heat flux.
Time sum for atmos. heat flux.
Time sum for subsurface heat flux.
Time sum for precip. heat flux.
Time sum for solar heat flux.
Time sum for infrared heat flux.
Time sum for artificial heat flux.
Time sum for outgoing infrared
heat flux.
Net solar (z=N) .
Net TR (z=N).
                                   TABLE 2
                             Contouring Parameter
IANA =
0
1
2
3
No grid analysis
Prints and contours
Contours
Prints
                                     121

-------
Input Deck Setup for Analysis and Gridprint Program
     Card
     Type_    Format    Columns
       0
1415
 4-5

 9-10


14-15

19-20
                          25

                        29-30
                        34-35


                        39-40
 Symbol
Integers

 NTPL0


 NXYPL0


 NZXPL0


 NZTPL0
                      M0RE


                     ITAPE

                      195



                     NFAREN
    Program Designates

Number of cards for time series
plots (<. 30)(n.d.).

Number of cards for maps in
X-Y plots (
-------
                        14-15      ISTAT      Grid point index for horizon-
                                              tal grid points to be plotted.
                                              The horizontal grid points
                                              are defined from Figure 2 as
                                              1 = point (1,1), 2 = point
                                              (1,2), etc.
Analysis Set 2 will produce maps in x,y format,
               1415      4-5        IVAR      Variable indicator from
                                              Table 1.

                         9-10      IZPL0T     Height level to be plotted
                                              (1 < IZPL0T < NX+1)*.

                        14-15       IANA      Contouring parameter, Table 2.

                        19-20      ITISTP     Time step index (<_ 20) (not
                                              the time step).
Analysis Set 3 will produce:  Height-space cross section.
               1415
4-5
IVAR
9-10
14-15
19-20
24-25
29-30
IANA
ITISTP
11
ISTOUT(I)
Variable, indicator from
Table 1.

Contouring parameter, Table 2,

Time step index (<. 20) (not
the time step).

Number of horizontal grid
points in cross section.

Horizontal grid point indices
of points in cross section
(1=1,11).
                        69-70
Analysis Set 4 will produce:  Height-time cross sections.

       4       1415      4-5       IZTSTA     Horizontal grid point index.

                         9-10        12       Number of variable indicators.

                        14-15   .-   IVAR      Variable indicators (1 to 12)
                                              from Table 1 (1 <. IVAR <. 13).
*  NX is defined in Section  1.2.
                                    123

-------
4.3    FORTRAN Listing for ANALYSIS Program
      ANALYSIS PROGRAM
      COMMON NSTOUT(IO) • ISTR» I MAX* JMAXt IGRID» UtDTiREALT »NREOS
      COMMON I TIMES (20)
      COMMON IVAR<30»3) »IZPLOT(30t2) »ITISTP(20»2) 1 1 STOUT (20 1 10)
      COMMON ISTATOO) » lANAt 30 »2 ) tCOM( 18 ) tZ ( 30 ) »ZA( 30 ) » I SET (20)
      COMMON TRANS(30»20) »XYPLO( 100 i20 ) »ZXPLO( 20 • 30 • 20) tAA(600)
     1  »3A(30»20) tIZTSTAdOO) »NZTVA(100) t I ZTVAI 100*13)
      DIMENSION MAXA(IOO) »MAXX(100) tllVAR(l) • I POL (13) tRSUMU5t40)
      DIMENSION VRNMU26)   •
      EQUIVALENCE I I IVAR( 1 ) » IVARI 1 »1 ) )
      EQUIVALENCE ( MAXA ( 1 ) »MAXX( 1 ) )
      EQUIVALENCE ( AA 1 1 ) »RSUM( 1 .1 ) )
      DATA IPOL /0»0»2»2»2»2»3»0»3»3»3»3»3/
DATA VRNM ./4HU t4H
1
2
3
4
5
6
7
8
9
1
2
3
4
t4HWSS »4H t4HXKU
t4H t4HPPl »4H
t4HXMQ t4H. t4HDEL
t4H t4HRAB t4H
»4HTOUP»4HRA t4HSRS
»4H »4HHA »4H
t4HCE t4H »4HCRE
»4H t4H Et4HTA2
t4H *4H »4H
|4H »4H »4H
»4HS SUt4HM t4HP S
»4HSUM t4HTG**»4H4
t4H t4H t4H
                                                           • 4HQ
                                                           t4H
                                                           •4HROW
                                                           |4H
                                                           t4HCRS
  »4H    »4HT   »4H
  t4HVVEL»4H    »4HRI
  t4H    *4HRADMt4HX
  »4HXLAM»4H    »4HRAN
  i4H    t4HCRN t4H
  »4HTAWAt4H    t4HTAWl»4H
  »4H    t4HHSl »4H    »4HHS
  t4HCF(Ot4H)   t4HCF(lt4H)
XEt4HTA2 t4H  YEt4HTA2 »4HHEIG
  »4H    t4H    »4H
  t4H    t4HLE St4HUM
  i4HR(l-t4HA)  t4HRA St4HUM
  t4HSOL »4HNET t4HIR
                            t4HV
                            t4H
                            t4HPP2
                            »4H
                            •4HRAA
                            *4H
                            t'4HHA I
                            t4H
                            t4H
                            »4H
                            t4H
                          SU »4HM
                            t4HNET
                            t4H
    READ NECESSARY TAPE INFORMATION
 11 READ It NTPLOtNXYPLOtNZXPLOtNZTPLO»MOREtITAPE»I95tNFAREN
    PRINTlt NTPLOtNXYPLOtNZXPLOtNZTPLO»MORE»ITAPE tI95tNFAREN
  1 FORMAT(14I5)
    IF (I95.GT.O) CALL TAPCHG (I95tITAPE)
    DO 919 I=lt616
919 NSTOUTlI) = 0
    IF( NTPLO )22t22t20
    TIME SERIES
 20 DO 21K=1»NTPLO
    READ 1» iVARUtl) »IZPLOT1»NXYPLO                	
    READ It IVAR(Kt2)tIZPLOT(Kt2)tIANA(K»l)»ITISTP(K»l)
    PR I NT 1» IVAR(K»2)tIZPLOT(Kt2)tIANA(K»1)tiTlSTPJKf1>
 24 CONTINUE
 25 IF(NZXPLO)29»29t26
 26 DO 27K=ltNZXPLO
    READ It IVAR(Ki3)»IANAU»2)tITISTP(K»2)»Ilt(ISTOUT(IKtK)tl
    PRINT1* IVARIK.3)11 ANA(Kt2>11TISTP(K,2)1111(I STOUT(IK»K)»I
    NSTOUT(K) = II
 27 CONTINUE                                .
 29 CONTINUE
    IF (NZTPLO.LE.O)  GO TO 420
    DO 419 J=1,NZTPLO
    READ 1»IZTSTA(J)111»(IZTVA(J»I)«I»1,I1)
t4HDTl
»4H
*4HRABN
t4H
»4HTAWW
t4H
t4HH3
»4HHT
                                                                  »4HMAN
                                                                   1 1 1 )
                                         124

-------
      PRINTltIZTSTA(J)iIl»(IZTVA(J»I) tl»l»ll)
  419 NZTVA(J) = II
  420 IF(NZTPLO.EQ.-l) GO TO 421
      IF ( (NTPLO+NXYPLO+NZXPLO+NZTPLOl.LE.O) GO TO 1999
C-READ RECORD ID AND SET UP CONSTANTS
  421 KK = 1
      READ  (ITAPE) AA
 2222 FORMAT j(lX9E13.5>
      DO 181=1118
   16 CONK I) « AA(I)
      IMAX  = AAI52)
      JMAX  * AA.153)
      IGRIO = IMAX •» JMAX
      IX *  AA(55>
      NP1 B AA(21)
      NM1 • NP1-2
      DT «  AAC54)
      DT «  DT/60.
      ISTR  = AA(56)
      DO 631-1*20
   68 ITIMES(I)  » AACI+62)
      XD «  AA(600)
      NRECS * AA(20>
      DO 51I=1»30
   51 Z(I)  * AAd-t-21)      /100*
      L » 0
      NX »  NP1-1
      DO 32 1»1»NX
      Tl a  IZU)+Z(I + 1) )/2.
      IF (I.EQ.IX) GO TO 32
      L o L+l
      ZA(L) • Tl
   32 CONTINUE
      KOUNT » 1
      DO 60KK»1,IGRID
      KL «=  ( (IGRID-
-------
      D01162 MJ=1»MK
      IFUZTVA(MI.MJ).EQ.II) GO TO 1061
 1162 CONTINUE
  162 CONTINUE
      GO TO 161
 1061 GO TO (163*164).II
  163 PRINT lOOOt KK.COM.DT
      DO 10011*1.ISTR
      ISTEP * ITIMESin
      PRINT 1002»    ISTEP.AAt1+82).AA(I+102)»AA(I+122).AA(I+142>.
     1 AAd + 162) tAAd+182) .AAd+202) »AA(I+222)
 1001 CONTINUE
      PRINT 1003
 1003 FORMAT(//30X.45HUPPER AND LOWER BOUNDARY AND INTERFACE FLUXES//
     111X»28H(	iDYNES/CM**2)	) .4X.36HI	(MLY/SEC)-
     2	).4X.36HIMQM/SEC CM»#2)      (MUGM/SEC CM**2).2X.8H<—CM
     3—)/6H  TIME.6X.6HTAWIN)»7X .3HTAW.4X.6HTAWI1)»6X»4HH(N)»9X»1HH»9X»
     4lHH.6X.4HHd ) .6X.4HEIN) . 9X »1HE »9X» 1HF »6X .4HF (1) »4X .6HHU/3 ) /6H  ST
     5EP»19X.3HZ=0»26X»4HZ=+0»6X»4HZ*-0»26X.4HZ=+0»6X»4HZ=-0//>
      DO 10041 = 1.ISTR
      ISTEP = ITIMES(I)
      PRINT 1005.   ISTEP.AA(1+242)»AA(1+262)»AA(1+282)»AAl1+302)»
     lAAf1+322).AACI+342)»AA(I+362),AA(1+382)»AAU+402),AA<1+422)»
     2AA(1+442),AA(1+462)
 1004 CONTINUE
      PRINT 1113 '
 1113 FORMAT(//30X.'ETA2     XETA2     YETA2'/6H  TIME.6X.6H ETA2 »
     1 7X.5HXETA2.4X.5HYETA2.4X.5H   H3//)
      DO 11141-l.ISTR
      ISTEP = ITIMESd)
      PRINT 1005.  ISTEP.AAJ1+482)»AA(1+502).AA(I+522)
     1   .AAU+462)
 1114 CONTINUE
 1005 FORMAT 
-------
      PRINT 1308»ITIMESm.OA(I»K) »K»1.5I
      PRINT 1308.KK       »(BAII.K)«K«6ilO)
 1310 CONTINUE
 1308 FORMAT<1X»I5»5£12.4>
      PRINT 1301iK<
  161 DO 40 ICALL»IJ»IE
      IF III.EQ.U MA «  " AA(MM)
      GO TO 40
C-SET UP XYPLOT FOR VARIABLES  19 NO (Z) DEPENDANCE
   33 II • MA + ITISTPCK-30.1)
      IF UI.EQ.2) II = MA+(ITISTP(K-30»1))»15-15
      IFdCALL.EQ.42) II - 599
      XYPLO(KL»K-30) » AA(Il)
   40 CONTINUE
   63 CONTINUE
C-SET UP STORE FROM VARIABLES 3-13
      DO 70 ICALL»3iNRECS
C-READ RECORD INTO BA(30»20)
      READ (ITAPEiEND»73) BA
      IF(ICALL.EQ.5.0R.ICALL.EQ.7> GO TO 1446
      GO TO 1449
 1446 DO 1450 I«1»NP1
      DO 1450 J=»1»ISTR
      IFUCALL.EQ.5) BA(I»J) = BA(I»J)  - 273.16
      IFUCALL.EQ.7) BA(lfJ) » BA(I»J)  * .0194254
 1450 CONTINUE
 1449 CONTINUE
      IF (NZTPLO.EQ.-l) GO TO 449
      IF (NZTPLO.LE.O) GO TO 451
      DO 445 I=1»NZTPLO
      IF UZTSTAI D.NE.KK) GO TO 445
      II « NZTVAU)
      DO 444 'J»1»I1
      IF 
-------
  448 FORMAT (  '1VARIABLE* '»2A4»« FOR '»18A4i' STATION*'iI5»' DT=»»F5.2
     1 ///' HEIGHT1 |4X»13(5X4HTIME)/4X'IN»»5X»1315XISTEPI))    '
      IF(NTPLO.LE.O) GO TO 45
C-TIME SERIES
      DO 44K=1«NTPLO
      IFdVAR(Kil).NE.ICALL)  GO TO 44
      IFdSTATUI.NE.KlO GO TO 44
      II « IZPLOT(Kil).
      DO 42 I«1»ISTR
   42 TRANS d»K>  = BAdltl)
   44 CONTINUE
C-SET UP  X»Y PLOT
   45 IF(NXYPLO.LE.O) GO TO 52
      DO 50 K=1»NXYPLO
      IF(IVAR(K»2).NE.ICALLIGO TO 50
      II a IZPLOT(K>2)
      12 « ITISTPJKil)
      XYPLO(KL»K> « BAU1.I2)
   50 CONTINUE
C-SET UP  ZiX PLOT
   52 IF (NZXPLO.LE.O) GO TO  70
      DO 56 K"1,NZXPLO
      IFUVAR(K»3).NE.ICALU  GO TO 56
      IJ - NSTOUTU)
      DO 53 I=1»IJ
      IF(ISTOUT(I»K).NE.KK) GO TO 53
      IT « I
   54 II » 1TISTP(K»2)
      DO 55 M*1»NP1
      ZXPLOIITiMiK) » BA(Mtll)
   55 CONTINUE
   53 CONTINUE
   56 CONTINUE
   70 CONTINUE
   60 CONTINUE
      REWIND ITAPE
  301 NX » NP1-1
      IF(NTPLO.LE.O) GO TO 311
      DO 110K=1.NTPLO
  110 CALL PLOT(TRANS(1.K)»VRNM»K.NFAR£N>
  311 IF(NXYPLO.LE.O) GO to 131
      DO 310I=1»JMAX
      MAXX(I)x« 1
  310 MAXXII+JMAX) = IMAX
      DO 130K=1»NXYPLO
      II « 1
      IJ = MINOdMAX.ll   )
      IPLOT1 H  ITISTP(K»1)
      REALT = DT  * ITIMES(IPLOT1)
      REALT « REALT/60*
      IZ » IZPLOT(K»2)
  111 PRINT 209»  (COMtI)»I«l»18)
  209 FORMATI1H1.18A4)
      IPLOT2 «  2*IVAR(K»2) -5
      PRINT 212»  VRNMI IPLOT2)fVRNM(IPLOT2+1)»ITIMES(IPLOT1>»DTiREALT»
     1  ZIIZliXD
                                         128

-------
212 FORMATC     X-Y PLOT FOR VARIABLE S2A4/' TIME STEP-SIS*1  DT*S
   1F6.2*1  REAL TIME«SF6.2*' HOURS  HEIGHT=SF8.1,' M X DIST«SF8.0)
    DO 112I"IliIJ
112 ISET(I) « I
    PRINT 213* USETU)»I»I1*1J)
213 FORMATI1HO* 115.10110)
    12 « II
    13 « IJ
    00 115 JJ»1»JMAX
    J » JMAX-JJ+1
    12 • U-1.)*IMAX-H1
    13 « I2+IJ -1
    PRINT 514* J»
    12 » 12 + 10
180 CONTINUE
    II » IANA(K»2)-2
    IF(IANA(K»2).GE*1) CALL ORIDPR(ZXPLO(1.1»K).NSTOUT(K).NP1.K*2»II»
                                       129

-------
    1 MAXAiVRNMIIPLOT2)i20»30)
 200 CONTINUE
1999 IF(MORE) 999»999»11
  72 PRINT 333»IIiKK
 333 FORMAT ('OEND OF FILE AFTER RECORD1.15».'  AT STATION1>I5)
     GO TO 74
  73 PRINT 333.ICALL.KK
  74 REWIND ITAPE
     GO TO 1999
 999 CALL EXIT
     END
                                        130

-------
      SUBROUTINE GRIDPR(A»MAXXiMAXJ»KlN«IXOXZ»ICTP»MAXA»VARNUM»              001
     1  IEX.JEX)                                              •               002
C  #*« IF MAXI LT 0» SPACING IS 1 INCH» POSITIVE t5 INCH                ••    003
C  »** IF KA  NEG»0» DATA STARTS AT 1»1 OF AiBUT IS ACTUALLY                 004
C  .**» ON GRID AT KA»KB (WRT 0»0)                                            005
C  *** KA GT 0 INDICATES SUBSET OF ARRAY WRT 0»0                             006
      COMMON NSTOUTUO)»ISTR»IMAX»JMAXtIGRID»lX»DT»REALT»NRECS               007
      COMMON {TIMES(20)                   -                                   008
      COMMON IVAR(30»3>•IZPLOT<30•2)»ITISTP<20.2)»I STOUT(20»10)              009
      COMMON ISTATOO) »IANA<30»2) »COM(18) »Z(30) »ZA(30) »ISET<20)              010
      DIMENSION BAND(20)»SCALES(4)»VARNUM(1)                                 Oil
      DIMENSION.A
-------
      GO TO 16                                                               057
   15 JLOOP = (MAXI-ll/IE+1                                                  058
      1RIGHTMLEFT + IE-1                                                      059
 .  16 BLANK=BAND(20)                                                          060
      II = ITISTP(KIN»IXOXZ)                                                 061
      ITM = ITIMES(Il)                                                       062
      DO 355 IJK»1»ILOOP                                                     063
   40 PRINT 1005»COM.VARNUM<1)»VARNUM(2)»ITM.DT»REALT                        064
 1005 FORMAT I'lRESULTS OF '•18A4i'  FOR '.2A4/1 AT TIME STEP'»I5»» DT»'»     065
     lF5.li1 MINUTES SCALES(1)»SCALES(3)»SCALES(4).BAND  	          078
      IF (IP6) 84»83»83                                                      081
   84 PRINT  905» (PLINE
-------
   47 IF (MAXA(J)-I) 231t270i270                                             115
  220 IF(I-ILEFT> 47»270.47                                                  116
C        GENERATING CONTOUR BANDS                                            117
  231 1BAND=1.+»A(I-1»J  I-SCALESI3)+XY*(AC IiJ  l-AII-l.J  M +YY*           118
     XIA(I-1»J+1  )-A(I-l»J  )) +XY*YY*(AU-1»J  >+A(I»J+l   )-A(1-1•J+l      119
     X )-A(I»J  1») /SCALESU)                                                120
  240 IF(lBANO)270i270»250                                                   121
  250 IBANDa MOD(IBAND-1i20)+1                                                122
  260 PLINE'(IPL)" BAND (I BAND)            '        '                            123
  270 CONTINUE                    '                                           124
C     WRITE BLANK OR BANDED LINES                                            125
  280 IF(JINT-NINT)290»281i340                                                126
  281 PRINT 1001*  ROW.PL INE                                                 127
 1001 FORMAT (1XF5.0»125A1>                                                  128
      GO TO 340                                        .                      129
  290 IFUP6)    291i295»295                                                 130
  291 PRINT 293»  PLINE                                                      131
  293 FORMAT (6X125A1)                                                       132
      GO TO 340                -                                              133
  295 PRINT 1002»  PLINE       .                                              134
 1002 FORMAT (6X125A1)                    '                                '   135
  300 GO TO 340                                                              136
C     WRITE GRIDPOINT VALUES                                                 137
  310 DO 320 I=ILEFT»IRIGHT        .                                         138
      IF (A(I.J) .EQ.O.)  AtI»J)-1.E-15 '                                    139
      Tl > ABS(A(I.J))/A(I»J)».5                                             140
  321 LINEU) » SCALES(2)*A(ItJ)+SCALES(l)+Tl                                141
  320 CONTINUE                                                               142
  330 IF (IP6) 329»331»331                                                   143
  329 PRINT 328»    ROWt
-------
   SUBROUTINE STOR {ISTR)                                                  001
   DOUBLE PRECISION DTI.PP12»PP22»TT2tU2»V2iW2»YY                         002
   COMMON RK30) »DTI (30) .YYO0.6) »SLOPX »SLOPY »HEIGHT »ETA1 »ETA2 .XETA2 t' TAPCHG1
  1YETA2»IHT»IANV.IGOG.ETAINX.ETAINY»CSOUT12).CRSiRAAiTOUPRAfH3iCF»CE TAPCMG2
  2»WS(30)tUST.CW»HAI.HSI»RANS»RABNS»RABS»CRNS»TRAUS»XT2»VVELt30)
   COMMON XKU(30)»         SRStRADMXiIGOGOiROWiXMQiDEL
  1   »XLAM*RSUMd5)iBl»B2»RADMX2iRADMXl
   COMMON -ZOO) iZA<30) »DZ(30) »DS(30) »DUMMY(135> »COM(18) iVARINOO)
  1  »NCStJMAX»IMAX»NXiNPl»IX»DT.ITIMES(20)»IM1»ABC»IP1»NM1»IP2           008
  2  iIGRID»NRECD»ITAPE                                     .              009
   COMMON AB(600)iU2S(30.20)»V2S«30120).TT2SI30i20 ) »W2S(30»20)            010
  1 »WSS(30«-20) .XKUS(30i20) »XKTS( 30»20 ) »R 15(30*20) »DT1S< 30»20)            Oil
  2  »PP1S(30»20)»PP2S<30»20)»RSUMS<15»40>                                012
   COMMON IUAR97                                                          013
   DIMENSION PP12I30)»PP22I 30)»TT2(30)»U2<30)»V2<30)iW2(30)               014
   EQUIVALENCE (YY(1.1)iU2(1))»(YY(1»2)»V2(1))»
-------
   TT2S«»ISTR) a TT2U)                                                  050
   W2S / 4.E4
   PP2S«»ISTR) a PP22(K) / 4iE4
40 CONTINUE            '                                                   070
   DO 12K»1»15              .                                             S071
12 RSUMS(K.ISTR) « RSUM(K)                                                072
   RETURN                                                                 073
   END                                                                   S074
                                       135

-------
      SUBROUTINE  PLOT(TRANS,VARN»KIN»NFAREN)
      COMMON NSTOUT(IO).ISTR»IMAX,JMAX>IGRID.IX,DT.REALT.NRECS               002
      COMMON ITIMESI20)                                                       003
      COMMON IVAR(30»3)»IZPLOT(30»2).ITISTP(20»2)»ISTOUT(20ilO)               004
      COMMON ISTAT<30)»lANA(30»2).COM(18)fZl30)»ZA(30)»ISET(20)               005
      DIMENSION XPLOT(51»20)                                                  006
      DIMENSION TRANS  (1)»  VARN(1)»RANGE(51)                      .            007
      DIMENSION RANGF<51)
      DATA BLNK/4H    /                                                       008
      DATA ASTRIK/4H   »/                                                     009
      DATA 2ERO/4H  Q/                                                       010
      DATA TEMPF/4HT   /
   18 XSUM » 0.                                                              Oil
C     FIND RANGE  OF MEAN FOR  SELECTED  PARAMETER                              012
      XMAX - TRANS(l)                                                         013
      XMIN » TRAN5U)                                                         014
      DO 73NFAR«1«51
   73 RANGF(NFAR)  = BLNK
      DO 74 K = l.ISTR         .                                              015
      IF
-------
     GO TO 14                                                               053
  13 XPLOT(I+1.K) = ASTRIK    .                                              054
  14 CONTINUE                                                               055
     ISTA « ISTAT(KIN)       -                                               056
     II » 2*IVAR(KIN»l)-5                      '                             057
     PRINT 104.VARNU1) tVARNI Il-t-1) iCOM                                      058
 104 FORMAT ('1TIME SERIES OF '»2A4i' FOR •»18A4)                           059
     12 = I$PLOT(KIN»1)                 •                                    060
     Tl « ZII2)                                                             061
     IF (I1.EQ.12.0R.I1.EQ.16) Tl= ZAd2)                                   062
     PRINT 700» ISTAiDT»Tl.XINCR»XMEAN                                      063
 700 FORMATC.  THE FOLLOWING GRAPH IS FROM STATION '»I5»'  TIME STEP I     064
    1S'»F6.1»'  MINUTESi   HEIGHT <='»F6.1»' METERS' /    '    WITH RANGE
    2INCREMENT COMPUTED '»E12.6»' AND COMPUTED MEAN OF '»E12.6)
     PRINT 119»dTIMESd)»I = l»ISTR)                                         067
119  FORMAT (' TIME STEP  S20I5)  '                                          068
     IFtVARNIID.EQ.TEMPF.ANDtNFAREN.EQ.l) PRINT 1119
1119 FORMAT(IH+illOX,'FAHRENHEIT1)
     IF(VARN(I1).EQ.TEMPF.AND.NFAREN.EQ.2) PRINT 1120
1120 FORMAT(1H+»110Xi' ABSOLUTE •»
     DO 118 1=1.51                                                          069
     PRINT 1117. RANGEd ) . < XPLOTI I »K> .K»l»ISTR)
     IFtVARN(Il)iNEtTEMPF) GO TO"  118
     IF(NFAREN.EQ.l) RANGF(I) " (9./5.J * RANGEd) * 32.
     IF(NFAREN.EQ.2> RANGFU) = RANGEd) + 273.16
1118 PRINT 120. RANGFd)
 120 FORMAT(1H+»110X»F10«4)
 118 CONTINUE                          .                                     071
1117 FORMAT (1XE10.4»20(1XA4))                                              072
     KOUNT = KOUNT + I                                                      073
     IF(KOUNTiGT.2) GO TO 699                                               074
     XINCR = (XMAX-UMAX+XMIN) / 2.) / 25.                                  075
     XSUM = XMAX                                                            076
     T2 " 0.                                                              .  077
     IF (XINCR.GT.O.) GO  TO 1001                                            078
     PRINT 1                                                                079
   1 FORMAT <• SECOND GRAPH OMITTED—LINEAR')                               080
 699 RETURN                                                                 081
     END                                                                    082
                                        137

-------
      SUBROUTINE TAPCHG U95iITAPO)                                          001
C  PROGRAM TO CHANGE FROM PREDICTION TAPE(MULTI-STATIONJ TO ANALYSIS TAPE    002
C  UNIT 195 IS INPUT TAPE                                                    003
C  UNIT ITAPE/ITAPO IS OUTPUT TAPE                                           004
C  UNIT 97 IS DISK UNIT FOR RECOROERING RECORDS                              005
      DOUBLE PRECISION DTI»PP12»PP22»TT2»U2«V2»W2»YY                         006
      COMMON RII 30) .DTI(30)»YY(30»6)»SLOPX»SLOPY.HEIGHT»ETA1»ETA2»XETA2• TAPCHG1
     1YETA2»IHT»IANV»IGOG»ETAINX.ETAINY»CSOUT(2)»CRS»RAA»TOUPRAtH3»CF»CE TAPCHG2
     2»WSJ30).UST»CW»HAI»HSI.»RANS»RABNS.RABS»CRNS»TRAUS»XT2.VVEL(30)
      COMMON XKU(30)»         SRS»RADMX»IGOGO»ROW»XMQ»DEL
     1   .XLAM.RSUMI15).81»B2iRADMX2»RADMX1
      COMMON Z(30) »ZA<30).02(30) .DSl 30) .DUMMY1135 ) »COM(18) .VARIN130)
     1  .NCS»JMAX»IMAX»NX»NP1»IX»DT»ITIMES(20).IM1.ABC.IP1.NM1.IP2           012
     2  .IGRID.NRECD.ITAPE                                                   013
      COMMON AB(600)»U2S<30»20>.V2S(30.20).TT2S<30.20)»W2S(30»20)            014
     1 .WSSO0.20) ,XKUS(30»20) tXKTS(30.20) ,RIS(30.20) .DT1SO0.20)            015
     2  .PP1S130.20)»PP2S(30t20)»RSUMS(15.40)                                016
      COMMON IUAR97                                                          017
      DIMENSION PP12I30).PP22(30).TT2(30)tU2(30J»V2(30)»W2(30)               014
      EQUIVALENCE  (YY( 1.11 »U2 (1) ) »< YY( 1.2 ) »V2< 1) ) • ( YY< 1.3) »TT2d) )           019
     1  »(YY(1»4) »W2d) ) »(YY(1»5)»PP12<1) )»(YY(1»6) »PP22(D)                 020
      DIMENSION MARAY<25)  '                                            '021
c   DEFINE FILE 97 ISTATIONS#PRINT TIME sTEPs»4*Ncs.L»iUAR97)                022
      DEFINE FILE 971500.2376»L.1UAR97)
      READ  1. IXTRA.(MARAY{I)»I=1»IXTRA)                                    024
      PRINT l.IXTRA                                                          025
C NO* WORDS IN NCS                                                           026
      NCST a 594
      READ (195)     
-------
709
710
DO 709
AB(I)
ABI52)
ABI53)
ABJ54)
AB(55)
DO 710
ABCI+62)
AB(600)
ICOUNT •
705
 65
 67
  6
 68
           I»22«51
            ZU-21)
           = IMAX
           = JMAX
           « OT
           B ix
           I«l«20
             » ITIMES(I)
              XD
             0
PRINT 2»COM
FORMAT (1X»18A4)
DO 705 J=1»NRECD
READ (I95iENO=65) (Rl{I)iI«ltNCST)
ICOUNT » ICOUNT+1
WRITE (97'ICOUNT) (RI(I)•I»liNCST)
CONTINUE
PRINT 1»NRECD»NCS1»ICOUNT
DO 64 I«l»500
READ (I95»END«67) (RI(J)»J=1»NCST)  •
PRINT 5
FORMAT COEND OF FILE NOT REACHED AFTER 500 RECORDS')
GO TO 68
PRINT 4 » J.
FORMAT ClEND OF FILE PREMATURE AT RECORD1 »17)
CALL EXIT
PRINT 6
FORMAT COEND OF INPUT  FILE REACHED*)
CALL PRINT (IXTRA»MARAY)
PRINT 3
FORMAT C10UTPUT TAPE WRITTEN')
RETURN
FORMAT (1415)
END
055
056
057
058
059
060
061
062

063
064
065
066
067
068
069
070
071
072
073
074
075
076
077
078
079
080
081
082
083
084
085
086
087
                                        139

-------
   SUBROUTINE PRINT ( IXTRA.MARAY)
   DOUBLE PRECISION DTI »PP12 tPP22 »TT2 »U2 »V2 »W2 . YY
   COMMON RH30) »DT1 ( 30) »YY (30.6 ) .SLOPX.SLOPY.HEIGHTtETAl »ETA2 iXETA2 »
  1YETA2.IHT.IANV.IGOG.ETAINX.ETAINY.CSOUT12) »CRS»RAA»TOUPRA.H3 »CF»CE
  2»WS<30).UST»CW»HAI»HSI»RANS»RABNS»RABS»CRNS.TRAUS»XT2»VVEL(30)
   COMMON XKUOO).         SRS»RADMX» IGOGO.ROW.XMQ.DEL
  1   .XLAM.RSUMU5) .81 »B2 »RADMX2 »RADMXl
   COMMON ZOO) »2A( 30) .02(30) »DS( 30) .DUMMY ( 135 ) .COM(18) »VARIN(30)
  1  •NCS.JMAX»IMAX.NX.NP1»IX»DT»ITIMES(20) . IM1 »ABC» I PI »NM1» IP2
  2  .IGRID.NRECD.ITAPE
   COMMON AB1600) ,U2S( 30,20 ) »V2S( 30,20 ),TT2S( 30,20 ).W2S( 30, 20)
  1 ,WSS(30,20) .XKUSO0.20) .XKTS130.20) »R IS(30 , 20 ) ,DT1S ( 30 .20 )
  2  »PP1S(30»20).PP2S(30.20) »RSUMS( 15 .40)
   COMMON IUAR97
   DIMENSION PP12(30)»PP22(30)»TT2(30)»U2(30) »V2 ( 30) »W2 ( 30)
   EQUIVALENCE  ( YY( 1 .1 ) ,U2 ( 1 ) ) . ( YY( 1.2 ) »V2< 1 ) ) . ( YY( 1.3) »TT2« 1 ) )
  1  »(YY(1»4) »W2d) ) »(YY(1»5) »PP12U) >»(YY<1»6) »PP22d»
   DIMENSION MARAY(25)
   ICOUNT « 1               .
   DO 95L»1*IGRID
   ISTR = 0
   DO 10 I»ltIXTRA  •
   MIS » MARAY(I)
   DO 9 J'l.MIS
   ISTR = ISTR+1
   READ (97' ICOUNT) 
-------
110
140
141

142

143
 90
SUBROUTINE PRT (NN»Il»ISTR»ZP»UX,ISTEP)
DIMENSION ZP<1)»UX(30»20)   »ISTEP<1)
IT « 11+1
IB  « 1
IE  =  ISTR
IF (ISTR4GT.12) I£«12
PRINT 129. 
                   GO TO 99
      131*
      90
      132,
      90
      133,
CONTINUE
IF(IE.GE.ISTR)
IB • IE + 1
IE « ISTR
PRINT 128, USTEPCI),!'
GO TO 110
  rURN
        •1PAGE 2',4X,13I9)
        7H METERS,4X1319)
        lHOtF7,2.3X,l3(lXF8.0)
        1HO,F7.2,3X»13(1XF8«1)
        1HO»F7.2»3X»13(1XF8.2)
        1HO»F7.2,3X,13(1XF8.3)
                           IB,IE1
001
002
003
004
005

007
008
009
010
Oil
012
013
014
015
016
017
018
                                                                       019

                                                                       023
99
128
129
130
131
132
133
RETURN
FORMAT
FORMAT
FORMAT
FORMAT
FORMAT
FORMAT
RETURN
END
                                                                           025
                                                                           026
                                                                           027
                                                                           028
                                                                           029
                                                                           030
                                                                           031
                                                                         TR032
                                        141

-------
 BIBLIOGRAPHIC DATA
 SHEET
1. Report No.
     EPA-R4-73-025b
                                                                        3. Recipient's Accession No.
4. Title and Subtitle Tests of an Urban Meteorological-Pollutant Model
 Using CO Validation Data  in the Los Angeles  Metropolitan Area
 Volume II, FORTRAN Program and Input/Output  Specification
                                                  5' Report Date
                                                       May 1973
                                                  6.
7. Author(s)
                  Joseph A.  Sekorski
                                                  8. Performing Organization Rept.
                                                    No.   49Q-B
9. Performing Organization Name and Address
         The Center for the  Environment and Man,  Inc.
         275 Windsor Street
         Hartford,  Connecticut   06120
                                                  10. Project/Task/Work Unit No.
                                                          4121
                                                  11. Contract/Grant No.
                                                     68-02-0223
12. Sponsoring Organization Name and Address

         Meteorology Laboratory
         National  Environmental Research Center
         Research  Triangle Park, North Carolina
                                                  13. Type of Report & Period
                                                     Covered
                                                  Final
 9/71 -  2/73
                                 27711
                                                  14.
 15. Supplementary Notes   Supplement.:  Vol.  I, Tests  of an Urban Meteorological-Pollutant
 Model  Using CO Validation  Data in  the Los Angeles Metropolitan Area"
                                         by J. Pandolfo and  C. Jacobs
16. Abstracts

    Input deck make-up and  FORTRAN  IV listings  are presented for  the numerical model
    described in  Volume I.
 17. Key Voids and Document Analysis. 17o. Descriptors
         Numerical  Models
         Air Pollution Meteorology
 17b. Identifiers/Open-Ended Terms

         Urban Boundary Layer Meteorology
17c. COSATI Field/Group    04/02
 18. Availability Statement
                                      19.. Security Class (This
                                        Report)
                                           UNCLASSIFIED
                                                           20. Security Class (This
                                                              Page
                                                                 UNCLASSIFIED
21- No. of Pages
   145   .
                                                            22. Price
FORM NTIS-31 (REV. 3-72)
                                                                                  USCOMM-DC
                                             143

-------