SUBROUTINE ST_DIAG1( NUM_STASH_LEVELSDA,INT15,PSTAR_OLD, 2,6@DYALLOC.140
*CALL ARGSIZE 
@DYALLOC.141
*CALL ARGD1 @DYALLOC.142
*CALL ARGDUMA @DYALLOC.143
*CALL ARGDUMO @DYALLOC.144
*CALL ARGDUMW GKR1F401.266
*CALL ARGSTS @DYALLOC.145
*CALL ARGPTRA @DYALLOC.146
*CALL ARGPTRO @DYALLOC.147
*CALL ARGCONA @DYALLOC.148
*CALL ARGPPX GKR0F305.992
*CALL ARGFLDPT GSM1F405.449
& ICODE,CMESSAGE) @DYALLOC.149
ST_DIA11.37
C* ST_DIA11.38
IMPLICIT NONE ST_DIA11.39
C*L ST_DIA11.40
ST_DIA11.41
*CALL CMAXSIZE @DYALLOC.150
*CALL CSUBMODL GSS1F305.938
*CALL TYPSIZE @DYALLOC.151
*CALL TYPD1 @DYALLOC.152
*CALL TYPDUMA @DYALLOC.153
*CALL TYPDUMO @DYALLOC.154
*CALL TYPDUMW GKR1F401.267
*CALL TYPSTS @DYALLOC.155
*CALL TYPPTRA @DYALLOC.156
*CALL TYPPTRO @DYALLOC.157
*CALL TYPCONA @DYALLOC.158
*CALL PPXLOOK GKR0F305.993
*CALL TYPFLDPT GSM1F405.450
@DYALLOC.159
INTEGER ST_DIA11.42
& INT15, ! Dummy for STASH_MAXLEN(15) ST_DIA11.43
& NUM_STASH_LEVELSDA,! In Extra copy NUM_STASH_LEVELS @DYALLOC.160
& ICODE ! Out return code : 0 Normal exit @DYALLOC.161
C ! : >0 Error exit ST_DIA11.45
C ! workspace to be dynamically allocated ST_DIA11.47
REAL ST_DIA11.48
& PSTAR_OLD(P_FIELD) ! IN Pstar before dynamics @DYALLOC.162
ST_DIA11.50
CHARACTER*(80) TS150793.188
& CMESSAGE ! Out error message if ICODE > 0 ST_DIA11.52
ST_DIA11.53
*CALL CHSUNITS RS030293.229
*CALL CCONTROL ST_DIA11.58
*CALL CPHYSCON ST_DIA11.59
*CALL CTIME RR250193.56
*CALL C_ETA_PMSL GDR3F404.4
ST_DIA11.60
CL External subroutines called ST_DIA11.61
ST_DIA11.62
EXTERNAL ST_DIA11.63
& STASH, ST_DIA11.64
& TIMER, ST_DIA11.65
& DYN_DIAG ST_DIA11.66
ST_DIA11.67
CL Dynamically allocated workspace for stash processing ST_DIA11.68
ST_DIA11.69
REAL ST_DIA11.70
& STASHWORK(INT15) ST_DIA11.71
& ,UCOMP_PRESS(NUM_STASH_LEVELSDA) @DYALLOC.163
& ,VCOMP_PRESS(NUM_STASH_LEVELSDA) @DYALLOC.164
& ,CAT_PROB_PRESS(NUM_STASH_LEVELSDA) @DYALLOC.165
& ,PV_THETA(NUM_STASH_LEVELSDA) ! requested theta levels @DYALLOC.166
& ,PV_PRESS(NUM_STASH_LEVELSDA) ! requested p levels @DYALLOC.167
& ,THETA_ON_PV(NUM_STASH_LEVELSDA) ! requested pv levels @DYALLOC.168
& ,T_PRESS(NUM_STASH_LEVELSDA) @DYALLOC.169
& ,w_PRESS(NUM_STASH_LEVELSDA) @DYALLOC.170
& ,Q_PRESS(NUM_STASH_LEVELSDA) @DYALLOC.171
& ,PRESS_LEVS(NUM_STASH_LEVELSDA) @DYALLOC.172
& ,TESTD_PRESS(NUM_STASH_LEVELSDA) @DYALLOC.173
& ,TESTD_MODEL(NUM_STASH_LEVELSDA) @DYALLOC.174
& ,HEAVY_PRESS(NUM_STASH_LEVELSDA) ! Heavy press levels ARS1F404.189
& ,Z_PRESS(NUM_STASH_LEVELSDA) ! Z pressure levels ARS1F404.190
ST_DIA11.80
C Local variables ST_DIA11.81
ST_DIA11.82
INTEGER ST_DIA11.83
& I, ST_DIA11.84
& NI, ST_DIA11.85
& K, ST_DIA11.86
& ISL, ST_DIA11.87
& BL, ST_DIA11.88
& TL, ST_DIA11.89
& LEVEL, ST_DIA11.90
& UCOMP_P_LEVS, ST_DIA11.91
& VCOMP_P_LEVS, ST_DIA11.92
& CAT_PROB_LEVS, ST_DIA11.93
& PV_THETA_LEVS, ST_DIA11.94
& PV_PRESS_LEVS, MM180193.74
& THETA_ON_PV_LEVS, MM180193.75
& n_levels, TD141293.95
& UV_P_LEVS,T_P_LEVS,UT_P_LEVS,VT_P_LEVS,T2_P_LEVS, ST_DIA11.95
& U2_P_LEVS,V2_P_LEVS,w_P_LEVS,WT_P_LEVS,Wu_P_LEVS, ST_DIA11.96
& WV_P_LEVS,Q_P_LEVS,QU_P_LEVS,QV_P_LEVS,QW_P_LEVS, ARS1F404.191
& TESTD_P_LEVS,TESTD_M_LEVS,HEAVY_P_LEVS ARS1F404.192
& ,Z_P_LEVS,UZ_P_LEVS,VZ_P_LEVS ARS1F404.193
& ,im_ident ! Internal Model Identifier GDR4F305.160
& ,im_index ! Internal Model Index for Stash Arrays GDR4F305.161
ST_DIA11.98
INTEGER ST_DIA11.99
& PT201,PT202,PT203,PT204,PT205,PT206,PT207,PT208,PT209, ST_DIA11.100
& PT210,PT211,PT212,PT213,PT214,PT215,PT216,PT217,PT218, ST_DIA11.101
& PT219,PT220,PT221,PT222,PT223,PT224,PT225,PT226,PT227, ST_DIA11.102
& PT228,PT229,PT230, MM180193.76
& PT231,PT232,PT233,PT234,PT235,PT236,PT237, ARS1F404.194
& PT238,PT239,PT240,PT241 ARS1F404.195
ST_DIA11.104
INTEGER ST_DIA11.105
& UV_IND(NUM_STASH_LEVELSDA*2),UT_IND(NUM_STASH_LEVELSDA*2), @DYALLOC.175
& VT_IND(NUM_STASH_LEVELSDA*2),T2_IND(NUM_STASH_LEVELSDA), @DYALLOC.176
& U2_IND(NUM_STASH_LEVELSDA*2),V2_IND(NUM_STASH_LEVELSDA), @DYALLOC.177
& WT_IND(NUM_STASH_LEVELSDA*2),WU_IND(NUM_STASH_LEVELSDA*2), @DYALLOC.178
& WV_IND(NUM_STASH_LEVELSDA*2),QU_IND(NUM_STASH_LEVELSDA*2), @DYALLOC.179
& QV_IND(NUM_STASH_LEVELSDA*2),QW_IND(NUM_STASH_LEVELSDA*2), ARS1F404.196
& UZ_IND(NUM_STASH_LEVELSDA*2),VZ_IND(NUM_STASH_LEVELSDA*2) ARS1F404.197
ST_DIA11.112
LOGICAL ST_DIA11.113
& ROTATE_UV, !True if wind to be rotated ST_DIA11.114
& ROTATE_MAX_UV !True if wind to be rotated ST_DIA11.115
& ,ERROR_TEST !True if pressure levels for diagnostic ST_DIA11.116
C product don't match ST_DIA11.117
ST_DIA11.118
REAL ST_DIA11.119
& NMOST_LAT, !Northern most latitude of grid ST_DIA11.120
& WMOST_LONG, !Western most longitude ST_DIA11.121
& EW_SPACE, !Delta longitude ST_DIA11.122
& NS_SPACE, !Delta latitude ST_DIA11.123
& PHI_POLE, !Latitude of the pseudo pole ST_DIA11.124
& LAMBDA_POLE !Longitude of the pseudo pole ST_DIA11.125
& ,LAT_STEP_INVERSE ST_DIA11.126
& ,LONG_STEP_INVERSE ST_DIA11.127
ST_DIA11.128
CL Internal Structure: ST_DIA11.129
ST_DIA11.130
! Set to atmosphere internal model GDR4F305.162
im_ident = atmos_im GDR4F305.163
im_index = internal_model_index(im_ident) GDR4F305.164
GDR4F305.165
ST_DIA11.131
CL Section 15 Dynamics diagnostics ST_DIA11.132
CL ST_DIA11.133
CL Local workspace definitions ST_DIA11.134
CL --------------------------------------------------------------------- ST_DIA11.135
CL call DYN_DIAG to calculate dynamical diagnostics and ST_DIA11.136
CL call STASH to process output ST_DIA11.137
CL --------------------------------------------------------------------- ST_DIA11.138
CL ST_DIA11.139
CL This section of code contains numbers used to ST_DIA11.140
CL check on the type of level which determines ST_DIA11.141
CL the interpolation, ST_DIA11.142
CL the codes are as follows (all for stashlist entry 11) ST_DIA11.143
CL 1 -- model levels ST_DIA11.144
CL 2 -- Pressure Levels ST_DIA11.145
CL 3 -- Height Levels ST_DIA11.146
CL 4 -- Theta Levels ST_DIA11.147
CL 5 -- Potential Vorticity Levels MM180193.77
ST_DIA11.148
CL-------------------Extract Reqd Pressures for U_COMP_P------------- ST_DIA11.149
ST_DIA11.150
ISL=STINDEX(1,201,15,im_index) GDR4F305.166
IF(ISL.GT.0) THEN ST_DIA11.152
NI=-STLIST(10,ISL) ST_DIA11.153
UCOMP_P_LEVS=STASH_LEVELS(1,NI) ST_DIA11.154
DO K =1,UCOMP_P_LEVS ST_DIA11.155
UCOMP_PRESS(K)=STASH_LEVELS(K+1,NI)/1000.0 ST_DIA11.156
ENDDO ST_DIA11.157
ELSE ST_DIA11.158
UCOMP_P_LEVS=1 ST_DIA11.159
END IF ST_DIA11.160
ST_DIA11.161
CL-------------------Extract Reqd Pressures for V_COMP_P------------- ST_DIA11.162
ST_DIA11.163
ISL=STINDEX(1,202,15,im_index) GDR4F305.167
IF(ISL.GT.0) THEN ST_DIA11.165
NI=-STLIST(10,ISL) ST_DIA11.166
VCOMP_P_LEVS=STASH_LEVELS(1,NI) ST_DIA11.167
DO K =1,VCOMP_P_LEVS ST_DIA11.168
VCOMP_PRESS(K)=STASH_LEVELS(K+1,NI)/1000.0 ST_DIA11.169
ENDDO ST_DIA11.170
ELSE ST_DIA11.171
VCOMP_P_LEVS=1 ST_DIA11.172
END IF ST_DIA11.173
ST_DIA11.174
CL----------Extract required thetas for Potn_vort on theta ---- MM180193.78
ST_DIA11.176
ISL=STINDEX(1,214,15,im_index) GDR4F305.168
IF(ISL.GT.0) THEN ST_DIA11.178
IF(STLIST(10,ISL).LT.0) THEN ST_DIA11.179
IF(STLIST(11,ISL).EQ.4) THEN ST_DIA11.180
NI = -STLIST(10,ISL) ST_DIA11.181
PV_THETA_LEVS = STASH_LEVELS(1,NI) ST_DIA11.182
DO K = 1,PV_THETA_LEVS ST_DIA11.183
PV_THETA(K) = STASH_LEVELS(K+1,NI)/1000.0 ST_DIA11.184
C ***** levels are stored as integers so divide by a thousand ** ST_DIA11.185
ENDDO ST_DIA11.186
ELSE ST_DIA11.187
CMESSAGE = ' ST_DIAG1 level not theta for pv_theta' ST_DIA11.188
ICODE = 1 ST_DIA11.189
RETURN ST_DIA11.190
END IF ST_DIA11.191
ELSE ST_DIA11.192
CMESSAGE =' ST_DIAG1 level not a LEVELS list for PV_Theta' ST_DIA11.193
ICODE = 1 ST_DIA11.194
RETURN ST_DIA11.195
END IF ST_DIA11.196
ELSE MM180193.79
PV_THETA_LEVS = 1 MM180193.80
END IF ST_DIA11.199
ST_DIA11.200
CL----------Extract required pressures for Potn_vort on press ---- MM180193.81
MM180193.82
ISL=STINDEX(1,229,15,im_index) GDR4F305.169
IF(ISL.GT.0) THEN MM180193.84
IF(STLIST(10,ISL).LT.0) THEN MM180193.85
IF(STLIST(11,ISL).EQ.2) THEN MM180193.86
NI = -STLIST(10,ISL) MM180193.87
PV_PRESS_LEVS = STASH_LEVELS(1,NI) MM180193.88
DO K = 1,PV_PRESS_LEVS MM180193.89
PV_PRESS(K) = STASH_LEVELS(K+1,NI)/10.0 MM180193.90
C ***** levels are stored as integers so divide by a thousand ** MM180193.91
C ***** Multiply by 100. to convert to pascals. MM180193.92
ENDDO MM180193.93
ELSE MM180193.94
CMESSAGE = ' ST_DIAG1 level not pressure for pv_press' MM180193.95
ICODE = 1 MM180193.96
RETURN MM180193.97
END IF MM180193.98
ELSE MM180193.99
CMESSAGE =' ST_DIAG1 level not a LEVELS list for PV_press' MM180193.100
ICODE = 1 MM180193.101
RETURN MM180193.102
END IF MM180193.103
ELSE MM180193.104
PV_PRESS_LEVS = 1 MM180193.105
END IF MM180193.106
MM180193.107
CL----------Extract required PVs for Theta on pv ----------------- MM180193.108
MM180193.109
ISL=STINDEX(1,230,15,im_index) GDR4F305.170
IF(ISL.GT.0) THEN MM180193.111
IF(STLIST(10,ISL).LT.0) THEN MM180193.112
IF(STLIST(11,ISL).EQ.5) THEN MM180193.113
NI = -STLIST(10,ISL) MM180193.114
THETA_ON_PV_LEVS = STASH_LEVELS(1,NI) MM180193.115
DO K = 1,PV_PRESS_LEVS MM180193.116
THETA_ON_PV(K) = STASH_LEVELS(K+1,NI)/1000.0 MM180193.117
C ***** levels are stored as integers so divide by a thousand ** MM180193.118
ENDDO MM180193.119
ELSE MM180193.120
CMESSAGE = ' ST_DIAG1 level not PV for theta_on_pv' MM180193.121
ICODE = 1 MM180193.122
RETURN MM180193.123
END IF MM180193.124
ELSE MM180193.125
CMESSAGE =' ST_DIAG1 level not a LEVELS list for theta_on_pv' MM180193.126
ICODE = 1 MM180193.127
RETURN MM180193.128
END IF MM180193.129
ELSE MM180193.130
THETA_ON_PV_LEVS = 1 MM180193.131
END IF MM180193.132
MM180193.133
CL----------Extract required pressures for CAT_PROB_SINGLE-------------- ST_DIA11.201
ST_DIA11.202
ISL=STINDEX(1,205,15,im_index) GDR4F305.171
IF(ISL.GT.0) THEN ST_DIA11.204
NI=-STLIST(10,ISL) ST_DIA11.205
CAT_PROB_LEVS=STASH_LEVELS(1,NI) ST_DIA11.206
DO K =1,CAT_PROB_LEVS ST_DIA11.207
CAT_PROB_PRESS(K)=STASH_LEVELS(K+1,NI)/1000.0 ST_DIA11.208
ENDDO ST_DIA11.209
ELSE ST_DIA11.210
CAT_PROB_LEVS=1 ST_DIA11.211
END IF ST_DIA11.212
ST_DIA11.213
CL----Check U and V also requested this timestep ----------------------- ST_DIA11.214
ST_DIA11.215
IF (SF(215,15)) THEN ST_DIA11.216
IF ((.NOT.SF(201,15)).OR.(.NOT.SF(202,15))) THEN ST_DIA11.217
CMESSAGE='ST_DIAG1 : UV error U and V must be requested' ST_DIA11.218
ICODE=1 ST_DIA11.219
GOTO 999 ST_DIA11.220
ELSE ST_DIA11.221
ISL=STINDEX(1,215,15,im_index) GDR4F305.172
IF(ISL.GT.0) THEN ST_DIA11.223
NI=-STLIST(10,ISL) ST_DIA11.224
UV_P_LEVS=STASH_LEVELS(1,NI) ST_DIA11.225
DO K =1,UV_P_LEVS ST_DIA11.226
PRESS_LEVS(K)=STASH_LEVELS(K+1,NI)/1000.0 ST_DIA11.227
DO I=1,UCOMP_P_LEVS ST_DIA11.228
IF (PRESS_LEVS(K).EQ.UCOMP_PRESS(I)) THEN ST_DIA11.229
UV_IND(K)=I ST_DIA11.230
ENDIF ST_DIA11.231
ENDDO ST_DIA11.232
DO I=1,VCOMP_P_LEVS ST_DIA11.233
IF (PRESS_LEVS(K).EQ.VCOMP_PRESS(I)) THEN ST_DIA11.234
UV_IND(UV_P_LEVS+K)=I ST_DIA11.235
ENDIF ST_DIA11.236
ENDDO ST_DIA11.237
ENDDO ST_DIA11.238
ELSE ST_DIA11.239
UV_P_LEVS=1 ST_DIA11.240
END IF ST_DIA11.241
END IF ST_DIA11.242
ELSE ST_DIA11.243
UV_P_LEVS=1 ST_DIA11.244
END IF ST_DIA11.245
ST_DIA11.246
CL-------------------Extract Reqd Pressures for T on wind grid------- ST_DIA11.247
ST_DIA11.248
ISL=STINDEX(1,216,15,im_index) GDR4F305.173
IF(ISL.GT.0) THEN ST_DIA11.250
NI=-STLIST(10,ISL) ST_DIA11.251
T_P_LEVS=STASH_LEVELS(1,NI) ST_DIA11.252
DO K =1,T_P_LEVS ST_DIA11.253
T_PRESS(K)=STASH_LEVELS(K+1,NI)/1000.0 ST_DIA11.254
ENDDO ST_DIA11.255
ELSE ST_DIA11.256
T_P_LEVS=1 ST_DIA11.257
END IF ST_DIA11.258
ST_DIA11.259
CL----Check UT requested at same time as U and T----------------------- ST_DIA11.260
ST_DIA11.261
IF (SF(217,15)) THEN ST_DIA11.262
IF ((.NOT.SF(201,15)).OR.(.NOT.SF(216,15))) THEN ST_DIA11.263
CMESSAGE='ST_DIAG1 : UT error U and T must be requested' ST_DIA11.264
ICODE=1 ST_DIA11.265
GOTO 999 ST_DIA11.266
ELSE ST_DIA11.267
ISL=STINDEX(1,217,15,im_index) GDR4F305.174
IF(ISL.GT.0) THEN ST_DIA11.269
NI=-STLIST(10,ISL) ST_DIA11.270
UT_P_LEVS=STASH_LEVELS(1,NI) ST_DIA11.271
DO K =1,UT_P_LEVS ST_DIA11.272
PRESS_LEVS(K)=STASH_LEVELS(K+1,NI)/1000.0 ST_DIA11.273
DO I=1,UCOMP_P_LEVS ST_DIA11.274
IF (PRESS_LEVS(K).EQ.UCOMP_PRESS(I)) THEN ST_DIA11.275
UT_IND(K)=I ST_DIA11.276
ENDIF ST_DIA11.277
ENDDO ST_DIA11.278
DO I=1,T_P_LEVS ST_DIA11.279
IF (PRESS_LEVS(K).EQ.T_PRESS(I)) THEN ST_DIA11.280
UT_IND(UT_P_LEVS+K)=I ST_DIA11.281
ENDIF ST_DIA11.282
ENDDO ST_DIA11.283
ENDDO ST_DIA11.284
ELSE ST_DIA11.285
UT_P_LEVS=1 ST_DIA11.286
END IF ST_DIA11.287
END IF ST_DIA11.288
ELSE ST_DIA11.289
UT_P_LEVS=1 ST_DIA11.290
END IF ST_DIA11.291
ST_DIA11.292
CL----Check VT requested at same time as V and T----------------------- ST_DIA11.293
ST_DIA11.294
IF (SF(218,15)) THEN ST_DIA11.295
IF ((.NOT.SF(202,15)).OR.(.NOT.SF(216,15))) THEN ST_DIA11.296
CMESSAGE='ST_DIAG1 : VT error V and T must be requested' ST_DIA11.297
ICODE=1 ST_DIA11.298
GOTO 999 ST_DIA11.299
ELSE ST_DIA11.300
ISL=STINDEX(1,218,15,im_index) GDR4F305.175
IF(ISL.GT.0) THEN ST_DIA11.302
NI=-STLIST(10,ISL) ST_DIA11.303
VT_P_LEVS=STASH_LEVELS(1,NI) ST_DIA11.304
DO K =1,VT_P_LEVS ST_DIA11.305
PRESS_LEVS(K)=STASH_LEVELS(K+1,NI)/1000.0 ST_DIA11.306
DO I=1,VCOMP_P_LEVS ST_DIA11.307
IF (PRESS_LEVS(K).EQ.VCOMP_PRESS(I)) THEN ST_DIA11.308
VT_IND(K)=I ST_DIA11.309
ENDIF ST_DIA11.310
ENDDO ST_DIA11.311
DO I=1,T_P_LEVS ST_DIA11.312
IF (PRESS_LEVS(K).EQ.T_PRESS(I)) THEN ST_DIA11.313
VT_IND(VT_P_LEVS+K)=I ST_DIA11.314
ENDIF ST_DIA11.315
ENDDO ST_DIA11.316
ENDDO ST_DIA11.317
ELSE ST_DIA11.318
VT_P_LEVS=1 ST_DIA11.319
END IF ST_DIA11.320
END IF ST_DIA11.321
ELSE ST_DIA11.322
VT_P_LEVS=1 ST_DIA11.323
END IF ST_DIA11.324
ST_DIA11.325
CL----Check T2 requested at same time as T ---------------------------- ST_DIA11.326
ST_DIA11.327
IF (SF(219,15)) THEN ST_DIA11.328
IF (.NOT.SF(216,15)) THEN ST_DIA11.329
CMESSAGE='ST_DIAG1 : T2 error T must be requested' ST_DIA11.330
ICODE=1 ST_DIA11.331
GOTO 999 ST_DIA11.332
ELSE ST_DIA11.333
ISL=STINDEX(1,219,15,im_index) GDR4F305.176
IF(ISL.GT.0) THEN ST_DIA11.335
NI=-STLIST(10,ISL) ST_DIA11.336
T2_P_LEVS=STASH_LEVELS(1,NI) ST_DIA11.337
DO K =1,T2_P_LEVS ST_DIA11.338
PRESS_LEVS(K)=STASH_LEVELS(K+1,NI)/1000.0 ST_DIA11.339
DO I=1,T_P_LEVS ST_DIA11.340
IF (PRESS_LEVS(K).EQ.T_PRESS(I)) THEN ST_DIA11.341
T2_IND(K)=I ST_DIA11.342
ENDIF ST_DIA11.343
ENDDO ST_DIA11.344
ENDDO ST_DIA11.345
ELSE ST_DIA11.346
T2_P_LEVS=1 ST_DIA11.347
END IF ST_DIA11.348
END IF ST_DIA11.349
ELSE ST_DIA11.350
T2_P_LEVS=1 ST_DIA11.351
END IF ST_DIA11.352
ST_DIA11.353
CL----Check U2 requested at same time as U ---------------------------- ST_DIA11.354
ST_DIA11.355
IF (SF(220,15)) THEN ST_DIA11.356
IF (.NOT.SF(201,15)) THEN ST_DIA11.357
CMESSAGE='ST_DIAG1 : U2 error U must be requested' ST_DIA11.358
ICODE=1 ST_DIA11.359
GOTO 999 ST_DIA11.360
ELSE ST_DIA11.361
ISL=STINDEX(1,220,15,im_index) GDR4F305.177
IF(ISL.GT.0) THEN ST_DIA11.363
NI=-STLIST(10,ISL) ST_DIA11.364
U2_P_LEVS=STASH_LEVELS(1,NI) ST_DIA11.365
DO K =1,U2_P_LEVS ST_DIA11.366
PRESS_LEVS(K)=STASH_LEVELS(K+1,NI)/1000.0 ST_DIA11.367
DO I=1,UCOMP_P_LEVS ST_DIA11.368
IF (PRESS_LEVS(K).EQ.UCOMP_PRESS(I)) THEN ST_DIA11.369
U2_IND(K)=I ST_DIA11.370
ENDIF ST_DIA11.371
ENDDO ST_DIA11.372
ENDDO ST_DIA11.373
ELSE ST_DIA11.374
U2_P_LEVS=1 ST_DIA11.375
END IF ST_DIA11.376
END IF ST_DIA11.377
ELSE ST_DIA11.378
U2_P_LEVS=1 ST_DIA11.379
END IF ST_DIA11.380
ST_DIA11.381
CL----Check V2 requested at same time as V ---------------------------- ST_DIA11.382
ST_DIA11.383
IF (SF(221,15)) THEN ST_DIA11.384
IF (.NOT.SF(202,15)) THEN ST_DIA11.385
CMESSAGE='ST_DIAG1 : V2 error V must be requested' ST_DIA11.386
ICODE=1 ST_DIA11.387
GOTO 999 ST_DIA11.388
ELSE ST_DIA11.389
ISL=STINDEX(1,221,15,im_index) GDR4F305.178
IF(ISL.GT.0) THEN ST_DIA11.391
NI=-STLIST(10,ISL) ST_DIA11.392
V2_P_LEVS=STASH_LEVELS(1,NI) ST_DIA11.393
DO K =1,V2_P_LEVS ST_DIA11.394
PRESS_LEVS(K)=STASH_LEVELS(K+1,NI)/1000.0 ST_DIA11.395
DO I=1,VCOMP_P_LEVS ST_DIA11.396
IF (PRESS_LEVS(K).EQ.VCOMP_PRESS(I)) THEN ST_DIA11.397
V2_IND(K)=I ST_DIA11.398
ENDIF ST_DIA11.399
ENDDO ST_DIA11.400
ENDDO ST_DIA11.401
ELSE ST_DIA11.402
V2_P_LEVS=1 ST_DIA11.403
END IF ST_DIA11.404
END IF ST_DIA11.405
ELSE ST_DIA11.406
V2_P_LEVS=1 ST_DIA11.407
END IF ST_DIA11.408
ST_DIA11.409
CL-------------------Extract Reqd Pressures for w on wind grid------- ST_DIA11.410
ST_DIA11.411
ISL=STINDEX(1,222,15,im_index) GDR4F305.179
IF(ISL.GT.0) THEN ST_DIA11.413
NI=-STLIST(10,ISL) ST_DIA11.414
w_P_LEVS=STASH_LEVELS(1,NI) ST_DIA11.415
DO K =1,w_P_LEVS ST_DIA11.416
w_PRESS(K)=STASH_LEVELS(K+1,NI)/1000.0 ST_DIA11.417
ENDDO ST_DIA11.418
ELSE ST_DIA11.419
w_P_LEVS=1 ST_DIA11.420
END IF ST_DIA11.421
ST_DIA11.422
CL----Check wT requested at same time as w and T----------------------- ST_DIA11.423
ST_DIA11.424
IF (SF(223,15)) THEN ST_DIA11.425
IF ((.NOT.SF(222,15)).OR.(.NOT.SF(216,15))) THEN ST_DIA11.426
CMESSAGE='ST_DIAG1 : wT error w and T must be requested' ST_DIA11.427
ICODE=1 ST_DIA11.428
GOTO 999 ST_DIA11.429
ELSE ST_DIA11.430
ISL=STINDEX(1,223,15,im_index) GDR4F305.180
IF(ISL.GT.0) THEN ST_DIA11.432
NI=-STLIST(10,ISL) ST_DIA11.433
WT_P_LEVS=STASH_LEVELS(1,NI) ST_DIA11.434
DO K =1,WT_P_LEVS ST_DIA11.435
PRESS_LEVS(K)=STASH_LEVELS(K+1,NI)/1000.0 ST_DIA11.436
DO I=1,W_P_LEVS ST_DIA11.437
IF (PRESS_LEVS(K).EQ.W_PRESS(I)) THEN ST_DIA11.438
WT_IND(K)=I ST_DIA11.439
ENDIF ST_DIA11.440
ENDDO ST_DIA11.441
DO I=1,T_P_LEVS ST_DIA11.442
IF (PRESS_LEVS(K).EQ.T_PRESS(I)) THEN ST_DIA11.443
WT_IND(WT_P_LEVS+K)=I ST_DIA11.444
ENDIF ST_DIA11.445
ENDDO ST_DIA11.446
ENDDO ST_DIA11.447
ELSE ST_DIA11.448
WT_P_LEVS=1 ST_DIA11.449
END IF ST_DIA11.450
END IF ST_DIA11.451
ELSE ST_DIA11.452
WT_P_LEVS=1 ST_DIA11.453
END IF ST_DIA11.454
ST_DIA11.455
CL----Check wU requested at same time as w and u----------------------- ST_DIA11.456
ST_DIA11.457
IF (SF(224,15)) THEN ST_DIA11.458
IF ((.NOT.SF(222,15)).OR.(.NOT.SF(201,15))) THEN ST_DIA11.459
CMESSAGE='ST_DIAG1 : wU error w and U must be requested' ST_DIA11.460
ICODE=1 ST_DIA11.461
GOTO 999 ST_DIA11.462
ELSE ST_DIA11.463
ISL=STINDEX(1,224,15,im_index) GDR4F305.181
IF(ISL.GT.0) THEN ST_DIA11.465
NI=-STLIST(10,ISL) ST_DIA11.466
WU_P_LEVS=STASH_LEVELS(1,NI) ST_DIA11.467
DO K =1,WU_P_LEVS ST_DIA11.468
PRESS_LEVS(K)=STASH_LEVELS(K+1,NI)/1000.0 ST_DIA11.469
DO I=1,W_P_LEVS ST_DIA11.470
IF (PRESS_LEVS(K).EQ.W_PRESS(I)) THEN ST_DIA11.471
WU_IND(K)=I ST_DIA11.472
ENDIF ST_DIA11.473
ENDDO ST_DIA11.474
DO I=1,UCOMP_P_LEVS ST_DIA11.475
IF (PRESS_LEVS(K).EQ.UCOMP_PRESS(I)) THEN ST_DIA11.476
WU_IND(WU_P_LEVS+K)=I ST_DIA11.477
ENDIF ST_DIA11.478
ENDDO ST_DIA11.479
ENDDO ST_DIA11.480
ELSE ST_DIA11.481
WU_P_LEVS=1 ST_DIA11.482
END IF ST_DIA11.483
END IF ST_DIA11.484
ELSE ST_DIA11.485
WU_P_LEVS=1 ST_DIA11.486
END IF ST_DIA11.487
ST_DIA11.488
CL----Check wV requested at same time as w and V----------------------- ST_DIA11.489
ST_DIA11.490
IF (SF(225,15)) THEN ST_DIA11.491
IF ((.NOT.SF(222,15)).OR.(.NOT.SF(202,15))) THEN ST_DIA11.492
CMESSAGE='ST_DIAG1 : wV error w and V must be requested' ST_DIA11.493
ICODE=1 ST_DIA11.494
GOTO 999 ST_DIA11.495
ELSE ST_DIA11.496
ISL=STINDEX(1,225,15,im_index) GDR4F305.182
IF(ISL.GT.0) THEN ST_DIA11.498
NI=-STLIST(10,ISL) ST_DIA11.499
WV_P_LEVS=STASH_LEVELS(1,NI) ST_DIA11.500
DO K =1,WV_P_LEVS ST_DIA11.501
PRESS_LEVS(K)=STASH_LEVELS(K+1,NI)/1000.0 ST_DIA11.502
DO I=1,W_P_LEVS ST_DIA11.503
IF (PRESS_LEVS(K).EQ.W_PRESS(I)) THEN ST_DIA11.504
WV_IND(K)=I ST_DIA11.505
ENDIF ST_DIA11.506
ENDDO ST_DIA11.507
DO I=1,VCOMP_P_LEVS ST_DIA11.508
IF (PRESS_LEVS(K).EQ.VCOMP_PRESS(I)) THEN ST_DIA11.509
WV_IND(WV_P_LEVS+K)=I ST_DIA11.510
ENDIF ST_DIA11.511
ENDDO ST_DIA11.512
ENDDO ST_DIA11.513
ELSE ST_DIA11.514
WV_P_LEVS=1 ST_DIA11.515
END IF ST_DIA11.516
END IF ST_DIA11.517
ELSE ST_DIA11.518
WV_P_LEVS=1 ST_DIA11.519
END IF ST_DIA11.520
ST_DIA11.521
ST_DIA11.522
CL-------------------Extract Reqd Pressures for q on wind grid------- ST_DIA11.523
ST_DIA11.524
ISL=STINDEX(1,226,15,im_index) GDR4F305.183
IF(ISL.GT.0) THEN ST_DIA11.526
NI=-STLIST(10,ISL) ST_DIA11.527
Q_P_LEVS=STASH_LEVELS(1,NI) ST_DIA11.528
DO K =1,Q_P_LEVS ST_DIA11.529
Q_PRESS(K)=STASH_LEVELS(K+1,NI)/1000.0 ST_DIA11.530
ENDDO ST_DIA11.531
ELSE ST_DIA11.532
Q_P_LEVS=1 ST_DIA11.533
END IF ST_DIA11.534
ST_DIA11.535
CL----Check qU requested at same time as q and u----------------------- ST_DIA11.536
ST_DIA11.537
IF (SF(227,15)) THEN ST_DIA11.538
IF ((.NOT.SF(226,15)).OR.(.NOT.SF(201,15))) THEN ST_DIA11.539
CMESSAGE='ST_DIAG1 : qU error q and U must be requested' ST_DIA11.540
ICODE=1 ST_DIA11.541
GOTO 999 ST_DIA11.542
ELSE ST_DIA11.543
ISL=STINDEX(1,227,15,im_index) GDR4F305.184
IF(ISL.GT.0) THEN ST_DIA11.545
NI=-STLIST(10,ISL) ST_DIA11.546
QU_P_LEVS=STASH_LEVELS(1,NI) ST_DIA11.547
DO K =1,QU_P_LEVS ST_DIA11.548
PRESS_LEVS(K)=STASH_LEVELS(K+1,NI)/1000.0 ST_DIA11.549
DO I=1,Q_P_LEVS ST_DIA11.550
IF (PRESS_LEVS(K).EQ.Q_PRESS(I)) THEN ST_DIA11.551
QU_IND(K)=I ST_DIA11.552
ENDIF ST_DIA11.553
ENDDO ST_DIA11.554
DO I=1,UCOMP_P_LEVS ST_DIA11.555
IF (PRESS_LEVS(K).EQ.UCOMP_PRESS(I)) THEN ST_DIA11.556
QU_IND(QU_P_LEVS+K)=I ST_DIA11.557
ENDIF ST_DIA11.558
ENDDO ST_DIA11.559
ENDDO ST_DIA11.560
ELSE ST_DIA11.561
QU_P_LEVS=1 ST_DIA11.562
END IF ST_DIA11.563
END IF ST_DIA11.564
ELSE ST_DIA11.565
QU_P_LEVS=1 ST_DIA11.566
END IF ST_DIA11.567
ST_DIA11.568
CL----Check qV requested at same time as q and V----------------------- ST_DIA11.569
ST_DIA11.570
IF (SF(228,15)) THEN ST_DIA11.571
IF ((.NOT.SF(226,15)).OR.(.NOT.SF(202,15))) THEN ST_DIA11.572
CMESSAGE='ST_DIAG1 : qV error q and V must be requested' ST_DIA11.573
ICODE=1 ST_DIA11.574
GOTO 999 ST_DIA11.575
ELSE ST_DIA11.576
ISL=STINDEX(1,228,15,im_index) GDR4F305.185
IF(ISL.GT.0) THEN ST_DIA11.578
NI=-STLIST(10,ISL) ST_DIA11.579
QV_P_LEVS=STASH_LEVELS(1,NI) ST_DIA11.580
DO K =1,QV_P_LEVS ST_DIA11.581
PRESS_LEVS(K)=STASH_LEVELS(K+1,NI)/1000.0 ST_DIA11.582
DO I=1,Q_P_LEVS ST_DIA11.583
IF (PRESS_LEVS(K).EQ.Q_PRESS(I)) THEN ST_DIA11.584
QV_IND(K)=I ST_DIA11.585
ENDIF ST_DIA11.586
ENDDO ST_DIA11.587
DO I=1,VCOMP_P_LEVS ST_DIA11.588
IF (PRESS_LEVS(K).EQ.VCOMP_PRESS(I)) THEN ST_DIA11.589
QV_IND(QV_P_LEVS+K)=I ST_DIA11.590
ENDIF ST_DIA11.591
ENDDO ST_DIA11.592
ENDDO ST_DIA11.593
ELSE ST_DIA11.594
QV_P_LEVS=1 ST_DIA11.595
END IF ST_DIA11.596
END IF ST_DIA11.597
ELSE ST_DIA11.598
QV_P_LEVS=1 ST_DIA11.599
END IF ST_DIA11.600
ST_DIA11.601
!L----Check qw requested at same time as q and w----------------------- ARS1F404.198
QW_P_LEVS=1 ARS1F404.199
IF (SF(235,15)) THEN ARS1F404.200
IF ((.NOT.SF(226,15)).OR.(.NOT.SF(222,15))) THEN ARS1F404.201
CMESSAGE='ST_DIAG1 : qw error q and w must be requested' ARS1F404.202
ICODE=1 ARS1F404.203
GOTO 999 ARS1F404.204
ELSE ARS1F404.205
ISL=STINDEX(1,235,15,im_index) ARS1F404.206
IF(ISL.GT.0) THEN ARS1F404.207
NI=-STLIST(10,ISL) ARS1F404.208
QW_P_LEVS=STASH_LEVELS(1,NI) ARS1F404.209
DO K =1,QW_P_LEVS ARS1F404.210
PRESS_LEVS(K)=STASH_LEVELS(K+1,NI)/1000.0 ARS1F404.211
DO I=1,Q_P_LEVS ARS1F404.212
IF (PRESS_LEVS(K).EQ.Q_PRESS(I)) THEN ARS1F404.213
QW_IND(K)=I ARS1F404.214
ENDIF ARS1F404.215
ENDDO ARS1F404.216
DO I=1,W_P_LEVS ARS1F404.217
IF (PRESS_LEVS(K).EQ.W_PRESS(I)) THEN ARS1F404.218
QW_IND(QW_P_LEVS+K)=I ARS1F404.219
ENDIF ARS1F404.220
ENDDO ARS1F404.221
ENDDO ARS1F404.222
END IF ARS1F404.223
END IF ARS1F404.224
END IF ARS1F404.225
CL-------------------Extract Reqd Pressures for Test Diagnostic 233-- RR250193.62
RR250193.63
ISL=STINDEX(1,233,15,im_index) GDR4F305.186
IF(ISL.GT.0) THEN RR250193.65
NI=-STLIST(10,ISL) RR250193.66
TESTD_P_LEVS=STASH_LEVELS(1,NI) RR250193.67
DO K =1,TESTD_P_LEVS RR250193.68
TESTD_PRESS(K)=STASH_LEVELS(K+1,NI)/1000.0 RR250193.69
ENDDO RR250193.70
ELSE RR250193.71
TESTD_P_LEVS=1 RR250193.72
END IF RR250193.73
RR250193.74
CL-------------------Extract Reqd Model levs for Test Diagnostic 234-- RR250193.75
RR250193.76
ISL=STINDEX(1,234,15,im_index) GDR4F305.187
IF(ISL.GT.0) THEN RR250193.78
NI=-STLIST(10,ISL) RR250193.79
TESTD_M_LEVS=STASH_LEVELS(1,NI) RR250193.80
DO K =1,TESTD_M_LEVS RR250193.81
TESTD_MODEL(K)=STASH_LEVELS(K+1,NI) ! Converts to real RR250193.82
ENDDO RR250193.83
ELSE RR250193.84
TESTD_M_LEVS=1 RR250193.85
END IF RR250193.86
!L-------------------Extract Reqd Pressures for Heavyside function--- ARS1F404.226
ST_DIA11.602
ISL=STINDEX(1,236,15,im_index) ARS1F404.227
IF(ISL.GT.0) THEN ARS1F404.228
NI=-STLIST(10,ISL) ARS1F404.229
HEAVY_P_LEVS=STASH_LEVELS(1,NI) ARS1F404.230
DO K =1,HEAVY_P_LEVS ARS1F404.231
HEAVY_PRESS(K)=STASH_LEVELS(K+1,NI)/1000.0 ARS1F404.232
ENDDO ARS1F404.233
ELSE ARS1F404.234
HEAVY_P_LEVS=1 ARS1F404.235
END IF ARS1F404.236
ARS1F404.237
!L-------------------Extract Reqd Pressures for geopotential height----- ARS1F404.238
ARS1F404.239
ISL=STINDEX(1,238,15,im_index) ARS1F404.240
IF(ISL.GT.0) THEN ARS1F404.241
NI=-STLIST(10,ISL) ARS1F404.242
Z_P_LEVS=STASH_LEVELS(1,NI) ARS1F404.243
DO K =1,Z_P_LEVS ARS1F404.244
Z_PRESS(K)=STASH_LEVELS(K+1,NI)/1000.0 ARS1F404.245
ENDDO ARS1F404.246
ELSE ARS1F404.247
Z_P_LEVS=1 ARS1F404.248
END IF ARS1F404.249
ARS1F404.250
!L----Check UZ requested at same time as Z and u----------------------- ARS1F404.251
ARS1F404.252
UZ_P_LEVS=1 ARS1F404.253
IF (SF(239,15)) THEN ARS1F404.254
IF ((.NOT.SF(238,15)).OR.(.NOT.SF(201,15))) THEN ARS1F404.255
CMESSAGE='ST_DIAG1 : UZ error Z and U must be requested' ARS1F404.256
ICODE=1 ARS1F404.257
GOTO 999 ARS1F404.258
ELSE ARS1F404.259
ISL=STINDEX(1,239,15,im_index) ARS1F404.260
IF(ISL.GT.0) THEN ARS1F404.261
NI=-STLIST(10,ISL) ARS1F404.262
UZ_P_LEVS=STASH_LEVELS(1,NI) ARS1F404.263
DO K =1,UZ_P_LEVS ARS1F404.264
PRESS_LEVS(K)=STASH_LEVELS(K+1,NI)/1000.0 ARS1F404.265
DO I=1,Z_P_LEVS ARS1F404.266
IF (PRESS_LEVS(K).EQ.Z_PRESS(I)) THEN ARS1F404.267
UZ_IND(K)=I ARS1F404.268
ENDIF ARS1F404.269
ENDDO ARS1F404.270
DO I=1,UCOMP_P_LEVS ARS1F404.271
IF (PRESS_LEVS(K).EQ.UCOMP_PRESS(I)) THEN ARS1F404.272
UZ_IND(UZ_P_LEVS+K)=I ARS1F404.273
ENDIF ARS1F404.274
ENDDO ARS1F404.275
ENDDO ARS1F404.276
END IF ARS1F404.277
END IF ARS1F404.278
END IF ARS1F404.279
ARS1F404.280
!L----Check VZ requested at same time as Z and v----------------------- ARS1F404.281
VZ_P_LEVS=1 ARS1F404.282
IF (SF(240,15)) THEN ARS1F404.283
IF ((.NOT.SF(238,15)).OR.(.NOT.SF(202,15))) THEN ARS1F404.284
CMESSAGE='ST_DIAG1 : vZ error Z and v must be requested' ARS1F404.285
ICODE=1 ARS1F404.286
GOTO 999 ARS1F404.287
ELSE ARS1F404.288
ISL=STINDEX(1,240,15,im_index) ARS1F404.289
IF(ISL.GT.0) THEN ARS1F404.290
NI=-STLIST(10,ISL) ARS1F404.291
VZ_P_LEVS=STASH_LEVELS(1,NI) ARS1F404.292
DO K =1,VZ_P_LEVS ARS1F404.293
PRESS_LEVS(K)=STASH_LEVELS(K+1,NI)/1000.0 ARS1F404.294
DO I=1,Z_P_LEVS ARS1F404.295
IF (PRESS_LEVS(K).EQ.Z_PRESS(I)) THEN ARS1F404.296
VZ_IND(K)=I ARS1F404.297
ENDIF ARS1F404.298
ENDDO ARS1F404.299
DO I=1,VCOMP_P_LEVS ARS1F404.300
IF (PRESS_LEVS(K).EQ.VCOMP_PRESS(I)) THEN ARS1F404.301
VZ_IND(VZ_P_LEVS+K)=I ARS1F404.302
ENDIF ARS1F404.303
ENDDO ARS1F404.304
ENDDO ARS1F404.305
END IF ARS1F404.306
END IF ARS1F404.307
END IF ARS1F404.308
ARS1F404.309
CL------------------Set up Pointers for STASHWORK ------------------- ST_DIA11.603
ST_DIA11.604
PT201=SI(201,15,im_index) GDR4F305.188
PT202=SI(202,15,im_index) GDR4F305.189
PT203=SI(203,15,im_index) GDR4F305.190
PT204=SI(204,15,im_index) GDR4F305.191
PT205=SI(205,15,im_index) GDR4F305.192
PT206=SI(206,15,im_index) GDR4F305.193
PT207=SI(207,15,im_index) GDR4F305.194
PT208=SI(208,15,im_index) GDR4F305.195
PT209=SI(209,15,im_index) GDR4F305.196
PT210=SI(210,15,im_index) GDR4F305.197
PT211=SI(211,15,im_index) GDR4F305.198
PT212=SI(212,15,im_index) GDR4F305.199
PT213=SI(213,15,im_index) GDR4F305.200
PT214=SI(214,15,im_index) GDR4F305.201
PT215=SI(215,15,im_index) GDR4F305.202
PT216=SI(216,15,im_index) GDR4F305.203
PT217=SI(217,15,im_index) GDR4F305.204
PT218=SI(218,15,im_index) GDR4F305.205
PT219=SI(219,15,im_index) GDR4F305.206
PT220=SI(220,15,im_index) GDR4F305.207
PT221=SI(221,15,im_index) GDR4F305.208
PT222=SI(222,15,im_index) GDR4F305.209
PT223=SI(223,15,im_index) GDR4F305.210
PT224=SI(224,15,im_index) GDR4F305.211
PT225=SI(225,15,im_index) GDR4F305.212
PT226=SI(226,15,im_index) GDR4F305.213
PT227=SI(227,15,im_index) GDR4F305.214
PT228=SI(228,15,im_index) GDR4F305.215
PT229=SI(229,15,im_index) GDR4F305.216
PT230=SI(230,15,im_index) GDR4F305.217
PT231=SI(231,15,im_index) GDR4F305.218
PT232=SI(232,15,im_index) GDR4F305.219
PT233=SI(233,15,im_index) GDR4F305.220
PT234=SI(234,15,im_index) GDR4F305.221
PT235=SI(235,15,im_index) ARS1F404.310
PT236=SI(236,15,im_index) ARS1F404.311
PT237=SI(237,15,im_index) ARS1F404.312
PT238=SI(238,15,im_index) ARS1F404.313
PT239=SI(239,15,im_index) ARS1F404.314
PT240=SI(240,15,im_index) ARS1F404.315
PT241=SI(241,15,im_index) ARS1F404.316
ST_DIA11.634
! Initialise STASHWORK array because DYN_DIAG does not initialise halos GSM1F405.451
!* DIR$ CACHE_BYPASS STASHWORK GSM1F405.452
DO I=1,INT15 GSM1F405.453
STASHWORK(I)=0. GSM1F405.454
ENDDO GSM1F405.455
GSM1F405.456
IF(LTIMER) THEN ST_DIA11.635
CALL TIMER('DYN_DIAG',3) ST_DIA11.636
END IF ST_DIA11.637
C Set flags to control wind rotation according to whether ELF grid ST_DIA11.638
IF(ELF) THEN ! ELF Grid RR250193.91
ROTATE_UV=.TRUE. ST_DIA11.640
ROTATE_MAX_UV=.TRUE. ST_DIA11.641
ELSE ST_DIA11.642
ROTATE_UV=.FALSE. ST_DIA11.643
ROTATE_MAX_UV=.FALSE. ST_DIA11.644
ENDIF ST_DIA11.645
NMOST_LAT=A_REALHD(3) ST_DIA11.646
WMOST_LONG=A_REALHD(4) ST_DIA11.647
NS_SPACE=A_REALHD(2) ST_DIA11.648
EW_SPACE=A_REALHD(1) ST_DIA11.649
PHI_POLE=A_REALHD(5) ST_DIA11.650
LAMBDA_POLE=A_REALHD(6) ST_DIA11.651
LAT_STEP_INVERSE = RECIP_PI_OVER_180/A_REALHD(2) AL011193.3
LONG_STEP_INVERSE = RECIP_PI_OVER_180/A_REALHD(1) AL011193.4
n_levels=p_levels-1 TD141293.97
C ST_DIA11.654
CALL DYN_DIAG ( ST_DIA11.655
*CALL ARGFLDPT GSM1F405.457
C Primary data in ST_DIA11.656
& D1(JPSTAR),D1(JU(1)),D1(JV(1)), ST_DIA11.657
& D1(JQ(1)),D1(JTHETA(1)),D1(JOROG),D1(JP_EXNER(1)),PSTAR_OLD, ST_DIA11.658
ST_DIA11.659
C Primary data constants ST_DIA11.660
ST_DIA11.661
& U_ROWS,P_ROWS,ROW_LENGTH,P_LEVELS,Q_LEVELS,P_FIELD,U_FIELD, ST_DIA11.662
& A_LEVDEPC(JAK),A_LEVDEPC(JBK),AKH,BKH,A_LEVDEPC(JDELTA_AK), ST_DIA11.663
& A_LEVDEPC(JDELTA_BK),NMOST_LAT,WMOST_LONG,NS_SPACE,EW_SPACE, ST_DIA11.664
& PHI_POLE,LAMBDA_POLE,SEC_U_LATITUDE,ROTATE_UV,ROTATE_MAX_UV, ST_DIA11.665
& ELF,ETA_MATRIX_INV,MATRIX_POLY_ORDER,LAT_STEP_INVERSE, RR250193.92
& LONG_STEP_INVERSE,SECS_PER_STEPim(atmos_im),SEC_P_LATITUDE, ADR1F305.220
& COS_U_LATITUDE,F3,FORECAST_HRS, ADR1F305.221
ST_DIA11.671
C Required Thetas ST_DIA11.672
MM180193.136
& PV_THETA,PV_PRESS,THETA_ON_PV,REQ_THETA_PV_LEVS, MM180193.137
& n_levels, TD141293.96
RR250193.94
C Required Pressure levels RR250193.95
RR250193.96
& UCOMP_PRESS,VCOMP_PRESS,CAT_PROB_PRESS,T_PRESS,W_PRESS,Q_PRESS, ST_DIA11.674
& TESTD_PRESS,HEAVY_PRESS,Z_PRESS, ARS1F404.317
ST_DIA11.675
C Required Model levels RR250193.98
RR250193.99
& TESTD_MODEL, RR250193.100
RR250193.101
C pressure indices ST_DIA11.676
ST_DIA11.677
& UV_IND,UT_IND,VT_IND,T2_IND,U2_IND,V2_IND,WT_IND,WU_IND, ST_DIA11.678
& WV_IND,QU_IND,QV_IND,QW_IND,UZ_IND,VZ_IND, ARS1F404.318
ST_DIA11.680
C DIAGNOSTICS OUT ST_DIA11.681
ST_DIA11.682
& STASHWORK(PT201),STASHWORK(PT202),STASHWORK(PT203), ST_DIA11.683
& STASHWORK(PT204),STASHWORK(PT205),STASHWORK(PT206), ST_DIA11.684
& STASHWORK(PT207),STASHWORK(PT208),STASHWORK(PT209), ST_DIA11.685
& STASHWORK(PT210),STASHWORK(PT211),STASHWORK(PT212), ST_DIA11.686
& STASHWORK(PT213),STASHWORK(PT214), ST_DIA11.687
& STASHWORK(PT215),STASHWORK(PT216), ST_DIA11.688
& STASHWORK(PT217),STASHWORK(PT218),STASHWORK(PT219), ST_DIA11.689
& STASHWORK(PT220),STASHWORK(PT221),STASHWORK(PT222), ST_DIA11.690
& STASHWORK(PT223),STASHWORK(PT224),STASHWORK(PT225), ST_DIA11.691
& STASHWORK(PT226),STASHWORK(PT227),STASHWORK(PT228), ST_DIA11.692
& STASHWORK(PT229),STASHWORK(PT230), MM180193.138
& STASHWORK(PT231),STASHWORK(PT232),STASHWORK(PT233), RR250193.102
& STASHWORK(PT234), RR250193.103
& STASHWORK(PT235),STASHWORK(PT236),STASHWORK(PT237), ARS1F404.319
& STASHWORK(PT238),STASHWORK(PT239),STASHWORK(PT240), ARS1F404.320
& STASHWORK(PT241), ARS1F404.321
ST_DIA11.693
C Diagnostic length ST_DIA11.694
ST_DIA11.695
& UCOMP_P_LEVS,VCOMP_P_LEVS,CAT_PROB_LEVS,PV_THETA_LEVS, ST_DIA11.696
& PV_PRESS_LEVS,THETA_ON_PV_LEVS,THETA_PV_P_LEVS, MM180193.139
& UV_P_LEVS,T_P_LEVS, ST_DIA11.697
& UT_P_LEVS,VT_P_LEVS,T2_P_LEVS,U2_P_LEVS,V2_P_LEVS,w_P_LEVS, ST_DIA11.698
& WT_P_LEVS,WU_P_LEVS,WV_P_LEVS,Q_P_LEVS,QU_P_LEVS,QV_P_LEVS, ST_DIA11.699
& TESTD_P_LEVS,TESTD_M_LEVS, RR250193.104
& QW_P_LEVS,HEAVY_P_LEVS,Z_P_LEVS,UZ_P_LEVS,VZ_P_LEVS, ARS1F404.322
ST_DIA11.700
C Diagnostic logical indicators ST_DIA11.701
ST_DIA11.702
& SF(201,15),SF(202,15),SF(203,15),SF(204,15),SF(205,15), ST_DIA11.703
& SF(206,15),SF(207,15),SF(208,15),SF(209,15),SF(210,15), ST_DIA11.704
& SF(211,15),SF(212,15),SF(213,15),SF(214,15), ST_DIA11.705
& SF(215,15),SF(216,15), ST_DIA11.706
& SF(217,15),SF(218,15),SF(219,15),SF(220,15),SF(221,15), ST_DIA11.707
& SF(222,15),SF(223,15),SF(224,15),SF(225,15),SF(226,15), ST_DIA11.708
& SF(227,15),SF(228,15),SF(229,15),SF(230,15), MM180193.140
& SF(231,15),SF(232,15),SF(233,15),SF(234,15), RR250193.105
& SF(235,15),SF(236,15),SF(237,15),SF(238,15),SF(239,15), ARS1F404.323
& SF(240,15),SF(241,15), ARS1F404.324
& LEVNO_PMSL_CALC, GDR3F404.5
ST_DIA11.710
C Diagnostic return code and message ST_DIA11.711
ST_DIA11.712
& ICODE,CMESSAGE, GSS1F304.204
GSS1F304.205
C Logical switch for linear TS calc GSS1F304.206
GSS1F304.207
& LLINTS) GSS1F304.208
ST_DIA11.714
IF(LTIMER) THEN ST_DIA11.715
CALL TIMER('DYN_DIAG',4) ST_DIA11.716
END IF ST_DIA11.717
ST_DIA11.718
ST_DIA11.719
IF(LTIMER) THEN ST_DIA11.720
CALL TIMER('STASH ',3) ST_DIA11.721
END IF ST_DIA11.722
ST_DIA11.723
IF(ICODE.NE.0) THEN ST_DIA11.724
RETURN ST_DIA11.725
ENDIF ST_DIA11.726
ST_DIA11.727
CALL STASH(a_sm,a_im,15,STASHWORK, GKR0F305.994
*CALL ARGSIZE @DYALLOC.182
*CALL ARGD1 @DYALLOC.183
*CALL ARGDUMA @DYALLOC.184
*CALL ARGDUMO @DYALLOC.185
*CALL ARGDUMW GKR1F401.268
*CALL ARGSTS @DYALLOC.186
*CALL ARGPPX GKR0F305.995
& ICODE,CMESSAGE) @DYALLOC.190
ST_DIA11.729
IF(LTIMER) THEN ST_DIA11.730
CALL TIMER('STASH ',4) ST_DIA11.731
END IF ST_DIA11.732
ST_DIA11.733
999 CONTINUE ST_DIA11.734
RETURN ST_DIA11.735
END ST_DIA11.736
*ENDIF ST_DIA11.737