*IF DEF,A03_6A ACB1F405.10
C *****************************COPYRIGHT****************************** SFLBES5B.3
C (c) CROWN COPYRIGHT 1997, METEOROLOGICAL OFFICE, All Rights Reserved. SFLBES5B.4
C SFLBES5B.5
C Use, duplication or disclosure of this code is subject to the SFLBES5B.6
C restrictions as set forth in the contract. SFLBES5B.7
C SFLBES5B.8
C Meteorological Office SFLBES5B.9
C London Road SFLBES5B.10
C BRACKNELL SFLBES5B.11
C Berkshire UK SFLBES5B.12
C RG12 2SZ SFLBES5B.13
C SFLBES5B.14
C If no contract has been raised with this copy of the code, the use, SFLBES5B.15
C duplication or disclosure of it is strictly prohibited. Permission SFLBES5B.16
C to do so must first be obtained in writing from the Head of Numerical SFLBES5B.17
C Modelling at the above address. SFLBES5B.18
C ******************************COPYRIGHT****************************** SFLBES5B.19
! SFLBES5B.20
!!! SUBROUTINE SF_LBEST----------------------------------------------- SFLBES5B.21
!!! SFLBES5B.22
!!! Purpose: Calculate combination height for surface tiles, and SFLBES5B.23
!!! heat moisture and wind variables at that height SFLBES5B.24
!!! SFLBES5B.25
!!! Simon Jackson <- programmer of some or all of previous code changes SFLBES5B.26
!!! SFLBES5B.27
!!! Model Modification history: SFLBES5B.28
!!! version Date SFLBES5B.29
!!! SFLBES5B.30
!!! 4.3 7/2/97 New deck. S Jackson SFLBES5B.31
!!! SFLBES5B.32
!!! Programming standard: Unified Model Documentation Paper No 4, SFLBES5B.33
!!! Version ?, dated ?. SFLBES5B.34
!!! SFLBES5B.35
!!! System component covered: P24. SFLBES5B.36
!!! SFLBES5B.37
!!! Project task: SFLBES5B.38
!!! SFLBES5B.39
!!! Documentation: UMDP 24. SFLBES5B.40
!!!--------------------------------------------------------------------- SFLBES5B.41
SFLBES5B.42
!! Arguaments -------------------------------------------------------- SFLBES5B.43
SFLBES5B.44
SUBROUTINE SF_LBEST ( 1,2SFLBES5B.45
& P_POINTS,P_FIELD,P1,H_BLEND_OROG, SFLBES5B.46
& QCL_1,QCF_1,QSTAR_GB,Q_1,TSTAR_GB,T_1,U_1,V_1, SFLBES5B.47
& Z0M_EFF,Z0H,Z0M,Z1_UV,Z1_TQ,H_BLEND,HEAT_BLEND_FACTOR, SFLBES5B.48
& Q_BLEND,QW_BLEND,T_BLEND,TL_BLEND,U_BLEND,V_BLEND, SFLBES5B.49
& WIND_BLEND_FACTOR,LTIMER SFLBES5B.50
& ) SFLBES5B.51
SFLBES5B.52
IMPLICIT NONE SFLBES5B.53
SFLBES5B.54
INTEGER ! Variables defining grid. SFLBES5B.55
& P_POINTS ! IN Number of P-grid points to be processed. SFLBES5B.56
&,P_FIELD ! IN Total number of p points. SFLBES5B.57
&,P1 ! IN First p point to be processed. SFLBES5B.58
&,LAND_MASK(P_FIELD) ! IN Land/sea mask SFLBES5B.59
SFLBES5B.60
LOGICAL SFLBES5B.61
& LTIMER SFLBES5B.62
SFLBES5B.63
REAL SFLBES5B.64
& H_BLEND_OROG(P_FIELD)! IN Blending height for effective SFLBES5B.65
! roughness lengths SFLBES5B.66
&,QCL_1(P_FIELD) ! IN Level 1 cloud water liquid water content SFLBES5B.67
&,QCF_1(P_FIELD) ! IN Lev 1 cloud fraction SFLBES5B.68
&,QSTAR_GB(P_FIELD) ! IN Mean surface QSTAR SFLBES5B.69
&,Q_1(P_FIELD) ! IN Level 1 Q SFLBES5B.70
&,TSTAR_GB(P_FIELD) ! IN Mean surface temperature SFLBES5B.71
&,T_1(P_FIELD) ! IN Level 1 temperature SFLBES5B.72
&,U_1(P_FIELD) ! IN U wind component for lowest SFLBES5B.73
! atmospheric layer (m/s). On P grid. SFLBES5B.74
&,V_1(P_FIELD) ! IN V wind component for lowest SFLBES5B.75
! atmospheric layer (m/s). On P grid. SFLBES5B.76
&,Z0M_EFF(P_FIELD) ! IN Effective roughness length for momentum SFLBES5B.77
&,Z0H(P_FIELD) ! IN Roughness length for heat and moisture m SFLBES5B.78
&,Z0M(P_FIELD) ! IN Roughness length for momentum (m). SFLBES5B.79
&,Z1_UV(P_FIELD) ! IN Height of level 1 on UV levels SFLBES5B.80
&,Z1_TQ(P_FIELD) ! IN Height of level 1 on TQ levels SFLBES5B.81
SFLBES5B.82
! Output SFLBES5B.83
REAL SFLBES5B.84
& H_BLEND(P_FIELD) ! OUT Blending height for times SFLBES5B.85
&,HEAT_BLEND_FACTOR(P_FIELD) SFLBES5B.86
! OUT Heat Blending factor SFLBES5B.87
&,Q_BLEND(P_FIELD) ! OUT Est of Q at blending height SFLBES5B.88
! using neutral profile SFLBES5B.89
&,QW_BLEND(P_FIELD) ! OUT Est of QW at blending height SFLBES5B.90
! using neutral profile SFLBES5B.91
&,T_BLEND(P_FIELD) ! OUT Est of temperature at blending height SFLBES5B.92
! using neutral profile SFLBES5B.93
&,TL_BLEND(P_FIELD) ! OUT Est of TL at blending height SFLBES5B.94
! using neutral profile SFLBES5B.95
&,U_BLEND(P_FIELD) ! OUT U component of wind at blending height SFLBES5B.96
&,V_BLEND(P_FIELD) ! OUT U component of wind at blending height SFLBES5B.97
&,WIND_BLEND_FACTOR(P_FIELD) SFLBES5B.98
! OUT Wind Blending factor SFLBES5B.99
! Work Variables SFLBES5B.100
SFLBES5B.101
INTEGER SFLBES5B.102
& I ! Loop counter SFLBES5B.103
SFLBES5B.104
REAL SFLBES5B.105
& LAPSE ! Atmospheric lapse rate in surface layer SFLBES5B.106
SFLBES5B.107
*CALL C_MDI 
SFLBES5B.108
*CALL C_VKMAN SFLBES5B.109
*CALL C_ROUGH SFLBES5B.110
*CALL C_SURF SFLBES5B.111
*CALL C_LHEAT SFLBES5B.112
*CALL C_R_CP SFLBES5B.113
*CALL C_G SFLBES5B.114
SFLBES5B.115
REAL LCRCP,LS,LSRCP SFLBES5B.116
PARAMETER ( SFLBES5B.117
& LCRCP=LC/CP ! Evaporation-to-dT conversion factor. SFLBES5B.118
&,LS=LF+LC ! Latent heat of sublimation. SFLBES5B.119
&,LSRCP=LS/CP ! Sublimation-to-dT conversion factor. SFLBES5B.120
& ) SFLBES5B.121
SFLBES5B.122
EXTERNAL TIMER SFLBES5B.123
SFLBES5B.124
IF (LTIMER) THEN SFLBES5B.125
CALL TIMER('SF_LBEST',3) SFLBES5B.126
ENDIF SFLBES5B.127
SFLBES5B.128
!################################################################# SFLBES5B.129
! Start of code SFLBES5B.130
!################################################################# SFLBES5B.131
SFLBES5B.132
DO I=P1,P1+P_POINTS-1 SFLBES5B.133
SFLBES5B.134
H_BLEND(I) = Z1_UV(I) + Z0M_EFF(I) ARN0F405.1819
SFLBES5B.140
IF (H_BLEND(I) .NE. Z1_UV(I) + Z0M_EFF(I)) THEN ARN0F405.1820
WIND_BLEND_FACTOR(I) = LOG ( H_BLEND(I) / Z0M_EFF(I) ) / SFLBES5B.146
& LOG ( (Z1_UV(I) + Z0M_EFF(I)) / Z0M_EFF(I) ) ARN0F405.1821
SFLBES5B.148
U_BLEND(I) = U_1(I) * WIND_BLEND_FACTOR(I) SFLBES5B.149
V_BLEND(I) = V_1(I) * WIND_BLEND_FACTOR(I) SFLBES5B.150
SFLBES5B.151
ELSE SFLBES5B.152
SFLBES5B.154
WIND_BLEND_FACTOR(I) = 1.0 SFLBES5B.155
SFLBES5B.156
U_BLEND(I) = U_1(I) SFLBES5B.157
V_BLEND(I) = V_1(I) SFLBES5B.158
SFLBES5B.159
ENDIF SFLBES5B.161
SFLBES5B.162
H_BLEND(I) = Z1_TQ(I) + Z0M_EFF(I) ARN0F405.1822
SFLBES5B.163
IF (H_BLEND(I) .NE. Z1_TQ(I) + Z0M_EFF(I)) THEN ARN0F405.1823
HEAT_BLEND_FACTOR(I) = LOG ( H_BLEND(I) / Z0H(I) ) / SFLBES5B.165
& LOG ( (Z1_TQ(I) + Z0M_EFF(I)) / Z0H(I) ) ARN0F405.1824
SFLBES5B.167
T_BLEND(I) = TSTAR_GB(I) - G/CP * (H_BLEND(I) - Z0H(I)) ARN0F405.1825
& + (T_1(I) + G/CP * (Z1_TQ(I) + Z0M_EFF(I)- Z0H(I)) ARN0F405.1826
& - TSTAR_GB(I) ) * HEAT_BLEND_FACTOR(I) ARN0F405.1827
SFLBES5B.170
Q_BLEND(I) = QSTAR_GB(I) + ( Q_1(I) - QSTAR_GB(I) ) * SFLBES5B.171
& HEAT_BLEND_FACTOR(I) SFLBES5B.172
ELSE SFLBES5B.173
SFLBES5B.174
HEAT_BLEND_FACTOR(I) = 1.0 SFLBES5B.176
SFLBES5B.177
T_BLEND(I) = T_1(I) SFLBES5B.178
Q_BLEND(I) = Q_1(I) SFLBES5B.179
SFLBES5B.180
ENDIF SFLBES5B.181
SFLBES5B.182
TL_BLEND(I) = T_BLEND(I) - LCRCP*QCL_1(I) - LSRCP*QCF_1(I) SFLBES5B.183
! P243.9 SFLBES5B.184
SFLBES5B.185
QW_BLEND(I) = Q_BLEND(I) + QCL_1(I) + QCF_1(I) ! P243.10 SFLBES5B.186
SFLBES5B.187
ENDDO SFLBES5B.188
SFLBES5B.189
SFLBES5B.190
IF (LTIMER) THEN SFLBES5B.191
CALL TIMER('SF_LBEST',4) SFLBES5B.192
ENDIF SFLBES5B.193
SFLBES5B.194
RETURN SFLBES5B.195
END SFLBES5B.196
SFLBES5B.197
*ENDIF SFLBES5B.198
SFLBES5B.199