SUBROUTINE DDRAUGHT (NPNTS,NP_FULL,K,KCT,THDD_K,QDD_K,THE_K, 4,21DDRAUG3C.53
& THE_KM1,QE_K,QE_KM1,DTHBYDT_K,DTHBYDT_KM1, DDRAUG3C.54
& DQBYDT_K,DQBYDT_KM1,FLX_DD_K,P_KM1,DELPK, DDRAUG3C.55
& DELPKM1,EXK,EXKM1,DELTD,DELQD,AMDETK,EKM14, DDRAUG3C.56
& EKM34,RAIN,SNOW,BDD_START,BDDWT_K,BDDWT_KM1, DDRAUG3C.57
& BDD_ON,B_DD_END,CCA,L_MOM,UDD_K,VDD_K, DDRAUG3C.58
& UE_K,VE_K,UE_KM1,VE_KM1,DUBYDT_K,DUBYDT_KM1, DDRAUG3C.59
& DVBYDT_K,DVBYDT_KM1,DELUD,DELVD,EFLUX_U_DD, DDRAUG3C.60
& EFLUX_V_DD,L_TRACER, DDRAUG3C.61
& NTRA,TRADD_K,TRAE_K,TRAE_KM1,DTRABYDT_K, DDRAUG3C.62
& DTRABYDT_KM1,DELTRAD) DDRAUG3C.63
C DDRAUG3C.64
IMPLICIT NONE DDRAUG3C.65
C DDRAUG3C.66
C----------------------------------------------------------------------- DDRAUG3C.67
C MODEL CONSTANTS DDRAUG3C.68
C----------------------------------------------------------------------- DDRAUG3C.69
C DDRAUG3C.70
*CALL C_0_DG_C 
DDRAUG3C.71
*CALL DDKMDET DDRAUG3C.72
C DDRAUG3C.73
C----------------------------------------------------------------------- DDRAUG3C.74
C VECTOR LENGTHS AND LOOP COUNTERS DDRAUG3C.75
C----------------------------------------------------------------------- DDRAUG3C.76
C DDRAUG3C.77
C DDRAUG3C.81
INTEGER I,KTRA ! LOOP COUNTERS DDRAUG3C.82
C DDRAUG3C.83
INTEGER NPNTS ! IN NUMBER OF POINTS DDRAUG3C.84
C DDRAUG3C.85
INTEGER NP_FULL ! IN FULL VECTOR LENGTH DDRAUG3C.86
C DDRAUG3C.87
INTEGER NTRA ! NUMBER OF TRACERS DDRAUG3C.88
C DDRAUG3C.89
INTEGER K ! IN PRESENT MODEL LAYER DDRAUG3C.90
C DDRAUG3C.91
C----------------------------------------------------------------------- DDRAUG3C.92
C VARIABLES WHICH ARE INPUT DDRAUG3C.93
C----------------------------------------------------------------------- DDRAUG3C.94
C DDRAUG3C.95
INTEGER KCT ! IN CONVECTIVE CLOUD TOP DDRAUG3C.96
C DDRAUG3C.97
REAL THE_KM1(NPNTS) ! IN POTENTIAL TEMPERATURE OF DDRAUG3C.98
! ENVIRONMENT IN LAYER K-1 (K) DDRAUG3C.99
C DDRAUG3C.100
REAL QE_KM1(NPNTS) ! IN MIXING RATIO OF ENVIRONMENT IN DDRAUG3C.101
! LAYER K-1 (KG/KG) DDRAUG3C.102
C DDRAUG3C.103
REAL UE_KM1(NPNTS) ! IN U OF ENVIRONMENT IN LAYER K-1 DDRAUG3C.104
! (M/S) DDRAUG3C.105
C DDRAUG3C.106
REAL VE_KM1(NPNTS) ! IN V OF ENVIRONMENT IN LAYER K-1 DDRAUG3C.107
! (M/S) DDRAUG3C.108
C DDRAUG3C.109
REAL TRAE_KM1(NP_FULL,NTRA) ! IN TRACER CONTENT OF ENVIRONMENT DDRAUG3C.110
! IN LAYER K-1 (KG/KG) DDRAUG3C.111
C DDRAUG3C.112
REAL P_KM1(NPNTS) ! IN PRESSURE OF LAYER K-1 (PA) DDRAUG3C.113
C DDRAUG3C.114
REAL DELPK(NPNTS) ! IN CHANGE IN PRESSURE ACROSS DDRAUG3C.115
! LAYER K (PA) DDRAUG3C.116
C DDRAUG3C.117
REAL DELPKM1(NPNTS) ! IN CHANGE IN PRESSURE ACROSS DDRAUG3C.118
! LAYER K-1 (PA) DDRAUG3C.119
C DDRAUG3C.120
REAL EXK(NPNTS) ! IN EXNER RATIO IN LAYER K DDRAUG3C.121
C DDRAUG3C.122
REAL EXKM1(NPNTS) ! IN EXNER RATIO IN LAYER K-1 DDRAUG3C.123
C DDRAUG3C.124
REAL AMDETK(NPNTS) ! IN MIXING DETRAINMENT RATE DDRAUG3C.125
C DDRAUG3C.126
REAL EKM14(NPNTS) ! IN EXNER RATIO AT LAYER K-1/4 DDRAUG3C.127
C DDRAUG3C.128
REAL EKM34(NPNTS) ! IN EXNER RATIO AT LAYER K-3/4 DDRAUG3C.129
C DDRAUG3C.130
REAL DELTD(NPNTS) ! IN COOLING NECESSARY TO ACHIEVE DDRAUG3C.131
! SATURATION (K) DDRAUG3C.132
C DDRAUG3C.133
REAL DELQD(NPNTS) ! IN MOISTENING NECESSARY TO ACHIEVE DDRAUG3C.134
! SATURATION (KG/KG) DDRAUG3C.135
C DDRAUG3C.136
REAL DELUD(NPNTS) ! IN CHANGE TO ENVIRONMENT U DUE TO DDRAUG3C.137
! DOWNDRAUGHT FORMATION (M/S) DDRAUG3C.138
C DDRAUG3C.139
REAL DELVD(NPNTS) ! IN CHANGE TO ENVIRONMENT V DUE TO DDRAUG3C.140
! DOWNDRAUGHT FORMATION (M/S) DDRAUG3C.141
C DDRAUG3C.142
REAL DELTRAD(NP_FULL,NTRA) ! IN DEPLETION OF ENV. TRACER DUE DDRAUG3C.143
! TO DOWNDRAUGHT FORMATION DDRAUG3C.144
C DDRAUG3C.145
LOGICAL BDDWT_K(NPNTS) ! IN MASK FOR THOSE POINTS IN DDRAUG3C.146
! DOWNDRAUGHT WHERE PRECIPITATION DDRAUG3C.147
! IS LIQUID IN LAYER K DDRAUG3C.148
C DDRAUG3C.149
LOGICAL BDDWT_KM1(NPNTS) ! IN MASK FOR THOSE POINTS IN DDRAUG3C.150
! DOWNDRAUGHT WHERE PRECIPITATION DDRAUG3C.151
! IS LIQUID IN LAYER K-1 DDRAUG3C.152
C DDRAUG3C.153
LOGICAL L_TRACER ! IN SWITCH FOR INCLUSION OF TRACERS DDRAUG3C.154
C DDRAUG3C.155
LOGICAL L_MOM ! IN SWITCH FOR INCLUSION DDRAUG3C.156
! OF MOMENTUM TRANSPORTS DDRAUG3C.157
C DDRAUG3C.158
REAL CCA(NPNTS) ! IN CONVECTIVE CLOUD AMOUNT DDRAUG3C.159
C DDRAUG3C.160
C----------------------------------------------------------------------- DDRAUG3C.161
C VARIABLES WHICH ARE INPUT AND OUTPUT DDRAUG3C.162
C----------------------------------------------------------------------- DDRAUG3C.163
C DDRAUG3C.164
REAL THDD_K(NPNTS) ! INOUT DDRAUG3C.165
! IN POTENTIAL TEMPERATURE OF DDRAUG3C.166
! DOWNDRAUGHT IN LAYER K (K) DDRAUG3C.167
! OUT POTENTIAL TEMPERATURE RESET DDRAUG3C.168
! FOR NEXT LAYER (K) DDRAUG3C.169
C DDRAUG3C.170
REAL QDD_K(NPNTS) ! INOUT DDRAUG3C.171
! IN DOWNDRAUGHT MIXING RATIO OF DDRAUG3C.172
! LAYER K (KG/KG) DDRAUG3C.173
! OUT MIXING RATIO RESET FOR NEXT DDRAUG3C.174
! LAYER (KG/KG) DDRAUG3C.175
C DDRAUG3C.176
REAL UDD_K(NPNTS) ! INOUT DDRAUG3C.177
! IN DOWNDRAUGHT U IN LAYER K DDRAUG3C.178
! (M/S) DDRAUG3C.179
! OUT U RESET FOR NEXT LAYER (M/S) DDRAUG3C.180
C DDRAUG3C.181
REAL VDD_K(NPNTS) ! INOUT DDRAUG3C.182
! IN DOWNDRAUGHT V IN LAYER K DDRAUG3C.183
! (M/S) DDRAUG3C.184
! OUT V RESET FOR NEXT LAYER (M/S) DDRAUG3C.185
C DDRAUG3C.186
REAL TRADD_K(NP_FULL,NTRA) ! INOUT DDRAUG3C.187
! IN DOWNDRAUGHT TRACER CONTENT OF DDRAUG3C.188
! LAYER K (KG/KG) DDRAUG3C.189
! OUT TRACER CONTENT RESET FOR NEXT DDRAUG3C.190
! LAYER (KG/KG) DDRAUG3C.191
C DDRAUG3C.192
REAL THE_K(NPNTS) ! INOUT DDRAUG3C.193
! IN POTENTIAL TEMPERATURE OF DDRAUG3C.194
! ENVIRONMENT IN LAYER K (K) DDRAUG3C.195
! OUT ENVIRONMENT POTENTIAL DDRAUG3C.196
! TEMPERATURE RESET FOR NEXT DDRAUG3C.197
! LAYER (K) DDRAUG3C.198
C DDRAUG3C.199
REAL QE_K(NPNTS) ! INOUT DDRAUG3C.200
! IN MIXING RATIO OF ENVIRONMENT DDRAUG3C.201
! LAYER K (KG/KG) DDRAUG3C.202
! OUT ENVIRONMENT MIXING RATIO DDRAUG3C.203
! RESET FOR NEXT LAYER (KG/KG) DDRAUG3C.204
C DDRAUG3C.205
REAL UE_K(NPNTS) ! INOUT DDRAUG3C.206
! IN U OF ENVIRONMENT IN LAYER K DDRAUG3C.207
! (M/S) DDRAUG3C.208
! OUT ENVIRONMENT U RESET FOR DDRAUG3C.209
! NEXT LAYER (M/S) DDRAUG3C.210
C DDRAUG3C.211
REAL VE_K(NPNTS) ! INOUT DDRAUG3C.212
! IN V OF ENVIRONMENT IN LAYER K DDRAUG3C.213
! (M/S) DDRAUG3C.214
! OUT ENVIRONMENT V RESET FOR DDRAUG3C.215
! NEXT LAYER (M/S) DDRAUG3C.216
C DDRAUG3C.217
REAL TRAE_K(NP_FULL,NTRA) ! INOUT DDRAUG3C.218
! IN TRACER CONTENT OF ENVIRONMENT DDRAUG3C.219
! IN LAYER K (KG/KG) DDRAUG3C.220
! OUT ENVIRONMENT TRACER CONTENT DDRAUG3C.221
! RESET FOR NEXT LAYER (KG/KG) DDRAUG3C.222
C DDRAUG3C.223
REAL FLX_DD_K(NPNTS) ! INOUT DDRAUG3C.224
! IN DOWNDRAUGHT MASS FLUX OF DDRAUG3C.225
! LAYER K (PA/S) DDRAUG3C.226
! OUT DOWNDRAUGHT MASS FLUX RESET DDRAUG3C.227
! FOR NEXT LAYER (PA/S) DDRAUG3C.228
C DDRAUG3C.229
REAL RAIN(NPNTS) ! INOUT DDRAUG3C.230
! IN AMOUNT OF RAIN (KG/M**2/S) DDRAUG3C.231
! OUT UPDATED RAINFALL (KG/M**2/S) DDRAUG3C.232
C DDRAUG3C.233
REAL SNOW(NPNTS) ! INOUT DDRAUG3C.234
! IN AMOUNT OF SNOW(KG/M**2/S) DDRAUG3C.235
! OUT UPDATED SNOWFALL (KG/M**2/S) DDRAUG3C.236
C DDRAUG3C.237
REAL DTHBYDT_K(NPNTS) ! INOUT DDRAUG3C.238
! IN INCREMENT TO MODEL POTENTIAL DDRAUG3C.239
! TEMPERATURE OF LAYER K (K/S) DDRAUG3C.240
! OUT UPDATED INCREMENT TO MODEL DDRAUG3C.241
! POTENTIAL TEMPERATURE IN DDRAUG3C.242
! LAYER K (K/S) DDRAUG3C.243
C DDRAUG3C.244
REAL DTHBYDT_KM1(NPNTS) ! INOUT DDRAUG3C.245
! IN INCREMENT TO MODEL POTENTIAL DDRAUG3C.246
! TEMPERATURE IN LAYER K-1 (K/S) DDRAUG3C.247
! OUT UPDATED INCREMENT TO MODEL DDRAUG3C.248
! POTENTIAL TEMPERATURE IN DDRAUG3C.249
! LAYER K-1 (K/S) DDRAUG3C.250
C DDRAUG3C.251
REAL DQBYDT_K(NPNTS) ! INOUT DDRAUG3C.252
! IN INCREMENT TO MODEL MIXING DDRAUG3C.253
! RATIO IN LAYER K (KG/KG/S) DDRAUG3C.254
! OUT UPDATED INCREMENT TO MODEL DDRAUG3C.255
! MIXING RATIO IN LAYER K DDRAUG3C.256
! (KG/KG/S) DDRAUG3C.257
C DDRAUG3C.258
REAL DQBYDT_KM1(NPNTS) ! INOUT DDRAUG3C.259
! IN INCREMENT TO MODEL MIXING DDRAUG3C.260
! RATIO IN LAYER K-1 (KG/KG/S) DDRAUG3C.261
! OUT UPDATED INCREMENT TO MODEL DDRAUG3C.262
! MIXING RATIO IN LAYER K-1 DDRAUG3C.263
! (KG/KG/S) DDRAUG3C.264
C DDRAUG3C.265
REAL DUBYDT_K(NPNTS) ! INOUT DDRAUG3C.266
! IN INCREMENT TO MODEL U IN DDRAUG3C.267
! LAYER K (M/S**2) DDRAUG3C.268
! OUT UPDATED INCREMENT TO MODEL DDRAUG3C.269
! U IN LAYER K (M/S**2) DDRAUG3C.270
C DDRAUG3C.271
REAL DUBYDT_KM1(NPNTS) ! INOUT DDRAUG3C.272
! IN INCREMENT TO MODEL U IN DDRAUG3C.273
! LAYER K-1 (M/S**2) DDRAUG3C.274
! OUT UPDATED INCREMENT TO MODEL DDRAUG3C.275
! U IN LAYER K-1 (M/S**2) DDRAUG3C.276
C DDRAUG3C.277
REAL DVBYDT_K(NPNTS) ! INOUT DDRAUG3C.278
! IN INCREMENT TO MODEL V IN DDRAUG3C.279
! LAYER K (M/S**2) DDRAUG3C.280
! OUT UPDATED INCREMENT TO MODEL DDRAUG3C.281
! V IN LAYER K (M/S**2) DDRAUG3C.282
C DDRAUG3C.283
REAL DVBYDT_KM1(NPNTS) ! INOUT DDRAUG3C.284
! IN INCREMENT TO MODEL V IN DDRAUG3C.285
! LAYER K-1 (M/S**2) DDRAUG3C.286
! OUT UPDATED INCREMENT TO MODEL DDRAUG3C.287
! V IN LAYER K-1 (M/S**2) DDRAUG3C.288
C DDRAUG3C.289
REAL DTRABYDT_K(NP_FULL,NTRA) ! INOUT DDRAUG3C.290
! IN INCREMENT TO MODEL TRACER DDRAUG3C.291
! CONTENTOF LAYER K (KG/KG/S) DDRAUG3C.292
! OUT UPDATED INCREMENT TO MODEL DDRAUG3C.293
! TRACER CONTENT IN LAYER K DDRAUG3C.294
! (KG/KG/S) DDRAUG3C.295
C DDRAUG3C.296
REAL DTRABYDT_KM1(NP_FULL, ! INOUT DDRAUG3C.297
* NTRA) ! IN INCREMENT TO MODEL TRACER DDRAUG3C.298
! CONTENT IN LAYER K-1 DDRAUG3C.299
! (KG/KG/S) DDRAUG3C.300
! OUT UPDATED INCREMENT TO MODEL DDRAUG3C.301
! TRACER CONTENT IN LAYER K-1 DDRAUG3C.302
! (KG/KG/S) DDRAUG3C.303
C DDRAUG3C.304
LOGICAL BDD_ON(NPNTS) ! INOUT DDRAUG3C.305
! IN MASK FOR THOSE POINTS WHERE DD DDRAUG3C.306
! HAS CONTINUED FROM LAYER K+1 DDRAUG3C.307
! OUT MASK FOR THOSE POINTS WHERE DD DDRAUG3C.308
! CONTINUES TO LAYER K-1 DDRAUG3C.309
C DDRAUG3C.310
REAL EFLUX_U_DD(NPNTS), ! INOUT DDRAUG3C.311
* EFLUX_V_DD(NPNTS) ! IN EDDY FLUX OF MOMENTUM DUE TO DDRAUG3C.312
! DD AT TOP OF A LAYER DDRAUG3C.313
! OUT EDDY FLUX OF MOMENTUM DUE TO DDRAUG3C.314
! DD AT BOTTOM OF A LAYER DDRAUG3C.315
C DDRAUG3C.316
C----------------------------------------------------------------------- DDRAUG3C.317
C VARIABLES WHICH ARE OUTPUT DDRAUG3C.318
C----------------------------------------------------------------------- DDRAUG3C.319
C DDRAUG3C.320
LOGICAL BDD_START(NPNTS) ! OUT MASK FOR THOSE POINTS WHERE DDRAUG3C.321
! DOWNDRAUGHT MAY START IN DDRAUG3C.322
! LAYER K-1 DDRAUG3C.323
C DDRAUG3C.324
LOGICAL B_DD_END(NPNTS) ! OUT MASK FOR THOSE POINTS WHERE DDRAUG3C.325
! DOWNDRAUGHT IS ENDING IN DDRAUG3C.326
! LAYER K-1 DDRAUG3C.327
C DDRAUG3C.328
C----------------------------------------------------------------------- DDRAUG3C.329
C VARIABLES WHICH ARE DEFINED LOCALLY DDRAUG3C.330
C----------------------------------------------------------------------- DDRAUG3C.331
C DDRAUG3C.332
C DDRAUG3C.368
REAL THDD_KM1(NPNTS) ! POTENTIAL TEMPERATURE OF DDRAUG3C.369
! DOWNDRAUGHT IN LAYER K-1 (K) DDRAUG3C.370
C DDRAUG3C.371
REAL QDD_KM1(NPNTS) ! DOWNDRAUGHT MIXING RATIO OF DDRAUG3C.372
! LAYER K-1 (KG/KG) DDRAUG3C.373
C DDRAUG3C.374
REAL UDD_KM1(NPNTS) ! DOWNDRAUGHT U IN LAYER K-1 (M/S) DDRAUG3C.375
C DDRAUG3C.376
REAL VDD_KM1(NPNTS) ! DOWNDRAUGHT V IN LAYER K-1 (M/S) DDRAUG3C.377
C DDRAUG3C.378
REAL TRADD_KM1(NPNTS,NTRA) ! TRACER CONTENT OF DOWNDRAUGHT DDRAUG3C.379
! IN LAYER K-1 (KG/KG) DDRAUG3C.380
C DDRAUG3C.381
REAL QSATDD(NPNTS) ! SATURATED DOWNDRAUGHT MIXING DDRAUG3C.382
! RATIO (KG/KG) DDRAUG3C.383
C DDRAUG3C.384
REAL TDD_KM1(NPNTS) ! TEMPERATURE OF DOWNDRAUGHT DDRAUG3C.385
! IN LAYER K-1 (K) DDRAUG3C.386
C DDRAUG3C.387
REAL THDDS(NPNTS) ! POTENTIAL TEMPERATURE OF DDRAUG3C.388
! SATURATED DOWNDRAUGHT (K) DDRAUG3C.389
C DDRAUG3C.390
REAL QDDS(NPNTS) ! SATURATED DOWNDRAUGHT MIXING DDRAUG3C.391
! RATIO (KG/KG) DDRAUG3C.392
C DDRAUG3C.393
REAL FLX_DD_KM1(NPNTS) ! DOWNDRAUGHT MASS FLUX IN DDRAUG3C.394
! LAYER K-1 (PA/S) DDRAUG3C.395
C DDRAUG3C.396
REAL RAIN_TMP(NPNTS) ! LIQUID PRECIPITATION STORE DDRAUG3C.397
C DDRAUG3C.398
REAL SNOW_TMP(NPNTS) ! SNOW STORE DDRAUG3C.399
C DDRAUG3C.400
C DDRAUG3C.402
C----------------------------------------------------------------------- DDRAUG3C.403
C EXTERNAL ROUTINES CALLED DDRAUG3C.404
C----------------------------------------------------------------------- DDRAUG3C.405
C DDRAUG3C.406
EXTERNAL SATCAL, CRS_FRZL, QSAT, DEVAP, TERMDD, DDRAUG3C.407
* DD_ENV, EVP DDRAUG3C.408
C DDRAUG3C.409
C----------------------------------------------------------------------- DDRAUG3C.410
C CALCULATE MASK FOR THOSE POINTS IN DOWNDRAUGHT WHERE PRECIPITATION DDRAUG3C.411
C IS LIQUID DDRAUG3C.412
C DDRAUG3C.413
C STORE PRECIPITATION IN LAYER K IN TEMPORARY VARIABLES DDRAUG3C.414
C----------------------------------------------------------------------- DDRAUG3C.415
C DDRAUG3C.416
DO I=1,NPNTS DDRAUG3C.417
IF (K .EQ. KCT+1 .OR. BDD_START(I)) THEN DDRAUG3C.418
BDDWT_K(I) = THDD_K(I)*EXK(I) .GT. TM DDRAUG3C.419
ELSE DDRAUG3C.420
BDDWT_K(I) = BDDWT_KM1(I) DDRAUG3C.421
END IF DDRAUG3C.422
RAIN_TMP(I) = RAIN(I) DDRAUG3C.423
SNOW_TMP(I) = SNOW(I) DDRAUG3C.424
C DDRAUG3C.425
C----------------------------------------------------------------------- DDRAUG3C.426
C DRY DESCENT FROM LAYER K TO K-1 DDRAUG3C.427
C DDRAUG3C.428
C ENTRAINMENT CALCULATION DDRAUG3C.429
C----------------------------------------------------------------------- DDRAUG3C.430
C DDRAUG3C.431
THDD_KM1(I) = (THDD_K(I)+(EKM14(I)*THE_K(I)) + DDRAUG3C.432
* (1.0+EKM14(I))*EKM34(I)*THE_KM1(I)) / DDRAUG3C.433
* ((1.0+EKM14(I))*(1.0+EKM34(I))) DDRAUG3C.434
QDD_KM1(I) = (QDD_K(I)+(EKM14(I)*QE_K(I)) + DDRAUG3C.435
* (1.0+EKM14(I))*EKM34(I)*QE_KM1(I))/ DDRAUG3C.436
* ((1.0+EKM14(I))*(1.0+EKM34(I))) DDRAUG3C.437
END DO DDRAUG3C.438
C DDRAUG3C.439
IF(L_MOM)THEN DDRAUG3C.440
DO I=1,NPNTS DDRAUG3C.441
C DDRAUG3C.442
UDD_KM1(I) = (UDD_K(I)+(EKM14(I)*UE_K(I)) + DDRAUG3C.443
* (1.0+EKM14(I))*EKM34(I)*UE_KM1(I))/ DDRAUG3C.444
* ((1.0+EKM14(I))*(1.0+EKM34(I))) DDRAUG3C.445
VDD_KM1(I) = (VDD_K(I)+(EKM14(I)*VE_K(I)) + DDRAUG3C.446
* (1.0+EKM14(I))*EKM34(I)*VE_KM1(I))/ DDRAUG3C.447
* ((1.0+EKM14(I))*(1.0+EKM34(I))) DDRAUG3C.448
C DDRAUG3C.449
C---------------------------------------------------------------------- DDRAUG3C.450
C ADD AN IN-CLOUD PRESSURE GRADIENT TERM TO THE MOMENTUM INCREMENTS DDRAUG3C.451
C---------------------------------------------------------------------- DDRAUG3C.452
C DDRAUG3C.453
UDD_KM1(I) = UDD_KM1(I) - (0.7*(UE_K(I)-UE_KM1(I))/ DDRAUG3C.454
* (1.0+EKM34(I))) DDRAUG3C.455
VDD_KM1(I) = VDD_KM1(I) - (0.7*(VE_K(I)-VE_KM1(I))/ DDRAUG3C.456
* (1.0+EKM34(I))) DDRAUG3C.457
END DO DDRAUG3C.458
END IF DDRAUG3C.459
C DDRAUG3C.460
C---------------------------------------------------------------------- DDRAUG3C.461
C DRY DESCENT FOR TRACERS DDRAUG3C.462
C---------------------------------------------------------------------- DDRAUG3C.463
C DDRAUG3C.464
IF(L_TRACER)THEN DDRAUG3C.465
C DDRAUG3C.466
DO KTRA=1,NTRA DDRAUG3C.467
DO I=1,NPNTS DDRAUG3C.468
C DDRAUG3C.469
TRADD_KM1(I,KTRA)=(TRADD_K(I,KTRA)+(EKM14(I)* DDRAUG3C.470
* TRAE_K(I,KTRA)) + DDRAUG3C.471
* (1.0+EKM14(I))*EKM34(I)*TRAE_KM1(I,KTRA))/ DDRAUG3C.472
* ((1.0+EKM14(I))*(1.0+EKM34(I))) DDRAUG3C.473
C DDRAUG3C.474
END DO DDRAUG3C.475
END DO DDRAUG3C.476
C DDRAUG3C.477
END IF DDRAUG3C.478
C----------------------------------------------------------------------- DDRAUG3C.479
C UPDATE MASS FLUX AND CALCULATE TEMPERATURE OF LAYER K-1 DDRAUG3C.480
C----------------------------------------------------------------------- DDRAUG3C.481
C DDRAUG3C.482
DO I=1,NPNTS DDRAUG3C.483
FLX_DD_KM1(I) = FLX_DD_K(I)*(1.0+EKM34(I))*(1.0+EKM14(I))* DDRAUG3C.484
* (1.0-AMDETK(I)) DDRAUG3C.485
C DDRAUG3C.486
TDD_KM1(I) = THDD_KM1(I)*EXKM1(I) DDRAUG3C.487
END DO DDRAUG3C.488
C DDRAUG3C.489
C----------------------------------------------------------------------- DDRAUG3C.490
C CALCULATE SUBSATURATION DDRAUG3C.491
C CALCULATE TEMPERATURE IF BROUGHT TO SATURATION DDRAUG3C.492
C----------------------------------------------------------------------- DDRAUG3C.493
C DDRAUG3C.494
CALL SATCAL(NPNTS,TDD_KM1,THDD_KM1,P_KM1,QDDS,THDDS, DDRAUG3C.495
& K,EXKM1,QDD_KM1,THE_KM1) DDRAUG3C.496
C DDRAUG3C.497
DO I=1,NPNTS DDRAUG3C.498
BDDWT_KM1(I) = THDDS(I)*EXKM1(I) .GT. TM DDRAUG3C.499
END DO DDRAUG3C.500
C DDRAUG3C.501
C----------------------------------------------------------------------- DDRAUG3C.502
C CALCULATE CHANGE OF PHASE DUE TO DOWNDRAUGHT SATURATION TEMPERATURE DDRAUG3C.503
C----------------------------------------------------------------------- DDRAUG3C.504
C DDRAUG3C.505
CALL CRS_FRZL (NPNTS,RAIN,SNOW,THDD_KM1,EXKM1,FLX_DD_KM1, DDRAUG3C.506
& BDDWT_KM1) DDRAUG3C.507
C DDRAUG3C.508
DO I=1,NPNTS DDRAUG3C.509
TDD_KM1(I) = THDD_KM1(I)*EXKM1(I) DDRAUG3C.510
END DO DDRAUG3C.511
C DDRAUG3C.512
C----------------------------------------------------------------------- DDRAUG3C.513
C RECALCULATE SUBSATURATION TEMPERATURE DDRAUG3C.514
C----------------------------------------------------------------------- DDRAUG3C.515
C DDRAUG3C.516
CALL SATCAL(NPNTS,TDD_KM1,THDD_KM1,P_KM1,QDDS,THDDS, DDRAUG3C.517
& K,EXKM1,QDD_KM1,THE_KM1) DDRAUG3C.518
C DDRAUG3C.519
C----------------------------------------------------------------------- DDRAUG3C.520
C CALCULATE MOISTURE SUBSATURATION DDRAUG3C.521
C----------------------------------------------------------------------- DDRAUG3C.522
C DDRAUG3C.523
CALL QSAT(QSATDD,TDD_KM1,P_KM1,NPNTS) DDRAUG3C.524
C DDRAUG3C.525
C----------------------------------------------------------------------- DDRAUG3C.526
C EVAPORATION CALCULATION AND ADJUSTMENT OF DOWNDRAUGHT TEMPERATURE DDRAUG3C.527
C AND MOISTURE DDRAUG3C.528
C----------------------------------------------------------------------- DDRAUG3C.529
C DDRAUG3C.530
CALL DEVAP (NPNTS,THDD_K,THDD_KM1,QDD_KM1,THDDS,QDDS, DDRAUG3C.531
& FLX_DD_KM1,EXK,EXKM1,QSATDD,RAIN,SNOW, DDRAUG3C.532
& DELPKM1,BDDWT_KM1,CCA,P_KM1) DDRAUG3C.533
C DDRAUG3C.534
C----------------------------------------------------------------------- DDRAUG3C.535
C CHECK IF PARCEL STILL NEGATIVELY BUOYANT SUCH THAT DOWNDRAUGHT CAN DDRAUG3C.536
C CONTINUE TO K-1 DDRAUG3C.537
C----------------------------------------------------------------------- DDRAUG3C.538
C DDRAUG3C.539
CALL TERMDD (NPNTS,BDD_START,THDD_KM1,QDD_KM1,THE_KM1, DDRAUG3C.540
& QE_KM1,K,B_DD_END,BDD_ON) DDRAUG3C.541
C DDRAUG3C.542
C----------------------------------------------------------------------- DDRAUG3C.543
C CALCULATE THE EFFECT ON THE ENVIRONMENT IN LAYER K DDRAUG3C.544
C----------------------------------------------------------------------- DDRAUG3C.545
C DDRAUG3C.546
CALL DD_ENV (NPNTS,NP_FULL,THDD_K,THDD_KM1,QDD_K,QDD_KM1,THE_K, DDRAUG3C.547
& THE_KM1,QE_K,QE_KM1,DTHBYDT_K,DTHBYDT_KM1,DQBYDT_K, DDRAUG3C.548
& DQBYDT_KM1,FLX_DD_K,FLX_DD_KM1,DELPK,DELPKM1, DDRAUG3C.549
& DELTD,DELQD,AMDETK,EKM14,B_DD_END,BDD_START,BDD_ON, DDRAUG3C.550
& L_MOM,UDD_K,VDD_K,UDD_KM1,VDD_KM1,UE_K,VE_K,UE_KM1, DDRAUG3C.551
& VE_KM1,DUBYDT_K,DUBYDT_KM1,DVBYDT_K,DVBYDT_KM1, DDRAUG3C.552
& DELUD,DELVD,EFLUX_U_DD,EFLUX_V_DD, DDRAUG3C.553
& L_TRACER,NTRA,TRADD_K,TRADD_KM1,TRAE_K, DDRAUG3C.554
& TRAE_KM1,DTRABYDT_K,DTRABYDT_KM1,DELTRAD) DDRAUG3C.555
C DDRAUG3C.556
C----------------------------------------------------------------------- DDRAUG3C.557
C RESET DOWNDRAUGHT BIT VECTORS DDRAUG3C.558
C DDRAUG3C.559
C----------------------------------------------------------------------- DDRAUG3C.560
C DDRAUG3C.561
DO I=1,NPNTS DDRAUG3C.562
BDD_START(I) = .FALSE. DDRAUG3C.563
IF (.NOT. BDD_ON(I)) THEN DDRAUG3C.564
RAIN(I) = RAIN_TMP(I) DDRAUG3C.565
SNOW(I) = SNOW_TMP(I) DDRAUG3C.566
END IF DDRAUG3C.567
IF (B_DD_END(I)) BDD_ON(I) = .FALSE. DDRAUG3C.568
END DO DDRAUG3C.569
C DDRAUG3C.570
C----------------------------------------------------------------------- DDRAUG3C.571
C SWITCH POTENTIAL TEMPERATURE, MIXING RATIO, MOMENTUM, MASS FLUX DDRAUG3C.572
C AND TRACER READY FOR CALCULATION AT NEXT MODEL LAYER DDRAUG3C.573
C----------------------------------------------------------------------- DDRAUG3C.574
C DDRAUG3C.575
IF (K.GT.2) THEN DDRAUG3C.576
DO I=1,NPNTS DDRAUG3C.577
IF (BDD_ON(I)) THEN DDRAUG3C.578
THDD_K(I) = THDD_KM1(I) DDRAUG3C.579
QDD_K(I) = QDD_KM1(I) DDRAUG3C.580
FLX_DD_K(I) = FLX_DD_KM1(I) DDRAUG3C.581
END IF DDRAUG3C.582
END DO DDRAUG3C.583
C DDRAUG3C.584
IF(L_MOM)THEN DDRAUG3C.585
DO I=1,NPNTS DDRAUG3C.586
IF(BDD_ON(I))THEN DDRAUG3C.587
UDD_K(I) = UDD_KM1(I) DDRAUG3C.588
VDD_K(I) = VDD_KM1(I) DDRAUG3C.589
END IF DDRAUG3C.590
END DO DDRAUG3C.591
END IF DDRAUG3C.592
C DDRAUG3C.593
IF(L_TRACER)THEN DDRAUG3C.594
C DDRAUG3C.595
DO KTRA=1,NTRA DDRAUG3C.596
DO I=1,NPNTS DDRAUG3C.597
IF(BDD_ON(I))THEN DDRAUG3C.598
TRADD_K(I,KTRA) = TRADD_KM1(I,KTRA) DDRAUG3C.599
END IF DDRAUG3C.600
END DO DDRAUG3C.601
END DO DDRAUG3C.602
C DDRAUG3C.603
END IF DDRAUG3C.604
C DDRAUG3C.605
END IF DDRAUG3C.606
DDRAUG3C.607
RETURN DDRAUG3C.608
END DDRAUG3C.609
C DDRAUG3C.610
*ENDIF DDRAUG3C.611