*IF DEF,A09_1A,OR,DEF,A09_2A,OR,DEF,A09_2B,OR,DEF,A18_1A ASK1F405.396
C ******************************COPYRIGHT****************************** GTS2F400.901
C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved. GTS2F400.902
C GTS2F400.903
C Use, duplication or disclosure of this code is subject to the GTS2F400.904
C restrictions as set forth in the contract. GTS2F400.905
C GTS2F400.906
C Meteorological Office GTS2F400.907
C London Road GTS2F400.908
C BRACKNELL GTS2F400.909
C Berkshire UK GTS2F400.910
C RG12 2SZ GTS2F400.911
C GTS2F400.912
C If no contract has been raised with this copy of the code, the use, GTS2F400.913
C duplication or disclosure of it is strictly prohibited. Permission GTS2F400.914
C to do so must first be obtained in writing from the Head of Numerical GTS2F400.915
C Modelling at the above address. GTS2F400.916
C ******************************COPYRIGHT****************************** GTS2F400.917
C GTS2F400.918
CLL SUBROUTINEs RH_TO_CC & CC_TO_RH------------------------------------ CLD2RH1A.3
CLL CLD2RH1A.4
CLL Purpose: calculate cloud cover (fraction) from input rh (%) CLD2RH1A.5
CLL : and vice versa CLD2RH1A.6
CLL : uses eqs P292.19 to P292.21 in UM Doc Paper 29 CLD2RH1A.7
CLL CLD2RH1A.8
CLL Model Modification History : CLD2RH1A.9
CLL version Date CLD2RH1A.10
CLL 3.3 22/12/93 Coded by Bruce Macpherson and Nigel Richards CLD2RH1A.11
CLL CLD2RH1A.12
CLL Programming Standard : UM CLD2RH1A.13
CLL CLD2RH1A.14
CLL Project Task : P29 CLD2RH1A.15
CLL CLD2RH1A.16
CLLEND------------------------------------------------------------- CLD2RH1A.17
C CLD2RH1A.18
C----Arguments:--------------------------------------------------------- CLD2RH1A.19
SUBROUTINE RH_TO_CC (RH,NPTS,RHC,CC) CLD2RH1A.20
CLD2RH1A.21
IMPLICIT NONE CLD2RH1A.22
CLD2RH1A.23
INTEGER CLD2RH1A.24
+ NPTS ! IN No. of points on level. CLD2RH1A.25
CLD2RH1A.26
REAL CLD2RH1A.27
+ RHC ! IN Critical relative humidity (fraction). CLD2RH1A.28
+,RH(NPTS) ! IN Rel humidity (%). CLD2RH1A.29
+,CC(NPTS) ! OUT Cloud cover (fraction). CLD2RH1A.30
CLD2RH1A.31
C---------------------------------------------------------------------- CLD2RH1A.32
C External subroutine calls NONE CLD2RH1A.33
C----------------------------------------------------------------------- CLD2RH1A.34
CLD2RH1A.35
C Local variables------------------------------------------------------ CLD2RH1A.36
REAL WRH ! Local rh (fraction) CLD2RH1A.37
CLD2RH1A.38
*CALL C_PI 
CLD2RH1A.39
CLD2RH1A.40
REAL PC1,PC2,PC3 ! local constants. CLD2RH1A.41
PARAMETER ( CLD2RH1A.42
+ PC1=1.060660172 ! 3/sqrt(8). CLD2RH1A.43
+,PC2=2.0*PC1 ! CLD2RH1A.44
+,PC3=PI/3.0 ! pi/3 CLD2RH1A.45
+) CLD2RH1A.46
CLD2RH1A.47
INTEGER I ! Do loop index CLD2RH1A.48
CLD2RH1A.49
DO I=1,NPTS CLD2RH1A.50
C----------------------------------------------------------------------- CLD2RH1A.51
CLL Calculate cloud fraction. CLD2RH1A.52
C----------------------------------------------------------------------- CLD2RH1A.53
C Work with rh fraction CLD2RH1A.54
WRH=0.01*RH(I) CLD2RH1A.55
C Remove any supersaturation CLD2RH1A.56
IF(WRH.GT.1.0) WRH=1.0 CLD2RH1A.57
CC(I)=0.0 CLD2RH1A.58
C For WRH<RHC (including WRH<0), CC remains zero. CLD2RH1A.59
C This treats the special MOPS rh=-85% for zero cloud cover. CLD2RH1A.60
IF(WRH.GT.RHC .AND. WRH.LT.(5.+RHC)/6.)THEN CLD2RH1A.61
CC(I)=2.*COS(PC3+ACOS( PC1*(WRH-RHC)/(1.-RHC) )/3.) CLD2RH1A.62
CC(I)=CC(I)*CC(I) CLD2RH1A.63
ENDIF CLD2RH1A.64
IF(WRH.GE.(5.+RHC)/6.)THEN CLD2RH1A.65
CC(I)=PC2*(1.-WRH)/(1.-RHC) CLD2RH1A.66
CC(I)=1.-CC(I)**(2./3.) CLD2RH1A.67
ENDIF CLD2RH1A.68
ENDDO ! end loop over points CLD2RH1A.69
CLD2RH1A.70
RETURN CLD2RH1A.71
END CLD2RH1A.72
CLD2RH1A.73
C----Arguments:--------------------------------------------------------- CLD2RH1A.74
SUBROUTINE CC_TO_RH (CC,NPTS,RHC,RH) CLD2RH1A.75
CLD2RH1A.76
IMPLICIT NONE CLD2RH1A.77
CLD2RH1A.78
INTEGER CLD2RH1A.79
+ NPTS ! IN No. of points on level. CLD2RH1A.80
CLD2RH1A.81
REAL CLD2RH1A.82
+ RHC ! IN Critical relative humidity (fraction). CLD2RH1A.83
+,CC(NPTS) ! IN Cloud cover (fraction). CLD2RH1A.84
+,RH(NPTS) ! OUT Rel humidity (%). CLD2RH1A.85
CLD2RH1A.86
C---------------------------------------------------------------------- CLD2RH1A.87
C External subroutine calls NONE CLD2RH1A.88
C----------------------------------------------------------------------- CLD2RH1A.89
CLD2RH1A.90
C Local variables------------------------------------------------------ CLD2RH1A.91
CLD2RH1A.92
INTEGER I ! Do loop index CLD2RH1A.93
CLD2RH1A.94
C Code in calling routine restricts CC to range 0-1 CLD2RH1A.95
C but check to be safe CLD2RH1A.96
CLD2RH1A.97
DO I=1,NPTS CLD2RH1A.98
IF (CC(I).GT.1.0) CC(I) = 1.0 CLD2RH1A.99
IF (CC(I).LT.0.0) CC(I) = 0.0 CLD2RH1A.100
CLD2RH1A.101
IF (CC(I).GT.0.5) THEN CLD2RH1A.102
C from eqn p292.21 CLD2RH1A.103
RH(I) = 1.0 - CLD2RH1A.104
& (1.-CC(I))**(3.0/2.0) * SQRT(2.0)/3.0 * (1.-RHC) CLD2RH1A.105
ELSE CLD2RH1A.106
C from eqn p292.19 CLD2RH1A.107
RH(I) = RHC + CLD2RH1A.108
& SQRT(2.0*CC(I)) * (1.0-CC(I)/3.0) * (1.-RHC) CLD2RH1A.109
ENDIF CLD2RH1A.110
RH(I) = RH(I) * 100.0 CLD2RH1A.111
END DO CLD2RH1A.112
CLD2RH1A.113
RETURN CLD2RH1A.114
END CLD2RH1A.115
*ENDIF CLD2RH1A.116