*IF DEF,A02_1A,OR,DEF,A02_1B,OR,DEF,A02_1C AWA1F304.1
C ******************************COPYRIGHT****************************** GTS2F400.5527
C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved. GTS2F400.5528
C GTS2F400.5529
C Use, duplication or disclosure of this code is subject to the GTS2F400.5530
C restrictions as set forth in the contract. GTS2F400.5531
C GTS2F400.5532
C Meteorological Office GTS2F400.5533
C London Road GTS2F400.5534
C BRACKNELL GTS2F400.5535
C Berkshire UK GTS2F400.5536
C RG12 2SZ GTS2F400.5537
C GTS2F400.5538
C If no contract has been raised with this copy of the code, the use, GTS2F400.5539
C duplication or disclosure of it is strictly prohibited. Permission GTS2F400.5540
C to do so must first be obtained in writing from the Head of Numerical GTS2F400.5541
C Modelling at the above address. GTS2F400.5542
C ******************************COPYRIGHT****************************** GTS2F400.5543
C GTS2F400.5544
CLL Subroutine LWCLD. LWCLD1A.3
CLL LWCLD1A.4
CLL Purpose LWCLD1A.5
CLL ~~~~~~~ LWCLD1A.6
CLL It calculates, from the fractional cloud cover, cloud water paths, LWCLD1A.7
CLL ice and water bulk absorption co-efficients and the fraction of the LWCLD1A.8
CLL cloud to be frozen, the effective cloud amount (cloud amount times LWCLD1A.9
CLL emissivity), for each layer and each longwave band, and returns LWCLD1A.10
CLL 1-this, the "effective clear fraction", in ECA LWCLD1A.11
*IF DEF,RANDOVER LWCLD1A.12
CLL as well as effective cloud top and base amount in ECTA and ECBA LWCLD1A.13
*ENDIF RANDOVER LWCLD1A.14
CLL for use in the overlap calculations when LWMAST constructs the LWCLD1A.15
CLL longwave fluxes. It is a separate routine to make it as easy as LWCLD1A.16
CLL possible to change the cloud generation scheme & the way clouds are LWCLD1A.17
CLL passed into P232. LWCLD1A.18
CLL LWCLD1A.19
CLL Author: William Ingram LWCLD1A.20
CLL LWCLD1A.21
CLL Model Modification history from model version 3.0: LWCLD1A.22
CLL version date LWCLD1A.23
!LL 4.0 28/9/95 FOCWWIL COMDECK now subroutine CALL. (A Bushell) AYY2F400.316
CLL 4.2 Sept.96 T3E migration: *DEF CRAY removed; GSS3F402.24
CLL *DEF T3E used for T3E library functions; GSS3F402.25
CLL dynamic allocation no longer *DEF controlled; GSS3F402.26
CLL cray HF functions replaced by T3E lib functions. GSS3F402.27
CLL S.J.Swarbrick GSS3F402.28
! 4.4 09/4/97 Allow replacement of FOCWWIL parametrization by AYY1F404.338
! direct ratio of prognostic cloud ice to liquid AYY1F404.339
! in layer cloud calculations. (A C Bushell) AYY1F404.340
CLL LWCLD1A.24
CLL Standard LWCLD1A.25
CLL ~~~~~~~~ LWCLD1A.26
CLL If UPDATE *DEF CRAY is off, the code is standard FORTRAN 77 except LWCLD1A.27
CLL It conforms with standard A of version 3 (07/9/90) of UMDP 4, and LWCLD1A.28
CLL contains no 8X-deprecated features. LWCLD1A.29
CLL for having ! comments (it then sets the "vector length" to 1) but LWCLD1A.30
CLL otherwise it includes automatic arrays also. LWCLD1A.31
CLL LWCLD1A.32
CLL It is part of component P232 (longwave radiation), in task P23 LWCLD1A.33
CLL (radiation). LWCLD1A.34
CLL LWCLD1A.35
CLL Offline documentation is in UMDP 23. LWCLD1A.36
C*L LWCLD1A.37
SUBROUTINE LWCLD (LCA, LCCWC1, LCCWC2, CCA, CCCWP, CCB, CCT, 2,2LWCLD1A.38
& TAC, PSTAR, AB, BB, LWCLD1A.39
& L_CLOUD_WATER_PARTITION, AYY1F404.341
& L1, NLEVS, NCLDS, LWCLD1A.40
& L2, GSS3F402.29
*IF DEF,RANDOVER LWCLD1A.44
& ECTA, ECBA, LWCLD1A.45
*ENDIF RANDOVER LWCLD1A.46
& ECA) LWCLD1A.47
C* LWCLD1A.48
EXTERNAL LSP_FOCWWIL AYY2F400.317
! EITHER AYY1F404.342
! Use temperature dependent focwwil for convection but calculate AYY1F404.343
! ratio in layer cloud from prognostic cloud ice produced as part AYY1F404.344
! of large-scale precipitation scheme 3A, OR AYY1F404.345
! Use the subroutine LSP_FOCWWIL (from Section 4) consistently to AYY2F400.318
C ! derive cloud radiative properties and precipitation amount, LWCLD1A.52
C ! taking into account that cloud does not freeze as soon as it is LWCLD1A.53
C ! cooled below the freezing point of bulk water. The release of LWCLD1A.54
C ! latent heat of fusion (not a major term) is done differently in LWCLD1A.55
C ! order to allow energy conservation (UMDP 29). This is the LWCLD1A.56
C ! reason for two layer cloud water contents being passed in and LWCLD1A.57
C ! then combined and differently split. LWCLD1A.58
C ! Array dimensions must be constants in FORTRAN: LWCLD1A.60
*CALL LWNBANDS 
LWCLD1A.63
C*L LWCLD1A.64
INTEGER!, INTENT(IN) :: LWCLD1A.65
& L1, ! Full field dimension LWCLD1A.66
& L2, ! Number of points to be treated GSS3F402.30
& NLEVS, ! Number of model levels LWCLD1A.70
& NCLDS ! Number of possibly cloudy levels LWCLD1A.71
REAL!, INTENT(IN) :: LWCLD1A.72
& LCA(L1,NCLDS), ! Layer cloud fractional cover LWCLD1A.73
& LCCWC1(L1,NCLDS), ! layer cloud condensed water content LWCLD1A.74
& LCCWC2(L1,NCLDS), ! layer cloud condensed ice content LWCLD1A.75
C ! These are specific cloud water contents, mass per unit mass, LWCLD1A.76
C ! and, as explained above, only their sum is used. LWCLD1A.77
& CCA(L1), ! Convective cloud fractional cover LWCLD1A.78
& CCCWP(L1), ! and condensed water path LWCLD1A.79
& TAC(L1,NLEVS), ! Mid-layer atmospheric temperature LWCLD1A.80
& PSTAR(L1), ! Surface pressure LWCLD1A.81
& AB(NLEVS+1),BB(NLEVS+1)! As & Bs at layer boundaries LWCLD1A.82
C ! Note that the fractional cover is that given by P29 without LWCLD1A.83
C ! any knowledge of convective cloud, and in the layers though LWCLD1A.84
C ! which the convective cloud extends it is taken to be the LWCLD1A.85
C ! fractional cover by layer cloud not over the whole grid-box but LWCLD1A.86
C ! the parts outside the convective cloud. LWCLD1A.87
C ! The LCCWC are averages over the whole grid-box, while CCCWP is LWCLD1A.88
C ! the in-cloud value. LWCLD1A.89
INTEGER!, INTENT(IN) :: LWCLD1A.90
& CCB(L1), CCT(L1) ! Convective cloud base and top LWCLD1A.91
LOGICAL!, INTENT(IN) :: AYY1F404.346
& L_CLOUD_WATER_PARTITION ! True if prognostic cloud ice used AYY1F404.347
REAL!, INTENT(OUT) :: LWCLD1A.92
& ECA(L2,NCLDS,NBANDS) ! "effective clear amount" LWCLD1A.93
*IF DEF,RANDOVER LWCLD1A.94
& , ECTA(L2,NCLDS,NBANDS), ! "effective cloud top amount" LWCLD1A.95
& ECBA(L2,NCLDS,NBANDS) ! "effective cloud bottom amount" LWCLD1A.96
*ENDIF RANDOVER LWCLD1A.97
C* LWCLD1A.98
! It has one array CECC, L2 in size, of dynamic storage. GSS3F402.31
! Its structure consists of one nested set of loops to find the GSS3F402.32
! effective cloud contributions from layer cloud, and one for GSS3F402.33
! convective cloud. GSS3F402.34
C LWCLD1A.107
C LWCLD1A.108
REAL CECL, ! Contribution to effective cloud LWCLD1A.109
& CECC(L2), ! from layer and convective cloud LWCLD1A.110
& ABSCCL, ! Mean absorption coeff. for a cloud LWCLD1A.111
& LQFR, ! Liquid fraction of layer AYY2F400.319
& CCLQFR(L2), ! & convective cloud AYY2F400.320
& DPBYG, ! Converts mixing ratio to pathlength LWCLD1A.113
& DAB, DBB, ! Differences of As & Bs LWCLD1A.114
& EXPONC(L1,NCLDS), ! Exponent calculating emissivity GSS3F402.35
& EXPONB(L1,NBANDS) GSS3F402.36
INTEGER BAND, LEVEL, J ! Loopers over band, level and points LWCLD1A.116
*CALL C_G LWCLD1A.117
*CALL C_0_DG_C LWCLD1A.118
*CALL LWABSIW LWCLD1A.119
C GSS3F402.37
REAL expEXPONC(L2,NCLDS) GSS3F402.38
REAL expEXPONB(L2,NBANDS) GSS3F402.39
C GSS3F402.40
C LWCLD1A.120
CL ! Section 1 LWCLD1A.121
CL ! ~~~~~~~~~ LWCLD1A.122
CL ! First find contributions to ECA, ECTA & ECBA from layer cloud: LWCLD1A.123
C LWCLD1A.124
IF (.NOT. L_CLOUD_WATER_PARTITION) THEN AYY1F404.348
! Use end of ECA as workspace for liquid fraction for each layer: AYY2F400.321
DO LEVEL=1, NCLDS AYY2F400.322
CALL LSP_FOCWWIL (TAC(1,LEVEL), L2, ECA(1,LEVEL,NBANDS)) AYY2F400.323
END DO AYY2F400.324
END IF AYY1F404.349
C GSS3F402.41
DO BAND=1, NBANDS GSS3F402.42
DO LEVEL=1, NCLDS GSS3F402.43
DAB = AB(LEVEL) - AB(LEVEL+1) LWCLD1A.127
DBB = BB(LEVEL) - BB(LEVEL+1) LWCLD1A.128
Cfpp$ Select(CONCUR) LWCLD1A.129
DO J=1, L2 GSS3F402.44
C ! From the liquid fraction find the average absorption coefft: LWCLD1A.131
IF (L_CLOUD_WATER_PARTITION) THEN AYY1F404.350
! calculate liquid fraction focwwil as ratio qcl/(qcl+qcf) AYY1F404.351
IF (LCA(J,LEVEL).GT.0.) THEN AYY1F404.352
LQFR = LCCWC1(J,LEVEL)/ (LCCWC1(J,LEVEL)+LCCWC2(J,LEVEL)) AYY1F404.353
ELSE AYY1F404.354
! Arbitrary number: makes it safe & vectorizable AYY1F404.355
LQFR = 0. AYY1F404.356
ENDIF AYY1F404.357
ELSE AYY1F404.358
! set proportion of liquid water focwwil from lsp_focwwil AYY1F404.359
LQFR = ECA(J,LEVEL,NBANDS) AYY2F400.325
ENDIF AYY1F404.360
! AYY1F404.361
ABSCCL = ( 1. - LQFR ) * ABSIW(BAND,1) + LQFR * ABSIW(BAND,2) LWCLD1A.135
C ! Calculate cloud water path and convert to in-cloud mean: LWCLD1A.136
DPBYG = ( DAB + PSTAR(J) * DBB ) / G LWCLD1A.137
EXPONC(J,LEVEL) = GSS3F402.45
& ABSCCL * ( LCCWC1(J,LEVEL) + LCCWC2(J,LEVEL) ) * DPBYG GSS3F402.46
IF ( LCA(J,LEVEL) .NE. 0. ) GSS3F402.47
& EXPONC(J,LEVEL) = EXPONC(J,LEVEL) / LCA(J,LEVEL) GSS3F402.48
end do GSS3F402.49
end do GSS3F402.50
end do GSS3F402.51
*IF DEF,VECTLIB PXVECTLB.95
DO J=1,L2 GSS3F402.53
DO LEVEL=1, NCLDS GSS3F402.54
expEXPONC(J,LEVEL)=EXPONC(J,LEVEL) GSS3F402.55
END DO GSS3F402.56
END DO GSS3F402.57
call exp_v(L2*nclds,expEXPONC,expEXPONC) GSS3F402.58
*ELSE GSS3F402.59
DO J=1,L2 GSS3F402.60
DO LEVEL=1, NCLDS GSS3F402.61
expEXPONC(J,LEVEL)=exp(EXPONC(J,LEVEL)) GSS3F402.62
END DO GSS3F402.63
END DO GSS3F402.64
*ENDIF GSS3F402.65
C ! Equation 2.3.1: LWCLD1A.140
DO BAND=1, NBANDS GSS3F402.66
DO LEVEL=1, NCLDS GSS3F402.67
DO J=1, L2 GSS3F402.68
CECL = LCA(J,LEVEL) * (1. - expEXPONC(J,LEVEL)) GSS3F402.69
IF ( LEVEL .GE. CCB(J) .AND. LEVEL .LT. CCT(J) ) LWCLD1A.148
& CECL = CECL * ( 1. - CCA(J) ) LWCLD1A.149
ECA(J,LEVEL,BAND) = CECL LWCLD1A.150
*IF DEF,RANDOVER LWCLD1A.151
ECTA(J,LEVEL,BAND) = CECL LWCLD1A.152
ECBA(J,LEVEL,BAND) = CECL LWCLD1A.153
*ENDIF RANDOVER LWCLD1A.154
end do GSS3F402.70
end do GSS3F402.71
end do GSS3F402.72
C LWCLD1A.158
CL ! Section 2 LWCLD1A.159
CL ! ~~~~~~~~~ LWCLD1A.160
CL ! And then convective cloud contributes similarly, LWCLD1A.161
C ! except that the temperature from which the ice/water fraction LWCLD1A.162
C ! is calculated is that of the top layer into which it extends, LWCLD1A.163
C ! CCCWP does not need to be converted into an in-cloud value, LWCLD1A.164
C ! and that the effective cloud cover then has to be put into a LWCLD1A.165
C ! range of levels. LWCLD1A.166
C ! LWCLD1A.167
DO J=1, L2 AYY2F400.326
CCLQFR(J) = TAC(J,CCT(J)) AYY2F400.327
END DO AYY2F400.328
CALL LSP_FOCWWIL (CCLQFR, L2, CCLQFR) AYY2F400.329
C GSS3F402.73
DO BAND=1, NBANDS GSS3F402.74
Cfpp$ Select(CONCUR) LWCLD1A.169
DO J=1, L2 GSS3F402.75
ABSCCL = (1.-CCLQFR(J))*ABSIW(BAND,1) + CCLQFR(J)*ABSIW(BAND,2) AYY2F400.330
EXPONB(J,BAND) = ABSCCL * CCCWP(J) GSS3F402.76
end do GSS3F402.77
end do GSS3F402.78
C ! Equation 2.3.1 again: LWCLD1A.176
*IF DEF,VECTLIB PXVECTLB.96
DO J=1,L2 GSS3F402.80
DO BAND=1, NBANDS GSS3F402.81
expEXPONB(J,BAND)=EXPONB(J,BAND) GSS3F402.82
END DO GSS3F402.83
END DO GSS3F402.84
call exp_v(L2*nbands,expEXPONB,expEXPONB) GSS3F402.85
*ELSE GSS3F402.86
DO J=1,L2 GSS3F402.87
DO BAND=1, NBANDS GSS3F402.88
expEXPONB(J,BAND)=exp(EXPONB(J,BAND)) GSS3F402.89
END DO GSS3F402.90
END DO GSS3F402.91
*ENDIF GSS3F402.92
C GSS3F402.93
DO BAND=1, NBANDS GSS3F402.94
DO J=1, L2 GSS3F402.95
CECC(J) = CCA(J) * (1. - expEXPONB(j,band)) GSS3F402.96
*IF DEF,RANDOVER LWCLD1A.182
ECBA(J,CCB(J),BAND) = ECBA(J,CCB(J),BAND) + CECC(J) LWCLD1A.183
ECTA(J,CCT(J)-1,BAND) = ECTA(J,CCT(J)-1,BAND) + CECC(J) LWCLD1A.184
*ENDIF RANDOVER LWCLD1A.185
end do GSS3F402.97
C ! The asymmetry beween CCB and CCT is because the indexing of the LWCLD1A.187
C ! effective cloud arrays is set up to simplify the layer cloud LWCLD1A.188
C ! loop, with a top being indexed like a bottom a layer below. LWCLD1A.189
DO LEVEL=1, NCLDS GSS3F402.98
Cfpp$ Select(CONCUR) LWCLD1A.191
DO J=1, L2 GSS3F402.99
IF ( LEVEL .GE. CCB(J) .AND. LEVEL .LT. CCT(J) ) LWCLD1A.193
& ECA(J,LEVEL,BAND) = ECA(J,LEVEL,BAND) + CECC(J) LWCLD1A.194
end do GSS3F402.100
end do GSS3F402.101
end do GSS3F402.102
C ! LWCLD1A.197
CL ! Section 3 LWCLD1A.198
CL ! ~~~~~~~~~ LWCLD1A.199
CL ! Finally change ECA from effective cloud amount to effective LWCLD1A.200
CL ! clear amount LWCLD1A.201
DO BAND=1, NBANDS GSS3F402.103
DO LEVEL=1, NCLDS GSS3F402.104
DO J=1, L2 GSS3F402.105
ECA(J,LEVEL,BAND) = 1. - ECA(J,LEVEL,BAND) LWCLD1A.205
end do GSS3F402.106
end do GSS3F402.107
end do GSS3F402.108
C LWCLD1A.209
RETURN LWCLD1A.210
END LWCLD1A.211
*ENDIF A02_1A,OR,A02_1B,OR,A02_1C AWA1F304.2