*IF DEF,A09_2B LSCLD2B.2
! ******************************COPYRIGHT****************************** LSCLD2B.3
! (c) CROWN COPYRIGHT 1998, METEOROLOGICAL OFFICE, All Rights Reserved. LSCLD2B.4
! LSCLD2B.5
! Use, duplication or disclosure of this code is subject to the LSCLD2B.6
! restrictions as set forth in the contract. LSCLD2B.7
! LSCLD2B.8
! Meteorological Office LSCLD2B.9
! London Road LSCLD2B.10
! BRACKNELL LSCLD2B.11
! Berkshire UK LSCLD2B.12
! RG12 2SZ LSCLD2B.13
! LSCLD2B.14
! If no contract has been raised with this copy of the code, the use, LSCLD2B.15
! duplication or disclosure of it is strictly prohibited. Permission LSCLD2B.16
! to do so must first be obtained in writing from the Head of Numerical LSCLD2B.17
! Modelling at the above address. LSCLD2B.18
! ******************************COPYRIGHT****************************** LSCLD2B.19
! LSCLD2B.20
!+ Large-scale Cloud Scheme. LSCLD2B.21
! Subroutine Interface: LSCLD2B.22
SUBROUTINE LS_CLD( 2,8LSCLD2B.23
! Pressure related fields LSCLD2B.24
& AK, BK, PSTAR LSCLD2B.25
! Array dimensions LSCLD2B.26
&,LEVELS, RHCPT, POINTS, PFIELD LSCLD2B.27
! Prognostic Fields LSCLD2B.28
&,T, CF, Q, QCF, QCL LSCLD2B.29
! Liquid and frozen ice cloud fractions LSCLD2B.30
&,CFL, CFF LSCLD2B.31
&,ERROR) LSCLD2B.32
! LSCLD2B.33
IMPLICIT NONE LSCLD2B.34
! LSCLD2B.35
! Purpose: LSCLD2B.36
! This subroutine calculates liquid and ice cloud fractional cover LSCLD2B.37
! for use with the enhanced precipitation microphysics scheme. LSCLD2B.38
! LSCLD2B.39
! Method: LSCLD2B.40
! Statistical cloud scheme separates input moisture into specific LSCLD2B.41
! humidity and cloud liquid water. Temperature calculated from liquid LSCLD2B.42
! water temperature. Cloud fractions calculated from statistical LSCLD2B.43
! relation between cloud fraction and cloud liquid/ice water content. LSCLD2B.44
! Critical relative humidity now specified for all grid cells. LSCLD2B.45
! LSCLD2B.46
! Current Owner of Code: S. Cusack LSCLD2B.47
! LSCLD2B.48
! History: LSCLD2B.49
! Version Date Comment LSCLD2B.50
! 4.5 14-05-98 Original Code S. Cusack LSCLD2B.51
! LSCLD2B.52
! Description of Code: LSCLD2B.53
! FORTRAN 77 + common extensions also in Fortran90. LSCLD2B.54
! This code is written to UMDP3 version 6 programming standards. LSCLD2B.55
! LSCLD2B.56
! System component covered: P292 LSCLD2B.57
! LSCLD2B.58
! Documentation: UMDP No.29 LSCLD2B.59
! LSCLD2B.60
! Global Variables:---------------------------------------------------- LSCLD2B.61
*CALL C_MDI 
LSCLD2B.62
*CALL C_PI LSCLD2B.63
! LSCLD2B.64
! Subroutine Arguments:------------------------------------------------ LSCLD2B.65
INTEGER !, INTENT(IN) LSCLD2B.66
& LEVELS LSCLD2B.67
! No. of levels being processed. LSCLD2B.68
&,POINTS LSCLD2B.69
! No. of gridpoints being processed. LSCLD2B.70
&,PFIELD LSCLD2B.71
! No. of points in global field (at one vertical level). LSCLD2B.72
! LSCLD2B.73
REAL !, INTENT(IN) LSCLD2B.74
& QCF(PFIELD,LEVELS) LSCLD2B.75
! Cloud ice content at processed levels (kg water per kg air). LSCLD2B.76
&,PSTAR(PFIELD) LSCLD2B.77
! Surface pressure (Pa). LSCLD2B.78
&,AK(LEVELS) LSCLD2B.79
! Hybrid "A" co-ordinate. LSCLD2B.80
&,BK(LEVELS) LSCLD2B.81
! Hybrid "B" co-ordinate. LSCLD2B.82
&,RHCPT(PFIELD,LEVELS) LSCLD2B.83
! Critical relative humidity for all points LSCLD2B.84
! LSCLD2B.85
REAL !, INTENT(INOUT) LSCLD2B.86
& Q(PFIELD,LEVELS) LSCLD2B.87
! On input : Total water content (QW) (kg per kg air). LSCLD2B.88
! On output: Specific humidity at processed levels LSCLD2B.89
! (kg water per kg air). LSCLD2B.90
&,T(PFIELD,LEVELS) LSCLD2B.91
! On input : Liquid/frozen water temperature (TL) (K). LSCLD2B.92
! On output: Temperature at processed levels (K). LSCLD2B.93
! LSCLD2B.94
REAL !, INTENT(OUT) LSCLD2B.95
& CF(PFIELD,LEVELS) LSCLD2B.96
! Cloud fraction at processed levels (decimal fraction). LSCLD2B.97
&,QCL(PFIELD,LEVELS) LSCLD2B.98
! Cloud liquid water content at processed levels (kg per kg air). LSCLD2B.99
&,CFL(PFIELD,LEVELS) LSCLD2B.100
! Liquid cloud fraction at processed levels (decimal fraction). LSCLD2B.101
&,CFF(PFIELD,LEVELS) LSCLD2B.102
! Frozen cloud fraction at processed levels (decimal fraction). LSCLD2B.103
! LSCLD2B.104
! Error Status: LSCLD2B.105
INTEGER ERROR !, INTENT(OUT) 0 if OK; 1 if bad arguments. LSCLD2B.106
! LSCLD2B.107
! Local parameters and other physical constants------------------------ LSCLD2B.108
REAL ROOTWO ! Sqrt(2.) LSCLD2B.109
! LSCLD2B.110
! Local scalars-------------------------------------------------------- LSCLD2B.111
! LSCLD2B.112
! (a) Scalars effectively expanded to workspace by the Cray (using LSCLD2B.113
! vector registers). LSCLD2B.114
REAL LSCLD2B.115
& QCFRBS ! qCF / bs LSCLD2B.116
&,PHIQCF ! Arc-cosine term in Cloud ice fraction calc. LSCLD2B.117
&,COSQCF ! Cosine term in Cloud ice fraction calc. LSCLD2B.118
! LSCLD2B.119
! (b) Others. LSCLD2B.120
INTEGER K,I ! Loop counters: K - vertical level index. LSCLD2B.121
! ! I - horizontal field index. LSCLD2B.122
INTEGER QC_POINTS ! No. points with non-zero cloud LSCLD2B.123
! LSCLD2B.124
! Local dynamic arrays------------------------------------------------- LSCLD2B.125
! 7 blocks of real workspace are required. LSCLD2B.126
REAL LSCLD2B.127
& P(POINTS) LSCLD2B.128
! Pressure at successive levels (Pa). LSCLD2B.129
&,QSL(POINTS) LSCLD2B.130
! Saturated specific humidity for temp TL or T. LSCLD2B.131
&,QN(POINTS) LSCLD2B.132
! Cloud water normalised with BS. LSCLD2B.133
&,GRID_QC(POINTS,LEVELS) LSCLD2B.134
! Gridbox mean saturation excess at processed levels LSCLD2B.135
! (kg per kg air). Set to RMDI when cloud is absent. LSCLD2B.136
&,BS(POINTS,LEVELS) LSCLD2B.137
! Maximum moisture fluctuation /6*sigma at processed levels LSCLD2B.138
! (kg per kg air). Set to RMDI when cloud is absent. LSCLD2B.139
LOGICAL LSCLD2B.140
& LQC(POINTS) ! True for points with non-zero cloud LSCLD2B.141
INTEGER LSCLD2B.142
& INDEX(POINTS) ! Index for points with non-zero cloud LSCLD2B.143
! LSCLD2B.144
! External subroutine calls: ------------------------------------------ LSCLD2B.145
EXTERNAL QSAT,QSAT_WAT,LS_CLD_C LSCLD2B.146
!- End of Header LSCLD2B.147
! ---------------------------------------------------------------------- LSCLD2B.148
! Check input arguments for potential over-writing problems. LSCLD2B.149
! ---------------------------------------------------------------------- LSCLD2B.150
ERROR=0 LSCLD2B.151
IF (POINTS.GT.PFIELD) THEN LSCLD2B.152
ERROR=1 LSCLD2B.153
GO TO 9999 LSCLD2B.154
END IF LSCLD2B.155
! LSCLD2B.156
! ==Main Block==-------------------------------------------------------- LSCLD2B.157
! Subroutine structure : LSCLD2B.158
! Loop round levels to be processed. LSCLD2B.159
! ---------------------------------------------------------------------- LSCLD2B.160
! Levels_do1: LSCLD2B.161
DO K=1,LEVELS LSCLD2B.162
! LSCLD2B.163
! ---------------------------------------------------------------------- LSCLD2B.164
! 1. Calculate QSAT at liquid/ice water temperature, TL, and initialize LSCLD2B.165
! cloud water, sub-grid distribution and fraction arrays. LSCLD2B.166
! This requires a preliminary calculation of the pressure. LSCLD2B.167
! NB: On entry to the subroutine 'T' is TL and 'Q' is QW. LSCLD2B.168
! ---------------------------------------------------------------------- LSCLD2B.169
! Points_do1: LSCLD2B.170
DO I=1, POINTS LSCLD2B.171
P(I) = AK(K) + PSTAR(I)*BK(K) LSCLD2B.172
QCL(I,K) = 0.0 LSCLD2B.173
CFL(I,K) = 0.0 LSCLD2B.174
GRID_QC(I,K) = RMDI LSCLD2B.175
BS(I,K) = RMDI LSCLD2B.176
END DO ! Points_do1 LSCLD2B.177
! LSCLD2B.178
CALL QSAT_WAT(QSL,T(1,K),P,POINTS) LSCLD2B.179
! LSCLD2B.180
! Points_do2: LSCLD2B.181
DO I=1, POINTS LSCLD2B.182
! Rhcrit_if: LSCLD2B.183
IF (RHCPT(I,K) .LT. 1.) THEN LSCLD2B.184
! ---------------------------------------------------------------------- LSCLD2B.185
! 2. Calculate the quantity QN = QC/BS = (QW/QSL-1)/(1-RHcrit) LSCLD2B.186
! if RHcrit is less than 1 LSCLD2B.187
! ---------------------------------------------------------------------- LSCLD2B.188
! LSCLD2B.189
QN(I) = (Q(I,K) / QSL(I) - 1.) / (1. - RHCPT(I,K)) LSCLD2B.190
! LSCLD2B.191
! ---------------------------------------------------------------------- LSCLD2B.192
! 3. Set logical variable for cloud, LQC, for the case RHcrit < 1; LSCLD2B.193
! where QN > -1, i.e. qW/qSAT(TL,P) > RHcrit, there is cloud LSCLD2B.194
! ---------------------------------------------------------------------- LSCLD2B.195
! LSCLD2B.196
LQC(I) = (QN(I) .GT. -1.) LSCLD2B.197
ELSE LSCLD2B.198
! ---------------------------------------------------------------------- LSCLD2B.199
! 2.a Calculate QN = QW - QSL if RHcrit equals 1 LSCLD2B.200
! ---------------------------------------------------------------------- LSCLD2B.201
! LSCLD2B.202
QN(I) = Q(I,K) - QSL(I) LSCLD2B.203
! LSCLD2B.204
! ---------------------------------------------------------------------- LSCLD2B.205
! 3.a Set logical variable for cloud, LQC, for the case RHcrit = 1; LSCLD2B.206
! where QN > 0, i.e. qW > qSAT(TL,P), there is cloud LSCLD2B.207
! ---------------------------------------------------------------------- LSCLD2B.208
! LSCLD2B.209
LQC(I) = (QN(I) .GT. 0.) LSCLD2B.210
END IF ! Rhcrit_if LSCLD2B.211
END DO ! Points_do2 LSCLD2B.212
! LSCLD2B.213
! ---------------------------------------------------------------------- LSCLD2B.214
! 4. Form index of points where non-zero liquid cloud fraction LSCLD2B.215
! ---------------------------------------------------------------------- LSCLD2B.216
! LSCLD2B.217
! Points_do3: LSCLD2B.218
QC_POINTS=0 LSCLD2B.219
DO I=1,POINTS LSCLD2B.220
IF (LQC(I)) THEN LSCLD2B.221
QC_POINTS = QC_POINTS + 1 LSCLD2B.222
INDEX(QC_POINTS) = I LSCLD2B.223
END IF LSCLD2B.224
END DO ! Points_do3 LSCLD2B.225
! LSCLD2B.226
! ---------------------------------------------------------------------- LSCLD2B.227
! 5. Call LS_CLD_C to calculate cloud water content, specific humidity, LSCLD2B.228
! water cloud fraction and determine temperature. LSCLD2B.229
! ---------------------------------------------------------------------- LSCLD2B.230
! Qc_points_if: LSCLD2B.231
IF (QC_POINTS .GT. 0) THEN LSCLD2B.232
CALL LS_CLD_C(P,QSL,QN,Q(1,K),T(1,K) LSCLD2B.233
& ,QCL(1,K),CFL(1,K),GRID_QC(1,K),BS(1,K) LSCLD2B.234
& ,INDEX,QC_POINTS,POINTS,RHCPT(1,K)) LSCLD2B.235
END IF ! Qc_points_if LSCLD2B.236
! LSCLD2B.237
! ---------------------------------------------------------------------- LSCLD2B.238
! 6. Calculate cloud fractions for ice clouds. LSCLD2B.239
! THIS IS STILL HIGHLY EXPERIMENTAL. LSCLD2B.240
! Begin by calculating Qsat(T,P), at Temperature, for estimate of bs. LSCLD2B.241
! ---------------------------------------------------------------------- LSCLD2B.242
CALL QSAT_WAT(QSL,T(1,K),P,POINTS) LSCLD2B.243
ROOTWO = SQRT(2.) LSCLD2B.244
! LSCLD2B.245
! Points_do4: LSCLD2B.246
DO I=1, POINTS LSCLD2B.247
! ---------------------------------------------------------------------- LSCLD2B.248
! 6a Calculate qCF/bs. LSCLD2B.249
! ---------------------------------------------------------------------- LSCLD2B.250
QCFRBS = QCF(I,K) / ((1. - RHCPT(I,K)) * QSL(I)) LSCLD2B.251
! LSCLD2B.252
! ---------------------------------------------------------------------- LSCLD2B.253
! 6b Calculate frozen cloud fraction from frozen cloud water content. LSCLD2B.254
! ---------------------------------------------------------------------- LSCLD2B.255
IF (QCFRBS .LE. 0.) THEN LSCLD2B.256
CFF(I,K) = 0.0 LSCLD2B.257
ELSEIF (0. .LT. QCFRBS .AND. (6. * QCFRBS) .LE. 1.) THEN LSCLD2B.258
CFF(I,K) = 0.5 * ((6. * QCFRBS)**(2./3.)) LSCLD2B.259
ELSEIF (1. .LT. (6.*QCFRBS) .AND. QCFRBS .LT. 1.) THEN LSCLD2B.260
PHIQCF = ACOS(ROOTWO * 0.75 * (1. - QCFRBS)) LSCLD2B.261
COSQCF = COS((PHIQCF + (4. * PI)) / 3.) LSCLD2B.262
CFF(I,K) = 1. - (4. * COSQCF * COSQCF) LSCLD2B.263
ELSEIF (QCFRBS .GE. 1.) THEN LSCLD2B.264
CFF(I,K) = 1. LSCLD2B.265
END IF LSCLD2B.266
! ---------------------------------------------------------------------- LSCLD2B.267
! 6c Calculate combined cloud fraction. LSCLD2B.268
! ---------------------------------------------------------------------- LSCLD2B.269
! Use maximum overlap condition LSCLD2B.270
! CF(I,K) = MAX(CFL(I,K), CFF(I,K)) LSCLD2B.271
! LSCLD2B.272
! Use minimum overlap condition LSCLD2B.273
CF(I,K) = MIN(CFL(I,K)+CFF(I,K), 1.0) LSCLD2B.274
! LSCLD2B.275
END DO ! Points_do4 LSCLD2B.276
! LSCLD2B.277
END DO ! Levels_do LSCLD2B.278
! LSCLD2B.279
9999 CONTINUE ! Error exit LSCLD2B.280
RETURN LSCLD2B.281
END LSCLD2B.282
! ====================================================================== LSCLD2B.283
! LSCLD2B.284
!+ Large-scale Cloud Scheme Compression routine (Cloud points only). LSCLD2B.285
! Subroutine Interface: LSCLD2B.286
SUBROUTINE LS_CLD_C( 3,3LSCLD2B.287
& P_F,QSL_F,QN_F,Q_F,T_F LSCLD2B.288
&,QCL_F,CF_F,GRID_QC_F,BS_F LSCLD2B.289
&,INDEX,POINTS,POINTS_F,RHCPT_F) LSCLD2B.290
IMPLICIT NONE LSCLD2B.291
! LSCLD2B.292
! Purpose: Calculates liquid cloud water amounts and cloud amounts, LSCLD2B.293
! temperature and specific humidity from cloud-conserved and LSCLD2B.294
! other model variables. This is done for one model level. LSCLD2B.295
! LSCLD2B.296
! Current Owner of Code: S. Cusack LSCLD2B.297
! LSCLD2B.298
! History: LSCLD2B.299
! Version Date Comment LSCLD2B.300
! 4.5 12-05-98 Original Code LSCLD2B.301
! LSCLD2B.302
! Description of Code: LSCLD2B.303
! FORTRAN 77 + common extensions also in Fortran90. LSCLD2B.304
! This code is written to UMDP3 version 6 programming standards. LSCLD2B.305
! LSCLD2B.306
! System component covered: P292 LSCLD2B.307
! LSCLD2B.308
! Documentation: UMDP No.29 LSCLD2B.309
! LSCLD2B.310
! Global Variables:---------------------------------------------------- LSCLD2B.311
*CALL C_R_CP LSCLD2B.312
*CALL C_EPSLON LSCLD2B.313
*CALL C_LHEAT LSCLD2B.314
! LSCLD2B.315
! Subroutine Arguments:------------------------------------------------ LSCLD2B.316
INTEGER !, INTENT(IN) LSCLD2B.317
& POINTS_F LSCLD2B.318
! No. of gridpoints being processed. LSCLD2B.319
&,POINTS LSCLD2B.320
! No. of gridpoints with non-zero cloud LSCLD2B.321
&,INDEX(POINTS) LSCLD2B.322
! INDEX for points with non-zero cloud from lowest model level. LSCLD2B.323
! LSCLD2B.324
REAL !, INTENT(IN) LSCLD2B.325
& P_F(POINTS_F) LSCLD2B.326
! pressure (Pa). LSCLD2B.327
&,QSL_F(POINTS_F) LSCLD2B.328
! saturated humidity at temperature TL, and pressure P_F LSCLD2B.329
&,QN_F(POINTS_F) LSCLD2B.330
! Normalised super/subsaturation ( = QC/BS). LSCLD2B.331
&,RHCPT_F(POINTS_F) LSCLD2B.332
! Critical relative humidity in all grid-cells. LSCLD2B.333
! LSCLD2B.334
REAL !, INTENT(INOUT) LSCLD2B.335
& Q_F(POINTS_F) LSCLD2B.336
! On input : Vapour + liquid water content (QW) (kg per kg air). LSCLD2B.337
! On output: Specific humidity at processed levels LSCLD2B.338
! (kg water per kg air). LSCLD2B.339
&,T_F(POINTS_F) LSCLD2B.340
! On input : Liquid water temperature (TL) (K). LSCLD2B.341
! On output: Temperature at processed levels (K). LSCLD2B.342
! LSCLD2B.343
REAL !, INTENT(OUT) LSCLD2B.344
& QCL_F(POINTS_F) LSCLD2B.345
! Cloud liquid water content at processed levels (kg per kg air). LSCLD2B.346
&,CF_F(POINTS_F) LSCLD2B.347
! Liquid cloud fraction at processed levels. LSCLD2B.348
&,GRID_QC_F(POINTS_F) LSCLD2B.349
! Super/subsaturation on processed levels. Input initially RMDI. LSCLD2B.350
&,BS_F(POINTS_F) LSCLD2B.351
! Value of bs at processed levels. Input initialized to RMDI. LSCLD2B.352
! LSCLD2B.353
! Local parameters and other physical constants------------------------ LSCLD2B.354
REAL ALPHL,LCRCP ! Derived parameters. LSCLD2B.355
PARAMETER ( LSCLD2B.356
& ALPHL=EPSILON*LC/R ! For liquid AlphaL calculation. LSCLD2B.357
&,LCRCP=LC/CP ! Lat ht of condensation/Cp. LSCLD2B.358
&) LSCLD2B.359
REAL WTN ! Weighting for ALPHAL iteration LSCLD2B.360
INTEGER LSCLD2B.361
& ITS ! Total number of iterations LSCLD2B.362
PARAMETER (ITS=5,WTN=0.75) LSCLD2B.363
! LSCLD2B.364
! Local scalars-------------------------------------------------------- LSCLD2B.365
! LSCLD2B.366
! (a) Scalars effectively expanded to workspace by the Cray (using LSCLD2B.367
! vector registers). LSCLD2B.368
REAL LSCLD2B.369
& AL ! LOCAL AL (see equation P292.6). LSCLD2B.370
&,ALPHAL ! LOCAL ALPHAL (see equation P292.5). LSCLD2B.371
! LSCLD2B.372
! (b) Others. LSCLD2B.373
INTEGER I,II,N ! Loop counters: I,II - horizontal field index. LSCLD2B.374
! : N - iteration counter. LSCLD2B.375
! LSCLD2B.376
! Local dynamic arrays------------------------------------------------- LSCLD2B.377
! 8 blocks of real workspace are required. LSCLD2B.378
REAL LSCLD2B.379
& P(POINTS) LSCLD2B.380
! Pressure (Pa). LSCLD2B.381
&,QS(POINTS) LSCLD2B.382
! Saturated spec humidity for temp T. LSCLD2B.383
&,QCN(POINTS) LSCLD2B.384
! Cloud water normalised with BS. LSCLD2B.385
&,T(POINTS) LSCLD2B.386
! temperature. LSCLD2B.387
&,Q(POINTS) LSCLD2B.388
! specific humidity. LSCLD2B.389
&,BS(POINTS) LSCLD2B.390
! Sigmas*sqrt(6): sigmas the parametric standard deviation of LSCLD2B.391
! local cloud water content fluctuations. LSCLD2B.392
&,ALPHAL_NM1(POINTS) LSCLD2B.393
! ALPHAL at previous iteration. LSCLD2B.394
! LSCLD2B.395
! External subroutine calls: ------------------------------------------ LSCLD2B.396
EXTERNAL QSAT_WAT LSCLD2B.397
! LSCLD2B.398
!- End of Header LSCLD2B.399
! LSCLD2B.400
! ==Main Block==-------------------------------------------------------- LSCLD2B.401
! Operate on INDEXed points with non-zero cloud fraction. LSCLD2B.402
! ---------------------------------------------------------------------- LSCLD2B.403
! Points_do1: LSCLD2B.404
DO I=1, POINTS LSCLD2B.405
II = INDEX(I) LSCLD2B.406
P(I) = P_F(II) LSCLD2B.407
QCN(I)= QN_F(II) LSCLD2B.408
! ---------------------------------------------------------------------- LSCLD2B.409
! 1. Calculate ALPHAL (eq P292.5) and AL (P292.6). LSCLD2B.410
! CAUTION: T_F acts as TL (input value) until update in final section LSCLD2B.411
! CAUTION: Q_F acts as QW (input value) until update in final section LSCLD2B.412
! ---------------------------------------------------------------------- LSCLD2B.413
! LSCLD2B.414
ALPHAL = ALPHL * QSL_F(II) / (T_F(II) * T_F(II)) ! P292.5 LSCLD2B.415
AL = 1.0 / (1.0 + (LCRCP * ALPHAL)) ! P292.6 LSCLD2B.416
ALPHAL_NM1(I) = ALPHAL LSCLD2B.417
! LSCLD2B.418
! Rhcrit_if1: LSCLD2B.419
IF (RHCPT_F(II) .LT. 1.) THEN LSCLD2B.420
! ---------------------------------------------------------------------- LSCLD2B.421
! 2. Calculate cloud fraction CF, BS (ie. sigma*sqrt(6), where sigma is LSCLD2B.422
! as in P292.14) and normalised cloud water QCN=qc/BS, using eqs LSCLD2B.423
! P292.15 & 16 if RHcrit < 1. LSCLD2B.424
! N.B. QN (input) is initially in QCN LSCLD2B.425
! N.B. QN does not depend on AL and so CF and QCN can be calculated LSCLD2B.426
! outside the iteration (which is performed in LS_CLD_C). LSCLD2B.427
! QN is > -1 for all points processed so CF > 0. LSCLD2B.428
! ---------------------------------------------------------------------- LSCLD2B.429
! LSCLD2B.430
BS(I) = (1.0 - RHCPT_F(II)) * AL * QSL_F(II) ! P292.14 LSCLD2B.431
IF (QCN(I) .LE. 0.) THEN LSCLD2B.432
CF_F(II) = 0.5 * (1. + QCN(I)) * (1. + QCN(I)) LSCLD2B.433
QCN(I)= (1. + QCN(I)) * (1. + QCN(I)) * (1. + QCN(I)) / 6. LSCLD2B.434
ELSEIF (QCN(I) .LT. 1.) THEN LSCLD2B.435
CF_F(II) = 1. - 0.5 * (1. - QCN(I)) * (1. - QCN(I)) LSCLD2B.436
QCN(I)=QCN(I) + (1.-QCN(I)) * (1.-QCN(I)) * (1.-QCN(I))/6. LSCLD2B.437
ELSE ! QN .GE. 1 LSCLD2B.438
CF_F(II) = 1. LSCLD2B.439
END IF ! QCN_if LSCLD2B.440
ELSE ! i.e. if RHcrit = 1 LSCLD2B.441
! ---------------------------------------------------------------------- LSCLD2B.442
! 3.a If RHcrit = 1., all points processed have QN > 0 and CF = 1. LSCLD2B.443
! ---------------------------------------------------------------------- LSCLD2B.444
BS(I) = AL LSCLD2B.445
CF_F(II) = 1. LSCLD2B.446
END IF ! Rhcrit_if1 LSCLD2B.447
! LSCLD2B.448
! ---------------------------------------------------------------------- LSCLD2B.449
! 3.1 Calculate 1st approx. to qc (store in QCL) LSCLD2B.450
! ---------------------------------------------------------------------- LSCLD2B.451
! LSCLD2B.452
QCL_F(II) = QCN(I) * BS(I) LSCLD2B.453
! LSCLD2B.454
! ---------------------------------------------------------------------- LSCLD2B.455
! 3.2 Calculate 1st approx. specific humidity (total minus cloud water) LSCLD2B.456
! ---------------------------------------------------------------------- LSCLD2B.457
! LSCLD2B.458
Q(I) = Q_F(II) - QCL_F(II) LSCLD2B.459
! LSCLD2B.460
! ---------------------------------------------------------------------- LSCLD2B.461
! 3.3 Calculate 1st approx. to temperature, adjusting for latent heating LSCLD2B.462
! ---------------------------------------------------------------------- LSCLD2B.463
! LSCLD2B.464
T(I) = T_F(II) + LCRCP*QCL_F(II) LSCLD2B.465
END DO ! Points_do1 LSCLD2B.466
! LSCLD2B.467
! ---------------------------------------------------------------------- LSCLD2B.468
! 4. Iteration to find better cloud water values. LSCLD2B.469
! ---------------------------------------------------------------------- LSCLD2B.470
! Its_if: LSCLD2B.471
IF (ITS .GE. 2) THEN LSCLD2B.472
! Its_do: LSCLD2B.473
DO N=2, ITS LSCLD2B.474
! LSCLD2B.475
CALL QSAT_WAT(QS,T,P,POINTS) LSCLD2B.476
! Points_do2: LSCLD2B.477
DO I=1, POINTS LSCLD2B.478
II = INDEX(I) LSCLD2B.479
! T_if: LSCLD2B.480
IF (T(I) .GT. T_F(II)) THEN LSCLD2B.481
! NB. T > TL implies cloud fraction > 0. LSCLD2B.482
ALPHAL = (QS(I) - QSL_F(II)) / (T(I) - T_F(II)) LSCLD2B.483
ALPHAL = WTN * ALPHAL + (1.0 - WTN) * ALPHAL_NM1(I) LSCLD2B.484
ALPHAL_NM1(I) = ALPHAL LSCLD2B.485
AL = 1.0 / (1.0 + (LCRCP * ALPHAL)) LSCLD2B.486
! Rhcrit_if2: LSCLD2B.487
IF (RHCPT_F(II) .LT. 1.) THEN LSCLD2B.488
BS(I) = (1.0 - RHCPT_F(II)) * AL * QSL_F(II) ! P292.1 LSCLD2B.489
ELSE LSCLD2B.490
BS(I) = AL LSCLD2B.491
END IF ! Rhcrit_if2 LSCLD2B.492
! LSCLD2B.493
! ---------------------------------------------------------------------- LSCLD2B.494
! 4.1 Calculate Nth approx. to qc (store in QCL). LSCLD2B.495
! ---------------------------------------------------------------------- LSCLD2B.496
! LSCLD2B.497
QCL_F(II) = QCN(I) * BS(I) LSCLD2B.498
! LSCLD2B.499
! ---------------------------------------------------------------------- LSCLD2B.500
! 4.2 Calculate Nth approx. spec. humidity (total minus cloud water). LSCLD2B.501
! ---------------------------------------------------------------------- LSCLD2B.502
! LSCLD2B.503
Q(I) = Q_F(II) - QCL_F(II) LSCLD2B.504
! LSCLD2B.505
! ---------------------------------------------------------------------- LSCLD2B.506
! 4.3 Calculate Nth approx. to temperature, adjusting for latent heating LSCLD2B.507
! ---------------------------------------------------------------------- LSCLD2B.508
! LSCLD2B.509
T(I) = T_F(II) + LCRCP * QCL_F(II) LSCLD2B.510
! LSCLD2B.511
END IF ! T_if LSCLD2B.512
END DO ! Points_do2 LSCLD2B.513
END DO ! Its_do LSCLD2B.514
END IF ! Its_if LSCLD2B.515
! LSCLD2B.516
! ---------------------------------------------------------------------- LSCLD2B.517
! 5. Finally scatter back cloud point results to full field arrays. LSCLD2B.518
! CAUTION: T_F updated from TL (input) to T (output) LSCLD2B.519
! CAUTION: Q_F updated from QW (input) to Q (output) LSCLD2B.520
! ---------------------------------------------------------------------- LSCLD2B.521
! LSCLD2B.522
CDIR$ IVDEP LSCLD2B.523
! Points_do3: LSCLD2B.524
DO I=1,POINTS LSCLD2B.525
Q_F(INDEX(I)) = Q(I) LSCLD2B.526
T_F(INDEX(I)) = T(I) LSCLD2B.527
GRID_QC_F(INDEX(I)) = BS(I) * QN_F(INDEX(I)) LSCLD2B.528
BS_F(INDEX(I)) = BS(I) LSCLD2B.529
END DO ! Points_do3 LSCLD2B.530
! LSCLD2B.531
RETURN LSCLD2B.532
END LSCLD2B.533
! ====================================================================== LSCLD2B.534
*ENDIF LSCLD2B.535