*IF DEF,A09_1A,OR,DEF,A09_2A,OR,DEF,A09_2B ASK1F405.395
C ******************************COPYRIGHT****************************** GTS2F400.919
C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved. GTS2F400.920
C GTS2F400.921
C Use, duplication or disclosure of this code is subject to the GTS2F400.922
C restrictions as set forth in the contract. GTS2F400.923
C GTS2F400.924
C Meteorological Office GTS2F400.925
C London Road GTS2F400.926
C BRACKNELL GTS2F400.927
C Berkshire UK GTS2F400.928
C RG12 2SZ GTS2F400.929
C GTS2F400.930
C If no contract has been raised with this copy of the code, the use, GTS2F400.931
C duplication or disclosure of it is strictly prohibited. Permission GTS2F400.932
C to do so must first be obtained in writing from the Head of Numerical GTS2F400.933
C Modelling at the above address. GTS2F400.934
C ******************************COPYRIGHT****************************** GTS2F400.935
C GTS2F400.936
CLL SUBROUTINE CLOUD_COVER_BASE ------------------------------------- CLDBAS1A.3
CLL CLDBAS1A.4
CLL PURPOSE: CLDBAS1A.5
CLL Return an array holding the lowest cloud base height (Kft) for each CLDBAS1A.6
CLL cloud amount (in octas) requested, from model level cloud cover and CLDBAS1A.7
CLL convective cloud base level and cover. (Cloud cover is input as a CLDBAS1A.8
CLL fraction and cloud base is the height of the half level at the base CLDBAS1A.9
CLL of the layer with cloud) CLDBAS1A.10
CLL Modification: Also return fraction of air below 1000 ft asl PC120793.23
CLL containing cloud and height of base and top of lowest cloud PC120793.24
CLL layer asl. Lowest cloud layer is defined as lowest set of PC120793.25
CLL contiguous levels with cloud amount greater than threshold. PC120793.26
CLL Fraction set to zero if orography > 1000ft. PC120793.27
CLL COMMENT: CLDBAS1A.11
CLL Since only have Q_LEVELS of CLOUD_FRACTION, do we need P_LEVELS? CLDBAS1A.12
CLL CLDBAS1A.13
CLL Model Modification history: CLDBAS1A.14
CLL version Date CLDBAS1A.15
CLL 3.1 05/11/92 New deck author P.Smith CLDBAS1A.16
CLL 3.1 20/01/93 New deck - used as mods at 2.7 & 2.8/3.0. CLDBAS1A.17
CLL Interfacing done by R.T.H.Barnes. CLDBAS1A.18
CLL 3.2 02/07/93 Modification to add cloud fraction below 1000 ft PC120793.28
CLL and low cloud base and top. PC120793.29
CLL Author Pete Clark. PC120793.30
CLL 3.4 24/05/94 Modification to add Wet bulb freezing level height ASW1F304.47
CLL and wet bulb temperature. ASW1F304.48
CLL Author Steve Woltering. ASW1F304.49
CLL 3.4 06/07/94 Modification to calculate model level heights (not ASW1F304.50
CLL output) and total cloud top height. ASW1F304.51
CLL Author Steve Woltering. ASW1F304.52
!LL 4.3 26/02/97 Add first & last points to arg.list. RTHBarnes. ARB2F403.133
CLL CLDBAS1A.19
CLL Programming standard: U M Doc. Paper No. 4 CLDBAS1A.20
CLL CLDBAS1A.21
CLL Logical components covered : CLDBAS1A.22
CLL CLDBAS1A.23
CLL Project task: CLDBAS1A.24
CLL CLDBAS1A.25
CLL External documentation UMDP CLDBAS1A.26
CLL CLDBAS1A.27
CLLEND------------------------------------------------------------- CLDBAS1A.28
C CLDBAS1A.29
C*L Arguments:------------------------------------------------------- CLDBAS1A.30
SUBROUTINE CLOUD_COVER_BASE 1,2CLDBAS1A.31
+ (TEMP,Q,P_STAR,P_EXNER_HALF,OROG !INPUT CLDBAS1A.32
+ ,CONV_CLD_COVER,CONV_BASE_LEV,CLOUD_COVER !INPUT CLDBAS1A.33
+ ,CONV_TOP_LEV !INPUT ASW1F304.53
+ ,P_FIELD,P_LEVELS,Q_LEVELS !INPUT CLDBAS1A.34
+ ,AK,BK,AKH,BKH,OCTAS,N_OCTAS !INPUT ASW1F304.54
+ ,CLD_COVER_RQD,LOW_CLD_RQD !INPUT PC120793.31
+ ,WBFL_RQD,WBTEMP_RQD !INPUT ASW1F304.55
+ ,CLD_TOP_RQD !INPUT ASW1F304.56
+ ,CLOUD_BASE !OUTPUT PC120793.32
+ ,LOW_C_FRAC !OUTPUT PC120793.33
+ ,LOW_C_BASE !OUTPUT PC120793.34
+ ,LOW_C_TOP !OUTPUT ASW1F304.57
+ ,WBFLH !OUTPUT ASW1F304.58
+ ,TW !OUTPUT ASW1F304.59
+ ,CLOUD_TOP !OUTPUT ASW1F304.60
+ ,FIRST_POINT,LAST_POINT) ARB2F403.134
IMPLICIT NONE CLDBAS1A.37
*CALL C_G 
CLDBAS1A.38
*CALL C_0_DG_C ASW1F304.62
*CALL C_EPSLON ASW1F304.63
*CALL C_R_CP CLDBAS1A.39
*CALL C_MDI CLDBAS1A.40
*CALL C_KT_FT CLDBAS1A.41
*CALL C_LOWCLD PC120793.36
C*-------------------------------------------------------------------- CLDBAS1A.42
C input variables----------------------------------------------------- CLDBAS1A.43
C--------------------------------------------------------------------- CLDBAS1A.44
INTEGER CLDBAS1A.45
* P_FIELD ! IN NO. points in field. CLDBAS1A.46
* ,P_LEVELS ! IN NO. of model levels. CLDBAS1A.47
* ,Q_LEVELS ! IN NO. of model wet levels. CLDBAS1A.48
* ,N_OCTAS ! IN NO. of cloud cover limits CLDBAS1A.49
* ,CONV_BASE_LEV(P_FIELD) ! IN level number conv base CLDBAS1A.50
* ,CONV_TOP_LEV(P_FIELD) ! IN level number conv top ASW1F304.64
* ,FIRST_POINT,LAST_POINT ! IN 1st & last pts for calc ARB2F403.135
REAL CLDBAS1A.51
* TEMP(P_FIELD,P_LEVELS) ! IN temp on model levels CLDBAS1A.52
* ,Q(P_FIELD,Q_LEVELS) ! IN spec humidity array CLDBAS1A.53
* ,P_STAR(P_FIELD) ! IN surface press. array CLDBAS1A.54
* ,P_EXNER_HALF(P_FIELD,P_LEVELS+1)! IN 1/2 lev exner press CLDBAS1A.55
* ,OROG(P_FIELD) ! IN model orography array CLDBAS1A.56
* ,CONV_CLD_COVER(P_FIELD) ! IN conv cloud cover arr CLDBAS1A.57
* ,CLOUD_COVER(P_FIELD,Q_LEVELS) ! IN cloud cover -mod levs CLDBAS1A.58
* ,AKH(P_LEVELS+1) ! IN A 1/2 lev hybrid coord ASW1F304.65
* ,BKH(P_LEVELS+1) ! IN B 1/2 lev hybrid coord ASW1F304.66
* ,AK(P_LEVELS) ! IN A lev hybrid coord ASW1F304.67
* ,BK(P_LEVELS) ! IN B lev hybrid coord ASW1F304.68
* ,OCTAS(N_OCTAS) ! IN cloud cover limits CLDBAS1A.61
LOGICAL PC120793.37
* CLD_COVER_RQD ! IN TRUE if cloud cover data required PC120793.38
* ,LOW_CLD_RQD ! IN TRUE if low cloud data required PC120793.39
* ,WBFL_RQD ! IN TRUE if wet bulb freezing lev rqd ASW1F304.69
* ,WBTEMP_RQD ! IN TRUE if wet bulb temp required ASW1F304.70
* ,CLD_TOP_RQD ! IN TRUE if cloud top height required ASW1F304.71
C*-------------------------------------------------------------------- CLDBAS1A.62
C Output variables---------------------------------------------------- CLDBAS1A.63
C--------------------------------------------------------------------- CLDBAS1A.64
REAL CLDBAS1A.65
* CLOUD_BASE(P_FIELD,N_OCTAS) ! OUT cloud bases for amnts. CLDBAS1A.66
* ,LOW_C_FRAC(P_FIELD) ! OUT cloud amt below 1000 ft. PC120793.40
* ,LOW_C_BASE(P_FIELD) ! OUT base of lowest cloud. PC120793.41
* ,LOW_C_TOP(P_FIELD) ! OUT top of lowest cloud. PC120793.42
* ,TW(P_FIELD,Q_LEVELS) ! OUT Wet bulb temp. ASW1F304.72
* ,WBFLH(P_FIELD) ! OUT Wet bulb freezing lev ht ASW1F304.73
* ,CLOUD_TOP(P_FIELD) ! Cloud top height. ASW1F304.74
C*-------------------------------------------------------------------- CLDBAS1A.67
C External subroutines called----------------------------------------- CLDBAS1A.68
C--------------------------------------------------------------------- CLDBAS1A.69
EXTERNAL V_INT_ZH, TWBULB ASW1F304.75
C*-------------------------------------------------------------------- CLDBAS1A.71
C Local varables:----------------------------------------------------- CLDBAS1A.72
C--------------------------------------------------------------------- CLDBAS1A.73
INTEGER CLDBAS1A.74
; I ! LOOP p_fields CLDBAS1A.75
; ,J ! LOOP p_levels - q_levels CLDBAS1A.76
; ,L ! LOOP p_levels - q_levels ASW1F304.76
; ,K ! LOOP n_octas CLDBAS1A.77
; ,CLOUD_BASE_LEV(P_FIELD,N_OCTAS) ! level num of cloud base CLDBAS1A.78
; ,CLOUD_TOP_LEV(P_FIELD) ! Level of total cld top ASW1F304.77
REAL CLDBAS1A.79
; PHI_STAR(P_FIELD) ! geopotential CLDBAS1A.80
; ,CONV_AMNT(P_FIELD) ! conv cloud amnt octas CLDBAS1A.81
; ,CLOUD_AMNT(P_FIELD,Q_LEVELS) ! cloud amnt octas CLDBAS1A.82
; ,THETA(P_FIELD,P_LEVELS) ! pot. temp model levels ASW1F304.78
; ,MODEL_HALF_HT(P_FIELD,P_LEVELS+1) ! hts of model half levs ASW1F304.79
; ,P_EXNER(P_FIELD,P_LEVELS) ! Level exner press. ASW1F304.80
; ,HEIGHT(P_FIELD,P_LEVELS) ! Level heights ASL. ASW1F304.81
; ,Z ! Level heights. ASW1F304.82
; ,PU,PL ! Upper & lower 1/2 lev pressure CLDBAS1A.85
; ,M_TO_KFT ! convert metres to kiloft CLDBAS1A.86
; ,PT ! p thickness accumulator PC120793.43
; ,FT ! cloud fract accumulator PC120793.44
; ,DP ! Layer pressure thickness PC120793.45
; ,H_ASL ! Layer base height asl PC120793.46
; ,H_ASLN ! Layer top height asl PC120793.47
; ,FR ! Layer fraction below ceil PC120793.48
; ,CP_OVER_G ! Used in level hghts calc. ASW1F304.83
; ,THRESH ! Threshold val for cld top ASW1F304.84
; ,CLD ! Intermediate cloud variab ASW1F304.85
; ,FRAC ! Interpolation fraction ASW1F304.86
; ,STR_CEILM ! STR_CEIL in M PC120793.49
PARAMETER ( CP_OVER_G = CP / G) ASW1F304.87
PARAMETER ( THRESH = 0.0627) ASW1F304.88
*CALL P_EXNERC CLDBAS1A.87
C----------------------------------------------------------------------C CLDBAS1A.88
C Set metres to KiloFT conversion C CLDBAS1A.89
C----------------------------------------------------------------------C CLDBAS1A.90
M_TO_KFT = (1./FT2M)*0.001 CLDBAS1A.91
STR_CEILM=STR_CEIL * FT2M PC120793.50
C----------------------------------------------------------------------C CLDBAS1A.101
C FIND HEIGHTS of MODEL HALF LEVELS C CLDBAS1A.102
C----------------------------------------------------------------------C CLDBAS1A.103
C GEOPOTENTIAL CLDBAS1A.104
DO I=1,P_FIELD CLDBAS1A.105
C PHI_STAR(I) = OROG(I) * G ! for ht above sea level CLDBAS1A.106
PHI_STAR(I) = 0.0 ! for ht above model orography CLDBAS1A.107
ENDDO CLDBAS1A.108
C TEMP to THETA CLDBAS1A.109
DO J=1,P_LEVELS ASW1F304.89
DO I=1,P_FIELD CLDBAS1A.111
PU = AKH(J+1)+BKH(J+1)*P_STAR(I) CLDBAS1A.112
PL = AKH(J)+BKH(J)*P_STAR(I) CLDBAS1A.113
P_EXNER(I,J) = P_EXNER_C( P_EXNER_HALF(I,J+1), ASW1F304.90
& P_EXNER_HALF(I,J),PU,PL,KAPPA ) CLDBAS1A.115
THETA(I,J) = TEMP(I,J)/P_EXNER(I,J) ASW1F304.91
ENDDO CLDBAS1A.116
ENDDO CLDBAS1A.117
CALL V_INT_ZH(P_EXNER_HALF,THETA,Q,PHI_STAR,MODEL_HALF_HT, CLDBAS1A.118
* P_FIELD,P_LEVELS,Q_LEVELS) ASW1F304.92
C----------------------------------------------------------------------C ASW1F304.93
C FIND HEIGHTS OF MODEL LEVELS C ASW1F304.94
C----------------------------------------------------------------------C ASW1F304.95
IF (WBFL_RQD .OR. CLD_TOP_RQD) THEN ASW1F304.96
DO J=1,Q_LEVELS ASW1F304.97
DO I=1,P_FIELD ASW1F304.98
Z = MODEL_HALF_HT(I,J) + CP_OVER_G* ASW1F304.99
& (1.0+C_VIRTUAL*Q(I,J))*THETA(I,J) ASW1F304.100
& *(P_EXNER_HALF(I,J) - P_EXNER(I,J)) ASW1F304.101
HEIGHT(I,J) = Z + OROG(I) ASW1F304.102
ENDDO ASW1F304.103
ENDDO ASW1F304.104
IF(P_LEVELS .GT. Q_LEVELS) THEN ASW1F304.105
IF(P_LEVELS .GT. Q_LEVELS) THEN ASW1F304.106
DO J=Q_LEVELS+1,P_LEVELS ASW1F304.107
DO I=1,P_FIELD ASW1F304.108
Z = MODEL_HALF_HT(I,J) + CP_OVER_G* ASW1F304.109
& THETA(I,J) ASW1F304.110
& *(P_EXNER_HALF(I,J) - P_EXNER(I,J)) ASW1F304.111
HEIGHT(I,J) = Z + OROG(I) ASW1F304.112
ENDDO ASW1F304.113
ENDDO ASW1F304.114
END IF ASW1F304.115
ENDIF ASW1F304.116
ENDIF ASW1F304.117
C----------------------------------------------------------------------C ASW1F304.118
C CALCULATE THE WET BULB TEMP AND/OR WET BULB FREEZING LEVEL C ASW1F304.119
C----------------------------------------------------------------------C ASW1F304.120
IF (WBTEMP_RQD .OR. WBFL_RQD) THEN ASW1F304.121
CALL TWBULB(Q,P_STAR,TEMP,AK,BK,P_FIELD,P_LEVELS,Q_LEVELS, ASW1F304.122
* TW,FIRST_POINT,LAST_POINT) ARB2F403.136
IF (WBFL_RQD) THEN ASW1F304.124
DO I = 1,P_FIELD ASW1F304.125
DO L = 1,Q_LEVELS ASW1F304.126
IF (TW(I,L) .NE. RMDI) THEN ASW1F304.127
IF (TW(I,L) .LE. ZERODEGC) THEN ASW1F304.128
IF(L .EQ. 1) THEN ASW1F304.129
WBFLH(I) = HEIGHT(I,L) ASW1F304.130
ELSE ASW1F304.131
FRAC = (ZERODEGC - TW(I,L-1))/(TW(I,L) - TW(I,L-1)) ASW1F304.132
WBFLH(I) = HEIGHT(I,L)*FRAC + HEIGHT(I,L-1) ASW1F304.133
& *(1.0-FRAC) ASW1F304.134
ENDIF ASW1F304.135
GOTO 100 ASW1F304.136
ENDIF ASW1F304.137
ELSE ASW1F304.138
WBFLH(I) = RMDI ASW1F304.139
ENDIF ASW1F304.140
ENDDO ASW1F304.141
100 CONTINUE ASW1F304.142
ENDDO ASW1F304.143
ENDIF ASW1F304.144
ENDIF ASW1F304.145
IF (CLD_TOP_RQD) THEN ASW1F304.146
C----------------------------------------------------------------------C ASW1F304.147
C INITIALISE OUTPUT ARRAYS C ASW1F304.148
C----------------------------------------------------------------------C ASW1F304.149
DO I=1,P_FIELD ASW1F304.150
CLOUD_TOP(I)=RMDI ASW1F304.151
CLOUD_TOP_LEV(I)=IMDI ASW1F304.152
ENDDO ASW1F304.153
C----------------------------------------------------------------------C ASW1F304.154
C CALCULATE TOTAL CLOUD TOP LEVELS C ASW1F304.155
C----------------------------------------------------------------------C ASW1F304.156
DO I=1,P_FIELD ASW1F304.157
DO J=Q_LEVELS,1,-1 ASW1F304.158
IF (J .GT. CONV_TOP_LEV(I) .OR. J .LT. CONV_BASE_LEV(I)) ASW1F304.159
* THEN ASW1F304.160
IF (CLOUD_COVER(I,J) .GE. THRESH) THEN ASW1F304.161
CLOUD_TOP_LEV(I) = J ASW1F304.162
ENDIF ASW1F304.163
ELSE ASW1F304.164
CLD = CONV_CLD_COVER(I) + ASW1F304.165
* (1 - CONV_CLD_COVER(I))*CLOUD_COVER(I,J) ASW1F304.166
IF (CLD .GE. THRESH) THEN ASW1F304.167
CLOUD_TOP_LEV(I) = J ASW1F304.168
ENDIF ASW1F304.169
ENDIF ASW1F304.170
IF (CLOUD_TOP_LEV(I) .GT. 0) GOTO 1000 ASW1F304.171
ENDDO ASW1F304.172
1000 CONTINUE ASW1F304.173
ENDDO ASW1F304.174
C----------------------------------------------------------------------C ASW1F304.175
C CALCULATE TOTAL CLOUD TOP HEIGHTS C ASW1F304.176
C----------------------------------------------------------------------C ASW1F304.177
DO I=1,P_FIELD ASW1F304.178
IF (CLOUD_TOP_LEV(I) .GT. 0) THEN ASW1F304.179
CLOUD_TOP(I) = HEIGHT(I,CLOUD_TOP_LEV(I)) * M_TO_KFT ASW1F304.180
ENDIF ASW1F304.181
ENDDO ASW1F304.182
ENDIF ASW1F304.183
IF(CLD_COVER_RQD) THEN PC120793.51
C----------------------------------------------------------------------C CLDBAS1A.120
C INITIALISE OUTPUT ARRAY C PC120793.52
C----------------------------------------------------------------------C PC120793.53
DO J=1,N_OCTAS PC120793.54
DO I=1,P_FIELD PC120793.55
CLOUD_BASE(I,J) = RMDI PC120793.56
CLOUD_BASE_LEV(I,J) = IMDI PC120793.57
ENDDO PC120793.58
ENDDO PC120793.59
C----------------------------------------------------------------------C PC120793.60
C CONVERT CONV.CLOUD COVER TO OKTAS C CLDBAS1A.121
C----------------------------------------------------------------------C CLDBAS1A.122
DO I=1,P_FIELD CLDBAS1A.123
CONV_AMNT(I) = CONV_CLD_COVER(I) * 8.0 CLDBAS1A.124
ENDDO CLDBAS1A.125
C----------------------------------------------------------------------C CLDBAS1A.126
C CONVERT CLOUD COVER TO OKTAS C CLDBAS1A.127
C----------------------------------------------------------------------C CLDBAS1A.128
DO J=1,Q_LEVELS CLDBAS1A.129
DO I=1,P_FIELD CLDBAS1A.130
CLOUD_AMNT(I,J) = CLOUD_COVER(I,J) * 8.0 CLDBAS1A.131
ENDDO CLDBAS1A.132
ENDDO CLDBAS1A.133
C----------------------------------------------------------------------C CLDBAS1A.134
C SET CLOUD BASE TO MODEL LEVELS FOR CLOUD BANDS C CLDBAS1A.135
C----------------------------------------------------------------------C CLDBAS1A.136
DO K=1,N_OCTAS CLDBAS1A.137
DO J=1,Q_LEVELS CLDBAS1A.138
DO I=1,P_FIELD CLDBAS1A.139
IF(CLOUD_AMNT(I,J).GT.OCTAS(K)) THEN CLDBAS1A.140
IF(CLOUD_BASE_LEV(I,K).LT.0) THEN CLDBAS1A.141
CLOUD_BASE_LEV(I,K) = J CLDBAS1A.142
ENDIF CLDBAS1A.143
ENDIF CLDBAS1A.144
ENDDO CLDBAS1A.145
ENDDO CLDBAS1A.146
ENDDO CLDBAS1A.147
C----------------------------------------------------------------------C CLDBAS1A.148
C COMPARE WITH CONVECTIVE CLOUD AND MODIFY IF NEEDED C CLDBAS1A.149
C----------------------------------------------------------------------C CLDBAS1A.150
DO K=1,N_OCTAS CLDBAS1A.151
DO I=1,P_FIELD CLDBAS1A.152
IF(CONV_AMNT(I).GT.OCTAS(K)) THEN CLDBAS1A.153
IF(CLOUD_BASE_LEV(I,K).LT.0 .OR. CLDBAS1A.154
* CLOUD_BASE_LEV(I,K).GT.CONV_BASE_LEV(I)) THEN CLDBAS1A.155
CLOUD_BASE_LEV(I,K) = CONV_BASE_LEV(I) CLDBAS1A.156
ENDIF CLDBAS1A.157
ENDIF CLDBAS1A.158
ENDDO CLDBAS1A.159
ENDDO CLDBAS1A.160
C----------------------------------------------------------------------C CLDBAS1A.161
C CONVERT LEVEL NUMBERS TO HEIGHTS (M converted to Kft) C CLDBAS1A.162
C----------------------------------------------------------------------C CLDBAS1A.163
DO K=1,N_OCTAS CLDBAS1A.164
DO I=1,P_FIELD CLDBAS1A.165
IF(CLOUD_BASE_LEV(I,K).GT.0) THEN CLDBAS1A.166
CLOUD_BASE(I,K) = MODEL_HALF_HT(I,CLOUD_BASE_LEV(I,K)) CLDBAS1A.167
CLOUD_BASE(I,K) = CLOUD_BASE(I,K) * M_TO_KFT CLDBAS1A.168
ENDIF CLDBAS1A.169
ENDDO CLDBAS1A.170
ENDDO CLDBAS1A.171
ENDIF PC120793.61
IF(LOW_CLD_RQD) THEN PC120793.62
C----------------------------------------------------------------------C PC120793.63
C FIND CLOUD FRACTION IN AIR < STR_CEIL, LOW_C_BASE C PC120793.64
C AND LOW_C_TOP C PC120793.65
C----------------------------------------------------------------------C PC120793.66
DO I=1,P_FIELD PC120793.67
PT=0.0 PC120793.68
FT=0.0 PC120793.69
LOW_C_BASE(I)=RMDI ! Initialise output variables PC120793.70
LOW_C_TOP(I)=RMDI PC120793.71
LOW_C_FRAC(I)=RMDI PC120793.72
H_ASLN=OROG(I) PC120793.73
DO J=1,Q_LEVELS PC120793.74
H_ASL=H_ASLN PC120793.75
H_ASLN=MODEL_HALF_HT(I,J+1)+OROG(I) PC120793.76
C PC120793.77
C Check if have not already found low cloud base. PC120793.78
IF(LOW_C_BASE(I).EQ.RMDI) THEN PC120793.79
C If not, and cloud cover in this layer > threshold PC120793.80
IF(CLOUD_COVER(I,J).GE.CLOUD_THRESHOLD) THEN PC120793.81
C Then call the bottom of this layer the base of low cloud. PC120793.82
LOW_C_BASE(I) = H_ASL / FT2M PC120793.83
ENDIF PC120793.84
ENDIF PC120793.85
C PC120793.86
C Check if already found low cloud base but not top. PC120793.87
IF(LOW_C_BASE(I).NE.RMDI.AND.LOW_C_TOP(I).EQ.RMDI) PC120793.88
+ THEN PC120793.89
C If not, and cloud cover in this layer < threshold PC120793.90
IF(CLOUD_COVER(I,J).LT.CLOUD_THRESHOLD) THEN PC120793.91
C Then call the bottom of this layer the top of low cloud. PC120793.92
LOW_C_TOP(I) = H_ASL / FT2M PC120793.93
ENDIF PC120793.94
ENDIF PC120793.95
C PC120793.96
C If bottom of layer is below low cloud ceiling (1000ft) PC120793.97
IF(H_ASL.LT.STR_CEILM) THEN PC120793.98
C Calculate top and bottom layer pressures PC120793.99
PU = AKH(J+1)+BKH(J+1)*P_STAR(I) PC120793.100
PL = AKH(J)+BKH(J)*P_STAR(I) PC120793.101
C And accumulate pressure thickness and pressure weighted cloud amt PC120793.102
DP = PU - PL PC120793.103
C If whole layer below ceiling, simply accumulate whole layer. PC120793.104
IF(H_ASLN.LT.STR_CEILM) THEN PC120793.105
PT = PT + DP PC120793.106
FT = FT + DP * CLOUD_COVER(I,J) PC120793.107
ELSE PC120793.108
C Otherwise height interpolate. PC120793.109
FR = (STR_CEILM - H_ASL) / (H_ASLN - H_ASL) PC120793.110
PT = PT + DP * FR PC120793.111
FT = FT + DP * CLOUD_COVER(I,J) * FR PC120793.112
C And set result PC120793.113
LOW_C_FRAC(I) = FT / PT PC120793.114
ENDIF PC120793.115
ENDIF PC120793.116
ENDDO ! J over Q_LEVELS PC120793.117
ENDDO ! I over P_FIELD PC120793.118
ENDIF PC120793.119
C----------------------------------------------------------------------C CLDBAS1A.172
C C CLDBAS1A.173
C----------------------------------------------------------------------C CLDBAS1A.174
RETURN CLDBAS1A.175
END CLDBAS1A.176
*ENDIF CLDBAS1A.177