SUBROUTINE PF_LS_CLD( 3,2PFLCLD1A.22
+ AK,BK,AKABOVE,BKABOVE,PSTAR,RHCRIT,POINTS,PFIELD, PFLCLD1A.23
& T,Q,QC,D_TYPE,ERROR) PFLCLD1A.24
PFLCLD1A.25
IMPLICIT NONE PFLCLD1A.26
! PFLCLD1A.27
! Description: PFLCLD1A.28
! For a single pressure level on UM grid OR theta level on UDG6F405.9
! the PF vertical grid ,the UDG6F405.10
! routine calculates cloud amount, total cloud water amount, UDG6F405.11
! and potential temperature and specific humidity increments UDG6F405.12
! due to cloud formation, from cloud-conserved and other UDG6F405.13
! model variables. It returns the potential temperature UDG6F405.14
! specific humidity and total cloud water amount UDG6F405.15
! fields/increments. UDG6F405.16
UDG6F405.17
! PFLCLD1A.34
! Method: The routine is based on the UM Cloud scheme 1A. PFLCLD1A.35
! PFLCLD1A.36
! Current Code Owner: I Edmond PFLCLD1A.37
! PFLCLD1A.38
! History: PFLCLD1A.39
! Version Date Comment PFLCLD1A.40
! ------- ---- ------- PFLCLD1A.41
! <version> <date> Original code. <Your name> PFLCLD1A.42
! 3.4 5/08/94 Remove calls to TIMER (under *DEF TIMER). R.Rawlins PFLCLD1A.43
! PFLCLD1A.44
! 4.0 9/05/95 Changed argument list to export mean cloud water PFLCLD1A.45
! content, QC, and bs for precipitation. A.C.Bushell PFLCLD1A.46
! PFLCLD1A.47
! 4.1 31/05/95 Reduced argument list to reduce the amount of memory PFLCLD1A.48
! allocated for the VAR reconfiguration. Temperature PFLCLD1A.49
! and specific humidity output only. Calculations done PFLCLD1A.50
! for a single level only. PFLCLD1A.51
! 4.2 Oct. 96 T3E migration: *DEF CRAY removed GSS9F402.84
! S.J.Swarbrick GSS9F402.85
! 4.5 29/07/98 Optimisation changes for T3E Rewrote **KAPPA UDG5F405.422
! calculations to reduce number of "**"'s and UDG5F405.423
! replaced "**"'s with vector function powr_v UDG5F405.424
! Author D.M. Goddard UDG5F405.425
! 4.5 29/07/98 Add comments to declaration of D_TYPE. UDG6F405.18
! Author D.M. Goddard UDG6F405.19
! PFLCLD1A.52
! Code Description: PFLCLD1A.53
! Language: FORTRAN 77 + common extensions. PFLCLD1A.54
! This code is written to UMDP3 v6 programming standards. PFLCLD1A.55
! PFLCLD1A.56
! System component covered: <appropriate code> PFLCLD1A.57
! System Task: <appropriate code> PFLCLD1A.58
! PFLCLD1A.59
! Declarations: PFLCLD1A.60
! These are of the form:- PFLCLD1A.61
! INTEGER ExampleVariable !Description of variable PFLCLD1A.62
! PFLCLD1A.63
! 1.0 Global variables (*Called COMDECKs etc...): PFLCLD1A.64
*CALL C_R_CP 
PFLCLD1A.65
PFLCLD1A.66
! 2.0 Subroutine arguments PFLCLD1A.67
! 2.1 Scalar arguments with intent(in): PFLCLD1A.68
INTEGER PFLCLD1A.69
& POINTS ! No. of gridpoints being processed. PFLCLD1A.70
&,PFIELD ! No. of points in global field (at one PFLCLD1A.71
! vertical level). PFLCLD1A.72
&,D_TYPE ! Specifies whether input UM or PF dump and determines UDG6F405.20
! whether the pressure on theta levels of PF vertical UDG6F405.21
! grid or pressure on UM pressure levels is calculated. UDG6F405.22
UDG6F405.23
UDG6F405.24
PFLCLD1A.74
REAL PFLCLD1A.75
& PSTAR(PFIELD) ! Surface pressure (Pa). PFLCLD1A.76
&,RHCRIT ! Critical relative humidity. See the PFLCLD1A.77
! the paragraph incorporating eqs P292.11 PFLCLD1A.78
! to P292.14; the values need to be tuned PFLCLD1A.79
! for the given set of levels. PFLCLD1A.80
&,AK PFLCLD1A.81
&,BK PFLCLD1A.82
&,AKABOVE ! Hybrid "A" co-ordinate. PFLCLD1A.83
&,BKABOVE ! Hybrid "B" co-ordinate. PFLCLD1A.84
&,PR_OUT !Intermediate temporaries used in calc of pressure PFLCLD1A.85
&,PR_OUT2 !Intermediate temporaries used in calc of pressure PFLCLD1A.86
&,PEXNER PFLCLD1A.87
&,PEXNER1 PFLCLD1A.88
PFLCLD1A.89
! 2.2 Array arguments with intent(InOut): PFLCLD1A.90
REAL PFLCLD1A.91
+ Q(PFIELD) ! On input: Total water content (QW) PFLCLD1A.92
! (kg per kg air). PFLCLD1A.93
! On output: Specific humidity at PFLCLD1A.94
! processed levels (kg water per kg air). PFLCLD1A.95
+,T(PFIELD) ! On input: Liquid/frozen water PFLCLD1A.96
! temperature (TL) (K). PFLCLD1A.97
! On output: Temperature at processed PFLCLD1A.98
! levels (K). PFLCLD1A.99
PFLCLD1A.100
! 2.3 Array arguments with intent(out): PFLCLD1A.101
REAL PFLCLD1A.102
& QC(PFIELD) ! Cloud water content at a level PFLCLD1A.103
! (kg per kg air). PFLCLD1A.104
PFLCLD1A.105
! 2.4 ErrorStatus PFLCLD1A.106
INTEGER ERROR ! OUT 0 if OK; 1 if bad arguments. PFLCLD1A.107
PFLCLD1A.108
! 3.0 Local parameters: PFLCLD1A.109
INTEGER MAXPOINTS PFLCLD1A.110
PARAMETER (MAXPOINTS=96*72) PFLCLD1A.111
PFLCLD1A.112
! 4.0 Local scalars: PFLCLD1A.113
INTEGER I ! Loop counters: I - horizontal field index. PFLCLD1A.114
INTEGER QC_POINTS ! No. points with non-zero cloud PFLCLD1A.115
PFLCLD1A.116
! 5.0 Local dynamic arrays: PFLCLD1A.117
REAL PFLCLD1A.118
+ CF(PFIELD) ! Cloud fraction at processed levels PFLCLD1A.119
! (decimal fraction). PFLCLD1A.120
+,QCF(PFIELD) ! Cloud ice content at processed levels PFLCLD1A.121
! (kg per kg air). PFLCLD1A.122
+,QCL(PFIELD) ! Cloud liquid water content at PFLCLD1A.123
! processed levels (kg per kg air). PFLCLD1A.124
PFLCLD1A.125
REAL ! "Automatic" arrays on Cray. PFLCLD1A.127
& P(POINTS) ! WORK Pressure at successive levels (Pa). PFLCLD1A.128
&,QSL(POINTS) ! WORK Saturated spec humidity for temp TL. PFLCLD1A.129
&,QN(POINTS) ! WORK Cloud water normalised with BS. PFLCLD1A.130
PFLCLD1A.131
LOGICAL PFLCLD1A.132
& LQC(POINTS) ! WORK True for points with non-zero cloud PFLCLD1A.133
PFLCLD1A.134
INTEGER PFLCLD1A.135
& INDEX(POINTS) ! WORK Index for points with non-zero cloud PFLCLD1A.136
*IF DEF,VECTLIB PXVECTLB.118
REAL UDG5F405.427
& a_pexner(points) UDG5F405.428
&,a_pexner1(points) UDG5F405.429
&,a_pexner_kappa(points) UDG5F405.430
&,a_pexner1_kappa(points) UDG5F405.431
*ENDIF UDG5F405.432
PFLCLD1A.149
! Function & Subroutine calls: PFLCLD1A.150
EXTERNAL QSAT,PF_LS_CLD_C PFLCLD1A.151
PFLCLD1A.155
!- End of header PFLCLD1A.156
PFLCLD1A.157
!----------------------------------------------------------------------- PFLCLD1A.158
! Check input arguments for potential over-writing problems. PFLCLD1A.159
!----------------------------------------------------------------------- PFLCLD1A.160
ERROR=0 PFLCLD1A.161
IF(POINTS.GT.PFIELD)THEN PFLCLD1A.162
ERROR=1 PFLCLD1A.163
GOTO1000 PFLCLD1A.164
ENDIF PFLCLD1A.165
PFLCLD1A.166
!----------------------------------------------------------------------- PFLCLD1A.167
! 1. Calculate QSAT at liquid/ice water temperature, TL, PFLCLD1A.168
! and initialise cloud ice, water and fraction arrays. PFLCLD1A.169
! This requires a preliminary calculation of the pressure. PFLCLD1A.170
! NB: On entry to the subroutine 'T' is TL and 'Q' is QW. PFLCLD1A.171
!----------------------------------------------------------------------- PFLCLD1A.172
PFLCLD1A.173
IF (D_TYPE.EQ.5) THEN PFLCLD1A.174
! Variables passed into the cloud scheme are on the PF vertical grid. PFLCLD1A.175
! Calculation of pressure on successsive theta levels on the PF vertical PFLCLD1A.176
! grid is made from exner pressure (on pressure levels, using the ak and PFLCLD1A.177
! values and pstar) and an equation derived in documentation working pap PFLCLD1A.178
*IF DEF,VECTLIB PXVECTLB.119
DO I=1,points UDG5F405.434
! Exner pressure at pressure level just below theta level UDG5F405.435
! of interest on PF vertical grid. UDG5F405.436
PR_OUT = AK + BK * PSTAR(I) UDG5F405.437
a_PEXNER(i) = (PR_OUT / PREF) UDG5F405.438
UDG5F405.439
! Exner pressure at pressure level just above theta level UDG5F405.440
! of interest on PF vertical grid. UDG5F405.441
PR_OUT2 = AKABOVE + BKABOVE * pstar(i) UDG5F405.442
a_PEXNER1(i) = (PR_OUT2 / PREF) UDG5F405.443
ENDDO UDG5F405.444
UDG5F405.445
call powr_v(points,a_pexner,kappa,a_pexner_kappa) UDG5F405.446
call powr_v(points,a_pexner1,kappa,a_pexner1_kappa) UDG5F405.447
UDG5F405.448
! Pressure on (theta) level of PF vertical grid. UDG5F405.449
DO I=1,points UDG5F405.450
PEXNER1=a_pexner1_kappa(i) UDG5F405.451
PEXNER=a_pexner_kappa(i) UDG5F405.452
UDG5F405.453
P(I) = (PEXNER1 - PEXNER)/((a_PEXNER1(i) - UDG5F405.454
& a_PEXNER(i))*KAPPA) UDG5F405.455
UDG5F405.456
ENDDO UDG5F405.457
call powr_v(points,p,(1/(KAPPA-1)),p) UDG5F405.458
DO I=1,points UDG5F405.459
P(I)=P(I)*PREF UDG5F405.460
QCF(I)=0.0 UDG5F405.461
QCL(I)=0.0 UDG5F405.462
QC(I) =0.0 UDG5F405.463
CF(I) =0.0 UDG5F405.464
ENDDO ! Loop over points UDG5F405.465
*ELSE UDG5F405.466
DO I=1,points PFLCLD1A.179
PFLCLD1A.180
! Exner pressure at pressure level just below theta level PFLCLD1A.181
! of interest on PF vertical grid. PFLCLD1A.182
PR_OUT = AK + BK * PSTAR(I) PFLCLD1A.183
PEXNER = (PR_OUT / PREF)**KAPPA PFLCLD1A.184
PFLCLD1A.185
! Exner pressure at pressure level just above theta level PFLCLD1A.186
! of interest on PF vertical grid. PFLCLD1A.187
PR_OUT2 = AKABOVE + BKABOVE * pstar(i) PFLCLD1A.188
PEXNER1 = (PR_OUT2 / pref)**KAPPA PFLCLD1A.189
PFLCLD1A.190
! Pressure on (theta) level of PF vertical grid. PFLCLD1A.191
P(I) = PREF*((PEXNER1 - PEXNER)/((PEXNER1**(1/KAPPA) - PFLCLD1A.192
& PEXNER**(1/KAPPA))*KAPPA))**(1/(KAPPA-1)) PFLCLD1A.193
QCF(I)=0.0 PFLCLD1A.194
QCL(I)=0.0 PFLCLD1A.195
QC(I) =0.0 PFLCLD1A.196
CF(I) =0.0 PFLCLD1A.197
ENDDO ! Loop over points PFLCLD1A.198
*ENDIF UDG5F405.467
PFLCLD1A.199
ELSE PFLCLD1A.200
PFLCLD1A.201
DO I=1,points PFLCLD1A.202
PFLCLD1A.203
! Obtain full level pressure on UM vertical grid. PFLCLD1A.204
P(I)= AK + BK * PSTAR(I) PFLCLD1A.205
QCF(I)=0.0 PFLCLD1A.206
QCL(I)=0.0 PFLCLD1A.207
QC(I) =0.0 PFLCLD1A.208
CF(I) =0.0 PFLCLD1A.209
PFLCLD1A.210
ENDDO ! Loop over points PFLCLD1A.211
ENDIF PFLCLD1A.212
PFLCLD1A.213
PFLCLD1A.214
CALL QSAT(QSL,T(1),P,POINTS) PFLCLD1A.215
PFLCLD1A.216
DO I=1,POINTS PFLCLD1A.217
IF (RHCRIT .LT. 1.) THEN PFLCLD1A.218
PFLCLD1A.219
!----------------------------------------------------------------------- PFLCLD1A.220
! 2. Calculate the quantity QN = QC/BS = (QW/QSL-1)/(1-RHcrit) PFLCLD1A.221
! if RHcrit is less than 1 PFLCLD1A.222
!----------------------------------------------------------------------- PFLCLD1A.223
PFLCLD1A.224
QN(I) = (Q(I)/QSL(I)-1.)/(1.-RHCRIT) PFLCLD1A.225
PFLCLD1A.226
!----------------------------------------------------------------------- PFLCLD1A.227
! 3. Set logical variable for cloud, LQC, for the case RHcrit < 1; PFLCLD1A.228
! where QN > -1, i.e. qW/qSAT(TL,P) > RHcrit, there is cloud PFLCLD1A.229
!----------------------------------------------------------------------- PFLCLD1A.230
PFLCLD1A.231
LQC(I) = (QN(I) .GT. -1.) PFLCLD1A.232
ELSE PFLCLD1A.233
PFLCLD1A.234
!----------------------------------------------------------------------- PFLCLD1A.235
! 2.a Calculate QN = QW - QSL if RHcrit equals 1 PFLCLD1A.236
!----------------------------------------------------------------------- PFLCLD1A.237
PFLCLD1A.238
QN(I) = Q(I) - QSL(I) PFLCLD1A.239
PFLCLD1A.240
!----------------------------------------------------------------------- PFLCLD1A.241
! 3.a Set logical variable for cloud, LQC, for the case RHcrit = 1; PFLCLD1A.242
! where QN > 0, i.e. qW > qSAT(TL,P), there is cloud PFLCLD1A.243
!----------------------------------------------------------------------- PFLCLD1A.244
PFLCLD1A.245
LQC(I) = (QN(I) .GT. 0.) PFLCLD1A.246
ENDIF ! Test on RHCRIT PFLCLD1A.247
ENDDO ! Loop over points PFLCLD1A.248
PFLCLD1A.249
!----------------------------------------------------------------------- PFLCLD1A.250
! 4. Form index of points where non-zero cloud fraction PFLCLD1A.251
!----------------------------------------------------------------------- PFLCLD1A.252
PFLCLD1A.253
QC_POINTS=0 PFLCLD1A.257
DO I=1,POINTS PFLCLD1A.258
IF(LQC(I)) THEN PFLCLD1A.259
QC_POINTS=QC_POINTS+1 PFLCLD1A.260
INDEX(QC_POINTS)=I PFLCLD1A.261
ENDIF PFLCLD1A.262
ENDDO ! Loop over points PFLCLD1A.263
PFLCLD1A.265
!----------------------------------------------------------------------- PFLCLD1A.266
! 5. Call PF_LS_CLD_C to calculate cloud ice and water contents, cloud PFLCLD1A.267
! fractions, spec. humidity and determine temperature PFLCLD1A.268
!----------------------------------------------------------------------- PFLCLD1A.269
PFLCLD1A.270
IF(QC_POINTS.GT.0) THEN PFLCLD1A.271
CALL PF_LS_CLD_C(P,RHCRIT,QSL,QN,Q(1),T(1),QCF(1), PFLCLD1A.272
& QCL(1),QC(1),CF(1),INDEX,QC_POINTS,POINTS) PFLCLD1A.273
ENDIF ! qc_points > 0 PFLCLD1A.274
PFLCLD1A.275
PFLCLD1A.276
1000 CONTINUE ! Error exit PFLCLD1A.277
RETURN PFLCLD1A.278
END PFLCLD1A.279
PFLCLD1A.280
!+ PFLCLD1A.281
! PFLCLD1A.282
! Subroutine Interface: PFLCLD1A.283
SUBROUTINE PF_LS_CLD_C( 1,1PFLCLD1A.284
& P_F,RHCRIT,QSL_F,QN_F,Q_F,T_F PFLCLD1A.285
&,QCF_F,QCL_F,QC_F,CF_F,INDEX,POINTS,POINTS_F) PFLCLD1A.286
PFLCLD1A.287
IMPLICIT NONE PFLCLD1A.288
! PFLCLD1A.289
! Description: PFLCLD1A.290
! Calculates cloud water amounts (ice and liquid), cloud PFLCLD1A.291
! amounts and temperature and specific humidity PFLCLD1A.292
! from cloud-conserved and other model variables. PFLCLD1A.293
! This is done for one level. PFLCLD1A.294
! Iteration is used to improve the determination of PFLCLD1A.295
! alphal, hence al and so qcf, qcl, Q and T. PFLCLD1A.296
! Method: see documentation: UMDP No.29 PFLCLD1A.297
! Current Code Owner: I Edmond PFLCLD1A.298
! PFLCLD1A.299
! History: PFLCLD1A.300
! Version Date Comment PFLCLD1A.301
! ------- ---- ------- PFLCLD1A.302
! 4.1 15/6/96 Original code. Ian Edmond PFLCLD1A.303
! PFLCLD1A.304
! Code Description: PFLCLD1A.305
! Language: FORTRAN 77 + common extensions. PFLCLD1A.306
! This code is written to UMDP3 v6 programming standards. PFLCLD1A.307
! PFLCLD1A.308
! System component covered: <appropriate code> PFLCLD1A.309
! System Task: <appropriate code> PFLCLD1A.310
! PFLCLD1A.311
! Declarations: PFLCLD1A.312
! These are of the form:- PFLCLD1A.313
! INTEGER ExampleVariable !Description of variable PFLCLD1A.314
! PFLCLD1A.315
! 1.0 Global variables (*Called COMDECKs etc...): PFLCLD1A.316
*CALL C_R_CP PFLCLD1A.317
*CALL C_EPSLON PFLCLD1A.318
*CALL C_LHEAT PFLCLD1A.319
*CALL C_0_DG_C PFLCLD1A.320
PFLCLD1A.321
! 2.0 Subroutine arguments PFLCLD1A.322
PFLCLD1A.323
! 2.1 Scalar arguments with intent(in): PFLCLD1A.324
INTEGER PFLCLD1A.325
& POINTS_F ! No. of gridpoints being processed. PFLCLD1A.326
&,POINTS ! No. of gridpoints with non-zero cloud PFLCLD1A.327
&,INDEX(POINTS) ! INDEX for points with non-zero cloud PFLCLD1A.328
! from lowest model level. PFLCLD1A.329
REAL PFLCLD1A.330
& P_F(POINTS_F) ! pressure (Pa). PFLCLD1A.331
&,QSL_F(POINTS_F) ! saturated humidity at temperature TL, PFLCLD1A.332
! and pressure P_F PFLCLD1A.333
&,QN_F(POINTS_F) ! Normalised super/subsaturation (=QC/BS). PFLCLD1A.334
&,RHCRIT ! Critical relative humidity. See the PFLCLD1A.335
! the paragraph incorporating eqs P292.11 PFLCLD1A.336
! to P292.14; PFLCLD1A.337
PFLCLD1A.338
! 2.3 Array arguments with intent(InOut): PFLCLD1A.339
REAL PFLCLD1A.340
& Q_F(POINTS_F) ! On input: Total water content (QW) PFLCLD1A.341
! (kg per kg air). PFLCLD1A.342
! On output: Specific humidity at PFLCLD1A.343
! processed levels (kg water per kg PFLCLD1A.344
! air). PFLCLD1A.345
&,T_F(POINTS_F) ! On input: Liquid/frozen water PFLCLD1A.346
! temperature (TL) (K). PFLCLD1A.347
! On output: Temperature at processed PFLCLD1A.348
! levels (K). PFLCLD1A.349
PFLCLD1A.350
! 2.4 Array arguments with intent(Out): PFLCLD1A.351
REAL PFLCLD1A.352
& QCF_F(POINTS_F) ! Cloud ice content at processed levels PFLCLD1A.353
! (kg per kg air). PFLCLD1A.354
&,QCL_F(POINTS_F) ! Cloud liquid water content at PFLCLD1A.355
! processed levels (kg per kg air). PFLCLD1A.356
&,QC_F(POINTS_F) ! Total cloud water content at PFLCLD1A.357
! processed levels (kg per kg air). PFLCLD1A.358
&,CF_F(POINTS_F) ! Cloud fraction at processed levels. PFLCLD1A.359
PFLCLD1A.360
&,GRID_QC_F(POINTS_F) ! Super/subsaturation on processed levels PFLCLD1A.361
PFLCLD1A.362
&,BS_F(POINTS_F) ! Value of bs at processed levels. PFLCLD1A.363
PFLCLD1A.364
! 3.0 Local parameters: PFLCLD1A.365
INTEGER MAXPOINTS PFLCLD1A.366
PARAMETER (MAXPOINTS=96*72) PFLCLD1A.367
PFLCLD1A.368
INTEGER ITS ! Total number of iterati PFLCLD1A.369
PARAMETER (ITS=5) PFLCLD1A.370
PFLCLD1A.371
REAL alphf PFLCLD1A.372
PARAMETER (ALPHF=EPSILON*(LF+LC)/R) ! For frozen AlphaL calculatio PFLCLD1A.373
PFLCLD1A.374
REAL alphl PFLCLD1A.375
PARAMETER (ALPHL=EPSILON*LC/R) ! For liquid AlphaL calculatio PFLCLD1A.376
PFLCLD1A.377
REAL lsrcp PFLCLD1A.378
PARAMETER (LSRCP=(LF+LC)/CP) ! Lat ht of sublimation/Cp. PFLCLD1A.379
PFLCLD1A.380
REAL LCRCP PFLCLD1A.381
PARAMETER (LCRCP=LC/CP) ! Lat ht of condensation/Cp. PFLCLD1A.382
PFLCLD1A.383
REAL LFRCP PFLCLD1A.384
PARAMETER (LFRCP=LF/CP) ! Lat ht of fusion/Cp. PFLCLD1A.385
PFLCLD1A.386
REAL cprlf PFLCLD1A.387
PARAMETER (CPRLF=CP/LF) ! Cp/lat ht of fusion. PFLCLD1A.388
PFLCLD1A.389
REAL wtn PFLCLD1A.390
PARAMETER (WTN=0.75) PFLCLD1A.391
PFLCLD1A.392
! 4.0 Local scalars: PFLCLD1A.393
INTEGER I,N ! Counters PFLCLD1A.394
PFLCLD1A.395
REAL PFLCLD1A.396
& AL ! al (see equation P292.6). PFLCLD1A.397
&,ALPHAL ! alphal (see equation P292.5). PFLCLD1A.398
&,TESTT ! temporary temperature for partition PFLCLD1A.399
! of cloud water into ice and liquid PFLCLD1A.400
&,FRACF ! Fraction of cloud water which is frozen. PFLCLD1A.401
PFLCLD1A.402
! 5.0 Local dynamic arrays: PFLCLD1A.403
PFLCLD1A.404
REAL ! "Automatic" arrays on Cray. PFLCLD1A.406
& P(POINTS) ! Pressure (Pa). PFLCLD1A.407
&,TL(POINTS) ! Liquid/ice water temperature. PFLCLD1A.408
&,QW(POINTS) ! Total water content. PFLCLD1A.409
&,QSL(POINTS) ! Saturated spec humidity for temp TL. PFLCLD1A.410
&,QS(POINTS) ! Saturated spec humidity for temp T. PFLCLD1A.411
&,QCN(POINTS) ! Cloud water normalised with BS. PFLCLD1A.412
&,T(POINTS) ! temperature. PFLCLD1A.413
&,Q(POINTS) ! specific humidity. PFLCLD1A.414
&,QCF(POINTS) ! Cloud ice content. PFLCLD1A.415
&,QCL(POINTS) ! Cloud water content. PFLCLD1A.416
&,CF(POINTS) ! Cloud fraction. PFLCLD1A.417
&,BS(POINTS) ! Sigmas*sqrt(6): sigmas the parametric PFLCLD1A.418
! standard deviation of local cloud PFLCLD1A.419
! water content fluctuations. PFLCLD1A.420
&,ALPHAL_NM1(POINTS) ! ALPHAL at previous iteration. PFLCLD1A.421
&,ALPHAL_NM1_F(POINTS_F) ! ALPHAL at previous iteration. PFLCLD1A.422
PFLCLD1A.442
! Function & Subroutine calls: PFLCLD1A.443
EXTERNAL QSAT PFLCLD1A.444
PFLCLD1A.445
!-End of header PFLCLD1A.446
PFLCLD1A.447
!----------------------------------------------------------------------- PFLCLD1A.448
! 1. Calculate ALPHAL (eq P292.5), AL (P292.6), BS (ie. sigma*sqrt(6), PFLCLD1A.449
! where sigma is as in P292.14) PFLCLD1A.450
!----------------------------------------------------------------------- PFLCLD1A.451
PFLCLD1A.452
DO I=1,POINTS_F PFLCLD1A.453
IF (T_F(I) .GT. TM) THEN PFLCLD1A.454
ALPHAL = ALPHL * QSL_F(I) / (T_F(I) * T_F(I)) ! P292.5 PFLCLD1A.455
AL = 1.0 / (1.0 + (LCRCP * ALPHAL)) ! P292.6 PFLCLD1A.456
ELSE PFLCLD1A.457
ALPHAL = ALPHF * QSL_F(I) / (T_F(I) * T_F(I)) ! P292.5 PFLCLD1A.458
AL = 1.0 / (1.0 + (LSRCP * ALPHAL)) ! P292.6 PFLCLD1A.459
ENDIF PFLCLD1A.460
IF (RHCRIT .LT. 1.) THEN PFLCLD1A.461
BS_F(I) = (1.0 - RHCRIT) * AL * QSL_F(I) ! P292.14 PFLCLD1A.462
ELSE PFLCLD1A.463
BS_F(I) = AL PFLCLD1A.464
ENDIF PFLCLD1A.465
GRID_QC_F(I) = QN_F(I) * BS_F(I) PFLCLD1A.466
ALPHAL_NM1_F(I) = ALPHAL PFLCLD1A.467
END DO ! Loop over points_f PFLCLD1A.468
PFLCLD1A.469
!----------------------------------------------------------------------- PFLCLD1A.470
! 1.a Gather points with non-zero cloud fraction. PFLCLD1A.471
!----------------------------------------------------------------------- PFLCLD1A.472
PFLCLD1A.473
DO I=1,POINTS PFLCLD1A.474
P(I)=P_F(INDEX(I)) PFLCLD1A.475
TL(I)=T_F(INDEX(I)) PFLCLD1A.476
QW(I)=Q_F(INDEX(I)) PFLCLD1A.477
QSL(I)=QSL_F(INDEX(I)) PFLCLD1A.478
QCN(I)=QN_F(INDEX(I)) PFLCLD1A.479
BS(I)=BS_F(INDEX(I)) PFLCLD1A.480
ALPHAL_NM1(I)=ALPHAL_NM1_F(INDEX(I)) PFLCLD1A.481
END DO ! Loop over points PFLCLD1A.482
PFLCLD1A.483
!----------------------------------------------------------------------- PFLCLD1A.484
! Loop over points with cloud. PFLCLD1A.485
!----------------------------------------------------------------------- PFLCLD1A.486
PFLCLD1A.487
DO I=1,POINTS PFLCLD1A.488
IF (RHCRIT .LT. 1.) THEN PFLCLD1A.489
!----------------------------------------------------------------------- PFLCLD1A.490
! 2. Calculate cloud fraction C and normalised cloud water QCN=qc/BS PFLCLD1A.491
! using eqs P292.15 & 16 if RHcrit < 1. PFLCLD1A.492
! N.B. QN (input) is initially in QCN PFLCLD1A.493
! N.B. QN does not depend on AL and so the calculation of CF PFLCLD1A.494
! and QCN can be done outside the iteration (which is performed in PFLCLD1A.495
! LS_CLD_C). QN is > -1 for all points processed so CF > 0. PFLCLD1A.496
!----------------------------------------------------------------------- PFLCLD1A.497
IF (QCN(I) .LE. 0.) THEN PFLCLD1A.498
CF(I)=0.5*(1.+QCN(I))*(1.+QCN(I)) PFLCLD1A.499
QCN(I)=(1.+QCN(I))*(1.+QCN(I))*(1.+QCN(I))/6. PFLCLD1A.500
ELSEIF (QCN(I) .LT. 1.) THEN PFLCLD1A.501
CF(I)=1.-0.5*(1.-QCN(I))*(1.-QCN(I)) PFLCLD1A.502
QCN(I)=QCN(I) + (1.-QCN(I))*(1.-QCN(I))*(1.-QCN(I))/6. PFLCLD1A.503
ELSE ! QN .GE. 1 PFLCLD1A.504
CF(I)=1. PFLCLD1A.505
ENDIF ! Tests on QN PFLCLD1A.506
ELSE ! i.e. if RHcrit =1 PFLCLD1A.507
!----------------------------------------------------------------------- PFLCLD1A.508
! 3.a Set the cloud fraction to 1 if RHcrit = 1. PFLCLD1A.509
! For the case RHcrit =1, QN is > 0 for all points processed PFLCLD1A.510
! so CF =1. PFLCLD1A.511
!----------------------------------------------------------------------- PFLCLD1A.512
CF(I) = 1. PFLCLD1A.513
ENDIF ! Test on RHCRIT PFLCLD1A.514
PFLCLD1A.515
!----------------------------------------------------------------------- PFLCLD1A.516
! 3.1 Calculate 1st approx. to qc (store in QCL) PFLCLD1A.517
!----------------------------------------------------------------------- PFLCLD1A.518
PFLCLD1A.519
QCL(I)=QCN(I)*BS(I) PFLCLD1A.520
PFLCLD1A.521
!----------------------------------------------------------------------- PFLCLD1A.522
! 3.2 Calculate 1st approx. specific humidity (total minus cloud water) PFLCLD1A.523
!----------------------------------------------------------------------- PFLCLD1A.524
PFLCLD1A.525
Q(I)=QW(I)-QCL(I) PFLCLD1A.526
PFLCLD1A.527
!----------------------------------------------------------------------- PFLCLD1A.528
! 3.3 Perform partition of cloud water into liquid and ice PFLCLD1A.529
! components, and calculate 1st approx. to temperature, PFLCLD1A.530
! accounting for latent heating. PFLCLD1A.531
! First assume cloud water is all liquid. PFLCLD1A.532
!----------------------------------------------------------------------- PFLCLD1A.533
PFLCLD1A.534
T(I)=TL(I)+LCRCP*QCL(I) PFLCLD1A.535
IF(T(I) .GT. TM) THEN ! Liquid case PFLCLD1A.536
QCF(I)=0.0 PFLCLD1A.537
ELSE ! Frozen or mixed phase PFLCLD1A.538
PFLCLD1A.539
!----------------------------------------------------------------------- PFLCLD1A.540
! 3.4 Cloud ice present; either all cloud water is cloud ice and T<TM PFLCLD1A.541
! or a mixture of ice and liquid and T=TM PFLCLD1A.542
! PFLCLD1A.543
! Form test temperature assuming all ice PFLCLD1A.544
! N.B. total cloud water stored in QCL at this stage PFLCLD1A.545
!----------------------------------------------------------------------- PFLCLD1A.546
PFLCLD1A.547
TESTT =T(I)+LFRCP*QCL(I) PFLCLD1A.548
IF(TESTT .LT. TM) THEN ! Frozen case PFLCLD1A.549
QCF(I)=QCL(I) PFLCLD1A.550
T(I)=TESTT PFLCLD1A.551
ELSE ! Mixed phase case PFLCLD1A.552
QCF(I)= CPRLF*(TM-T(I)) PFLCLD1A.553
T(I)=TM PFLCLD1A.554
ENDIF ! End frozen PFLCLD1A.555
ENDIF ! End liquid PFLCLD1A.556
PFLCLD1A.557
!----------------------------------------------------------------------- PFLCLD1A.558
! 3.5 Calculate 1st approx. to cloud liquid water content. PFLCLD1A.559
!----------------------------------------------------------------------- PFLCLD1A.560
PFLCLD1A.561
QCL(I) = QCL(I) - QCF(I) PFLCLD1A.562
ENDDO ! Loop over points PFLCLD1A.563
PFLCLD1A.564
!----------------------------------------------------------------------- PFLCLD1A.565
! 4. Iteration to find better cloud water values. PFLCLD1A.566
!----------------------------------------------------------------------- PFLCLD1A.567
PFLCLD1A.568
IF(ITS.GE.2) THEN PFLCLD1A.569
DO N=2,ITS PFLCLD1A.570
PFLCLD1A.571
CALL QSAT(QS,T,P,POINTS) PFLCLD1A.572
PFLCLD1A.573
DO I=1,POINTS PFLCLD1A.574
IF(T(I).GT.TL(I)) THEN PFLCLD1A.575
! N.B. Cloud water > 0 implies T > TL and so the PFLCLD1A.576
! denominator in the following statement is non-zero. PFLCLD1A.577
ALPHAL=(QS(I)-QSL(I))/(T(I)-TL(I)) PFLCLD1A.578
ALPHAL=WTN*ALPHAL+(1.0-WTN)*ALPHAL_NM1(I) PFLCLD1A.579
ALPHAL_NM1(I)=ALPHAL PFLCLD1A.580
FRACF=QCF(I)/(QCL(I)+QCF(I)) PFLCLD1A.581
AL=1.0/(1.0 + (LCRCP+FRACF*LFRCP)*ALPHAL) PFLCLD1A.582
IF (RHCRIT .LT. 1.) THEN PFLCLD1A.583
BS(I)=(1.0-RHCRIT)*AL*QSL(I) ! P292.14 PFLCLD1A.584
ELSE PFLCLD1A.585
BS(I)=AL PFLCLD1A.586
ENDIF PFLCLD1A.587
PFLCLD1A.588
!----------------------------------------------------------------------- PFLCLD1A.589
! 4.1 Calculate Nth approx. to qc (store in QCL). PFLCLD1A.590
!----------------------------------------------------------------------- PFLCLD1A.591
PFLCLD1A.592
QCL(I)=QCN(I)*BS(I) PFLCLD1A.593
PFLCLD1A.594
!----------------------------------------------------------------------- PFLCLD1A.595
! 4.2 Calculate Nth approx. spec. humidity (total minus cloud water). PFLCLD1A.596
!----------------------------------------------------------------------- PFLCLD1A.597
PFLCLD1A.598
Q(I)=QW(I)-QCL(I) PFLCLD1A.599
PFLCLD1A.600
!----------------------------------------------------------------------- PFLCLD1A.601
! 4.3 Perform partition of cloud water into liquid and ice PFLCLD1A.602
! components, and calculate Nth approx. to temperature, PFLCLD1A.603
! accounting for latent heating. PFLCLD1A.604
! First assume cloud water is all liquid. PFLCLD1A.605
!----------------------------------------------------------------------- PFLCLD1A.606
PFLCLD1A.607
T(I)=TL(I)+LCRCP*QCL(I) PFLCLD1A.608
IF(T(I) .GT. TM) THEN ! Liquid case PFLCLD1A.609
QCF(I)=0.0 PFLCLD1A.610
ELSE ! Frozen or mixed phase PFLCLD1A.611
PFLCLD1A.612
!----------------------------------------------------------------------- PFLCLD1A.613
! 4.4 Cloud ice present; either all cloud water is cloud ice and T<TM PFLCLD1A.614
! or a mixture of ice and liquid and T=TM PFLCLD1A.615
! PFLCLD1A.616
! Form test temperature assuming all ice PFLCLD1A.617
! N.B. total cloud water stored in QCL at this stage PFLCLD1A.618
!----------------------------------------------------------------------- PFLCLD1A.619
PFLCLD1A.620
TESTT =T(I)+LFRCP*QCL(I) PFLCLD1A.621
IF(TESTT .LT. TM) THEN ! Frozen case PFLCLD1A.622
QCF(I)=QCL(I) PFLCLD1A.623
T(I)=TESTT PFLCLD1A.624
ELSE ! Mixed phase case PFLCLD1A.625
QCF(I)= CPRLF*(TM-T(I)) PFLCLD1A.626
T(I)=TM PFLCLD1A.627
ENDIF ! End frozen PFLCLD1A.628
ENDIF ! End liquid PFLCLD1A.629
PFLCLD1A.630
!----------------------------------------------------------------------- PFLCLD1A.631
! 4.5 Calculate Nth approx. to cloud liquid water content. PFLCLD1A.632
!----------------------------------------------------------------------- PFLCLD1A.633
PFLCLD1A.634
QCL(I) = QCL(I) - QCF(I) PFLCLD1A.635
ENDIF ! T > TL PFLCLD1A.636
ENDDO ! Loop over points PFLCLD1A.637
ENDDO ! Loop over iterations PFLCLD1A.638
ENDIF ! ITS ge 2 PFLCLD1A.639
PFLCLD1A.640
!----------------------------------------------------------------------- PFLCLD1A.641
! 5. Finally scatter back results PFLCLD1A.642
!----------------------------------------------------------------------- PFLCLD1A.643
PFLCLD1A.644
CDIR$ IVDEP PFLCLD1A.645
DO I=1,POINTS PFLCLD1A.646
Q_F(INDEX(I)) = Q(I) PFLCLD1A.647
T_F(INDEX(I)) = T(I) PFLCLD1A.648
QCF_F(INDEX(I)) = QCF(I) PFLCLD1A.649
QCL_F(INDEX(I)) = QCL(I) PFLCLD1A.650
QC_F(INDEX(I)) = QCL(I) + QCF(I) PFLCLD1A.651
CF_F(INDEX(I)) = CF(I) PFLCLD1A.652
GRID_QC_F(INDEX(I)) = BS(I) * QN_F(INDEX(I)) PFLCLD1A.653
BS_F(INDEX(I)) = BS(I) PFLCLD1A.654
END DO ! Loop over points PFLCLD1A.655
PFLCLD1A.656
RETURN PFLCLD1A.657
END PFLCLD1A.658
*ENDIF PFLCLD1A.659