*IF DEF,A03_5A SFEXCH5A.2
C *****************************COPYRIGHT****************************** SFEXCH5A.3
C (c) CROWN COPYRIGHT 1996, METEOROLOGICAL OFFICE, All Rights Reserved. SFEXCH5A.4
C SFEXCH5A.5
C Use, duplication or disclosure of this code is subject to the SFEXCH5A.6
C restrictions as set forth in the contract. SFEXCH5A.7
C SFEXCH5A.8
C Meteorological Office SFEXCH5A.9
C London Road SFEXCH5A.10
C BRACKNELL SFEXCH5A.11
C Berkshire UK SFEXCH5A.12
C RG12 2SZ SFEXCH5A.13
C SFEXCH5A.14
C If no contract has been raised with this copy of the code, the use, SFEXCH5A.15
C duplication or disclosure of it is strictly prohibited. Permission SFEXCH5A.16
C to do so must first be obtained in writing from the Head of Numerical SFEXCH5A.17
C Modelling at the above address. SFEXCH5A.18
C ******************************COPYRIGHT****************************** SFEXCH5A.19
C*LL SUBROUTINE SF_EXCH------------------------------------------------ SFEXCH5A.20
CLL SFEXCH5A.21
CLL Purpose: Calculate coefficients of turbulent exchange between SFEXCH5A.22
CLL the surface and the lowest atmospheric layer, and SFEXCH5A.23
CLL "explicit" fluxes between the surface and this layer. SFEXCH5A.24
CLL SFEXCH5A.25
CLL Suitable for Single Column use. AJC1F405.93
CLL SFEXCH5A.27
CLL Canopy evaporation made implicit SFEXCH5A.28
CLL with respect to canopy water content (requiring TIMESTEP to be SFEXCH5A.29
CLL passed in). SFEXCH5A.30
CLL SFEXCH5A.31
CLL Model Modification history: SFEXCH5A.32
CLL version Date SFEXCH5A.33
CLL 4.1 07/05/96 New deck. M.J.Woodage SFEXCH5A.34
CLL 4.2 Oct. 96 T3E migration - *DEF CRAY removed GSS2F402.291
CLL S J Swarbrick GSS2F402.292
!LL 4.3 14/01/97 MPP code : Corrected setting of polar rows GPB1F403.45
!LL P.Burton GPB1F403.46
CLL 4.3 15/05/97 By-pass call to SF_STOM when land points=0 to ARR0F403.22
CLL prevent occasional failures with MPP. R.Rawlins ARR0F403.23
CLL 4.3 09/06/97 Add swapbounds for CDR10M. D.Sexton/RTHBarnes ASJ1F403.20
CLL 4.4 08/09/97 L_BL_LSPICE specifies mixed phase precipitation ADM3F404.73
CLL scheme D.Wilson ADM3F404.74
CLL 4.5 20/08/98 Option to include a thermal plant canopy APA1F405.386
CLL M.Best APA1F405.387
CLL 4.5 Jul. 98 Kill the IBM specific lines (JCThil) AJC1F405.92
CLL SFEXCH5A.35
CLL Programming standard: Unified Model Documentation Paper No 4, SFEXCH5A.36
CLL Version 2, dated 18/1/90. SFEXCH5A.37
CLL SFEXCH5A.38
CLL System component covered: Part of P243. SFEXCH5A.39
CLL SFEXCH5A.40
CLL Project task: SFEXCH5A.41
CLL SFEXCH5A.42
CLL Documentation: UM Documentation Paper No 24, section P243. SFEXCH5A.43
CLL See especially sub-section (ix). SFEXCH5A.44
CLL SFEXCH5A.45
CLLEND------------------------------------------------------------------ SFEXCH5A.46
C* SFEXCH5A.47
C*L Arguments --------------------------------------------------------- SFEXCH5A.48
SUBROUTINE SF_EXCH ( 4,99SFEXCH5A.49
& P_POINTS,LAND_PTS,U_POINTS,ROW_LENGTH,P_ROWS,U_ROWS SFEXCH5A.50
&,LAND_INDEX,P1,GATHER SFEXCH5A.52
&,AK_1,BK_1 SFEXCH5A.54
&,CANOPY,CATCH,CO2,CF_1,SM_LEVELS,DZSOIL,HCONS,F_TYPE SFEXCH5A.55
&,HT,LAI,PAR,GPP,NPP,RESP_P SFEXCH5A.56
&,ICE_FRACT,LAND_MASK,LYING_SNOW SFEXCH5A.57
&,PSTAR,Q_1,QCF_1,QCL_1,RADNET_C,GC,RESIST,ROOTD,SMC APA1F405.388
&,SMVCCL,SMVCWT SFEXCH5A.59
&,T_1,TIMESTEP,TI,TS1,TSTAR SFEXCH5A.60
&,U_1,V_1,U_1_P,V_1_P,U_0,V_0,V_ROOT,V_SOIL SFEXCH5A.61
&,VFRAC,Z0V,SIL_OROG,Z1,CANCAP,Z0MSEA,HO2R2_OROG APA1F405.389
&, ALPHA1,ASHTF,BQ_1,BT_1,BF_1,CD,CH ADM3F404.75
&,EPOT,FQW_1,FSMC,FTL_1,E_SEA,H_SEA,TAUX_1,TAUY_1,QW_1 ANG1F405.92
&,FRACA,RESFS,F_SE,RESFT,RHOKE,RHOKH_1,RHOKM_1 ANG1F405.93
&,RHOKPM,RHOKPM_POT ANG1F405.94
&,RIB,TL_1,VSHR,Z0H,Z0M,Z0M_EFF,H_BLEND SFEXCH5A.66
&,T1_SD,Q1_SD SFEXCH5A.67
&,RHO_CD_MODV1 SFEXCH5A.68
&,CDR10M,CHR1P5M,CER1P5M,FME SFEXCH5A.69
&,SU10,SV10,SQ1P5,ST1P5,SFME SFEXCH5A.70
&,RHO_ARESIST,ARESIST,RESIST_B SFEXCH5A.71
&,NRML SFEXCH5A.72
&,L_Z0_OROG,L_RMBL,L_BL_LSPICE,ERROR,LTIMER ADM3F404.76
*IF DEF,SCMA AJC0F405.102
& ,OBS AJC0F405.103
*ENDIF AJC0F405.104
&) SFEXCH5A.74
IMPLICIT NONE SFEXCH5A.75
C SFEXCH5A.76
C Input variables. All fields are on P grid except where noted. SFEXCH5A.77
C Fxxx in a comment indicates the file from which the data are taken. SFEXCH5A.78
C SFEXCH5A.79
C SFEXCH5A.81
C GENERAL NOTES ABOUT GRID-DEFINITION INPUT VARIABLES. SFEXCH5A.82
C ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ SFEXCH5A.83
C For global data :- SFEXCH5A.84
C SFEXCH5A.85
C An Arakawa B-grid is assumed in which each pole is represented by a SFEXCH5A.86
C row of P-grid points. These polar rows are omitted in the input and SFEXCH5A.87
C output of the present subroutine, so that the argument P_ROWS is two SFEXCH5A.88
C less than the total number of P-rows in the grid. Land specific SFEXCH5A.89
C variables that are required as INput by the higher level routine, SFEXCH5A.90
C BDY_LAYR, are stored on P_grid land points only and land pts on polar SFEXCH5A.91
C rows are not input or output by this routine ; diagnostic variables SFEXCH5A.92
C must be defined on land and sea points for post processing. SFEXCH5A.93
C If defined variable IBM is selected then land point calculations are SFEXCH5A.94
C performed using the array LAND_INDEX to select land points. But note SFEXCH5A.95
C that elements of LAND_INDEX define land points on the full field SFEXCH5A.96
C (ie including polar rows). SFEXCH5A.97
C SFEXCH5A.98
C Entire fields of UV-grid values are taken as input, but the two SFEXCH5A.99
C polemost rows are (a) not updated, in the case of INOUT fields, or SFEXCH5A.100
C (b) set to zero, in the case of OUT fields. SFEXCH5A.101
C SFEXCH5A.102
C For limited-area data :- SFEXCH5A.103
C SFEXCH5A.104
C The above applies, but for "polar rows", etc., read "rows at the SFEXCH5A.105
C north and south boundaries of the area", etc. E.g. if you want to SFEXCH5A.106
C do calculations in UV-rows n to m inclusive, the input data will be SFEXCH5A.107
C on P-rows n to m+1, and UV-rows n-1 to m+1. P-rows n to m will SFEXCH5A.108
C then be updated. Land specific variables are processed as for global SFEXCH5A.109
C data. SFEXCH5A.110
C SFEXCH5A.111
C For both cases, the following equalities apply amongst the input SFEXCH5A.112
C grid-definition variables :- SFEXCH5A.113
C SFEXCH5A.114
C P_POINTS = P_ROWS * ROW_LENGTH SFEXCH5A.115
C U_POINTS = U_ROWS * ROW_LENGTH SFEXCH5A.116
C U_ROWS = P_ROWS + 1 SFEXCH5A.117
C LAND_PTS <= P_POINTS SFEXCH5A.118
C SFEXCH5A.119
C An error condition is returned if the input variables don't satisfy SFEXCH5A.120
C these equalities. (There is of course redundancy here; a compromise SFEXCH5A.121
C between economy, clarity and easy dimensioning is intended.) SFEXCH5A.122
C SFEXCH5A.123
C NB: All this has severe implications for batching/macrotasking; SFEXCH5A.124
C effectively it can't be done on a shared-memory machine without SFEXCH5A.125
C either rewriting this routine or using expensive synchronizations SFEXCH5A.126
C (or other messy and/or undesirable subterfuges). SFEXCH5A.127
C SFEXCH5A.128
C SFEXCH5A.143
LOGICAL LTIMER SFEXCH5A.144
C SFEXCH5A.145
INTEGER ! Variables defining grid. SFEXCH5A.146
& P_POINTS ! IN Number of P-grid points to be processed. SFEXCH5A.147
&,LAND_PTS ! IN Number of land points to be processed. SFEXCH5A.148
&,U_POINTS ! IN Number of UV-grid points. SFEXCH5A.149
&,ROW_LENGTH ! IN No. of points in latitude row (inclusive SFEXCH5A.153
C ! of endpoints for ltd. area model). SFEXCH5A.154
&,P_ROWS ! IN Number of rows of data on P-grid. SFEXCH5A.158
&,U_ROWS ! IN Number of rows of data on UV-grid. SFEXCH5A.162
&,LAND_INDEX(LAND_PTS)! IN Index for compressed land point array; SFEXCH5A.166
C ! ith element holds position in the FULL SFEXCH5A.167
C ! field of the ith land pt to be processed SFEXCH5A.168
&,P1 ! IN First P-point to be processed. SFEXCH5A.169
SFEXCH5A.170
LOGICAL SFEXCH5A.171
& GATHER ! IN If true then leads variables are comp- SFEXCH5A.172
C ! ressed for sea-ice calculations. This SFEXCH5A.173
C ! saves duplicating calculations if there SFEXCH5A.174
C ! are a relatively few of sea-ice points. SFEXCH5A.175
C ! Set to false for a limited area run SFEXCH5A.176
C ! with a high proportion of sea-ice. SFEXCH5A.177
!--------------------------------------------------------------------- SFEXCH5A.179
! Extra variables for the interactive stomatal resistance model SFEXCH5A.180
!--------------------------------------------------------------------- SFEXCH5A.181
INTEGER SFEXCH5A.182
& SM_LEVELS ! IN Number of soil moisture levels SFEXCH5A.183
&,F_TYPE(LAND_PTS) ! IN Plant functional type: SFEXCH5A.184
C ! 1 - Broadleaf Tree SFEXCH5A.185
C ! 2 - Needleleaf Tree SFEXCH5A.186
C ! 3 - C3 Grass SFEXCH5A.187
C ! 4 - C4 Grass SFEXCH5A.188
SFEXCH5A.189
REAL SFEXCH5A.190
& HT(LAND_PTS) ! IN Canopy height (m). SFEXCH5A.191
&,LAI(LAND_PTS) ! IN Leaf area index. SFEXCH5A.192
&,PAR(P_POINTS) ! IN Photosynthetically active radiation SFEXCH5A.193
C ! (W/m2). SFEXCH5A.194
&,GPP(LAND_PTS) ! OUT Gross Primary Productivity SFEXCH5A.195
C ! (kg C/m2/s). SFEXCH5A.196
&,NPP(LAND_PTS) ! OUT Net Primary Productivity SFEXCH5A.197
C ! (kg C/m2/s). SFEXCH5A.198
&,RESP_P(LAND_PTS) ! OUT Plant respiration rate (kg C/m2/s). SFEXCH5A.199
SFEXCH5A.200
REAL SFEXCH5A.201
& AK_1 ! IN Hybrid "A" for lowest model layer. SFEXCH5A.202
&,BK_1 ! IN Hybrid "B" for lowest model layer. SFEXCH5A.203
&,CANOPY(LAND_PTS) ! IN Surface water (kg per sq metre). F642. SFEXCH5A.204
&,CATCH(LAND_PTS) ! IN Surface capacity (max. surface water) SFEXCH5A.205
C ! (kg per sq metre). F6416. SFEXCH5A.206
&,CF_1(P_POINTS) ! IN Cloud fraction for lowest atmospheric SFEXCH5A.207
C ! layer (decimal fraction). SFEXCH5A.208
&,CO2 ! IN CO2 mixing ratio (kg CO2/kg air). SFEXCH5A.209
&,DZSOIL(SM_LEVELS) ! IN Thicknesses of the soil layers (m). SFEXCH5A.210
&,HCONS(LAND_PTS) ! IN Soil thermal conductivity including SFEXCH5A.211
C ! the effects of water and ice (W/m/K). SFEXCH5A.212
&,ICE_FRACT(P_POINTS) ! IN Fraction of gridbox which is sea-ice. SFEXCH5A.213
&,LYING_SNOW(P_POINTS)! IN Lying snow amount (kg per sq metre). SFEXCH5A.214
&,PSTAR(P_POINTS) ! IN Surface pressure (Pascals). SFEXCH5A.215
&,Q_1(P_POINTS) ! IN Specific humidity for lowest atmospheric SFEXCH5A.216
C ! layer (kg water per kg air). SFEXCH5A.217
&,QCF_1(P_POINTS) ! IN Cloud ice for lowest atmospheric layer SFEXCH5A.218
C ! (kg water per kg air). SFEXCH5A.219
&,QCL_1(P_POINTS) ! IN Cloud liquid water for lowest atm layer SFEXCH5A.220
C ! (kg water per kg air). SFEXCH5A.221
&,GC(LAND_PTS) ! IN Interactive canopy conductance SFEXCH5A.224
C ! to evaporation (m/s) SFEXCH5A.225
&,RESIST(LAND_PTS) ! IN Fixed "stomatal" resistance SFEXCH5A.226
C ! to evaporation (s/m) SFEXCH5A.227
&,ROOTD(LAND_PTS) ! IN "Root depth" (metres). F6412. SFEXCH5A.228
&,SMC(LAND_PTS) ! IN Soil moisture content (kg per sq m). SFEXCH5A.229
C ! F621. SFEXCH5A.230
&,SMVCCL(LAND_PTS) ! IN Critical volumetric SMC (cubic metres SFEXCH5A.231
C ! per cubic metre of soil). F6232. SFEXCH5A.232
&,SMVCWT(LAND_PTS) ! IN Volumetric wilting point (cubic m of SFEXCH5A.233
C ! water per cubic m of soil). F6231. SFEXCH5A.234
C SFEXCH5A.235
C Note: (SMVCCL - SMVCWT) is the critical volumetric available soil SFEXCH5A.236
C moisture content. ~~~~~~~~~ SFEXCH5A.237
C SFEXCH5A.238
&,STHU(LAND_PTS,SM_LEVELS)! IN Unfrozen soil moisture content of SFEXCH5A.239
C ! each layer as a fraction of SFEXCH5A.240
C ! saturation. SFEXCH5A.241
C SFEXCH5A.242
REAL ! (Split to avoid > 19 continuations.) SFEXCH5A.243
& T_1(P_POINTS) ! IN Temperature for lowest atmospheric layer SFEXCH5A.244
C ! (Kelvin). SFEXCH5A.245
&,TIMESTEP ! IN Timestep in seconds for EPDT calc. SFEXCH5A.246
&,TI(P_POINTS) ! IN Temperature of sea-ice surface layer (K). SFEXCH5A.247
&,TS1(LAND_PTS) ! IN Temperature of top soil layer (K) SFEXCH5A.248
&,TSTAR(P_POINTS) ! IN Mean gridsquare surface temperature (K). SFEXCH5A.249
&,U_1(U_POINTS) ! IN West-to-east wind component for lowest SFEXCH5A.250
C ! atmospheric layer (m/s). On UV grid. SFEXCH5A.251
&,V_1(U_POINTS) ! IN South-to-north wind component for lowest SFEXCH5A.252
C ! atmospheric layer (m/s). On UV grid. SFEXCH5A.253
&,U_1_P(P_POINTS) ! IN West-to-east wind component for lowest SFEXCH5A.254
C ! atmospheric layer (m/s). On P grid. SFEXCH5A.255
C ! (Same as U_1 for Single Column Model.) SFEXCH5A.257
&,V_1_P(P_POINTS) ! IN South-to-north wind component for lowest SFEXCH5A.259
C ! atmospheric layer (m/s). On P grid. SFEXCH5A.260
C ! (Same as V_1 for Single Column Model.) SFEXCH5A.262
&,U_0(U_POINTS) ! IN West-to-east component of ocean surface SFEXCH5A.264
C ! current (m/s; ASSUMED zero over land). SFEXCH5A.265
C ! UV grid. F615. SFEXCH5A.266
&,V_0(U_POINTS) ! IN South-to-north component of ocean surface SFEXCH5A.267
C ! current (m/s; ASSUMED zero over land). SFEXCH5A.268
C ! UV grid. F616. SFEXCH5A.269
&,V_ROOT(LAND_PTS) ! IN Volumetric soil moisture concentration SFEXCH5A.270
C ! in the rootzone (m3 H2O/m3 soil). SFEXCH5A.271
&,V_SOIL(LAND_PTS) ! IN Volumetric soil moisture concentration SFEXCH5A.272
C ! in the top soil layer (m3 H2O/m3 soil). SFEXCH5A.273
&,VFRAC(LAND_PTS) ! IN Vegetated fraction. SFEXCH5A.274
&,Z0V(P_POINTS) ! IN Vegetative roughness length (m). F6418. SFEXCH5A.275
&,SIL_OROG(LAND_PTS) ! IN Silhouette area of unresolved orography SFEXCH5A.276
C ! per unit horizontal area SFEXCH5A.277
&,Z1(P_POINTS) ! IN Height of lowest atmospheric level (m). SFEXCH5A.278
&,HO2R2_OROG(LAND_PTS) ! IN Peak to trough height of unresolved SFEXCH5A.279
C ! orography devided by 2SQRT(2) (m). SFEXCH5A.280
LOGICAL SFEXCH5A.281
& LAND_MASK(P_POINTS) ! IN .TRUE. for land; .FALSE. elsewhere. F60. SFEXCH5A.282
&,SU10 ! IN STASH flag for 10-metre W wind. SFEXCH5A.283
&,SV10 ! IN STASH flag for 10-metre S wind. SFEXCH5A.284
&,SQ1P5 ! IN STASH flag for 1.5-metre sp humidity. SFEXCH5A.285
&,ST1P5 ! IN STASH flag for 1.5-metre temperature. SFEXCH5A.286
&,SFME ! IN STASH flag for wind mixing energy flux. SFEXCH5A.287
+,L_RMBL ! IN T to use rapidly mixing boundary SFEXCH5A.288
C ! scheme in IMPL_CAL SFEXCH5A.289
&,L_BL_LSPICE ! IN ADM3F404.77
! TRUE Use scientific treatment of mixed ADM3F404.78
! phase precip scheme. ADM3F404.79
! FALSE Do not use mixed phase precip ADM3F404.80
! considerations ADM3F404.81
&,L_Z0_OROG ! IN .TRUE. to use orographic roughness. SFEXCH5A.290
*IF DEF,SCMA AJC0F405.105
LOGICAL OBS ! Switch for OBS forcing AJC0F405.106
*ENDIF AJC0F405.107
C SFEXCH5A.291
C Modified (INOUT) variables. SFEXCH5A.292
C SFEXCH5A.293
REAL SFEXCH5A.294
& CANCAP(P_POINTS) ! INOUT Volumetric heat capacity of APA1F405.390
C ! vegetation canopy (J/Kg/m3). APA1F405.391
&,RADNET_C(P_POINTS) ! INOUT Adjusted net radiation for vegetation APA1F405.392
C ! over land (W/m2). APA1F405.393
&,Z0MSEA(P_POINTS) ! INOUT Sea-surface roughness length for APA1F405.394
C ! momentum (m). F617. SFEXCH5A.296
C SFEXCH5A.297
C Output variables. SFEXCH5A.298
C SFEXCH5A.299
REAL SFEXCH5A.300
& ALPHA1(P_POINTS) ! OUT Gradient of saturated specific humidity SFEXCH5A.301
C ! with respect to temperature between the SFEXCH5A.302
C ! bottom model layer and the surface SFEXCH5A.303
&,ASHTF(P_POINTS) ! OUT Coefficient to calculate surface SFEXCH5A.304
C ! heat flux into soil or sea-ice (W/m2/K). SFEXCH5A.305
&,BQ_1(P_POINTS) ! OUT A buoyancy parameter for lowest atm level SFEXCH5A.306
C ! ("beta-q twiddle"). SFEXCH5A.307
&,BT_1(P_POINTS) ! OUT A buoyancy parameter for lowest atm level. SFEXCH5A.308
C ! ("beta-T twiddle"). SFEXCH5A.309
&,BF_1(P_POINTS) ADM3F404.82
! OUT A buoyancy parameter for lowest atm level. ADM3F404.83
! ("beta-F twiddle"). ADM3F404.84
&,CD(P_POINTS) ! OUT Bulk transfer coefficient for momentum. SFEXCH5A.310
&,CH(P_POINTS) ! OUT Bulk transfer coefficient for heat and/or SFEXCH5A.311
C ! moisture. SFEXCH5A.312
&,CDR10M(U_POINTS) ! OUT Reqd for calculation of 10m wind (u & v). SFEXCH5A.313
C ! NBB: This is output on the UV-grid, but SFEXCH5A.314
C ! with the first and last rows set to a SFEXCH5A.315
C ! "missing data indicator". SFEXCH5A.316
C ! Sea-ice leads ignored. See 3.D.7 below. SFEXCH5A.317
&,CHR1P5M(P_POINTS)! OUT Reqd for calculation of 1.5m temperature. SFEXCH5A.318
C ! Sea-ice leads ignored. See 3.D.7 below. SFEXCH5A.319
&,CER1P5M(P_POINTS)! OUT Reqd for calculation of 1.5m sp humidity. SFEXCH5A.320
C ! Sea-ice leads ignored. See 3.D.7 below. SFEXCH5A.321
&,RHO_CD_MODV1(P_POINTS) SFEXCH5A.322
C ! OUT rhostar*cD*vshr before horizontal SFEXCH5A.323
C ! interpolation output as a diagnostic. SFEXCH5A.324
REAL ! (Split to avoid > 19 continuations.) SFEXCH5A.325
& EPOT(P_POINTS) ! OUT potential evaporation on P-grid ANG1F405.95
C ! (kg/m2/s). ANG1F405.96
&,FQW_1(P_POINTS) ! OUT "Explicit" surface flux of QW (i.e. ANG1F405.97
C ! evaporation), on P-grid (kg/m2/s). ANG1F405.98
&,FTL_1(P_POINTS) ! OUT "Explicit" surface flux of TL = H/CP. SFEXCH5A.328
C ! (sensible heat / CP). SFEXCH5A.329
&,FSMC(LAND_PTS) ! OUT soil moisture availability. ANG1F405.99
&,FRACA(P_POINTS) ! OUT Fraction of surface moisture flux with SFEXCH5A.330
C ! only aerodynamic resistance. SFEXCH5A.331
&,E_SEA(P_POINTS) ! OUT Evaporation from sea times leads SFEXCH5A.332
C ! fraction (kg/m2/s). Zero over land. SFEXCH5A.333
&,H_SEA(P_POINTS) ! OUT Surface sensible heat flux over sea SFEXCH5A.334
C ! times leads fraction (W/m2). SFEXCH5A.335
C ! Zero over land. SFEXCH5A.336
&,TAUX_1(U_POINTS) ! OUT "Explicit" x-component of surface SFEXCH5A.337
C ! turbulent stress; on UV-grid; first and SFEXCH5A.338
C ! last rows set to a "missing data SFEXCH5A.339
C ! indicator". (Newtons per square metre) SFEXCH5A.340
&,TAUY_1(U_POINTS) ! OUT "Explicit" y-component of surface SFEXCH5A.341
C ! turbulent stress; on UV-grid; first and SFEXCH5A.342
C ! last rows set to a "missing data SFEXCH5A.343
C ! indicator". (Newtons per square metre) SFEXCH5A.344
&,QW_1(P_POINTS) ! OUT Total water content of lowest SFEXCH5A.345
C ! atmospheric layer (kg per kg air). SFEXCH5A.346
&,RESFS(P_POINTS) ! OUT Combined soil, stomatal and aerodynamic SFEXCH5A.347
C ! resistance factor = PSIS/(1+RS/RA) for SFEXCH5A.348
C ! fraction (1-FRACA) SFEXCH5A.349
&,F_SE(P_POINTS) ! OUT Fraction of the evapotranspiration which SFEXCH5A.350
C ! is bare soil evaporation. SFEXCH5A.351
&,RESFT(P_POINTS) ! OUT Total resistance factor SFEXCH5A.352
C ! FRACA+(1-FRACA)*RESFS. SFEXCH5A.353
C SFEXCH5A.354
REAL ! Surface exchange coefficients;passed to subroutine IMPL_CAL SFEXCH5A.355
& RHOKE(P_POINTS) ! OUT For FQW, then *GAMMA(1) for implicit calc SFEXCH5A.356
&,RHOKH_1(P_POINTS) ! OUT For FTL,then *GAMMA(1) for implicit calcs SFEXCH5A.357
&,RHOKM_1(U_POINTS) ! OUT For momentum, then *GAMMA(1) for implicit SFEXCH5A.358
C ! calculations. NBB: This is output on the SFEXCH5A.359
C ! UV-grid, but with the first and last SFEXCH5A.360
C ! rows set to a "missing data indicator". SFEXCH5A.361
&,RHOKPM(P_POINTS) ! OUT NB NOT * GAMMA for implicit calcs. SFEXCH5A.362
&,RHOKPM_POT(P_POINTS) ANG1F405.100
C ! OUT Surface exchange coeff. for ANG1F405.101
C potential evaporation. ANG1F405.102
&,Z0M_EFF(P_POINTS) ! OUT Effective roughness length for momentum SFEXCH5A.363
&,H_BLEND(P_POINTS) ! OUT Blending height SFEXCH5A.364
&,T1_SD(P_POINTS) ! OUT Standard deviation of turbulent SFEXCH5A.365
C ! fluctuations of surface layer SFEXCH5A.366
C ! temperature (K). SFEXCH5A.367
&,Q1_SD(P_POINTS) ! OUT Standard deviation of turbulent SFEXCH5A.368
C ! fluctuations of surface layer SFEXCH5A.369
C ! specific humidity (kg/kg). SFEXCH5A.370
&,RIB(P_POINTS) ! OUT Bulk Richardson number for lowest layer. SFEXCH5A.371
&,TL_1(P_POINTS) ! OUT Liquid/frozen water temperature for SFEXCH5A.372
C ! lowest atmospheric layer (K). SFEXCH5A.373
&,VSHR(P_POINTS) ! OUT Magnitude of surface-to-lowest-lev. wind SFEXCH5A.374
&,Z0H(P_POINTS) ! OUT Roughness length for heat and moisture m SFEXCH5A.375
&,Z0M(P_POINTS) ! OUT Roughness length for momentum (m). SFEXCH5A.376
&,FME(P_POINTS) ! OUT Wind mixing energy flux (Watts/sq m). SFEXCH5A.377
&,RHO_ARESIST(P_POINTS) ! OUT, RHOSTAR*CD_STD*VSHR for SCYCLE SFEXCH5A.378
&,ARESIST(P_POINTS) ! OUT, 1/(CD_STD*VSHR) for SCYCLE SFEXCH5A.379
&,RESIST_B(P_POINTS) ! OUT, (1/CH-1/CD_STD)/VSHR for SCYCLE SFEXCH5A.380
C SFEXCH5A.381
INTEGER SFEXCH5A.382
& NRML(P_POINTS) ! OUT 1 if surface layer unstable, else 0. SFEXCH5A.383
&,ERROR ! OUT 1 if grid definition faulty; else 0. SFEXCH5A.384
C* SFEXCH5A.385
C*L Symbolic constants ------------------------------------------------ SFEXCH5A.386
C SFEXCH5A.387
C (1) UM-wide common parameters. SFEXCH5A.388
C SFEXCH5A.389
*CALL C_0_DG_C 
SFEXCH5A.390
*CALL C_LHEAT SFEXCH5A.391
*CALL C_G SFEXCH5A.392
*CALL C_R_CP SFEXCH5A.393
*CALL C_EPSLON SFEXCH5A.394
*CALL C_VKMAN SFEXCH5A.395
*CALL C_MDI SFEXCH5A.396
SFEXCH5A.397
C SFEXCH5A.398
C (2) Boundary Layer local parameters. SFEXCH5A.399
C SFEXCH5A.400
*CALL C_CHARNK SFEXCH5A.401
*CALL C_DENSTY SFEXCH5A.402
*CALL C_GAMMA SFEXCH5A.403
*CALL C_HT_M SFEXCH5A.404
*CALL C_ROUGH SFEXCH5A.405
*CALL C_SURF SFEXCH5A.406
*CALL C_SOILH SFEXCH5A.407
*CALL C_KAPPAI SFEXCH5A.408
*CALL C_SICEHC SFEXCH5A.409
SFEXCH5A.410
C SFEXCH5A.411
C (3) Derived local parameters. SFEXCH5A.412
C SFEXCH5A.413
REAL ETAR,GRCP,LCRCP,LFRCP,LS,LSRCP,H_BLEND_MIN,H_BLEND_MAX SFEXCH5A.414
SFEXCH5A.415
PARAMETER ( SFEXCH5A.416
& ETAR=1./(1.-EPSILON) ! Used in calc of buoyancy parameter BETAC. SFEXCH5A.417
&,GRCP=G/CP ! Used in calc of dT across surface layer. SFEXCH5A.418
&,LCRCP=LC/CP ! Evaporation-to-dT conversion factor. SFEXCH5A.419
&,LFRCP=LF/CP ! Freezing-to-dT conversion factor. SFEXCH5A.420
&,LS=LF+LC ! Latent heat of sublimation. SFEXCH5A.421
&,LSRCP=LS/CP ! Sublimation-to-dT conversion factor. SFEXCH5A.422
&,H_BLEND_MIN=0.0 ! Minimum blending height. SFEXCH5A.423
&,H_BLEND_MAX=1000.0 ! Maximum blending height (m). SFEXCH5A.424
&) SFEXCH5A.425
C* SFEXCH5A.426
*IF DEF,MPP GPB1F403.47
! MPP Common block GPB1F403.48
*CALL PARVARS GPB1F403.49
*ENDIF GPB1F403.50
C*L SFEXCH5A.427
C External subprograms called. SFEXCH5A.428
C SFEXCH5A.429
EXTERNAL SF_ROUGH,SF_RIB,FCDCH,QSAT,SFL_INT,SF_FLUX,SF_STOM SFEXCH5A.430
&,QSAT_WAT ADM3F404.85
*IF -DEF,SCMA AJC1F405.94
EXTERNAL P_TO_UV,UV_TO_P GSS1F403.53
*ENDIF SFEXCH5A.433
EXTERNAL TIMER SFEXCH5A.434
C* SFEXCH5A.435
C SFEXCH5A.436
C Define local storage. SFEXCH5A.437
C SFEXCH5A.438
C (a) Workspace. SFEXCH5A.439
C SFEXCH5A.440
C*L Workspace --------------------------------------------------------- SFEXCH5A.441
C 25 blocks of real workspace are required, as follows. SFEXCH5A.443
REAL SFEXCH5A.444
& CD_LEAD(P_POINTS) ! Bulk transfer coefficient for momentum SFEXCH5A.445
C ! over sea-ice leads.Missing data over non SFEXCH5A.446
C ! sea-ice points.(Temporary store for Z0MIZ) SFEXCH5A.447
&,CD_MIZ(P_POINTS) ! Bulk transfer coefficient for momentum SFEXCH5A.448
C ! over the sea-ice Marginal Ice Zone. SFEXCH5A.449
C ! Missing data indicator over non sea-ice. SFEXCH5A.450
&,CH_LEAD(P_POINTS) ! Bulk transfer coefficient for heat and SFEXCH5A.451
C ! or moisture over sea ice leads. SFEXCH5A.452
C ! Missing data indicator over non sea-ice. SFEXCH5A.453
&,CH_MIZ(P_POINTS) ! Bulk transfer coefficient for heat and SFEXCH5A.454
C ! or moisture over the Marginal Ice Zone. SFEXCH5A.455
C ! Missing data indicator over non sea-ice. SFEXCH5A.456
&,CD_STD(P_POINTS) ! Local drag coefficient for SFEXCH5A.457
C ! calculation of interpolation coefficients SFEXCH5A.458
&,DQ(P_POINTS) ! Sp humidity difference between surface SFEXCH5A.459
C ! and lowest atmospheric level (Q1 - Q*). SFEXCH5A.460
C ! Holds value over sea-ice where ICE_FRACT SFEXCH5A.461
C ! >0 i.e. Leads contribution not included. SFEXCH5A.462
&,DQI(P_POINTS) ADM3F404.86
! Ice water difference between surface ADM3F404.87
! and lowest atmospheric level (Q1 - Q*). ADM3F404.88
! Holds value over sea-ice where ICE_FRACT ADM3F404.89
! >0 i.e. Leads contribution not included. ADM3F404.90
&,DQ_LEAD(P_POINTS) ! DQ for leads fraction of gridsquare. SFEXCH5A.463
C ! Missing data indicator over non sea-ice. SFEXCH5A.464
&,DQI_LEAD(P_POINTS) ADM3F404.91
! DQI for leads fraction of gridsquare. ADM3F404.92
! Missing data indicator over non sea-ice. ADM3F404.93
&,DTEMP(P_POINTS) ! Liquid/ice static energy difference SFEXCH5A.465
C ! between surface and lowest atmospheric SFEXCH5A.466
C ! level, divided by CP (a modified SFEXCH5A.467
C ! temperature difference). SFEXCH5A.468
C ! Holds value over sea-ice where ICE_FRACT SFEXCH5A.469
C ! >0 i.e. Leads contribution not included. SFEXCH5A.470
&,DTEMP_LEAD(P_POINTS) ! DTEMP for leads fraction of gridsquare. SFEXCH5A.471
C ! Missing data indicator over non sea-ice. SFEXCH5A.472
&,EPDT(P_POINTS) ! "Potential" Evaporation * Timestep SFEXCH5A.473
&,NL0(LAND_PTS) ! Nitrogen concentration of the top leaf SFEXCH5A.474
C ! (kg N/kg C). SFEXCH5A.475
&,PSIS(P_POINTS) ! Soil moisture availability factor. SFEXCH5A.476
&,PSTAR_ICE(P_POINTS)! Surface pressure over sea ice (Pa). SFEXCH5A.477
&,QS1(P_POINTS) ! Sat. specific humidity qsat(TL_1,PSTAR) SFEXCH5A.478
&,QSL(P_POINTS) ! Saturated sp humidity at liquid/ice SFEXCH5A.479
C ! temperature and pressure of lowest SFEXCH5A.480
C ! atmospheric level. SFEXCH5A.481
&,QSTAR(P_POINTS) ! Surface saturated sp humidity. Holds SFEXCH5A.482
C ! value over sea-ice where ICE_FRACT > 0. SFEXCH5A.483
C ! i.e. Leads contribution not included. SFEXCH5A.484
&,QSTAR_LEAD(P_POINTS) ! QSTAR for sea-ice leads. SFEXCH5A.485
C ! Missing data indicator over non sea-ice. SFEXCH5A.486
&,RHOSTAR(P_POINTS) ! Surface air density in kg per cubic metre. SFEXCH5A.487
&,RIB_LEAD(P_POINTS) ! Bulk Richardson no. for sea-ice leads at SFEXCH5A.488
C ! lowest layer. At non sea-ice points holds SFEXCH5A.489
C ! RIB for FCDCH calculation, then set to SFEXCH5A.490
C ! to missing data indicator. SFEXCH5A.491
&,RA(P_POINTS) ! Aerodynamic resistance. SFEXCH5A.492
&,ROOT(LAND_PTS) ! Root biomass (kg C/m2). SFEXCH5A.493
&,TSTAR_NL(P_POINTS) ! TSTAR No Leads: surface temperature SFEXCH5A.494
C ! over sea-ice fraction of gridsquare. SFEXCH5A.495
C ! =TSTAR over non sea-ice points. SFEXCH5A.496
&,U_0_P(P_POINTS) ! West-to-east component of ocean surface SFEXCH5A.497
C ! current (m/s; zero over land if U_0 OK). SFEXCH5A.498
C ! P grid. F615. SFEXCH5A.499
&,V_0_P(P_POINTS) ! South-to-north component of ocean surface SFEXCH5A.500
C ! current (m/s; zero over land if V_0 OK). SFEXCH5A.501
C ! P grid. F616. SFEXCH5A.502
&,WIND_PROFILE_FACTOR(P_POINTS) SFEXCH5A.503
C ! For transforming effective surface transfer SFEXCH5A.504
C ! coefficients to those excluding form drag. SFEXCH5A.505
SFEXCH5A.506
&,Z0F(P_POINTS) ! Roughness length for free-convective heat SFEXCH5A.507
C ! and moisture transport. SFEXCH5A.508
&,Z0FS(P_POINTS) ! Roughness length for free-convective heat SFEXCH5A.509
C ! and moisture transport over sea. SFEXCH5A.510
&,Z0HS(P_POINTS) ! Roughness length for heat and moisture SFEXCH5A.511
C ! transport over sea. SFEXCH5A.512
C SFEXCH5A.513
C Workspace (reqd for compression). SFEXCH5A.514
INTEGER SFEXCH5A.515
& SICE_INDEX(P_POINTS) ! Index vector for gather to sea-ice points SFEXCH5A.516
LOGICAL ITEST(P_POINTS) ! Used as 'logical' for compression. SFEXCH5A.517
C* SFEXCH5A.584
C SFEXCH5A.585
C (b) Scalars. SFEXCH5A.586
C SFEXCH5A.587
INTEGER SFEXCH5A.588
& I ! Loop counter (horizontal field index). SFEXCH5A.589
&,J ! Offset counter within I-loop. SFEXCH5A.590
&,K ! Offset counter within I-loop. SFEXCH5A.591
&,L ! Loop counter (land point field index). SFEXCH5A.592
&,N ! Loop counter (land point field index). SFEXCH5A.593
&,NSICE ! Number of sea-ice points. SFEXCH5A.594
&,SI ! Loop counter (sea-ice field index). SFEXCH5A.598
REAL SFEXCH5A.599
& TAU ! Magnitude of surface wind stress over sea. SFEXCH5A.600
&,VS ! Surface layer friction velocity SFEXCH5A.601
&,VSF1_CUBED ! Cube of surface layer free convective scaling SFEXCH5A.602
C ! velocity SFEXCH5A.603
&,WS1 ! Turbulent velocity scale for surface layer SFEXCH5A.604
SFEXCH5A.605
!------------------------------------------------------------------- SFEXCH5A.606
! Extra work variables for the canopy (stomatal) conductance model. SFEXCH5A.607
!------------------------------------------------------------------- SFEXCH5A.608
LOGICAL SFEXCH5A.609
& INT_STOM ! T for interactive stomatal resistance. SFEXCH5A.610
PARAMETER (INT_STOM=.TRUE.) SFEXCH5A.611
SFEXCH5A.612
C SFEXCH5A.613
C----------------------------------------------------------------------- SFEXCH5A.614
CL 0. Check that the scalars input to define the grid are consistent. SFEXCH5A.615
C----------------------------------------------------------------------- SFEXCH5A.616
C SFEXCH5A.617
IF (LTIMER) THEN SFEXCH5A.618
CALL TIMER('SFEXCH ',3) SFEXCH5A.619
ENDIF SFEXCH5A.620
SFEXCH5A.621
ERROR=0 SFEXCH5A.622
*IF DEF,SCMA AJC1F405.95
IF ( U_ROWS .NE. P_ROWS .OR. AJC1F405.96
& U_POINTS .NE. (U_ROWS*ROW_LENGTH) .OR. AJC1F405.97
& P_POINTS .NE. (P_ROWS*ROW_LENGTH) .OR. AJC1F405.98
& LAND_PTS .GT. P_POINTS ) THEN AJC1F405.99
ERROR=1 AJC1F405.100
GOTO 6 AJC1F405.101
ENDIF AJC1F405.102
*ELSE SFEXCH5A.639
IF ( U_ROWS .NE. (P_ROWS+1) .OR. SFEXCH5A.640
& U_POINTS .NE. (U_ROWS*ROW_LENGTH) .OR. SFEXCH5A.641
& P_POINTS .NE. (P_ROWS*ROW_LENGTH) .OR. SFEXCH5A.642
& LAND_PTS .GT. P_POINTS ) THEN SFEXCH5A.643
ERROR=1 SFEXCH5A.644
GOTO6 SFEXCH5A.645
ENDIF SFEXCH5A.646
*ENDIF AJC1F405.103
C SFEXCH5A.647
C----------------------------------------------------------------------- SFEXCH5A.648
CL 1. Construct SICE_INDEX for compression onto sea points in SFEXCH5A.649
CL sea-ice leads calculations. SFEXCH5A.650
C----------------------------------------------------------------------- SFEXCH5A.651
C SFEXCH5A.652
DO I = 1,P_POINTS SFEXCH5A.653
ITEST(I) = .FALSE. SFEXCH5A.654
IF (ICE_FRACT(I).GT.0.0 .AND. .NOT.LAND_MASK(I)) SFEXCH5A.655
& ITEST(I) = .TRUE. SFEXCH5A.656
ENDDO SFEXCH5A.657
C SFEXCH5A.658
C Routine whenimd is functionally equivalent to WHENILE, so ITEST is SFEXCH5A.659
C 1 for "False", 0 for "True". SFEXCH5A.660
C SFEXCH5A.661
C GSS2F402.293
NSICE = 0 GSS2F402.294
DO I=1,P_POINTS GSS2F402.295
IF(ITEST(I))THEN GSS2F402.296
NSICE = NSICE + 1 GSS2F402.297
SICE_INDEX(NSICE) = I GSS2F402.298
END IF GSS2F402.299
END DO GSS2F402.300
C SFEXCH5A.664
C----------------------------------------------------------------------- SFEXCH5A.665
CL 2. Calculate QSAT values required later and components of ocean SFEXCH5A.666
CL current. SFEXCH5A.667
C Done here to avoid loop splitting. SFEXCH5A.668
C QSTAR 'borrowed' to store P at level 1 (just this once). SFEXCH5A.669
C PSIS 'borrowed' to store leads and non sea-ice surface temp. SFEXCH5A.670
C----------------------------------------------------------------------- SFEXCH5A.671
C SFEXCH5A.672
C----------------------------------------------------------------------- SFEXCH5A.674
CL 2.1 IF (GATHER) THEN SFEXCH5A.675
CL Calculate temperatures and pressures for QSAT calculations. SFEXCH5A.676
CL Calculate QSAT values. For sea-ice points, separate values SFEXCH5A.677
CL are required for the leads (QSTAR_LEAD) and sea-ice (QSTAR) SFEXCH5A.678
CL fractions respectively. QSTAR_LEAD = missing data, elsewhere. SFEXCH5A.679
CL Use RS to store compressed PSTAR for this section only. SFEXCH5A.680
CL NB Unlike QSTAR, TSTAR values at sea-ice points are gridsq. SFEXCH5A.681
CL means and so include the leads contribution. SFEXCH5A.682
CL ELSE SFEXCH5A.683
CL As above with QSTAR_LEAD done on full field. SFEXCH5A.684
CL ENDIF SFEXCH5A.685
C----------------------------------------------------------------------- SFEXCH5A.686
IF (GATHER) THEN SFEXCH5A.687
DO I = 1,P_POINTS SFEXCH5A.688
IF (L_BL_LSPICE) THEN ADM3F404.94
TL_1(I) = T_1(I) - LCRCP*QCL_1(I) ! P243.9 ADM3F404.95
ELSE ADM3F404.96
TL_1(I) = T_1(I) - LCRCP*QCL_1(I) - LSRCP*QCF_1(I) !P243.9 ADM3F404.97
ENDIF ADM3F404.98
TSTAR_NL(I) = TSTAR(I) SFEXCH5A.690
QSTAR_LEAD(I) = 1.0E30 ! Missing data indicato SFEXCH5A.691
QSTAR(I) = AK_1 + BK_1*PSTAR(I) SFEXCH5A.692
ENDDO SFEXCH5A.693
IF (NSICE.GT.0) THEN SFEXCH5A.694
CDIR$ IVDEP SFEXCH5A.695
! Fujitsu vectorization directive GRB0F405.479
!OCL NOVREC GRB0F405.480
DO SI = 1,NSICE SFEXCH5A.696
I = SICE_INDEX(SI) SFEXCH5A.697
TSTAR_NL(I) = (TSTAR(I)-(1.0-ICE_FRACT(I)) *TFS) SFEXCH5A.698
& / ICE_FRACT(I) ! P2430.1 SFEXCH5A.699
PSIS(SI) = TFS SFEXCH5A.700
PSTAR_ICE(SI) = PSTAR(I) SFEXCH5A.701
ENDDO SFEXCH5A.702
ENDIF SFEXCH5A.703
IF (L_BL_LSPICE) THEN ADM3F404.99
CALL QSAT_WAT(QSL,TL_1,QSTAR,P_POINTS) ADM3F404.100
ELSE ADM3F404.101
CALL QSAT(QSL,TL_1,QSTAR,P_POINTS) ADM3F404.102
ENDIF ADM3F404.103
SFEXCH5A.705
CALL QSAT(QSTAR,TSTAR_NL,PSTAR,P_POINTS) SFEXCH5A.706
SFEXCH5A.707
C ...values at sea-ice points contain ice contribution only SFEXCH5A.708
IF (NSICE.GT.0) CALL QSAT(QSTAR_LEAD,PSIS,PSTAR_ICE,NSICE) SFEXCH5A.709
C ...values at sea-ice points only SFEXCH5A.710
ELSE SFEXCH5A.711
C----------------------------------------------------------------------- SFEXCH5A.713
CL 2.1 Single Column Model selected. SFEXCH5A.714
CL Calculate temperatures and pressures for QSAT calculations. SFEXCH5A.715
CL If there is sea-ice, separate values of surface saturated SFEXCH5A.716
CL specific humidity are required for the leads (QSTAR_LEAD) SFEXCH5A.717
CL and sea-ice (QSTAR) fractions respectively. SFEXCH5A.718
CL NB Unlike QSTAR, TSTAR values at sea-ice points are gridsq. SFEXCH5A.719
CL means and so include the leads contribution. SFEXCH5A.720
CL Also initialise RIB to 0 SFEXCH5A.721
C----------------------------------------------------------------------- SFEXCH5A.722
DO I = 1,P_POINTS SFEXCH5A.724
IF (L_BL_LSPICE) THEN ADM3F404.104
TL_1(I) = T_1(I) - LCRCP*QCL_1(I) ! P243.9 ADM3F404.105
ELSE ADM3F404.106
TL_1(I) = T_1(I) - LCRCP*QCL_1(I) - LSRCP*QCF_1(I) !P243.9 ADM3F404.107
ENDIF ADM3F404.108
TSTAR_NL(I) = TSTAR(I) SFEXCH5A.726
C Set to missing data at non sea-ice points after QSAT. SFEXCH5A.727
PSIS(I) = TSTAR(I) SFEXCH5A.728
QSTAR(I) = AK_1 + BK_1*PSTAR(I) SFEXCH5A.729
IF ( ICE_FRACT(I).GT.0.0 .AND. .NOT.LAND_MASK(I) ) THEN SFEXCH5A.730
TSTAR_NL(I) = (TSTAR(I)-(1.0-ICE_FRACT(I)) *TFS) SFEXCH5A.731
& / ICE_FRACT(I) ! P2430.1 SFEXCH5A.732
PSIS(I) = TFS SFEXCH5A.733
ENDIF SFEXCH5A.734
RIB(I) = 0.0 SFEXCH5A.735
ENDDO SFEXCH5A.736
IF (L_BL_LSPICE) THEN ADM3F404.109
CALL QSAT_WAT(QSL,TL_1,QSTAR,P_POINTS) ADM3F404.110
ELSE ADM3F404.111
CALL QSAT(QSL,TL_1,QSTAR,P_POINTS) ADM3F404.112
ENDIF ADM3F404.113
SFEXCH5A.738
CALL QSAT(QSTAR,TSTAR_NL,PSTAR,P_POINTS) SFEXCH5A.739
C ...values at sea-ice points contain ice contribution only SFEXCH5A.740
IF (NSICE.GT.0) CALL QSAT(QSTAR_LEAD,PSIS,PSTAR,P_POINTS) SFEXCH5A.741
C ...values at sea-ice points contain leads contribution only SFEXCH5A.742
DO I=1,P_POINTS SFEXCH5A.743
IF ( .NOT.(ICE_FRACT(I).GT.0.0 .AND. .NOT.LAND_MASK(I)) ) SFEXCH5A.744
& QSTAR_LEAD(I) = 1.0E30 SFEXCH5A.745
ENDDO SFEXCH5A.746
ENDIF ! End of IF (GATHER) THEN... ELSE. SFEXCH5A.748
C----------------------------------------------------------------------- SFEXCH5A.750
CL 2.2 Set components of ocean surface current. SFEXCH5A.751
C----------------------------------------------------------------------- SFEXCH5A.752
*IF DEF,SCMA AJC1F405.104
DO I = 1, U_POINTS AJC1F405.105
U_0_P(I) = U_0(I) AJC1F405.106
V_0_P(I) = V_0(I) AJC1F405.107
ENDDO AJC1F405.108
*ELSE SFEXCH5A.756
CALL UV_TO_P(U_0,U_0_P,U_POINTS,P_POINTS,ROW_LENGTH,U_ROWS) SFEXCH5A.757
CALL UV_TO_P(V_0,V_0_P,U_POINTS,P_POINTS,ROW_LENGTH,U_ROWS) SFEXCH5A.758
*ENDIF SFEXCH5A.759
C SFEXCH5A.760
C----------------------------------------------------------------------- SFEXCH5A.761
CL 3. Calculation of transfer coefficients and surface layer stability SFEXCH5A.762
C----------------------------------------------------------------------- SFEXCH5A.763
C SFEXCH5A.764
C----------------------------------------------------------------------- SFEXCH5A.765
CL 3.1 Calculate neutral roughness lengths and blending height for SFEXCH5A.766
CL surface SFEXCH5A.767
C----------------------------------------------------------------------- SFEXCH5A.768
SFEXCH5A.769
CALL SF_ROUGH ( SFEXCH5A.770
& P_POINTS,LAND_PTS,LAND_MASK, SFEXCH5A.771
& P1,LAND_INDEX, SFEXCH5A.773
& L_Z0_OROG,Z1,Z0MSEA,ICE_FRACT, SFEXCH5A.775
& LYING_SNOW,Z0V,SIL_OROG,HO2R2_OROG,RIB,Z0M_EFF,Z0M,Z0H, SFEXCH5A.776
& WIND_PROFILE_FACTOR,H_BLEND,CD_LEAD,Z0HS,Z0F,Z0FS, SFEXCH5A.777
& LTIMER) SFEXCH5A.778
SFEXCH5A.779
SFEXCH5A.780
C----------------------------------------------------------------------- SFEXCH5A.781
CL 3.2 Calculate buoyancy parameters and bulk Richardson number for SFEXCH5A.782
CL the lowest model level. SFEXCH5A.783
C----------------------------------------------------------------------- SFEXCH5A.784
C Calculate QSAT(TL1,P*) SFEXCH5A.785
C SFEXCH5A.786
CALL QSAT(QS1,TL_1,PSTAR,P_POINTS) SFEXCH5A.787
SFEXCH5A.788
CALL SF_RIB ( SFEXCH5A.789
& P_POINTS,LAND_PTS,LAND_MASK,INT_STOM, SFEXCH5A.790
& GATHER,P1,LAND_INDEX, SFEXCH5A.792
& NSICE,SICE_INDEX,ICE_FRACT, SFEXCH5A.794
& PSTAR,AK_1,BK_1,Q_1,QW_1,QCL_1,QCF_1, SFEXCH5A.795
& CF_1,T_1,TL_1,QSL,QSTAR,QSTAR_LEAD, SFEXCH5A.796
& QS1,TSTAR_NL,Z1,Z0M_EFF,Z0M,Z0H,Z0HS,Z0MSEA, SFEXCH5A.797
& WIND_PROFILE_FACTOR,U_1_P,U_0_P,V_1_P,V_0_P, SFEXCH5A.798
& ROOTD,SMVCCL,SMVCWT,SMC,V_SOIL,VFRAC,CANOPY,CATCH, SFEXCH5A.799
& LYING_SNOW,GC,RESIST,RIB,RIB_LEAD,PSIS,VSHR,ALPHA1, SFEXCH5A.800
& BT_1,BQ_1,BF_1,FRACA,RESFS,DQ,DQ_LEAD,DTEMP, ADM3F404.114
& DTEMP_LEAD,L_BL_LSPICE, ADM3F404.115
& LTIMER) SFEXCH5A.802
SFEXCH5A.803
C----------------------------------------------------------------------- SFEXCH5A.804
CL 3.3 Calculate stability corrected effective roughness length. SFEXCH5A.805
CL Simple linear interpolation when RIB between 0 and RIB_CRIT (>0) for SFEXCH5A.806
CL form drag term. SFEXCH5A.807
C----------------------------------------------------------------------- SFEXCH5A.808
SFEXCH5A.809
SFEXCH5A.810
CALL SF_ROUGH ( SFEXCH5A.811
& P_POINTS,LAND_PTS,LAND_MASK, SFEXCH5A.812
& P1,LAND_INDEX, SFEXCH5A.814
& L_Z0_OROG,Z1,Z0MSEA,ICE_FRACT, SFEXCH5A.816
& LYING_SNOW,Z0V,SIL_OROG,HO2R2_OROG,RIB,Z0M_EFF,Z0M,Z0H, SFEXCH5A.817
& WIND_PROFILE_FACTOR,H_BLEND,CD_LEAD,Z0HS,Z0F,Z0FS, SFEXCH5A.818
& LTIMER) SFEXCH5A.819
SFEXCH5A.820
C SFEXCH5A.821
C----------------------------------------------------------------------- SFEXCH5A.822
CL 3.4 Calculate CD, CH via routine FCDCH. SFEXCH5A.823
CL Calculate CD_MIZ,CH_MIZ,CD_LEAD,CH_LEAD on full field then set SFEXCH5A.824
CL non sea-ice points to missing data (contain nonsense after FCDCH) SFEXCH5A.825
C Unlike the QSAT calculations above, arrays are not compressed to SFEXCH5A.827
C sea-ice points for FCDCH. This is because it would require extra SFEXCH5A.828
C work space and initial tests showed that with with the extra SFEXCH5A.829
C compression calculations required no time was saved. SFEXCH5A.830
C NB CD_LEAD stores Z0MIZ for calculation of CD_MIZ,CH_MIZ. SFEXCH5A.832
C----------------------------------------------------------------------- SFEXCH5A.833
C SFEXCH5A.834
CALL FCDCH(RIB,CD_LEAD,CD_LEAD,CD_LEAD,Z1,WIND_PROFILE_FACTOR, SFEXCH5A.835
& P_POINTS,CD_MIZ,CH_MIZ,CD_STD,LTIMER) SFEXCH5A.836
C ! Marginal Ice Zone.P2430.9 SFEXCH5A.837
CALL FCDCH(RIB_LEAD,Z0MSEA,Z0HS,Z0FS,Z1,WIND_PROFILE_FACTOR, SFEXCH5A.838
& P_POINTS,CD_LEAD,CH_LEAD,CD_STD,LTIMER) SFEXCH5A.839
C ! Sea-ice leads.P2430.8 SFEXCH5A.840
CALL FCDCH(RIB,Z0M_EFF,Z0H,Z0F,Z1,WIND_PROFILE_FACTOR, SFEXCH5A.841
& P_POINTS,CD,CH,CD_STD,LTIMER) SFEXCH5A.842
DO I=1,P_POINTS SFEXCH5A.843
C IF ( an ordinary sea points (no sea-ice) or a land point) SFEXCH5A.844
IF (.NOT.(ICE_FRACT(I).GT.0.0 .AND. .NOT.LAND_MASK(I)) ) THEN SFEXCH5A.845
CD_MIZ(I) = 1.E30 SFEXCH5A.846
CH_MIZ(I) = 1.E30 SFEXCH5A.847
CD_LEAD(I) = 1.E30 SFEXCH5A.848
CH_LEAD(I) = 1.E30 SFEXCH5A.849
RIB_LEAD(I) = 1.E30 SFEXCH5A.850
ENDIF SFEXCH5A.851
ENDDO SFEXCH5A.852
C SFEXCH5A.853
SFEXCH5A.854
C----------------------------------------------------------------------- SFEXCH5A.855
CL 4. Loop round gridpoints to be processed, performing calculations SFEXCH5A.856
CL AFTER call to FCDCH which necessitates splitting of loop. SFEXCH5A.857
C----------------------------------------------------------------------- SFEXCH5A.858
CL 4.1 Recalculate RESFS using "true" CH and EPDT SFEXCH5A.859
C----------------------------------------------------------------------- SFEXCH5A.860
SFEXCH5A.861
CDIR$ IVDEP SFEXCH5A.867
! Fujitsu vectorization directive GRB0F405.481
!OCL NOVREC GRB0F405.482
DO L = 1,LAND_PTS SFEXCH5A.868
I = LAND_INDEX(L) - (P1-1) SFEXCH5A.869
EPDT(I) = -PSTAR(I)/(R*TSTAR(I))*CH(I)*VSHR(I)*DQ(I)*TIMESTEP SFEXCH5A.871
ENDDO ! Loop over land-points SFEXCH5A.876
SFEXCH5A.878
!----------------------------------------------------------------------- SFEXCH5A.879
! If the interactive surface resistance is requested call SF_STOM SFEXCH5A.880
!----------------------------------------------------------------------- SFEXCH5A.881
IF (INT_STOM) THEN SFEXCH5A.882
SFEXCH5A.883
!----------------------------------------------------------------------- SFEXCH5A.884
! Calculate the aerodynamic resistance SFEXCH5A.885
!----------------------------------------------------------------------- SFEXCH5A.886
DO I=1,P_POINTS SFEXCH5A.887
RA(I) = 1.0 / (CH(I) * VSHR(I)) SFEXCH5A.888
ENDDO SFEXCH5A.889
SFEXCH5A.890
CDIR$ IVDEP SFEXCH5A.896
! Fujitsu vectorization directive GRB0F405.483
!OCL NOVREC GRB0F405.484
DO L = 1,LAND_PTS SFEXCH5A.897
I = LAND_INDEX(L) - (P1-1) SFEXCH5A.898
!----------------------------------------------------------------------- SFEXCH5A.900
! For mesoscale model release assume uniform functional types and top SFEXCH5A.901
! leaf nitrogen concentrations. Assume that (fine) root biomass is SFEXCH5A.902
! equal to leaf biomass. SFEXCH5A.903
!----------------------------------------------------------------------- SFEXCH5A.904
NL0(L) = 50.0E-3 SFEXCH5A.905
ROOT(L) = 0.04 * LAI(L) SFEXCH5A.906
SFEXCH5A.907
ENDDO ! Loop over land-points SFEXCH5A.912
SFEXCH5A.914
IF(LAND_PTS.GT.0) THEN ! Omit if no land points ARR0F403.24
ARR0F403.25
CALL SF_STOM (LAND_PTS,LAND_INDEX,P1,P_POINTS SFEXCH5A.915
&, F_TYPE,CO2,HT,PAR,LAI,NL0,PSTAR SFEXCH5A.916
&, Q_1,RA,ROOT,TSTAR,SMVCCL,V_ROOT,SMVCWT SFEXCH5A.917
&, VFRAC,GPP,NPP,RESP_P,GC,LTIMER,FSMC) ANG1F405.104
ARR0F403.26
ENDIF ! End test on land points ARR0F403.27
SFEXCH5A.919
!----------------------------------------------------------------------- SFEXCH5A.920
! Convert carbon fluxes to gridbox mean values SFEXCH5A.921
!----------------------------------------------------------------------- SFEXCH5A.922
CDIR$ IVDEP SFEXCH5A.928
! Fujitsu vectorization directive GRB0F405.485
!OCL NOVREC GRB0F405.486
DO L = 1,LAND_PTS SFEXCH5A.929
I = LAND_INDEX(L) - (P1-1) SFEXCH5A.930
SFEXCH5A.932
GPP(L) = VFRAC(L) * GPP(L) SFEXCH5A.933
NPP(L) = VFRAC(L) * NPP(L) SFEXCH5A.934
RESP_P(L) = VFRAC(L) * RESP_P(L) SFEXCH5A.935
SFEXCH5A.936
ENDDO ! Loop over land-points SFEXCH5A.941
SFEXCH5A.943
ENDIF ! INT_STOM SFEXCH5A.944
SFEXCH5A.945
SFEXCH5A.946
CALL SF_RESIST ( SFEXCH5A.947
& P_POINTS,LAND_PTS,LAND_MASK,INT_STOM, SFEXCH5A.948
& P1,LAND_INDEX, SFEXCH5A.950
& ROOTD,SMVCCL,SMVCWT,SMC,V_SOIL,VFRAC,CANOPY,CATCH,DQ, SFEXCH5A.952
& EPDT,LYING_SNOW,GC,RESIST,VSHR,CH,PSIS,FRACA,RESFS, SFEXCH5A.953
& F_SE,RESFT,LTIMER) SFEXCH5A.954
SFEXCH5A.955
SFEXCH5A.956
C----------------------------------------------------------------------- SFEXCH5A.957
CL 4.D Call SFL_INT to calculate CDR10M, CHR1P5M and CER1P5M - SFEXCH5A.958
CL interpolation coefficients used in SF_EVAP and IMPL_CAL to SFEXCH5A.959
CL calculate screen temperature, specific humidity and 10m winds. SFEXCH5A.960
C----------------------------------------------------------------------- SFEXCH5A.961
C SFEXCH5A.962
IF (SU10 .OR. SV10 .OR. SQ1P5 .OR. ST1P5) THEN SFEXCH5A.963
SFEXCH5A.964
CALL SFL_INT ( SFEXCH5A.965
& P_POINTS,U_POINTS,RIB,Z1,Z0M,Z0M_EFF,Z0H,Z0F,CD_STD,CD,CH, SFEXCH5A.966
& RESFT,WIND_PROFILE_FACTOR, SFEXCH5A.967
& CDR10M,CHR1P5M,CER1P5M, SFEXCH5A.968
& SU10,SV10,ST1P5,SQ1P5,LTIMER SFEXCH5A.969
& ) SFEXCH5A.970
ENDIF SFEXCH5A.971
C----------------------------------------------------------------------- SFEXCH5A.972
CL 4.2 Now that diagnostic calculations are over, update CD and CH SFEXCH5A.973
CL to their correct values (i.e. gridsquare means). SFEXCH5A.974
C----------------------------------------------------------------------- SFEXCH5A.975
DO I = 1,P_POINTS SFEXCH5A.976
IF ( ICE_FRACT(I).GT.0.0 .AND. .NOT.LAND_MASK(I) ) THEN SFEXCH5A.977
IF ( ICE_FRACT(I).LT. 0.7 ) THEN SFEXCH5A.978
CD(I) = ( ICE_FRACT(I)*CD_MIZ(I) + SFEXCH5A.979
& (0.7-ICE_FRACT(I))*CD_LEAD(I) ) / 0.7 ! P2430.5 SFEXCH5A.980
CD_STD(I) = CD(I) ! for SCYCLE: no orog. over sea+ice SFEXCH5A.981
CH(I) = ( ICE_FRACT(I)*CH_MIZ(I) + SFEXCH5A.982
& (0.7-ICE_FRACT(I))*CH_LEAD(I) ) / 0.7 ! P2430.4 SFEXCH5A.983
ELSE SFEXCH5A.984
CD(I) = ( (1.0-ICE_FRACT(I))*CD_MIZ(I) + SFEXCH5A.985
& (ICE_FRACT(I)-0.7)*CD(I) ) / 0.3 ! P2430.7 SFEXCH5A.986
CD_STD(I) = CD(I) ! for SCYCLE: no orog. over sea+ice SFEXCH5A.987
CH(I) = ( (1.0-ICE_FRACT(I))*CH_MIZ(I) + SFEXCH5A.988
& (ICE_FRACT(I)-0.7)*CH(I) ) / 0.3 ! P2430.7 SFEXCH5A.989
ENDIF SFEXCH5A.990
ENDIF SFEXCH5A.991
C----------------------------------------------------------------------- SFEXCH5A.992
CL 4.3 Calculate the surface exchange coefficients RHOK(*). SFEXCH5A.993
C----------------------------------------------------------------------- SFEXCH5A.994
RHOSTAR(I) = PSTAR(I) / ( R*TSTAR(I) ) SFEXCH5A.995
C ... surface air density from ideal gas equation SFEXCH5A.996
C Calculate resistances for use in Sulphur Cycle SFEXCH5A.997
C (Note that CD_STD, CH and VSHR should never = 0) SFEXCH5A.998
RHO_ARESIST(I) = RHOSTAR(I) * CD_STD(I) * VSHR(I) SFEXCH5A.999
ARESIST(I) = RHOSTAR(I)/RHO_ARESIST(I) SFEXCH5A.1000
RESIST_B(I)= (CD_STD(I)/CH(I) - 1.0) * ARESIST(I) SFEXCH5A.1001
! SFEXCH5A.1002
RHOKM_1(I) = RHOSTAR(I) * CD(I) * VSHR(I) ! P243.124 SFEXCH5A.1003
*IF DEF,SCMA AJC0F405.108
C If OBS run use RHOKH_1 and FACTOR_RHOKH AJC0F405.109
C (from FLUX_H and FLUX_E input by namelist) AJC0F405.110
If (.NOT.OBS) then AJC0F405.111
*ENDIF AJC0F405.112
RHOKH_1(I) = RHOSTAR(I) * CH(I) * VSHR(I) ! P243.125 SFEXCH5A.1004
*IF DEF,SCMA AJC0F405.113
endif AJC0F405.114
*ENDIF AJC0F405.115
RHOKE(I) = RESFT(I) * RHOKH_1(I) SFEXCH5A.1005
C SFEXCH5A.1006
C RHOSTAR * CD * VSHR stored for diagnostic output before SFEXCH5A.1007
C horizontal interpolation. SFEXCH5A.1008
C SFEXCH5A.1009
RHO_CD_MODV1(I) = RHOKM_1(I) SFEXCH5A.1010
SFEXCH5A.1011
SFEXCH5A.1012
ENDDO SFEXCH5A.1013
SFEXCH5A.1014
SFEXCH5A.1015
CALL SF_FLUX ( SFEXCH5A.1016
& P_POINTS,LAND_PTS,LAND_MASK, SFEXCH5A.1017
& P1,LAND_INDEX, SFEXCH5A.1019
& ALPHA1,DQ,DQ_LEAD,DTEMP,DTEMP_LEAD,DZSOIL,HCONS,ICE_FRACT, SFEXCH5A.1021
& LYING_SNOW,QS1,QW_1,RADNET_C,RESFT,RHOKE,RHOKH_1,TI,TL_1,TS1, APA1F405.395
& Z0H,Z0M_EFF,Z1, SFEXCH5A.1023
& ASHTF,E_SEA,EPOT,FQW_1,FTL_1,H_SEA,RHOKPM,RHOKPM_POT, ANG1F405.103
& TSTAR,VFRAC,TIMESTEP,CANCAP, APA1F405.396
& LTIMER) SFEXCH5A.1025
SFEXCH5A.1026
C----------------------------------------------------------------------- SFEXCH5A.1027
CL 4.4.1 Set indicator for unstable suface layer (buoyancy flux +ve.). SFEXCH5A.1028
CL if required by logical L_RMBL SFEXCH5A.1029
C----------------------------------------------------------------------- SFEXCH5A.1030
SFEXCH5A.1031
DO I=1,P_POINTS SFEXCH5A.1032
SFEXCH5A.1033
IF (L_RMBL.AND.BT_1(I)*FTL_1(I)+BQ_1(I)*FQW_1(I).GT.0.0 )THEN SFEXCH5A.1034
NRML(I) = 1 SFEXCH5A.1035
ELSE SFEXCH5A.1036
NRML(I) = 0 SFEXCH5A.1037
ENDIF SFEXCH5A.1038
C----------------------------------------------------------------------- SFEXCH5A.1039
CL 4.5 Multiply surface exchange coefficients that are on the P-grid SFEXCH5A.1040
CL by GAMMA(1).Needed for implicit calculations in P244(IMPL_CAL). SFEXCH5A.1041
CL RHOKM_1 dealt with in section 4.1 below. SFEXCH5A.1042
C----------------------------------------------------------------------- SFEXCH5A.1043
RHOKH_1(I) = RHOKH_1(I) * GAMMA(1) SFEXCH5A.1044
RHOKE(I) = RHOKE(I) * GAMMA(1) SFEXCH5A.1045
C----------------------------------------------------------------------- SFEXCH5A.1046
CL 4.5.1 Calculate the standard deviations of layer 1 turbulent SFEXCH5A.1047
CL fluctuations of temperature and humidity using approximate SFEXCH5A.1048
CL formulae from first order closure. SFEXCH5A.1049
C----------------------------------------------------------------------- SFEXCH5A.1050
VS = SQRT ( RHOKM_1(I)/RHOSTAR(I) * VSHR(I) ) SFEXCH5A.1051
VSF1_CUBED = 1.25 * ( Z1(I) + Z0M(I) ) * G * SFEXCH5A.1052
& ( BT_1(I)*FTL_1(I) + BQ_1(I)*FQW_1(I) ) / RHOSTAR(I) SFEXCH5A.1053
C !--------------------------------------------------------------- SFEXCH5A.1054
C ! Only calculate standard deviations for unstable surface layers SFEXCH5A.1055
C !--------------------------------------------------------------- SFEXCH5A.1056
IF (VSF1_CUBED .GT. 0.0) THEN SFEXCH5A.1057
WS1 = ( VSF1_CUBED + VS * VS * VS ) ** (1.0/3.0) SFEXCH5A.1058
T1_SD(I) = MAX ( 0.0 , 1.93 * FTL_1(I) / (RHOSTAR(I) * WS1) ) SFEXCH5A.1059
Q1_SD(I) = MAX ( 0.0 , 1.93 * FQW_1(I) / (RHOSTAR(I) * WS1) ) SFEXCH5A.1060
ELSE SFEXCH5A.1061
T1_SD(I) = 0.0 SFEXCH5A.1062
Q1_SD(I) = 0.0 SFEXCH5A.1063
ENDIF SFEXCH5A.1064
C----------------------------------------------------------------------- SFEXCH5A.1065
CL 4.6 For sea points, calculate the wind mixing energy flux and the SFEXCH5A.1066
CL sea-surface roughness length on the P-grid, using time-level n SFEXCH5A.1067
CL quantities. SFEXCH5A.1068
C----------------------------------------------------------------------- SFEXCH5A.1069
IF (.NOT.LAND_MASK(I)) THEN SFEXCH5A.1070
TAU = RHOKM_1(I) * VSHR(I) ! P243.130 SFEXCH5A.1071
IF (ICE_FRACT(I) .GT. 0.0) SFEXCH5A.1072
& TAU = RHOSTAR(I) * CD_LEAD(I) * VSHR(I) * VSHR(I) SFEXCH5A.1073
IF (SFME) FME(I) = (1.0-ICE_FRACT(I)) * TAU * SQRT(TAU/RHOSEA) SFEXCH5A.1074
C ! P243.96 SFEXCH5A.1075
Z0MSEA(I) = MAX ( Z0HSEA , SFEXCH5A.1076
& (CHARNOCK/G) * (TAU / RHOSTAR(I)) ) SFEXCH5A.1077
C ... P243.B6 (Charnock formula) SFEXCH5A.1078
C TAU/RHOSTAR is "mod VS squared", see eqn P243.131 SFEXCH5A.1079
C SFEXCH5A.1080
ENDIF ! of IF (.NOT. LAND_MASK), land-points done in next loop. SFEXCH5A.1084
ENDDO ! Loop over points for sections 4.2 - 4.6 SFEXCH5A.1085
DO L=1,LAND_PTS SFEXCH5A.1086
I = LAND_INDEX(L) - (P1-1) SFEXCH5A.1087
C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - SFEXCH5A.1089
CL 4.7 Set Z0MSEA to Z0V, FME to zero for land points. SFEXCH5A.1090
C (Former because UM uses same storage for Z0V SFEXCH5A.1091
C and Z0MSEA.) SFEXCH5A.1092
C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - SFEXCH5A.1093
Z0MSEA(I) = Z0V(I) SFEXCH5A.1094
IF (SFME) FME(I) = 0.0 SFEXCH5A.1095
ENDDO ! Loop over points for section 4.7 SFEXCH5A.1101
C SFEXCH5A.1102
*IF -DEF,SCMA AJC1F405.109
C----------------------------------------------------------------------- SFEXCH5A.1103
CL 5. Calculate "explicit" surface fluxes of momentum (on UV-grid). SFEXCH5A.1104
C----------------------------------------------------------------------- SFEXCH5A.1105
CL 5.1 Interpolate exchange coefficient to UV-grid, then mutiply SFEXCH5A.1106
CL by GAMMA(1) to be passed to subroutine IMPL_CAL (P244) which SFEXCH5A.1107
CL only uses RHOKM_1 when mulitplied by GAMMA(1). SFEXCH5A.1108
C----------------------------------------------------------------------- SFEXCH5A.1109
C SFEXCH5A.1110
C PSIS used purely as spare workspace here. SFEXCH5A.1111
C SFEXCH5A.1112
*IF DEF,MPP SFEXCH5A.1113
! RHOKM_1 contains duff data in halos. The P_TO_UV can interpolate this SFEXCH5A.1114
! into the real data, so first we must update east/west halos SFEXCH5A.1115
CALL SWAPBOUNDS(RHOKM_1,ROW_LENGTH,U_POINTS/ROW_LENGTH,1,0,1) SFEXCH5A.1116
SFEXCH5A.1117
*ENDIF SFEXCH5A.1118
CALL P_TO_UV(RHOKM_1,PSIS,P_POINTS,U_POINTS,ROW_LENGTH,P_ROWS) SFEXCH5A.1119
DO I=1,U_POINTS-2*ROW_LENGTH SFEXCH5A.1120
J = I+ROW_LENGTH SFEXCH5A.1121
RHOKM_1(J) = PSIS(I) SFEXCH5A.1122
TAUX_1(J) = RHOKM_1(J) * ( U_1(J) - U_0(J) ) ! P243.132 SFEXCH5A.1123
TAUY_1(J) = RHOKM_1(J) * ( V_1(J) - V_0(J) ) ! P243.133 SFEXCH5A.1124
RHOKM_1(J) = GAMMA(1) * RHOKM_1(J) SFEXCH5A.1125
ENDDO SFEXCH5A.1126
C----------------------------------------------------------------------- SFEXCH5A.1127
CL 5.2 Set first and last rows to "missing data indicator". SFEXCH5A.1128
C----------------------------------------------------------------------- SFEXCH5A.1129
*IF DEF,MPP GPB1F403.51
IF (attop) THEN GPB1F403.52
*ENDIF GPB1F403.53
DO I=1,ROW_LENGTH GPB1F403.54
RHOKM_1(I) = 1.0E30 GPB1F403.55
TAUX_1(I) = 1.0E30 GPB1F403.56
TAUY_1(I) = 1.0E30 GPB1F403.57
ENDDO GPB1F403.58
*IF DEF,MPP GPB1F403.59
ENDIF GPB1F403.60
GPB1F403.61
IF (atbase) THEN GPB1F403.62
*ENDIF GPB1F403.63
DO I= (U_ROWS-1)*ROW_LENGTH + 1 , U_ROWS*ROW_LENGTH GPB1F403.64
RHOKM_1(I) = 1.0E30 GPB1F403.65
TAUX_1(I) = 1.0E30 GPB1F403.66
TAUY_1(I) = 1.0E30 GPB1F403.67
ENDDO GPB1F403.68
*IF DEF,MPP GPB1F403.69
ENDIF GPB1F403.70
*ENDIF GPB1F403.71
C----------------------------------------------------------------------- SFEXCH5A.1139
CL 5.D Interpolate CDR10M to UV-grid. SFEXCH5A.1140
C----------------------------------------------------------------------- SFEXCH5A.1141
*IF DEF,MPP ASJ1F403.21
! CDR10M contains incorrect data in halos. The P_TO_UV can interpolate ASJ1F403.22
! this into the real data, so first we must update east/west halos. ASJ1F403.23
CALL SWAPBOUNDS(CDR10M,ROW_LENGTH,U_POINTS/ROW_LENGTH,1,0,1) ASJ1F403.24
ASJ1F403.25
*ENDIF ASJ1F403.26
IF (SU10 .OR. SV10) THEN SFEXCH5A.1142
CALL P_TO_UV(CDR10M,PSIS,P_POINTS,U_POINTS,ROW_LENGTH,P_ROWS) SFEXCH5A.1143
DO I=1,U_POINTS-2*ROW_LENGTH SFEXCH5A.1144
J = I + ROW_LENGTH SFEXCH5A.1145
CDR10M(J) = PSIS(I) SFEXCH5A.1146
ENDDO SFEXCH5A.1147
C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - SFEXCH5A.1148
CL 5.D.1 Set first and last rows to "missing data indicator". SFEXCH5A.1149
C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - SFEXCH5A.1150
*IF DEF,MPP GPB1F403.72
IF (attop) THEN GPB1F403.73
*ENDIF GPB1F403.74
DO I=1,ROW_LENGTH GPB1F403.75
CDR10M(I) = 1.0E30 GPB1F403.76
ENDDO GPB1F403.77
*IF DEF,MPP GPB1F403.78
ENDIF GPB1F403.79
GPB1F403.80
IF (atbase) THEN GPB1F403.81
*ENDIF GPB1F403.82
DO I= (U_ROWS-1)*ROW_LENGTH + 1 , U_ROWS*ROW_LENGTH GPB1F403.83
CDR10M(I) = 1.0E30 GPB1F403.84
ENDDO GPB1F403.85
*IF DEF,MPP GPB1F403.86
ENDIF GPB1F403.87
*ENDIF GPB1F403.88
ENDIF SFEXCH5A.1156
*ELSE SFEXCH5A.1157
C SFEXCH5A.1158
C----------------------------------------------------------------------- SFEXCH5A.1159
CL 5. Calculate "explicit" surface fluxes of momentum, then overwrite SFEXCH5A.1160
CL coefficient with GAMMA(1)*RHOKM_1 to be passed out for implicit SFEXCH5A.1161
CL calculations in P244 (subroutine IMPL_CAL). This routine only SFEXCH5A.1162
CL uses RHOKM_1 when multiplied by GAMMA(1). SFEXCH5A.1163
C----------------------------------------------------------------------- SFEXCH5A.1164
C SFEXCH5A.1165
DO I=1,U_POINTS SFEXCH5A.1166
TAUX_1(I) = RHOKM_1(I) * ( U_1(I) - U_0(I) ) ! P243.132 SFEXCH5A.1167
TAUY_1(I) = RHOKM_1(I) * ( V_1(I) - V_0(I) ) ! P243.133 SFEXCH5A.1168
RHOKM_1(I) = GAMMA(1) * RHOKM_1(I) SFEXCH5A.1169
ENDDO SFEXCH5A.1170
*ENDIF SFEXCH5A.1171
SFEXCH5A.1172
6 CONTINUE ! Branch for error exit. SFEXCH5A.1173
IF (LTIMER) THEN SFEXCH5A.1174
CALL TIMER('SFEXCH ',4) SFEXCH5A.1175
ENDIF SFEXCH5A.1176
RETURN SFEXCH5A.1177
END SFEXCH5A.1178
*ENDIF SFEXCH5A.1179