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