*IF DEF,A04_2B,OR,DEF,A04_2C ADM3F404.33
C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved. GTS2F400.15932
C GTS2F400.15933
C Use, duplication or disclosure of this code is subject to the GTS2F400.15934
C restrictions as set forth in the contract. GTS2F400.15935
C GTS2F400.15936
C Meteorological Office GTS2F400.15937
C London Road GTS2F400.15938
C BRACKNELL GTS2F400.15939
C Berkshire UK GTS2F400.15940
C RG12 2SZ GTS2F400.15941
C GTS2F400.15942
C If no contract has been raised with this copy of the code, the use, GTS2F400.15943
C duplication or disclosure of it is strictly prohibited. Permission GTS2F400.15944
C to do so must first be obtained in writing from the Head of Numerical GTS2F400.15945
C Modelling at the above address. GTS2F400.15946
C ******************************COPYRIGHT****************************** GTS2F400.15947
C GTS2F400.15948
C*LL SUBROUTINE LSP_FOCWWIL-------------------------------------------- LSPFCW1A.3
!LL LSPFCW1A.4
!LL Purpose: Calculate from temperature the Fraction Of Cloud Water LSPFCW1A.5
!LL Which Is Liquid. LSPFCW1A.6
!LL LSPFCW1A.7
!LL A.Bushell <- programmer of some or all of previous code or changes LSPFCW1A.8
!LL LSPFCW1A.9
!LL Model LSPFCW1A.10
!LL version Date Modification history from model version 4.0: LSPFCW1A.11
!LL LSPFCW1A.12
!LL 4.0 27/09/95 Subroutine created from in-line COMDECK. LSPFCW1A.13
!LL LSPFCW1A.14
!LL LSPFCW1A.15
!LL Programming standard: Unified Model Documentation Paper No 4, LSPFCW1A.16
!LL Version 1, dated 12/9/89. LSPFCW1A.17
!LL LSPFCW1A.18
!LL Logical component covered: Part of P26. LSPFCW1A.19
!LL LSPFCW1A.20
!LL System task: LSPFCW1A.21
!LL LSPFCW1A.22
!LL Documentation: Unified Model Documentation Paper No 26: Eq 26.29. LSPFCW1A.23
!LL LSPFCW1A.24
!LL Called by components P26, P23. LSPFCW1A.25
C* LSPFCW1A.26
C*L Arguments:--------------------------------------------------------- LSPFCW1A.27
SUBROUTINE LSP_FOCWWIL( 12LSPFCW1A.28
& T,POINTS,ROCWWIL LSPFCW1A.29
&) LSPFCW1A.30
IMPLICIT NONE LSPFCW1A.31
INTEGER ! Input integer scalar :- LSPFCW1A.32
& POINTS ! IN Number of points to be processed. LSPFCW1A.33
REAL ! Input real arrays :- LSPFCW1A.34
& T(POINTS) ! IN Temperature at this level (K). LSPFCW1A.35
REAL ! Updated real arrays :- LSPFCW1A.36
& ROCWWIL(POINTS) ! OUT Ratio Of Cloud Water Which Is Liquid. LSPFCW1A.37
C*L External subprogram called :- LSPFCW1A.38
! EXTERNAL None. LSPFCW1A.39
C* LSPFCW1A.40
!----------------------------------------------------------------------- LSPFCW1A.41
! Common, then local, physical constants. LSPFCW1A.42
!----------------------------------------------------------------------- LSPFCW1A.43
*CALL C_0_DG_C 
LSPFCW1A.44
!----------------------------------------------------------------------- LSPFCW1A.45
! Define local scalars. LSPFCW1A.46
!----------------------------------------------------------------------- LSPFCW1A.47
! (a) Reals effectively expanded to workspace by the Cray (using LSPFCW1A.48
! vector registers). LSPFCW1A.49
REAL ! Real workspace. At end of DO loop, contains :- LSPFCW1A.50
& TFOC ! T(I) within DO loop. Allows routines to call LSPFCW1A.51
! LSP_FOCWWIL(WORK1, POINTS, WORK1) to save space LSPFCW1A.52
! (b) Others. LSPFCW1A.53
INTEGER I ! Loop counter (horizontal field index). LSPFCW1A.54
! LSPFCW1A.55
DO I = 1, POINTS LSPFCW1A.56
! LSPFCW1A.57
TFOC = T(I) LSPFCW1A.58
!----------------------------------------------------------------------- LSPFCW1A.59
!L 0. Calculate fraction of cloud water which is liquid (FL), LSPFCW1A.60
!L according to equation P26.50. LSPFCW1A.61
!----------------------------------------------------------------------- LSPFCW1A.62
IF (TFOC .LE. (TM - 15.0)) THEN LSPFCW1A.63
! Low temperatures, cloud water all frozen------------------------ LSPFCW1A.64
ROCWWIL(I) = 0.0 LSPFCW1A.65
! LSPFCW1A.66
ELSE IF (TFOC .LT. (TM - 5.0)) THEN LSPFCW1A.67
! Intermediate temperatures--------------------------------------- LSPFCW1A.68
ROCWWIL(I) = (TFOC - TM + 15.0) * (TFOC - TM + 15.0) / 150.0 LSPFCW1A.69
! LSPFCW1A.70
ELSE IF (TFOC .LT. TM) THEN LSPFCW1A.71
! Intermediate temperatures--------------------------------------- LSPFCW1A.72
ROCWWIL(I) = 1.0 - ((TFOC - TM) * (TFOC - TM) / 75.0) LSPFCW1A.73
! LSPFCW1A.74
ELSE LSPFCW1A.75
! High temperatures, cloud water all liquid----------------------- LSPFCW1A.76
ROCWWIL(I) = 1.0 LSPFCW1A.77
! LSPFCW1A.78
END IF LSPFCW1A.79
! LSPFCW1A.80
END DO ! Loop over points LSPFCW1A.81
! LSPFCW1A.82
RETURN LSPFCW1A.83
END LSPFCW1A.84
*ENDIF LSPFCW1A.85