*IF DEF,A03_7A SFEXCH7A.2
C *****************************COPYRIGHT****************************** SFEXCH7A.3
C (c) CROWN COPYRIGHT 1997, METEOROLOGICAL OFFICE, All Rights Reserved. SFEXCH7A.4
C SFEXCH7A.5
C Use, duplication or disclosure of this code is subject to the SFEXCH7A.6
C restrictions as set forth in the contract. SFEXCH7A.7
C SFEXCH7A.8
C Meteorological Office SFEXCH7A.9
C London Road SFEXCH7A.10
C BRACKNELL SFEXCH7A.11
C Berkshire UK SFEXCH7A.12
C RG12 2SZ SFEXCH7A.13
C SFEXCH7A.14
C If no contract has been raised with this copy of the code, the use, SFEXCH7A.15
C duplication or disclosure of it is strictly prohibited. Permission SFEXCH7A.16
C to do so must first be obtained in writing from the Head of Numerical SFEXCH7A.17
C Modelling at the above address. SFEXCH7A.18
C ******************************COPYRIGHT****************************** SFEXCH7A.19
!!! SUBROUTINE SF_EXCH------------------------------------------------ SFEXCH7A.20
!!! SFEXCH7A.21
!!! Purpose: Calculate coefficients of turbulent exchange between SFEXCH7A.22
!!! the surface and the lowest atmospheric layer, and SFEXCH7A.23
!!! "explicit" fluxes between the surface and this layer. SFEXCH7A.24
!!! SFEXCH7A.25
!!! Suitable for Single Column use. AJC1F405.75
!!! SFEXCH7A.27
!!! Model Modification history: SFEXCH7A.28
!!! version Date SFEXCH7A.29
!!! 4.3 17/11/95 New deck Simon Jackson SFEXCH7A.30
!!! 4.4 16/7/97 Version for MOSES II tile model. Richard Essery SFEXCH7A.31
!!! 4.5 Jul. 98 Kill the IBM specific lines (JCThil) AJC1F405.74
!!! 4.5 17/11/98 Introduce Z0H_Z0M and initialise FTL_TILE and ABX1F405.895
!!! RIB_TILE on all tiles at all points. Richard Betts ABX1F405.896
!!! SFEXCH7A.32
!!! SFEXCH7A.33
!!! Programming standard: Unified Model Documentation Paper No 4, SFEXCH7A.34
!!! Version 2, dated 18/1/90. SFEXCH7A.35
!!! SFEXCH7A.36
!!! System component covered: Part of P243. SFEXCH7A.37
!!! SFEXCH7A.38
!!! Project task: SFEXCH7A.39
!!! SFEXCH7A.40
!!! Documentation: UM Documentation Paper No 24, section P243. SFEXCH7A.41
!!! See especially sub-section (ix). SFEXCH7A.42
!!! SFEXCH7A.43
!!!--------------------------------------------------------------------- SFEXCH7A.44
SFEXCH7A.45
! Arguments :- SFEXCH7A.46
SFEXCH7A.47
SUBROUTINE SF_EXCH ( 4,99SFEXCH7A.48
& P_POINTS,P_FIELD,P1,LAND1,LAND_PTS,LAND_FIELD,NTYPE,LAND_INDEX, SFEXCH7A.49
& TILE_INDEX,TILE_PTS, SFEXCH7A.50
& BQ_1,BT_1,CANOPY,CATCH,DZSOIL,GC,HCONS,HO2R2_OROG, SFEXCH7A.51
& ICE_FRACT,LYING_SNOW,PSTAR,P_1,QW_1,RADNET,RADNET_SNOW,SIL_OROG, SFEXCH7A.52
& SMVCST,TILE_FRAC,TIMESTEP,TL_1,TI,TS1,TSNOW,TSTAR_TILE,TSTAR, SFEXCH7A.53
& VSHR,Z0_TILE,Z0_SF_GB,Z1_UV,Z1_TQ,LAND_MASK, SFEXCH7A.54
& SU10,SV10,SQ1P5,ST1P5,SFME,LTIMER,L_Z0_OROG,Z0MSEA, SFEXCH7A.55
& ALPHA1,ALPHA1_SICE,ASHTF,ASHTF_SNOW,CD,CH,CDR10M, SFEXCH7A.56
& CHR1P5M,CHR1P5M_SICE,E_SEA,FME,FQW_1,FQW_TILE,FQW_ICE, SFEXCH7A.57
& FTL_1,FTL_TILE,FTL_ICE,FRACA,H_BLEND_OROG,H_SEA, SFEXCH7A.58
& Q1_SD,RESFS,RESFT,RIB,RIB_TILE,T1_SD,Z0M_EFF, SFEXCH7A.59
& Z0H,Z0H_TILE,Z0M,Z0M_TILE,RHO_ARESIST,ARESIST,RESIST_B, SFEXCH7A.60
& RHO_ARESIST_TILE,ARESIST_TILE,RESIST_B_TILE, SFEXCH7A.61
& RHO_CD_MODV1,RHOKH_1,RHOKH_1_SICE,RHOKM_1,RHOKPM,RHOKPM_SICE, SFEXCH7A.62
& NRML SFEXCH7A.63
& ) SFEXCH7A.64
SFEXCH7A.65
IMPLICIT NONE SFEXCH7A.66
SFEXCH7A.67
INTEGER SFEXCH7A.68
& P_POINTS ! IN Number of P-grid points to be SFEXCH7A.69
! ! processed. SFEXCH7A.70
&,P_FIELD ! IN Total number of P-grid points. SFEXCH7A.71
&,P1 ! IN First P-point to be processed. SFEXCH7A.72
&,LAND1 ! IN First land point to be processed. SFEXCH7A.73
&,LAND_PTS ! IN Number of land points to be processed. SFEXCH7A.74
&,LAND_FIELD ! IN Total number of land points. SFEXCH7A.75
&,NTYPE ! IN Number of tiles per land point. SFEXCH7A.76
&,LAND_INDEX(P_FIELD) ! IN Index of land points. SFEXCH7A.77
&,TILE_INDEX(LAND_FIELD,NTYPE) SFEXCH7A.78
! ! IN Index of tile points. SFEXCH7A.79
&,TILE_PTS(NTYPE) ! IN Number of tile points. SFEXCH7A.80
SFEXCH7A.81
REAL SFEXCH7A.82
& BQ_1(P_FIELD) ! IN A buoyancy parameter for lowest atm SFEXCH7A.83
! ! level ("beta-q twiddle"). SFEXCH7A.84
&,BT_1(P_FIELD) ! IN A buoyancy parameter for lowest atm SFEXCH7A.85
! ! level ("beta-T twiddle"). SFEXCH7A.86
&,CANOPY(LAND_FIELD,NTYPE-1) SFEXCH7A.87
! ! IN Surface water for land tiles SFEXCH7A.88
! ! (kg/m2). SFEXCH7A.89
&,CATCH(LAND_FIELD,NTYPE-1) SFEXCH7A.90
! ! IN Surface capacity (max. surface water) SFEXCH7A.91
! ! of snow-free land tiles (kg/m2). SFEXCH7A.92
&,DZSOIL ! IN Soil or land-ice surface layer SFEXCH7A.93
! ! thickness (m). SFEXCH7A.94
&,GC(LAND_FIELD,NTYPE) ! IN "Stomatal" conductance to evaporation SFEXCH7A.95
! ! for land tiles (m/s). SFEXCH7A.96
&,HCONS(LAND_FIELD) ! IN Soil thermal conductivity including SFEXCH7A.97
! ! effects of water and ice (W/m/K). SFEXCH7A.98
&,HO2R2_OROG(LAND_FIELD)! IN Peak to trough height of unresolved SFEXCH7A.99
! ! orography divided by 2SQRT(2) (m). SFEXCH7A.100
&,ICE_FRACT(P_FIELD) ! IN Fraction of gridbox which is sea-ice. SFEXCH7A.101
&,LYING_SNOW(P_FIELD) ! IN Lying snow amount (kg per sq metre). SFEXCH7A.102
&,PSTAR(P_FIELD) ! IN Surface pressure (Pascals). SFEXCH7A.103
&,P_1(P_FIELD) ! IN Level 1 atmospheric pressure. SFEXCH7A.104
&,QW_1(P_FIELD) ! IN Total water content of lowest SFEXCH7A.105
! ! atmospheric layer (kg per kg air). SFEXCH7A.106
&,RADNET(P_FIELD) ! IN Net surface radiation over snow-free SFEXCH7A.107
! ! land or sea-ice (W/m2) SFEXCH7A.108
&,RADNET_SNOW(P_FIELD) ! IN Net surface radiation over snow or SFEXCH7A.109
! ! land-ice (W/m2) SFEXCH7A.110
&,SIL_OROG(LAND_FIELD) ! IN Silhouette area of unresolved SFEXCH7A.111
! ! orography per unit horizontal area SFEXCH7A.112
&,SMVCST(LAND_FIELD) ! IN Volumetric saturation point SFEXCH7A.113
! ! - zero at land-ice points. SFEXCH7A.114
&,TILE_FRAC(LAND_FIELD,NTYPE) SFEXCH7A.115
! ! IN Tile fractions. SFEXCH7A.116
&,TIMESTEP ! IN Timestep in seconds for EPDT calc. SFEXCH7A.117
&,TL_1(P_FIELD) ! IN Liquid/frozen water temperature for SFEXCH7A.118
! ! lowest atmospheric layer (K). SFEXCH7A.119
&,TI(P_FIELD) ! IN Temperature of sea-ice surface layer SFEXCH7A.120
! ! (K) SFEXCH7A.121
&,TS1(LAND_FIELD) ! IN Temperature of top soil or land-ice SFEXCH7A.122
! ! layer (K) SFEXCH7A.123
&,TSNOW(LAND_FIELD) ! IN Temperature of surface snow layer (K) SFEXCH7A.124
! ! = TS1 at land-ice points. SFEXCH7A.125
&,TSTAR_TILE(LAND_FIELD,NTYPE) SFEXCH7A.126
! ! IN Tile surface temperatures (K). SFEXCH7A.127
&,TSTAR(P_FIELD) ! IN Gridbox mean surface temperature (K). SFEXCH7A.128
&,VSHR(P_FIELD) ! IN Magnitude of surface-to-lowest-level SFEXCH7A.129
! ! wind shear SFEXCH7A.130
&,Z0_TILE(LAND_FIELD,NTYPE) SFEXCH7A.131
! ! IN Tile roughness lengths (m). SFEXCH7A.132
&,Z0_SF_GB(P_FIELD) ! IN Snow-free GBM roughness length (m). SFEXCH7A.133
&,Z1_UV(P_FIELD) ! IN Height of lowest uv level (m). SFEXCH7A.134
&,Z1_TQ(P_FIELD) ! IN Height of lowest tq level (m). SFEXCH7A.135
! ! Note, if the grid used is staggered in SFEXCH7A.136
! ! the vertical, Z1_UV and Z1_TQ can be SFEXCH7A.137
! ! different. SFEXCH7A.138
SFEXCH7A.139
LOGICAL SFEXCH7A.140
& LAND_MASK(P_FIELD) ! IN .TRUE. for land; .FALSE. elsewhere. SFEXCH7A.141
&,SU10 ! IN STASH flag for 10-metre W wind. SFEXCH7A.142
&,SV10 ! IN STASH flag for 10-metre S wind. SFEXCH7A.143
&,SQ1P5 ! IN STASH flag for 1.5-metre sp humidity. SFEXCH7A.144
&,ST1P5 ! IN STASH flag for 1.5-metre temperature. SFEXCH7A.145
&,SFME ! IN STASH flag for wind mixing energy flux SFEXCH7A.146
&,LTIMER ! IN Logical for TIMER. SFEXCH7A.147
&,L_Z0_OROG ! IN .TRUE. to use orographic roughness. SFEXCH7A.148
SFEXCH7A.149
! Modified (INOUT) variables. SFEXCH7A.150
SFEXCH7A.151
REAL SFEXCH7A.152
& Z0MSEA(P_FIELD) ! INOUT Sea-surface roughness length for SFEXCH7A.153
! ! momentum (m). F617. SFEXCH7A.154
SFEXCH7A.155
! Output variables. SFEXCH7A.156
! SFEXCH7A.157
REAL SFEXCH7A.158
& ALPHA1(LAND_FIELD,NTYPE) SFEXCH7A.159
! ! OUT Gradients of saturated specific SFEXCH7A.160
! ! humidity with respect to temperature SFEXCH7A.161
! ! between the bottom model layer and SFEXCH7A.162
! ! tile surface SFEXCH7A.163
&,ALPHA1_SICE(P_FIELD) ! OUT ALPHA1 for sea-ice. SFEXCH7A.164
&,ASHTF(P_FIELD) ! OUT Coefficient to calculate surface heat SFEXCH7A.165
! ! flux into soil or sea-ice (W/m2/K) SFEXCH7A.166
&,ASHTF_SNOW(P_FIELD) ! OUT Coefficient to calculate surface heat SFEXCH7A.167
! ! flux into snow (W/m2/K) SFEXCH7A.168
&,CD(P_FIELD) ! OUT Bulk transfer coefficient for SFEXCH7A.169
! ! momentum. SFEXCH7A.170
&,CH(P_FIELD) ! OUT Bulk transfer coefficient for heat SFEXCH7A.171
! ! and/or moisture. SFEXCH7A.172
&,CDR10M(P_FIELD) ! OUT Reqd for calculation of 10m wind SFEXCH7A.173
! ! (u & v). SFEXCH7A.174
! ! NBB: This is output on the UV-grid, SFEXCH7A.175
! ! but with the first and last rows set SFEXCH7A.176
! ! to a "missing data indicator". SFEXCH7A.177
! ! Sea-ice leads ignored. SFEXCH7A.178
&,CHR1P5M(LAND_FIELD,NTYPE) SFEXCH7A.179
! ! OUT Reqd for calculation of 1.5m temp for SFEXCH7A.180
! ! land tiles. SFEXCH7A.181
&,CHR1P5M_SICE(P_FIELD) ! OUT CHR1P5M for sea and sea-ice SFEXCH7A.182
! ! (leads ignored). SFEXCH7A.183
&,E_SEA(P_FIELD) ! OUT Evaporation from sea times leads SFEXCH7A.184
! ! fraction (kg/m2/s). Zero over land. SFEXCH7A.185
&,FME(P_FIELD) ! OUT Wind mixing energy flux (Watts/sq m). SFEXCH7A.186
&,FQW_1(P_FIELD) ! OUT "Explicit" surface flux of QW (i.e. SFEXCH7A.187
! ! evaporation), on P-grid (kg/m2/s). SFEXCH7A.188
! ! for whole grid-box SFEXCH7A.189
&,FQW_TILE(LAND_FIELD,NTYPE) SFEXCH7A.190
! ! OUT Local FQW_1 for land tiles. SFEXCH7A.191
&,FQW_ICE(P_FIELD) ! OUT GBM FQW_1 for sea-ice. SFEXCH7A.192
&,FTL_1(P_FIELD) ! OUT "Explicit" surface flux of TL = H/CP. SFEXCH7A.193
! ! (sensible heat / CP). grid-box mean SFEXCH7A.194
&,FTL_TILE(LAND_FIELD,NTYPE) SFEXCH7A.195
! ! OUT Local FTL_1 for land tiles. SFEXCH7A.196
&,FTL_ICE(P_FIELD) ! OUT GBM FTL_1 for sea-ice. SFEXCH7A.197
&,FRACA(LAND_FIELD,NTYPE-1) SFEXCH7A.198
! ! OUT Fraction of surface moisture flux SFEXCH7A.199
! ! with only aerodynamic resistance SFEXCH7A.200
! ! for snow-free land tiles. SFEXCH7A.201
&,H_BLEND_OROG(P_FIELD) ! OUT Blending height for orographic SFEXCH7A.202
! ! roughness SFEXCH7A.203
&,H_SEA(P_FIELD) ! OUT Surface sensible heat flux over sea SFEXCH7A.204
! ! times leads fraction (W/m2). SFEXCH7A.205
! ! Zero over land. SFEXCH7A.206
&,Q1_SD(P_FIELD) ! OUT Standard deviation of turbulent SFEXCH7A.207
! ! fluctuations of surface layer SFEXCH7A.208
! ! specific humidity (kg/kg). SFEXCH7A.209
&,RESFS(LAND_FIELD,NTYPE-1) SFEXCH7A.210
! ! OUT Combined soil, stomatal and SFEXCH7A.211
! ! aerodynamic resistance factor for SFEXCH7A.212
! ! fraction 1-FRACA of snow-free tiles SFEXCH7A.213
&,RESFT(LAND_FIELD,NTYPE) SFEXCH7A.214
! ! OUT Total resistance factor SFEXCH7A.215
! ! FRACA+(1-FRACA)*RESFS for snow-free SFEXCH7A.216
! ! tiles, 1 for snow. SFEXCH7A.217
&,RIB(P_FIELD) ! OUT Mean bulk Richardson number for SFEXCH7A.218
! ! lowest layer SFEXCH7A.219
&,RIB_TILE(LAND_FIELD,NTYPE) SFEXCH7A.220
! ! OUT RIB for land tiles. SFEXCH7A.221
&,T1_SD(P_FIELD) ! OUT Standard deviation of turbulent SFEXCH7A.222
! ! fluctuations of surface layer SFEXCH7A.223
! ! temperature (K). SFEXCH7A.224
&,Z0M_EFF(P_FIELD) ! OUT Effective roughness length for SFEXCH7A.225
! ! momentum SFEXCH7A.226
&,Z0H(P_FIELD) ! OUT Roughness length for heat SFEXCH7A.227
! ! and moisture SFEXCH7A.228
&,Z0H_TILE(LAND_FIELD,NTYPE) SFEXCH7A.229
! ! OUT Tile roughness lengths for heat SFEXCH7A.230
! ! and moisture SFEXCH7A.231
&,Z0M(P_FIELD) ! OUT Roughness length for momentum SFEXCH7A.232
&,Z0M_TILE(LAND_FIELD,NTYPE) SFEXCH7A.233
! ! OUT Tile roughness lengths for momentum SFEXCH7A.234
&,RHO_ARESIST(P_FIELD) ! OUT RHOSTAR*CD_STD*VSHR for SCYCLE SFEXCH7A.235
&,ARESIST(P_FIELD) ! OUT 1/(CD_STD*VSHR) for SCYCLE SFEXCH7A.236
&,RESIST_B(P_FIELD) ! OUT (1/CH-1/CD_STD)/VSHR for SCYCLE SFEXCH7A.237
&,RHO_ARESIST_TILE(LAND_FIELD,NTYPE) SFEXCH7A.238
! ! OUT RHOSTAR*CD_STD*VSHR on land tiles SFEXCH7A.239
&,ARESIST_TILE(LAND_FIELD,NTYPE) SFEXCH7A.240
! ! OUT 1/(CD_STD*VSHR) on land tiles SFEXCH7A.241
&,RESIST_B_TILE(LAND_FIELD,NTYPE) SFEXCH7A.242
! ! OUT (1/CH-1/CD_STD)/VSHR on land tiles SFEXCH7A.243
SFEXCH7A.244
! Surface exchange coefficients;passed to subroutine IMPL_CAL SFEXCH7A.245
REAL SFEXCH7A.246
& RHO_CD_MODV1(P_FIELD) ! OUT rhostar*cD*vshr before horizontal SFEXCH7A.247
! ! interpolation output as a diagnostic. SFEXCH7A.248
&,RHOKH_1(LAND_FIELD,NTYPE) SFEXCH7A.249
! ! OUT Surface exchange coefficient for land SFEXCH7A.250
! ! tiles. SFEXCH7A.251
&,RHOKH_1_SICE(P_FIELD) ! OUT Surface exchange coefficient for sea SFEXCH7A.252
! ! or sea-ice. SFEXCH7A.253
&,RHOKM_1(P_FIELD) ! OUT For momentum. NB: This is output on SFEXCH7A.254
! ! UV-grid, but with the first and last SFEXCH7A.255
! ! rows set to "missing data indicator". SFEXCH7A.256
&,RHOKPM(LAND_FIELD,NTYPE) SFEXCH7A.257
! ! OUT Mixing coefficient for land tiles. SFEXCH7A.258
&,RHOKPM_SICE(P_FIELD) ! OUT Mixing coefficient for sea-ice. SFEXCH7A.259
SFEXCH7A.260
INTEGER SFEXCH7A.261
& NRML(P_FIELD) ! OUT 1 if surface layer unstable, else 0. SFEXCH7A.262
SFEXCH7A.263
! Symbolic constants ------------------------------------------------ SFEXCH7A.264
SFEXCH7A.265
! (1) UM-wide common parameters. SFEXCH7A.266
SFEXCH7A.267
*CALL C_0_DG_C 
SFEXCH7A.268
*CALL C_G SFEXCH7A.269
*CALL C_LHEAT SFEXCH7A.270
*CALL C_R_CP SFEXCH7A.271
SFEXCH7A.272
! Derived local parameters. SFEXCH7A.273
REAL LS SFEXCH7A.274
PARAMETER ( SFEXCH7A.275
& LS=LF+LC ! Latent heat of sublimation. SFEXCH7A.276
& ) SFEXCH7A.277
SFEXCH7A.278
! (2) Boundary Layer local parameters. SFEXCH7A.279
SFEXCH7A.280
*CALL BLEND_H SFEXCH7A.281
*CALL C_CHARNK SFEXCH7A.282
*CALL C_DENSTY SFEXCH7A.283
*CALL C_KAPPAI SFEXCH7A.284
*CALL C_ROUGH SFEXCH7A.285
*CALL C_VKMAN SFEXCH7A.286
*CALL C_SOILH SFEXCH7A.287
*CALL C_Z0H_Z0M ABX1F405.897
SFEXCH7A.288
REAL H_BLEND_MIN SFEXCH7A.289
PARAMETER ( SFEXCH7A.290
& H_BLEND_MIN=0.0 ! Minimum blending height. SFEXCH7A.291
&) SFEXCH7A.292
SFEXCH7A.293
! External subprograms called. SFEXCH7A.294
SFEXCH7A.295
EXTERNAL SF_OROG,SF_OROG_GB,QSAT,SFL_INT,SF_RESIST,TIMER, SFEXCH7A.296
& STDEV1_SEA,STDEV1_LAND,SF_RIB_SEA,SF_RIB_LAND, SFEXCH7A.297
& FCDCH_SEA,FCDCH_LAND,SF_FLUX_SEA,SF_FLUX_LAND SFEXCH7A.298
SFEXCH7A.299
! Define local storage. SFEXCH7A.300
SFEXCH7A.301
! (a) Workspace. SFEXCH7A.302
SFEXCH7A.303
REAL SFEXCH7A.304
& QS1(P_FIELD) ! Sat. specific humidity SFEXCH7A.305
! ! qsat(TL_1,PSTAR) SFEXCH7A.306
&,RHOSTAR(P_FIELD) ! Surface air density SFEXCH7A.307
SFEXCH7A.308
! Workspace for sea and sea-ice leads SFEXCH7A.309
REAL SFEXCH7A.310
& CD_SEA(P_FIELD) ! Drag coefficient SFEXCH7A.311
&,CH_SEA(P_FIELD) ! Transfer coefficient for heat and SFEXCH7A.312
! ! moisture SFEXCH7A.313
&,QSTAR_SEA(P_FIELD) ! Surface saturated sp humidity SFEXCH7A.314
&,RIB_SEA(P_FIELD) ! Bulk Richardson number SFEXCH7A.315
&,TSTAR_SEA(P_FIELD) ! Surface temperature SFEXCH7A.316
&,Z0F_SEA(P_FIELD) ! Roughness length for free-convec. SFEXCH7A.317
! ! heat and moisture transport SFEXCH7A.318
&,Z0H_SEA(P_FIELD) ! Roughness length for heat and SFEXCH7A.319
! ! moisture transport SFEXCH7A.320
SFEXCH7A.321
! Workspace for sea-ice and marginal ice zone SFEXCH7A.322
REAL SFEXCH7A.323
& CD_ICE(P_FIELD) ! Drag coefficient SFEXCH7A.324
&,CD_MIZ(P_FIELD) ! Drag coefficient SFEXCH7A.325
&,CH_ICE(P_FIELD) ! Transfer coefficient for heat and SFEXCH7A.326
! ! moisture SFEXCH7A.327
&,CH_MIZ(P_FIELD) ! Transfer coefficient for heat and SFEXCH7A.328
! ! moisture SFEXCH7A.329
&,QSTAR_ICE(P_FIELD) ! Surface saturated sp humidity SFEXCH7A.330
&,RIB_ICE(P_FIELD) ! Bulk Richardson number SFEXCH7A.331
&,RIB_MIZ(P_FIELD) ! Bulk Richardson number SFEXCH7A.332
&,TSTAR_ICE(P_FIELD) ! Surface temperature SFEXCH7A.333
&,Z0_ICE(P_FIELD) ! Roughness length. SFEXCH7A.334
&,Z0_MIZ(P_FIELD) ! Roughness length. SFEXCH7A.335
INTEGER SFEXCH7A.336
& SICE_INDEX(P_FIELD) ! Index of sea-ice points SFEXCH7A.337
&,NSICE ! Number of sea-ice points. SFEXCH7A.338
SFEXCH7A.339
! Workspace for land tiles SFEXCH7A.340
REAL SFEXCH7A.341
& CD_STD(LAND_FIELD,NTYPE) ! Local drag coefficient for calc SFEXCH7A.342
! ! of interpolation coefficient SFEXCH7A.343
&,CD_TILE(LAND_FIELD,NTYPE) ! Drag coefficient SFEXCH7A.344
&,CH_TILE(LAND_FIELD,NTYPE) ! Transfer coefficient for heat and SFEXCH7A.345
! ! moisture SFEXCH7A.346
&,CHN(LAND_FIELD) ! Neutral value of CH. SFEXCH7A.347
&,DQ(LAND_FIELD) ! Sp humidity difference between SFEXCH7A.348
! ! surface and lowest atmospheric lev SFEXCH7A.349
&,EPDT(LAND_FIELD) ! "Potential" Evaporation * Timestep SFEXCH7A.350
&,PSTAR_LAND(LAND_FIELD) ! Surface pressure for land points. SFEXCH7A.351
&,QSTAR_TILE(LAND_FIELD,NTYPE)! Surface saturated sp humidity. SFEXCH7A.352
&,RHOKM_1_TILE(LAND_FIELD,NTYPE) SFEXCH7A.353
! ! Momentum exchange coefficient. SFEXCH7A.354
&,WIND_PROFILE_FACTOR(LAND_FIELD,NTYPE) SFEXCH7A.355
! ! For transforming effective surface SFEXCH7A.356
! ! transfer coefficients to those SFEXCH7A.357
! ! excluding form drag. SFEXCH7A.358
&,Z0_GB(LAND_FIELD) ! GBM roughness length including snow SFEXCH7A.359
&,Z0M_EFF_TILE(LAND_FIELD,NTYPE) SFEXCH7A.360
! ! Effective momentum roughness length SFEXCH7A.361
&,Z0F_TILE(LAND_FIELD,NTYPE) !Roughness length for free convective SFEXCH7A.362
! ! heat and moisture transport SFEXCH7A.363
SFEXCH7A.364
! (b) Scalars. SFEXCH7A.365
SFEXCH7A.366
INTEGER SFEXCH7A.367
& I ! Loop counter (horizontal field index). SFEXCH7A.368
&,J ! Loop counter (tile field index). SFEXCH7A.369
&,L ! Loop counter (land point field index). SFEXCH7A.370
&,N ! Loop counter (tile index). SFEXCH7A.371
REAL SFEXCH7A.372
& TAU ! Magnitude of surface wind stress over sea. SFEXCH7A.373
&,ZETAM ! Temporary in calculation of CHN. SFEXCH7A.374
&,ZETAH ! Temporary in calculation of CHN. SFEXCH7A.375
&,ZETA1 ! Work space SFEXCH7A.376
&,Z0 ! yet more workspace SFEXCH7A.377
SFEXCH7A.378
IF (LTIMER) THEN SFEXCH7A.379
CALL TIMER('SFEXCH ',3) SFEXCH7A.380
ENDIF SFEXCH7A.381
SFEXCH7A.382
!----------------------------------------------------------------------- ABX1F405.898
!! 0. Initialise FTL_TILE and RIB_TILE on all tiles at all points, ABX1F405.899
!! to allow STASH to process these as diagnostics. ABX1F405.900
!----------------------------------------------------------------------- ABX1F405.901
DO N=1,NTYPE ABX1F405.902
DO L=1,LAND_FIELD ABX1F405.903
FTL_TILE(L,N) = 0.0 ABX1F405.904
RIB_TILE(L,N) = 0.0 ABX1F405.905
ENDDO ABX1F405.906
ENDDO ABX1F405.907
ABX1F405.908
!----------------------------------------------------------------------- SFEXCH7A.383
!! 1. Index array for sea-ice SFEXCH7A.384
!----------------------------------------------------------------------- SFEXCH7A.385
SFEXCH7A.386
NSICE = 0 SFEXCH7A.387
DO I=P1,P1+P_POINTS-1 SFEXCH7A.388
IF ( ICE_FRACT(I).GT.0.0 .AND. .NOT.LAND_MASK(I) ) THEN SFEXCH7A.389
NSICE = NSICE + 1 SFEXCH7A.390
SICE_INDEX(NSICE) = I SFEXCH7A.391
ENDIF SFEXCH7A.392
ENDDO SFEXCH7A.393
SFEXCH7A.394
!----------------------------------------------------------------------- SFEXCH7A.395
!! 2. Calculate QSAT values required later. SFEXCH7A.396
!----------------------------------------------------------------------- SFEXCH7A.397
SFEXCH7A.398
DO I=P1,P1+P_POINTS-1 SFEXCH7A.399
TSTAR_SEA(I) = TSTAR(I) SFEXCH7A.400
TSTAR_ICE(I) = TSTAR(I) SFEXCH7A.401
RHOSTAR(I) = PSTAR(I) / ( R*TSTAR(I) ) SFEXCH7A.402
! ... surface air density from ideal gas equation SFEXCH7A.403
IF ( ICE_FRACT(I).GT.0.0 .AND. .NOT.LAND_MASK(I) ) THEN SFEXCH7A.404
TSTAR_ICE(I) = ( TSTAR(I) - (1.0-ICE_FRACT(I))*TFS ) SFEXCH7A.405
& / ICE_FRACT(I) ! P2430.1 SFEXCH7A.406
TSTAR_SEA(I) = TFS SFEXCH7A.407
ENDIF SFEXCH7A.408
ENDDO SFEXCH7A.409
CALL QSAT(QS1(P1),TL_1(P1),PSTAR(P1),P_POINTS) SFEXCH7A.410
CALL QSAT(QSTAR_SEA(P1),TSTAR_SEA(P1),PSTAR(P1),P_POINTS) SFEXCH7A.411
CALL QSAT(QSTAR_ICE(P1),TSTAR_ICE(P1),PSTAR(P1),P_POINTS) SFEXCH7A.412
DO L=LAND1,LAND1+LAND_PTS-1 SFEXCH7A.413
I = LAND_INDEX(L) SFEXCH7A.414
PSTAR_LAND(L) = PSTAR(I) SFEXCH7A.415
ENDDO SFEXCH7A.416
DO N=1,NTYPE SFEXCH7A.417
CALL QSAT(QSTAR_TILE(LAND1,N),TSTAR_TILE(LAND1,N), SFEXCH7A.418
& PSTAR_LAND(LAND1),LAND_PTS) SFEXCH7A.419
ENDDO SFEXCH7A.420
SFEXCH7A.421
!----------------------------------------------------------------------- SFEXCH7A.422
!! 3. Calculation of transfer coefficients and surface layer stability SFEXCH7A.423
!----------------------------------------------------------------------- SFEXCH7A.424
SFEXCH7A.425
!----------------------------------------------------------------------- SFEXCH7A.426
!! 3.1 Calculate neutral roughness lengths SFEXCH7A.427
!----------------------------------------------------------------------- SFEXCH7A.428
SFEXCH7A.429
! Sea, sea-ice leads, sea-ice and marginal ice zone SFEXCH7A.430
DO I=P1,P1+P_POINTS-1 SFEXCH7A.431
Z0H_SEA(I) = Z0HSEA SFEXCH7A.432
Z0F_SEA(I) = Z0FSEA SFEXCH7A.433
Z0_MIZ(I) = Z0MIZ SFEXCH7A.434
Z0_ICE(I) = Z0SICE SFEXCH7A.435
RIB_SEA(I) = 0. SFEXCH7A.436
RIB_ICE(I) = 0. SFEXCH7A.437
ENDDO SFEXCH7A.438
SFEXCH7A.439
! Land tiles SFEXCH7A.440
! Z0_TILE contains the appropriate value for land-ice points, but has to SFEXCH7A.441
! be modified for snow-cover on non-land-ice points SFEXCH7A.442
DO N=1,NTYPE SFEXCH7A.443
DO J=1,TILE_PTS(N) SFEXCH7A.444
L = TILE_INDEX(J,N) SFEXCH7A.445
Z0M_TILE(L,N) = Z0_TILE(L,N) SFEXCH7A.446
IF ( N.EQ.NTYPE .AND. SMVCST(L).NE.0. ) THEN SFEXCH7A.447
I = LAND_INDEX(L) SFEXCH7A.448
Z0 = Z0_SF_GB(I) - 4.0E-4*LYING_SNOW(I)/TILE_FRAC(L,N) SFEXCH7A.449
ZETA1 = MIN( 5.0E-4 , Z0_SF_GB(I) ) SFEXCH7A.450
Z0M_TILE(L,N) = MAX( ZETA1 , Z0 ) SFEXCH7A.451
ENDIF SFEXCH7A.452
Z0H_TILE(L,N) = Z0H_Z0M(N)*Z0M_TILE(L,N) ABX1F405.909
Z0F_TILE(L,N) = Z0H_Z0M(N)*Z0M_TILE(L,N) ABX1F405.910
RIB_TILE(L,N) = 0. SFEXCH7A.455
ENDDO SFEXCH7A.456
ENDDO SFEXCH7A.457
SFEXCH7A.458
DO N=1,NTYPE SFEXCH7A.459
CALL SF_OROG ( SFEXCH7A.460
& P_FIELD,LAND_FIELD,TILE_PTS(N),LAND_INDEX,TILE_INDEX(1,N), SFEXCH7A.461
& L_Z0_OROG,LTIMER, SFEXCH7A.462
& HO2R2_OROG,RIB_TILE(1,N),SIL_OROG,Z0M_TILE(1,N),Z1_UV, SFEXCH7A.463
& WIND_PROFILE_FACTOR(1,N),Z0M_EFF_TILE(1,N) SFEXCH7A.464
& ) SFEXCH7A.465
ENDDO SFEXCH7A.466
SFEXCH7A.467
!----------------------------------------------------------------------- SFEXCH7A.468
! Calculate RESFT with neutral CH and EPDT=0 for use in calculation SFEXCH7A.469
! of Richardson number. RESFT=1 for snow. SFEXCH7A.470
!----------------------------------------------------------------------- SFEXCH7A.471
SFEXCH7A.472
! Snow-free land tiles SFEXCH7A.473
DO N=1,NTYPE-1 SFEXCH7A.474
DO J=1,TILE_PTS(N) SFEXCH7A.475
L = TILE_INDEX(J,N) SFEXCH7A.476
I = LAND_INDEX(L) SFEXCH7A.477
ZETAM = LOG ( (Z1_UV(I) + Z0M_TILE(L,N))/Z0M_TILE(L,N) ) SFEXCH7A.478
ZETAH = LOG ( (Z1_TQ(I) + Z0M_TILE(L,N))/Z0H_TILE(L,N) ) SFEXCH7A.479
CHN(L) = (VKMAN/ZETAH)*(VKMAN/ZETAM)*WIND_PROFILE_FACTOR(L,N) SFEXCH7A.480
DQ(L) = QW_1(I) - QSTAR_TILE(L,N) SFEXCH7A.481
EPDT(L) = 0.0 SFEXCH7A.482
ENDDO SFEXCH7A.483
CALL SF_RESIST ( SFEXCH7A.484
& P_FIELD,LAND_FIELD,TILE_PTS(N),LAND_INDEX,TILE_INDEX(1,N), SFEXCH7A.485
& CANOPY(1,N),CATCH(1,N),CHN,DQ,EPDT,GC(1,N),VSHR, SFEXCH7A.486
& FRACA(1,N),RESFS(1,N),RESFT(1,N),LTIMER SFEXCH7A.487
& ) SFEXCH7A.488
ENDDO SFEXCH7A.489
SFEXCH7A.490
! Snow and land-ice tile SFEXCH7A.491
DO J=1,TILE_PTS(NTYPE) SFEXCH7A.492
L = TILE_INDEX(J,NTYPE) SFEXCH7A.493
RESFT(L,NTYPE) = 1. SFEXCH7A.494
ENDDO SFEXCH7A.495
SFEXCH7A.496
!----------------------------------------------------------------------- SFEXCH7A.497
!! 3.2 Calculate bulk Richardson number for the lowest model level. SFEXCH7A.498
!----------------------------------------------------------------------- SFEXCH7A.499
SFEXCH7A.500
! Sea, sea-ice and sea-ice leads SFEXCH7A.501
CALL SF_RIB_SEA ( SFEXCH7A.502
& P_POINTS,P_FIELD,P1,LAND_MASK,NSICE,SICE_INDEX, SFEXCH7A.503
& BQ_1,BT_1,ICE_FRACT,QSTAR_ICE,QSTAR_SEA,QW_1,TL_1,TSTAR_ICE, SFEXCH7A.504
& TSTAR_SEA,VSHR,Z0_ICE,Z0H_SEA,Z0_ICE,Z0MSEA,Z1_TQ,Z1_UV, SFEXCH7A.505
& RIB_SEA,RIB_ICE,LTIMER SFEXCH7A.506
& ) SFEXCH7A.507
SFEXCH7A.508
! Land tiles SFEXCH7A.509
DO N=1,NTYPE SFEXCH7A.510
CALL SF_RIB_LAND ( SFEXCH7A.511
& P_FIELD,LAND_FIELD,TILE_PTS(N),LAND_INDEX,TILE_INDEX(1,N), SFEXCH7A.512
& BQ_1,BT_1,QSTAR_TILE(1,N),QW_1,RESFT(1,N),TL_1, SFEXCH7A.513
& TSTAR_TILE(1,N),VSHR,Z0H_TILE(1,N),Z0M_TILE(1,N),Z1_TQ,Z1_UV, SFEXCH7A.514
& RIB_TILE(1,N),LTIMER SFEXCH7A.515
& ) SFEXCH7A.516
ENDDO SFEXCH7A.517
SFEXCH7A.518
!----------------------------------------------------------------------- SFEXCH7A.519
!! 3.3 Calculate stability corrected effective roughness length. SFEXCH7A.520
!! Stability correction only applies to land points. SFEXCH7A.521
!----------------------------------------------------------------------- SFEXCH7A.522
SFEXCH7A.523
DO N=1,NTYPE SFEXCH7A.524
CALL SF_OROG ( SFEXCH7A.525
& P_FIELD,LAND_FIELD,TILE_PTS(N),LAND_INDEX,TILE_INDEX(1,N), SFEXCH7A.526
& L_Z0_OROG,LTIMER, SFEXCH7A.527
& HO2R2_OROG,RIB_TILE(1,N),SIL_OROG,Z0M_TILE(1,N),Z1_UV, SFEXCH7A.528
& WIND_PROFILE_FACTOR(1,N),Z0M_EFF_TILE(1,N) SFEXCH7A.529
& ) SFEXCH7A.530
ENDDO SFEXCH7A.531
SFEXCH7A.532
!----------------------------------------------------------------------- SFEXCH7A.533
!! 3.4 Calculate CD, CH via routine FCDCH. SFEXCH7A.534
!----------------------------------------------------------------------- SFEXCH7A.535
SFEXCH7A.536
! Sea-ice SFEXCH7A.537
CALL FCDCH_SEA(P_POINTS,P_FIELD,P1,LAND_MASK, SFEXCH7A.538
& RIB_ICE,Z0_ICE,Z0_ICE,Z0_ICE,Z1_UV,Z1_TQ, SFEXCH7A.539
& CD_ICE,CH_ICE,LTIMER) SFEXCH7A.540
SFEXCH7A.541
! Marginal Ice Zone SFEXCH7A.542
CALL FCDCH_SEA(P_POINTS,P_FIELD,P1,LAND_MASK, SFEXCH7A.543
& RIB_ICE,Z0_MIZ,Z0_MIZ,Z0_MIZ,Z1_UV,Z1_TQ, SFEXCH7A.544
& CD_MIZ,CH_MIZ,LTIMER) SFEXCH7A.545
SFEXCH7A.546
! Sea and sea-ice leads SFEXCH7A.547
CALL FCDCH_SEA(P_POINTS,P_FIELD,P1,LAND_MASK, SFEXCH7A.548
& RIB_SEA,Z0MSEA,Z0H_SEA,Z0F_SEA,Z1_UV,Z1_TQ, SFEXCH7A.549
& CD_SEA,CH_SEA,LTIMER) SFEXCH7A.550
SFEXCH7A.551
! Land tiles SFEXCH7A.552
DO N=1,NTYPE SFEXCH7A.553
CALL FCDCH_LAND ( SFEXCH7A.554
& P_FIELD,LAND_FIELD,TILE_PTS(N),TILE_INDEX(1,N),LAND_INDEX, SFEXCH7A.555
& RIB_TILE(1,N),WIND_PROFILE_FACTOR(1,N), SFEXCH7A.556
& Z0M_EFF_TILE(1,N),Z0H_TILE(1,N),Z0F_TILE(1,N),Z1_UV,Z1_TQ, SFEXCH7A.557
& CD_TILE(1,N),CH_TILE(1,N),CD_STD(1,N),LTIMER SFEXCH7A.558
& ) SFEXCH7A.559
ENDDO SFEXCH7A.560
SFEXCH7A.561
!----------------------------------------------------------------------- SFEXCH7A.562
!! 4.1 Recalculate RESFT using "true" CH and EPDT for snow-free land SFEXCH7A.563
!! tiles SFEXCH7A.564
!----------------------------------------------------------------------- SFEXCH7A.565
SFEXCH7A.566
DO N=1,NTYPE-1 SFEXCH7A.567
DO J=1,TILE_PTS(N) SFEXCH7A.568
L = TILE_INDEX(J,N) SFEXCH7A.569
I = LAND_INDEX(L) SFEXCH7A.570
DQ(L) = QW_1(I) - QSTAR_TILE(L,N) SFEXCH7A.571
EPDT(L) = - RHOSTAR(I)*CH_TILE(L,N)*VSHR(I)*DQ(L)*TIMESTEP SFEXCH7A.572
ENDDO SFEXCH7A.573
CALL SF_RESIST ( SFEXCH7A.574
& P_FIELD,LAND_FIELD,TILE_PTS(N),LAND_INDEX,TILE_INDEX(1,N), SFEXCH7A.575
& CANOPY(1,N),CATCH(1,N),CH_TILE(1,N),DQ,EPDT,GC(1,N),VSHR, SFEXCH7A.576
& FRACA(1,N),RESFS(1,N),RESFT(1,N),LTIMER SFEXCH7A.577
& ) SFEXCH7A.578
ENDDO SFEXCH7A.579
SFEXCH7A.580
!----------------------------------------------------------------------- SFEXCH7A.581
! Calculate gridbox-means of transfer coefficients. SFEXCH7A.582
!----------------------------------------------------------------------- SFEXCH7A.583
SFEXCH7A.584
DO I=P1,P1+P_POINTS-1 SFEXCH7A.585
CD(I) = 0. SFEXCH7A.586
CH(I) = 0. SFEXCH7A.587
SFEXCH7A.588
! Sea and sea-ice SFEXCH7A.589
IF ( .NOT.LAND_MASK(I) ) THEN SFEXCH7A.590
IF ( ICE_FRACT(I) .LT. 0.7 ) THEN SFEXCH7A.591
CD(I) = ( ICE_FRACT(I)*CD_MIZ(I) + SFEXCH7A.592
& (0.7-ICE_FRACT(I))*CD_SEA(I) ) / 0.7 ! P2430.5 SFEXCH7A.593
CH(I) = ( ICE_FRACT(I)*CH_MIZ(I) + SFEXCH7A.594
& (0.7-ICE_FRACT(I))*CH_SEA(I) ) / 0.7 ! P2430.4 SFEXCH7A.595
ELSE SFEXCH7A.596
CD(I) = ( (1.0-ICE_FRACT(I))*CD_MIZ(I) + SFEXCH7A.597
& (ICE_FRACT(I)-0.7)*CD_ICE(I) ) / 0.3 ! P2430.7 SFEXCH7A.598
CH(I) = ( (1.0-ICE_FRACT(I))*CH_MIZ(I) + SFEXCH7A.599
& (ICE_FRACT(I)-0.7)*CH_ICE(I) ) / 0.3 ! P2430.7 SFEXCH7A.600
ENDIF SFEXCH7A.601
ENDIF SFEXCH7A.602
SFEXCH7A.603
ENDDO SFEXCH7A.604
SFEXCH7A.605
! Land tiles SFEXCH7A.606
DO N=1,NTYPE SFEXCH7A.607
DO J=1,TILE_PTS(N) SFEXCH7A.608
L = TILE_INDEX(J,N) SFEXCH7A.609
I = LAND_INDEX(L) SFEXCH7A.610
CD(I) = CD(I) + TILE_FRAC(L,N)*CD_TILE(L,N) SFEXCH7A.611
CH(I) = CH(I) + TILE_FRAC(L,N)*CH_TILE(L,N) SFEXCH7A.612
ENDDO SFEXCH7A.613
ENDDO SFEXCH7A.614
SFEXCH7A.615
!----------------------------------------------------------------------- SFEXCH7A.616
!! 4.3 Calculate the surface exchange coefficients RHOK(*) and SFEXCH7A.617
! resistances for use in Sulphur Cycle SFEXCH7A.618
! (Note that CD_STD, CH and VSHR should never = 0) SFEXCH7A.619
! RHOSTAR * CD * VSHR stored for diagnostic output before SFEXCH7A.620
! horizontal interpolation. SFEXCH7A.621
!----------------------------------------------------------------------- SFEXCH7A.622
SFEXCH7A.623
DO I=P1,P1+P_POINTS-1 SFEXCH7A.624
RHO_ARESIST(I) = 0. SFEXCH7A.625
ARESIST(I) = 0. SFEXCH7A.626
RESIST_B(I) = 0. SFEXCH7A.627
RHOKM_1(I) = 0. SFEXCH7A.628
SFEXCH7A.629
! Sea and sea-ice SFEXCH7A.630
IF ( .NOT.LAND_MASK(I) ) THEN SFEXCH7A.631
RHOKM_1(I) = RHOSTAR(I)*CD(I)*VSHR(I) ! P243.124 SFEXCH7A.632
RHOKH_1_SICE(I) = RHOSTAR(I) * CH(I) * VSHR(I) ! P243.125 SFEXCH7A.633
RHO_ARESIST(I) = RHOSTAR(I) * CD(I) * VSHR(I) SFEXCH7A.634
ARESIST(I) = 1. / (CD(I) * VSHR(I)) SFEXCH7A.635
RESIST_B(I)= (CD(I)/CH(I) - 1.0) * ARESIST(I) SFEXCH7A.636
ENDIF SFEXCH7A.637
SFEXCH7A.638
ENDDO SFEXCH7A.639
SFEXCH7A.640
! Land tiles SFEXCH7A.641
DO N=1,NTYPE SFEXCH7A.642
DO L=LAND1,LAND1+LAND_PTS-1 SFEXCH7A.643
RHO_ARESIST_TILE(L,N) = 0. SFEXCH7A.644
ARESIST_TILE(L,N) = 0. SFEXCH7A.645
RESIST_B_TILE(L,N) = 0. SFEXCH7A.646
ENDDO SFEXCH7A.647
DO J=1,TILE_PTS(N) SFEXCH7A.648
L = TILE_INDEX(J,N) SFEXCH7A.649
I = LAND_INDEX(L) SFEXCH7A.650
RHOKM_1_TILE(L,N) = RHOSTAR(I)*CD_TILE(L,N)*VSHR(I) ! P243.124 SFEXCH7A.651
RHOKM_1(I) = RHOKM_1(I) + TILE_FRAC(L,N)*RHOKM_1_TILE(L,N) SFEXCH7A.652
RHOKH_1(L,N) = RHOSTAR(I)*CH_TILE(L,N)*VSHR(I) ! P243.125 SFEXCH7A.653
RHO_ARESIST_TILE(L,N) = RHOSTAR(I) * CD_STD(L,N) * VSHR(I) SFEXCH7A.654
ARESIST_TILE(L,N) = 1. / ( CD_STD(L,N) * VSHR(I) ) SFEXCH7A.655
RESIST_B_TILE(L,N) = ( CD_STD(L,N)/CH_TILE(L,N) - 1.0 ) * SFEXCH7A.656
& ARESIST_TILE(L,N) SFEXCH7A.657
ENDDO SFEXCH7A.658
ENDDO SFEXCH7A.659
SFEXCH7A.660
DO I=P1,P1+P_POINTS-1 SFEXCH7A.661
RHO_CD_MODV1(I) = RHOKM_1(I) ! diagnostic required for VAR SFEXCH7A.662
ENDDO SFEXCH7A.663
SFEXCH7A.664
!----------------------------------------------------------------------- SFEXCH7A.665
!! Calculate local and gridbox-average surface fluxes of heat and SFEXCH7A.666
!! moisture. Parameters for snow tile depend on whether or not a land SFEXCH7A.667
!! point has permanent ice cover. SFEXCH7A.668
!----------------------------------------------------------------------- SFEXCH7A.669
SFEXCH7A.670
DO I=P1,P1+P_POINTS-1 SFEXCH7A.671
FTL_1(I) = 0. SFEXCH7A.672
FQW_1(I) = 0. SFEXCH7A.673
ASHTF(I) = 2 * KAPPAI / DE SFEXCH7A.674
ENDDO SFEXCH7A.675
SFEXCH7A.676
DO N=1,NTYPE SFEXCH7A.677
DO L = LAND1,LAND1+LAND_PTS-1 SFEXCH7A.678
FTL_TILE(L,N) = 0. SFEXCH7A.679
FQW_TILE(L,N) = 0. SFEXCH7A.680
ENDDO SFEXCH7A.681
ENDDO SFEXCH7A.682
SFEXCH7A.683
DO L = LAND1,LAND1+LAND_PTS-1 SFEXCH7A.684
I = LAND_INDEX(L) SFEXCH7A.685
ASHTF(I) = 2.0 * HCONS(L) / DZSOIL SFEXCH7A.689
ASHTF_SNOW(I) = ASHTF(I) SFEXCH7A.691
IF ( SMVCST(L).NE.0. ) THEN SFEXCH7A.692
ASHTF_SNOW(I) = 2.0 * SNOW_HCON / DEFF_SNOW SFEXCH7A.693
ENDIF SFEXCH7A.694
ENDDO SFEXCH7A.695
SFEXCH7A.696
! Sea and sea-ice SFEXCH7A.697
CALL SF_FLUX_SEA ( SFEXCH7A.698
& P_POINTS,P_FIELD,P1,NSICE,SICE_INDEX,LAND_MASK, SFEXCH7A.699
& ASHTF,ICE_FRACT,QS1,QSTAR_ICE,QSTAR_SEA,QW_1,RADNET,RHOKH_1_SICE, SFEXCH7A.700
& TI,TL_1,TSTAR_ICE,TSTAR_SEA,Z0_ICE,Z0_ICE,Z0H_SEA,Z0MSEA,Z1_TQ, SFEXCH7A.701
& ALPHA1_SICE,E_SEA,FQW_ICE,FQW_1,FTL_ICE,FTL_1,H_SEA,RHOKPM_SICE, SFEXCH7A.702
& LTIMER SFEXCH7A.703
& ) SFEXCH7A.704
SFEXCH7A.705
! Snow-free land tiles SFEXCH7A.706
DO N=1,NTYPE-1 SFEXCH7A.707
CALL SF_FLUX_LAND ( SFEXCH7A.708
& P_FIELD,LAND_FIELD,TILE_PTS(N),LAND_INDEX,TILE_INDEX(1,N), SFEXCH7A.709
& ASHTF,LC,QS1,QSTAR_TILE(1,N),QW_1,RADNET,RESFT(1,N), SFEXCH7A.710
& RHOKH_1(1,N),TILE_FRAC(1,N),TL_1,TS1,TSTAR_TILE(1,N), SFEXCH7A.711
& Z0H_TILE(1,N),Z0M_EFF_TILE(1,N),Z1_TQ, SFEXCH7A.712
& FQW_1,FTL_1, SFEXCH7A.713
& ALPHA1(1,N),FQW_TILE(1,N),FTL_TILE(1,N),RHOKPM(1,N),LTIMER SFEXCH7A.714
& ) SFEXCH7A.715
ENDDO SFEXCH7A.716
SFEXCH7A.717
! Snow and land-ice tile SFEXCH7A.718
N=NTYPE SFEXCH7A.719
CALL SF_FLUX_LAND ( SFEXCH7A.720
& P_FIELD,LAND_FIELD,TILE_PTS(N),LAND_INDEX,TILE_INDEX(1,N), SFEXCH7A.721
& ASHTF_SNOW,LS,QS1,QSTAR_TILE(1,N),QW_1,RADNET_SNOW,RESFT(1,N), SFEXCH7A.722
& RHOKH_1(1,N),TILE_FRAC(1,N),TL_1,TSNOW,TSTAR_TILE(1,N), SFEXCH7A.723
& Z0H_TILE(1,N),Z0M_EFF_TILE(1,N),Z1_TQ, SFEXCH7A.724
& FQW_1,FTL_1, SFEXCH7A.725
& ALPHA1(1,N),FQW_TILE(1,N),FTL_TILE(1,N),RHOKPM(1,N),LTIMER SFEXCH7A.726
& ) SFEXCH7A.727
SFEXCH7A.728
!----------------------------------------------------------------------- SFEXCH7A.729
!! 4.4 Calculate the standard deviations of layer 1 turbulent SFEXCH7A.730
!! fluctuations of temperature and humidity using approximate SFEXCH7A.731
!! formulae from first order closure. SFEXCH7A.732
!----------------------------------------------------------------------- SFEXCH7A.733
SFEXCH7A.734
DO I=P1,P1+P_POINTS-1 SFEXCH7A.735
Q1_SD(I) = 0. SFEXCH7A.736
T1_SD(I) = 0. SFEXCH7A.737
ENDDO SFEXCH7A.738
SFEXCH7A.739
! Sea and sea-ice SFEXCH7A.740
CALL STDEV1_SEA ( SFEXCH7A.741
& P_POINTS,P_FIELD,P1,LAND_MASK, SFEXCH7A.742
& BQ_1,BT_1,FQW_1,FTL_1,ICE_FRACT,RHOKM_1,RHOSTAR,VSHR, SFEXCH7A.743
& Z0MSEA,Z0_ICE,Z1_TQ, SFEXCH7A.744
& Q1_SD,T1_SD,LTIMER SFEXCH7A.745
& ) SFEXCH7A.746
SFEXCH7A.747
! Land tiles SFEXCH7A.748
DO N=1,NTYPE SFEXCH7A.749
CALL STDEV1_LAND ( SFEXCH7A.750
& P_FIELD,LAND_FIELD,TILE_PTS(N),LAND_INDEX,TILE_INDEX(1,N), SFEXCH7A.751
& BQ_1,BT_1,FQW_TILE(1,N),FTL_TILE(1,N),RHOKM_1_TILE(1,N), SFEXCH7A.752
& RHOSTAR,VSHR,Z0M_TILE(1,N),Z1_TQ, SFEXCH7A.753
& Q1_SD,T1_SD,LTIMER SFEXCH7A.754
& ) SFEXCH7A.755
ENDDO SFEXCH7A.756
SFEXCH7A.757
!----------------------------------------------------------------------- SFEXCH7A.758
!! 4.5 Set indicator for unstable suface layer (buoyancy flux +ve.). SFEXCH7A.759
!----------------------------------------------------------------------- SFEXCH7A.760
! Set to 0 - rapidly mixing boundary layer not available with MOSES II SFEXCH7A.761
SFEXCH7A.762
DO I=P1,P1+P_POINTS-1 SFEXCH7A.763
NRML(I) = 0 SFEXCH7A.764
ENDDO SFEXCH7A.765
SFEXCH7A.766
!----------------------------------------------------------------------- SFEXCH7A.767
!! 4.6 For sea points, calculate the wind mixing energy flux and the SFEXCH7A.768
!! sea-surface roughness length on the P-grid, using time-level n SFEXCH7A.769
!! quantities. SFEXCH7A.770
!----------------------------------------------------------------------- SFEXCH7A.771
SFEXCH7A.772
DO I=P1,P1+P_POINTS-1 SFEXCH7A.773
SFEXCH7A.774
IF (SFME) FME(I) = 0.0 SFEXCH7A.775
IF (.NOT.LAND_MASK(I)) THEN SFEXCH7A.776
TAU = RHOKM_1(I) * VSHR(I) ! P243.130 SFEXCH7A.777
IF (ICE_FRACT(I) .GT. 0.0) SFEXCH7A.778
& TAU = RHOSTAR(I) * CD_SEA(I) * VSHR(I) * VSHR(I) SFEXCH7A.779
SFEXCH7A.780
IF (SFME) FME(I) = (1.0-ICE_FRACT(I)) * TAU * SQRT(TAU/RHOSEA) SFEXCH7A.781
! ! P243.96 SFEXCH7A.782
Z0MSEA(I) = MAX ( Z0HSEA , SFEXCH7A.783
& (CHARNOCK/G) * (TAU / RHOSTAR(I)) ) SFEXCH7A.784
! ... P243.B6 (Charnock formula) SFEXCH7A.785
! TAU/RHOSTAR is "mod VS squared", see eqn P243.131 SFEXCH7A.786
ENDIF SFEXCH7A.787
SFEXCH7A.788
ENDDO SFEXCH7A.789
SFEXCH7A.790
!----------------------------------------------------------------------- SFEXCH7A.791
! Calculate effective roughness lengths, orographic blending heights SFEXCH7A.792
! and gridbox-average Richardson numbers. SFEXCH7A.793
!----------------------------------------------------------------------- SFEXCH7A.794
SFEXCH7A.795
DO I=P1,P1+P_POINTS-1 SFEXCH7A.796
RIB(I) = 0. SFEXCH7A.797
Z0M_EFF(I) = 1. SFEXCH7A.798
SFEXCH7A.799
! Sea and sea-ice (leads ignored) SFEXCH7A.800
IF ( .NOT.LAND_MASK(I) ) THEN SFEXCH7A.801
H_BLEND_OROG(I) = H_BLEND_MIN SFEXCH7A.802
RIB(I) = RIB_SEA(I) SFEXCH7A.803
Z0M_EFF(I) = Z0MSEA(I) SFEXCH7A.804
Z0M(I) = Z0MSEA(I) SFEXCH7A.805
Z0H(I) = Z0HSEA SFEXCH7A.806
IF ( ICE_FRACT(I) .GT. 0. ) THEN SFEXCH7A.807
RIB(I) = RIB_ICE(I) SFEXCH7A.808
Z0M_EFF(I) = Z0_ICE(I) SFEXCH7A.809
Z0M(I) = Z0_ICE(I) SFEXCH7A.810
Z0H(I) = Z0_ICE(I) SFEXCH7A.811
ENDIF SFEXCH7A.812
ENDIF SFEXCH7A.813
SFEXCH7A.814
ENDDO SFEXCH7A.815
SFEXCH7A.816
DO N=1,NTYPE SFEXCH7A.817
DO J=1,TILE_PTS(N) SFEXCH7A.818
L = TILE_INDEX(J,N) SFEXCH7A.819
I = LAND_INDEX(L) SFEXCH7A.820
RIB(I) = RIB(I) + TILE_FRAC(L,N)*RIB_TILE(L,N) SFEXCH7A.821
ENDDO SFEXCH7A.822
ENDDO SFEXCH7A.823
SFEXCH7A.824
SFEXCH7A.825
DO L = LAND1,LAND1+LAND_PTS-1 SFEXCH7A.826
Z0_GB(L) = Z0_SF_GB(LAND_INDEX(L)) SFEXCH7A.827
ENDDO SFEXCH7A.828
DO J=1,TILE_PTS(NTYPE) SFEXCH7A.829
L = TILE_INDEX(J,NTYPE) SFEXCH7A.830
Z0 = TILE_FRAC(L,NTYPE) / ( LOG(LB/Z0M_TILE(L,NTYPE))**2 ) + SFEXCH7A.831
& (1. - TILE_FRAC(L,NTYPE)) / ( LOG(LB/Z0_GB(L))**2 ) SFEXCH7A.832
Z0_GB(L) = LB * EXP( - SQRT(1./Z0) ) SFEXCH7A.833
ENDDO SFEXCH7A.834
SFEXCH7A.835
CALL SF_OROG_GB( SFEXCH7A.836
& P_FIELD,P1,P_POINTS,LAND_FIELD,LAND1,LAND_PTS,LAND_INDEX, SFEXCH7A.837
& LAND_MASK,L_Z0_OROG,HO2R2_OROG,RIB,SIL_OROG,Z0_GB,Z1_UV, SFEXCH7A.838
& H_BLEND_OROG,Z0M_EFF,LTIMER SFEXCH7A.839
& ) SFEXCH7A.840
SFEXCH7A.841
!----------------------------------------------------------------------- SFEXCH7A.842
!! Call SFL_INT to calculate CDR10M and CHR1P5M - interpolation coeffs SFEXCH7A.843
!! used to calculate screen temperature, humidity and 10m winds. SFEXCH7A.844
!----------------------------------------------------------------------- SFEXCH7A.845
SFEXCH7A.846
IF (SU10 .OR. SV10 .OR. SQ1P5 .OR. ST1P5) THEN SFEXCH7A.847
SFEXCH7A.848
! Sea and sea-ice (leads ignored) SFEXCH7A.849
DO I=P1,P1+P_POINTS-1 SFEXCH7A.850
CDR10M(I) =0. SFEXCH7A.851
IF ( .NOT.LAND_MASK(I) .AND. ICE_FRACT(I).GT.0. ) THEN SFEXCH7A.852
CD_SEA(I) = CD_ICE(I) SFEXCH7A.853
CH_SEA(I) = CH_ICE(I) SFEXCH7A.854
Z0H_SEA(I) = Z0_ICE(I) SFEXCH7A.855
Z0F_SEA(I) = Z0_ICE(I) SFEXCH7A.856
ENDIF SFEXCH7A.857
ENDDO SFEXCH7A.858
SFEXCH7A.859
CALL SFL_INT_SEA ( SFEXCH7A.860
& P_POINTS,P_FIELD,P1, SFEXCH7A.861
& CD_SEA,CH_SEA,RIB,Z0M_EFF,Z0H_SEA,Z0F_SEA,Z1_UV, SFEXCH7A.862
& LAND_MASK,SU10,SV10,ST1P5,SQ1P5,LTIMER, SFEXCH7A.863
& CDR10M,CHR1P5M_SICE SFEXCH7A.864
& ) SFEXCH7A.865
SFEXCH7A.866
! Land tiles SFEXCH7A.867
DO N=1,NTYPE SFEXCH7A.868
CALL SFL_INT_LAND ( SFEXCH7A.869
& P_FIELD,LAND_FIELD,TILE_PTS(N),TILE_INDEX(1,N),LAND_INDEX, SFEXCH7A.870
& CD_STD(1,N),CD_TILE(1,N),CH_TILE(1,N),RIB_TILE(1,N), SFEXCH7A.871
& TILE_FRAC(1,N),WIND_PROFILE_FACTOR(1,N),Z0M_TILE(1,N), SFEXCH7A.872
& Z0M_EFF_TILE(1,N),Z0H_TILE(1,N),Z0F_TILE(1,N),Z1_UV, SFEXCH7A.873
& SU10,SV10,ST1P5,SQ1P5,LTIMER, SFEXCH7A.874
& CDR10M,CHR1P5M(1,N) SFEXCH7A.875
& ) SFEXCH7A.876
ENDDO SFEXCH7A.877
SFEXCH7A.878
ENDIF SFEXCH7A.879
SFEXCH7A.880
IF (LTIMER) THEN SFEXCH7A.881
CALL TIMER('SFEXCH ',4) SFEXCH7A.882
ENDIF SFEXCH7A.883
SFEXCH7A.884
RETURN SFEXCH7A.885
END SFEXCH7A.886
*ENDIF SFEXCH7A.887