*IF DEF,A05_2C DDCALL2C.2
C ******************************COPYRIGHT****************************** DDCALL2C.3
C (c) CROWN COPYRIGHT 1996, METEOROLOGICAL OFFICE, All Rights Reserved. DDCALL2C.4
C DDCALL2C.5
C Use, duplication or disclosure of this code is subject to the DDCALL2C.6
C restrictions as set forth in the contract. DDCALL2C.7
C DDCALL2C.8
C Meteorological Office DDCALL2C.9
C London Road DDCALL2C.10
C BRACKNELL DDCALL2C.11
C Berkshire UK DDCALL2C.12
C RG12 2SZ DDCALL2C.13
C DDCALL2C.14
C If no contract has been raised with this copy of the code, the use, DDCALL2C.15
C duplication or disclosure of it is strictly prohibited. Permission DDCALL2C.16
C to do so must first be obtained in writing from the Head of Numerical DDCALL2C.17
C Modelling at the above address. DDCALL2C.18
C ******************************COPYRIGHT****************************** DDCALL2C.19
C DDCALL2C.20
CLL SUBROUTINE DD_CALL------------------------------------------------ DDCALL2C.21
CLL DDCALL2C.22
CLL PURPOSE : CALCULATE INITIAL DOWNDRAUGHT MASSFLUX DDCALL2C.23
CLL DDCALL2C.24
CLL RESET EN/DETRAINMENT RATES FOR DOWNDRAUGHT DDCALL2C.25
CLL DDCALL2C.26
CLL COMPRESS/EXPAND VARIABLES DDCALL2C.27
CLL DDCALL2C.28
CLL INITIALISE DOWNDRAUGHT DDCALL2C.29
CLL DDCALL2C.30
CLL CALL DOWNDRAUGHT ROUTINE DDCALL2C.31
CLL DDCALL2C.32
CLL SUITABLE FOR SINGLE COLUMN MODEL USE DDCALL2C.33
CLL DDCALL2C.34
CLL CODE REWORKED FOR CRAY Y-MP BY S.BETT AND D.GREGORY AUTUMN 1991 DDCALL2C.35
CLL DDCALL2C.36
CLL MODEL MODIFICATION HISTORY: DDCALL2C.37
CLL VERSION DATE DDCALL2C.38
CLL 4.2 1/11/96 New deck version based on DDCALL2A with HADCM2 DDCALL2C.39
CLL specific modifications: R Jones DDCALL2C.40
CLL 4.3 Feb. 97 T3E migration: pass recip_pstar to LAYER_DD : GSS1F403.269
CLL recip_pstar is compressed in the same way as GSS1F403.270
CLL pstar before being passed to LAYER_DD. GSS1F403.271
CLL S.J.Swarbrick GSS1F403.272
!LL 4.5 20/02/98 Remove redundant code. A. Dickinson ADR1F405.47
CLL DDCALL2C.41
CLL PROGRAMMING STANDARDS : UNIFIED MODEL DOCUMENTATION PAPER NO. 3 DDCALL2C.42
CLL VERSION NO. 4 DATED 5/2/92 DDCALL2C.43
CLL DDCALL2C.44
CLL SYSTEM TASK : P27 DDCALL2C.45
CLL DDCALL2C.46
CLL DOCUMENTATION : UNIFIED MODEL DOCUMENTATION PAPER 27 DDCALL2C.47
CLL DDCALL2C.48
CLLEND----------------------------------------------------------------- DDCALL2C.49
C DDCALL2C.50
C*L ARGUMENTS--------------------------------------------------------- DDCALL2C.51
C DDCALL2C.52
SUBROUTINE DD_CALL (
NP_FIELD,NPNTS,KCT,THP,QP,THE,QE,DTHBYDT, DDCALL2C.53
* DQBYDT,FLX,PSTAR,AK,BK,AKM12,BKM12,DELAK, DDCALL2C.54
* DELBK,EXNER,PRECIP,RAIN,SNOW,ICCB,ICCT, DDCALL2C.55
* BWATER,BTERM,BGMK,TIMESTEP,CCA,NTERM, GSS1F403.273
* recip_pstar) GSS1F403.274
C DDCALL2C.57
IMPLICIT NONE DDCALL2C.58
C DDCALL2C.59
C----------------------------------------------------------------------- DDCALL2C.60
C VECTOR LENGTHS AND LOOP COUNTERS DDCALL2C.61
C----------------------------------------------------------------------- DDCALL2C.62
C DDCALL2C.63
C DDCALL2C.64
INTEGER I ! LOOP COUNTER DDCALL2C.65
C DDCALL2C.66
INTEGER K ! PRESENT MODEL LAYER DDCALL2C.67
C DDCALL2C.68
INTEGER NPNTS ! IN NUMBER OF POINTS DDCALL2C.69
C DDCALL2C.70
INTEGER NDD,NTERM ! COMPRESSED VECTOR LENGTH FOR DDCALL2C.71
! DOWNDRAUGHT CALCULATION DDCALL2C.72
C DDCALL2C.73
INTEGER NP_FIELD ! IN FULL VECTOR LENGTH DDCALL2C.74
C DDCALL2C.75
INTEGER NDDON_TMP ! NUMBER OF POINTS WITH ACTIVE DDCALL2C.76
! DOWNDRAUGHT DDCALL2C.77
C DDCALL2C.78
C----------------------------------------------------------------------- DDCALL2C.79
C VARIABLES WHICH ARE INPUT DDCALL2C.80
C----------------------------------------------------------------------- DDCALL2C.81
C DDCALL2C.82
INTEGER KCT ! IN CONVECTIVE CLOUD TOP LAYER DDCALL2C.83
C DDCALL2C.84
REAL AK(KCT+1) ! IN ) HYBRID CO-ORDINATE VALUES AT DDCALL2C.85
REAL BK(KCT+1) ! IN ) MID-LAYER OF LAYER K DDCALL2C.86
C DDCALL2C.87
REAL AKM12(KCT+2) ! IN ) HYBRID CO-ORDINATE VALUES AT DDCALL2C.88
REAL BKM12(KCT+2) ! IN ) LOWER LAYER BOUNDARY OF LAYER K DDCALL2C.89
C DDCALL2C.90
REAL DELAK(KCT+1) ! IN ) HYBRID CO-ORDINATE VALUES FOR DDCALL2C.91
REAL DELBK(KCT+1) ! IN ) THICKNESS OF LAYER K DDCALL2C.92
C DDCALL2C.93
REAL EXNER(NP_FIELD,KCT+2) ! IN EXNER FUNCTION AT LAYER BOUNDARIES DDCALL2C.94
! STARTING AT LEVEL K-1/2 DDCALL2C.95
C DDCALL2C.96
REAL THP(NPNTS,KCT+1) ! IN POTENTIAL TEMPERATURE OF DDCALL2C.97
! PARCEL (K) DDCALL2C.98
C DDCALL2C.99
REAL QP(NPNTS,KCT+1) ! IN MODEL MIXING RATIO (KG/KG) DDCALL2C.100
C DDCALL2C.101
REAL THE(NP_FIELD,KCT+1) ! IN MODEL ENVIRONMENTAL POTENTIAL DDCALL2C.102
! TEMPERATURE (K) DDCALL2C.103
C DDCALL2C.104
REAL QE(NP_FIELD,KCT+1) ! IN ENVIRONMENT MIXING RATIO DDCALL2C.105
! (KG/KG) DDCALL2C.106
C DDCALL2C.107
REAL FLX(NPNTS,KCT+1) ! IN CONVECTIVE MASSFLUX (PA/S) DDCALL2C.108
C DDCALL2C.109
REAL PSTAR(NP_FIELD) ! IN SURFACE PRESSURE (PA) DDCALL2C.110
C DDCALL2C.111
REAL PRECIP(NPNTS,KCT+1) ! IN PRECIPITATION ADDED WHEN DDCALL2C.112
! DESCENDING FROM LAYER K TO K-1 DDCALL2C.113
! (KG/M**2/S) DDCALL2C.114
C DDCALL2C.115
INTEGER ICCB(NP_FIELD) ! IN CLOUD BASE LEVEL DDCALL2C.116
C DDCALL2C.117
INTEGER ICCT(NP_FIELD) ! IN CLOUD TOP LEVEL DDCALL2C.118
C DDCALL2C.119
REAL CCA(NP_FIELD) ! IN CONVECTIVE CLOUD AMOUNT DDCALL2C.120
C DDCALL2C.121
LOGICAL BWATER(NPNTS,2:KCT+1)!IN MASK FOR THOSE POINTS AT WHICH DDCALL2C.122
! CONDENSATE IS WATER IN LAYER K DDCALL2C.123
C DDCALL2C.124
LOGICAL BTERM(NPNTS) ! IN MASK FOR THOSE POINTS WHERE DDCALL2C.125
! UPDRAUGHT IS TERMINATING DDCALL2C.126
C DDCALL2C.127
LOGICAL BGMK(NPNTS) ! IN MASK FOR POINTS WHERE PARCEL IN DDCALL2C.128
! LAYER K IS SATURATED DDCALL2C.129
C DDCALL2C.130
REAL TIMESTEP DDCALL2C.131
REAL recip_PSTAR(NP_FIELD)! Reciprocal of pstar array GSS1F403.276
C DDCALL2C.132
C----------------------------------------------------------------------- DDCALL2C.133
C VARIABLES WHICH ARE INPUT AND OUTPUT DDCALL2C.134
C----------------------------------------------------------------------- DDCALL2C.135
C DDCALL2C.136
REAL DTHBYDT(NP_FIELD,KCT+1) ! INOUT DDCALL2C.137
! IN INCREMENT TO MODEL POTENTIAL DDCALL2C.138
! TEMPERATURE (K/S) DDCALL2C.139
! OUT UPDATED INCREMENT TO MODEL DDCALL2C.140
! POTENTIAL TEMPERATURE (K/S) DDCALL2C.141
C DDCALL2C.142
REAL DQBYDT(NP_FIELD,KCT+1) ! INOUT DDCALL2C.143
! IN INCREMENT TO MODEL MIXING DDCALL2C.144
! RATIO (KG/KG/S) DDCALL2C.145
! OUT UPDATED INCREMENT TO MODEL DDCALL2C.146
! MIXING RATIO (KG/KG/S) DDCALL2C.147
C DDCALL2C.148
C----------------------------------------------------------------------- DDCALL2C.149
C VARIABLES WHICH ARE OUTPUT DDCALL2C.150
C----------------------------------------------------------------------- DDCALL2C.151
C DDCALL2C.152
REAL RAIN(NP_FIELD) ! OUT RAINFALL AT SURFACE (KG/M**2/S) DDCALL2C.153
C DDCALL2C.154
REAL SNOW(NP_FIELD) ! OUT SNOWFALL AT SURFACE (KG/M**2/S) DDCALL2C.155
C DDCALL2C.156
C----------------------------------------------------------------------- DDCALL2C.157
C VARIABLES WHICH ARE DEFINED LOCALLY DDCALL2C.158
C----------------------------------------------------------------------- DDCALL2C.159
C DDCALL2C.160
C DDCALL2C.161
REAL EXNER_KM12_C(NTERM) ! COMPRESSED EXNER FUNCTION AT DDCALL2C.162
! LAYER K DDCALL2C.163
C DDCALL2C.164
REAL EXNER_KP12_C(NTERM) ! COMPRESSED EXNER FUNCTION AT DDCALL2C.165
! LAYER K+1 DDCALL2C.166
C DDCALL2C.167
REAL EXNER_KM32_C(NTERM) ! COMPRESSED EXNER FUNCTION AT DDCALL2C.168
! LAYER K-1 DDCALL2C.169
C DDCALL2C.170
REAL PK(NTERM) ! PRESSURE OF LAYER K (PA) DDCALL2C.171
C DDCALL2C.172
REAL P_KM1(NTERM) ! PRESSURE OF LAYER K-1 (PA) DDCALL2C.173
C DDCALL2C.174
REAL EXK(NTERM) ! EXNER RATIO FOR LAYER K DDCALL2C.175
C DDCALL2C.176
REAL EXKM1(NTERM) ! EXNER RATIO FOR LAYER K-1 DDCALL2C.177
C DDCALL2C.178
REAL DELPK(NTERM) ! PRESSURE DIFFERENCE ACROSS LAYER K DDCALL2C.179
! (PA) DDCALL2C.180
C DDCALL2C.181
REAL DELPKM1(NTERM) ! PRESSURE DIFFERENCE ACROSS DDCALL2C.182
! LAYER K-1 (PA) DDCALL2C.183
C DDCALL2C.184
REAL AMDETK(NTERM) ! MIXING DETRAINMENT AT LEVEL K DDCALL2C.185
! MULTIPLIED BY APPROPRIATE LAYER DDCALL2C.186
! THICKNESS DDCALL2C.187
C DDCALL2C.188
REAL EKM12(NTERM) ! EXNER RATIO AT LAYER K-1/2 DDCALL2C.189
C DDCALL2C.190
REAL EKM14(NTERM) ! EXNER RATIO AT LAYER K-1/4 DDCALL2C.191
C DDCALL2C.192
REAL EKM34(NTERM) ! EXNER RATIO AT LAYER K-3/4 DDCALL2C.193
C DDCALL2C.194
LOGICAL BWATER_K_C(NTERM) ! COMPRESSED MASK FOR THOSE DDCALL2C.195
! POINTS AT WHICH CONDENSATE DDCALL2C.196
! IS WATER IN LAYER K DDCALL2C.197
C DDCALL2C.198
REAL PRECIP_K_C(NTERM) ! COMPRESSED PRECIPITATION DDCALL2C.199
! ADDED WHEN DESCENDING FROM DDCALL2C.200
! LAYER K TO K-1 (KG/M**2/S) DDCALL2C.201
C DDCALL2C.202
REAL Q_K_C(NTERM) ! COMPRESSED PARCEL MIXING RATIO DDCALL2C.203
! OF LAYER K (KG/KG) DDCALL2C.204
C DDCALL2C.205
REAL TH_K_C(NTERM) ! COMPRESSED PARCEL POTENTIAL DDCALL2C.206
! TEMPERATURE OF LAYER K (K) DDCALL2C.207
C DDCALL2C.208
REAL PSTAR_C(NTERM) ! COMPRESSED SURFACE PRESSURE (PA) DDCALL2C.209
C DDCALL2C.210
REAL recip_PSTAR_C(NTERM) ! Reciprocal of comp. pstar array GSS1F403.281
C GSS1F403.285
INTEGER ICCB_C(NTERM) ! COMPRESSED CLOUD BASE LEVEL DDCALL2C.211
C DDCALL2C.212
REAL DTHBYDT_K_C(NTERM) ! COMPRESSED INCREMENT TO MODEL DDCALL2C.213
! POTENTIAL TEMPERATURE OF LAYER K DDCALL2C.214
! (K/S) DDCALL2C.215
C DDCALL2C.216
REAL DTHBYDT_KM1_C(NTERM) ! COMPRESSED INCREMENT TO MODEL DDCALL2C.217
! POTENTIAL TEMPERATURE OF LAYER K-1 DDCALL2C.218
! (K/S) DDCALL2C.219
C DDCALL2C.220
REAL DQBYDT_K_C(NTERM) ! COMPRESSED INCREMENT TO MODEL DDCALL2C.221
! MIXING RATIO OF LAYER K (KG/KG/S) DDCALL2C.222
C DDCALL2C.223
REAL DQBYDT_KM1_C(NTERM) ! COMPRESSED INCREMENT TO MODEL DDCALL2C.224
! MIXING RATIO OF LAYER K-1 (KG/KG/S) DDCALL2C.225
C DDCALL2C.226
REAL DELTD(NTERM) ! COOLING NECESSARY TO DDCALL2C.227
! ACHIEVE SATURATION (K) DDCALL2C.228
C DDCALL2C.229
REAL DELQD(NTERM) ! MOISTENING NECESSARY TO DDCALL2C.230
! ACHIEVE SATURATION (KG/KG) DDCALL2C.231
C DDCALL2C.232
REAL QDD_K(NTERM) ! MIXING RATIO OF DOWNDRAUGHT IN DDCALL2C.233
! LAYER K (KG/KG) DDCALL2C.234
C DDCALL2C.235
REAL THDD_K(NTERM) ! MODEL POTENTIAL TEMPERATURE DDCALL2C.236
! OF DOWNDRAUGHT IN LAYER K (K) DDCALL2C.237
C DDCALL2C.238
REAL FLX_DD_K(NPNTS) ! DOWNDRAUGHT INITIAL MASS FLUX DDCALL2C.239
! (PA/S) DDCALL2C.240
C DDCALL2C.241
REAL FLX_DD_K_C(NTERM) ! COMPRESSED DOWNDRAUGHT INITIAL DDCALL2C.242
! MASS FLUX (PA/S) DDCALL2C.243
C DDCALL2C.244
LOGICAL BDDI(NPNTS) ! MASK FOR POINTS WHERE DOWNDRAUGHT DDCALL2C.245
! MIGHT OCCUR DDCALL2C.246
C DDCALL2C.247
LOGICAL BDDI_C(NTERM) ! COMPRESSED MASK FOR POINTS WHERE DDCALL2C.248
! DOWNDRAUGHT MAY INITIATE DDCALL2C.249
C DDCALL2C.250
INTEGER INDEX1(NTERM) ! INDEX FOR COMPRESS AND EXPAND DDCALL2C.251
C DDCALL2C.252
REAL QE_K_C(NTERM) ! COMPRESSED ENVIRONMENT MIXING DDCALL2C.253
! RATIO OF LAYER K (KG/KG) DDCALL2C.254
C DDCALL2C.255
REAL QE_KM1_C(NTERM) ! COMPRESSED ENVIRONMENT MIXING DDCALL2C.256
! RATIO OF LAYER K-1 (KG/KG) DDCALL2C.257
C DDCALL2C.258
REAL THE_K_C(NTERM) ! COMPRESSED POTENTIAL TEMPERATURE DDCALL2C.259
! OF ENVIRONMENT IN LAYER K (K) DDCALL2C.260
C DDCALL2C.261
REAL THE_KM1_C(NTERM) ! COMPRESSED POTENTIAL TEMPERATURE DDCALL2C.262
! OF ENVIRONMENT IN LAYER K-1 (K) DDCALL2C.263
C DDCALL2C.264
REAL RAIN_C(NTERM) ! COMPRESSED SURFACE RAINFALL DDCALL2C.265
! (KG/M**2/S) DDCALL2C.266
C DDCALL2C.267
REAL SNOW_C(NTERM) ! COMPRESSED SURFACE SNOWFALL DDCALL2C.268
! (KG/M**2/S) DDCALL2C.269
C DDCALL2C.270
REAL FLX_UD_K_C(NTERM) ! UPDRAUGHT MASS FLUX AT LAYER K DDCALL2C.271
C DDCALL2C.272
REAL RAIN_ENV(NTERM) ! AMOUNT OF RAINFALL PASSING THROUGH DDCALL2C.273
! ENVIRONMENT (KG/M**2/S) DDCALL2C.274
C DDCALL2C.275
REAL SNOW_ENV(NTERM) ! AMOUNT OF SNOWFALL PASSING THROUGH DDCALL2C.276
! ENVIRONMENT (KG/M**2/S) DDCALL2C.277
C DDCALL2C.278
REAL RAIN_DD(NTERM) ! AMOUNT OF RAINFALL PASSING THROUGH DDCALL2C.279
! DOWNDRAUGHT (KG/M**2/S) DDCALL2C.280
C DDCALL2C.281
REAL SNOW_DD(NTERM) ! AMOUNT OF SNOWFALL PASSING THROUGH DDCALL2C.282
! DOWNDRAUGHT (KG/M**2/S) DDCALL2C.283
C DDCALL2C.284
LOGICAL BDD_START(NPNTS) ! MASK FOR THOSE POINT WHERE DDCALL2C.285
! DOWNDRAUGHT IS ABLE TO START DDCALL2C.286
! FROM LEVEL K DDCALL2C.287
C DDCALL2C.288
LOGICAL BDD_START_C(NTERM) ! COMPRESSED MASK FOR THOSE POINT DDCALL2C.289
! WHERE DOWNDRAUGHT IS ABLE TO START DDCALL2C.290
! FROM LEVEL K DDCALL2C.291
C DDCALL2C.292
LOGICAL BDDWT_K(NPNTS) ! MASK FOR POINTS IN DOWNDRAUGHT DDCALL2C.293
! WHERE PPT IN LAYER K IS LIQUID DDCALL2C.294
C DDCALL2C.295
LOGICAL BDDWT_K_C(NTERM) ! COMPRESSED MASK FOR POINTS IN DD DDCALL2C.296
! WHERE PPT IN LAYER K IS LIQUID DDCALL2C.297
C DDCALL2C.298
LOGICAL BDDWT_KM1(NPNTS) ! MASK FOR POINTS IN DOWNDRAUGHT DDCALL2C.299
! WHERE PPT IN LAYER K-1 IS LIQUID DDCALL2C.300
C DDCALL2C.301
LOGICAL BDDWT_KM1_C(NTERM) ! COMPRESSED MASK FOR POINTS IN DD DDCALL2C.302
! WHERE PPT IN LAYER K-1 IS LIQUID DDCALL2C.303
C DDCALL2C.304
LOGICAL BDD_ON(NPNTS) ! MASK FOR THOSE POINTS WHERE DD DDCALL2C.305
! CONTINUES FROM LAYER K+1 DDCALL2C.306
C DDCALL2C.307
LOGICAL BDD_ON_C(NTERM) ! COMPRESSED MASK FOR POINTS WHERE DD DDCALL2C.308
! CONTINUES FROM LAYER K+1 DDCALL2C.309
C DDCALL2C.310
INTEGER KMIN(NTERM) ! FREEZING LEVEL WHERE ENTRAINMENT DDCALL2C.311
! RATES ARE INCREASED DDCALL2C.312
C DDCALL2C.313
REAL FLX_STRT(NPNTS) ! MASSFLUX AT LEVEL WHERE DOWNDRAUGHT DDCALL2C.314
! STARTS (PA/S) DDCALL2C.315
C DDCALL2C.316
REAL FLX_STRT_C(NTERM) ! COMPRESSED VALUE OF FLX_STRT DDCALL2C.317
C DDCALL2C.318
REAL CCA_C(NTERM) ! COMPRESSED CONVECTIVE CLOUD AMOUNT DDCALL2C.319
C DDCALL2C.320
INTEGER INDEX2(NTERM) ! INDEX OF WHERE ACTICE DOWNDRAUGHT DDCALL2C.321
! OCCURS DDCALL2C.322
C DDCALL2C.323
C DDCALL2C.324
C----------------------------------------------------------------------- DDCALL2C.325
C----------------------------------------------------------------------- DDCALL2C.326
C EXTERNAL ROUTINES CALLED DDCALL2C.327
C----------------------------------------------------------------------- DDCALL2C.328
C DDCALL2C.329
EXTERNAL FLX_INIT, LAYER_DD, DD_INIT, DOWND DDCALL2C.330
C DDCALL2C.331
C----------------------------------------------------------------------- DDCALL2C.332
C CALCULATE INDEX FOR COMPRESS ON BASIS OF BTERM DDCALL2C.333
C----------------------------------------------------------------------- DDCALL2C.334
C DDCALL2C.335
NDD = 0 DDCALL2C.336
DO I=1,NPNTS DDCALL2C.337
IF (BTERM(I)) THEN DDCALL2C.338
NDD = NDD+1 DDCALL2C.339
INDEX1(NDD) = I DDCALL2C.340
END IF DDCALL2C.341
END DO DDCALL2C.342
C DDCALL2C.343
C---------------------------------------------------------------------- DDCALL2C.344
C INITIALISE LOGICAL ARRAYS AS FALSE DDCALL2C.345
C----------------------------------------------------------------------- DDCALL2C.346
C DDCALL2C.347
DO I=1,NPNTS DDCALL2C.348
BDDI(I) = .FALSE. DDCALL2C.349
BDD_START(I) = .FALSE. DDCALL2C.350
BDDWT_K(I) = .FALSE. DDCALL2C.351
BDDWT_KM1(I) = .FALSE. DDCALL2C.352
BDD_ON(I) = .FALSE. DDCALL2C.353
C DDCALL2C.354
C----------------------------------------------------------------------- DDCALL2C.355
C CALCULATE MASK FOR THOSE POINT WHERE DOWNDRAUGHT MIGHT OCCUR DDCALL2C.356
C AND LEVEL AT WHICH IT MIGHT INITIATE DDCALL2C.357
C----------------------------------------------------------------------- DDCALL2C.358
C DDCALL2C.359
IF (KCT .GE. 4 .AND. BTERM(I) .AND. BGMK(I) .AND. (KCT-ICCB(I)) DDCALL2C.360
& .GT. 2) BDDI(I) = .TRUE. DDCALL2C.361
END DO DDCALL2C.362
C DDCALL2C.363
C---------------------------------------------------------------------- DDCALL2C.364
C CALCULATE INITIAL DOWNDRAUGHT MASS FLUX DDCALL2C.365
C----------------------------------------------------------------------- DDCALL2C.366
C DDCALL2C.367
IF (KCT .GE. 4) DDCALL2C.368
* CALL FLX_INIT (NPNTS,KCT,ICCB,ICCT,FLX,FLX_DD_K,BDDI,FLX_STRT) DDCALL2C.369
C DDCALL2C.370
C----------------------------------------------------------------------- DDCALL2C.371
C COMPRESS ALL INPUT ARRAYS FOR THE DOWNDRAUGHT CALCULATION DDCALL2C.372
C----------------------------------------------------------------------- DDCALL2C.373
C DDCALL2C.374
DO 10 K = KCT+1,2,-1 DDCALL2C.375
C DDCALL2C.376
DO I=1,NDD DDCALL2C.377
TH_K_C(I) = THP(INDEX1(I),K) DDCALL2C.378
Q_K_C(I) = QP(INDEX1(I),K) DDCALL2C.379
THE_K_C(I) = THE(INDEX1(I),K) DDCALL2C.380
THE_KM1_C(I) = THE(INDEX1(I),K-1) DDCALL2C.381
QE_K_C(I) = QE(INDEX1(I),K) DDCALL2C.382
QE_KM1_C(I) = QE(INDEX1(I),K-1) DDCALL2C.383
DTHBYDT_K_C(I) = DTHBYDT(INDEX1(I),K) DDCALL2C.384
DTHBYDT_KM1_C(I) = DTHBYDT(INDEX1(I),K-1) DDCALL2C.385
DQBYDT_K_C(I) = DQBYDT(INDEX1(I),K) DDCALL2C.386
DQBYDT_KM1_C(I) = DQBYDT(INDEX1(I),K-1) DDCALL2C.387
EXNER_KM12_C(I) = EXNER(INDEX1(I),K) DDCALL2C.388
EXNER_KP12_C(I) = EXNER(INDEX1(I),K+1) DDCALL2C.389
EXNER_KM32_C(I) = EXNER(INDEX1(I),K-1) DDCALL2C.390
PRECIP_K_C(I) = PRECIP(INDEX1(I),K) DDCALL2C.391
FLX_UD_K_C(I) = FLX(INDEX1(I),K) DDCALL2C.392
BWATER_K_C(I) = BWATER(INDEX1(I),K) DDCALL2C.393
END DO DDCALL2C.394
IF (K.EQ.KCT+1) THEN DDCALL2C.395
DO I=1,NDD DDCALL2C.396
FLX_DD_K_C(I) = FLX_DD_K(INDEX1(I)) DDCALL2C.397
FLX_STRT_C(I) = FLX_STRT(INDEX1(I)) DDCALL2C.398
PSTAR_C(I) = PSTAR(INDEX1(I)) DDCALL2C.399
recip_pstar_c(I)=recip_pstar(index1(I)) GSS1F403.287
ICCB_C(I) = ICCB(INDEX1(I)) DDCALL2C.400
BDDI_C(I) = BDDI(INDEX1(I)) DDCALL2C.401
BDD_START_C(I) = BDD_START(INDEX1(I)) DDCALL2C.402
RAIN_C(I) = RAIN(INDEX1(I)) DDCALL2C.403
SNOW_C(I) = SNOW(INDEX1(I)) DDCALL2C.404
BDDWT_K_C(I) = BDDWT_K(INDEX1(I)) DDCALL2C.405
BDDWT_KM1_C(I) = BDDWT_KM1(INDEX1(I)) DDCALL2C.406
BDD_ON_C(I) = BDD_ON(INDEX1(I)) DDCALL2C.407
CCA_C(I) = CCA(INDEX1(I)) DDCALL2C.408
END DO DDCALL2C.409
END IF DDCALL2C.410
C DDCALL2C.411
C----------------------------------------------------------------------- DDCALL2C.412
C RESET EN/DETRAINMENT RATES FOR DOWNDRAUGHT DDCALL2C.413
C----------------------------------------------------------------------- DDCALL2C.414
C DDCALL2C.415
CALL LAYER_DD (NDD,K,KCT,THE_K_C,THE_KM1_C,FLX_STRT_C,AK,BK, DDCALL2C.416
* AKM12,BKM12,DELAK,DELBK,EXNER_KM12_C,EXNER_KP12_C, DDCALL2C.417
* EXNER_KM32_C,PSTAR_C,PK,P_KM1,DELPK,DELPKM1,EXK, DDCALL2C.418
* EXKM1,AMDETK,EKM14,EKM34,KMIN,BDDI_C, GSS1F403.289
* recip_pstar_c) GSS1F403.290
C DDCALL2C.420
C----------------------------------------------------------------------- DDCALL2C.421
C INITIALISE DOWNDRAUGHT DDCALL2C.422
C----------------------------------------------------------------------- DDCALL2C.423
C DDCALL2C.424
IF (KCT .GE. 4) DDCALL2C.425
& CALL DD_INIT(NDD,TH_K_C,Q_K_C,THE_K_C,QE_K_C,PK,EXK,THDD_K, DDCALL2C.426
& QDD_K,DELTD,DELQD,BDD_START_C,K,BDDI_C,BDD_ON_C) DDCALL2C.427
C DDCALL2C.428
C----------------------------------------------------------------------- DDCALL2C.429
C UPDATE MASK FOR WHERE DOWNDRAUGHT OCCURS DDCALL2C.430
C----------------------------------------------------------------------- DDCALL2C.431
C DDCALL2C.432
DO I=1,NDD DDCALL2C.433
IF (BDD_START_C(I).OR.BDD_ON_C(I)) BDD_ON_C(I)=.TRUE. DDCALL2C.434
END DO DDCALL2C.435
C DDCALL2C.436
NDDON_TMP = 0 DDCALL2C.437
DO I=1,NDD DDCALL2C.438
IF (BDD_ON_C(I)) THEN DDCALL2C.439
NDDON_TMP = NDDON_TMP+1 DDCALL2C.440
END IF DDCALL2C.441
END DO DDCALL2C.442
C DDCALL2C.443
C----------------------------------------------------------------------- DDCALL2C.444
C CALL DOWNDRAUGHT ROUTINE DDCALL2C.445
C----------------------------------------------------------------------- DDCALL2C.446
C DDCALL2C.447
DDCALL2C.448
CALL DOWND(NDD,K,KCT,THDD_K,QDD_K,THE_K_C,THE_KM1_C,QE_K_C, DDCALL2C.449
& QE_KM1_C,DTHBYDT_K_C,DTHBYDT_KM1_C,DQBYDT_K_C, DDCALL2C.450
& DQBYDT_KM1_C,FLX_DD_K_C,P_KM1,DELPK,DELPKM1,EXK, DDCALL2C.451
& EXKM1,DELTD,DELQD,AMDETK,EKM14,EKM34,PRECIP_K_C, DDCALL2C.452
& RAIN_C,SNOW_C,ICCB_C,BWATER_K_C,BDD_START_C, DDCALL2C.453
& BDDWT_K_C,BDDWT_KM1_C,BDD_ON_C,RAIN_ENV,SNOW_ENV, DDCALL2C.454
& RAIN_DD,SNOW_DD,FLX_UD_K_C,TIMESTEP,CCA_C,NDDON_TMP) DDCALL2C.455
C DDCALL2C.456
C----------------------------------------------------------------------- DDCALL2C.457
C DECOMPRESS/EXPAND THOSE VARIABLES WHICH ARE TO BE OUTPUT DDCALL2C.458
C----------------------------------------------------------------------- DDCALL2C.459
C DDCALL2C.460
CDIR$ IVDEP DDCALL2C.461
! Fujitsu vectorization directive GRB0F405.219
!OCL NOVREC GRB0F405.220
DO I=1,NDD DDCALL2C.462
DTHBYDT(INDEX1(I),K) = DTHBYDT_K_C(I) DDCALL2C.463
DTHBYDT(INDEX1(I),K-1) = DTHBYDT_KM1_C(I) DDCALL2C.464
DQBYDT(INDEX1(I),K) = DQBYDT_K_C(I) DDCALL2C.465
DQBYDT(INDEX1(I),K-1) = DQBYDT_KM1_C(I) DDCALL2C.466
IF (K.EQ.2) THEN DDCALL2C.467
RAIN(INDEX1(I)) = RAIN_C(I) DDCALL2C.468
SNOW(INDEX1(I)) = SNOW_C(I) DDCALL2C.469
END IF DDCALL2C.470
PRECIP(INDEX1(I),K) = PRECIP_K_C(I) DDCALL2C.471
END DO DDCALL2C.472
C DDCALL2C.473
C---------------------------------------------------------------------- DDCALL2C.474
C END OF MAIN K LOOP DDCALL2C.475
C---------------------------------------------------------------------- DDCALL2C.476
C DDCALL2C.477
10 CONTINUE DDCALL2C.478
C DDCALL2C.479
RETURN DDCALL2C.480
END DDCALL2C.481
C DDCALL2C.482
*ENDIF DDCALL2C.483