root/GCM/modelII/trunk/DB11pdC9.f

Revision 855, 234.5 kB (checked in by mankoff, 5 months ago)

fixed formatting typo

Line 
1c  *********************************************************************
2c  *********************************************************************
3c  **
4c  ** Model IImac
5c  ** Based on GCMII code for IBM RS/6000 computers created at GISS
6c  ** Modified to compile under Absoft Pro Fortran 6.2 for MacOS.
7c  ** Based on MP008macC9, BA94C9 and MA94DC9
8c  **
9c  ** CHANGE HISTORY:
10c  **
11c  ** 07/27/99 First Successful Compile! (DCH)
12c  ** 08/06/99 Changed to single precision (MFS)
13c  ** 12/21/00 converted for new model (MFS)
14c  ** 10/01/02 added 9/X switch for sea level pressure collection (MFS)
15c  ** 12/02 Correct calculation of latitudes for this resolution
16c  ** 04/12/04 Added code for writing post-processing files. (JAL)
17c  **    Removed dummy DIAG8; minor corrections; geometry flexibility
18c  ** 04/19/04 fix to allow F90 compiling, same as PD code (JAL)
19c  ** 06/22/04 fix overflow lines (MFS)
20c  ** 01/27/05 changed CLOCKS to MCLOCK, a to a16 (GLR)
21c  ** 01/17/06 reverted to CLOCKS to fix Windows version (MFS)
22c  **
23c  ** NOTES:
24c  **
25c  *********************************************************************
26c  *********************************************************************
27
28
29c  ** DB11C9  BA94C9 DA94C9                  12/20/89
30c  ** OPT(3)
31c  **
32c  ** MODEL II FINE GRID DIAGNOSTICS WITH HALF-BOX SHIFT IN LONGITUDE
33c  ** subroutines in DB11F9: IJMAP
34c  ** DA94C9  BA94C9 DA94M9                  12/20/89
35c  ** OPT(3)
36c  **
37c  ** MODEL II FINE GRID DIAGNOSTICS
38c  ** subroutines in DA94F9: all diagnostics routines
39c  ** Model II diagnostics in double precision for work station  7/19/91
40      SUBROUTINE DIAGA (U,V,T,P,Q)
41c  **                                                             IDACC
42c  ** CONTENTS OF AJ(J,N)  (SUM OVER LONGITUDE AND TIME OF)
43c  **   1  SRINCP0 (W/M**2)                                        2 RD
44c  **   2  SRNFP0 (W/M**2)                                         2 RD
45c  **   3  SRNFP1 (W/M**2)                                         2 RD
46c  **   4  SRABSATM=AJ(2)-AJ(6) (W/M**2)                           2 D1
47c  **   5  SRINCG (W/M**2)                                         2 RD
48c  **   6  SRNFG (W/M**2)                                          2 RD
49c  **   7  TRNFP0=AJ(74)+A2BYA1*AJ(9)/DTSRCE (W/M**2)              2 D1
50c  **   8  TRNFP1=AJ(75)+A2BYA1*AJ(9)/DTSRCE (W/M**2)              2 D1
51c  **   9  TRHDT (J/M**2)                                          1 SF
52c  **  10  RNFP0=AJ(2)+AJ(7) (W/M**2)                              2 D1
53c  **  11  RNFP1=AJ(3)+AJ(8) (W/M**2)                              2 D1
54c  **  12  RHDT=A1BYA2*AJ(6)*DTSRCE+AJ(9) (J/M**2)                 1 D1
55c  **  13  SHEATDT (J/M**2)                                        1 SF
56c  **  14  EVHDT (J/M**2)                                          1 SF
57c  **  15  F2DT (J/M**2)                                           1 GD
58c  **  16  HEATZ1=AJ(41)+AJ(42)                                    1 D1
59c  **  17  TG2 (K-273.16)                                          1 GD
60c  **  18  TG1 (K-273.16)                                          1 GD
61c  **  19  EVAP (KG/M**2)                                          1 GD
62c  **  20  PRCP=AJ(61)+AJ(62) (100 PA)                             1 D1
63c  **  21  TX (K-273.16)  (INTEGRAL OVER ATMOSPHERE OF)            4 DA
64c  **  22  TX1 (K-273.16)                                          4 DA
65c  **  23  TS (K-273.16)                                           3 SF
66c  **  24  DTH/DPHI  (STRATOSPHERE)                                4 DA
67c  **  25  DTH/DPHI  (TROPOSPHERE)                                 4 DA
68c  **  26  .0625*DTH*DLNP/(DU*DU+DV*DV)  (STRATOSPHERE)            4 DA
69c  **  27  .0625*DTH*DLNP/(DU*DU+DV*DV)  (TROPOSPHERE)             4 DA
70c  **  28  4*UMAX/(DX*SINJ)  (STRATOSPHERE)                        4 DA
71c  **  29  4*UMAX/(DX*SINJ)  (TROPOSPHERE)                         4 DA
72c  **  30  POICE (1)                                               1 GD
73c  **  31  PSNOW (1)                                               4 DA
74c  **  32  SW CORRECTION                                           2 RD
75c  **  33  OCEAN TRANSPORT                                         1 GD
76c  **  34  OCEAN TEMPERATURE AT MAX. MIXED LAYER DEPTH             1 GD
77c  **  35  T(J+1)-T(J-1)  (SUM OVER STRATOSPHERE OF)               4 DA
78c  **  36  T(J+1)-T(J-1)  (SUM OVER TROPOSPHERE OF)                4 DA
79c  **  37  SQRT(DTH/DLNP)/SINJ  (STRATOSPHERE)                     4 DA
80c  **  38  SQRT(DTH/DLNP)/SINJ  (TROPOSPHERE)                      4 DA
81c  **  39  ENERGP (J/M**2)                                         1 PR
82c  **  40  ERUN1 (J/M**2)                                          1 GP
83c  **  41  EDIFS (J/M**2)                                          1 GP
84c  **  42  F1DT (J/M**2)                                           1 GD
85c  **  43  ERUN2 (J/M**2)                                          1 GP
86c  **  44  HEATZ0=AJ(12)+AJ(13)+AJ(14)+AJ(39)-AJ(40) (J/M**2)      1 D1
87c  **  45  DIFS (KG/M**2)                                          1 GP
88c  **  46  AIFO ; BRUN2 ; CRUN2+CIFI                               1 GP
89c  **  47  RUN2 (KG/M**2)                                          1 GP
90c  **  48  DWTR2=AJ(45)-AJ(47) (KG/M**2)                           1 D1
91c  **  49  WTR1 (KG/M**2)                                          1 GD
92c  **  50  ACE1 (KG/M**2)                                          1 GD
93c  **  51  WTR2 (KG/M**2)                                          1 GD
94c  **  52  ACE2 (KG/M**2)                                          1 GD
95c  **  53  SNOW (KG/M**2)                                          1 GD
96c  **  54  RUN1 (KG/M**2)                                          1 GP
97c  **  55  BTEMPW-TF                                               2 RD
98c  **  56  HEATZ2=AJ(15)+AJ(43) (J/M**2)                           1 D1
99c  **  57  PCLDSS (1)  (COMPOSITE OVER ATMOSPHERE)                 2 RD
100c  **  58  PCLDMC (1)  (COMPOSITE OVER ATMOSPHERE)                 2 RD
101c  **  59  PCLD (1)  (COMPOSITE OVER ATMOSPHERE)                   2 RD
102c  **  60  CLDTOPMC=AJ(80)/AJ(58) (100 PA)                         0 D1
103c  **  61  PRCPSS (100 PA)                                         1 CN
104c  **  62  PRCPMC (100 PA)                                         1 CN
105c  **  63  Q*P (100 PA)  (INTEGRAL OVER ATMOSPHERE OF)             4 DA
106c  **  64  GAM  (K/M)  (*SIG(TROPOSPHERE)/GRAV)                    4 DA
107c  **  65  GAMM  (K-S**2/M**2)  (SIG(TROPOSPHERE)/GAMD)            4 DA
108c  **  66  GAMC  (K/M)                                             4 DA
109c  **  67  TRINCG (W/M**2)                                         2 RD
110c  **  68  ENERGY DIFFUSION INTO THERMOCLINE (W/M**2)           .5*9 MN
111c  **  69  FREE
112c  **  70  TRNFP0-TRNFG (W/M**2)                                   2 RD
113c  **  71  TRNFP1-TRNFG (W/M**2)                                   2 RD
114c  **  72  PLAVIS*S0*COSZ (W/M**2)                                 2 RD
115c  **  73  PLANIR*S0*COSZ (W/M**2)                                 2 RD
116c  **  74  ALBVIS*S0*COSZ (W/M**2)                                 2 RD
117c  **  75  ALBNIR*S0*COSZ (W/M**2)                                 2 RD
118c  **  76  SRRVIS*S0*COSZ (W/M**2)                                 2 RD
119c  **  77  SRRNIR*S0*COSZ (W/M**2)                                 2 RD
120c  **  78  SRAVIS*S0*COSZ (W/M**2)                                 2 RD
121c  **  79  SRANIR*S0*COSZ (W/M**2)                                 2 RD
122c  **  80  PBOTMC-PTOPMC (100 PA)                                  2 RD
123c  **
124c  ** CONTENTS OF APJ(J,N)  (SUM OVER LONGITUDE AND TIME OF)
125c  **   1  P (100 PA)                                              4 DA
126c  **   2  4*P4I (100 PA)  (UV GRID)                               4 DA
127c  **
128c  ** CONTENTS OF AJL(J,L,N)  (SUM OVER LONGITUDE AND TIME OF)
129c  **   1  FREE                                                    4 DA
130c  **   2  FREE                                                    4 DA
131c  **   3  FREE                                                    4 DA
132c  **   4  FREE                                                    4 DA
133c  **   5  FREE                                                    4 DA
134c  **   6  FREE                                                    4 DA
135c  **   7  FREE                                                    4 DA
136c  **   8  FMX(MC)*P (100 PA)                                      1 CN
137c  **   9  SRHR (W/M**2)                                           2 RD
138c  **  10  TRHR (W/M**2)                                           2 RD
139c  **  11  DTX(SS)*P (100 K*PA)                                    1 CN
140c  **  12  DT(DC)*P                                                1 CN
141c  **  13  DT(MC)*P (100 PA*K)  DRY HEATING                        1 CN
142c  **  14  FREE                                                    4 DA
143c  **  15  FREE                                                    4 DA
144c  **  16  (TH*SQRT(P)-THGM)**2/GMEAN(PR**(1-KAPA)*DTH/DPR)        4 DA
145c  **  17  FREE                                                    4 DA
146c  **  18  FREE                                                    4 DA
147c  **  19  PCLD*P (TOTAL)                                          1 CN
148c  **  20  FREE                                                    4 DA
149c  **  21  FREE                                                    4 DA
150c  **  22  FREE                                                    4 DA
151c  **  23  FREE                                                    4 DA
152c  **  24  FREE                                                    4 DA
153c  **  25  FREE                                                    4 DA
154c  **  26  FREE                                                    4 DA
155c  **  27  FREE                                                    4 DA
156c  **  28  PCLD*P (SS)                                             1 CN
157c  **  29  PCLD*P (MC)                                             1 CN
158c  **  30  FREE                                                    4 DA
159c  **  31  FREE                                                    4 DA
160c  **  32  FREE                                                    4 DA
161c  **  33  FREE                                                    4 DA
162c  **  34  FREE                                                    4 DA
163c  **  35  FREE                                                    4 DA
164c  **  36  FREE                                                    4 DA
165c  **  37  FREE                                                    4 DA
166c  **  38  DU(DC)*P  (UV GRID)                                       GD
167c  **  39  DU(MC)*P (100 N/M/S)  (UV GRID)                         1 CN
168c  **  40  DU(ED)*P*(DTSURF*DSIG*ED/DZ**2)  (UV GRID)                SF
169c  **  41  U  (SUM OVER I FROM 5 TO 9)  (PV GRID) (COMMENTED OUT)  4 DA
170c  **  41  P*V*((TH-THMEAN) * (DU/DP) / (DTH/DP) - U+UMEAN )       4 DA
171c  **  42  V  (SUM OVER I FROM 5 TO 9)  (PV GRID)                  4 DA
172c  **  43  SD  (SUM OVER I FROM 5 TO 9)                            4 DA
173c  **  44  U  (SUM OVER I FROM 35 TO 3)  (PV GRID) (COMMENTED OUT) 4 DA
174c  **  44  (2F-2D(UDX))*16PV(TH-THMEAN)/(DTH/DSIG)+(SD-SDMEAN)*8U  4 DA
175c  **  45  V  (SUM OVER I FROM 35 TO 3)  (PV GRID)                 4 DA
176c  **  46  SD  (SUM OVER I FROM 35 TO 3)                           4 DA
177c  **  47  V-V*  =D((V-VI)*(T-TI)/DTHDP)/DP                        4 DA
178c  **  48  4*PU4I*PV4I/P4I (100 N/S**2)  (UV GRID)                 4 DA
179c  **  49  4*PUV4I (100 N/S**2)  (UV GRID)                         4 DA
180c  **  50  DT(MC)*P (100 PA*K)  CHANGE OF PHASE                    1 CN
181c  **  51  CLHE*DQ(MC BEFORE COND)*P (100 PA*K)                    1 CN
182c  **  52  FREE                                                    4 DA
183c  **  53  FREE                                                    4 DA
184c  **  54  SIGMA  (VARIANCE FOR MOIST CONVECTION)                  1 CN
185c  **
186c  ** CONTENTS OF ASJL(J,L,N)  (SUM OVER LONGITUDE AND TIME OF)
187c  **   1  TX (C)                                                  4 DA
188c  **   2  PHI (M**2/S**2)                                         4 DA
189c  **   3  SRHR (W/M**2)                                           2 RD
190c  **   4  TRHR (W/M**2)                                           2 RD
191c  **
192c  ** CONTENTS OF AIJ(I,J,N)  (SUM OVER TIME OF)
193c  **   1  POICE (1)                                               1 GD
194c  **   2  PSNOW (1)                                               4 DA
195c  **   3  SNOW (KG/M**2)                                          4 DA
196c  **   4  SHDT (J/M**2)                                           1 SF
197c  **   5  PREC (KG/M**2)                                          1 PR
198c  **   6  EVAP (KG/M**2)                                          1 SF
199c  **   7  BETA (1)                                                1 GD
200c  **   8  SLP (100 PA-1000) (USING T1) (COMMENTED OUT)            4 DA
201c  **   8  4*P4 (100 PA)  (UV GRID)                 (NO PRINTOUT)  4 DA
202c  **   9  PHI1000 (M**2/S**2)                                     4 DA
203c  **  10  PHI850 (M**2/S**2-1500*GRAV)                            4 DA
204c  **  11  PHI700-3000*GRAV                                        4 DA
205c  **  12  PHI500-5600*GRAV                                        4 DA
206c  **  13  PHI300-9500*GRAV                                        4 DA
207c  **  14  PHI100-16400*GRAV                                       4 DA
208c  **  15  PHI30-24000*GRAV                                        4 DA
209c  **  16  T850-273.16 (K-273.16)*GRAV)             (NO PRINTOUT)  4 DA
210c  **  17  PCLDMC (1)  (COMPOSITE OVER ATMOSPHERE)                 2 RD
211c  **  18  PBOTMC-PTOPMC (100 PA)                                  2 RD
212c  **  19  PCLD (1)  (COMPOSITE OVER ATMOSPHERE)                   2 RD
213c  **  20  16*P4*(SHA*T4+Z4)*V1*DSIG*DXV (100 W*M/S**2)  (UV GRID) 4 DA
214c  **  21  TRNFP0 (W/M**2)                                         2 RS
215c  **  22  SRHDT+TRHDT (J/M**2)                                    1 SF
216c  **  23  SRHDT+TRHDT+SHDT+EVHDT+ENRGP (J/M**2)                   1 SP
217c  **  24  SRNFP0 (W/M**2)                                         2 RD
218c  **  25  SRINCP0 (W/M**2)                                        2 RD
219c  **  26  SRNFG (W/M**2)                                          2 RD
220c  **  27  SRINCG (W/M**2)                                         2 RD
221c  **  28  TG1 (K-273.16)                                          1 GD
222c  **  29  POICE+PLICE+(IF SNOW)PEARTH                             4 DA
223c  **  30  DIURNAL DELTA TS (K)                 (NO PRINTOUT)   .5*9 MN
224c  **  31  DTH/DPHI  (TROPOSPHERE)                                 4 DA
225c  **  32  RUN1 OVER EARTH  (KG/M**2)                              1 PG
226c  **  33  TS (K-273.16)  (USING LAPSE RATE FROM TX1)  (COMM'D OUT)4 DA
227c  **  33  RUN1 OVER LAND ICE  (KG/M**2)            (NO PRINTOUT)  1 PG
228c  **  34  ALPHA PRIME (1)                                         3 SF
229c  **  35  TS (K-273.16)                                           3 SF
230c  **  36  US (M/S)                                                3 SF
231c  **  37  VS (M/S)                                                3 SF
232c  **  38  PSL (100 PA-1000)  (USING TS)                           4 DA
233c  **  39  UJET (M/S)                                              4 DA
234c  **  40  VJET (M/S)                                              4 DA
235c  **  41  PCLD(LOW) (1)                                           2 RD
236c  **  42  PCLD(MID) (1)                                           2 RD
237c  **  43  PCLD(HIGH) (1)                                          2 RD
238c  **  44  BTEMPW-TF (K-273.16)                                    2 RD
239c  **  45  PLAVIS*S0*COSZ (W/M**2)                                 2 RD
240c  **  46  ALPHA0 (1)                                              3 SF
241c  **  47  TAUS                                     (NO PRINTOUT)  3 SF
242c  **  48  TAUUS                                    (NO PRINTOUT)  3 SF
243c  **  49  TAUVS                                    (NO PRINTOUT)  3 SF
244c  **  50  WATER1+WATER2+ICE1+ICE2  (FOR EARTH POINTS ONLY)        1 GD
245c  **  51  QS                                       (NO PRINTOUT)  3 SF
246c  **  52  MAX(0,33-1.8*DAILY MEAN ON TS IN C)                  .5*9 MN
247c  **  53  40.6+.72*(2TS(C)-(QSATS-QS)*LHA/SHA)                    3 SF
248c  **  54  18*(DEL(TG)/DEL(TS)-1), DEL=DIURNAL MAX-MIN          .5*9 MN
249c  **
250c  **     THE REMAINING ARRAYS ARE NOT USED IN THE STANDARD PRINTOUT
251c  **
252c  **  55  8*P*U*Q (VERTICALLY INTEGRATED)  (12.5 PA*M/S)          4 DA
253c  **  56  8*P*V*Q (VERTICALLY INTEGRATED)  (12.5 PA*M/S)          4 DA
254c  **  57  TGO=ODATA(1)  (C)                                       1 GD
255c  **  58  ACE2OI=ODATA(3)*POICE  (KG/M**2)                        1 GD
256c  **  59  TGO2=ODATA(4)  (C)                                   .5*9 MN
257c  **  60  TGO12=ODATA(5)  (C)                                  .5*9 MN
258c  **  61  EVAP*POCEAN  (KG/M**2)                                  1 GD
259c  **  62  EVAP*POICE  (KG/M**2)                                   1 GD
260c  **  63  EVAP OVER LAND ICE  (KG/M**2)                           1 GD
261c  **  64  EVAP OVER EARTH  (KG/M**2)                              1 GD
262c  **  65  F0DT*POCEAN, NET HEAT AT Z0  (J/M**2)                   1 GD
263c  **  66  F0DT*POICE, NET HEAT AT Z0  (J/M**2)                    1 GD
264c  **  67  F0DT, NET HEAT AT Z0 OVER LAND ICE  (J/M**2)            1 GD
265c  **  68  F0DT, NET HEAT AT Z0 OVER EARTH  (J/M**2)               1 GD
266c  **  69  F1DT OVER LAND ICE  (J/M**2)                            1 PG
267c  **  70  SNOW FALL  (KG/M**2)                                    1 PR
268c  **  71  SURF AIR TEMP OVER LAND ICE  (C)                  NSURF*1 SF
269c  **  72  F2DT OVER LAND ICE  (J/M**2)                            1 PG
270c  **  73  SHDT OVER LAND ICE  (J/M**2)                            3 SF
271c  **  74  EVHDT OVER LAND ICE  (J/M**2)                           3 SF
272c  **  75  TRHDT OVER LAND ICE  (J/M**2)                           3 SF
273c  **  76  MAX(COMPOSITE TS)                                      12  SF
274c  **  77  MIN(COMPOSITE TS)                                      12  SF
275c  **  78  MIN(DIURNAL MAX OF COMPOSITE TS)                       12  MN
276c  **  79  PEVAPS                                                  1  SF
277c  **  80  FREE
278c  **
279c  ** CONTENTS OF AIL(I,L,N)  (SUM OVER TIME OF)
280c  ** WE ARE NOT TAKING INTO ACCOUNT THE VARIATION OF MASS
281c  **   1  U (M/S) (SUM FOR J=JEQ+1,JEQ,JEQ-1,JEQ-2)  (PU GRID)    4 DA
282c  **   2  V (M/S) (SUM FOR J=JEQ+1,JEQ,JEQ-1,JEQ-2)  (PU GRID)    4 DA
283c  **   3  SD (100 N/S) (SUM FOR J=JEQ,JEQ-1,JEQ-2)                4 DA
284c  **   4  TX (K-273.16) (SUM FOR J=JEQ,JEQ-1,JEQ-2)               4 DA
285c  **   5  RH (1) (SUM FOR J=JEQ,JEQ-1,JEQ-2)                      4 DA
286c  **   6  DTX(MC)*P*DA (100 K*N) (SUM FOR J=JEQ,JEQ-1,JEQ-2)      1 CN
287c  **   7  (SRHR+TRHR)*DA (W) (SUM FOR J=JEQ,JEQ-1,JEQ-2)          2 RD
288c  **   9  SD (100 N/S) (AT LAT 50 N) (COMMENTED OUT)              4 DA
289c  **  10  TX-273.16  (AT LAT 50 N)                                4 DA
290c  **  11  SR+TR  (AT LAT 50 N)                                    2 RD
291c  **  12  2*U  (AT LAT 50 N)                                      4 DA
292c  **  13  SD  (AT LAT 70 N)         (COMMENTED OUT)               4 DA
293c  **  14  TX-273.16  (AT LAT 70 N)  (COMMENTED OUT)               4 DA
294c  **  15  SR+TR  (AT LAT 70 N)                                    2 RD
295c  **  16  2*U  (AT LAT 70 N)        (COMMENTED OUT)               4 DA
296c  **
297c  ** CONTENTS OF AIJL(I,J,L,N)  (SUM OVER TIME OF)
298c  **   1  4*P4*U1 (100 PA*M/S)  (UV GRID)  (COMMENTED OUT)        4 DA
299c  **   1  FREQUENCY OF BEING TOP CLOUD LEVEL                      2 RD
300c  **   2  4*P4*V1 (100 PA*M/S)  (UV GRID)  (COMMENTED OUT)        4 DA
301c  **   2  TOP CLOUD TEMPERATURE (OR 0 IF NOT TOP CLOUD LEVEL)     2 RD
302c  **   3  16*P4*(SHA*T4+Z4) (100 N/S**2)  (UV GRID) (COMM'D OUT)  4 DA
303c  **   3  SWINC ON TOP CLOUD (OR 0 IF NOT TOP CLOUD LEVEL)        2 RD
304c  **
305c  ** CONTENTS OF IDACC(N), NUMBER OF ACCUMULATION TIMES OF
306c  **   1  SOURCE TERMS  (DETERMINED BY NDYN)
307c  **   2  RADIATION SOURCE TERMS  (DETERMINED BY NRAD)
308c  **   3  SURFACE INTERACTION SOURCE TERMS  (DETERMINED BY NDASF)
309c  **   4  QUANTITIES IN DIAGA  (DETERMINED BY NDAA)
310c  **   5  ENERGY NUMBERS IN DIAG4  (DEYERMINED BY NDA4)
311c  **   6  KINETIC ENERGY IN DIAG5 FROM DYNAMICS  (DETERMINED BY NDA5K)
312c  **   7  ENERGY IN DIAG5 FROM DYNAMICS  (DETERMINED BY NDA5D)
313c  **   8  ENERGY IN DIAG5 FROM SOURCES  (DETERMINED BY NDA5S)
314c  **   9  WAVE ENERGY IN DIAG7  (EVERY 12 HOURS)
315c  **  10  ENERGY IN DIAG5 FROM FILTER  (DETERMINED BY NFILTR)
316c  **  11  USED FOR T-DIAGNOSTICS CHECKT:  0=OFF,1=ON
317c  **  12  ALWAYS =1 (UNLESS SEVERAL RESTART FILES WERE ACCUMULATED)
318c  **
319c  ** CONTENTS OF AUXILIARY ARRAYS (TSFREZ(I,J,1-2),TDIURN(I,J,N))
320c  **   1  FIRST DAY OF GROWING SEASON (JULIAN DAY)
321c  **   2  LAST DAY OF GROWING SEASON (JULIAN DAY)
322c  **
323c  **   1  MIN TG1 OVER EARTH FOR CURRENT DAY (C)
324c  **   2  MAX TG1 OVER EARTH FOR CURRENT DAY (C)
325c  **   3  MIN TS OVER EARTH FOR CURRENT DAY (K)
326c  **   4  MAX TS OVER EARTH FOR CURRENT DAY (K)
327c  **   5  SUM OF COMPOSITE TS OVER TIME FOR CURRENT DAY (C)
328c  **   6  MAX COMPOSITE TS FOR CURRENT DAY (K)
329c  **
330      INCLUDE 'BA94jalC9.COM'
331      LOGICAL POLE
332      COMMON/WORK1/PIT(IM,JM),SD(IM,JM,LM-1)
333      COMMON/WORK2/PK(IM,JM,LM),W(IM,JM,LM),PHIE(IM,JM,LM-1),
334     *  GMEAN(LM),THJL(JM,LM),THSQJL(JM,LM),SDMEAN(JM,LM-1),
335     *  DUDVSQ(JM),EL(JM),RI(JM),SPI(JM,LM),PHIPI(JM,LM),
336     *  TPI(JM,LM),TIL(JM),UI(JM),UMAX(JM),
337     *  SOCEAN(JM),SLAND(JM),SOICE(JM),PUV(IM,JM),PI(JM),
338     *  SQRTP(IM),PDA(IM),TRI(3)
339      COMMON/WORK3/PHI(IM,JM,LM),TX(IM,JM,LM),
340     *  THSEC(IM),PSEC(IM),SHETH(LM)
341      DIMENSION LUPA(LM),LDNA(LM),D2SIG(LM)
342      COMMON/WORK5/DUT(IM,JM,LM),DVT(IM,JM,LM),
343     *  X1(IM),FCUV(2,IMH+1,JM,LM,2),
344     *  FC(2,IMH+1)
345      CHARACTER*16 TITLE
346      DIMENSION PMB(7),GHT(7)
347      DATA PMB/1000.,850.,700.,500.,300.,100.,30./,P1000/1000./
348      DATA GHT/0.,1500.,3000.,5600.,9500.,16400.,24000./
349      DATA IFIRST/1/,ONE/1./,ZERO20/1.E-20/
350c  ** QSAT=(RAIR/RVAPOR)*6.1071*EXP((L/RVAPOR)*(1/TF-1/T))/P
351      DATA AQSAT/3.797915/,BQSAT/7.93252E-6/,CQSAT/2.166847E-3/
352      QSAT(TM,PR,QL)=AQSAT*EXP(QL*(BQSAT-CQSAT/TM))/PR
353      CALL CLOCKS (MBEGIN)
354      IDACC(4)=IDACC(4)+1
355      IF (IFIRST.NE.1) GO TO 50
356      IFIRST=0
357c  ** INITIALIZE CERTAIN QUANTITIES
358      L=LM+1
359    3 L=L-1
360      IF (L.EQ.1) GO TO 4
361      IF (.25*(SIGE(L-1)+2*SIGE(L)+SIGE(L+1))*(PSF-PTOP)+PTOP.LT.250.)
362     *   GO TO 3
363    4 JET=L
364      WRITE (6,888) JET
365  888 FORMAT (' JET WIND LEVEL FOR DIAG',I3)
366      BYIM=1./FIM
367      SHA=RGAS/KAPA
368      BETA=.0065
369      BBYG=BETA/GRAV
370      RBBYG=RGAS*BETA/GRAV
371      GBYRB=GRAV/(RGAS*BETA)
372      EPSLON=1.
373      PTOPK=EXPBYK(PTOP)
374      KM=0
375      DO 5 K=1,7
376      IF (PTOP.GT.PMB(K)) GO TO 6
377    5 KM=KM+1
378    6 JEQ=2.+.5*(JM-1)
379      J50N=(50.+90.)*(JM-1)/180.+1.5
380      J70N=(70.+90.)*(JM-1)/180.+1.5
381      PRQ1=.75*PTOP
382      DLNP12=LOG(.75/.35)
383      DLNP23=LOG(.35/.1)
384      DO 10 L=1,LM
385      LUPA(L)=L+1
386   10 LDNA(L)=L-1
387      LDNA(1)=1
388      LUPA(LM)=LM
389      DO 20 L=1,LM
390   20 D2SIG(L)=SIG(LUPA(L))-SIG(LDNA(L))
391   50 CONTINUE
392c  **
393c  ** FILL IN HUMIDITY AND SIGMA DOT ARRAYS AT THE POLES
394c  **
395      DO 65 L=1,LM
396      DO 65 I=2,IM
397      Q(I,1,L)=Q(1,1,L)
398   65 Q(I,JM,L)=Q(1,JM,L)
399c  **
400c  ** CALCULATE PK AND TX, THE REAL TEMPERATURE
401c  **
402      DO 80 L=1,LM
403      PK(1,1,L)=EXPBYK(SIG(L)*P(1,1)+PTOP)
404      TX(1,1,L)=T(1,1,L)*PK(1,1,L)
405      PK(1,JM,L)=EXPBYK(SIG(L)*P(1,JM)+PTOP)
406      TX(1,JM,L)=T(1,JM,L)*PK(1,JM,L)
407      DO 70 I=2,IM
408      T(I,1,L)=T(1,1,L)
409      T(I,JM,L)=T(1,JM,L)
410      PK(I,1,L)=PK(1,1,L)
411      TX(I,1,L)=TX(1,1,L)
412      PK(I,JM,L)=PK(1,JM,L)
413   70 TX(I,JM,L)=TX(1,JM,L)
414      DO 80 J=2,JM-1
415      DO 80 I=1,IM
416      PK(I,J,L)=EXPBYK(SIG(L)*P(I,J)+PTOP)
417   80 TX(I,J,L)=T(I,J,L)*PK(I,J,L)
418c  **
419c  ** CALCULATE PUV, THE MASS WEIGHTED PRESSURE
420c  **
421      DO 90 J=2,JM
422      I=IM
423      DO 85 IP1=1,IM
424      PUV(I,J)=RAVPN(J-1)*(P(I,J-1)+P(IP1,J-1))+
425     *         RAVPS(  J)*(P(I,  J)+P(IP1,  J))
426   85 I=IP1
427   90 CONTINUE
428c  **
429c  ** J LOOPS FOR ALL PRIMARY GRID ROWS
430c  **
431      DO 190 J=1,JM
432      POLE=.FALSE.
433      IF (J.EQ.1.OR.J.EQ.JM) POLE=.TRUE.
434      IMAX=IM
435      IF (POLE) IMAX=1
436      DXYPJ=DXYP(J)
437c  ** NUMBERS ACCUMULATED FOR A SINGLE LEVEL
438      AT1=0.
439      BT1=0.
440      CT1=0.
441      BSCOV=0.
442      CSCOV=0.
443      PI(J)=0.
444      SLAND(J)=0.
445      SOICE(J)=0.
446      SOCEAN(J)=0.
447      DO 120 I=1,IMAX
448      JR=JREG(I,J)
449      PLAND=FDATA(I,J,2)
450      POICE=ODATA(I,J,2)*(1.-PLAND)
451      PLICE=FDATA(I,J,3)*PLAND
452      POCEAN=(1.-PLAND)-POICE
453      PEARTH=PLAND-PLICE
454      SLAND(J)=SLAND(J)+PLAND
455      SOICE(J)=SOICE(J)+POICE
456      SOCEAN(J)=SOCEAN(J)+POCEAN
457      AT1=AT1+(TX(I,J,1)-273.16)*POCEAN
458      BT1=BT1+(TX(I,J,1)-273.16)*PLAND
459      CT1=CT1+(TX(I,J,1)-273.16)*POICE
460      DJ(JR,22)=DJ(JR,22)+(TX(I,J,1)-273.16)*DXYPJ
461      SCOVL=0.
462      IF (GDATA(I,J,2).GT.0.) SCOVL=PEARTH
463      IF (GDATA(I,J,12).GT.0.) SCOVL=SCOVL+PLICE
464      BSCOV=BSCOV+SCOVL
465      SCOVOI=0.
466      IF (GDATA(I,J,1).GT.0.) SCOVOI=POICE
467      CSCOV=CSCOV+SCOVOI
468      DJ(JR,31)=DJ(JR,31)+(SCOVL+SCOVOI)*DXYPJ
469      PI(J)=PI(J)+P(I,J)
470      AIJ(I,J,2)=AIJ(I,J,2)+(SCOVOI+SCOVL)
471      AIJ(I,J,3)=AIJ(I,J,3)+(GDATA(I,J,1)*POICE+GDATA(I,J,2)*PEARTH+
472     *  GDATA(I,J,12)*PLICE)
473c     TS=TX(I,J,1)*((P(I,J)+PTOP)/(SIG(1)*P(I,J)+PTOP))**RBBYG
474c     AIJ(I,J,8)=AIJ(I,J,8)+((P(I,J)+PTOP)*(1.+BBYG*FDATA(I,J,1)/TS)
475c    *  **GBYRB-P1000)
476      PSNOW=0.
477      IF (GDATA(I,J,2).GT.0.) PSNOW=PEARTH
478      AIJ(I,J,29)=AIJ(I,J,29)+POICE+PLICE+PSNOW
479c     AIJ(I,J,33)=AIJ(I,J,33)+(TS-273.16)
480      AIJ(I,J,38)=AIJ(I,J,38)+((P(I,J)+PTOP)*(1.+BBYG*FDATA(I,J,1)/
481     *  BLDATA(I,J,2))**GBYRB-P1000)
482  120 CONTINUE
483      AJ(J,22)=AJ(J,22)+AT1
484      BJ(J,22)=BJ(J,22)+BT1
485      CJ(J,22)=CJ(J,22)+CT1
486      BJ(J,31)=BJ(J,31)+BSCOV
487      CJ(J,31)=CJ(J,31)+CSCOV
488      APJ(J,1)=APJ(J,1)+PI(J)
489c  ** GEOPOTENTIALS CALCULATED FOR EACH LAYER
490      DO 160 I=1,IMAX
491      P1=SIG(1)*P(I,J)+PTOP
492      PUP=SIG(2)*P(I,J)+PTOP
493      IF (ABS(TX(I,J,2)-TX(I,J,1)).LT.EPSLON) GO TO 152
494      BBYGV=LOG(TX(I,J,1)/TX(I,J,2))/(RGAS*LOG(P1/PUP))
495      PHI(I,J,1)=FDATA(I,J,1)+TX(I,J,1)
496     *  *(((P(I,J)+PTOP)/P1)**(RGAS*BBYGV)-1.)/BBYGV
497      PHI(I,J,2)=PHI(I,J,1)+(TX(I,J,1)-TX(I,J,2))/BBYGV
498      GO TO 154
499  152 PHI(I,J,1)=FDATA(I,J,1)+RGAS*TX(I,J,1)*LOG((P(I,J)+PTOP)/P1)
500      PHI(I,J,2)=PHI(I,J,1)+RGAS*.5*(TX(I,J,1)+TX(I,J,2))*LOG(P1/PUP)
501  154 DO 160 L=3,LM
502      PDN=PUP
503      PUP=SIG(L)*P(I,J)+PTOP
504      IF (ABS(TX(I,J,L)-TX(I,J,L-1)).LT.EPSLON) GO TO 156
505      BBYGV=LOG(TX(I,J,L-1)/TX(I,J,L))/(RGAS*LOG(PDN/PUP))
506      PHI(I,J,L)=PHI(I,J,L-1)+(TX(I,J,L-1)-TX(I,J,L))/BBYGV
507      GO TO 160
508  156 PHI(I,J,L)=PHI(I,J,L-1)+RGAS*.5*(TX(I,J,L-1)+TX(I,J,L))
509     *  *LOG(PDN/PUP)
510  160 CONTINUE
511      IF (.NOT.POLE) GO TO 170
512      DO 162 L=1,LM
513      DO 162 I=2,IM
514  162 PHI(I,J,L)=PHI(1,J,L)
515c  ** CALCULATE GEOPOTENTIAL HEIGHTS AT SPECIFIC MILLIBAR LEVELS
516  170 DO 180 I=1,IMAX
517      K=1
518      L=1
519  172 L=L+1
520      PL=SIG(L)*P(I,J)+PTOP
521      IF (PMB(K).LT.PL.AND.L.LT.LM) GO TO 172
522      IF (ABS(TX(I,J,L)-TX(I,J,L-1)).LT.EPSLON) GO TO 176
523      BBYGV=(TX(I,J,L-1)-TX(I,J,L))/(PHI(I,J,L)-PHI(I,J,L-1))
524  174 AIJ(I,J,8+K)=AIJ(I,J,8+K)+(PHI(I,J,L)
525     *  -TX(I,J,L)*((PMB(K)/PL)**(RGAS*BBYGV)-1.)/BBYGV-GHT(K)*GRAV)
526      IF (K.EQ.2) AIJ(I,J,16)=AIJ(I,J,16)+(TX(I,J,L)-273.16+(TX(I,J,L-1)
527     *  -TX(I,J,L))*LOG(PMB(K)/PL)/LOG((SIG(L-1)*P(I,J)+PTOP)/PL))
528      IF (K.GE.KM) GO TO 180
529      K=K+1
530      IF (PMB(K).LT.PL.AND.L.LT.LM) GO TO 172
531      GO TO 174
532  176 AIJ(I,J,8+K)=AIJ(I,J,8+K)+(PHI(I,J,L)
533     *  -RGAS*TX(I,J,L)*LOG(PMB(K)/PL)-GHT(K)*GRAV)
534      IF (K.EQ.2) AIJ(I,J,16)=AIJ(I,J,16)+(TX(I,J,L)-273.16)
535      IF (K.GE.KM) GO TO 180
536      K=K+1
537      IF (PMB(K).LT.PL.AND.L.LT.LM) GO TO 172
538      GO TO 176
539  180 CONTINUE
540  190 CONTINUE
541c  ** ACCUMULATION OF TEMP., POTENTIAL TEMP., Q, AND RH
542      DO 250 J=1,JM
543      IMAX=IM
544      IF (J.EQ.1.OR.J.EQ.JM) IMAX=1
545      DXYPJ=DXYP(J)
546      DO 230 L=1,LM
547      ATX=0.
548      BTX=0.
549      CTX=0.
550      TPI(J,L)=0.
551      AQ=0.
552      BQ=0.
553      CQ=0.
554      PHIPI(J,L)=0.
555c     QPI=0.
556      SPI(J,L)=0.
557c     RHPI=0.
558      DO 220 I=1,IMAX
559      JR=JREG(I,J)
560      PLAND=FDATA(I,J,2)
561      POICE=ODATA(I,J,2)*(1.-PLAND)
562      POCEAN=(1.-PLAND)-POICE
563      PIJ=P(I,J)
564      ATX=ATX+(TX(I,J,L)-273.16)*POCEAN
565      BTX=BTX+(TX(I,J,L)-273.16)*PLAND
566      CTX=CTX+(TX(I,J,L)-273.16)*POICE
567      AQ=AQ+Q(I,J,L)*PIJ*POCEAN
568      BQ=BQ+Q(I,J,L)*PIJ*PLAND
569      CQ=CQ+Q(I,J,L)*PIJ*POICE
570      DJ(JR,63)=DJ(JR,63)+Q(I,J,L)*PIJ*DSIG(L)*DXYPJ
571      DJ(JR,21)=DJ(JR,21)+(TX(I,J,L)-273.16)*DSIG(L)*DXYPJ
572      TPI(J,L)=TPI(J,L)+(TX(I,J,L)-273.16)*PIJ
573      PHIPI(J,L)=PHIPI(J,L)+PHI(I,J,L)*PIJ
574c     QPI=QPI+Q(I,J,L)*PIJ
575      SPI(J,L)=SPI(J,L)+T(I,J,L)*PIJ
576c     QLH=LHE
577c     QSATL=QSAT(TX(I,J,L),SIG(L)*PIJ+PTOP,QLH)
578c     IF (QSATL.GT.1.) QSATL=1.
579c     RHPI=RHPI+Q(I,J,L)*PIJ/QSATL
580  220 CONTINUE
581      AJ(J,21)=AJ(J,21)+ATX*DSIG(L)
582      BJ(J,21)=BJ(J,21)+BTX*DSIG(L)
583      CJ(J,21)=CJ(J,21)+CTX*DSIG(L)
584      AJ(J,63)=AJ(J,63)+AQ*DSIG(L)
585      BJ(J,63)=BJ(J,63)+BQ*DSIG(L)
586      CJ(J,63)=CJ(J,63)+CQ*DSIG(L)
587c     AJL(J,L,1)=AJL(J,L,1)+TPI(J,L)
588c     AJL(J,L,2)=AJL(J,L,2)+PHIPI(J,L)
589c     AJL(J,L,3)=AJL(J,L,3)+QPI
590c     AJL(J,L,17)=AJL(J,L,17)+SPI(J,L)
591c     AJL(J,L,18)=AJL(J,L,18)+RHPI
592  230 CONTINUE
593  250 CONTINUE
594c  **
595c  ** NORTHWARD GRADIENT OF TEMPERATURE: TROPOSPHERIC AND STRATOSPHERIC
596c  **
597      DO 385 J=2,JM-1
598c  ** MEAN TROPOSPHERIC NORTHWARD TEMPERATURE GRADIENT
599      DO 340 L=1,LTM
600      ADTDL=0.
601      BDTDL=0.
602      CDTDL=0.
603      DO 335 I=1,IM
604      PLAND=FDATA(I,J,2)
605      POICE=ODATA(I,J,2)*(1.-PLAND)
606      POCEAN=(1.-PLAND)-POICE
607      ADTDL=ADTDL+(TX(I,J+1,L)-TX(I,J-1,L))*POCEAN
608      BDTDL=BDTDL+(TX(I,J+1,L)-TX(I,J-1,L))*PLAND
609      CDTDL=CDTDL+(TX(I,J+1,L)-TX(I,J-1,L))*POICE
610  335 CONTINUE
611  338 AJ(J,36)=AJ(J,36)+ADTDL*DSIG(L)
612      BJ(J,36)=BJ(J,36)+BDTDL*DSIG(L)
613  340 CJ(J,36)=CJ(J,36)+CDTDL*DSIG(L)
614c  ** MEAN STRATOSPHERIC NORTHWARD TEMPERATURE GRADIENT
615      IF (LS1.GT.LM) GO TO 380
616      DO 370 L=LS1,LM
617      ADTDL=0.
618      BDTDL=0.
619      CDTDL=0.
620      DO 350 I=1,IM
621      PLAND=FDATA(I,J,2)
622      POICE=ODATA(I,J,2)*(1.-PLAND)
623      POCEAN=(1.-PLAND)-POICE
624      ADTDL=ADTDL+(TX(I,J+1,L)-TX(I,J-1,L))*POCEAN
625      BDTDL=BDTDL+(TX(I,J+1,L)-TX(I,J-1,L))*PLAND
626      CDTDL=CDTDL+(TX(I,J+1,L)-TX(I,J-1,L))*POICE
627  350 CONTINUE
628  360 AJ(J,35)=AJ(J,35)+ADTDL*DSIG(L)
629      BJ(J,35)=BJ(J,35)+BDTDL*DSIG(L)
630  370 CJ(J,35)=CJ(J,35)+CDTDL*DSIG(L)
631  380 CONTINUE
632  385 CONTINUE
633c  **
634c  ** STATIC STABILITIES: TROPOSPHERIC AND STRATOSPHERIC
635c  **
636      DO 490 J=1,JM
637      IMAX=IM
638      IF (J.EQ.1.OR.J.EQ.JM) IMAX=1
639      DXYPJ=DXYP(J)
640c  ** OLD TROPOSPHERIC STATIC STABILITY
641      ASS=0.
642      BSS=0.
643      CSS=0.
644      DO 390 I=1,IMAX
645      JR=JREG(I,J)
646      PLAND=FDATA(I,J,2)
647      POICE=ODATA(I,J,2)*(1.-PLAND)
648      POCEAN=(1.-PLAND)-POICE
649      SS=(T(I,J,LTM)-T(I,J,1))/(PHI(I,J,LTM)-PHI(I,J,1)+ZERO20)
650      ASS=ASS+SS*POCEAN
651      BSS=BSS+SS*PLAND
652      CSS=CSS+SS*POICE
653      DJ(JR,25)=DJ(JR,25)+SS*DXYPJ
654  390 AIJ(I,J,31)=AIJ(I,J,31)+SS
655      AJ(J,25)=AJ(J,25)+ASS
656      BJ(J,25)=BJ(J,25)+BSS
657      CJ(J,25)=CJ(J,25)+CSS
658c  ** OLD STRATOSPHERIC STATIC STABILITY
659      ASS=0.
660      BSS=0.
661      CSS=0.
662      DO 440 I=1,IMAX
663      JR=JREG(I,J)
664      PLAND=FDATA(I,J,2)
665      POICE=ODATA(I,J,2)*(1.-PLAND)
666      POCEAN=(1.-PLAND)-POICE
667      SS=(T(I,J,LM)-T(I,J,LTM))/((PHI(I,J,LM)-PHI(I,J,LTM))+ZERO20)
668      ASS=ASS+SS*POCEAN
669      BSS=BSS+SS*PLAND
670      CSS=CSS+SS*POICE
671      DJ(JR,24)=DJ(JR,24)+SS*DXYPJ
672  440 CONTINUE
673      AJ(J,24)=AJ(J,24)+ASS
674      BJ(J,24)=BJ(J,24)+BSS
675      CJ(J,24)=CJ(J,24)+CSS
676c  **
677c  ** NUMBERS ACCUMULATED FOR THE RADIATION EQUILIBRIUM LAYERS
678c  **
679      DO 470 LR=1,3
680      TRI(LR)=0.
681      DO 460 I=1,IMAX
682  460 TRI(LR)=TRI(LR)+RQT(I,J,LR)
683  470 ASJL(J,LR,1)=ASJL(J,LR,1)+(TRI(LR)-273.16*IMAX)
684      PHIRI=0.
685      DO 480 I=1,IMAX
686  480 PHIRI=PHIRI+(PHI(I,J,LM)+RGAS*.5*(TX(I,J,LM)+RQT(I,J,1))
687     *  *LOG((SIG(LM)*P(I,J)+PTOP)/PRQ1))
688      ASJL(J,1,2)=ASJL(J,1,2)+PHIRI
689      PHIRI=PHIRI+RGAS*.5*(TRI(1)+TRI(2))*DLNP12
690      ASJL(J,2,2)=ASJL(J,2,2)+PHIRI
691      PHIRI=PHIRI+RGAS*.5*(TRI(2)+TRI(3))*DLNP23
692      ASJL(J,3,2)=ASJL(J,3,2)+PHIRI
693  490 CONTINUE
694c  **
695c  ** RICHARDSON NUMBER , ROSSBY NUMBER , RADIUS OF DEFORMATION
696c  **
697c  ** NUMBERS ACCUMULATED OVER THE TROPOSPHERE
698      DO 506 J=2,JM
699      DUDVSQ(J)=0.
700      UMAX(J)=0.
701      DO 504 I=1,IM
702      DU=U(I,J,LTM)-U(I,J,1)
703      DV=V(I,J,LTM)-V(I,J,1)
704      DUDVSQ(J)=DUDVSQ(J)+(DU*DU+DV*DV)*PUV(I,J)
705  504 CONTINUE
706  506 CONTINUE
707      DO 510 J=2,JM-1
708      PIBYIM=PI(J)*BYIM
709      DLNP=LOG((SIG(1)*PIBYIM+PTOP)/(SIG(LTM)*PIBYIM+PTOP))
710      DLNS=LOG(SPI(J,LTM)/SPI(J,1))
711      DS=SPI(J,LTM)-SPI(J,1)
712      EL(J)=SQRT(DLNS/DLNP)
713      RI(J)=DS*DLNP/(.5*(DUDVSQ(J)+DUDVSQ(J+1)))
714  510 CONTINUE
715      DO 515 L=1,LTM
716      DO 514 J=2,JM
717      UI(J)=0.
718      DO 512 I=1,IM
719  512 UI(J)=UI(J)+U(I,J,L)
720  514 CONTINUE
721      DO 515 J=2,JM-1
722      UAMAX=ABS(UI(J)+UI(J+1))
723      IF (UAMAX.GT.UMAX(J)) UMAX(J)=UAMAX
724  515 CONTINUE
725      DO 520 J=2,JM-1
726      ROSSX=DYP(J)/(DXYP(J)*SINP(J))
727      ELX=1./SINP(J)
728      AJ(J,27)=AJ(J,27)+RI(J)*SOCEAN(J)
729      BJ(J,27)=BJ(J,27)+RI(J)*SLAND(J)
730      CJ(J,27)=CJ(J,27)+RI(J)*SOICE(J)
731      AJ(J,29)=AJ(J,29)+UMAX(J)*SOCEAN(J)*ROSSX
732      BJ(J,29)=BJ(J,29)+UMAX(J)*SLAND(J)*ROSSX
733      CJ(J,29)=CJ(J,29)+UMAX(J)*SOICE(J)*ROSSX
734      AJ(J,38)=AJ(J,38)+EL(J)*SOCEAN(J)*ELX
735      BJ(J,38)=BJ(J,38)+EL(J)*SLAND(J)*ELX
736      CJ(J,38)=CJ(J,38)+EL(J)*SOICE(J)*ELX
737  520 CONTINUE
738c  ** NUMBERS ACCUMULATED OVER THE STRATOSPHERE
739cNOST IF (LS1.GT.LM) GO TO 551    NEEDED FOR RUNS WITHOUT A STRATOSPHERE
740      DO 532 J=2,JM
741      DUDVSQ(J)=0.
742      UMAX(J)=0.
743  532 CONTINUE
744      DO 536 J=2,JM
745      DO 534 I=1,IM
746      DU=U(I,J,LM)-U(I,J,LTM)
747      DV=V(I,J,LM)-V(I,J,LTM)
748      DUDVSQ(J)=DUDVSQ(J)+(DU*DU+DV*DV)*PUV(I,J)
749  534 CONTINUE
750  536 CONTINUE
751      DO 540 J=2,JM-1
752      PIBYIM=PI(J)*BYIM
753      DLNP=LOG((SIG(LTM)*PIBYIM+PTOP)/(SIG(LM)*PIBYIM+PTOP))
754      DLNS=LOG(SPI(J,LM)/SPI(J,LTM))
755      DS=SPI(J,LM)-SPI(J,LTM)
756      EL(J)=SQRT(DLNS/DLNP)
757      RI(J)=DS*DLNP/(.5*(DUDVSQ(J)+DUDVSQ(J+1)))
758  540 CONTINUE
759      DO 545 L=LS1,LM
760      DO 544 J=2,JM
761      UI(J)=0.
762      DO 542 I=1,IM
763  542 UI(J)=UI(J)+U(I,J,L)
764  544 CONTINUE
765      DO 545 J=2,JM-1
766      UAMAX=ABS(UI(J)+UI(J+1))
767      IF (UAMAX.GT.UMAX(J)) UMAX(J)=UAMAX
768  545 CONTINUE
769      DO 550 J=2,JM-1
770      ROSSX=DYP(J)/(DXYP(J)*SINP(J))
771      ELX=1./SINP(J)
772      AJ(J,26)=AJ(J,26)+RI(J)*SOCEAN(J)
773      BJ(J,26)=BJ(J,26)+RI(J)*SLAND(J)
774      CJ(J,26)=CJ(J,26)+RI(J)*SOICE(J)
775      AJ(J,28)=AJ(J,28)+UMAX(J)*SOCEAN(J)*ROSSX
776      BJ(J,28)=BJ(J,28)+UMAX(J)*SLAND(J)*ROSSX
777      CJ(J,28)=CJ(J,28)+UMAX(J)*SOICE(J)*ROSSX
778      AJ(J,37)=AJ(J,37)+EL(J)*SOCEAN(J)*ELX
779      BJ(J,37)=BJ(J,37)+EL(J)*SLAND(J)*ELX
780      CJ(J,37)=CJ(J,37)+EL(J)*SOICE(J)*ELX
781  550 CONTINUE
782c 551 CONTINUE
783c  **
784c  ** MEAN TROPOSPHERIC LAPSE RATES:  MOIST CONVECTIVE, ACTUAL,
785c  **    DRY ADIABATIC
786c  **