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/» MIDNIGHT OCCURS AT TIME STEP»»I5»' NEW DECLINATION IS'
1.E12.4)
2 IF(T5)5t5»l9
5 CRS " 0.
TE « 0.
RH » 0.
TOUPRA « 0.
DO 6l=liNPl
6 DTDTII) » 0.
GO TO 99
19 Ml « NP1 - IX
CALL SOLAR2 (Nl »PAl IY) ».DUW.PASAtPAAB»EC»TCL »LLCtCOSZ»DTDT( IY » •
1 CRS»TE»TOUPRA»NATAL)
86
1414
GO TO C86»86»86»1414). IGOGO
SINZ = SQRT(1«-COSZ*COSZ)
SRS = -«0139 + «0467 * (SINZ/COSZ)
SRS = AMINlll.»SRS)
SRS " AMAXK .03.SRS)
CONTINUE
RAKIX) " CRS * (l.-SRS)
TOUPRA B TOUPRA +• CRS*SRS
RH = RAIUX)
IF(IGONY.GT.O) GO TO 99
6843 SECZ • l./COSZ
IFISECZ.GT.10.) SECZ = 10.
IFIRAKIXJ.LE.1.0E-30) RAKIX) «
DO 25 M=2»IX
I = IX-M+2
T2 « ZA(I-1)/100«
CALL KAPPA 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 (20)(n.d.).
Number of cards for height
cross sections (<_ 10) (n.d. ) . .
Number of cards for time cross
sections (<_ 10) (n.d. ) . If
"-1", print out entire simula-
tion run and no cards are
needed.
"0" last data set. "1" more
data sets.
Tape unit for analysis tape.
Tape unit from prediction run.
If "O1
used.
only analysis tape is
Temperature units indicator.
"0" Centigrade, "1" Fahrenheit,
"2" Absolute.
Include only sets that are desired. The number of cards in each set below
is shown on Card type 0.
A 1415 4-5
IXTRA
Total number of print time
steps.
9-10 MARAY(I) A(l) is punched for each
• printed time step (1=1,IXTRA).
69-70
Analysis Set 1 will produce: Time series, plots.
1 1415 4-5 IVAR Variable indicator from Table 1.
9-10 IZPL0T Height level to be plotted
(1 < IZPL0T < NX+1)*.
* NX is defined in Section 1.2.
122
-------
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
-------