SUBROUTINE DD_CALL (
NP_FIELD,NPNTS,KCT,THP,QP,THE,QE,DTHBYDT, DDCALL3A.39
* DQBYDT,FLX,PSTAR,AK,BK,AKM12,BKM12,DELAK, DDCALL3A.40
* DELBK,EXNER,PRECIP,RAIN,SNOW,ICCB,ICCT, DDCALL3A.41
* BWATER,BTERM,BGMK,TIMESTEP,CCA,NTERM,L_MOM, DDCALL3A.42
* UP,VP,UE,VE,DUBYDT,DVBYDT,EFLUX_U_DD, DDCALL3A.43
* EFLUX_V_DD,L_TRACER,NTRA, DDCALL3A.44
& TRAP,TRAE,DTRABYDT,NLEV,TRLEV,recip_pstar, API2F405.289
& DD_FLUX,FLG_DWN_FLX,ENTRAIN_DWN, API2F405.290
& FLG_ENTR_DWN,DETRAIN_DWN,FLG_DETR_DWN) API2F405.291
C DDCALL3A.46
IMPLICIT NONE DDCALL3A.47
C DDCALL3A.48
C----------------------------------------------------------------------- DDCALL3A.49
C VECTOR LENGTHS AND LOOP COUNTERS DDCALL3A.50
C----------------------------------------------------------------------- DDCALL3A.51
C DDCALL3A.52
C DDCALL3A.56
INTEGER I,KTRA ! LOOP COUNTERS DDCALL3A.57
C DDCALL3A.58
INTEGER K ! PRESENT MODEL LAYER DDCALL3A.59
C DDCALL3A.60
INTEGER NPNTS ! IN NUMBER OF POINTS DDCALL3A.61
C DDCALL3A.62
INTEGER NDD,NTERM ! COMPRESSED VECTOR LENGTH FOR DDCALL3A.63
! DOWNDRAUGHT CALCULATION DDCALL3A.64
C DDCALL3A.65
INTEGER NP_FIELD ! IN FULL VECTOR LENGTH DDCALL3A.66
C DDCALL3A.67
INTEGER NDDON_TMP ! NUMBER OF POINTS WITH ACTIVE DDCALL3A.68
! DOWNDRAUGHT DDCALL3A.69
C DDCALL3A.70
INTEGER NTRA ! NUMBER OF TRACER VARIABLES DDCALL3A.71
C DDCALL3A.72
INTEGER NLEV ! NUMBER OF MODEL LEVELS DDCALL3A.73
C DDCALL3A.74
INTEGER TRLEV ! NUMBER OF TRACER LEVELS DDCALL3A.75
C DDCALL3A.76
C DDCALL3A.77
C----------------------------------------------------------------------- DDCALL3A.78
C VARIABLES WHICH ARE INPUT DDCALL3A.79
C----------------------------------------------------------------------- DDCALL3A.80
C DDCALL3A.81
INTEGER KCT ! IN CONVECTIVE CLOUD TOP LAYER DDCALL3A.82
C DDCALL3A.83
REAL AK(KCT+1) ! IN ) HYBRID CO-ORDINATE VALUES AT DDCALL3A.84
REAL BK(KCT+1) ! IN ) MID-LAYER OF LAYER K DDCALL3A.85
C DDCALL3A.86
REAL AKM12(KCT+2) ! IN ) HYBRID CO-ORDINATE VALUES AT DDCALL3A.87
REAL BKM12(KCT+2) ! IN ) LOWER LAYER BOUNDARY OF LAYER K DDCALL3A.88
C DDCALL3A.89
REAL DELAK(KCT+1) ! IN ) HYBRID CO-ORDINATE VALUES FOR DDCALL3A.90
REAL DELBK(KCT+1) ! IN ) THICKNESS OF LAYER K DDCALL3A.91
C DDCALL3A.92
REAL EXNER(NP_FIELD,KCT+2) ! IN EXNER FUNCTION AT LAYER BOUNDARIES DDCALL3A.93
! STARTING AT LEVEL K-1/2 DDCALL3A.94
C DDCALL3A.95
REAL THP(NPNTS,KCT+1) ! IN POTENTIAL TEMPERATURE OF DDCALL3A.96
! PARCEL (K) DDCALL3A.97
C DDCALL3A.98
REAL QP(NPNTS,KCT+1) ! IN MODEL MIXING RATIO (KG/KG) DDCALL3A.99
C DDCALL3A.100
REAL UP(NPNTS,KCT+1) ! IN PARCEL U (M/S) DDCALL3A.101
C DDCALL3A.102
REAL VP(NPNTS,KCT+1) ! IN PARCEL V (M/S) DDCALL3A.103
C DDCALL3A.104
REAL TRAP(NPNTS,NLEV, ! IN PARCEL TRACER (KG/KG) ARB0F404.31
* NTRA) DDCALL3A.106
C DDCALL3A.107
REAL THE(NP_FIELD,KCT+1) ! IN MODEL ENVIRONMENTAL POTENTIAL DDCALL3A.108
! TEMPERATURE (K) DDCALL3A.109
C DDCALL3A.110
REAL QE(NP_FIELD,KCT+1) ! IN ENVIRONMENT MIXING RATIO DDCALL3A.111
! (KG/KG) DDCALL3A.112
C DDCALL3A.113
REAL UE(NP_FIELD,KCT+1) ! IN ENVIRONMENT U (M/S) API4F401.69
C DDCALL3A.115
REAL VE(NP_FIELD,KCT+1) ! IN ENVIRONMENT V (M/S) API4F401.70
C DDCALL3A.117
REAL TRAE(NP_FIELD,TRLEV, ! IN ENVIRONMENT TRACER (KG/KG) DDCALL3A.118
* NTRA) DDCALL3A.119
C DDCALL3A.120
REAL FLX(NPNTS,KCT+1) ! IN CONVECTIVE MASSFLUX (PA/S) DDCALL3A.121
C DDCALL3A.122
REAL PSTAR(NP_FIELD) ! IN SURFACE PRESSURE (PA) DDCALL3A.123
C DDCALL3A.124
REAL PRECIP(NPNTS,KCT+1) ! IN PRECIPITATION ADDED WHEN DDCALL3A.125
! DESCENDING FROM LAYER K TO K-1 DDCALL3A.126
! (KG/M**2/S) DDCALL3A.127
C DDCALL3A.128
INTEGER ICCB(NP_FIELD) ! IN CLOUD BASE LEVEL DDCALL3A.129
C DDCALL3A.130
INTEGER ICCT(NP_FIELD) ! IN CLOUD TOP LEVEL DDCALL3A.131
C DDCALL3A.132
REAL CCA(NP_FIELD) ! IN CONVECTIVE CLOUD AMOUNT DDCALL3A.133
C DDCALL3A.134
LOGICAL BWATER(NPNTS,2:KCT+1)!IN MASK FOR THOSE POINTS AT WHICH DDCALL3A.135
! CONDENSATE IS WATER IN LAYER K DDCALL3A.136
C DDCALL3A.137
LOGICAL BTERM(NPNTS) ! IN MASK FOR THOSE POINTS WHERE DDCALL3A.138
! UPDRAUGHT IS TERMINATING DDCALL3A.139
C DDCALL3A.140
LOGICAL BGMK(NPNTS) ! IN MASK FOR POINTS WHERE PARCEL IN DDCALL3A.141
! LAYER K IS SATURATED DDCALL3A.142
C DDCALL3A.143
LOGICAL L_TRACER ! IN SWITCH FOR INCLUSION OF TRACERS DDCALL3A.144
C DDCALL3A.145
LOGICAL L_MOM ! IN SWITCH FOR INCLUSION OF DDCALL3A.146
! MOMENTUM TRANSPORTS DDCALL3A.147
LOGICAL FLG_DWN_FLX ! STASH FLAG FOR DOWNDRAUGHT MASS FLUX API2F405.292
C DDCALL3A.148
LOGICAL FLG_ENTR_DWN ! STASH FLAG FOR DOWNDRAUGHT ENTRAINMNT API2F405.293
C API2F405.294
LOGICAL FLG_DETR_DWN ! STASH FLAG FOR DOWNDRAIGHT DETRANMNT API2F405.295
C API2F405.296
REAL TIMESTEP DDCALL3A.149
REAL recip_PSTAR(NP_FIELD)! Reciprocal of pstar array GSS1F403.297
C DDCALL3A.150
C----------------------------------------------------------------------- DDCALL3A.151
C VARIABLES WHICH ARE INPUT AND OUTPUT DDCALL3A.152
C----------------------------------------------------------------------- DDCALL3A.153
C DDCALL3A.154
REAL DTHBYDT(NP_FIELD,KCT+1) ! INOUT DDCALL3A.155
! IN INCREMENT TO MODEL POTENTIAL DDCALL3A.156
! TEMPERATURE (K/S) DDCALL3A.157
! OUT UPDATED INCREMENT TO MODEL DDCALL3A.158
! POTENTIAL TEMPERATURE (K/S) DDCALL3A.159
C DDCALL3A.160
REAL DQBYDT(NP_FIELD,KCT+1) ! INOUT DDCALL3A.161
! IN INCREMENT TO MODEL MIXING DDCALL3A.162
! RATIO (KG/KG/S) DDCALL3A.163
! OUT UPDATED INCREMENT TO MODEL DDCALL3A.164
! MIXING RATIO (KG/KG/S) DDCALL3A.165
C DDCALL3A.166
REAL DUBYDT(NP_FIELD,KCT+1) ! INOUT API4F401.71
! IN INCREMENT TO MODEL U (M/S) DDCALL3A.168
! OUT UPDATED INCREMENT TO MODEL U DDCALL3A.169
! (M/S) DDCALL3A.170
C DDCALL3A.171
REAL DVBYDT(NP_FIELD,KCT+1) ! INOUT API4F401.72
! IN INCREMENT TO MODEL V (M/S) DDCALL3A.173
! OUT UPDATED INCREMENT TO MODEL V DDCALL3A.174
! (M/S) DDCALL3A.175
C DDCALL3A.176
REAL DTRABYDT(NPNTS,NLEV, ! INOUT ARB0F404.32
* NTRA) ! IN INCREMENT TO MODEL DDCALL3A.178
! TRACER (KG/KG/S) DDCALL3A.179
! OUT UPDATED INCREMENT TO DDCALL3A.180
! MODEL TRACER (KG/KG/S) DDCALL3A.181
C DDCALL3A.182
REAL EFLUX_U_DD(NPNTS), ! INOUT DDCALL3A.183
* EFLUX_V_DD(NPNTS) ! IN EDDY FLUX OF MOMENTUM DUE TO DDCALL3A.184
! DD AT TOP OF A LAYER DDCALL3A.185
! OUT EDDY FLUX OF MOMENTUM DUE TO DDCALL3A.186
! DD AT BOTTOM OF A LAYER DDCALL3A.187
C DDCALL3A.188
C DDCALL3A.189
C----------------------------------------------------------------------- DDCALL3A.190
C VARIABLES WHICH ARE OUTPUT DDCALL3A.191
C----------------------------------------------------------------------- DDCALL3A.192
C DDCALL3A.193
REAL RAIN(NP_FIELD) ! OUT RAINFALL AT SURFACE (KG/M**2/S) DDCALL3A.194
C DDCALL3A.195
REAL SNOW(NP_FIELD) ! OUT SNOWFALL AT SURFACE (KG/M**2/S) DDCALL3A.196
C DDCALL3A.197
REAL DD_FLUX(NP_FIELD,KCT+1) ! OUT DOWN DRAUGHT MASS FLUX API2F405.297
C API2F405.298
REAL ENTRAIN_DWN(NP_FIELD,KCT+1) ! OUT FRACTIONAL ENTRAINMENT API2F405.299
! RATE FOR DOWN DRAUGHT API2F405.300
C API2F405.301
REAL DETRAIN_DWN(NP_FIELD,KCT+1) ! OUT FRACTIONAL DETRAINMENT API2F405.302
! RATE FOR DOWNDRAUGHT API2F405.303
C----------------------------------------------------------------------- DDCALL3A.198
C VARIABLES WHICH ARE DEFINED LOCALLY DDCALL3A.199
C----------------------------------------------------------------------- DDCALL3A.200
C DDCALL3A.201
REAL EXNER_KM12_C(NTERM) ! COMPRESSED EXNER FUNCTION AT DDCALL3A.436
! LAYER K DDCALL3A.437
C DDCALL3A.438
REAL EXNER_KP12_C(NTERM) ! COMPRESSED EXNER FUNCTION AT DDCALL3A.439
! LAYER K+1 DDCALL3A.440
C DDCALL3A.441
REAL EXNER_KM32_C(NTERM) ! COMPRESSED EXNER FUNCTION AT DDCALL3A.442
! LAYER K-1 DDCALL3A.443
C DDCALL3A.444
REAL PK(NTERM) ! PRESSURE OF LAYER K (PA) DDCALL3A.445
C DDCALL3A.446
REAL P_KM1(NTERM) ! PRESSURE OF LAYER K-1 (PA) DDCALL3A.447
C DDCALL3A.448
REAL EXK(NTERM) ! EXNER RATIO FOR LAYER K DDCALL3A.449
C DDCALL3A.450
REAL EXKM1(NTERM) ! EXNER RATIO FOR LAYER K-1 DDCALL3A.451
C DDCALL3A.452
REAL DELPK(NTERM) ! PRESSURE DIFFERENCE ACROSS LAYER K DDCALL3A.453
! (PA) DDCALL3A.454
C DDCALL3A.455
REAL DELPKM1(NTERM) ! PRESSURE DIFFERENCE ACROSS DDCALL3A.456
! LAYER K-1 (PA) DDCALL3A.457
C DDCALL3A.458
REAL AMDETK(NTERM) ! MIXING DETRAINMENT AT LEVEL K DDCALL3A.459
! MULTIPLIED BY APPROPRIATE LAYER DDCALL3A.460
! THICKNESS DDCALL3A.461
C DDCALL3A.462
REAL EKM14(NTERM) ! EXNER RATIO AT LAYER K-1/4 DDCALL3A.463
C DDCALL3A.464
REAL EKM34(NTERM) ! EXNER RATIO AT LAYER K-3/4 DDCALL3A.465
C DDCALL3A.466
LOGICAL BWATER_K_C(NTERM) ! COMPRESSED MASK FOR THOSE DDCALL3A.467
! POINTS AT WHICH CONDENSATE DDCALL3A.468
! IS WATER IN LAYER K DDCALL3A.469
C DDCALL3A.470
REAL PRECIP_K_C(NTERM) ! COMPRESSED PRECIPITATION DDCALL3A.471
! ADDED WHEN DESCENDING FROM DDCALL3A.472
! LAYER K TO K-1 (KG/M**2/S) DDCALL3A.473
C DDCALL3A.474
REAL Q_K_C(NTERM) ! COMPRESSED PARCEL MIXING RATIO DDCALL3A.475
! OF LAYER K (KG/KG) DDCALL3A.476
C DDCALL3A.477
REAL TH_K_C(NTERM) ! COMPRESSED PARCEL POTENTIAL DDCALL3A.478
! TEMPERATURE OF LAYER K (K) DDCALL3A.479
C DDCALL3A.480
REAL U_K_C(NTERM) ! COMPRESSED PARCEL U IN LAYER K (M/S) DDCALL3A.481
C DDCALL3A.482
REAL V_K_C(NTERM) ! COMPRESSED PARCEL V IN LAYER K (M/S) DDCALL3A.483
C DDCALL3A.484
REAL TRA_K_C(NTERM,NTRA) ! COMPRESSED PARCEL TRACER IN DDCALL3A.485
! LAYER K (KG/KG) DDCALL3A.486
C DDCALL3A.487
REAL PSTAR_C(NTERM) ! COMPRESSED SURFACE PRESSURE (PA) DDCALL3A.488
C DDCALL3A.489
REAL recip_PSTAR_C(NTERM) ! Reciprocal of comp. pstar array GSS1F403.302
C GSS1F403.306
INTEGER ICCB_C(NTERM) ! COMPRESSED CLOUD BASE LEVEL DDCALL3A.490
C DDCALL3A.491
REAL DTHBYDT_K_C(NTERM) ! COMPRESSED INCREMENT TO MODEL DDCALL3A.492
! POTENTIAL TEMPERATURE OF LAYER K DDCALL3A.493
! (K/S) DDCALL3A.494
C DDCALL3A.495
REAL DTHBYDT_KM1_C(NTERM) ! COMPRESSED INCREMENT TO MODEL DDCALL3A.496
! POTENTIAL TEMPERATURE OF LAYER K-1 DDCALL3A.497
! (K/S) DDCALL3A.498
C DDCALL3A.499
REAL DQBYDT_K_C(NTERM) ! COMPRESSED INCREMENT TO MODEL DDCALL3A.500
! MIXING RATIO OF LAYER K (KG/KG/S) DDCALL3A.501
C DDCALL3A.502
REAL DQBYDT_KM1_C(NTERM) ! COMPRESSED INCREMENT TO MODEL DDCALL3A.503
! MIXING RATIO OF LAYER K-1 (KG/KG/S) DDCALL3A.504
C DDCALL3A.505
REAL DUBYDT_K_C(NTERM) ! COMPRESSED INCREMENT TO MODEL DDCALL3A.506
! U IN LAYER K (M/S) DDCALL3A.507
C DDCALL3A.508
REAL DUBYDT_KM1_C(NTERM) ! COMPRESSED INCREMENT TO MODEL DDCALL3A.509
! U IN LAYER K-1 (M/S) DDCALL3A.510
C DDCALL3A.511
REAL DVBYDT_K_C(NTERM) ! COMPRESSED INCREMENT TO MODEL DDCALL3A.512
! V IN LAYER K (M/S) DDCALL3A.513
C DDCALL3A.514
REAL DVBYDT_KM1_C(NTERM) ! COMPRESSED INCREMENT TO MODEL DDCALL3A.515
! V IN LAYER K-1 (M/S) DDCALL3A.516
C DDCALL3A.517
REAL DTRA_K_C(NTERM,NTRA) ! COMPRESSED INCREMENT TO MODEL DDCALL3A.518
! TRACER OF LAYER K (KG/KG/S) DDCALL3A.519
C DDCALL3A.520
REAL DTRA_KM1_C(NTERM,NTRA)! COMPRESSED INCREMENT TO MODEL DDCALL3A.521
! TRACER OF LAYER K-1 (KG/KG/S) DDCALL3A.522
C DDCALL3A.523
REAL DELTD(NTERM) ! COOLING NECESSARY TO DDCALL3A.524
! ACHIEVE SATURATION (K) DDCALL3A.525
C DDCALL3A.526
REAL DELQD(NTERM) ! MOISTENING NECESSARY TO DDCALL3A.527
! ACHIEVE SATURATION (KG/KG) DDCALL3A.528
C DDCALL3A.529
REAL DELUD(NTERM) ! CHANGE TO ENVIRONMENT U DUE TO DDCALL3A.530
! DOWNDRAUGHT FORMATION (M/S) DDCALL3A.531
C DDCALL3A.532
REAL DELVD(NTERM) ! CHANGE TO ENVIRONMENT V DUE TO DDCALL3A.533
! DOWNDRAUGHT FORMATION (M/S) DDCALL3A.534
C DDCALL3A.535
REAL DELTRAD(NTERM,NTRA) ! DEPLETION OF ENVIRONMENT TRACER DDCALL3A.536
! DUE TO DOWNDRAUGHT FORMATION (KG/KG) DDCALL3A.537
C DDCALL3A.538
REAL QDD_K(NTERM) ! MIXING RATIO OF DOWNDRAUGHT IN DDCALL3A.539
! LAYER K (KG/KG) DDCALL3A.540
C DDCALL3A.541
REAL THDD_K(NTERM) ! MODEL POTENTIAL TEMPERATURE DDCALL3A.542
! OF DOWNDRAUGHT IN LAYER K (K) DDCALL3A.543
C DDCALL3A.544
REAL UDD_K(NTERM) ! MODEL U IN DOWNDRAUGHT IN LAYER DDCALL3A.545
! K (M/S) DDCALL3A.546
C DDCALL3A.547
REAL VDD_K(NTERM) ! MODEL V IN DOWNDRAUGHT IN LAYER DDCALL3A.548
! K (M/S) DDCALL3A.549
C DDCALL3A.550
REAL TRADD_K(NTERM,NTRA) ! MODEL TRACER OF DOWNDRAUGHT DDCALL3A.551
! IN LAYER K (KG/KG) DDCALL3A.552
C DDCALL3A.553
REAL FLX_DD_K(NPNTS) ! DOWNDRAUGHT INITIAL MASS FLUX DDCALL3A.554
! (PA/S) DDCALL3A.555
C DDCALL3A.556
REAL FLX_DD_K_C(NTERM) ! COMPRESSED DOWNDRAUGHT INITIAL DDCALL3A.557
! MASS FLUX (PA/S) DDCALL3A.558
C DDCALL3A.559
LOGICAL BDDI(NPNTS) ! MASK FOR POINTS WHERE DOWNDRAUGHT DDCALL3A.560
! MIGHT OCCUR DDCALL3A.561
C DDCALL3A.562
LOGICAL BDDI_C(NTERM) ! COMPRESSED MASK FOR POINTS WHERE DDCALL3A.563
! DOWNDRAUGHT MAY INITIATE DDCALL3A.564
C DDCALL3A.565
INTEGER INDEX1(NTERM) ! INDEX FOR COMPRESS AND EXPAND DDCALL3A.566
C DDCALL3A.567
REAL QE_K_C(NTERM) ! COMPRESSED ENVIRONMENT MIXING DDCALL3A.568
! RATIO OF LAYER K (KG/KG) DDCALL3A.569
C DDCALL3A.570
REAL QE_KM1_C(NTERM) ! COMPRESSED ENVIRONMENT MIXING DDCALL3A.571
! RATIO OF LAYER K-1 (KG/KG) DDCALL3A.572
C DDCALL3A.573
REAL THE_K_C(NTERM) ! COMPRESSED POTENTIAL TEMPERATURE DDCALL3A.574
! OF ENVIRONMENT IN LAYER K (K) DDCALL3A.575
C DDCALL3A.576
REAL THE_KM1_C(NTERM) ! COMPRESSED POTENTIAL TEMPERATURE DDCALL3A.577
! OF ENVIRONMENT IN LAYER K-1 (K) DDCALL3A.578
C DDCALL3A.579
REAL UE_K_C(NTERM) ! COMPRESSED U OF ENVIRONMENT IN DDCALL3A.580
! LAYER K (M/S) DDCALL3A.581
C DDCALL3A.582
REAL UE_KM1_C(NTERM) ! COMPRESSED U OF ENVIRONMENT IN DDCALL3A.583
! LAYER K-1 (M/S) DDCALL3A.584
C DDCALL3A.585
REAL VE_K_C(NTERM) ! COMPRESSED V OF ENVIRONMENT IN DDCALL3A.586
! LAYER K (M/S) DDCALL3A.587
C DDCALL3A.588
REAL VE_KM1_C(NTERM) ! COMPRESSED V OF ENVIRONMENT IN DDCALL3A.589
! LAYER K-1 (M/S) DDCALL3A.590
C DDCALL3A.591
REAL EFLUX_U_DD_C(NTERM), ! COMPRESSED EDDY MOMENTUM FLUX AT DDCALL3A.592
* EFLUX_V_DD_C(NTERM) ! TOP OF LAYER DUE TO DD DDCALL3A.593
C DDCALL3A.594
REAL TRAE_K_C(NTERM,NTRA) ! COMPRESSED TRACER OF ENVIRONMENT DDCALL3A.595
! IN LAYER K (KG/KG) DDCALL3A.596
C DDCALL3A.597
REAL TRAE_KM1_C(NTERM,NTRA)! COMPRESSED TRACER OF ENVIRONMENT DDCALL3A.598
! IN LAYER K-1 (KG/KG) DDCALL3A.599
C DDCALL3A.600
REAL RAIN_C(NTERM) ! COMPRESSED SURFACE RAINFALL DDCALL3A.601
! (KG/M**2/S) DDCALL3A.602
C DDCALL3A.603
REAL SNOW_C(NTERM) ! COMPRESSED SURFACE SNOWFALL DDCALL3A.604
! (KG/M**2/S) DDCALL3A.605
C DDCALL3A.606
REAL FLX_UD_K_C(NTERM) ! UPDRAUGHT MASS FLUX AT LAYER K DDCALL3A.607
C DDCALL3A.608
REAL RAIN_ENV(NTERM) ! AMOUNT OF RAINFALL PASSING THROUGH DDCALL3A.609
! ENVIRONMENT (KG/M**2/S) DDCALL3A.610
C DDCALL3A.611
REAL SNOW_ENV(NTERM) ! AMOUNT OF SNOWFALL PASSING THROUGH DDCALL3A.612
! ENVIRONMENT (KG/M**2/S) DDCALL3A.613
C DDCALL3A.614
REAL RAIN_DD(NTERM) ! AMOUNT OF RAINFALL PASSING THROUGH DDCALL3A.615
! DOWNDRAUGHT (KG/M**2/S) DDCALL3A.616
C DDCALL3A.617
REAL SNOW_DD(NTERM) ! AMOUNT OF SNOWFALL PASSING THROUGH DDCALL3A.618
! DOWNDRAUGHT (KG/M**2/S) DDCALL3A.619
C DDCALL3A.620
LOGICAL BDD_START(NPNTS) ! MASK FOR THOSE POINT WHERE DDCALL3A.621
! DOWNDRAUGHT IS ABLE TO START DDCALL3A.622
! FROM LEVEL K DDCALL3A.623
C DDCALL3A.624
LOGICAL BDD_START_C(NTERM) ! COMPRESSED MASK FOR THOSE POINT DDCALL3A.625
! WHERE DOWNDRAUGHT IS ABLE TO START DDCALL3A.626
! FROM LEVEL K DDCALL3A.627
C DDCALL3A.628
LOGICAL BDDWT_K(NPNTS) ! MASK FOR POINTS IN DOWNDRAUGHT DDCALL3A.629
! WHERE PPT IN LAYER K IS LIQUID DDCALL3A.630
C DDCALL3A.631
LOGICAL BDDWT_K_C(NTERM) ! COMPRESSED MASK FOR POINTS IN DD DDCALL3A.632
! WHERE PPT IN LAYER K IS LIQUID DDCALL3A.633
C DDCALL3A.634
LOGICAL BDDWT_KM1(NPNTS) ! MASK FOR POINTS IN DOWNDRAUGHT DDCALL3A.635
! WHERE PPT IN LAYER K-1 IS LIQUID DDCALL3A.636
C DDCALL3A.637
LOGICAL BDDWT_KM1_C(NTERM) ! COMPRESSED MASK FOR POINTS IN DD DDCALL3A.638
! WHERE PPT IN LAYER K-1 IS LIQUID DDCALL3A.639
C DDCALL3A.640
LOGICAL BDD_ON(NPNTS) ! MASK FOR THOSE POINTS WHERE DD DDCALL3A.641
! CONTINUES FROM LAYER K+1 DDCALL3A.642
C DDCALL3A.643
LOGICAL BDD_ON_C(NTERM) ! COMPRESSED MASK FOR POINTS WHERE DD DDCALL3A.644
! CONTINUES FROM LAYER K+1 DDCALL3A.645
C DDCALL3A.646
INTEGER KMIN(NTERM) ! FREEZING LEVEL WHERE ENTRAINMENT DDCALL3A.647
! RATES ARE INCREASED DDCALL3A.648
C DDCALL3A.649
REAL FLX_STRT(NPNTS) ! MASSFLUX AT LEVEL WHERE DOWNDRAUGHT DDCALL3A.650
! STARTS (PA/S) DDCALL3A.651
C DDCALL3A.652
REAL FLX_STRT_C(NTERM) ! COMPRESSED VALUE OF FLX_STRT DDCALL3A.653
C DDCALL3A.654
REAL CCA_C(NTERM) ! COMPRESSED CONVECTIVE CLOUD AMOUNT DDCALL3A.655
C DDCALL3A.656
INTEGER INDEX2(NTERM) ! INDEX OF WHERE ACTICE DOWNDRAUGHT DDCALL3A.657
! OCCURS DDCALL3A.658
C DDCALL3A.659
REAL LR_UD_REF(NTERM) ! PRECIPITATION MIXING RATIO AT LOWEST DDCALL3A.660
! PRECIPITATING LEVEL OF UD DDCALL3A.661
C DDCALL3A.662
C DDCALL3A.664
REAL P_CLD_TOP ! PRESSURE AT CLOUD TOP (PA) DDCALL3A.665
C DDCALL3A.666
REAL P_CLD_BASE ! PRESSURE AT CLOUD BASE (PA) DDCALL3A.667
C----------------------------------------------------------------------- DDCALL3A.668
C----------------------------------------------------------------------- DDCALL3A.669
C EXTERNAL ROUTINES CALLED DDCALL3A.670
C----------------------------------------------------------------------- DDCALL3A.671
C DDCALL3A.672
EXTERNAL FLX_INIT, LAYER_DD, DD_INIT, DOWND DDCALL3A.673
C DDCALL3A.677
C----------------------------------------------------------------------- DDCALL3A.678
C CALCULATE INDEX FOR COMPRESS ON BASIS OF BTERM DDCALL3A.679
C----------------------------------------------------------------------- DDCALL3A.680
C DDCALL3A.681
NDD = 0 DDCALL3A.682
DO I=1,NPNTS DDCALL3A.686
IF (BTERM(I)) THEN DDCALL3A.687
NDD = NDD+1 DDCALL3A.688
INDEX1(NDD) = I DDCALL3A.689
END IF DDCALL3A.690
END DO DDCALL3A.691
C DDCALL3A.693
C---------------------------------------------------------------------- DDCALL3A.694
C INITIALISE LOGICAL ARRAYS AS FALSE DDCALL3A.695
C----------------------------------------------------------------------- DDCALL3A.696
C DDCALL3A.697
DO I=1,NPNTS DDCALL3A.698
BDDI(I) = .FALSE. DDCALL3A.699
BDD_START(I) = .FALSE. DDCALL3A.700
BDDWT_K(I) = .FALSE. DDCALL3A.701
BDDWT_KM1(I) = .FALSE. DDCALL3A.702
BDD_ON(I) = .FALSE. DDCALL3A.703
C DDCALL3A.704
C----------------------------------------------------------------------- DDCALL3A.705
C CALCULATE MASK FOR THOSE POINTS WHERE DOWNDRAUGHT MIGHT OCCUR DDCALL3A.706
C AND LEVEL AT WHICH IT MIGHT INITIATE DDCALL3A.707
C----------------------------------------------------------------------- DDCALL3A.708
C DDCALL3A.709
P_CLD_TOP =AK(KCT) + BK(KCT)*PSTAR(I) DDCALL3A.710
IF (ICCB(I).GT.0) THEN DDCALL3A.711
P_CLD_BASE = AK(ICCB(I)) + BK(ICCB(I))*PSTAR(I) DDCALL3A.712
ELSE DDCALL3A.713
P_CLD_BASE = P_CLD_TOP DDCALL3A.714
END IF DDCALL3A.715
C DDCALL3A.716
IF (P_CLD_TOP.LT.(PSTAR(I)-15000.0) .AND. DDCALL3A.717
& BTERM(I) .AND. BGMK(I) .AND. (P_CLD_BASE-P_CLD_TOP) DDCALL3A.718
& .GT. 15000.0) BDDI(I) = .TRUE. DDCALL3A.719
END DO DDCALL3A.720
C DDCALL3A.721
C---------------------------------------------------------------------- DDCALL3A.722
C CALCULATE INITIAL DOWNDRAUGHT MASS FLUX DDCALL3A.723
C----------------------------------------------------------------------- DDCALL3A.724
C DDCALL3A.725
CALL FLX_INIT (NPNTS,KCT,ICCB,ICCT,FLX,FLX_DD_K,BDDI,FLX_STRT) DDCALL3A.726
C DDCALL3A.727
C----------------------------------------------------------------------- DDCALL3A.728
C COMPRESS ALL INPUT ARRAYS FOR THE DOWNDRAUGHT CALCULATION DDCALL3A.729
C----------------------------------------------------------------------- DDCALL3A.730
C DDCALL3A.731
DO 10 K = KCT+1,2,-1 DDCALL3A.732
C DDCALL3A.733
DO I=1,NDD DDCALL3A.734
TH_K_C(I) = THP(INDEX1(I),K) DDCALL3A.735
Q_K_C(I) = QP(INDEX1(I),K) DDCALL3A.736
THE_K_C(I) = THE(INDEX1(I),K) DDCALL3A.737
THE_KM1_C(I) = THE(INDEX1(I),K-1) DDCALL3A.738
QE_K_C(I) = QE(INDEX1(I),K) DDCALL3A.739
QE_KM1_C(I) = QE(INDEX1(I),K-1) DDCALL3A.740
DTHBYDT_K_C(I) = DTHBYDT(INDEX1(I),K) DDCALL3A.741
DTHBYDT_KM1_C(I) = DTHBYDT(INDEX1(I),K-1) DDCALL3A.742
DQBYDT_K_C(I) = DQBYDT(INDEX1(I),K) DDCALL3A.743
DQBYDT_KM1_C(I) = DQBYDT(INDEX1(I),K-1) DDCALL3A.744
EXNER_KM12_C(I) = EXNER(INDEX1(I),K) DDCALL3A.745
EXNER_KP12_C(I) = EXNER(INDEX1(I),K+1) DDCALL3A.746
EXNER_KM32_C(I) = EXNER(INDEX1(I),K-1) DDCALL3A.747
PRECIP_K_C(I) = PRECIP(INDEX1(I),K) DDCALL3A.748
FLX_UD_K_C(I) = FLX(INDEX1(I),K) DDCALL3A.749
BWATER_K_C(I) = BWATER(INDEX1(I),K) DDCALL3A.750
END DO DDCALL3A.751
C DDCALL3A.752
IF(L_MOM)THEN DDCALL3A.753
DO I=1,NDD DDCALL3A.754
U_K_C(I) = UP(INDEX1(I),K) DDCALL3A.755
V_K_C(I) = VP(INDEX1(I),K) DDCALL3A.756
UE_K_C(I) = UE(INDEX1(I),K) DDCALL3A.757
UE_KM1_C(I) = UE(INDEX1(I),K-1) DDCALL3A.758
VE_K_C(I) = VE(INDEX1(I),K) DDCALL3A.759
VE_KM1_C(I) = VE(INDEX1(I),K-1) DDCALL3A.760
DUBYDT_K_C(I) = DUBYDT(INDEX1(I),K) DDCALL3A.761
DUBYDT_KM1_C(I) = DUBYDT(INDEX1(I),K-1) DDCALL3A.762
DVBYDT_K_C(I) = DVBYDT(INDEX1(I),K) DDCALL3A.763
DVBYDT_KM1_C(I) = DVBYDT(INDEX1(I),K-1) DDCALL3A.764
EFLUX_U_DD_C(I) = EFLUX_U_DD(INDEX1(I)) DDCALL3A.765
EFLUX_V_DD_C(I) = EFLUX_V_DD(INDEX1(I)) DDCALL3A.766
END DO DDCALL3A.767
END IF DDCALL3A.768
C DDCALL3A.769
IF(L_TRACER)THEN DDCALL3A.770
C DDCALL3A.771
DO KTRA=1,NTRA DDCALL3A.772
DO I=1,NDD DDCALL3A.773
TRA_K_C(I,KTRA) = TRAP(INDEX1(I),K,KTRA) DDCALL3A.774
TRAE_K_C(I,KTRA) = TRAE(INDEX1(I),K,KTRA) DDCALL3A.775
TRAE_KM1_C(I,KTRA) = TRAE(INDEX1(I),K-1,KTRA) DDCALL3A.776
DTRA_K_C(I,KTRA) = DTRABYDT(INDEX1(I),K,KTRA) DDCALL3A.777
DTRA_KM1_C(I,KTRA) = DTRABYDT(INDEX1(I),K-1,KTRA) DDCALL3A.778
END DO DDCALL3A.779
END DO DDCALL3A.780
C DDCALL3A.781
END IF DDCALL3A.782
C DDCALL3A.783
IF (K.EQ.KCT+1) THEN DDCALL3A.784
DO I=1,NDD DDCALL3A.785
FLX_DD_K_C(I) = FLX_DD_K(INDEX1(I)) DDCALL3A.786
FLX_STRT_C(I) = FLX_STRT(INDEX1(I)) DDCALL3A.787
PSTAR_C(I) = PSTAR(INDEX1(I)) DDCALL3A.788
recip_pstar_c(I)=recip_pstar(index1(I)) GSS1F403.308
ICCB_C(I) = ICCB(INDEX1(I)) DDCALL3A.789
BDDI_C(I) = BDDI(INDEX1(I)) DDCALL3A.790
BDD_START_C(I) = BDD_START(INDEX1(I)) DDCALL3A.791
RAIN_C(I) = RAIN(INDEX1(I)) DDCALL3A.792
SNOW_C(I) = SNOW(INDEX1(I)) DDCALL3A.793
BDDWT_K_C(I) = BDDWT_K(INDEX1(I)) DDCALL3A.794
BDDWT_KM1_C(I) = BDDWT_KM1(INDEX1(I)) DDCALL3A.795
BDD_ON_C(I) = BDD_ON(INDEX1(I)) DDCALL3A.796
CCA_C(I) = CCA(INDEX1(I)) DDCALL3A.797
LR_UD_REF(I) = 0.0 DDCALL3A.798
END DO DDCALL3A.799
END IF DDCALL3A.800
C DDCALL3A.801
C---------------------------------------------------------------------- DDCALL3A.802
C IF BELOW CONVECTIVE CLOUD BASE DOWNDRAUGHT NOT ALLOWED TO FORM DDCALL3A.803
C---------------------------------------------------------------------- DDCALL3A.804
C DDCALL3A.805
DO I=1,NDD DDCALL3A.806
IF (K.LT.ICCB_C(I)) BDDI_C(I)=.FALSE. DDCALL3A.807
END DO DDCALL3A.808
C DDCALL3A.809
C----------------------------------------------------------------------- DDCALL3A.810
C RESET EN/DETRAINMENT RATES FOR DOWNDRAUGHT DDCALL3A.811
C----------------------------------------------------------------------- DDCALL3A.812
C DDCALL3A.813
CALL LAYER_DD (NDD,K,KCT,THE_K_C,THE_KM1_C,FLX_STRT_C,AK,BK, DDCALL3A.814
* AKM12,BKM12,DELAK,DELBK,EXNER_KM12_C,EXNER_KP12_C, DDCALL3A.815
* EXNER_KM32_C,PSTAR_C,PK,P_KM1,DELPK,DELPKM1,EXK, DDCALL3A.816
* EXKM1,AMDETK,EKM14,EKM34,KMIN,BDDI_C, GSS1F403.310
* recip_pstar_c) GSS1F403.311
C---------------------------------------------------------------------- DDCALL3A.818
C IF LEVEL K WITHIN 150MB OF SURFACE THEN DOWNDRAUGHT NOT ALLOWED TO DDCALL3A.819
C FORM DDCALL3A.820
C---------------------------------------------------------------------- DDCALL3A.821
C DDCALL3A.822
DO I=1,NDD DDCALL3A.823
IF (PK(I).GT.(PSTAR_C(I)-15000.0)) BDDI_C(I)=.FALSE. DDCALL3A.824
END DO DDCALL3A.825
C DDCALL3A.826
C DDCALL3A.827
C----------------------------------------------------------------------- DDCALL3A.828
C INITIALISE DOWNDRAUGHT DDCALL3A.829
C DOWNDRAUGHT NOT ALLOWED TO FORM FROM CLOUD TOP LAYER (KCT+1) DDCALL3A.830
C OR FROM BELOW CLOUD BASE DDCALL3A.831
C----------------------------------------------------------------------- DDCALL3A.832
C DDCALL3A.833
CALL DD_INIT(NDD,NTERM,TH_K_C,Q_K_C,THE_K_C,QE_K_C,PK,EXK, DDCALL3A.834
& THDD_K,QDD_K,DELTD,DELQD,BDD_START_C,K,BDDI_C, DDCALL3A.835
& BDD_ON_C,L_MOM,U_K_C,V_K_C,UE_K_C,VE_K_C,UDD_K, DDCALL3A.836
& VDD_K,DELUD,DELVD,L_TRACER,NTRA,TRA_K_C, DDCALL3A.837
& TRAE_K_C,TRADD_K,DELTRAD) DDCALL3A.838
C DDCALL3A.839
C----------------------------------------------------------------------- DDCALL3A.840
C UPDATE MASK FOR WHERE DOWNDRAUGHT OCCURS DDCALL3A.841
C----------------------------------------------------------------------- DDCALL3A.842
C DDCALL3A.843
DO I=1,NDD DDCALL3A.844
IF (BDD_START_C(I).OR.BDD_ON_C(I)) BDD_ON_C(I)=.TRUE. DDCALL3A.845
END DO DDCALL3A.846
C DDCALL3A.847
NDDON_TMP = 0 DDCALL3A.848
DO I=1,NDD DDCALL3A.852
IF (BDD_ON_C(I)) THEN DDCALL3A.853
NDDON_TMP = NDDON_TMP+1 DDCALL3A.854
IF(FLG_DWN_FLX) DD_FLUX(INDEX1(I),K)=FLX_DD_K(INDEX1(I)) API2F405.304
END IF DDCALL3A.855
END DO DDCALL3A.856
C DDCALL3A.858
C----------------------------------------------------------------------- DDCALL3A.859
C CALL DOWNDRAUGHT ROUTINE DDCALL3A.860
C----------------------------------------------------------------------- DDCALL3A.861
C DDCALL3A.862
DDCALL3A.863
CALL DOWND(NDD,NTERM,K,KCT,THDD_K,QDD_K,THE_K_C,THE_KM1_C, DDCALL3A.864
& QE_K_C,QE_KM1_C,DTHBYDT_K_C,DTHBYDT_KM1_C,DQBYDT_K_C, DDCALL3A.865
& DQBYDT_KM1_C,FLX_DD_K_C,P_KM1,DELPK,DELPKM1,EXK, DDCALL3A.866
& EXKM1,DELTD,DELQD,AMDETK,EKM14,EKM34,PRECIP_K_C, DDCALL3A.867
& RAIN_C,SNOW_C,ICCB_C,BWATER_K_C,BDD_START_C, DDCALL3A.868
& BDDWT_K_C,BDDWT_KM1_C,BDD_ON_C,RAIN_ENV,SNOW_ENV, DDCALL3A.869
& RAIN_DD,SNOW_DD,FLX_UD_K_C,TIMESTEP,CCA_C,NDDON_TMP, DDCALL3A.870
& LR_UD_REF,L_MOM,UDD_K,VDD_K,UE_K_C,VE_K_C,UE_KM1_C, DDCALL3A.871
& VE_KM1_C,DUBYDT_K_C,DVBYDT_K_C,DUBYDT_KM1_C, DDCALL3A.872
& DVBYDT_KM1_C,DELUD,DELVD,EFLUX_U_DD_C,EFLUX_V_DD_C, DDCALL3A.873
& L_TRACER,NTRA,TRADD_K, DDCALL3A.874
& TRAE_K_C,TRAE_KM1_C,DTRA_K_C,DTRA_KM1_C,DELTRAD) DDCALL3A.875
C DDCALL3A.876
C----------------------------------------------------------------------- DDCALL3A.877
C DECOMPRESS/EXPAND THOSE VARIABLES WHICH ARE TO BE OUTPUT DDCALL3A.878
C----------------------------------------------------------------------- DDCALL3A.879
C DDCALL3A.880
CDIR$ IVDEP DDCALL3A.881
! Fujitsu vectorization directive GRB0F405.221
!OCL NOVREC GRB0F405.222
DO I=1,NDD DDCALL3A.882
DTHBYDT(INDEX1(I),K) = DTHBYDT_K_C(I) DDCALL3A.883
DTHBYDT(INDEX1(I),K-1) = DTHBYDT_KM1_C(I) DDCALL3A.884
DQBYDT(INDEX1(I),K) = DQBYDT_K_C(I) DDCALL3A.885
DQBYDT(INDEX1(I),K-1) = DQBYDT_KM1_C(I) DDCALL3A.886
IF (K.EQ.2) THEN DDCALL3A.887
RAIN(INDEX1(I)) = RAIN_C(I) DDCALL3A.888
SNOW(INDEX1(I)) = SNOW_C(I) DDCALL3A.889
END IF DDCALL3A.890
PRECIP(INDEX1(I),K) = PRECIP_K_C(I) DDCALL3A.891
END DO DDCALL3A.892
! API2F405.305
! NEED TO CHECK THAT POINT WOULD BE SELECTED IN S.R DOWND OR ELSE API2F405.306
! NOT SENSIBLE TO SET DIAGNOSTICS API2F405.307
! API2F405.308
IF(FLG_DWN_FLX) THEN API2F405.309
DO I=1,NDD API2F405.310
IF(BDD_ON_C(I)) THEN API2F405.311
DD_FLUX(INDEX1(I),K-1) = FLX_DD_K_C(I) API2F405.312
ENDIF API2F405.313
END DO API2F405.314
ENDIF API2F405.315
IF(FLG_ENTR_DWN) THEN API2F405.316
DO I=1,NDD API2F405.317
IF(BDD_ON_C(I)) THEN API2F405.318
ENTRAIN_DWN(INDEX1(I),K)=(1.0-AMDETK(I))* API2F405.319
& (EKM14(I)+EKM34(I)*(1.0+EKM14(I)))* API2F405.320
& DD_FLUX(INDEX1(I),K) API2F405.321
ENDIF API2F405.322
END DO API2F405.323
ENDIF API2F405.324
IF(FLG_DETR_DWN) THEN API2F405.325
DO I=1,NDD API2F405.326
IF(BDD_ON_C(I)) THEN API2F405.327
DETRAIN_DWN(INDEX1(I),K)=-AMDETK(I)*DD_FLUX(INDEX1(I),K) API2F405.328
ENDIF API2F405.329
END DO API2F405.330
ENDIF API2F405.331
API2F405.332
C DDCALL3A.893
IF(L_MOM)THEN DDCALL3A.894
DO I=1,NDD DDCALL3A.895
DUBYDT(INDEX1(I),K) = DUBYDT_K_C(I) DDCALL3A.896
DUBYDT(INDEX1(I),K-1) = DUBYDT_KM1_C(I) DDCALL3A.897
DVBYDT(INDEX1(I),K) = DVBYDT_K_C(I) DDCALL3A.898
DVBYDT(INDEX1(I),K-1) = DVBYDT_KM1_C(I) DDCALL3A.899
END DO DDCALL3A.900
END IF DDCALL3A.901
C DDCALL3A.902
IF(L_TRACER)THEN DDCALL3A.903
C DDCALL3A.904
DO KTRA=1,NTRA DDCALL3A.905
DO I=1,NDD DDCALL3A.906
DTRABYDT(INDEX1(I),K,KTRA) = DTRA_K_C(I,KTRA) DDCALL3A.907
DTRABYDT(INDEX1(I),K-1,KTRA) = DTRA_KM1_C(I,KTRA) DDCALL3A.908
END DO DDCALL3A.909
END DO DDCALL3A.910
C DDCALL3A.911
END IF DDCALL3A.912
C DDCALL3A.913
C---------------------------------------------------------------------- DDCALL3A.914
C END OF MAIN K LOOP DDCALL3A.915
C---------------------------------------------------------------------- DDCALL3A.916
C DDCALL3A.917
10 CONTINUE DDCALL3A.918
C DDCALL3A.919
RETURN DDCALL3A.920
END DDCALL3A.921
C DDCALL3A.922
*ENDIF DDCALL3A.923