SUBROUTINE BDY_LAYR ( 4,80BDYLYR6A.55
BDYLYR6A.56
! IN values defining field dimensions and subset to be processed : BDYLYR6A.57
& P_FIELD,U_FIELD,N_TYPES,LAND_FIELD, BDYLYR6A.58
& P_ROWS,FIRST_ROW,N_ROWS,ROW_LENGTH, BDYLYR6A.59
BDYLYR6A.60
! IN values defining vertical grid of model atmosphere : BDYLYR6A.61
& BL_LEVELS,P_LEVELS,AK,BK,AKH,BKH,DELTA_AK,DELTA_BK, BDYLYR6A.62
& EXNER, BDYLYR6A.63
BDYLYR6A.64
! IN soil/vegetation/land surface data : BDYLYR6A.65
& LAND_MASK,GATHER,LAND_INDEX, BDYLYR6A.69
& ST_LEVELS,SM_LEVELS,TILE_FRAC,HT_TILE,CANOPY, BDYLYR6A.71
& CATCH,CATCH_TILE,HCON, BDYLYR6A.72
& LYING_SNOW,RESIST,RESIST_TILE,ROOTD,ROOTD_TILE, BDYLYR6A.73
& SMVCCL,SMVCST,SMVCWT,STHF,STHU, BDYLYR6A.74
& VFRAC_TILE,Z0V,Z0V_TILE,SIL_OROG_LAND,L_Z0_OROG,HO2R2_OROG, BDYLYR6A.75
& LAI_TILE, BDYLYR6A.76
BDYLYR6A.77
! IN sea/sea-ice data : BDYLYR6A.78
& DI,ICE_FRACT,U_0,V_0, BDYLYR6A.79
BDYLYR6A.80
! IN cloud data : BDYLYR6A.81
& CF,QCF,QCL,CCA,CCB,CCT, BDYLYR6A.82
BDYLYR6A.83
! IN everything not covered so far : BDYLYR6A.84
& CO2_MMR,PHOTOSYNTH_ACT_RAD,PSTAR,RADNET,RAD_HR,RADHR_DIM1, BDYLYR6A.85
& TIMESTEP,L_RMBL,L_BL_LSPICE,L_MOM, BDYLYR6A.86
BDYLYR6A.87
! INOUT data : BDYLYR6A.88
& Q,GC,T,T_SOIL,TI,TSTAR,TSTAR_TILE,U,V,Z0MSEA, BDYLYR6A.89
BDYLYR6A.90
! OUT Diagnostic not requiring STASH flags : BDYLYR6A.91
& CD,CH,E_SEA,EPOT,ETRAN,FQW,FQW_TILE,FSMC,FTL,FTL_TILE, ANG1F405.73
& H_SEA,RHOKH,RHOKM_UV, ANG1F405.74
& RIB_GB,RIB,SEA_ICE_HTF,SURF_HT_FLUX_GB,TAUX,TAUY,VSHR,ZHT, ARN0F405.181
& BL_TYPE_1,BL_TYPE_2,BL_TYPE_3,BL_TYPE_4,BL_TYPE_5,BL_TYPE_6, ARN0F405.182
BDYLYR6A.94
! OUT diagnostic requiring STASH flags : BDYLYR6A.95
& FME,SICE_MLT_HTF,SNOMLT_SURF_HTF,LATENT_HEAT, BDYLYR6A.96
& Q1P5M,T1P5M,U10M,V10M, BDYLYR6A.97
BDYLYR6A.98
! (IN) STASH flags :- BDYLYR6A.99
& SFME,SIMLT,SMLT,SLH,SQ1P5,ST1P5,SU10,SV10, BDYLYR6A.100
BDYLYR6A.101
! OUT data required for tracer mixing : BDYLYR6A.102
& RHO_ARESIST,ARESIST,RESIST_B, BDYLYR6A.103
& NRML, BDYLYR6A.104
BDYLYR6A.105
! OUT data required for 4D-VAR : BDYLYR6A.106
& RHO_CD_MODV1,RHO_KM, BDYLYR6A.107
BDYLYR6A.108
! OUT data required elsewhere in UM system : BDYLYR6A.109
& ECAN,EI,ES_GB,EXT,SNOWMELT,ZH, BDYLYR6A.110
& GPP,NPP,RESP_P, BDYLYR6A.111
& T1_SD,Q1_SD,ERROR, BDYLYR6A.112
BDYLYR6A.113
! LOGICAL LTIMER BDYLYR6A.114
& LTIMER BDYLYR6A.115
& ) BDYLYR6A.116
BDYLYR6A.117
IMPLICIT NONE BDYLYR6A.118
BDYLYR6A.119
! Inputs :- BDYLYR6A.120
BDYLYR6A.121
! (a) Defining horizontal grid and subset thereof to be processed. BDYLYR6A.122
BDYLYR6A.123
INTEGER BDYLYR6A.124
& P_FIELD ! IN No. of P-points in whole grid BDYLYR6A.125
! (for dimensioning only). BDYLYR6A.126
&,RADHR_DIM1 ! IN Dimension of Radiative heating BDYLYR6A.127
! ! rate (P_FIELD but used for BDYLYR6A.128
! ! dynamic allocation) BDYLYR6A.129
&,U_FIELD ! IN No. of UV-points in whole grid. BDYLYR6A.133
! (Checked for consistency with BDYLYR6A.135
! P_FIELD and P_ROWS; there must BDYLYR6A.136
! be 1 less UV than P row.) BDYLYR6A.137
&,N_TYPES ! IN number of land tiles BDYLYR6A.141
&,LAND_FIELD ! IN No.of land points in whole grid. BDYLYR6A.142
! (Checked for consistency with BDYLYR6A.144
! P_FIELD ) BDYLYR6A.145
&,P_ROWS ! IN No. of P-rows in whole grid BDYLYR6A.150
! (for dimensioning only). BDYLYR6A.151
&,FIRST_ROW ! IN First row of data to be treated, BDYLYR6A.155
! referred to P-grid (must be > 1 BDYLYR6A.157
! since "polar" rows are never BDYLYR6A.158
! treated). BDYLYR6A.159
&,N_ROWS ! IN No. of rows of data to be BDYLYR6A.163
! treated, referred to P-grid. BDYLYR6A.164
! FIRST_ROW+N_ROWS-1 must be less BDYLYR6A.166
! than P_ROWS, since "polar" rows BDYLYR6A.167
! are never treated. BDYLYR6A.168
&,ROW_LENGTH ! IN No. of points in one row. BDYLYR6A.172
! (Checked for consistency with BDYLYR6A.174
! P_FIELD and N_ROWS.) BDYLYR6A.175
BDYLYR6A.179
! (b) Defining vertical grid of model atmosphere. BDYLYR6A.180
BDYLYR6A.181
INTEGER BDYLYR6A.182
& BL_LEVELS ! IN Max. no. of "boundary" levels BDYLYR6A.183
! allowed.Assumed <= 30 for dim- BDYLYR6A.184
! sioning of GAMMA in common deck BDYLYR6A.185
! C_GAMMA used in SF_EXCH and KMKH BDYLYR6A.186
&,P_LEVELS ! IN Total no. of vertical levels in BDYLYR6A.187
! the model atmosphere. BDYLYR6A.188
REAL BDYLYR6A.189
& AK(P_LEVELS) ! IN Hybrid 'A' for all levels. BDYLYR6A.190
&,BK(P_LEVELS) ! IN Hybrid 'B' for all levels. BDYLYR6A.191
&,AKH(P_LEVELS+1) ! IN Hybrid 'A' for layer interfaces. BDYLYR6A.192
&,BKH(P_LEVELS+1) ! IN Hybrid 'B' for layer interfaces. BDYLYR6A.193
&,DELTA_AK(P_LEVELS) ! IN Difference of hybrid 'A' across BDYLYR6A.194
! layers (K-1/2 to K+1/2). BDYLYR6A.195
! NB: Upper minus lower. BDYLYR6A.196
&,DELTA_BK(P_LEVELS) ! IN Difference of hybrid 'B' across BDYLYR6A.197
! layers (K-1/2 to K+1/2). BDYLYR6A.198
! NB: Upper minus lower. BDYLYR6A.199
&,EXNER(P_FIELD,BL_LEVELS+1) ! IN Exner function. EXNER(,K) is BDYLYR6A.200
! value for LOWER BOUNDARY of BDYLYR6A.201
! level K. BDYLYR6A.202
BDYLYR6A.203
! (c) Soil/vegetation/land surface parameters (mostly constant). BDYLYR6A.204
BDYLYR6A.205
LOGICAL BDYLYR6A.206
& LAND_MASK(P_FIELD) ! IN T if land, F elsewhere. BDYLYR6A.207
&,L_Z0_OROG ! IN T to use orog.roughness BDYLYR6A.208
! treatment in SF_EXCH BDYLYR6A.209
&,L_RMBL ! IN T to use rapidly mixing boundary BDYLYR6A.210
! scheme in IMPL_CAL BDYLYR6A.211
&,L_BL_LSPICE ! IN True if 3A large-scale ppn BDYLYR6A.212
! scheme is used. BDYLYR6A.213
&,L_MOM ! IN Switch for convective momentum BDYLYR6A.214
! ! transport. BDYLYR6A.215
&,GATHER ! IN T if gather to sea-ice points BDYLYR6A.217
! in SF_EXCH. Saves a lot of un- BDYLYR6A.218
! necessary calculations if there BDYLYR6A.219
! are relatively few sea-ice points BDYLYR6A.220
BDYLYR6A.221
INTEGER BDYLYR6A.222
& LAND_INDEX(P_FIELD) ! IN LAND_INDEX(I)=J => the Jth BDYLYR6A.223
! point in P_FIELD is the Ith BDYLYR6A.224
! land point. BDYLYR6A.225
BDYLYR6A.227
INTEGER BDYLYR6A.228
& ST_LEVELS ! IN No. of deep soil temp. levels BDYLYR6A.229
&,SM_LEVELS ! IN No. of soil moisture levels BDYLYR6A.230
BDYLYR6A.231
REAL BDYLYR6A.232
& CANOPY(LAND_FIELD) ! IN Surface/canopy water (kg/m2) BDYLYR6A.233
&,CATCH(LAND_FIELD) ! IN Surface/canopy water capacity BDYLYR6A.234
! (kg/m2). BDYLYR6A.235
&,CATCH_TILE(LAND_FIELD,N_TYPES) BDYLYR6A.236
! IN Surface/canopy water capacity BDYLYR6A.237
! (kg per sq m). BDYLYR6A.238
&,HCON(LAND_FIELD) ! IN Soil thermal conductivity BDYLYR6A.239
! (W/m/K). BDYLYR6A.240
&,HT_TILE(LAND_FIELD,N_TYPES) ! IN Canopy height (m) BDYLYR6A.241
&,LAI_TILE(LAND_FIELD,N_TYPES)! IN Leaf area index. BDYLYR6A.242
&,LYING_SNOW(P_FIELD) ! IN Lying snow (kg/sq m). BDYLYR6A.243
! Must be global for coupled model, BDYLYR6A.245
! ie dimension P_FIELD not BDYLYR6A.246
! LAND_FIELD BDYLYR6A.247
&,RESIST(LAND_FIELD) ! IN "Stomatal" resistance to BDYLYR6A.249
! evaporation (seconds per metre). BDYLYR6A.250
&,RESIST_TILE(LAND_FIELD,N_TYPES) BDYLYR6A.251
! IN "Stomatal" resistance to BDYLYR6A.252
! evaporation (seconds per metre). BDYLYR6A.253
&,ROOTD(LAND_FIELD) ! IN Depth of active soil layer BDYLYR6A.254
! ("root depth") (metres). BDYLYR6A.255
&,ROOTD_TILE(LAND_FIELD,N_TYPES) BDYLYR6A.256
! IN Depth of active soil layer BDYLYR6A.257
! ("root depth") (metres). BDYLYR6A.258
&,SMVCCL(LAND_FIELD) ! IN Critical volumetric SMC (m3/m3 BDYLYR6A.259
! of soil). BDYLYR6A.260
&,SMVCST(LAND_FIELD) ! IN Volumetric saturation point BDYLYR6A.261
! (m3/m3 of soil). BDYLYR6A.262
&,SMVCWT(LAND_FIELD) ! IN Volumetric wilting point (m3/m3 BDYLYR6A.263
! of soil). BDYLYR6A.264
&,STHF(LAND_FIELD,SM_LEVELS) ! IN Frozen soil moisture content of BDYLYR6A.265
! each layer as a fraction of BDYLYR6A.266
! saturation. BDYLYR6A.267
&,STHU(LAND_FIELD,SM_LEVELS) ! IN Unfrozen soil moisture content BDYLYR6A.268
! of each layer as a fraction of BDYLYR6A.269
! saturation. BDYLYR6A.270
&,TILE_FRAC(P_FIELD,N_TYPES) ! IN fractional coverage for each BDYLYR6A.271
! surface tile BDYLYR6A.272
&,VFRAC_TILE(LAND_FIELD,N_TYPES) BDYLYR6A.273
! ! IN Vegetation fraction. BDYLYR6A.274
&,Z0V(P_FIELD) ! IN Vegetative roughness length (m). BDYLYR6A.275
! NB:UM uses same storage for Z0MSEA BDYLYR6A.276
! so for sea points this is INOUT. BDYLYR6A.277
&,Z0V_TILE(P_FIELD,N_TYPES) ! IN Vegetative roughness length (m) BDYLYR6A.278
! for surface tile BDYLYR6A.279
&,SIL_OROG_LAND(LAND_FIELD) ! IN Silhouette area of unresolved BDYLYR6A.280
! orography per unit horizontal area BDYLYR6A.281
! on land points only. BDYLYR6A.282
&,HO2R2_OROG(LAND_FIELD) ! IN Standard Deviation of orography. BDYLYR6A.283
! equivilent to peak to trough BDYLYR6A.284
! height of unresolved orography BDYLYR6A.285
! devided by 2SQRT(2) on land BDYLYR6A.286
! points only (m) BDYLYR6A.287
BDYLYR6A.288
! (d) Sea/sea-ice data. BDYLYR6A.289
BDYLYR6A.290
REAL BDYLYR6A.291
& DI(P_FIELD) ! IN "Equivalent thickness" of BDYLYR6A.292
! sea-ice(m). BDYLYR6A.293
&,ICE_FRACT(P_FIELD) ! IN Fraction of gridbox covered by BDYLYR6A.294
! sea-ice (decimal fraction). BDYLYR6A.295
&,U_0(U_FIELD) ! IN W'ly component of surface BDYLYR6A.296
! current (m/s). BDYLYR6A.297
&,V_0(U_FIELD) ! IN S'ly component of surface BDYLYR6A.298
! current (m/s). BDYLYR6A.299
BDYLYR6A.300
! (e) Cloud data. BDYLYR6A.301
BDYLYR6A.302
REAL BDYLYR6A.303
& CF(P_FIELD,BL_LEVELS) ! IN Cloud fraction (decimal). BDYLYR6A.304
&,QCF(P_FIELD,BL_LEVELS) ! IN Cloud ice (kg per kg air) BDYLYR6A.305
&,QCL(P_FIELD,BL_LEVELS) ! IN Cloud liquid water (kg BDYLYR6A.306
! per kg air). BDYLYR6A.307
&,CCA(P_FIELD) ! IN Convective Cloud Amount BDYLYR6A.308
! (decimal) BDYLYR6A.309
BDYLYR6A.310
INTEGER BDYLYR6A.311
& CCB(P_FIELD) ! IN Convective Cloud Base BDYLYR6A.312
&,CCT(P_FIELD) ! IN Convective Cloud Top BDYLYR6A.313
BDYLYR6A.314
! (f) Atmospheric + any other data not covered so far, incl control. BDYLYR6A.315
BDYLYR6A.316
REAL BDYLYR6A.317
& CO2_MMR ! IN CO2 Mass Mixing Ratio BDYLYR6A.318
&,PHOTOSYNTH_ACT_RAD(P_FIELD) ! IN Net downward shortwave radiation BDYLYR6A.319
! in band 1 (w/m2). BDYLYR6A.320
&,PSTAR(P_FIELD) ! IN Surface pressure (Pascals). BDYLYR6A.321
&,RAD_HR(RADHR_DIM1,BL_LEVELS)! IN Radiative heating rate (K/s). BDYLYR6A.322
&,RADNET(P_FIELD) ! IN Surface net radiation (W/sq m, BDYLYR6A.323
! positive downwards). BDYLYR6A.324
&,TIMESTEP ! IN Timestep (seconds). BDYLYR6A.325
BDYLYR6A.326
LOGICAL LTIMER ! Logical switch for TIMER diags BDYLYR6A.327
BDYLYR6A.328
! STASH flags :- BDYLYR6A.329
BDYLYR6A.330
LOGICAL BDYLYR6A.331
& SFME ! IN Flag for FME (q.v.). BDYLYR6A.332
&,SIMLT ! IN Flag for SICE_MLT_HTF (q.v.) BDYLYR6A.333
&,SMLT ! IN Flag for SNOMLT_SURF_HTF (q.v.) BDYLYR6A.334
&,SLH ! IN Flag for LATENT_HEAT (q.v.) BDYLYR6A.335
&,SQ1P5 ! IN Flag for Q1P5M (q.v.) BDYLYR6A.336
&,ST1P5 ! IN Flag for T1P5M (q.v.) BDYLYR6A.337
&,SU10 ! IN Flag for U10M (q.v.) BDYLYR6A.338
&,SV10 ! IN Flag for V10M (q.v.) BDYLYR6A.339
BDYLYR6A.340
! In/outs :- BDYLYR6A.341
BDYLYR6A.342
REAL BDYLYR6A.343
& GC(LAND_FIELD,N_TYPES) ! INOUT "Stomatal" conductance to BDYLYR6A.344
! evaporation (m/s). BDYLYR6A.345
&,Q(P_FIELD,BL_LEVELS) ! INOUT Input:specific humidity BDYLYR6A.346
! ( kg/kg air). BDYLYR6A.347
! Output:total water content BDYLYR6A.348
! (Q)(kg/Kg air). BDYLYR6A.349
&,T(P_FIELD,BL_LEVELS) ! INOUT Input:atmospheric temp(K) BDYLYR6A.350
! Output:liquid/frozen water BDYLYR6A.351
! temperature (TL) (K) BDYLYR6A.352
&,T_SOIL(LAND_FIELD,SM_LEVELS)! INOUT Soil temperatures (K). BDYLYR6A.353
&,TI(P_FIELD) ! INOUT Sea-ice surface layer BDYLYR6A.354
! temperature (K). BDYLYR6A.355
&,TSTAR(P_FIELD) ! INOUT Surface temperature (K). BDYLYR6A.356
&,TSTAR_TILE(P_FIELD,N_TYPES) ! INOUT Surface tile temperature BDYLYR6A.357
&,U(U_FIELD,BL_LEVELS) ! INOUT W'ly wind component (m/s) BDYLYR6A.358
&,V(U_FIELD,BL_LEVELS) ! INOUT S'ly wind component (m/s) BDYLYR6A.359
&,Z0MSEA(P_FIELD) ! INOUT Sea-surface roughness BDYLYR6A.360
! length for momentum (m). BDYLYR6A.361
! NB: same storage is used BDYLYR6A.362
! for Z0V, so the intent is BDYLYR6A.363
! IN for land points. BDYLYR6A.364
BDYLYR6A.365
! Outputs :- BDYLYR6A.366
!-1 Diagnostic (or effectively so - includes coupled model requisites):- BDYLYR6A.367
BDYLYR6A.368
! (a) Calculated anyway (use STASH space from higher level) :- BDYLYR6A.369
! BDYLYR6A.370
REAL BDYLYR6A.371
& CD(P_FIELD) ! OUT Turbulent surface exchange BDYLYR6A.372
! (bulk transfer) coefficient for BDYLYR6A.373
! momentum. BDYLYR6A.374
&,CH(P_FIELD) ! OUT Turbulent surface exchange BDYLYR6A.375
! (bulk transfer) coefficient for BDYLYR6A.376
! heat and/or moisture. BDYLYR6A.377
&,E_SEA(P_FIELD) ! OUT Evaporation from sea times BDYLYR6A.378
! leads fraction. Zero over land. BDYLYR6A.379
! (kg per square metre per sec). BDYLYR6A.380
&,EPOT_TILE(P_FIELD,N_TYPES) ! WORK potential evaporation ANG1F405.75
! over tile (kg/m2/s). ANG1F405.76
&,EPOT(P_FIELD) ! OUT potential evaporation (kg/m2/s) ANG1F405.77
&,FQW(P_FIELD,BL_LEVELS) ! OUT Moisture flux between layers BDYLYR6A.381
! (kg per square metre per sec). BDYLYR6A.382
! FQW(,1) is total water flux BDYLYR6A.383
! from surface, 'E'. BDYLYR6A.384
&,FQW_TILE(P_FIELD,N_TYPES) ! OUT surface tile moisture flux BDYLYR6A.385
&,FSMC(LAND_FIELD) ! OUT soil moisture availability. ANG1F405.78
&,FSMC_TILE(LAND_FIELD,N_TYPES) ANG1F405.79
! WORK soil moisture availability ANG1F405.80
! over tile. ANG1F405.81
&,FTL(P_FIELD,BL_LEVELS) ! OUT FTL(,K) contains net turbulent BDYLYR6A.386
! sensible heat flux into layer K BDYLYR6A.387
! from below; so FTL(,1) is the BDYLYR6A.388
! surface sensible heat, H. (W/m2) BDYLYR6A.389
&,FTL_TILE(P_FIELD,N_TYPES) ! OUT surface tile heat flux BDYLYR6A.390
&,H_SEA(P_FIELD) ! OUT Surface sensible heat flux over BDYLYR6A.391
! sea times leads fraction. (W/m2) BDYLYR6A.392
&,RHOKH(P_FIELD,BL_LEVELS) ! OUT Exchange coeffs for moisture. BDYLYR6A.393
&,RHOKM_UV(U_FIELD,BL_LEVELS) ! OUT Exchange coefficients for BDYLYR6A.394
! momentum (on UV-grid, with 1st BDYLYR6A.395
! and last rows undefined (or, at BDYLYR6A.396
! present, set to "missing data")) BDYLYR6A.397
&,RIB(P_FIELD,N_TYPES) ! OUT Tile bulk Richardson number for BDYLYR6A.398
! lowest layer. BDYLYR6A.399
&,RIB_GB(P_FIELD) ! OUT Mean bulk Richardson number for BDYLYR6A.400
! lowest layer. BDYLYR6A.401
&,SEA_ICE_HTF(P_FIELD) ! OUT Heat flux through sea-ice BDYLYR6A.402
! (W/m2, positive downwards). BDYLYR6A.403
&,SURF_HT_FLUX_GB(P_FIELD) ! OUT Net downward heat flux at BDYLYR6A.404
! surface over land or sea-ice BDYLYR6A.405
! fraction of gridbox (W/m2). BDYLYR6A.406
&,TAUX(U_FIELD,BL_LEVELS) ! OUT W'ly component of surface wind BDYLYR6A.407
! stress (N/sq m).(On UV-grid with BDYLYR6A.408
! first and last rows undefined or BDYLYR6A.409
! at present, set to missing data BDYLYR6A.410
&,TAUY(U_FIELD,BL_LEVELS) ! OUT S'ly component of surface wind BDYLYR6A.411
! stress (N/sq m). On UV-grid; BDYLYR6A.412
! comments as per TAUX. BDYLYR6A.413
&,VSHR(P_FIELD) ! OUT Magnitude of surface-to-lowest BDYLYR6A.414
! atm level wind shear (m per s). BDYLYR6A.415
&,ZHT(P_FIELD) ! OUT Height below which there may be ARN0F405.183
! ! turbulent mixing (m). ARN0F405.184
&,BL_TYPE_1(P_FIELD) ! OUT Indicator set to 1.0 if stable ARN0F405.185
! ! b.l. diagnosed, 0.0 otherwise. ARN0F405.186
&,BL_TYPE_2(P_FIELD) ! OUT Indicator set to 1.0 if Sc over ARN0F405.187
! ! stable surface layer diagnosed, ARN0F405.188
! ! 0.0 otherwise. ARN0F405.189
&,BL_TYPE_3(P_FIELD) ! OUT Indicator set to 1.0 if well ARN0F405.190
! ! mixed b.l. diagnosed, ARN0F405.191
! ! 0.0 otherwise. ARN0F405.192
&,BL_TYPE_4(P_FIELD) ! OUT Indicator set to 1.0 if ARN0F405.193
! ! decoupled Sc layer (not over ARN0F405.194
! ! cumulus) diagnosed, ARN0F405.195
! ! 0.0 otherwise. ARN0F405.196
&,BL_TYPE_5(P_FIELD) ! OUT Indicator set to 1.0 if ARN0F405.197
! ! decoupled Sc layer over cumulus ARN0F405.198
! ! diagnosed, 0.0 otherwise. ARN0F405.199
&,BL_TYPE_6(P_FIELD) ! OUT Indicator set to 1.0 if a ARN0F405.200
! ! cumulus capped b.l. diagnosed, ARN0F405.201
! ! 0.0 otherwise. ARN0F405.202
&,RHO_CD_MODV1(P_FIELD) ! OUT Surface air density * drag coef BDYLYR6A.416
! *mod(v1 - v0) before interpolation BDYLYR6A.417
&,RHO_KM(P_FIELD,2:BL_LEVELS) ! OUT Air density * turbulent mixing BDYLYR6A.418
! coefficient for momentum before BDYLYR6A.419
! interpolation. BDYLYR6A.420
&,RHO_ARESIST(P_FIELD) ! OUT RHOSTAR*CD_STD*VSHR for SULPHUR BDYLYR6A.421
! cycle BDYLYR6A.422
&,ARESIST(P_FIELD) ! OUT 1/(CD_STD*VSHR) for Sulphur BDYLYR6A.423
! cycle BDYLYR6A.424
&,RESIST_B(P_FIELD) ! OUT (1/CH-1/(CD_STD)/VSHR for BDYLYR6A.425
! Sulphur cycle BDYLYR6A.426
BDYLYR6A.427
INTEGER BDYLYR6A.428
& NRML(P_FIELD) ! OUT Number of model layers in the BDYLYR6A.429
! Rapidly Mixing Layer; diagnosed BDYLYR6A.430
! in SF_EXCH and KMKH and used in BDYLYR6A.431
! IMPL_CAL, SF_EVAP and TR_MIX. BDYLYR6A.432
BDYLYR6A.433
! (b) Not passed between lower-level routines (not in workspace at this BDYLYR6A.434
! level) :- BDYLYR6A.435
BDYLYR6A.436
REAL BDYLYR6A.437
& FME(P_FIELD) ! OUT Wind mixing "power" (W per sq m). BDYLYR6A.438
&,SICE_MLT_HTF(P_FIELD) ! OUT Heat flux due to melting of sea- BDYLYR6A.439
! ice (Watts per sq metre). BDYLYR6A.440
&,SNOMLT_SURF_HTF(P_FIELD) ! OUT Heat flux required for surface BDYLYR6A.441
! melting of snow (W/m2). BDYLYR6A.442
&,LATENT_HEAT(P_FIELD) ! OUT Surface latent heat flux, +ve BDYLYR6A.443
! upwards (Watts per sq m). BDYLYR6A.444
&,Q1P5M(P_FIELD) ! OUT Q at 1.5 m (kg water per kg air). BDYLYR6A.445
&,T1P5M(P_FIELD) ! OUT T at 1.5 m (K). BDYLYR6A.446
&,U10M(U_FIELD) ! OUT U at 10 m (m per s). BDYLYR6A.447
&,V10M(U_FIELD) ! OUT V at 10 m (m per s). BDYLYR6A.448
BDYLYR6A.449
!-2 Genuinely output, needed by other atmospheric routines :- BDYLYR6A.450
BDYLYR6A.451
REAL BDYLYR6A.452
& EI(P_FIELD) ! OUT Sublimation from lying snow or BDYLYR6A.453
! sea-ice (kg/m2/s). BDYLYR6A.454
&,ECAN(P_FIELD) ! OUT Gridbox mean evaporation from BDYLYR6A.455
! canopy/surface store (kg/m2/s). BDYLYR6A.456
! Zero over sea. BDYLYR6A.457
&,ES_GB(P_FIELD) ! OUT Surface evapotranspiration BDYLYR6A.458
! through a resistance which is not BDYLYR6A.459
! entirely aerodynamic i.e. "soil BDYLYR6A.460
! evaporation". Always non-negative. BDYLYR6A.461
! (kg/m2/s). BDYLYR6A.462
&,ETRAN(P_FIELD,N_TYPES) ! OUT Transpiration (kg/m2/s). BDYLYR6A.463
&,EXT(LAND_FIELD,SM_LEVELS) ! OUT Extraction of water from each BDYLYR6A.464
! soil layer (kg/m2/s). BDYLYR6A.465
&,GPP(LAND_FIELD,N_TYPES) ! OUT Gross primary productivity BDYLYR6A.466
! (kg C/m2/s). BDYLYR6A.467
&,NPP(LAND_FIELD,N_TYPES) ! OUT Net primary productivity BDYLYR6A.468
! (kg C/m2/s). BDYLYR6A.469
&,RESP_P(LAND_FIELD,N_TYPES)! OUT Plant respiration (kg C/m2/s). BDYLYR6A.470
&,SNOWMELT(P_FIELD) ! OUT Snowmelt (kg/m2/s). BDYLYR6A.471
&,ZH(P_FIELD) ! INOUT Height above surface of top of BDYLYR6A.472
! boundary layer (metres). BDYLYR6A.473
&,T1_SD(P_FIELD) ! OUT Standard deviation of turbulent BDYLYR6A.474
! fluctuations of layer 1 temperature; BDYLYR6A.475
! for use in initiating convection. BDYLYR6A.476
&,Q1_SD(P_FIELD) ! OUT Standard deviation of turbulent BDYLYR6A.477
! fluctuations of layer 1 humidity; BDYLYR6A.478
! for use in initiating convection. BDYLYR6A.479
INTEGER BDYLYR6A.480
& ERROR ! OUT 0 - AOK; BDYLYR6A.481
! ! 1 to 7 - bad grid definition detected; BDYLYR6A.483
BDYLYR6A.487
!--------------------------------------------------------------------- BDYLYR6A.488
! External routines called :- BDYLYR6A.489
BDYLYR6A.490
EXTERNAL Z,HEAT_CON,SMC_ROOT,SF_EXCH,BOUY_TQ,BTQ_INT, BDYLYR6A.491
& KMKH,EX_FLUX_TQ,EX_FLUX_UV,IM_CAL_TQ,SICE_HTF,SF_EVAP, BDYLYR6A.492
& IM_CAL_UV BDYLYR6A.493
EXTERNAL TIMER BDYLYR6A.494
*IF -DEF,SCMA AJC1F405.373
EXTERNAL UV_TO_P,P_TO_UV BDYLYR6A.496
*ENDIF BDYLYR6A.497
BDYLYR6A.498
!----------------------------------------------------------------------- BDYLYR6A.499
! Symbolic constants (parameters) reqd in top-level routine :- BDYLYR6A.500
BDYLYR6A.501
*CALL C_R_CP 
BDYLYR6A.502
*CALL C_G BDYLYR6A.503
*CALL C_LHEAT BDYLYR6A.504
*CALL C_GAMMA BDYLYR6A.505
*CALL SOIL_THICK BDYLYR6A.506
*IF DEF,MPP BDYLYR6A.507
! MPP Common block BDYLYR6A.508
*CALL PARVARS BDYLYR6A.509
*ENDIF BDYLYR6A.510
BDYLYR6A.511
! Derived local parameters. BDYLYR6A.512
BDYLYR6A.513
REAL LCRCP,LS,LSRCP BDYLYR6A.514
BDYLYR6A.515
PARAMETER ( BDYLYR6A.516
& LCRCP=LC/CP ! Evaporation-to-dT conversion factor. BDYLYR6A.517
&,LS=LF+LC ! Latent heat of sublimation. BDYLYR6A.518
&,LSRCP=LS/CP ! Sublimation-to-dT conversion factor. BDYLYR6A.519
& ) BDYLYR6A.520
BDYLYR6A.521
!----------------------------------------------------------------------- BDYLYR6A.522
BDYLYR6A.523
! Workspace :- BDYLYR6A.524
BDYLYR6A.525
REAL BDYLYR6A.526
& A_DQSDT(P_FIELD,BL_LEVELS) BDYLYR6A.527
! ! Saturated lapse rate factor BDYLYR6A.528
! ! on p,T,q-levels (full levels). BDYLYR6A.529
&,A_DQSDTM(P_FIELD,BL_LEVELS) BDYLYR6A.530
! ! Saturated lapse rate factor BDYLYR6A.531
! ! on intermediate levels (half levels). BDYLYR6A.532
&,ALPHA1(P_FIELD,N_TYPES) ! Mean gradient of saturated BDYLYR6A.533
! specific humidity with BDYLYR6A.534
! respect to temperature between BDYLYR6A.535
! the bottom model layer and the BDYLYR6A.536
! tile surfaces. BDYLYR6A.537
&,ALPHA1_GB(P_FIELD) ! Mean gradient of saturated BDYLYR6A.538
! specific humidity with BDYLYR6A.539
! respect to temperature between BDYLYR6A.540
! the bottom model layer and the BDYLYR6A.541
! tile surfaces BDYLYR6A.542
&,A_QS(P_FIELD,BL_LEVELS) ! Saturated lapse rate factor BDYLYR6A.543
! ! on p,T,q-levels (full levels). BDYLYR6A.544
&,A_QSM(P_FIELD,BL_LEVELS) BDYLYR6A.545
! ! Saturated lapse rate factor BDYLYR6A.546
! ! on intermediate levels (half levels). BDYLYR6A.547
&,ASHTF(P_FIELD) ! Coefficient to calculate surface BDYLYR6A.548
! heat flux into soil or sea-ice. BDYLYR6A.549
&,ASURF(P_FIELD) ! Reciprocal areal heat capacity BDYLYR6A.550
! of soil layer or sea-ice BDYLYR6A.551
! surface layer (K m**2 / J). BDYLYR6A.552
&,BQ(P_FIELD,BL_LEVELS) ! A buoyancy parameter for clear air BDYLYR6A.553
! ! on p,T,q-levels (full levels). BDYLYR6A.554
&,BQ_CLD(P_FIELD,BL_LEVELS)! A buoyancy parameter for cloudy air BDYLYR6A.555
! ! on p,T,q-levels (full levels). BDYLYR6A.556
&,BQM(P_FIELD,BL_LEVELS) ! A buoyancy parameter for clear air BDYLYR6A.557
! ! on intermediate levels (half levels). BDYLYR6A.558
&,BQM_CLD(P_FIELD,BL_LEVELS) BDYLYR6A.559
! ! A buoyancy parameter for cloudy air BDYLYR6A.560
! ! on intermediate levels (half levels). BDYLYR6A.561
&,BT(P_FIELD,BL_LEVELS) ! A buoyancy parameter for clear air BDYLYR6A.562
! ! on p,T,q-levels (full levels). BDYLYR6A.563
&,BT_CLD(P_FIELD,BL_LEVELS) BDYLYR6A.564
! ! A buoyancy parameter for cloudy air BDYLYR6A.565
! ! on p,T,q-levels (full levels). BDYLYR6A.566
&,BTM(P_FIELD,BL_LEVELS) ! A buoyancy parameter for clear air BDYLYR6A.567
! ! on intermediate levels (half levels). BDYLYR6A.568
&,BTM_CLD(P_FIELD,BL_LEVELS) BDYLYR6A.569
! ! A buoyancy parameter for cloudy air BDYLYR6A.570
! ! on intermediate levels (half levels). BDYLYR6A.571
&,DB(P_FIELD,2:BL_LEVELS) BDYLYR6A.572
! ! Buoyancy jump across layer interface. BDYLYR6A.573
&,DELTAP(P_FIELD,BL_LEVELS)! Difference in pressure between levels BDYLYR6A.574
&,DELTAP_UV(P_FIELD,BL_LEVELS) BDYLYR6A.575
! Difference in pressure between levels BDYLYR6A.576
! on UV points BDYLYR6A.577
&,DQSDT(P_FIELD,BL_LEVELS) ! Derivative of q_SAT w.r.t. T BDYLYR6A.578
&,DQW_1(P_FIELD) ! Increment for QW(,1). BDYLYR6A.579
&,DTRDZ(P_FIELD,BL_LEVELS) ! -g.dt/dp for model layers. BDYLYR6A.580
&,DTRDZ_UV(U_FIELD,BL_LEVELS) BDYLYR6A.581
! -g.dt/dp for model wind layers. BDYLYR6A.582
&,DTRDZ_RML(P_FIELD) ! -g.dt/dp for the rapidly BDYLYR6A.583
! mixing layer. BDYLYR6A.584
&,DZL(P_FIELD,BL_LEVELS) ! DZL(,K) is depth in m of layer BDYLYR6A.585
! K, i.e. distance from boundary BDYLYR6A.586
! K-1/2 to boundary K+1/2. BDYLYR6A.587
&,DU(U_FIELD,BL_LEVELS) ! BL increment to u wind foeld BDYLYR6A.588
&,DV(U_FIELD,BL_LEVELS) ! BL increment to v wind foeld BDYLYR6A.589
&,DU_NT(U_FIELD,BL_LEVELS) ! non-turbulent inc. to u wind field BDYLYR6A.590
&,DV_NT(U_FIELD,BL_LEVELS) ! non-turbulent inc. to v wind field BDYLYR6A.591
&,DTL_NT(P_FIELD,BL_LEVELS)! non-turbulent inc. to TL field BDYLYR6A.592
&,DQW_NT(P_FIELD,BL_LEVELS)! non-turbulent inc. to QW field BDYLYR6A.593
&,ES(P_FIELD,N_TYPES) ! Surface evapotranspiration BDYLYR6A.594
! through a resistance which is not BDYLYR6A.595
! entirely aerodynamic i.e. "soil BDYLYR6A.596
! evaporation". Always non-negative. BDYLYR6A.597
! (kg/m2/s). BDYLYR6A.598
&,ESOIL(P_FIELD,N_TYPES) ! Evaporation from bare soil (kg/m2 BDYLYR6A.599
&,FB_SURF(P_FIELD) ! Surface flux buoyancy over density BDYLYR6A.600
! ! (m^2/s^3) BDYLYR6A.601
! BDYLYR6A.602
&,FRACA(P_FIELD,N_TYPES) ! Fraction of surface moisture flux BDYLYR6A.603
! with only aerodynamic resistance. BDYLYR6A.604
&,F_SE(P_FIELD,N_TYPES) ! Fraction of the evapotranspiration BDYLYR6A.605
! which is bare soil evaporation. BDYLYR6A.606
&,GRAD_Q_ADJ(P_FIELD) ! Humidity gradient adjustment BDYLYR6A.607
! for non-local mixing in unstable BDYLYR6A.608
! turbulent boundary layer. BDYLYR6A.609
&,GRAD_T_ADJ(P_FIELD) ! Temperature gradient adjustment BDYLYR6A.610
! for non-local mixing in unstable BDYLYR6A.611
! turbulent boundary layer. BDYLYR6A.612
&,HEAT_BLEND_FACTOR(P_FIELD,N_TYPES) BDYLYR6A.613
! Blending factor used as part of BDYLYR6A.614
! tile scheme BDYLYR6A.615
&,HCONS(LAND_FIELD) ! Soil thermal conductivity includi BDYLYR6A.616
! the effects of water and ice (W/m BDYLYR6A.617
&,QW(P_FIELD,BL_LEVELS) ! Total water content, but BDYLYR6A.618
! replaced by specific humidity BDYLYR6A.619
! in LS_CLD. BDYLYR6A.620
&,P(P_FIELD,BL_LEVELS) ! P(*,K) is pressure at full level k. BDYLYR6A.621
&,P_HALF(P_FIELD,BL_LEVELS)! P_HALF(*,K) is pressure at half BDYLYR6A.622
! ! level k-1/2. BDYLYR6A.623
&,Z_FULL(P_FIELD,BL_LEVELS)! Z_FULL(*,K) is height of full level k. BDYLYR6A.624
&,Z_HALF(P_FIELD,BL_LEVELS)! Z_HALF(*,K) is height of half level BDYLYR6A.625
! ! k-1/2. BDYLYR6A.626
&,Z_UV(P_FIELD,BL_LEVELS) ! Z_UV(*,K) is height of half level BDYLYR6A.627
! ! k-1/2. BDYLYR6A.628
&,Z_TQ(P_FIELD,BL_LEVELS) ! Z_TQ(*,K) is height of half level BDYLYR6A.629
! ! k+1/2. BDYLYR6A.630
&,RDZ(P_FIELD,BL_LEVELS) ! RDZ(,1) is the reciprocal of the BDYLYR6A.631
! height of level 1, i.e. of the BDYLYR6A.632
! middle of layer 1. For K > 1, BDYLYR6A.633
! RDZ(,K) is the reciprocal BDYLYR6A.634
! of the vertical distance BDYLYR6A.635
! from level K-1 to level K. BDYLYR6A.636
&,RDZUV(U_FIELD,BL_LEVELS) ! RDZ (K > 1) on UV-grid. BDYLYR6A.637
! Comments as per RHOKM (RDZUV). BDYLYR6A.638
&,RESFS(P_FIELD,N_TYPES) ! Combined soil, stomatal BDYLYR6A.639
! and aerodynamicresistance BDYLYR6A.640
! factor = PSIS/(1+RS/RA) for BDYLYR6A.641
! fraction (1-FRACA) BDYLYR6A.642
&,RESFT_TILE(P_FIELD,N_TYPES) BDYLYR6A.643
! Total resistance factor for tile BDYLYR6A.644
! FRACA+(1-FRACA)*RESFS. BDYLYR6A.645
&,RESFT(P_FIELD) ! Mean total resistance factor BDYLYR6A.646
! FRACA+(1-FRACA)*RESFS. BDYLYR6A.647
&,RHO_FULL(P_FIELD,BL_LEVELS) BDYLYR6A.648
! ! RHO_FULL(*,K) is the density at full BDYLYR6A.649
! ! model level k. BDYLYR6A.650
&,RHO_HALF(P_FIELD,BL_LEVELS) BDYLYR6A.651
! ! RHO_HALF(*,K) is the density at half BDYLYR6A.652
! ! level k-1/2. BDYLYR6A.653
&,RHO_UV(P_FIELD,BL_LEVELS) BDYLYR6A.654
! ! RHO_UV(*,K) is the density at half BDYLYR6A.655
! ! level k-1/2. BDYLYR6A.656
&,RHO_TQ(P_FIELD,BL_LEVELS) BDYLYR6A.657
! ! RHO_TQ(*,K) is the density at half BDYLYR6A.658
! ! level k+1/2. BDYLYR6A.659
&,RHOKE(P_FIELD,N_TYPES) ! Surface exchange coefficient for FQW BDYLYR6A.660
&,RHOKH_TILE(P_FIELD,N_TYPES) BDYLYR6A.661
! Tile surface exchange coefficients BDYLYR6A.662
! for heat BDYLYR6A.663
&,RHOKHZ(P_FIELD,2:BL_LEVELS) BDYLYR6A.664
! ! Non-local turbulent mixing BDYLYR6A.665
! coefficient for heat and moisture. BDYLYR6A.666
&,RHOKH_TOP(P_FIELD,2:BL_LEVELS) ARN0F405.203
! ! Non-local turbulent mixing coefficient ARN0F405.204
! ! for top-down mixing of heat and ARN0F405.205
! ! moisture. ARN0F405.206
&,RHOKM(P_FIELD,BL_LEVELS) ! Turbulent mixing coefficient for BDYLYR6A.667
! momentum on P-grid. BDYLYR6A.668
&,RHOKMZ(P_FIELD,2:BL_LEVELS) BDYLYR6A.669
! ! Non-local turbulent mixing BDYLYR6A.670
! coefficient for momentum. BDYLYR6A.671
&,RHOKM_TOP(P_FIELD,2:BL_LEVELS) ARN0F405.207
! ! Non-local turbulent mixing coefficient ARN0F405.208
! ! for top-down mixing of momentum. ARN0F405.209
&,RHOKPM(P_FIELD) ! Surface exchange coefficient. BDYLYR6A.672
&,RHOKPM_POT(P_FIELD) ! WORK Surface exchange coeff. for ANG1F405.82
! potential evaporation. ANG1F405.83
&,RHOKPM_POT_TILE(P_FIELD,N_TYPES) ANG1F405.84
! WORK Tile surface exchange coeff. ANG1F405.85
! for potential evaporaiotn. ANG1F405.86
&,RHOKPM_TILE(P_FIELD,N_TYPES) BDYLYR6A.673
! Surface exchange coefficient. BDYLYR6A.674
&,SMC(LAND_FIELD,N_TYPES) ! Soil moisture content in root depth BDYLYR6A.675
! (kg/m2). BDYLYR6A.676
&,SURF_HT_FLUX(P_FIELD,N_TYPES) BDYLYR6A.677
! Net downward heat flux at surface BDYLYR6A.678
! over land or sea-ice fraction of BDYLYR6A.679
! gridbox (W/m2). BDYLYR6A.680
&,TL(P_FIELD,BL_LEVELS) ! Ice/liquid water temperature, BDYLYR6A.681
! but replaced by T in LS_CLD. BDYLYR6A.682
&,TV(P_FIELD,BL_LEVELS) ! Virtual temp BDYLYR6A.683
&,TV1_SD(P_FIELD) ! Standard deviation of turbulent BDYLYR6A.684
! ! fluctuations of surface layer BDYLYR6A.685
! ! virtual temperature (K). BDYLYR6A.686
&,U_P(P_FIELD,BL_LEVELS) ! U on P-grid. BDYLYR6A.687
&,U_0_P(P_FIELD) ! U_0 on P-grid. BDYLYR6A.688
&,U_S(P_FIELD) ! Surface friction velocity (m/s) BDYLYR6A.689
&,V_P(P_FIELD,BL_LEVELS) ! V on P-grid. BDYLYR6A.690
&,V_0_P(P_FIELD) ! V_0 on P-grid. BDYLYR6A.691
&,V_ROOT(LAND_FIELD,N_TYPES)! Volumetric soil moisture BDYLYR6A.692
! concentration in the rootzone BDYLYR6A.693
! (m3 H2O/m3 soil). BDYLYR6A.694
&,V_SOIL(LAND_FIELD) ! Volumetric soil moisture BDYLYR6A.695
! concentration in the top BDYLYR6A.696
! soil layer (m3 H2O/m3 soil). BDYLYR6A.697
&,WIND_BLEND_FACTOR(P_FIELD,N_TYPES) BDYLYR6A.698
! Blending factor used as part of BDYLYR6A.699
! tile scheme BDYLYR6A.700
&,WT_EXT(LAND_FIELD,SM_LEVELS) BDYLYR6A.701
! Fraction of transpiration which is BDYLYR6A.702
! extracted from each soil layer. BDYLYR6A.703
&,ZLB(P_FIELD,0:BL_LEVELS) ! ZLB(,K) is the height of the BDYLYR6A.704
! upper boundary of layer K BDYLYR6A.705
! ( = 0.0 for "K=0"). BDYLYR6A.706
REAL BDYLYR6A.707
& Z0H(P_FIELD,N_TYPES) ! Roughness length for heat and BDYLYR6A.708
! moisture. BDYLYR6A.709
&,Z0M(P_FIELD,N_TYPES) ! Roughness length for momentum. BDYLYR6A.710
&,Z1(P_FIELD) ! Height of lowest level (i.e. BDYLYR6A.711
! height of middle of lowest BDYLYR6A.712
! layer). BDYLYR6A.713
&,H_BLEND_OROG(P_FIELD) ! Blending height used as part of BDYLYR6A.714
! effective roughness scheme BDYLYR6A.715
&,H_BLEND(P_FIELD) ! Blending height for tiles BDYLYR6A.716
&,Z0M_EFF_GB(P_FIELD) ! Effective grid-box roughness BDYLYR6A.717
! length for momentum BDYLYR6A.718
&,Z0M_EFF(P_FIELD,N_TYPES) ! Effective tile roughness length BDYLYR6A.719
! for momentum BDYLYR6A.720
&,Z_LCL(P_FIELD) ! Height of lifting condensation level. ARN0F405.210
&,CDR10M(P_FIELD) ! Ratio of CD's reqd for calculation BDYLYR6A.721
! of 10 m wind. On P-grid BDYLYR6A.722
&,CDR10M_UV(U_FIELD) ! Ratio of CD's reqd for calculation BDYLYR6A.723
! of 10 m wind. On UV-grid; comments as BDYLYR6A.724
! per RHOKM. BDYLYR6A.725
&,CER1P5M(P_FIELD) ! Ratio of coefficients reqd for BDYLYR6A.726
! calculation of 1.5 m Q. BDYLYR6A.727
&,CHR1P5M(P_FIELD) ! Ratio of coefficients reqd for BDYLYR6A.728
! calculation of 1.5 m T. BDYLYR6A.729
! APA1F405.354
! Variables for Vegetation Thermal Canopy APA1F405.355
! APA1F405.356
REAL APA1F405.357
+ CANCAP(P_FIELD,N_TYPES) ! WORK Volumetric heat capacity of APA1F405.358
! ! vegetation canopy (J/Kg/m3). APA1F405.359
+,RADNET_C(P_FIELD,N_TYPES) ! WORK Adjusted net radiation for APA1F405.360
! ! vegetation canopy over land APA1F405.361
! ! (W/m2). APA1F405.362
BDYLYR6A.730
INTEGER BDYLYR6A.731
& F_TYPE(LAND_FIELD,N_TYPES)! Plant functional type: BDYLYR6A.732
! 1 - Broadleaf Tree BDYLYR6A.733
! 2 - Needleleaf Tree BDYLYR6A.734
! 3 - C3 Grass BDYLYR6A.735
! 4 - C4 Grass BDYLYR6A.736
INTEGER BDYLYR6A.737
& NTML(P_FIELD) ! Number of model levels in the BDYLYR6A.738
! turbulently mixed layer. BDYLYR6A.739
&,NTDSC(P_FIELD) ! Top level for turbulent mixing in ARN0F405.211
! ! cloud layer. ARN0F405.212
LOGICAL ARN0F405.213
& CUMULUS(P_FIELD) ! Logical switch for cumulus in the b.l. ARN0F405.214
&,UNSTABLE(P_FIELD) ! Logical switch for unstable ARN0F405.215
! surface layer. ARN0F405.216
&,DSC(P_FIELD) ! Flag set if decoupled stratocumulus ARN0F405.217
! ! layer found. ARN0F405.218
BDYLYR6A.740
! Local scalars :- BDYLYR6A.741
BDYLYR6A.742
REAL BDYLYR6A.743
& WK ! LOCAL 0.5 * DZL(I,K) * RDZ(I,K) BDYLYR6A.744
&,WKM1 ! LOCAL 0.5 * DZL(I,K-1) * RDZ(I,K) BDYLYR6A.745
BDYLYR6A.746
INTEGER BDYLYR6A.747
& I,J,L ! LOCAL Loop counter (horizontal field index). BDYLYR6A.748
&,ITILE ! LOCAL Loopy counter (tile index). BDYLYR6A.749
&,N ! LOCAL Loop counter (soil levels) BDYLYR6A.750
&,K ! LOCAL Loop counter (vertical level index). BDYLYR6A.751
&,N_P_ROWS ! LOCAL No of P-rows being processed. BDYLYR6A.752
&,N_U_ROWS ! LOCAL No of UV-rows being processed. BDYLYR6A.753
&,P_POINTS ! LOCAL No of P-points being processed. BDYLYR6A.754
&,P1 ! LOCAL First P-point to be processed. BDYLYR6A.755
&,LAND1 ! LOCAL First land-point to be processed. BDYLYR6A.756
! 1 <= LAND1 <= LAND_FIELD BDYLYR6A.757
&,LAND_PTS ! LOCAL No of land points being processed. BDYLYR6A.758
&,U_POINTS ! LOCAL No of UV-points being processed. BDYLYR6A.759
&,U1 ! LOCAL First UV-point to be processed. BDYLYR6A.760
BDYLYR6A.761
IF (LTIMER) THEN BDYLYR6A.762
CALL TIMER('BDYLAYR ',3) BDYLYR6A.763
ENDIF BDYLYR6A.764
ERROR = 0 BDYLYR6A.765
C----------------------------------------------------------------------- APA1F405.363
C Initialise RADNET_C to be the same as RADNET over all points APA1F405.364
C----------------------------------------------------------------------- APA1F405.365
DO ITILE=1,N_TYPES APA1F405.366
DO I=1,P_FIELD APA1F405.367
RADNET_C(I,ITILE) = RADNET(I) APA1F405.368
ENDDO APA1F405.369
ENDDO APA1F405.370
BDYLYR6A.766
*IF -DEF,SCMA AJC1F405.374
!----------------------------------------------------------------------- BDYLYR6A.768
!! 0. Verify grid/subset definitions. Arakawa 'B' grid with P-rows at BDYLYR6A.769
!! extremes is assumed. Extreme-most P-rows are ignored; extreme- BDYLYR6A.770
!! most UV-rows are used only for interpolation and are not updated. BDYLYR6A.771
!----------------------------------------------------------------------- BDYLYR6A.772
BDYLYR6A.773
IF ( BL_LEVELS.LT.1 .OR. ST_LEVELS.LT.1 .OR. SM_LEVELS.LT.1 BDYLYR6A.774
& .OR. P_ROWS.LT.3 ) THEN BDYLYR6A.775
ERROR = 1 BDYLYR6A.776
GOTO999 BDYLYR6A.777
*IF -DEF,MPP BDYLYR6A.778
ELSEIF ( U_FIELD .NE. (P_ROWS-1)*ROW_LENGTH ) THEN BDYLYR6A.779
*ELSE BDYLYR6A.780
ELSEIF ( U_FIELD .NE. P_ROWS*ROW_LENGTH ) THEN BDYLYR6A.781
*ENDIF BDYLYR6A.782
ERROR = 2 BDYLYR6A.783
GOTO999 BDYLYR6A.784
ELSEIF ( P_FIELD .NE. P_ROWS*ROW_LENGTH ) THEN BDYLYR6A.785
ERROR = 3 BDYLYR6A.786
GOTO999 BDYLYR6A.787
ELSEIF ( FIRST_ROW.LE.1 .OR. FIRST_ROW.GE.P_ROWS ) THEN BDYLYR6A.788
ERROR = 4 BDYLYR6A.789
GOTO999 BDYLYR6A.790
ELSEIF ( N_ROWS.LE.0 ) THEN BDYLYR6A.791
ERROR = 5 BDYLYR6A.792
GOTO999 BDYLYR6A.793
*IF -DEF,MPP BDYLYR6A.794
ELSEIF ( (FIRST_ROW+N_ROWS) .GT. P_ROWS ) THEN BDYLYR6A.795
*ELSE BDYLYR6A.796
ELSEIF ( (FIRST_ROW+N_ROWS-1) .GT. P_ROWS ) THEN BDYLYR6A.797
*ENDIF BDYLYR6A.798
ERROR = 6 BDYLYR6A.799
GOTO999 BDYLYR6A.800
ELSEIF ( LAND_FIELD.GT.P_FIELD ) THEN BDYLYR6A.801
ERROR = 7 BDYLYR6A.802
GOTO999 BDYLYR6A.803
ENDIF BDYLYR6A.804
BDYLYR6A.805
!----------------------------------------------------------------------- BDYLYR6A.806
!! Set pointers, etc. BDYLYR6A.807
!----------------------------------------------------------------------- BDYLYR6A.808
BDYLYR6A.809
N_P_ROWS = N_ROWS BDYLYR6A.810
N_U_ROWS = N_ROWS + 1 BDYLYR6A.811
BDYLYR6A.812
P_POINTS = N_P_ROWS * ROW_LENGTH BDYLYR6A.813
U_POINTS = N_U_ROWS * ROW_LENGTH BDYLYR6A.814
BDYLYR6A.815
P1 = 1 + (FIRST_ROW-1)*ROW_LENGTH BDYLYR6A.816
U1 = 1 + (FIRST_ROW-2)*ROW_LENGTH BDYLYR6A.817
BDYLYR6A.818
!----------------------------------------------------------------------- BDYLYR6A.819
!! Set compressed land point pointers. BDYLYR6A.820
!----------------------------------------------------------------------- BDYLYR6A.821
BDYLYR6A.822
LAND1=0 BDYLYR6A.823
DO I=1,P1+P_POINTS-1 BDYLYR6A.824
IF (LAND_INDEX(I).GE.P1) THEN BDYLYR6A.825
LAND1 = I BDYLYR6A.826
GOTO2 BDYLYR6A.827
ENDIF BDYLYR6A.828
ENDDO BDYLYR6A.829
2 CONTINUE BDYLYR6A.830
BDYLYR6A.831
LAND_PTS=0 BDYLYR6A.832
DO I=P1,P1+P_POINTS-1 BDYLYR6A.833
IF (LAND_MASK(I)) LAND_PTS = LAND_PTS + 1 BDYLYR6A.834
ENDDO BDYLYR6A.835
*ELSE BDYLYR6A.836
C AJC1F405.375
C--------------------------------------------------------------------- AJC1F405.376
CL 0. Check grid definition arguments. AJC1F405.377
C--------------------------------------------------------------------- AJC1F405.378
C AJC1F405.379
IF ( BL_LEVELS.LT.1 AJC1F405.380
& .OR. ST_LEVELS.LT.1 .OR.SM_LEVELS.LT.1 ) THEN AJC1F405.381
ERROR = 1 AJC1F405.382
GOTO999 AJC1F405.383
ELSEIF ( U_FIELD .NE. P_ROWS*ROW_LENGTH ) THEN AJC1F405.384
ERROR = 2 AJC1F405.385
GOTO999 AJC1F405.386
ELSEIF ( P_FIELD .NE. P_ROWS*ROW_LENGTH ) THEN AJC1F405.387
ERROR = 3 AJC1F405.388
GOTO999 AJC1F405.389
ELSEIF ( N_ROWS.LE.0 ) THEN AJC1F405.390
ERROR = 5 AJC1F405.391
GOTO999 AJC1F405.392
ELSEIF ( LAND_FIELD.GT.P_FIELD ) THEN AJC1F405.393
ERROR = 7 AJC1F405.394
GOTO999 AJC1F405.395
ENDIF AJC1F405.396
C AJC1F405.397
C--------------------------------------------------------------------- AJC1F405.398
CL Set pointers, etc. AJC1F405.399
C--------------------------------------------------------------------- AJC1F405.400
C AJC1F405.401
N_P_ROWS=N_ROWS AJC1F405.402
N_U_ROWS=N_ROWS AJC1F405.403
AJC1F405.404
P_POINTS=N_P_ROWS*ROW_LENGTH AJC1F405.405
U_POINTS=N_U_ROWS*ROW_LENGTH AJC1F405.406
AJC1F405.407
P1 = 1 AJC1F405.408
U1 = 1 AJC1F405.409
C AJC1F405.410
C--------------------------------------------------------------------- AJC1F405.411
CL Set compressed land point pointers. AJC1F405.412
C--------------------------------------------------------------------- AJC1F405.413
C AJC1F405.414
LAND1=0 AJC1F405.415
DO 1 I=1,P1+P_POINTS-1 AJC1F405.416
IF (LAND_INDEX(I).GE.P1) THEN AJC1F405.417
LAND1 = I AJC1F405.418
GOTO2 AJC1F405.419
ENDIF AJC1F405.420
1 CONTINUE AJC1F405.421
2 CONTINUE AJC1F405.422
LAND_PTS=0 AJC1F405.423
DO 3 I=P1,P1+P_POINTS-1 AJC1F405.424
IF (LAND_MASK(I)) LAND_PTS = LAND_PTS + 1 AJC1F405.425
3 CONTINUE AJC1F405.426
*ENDIF BDYLYR6A.866
BDYLYR6A.867
BDYLYR6A.868
!----------------------------------------------------------------------- BDYLYR6A.869
!! 1. Perform calculations in what the documentation describes as BDYLYR6A.870
!! subroutine Z_DZ. In fact, a separate subroutine isn't used. BDYLYR6A.871
!----------------------------------------------------------------------- BDYLYR6A.872
BDYLYR6A.873
!----------------------------------------------------------------------- BDYLYR6A.874
!! 1.1 Initialise ZLB(,0) (to zero, of course, this being the height BDYLYR6A.875
!! of the surface above the surface). BDYLYR6A.876
!----------------------------------------------------------------------- BDYLYR6A.877
BDYLYR6A.878
DO I=P1,P1+P_POINTS-1 BDYLYR6A.879
ZLB(I,0)=0.0 BDYLYR6A.880
ENDDO BDYLYR6A.881
BDYLYR6A.882
!----------------------------------------------------------------------- BDYLYR6A.883
!! 1.2 Calculate layer depths and heights, and construct wind fields on BDYLYR6A.884
!! P-grid. This involves calling subroutines Z and UV_TO_P. BDYLYR6A.885
!! Virtual temperature is also calculated, as a by-product. BDYLYR6A.886
!----------------------------------------------------------------------- BDYLYR6A.887
BDYLYR6A.888
! NB RDZ TEMPORARILY used to return DELTA_Z_LOWER, the lower half BDYLYR6A.889
! layer thickness BDYLYR6A.890
BDYLYR6A.891
DO K=1,BL_LEVELS BDYLYR6A.892
CALL Z(P_POINTS,EXNER(P1,K),EXNER(P1,K+1),PSTAR(P1), BDYLYR6A.893
& AKH(K),BKH(K),Q(P1,K),QCF(P1,K), BDYLYR6A.894
& QCL(P1,K),T(P1,K),ZLB(P1,K-1),TV(P1,K), BDYLYR6A.895
& ZLB(P1,K),DZL(P1,K),RDZ(P1,K),LTIMER) BDYLYR6A.896
ENDDO BDYLYR6A.897
DO K=1,BL_LEVELS BDYLYR6A.898
DO I=P1,P1+P_POINTS-1 BDYLYR6A.899
Z_FULL(I,K) = ZLB(I,K) - 0.5 * DZL(I,K) BDYLYR6A.900
Z_HALF(I,K) = ZLB(I,K-1) BDYLYR6A.901
Z_UV(I,K) = ZLB(I,K-1) BDYLYR6A.902
Z_TQ(I,K) = ZLB(I,K) BDYLYR6A.903
ENDDO BDYLYR6A.904
ENDDO BDYLYR6A.905
DO K=1,BL_LEVELS BDYLYR6A.906
BDYLYR6A.907
*IF -DEF,SCMA AJC1F405.427
CALL UV_TO_P(U(U1,K),U_P(P1,K), BDYLYR6A.909
& U_POINTS,P_POINTS,ROW_LENGTH,N_U_ROWS) BDYLYR6A.910
CALL UV_TO_P(V(U1,K),V_P(P1,K), BDYLYR6A.911
& U_POINTS,P_POINTS,ROW_LENGTH,N_U_ROWS) BDYLYR6A.912
BDYLYR6A.913
BDYLYR6A.914
! du_nt 'borrowed to store dzl on uv grid BDYLYR6A.915
CALL P_TO_UV (DZL(P1,K),DU_NT(U1+ROW_LENGTH,K), BDYLYR6A.916
& P_POINTS,U_POINTS,ROW_LENGTH,N_P_ROWS) BDYLYR6A.917
BDYLYR6A.918
*ELSE BDYLYR6A.919
DO I = P1, P1-1+P_POINTS AJC1F405.428
U_P(i,K) = U(i,K) AJC1F405.429
V_P(i,K) = V(i,K) AJC1F405.430
ENDDO AJC1F405.431
*ENDIF BDYLYR6A.922
ENDDO BDYLYR6A.923
BDYLYR6A.924
*IF -DEF,SCMA AJC1F405.432
CALL UV_TO_P(U_0(U1),U_0_P(P1), BDYLYR6A.926
& U_POINTS,P_POINTS,ROW_LENGTH,N_U_ROWS) BDYLYR6A.927
CALL UV_TO_P(V_0(U1),V_0_P(P1), BDYLYR6A.928
& U_POINTS,P_POINTS,ROW_LENGTH,N_U_ROWS) BDYLYR6A.929
*ELSE BDYLYR6A.930
DO I = P1, P1-1+P_POINTS AJC1F405.433
U_0_P(i) = U_0(i) AJC1F405.434
V_0_P(i) = V_0(i) AJC1F405.435
ENDDO AJC1F405.436
*ENDIF BDYLYR6A.933
BDYLYR6A.934
BDYLYR6A.935
! set pressure array. BDYLYR6A.936
DO K=1,BL_LEVELS BDYLYR6A.937
DO I=P1,P1+P_POINTS-1 BDYLYR6A.938
P(I,K) = AK(K) + BK(K)*PSTAR(I) BDYLYR6A.939
P_HALF(I,K) = AKH(K) + BKH(K)*PSTAR(I) BDYLYR6A.940
BDYLYR6A.941
! These will be used in new dynamics scheme - currently unused BDYLYR6A.942
DTL_NT(I,K)=0.0 BDYLYR6A.943
DQW_NT(I,K)=0.0 BDYLYR6A.944
BDYLYR6A.945
ENDDO BDYLYR6A.946
BDYLYR6A.947
ENDDO ! end of loop over bl_levels BDYLYR6A.948
BDYLYR6A.949
DO K=BL_LEVELS,2,-1 BDYLYR6A.950
BDYLYR6A.951
DO I=P1,P1+P_POINTS-1 BDYLYR6A.952
RDZ(I,K)=1.0/(RDZ(I,K)+(DZL(I,K-1)-RDZ(I,K-1))) BDYLYR6A.953
DELTAP(I,K)=DELTA_AK(K) + PSTAR(I)*DELTA_BK(K) BDYLYR6A.954
BDYLYR6A.955
DTRDZ(I,K) = -G * TIMESTEP/ DELTAP(I,K) BDYLYR6A.956
! & (DELTA_AK(K) + PSTAR(I)*DELTA_BK(K)) BDYLYR6A.957
ENDDO BDYLYR6A.958
ENDDO BDYLYR6A.959
BDYLYR6A.960
DO I=P1,P1+P_POINTS-1 BDYLYR6A.961
Z1(I)=RDZ(I,1) BDYLYR6A.962
RDZ(I,1)=1.0/RDZ(I,1) BDYLYR6A.963
BDYLYR6A.964
DELTAP(I,1)=DELTA_AK(1) + PSTAR(I)*DELTA_BK(1) BDYLYR6A.965
DTRDZ(I,1) = -G * TIMESTEP/DELTAP(I,1) BDYLYR6A.966
! & (DELTA_AK(1) + PSTAR(I)*DELTA_BK(1)) BDYLYR6A.967
ENDDO BDYLYR6A.968
BDYLYR6A.969
DO K=1,BL_LEVELS BDYLYR6A.970
BDYLYR6A.971
BDYLYR6A.972
! Calculate RDZUV here BDYLYR6A.973
BDYLYR6A.974
IF(K.GE.2)THEN BDYLYR6A.975
*IF -DEF,SCMA AJC1F405.437
BDYLYR6A.977
DO I=U1+ROW_LENGTH,U1-ROW_LENGTH+U_POINTS-1 BDYLYR6A.978
RDZUV(I,K) = 2.0 / ( DU_NT(I,K) + DU_NT(I,K-1) ) BDYLYR6A.979
ENDDO BDYLYR6A.980
BDYLYR6A.981
!----------------------------------------------------------------------- BDYLYR6A.982
! 1.3 Set first and last rows to "missing data indicator" BDYLYR6A.983
!----------------------------------------------------------------------- BDYLYR6A.984
BDYLYR6A.985
*IF DEF,MPP BDYLYR6A.986
IF (attop) THEN BDYLYR6A.987
*ENDIF BDYLYR6A.988
DO I=U1,U1+ROW_LENGTH-1 BDYLYR6A.989
RDZUV(I,K) = 1.0E30 BDYLYR6A.990
ENDDO BDYLYR6A.991
*IF DEF,MPP BDYLYR6A.992
ENDIF BDYLYR6A.993
BDYLYR6A.994
IF (atbase) THEN BDYLYR6A.995
*ENDIF BDYLYR6A.996
DO I= U1+(N_U_ROWS-1)*ROW_LENGTH, U1 + N_U_ROWS*ROW_LENGTH-1 BDYLYR6A.997
RDZUV(I,K) = 1.0E30 BDYLYR6A.998
ENDDO BDYLYR6A.999
*IF DEF,MPP BDYLYR6A.1000
ENDIF BDYLYR6A.1001
*ENDIF BDYLYR6A.1002
BDYLYR6A.1003
BDYLYR6A.1004
*ELSE BDYLYR6A.1005
DO I = P1, P1-1+P_POINTS AJC1F405.438
RDZUV(i,K) = 2.0 / ( DZL(i,K) + DZL(i,K-1) ) AJC1F405.439
ENDDO AJC1F405.440
*ENDIF BDYLYR6A.1007
ENDIF ! K .ge. 2 BDYLYR6A.1008
BDYLYR6A.1009
! Calculate DTRDZ_UV here. BDYLYR6A.1010
BDYLYR6A.1011
*IF -DEF,SCMA AJC1F405.441
! CALL P_TO_UV (DTRDZ(P1,K),DTRDZ_UV(U1+ROW_LENGTH,K), BDYLYR6A.1013
! & P_POINTS,U_POINTS,ROW_LENGTH,N_P_ROWS) BDYLYR6A.1014
BDYLYR6A.1015
CALL P_TO_UV (DELTAP(P1,K),DELTAP_UV(U1+ROW_LENGTH,K), BDYLYR6A.1016
& P_POINTS,U_POINTS,ROW_LENGTH,N_P_ROWS) BDYLYR6A.1017
BDYLYR6A.1018
DO I=U1+ROW_LENGTH,U1+U_POINTS-ROW_LENGTH-1 BDYLYR6A.1019
DTRDZ_UV(I,K) = -G * TIMESTEP / DELTAP_UV(I,K) BDYLYR6A.1020
ENDDO BDYLYR6A.1021
BDYLYR6A.1022
*ELSE BDYLYR6A.1023
DO I = P1, P1-1+P_POINTS AJC1F405.442
DTRDZ_UV(i,K) = DTRDZ(i,K) AJC1F405.443
ENDDO AJC1F405.444
*ENDIF BDYLYR6A.1025
BDYLYR6A.1026
ENDDO ! loop over bl_levels BDYLYR6A.1027
BDYLYR6A.1028
! "borrowed" du_nt reset to zero BDYLYR6A.1029
! Non turbulent increments for new dynamics scheme (currently not used) BDYLYR6A.1030
DO K=1,BL_LEVELS BDYLYR6A.1031
DO I=1,U_FIELD BDYLYR6A.1032
DU_NT(I,K) =0.0 BDYLYR6A.1033
DV_NT(I,K) =0.0 BDYLYR6A.1034
ENDDO BDYLYR6A.1035
ENDDO BDYLYR6A.1036
BDYLYR6A.1037
BDYLYR6A.1038
!!---------------------------------------------------------------------- BDYLYR6A.1039
!! 2. Diagnose the plant functional types at each location. BDYLYR6A.1040
!! Assume : Broadleaf Trees if rootdepth > 0.8m BDYLYR6A.1041
! C3 Grass if rootdepth < 0.8m BDYLYR6A.1042
!----------------------------------------------------------------------- BDYLYR6A.1043
DO ITILE=1,N_TYPES BDYLYR6A.1044
DO L=1,LAND_FIELD BDYLYR6A.1045
IF (ROOTD_TILE(L,ITILE).GT.0.8) THEN BDYLYR6A.1046
F_TYPE(L,ITILE)=1 BDYLYR6A.1047
ELSE BDYLYR6A.1048
F_TYPE(L,ITILE)=3 BDYLYR6A.1049
ENDIF BDYLYR6A.1050
ENDDO BDYLYR6A.1051
ENDDO BDYLYR6A.1052
BDYLYR6A.1053
!----------------------------------------------------------------------- BDYLYR6A.1054
! Calculate the thermal conductivity of the top soil layer. BDYLYR6A.1055
!----------------------------------------------------------------------- BDYLYR6A.1056
BDYLYR6A.1057
IF(LAND_FIELD.GT.0) THEN ! Omit if no land points BDYLYR6A.1058
CALL HEAT_CON (LAND_FIELD,HCON,STHU,STHF,SMVCST,HCONS,LTIMER) BDYLYR6A.1059
BDYLYR6A.1060
!----------------------------------------------------------------------- BDYLYR6A.1061
! Calculate the soil moisture in the root zone. BDYLYR6A.1062
!----------------------------------------------------------------------- BDYLYR6A.1063
BDYLYR6A.1064
DO ITILE=1,N_TYPES BDYLYR6A.1065
CALL SMC_ROOT (LAND_FIELD,SM_LEVELS,F_TYPE(1,ITILE),DZSOIL, BDYLYR6A.1066
& ROOTD_TILE(1,ITILE), APA1F405.371
& STHU,VFRAC_TILE(1,ITILE),SMVCST,SMVCWT, BDYLYR6A.1067
& SMC(1,ITILE),V_ROOT(1,ITILE),V_SOIL,WT_EXT, BDYLYR6A.1068
& LTIMER) BDYLYR6A.1069
ENDDO BDYLYR6A.1070
BDYLYR6A.1071
ENDIF ! End test on land points BDYLYR6A.1072
BDYLYR6A.1073
BDYLYR6A.1074
!----------------------------------------------------------------------- BDYLYR6A.1075
!! Calculate total water content, QW and Liquid water temperature, TL BDYLYR6A.1076
!----------------------------------------------------------------------- BDYLYR6A.1077
BDYLYR6A.1078
DO K=1,BL_LEVELS BDYLYR6A.1079
DO I=P1,P1+P_POINTS-1 BDYLYR6A.1080
QW(I,K) = Q(I,K) + QCL(I,K) + QCF(I,K) ! P243.10 BDYLYR6A.1081
TL(I,K) = T(I,K) - LCRCP*QCL(I,K) - LSRCP*QCF(I,K) ! P243.9 BDYLYR6A.1082
ENDDO BDYLYR6A.1083
ENDDO BDYLYR6A.1084
BDYLYR6A.1085
!----------------------------------------------------------------------- BDYLYR6A.1086
!! 3. Calls to SICE_HTF and SOIL_HTF now after IMPL_CAL BDYLYR6A.1087
!----------------------------------------------------------------------- BDYLYR6A.1088
BDYLYR6A.1089
!----------------------------------------------------------------------- BDYLYR6A.1090
!! 4. Surface turbulent exchange coefficients and "explicit" fluxes BDYLYR6A.1091
!! (P243a, routine SF_EXCH). BDYLYR6A.1092
!! Wind mixing "power" and some values required for other, later, BDYLYR6A.1093
!! diagnostic calculations, are also evaluated if requested. BDYLYR6A.1094
!----------------------------------------------------------------------- BDYLYR6A.1095
BDYLYR6A.1096
BDYLYR6A.1097
! Set lots of things to zero BDYLYR6A.1098
BDYLYR6A.1099
DO ITILE=1,N_TYPES BDYLYR6A.1100
DO I=1,P_FIELD BDYLYR6A.1101
ETRAN(I,ITILE)=0.0 BDYLYR6A.1102
ALPHA1(I,ITILE)=0.0 BDYLYR6A.1103
FQW_TILE(I,ITILE)=0.0 BDYLYR6A.1104
FTL_TILE(I,ITILE)=0.0 BDYLYR6A.1105
FRACA(I,ITILE)=0.0 BDYLYR6A.1106
RESFS(I,ITILE)=0.0 BDYLYR6A.1107
RESFT_TILE(I,ITILE)=0.0 BDYLYR6A.1108
RHOKH_TILE(I,ITILE)=0.0 BDYLYR6A.1109
RHOKPM_TILE(I,ITILE)=0.0 BDYLYR6A.1110
Z0H(I,ITILE)=0.0 BDYLYR6A.1111
Z0M_EFF(I,ITILE)=0.0 BDYLYR6A.1112
WIND_BLEND_FACTOR(I,ITILE)=0.0 BDYLYR6A.1113
HEAT_BLEND_FACTOR(I,ITILE)=0.0 BDYLYR6A.1114
BDYLYR6A.1115
IF(.NOT. LAND_MASK(I)) TILE_FRAC(I,ITILE)=0.0 BDYLYR6A.1116
BDYLYR6A.1117
tstar_tile(i,itile)=tstar(i) ! temporary for single tile only BDYLYR6A.1118
BDYLYR6A.1119
ENDDO BDYLYR6A.1120
ENDDO BDYLYR6A.1121
BDYLYR6A.1122
DO N=1,SM_LEVELS BDYLYR6A.1123
DO I=LAND1,LAND1+LAND_PTS-1 BDYLYR6A.1124
EXT(I,N)=0.0 BDYLYR6A.1125
ENDDO BDYLYR6A.1126
ENDDO BDYLYR6A.1127
BDYLYR6A.1128
DO I=P1,P1+P_POINTS-1 BDYLYR6A.1129
! IF(.NOT. LAND_MASK(I)) TILE_FRAC(I,1)=1.0 BDYLYR6A.1130
TILE_FRAC(I,1)=1.0 ! hard wired for single tile only BDYLYR6A.1131
BDYLYR6A.1132
SURF_HT_FLUX_GB(I)=0.0 BDYLYR6A.1133
ES_GB(I)=0.0 BDYLYR6A.1134
BDYLYR6A.1135
ENDDO BDYLYR6A.1136
BDYLYR6A.1137
BDYLYR6A.1138
BDYLYR6A.1139
CALL SF_EXCH ( BDYLYR6A.1140
& P_POINTS,LAND_PTS,P_FIELD,LAND_FIELD,N_TYPES, BDYLYR6A.1141
& P1,LAND1, BDYLYR6A.1142
& LAND_INDEX,GATHER, BDYLYR6A.1144
& P(1,1),TILE_FRAC, BDYLYR6A.1146
& CANOPY,CATCH_TILE,CO2_MMR, BDYLYR6A.1147
& SM_LEVELS,DZSOIL,HCONS,F_TYPE, BDYLYR6A.1148
& HT_TILE,LAI_TILE,PHOTOSYNTH_ACT_RAD,GPP,NPP,RESP_P, BDYLYR6A.1149
& ICE_FRACT,LAND_MASK,LYING_SNOW,PSTAR,Q(1,1), BDYLYR6A.1150
& QCF(1,1),QCL(1,1),RADNET_C,GC,RESIST_TILE, APA1F405.372
& ROOTD_TILE,SMC,SMVCCL,SMVCWT, BDYLYR6A.1152
& T(1,1),TIMESTEP,TI,T_SOIL(1,1),TSTAR, BDYLYR6A.1153
& TSTAR_TILE,U_P(1,1),V_P(1,1),U_0_P,V_0_P, BDYLYR6A.1154
& V_ROOT,V_SOIL,VFRAC_TILE, BDYLYR6A.1155
& Z0V,Z0V_TILE,SIL_OROG_LAND,HO2R2_OROG,ZH, BDYLYR6A.1156
& Z1,Z1,CANCAP,Z0MSEA,ALPHA1_GB,ALPHA1,ASHTF, APA1F405.373
& BQ(1,1),BT(1,1),CD,CH, BDYLYR6A.1158
& FQW_TILE,FQW(1,1),FTL_TILE,FTL(1,1), BDYLYR6A.1159
& EPOT_TILE,EPOT,FSMC_TILE,FSMC, ANG1F405.87
& E_SEA,H_SEA,FRACA,RESFS,F_SE, BDYLYR6A.1160
& RESFT_TILE,RESFT,RHOKE,RHOKH_TILE, BDYLYR6A.1161
& RHOKH,RHOKM,RHOKPM_TILE,RHOKPM,RHOKPM_POT_TILE,RHOKPM_POT, ANG1F405.88
& RIB_GB,RIB,TL(1,1),VSHR,Z0H,Z0M,Z0M_EFF,Z0M_EFF_GB, BDYLYR6A.1163
& H_BLEND_OROG,H_BLEND,T1_SD,Q1_SD,TV1_SD,U_S,FB_SURF, BDYLYR6A.1164
& RHO_CD_MODV1,WIND_BLEND_FACTOR,HEAT_BLEND_FACTOR, BDYLYR6A.1165
& CDR10M,CHR1P5M,CER1P5M,FME, BDYLYR6A.1166
& SU10,SV10,SQ1P5,ST1P5,SFME, BDYLYR6A.1167
& RHO_ARESIST,ARESIST,RESIST_B,NRML, BDYLYR6A.1168
& L_Z0_OROG,L_RMBL,LTIMER BDYLYR6A.1169
&) BDYLYR6A.1170
BDYLYR6A.1171
BDYLYR6A.1172
!----------------------------------------------------------------------- BDYLYR6A.1173
!! 5. Turbulent exchange coefficients and "explicit" fluxes between BDYLYR6A.1174
!! model layers in the boundary layer (P243b, routine KMKH). BDYLYR6A.1175
!----------------------------------------------------------------------- BDYLYR6A.1176
BDYLYR6A.1177
!----------------------------------------------------------------------- BDYLYR6A.1178
!! 5.1 Calculate bouyancy parameters BT and BQ. BDYLYR6A.1179
!----------------------------------------------------------------------- BDYLYR6A.1180
BDYLYR6A.1181
CALL BOUY_TQ ( BDYLYR6A.1182
& P_FIELD,P1 BDYLYR6A.1183
&,P_POINTS,BL_LEVELS BDYLYR6A.1184
&,P,T,Q,QCF,QCL BDYLYR6A.1185
&,BT,BQ,BT_CLD,BQ_CLD,A_QS,A_DQSDT,DQSDT BDYLYR6A.1186
&,LTIMER BDYLYR6A.1187
& ) BDYLYR6A.1188
BDYLYR6A.1189
BDYLYR6A.1190
!----------------------------------------------------------------------- BDYLYR6A.1191
!! 5.2 Interpolate BT and BQ to half levels. BDYLYR6A.1192
!----------------------------------------------------------------------- BDYLYR6A.1193
BDYLYR6A.1194
CALL BTQ_INT ( BDYLYR6A.1195
& P_FIELD,P1,P_POINTS,BL_LEVELS BDYLYR6A.1196
&,DZL,RDZ,BQ,BT,BQ_CLD,BT_CLD,A_QS,A_DQSDT BDYLYR6A.1197
&,BQM,BTM,BQM_CLD,BTM_CLD,A_QSM,A_DQSDTM BDYLYR6A.1198
&,LTIMER BDYLYR6A.1199
& ) BDYLYR6A.1200
BDYLYR6A.1201
BDYLYR6A.1202
!----------------------------------------------------------------------- BDYLYR6A.1203
!! 5.3 Calculate the diffusion coefficients Km and Kh. BDYLYR6A.1204
!----------------------------------------------------------------------- BDYLYR6A.1205
BDYLYR6A.1206
DO K=1,BL_LEVELS BDYLYR6A.1207
DO I=P1,P1+P_POINTS-1 BDYLYR6A.1208
RHO_FULL(I,K) = BDYLYR6A.1209
& ( AK(K) + BK(K)*PSTAR(I) ) ! Pressure at K BDYLYR6A.1210
& / ! divided by ... BDYLYR6A.1211
& ( R * TV(I,K) ) ! R times TV at K BDYLYR6A.1212
ENDDO BDYLYR6A.1213
ENDDO BDYLYR6A.1214
DO K=2,BL_LEVELS BDYLYR6A.1215
DO I=P1,P1+P_POINTS-1 BDYLYR6A.1216
WKM1 = 0.5 * DZL(I,K-1) * RDZ(I,K) BDYLYR6A.1217
WK = 0.5 * DZL(I,K) * RDZ(I,K) BDYLYR6A.1218
RHO_HALF(I,K) = WK*RHO_FULL(I,K-1) + WKM1*RHO_FULL(I,K) BDYLYR6A.1219
ENDDO BDYLYR6A.1220
ENDDO BDYLYR6A.1221
DO K=2,BL_LEVELS BDYLYR6A.1222
DO I=P1,P1+P_POINTS-1 BDYLYR6A.1223
RHO_UV(I,K) = RHO_HALF(I,K) BDYLYR6A.1224
ENDDO BDYLYR6A.1225
ENDDO BDYLYR6A.1226
DO K=1,BL_LEVELS-1 BDYLYR6A.1227
DO I=P1,P1+P_POINTS-1 BDYLYR6A.1228
RHO_TQ(I,K) = RHO_HALF(I,K+1) BDYLYR6A.1229
ENDDO BDYLYR6A.1230
ENDDO BDYLYR6A.1231
DO I=P1,P1+P_POINTS-1 BDYLYR6A.1232
RHO_HALF(I,1) = RHO_FULL(I,1) BDYLYR6A.1233
RHO_UV(I,1) = RHO_FULL(I,1) BDYLYR6A.1234
RHO_TQ(I,BL_LEVELS) = RHO_FULL(I,BL_LEVELS) BDYLYR6A.1235
ENDDO BDYLYR6A.1236
BDYLYR6A.1237
CALL KMKHZ ( BDYLYR6A.1238
& P_FIELD,P1,P_POINTS,BL_LEVELS, BDYLYR6A.1239
& P,P_HALF,T,Q,QCL,QCF,BT,BQ,CF,DZL, BDYLYR6A.1240
& RDZ,DELTAP,FTL,FQW, BDYLYR6A.1241
& Z0M_EFF_GB,Z_FULL,Z_HALF,Z_UV,Z_TQ,U_S,FB_SURF, BDYLYR6A.1242
& QW,RHOKMZ(1,2),DB(1,2),RHOKHZ(1,2),TL,ZH,TV1_SD,T1_SD,Q1_SD, BDYLYR6A.1243
& NTML,GRAD_T_ADJ,GRAD_Q_ADJ, BDYLYR6A.1244
& BTM,BQM,DQSDT,BTM_CLD,BQM_CLD,A_QSM,A_DQSDTM,RHO_TQ,RHO_UV, BDYLYR6A.1245
& RAD_HR,RADHR_DIM1,CUMULUS,Z_LCL,RHOKM_TOP(1,2),RHOKH_TOP(1,2), ARN0F405.219
& ZHT,BL_TYPE_1,BL_TYPE_2,BL_TYPE_3,BL_TYPE_4,BL_TYPE_5,BL_TYPE_6, ARN0F405.220
& UNSTABLE,NTDSC,DSC, ARN0F405.221
& LTIMER BDYLYR6A.1247
& ) BDYLYR6A.1248
BDYLYR6A.1249
CALL EX_COEF ( BDYLYR6A.1250
& P_FIELD,P1,P_POINTS,BL_LEVELS BDYLYR6A.1251
&,CCB,CCT,NTML,L_MOM BDYLYR6A.1252
&,CCA,DZL,RDZ,DB(1,2),U_P,V_P BDYLYR6A.1253
&,RHO_HALF,ZH,Z_HALF,Z0M,H_BLEND_OROG BDYLYR6A.1254
&,CUMULUS,Z_LCL ARN0F405.222
&,RHOKM,RHOKH BDYLYR6A.1255
&,LTIMER BDYLYR6A.1256
& ) BDYLYR6A.1257
BDYLYR6A.1258
CALL KMKH ( BDYLYR6A.1259
& P_FIELD,P1,P_POINTS,BL_LEVELS BDYLYR6A.1260
&,RHOKM,RHO_KM(1,2),RHOKH BDYLYR6A.1261
&,RHOKMZ(1,2),RHOKHZ(1,2) BDYLYR6A.1262
&,NTML,CUMULUS,RHOKM_TOP(1,2),RHOKH_TOP(1,2) ARN0F405.223
&,UNSTABLE,NTDSC,DSC ARN0F405.224
&,LTIMER BDYLYR6A.1263
& ) BDYLYR6A.1264
BDYLYR6A.1265
! BDYLYR6A.1266
!----------------------------------------------------------------------- BDYLYR6A.1267
!! 5.4 Interpolate RHOKM's and CDR10M to uv points ready for the BDYLYR6A.1268
!! calculation of the explcit fluxes TAU_X and TAU_Y at levels BDYLYR6A.1269
!! above the surface. BDYLYR6A.1270
!----------------------------------------------------------------------- BDYLYR6A.1271
BDYLYR6A.1272
*IF DEF,MPP BDYLYR6A.1273
! RHOKM(*,1) contains duff data in halos. The P_TO_UV can interpolate BDYLYR6A.1274
! this into the real data, so first we must update east/west halos BDYLYR6A.1275
BDYLYR6A.1276
CALL SWAPBOUNDS(RHOKM(P1,1),ROW_LENGTH,N_U_ROWS,1,0,1) BDYLYR6A.1277
CALL SWAPBOUNDS(RHOKM(1,2),ROW_LENGTH, BDYLYR6A.1278
& U_FIELD/ROW_LENGTH,1,1,BL_LEVELS-1) BDYLYR6A.1279
*ENDIF BDYLYR6A.1280
BDYLYR6A.1281
DO K=1,BL_LEVELS BDYLYR6A.1282
BDYLYR6A.1283
*IF -DEF,SCMA AJC1F405.445
CALL P_TO_UV (RHOKM(P1,K),RHOKM_UV(U1+ROW_LENGTH,K), BDYLYR6A.1285
& P_POINTS,U_POINTS,ROW_LENGTH,N_P_ROWS) BDYLYR6A.1286
*IF DEF,MPP BDYLYR6A.1287
IF (attop) THEN BDYLYR6A.1288
*ENDIF BDYLYR6A.1289
DO I=U1,U1+ROW_LENGTH-1 BDYLYR6A.1290
RHOKM_UV(I,K) = 1.0E30 BDYLYR6A.1291
ENDDO BDYLYR6A.1292
*IF DEF,MPP BDYLYR6A.1293
ENDIF BDYLYR6A.1294
BDYLYR6A.1295
IF (atbase) THEN BDYLYR6A.1296
*ENDIF BDYLYR6A.1297
DO I= U1+(N_U_ROWS-1)*ROW_LENGTH, U1+N_U_ROWS*ROW_LENGTH-1 BDYLYR6A.1298
RHOKM_UV(I,K) = 1.0E30 BDYLYR6A.1299
ENDDO BDYLYR6A.1300
*IF DEF,MPP BDYLYR6A.1301
ENDIF BDYLYR6A.1302
*ENDIF BDYLYR6A.1303
BDYLYR6A.1304
*ELSE BDYLYR6A.1305
DO I = P1, P1-1+P_POINTS AJC1F405.446
RHOKM_UV(i,K) = RHOKM(i,K) AJC1F405.447
ENDDO AJC1F405.448
*ENDIF BDYLYR6A.1307
ENDDO ! loop over bl_levels BDYLYR6A.1308
BDYLYR6A.1309
*IF DEF,MPP BDYLYR6A.1310
! CDR10M contains incorrect data in halos. The P_TO_UV can interpolate BDYLYR6A.1311
! this into the real data, so first we must update east/west halos. BDYLYR6A.1312
CALL SWAPBOUNDS(CDR10M(P1),ROW_LENGTH,N_U_ROWS,1,0,1) BDYLYR6A.1313
BDYLYR6A.1314
*ENDIF BDYLYR6A.1315
BDYLYR6A.1316
IF (SU10. OR. SV10)THEN BDYLYR6A.1317
*IF -DEF,SCMA AJC1F405.449
BDYLYR6A.1319
CALL P_TO_UV (CDR10M(P1),CDR10M_UV(U1+ROW_LENGTH),P_POINTS, BDYLYR6A.1320
& U_POINTS,ROW_LENGTH,N_P_ROWS) BDYLYR6A.1321
!----------------------------------------------------------------------- BDYLYR6A.1322
!! Set first and last rows to "missing data indicator" BDYLYR6A.1323
!----------------------------------------------------------------------- BDYLYR6A.1324
*IF DEF,MPP BDYLYR6A.1325
IF (attop) THEN BDYLYR6A.1326
*ENDIF BDYLYR6A.1327
DO I=U1,U1+ROW_LENGTH-1 BDYLYR6A.1328
CDR10M_UV(I) = 1.0E30 BDYLYR6A.1329
ENDDO BDYLYR6A.1330
*IF DEF,MPP BDYLYR6A.1331
ENDIF BDYLYR6A.1332
BDYLYR6A.1333
IF (atbase) THEN BDYLYR6A.1334
*ENDIF BDYLYR6A.1335
DO I= U1+(N_U_ROWS-1)*ROW_LENGTH, U1+N_U_ROWS*ROW_LENGTH-1 BDYLYR6A.1336
CDR10M_UV(I) = 1.0E30 BDYLYR6A.1337
ENDDO BDYLYR6A.1338
*IF DEF,MPP BDYLYR6A.1339
ENDIF BDYLYR6A.1340
*ENDIF BDYLYR6A.1341
BDYLYR6A.1342
*ELSE BDYLYR6A.1343
DO I = P1, P1-1+P_POINTS AJC1F405.450
CDR10M_UV(i) = CDR10M(i) AJC1F405.451
ENDDO AJC1F405.452
*ENDIF BDYLYR6A.1345
ENDIF BDYLYR6A.1346
BDYLYR6A.1347
IF (L_BL_LSPICE) THEN BDYLYR6A.1348
BDYLYR6A.1349
DO K = 1,BL_LEVELS BDYLYR6A.1350
DO I = P1,P1+P_POINTS-1 BDYLYR6A.1351
QW(I,K) = Q(I,K) + QCL(I,K) BDYLYR6A.1352
TL(I,K) = T(I,K) - LCRCP * QCL(I,K) BDYLYR6A.1353
ENDDO BDYLYR6A.1354
ENDDO BDYLYR6A.1355
BDYLYR6A.1356
ENDIF BDYLYR6A.1357
BDYLYR6A.1358
!----------------------------------------------------------------------- BDYLYR6A.1359
!! 5.5 Calculation of explicit fluxes of T,Q BDYLYR6A.1360
!----------------------------------------------------------------------- BDYLYR6A.1361
BDYLYR6A.1362
BDYLYR6A.1363
CALL EX_FLUX_TQ ( BDYLYR6A.1364
& P_POINTS,P_FIELD,P1,BL_LEVELS BDYLYR6A.1365
&, TL,QW,RDZ,FTL,FQW,RHOKH BDYLYR6A.1366
&, RHOKHZ(1,2) ARN0F405.225
&, GRAD_T_ADJ,GRAD_Q_ADJ BDYLYR6A.1367
&, NTML BDYLYR6A.1368
&, LTIMER BDYLYR6A.1369
& ) BDYLYR6A.1370
BDYLYR6A.1371
!----------------------------------------------------------------------- BDYLYR6A.1372
!! 5.6 Calculation of explicit fluxes of U and V. BDYLYR6A.1373
!----------------------------------------------------------------------- BDYLYR6A.1374
BDYLYR6A.1375
BDYLYR6A.1376
CALL EX_FLUX_UV ( ! For U BDYLYR6A.1377
& U_POINTS,U_FIELD,ROW_LENGTH,BL_LEVELS,U1 BDYLYR6A.1378
&, U,U_0,RDZUV(1,2),RHOKM_UV,TAUX BDYLYR6A.1379
&, LTIMER BDYLYR6A.1380
& ) BDYLYR6A.1381
BDYLYR6A.1382
BDYLYR6A.1383
CALL EX_FLUX_UV ( ! For V BDYLYR6A.1384
& U_POINTS,U_FIELD,ROW_LENGTH,BL_LEVELS,U1 BDYLYR6A.1385
&, V,V_0,RDZUV(1,2),RHOKM_UV,TAUY BDYLYR6A.1386
&, LTIMER BDYLYR6A.1387
& ) BDYLYR6A.1388
BDYLYR6A.1389
BDYLYR6A.1390
*IF -DEF,SCMA AJC1F405.453
!----------------------------------------------------------------------- BDYLYR6A.1392
!! Set first and last rows to "missing data indicator" BDYLYR6A.1393
!----------------------------------------------------------------------- BDYLYR6A.1394
DO K=1,BL_LEVELS BDYLYR6A.1395
*IF DEF,MPP BDYLYR6A.1396
IF (attop) THEN BDYLYR6A.1397
*ENDIF BDYLYR6A.1398
DO I=U1,U1+ROW_LENGTH-1 BDYLYR6A.1399
TAUX(I,K)=1.E30 BDYLYR6A.1400
TAUY(I,K)=1.E30 BDYLYR6A.1401
ENDDO BDYLYR6A.1402
*IF DEF,MPP BDYLYR6A.1403
ENDIF BDYLYR6A.1404
BDYLYR6A.1405
IF (atbase) THEN BDYLYR6A.1406
*ENDIF BDYLYR6A.1407
DO I= U1 + (N_U_ROWS-1)*ROW_LENGTH, U1 + N_U_ROWS*ROW_LENGTH -1 BDYLYR6A.1408
TAUX(I,K)=1.E30 BDYLYR6A.1409
TAUY(I,K)=1.E30 BDYLYR6A.1410
ENDDO BDYLYR6A.1411
*IF DEF,MPP BDYLYR6A.1412
ENDIF BDYLYR6A.1413
*ENDIF BDYLYR6A.1414
ENDDO BDYLYR6A.1415
*ENDIF BDYLYR6A.1416
BDYLYR6A.1417
!----------------------------------------------------------------------- BDYLYR6A.1418
!! 6. "Implicit" calculation of increments for TL and QW BDYLYR6A.1419
!----------------------------------------------------------------------- BDYLYR6A.1420
BDYLYR6A.1421
CALL IM_CAL_TQ ( BDYLYR6A.1422
& P_FIELD,P1 BDYLYR6A.1423
&,LAND_INDEX BDYLYR6A.1425
&,LAND_PTS,LAND1 BDYLYR6A.1427
&,P_POINTS,BL_LEVELS,N_TYPES,TILE_FRAC BDYLYR6A.1428
&,ALPHA1_GB,ALPHA1,ASHTF BDYLYR6A.1429
&,DTRDZ,DTRDZ_RML,RHOKH(1,2),RDZ BDYLYR6A.1430
&,ICE_FRACT,LYING_SNOW,RADNET_C,RESFT_TILE,RHOKPM_TILE APA1F405.374
&,RHOKPM_POT_TILE ANG1F405.89
&,TIMESTEP,LAND_MASK BDYLYR6A.1432
&,EPOT,EPOT_TILE ANG1F405.90
&,FQW,FQW_TILE,FTL,FTL_TILE,E_SEA,H_SEA,DQW_NT,QW ANG1F405.91
&,GAMMA,RHOKE,RHOKH(1,1),DTL_NT,TL BDYLYR6A.1434
&,SURF_HT_FLUX,NRML BDYLYR6A.1435
&,LTIMER BDYLYR6A.1436
&) BDYLYR6A.1437
BDYLYR6A.1438
BDYLYR6A.1439
!----------------------------------------------------------------------- BDYLYR6A.1440
!! 6.1 Convert FTL to sensible heat flux in Watts per square metre. BDYLYR6A.1441
! Also, IMPL_CAL only updates FTL_TILE(*,1) and FQW_TILE(*,1) BDYLYR6A.1442
! over sea points, so copy this to remaining tiles BDYLYR6A.1443
!----------------------------------------------------------------------- BDYLYR6A.1444
BDYLYR6A.1445
DO K=1,BL_LEVELS BDYLYR6A.1446
Cfpp$ Select(CONCUR) BDYLYR6A.1447
DO I=P1,P1+P_POINTS-1 BDYLYR6A.1448
FTL(I,K) = FTL(I,K)*CP BDYLYR6A.1449
ENDDO BDYLYR6A.1450
ENDDO BDYLYR6A.1451
BDYLYR6A.1452
DO ITILE=1,N_TYPES BDYLYR6A.1453
DO I=P1,P1+P_POINTS-1 BDYLYR6A.1454
IF(LAND_MASK(I)) THEN BDYLYR6A.1455
FTL_TILE(I,ITILE) = FTL_TILE(I,ITILE)*CP BDYLYR6A.1456
ELSE BDYLYR6A.1457
FTL_TILE(I,ITILE) = FTL(I,1) BDYLYR6A.1458
FQW_TILE(I,ITILE) = FQW_TILE(I,1) BDYLYR6A.1459
ENDIF BDYLYR6A.1460
ENDDO BDYLYR6A.1461
ENDDO BDYLYR6A.1462
BDYLYR6A.1463
!----------------------------------------------------------------------- BDYLYR6A.1464
!! Diagnose surface temperature and increment sub-surface temperatures BDYLYR6A.1465
!! for land and sea-ice. BDYLYR6A.1466
!----------------------------------------------------------------------- BDYLYR6A.1467
BDYLYR6A.1468
!----------------------------------------------------------------------- BDYLYR6A.1469
!! Sea-ice (P241, routine SICE_HTF). BDYLYR6A.1470
!----------------------------------------------------------------------- BDYLYR6A.1471
BDYLYR6A.1472
CALL SICE_HTF( BDYLYR6A.1473
& ASHTF,DI,ICE_FRACT,SURF_HT_FLUX(1,1),TIMESTEP, BDYLYR6A.1474
& LAND_MASK,P_FIELD,P_POINTS,P1,TI,TSTAR,ASURF, BDYLYR6A.1475
& SEA_ICE_HTF,LTIMER BDYLYR6A.1476
&) BDYLYR6A.1477
BDYLYR6A.1478
!----------------------------------------------------------------------- BDYLYR6A.1479
!! Diagnose the land surface temperature (previously in SOIL_HTF) BDYLYR6A.1480
!----------------------------------------------------------------------- BDYLYR6A.1481
BDYLYR6A.1482
BDYLYR6A.1483
DO I=LAND1,LAND1+LAND_PTS-1 BDYLYR6A.1489
J = LAND_INDEX(I) BDYLYR6A.1490
TSTAR(J)=0.0 BDYLYR6A.1491
ENDDO BDYLYR6A.1492
BDYLYR6A.1494
BDYLYR6A.1495
DO ITILE=1,N_TYPES BDYLYR6A.1496
DO J=P1,P1+P_POINTS-1 BDYLYR6A.1512
IF (.NOT. LAND_MASK(J)) TSTAR_TILE(J,ITILE)=TSTAR(J) BDYLYR6A.1513
ENDDO BDYLYR6A.1514
BDYLYR6A.1515
DO I=LAND1,LAND1+LAND_PTS-1 BDYLYR6A.1516
J = LAND_INDEX(I) BDYLYR6A.1517
TSTAR_TILE(J,ITILE) = T_SOIL(I,1) + SURF_HT_FLUX(J,ITILE) BDYLYR6A.1518
& / ASHTF(J) BDYLYR6A.1519
TSTAR(J)=TSTAR(J)+TSTAR_TILE(J,ITILE)*TILE_FRAC(J,ITILE) BDYLYR6A.1520
ENDDO BDYLYR6A.1521
ENDDO ! tile loop BDYLYR6A.1523
BDYLYR6A.1524
!----------------------------------------------------------------------- BDYLYR6A.1525
!! 7. Surface evaporation components and updating of surface BDYLYR6A.1526
!! temperature (P245, routine SF_EVAP). BDYLYR6A.1527
!! The following diagnostics are also calculated, as requested :- BDYLYR6A.1528
!! Heat flux due to melting of sea-ice; specific humidity at 1.5 BDYLYR6A.1529
!! metres; temperature at 1.5 metres. BDYLYR6A.1530
!----------------------------------------------------------------------- BDYLYR6A.1531
BDYLYR6A.1532
CALL SF_EVAP ( BDYLYR6A.1533
& P_FIELD,P1,N_TYPES,LAND_FIELD,LAND1,GAMMA, BDYLYR6A.1534
& P_POINTS,BL_LEVELS,LAND_MASK,LAND_PTS,LAND_INDEX, BDYLYR6A.1538
& TILE_FRAC,ALPHA1,ASURF,ASHTF,CANOPY,CATCH_TILE, BDYLYR6A.1540
& DTRDZ,DTRDZ_RML,E_SEA,FRACA, BDYLYR6A.1541
& ICE_FRACT,NRML,RHOKH_TILE,SMC,TIMESTEP,CER1P5M,CHR1P5M, BDYLYR6A.1542
& PSTAR,RESFS,RESFT_TILE,Z0M,Z0H,SQ1P5,ST1P5,SIMLT,SMLT, BDYLYR6A.1543
& FTL,FTL_TILE,FQW,FQW_TILE,LYING_SNOW,QW,SURF_HT_FLUX, BDYLYR6A.1544
& TL,TSTAR_TILE,TSTAR,TI,ECAN,ES,EI, BDYLYR6A.1545
& SICE_MLT_HTF,SNOMLT_SURF_HTF,SNOWMELT, BDYLYR6A.1546
& H_BLEND,HEAT_BLEND_FACTOR,QCL(1,1),QCF(1,1),Z1, ARN0F405.226
& Q1P5M,T1P5M,LTIMER BDYLYR6A.1548
& ) BDYLYR6A.1549
BDYLYR6A.1550
BDYLYR6A.1551
!7.1 Copy T and Q from workspace to INOUT space. BDYLYR6A.1552
BDYLYR6A.1553
DO K=1,BL_LEVELS BDYLYR6A.1554
Cfpp$ Select(CONCUR) BDYLYR6A.1555
DO I=P1,P1+P_POINTS-1 BDYLYR6A.1556
T(I,K)=TL(I,K) BDYLYR6A.1557
Q(I,K)=QW(I,K) BDYLYR6A.1558
ENDDO BDYLYR6A.1559
ENDDO BDYLYR6A.1560
BDYLYR6A.1561
C----------------------------------------------------------------------- APA1F405.375
C Diagnose the true value of the surface soil heat flux over land points APA1F405.376
C----------------------------------------------------------------------- APA1F405.377
DO ITILE=1,N_TYPES APA1F405.378
DO I=LAND1,LAND1+LAND_PTS-1 APA1F405.379
J = LAND_INDEX(I) APA1F405.380
SURF_HT_FLUX(J,ITILE) = SURF_HT_FLUX(J,ITILE) APA1F405.381
+ - CANCAP(J,ITILE) * APA1F405.382
+ (TSTAR_TILE(J,ITILE) - T_SOIL(I,1)) / TIMESTEP APA1F405.383
ENDDO APA1F405.384
ENDDO APA1F405.385
DO ITILE=1,N_TYPES BDYLYR6A.1562
DO I=P1,P1+P_POINTS-1 BDYLYR6A.1563
SURF_HT_FLUX_GB(I) = SURF_HT_FLUX_GB(I) + TILE_FRAC(I,ITILE)* BDYLYR6A.1564
& SURF_HT_FLUX(I,ITILE) BDYLYR6A.1565
ENDDO BDYLYR6A.1566
ENDDO BDYLYR6A.1567
BDYLYR6A.1568
!----------------------------------------------------------------------- BDYLYR6A.1569
!! 8 "Implicit" calculation of increments for U and V. BDYLYR6A.1570
!----------------------------------------------------------------------- BDYLYR6A.1571
BDYLYR6A.1572
BDYLYR6A.1573
CALL IM_CAL_UV ( ! For U BDYLYR6A.1574
& U_FIELD,U1 BDYLYR6A.1575
&,U_POINTS,BL_LEVELS,ROW_LENGTH BDYLYR6A.1576
&,GAMMA BDYLYR6A.1577
&,RHOKM_UV(1,2) BDYLYR6A.1578
&,U,U_0,TIMESTEP BDYLYR6A.1579
&,RHOKM_UV(1,1),DU_NT,DU BDYLYR6A.1580
&,DTRDZ_UV,RDZUV(1,2),TAUX BDYLYR6A.1581
&,LTIMER BDYLYR6A.1582
&) BDYLYR6A.1583
BDYLYR6A.1584
BDYLYR6A.1585
CALL IM_CAL_UV ( ! For V BDYLYR6A.1586
& U_FIELD,U1 BDYLYR6A.1587
&,U_POINTS,BL_LEVELS,ROW_LENGTH BDYLYR6A.1588
&,GAMMA BDYLYR6A.1589
&,RHOKM_UV(1,2) BDYLYR6A.1590
&,V,V_0,TIMESTEP BDYLYR6A.1591
&,RHOKM_UV(1,1),DV_NT,DV BDYLYR6A.1592
&,DTRDZ_UV,RDZUV(1,2),TAUY BDYLYR6A.1593
&,LTIMER BDYLYR6A.1594
& ) BDYLYR6A.1595
BDYLYR6A.1596
BDYLYR6A.1597
!---------------------------------------------------------------------- BDYLYR6A.1598
!! 8.1 Update U_V. BDYLYR6A.1599
!---------------------------------------------------------------------- BDYLYR6A.1600
BDYLYR6A.1601
BDYLYR6A.1602
DO K=1,BL_LEVELS BDYLYR6A.1603
*IF -DEF,SCMA AJC1F405.454
DO I=U1+ROW_LENGTH,U1+U_POINTS-ROW_LENGTH-1 BDYLYR6A.1605
*ELSE BDYLYR6A.1606
DO I=1,U_POINTS BDYLYR6A.1607
*ENDIF BDYLYR6A.1608
U(I,K) = U(I,K) + DU(I,K) BDYLYR6A.1609
V(I,K) = V(I,K) + DV(I,K) BDYLYR6A.1610
ENDDO BDYLYR6A.1611
ENDDO BDYLYR6A.1612
BDYLYR6A.1613
! U component of 10m wind BDYLYR6A.1614
IF (SU10)THEN BDYLYR6A.1615
*IF -DEF,SCMA AJC1F405.455
DO I=U1+ROW_LENGTH,U1+U_POINTS-ROW_LENGTH-1 BDYLYR6A.1617
*ELSE BDYLYR6A.1618
DO I=1,U_POINTS BDYLYR6A.1619
*ENDIF BDYLYR6A.1620
U10M(I) = (U(I,1) -U_0(I))*CDR10M_UV(I) + U_0(I) BDYLYR6A.1621
ENDDO BDYLYR6A.1622
ENDIF BDYLYR6A.1623
BDYLYR6A.1624
! V component of 10m wind BDYLYR6A.1625
IF (SV10)THEN BDYLYR6A.1626
*IF -DEF,SCMA AJC1F405.456
DO I=U1+ROW_LENGTH,U1+U_POINTS-ROW_LENGTH-1 BDYLYR6A.1628
*ELSE BDYLYR6A.1629
DO I=1,U_POINTS BDYLYR6A.1630
*ENDIF BDYLYR6A.1631
V10M(I) = (V(I,1) -V_0(I))*CDR10M_UV(I) + V_0(I) BDYLYR6A.1632
ENDDO BDYLYR6A.1633
ENDIF BDYLYR6A.1634
BDYLYR6A.1635
!----------------------------------------------------------------------- BDYLYR6A.1636
!! 9. Calculate diagnostics BDYLYR6A.1637
! 9.1 Surface latent heat flux. BDYLYR6A.1638
!----------------------------------------------------------------------- BDYLYR6A.1639
BDYLYR6A.1640
IF (SLH) THEN BDYLYR6A.1641
DO I=P1,P1+P_POINTS-1 BDYLYR6A.1642
LATENT_HEAT(I) = LC*FQW(I,1) + LF*EI(I) BDYLYR6A.1643
ENDDO BDYLYR6A.1644
ENDIF BDYLYR6A.1645
!----------------------------------------------------------------------- BDYLYR6A.1646
! 9.2 Diagnose the soil evaporation, the transpiration and the water BDYLYR6A.1647
! extracted from each soil layer BDYLYR6A.1648
!----------------------------------------------------------------------- BDYLYR6A.1649
DO ITILE=1,N_TYPES BDYLYR6A.1675
DO N=1,SM_LEVELS BDYLYR6A.1676
DO I=LAND1,LAND1+LAND_PTS-1 BDYLYR6A.1677
J = LAND_INDEX(I) BDYLYR6A.1678
EXT(I,N)=EXT(I,N) + WT_EXT(I,N) * (1-F_SE(J,ITILE))* BDYLYR6A.1679
& ES(J,ITILE) * TILE_FRAC(J,ITILE) BDYLYR6A.1680
BDYLYR6A.1681
ENDDO ! land_points BDYLYR6A.1682
ENDDO ! sm_levels BDYLYR6A.1683
BDYLYR6A.1684
CDIR$ IVDEP BDYLYR6A.1685
! Fujitsu vectorization directive GRB0F405.195
!OCL NOVREC GRB0F405.196
DO I=LAND1,LAND1+LAND_PTS-1 BDYLYR6A.1686
J = LAND_INDEX(I) BDYLYR6A.1687
ESOIL(J,ITILE)=F_SE(J,ITILE)*ES(J,ITILE) BDYLYR6A.1688
ETRAN(J,ITILE)=(1-F_SE(J,ITILE))*ES(J,ITILE) BDYLYR6A.1689
EXT(I,1)=EXT(I,1)+ESOIL(J,ITILE)*TILE_FRAC(J,ITILE) BDYLYR6A.1690
ES_GB(J)=ES_GB(J)+ES(J,ITILE)*TILE_FRAC(J,ITILE) BDYLYR6A.1691
ENDDO BDYLYR6A.1692
ENDDO ! Tile loop BDYLYR6A.1693
BDYLYR6A.1695
!----------------------------------------------------------------------- BDYLYR6A.1696
! 10 Set RHOKH, the coefficients required for tracer mixing. BDYLYR6A.1697
! Required 5B and after due to change in contents of RHOKH in rest BDYLYR6A.1698
! of routine. BDYLYR6A.1699
!----------------------------------------------------------------------- BDYLYR6A.1700
BDYLYR6A.1701
DO I=P1,P1+P_POINTS-1 BDYLYR6A.1702
RHOKH(I,1) = GAMMA(1)*RHOKH(I,1) BDYLYR6A.1703
ENDDO BDYLYR6A.1704
DO K = 2,BL_LEVELS BDYLYR6A.1705
DO I=P1,P1+P_POINTS-1 BDYLYR6A.1706
RHOKH(I,K) = GAMMA(K)*RHOKH(I,K)*RDZ(I,K) BDYLYR6A.1707
ENDDO BDYLYR6A.1708
ENDDO BDYLYR6A.1709
BDYLYR6A.1710
999 CONTINUE ! Branch for error exit. BDYLYR6A.1711
BDYLYR6A.1712
IF (LTIMER) THEN BDYLYR6A.1713
CALL TIMER('BDYLAYR ',4) BDYLYR6A.1714
ENDIF BDYLYR6A.1715
BDYLYR6A.1716
RETURN BDYLYR6A.1717
END BDYLYR6A.1718
*ENDIF BDYLYR6A.1719