SUBROUTINE CONVECT(NP_FIELD,NPNTS,NLEV,NBL,TH,Q,PSTAR,BLAND,U,V, 3,46CONVEC3C.64
* TRACER,DTHBYDT,DQBYDT,DUBYDT,DVBYDT,RAIN,SNOW, CONVEC3C.65
* CCA,ICCB,ICCT,CCLWP,CCW,ICCBPxCCA,ICCTPxCCA, CONVEC3C.66
* GBMCCWP,GBMCCW,LCBASE,LCTOP,LCCA, CONVEC3C.67
* LCCLWP,CAPE_OUT,EXNER,AK,BK, CONVEC3C.68
* AKM12,BKM12,DELAK,DELBK,TIMESTEP,T1_SD,Q1_SD, CONVEC3C.69
& L_MOM,L_TRACER,L_CAPE,NTRA,TRLEV,L_XSCOMP, CONVEC3C.70
& L_SDXS,N_CCA_LEV,L_3D_CCA,L_CCW,MPARWTR CONVEC3C.71
& ,ANVIL_FACTOR ,TOWER_FACTOR CONVEC3C.72
*IF DEF,MPP CONVEC3C.73
& ,l_halo CONVEC3C.74
*ENDIF CONVEC3C.75
& ,UD_FACTOR,L_CLOUD_DEEP,L_PHASE_LIM AJX1F405.21
& ,UP_FLUX,FLG_UP_FLX,DWN_FLUX,FLG_DWN_FLX AJX1F405.22
& ,ENTRAIN_UP,FLG_ENTR_UP,DETRAIN_UP AJX1F405.23
& ,FLG_DETR_UP,ENTRAIN_DWN,FLG_ENTR_DWN AJX1F405.24
& ,DETRAIN_DWN,FLG_DETR_DWN AJX1F405.25
& ) CONVEC3C.76
! CONVEC3C.77
IMPLICIT NONE CONVEC3C.78
C CONVEC3C.79
C CONVEC3C.83
C-------------------------------------------------------------------- CONVEC3C.84
C MODEL CONSTANTS CONVEC3C.85
C-------------------------------------------------------------------- CONVEC3C.86
C CONVEC3C.87
*CALL PARXS 
CONVEC3C.88
*CALL C_EPSLON CONVEC3C.89
*CALL C_R_CP CONVEC3C.90
*CALL XSBMIN CONVEC3C.91
*CALL MPARB CONVEC3C.92
*CALL DELTHST CONVEC3C.93
*CALL C_LHEAT CONVEC3C.94
*CALL MASSFC CONVEC3C.95
*CALL ENTCNST CONVEC3C.96
*CALL CAPECNST CONVEC3C.97
*CALL QSTICE CONVEC3C.98
*CALL C_0_DG_C CONVEC3C.99
*CALL C_G AJX4F405.8
C CONVEC3C.100
*IF DEF,CRAY CONVEC3C.101
*IF DEF,CRAY,AND,-DEF,T3D CONVEC3C.102
INTRINSIC MINVAL ! FOR TRACERS CONVEC3C.103
*ENDIF CONVEC3C.104
*ENDIF CONVEC3C.105
C--------------------------------------------------------------------- CONVEC3C.106
C VECTOR LENGTHS AND LOOP COUNTERS CONVEC3C.107
C--------------------------------------------------------------------- CONVEC3C.108
C CONVEC3C.109
INTEGER NP_FIELD ! LENGTH OF DATA (ALSO USED TO CONVEC3C.110
! SPECIFY STARTING POINT OF CONVEC3C.111
! DATA PASSED IN) CONVEC3C.112
C CONVEC3C.113
INTEGER NPNTS ! IN FULL VECTOR LENGTH CONVEC3C.114
C CONVEC3C.115
INTEGER NLEV ! IN NUMBER OF MODEL LAYERS CONVEC3C.116
C CONVEC3C.117
INTEGER NBL ! IN NUMBER OF BOUNDARY LAYER LEVELS CONVEC3C.118
C CONVEC3C.119
INTEGER NCONV ! NUMBER OF POINTS WHICH PASS CONVEC3C.120
! INITIAL STABILITY TEST IN LAYER K CONVEC3C.121
C CONVEC3C.122
INTEGER NINIT ! NUMBER OF POINTS AT WHICH CONVEC3C.123
! CONVECTION OCCURS IN LAYER K CONVEC3C.124
C CONVEC3C.125
INTEGER NTERM ! NUMBER OF CONVECTING POINTS IN CONVEC3C.126
! LAYER K AT WHICH CONVECTION IS CONVEC3C.127
! TERMINATING CONVEC3C.128
C CONVEC3C.129
INTEGER NCNLV ! NUMBER OF POINTS AT WHICH CONVECTION CONVEC3C.130
! OCCURS AT SOME LAYER OF THE DOMAIN CONVEC3C.131
C CONVEC3C.132
INTEGER NTRA ! NUMBER OF TRACER FIELDS CONVEC3C.133
C CONVEC3C.134
INTEGER TRLEV ! NUMBER OF MODEL LEVELS ON WHICH CONVEC3C.135
! TRACERS ARE INCLUDED CONVEC3C.136
C CONVEC3C.137
INTEGER I,K,KC,KTRA,K_TEST, ! LOOP COUNTERS CONVEC3C.138
* KT CONVEC3C.139
C CONVEC3C.140
INTEGER N_CCA_LEV ! Number of levels for conv cloud CONVEC3C.141
! ! amount: 1 for 2D, nlevs for 3D. CONVEC3C.142
C CONVEC3C.143
C--------------------------------------------------------------------- CONVEC3C.144
C VARIABLES WHICH ARE INPUT CONVEC3C.145
C--------------------------------------------------------------------- CONVEC3C.146
C CONVEC3C.147
LOGICAL BLAND(NP_FIELD) ! IN LAND/SEA MASK CONVEC3C.148
C CONVEC3C.149
LOGICAL L_TRACER ! IN SWITCH FOR INCLUSION OF TRACERS CONVEC3C.150
C CONVEC3C.151
LOGICAL L_MOM ! IN SWITCH FOR INCLUSION OF CONVEC3C.152
! MOMENTUM TRANSPORTS CONVEC3C.153
C CONVEC3C.154
LOGICAL L_CAPE ! IN SWITCH FOR USE OF CAPE CLOSURE CONVEC3C.155
C CONVEC3C.156
LOGICAL L_XSCOMP ! IN Switch for allowing compensating CONVEC3C.157
! cooling and drying of the CONVEC3C.158
! environment in initiating layer CONVEC3C.159
C CONVEC3C.160
LOGICAL L_SDXS ! IN Switch for allowing parcel excess CONVEC3C.161
! to be set to s.d. of turbulent CONVEC3C.162
! fluctuations in lowest model CONVEC3C.163
! layer CONVEC3C.164
C CONVEC3C.165
LOGICAL L_3D_CCA ! IN Switch for conv cld amt varying CONVEC3C.166
! ! with height (3D), or not (2D) CONVEC3C.167
LOGICAL L_CCW ! IN Switch for allowing precip CONVEC3C.168
! before calculation of water CONVEC3C.169
! path. CONVEC3C.170
! AJX1F405.26
LOGICAL L_PHASE_LIM ! IN Switch to determine if phase AJX1F405.27
! ! change of precip is limited so LH AJX1F405.28
! ! does not make temp go other side AJX1F405.29
! ! of TM. AJX1F405.30
! AJX1F405.31
LOGICAL L_CLOUD_DEEP ! IN Switch for depth criterion for AJX1F405.32
! ! anvil clouds. AJX1F405.33
! AJX1F405.34
REAL PSTAR(NP_FIELD) ! IN SURFACE PRESSURE (PA) CONVEC3C.171
C CONVEC3C.172
REAL EXNER(NP_FIELD,NLEV+1) ! IN EXNER RATIO CONVEC3C.173
C CONVEC3C.174
REAL AK(NLEV), ! IN HYBRID CO-ORDINATE COEFFICIENTS CONVEC3C.175
* BK(NLEV) ! DEFINE PRESSURE AT MID-POINT CONVEC3C.176
! OF LAYER K CONVEC3C.177
C CONVEC3C.178
REAL AKM12(NLEV+1), ! IN HYBRID CO-ORDINATE COEFFICIENTS CONVEC3C.179
* BKM12(NLEV+1) ! TO DEFINE PRESSURE AT CONVEC3C.180
! LEVEL K-1/2 CONVEC3C.181
C CONVEC3C.182
REAL DELAK(NLEV), ! IN DIFFERENCE IN HYBRID CO-ORDINATE CONVEC3C.183
* DELBK(NLEV) ! COEFFICIENTS ACROSS LAYER K CONVEC3C.184
C CONVEC3C.185
REAL TIMESTEP ! IN MODEL TIMESTEP (SECS) CONVEC3C.186
C CONVEC3C.187
REAL T1_SD(NP_FIELD) ! IN Standard deviation of turbulent CONVEC3C.188
C ! fluctuations of layer 1 CONVEC3C.189
C ! temperature (K). CONVEC3C.190
REAL Q1_SD(NP_FIELD) ! IN Standard deviation of turbulent CONVEC3C.191
C ! fluctuations of layer 1 CONVEC3C.192
C ! humidity (kg/kg). CONVEC3C.193
REAL MPARWTR ! IN Reservoir of conv cld water left CONVEC3C.194
! ! in a layer after conv. precip. CONVEC3C.195
REAL ANVIL_FACTOR ! IN used in calculation of cld. amt. CONVEC3C.196
& ,TOWER_FACTOR ! on model levels if L_3D_CCA = .T. CONVEC3C.197
! AJX3F405.52
REAL UD_FACTOR ! IN Updraught factor: used in conv. AJX3F405.53
! ! cloud water path as seen by rad. AJX3F405.54
! ! if L_CCW is true. AJX3F405.55
CONVEC3C.198
*IF DEF,MPP CONVEC3C.199
LOGICAL l_halo(NP_FIELD) ! Mask for halos CONVEC3C.200
*ENDIF CONVEC3C.201
LOGICAL FLG_UP_FLX ! STASH FLAG FOR UPDRAUGHT MASS FLUX API2F405.236
C CONVEC3C.202
LOGICAL FLG_DWN_FLX ! STASH FLAG FOR DOWNDRAUGHT MASS FLUX API2F405.237
C API2F405.238
LOGICAL FLG_ENTR_UP ! STASH FLAG FOR UPDRAUGHT ENTRAINMENT API2F405.239
C API2F405.240
LOGICAL FLG_ENTR_DWN ! STASH FLAG FOR DOWNDRAUGHT ENTRAINMN API2F405.241
C API2F405.242
LOGICAL FLG_DETR_UP ! STASH FLAG FOR UPDRAUGHT DETRAINMENT API2F405.243
C API2F405.244
LOGICAL FLG_DETR_DWN ! STASH FLAG FOR DOWNDRAUGHT DETRAINMN API2F405.245
C API2F405.246
C--------------------------------------------------------------------- CONVEC3C.203
C VARIABLES WHICH ARE INPUT AND OUTPUT CONVEC3C.204
C--------------------------------------------------------------------- CONVEC3C.205
C CONVEC3C.206
REAL TH(NP_FIELD,NLEV) ! INOUT CONVEC3C.207
! IN MODEL POTENTIAL TEMPERATURE (K) CONVEC3C.208
! OUT MODEL POTENTIAL TEMPERATURE CONVEC3C.209
! AFTER CONVECTION (K) CONVEC3C.210
C CONVEC3C.211
REAL Q(NP_FIELD,NLEV) ! INOUT CONVEC3C.212
! IN MODEL MIXING RATIO (KG/KG) CONVEC3C.213
! OUT MODEL MIXING RATIO AFTER CONVEC3C.214
! AFTER CONVECTION (KG/KG) CONVEC3C.215
C CONVEC3C.216
REAL U(NP_FIELD,NLEV) ! INOUT CONVEC3C.217
! IN MODEL U FIELD (M/S) CONVEC3C.218
! OUT MODEL U FIELD AFTER CONVECTIVE CONVEC3C.219
! MOMENTUM TRANSPORT (M/S) CONVEC3C.220
C CONVEC3C.221
REAL V(NP_FIELD,NLEV) ! INOUT CONVEC3C.222
! IN MODEL V FIELD (M/S) CONVEC3C.223
! OUT MODEL V FIELD AFTER CONVECTIVE CONVEC3C.224
! MOMENTUM TRANSPORT (M/S) CONVEC3C.225
C CONVEC3C.226
REAL TRACER(NP_FIELD,TRLEV, ! INOUT CONVEC3C.227
* NTRA) ! IN MODEL TRACER FIELDS (KG/KG) CONVEC3C.228
! OUT MODEL TRACER FIELDS AFTER CONVEC3C.229
! CONVECTION (KG/KG) CONVEC3C.230
C CONVEC3C.231
C CONVEC3C.232
C---------------------------------------------------------------------- CONVEC3C.233
C VARIABLES WHICH ARE OUTPUT CONVEC3C.234
C---------------------------------------------------------------------- CONVEC3C.235
C CONVEC3C.236
REAL DTHBYDT(NP_FIELD,NLEV) ! OUT INCREMENTS TO POTENTIAL CONVEC3C.237
! TEMPERATURE DUE TO CONVECTION CONVEC3C.238
! (K/S) CONVEC3C.239
C CONVEC3C.240
REAL DQBYDT(NP_FIELD,NLEV) ! OUT INCREMENTS TO MIXING RATIO CONVEC3C.241
! DUE TO CONVECTION (KG/KG/S) CONVEC3C.242
C CONVEC3C.243
REAL DUBYDT(NP_FIELD,NLEV) ! OUT INCREMENTS TO U DUE TO CONVEC3C.244
! CONVECTIVE MOMENTUM TRANSPORT CONVEC3C.245
! (M/S**2) CONVEC3C.246
C CONVEC3C.247
REAL DVBYDT(NP_FIELD,NLEV) ! OUT INCREMENTS TO V DUE TO CONVEC3C.248
! CONVECTIVE MOMENTUM TRANSPORT CONVEC3C.249
! (M/S**2) CONVEC3C.250
C CONVEC3C.251
REAL RAIN(NP_FIELD) ! OUT SURFACE CONVECTIVE RAINFALL CONVEC3C.252
! (KG/M**2/S) CONVEC3C.253
C CONVEC3C.254
REAL SNOW(NP_FIELD) ! OUT SURFACE CONVECTIVE SNOWFALL CONVEC3C.255
! (KG/M**2/S) CONVEC3C.256
C CONVEC3C.257
REAL CCA(NP_FIELD,N_CCA_LEV)! OUT CONVECTIVE CLOUD AMOUNT (%) CONVEC3C.258
C CONVEC3C.259
INTEGER ICCB(NP_FIELD) ! OUT CONVECTIVE CLOUD BASE LEVEL CONVEC3C.260
C CONVEC3C.261
INTEGER ICCT(NP_FIELD) ! OUT CONVECTIVE CLOUD TOP LEVEL CONVEC3C.262
C CONVEC3C.263
REAL CCLWP(NP_FIELD) ! OUT CONDENSED WATER PATH (KG/M**2) CONVEC3C.264
C CONVEC3C.265
REAL CCW(NP_FIELD,NLEV) ! OUT CONVECTIVE CLOUD LIQUID WATER CONVEC3C.266
! (G/KG) ON MODEL LEVELS CONVEC3C.267
C CONVEC3C.268
REAL ICCBPxCCA(NP_FIELD) ! OUT CONV. CLD BASE PRESSURE x CCA CONVEC3C.269
C CONVEC3C.270
REAL ICCTPxCCA(NP_FIELD) ! OUT CONV. CLD TOP PRESSURE x CCA CONVEC3C.271
C CONVEC3C.272
REAL GBMCCWP(NP_FIELD) ! OUT GRIDBOX MEAN CCWP CONVEC3C.273
C CONVEC3C.274
REAL GBMCCW(NP_FIELD,NLEV) ! OUT GRIDBOX MEAN CCW CONVEC3C.275
C CONVEC3C.276
REAL LCCA(NP_FIELD) ! OUT LOWEST CONV.CLOUD AMOUNT (%) CONVEC3C.277
C CONVEC3C.278
INTEGER LCBASE(NP_FIELD) ! OUT LOWEST CONV.CLOUD BASE LEVEL CONVEC3C.279
C CONVEC3C.280
INTEGER LCTOP(NP_FIELD) ! OUT LOWEST CONV.CLOUD TOP LEVEL CONVEC3C.281
C CONVEC3C.282
REAL LCCLWP(NP_FIELD) ! OUT CONDENSED WATER PATH (KG/M**2) CONVEC3C.283
! FOR LOWEST CONV.CLOUD CONVEC3C.284
C CONVEC3C.285
REAL CAPE_OUT(NPNTS) ! OUT SAVED VALUES OF CONVECTIVE CONVEC3C.286
! AVAILABLE POTENTIAL ENERGY CONVEC3C.287
! FOR DIAGNOSTIC OUTPUT CONVEC3C.288
REAL UP_FLUX(NP_FIELD,NLEV) ! OUT UPDRAUGHT MASS FLUX API2F405.247
C CONVEC3C.289
REAL DWN_FLUX(NP_FIELD,NLEV) ! OUT DOWNDRAUGHT MASS FLUX API2F405.248
C API2F405.249
REAL ENTRAIN_UP(NP_FIELD,NLEV) ! FRACTIONAL ENTRAINMENT RATE API2F405.250
! INTO UPDRAUGHTS API2F405.251
REAL DETRAIN_UP(NP_FIELD,NLEV) ! FRACTIONAL DETRAINMENT RATE API2F405.252
! FROM UPDRAUGHTS API2F405.253
REAL ENTRAIN_DWN(NP_FIELD,NLEV) ! FRACTIONAL ENTRAINMENT RATE API2F405.254
! INTO DOWNDRAUGHTS API2F405.255
REAL DETRAIN_DWN(NP_FIELD,NLEV) ! FRACTIONAL DETRAINMENT RATE API2F405.256
! FROM DOWNDRAUGHTS API2F405.257
C API2F405.258
C API2F405.259
C---------------------------------------------------------------------- CONVEC3C.290
C VARIABLES DEFINED LOCALLY CONVEC3C.291
C CONVEC3C.292
REAL WORK(NPNTS,NLEV*2), ! WORK SPACE CONVEC3C.535
* WORK2(NPNTS,NLEV*2) CONVEC3C.536
LOGICAL BWORK(NPNTS,4), ! WORK SPACE FOR 'BIT' MASKS CONVEC3C.537
* BWORK2(NPNTS,4) CONVEC3C.538
C CONVEC3C.539
REAL CAPE(NPNTS) ! CONVECTIVE AVAILABLE POTENTIAL CONVEC3C.540
! ENERGY (J/KG) CONVEC3C.541
C CONVEC3C.542
REAL DCPBYDT(NPNTS) ! RATE OF CHANGE OF CAPE CONVEC3C.543
C CONVEC3C.544
REAL CAPE_C(NPNTS) ! CAPE - COMPRESSED CONVEC3C.545
C CONVEC3C.546
REAL DCPBYDT_C(NPNTS) ! RATE OF CHANGE OF CAPE - COMPRESSED CONVEC3C.547
C CONVEC3C.548
REAL DTHEF(NPNTS) ! THETA INCREMENT FROM CONVECTION CONVEC3C.549
! IN MODEL LEVEL AT WHICH SPLIT CONVEC3C.550
! FINAL DETRAINMENT LAST OCCURRED CONVEC3C.551
! (K/S) CONVEC3C.552
C CONVEC3C.553
REAL DQF(NPNTS) ! SPECIFIC HUMIDITY INCREMENT FROM CONVEC3C.554
! CONVECTION IN MODEL LEVEL AT WHICH CONVEC3C.555
! SPLIT FINAL DETRAINMENT LAST CONVEC3C.556
! OCCURRED (KG/KG/S) CONVEC3C.557
C CONVEC3C.558
REAL DUEF(NPNTS) ! AS DTHEF BUT FOR U INCREMENTS (ms-2) API1F405.31
! API1F405.32
REAL DVEF(NPNTS) ! AS DTHEF BUT FOR V INCREMENTS (ms-2) API1F405.33
! API1F405.34
LOGICAL BCONV(NPNTS) ! MASK FOR POINTS WHERE STABILITY CONVEC3C.559
! LOW ENOUGH FOR CONVECTION CONVEC3C.560
! TO OCCUR CONVEC3C.561
C CONVEC3C.562
REAL QSE(NPNTS,NLEV) ! SATURATION MIXING RATIO OF CLOUD CONVEC3C.563
! ENVIRONMENT (KG/KG) CONVEC3C.564
C CONVEC3C.565
REAL TT(NPNTS) ! TEMPORARY STORE FOR TEMPERATURE CONVEC3C.566
! IN CALCULATION OF SATURATION CONVEC3C.567
! MIXING RATIO (K) CONVEC3C.568
C CONVEC3C.569
REAL TTKM1(NPNTS) ! TEMPORARY STORE FOR TEMPERATURE CONVEC3C.570
! IN LAYER K-1 FOR USE IN FREEZING CONVEC3C.571
! LEV. CALCULATION FOR ANVIL (K) CONVEC3C.572
C CONVEC3C.573
REAL PT(NPNTS) ! TEMPORARY STORE FOR PRESSURE CONVEC3C.574
! IN CALCULATION OF SATURATION CONVEC3C.575
! MIXING RATIO (PA) CONVEC3C.576
C CONVEC3C.577
REAL CCA_2DC(NPNTS) ! COMPRESSED VALUES OF 2D CCA CONVEC3C.578
C CONVEC3C.579
INTEGER ICCBC(NPNTS) ! COMPRESSED VALUES OF CCB CONVEC3C.580
C CONVEC3C.581
INTEGER ICCTC(NPNTS) ! COMPRESSED VALUES OF CCT CONVEC3C.582
C CONVEC3C.583
REAL TCW(NPNTS) ! TOTAL CONDENSED WATER (KG/M**2/S) CONVEC3C.584
C CONVEC3C.585
REAL TCWC(NPNTS) ! COMPRESSED VALUES OF TCW CONVEC3C.586
C CONVEC3C.587
REAL CCLWPC(NPNTS) ! COMPRESSED VALUE OF CCLWP CONVEC3C.588
C CONVEC3C.589
REAL LCCAC(NPNTS) ! COMPRESSED VALUES OF LCCA CONVEC3C.590
C CONVEC3C.591
INTEGER LCBASEC(NPNTS) ! COMPRESSED VALUES OF LCBASE CONVEC3C.592
C CONVEC3C.593
INTEGER LCTOPC(NPNTS) ! COMPRESSED VALUES OF LCTOP CONVEC3C.594
C CONVEC3C.595
REAL LCCLWPC(NPNTS) ! COMPRESSED VALUE OF LCCLWP CONVEC3C.596
C CONVEC3C.597
REAL DQSTHK(NPNTS) ! GRADIENT OF SATURATION MIXING CONVEC3C.598
! RATIO OF CLOUD ENVIRONMENT WITH CONVEC3C.599
! POTENTIAL TEMPERATURE IN LAYER K CONVEC3C.600
! (KG/KG/K) CONVEC3C.601
C CONVEC3C.602
REAL DQSTHKP1(NPNTS) ! GRADIENT OF SATURATION MIXING CONVEC3C.603
! RATIO OF CLOUD ENVIRONMENT WITH CONVEC3C.604
! POTENTIAL TEMPERATURE IN LAYER K+1 CONVEC3C.605
! (KG/KG/K) CONVEC3C.606
C CONVEC3C.607
REAL DTRABYDT(NPNTS,NLEV, ! INCREMENT TO TRACER DUE TO CONVEC3C.608
* NTRA) ! CONVECTION (KG/KG/S) CONVEC3C.609
C CONVEC3C.610
REAL PRECIP(NPNTS,NLEV) ! AMOUNT OF PRECIPITATION CONVEC3C.611
! FROM EACH LAYER (KG/M*:2/S) CONVEC3C.612
C CONVEC3C.613
REAL THPI(NPNTS) ! INITIAL PARCEL POTENTIAL TEMPERATURE CONVEC3C.614
! (K) CONVEC3C.615
C CONVEC3C.616
REAL QPI(NPNTS) ! INITIAL PARCEL MIXING RATIO CONVEC3C.617
! (KG/KG) CONVEC3C.618
C CONVEC3C.619
REAL TRAPI(NPNTS,NTRA) ! INITIAL PARCEL TRACER CONTENT CONVEC3C.620
! (KG/KG) CONVEC3C.621
C CONVEC3C.622
REAL THP(NPNTS,NLEV) ! PARCEL POTENTIAL TEMPERATURE CONVEC3C.623
! IN LAYER K (K) CONVEC3C.624
C CONVEC3C.625
REAL QP(NPNTS,NLEV) ! PARCEL MIXING RATIO IN LAYER K CONVEC3C.626
! (KG/KG) CONVEC3C.627
C CONVEC3C.628
REAL UP(NPNTS,NLEV) ! PARCEL U IN LAYER K (M/S) CONVEC3C.629
C CONVEC3C.630
REAL VP(NPNTS,NLEV) ! PARCEL V IN LAYER K (M/S) CONVEC3C.631
C CONVEC3C.632
REAL TRAP(NPNTS,NLEV,NTRA) ! PARCEL TRACER CONTENT IN LAYER K CONVEC3C.633
! (KG/KG) CONVEC3C.634
C CONVEC3C.635
REAL XPK(NPNTS,NLEV) ! PARCEL CLOUD WATER IN LAYER K CONVEC3C.636
! (KG/KG) CONVEC3C.637
C CONVEC3C.638
REAL FLX(NPNTS,NLEV) ! PARCEL MASSFLUX IN LAYER K (PA/S) CONVEC3C.639
C CONVEC3C.640
REAL FLX_INIT(NPNTS) ! INITIAL MASSFLUX AT CLOUD BASE CONVEC3C.641
! (PA/S) CONVEC3C.642
C CONVEC3C.643
REAL FLX_INIT_NEW(NPNTS) ! INITIAL MASSFLUX AT CLOUD BASE, CONVEC3C.644
! SCALED TO DESTROY CAPE OVER CONVEC3C.645
! GIVEN TIMESCALE (PA/S) CONVEC3C.646
C CONVEC3C.647
REAL FLXMAX_INIT(NPNTS) ! MAXIMUM POSSIBLE INITIAL MASSFLUX CONVEC3C.648
! LIMITED TO THE MASS IN TH INITIAL CONVEC3C.649
! CONVECTING LAYER (PA/S) CONVEC3C.650
C CONVEC3C.651
INTEGER START_LEV(NPNTS) ! LEVEL AT WHICH CONVECTION INITIATES CONVEC3C.652
C CONVEC3C.653
INTEGER DET_LEV(NPNTS) ! LEVEL AT WHICH SPLIT FINAL CONVEC3C.654
! DETRAINMENT LAST OCCURRED CONVEC3C.655
C CONVEC3C.656
LOGICAL BINIT(NPNTS) ! MASK FOR POINTS WHERE CONVECTION CONVEC3C.657
! IS OCCURING CONVEC3C.658
C CONVEC3C.659
LOGICAL BTERM(NPNTS) ! MASK FOR POINTS WHERE CONVECTION CONVEC3C.660
! TERMINATES IN LAYER K+1 CONVEC3C.661
C CONVEC3C.662
LOGICAL BWATER(NPNTS,2:NLEV) ! MASK FOR POINTS AT WHICH CONVEC3C.663
! PRECIPITATION IS LIQUID CONVEC3C.664
C CONVEC3C.665
LOGICAL BGMK(NPNTS) ! MASK FOR POINTS WHERE PARCEL IN CONVEC3C.666
! LAYER K IS SATURATED CONVEC3C.667
C CONVEC3C.668
LOGICAL BCNLV(NPNTS) ! MASK FOR THOSE POINTS AT WHICH CONVEC3C.669
! CONVECTION HAS OCCURED AT SOME CONVEC3C.670
! LEVEL OF THE MODEL CONVEC3C.671
C CONVEC3C.672
REAL DEPTH(NPNTS) ! DEPTH OF CONVECTIVE CLOUD (M) CONVEC3C.673
C CONVEC3C.674
REAL FLXMAXK(NPNTS) ! MAXIMUM INITIL CONVECTIVE MASSFLUX CONVEC3C.675
! (PA/S) CONVEC3C.676
C CONVEC3C.677
REAL FLXMAX2(NPNTS) ! MAXIMUM INITIL CONVECTIVE MASSFLUX CONVEC3C.678
! (PA/S) CONVEC3C.679
C CONVEC3C.680
REAL PK(NPNTS) ! PRESSURE AT MID-POINT OF LAYER K CONVEC3C.681
! (PA) CONVEC3C.682
C CONVEC3C.683
REAL PKP1(NPNTS) ! PRESSURE AT MID-POINT OF LAYER K+1 CONVEC3C.684
! (PA) CONVEC3C.685
C CONVEC3C.686
REAL DELPK(NPNTS) ! PRESSURE DIFFERENCE ACROSS LAYER K CONVEC3C.687
! (PA) CONVEC3C.688
C CONVEC3C.689
REAL DELPKP1(NPNTS) ! PRESSURE DIFFERENCE ACROSS LAYER K+1 CONVEC3C.690
! (PA) CONVEC3C.691
C CONVEC3C.692
REAL DELPKP12(NPNTS) ! PRESSURE DIFFERENCE BETWEEN CONVEC3C.693
! LEVELS K AND K+1 (PA) CONVEC3C.694
C CONVEC3C.695
REAL EKP14(NPNTS), ! ENTRAINMENT COEFFICIENTS AT LEVELS CONVEC3C.696
* EKP34(NPNTS) ! K+1/4 AND K+3/4 MULTIPLIED BY CONVEC3C.697
! APPROPRIATE LAYER THICKNESS CONVEC3C.698
C CONVEC3C.699
REAL AMDETK(NPNTS) ! MIXING DETRAINMENT COEFFICIENT AT CONVEC3C.700
! LEVEL K MULTIPLIED BY APPROPRIATE CONVEC3C.701
! LAYER THICKNESS CONVEC3C.702
C CONVEC3C.703
REAL DELTAK(NPNTS) ! FORCED DETRAINMENT RATE API2F405.260
C API2F405.261
REAL EXK(NPNTS) ! EXNER RATIO AT LEVEL K CONVEC3C.704
C CONVEC3C.705
REAL EXKP1(NPNTS) ! EXNER RATIO AT LEVEL K+1 CONVEC3C.706
C CONVEC3C.707
REAL DELEXKP1(NPNTS) ! DIFFERENCE IN EXNER RATIO CONVEC3C.708
! ACROSS LAYER K+1 CONVEC3C.709
C CONVEC3C.710
REAL EMINDS(NPNTS) ! MINIMUM BUOYANCY FOR CONVECTION TO CONVEC3C.711
! INITIATE FROM LAYER K CONVEC3C.712
C CONVEC3C.713
INTEGER INDEX1(NPNTS), ! INDEX FOR COMPRESS AND CONVEC3C.714
* INDEX2(NPNTS), ! EXPAND CONVEC3C.715
* INDEX3(NPNTS), CONVEC3C.716
* INDEX4(NPNTS) CONVEC3C.717
C CONVEC3C.718
LOGICAL L_SHALLOW(NPNTS) ! CONVECTION LIKELY TO BE SHALLOW CONVEC3C.719
! IF SET TO TR CONVEC3C.720
C CONVEC3C.721
LOGICAL L_SHALLOW_C(NPNTS), ! CONVECTION LIKELY TO BE SHALLOW CONVEC3C.722
* L_SHALLOW_C2(NPNTS) ! IF SET TO TRUE -- COMPRESSED CONVEC3C.723
C CONVEC3C.724
LOGICAL L_MID(NPNTS) ! CONVECTION STARTS ABOVE BOUNDARY CONVEC3C.725
! LAYER IF SET TO TRUE CONVEC3C.726
C CONVEC3C.727
LOGICAL L_MID_C(NPNTS), ! CONVECTION STARTS ABOVE BOUNDARY CONVEC3C.728
* L_MID_C2(NPNTS) ! LAYER IF SET TO TRUE -- COMPRESSED CONVEC3C.729
C CONVEC3C.730
REAL TRAPK_C(NPNTS,NTRA), ! PARCEL TRACER CONTENT IN LAYER K CONVEC3C.731
* TRAPK_C2(NPNTS,NTRA) ! - COMPRESSED (KG/KG) CONVEC3C.732
C CONVEC3C.733
REAL TRAPKP1_C(NPNTS,NTRA), ! PARCEL TRACER CONTENT IN LAYER K+1 CONVEC3C.734
* TRAPKP1_C2(NPNTS,NTRA) ! - COMPRESSED (KG/KG) CONVEC3C.735
C CONVEC3C.736
REAL TRAEK_C(NPNTS,NTRA), ! TRACER CONTENT OF CLOUD ENVIRONMENT CONVEC3C.737
* TRAEK_C2(NPNTS,NTRA) ! IN LAYER K - COMPRESSED (KG/KG) CONVEC3C.738
C CONVEC3C.739
REAL TRAEKP1_C(NPNTS,NTRA), ! TRACER CONTENT OF CLOUD ENVIRONMENT CONVEC3C.740
* TRAEKP1_C2(NPNTS,NTRA) ! IN LAYER K+1 - COMPRESSED (KG/KG) CONVEC3C.741
C CONVEC3C.742
REAL DTRAEK_C(NPNTS,NTRA) ! INCREMENTS TO MODEL TRACER CONVEC3C.743
! DUE TO CONVECTION AT LEVEL K CONVEC3C.744
! - COMPRESSED (KG/KG/S) CONVEC3C.745
C CONVEC3C.746
REAL DTRAEKP1_C(NPNTS,NTRA) ! INCREMENTS TO MODEL TRACER DUE TO CONVEC3C.747
! CONVECTION IN LAYER K+1 -COMPRESSED CONVEC3C.748
! (KG/KG/S) CONVEC3C.749
C CONVEC3C.750
REAL EFLUX_U_UD(NPNTS), ! VERTICAL EDDY FLUX OF MOMENTUM DUE CONVEC3C.751
* EFLUX_V_UD(NPNTS) ! TO UD AT TOP OF A LAYER CONVEC3C.752
C CONVEC3C.753
REAL EFLUX_U_DD(NPNTS), ! VERTICAL EDDY FLUX OF MOMENTUM DUE CONVEC3C.754
* EFLUX_V_DD(NPNTS) ! TO DD AT BOTTOM OF A LAYER CONVEC3C.755
C CONVEC3C.756
REAL LIMITED_STEP(NPNTS), ! Reduced step size for tracer mixing CONVEC3C.757
& STEP_TEST1(NLEV), ! Work array used in reducing step CONVEC3C.758
& STEP_TEST2(NLEV) ! " CONVEC3C.759
REAL REDUCTION_FACTOR(NPNTS,NTRA) ! Diagnostic array for time- CONVEC3C.760
! ! step reduction factor for tracers CONVEC3C.761
REAL SAFETY_MARGIN ! Small no. used in tracer step reducn CONVEC3C.762
C CONVEC3C.763
*IF DEF,T3E PXCONVEC.1
PARAMETER (SAFETY_MARGIN = 1.0E-100 ) PXCONVEC.2
*ELSE PXCONVEC.3
PARAMETER (SAFETY_MARGIN = TINY(1.0) ) PXCONVEC.4
*ENDIF PXCONVEC.5
! CONVEC3C.765
C CONVEC3C.766
INTEGER FREEZE_LEV(NPNTS) ! FREEZING LEVEL CONVEC3C.767
C CONVEC3C.768
REAL CCA_2D(NPNTS) ! Conv cloud amount on a single CONVEC3C.769
! ! level, as calculated in CONRAD CONVEC3C.770
C CONVEC3C.771
C CONVEC3C.773
REAL FLX2 ! TEMPORARY STORE FOR MASS FLUX CONVEC3C.774
C CONVEC3C.775
REAL AEKP14,AEKP34 ! CONSTANTS USED IN CALCULATION CONVEC3C.776
! OF ENTRAINMENT COEFFICIENTS CONVEC3C.777
C CONVEC3C.778
REAL EL ! LATENT HEAT OF CONDENSATION CONVEC3C.779
! USED IN UNDILUTE ASCENT CALCULATION CONVEC3C.780
C CONVEC3C.781
REAL THVUNDI,THVEKP1 ! VIRTUAL TEMPERATURE OF UNDILUTE CONVEC3C.782
! PARCEL AND ENVIRONMENT USED IN CONVEC3C.783
! BUOYANCY CALCULATIONS FOR THE CONVEC3C.784
! UNDILUTE ASCENT CONVEC3C.785
C CONVEC3C.786
REAL C,D ! MASS FLUX PARAMETERS CONVEC3C.787
C CONVEC3C.788
REAL recip_PSTAR(NP_FIELD) ! Reciprocal of pstar array CONVEC3C.789
C CONVEC3C.790
C---------------------------------------------------------------------- CONVEC3C.791
C EXTERNAL ROUTINES CALLED CONVEC3C.792
C---------------------------------------------------------------------- CONVEC3C.793
C CONVEC3C.794
EXTERNAL QSAT,FLAG_WET,LIFT_PAR,CONVEC2,LAYER_CN, CONVEC3C.795
* DQS_DTH,COR_ENGY,DD_CALL,CALC_3D_CCA CONVEC3C.796
C CONVEC3C.797
CONVEC3C.798
REAL CONVEC3C.799
& PU,PL,PM CONVEC3C.800
*CALL P_EXNERC CONVEC3C.801
CONVEC3C.802
C*--------------------------------------------------------------------- CONVEC3C.803
C CONVEC3C.804
CL CONVEC3C.805
CL--------------------------------------------------------------------- CONVEC3C.806
CL CALCULATE AN ARRAY OF SATURATION MIXING RATIOS CONVEC3C.807
CL FIRST CONVERT POTENTIAL TEMPERATURE TO TEMPERATURE AND CALCULATE CONVEC3C.808
CL PRESSURE OF LAYER K CONVEC3C.809
CL CONVEC3C.810
CL SUBROUTINE QSAT CONVEC3C.811
CL UM DOCUMENTATION PAPER P282 CONVEC3C.812
CL--------------------------------------------------------------------- CONVEC3C.813
CL CONVEC3C.814
DO I=1,NPNTS CONVEC3C.815
RECIP_PSTAR(I)=1./PSTAR(I) CONVEC3C.816
ENDDO CONVEC3C.817
CONVEC3C.818
DO 20 K=1,NLEV CONVEC3C.819
DO 25 I = 1,NPNTS CONVEC3C.820
TTKM1(I)=TT(I) CONVEC3C.821
PU=PSTAR(I)*BKM12(K+1) + AKM12(K+1) CONVEC3C.822
PL=PSTAR(I)*BKM12(K) + AKM12(K) CONVEC3C.823
TT(I) = TH(I,K)* P_EXNER_C(EXNER(I,K+1),EXNER(I,K),PU,PL,KAPPA) CONVEC3C.824
PT(I) = AK(K)+BK(K)*PSTAR(I) CONVEC3C.825
IF (TT(I).LT.TM) THEN CONVEC3C.826
IF (K.EQ.1) THEN CONVEC3C.827
FREEZE_LEV(I)=K CONVEC3C.828
ELSEIF(TTKM1(I).GE.TM) THEN AJX4F405.2
FREEZE_LEV(I)=K CONVEC3C.830
ENDIF CONVEC3C.831
ENDIF CONVEC3C.832
25 CONTINUE CONVEC3C.833
C CONVEC3C.834
CALL QSAT (QSE(1,K),TT,PT,NPNTS) CONVEC3C.835
C CONVEC3C.836
20 CONTINUE CONVEC3C.837
CL CONVEC3C.838
CL--------------------------------------------------------------------- CONVEC3C.839
CL CALCULATE BIT VECTOR WHERE WATER WILL CONDENSE RATHER THAN ICE CONVEC3C.840
CL SUBROUTINE FLAG_WET CONVEC3C.841
CL CONVEC3C.842
CL UM DOCUMENTATION PAPER 27 CONVEC3C.843
CL SECTION (2B) CONVEC3C.844
CL--------------------------------------------------------------------- CONVEC3C.845
CL CONVEC3C.846
CALL FLAG_WET(BWATER,TH,EXNER,PSTAR,AKM12,BKM12, CONVEC3C.847
& NP_FIELD,NPNTS,NLEV) CONVEC3C.848
C CONVEC3C.849
C---------------------------------------------------------------------- CONVEC3C.850
C INITIALISE PRECIPITATION, DTH/DT, DQ/DT, CCW CONVEC3C.851
C DU/DT, DV/DT AND TRACER INCREMENT ARRAYS CONVEC3C.852
C---------------------------------------------------------------------- CONVEC3C.853
C CONVEC3C.854
DO K=1,NLEV CONVEC3C.855
DO I=1,NPNTS CONVEC3C.856
PRECIP(I,K) = 0.0 CONVEC3C.857
CCW(I,K) = 0.0 CONVEC3C.858
ENDDO CONVEC3C.859
DO I=1,NPNTS CONVEC3C.860
GBMCCW(I,K) = 0.0 CONVEC3C.861
DTHBYDT(I,K) = 0.0 CONVEC3C.862
DQBYDT(I,K) = 0.0 CONVEC3C.863
ENDDO CONVEC3C.864
DO I=1,NPNTS CONVEC3C.865
IF(L_MOM)THEN CONVEC3C.866
DUBYDT(I,K) = 0.0 CONVEC3C.867
DVBYDT(I,K) = 0.0 CONVEC3C.868
END IF CONVEC3C.869
END DO CONVEC3C.870
END DO CONVEC3C.871
IF(L_TRACER)THEN CONVEC3C.872
DO KTRA=1,NTRA CONVEC3C.873
DO K=1,NLEV CONVEC3C.874
DO I=1,NPNTS CONVEC3C.875
DTRABYDT(I,K,KTRA) = 0.0 CONVEC3C.876
END DO CONVEC3C.877
END DO CONVEC3C.878
END DO CONVEC3C.879
END IF CONVEC3C.880
DO K=1,N_CCA_LEV ADR1F405.29
DO I=1,NPNTS ADR1F405.30
CCA(I,K) = 0.0 ADR1F405.31
ENDDO ADR1F405.32
ENDDO ADR1F405.33
C CONVEC3C.881
DO I=1,NPNTS APB3F405.375
C CONVEC3C.883
C---------------------------------------------------------------------- CONVEC3C.884
C INITIALISE BIT VECTORS FOR POINTS WHICH ARE ALREADY CONVECTING CONVEC3C.885
C AND FOR POINTS AT WHICH CONVECTION OCCURS AT SOME LEVEL OF CONVEC3C.886
C THE ATMOSPHERE. ALSO SET BIT VECTORS FOR SHALLOW AND MID LEVEL CONVEC3C.887
C CONVECTION TO FALSE AS DEEP CONVECTION IS ASSUMED UNTIL TEST CONVEC3C.888
C ASCENT IS PERFORMED. CONVEC3C.889
C---------------------------------------------------------------------- CONVEC3C.890
C CONVEC3C.891
BINIT(I) = .FALSE. CONVEC3C.892
BCNLV(I) = .FALSE. CONVEC3C.893
ENDDO APB3F405.376
DO I=1,NPNTS APB3F405.377
BTERM(I) = .FALSE. CONVEC3C.894
L_SHALLOW(I) = .FALSE. CONVEC3C.895
ENDDO APB3F405.378
DO I=1,NPNTS APB3F405.379
L_MID(I) = .FALSE. CONVEC3C.896
C CONVEC3C.897
C---------------------------------------------------------------------- CONVEC3C.898
C INITIALISE RADIATION DIAGNOSTICS CONVEC3C.899
C---------------------------------------------------------------------- CONVEC3C.900
C CONVEC3C.901
CCA_2D(I) = 0.0 CONVEC3C.902
ENDDO APB3F405.380
DO I=1,NPNTS APB3F405.381
ICCB(I) = 0 CONVEC3C.903
ICCT(I) = 0 CONVEC3C.904
ENDDO APB3F405.382
DO I=1,NPNTS APB3F405.383
TCW(I) = 0.0 CONVEC3C.905
CCLWP(I) = 0.0 CONVEC3C.906
ENDDO APB3F405.384
DO I=1,NPNTS APB3F405.385
C CONVEC3C.907
C--------------------------------------------------------------------- CONVEC3C.908
C INITIALISE GRIDBOX MEAN DIAGNOSTICS CONVEC3C.909
C--------------------------------------------------------------------- CONVEC3C.910
C CONVEC3C.911
GBMCCWP(I) = 0.0 CONVEC3C.912
ICCBPxCCA(I) = 0.0 CONVEC3C.913
ENDDO APB3F405.386
DO I=1,NPNTS APB3F405.387
ICCTPxCCA(I) = 0.0 CONVEC3C.914
C CONVEC3C.915
CL------------------------------------------------------------------- CONVEC3C.916
CL INITIALISE DIAGNOSTICS FOR CLOSURE CALCULATION CONVEC3C.917
CL------------------------------------------------------------------- CONVEC3C.918
C CONVEC3C.919
FLX_INIT(I) = 0.0 CONVEC3C.920
ENDDO APB3F405.388
DO I=1,NPNTS APB3F405.389
FLX_INIT_NEW(I) = 0.0 CONVEC3C.921
CAPE(I) = 0.0 CONVEC3C.922
ENDDO APB3F405.390
DO I=1,NPNTS APB3F405.391
CAPE_OUT(I) = 0.0 CONVEC3C.923
DCPBYDT(I) = 0.0 CONVEC3C.924
ENDDO APB3F405.392
DO I=1,NPNTS APB3F405.393
CAPE_C(I) = 0.0 CONVEC3C.925
DCPBYDT_C(I) = 0.0 CONVEC3C.926
ENDDO APB3F405.394
DO I=1,NPNTS APB3F405.395
START_LEV(I) = 0 CONVEC3C.927
DELTAK(I)=0.0 API2F405.262
DET_LEV(I) = 0 CONVEC3C.928
ENDDO APB3F405.396
DO I=1,NPNTS APB3F405.397
DTHEF(I) = 0.0 CONVEC3C.929
DQF(I) = 0.0 CONVEC3C.930
DUEF(I)=0.0 API1F405.35
DVEF(I)=0.0 API1F405.36
ENDDO APB3F405.398
DO I=1,NPNTS APB3F405.399
C CONVEC3C.931
C--------------------------------------------------------------------- CONVEC3C.932
C INITIALISE EDDY FLUX ARRAYS FOR UD AND DD CONVEC3C.933
C-------------------------------------------------------------------- CONVEC3C.934
C CONVEC3C.935
EFLUX_U_UD(I) = 0.0 CONVEC3C.936
EFLUX_V_UD(I) = 0.0 CONVEC3C.937
ENDDO APB3F405.400
DO I=1,NPNTS APB3F405.401
EFLUX_U_DD(I) = 0.0 CONVEC3C.938
EFLUX_V_DD(I) = 0.0 CONVEC3C.939
ENDDO APB3F405.402
DO I=1,NPNTS APB3F405.403
C CONVEC3C.940
C--------------------------------------------------------------------- CONVEC3C.941
C INITIALISE SURFACE PRECIPITATION ARRAYS CONVEC3C.942
C--------------------------------------------------------------------- CONVEC3C.943
C CONVEC3C.944
RAIN(I) = 0.0 CONVEC3C.945
SNOW(I) = 0.0 APB3F405.404
ENDDO APB3F405.405
CL CONVEC3C.947
CL===================================================================== CONVEC3C.948
CL MAIN LOOP OVER LEVELS - FROM SURFACE TO TOP CONVEC3C.949
CL===================================================================== CONVEC3C.950
CL CONVEC3C.951
DO 60 K=1,NLEV-1 CONVEC3C.952
CL CONVEC3C.953
CL--------------------------------------------------------------------- CONVEC3C.954
CL CALCULATE LEVEL PRESSURES, EXNER RATIO FOR MID POINTS, ENTRAINMENT CONVEC3C.955
CL RATES, DETRAINMENTS RATES AND PRESSURE DIFFERENCE ACROS LAYERS AS CONVEC3C.956
CL A FUNCTION OF GRID-POINT CONVEC3C.957
CL CONVEC3C.958
CL SUBROUTINE LAYER_CN CONVEC3C.959
CL--------------------------------------------------------------------- CONVEC3C.960
CL CONVEC3C.961
CALL LAYER_CN(K,NP_FIELD,NPNTS,NLEV,EXNER,AK,BK,AKM12,BKM12, CONVEC3C.962
* DELAK,DELBK,PSTAR,PK,PKP1,DELPK,DELPKP1, CONVEC3C.963
* DELPKP12,EKP14,EKP34,AMDETK,EXK,EXKP1, CONVEC3C.964
* DELEXKP1,recip_PSTAR) CONVEC3C.965
CL CONVEC3C.966
CL--------------------------------------------------------------------- CONVEC3C.967
CL CALCULATE DQS/DTH FOR LAYERS K AND K+1 CONVEC3C.968
CL CONVEC3C.969
CL SUBROUTINE DQS_DTH CONVEC3C.970
CL--------------------------------------------------------------------- CONVEC3C.971
CL CONVEC3C.972
IF (K.EQ.1) THEN CONVEC3C.973
CALL DQS_DTH(DQSTHK,K,TH(1,K),QSE(1,K),EXK,NPNTS) CONVEC3C.974
ELSE CONVEC3C.975
DO 65 I=1,NPNTS CONVEC3C.976
DQSTHK(I) = DQSTHKP1(I) CONVEC3C.977
65 CONTINUE CONVEC3C.978
END IF CONVEC3C.979
C CONVEC3C.980
CALL DQS_DTH(DQSTHKP1,K+1,TH(1,K+1),QSE(1,K+1),EXKP1,NPNTS) CONVEC3C.981
C CONVEC3C.982
DO 70 I=1,NPNTS CONVEC3C.983
C CONVEC3C.984
C--------------------------------------------------------------------- CONVEC3C.985
C SET OTHER GIRD-POINT DEPENDENT CONSTANTS CONVEC3C.986
C--------------------------------------------------------------------- CONVEC3C.987
C CONVEC3C.988
C--------------------------------------------------------------------- CONVEC3C.989
C MAXIMUM INITIAL CONVECTIVE MASSFLUX CONVEC3C.990
C--------------------------------------------------------------------- CONVEC3C.991
C CONVEC3C.992
FLXMAXK(I) = DELPK(I)/((1.0 + EKP14(I)) * TIMESTEP) CONVEC3C.993
C CONVEC3C.994
C--------------------------------------------------------------------- CONVEC3C.995
C MAXIMUM CONVECTIVE MASSFLUX AT MID-POINT OF LAYER 2 CONVEC3C.996
C--------------------------------------------------------------------- CONVEC3C.997
C CONVEC3C.998
IF (K.EQ.1) FLXMAX2(I) = (PSTAR(I)-PKP1(I)) / TIMESTEP CONVEC3C.999
C CONVEC3C.1000
C--------------------------------------------------------------------- CONVEC3C.1001
C MINIMUM BUOYANCY FOR CONVECTION TO START FROM LAYER K CONVEC3C.1002
C--------------------------------------------------------------------- CONVEC3C.1003
C CONVEC3C.1004
EMINDS(I) = MPARB*DELPKP12(I)*RECIP_PSTAR(I) CONVEC3C.1005
C CONVEC3C.1006
C---------------------------------------------------------------------- CONVEC3C.1007
C SET BIT VECTOR FOR POINTS WHERE CONVECTION HAS OCCURRED AT SOME CONVEC3C.1008
C LEVEL OF THE ATMOSPHERE CONVEC3C.1009
C----------------------------------------------------------------------- CONVEC3C.1010
C CONVEC3C.1011
BCNLV(I) = BCNLV(I) .OR. BINIT(I) CONVEC3C.1012
CL CONVEC3C.1013
CL--------------------------------------------------------------------- CONVEC3C.1014
CL SET INITIAL VALUES FOR POINTS NOT ALREADY INITIATED CONVEC3C.1015
CL CONVEC3C.1016
CL UM DOCUMENTATION PAPER 27 CONVEC3C.1017
CL SECTION (3), EQUATION(17) CONVEC3C.1018
CL--------------------------------------------------------------------- CONVEC3C.1019
CL CONVEC3C.1020
IF (.NOT.BINIT(I)) THEN CONVEC3C.1021
C CONVEC3C.1022
IF (K.LT.NBL) THEN CONVEC3C.1023
C CONVEC3C.1024
C---------------------------------------------------------------------- CONVEC3C.1025
C SET TO DEEP CONVECTIVE VALUES - MODIFIED LATER IF SHALLOW CONVECTION CONVEC3C.1026
C IS TO DEVELOP CONVEC3C.1027
C---------------------------------------------------------------------- CONVEC3C.1028
C CONVEC3C.1029
L_SHALLOW(I) = .FALSE. CONVEC3C.1030
IF ( L_SDXS .AND. K .EQ. 1 ) THEN CONVEC3C.1031
THPI(I) = TH(I,K) + MAX ( THPIXS_DEEP , T1_SD(I)/EXK(I) ) CONVEC3C.1032
THP(I,K) = TH(I,K) + MAX ( THPIXS_DEEP , T1_SD(I)/EXK(I) ) CONVEC3C.1033
QPI(I) = Q(I,K) + MAX ( QPIXS_DEEP , Q1_SD(I) ) CONVEC3C.1034
QP(I,K) = Q(I,K) + MAX ( QPIXS_DEEP , Q1_SD(I) ) CONVEC3C.1035
ELSE CONVEC3C.1036
THPI(I) = TH(I,K) + THPIXS_DEEP CONVEC3C.1037
THP(I,K) = TH(I,K) + THPIXS_DEEP CONVEC3C.1038
QPI(I) = Q(I,K) + QPIXS_DEEP CONVEC3C.1039
QP(I,K) = Q(I,K) + QPIXS_DEEP CONVEC3C.1040
END IF CONVEC3C.1041
C CONVEC3C.1042
ELSE ! IF(K.GE.NBL) CONVEC3C.1043
C CONVEC3C.1044
C---------------------------------------------------------------------- CONVEC3C.1045
C SET TO VALUES FOR MID-LEVEL CONVECTION CONVEC3C.1046
C---------------------------------------------------------------------- CONVEC3C.1047
C CONVEC3C.1048
L_MID(I) = .TRUE. CONVEC3C.1049
THPI(I) = TH(I,K) + THPIXS_MID CONVEC3C.1050
THP(I,K) = TH(I,K) + THPIXS_MID CONVEC3C.1051
QPI(I) = Q(I,K) + QPIXS_MID CONVEC3C.1052
QP(I,K) = Q(I,K) + QPIXS_MID CONVEC3C.1053
C CONVEC3C.1054
END IF ! IF(K.LT.NBL) END CONVEC3C.1055
C CONVEC3C.1056
XPK(I,K) = 0.0 CONVEC3C.1057
FLX(I,K) = 0.0 CONVEC3C.1058
BGMK(I) = .FALSE. CONVEC3C.1059
DEPTH(I) = 0.0 CONVEC3C.1060
C CONVEC3C.1061
END IF ! IF(.NOT.BINIT(I)) END CONVEC3C.1062
CL CONVEC3C.1063
CL---------------------------------------------------------------------- CONVEC3C.1064
CL FORM A BIT VECTOR OF POINTS FOR WHICH CONVECTION MAY BE POSSIBLE CONVEC3C.1065
CL FROM LAYER K TO K+1 EITHER BECAUSE STABILITY IS LOW ENOUGH CONVEC3C.1066
CL OR BECAUSE CONVECTION OCCURRING FROM LAYER K+1 TO K CONVEC3C.1067
CL THIS BIT VECTOR IS USED IN THE FIRST COMPRESS OF THE DATA CONVEC3C.1068
CL TO CALCULATE PARCEL BUOYANCY IN LAYER K+1 CONVEC3C.1069
CL CONVEC3C.1070
CL UM DOCUMENTATION PAPER 27 CONVEC3C.1071
CL SECTION(3), EQUATION(16) CONVEC3C.1072
CL---------------------------------------------------------------------- CONVEC3C.1073
CL CONVEC3C.1074
BCONV(I) = BINIT(I) .OR. CONVEC3C.1075
* ((TH(I,K) - TH(I,K+1) + DELTHST CONVEC3C.1076
* + MAX(0.0,(Q(I,K)-QSE(I,K+1)))*(LC/(CP*EXKP1(I)))) CONVEC3C.1077
* .GT. 0.) CONVEC3C.1078
*IF DEF,MPP CONVEC3C.1079
BCONV(I) = l_halo(I).AND.BCONV(I) CONVEC3C.1080
*ENDIF CONVEC3C.1081
70 CONTINUE CONVEC3C.1082
C CONVEC3C.1083
CL---------------------------------------------------------------------- CONVEC3C.1084
CL READ INITIAL VALUES OF MOMENTUM AND TRACER INTO THE PARCEL CONVEC3C.1085
CL---------------------------------------------------------------------- CONVEC3C.1086
CL CONVEC3C.1087
IF(L_MOM)THEN CONVEC3C.1088
DO I=1,NPNTS CONVEC3C.1089
IF(.NOT.BINIT(I))THEN CONVEC3C.1090
UP(I,K)=U(I,K) CONVEC3C.1091
VP(I,K) = V(I,K) CONVEC3C.1092
END IF CONVEC3C.1093
END DO CONVEC3C.1094
END IF CONVEC3C.1095
C CONVEC3C.1096
IF(L_TRACER)THEN CONVEC3C.1097
C CONVEC3C.1098
DO KTRA = 1,NTRA CONVEC3C.1099
DO I = 1,NPNTS CONVEC3C.1100
IF(.NOT.BINIT(I))THEN CONVEC3C.1101
TRAPI(I,KTRA) = TRACER(I,K,KTRA) CONVEC3C.1102
TRAP(I,K,KTRA) = TRAPI(I,KTRA) CONVEC3C.1103
END IF CONVEC3C.1104
END DO CONVEC3C.1105
END DO CONVEC3C.1106
C CONVEC3C.1107
END IF CONVEC3C.1108
C CONVEC3C.1109
CL CONVEC3C.1110
CL---------------------------------------------------------------------- CONVEC3C.1111
CL COMPRESS DOWN POINTS ON THE BASIS OF BIT VECTOR BCONV CONVEC3C.1112
CL---------------------------------------------------------------------- CONVEC3C.1113
CL CONVEC3C.1114
NCONV = 0 CONVEC3C.1115
DO 75 I=1,NPNTS CONVEC3C.1116
IF(BCONV(I))THEN CONVEC3C.1117
NCONV = NCONV + 1 CONVEC3C.1118
INDEX1(NCONV) = I CONVEC3C.1119
END IF CONVEC3C.1120
75 CONTINUE CONVEC3C.1121
C CONVEC3C.1122
C---------------------------------------------------------------------- CONVEC3C.1123
C WORK SPACE USAGE FOR FIRST COMPRESS ON BASIS OF SIMPLE CONVEC3C.1124
C STABILITY TEST (SECTION (3), EQN(16)) CONVEC3C.1125
C CONVEC3C.1126
C REFERENCES TO WORK AND BWORK REFER TO STARTING ADDRESS CONVEC3C.1127
C CONVEC3C.1128
C LENGTH OF COMPRESSES DATA = NCONV CONVEC3C.1129
C CONVEC3C.1130
C WORK(1,1) = TH(#,K) CONVEC3C.1131
C WORK(1,2) = TH(#,K+1) CONVEC3C.1132
C WORK(1,3) = Q(#,K) CONVEC3C.1133
C WORK(1,4) = Q(#,K+1) CONVEC3C.1134
C WORK(1,5) = QSE(#,K+1) CONVEC3C.1135
C WORK(1,6) = DQSTHKP1(#) CONVEC3C.1136
C WORK(1,7) = THP(#,K) CONVEC3C.1137
C WORK(1,8) = QP(#,K) CONVEC3C.1138
C WORK(1,9) = PKP1(#) CONVEC3C.1139
C WORK(1,10) = EXKP1(#) CONVEC3C.1140
C WORK(1,11) = EKP14(#) CONVEC3C.1141
C WORK(1,12) = EKP34(#) CONVEC3C.1142
C WORK(1,13) = PARCEL POT. TEMPERATURE IN LAYER K+1 CONVEC3C.1143
C WORK(1,14) = PARCEL MIXING RATIO IN LAYER K+1 CONVEC3C.1144
C WORK(1,15) = EXCESS WATER VAPOUR IN PARCEL ABOVE CONVEC3C.1145
C SATURATION AFTER DRY ASCENT CONVEC3C.1146
C WORK(1,16) = PARCEL BUOYANCY IN LAYER K+1 CONVEC3C.1147
C WORK(1,17) = DELPKP12(#) CONVEC3C.1148
C WORK(1,18) = PSTAR(#) CONVEC3C.1149
C WORK(1,19) = FLX(#,K) CONVEC3C.1150
C WORK(1,20) = EMINDS(#) CONVEC3C.1151
C WORK(1,21) = FLXMAXK(#) CONVEC3C.1152
C WORK(1,22) = FLXMAX2(#) CONVEC3C.1153
C WORK(1,23) = U(#,K) CONVEC3C.1154
C WORK(1,24) = U(#,K+1) CONVEC3C.1155
C WORK(1,25) = V(#,K) CONVEC3C.1156
C WORK(1,26) = V(#,K+1) CONVEC3C.1157
C WORK(1,27) = UP(#,K) CONVEC3C.1158
C WORK(1,28) = VP(#,K) CONVEC3C.1159
C WORK(1,29) = PARCEL U IN LAYER K+1 CONVEC3C.1160
C WORK(1,30) = PARCEL V IN LAYER K+1 CONVEC3C.1161
C CONVEC3C.1162
C BWORK(1,1) = BWATER(INDEX1(I),K+1) CONVEC3C.1163
C BWORK(1,2) = .TRUE. IF PARCEL SATURATED IN LAYER K+1 CONVEC3C.1164
C BWORK(1,3) = .TRUE. IF CONVECTION INITIATE FROM LAYER K+1 CONVEC3C.1165
C BWORK(1,4) = BINIT(INDEX1(I)) CONVEC3C.1166
C---------------------------------------------------------------------- CONVEC3C.1167
C CONVEC3C.1168
IF (NCONV .NE. 0) THEN CONVEC3C.1169
DO I=1,NCONV CONVEC3C.1170
WORK(I,1) = TH(INDEX1(I),K) CONVEC3C.1171
WORK(I,2) = TH(INDEX1(I),K+1) CONVEC3C.1172
ENDDO CONVEC3C.1173
DO I=1,NCONV CONVEC3C.1174
WORK(I,3) = Q(INDEX1(I),K) CONVEC3C.1175
WORK(I,4) = Q(INDEX1(I),K+1) CONVEC3C.1176
ENDDO CONVEC3C.1177
DO I=1,NCONV CONVEC3C.1178
WORK(I,5) = QSE(INDEX1(I),K+1) CONVEC3C.1179
WORK(I,6) = DQSTHKP1(INDEX1(I)) CONVEC3C.1180
ENDDO CONVEC3C.1181
DO I=1,NCONV CONVEC3C.1182
WORK(I,7) = THP(INDEX1(I),K) CONVEC3C.1183
WORK(I,8) = QP(INDEX1(I),K) CONVEC3C.1184
ENDDO CONVEC3C.1185
DO I=1,NCONV CONVEC3C.1186
WORK(I,9) = PKP1(INDEX1(I)) CONVEC3C.1187
WORK(I,10) = EXKP1(INDEX1(I)) CONVEC3C.1188
ENDDO CONVEC3C.1189
DO I=1,NCONV CONVEC3C.1190
WORK(I,11) = EKP14(INDEX1(I)) CONVEC3C.1191
WORK(I,12) = EKP34(INDEX1(I)) CONVEC3C.1192
ENDDO CONVEC3C.1193
DO I=1,NCONV CONVEC3C.1194
WORK(I,17) = DELPKP12(INDEX1(I)) CONVEC3C.1195
WORK(I,18) = PSTAR(INDEX1(I)) CONVEC3C.1196
ENDDO CONVEC3C.1197
DO I=1,NCONV CONVEC3C.1198
WORK(I,19) = FLX(INDEX1(I),K) CONVEC3C.1199
WORK(I,20) = EMINDS(INDEX1(I)) CONVEC3C.1200
ENDDO CONVEC3C.1201
DO I=1,NCONV CONVEC3C.1202
WORK(I,21) = FLXMAXK(INDEX1(I)) CONVEC3C.1203
WORK(I,22) = FLXMAX2(INDEX1(I)) CONVEC3C.1204
ENDDO CONVEC3C.1205
DO I=1,NCONV CONVEC3C.1206
BWORK(I,1) = BWATER(INDEX1(I),K+1) CONVEC3C.1207
BWORK(I,4) = BINIT(INDEX1(I)) CONVEC3C.1208
ENDDO CONVEC3C.1209
DO I=1,NCONV CONVEC3C.1210
L_SHALLOW_C(I) = L_SHALLOW(INDEX1(I)) CONVEC3C.1211
L_MID_C(I) = L_MID(INDEX1(I)) CONVEC3C.1212
ENDDO CONVEC3C.1213
C CONVEC3C.1214
IF(L_MOM)THEN CONVEC3C.1215
DO I=1,NCONV CONVEC3C.1216
WORK(I,23) = U(INDEX1(I),K) CONVEC3C.1217
WORK(I,24) = U(INDEX1(I),K+1) CONVEC3C.1218
ENDDO CONVEC3C.1219
DO I=1,NCONV CONVEC3C.1220
WORK(I,25) = V(INDEX1(I),K) CONVEC3C.1221
WORK(I,26) = V(INDEX1(I),K+1) CONVEC3C.1222
ENDDO CONVEC3C.1223
DO I=1,NCONV CONVEC3C.1224
WORK(I,27) = UP(INDEX1(I),K) CONVEC3C.1225
WORK(I,28) = VP(INDEX1(I),K) CONVEC3C.1226
ENDDO CONVEC3C.1227
END IF CONVEC3C.1228
C CONVEC3C.1229
IF(L_TRACER)THEN CONVEC3C.1230
C CONVEC3C.1231
DO KTRA = 1,NTRA CONVEC3C.1232
DO I=1,NCONV CONVEC3C.1233
TRAEK_C(I,KTRA) = TRACER(INDEX1(I),K,KTRA) CONVEC3C.1234
TRAEKP1_C(I,KTRA) = TRACER(INDEX1(I),K+1,KTRA) CONVEC3C.1235
TRAPK_C(I,KTRA) = TRAP(INDEX1(I),K,KTRA) CONVEC3C.1236
END DO CONVEC3C.1237
END DO CONVEC3C.1238
C CONVEC3C.1239
END IF CONVEC3C.1240
C CONVEC3C.1241
IF ( K.LT.NBL) THEN CONVEC3C.1242
C CONVEC3C.1243
CL CONVEC3C.1244
CL-------------------------------------------------------------------- CONVEC3C.1245
CL CARRY OUT TEST ASCENT TO ASCERTAIN WHETHER DEEP CONVECTION OR CONVEC3C.1246
CL SHALLOW CONVECTION IS POSSIBLE. CONVEC3C.1247
CL CONVEC3C.1248
CL UM DOCUMENTATION PAPER 27-3. SECTION 2. CONVEC3C.1249
CL CONVEC3C.1250
CL CALCULATION ONLY CARRIED OUT FOR CONVECTION INITIATING WITHIN THE CONVEC3C.1251
CL BOUNDARY LAYER CONVEC3C.1252
CL-------------------------------------------------------------------- CONVEC3C.1253
CL CONVEC3C.1254
DO K_TEST=K,NBL ! LOOP OVER BOUNDARY LAYER LEVELS CONVEC3C.1255
C--------------------------------------------------------------------- CONVEC3C.1256
C SET COEFFICIENTS FOR CALCULATION OF ENTRAINMENT RATES CONVEC3C.1257
C--------------------------------------------------------------------- CONVEC3C.1258
IF(K_TEST.EQ.1)THEN CONVEC3C.1259
AEKP14 = AE1 CONVEC3C.1260
AEKP34 = AE2 CONVEC3C.1261
ELSE CONVEC3C.1262
AEKP14 = AE2 CONVEC3C.1263
AEKP34 = AE2 CONVEC3C.1264
END IF CONVEC3C.1265
C CONVEC3C.1266
C-------------------------------------------------------------------- CONVEC3C.1267
C SET VALUES FOR TEST ASCENT CONVEC3C.1268
C-------------------------------------------------------------------- CONVEC3C.1269
C CONVEC3C.1270
IF ( K_TEST .EQ. K ) THEN CONVEC3C.1271
C CONVEC3C.1272
DO I=1,NCONV ! 1ST COMPRESS LOOP CONVEC3C.1273
WORK2(I,1) = WORK(I,1) ! THEK CONVEC3C.1274
WORK2(I,2) = WORK(I,2) ! THEKP1 CONVEC3C.1275
ENDDO APB3F405.406
DO I=1,NCONV ! 1ST COMPRESS LOOP APB3F405.407
WORK2(I,3) = WORK(I,3) ! QEK CONVEC3C.1276
WORK2(I,4) = WORK(I,4) ! QEKP1 CONVEC3C.1277
ENDDO APB3F405.408
DO I=1,NCONV ! 1ST COMPRESS LOOP APB3F405.409
WORK2(I,5) = WORK(I,5) ! QSEKP1 CONVEC3C.1278
WORK2(I,6) = WORK(I,6) ! DQSEKP1 CONVEC3C.1279
ENDDO APB3F405.410
DO I=1,NCONV ! 1ST COMPRESS LOOP APB3F405.411
WORK2(I,7) = WORK(I,7) ! THPK CONVEC3C.1280
WORK2(I,8) = WORK(I,8) ! QPK CONVEC3C.1281
ENDDO APB3F405.412
DO I=1,NCONV ! 1ST COMPRESS LOOP APB3F405.413
WORK2(I,9) = WORK(I,9) ! PKP1 CONVEC3C.1282
WORK2(I,10) = WORK(I,10) ! EXKP1 CONVEC3C.1283
ENDDO APB3F405.414
DO I=1,NCONV ! 1ST COMPRESS LOOP APB3F405.415
WORK2(I,11) = WORK(I,11) ! EKP14 CONVEC3C.1284
WORK2(I,12) = WORK(I,12) ! EKP34 CONVEC3C.1285
ENDDO APB3F405.416
DO I=1,NCONV ! 1ST COMPRESS LOOP APB3F405.417
BWORK2(I,1) = BWORK(I,1) ! BWATER KP1 CONVEC3C.1286
BWORK2(I,3) = .FALSE. ! POINT WHERE CONVECTION CONVEC3C.1287
! HAS INITIATED FROM LAYER K CONVEC3C.1288
! OR ABOVE CONVEC3C.1289
WORK2(I,20) = WORK(I,20) ! EMINDS CONVEC3C.1290
C CONVEC3C.1291
END DO ! END OF 1ST COMPRESS LOOP CONVEC3C.1292
C CONVEC3C.1293
C CONVEC3C.1294
ELSE ! IF(K_TEST.NE.K) CONVEC3C.1295
C CONVEC3C.1296
DO I=1,NCONV ! 2ND COMPRESS LOOP CONVEC3C.1297
C CONVEC3C.1298
WORK2(I,1) = WORK2(I,2) ! THEK CONVEC3C.1299
WORK2(I,2) = TH(INDEX1(I),K_TEST+1) ! THEKP1 CONVEC3C.1300
ENDDO APB3F405.418
DO I=1,NCONV ! 2ND COMPRESS LOOP APB3F405.419
WORK2(I,3) = WORK2(I,4) ! QEK CONVEC3C.1301
WORK2(I,4) = Q(INDEX1(I),K_TEST+1) ! QEKP1 CONVEC3C.1302
ENDDO APB3F405.420
DO I=1,NCONV ! 2ND COMPRESS LOOP APB3F405.421
WORK2(I,5) = QSE(INDEX1(I),K_TEST+1) ! QSEKP1 CONVEC3C.1303
WORK2(I,7) = WORK2(I,13) ! THPK CONVEC3C.1304
ENDDO APB3F405.422
DO I=1,NCONV ! 2ND COMPRESS LOOP APB3F405.423
WORK2(I,8) = WORK2(I,14) ! QPK CONVEC3C.1305
WORK2(I,9) = AK(K_TEST+1) + BK(K_TEST+1) CONVEC3C.1306
* *WORK(I,18) ! PKP1 CONVEC3C.1307
ENDDO APB3F405.424
DO I=1,NCONV ! 2ND COMPRESS LOOP APB3F405.425
PU = WORK(I,18)*BKM12(K_TEST+2)+AKM12(K_TEST+2) CONVEC3C.1308
PL = WORK(I,18)*BKM12(K_TEST+1)+AKM12(K_TEST+1) CONVEC3C.1309
PM = WORK(I,18)*BK(K_TEST)+AK(K_TEST) CONVEC3C.1310
WORK2(I,10) = P_EXNER_C(EXNER(INDEX1(I),K_TEST+2), CONVEC3C.1311
* EXNER(INDEX1(I),K_TEST+1),PU,PL,KAPPA) ! EXKP1 CONVEC3C.1312
WORK2(I,11) = ENTCOEF * AEKP14 * PM * CONVEC3C.1313
* (PM-AKM12(K_TEST+1)-BKM12(K_TEST+1)* CONVEC3C.1314
* WORK(I,18))/(WORK(I,18)*WORK(I,18)) ! EKP14 CONVEC3C.1315
ENDDO APB3F405.426
DO I=1,NCONV ! 2ND COMPRESS LOOP APB3F405.427
WORK2(I,12) = ENTCOEF *AEKP34 * (AKM12(K_TEST+1) CONVEC3C.1316
* +BKM12(K_TEST+1)*WORK(I,18))* CONVEC3C.1317
* (AKM12(K_TEST+1)+BKM12(K_TEST+1)* CONVEC3C.1318
* WORK(I,18)-WORK2(I,9))/(WORK(I,18)* CONVEC3C.1319
* WORK(I,18)) ! EKP34 CONVEC3C.1320
ENDDO APB3F405.428
DO I=1,NCONV ! 2ND COMPRESS LOOP APB3F405.429
WORK2(I,20) = EMINDS(INDEX1(I)) ! EMINDS CONVEC3C.1321
BWORK2(I,1) = BWATER(INDEX1(I),K_TEST+1) ! BWATER KP1 CONVEC3C.1322
C CONVEC3C.1323
END DO ! END OF 2ND COMPRESS LOOP CONVEC3C.1324
C CONVEC3C.1325
CALL DQS_DTH(WORK2(1,6),K_TEST+1,WORK2(1,2),WORK2(1,5), CONVEC3C.1326
* WORK2(1,10),NCONV) CONVEC3C.1327
C CONVEC3C.1328
END IF ! IF(K_TEST.EQ.K) END CONVEC3C.1329
C CONVEC3C.1330
C-------------------------------------------------------------------- CONVEC3C.1331
C CARRY OUT TEST ASCENT CONVEC3C.1332
C L_TRACER AND L_MOM(THE LOGICAL SWITCHES FOR INCLUSION OF TRACERS AND CONVEC3C.1333
C MOMENTUM ARE SET TO .FALSE. IN THIS CALL SINCE THIS ASCENT IS PURELY CONVEC3C.1334
C TO DIAGNOSE THE DEPTH OF THE INITIATED CONVECTION. THUS NOT CONVEC3C.1335
C INCLUDING THE TRACERS AND WINDS SAVES CPU TIME AND MEMORY. CONVEC3C.1336
C-------------------------------------------------------------------- CONVEC3C.1337
C CONVEC3C.1338
CALL LIFT_PAR (NCONV,NPNTS,WORK2(1,13),WORK2(1,14),WORK2(1,15), CONVEC3C.1339
* BWORK2(1,2),BWORK2(1,1),WORK2(1,7),WORK2(1,8), CONVEC3C.1340
* WORK2(1,2),WORK2(1,4),WORK2(1,1),WORK2(1,3), CONVEC3C.1341
* WORK2(1,5),WORK2(1,6),WORK2(1,9),WORK2(1,10), CONVEC3C.1342
* WORK2(1,11),WORK2(1,12),.FALSE.,WORK2(1,29), CONVEC3C.1343
* WORK2(1,30),WORK2(1,27),WORK2(1,28),WORK2(1,23), CONVEC3C.1344
* WORK2(1,24),WORK2(1,25),WORK2(1,26),.FALSE.,NTRA, CONVEC3C.1345
* TRAPKP1_C2,TRAPK_C2,TRAEKP1_C2,TRAEK_C2, CONVEC3C.1346
* L_SHALLOW_C) CONVEC3C.1347
C CONVEC3C.1348
DO I=1,NCONV ! 1ST LOOP OVER CONVECTING POINTS CONVEC3C.1349
CL CONVEC3C.1350
CL--------------------------------------------------------------------- CONVEC3C.1351
CL CALCULATE BUOYANCY OF PARCEL IN LAYER K+1 CONVEC3C.1352
CL--------------------------------------------------------------------- CONVEC3C.1353
CL CONVEC3C.1354
WORK2(I,16) = WORK2(I,13)*(1.0 + CONVEC3C.1355
* C_VIRTUAL * WORK2(I,14)) CONVEC3C.1356
* - WORK2(I,2)*(1.0 + CONVEC3C.1357
* C_VIRTUAL * WORK2(I,4)) CONVEC3C.1358
C CONVEC3C.1359
C---------------------------------------------------------------------- CONVEC3C.1360
C INITIATE CONVECTION WHERE BUOYANCY IS LARGE ENOUGH CONVEC3C.1361
C---------------------------------------------------------------------- CONVEC3C.1362
C CONVEC3C.1363
IF ( .NOT.BWORK2(I,3) .AND. .NOT.BWORK(I,4) ) CONVEC3C.1364
* BWORK2(I,3) = WORK2(I,16) .GT. CONVEC3C.1365
* (WORK2(I,20)+XSBMIN) CONVEC3C.1366
C CONVEC3C.1367
C---------------------------------------------------------------------- CONVEC3C.1368
C CHECK TO SEE IF CONVECTION INITIATING BETWEEN LAYERS K AND NBL CONVEC3C.1369
C REACHES ZERO BUOYANCY BEFORE NBL+1 CONVEC3C.1370
C--------------------------------------------------------------------- CONVEC3C.1371
C CONVEC3C.1372
IF ( BWORK2(I,3) .AND. .NOT.BWORK(I,4) .AND. CONVEC3C.1373
* .NOT.L_SHALLOW_C(I).AND. WORK2(I,16) .LE. 0.0) THEN CONVEC3C.1374
L_SHALLOW_C(I) = .TRUE. CONVEC3C.1375
L_SHALLOW(INDEX1(I)) = L_SHALLOW_C(I) CONVEC3C.1376
C CONVEC3C.1377
C---------------------------------------------------------------------- CONVEC3C.1378
C IF IN TOP 2 LAYERS OF BOUNDARY LAYER, CALCULATE THE POTENTIAL CONVEC3C.1379
C TEMPERATURE OF AN UNDILUTE PARCEL FROM THE INITIAL CONVECTIVE CONVEC3C.1380
C LEVEL, (MIMICKING CODE IN ROUTINE TERM_CON) AND RESET L_SHALLOW CONVEC3C.1381
C TO FALSE IF THIS PARCEL IS STILL BUOYANT. CONVEC3C.1382
C---------------------------------------------------------------------- CONVEC3C.1383
C CONVEC3C.1384
IF(K_TEST.EQ.NBL.OR.K_TEST.EQ.NBL-1)THEN CONVEC3C.1385
IF(BWORK2(I,1))THEN CONVEC3C.1386
EL=LC CONVEC3C.1387
ELSE CONVEC3C.1388
EL=LC+LF CONVEC3C.1389
END IF CONVEC3C.1390
THVUNDI=(THPI(INDEX1(I))+(EL/(WORK2(I,10)*CP))*(QPI(INDEX1(I)) CONVEC3C.1391
* -WORK2(I,5))+((LC-EL)/(WORK2(I,10)*CP))*MAX(0.0, CONVEC3C.1392
* (QPI(INDEX1(I))-QSTICE)))*(1.0+C_VIRTUAL*WORK2(I,5)) CONVEC3C.1393
THVEKP1=(WORK2(I,2)*(1.0+C_VIRTUAL*WORK2(I,4))+XSBMIN) CONVEC3C.1394
IF(THVUNDI.GT.THVEKP1)THEN CONVEC3C.1395
L_SHALLOW_C(I)=.FALSE. CONVEC3C.1396
L_SHALLOW(INDEX1(I))=L_SHALLOW_C(I) CONVEC3C.1397
END IF CONVEC3C.1398
END IF ! IF(K_TEST.EQ.NBL.OR.K_TEST.EQ.NBL-1) END CONVEC3C.1399
BWORK2(I,3) = .FALSE. CONVEC3C.1400
END IF ! IF(BWORK2(I,3.AND..NOT.BWORK(I,4)...) END CONVEC3C.1401
C CONVEC3C.1402
END DO ! END OF 1ST I LOOP OVER CONVECTIVE POINTS CONVEC3C.1403
C CONVEC3C.1404
END DO ! END OF LOOP OVER BOUNDARY LAYER LEVELS CONVEC3C.1405
C CONVEC3C.1406
C---------------------------------------------------------------------- CONVEC3C.1407
C RESET INITIAL THETA AND Q OF THE PARCEL AND ENTRAINMENT/ CONVEC3C.1408
C DETRAINMENT RATES IF SHALLOW CONVECTION CONVEC3C.1409
C--------------------------------------------------------------------- CONVEC3C.1410
C CONVEC3C.1411
DO I=1,NCONV ! 2ND LOOP OVER CONVECTING POINTS CONVEC3C.1412
C CONVEC3C.1413
IF ( L_SHALLOW_C(I) ) THEN CONVEC3C.1414
C CONVEC3C.1415
IF (.NOT.BWORK(I,4)) THEN CONVEC3C.1416
C CONVEC3C.1417
IF ( L_SDXS .AND. K .EQ. 1 ) THEN CONVEC3C.1418
WORK(I,7) = WORK(I,1) + MAX(THPIXS_SHALLOW, CONVEC3C.1419
* T1_SD(INDEX1(I))/EXK(INDEX1(I))) CONVEC3C.1420
THPI(INDEX1(I)) = WORK(I,1) + MAX(THPIXS_SHALLOW, CONVEC3C.1421
* T1_SD(INDEX1(I))/EXK(INDEX1(I))) CONVEC3C.1422
WORK(I,8) = WORK(I,3) + MAX(QPIXS_SHALLOW,Q1_SD(INDEX1(I))) CONVEC3C.1423
QPI(INDEX1(I)) = WORK(I,3) + MAX(QPIXS_SHALLOW, CONVEC3C.1424
* Q1_SD(INDEX1(I))) CONVEC3C.1425
ELSE CONVEC3C.1426
WORK(I,7) = WORK(I,1) + THPIXS_SHALLOW CONVEC3C.1427
THPI(INDEX1(I)) = WORK(I,1) + THPIXS_SHALLOW CONVEC3C.1428
WORK(I,8) = WORK(I,3) + QPIXS_SHALLOW CONVEC3C.1429
QPI(INDEX1(I)) = WORK(I,3) + QPIXS_SHALLOW CONVEC3C.1430
END IF CONVEC3C.1431
C CONVEC3C.1432
END IF ! IF(.NOT.BWORK(I,4)) END CONVEC3C.1433
C CONVEC3C.1434
WORK(I,11) = WORK(I,11)*SH_FAC CONVEC3C.1435
EKP14(INDEX1(I)) = WORK(I,11) CONVEC3C.1436
WORK(I,12) = WORK(I,12)*SH_FAC CONVEC3C.1437
EKP34(INDEX1(I)) = WORK(I,12) CONVEC3C.1438
AMDETK(INDEX1(I)) = AMDETK(INDEX1(I))*SH_FAC CONVEC3C.1439
C CONVEC3C.1440
END IF ! IF(L_SHALLOW_C(I)) END CONVEC3C.1441
C CONVEC3C.1442
END DO ! END OF 2ND I LOOP OVER CONVECTING POINTS CONVEC3C.1443
C CONVEC3C.1444
END IF ! IF(K.LT.NBL) END CONVEC3C.1445
CL CONVEC3C.1446
CL--------------------------------------------------------------------- CONVEC3C.1447
CL LIFT PARCEL FROM LAYER K TO K+1 CONVEC3C.1448
CL CONVEC3C.1449
CL UM DOCUMENTATION PAPER 27 CONVEC3C.1450
CL SECTION (3) AND (4) CONVEC3C.1451
CL--------------------------------------------------------------------- CONVEC3C.1452
CL CONVEC3C.1453
CALL LIFT_PAR (NCONV,NPNTS,WORK(1,13),WORK(1,14),WORK(1,15), CONVEC3C.1454
* BWORK(1,2),BWORK(1,1),WORK(1,7),WORK(1,8), CONVEC3C.1455
* WORK(1,2),WORK(1,4),WORK(1,1),WORK(1,3), CONVEC3C.1456
* WORK(1,5),WORK(1,6),WORK(1,9), CONVEC3C.1457
* WORK(1,10),WORK(1,11),WORK(1,12),L_MOM, CONVEC3C.1458
* WORK(1,29),WORK(1,30),WORK(1,27),WORK(1,28), CONVEC3C.1459
* WORK(1,23),WORK(1,24),WORK(1,25),WORK(1,26), CONVEC3C.1460
* L_TRACER,NTRA,TRAPKP1_C,TRAPK_C,TRAEKP1_C, CONVEC3C.1461
* TRAEK_C,L_SHALLOW_C) CONVEC3C.1462
C CONVEC3C.1463
DO 110 I=1,NCONV CONVEC3C.1464
CL CONVEC3C.1465
CL--------------------------------------------------------------------- CONVEC3C.1466
CL CALCULATE BUOYANCY OF PARCEL IN LAYER K+1 CONVEC3C.1467
CL--------------------------------------------------------------------- CONVEC3C.1468
CL CONVEC3C.1469
WORK(I,16) = WORK(I,13)*(1.0 + CONVEC3C.1470
* C_VIRTUAL * WORK(I,14)) CONVEC3C.1471
* - WORK(I,2)*(1.0 + CONVEC3C.1472
* C_VIRTUAL * WORK(I,4)) CONVEC3C.1473
C CONVEC3C.1474
C---------------------------------------------------------------------- CONVEC3C.1475
C INITIATE CONVECTION WHERE BUOYANCY IS LARGE ENOUGH CONVEC3C.1476
C---------------------------------------------------------------------- CONVEC3C.1477
C CONVEC3C.1478
BWORK(I,3) = .NOT.BWORK(I,4) .AND. WORK(I,16) .GT. CONVEC3C.1479
* (WORK(I,20)+ XSBMIN) CONVEC3C.1480
C CONVEC3C.1481
C---------------------------------------------------------------------- CONVEC3C.1482
C CALCULATE INITIAL MASSFLUX FROM LAYER K CONVEC3C.1483
C---------------------------------------------------------------------- CONVEC3C.1484
C CONVEC3C.1485
IF ( BWORK(I,3) ) THEN CONVEC3C.1486
C CONVEC3C.1487
IF(L_SHALLOW_C(I))THEN CONVEC3C.1488
C=C_SHALLOW CONVEC3C.1489
D=D_SHALLOW CONVEC3C.1490
ELSEIF(L_MID_C(I))THEN CONVEC3C.1491
C=C_MID CONVEC3C.1492
D=D_MID CONVEC3C.1493
ELSE CONVEC3C.1494
C=C_DEEP CONVEC3C.1495
D=D_DEEP CONVEC3C.1496
END IF CONVEC3C.1497
C CONVEC3C.1498
WORK(I,19) = 1.0E-3 * WORK(I,18) * CONVEC3C.1499
1 ( D + C * WORK(I,18) * CONVEC3C.1500
2 ((WORK(I,16) - XSBMIN) / WORK(I,17))) CONVEC3C.1501
C CONVEC3C.1502
END IF CONVEC3C.1503
110 CONTINUE CONVEC3C.1504
C CONVEC3C.1505
C---------------------------------------------------------------------- CONVEC3C.1506
C LIMIT MASSFLUX IN LOWEST CONVECTING LAYER TO BE <= MASS OF LAYER CONVEC3C.1507
C OR CONVEC3C.1508
C IF K=1 ADJUST ENTRAINMENT RATE IN BOTTOM HALF OF LAYER 2 SO CONVEC3C.1509
C NOT TO AFFECT THE MASS FLUX AT MID-POINT OF LAYER 2 CONVEC3C.1510
C---------------------------------------------------------------------- CONVEC3C.1511
C CONVEC3C.1512
IF ( K .EQ. 1 ) THEN CONVEC3C.1513
C CONVEC3C.1514
DO I=1,NCONV CONVEC3C.1515
C CONVEC3C.1516
C-------------------------------------------------------------------- CONVEC3C.1517
C CARRY OUT CALCULATION IF CONVECTION WAS INITIATED FROM LAYER 1 CONVEC3C.1518
C-------------------------------------------------------------------- CONVEC3C.1519
C CONVEC3C.1520
IF ( BWORK(I,3) ) THEN CONVEC3C.1521
C CONVEC3C.1522
C-------------------------------------------------------------------- CONVEC3C.1523
C CALCULATE MASS FLUX AT MID-POINT OF LAYER 2 USING STANDARD CONVEC3C.1524
C ENTRAINMENT RATES CONVEC3C.1525
C-------------------------------------------------------------------- CONVEC3C.1526
C CONVEC3C.1527
FLX2 = WORK(I,19) * (1.0 + WORK(I,11)) * (1.0 + WORK(I,12)) CONVEC3C.1528
C CONVEC3C.1529
C-------------------------------------------------------------------- CONVEC3C.1530
C IF MASS FLUX IN LAYER 2 EXCEEDS MASS OF LAYER THEN LIMIT MASS FLUX CONVEC3C.1531
C OVER A TIMESTEP TO MASS OF LAYER CONVEC3C.1532
C-------------------------------------------------------------------- CONVEC3C.1533
C CONVEC3C.1534
IF (WORK(I,19) .GT. WORK(I,21)) THEN CONVEC3C.1535
C CONVEC3C.1536
WORK(I,19) = WORK(I,21) CONVEC3C.1537
C CONVEC3C.1538
C-------------------------------------------------------------------- CONVEC3C.1539
C IF MASS FLUX AT MID-POINT OF LAYER 2 EXCEEDS THE MASS OF THE COLUMN CONVEC3C.1540
C DOWN TO THE SURFACE OVER THE TIMESTEP THEN LIMIT MASS FLUX CONVEC3C.1541
C-------------------------------------------------------------------- CONVEC3C.1542
C CONVEC3C.1543
IF ( FLX2 .GT. WORK(I,22)) FLX2 = WORK(I,22) CONVEC3C.1544
C CONVEC3C.1545
C-------------------------------------------------------------------- CONVEC3C.1546
C ADJUST ENTRAINMENT RATE IN BOTTOM HALF OF LAYER 2 CONVEC3C.1547
C-------------------------------------------------------------------- CONVEC3C.1548
C CONVEC3C.1549
WORK(I,12) = (FLX2/(WORK(I,19) * (1.0 + WORK(I,11)))) - 1.0 CONVEC3C.1550
END IF CONVEC3C.1551
C CONVEC3C.1552
END IF CONVEC3C.1553
END DO CONVEC3C.1554
C CONVEC3C.1555
C--------------------------------------------------------------------- CONVEC3C.1556
C RECALCULATE ASCENT FROM LAYER 1 TO 2 USING ADJUSTED ENTRAINMENT RATE CONVEC3C.1557
C--------------------------------------------------------------------- CONVEC3C.1558
C CONVEC3C.1559
CALL LIFT_PAR (NCONV,NPNTS,WORK(1,13),WORK(1,14),WORK(1,15), CONVEC3C.1560
* BWORK(1,2),BWORK(1,1),WORK(1,7),WORK(1,8), CONVEC3C.1561
* WORK(1,2),WORK(1,4),WORK(1,1),WORK(1,3), CONVEC3C.1562
* WORK(1,5),WORK(1,6),WORK(1,9), CONVEC3C.1563
* WORK(1,10),WORK(1,11),WORK(1,12),L_MOM, CONVEC3C.1564
* WORK(1,29),WORK(1,30),WORK(1,27),WORK(1,28), CONVEC3C.1565
* WORK(1,23),WORK(1,24),WORK(1,25),WORK(1,26), CONVEC3C.1566
* L_TRACER,NTRA,TRAPKP1_C,TRAPK_C,TRAEKP1_C, CONVEC3C.1567
* TRAEK_C,L_SHALLOW_C) CONVEC3C.1568
C CONVEC3C.1569
DO I=1,NCONV CONVEC3C.1570
C CONVEC3C.1571
IF ( BWORK(I,3) ) THEN CONVEC3C.1572
CL CONVEC3C.1573
CL--------------------------------------------------------------------- CONVEC3C.1574
CL RECALCULATE BUOYANCY OF PARCEL IN LAYER K+1 CONVEC3C.1575
CL--------------------------------------------------------------------- CONVEC3C.1576
CL CONVEC3C.1577
WORK(I,16) = WORK(I,13)*(1.0 + CONVEC3C.1578
* C_VIRTUAL * WORK(I,14)) CONVEC3C.1579
* - WORK(I,2)*(1.0 + CONVEC3C.1580
* C_VIRTUAL * WORK(I,4)) CONVEC3C.1581
C CONVEC3C.1582
C---------------------------------------------------------------------- CONVEC3C.1583
C RESET MASK TO INITIATE CONVECTION WHERE BUOYANCY IS LARGE ENOUGH CONVEC3C.1584
C---------------------------------------------------------------------- CONVEC3C.1585
C CONVEC3C.1586
BWORK(I,3) = .NOT.BWORK(I,4) .AND. WORK(I,16) .GT. CONVEC3C.1587
* (WORK(I,20)+ XSBMIN) CONVEC3C.1588
C CONVEC3C.1589
BWORK(I,4) = BWORK(I,4) .OR. BWORK(I,3) CONVEC3C.1590
C CONVEC3C.1591
END IF CONVEC3C.1592
C CONVEC3C.1593
FLX(INDEX1(I),K) = WORK(I,19) CONVEC3C.1594
IF(FLG_UP_FLX) UP_FLUX(INDEX1(I),K)=WORK(I,19) API2F405.263
C CONVEC3C.1595
END DO CONVEC3C.1596
C CONVEC3C.1597
C---------------------------------------------------------------------- CONVEC3C.1598
C END OF CALCULATION FOR LAYER 1 CONVEC3C.1599
C---------------------------------------------------------------------- CONVEC3C.1600
C CONVEC3C.1601
ELSE CONVEC3C.1602
C CONVEC3C.1603
DO I=1,NCONV CONVEC3C.1604
C CONVEC3C.1605
C---------------------------------------------------------------------- CONVEC3C.1606
C IF MASS FLUX OUT OF THE INITIAL LAYER IS GREATER THAN THE MASS OF CONVEC3C.1607
C THE LAYER OVER THE TIMESTEP THEN LIMIT MASS FLUX TO MASSS OF LAYER CONVEC3C.1608
C---------------------------------------------------------------------- CONVEC3C.1609
C CONVEC3C.1610
IF (BWORK(I,3) .AND. WORK(I,19).GT.WORK(I,21)) CONVEC3C.1611
1 WORK(I,19) = WORK(I,21) CONVEC3C.1612
C CONVEC3C.1613
BWORK(I,4) = BWORK(I,4) .OR. BWORK(I,3) CONVEC3C.1614
C CONVEC3C.1615
FLX(INDEX1(I),K) = WORK(I,19) CONVEC3C.1616
IF(FLG_UP_FLX) UP_FLUX(INDEX1(I),K)=WORK(I,19) API2F405.264
C CONVEC3C.1617
END DO CONVEC3C.1618
C CONVEC3C.1619
END IF CONVEC3C.1620
C CONVEC3C.1621
CL CONVEC3C.1622
CL-------------------------------------------------------------------- CONVEC3C.1623
CL ZERO MIXING DETRAINMENT RATE WHEN CONVECTION STARTS FROM LAYER K CONVEC3C.1624
CL STORE DIAGNOSTIC LINKED TO INITIAL CONVECTIVE MASSFLUX FOR CONVEC3C.1625
CL CALCULATION OF FINAL CLOSURE FOR DEEP CONVECTION. CONVEC3C.1626
CL-------------------------------------------------------------------- CONVEC3C.1627
CL CONVEC3C.1628
DO I=1,NCONV CONVEC3C.1629
IF ( BWORK(I,3) )THEN CONVEC3C.1630
AMDETK(INDEX1(I))=0.0 CONVEC3C.1631
FLX_INIT(INDEX1(I))=WORK(I,19) CONVEC3C.1632
START_LEV(INDEX1(I))=K CONVEC3C.1633
FLXMAX_INIT(INDEX1(I))=WORK(I,21) CONVEC3C.1634
END IF CONVEC3C.1635
END DO CONVEC3C.1636
CL CONVEC3C.1637
CL-------------------------------------------------------------------- CONVEC3C.1638
CL COMPRESS DOWN THOSE POINTS WHICH ARE NOT BUOYANT IN LAYER K+1. CONVEC3C.1639
CL-------------------------------------------------------------------- CONVEC3C.1640
CL CONVEC3C.1641
NINIT = 0 CONVEC3C.1642
DO 115 I=1,NCONV CONVEC3C.1643
IF(BWORK(I,4))THEN CONVEC3C.1644
NINIT = NINIT + 1 CONVEC3C.1645
INDEX2(NINIT) = I CONVEC3C.1646
END IF CONVEC3C.1647
115 CONTINUE CONVEC3C.1648
C CONVEC3C.1649
C CONVEC3C.1650
C---------------------------------------------------------------------- CONVEC3C.1651
C WORK SPACE USAGE FOR SECOND COMPRESS ON BASIS OF WHETHER CONVEC3C.1652
C PARCEL A PARCEL STARTING FROM LAYER K IS BUOYANT IN LAYER CONVEC3C.1653
C K+1 OR IF CONVECTION ALREADY EXISTS IN LAYER K CONVEC3C.1654
C CONVEC3C.1655
C REFERENCES TO WORK, WORK2, BWORK AND BWORK2 CONVEC3C.1656
C REFER TO STARTING ADDRESS CONVEC3C.1657
C CONVEC3C.1658
C LENGTH OF COMPRESSES DATA = NINIT CONVEC3C.1659
C CONVEC3C.1660
C WORK2 AND BWORK2 ARE COMPRESSED DOWN FROM COMPRESSED CONVEC3C.1661
C ARRAYS STORED IN WORK AND BWORK AFTER FIST COMPRESS CONVEC3C.1662
C CONVEC3C.1663
C WORK2(1,1) = TH(#,K) CONVEC3C.1664
C WORK2(1,2) = TH(#,K+1) CONVEC3C.1665
C WORK2(1,3) = Q(#,K) CONVEC3C.1666
C WORK2(1,4) = Q(#,K+1) CONVEC3C.1667
C WORK2(1,5) = QSE(#,K+1) CONVEC3C.1668
C WORK2(1,6) = DQSTHKP1(#) CONVEC3C.1669
C WORK2(1,7) = THP(#,K) CONVEC3C.1670
C WORK2(1,8) = QP(#,K) CONVEC3C.1671
C WORK2(1,9) = PKP1(#) CONVEC3C.1672
C WORK2(1,10) = EXKP1(#) CONVEC3C.1673
C WORK2(1,11) = EKP14(#) CONVEC3C.1674
C WORK2(1,12) = EKP34(#) CONVEC3C.1675
C WORK2(1,13) = PARCEL POT. TEMPERATURE IN LAYER K+1 CONVEC3C.1676
C WORK2(1,14) = PARCEL MIXING RATIO IN LAYER K+1 CONVEC3C.1677
C WORK2(1,15) = EXCESS WATER VAPOUR IN PARCEL ABOVE CONVEC3C.1678
C SATURATION AFTER DRY ASCENT CONVEC3C.1679
C WORK2(1,16) = PARCEL BUOYANCY IN LAYER K+1 CONVEC3C.1680
C WORK2(1,17) = NOT USED IN THIS SECTION CONVEC3C.1681
C WORK2(1,18) = PSTAR(#) CONVEC3C.1682
C WORK2(1,19) = FLX(#,K) CONVEC3C.1683
C CONVEC3C.1684
C BWORK2(1,1) = BWATER(INDEX1(I),K+1) CONVEC3C.1685
C BWORK2(1,2) = .TRUE. IF PARCEL SATURATED IN LAYER K+1 CONVEC3C.1686
C BWORK2(1,3) = .TRUE. IF CONVECTION INITIATE FROM LAYER K+1 CONVEC3C.1687
C WORK2(1,23) = U(#,K) CONVEC3C.1688
C WORK2(1,24) = U(#,K+1) CONVEC3C.1689
C WORK2(1,25) = V(#,K) CONVEC3C.1690
C WORK2(1,26) = V(#,K+1) CONVEC3C.1691
C WORK2(1,27) = UP(#,K) CONVEC3C.1692
C WORK2(1,28) = VP(#,K) CONVEC3C.1693
C WORK2(1,29) = PARCEL U IN LAYER K+1 CONVEC3C.1694
C WORK2(1,30) = PARCEL V IN LAYER K+1 CONVEC3C.1695
C CONVEC3C.1696
C WORK AND BWORK NOW CONTAIN DATA COMPRESSED DOWN CONVEC3C.1697
C FROM FULL LENGTH VECTORS CONVEC3C.1698
C CONVEC3C.1699
C WORK(1,1) = not used in this section CONVEC3C.1700
C WORK(1,2) = QSE(#,K) CONVEC3C.1701
C WORK(1,3) = DQSTHK(#) CONVEC3C.1702
C WORK(1,4) = THPI(#) CONVEC3C.1703
C WORK(1,5) = QPI(#) CONVEC3C.1704
C WORK(1,6) = XPK(#,K+1) CONVEC3C.1705
C WORK(1,7) = not used in this section CONVEC3C.1706
C WORK(1,8) = DEPTH(#) CONVEC3C.1707
C WORK(1,9) = PRECIP(#,K+1) CONVEC3C.1708
C WORK(1,10) = DTHBYDT(#,K) CONVEC3C.1709
C WORK(1,11) = DQBYDT(#,K) CONVEC3C.1710
C WORK(1,12) = DTHBYDT(#,K+1) CONVEC3C.1711
C WORK(1,13) = DQBYDT(#,K+1) CONVEC3C.1712
C WORK(1,14) = AMDETK(#) CONVEC3C.1713
C WORK(1,15) = NOY USED IN THIS SECTION CONVEC3C.1714
C WORK(1,16) = PK(#) CONVEC3C.1715
C WORK(1,17) = EXK(#) CONVEC3C.1716
C WORK(1,18) = DELEXKP1(#) CONVEC3C.1717
C WORK(1,19) = DELPK(#) CONVEC3C.1718
C WORK(1,20) = DELPKP1(#) CONVEC3C.1719
C WORK(1,21) = CCW(#,K+1) CONVEC3C.1720
C WORK(1,22) = T1_SD(#) CONVEC3C.1721
C WORK(1,23) = Q1_SD(#) CONVEC3C.1722
C WORK(1,24) = DUBYDT(#,K) CONVEC3C.1723
C WORK(1,25) = DUBYDT(#,K+1) CONVEC3C.1724
C WORK(1,26) = DVBYDT(#,K) CONVEC3C.1725
C WORK(1,27) = DVBYDT(#,K+1) CONVEC3C.1726
C WORK(1,28) = EFLUX_U_UD(#) CONVEC3C.1727
C WORK(1,29) = EFLUX_V_UD(#) CONVEC3C.1728
C CONVEC3C.1729
C BWORK(1,1) = BGMK(#) CONVEC3C.1730
C BWORK(1,2) = BLAND(#) CONVEC3C.1731
C BWORK(1,3) = BTERM(#) CONVEC3C.1732
C BWORK(1,2) = BLAND(#) CONVEC3C.1733
C---------------------------------------------------------------------- CONVEC3C.1734
C CONVEC3C.1735
IF (NINIT .NE. 0) THEN CONVEC3C.1736
C CONVEC3C.1737
C----------------------------------------------------------------------- CONVEC3C.1738
C FIRST COMPRESS DOWN QUANTITIES FROM PREVIOUSLY COMPRESSED ARRAY CONVEC3C.1739
C----------------------------------------------------------------------- CONVEC3C.1740
C CONVEC3C.1741
DO I=1,NINIT CONVEC3C.1742
WORK2(I,1) = WORK(INDEX2(I),1) CONVEC3C.1743
WORK2(I,2) = WORK(INDEX2(I),2) CONVEC3C.1744
END DO CONVEC3C.1745
DO I=1,NINIT CONVEC3C.1746
WORK2(I,3) = WORK(INDEX2(I),3) CONVEC3C.1747
WORK2(I,4) = WORK(INDEX2(I),4) CONVEC3C.1748
END DO CONVEC3C.1749
DO I=1,NINIT CONVEC3C.1750
WORK2(I,5) = WORK(INDEX2(I),5) CONVEC3C.1751
WORK2(I,6) = WORK(INDEX2(I),6) CONVEC3C.1752
END DO CONVEC3C.1753
DO I=1,NINIT CONVEC3C.1754
WORK2(I,7) = WORK(INDEX2(I),7) CONVEC3C.1755
WORK2(I,8) = WORK(INDEX2(I),8) CONVEC3C.1756
END DO CONVEC3C.1757
DO I=1,NINIT CONVEC3C.1758
WORK2(I,9) = WORK(INDEX2(I),9) CONVEC3C.1759
WORK2(I,10) = WORK(INDEX2(I),10) CONVEC3C.1760
END DO CONVEC3C.1761
DO I=1,NINIT CONVEC3C.1762
WORK2(I,11) = WORK(INDEX2(I),11) CONVEC3C.1763
WORK2(I,12) = WORK(INDEX2(I),12) CONVEC3C.1764
END DO CONVEC3C.1765
DO I=1,NINIT CONVEC3C.1766
WORK2(I,13) = WORK(INDEX2(I),13) CONVEC3C.1767
WORK2(I,14) = WORK(INDEX2(I),14) CONVEC3C.1768
END DO CONVEC3C.1769
DO I=1,NINIT CONVEC3C.1770
WORK2(I,15) = WORK(INDEX2(I),15) CONVEC3C.1771
WORK2(I,16) = WORK(INDEX2(I),16) CONVEC3C.1772
END DO CONVEC3C.1773
DO I=1,NINIT CONVEC3C.1774
WORK2(I,17) = WORK(INDEX2(I),17) CONVEC3C.1775
WORK2(I,18) = WORK(INDEX2(I),18) CONVEC3C.1776
END DO CONVEC3C.1777
DO I=1,NINIT CONVEC3C.1778
WORK2(I,19) = WORK(INDEX2(I),19) CONVEC3C.1779
BWORK2(I,1) = BWORK(INDEX2(I),1) CONVEC3C.1780
END DO CONVEC3C.1781
DO I=1,NINIT CONVEC3C.1782
BWORK2(I,2) = BWORK(INDEX2(I),2) CONVEC3C.1783
BWORK2(I,3) = BWORK(INDEX2(I),3) CONVEC3C.1784
END DO CONVEC3C.1785
DO I=1,NINIT CONVEC3C.1786
L_SHALLOW_C2(I) = L_SHALLOW_C(INDEX2(I)) CONVEC3C.1787
L_MID_C2(I) = L_MID_C(INDEX2(I)) CONVEC3C.1788
END DO CONVEC3C.1789
C CONVEC3C.1790
IF(L_MOM)THEN CONVEC3C.1791
DO I=1,NINIT CONVEC3C.1792
WORK2(I,23) = WORK(INDEX2(I),23) CONVEC3C.1793
WORK2(I,24) = WORK(INDEX2(I),24) CONVEC3C.1794
END DO CONVEC3C.1795
DO I=1,NINIT CONVEC3C.1796
WORK2(I,25) = WORK(INDEX2(I),25) CONVEC3C.1797
WORK2(I,26) = WORK(INDEX2(I),26) CONVEC3C.1798
END DO CONVEC3C.1799
DO I=1,NINIT CONVEC3C.1800
WORK2(I,27) = WORK(INDEX2(I),27) CONVEC3C.1801
WORK2(I,28) = WORK(INDEX2(I),28) CONVEC3C.1802
END DO CONVEC3C.1803
DO I=1,NINIT CONVEC3C.1804
WORK2(I,29) = WORK(INDEX2(I),29) CONVEC3C.1805
WORK2(I,30) = WORK(INDEX2(I),30) CONVEC3C.1806
END DO CONVEC3C.1807
END IF CONVEC3C.1808
C CONVEC3C.1809
IF(L_TRACER)THEN CONVEC3C.1810
C CONVEC3C.1811
DO KTRA=1,NTRA CONVEC3C.1812
DO I=1,NINIT CONVEC3C.1813
TRAEK_C2(I,KTRA)=TRAEK_C(INDEX2(I),KTRA) CONVEC3C.1814
TRAEKP1_C2(I,KTRA)=TRAEKP1_C(INDEX2(I),KTRA) CONVEC3C.1815
END DO CONVEC3C.1816
DO I=1,NINIT CONVEC3C.1817
TRAPK_C2(I,KTRA)=TRAPK_C(INDEX2(I),KTRA) CONVEC3C.1818
TRAPKP1_C2(I,KTRA)=TRAPKP1_C(INDEX2(I),KTRA) CONVEC3C.1819
END DO CONVEC3C.1820
END DO CONVEC3C.1821
C CONVEC3C.1822
END IF CONVEC3C.1823
C---------------------------------------------------------------------- CONVEC3C.1824
C COMPRESS DOWN REST OF DATA FROM FULL ARRAYS CONVEC3C.1825
C CONVEC3C.1826
C FIRST EXPAND BACK BWORK(1,2) (=BINIT) BACK TO FULL VECTORS CONVEC3C.1827
C---------------------------------------------------------------------- CONVEC3C.1828
C CONVEC3C.1829
CDIR$ IVDEP CONVEC3C.1830
! Fujitsu vectorization directive GRB0F405.211
!OCL NOVREC GRB0F405.212
DO 130 I=1,NCONV CONVEC3C.1831
BINIT(INDEX1(I)) = BWORK(I,4) CONVEC3C.1832
130 CONTINUE CONVEC3C.1833
C CONVEC3C.1834
NINIT = 0 CONVEC3C.1835
DO 135 I=1,NPNTS CONVEC3C.1836
IF(BINIT(I))THEN CONVEC3C.1837
NINIT = NINIT + 1 CONVEC3C.1838
INDEX3(NINIT) = I CONVEC3C.1839
END IF CONVEC3C.1840
135 CONTINUE CONVEC3C.1841
C CONVEC3C.1842
DO I=1,NINIT CONVEC3C.1843
WORK(I,2) = QSE(INDEX3(I),K) CONVEC3C.1844
WORK(I,3) = DQSTHK(INDEX3(I)) CONVEC3C.1845
END DO CONVEC3C.1846
DO I=1,NINIT CONVEC3C.1847
WORK(I,4) = THPI(INDEX3(I)) CONVEC3C.1848
WORK(I,5) = QPI(INDEX3(I)) CONVEC3C.1849
END DO CONVEC3C.1850
DO I=1,NINIT CONVEC3C.1851
WORK(I,6) = XPK(INDEX3(I),K) CONVEC3C.1852
WORK(I,8) = DEPTH(INDEX3(I)) CONVEC3C.1853
END DO CONVEC3C.1854
DO I=1,NINIT CONVEC3C.1855
CCA_2DC(I) = CCA_2D(INDEX3(I)) CONVEC3C.1856
ICCBC(I) = ICCB(INDEX3(I)) CONVEC3C.1857
END DO CONVEC3C.1858
DO I=1,NINIT CONVEC3C.1859
ICCTC(I) = ICCT(INDEX3(I)) CONVEC3C.1860
TCWC(I) = TCW(INDEX3(I)) CONVEC3C.1861
END DO CONVEC3C.1862
DO I=1,NINIT CONVEC3C.1863
CCLWPC(I) = CCLWP(INDEX3(I)) CONVEC3C.1864
LCCAC(I) = LCCA(INDEX3(I)) ! beware - LCCAC & LCBASEC CONVEC3C.1865
END DO CONVEC3C.1866
DO I=1,NINIT CONVEC3C.1867
LCBASEC(I) = LCBASE(INDEX3(I)) ! are IN/OUT to lower levels CONVEC3C.1868
LCTOPC(I) = LCTOP(INDEX3(I)) CONVEC3C.1869
END DO CONVEC3C.1870
DO I=1,NINIT CONVEC3C.1871
LCCLWPC(I) = LCCLWP(INDEX3(I)) CONVEC3C.1872
BWORK(I,1) = BGMK(INDEX3(I)) CONVEC3C.1873
END DO CONVEC3C.1874
DO I=1,NINIT CONVEC3C.1875
BWORK(I,2) = BLAND(INDEX3(I)) CONVEC3C.1876
WORK(I,10) = DTHBYDT(INDEX3(I),K) CONVEC3C.1877
END DO CONVEC3C.1878
DO I=1,NINIT CONVEC3C.1879
WORK(I,11) = DQBYDT(INDEX3(I),K) CONVEC3C.1880
WORK(I,12) = DTHBYDT(INDEX3(I),K+1) CONVEC3C.1881
END DO CONVEC3C.1882
DO I=1,NINIT CONVEC3C.1883
WORK(I,13) = DQBYDT(INDEX3(I),K+1) CONVEC3C.1884
WORK(I,14) = AMDETK(INDEX3(I)) CONVEC3C.1885
END DO CONVEC3C.1886
DO I=1,NINIT CONVEC3C.1887
WORK(I,16) = PK(INDEX3(I)) CONVEC3C.1888
WORK(I,17) = EXK(INDEX3(I)) CONVEC3C.1889
END DO CONVEC3C.1890
DO I=1,NINIT CONVEC3C.1891
WORK(I,18) = DELEXKP1(INDEX3(I)) CONVEC3C.1892
WORK(I,19) = DELPK(INDEX3(I)) CONVEC3C.1893
END DO CONVEC3C.1894
DO I=1,NINIT CONVEC3C.1895
WORK(I,20) = DELPKP1(INDEX3(I)) CONVEC3C.1896
WORK(I,22) = T1_SD(INDEX3(I)) CONVEC3C.1897
END DO CONVEC3C.1898
DO I=1,NINIT CONVEC3C.1899
WORK(I,23) = Q1_SD(INDEX3(I)) CONVEC3C.1900
CAPE_C(I) = CAPE(INDEX3(I)) CONVEC3C.1901
END DO CONVEC3C.1902
DO I=1,NINIT CONVEC3C.1903
DCPBYDT_C(I) = DCPBYDT(INDEX3(I)) CONVEC3C.1904
C CONVEC3C.1905
BWORK(I,4) = .TRUE. CONVEC3C.1906
END DO CONVEC3C.1907
C CONVEC3C.1908
IF(L_MOM)THEN CONVEC3C.1909
DO I=1,NINIT CONVEC3C.1910
WORK(I,24) = DUBYDT(INDEX3(I),K) CONVEC3C.1911
WORK(I,25) = DUBYDT(INDEX3(I),K+1) CONVEC3C.1912
END DO CONVEC3C.1913
DO I=1,NINIT CONVEC3C.1914
WORK(I,26) = DVBYDT(INDEX3(I),K) CONVEC3C.1915
WORK(I,27) = DVBYDT(INDEX3(I),K+1) CONVEC3C.1916
END DO CONVEC3C.1917
DO I=1,NINIT CONVEC3C.1918
WORK(I,28) = EFLUX_U_UD(INDEX3(I)) CONVEC3C.1919
WORK(I,29) = EFLUX_V_UD(INDEX3(I)) CONVEC3C.1920
END DO CONVEC3C.1921
END IF CONVEC3C.1922
C CONVEC3C.1923
IF(L_TRACER)THEN CONVEC3C.1924
C CONVEC3C.1925
DO KTRA=1,NTRA CONVEC3C.1926
DO I=1,NINIT CONVEC3C.1927
DTRAEK_C(I,KTRA) = DTRABYDT(INDEX3(I),K,KTRA) CONVEC3C.1928
DTRAEKP1_C(I,KTRA) = DTRABYDT(INDEX3(I),K+1,KTRA) CONVEC3C.1929
END DO CONVEC3C.1930
END DO CONVEC3C.1931
C CONVEC3C.1932
END IF CONVEC3C.1933
C CONVEC3C.1934
CL CONVEC3C.1935
CL---------------------------------------------------------------------- CONVEC3C.1936
CL CALCULATE REST OF PARCEL ASCENT AND EFFECT OF CONVECTION CONVEC3C.1937
CL UPON THE LARGE-SCALE ATMOSPHERE CONVEC3C.1938
CL CONVEC3C.1939
CL SUBROUTINE CONVEC2 CONVEC3C.1940
CL CONVEC3C.1941
CL UM DOCUMENTATION PAPER 27 CONVEC3C.1942
CL SECTIONS (5),(6),(7),(8),(9),(10) CONVEC3C.1943
CL---------------------------------------------------------------------- CONVEC3C.1944
CL CONVEC3C.1945
CALL CONVEC2 (NINIT,NPNTS,NLEV,K,WORK2(1,1),WORK2(1,2),WORK2(1,3), CONVEC3C.1946
* WORK2(1,4),WORK2(1,5),WORK2(1,6),WORK2(1,18), CONVEC3C.1947
* WORK2(1,7),WORK2(1,8),WORK2(1,13),WORK2(1,14), CONVEC3C.1948
* WORK2(1,15),WORK2(1,16),WORK(1,2),WORK(1,3), CONVEC3C.1949
* WORK(1,4),WORK(1,5),WORK(1,6),WORK2(1,19), CONVEC3C.1950
* BWORK2(1,1),BWORK2(1,2),BWORK(1,1),BWORK2(1,3), CONVEC3C.1951
* BWORK(1,2),BWORK(1,3),WORK(1,8),WORK(1,9), CONVEC3C.1952
* WORK(1,10),WORK(1,11),WORK(1,12),WORK(1,13), CONVEC3C.1953
* BWORK(1,4),CCA_2DC,ICCBC,ICCTC,TCWC, CONVEC3C.1954
* WORK2(1,11),WORK2(1,12),WORK(1,14), CONVEC3C.1955
* WORK(1,16),WORK2(1,9),WORK(1,17),WORK2(1,10), CONVEC3C.1956
* WORK(1,18),WORK(1,19),WORK(1,20), CONVEC3C.1957
* CCLWPC,WORK(1,21),LCCAC,LCBASEC,LCTOPC,LCCLWPC, CONVEC3C.1958
* WORK(1,22),WORK(1,23),L_MOM,WORK2(1,23),WORK2(1,24), CONVEC3C.1959
* WORK2(1,25),WORK2(1,26),WORK2(1,27),WORK2(1,28), CONVEC3C.1960
* WORK2(1,29),WORK2(1,30),WORK(1,24),WORK(1,25), CONVEC3C.1961
* WORK(1,26),WORK(1,27),WORK(1,28),WORK(1,29), CONVEC3C.1962
* L_SHALLOW_C2,L_MID_C2, CONVEC3C.1963
* L_TRACER,NTRA,TRAEK_C2,TRAEKP1_C2,TRAPK_C2, CONVEC3C.1964
* TRAPKP1_C2,DTRAEK_C,DTRAEKP1_C,CAPE_C,DCPBYDT_C, CONVEC3C.1965
& L_XSCOMP,L_SDXS,L_CCW,MPARWTR,UD_FACTOR, AJX3F405.56
& DELTAK) AJX3F405.57
CL CONVEC3C.1967
CL--------------------------------------------------------------------- CONVEC3C.1968
CL EXPAND REQUIRED VECTORS BACK TO FULL FIELDS CONVEC3C.1969
CL---------------------------------------------------------------------- CONVEC3C.1970
CL CONVEC3C.1971
DO I=1,NPNTS CONVEC3C.1972
THP(I,K+1) = 0.0 CONVEC3C.1973
QP(I,K+1) = 0.0 CONVEC3C.1974
ENDDO CONVEC3C.1975
DO I=1,NPNTS CONVEC3C.1976
XPK(I,K+1) = 0.0 CONVEC3C.1977
FLX(I,K+1)= 0.0 CONVEC3C.1978
ENDDO CONVEC3C.1979
DO I=1,NPNTS CONVEC3C.1980
DEPTH(I) = 0.0 CONVEC3C.1981
PRECIP(I,K+1) = 0.0 CONVEC3C.1982
ENDDO CONVEC3C.1983
DO I=1,NPNTS CONVEC3C.1984
BGMK(I) = .FALSE. CONVEC3C.1985
BTERM(I) = .FALSE. CONVEC3C.1986
BINIT(I) = .FALSE. CONVEC3C.1987
ENDDO CONVEC3C.1988
C CONVEC3C.1989
IF(L_MOM)THEN CONVEC3C.1990
DO I=1,NPNTS CONVEC3C.1991
UP(I,K+1) = 0.0 CONVEC3C.1992
VP(I,K+1) = 0.0 CONVEC3C.1993
END DO CONVEC3C.1994
END IF CONVEC3C.1995
C CONVEC3C.1996
IF(L_TRACER)THEN CONVEC3C.1997
C CONVEC3C.1998
DO KTRA=1,NTRA CONVEC3C.1999
DO I=1,NPNTS CONVEC3C.2000
TRAP(I,K+1,KTRA) = 0.0 CONVEC3C.2001
END DO CONVEC3C.2002
END DO CONVEC3C.2003
C CONVEC3C.2004
END IF CONVEC3C.2005
C CONVEC3C.2006
CDIR$ IVDEP CONVEC3C.2007
! Fujitsu vectorization directive GRB0F405.213
!OCL NOVREC GRB0F405.214
DO I=1,NINIT CONVEC3C.2008
THP(INDEX3(I),K+1) = WORK2(I,7) CONVEC3C.2009
QP(INDEX3(I),K+1) = WORK2(I,8) CONVEC3C.2010
ENDDO CONVEC3C.2011
DO I=1,NINIT CONVEC3C.2012
XPK(INDEX3(I),K+1) = WORK(I,6) CONVEC3C.2013
FLX(INDEX3(I),K+1) = WORK2(I,19) CONVEC3C.2014
IF(FLG_UP_FLX) UP_FLUX(INDEX3(I),K+1)=WORK2(I,19) API2F405.265
ENDDO CONVEC3C.2015
IF(FLG_ENTR_UP) THEN API2F405.266
DO I=1,NINIT CONVEC3C.2016
ENTRAIN_UP(INDEX3(I),K)=(1.0-DELTAK(I))* API2F405.267
& (1.0-WORK(I,14))*(WORK2(I,11)+WORK2(I,12)* API2F405.268
& (1.0+WORK2(I,11)))*FLX(INDEX3(I),K) API2F405.269
IF(BTERM(INDEX3(I))) ENTRAIN_UP(INDEX3(I),K+1)=0.0 API2F405.270
END DO API2F405.271
ENDIF API2F405.272
IF(FLG_DETR_UP) THEN API2F405.273
DO I=1,NINIT API2F405.274
DETRAIN_UP(INDEX3(I),K)=-(WORK(I,14)+ API2F405.275
& DELTAK(I)*(1.0-WORK(I,14)))* API2F405.276
& FLX(INDEX3(I),K) API2F405.277
IF(BTERM(INDEX3(I))) DETRAIN_UP(INDEX3(I),K+1)= API2F405.278
& -(1.0-DELTAK(I))*FLX(INDEX3(I),K) API2F405.279
END DO API2F405.280
ENDIF API2F405.281
DO I=1,NINIT API2F405.282
DEPTH(INDEX3(I)) = WORK(I,8) CONVEC3C.2017
PRECIP(INDEX3(I),K+1) = WORK(I,9) CONVEC3C.2018
ENDDO CONVEC3C.2019
DO I=1,NINIT CONVEC3C.2020
DTHBYDT(INDEX3(I),K) = WORK(I,10) CONVEC3C.2021
DQBYDT(INDEX3(I),K) = WORK(I,11) CONVEC3C.2022
ENDDO CONVEC3C.2023
DO I=1,NINIT CONVEC3C.2024
DTHBYDT(INDEX3(I),K+1) = WORK(I,12) CONVEC3C.2025
DQBYDT(INDEX3(I),K+1) = WORK(I,13) CONVEC3C.2026
ENDDO CONVEC3C.2027
DO I=1,NINIT CONVEC3C.2028
CCA_2D(INDEX3(I)) = CCA_2DC(I) CONVEC3C.2029
ICCB(INDEX3(I)) = ICCBC(I) CONVEC3C.2030
ENDDO CONVEC3C.2031
DO I=1,NINIT CONVEC3C.2032
ICCT(INDEX3(I)) = ICCTC(I) CONVEC3C.2033
TCW(INDEX3(I)) = TCWC(I) CONVEC3C.2034
ENDDO CONVEC3C.2035
DO I=1,NINIT CONVEC3C.2036
CCLWP(INDEX3(I)) = CCLWPC(I) CONVEC3C.2037
LCCA(INDEX3(I)) = LCCAC(I) CONVEC3C.2038
ENDDO CONVEC3C.2039
DO I=1,NINIT CONVEC3C.2040
LCBASE(INDEX3(I)) = LCBASEC(I) CONVEC3C.2041
LCTOP(INDEX3(I)) = LCTOPC(I) CONVEC3C.2042
ENDDO CONVEC3C.2043
DO I=1,NINIT CONVEC3C.2044
LCCLWP(INDEX3(I)) = LCCLWPC(I) CONVEC3C.2045
CCW(INDEX3(I),K+1) = WORK(I,21) CONVEC3C.2046
ENDDO CONVEC3C.2047
DO I=1,NINIT CONVEC3C.2048
CAPE(INDEX3(I)) = CAPE_C(I) CONVEC3C.2049
DCPBYDT(INDEX3(I)) = DCPBYDT_C(I) CONVEC3C.2050
ENDDO CONVEC3C.2051
DO I=1,NINIT CONVEC3C.2052
C CONVEC3C.2053
BGMK(INDEX3(I)) = BWORK(I,1) CONVEC3C.2054
BTERM(INDEX3(I)) = BWORK(I,3) CONVEC3C.2055
BINIT(INDEX3(I)) = BWORK(I,4) CONVEC3C.2056
ENDDO CONVEC3C.2057
C CONVEC3C.2058
IF(L_MOM)THEN CONVEC3C.2059
DO I=1,NINIT CONVEC3C.2060
UP(INDEX3(I),K+1) = WORK2(I,27) CONVEC3C.2061
VP(INDEX3(I),K+1) = WORK2(I,28) CONVEC3C.2062
ENDDO CONVEC3C.2063
DO I=1,NINIT CONVEC3C.2064
DUBYDT(INDEX3(I),K) = WORK(I,24) CONVEC3C.2065
DVBYDT(INDEX3(I),K) = WORK(I,26) CONVEC3C.2066
ENDDO CONVEC3C.2067
DO I=1,NINIT CONVEC3C.2068
DUBYDT(INDEX3(I),K+1) = WORK(I,25) CONVEC3C.2069
DVBYDT(INDEX3(I),K+1) = WORK(I,27) CONVEC3C.2070
ENDDO CONVEC3C.2071
DO I=1,NINIT CONVEC3C.2072
EFLUX_U_UD(INDEX3(I)) = WORK(I,28) CONVEC3C.2073
EFLUX_V_UD(INDEX3(I)) = WORK(I,29) CONVEC3C.2074
END DO CONVEC3C.2075
END IF CONVEC3C.2076
C CONVEC3C.2077
IF(L_TRACER)THEN CONVEC3C.2078
C CONVEC3C.2079
DO KTRA=1,NTRA CONVEC3C.2080
DO I=1,NINIT CONVEC3C.2081
TRAP(INDEX3(I),K+1,KTRA)=TRAPK_C2(I,KTRA) CONVEC3C.2082
DTRABYDT(INDEX3(I),K,KTRA)=DTRAEK_C(I,KTRA) CONVEC3C.2083
DTRABYDT(INDEX3(I),K+1,KTRA)=DTRAEKP1_C(I,KTRA) CONVEC3C.2084
END DO CONVEC3C.2085
END DO CONVEC3C.2086
C CONVEC3C.2087
END IF CONVEC3C.2088
C CONVEC3C.2089
C CONVEC3C.2090
END IF CONVEC3C.2091
C CONVEC3C.2092
END IF CONVEC3C.2093
C CONVEC3C.2094
C------------------------------------------------------------------- CONVEC3C.2095
C ADJUSTMENT OF CLOSURE FOR DEEP CONVECTION CONVEC3C.2096
C CONVEC3C.2097
C UM DOCUMENTATION PAPER 27-3. SECTION 5. CONVEC3C.2098
C CONVEC3C.2099
C ADJUST INITIAL MASS FLUX SO THAT CAPE IS REMOVED BY CONVECTION CONVEC3C.2100
C OVER TIMESCALE CAPE_TS CONVEC3C.2101
C------------------------------------------------------------------- CONVEC3C.2102
C CONVEC3C.2103
C CONVEC3C.2104
DO I=1,NPNTS CONVEC3C.2105
IF(L_CAPE)THEN CONVEC3C.2106
IF(.NOT.L_SHALLOW(I).AND.BTERM(I))THEN CONVEC3C.2107
IF(DCPBYDT(I).GT.0.0)THEN CONVEC3C.2108
FLX_INIT_NEW(I)=FLX_INIT(I)*CAPE(I)/(CAPE_TS*DCPBYDT(I)) CONVEC3C.2109
IF(FLX_INIT_NEW(I).GT.FLXMAX_INIT(I))THEN CONVEC3C.2110
FLX_INIT_NEW(I)=FLXMAX_INIT(I) CONVEC3C.2111
END IF CONVEC3C.2112
END IF CONVEC3C.2113
END IF CONVEC3C.2114
END IF CONVEC3C.2115
IF(BTERM(I))THEN CONVEC3C.2116
CAPE_OUT(I)=CAPE(I) CONVEC3C.2117
CAPE(I)=0.0 CONVEC3C.2118
DCPBYDT(I)=0.0 CONVEC3C.2119
END IF CONVEC3C.2120
END DO CONVEC3C.2121
C CONVEC3C.2122
C--------------------------------------------------------------------- CONVEC3C.2123
C RESCALE Q1, Q2 MASS FLUX AND PRECIP FOR DEEP CONVECTION CONVEC3C.2124
C--------------------------------------------------------------------- CONVEC3C.2125
C CONVEC3C.2126
IF(L_CAPE)THEN CONVEC3C.2127
DO KT=1,K+1 CONVEC3C.2128
DO I=1,NPNTS CONVEC3C.2129
IF(KT.GE.START_LEV(I).AND..NOT.L_SHALLOW(I).AND.BTERM(I). CONVEC3C.2130
* AND.FLX_INIT_NEW(I).GT.0.0)THEN CONVEC3C.2131
IF(KT.EQ.DET_LEV(I))THEN CONVEC3C.2132
DTHBYDT(I,KT)=(DTHBYDT(I,KT) - DTHEF(I)) CONVEC3C.2133
* *FLX_INIT_NEW(I)/FLX_INIT(I) CONVEC3C.2134
DTHBYDT(I,KT) = DTHBYDT(I,KT) + DTHEF(I) CONVEC3C.2135
DQBYDT(I,KT)=(DQBYDT(I,KT) - DQF(I)) CONVEC3C.2136
* *FLX_INIT_NEW(I)/FLX_INIT(I) CONVEC3C.2137
DQBYDT(I,KT) = DQBYDT(I,KT) +DQF(I) CONVEC3C.2138
IF(L_MOM) THEN API1F405.37
DUBYDT(I,KT)=(DUBYDT(I,KT)-DUEF(I))* API1F405.38
& FLX_INIT_NEW(I)/FLX_INIT(I) API1F405.39
DUBYDT(I,KT)=DUBYDT(I,KT)+DUEF(I) API1F405.40
DVBYDT(I,KT)=(DVBYDT(I,KT)-DVEF(I))* API1F405.41
& FLX_INIT_NEW(I)/FLX_INIT(I) API1F405.42
DVBYDT(I,KT)=DVBYDT(I,KT)+DVEF(I) API1F405.43
ENDIF API1F405.44
ELSE CONVEC3C.2139
DTHBYDT(I,KT)=DTHBYDT(I,KT)*FLX_INIT_NEW(I)/FLX_INIT(I) CONVEC3C.2140
DQBYDT(I,KT)=DQBYDT(I,KT)*FLX_INIT_NEW(I)/FLX_INIT(I) CONVEC3C.2141
IF(L_MOM) THEN API1F405.45
DUBYDT(I,KT)=DUBYDT(I,KT)*FLX_INIT_NEW(I)/FLX_INIT(I) API1F405.46
DVBYDT(I,KT)=DVBYDT(I,KT)*FLX_INIT_NEW(I)/FLX_INIT(I) API1F405.47
ENDIF API1F405.48
END IF CONVEC3C.2142
FLX(I,KT)=FLX(I,KT)*FLX_INIT_NEW(I)/FLX_INIT(I) CONVEC3C.2143
IF(FLG_UP_FLX) UP_FLUX(I,KT)=FLX(I,KT) API2F405.283
IF(FLG_ENTR_UP) ENTRAIN_UP(I,KT)=ENTRAIN_UP(I,KT)* API2F405.284
& FLX_INIT_NEW(I)/FLX_INIT(I) API2F405.285
IF(FLG_DETR_UP) DETRAIN_UP(I,KT)=DETRAIN_UP(I,KT)* API2F405.286
& FLX_INIT_NEW(I)/FLX_INIT(I) API2F405.287
API2F405.288
PRECIP(I,KT)=PRECIP(I,KT)*FLX_INIT_NEW(I)/FLX_INIT(I) CONVEC3C.2144
END IF CONVEC3C.2145
END DO CONVEC3C.2146
END DO CONVEC3C.2147
DO I=1,NPNTS API1F405.49
IF(.NOT.L_SHALLOW(I).AND.BTERM(I).AND. API1F405.50
& FLX_INIT_NEW(I).GT.0.0)THEN API1F405.51
IF(CCA_2D(I).GT.2.0E-5) CCA_2D(I)=CCA_2D(I)+ API1F405.52
& 0.06*LOG(FLX_INIT_NEW(I)/FLX_INIT(I)) API1F405.53
ENDIF API1F405.54
END DO API1F405.55
C CONVEC3C.2148
END IF CONVEC3C.2149
CL CONVEC3C.2150
CL--------------------------------------------------------------------- CONVEC3C.2151
CL DOWNDRAUGHT CALCULATION CONVEC3C.2152
CL CONVEC3C.2153
CL CARRIED OUT FOR THOSE CLOUD WHICH ARE TERMINATING CONVEC3C.2154
CL CONVEC3C.2155
CL SUBROUTINE DD_CALL CONVEC3C.2156
CL CONVEC3C.2157
CL UM DOCUMENTATION PAPER 27 CONVEC3C.2158
CL SECTION (11) CONVEC3C.2159
CL--------------------------------------------------------------------- CONVEC3C.2160
CL CONVEC3C.2161
C CONVEC3C.2162
NTERM = 0 CONVEC3C.2163
DO 160 I=1,NPNTS CONVEC3C.2164
IF (BTERM(I)) THEN CONVEC3C.2165
NTERM = NTERM + 1 CONVEC3C.2166
DTHEF(I) = DTHBYDT(I,K+1) CONVEC3C.2167
DQF(I) = DQBYDT(I,K+1) CONVEC3C.2168
IF(L_MOM) THEN API1F405.56
DUEF(I)=DUBYDT(I,K+1) API1F405.57
DVEF(I)=DVBYDT(I,K+1) API1F405.58
ENDIF API1F405.59
API1F405.60
API1F405.61
DET_LEV(I) = K+1 CONVEC3C.2169
END IF CONVEC3C.2170
160 CONTINUE CONVEC3C.2171
C CONVEC3C.2172
IF (NTERM .NE. 0) THEN CONVEC3C.2173
C CONVEC3C.2174
CALL DD_CALL (NP_FIELD,NPNTS,K,THP(1,1),QP(1,1),TH(1,1), CONVEC3C.2175
* Q(1,1),DTHBYDT(1,1),DQBYDT(1,1),FLX(1,1), CONVEC3C.2176
* PSTAR,AK,BK,AKM12,BKM12,DELAK,DELBK,EXNER(1,1), CONVEC3C.2177
* PRECIP(1,1),RAIN,SNOW,ICCB,ICCT,BWATER(1,2), CONVEC3C.2178
* BTERM,BGMK,TIMESTEP,CCA_2D,NTERM,L_MOM,UP(1,1), CONVEC3C.2179
* VP(1,1),U(1,1),V(1,1),DUBYDT(1,1),DVBYDT(1,1), CONVEC3C.2180
* EFLUX_U_DD,EFLUX_V_DD, CONVEC3C.2181
* L_TRACER,NTRA,TRAP,TRACER,DTRABYDT,NLEV,TRLEV, CONVEC3C.2182
& recip_pstar,L_PHASE_LIM, AJX1F405.35
& DWN_FLUX,FLG_DWN_FLX,ENTRAIN_DWN, AJX1F405.36
& FLG_ENTR_DWN,DETRAIN_DWN,FLG_DETR_DWN AJX1F405.37
& ) AJX1F405.38
C CONVEC3C.2184
C--------------------------------------------------------------------- CONVEC3C.2185
C ZERO CONVECTION START LEVEL IF CONVECTION TERMINATES CONVEC3C.2186
C--------------------------------------------------------------------- CONVEC3C.2187
C CONVEC3C.2188
DO I=1,NPNTS CONVEC3C.2189
IF(BTERM(I))THEN CONVEC3C.2190
START_LEV(I)=0.0 CONVEC3C.2191
END IF CONVEC3C.2192
END DO CONVEC3C.2193
C CONVEC3C.2194
C--------------------------------------------------------------------- CONVEC3C.2195
C ADJUSTMENT TO CLOUD BASE, TOP AND AMOUNT CONVEC3C.2196
C CONVEC3C.2197
C IF CLOUD BASE AND TOP ARE EQUAL THEN ERRORS OCCUR IN RADIATION SCHEME CONVEC3C.2198
C CONVEC3C.2199
C ONLY OCCURS IF CONVECTION SATURATES UPON FORCED DETRAINMENT CONVEC3C.2200
C CONVEC3C.2201
C WHEN OCCURS ZERO CLOUD BASE, TOP AND AMOUNT CONVEC3C.2202
C CONVEC3C.2203
C--------------------------------------------------------------------- CONVEC3C.2204
C CONVEC3C.2205
DO I=1,NPNTS CONVEC3C.2206
IF (BTERM(I) .AND. ICCB(I) .EQ. ICCT(I)) THEN CONVEC3C.2207
ICCB(I) = 0.0 CONVEC3C.2208
ICCT(I) = 0.0 CONVEC3C.2209
CCA_2D(I) = 0.0 CONVEC3C.2210
TCW(I) = 0.0 CONVEC3C.2211
CCLWP(I) = 0.0 CONVEC3C.2212
END IF CONVEC3C.2213
IF (BTERM(I) .AND. LCBASE(I) .EQ. LCTOP(I)) THEN CONVEC3C.2214
LCBASE(I) = 0 CONVEC3C.2215
LCTOP(I) = 0 CONVEC3C.2216
LCCA(I) = 0.0 CONVEC3C.2217
LCCLWP(I) = 0.0 CONVEC3C.2218
END IF CONVEC3C.2219
END DO CONVEC3C.2220
C CONVEC3C.2221
C--------------------------------------------------------------------- CONVEC3C.2222
C RESET BTERM TO FALSE CONVEC3C.2223
C--------------------------------------------------------------------- CONVEC3C.2224
C CONVEC3C.2225
DO 200 I=1,NPNTS CONVEC3C.2226
200 BTERM(I) = .FALSE. CONVEC3C.2227
C CONVEC3C.2228
END IF CONVEC3C.2229
CL CONVEC3C.2230
CL===================================================================== CONVEC3C.2231
CL END OF MAIN LOOP CONVEC3C.2232
CL===================================================================== CONVEC3C.2233
CL CONVEC3C.2234
60 CONTINUE CONVEC3C.2235
CL CONVEC3C.2236
CL--------------------------------------------------------------------- CONVEC3C.2237
CL BALANCE ENERGY BUDGET BY APPLYING CORRECTION TO THE TEMPERATURES CONVEC3C.2238
CL CONVEC3C.2239
CL SUBROUTINE COR_ENGY CONVEC3C.2240
CL CONVEC3C.2241
CL UM DOCUMENTATION PAPER 27 CONVEC3C.2242
CL SECTION (12) CONVEC3C.2243
CL--------------------------------------------------------------------- CONVEC3C.2244
CL CONVEC3C.2245
NCNLV = 0 CONVEC3C.2246
DO 210 I=1,NPNTS CONVEC3C.2247
IF(BCNLV(I))THEN CONVEC3C.2248
NCNLV = NCNLV + 1 CONVEC3C.2249
INDEX4(NCNLV) = I CONVEC3C.2250
END IF CONVEC3C.2251
210 CONTINUE CONVEC3C.2252
C CONVEC3C.2253
C CONVEC3C.2254
C---------------------------------------------------------------------- CONVEC3C.2255
C WORK SPACE USAGE FOR ENERGY CORRECTION CALCULATION CONVEC3C.2256
C CONVEC3C.2257
C REFERENCES TO WORK AND WORK2 CONVEC3C.2258
C REFER TO STARTING ADDRESS CONVEC3C.2259
C CONVEC3C.2260
C LENGTH OF COMPRESSES DATA = NCNLV CONVEC3C.2261
C CONVEC3C.2262
C WORK(1,1 TO NLEV) = DTHBYDT(#,1 TO NLEV) CONVEC3C.2263
C WORK(1,NLEV+1 TO 2*NLEV) = DQBYDT(#,1 TO NLEV) CONVEC3C.2264
C WORK2(1,1 TO NLEV+1) = EXNER(#,1 TO NLEV+1) CONVEC3C.2265
C WORK2(1,NLEV+2) = TH(#,1) CONVEC3C.2266
C WORK2(1,NLEV+3) = PSTAR(#) CONVEC3C.2267
C---------------------------------------------------------------------- CONVEC3C.2268
C CONVEC3C.2269
IF (NCNLV .NE. 0)THEN CONVEC3C.2270
C CONVEC3C.2271
CALL COR_ENGY (NP_FIELD,NPNTS,NCNLV,NLEV,DTHBYDT,DQBYDT,SNOW, CONVEC3C.2272
* EXNER,PSTAR,DELAK,DELBK,AKM12,BKM12,INDEX4) CONVEC3C.2273
CL CONVEC3C.2274
IF (L_3D_CCA) THEN CONVEC3C.2275
CALL CALC_3D_CCA(NP_FIELD,NPNTS,NLEV,NBL,ANVIL_FACTOR ADR1F405.34
& ,TOWER_FACTOR,AKM12,BKM12,ICCB,ICCT ADR1F405.35
& ,FREEZE_LEV,PSTAR,CCA_2D,CCA,L_CLOUD_DEEP) ADR1F405.36
ELSE ADR1F405.37
DO I=1,NPNTS ADR1F405.38
CCA(I,1)=CCA_2D(I) ADR1F405.39
ENDDO ADR1F405.40
ENDIF CONVEC3C.2279
CL--------------------------------------------------------------------- CONVEC3C.2280
CL UPDATE MODEL POTENTIAL TEMPERATURE, MIXING RATIO, U, V CONVEC3C.2281
CL AND TRACER WITH INCREMENTS DUE TO CONVECTION CONVEC3C.2282
CL--------------------------------------------------------------------- CONVEC3C.2283
CL CONVEC3C.2284
DO 250 K=1,NLEV CONVEC3C.2285
DO 250 I=1,NPNTS CONVEC3C.2286
TH(I,K) = TH(I,K) + DTHBYDT(I,K) * TIMESTEP CONVEC3C.2287
Q(I,K) = Q(I,K) + DQBYDT(I,K) * TIMESTEP CONVEC3C.2288
C CONVEC3C.2289
C--------------------------------------------------------------------- CONVEC3C.2290
C Calculation of gridbox mean CCW and CCWP, and CCA x conv. cloud CONVEC3C.2291
C base and top pressure. CONVEC3C.2292
C--------------------------------------------------------------------- CONVEC3C.2293
C CONVEC3C.2294
IF (CCA_2D(I) .NE. 0.0) THEN CONVEC3C.2295
IF (L_3D_CCA) THEN CONVEC3C.2296
GBMCCW(I,K) = CCA(I,K) * CCW(I,K) CONVEC3C.2297
DELPK(I) = -DELAK(K) - DELBK(K)*PSTAR(I) AJX4F405.9
GBMCCWP(I) = GBMCCWP(I) + CCW(I,K)*DELPK(I)*CCA(I,K)/G AJX4F405.10
IF (K.EQ.NLEV) THEN CONVEC3C.2299
ICCBPxCCA(I) = CCA(I,ICCB(I)) * CONVEC3C.2300
* (AK(ICCB(I)) + BK(ICCB(I)) * PSTAR(I)) CONVEC3C.2301
ICCTPxCCA(I) = CCA(I,ICCT(I)-1) * CONVEC3C.2302
* (AK(ICCT(I)) + BK(ICCT(I)) * PSTAR(I)) CONVEC3C.2303
ENDIF CONVEC3C.2304
ELSE CONVEC3C.2305
GBMCCW(I,K) = CCA_2D(I) * CCW(I,K) CONVEC3C.2306
IF (K.EQ.NLEV) THEN CONVEC3C.2307
GBMCCWP(I) = CCA_2D(I) * CCLWP(I) CONVEC3C.2308
ICCBPxCCA(I) = CCA_2D(I) * CONVEC3C.2309
* (AK(ICCB(I)) + BK(ICCB(I)) * PSTAR(I)) CONVEC3C.2310
ICCTPxCCA(I) = CCA_2D(I) * CONVEC3C.2311
* (AK(ICCT(I)) + BK(ICCT(I)) * PSTAR(I)) CONVEC3C.2312
END IF CONVEC3C.2313
ENDIF CONVEC3C.2314
ENDIF CONVEC3C.2319
250 CONTINUE CONVEC3C.2320
C CONVEC3C.2321
IF(L_TRACER)THEN CONVEC3C.2322
C CONVEC3C.2323
! CONVEC3C.2324
! BEFORE UPDATING THE TRACER FIELD, ADJUST THE TIMESTEP TO CONVEC3C.2325
! PREVENT ANY NEGATIVE VALUES INVADING THE TRACER FIELDS. CONVEC3C.2326
! NOTE THAT THE ADJUSTED TIMESTEP IS A FUNCTION OF GEOGRAPHICAL CONVEC3C.2327
! LOCATION AND THE PARTICULAR TRACER. CONVEC3C.2328
! CONVEC3C.2329
DO KTRA=1,NTRA CONVEC3C.2330
! CONVEC3C.2331
DO I=1,NPNTS CONVEC3C.2332
! CONVEC3C.2333
DO K=1,NLEV CONVEC3C.2334
! CONVEC3C.2335
STEP_TEST2(K) = DTRABYDT(I,K,KTRA) CONVEC3C.2336
STEP_TEST1(K) = ( 0.9999*ABS(TRACER(I,K,KTRA)) ) / CONVEC3C.2337
& ( ABS(STEP_TEST2(K)) + SAFETY_MARGIN ) CONVEC3C.2338
! CONVEC3C.2339
END DO ! END OF LEVEL (K) LOOP. CONVEC3C.2340
! CONVEC3C.2341
*IF DEF,CRAY,AND,-DEF,T3D CONVEC3C.2342
! Now use CRAY MINVAL function. Note: CONVEC3C.2343
! (a) It must be declared as an INTRINSIC function. CONVEC3C.2344
! (b) If there are no levels at which rate of change is negative CONVEC3C.2345
! (unlikely) MINVAL generates a huge number. The following CONVEC3C.2346
! statement then replaces that by the base value of the tstep. CONVEC3C.2347
! CONVEC3C.2348
LIMITED_STEP(I) = MINVAL(STEP_TEST1,1,STEP_TEST2.LT.0.0) CONVEC3C.2349
IF (LIMITED_STEP(I) .GT. TIMESTEP) THEN CONVEC3C.2350
LIMITED_STEP(I) = TIMESTEP CONVEC3C.2351
ENDIF CONVEC3C.2352
! CONVEC3C.2353
*ELSE CONVEC3C.2354
! CONVEC3C.2355
! The following fragment of code provides a standard Fortran CONVEC3C.2356
! alternative to the use of the Cray MINVAL function. CONVEC3C.2357
! CONVEC3C.2358
LIMITED_STEP(I) = TIMESTEP CONVEC3C.2359
DO K = 1,NLEV CONVEC3C.2360
IF( STEP_TEST2(K) .LT. 0.0 ) THEN CONVEC3C.2361
IF ( STEP_TEST1(K) .LT. LIMITED_STEP(I) ) THEN CONVEC3C.2362
LIMITED_STEP(I) = STEP_TEST1(K) CONVEC3C.2363
ENDIF CONVEC3C.2364
ENDIF CONVEC3C.2365
END DO CONVEC3C.2366
! CONVEC3C.2367
! End of alternative to MINVAL. CONVEC3C.2368
! CONVEC3C.2369
*ENDIF CONVEC3C.2370
! CONVEC3C.2371
! Diagnose the factor by which the tstep has been multiplied CONVEC3C.2372
! CONVEC3C.2373
REDUCTION_FACTOR(I,KTRA) = LIMITED_STEP(I)/TIMESTEP CONVEC3C.2374
! CONVEC3C.2375
END DO ! END OF LOCATION (I) LOOP. CONVEC3C.2376
! CONVEC3C.2377
! Now update tracer field using LIMITED STEP. CONVEC3C.2378
! We can reverse order of I and K loop now. CONVEC3C.2379
! CONVEC3C.2380
DO K=1,NLEV CONVEC3C.2381
DO I=1,NPNTS CONVEC3C.2382
TRACER(I,K,KTRA) = TRACER(I,K,KTRA) + DTRABYDT(I,K,KTRA) CONVEC3C.2383
& * LIMITED_STEP(I) CONVEC3C.2384
END DO CONVEC3C.2385
END DO CONVEC3C.2386
! CONVEC3C.2387
END DO ! END OF LOOP OVER TRACER TYPES (KTRA). CONVEC3C.2388
! CONVEC3C.2389
C CONVEC3C.2390
END IF CONVEC3C.2391
C CONVEC3C.2392
END IF CONVEC3C.2393
C CONVEC3C.2394
RETURN CONVEC3C.2395
END CONVEC3C.2396
C CONVEC3C.2397
*ENDIF CONVEC3C.2398