*IF DEF,RECON,OR,DEF,SCMA AJC0F405.1
C ******************************COPYRIGHT****************************** GTS2F400.4861
C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved. GTS2F400.4862
C GTS2F400.4863
C Use, duplication or disclosure of this code is subject to the GTS2F400.4864
C restrictions as set forth in the contract. GTS2F400.4865
C GTS2F400.4866
C Meteorological Office GTS2F400.4867
C London Road GTS2F400.4868
C BRACKNELL GTS2F400.4869
C Berkshire UK GTS2F400.4870
C RG12 2SZ GTS2F400.4871
C GTS2F400.4872
C If no contract has been raised with this copy of the code, the use, GTS2F400.4873
C duplication or disclosure of it is strictly prohibited. Permission GTS2F400.4874
C to do so must first be obtained in writing from the Head of Numerical GTS2F400.4875
C Modelling at the above address. GTS2F400.4876
C ******************************COPYRIGHT****************************** GTS2F400.4877
C GTS2F400.4878
CLL SUBROUTINE INITQLCF------------------------------------------------ INITQLC1.3
CLL INITQLC1.4
CLL Purpose: Diagnose (initialise) cloud water (frozen + liquid INITQLC1.5
CLL separately) and cloud amount, from standard prognostic INITQLC1.6
CLL model variables (Q, T, P*). INITQLC1.7
CLL INITQLC1.8
CLL For initialisation of RHC see the documentation INITQLC1.9
CLL of sub-component P292 (large-scale cloud). SRHC1 and SRHC2 INITQLC1.10
CLL contain the critical relative humidity discussed in the INITQLC1.11
CLL paragraph incorporating equations P292.11 - P292.14. The INITQLC1.12
CLL values below are based on those used in the old GCM. INITQLC1.13
CLL INITQLC1.14
CLL C.Wilson <- programmer of some or all of previous code or changes INITQLC1.15
CLL INITQLC1.16
CLL Model Modification history from model version 3.0: INITQLC1.17
CLL version Date INITQLC1.18
CLL 4.5 01/05/1998 modify prototype in order to introduce SCM. AJC0F405.2
CLL (JC Thil) AJC0F405.3
CLL INITQLC1.19
CLL Programming standard : INITQLC1.20
CLL INITQLC1.21
CLL Logical components covered : P292 INITQLC1.22
CLL INITQLC1.23
CLL Project task : INITQLC1.24
CLL INITQLC1.25
CLL External documentation: INITQLC1.26
CLL INITQLC1.27
CLLEND ----------------------------------------------------------------- INITQLC1.28
CLL INITQLC1.29
C*L Arguments:--------------------------------------------------------- INITQLC1.30
SUBROUTINE INITQLCF 2,1INITQLC1.31
*IF DEF,SCMA AJC0F405.4
& (AK,BK,RHCRIT,PSTAR,Q,T,P_LEVELS,NPTS,OCF,OQCF,OQCL,NBL,JLEV) AJC0F405.5
*ELSE AJC0F405.6
+(AK,BK,PSTAR,Q,T,P_LEVELS,NPTS,OCF,OQCF,OQCL,NBL,JLEV) INITQLC1.32
*ENDIF AJC0F405.7
INITQLC1.33
IMPLICIT NONE INITQLC1.34
INITQLC1.35
INTEGER INITQLC1.36
+ NBL ! IN No of levels in b.l. INITQLC1.37
+,JLEV ! IN Model level to be processed INITQLC1.38
+,NPTS ! IN No. of gridpoints at each level. INITQLC1.39
+,P_LEVELS ! IN No. of hybrid levels in the model. INITQLC1.40
INITQLC1.41
REAL INITQLC1.42
+ AK(P_LEVELS) ! IN Hybrid co-ordinate. INITQLC1.43
+,BK(P_LEVELS) ! IN Hybrid co-ordinate. INITQLC1.44
*IF DEF,SCMA AJC0F405.8
& ,RHCRIT(P_LEVELS) ! Critical relative humidities AJC0F405.9
*ENDIF AJC0F405.10
+,PSTAR(NPTS) ! IN Surface pressure (Pa). INITQLC1.45
+,Q(NPTS) ! IN Sp humidity (kg water per kg air). INITQLC1.46
+,T(NPTS) ! IN Temperature (K). INITQLC1.47
+,OCF(NPTS) ! OUT Cloud fraction (decimal fraction). INITQLC1.48
+,OQCF(NPTS) ! OUT Cloud ice content (kg per kg air). INITQLC1.49
+,OQCL(NPTS) ! OUT Cloud liquid water (kg per kg air). INITQLC1.50
INITQLC1.51
C External subroutine called------------------------------------------- INITQLC1.52
EXTERNAL QSAT INITQLC1.53
C Workspace usage:----------------------------------------------------- INITQLC1.54
REAL ! Workspace (see later comments for usage):- INITQLC1.55
+ W(NPTS) ! WORK INITQLC1.56
+,WQSAT(NPTS) ! WORK INITQLC1.57
C*--------------------------------------------------------------------- INITQLC1.58
C Local varables:------------------------------------------------------ INITQLC1.59
REAL ! Local (see later comments for usage):- INITQLC1.60
+ WAC ! LOCAL INITQLC1.61
+,WRH ! LOCAL INITQLC1.62
+,ALPHALRCP ! LOCAL INITQLC1.63
+,QC ! LOCAL Cloud water/ice content INITQLC1.64
INITQLC1.65
*CALL C_LHEAT 
INITQLC1.66
*CALL C_R_CP INITQLC1.67
*CALL C_EPSLON INITQLC1.68
*CALL C_0_DG_C INITQLC1.69
*CALL C_PI INITQLC1.70
REAL PFIDDLE,PALCON2E,PALDEP2E,PRCP, ! Derived + local constants. INITQLC1.71
+ PC1,PC2,PC3 INITQLC1.72
PARAMETER ( INITQLC1.73
+ PFIDDLE=0.25 ! Used in 8/8 cloud case. INITQLC1.74
+,PALCON2E=LC*LC*EPSILON ! INITQLC1.75
+,PALDEP2E=(LC+LF)*(LC+LF)*EPSILON ! INITQLC1.76
+,PRCP=R*CP ! INITQLC1.77
+,PC1=1.060660172 ! 3/sqrt(8). INITQLC1.78
+,PC2=2.0*PC1 ! INITQLC1.79
+,PC3=PI/3.0 ! pi/3 INITQLC1.80
+) INITQLC1.81
INITQLC1.82
REAL SRHC1,SRHC2 !critical relative humidity consts INITQLC1.83
DATA SRHC1/0.925/ !in b.l. INITQLC1.84
*,SRHC2/0.85/ !above b.l. INITQLC1.85
REAL RHC !critical relative humidity INITQLC1.86
INITQLC1.87
INTEGER I ! Do loop index INITQLC1.88
INITQLC1.89
C----------------------------------------------------------------------- INITQLC1.90
CLL 0. Initialise critical relative humidity according to level INITQLC1.91
C----------------------------------------------------------------------- INITQLC1.92
INITQLC1.93
IF(JLEV.LT.NBL)THEN INITQLC1.94
RHC=SRHC1 INITQLC1.95
ELSE INITQLC1.96
RHC=SRHC2 INITQLC1.97
ENDIF INITQLC1.98
*IF DEF,SCMA AJC0F405.11
RHC = RHCRIT(JLEV) AJC0F405.12
*ENDIF AJC0F405.13
INITQLC1.99
C----------------------------------------------------------------------- INITQLC1.100
CLL 1. Calculate pressure (in array W), hence QSAT, hence relative INITQLC1.101
CLL humidity in WRH. INITQLC1.102
C----------------------------------------------------------------------- INITQLC1.103
DO I=1,NPTS INITQLC1.104
W(I)=AK(JLEV)+PSTAR(I)*BK(JLEV) INITQLC1.105
ENDDO INITQLC1.106
INITQLC1.107
CALL QSAT(WQSAT,T(1),W,NPTS) INITQLC1.108
INITQLC1.109
DO I=1,NPTS INITQLC1.110
WRH=Q(I)/WQSAT(I) INITQLC1.111
IF(WRH.GT.1.0)WRH=1.0 INITQLC1.112
C----------------------------------------------------------------------- INITQLC1.113
CLL 2. Calculate cloud fraction OCF. (Known as C in formulae). INITQLC1.114
C----------------------------------------------------------------------- INITQLC1.115
OCF(I)=0.0 INITQLC1.116
IF(WRH.GT.RHC .AND. WRH.LT.(5.+RHC)/6.)THEN INITQLC1.117
OCF(I)=2.*COS(PC3+ACOS( PC1*(WRH-RHC)/(1.-RHC) )/3.) INITQLC1.118
OCF(I)=OCF(I)*OCF(I) INITQLC1.119
ENDIF INITQLC1.120
IF(WRH.GE.(5.+RHC)/6.)THEN INITQLC1.121
OCF(I)=PC2*(1.-WRH)/(1.-RHC) INITQLC1.122
OCF(I)=1.-OCF(I)**(2./3.) INITQLC1.123
ENDIF INITQLC1.124
IF(OCF(I).LT.0.0)OCF(I)=0.0 INITQLC1.125
IF(OCF(I).GT.1.0)OCF(I)=1.0 INITQLC1.126
C----------------------------------------------------------------------- INITQLC1.127
CLL 3. Calculate F(C) - store in WAC. INITQLC1.128
C----------------------------------------------------------------------- INITQLC1.129
WAC=0.0 INITQLC1.130
IF(OCF(I).LE.0.5 .AND. OCF(I).GT.0.0)THEN INITQLC1.131
WAC=2.*OCF(I) INITQLC1.132
WAC=SQRT(WAC*WAC*WAC)/6. INITQLC1.133
ENDIF INITQLC1.134
IF(OCF(I).GT.0.5)THEN INITQLC1.135
WAC=2.*(1.-OCF(I)) INITQLC1.136
WAC=1.+ INITQLC1.137
+ SQRT(WAC*WAC*WAC)/6.- INITQLC1.138
+ SQRT(WAC) INITQLC1.139
ENDIF INITQLC1.140
C----------------------------------------------------------------------- INITQLC1.141
CLL 4. Calculate A(C) - store in WAC. INITQLC1.142
C----------------------------------------------------------------------- INITQLC1.143
WAC=WAC*(1.-RHC) INITQLC1.144
C----------------------------------------------------------------------- INITQLC1.145
CLL 5. Calculate total cloud water - store in QC INITQLC1.146
C----------------------------------------------------------------------- INITQLC1.147
IF(T(I).GT.TM)THEN INITQLC1.148
ALPHALRCP=PALCON2E*WQSAT(I)/(PRCP*T(I)*T(I)) INITQLC1.149
ELSE INITQLC1.150
ALPHALRCP=PALDEP2E*WQSAT(I)/(PRCP*T(I)*T(I)) INITQLC1.151
ENDIF INITQLC1.152
C Special treatment of full liquid cloud cover case. INITQLC1.153
IF(OCF(I).GE.1. .AND. T(I).GE.TM)THEN INITQLC1.154
QC=PFIDDLE/(1.+ALPHALRCP*(1.+PFIDDLE)) INITQLC1.155
ELSE INITQLC1.156
QC=WAC/(1.+ALPHALRCP*(WRH+WAC)) INITQLC1.157
ENDIF INITQLC1.158
QC=QC*WQSAT(I) INITQLC1.159
C----------------------------------------------------------------------- INITQLC1.160
CLL 6. Partition cloud water into liquid and ice, and store in output INITQLC1.161
CLL arrays OQCL, OQCF. INITQLC1.162
C----------------------------------------------------------------------- INITQLC1.163
OQCL(I)=0.0 INITQLC1.164
OQCF(I)=0.0 INITQLC1.165
IF(T(I).GT.TM)THEN INITQLC1.166
OQCL(I)=QC INITQLC1.167
ELSE INITQLC1.168
OQCF(I)=QC INITQLC1.169
ENDIF INITQLC1.170
ENDDO ! loop over points INITQLC1.171
INITQLC1.172
RETURN INITQLC1.173
END INITQLC1.174
*ENDIF INITQLC1.175