*IF DEF,A05_2A AJX1F405.158
C ******************************COPYRIGHT****************************** GTS2F400.2269
C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved. GTS2F400.2270
C GTS2F400.2271
C Use, duplication or disclosure of this code is subject to the GTS2F400.2272
C restrictions as set forth in the contract. GTS2F400.2273
C GTS2F400.2274
C Meteorological Office GTS2F400.2275
C London Road GTS2F400.2276
C BRACKNELL GTS2F400.2277
C Berkshire UK GTS2F400.2278
C RG12 2SZ GTS2F400.2279
C GTS2F400.2280
C If no contract has been raised with this copy of the code, the use, GTS2F400.2281
C duplication or disclosure of it is strictly prohibited. Permission GTS2F400.2282
C to do so must first be obtained in writing from the Head of Numerical GTS2F400.2283
C Modelling at the above address. GTS2F400.2284
C ******************************COPYRIGHT****************************** GTS2F400.2285
C GTS2F400.2286
CLL SUBROUTINE DOWND-------------------------------------------------- DOWND2A.3
CLL DOWND2A.4
CLL PURPOSE : CALL DOWNDRAUGHT CALCULATION DOWND2A.5
CLL DOWND2A.6
CLL CHANGE OF PHASE CALCULATION WHERE NO DOWNDRAUGHT OCCURS DOWND2A.7
CLL DOWND2A.8
CLL SUITABLE FOR SINGLE COLUMN MODEL USE DOWND2A.9
CLL DOWND2A.10
CLL CODE WRITTEN FOR CRAY Y-MP BY S.BETT AND D.GREGORY AUTUMN 1991 DOWND2A.11
CLL DOWND2A.12
CLL MODEL MODIFICATION HISTORY FROM MODEL VERSION 3.0: DOWND2A.13
CLL VERSION DATE DOWND2A.14
CLL 3.3 23/12/93 : DG060893 : CORRECTION TO PREVENT OVER PREDICTION DG060893.36
CLL OF SNOW SHOWERS; CHANGE TO CALCULATION DG060893.37
CLL OF AMOUNT OF SNOW WHICH FALLS THROUGH DG060893.38
CLL THE DOWNDRAUGHT DG060893.39
CLL 4.2 Oct. 96 T3E migration: *DEF CRAY removed GSS1F402.97
CLL (was used to switch on WHENIMD) GSS1F402.98
CLL S.J.Swarbrick GSS1F402.99
!LL 4.2 7/11/96 : Tighter check on (rain_env + snow_env) to AYY1F402.1
!LL prevent occasional floating point exceptions. AYY1F402.2
!LL Andrew Bushell. AYY1F402.3
CLL 4.5 Jul. 98 Kill the IBM specific lines (JCThil) AJC1F405.11
CLL DG060893.40
CLL DOWND2A.15
CLL PROGRAMMING STANDARDS : UNIFIED MODEL DOCUMENTATION PAPER NO. 3 DOWND2A.16
CLL VERSION NO. 4 DATED 5/2/92 DOWND2A.17
CLL DOWND2A.18
CLL SYSTEM TASK : P27 DOWND2A.19
CLL DOWND2A.20
CLL DOCUMENTATION : UNIFIED MODEL DOCUMENTATION PAPER P27 DOWND2A.21
CLL DOWND2A.22
CLLEND----------------------------------------------------------------- DOWND2A.23
C DOWND2A.24
C*L ARGUMENTS--------------------------------------------------------- DOWND2A.25
C DOWND2A.26
SUBROUTINE DOWND (NPNTS,K,KCT,THDD_K,QDD_K,THE_K,THE_KM1,QE_K, 4,12DOWND2A.27
& QE_KM1,DTHBYDT_K,DTHBYDT_KM1,DQBYDT_K, DOWND2A.28
& DQBYDT_KM1,FLX_DD_K,P_KM1,DELPK,DELPKM1,EXK, DOWND2A.29
& EXKM1,DELTD,DELQD,AMDETK,EKM14,EKM34,PRECIP_K, DOWND2A.30
& RAIN,SNOW,ICCB,BWATER_K,BDD_START, DOWND2A.31
& BDDWT_K,BDDWT_KM1,BDD_ON,RAIN_ENV,SNOW_ENV, DOWND2A.32
& RAIN_DD,SNOW_DD,FLX_UD_K,TIMESTEP,CCA,NDDON_A, DG060893.41
& LR_UD_REF) DG060893.42
C DOWND2A.34
IMPLICIT NONE DOWND2A.35
C DOWND2A.36
C----------------------------------------------------------------------- DOWND2A.37
C MODEL CONSTANTS DOWND2A.38
C----------------------------------------------------------------------- DOWND2A.39
C DOWND2A.40
*CALL C_0_DG_C 
DOWND2A.41
*CALL C_G DG060893.43
C DOWND2A.42
C----------------------------------------------------------------------- DOWND2A.43
C VECTOR LENGTHS AND LOOP COUNTERS DOWND2A.44
C----------------------------------------------------------------------- DOWND2A.45
C DOWND2A.46
C DOWND2A.50
INTEGER I ! LOOP COUNTER DOWND2A.51
C DOWND2A.52
INTEGER K ! IN PRESENT MODEL LAYER DOWND2A.53
C DOWND2A.54
INTEGER NPNTS ! IN NUMBER OF POINTS DOWND2A.55
C DOWND2A.56
INTEGER NDDON,NDDON_A ! NUMBER OF POINTS AT WHICH DOWND2A.57
! DOWNDRAUGHT DOES OCCUR DOWND2A.58
C DOWND2A.59
C----------------------------------------------------------------------- DOWND2A.60
C VARIABLES WHICH ARE INPUT DOWND2A.61
C----------------------------------------------------------------------- DOWND2A.62
C DOWND2A.63
INTEGER KCT ! IN CONVECTIVE CLOUD TOP LAYER DOWND2A.64
C DOWND2A.65
REAL THDD_K(NPNTS) ! IN MODEL POTENTIAL TEMPERATURE DOWND2A.66
! OF DOWNDRAUGHT IN LAYER K (K) DOWND2A.67
C DOWND2A.68
REAL QDD_K(NPNTS) ! IN MIXING RATIO OF DOWNDRAUGHT IN DOWND2A.69
! LAYER K (KG/KG) DOWND2A.70
C DOWND2A.71
REAL THE_K(NPNTS) ! IN POTENTIAL TEMPERATURE OF DOWND2A.72
! ENVIRONMENT IN LAYER K (K) DOWND2A.73
C DOWND2A.74
REAL THE_KM1(NPNTS) ! IN POTENTIAL TEMPERATURE OF DOWND2A.75
! ENVIRONMENT IN LAYER K-1 (K) DOWND2A.76
C DOWND2A.77
REAL QE_K(NPNTS) ! IN MIXING RATIO OF ENVIRONMENT IN DOWND2A.78
! LAYER K (KG/KG) DOWND2A.79
C DOWND2A.80
REAL QE_KM1(NPNTS) ! IN MIXING RATIO OF ENVIRONMENT IN DOWND2A.81
! LAYER K-1 (KG/KG) DOWND2A.82
C DOWND2A.83
REAL FLX_DD_K(NPNTS) ! IN DOWNDRAUGHT MASS FLUX OF LAYER K DOWND2A.84
! (PA/S) DOWND2A.85
C DOWND2A.86
REAL P_KM1(NPNTS) ! IN PRESSURE OF LAYER K-1 (PA) DOWND2A.87
C DOWND2A.88
REAL DELPK(NPNTS) ! IN PRESSURE DIFFERENCE ACROSS DOWND2A.89
! LAYER K (PA) DOWND2A.90
C DOWND2A.91
REAL DELPKM1(NPNTS) ! IN PRESSURE DIFFERENCE ACROSS DOWND2A.92
! LAYER K-1 (PA) DOWND2A.93
C DOWND2A.94
REAL EXK(NPNTS) ! IN EXNER RATIO FOR LAYER K DOWND2A.95
C DOWND2A.96
REAL EXKM1(NPNTS) ! IN EXNER RATIO FOR LAYER K-1 DOWND2A.97
C DOWND2A.98
REAL PRECIP_K(NPNTS) ! IN PRECIPITATION ADDED WHEN DOWND2A.99
! DESCENDING FROM LAYER K TO K-1 DOWND2A.100
! (KG/M**2/S) DOWND2A.101
C DOWND2A.102
REAL AMDETK(NPNTS) ! IN MIXING DETRAINMENT AT LEVEL K DOWND2A.103
! MULTIPLIED BY APPROPRIATE LAYER DOWND2A.104
! THICKNESS DOWND2A.105
C DOWND2A.106
REAL EKM14(NPNTS) ! IN EXNER RATIO AT LAYER K-1/4 DOWND2A.107
C DOWND2A.108
REAL EKM34(NPNTS) ! IN EXNER RATIO AT LAYER K-3/4 DOWND2A.109
C DOWND2A.110
REAL DELTD(NPNTS) ! IN COOLING NECESSARY TO DOWND2A.111
! ACHIEVE SATURATION (K) DOWND2A.112
C DOWND2A.113
REAL DELQD(NPNTS) ! IN MOISTENING NECESSARY TO DOWND2A.114
! ACHIEVE SATURATION (KG/KG) DOWND2A.115
C DOWND2A.116
REAL ICCB(NPNTS) ! IN CLOUD BASE LEVEL DOWND2A.117
C DOWND2A.118
LOGICAL BWATER_K(NPNTS) ! IN MASK FOR THOSE POINTS AT WHICH DOWND2A.119
! CONDENSATE IS WATER IN LAYER K DOWND2A.120
C DOWND2A.121
LOGICAL BDDWT_K(NPNTS) ! IN MASK FOR THOSE POINTS IN DOWND2A.122
! DOWNDRAUGHT WHERE PRECIPITATION DOWND2A.123
! IS LIQUID IN LAYER K DOWND2A.124
C DOWND2A.125
LOGICAL BDDWT_KM1(NPNTS) ! IN MASK FOR THOSE POINTS IN DOWND2A.126
! DOWNDRAUGHT WHERE PRECIPITATION DOWND2A.127
! IS LIQUID IN LAYER K-1 DOWND2A.128
C DOWND2A.129
REAL RAIN_ENV(NPNTS) ! IN AMOUNT OF RAIN FALLING THROUGH DOWND2A.130
! THE ENVIRONMENT DOWND2A.131
C DOWND2A.132
REAL SNOW_ENV(NPNTS) ! IN AMOUNT OF SNOW FALLING THROUGH DOWND2A.133
! THE ENVIRONMENT DOWND2A.134
C DOWND2A.135
REAL RAIN_DD(NPNTS) ! IN AMOUNT OF RAIN FALLING THROUGH DOWND2A.136
! THE DOWNDRAUGHT DOWND2A.137
C DOWND2A.138
REAL SNOW_DD(NPNTS) ! IN AMOUNT OF SNOW FALLING THROUGH DOWND2A.139
! THE DOWNDRAUGHT DOWND2A.140
C DOWND2A.141
REAL FLX_UD_K(NPNTS) ! IN UPDRAUGHT MASSFLUX AT LAYER K DOWND2A.142
C DOWND2A.143
REAL TIMESTEP ! IN MODEL TIMESTEP (S) DOWND2A.144
C DOWND2A.145
REAL CCA(NPNTS) ! IN CONVECTIVE CLOUD AMOUNT DOWND2A.146
C DOWND2A.147
REAL LR_UD_REF(NPNTS) ! IN UD PPN MIXING RATION IN LOWEST DG060893.44
! PRECIPITATING LAYER IN UD DG060893.45
C DG060893.46
C----------------------------------------------------------------------- DOWND2A.148
C VARIABLES WHICH ARE INPUT AND OUTPUT DOWND2A.149
C----------------------------------------------------------------------- DOWND2A.150
C DOWND2A.151
LOGICAL BDD_START(NPNTS) ! INOUT DOWND2A.152
! IN MASK FOR THOSE POINTS WHERE DOWND2A.153
! DOWNDRAUGHT MAY FORM IN LAYER K DOWND2A.154
! OUT MASK FOR THOSE POINTS WHERE DOWND2A.155
! DOWNDRAUGHT MAY FORM IN LAYER DOWND2A.156
! K-1 DOWND2A.157
C DOWND2A.158
REAL DTHBYDT_K(NPNTS) ! INOUT DOWND2A.159
! IN INCREMENT TO MODEL POTENTIAL DOWND2A.160
! TEMPERATURE OF LAYER K (K/S) DOWND2A.161
! OUT UPDATED INCREMENT TO MODEL DOWND2A.162
! POTENTIAL TEMPERATURE OF LAYER K DOWND2A.163
! (K/S) DOWND2A.164
C DOWND2A.165
REAL DTHBYDT_KM1(NPNTS) ! INOUT DOWND2A.166
! IN INCREMENT TO MODEL POTENTIAL DOWND2A.167
! TEMPERATURE OF LAYER K-1 (K/S) DOWND2A.168
! OUT UPDATED INCREMENT TO MODEL DOWND2A.169
! POTENTIAL TEMPERATURE OF DOWND2A.170
! LAYER K-1 (K/S) DOWND2A.171
C DOWND2A.172
REAL DQBYDT_K(NPNTS) ! INOUT DOWND2A.173
! IN INCREMENT TO MODEL MIXING DOWND2A.174
! RATIO OF LAYER K (KG/KG/S) DOWND2A.175
! OUT UPDATED INCREMENT TO MODEL DOWND2A.176
! MIXING RATIO OF LAYER K (KG/KG/S) DOWND2A.177
C DOWND2A.178
REAL DQBYDT_KM1(NPNTS) ! INOUT DOWND2A.179
! IN INCREMENT TO MODEL MIXING DOWND2A.180
! RATIO OF LAYER K-1 (KG/KG/S) DOWND2A.181
! OUT UPDATED INCREMENT TO MODEL DOWND2A.182
! POTENTIAL TEMPERATURE OF DOWND2A.183
! LAYER K-1 (KG/KG/S) DOWND2A.184
C DOWND2A.185
REAL RAIN (NPNTS) ! INOUT DOWND2A.186
! IN INITIALISED RAINFALL (KG/M**2/S) DOWND2A.187
! OUT SURFACE RAINFALL (KG/M**2/S) DOWND2A.188
C DOWND2A.189
REAL SNOW(NPNTS) ! INOUT DOWND2A.190
! IN INITIALISED SNOWFALL (KG/M**2/S) DOWND2A.191
! OUT SURFACE SNOWFALL (KG/M**2/S) DOWND2A.192
C DOWND2A.193
LOGICAL BDD_ON(NPNTS) ! INOUT DOWND2A.194
! IN MASK FOR THOSE POINTS WHERE DD DOWND2A.195
! HAS CONTINUED FROM PREVIOUS LAYER DOWND2A.196
! OUT MASK FOR THOSE POINTS WHERE DD DOWND2A.197
! CONTINUES TO LAYER K-1 DOWND2A.198
C DOWND2A.199
C----------------------------------------------------------------------- DOWND2A.200
C VARIABLES WHICH ARE DEFINED LOCALLY DOWND2A.201
C----------------------------------------------------------------------- DOWND2A.202
C DOWND2A.203
C DOWND2A.216
REAL WORK(NDDON_A,24) ! WORK SPACE DOWND2A.217
C DOWND2A.218
LOGICAL BWORK(NDDON_A,5) ! WORK SPACE FOR 'BIT' MASKS DOWND2A.219
C DOWND2A.220
INTEGER INDEX1(NDDON_A) ! INDEX FOR COMPRESS AND DOWND2A.221
C DOWND2A.222
LOGICAL B_DD_END(NPNTS) ! MASK FOR POINTS WHERE DOWNDRAUGHT DOWND2A.223
! HAS ENDED DOWND2A.224
C DOWND2A.225
C DOWND2A.227
REAL FACTOR ! PROPORTION OF RAINFALL GOING INTO DG060893.47
! DOWNDRAUGHT FROM UD DG060893.48
C DOWND2A.230
REAL FACTOR_ENV ! PROPORTION OF RAINFALL GOING INTO DG060893.49
! DD FROM FALLING PPN DG060893.50
C DG060893.51
REAL PPN_DD_REF ! REFERENCE DD PPN MASS DG060893.52
C DG060893.53
C----------------------------------------------------------------------- DOWND2A.231
C EXTERNAL ROUTINES CALLED DOWND2A.232
C----------------------------------------------------------------------- DOWND2A.233
C DOWND2A.234
EXTERNAL CHG_PHSE, PEVP_BCB, DDRAUGHT DOWND2A.235
C DOWND2A.239
C----------------------------------------------------------------------- DOWND2A.240
C START OF MAIN LOOP DOWND2A.241
C UPDATE PRECIPITATION AND CALCULATE MASK FOR WHERE PRECIPITATION DOWND2A.242
C IS LIQUID DOWND2A.243
C----------------------------------------------------------------------- DOWND2A.244
C DOWND2A.245
DO I=1,NPNTS DOWND2A.246
B_DD_END(I) = .FALSE. DOWND2A.247
END DO DOWND2A.248
C DOWND2A.249
IF (K.EQ.KCT+1) THEN DOWND2A.250
DO I=1,NPNTS DOWND2A.251
RAIN_DD(I) = 0.0 DOWND2A.252
RAIN_ENV(I) = 0.0 DOWND2A.253
SNOW_DD(I) = 0.0 DOWND2A.254
SNOW_ENV(I) = 0.0 DOWND2A.255
END DO DOWND2A.256
END IF DOWND2A.257
C DOWND2A.258
C---------------------------------------------------------------------- DG060893.54
C INJECTION OF PRECIPITATION FROM UD AT LEVEL K DG060893.55
C---------------------------------------------------------------------- DG060893.56
C DG060893.57
DO I=1,NPNTS DG060893.58
FACTOR= 0.0 DG060893.59
IF (BDD_ON(I) .AND. FLX_UD_K(I).GT.0.0) THEN DG060893.60
FACTOR = G * FLX_DD_K(I)/FLX_UD_K(I) DG060893.61
FACTOR = AMIN1(FACTOR,1.0) DG060893.62
END IF DG060893.63
c DG060893.64
IF (BWATER_K(I)) THEN DG060893.65
RAIN_DD(I) = RAIN_DD(I) + PRECIP_K(I)*FACTOR DG060893.66
RAIN_ENV(I) = RAIN_ENV(I) + PRECIP_K(I)*(1.0-FACTOR) DG060893.67
ELSE DG060893.68
SNOW_DD(I) = SNOW_DD(I) + PRECIP_K(I)*FACTOR DG060893.69
SNOW_ENV(I) = SNOW_ENV(I) + PRECIP_K(I)*(1.0-FACTOR) DG060893.70
END IF DG060893.71
c DG060893.72
END DO DG060893.73
C DG060893.74
C---------------------------------------------------------------------- DG060893.75
C INTERACTION OF DOWNDRAUGHT WITH RESERVE OF PRECIPITATION OUTSIDE DG060893.76
C DOWNDRAUGHT DG060893.77
C DG060893.78
C BASED UPON CONTINUITY OF PRECIPITATION MIXING RATIO WITHIN DG060893.79
C DOWNDRAUGHT - EITHER AFTER INJECTION OF RAIN FROM UD IN LEVEL DG060893.80
C K OR WITH PPN MIXING RATIO IN LOWEST PRECIPITATING LAYER DG060893.81
C DG060893.82
C IF DOWNDRAUGHT INCREASES IN MASS THEN WATER INJECTED DG060893.83
C IF DOWNDRAUGHT DECREASES IN MASS THEN WATER IS REMOVED DG060893.84
C DG060893.85
C---------------------------------------------------------------------- DG060893.86
C DG060893.87
DO I=1,NPNTS DOWND2A.259
C DOWND2A.260
IF (BDD_ON(I)) THEN DG060893.88
C DOWND2A.266
FACTOR_ENV = 0.0 DG060893.89
IF (PRECIP_K(I).GT.0.0) THEN DG060893.90
C DG060893.91
C--------------------------------------------------------------------- DG060893.92
C CALCULATE NEW REFERENCE PPN MIXING RATIO DG060893.93
C DD PPN MIXING RATIO IN LAYER KM1 BASED ON CONTINUITY DG060893.94
C WITH THAT IN LAYER K DG060893.95
C--------------------------------------------------------------------- DG060893.96
C DG060893.97
LR_UD_REF(I) = G * PRECIP_K(I)/FLX_UD_K(I) DG060893.98
PPN_DD_REF = RAIN_DD(I)+SNOW_DD(I) DG060893.99
ELSE DG060893.100
C DG060893.101
C--------------------------------------------------------------------- DG060893.102
C DD PPN MIXING RATIO IN LAYER KM1 BASED ON CONTINUITY DG060893.103
C WITH THAT IN LAST PRECIPITATING UD LAYER DG060893.104
C--------------------------------------------------------------------- DG060893.105
C DG060893.106
PPN_DD_REF = LR_UD_REF(I) * FLX_DD_K(I) DG060893.107
END IF DG060893.108
C DG060893.109
C-------------------------------------------------------------------- DG060893.110
C INJECT PPN INTO DD FROM PPN FALLING OUTSIDE OF THE DD DG060893.111
C-------------------------------------------------------------------- DG060893.112
C DG060893.113
IF ((RAIN_ENV(I) + SNOW_ENV(I)) .GT. 0.0) THEN AYY1F402.4
!-------Already inside IF ( BDD_ON(I)) block---------------------------- AYY1F402.5
FACTOR_ENV = ( (PPN_DD_REF * (1.0+EKM14(I))* DG060893.116
* (1.0+EKM34(I))*(1.0-AMDETK(I))) - DG060893.117
* (RAIN_DD(I)+SNOW_DD(I)) ) / DG060893.118
* (RAIN_ENV(I)+SNOW_ENV(I)) DG060893.119
FACTOR_ENV = AMIN1(FACTOR_ENV,1.0) DG060893.120
FACTOR_ENV = AMAX1(FACTOR_ENV,-1.0) DG060893.121
END IF DG060893.122
C DG060893.123
IF (FACTOR_ENV.GT.0.0) THEN DG060893.124
RAIN_DD(I) = RAIN_DD(I) + RAIN_ENV(I)*FACTOR_ENV DG060893.125
RAIN_ENV(I) = RAIN_ENV(I) * (1.0-FACTOR_ENV) DG060893.126
SNOW_DD(I) = SNOW_DD(I) + SNOW_ENV(I)*FACTOR_ENV DG060893.127
SNOW_ENV(I) = SNOW_ENV(I) * (1.0-FACTOR_ENV) DG060893.128
ELSE DG060893.129
RAIN_ENV(I) = RAIN_ENV(I) - RAIN_DD(I)*FACTOR_ENV DG060893.130
RAIN_DD(I) = RAIN_DD(I) * (1.0+FACTOR_ENV) DG060893.131
SNOW_ENV(I) = SNOW_ENV(I) - SNOW_DD(I)*FACTOR_ENV DG060893.132
SNOW_DD(I) = SNOW_DD(I) * (1.0+FACTOR_ENV) DG060893.133
END IF DG060893.134
C DG060893.135
END IF DG060893.136
C DG060893.137
C-------------------------------------------------------------------- DG060893.138
C ZERO PRECIPITATION RATE IN LAYER K DG060893.139
C-------------------------------------------------------------------- DG060893.140
C DG060893.141
PRECIP_K(I) = 0.0 DG060893.142
C DOWND2A.279
END DO DOWND2A.280
C DOWND2A.281
C DOWND2A.282
C----------------------------------------------------------------------- DOWND2A.283
C COMPRESS OUT ON BASIS OF BIT VECTOR BDDON - THOSE POINTS WITH A DOWND2A.284
C DOWNDRAUGHT DOWND2A.285
C----------------------------------------------------------------------- DOWND2A.286
C DOWND2A.287
NDDON=0 DOWND2A.288
C DOWND2A.289
DO I=1,NPNTS DOWND2A.293
IF (BDD_ON(I)) THEN DOWND2A.294
NDDON = NDDON+1 DOWND2A.295
INDEX1(NDDON) = I DOWND2A.296
END IF DOWND2A.297
END DO DOWND2A.298
C DOWND2A.300
IF (NDDON .NE. 0) THEN DOWND2A.301
DO I=1,NDDON DOWND2A.302
WORK(I,1) = THDD_K(INDEX1(I)) DOWND2A.303
WORK(I,2) = QDD_K(INDEX1(I)) DOWND2A.304
WORK(I,3) = THE_K(INDEX1(I)) DOWND2A.305
WORK(I,4) = THE_KM1(INDEX1(I)) DOWND2A.306
WORK(I,5) = QE_K(INDEX1(I)) DOWND2A.307
WORK(I,6) = QE_KM1(INDEX1(I)) DOWND2A.308
WORK(I,7) = DTHBYDT_K(INDEX1(I)) DOWND2A.309
WORK(I,8) = DTHBYDT_KM1(INDEX1(I)) DOWND2A.310
WORK(I,9) = DQBYDT_K(INDEX1(I)) DOWND2A.311
WORK(I,10) = DQBYDT_KM1(INDEX1(I)) DOWND2A.312
WORK(I,11) = FLX_DD_K(INDEX1(I)) DOWND2A.313
WORK(I,12) = P_KM1(INDEX1(I)) DOWND2A.314
WORK(I,13) = DELPK(INDEX1(I)) DOWND2A.315
WORK(I,14) = DELPKM1(INDEX1(I)) DOWND2A.316
WORK(I,15) = EXK(INDEX1(I)) DOWND2A.317
WORK(I,16) = EXKM1(INDEX1(I)) DOWND2A.318
WORK(I,17) = DELTD(INDEX1(I)) DOWND2A.319
WORK(I,18) = DELQD(INDEX1(I)) DOWND2A.320
WORK(I,19) = AMDETK(INDEX1(I)) DOWND2A.321
WORK(I,20) = EKM14(INDEX1(I)) DOWND2A.322
WORK(I,21) = EKM34(INDEX1(I)) DOWND2A.323
WORK(I,22) = RAIN_DD(INDEX1(I)) DOWND2A.324
WORK(I,23) = SNOW_DD(INDEX1(I)) DOWND2A.325
WORK(I,24) = CCA(INDEX1(I)) DOWND2A.326
BWORK(I,1) = BDD_START(INDEX1(I)) DOWND2A.327
BWORK(I,2) = BDDWT_K(INDEX1(I)) DOWND2A.328
BWORK(I,3) = BDDWT_KM1(INDEX1(I)) DOWND2A.329
BWORK(I,4) = BDD_ON(INDEX1(I)) DOWND2A.330
BWORK(I,5) = B_DD_END(INDEX1(I)) DOWND2A.331
END DO DOWND2A.332
C DOWND2A.333
C----------------------------------------------------------------------- DOWND2A.334
C START DOWNDRAUGHT CALCULATION DOWND2A.335
C----------------------------------------------------------------------- DOWND2A.336
C DOWND2A.337
C DOWND2A.338
CALL DDRAUGHT (NDDON,K,KCT,WORK(1,1),WORK(1,2),WORK(1,3), DOWND2A.339
& WORK(1,4),WORK(1,5),WORK(1,6),WORK(1,7), DOWND2A.340
& WORK(1,8),WORK(1,9),WORK(1,10),WORK(1,11), DOWND2A.341
& WORK(1,12),WORK(1,13),WORK(1,14), DOWND2A.342
& WORK(1,15),WORK(1,16),WORK(1,17),WORK(1,18), DOWND2A.343
& WORK(1,19),WORK(1,20),WORK(1,21),WORK(1,22), DOWND2A.344
& WORK(1,23),BWORK(1,1),BWORK(1,2),BWORK(1,3), DOWND2A.345
& BWORK(1,4),BWORK(1,5),WORK(1,24)) DOWND2A.346
C DOWND2A.347
C----------------------------------------------------------------------- DOWND2A.348
C EXPAND REQUIRED VECTORS BACK TO FULL FIELDS DOWND2A.349
C----------------------------------------------------------------------- DOWND2A.350
C DOWND2A.351
DO I=1,NDDON DOWND2A.352
THDD_K(INDEX1(I)) = WORK(I,1) DOWND2A.353
QDD_K(INDEX1(I)) = WORK(I,2) DOWND2A.354
DTHBYDT_K(INDEX1(I)) = WORK(I,7) DOWND2A.355
DTHBYDT_KM1(INDEX1(I)) = WORK(I,8) DOWND2A.356
DQBYDT_K(INDEX1(I)) = WORK(I,9) DOWND2A.357
DQBYDT_KM1(INDEX1(I)) = WORK(I,10) DOWND2A.358
FLX_DD_K(INDEX1(I)) = WORK(I,11) DOWND2A.359
RAIN_DD(INDEX1(I)) = WORK(I,22) DOWND2A.360
SNOW_DD(INDEX1(I)) = WORK(I,23) DOWND2A.361
BDD_START(INDEX1(I)) = BWORK(I,1) DOWND2A.362
BDDWT_K(INDEX1(I)) = BWORK(I,2) DOWND2A.363
BDDWT_KM1(INDEX1(I)) = BWORK(I,3) DOWND2A.364
BDD_ON(INDEX1(I)) = BWORK(I,4) DOWND2A.365
B_DD_END(INDEX1(I)) = BWORK(I,5) DOWND2A.366
END DO DOWND2A.367
END IF DOWND2A.368
C DOWND2A.369
C----------------------------------------------------------------------- DOWND2A.370
C RESET PRECIPITATION FALLING THROUGH ENVIRONMENT IF DOWNDRAUGHT DOWND2A.371
C DID NOT FORM DOWND2A.372
C----------------------------------------------------------------------- DOWND2A.373
C DOWND2A.374
DO I=1,NPNTS DOWND2A.375
IF (.NOT.BDD_ON(I).AND..NOT.B_DD_END(I)) THEN DOWND2A.376
RAIN_ENV(I) = RAIN_ENV(I)+RAIN_DD(I) DOWND2A.377
SNOW_ENV(I) = SNOW_ENV(I)+SNOW_DD(I) DOWND2A.378
RAIN_DD(I) = 0.0 DOWND2A.379
SNOW_DD(I) = 0.0 DOWND2A.380
END IF DOWND2A.381
END DO DOWND2A.382
C DOWND2A.383
C----------------------------------------------------------------------- DOWND2A.384
C CARRY OUT CHANGE OF PHASE CALCULATION FOR PRECIPITATION FALLING DOWND2A.385
C THROUGH ENVIRONMENT DOWND2A.386
C----------------------------------------------------------------------- DOWND2A.387
C DOWND2A.388
CALL CHG_PHSE (NPNTS,K,RAIN_ENV,SNOW_ENV,DTHBYDT_KM1, DOWND2A.389
& EXK,EXKM1,DELPKM1,THE_K,THE_KM1) DOWND2A.390
C DOWND2A.391
C----------------------------------------------------------------------- DOWND2A.392
C EVAPORATE RAIN FALLING THROUGH ENVIRONMENT IF LAYER K BELOW DOWND2A.393
C CLOUD BASE DOWND2A.394
C----------------------------------------------------------------------- DOWND2A.395
C DOWND2A.396
CALL PEVP_BCB (NPNTS,K-1,ICCB,THE_KM1,P_KM1,QE_KM1,DELPKM1, DOWND2A.397
& RAIN_ENV,SNOW_ENV,DTHBYDT_KM1,DQBYDT_KM1, DOWND2A.398
& EXKM1,TIMESTEP,CCA) DOWND2A.399
C DOWND2A.400
C----------------------------------------------------------------------- DOWND2A.401
C RESET PRECIPITATION FALLING THROUGH ENVIRONMENT IF DOWNDRAUGHT DOWND2A.402
C TERMINATES DOWND2A.403
C----------------------------------------------------------------------- DOWND2A.404
C DOWND2A.405
DO I=1,NPNTS DOWND2A.406
IF (B_DD_END(I)) THEN DOWND2A.407
RAIN_ENV(I) = RAIN_ENV(I)+RAIN_DD(I) DOWND2A.408
SNOW_ENV(I) = SNOW_ENV(I)+SNOW_DD(I) DOWND2A.409
RAIN_DD(I) = 0.0 DOWND2A.410
SNOW_DD(I) = 0.0 DOWND2A.411
END IF DOWND2A.412
END DO DOWND2A.413
C DOWND2A.414
C----------------------------------------------------------------------- DOWND2A.415
C UPDATE RAIN AND SNOW DOWND2A.416
C----------------------------------------------------------------------- DOWND2A.417
C DOWND2A.418
IF (K.EQ.2) THEN DOWND2A.419
DO I=1,NPNTS DOWND2A.420
RAIN(I) = RAIN(I)+RAIN_DD(I)+RAIN_ENV(I) DOWND2A.421
SNOW(I) = SNOW(I)+SNOW_DD(I)+SNOW_ENV(I) DOWND2A.422
END DO DOWND2A.423
END IF DOWND2A.424
C DOWND2A.425
RETURN DOWND2A.426
END DOWND2A.427
C DOWND2A.428
*ENDIF DOWND2A.429