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