*IF DEF,A03_6A FCDCH6A.2
C ******************************COPYRIGHT****************************** FCDCH6A.3
C (c) CROWN COPYRIGHT 1997, METEOROLOGICAL OFFICE, All Rights Reserved. FCDCH6A.4
C FCDCH6A.5
C Use, duplication or disclosure of this code is subject to the FCDCH6A.6
C restrictions as set forth in the contract. FCDCH6A.7
C FCDCH6A.8
C Meteorological Office FCDCH6A.9
C London Road FCDCH6A.10
C BRACKNELL FCDCH6A.11
C Berkshire UK FCDCH6A.12
C RG12 2SZ FCDCH6A.13
C FCDCH6A.14
C If no contract has been raised with this copy of the code, the use, FCDCH6A.15
C duplication or disclosure of it is strictly prohibited. Permission FCDCH6A.16
C to do so must first be obtained in writing from the Head of Numerical FCDCH6A.17
C Modelling at the above address. FCDCH6A.18
C ******************************COPYRIGHT****************************** FCDCH6A.19
C FCDCH6A.20
!!! SUBROUTINE FCDCH-------------------------------------------------- FCDCH6A.21
!!! FCDCH6A.22
!!! Purpose: Calculate surface transfer coefficients at one or more FCDCH6A.23
!!! gridpoints. FCDCH6A.24
!!! FCDCH6A.25
!!! Model Modification history: FCDCH6A.26
!!! version Date FCDCH6A.27
!!! FCDCH6A.28
!!! 4.4 08/05/97 New version of subroutine using Monin-Obukhov FCDCH6A.29
!!! stability functions created. FCDCH6A.30
!!! R.N.B.Smith FCDCH6A.31
!!! FCDCH6A.32
!!! Programming standard: FCDCH6A.33
!!! FCDCH6A.34
!!! System component covered: Part of P243. FCDCH6A.35
!!! FCDCH6A.36
!!! Documentation: UM Documentation Paper No 24, section P243. FCDCH6A.37
!!! FCDCH6A.38
!! Arguments:--------------------------------------------------------- FCDCH6A.39
SUBROUTINE FCDCH( 9,6FCDCH6A.40
& P_POINTS,P_FIELD,P1,L_LAND,LAND_MASK, FCDCH6A.41
& DB,VSHR,Z0M,Z0H,ZH,Z1_UV,Z1_TQ,WIND_PROFILE_FACTOR, FCDCH6A.42
& CDV,CHV,CDV_STD,V_S,V_S_STD,RECIP_L_MO,LTIMER FCDCH6A.43
&) FCDCH6A.44
IMPLICIT NONE FCDCH6A.45
FCDCH6A.46
INTEGER FCDCH6A.47
& P_POINTS ! IN Number of gridpoints treated. FCDCH6A.48
&,P_FIELD ! IN Size of field on p-grid. FCDCH6A.49
&,P1 ! IN First p-point to be treated. FCDCH6A.50
FCDCH6A.51
LOGICAL FCDCH6A.52
& LTIMER FCDCH6A.53
&,L_LAND ! IN If true, treat land points only. FCDCH6A.54
&,LAND_MASK(P_FIELD) ! IN Land mask FCDCH6A.55
FCDCH6A.56
FCDCH6A.57
REAL FCDCH6A.58
& DB(P_FIELD) ! IN Buoyancy difference between surface and lowest FCDCH6A.59
! ! temperature and humidity level in the FCDCH6A.60
! ! atmosphere (m/s^2). FCDCH6A.61
&,VSHR(P_FIELD) ! IN Wind speed difference between the surface and FCDCH6A.62
! ! the lowest wind level in the atmosphere (m/s). FCDCH6A.63
+,Z0M(P_FIELD) ! IN Roughness length for momentum transport (m). FCDCH6A.64
+,Z0H(P_FIELD) ! IN Roughness length for heat and moisture (m). FCDCH6A.65
+,ZH(P_FIELD) ! IN Depth of boundary layer (m). FCDCH6A.66
+,Z1_UV(P_FIELD)! IN Height of lowest wind level (m). FCDCH6A.67
+,Z1_TQ(P_FIELD)! IN Height of lowest temperature and humidity FCDCH6A.68
! ! level (m). FCDCH6A.69
&,WIND_PROFILE_FACTOR(P_FIELD) FCDCH6A.70
! ! IN for adjusting the surface transfer FCDCH6A.71
! ! coefficients to remove form drag effects. FCDCH6A.72
FCDCH6A.73
REAL FCDCH6A.74
& CDV(P_FIELD) ! OUT Surface transfer coefficient for momentum FCDCH6A.75
! ! including orographic form drag (m/s). FCDCH6A.76
+,CHV(P_FIELD) ! OUT Surface transfer coefficient for FCDCH6A.77
! ! heat, moisture & other scalars (m/s). FCDCH6A.78
&,CDV_STD(P_FIELD) FCDCH6A.79
! ! OUT Surface transfer coefficient for momentum FCDCH6A.80
! ! excluding orographic form drag (m/s). FCDCH6A.81
&,V_S(P_FIELD) ! OUT Surface layer scaling velocity FCDCH6A.82
! ! including orographic form drag (m/s). FCDCH6A.83
&,V_S_STD(P_FIELD) FCDCH6A.84
! ! OUT Surface layer scaling velocity FCDCH6A.85
! ! excluding orographic form drag (m/s). FCDCH6A.86
&,RECIP_L_MO(P_FIELD) FCDCH6A.87
! ! OUT Reciprocal of the Monin-Obukhov length FCDCH6A.88
! ! (m^-1). FCDCH6A.89
FCDCH6A.90
!*L Workspace usage---------------------------------------------------- FCDCH6A.91
! FCDCH6A.92
! Local work arrays. FCDCH6A.93
! FCDCH6A.94
REAL FCDCH6A.95
& PHI_M(P_FIELD) ! Monin-Obukhov stability function for momentum FCDCH6A.96
! ! integrated to the model's lowest wind level. FCDCH6A.97
&,PHI_H(P_FIELD) ! Monin-Obukhov stability function for scalars FCDCH6A.98
! ! integrated to the model's lowest temperature FCDCH6A.99
! ! and humidity level. FCDCH6A.100
! FCDCH6A.101
!*---------------------------------------------------------------------- FCDCH6A.102
FCDCH6A.103
EXTERNAL TIMER,PHI_M_H FCDCH6A.104
FCDCH6A.105
!*---------------------------------------------------------------------- FCDCH6A.106
! Common and local constants. FCDCH6A.107
*CALL C_VKMAN 
FCDCH6A.108
REAL BETA,THIRD FCDCH6A.109
PARAMETER ( FCDCH6A.110
& BETA=0.08, ! Tunable parameter in the surface layer scaling FCDCH6A.111
! ! velocity formula (multiplying the turbulent FCDCH6A.112
! ! convective scaling velocity). FCDCH6A.113
+ THIRD=1./3. ! One third. FCDCH6A.114
+) FCDCH6A.115
INTEGER N_ITS ! Number of iterations for Monin-Obukhov length FCDCH6A.116
! ! and stability functions. FCDCH6A.117
PARAMETER ( FCDCH6A.118
& N_ITS=5 FCDCH6A.119
&) FCDCH6A.120
! FCDCH6A.121
! Define local variables FCDCH6A.122
! FCDCH6A.123
INTEGER I,L ! Loop counter; horizontal field index. FCDCH6A.124
INTEGER IT ! Iteration loop counter. FCDCH6A.125
FCDCH6A.126
REAL FCDCH6A.127
& B_FLUX ! Surface bouyancy flux over air density. FCDCH6A.128
&,U_S ! Surface friction velocity (effective value). FCDCH6A.129
&,U_S_STD ! Surface friction velocity (standard value). FCDCH6A.130
&,W_S ! Surface turbulent convective scaling velocity. FCDCH6A.131
FCDCH6A.132
IF (LTIMER) THEN FCDCH6A.133
CALL TIMER('FCDCH ',3) FCDCH6A.134
ENDIF FCDCH6A.135
FCDCH6A.136
! FCDCH6A.137
!----------------------------------------------------------------------- FCDCH6A.138
!! 1. Set initial values for the iteration. FCDCH6A.139
!----------------------------------------------------------------------- FCDCH6A.140
! FCDCH6A.141
I=0 ! Reset loop counter FCDCH6A.142
FCDCH6A.143
DO L=P1,P1+P_POINTS-1 FCDCH6A.144
! IF (L_LAND.AND.LAND_MASK(L)) THEN FCDCH6A.145
! I=I+1 FCDCH6A.146
! ELSEIF (.NOT.L_LAND) THEN FCDCH6A.147
I=L FCDCH6A.148
! ENDIF FCDCH6A.149
FCDCH6A.150
! IF(.NOT.L_LAND.OR.(L_LAND.AND.LAND_MASK(L))) THEN FCDCH6A.151
FCDCH6A.152
IF (DB(I) .LT. 0.0 .AND. VSHR(I) .LT. 2.0) THEN FCDCH6A.153
!----------------------------------------------------------------------- FCDCH6A.154
! Start the iteration from the convective limit. FCDCH6A.155
!----------------------------------------------------------------------- FCDCH6A.156
RECIP_L_MO(I) = -VKMAN/(BETA*BETA*BETA*ZH(I)) FCDCH6A.157
ELSE FCDCH6A.158
!----------------------------------------------------------------------- FCDCH6A.159
! Start the iteration from neutral values. FCDCH6A.160
!----------------------------------------------------------------------- FCDCH6A.161
RECIP_L_MO(I) = 0.0 FCDCH6A.162
ENDIF FCDCH6A.163
! ENDIF ! L_LAND and LAND_MASK FCDCH6A.164
ENDDO FCDCH6A.165
CALL PHI_M_H (P_POINTS,P_FIELD,P1,L_LAND,LAND_MASK, FCDCH6A.166
& RECIP_L_MO,Z1_UV,Z1_TQ,Z0M,Z0H, FCDCH6A.167
& PHI_M,PHI_H, FCDCH6A.168
& LTIMER) FCDCH6A.169
! FCDCH6A.170
I=0 ! Reset loop counter FCDCH6A.171
FCDCH6A.172
DO L=P1,P1+P_POINTS-1 FCDCH6A.173
! IF (L_LAND.AND.LAND_MASK(L)) THEN FCDCH6A.174
! I=I+1 FCDCH6A.175
! ELSEIF (.NOT.L_LAND) THEN FCDCH6A.176
I=L FCDCH6A.177
! ENDIF FCDCH6A.178
FCDCH6A.179
! IF(.NOT.L_LAND.OR.(L_LAND.AND.LAND_MASK(L))) THEN FCDCH6A.180
FCDCH6A.181
IF (DB(I) .LT. 0.0 .AND. VSHR(I) .LT. 2.0) THEN FCDCH6A.182
!----------------------------------------------------------------------- FCDCH6A.183
! Start the iteration from the convective limit. FCDCH6A.184
!----------------------------------------------------------------------- FCDCH6A.185
V_S_STD(I) = BETA * FCDCH6A.186
& SQRT( BETA * ( VKMAN / PHI_H(I) ) * ZH(I) * (-DB(I)) ) FCDCH6A.187
V_S(I) = V_S_STD(I) FCDCH6A.188
ELSE FCDCH6A.189
!----------------------------------------------------------------------- FCDCH6A.190
! Start the iteration from neutral values. FCDCH6A.191
!----------------------------------------------------------------------- FCDCH6A.192
V_S(I) = ( VKMAN / PHI_M(I) ) * VSHR(I) FCDCH6A.193
V_S_STD(I) = V_S(I) * WIND_PROFILE_FACTOR(I) FCDCH6A.194
ENDIF FCDCH6A.195
CHV(I) = ( VKMAN / PHI_H(I) ) * V_S_STD(I) FCDCH6A.196
CDV(I) = ( VKMAN / PHI_M(I) ) * V_S(I) FCDCH6A.197
CDV_STD(I) = CDV(I) * ( V_S_STD(I) / V_S(I) ) * FCDCH6A.198
& WIND_PROFILE_FACTOR(I) FCDCH6A.199
! ENDIF ! L_LAND and LAND_MASK FCDCH6A.200
ENDDO FCDCH6A.201
!----------------------------------------------------------------------- FCDCH6A.202
!! 2. Iterate to obtain sucessively better approximations for CD & CH. FCDCH6A.203
!----------------------------------------------------------------------- FCDCH6A.204
DO IT = 1,N_ITS FCDCH6A.205
! FCDCH6A.206
I=0 ! Reset loop counter FCDCH6A.207
FCDCH6A.208
DO L=P1,P1+P_POINTS-1 FCDCH6A.209
! IF (L_LAND.AND.LAND_MASK(L)) THEN FCDCH6A.210
! I=I+1 FCDCH6A.211
! ELSEIF (.NOT.L_LAND) THEN FCDCH6A.212
I=L FCDCH6A.213
! ENDIF FCDCH6A.214
FCDCH6A.215
! IF(.NOT.L_LAND.OR.(L_LAND.AND.LAND_MASK(L))) THEN FCDCH6A.216
FCDCH6A.217
B_FLUX = -CHV(I) * DB(I) FCDCH6A.218
U_S = SQRT( CDV(I) * VSHR(I) ) FCDCH6A.219
U_S_STD = SQRT( CDV_STD(I) * VSHR(I) ) FCDCH6A.220
IF (DB(I) .LT. 0.0) THEN FCDCH6A.221
W_S = (ZH(I) * B_FLUX)**THIRD FCDCH6A.222
V_S(I) = SQRT(U_S*U_S + BETA*BETA*W_S*W_S) FCDCH6A.223
V_S_STD(I) = SQRT(U_S_STD*U_S_STD + BETA*BETA*W_S*W_S) FCDCH6A.224
ELSE FCDCH6A.225
V_S(I) = U_S FCDCH6A.226
V_S_STD(I) = U_S_STD FCDCH6A.227
ENDIF FCDCH6A.228
RECIP_L_MO(I) = -VKMAN * B_FLUX / FCDCH6A.229
& (V_S(I)*V_S(I)*V_S(I)) ARN0F405.874
! ENDIF ! L_LAND and LAND_MASK FCDCH6A.231
ENDDO FCDCH6A.232
CALL PHI_M_H (P_POINTS,P_FIELD,P1,L_LAND,LAND_MASK, FCDCH6A.233
& RECIP_L_MO,Z1_UV,Z1_TQ,Z0M,Z0H, FCDCH6A.234
& PHI_M,PHI_H, FCDCH6A.235
& LTIMER) FCDCH6A.236
! FCDCH6A.237
I=0 ! Reset loop counter FCDCH6A.238
FCDCH6A.239
DO L=P1,P1+P_POINTS-1 FCDCH6A.240
! IF (L_LAND.AND.LAND_MASK(L)) THEN FCDCH6A.241
! I=I+1 FCDCH6A.242
! ELSEIF (.NOT.L_LAND) THEN FCDCH6A.243
I=L FCDCH6A.244
! ENDIF FCDCH6A.245
FCDCH6A.246
! IF(.NOT.L_LAND.OR.(L_LAND.AND.LAND_MASK(L))) THEN FCDCH6A.247
FCDCH6A.248
CHV(I) = ( VKMAN / PHI_H(I) ) * V_S_STD(I) FCDCH6A.249
CDV(I) = ( VKMAN / PHI_M(I) ) * V_S(I) FCDCH6A.250
CDV_STD(I) = CDV(I) * ( V_S_STD(I) / V_S(I) ) * FCDCH6A.251
& WIND_PROFILE_FACTOR(I) FCDCH6A.252
! ENDIF ! L_LAND and LAND_MASK FCDCH6A.253
ENDDO FCDCH6A.254
ENDDO ! Iteration loop FCDCH6A.255
FCDCH6A.256
IF (LTIMER) THEN FCDCH6A.257
CALL TIMER('FCDCH ',4) FCDCH6A.258
ENDIF FCDCH6A.259
FCDCH6A.260
RETURN FCDCH6A.261
END FCDCH6A.262
*ENDIF FCDCH6A.263