*IF DEF,A03_2C ASJ1F304.330
C ******************************COPYRIGHT****************************** GTS2F400.8857
C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved. GTS2F400.8858
C GTS2F400.8859
C Use, duplication or disclosure of this code is subject to the GTS2F400.8860
C restrictions as set forth in the contract. GTS2F400.8861
C GTS2F400.8862
C Meteorological Office GTS2F400.8863
C London Road GTS2F400.8864
C BRACKNELL GTS2F400.8865
C Berkshire UK GTS2F400.8866
C RG12 2SZ GTS2F400.8867
C GTS2F400.8868
C If no contract has been raised with this copy of the code, the use, GTS2F400.8869
C duplication or disclosure of it is strictly prohibited. Permission GTS2F400.8870
C to do so must first be obtained in writing from the Head of Numerical GTS2F400.8871
C Modelling at the above address. GTS2F400.8872
C ******************************COPYRIGHT****************************** GTS2F400.8873
C GTS2F400.8874
CLL SUBROUTINE SFL_INT------------------------------------------------ SFLINT1B.3
CLL SFLINT1B.4
CLL Purpose: To calculate interpolation coefficients for 10m winds SFLINT1B.5
CLL and 1.5m temperature/specific humidity diagnostics SFLINT1B.6
CLL using a generalisation of the method of Geleyn (1988). SFLINT1B.7
CLL SFLINT1B.8
CLL Suitable for single column use (via *IF definition IBM). SFLINT1B.9
CLL SFLINT1B.10
CLL Model Modification history: SFLINT1B.11
CLL version Date SFLINT1B.12
CLL SFLINT1B.13
CLL 3.1 10/92 First version by Simon Jackson SFLINT1B.14
CLL 3.2 7/93 Correction to TIMER calls. S Jackson SJ190793.1
CLL 3.4 6/94 DEF TIMER replaced by LOGICAL LTIMER ASJ1F304.331
CLL Argument LTIMER added ASJ1F304.332
CLL S.J.Swarbrick ASJ1F304.333
CLL 4.2 Oct. 96 T3E migration - *DEF CRAY removed GSS2F402.305
CLL S J Swarbrick GSS2F402.306
CLL SFLINT1B.15
CLL Programming standard: Unified Model Documentation Paper No 4, SFLINT1B.16
CLL Version 2, dated 18/1/90. SFLINT1B.17
CLL SFLINT1B.18
CLL Logical component covered: Part of P243. SFLINT1B.19
CLL SFLINT1B.20
CLL System Task: SFLINT1B.21
CLL SFLINT1B.22
CLL External Documentation: UMDP No.24 SFLINT1B.23
CLL SFLINT1B.24
CLL--------------------------------------------------------------------- SFLINT1B.25
C*L Arguments :- SFLINT1B.26
SUBROUTINE SFL_INT ( 3,8SFLINT1B.27
+ P_POINTS,U_POINTS,RIB,Z1,Z0M,Z0H,Z0F,CD,CH,CDR10M,CHR1P5M SFLINT1B.28
+,CER1P5M,RESFT SFLINT1B.29
+,SU10,SV10,ST1P5,SQ1P5,LTIMER ASJ1F304.334
+) SFLINT1B.31
IMPLICIT NONE SFLINT1B.32
INTEGER SFLINT1B.33
+ P_POINTS ! IN No. of P-grid points to be processed. SFLINT1B.34
+,U_POINTS ! IN No. of UV-grid points to be processed. SFLINT1B.35
REAL SFLINT1B.36
+ RIB(P_POINTS) ! IN Bulk Richardson number for SFLINT1B.37
C ! lowest layer. SFLINT1B.38
+,Z1(P_POINTS) ! IN Height of lowest model level (m). SFLINT1B.39
+,Z0M(P_POINTS) ! IN Roughness length for momentum (m). SFLINT1B.40
+,Z0H(P_POINTS) ! IN Roughness length for heat and SFLINT1B.41
C ! moisture (m). SFLINT1B.42
+,Z0F(P_POINTS) ! IN Roughness length in the free SFLINT1B.43
C ! convective limit (m). SFLINT1B.44
+,CD(P_POINTS) ! IN Drag coefficient for momentum. SFLINT1B.45
+,CH(P_POINTS) ! IN Drag coefficient for heat and SFLINT1B.46
C ! moisture. SFLINT1B.47
+,RESFT(P_POINTS) ! IN Total resistance factor for moisture SFLINT1B.48
C ! transfer from the surface. SFLINT1B.49
LOGICAL SFLINT1B.50
+ SU10 ! IN 10m U-wind diagnostic flag SFLINT1B.51
+,SV10 ! IN 10m V-wind diagnostic flag SFLINT1B.52
+,ST1P5 ! IN screen temp diagnostic flag SFLINT1B.53
+,SQ1P5 ! IN screen specific humidity SFLINT1B.54
C ! diagnostic flag SFLINT1B.55
+,LTIMER ! IN TIMER flag ASJ1F304.335
C Output variables SFLINT1B.56
C SFLINT1B.57
REAL SFLINT1B.58
+ CDR10M(U_POINTS) ! OUT interpolation coefficicent for 10m wind SFLINT1B.59
+,CHR1P5M(P_POINTS) ! OUT Interpolation coefficient for 1.5m SFLINT1B.60
C ! temperature SFLINT1B.61
+,CER1P5M(P_POINTS) ! OUT Interpolation coefficient for 1.5m SFLINT1B.62
C ! specific humidity SFLINT1B.63
C* SFLINT1B.64
C*L--------------------------------------------------------------------- SFLINT1B.65
EXTERNAL TIMER SFLINT1B.67
C*L--------------------------------------------------------------------- SFLINT1B.72
C Local and other symbolic constants :- SFLINT1B.73
*CALL C_VKMAN 
SFLINT1B.74
REAL Z1P5M,Z10M SFLINT1B.75
PARAMETER ( SFLINT1B.76
+ Z1P5M = 1.5 ! for diagnosis of screen values of temperature SFLINT1B.77
C ! and humidity (assumed to be at 1.5m). SFLINT1B.78
+,Z10M = 10.0 ! for diagnosis of 10m winds. SFLINT1B.79
+) SFLINT1B.80
C SFLINT1B.81
C Define local storage. SFLINT1B.82
C SFLINT1B.83
C (a) Local work arrays. SFLINT1B.84
C SFLINT1B.85
REAL SFLINT1B.87
+ Z1E(P_POINTS) ! Level 1 height + Z0M SFLINT1B.88
+,SQRTCD(P_POINTS) ! Square root of CD SFLINT1B.89
C SFLINT1B.96
C (b) Scalars. SFLINT1B.97
C SFLINT1B.98
REAL SFLINT1B.99
+ Z1S ! Level 1 height + Z0M - Z0H SFLINT1B.100
+,Z1P5ME ! 1.5m + Z0M (screen height + envelope height) SFLINT1B.101
+,Z10ME ! 10m + Z0M SFLINT1B.102
+,SQRTCD_K ! Temporary storage in calc of 1.5 amd 10m diags SFLINT1B.103
+,Z_OVER_Z1 ! Temporary storage in calc of 1.5 amd 10m diags SFLINT1B.104
+,CDNZ ! Neutral drag coef. for momentum @ 10m SFLINT1B.105
+,CDNZ1 ! Neutral drag coef. for momentum @ level1 SFLINT1B.106
+,CHNZ ! Neutral drag coef. for heat/moisture @ 1.5m SFLINT1B.107
+,CHNZ1 ! Neutral drag coef. for heat/moisture @ level1 SFLINT1B.108
+,CDTEMP ! workspace in calc of interpolation coeffs. SFLINT1B.109
SFLINT1B.110
INTEGER SFLINT1B.111
+ I ! Loop counter (horizontal field index). SFLINT1B.112
C* SFLINT1B.113
IF (LTIMER) THEN ASJ1F304.336
CALL TIMER('SFLINT ',3) SJ190793.2
ENDIF ASJ1F304.337
C SFLINT1B.117
C----------------------------------------------------------------------- SFLINT1B.118
CL 1. This routine uses a generalised formulation of Geleyn (1988) SFLINT1B.119
CL to interpolate to screen and 10m height using surface and bottom SFLINT1B.120
CL level values as well as roughness lengths for heat and momentum. SFLINT1B.121
CL Start of main loop. Set up variables needed later (eg height of SFLINT1B.122
CL envelope orography). SFLINT1B.123
C----------------------------------------------------------------------- SFLINT1B.124
SFLINT1B.125
DO I=1,P_POINTS SFLINT1B.126
SQRTCD(I) = SQRT(CD(I)) SFLINT1B.127
Z1E(I) = Z1(I) + Z0M(I) SFLINT1B.128
ENDDO SFLINT1B.129
SFLINT1B.130
C----------------------------------------------------------------------- SFLINT1B.131
CL 2. If selected calculate interpolation coefficient for 10m winds. SFLINT1B.132
C----------------------------------------------------------------------- SFLINT1B.133
C SFLINT1B.134
IF(SU10.OR.SV10) THEN SFLINT1B.135
DO I=1,P_POINTS SFLINT1B.136
Z10ME = Z10M + Z0M(I) SFLINT1B.137
CDNZ = LOG( Z10ME / Z0M(I) ) SFLINT1B.138
CDNZ1 = LOG( Z1E(I) / Z0M(I) ) SFLINT1B.139
SQRTCD_K = SQRTCD(I) / VKMAN SFLINT1B.140
Z_OVER_Z1 = Z10M / Z1(I) SFLINT1B.141
SFLINT1B.142
IF (RIB(I).GE.0.0) THEN SFLINT1B.143
CDR10M(I) = Z_OVER_Z1 + SQRTCD_K * SFLINT1B.144
+ (CDNZ - Z_OVER_Z1*CDNZ1) SFLINT1B.145
ELSE SFLINT1B.146
CDTEMP = ( Z10M * Z1E(I) + Z0M(I) * (Z1(I)-Z10M) SFLINT1B.147
+ * EXP (1.0/SQRTCD_K) ) / (Z1(I) * Z10ME) SFLINT1B.148
CDR10M(I) = 1 - SQRTCD_K * LOG (CDTEMP) SFLINT1B.149
ENDIF SFLINT1B.150
ENDDO SFLINT1B.151
ENDIF SFLINT1B.152
C SFLINT1B.153
C----------------------------------------------------------------------- SFLINT1B.154
CL 3. If selected calculate interpolation coefficient for 1.5m screen SFLINT1B.155
CL temperature and specific humidity. SFLINT1B.156
C----------------------------------------------------------------------- SFLINT1B.157
C SFLINT1B.158
IF (ST1P5.OR.SQ1P5) THEN SFLINT1B.159
DO I=1,P_POINTS SFLINT1B.160
C SFLINT1B.161
C variables to be used later SFLINT1B.162
Z1S = Z1E(I) - Z0H(I) SFLINT1B.163
Z1P5ME = Z1P5M + Z0H(I) SFLINT1B.164
CHNZ = LOG( Z1P5ME / Z0H(I) ) SFLINT1B.165
CHNZ1 = LOG( Z1E(I) / Z0H(I) ) SFLINT1B.166
SQRTCD_K = CH(I) / (SQRTCD(I) * VKMAN) SFLINT1B.167
Z_OVER_Z1 = Z1P5M / Z1S SFLINT1B.168
SFLINT1B.169
C SFLINT1B.170
C Stable case SFLINT1B.171
IF (RIB(I).GE.0.0) THEN SFLINT1B.172
CHR1P5M(I) = Z_OVER_Z1 + SQRTCD_K * SFLINT1B.173
+ (CHNZ - Z_OVER_Z1 * CHNZ1) SFLINT1B.174
ELSE SFLINT1B.175
C SFLINT1B.176
C Unstable Case SFLINT1B.177
CDTEMP = ( Z1P5M * Z1E(I) + Z0H(I) * (Z1E(I)-Z1P5ME) * SFLINT1B.178
+ EXP (1.0 / SQRTCD_K) ) / (Z1S * Z1P5ME) SFLINT1B.179
CHR1P5M(I) = 1 - SQRTCD_K * LOG (CDTEMP) SFLINT1B.180
ENDIF SFLINT1B.181
SFLINT1B.182
C SFLINT1B.183
CER1P5M(I) = ( CHR1P5M(I) - 1.0 ) * RESFT(I) ! P243.123 SFLINT1B.184
ENDDO SFLINT1B.185
ENDIF SFLINT1B.186
C SFLINT1B.187
IF (LTIMER) THEN ASJ1F304.338
CALL TIMER('SFLINT ',4) SJ190793.3
ENDIF ASJ1F304.339
RETURN SFLINT1B.191
END SFLINT1B.192
*ENDIF SFLINT1B.420