*IF DEF,A03_7A FCDCH7A.2
C *****************************COPYRIGHT****************************** FCDCH7A.3
C (c) CROWN COPYRIGHT 1997, METEOROLOGICAL OFFICE, All Rights Reserved. FCDCH7A.4
C FCDCH7A.5
C Use, duplication or disclosure of this code is subject to the FCDCH7A.6
C restrictions as set forth in the contract. FCDCH7A.7
C FCDCH7A.8
C Meteorological Office FCDCH7A.9
C London Road FCDCH7A.10
C BRACKNELL FCDCH7A.11
C Berkshire UK FCDCH7A.12
C RG12 2SZ FCDCH7A.13
C FCDCH7A.14
C If no contract has been raised with this copy of the code, the use, FCDCH7A.15
C duplication or disclosure of it is strictly prohibited. Permission FCDCH7A.16
C to do so must first be obtained in writing from the Head of Numerical FCDCH7A.17
C Modelling at the above address. FCDCH7A.18
C ******************************COPYRIGHT****************************** FCDCH7A.19
!!! SUBROUTINES FCDCH_SEA AND FCDCH_LAND----------------------------- FCDCH7A.20
!!! FCDCH7A.21
!!! Purpose: Calculate bulk transfer coefficients at one or more FCDCH7A.22
!!! gridpoints, according to formulae derived by R N B Smith FCDCH7A.23
!!! October 1989. FCDCH7A.24
!!! FCDCH7A.25
!!! Model Modification history: FCDCH7A.26
!!! version Date FCDCH7A.27
!!! FCDCH7A.28
!!! 4.4 7/97 Split into separate land and sea routines for the FCDCH7A.29
!!! MOSES II tile model (Richard Essery). FCDCH7A.30
!!! FCDCH7A.31
!!! Programming standard: Unified Model Documentation Paper No 4, FCDCH7A.32
!!! Version 2, dated 18/1/90. FCDCH7A.33
!!! FCDCH7A.34
!!! System component covered: Part of P243. FCDCH7A.35
!!! FCDCH7A.36
!!! Documentation: UM Documentation Paper No 24, section P243. FCDCH7A.37
!!! See especially sub-section (iv). FCDCH7A.38
!!! ----------------------------------------------------------------- FCDCH7A.39
FCDCH7A.40
! SUBROUTINE FCDCH_SEA--------------------------------------------- FCDCH7A.41
! FCDCH7A.42
! Transfer coefficients for sea, sea-ice and leads FCDCH7A.43
! FCDCH7A.44
! ----------------------------------------------------------------- FCDCH7A.45
SUBROUTINE FCDCH_SEA (P_POINTS,P_FIELD,P1,LAND_MASK, 3,2FCDCH7A.46
& RIB,Z0M,Z0H,Z0F,Z1_UV,Z1_TQ, FCDCH7A.47
& CD,CH,LTIMER) FCDCH7A.48
FCDCH7A.49
IMPLICIT NONE FCDCH7A.50
FCDCH7A.51
INTEGER FCDCH7A.52
& P_POINTS ! IN Number of gridpoints treated. FCDCH7A.53
&,P_FIELD ! IN Size of field on p-grid. FCDCH7A.54
&,P1 ! IN First p-point to be treated. FCDCH7A.55
FCDCH7A.56
LOGICAL FCDCH7A.57
& LTIMER ! IN logical for TIMER FCDCH7A.58
&,LAND_MASK(P_FIELD) ! IN .TRUE. for land; .FALSE. elsewhere. FCDCH7A.59
FCDCH7A.60
REAL FCDCH7A.61
& RIB(P_FIELD) ! IN Bulk Richardson number. FCDCH7A.62
&,Z0M(P_FIELD) ! IN Roughness length for momentum transport FCDCH7A.63
&,Z0H(P_FIELD) ! IN Roughness length for heat and moisture FCDCH7A.64
&,Z0F(P_FIELD) ! IN Roughness length for free-convective heat FCDCH7A.65
! ! and moisture transport (m). FCDCH7A.66
&,Z1_UV(P_FIELD) ! IN Height of lowest uv level (m). FCDCH7A.67
&,Z1_TQ(P_FIELD) ! IN Height of lowest tq level (m). FCDCH7A.68
FCDCH7A.69
REAL FCDCH7A.70
& CD(P_FIELD) ! OUT Surface drag coefficient including form FCDCH7A.71
! drag. FCDCH7A.72
&,CH(P_FIELD) ! OUT Bulk transfer coefficient for FCDCH7A.73
! heat/moisture. FCDCH7A.74
FCDCH7A.75
EXTERNAL TIMER FCDCH7A.76
FCDCH7A.77
!---------------------------------------------------------------------- FCDCH7A.78
! Common and local physical constants FCDCH7A.79
*CALL C_VKMAN 
FCDCH7A.80
FCDCH7A.81
REAL ALPHAR,HETGEN,CZ,DM FCDCH7A.82
PARAMETER ( FCDCH7A.83
& ALPHAR=5.0 ! Tunable parameter in FM and FH calculation. FCDCH7A.84
&,HETGEN=0.0 ! Tunable parameter to represent 'the degree of FCDCH7A.85
! heterogeneity' of the surface; must be > or = 0.0 FCDCH7A.86
! and < or = 1.0 FCDCH7A.87
&,CZ=4.0 ! Tunable parameter in unstable Fh, Fm calculations, FCDCH7A.88
! equal to (3h)**-1.5 in the documentation. FCDCH7A.89
&,DM=2.0 ! Tunable parameter in unstable Fm calculation. FCDCH7A.90
&) FCDCH7A.91
FCDCH7A.92
! Define local variables (more or less in order of first appearance). FCDCH7A.93
FCDCH7A.94
INTEGER I ! Loop counter; horizontal field index FCDCH7A.95
REAL FCDCH7A.96
& KARMAN2 ! Square of von Karman's constant. FCDCH7A.97
&,ZETAM ! See documentation for definition. FCDCH7A.98
&,ZETAH ! See documentation for definition. FCDCH7A.99
&,CDN ! CD for neutral conditions. FCDCH7A.100
&,CHN ! CH for neutral conditions. FCDCH7A.101
&,PRANDTL ! Prandtl number at neutrality. FCDCH7A.102
&,RFZ ! Temporary in calculation of FM and FH. FCDCH7A.103
&,RIF ! Flux Richardson number. FCDCH7A.104
&,AM ! Temporary in calculation of FM and FH. FCDCH7A.105
&,AH ! Temporary in calculation of FM and FH. FCDCH7A.106
&,BM ! Temporary in calculation of FM and FH. FCDCH7A.107
&,BH ! Temporary in calculation of FM and FH. FCDCH7A.108
&,FM ! Stability factor for CD. FCDCH7A.109
&,FH ! Stability factor for CH. FCDCH7A.110
FCDCH7A.111
IF (LTIMER) THEN FCDCH7A.112
CALL TIMER('FCDCH ',3) FCDCH7A.113
ENDIF FCDCH7A.114
FCDCH7A.115
KARMAN2=VKMAN*VKMAN FCDCH7A.116
FCDCH7A.117
DO I=P1,P1+P_POINTS-1 FCDCH7A.118
CD(I) = 0. FCDCH7A.119
CH(I) = 0. FCDCH7A.120
IF ( .NOT. LAND_MASK(I) ) THEN FCDCH7A.121
FCDCH7A.122
!----------------------------------------------------------------------- FCDCH7A.123
!! 1. Calculate neutral CD, CH. FCDCH7A.124
!----------------------------------------------------------------------- FCDCH7A.125
! (A) Store ZETAM, ZETAH. FCDCH7A.126
ZETAM = LOG( (Z1_UV(I) + Z0M(I)) / Z0M(I) ) FCDCH7A.127
ZETAH = LOG( (Z1_TQ(I) + Z0M(I)) / Z0H(I) ) FCDCH7A.128
! (B) Calculate neutral CD, CH. Eqns P243.40, P243.41 FCDCH7A.129
CDN = KARMAN2 / ( ZETAM * ZETAM ) FCDCH7A.130
CHN = KARMAN2 / ( ZETAH * ZETAM ) FCDCH7A.131
PRANDTL = CDN / CHN FCDCH7A.132
! (C) Calculate temporary quantities. FCDCH7A.133
AM = 2.0 * ALPHAR / PRANDTL FCDCH7A.134
AH = AM FCDCH7A.135
FCDCH7A.136
!----------------------------------------------------------------------- FCDCH7A.137
!! 2. Calculate functions Fm, Fh. FCDCH7A.138
!----------------------------------------------------------------------- FCDCH7A.139
RFZ=0.0 FCDCH7A.140
BM=0.0 FCDCH7A.141
BH=0.0 FCDCH7A.142
RIF = RIB(I) / PRANDTL FCDCH7A.143
FCDCH7A.144
! Case 1: stable boundary layer (RIB > 0). FCDCH7A.145
IF (RIB(I) .GT. 0.0) THEN FCDCH7A.146
IF ( 1.0/RIF .GT. HETGEN*ALPHAR ) THEN FCDCH7A.147
FM = 1.0 - HETGEN * ALPHAR * RIF FCDCH7A.148
FM = ( FM * FM ) / FCDCH7A.149
& ( 1.0 + 2.0 * (1.0-HETGEN) * ALPHAR * RIF ) FCDCH7A.150
FH = FM FCDCH7A.151
ELSE FCDCH7A.152
FM = 0.0 FCDCH7A.153
FH = 0.0 FCDCH7A.154
ENDIF FCDCH7A.155
FCDCH7A.156
! Case 2: unstable boundary layer (RIB < or = 0). FCDCH7A.157
ELSE FCDCH7A.158
! (A) Store 1/Fz in RFZ. Eqn P243.51, as approximated by P243.52. FCDCH7A.159
RFZ = CZ * SQRT ( Z1_UV(I) / Z0F(I) ) FCDCH7A.160
! (B) Store BM and BH. FCDCH7A.161
BM = DM * AM * CDN * RFZ FCDCH7A.162
BH = AH * CHN * RFZ FCDCH7A.163
! (C) Finally calculate FM and FH. FCDCH7A.164
FM = 1.0 - AM * RIB(I) / ( 1.0 + BM * SQRT(-RIB(I)) ) FCDCH7A.165
FH = 1.0 - AH * RIB(I) / ( 1.0 + BH * SQRT(-RIB(I)) ) FCDCH7A.166
FCDCH7A.167
ENDIF FCDCH7A.168
FCDCH7A.169
!----------------------------------------------------------------------- FCDCH7A.170
!! 3. Calculate output coefficients. Eqns P243.53, P243.54. FCDCH7A.171
!----------------------------------------------------------------------- FCDCH7A.172
CD(I) = CDN * FM FCDCH7A.173
CH(I) = CHN * FH FCDCH7A.174
FCDCH7A.175
ENDIF ! Sea points FCDCH7A.176
FCDCH7A.177
ENDDO ! POINTS FCDCH7A.178
FCDCH7A.179
IF (LTIMER) THEN FCDCH7A.180
CALL TIMER('FCDCH ',4) FCDCH7A.181
ENDIF FCDCH7A.182
FCDCH7A.183
RETURN FCDCH7A.184
END FCDCH7A.185
FCDCH7A.186
! SUBROUTINE FCDCH_LAND--------------------------------------------- FCDCH7A.187
! FCDCH7A.188
! Transfer coefficients for snow, land ice and snow-free land tiles FCDCH7A.189
! FCDCH7A.190
! ------------------------------------------------------------------ FCDCH7A.191
SUBROUTINE FCDCH_LAND ( 1,2FCDCH7A.192
& P_FIELD,LAND_FIELD,TILE_PTS,TILE_INDEX,LAND_INDEX, FCDCH7A.193
& RIB,WIND_PROFILE_FACTOR,Z0M,Z0H,Z0F,Z1_UV,Z1_TQ, FCDCH7A.194
& CD,CH,CD_STD,LTIMER FCDCH7A.195
& ) FCDCH7A.196
FCDCH7A.197
IMPLICIT NONE FCDCH7A.198
FCDCH7A.199
INTEGER FCDCH7A.200
& P_FIELD ! IN Size of field on p-grid. FCDCH7A.201
&,LAND_FIELD ! IN Number of land points. FCDCH7A.202
&,TILE_PTS ! IN Number of tile points. FCDCH7A.203
&,TILE_INDEX(LAND_FIELD) FCDCH7A.204
! ! IN Index of tile points. FCDCH7A.205
&,LAND_INDEX(P_FIELD)! IN Index of land points. FCDCH7A.206
FCDCH7A.207
LOGICAL FCDCH7A.208
& LTIMER ! IN Logical for TIMER. FCDCH7A.209
FCDCH7A.210
REAL FCDCH7A.211
& RIB(LAND_FIELD) ! IN Bulk Richardson number. FCDCH7A.212
&,WIND_PROFILE_FACTOR(LAND_FIELD) FCDCH7A.213
! ! IN for adjusting the surface transfer FCDCH7A.214
! ! coefficients to remove form drag effects. FCDCH7A.215
&,Z0M(LAND_FIELD) ! IN Roughness length for momentum transport FCDCH7A.216
&,Z0H(LAND_FIELD) ! IN Roughness length for heat and moisture FCDCH7A.217
&,Z0F(LAND_FIELD) ! IN Roughness length for free-convective heat FCDCH7A.218
! ! and moisture transport (m). FCDCH7A.219
&,Z1_UV(P_FIELD) ! IN Height of lowest uv level (m). FCDCH7A.220
&,Z1_TQ(P_FIELD) ! IN Height of lowest tq level (m). FCDCH7A.221
FCDCH7A.222
REAL FCDCH7A.223
& CD(LAND_FIELD) ! OUT Surface drag coefficient including form FCDCH7A.224
! ! drag. FCDCH7A.225
&,CH(LAND_FIELD) ! OUT Bulk transfer coefficient for FCDCH7A.226
! ! heat/moisture. FCDCH7A.227
&,CD_STD(LAND_FIELD) ! OUT Surface drag coefficient excluding form FCDCH7A.228
! drag. FCDCH7A.229
FCDCH7A.230
EXTERNAL TIMER FCDCH7A.231
FCDCH7A.232
!---------------------------------------------------------------------- FCDCH7A.233
! Common and local physical constants FCDCH7A.234
*CALL C_VKMAN FCDCH7A.235
FCDCH7A.236
REAL ALPHAR,HETGEN,CZ,DM FCDCH7A.237
PARAMETER ( FCDCH7A.238
& ALPHAR=5.0 ! Tunable parameter in FM and FH calculation. FCDCH7A.239
&,HETGEN=0.0 ! Tunable parameter to represent 'the degree of FCDCH7A.240
! heterogeneity' of the surface; must be > or = 0.0 FCDCH7A.241
! and < or = 1.0 FCDCH7A.242
&,CZ=4.0 ! Tunable parameter in unstable Fh, Fm calculations, FCDCH7A.243
! equal to (3h)**-1.5 in the documentation. FCDCH7A.244
&,DM=2.0 ! Tunable parameter in unstable Fm calculation. FCDCH7A.245
&) FCDCH7A.246
FCDCH7A.247
! Define local variables (more or less in order of first appearance). FCDCH7A.248
FCDCH7A.249
INTEGER FCDCH7A.250
& I ! Horizontal field index FCDCH7A.251
&,J ! Tile field index FCDCH7A.252
&,L ! Land field index FCDCH7A.253
FCDCH7A.254
REAL FCDCH7A.255
& KARMAN2 ! Square of von Karman's constant. FCDCH7A.256
&,ZETAM ! See documentation for definition. FCDCH7A.257
&,ZETAH ! See documentation for definition. FCDCH7A.258
&,CDN ! CD for neutral conditions. FCDCH7A.259
&,CHN ! CH for neutral conditions. FCDCH7A.260
&,CDN_STD ! CD_STD for neutral conditions. FCDCH7A.261
&,PRANDTL ! Prandtl number at neutrality. FCDCH7A.262
&,RFZ ! Temporary in calculation of FM and FH. FCDCH7A.263
&,RIF ! Flux Richardson number. FCDCH7A.264
&,AM ! Temporary in calculation of FM and FH. FCDCH7A.265
&,AH ! Temporary in calculation of FM and FH. FCDCH7A.266
&,BM ! Temporary in calculation of FM and FH. FCDCH7A.267
&,BH ! Temporary in calculation of FM and FH. FCDCH7A.268
&,BM_STD ! Temporary in calculation of FM_STD. FCDCH7A.269
&,FM ! Stability factor for CD. FCDCH7A.270
&,FH ! Stability factor for CH. FCDCH7A.271
&,FM_STD ! Stability factor for CD_STD. FCDCH7A.272
FCDCH7A.273
IF (LTIMER) THEN FCDCH7A.274
CALL TIMER('FCDCH ',3) FCDCH7A.275
ENDIF FCDCH7A.276
FCDCH7A.277
KARMAN2=VKMAN*VKMAN FCDCH7A.278
FCDCH7A.279
DO J=1,TILE_PTS FCDCH7A.280
L = TILE_INDEX(J) FCDCH7A.281
I = LAND_INDEX(L) FCDCH7A.282
FCDCH7A.283
!----------------------------------------------------------------------- FCDCH7A.284
!! 1. Calculate neutral CD, CH. FCDCH7A.285
!----------------------------------------------------------------------- FCDCH7A.286
! (A) Store ZETAM, ZETAH. FCDCH7A.287
ZETAM = LOG( (Z1_UV(I) + Z0M(L)) / Z0M(L) ) FCDCH7A.288
ZETAH = LOG( (Z1_TQ(I) + Z0M(L)) / Z0H(L) ) FCDCH7A.289
! (B) Calculate neutral CD, CH. Eqns P243.40, P243.41 FCDCH7A.290
CDN = KARMAN2 / ( ZETAM * ZETAM ) FCDCH7A.291
CHN = KARMAN2 / ( ZETAH * ZETAM ) * WIND_PROFILE_FACTOR(L) FCDCH7A.292
CDN_STD = CDN * WIND_PROFILE_FACTOR(L) * FCDCH7A.293
& WIND_PROFILE_FACTOR(L) FCDCH7A.294
PRANDTL = CDN_STD / CHN FCDCH7A.295
! (C) Calculate temporary quantities. FCDCH7A.296
AM = 2.0 * ALPHAR / PRANDTL FCDCH7A.297
AH = AM FCDCH7A.298
FCDCH7A.299
!----------------------------------------------------------------------- FCDCH7A.300
!! 2. Calculate functions Fm, Fh. FCDCH7A.301
!----------------------------------------------------------------------- FCDCH7A.302
RFZ=0.0 FCDCH7A.303
BM=0.0 FCDCH7A.304
BH=0.0 FCDCH7A.305
BM_STD=0.0 FCDCH7A.306
RIF = RIB(L) / PRANDTL FCDCH7A.307
FCDCH7A.308
! Case 1: stable boundary layer (RIB > 0). FCDCH7A.309
IF (RIB(L) .GT. 0.0) THEN FCDCH7A.310
IF ( 1.0/RIF .GT. HETGEN*ALPHAR ) THEN FCDCH7A.311
FM = 1.0 - HETGEN * ALPHAR * RIF FCDCH7A.312
FM = ( FM * FM ) / FCDCH7A.313
& ( 1.0 + 2.0 * (1.0-HETGEN) * ALPHAR * RIF ) FCDCH7A.314
FH = FM FCDCH7A.315
FM_STD = FM FCDCH7A.316
ELSE FCDCH7A.317
FM = 0.0 FCDCH7A.318
FH = 0.0 FCDCH7A.319
FM_STD = 0.0 FCDCH7A.320
ENDIF FCDCH7A.321
FCDCH7A.322
! Case 2: unstable boundary layer (RIB < or = 0). FCDCH7A.323
ELSE FCDCH7A.324
! (A) Store 1/Fz in RFZ. Eqn P243.51, as approximated by P243.52. FCDCH7A.325
RFZ = CZ * SQRT ( Z1_UV(I) / Z0F(L) ) FCDCH7A.326
! (B) Store BM, BH and BM_STD. FCDCH7A.327
BM = DM * AM * CDN * RFZ FCDCH7A.328
BH = AH * CHN * RFZ FCDCH7A.329
BM_STD = DM * AM * CDN_STD * RFZ FCDCH7A.330
! (C) Finally calculate FM, FH and FM_STD. FCDCH7A.331
FM = 1.0 - AM * RIB(L) / ( 1.0 + BM * SQRT(-RIB(L)) ) FCDCH7A.332
FH = 1.0 - AH * RIB(L) / ( 1.0 + BH * SQRT(-RIB(L)) ) FCDCH7A.333
FM_STD = 1.0 - AM * RIB(L) / FCDCH7A.334
& ( 1.0 + BM_STD * SQRT(-RIB(L)) ) FCDCH7A.335
FCDCH7A.336
ENDIF FCDCH7A.337
FCDCH7A.338
!----------------------------------------------------------------------- FCDCH7A.339
!! 3. Calculate output coefficients. Eqns P243.53, P243.54. FCDCH7A.340
!----------------------------------------------------------------------- FCDCH7A.341
CD(L) = CDN * FM FCDCH7A.342
CH(L) = CHN * FH FCDCH7A.343
CD_STD(L) = CDN_STD * FM_STD FCDCH7A.344
FCDCH7A.345
ENDDO ! POINTS FCDCH7A.346
FCDCH7A.347
IF (LTIMER) THEN FCDCH7A.348
CALL TIMER('FCDCH ',4) FCDCH7A.349
ENDIF FCDCH7A.350
FCDCH7A.351
RETURN FCDCH7A.352
END FCDCH7A.353
FCDCH7A.354
*ENDIF FCDCH7A.355