SUBROUTINE INITDIAG( 1,3@DYALLOC.1448
*CALL ARGSIZE 
@DYALLOC.1449
*CALL ARGD1 @DYALLOC.1450
*CALL ARGDUMA @DYALLOC.1451
*CALL ARGDUMO @DYALLOC.1452
*CALL ARGDUMW GKR1F401.212
*CALL ARGSTS @DYALLOC.1453
*CALL ARGPTRA @DYALLOC.1454
*CALL ARGPTRO @DYALLOC.1455
*CALL ARGCONA @DYALLOC.1456
*CALL ARGPPX GKR0F305.939
& P_FIELDDA, NF171193.44
& ICODE,CMESSAGE) @DYALLOC.1457
INITDIA1.28
C* INITDIA1.29
IMPLICIT NONE INITDIA1.30
C*L INITDIA1.31
*CALL CMAXSIZE @DYALLOC.1458
*CALL CSUBMODL GSS1F305.929
*CALL TYPSIZE @DYALLOC.1459
*CALL TYPD1 @DYALLOC.1460
*CALL TYPDUMA @DYALLOC.1461
*CALL TYPDUMO @DYALLOC.1462
*CALL TYPDUMW GKR1F401.213
*CALL TYPSTS @DYALLOC.1463
*CALL TYPPTRA @DYALLOC.1464
*CALL TYPPTRO @DYALLOC.1465
*CALL TYPCONA @DYALLOC.1466
*CALL TYPFLDPT GSM1F405.506
*CALL PPXLOOK GKR0F305.940
*IF DEF,MPP GSM1F405.507
*CALL PARVARS GSM1F405.508
*ENDIF GSM1F405.509
INITDIA1.32
INTEGER INITDIA1.33
& P_FIELDDA, ! IN : copy of P_FIELD for portable DA NF171193.45
& ICODE ! Out return code : 0 Normal exit @DYALLOC.1467
C ! : >0 Error exit INITDIA1.35
INITDIA1.38
CHARACTER*80 TS150793.80
& CMESSAGE ! Out error message if ICODE > 0 INITDIA1.40
INITDIA1.41
@DYALLOC.1468
CL External subroutines called INITDIA1.46
INITDIA1.47
EXTERNAL INITDIA1.48
& ST_DIAG1, INITDIA1.49
& ST_DIAG2, INITDIA1.50
& STASH INITDIA1.51
INITDIA1.52
CL local variables INITDIA1.53
INTEGER INITDIA1.54
& ISL,K,I,NI,COUNT INITDIA1.55
& ,NI_U,NI_V,NI_T,NI_W,NI_H,NI_q INITDIA1.56
& ,U_PLEV ! number of u pressure levels INITDIA1.57
& ,V_PLEV ! Number of V pressure levels INITDIA1.58
& ,T_PLEV ! number of T pressure levels INITDIA1.59
& ,W_PLEV ! number of w pressure levels INITDIA1.60
& ,H_PLEV ! number of height pressure levels INITDIA1.61
& ,Q_PLEV ! number of q pressure levels INITDIA1.62
& ,NUM_LEVELS ! number of pressure levels INITDIA1.63
& ,im_ident ! Internal Model Identifier GDR4F305.93
& ,im_index ! Internal Model Index for stash arrays GDR4F305.94
INITDIA1.64
REAL INITDIA1.65
& PSTAR_OLD(P_FIELDDA) ! array to hold old value of Pstar NF171193.46
INITDIA1.67
CL -------------------------------------------------------------------- INITDIA1.68
INITDIA1.69
*CALL SETFLDPT GSM1F405.510
GSM1F405.511
! Set to atmosphere internal model GDR4F305.95
im_ident = atmos_im GDR4F305.96
im_index = internal_model_index(im_ident) GDR4F305.97
GDR4F305.98
CALL STASH(a_sm,a_im,0,D1, GKR0F305.941
*CALL ARGSIZE @DYALLOC.1470
*CALL ARGD1 @DYALLOC.1471
*CALL ARGDUMA @DYALLOC.1472
*CALL ARGDUMO @DYALLOC.1473
*CALL ARGDUMW GKR1F401.214
*CALL ARGSTS @DYALLOC.1474
*CALL ARGPPX GKR0F305.942
& ICODE,CMESSAGE) @DYALLOC.1478
INITDIA1.71
C Check diagnostics and their levels are consistent now. INITDIA1.72
C This should reduce need to check this on all subsequent calls to INITDIA1.73
C ST_DIAG1. INITDIA1.74
C 15,201 U_COMP on pressure levels INITDIA1.75
ISL=STINDEX(1,201,15,im_index) GDR4F305.99
IF(ISL.GT.0) THEN INITDIA1.77
IF (STLIST(10,ISL).LT.0) THEN INITDIA1.78
IF (STLIST(11,ISL).NE.2) THEN INITDIA1.79
CMESSAGE='INITDIA: Level not pressure for U_COMP' INITDIA1.80
ICODE=1 INITDIA1.81
GOTO 99 INITDIA1.82
ELSE INITDIA1.83
NI_U = -STLIST(10,ISL) INITDIA1.84
U_PLEV=STASH_LEVELS(1,NI_U) INITDIA1.85
ENDIF INITDIA1.86
ELSE INITDIA1.87
CMESSAGE='INITDIA: Level not a levels list for U_COMP' INITDIA1.88
ICODE=1 INITDIA1.89
GOTO 99 INITDIA1.90
ENDIF INITDIA1.91
ENDIF INITDIA1.92
C 15,202 V_COMP on pressure levels INITDIA1.93
ISL=STINDEX(1,202,15,im_index) GDR4F305.100
IF(ISL.GT.0) THEN INITDIA1.95
IF (STLIST(10,ISL).LT.0) THEN INITDIA1.96
IF (STLIST(11,ISL).NE.2) THEN INITDIA1.97
CMESSAGE='INITDIA: Level not pressure for V_COMP' INITDIA1.98
ICODE=1 INITDIA1.99
GOTO 99 INITDIA1.100
ELSE INITDIA1.101
NI_V = -STLIST(10,ISL) INITDIA1.102
V_PLEV=STASH_LEVELS(1,NI_V) INITDIA1.103
ENDIF INITDIA1.104
ELSE INITDIA1.105
CMESSAGE='INITDIA: Level not a levels list for V_COMP' INITDIA1.106
ICODE=1 INITDIA1.107
GOTO 99 INITDIA1.108
ENDIF INITDIA1.109
ENDIF INITDIA1.110
C 15,205 cat_prob_single pressure levels INITDIA1.111
ISL=STINDEX(1,205,15,im_index) GDR4F305.101
IF(ISL.GT.0) THEN INITDIA1.113
IF (STLIST(10,ISL).LT.0) THEN INITDIA1.114
IF (STLIST(11,ISL).NE.2) THEN INITDIA1.115
CMESSAGE='INITDIA: Level not pressure for CAT_PROB_SINGLE' INITDIA1.116
ICODE=1 INITDIA1.117
GOTO 99 INITDIA1.118
ENDIF INITDIA1.119
ELSE INITDIA1.120
CMESSAGE='INITDIA: Level not a levels list for CAT_PROB_SINGLE' INITDIA1.121
ICODE=1 INITDIA1.122
GOTO 99 INITDIA1.123
ENDIF INITDIA1.124
ENDIF INITDIA1.125
C 15,216 Temperature on pressure levels INITDIA1.126
ISL=STINDEX(1,216,15,im_index) GDR4F305.102
IF(ISL.GT.0) THEN INITDIA1.128
IF (STLIST(10,ISL).LT.0) THEN INITDIA1.129
IF (STLIST(11,ISL).NE.2) THEN INITDIA1.130
CMESSAGE='INITDIA: Level not pressure for T' INITDIA1.131
ICODE=1 INITDIA1.132
GOTO 99 INITDIA1.133
ELSE INITDIA1.134
NI_T = -STLIST(10,ISL) INITDIA1.135
T_PLEV=STASH_LEVELS(1,NI_T) INITDIA1.136
ENDIF INITDIA1.137
ELSE INITDIA1.138
CMESSAGE='INITDIA: Level not a levels list for T' INITDIA1.139
ICODE=1 INITDIA1.140
GOTO 99 INITDIA1.141
ENDIF INITDIA1.142
ENDIF INITDIA1.143
C 15,222 Omega on pressure levels INITDIA1.144
ISL=STINDEX(1,222,15,im_index) GDR4F305.103
IF(ISL.GT.0) THEN INITDIA1.146
IF (STLIST(10,ISL).LT.0) THEN INITDIA1.147
IF (STLIST(11,ISL).NE.2) THEN INITDIA1.148
CMESSAGE='INITDIA: Level not pressure for omega' INITDIA1.149
ICODE=1 INITDIA1.150
GOTO 99 INITDIA1.151
ELSE INITDIA1.152
NI_w = -STLIST(10,ISL) INITDIA1.153
w_PLEV=STASH_LEVELS(1,NI_w) INITDIA1.154
ENDIF INITDIA1.155
ELSE INITDIA1.156
CMESSAGE='INITDIA: Level not a levels list for omega' INITDIA1.157
ICODE=1 INITDIA1.158
GOTO 99 INITDIA1.159
ENDIF INITDIA1.160
ENDIF INITDIA1.161
C 15,226 Specific Humidity on pressure levels INITDIA1.162
ISL=STINDEX(1,226,15,im_index) GDR4F305.104
IF(ISL.GT.0) THEN INITDIA1.164
IF (STLIST(10,ISL).LT.0) THEN INITDIA1.165
IF (STLIST(11,ISL).NE.2) THEN INITDIA1.166
CMESSAGE='INITDIA: Level not pressure for Specific humidity' INITDIA1.167
ICODE=1 INITDIA1.168
GOTO 99 INITDIA1.169
ELSE INITDIA1.170
NI_Q = -STLIST(10,ISL) INITDIA1.171
Q_PLEV=STASH_LEVELS(1,NI_Q) INITDIA1.172
ENDIF INITDIA1.173
ELSE INITDIA1.174
CMESSAGE='INITDIA: Level not pressure for Specific humidity' INITDIA1.175
ICODE=1 INITDIA1.176
GOTO 99 INITDIA1.177
ENDIF INITDIA1.178
ENDIF INITDIA1.179
! 15,236 Heavyside function on pressure levels ARS1F404.348
ISL=STINDEX(1,236,15,im_index) ARS1F404.349
IF(ISL.GT.0) THEN ARS1F404.350
IF (STLIST(10,ISL).LT.0) THEN ARS1F404.351
IF (STLIST(11,ISL).NE.2) THEN ARS1F404.352
CMESSAGE='INITDIA:Level not pressure for Heavyside function' ARS1F404.353
ICODE=1 ARS1F404.354
GOTO 99 ARS1F404.355
ENDIF ARS1F404.356
ELSE ARS1F404.357
CMESSAGE='INITDIA:Level not pressure for Heavyside function' ARS1F404.358
ICODE=1 ARS1F404.359
GOTO 99 ARS1F404.360
ENDIF ARS1F404.361
ENDIF ARS1F404.362
! 15,238 geopotential height on u grid ARS1F404.363
ISL=STINDEX(1,238,15,im_index) ARS1F404.364
IF(ISL.GT.0) THEN ARS1F404.365
IF (STLIST(10,ISL).LT.0) THEN ARS1F404.366
IF (STLIST(11,ISL).NE.2) THEN ARS1F404.367
CMESSAGE='INITDIA:Level not pressure for geopotential' ARS1F404.368
ICODE=1 ARS1F404.369
GOTO 99 ARS1F404.370
ELSE ARS1F404.371
NI_H = -STLIST(10,ISL) ARS1F404.372
H_PLEV=STASH_LEVELS(1,NI_H) ARS1F404.373
ENDIF ARS1F404.374
ELSE ARS1F404.375
CMESSAGE='INITDIA:Level not pressure for geopotential' ARS1F404.376
ICODE=1 ARS1F404.377
GOTO 99 ARS1F404.378
ENDIF ARS1F404.379
ENDIF ARS1F404.380
C ---------------------------------------------------------------------- INITDIA1.180
C Diagnostics with restrictive tests on their output ie for any INITDIA1.181
C product field A*B, A*B can only be requested on a subset of the INITDIA1.182
C levels requested for A and B searately. INITDIA1.183
C INITDIA1.184
C 15,215 UV on pressure levels INITDIA1.185
ISL=STINDEX(1,215,15,im_index) GDR4F305.105
IF(ISL.GT.0) THEN INITDIA1.187
IF (STLIST(10,ISL).LT.0) THEN INITDIA1.188
IF (STLIST(11,ISL).NE.2) THEN INITDIA1.189
CMESSAGE='INITDIA: Level not pressure for UV' INITDIA1.190
ICODE=1 INITDIA1.191
GOTO 99 INITDIA1.192
ELSE INITDIA1.193
NI=-STLIST(10,ISL) INITDIA1.194
NUM_LEVELS=STASH_LEVELS(1,NI) INITDIA1.195
IF (NUM_LEVELS.LE.U_PLEV.AND.NUM_LEVELS.LE.V_PLEV) THEN INITDIA1.196
COUNT=0 INITDIA1.197
DO K=1,NUM_LEVELS INITDIA1.198
DO I=1,U_PLEV INITDIA1.199
IF (STASH_LEVELS(K+1,NI).EQ. INITDIA1.200
& STASH_LEVELS(I+1,NI_U)) THEN INITDIA1.201
COUNT=COUNT+1 INITDIA1.202
ENDIF INITDIA1.203
ENDDO INITDIA1.204
DO I=1,V_PLEV INITDIA1.205
IF (STASH_LEVELS(K+1,NI).EQ. INITDIA1.206
& STASH_LEVELS(I+1,NI_V)) THEN INITDIA1.207
COUNT=COUNT+1 INITDIA1.208
ENDIF INITDIA1.209
ENDDO INITDIA1.210
ENDDO INITDIA1.211
IF (COUNT.NE.2*NUM_LEVELS) THEN INITDIA1.212
CMESSAGE='INITDIA: UV must be on a subset of U and V leve INITDIA1.213
&ls' INITDIA1.214
ICODE=1 INITDIA1.215
GOTO 99 INITDIA1.216
ENDIF INITDIA1.217
ELSE INITDIA1.218
CMESSAGE='INITDIA: UV must be on a subset of U and V leve INITDIA1.219
&ls' INITDIA1.220
ICODE=1 INITDIA1.221
GOTO 99 INITDIA1.222
ENDIF INITDIA1.223
ENDIF INITDIA1.224
ELSE INITDIA1.225
CMESSAGE='INITDIA: Level not a levels list for UV' INITDIA1.226
ICODE=1 INITDIA1.227
GOTO 99 INITDIA1.228
ENDIF INITDIA1.229
ENDIF INITDIA1.230
INITDIA1.231
C 15,217 UT on pressure levels INITDIA1.232
ISL=STINDEX(1,217,15,im_index) GDR4F305.106
IF(ISL.GT.0) THEN INITDIA1.234
IF (STLIST(10,ISL).LT.0) THEN INITDIA1.235
IF (STLIST(11,ISL).NE.2) THEN INITDIA1.236
CMESSAGE='INITDIA: Level not pressure for UT' INITDIA1.237
ICODE=1 INITDIA1.238
GOTO 99 INITDIA1.239
ELSE INITDIA1.240
NI=-STLIST(10,ISL) INITDIA1.241
NUM_LEVELS=STASH_LEVELS(1,NI) INITDIA1.242
IF (NUM_LEVELS.LE.U_PLEV.AND.NUM_LEVELS.LE.T_PLEV) THEN INITDIA1.243
COUNT=0 INITDIA1.244
DO K=1,NUM_LEVELS INITDIA1.245
DO I=1,U_PLEV INITDIA1.246
IF (STASH_LEVELS(K+1,NI).EQ. INITDIA1.247
& STASH_LEVELS(I+1,NI_U)) THEN INITDIA1.248
COUNT=COUNT+1 INITDIA1.249
ENDIF INITDIA1.250
ENDDO INITDIA1.251
DO I=1,T_PLEV INITDIA1.252
IF (STASH_LEVELS(K+1,NI).EQ. INITDIA1.253
& STASH_LEVELS(I+1,NI_T)) THEN INITDIA1.254
COUNT=COUNT+1 INITDIA1.255
ENDIF INITDIA1.256
ENDDO INITDIA1.257
ENDDO INITDIA1.258
IF (COUNT.NE.2*NUM_LEVELS) THEN INITDIA1.259
CMESSAGE='INITDIA: UT must be on a subset of U and T leve INITDIA1.260
&ls' INITDIA1.261
ICODE=1 INITDIA1.262
GOTO 99 INITDIA1.263
ENDIF INITDIA1.264
ELSE INITDIA1.265
CMESSAGE='INITDIA: UT must be on a subset of U and T leve INITDIA1.266
&ls' INITDIA1.267
ICODE=1 INITDIA1.268
GOTO 99 INITDIA1.269
ENDIF INITDIA1.270
ENDIF INITDIA1.271
ELSE INITDIA1.272
CMESSAGE='INITDIA: Level not a levels list for UT' INITDIA1.273
ICODE=1 INITDIA1.274
GOTO 99 INITDIA1.275
ENDIF INITDIA1.276
ENDIF INITDIA1.277
INITDIA1.278
C 15,218 VT on pressure levels INITDIA1.279
ISL=STINDEX(1,218,15,im_index) GDR4F305.107
IF(ISL.GT.0) THEN INITDIA1.281
IF (STLIST(10,ISL).LT.0) THEN INITDIA1.282
IF (STLIST(11,ISL).NE.2) THEN INITDIA1.283
CMESSAGE='INITDIA: Level not pressure for VT' INITDIA1.284
ICODE=1 INITDIA1.285
GOTO 99 INITDIA1.286
ELSE INITDIA1.287
NI=-STLIST(10,ISL) INITDIA1.288
NUM_LEVELS=STASH_LEVELS(1,NI) INITDIA1.289
IF (NUM_LEVELS.LE.V_PLEV.AND.NUM_LEVELS.LE.T_PLEV) THEN INITDIA1.290
COUNT=0 INITDIA1.291
DO K=1,NUM_LEVELS INITDIA1.292
DO I=1,V_PLEV INITDIA1.293
IF (STASH_LEVELS(K+1,NI).EQ. INITDIA1.294
& STASH_LEVELS(I+1,NI_V)) THEN INITDIA1.295
COUNT=COUNT+1 INITDIA1.296
ENDIF INITDIA1.297
ENDDO INITDIA1.298
DO I=1,T_PLEV INITDIA1.299
IF (STASH_LEVELS(K+1,NI).EQ. INITDIA1.300
& STASH_LEVELS(I+1,NI_T)) THEN INITDIA1.301
COUNT=COUNT+1 INITDIA1.302
ENDIF INITDIA1.303
ENDDO INITDIA1.304
ENDDO INITDIA1.305
IF (COUNT.NE.2*NUM_LEVELS) THEN INITDIA1.306
CMESSAGE='INITDIA: VT must be on a subset of V and T leve INITDIA1.307
&ls' INITDIA1.308
ICODE=1 INITDIA1.309
GOTO 99 INITDIA1.310
ENDIF INITDIA1.311
ELSE INITDIA1.312
CMESSAGE='INITDIA: VT must be on a subset of V and T leve INITDIA1.313
&ls' INITDIA1.314
ICODE=1 INITDIA1.315
GOTO 99 INITDIA1.316
ENDIF INITDIA1.317
ENDIF INITDIA1.318
ELSE INITDIA1.319
CMESSAGE='INITDIA: Level not a levels list for VT' INITDIA1.320
ICODE=1 INITDIA1.321
GOTO 99 INITDIA1.322
ENDIF INITDIA1.323
ENDIF INITDIA1.324
INITDIA1.325
C 15,219 T2 on pressure levels INITDIA1.326
ISL=STINDEX(1,219,15,im_index) GDR4F305.108
IF(ISL.GT.0) THEN INITDIA1.328
IF (STLIST(10,ISL).LT.0) THEN INITDIA1.329
IF (STLIST(11,ISL).NE.2) THEN INITDIA1.330
CMESSAGE='INITDIA: Level not pressure for T2' INITDIA1.331
ICODE=1 INITDIA1.332
GOTO 99 INITDIA1.333
ELSE INITDIA1.334
NI=-STLIST(10,ISL) INITDIA1.335
NUM_LEVELS=STASH_LEVELS(1,NI) INITDIA1.336
IF (NUM_LEVELS.LE.T_PLEV) THEN INITDIA1.337
COUNT=0 INITDIA1.338
DO K=1,NUM_LEVELS INITDIA1.339
DO I=1,T_PLEV INITDIA1.340
IF (STASH_LEVELS(K+1,NI).EQ. INITDIA1.341
& STASH_LEVELS(I+1,NI_T)) THEN INITDIA1.342
COUNT=COUNT+1 INITDIA1.343
ENDIF INITDIA1.344
ENDDO INITDIA1.345
ENDDO INITDIA1.346
IF (COUNT.NE.NUM_LEVELS) THEN INITDIA1.347
CMESSAGE='INITDIA: T**2 must be on a subset of T levels' INITDIA1.348
ICODE=1 INITDIA1.349
GOTO 99 INITDIA1.350
ENDIF INITDIA1.351
ELSE INITDIA1.352
CMESSAGE='INITDIA: T**2 must be on a subset of T levels' INITDIA1.353
ICODE=1 INITDIA1.354
GOTO 99 INITDIA1.355
ENDIF INITDIA1.356
ENDIF INITDIA1.357
ELSE INITDIA1.358
CMESSAGE='INITDIA: Level not a levels list for T2' INITDIA1.359
ICODE=1 INITDIA1.360
GOTO 99 INITDIA1.361
ENDIF INITDIA1.362
ENDIF INITDIA1.363
INITDIA1.364
C 15,220 U2 on pressure levels INITDIA1.365
ISL=STINDEX(1,220,15,im_index) GDR4F305.109
IF(ISL.GT.0) THEN INITDIA1.367
IF (STLIST(10,ISL).LT.0) THEN INITDIA1.368
IF (STLIST(11,ISL).NE.2) THEN INITDIA1.369
CMESSAGE='INITDIA: Level not pressure for U2' INITDIA1.370
ICODE=1 INITDIA1.371
GOTO 99 INITDIA1.372
ELSE INITDIA1.373
NI=-STLIST(10,ISL) INITDIA1.374
NUM_LEVELS=STASH_LEVELS(1,NI) INITDIA1.375
IF (NUM_LEVELS.LE.U_PLEV) THEN INITDIA1.376
COUNT=0 INITDIA1.377
DO K=1,NUM_LEVELS INITDIA1.378
DO I=1,U_PLEV INITDIA1.379
IF (STASH_LEVELS(K+1,NI).EQ. INITDIA1.380
& STASH_LEVELS(I+1,NI_U)) THEN INITDIA1.381
COUNT=COUNT+1 INITDIA1.382
ENDIF INITDIA1.383
ENDDO INITDIA1.384
ENDDO INITDIA1.385
IF (COUNT.NE.NUM_LEVELS) THEN INITDIA1.386
CMESSAGE='INITDIA: U**2 must be on a subset of U levels' INITDIA1.387
ICODE=1 INITDIA1.388
GOTO 99 INITDIA1.389
ENDIF INITDIA1.390
ELSE INITDIA1.391
CMESSAGE='INITDIA: U**2 must be on a subset of U levels' INITDIA1.392
ICODE=1 INITDIA1.393
GOTO 99 INITDIA1.394
ENDIF INITDIA1.395
ENDIF INITDIA1.396
ELSE INITDIA1.397
CMESSAGE='INITDIA: Level not a levels list for U2' INITDIA1.398
ICODE=1 INITDIA1.399
GOTO 99 INITDIA1.400
ENDIF INITDIA1.401
ENDIF INITDIA1.402
INITDIA1.403
C 15,221 V2 on pressure levels INITDIA1.404
ISL=STINDEX(1,221,15,im_index) GDR4F305.110
IF(ISL.GT.0) THEN INITDIA1.406
IF (STLIST(10,ISL).LT.0) THEN INITDIA1.407
IF (STLIST(11,ISL).NE.2) THEN INITDIA1.408
CMESSAGE='INITDIA: Level not pressure for V2' INITDIA1.409
ICODE=1 INITDIA1.410
GOTO 99 INITDIA1.411
ELSE INITDIA1.412
NI=-STLIST(10,ISL) INITDIA1.413
NUM_LEVELS=STASH_LEVELS(1,NI) INITDIA1.414
IF (NUM_LEVELS.LE.V_PLEV) THEN INITDIA1.415
COUNT=0 INITDIA1.416
DO K=1,NUM_LEVELS INITDIA1.417
DO I=1,V_PLEV INITDIA1.418
IF (STASH_LEVELS(K+1,NI).EQ. INITDIA1.419
& STASH_LEVELS(I+1,NI_V)) THEN INITDIA1.420
COUNT=COUNT+1 INITDIA1.421
ENDIF INITDIA1.422
ENDDO INITDIA1.423
ENDDO INITDIA1.424
IF (COUNT.NE.NUM_LEVELS) THEN INITDIA1.425
CMESSAGE='INITDIA: V**2 must be on a subset of V levels' INITDIA1.426
ICODE=1 INITDIA1.427
GOTO 99 INITDIA1.428
ENDIF INITDIA1.429
ELSE INITDIA1.430
CMESSAGE='INITDIA: V**2 must be on a subset of V levels' INITDIA1.431
ICODE=1 INITDIA1.432
GOTO 99 INITDIA1.433
ENDIF INITDIA1.434
ENDIF INITDIA1.435
ELSE INITDIA1.436
CMESSAGE='INITDIA: Level not a levels list for V2' INITDIA1.437
ICODE=1 INITDIA1.438
GOTO 99 INITDIA1.439
ENDIF INITDIA1.440
ENDIF INITDIA1.441
INITDIA1.442
C 15,223 wT on pressure levels INITDIA1.443
ISL=STINDEX(1,223,15,im_index) GDR4F305.111
IF(ISL.GT.0) THEN INITDIA1.445
IF (STLIST(10,ISL).LT.0) THEN INITDIA1.446
IF (STLIST(11,ISL).NE.2) THEN INITDIA1.447
CMESSAGE='INITDIA: Level not pressure for wT' INITDIA1.448
ICODE=1 INITDIA1.449
GOTO 99 INITDIA1.450
ELSE INITDIA1.451
NI=-STLIST(10,ISL) INITDIA1.452
NUM_LEVELS=STASH_LEVELS(1,NI) INITDIA1.453
IF (NUM_LEVELS.LE.w_PLEV.AND.NUM_LEVELS.LE.T_PLEV) THEN INITDIA1.454
COUNT=0 INITDIA1.455
DO K=1,NUM_LEVELS INITDIA1.456
DO I=1,W_PLEV INITDIA1.457
IF (STASH_LEVELS(K+1,NI).EQ. INITDIA1.458
& STASH_LEVELS(I+1,NI_W)) THEN INITDIA1.459
COUNT=COUNT+1 INITDIA1.460
ENDIF INITDIA1.461
ENDDO INITDIA1.462
DO I=1,T_PLEV INITDIA1.463
IF (STASH_LEVELS(K+1,NI).EQ. INITDIA1.464
& STASH_LEVELS(I+1,NI_T)) THEN INITDIA1.465
COUNT=COUNT+1 INITDIA1.466
ENDIF INITDIA1.467
ENDDO INITDIA1.468
ENDDO INITDIA1.469
IF (COUNT.NE.2*NUM_LEVELS) THEN INITDIA1.470
CMESSAGE='INITDIA: wT must be on a subset of w and T leve INITDIA1.471
&ls' INITDIA1.472
ICODE=1 INITDIA1.473
GOTO 99 INITDIA1.474
ENDIF INITDIA1.475
ELSE INITDIA1.476
CMESSAGE='INITDIA: wT must be on a subset of w and T leve INITDIA1.477
&ls' INITDIA1.478
ICODE=1 INITDIA1.479
GOTO 99 INITDIA1.480
ENDIF INITDIA1.481
ENDIF INITDIA1.482
ELSE INITDIA1.483
CMESSAGE='INITDIA: Level not a levels list for wT' INITDIA1.484
ICODE=1 INITDIA1.485
GOTO 99 INITDIA1.486
ENDIF INITDIA1.487
ENDIF INITDIA1.488
INITDIA1.489
C 15,224 wU on pressure levels INITDIA1.490
ISL=STINDEX(1,224,15,im_index) GDR4F305.112
IF(ISL.GT.0) THEN INITDIA1.492
IF (STLIST(10,ISL).LT.0) THEN INITDIA1.493
IF (STLIST(11,ISL).NE.2) THEN INITDIA1.494
CMESSAGE='INITDIA: Level not pressure for wU' INITDIA1.495
ICODE=1 INITDIA1.496
GOTO 99 INITDIA1.497
ELSE INITDIA1.498
NI=-STLIST(10,ISL) INITDIA1.499
NUM_LEVELS=STASH_LEVELS(1,NI) INITDIA1.500
IF (NUM_LEVELS.LE.w_PLEV.AND.NUM_LEVELS.LE.U_PLEV) THEN INITDIA1.501
COUNT=0 INITDIA1.502
DO K=1,NUM_LEVELS INITDIA1.503
DO I=1,W_PLEV INITDIA1.504
IF (STASH_LEVELS(K+1,NI).EQ. INITDIA1.505
& STASH_LEVELS(I+1,NI_W)) THEN INITDIA1.506
COUNT=COUNT+1 INITDIA1.507
ENDIF INITDIA1.508
ENDDO INITDIA1.509
DO I=1,U_PLEV INITDIA1.510
IF (STASH_LEVELS(K+1,NI).EQ. INITDIA1.511
& STASH_LEVELS(I+1,NI_U)) THEN INITDIA1.512
COUNT=COUNT+1 INITDIA1.513
ENDIF INITDIA1.514
ENDDO INITDIA1.515
ENDDO INITDIA1.516
IF (COUNT.NE.2*NUM_LEVELS) THEN INITDIA1.517
CMESSAGE='INITDIA: wU must be on a subset of w and U leve INITDIA1.518
&ls' INITDIA1.519
ICODE=1 INITDIA1.520
GOTO 99 INITDIA1.521
ENDIF INITDIA1.522
ELSE INITDIA1.523
CMESSAGE='INITDIA: wU must be on a subset of w and U leve INITDIA1.524
&ls' INITDIA1.525
ICODE=1 INITDIA1.526
GOTO 99 INITDIA1.527
ENDIF INITDIA1.528
ENDIF INITDIA1.529
ELSE INITDIA1.530
CMESSAGE='INITDIA: Level not a levels list for wU' INITDIA1.531
ICODE=1 INITDIA1.532
GOTO 99 INITDIA1.533
ENDIF INITDIA1.534
ENDIF INITDIA1.535
INITDIA1.536
C 15,225 wV on pressure levels INITDIA1.537
ISL=STINDEX(1,225,15,im_index) GDR4F305.113
IF(ISL.GT.0) THEN INITDIA1.539
IF (STLIST(10,ISL).LT.0) THEN INITDIA1.540
IF (STLIST(11,ISL).NE.2) THEN INITDIA1.541
CMESSAGE='INITDIA: Level not pressure for wV' INITDIA1.542
ICODE=1 INITDIA1.543
GOTO 99 INITDIA1.544
ELSE INITDIA1.545
NI=-STLIST(10,ISL) INITDIA1.546
NUM_LEVELS=STASH_LEVELS(1,NI) INITDIA1.547
IF (NUM_LEVELS.LE.w_PLEV.AND.NUM_LEVELS.LE.V_PLEV) THEN INITDIA1.548
COUNT=0 INITDIA1.549
DO K=1,NUM_LEVELS INITDIA1.550
DO I=1,W_PLEV INITDIA1.551
IF (STASH_LEVELS(K+1,NI).EQ. INITDIA1.552
& STASH_LEVELS(I+1,NI_W)) THEN INITDIA1.553
COUNT=COUNT+1 INITDIA1.554
ENDIF INITDIA1.555
ENDDO INITDIA1.556
DO I=1,V_PLEV INITDIA1.557
IF (STASH_LEVELS(K+1,NI).EQ. INITDIA1.558
& STASH_LEVELS(I+1,NI_V)) THEN INITDIA1.559
COUNT=COUNT+1 INITDIA1.560
ENDIF INITDIA1.561
ENDDO INITDIA1.562
ENDDO INITDIA1.563
IF (COUNT.NE.2*NUM_LEVELS) THEN INITDIA1.564
CMESSAGE='INITDIA: wV must be on a subset of w and V leve INITDIA1.565
&ls' INITDIA1.566
ICODE=1 INITDIA1.567
GOTO 99 INITDIA1.568
ENDIF INITDIA1.569
ELSE INITDIA1.570
CMESSAGE='INITDIA: wV must be on a subset of w and V leve INITDIA1.571
&ls' INITDIA1.572
ICODE=1 INITDIA1.573
GOTO 99 INITDIA1.574
ENDIF INITDIA1.575
ENDIF INITDIA1.576
ELSE INITDIA1.577
CMESSAGE='INITDIA: Level not a levels list for wV' INITDIA1.578
ICODE=1 INITDIA1.579
GOTO 99 INITDIA1.580
ENDIF INITDIA1.581
ENDIF INITDIA1.582
INITDIA1.583
C 15,227 qU on pressure levels INITDIA1.584
ISL=STINDEX(1,227,15,im_index) GDR4F305.114
IF(ISL.GT.0) THEN INITDIA1.586
IF (STLIST(10,ISL).LT.0) THEN INITDIA1.587
IF (STLIST(11,ISL).NE.2) THEN INITDIA1.588
CMESSAGE='INITDIA: Level not pressure for qu' INITDIA1.589
ICODE=1 INITDIA1.590
GOTO 99 INITDIA1.591
ELSE INITDIA1.592
NI=-STLIST(10,ISL) INITDIA1.593
NUM_LEVELS=STASH_LEVELS(1,NI) INITDIA1.594
IF (NUM_LEVELS.LE.q_PLEV.AND.NUM_LEVELS.LE.U_PLEV) THEN INITDIA1.595
COUNT=0 INITDIA1.596
DO K=1,NUM_LEVELS INITDIA1.597
DO I=1,Q_PLEV INITDIA1.598
IF (STASH_LEVELS(K+1,NI).EQ. INITDIA1.599
& STASH_LEVELS(I+1,NI_Q)) THEN INITDIA1.600
COUNT=COUNT+1 INITDIA1.601
ENDIF INITDIA1.602
ENDDO INITDIA1.603
DO I=1,U_PLEV INITDIA1.604
IF (STASH_LEVELS(K+1,NI).EQ. INITDIA1.605
& STASH_LEVELS(I+1,NI_U)) THEN INITDIA1.606
COUNT=COUNT+1 INITDIA1.607
ENDIF INITDIA1.608
ENDDO INITDIA1.609
ENDDO INITDIA1.610
IF (COUNT.NE.2*NUM_LEVELS) THEN INITDIA1.611
CMESSAGE='INITDIA: qU must be on a subset of q and U leve INITDIA1.612
&ls' INITDIA1.613
ICODE=1 INITDIA1.614
GOTO 99 INITDIA1.615
ENDIF INITDIA1.616
ELSE INITDIA1.617
CMESSAGE='INITDIA: qU must be on a subset of q and U leve INITDIA1.618
&ls' INITDIA1.619
ICODE=1 INITDIA1.620
GOTO 99 INITDIA1.621
ENDIF INITDIA1.622
ENDIF INITDIA1.623
ELSE INITDIA1.624
CMESSAGE='INITDIA: Level not a levels list for qu' INITDIA1.625
ICODE=1 INITDIA1.626
GOTO 99 INITDIA1.627
ENDIF INITDIA1.628
ENDIF INITDIA1.629
INITDIA1.630
C 15,228 qV on pressure levels INITDIA1.631
ISL=STINDEX(1,228,15,im_index) GDR4F305.115
IF(ISL.GT.0) THEN INITDIA1.633
IF (STLIST(10,ISL).LT.0) THEN INITDIA1.634
IF (STLIST(11,ISL).NE.2) THEN INITDIA1.635
CMESSAGE='INITDIA: Level not pressure for qV' INITDIA1.636
ICODE=1 INITDIA1.637
GOTO 99 INITDIA1.638
ELSE INITDIA1.639
NI=-STLIST(10,ISL) INITDIA1.640
NUM_LEVELS=STASH_LEVELS(1,NI) INITDIA1.641
IF (NUM_LEVELS.LE.q_PLEV.AND.NUM_LEVELS.LE.V_PLEV) THEN INITDIA1.642
COUNT=0 INITDIA1.643
DO K=1,NUM_LEVELS INITDIA1.644
DO I=1,Q_PLEV INITDIA1.645
IF (STASH_LEVELS(K+1,NI).EQ. INITDIA1.646
& STASH_LEVELS(I+1,NI_Q)) THEN INITDIA1.647
COUNT=COUNT+1 INITDIA1.648
ENDIF INITDIA1.649
ENDDO INITDIA1.650
DO I=1,V_PLEV INITDIA1.651
IF (STASH_LEVELS(K+1,NI).EQ. INITDIA1.652
& STASH_LEVELS(I+1,NI_V)) THEN INITDIA1.653
COUNT=COUNT+1 INITDIA1.654
ENDIF INITDIA1.655
ENDDO INITDIA1.656
ENDDO INITDIA1.657
IF (COUNT.NE.2*NUM_LEVELS) THEN INITDIA1.658
CMESSAGE='INITDIA: qV must be on a subset of q and V leve INITDIA1.659
&ls' INITDIA1.660
ICODE=1 INITDIA1.661
GOTO 99 INITDIA1.662
ENDIF INITDIA1.663
ELSE INITDIA1.664
CMESSAGE='INITDIA: qV must be on a subset of q and V leve INITDIA1.665
&ls' INITDIA1.666
ICODE=1 INITDIA1.667
GOTO 99 INITDIA1.668
ENDIF INITDIA1.669
ENDIF INITDIA1.670
ELSE INITDIA1.671
CMESSAGE='INITDIA: Level not a levels list for qV' INITDIA1.672
ICODE=1 ARS1F404.381
GOTO 99 ARS1F404.382
ENDIF ARS1F404.383
ENDIF ARS1F404.384
ARS1F404.385
! 15,235 qw on pressure levels ARS1F404.386
ISL=STINDEX(1,235,15,im_index) ARS1F404.387
IF(ISL.GT.0) THEN ARS1F404.388
IF (STLIST(10,ISL).LT.0) THEN ARS1F404.389
IF (STLIST(11,ISL).NE.2) THEN ARS1F404.390
CMESSAGE='INITDIA: Level not pressure for qw' ARS1F404.391
ICODE=1 ARS1F404.392
GOTO 99 ARS1F404.393
ELSE ARS1F404.394
NI=-STLIST(10,ISL) ARS1F404.395
NUM_LEVELS=STASH_LEVELS(1,NI) ARS1F404.396
IF (NUM_LEVELS.LE.q_PLEV.AND.NUM_LEVELS.LE.W_PLEV) THEN ARS1F404.397
COUNT=0 ARS1F404.398
DO K=1,NUM_LEVELS ARS1F404.399
DO I=1,Q_PLEV ARS1F404.400
IF (STASH_LEVELS(K+1,NI).EQ. ARS1F404.401
& STASH_LEVELS(I+1,NI_Q)) THEN ARS1F404.402
COUNT=COUNT+1 ARS1F404.403
ENDIF ARS1F404.404
ENDDO ARS1F404.405
DO I=1,W_PLEV ARS1F404.406
IF (STASH_LEVELS(K+1,NI).EQ. ARS1F404.407
& STASH_LEVELS(I+1,NI_W)) THEN ARS1F404.408
COUNT=COUNT+1 ARS1F404.409
ENDIF ARS1F404.410
ENDDO ARS1F404.411
ENDDO ARS1F404.412
IF (COUNT.NE.2*NUM_LEVELS) THEN ARS1F404.413
CMESSAGE='INITDIA: qw must be on a subset of q and w leve ARS1F404.414
&ls' ARS1F404.415
ICODE=1 ARS1F404.416
GOTO 99 ARS1F404.417
ENDIF ARS1F404.418
ELSE ARS1F404.419
CMESSAGE='INITDIA: qw must be on a subset of q and w leve ARS1F404.420
&ls' ARS1F404.421
ICODE=1 ARS1F404.422
GOTO 99 ARS1F404.423
ENDIF ARS1F404.424
ENDIF ARS1F404.425
ELSE ARS1F404.426
CMESSAGE='INITDIA: Level not a levels list for qw' ARS1F404.427
ICODE=1 ARS1F404.428
GOTO 99 ARS1F404.429
ENDIF ARS1F404.430
ENDIF ARS1F404.431
ARS1F404.432
! 15239 - u*geopotential ARS1F404.433
ARS1F404.434
ISL=STINDEX(1,239,15,im_index) ARS1F404.435
IF(ISL.GT.0) THEN ARS1F404.436
IF (STLIST(10,ISL).LT.0) THEN ARS1F404.437
IF (STLIST(11,ISL).NE.2) THEN ARS1F404.438
CMESSAGE='INITDIA: Level not pressure for vZ' ARS1F404.439
ICODE=1 ARS1F404.440
GOTO 99 ARS1F404.441
ELSE ARS1F404.442
NI=-STLIST(10,ISL) ARS1F404.443
NUM_LEVELS=STASH_LEVELS(1,NI) ARS1F404.444
IF (NUM_LEVELS.LE.U_PLEV.AND.NUM_LEVELS.LE.H_PLEV) THEN ARS1F404.445
COUNT=0 ARS1F404.446
DO K=1,NUM_LEVELS ARS1F404.447
DO I=1,U_PLEV ARS1F404.448
IF (STASH_LEVELS(K+1,NI).EQ. STASH_LEVELS(I+1,NI_U)) THEN ARS1F404.449
COUNT=COUNT+1 ARS1F404.450
ENDIF ARS1F404.451
ENDDO ARS1F404.452
DO I=1,H_PLEV ARS1F404.453
IF (STASH_LEVELS(K+1,NI).EQ.STASH_LEVELS(I+1,NI_H)) THEN ARS1F404.454
COUNT=COUNT+1 ARS1F404.455
ENDIF ARS1F404.456
ENDDO ARS1F404.457
ENDDO ARS1F404.458
IF (COUNT.NE.2*NUM_LEVELS) THEN ARS1F404.459
CMESSAGE='INITDIA: uZ must be on a subset of u and Z levels' ARS1F404.460
ICODE=1 ARS1F404.461
GOTO 99 ARS1F404.462
ENDIF ARS1F404.463
ELSE ARS1F404.464
CMESSAGE='INITDIA: uZ must be on a subset of u and Z levels' ARS1F404.465
ICODE=1 ARS1F404.466
GOTO 99 ARS1F404.467
ENDIF ARS1F404.468
ENDIF ARS1F404.469
ELSE ARS1F404.470
CMESSAGE='INITDIA: Level not a levels list for uZ' ARS1F404.471
ICODE=1 ARS1F404.472
GOTO 99 ARS1F404.473
ENDIF ARS1F404.474
ENDIF ARS1F404.475
ARS1F404.476
! 15240 - v*geopotential ARS1F404.477
ARS1F404.478
ISL=STINDEX(1,240,15,im_index) ARS1F404.479
IF(ISL.GT.0) THEN ARS1F404.480
IF (STLIST(10,ISL).LT.0) THEN ARS1F404.481
IF (STLIST(11,ISL).NE.2) THEN ARS1F404.482
CMESSAGE='INITDIA: Level not pressure for vZ' ARS1F404.483
ICODE=1 ARS1F404.484
GOTO 99 ARS1F404.485
ELSE ARS1F404.486
NI=-STLIST(10,ISL) ARS1F404.487
NUM_LEVELS=STASH_LEVELS(1,NI) ARS1F404.488
IF (NUM_LEVELS.LE.V_PLEV.AND.NUM_LEVELS.LE.H_PLEV) THEN ARS1F404.489
COUNT=0 ARS1F404.490
DO K=1,NUM_LEVELS ARS1F404.491
DO I=1,V_PLEV ARS1F404.492
IF (STASH_LEVELS(K+1,NI).EQ. STASH_LEVELS(I+1,NI_V)) THEN ARS1F404.493
COUNT=COUNT+1 ARS1F404.494
ENDIF ARS1F404.495
ENDDO ARS1F404.496
DO I=1,H_PLEV ARS1F404.497
IF (STASH_LEVELS(K+1,NI).EQ.STASH_LEVELS(I+1,NI_H)) THEN ARS1F404.498
COUNT=COUNT+1 ARS1F404.499
ENDIF ARS1F404.500
ENDDO ARS1F404.501
ENDDO ARS1F404.502
IF (COUNT.NE.2*NUM_LEVELS) THEN ARS1F404.503
CMESSAGE='INITDIA: vZ must be on a subset of v and Z levels' ARS1F404.504
ICODE=1 ARS1F404.505
GOTO 99 ARS1F404.506
ENDIF ARS1F404.507
ELSE ARS1F404.508
CMESSAGE='INITDIA: vZ must be on a subset of v and Z levels' ARS1F404.509
ICODE=1 ARS1F404.510
GOTO 99 ARS1F404.511
ENDIF ARS1F404.512
ENDIF ARS1F404.513
ELSE ARS1F404.514
CMESSAGE='INITDIA: Level not a levels list for vZ' ARS1F404.515
ICODE=1 INITDIA1.673
GOTO 99 INITDIA1.674
ENDIF INITDIA1.675
ENDIF INITDIA1.676
INITDIA1.677
C Initialise Pstar-old to Pstar for timestep 0 INITDIA1.678
DO K=1,P_FIELD INITDIA1.679
PSTAR_OLD(k) = D1(JPSTAR+k-1) INITDIA1.680
ENDDO INITDIA1.681
INITDIA1.682
CALL ST_DIAG1(NUM_STASH_LEVELS,STASH_MAXLEN(15,im_index), GDR4F305.116
& PSTAR_OLD, GDR4F305.117
*CALL ARGSIZE @DYALLOC.1480
*CALL ARGD1 @DYALLOC.1481
*CALL ARGDUMA @DYALLOC.1482
*CALL ARGDUMO @DYALLOC.1483
*CALL ARGDUMW GKR1F401.215
*CALL ARGSTS @DYALLOC.1484
*CALL ARGPTRA @DYALLOC.1485
*CALL ARGPTRO @DYALLOC.1486
*CALL ARGCONA @DYALLOC.1487
*CALL ARGPPX GKR0F305.943
*CALL ARGFLDPT GSM1F405.512
& ICODE,CMESSAGE) @DYALLOC.1488
INITDIA1.684
C Check diagnostics and their levels are consistent now. INITDIA1.685
C This should reduce need to check this on all subsequent calls to INITDIA1.686
C ST_DIAG2. INITDIA1.687
C INITDIA1.688
C 16,202 Height on pressure levels INITDIA1.689
ISL=STINDEX(1,202,16,im_index) GDR4F305.118
IF(ISL.GT.0) THEN INITDIA1.691
IF (STLIST(10,ISL).LT.0) THEN INITDIA1.692
IF (STLIST(11,ISL).NE.2) THEN INITDIA1.693
CMESSAGE='INITDIA: Level not pressure for Height' INITDIA1.694
ICODE=1 INITDIA1.695
GOTO 99 INITDIA1.696
ELSE INITDIA1.697
NI_H = -STLIST(10,ISL) INITDIA1.698
H_PLEV=STASH_LEVELS(1,NI_H) INITDIA1.699
ENDIF INITDIA1.700
ELSE INITDIA1.701
CMESSAGE='INITDIA: Level not a levels list for height' INITDIA1.702
ICODE=1 INITDIA1.703
GOTO 99 INITDIA1.704
ENDIF INITDIA1.705
ENDIF INITDIA1.706
C INITDIA1.707
C 16,203 Temperature on pressure levels INITDIA1.708
ISL=STINDEX(1,203,16,im_index) GDR4F305.119
IF(ISL.GT.0) THEN INITDIA1.710
IF (STLIST(10,ISL).LT.0) THEN INITDIA1.711
IF (STLIST(11,ISL).NE.2) THEN INITDIA1.712
CMESSAGE='INITDIA: Level not pressure for T' INITDIA1.713
ICODE=1 INITDIA1.714
GOTO 99 INITDIA1.715
ELSE INITDIA1.716
NI_T = -STLIST(10,ISL) INITDIA1.717
T_PLEV=STASH_LEVELS(1,NI_T) INITDIA1.718
ENDIF INITDIA1.719
ELSE INITDIA1.720
CMESSAGE='INITDIA: Level not a levels list for T' INITDIA1.721
ICODE=1 INITDIA1.722
GOTO 99 INITDIA1.723
ENDIF INITDIA1.724
ENDIF INITDIA1.725
C ---------------------------------------------------------------------- INITDIA1.726
C Restrictive tests on product diagnostics INITDIA1.727
C INITDIA1.728
C 16,224 H**2 on pressure levels INITDIA1.729
ISL=STINDEX(1,224,16,im_index) GDR4F305.120
IF(ISL.GT.0) THEN INITDIA1.731
IF (STLIST(10,ISL).LT.0) THEN INITDIA1.732
IF (STLIST(11,ISL).NE.2) THEN INITDIA1.733
CMESSAGE='INITDIA: Level not pressure for Height**2' INITDIA1.734
ICODE=1 INITDIA1.735
GOTO 99 INITDIA1.736
ELSE INITDIA1.737
NI=-STLIST(10,ISL) INITDIA1.738
NUM_LEVELS=STASH_LEVELS(1,NI) INITDIA1.739
IF (NUM_LEVELS.LE.H_PLEV) THEN INITDIA1.740
COUNT=0 INITDIA1.741
DO K=1,NUM_LEVELS INITDIA1.742
DO I=1,H_PLEV INITDIA1.743
IF (STASH_LEVELS(K+1,NI).EQ.STASH_LEVELS(I+1,NI_H))THEN INITDIA1.744
COUNT=COUNT+1 INITDIA1.745
ENDIF INITDIA1.746
ENDDO INITDIA1.747
ENDDO INITDIA1.748
IF (COUNT.NE.NUM_LEVELS) THEN INITDIA1.749
CMESSAGE='INITDIA: Height**2 must be on a subset of H lev INITDIA1.750
&ls' INITDIA1.751
ICODE=1 INITDIA1.752
GOTO 99 INITDIA1.753
ENDIF INITDIA1.754
ELSE INITDIA1.755
CMESSAGE='INITDIA: Height**2 must be on a subset of H lev INITDIA1.756
&ls' INITDIA1.757
ICODE=1 INITDIA1.758
GOTO 99 INITDIA1.759
ENDIF INITDIA1.760
ENDIF INITDIA1.761
ELSE INITDIA1.762
CMESSAGE='INITDIA: Level not a levels list for Height**2' INITDIA1.763
ICODE=1 INITDIA1.764
GOTO 99 INITDIA1.765
ENDIF INITDIA1.766
ENDIF INITDIA1.767
C INITDIA1.768
INITDIA1.769
INITDIA1.770
CALL ST_DIAG2(NUM_STASH_LEVELS,STASH_MAXLEN(16,im_index), GDR4F305.121
& P_FIELD,P_LEVELS,TR_VARS, ADP0F401.6
*CALL ARGSIZE @DYALLOC.1490
*CALL ARGD1 @DYALLOC.1491
*CALL ARGDUMA @DYALLOC.1492
*CALL ARGDUMO @DYALLOC.1493
*CALL ARGDUMW GKR1F401.216
*CALL ARGSTS @DYALLOC.1494
*CALL ARGPTRA @DYALLOC.1495
*CALL ARGPTRO @DYALLOC.1496
*CALL ARGCONA @DYALLOC.1497
*CALL ARGPPX GKR0F305.944
*CALL ARGFLDPT GSM1F405.513
& ICODE,CMESSAGE) @DYALLOC.1498
INITDIA1.772
99 CONTINUE INITDIA1.773
RETURN INITDIA1.774
END INITDIA1.775
*ENDIF INITDIA1.776