*IF DEF,A05_2A,OR,DEF,A05_2C,OR,DEF,A05_3B AJX1F405.139
C ******************************COPYRIGHT****************************** GTS2F400.7165
C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved. GTS2F400.7166
C GTS2F400.7167
C Use, duplication or disclosure of this code is subject to the GTS2F400.7168
C restrictions as set forth in the contract. GTS2F400.7169
C GTS2F400.7170
C Meteorological Office GTS2F400.7171
C London Road GTS2F400.7172
C BRACKNELL GTS2F400.7173
C Berkshire UK GTS2F400.7174
C RG12 2SZ GTS2F400.7175
C GTS2F400.7176
C If no contract has been raised with this copy of the code, the use, GTS2F400.7177
C duplication or disclosure of it is strictly prohibited. Permission GTS2F400.7178
C to do so must first be obtained in writing from the Head of Numerical GTS2F400.7179
C Modelling at the above address. GTS2F400.7180
C ******************************COPYRIGHT****************************** GTS2F400.7181
C GTS2F400.7182
CLL SUBROUTINE PARCEL------------------------------------------------- PARCEL1A.3
CLL PARCEL1A.4
CLL PURPOSE : COMPLETES LIFTING OF THE PARCEL FROM LAYER K TO K+1 PARCEL1A.5
CLL PARCEL1A.6
CLL CALL SUBROUTINE DETRAIN, TERM_CON, CLOUD_W PARCEL1A.7
CLL PARCEL1A.8
CLL AN INITIAL MASS FLUX IS CALCULATED PARCEL1A.9
CLL PARCEL1A.10
CLL SUBROUTINE DETRAIN CARRIES OUT THE FORCED DETRAINMENT PARCEL1A.11
CLL CALCULATION PARCEL1A.12
CLL PARCEL1A.13
CLL SUBROUTINE TERM_CON TESTS FOR ANY CONVECTION WHICH IS PARCEL1A.14
CLL TERMINATING IN LAYER K+1 PARCEL1A.15
CLL PARCEL1A.16
CLL SUBROUTINE CLOUD_W CARRIES OUT THE CLOUD MICROPHYSICS PARCEL1A.17
CLL CALCULATION PARCEL1A.18
CLL PARCEL1A.19
CLL SUITABLE FOR SINGLE COLUMN MODEL USE PARCEL1A.20
CLL PARCEL1A.21
CLL CODE REWORKED FOR CRAY Y-MP BY D.GREGORY AUTUMN/WINTER 1989/90 PARCEL1A.22
CLL THE RELEVANT POINTS IN CONVECT PARCEL1A.23
CLL PARCEL1A.24
CLL MODEL MODIFICATION HISTORY FROM MODEL VERSION 3.0: PARCEL1A.25
CLL VERSION DATE PARCEL1A.26
CLL 3.2 8/07/93 : added convective cloud condensed water diagnostic PI080793.49
CLL : P Inness PI080793.50
CLL 3.4 21/03/94 Add lowest conv.cloud diagnostics. R.T.H.Barnes. ARN2F304.89
CLL 4.2 Oct. 96 T3E migration: *DEF CRAY removed GSS1F402.100
CLL S.J.Swarbrick GSS1F402.101
CLL 4.4 26/09/97 Logical L_CCW passed in to determine if precip is AJX0F404.399
CLL included in water path. MPARWTR passed down as an AJX0F404.400
CLL argument at versions 3A and 3B. J.M.Gregory AJX0F404.401
CLL 4.5 Jul. 98 Kill the IBM specific lines (JCThil) AJC1F405.14
CLL PARCEL1A.27
CLL PROGRAMMING STANDARDS : UNIFIED MODEL DOCUMENTATION PAPER NO. 4 PARCEL1A.28
CLL VERSION NO. 1 PARCEL1A.29
CLL PARCEL1A.30
CLL LOGICAL COMPONENTS COVERED: P27 PARCEL1A.31
CLL PARCEL1A.32
CLL DOCUMENTATION : UNIFIED MODEL DOCUMENTATION PAPER P27 PARCEL1A.33
CLL PARCEL1A.34
CLLEND----------------------------------------------------------------- PARCEL1A.35
C PARCEL1A.36
C*L ARGUMENTS--------------------------------------------------------- PARCEL1A.37
SUBROUTINE PARCEL (K,NPNTS,NLEV,PSTAR,THEKP1,THEK,QEKP1,QEK, 3,6PARCEL1A.38
* QSEK,QSEKP1,DQSK,DQSKP1,BLAND,BWKP1, PARCEL1A.39
* DELTAK,FLXK,THPK,QPK,THRK,QRK, PARCEL1A.40
* BTERM,THPKP1,QPKP1,PREKP1,XPK,XPKP1,FLXKP1, PARCEL1A.41
* XSQKP1,THPI,QPI,BGMK,BGMKP1,BLOWST,RBUOY, PARCEL1A.42
* CCA,ICCB,ICCT,TCW,DEPTH, PARCEL1A.43
* EKP14,EKP34,AMDETK,DELPKP1,PK,PKP1, PARCEL1A.44
* EXK,EXKP1,DELEXKP1,CCLWP,CCW, ARN2F304.90
* LCCA,LCBASE,LCTOP,LCCLWP,L_SHALLOW,L_CCW AJX0F404.402
*IF DEF,A05_3B AJX1F405.140
& ,MPARWTR AJX0F404.404
*ENDIF AJX0F404.405
& ,UD_FACTOR AJX3F405.9
& ) AJX0F404.406
C PARCEL1A.46
IMPLICIT NONE PARCEL1A.47
C PARCEL1A.48
C---------------------------------------------------------------------- PARCEL1A.49
C MODEL CONSTANTS PARCEL1A.50
C---------------------------------------------------------------------- PARCEL1A.51
C PARCEL1A.52
*CALL XSBMIN 
PARCEL1A.53
*CALL MASSFC PARCEL1A.54
C PARCEL1A.55
C---------------------------------------------------------------------- PARCEL1A.56
C VECTOR LENGTHS AND LOOP COUNTERS PARCEL1A.57
C---------------------------------------------------------------------- PARCEL1A.58
C PARCEL1A.59
INTEGER NPNTS ! IN VECTOR LENGTH PARCEL1A.63
C PARCEL1A.64
INTEGER NLEV ! IN NUMBER OF MODEL LEVELS PARCEL1A.65
C PARCEL1A.66
INTEGER NDET ! COMPRESSED VECTOR LENGTH FOR PARCEL1A.67
! FORCED DETRAINMENT CALCULATION PARCEL1A.68
C PARCEL1A.69
INTEGER K ! IN PRESENT MODEL LAYER PARCEL1A.70
C PARCEL1A.71
INTEGER I ! LOOP COUNTER PARCEL1A.72
C PARCEL1A.73
C PARCEL1A.74
C---------------------------------------------------------------------- PARCEL1A.75
C VARIABLES WHICH ARE INPUT AJX3F405.10
C---------------------------------------------------------------------- PARCEL1A.77
C PARCEL1A.78
REAL THEK(NPNTS) ! IN POTENTIAL TEMPERATURE OF CLOUD PARCEL1A.79
! ENVIRONMENT IN LAYER K (K) PARCEL1A.80
C PARCEL1A.81
REAL THEKP1(NPNTS) ! IN POTENTIAL TEMPERATURE OF CLOUD PARCEL1A.82
! ENVIRONMENT IN LAYER K+1 (K) PARCEL1A.83
C PARCEL1A.84
REAL QEK(NPNTS) ! IN MIXING RATIO OF CLOUD PARCEL1A.85
! ENVIRONMENT IN LAYER K (KG/KG) PARCEL1A.86
C PARCEL1A.87
REAL QEKP1(NPNTS) ! IN MIXING RATIO OF CLOUD PARCEL1A.88
! ENVIRONMENT IN LAYER K+1 (KG/KG) PARCEL1A.89
C PARCEL1A.90
REAL QSEKP1(NPNTS) ! IN SATURATION MIXING RATIO OF CLOUD PARCEL1A.91
! ENVIRONMENT IN LAYER K+1 (KG/KG) PARCEL1A.92
C PARCEL1A.93
REAL DQSKP1(NPNTS) ! IN GRADIENT OF SATURATION MIXING RATIO PARCEL1A.94
! WITH POTENTIAL TEMPERATURE FOR THE PARCEL1A.95
! CLOUD ENVIRONMENT IN LAYER K+1 PARCEL1A.96
! (KG/KG/K) PARCEL1A.97
C PARCEL1A.98
REAL PSTAR(NPNTS) ! IN SURFACE PRESSURE (PA) PARCEL1A.99
C PARCEL1A.100
REAL THPK(NPNTS) ! IN PARCEL POTENTIAL TEMPERATURE PARCEL1A.101
! IN LAYER K (KG/KG) PARCEL1A.102
C PARCEL1A.103
REAL QPK(NPNTS) ! IN PARCEL MIXING RATIO IN LAYER K (KG/KG) PARCEL1A.104
C PARCEL1A.105
REAL XSQKP1(NPNTS) ! IN EXCESS PARCEL WATER AFER LIFTING FROM PARCEL1A.106
! LAYER K TO K+1 (KG/KG) PARCEL1A.107
C PARCEL1A.108
REAL RBUOY(NPNTS) ! IN PARCEL BUOYANCY IN LAYER K+1 (K) PARCEL1A.109
C PARCEL1A.110
REAL QSEK(NPNTS) ! IN SATURATION MIXING RATIO OF CLOUD PARCEL1A.111
! ENVIRONMENT IN LAYER K (KG/KG) PARCEL1A.112
C PARCEL1A.113
REAL DQSK(NPNTS) ! IN GRADIENT OF SATURATION MIXING RATIO PARCEL1A.114
! WITH POTENTIAL TEMPERATURE FOR THE PARCEL1A.115
! CLOUD ENVIRONMENT OF LAYER K PARCEL1A.116
! (KG/KG/K) PARCEL1A.117
C PARCEL1A.118
REAL THPI(NPNTS) ! IN INITIAL PARCEL POTENTIAL TEMPERATURE PARCEL1A.119
! (K) PARCEL1A.120
C PARCEL1A.121
REAL QPI(NPNTS) ! IN INITIAL PARCEL MIXING RATIO (KG/KG) PARCEL1A.122
C PARCEL1A.123
REAL XPK(NPNTS) ! IN PARCEL CLOUD WATER IN LAYER K (KG/KG) PARCEL1A.124
C PARCEL1A.125
*IF DEF,A05_3B AJX1F405.141
REAL MPARWTR ! IN Reservoir of conv cld water left AJX0F404.408
! ! in a layer after conv. precip. AJX0F404.409
*ENDIF AJX0F404.410
LOGICAL BWKP1(NPNTS) ! IN MASK FOR WHETHER CONDENSATE IS PARCEL1A.126
! LIQUID IN LAYER K+1 PARCEL1A.127
C PARCEL1A.128
LOGICAL BGMK(NPNTS) ! IN MASK FOR PARCELS WHICH ARE PARCEL1A.129
! SATURATED IN LAYER K PARCEL1A.130
C PARCEL1A.131
LOGICAL BLAND(NPNTS) ! IN LAND/SEA MASK PARCEL1A.132
C PARCEL1A.133
LOGICAL BLOWST(NPNTS) ! IN MASK FOR THOSE POINTS AT WHICH PARCEL1A.134
! STABILITY IS LOW ENOUGH FOR PARCEL1A.135
! CONVECTION TO OCCUR PARCEL1A.136
C PARCEL1A.137
LOGICAL L_SHALLOW(NPNTS) ! IN MASK FOR POINTS WHERE CONVECTION AJX0F404.411
! IS EXPECTED TO BE SHALLOW AJX0F404.412
LOGICAL L_CCW ! IN SWITCH FOR CLOUD WATER CHANGES: AJX0F404.413
! (PRECIP NOT INC. IN WATER PATH) AJX0F404.414
C AJX0F404.415
REAL EKP14(NPNTS) ! IN ENTRAINMENT COEFFICIENT AT LEVEL PARCEL1A.138
! K+1/4 MULTIPLIED BY APPROPRIATE PARCEL1A.139
! LAYER THICKNESS PARCEL1A.140
C PARCEL1A.141
REAL EKP34(NPNTS) ! IN ENTRAINMENT COEFFICIENT AT LEVEL PARCEL1A.142
! K+3/4 MULTIPLIED BY APPROPRIATE PARCEL1A.143
! LAYER THICKNESS PARCEL1A.144
C PARCEL1A.145
REAL AMDETK(NPNTS) ! IN MIXING DETRAINMENT COEFFICIENT PARCEL1A.146
! AT LEVEL K MULTIPLIED BY PARCEL1A.147
! APPROPORIATE LAYER THICKNESS PARCEL1A.148
C PARCEL1A.149
REAL DELPKP1(NPNTS) ! IN PRESSURE DIFFERENCE ACROSS PARCEL1A.150
! LAYER K+1 (PA) PARCEL1A.151
C PARCEL1A.152
REAL PK(NPNTS) ! IN PRESSURE AT LEVEL K (PA) PARCEL1A.153
C PARCEL1A.154
REAL PKP1(NPNTS) ! IN PRESSURE AT LEVEL K+1 (PA) PARCEL1A.155
C PARCEL1A.156
REAL EXK(NPNTS) ! IN EXNER FUNCTION AT LEVEL K PARCEL1A.157
C PARCEL1A.158
REAL EXKP1(NPNTS) ! IN EXNER FUNCTION AT LEVEL K+1 PARCEL1A.159
C PARCEL1A.160
REAL DELEXKP1(NPNTS) ! IN DIFFERENCE IN EXNER FUNCTION ACROSS PARCEL1A.161
! LAYER K+1 PARCEL1A.162
! AJX3F405.11
REAL UD_FACTOR ! IN Updraught factor. Set in user AJX3F405.12
! interface to reduce cloud water AJX3F405.13
! seen by radiation. Used if L_CCW AJX3F405.14
! is set to true. AJX3F405.15
C PARCEL1A.163
C PARCEL1A.164
C--------------------------------------------------------------------- PARCEL1A.165
C VARAIBLES WHICH ARE BOTH INPUT AND OUTPUT PARCEL1A.166
C--------------------------------------------------------------------- PARCEL1A.167
C PARCEL1A.168
REAL THPKP1(NPNTS) ! INOUT PARCEL1A.169
! IN ESTIMATE OF PARCEL POTENTIAL PARCEL1A.170
! TEMPERATURE IN LAYER K+1 AFTER PARCEL1A.171
! ENTRAINMENT AND LATENT HEATING (K) PARCEL1A.172
! OUT FINAL PARCEL POTENTIAL TEMPERATURE PARCEL1A.173
! IN LAYER K+1 (AFTER FORCED PARCEL1A.174
! DETRAINEMNT) (K) PARCEL1A.175
C PARCEL1A.176
REAL QPKP1(NPNTS) ! INOUT PARCEL1A.177
! IN ESTIMATE OF PARCEL MIXING RATIO PARCEL1A.178
! IN LAYER K+1 AFTER ENTRAINMENT AND PARCEL1A.179
! LATENT HEATING (KG/KG) PARCEL1A.180
! OUT FINAL PARCEL MIXING RATIO PARCEL1A.181
! IN LAYER K+1 (AFTER FORCED PARCEL1A.182
! DETRAINEMNT) (KG/KG) PARCEL1A.183
C PARCEL1A.184
REAL FLXK(NPNTS) ! INOUT PARCEL1A.185
! IN PARCEL MASSFLUX IN LAYER K PARCEL1A.186
! (NON-ZERO IF CONVECTION IS NOT PARCEL1A.187
! INITIATED FROM LAYER K) (PA/S) PARCEL1A.188
! OUT PARCEL MASSFLUX IN LAYER K PARCEL1A.189
! (SET IF CONVECTION IS INITIATED PARCEL1A.190
! IN LAYER K) (PA/S) PARCEL1A.191
C PARCEL1A.192
LOGICAL BGMKP1(NPNTS) ! INOUT PARCEL1A.193
! IN MASK FOR PARCELS WHICH ARE PARCEL1A.194
! SATURATED IN LAYER K+1 PARCEL1A.195
! CALCULATED ON THE BASIS OF PARCEL1A.196
! INPUT PARCEL POTENTIAL TEMPERATURE PARCEL1A.197
! AND MIXING RATIO PARCEL1A.198
! OUT MASK FOR PARCELS WHICH ARE PARCEL1A.199
! SATURATED IN LAYER K+1 CALCULATED PARCEL1A.200
! FORM PARCEL TEMPERATURE AND PARCEL1A.201
! MIXING RATIO AFTER FORCED PARCEL1A.202
! DETARINMENT CALCULATION PARCEL1A.203
C PARCEL1A.204
REAL TCW(NPNTS) ! INOUT PARCEL1A.205
! IN TOTAL CONDENSED WATER CONTENT PARCEL1A.206
! SUMMED UPTO LAYER K (KG/M**2/S) PARCEL1A.207
! OUT UPDATED TOTAL CONDENSED WATER PARCEL1A.208
! CONTENT SUMMED UPTO LAYER K+1 PARCEL1A.209
! (KG/M**2/S) PARCEL1A.210
C PARCEL1A.211
REAL DEPTH(NPNTS) ! INOUT PARCEL1A.212
! IN DEPTH OF CONVECTIVE CLOUD TO PARCEL1A.213
! LAYER K (M) PARCEL1A.214
! OUT UPDATED DEPTH OF CONVECTIVE PARCEL1A.215
! CLOUD TO LAYER K+1 (M) PARCEL1A.216
C PARCEL1A.217
REAL CCLWP(NPNTS) ! INOUT PARCEL1A.218
! IN CONDENSED WATER PATH PARCEL1A.219
! SUMMED UPTO LAYER K (KG/M**2) PARCEL1A.220
! OUT UPDATED CONDENSED WATER PATH PARCEL1A.221
! SUMMED UPTO LAYER K+1 (KG/M**2) PARCEL1A.222
C PARCEL1A.223
C PARCEL1A.224
C--------------------------------------------------------------------- PARCEL1A.225
C VARIABLES WHICH ARE OUTPUT PARCEL1A.226
C--------------------------------------------------------------------- PARCEL1A.227
C PARCEL1A.228
LOGICAL BTERM(NPNTS) ! OUT MASK FOR PARCELS WHICH TERMINATE IN PARCEL1A.229
! LAYER K+1 PARCEL1A.230
C PARCEL1A.231
REAL PREKP1(NPNTS) ! OUT PRECIPITATION FROM PARCEL AS IT PARCEL1A.232
! RISES FROM LAYER K TO K+1 (KG/M**2/S) PARCEL1A.233
C PARCEL1A.234
REAL THRK(NPNTS) ! OUT PARCEL DETRAINMENT POTENTIAL PARCEL1A.235
! TEMPERATURE IN LAYER K (K) PARCEL1A.236
C PARCEL1A.237
REAL QRK(NPNTS) ! OUT PARCEL DETRAINMENT MIXING RATIO PARCEL1A.238
! IN LAYER K (KG/KG) PARCEL1A.239
C PARCEL1A.240
REAL XPKP1(NPNTS) ! OUT PARCEL CLOUD WATER IN LAYER K+1 PARCEL1A.241
! (KG/KG) PARCEL1A.242
C PARCEL1A.243
REAL FLXKP1(NPNTS) ! OUT PARCEL MASSFLUX IN LAYER K+1 (PA/S) PARCEL1A.244
C PARCEL1A.245
REAL DELTAK(NPNTS) ! OUT PARCEL FORCED DETRAINMENT PARCEL1A.246
! COEFFICIENT IN LAYER K PARCEL1A.247
! MULTIPLIED BY APPROPRIATE PARCEL1A.248
! LAYER THICKNESS PARCEL1A.249
C PARCEL1A.250
REAL CCA(NPNTS) ! OUT CONVECTIVE CLOUD AMOUNT (%) PARCEL1A.251
C PARCEL1A.252
INTEGER ICCB(NPNTS) ! OUT CONVECTIVE CLOUD BASE LEVEL PARCEL1A.253
C PARCEL1A.254
INTEGER ICCT(NPNTS) ! OUT CONVECTIVE CLOUD TOP LEVEL PARCEL1A.255
C PARCEL1A.256
REAL CCW(NPNTS) ! OUT CONVECTIVE CLOUD LIQUID WATER PI080793.52
! (G/KG) ON MODEL LEVELS PI080793.53
C PARCEL1A.257
REAL LCCA(NPNTS) ! OUT LOWEST CONV.CLOUD AMOUNT (%) ARN2F304.92
C PI080793.54
INTEGER LCBASE(NPNTS) ! OUT LOWEST CONV.CLOUD BASE LEVEL ARN2F304.93
C ARN2F304.94
INTEGER LCTOP(NPNTS) ! OUT LOWEST CONV.CLOUD TOP LEVEL ARN2F304.95
C ARN2F304.96
REAL LCCLWP(NPNTS) ! OUT LOWEST CONV.CLOUD LIQ.WATER PATH ARN2F304.97
C ARN2F304.98
C ARN2F304.99
C--------------------------------------------------------------------- PARCEL1A.258
C VARIABLES WHICH ARE DEFINED LOCALLY PARCEL1A.259
C--------------------------------------------------------------------- PARCEL1A.260
C PARCEL1A.261
REAL THEK_C(NPNTS) ! COMPRESSED POTENTIAL TEMPERATURE OF PARCEL1A.347
! CLOUD ENVIRONMENT IN LAYER K (K) PARCEL1A.348
C PARCEL1A.349
REAL THEKP1_C(NPNTS) ! COMPRESSED POTENTIAL TEMPERATURE OF PARCEL1A.350
! CLOUD ENVIRONMENT IN LAYER K+1 (K) PARCEL1A.351
C PARCEL1A.352
REAL QEK_C(NPNTS) ! COMPRESSED MIXING RATIO OF CLOUD PARCEL1A.353
! ENVIRONMENT IN LAYER K (KG/KG) PARCEL1A.354
C PARCEL1A.355
REAL QEKP1_C(NPNTS) ! COMPRESSED MIXING RATIO OF CLOUD PARCEL1A.356
! ENVIRONMENT IN LAYER K+1 (KG/KG) PARCEL1A.357
C PARCEL1A.358
REAL QSEK_C(NPNTS) ! COMPRESSED SATURATION MIXING RATIO OF PARCEL1A.359
! CLOUD ENVIRONMENT IN LAYER K (KG/KG) PARCEL1A.360
C PARCEL1A.361
REAL DQSK_C(NPNTS) ! COMPRESSED GRADIENT OF SATURATION MIXING PARCEL1A.362
! RATIO WITH POTENTIAL TEMPERATURE FOR THE PARCEL1A.363
! CLOUD ENVIRONMENT OF LAYER K (KG/KG/K) PARCEL1A.364
C PARCEL1A.365
REAL QSEKP1_C(NPNTS) ! COMPRESSED SATURATION MIXING RATIO OF PARCEL1A.366
! CLOUD ENVIRONMENT IN LAYER K+1 (KG/KG) PARCEL1A.367
C PARCEL1A.368
REAL DQSKP1_C(NPNTS) ! COMPRESSED GRADIENT OF SATURATION MIXING PARCEL1A.369
! RATIO WITH POTENTIAL TEMPERATURE FOR PARCEL1A.370
! THE CLOUD ENVIRONMENT IN LAYER K+1 PARCEL1A.371
! (KG/KG/K) PARCEL1A.372
C PARCEL1A.373
REAL THPK_C(NPNTS) ! COMPRESSED PARCEL POTENTIAL PARCEL1A.374
! TEMPERATURE IN LAYER K (K) PARCEL1A.375
C PARCEL1A.376
REAL QPK_C(NPNTS) ! COMPRESSED PARCEL MIXING RATIO IN PARCEL1A.377
! LAYER K (KG/KG) PARCEL1A.378
C PARCEL1A.379
REAL THPKP1_C(NPNTS) ! COMPRESSED PARCEL POTENTIAL PARCEL1A.380
! TEMPERATURE IN LAYER K+1 (K) PARCEL1A.381
C PARCEL1A.382
REAL QPKP1_C(NPNTS) ! COMPRESSED PARCEL MIXING RATIO PARCEL1A.383
! IN LAYER K+1 (KG/KG) PARCEL1A.384
C PARCEL1A.385
REAL XSQKP1_C(NPNTS) ! EXCESS PARCEL WATER AFER LIFTING PARCEL1A.386
! FROM LAYER K TO K+1 (KG/KG) PARCEL1A.387
C PARCEL1A.388
REAL THRK_C(NPNTS) ! COMPRESSED PARCEL DETRAINMENT PARCEL1A.389
! POTENTIAL TEMPERATURE IN LAYER K (K) PARCEL1A.390
C PARCEL1A.391
REAL QRK_C(NPNTS) ! COMPRESSED PARCEL DETRAINMENT MIXING PARCEL1A.392
! RATIO IN LAYER K (KG/KG) PARCEL1A.393
C PARCEL1A.394
REAL DELTAK_C(NPNTS) ! COMPRESSED PARCEL FORCED DETRAINMENT PARCEL1A.395
! COEFFICIENT IN LAYER K PARCEL1A.396
! MULTIPLIED BY APPROPRIATE PARCEL1A.397
! LAYER THICKNESS PARCEL1A.398
C PARCEL1A.399
REAL EKP14_C(NPNTS) ! COMPRESSED IN ENTRAINMENT COEFFICIENT AT PARCEL1A.400
! LEVEL K+1/4 MULTIPLIED BY APPROPRIATE PARCEL1A.401
! LAYER THICKNESS PARCEL1A.402
C PARCEL1A.403
REAL EKP34_C(NPNTS) ! COMPRESSED ENTRAINMENT COEFFICIENT AT PARCEL1A.404
! LEVEL K+3/4 MULTIPLIED BY APPROPRIATE PARCEL1A.405
! LAYER THICKNESS PARCEL1A.406
C PARCEL1A.407
REAL PK_C(NPNTS) ! COMPRESSED PRESSURE AT LEVEL K (PA) PARCEL1A.408
C PARCEL1A.409
REAL PKP1_C(NPNTS) ! COMPRESSED PRESSURE AT LEVEL K+1 (PA) PARCEL1A.410
C PARCEL1A.411
REAL EXK_C(NPNTS) ! COMPRESSED EXNER FUNCTION AT LEVEL K PARCEL1A.412
C PARCEL1A.413
REAL EXKP1_C(NPNTS) ! COMPRESSED EXNER FUNCTION AT LEVEL K+1 PARCEL1A.414
C PARCEL1A.415
LOGICAL BWKP1_C(NPNTS) ! COMPRESSED MASK FOR WHETHER CONDENSATE PARCEL1A.416
! IS LIQUID IN LAYER K+1 PARCEL1A.417
C PARCEL1A.418
LOGICAL BGMK_C(NPNTS) ! COMPRESSED MASK FOR PARCELS WHICH ARE PARCEL1A.419
! SATURATED IN LAYER K PARCEL1A.420
C PARCEL1A.421
LOGICAL BGMKP1_C(NPNTS) ! COMPRESSED MASK FOR PARCELS PARCEL1A.422
! WHICH ARESATURATED IN LAYER K+1 PARCEL1A.423
C PARCEL1A.424
INTEGER INDEX1(NPNTS) ! INDEX FOR COMPRESS AND EXPAND PARCEL1A.425
C PARCEL1A.426
LOGICAL BDETK(NPNTS) ! MASK FOR POINTS UNDERGOING PARCEL1A.427
! FORCED DETRAINMENT PARCEL1A.428
C PARCEL1A.429
C PARCEL1A.431
C---------------------------------------------------------------------- PARCEL1A.432
C EXTERNAL ROUTINES CALLED PARCEL1A.433
C---------------------------------------------------------------------- PARCEL1A.434
C PARCEL1A.435
EXTERNAL DETRAIN,TERM_CON,CLOUD_W PARCEL1A.436
C PARCEL1A.440
C*-------------------------------------------------------------------- PARCEL1A.441
C PARCEL1A.442
C PARCEL1A.443
DO 5 I=1,NPNTS PARCEL1A.444
CL PARCEL1A.445
CL--------------------------------------------------------------------- PARCEL1A.446
CL CALCULATE MASK FOR THOSE POINTS UNDERGOING FORCED DETRAINMENT PARCEL1A.447
CL PARCEL1A.448
CL UM DOCUMENTATION PAPER P27 PARCEL1A.449
CL SECTION (6), EQUATION (23) PARCEL1A.450
CL--------------------------------------------------------------------- PARCEL1A.451
CL PARCEL1A.452
BDETK(I) = RBUOY(I) .LT. XSBMIN PARCEL1A.453
C PARCEL1A.454
5 CONTINUE PARCEL1A.455
CL PARCEL1A.456
CL---------------------------------------------------------------------- PARCEL1A.457
CL COMPRESS ALL INPUT ARRAYS FOR THE FORCED DETRAINMENT CALCULATIONS PARCEL1A.458
CL---------------------------------------------------------------------- PARCEL1A.459
CL PARCEL1A.460
NDET = 0 PARCEL1A.461
DO 10 I=1,NPNTS PARCEL1A.465
IF (BDETK(I))THEN PARCEL1A.466
NDET = NDET + 1 PARCEL1A.467
INDEX1(NDET) = I PARCEL1A.468
END IF PARCEL1A.469
10 CONTINUE PARCEL1A.470
C PARCEL1A.472
IF (NDET .NE. 0) THEN PARCEL1A.473
DO 35 I=1,NDET PARCEL1A.474
THEK_C(I) = THEK(INDEX1(I)) PARCEL1A.475
QEK_C(I) = QEK(INDEX1(I)) PARCEL1A.476
THPK_C(I) = THPK(INDEX1(I)) PARCEL1A.477
QPK_C(I) = QPK(INDEX1(I)) PARCEL1A.478
QSEK_C(I) = QSEK(INDEX1(I)) PARCEL1A.479
DQSK_C(I) = DQSK(INDEX1(I)) PARCEL1A.480
THEKP1_C(I)= THEKP1(INDEX1(I)) PARCEL1A.481
QEKP1_C(I) = QEKP1(INDEX1(I)) PARCEL1A.482
THPKP1_C(I)= THPKP1(INDEX1(I)) PARCEL1A.483
QPKP1_C(I) = QPKP1(INDEX1(I)) PARCEL1A.484
QSEKP1_C(I)= QSEKP1(INDEX1(I)) PARCEL1A.485
DQSKP1_C(I)= DQSKP1(INDEX1(I)) PARCEL1A.486
XSQKP1_C(I)= XSQKP1(INDEX1(I)) PARCEL1A.487
EKP14_C(I) = EKP14(INDEX1(I)) PARCEL1A.488
EKP34_C(I) = EKP34(INDEX1(I)) PARCEL1A.489
PK_C(I) = PK(INDEX1(I)) PARCEL1A.490
PKP1_C(I) = PKP1(INDEX1(I)) PARCEL1A.491
EXK_C(I) = EXK(INDEX1(I)) PARCEL1A.492
EXKP1_C(I) = EXKP1(INDEX1(I)) PARCEL1A.493
C PARCEL1A.494
BGMK_C(I) = BGMK(INDEX1(I)) PARCEL1A.495
BGMKP1_C(I)= BGMKP1(INDEX1(I)) PARCEL1A.496
BWKP1_C(I) = BWKP1(INDEX1(I)) PARCEL1A.497
35 CONTINUE PARCEL1A.498
CL PARCEL1A.499
CL------------------------------------------------------------------- PARCEL1A.500
CL DETRAINMENT CALCULATION PARCEL1A.501
CL PARCEL1A.502
CL SUBROUTINE DETRAIN PARCEL1A.503
CL PARCEL1A.504
CL UM DOCUMENTATION PAPER P27 PARCEL1A.505
CL SECTION (6) PARCEL1A.506
CL------------------------------------------------------------------- PARCEL1A.507
CL PARCEL1A.508
CALL DETRAIN (NDET,THEK_C,QEK_C,THPK_C,QPK_C, PARCEL1A.509
* QSEK_C,DQSK_C,BGMK_C,THEKP1_C, PARCEL1A.510
* QEKP1_C,THPKP1_C,QPKP1_C,QSEKP1_C, PARCEL1A.511
* DQSKP1_C,BGMKP1_C,BWKP1_C, PARCEL1A.512
* XSQKP1_C,DELTAK_C, PARCEL1A.513
* THRK_C,QRK_C,EKP14_C,EKP34_C, PARCEL1A.514
* PK_C,PKP1_C,EXK_C,EXKP1_C) PARCEL1A.515
C PARCEL1A.516
C----------------------------------------------------------------------- PARCEL1A.517
C DECOMPRESS/EXPAND OUTPUT ARRAYS FROM THE DETRAINMENT CALCULATIONS PARCEL1A.518
C----------------------------------------------------------------------- PARCEL1A.519
C PARCEL1A.520
C PARCEL1A.521
CDIR$ IVDEP PARCEL1A.522
! Fujitsu vectorization directive GRB0F405.431
!OCL NOVREC GRB0F405.432
DO 40 I=1,NDET PARCEL1A.523
THPKP1(INDEX1(I)) = THPKP1_C(I) PARCEL1A.524
QPKP1(INDEX1(I)) = QPKP1_C(I) PARCEL1A.525
XSQKP1(INDEX1(I)) = XSQKP1_C(I) PARCEL1A.526
C PARCEL1A.527
BGMKP1(INDEX1(I)) = BGMKP1_C(I) PARCEL1A.528
40 CONTINUE PARCEL1A.529
ENDIF PARCEL1A.530
C PARCEL1A.531
DO 45 I=1,NPNTS PARCEL1A.532
DELTAK(I) = 0.0 PARCEL1A.533
THRK(I) = 0.0 PARCEL1A.534
QRK(I) = 0.0 PARCEL1A.535
45 CONTINUE PARCEL1A.536
C PARCEL1A.537
CDIR$ IVDEP PARCEL1A.538
! Fujitsu vectorization directive GRB0F405.433
!OCL NOVREC GRB0F405.434
DO 50 I=1,NDET PARCEL1A.539
DELTAK(INDEX1(I)) = DELTAK_C(I) PARCEL1A.540
THRK(INDEX1(I)) = THRK_C(I) PARCEL1A.541
QRK(INDEX1(I)) = QRK_C(I) PARCEL1A.542
50 CONTINUE PARCEL1A.543
CL PARCEL1A.544
CL---------------------------------------------------------------------- PARCEL1A.545
CL CALCULATE MASS FLUX AT LEVEL K+1. PARCEL1A.546
CL PARCEL1A.547
CL UM DOCUMENTATION PAPER P27 PARCEL1A.548
CL SECTION (2B), EQUATION (10A) PARCEL1A.549
CL---------------------------------------------------------------------- PARCEL1A.550
CL PARCEL1A.551
DO 60 I=1,NPNTS PARCEL1A.552
FLXKP1(I) = FLXK(I)*(1.+EKP14(I))*(1.+EKP34(I))*(1.-DELTAK(I))* PARCEL1A.553
* (1.-AMDETK(I)) PARCEL1A.554
60 CONTINUE PARCEL1A.555
CL PARCEL1A.556
CL--------------------------------------------------------------------- PARCEL1A.557
CL TEST FOR POINTS AT WHICH CONVECTION TERMINATES IN LAYER K+1 PARCEL1A.558
CL PARCEL1A.559
CL SUBROUTINE TERM_CON PARCEL1A.560
CL PARCEL1A.561
CL UM DOCUMENTATION PAPER P27 PARCEL1A.562
CL SECTION (7) PARCEL1A.563
CL--------------------------------------------------------------------- PARCEL1A.564
CL PARCEL1A.565
CALL TERM_CON (NPNTS,NLEV,K,BTERM,BWKP1,FLXKP1,THEKP1,QEKP1,THPI, PARCEL1A.566
* QPI,QSEKP1,DELTAK,EXKP1,EKP14,EKP34,PSTAR) PARCEL1A.567
CL PARCEL1A.568
CL---------------------------------------------------------------------- PARCEL1A.569
CL CLOUD MICROPHYSICS CALCULATION PARCEL1A.570
CL PARCEL1A.571
CL SUBROUTINE CLOUD_W PARCEL1A.572
CL PARCEL1A.573
CL UM DOCUMENTATION PAPER P27 PARCEL1A.574
CL SECTION (8), (9) PARCEL1A.575
CL---------------------------------------------------------------------- PARCEL1A.576
CL PARCEL1A.577
CALL CLOUD_W (K,NPNTS,XPKP1,PREKP1,XSQKP1,BLOWST,FLXKP1, PARCEL1A.578
* XPK,THEKP1,QEKP1,BWKP1,BLAND,QSEKP1,BGMKP1, PARCEL1A.579
* BTERM,CCA,ICCB,ICCT,TCW,DEPTH,EKP14,EKP34,DELEXKP1, PARCEL1A.580
* CCLWP,DELPKP1,CCW,LCCA,LCBASE,LCTOP,LCCLWP,L_SHALLOW, AJX0F404.416
* L_CCW AJX0F404.417
*IF DEF,A05_3B AJX1F405.142
& ,MPARWTR AJX0F404.419
*ENDIF AJX0F404.420
& ,UD_FACTOR AJX3F405.16
& ) AJX0F404.421
C PARCEL1A.582
RETURN PARCEL1A.583
END PARCEL1A.584
*ENDIF PARCEL1A.585