*IF DEF,A09_1A,OR,DEF,A09_2A,OR,DEF,A09_2B,OR,DEF,A18_1A ASK1F405.394
C ******************************COPYRIGHT****************************** GTS2F400.955
C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved. GTS2F400.956
C GTS2F400.957
C Use, duplication or disclosure of this code is subject to the GTS2F400.958
C restrictions as set forth in the contract. GTS2F400.959
C GTS2F400.960
C Meteorological Office GTS2F400.961
C London Road GTS2F400.962
C BRACKNELL GTS2F400.963
C Berkshire UK GTS2F400.964
C RG12 2SZ GTS2F400.965
C GTS2F400.966
C If no contract has been raised with this copy of the code, the use, GTS2F400.967
C duplication or disclosure of it is strictly prohibited. Permission GTS2F400.968
C to do so must first be obtained in writing from the Head of Numerical GTS2F400.969
C Modelling at the above address. GTS2F400.970
C ******************************COPYRIGHT****************************** GTS2F400.971
C GTS2F400.972
CLL SUBROUTINE CLOUD_COVER-------------------------------------------- CLDCVR1A.3
CLL CLDCVR1A.4
CLL PURPOSE: CLDCVR1A.5
CLL This routine combines model level cloud into three categories; CLDCVR1A.6
CLL High,Medium and Low. The criteria for the upper and lower CLDCVR1A.7
CLL boundaries were provided by C.F.O and are input to this routine. CLDCVR1A.8
CLL It also provides total cloud cover as it would be with either WI080293.6
CLL random or maximum/random cloud overlap. WI080293.7
CLL CLDCVR1A.10
CLL Model Modification history from model version 3.0: CLDCVR1A.11
CLL version Date CLDCVR1A.12
CLL 3.1 8/2/92 Total cloud cover diagnostics added. WI080293.8
CLL 3.2 13/07/93 Changed CHARACTER*(*) to CHARACTER*(80) for TS150793.231
CLL portability. Author Tracey Smith. TS150793.232
CLL 3.3 10/12/93 Change *DEF to include A18_1A Bruce M SB151293.417
CLL 3.3 15/12/93 Calculation of TCA_MAXRAN corrected to allow WI141293.4
CLL for zero convective cloud cover. WI141293.5
! 4.4 31/07/97 Add cloud frequency diagnostic. Andrew Bushell AYY1F404.224
CLL CLDCVR1A.13
CLL Programming standard: U M DOC Paper NO. 4, CLDCVR1A.14
CLL CLDCVR1A.15
CLL Logical components covered : D433 CLDCVR1A.16
CLL CLDCVR1A.17
CLL Project task: D4 CLDCVR1A.18
CLL CLDCVR1A.19
CLL External documentation UMDP CLDCVR1A.20
CLL CLDCVR1A.21
CLLEND------------------------------------------------------------- CLDCVR1A.22
C CLDCVR1A.23
C*L ARGUMENTS:----------------------------------------------------- CLDCVR1A.24
SUBROUTINE CLOUD_COVER 1CLDCVR1A.25
* (MODEL_CLOUD, CONVECTIVE_CLOUD, CCB, CCT, WI080293.9
* LOW_CLOUD, MED_CLOUD, HIGH_CLOUD, TCA_RANDOM, TCA_MAXRAN, WI080293.10
& LAYER_CLOUD_PRESENT, AYY1F404.225
* LOW_BOT_LEVEL,LOW_TOP_LEVEL, CLDCVR1A.27
* MED_BOT_LEVEL,MED_TOP_LEVEL,HIGH_BOT_LEVEL,HIGH_TOP_LEVEL, CLDCVR1A.28
* FLAG_LOW, FLAG_MED, FLAG_HIGH, FLAG_TRA, FLAG_TMR, WI080293.11
& FLAG_LCP,CLOUD_LEVELS,POINTS,Q_LEVELS,ICODE,CMESSAGE) AYY1F404.226
C CLDCVR1A.31
IMPLICIT NONE CLDCVR1A.32
CHARACTER*(80) CMESSAGE ! OUT Return message TS150793.233
INTEGER CLDCVR1A.35
* ICODE ! OUT Return code 0 normal exit GT 0 error CLDCVR1A.36
*,POINTS ! IN NO of Points to be processed. CLDCVR1A.37
&,Q_LEVELS ! IN NO of HUMIDITY LEVELS AYY1F404.227
&,CLOUD_LEVELS ! IN NO of RADIATION CLOUD LEVELS AYY1F404.228
*,LOW_BOT_LEVEL ! IN The lowest level of the LOW category CLDCVR1A.40
*,LOW_TOP_LEVEL ! IN The top level of the LOW category CLDCVR1A.41
*,MED_BOT_LEVEL ! IN The lowest level of the MED category CLDCVR1A.42
*,MED_TOP_LEVEL ! IN The top level of the MED category CLDCVR1A.43
*,HIGH_BOT_LEVEL ! IN The lowest level of the Highest category CLDCVR1A.44
*,HIGH_TOP_LEVEL ! IN The top level of the Highest category CLDCVR1A.45
*,CCB(POINTS) ! IN Convective cloud base WI080293.12
*,CCT(POINTS) ! IN Convective cloud top WI080293.13
C CLDCVR1A.46
REAL CLDCVR1A.47
* MODEL_CLOUD(POINTS,CLOUD_LEVELS) ! IN The model's layer cloud WI080293.14
*,CONVECTIVE_CLOUD(POINTS) ! IN Its convective cloud WI080293.15
*,LOW_CLOUD(POINTS) ! OUT Cloudy fraction in the lowest lyr CLDCVR1A.49
*,MED_CLOUD(POINTS) ! OUT Cloudy fraction for the medium lyr CLDCVR1A.50
*,HIGH_CLOUD(POINTS) ! OUT Cloudy fraction for the highest lyr CLDCVR1A.51
*,TCA_RANDOM(POINTS) ! OUT Total cloud amount with random overlap WI080293.16
*,TCA_MAXRAN(POINTS) ! OUT and with maximum/random overlap WI080293.17
&,LAYER_CLOUD_PRESENT(POINTS,CLOUD_LEVELS) ! OUT Lcld frequency AYY1F404.229
C CLDCVR1A.52
LOGICAL CLDCVR1A.53
* FLAG_LOW ! True if required FALSE if not CLDCVR1A.54
*,FLAG_MED ! " CLDCVR1A.55
*,FLAG_HIGH ! " CLDCVR1A.56
*,FLAG_TRA ! " WI080293.18
*,FLAG_TMR ! " WI080293.19
&,FLAG_LCP ! " AYY1F404.230
C*--------------------------------------------------------------- CLDCVR1A.57
C CLDCVR1A.58
C*L WORKSPACE USAGE---------------------------------------------- CLDCVR1A.59
C One dynamically allocated array MAX_CONTIG: WI080293.20
REAL MAX_CONTIG(POINTS) ! Maximum total cloud cover in the WI080293.21
C ! layer currently being considered and those below it through WI080293.22
C ! which cloud extends contiguously. WI080293.23
C*--------------------------------------------------------------- CLDCVR1A.61
C CLDCVR1A.62
C*L EXTERNAL SUBROUTINES CALLED---------------------------------- CLDCVR1A.63
C None. CLDCVR1A.64
C*--------------------------------------------------------------- CLDCVR1A.65
C CLDCVR1A.66
C CLDCVR1A.67
C---------------------------------------------------------------- CLDCVR1A.68
C DEFINE LOCAL VARIABLES CLDCVR1A.69
C---------------------------------------------------------------- CLDCVR1A.70
INTEGER CLDCVR1A.71
* I,J ! LOOP COUNTERS CLDCVR1A.72
REAL TOCLE ! Total cloud in this layer WI080293.24
C CLDCVR1A.73
CLDCVR1A.74
C------------------------------------------------------------------ CLDCVR1A.75
CL 1. Calculate the cloudy fraction of each of the layers CLDCVR1A.76
C------------------------------------------------------------------ CLDCVR1A.77
CLDCVR1A.78
CL 1. Calculate the cloudy fraction for LOW CLDCVR1A.79
CLDCVR1A.80
IF(FLAG_LOW) THEN CLDCVR1A.81
CLDCVR1A.82
IF(LOW_BOT_LEVEL.GT.LOW_TOP_LEVEL)THEN CLDCVR1A.83
ICODE=1 CLDCVR1A.84
CMESSAGE='CLDCVR :CLOUD_TYPE LOW Bottom lvl above top level' CLDCVR1A.85
GOTO 9999 CLDCVR1A.86
ENDIF CLDCVR1A.87
CLDCVR1A.88
IF(LOW_TOP_LEVEL.GT.CLOUD_LEVELS) THEN CLDCVR1A.89
ICODE=1 CLDCVR1A.90
CMESSAGE='CLDCVR :CLOUD_TYPE LOW TOP level above CLOUD_LEVELS' CLDCVR1A.91
GOTO 9999 CLDCVR1A.92
ENDIF CLDCVR1A.93
CLDCVR1A.94
C Intialise the LOW_CLOUD ARRAY to the bottom layer amount. CLDCVR1A.95
DO I=1,POINTS CLDCVR1A.96
LOW_CLOUD(I)=MODEL_CLOUD(I,LOW_BOT_LEVEL) CLDCVR1A.97
ENDDO CLDCVR1A.98
CLDCVR1A.99
C Find the max fraction over the required layers CLDCVR1A.100
CL *** Following loop labelled due to fmp mistranslation CLDCVR1A.101
C CLDCVR1A.102
DO 100 J=LOW_BOT_LEVEL+1,LOW_TOP_LEVEL CLDCVR1A.103
DO I=1,POINTS CLDCVR1A.104
IF(LOW_CLOUD(I).LT.MODEL_CLOUD(I,J)) THEN CLDCVR1A.105
LOW_CLOUD(I)=MODEL_CLOUD(I,J) CLDCVR1A.106
ENDIF CLDCVR1A.107
ENDDO CLDCVR1A.108
100 CONTINUE CLDCVR1A.109
ENDIF CLDCVR1A.110
CL 2. Calculate the cloudy fraction for MEDIUM CLDCVR1A.111
CLDCVR1A.112
IF(FLAG_MED) THEN CLDCVR1A.113
CLDCVR1A.114
IF(MED_BOT_LEVEL.GT.MED_TOP_LEVEL)THEN CLDCVR1A.115
ICODE=1 CLDCVR1A.116
CMESSAGE='CLDCVR:CLOUD_TYPE MED Bottom level above top level' CLDCVR1A.117
GOTO 9999 CLDCVR1A.118
ENDIF CLDCVR1A.119
CLDCVR1A.120
IF(MED_TOP_LEVEL.GT.CLOUD_LEVELS) THEN CLDCVR1A.121
ICODE=1 CLDCVR1A.122
CMESSAGE='CLDCVR:CLOUD_TYPE MED TOP level above CLOUD_LEVELS' CLDCVR1A.123
GOTO 9999 CLDCVR1A.124
ENDIF CLDCVR1A.125
CLDCVR1A.126
C Intialise the MED_CLOUD ARRAY to the bottom layer amount. CLDCVR1A.127
DO I=1,POINTS CLDCVR1A.128
MED_CLOUD(I)=MODEL_CLOUD(I,MED_BOT_LEVEL) CLDCVR1A.129
ENDDO CLDCVR1A.130
CLDCVR1A.131
C Find the max fraction over the required layers CLDCVR1A.132
CL *** Following loop labelled due to fmp mistranslation CLDCVR1A.133
C CLDCVR1A.134
DO 200 J=MED_BOT_LEVEL+1,MED_TOP_LEVEL CLDCVR1A.135
DO I=1,POINTS CLDCVR1A.136
IF(MED_CLOUD(I).LT.MODEL_CLOUD(I,J)) THEN CLDCVR1A.137
MED_CLOUD(I)=MODEL_CLOUD(I,J) CLDCVR1A.138
ENDIF CLDCVR1A.139
ENDDO CLDCVR1A.140
200 CONTINUE CLDCVR1A.141
CLDCVR1A.142
ENDIF CLDCVR1A.143
CL 4. Calculate the cloudy fraction for high CLDCVR1A.144
CLDCVR1A.145
IF(FLAG_HIGH) THEN CLDCVR1A.146
CLDCVR1A.147
IF(HIGH_BOT_LEVEL.GT.HIGH_TOP_LEVEL)THEN CLDCVR1A.148
ICODE=1 CLDCVR1A.149
CMESSAGE='CLDCVR: CLOUD_TYPE HIGH Bottom lvl above top level' CLDCVR1A.150
GOTO 9999 CLDCVR1A.151
ENDIF CLDCVR1A.152
CLDCVR1A.153
IF(HIGH_TOP_LEVEL.GT.CLOUD_LEVELS) THEN CLDCVR1A.154
ICODE=1 CLDCVR1A.155
CMESSAGE='CLDCVR:CLOUD_TYPE HIGH TOP lvl above CLOUD_LEVELS' CLDCVR1A.156
GOTO 9999 CLDCVR1A.157
ENDIF CLDCVR1A.158
CLDCVR1A.159
C Intialise the HIGH_CLOUD ARRAY to the bottom layer amount. CLDCVR1A.160
DO I=1,POINTS CLDCVR1A.161
HIGH_CLOUD(I)=MODEL_CLOUD(I,HIGH_BOT_LEVEL) CLDCVR1A.162
ENDDO CLDCVR1A.163
CLDCVR1A.164
C Find the max fraction over the required layers CLDCVR1A.165
CL *** Following loop labelled due to fmp mistranslation CLDCVR1A.166
C CLDCVR1A.167
DO 300 J=HIGH_BOT_LEVEL+1,HIGH_TOP_LEVEL CLDCVR1A.168
DO I=1,POINTS CLDCVR1A.169
IF(HIGH_CLOUD(I).LT.MODEL_CLOUD(I,J)) THEN CLDCVR1A.170
HIGH_CLOUD(I)=MODEL_CLOUD(I,J) CLDCVR1A.171
ENDIF CLDCVR1A.172
ENDDO CLDCVR1A.173
300 CONTINUE CLDCVR1A.174
CLDCVR1A.175
CLDCVR1A.176
ENDIF CLDCVR1A.177
WI080293.25
C----------------------------------------------------------------------- WI080293.26
CL 2. Calculate the total cloud amounts WI080293.27
C----------------------------------------------------------------------- WI080293.28
WI080293.29
C These diagnostics are calculated just as in LWDCSF - see that WI080293.30
C routine for comments on how it is done. WI080293.31
WI080293.32
IF ( FLAG_TRA ) THEN WI080293.33
WI080293.34
DO I=1, POINTS WI080293.35
TCA_RANDOM(I) = 1. - CONVECTIVE_CLOUD(I) WI080293.36
ENDDO WI080293.37
WI080293.38
DO 500 J=1, CLOUD_LEVELS WI080293.39
DO I=1, POINTS WI080293.40
TCA_RANDOM(I) = TCA_RANDOM(I) * ( 1. - MODEL_CLOUD(I,J) ) WI080293.41
ENDDO WI080293.42
500 CONTINUE WI080293.43
WI080293.44
DO I=1, POINTS WI080293.45
TCA_RANDOM(I) = 1. - TCA_RANDOM(I) WI080293.46
ENDDO WI080293.47
C WI080293.48
ENDIF WI080293.49
WI080293.50
IF ( FLAG_TMR ) THEN WI080293.51
WI080293.52
DO I=1, POINTS WI080293.53
TCA_MAXRAN(I) = 1. WI080293.54
MAX_CONTIG(I) = 0. WI080293.55
ENDDO WI080293.56
WI080293.57
DO 600 J=1, CLOUD_LEVELS WI080293.58
DO I=1, POINTS WI080293.59
IF ( MODEL_CLOUD(I,J) .EQ. 0. .AND. WI141293.6
& ( CONVECTIVE_CLOUD(I) .EQ. 0. .OR. WI141293.7
& J .LT. CCB(I) .OR. J .GE. CCT(I) ) ) THEN WI141293.8
TCA_MAXRAN(I) = TCA_MAXRAN(I) * ( 1. - MAX_CONTIG(I) ) WI080293.62
MAX_CONTIG(I) = 0. WI080293.63
ELSE WI080293.64
TOCLE = MODEL_CLOUD(I,J) WI080293.65
IF ( J .GE. CCB(I) .AND. J .LT. CCT(I) ) WI080293.66
& TOCLE = TOCLE + CONVECTIVE_CLOUD(I) * ( 1. - TOCLE ) WI080293.67
MAX_CONTIG(I) = MAX(MAX_CONTIG(I),TOCLE) WI080293.68
ENDIF WI080293.69
ENDDO WI080293.70
600 CONTINUE WI080293.71
WI080293.72
DO I=1, POINTS WI080293.73
TCA_MAXRAN(I) = 1. - TCA_MAXRAN(I) * ( 1. - MAX_CONTIG(I) ) WI080293.74
ENDDO WI080293.75
WI080293.76
ENDIF WI080293.77
!----------------------------------------------------------------------- AYY1F404.231
! 3. Calculate the layer cloud frequency AYY1F404.232
!----------------------------------------------------------------------- AYY1F404.233
IF ( FLAG_LCP ) THEN AYY1F404.234
DO J=1, Q_LEVELS AYY1F404.235
DO I=1, POINTS AYY1F404.236
IF (MODEL_CLOUD(I,J) .LE. 0.) THEN AYY1F404.237
LAYER_CLOUD_PRESENT(I,J)=0. AYY1F404.238
ELSE AYY1F404.239
LAYER_CLOUD_PRESENT(I,J)=1. AYY1F404.240
ENDIF AYY1F404.241
END DO ! I_do_lcp AYY1F404.242
END DO ! J_do_lcp AYY1F404.243
ENDIF ! Flag_lcp_if AYY1F404.244
! AYY1F404.245
9999 CONTINUE CLDCVR1A.178
RETURN CLDCVR1A.179
END CLDCVR1A.180
*ENDIF CLDCVR1A.181