*IF DEF,A03_3A ASJ4F401.1
C ******************************COPYRIGHT****************************** GTS2F400.451
C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved. GTS2F400.452
C GTS2F400.453
C Use, duplication or disclosure of this code is subject to the GTS2F400.454
C restrictions as set forth in the contract. GTS2F400.455
C GTS2F400.456
C Meteorological Office GTS2F400.457
C London Road GTS2F400.458
C BRACKNELL GTS2F400.459
C Berkshire UK GTS2F400.460
C RG12 2SZ GTS2F400.461
C GTS2F400.462
C If no contract has been raised with this copy of the code, the use, GTS2F400.463
C duplication or disclosure of it is strictly prohibited. Permission GTS2F400.464
C to do so must first be obtained in writing from the Head of Numerical GTS2F400.465
C Modelling at the above address. GTS2F400.466
C ******************************COPYRIGHT****************************** GTS2F400.467
C GTS2F400.468
C*LL SUBROUTINE BDY_LAYR----------------------------------------------- BDYLYR3A.3
CLL BDYLYR3A.4
CLL Purpose: Calculate turbulent fluxes of heat, moisture and momentum BDYLYR3A.5
CLL between (a) surface and atmosphere, (b) atmospheric levels BDYLYR3A.6
CLL within the boundary layer, and/or the effects of these BDYLYR3A.7
CLL fluxes on the primary model variables. The flux of heat BDYLYR3A.8
CLL into and through the soil is also modelled. Numerous BDYLYR3A.9
CLL related diagnostics are also calculated. BDYLYR3A.10
CLL BDYLYR3A.12
CLL If the point for a single column run is a sea point then the BDYLYR3A.13
CLL land mask ensures that correct calculations are done; LAND_FIELD BDYLYR3A.14
CLL dimensions land point arrays and so its value is irrelevent in BDYLYR3A.15
CLL this case. An error is generated if LAND_FIELD is not one in the BDYLYR3A.16
CLL land point case. BDYLYR3A.17
CLL F E Hewer, July 1990: removed call to LS_CLD. BDYLYR3A.19
CLL This version passes out liquid/frozen water temperature in BDYLYR3A.20
CLL array "T" (TL), and total water content in array "Q" (QW). BDYLYR3A.21
CLL These may be converted to T and Q respectively by calling BDYLYR3A.22
CLL the large scale cloud routine, LS_CLD. BDYLYR3A.23
CLL F E Hewer, August 1990: land point data stored BDYLYR3A.24
CLL on land points only (dimension: LAND_FIELD, arrays:CANOPY, CATCH BDYLYR3A.25
CLL HCAP, HCON, RESIST, ROOTDEP, SMC, SMVCCL, SMVCWT, T_DEEP_SOIL) BDYLYR3A.26
CLL Arrays whose elements may contain values over both sea and land BDYLYR3A.27
CLL points are compressed onto land points for land calculations if BDYLYR3A.28
CLL defined variable IBM is NOT selected. RHOKM,RHOKH redefined as BDYLYR3A.29
CLL workspace. BDYLYR3A.30
CLL BDYLYR3A.31
CLL Suitable for single column use AJC1F405.519
CLL BDYLYR3A.33
CLL F.Hewer <- programmer of some or all of previous code or changes BDYLYR3A.34
CLL C.Wilson <- programmer of some or all of previous code or changes BDYLYR3A.35
CLL BDYLYR3A.36
CLL Model Modification history: BDYLYR3A.37
CLL version Date BDYLYR3A.38
CLL 3.4 18/10/94 *DECK inserted into UM version 3.4. S Jackson BDYLYR3A.39
CLL BDYLYR3A.40
CLL 4.0 05/01/95 rhostar*cD*modv1 and rho*Km output via argument ASJ1F400.1
CLL list for STASHing. R.N.B.Smith ASJ1F400.2
CLL ASJ1F400.3
CLL 4.0 30/12/94 References to z0h_eff removed for reformulated ARN1F400.2
CLL surface transfer coefficients for scalars. ARN1F400.3
CLL R.N.B.Smith ARN1F400.4
! 4.1 23/05/96 MPP code: Change updateable area P.Burton APBGF401.1
CLL 4.1 5/6/96 DS_LEVELS chnaged to ST_LEVELS and SM_LEVELS AJS1F401.1085
CLL C.Bunton AJS1F401.1086
CLL ASJ3F401.1
CLL 4.1 08/05/96 Logical L_RMBL included to select rapidly mixing ASJ3F401.2
CLL boundary layer scheme Simon Jackson ASJ3F401.3
CLL ASJ3F401.4
CLL 4.1 08/05/96 decks A03_2C and A03_3B removed ASJ4F401.2
CLL S D Jackson ASJ4F401.3
CLL 4.2 Oct. 96 T3E migration - *DEF CRAY removed GSS1F402.60
CLL S J Swarbrick GSS1F402.61
CLL ASJ4F401.4
CLL 4.3 04/02/97 Logical switches L_MOM and L_MIXLEN passed down ARN1F403.27
CLL to KHKH and thence EXCOEF. ARN1F403.28
CLL R.N.B.Smith ARN1F403.29
CLL 4.4 08/09/97 L_BL_LSPICE specifies mixed phase precipitation ADM3F404.204
CLL scheme D.Wilson ADM3F404.205
!!! 4.5 Jul. 98 Kill the IBM specific lines. (JCThil) AJC1F405.518
CLL ARN1F403.30
CLL Programming standard: Unified Model Documentation Paper No 4, BDYLYR3A.41
CLL Version ?, dated ?. BDYLYR3A.42
CLL BDYLYR3A.43
CLL System component covered: P24. BDYLYR3A.44
CLL BDYLYR3A.45
CLL Project task: BDYLYR3A.46
CLL BDYLYR3A.47
CLL Documentation: UMDP 24. BDYLYR3A.48
CLL BDYLYR3A.49
CLL--------------------------------------------------------------------- BDYLYR3A.50
C* BDYLYR3A.51
C*L--------------------------------------------------------------------- BDYLYR3A.52
C Arguments :- BDYLYR3A.53
SUBROUTINE BDY_LAYR ( 4,80BDYLYR3A.54
BDYLYR3A.55
C IN values defining field dimensions and subset to be processed : BDYLYR3A.56
+ P_FIELD,U_FIELD,LAND_FIELD,P_ROWS,FIRST_ROW,N_ROWS,ROW_LENGTH BDYLYR3A.57
BDYLYR3A.58
C IN values defining vertical grid of model atmosphere : BDYLYR3A.59
+,BL_LEVELS,P_LEVELS,AK,BK,AKH,BKH,DELTA_AK,DELTA_BK BDYLYR3A.60
+,EXNER BDYLYR3A.61
BDYLYR3A.62
C IN soil/vegetation/land surface data : BDYLYR3A.63
+,LAND_MASK,GATHER,LAND_INDEX BDYLYR3A.67
+,ST_LEVELS,SM_LEVELS,CANOPY,CATCH,HCAP,HCON,LAYER_DEPTH AJS1F401.1088
+,LYING_SNOW,RESIST,ROOTD,SMC,SMVCCL,SMVCWT,Z0V,SIL_OROG_LAND BDYLYR3A.70
+,L_Z0_OROG,HO2R2_OROG BDYLYR3A.71
BDYLYR3A.72
C IN sea/sea-ice data : BDYLYR3A.73
+,DI,ICE_FRACT,U_0,V_0 BDYLYR3A.74
BDYLYR3A.75
C IN cloud data : BDYLYR3A.76
+,CF,QCF,QCL BDYLYR3A.77
+,CCA,CCB,CCT BDYLYR3A.78
BDYLYR3A.79
C IN everything not covered so far : BDYLYR3A.80
+,PSTAR,RADNET,TIMESTEP,L_RMBL,L_BL_LSPICE,L_MOM,L_MIXLEN ADM3F404.206
BDYLYR3A.82
C INOUT data : BDYLYR3A.83
+,Q,T,T_DEEP_SOIL,TSTAR,U,V,Z0MSEA BDYLYR3A.84
BDYLYR3A.85
C OUT Diagnostic not requiring STASH flags : BDYLYR3A.86
+,CD,CH,E_SEA,FQW,FTL,H_SEA,RHOKH,RHOKM,RIB BDYLYR3A.87
+,SEA_ICE_HTF,SOIL_HT_FLUX,TAUX,TAUY,VSHR BDYLYR3A.88
BDYLYR3A.89
C OUT diagnostic requiring STASH flags : BDYLYR3A.90
+,FME,SICE_MLT_HTF,LATENT_HEAT,Q1P5M,T1P5M,U10M,V10M BDYLYR3A.91
C (IN) STASH flags :- BDYLYR3A.92
+,SFME,SMLT,SLH,SQ1P5,ST1P5,SU10,SV10 BDYLYR3A.93
BDYLYR3A.94
C OUT data required for tracer mixing : BDYLYR3A.95
&,NRML BDYLYR3A.96
BDYLYR3A.97
C OUT data required for 4D-VAR : ASJ1F400.4
&,RHO_CD_MODV1,RHO_KM ASJ1F400.5
ASJ1F400.6
C OUT data required elsewhere in UM system : BDYLYR3A.98
+,ECAN,EI,ES,ZH,T1_SD,Q1_SD,ERROR BDYLYR3A.99
BDYLYR3A.100
C LOGICAL LTIMER BDYLYR3A.101
+,LTIMER BDYLYR3A.102
*IF DEF,SCMA AJC0F405.64
& ,FACTOR_RHOKH,OBS AJC0F405.65
*ENDIF AJC0F405.66
+) BDYLYR3A.103
IMPLICIT NONE BDYLYR3A.104
C BDYLYR3A.105
C Inputs :- BDYLYR3A.106
C BDYLYR3A.107
C (a) Defining horizontal grid and subset thereof to be processed. BDYLYR3A.108
C BDYLYR3A.109
INTEGER BDYLYR3A.110
+ P_FIELD ! IN No. of P-points in whole grid BDYLYR3A.111
C ! (for dimensioning only). BDYLYR3A.112
+,U_FIELD ! IN No. of UV-points in whole grid. BDYLYR3A.116
C ! (Checked for consistency with BDYLYR3A.118
C ! P_FIELD and P_ROWS; there must BDYLYR3A.119
C ! be 1 less UV than P row.) BDYLYR3A.120
+,LAND_FIELD ! IN No.of land points in whole grid. BDYLYR3A.124
C ! (Checked for consistency with BDYLYR3A.126
C ! P_FIELD ) BDYLYR3A.127
+,P_ROWS ! IN No. of P-rows in whole grid BDYLYR3A.132
C ! (for dimensioning only). BDYLYR3A.133
+,FIRST_ROW ! IN First row of data to be treated, BDYLYR3A.137
C ! referred to P-grid (must be > 1 BDYLYR3A.139
C ! since "polar" rows are never BDYLYR3A.140
C ! treated). BDYLYR3A.141
+,N_ROWS ! IN No. of rows of data to be BDYLYR3A.145
C ! treated, referred to P-grid. BDYLYR3A.146
C ! FIRST_ROW+N_ROWS-1 must be less BDYLYR3A.148
C ! than P_ROWS, since "polar" rows BDYLYR3A.149
C ! are never treated. BDYLYR3A.150
+,ROW_LENGTH ! IN No. of points in one row. BDYLYR3A.154
C ! (Checked for consistency with BDYLYR3A.156
C ! P_FIELD and N_ROWS.) BDYLYR3A.157
C BDYLYR3A.161
C (b) Defining vertical grid of model atmosphere. BDYLYR3A.162
C BDYLYR3A.163
INTEGER BDYLYR3A.164
+ BL_LEVELS ! IN Max. no. of "boundary" levels BDYLYR3A.165
C ! allowed.Assumed <= 30 for dim- BDYLYR3A.166
C ! sioning of GAMMA in common deck BDYLYR3A.167
C ! C_GAMMA used in SF_EXCH and KMKH BDYLYR3A.168
+,P_LEVELS ! IN Total no. of vertical levels in BDYLYR3A.169
C ! the model atmosphere. BDYLYR3A.170
REAL BDYLYR3A.171
+ AK(P_LEVELS) ! IN Hybrid 'A' for all levels. BDYLYR3A.172
+,BK(P_LEVELS) ! IN Hybrid 'B' for all levels. BDYLYR3A.173
+,AKH(P_LEVELS+1) ! IN Hybrid 'A' for layer interfaces. BDYLYR3A.174
+,BKH(P_LEVELS+1) ! IN Hybrid 'B' for layer interfaces. BDYLYR3A.175
+,DELTA_AK(P_LEVELS) ! IN Difference of hybrid 'A' across BDYLYR3A.176
C ! layers (K-1/2 to K+1/2). BDYLYR3A.177
C ! NB: Upper minus lower. BDYLYR3A.178
+,DELTA_BK(P_LEVELS) ! IN Difference of hybrid 'B' across BDYLYR3A.179
C ! layers (K-1/2 to K+1/2). BDYLYR3A.180
C ! NB: Upper minus lower. BDYLYR3A.181
+,EXNER(P_FIELD,BL_LEVELS+1) ! IN Exner function. EXNER(,K) is BDYLYR3A.182
C ! value for LOWER BOUNDARY of BDYLYR3A.183
C ! level K. BDYLYR3A.184
C BDYLYR3A.185
C (c) Soil/vegetation/land surface parameters (mostly constant). BDYLYR3A.186
C BDYLYR3A.187
LOGICAL BDYLYR3A.188
+ LAND_MASK(P_FIELD) ! IN T if land, F elsewhere. BDYLYR3A.189
+,GATHER ! IN T if gather to sea-ice points BDYLYR3A.190
C ! in SF_EXCH. Saves a lot of un- BDYLYR3A.191
C ! necessary calculations if there BDYLYR3A.192
C ! are relatively few sea-ice points BDYLYR3A.193
+,L_Z0_OROG ! IN T to use orog.roughness BDYLYR3A.194
C ! treatment in SF_EXCH BDYLYR3A.195
*IF DEF,SCMA AJC0F405.67
LOGICAL OBS ! Switch for OBS forcing AJC0F405.68
*ENDIF AJC0F405.69
+,L_RMBL ! IN T to use rapidly mixing boundary ASJ3F401.6
C ! scheme in IMPL_CAL ASJ3F401.7
&,L_BL_LSPICE ! IN ADM3F404.207
! TRUE Use scientific treatment of mixed ADM3F404.208
! phase precip scheme. ADM3F404.209
! FALSE Do not use mixed phase precip ADM3F404.210
! considerations ADM3F404.211
&,L_MOM ! IN Switch for convective momentum ARN1F403.32
C ! transport. ARN1F403.33
&,L_MIXLEN ! IN Switch for reducing the turbulent ARN1F403.34
C ! mixing length above the top of the ARN1F403.35
C ! boundary layer. ARN1F403.36
C ARN1F403.37
INTEGER BDYLYR3A.197
+ LAND_INDEX(P_FIELD) ! IN LAND_INDEX(I)=J => the Jth BDYLYR3A.198
C ! point in P_FIELD is the Ith BDYLYR3A.199
C ! land point. BDYLYR3A.200
INTEGER BDYLYR3A.202
+ ST_LEVELS ! IN No. of deep soil levels AJS1F401.1089
+,SM_LEVELS ! IN No. of soil moisture levels AJS1F401.1090
C ! AJS1F401.1091
REAL BDYLYR3A.205
+ CANOPY(LAND_FIELD) ! IN Surface/canopy water (kg per sq m) BDYLYR3A.206
+,CATCH(LAND_FIELD) ! IN Surface/canopy water capacity BDYLYR3A.207
C ! (kg per sq m). BDYLYR3A.208
*IF DEF,SCMA AJC0F405.70
& ,FACTOR_RHOKH(P_FIELD) ! IN Factor for modifying surface AJC0F405.71
! fluxes if OBS forcing used AJC0F405.72
*ENDIF AJC0F405.73
+,HCAP(LAND_FIELD) ! IN Soil heat capacity (J / K / m**3). BDYLYR3A.209
+,HCON(LAND_FIELD) ! IN Soil thermal conductivity (W/m/K). BDYLYR3A.210
+,LAYER_DEPTH(ST_LEVELS+1) ! IN Depths of soil layers, as multiple AJS1F401.1092
C ! of depth of top layer, counting BDYLYR3A.212
C ! from top down and including first BDYLYR3A.213
C ! layer (i.e. 1st value must be 1). BDYLYR3A.214
+,LYING_SNOW(P_FIELD) ! IN Lying snow (kg per sq m). BDYLYR3A.215
C ! Must be global for coupled model, BDYLYR3A.217
C ! ie dimension P_FIELD not LAND_FIEL BDYLYR3A.218
+,RESIST(LAND_FIELD) ! IN "Stomatal" resistance to BDYLYR3A.220
C ! evaporation (seconds per metre). BDYLYR3A.221
+,ROOTD(LAND_FIELD) ! IN Depth of active soil layer ("root BDYLYR3A.222
C ! depth") (metres). BDYLYR3A.223
+,SMC(LAND_FIELD) ! IN Soil moisture content (kg / sq m). BDYLYR3A.224
+,SMVCCL(LAND_FIELD) ! IN Critical volumetric SMC (cubic m BDYLYR3A.225
C ! per cubic m of soil). BDYLYR3A.226
+,SMVCWT(LAND_FIELD) ! IN Volumetric wilting point (cubic m BDYLYR3A.227
C ! per cubic m of soil). BDYLYR3A.228
+,Z0V(P_FIELD) ! IN Vegetative roughness length (m). BDYLYR3A.229
C ! NB:UM uses same storage for Z0MSEA BDYLYR3A.230
C ! so for sea points this is INOUT. BDYLYR3A.231
+,SIL_OROG_LAND(LAND_FIELD) ! IN Silhouette area of unresolved BDYLYR3A.232
C ! orography per unit horizontal area BDYLYR3A.233
C ! on land points only. BDYLYR3A.234
+,HO2R2_OROG(LAND_FIELD) ! IN Standard Deviation of orography. BDYLYR3A.235
C ! equivilent to peak to trough BDYLYR3A.236
C ! height of unresolved orography BDYLYR3A.237
C ! devided by 2SQRT(2) on land BDYLYR3A.238
C ! points only (m) BDYLYR3A.239
C BDYLYR3A.240
C (d) Sea/sea-ice data. BDYLYR3A.241
C BDYLYR3A.242
REAL BDYLYR3A.243
+ DI(P_FIELD) ! IN "Equivalent thickness" of sea-ice BDYLYR3A.244
C ! (m). BDYLYR3A.245
+,ICE_FRACT(P_FIELD) ! IN Fraction of gridbox covered by BDYLYR3A.246
C ! sea-ice (decimal fraction). BDYLYR3A.247
+,U_0(U_FIELD) ! IN W'ly component of surface current BDYLYR3A.248
C ! (metres per second). BDYLYR3A.249
+,V_0(U_FIELD) ! IN S'ly component of surface current BDYLYR3A.250
C ! (metres per second). BDYLYR3A.251
C BDYLYR3A.252
C (e) Cloud data. BDYLYR3A.253
C BDYLYR3A.254
REAL BDYLYR3A.255
+ CF(P_FIELD,BL_LEVELS) ! IN Cloud fraction (decimal). BDYLYR3A.256
+,QCF(P_FIELD,BL_LEVELS) ! IN Cloud ice (kg per kg air) BDYLYR3A.257
+,QCL(P_FIELD,BL_LEVELS) ! IN Cloud liquid water (kg BDYLYR3A.258
C ! per kg air). BDYLYR3A.259
+,CCA(P_FIELD) ! IN Convective Cloud Amount (decimal). BDYLYR3A.260
INTEGER BDYLYR3A.261
+ CCB(P_FIELD) ! IN Convective Cloud Base BDYLYR3A.262
+,CCT(P_FIELD) ! IN Convective Cloud Top BDYLYR3A.263
C BDYLYR3A.264
C (f) Atmospheric + any other data not covered so far, incl control. BDYLYR3A.265
C BDYLYR3A.266
REAL BDYLYR3A.267
+ PSTAR(P_FIELD) ! IN Surface pressure (Pascals). BDYLYR3A.268
+,RADNET(P_FIELD) ! IN Surface net radiation (W/sq m, BDYLYR3A.269
C ! positive downwards). BDYLYR3A.270
+,TIMESTEP ! IN Timestep (seconds). BDYLYR3A.271
C BDYLYR3A.272
LOGICAL LTIMER ! Logical switch for TIMER diags BDYLYR3A.273
C BDYLYR3A.274
C STASH flags :- BDYLYR3A.275
C BDYLYR3A.276
LOGICAL BDYLYR3A.277
+ SFME ! IN Flag for FME (q.v.). BDYLYR3A.278
+,SMLT ! IN Flag for SICE_MLT_HTF (q.v.) BDYLYR3A.279
+,SLH ! IN Flag for LATENT_HEAT (q.v.) BDYLYR3A.280
+,SQ1P5 ! IN Flag for Q1P5M (q.v.) BDYLYR3A.281
+,ST1P5 ! IN Flag for T1P5M (q.v.) BDYLYR3A.282
+,SU10 ! IN Flag for U10M (q.v.) BDYLYR3A.283
+,SV10 ! IN Flag for V10M (q.v.) BDYLYR3A.284
C BDYLYR3A.285
C In/outs :- BDYLYR3A.286
C BDYLYR3A.287
REAL BDYLYR3A.288
+ Q(P_FIELD,BL_LEVELS) ! INOUT Input:specific humidity BDYLYR3A.289
C ! ( kg water per kg air). BDYLYR3A.290
C ! Output:total water content BDYLYR3A.291
C ! (Q)(kg water per kg air). BDYLYR3A.292
+,T(P_FIELD,BL_LEVELS) ! INOUT Input:atmospheric temp(K) BDYLYR3A.293
C ! Output:liquid/frozen water BDYLYR3A.294
C ! temperature (TL) (K) BDYLYR3A.295
+,T_DEEP_SOIL(LAND_FIELD,ST_LEVELS) ! INOUT Deep soil temperatures AJS1F401.1093
C ! (K). BDYLYR3A.297
+,TSTAR(P_FIELD) ! INOUT Surface temperature BDYLYR3A.298
C ! (= top soil layer BDYLYR3A.299
C ! temperature) (K). BDYLYR3A.300
+,U(U_FIELD,BL_LEVELS) ! INOUT W'ly wind component BDYLYR3A.301
C ! (metres per second). BDYLYR3A.302
+,V(U_FIELD,BL_LEVELS) ! INOUT S'ly wind component BDYLYR3A.303
C ! (metres per second). BDYLYR3A.304
+,Z0MSEA(P_FIELD) ! INOUT Sea-surface roughness BDYLYR3A.305
C ! length for momentum (m). BDYLYR3A.306
C ! NB: same storage is used BDYLYR3A.307
C ! for Z0V, so the intent is BDYLYR3A.308
C ! IN for land points. BDYLYR3A.309
C BDYLYR3A.310
C Outputs :- BDYLYR3A.311
C BDYLYR3A.312
C-1 Diagnostic (or effectively so - includes coupled model requisites):- BDYLYR3A.313
C BDYLYR3A.314
C (a) Calculated anyway (use STASH space from higher level) :- BDYLYR3A.315
C BDYLYR3A.316
REAL BDYLYR3A.317
+ CD(P_FIELD) ! OUT Turbulent surface exchange (bulk BDYLYR3A.318
C ! transfer) coefficient for BDYLYR3A.319
C ! momentum. BDYLYR3A.320
+,CH(P_FIELD) ! OUT Turbulent surface exchange (bulk BDYLYR3A.321
C ! transfer) coefficient for heat BDYLYR3A.322
C ! and/or moisture. BDYLYR3A.323
+,E_SEA(P_FIELD) ! OUT Evaporation from sea times leads BDYLYR3A.324
C ! fraction. Zero over land. BDYLYR3A.325
C ! (kg per square metre per sec). BDYLYR3A.326
+,FQW(P_FIELD,BL_LEVELS) ! OUT Moisture flux between layers BDYLYR3A.327
C ! (kg per square metre per sec). BDYLYR3A.328
C ! FQW(,1) is total water flux BDYLYR3A.329
C ! from surface, 'E'. BDYLYR3A.330
+,FTL(P_FIELD,BL_LEVELS) ! OUT FTL(,K) contains net turbulent BDYLYR3A.331
C ! sensible heat flux into layer K BDYLYR3A.332
C ! from below; so FTL(,1) is the BDYLYR3A.333
C ! surface sensible heat, H. (W/m2) BDYLYR3A.334
+,H_SEA(P_FIELD) ! OUT Surface sensible heat flux over BDYLYR3A.335
C ! sea times leads fraction. (W/m2) BDYLYR3A.336
+,RHOKH(P_FIELD,BL_LEVELS) ! OUT Exchange coeffs for moisture. BDYLYR3A.337
C ! Surface:out of SF_EXCH containing BDYLYR3A.338
C ! GAMMA(1)*RHOKH,after IMPL_CAL BDYLYR3A.339
C ! contains only RHOKH. BDYLYR3A.340
C ! Above surface:out of KMKH cont- BDYLYR3A.341
C ! aining GAMMA(1)*RHOKH(,1)*RDZ(,1) BDYLYR3A.342
+,RHOKM(U_FIELD,BL_LEVELS) ! OUT Exchange coefficients for BDYLYR3A.343
C ! momentum (on UV-grid, with 1st BDYLYR3A.344
C ! and last rows undefined (or, at BDYLYR3A.345
C ! present, set to "missing data")). BDYLYR3A.346
C ! Surface:out of SF_EXCH containing BDYLYR3A.347
C ! GAMMA(1)*RHOKH,after IMPL_CAL BDYLYR3A.348
C ! contains only RHOKH. BDYLYR3A.349
C ! Above surface:out of KMKH cont- BDYLYR3A.350
C ! aining GAMMA(1)*RHOKH(,1)*RDZ(,1) BDYLYR3A.351
+,RIB(P_FIELD) ! OUT Bulk Richardson number for lowest BDYLYR3A.352
C ! layer. BDYLYR3A.353
+,SEA_ICE_HTF(P_FIELD) ! OUT Heat flux through sea-ice (W per BDYLYR3A.354
C ! sq m, positive downwards). BDYLYR3A.355
+,SOIL_HT_FLUX(P_FIELD) ! OUT Heat flux from soil layer 1 to BDYLYR3A.356
C ! soil layer 2, i.e. from surface BDYLYR3A.357
C ! to deep soil layer 1, i.e. +ve BDYLYR3A.358
C ! downwards (Watts per sq m). BDYLYR3A.359
+,TAUX(U_FIELD,BL_LEVELS) ! OUT W'ly component of surface wind BDYLYR3A.360
C ! stress (N/sq m).(On UV-grid with BDYLYR3A.361
C ! first and last rows undefined or BDYLYR3A.362
C ! at present, set to 'missing data' BDYLYR3A.363
+,TAUY(U_FIELD,BL_LEVELS) ! OUT S'ly component of surface wind BDYLYR3A.364
C ! stress (N/sq m). On UV-grid; BDYLYR3A.365
C ! comments as per TAUX. BDYLYR3A.366
+,VSHR(P_FIELD) ! OUT Magnitude of surface-to-lowest BDYLYR3A.367
C ! atm level wind shear (m per s). BDYLYR3A.368
C BDYLYR3A.369
&,RHO_CD_MODV1(P_FIELD) ! OUT Surface air density * drag coef.* ASJ1F400.7
C ! mod(v1 - v0) before interpolation ASJ1F400.8
&,RHO_KM(P_FIELD,2:BL_LEVELS) ! OUT Air density * turbulent mixing ASJ1F400.9
C ! coefficient for momentum before ASJ1F400.10
C interpolation. ASJ1F400.11
INTEGER BDYLYR3A.370
+ NRML(P_FIELD) ! OUT Number of model layers in the BDYLYR3A.371
C ! Rapidly Mixing Layer; diagnosed BDYLYR3A.372
C ! in SF_EXCH and KMKH and used in BDYLYR3A.373
C ! IMPL_CAL, SF_EVAP and TR_MIX. BDYLYR3A.374
C BDYLYR3A.375
C (b) Not passed between lower-level routines (not in workspace at this BDYLYR3A.376
C level) :- BDYLYR3A.377
C BDYLYR3A.378
REAL BDYLYR3A.379
+ FME(P_FIELD) ! OUT Wind mixing "power" (W per sq m). BDYLYR3A.380
+,SICE_MLT_HTF(P_FIELD) ! OUT Heat flux due to melting of sea- BDYLYR3A.381
C ! ice (Watts per sq metre). BDYLYR3A.382
+,LATENT_HEAT(P_FIELD) ! OUT Surface latent heat flux, +ve BDYLYR3A.383
C ! upwards (Watts per sq m). BDYLYR3A.384
+,Q1P5M(P_FIELD) ! OUT Q at 1.5 m (kg water per kg air). BDYLYR3A.385
+,T1P5M(P_FIELD) ! OUT T at 1.5 m (K). BDYLYR3A.386
+,U10M(U_FIELD) ! OUT U at 10 m (m per s). BDYLYR3A.387
+,V10M(U_FIELD) ! OUT V at 10 m (m per s). BDYLYR3A.388
C BDYLYR3A.389
C-2 Genuinely output, needed by other atmospheric routines :- BDYLYR3A.390
C BDYLYR3A.391
REAL BDYLYR3A.392
+ ECAN(P_FIELD) ! OUT Gridbox mean evaporation from canopy/surface BDYLYR3A.393
C ! store (kg per sq m per s). Zero over sea. BDYLYR3A.394
+,EI(P_FIELD) ! OUT Sublimation from lying snow or sea-ice (kg BDYLYR3A.395
C ! per sq m per sec). BDYLYR3A.396
+,ES(P_FIELD) ! OUT Surface evapotranspiration through a BDYLYR3A.397
C ! resistance which is not entirely aerodynamic BDYLYR3A.398
C ! i.e. "soil evaporation". Always non- BDYLYR3A.399
C ! negative. Kg per sq m per sec. BDYLYR3A.400
+,ZH(P_FIELD) ! OUT Height above surface of top of boundary BDYLYR3A.401
C ! layer (metres). BDYLYR3A.402
&,T1_SD(P_FIELD) ! OUT Standard deviation of turbulent fluctuations BDYLYR3A.403
C ! of layer 1 temperature; for use in BDYLYR3A.404
C ! initiating convection. BDYLYR3A.405
&,Q1_SD(P_FIELD) ! OUT Standard deviation of turbulent fluctuations BDYLYR3A.406
C ! of layer 1 humidity; for use in initiating BDYLYR3A.407
C ! convection. BDYLYR3A.408
INTEGER BDYLYR3A.409
+ ERROR ! OUT 0 - AOK; BDYLYR3A.410
C ! 1 to 7 - bad grid definition detected; BDYLYR3A.412
C ! 11 - error in SF_EXCH; BDYLYR3A.416
C ! 21 - error in KMKH; BDYLYR3A.417
C ! 31 - error in IMPL_CAL; BDYLYR3A.418
C ! 41 - error in SOIL_HTF. BDYLYR3A.420
C*---------------------------------------------------------------------- BDYLYR3A.422
C*L--------------------------------------------------------------------- BDYLYR3A.423
C External routines called :- BDYLYR3A.424
C BDYLYR3A.425
EXTERNAL Z,SICE_HTF,SOIL_HTF,SF_EXCH,KMKH,IMPL_CAL,SF_EVAP BDYLYR3A.426
EXTERNAL TIMER BDYLYR3A.427
*IF -DEF,SCMA AJC1F405.520
EXTERNAL UV_TO_P BDYLYR3A.429
*ENDIF BDYLYR3A.430
C*---------------------------------------------------------------------- BDYLYR3A.431
C*L--------------------------------------------------------------------- BDYLYR3A.432
C Symbolic constants (parameters) reqd in top-level routine :- BDYLYR3A.433
C BDYLYR3A.434
*CALL C_R_CP
BDYLYR3A.435
*CALL C_LHEAT
BDYLYR3A.436
C*---------------------------------------------------------------------- BDYLYR3A.437
C BDYLYR3A.438
C Workspace :- BDYLYR3A.439
C BDYLYR3A.440
REAL BDYLYR3A.516
+ DZL(P_FIELD,BL_LEVELS) ! WORK DZL(,K) is depth in m of layer BDYLYR3A.517
C ! K, i.e. distance from boundary BDYLYR3A.518
C ! K-1/2 to boundary K+1/2. BDYLYR3A.519
+,FQW_LEAD(P_FIELD) ! WORK FQW for leads fractn of grid sq BDYLYR3A.520
+,FTL_LEAD(P_FIELD) ! WORK FTL for leads fractn of grid sq BDYLYR3A.521
+,QW(P_FIELD,BL_LEVELS) ! WORK Total water content, but BDYLYR3A.522
C ! replaced by specific humidity BDYLYR3A.523
C ! in LS_CLD. BDYLYR3A.524
+,RDZ(P_FIELD,BL_LEVELS) ! WORK RDZ(,1) is the reciprocal BDYLYR3A.525
C ! of the height of level 1, i.e. BDYLYR3A.526
C ! of the middle of layer 1. For BDYLYR3A.527
C ! K > 1, RDZ(,K) is the BDYLYR3A.528
C ! reciprocal of the vertical BDYLYR3A.529
C ! distance from level K-1 to BDYLYR3A.530
C ! level K. BDYLYR3A.531
+,TL(P_FIELD,BL_LEVELS) ! WORK Ice/liquid water temperature, BDYLYR3A.532
C ! but replaced by T in LS_CLD. BDYLYR3A.533
+,TSTAR_NL(P_FIELD) ! WORK TSTAR No Leads (K). BDYLYR3A.534
+,TV_RDZUV(P_FIELD,BL_LEVELS) ! WORK Virtual temp at start (TV). BDYLYR3A.535
C ! RDZ (K > 1) on UV-grid. BDYLYR3A.536
C ! Comments as per RHOKM (RDZUV). BDYLYR3A.537
+,U_P(P_FIELD,BL_LEVELS) ! WORK U on P-grid. BDYLYR3A.538
+,V_P(P_FIELD,BL_LEVELS) ! WORK V on P-grid. BDYLYR3A.539
+,ZLB(P_FIELD,0:BL_LEVELS) ! WORK ZLB(,K) is the height of the BDYLYR3A.540
C ! upper boundary of layer K BDYLYR3A.541
C ! ( = 0.0 for "K=0"). BDYLYR3A.542
REAL BDYLYR3A.543
+ ASOIL_1(P_FIELD) ! WORK Soil thermodynamic coefficient. BDYLYR3A.544
+,BQ_1(P_FIELD) ! WORK A buoyancy parameter for the BDYLYR3A.545
C ! lowest atmospheric level. BDYLYR3A.546
+,BT_1(P_FIELD) ! WORK A buoyancy parameter for the BDYLYR3A.547
C ! lowest atmospheric level. BDYLYR3A.548
&,BF_1(P_FIELD) ADM3F404.212
! WORK A bouyancy parameter for the lowest atmospheric level ADM3F404.213
+,DQW_1(P_FIELD) ! WORK Increment for QW(,1). BDYLYR3A.549
+,DQW_RML(P_FIELD) ! WORK Increment for QW in the BDYLYR3A.550
C ! Rapidly Mixing Layer. BDYLYR3A.551
+,DTRDZ(P_FIELD,BL_LEVELS) ! WORK -g.dt/dp for model layers. BDYLYR3A.552
+,DTRDZ_RML(P_FIELD) ! WORK -g.dt/dp for the rapidly BDYLYR3A.553
C ! mixing layer. BDYLYR3A.554
+,DTSTAR(P_FIELD) ! WORK Increment for TSTAR. BDYLYR3A.555
+,EA(P_FIELD) ! WORK Surface evaporation with only BDYLYR3A.556
C ! aerodynamic resistance (+ve), BDYLYR3A.557
C ! or condensation (-ve), BDYLYR3A.558
C ! averaged over gridbox. BDYLYR3A.559
+,ESL(P_FIELD) ! WORK ES (q.v.) without fractional BDYLYR3A.560
C ! weighting factor FRACS. "L" BDYLYR3A.561
C ! is for "local". BDYLYR3A.562
+,RHOKE(P_FIELD) ! WORK Surface exchange coefficient BDYLYR3A.563
C ! for FQW. BDYLYR3A.564
+,RHOKEA(P_FIELD) ! WORK Surface exchange coefficient BDYLYR3A.565
C ! for EA. BDYLYR3A.566
+,RHOKES(P_FIELD) ! WORK Surface exchange coefficient BDYLYR3A.567
C ! for ES. BDYLYR3A.568
+,RHOKESL(P_FIELD) ! WORK Surface exchange coefficient BDYLYR3A.569
C ! for ESL. BDYLYR3A.570
+,Z0H(P_FIELD) ! WORK Roughness length for heat and BDYLYR3A.571
C ! moisture. BDYLYR3A.572
+,Z0M(P_FIELD) ! WORK Roughness length for momentum. BDYLYR3A.573
+,Z1(P_FIELD) ! WORK Height of lowest level (i.e. BDYLYR3A.574
C ! height of middle of lowest BDYLYR3A.575
C ! layer). BDYLYR3A.576
+,H_BLEND(P_FIELD) ! WORK Blending height used as part of BDYLYR3A.577
C ! effective roughness scheme BDYLYR3A.578
+,Z0M_EFF(P_FIELD) ! WORK Effective roughness length for BDYLYR3A.581
C ! momentum BDYLYR3A.582
REAL BDYLYR3A.583
+ CDR10M(U_FIELD) ! WORK Ratio of CD's reqd for BDYLYR3A.584
C ! calculation of 10 m wind. BDYLYR3A.585
C ! On UV-grid; comments as per BDYLYR3A.586
C ! RHOKM. BDYLYR3A.587
+,CER1P5M(P_FIELD) ! WORK Ratio of coefficients reqd for BDYLYR3A.588
C ! calculation of 1.5 m Q. BDYLYR3A.589
+,CHR1P5M(P_FIELD) ! WORK Ratio of coefficients reqd for BDYLYR3A.590
C ! calculation of 1.5 m T. BDYLYR3A.591
C BDYLYR3A.593
C Local scalars :- BDYLYR3A.594
C BDYLYR3A.595
INTEGER BDYLYR3A.596
+ ERR ! LOCAL Return codes from lower-level routines. BDYLYR3A.597
+,I ! LOCAL Loop counter (horizontal field index). BDYLYR3A.598
+,K ! LOCAL Loop counter (vertical level index). BDYLYR3A.599
+,N_P_ROWS ! LOCAL No of P-rows being processed. BDYLYR3A.600
+,N_U_ROWS ! LOCAL No of UV-rows being processed. BDYLYR3A.601
+,P_POINTS ! LOCAL No of P-points being processed. BDYLYR3A.603
+,P1 ! LOCAL First P-point to be processed. BDYLYR3A.604
+,LAND1 ! LOCAL First land-point to be processed. BDYLYR3A.605
C ! 1 <= LAND1 <= LAND_FIELD BDYLYR3A.606
+,LAND_PTS ! LOCAL No of land points being processed. BDYLYR3A.607
+,SEA_FIELD ! LOCAL No of sea points in the full field. BDYLYR3A.608
+,SEA_PTS ! LOCAL No of sea points being processed. BDYLYR3A.609
+,U_POINTS ! LOCAL No of UV-points being processed. BDYLYR3A.610
+,U1 ! LOCAL First UV-point to be processed. BDYLYR3A.611
IF (LTIMER) THEN BDYLYR3A.612
CALL TIMER
('BDYLAYR ',3) BDYLYR3A.613
ENDIF BDYLYR3A.614
ERROR = 0 BDYLYR3A.615
*IF -DEF,SCMA AJC1F405.521
C BDYLYR3A.617
C----------------------------------------------------------------------- BDYLYR3A.618
CL 0. Verify grid/subset definitions. Arakawa 'B' grid with P-rows at BDYLYR3A.619
CL extremes is assumed. Extreme-most P-rows are ignored; extreme- BDYLYR3A.620
CL most UV-rows are used only for interpolation and are not updated. BDYLYR3A.621
C----------------------------------------------------------------------- BDYLYR3A.622
C BDYLYR3A.623
IF ( BL_LEVELS.LT.1 .OR. ST_LEVELS.LT.1 AJS1F401.1094
&.OR. P_ROWS.LT.3 ) THEN AJS1F401.1095
ERROR = 1 BDYLYR3A.625
GOTO999 BDYLYR3A.626
*IF -DEF,MPP APBGF401.2
ELSEIF ( U_FIELD .NE. (P_ROWS-1)*ROW_LENGTH ) THEN BDYLYR3A.627
*ELSE APBGF401.3
ELSEIF ( U_FIELD .NE. (P_ROWS)*ROW_LENGTH ) THEN APBGF401.4
*ENDIF APBGF401.5
ERROR = 2 BDYLYR3A.628
GOTO999 BDYLYR3A.629
ELSEIF ( P_FIELD .NE. P_ROWS*ROW_LENGTH ) THEN BDYLYR3A.630
ERROR = 3 BDYLYR3A.631
GOTO999 BDYLYR3A.632
ELSEIF ( FIRST_ROW.LE.1 .OR. FIRST_ROW.GE.P_ROWS ) THEN BDYLYR3A.633
ERROR = 4 BDYLYR3A.634
GOTO999 BDYLYR3A.635
ELSEIF ( N_ROWS.LE.0 ) THEN BDYLYR3A.636
ERROR = 5 BDYLYR3A.637
GOTO999 BDYLYR3A.638
*IF -DEF,MPP APBGF401.6
ELSEIF ( (FIRST_ROW+N_ROWS) .GT. P_ROWS ) THEN BDYLYR3A.639
*ELSE APBGF401.7
ELSEIF ( (FIRST_ROW+N_ROWS-1) .GT. P_ROWS ) THEN APBGF401.8
*ENDIF APBGF401.9
ERROR = 6 BDYLYR3A.640
GOTO999 BDYLYR3A.641
ELSEIF ( LAND_FIELD.GT.P_FIELD ) THEN BDYLYR3A.642
ERROR = 7 BDYLYR3A.643
GOTO999 BDYLYR3A.644
ENDIF BDYLYR3A.645
C BDYLYR3A.646
C----------------------------------------------------------------------- BDYLYR3A.647
CL Set pointers, etc. BDYLYR3A.648
C----------------------------------------------------------------------- BDYLYR3A.649
C BDYLYR3A.650
N_P_ROWS=N_ROWS APBGF401.10
N_U_ROWS=N_ROWS+1 APBGF401.11
APBGF401.12
P_POINTS=N_P_ROWS*ROW_LENGTH APBGF401.13
U_POINTS=N_U_ROWS*ROW_LENGTH APBGF401.14
APBGF401.15
P1=1+(FIRST_ROW-1)*ROW_LENGTH APBGF401.16
U1=1+(FIRST_ROW-2)*ROW_LENGTH APBGF401.17
C BDYLYR3A.658
C----------------------------------------------------------------------- BDYLYR3A.659
CL Set compressed land point pointers. BDYLYR3A.660
C----------------------------------------------------------------------- BDYLYR3A.661
C BDYLYR3A.662
LAND1=0 BDYLYR3A.663
DO 1 I=1,P1+P_POINTS-1 BDYLYR3A.664
IF (LAND_INDEX(I).GE.P1) THEN BDYLYR3A.665
LAND1 = I BDYLYR3A.666
GOTO2 BDYLYR3A.667
ENDIF BDYLYR3A.668
1 CONTINUE BDYLYR3A.669
2 CONTINUE BDYLYR3A.670
LAND_PTS=0 BDYLYR3A.671
DO 3 I=P1,P1+P_POINTS-1 BDYLYR3A.672
IF (LAND_MASK(I)) LAND_PTS = LAND_PTS + 1 BDYLYR3A.673
3 CONTINUE BDYLYR3A.674
*ELSE BDYLYR3A.675
C AJC1F405.522
C--------------------------------------------------------------------- AJC1F405.523
CL 0. Check grid definition arguments. AJC1F405.524
C--------------------------------------------------------------------- AJC1F405.525
C AJC1F405.526
IF ( BL_LEVELS.LT.1 AJC1F405.527
& .OR. ST_LEVELS.LT.1 .OR.SM_LEVELS.LT.1 ) THEN AJC1F405.528
ERROR = 1 AJC1F405.529
GOTO999 AJC1F405.530
ELSEIF ( U_FIELD .NE. P_ROWS*ROW_LENGTH ) THEN AJC1F405.531
ERROR = 2 AJC1F405.532
GOTO999 AJC1F405.533
ELSEIF ( P_FIELD .NE. P_ROWS*ROW_LENGTH ) THEN AJC1F405.534
ERROR = 3 AJC1F405.535
GOTO999 AJC1F405.536
ELSEIF ( N_ROWS.LE.0 ) THEN AJC1F405.537
ERROR = 5 AJC1F405.538
GOTO999 AJC1F405.539
ELSEIF ( LAND_FIELD.GT.P_FIELD ) THEN AJC1F405.540
ERROR = 7 AJC1F405.541
GOTO999 AJC1F405.542
ENDIF AJC1F405.543
C AJC1F405.544
C--------------------------------------------------------------------- AJC1F405.545
CL Set pointers, etc. AJC1F405.546
C--------------------------------------------------------------------- AJC1F405.547
C AJC1F405.548
N_P_ROWS=N_ROWS AJC1F405.549
N_U_ROWS=N_ROWS AJC1F405.550
AJC1F405.551
P_POINTS=N_P_ROWS*ROW_LENGTH AJC1F405.552
U_POINTS=N_U_ROWS*ROW_LENGTH AJC1F405.553
AJC1F405.554
P1 = 1 AJC1F405.555
U1 = 1 AJC1F405.556
C AJC1F405.557
C--------------------------------------------------------------------- AJC1F405.558
CL Set compressed land point pointers. AJC1F405.559
C--------------------------------------------------------------------- AJC1F405.560
C AJC1F405.561
LAND1=0 AJC1F405.562
DO 1 I=1,P1+P_POINTS-1 AJC1F405.563
IF (LAND_INDEX(I).GE.P1) THEN AJC1F405.564
LAND1 = I AJC1F405.565
GOTO2 AJC1F405.566
ENDIF AJC1F405.567
1 CONTINUE AJC1F405.568
2 CONTINUE AJC1F405.569
LAND_PTS=0 AJC1F405.570
DO 3 I=P1,P1+P_POINTS-1 AJC1F405.571
IF (LAND_MASK(I)) LAND_PTS = LAND_PTS + 1 AJC1F405.572
3 CONTINUE AJC1F405.573
*ENDIF BDYLYR3A.706
C BDYLYR3A.707
C----------------------------------------------------------------------- BDYLYR3A.708
CL 1. Perform calculations in what the documentation describes as BDYLYR3A.709
CL subroutine Z_DZ. In fact, a separate subroutine isn't used. BDYLYR3A.710
C----------------------------------------------------------------------- BDYLYR3A.711
C BDYLYR3A.712
CL 1.1 Initialise ZLB(,0) (to zero, of course, this being the height BDYLYR3A.713
CL of the surface above the surface). BDYLYR3A.714
C BDYLYR3A.715
DO 4 I=P1,P1+P_POINTS-1 BDYLYR3A.716
ZLB(I,0)=0.0 BDYLYR3A.717
4 CONTINUE BDYLYR3A.718
C BDYLYR3A.719
CL 1.2 Calculate layer depths and heights, and construct wind fields on BDYLYR3A.720
CL P-grid. This involves calling subroutines Z and UV_TO_P. BDYLYR3A.721
CL Virtual temperature is also calculated, as a by-product. BDYLYR3A.722
C BDYLYR3A.723
C NB RDZ TEMPORARILY used to return DELTA_Z_LOWER, the lower half layer BDYLYR3A.724
C thickness BDYLYR3A.725
C BDYLYR3A.726
DO 5 K=1,BL_LEVELS BDYLYR3A.727
CALL Z
(P_POINTS,EXNER(P1,K),EXNER(P1,K+1),PSTAR(P1), BDYLYR3A.728
+ AKH(K),BKH(K),Q(P1,K),QCF(P1,K), BDYLYR3A.729
+ QCL(P1,K),T(P1,K),ZLB(P1,K-1),TV_RDZUV(P1,K), BDYLYR3A.730
+ ZLB(P1,K),DZL(P1,K),RDZ(P1,K),LTIMER) BDYLYR3A.731
*IF -DEF,SCMA AJC1F405.574
CALL UV_TO_P
(U(U1,K),U_P(P1,K), BDYLYR3A.733
+ U_POINTS,P_POINTS,ROW_LENGTH,N_U_ROWS) BDYLYR3A.734
CALL UV_TO_P
(V(U1,K),V_P(P1,K), BDYLYR3A.735
+ U_POINTS,P_POINTS,ROW_LENGTH,N_U_ROWS) BDYLYR3A.736
*ELSE BDYLYR3A.737
DO I = P1, P1-1+P_POINTS AJC1F405.575
U_P(i,K) = U(i,K) AJC1F405.576
V_P(i,K) = V(i,K) AJC1F405.577
ENDDO AJC1F405.578
*ENDIF BDYLYR3A.740
5 CONTINUE BDYLYR3A.741
DO 61 K=BL_LEVELS,2,-1 BDYLYR3A.742
DO 62 I=P1,P1+P_POINTS-1 BDYLYR3A.743
RDZ(I,K)=1.0/(RDZ(I,K)+(DZL(I,K-1)-RDZ(I,K-1))) BDYLYR3A.744
62 CONTINUE BDYLYR3A.745
61 CONTINUE BDYLYR3A.746
DO 6 I=P1,P1+P_POINTS-1 BDYLYR3A.747
Z1(I)=RDZ(I,1) BDYLYR3A.748
RDZ(I,1)=1.0/RDZ(I,1) BDYLYR3A.749
6 CONTINUE BDYLYR3A.750
C BDYLYR3A.751
C----------------------------------------------------------------------- BDYLYR3A.752
CL 2. Heat flux through sea-ice (P241, routine SICE_HTF). BDYLYR3A.753
C----------------------------------------------------------------------- BDYLYR3A.754
C BDYLYR3A.755
CALL SICE_HTF
( BDYLYR3A.756
+ DI(P1),ICE_FRACT(P1),LAND_MASK(P1),TSTAR(P1),P_POINTS, BDYLYR3A.757
+ SEA_ICE_HTF(P1),LTIMER BDYLYR3A.758
+) BDYLYR3A.759
C BDYLYR3A.760
C----------------------------------------------------------------------- BDYLYR3A.761
CL 3. Heat fluxes through soil (P242, routine SOIL_HTF). BDYLYR3A.762
C----------------------------------------------------------------------- BDYLYR3A.763
C BDYLYR3A.764
CALL SOIL_HTF
( BDYLYR3A.765
+ HCAP,HCON,LAYER_DEPTH,LYING_SNOW,TSTAR,LAND_MASK,TIMESTEP, BDYLYR3A.766
+ P_FIELD,LAND_FIELD,P_POINTS,P1, BDYLYR3A.767
+ LAND_PTS,LAND1,LAND_INDEX, BDYLYR3A.769
+ ST_LEVELS+1,T_DEEP_SOIL,ASOIL_1,SOIL_HT_FLUX AJS1F401.1097
+,LTIMER) BDYLYR3A.776
C BDYLYR3A.783
C----------------------------------------------------------------------- BDYLYR3A.784
CL 4. Surface turbulent exchange coefficients and "explicit" fluxes BDYLYR3A.785
CL (P243a, routine SF_EXCH). BDYLYR3A.786
CL Wind mixing "power" and some values required for other, later, BDYLYR3A.787
CL diagnostic calculations, are also evaluated if requested. BDYLYR3A.788
C----------------------------------------------------------------------- BDYLYR3A.789
C BDYLYR3A.790
CALL SF_EXCH
( BDYLYR3A.791
+ P_POINTS,LAND_PTS,U_POINTS,ROW_LENGTH,N_P_ROWS,N_U_ROWS, BDYLYR3A.792
+ LAND_INDEX(LAND1),P1,GATHER, BDYLYR3A.794
+ AK(1),BK(1),TIMESTEP,CANOPY(LAND1),CATCH(LAND1),CF(P1,1), BDYLYR3A.796
+ ICE_FRACT(P1),LAND_MASK(P1),PSTAR(P1),Q(P1,1),QCF(P1,1), BDYLYR3A.797
+ QCL(P1,1),RESIST(LAND1),ROOTD(LAND1),SMC(LAND1), BDYLYR3A.798
+ SMVCCL(LAND1),SMVCWT(LAND1),LYING_SNOW(P1),T(P1,1),TSTAR(P1), BDYLYR3A.799
+ U(U1,1),V(U1,1),U_P(P1,1),V_P(P1,1),U_0(U1),V_0(U1), BDYLYR3A.800
+ Z0V(P1),SIL_OROG_LAND(LAND1),Z1(P1),Z0MSEA(P1),HO2R2_OROG(LAND1), BDYLYR3A.801
& BQ_1(P1),BT_1(P1),BF_1(P1),CD(P1),CH(P1), ADM3F404.214
+ EA(P1),ES(P1),ESL(P1),FQW(P1,1),FQW_LEAD(P1),FTL(P1,1), BDYLYR3A.803
+ FTL_LEAD(P1),TAUX(U1,1),TAUY(U1,1),QW(P1,1),RHOKE(P1), BDYLYR3A.804
+ RHOKEA(P1),RHOKES(P1),RHOKESL(P1),RHOKH(P1,1),RHOKM(U1,1), BDYLYR3A.805
+ RIB(P1),TL(P1,1),TSTAR_NL(P1),VSHR(P1),Z0H(P1),Z0M(P1), BDYLYR3A.806
+ Z0M_EFF(P1),H_BLEND(P1),T1_SD(P1),Q1_SD(P1), ARN1F400.5
& RHO_CD_MODV1(P1),CDR10M(U1),CHR1P5M(P1),CER1P5M(P1),FME(P1), ASJ1F400.12
+ SU10,SV10,SQ1P5,ST1P5,SFME, BDYLYR3A.809
+ NRML(P1),L_Z0_OROG,L_RMBL,L_BL_LSPICE,ERR,LTIMER ADM3F404.215
*IF DEF,SCMA AJC0F405.74
& ,FACTOR_RHOKH,OBS AJC0F405.75
*ENDIF AJC0F405.76
+) BDYLYR3A.811
IF (ERR.GT.0) THEN BDYLYR3A.812
ERROR = ERR + 10 BDYLYR3A.813
GOTO999 BDYLYR3A.814
ENDIF BDYLYR3A.815
C BDYLYR3A.816
C----------------------------------------------------------------------- BDYLYR3A.817
CL 5. Turbulent exchange coefficients and "explicit" fluxes between BDYLYR3A.818
CL model layers in the boundary layer (P243b, routine KMKH). BDYLYR3A.819
C----------------------------------------------------------------------- BDYLYR3A.820
C BDYLYR3A.821
CALL KMKH
( BDYLYR3A.822
+ P_FIELD,U_FIELD,P1,U1, BDYLYR3A.823
+ P_POINTS,U_POINTS,ROW_LENGTH,N_P_ROWS,N_U_ROWS,BL_LEVELS, BDYLYR3A.824
+ TIMESTEP,AK,BK,AKH,BKH,DELTA_AK,DELTA_BK,CCA,BQ_1,BT_1,BF_1, ADM3F404.216
& CF,DZL, ADM3F404.217
+ PSTAR,Q,QCF,QCL,RDZ,T,TV_RDZUV, BDYLYR3A.826
+ U,U_P,V,V_P,Z0M_EFF,ZLB(1,0),H_BLEND, BDYLYR3A.827
+ FQW,FTL,TAUX,TAUY,QW, BDYLYR3A.828
+ RHOKM,RHOKH,TL,ZH,TV_RDZUV(1,2),RHO_KM(1,2), ASJ1F400.13
+ CCB,CCT,L_MOM,L_MIXLEN, ARN1F403.38
& L_BL_LSPICE, ADM3F404.218
+ NRML,ERR,LTIMER BDYLYR3A.831
+) BDYLYR3A.832
IF (ERR.GT.0) THEN BDYLYR3A.833
ERROR = ERR + 20 BDYLYR3A.834
GOTO999 BDYLYR3A.835
ENDIF BDYLYR3A.836
C BDYLYR3A.837
C----------------------------------------------------------------------- BDYLYR3A.838
CL 6. "Implicit" calculation of increments for TSTAR and atmospheric BDYLYR3A.839
CL boundary layer variables (P244, routine IMPL_CAL). BDYLYR3A.840
CL 10-metre wind components are also diagnosed if requested. BDYLYR3A.841
C----------------------------------------------------------------------- BDYLYR3A.842
C BDYLYR3A.843
CALL IMPL_CAL
( BDYLYR3A.844
+ P_FIELD,U_FIELD,P1,U1, BDYLYR3A.845
+ P_POINTS,U_POINTS,BL_LEVELS,ROW_LENGTH,N_P_ROWS,N_U_ROWS, BDYLYR3A.846
+ CDR10M,U_0,V_0,SU10,SV10, BDYLYR3A.847
+ ASOIL_1,DELTA_AK,DELTA_BK,FQW_LEAD,FTL_LEAD, BDYLYR3A.848
+ RHOKE,RHOKEA,RHOKES,RHOKESL, BDYLYR3A.849
+ RHOKH(1,2),RHOKM(1,2), BDYLYR3A.850
+ ICE_FRACT,LAND_MASK,LYING_SNOW,PSTAR,RADNET, BDYLYR3A.851
+ SEA_ICE_HTF,SOIL_HT_FLUX,TIMESTEP,TSTAR_NL, BDYLYR3A.852
+ EA,ES,ESL,FQW,FTL,QW,RHOKH(1,1),RHOKM(1,1),TSTAR,TL, BDYLYR3A.853
+ U,V,DQW_1,DQW_RML,DTRDZ,DTRDZ_RML,DTSTAR, BDYLYR3A.854
+ E_SEA,H_SEA,TAUX,TAUY, BDYLYR3A.855
+ U10M,V10M, BDYLYR3A.856
+ NRML,ERR,LTIMER BDYLYR3A.857
+) BDYLYR3A.858
IF (ERR.GT.0) THEN BDYLYR3A.859
ERROR = ERR + 30 BDYLYR3A.860
GOTO999 BDYLYR3A.861
ENDIF BDYLYR3A.862
C BDYLYR3A.863
CL 6.1 Convert FTL to sensible heat flux in Watts per square metre. BDYLYR3A.864
C BDYLYR3A.865
DO 7 K=1,BL_LEVELS BDYLYR3A.866
Cfpp$ Select(CONCUR) BDYLYR3A.867
DO 71 I=P1,P1+P_POINTS-1 BDYLYR3A.868
FTL(I,K) = FTL(I,K)*CP BDYLYR3A.869
71 CONTINUE BDYLYR3A.870
7 CONTINUE BDYLYR3A.871
C BDYLYR3A.872
C----------------------------------------------------------------------- BDYLYR3A.873
CL 7. Surface evaporation components and updating of surface BDYLYR3A.874
CL temperature (P245, routine SF_EVAP). BDYLYR3A.875
CL The following diagnostics are also calculated, as requested :- BDYLYR3A.876
CL Heat flux due to melting of sea-ice; specific humidity at 1.5 BDYLYR3A.877
CL metres; temperature at 1.5 metres. BDYLYR3A.878
C----------------------------------------------------------------------- BDYLYR3A.879
C BDYLYR3A.880
CALL SF_EVAP
( BDYLYR3A.881
+ P_FIELD,P1,LAND_FIELD,LAND1, BDYLYR3A.882
+ P_POINTS,BL_LEVELS,LAND_MASK,LAND_PTS,LAND_INDEX, BDYLYR3A.886
+ ASOIL_1,CANOPY,CATCH,DTRDZ,DTRDZ_RML, BDYLYR3A.888
+ EA,ESL,SOIL_HT_FLUX,E_SEA, BDYLYR3A.889
+ ICE_FRACT,LYING_SNOW,RADNET,SMC,TIMESTEP, BDYLYR3A.890
+ CER1P5M,CHR1P5M,PSTAR,Z1,Z0M_EFF,Z0H, BDYLYR3A.891
+ SQ1P5,ST1P5,SMLT, BDYLYR3A.892
+ NRML, BDYLYR3A.893
+ RHOKH,DQW_1,DQW_RML,DTSTAR,FTL,FQW,ES,QW,TL,TSTAR, BDYLYR3A.894
+ ECAN,EI BDYLYR3A.895
+,SICE_MLT_HTF,Q1P5M,T1P5M,LTIMER BDYLYR3A.896
+) BDYLYR3A.897
C BDYLYR3A.898
CL 7.1 Copy T and Q from workspace to INOUT space. BDYLYR3A.899
C BDYLYR3A.900
DO K=1,BL_LEVELS BDYLYR3A.901
Cfpp$ Select(CONCUR) BDYLYR3A.902
DO I=P1,P1+P_POINTS-1 BDYLYR3A.903
T(I,K)=TL(I,K) BDYLYR3A.904
Q(I,K)=QW(I,K) BDYLYR3A.905
ENDDO BDYLYR3A.906
ENDDO BDYLYR3A.907
C BDYLYR3A.908
C----------------------------------------------------------------------- BDYLYR3A.909
CL 8. Calculate surface latent heat flux diagnostic. BDYLYR3A.910
C----------------------------------------------------------------------- BDYLYR3A.911
C BDYLYR3A.912
IF (SLH) THEN BDYLYR3A.913
DO 9 I=P1,P1+P_POINTS-1 BDYLYR3A.914
LATENT_HEAT(I) = LC*FQW(I,1) + LF*EI(I) BDYLYR3A.915
9 CONTINUE BDYLYR3A.916
ENDIF BDYLYR3A.917
999 CONTINUE ! Branch for error exit. BDYLYR3A.918
BDYLYR3A.919
IF (LTIMER) THEN BDYLYR3A.920
CALL TIMER
('BDYLAYR ',4) BDYLYR3A.921
ENDIF BDYLYR3A.922
BDYLYR3A.923
RETURN BDYLYR3A.924
END BDYLYR3A.925
*ENDIF BDYLYR3A.926