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