*IF DEF,A05_2A AJX1F405.153
C ******************************COPYRIGHT****************************** GTS2F400.1711
C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved. GTS2F400.1712
C GTS2F400.1713
C Use, duplication or disclosure of this code is subject to the GTS2F400.1714
C restrictions as set forth in the contract. GTS2F400.1715
C GTS2F400.1716
C Meteorological Office GTS2F400.1717
C London Road GTS2F400.1718
C BRACKNELL GTS2F400.1719
C Berkshire UK GTS2F400.1720
C RG12 2SZ GTS2F400.1721
C GTS2F400.1722
C If no contract has been raised with this copy of the code, the use, GTS2F400.1723
C duplication or disclosure of it is strictly prohibited. Permission GTS2F400.1724
C to do so must first be obtained in writing from the Head of Numerical GTS2F400.1725
C Modelling at the above address. GTS2F400.1726
C ******************************COPYRIGHT****************************** GTS2F400.1727
C GTS2F400.1728
CLL SUBROUTINE DD_CALL------------------------------------------------ DDCALL2A.3
CLL DDCALL2A.4
CLL PURPOSE : CALCULATE INITIAL DOWNDRAUGHT MASSFLUX DDCALL2A.5
CLL DDCALL2A.6
CLL RESET EN/DETRAINMENT RATES FOR DOWNDRAUGHT DDCALL2A.7
CLL DDCALL2A.8
CLL COMPRESS/EXPAND VARIABLES DDCALL2A.9
CLL DDCALL2A.10
CLL INITIALISE DOWNDRAUGHT DDCALL2A.11
CLL DDCALL2A.12
CLL CALL DOWNDRAUGHT ROUTINE DDCALL2A.13
CLL DDCALL2A.14
CLL SUITABLE FOR SINGLE COLUMN MODEL USE DDCALL2A.15
CLL DDCALL2A.16
CLL CODE REWORKED FOR CRAY Y-MP BY S.BETT AND D.GREGORY AUTUMN 1991 DDCALL2A.17
CLL DDCALL2A.18
CLL MODEL MODIFICATION HISTORY FROM MODEL VERSION 3.0: DDCALL2A.19
CLL VERSION DATE DDCALL2A.20
CLL 3.3 23/12/93 : DG060893 : CORRECTION TO REDUCE OVER PREDICTION DG060893.9
CLL OF CONVECTIVE SNOW; TO PASS ADDITIONAL DG060893.10
CLL DATA DOWN TO DOWN2A AND PREVENT DD DG060893.11
CLL FORMING BELOW UPDRAUGHT BASE DG060893.12
CLL 4.2 Oct. 96 T3E migration: *DEF CRAY removed GSS1F402.94
CLL (was used to switch on WHENIMD) GSS1F402.95
CLL S.J.Swarbrick GSS1F402.96
CLL 4.3 Feb. 97 T3E migration: pass recip_pstar to LAYER_DD : GSS1F403.247
CLL recip_pstar is compressed in the same way as GSS1F403.248
CLL pstar before being passed to LAYER_DD. GSS1F403.249
CLL S.J.Swarbrick GSS1F403.250
CLL 4.5 Jul. 98 Kill the IBM specific lines (JCThil) AJC1F405.4
!LL 4.5 20/02/98 Remove redundant code. A. Dickinson ADR1F405.46
CLL DG060893.13
CLL DDCALL2A.21
CLL PROGRAMMING STANDARDS : UNIFIED MODEL DOCUMENTATION PAPER NO. 3 DDCALL2A.22
CLL VERSION NO. 4 DATED 5/2/92 DDCALL2A.23
CLL DDCALL2A.24
CLL SYSTEM TASK : P27 DDCALL2A.25
CLL DDCALL2A.26
CLL DOCUMENTATION : UNIFIED MODEL DOCUMENTATION PAPER P27 DDCALL2A.27
CLL DDCALL2A.28
CLLEND----------------------------------------------------------------- DDCALL2A.29
C DDCALL2A.30
C*L ARGUMENTS--------------------------------------------------------- DDCALL2A.31
C DDCALL2A.32
SUBROUTINE DD_CALL (
NP_FIELD,NPNTS,KCT,THP,QP,THE,QE,DTHBYDT, DDCALL2A.33
* DQBYDT,FLX,PSTAR,AK,BK,AKM12,BKM12,DELAK, DDCALL2A.34
* DELBK,EXNER,PRECIP,RAIN,SNOW,ICCB,ICCT, DDCALL2A.35
* BWATER,BTERM,BGMK,TIMESTEP,CCA,NTERM, GSS1F403.251
* recip_pstar) GSS1F403.252
C DDCALL2A.37
IMPLICIT NONE DDCALL2A.38
C DDCALL2A.39
C----------------------------------------------------------------------- DDCALL2A.40
C VECTOR LENGTHS AND LOOP COUNTERS DDCALL2A.41
C----------------------------------------------------------------------- DDCALL2A.42
C DDCALL2A.43
C DDCALL2A.47
INTEGER I ! LOOP COUNTER DDCALL2A.48
C DDCALL2A.49
INTEGER K ! PRESENT MODEL LAYER DDCALL2A.50
C DDCALL2A.51
INTEGER NPNTS ! IN NUMBER OF POINTS DDCALL2A.52
C DDCALL2A.53
INTEGER NDD,NTERM ! COMPRESSED VECTOR LENGTH FOR DDCALL2A.54
! DOWNDRAUGHT CALCULATION DDCALL2A.55
C DDCALL2A.56
INTEGER NP_FIELD ! IN FULL VECTOR LENGTH DDCALL2A.57
C DDCALL2A.58
INTEGER NDDON_TMP ! NUMBER OF POINTS WITH ACTIVE DDCALL2A.59
! DOWNDRAUGHT DDCALL2A.60
C DDCALL2A.61
C----------------------------------------------------------------------- DDCALL2A.62
C VARIABLES WHICH ARE INPUT DDCALL2A.63
C----------------------------------------------------------------------- DDCALL2A.64
C DDCALL2A.65
INTEGER KCT ! IN CONVECTIVE CLOUD TOP LAYER DDCALL2A.66
C DDCALL2A.67
REAL AK(KCT+1) ! IN ) HYBRID CO-ORDINATE VALUES AT DDCALL2A.68
REAL BK(KCT+1) ! IN ) MID-LAYER OF LAYER K DDCALL2A.69
C DDCALL2A.70
REAL AKM12(KCT+2) ! IN ) HYBRID CO-ORDINATE VALUES AT DDCALL2A.71
REAL BKM12(KCT+2) ! IN ) LOWER LAYER BOUNDARY OF LAYER K DDCALL2A.72
C DDCALL2A.73
REAL DELAK(KCT+1) ! IN ) HYBRID CO-ORDINATE VALUES FOR DDCALL2A.74
REAL DELBK(KCT+1) ! IN ) THICKNESS OF LAYER K DDCALL2A.75
C DDCALL2A.76
REAL EXNER(NP_FIELD,KCT+2) ! IN EXNER FUNCTION AT LAYER BOUNDARIES DDCALL2A.77
! STARTING AT LEVEL K-1/2 DDCALL2A.78
C DDCALL2A.79
REAL THP(NPNTS,KCT+1) ! IN POTENTIAL TEMPERATURE OF DDCALL2A.80
! PARCEL (K) DDCALL2A.81
C DDCALL2A.82
REAL QP(NPNTS,KCT+1) ! IN MODEL MIXING RATIO (KG/KG) DDCALL2A.83
C DDCALL2A.84
REAL THE(NP_FIELD,KCT+1) ! IN MODEL ENVIRONMENTAL POTENTIAL DDCALL2A.85
! TEMPERATURE (K) DDCALL2A.86
C DDCALL2A.87
REAL QE(NP_FIELD,KCT+1) ! IN ENVIRONMENT MIXING RATIO DDCALL2A.88
! (KG/KG) DDCALL2A.89
C DDCALL2A.90
REAL FLX(NPNTS,KCT+1) ! IN CONVECTIVE MASSFLUX (PA/S) DDCALL2A.91
C DDCALL2A.92
REAL PSTAR(NP_FIELD) ! IN SURFACE PRESSURE (PA) DDCALL2A.93
C DDCALL2A.94
REAL PRECIP(NPNTS,KCT+1) ! IN PRECIPITATION ADDED WHEN DDCALL2A.95
! DESCENDING FROM LAYER K TO K-1 DDCALL2A.96
! (KG/M**2/S) DDCALL2A.97
C DDCALL2A.98
INTEGER ICCB(NP_FIELD) ! IN CLOUD BASE LEVEL DDCALL2A.99
C DDCALL2A.100
INTEGER ICCT(NP_FIELD) ! IN CLOUD TOP LEVEL DDCALL2A.101
C DDCALL2A.102
REAL CCA(NP_FIELD) ! IN CONVECTIVE CLOUD AMOUNT DDCALL2A.103
C DDCALL2A.104
LOGICAL BWATER(NPNTS,2:KCT+1)!IN MASK FOR THOSE POINTS AT WHICH DDCALL2A.105
! CONDENSATE IS WATER IN LAYER K DDCALL2A.106
C DDCALL2A.107
LOGICAL BTERM(NPNTS) ! IN MASK FOR THOSE POINTS WHERE DDCALL2A.108
! UPDRAUGHT IS TERMINATING DDCALL2A.109
C DDCALL2A.110
LOGICAL BGMK(NPNTS) ! IN MASK FOR POINTS WHERE PARCEL IN DDCALL2A.111
! LAYER K IS SATURATED DDCALL2A.112
C DDCALL2A.113
REAL TIMESTEP DDCALL2A.114
REAL recip_PSTAR(NP_FIELD)! Reciprocal of pstar array GSS1F403.254
C DDCALL2A.115
C----------------------------------------------------------------------- DDCALL2A.116
C VARIABLES WHICH ARE INPUT AND OUTPUT DDCALL2A.117
C----------------------------------------------------------------------- DDCALL2A.118
C DDCALL2A.119
REAL DTHBYDT(NP_FIELD,KCT+1) ! INOUT DDCALL2A.120
! IN INCREMENT TO MODEL POTENTIAL DDCALL2A.121
! TEMPERATURE (K/S) DDCALL2A.122
! OUT UPDATED INCREMENT TO MODEL DDCALL2A.123
! POTENTIAL TEMPERATURE (K/S) DDCALL2A.124
C DDCALL2A.125
REAL DQBYDT(NP_FIELD,KCT+1) ! INOUT DDCALL2A.126
! IN INCREMENT TO MODEL MIXING DDCALL2A.127
! RATIO (KG/KG/S) DDCALL2A.128
! OUT UPDATED INCREMENT TO MODEL DDCALL2A.129
! MIXING RATIO (KG/KG/S) DDCALL2A.130
C DDCALL2A.131
C----------------------------------------------------------------------- DDCALL2A.132
C VARIABLES WHICH ARE OUTPUT DDCALL2A.133
C----------------------------------------------------------------------- DDCALL2A.134
C DDCALL2A.135
REAL RAIN(NP_FIELD) ! OUT RAINFALL AT SURFACE (KG/M**2/S) DDCALL2A.136
C DDCALL2A.137
REAL SNOW(NP_FIELD) ! OUT SNOWFALL AT SURFACE (KG/M**2/S) DDCALL2A.138
C DDCALL2A.139
C----------------------------------------------------------------------- DDCALL2A.140
C VARIABLES WHICH ARE DEFINED LOCALLY DDCALL2A.141
C----------------------------------------------------------------------- DDCALL2A.142
C DDCALL2A.143
C DDCALL2A.307
REAL EXNER_KM12_C(NTERM) ! COMPRESSED EXNER FUNCTION AT DDCALL2A.308
! LAYER K DDCALL2A.309
C DDCALL2A.310
REAL EXNER_KP12_C(NTERM) ! COMPRESSED EXNER FUNCTION AT DDCALL2A.311
! LAYER K+1 DDCALL2A.312
C DDCALL2A.313
REAL EXNER_KM32_C(NTERM) ! COMPRESSED EXNER FUNCTION AT DDCALL2A.314
! LAYER K-1 DDCALL2A.315
C DDCALL2A.316
REAL PK(NTERM) ! PRESSURE OF LAYER K (PA) DDCALL2A.317
C DDCALL2A.318
REAL P_KM1(NTERM) ! PRESSURE OF LAYER K-1 (PA) DDCALL2A.319
C DDCALL2A.320
REAL EXK(NTERM) ! EXNER RATIO FOR LAYER K DDCALL2A.321
C DDCALL2A.322
REAL EXKM1(NTERM) ! EXNER RATIO FOR LAYER K-1 DDCALL2A.323
C DDCALL2A.324
REAL DELPK(NTERM) ! PRESSURE DIFFERENCE ACROSS LAYER K DDCALL2A.325
! (PA) DDCALL2A.326
C DDCALL2A.327
REAL DELPKM1(NTERM) ! PRESSURE DIFFERENCE ACROSS DDCALL2A.328
! LAYER K-1 (PA) DDCALL2A.329
C DDCALL2A.330
REAL AMDETK(NTERM) ! MIXING DETRAINMENT AT LEVEL K DDCALL2A.331
! MULTIPLIED BY APPROPRIATE LAYER DDCALL2A.332
! THICKNESS DDCALL2A.333
C DDCALL2A.334
REAL EKM12(NTERM) ! EXNER RATIO AT LAYER K-1/2 DDCALL2A.335
C DDCALL2A.336
REAL EKM14(NTERM) ! EXNER RATIO AT LAYER K-1/4 DDCALL2A.337
C DDCALL2A.338
REAL EKM34(NTERM) ! EXNER RATIO AT LAYER K-3/4 DDCALL2A.339
C DDCALL2A.340
LOGICAL BWATER_K_C(NTERM) ! COMPRESSED MASK FOR THOSE DDCALL2A.341
! POINTS AT WHICH CONDENSATE DDCALL2A.342
! IS WATER IN LAYER K DDCALL2A.343
C DDCALL2A.344
REAL PRECIP_K_C(NTERM) ! COMPRESSED PRECIPITATION DDCALL2A.345
! ADDED WHEN DESCENDING FROM DDCALL2A.346
! LAYER K TO K-1 (KG/M**2/S) DDCALL2A.347
C DDCALL2A.348
REAL Q_K_C(NTERM) ! COMPRESSED PARCEL MIXING RATIO DDCALL2A.349
! OF LAYER K (KG/KG) DDCALL2A.350
C DDCALL2A.351
REAL TH_K_C(NTERM) ! COMPRESSED PARCEL POTENTIAL DDCALL2A.352
! TEMPERATURE OF LAYER K (K) DDCALL2A.353
C DDCALL2A.354
REAL PSTAR_C(NTERM) ! COMPRESSED SURFACE PRESSURE (PA) DDCALL2A.355
C DDCALL2A.356
REAL recip_PSTAR_C(NTERM) ! Reciprocal of comp. pstar array GSS1F403.259
C GSS1F403.263
INTEGER ICCB_C(NTERM) ! COMPRESSED CLOUD BASE LEVEL DDCALL2A.357
C DDCALL2A.358
REAL DTHBYDT_K_C(NTERM) ! COMPRESSED INCREMENT TO MODEL DDCALL2A.359
! POTENTIAL TEMPERATURE OF LAYER K DDCALL2A.360
! (K/S) DDCALL2A.361
C DDCALL2A.362
REAL DTHBYDT_KM1_C(NTERM) ! COMPRESSED INCREMENT TO MODEL DDCALL2A.363
! POTENTIAL TEMPERATURE OF LAYER K-1 DDCALL2A.364
! (K/S) DDCALL2A.365
C DDCALL2A.366
REAL DQBYDT_K_C(NTERM) ! COMPRESSED INCREMENT TO MODEL DDCALL2A.367
! MIXING RATIO OF LAYER K (KG/KG/S) DDCALL2A.368
C DDCALL2A.369
REAL DQBYDT_KM1_C(NTERM) ! COMPRESSED INCREMENT TO MODEL DDCALL2A.370
! MIXING RATIO OF LAYER K-1 (KG/KG/S) DDCALL2A.371
C DDCALL2A.372
REAL DELTD(NTERM) ! COOLING NECESSARY TO DDCALL2A.373
! ACHIEVE SATURATION (K) DDCALL2A.374
C DDCALL2A.375
REAL DELQD(NTERM) ! MOISTENING NECESSARY TO DDCALL2A.376
! ACHIEVE SATURATION (KG/KG) DDCALL2A.377
C DDCALL2A.378
REAL QDD_K(NTERM) ! MIXING RATIO OF DOWNDRAUGHT IN DDCALL2A.379
! LAYER K (KG/KG) DDCALL2A.380
C DDCALL2A.381
REAL THDD_K(NTERM) ! MODEL POTENTIAL TEMPERATURE DDCALL2A.382
! OF DOWNDRAUGHT IN LAYER K (K) DDCALL2A.383
C DDCALL2A.384
REAL FLX_DD_K(NPNTS) ! DOWNDRAUGHT INITIAL MASS FLUX DDCALL2A.385
! (PA/S) DDCALL2A.386
C DDCALL2A.387
REAL FLX_DD_K_C(NTERM) ! COMPRESSED DOWNDRAUGHT INITIAL DDCALL2A.388
! MASS FLUX (PA/S) DDCALL2A.389
C DDCALL2A.390
LOGICAL BDDI(NPNTS) ! MASK FOR POINTS WHERE DOWNDRAUGHT DDCALL2A.391
! MIGHT OCCUR DDCALL2A.392
C DDCALL2A.393
LOGICAL BDDI_C(NTERM) ! COMPRESSED MASK FOR POINTS WHERE DDCALL2A.394
! DOWNDRAUGHT MAY INITIATE DDCALL2A.395
C DDCALL2A.396
INTEGER INDEX1(NTERM) ! INDEX FOR COMPRESS AND EXPAND DDCALL2A.397
C DDCALL2A.398
REAL QE_K_C(NTERM) ! COMPRESSED ENVIRONMENT MIXING DDCALL2A.399
! RATIO OF LAYER K (KG/KG) DDCALL2A.400
C DDCALL2A.401
REAL QE_KM1_C(NTERM) ! COMPRESSED ENVIRONMENT MIXING DDCALL2A.402
! RATIO OF LAYER K-1 (KG/KG) DDCALL2A.403
C DDCALL2A.404
REAL THE_K_C(NTERM) ! COMPRESSED POTENTIAL TEMPERATURE DDCALL2A.405
! OF ENVIRONMENT IN LAYER K (K) DDCALL2A.406
C DDCALL2A.407
REAL THE_KM1_C(NTERM) ! COMPRESSED POTENTIAL TEMPERATURE DDCALL2A.408
! OF ENVIRONMENT IN LAYER K-1 (K) DDCALL2A.409
C DDCALL2A.410
REAL RAIN_C(NTERM) ! COMPRESSED SURFACE RAINFALL DDCALL2A.411
! (KG/M**2/S) DDCALL2A.412
C DDCALL2A.413
REAL SNOW_C(NTERM) ! COMPRESSED SURFACE SNOWFALL DDCALL2A.414
! (KG/M**2/S) DDCALL2A.415
C DDCALL2A.416
REAL FLX_UD_K_C(NTERM) ! UPDRAUGHT MASS FLUX AT LAYER K DDCALL2A.417
C DDCALL2A.418
REAL RAIN_ENV(NTERM) ! AMOUNT OF RAINFALL PASSING THROUGH DDCALL2A.419
! ENVIRONMENT (KG/M**2/S) DDCALL2A.420
C DDCALL2A.421
REAL SNOW_ENV(NTERM) ! AMOUNT OF SNOWFALL PASSING THROUGH DDCALL2A.422
! ENVIRONMENT (KG/M**2/S) DDCALL2A.423
C DDCALL2A.424
REAL RAIN_DD(NTERM) ! AMOUNT OF RAINFALL PASSING THROUGH DDCALL2A.425
! DOWNDRAUGHT (KG/M**2/S) DDCALL2A.426
C DDCALL2A.427
REAL SNOW_DD(NTERM) ! AMOUNT OF SNOWFALL PASSING THROUGH DDCALL2A.428
! DOWNDRAUGHT (KG/M**2/S) DDCALL2A.429
C DDCALL2A.430
LOGICAL BDD_START(NPNTS) ! MASK FOR THOSE POINT WHERE DDCALL2A.431
! DOWNDRAUGHT IS ABLE TO START DDCALL2A.432
! FROM LEVEL K DDCALL2A.433
C DDCALL2A.434
LOGICAL BDD_START_C(NTERM) ! COMPRESSED MASK FOR THOSE POINT DDCALL2A.435
! WHERE DOWNDRAUGHT IS ABLE TO START DDCALL2A.436
! FROM LEVEL K DDCALL2A.437
C DDCALL2A.438
LOGICAL BDDWT_K(NPNTS) ! MASK FOR POINTS IN DOWNDRAUGHT DDCALL2A.439
! WHERE PPT IN LAYER K IS LIQUID DDCALL2A.440
C DDCALL2A.441
LOGICAL BDDWT_K_C(NTERM) ! COMPRESSED MASK FOR POINTS IN DD DDCALL2A.442
! WHERE PPT IN LAYER K IS LIQUID DDCALL2A.443
C DDCALL2A.444
LOGICAL BDDWT_KM1(NPNTS) ! MASK FOR POINTS IN DOWNDRAUGHT DDCALL2A.445
! WHERE PPT IN LAYER K-1 IS LIQUID DDCALL2A.446
C DDCALL2A.447
LOGICAL BDDWT_KM1_C(NTERM) ! COMPRESSED MASK FOR POINTS IN DD DDCALL2A.448
! WHERE PPT IN LAYER K-1 IS LIQUID DDCALL2A.449
C DDCALL2A.450
LOGICAL BDD_ON(NPNTS) ! MASK FOR THOSE POINTS WHERE DD DDCALL2A.451
! CONTINUES FROM LAYER K+1 DDCALL2A.452
C DDCALL2A.453
LOGICAL BDD_ON_C(NTERM) ! COMPRESSED MASK FOR POINTS WHERE DD DDCALL2A.454
! CONTINUES FROM LAYER K+1 DDCALL2A.455
C DDCALL2A.456
INTEGER KMIN(NTERM) ! FREEZING LEVEL WHERE ENTRAINMENT DDCALL2A.457
! RATES ARE INCREASED DDCALL2A.458
C DDCALL2A.459
REAL FLX_STRT(NPNTS) ! MASSFLUX AT LEVEL WHERE DOWNDRAUGHT DDCALL2A.460
! STARTS (PA/S) DDCALL2A.461
C DDCALL2A.462
REAL FLX_STRT_C(NTERM) ! COMPRESSED VALUE OF FLX_STRT DDCALL2A.463
C DDCALL2A.464
REAL CCA_C(NTERM) ! COMPRESSED CONVECTIVE CLOUD AMOUNT DDCALL2A.465
C DDCALL2A.466
INTEGER INDEX2(NTERM) ! INDEX OF WHERE ACTICE DOWNDRAUGHT DDCALL2A.467
! OCCURS DDCALL2A.468
C DDCALL2A.469
REAL LR_UD_REF(NTERM) ! PRECIPITATION MIXING RATIO AT LOWEST DG060893.17
! PRECIPITATING LEVEL OF UD DG060893.18
C DG060893.19
C DDCALL2A.471
C----------------------------------------------------------------------- DDCALL2A.472
C----------------------------------------------------------------------- DDCALL2A.473
C EXTERNAL ROUTINES CALLED DDCALL2A.474
C----------------------------------------------------------------------- DDCALL2A.475
C DDCALL2A.476
EXTERNAL FLX_INIT, LAYER_DD, DD_INIT, DOWND DDCALL2A.477
C DDCALL2A.481
C----------------------------------------------------------------------- DDCALL2A.482
C CALCULATE INDEX FOR COMPRESS ON BASIS OF BTERM DDCALL2A.483
C----------------------------------------------------------------------- DDCALL2A.484
C DDCALL2A.485
NDD = 0 DDCALL2A.486
DO I=1,NPNTS DDCALL2A.490
IF (BTERM(I)) THEN DDCALL2A.491
NDD = NDD+1 DDCALL2A.492
INDEX1(NDD) = I DDCALL2A.493
END IF DDCALL2A.494
END DO DDCALL2A.495
C DDCALL2A.497
C---------------------------------------------------------------------- DDCALL2A.498
C INITIALISE LOGICAL ARRAYS AS FALSE DDCALL2A.499
C----------------------------------------------------------------------- DDCALL2A.500
C DDCALL2A.501
DO I=1,NPNTS DDCALL2A.502
BDDI(I) = .FALSE. DDCALL2A.503
BDD_START(I) = .FALSE. DDCALL2A.504
BDDWT_K(I) = .FALSE. DDCALL2A.505
BDDWT_KM1(I) = .FALSE. DDCALL2A.506
BDD_ON(I) = .FALSE. DDCALL2A.507
C DDCALL2A.508
C----------------------------------------------------------------------- DDCALL2A.509
C CALCULATE MASK FOR THOSE POINT WHERE DOWNDRAUGHT MIGHT OCCUR DDCALL2A.510
C AND LEVEL AT WHICH IT MIGHT INITIATE DDCALL2A.511
C----------------------------------------------------------------------- DDCALL2A.512
C DDCALL2A.513
IF (KCT .GE. 4 .AND. BTERM(I) .AND. BGMK(I) .AND. (KCT-ICCB(I)) DDCALL2A.514
& .GT. 2) BDDI(I) = .TRUE. DDCALL2A.515
END DO DDCALL2A.516
C DDCALL2A.517
C---------------------------------------------------------------------- DDCALL2A.518
C CALCULATE INITIAL DOWNDRAUGHT MASS FLUX DDCALL2A.519
C----------------------------------------------------------------------- DDCALL2A.520
C DDCALL2A.521
IF (KCT .GE. 4) DDCALL2A.522
* CALL FLX_INIT (NPNTS,KCT,ICCB,ICCT,FLX,FLX_DD_K,BDDI,FLX_STRT) DDCALL2A.523
C DDCALL2A.524
C----------------------------------------------------------------------- DDCALL2A.525
C COMPRESS ALL INPUT ARRAYS FOR THE DOWNDRAUGHT CALCULATION DDCALL2A.526
C----------------------------------------------------------------------- DDCALL2A.527
C DDCALL2A.528
DO 10 K = KCT+1,2,-1 DDCALL2A.529
C DDCALL2A.530
DO I=1,NDD DDCALL2A.531
TH_K_C(I) = THP(INDEX1(I),K) DDCALL2A.532
Q_K_C(I) = QP(INDEX1(I),K) DDCALL2A.533
THE_K_C(I) = THE(INDEX1(I),K) DDCALL2A.534
THE_KM1_C(I) = THE(INDEX1(I),K-1) DDCALL2A.535
QE_K_C(I) = QE(INDEX1(I),K) DDCALL2A.536
QE_KM1_C(I) = QE(INDEX1(I),K-1) DDCALL2A.537
DTHBYDT_K_C(I) = DTHBYDT(INDEX1(I),K) DDCALL2A.538
DTHBYDT_KM1_C(I) = DTHBYDT(INDEX1(I),K-1) DDCALL2A.539
DQBYDT_K_C(I) = DQBYDT(INDEX1(I),K) DDCALL2A.540
DQBYDT_KM1_C(I) = DQBYDT(INDEX1(I),K-1) DDCALL2A.541
EXNER_KM12_C(I) = EXNER(INDEX1(I),K) DDCALL2A.542
EXNER_KP12_C(I) = EXNER(INDEX1(I),K+1) DDCALL2A.543
EXNER_KM32_C(I) = EXNER(INDEX1(I),K-1) DDCALL2A.544
PRECIP_K_C(I) = PRECIP(INDEX1(I),K) DDCALL2A.545
FLX_UD_K_C(I) = FLX(INDEX1(I),K) DDCALL2A.546
BWATER_K_C(I) = BWATER(INDEX1(I),K) DDCALL2A.547
END DO DDCALL2A.548
IF (K.EQ.KCT+1) THEN DDCALL2A.549
DO I=1,NDD DDCALL2A.550
FLX_DD_K_C(I) = FLX_DD_K(INDEX1(I)) DDCALL2A.551
FLX_STRT_C(I) = FLX_STRT(INDEX1(I)) DDCALL2A.552
PSTAR_C(I) = PSTAR(INDEX1(I)) DDCALL2A.553
recip_pstar_c(I)=recip_pstar(index1(I)) GSS1F403.265
ICCB_C(I) = ICCB(INDEX1(I)) DDCALL2A.554
BDDI_C(I) = BDDI(INDEX1(I)) DDCALL2A.555
BDD_START_C(I) = BDD_START(INDEX1(I)) DDCALL2A.556
RAIN_C(I) = RAIN(INDEX1(I)) DDCALL2A.557
SNOW_C(I) = SNOW(INDEX1(I)) DDCALL2A.558
BDDWT_K_C(I) = BDDWT_K(INDEX1(I)) DDCALL2A.559
BDDWT_KM1_C(I) = BDDWT_KM1(INDEX1(I)) DDCALL2A.560
BDD_ON_C(I) = BDD_ON(INDEX1(I)) DDCALL2A.561
CCA_C(I) = CCA(INDEX1(I)) DDCALL2A.562
LR_UD_REF(I) = 0.0 DG060893.20
END DO DDCALL2A.563
END IF DDCALL2A.564
C DDCALL2A.565
C---------------------------------------------------------------------- DG060893.21
C IF BELOW CONVECTIVE CLOUD BASE DOWNDRAUGHT NOT ALLOWED TO FORM DG060893.22
C---------------------------------------------------------------------- DG060893.23
C DG060893.24
DO I=1,NDD DG060893.25
IF (K.LT.ICCB_C(I)) BDDI_C(I)=.FALSE. DG060893.26
END DO DG060893.27
C DG060893.28
C----------------------------------------------------------------------- DDCALL2A.566
C RESET EN/DETRAINMENT RATES FOR DOWNDRAUGHT DDCALL2A.567
C----------------------------------------------------------------------- DDCALL2A.568
C DDCALL2A.569
CALL LAYER_DD (NDD,K,KCT,THE_K_C,THE_KM1_C,FLX_STRT_C,AK,BK, DDCALL2A.570
* AKM12,BKM12,DELAK,DELBK,EXNER_KM12_C,EXNER_KP12_C, DDCALL2A.571
* EXNER_KM32_C,PSTAR_C,PK,P_KM1,DELPK,DELPKM1,EXK, DDCALL2A.572
* EXKM1,AMDETK,EKM14,EKM34,KMIN,BDDI_C, GSS1F403.267
* recip_pstar_c) GSS1F403.268
C DDCALL2A.574
C----------------------------------------------------------------------- DDCALL2A.575
C INITIALISE DOWNDRAUGHT DDCALL2A.576
C DOWNDRAUGHT NOT ALLOWED TO FORM FROM CLOUD TOP LAYER (KCT+1) DG060893.29
C OR FROM BELOW CLOUD BASE DG060893.30
C----------------------------------------------------------------------- DDCALL2A.577
C DDCALL2A.578
IF (KCT .GE. 4 .AND. K.LT.KCT+1) DG060893.31
& CALL DD_INIT(NDD,TH_K_C,Q_K_C,THE_K_C,QE_K_C,PK,EXK,THDD_K, DDCALL2A.580
& QDD_K,DELTD,DELQD,BDD_START_C,K,BDDI_C,BDD_ON_C) ARN2F304.348
C DDCALL2A.582
C----------------------------------------------------------------------- DDCALL2A.583
C UPDATE MASK FOR WHERE DOWNDRAUGHT OCCURS DDCALL2A.584
C----------------------------------------------------------------------- DDCALL2A.585
C DDCALL2A.586
DO I=1,NDD DDCALL2A.587
IF (BDD_START_C(I).OR.BDD_ON_C(I)) BDD_ON_C(I)=.TRUE. DDCALL2A.588
END DO DDCALL2A.589
C DDCALL2A.590
NDDON_TMP = 0 DDCALL2A.591
DO I=1,NDD DDCALL2A.595
IF (BDD_ON_C(I)) THEN DDCALL2A.596
NDDON_TMP = NDDON_TMP+1 DDCALL2A.597
END IF DDCALL2A.598
END DO DDCALL2A.599
C DDCALL2A.601
C----------------------------------------------------------------------- DDCALL2A.602
C CALL DOWNDRAUGHT ROUTINE DDCALL2A.603
C----------------------------------------------------------------------- DDCALL2A.604
C DDCALL2A.605
DDCALL2A.606
CALL DOWND(NDD,K,KCT,THDD_K,QDD_K,THE_K_C,THE_KM1_C,QE_K_C, DDCALL2A.607
& QE_KM1_C,DTHBYDT_K_C,DTHBYDT_KM1_C,DQBYDT_K_C, DDCALL2A.608
& DQBYDT_KM1_C,FLX_DD_K_C,P_KM1,DELPK,DELPKM1,EXK, DDCALL2A.609
& EXKM1,DELTD,DELQD,AMDETK,EKM14,EKM34,PRECIP_K_C, DDCALL2A.610
& RAIN_C,SNOW_C,ICCB_C,BWATER_K_C,BDD_START_C, DDCALL2A.611
& BDDWT_K_C,BDDWT_KM1_C,BDD_ON_C,RAIN_ENV,SNOW_ENV, DDCALL2A.612
& RAIN_DD,SNOW_DD,FLX_UD_K_C,TIMESTEP,CCA_C,NDDON_TMP, DG060893.34
& LR_UD_REF) DG060893.35
C DDCALL2A.614
C----------------------------------------------------------------------- DDCALL2A.615
C DECOMPRESS/EXPAND THOSE VARIABLES WHICH ARE TO BE OUTPUT DDCALL2A.616
C----------------------------------------------------------------------- DDCALL2A.617
C DDCALL2A.618
CDIR$ IVDEP DDCALL2A.619
! Fujitsu vectorization directive GRB0F405.217
!OCL NOVREC GRB0F405.218
DO I=1,NDD DDCALL2A.620
DTHBYDT(INDEX1(I),K) = DTHBYDT_K_C(I) DDCALL2A.621
DTHBYDT(INDEX1(I),K-1) = DTHBYDT_KM1_C(I) DDCALL2A.622
DQBYDT(INDEX1(I),K) = DQBYDT_K_C(I) DDCALL2A.623
DQBYDT(INDEX1(I),K-1) = DQBYDT_KM1_C(I) DDCALL2A.624
IF (K.EQ.2) THEN DDCALL2A.625
RAIN(INDEX1(I)) = RAIN_C(I) DDCALL2A.626
SNOW(INDEX1(I)) = SNOW_C(I) DDCALL2A.627
END IF DDCALL2A.628
PRECIP(INDEX1(I),K) = PRECIP_K_C(I) DDCALL2A.629
END DO DDCALL2A.630
C DDCALL2A.631
C---------------------------------------------------------------------- DDCALL2A.632
C END OF MAIN K LOOP DDCALL2A.633
C---------------------------------------------------------------------- DDCALL2A.634
C DDCALL2A.635
10 CONTINUE DDCALL2A.636
C DDCALL2A.637
RETURN DDCALL2A.638
END DDCALL2A.639
C DDCALL2A.640
*ENDIF DDCALL2A.641