*IF DEF,A02_1A,OR,DEF,A02_1B,OR,DEF,A02_1C AWA1F304.3
C ******************************COPYRIGHT****************************** GTS2F400.5545
C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved. GTS2F400.5546
C GTS2F400.5547
C Use, duplication or disclosure of this code is subject to the GTS2F400.5548
C restrictions as set forth in the contract. GTS2F400.5549
C GTS2F400.5550
C Meteorological Office GTS2F400.5551
C London Road GTS2F400.5552
C BRACKNELL GTS2F400.5553
C Berkshire UK GTS2F400.5554
C RG12 2SZ GTS2F400.5555
C GTS2F400.5556
C If no contract has been raised with this copy of the code, the use, GTS2F400.5557
C duplication or disclosure of it is strictly prohibited. Permission GTS2F400.5558
C to do so must first be obtained in writing from the Head of Numerical GTS2F400.5559
C Modelling at the above address. GTS2F400.5560
C ******************************COPYRIGHT****************************** GTS2F400.5561
C GTS2F400.5562
CLL Subroutine LWDCSF ------------------------------------------------ WI200893.37
CLL LWDCSF1A.4
CLL Purpose : LWDCSF1A.5
CLL It calculates the clear-sky fraction (i.e. the fraction of the LWDCSF1A.6
CLL grid-box where no cloud exists at any level) for use in LWDCSF1A.7
CLL constructing diagnostics - the "total cloud amount" diagnostic (the LWDCSF1A.8
CLL fraction of the grid-box where there is some cloud at some level) LWDCSF1A.9
CLL is one minus this, and the clear-sky (type I) diagnostics are the LWDCSF1A.10
CLL clear-sky (type II) diagnostics multiplied by it. LWDCSF1A.11
CLL Suitable for single column model use. LWDCSF1A.12
CLL LWDCSF1A.13
CLL Author: William Ingram LWDCSF1A.14
CLL LWDCSF1A.15
CLL Model Modification history from model version 3.0: LWDCSF1A.16
CLL version Date LWDCSF1A.17
CLL 3.3 15/12/93 Corrected to allow for zero convective cloud cover WI141293.1
CLL 4.2 Sept.96 T3E migration: *DEF CRAY removed; GSS1F402.32
CLL *DEF T3E used for T3E library functions; GSS1F402.33
CLL dynamic allocation no longer *DEF controlled. GSS1F402.34
CLL S.J.Swarbrick GSS1F402.35
CLL LWDCSF1A.19
CLL Programming standard : LWDCSF1A.20
CLL It conforms to programming standard A of UMDP 4 (version 2 18/1/90) LWDCSF1A.21
CLL and has no features deprecated by 8X. LWDCSF1A.22
CLL If *DEF IBM or *DEF RANDOVER or both are set, the code is standard LWDCSF1A.23
CLL FORTRAN 77 except for having ! comments (it then sets the "vector LWDCSF1A.24
CLL length" to be 1) but otherwise it includes CRAY automatic arrays LWDCSF1A.25
CLL also. LWDCSF1A.26
CLL LWDCSF1A.27
CLL Logical components covered : D23 (radiation diagnostics) LWDCSF1A.28
CLL LWDCSF1A.29
CLL Project task : P23 LWDCSF1A.30
CLL LWDCSF1A.31
CLL External documentation: LWDCSF1A.32
CLL The cloud overlap assumptions are documented in UMDP 23. LWDCSF1A.33
CLL LWDCSF1A.34
CLLEND ----------------------------------------------------------------- LWDCSF1A.35
C*L LWDCSF1A.36
SUBROUTINE LWDCSF (LCA, CCA, CCB, CCT, NCLDS, L1, 2LWDCSF1A.37
& L2, GSS1F402.36
& CSF) LWDCSF1A.47
C LWDCSF1A.48
INTEGER!, INTENT (IN) LWDCSF1A.49
& L1, ! First dimension of input arrays LWDCSF1A.50
& L2, ! Number of points to be treated GSS1F402.37
& NCLDS, ! Number of layers with cloud LWDCSF1A.58
& CCB(L1), ! Convective cloud base & top, LWDCSF1A.59
& CCT(L1) ! counting upward & the surface=1 LWDCSF1A.60
REAL!, INTENT (IN) LWDCSF1A.61
& LCA(L1,NCLDS), CCA(L1) ! Layer & convective cloud fraction LWDCSF1A.62
C*IF -DEF,RANDOVER GSS1F402.38
C ! Array dimensions must be constants in FORTRAN: LWDCSF1A.65
C*CALL L2VAL GSS1F402.39
C*ENDIF -RANDOVER GSS1F402.40
REAL!, INTENT (OUT) :: LWDCSF1A.69
& CSF(L2) ! Clear-sky fraction returned LWDCSF1A.70
C LWDCSF1A.71
CL ! LWDCSF has no EXTERNAL calls LWDCSF1A.72
*IF DEF,RANDOVER LWDCSF1A.73
CL ! and no dynamically allocated workspace. LWDCSF1A.74
*ELSE RANDOVER LWDCSF1A.75
CL ! but one dynamically allocated array MAXCON: GSS1F402.41
REAL MAXCON(L2) ! Maximum total cloud cover in the LWDCSF1A.79
C ! layer currently being considered and those below it through LWDCSF1A.80
C ! which cloud extends contiguously. LWDCSF1A.81
C* LWDCSF1A.82
REAL TOCLE ! Total cloud in this layer LWDCSF1A.83
*ENDIF RANDOVER LWDCSF1A.84
C* LWDCSF1A.85
INTEGER LEVEL, J ! Loopers over level & point LWDCSF1A.86
C LWDCSF1A.87
CL ! First an initialization loop: LWDCSF1A.88
C LWDCSF1A.89
DO J=1, L2 LWDCSF1A.90
*IF DEF,RANDOVER LWDCSF1A.91
CSF(J) = 1. - CCA(J) LWDCSF1A.92
*ELSE RANDOVER LWDCSF1A.93
CSF(J) = 1. LWDCSF1A.94
MAXCON(J) = 0. LWDCSF1A.95
*ENDIF RANDOVER LWDCSF1A.96
ENDDO LWDCSF1A.97
C LWDCSF1A.98
CL ! Then work up through the cloudy layers, remembering that LCA is LWDCSF1A.99
CL ! the fractional cover by layer cloud outside the convective cloud LWDCSF1A.100
C LWDCSF1A.101
DO 100 LEVEL=1, NCLDS LWDCSF1A.102
DO 200 J=1, L2 LWDCSF1A.103
*IF DEF,RANDOVER LWDCSF1A.104
C ! Thus we can just multiply the cloud-free fractions together LWDCSF1A.105
C ! for each layer of layer cloud, putting in the CCA term at LWDCSF1A.106
C ! the beginning - if we did do it layer-by-layer the term LWDCSF1A.107
C ! would be (1-(LCA*(1-CCA)+CCA))) in the layer where the LWDCSF1A.108
C ! convective cloud base is, & (1-LCA) elsewhere. LWDCSF1A.109
CSF(J) = CSF(J) * ( 1. - LCA(J,LEVEL) ) LWDCSF1A.110
*ELSE RANDOVER LWDCSF1A.111
C ! So total cloud amount in a layer is (1-(LCA*(1-CCA)+CCA))) LWDCSF1A.112
C ! if the convective cloud base extends through it, & (1-LCA) LWDCSF1A.113
C ! if not. We want the product of 1 - the maxima of this for LWDCSF1A.114
C ! each group of contiguous (in the vertical) cloudy layers. LWDCSF1A.115
C ! So accumulate this maximum through each such group, and at LWDCSF1A.116
C ! each cloud-free layer multiply it in & re-zero it. LWDCSF1A.117
IF ( LCA(J,LEVEL) .EQ. 0. .AND. ( CCA(J) .EQ. 0. .OR. WI141293.2
& LEVEL .LT. CCB(J) .OR. LEVEL .GE. CCT(J) ) ) THEN WI141293.3
CSF(J) = CSF(J) * ( 1. - MAXCON(J) ) LWDCSF1A.120
MAXCON(J) = 0. LWDCSF1A.121
ELSE LWDCSF1A.122
TOCLE = LCA(J,LEVEL) LWDCSF1A.123
IF ( LEVEL .GE. CCB(J) .AND. LEVEL .LT. CCT(J) ) LWDCSF1A.124
& TOCLE = TOCLE + CCA(J) * ( 1. - TOCLE ) LWDCSF1A.125
MAXCON(J) = MAX(MAXCON(J),TOCLE) LWDCSF1A.126
ENDIF LWDCSF1A.127
*ENDIF RANDOVER LWDCSF1A.128
200 CONTINUE LWDCSF1A.129
100 CONTINUE LWDCSF1A.130
C LWDCSF1A.131
*IF -DEF,RANDOVER LWDCSF1A.132
CL ! The term from the highest cloud block has still to be put in if LWDCSF1A.133
CL ! it extends into layer NCLDS. LWDCSF1A.134
DO J=1, L2 LWDCSF1A.135
CSF(J) = CSF(J) * ( 1. - MAXCON(J) ) LWDCSF1A.136
ENDDO LWDCSF1A.137
C LWDCSF1A.138
*ENDIF -RANDOVER LWDCSF1A.139
RETURN LWDCSF1A.140
END LWDCSF1A.141
*ENDIF A02_1A,OR,A02_1B,OR,A02_1C AWA1F304.4