*IF DEF,A03_6A SFEXCH6A.2
C *****************************COPYRIGHT****************************** SFEXCH6A.3
C (c) CROWN COPYRIGHT 1997, METEOROLOGICAL OFFICE, All Rights Reserved. SFEXCH6A.4
C SFEXCH6A.5
C Use, duplication or disclosure of this code is subject to the SFEXCH6A.6
C restrictions as set forth in the contract. SFEXCH6A.7
C SFEXCH6A.8
C Meteorological Office SFEXCH6A.9
C London Road SFEXCH6A.10
C BRACKNELL SFEXCH6A.11
C Berkshire UK SFEXCH6A.12
C RG12 2SZ SFEXCH6A.13
C SFEXCH6A.14
C If no contract has been raised with this copy of the code, the use, SFEXCH6A.15
C duplication or disclosure of it is strictly prohibited. Permission SFEXCH6A.16
C to do so must first be obtained in writing from the Head of Numerical SFEXCH6A.17
C Modelling at the above address. SFEXCH6A.18
C ******************************COPYRIGHT****************************** SFEXCH6A.19
!!! SUBROUTINE SF_EXCH------------------------------------------------ SFEXCH6A.20
!!! SFEXCH6A.21
!!! Purpose: Calculate coefficients of turbulent exchange between SFEXCH6A.22
!!! the surface and the lowest atmospheric layer, and SFEXCH6A.23
!!! "explicit" fluxes between the surface and this layer. SFEXCH6A.24
!!! SFEXCH6A.25
!!! Suitable for Single Column use. AJC1F405.91
!!! SFEXCH6A.27
!!! Canopy evaporation made implicit SFEXCH6A.28
!!! with respect to canopy water content (requiring TIMESTEP to be SFEXCH6A.29
!!! passed in). SFEXCH6A.30
!!! SFEXCH6A.31
!!! SFEXCH6A.32
!!! Model Modification history: SFEXCH6A.33
!!! version Date SFEXCH6A.34
!!! 4.4 10/09/95 New deck R.N.B.Smith SFEXCH6A.35
!!! 4.5 Jul. 98 Kill the IBM specific lines (JCThil) AJC1F405.90
!!! SFEXCH6A.36
!!! Programming standard: SFEXCH6A.37
!!! SFEXCH6A.38
!!! System component covered: Part of P243. SFEXCH6A.39
!!! SFEXCH6A.40
!!! Project task: SFEXCH6A.41
!!! SFEXCH6A.42
!!! Documentation: UM Documentation Paper No 24, section P243. SFEXCH6A.43
!!! SFEXCH6A.44
!!!--------------------------------------------------------------------- SFEXCH6A.45
SFEXCH6A.46
! Arguments :- SFEXCH6A.47
SFEXCH6A.48
SUBROUTINE SF_EXCH ( 4,99SFEXCH6A.49
& P_POINTS,LAND_PTS,P_FIELD,LAND_FIELD,N_TYPES SFEXCH6A.50
&,P1,LAND1 SFEXCH6A.51
&,LAND_INDEX,GATHER SFEXCH6A.53
&,P_1,TILE_FRAC SFEXCH6A.55
&,CANOPY,CATCH,CO2 SFEXCH6A.56
&,SM_LEVELS,DZSOIL,HCONS,F_TYPE SFEXCH6A.57
&,HT,LAI,PAR,GPP,NPP,RESP_P SFEXCH6A.58
&,ICE_FRACT,LAND_MASK,LYING_SNOW,PSTAR,Q_1 SFEXCH6A.59
&,QCF_1,QCL_1,RADNET_C,GC,RESIST APA1F405.438
&,ROOTD,SMC,SMVCCL,SMVCWT SFEXCH6A.61
&,T_1,TIMESTEP,TI,TS1,TSTAR_GB SFEXCH6A.62
&,TSTAR_TILE,U_1,V_1,U_0,V_0 SFEXCH6A.63
&,V_ROOT,V_SOIL,VFRAC SFEXCH6A.64
&,Z0V_GB,Z0V,SIL_OROG,HO2R2_OROG,ZH SFEXCH6A.65
&,Z1_UV,Z1_TQ,CANCAP,Z0MSEA,ALPHA1_GB,ALPHA1,ASHTF APA1F405.439
&,BQ1_GB,BT1_GB,CD,CH SFEXCH6A.67
&,FQW_1,FQW1_GB,FTL_1,FTL1_GB SFEXCH6A.68
&,EPOT,EPOT_GB,FSMC,FSMC_GB ANG1F405.105
&,E_SEA,H_SEA,FRACA,RESFS,F_SE SFEXCH6A.69
&,RESFT,RESFT_GB,RHOKE,RHOKH_1,RHOKH_1_GB SFEXCH6A.70
&,RHOKM_1_GB,RHOKPM,RHOKPM_GB,RHOKPM_POT,RHOKPM_POT_GB ANG1F405.106
&,RIB_GB,RIB,TL_1,VSHR,Z0H_T,Z0M_T,Z0M_EFF_T,Z0M_EFF SFEXCH6A.72
&,H_BLEND_OROG,H_BLEND,T1_SD,Q1_SD,TV1_SD,U_S,FB_SURF SFEXCH6A.73
&,RHO_CD_MODV1,WIND_BLEND_FACTOR,HEAT_BLEND_FACTOR SFEXCH6A.74
&,CDR10M,CHR1P5M,CER1P5M,FME SFEXCH6A.75
&,SU10,SV10,SQ1P5,ST1P5,SFME SFEXCH6A.76
&,RHO_ARESIST,ARESIST,RESIST_B,NRML SFEXCH6A.77
&,L_Z0_OROG,L_RMBL,LTIMER SFEXCH6A.78
&) SFEXCH6A.79
SFEXCH6A.80
IMPLICIT NONE SFEXCH6A.81
SFEXCH6A.82
! Input variables. All fields are on P grid except where noted. SFEXCH6A.83
! Fxxx in a comment indicates the file from which the data are taken. SFEXCH6A.84
SFEXCH6A.85
SFEXCH6A.87
! GENERAL NOTES ABOUT GRID-DEFINITION INPUT VARIABLES. SFEXCH6A.88
! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ SFEXCH6A.89
! For global data :- SFEXCH6A.90
SFEXCH6A.91
! An Arakawa B-grid is assumed in which each pole is represented by a SFEXCH6A.92
! row of P-grid points. Entire fields of P-grid values are taken as SFEXCH6A.93
! input, but the two polemost rows are (a) not updated, in the case SFEXCH6A.94
! of INOUT fields, or (b) set to zero, in the case of OUT fields. SFEXCH6A.95
SFEXCH6A.96
! If defined variable IBM is selected then land point calculations are SFEXCH6A.97
! performed using the array LAND_INDEX to select land points. But note SFEXCH6A.98
! that elements of LAND_INDEX define land points on the full field SFEXCH6A.99
! (ie including polar rows). SFEXCH6A.100
SFEXCH6A.101
! Entire fields of UV-grid values are taken as input, but the two SFEXCH6A.102
! polemost rows are (a) not updated, in the case of INOUT fields, or SFEXCH6A.103
! (b) set to zero, in the case of OUT fields. SFEXCH6A.104
SFEXCH6A.105
! For limited-area data :- SFEXCH6A.106
SFEXCH6A.107
! The above applies, but for "polar rows", etc., read "rows at the SFEXCH6A.108
! north and south boundaries of the area", etc. E.g. if you want to SFEXCH6A.109
! do calculations in UV-rows n to m inclusive, the input data will be SFEXCH6A.110
! on P-rows n-1 to m+1, and UV-rows n-1 to m+1. P-rows n to m will SFEXCH6A.111
! then be updated. Land specific variables are processed as for global SFEXCH6A.112
! data. SFEXCH6A.113
SFEXCH6A.114
! For both cases, the following equalities apply amongst the input SFEXCH6A.115
! grid-definition variables :- SFEXCH6A.116
SFEXCH6A.117
! P_POINTS = P_ROWS * ROW_LENGTH SFEXCH6A.118
! U_POINTS = U_ROWS * ROW_LENGTH SFEXCH6A.119
! U_ROWS = P_ROWS + 1 SFEXCH6A.120
! LAND_PTS <= P_POINTS SFEXCH6A.121
SFEXCH6A.122
! NB: All this has severe implications for batching/macrotasking; SFEXCH6A.123
! effectively it can't be done on a shared-memory machine without SFEXCH6A.124
! either rewriting this routine or using expensive synchronizations SFEXCH6A.125
! (or other messy and/or undesirable subterfuges). SFEXCH6A.126
SFEXCH6A.127
SFEXCH6A.142
LOGICAL LTIMER SFEXCH6A.143
SFEXCH6A.144
INTEGER ! Variables defining grid. SFEXCH6A.145
& P_POINTS ! IN Number of P-grid points to be SFEXCH6A.146
! processed. SFEXCH6A.147
&,P_FIELD ! IN Total number of P-grid points. SFEXCH6A.148
&,P1 ! IN First P-point to be processed. SFEXCH6A.149
&,LAND1 ! IN First land point to be processed. SFEXCH6A.150
&,LAND_PTS ! IN Number of land points to be processed. SFEXCH6A.151
&,LAND_FIELD ! IN Total number of land points. SFEXCH6A.152
&,N_TYPES ! IN Number of tiles per land point. SFEXCH6A.153
&,LAND_INDEX(LAND_FIELD)! IN Index for compressed land point array; SFEXCH6A.155
! ith element holds position in the FULL SFEXCH6A.156
! field of the ith land pt to be processed SFEXCH6A.157
SFEXCH6A.158
LOGICAL SFEXCH6A.159
& GATHER ! IN If true then leads variables are comp- SFEXCH6A.160
! ressed for sea-ice calculations. This SFEXCH6A.161
! saves duplicating calculations if there SFEXCH6A.162
! are a relatively few of sea-ice points. SFEXCH6A.163
! Set to false for a limited area run SFEXCH6A.164
! with a high proportion of sea-ice. SFEXCH6A.165
SFEXCH6A.167
! Extra variables for the interactive stomatal resistance model SFEXCH6A.168
SFEXCH6A.169
INTEGER SFEXCH6A.170
& SM_LEVELS ! IN Number of soil moisture levels. SFEXCH6A.171
&,F_TYPE(LAND_FIELD,N_TYPES) SFEXCH6A.172
! IN Plant functional type: SFEXCH6A.173
! 1 - Broadleaf Tree SFEXCH6A.174
! 2 - Needleleaf Tree SFEXCH6A.175
! 3 - C3 Grass SFEXCH6A.176
! 4 - C4 Grass SFEXCH6A.177
REAL SFEXCH6A.178
& CANOPY(LAND_FIELD) ! IN Surface water (kg per sq metre). F642. SFEXCH6A.179
&,CATCH(LAND_FIELD,N_TYPES) SFEXCH6A.180
! IN Surface capacity (max. surface water) SFEXCH6A.181
! (kg per sq metre). F6416. SFEXCH6A.182
&,CO2 ! IN CO2 Mass Mixing Ratio SFEXCH6A.183
&,DZSOIL(SM_LEVELS) ! IN Soil layer thicknesses (m) SFEXCH6A.184
&,HCONS(LAND_FIELD) ! IN Soil thermal conductivity (W/m/K). SFEXCH6A.185
&,HO2R2_OROG(LAND_FIELD)! IN Peak to trough height of unresolved SFEXCH6A.186
! orography devided by 2SQRT(2) (m). SFEXCH6A.187
&,HT(LAND_FIELD,N_TYPES)! IN Canopy height (m). SFEXCH6A.188
&,ICE_FRACT(P_FIELD) ! IN Fraction of gridbox which is sea-ice. SFEXCH6A.189
&,LAI(LAND_FIELD,N_TYPES)!IN Leaf area index. SFEXCH6A.190
&,LYING_SNOW(P_FIELD) ! IN Lying snow amount (kg per sq metre). SFEXCH6A.191
&,PAR(P_FIELD) ! IN Photosynthetically active radiation SFEXCH6A.192
! (W/m2). SFEXCH6A.193
&,PSTAR(P_FIELD) ! IN Surface pressure (Pascals). SFEXCH6A.194
&,P_1(P_FIELD) ! IN pressure lowest atmospheric SFEXCH6A.195
&,Q_1(P_FIELD) ! IN Specific humidity for lowest SFEXCH6A.196
! atmospheric layer (kg water per kg air). SFEXCH6A.197
&,QCF_1(P_FIELD) ! IN Cloud ice for lowest atmospheric layer SFEXCH6A.198
! (kg water per kg air). SFEXCH6A.199
&,QCL_1(P_FIELD) ! IN Cloud liquid water for lowest atm SFEXCH6A.200
! layer (kg water per kg air). SFEXCH6A.201
&,RESIST(LAND_FIELD,N_TYPES) SFEXCH6A.204
! ! IN "Stomatal" resistance to evaporation SFEXCH6A.205
! (seconds per metre). F6415. SFEXCH6A.206
&,ROOTD(LAND_FIELD,N_TYPES) SFEXCH6A.207
! IN "Root depth" (metres). F6412. SFEXCH6A.208
&,SIL_OROG(LAND_FIELD) ! IN Silhouette area of unresolved SFEXCH6A.209
! orography per unit horizontal area SFEXCH6A.210
&,SMC(LAND_FIELD,N_TYPES)!IN Soil moisture content (kg/m2). F621. SFEXCH6A.211
&,SMVCCL(LAND_FIELD) ! IN Critical volumetric SMC (cubic metres SFEXCH6A.212
! per cubic metre of soil). F6232. SFEXCH6A.213
&,SMVCWT(LAND_FIELD) ! IN Volumetric wilting point (cubic m of SFEXCH6A.214
! water per cubic m of soil). F6231. SFEXCH6A.215
SFEXCH6A.216
! Note: (SMVCCL - SMVCWT) is the critical volumetric available soil SFEXCH6A.217
! moisture content. ~~~~~~~~~ SFEXCH6A.218
SFEXCH6A.219
REAL ! (Split to avoid > 19 continuations.) SFEXCH6A.220
& T_1(P_FIELD) ! IN Temperature for lowest atmospheric SFEXCH6A.221
! layer (Kelvin). SFEXCH6A.222
&,TILE_FRAC(P_FIELD,N_TYPES) SFEXCH6A.223
! IN Fractional coverage for each tile SFEXCH6A.224
&,TIMESTEP ! IN Timestep in seconds for EPDT calc. SFEXCH6A.225
&,TI(P_FIELD) ! IN Temperature of sea-ice surface layer SFEXCH6A.226
! (Kelvin) SFEXCH6A.227
&,TL_1(P_FIELD) ! IN Liquid/frozen water temperature for SFEXCH6A.228
! lowest atmospheric layer (K). SFEXCH6A.229
&,TS1(LAND_FIELD) ! IN Temperature of top soil layer (K) SFEXCH6A.230
&,TSTAR_TILE(P_FIELD,N_TYPES) SFEXCH6A.231
! IN Tile surface temperature (K). SFEXCH6A.232
&,TSTAR_GB(P_FIELD) ! IN Mean gridbox surface temperature (K). SFEXCH6A.233
&,U_0(P_FIELD) ! IN West-to-east component of ocean SFEXCH6A.234
! surface current (m/s; ASSUMED zero over SFEXCH6A.235
! land). UV grid. F615. SFEXCH6A.236
&,U_1(P_FIELD) ! IN West-to-east wind component for lowest SFEXCH6A.237
! atmospheric layer (m/s). On UV grid. SFEXCH6A.238
&,V_0(P_FIELD) ! IN South-to-north component of ocean SFEXCH6A.239
! surface current (m/s; ASSUMED zero over SFEXCH6A.240
! land). UV grid. F616. SFEXCH6A.241
&,V_1(P_FIELD) ! IN South-to-north wind component for SFEXCH6A.242
! lowest atm. layer (m/s). On UV grid. SFEXCH6A.243
&,V_ROOT(LAND_FIELD,N_TYPES) SFEXCH6A.244
! ! IN Volumetric soil moisture concentration SFEXCH6A.245
! in the rootzone (m3 H2O/m3 soil). SFEXCH6A.246
&,V_SOIL(LAND_FIELD) ! IN Volumetric soil moisture concentration SFEXCH6A.247
! in the top soil layer (m3 H2O/m3 soil). SFEXCH6A.248
&,VFRAC(LAND_FIELD,N_TYPES) SFEXCH6A.249
! ! IN Vegetation fraction. SFEXCH6A.250
&,Z0V(P_FIELD,N_TYPES) ! IN Tile vegetative roughness length (m). SFEXCH6A.251
&,Z0V_GB(P_FIELD) ! IN Gridbox veg. roughness length (m). SFEXCH6A.252
&,Z1_UV(P_FIELD) ! IN Height of lowest uv level (m). SFEXCH6A.253
&,Z1_TQ(P_FIELD) ! IN Height of lowest tq level (m). SFEXCH6A.254
! Note, if the grid used is staggered in SFEXCH6A.255
! the vertical, Z1_UV and Z1_TQ can be SFEXCH6A.256
! different. SFEXCH6A.257
&,ZH(P_FIELD) ! IN Height of top of boundary layer (m). SFEXCH6A.258
SFEXCH6A.259
LOGICAL SFEXCH6A.260
& LAND_MASK(P_FIELD) ! IN .TRUE. for land; .FALSE. elsewhere. SFEXCH6A.261
! F60. SFEXCH6A.262
&,SU10 ! IN STASH flag for 10-metre W wind. SFEXCH6A.263
&,SV10 ! IN STASH flag for 10-metre S wind. SFEXCH6A.264
&,SQ1P5 ! IN STASH flag for 1.5-metre sp humidity. SFEXCH6A.265
&,ST1P5 ! IN STASH flag for 1.5-metre temperature. SFEXCH6A.266
&,SFME ! IN STASH flag for wind mixing energy flux SFEXCH6A.267
&,L_RMBL ! IN T to use rapidly mixing boundary SFEXCH6A.268
! scheme in IMPL_CAL SFEXCH6A.269
&,L_Z0_OROG ! IN .TRUE. to use orographic roughness. SFEXCH6A.270
SFEXCH6A.271
! Modified (INOUT) variables. SFEXCH6A.272
SFEXCH6A.273
REAL SFEXCH6A.274
& CANCAP(P_FIELD,N_TYPES)! INOUT Volumetric heat capacity of APA1F405.440
C ! vegetation canopy (J/Kg/m3). APA1F405.441
&,RADNET_C(P_FIELD,N_TYPES) ! INOUT Adjusted net radiation for APA1F405.442
C ! vegetation over land (W/m2). APA1F405.443
&,Z0MSEA(P_FIELD) ! INOUT Sea-surface roughness length for APA1F405.444
! momentum (m). F617. SFEXCH6A.276
&,GC(LAND_FIELD,N_TYPES)! INOUT "Stomatal" conductance to SFEXCH6A.277
! evaporation (m/s). SFEXCH6A.278
SFEXCH6A.279
! Output variables. SFEXCH6A.280
! SFEXCH6A.281
REAL SFEXCH6A.282
& ALPHA1(P_FIELD,N_TYPES)!OUT Gradients of saturated specific SFEXCH6A.283
! humidity with respect to temperature SFEXCH6A.284
! between the bottom model layer and tile SFEXCH6A.285
! surface SFEXCH6A.286
&,ALPHA1_GB(P_FIELD) ! OUT Gradient of saturated specific SFEXCH6A.287
! humidity with respect to temperature SFEXCH6A.288
! between the bottom model layer and the SFEXCH6A.289
! mean surface SFEXCH6A.290
&,ASHTF(P_FIELD) ! OUT Coefficient to calculate surface SFEXCH6A.291
! heat flux into soil or sea-ice (W/m2/K) SFEXCH6A.292
&,BQ1_GB(P_FIELD) ! OUT A buoyancy parameter for lowest atm SFEXCH6A.293
! level ("beta-q twiddle"). SFEXCH6A.294
&,BT1_GB(P_FIELD) ! OUT A buoyancy parameter for lowest atm SFEXCH6A.295
! level ("beta-T twiddle"). SFEXCH6A.296
&,CD(P_FIELD) ! OUT Bulk transfer coefficient for SFEXCH6A.297
! momentum. SFEXCH6A.298
&,CH(P_FIELD) ! OUT Bulk transfer coefficient for heat SFEXCH6A.299
! and/or moisture. SFEXCH6A.300
&,CDR10M(P_FIELD) ! OUT Reqd for calculation of 10m wind SFEXCH6A.301
! (u & v). SFEXCH6A.302
! NBB: This is output on the UV-grid, but SFEXCH6A.303
! with the first and last rows set to a SFEXCH6A.304
! "missing data indicator". SFEXCH6A.305
! Sea-ice leads ignored. See 3.D.7 below. SFEXCH6A.306
&,CHR1P5M(P_FIELD) ! OUT Reqd for calculation of 1.5m temp. SFEXCH6A.307
! Sea-ice leads ignored. See 3.D.7 below. SFEXCH6A.308
&,CER1P5M(P_FIELD) ! OUT Reqd for calculation of 1.5m sp SFEXCH6A.309
! humidity. Sea-ice leads ignored. SFEXCH6A.310
! See 3.D.7 below. SFEXCH6A.311
&,E_SEA(P_FIELD) ! OUT Evaporation from sea times leads SFEXCH6A.312
! fraction (kg/m2/s). Zero over land. SFEXCH6A.313
&,FME(P_FIELD) ! OUT Wind mixing energy flux (Watts/sq m). SFEXCH6A.314
&,F_SE(P_FIELD,N_TYPES) ! OUT Fraction of the evapotranspiration SFEXCH6A.315
! which is bare soil evaporation. SFEXCH6A.316
&,EPOT(P_FIELD,N_TYPES) ! OUT "Explicit" potential evaporation ANG1F405.107
! on P-grid (kg/m2/s). ANG1F405.108
&,EPOT_GB(P_FIELD) ! OUT "Explicit" potential evaporation ANG1F405.109
! on P-grid (kg/m2/s) ANG1F405.110
! for whole grid box. ANG1F405.111
&,FSMC(LAND_FIELD,N_TYPES) ANG1F405.112
! OUT soil moisture availability. ANG1F405.113
&,FSMC_GB(LAND_FIELD) ANG1F405.114
! OUT soil moisture availability ANG1F405.115
! for whole grid box. ANG1F405.116
&,FQW_1(P_FIELD,N_TYPES)! OUT "Explicit" surface flux of QW (i.e. SFEXCH6A.317
! evaporation), on P-grid (kg/m2/s). SFEXCH6A.318
&,FQW1_GB(P_FIELD) ! OUT "Explicit" surface flux of QW (i.e. SFEXCH6A.319
! evaporation), on P-grid (kg/m2/s). for SFEXCH6A.320
! whole grid-box SFEXCH6A.321
&,FTL_1(P_FIELD,N_TYPES)! OUT "Explicit" surface flux of TL = H/CP. SFEXCH6A.322
! (sensible heat / CP). SFEXCH6A.323
&,FTL1_GB(P_FIELD) ! OUT "Explicit" surface flux of TL = H/CP. SFEXCH6A.324
! (sensible heat / CP). grid-box mean SFEXCH6A.325
&,FRACA(P_FIELD,N_TYPES)! OUT Fraction of surface moisture flux SFEXCH6A.326
! with only aerodynamic resistance. SFEXCH6A.327
&,GPP(LAND_FIELD,N_TYPES)!OUT Gross Primary Productivity SFEXCH6A.328
! (kg C/m2/s). SFEXCH6A.329
&,H_BLEND(P_FIELD) ! OUT Blending height for tiles SFEXCH6A.330
&,H_BLEND_OROG(P_FIELD) ! OUT Blending height for orographic SFEXCH6A.331
! roughness SFEXCH6A.332
&,H_SEA(P_FIELD) ! OUT Surface sensible heat flux over sea SFEXCH6A.333
! times leads fraction (W/m2). SFEXCH6A.334
! Zero over land. SFEXCH6A.335
&,NPP(LAND_FIELD,N_TYPES)!OUT Net Primary Productivity (kg C/m2/s). SFEXCH6A.336
&,Q1_SD(P_FIELD) ! OUT Standard deviation of turbulent SFEXCH6A.337
! fluctuations of surface layer SFEXCH6A.338
! specific humidity (kg/kg). SFEXCH6A.339
&,RESFS_GB(P_FIELD) ! OUT Combined soil, stomatal and SFEXCH6A.340
! aerodynamic resistance factor = SFEXCH6A.341
! PSIS/(1+RS/RA) for fraction (1-FRACA) SFEXCH6A.342
&,RESFT_GB(P_FIELD) ! OUT Total resistance factor SFEXCH6A.343
! FRACA+(1-FRACA)*RESFS. SFEXCH6A.344
&,RESP_P(LAND_FIELD,N_TYPES) SFEXCH6A.345
! ! OUT Plant respiration rate (kg C/m2/s). SFEXCH6A.346
&,RIB_GB(P_FIELD) ! OUT Mean bulk Richardson number for SFEXCH6A.347
! lowest layer SFEXCH6A.348
&,T1_SD(P_FIELD) ! OUT Standard deviation of turbulent SFEXCH6A.349
! fluctuations of surface layer SFEXCH6A.350
! temperature (K). SFEXCH6A.351
&,TV1_SD(P_FIELD) ! OUT Standard deviation of turbulent SFEXCH6A.352
! ! fluctuations of surface layer SFEXCH6A.353
! ! virtual temperature (K). SFEXCH6A.354
&,U_S(P_FIELD) ! OUT Surface friction velocity (m/s) SFEXCH6A.355
&,FB_SURF(P_FIELD) ! OUT Surface flux buoyancy over density SFEXCH6A.356
! ! (m^2/s^3) SFEXCH6A.357
! SFEXCH6A.358
&,VSHR(P_FIELD) ! OUT Magnitude of surface-to-lowest-level SFEXCH6A.359
! wind SFEXCH6A.360
&,Z0H(P_FIELD) ! OUT Roughness length for heat & moisture SFEXCH6A.361
&,Z0M(P_FIELD) ! OUT Roughness length for momentum (m). SFEXCH6A.362
&,Z0M_EFF(P_FIELD) ! OUT Effective roughness length for SFEXCH6A.363
! momentum SFEXCH6A.364
&,RHO_ARESIST(P_FIELD) ! OUT, RHOSTAR*CD_STD*VSHR for SCYCLE SFEXCH6A.365
&,ARESIST(P_FIELD) ! OUT, 1/(CD_STD*VSHR) for SCYCLE SFEXCH6A.366
&,RESIST_B(P_FIELD) ! OUT, (1/CH-1/CD_STD)/VSHR for SCYCLE SFEXCH6A.367
SFEXCH6A.368
SFEXCH6A.369
! Surface exchange coefficients;passed to subroutine IMPL_CAL SFEXCH6A.370
REAL SFEXCH6A.371
& RHO_CD_MODV1(P_FIELD) ! OUT rhostar*cD*vshr before horizontal SFEXCH6A.372
! interpolation output as a diagnostic. SFEXCH6A.373
&,RHOKE_GB(P_FIELD) ! OUT For FQW SFEXCH6A.374
&,RHOKH_1(P_FIELD,N_TYPES) SFEXCH6A.375
! ! OUT For FTL SFEXCH6A.376
&,RHOKH_1_GB(P_FIELD) ! OUT For FTL SFEXCH6A.377
&,RHOKM_1_GB(P_FIELD) ! OUT For momentum. NB: This is output on SFEXCH6A.378
! UV-grid, but with the first and last SFEXCH6A.379
! rows set to a "missing data indicator". SFEXCH6A.380
&,RHOKPM_GB(P_FIELD) ! OUT Mixing coefficient for Penman- SFEXCH6A.381
! Monteith scheme SFEXCH6A.382
&,RHOKPM_POT(P_FIELD,N_TYPES) ANG1F405.117
! OUT Surface exchange coeff. for ANG1F405.118
! potential evaporation. ANG1F405.119
&,RHOKPM_POT_GB(P_FIELD)! OUT Surface exchange coeff. for ANG1F405.120
! potential evaporation ANG1F405.121
! for whole grid box. ANG1F405.122
SFEXCH6A.383
INTEGER SFEXCH6A.384
& NRML(P_FIELD) ! OUT 1 if surface layer unstable, else 0. SFEXCH6A.385
SFEXCH6A.386
! Symbolic constants ------------------------------------------------ SFEXCH6A.387
SFEXCH6A.388
! (1) UM-wide common parameters. SFEXCH6A.389
SFEXCH6A.390
*CALL C_0_DG_C 
SFEXCH6A.391
*CALL C_LHEAT SFEXCH6A.392
*CALL C_G SFEXCH6A.393
*CALL C_R_CP SFEXCH6A.394
*CALL C_EPSLON SFEXCH6A.395
*CALL C_VKMAN SFEXCH6A.396
*CALL C_MDI SFEXCH6A.397
SFEXCH6A.398
SFEXCH6A.399
! (2) Boundary Layer local parameters. SFEXCH6A.400
SFEXCH6A.401
*CALL C_CHARNK SFEXCH6A.402
*CALL C_DENSTY SFEXCH6A.403
*CALL C_HT_M SFEXCH6A.404
*CALL C_ROUGH SFEXCH6A.405
*CALL C_SURF SFEXCH6A.406
*CALL C_SOILH SFEXCH6A.407
*CALL C_KAPPAI SFEXCH6A.408
*CALL C_SICEHC SFEXCH6A.409
SFEXCH6A.410
SFEXCH6A.411
! (3) Derived local parameters. SFEXCH6A.412
SFEXCH6A.413
REAL ETAR,GRCP,LCRCP,LFRCP,LS,LSRCP,H_BLEND_MIN,H_BLEND_MAX SFEXCH6A.414
SFEXCH6A.415
PARAMETER ( SFEXCH6A.416
& ETAR=1./(1.-EPSILON) ! Used in calc of buoyancy parameter BETAC. SFEXCH6A.417
&,GRCP=G/CP ! Used in calc of dT across surface layer. SFEXCH6A.418
&,LCRCP=LC/CP ! Evaporation-to-dT conversion factor. SFEXCH6A.419
&,LFRCP=LF/CP ! Freezing-to-dT conversion factor. SFEXCH6A.420
&,LS=LF+LC ! Latent heat of sublimation. SFEXCH6A.421
&,LSRCP=LS/CP ! Sublimation-to-dT conversion factor. SFEXCH6A.422
&,H_BLEND_MIN=0.0 ! Minimum blending height. SFEXCH6A.423
&,H_BLEND_MAX=1000.0 ! Maximum blending height (m). SFEXCH6A.424
&) SFEXCH6A.425
SFEXCH6A.426
SFEXCH6A.427
! External subprograms called. SFEXCH6A.428
SFEXCH6A.429
EXTERNAL SF_ROUGH,SF_LBEST,SF_RIB,FCDCH,QSAT,SFL_INT,SF_RESIST, SFEXCH6A.430
& SF_FLUX,SF_STOM,TIMER SFEXCH6A.431
SFEXCH6A.432
SFEXCH6A.433
! Define local storage. SFEXCH6A.434
SFEXCH6A.435
! (a) Workspace. SFEXCH6A.436
SFEXCH6A.437
! Workspace --------------------------------------------------------- SFEXCH6A.438
REAL SFEXCH6A.439
& BQ_1(P_FIELD,N_TYPES)!A buoyancy parameter for lowest atm level SFEXCH6A.440
! ("beta-q twiddle"). SFEXCH6A.441
&,BT_1(P_FIELD,N_TYPES)!A buoyancy parameter for lowest atm level. SFEXCH6A.442
! ("beta-T twiddle"). SFEXCH6A.443
&,CD_LEAD(P_FIELD) ! Bulk transfer coefficient for momentum SFEXCH6A.444
! over sea-ice leads.Missing data over non SFEXCH6A.445
! sea-ice points.(Temporary store for SFEXCH6A.446
! Z0MIZ) SFEXCH6A.447
&,CD_MIZ(P_FIELD) ! Bulk transfer coefficient for momentum SFEXCH6A.448
! over the sea-ice Marginal Ice Zone. SFEXCH6A.449
! Missing data indicator over non sea-ice. SFEXCH6A.450
&,CD_STD_T(P_FIELD,N_TYPES) SFEXCH6A.451
! Local drag coefficient for SFEXCH6A.452
! calculation of interpolation coefficients SFEXCH6A.453
&,CD_STD(P_FIELD) ! Local drag coefficient for SFEXCH6A.454
! ! calculation of interpolation coefficients SFEXCH6A.455
&,CD_T(P_FIELD,N_TYPES)! Drag coefficient on tile SFEXCH6A.456
&,CH_LEAD(P_FIELD) ! Bulk transfer coefficient for heat and SFEXCH6A.457
! or moisture over sea ice leads. SFEXCH6A.458
! Missing data indicator over non sea-ice. SFEXCH6A.459
&,CH_MIZ(P_FIELD) ! Bulk transfer coefficient for heat and SFEXCH6A.460
! or moisture over the Marginal Ice Zone. SFEXCH6A.461
! Missing data indicator over non sea-ice. SFEXCH6A.462
&,CH_T(P_FIELD,N_TYPES)! Transfer coefficient for heat and SFEXCH6A.463
! moisture on tile SFEXCH6A.464
&,DQ(P_FIELD,N_TYPES) ! Sp humidity difference between surface SFEXCH6A.465
! and lowest atmospheric level (Q1 - Q*). SFEXCH6A.466
! Holds value over sea-ice where ICE_FRACT SFEXCH6A.467
! >0 i.e. Leads contribution not included. SFEXCH6A.468
&,DQ_LEAD(P_FIELD) ! DQ for leads fraction of gridsquare. SFEXCH6A.469
! Missing data indicator over non sea-ice. SFEXCH6A.470
&,DTEMP(P_FIELD,N_TYPES)!Liquid/ice static energy difference SFEXCH6A.471
! between surface and lowest atmospheric SFEXCH6A.472
! level, divided by CP (a modified SFEXCH6A.473
! temperature difference). SFEXCH6A.474
! Holds value over sea-ice where ICE_FRACT SFEXCH6A.475
! >0 i.e. Leads contribution not included. SFEXCH6A.476
&,DTEMP_LEAD(P_FIELD) ! DTEMP for leads fraction of gridsquare. SFEXCH6A.477
! Missing data indicator over non sea-ice. SFEXCH6A.478
&,EPDT(P_FIELD) ! "Potential" Evaporation * Timestep SFEXCH6A.479
&,HEAT_BLEND_FACTOR(P_FIELD) SFEXCH6A.480
! used in estimation of heat and SFEXCH6A.481
! moisture at blending height SFEXCH6A.482
&,NL0(LAND_FIELD) ! Nitrogen concentration of the top leaf SFEXCH6A.483
! (kg N/kg C). SFEXCH6A.484
&,PSIS(P_FIELD,N_TYPES)! Soil moisture availability factor. SFEXCH6A.485
&,PSTAR_ICE(P_FIELD) ! Surface pressure over sea ice (Pa). SFEXCH6A.486
&,Q_BLEND(P_FIELD) ! Estimate of blending height Q SFEXCH6A.487
&,QS_BLEND(P_FIELD) ! Sat. specific humidity SFEXCH6A.488
! qsat(TL_BLEND,PSTAR) SFEXCH6A.489
&,QW_BLEND(P_FIELD) ! Estimate of blending height Q SFEXCH6A.490
&,QS1(P_FIELD) ! Sat. specific humidity qsat(TL_1,PSTAR) SFEXCH6A.491
&,QSL(P_FIELD) ! Saturated sp humidity at liquid/ice SFEXCH6A.492
! temperature and pressure of lowest SFEXCH6A.493
! atmospheric level. SFEXCH6A.494
&,QSTAR_GB(P_FIELD) ! Gridbox mean QSTAR SFEXCH6A.495
&,QSTAR(P_FIELD) ! Surface saturated sp humidity. Holds SFEXCH6A.496
! value over sea-ice where ICE_FRACT > 0. SFEXCH6A.497
! i.e. Leads contribution not included. SFEXCH6A.498
&,QSTAR_LEAD(P_FIELD) ! QSTAR for sea-ice leads. SFEXCH6A.499
! Missing data indicator over non sea-ice. SFEXCH6A.500
&,RA(P_FIELD) ! Aerodynamic resistance. SFEXCH6A.501
&,RESFS(P_FIELD,N_TYPES)!Combined soil, stomatal and aerodynamic SFEXCH6A.502
! resistance factor = PSIS/(1+RS/RA) for SFEXCH6A.503
! fraction (1-FRACA) SFEXCH6A.504
&,RESFT(P_FIELD,N_TYPES)!Total resistance factor SFEXCH6A.505
! FRACA+(1-FRACA)*RESFS. SFEXCH6A.506
&,RHOKE(P_FIELD,N_TYPES)!For FQW SFEXCH6A.507
&,RHOKM_1(P_FIELD,N_TYPES) SFEXCH6A.508
! RHOKM for tile SFEXCH6A.509
&,RHOKPM(P_FIELD,N_TYPES) SFEXCH6A.510
! Mixing coefficient SFEXCH6A.511
&,RHOSTAR(P_FIELD,N_TYPES) SFEXCH6A.512
! Surface air density in kg per cubic metre. SFEXCH6A.513
&,RHOSTAR_GB(P_FIELD) ! Surface air density in kg per cubic metre. SFEXCH6A.514
&,DB_GB(P_FIELD) ! Gridbox mean buoyancy difference. SFEXCH6A.515
&,DB_LEAD(P_FIELD) ! Buoyancy difference for lead part of grdbx SFEXCH6A.516
&,DB(P_FIELD,N_TYPES) ! Buoyancy difference for surface tile SFEXCH6A.517
&,RIB_LEAD(P_FIELD) ! Bulk Richardson no. for sea-ice leads at SFEXCH6A.518
! lowest layer. At non sea-ice points holds SFEXCH6A.519
! RIB for FCDCH calculation, then set to SFEXCH6A.520
! to missing data indicator. SFEXCH6A.521
&,RIB(P_FIELD,N_TYPES) ! Bulk Richardson no. for surface tile SFEXCH6A.522
&,ROOT(LAND_FIELD) ! Root biomass (kg C/m2). SFEXCH6A.523
&,T_BLEND(P_FIELD) ! Estimate of blending height T SFEXCH6A.524
&,TL_BLEND(P_FIELD) ! Estimate of blending height TL SFEXCH6A.525
&,TSTAR_NL(P_FIELD) ! TSTAR No Leads: surface temperature SFEXCH6A.526
! over sea-ice fraction of gridsquare. SFEXCH6A.527
! =TSTAR over non sea-ice points. SFEXCH6A.528
&,U_BLEND(P_FIELD) ! Estimate of blending height U SFEXCH6A.529
&,V_BLEND(P_FIELD) ! Estimate of blending height V SFEXCH6A.530
&,WIND_BLEND_FACTOR(P_FIELD) SFEXCH6A.531
! used in estimation of winds at SFEXCH6A.532
! blending height SFEXCH6A.533
&,WIND_PROFILE_FACTOR(P_FIELD,N_TYPES) SFEXCH6A.534
! For transforming effective surface SFEXCH6A.535
! transfer coefficients to those excluding SFEXCH6A.536
! form drag. SFEXCH6A.537
&,RECIP_L_MO(P_FIELD,N_TYPES) SFEXCH6A.538
! ! Reciprocal of the Monin-Obukhov length. SFEXCH6A.539
&,V_S(P_FIELD,N_TYPES) ! Surface scaling velocity (friction velocit SFEXCH6A.540
! ! modified with convective turbulence SFEXCH6A.541
! ! velocity) including orographic form drag SFEXCH6A.542
! ! effects. SFEXCH6A.543
&,V_S_STD(P_FIELD,N_TYPES) SFEXCH6A.544
! ! Surface scaling velocity (friction velocit SFEXCH6A.545
! ! modified with convective turbulence SFEXCH6A.546
! ! velocity) excluding orographic form drag SFEXCH6A.547
! ! effects. SFEXCH6A.548
&,V_S_LEAD(P_FIELD) ! Surface scaling velocity (friction velocit SFEXCH6A.549
! ! modified with convective turbulence veloci SFEXCH6A.550
! ! for leads part of sea gridbox. SFEXCH6A.551
&,Z0HS(P_FIELD) ! Roughness length for heat and moisture SFEXCH6A.552
! transport over sea. SFEXCH6A.553
&,Z0M_EFF_T(P_FIELD,N_TYPES) SFEXCH6A.554
! Effective roughness length for momentum SFEXCH6A.555
&,Z0H_T(P_FIELD,N_TYPES)!Tile roughness length for heat and SFEXCH6A.556
! moisture SFEXCH6A.557
&,Z0M_T(P_FIELD,N_TYPES)!Local tileroughness length for momentum SFEXCH6A.558
SFEXCH6A.559
! Workspace (reqd for compression). SFEXCH6A.560
INTEGER SFEXCH6A.561
& SICE_INDEX(P_FIELD) ! Index vector for gather to sea-ice points SFEXCH6A.562
SFEXCH6A.563
LOGICAL ITEST(P_FIELD) !Used as 'logical' for compression. SFEXCH6A.564
SFEXCH6A.565
SFEXCH6A.566
! (b) Scalars. SFEXCH6A.567
SFEXCH6A.568
INTEGER SFEXCH6A.569
& I ! Loop counter (horizontal field index). SFEXCH6A.570
&,ITILE ! Loop counter (tile index). SFEXCH6A.571
&,J,K ! Offset counter within I-loop. SFEXCH6A.572
&,L,N ! Loop counter (land point field index). SFEXCH6A.573
&,NSICE ! Number of sea-ice points. SFEXCH6A.574
&,SI ! Loop counter (sea-ice field index). SFEXCH6A.578
REAL SFEXCH6A.579
& TAU ! Magnitude of surface wind stress over sea. SFEXCH6A.580
&,W_S_CUBED ! Cube of surface layer free convective scaling SFEXCH6A.581
! ! velocity SFEXCH6A.582
&,W_M ! Turbulent velocity scale for surface layer SFEXCH6A.583
SFEXCH6A.584
LOGICAL SFEXCH6A.585
& L_LAND ! a logical SFEXCH6A.586
SFEXCH6A.587
! Extra work variables for the canopy (stomatal) conductance model. SFEXCH6A.588
LOGICAL SFEXCH6A.589
& INT_STOM ! T for interactive stomatal resistance. SFEXCH6A.590
PARAMETER (INT_STOM=.TRUE.) SFEXCH6A.591
SFEXCH6A.592
SFEXCH6A.593
!----------------------------------------------------------------------- SFEXCH6A.594
!! 0. Check that the scalars input to define the grid are consistent. SFEXCH6A.595
!----------------------------------------------------------------------- SFEXCH6A.596
SFEXCH6A.597
IF (LTIMER) THEN SFEXCH6A.598
CALL TIMER('SFEXCH ',3) SFEXCH6A.599
ENDIF SFEXCH6A.600
SFEXCH6A.601
SFEXCH6A.614
!----------------------------------------------------------------------- SFEXCH6A.615
!! 1. Construct SICE_INDEX for compression onto sea points in SFEXCH6A.616
!! sea-ice leads calculations. SFEXCH6A.617
!----------------------------------------------------------------------- SFEXCH6A.618
SFEXCH6A.619
DO I=P1,P1+P_POINTS-1 SFEXCH6A.620
ITEST(I) = .FALSE. SFEXCH6A.621
IF (ICE_FRACT(I).GT.0.0 .AND. .NOT.LAND_MASK(I)) SFEXCH6A.622
& ITEST(I) = .TRUE. SFEXCH6A.623
ENDDO SFEXCH6A.624
SFEXCH6A.625
NSICE = 0 SFEXCH6A.626
DO I=P1,P1+P_POINTS-1 SFEXCH6A.627
IF(ITEST(I))THEN SFEXCH6A.628
NSICE = NSICE + 1 SFEXCH6A.629
SICE_INDEX(NSICE) = I SFEXCH6A.630
END IF SFEXCH6A.631
ENDDO SFEXCH6A.632
SFEXCH6A.634
!----------------------------------------------------------------------- SFEXCH6A.635
!! 2. Calculate QSAT values required later and components of ocean SFEXCH6A.636
!! current. SFEXCH6A.637
!! Done here to avoid loop splitting. SFEXCH6A.638
!! QSTAR 'borrowed' to store P at level 1 (just this once). SFEXCH6A.639
!! PSIS 'borrowed' to store leads and non sea-ice surface temp. SFEXCH6A.640
!----------------------------------------------------------------------- SFEXCH6A.641
SFEXCH6A.642
SFEXCH6A.643
!----------------------------------------------------------------------- SFEXCH6A.645
!! 2.1 IF (GATHER) THEN SFEXCH6A.646
!! Calculate temperatures and pressures for QSAT calculations. SFEXCH6A.647
!! Calculate QSAT values. For sea-ice points, separate values SFEXCH6A.648
!! are required for the leads (QSTAR_LEAD) and sea-ice (QSTAR) SFEXCH6A.649
!! fractions respectively. QSTAR_LEAD = missing data, elsewhere. SFEXCH6A.650
!! Use RS to store compressed PSTAR for this section only. SFEXCH6A.651
!! NB Unlike QSTAR, TSTAR values at sea-ice points are gridsq. SFEXCH6A.652
!! means and so include the leads contribution. SFEXCH6A.653
!! ELSE SFEXCH6A.654
!! As above with QSTAR_LEAD done on full field. SFEXCH6A.655
!! ENDIF SFEXCH6A.656
!----------------------------------------------------------------------- SFEXCH6A.657
IF (GATHER) THEN SFEXCH6A.658
DO I=P1,P1+P_POINTS-1 SFEXCH6A.659
TSTAR_NL(I) = TSTAR_GB(I) SFEXCH6A.660
QSTAR_LEAD(I) = 1.0E30 ! Missing data indicator SFEXCH6A.661
ENDDO SFEXCH6A.662
IF (NSICE.GT.0) THEN SFEXCH6A.663
CDIR$ IVDEP SFEXCH6A.664
! Fujitsu vectorization directive GRB0F405.487
!OCL NOVREC GRB0F405.488
DO SI = 1,NSICE SFEXCH6A.665
I = SICE_INDEX(SI) SFEXCH6A.666
SFEXCH6A.667
TSTAR_NL(I) = (TSTAR_GB(I)-(1.0-ICE_FRACT(I)) *TFS) SFEXCH6A.668
& / ICE_FRACT(I) ! P2430.1 SFEXCH6A.669
PSIS(SI,1) = TFS SFEXCH6A.670
PSTAR_ICE(SI) = PSTAR(I) SFEXCH6A.671
ENDDO SFEXCH6A.672
ENDIF SFEXCH6A.673
SFEXCH6A.674
CALL QSAT(QSL(P1),TL_1(P1),P_1(P1),P_POINTS) SFEXCH6A.675
CALL QSAT(QS1(P1),TL_1(P1),PSTAR(P1),P_POINTS) SFEXCH6A.676
SFEXCH6A.677
CALL QSAT(QSTAR(P1),TSTAR_NL(P1),PSTAR(P1),P_POINTS) SFEXCH6A.678
! ...values at sea-ice points contain ice contribution only SFEXCH6A.679
IF (NSICE.GT.0) CALL QSAT(QSTAR_LEAD,PSIS,PSTAR_ICE,NSICE) SFEXCH6A.680
! ...values at sea-ice points only SFEXCH6A.681
SFEXCH6A.682
CALL QSAT(QSTAR_GB(P1),TSTAR_GB(P1),PSTAR(P1),P_POINTS) SFEXCH6A.683
! ...values at sea-ice points gb-average SFEXCH6A.684
SFEXCH6A.685
ELSE SFEXCH6A.686
SFEXCH6A.698
DO I=P1,P1+P_POINTS-1 SFEXCH6A.699
TSTAR_NL(I) = TSTAR_GB(I) SFEXCH6A.700
! Set to missing data at non sea-ice points after QSAT. SFEXCH6A.701
PSIS(I,1) = TSTAR_GB(I) SFEXCH6A.702
IF ( ICE_FRACT(I).GT.0.0 .AND. .NOT.LAND_MASK(I) ) THEN SFEXCH6A.703
TSTAR_NL(I) = (TSTAR_GB(I)-(1.0-ICE_FRACT(I)) *TFS) SFEXCH6A.704
& / ICE_FRACT(I) ! P2430.1 SFEXCH6A.705
PSIS(I,1) = TFS SFEXCH6A.706
ENDIF SFEXCH6A.707
ENDDO SFEXCH6A.708
CALL QSAT(QSL(P1),TL_1(P1),P_1(P1),P_POINTS) SFEXCH6A.709
CALL QSAT(QS1(P1),TL_1(P1),PSTAR(P1),P_POINTS) SFEXCH6A.710
SFEXCH6A.711
CALL QSAT(QSTAR(P1),TSTAR_NL(P1),PSTAR(P1),P_POINTS) SFEXCH6A.712
! ...values at sea-ice points contain ice contribution only SFEXCH6A.713
SFEXCH6A.714
IF (NSICE.GT.0) SFEXCH6A.715
& CALL QSAT(QSTAR_LEAD(P1),PSIS(P1,1),PSTAR(P1),P_POINTS) SFEXCH6A.716
! ...values at sea-ice points contain leads contribution only SFEXCH6A.717
SFEXCH6A.718
CALL QSAT(QSTAR_GB(P1),TSTAR_GB(P1),PSTAR(P1),P_POINTS) SFEXCH6A.719
! ...values at sea-ice points gb-average SFEXCH6A.720
SFEXCH6A.721
DO I=P1,P1+P_POINTS-1 SFEXCH6A.722
IF ( .NOT.(ICE_FRACT(I).GT.0.0 .AND. .NOT.LAND_MASK(I)) ) SFEXCH6A.723
& QSTAR_LEAD(I) = 1.0E30 SFEXCH6A.724
ENDDO SFEXCH6A.725
ENDIF ! End of IF (GATHER) THEN... ELSE. SFEXCH6A.727
SFEXCH6A.729
!----------------------------------------------------------------------- SFEXCH6A.730
!! 2.2 Reset aggregated quantities SFEXCH6A.731
!----------------------------------------------------------------------- SFEXCH6A.732
SFEXCH6A.733
DO I=1,P_FIELD SFEXCH6A.734
RHO_ARESIST(I) = 0.0 SFEXCH6A.735
ARESIST(I) = 0.0 SFEXCH6A.736
RESIST_B(I) = 0.0 SFEXCH6A.737
EPOT_GB(I) = 0.0 ANG1F405.123
FQW1_GB(I)=0.0 SFEXCH6A.738
FTL1_GB(I)=0.0 SFEXCH6A.739
RIB_GB(I)=0.0 SFEXCH6A.740
DB_GB(I)=0.0 SFEXCH6A.741
BT1_GB(I)=0.0 SFEXCH6A.742
BQ1_GB(I)=0.0 SFEXCH6A.743
RESFS_GB(I)=0.0 SFEXCH6A.744
RESFT_GB(I)=0.0 SFEXCH6A.745
ALPHA1_GB(I) = 0.0 SFEXCH6A.746
RHOKE_GB(I) = 0.0 SFEXCH6A.747
CD(I)=0.0 SFEXCH6A.748
CD_STD(I)=0.0 SFEXCH6A.749
CH(I)=0.0 SFEXCH6A.750
RHOKH_1_GB(I) = 0.0 SFEXCH6A.751
RHOKM_1_GB(I) = 0.0 SFEXCH6A.752
RHOKPM_GB(I) = 0.0 SFEXCH6A.753
RHOKPM_POT_GB(I) = 0.0 ANG1F405.124
T1_SD(I)=0.0 SFEXCH6A.754
Q1_SD(I)=0.0 SFEXCH6A.755
TV1_SD(I)=0.0 SFEXCH6A.756
RHOSTAR_GB(I)=0.0 SFEXCH6A.757
NRML(I) = 0 SFEXCH6A.758
SFEXCH6A.759
DO ITILE=1,N_TYPES SFEXCH6A.760
DB(I,ITILE)=0.0 SFEXCH6A.761
RIB(I,ITILE)=0.0 SFEXCH6A.762
ENDDO SFEXCH6A.763
ENDDO SFEXCH6A.764
SFEXCH6A.765
DO L=1,LAND_FIELD ANG1F405.125
FSMC_GB(L) = 0.0 ANG1F405.126
ENDDO ANG1F405.127
SFEXCH6A.766
!----------------------------------------------------------------------- SFEXCH6A.767
!! 3. Calculation of transfer coefficients and surface layer stability SFEXCH6A.768
!----------------------------------------------------------------------- SFEXCH6A.769
SFEXCH6A.770
!----------------------------------------------------------------------- SFEXCH6A.771
!! 3.1 Calculate neutral roughness lengths and blending height for SFEXCH6A.772
!! surface SFEXCH6A.773
!----------------------------------------------------------------------- SFEXCH6A.774
SFEXCH6A.775
! Grid box mean value for estimating model values at bending height SFEXCH6A.776
SFEXCH6A.777
L_LAND=.FALSE. ! Calc over all points) SFEXCH6A.778
SFEXCH6A.779
CALL SF_ROUGH ( SFEXCH6A.780
& P_FIELD,P_POINTS,LAND_FIELD,LAND_PTS,LAND_MASK,L_LAND,P1,LAND1, SFEXCH6A.781
& LAND_INDEX, SFEXCH6A.783
& L_Z0_OROG,Z1_UV,Z0MSEA,ICE_FRACT, SFEXCH6A.785
& LYING_SNOW,Z0V_GB,SIL_OROG,HO2R2_OROG,RIB_GB,Z0M_EFF,Z0M,Z0H, SFEXCH6A.786
& WIND_PROFILE_FACTOR(1,1),H_BLEND_OROG,CD_LEAD,Z0HS, SFEXCH6A.787
& LTIMER) SFEXCH6A.788
SFEXCH6A.789
SFEXCH6A.790
! Estimate model values at blending height from neutral profile SFEXCH6A.791
SFEXCH6A.792
CALL SF_LBEST ( SFEXCH6A.793
& P_POINTS,P_FIELD,P1,H_BLEND_OROG, SFEXCH6A.794
& QCL_1,QCF_1,QSTAR_GB,Q_1,TSTAR_GB,T_1,U_1,V_1, SFEXCH6A.795
& Z0M_EFF,Z0H,Z0M,Z1_UV,Z1_TQ,H_BLEND,HEAT_BLEND_FACTOR, SFEXCH6A.796
& Q_BLEND,QW_BLEND,T_BLEND,TL_BLEND,U_BLEND,V_BLEND, SFEXCH6A.797
& WIND_BLEND_FACTOR,LTIMER SFEXCH6A.798
& ) SFEXCH6A.799
SFEXCH6A.800
! Calc. QSAT at blending height SFEXCH6A.801
CALL QSAT(QS_BLEND(P1),TL_BLEND(P1),PSTAR(P1),P_POINTS) SFEXCH6A.802
SFEXCH6A.803
SFEXCH6A.804
! Calc QSTAR_no_leads and store in QSTAR_GB SFEXCH6A.805
CALL QSAT(QSTAR_GB(P1),TSTAR_NL(P1),PSTAR(P1),P_POINTS) SFEXCH6A.806
SFEXCH6A.807
SFEXCH6A.808
! Start of loop over tiles SFEXCH6A.809
DO ITILE=1,N_TYPES SFEXCH6A.810
SFEXCH6A.811
!----------------------------------------------------------------------- SFEXCH6A.812
! 3.1.1 Tile roughnesses SFEXCH6A.813
!----------------------------------------------------------------------- SFEXCH6A.814
SFEXCH6A.815
! Only calculate roughnesses for sea points once SFEXCH6A.816
SFEXCH6A.817
L_LAND=.FALSE. SFEXCH6A.818
SFEXCH6A.819
CALL SF_ROUGH ( SFEXCH6A.820
& P_FIELD,P_POINTS,LAND_FIELD,LAND_PTS,LAND_MASK,L_LAND,P1,LAND1, SFEXCH6A.821
& LAND_INDEX, SFEXCH6A.823
& L_Z0_OROG,Z1_UV,Z0MSEA,ICE_FRACT, SFEXCH6A.825
& LYING_SNOW,Z0V(1,ITILE),SIL_OROG,HO2R2_OROG,RIB(1,ITILE), SFEXCH6A.826
& Z0M_EFF_T(1,ITILE),Z0M_T(1,ITILE),Z0H_T(1,ITILE), SFEXCH6A.827
& WIND_PROFILE_FACTOR(1,ITILE),H_BLEND_OROG,CD_LEAD,Z0HS, SFEXCH6A.828
& LTIMER SFEXCH6A.829
& ) SFEXCH6A.830
SFEXCH6A.831
!----------------------------------------------------------------------- SFEXCH6A.832
!! 3.2 Calculate buoyancy parameters and bulk Richardson number for SFEXCH6A.833
!! the lowest model level. SFEXCH6A.834
!----------------------------------------------------------------------- SFEXCH6A.835
SFEXCH6A.836
SFEXCH6A.837
! Tile temperature passed to sf_rib through tstar_nl SFEXCH6A.838
DO I=P1,P1+P_POINTS-1 SFEXCH6A.839
IF ( LAND_MASK(I) ) TSTAR_NL(I)=TSTAR_TILE(I,ITILE) SFEXCH6A.840
ENDDO SFEXCH6A.841
SFEXCH6A.842
SFEXCH6A.843
CALL QSAT(QSTAR(P1),TSTAR_NL(P1),PSTAR(P1),P_POINTS) SFEXCH6A.844
SFEXCH6A.845
SFEXCH6A.846
! qstar over sea-ice doesn not include leads SFEXCH6A.847
SFEXCH6A.848
DO I=P1,P1+P_POINTS-1 SFEXCH6A.849
IF(.NOT.LAND_MASK(I)) QSTAR(I)=QSTAR_GB(I) SFEXCH6A.850
ENDDO SFEXCH6A.851
SFEXCH6A.852
CALL SF_RIB ( SFEXCH6A.853
& P_POINTS,LAND_PTS,P_FIELD,LAND_FIELD,LAND_MASK,L_LAND,INT_STOM, SFEXCH6A.854
& P1,LAND1, SFEXCH6A.855
& GATHER,LAND_INDEX, SFEXCH6A.857
& NSICE,SICE_INDEX,ICE_FRACT,Q_BLEND,QW_BLEND,QCL_1,QCF_1, SFEXCH6A.859
& T_BLEND,TL_BLEND,QSL,QSTAR,QSTAR_LEAD, SFEXCH6A.860
& QS_BLEND,TSTAR_NL,Z1_TQ,Z1_UV,Z0M_EFF_T(1,ITILE), SFEXCH6A.861
& Z0M_T(1,ITILE),Z0H_T(1,ITILE),Z0HS,Z0MSEA, SFEXCH6A.862
& WIND_PROFILE_FACTOR(1,ITILE),U_BLEND,U_0,V_BLEND,V_0, SFEXCH6A.863
& ROOTD(1,ITILE),SMVCCL,SMVCWT,SMC(1,ITILE),VFRAC(1,ITILE), SFEXCH6A.864
& V_SOIL,CANOPY,CATCH(1,ITILE), SFEXCH6A.865
& LYING_SNOW,GC(1,ITILE),RESIST(1,ITILE), SFEXCH6A.866
& DB(1,ITILE),DB_LEAD,RIB(1,ITILE),RIB_LEAD,PSIS(1,ITILE),VSHR, SFEXCH6A.867
& ALPHA1(1,ITILE),BT_1(1,ITILE),BQ_1(1,ITILE), SFEXCH6A.868
& FRACA(1,ITILE),RESFS(1,ITILE), SFEXCH6A.869
& DQ(1,ITILE),DQ_LEAD,DTEMP(1,ITILE),DTEMP_LEAD,LTIMER SFEXCH6A.870
& ) SFEXCH6A.871
SFEXCH6A.872
!----------------------------------------------------------------------- SFEXCH6A.873
!! 3.3 Calculate stability corrected effective roughness length. SFEXCH6A.874
!! Simple linear interpolation when RIB between 0 and RIB_CRIT (>0) for SFEXCH6A.875
!! form drag term. SFEXCH6A.876
!----------------------------------------------------------------------- SFEXCH6A.877
SFEXCH6A.878
SFEXCH6A.879
! Stability correction only applies to land points SFEXCH6A.880
L_LAND = .TRUE. SFEXCH6A.881
SFEXCH6A.882
CALL SF_ROUGH ( SFEXCH6A.883
& P_FIELD,P_POINTS,LAND_FIELD,LAND_PTS,LAND_MASK,L_LAND,P1,LAND1, SFEXCH6A.884
& LAND_INDEX, SFEXCH6A.886
& L_Z0_OROG,Z1_UV,Z0MSEA,ICE_FRACT, SFEXCH6A.888
& LYING_SNOW,Z0V(1,ITILE),SIL_OROG,HO2R2_OROG,RIB(1,ITILE), SFEXCH6A.889
& Z0M_EFF_T(1,ITILE),Z0M_T(1,ITILE),Z0H_T(1,ITILE), SFEXCH6A.890
& WIND_PROFILE_FACTOR(1,ITILE),H_BLEND_OROG,CD_LEAD,Z0HS, SFEXCH6A.891
& LTIMER SFEXCH6A.892
& ) SFEXCH6A.893
SFEXCH6A.894
ENDDO ! n_types SFEXCH6A.895
SFEXCH6A.896
SFEXCH6A.897
DO ITILE=1,N_TYPES SFEXCH6A.898
SFEXCH6A.899
! Calculate 'mean' richardson number for mean roughness lengths SFEXCH6A.900
DO I=P1,P1+P_POINTS-1 SFEXCH6A.901
SFEXCH6A.902
IF (.NOT.LAND_MASK(I)) THEN SFEXCH6A.903
RIB(I,ITILE) = RIB(I,1) SFEXCH6A.904
DB(I,ITILE) = DB(I,1) SFEXCH6A.905
ENDIF SFEXCH6A.906
SFEXCH6A.907
RIB_GB(I) = RIB_GB(I) + RIB(I,ITILE) * TILE_FRAC(I,ITILE) SFEXCH6A.908
DB_GB(I) = DB_GB(I) + DB(I,ITILE) * TILE_FRAC(I,ITILE) SFEXCH6A.909
SFEXCH6A.910
ENDDO !End of p_point loop SFEXCH6A.911
SFEXCH6A.912
SFEXCH6A.913
DO I=P1,P1+P_POINTS-1 SFEXCH6A.914
IF (.NOT. LAND_MASK(I).AND.ITILE.GT.1) THEN SFEXCH6A.915
PSIS(I,ITILE)=PSIS(I,1) SFEXCH6A.916
DQ(I,ITILE)=DQ(I,1) SFEXCH6A.917
DTEMP(I,ITILE)=DTEMP(I,1) SFEXCH6A.918
FRACA(I,ITILE)=FRACA(I,1) SFEXCH6A.919
RESFS(I,ITILE)=RESFS(I,1) SFEXCH6A.920
BT_1(I,ITILE)=BT_1(I,1) SFEXCH6A.921
BQ_1(I,ITILE)=BQ_1(I,1) SFEXCH6A.922
ALPHA1(I,ITILE)=ALPHA1(I,1) SFEXCH6A.923
Z0M_EFF_T(I,ITILE) = Z0M_EFF_T(I,1) SFEXCH6A.924
Z0M_T(I,ITILE) = Z0M_T(I,1) SFEXCH6A.925
Z0H_T(I,ITILE) = Z0H_T(I,1) SFEXCH6A.926
WIND_PROFILE_FACTOR(I,ITILE) = WIND_PROFILE_FACTOR(I,1) SFEXCH6A.927
ENDIF SFEXCH6A.928
ENDDO !P_POINTS SFEXCH6A.929
ENDDO !loop over tiles SFEXCH6A.930
SFEXCH6A.931
! stability correction for grid box roughness lengths SFEXCH6A.932
SFEXCH6A.933
CALL SF_ROUGH ( SFEXCH6A.934
& P_FIELD,P_POINTS,LAND_FIELD,LAND_PTS,LAND_MASK,L_LAND,P1,LAND1, SFEXCH6A.935
& LAND_INDEX, SFEXCH6A.937
& L_Z0_OROG,Z1_UV,Z0MSEA,ICE_FRACT, SFEXCH6A.939
& LYING_SNOW,Z0V_GB,SIL_OROG,HO2R2_OROG,RIB_GB,Z0M_EFF,Z0M,Z0H, SFEXCH6A.940
& WIND_PROFILE_FACTOR(1,1),H_BLEND_OROG,CD_LEAD,Z0HS, SFEXCH6A.941
& LTIMER) SFEXCH6A.942
SFEXCH6A.943
SFEXCH6A.944
!----------------------------------------------------------------------- SFEXCH6A.945
!! 3.4 Calculate CD, CH via routine FCDCH. SFEXCH6A.946
!! Calculate CD_MIZ,CH_MIZ,CD_LEAD,CH_LEAD on full field then set SFEXCH6A.947
!! non sea-ice points to missing data (contain nonsense after FCDCH) SFEXCH6A.948
! Unlike the QSAT calculations above, arrays are not compressed to SFEXCH6A.950
! sea-ice points for FCDCH. This is because it would require extra SFEXCH6A.951
! work space and initial tests showed that with with the extra SFEXCH6A.952
! compression calculations required no time was saved. SFEXCH6A.953
! NB CD_LEAD stores Z0MIZ for calculation of CD_MIZ,CH_MIZ. SFEXCH6A.955
!----------------------------------------------------------------------- SFEXCH6A.956
SFEXCH6A.957
L_LAND=.FALSE. SFEXCH6A.958
SFEXCH6A.959
CALL FCDCH(P_POINTS,P_FIELD,P1,L_LAND,LAND_MASK,DB_GB,VSHR, SFEXCH6A.960
& CD_LEAD,CD_LEAD,ZH,Z1_UV,Z1_TQ, SFEXCH6A.961
& WIND_PROFILE_FACTOR(1,1), SFEXCH6A.962
& CD_MIZ,CH_MIZ,CD_STD_T(1,1),V_S(1,1),V_S_STD(1,1), SFEXCH6A.963
& RECIP_L_MO(1,1),LTIMER) SFEXCH6A.964
! ! Marginal Ice Zone.P2430.9 SFEXCH6A.965
! SFEXCH6A.966
CALL FCDCH(P_POINTS,P_FIELD,P1,L_LAND,LAND_MASK,DB_LEAD,VSHR, SFEXCH6A.967
& Z0MSEA,Z0HS,ZH,Z1_UV,Z1_TQ,WIND_PROFILE_FACTOR(1,1), SFEXCH6A.968
& CD_LEAD,CH_LEAD,CD_STD_T(1,1),V_S_LEAD,V_S_STD(1,1), SFEXCH6A.969
& RECIP_L_MO(1,1),LTIMER) SFEXCH6A.970
! ! Sea-ice leads.P2430.8 SFEXCH6A.971
SFEXCH6A.972
DO ITILE=1,N_TYPES SFEXCH6A.973
SFEXCH6A.974
IF (ITILE.EQ.1) THEN SFEXCH6A.975
L_LAND=.FALSE. SFEXCH6A.976
ELSE SFEXCH6A.977
L_LAND=.TRUE. SFEXCH6A.978
ENDIF SFEXCH6A.979
SFEXCH6A.980
CALL FCDCH(P_POINTS,P_FIELD,P1,L_LAND,LAND_MASK,DB(1,ITILE), SFEXCH6A.981
& VSHR,Z0M_EFF_T(1,ITILE),Z0H_T(1,ITILE),ZH, SFEXCH6A.982
& Z1_UV,Z1_TQ,WIND_PROFILE_FACTOR(1,ITILE), SFEXCH6A.983
& CD_T(1,ITILE),CH_T(1,ITILE),CD_STD_T(1,ITILE), SFEXCH6A.984
& V_S(1,ITILE),V_S_STD(1,ITILE),RECIP_L_MO(1,ITILE), SFEXCH6A.985
& LTIMER) SFEXCH6A.986
SFEXCH6A.987
SFEXCH6A.988
DO I=P1,P1+P_POINTS-1 SFEXCH6A.989
SFEXCH6A.990
IF (.NOT.LAND_MASK(I).AND.ITILE.GT.1) THEN SFEXCH6A.991
CD_T(I,ITILE)=CD_T(I,1) SFEXCH6A.992
CH_T(I,ITILE)=CH_T(I,1) SFEXCH6A.993
CD_STD_T(I,ITILE)=CD_STD_T(I,1) SFEXCH6A.994
ENDIF SFEXCH6A.995
ENDDO ! loop over P-points SFEXCH6A.996
SFEXCH6A.997
ENDDO ! loop over tiles SFEXCH6A.998
SFEXCH6A.999
SFEXCH6A.1000
DO I=P1,P1+P_POINTS-1 SFEXCH6A.1001
! IF ( an ordinary sea points (no sea-ice) or a land point) SFEXCH6A.1002
IF (.NOT.(ICE_FRACT(I).GT.0.0 .AND. .NOT.LAND_MASK(I)) ) THEN SFEXCH6A.1003
CD_MIZ(I) = 1.E30 SFEXCH6A.1004
CH_MIZ(I) = 1.E30 SFEXCH6A.1005
CD_LEAD(I) = 1.E30 SFEXCH6A.1006
CH_LEAD(I) = 1.E30 SFEXCH6A.1007
RIB_LEAD(I) = 1.E30 SFEXCH6A.1008
ENDIF SFEXCH6A.1009
ENDDO SFEXCH6A.1010
SFEXCH6A.1011
SFEXCH6A.1012
!----------------------------------------------------------------------- SFEXCH6A.1013
!! 4. Loop round gridpoints to be processed, performing calculations SFEXCH6A.1014
!! AFTER call to FCDCH which necessitates splitting of loop. SFEXCH6A.1015
!----------------------------------------------------------------------- SFEXCH6A.1016
SFEXCH6A.1017
DO ITILE=1,N_TYPES SFEXCH6A.1018
SFEXCH6A.1019
!----------------------------------------------------------------------- SFEXCH6A.1020
! 4.1 If the interactive surface resistance is requested call SF_STOM SFEXCH6A.1021
!----------------------------------------------------------------------- SFEXCH6A.1022
SFEXCH6A.1023
IF (INT_STOM) THEN SFEXCH6A.1024
SFEXCH6A.1025
!----------------------------------------------------------------------- SFEXCH6A.1026
! Calculate the aerodynamic resistance SFEXCH6A.1027
!----------------------------------------------------------------------- SFEXCH6A.1028
DO I=P1,P1+P_POINTS-1 SFEXCH6A.1029
RA(I) = 1.0 / CH_T(I,ITILE) SFEXCH6A.1030
ENDDO SFEXCH6A.1031
SFEXCH6A.1032
CDIR$ IVDEP SFEXCH6A.1038
! Fujitsu vectorization directive GRB0F405.489
!OCL NOVREC GRB0F405.490
DO L = LAND1,LAND1+LAND_PTS-1 SFEXCH6A.1039
I = LAND_INDEX(L) SFEXCH6A.1040
!----------------------------------------------------------------------- SFEXCH6A.1042
! For mesoscale model release assume uniform functional types and top SFEXCH6A.1043
! leaf nitrogen concentrations. Assume that (fine) root biomass is SFEXCH6A.1044
! equal to leaf biomass. SFEXCH6A.1045
!----------------------------------------------------------------------- SFEXCH6A.1046
NL0(L) = 50.0E-3 SFEXCH6A.1047
ROOT(L) = 0.04 * LAI(L,ITILE) SFEXCH6A.1048
SFEXCH6A.1049
ENDDO ! Loop over land-points SFEXCH6A.1054
SFEXCH6A.1056
SFEXCH6A.1057
IF(LAND_PTS.GT.0) THEN ! Omit if no land points SFEXCH6A.1058
CALL SF_STOM ( SFEXCH6A.1059
& LAND_PTS,LAND_FIELD,LAND_MASK,P1,LAND1, SFEXCH6A.1060
& LAND_INDEX, SFEXCH6A.1062
& P_POINTS,P_FIELD, SFEXCH6A.1064
& F_TYPE(1,ITILE),CO2,HT(1,ITILE),PAR,LAI(1,ITILE), SFEXCH6A.1065
& NL0,PSTAR,Q_1,RA,ROOT,TSTAR_TILE(1,ITILE),SMVCCL, SFEXCH6A.1066
& V_ROOT(1,ITILE),SMVCWT,VFRAC(1,ITILE),GPP(1,ITILE), SFEXCH6A.1067
& NPP(1,ITILE),RESP_P(1,ITILE), SFEXCH6A.1068
& GC(1,ITILE),LTIMER,FSMC(1,ITILE)) ANG1F405.137
ENDIF ! End test on land points SFEXCH6A.1070
SFEXCH6A.1071
SFEXCH6A.1072
!----------------------------------------------------------------------- ABX1F405.734
! Initialise gridbox mean carbon fluxes on uncalculated points ABX1F405.735
!----------------------------------------------------------------------- ABX1F405.736
IF(LAND_FIELD.GT.0) THEN ABX1F405.737
DO L=1,LAND1-1 ABX1F405.738
GPP(L,ITILE)=0. ABX1F405.739
NPP(L,ITILE)=0. ABX1F405.740
RESP_P(L,ITILE)=0. ABX1F405.741
ENDDO ABX1F405.742
DO L=LAND_PTS+LAND1,LAND_FIELD ABX1F405.743
GPP(L,ITILE)=0. ABX1F405.744
NPP(L,ITILE)=0. ABX1F405.745
RESP_P(L,ITILE)=0. ABX1F405.746
ENDDO ABX1F405.747
ENDIF ABX1F405.748
ABX1F405.749
!----------------------------------------------------------------------- SFEXCH6A.1073
! Convert carbon fluxes to gridbox mean values SFEXCH6A.1074
!----------------------------------------------------------------------- SFEXCH6A.1075
SFEXCH6A.1076
SFEXCH6A.1077
DO L = LAND1,LAND1+LAND_PTS-1 SFEXCH6A.1078
SFEXCH6A.1079
GPP(L,ITILE) = VFRAC(L,ITILE) * GPP(L,ITILE) SFEXCH6A.1080
NPP(L,ITILE) = VFRAC(L,ITILE) * NPP(L,ITILE) SFEXCH6A.1081
RESP_P(L,ITILE) = VFRAC(L,ITILE) * RESP_P(L,ITILE) SFEXCH6A.1082
SFEXCH6A.1083
ENDDO ! Loop over land-points SFEXCH6A.1084
SFEXCH6A.1085
ENDIF ! INT_STOM SFEXCH6A.1086
SFEXCH6A.1087
SFEXCH6A.1088
!----------------------------------------------------------------------- SFEXCH6A.1089
!! 4.2 Recalculate RESFS using "true" CH and EPDT SFEXCH6A.1090
SFEXCH6A.1091
!----------------------------------------------------------------------- SFEXCH6A.1092
CDIR$ IVDEP SFEXCH6A.1098
! Fujitsu vectorization directive GRB0F405.491
!OCL NOVREC GRB0F405.492
DO L = LAND1,LAND1+LAND_PTS-1 SFEXCH6A.1099
I = LAND_INDEX(L) SFEXCH6A.1100
EPDT(I) = -PSTAR(I)/(R*TSTAR_TILE(I,ITILE))*CH_T(I,ITILE)* SFEXCH6A.1102
& DQ(I,ITILE)*TIMESTEP SFEXCH6A.1103
SFEXCH6A.1104
ENDDO ! Loop over land-points SFEXCH6A.1109
SFEXCH6A.1111
SFEXCH6A.1112
CALL SF_RESIST ( SFEXCH6A.1113
& P_POINTS,LAND_PTS,P_FIELD,LAND_FIELD,LAND_MASK,INT_STOM, SFEXCH6A.1114
& P1,LAND1, SFEXCH6A.1115
& LAND_INDEX, SFEXCH6A.1117
& ROOTD(1,ITILE),SMVCCL,SMVCWT,SMC(1,ITILE),V_SOIL, SFEXCH6A.1119
& VFRAC(1,ITILE),CANOPY,CATCH(1,ITILE),DQ(1,ITILE),EPDT, SFEXCH6A.1120
& LYING_SNOW,GC(1,ITILE),RESIST(1,ITILE),CH_T(1,ITILE), SFEXCH6A.1121
& PSIS(1,ITILE),FRACA(1,ITILE),RESFS(1,ITILE),F_SE(1,ITILE), SFEXCH6A.1122
& RESFT(1,ITILE),LTIMER SFEXCH6A.1123
& ) SFEXCH6A.1124
SFEXCH6A.1125
ENDDO ! loop over tiles SFEXCH6A.1126
SFEXCH6A.1127
SFEXCH6A.1128
!----------------------------------------------------------------------- SFEXCH6A.1129
!! 4.D Call SFL_INT to calculate CDR10M, CHR1P5M and CER1P5M - SFEXCH6A.1130
!! interpolation coefficients used in SF_EVAP and IMPL_CAL to SFEXCH6A.1131
!! calculate screen temperature, specific humidity and 10m winds. SFEXCH6A.1132
!----------------------------------------------------------------------- SFEXCH6A.1133
SFEXCH6A.1134
IF (SU10 .OR. SV10 .OR. SQ1P5 .OR. ST1P5) THEN SFEXCH6A.1135
SFEXCH6A.1136
!sjtemp ITILE=3 ! short grass tile SFEXCH6A.1137
SFEXCH6A.1138
ITILE=1 ! single tile mode only SFEXCH6A.1139
SFEXCH6A.1140
CALL SFL_INT ( SFEXCH6A.1141
& P_POINTS,P_FIELD,P1, SFEXCH6A.1142
& Z0M_EFF_T(1,ITILE),Z0H_T(1,ITILE),CD_T(1,ITILE),CH_T(1,ITILE), SFEXCH6A.1143
& Z0M_T(1,ITILE),CD_STD_T(1,ITILE), ARN0F405.1817
& RESFT(1,ITILE),RECIP_L_MO(1,ITILE), SFEXCH6A.1144
& V_S(1,ITILE),V_S_STD(1,ITILE), SFEXCH6A.1145
& CDR10M,CHR1P5M,CER1P5M, SFEXCH6A.1146
& SU10,SV10,ST1P5,SQ1P5, SFEXCH6A.1147
& LTIMER SFEXCH6A.1148
& ) SFEXCH6A.1149
SFEXCH6A.1150
ENDIF SFEXCH6A.1151
SFEXCH6A.1152
!----------------------------------------------------------------------- SFEXCH6A.1153
!! 4.2 Now that diagnostic calculations are over, update sea ice CD SFEXCH6A.1154
!! and CH to their correct values (i.e. gridsquare means). SFEXCH6A.1155
!----------------------------------------------------------------------- SFEXCH6A.1156
SFEXCH6A.1157
DO I=P1,P1+P_POINTS-1 SFEXCH6A.1158
IF ( ICE_FRACT(I).GT.0.0 .AND. .NOT.LAND_MASK(I) ) THEN SFEXCH6A.1159
IF ( ICE_FRACT(I).LT. 0.7 ) THEN SFEXCH6A.1160
CD_T(I,1) = ( ICE_FRACT(I)*CD_MIZ(I) + SFEXCH6A.1161
& (0.7-ICE_FRACT(I))*CD_LEAD(I) ) / 0.7 ! P2430.5 SFEXCH6A.1162
CH_T(I,1) = ( ICE_FRACT(I)*CH_MIZ(I) + SFEXCH6A.1163
& (0.7-ICE_FRACT(I))*CH_LEAD(I) ) / 0.7 ! P2430.4 SFEXCH6A.1164
CD_STD_T(I,1)=CD_T(I,1) ! for SCYCLE: no orog. over sea+ice SFEXCH6A.1165
ELSE SFEXCH6A.1166
CD_T(I,1) = ( (1.0-ICE_FRACT(I))*CD_MIZ(I) + SFEXCH6A.1167
& (ICE_FRACT(I)-0.7)*CD_T(I,1) ) / 0.3 ! P2430.7 SFEXCH6A.1168
CH_T(I,1) = ( (1.0-ICE_FRACT(I))*CH_MIZ(I) + SFEXCH6A.1169
& (ICE_FRACT(I)-0.7)*CH_T(I,1) ) / 0.3 ! P2430.7 SFEXCH6A.1170
CD_STD_T(I,1)=CD_T(I,1) ! for SCYCLE: no orog. over sea+ice SFEXCH6A.1171
ENDIF SFEXCH6A.1172
ENDIF SFEXCH6A.1173
SFEXCH6A.1174
ENDDO !loop over points for sea ice SFEXCH6A.1175
SFEXCH6A.1176
SFEXCH6A.1177
DO ITILE=1,N_TYPES SFEXCH6A.1178
DO I=P1,P1+P_POINTS-1 SFEXCH6A.1179
SFEXCH6A.1180
!----------------------------------------------------------------------- SFEXCH6A.1181
!! 4.3 Calculate the surface exchange coefficients RHOK(*). SFEXCH6A.1182
!----------------------------------------------------------------------- SFEXCH6A.1183
SFEXCH6A.1184
RHOSTAR(I,ITILE) = PSTAR(I) / ( R*TSTAR_TILE(I,ITILE) ) SFEXCH6A.1185
! ... surface air density from ideal gas equation SFEXCH6A.1186
SFEXCH6A.1187
RHOKM_1(I,ITILE) = RHOSTAR(I,ITILE) * CD_T(I,ITILE) SFEXCH6A.1188
! P243.124 SFEXCH6A.1189
RHOKH_1(I,ITILE) = RHOSTAR(I,ITILE) * CH_T(I,ITILE) SFEXCH6A.1190
! P243.125 SFEXCH6A.1191
RHOKE(I,ITILE) = RESFT(I,ITILE) * RHOKH_1(I,ITILE) SFEXCH6A.1192
SFEXCH6A.1193
! Calculate resistances for use in Sulphur Cycle SFEXCH6A.1194
! (Note that CD_STD, CH and VSHR should never = 0) SFEXCH6A.1195
RHO_ARESIST(I) = RHO_ARESIST(I) + TILE_FRAC(I,ITILE) * SFEXCH6A.1196
& (RHOSTAR(I,ITILE) * CD_STD_T(I,ITILE)) SFEXCH6A.1197
SFEXCH6A.1198
ARESIST(I) = ARESIST(I) + TILE_FRAC(I,ITILE) / SFEXCH6A.1199
& CD_STD_T(I,ITILE) SFEXCH6A.1200
SFEXCH6A.1201
RESIST_B(I)= RESIST_B(I) + TILE_FRAC(I,ITILE)* SFEXCH6A.1202
& (CD_STD_T(I,ITILE)/CH_T(I,ITILE) - 1.0) / SFEXCH6A.1203
& CD_STD_T(I,ITILE) SFEXCH6A.1204
SFEXCH6A.1205
! RHOSTAR * CD * VSHR stored for diagnostic output before SFEXCH6A.1206
! horizontal interpolation. SFEXCH6A.1207
SFEXCH6A.1208
ENDDO ! loop over p-points SFEXCH6A.1209
ENDDO ! n_types SFEXCH6A.1210
SFEXCH6A.1211
SFEXCH6A.1212
DO ITILE=1,N_TYPES SFEXCH6A.1213
IF(ITILE.EQ.1) THEN SFEXCH6A.1214
L_LAND=.FALSE. SFEXCH6A.1215
ELSE SFEXCH6A.1216
L_LAND=.TRUE. SFEXCH6A.1217
ENDIF SFEXCH6A.1218
SFEXCH6A.1219
CALL SF_FLUX ( SFEXCH6A.1220
& P_POINTS,P_FIELD,LAND_PTS,LAND_FIELD,LAND_MASK,L_LAND,P1,LAND1, SFEXCH6A.1221
& LAND_INDEX, SFEXCH6A.1223
& ALPHA1(1,ITILE),DQ(1,ITILE),DQ_LEAD,DTEMP(1,ITILE),DTEMP_LEAD, SFEXCH6A.1225
& DZSOIL,HCONS,ICE_FRACT, SFEXCH6A.1226
& LYING_SNOW,QS_BLEND,QW_BLEND,RADNET_C(1,ITILE),RESFT(1,ITILE), APA1F405.445
& RHOKE(1,ITILE),RHOKH_1(1,ITILE),TI,TL_BLEND,TS1, SFEXCH6A.1228
& Z0H_T(1,ITILE),Z0M_EFF_T(1,ITILE),Z1_TQ,Z1_UV, SFEXCH6A.1229
& ASHTF,E_SEA,EPOT(1,ITILE),FQW_1(1,ITILE),FTL_1(1,ITILE),H_SEA, ANG1F405.135
& RHOKPM(1,ITILE),RHOKPM_POT(1,ITILE),LTIMER ANG1F405.136
&, TSTAR_TILE(1,ITILE),VFRAC(1,ITILE),TIMESTEP,CANCAP(1,ITILE) APA1F405.446
& ) SFEXCH6A.1232
SFEXCH6A.1233
ENDDO ! n_types SFEXCH6A.1234
SFEXCH6A.1235
DO ITILE=1,N_TYPES SFEXCH6A.1236
CDIR$ IVDEP SFEXCH6A.1242
! Fujitsu vectorization directive GRB0F405.493
!OCL NOVREC GRB0F405.494
DO L = LAND1,LAND1+LAND_PTS-1 SFEXCH6A.1243
I = LAND_INDEX(L) SFEXCH6A.1244
! average fluxes, resistances and other things SFEXCH6A.1246
SFEXCH6A.1247
FTL1_GB(I)=FTL1_GB(I)+FTL_1(I,ITILE)*TILE_FRAC(I,ITILE) SFEXCH6A.1248
FQW1_GB(I)=FQW1_GB(I)+FQW_1(I,ITILE)*TILE_FRAC(I,ITILE) SFEXCH6A.1249
EPOT_GB(I)=EPOT_GB(I)+EPOT(I,ITILE)*TILE_FRAC(I,ITILE) ANG1F405.128
SFEXCH6A.1250
RESFS_GB(I) = RESFS_GB(I) + SFEXCH6A.1251
& TILE_FRAC(I,ITILE) * RESFS(I,ITILE) SFEXCH6A.1252
RESFT_GB(I) = RESFT_GB(I) + SFEXCH6A.1253
& TILE_FRAC(I,ITILE) * RESFT(I,ITILE) SFEXCH6A.1254
SFEXCH6A.1255
RHOKH_1_GB(I) = RHOKH_1_GB(I) + SFEXCH6A.1256
& RHOKH_1(I,ITILE) * TILE_FRAC(I,ITILE) SFEXCH6A.1257
RHOKM_1_GB(I) = RHOKM_1_GB(I) + SFEXCH6A.1258
& RHOKM_1(I,ITILE) * TILE_FRAC(I,ITILE) SFEXCH6A.1259
RHOKE_GB(I) = RHOKE_GB(I) + SFEXCH6A.1260
& RHOKE(I,ITILE) * TILE_FRAC(I,ITILE) SFEXCH6A.1261
RHOKPM_GB(I) = RHOKPM_GB(I) + SFEXCH6A.1262
& RHOKPM(I,ITILE) * TILE_FRAC(I,ITILE) SFEXCH6A.1263
RHOKPM_POT_GB(I) = RHOKPM_POT_GB(I) + ANG1F405.129
& RHOKPM_POT(I,ITILE) * TILE_FRAC(I,ITILE) ANG1F405.130
FSMC_GB(L) = FSMC_GB(L) + ANG1F405.131
& FSMC(L,ITILE) * TILE_FRAC(I,ITILE) ANG1F405.132
SFEXCH6A.1264
ALPHA1_GB(I) = ALPHA1_GB(I) + SFEXCH6A.1265
& ALPHA1(I,ITILE) * TILE_FRAC(I,ITILE) SFEXCH6A.1266
SFEXCH6A.1267
CD(I) = CD(I) + CD_T(I,ITILE) * TILE_FRAC(I,ITILE) SFEXCH6A.1268
SFEXCH6A.1269
CD_STD(I) = CD_STD(I) + SFEXCH6A.1270
& CD_STD_T(I,ITILE) * TILE_FRAC(I,ITILE) SFEXCH6A.1271
SFEXCH6A.1272
CH(I) = CH(I) + CH_T(I,ITILE) * TILE_FRAC(I,ITILE) SFEXCH6A.1273
SFEXCH6A.1274
BT1_GB(I) = BT1_GB(I) + BT_1(I,ITILE) * TILE_FRAC(I,ITILE) SFEXCH6A.1275
BQ1_GB(I) = BQ1_GB(I) + BQ_1(I,ITILE) * TILE_FRAC(I,ITILE) SFEXCH6A.1276
RHOSTAR_GB(I) = PSTAR(I) / ( R*TSTAR_GB(I) ) SFEXCH6A.1277
! ... surface air density from ideal gas equation SFEXCH6A.1278
SFEXCH6A.1279
SFEXCH6A.1280
ENDDO ! Loop over land-points SFEXCH6A.1285
SFEXCH6A.1287
ENDDO ! loop over tiles SFEXCH6A.1288
SFEXCH6A.1289
SFEXCH6A.1290
DO I=P1,P1+P_POINTS-1 SFEXCH6A.1291
IF(.NOT.LAND_MASK(I)) THEN SFEXCH6A.1292
FTL1_GB(I) = FTL_1(I,1) SFEXCH6A.1293
FQW1_GB(I) = FQW_1(I,1) SFEXCH6A.1294
EPOT_GB(I) = EPOT(I,1) ANG1F405.133
SFEXCH6A.1295
RESFS_GB(I) = RESFS(I,1) SFEXCH6A.1296
RESFT_GB(I) = RESFT(I,1) SFEXCH6A.1297
SFEXCH6A.1298
RHOKH_1_GB(I) = RHOKH_1(I,1) SFEXCH6A.1299
RHOKM_1_GB(I) = RHOKM_1(I,1) SFEXCH6A.1300
RHOKE_GB(I) = RHOKE(I,1) SFEXCH6A.1301
RHOKPM_GB(I) = RHOKPM(I,1) SFEXCH6A.1302
RHOKPM_POT_GB(I) = RHOKPM_POT(I,1) ANG1F405.134
SFEXCH6A.1303
ALPHA1_GB(I) = ALPHA1(I,1) SFEXCH6A.1304
SFEXCH6A.1305
CD(I) = CD_T(I,1) SFEXCH6A.1306
CD_STD(I) = CD_STD_T(I,1) SFEXCH6A.1307
CH(I) = CH_T(I,1) SFEXCH6A.1308
SFEXCH6A.1309
BT1_GB(I) = BT_1(I,1) SFEXCH6A.1310
BQ1_GB(I) = BQ_1(I,1) SFEXCH6A.1311
RHOSTAR_GB(I) = RHOSTAR(I,1) SFEXCH6A.1312
SFEXCH6A.1313
ENDIF SFEXCH6A.1314
SFEXCH6A.1315
RHO_CD_MODV1(I) = RHOKM_1_GB(I) ! diagnostic required for VAR SFEXCH6A.1316
SFEXCH6A.1317
ENDDO SFEXCH6A.1318
SFEXCH6A.1319
!----------------------------------------------------------------------- SFEXCH6A.1320
!! 4.4 Calculate the standard deviations of layer 1 turbulent SFEXCH6A.1321
!! fluctuations of temperature and humidity using approximate SFEXCH6A.1322
!! formulae from first order closure. SFEXCH6A.1323
!----------------------------------------------------------------------- SFEXCH6A.1324
DO I=P1,P1+P_POINTS-1 SFEXCH6A.1325
SFEXCH6A.1326
U_S(I) = SQRT(CD(I) * VSHR(I)) ARN0F405.1818
FB_SURF(I) = G * ( BT1_GB(I)*FTL1_GB(I) + SFEXCH6A.1328
& BQ1_GB(I)*FQW1_GB(I) ) / RHOSTAR_GB(I) SFEXCH6A.1329
SFEXCH6A.1330
W_S_CUBED = 75.0 * FB_SURF(I) SFEXCH6A.1331
C ! 75.0 = 2.5 * height above the surface of 30 m SFEXCH6A.1332
C !--------------------------------------------------------------- SFEXCH6A.1333
C ! Only calculate standard deviations for unstable surface layers SFEXCH6A.1334
C !--------------------------------------------------------------- SFEXCH6A.1335
IF (W_S_CUBED .GT. 0.0) THEN SFEXCH6A.1336
W_M = ( W_S_CUBED + U_S(I) * U_S(I) * U_S(I) ) ** (1.0/3.0) SFEXCH6A.1337
T1_SD(I) = 1.93 * FTL1_GB(I) / (RHOSTAR_GB(I) * W_M) SFEXCH6A.1338
Q1_SD(I) = 1.93 * FQW1_GB(I) / (RHOSTAR_GB(I) * W_M) SFEXCH6A.1339
TV1_SD(I) = T_1(I) * SFEXCH6A.1340
& ( 1.0 + C_VIRTUAL*Q_1(I) - QCL_1(I) - QCF_1(I) ) * SFEXCH6A.1341
& ( BT1_GB(I)*T1_SD(I) + BQ1_GB(I)*Q1_SD(I) ) SFEXCH6A.1342
T1_SD(I) = MAX ( 0.0 , T1_SD(I) ) SFEXCH6A.1343
Q1_SD(I) = MAX ( 0.0 , Q1_SD(I) ) SFEXCH6A.1344
IF (TV1_SD(I) .LE. 0.0) THEN SFEXCH6A.1345
TV1_SD(I) = 0.0 SFEXCH6A.1346
T1_SD(I) = 0.0 SFEXCH6A.1347
Q1_SD(I) = 0.0 SFEXCH6A.1348
ENDIF SFEXCH6A.1349
ELSE SFEXCH6A.1350
T1_SD(I) = 0.0 SFEXCH6A.1351
Q1_SD(I) = 0.0 SFEXCH6A.1352
TV1_SD(I) = 0.0 SFEXCH6A.1353
ENDIF SFEXCH6A.1354
!----------------------------------------------------------------------- SFEXCH6A.1355
!! 4.5 For diagnostic output calculate the dimensionless surface SFEXCH6A.1356
!! transfer coefficients. SFEXCH6A.1357
!---------------------------------------------------------------------- SFEXCH6A.1358
CD(I) = CD(I) / VSHR(I) SFEXCH6A.1359
CH(I) = CH(I) / VSHR(I) SFEXCH6A.1360
! SFEXCH6A.1361
ENDDO SFEXCH6A.1362
SFEXCH6A.1363
!----------------------------------------------------------------------- SFEXCH6A.1364
!! 4.6 For sea points, calculate the wind mixing energy flux and the SFEXCH6A.1365
!! sea-surface roughness length on the P-grid, using time-level n SFEXCH6A.1366
!! quantities. SFEXCH6A.1367
!----------------------------------------------------------------------- SFEXCH6A.1368
SFEXCH6A.1369
DO I=P1,P1+P_POINTS-1 SFEXCH6A.1370
SFEXCH6A.1371
IF (.NOT.LAND_MASK(I)) THEN SFEXCH6A.1372
TAU = RHOSTAR_GB(I) * V_S(I,1) * V_S(I,1) SFEXCH6A.1373
IF (ICE_FRACT(I) .GT. 0.0) SFEXCH6A.1374
& TAU = RHOSTAR_GB(I) * V_S_LEAD(I) * V_S_LEAD(I) SFEXCH6A.1375
IF (SFME) FME(I) = (1.0-ICE_FRACT(I)) * TAU * SQRT(TAU/RHOSEA) SFEXCH6A.1376
! ! P243.96 SFEXCH6A.1377
Z0MSEA(I) = 1.54E-6 / SQRT(TAU / RHOSTAR_GB(I)) + SFEXCH6A.1378
& (CHARNOCK/G) * (TAU / RHOSTAR_GB(I)) SFEXCH6A.1379
! ... (S.Smith formula) SFEXCH6A.1380
ENDIF ! of IF (.NOT. LAND_MASK), land-points done in next loop. SFEXCH6A.1384
ENDDO ! Loop over points for sections 4.2 - 4.6 SFEXCH6A.1385
DO L=LAND1,LAND1+LAND_PTS-1 SFEXCH6A.1386
I = LAND_INDEX(L) SFEXCH6A.1387
SFEXCH6A.1389
!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - SFEXCH6A.1390
!! 4.7 Set Z0MSEA to Z0V, FME to zero for land points. SFEXCH6A.1391
! (Former because UM uses same storage for Z0V SFEXCH6A.1392
! and Z0MSEA.) SFEXCH6A.1393
!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - SFEXCH6A.1394
SFEXCH6A.1395
Z0MSEA(I) = Z0V_GB(I) SFEXCH6A.1396
SFEXCH6A.1397
IF (SFME) FME(I) = 0.0 SFEXCH6A.1398
SFEXCH6A.1399
ENDDO ! Loop over points for section 4.7 SFEXCH6A.1405
SFEXCH6A.1407
IF (LTIMER) THEN SFEXCH6A.1408
CALL TIMER('SFEXCH ',4) SFEXCH6A.1409
ENDIF SFEXCH6A.1410
SFEXCH6A.1411
RETURN SFEXCH6A.1412
END SFEXCH6A.1413
*ENDIF SFEXCH6A.1414