SUBROUTINE BDY_LAYR ( 4,80BDYLYR7A.72
BDYLYR7A.73
! IN values defining field dimensions and subset to be processed : BDYLYR7A.74
& P_FIELD,U_FIELD,LAND_FIELD, BDYLYR7A.75
& P_ROWS,FIRST_ROW,N_ROWS,ROW_LENGTH, BDYLYR7A.76
& N_P_ROWS,N_U_ROWS,P_POINTS,P1,LAND1,LAND_PTS,U_POINTS,U1, BDYLYR7A.77
BDYLYR7A.78
! IN values defining vertical grid of model atmosphere : BDYLYR7A.79
& BL_LEVELS,P_LEVELS,AK,BK,AKH,BKH,DELTA_AK,DELTA_BK, BDYLYR7A.80
& EXNER, BDYLYR7A.81
BDYLYR7A.82
! IN soil/vegetation/land surface data : BDYLYR7A.83
& LAND_INDEX, BDYLYR7A.85
& LAND_MASK,L_Z0_OROG, BDYLYR7A.87
& NTYPE,TILE_INDEX,TILE_PTS,SM_LEVELS, BDYLYR7A.88
& CANOPY,CATCH,GC,HCON,HO2R2_OROG,LYING_SNOW, BDYLYR7A.89
& SIL_OROG_LAND,SMC,SMVCST,STHF,STHU, BDYLYR7A.90
& TILE_FRAC,WT_EXT,Z0_SF_GB,Z0_TILE, BDYLYR7A.91
BDYLYR7A.92
! IN sea/sea-ice data : BDYLYR7A.93
& DI,ICE_FRACT,U_0,V_0, BDYLYR7A.94
BDYLYR7A.95
! IN cloud data : BDYLYR7A.96
& CF,QCF,QCL,CCA,CCB,CCT, BDYLYR7A.97
BDYLYR7A.98
! IN everything not covered so far : BDYLYR7A.99
& PSTAR,RADNET,RADNET_SNOW,TIMESTEP,VSHR, BDYLYR7A.100
& L_RMBL,L_BL_LSPICE,L_MOM,L_NEG_TSTAR, ABX1F405.855
BDYLYR7A.102
! IN STASH flags :- BDYLYR7A.103
& SFME,SIMLT,SMLT,SLH,SQ1P5,ST1P5,SU10,SV10, BDYLYR7A.104
BDYLYR7A.105
! INOUT data : BDYLYR7A.106
& Q,T,T_SOIL,TSNOW,TI,TSTAR,TSTAR_TILE,U,V,Z0MSEA, BDYLYR7A.107
BDYLYR7A.108
! OUT Diagnostic not requiring STASH flags : BDYLYR7A.109
& CD,CH,ECAN,E_SEA,ESOIL_TILE,FQW, BDYLYR7A.110
& FTL,FTL_TILE,H_SEA,RHOKH,RHOKM_UV, BDYLYR7A.111
& RIB,RIB_TILE,SEA_ICE_HTF,SURF_HT_FLUX,TAUX,TAUY, BDYLYR7A.112
BDYLYR7A.113
! OUT diagnostic requiring STASH flags : BDYLYR7A.114
& FME,SICE_MLT_HTF,SNOMLT_SURF_HTF,LATENT_HEAT, BDYLYR7A.115
& Q1P5M,T1P5M,U10M,V10M, BDYLYR7A.116
BDYLYR7A.117
! OUT data required for tracer mixing : BDYLYR7A.118
& RHO_ARESIST,ARESIST,RESIST_B, BDYLYR7A.119
& RHO_ARESIST_TILE,ARESIST_TILE,RESIST_B_TILE, BDYLYR7A.120
& NRML, BDYLYR7A.121
BDYLYR7A.122
! OUT data required for 4D-VAR : BDYLYR7A.123
& RHO_CD_MODV1,RHO_KM, BDYLYR7A.124
BDYLYR7A.125
! OUT data required elsewhere in UM system : BDYLYR7A.126
& ECAN_TILE,EI,ESOIL,EXT,SNOWMELT,ZH, BDYLYR7A.127
& SOIL_SURF_HTF,SNOW_SURF_HTF, BDYLYR7A.128
& T1_SD,Q1_SD,ERROR, BDYLYR7A.129
BDYLYR7A.130
! LOGICAL LTIMER BDYLYR7A.131
& LTIMER BDYLYR7A.132
& ) BDYLYR7A.133
BDYLYR7A.134
IMPLICIT NONE BDYLYR7A.135
BDYLYR7A.136
! Inputs :- BDYLYR7A.137
BDYLYR7A.138
! (a) Defining horizontal grid and subset thereof to be processed. BDYLYR7A.139
! Checked for consistency. BDYLYR7A.141
BDYLYR7A.145
INTEGER BDYLYR7A.146
& P_FIELD ! IN No. of P-points in whole grid BDYLYR7A.147
! ! (for dimensioning only). BDYLYR7A.148
&,U_FIELD ! IN No. of UV-points in whole grid. BDYLYR7A.149
&,LAND_FIELD ! IN No.of land points in whole grid. BDYLYR7A.150
&,P_ROWS ! IN No. of P-rows in whole grid BDYLYR7A.151
! ! (for dimensioning only). BDYLYR7A.152
&,FIRST_ROW ! IN First row of data to be treated, BDYLYR7A.153
! ! referred to P-grid. BDYLYR7A.154
&,N_ROWS ! IN No. of rows of data to be BDYLYR7A.155
! ! treated, referred to P-grid. BDYLYR7A.156
&,ROW_LENGTH ! IN No. of points in one row. BDYLYR7A.157
&,N_P_ROWS ! IN No of P-rows being processed. BDYLYR7A.158
&,N_U_ROWS ! IN No of UV-rows being processed. BDYLYR7A.159
&,P_POINTS ! IN No of P-points being processed. BDYLYR7A.160
&,P1 ! IN First P-point to be processed. BDYLYR7A.161
&,LAND1 ! IN First land-point to be processed. BDYLYR7A.162
! ! 1 <= LAND1 <= LAND_FIELD BDYLYR7A.163
&,LAND_PTS ! IN No of land points being processed. BDYLYR7A.164
&,U_POINTS ! IN No of UV-points being processed. BDYLYR7A.165
&,U1 ! IN First UV-point to be processed. BDYLYR7A.166
BDYLYR7A.167
! (b) Defining vertical grid of model atmosphere. BDYLYR7A.168
BDYLYR7A.169
INTEGER BDYLYR7A.170
& BL_LEVELS ! IN Max. no. of "boundary" levels BDYLYR7A.171
! ! allowed. Assumed <= 30 for dim- BDYLYR7A.172
! ! ensioning GAMMA in common deck BDYLYR7A.173
! ! C_GAMMA used in SF_EXCH and KMKH BDYLYR7A.174
&,P_LEVELS ! IN Total no. of vertical levels in BDYLYR7A.175
! ! the model atmosphere. BDYLYR7A.176
REAL BDYLYR7A.177
& AK(P_LEVELS) ! IN Hybrid 'A' for all levels. BDYLYR7A.178
&,BK(P_LEVELS) ! IN Hybrid 'B' for all levels. BDYLYR7A.179
&,AKH(P_LEVELS+1) ! IN Hybrid 'A' for layer interfaces. BDYLYR7A.180
&,BKH(P_LEVELS+1) ! IN Hybrid 'B' for layer interfaces. BDYLYR7A.181
&,DELTA_AK(P_LEVELS) ! IN Difference of hybrid 'A' across BDYLYR7A.182
! ! layers (K-1/2 to K+1/2). BDYLYR7A.183
! ! NB: Upper minus lower. BDYLYR7A.184
&,DELTA_BK(P_LEVELS) ! IN Difference of hybrid 'B' across BDYLYR7A.185
! ! layers (K-1/2 to K+1/2). BDYLYR7A.186
! ! NB: Upper minus lower. BDYLYR7A.187
&,EXNER(P_FIELD,BL_LEVELS+1) ! IN Exner function. EXNER(,K) is BDYLYR7A.188
! ! value for LOWER BOUNDARY of BDYLYR7A.189
! ! level K. BDYLYR7A.190
BDYLYR7A.191
! (c) Soil/vegetation/land surface parameters (mostly constant). BDYLYR7A.192
BDYLYR7A.193
LOGICAL BDYLYR7A.194
& LAND_MASK(P_FIELD) ! IN T if land, F elsewhere. BDYLYR7A.195
&,L_Z0_OROG ! IN T to use orog.roughness BDYLYR7A.196
! ! treatment in SF_EXCH BDYLYR7A.197
BDYLYR7A.198
INTEGER BDYLYR7A.200
& LAND_INDEX(P_FIELD) ! IN LAND_INDEX(I)=J => the Jth BDYLYR7A.201
! ! point in P_FIELD is the Ith BDYLYR7A.202
! ! land point. BDYLYR7A.203
BDYLYR7A.205
INTEGER BDYLYR7A.206
& SM_LEVELS ! IN No. of soil moisture levels BDYLYR7A.207
&,NTYPE ! IN No. of land tiles BDYLYR7A.208
&,TILE_INDEX(LAND_FIELD,NTYPE)! IN Index of tile points BDYLYR7A.209
&,TILE_PTS(NTYPE) ! IN Number of tile points BDYLYR7A.210
BDYLYR7A.211
REAL BDYLYR7A.212
& CANOPY(LAND_FIELD,NTYPE-1) ! IN Surface/canopy water for BDYLYR7A.213
! ! snow-free land tiles (kg/m2) BDYLYR7A.214
&,CATCH(LAND_FIELD,NTYPE-1) ! IN Surface/canopy water capacity BDYLYR7A.215
! ! of snow-free land tiles (kg/m2). BDYLYR7A.216
&,GC(LAND_FIELD,NTYPE) ! IN "Stomatal" conductance to BDYLYR7A.217
! ! evaporation for land tiles BDYLYR7A.218
! ! (m/s). BDYLYR7A.219
&,HCON(LAND_FIELD) ! IN Soil thermal conductivity BDYLYR7A.220
! ! (W/m/K). BDYLYR7A.221
&,LYING_SNOW(P_FIELD) ! IN Lying snow (kg/sq m). BDYLYR7A.222
! Must be global for coupled model, BDYLYR7A.224
! ie dimension P_FIELD not BDYLYR7A.225
! LAND_FIELD BDYLYR7A.226
&,SMC(LAND_FIELD) ! IN Available soil moisture (kg/m2). BDYLYR7A.228
&,SMVCST(LAND_FIELD) ! IN Volumetric saturation point BDYLYR7A.229
! ! (m3/m3 of soil). BDYLYR7A.230
&,STHF(LAND_FIELD,SM_LEVELS) ! IN Frozen soil moisture content of BDYLYR7A.231
! ! each layer as a fraction of BDYLYR7A.232
! ! saturation. BDYLYR7A.233
&,STHU(LAND_FIELD,SM_LEVELS) ! IN Unfrozen soil moisture content BDYLYR7A.234
! ! of each layer as a fraction of BDYLYR7A.235
! ! saturation. BDYLYR7A.236
&,TILE_FRAC(LAND_FIELD,NTYPE) ! IN Tile fractions including BDYLYR7A.237
! ! snow cover in the ice tile. BDYLYR7A.238
&,WT_EXT(LAND_FIELD,SM_LEVELS)! IN Fraction of evapotranspiration BDYLYR7A.239
! ! extracted from each soil layer. BDYLYR7A.240
&,Z0_TILE(LAND_FIELD,NTYPE) ! IN Tile roughness lengths (m). BDYLYR7A.241
&,Z0_SF_GB(P_FIELD) ! IN GBM roughness length for BDYLYR7A.242
! ! snow-free land (m). BDYLYR7A.243
&,SIL_OROG_LAND(LAND_FIELD) ! IN Silhouette area of unresolved BDYLYR7A.244
! ! orography per unit horizontal BDYLYR7A.245
! ! area on land points only. BDYLYR7A.246
&,HO2R2_OROG(LAND_FIELD) ! IN Standard Deviation of orography. BDYLYR7A.247
! ! equivilent to peak to trough BDYLYR7A.248
! ! height of unresolved orography BDYLYR7A.249
! ! divided by 2SQRT(2) on land BDYLYR7A.250
! ! points only (m) BDYLYR7A.251
BDYLYR7A.252
! (d) Sea/sea-ice data. BDYLYR7A.253
BDYLYR7A.254
REAL BDYLYR7A.255
& DI(P_FIELD) ! IN "Equivalent thickness" of BDYLYR7A.256
! ! sea-ice(m). BDYLYR7A.257
&,ICE_FRACT(P_FIELD) ! IN Fraction of gridbox covered by BDYLYR7A.258
! ! sea-ice (decimal fraction). BDYLYR7A.259
&,U_0(U_FIELD) ! IN W'ly component of surface BDYLYR7A.260
! ! current (m/s). BDYLYR7A.261
&,V_0(U_FIELD) ! IN S'ly component of surface BDYLYR7A.262
! ! current (m/s). BDYLYR7A.263
BDYLYR7A.264
! (e) Cloud data. BDYLYR7A.265
BDYLYR7A.266
REAL BDYLYR7A.267
& CF(P_FIELD,BL_LEVELS) ! IN Cloud fraction (decimal). BDYLYR7A.268
&,QCF(P_FIELD,BL_LEVELS) ! IN Cloud ice (kg per kg air) BDYLYR7A.269
&,QCL(P_FIELD,BL_LEVELS) ! IN Cloud liquid water (kg BDYLYR7A.270
! ! per kg air). BDYLYR7A.271
&,CCA(P_FIELD) ! IN Convective Cloud Amount BDYLYR7A.272
! ! (decimal) BDYLYR7A.273
BDYLYR7A.274
INTEGER BDYLYR7A.275
& CCB(P_FIELD) ! IN Convective Cloud Base BDYLYR7A.276
&,CCT(P_FIELD) ! IN Convective Cloud Top BDYLYR7A.277
BDYLYR7A.278
! (f) Atmospheric + any other data not covered so far, incl control. BDYLYR7A.279
BDYLYR7A.280
REAL BDYLYR7A.281
& PSTAR(P_FIELD) ! IN Surface pressure (Pascals). BDYLYR7A.282
&,RADNET(P_FIELD) ! IN Surface net radiation for sea- BDYLYR7A.283
! ! ice or snow-free land (W/sq m). BDYLYR7A.284
&,RADNET_SNOW(P_FIELD) ! IN Snow surface net radiation. BDYLYR7A.285
&,TIMESTEP ! IN Timestep (seconds). BDYLYR7A.286
&,VSHR(P_FIELD) ! IN Magnitude of surface-to-lowest BDYLYR7A.287
! ! atm level wind shear (m per s). BDYLYR7A.288
BDYLYR7A.289
LOGICAL BDYLYR7A.290
& LTIMER ! IN Logical switch for TIMER diags BDYLYR7A.291
&,L_RMBL ! IN T to use rapidly mixing boundary BDYLYR7A.292
! ! scheme BDYLYR7A.293
! ! - not available in MOSES II BDYLYR7A.294
&,L_BL_LSPICE ! IN Use if 3A large scale precip BDYLYR7A.295
&,L_MOM ! IN Switch for convective momentum BDYLYR7A.296
! ! transport. BDYLYR7A.297
&,L_NEG_TSTAR ! IN Switch for -ve TSTAR error check ABX1F405.856
BDYLYR7A.298
! STASH flags :- BDYLYR7A.299
BDYLYR7A.300
LOGICAL BDYLYR7A.301
& SFME ! IN Flag for FME (q.v.). BDYLYR7A.302
&,SIMLT ! IN Flag for SICE_MLT_HTF (q.v.) BDYLYR7A.303
&,SMLT ! IN Flag for SNOMLT_SURF_HTF (q.v.) BDYLYR7A.304
&,SLH ! IN Flag for LATENT_HEAT (q.v.) BDYLYR7A.305
&,SQ1P5 ! IN Flag for Q1P5M (q.v.) BDYLYR7A.306
&,ST1P5 ! IN Flag for T1P5M (q.v.) BDYLYR7A.307
&,SU10 ! IN Flag for U10M (q.v.) BDYLYR7A.308
&,SV10 ! IN Flag for V10M (q.v.) BDYLYR7A.309
BDYLYR7A.310
! In/outs :- BDYLYR7A.311
BDYLYR7A.312
REAL BDYLYR7A.313
& Q(P_FIELD,BL_LEVELS) ! IN Specific humidity ( kg/kg air). BDYLYR7A.314
! ! OUT Total water content (QW) BDYLYR7A.315
! ! (kg/kg air). BDYLYR7A.316
&,T(P_FIELD,BL_LEVELS) ! IN Atmospheric temperature (K). BDYLYR7A.317
! ! OUT Liquid/frozen water BDYLYR7A.318
! ! temperature (TL) (K). BDYLYR7A.319
&,T_SOIL(LAND_FIELD,SM_LEVELS)! INOUT Soil temperatures (K). BDYLYR7A.320
&,TI(P_FIELD) ! INOUT Sea-ice surface layer BDYLYR7A.321
! ! temperature (K). BDYLYR7A.322
&,TSNOW(LAND_FIELD) ! INOUT Snow surface layer BDYLYR7A.323
! ! temperature (K). BDYLYR7A.324
! ! =T_SOIL(*,1) for land-ice BDYLYR7A.325
&,TSTAR(P_FIELD) ! INOUT GBM surface temperature (K). BDYLYR7A.326
&,TSTAR_TILE(LAND_FIELD,NTYPE)! INOUT Surface tile temperatures BDYLYR7A.327
&,U(U_FIELD,BL_LEVELS) ! INOUT W'ly wind component (m/s) BDYLYR7A.328
&,V(U_FIELD,BL_LEVELS) ! INOUT S'ly wind component (m/s) BDYLYR7A.329
&,Z0MSEA(P_FIELD) ! INOUT Sea-surface roughness BDYLYR7A.330
! ! length for momentum (m). BDYLYR7A.331
BDYLYR7A.332
! Outputs :- BDYLYR7A.333
!-1 Diagnostic (or effectively so - includes coupled model requisites):- BDYLYR7A.334
BDYLYR7A.335
! (a) Calculated anyway (use STASH space from higher level) :- BDYLYR7A.336
! BDYLYR7A.337
REAL BDYLYR7A.338
& CD(P_FIELD) ! OUT Turbulent surface exchange BDYLYR7A.339
! ! (bulk transfer) coefficient for BDYLYR7A.340
! ! momentum. BDYLYR7A.341
&,CH(P_FIELD) ! OUT Turbulent surface exchange BDYLYR7A.342
! ! (bulk transfer) coefficient for BDYLYR7A.343
! ! heat and/or moisture. BDYLYR7A.344
&,ECAN(P_FIELD) ! OUT Gridbox mean evaporation from BDYLYR7A.345
! ! canopy/surface store (kg/m2/s). BDYLYR7A.346
! ! Zero over sea. BDYLYR7A.347
&,E_SEA(P_FIELD) ! OUT Evaporation from sea times BDYLYR7A.348
! ! leads fraction. Zero over land. BDYLYR7A.349
! ! (kg per square metre per sec). BDYLYR7A.350
&,ESOIL_TILE(LAND_FIELD,NTYPE-1) BDYLYR7A.351
! ! OUT ESOIL for snow-free land tiles BDYLYR7A.352
&,FQW(P_FIELD,BL_LEVELS) ! OUT Moisture flux between layers BDYLYR7A.353
! ! (kg per square metre per sec). BDYLYR7A.354
! ! FQW(,1) is total water flux BDYLYR7A.355
! ! from surface, 'E'. BDYLYR7A.356
&,FTL(P_FIELD,BL_LEVELS) ! OUT FTL(,K) contains net turbulent BDYLYR7A.357
! ! sensible heat flux into layer K BDYLYR7A.358
! ! from below; so FTL(,1) is the BDYLYR7A.359
! ! surface sensible heat, H.(W/m2) BDYLYR7A.360
&,FTL_TILE(LAND_FIELD,NTYPE) ! OUT Surface FTL for land tiles BDYLYR7A.361
&,H_SEA(P_FIELD) ! OUT Surface sensible heat flux over BDYLYR7A.362
! ! sea times leads fraction (W/m2) BDYLYR7A.363
&,RHOKH(P_FIELD,BL_LEVELS) ! OUT Exchange coeffs for moisture. BDYLYR7A.364
&,RHOKM_UV(U_FIELD,BL_LEVELS) ! OUT Exchange coefficients for BDYLYR7A.365
! ! momentum (on UV-grid, with 1st BDYLYR7A.366
! ! and last rows undefined or, at BDYLYR7A.367
! ! present, set to "missing data") BDYLYR7A.368
&,RIB(P_FIELD) ! OUT Mean bulk Richardson number for BDYLYR7A.369
! ! lowest layer. BDYLYR7A.370
&,RIB_TILE(LAND_FIELD,NTYPE) ! OUT RIB for land tiles. BDYLYR7A.371
&,SEA_ICE_HTF(P_FIELD) ! OUT Heat flux through sea-ice BDYLYR7A.372
! ! (W/m2, positive downwards). BDYLYR7A.373
&,SURF_HT_FLUX(P_FIELD) ! OUT Net downward heat flux at BDYLYR7A.374
! ! surface over land or sea-ice BDYLYR7A.375
! ! fraction of gridbox (W/m2). BDYLYR7A.376
&,TAUX(U_FIELD,BL_LEVELS) ! OUT W'ly component of surface wind BDYLYR7A.377
! ! stress (N/sq m). (On UV-grid BDYLYR7A.378
! ! with first and last rows BDYLYR7A.379
! ! undefined or, at present, BDYLYR7A.380
! ! set to missing data BDYLYR7A.381
&,TAUY(U_FIELD,BL_LEVELS) ! OUT S'ly component of surface wind BDYLYR7A.382
! ! stress (N/sq m). On UV-grid; BDYLYR7A.383
! ! comments as per TAUX. BDYLYR7A.384
&,RHO_CD_MODV1(P_FIELD) ! OUT Surface air density * drag coef BDYLYR7A.385
! ! *mod(v1 - v0) before interp BDYLYR7A.386
&,RHO_KM(P_FIELD,2:BL_LEVELS) ! OUT Air density * turbulent mixing BDYLYR7A.387
! ! coefficient for momentum before BDYLYR7A.388
! ! interpolation. BDYLYR7A.389
&,RHO_ARESIST(P_FIELD) ! OUT RHOSTAR*CD_STD*VSHR for Sulphur BDYLYR7A.390
! ! cycle BDYLYR7A.391
&,ARESIST(P_FIELD) ! OUT 1/(CD_STD*VSHR) for Sulphur BDYLYR7A.392
! ! cycle BDYLYR7A.393
&,RESIST_B(P_FIELD) ! OUT (1/CH-1/(CD_STD)/VSHR for BDYLYR7A.394
! ! Sulphur cycle BDYLYR7A.395
&,RHO_ARESIST_TILE(LAND_FIELD,NTYPE) BDYLYR7A.396
! ! OUT RHOSTAR*CD_STD*VSHR on land BDYLYR7A.397
! ! tiles BDYLYR7A.398
&,ARESIST_TILE(LAND_FIELD,NTYPE) BDYLYR7A.399
! ! OUT 1/(CD_STD*VSHR) on land tiles BDYLYR7A.400
&,RESIST_B_TILE(LAND_FIELD,NTYPE) BDYLYR7A.401
! ! OUT (1/CH-1/CD_STD)/VSHR on land BDYLYR7A.402
! ! tiles BDYLYR7A.403
BDYLYR7A.404
INTEGER BDYLYR7A.405
& NRML(P_FIELD) ! OUT Number of model layers in the BDYLYR7A.406
! ! Rapidly Mixing Layer; set to BDYLYR7A.407
! ! zero in SF_EXCH for MOSES II. BDYLYR7A.408
BDYLYR7A.409
! (b) Not passed between lower-level routines (not in workspace at this BDYLYR7A.410
! level) :- BDYLYR7A.411
BDYLYR7A.412
REAL BDYLYR7A.413
& FME(P_FIELD) ! OUT Wind mixing "power" (W/m2). BDYLYR7A.414
&,SICE_MLT_HTF(P_FIELD) ! OUT Heat flux due to melting of BDYLYR7A.415
! ! sea-ice (Watts per sq metre). BDYLYR7A.416
&,SNOMLT_SURF_HTF(P_FIELD) ! OUT Heat flux required for surface BDYLYR7A.417
! ! melting of snow (W/m2). BDYLYR7A.418
&,LATENT_HEAT(P_FIELD) ! OUT Surface latent heat flux, +ve BDYLYR7A.419
! ! upwards (Watts per sq m). BDYLYR7A.420
&,Q1P5M(P_FIELD) ! OUT Q at 1.5 m (kg water / kg air). BDYLYR7A.421
&,T1P5M(P_FIELD) ! OUT T at 1.5 m (K). BDYLYR7A.422
&,U10M(U_FIELD) ! OUT U at 10 m (m per s). BDYLYR7A.423
&,V10M(U_FIELD) ! OUT V at 10 m (m per s). BDYLYR7A.424
BDYLYR7A.425
!-2 Genuinely output, needed by other atmospheric routines :- BDYLYR7A.426
BDYLYR7A.427
REAL BDYLYR7A.428
& EI(P_FIELD) ! OUT Sublimation from lying snow or BDYLYR7A.429
! ! sea-ice (kg/m2/s). BDYLYR7A.430
&,ECAN_TILE(LAND_FIELD,NTYPE-1)! OUT ECAN for snow-free land tiles BDYLYR7A.431
&,ESOIL(P_FIELD) ! OUT Surface evapotranspiration BDYLYR7A.432
! ! from soil moisture store BDYLYR7A.433
! ! (kg/m2/s). BDYLYR7A.434
&,EXT(LAND_FIELD,SM_LEVELS) ! OUT Extraction of water from each BDYLYR7A.435
! ! soil layer (kg/m2/s). BDYLYR7A.436
&,SOIL_SURF_HTF(LAND_FIELD) ! OUT Net downward heat flux at BDYLYR7A.437
! ! snow-free land surface (W/m2). BDYLYR7A.438
&,SNOW_SURF_HTF(LAND_FIELD) ! OUT Net downward heat flux at BDYLYR7A.439
! ! snow surface (W/m2). BDYLYR7A.440
&,SNOWMELT(P_FIELD) ! OUT Snowmelt (kg/m2/s). BDYLYR7A.441
&,ZH(P_FIELD) ! OUT Height above surface of top of BDYLYR7A.442
! ! boundary layer (metres). BDYLYR7A.443
&,T1_SD(P_FIELD) ! OUT Standard deviation of turbulent BDYLYR7A.444
! ! fluctuations of layer 1 temp; BDYLYR7A.445
! ! used in initiating convection. BDYLYR7A.446
&,Q1_SD(P_FIELD) ! OUT Standard deviation of turbulent BDYLYR7A.447
! ! flucs of layer 1 humidity; BDYLYR7A.448
! ! used in initiating convection. BDYLYR7A.449
INTEGER BDYLYR7A.450
& ERROR ! OUT 0 - AOK; BDYLYR7A.451
! ! 1 to 7 - bad grid definition detected; BDYLYR7A.453
BDYLYR7A.457
!--------------------------------------------------------------------- BDYLYR7A.458
! External routines called :- BDYLYR7A.459
BDYLYR7A.460
EXTERNAL Z,HEAT_CON,SF_EXCH,BOUY_TQ,BTQ_INT, BDYLYR7A.461
& KMKH,EX_FLUX_TQ,EX_FLUX_UV,IM_CAL_TQ,SICE_HTF,SF_EVAP,SF_MELT, BDYLYR7A.462
& IM_CAL_UV,SCREEN_TQ BDYLYR7A.463
EXTERNAL TIMER BDYLYR7A.464
*IF -DEF,SCMA AJC1F405.346
EXTERNAL UV_TO_P,P_TO_UV BDYLYR7A.466
*ENDIF BDYLYR7A.467
BDYLYR7A.468
!----------------------------------------------------------------------- BDYLYR7A.469
! Symbolic constants (parameters) reqd in top-level routine :- BDYLYR7A.470
BDYLYR7A.471
*CALL C_R_CP 
BDYLYR7A.472
*CALL C_G BDYLYR7A.473
*CALL C_LHEAT BDYLYR7A.474
*CALL C_GAMMA BDYLYR7A.475
*CALL SOIL_THICK BDYLYR7A.476
*IF DEF,MPP BDYLYR7A.477
! MPP Common block BDYLYR7A.478
*CALL PARVARS BDYLYR7A.479
*ENDIF BDYLYR7A.480
BDYLYR7A.481
! Derived local parameters. BDYLYR7A.482
BDYLYR7A.483
REAL LCRCP,LS,LSRCP BDYLYR7A.484
BDYLYR7A.485
PARAMETER ( BDYLYR7A.486
& LCRCP=LC/CP ! Evaporation-to-dT conversion factor. BDYLYR7A.487
&,LS=LF+LC ! Latent heat of sublimation. BDYLYR7A.488
&,LSRCP=LS/CP ! Sublimation-to-dT conversion factor. BDYLYR7A.489
& ) BDYLYR7A.490
BDYLYR7A.491
!----------------------------------------------------------------------- BDYLYR7A.492
BDYLYR7A.493
! Workspace :- BDYLYR7A.494
BDYLYR7A.495
REAL BDYLYR7A.496
& ALPHA1(LAND_FIELD,NTYPE) ! Mean gradient of saturated BDYLYR7A.497
! ! specific humidity with respect to BDYLYR7A.498
! ! temperature between the bottom model BDYLYR7A.499
! ! layer and tile surfaces BDYLYR7A.500
&,ALPHA1_SICE(P_FIELD) ! ALPHA1 for sea-ice. BDYLYR7A.501
&,ASHTF(P_FIELD) ! Coefficient to calculate surface BDYLYR7A.502
! ! heat flux into soil or sea-ice. BDYLYR7A.503
&,ASHTF_SNOW(P_FIELD) ! ASHTF for snow or land-ice. BDYLYR7A.504
&,ASURF(P_FIELD) ! Reciprocal areal heat capacity BDYLYR7A.505
! ! of sea-ice surface layer (K m**2 / J). BDYLYR7A.506
&,BF(P_FIELD,BL_LEVELS) ! A buoyancy parameter (beta F tilde) BDYLYR7A.507
&,BQ(P_FIELD,BL_LEVELS) ! A buoyancy parameter (beta q tilde). BDYLYR7A.508
&,BT(P_FIELD,BL_LEVELS) ! A buoyancy parameter (beta T tilde). BDYLYR7A.509
&,DELTAP(P_FIELD,BL_LEVELS)! Difference in pressure between levels BDYLYR7A.510
&,DELTAP_UV(P_FIELD,BL_LEVELS) BDYLYR7A.511
! ! Difference in pressure between levels BDYLYR7A.512
! ! on UV points BDYLYR7A.513
&,DTRDZ(P_FIELD,BL_LEVELS) ! -g.dt/dp for model layers. BDYLYR7A.514
&,DTRDZ_UV(U_FIELD,BL_LEVELS) BDYLYR7A.515
! ! -g.dt/dp for model wind layers. BDYLYR7A.516
&,DTRDZ_RML(P_FIELD) ! -g.dt/dp for the rapidly BDYLYR7A.517
! ! mixing layer. BDYLYR7A.518
&,DZL(P_FIELD,BL_LEVELS) ! DZL(,K) is depth in m of layer BDYLYR7A.519
! ! K, i.e. distance from boundary BDYLYR7A.520
! ! K-1/2 to boundary K+1/2. BDYLYR7A.521
&,DU(U_FIELD,BL_LEVELS) ! BL increment to u wind foeld BDYLYR7A.522
&,DV(U_FIELD,BL_LEVELS) ! BL increment to v wind foeld BDYLYR7A.523
&,DU_NT(U_FIELD,BL_LEVELS) ! non-turbulent inc. to u wind field BDYLYR7A.524
&,DV_NT(U_FIELD,BL_LEVELS) ! non-turbulent inc. to v wind field BDYLYR7A.525
&,DTL_NT(P_FIELD,BL_LEVELS)! non-turbulent inc. to TL field BDYLYR7A.526
&,DQW_NT(P_FIELD,BL_LEVELS)! non-turbulent inc. to QW field BDYLYR7A.527
&,FQW_TILE(LAND_FIELD,NTYPE)! Surface FQW for land tiles BDYLYR7A.528
&,FQW_ICE(P_FIELD) ! Surface FQW for sea-ice BDYLYR7A.529
&,FTL_ICE(P_FIELD) ! Surface FTL for sea-ice BDYLYR7A.530
&,FRACA(LAND_FIELD,NTYPE-1)! Fraction of surface moisture flux BDYLYR7A.531
! ! with only aerodynamic resistance BDYLYR7A.532
! ! for snow-free land tiles. BDYLYR7A.533
&,HCONS(LAND_FIELD) ! Soil thermal conductivity including BDYLYR7A.534
! ! the effects of water and ice (W/m2) BDYLYR7A.535
&,QW(P_FIELD,BL_LEVELS) ! Total water content, but BDYLYR7A.536
! ! replaced by specific humidity BDYLYR7A.537
! ! in LS_CLD. BDYLYR7A.538
&,P(P_FIELD,BL_LEVELS) ! Pressure at model levels BDYLYR7A.539
&,RDZ(P_FIELD,BL_LEVELS) ! RDZ(,1) is the reciprocal of the BDYLYR7A.540
! ! height of level 1, i.e. of the BDYLYR7A.541
! ! middle of layer 1. For K > 1, BDYLYR7A.542
! ! RDZ(,K) is the reciprocal BDYLYR7A.543
! ! of the vertical distance BDYLYR7A.544
! ! from level K-1 to level K. BDYLYR7A.545
&,RDZUV(U_FIELD,BL_LEVELS) ! RDZ (K > 1) on UV-grid. BDYLYR7A.546
! ! Comments as per RHOKM (RDZUV). BDYLYR7A.547
&,RESFS(LAND_FIELD,NTYPE-1)! Combined soil, stomatal BDYLYR7A.548
! ! and aerodynamic resistance BDYLYR7A.549
! ! factor for fraction (1-FRACA) of BDYLYR7A.550
! ! snow-free land tiles. BDYLYR7A.551
&,RESFT(LAND_FIELD,NTYPE) ! Total resistance factor. BDYLYR7A.552
! ! FRACA+(1-FRACA)*RESFS for snow-free BDYLYR7A.553
! ! land, 1 for snow. BDYLYR7A.554
&,RHO(P_FIELD,BL_LEVELS) ! Density of model layer BDYLYR7A.555
&,RHOKH_TILE(LAND_FIELD,NTYPE) BDYLYR7A.556
! ! Surface exchange coefficients BDYLYR7A.557
! ! for land tiles BDYLYR7A.558
&,RHOKH_SICE(P_FIELD) ! Surface exchange coefficients BDYLYR7A.559
! ! for sea and sea-ice BDYLYR7A.560
&,RHOKM(P_FIELD,BL_LEVELS) ! Exchange coefficients for BDYLYR7A.561
! ! momentum on P-grid BDYLYR7A.562
&,RHOKPM(LAND_FIELD,NTYPE) ! Land surface exchange coeff. BDYLYR7A.563
&,RHOKPM_SICE(P_FIELD) ! Sea-ice surface exchange coeff. BDYLYR7A.564
&,TL(P_FIELD,BL_LEVELS) ! Ice/liquid water temperature, BDYLYR7A.565
! ! but replaced by T in LS_CLD. BDYLYR7A.566
&,TV(P_FIELD,BL_LEVELS) ! Virtual temp BDYLYR7A.567
&,U_P(P_FIELD,BL_LEVELS) ! U on P-grid. BDYLYR7A.568
&,V_P(P_FIELD,BL_LEVELS) ! V on P-grid. BDYLYR7A.569
&,ZLB(P_FIELD,0:BL_LEVELS) ! ZLB(,K) is the height of the BDYLYR7A.570
! ! upper boundary of layer K BDYLYR7A.571
! ! ( = 0.0 for "K=0"). BDYLYR7A.572
REAL BDYLYR7A.573
& Z1(P_FIELD) ! Height of lowest level (i.e. BDYLYR7A.574
! ! height of middle of lowest BDYLYR7A.575
! ! layer). BDYLYR7A.576
&,H_BLEND_OROG(P_FIELD) ! Blending height used as part of BDYLYR7A.577
! ! effective roughness scheme BDYLYR7A.578
&,Z0H(P_FIELD) ! Roughness length for heat and BDYLYR7A.579
! ! moisture (m). BDYLYR7A.580
&,Z0H_TILE(LAND_FIELD,NTYPE) BDYLYR7A.581
! ! Tile roughness lengths for heat and BDYLYR7A.582
! ! moisture (m). BDYLYR7A.583
&,Z0M(P_FIELD) ! Roughness length for momentum (m). BDYLYR7A.584
&,Z0M_TILE(LAND_FIELD,NTYPE) BDYLYR7A.585
! ! Tile roughness lengths for momentum. BDYLYR7A.586
&,Z0M_EFF(P_FIELD) ! Effective grid-box roughness BDYLYR7A.587
! ! length for momentum BDYLYR7A.588
&,CDR10M(P_FIELD) ! Ratio of CD's reqd for calculation BDYLYR7A.589
! ! of 10 m wind. On P-grid BDYLYR7A.590
&,CDR10M_UV(U_FIELD) ! Ratio of CD's reqd for calculation BDYLYR7A.591
! ! of 10 m wind. On UV-grid; comments as BDYLYR7A.592
! ! per RHOKM. BDYLYR7A.593
&,CHR1P5M(LAND_FIELD,NTYPE)! Ratio of coefffs for calculation of BDYLYR7A.594
! ! 1.5m temp for land tiles. BDYLYR7A.595
&,CHR1P5M_SICE(P_FIELD) ! CHR1P5M for sea and sea-ice BDYLYR7A.596
! ! (leads ignored). BDYLYR7A.597
BDYLYR7A.598
BDYLYR7A.605
! Local scalars :- BDYLYR7A.606
BDYLYR7A.607
REAL BDYLYR7A.608
& WK ! LOCAL 0.5 * DZL(I,K) * RDZ(I,K) BDYLYR7A.609
&,WKM1 ! LOCAL 0.5 * DZL(I,K-1) * RDZ(I,K) BDYLYR7A.610
BDYLYR7A.611
INTEGER BDYLYR7A.612
& I,J,L ! LOCAL Loop counter (horizontal field index). BDYLYR7A.613
&,K ! LOCAL Loop counter (vertical level index). BDYLYR7A.614
&,N ! LOCAL Loop counter (tile index). BDYLYR7A.615
BDYLYR7A.616
IF (LTIMER) THEN BDYLYR7A.617
CALL TIMER('BDYLAYR ',3) BDYLYR7A.618
ENDIF BDYLYR7A.619
ERROR = 0 BDYLYR7A.620
BDYLYR7A.621
!----------------------------------------------------------------------- BDYLYR7A.622
!! 1. Perform calculations in what the documentation describes as BDYLYR7A.623
!! subroutine Z_DZ. In fact, a separate subroutine isn't used. BDYLYR7A.624
!----------------------------------------------------------------------- BDYLYR7A.625
BDYLYR7A.626
!----------------------------------------------------------------------- BDYLYR7A.627
!! 1.1 Initialise ZLB(,0) (to zero, of course, this being the height BDYLYR7A.628
!! of the surface above the surface). BDYLYR7A.629
!----------------------------------------------------------------------- BDYLYR7A.630
BDYLYR7A.631
DO I=P1,P1+P_POINTS-1 BDYLYR7A.632
ZLB(I,0)=0.0 BDYLYR7A.633
ENDDO BDYLYR7A.634
BDYLYR7A.635
!----------------------------------------------------------------------- BDYLYR7A.636
!! 1.2 Calculate layer depths and heights, and construct wind fields on BDYLYR7A.637
!! P-grid. This involves calling subroutines Z and UV_TO_P. BDYLYR7A.638
!! Virtual temperature is also calculated, as a by-product. BDYLYR7A.639
!----------------------------------------------------------------------- BDYLYR7A.640
! NB RDZ TEMPORARILY used to return DELTA_Z_LOWER, the lower half BDYLYR7A.641
! layer thickness BDYLYR7A.642
BDYLYR7A.643
DO K=1,BL_LEVELS BDYLYR7A.644
CALL Z(P_POINTS,EXNER(P1,K),EXNER(P1,K+1),PSTAR(P1), BDYLYR7A.645
& AKH(K),BKH(K),Q(P1,K),QCF(P1,K), BDYLYR7A.646
& QCL(P1,K),T(P1,K),ZLB(P1,K-1),TV(P1,K), BDYLYR7A.647
& ZLB(P1,K),DZL(P1,K),RDZ(P1,K),LTIMER) BDYLYR7A.648
BDYLYR7A.649
*IF -DEF,SCMA AJC1F405.347
CALL UV_TO_P(U(U1,K),U_P(P1,K), BDYLYR7A.651
& U_POINTS,P_POINTS,ROW_LENGTH,N_U_ROWS) BDYLYR7A.652
CALL UV_TO_P(V(U1,K),V_P(P1,K), BDYLYR7A.653
& U_POINTS,P_POINTS,ROW_LENGTH,N_U_ROWS) BDYLYR7A.654
BDYLYR7A.655
*IF DEF,MPP ABX3F405.1
! DZL can contain incorrect data in halos, so call SWAPBOUNDS. ABX3F405.2
CALL SWAPBOUNDS(DZL(P1,1),ROW_LENGTH,N_U_ROWS,1,0,BL_LEVELS) ABX3F405.3
ABX3F405.4
*ENDIF ABX3F405.5
! du_nt 'borrowed to store dzl on uv grid BDYLYR7A.656
CALL P_TO_UV (DZL(P1,K),DU_NT(U1+ROW_LENGTH,K), BDYLYR7A.657
& P_POINTS,U_POINTS,ROW_LENGTH,N_P_ROWS) BDYLYR7A.658
BDYLYR7A.659
*ELSE BDYLYR7A.660
DO I = U1, U1-1+U_POINTS AJC1F405.348
U_P(i,K) = U(i,K) AJC1F405.349
V_P(i,K) = V(i,K) AJC1F405.350
END DO AJC1F405.351
*ENDIF BDYLYR7A.663
ENDDO BDYLYR7A.664
BDYLYR7A.665
! set pressure array. BDYLYR7A.666
DO K=1,BL_LEVELS BDYLYR7A.667
DO I=P1,P1+P_POINTS-1 BDYLYR7A.668
P(I,K) = AK(K) + BK(K)*PSTAR(I) BDYLYR7A.669
BDYLYR7A.670
! These will be used in new dynamics scheme - currently unused BDYLYR7A.671
DTL_NT(I,K)=0.0 BDYLYR7A.672
DQW_NT(I,K)=0.0 BDYLYR7A.673
BDYLYR7A.674
ENDDO BDYLYR7A.675
BDYLYR7A.676
ENDDO ! end of loop over bl_levels BDYLYR7A.677
BDYLYR7A.678
DO K=BL_LEVELS,2,-1 BDYLYR7A.679
BDYLYR7A.680
DO I=P1,P1+P_POINTS-1 BDYLYR7A.681
RDZ(I,K)=1.0/(RDZ(I,K)+(DZL(I,K-1)-RDZ(I,K-1))) BDYLYR7A.682
DELTAP(I,K)=DELTA_AK(K) + PSTAR(I)*DELTA_BK(K) BDYLYR7A.683
BDYLYR7A.684
DTRDZ(I,K) = -G * TIMESTEP/ DELTAP(I,K) BDYLYR7A.685
! & (DELTA_AK(K) + PSTAR(I)*DELTA_BK(K)) BDYLYR7A.686
ENDDO BDYLYR7A.687
ENDDO BDYLYR7A.688
BDYLYR7A.689
DO I=P1,P1+P_POINTS-1 BDYLYR7A.690
Z1(I)=RDZ(I,1) BDYLYR7A.691
RDZ(I,1)=1.0/RDZ(I,1) BDYLYR7A.692
DELTAP(I,1)=DELTA_AK(1) + PSTAR(I)*DELTA_BK(1) BDYLYR7A.693
DTRDZ(I,1) = -G * TIMESTEP/DELTAP(I,1) BDYLYR7A.694
! & (DELTA_AK(1) + PSTAR(I)*DELTA_BK(1)) BDYLYR7A.695
ENDDO BDYLYR7A.696
BDYLYR7A.697
DO K=1,BL_LEVELS BDYLYR7A.698
BDYLYR7A.699
! Calculate RDZUV here BDYLYR7A.700
BDYLYR7A.701
IF(K.GE.2)THEN BDYLYR7A.702
*IF -DEF,SCMA AJC1F405.352
BDYLYR7A.704
DO I=U1+ROW_LENGTH,U1-ROW_LENGTH+U_POINTS-1 BDYLYR7A.705
RDZUV(I,K) = 2.0 / ( DU_NT(I,K) + DU_NT(I,K-1) ) BDYLYR7A.706
ENDDO BDYLYR7A.707
BDYLYR7A.708
!----------------------------------------------------------------------- BDYLYR7A.709
! 1.3 Set first and last rows to "missing data indicator" BDYLYR7A.710
!----------------------------------------------------------------------- BDYLYR7A.711
BDYLYR7A.712
*IF DEF,MPP BDYLYR7A.713
IF (attop) THEN BDYLYR7A.714
*ENDIF BDYLYR7A.715
DO I=U1,U1+ROW_LENGTH-1 BDYLYR7A.716
RDZUV(I,K) = 1.0E30 BDYLYR7A.717
ENDDO BDYLYR7A.718
*IF DEF,MPP BDYLYR7A.719
ENDIF BDYLYR7A.720
BDYLYR7A.721
IF (atbase) THEN BDYLYR7A.722
*ENDIF BDYLYR7A.723
DO I= U1+(N_U_ROWS-1)*ROW_LENGTH, U1 + N_U_ROWS*ROW_LENGTH-1 BDYLYR7A.724
RDZUV(I,K) = 1.0E30 BDYLYR7A.725
ENDDO BDYLYR7A.726
*IF DEF,MPP BDYLYR7A.727
ENDIF BDYLYR7A.728
*ENDIF BDYLYR7A.729
BDYLYR7A.730
*ELSE BDYLYR7A.731
DO I = U1, U1-1+U_POINTS AJC1F405.353
RDZUV(i,K) = 2.0 / ( DZL(i,K) + DZL(i,K-1) ) AJC1F405.354
ENDDO AJC1F405.355
*ENDIF BDYLYR7A.733
ENDIF ! K .ge. 2 BDYLYR7A.734
BDYLYR7A.735
! Calculate DTRDZ_UV here. BDYLYR7A.736
BDYLYR7A.737
*IF -DEF,SCMA AJC1F405.356
! CALL P_TO_UV (DTRDZ(P1,K),DTRDZ_UV(U1+ROW_LENGTH,K), BDYLYR7A.739
! & P_POINTS,U_POINTS,ROW_LENGTH,N_P_ROWS) BDYLYR7A.740
BDYLYR7A.741
CALL P_TO_UV (DELTAP(P1,K),DELTAP_UV(U1+ROW_LENGTH,K), BDYLYR7A.742
& P_POINTS,U_POINTS,ROW_LENGTH,N_P_ROWS) BDYLYR7A.743
BDYLYR7A.744
DO I=U1+ROW_LENGTH,U1+U_POINTS-ROW_LENGTH-1 BDYLYR7A.745
DTRDZ_UV(I,K) = -G * TIMESTEP / DELTAP_UV(I,K) BDYLYR7A.746
ENDDO BDYLYR7A.747
BDYLYR7A.748
*ELSE BDYLYR7A.749
DO I = P1, P1-1+P_POINTS AJC1F405.357
DTRDZ_UV(i,K) = DTRDZ(i,K) AJC1F405.358
ENDDO AJC1F405.359
*ENDIF BDYLYR7A.751
BDYLYR7A.752
ENDDO ! loop over bl_levels BDYLYR7A.753
BDYLYR7A.754
! "borrowed" du_nt reset to zero BDYLYR7A.755
! Non turbulent increments for new dynamics scheme (currently not used) BDYLYR7A.756
DO K=1,BL_LEVELS BDYLYR7A.757
DO I=1,U_FIELD BDYLYR7A.758
DU_NT(I,K) =0.0 BDYLYR7A.759
DV_NT(I,K) =0.0 BDYLYR7A.760
ENDDO BDYLYR7A.761
ENDDO BDYLYR7A.762
BDYLYR7A.763
IF (LAND_FIELD.GT.0) THEN ! Omit if no land points BDYLYR7A.764
BDYLYR7A.765
!----------------------------------------------------------------------- BDYLYR7A.766
! Calculate the thermal conductivity of the top soil layer. BDYLYR7A.767
!----------------------------------------------------------------------- BDYLYR7A.768
CALL HEAT_CON (LAND_FIELD,HCON,STHU,STHF,SMVCST,HCONS,LTIMER) BDYLYR7A.769
BDYLYR7A.770
ENDIF ! End test on land points BDYLYR7A.771
BDYLYR7A.772
!----------------------------------------------------------------------- BDYLYR7A.773
!! Calculate total water content, QW and Liquid water temperature, TL BDYLYR7A.774
!----------------------------------------------------------------------- BDYLYR7A.775
DO K=1,BL_LEVELS BDYLYR7A.776
DO I=P1,P1+P_POINTS-1 BDYLYR7A.777
QW(I,K) = Q(I,K) + QCL(I,K) + QCF(I,K) ! P243.10 BDYLYR7A.778
TL(I,K) = T(I,K) - LCRCP*QCL(I,K) - LSRCP*QCF(I,K) ! P243.9 BDYLYR7A.779
ENDDO BDYLYR7A.780
ENDDO BDYLYR7A.781
BDYLYR7A.782
!----------------------------------------------------------------------- BDYLYR7A.783
!! Calculate buoyancy parameters BT and BQ. BDYLYR7A.784
!----------------------------------------------------------------------- BDYLYR7A.785
CALL BOUY_TQ ( BDYLYR7A.786
& P_FIELD,P1,P_POINTS,BL_LEVELS BDYLYR7A.787
&,P,CF,Q,QCF,QCL,T,TL BDYLYR7A.788
&,BT,BQ,BF,L_BL_LSPICE,LTIMER BDYLYR7A.789
& ) BDYLYR7A.790
BDYLYR7A.791
!----------------------------------------------------------------------- BDYLYR7A.792
!! 4. Surface turbulent exchange coefficients and "explicit" fluxes BDYLYR7A.793
!! (P243a, routine SF_EXCH). BDYLYR7A.794
!! Wind mixing "power" and some values required for other, later, BDYLYR7A.795
!! diagnostic calculations, are also evaluated if requested. BDYLYR7A.796
!----------------------------------------------------------------------- BDYLYR7A.797
BDYLYR7A.798
CALL SF_EXCH ( BDYLYR7A.799
& P_POINTS,P_FIELD,P1,LAND1,LAND_PTS,LAND_FIELD,NTYPE,LAND_INDEX, BDYLYR7A.800
& TILE_INDEX,TILE_PTS, BDYLYR7A.801
& BQ(1,1),BT(1,1),CANOPY,CATCH,DZSOIL(1),GC,HCONS,HO2R2_OROG, BDYLYR7A.802
& ICE_FRACT,LYING_SNOW,PSTAR,P(1,1),QW(1,1),RADNET,RADNET_SNOW, BDYLYR7A.803
& SIL_OROG_LAND,SMVCST,TILE_FRAC,TIMESTEP, BDYLYR7A.804
& TL(1,1),TI,T_SOIL(1,1),TSNOW,TSTAR_TILE,TSTAR, BDYLYR7A.805
& VSHR,Z0_TILE,Z0_SF_GB,Z1,Z1, BDYLYR7A.806
& LAND_MASK,SU10,SV10,SQ1P5,ST1P5,SFME,LTIMER,L_Z0_OROG,Z0MSEA, BDYLYR7A.807
& ALPHA1,ALPHA1_SICE,ASHTF,ASHTF_SNOW,CD,CH,CDR10M,CHR1P5M, BDYLYR7A.808
& CHR1P5M_SICE,E_SEA,FME,FQW(1,1),FQW_TILE,FQW_ICE, BDYLYR7A.809
& FTL(1,1),FTL_TILE,FTL_ICE,FRACA,H_BLEND_OROG,H_SEA, BDYLYR7A.810
& Q1_SD,RESFS,RESFT,RIB,RIB_TILE,T1_SD,Z0M_EFF, BDYLYR7A.811
& Z0H,Z0H_TILE,Z0M,Z0M_TILE,RHO_ARESIST,ARESIST,RESIST_B, BDYLYR7A.812
& RHO_ARESIST_TILE,ARESIST_TILE,RESIST_B_TILE, BDYLYR7A.813
& RHO_CD_MODV1,RHOKH_TILE,RHOKH_SICE,RHOKM(1,1),RHOKPM,RHOKPM_SICE, BDYLYR7A.814
& NRML BDYLYR7A.815
& ) BDYLYR7A.816
BDYLYR7A.817
!----------------------------------------------------------------------- BDYLYR7A.818
!! 5. Turbulent exchange coefficients and "explicit" fluxes between BDYLYR7A.819
!! model layers in the boundary layer (P243b, routine KMKH). BDYLYR7A.820
!----------------------------------------------------------------------- BDYLYR7A.821
BDYLYR7A.822
!----------------------------------------------------------------------- BDYLYR7A.823
!! Interpolate BT and BQ to interface between layers. BDYLYR7A.824
!----------------------------------------------------------------------- BDYLYR7A.825
BDYLYR7A.826
CALL BTQ_INT ( BDYLYR7A.827
& P_FIELD,P1,P_POINTS,BL_LEVELS BDYLYR7A.828
&,BQ,BT,BF,DZL,RDZ,QW,QCF,TL BDYLYR7A.829
&,L_BL_LSPICE,LTIMER BDYLYR7A.830
& ) BDYLYR7A.831
BDYLYR7A.832
!----------------------------------------------------------------------- BDYLYR7A.833
!! 5.3 Calculate the diffusion coefficients Km and Kh. BDYLYR7A.834
!----------------------------------------------------------------------- BDYLYR7A.835
BDYLYR7A.836
! Repeat of KMKH calculation, could be passed in from KMKH. BDYLYR7A.837
BDYLYR7A.838
DO K=2,BL_LEVELS BDYLYR7A.839
DO I=P1,P1+P_POINTS-1 BDYLYR7A.840
WKM1 = 0.5 * DZL(I,K-1) * RDZ(I,K) BDYLYR7A.841
WK = 0.5 * DZL(I,K) * RDZ(I,K) BDYLYR7A.842
BDYLYR7A.843
! Calculate rho at K-1/2, from P243.111 :- BDYLYR7A.844
RHO(I,K) = BDYLYR7A.845
& ( AKH(K) + BKH(K)*PSTAR(I) ) ! Pressure at K-1/2, P243.112 BDYLYR7A.846
& / ! divided by ... BDYLYR7A.847
& ( R * ! R times ... BDYLYR7A.848
& ( TV(I,K-1)*WK + TV(I,K)*WKM1 ) ! TV at K-1/2, from P243.113 BDYLYR7A.849
& ) BDYLYR7A.850
ENDDO BDYLYR7A.851
ENDDO BDYLYR7A.852
BDYLYR7A.853
CALL KMKH ( BDYLYR7A.854
& P_FIELD,P1,P_POINTS,BL_LEVELS, BDYLYR7A.855
& TIMESTEP,P,CCA,BT,BQ,BF,CF,DZL,DTRDZ, BDYLYR7A.856
& RDZ,U_P,V_P,FTL,FQW, BDYLYR7A.857
& RHO,Z0M_EFF,ZLB(1,0),H_BLEND_OROG, BDYLYR7A.858
& QW,QCF,RHOKM,RHO_KM(1,2),RHOKH,TL,ZH, BDYLYR7A.859
& CCB,CCT,L_MOM, BDYLYR7A.860
& NRML,L_BL_LSPICE,LTIMER BDYLYR7A.861
& ) BDYLYR7A.862
BDYLYR7A.863
!----------------------------------------------------------------------- BDYLYR7A.864
!! 5.4 Interpolate RHOKM's and CDR10M to uv points ready for the BDYLYR7A.865
!! calculation of the explcit fluxes TAU_X and TAU_Y at levels BDYLYR7A.866
!! above the surface. BDYLYR7A.867
!----------------------------------------------------------------------- BDYLYR7A.868
BDYLYR7A.869
*IF DEF,MPP BDYLYR7A.870
! RHOKM(*,1) contains duff data in halos. The P_TO_UV can interpolate BDYLYR7A.871
! this into the real data, so first we must update east/west halos BDYLYR7A.872
BDYLYR7A.873
CALL SWAPBOUNDS(RHOKM(P1,1),ROW_LENGTH,N_U_ROWS,1,0,1) BDYLYR7A.874
CALL SWAPBOUNDS(RHOKM(1,2),ROW_LENGTH, BDYLYR7A.875
& U_FIELD/ROW_LENGTH,1,1,BL_LEVELS-1) BDYLYR7A.876
*ENDIF BDYLYR7A.877
BDYLYR7A.878
DO K=1,BL_LEVELS BDYLYR7A.879
BDYLYR7A.880
*IF -DEF,SCMA AJC1F405.360
CALL P_TO_UV (RHOKM(P1,K),RHOKM_UV(U1+ROW_LENGTH,K), BDYLYR7A.882
& P_POINTS,U_POINTS,ROW_LENGTH,N_P_ROWS) BDYLYR7A.883
*IF DEF,MPP BDYLYR7A.884
IF (attop) THEN BDYLYR7A.885
*ENDIF BDYLYR7A.886
DO I=U1,U1+ROW_LENGTH-1 BDYLYR7A.887
RHOKM_UV(I,K) = 1.0E30 BDYLYR7A.888
ENDDO BDYLYR7A.889
*IF DEF,MPP BDYLYR7A.890
ENDIF BDYLYR7A.891
BDYLYR7A.892
IF (atbase) THEN BDYLYR7A.893
*ENDIF BDYLYR7A.894
DO I= U1+(N_U_ROWS-1)*ROW_LENGTH, U1+N_U_ROWS*ROW_LENGTH-1 BDYLYR7A.895
RHOKM_UV(I,K) = 1.0E30 BDYLYR7A.896
ENDDO BDYLYR7A.897
*IF DEF,MPP BDYLYR7A.898
ENDIF BDYLYR7A.899
*ENDIF BDYLYR7A.900
BDYLYR7A.901
*ELSE BDYLYR7A.902
DO I = P1, P1-1+P_POINTS AJC1F405.361
RHOKM_UV(i,K) = RHOKM(i,K) AJC1F405.362
ENDDO AJC1F405.363
*ENDIF BDYLYR7A.904
ENDDO ! loop over bl_levels BDYLYR7A.905
BDYLYR7A.906
IF (SU10. OR. SV10)THEN BDYLYR7A.907
*IF -DEF,SCMA AJC1F405.364
BDYLYR7A.909
CALL P_TO_UV (CDR10M(P1),CDR10M_UV(U1+ROW_LENGTH),P_POINTS, BDYLYR7A.910
& U_POINTS,ROW_LENGTH,N_P_ROWS) BDYLYR7A.911
!----------------------------------------------------------------------- BDYLYR7A.912
!! Set first and last rows to "missing data indicator" BDYLYR7A.913
!----------------------------------------------------------------------- BDYLYR7A.914
*IF DEF,MPP BDYLYR7A.915
IF (attop) THEN BDYLYR7A.916
*ENDIF BDYLYR7A.917
DO I=U1,U1+ROW_LENGTH-1 BDYLYR7A.918
CDR10M_UV(I) = 1.0E30 BDYLYR7A.919
ENDDO BDYLYR7A.920
*IF DEF,MPP BDYLYR7A.921
ENDIF BDYLYR7A.922
BDYLYR7A.923
IF (atbase) THEN BDYLYR7A.924
*ENDIF BDYLYR7A.925
DO I= U1+(N_U_ROWS-1)*ROW_LENGTH, U1+N_U_ROWS*ROW_LENGTH-1 BDYLYR7A.926
CDR10M_UV(I) = 1.0E30 BDYLYR7A.927
ENDDO BDYLYR7A.928
*IF DEF,MPP BDYLYR7A.929
ENDIF BDYLYR7A.930
*ENDIF BDYLYR7A.931
BDYLYR7A.932
*ELSE BDYLYR7A.933
DO I = P1, P1-1+P_POINTS AJC1F405.365
CDR10M_UV(I) = CDR10M(I) AJC1F405.366
ENDDO AJC1F405.367
*ENDIF BDYLYR7A.935
ENDIF BDYLYR7A.936
BDYLYR7A.937
!----------------------------------------------------------------------- BDYLYR7A.938
!! 5.5 Calculation of explicit fluxes of T,Q BDYLYR7A.939
!----------------------------------------------------------------------- BDYLYR7A.940
BDYLYR7A.941
CALL EX_FLUX_TQ ( BDYLYR7A.942
& P_POINTS,P_FIELD,P1,BL_LEVELS BDYLYR7A.943
&, TL,QW,RDZ,FTL,FQW,RHOKH BDYLYR7A.944
&, LTIMER BDYLYR7A.945
& ) BDYLYR7A.946
BDYLYR7A.947
!----------------------------------------------------------------------- BDYLYR7A.948
!! 5.6 Calculation of explicit fluxes of U and V. BDYLYR7A.949
!----------------------------------------------------------------------- BDYLYR7A.950
BDYLYR7A.951
CALL EX_FLUX_UV ( ! For U BDYLYR7A.952
& U_POINTS,U_FIELD,ROW_LENGTH,BL_LEVELS,U1 BDYLYR7A.953
&, U,U_0,RDZUV(1,2),RHOKM_UV,TAUX BDYLYR7A.954
&, LTIMER BDYLYR7A.955
& ) BDYLYR7A.956
BDYLYR7A.957
CALL EX_FLUX_UV ( ! For V BDYLYR7A.958
& U_POINTS,U_FIELD,ROW_LENGTH,BL_LEVELS,U1 BDYLYR7A.959
&, V,V_0,RDZUV(1,2),RHOKM_UV,TAUY BDYLYR7A.960
&, LTIMER BDYLYR7A.961
& ) BDYLYR7A.962
BDYLYR7A.963
*IF -DEF,SCMA AJC1F405.368
!----------------------------------------------------------------------- BDYLYR7A.965
!! Set first and last rows to "missing data indicator" BDYLYR7A.966
!----------------------------------------------------------------------- BDYLYR7A.967
DO K=1,BL_LEVELS BDYLYR7A.968
*IF DEF,MPP BDYLYR7A.969
IF (attop) THEN BDYLYR7A.970
*ENDIF BDYLYR7A.971
DO I=U1,U1+ROW_LENGTH-1 BDYLYR7A.972
TAUX(I,K)=1.E30 BDYLYR7A.973
TAUY(I,K)=1.E30 BDYLYR7A.974
ENDDO BDYLYR7A.975
*IF DEF,MPP BDYLYR7A.976
ENDIF BDYLYR7A.977
BDYLYR7A.978
IF (atbase) THEN BDYLYR7A.979
*ENDIF BDYLYR7A.980
DO I= U1 + (N_U_ROWS-1)*ROW_LENGTH, U1 + N_U_ROWS*ROW_LENGTH -1 BDYLYR7A.981
TAUX(I,K)=1.E30 BDYLYR7A.982
TAUY(I,K)=1.E30 BDYLYR7A.983
ENDDO BDYLYR7A.984
*IF DEF,MPP BDYLYR7A.985
ENDIF BDYLYR7A.986
*ENDIF BDYLYR7A.987
ENDDO BDYLYR7A.988
*ENDIF BDYLYR7A.989
BDYLYR7A.990
!----------------------------------------------------------------------- BDYLYR7A.991
!! 6. "Implicit" calculation of increments for TL and QW BDYLYR7A.992
!----------------------------------------------------------------------- BDYLYR7A.993
BDYLYR7A.994
CALL IM_CAL_TQ ( BDYLYR7A.995
& P_FIELD,P1,P_POINTS,BL_LEVELS,LAND_FIELD,LAND_INDEX,NTYPE, BDYLYR7A.996
& TILE_INDEX,TILE_PTS,LAND_MASK,LTIMER, BDYLYR7A.997
& ALPHA1,ALPHA1_SICE,ASHTF,ASHTF_SNOW,DTL_NT,DQW_NT,DTRDZ, BDYLYR7A.998
& ICE_FRACT,RDZ,RESFT,RHOKH(1,2), BDYLYR7A.999
& RHOKH_TILE,RHOKH_SICE,RHOKPM,RHOKPM_SICE,TILE_FRAC, BDYLYR7A.1000
& FQW,FQW_ICE,FQW_TILE,E_SEA, BDYLYR7A.1001
& FTL,FTL_ICE,FTL_TILE,H_SEA,QW,TL BDYLYR7A.1002
& ) BDYLYR7A.1003
BDYLYR7A.1004
!----------------------------------------------------------------------- BDYLYR7A.1005
!! 6.1 Convert FTL to sensible heat flux in Watts per square metre. BDYLYR7A.1006
!----------------------------------------------------------------------- BDYLYR7A.1007
BDYLYR7A.1008
DO K=1,BL_LEVELS BDYLYR7A.1009
Cfpp$ Select(CONCUR) BDYLYR7A.1010
DO I=P1,P1+P_POINTS-1 BDYLYR7A.1011
FTL(I,K) = FTL(I,K)*CP BDYLYR7A.1012
ENDDO BDYLYR7A.1013
ENDDO BDYLYR7A.1014
BDYLYR7A.1015
DO I=P1,P1+P_POINTS-1 BDYLYR7A.1016
FTL_ICE(I) = CP*FTL_ICE(I) BDYLYR7A.1017
ENDDO BDYLYR7A.1018
BDYLYR7A.1019
DO N=1,NTYPE BDYLYR7A.1020
DO J=1,TILE_PTS(N) BDYLYR7A.1021
L = TILE_INDEX(J,N) BDYLYR7A.1022
FTL_TILE(L,N) = CP*FTL_TILE(L,N) BDYLYR7A.1023
ENDDO BDYLYR7A.1024
ENDDO BDYLYR7A.1025
BDYLYR7A.1026
!----------------------------------------------------------------------- BDYLYR7A.1027
!! Sea-ice (P241, routine SICE_HTF). BDYLYR7A.1028
!----------------------------------------------------------------------- BDYLYR7A.1029
DO I=P1,P1+P_POINTS-1 BDYLYR7A.1030
IF ( .NOT.LAND_MASK(I) ) BDYLYR7A.1031
& SURF_HT_FLUX(I) = RADNET(I) - LS*FQW_ICE(I) - FTL_ICE(I) BDYLYR7A.1032
ENDDO BDYLYR7A.1033
BDYLYR7A.1034
CALL SICE_HTF( BDYLYR7A.1035
& ASHTF,DI,ICE_FRACT,SURF_HT_FLUX,TIMESTEP, BDYLYR7A.1036
& LAND_MASK,P_FIELD,P_POINTS,P1,TI,TSTAR,ASURF, BDYLYR7A.1037
& SEA_ICE_HTF,LTIMER BDYLYR7A.1038
&) BDYLYR7A.1039
BDYLYR7A.1040
!----------------------------------------------------------------------- ABX1F405.857
! Optional error check : test for negative top soil layer temperature ABX1F405.858
!----------------------------------------------------------------------- ABX1F405.859
IF (L_NEG_TSTAR) THEN ABX1F405.860
DO L=LAND1,LAND1+LAND_PTS-1 ABX1F405.861
IF (T_SOIL(L,1).LT.0) THEN ABX1F405.862
ERROR = 1 ABX1F405.863
WRITE(6,*) '*** ERROR DETECTED BY ROUTINE BDY_LAYR ***' ABX1F405.864
WRITE(6,*) 'NEGATIVE TEMPERATURE IN TOP SOIL LAYER AT ' ABX1F405.865
WRITE(6,*) 'LAND POINT ',L ABX1F405.866
ENDIF ABX1F405.867
ENDDO ABX1F405.868
ENDIF ABX1F405.869
ABX1F405.870
!----------------------------------------------------------------------- BDYLYR7A.1041
!! Diagnose the land surface temperature (previously in SOIL_HTF) BDYLYR7A.1042
!----------------------------------------------------------------------- BDYLYR7A.1043
BDYLYR7A.1044
DO N=1,NTYPE ABX1F405.871
DO L=LAND1,LAND1+LAND_PTS-1 ABX1F405.872
TSTAR_TILE(L,N) = T_SOIL(L,1) ABX1F405.873
ENDDO ABX1F405.874
ENDDO ABX1F405.875
ABX1F405.876
DO N=1,NTYPE-1 BDYLYR7A.1045
DO J=1,TILE_PTS(N) BDYLYR7A.1046
L = TILE_INDEX(J,N) BDYLYR7A.1047
I = LAND_INDEX(L) BDYLYR7A.1048
TSTAR_TILE(L,N) = TSTAR_TILE(L,N) + ABX1F405.877
& ( RADNET(I) - LC*FQW_TILE(L,N) - FTL_TILE(L,N) ) / ASHTF(I) ABX1F405.878
ENDDO BDYLYR7A.1051
ENDDO BDYLYR7A.1052
BDYLYR7A.1053
N = NTYPE BDYLYR7A.1054
DO J=1,TILE_PTS(N) BDYLYR7A.1055
L = TILE_INDEX(J,N) BDYLYR7A.1056
I = LAND_INDEX(L) BDYLYR7A.1057
TSTAR_TILE(L,N) = TSNOW(L) + ( RADNET_SNOW(I) - LS*FQW_TILE(L,N) BDYLYR7A.1058
& - FTL_TILE(L,N) ) / ASHTF_SNOW(I) BDYLYR7A.1059
ENDDO BDYLYR7A.1060
BDYLYR7A.1061
!----------------------------------------------------------------------- BDYLYR7A.1062
!! 7. Surface evaporation components and updating of surface BDYLYR7A.1063
!! temperature (P245, routine SF_EVAP). BDYLYR7A.1064
!----------------------------------------------------------------------- BDYLYR7A.1065
CALL SF_EVAP ( BDYLYR7A.1066
& P_POINTS,P_FIELD,P1,LAND1,LAND_PTS,LAND_FIELD,NTYPE, BDYLYR7A.1067
& LAND_INDEX,TILE_INDEX,TILE_PTS,SM_LEVELS,LTIMER, BDYLYR7A.1068
& ASHTF,ASHTF_SNOW,CANOPY,DTRDZ(1,1),FRACA,LYING_SNOW,RESFS, BDYLYR7A.1069
& RESFT,RHOKH_TILE,TILE_FRAC,SMC,WT_EXT,TIMESTEP, BDYLYR7A.1070
& FQW(1,1),FQW_TILE,FTL(1,1),FTL_TILE,QW(1,1),TL(1,1),TSTAR_TILE, BDYLYR7A.1071
& ECAN,ECAN_TILE,ESOIL,ESOIL_TILE,EXT BDYLYR7A.1072
& ) BDYLYR7A.1073
BDYLYR7A.1074
!----------------------------------------------------------------------- BDYLYR7A.1075
!! Surface melting of snow. BDYLYR7A.1076
!! Melting of sea-ice. BDYLYR7A.1077
!----------------------------------------------------------------------- BDYLYR7A.1078
N = NTYPE BDYLYR7A.1079
CALL SF_MELT ( BDYLYR7A.1080
& P_POINTS,P_FIELD,P1,LAND_FIELD,LAND_INDEX, BDYLYR7A.1081
& TILE_INDEX(1,N),TILE_PTS(N),LAND_MASK,LTIMER,SIMLT,SMLT, BDYLYR7A.1082
& ALPHA1(1,N),ALPHA1_SICE,ASHTF,ASHTF_SNOW,DTRDZ(1,1),ICE_FRACT, BDYLYR7A.1083
& LYING_SNOW,RHOKH_TILE(1,N),RHOKH_SICE,TILE_FRAC(1,N),TIMESTEP, BDYLYR7A.1084
& FQW(1,1),FQW_ICE,FQW_TILE(1,N),FTL(1,1),FTL_TILE(1,N), BDYLYR7A.1085
& QW(1,1),TL(1,1),TSTAR,TSTAR_TILE(1,N),TI, BDYLYR7A.1086
& EI,SICE_MLT_HTF,SNOMLT_SURF_HTF,SNOWMELT BDYLYR7A.1087
& ) BDYLYR7A.1088
BDYLYR7A.1089
!----------------------------------------------------------------------- BDYLYR7A.1090
!! Specific humidity and temperature at 1.5 metres. BDYLYR7A.1091
!----------------------------------------------------------------------- BDYLYR7A.1092
CALL SCREEN_TQ ( BDYLYR7A.1093
& P_POINTS,P_FIELD,P1,LAND1,LAND_PTS,LAND_FIELD,NTYPE, BDYLYR7A.1094
& LAND_INDEX,TILE_INDEX,TILE_PTS,LAND_MASK, BDYLYR7A.1095
& SQ1P5,ST1P5,CHR1P5M,CHR1P5M_SICE,PSTAR,QW(1,1),RESFT, BDYLYR7A.1096
& TILE_FRAC,TL(1,1),TSTAR,TSTAR_TILE, BDYLYR7A.1097
& Z0H,Z0H_TILE,Z0M,Z0M_TILE,Z1, BDYLYR7A.1098
& Q1P5M,T1P5M BDYLYR7A.1099
& ) BDYLYR7A.1100
BDYLYR7A.1101
!7.1 Copy T and Q from workspace to INOUT space. BDYLYR7A.1102
BDYLYR7A.1103
DO K=1,BL_LEVELS BDYLYR7A.1104
Cfpp$ Select(CONCUR) BDYLYR7A.1105
DO I=P1,P1+P_POINTS-1 BDYLYR7A.1106
T(I,K)=TL(I,K) BDYLYR7A.1107
Q(I,K)=QW(I,K) BDYLYR7A.1108
ENDDO BDYLYR7A.1109
ENDDO BDYLYR7A.1110
BDYLYR7A.1111
!----------------------------------------------------------------------- BDYLYR7A.1112
!! Gridbox-mean surface temperature and net surface heat fluxes BDYLYR7A.1113
!----------------------------------------------------------------------- BDYLYR7A.1114
DO L=1,LAND_FIELD ABX1F405.879
I = LAND_INDEX(L) BDYLYR7A.1116
TSTAR(I) = 0. BDYLYR7A.1120
SNOW_SURF_HTF(L) = 0. BDYLYR7A.1121
SOIL_SURF_HTF(L) = 0. BDYLYR7A.1122
ENDDO BDYLYR7A.1126
BDYLYR7A.1127
DO N=1,NTYPE-1 BDYLYR7A.1128
DO J=1,TILE_PTS(N) BDYLYR7A.1129
L = TILE_INDEX(J,N) BDYLYR7A.1130
I = LAND_INDEX(L) BDYLYR7A.1131
SOIL_SURF_HTF(L) = SOIL_SURF_HTF(L) + TILE_FRAC(L,N) * BDYLYR7A.1132
& (RADNET(I) - LC*FQW_TILE(L,N) - FTL_TILE(L,N)) BDYLYR7A.1133
TSTAR(I) = TSTAR(I) + TILE_FRAC(L,N)*TSTAR_TILE(L,N) BDYLYR7A.1134
ENDDO BDYLYR7A.1135
ENDDO BDYLYR7A.1136
BDYLYR7A.1137
N = NTYPE BDYLYR7A.1138
DO J=1,TILE_PTS(N) BDYLYR7A.1139
L = TILE_INDEX(J,N) BDYLYR7A.1140
I = LAND_INDEX(L) BDYLYR7A.1141
SNOW_SURF_HTF(L) = TILE_FRAC(L,N) * ARE1F405.36
& (RADNET_SNOW(I) - LS*FQW_TILE(L,N) - FTL_TILE(L,N)) ARE1F405.37
& - LF*SNOWMELT(I) ARE1F405.38
TSTAR(I) = TSTAR(I) + TILE_FRAC(L,N)*TSTAR_TILE(L,N) BDYLYR7A.1144
ENDDO BDYLYR7A.1145
BDYLYR7A.1146
BDYLYR7A.1147
DO L=LAND1,LAND1+LAND_PTS-1 BDYLYR7A.1148
I = LAND_INDEX(L) BDYLYR7A.1149
SURF_HT_FLUX(I) = SOIL_SURF_HTF(L) + SNOW_SURF_HTF(L) ARE1F405.39
ENDDO BDYLYR7A.1152
BDYLYR7A.1153
DO I=P1,P1+P_POINTS-1 BDYLYR7A.1154
IF ( .NOT.LAND_MASK(I) ) BDYLYR7A.1155
& SURF_HT_FLUX(I) = RADNET(I) - LS*FQW_ICE(I) - FTL_ICE(I) BDYLYR7A.1156
ENDDO BDYLYR7A.1157
BDYLYR7A.1158
!----------------------------------------------------------------------- ABX1F405.880
! Optional error check : test for negative surface temperature ABX1F405.881
!----------------------------------------------------------------------- ABX1F405.882
IF (L_NEG_TSTAR) THEN ABX1F405.883
DO L=LAND1,LAND1+LAND_PTS-1 ABX1F405.884
I = LAND_INDEX(L) ABX1F405.885
IF (TSTAR(I).LT.0) THEN ABX1F405.886
ERROR = 1 ABX1F405.887
WRITE(6,*) '*** ERROR DETECTED BY ROUTINE BDY_LAYR ***' ABX1F405.888
WRITE(6,*) 'NEGATIVE SURFACE TEMPERATURE AT LAND POINT ',L ABX1F405.889
ENDIF ABX1F405.890
ENDDO ABX1F405.891
ENDIF ABX1F405.892
ABX1F405.893
!----------------------------------------------------------------------- BDYLYR7A.1159
!! 8 "Implicit" calculation of increments for U and V. BDYLYR7A.1160
!----------------------------------------------------------------------- BDYLYR7A.1161
BDYLYR7A.1162
CALL IM_CAL_UV ( ! For U BDYLYR7A.1163
& U_FIELD,U1 BDYLYR7A.1164
&,U_POINTS,BL_LEVELS,ROW_LENGTH BDYLYR7A.1165
&,GAMMA BDYLYR7A.1166
&,RHOKM_UV(1,2) BDYLYR7A.1167
&,U,U_0,TIMESTEP BDYLYR7A.1168
&,RHOKM_UV(1,1),DU_NT,DU BDYLYR7A.1169
&,DTRDZ_UV,RDZUV(1,2),TAUX BDYLYR7A.1170
&,LTIMER BDYLYR7A.1171
&) BDYLYR7A.1172
BDYLYR7A.1173
CALL IM_CAL_UV ( ! For V BDYLYR7A.1174
& U_FIELD,U1 BDYLYR7A.1175
&,U_POINTS,BL_LEVELS,ROW_LENGTH BDYLYR7A.1176
&,GAMMA BDYLYR7A.1177
&,RHOKM_UV(1,2) BDYLYR7A.1178
&,V,V_0,TIMESTEP BDYLYR7A.1179
&,RHOKM_UV(1,1),DV_NT,DV BDYLYR7A.1180
&,DTRDZ_UV,RDZUV(1,2),TAUY BDYLYR7A.1181
&,LTIMER BDYLYR7A.1182
& ) BDYLYR7A.1183
BDYLYR7A.1184
!---------------------------------------------------------------------- BDYLYR7A.1185
!! 8.1 Update U_V. BDYLYR7A.1186
!---------------------------------------------------------------------- BDYLYR7A.1187
BDYLYR7A.1188
DO K=1,BL_LEVELS BDYLYR7A.1189
*IF -DEF,SCMA AJC1F405.369
DO I=U1+ROW_LENGTH,U1+U_POINTS-ROW_LENGTH-1 BDYLYR7A.1191
*ELSE BDYLYR7A.1192
DO I=1,U_POINTS BDYLYR7A.1193
*ENDIF BDYLYR7A.1194
U(I,K) = U(I,K) + DU(I,K) BDYLYR7A.1195
V(I,K) = V(I,K) + DV(I,K) BDYLYR7A.1196
ENDDO BDYLYR7A.1197
ENDDO BDYLYR7A.1198
BDYLYR7A.1199
! U component of 10m wind BDYLYR7A.1200
IF (SU10)THEN BDYLYR7A.1201
*IF -DEF,SCMA AJC1F405.370
DO I=U1+ROW_LENGTH,U1+U_POINTS-ROW_LENGTH-1 BDYLYR7A.1203
*ELSE BDYLYR7A.1204
DO I=1,U_POINTS BDYLYR7A.1205
*ENDIF BDYLYR7A.1206
U10M(I) = (U(I,1) -U_0(I))*CDR10M_UV(I) + U_0(I) BDYLYR7A.1207
ENDDO BDYLYR7A.1208
ENDIF BDYLYR7A.1209
BDYLYR7A.1210
! V component of 10m wind BDYLYR7A.1211
IF (SV10)THEN BDYLYR7A.1212
*IF -DEF,SCMA AJC1F405.371
DO I=U1+ROW_LENGTH,U1+U_POINTS-ROW_LENGTH-1 BDYLYR7A.1214
*ELSE BDYLYR7A.1215
DO I=1,U_POINTS BDYLYR7A.1216
*ENDIF BDYLYR7A.1217
V10M(I) = (V(I,1) -V_0(I))*CDR10M_UV(I) + V_0(I) BDYLYR7A.1218
ENDDO BDYLYR7A.1219
ENDIF BDYLYR7A.1220
BDYLYR7A.1221
!----------------------------------------------------------------------- BDYLYR7A.1222
!! 9. Calculate surface latent heat flux. BDYLYR7A.1223
!----------------------------------------------------------------------- BDYLYR7A.1224
BDYLYR7A.1225
IF (SLH) THEN BDYLYR7A.1226
DO I=P1,P1+P_POINTS-1 BDYLYR7A.1227
LATENT_HEAT(I) = LC*FQW(I,1) + LF*EI(I) BDYLYR7A.1228
ENDDO BDYLYR7A.1229
ENDIF BDYLYR7A.1230
BDYLYR7A.1231
999 CONTINUE ! Branch for error exit. BDYLYR7A.1232
BDYLYR7A.1233
IF (LTIMER) THEN BDYLYR7A.1234
CALL TIMER('BDYLAYR ',4) BDYLYR7A.1235
ENDIF BDYLYR7A.1236
BDYLYR7A.1237
RETURN BDYLYR7A.1238
END BDYLYR7A.1239
*ENDIF BDYLYR7A.1240