SUBROUTINE CONVECT (NP_FIELD,NPNTS,NLEV,TH,Q,PSTAR,BLAND,DTHBYDT, 3,46CONVEC2A.38
& DQBYDT,RAIN,SNOW,CCA,ICCB,ICCT,CCLWP, ARN2F304.175
& CCW,ICCBPxCCA,ICCTPxCCA,GBMCCWP,GBMCCW, AJX1F402.139
& LCBASE,LCTOP,LCCA,LCCLWP,CAPE_OUT, AJX1F402.140
& EXNER,AK,BK,AKM12,BKM12,DELAK,DELBK,TIMESTEP AAD2F404.159
*IF DEF,SCMA AJC0F405.154
& ,DTHUD,DTHDD,DQUD,DQDD AJC0F405.155
*ENDIF AJC0F405.156
*IF DEF,MPP AAD2F404.160
& ,l_halo AAD2F404.161
*ENDIF AAD2F404.162
& ) AAD2F404.163
C CONVEC2A.41
IMPLICIT NONE CONVEC2A.42
C CONVEC2A.43
C CONVEC2A.47
C-------------------------------------------------------------------- CONVEC2A.48
C MODEL CONSTANTS CONVEC2A.49
C-------------------------------------------------------------------- CONVEC2A.50
C CONVEC2A.51
*CALL PARXS 
CONVEC2A.52
*CALL C_EPSLON CONVEC2A.53
*CALL C_R_CP CONVEC2A.54
*CALL XSBMIN CONVEC2A.55
*CALL MPARB CONVEC2A.56
*CALL DELTHST CONVEC2A.57
*CALL C_LHEAT CONVEC2A.58
*CALL MASSFC CONVEC2A.59
C CONVEC2A.60
C--------------------------------------------------------------------- CONVEC2A.61
C VECTOR LENGTHS AND LOOP COUNTERS CONVEC2A.62
C--------------------------------------------------------------------- CONVEC2A.63
C CONVEC2A.64
INTEGER NP_FIELD ! LENGTH OF DATA (ALSO USED TO CONVEC2A.65
! SPECIFY STARTING POINT OF CONVEC2A.66
! DATA PASSED IN) CONVEC2A.67
C CONVEC2A.68
INTEGER NPNTS ! IN FULL VECTOR LENGTH CONVEC2A.69
C CONVEC2A.70
INTEGER NLEV ! IN NUMBER OF MODEL LAYERS CONVEC2A.71
C CONVEC2A.72
INTEGER NCONV ! NUMBER OF POINTS WHICH PASS CONVEC2A.73
! INITIAL STABILITY TEST IN LAYER K CONVEC2A.74
C CONVEC2A.75
INTEGER NINIT ! NUMBER OF POINTS AT WHICH CONVEC2A.76
! CONVECTION OCCURS IN LAYER K CONVEC2A.77
C CONVEC2A.78
INTEGER NTERM ! NUMBER OF CONVECTING POINTS IN CONVEC2A.79
! LAYER K AT WHICH CONVECTION IS CONVEC2A.80
! TERMINATING CONVEC2A.81
C CONVEC2A.82
INTEGER NCNLV ! NUMBER OF POINTS AT WHICH CONVECTION CONVEC2A.83
! OCCURS AT SOME LAYER OF THE DOMAIN CONVEC2A.84
C CONVEC2A.85
INTEGER I,K,KC ! LOOP COUNTERS CONVEC2A.86
C CONVEC2A.87
C CONVEC2A.88
C--------------------------------------------------------------------- CONVEC2A.89
C VARIABLES WHICH ARE INPUT CONVEC2A.90
C--------------------------------------------------------------------- CONVEC2A.91
C CONVEC2A.92
LOGICAL BLAND(NP_FIELD) ! IN LAND/SEA MASK CONVEC2A.93
C CONVEC2A.94
REAL PSTAR(NP_FIELD) ! IN SURFACE PRESSURE (PA) CONVEC2A.95
C CONVEC2A.96
REAL EXNER(NP_FIELD,NLEV+1) ! IN EXNER RATIO CONVEC2A.97
C CONVEC2A.98
REAL AK(NLEV), ! IN HYBRID CO-ORDINATE COEFFICIENTS CONVEC2A.99
* BK(NLEV) ! DEFINE PRESSURE AT MID-POINT CONVEC2A.100
! OF LAYER K CONVEC2A.101
C CONVEC2A.102
REAL AKM12(NLEV+1), ! IN HYBRID CO-ORDINATE COEFFICIENTS CONVEC2A.103
* BKM12(NLEV+1) ! TO DEFINE PRESSURE AT CONVEC2A.104
! LEVEL K-1/2 CONVEC2A.105
C CONVEC2A.106
REAL DELAK(NLEV), ! IN DIFFERENCE IN HYBRID CO-ORDINATE CONVEC2A.107
* DELBK(NLEV) ! COEFFICIENTS ACROSS LAYER K CONVEC2A.108
C CONVEC2A.109
REAL TIMESTEP ! IN MODEL TIMESTEP (SECS) CONVEC2A.110
*IF DEF,MPP AAD2F404.164
LOGICAL l_halo(NP_FIELD) ! IN: Mask for halos AAD2F404.165
*ENDIF AAD2F404.166
C CONVEC2A.111
C CONVEC2A.112
C--------------------------------------------------------------------- CONVEC2A.113
C VARIABLES WHICH ARE INPUT AND OUTPUT CONVEC2A.114
C--------------------------------------------------------------------- CONVEC2A.115
C CONVEC2A.116
REAL TH(NP_FIELD,NLEV) ! INOUT CONVEC2A.117
! IN MODEL POTENTIAL TEMPERATURE (K) CONVEC2A.118
! OUT MODEL POTENTIAL TEMPERATURE CONVEC2A.119
! AFTER CONVECTION (K) CONVEC2A.120
C CONVEC2A.121
REAL Q(NP_FIELD,NLEV) ! INOUT CONVEC2A.122
! IN MODEL MIXING RATIO (KG/KG) CONVEC2A.123
! OUT MODEL MIXING RATIO AFTER CONVEC2A.124
! AFTER CONVECTION (KG/KG) CONVEC2A.125
C CONVEC2A.126
C CONVEC2A.127
C---------------------------------------------------------------------- CONVEC2A.128
C VARIABLES WHICH ARE OUTPUT CONVEC2A.129
C---------------------------------------------------------------------- CONVEC2A.130
C CONVEC2A.131
REAL DTHBYDT(NP_FIELD,NLEV) ! OUT INCREMENTS TO POTENTIAL CONVEC2A.132
! TEMPERATURE DUE TO CONVECTION CONVEC2A.133
! (K/S) CONVEC2A.134
C CONVEC2A.135
REAL DQBYDT(NP_FIELD,NLEV) ! OUT INCREMENTS TO MIXING RATIO CONVEC2A.136
! DUE TO CONVECTION (KG/KG/S) CONVEC2A.137
C CONVEC2A.138
*IF DEF,SCMA AJC0F405.157
Real DTHUD(NP_FIELD,NLEV) AJC0F405.158
Real DTHDD(NP_FIELD,NLEV) AJC0F405.159
Real DQUD(NP_FIELD,NLEV) AJC0F405.160
Real DQDD(NP_FIELD,NLEV) AJC0F405.161
*ENDIF AJC0F405.162
REAL RAIN(NP_FIELD) ! OUT SURFACE CONVECTIVE RAINFALL CONVEC2A.139
! (KG/M**2/S) CONVEC2A.140
C CONVEC2A.141
REAL SNOW(NP_FIELD) ! OUT SURFACE CONVECTIVE SNOWFALL CONVEC2A.142
! (KG/M**2/S) CONVEC2A.143
C CONVEC2A.144
REAL CCA(NP_FIELD) ! OUT CONVECTIVE CLOUD AMOUNT (%) CONVEC2A.145
C CONVEC2A.146
INTEGER ICCB(NP_FIELD) ! OUT CONVECTIVE CLOUD BASE LEVEL CONVEC2A.147
C CONVEC2A.148
INTEGER ICCT(NP_FIELD) ! OUT CONVECTIVE CLOUD TOP LEVEL CONVEC2A.149
C CONVEC2A.150
REAL CCLWP(NP_FIELD) ! OUT CONDENSED WATER PATH (KG/M**2) CONVEC2A.151
C CONVEC2A.152
REAL CCW(NP_FIELD,NLEV) ! OUT CONVECTIVE CLOUD LIQUID WATER PI080793.34
! (G/KG) ON MODEL LEVELS PI080793.35
C PI080793.36
REAL ICCBPxCCA(NP_FIELD) ! OUT CONV. CLD BASE PRESSURE x CCA AJX1F402.141
C AJX1F402.142
REAL ICCTPxCCA(NP_FIELD) ! OUT CONV. CLD TOP PRESSURE x CCA AJX1F402.143
C AJX1F402.144
REAL GBMCCWP(NP_FIELD) ! OUT GRIDBOX MEAN CCWP AJX1F402.145
C AJX1F402.146
REAL GBMCCW(NP_FIELD,NLEV) ! OUT GRIDBOX MEAN CCW AJX1F402.147
C AJX1F402.148
REAL CAPE_OUT(NPNTS) ! OUT SAVED VALUES OF CONVECTIVE API2F400.165
! AVAILABLE POTENTIAL ENERGY API2F400.166
! FOR DIAGNOSTIC OUTPUT (J/KG) API2F400.167
C API2F400.168
REAL LCCA(NP_FIELD) ! OUT LOWEST CONV.CLOUD AMOUNT (%) ARN2F304.185
C ARN2F304.186
INTEGER LCBASE(NP_FIELD) ! OUT LOWEST CONV.CLOUD BASE LEVEL ARN2F304.187
C ARN2F304.188
INTEGER LCTOP(NP_FIELD) ! OUT LOWEST CONV.CLOUD TOP LEVEL ARN2F304.189
C ARN2F304.190
REAL LCCLWP(NP_FIELD) ! OUT CONDENSED WATER PATH (KG/M**2) ARN2F304.191
! FOR LOWEST CONV.CLOUD ARN2F304.192
C ARN2F304.193
C---------------------------------------------------------------------- CONVEC2A.153
C VARIABLES DEFINED LOCALLY CONVEC2A.154
C CONVEC2A.155
REAL WORK(NPNTS,NLEV*2), ! WORK SPACE CONVEC2A.291
* WORK2(NPNTS,NLEV*2) CONVEC2A.292
LOGICAL BWORK(NPNTS,4), ! WORK SPACE FOR 'BIT' MASKS CONVEC2A.293
* BWORK2(NPNTS,4) CONVEC2A.294
C API2F400.175
REAL CAPE(NPNTS) ! CONVECTIVE AVAILABLE POTENTIAL API2F400.176
! ENERGY (J/KG) API2F400.177
C API2F400.178
REAL CAPE_C(NPNTS) ! CAPE - COMPRESSED API2F400.179
C API2F400.180
C CONVEC2A.295
LOGICAL BCONV(NPNTS) ! MASK FOR POINTS WHERE STABILITY CONVEC2A.296
! LOW ENOUGH FOR CONVECTION CONVEC2A.297
! TO OCCUR CONVEC2A.298
C CONVEC2A.299
REAL QSE(NPNTS,NLEV) ! SATURATION MIXING RATIO OF CLOUD CONVEC2A.300
! ENVIRONMENT (KG/KG) CONVEC2A.301
C CONVEC2A.302
REAL TT(NPNTS) ! TEMPORARY STORE FOR TEMPERATURE CONVEC2A.303
! IN CALCULATION OF SATURATION CONVEC2A.304
! MIXING RATIO (K) CONVEC2A.305
C CONVEC2A.306
REAL PT(NPNTS) ! TEMPORARY STORE FOR PRESSURE CONVEC2A.307
! IN CALCULATION OF SATURATION CONVEC2A.308
! MIXING RATIO (PA) CONVEC2A.309
C CONVEC2A.310
REAL CCAC(NPNTS) ! COMPRESSED VALUES OF CCA CONVEC2A.311
C CONVEC2A.312
INTEGER ICCBC(NPNTS) ! COMPRESSED VALUES OF CCB CONVEC2A.313
C CONVEC2A.314
INTEGER ICCTC(NPNTS) ! COMPRESSED VALUES OF CCT CONVEC2A.315
C CONVEC2A.316
REAL TCW(NPNTS) ! TOTAL CONDENSED WATER (KG/M**2/S) CONVEC2A.317
C CONVEC2A.318
REAL TCWC(NPNTS) ! COMPRESSED VALUES OF TCW CONVEC2A.319
C CONVEC2A.320
REAL CCLWPC(NPNTS) ! COMPRESSED VALUE OF CCLWP CONVEC2A.321
C CONVEC2A.322
REAL LCCAC(NPNTS) ! COMPRESSED VALUES OF LCCA ARN2F304.202
C ARN2F304.203
INTEGER LCBASEC(NPNTS) ! COMPRESSED VALUES OF LCBASE ARN2F304.204
C ARN2F304.205
INTEGER LCTOPC(NPNTS) ! COMPRESSED VALUES OF LCTOP ARN2F304.206
C ARN2F304.207
REAL LCCLWPC(NPNTS) ! COMPRESSED VALUE OF LCCLWP ARN2F304.208
C ARN2F304.209
REAL DQSTHK(NPNTS) ! GRADIENT OF SATURATION MIXING CONVEC2A.323
! RATIO OF CLOUD ENVIRONMENT WITH CONVEC2A.324
! POTENTIAL TEMPERATURE IN LAYER K CONVEC2A.325
! (KG/KG/K) CONVEC2A.326
C CONVEC2A.327
REAL DQSTHKP1(NPNTS) ! GRADIENT OF SATURATION MIXING CONVEC2A.328
! RATIO OF CLOUD ENVIRONMENT WITH CONVEC2A.329
! POTENTIAL TEMPERATURE IN LAYER K+1 CONVEC2A.330
! (KG/KG/K) CONVEC2A.331
C CONVEC2A.332
REAL PRECIP(NPNTS,NLEV) ! AMOUNT OF PRECIPITATION CONVEC2A.333
! FROM EACH LAYER (KG/M*:2/S) CONVEC2A.334
C CONVEC2A.335
REAL THPI(NPNTS) ! INITIAL PARCEL POTENTIAL TEMPERATURE CONVEC2A.336
! (K) CONVEC2A.337
C CONVEC2A.338
REAL QPI(NPNTS) ! INITIAL PARCEL MIXING RATIO CONVEC2A.339
! (KG/KG) CONVEC2A.340
C CONVEC2A.341
REAL THP(NPNTS,NLEV) ! PARCEL POTENTIAL TEMPERATURE CONVEC2A.342
! IN LAYER K (K) CONVEC2A.343
C CONVEC2A.344
REAL QP(NPNTS,NLEV) ! PARCEL MIXING RATIO IN LAYER K CONVEC2A.345
! (KG/KG) CONVEC2A.346
C CONVEC2A.347
REAL XPK(NPNTS) ! PARCEL CLOUD WATER IN LAYER K CONVEC2A.348
! (KG/KG) CONVEC2A.349
C CONVEC2A.350
REAL FLX(NPNTS,NLEV) ! PARCEL MASSFLUX IN LAYER K (PA/S) CONVEC2A.351
C CONVEC2A.352
LOGICAL BINIT(NPNTS) ! MASK FOR POINTS WHERE CONVECTION CONVEC2A.353
! IS OCCURING CONVEC2A.354
C CONVEC2A.355
LOGICAL BTERM(NPNTS) ! MASK FOR POINTS WHERE CONVECTION CONVEC2A.356
! TERMINATES IN LAYER K+1 CONVEC2A.357
C CONVEC2A.358
LOGICAL BWATER(NPNTS,2:NLEV) ! MASK FOR POINTS AT WHICH CONVEC2A.359
! PRECIPITATION IS LIQUID CONVEC2A.360
C CONVEC2A.361
LOGICAL BGMK(NPNTS) ! MASK FOR POINTS WHERE PARCEL IN CONVEC2A.362
! LAYER K IS SATURATED CONVEC2A.363
C CONVEC2A.364
LOGICAL BCNLV(NPNTS) ! MASK FOR THOSE POINTS AT WHICH CONVEC2A.365
! CONVECTION HAS OCCURED AT SOME CONVEC2A.366
! LEVEL OF THE MODEL CONVEC2A.367
C CONVEC2A.368
REAL DEPTH(NPNTS) ! DEPTH OF CONVECTIVE CLOUD (M) CONVEC2A.369
C CONVEC2A.370
REAL FLXMAXK(NPNTS) ! MAXIMUM INITIL CONVECTIVE MASSFLUX CONVEC2A.371
! (PA/S) CONVEC2A.372
C CONVEC2A.373
REAL FLXMAX2(NPNTS) ! MAXIMUM INITIL CONVECTIVE MASSFLUX CONVEC2A.374
! (PA/S) CONVEC2A.375
C CONVEC2A.376
REAL PK(NPNTS) ! PRESSURE AT MID-POINT OF LAYER K CONVEC2A.377
! (PA) CONVEC2A.378
C CONVEC2A.379
REAL PKP1(NPNTS) ! PRESSURE AT MID-POINT OF LAYER K+1 CONVEC2A.380
! (PA) CONVEC2A.381
C CONVEC2A.382
REAL DELPK(NPNTS) ! PRESSURE DIFFERENCE ACROSS LAYER K CONVEC2A.383
! (PA) CONVEC2A.384
C CONVEC2A.385
REAL DELPKP1(NPNTS) ! PRESSURE DIFFERENCE ACROSS LAYER K+1 CONVEC2A.386
! (PA) CONVEC2A.387
C CONVEC2A.388
REAL DELPKP12(NPNTS) ! PRESSURE DIFFERENCE BETWEEN CONVEC2A.389
! LEVELS K AND K+1 (PA) CONVEC2A.390
C CONVEC2A.391
REAL EKP14(NPNTS), ! ENTRAINMENT COEFFICIENTS AT LEVELS CONVEC2A.392
* EKP34(NPNTS) ! K+1/4 AND K+3/4 MULTIPLIED BY CONVEC2A.393
! APPROPRIATE LAYER THICKNESS CONVEC2A.394
C CONVEC2A.395
REAL AMDETK(NPNTS) ! MIXING DETRAINMENT COEFFICIENT AT CONVEC2A.396
! LEVEL K MULTIPLIED BY APPROPRIATE CONVEC2A.397
! LAYER THICKNESS CONVEC2A.398
C CONVEC2A.399
REAL EXK(NPNTS) ! EXNER RATIO AT LEVEL K CONVEC2A.400
C CONVEC2A.401
REAL EXKP1(NPNTS) ! EXNER RATIO AT LEVEL K+1 CONVEC2A.402
C CONVEC2A.403
REAL DELEXKP1(NPNTS) ! DIFFERENCE IN EXNER RATIO CONVEC2A.404
! ACROSS LAYER K+1 CONVEC2A.405
C CONVEC2A.406
REAL EMINDS(NPNTS) ! CONVEC2A.407
C CONVEC2A.408
INTEGER INDEX1(NPNTS), ! INDEX FOR COMPRESS AND CONVEC2A.409
* INDEX2(NPNTS), ! EXPAND CONVEC2A.410
* INDEX3(NPNTS), CONVEC2A.411
* INDEX4(NPNTS) CONVEC2A.412
C CONVEC2A.413
C CONVEC2A.415
REAL recip_PSTAR(NP_FIELD) ! Reciprocal of pstar array GSS1F403.82
REAL FLX2 ! TEMPORARY STORE FOR MASS FLUX CONVEC2A.416
C CONVEC2A.417
C---------------------------------------------------------------------- CONVEC2A.418
C EXTERNAL ROUTINES CALLED CONVEC2A.419
C---------------------------------------------------------------------- CONVEC2A.420
C CONVEC2A.421
EXTERNAL QSAT,FLAG_WET,LIFT_PAR,CONVEC2,LAYER_CN, CONVEC2A.422
* DQS_DTH,COR_ENGY,DD_CALL CONVEC2A.423
C CONVEC2A.427
CONVEC2A.428
REAL CONVEC2A.429
& PU,PL CONVEC2A.430
*CALL P_EXNERC CONVEC2A.431
CONVEC2A.432
C*--------------------------------------------------------------------- CONVEC2A.433
C CONVEC2A.434
CL CONVEC2A.435
CL--------------------------------------------------------------------- CONVEC2A.436
CL CALCULATE AN ARRAY OF SATURATION MIXING RATIOS CONVEC2A.437
CL FIRST CONVERT POTENTIAL TEMPERATURE TO TEMPERATURE AND CALCULATE CONVEC2A.438
CL PRESSURE OF LAYER K CONVEC2A.439
CL CONVEC2A.440
CL SUBROUTINE QSAT CONVEC2A.441
CL UM DOCUMENTATION PAPER P282 CONVEC2A.442
CL--------------------------------------------------------------------- CONVEC2A.443
CL CONVEC2A.444
C Calculate reciprocal of pstar ADR1F405.2
DO I=1,NPNTS ADR1F405.3
RECIP_PSTAR(I)=1./PSTAR(I) ADR1F405.4
ENDDO ADR1F405.5
C GSS1F403.90
DO 20 K=1,NLEV CONVEC2A.445
DO 25 I = 1,NPNTS CONVEC2A.446
PU=PSTAR(I)*BKM12(K+1) + AKM12(K+1) CONVEC2A.447
PL=PSTAR(I)*BKM12(K) + AKM12(K) CONVEC2A.448
TT(I) = TH(I,K)* P_EXNER_C(EXNER(I,K+1),EXNER(I,K),PU,PL,KAPPA) CONVEC2A.449
PT(I) = AK(K)+BK(K)*PSTAR(I) CONVEC2A.450
25 CONTINUE CONVEC2A.451
C CONVEC2A.452
CALL QSAT (QSE(1,K),TT,PT,NPNTS) CONVEC2A.453
C CONVEC2A.454
20 CONTINUE CONVEC2A.455
CL CONVEC2A.456
CL--------------------------------------------------------------------- CONVEC2A.457
CL CALCULATE BIT VECTOR WHERE WATER WILL CONDENSE RATHER THAN ICE CONVEC2A.458
CL SUBROUTINE FLAG_WET CONVEC2A.459
CL CONVEC2A.460
CL UM DOCUMENTATION PAPER P27 CONVEC2A.461
CL SECTION (2B) CONVEC2A.462
CL--------------------------------------------------------------------- CONVEC2A.463
CL CONVEC2A.464
CALL FLAG_WET(BWATER,TH,EXNER,PSTAR,AKM12,BKM12, CONVEC2A.465
& NP_FIELD,NPNTS,NLEV) CONVEC2A.466
C CONVEC2A.467
C---------------------------------------------------------------------- CONVEC2A.468
C INITIALISE PRECIPITATION, DTH/DT, DQ/DT, CCW ARRAYS PI080793.37
C---------------------------------------------------------------------- CONVEC2A.470
C CONVEC2A.471
DO 40 K=1,NLEV CONVEC2A.472
DO 40 I=1,NPNTS CONVEC2A.473
PRECIP(I,K) = 0.0 CONVEC2A.474
CCW(I,K) = 0.0 PI080793.38
GBMCCW(I,K) = 0.0 AJX1F402.149
DTHBYDT(I,K) = 0.0 CONVEC2A.475
*IF DEF,SCMA AJC0F405.163
DTHUD(I,K) = 0.0 AJC0F405.164
DTHDD(I,K) = 0.0 AJC0F405.165
DQUD(I,K) = 0.0 AJC0F405.166
DQDD(I,K) = 0.0 AJC0F405.167
*ENDIF AJC0F405.168
40 DQBYDT(I,K) = 0.0 CONVEC2A.476
DO 50 I=1,NPNTS CONVEC2A.477
C CONVEC2A.478
C---------------------------------------------------------------------- CONVEC2A.479
C INITIALISE BIT VECTORS FOR POINTS WHICH ARE ALREADY CONVECTING CONVEC2A.480
C AND FOR POINTS AT WHICH CONVECTION OCCURS AT SOME LEVEL OF CONVEC2A.481
C THE ATMOSPHERE CONVEC2A.482
C---------------------------------------------------------------------- CONVEC2A.483
C CONVEC2A.484
BINIT(I) = .FALSE. CONVEC2A.485
BCNLV(I) = .FALSE. CONVEC2A.486
BTERM(I) = .FALSE. AAD1F304.81
C CONVEC2A.487
C---------------------------------------------------------------------- CONVEC2A.488
C INITIALISE RADIATION DIAGNOSTICS CONVEC2A.489
C---------------------------------------------------------------------- CONVEC2A.490
C CONVEC2A.491
CCA(I) = 0.0 CONVEC2A.492
ICCB(I) = 0 CONVEC2A.493
ICCT(I) = 0 CONVEC2A.494
TCW(I) = 0.0 CONVEC2A.495
CCLWP(I) = 0.0 AJX1F402.150
C API2F400.181
C-------------------------------------------------------------------- AJX1F402.151
C INITIALISE GRIDBOX MEAN DIAGNOSTICS AJX1F402.152
C-------------------------------------------------------------------- AJX1F402.153
C AJX1F402.154
GBMCCWP(I) = 0.0 AJX1F402.155
ICCBPxCCA(I) = 0.0 AJX1F402.156
ICCTPxCCA(I) = 0.0 AJX1F402.157
C AJX1F402.158
CL------------------------------------------------------------------- API2F400.182
CL INITIALISE CAPE DIAGNOSTIC API2F400.183
CL------------------------------------------------------------------- API2F400.184
C API2F400.185
CAPE(I) = 0.0 API2F400.186
CAPE_OUT(I) = 0.0 API2F400.187
CAPE_C(I) = 0.0 API2F400.188
C CONVEC2A.496
C--------------------------------------------------------------------- CONVEC2A.497
C INITIALISE SURFACE PRECIPITATION ARRAYS CONVEC2A.498
C--------------------------------------------------------------------- CONVEC2A.499
C CONVEC2A.500
RAIN(I) = 0.0 CONVEC2A.501
50 SNOW(I) = 0.0 CONVEC2A.502
CL CONVEC2A.503
CL===================================================================== CONVEC2A.504
CL MAIN LOOP OVER LEVELS - FROM SURFACE TO TOP CONVEC2A.505
CL===================================================================== CONVEC2A.506
CL CONVEC2A.507
DO 60 K=1,NLEV-1 CONVEC2A.508
CL CONVEC2A.509
CL--------------------------------------------------------------------- CONVEC2A.510
CL CALCULATE LEVEL PRESSURES, EXNER RATIO FOR MID POINTS, ENTRAINMENT CONVEC2A.511
CL RATES, DETRAINMENTS RATES AND PRESSURE DIFFERENCE ACROS LAYERS AS CONVEC2A.512
CL A FUNCTION OF GRID-POINT CONVEC2A.513
CL CONVEC2A.514
CL SUBROUTINE LAYER_CN CONVEC2A.515
CL--------------------------------------------------------------------- CONVEC2A.516
CL CONVEC2A.517
CALL LAYER_CN(K,NP_FIELD,NPNTS,NLEV,EXNER,AK,BK,AKM12,BKM12, CONVEC2A.518
* DELAK,DELBK,PSTAR,PK,PKP1,DELPK,DELPKP1, CONVEC2A.519
* DELPKP12,EKP14,EKP34,AMDETK,EXK,EXKP1, CONVEC2A.520
* DELEXKP1,recip_PSTAR) GSS1F403.91
CL CONVEC2A.522
CL--------------------------------------------------------------------- CONVEC2A.523
CL CALCULATE DQS/DTH FOR LAYERS K AND K+1 CONVEC2A.524
CL CONVEC2A.525
CL SUBROUTINE DQS_DTH CONVEC2A.526
CL--------------------------------------------------------------------- CONVEC2A.527
CL CONVEC2A.528
IF (K.EQ.1) THEN CONVEC2A.529
CALL DQS_DTH(DQSTHK,K,TH(1,K),QSE(1,K),EXK,NPNTS) CONVEC2A.530
ELSE CONVEC2A.531
DO 65 I=1,NPNTS CONVEC2A.532
DQSTHK(I) = DQSTHKP1(I) CONVEC2A.533
65 CONTINUE CONVEC2A.534
END IF CONVEC2A.535
C CONVEC2A.536
CALL DQS_DTH(DQSTHKP1,K+1,TH(1,K+1),QSE(1,K+1),EXKP1,NPNTS) CONVEC2A.537
C CONVEC2A.538
DO 70 I=1,NPNTS CONVEC2A.539
C CONVEC2A.540
C--------------------------------------------------------------------- CONVEC2A.541
C SET OTHER GIRD-POINT DEPENDENT CONSTANTS CONVEC2A.542
C--------------------------------------------------------------------- CONVEC2A.543
C CONVEC2A.544
C--------------------------------------------------------------------- CONVEC2A.545
C MAXIMUM INITIAL CONVECTIVE MASSFLUX CONVEC2A.546
C--------------------------------------------------------------------- CONVEC2A.547
C CONVEC2A.548
FLXMAXK(I) = DELPK(I)/((1.0 + EKP14(I)) * TIMESTEP) CONVEC2A.549
C CONVEC2A.550
C--------------------------------------------------------------------- CONVEC2A.551
C MAXIMUM CONVECTIVE MASSFLUX AT MID-POINT OF LAYER 2 CONVEC2A.552
C--------------------------------------------------------------------- CONVEC2A.553
C CONVEC2A.554
IF (K.EQ.1) FLXMAX2(I) = (PSTAR(I)-PKP1(I)) / TIMESTEP CONVEC2A.555
C CONVEC2A.556
C--------------------------------------------------------------------- CONVEC2A.557
C MINIMUM BUOYANCY FOR CONVECTION TO START FROM LAYER K CONVEC2A.558
C--------------------------------------------------------------------- CONVEC2A.559
C CONVEC2A.560
EMINDS(I) = MPARB*DELPKP12(I)*recip_pstar(I) GSS1F403.93
C CONVEC2A.562
C---------------------------------------------------------------------- CONVEC2A.563
C SET BIT VECTOR FOR POINTS WHERE CONVECTION HAS OCCURRED AT SOME CONVEC2A.564
C LEVEL OF THE ATMOSPHERE CONVEC2A.565
C----------------------------------------------------------------------- CONVEC2A.566
C CONVEC2A.567
BCNLV(I) = BCNLV(I) .OR. BINIT(I) CONVEC2A.568
CL CONVEC2A.569
CL--------------------------------------------------------------------- CONVEC2A.570
CL SET INITIAL VALUES FOR POINTS NOT ALREADY INITIATED CONVEC2A.571
CL CONVEC2A.572
CL UM DOCUMENTATION PAPER P27 CONVEC2A.573
CL SECTION (3), EQUATION(17) CONVEC2A.574
CL--------------------------------------------------------------------- CONVEC2A.575
CL CONVEC2A.576
IF (.NOT.BINIT(I)) THEN CONVEC2A.577
THPI(I) = TH(I,K) + THPIXS CONVEC2A.578
QPI(I) = Q(I,K) + QPIXS CONVEC2A.579
THP(I,K) = TH(I,K) + THPIXS CONVEC2A.580
QP(I,K) = Q(I,K) + QPIXS CONVEC2A.581
XPK(I) = 0.0 CONVEC2A.582
FLX(I,K) = 0.0 CONVEC2A.583
BGMK(I) = .FALSE. CONVEC2A.584
DEPTH(I) = 0.0 CONVEC2A.585
END IF CONVEC2A.586
CL CONVEC2A.587
CL---------------------------------------------------------------------- CONVEC2A.588
CL FORM A BIT VECTOR OF POINTS FOR WHICH CONVECTION MAY BE POSSIBLE CONVEC2A.589
CL FROM LAYER K TO K-1 EITHER BECAUSE STABILITY IS LOW ENOUGH CONVEC2A.590
CL OR BECAUSE CONVECTION OCCURRING FROM LAYER K+1 TO K CONVEC2A.591
CL THIS BIT VECTOR IS USED IN THE FIRST COMPREE OF THE DATA CONVEC2A.592
CL TO CALCULATE PARCEL BUOYANCY IN LAYER K-1 CONVEC2A.593
CL CONVEC2A.594
CL UM DOCUMENTATION PAPER P27 CONVEC2A.595
CL SECTION(3), EQUATION(16) CONVEC2A.596
CL---------------------------------------------------------------------- CONVEC2A.597
CL CONVEC2A.598
BCONV(I) = BINIT(I) .OR. CONVEC2A.599
* ((TH(I,K) - TH(I,K+1) + DELTHST CONVEC2A.600
* + MAX(0.0,(Q(I,K)-QSE(I,K+1)))*(LC/(CP*EXKP1(I)))) CONVEC2A.601
* .GT. 0.) CONVEC2A.602
*IF DEF,MPP AAD2F404.167
BCONV(I) = l_halo(I).AND.BCONV(I) AAD2F404.168
*ENDIF AAD2F404.169
70 CONTINUE CONVEC2A.603
CL CONVEC2A.604
CL---------------------------------------------------------------------- CONVEC2A.605
CL COMPRESS DOWN POINTS ON THE BASIS OF BIT VECTOR BCONV CONVEC2A.606
CL---------------------------------------------------------------------- CONVEC2A.607
CL CONVEC2A.608
NCONV = 0 CONVEC2A.609
DO 75 I=1,NPNTS CONVEC2A.613
IF(BCONV(I))THEN CONVEC2A.614
NCONV = NCONV + 1 CONVEC2A.615
INDEX1(NCONV) = I CONVEC2A.616
END IF CONVEC2A.617
75 CONTINUE CONVEC2A.618
C CONVEC2A.620
C---------------------------------------------------------------------- CONVEC2A.621
C WORK SPACE USAGE FOR FIRST COMPRESS ON BASIS OF SIMPLE CONVEC2A.622
C STABILITY TEST (SECTION (3), EQN(16)) CONVEC2A.623
C CONVEC2A.624
C REFERENCES TO WORK AND BWORK REFER TO STARTING ADDRESS CONVEC2A.625
C CONVEC2A.626
C LENGTH OF COMPRESSES DATA = NCONV CONVEC2A.627
C CONVEC2A.628
C WORK(1,1) = TH(#,K) CONVEC2A.629
C WORK(1,2) = TH(#,K+1) CONVEC2A.630
C WORK(1,3) = Q(#,K) CONVEC2A.631
C WORK(1,4) = Q(#,K+1) CONVEC2A.632
C WORK(1,5) = QSE(#,K+1) CONVEC2A.633
C WORK(1,6) = DQSTHKP1(#) CONVEC2A.634
C WORK(1,7) = THP(#,K) CONVEC2A.635
C WORK(1,8) = QP(#,K) CONVEC2A.636
C WORK(1,9) = PKP1(#) CONVEC2A.637
C WORK(1,10) = EXKP1(#) CONVEC2A.638
C WORK(1,11) = EKP14(#) CONVEC2A.639
C WORK(1,12) = EKP34(#) CONVEC2A.640
C WORK(1,13) = PARCEL POT. TEMPERATURE IN LAYER K+1 CONVEC2A.641
C WORK(1,14) = PARCEL MIXING RATIO IN LAYER K+1 CONVEC2A.642
C WORK(1,15) = EXCESS WATER VAPOUR IN PARCEL ABOVE CONVEC2A.643
C SATURATION AFTER DRY ASCENT CONVEC2A.644
C WORK(1,16) = PARCEL BUOYANCY IN LAYER K+1 CONVEC2A.645
C WORK(1,17) = DELPKP12(#) CONVEC2A.646
C WORK(1,18) = PSTAR(#) CONVEC2A.647
C WORK(1,19) = FLX(#,K) CONVEC2A.648
C WORK(1,20) = EMINDS(#) CONVEC2A.649
C WORK(1,21) = FLXMAXK(#) CONVEC2A.650
C WORK(1,22) = FLXMAX2(#) CONVEC2A.651
C CONVEC2A.652
C BWORK(1,1) = BWATER(INDEX1(I),K+1) CONVEC2A.653
C BWORK(1,2) = .TRUE. IF PARCEL SATURATED IN LAYER K+1 CONVEC2A.654
C BWORK(1,3) = .TRUE. IF CONVECTION INITIATE FROM LAYER K+1 CONVEC2A.655
C BWORK(1,4) = BINIT(INDEX1(I)) CONVEC2A.656
C---------------------------------------------------------------------- CONVEC2A.657
C CONVEC2A.658
IF (NCONV .NE. 0) THEN CONVEC2A.659
DO 80 I=1,NCONV CONVEC2A.660
WORK(I,1) = TH(INDEX1(I),K) CONVEC2A.661
WORK(I,2) = TH(INDEX1(I),K+1) CONVEC2A.662
WORK(I,3) = Q(INDEX1(I),K) CONVEC2A.663
WORK(I,4) = Q(INDEX1(I),K+1) CONVEC2A.664
WORK(I,5) = QSE(INDEX1(I),K+1) CONVEC2A.665
WORK(I,6) = DQSTHKP1(INDEX1(I)) CONVEC2A.666
WORK(I,7) = THP(INDEX1(I),K) CONVEC2A.667
WORK(I,8) = QP(INDEX1(I),K) CONVEC2A.668
WORK(I,9) = PKP1(INDEX1(I)) CONVEC2A.669
WORK(I,10) = EXKP1(INDEX1(I)) CONVEC2A.670
WORK(I,11) = EKP14(INDEX1(I)) CONVEC2A.671
WORK(I,12) = EKP34(INDEX1(I)) CONVEC2A.672
WORK(I,17) = DELPKP12(INDEX1(I)) CONVEC2A.673
WORK(I,18) = PSTAR(INDEX1(I)) CONVEC2A.674
WORK(I,19) = FLX(INDEX1(I),K) CONVEC2A.675
WORK(I,20) = EMINDS(INDEX1(I)) CONVEC2A.676
WORK(I,21) = FLXMAXK(INDEX1(I)) CONVEC2A.677
WORK(I,22) = FLXMAX2(INDEX1(I)) CONVEC2A.678
BWORK(I,1) = BWATER(INDEX1(I),K+1) CONVEC2A.679
BWORK(I,4) = BINIT(INDEX1(I)) CONVEC2A.680
C CONVEC2A.681
C CONVEC2A.682
80 CONTINUE CONVEC2A.683
CL CONVEC2A.684
CL--------------------------------------------------------------------- CONVEC2A.685
CL LIFT PARCEL FROM LAYER K TO K-1 CONVEC2A.686
CL CONVEC2A.687
CL UM DOCUMENTATION PAPER P27 CONVEC2A.688
CL SECTION (3) AND (4) CONVEC2A.689
CL--------------------------------------------------------------------- CONVEC2A.690
CL CONVEC2A.691
CALL LIFT_PAR (NCONV,WORK(1,13),WORK(1,14),WORK(1,15), CONVEC2A.692
* BWORK(1,2),BWORK(1,1),WORK(1,7),WORK(1,8), CONVEC2A.693
* WORK(1,2),WORK(1,4),WORK(1,1),WORK(1,3), CONVEC2A.694
* WORK(1,5),WORK(1,6),WORK(1,9), CONVEC2A.695
* WORK(1,10),WORK(1,11),WORK(1,12)) CONVEC2A.696
C CONVEC2A.697
DO 110 I=1,NCONV CONVEC2A.698
CL CONVEC2A.699
CL--------------------------------------------------------------------- CONVEC2A.700
CL CALCULATE BUOYANCY OF PARCEL IN LAYER K-1 CONVEC2A.701
CL--------------------------------------------------------------------- CONVEC2A.702
CL CONVEC2A.703
WORK(I,16) = WORK(I,13)*(1.0 + CONVEC2A.704
* C_VIRTUAL * WORK(I,14)) CONVEC2A.705
* - WORK(I,2)*(1.0 + CONVEC2A.706
* C_VIRTUAL * WORK(I,4)) CONVEC2A.707
C CONVEC2A.708
C---------------------------------------------------------------------- CONVEC2A.709
C INITIATE CONVECTION WHERE BUOYANCY IS LARGE ENOUGH CONVEC2A.710
C---------------------------------------------------------------------- CONVEC2A.711
C CONVEC2A.712
BWORK(I,3) = .NOT.BWORK(I,4) .AND. WORK(I,16) .GT. CONVEC2A.713
* (WORK(I,20)+ XSBMIN) CONVEC2A.714
C CONVEC2A.715
C---------------------------------------------------------------------- CONVEC2A.716
C CALCULATE INITIAL MASSFLUX FROM LAYER K CONVEC2A.717
C---------------------------------------------------------------------- CONVEC2A.718
C CONVEC2A.719
IF (BWORK(I,3)) CONVEC2A.720
1 WORK(I,19) = 1.0E-3 * WORK(I,18) * (D + C * WORK(I,18) * CONVEC2A.721
2 ((WORK(I,16) - XSBMIN) / WORK(I,17))) CONVEC2A.722
110 CONTINUE CONVEC2A.723
C CONVEC2A.724
C---------------------------------------------------------------------- CONVEC2A.725
C LIMIT MASSFLUX IN LOWEST CONVECTING LAYER TO BE <= MASS OF LAYER CONVEC2A.726
C OR CONVEC2A.727
C IF K=1 ADJUST ENTRAINMENT RATE IN BOTTOM HALF OF LAYER 2 SO CONVEC2A.728
C NOT TO AFFECT THE MASS FLUX AT MID-POINT OF LAYER 2 CONVEC2A.729
C---------------------------------------------------------------------- CONVEC2A.730
C CONVEC2A.731
IF ( K .EQ. 1 ) THEN CONVEC2A.732
C CONVEC2A.733
DO I=1,NCONV CONVEC2A.734
C CONVEC2A.735
C-------------------------------------------------------------------- CONVEC2A.736
C CARRY OUT CALCULATION IF CONVECTION WAS INITIATED FROM LAYER 1 CONVEC2A.737
C-------------------------------------------------------------------- CONVEC2A.738
C CONVEC2A.739
IF ( BWORK(I,3) ) THEN CONVEC2A.740
C CONVEC2A.741
C-------------------------------------------------------------------- CONVEC2A.742
C CALCULATE MASS FLUX AT MID-POINT OF LAYER 2 USING STANDARD CONVEC2A.743
C ENTRAINMENT RATES CONVEC2A.744
C-------------------------------------------------------------------- CONVEC2A.745
C CONVEC2A.746
FLX2 = WORK(I,19) * (1.0 + WORK(I,11)) * (1.0 + WORK(I,12)) CONVEC2A.747
C CONVEC2A.748
C-------------------------------------------------------------------- CONVEC2A.749
C IF MASS FLUX IN LAYER 2 EXCEEDS MASS OF LAYER THEN LIMIT MASS FLUX CONVEC2A.750
C OVER A TIMESTEP TO MASS OF LAYER CONVEC2A.751
C-------------------------------------------------------------------- CONVEC2A.752
C CONVEC2A.753
IF (WORK(I,19) .GT. WORK(I,21)) THEN CONVEC2A.754
C CONVEC2A.755
WORK(I,19) = WORK(I,21) CONVEC2A.756
C CONVEC2A.757
C-------------------------------------------------------------------- CONVEC2A.758
C IF MASS FLUX AT MID-POINT OF LAYER 2 EXCEEDS THE MASS OF THE COLUMN CONVEC2A.759
C DOWN TO THE SURFACE OVER THE TIMESTEP THEN LIMIT MASS FLUX CONVEC2A.760
C-------------------------------------------------------------------- CONVEC2A.761
C CONVEC2A.762
IF ( FLX2 .GT. WORK(I,22)) FLX2 = WORK(I,22) CONVEC2A.763
C CONVEC2A.764
C-------------------------------------------------------------------- CONVEC2A.765
C ADJUST ENTRAINMENT RATE IN BOTTOM HALF OF LAYER 2 CONVEC2A.766
C-------------------------------------------------------------------- CONVEC2A.767
C CONVEC2A.768
WORK(I,12) = (FLX2/(WORK(I,19) * (1.0 + WORK(I,11)))) - 1.0 CONVEC2A.769
END IF CONVEC2A.770
C CONVEC2A.771
END IF CONVEC2A.772
END DO CONVEC2A.773
C CONVEC2A.774
C--------------------------------------------------------------------- CONVEC2A.775
C RECALCULATE ASCENT FROM LAYER 1 TO 2 USING ADJUSTED ENTRAINMENT RATE CONVEC2A.776
C--------------------------------------------------------------------- CONVEC2A.777
C CONVEC2A.778
CALL LIFT_PAR (NCONV,WORK(1,13),WORK(1,14),WORK(1,15), CONVEC2A.779
* BWORK(1,2),BWORK(1,1),WORK(1,7),WORK(1,8), CONVEC2A.780
* WORK(1,2),WORK(1,4),WORK(1,1),WORK(1,3), CONVEC2A.781
* WORK(1,5),WORK(1,6),WORK(1,9), CONVEC2A.782
* WORK(1,10),WORK(1,11),WORK(1,12)) CONVEC2A.783
C CONVEC2A.784
DO I=1,NCONV CONVEC2A.785
C CONVEC2A.786
IF ( BWORK(I,3) ) THEN CONVEC2A.787
CL CONVEC2A.788
CL--------------------------------------------------------------------- CONVEC2A.789
CL RECALCULATE BUOYANCY OF PARCEL IN LAYER K-1 CONVEC2A.790
CL--------------------------------------------------------------------- CONVEC2A.791
CL CONVEC2A.792
WORK(I,16) = WORK(I,13)*(1.0 + CONVEC2A.793
* C_VIRTUAL * WORK(I,14)) CONVEC2A.794
* - WORK(I,2)*(1.0 + CONVEC2A.795
* C_VIRTUAL * WORK(I,4)) CONVEC2A.796
C CONVEC2A.797
C---------------------------------------------------------------------- CONVEC2A.798
C RESET MASK TO INITIATE CONVECTION WHERE BUOYANCY IS LARGE ENOUGH CONVEC2A.799
C---------------------------------------------------------------------- CONVEC2A.800
C CONVEC2A.801
BWORK(I,3) = .NOT.BWORK(I,4) .AND. WORK(I,16) .GT. CONVEC2A.802
* (WORK(I,20)+ XSBMIN) CONVEC2A.803
C CONVEC2A.804
BWORK(I,4) = BWORK(I,4) .OR. BWORK(I,3) CONVEC2A.805
C CONVEC2A.806
END IF CONVEC2A.807
C CONVEC2A.808
FLX(INDEX1(I),K) = WORK(I,19) CONVEC2A.809
C CONVEC2A.810
END DO CONVEC2A.811
C CONVEC2A.812
C---------------------------------------------------------------------- CONVEC2A.813
C END OF CALCULATION FOR LAYER 1 CONVEC2A.814
C---------------------------------------------------------------------- CONVEC2A.815
C CONVEC2A.816
ELSE CONVEC2A.817
C CONVEC2A.818
DO I=1,NCONV CONVEC2A.819
C CONVEC2A.820
C---------------------------------------------------------------------- CONVEC2A.821
C IF MASS FLUX OUT OF THE INITIAL LAYER IS GREATER THAN THE MASS OF CONVEC2A.822
C THE LAYER OVER THE TIMESTEP THEN LIMIT MASS FLUX TO MASSS OF LAYER CONVEC2A.823
C---------------------------------------------------------------------- CONVEC2A.824
C CONVEC2A.825
IF (BWORK(I,3) .AND. WORK(I,19).GT.WORK(I,21)) CONVEC2A.826
1 WORK(I,19) = WORK(I,21) CONVEC2A.827
C CONVEC2A.828
BWORK(I,4) = BWORK(I,4) .OR. BWORK(I,3) CONVEC2A.829
C CONVEC2A.830
FLX(INDEX1(I),K) = WORK(I,19) CONVEC2A.831
C CONVEC2A.832
END DO CONVEC2A.833
C CONVEC2A.834
END IF CONVEC2A.835
C CONVEC2A.836
CL CONVEC2A.837
CL-------------------------------------------------------------------- CONVEC2A.838
CL ZERO MIXING DETRAINMENT RATE WHEN CONVECTION STARTS FROM LAYER K CONVEC2A.839
CL-------------------------------------------------------------------- CONVEC2A.840
CL CONVEC2A.841
DO I=1,NCONV CONVEC2A.842
IF ( BWORK(I,3) ) AMDETK(INDEX1(I))=0.0 CONVEC2A.843
END DO CONVEC2A.844
CL CONVEC2A.845
CL-------------------------------------------------------------------- CONVEC2A.846
CL COMPRESS DOWN THOSE POINTS WHICH ARE NOT BUOYANT IN LAYER K-1 CONVEC2A.847
CL-------------------------------------------------------------------- CONVEC2A.848
CL CONVEC2A.849
NINIT = 0 CONVEC2A.850
DO 115 I=1,NCONV CONVEC2A.854
IF(BWORK(I,4))THEN CONVEC2A.855
NINIT = NINIT + 1 CONVEC2A.856
INDEX2(NINIT) = I CONVEC2A.857
END IF CONVEC2A.858
115 CONTINUE CONVEC2A.859
C CONVEC2A.861
C CONVEC2A.862
C---------------------------------------------------------------------- CONVEC2A.863
C WORK SPACE USAGE FOR SECOND COMPRESS ON BASIS OF WHETHER CONVEC2A.864
C PARCEL A PARCEL STARTING FROM LAYER K IS BUOYANT IN LAYER CONVEC2A.865
C K+1 OR IF CONVECTION ALREADY EXISTS IN LAYER K CONVEC2A.866
C CONVEC2A.867
C REFERENCES TO WORK, WORK2, BWORK AND BWORK2 CONVEC2A.868
C REFER TO STARTING ADDRESS CONVEC2A.869
C CONVEC2A.870
C LENGTH OF COMPRESSES DATA = NINIT CONVEC2A.871
C CONVEC2A.872
C WORK2 AND BWORK2 ARE COMPRESSED DOWN FROM COMPRESSED CONVEC2A.873
C ARRAYS STORED IN WORK AND BWORK AFTER FIST COMPRESS CONVEC2A.874
C CONVEC2A.875
C WORK2(1,1) = TH(#,K) CONVEC2A.876
C WORK2(1,2) = TH(#,K+1) CONVEC2A.877
C WORK2(1,3) = Q(#,K) CONVEC2A.878
C WORK2(1,4) = Q(#,K+1) CONVEC2A.879
C WORK2(1,5) = QSE(#,K+1) CONVEC2A.880
C WORK2(1,6) = DQSTHKP1(#) CONVEC2A.881
C WORK2(1,7) = THP(#,K) CONVEC2A.882
C WORK2(1,8) = QP(#,K) CONVEC2A.883
C WORK2(1,9) = PKP1(#) CONVEC2A.884
C WORK2(1,10) = EXKP1(#) CONVEC2A.885
C WORK2(1,11) = EKP14(#) CONVEC2A.886
C WORK2(1,12) = EKP34(#) CONVEC2A.887
C WORK2(1,13) = PARCEL POT. TEMPERATURE IN LAYER K+1 CONVEC2A.888
C WORK2(1,14) = PARCEL MIXING RATIO IN LAYER K+1 CONVEC2A.889
C WORK2(1,15) = EXCESS WATER VAPOUR IN PARCEL ABOVE CONVEC2A.890
C SATURATION AFTER DRY ASCENT CONVEC2A.891
C WORK2(1,16) = PARCEL BUOYANCY IN LAYER K+1 CONVEC2A.892
C WORK2(1,17) = NOT USED IN THIS SECTION CONVEC2A.893
C WORK2(1,18) = PSTAR(#) CONVEC2A.894
C WORK2(1,19) = FLX(#,K) CONVEC2A.895
C CONVEC2A.896
C BWORK2(1,1) = BWATER(INDEX1(I),K+1) CONVEC2A.897
C BWORK2(1,2) = .TRUE. IF PARCEL SATURATED IN LAYER K+1 CONVEC2A.898
C BWORK2(1,3) = .TRUE. IF CONVECTION INITIATE FROM LAYER K+1 CONVEC2A.899
C CONVEC2A.900
C WORK AND BWORK NOW CONTAIN DATA COMPRESSED DOWN CONVEC2A.901
C FROM FULL LENGTH VECTORS CONVEC2A.902
C CONVEC2A.903
C WORK(1,1) = not used in this section CONVEC2A.904
C WORK(1,2) = QSE(#,K) CONVEC2A.905
C WORK(1,3) = DQSTHK(#) CONVEC2A.906
C WORK(1,4) = THPI(#) CONVEC2A.907
C WORK(1,5) = QPI(#) CONVEC2A.908
C WORK(1,6) = XPK(#) CONVEC2A.909
C WORK(1,7) = not used in this section CONVEC2A.910
C WORK(1,8) = DEPTH(#) CONVEC2A.911
C WORK(1,9) = PRECIP(#,K+1) CONVEC2A.912
C WORK(1,10) = DTHBYDT(#,K) CONVEC2A.913
C WORK(1,11) = DQBYDT(#,K) CONVEC2A.914
C WORK(1,12) = DTHBYDT(#,K+1) CONVEC2A.915
C WORK(1,13) = DQBYDT(#,K+1) CONVEC2A.916
C WORK(1,14) = AMDETK(#) CONVEC2A.917
C WORK(1,15) = NOY USED IN THIS SECTION CONVEC2A.918
C WORK(1,16) = PK(#) CONVEC2A.919
C WORK(1,17) = EXK(#) CONVEC2A.920
C WORK(1,18) = DELEXKP1(#) CONVEC2A.921
C WORK(1,19) = DELPK(#) CONVEC2A.922
C WORK(1,20) = DELPKP1(#) CONVEC2A.923
C WORK(1,21) = CCW(#,K+1) PI080793.39
C CONVEC2A.924
C BWORK(1,1) = BGMK(#) CONVEC2A.925
C BWORK(1,2) = BLAND(#) CONVEC2A.926
C BWORK(1,3) = BTERM(#) CONVEC2A.927
C BWORK(1,2) = BLAND(#) CONVEC2A.928
C---------------------------------------------------------------------- CONVEC2A.929
C CONVEC2A.930
IF (NINIT .NE. 0) THEN CONVEC2A.931
C CONVEC2A.932
C----------------------------------------------------------------------- CONVEC2A.933
C FIRST COMPRESS DOWN QUANTITIES FROM PREVIOUSLY COMPRESSED ARRAY CONVEC2A.934
C----------------------------------------------------------------------- CONVEC2A.935
C CONVEC2A.936
DO 120 I=1,NINIT CONVEC2A.937
WORK2(I,1) = WORK(INDEX2(I),1) CONVEC2A.938
WORK2(I,2) = WORK(INDEX2(I),2) CONVEC2A.939
WORK2(I,3) = WORK(INDEX2(I),3) CONVEC2A.940
WORK2(I,4) = WORK(INDEX2(I),4) CONVEC2A.941
WORK2(I,5) = WORK(INDEX2(I),5) CONVEC2A.942
WORK2(I,6) = WORK(INDEX2(I),6) CONVEC2A.943
WORK2(I,7) = WORK(INDEX2(I),7) CONVEC2A.944
WORK2(I,8) = WORK(INDEX2(I),8) CONVEC2A.945
WORK2(I,9) = WORK(INDEX2(I),9) CONVEC2A.946
WORK2(I,10) = WORK(INDEX2(I),10) CONVEC2A.947
WORK2(I,11) = WORK(INDEX2(I),11) CONVEC2A.948
WORK2(I,12) = WORK(INDEX2(I),12) CONVEC2A.949
WORK2(I,13) = WORK(INDEX2(I),13) CONVEC2A.950
WORK2(I,14) = WORK(INDEX2(I),14) CONVEC2A.951
WORK2(I,15) = WORK(INDEX2(I),15) CONVEC2A.952
WORK2(I,16) = WORK(INDEX2(I),16) CONVEC2A.953
WORK2(I,17) = WORK(INDEX2(I),17) CONVEC2A.954
WORK2(I,18) = WORK(INDEX2(I),18) CONVEC2A.955
WORK2(I,19) = WORK(INDEX2(I),19) CONVEC2A.956
BWORK2(I,1) = BWORK(INDEX2(I),1) CONVEC2A.957
BWORK2(I,2) = BWORK(INDEX2(I),2) CONVEC2A.958
BWORK2(I,3) = BWORK(INDEX2(I),3) CONVEC2A.959
120 CONTINUE CONVEC2A.960
C CONVEC2A.961
C---------------------------------------------------------------------- CONVEC2A.962
C COMPRESS DOWN REST OF DATA FROM FULL ARRAYS CONVEC2A.963
C CONVEC2A.964
C FIRST EXPAND BACK BWORK(1,2) (=BINIT) BACK TO FULL VECTORS CONVEC2A.965
C---------------------------------------------------------------------- CONVEC2A.966
C CONVEC2A.967
CDIR$ IVDEP CONVEC2A.968
! Fujitsu vectorization directive GRB0F405.203
!OCL NOVREC GRB0F405.204
DO 130 I=1,NCONV CONVEC2A.969
BINIT(INDEX1(I)) = BWORK(I,4) CONVEC2A.970
130 CONTINUE CONVEC2A.971
C CONVEC2A.972
NINIT = 0 CONVEC2A.973
DO 135 I=1,NPNTS CONVEC2A.977
IF(BINIT(I))THEN CONVEC2A.978
NINIT = NINIT + 1 CONVEC2A.979
INDEX3(NINIT) = I CONVEC2A.980
END IF CONVEC2A.981
135 CONTINUE CONVEC2A.982
C CONVEC2A.984
DO 140 I=1,NINIT CONVEC2A.985
WORK(I,2) = QSE(INDEX3(I),K) CONVEC2A.986
WORK(I,3) = DQSTHK(INDEX3(I)) CONVEC2A.987
WORK(I,4) = THPI(INDEX3(I)) CONVEC2A.988
WORK(I,5) = QPI(INDEX3(I)) CONVEC2A.989
WORK(I,6) = XPK(INDEX3(I)) CONVEC2A.990
WORK(I,8) = DEPTH(INDEX3(I)) CONVEC2A.991
CCAC(I) = CCA(INDEX3(I)) CONVEC2A.992
ICCBC(I) = ICCB(INDEX3(I)) CONVEC2A.993
ICCTC(I) = ICCT(INDEX3(I)) CONVEC2A.994
TCWC(I) = TCW(INDEX3(I)) CONVEC2A.995
CCLWPC(I) = CCLWP(INDEX3(I)) CONVEC2A.996
LCCAC(I) = LCCA(INDEX3(I)) ! beware - LCCAC & LCBASEC ARN2F304.210
LCBASEC(I) = LCBASE(INDEX3(I)) ! are IN/OUT to lower levels ARN2F304.211
LCTOPC(I) = LCTOP(INDEX3(I)) ARN2F304.212
LCCLWPC(I) = LCCLWP(INDEX3(I)) ARN2F304.213
BWORK(I,1) = BGMK(INDEX3(I)) CONVEC2A.997
BWORK(I,2) = BLAND(INDEX3(I)) CONVEC2A.998
WORK(I,10) = DTHBYDT(INDEX3(I),K) CONVEC2A.999
WORK(I,11) = DQBYDT(INDEX3(I),K) CONVEC2A.1000
WORK(I,12) = DTHBYDT(INDEX3(I),K+1) CONVEC2A.1001
WORK(I,13) = DQBYDT(INDEX3(I),K+1) CONVEC2A.1002
WORK(I,14) = AMDETK(INDEX3(I)) CONVEC2A.1003
WORK(I,16) = PK(INDEX3(I)) CONVEC2A.1004
WORK(I,17) = EXK(INDEX3(I)) CONVEC2A.1005
WORK(I,18) = DELEXKP1(INDEX3(I)) CONVEC2A.1006
WORK(I,19) = DELPK(INDEX3(I)) CONVEC2A.1007
WORK(I,20) = DELPKP1(INDEX3(I)) CONVEC2A.1008
CAPE_C(I) = CAPE(INDEX3(I)) API2F400.189
C CONVEC2A.1009
BWORK(I,4) = .TRUE. CONVEC2A.1010
140 CONTINUE CONVEC2A.1011
CL CONVEC2A.1012
CL---------------------------------------------------------------------- CONVEC2A.1013
CL CALCULATE REST OF PARCEL ASCENT AND EFFECT OF CONVECTION CONVEC2A.1014
CL UPON THE LARGE-SCALE ATMOSPHERE CONVEC2A.1015
CL CONVEC2A.1016
CL SUBROUTINE CONVEC2 CONVEC2A.1017
CL CONVEC2A.1018
CL UM DOCUMENTATION PAPER P27 CONVEC2A.1019
CL SECTIONS (5),(6),(7),(8),(9),(10) CONVEC2A.1020
CL---------------------------------------------------------------------- CONVEC2A.1021
CL CONVEC2A.1022
CALL CONVEC2 (NINIT,NLEV,K,WORK2(1,1),WORK2(1,2),WORK2(1,3), CONVEC2A.1023
* WORK2(1,4),WORK2(1,5),WORK2(1,6),WORK2(1,18), CONVEC2A.1024
* WORK2(1,7),WORK2(1,8),WORK2(1,13),WORK2(1,14), CONVEC2A.1025
* WORK2(1,15),WORK2(1,16),WORK(1,2),WORK(1,3), CONVEC2A.1026
* WORK(1,4),WORK(1,5),WORK(1,6),WORK2(1,19), CONVEC2A.1027
* BWORK2(1,1),BWORK2(1,2),BWORK(1,1),BWORK2(1,3), CONVEC2A.1028
* BWORK(1,2),BWORK(1,3),WORK(1,8),WORK(1,9), CONVEC2A.1029
* WORK(1,10),WORK(1,11),WORK(1,12),WORK(1,13), CONVEC2A.1030
* BWORK(1,4),CCAC,ICCBC,ICCTC,TCWC, CONVEC2A.1031
* WORK2(1,11),WORK2(1,12),WORK(1,14), CONVEC2A.1032
* WORK(1,16),WORK2(1,9),WORK(1,17),WORK2(1,10), CONVEC2A.1033
* WORK(1,18),WORK(1,19),WORK(1,20), CONVEC2A.1034
* CCLWPC,WORK(1,21),LCCAC,LCBASEC,LCTOPC,LCCLWPC, API2F400.190
* CAPE_C) API2F400.191
CL CONVEC2A.1036
CL--------------------------------------------------------------------- CONVEC2A.1037
CL EXPAND REQUIRED VECTORS BACK TO FULL FIELDS CONVEC2A.1038
CL---------------------------------------------------------------------- CONVEC2A.1039
CL CONVEC2A.1040
DO 145 I=1,NPNTS CONVEC2A.1041
THP(I,K+1) = 0.0 CONVEC2A.1042
QP(I,K+1) = 0.0 CONVEC2A.1043
XPK(I) = 0.0 CONVEC2A.1044
FLX(I,K+1)= 0.0 CONVEC2A.1045
DEPTH(I) = 0.0 CONVEC2A.1046
PRECIP(I,K+1) = 0.0 CONVEC2A.1047
BGMK(I) = .FALSE. CONVEC2A.1048
BTERM(I) = .FALSE. CONVEC2A.1049
BINIT(I) = .FALSE. CONVEC2A.1050
145 CONTINUE CONVEC2A.1051
C CONVEC2A.1052
CDIR$ IVDEP CONVEC2A.1053
! Fujitsu vectorization directive GRB0F405.205
!OCL NOVREC GRB0F405.206
DO 150 I=1,NINIT CONVEC2A.1054
THP(INDEX3(I),K+1) = WORK2(I,7) CONVEC2A.1055
QP(INDEX3(I),K+1) = WORK2(I,8) CONVEC2A.1056
XPK(INDEX3(I)) = WORK(I,6) CONVEC2A.1057
FLX(INDEX3(I),K+1) = WORK2(I,19) CONVEC2A.1058
DEPTH(INDEX3(I)) = WORK(I,8) CONVEC2A.1059
PRECIP(INDEX3(I),K+1) = WORK(I,9) CONVEC2A.1060
DTHBYDT(INDEX3(I),K) = WORK(I,10) CONVEC2A.1061
DQBYDT(INDEX3(I),K) = WORK(I,11) CONVEC2A.1062
DTHBYDT(INDEX3(I),K+1) = WORK(I,12) CONVEC2A.1063
DQBYDT(INDEX3(I),K+1) = WORK(I,13) CONVEC2A.1064
CCA(INDEX3(I)) = CCAC(I) CONVEC2A.1065
ICCB(INDEX3(I)) = ICCBC(I) CONVEC2A.1066
ICCT(INDEX3(I)) = ICCTC(I) CONVEC2A.1067
TCW(INDEX3(I)) = TCWC(I) CONVEC2A.1068
CCLWP(INDEX3(I)) = CCLWPC(I) CONVEC2A.1069
LCCA(INDEX3(I)) = LCCAC(I) ARN2F304.215
LCBASE(INDEX3(I)) = LCBASEC(I) ARN2F304.216
LCTOP(INDEX3(I)) = LCTOPC(I) ARN2F304.217
LCCLWP(INDEX3(I)) = LCCLWPC(I) ARN2F304.218
CCW(INDEX3(I),K+1) = WORK(I,21) PI080793.41
CAPE(INDEX3(I)) = CAPE_C(I) API2F400.192
C CONVEC2A.1070
BGMK(INDEX3(I)) = BWORK(I,1) CONVEC2A.1071
BTERM(INDEX3(I)) = BWORK(I,3) CONVEC2A.1072
BINIT(INDEX3(I)) = BWORK(I,4) CONVEC2A.1073
150 CONTINUE CONVEC2A.1074
C CONVEC2A.1075
END IF CONVEC2A.1076
C CONVEC2A.1077
END IF CONVEC2A.1078
C------------------------------------------------------------------- API2F400.193
C IF CONVECTION IS TERMINATING, READ VALUE OF CAPE INTO DIAGNOSTIC API2F400.194
C OUTPUT ARRAY AND RESET TO ZERO API2F400.195
C------------------------------------------------------------------- API2F400.196
C API2F400.197
DO I=1,NPNTS API2F400.198
IF(BTERM(I))THEN API2F400.199
CAPE_OUT(I)=CAPE(I) API2F400.200
CAPE(I)=0.0 API2F400.201
END IF API2F400.202
END DO API2F400.203
C API2F400.204
CL CONVEC2A.1079
CL--------------------------------------------------------------------- CONVEC2A.1080
CL DOWNDRAUGHT CALCULATION CONVEC2A.1081
CL CONVEC2A.1082
CL CARRIED OUT FOR THOSE CLOUD WHICH ARE TERMINATING CONVEC2A.1083
CL CONVEC2A.1084
CL SUBROUTINE DD_CALL CONVEC2A.1085
CL CONVEC2A.1086
CL UM DOCUMENTATION PAPER P27 CONVEC2A.1087
CL SECTION (11) CONVEC2A.1088
CL--------------------------------------------------------------------- CONVEC2A.1089
CL CONVEC2A.1090
C CONVEC2A.1091
NTERM = 0 CONVEC2A.1092
DO 160 I=1,NPNTS CONVEC2A.1093
*IF DEF,SCMA AJC0F405.169
DTHUD(I,K) = DTHBYDT(I,K) AJC0F405.170
DQUD(I,K) = DQBYDT(I,K) AJC0F405.171
*ENDIF AJC0F405.172
IF (BTERM(I)) THEN CONVEC2A.1094
NTERM = NTERM + 1 CONVEC2A.1095
END IF CONVEC2A.1096
160 CONTINUE CONVEC2A.1097
C CONVEC2A.1098
IF (NTERM .NE. 0) THEN CONVEC2A.1099
C CONVEC2A.1100
CALL DD_CALL (NP_FIELD,NPNTS,K,THP(1,1),QP(1,1),TH(1,1),Q(1,1), CONVEC2A.1101
* DTHBYDT(1,1),DQBYDT(1,1),FLX(1,1),PSTAR, CONVEC2A.1102
* AK,BK,AKM12,BKM12,DELAK,DELBK,EXNER(1,1), CONVEC2A.1103
* PRECIP(1,1),RAIN,SNOW,ICCB,ICCT,BWATER(1,2), CONVEC2A.1104
* BTERM,BGMK,TIMESTEP,CCA,NTERM,recip_pstar) GSS1F403.96
C CONVEC2A.1106
C--------------------------------------------------------------------- CONVEC2A.1107
C ADJUSTMENT TO CLOUD BASE, TOP AND AMOUNT CONVEC2A.1108
C CONVEC2A.1109
C IF CLOUD BASE AND TOP ARE EQUAL THEN ERRORS OCCUR IN RADIATION SCHEME CONVEC2A.1110
C CONVEC2A.1111
C ONLY OCCURS IF CONVECTION SATURATES UPON FORCED DETRAINMENT CONVEC2A.1112
C CONVEC2A.1113
C WHEN OCCURS ZERO CLOUD BASE, TOP AND AMOUNT CONVEC2A.1114
C CONVEC2A.1115
C--------------------------------------------------------------------- CONVEC2A.1116
C CONVEC2A.1117
DO I=1,NPNTS CONVEC2A.1118
IF (BTERM(I) .AND. ICCB(I) .EQ. ICCT(I)) THEN CONVEC2A.1119
ICCB(I) = 0.0 CONVEC2A.1120
ICCT(I) = 0.0 CONVEC2A.1121
CCA(I) = 0.0 CONVEC2A.1122
TCW(I) = 0.0 CONVEC2A.1123
CCLWP(I) = 0.0 CONVEC2A.1124
END IF ARN2F304.219
IF (BTERM(I) .AND. LCBASE(I) .EQ. LCTOP(I)) THEN ARN2F304.220
LCBASE(I) = 0 ARN2F304.221
LCTOP(I) = 0 ARN2F304.222
LCCA(I) = 0.0 ARN2F304.223
LCCLWP(I) = 0.0 ARN2F304.224
END IF CONVEC2A.1125
END DO CONVEC2A.1126
C CONVEC2A.1127
C--------------------------------------------------------------------- CONVEC2A.1128
C RESET BTERM TO FALSE CONVEC2A.1129
C--------------------------------------------------------------------- CONVEC2A.1130
C CONVEC2A.1131
DO 200 I=1,NPNTS CONVEC2A.1132
200 BTERM(I) = .FALSE. CONVEC2A.1133
C CONVEC2A.1134
END IF CONVEC2A.1135
CL CONVEC2A.1136
CL===================================================================== CONVEC2A.1137
CL END OF MAIN LOOP CONVEC2A.1138
CL===================================================================== CONVEC2A.1139
CL CONVEC2A.1140
60 CONTINUE CONVEC2A.1141
CL CONVEC2A.1142
CL--------------------------------------------------------------------- CONVEC2A.1143
CL BALANCE ENERGY BUDGET BY APPLYING CORRECTION TO THE TEMPERATURES CONVEC2A.1144
CL CONVEC2A.1145
CL SUBROUTINE COR_ENGY CONVEC2A.1146
CL CONVEC2A.1147
CL UM DOCUMENTATION PAPER P27 CONVEC2A.1148
CL SECTION (12) CONVEC2A.1149
CL--------------------------------------------------------------------- CONVEC2A.1150
CL CONVEC2A.1151
NCNLV = 0 CONVEC2A.1152
DO 210 I=1,NPNTS CONVEC2A.1156
IF(BCNLV(I))THEN CONVEC2A.1157
NCNLV = NCNLV + 1 CONVEC2A.1158
INDEX4(NCNLV) = I CONVEC2A.1159
END IF CONVEC2A.1160
210 CONTINUE CONVEC2A.1161
C CONVEC2A.1163
C CONVEC2A.1164
C---------------------------------------------------------------------- CONVEC2A.1165
C WORK SPACE USAGE FOR ENERGY CORRECTION CALCULATION CONVEC2A.1166
C CONVEC2A.1167
C REFERENCES TO WORK AND WORK2 CONVEC2A.1168
C REFER TO STARTING ADDRESS CONVEC2A.1169
C CONVEC2A.1170
C LENGTH OF COMPRESSES DATA = NCNLV CONVEC2A.1171
C CONVEC2A.1172
C WORK(1,1 TO NLEV) = DTHBYDT(#,1 TO NLEV) CONVEC2A.1173
C WORK(1,NLEV+1 TO 2*NLEV) = DQBYDT(#,1 TO NLEV) CONVEC2A.1174
C WORK2(1,1 TO NLEV+1) = EXNER(#,1 TO NLEV+1) CONVEC2A.1175
C WORK2(1,NLEV+2) = TH(#,1) CONVEC2A.1176
C WORK2(1,NLEV+3) = PSTAR(#) CONVEC2A.1177
C---------------------------------------------------------------------- CONVEC2A.1178
C CONVEC2A.1179
IF (NCNLV .NE. 0)THEN CONVEC2A.1180
C CONVEC2A.1187
CALL COR_ENGY (NP_FIELD,NPNTS,NCNLV,NLEV,DTHBYDT,DQBYDT,SNOW, GSS1F403.97
* EXNER,PSTAR,DELAK,DELBK,AKM12,BKM12,INDEX4) GSS1F403.98
C CONVEC2A.1193
CL CONVEC2A.1204
CL--------------------------------------------------------------------- CONVEC2A.1205
CL UPDATE MODEL POTENTIAL TEMPERATURE AND MIXING RATIO CONVEC2A.1206
CL WITH INCREMENTS DUE TO CONVECTION CONVEC2A.1207
CL--------------------------------------------------------------------- CONVEC2A.1208
CL CONVEC2A.1209
DO 250 K=1,NLEV CONVEC2A.1210
DO 250 I=1,NPNTS CONVEC2A.1211
*IF DEF,SCMA AJC0F405.173
DTHDD(I,K) = DTHBYDT(I,K) - DTHUD(I,K) AJC0F405.174
DQDD(I,K) = DQBYDT(I,K) - DQUD(I,K) AJC0F405.175
*ENDIF AJC0F405.176
TH(I,K) = TH(I,K) + DTHBYDT(I,K) * TIMESTEP CONVEC2A.1212
Q(I,K) = Q(I,K) + DQBYDT(I,K) * TIMESTEP CONVEC2A.1213
CL AJX1F402.159
CL--------------------------------------------------------------------- AJX1F402.160
CL CALCULATE GRIDBOX MEAN DIAGNOSTICS AJX1F402.161
CL--------------------------------------------------------------------- AJX1F402.162
CL AJX1F402.163
IF (CCA(I) .NE. 0.0) THEN AJX1F402.164
GBMCCW(I,K) = CCA(I) * CCW(I,K) AJX1F402.165
IF (K.EQ.NLEV) THEN AJX1F402.166
GBMCCWP(I) = CCA(I) * CCLWP(I) AJX1F402.167
ICCBPxCCA(I) = CCA(I) * AJX1F402.168
* (AK(ICCB(I)) + BK(ICCB(I)) * PSTAR(I)) AJX1F402.169
ICCTPxCCA(I) = CCA(I) * AJX1F402.170
* (AK(ICCT(I)) + BK(ICCT(I)) * PSTAR(I)) AJX1F402.171
END IF AJX1F402.172
ENDIF AJX1F402.173
250 CONTINUE CONVEC2A.1214
C CONVEC2A.1215
END IF CONVEC2A.1216
C CONVEC2A.1217
RETURN CONVEC2A.1218
END CONVEC2A.1219
C CONVEC2A.1220
*ENDIF CONVEC2A.1221