*IF DEF,A03_5A SFRIB5A.2
C *****************************COPYRIGHT****************************** SFRIB5A.3
C (c) CROWN COPYRIGHT 1996, METEOROLOGICAL OFFICE, All Rights Reserved. SFRIB5A.4
C SFRIB5A.5
C Use, duplication or disclosure of this code is subject to the SFRIB5A.6
C restrictions as set forth in the contract. SFRIB5A.7
C SFRIB5A.8
C Meteorological Office SFRIB5A.9
C London Road SFRIB5A.10
C BRACKNELL SFRIB5A.11
C Berkshire UK SFRIB5A.12
C RG12 2SZ SFRIB5A.13
C SFRIB5A.14
C If no contract has been raised with this copy of the code, the use, SFRIB5A.15
C duplication or disclosure of it is strictly prohibited. Permission SFRIB5A.16
C to do so must first be obtained in writing from the Head of Numerical SFRIB5A.17
C Modelling at the above address. SFRIB5A.18
C ******************************COPYRIGHT****************************** SFRIB5A.19
C*LL SUBROUTINE SF_RIB------------------------------------------------ SFRIB5A.20
CLL SFRIB5A.21
CLL Purpose: Calculate bulk Richardson number for surface layer SFRIB5A.22
CLL SFRIB5A.23
CLL SFRIB5A.24
CLLEND----------------------------------------------------------------- SFRIB5A.25
C* Vn GSS2F402.307
CLL 4.2 Oct. 96 T3E migration - *DEF CRAY removed GSS2F402.308
CLL S J Swarbrick GSS2F402.309
CLL 4.4 08/09/97 L_BL_LSPICE specifies mixed phase precipitation ADM3F404.116
CLL scheme. D.Wilson ADM3F404.117
C 4.5 Jul. 98 Kill the IBM specific lines (JCThil) AJC1F405.56
C*L Arguaments ------------------------------------------------------- SFRIB5A.27
SUBROUTINE SF_RIB ( 2,6SFRIB5A.28
& P_POINTS,LAND_PTS,LAND_MASK,INT_STOM, SFRIB5A.29
& GATHER,P1,LAND_INDEX, SFRIB5A.31
& NSICE,SICE_INDEX,ICE_FRACT, SFRIB5A.33
& PSTAR,AK_1,BK_1,Q_1,QW_1,QCL_1,QCF_1, SFRIB5A.34
& CF_1,T_1,TL_1,QSL,QSTAR,QSTAR_LEAD, SFRIB5A.35
& QS1,TSTAR_NL,Z1,Z0M_EFF,Z0M,Z0H,Z0HS,Z0MSEA, SFRIB5A.36
& WIND_PROFILE_FACTOR,U_1_P,U_0_P,V_1_P,V_0_P, SFRIB5A.37
& ROOTD,SMVCCL,SMVCWT,SMC,V_SOIL,VFRAC,CANOPY,CATCH, SFRIB5A.38
& LYING_SNOW,GC,RESIST,RIB,RIB_LEAD,PSIS,VSHR,ALPHA1, SFRIB5A.39
& BT_1,BQ_1,BF_1,FRACA,RESFS,DQ,DQ_LEAD,DTEMP, ADM3F404.118
& DTEMP_LEAD,L_BL_LSPICE, ADM3F404.119
& LTIMER) SFRIB5A.41
IMPLICIT NONE SFRIB5A.42
SFRIB5A.43
SFRIB5A.44
INTEGER ! Variables defining grid. SFRIB5A.45
& P_POINTS ! IN Number of P-grid points to be processed SFRIB5A.46
&,LAND_PTS ! IN Number of land points to be processed. SFRIB5A.47
&,NSICE ! IN Number of sea-ice points. SFRIB5A.48
&,SICE_INDEX(P_POINTS) ! IN Index vector for gather to sea-ice SFRIB5A.49
C ! points SFRIB5A.50
SFRIB5A.51
&,LAND_INDEX(LAND_PTS)! IN Index for compressed land point array; SFRIB5A.53
C ! i'th element holds position in the FULL SFRIB5A.54
C ! field of the ith land pt to be SFRIB5A.55
C ! processed SFRIB5A.56
&,P1 ! IN First P-point to be processed. SFRIB5A.57
LOGICAL SFRIB5A.58
& GATHER ! IN If true then leads variables are comp- SFRIB5A.59
C ! ressed for sea-ice calculations. This SFRIB5A.60
C ! saves duplicating calculations if there SFRIB5A.61
C ! are a relatively few of sea-ice points. SFRIB5A.62
C ! Set to false for a limited area run SFRIB5A.63
C ! with a high proportion of sea-ice. SFRIB5A.64
LOGICAL SFRIB5A.66
& INT_STOM ! IN T for interactive stomatal resistance. SFRIB5A.67
&,L_BL_LSPICE ! IN ADM3F404.120
! TRUE Use scientific treatment of mixed ADM3F404.121
! phase precip scheme. ADM3F404.122
! FALSE Do not use mixed phase precip ADM3F404.123
! considerations ADM3F404.124
C SFRIB5A.68
REAL SFRIB5A.69
& AK_1 ! IN Hybrid "A" for lowest model layer. SFRIB5A.70
&,BK_1 ! IN Hybrid "B" for lowest model layer. SFRIB5A.71
&,CANOPY(LAND_PTS) ! IN Surface water (kg per sq metre). F642. SFRIB5A.72
&,CATCH(LAND_PTS) ! IN Surface capacity (max. surface water) SFRIB5A.73
C ! (kg per sq metre). F6416. SFRIB5A.74
&,CF_1(P_POINTS) ! IN Cloud fraction for lowest atmospheric SFRIB5A.75
C ! layer (decimal fraction). SFRIB5A.76
&,ICE_FRACT(P_POINTS) ! IN Fraction of gridbox which is sea-ice. SFRIB5A.77
&,LYING_SNOW(P_POINTS)! IN Lying snow amount (kg per sq metre). SFRIB5A.78
&,PSTAR(P_POINTS) ! IN Surface pressure (Pascals). SFRIB5A.79
&,Q_1(P_POINTS) ! IN Specific humidity for lowest SFRIB5A.80
C ! atmospheric layer (kg water per kg air) SFRIB5A.81
&,QCF_1(P_POINTS) ! IN Cloud ice for lowest atmospheric layer SFRIB5A.82
C ! (kg water per kg air). SFRIB5A.83
&,QCL_1(P_POINTS) ! IN Cloud liquid water for lowest atm layer SFRIB5A.84
C ! (kg water per kg air). SFRIB5A.85
&,QS1(P_POINTS) ! IN Sat. specific humidity qsat(TL_1,PSTAR) SFRIB5A.86
&,QSL(P_POINTS) ! IN Saturated sp humidity at liquid/ice SFRIB5A.87
C ! temperature and pressure of lowest SFRIB5A.88
C ! atmospheric level. SFRIB5A.89
&,QSTAR(P_POINTS) ! IN Surface saturated sp humidity. Holds SFRIB5A.90
C ! value over sea-ice where ICE_FRACT > 0. SFRIB5A.91
C ! i.e. Leads contribution not included. SFRIB5A.92
&,QSTAR_LEAD(P_POINTS) ! IN QSTAR for sea-ice leads. SFRIB5A.93
C ! Missing data indicator over non sea-ice. SFRIB5A.94
&,GC(LAND_PTS) ! IN Interactive canopy conductance SFRIB5A.95
C ! to evaporation (m/s) SFRIB5A.96
&,RESIST(LAND_PTS) ! IN Fixed "stomatal" resistance SFRIB5A.97
C ! to evaporation (s/m) SFRIB5A.98
&,ROOTD(LAND_PTS) ! IN "Root depth" (metres). F6412. SFRIB5A.99
&,SMC(LAND_PTS) ! IN Soil moisture content (kg per sq m). SFRIB5A.100
C ! F621. SFRIB5A.101
&,SMVCCL(LAND_PTS) ! IN Critical volumetric SMC (cubic metres SFRIB5A.102
C ! per cubic metre of soil). F6232. SFRIB5A.103
&,SMVCWT(LAND_PTS) ! IN Volumetric wilting point (cubic m of SFRIB5A.104
C ! water per cubic m of soil). F6231. SFRIB5A.105
C SFRIB5A.106
C Note: (SMVCCL - SMVCWT) is the critical volumetric available soil SFRIB5A.107
C moisture content. ~~~~~~~~~ SFRIB5A.108
C SFRIB5A.109
&,T_1(P_POINTS) ! IN Temperature for lowest atmospheric layer SFRIB5A.110
C ! (Kelvin). SFRIB5A.111
&,TL_1(P_POINTS) ! IN Liquid/frozen water temperature for SFRIB5A.112
C ! lowest atmospheric layer (K). SFRIB5A.113
&,TSTAR_NL(P_POINTS) ! IN TSTAR No Leads: surface temperature SFRIB5A.114
C ! over sea-ice fraction of gridsquare. SFRIB5A.115
C ! =TSTAR over non sea-ice points. SFRIB5A.116
&,U_1_P(P_POINTS) ! IN West-to-east wind component for lowest SFRIB5A.117
C ! atmospheric layer (m/s). On P grid. SFRIB5A.118
&,V_1_P(P_POINTS) ! IN South-to-north wind component for lowest SFRIB5A.122
C ! atmospheric layer (m/s). On P grid. SFRIB5A.123
&,U_0_P(P_POINTS) ! IN West-to-east component of ocean surface SFRIB5A.127
C ! current (m/s; zero over land if U_0 OK). SFRIB5A.128
C ! P grid. F615. SFRIB5A.129
&,V_0_P(P_POINTS) ! IN South-to-north component of ocean surface SFRIB5A.130
C ! current (m/s; zero over land if V_0 OK). SFRIB5A.131
C ! P grid. F616. SFRIB5A.132
&,V_SOIL(LAND_PTS) ! IN Volumetric soil moisture concentration SFRIB5A.133
C ! in the top soil layer (m3 H2O/m3 soil). SFRIB5A.134
&,VFRAC(LAND_PTS) ! IN Vegetated fraction. SFRIB5A.135
&,WIND_PROFILE_FACTOR(P_POINTS) SFRIB5A.136
C ! IN For transforming effective surface transf SFRIB5A.137
C ! coefficients to those excluding form drag SFRIB5A.138
+,Z0H(P_POINTS) ! IN Roughness length for heat and moisture m SFRIB5A.139
+,Z0HS(P_POINTS) ! IN Roughness length for heat and moisture SFRIB5A.140
C ! transport over sea. SFRIB5A.141
&,Z0M(P_POINTS) ! IN Roughness length for heat and moisture m SFRIB5A.142
&,Z0MSEA(P_POINTS) ! IN Sea-surface roughness length for SFRIB5A.143
C ! momentum (m). F617. SFRIB5A.144
&,Z0M_EFF(P_POINTS) ! IN Effective roughness length for momentum SFRIB5A.145
&,Z1(P_POINTS) ! IN Height of lowest atmospheric level (m). SFRIB5A.146
LOGICAL SFRIB5A.147
& LAND_MASK(P_POINTS) ! IN .TRUE. for land; .FALSE. elsewhere. F60. SFRIB5A.148
C SFRIB5A.149
C Output variables. SFRIB5A.150
C SFRIB5A.151
REAL SFRIB5A.152
& ALPHA1(P_POINTS) ! OUT Gradient of saturated specific humidity SFRIB5A.153
C ! with respect to temperature between the SFRIB5A.154
C ! bottom model layer and the surface SFRIB5A.155
&,BQ_1(P_POINTS) ! OUT A buoyancy parameter for lowest atm SFRIB5A.156
C ! level. ("beta-q twiddle"). SFRIB5A.157
&,BF_1(P_POINTS) ADM3F404.125
! OUT A buoyancy parameter for lowest atm level. ADM3F404.126
! ("beta-q twiddle"). ADM3F404.127
&,BT_1(P_POINTS) ! OUT A buoyancy parameter for lowest atm SFRIB5A.158
C ! level. ("beta-T twiddle"). SFRIB5A.159
&,DQ(P_POINTS) ! OUT Sp humidity difference between surface SFRIB5A.160
C ! and lowest atmospheric level (Q1 - Q*). SFRIB5A.161
C ! Holds value over sea-ice where SFRIB5A.162
C ! ICE_FRACT>0 i.e. Leads contribution not SFRIB5A.163
C ! included. SFRIB5A.164
&,DQ_LEAD(P_POINTS) ! OUT DQ for leads fraction of gridsquare. SFRIB5A.165
&,DTEMP(P_POINTS) ! OUT Liquid/ice static energy difference SFRIB5A.166
C ! between surface and lowest atmospheric SFRIB5A.167
C ! level, divided by CP (a modified SFRIB5A.168
C ! temperature difference). SFRIB5A.169
C ! Holds value over sea-ice where SFRIB5A.170
C ! ICE_FRACT>0 i.e. Leads contribution not SFRIB5A.171
C ! included. SFRIB5A.172
&,DTEMP_LEAD(P_POINTS) ! OUT DTEMP for leads fraction of SFRIB5A.173
C ! gridsquare. SFRIB5A.174
&,FRACA(P_POINTS) ! OUT Fraction of surface moisture flux with SFRIB5A.175
C ! only aerodynamic resistance. SFRIB5A.176
&,PSIS(P_POINTS) ! Soil moisture availability factor. SFRIB5A.177
&,QW_1(P_POINTS) ! OUT Total water content of lowest SFRIB5A.178
C ! atmospheric layer (kg per kg air). SFRIB5A.179
&,RESFS(P_POINTS) ! OUT Combined soil, stomatal and aerodynamic SFRIB5A.180
C ! resistance factor = PSIS/(1+RS/RA) for SFRIB5A.181
C ! fraction (1-FRACA) SFRIB5A.182
&,RESFT(P_POINTS) ! OUT Total resistance factor SFRIB5A.183
C ! FRACA+(1-FRACA)*RESFS. SFRIB5A.184
&,RIB(P_POINTS) ! OUT Bulk Richardson number for lowest layer SFRIB5A.185
&,RIB_LEAD(P_POINTS) ! OUT Bulk Richardson no. for sea-ice leads SFRIB5A.186
C ! at lowest layer. At non sea-ice points SFRIB5A.187
C ! holds RIB for FCDCH calculation, then SFRIB5A.188
C ! set to missing data indicator. SFRIB5A.189
&,VSHR(P_POINTS) ! OUT Magnitude of surface-to-lowest-lev. wind SFRIB5A.190
C SFRIB5A.191
LOGICAL LTIMER ! Logical switch for TIMER diags SFRIB5A.192
C* SFRIB5A.193
C*L Symbolic constants ----------------------------------------------- SFRIB5A.194
C SFRIB5A.195
SFRIB5A.196
*CALL C_MDI 
SFRIB5A.197
*CALL C_0_DG_C SFRIB5A.198
*CALL C_G SFRIB5A.199
*CALL C_LHEAT SFRIB5A.200
*CALL C_SOILH SFRIB5A.201
*CALL C_R_CP SFRIB5A.202
*CALL C_EPSLON SFRIB5A.203
*CALL C_VKMAN SFRIB5A.204
*CALL C_DENSTY SFRIB5A.205
C SFRIB5A.206
C (3) Derived local parameters. SFRIB5A.207
C SFRIB5A.208
REAL ETAR,GRCP,LCRCP,LFRCP,LS,LSRCP SFRIB5A.209
PARAMETER ( SFRIB5A.210
& ETAR=1./(1.-EPSILON) ! Used in calc of buoyancy parameter BETAC SFRIB5A.211
&,GRCP=G/CP ! Used in calc of dT across surface layer. SFRIB5A.212
&,LCRCP=LC/CP ! Evaporation-to-dT conversion factor. SFRIB5A.213
&,LFRCP=LF/CP ! Freezing-to-dT conversion factor. SFRIB5A.214
&,LS=LF+LC ! Latent heat of sublimation. SFRIB5A.215
&,LSRCP=LS/CP ! Sublimation-to-dT conversion factor. SFRIB5A.216
& ) SFRIB5A.217
SFRIB5A.218
C Define local storage. SFRIB5A.219
C SFRIB5A.220
C (a) Workspace. SFRIB5A.221
C SFRIB5A.222
C*L Workspace -------------------------------------------------------- SFRIB5A.223
INTEGER SFRIB5A.224
& I ! Loop counter (horizontal field index). SFRIB5A.225
&,L ! Loop counter (land field index). SFRIB5A.226
&,SI ! Loop counter (sea-ice field index). SFRIB5A.227
REAL SFRIB5A.228
& AL ! Temporary in calculation of buoyancy parameters. SFRIB5A.229
&,ALPHAL ! Temporary in calculation of buoyancy parameters. SFRIB5A.230
&,BETAC ! Temporary in calculation of buoyancy parameters. SFRIB5A.231
&,BETAQ ! Temporary in calculation of buoyancy parameters. SFRIB5A.232
&,BETAT ! Temporary in calculation of buoyancy parameters. SFRIB5A.233
&,D_T ! Temporary in calculation of alpha1 SFRIB5A.234
&,USHEAR ! U-component of surface-to-lowest-level wind shear. SFRIB5A.235
&,VSHEAR ! V-component of surface-to-lowest-level wind shear. SFRIB5A.236
&,VSHR2 ! Square of magnitude of surface-to-lowest-level SFRIB5A.237
C ! wind shear. SFRIB5A.238
&,ZETAM ! Temporary in calculation of CHN. SFRIB5A.239
&,ZETAH ! Temporary in calculation of CHN. SFRIB5A.240
SFRIB5A.241
REAL SFRIB5A.243
& CHN(P_POINTS) ! Neutral-stability value of CH, used as a firs SFRIB5A.244
C ! approximation to the "true" CH. SFRIB5A.245
&,EPDT(P_POINTS) ! "Potential" Evaporation * Timestep - dummy SFRIB5A.246
C ! variale = 0. SFRIB5A.247
&,F_SE(P_POINTS) ! Dummy variable - actual value set in SFRIB5A.248
C ! 2nd Call to SF_RESIST in SF_EXCH SFRIB5A.249
SFRIB5A.260
SFRIB5A.261
EXTERNAL SF_RESIST SFRIB5A.262
IF (LTIMER) THEN SFRIB5A.263
CALL TIMER('SFRIB ',3) SFRIB5A.264
ENDIF SFRIB5A.265
SFRIB5A.266
C---------------------------------------------------------------------- SFRIB5A.267
CL 1 Calculate buoyancy parameters for the lowest model level. SFRIB5A.268
C---------------------------------------------------------------------- SFRIB5A.269
DO I=1,P_POINTS SFRIB5A.270
IF (L_BL_LSPICE) THEN ADM3F404.128
QW_1(I) = Q_1(I) + QCL_1(I) ! P243.10 ADM3F404.129
ELSE ADM3F404.130
QW_1(I) = Q_1(I) + QCL_1(I) + QCF_1(I) ! P243.10 ADM3F404.131
ENDIF ADM3F404.132
BETAT = 1.0 / T_1(I) ! P243.19 (1st eqn) SFRIB5A.272
BETAQ = C_VIRTUAL / SFRIB5A.273
& ( 1.0 + C_VIRTUAL*Q_1(I) - QCL_1(I) - QCF_1(I) ) SFRIB5A.274
C ... P243.19 (2nd eqn) SFRIB5A.275
C SFRIB5A.276
IF (TL_1(I).GT.TM.OR.L_BL_LSPICE) THEN ADM3F404.133
ALPHAL = (EPSILON * LC * QSL(I)) / (R * TL_1(I) * TL_1(I)) SFRIB5A.278
C ... P243.20 (Clausius-Clapeyron) SFRIB5A.279
C SFRIB5A.280
AL = 1.0 / (1.0 + LCRCP*ALPHAL) ! P243.21 SFRIB5A.281
BETAC = CF_1(I) * AL * (LCRCP*BETAT - ETAR*BETAQ) SFRIB5A.282
C ... P243.19 (3rd eqn) SFRIB5A.283
C SFRIB5A.284
ELSE SFRIB5A.285
ALPHAL = (EPSILON * LS * QSL(I)) / (R * TL_1(I) * TL_1(I)) SFRIB5A.286
C ... P243.20 (Clausius-Clapeyron) SFRIB5A.287
C SFRIB5A.288
AL = 1.0 / (1.0 + LSRCP*ALPHAL) ! P243.21 SFRIB5A.289
BETAC = CF_1(I) * AL * (LSRCP*BETAT - ETAR*BETAQ) SFRIB5A.290
C ... P243.19 (3rd eqn) SFRIB5A.291
C SFRIB5A.292
ENDIF SFRIB5A.293
BT_1(I) = BETAT - ALPHAL*BETAC ! P243.18 (1st eqn) SFRIB5A.294
BQ_1(I) = BETAQ + BETAC ! P243.18 (2nd eqn) SFRIB5A.295
BF_1(I) = BETAQ *EPSILON*ETAR ! P243.18 (2nd eqn) ADM3F404.134
C SFRIB5A.296
C SFRIB5A.297
C*********************************************************************** SFRIB5A.298
C 2. Calculate ALPHA1 {qsat(T*,P*) -qsat(TL1,P*)}/ SFRIB5A.299
C {T*-TL1} for land and sea-ice points only - SFRIB5A.300
C set to zero over sea points SFRIB5A.301
C*********************************************************************** SFRIB5A.302
C SFRIB5A.303
D_T = TSTAR_NL(I)-TL_1(I) SFRIB5A.304
IF (D_T .GT. 0.05 .OR. D_T .LT. -0.05) THEN SFRIB5A.305
ALPHA1(I) = (QSTAR(I) - QS1(I)) / D_T SFRIB5A.306
ELSE IF (TL_1(I).GT.TM) THEN SFRIB5A.307
ALPHA1(I) = (EPSILON*LC*QS1(I)*(1.0+C_VIRTUAL*QS1(I))) SFRIB5A.308
& / (R*TL_1(I)*TL_1(I)) SFRIB5A.309
ELSE SFRIB5A.310
ALPHA1(I) = (EPSILON*LS*QS1(I)*(1.0+C_VIRTUAL*QS1(I))) SFRIB5A.311
& / (R*TL_1(I)*TL_1(I)) SFRIB5A.312
ENDIF SFRIB5A.313
IF (.NOT.LAND_MASK(I).AND.ICE_FRACT(I).LE.0.0) SFRIB5A.314
& ALPHA1(I) = 0.0 ! Sea points SFRIB5A.315
ENDDO SFRIB5A.316
C----------------------------------------------------------------------- SFRIB5A.317
CL 3 Calculate temperature (strictly, liquid/ice static energy) and SFRIB5A.318
CL humidity jumps, and wind shear, across the surface layer. SFRIB5A.319
CL Separate values are required for the leads and ice fractions SFRIB5A.320
CL of sea-ice grid-squares. SFRIB5A.321
C----------------------------------------------------------------------- SFRIB5A.322
IF (GATHER) THEN SFRIB5A.324
DO I=1,P_POINTS SFRIB5A.325
DTEMP(I) = TL_1(I) - TSTAR_NL(I) SFRIB5A.326
& + GRCP * ( Z1(I) + Z0M_EFF(I) - Z0H(I) ) SFRIB5A.327
C ! P243.118 SFRIB5A.328
DQ(I) = QW_1(I) - QSTAR(I) ! P243.119 SFRIB5A.329
C SFRIB5A.330
DTEMP_LEAD(I) = 1.E30 ! Missing data indicato SFRIB5A.331
DQ_LEAD(I) = 1.E30 ! Missing data indicato SFRIB5A.332
USHEAR = U_1_P(I) - U_0_P(I) SFRIB5A.333
VSHEAR = V_1_P(I) - V_0_P(I) SFRIB5A.334
VSHR2 = MAX (1.0E-6 , USHEAR*USHEAR + VSHEAR*VSHEAR) SFRIB5A.335
VSHR(I) = SQRT(VSHR2) SFRIB5A.336
C ... P243.120 (previous 4 lines of code) SFRIB5A.337
ENDDO SFRIB5A.338
C----------------------------------------------------------------------- SFRIB5A.339
CL 4 Calculate leads values by looping round sea-ice points only. SFRIB5A.340
C Avoids an if test in the above loop, so code can run faster. SFRIB5A.341
C----------------------------------------------------------------------- SFRIB5A.342
CDIR$ IVDEP SFRIB5A.343
! Fujitsu vectorization directive GRB0F405.507
!OCL NOVREC GRB0F405.508
DO SI=1,NSICE SFRIB5A.344
I = SICE_INDEX(SI) SFRIB5A.345
DTEMP_LEAD(I) = TL_1(I)-TFS + GRCP*(Z1(I)+Z0MSEA(I)-Z0HS(I)) SFRIB5A.346
DQ_LEAD(I) = QW_1(I) - QSTAR_LEAD(SI) SFRIB5A.347
ENDDO SFRIB5A.348
ELSE SFRIB5A.349
DO I=1,P_POINTS SFRIB5A.351
USHEAR = U_1_P(I) - U_0_P(I) SFRIB5A.352
VSHEAR = V_1_P(I) - V_0_P(I) SFRIB5A.353
SFRIB5A.354
VSHR2 = MAX (1.0E-6 , USHEAR*USHEAR + VSHEAR*VSHEAR) SFRIB5A.355
VSHR(I) = SQRT(VSHR2) SFRIB5A.356
C ... P243.120 (previous 4 lines of code) SFRIB5A.357
DTEMP(I) = TL_1(I) - TSTAR_NL(I) SFRIB5A.358
& + GRCP * ( Z1(I) + Z0M_EFF(I) - Z0H(I) ) SFRIB5A.359
C ! P243.118 SFRIB5A.360
DQ(I) = QW_1(I) - QSTAR(I) ! P243.119 SFRIB5A.361
C SFRIB5A.362
IF ( ICE_FRACT(I).GT.0.0 .AND. .NOT.LAND_MASK(I) ) THEN SFRIB5A.363
DTEMP_LEAD(I) = TL_1(I)-TFS + GRCP*(Z1(I)+Z0MSEA(I)-Z0HS(I)) SFRIB5A.364
DQ_LEAD(I) = QW_1(I) - QSTAR_LEAD(I) SFRIB5A.365
ELSE SFRIB5A.366
DTEMP_LEAD(I) = RMDI ! Missing data indicator SFRIB5A.367
DQ_LEAD(I) = RMDI ! Missing data indicator SFRIB5A.368
ENDIF SFRIB5A.369
C SFRIB5A.370
ENDDO SFRIB5A.371
ENDIF ! End of IF (GATHER) THEN... ELSE... SFRIB5A.373
SFRIB5A.375
SFRIB5A.376
C----------------------------------------------------------------------- SFRIB5A.377
CL 6 Evaporation over land surfaces without snow is limited by SFRIB5A.378
CL soil moisture availability and stomatal resistance. SFRIB5A.379
C Set FRACA (= fA in the documentation) according to P243.68, SFRIB5A.380
C PSIS according to P243.65, and RESFS (= fS) according to P243.75 SFRIB5A.381
C and P243.61, using neutral-stability value of CH (as explained SFRIB5A.382
C in section (v) of the P243 documentation). SFRIB5A.383
C----------------------------------------------------------------------- SFRIB5A.384
SFRIB5A.385
DO I=1,P_POINTS SFRIB5A.386
SFRIB5A.387
C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - SFRIB5A.388
CL 6.2.1 Calculate neutral stability value of CH (CHN), as an SFRIB5A.389
CL approximation to CH. SFRIB5A.390
C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - SFRIB5A.391
ZETAM = LOG ( (Z1(I) + Z0M_EFF(I))/Z0M_EFF(I) ) SFRIB5A.392
ZETAH = LOG ( (Z1(I) + Z0M_EFF(I))/Z0H(I) ) SFRIB5A.393
CHN(I) = (VKMAN/ZETAH) * (VKMAN/ZETAM) * WIND_PROFILE_FACTOR(I) SFRIB5A.394
SFRIB5A.395
EPDT(I) = 0.0 !Dummy variable for SF_RESIST SFRIB5A.396
SFRIB5A.397
ENDDO ! Calc of CHN SFRIB5A.398
SFRIB5A.399
SFRIB5A.400
CALL SF_RESIST ( SFRIB5A.401
& P_POINTS,LAND_PTS,LAND_MASK,INT_STOM, SFRIB5A.402
& P1,LAND_INDEX, SFRIB5A.404
& ROOTD,SMVCCL,SMVCWT,SMC,V_SOIL,VFRAC,CANOPY,CATCH,DQ, SFRIB5A.406
& EPDT,LYING_SNOW,GC,RESIST,VSHR,CHN,PSIS,FRACA, SFRIB5A.407
& RESFS,F_SE,RESFT,LTIMER SFRIB5A.408
& ) SFRIB5A.409
SFRIB5A.410
SFRIB5A.411
C----------------------------------------------------------------------- SFRIB5A.412
CL 7 Calculate bulk Richardson numbers for the surface layer. SFRIB5A.413
CL At sea-ice points RIB contains value for ice only (not leads). SFRIB5A.414
CL Initialise RIB_LEAD to RIB so that it contains sensible SFRIB5A.415
CL values at non sea ice points for the FCDCH calculation below. SFRIB5A.416
C----------------------------------------------------------------------- SFRIB5A.417
IF (GATHER) THEN SFRIB5A.419
DO I=1,P_POINTS SFRIB5A.420
RIB(I) = G * Z1(I) * SFRIB5A.421
& ( BT_1(I)*DTEMP(I) + BQ_1(I)*RESFT(I)*DQ(I) ) / SFRIB5A.422
& ( VSHR(I)*VSHR(I) ) SFRIB5A.423
RIB_LEAD(I) = RIB(I) SFRIB5A.424
ENDDO SFRIB5A.425
C----------------------------------------------------------------------- SFRIB5A.426
CL 7.1 Calculate bulk Richardson no. for leads at sea-ice points SFRIB5A.427
CL only. SFRIB5A.428
C----------------------------------------------------------------------- SFRIB5A.429
CDIR$ IVDEP SFRIB5A.430
! Fujitsu vectorization directive GRB0F405.509
!OCL NOVREC GRB0F405.510
DO SI = 1,NSICE SFRIB5A.431
I = SICE_INDEX(SI) SFRIB5A.432
RIB_LEAD(I) = G * Z1(I) * SFRIB5A.433
& ( BT_1(I) * DTEMP_LEAD(I) + SFRIB5A.434
& BQ_1(I) * RESFT(I) * DQ_LEAD(I) ) / SFRIB5A.435
& ( VSHR(I) * VSHR(I) ) SFRIB5A.436
C ... P2430.2, for sea-ice leads. SFRIB5A.437
ENDDO SFRIB5A.438
ELSE SFRIB5A.439
DO I=1,P_POINTS SFRIB5A.441
RIB(I) = G * Z1(I) * SFRIB5A.442
& ( BT_1(I)*DTEMP(I) + BQ_1(I)*RESFT(I)*DQ(I) ) / SFRIB5A.443
& ( VSHR(I)*VSHR(I) ) SFRIB5A.444
C ... P243.43 (G times middle line is surface SFRIB5A.445
C layer buoyancy difference, P243.25) SFRIB5A.446
C SFRIB5A.447
RIB_LEAD(I) = RIB(I) SFRIB5A.448
IF ( ICE_FRACT(I).GT.0.0 .AND. .NOT.LAND_MASK(I) ) THEN SFRIB5A.449
RIB_LEAD(I) = G * Z1(I) * SFRIB5A.450
& ( BT_1(I) * DTEMP_LEAD(I) + SFRIB5A.451
& BQ_1(I) * RESFT(I) * DQ_LEAD(I) ) / SFRIB5A.452
& ( VSHR(I) * VSHR(I) ) SFRIB5A.453
C ... P2430.2, for sea-ice leads. SFRIB5A.454
ENDIF SFRIB5A.455
ENDDO SFRIB5A.456
ENDIF ! End of IF (GATHER) THEN... ELSE... SFRIB5A.458
SFRIB5A.460
C SFRIB5A.461
IF (LTIMER) THEN SFRIB5A.462
CALL TIMER('SFRIB ',4) SFRIB5A.463
ENDIF SFRIB5A.464
RETURN SFRIB5A.465
END SFRIB5A.466
SFRIB5A.467
*ENDIF SFRIB5A.468