*IF DEF,A03_5A BDYLYR5A.2
C *****************************COPYRIGHT****************************** BDYLYR5A.3
C (c) CROWN COPYRIGHT 1996, METEOROLOGICAL OFFICE, All Rights Reserved. BDYLYR5A.4
C BDYLYR5A.5
C Use, duplication or disclosure of this code is subject to the BDYLYR5A.6
C restrictions as set forth in the contract. BDYLYR5A.7
C BDYLYR5A.8
C Meteorological Office BDYLYR5A.9
C London Road BDYLYR5A.10
C BRACKNELL BDYLYR5A.11
C Berkshire UK BDYLYR5A.12
C RG12 2SZ BDYLYR5A.13
C BDYLYR5A.14
C If no contract has been raised with this copy of the code, the use, BDYLYR5A.15
C duplication or disclosure of it is strictly prohibited. Permission BDYLYR5A.16
C to do so must first be obtained in writing from the Head of Numerical BDYLYR5A.17
C Modelling at the above address. BDYLYR5A.18
C ******************************COPYRIGHT****************************** BDYLYR5A.19
C*LL SUBROUTINE BDY_LAYR----------------------------------------------- BDYLYR5A.20
CLL BDYLYR5A.21
CLL Purpose: Calculate turbulent fluxes of heat, moisture and momentum BDYLYR5A.22
CLL between (a) surface and atmosphere, (b) atmospheric levels BDYLYR5A.23
CLL within the boundary layer, and/or the effects of these BDYLYR5A.24
CLL fluxes on the primary model variables. The flux of heat BDYLYR5A.25
CLL into and through the soil is also modelled. Numerous BDYLYR5A.26
CLL related diagnostics are also calculated. BDYLYR5A.27
CLL F E Hewer, July 1990: removed call to LS_CLD. BDYLYR5A.36
CLL This version passes out liquid/frozen water temperature in BDYLYR5A.37
CLL array "T" (TL), and total water content in array "Q" (QW). BDYLYR5A.38
CLL These may be converted to T and Q respectively by calling BDYLYR5A.39
CLL the large scale cloud routine, LS_CLD. BDYLYR5A.40
CLL F E Hewer, August 1990: land point data stored BDYLYR5A.41
CLL on land points only (dimension: LAND_FIELD, arrays:CANOPY, CATCH BDYLYR5A.42
CLL HCAP, HCON, RESIST, ROOTDEP, SMC, SMVCCL, SMVCWT, T_SOIL) BDYLYR5A.43
CLL Arrays whose elements may contain values over both sea and land BDYLYR5A.44
CLL points are compressed onto land points for land calculations if BDYLYR5A.45
CLL defined variable IBM is NOT selected. RHOKM,RHOKH redefined as BDYLYR5A.46
CLL workspace. BDYLYR5A.47
CLL BDYLYR5A.48
CLL Suitable for single column use AJC1F405.458
CLL BDYLYR5A.50
CLL Model Modification history: BDYLYR5A.51
CLL version Date BDYLYR5A.52
CLL BDYLYR5A.53
CLL 4.1 5/6/96 New deck. C.Bunton BDYLYR5A.54
CLL 4.2 Oct. 96 T3E migration - *DEF CRAY removed GSS2F402.285
CLL S J Swarbrick GSS2F402.286
CLL 4.3 04/02/97 Logical switches L_MOM and L_MIXLEN passed down ARN1F403.39
CLL to KHKH and thence EXCOEF. ARN1F403.40
CLL R.N.B.Smith ARN1F403.41
CLL 4.3 15/05/97 By-pass calls to HEAT_CON and SMC_ROOT when land ARR0F403.28
CLL points=0 to prevent occasional failures with ARR0F403.29
CLL MPP. R.Rawlins. ARR0F403.30
CLL BDYLYR5A.55
CLL ARN1F403.42
CLL 4.3 28/04/97 Some fields not fully initialised. GSM4F403.1
CLL 4.4 16/10/97 Minor initialisation bug. S.D.Mullerworth GSM1F404.44
CLL SD Mullerworth GSM4F403.2
CLL ADM3F404.57
CLL 4.4 08/09/97 L_BL_LSPICE specifies mixed phase precipitation ADM3F404.58
CLL scheme. D.Wilson ADM3F404.59
CLL 4.5 Jul. 98 Kill the IBM specific lines. (JCThil) AJC1F405.457
CLL GSM4F403.3
CLL Programming standard: Unified Model Documentation Paper No 4, BDYLYR5A.56
CLL Version ?, dated ?. BDYLYR5A.57
CLL BDYLYR5A.58
CLL System component covered: P24. BDYLYR5A.59
CLL BDYLYR5A.60
CLL Project task: BDYLYR5A.61
CLL BDYLYR5A.62
CLL Documentation: UMDP 24. BDYLYR5A.63
CLL BDYLYR5A.64
CLL--------------------------------------------------------------------- BDYLYR5A.65
C* BDYLYR5A.66
C*L--------------------------------------------------------------------- BDYLYR5A.67
C Arguments :- BDYLYR5A.68
SUBROUTINE BDY_LAYR ( 4,80BDYLYR5A.69
BDYLYR5A.70
C IN values defining field dimensions and subset to be processed : BDYLYR5A.71
+ P_FIELD,U_FIELD,LAND_FIELD BDYLYR5A.72
+,P_ROWS,FIRST_ROW,N_ROWS,ROW_LENGTH BDYLYR5A.73
BDYLYR5A.74
C IN values defining vertical grid of model atmosphere : BDYLYR5A.75
+,BL_LEVELS,P_LEVELS,AK,BK,AKH,BKH,DELTA_AK,DELTA_BK BDYLYR5A.76
+,EXNER BDYLYR5A.77
BDYLYR5A.78
C IN soil/vegetation/land surface data : BDYLYR5A.79
+,LAND_MASK,GATHER,LAND_INDEX BDYLYR5A.83
+,ST_LEVELS,SM_LEVELS,CANOPY,CATCH,HCON BDYLYR5A.84
+,LYING_SNOW,RESIST,ROOTD,SMVCCL,SMVCST,SMVCWT BDYLYR5A.86
+,STHF,STHU,VFRAC,Z0V,SIL_OROG_LAND,L_Z0_OROG,HO2R2_OROG BDYLYR5A.87
+,HT,LAI BDYLYR5A.88
BDYLYR5A.89
C IN sea/sea-ice data : BDYLYR5A.90
+,DI,ICE_FRACT,U_0,V_0 BDYLYR5A.91
BDYLYR5A.92
C IN cloud data : BDYLYR5A.93
+,CF,QCF,QCL BDYLYR5A.94
+,CCA,CCB,CCT BDYLYR5A.95
BDYLYR5A.96
C IN everything not covered so far : BDYLYR5A.97
+,CO2_MMR,PHOTOSYNTH_ACT_RAD,PSTAR,RADNET,TIMESTEP BDYLYR5A.98
+,L_RMBL,L_BL_LSPICE,L_MOM,L_MIXLEN ADM3F404.60
BDYLYR5A.100
C INOUT data : BDYLYR5A.101
+,Q,GC,T,T_SOIL,TI,TSTAR,U,V,Z0MSEA BDYLYR5A.102
BDYLYR5A.103
C OUT Diagnostic not requiring STASH flags : BDYLYR5A.104
&,CD,CH,E_SEA,EPOT,ETRAN,FQW,FSMC,FTL,H_SEA,RHOKH,RHOKM,RIB ANG1F405.61
+,SEA_ICE_HTF,SURF_HT_FLUX BDYLYR5A.106
+,TAUX,TAUY,VSHR BDYLYR5A.107
BDYLYR5A.108
C OUT diagnostic requiring STASH flags : BDYLYR5A.109
+,FME,SICE_MLT_HTF,SNOMLT_SURF_HTF,LATENT_HEAT BDYLYR5A.110
+,Q1P5M,T1P5M,U10M,V10M BDYLYR5A.111
C (IN) STASH flags :- BDYLYR5A.112
+,SFME,SIMLT,SMLT,SLH,SQ1P5,ST1P5,SU10,SV10 BDYLYR5A.113
BDYLYR5A.114
C OUT data required for tracer mixing : BDYLYR5A.115
&,RHO_ARESIST,ARESIST,RESIST_B BDYLYR5A.116
&,NRML BDYLYR5A.117
BDYLYR5A.118
C OUT data required for 4D-VAR : BDYLYR5A.119
&,RHO_CD_MODV1,RHO_KM BDYLYR5A.120
BDYLYR5A.121
C OUT data required elsewhere in UM system : BDYLYR5A.122
+,ECAN,EI,ES,EXT,SNOWMELT,ZH BDYLYR5A.123
+,GPP,NPP,RESP_P BDYLYR5A.124
+,T1_SD,Q1_SD,ERROR BDYLYR5A.125
C LOGICAL LTIMER BDYLYR5A.126
+,LTIMER BDYLYR5A.127
*IF DEF,SCMA AJC0F405.42
& ,FACTOR_RHOKH,OBS AJC0F405.43
*ENDIF AJC0F405.44
+) BDYLYR5A.128
IMPLICIT NONE BDYLYR5A.129
C BDYLYR5A.130
C Inputs :- BDYLYR5A.131
C BDYLYR5A.132
C (a) Defining horizontal grid and subset thereof to be processed. BDYLYR5A.133
C BDYLYR5A.134
INTEGER BDYLYR5A.135
+ P_FIELD ! IN No. of P-points in whole grid BDYLYR5A.136
C ! (for dimensioning only). BDYLYR5A.137
+,U_FIELD ! IN No. of UV-points in whole grid. BDYLYR5A.141
C ! (Checked for consistency with BDYLYR5A.143
C ! P_FIELD and P_ROWS; there must BDYLYR5A.144
C ! be 1 less UV than P row.) BDYLYR5A.145
+,LAND_FIELD ! IN No.of land points in whole grid. BDYLYR5A.149
C ! (Checked for consistency with BDYLYR5A.151
C ! P_FIELD ) BDYLYR5A.152
+,P_ROWS ! IN No. of P-rows in whole grid BDYLYR5A.157
C ! (for dimensioning only). BDYLYR5A.158
+,FIRST_ROW ! IN First row of data to be treated, BDYLYR5A.162
C ! referred to P-grid (must be > 1 BDYLYR5A.164
C ! since "polar" rows are never BDYLYR5A.165
C ! treated). BDYLYR5A.166
+,N_ROWS ! IN No. of rows of data to be BDYLYR5A.170
C ! treated, referred to P-grid. BDYLYR5A.171
C ! FIRST_ROW+N_ROWS-1 must be less BDYLYR5A.173
C ! than P_ROWS, since "polar" rows BDYLYR5A.174
C ! are never treated. BDYLYR5A.175
+,ROW_LENGTH ! IN No. of points in one row. BDYLYR5A.179
C ! (Checked for consistency with BDYLYR5A.181
C ! P_FIELD and N_ROWS.) BDYLYR5A.182
C BDYLYR5A.186
C (b) Defining vertical grid of model atmosphere. BDYLYR5A.187
C BDYLYR5A.188
INTEGER BDYLYR5A.189
+ BL_LEVELS ! IN Max. no. of "boundary" levels BDYLYR5A.190
C ! allowed.Assumed <= 30 for dim- BDYLYR5A.191
C ! sioning of GAMMA in common deck BDYLYR5A.192
C ! C_GAMMA used in SF_EXCH and KMKH BDYLYR5A.193
+,P_LEVELS ! IN Total no. of vertical levels in BDYLYR5A.194
C ! the model atmosphere. BDYLYR5A.195
REAL BDYLYR5A.196
+ AK(P_LEVELS) ! IN Hybrid 'A' for all levels. BDYLYR5A.197
+,BK(P_LEVELS) ! IN Hybrid 'B' for all levels. BDYLYR5A.198
+,AKH(P_LEVELS+1) ! IN Hybrid 'A' for layer interfaces. BDYLYR5A.199
+,BKH(P_LEVELS+1) ! IN Hybrid 'B' for layer interfaces. BDYLYR5A.200
+,DELTA_AK(P_LEVELS) ! IN Difference of hybrid 'A' across BDYLYR5A.201
C ! layers (K-1/2 to K+1/2). BDYLYR5A.202
C ! NB: Upper minus lower. BDYLYR5A.203
+,DELTA_BK(P_LEVELS) ! IN Difference of hybrid 'B' across BDYLYR5A.204
C ! layers (K-1/2 to K+1/2). BDYLYR5A.205
C ! NB: Upper minus lower. BDYLYR5A.206
+,EXNER(P_FIELD,BL_LEVELS+1) ! IN Exner function. EXNER(,K) is BDYLYR5A.207
C ! value for LOWER BOUNDARY of BDYLYR5A.208
C ! level K. BDYLYR5A.209
C BDYLYR5A.210
C (c) Soil/vegetation/land surface parameters (mostly constant). BDYLYR5A.211
C BDYLYR5A.212
LOGICAL BDYLYR5A.213
+ LAND_MASK(P_FIELD) ! IN T if land, F elsewhere. BDYLYR5A.214
+,GATHER ! IN T if gather to sea-ice points BDYLYR5A.215
C ! in SF_EXCH. Saves a lot of un- BDYLYR5A.216
C ! necessary calculations if there BDYLYR5A.217
C ! are relatively few sea-ice points BDYLYR5A.218
+,L_RMBL ! IN T to use rapidly mixing boundary BDYLYR5A.219
C ! scheme in IMPL_CAL BDYLYR5A.220
&,L_BL_LSPICE ! IN ADM3F404.61
! TRUE Use scientific treatment of mixed ADM3F404.62
! phase precip scheme. ADM3F404.63
! FALSE Do not use mixed phase precip ADM3F404.64
! considerations ADM3F404.65
+,L_Z0_OROG ! IN T to use orog.roughness BDYLYR5A.221
C ! treatment in SF_EXCH BDYLYR5A.222
&,L_MOM ! IN Switch for convective momentum ARN1F403.44
C ! transport. ARN1F403.45
&,L_MIXLEN ! IN Switch for reducing the turbulent ARN1F403.46
C ! mixing length above the top of the ARN1F403.47
C ! boundary layer. ARN1F403.48
C ARN1F403.49
INTEGER BDYLYR5A.224
+ LAND_INDEX(P_FIELD) ! IN LAND_INDEX(I)=J => the Jth BDYLYR5A.225
C ! point in P_FIELD is the Ith BDYLYR5A.226
C ! land point. BDYLYR5A.227
BDYLYR5A.228
INTEGER BDYLYR5A.230
+ ST_LEVELS ! IN No. of deep soil temp. levels BDYLYR5A.231
+,SM_LEVELS ! IN No. of soil moisture levels BDYLYR5A.232
REAL BDYLYR5A.233
+ CANOPY(LAND_FIELD) ! IN Surface/canopy water (kg per sq m) BDYLYR5A.234
+,CATCH(LAND_FIELD) ! IN Surface/canopy water capacity BDYLYR5A.235
C ! (kg per sq m). BDYLYR5A.236
C ! Must be global for coupled model, BDYLYR5A.238
C ! ie dimension P_FIELD not LAND_FIEL BDYLYR5A.239
+,HCON(LAND_FIELD) ! IN Soil thermal conductivity excludin BDYLYR5A.241
C ! the effects of water and ice (W/m/ BDYLYR5A.242
+,HT(LAND_FIELD) ! IN Canopy height (m) BDYLYR5A.243
+,LAI(LAND_FIELD) ! IN Leaf area index. BDYLYR5A.244
+,LYING_SNOW(P_FIELD) ! IN Lying snow (kg/sq m). BDYLYR5A.245
+,RESIST(LAND_FIELD) ! IN Fixed surface resistance to BDYLYR5A.246
C ! evaporation (s/m). BDYLYR5A.247
+,ROOTD(LAND_FIELD) ! IN Depth of active soil layer ("root BDYLYR5A.248
C ! depth") (metres). BDYLYR5A.249
+,SMVCCL(LAND_FIELD) ! IN Critical volumetric SMC (cubic m BDYLYR5A.250
C ! per cubic m of soil). BDYLYR5A.251
+,SMVCST(LAND_FIELD) ! IN Volumetric saturation point (cubic BDYLYR5A.252
C ! per cubic m of soil). BDYLYR5A.253
+,SMVCWT(LAND_FIELD) ! IN Volumetric wilting point (cubic m BDYLYR5A.254
C ! per cubic m of soil). BDYLYR5A.255
+,STHF(LAND_FIELD,SM_LEVELS)! IN Frozen soil moisture content of BDYLYR5A.256
C ! each layer as a fraction of BDYLYR5A.257
C ! saturation. BDYLYR5A.258
+,STHU(LAND_FIELD,SM_LEVELS)! IN Unfrozen soil moisture content of BDYLYR5A.259
C ! each layer as a fraction of BDYLYR5A.260
C ! saturation. BDYLYR5A.261
+,VFRAC(LAND_FIELD) ! IN Vegetation fraction. BDYLYR5A.262
+,Z0V(P_FIELD) ! IN Vegetative roughness length (m). BDYLYR5A.263
C ! NB:UM uses same storage for Z0MSEA BDYLYR5A.264
C ! so for sea points this is INOUT. BDYLYR5A.265
+,SIL_OROG_LAND(LAND_FIELD) ! IN Silhouette area of unresolved BDYLYR5A.266
C ! orography per unit horizontal area BDYLYR5A.267
C ! on land points only. BDYLYR5A.268
+,HO2R2_OROG(LAND_FIELD) ! IN Standard Deviation of orography. BDYLYR5A.269
C ! equivilent to peak to trough BDYLYR5A.270
C ! height of unresolved orography BDYLYR5A.271
C ! devided by 2SQRT(2) on land BDYLYR5A.272
C ! points only (m) BDYLYR5A.273
C BDYLYR5A.274
C (d) Sea/sea-ice data. BDYLYR5A.275
C BDYLYR5A.276
REAL BDYLYR5A.277
+ DI(P_FIELD) ! IN "Equivalent thickness" of sea-ice BDYLYR5A.278
C ! (m). BDYLYR5A.279
+,ICE_FRACT(P_FIELD) ! IN Fraction of gridbox covered by BDYLYR5A.280
C ! sea-ice (decimal fraction). BDYLYR5A.281
+,U_0(U_FIELD) ! IN W'ly component of surface current BDYLYR5A.282
C ! (metres per second). BDYLYR5A.283
+,V_0(U_FIELD) ! IN S'ly component of surface current BDYLYR5A.284
C ! (metres per second). BDYLYR5A.285
C BDYLYR5A.286
C (e) Cloud data. BDYLYR5A.287
C BDYLYR5A.288
REAL BDYLYR5A.289
+ CF(P_FIELD,BL_LEVELS) ! IN Cloud fraction (decimal). BDYLYR5A.290
+,QCF(P_FIELD,BL_LEVELS) ! IN Cloud ice (kg per kg air) BDYLYR5A.291
+,QCL(P_FIELD,BL_LEVELS) ! IN Cloud liquid water (kg BDYLYR5A.292
C ! per kg air). BDYLYR5A.293
+,CCA(P_FIELD) ! IN Convective Cloud Amount (decimal). BDYLYR5A.294
INTEGER BDYLYR5A.295
+ CCB(P_FIELD) ! IN Convective Cloud Base BDYLYR5A.296
+,CCT(P_FIELD) ! IN Convective Cloud Top BDYLYR5A.297
C BDYLYR5A.298
C (f) Atmospheric + any other data not covered so far, incl control. BDYLYR5A.299
C BDYLYR5A.300
REAL BDYLYR5A.301
+ CO2_MMR ! IN CO2 Mass Mixing Ratio BDYLYR5A.302
*IF DEF,SCMA AJC0F405.45
& ,FACTOR_RHOKH(P_FIELD) ! IN Factor for modifying surface AJC0F405.46
! fluxes if OBS forcing used AJC0F405.47
*ENDIF AJC0F405.48
+,PHOTOSYNTH_ACT_RAD(P_FIELD) ! IN Net downward shortwave radiation BDYLYR5A.303
C ! in band 1 (w/m2). BDYLYR5A.304
+,PSTAR(P_FIELD) ! IN Surface pressure (Pascals). BDYLYR5A.305
+,RADNET(P_FIELD) ! IN Surface net radiation (W/sq m, BDYLYR5A.306
C ! positive downwards). BDYLYR5A.307
+,TIMESTEP ! IN Timestep (seconds). BDYLYR5A.308
C BDYLYR5A.309
LOGICAL LTIMER ! Logical switch for TIMER diags BDYLYR5A.310
*IF DEF,SCMA AJC0F405.49
LOGICAL OBS ! IN flag for Observational AJC0F405.50
! diagnostics for SCM AJC0F405.51
*ENDIF AJC0F405.52
C BDYLYR5A.311
C STASH flags :- BDYLYR5A.312
C BDYLYR5A.313
LOGICAL BDYLYR5A.314
+ SFME ! IN Flag for FME (q.v.). BDYLYR5A.315
+,SIMLT ! IN Flag for SICE_MLT_HTF (q.v.) BDYLYR5A.316
+,SMLT ! IN Flag for SNOMLT_SURF_HTF (q.v.) BDYLYR5A.317
+,SLH ! IN Flag for LATENT_HEAT (q.v.) BDYLYR5A.318
+,SQ1P5 ! IN Flag for Q1P5M (q.v.) BDYLYR5A.319
+,ST1P5 ! IN Flag for T1P5M (q.v.) BDYLYR5A.320
+,SU10 ! IN Flag for U10M (q.v.) BDYLYR5A.321
+,SV10 ! IN Flag for V10M (q.v.) BDYLYR5A.322
C BDYLYR5A.323
C In/outs :- BDYLYR5A.324
C BDYLYR5A.325
REAL BDYLYR5A.326
+ Q(P_FIELD,BL_LEVELS) ! INOUT Input:specific humidity BDYLYR5A.327
C ! ( kg water per kg air). BDYLYR5A.328
C ! Output:total water content BDYLYR5A.329
C ! (Q)(kg water per kg air). BDYLYR5A.330
+,GC(LAND_FIELD) ! INOUT "Stomatal" conductance to BDYLYR5A.331
C ! evaporation (m/s). BDYLYR5A.332
+,T(P_FIELD,BL_LEVELS) ! INOUT Input:atmospheric temp(K) BDYLYR5A.333
C ! Output:liquid/frozen water BDYLYR5A.334
C ! temperature (TL) (K) BDYLYR5A.335
+,T_SOIL(LAND_FIELD,ST_LEVELS) ! INOUT Soil temperatures (K). BDYLYR5A.336
+,TI(P_FIELD) ! INOUT Sea-ice surface layer BDYLYR5A.337
C ! temperature (K). BDYLYR5A.338
+,TSTAR(P_FIELD) ! INOUT Surface temperature (K). BDYLYR5A.339
+,U(U_FIELD,BL_LEVELS) ! INOUT W'ly wind component BDYLYR5A.340
C ! (metres per second). BDYLYR5A.341
+,V(U_FIELD,BL_LEVELS) ! INOUT S'ly wind component BDYLYR5A.342
C ! (metres per second). BDYLYR5A.343
+,Z0MSEA(P_FIELD) ! INOUT Sea-surface roughness BDYLYR5A.344
C ! length for momentum (m). BDYLYR5A.345
C ! NB: same storage is used BDYLYR5A.346
C ! for Z0V, so the intent is BDYLYR5A.347
C ! IN for land points. BDYLYR5A.348
C BDYLYR5A.349
C Outputs :- BDYLYR5A.350
C BDYLYR5A.351
C-1 Diagnostic (or effectively so - includes coupled model requisites):- BDYLYR5A.352
C BDYLYR5A.353
C (a) Calculated anyway (use STASH space from higher level) :- BDYLYR5A.354
C BDYLYR5A.355
REAL BDYLYR5A.356
+ CD(P_FIELD) ! OUT Turbulent surface exchange (bulk BDYLYR5A.357
C ! transfer) coefficient for BDYLYR5A.358
C ! momentum. BDYLYR5A.359
+,CH(P_FIELD) ! OUT Turbulent surface exchange (bulk BDYLYR5A.360
C ! transfer) coefficient for heat BDYLYR5A.361
C ! and/or moisture. BDYLYR5A.362
+,E_SEA(P_FIELD) ! OUT Evaporation from sea times leads BDYLYR5A.363
C ! fraction. Zero over land. BDYLYR5A.364
C ! (kg per square metre per sec). BDYLYR5A.365
&,EPOT(P_FIELD) ! OUT potential evaporation (kg/m2/s). ANG1F405.62
+,FQW(P_FIELD,BL_LEVELS) ! OUT Moisture flux between layers BDYLYR5A.366
C ! (kg per square metre per sec). BDYLYR5A.367
C ! FQW(,1) is total water flux BDYLYR5A.368
C ! from surface, 'E'. BDYLYR5A.369
&,FSMC(LAND_FIELD) ! OUT soil moisture availability. ANG1F405.63
+,FTL(P_FIELD,BL_LEVELS) ! OUT FTL(,K) contains net turbulent BDYLYR5A.370
C ! sensible heat flux into layer K BDYLYR5A.371
C ! from below; so FTL(,1) is the BDYLYR5A.372
C ! surface sensible heat, H. (W/m2) BDYLYR5A.373
+,H_SEA(P_FIELD) ! OUT Surface sensible heat flux over BDYLYR5A.374
C ! sea times leads fraction. (W/m2) BDYLYR5A.375
+,RHOKH(P_FIELD,BL_LEVELS) ! OUT Exchange coeffs for moisture. BDYLYR5A.376
C ! Surface:out of SF_EXCH containing BDYLYR5A.377
C ! GAMMA(1)*RHOKH,after IMPL_CAL BDYLYR5A.378
C ! contains only RHOKH. BDYLYR5A.379
C ! Above surface:out of KMKH cont- BDYLYR5A.380
C ! aining GAMMA(1)*RHOKH(,1)*RDZ(,1) BDYLYR5A.381
+,RHOKM(U_FIELD,BL_LEVELS) ! OUT Exchange coefficients for BDYLYR5A.382
C ! momentum (on UV-grid, with 1st BDYLYR5A.383
C ! and last rows undefined (or, at BDYLYR5A.384
C ! present, set to "missing data")). BDYLYR5A.385
C ! Surface:out of SF_EXCH containing BDYLYR5A.386
C ! GAMMA(1)*RHOKH,after IMPL_CAL BDYLYR5A.387
C ! contains only RHOKH. BDYLYR5A.388
C ! Above surface:out of KMKH cont- BDYLYR5A.389
C ! aining GAMMA(1)*RHOKH(,1)*RDZ(,1) BDYLYR5A.390
+,RIB(P_FIELD) ! OUT Bulk Richardson number for lowest BDYLYR5A.391
C ! layer. BDYLYR5A.392
+,SEA_ICE_HTF(P_FIELD) ! OUT Heat flux through sea-ice (W per BDYLYR5A.393
C ! sq m, positive downwards). BDYLYR5A.394
+,SURF_HT_FLUX(P_FIELD) ! OUT Net downward heat flux at surface BDYLYR5A.395
C ! over land or sea-ice fraction of BDYLYR5A.396
C ! gridbox (W/m2). BDYLYR5A.397
+,TAUX(U_FIELD,BL_LEVELS) ! OUT W'ly component of surface wind BDYLYR5A.398
C ! stress (N/sq m).(On UV-grid with BDYLYR5A.399
C ! first and last rows undefined or BDYLYR5A.400
C ! at present, set to 'missing data' BDYLYR5A.401
+,TAUY(U_FIELD,BL_LEVELS) ! OUT S'ly component of surface wind BDYLYR5A.402
C ! stress (N/sq m). On UV-grid; BDYLYR5A.403
C ! comments as per TAUX. BDYLYR5A.404
+,VSHR(P_FIELD) ! OUT Magnitude of surface-to-lowest BDYLYR5A.405
C ! atm level wind shear (m per s). BDYLYR5A.406
C BDYLYR5A.407
&,RHO_CD_MODV1(P_FIELD) ! OUT Surface air density * drag coef.* BDYLYR5A.408
C ! mod(v1 - v0) before interpolation BDYLYR5A.409
&,RHO_KM(P_FIELD,2:BL_LEVELS) ! OUT Air density * turbulent mixing BDYLYR5A.410
C ! coefficient for momentum before BDYLYR5A.411
C ! interpolation. BDYLYR5A.412
&,RHO_ARESIST(P_FIELD) ! OUT RHOSTAR*CD_STD*VSHR for SULPHUR c BDYLYR5A.413
&,ARESIST(P_FIELD) ! OUT 1/(CD_STD*VSHR) for Sulphur cycle BDYLYR5A.414
&,RESIST_B(P_FIELD) ! OUT (1/CH-1/(CD_STD)/VSHR for Sulpur BDYLYR5A.415
BDYLYR5A.416
INTEGER BDYLYR5A.417
& NRML(P_FIELD) ! OUT Number of model layers in the BDYLYR5A.418
C ! Rapidly Mixing Layer; diagnosed BDYLYR5A.419
C ! in SF_EXCH and KMKH and used in BDYLYR5A.420
C ! IMPL_CAL, SF_EVAP and TR_MIX. BDYLYR5A.421
C BDYLYR5A.422
C (b) Not passed between lower-level routines (not in workspace at this BDYLYR5A.423
C level) :- BDYLYR5A.424
C BDYLYR5A.425
REAL BDYLYR5A.426
+ FME(P_FIELD) ! OUT Wind mixing "power" (W per sq m). BDYLYR5A.427
+,SICE_MLT_HTF(P_FIELD) ! OUT Heat flux due to melting of sea- BDYLYR5A.428
C ! ice (Watts per sq metre). BDYLYR5A.429
+,SNOMLT_SURF_HTF(P_FIELD) ! OUT Heat flux required for surface BDYLYR5A.430
C ! melting of snow (W/m2). BDYLYR5A.431
+,LATENT_HEAT(P_FIELD) ! OUT Surface latent heat flux, +ve BDYLYR5A.432
C ! upwards (Watts per sq m). BDYLYR5A.433
+,Q1P5M(P_FIELD) ! OUT Q at 1.5 m (kg water per kg air). BDYLYR5A.434
+,T1P5M(P_FIELD) ! OUT T at 1.5 m (K). BDYLYR5A.435
+,U10M(U_FIELD) ! OUT U at 10 m (m per s). BDYLYR5A.436
+,V10M(U_FIELD) ! OUT V at 10 m (m per s). BDYLYR5A.437
C BDYLYR5A.438
C-2 Genuinely output, needed by other atmospheric routines :- BDYLYR5A.439
C BDYLYR5A.440
REAL BDYLYR5A.441
+ EI(P_FIELD) ! OUT Sublimation from lying snow or sea-ice BDYLYR5A.442
C ! (kg per sq m per sec). BDYLYR5A.443
+,ECAN(P_FIELD) ! OUT Gridbox mean evaporation from canopy/surface BDYLYR5A.444
C ! store (kg per sq m per s). Zero over sea. BDYLYR5A.445
+,ES(P_FIELD) ! OUT Surface evapotranspiration through a BDYLYR5A.446
C ! resistance which is not entirely aerodynamic BDYLYR5A.447
C ! i.e. "soil evaporation". Always non- BDYLYR5A.448
C ! negative. Kg per sq m per sec. BDYLYR5A.449
+,ETRAN(P_FIELD) ! OUT Transpiration (kg/m2/s). BDYLYR5A.450
+,EXT(LAND_FIELD,SM_LEVELS) BDYLYR5A.451
C ! OUT Extraction of water from each soil layer BDYLYR5A.452
C ! (kg/m2/s). BDYLYR5A.453
+,GPP(LAND_FIELD)! OUT Gross primary productivity (kg C/m2/s). BDYLYR5A.454
+,NPP(LAND_FIELD)! OUT Net primary productivity (kg C/m2/s). BDYLYR5A.455
+,RESP_P(LAND_FIELD) BDYLYR5A.456
C ! OUT Plant respiration (kg C/m2/s). BDYLYR5A.457
+,SNOWMELT(P_FIELD) ! OUT Snowmelt (kg/m2/s). BDYLYR5A.458
+,ZH(P_FIELD) ! OUT Height above surface of top of boundary BDYLYR5A.459
C ! layer (metres). BDYLYR5A.460
&,T1_SD(P_FIELD) ! OUT Standard deviation of turbulent fluctuations BDYLYR5A.461
C ! of layer 1 temperature; for use in BDYLYR5A.462
C ! initiating convection. BDYLYR5A.463
&,Q1_SD(P_FIELD) ! OUT Standard deviation of turbulent fluctuations BDYLYR5A.464
C ! of layer 1 humidity; for use in initiating BDYLYR5A.465
C ! convection. BDYLYR5A.466
INTEGER BDYLYR5A.467
+ ERROR ! OUT 0 - AOK; BDYLYR5A.468
C ! 1 to 7 - bad grid definition detected; BDYLYR5A.470
C ! 11 - error in SF_EXCH; BDYLYR5A.474
C ! 21 - error in KMKH; BDYLYR5A.475
C ! 31 - error in IMPL_CAL; BDYLYR5A.476
C*---------------------------------------------------------------------- BDYLYR5A.477
C*L--------------------------------------------------------------------- BDYLYR5A.478
C External routines called :- BDYLYR5A.479
C BDYLYR5A.480
EXTERNAL Z,SICE_HTF,SF_EXCH,KMKH,IMPL_CAL,SF_EVAP BDYLYR5A.481
EXTERNAL TIMER BDYLYR5A.482
*IF -DEF,SCMA AJC1F405.459
EXTERNAL UV_TO_P BDYLYR5A.484
*ENDIF BDYLYR5A.485
C*---------------------------------------------------------------------- BDYLYR5A.486
C*L--------------------------------------------------------------------- BDYLYR5A.487
C Symbolic constants (parameters) reqd in top-level routine :- BDYLYR5A.488
C BDYLYR5A.489
*CALL C_R_CP 
BDYLYR5A.490
*CALL C_LHEAT BDYLYR5A.491
*CALL SOIL_THICK BDYLYR5A.492
C*---------------------------------------------------------------------- BDYLYR5A.493
C BDYLYR5A.494
C Workspace :- BDYLYR5A.495
C BDYLYR5A.496
REAL BDYLYR5A.591
+ ALPHA1(P_FIELD) ! WORK Gradient of saturated BDYLYR5A.592
C ! specific humidity with BDYLYR5A.593
C ! respect to temperature between BDYLYR5A.594
C ! the bottom model layer and the BDYLYR5A.595
C ! surface BDYLYR5A.596
+,ASHTF(P_FIELD) ! WORK Coefficient to calculate surface BDYLYR5A.597
C ! heat flux into soil or sea-ice. BDYLYR5A.598
+,ASURF(P_FIELD) ! WORK Reciprocal areal heat capacity BDYLYR5A.599
C ! of soil layer or sea-ice BDYLYR5A.600
C ! surface layer (K m**2 / J). BDYLYR5A.601
+,BQ_1(P_FIELD) ! WORK A buoyancy parameter for the BDYLYR5A.602
C ! lowest atmospheric level. BDYLYR5A.603
+,BT_1(P_FIELD) ! WORK A buoyancy parameter for the BDYLYR5A.604
C ! lowest atmospheric level. BDYLYR5A.605
&,BF_1(P_FIELD) ADM3F404.66
! WORK A bouyancy parameter for the lowest atmospheric level ADM3F404.67
+,DQW_1(P_FIELD) ! WORK Increment for QW(,1). BDYLYR5A.606
+,DTRDZ(P_FIELD,BL_LEVELS) ! WORK -g.dt/dp for model layers. BDYLYR5A.607
+,DTRDZ_RML(P_FIELD) ! WORK -g.dt/dp for the rapidly BDYLYR5A.608
C ! mixing layer. BDYLYR5A.609
+,DZL(P_FIELD,BL_LEVELS) ! WORK DZL(,K) is depth in m of layer BDYLYR5A.610
C ! K, i.e. distance from boundary BDYLYR5A.611
C ! K-1/2 to boundary K+1/2. BDYLYR5A.612
+,ESOIL(P_FIELD) ! WORK Evaporation from bare soil (kg/m2 BDYLYR5A.613
+,FRACA(P_FIELD) ! WORK Fraction of surface moisture flux BDYLYR5A.614
C ! with only aerodynamic resistance. BDYLYR5A.615
+,F_SE(P_FIELD) ! WORK Fraction of the evapotranspiratio BDYLYR5A.616
C ! which is bare soil evaporation. BDYLYR5A.617
+,HCONS(LAND_FIELD) ! WORK Soil thermal conductivity includi BDYLYR5A.618
C ! the effects of water and ice (W/m BDYLYR5A.619
+,QW(P_FIELD,BL_LEVELS) ! WORK Total water content, but BDYLYR5A.620
C ! replaced by specific humidity BDYLYR5A.621
C ! in LS_CLD. BDYLYR5A.622
+,RESFS(P_FIELD) ! WORK Combined soil, stomatal BDYLYR5A.623
C ! and aerodynamic resistance BDYLYR5A.624
C ! factor = PSIS/(1+RS/RA) for BDYLYR5A.625
C ! fraction (1-FRACA) BDYLYR5A.626
+,RESFT(P_FIELD) ! WORK Total resistance factor BDYLYR5A.627
C ! FRACA+(1-FRACA)*RESFS. BDYLYR5A.628
+,RHOKE(P_FIELD) ! WORK Surface exchange coefficient for BDYLYR5A.629
C ! FQW. BDYLYR5A.630
+,RHOKPM(P_FIELD) ! WORK Surface exchange coeff. BDYLYR5A.631
&,RHOKPM_POT(P_FIELD) ! WORK Surface exchange coeff. for ANG1F405.64
! potential evaporation ANG1F405.65
+,RDZ(P_FIELD,BL_LEVELS) ! WORK RDZ(,1) is the reciprocal BDYLYR5A.632
C ! of the height of level 1, i.e. BDYLYR5A.633
C ! of the middle of layer 1. For BDYLYR5A.634
C ! K > 1, RDZ(,K) is the BDYLYR5A.635
C ! reciprocal of the vertical BDYLYR5A.636
C ! distance from level K-1 to BDYLYR5A.637
C ! level K. BDYLYR5A.638
+,SMC(LAND_FIELD) ! WORK Soil moisture content (kg/m2). BDYLYR5A.639
+,TL(P_FIELD,BL_LEVELS) ! WORK Ice/liquid water temperature, BDYLYR5A.640
C ! but replaced by T in LS_CLD. BDYLYR5A.641
+,TV_RDZUV(P_FIELD,BL_LEVELS) ! WORK Virtual temp at start (TV). BDYLYR5A.642
C ! RDZ (K > 1) on UV-grid. BDYLYR5A.643
C ! Comments as per RHOKM (RDZUV). BDYLYR5A.644
+,U_P(P_FIELD,BL_LEVELS) ! WORK U on P-grid. BDYLYR5A.645
+,V_P(P_FIELD,BL_LEVELS) ! WORK V on P-grid. BDYLYR5A.646
+,V_ROOT(LAND_FIELD) ! WORK Volumetric soil moisture BDYLYR5A.647
C ! concentration in the rootzone BDYLYR5A.648
C ! (m3 H2O/m3 soil). BDYLYR5A.649
+,V_SOIL(LAND_FIELD) ! WORK Volumetric soil moisture BDYLYR5A.650
C ! concentration in the top BDYLYR5A.651
C ! soil layer (m3 H2O/m3 soil). BDYLYR5A.652
+,WT_EXT(LAND_FIELD,SM_LEVELS)! WORK Fraction of transpiration whic BDYLYR5A.653
C ! extracted from each soil layer. BDYLYR5A.654
+,ZLB(P_FIELD,0:BL_LEVELS) ! WORK ZLB(,K) is the height of the BDYLYR5A.655
C ! upper boundary of layer K BDYLYR5A.656
C ! ( = 0.0 for "K=0"). BDYLYR5A.657
REAL BDYLYR5A.658
+ Z0H(P_FIELD) ! WORK Roughness length for heat and BDYLYR5A.659
C ! moisture. BDYLYR5A.660
+,Z0M(P_FIELD) ! WORK Roughness length for momentum. BDYLYR5A.661
+,Z1(P_FIELD) ! WORK Height of lowest level (i.e. BDYLYR5A.662
C ! height of middle of lowest BDYLYR5A.663
C ! layer). BDYLYR5A.664
+,H_BLEND(P_FIELD) ! WORK Blending height used as part of BDYLYR5A.665
C ! effective roughness scheme BDYLYR5A.666
+,Z0M_EFF(P_FIELD) ! WORK Effective roughness length for BDYLYR5A.667
C ! momentum BDYLYR5A.668
REAL BDYLYR5A.669
+ CDR10M(U_FIELD) ! WORK Ratio of CD's reqd for BDYLYR5A.670
C ! calculation of 10 m wind. BDYLYR5A.671
C ! On UV-grid; comments as per BDYLYR5A.672
C ! RHOKM. BDYLYR5A.673
+,CER1P5M(P_FIELD) ! WORK Ratio of coefficients reqd for BDYLYR5A.674
C ! calculation of 1.5 m Q. BDYLYR5A.675
+,CHR1P5M(P_FIELD) ! WORK Ratio of coefficients reqd for BDYLYR5A.676
C ! calculation of 1.5 m T. BDYLYR5A.677
C APA1F405.322
C Variables for Vegetation Thermal Canopy APA1F405.323
C APA1F405.324
REAL APA1F405.325
+ CANCAP(P_FIELD) ! WORK Volumetric heat capacity of APA1F405.326
C ! vegetation canopy (J/Kg/m3). APA1F405.327
+,RADNET_C(P_FIELD) ! WORK Adjusted net radiation for APA1F405.328
C ! vegetation canopy over land APA1F405.329
C ! (W/m2). APA1F405.330
BDYLYR5A.678
INTEGER BDYLYR5A.679
+ F_TYPE(LAND_FIELD) ! WORK Plant functional type: BDYLYR5A.680
C ! 1 - Broadleaf Tree BDYLYR5A.681
C ! 2 - Needleleaf Tree BDYLYR5A.682
C ! 3 - C3 Grass BDYLYR5A.683
C ! 4 - C4 Grass BDYLYR5A.684
C BDYLYR5A.686
C Local scalars :- BDYLYR5A.687
C BDYLYR5A.688
INTEGER BDYLYR5A.689
+ ERR ! LOCAL Return codes from lower-level routines. BDYLYR5A.690
+,I,J,L ! LOCAL Loop counter (horizontal field index). BDYLYR5A.691
+,K,N ! LOCAL Loop counter (vertical level index). BDYLYR5A.692
+,N_P_ROWS ! LOCAL No of P-rows being processed. BDYLYR5A.693
+,N_U_ROWS ! LOCAL No of UV-rows being processed. BDYLYR5A.694
+,P_POINTS ! LOCAL No of P-points being processed. BDYLYR5A.695
+,P1 ! LOCAL First P-point to be processed. BDYLYR5A.696
+,LAND1 ! LOCAL First land-point to be processed. BDYLYR5A.697
C ! 1 <= LAND1 <= LAND_FIELD BDYLYR5A.698
+,LAND_PTS ! LOCAL No of land points being processed. BDYLYR5A.699
+,U_POINTS ! LOCAL No of UV-points being processed. BDYLYR5A.700
+,U1 ! LOCAL First UV-point to be processed. BDYLYR5A.701
BDYLYR5A.702
C----------------------------------------------------------------------- BDYLYR5A.703
C Functional Type dependent parameters BDYLYR5A.704
C----------------------------------------------------------------------- BDYLYR5A.705
INTEGER BDYLYR5A.706
+ R_LAYERS(4) ! Number of soil layers from which BDYLYR5A.707
! water can be extracted BDYLYR5A.708
C----------------------------------------------------------------------- BDYLYR5A.709
C BT NT C3G C4G BDYLYR5A.710
C----------------------------------------------------------------------- BDYLYR5A.711
DATA R_LAYERS/ 4, 4, 3, 3 / BDYLYR5A.712
BDYLYR5A.713
IF (LTIMER) THEN BDYLYR5A.714
CALL TIMER('BDYLAYR ',3) BDYLYR5A.715
ENDIF BDYLYR5A.716
ERROR = 0 BDYLYR5A.717
C----------------------------------------------------------------------- APA1F405.331
C Initialise RADNET_C to be the same as RADNET over all points APA1F405.332
C----------------------------------------------------------------------- APA1F405.333
DO I=1,P_FIELD APA1F405.334
RADNET_C(I) = RADNET(I) APA1F405.335
ENDDO APA1F405.336
APA1F405.337
*IF -DEF,SCMA AJC1F405.460
C BDYLYR5A.719
C----------------------------------------------------------------------- BDYLYR5A.720
CL 0. Verify grid/subset definitions. Arakawa 'B' grid with P-rows at BDYLYR5A.721
CL extremes is assumed. Extreme-most P-rows are ignored; extreme- BDYLYR5A.722
CL most UV-rows are used only for interpolation and are not updated. BDYLYR5A.723
C----------------------------------------------------------------------- BDYLYR5A.724
C BDYLYR5A.725
IF ( BL_LEVELS.LT.1 .OR. ST_LEVELS.LT.1 .OR. SM_LEVELS.LT.1 BDYLYR5A.726
& .OR. P_ROWS.LT.3 ) THEN BDYLYR5A.727
ERROR = 1 BDYLYR5A.728
GOTO999 BDYLYR5A.729
*IF -DEF,MPP BDYLYR5A.730
ELSEIF ( U_FIELD .NE. (P_ROWS-1)*ROW_LENGTH ) THEN BDYLYR5A.731
*ELSE BDYLYR5A.732
ELSEIF ( U_FIELD .NE. P_ROWS*ROW_LENGTH ) THEN BDYLYR5A.733
*ENDIF BDYLYR5A.734
ERROR = 2 BDYLYR5A.735
GOTO999 BDYLYR5A.736
ELSEIF ( P_FIELD .NE. P_ROWS*ROW_LENGTH ) THEN BDYLYR5A.737
ERROR = 3 BDYLYR5A.738
GOTO999 BDYLYR5A.739
ELSEIF ( FIRST_ROW.LE.1 .OR. FIRST_ROW.GE.P_ROWS ) THEN BDYLYR5A.740
ERROR = 4 BDYLYR5A.741
GOTO999 BDYLYR5A.742
ELSEIF ( N_ROWS.LE.0 ) THEN BDYLYR5A.743
ERROR = 5 BDYLYR5A.744
GOTO999 BDYLYR5A.745
*IF -DEF,MPP BDYLYR5A.746
ELSEIF ( (FIRST_ROW+N_ROWS) .GT. P_ROWS ) THEN BDYLYR5A.747
*ELSE BDYLYR5A.748
ELSEIF ( (FIRST_ROW+N_ROWS-1) .GT. P_ROWS ) THEN BDYLYR5A.749
*ENDIF BDYLYR5A.750
ERROR = 6 BDYLYR5A.751
GOTO999 BDYLYR5A.752
ELSEIF ( LAND_FIELD.GT.P_FIELD ) THEN BDYLYR5A.753
ERROR = 7 BDYLYR5A.754
GOTO999 BDYLYR5A.755
ENDIF BDYLYR5A.756
C BDYLYR5A.757
C----------------------------------------------------------------------- BDYLYR5A.758
CL Set pointers, etc. BDYLYR5A.759
C----------------------------------------------------------------------- BDYLYR5A.760
C BDYLYR5A.761
N_P_ROWS=N_ROWS BDYLYR5A.762
N_U_ROWS=N_ROWS+1 BDYLYR5A.763
BDYLYR5A.764
P_POINTS=N_P_ROWS*ROW_LENGTH BDYLYR5A.765
U_POINTS=N_U_ROWS*ROW_LENGTH BDYLYR5A.766
BDYLYR5A.767
P1=1+(FIRST_ROW-1)*ROW_LENGTH BDYLYR5A.768
U1=1+(FIRST_ROW-2)*ROW_LENGTH BDYLYR5A.769
C BDYLYR5A.770
C----------------------------------------------------------------------- BDYLYR5A.771
CL Set compressed land point pointers. BDYLYR5A.772
C----------------------------------------------------------------------- BDYLYR5A.773
C BDYLYR5A.774
LAND1=0 BDYLYR5A.775
DO 1 I=1,P1+P_POINTS-1 BDYLYR5A.776
IF (LAND_INDEX(I).GE.P1) THEN BDYLYR5A.777
LAND1 = I BDYLYR5A.778
GOTO2 BDYLYR5A.779
ENDIF BDYLYR5A.780
1 CONTINUE BDYLYR5A.781
2 CONTINUE BDYLYR5A.782
LAND_PTS=0 BDYLYR5A.783
DO 3 I=P1,P1+P_POINTS-1 BDYLYR5A.784
IF (LAND_MASK(I)) LAND_PTS = LAND_PTS + 1 BDYLYR5A.785
3 CONTINUE BDYLYR5A.786
*ELSE BDYLYR5A.787
C AJC1F405.461
C--------------------------------------------------------------------- AJC1F405.462
CL 0. Check grid definition arguments. AJC1F405.463
C--------------------------------------------------------------------- AJC1F405.464
C AJC1F405.465
IF ( BL_LEVELS.LT.1 AJC1F405.466
& .OR. ST_LEVELS.LT.1 .OR.SM_LEVELS.LT.1 ) THEN AJC1F405.467
ERROR = 1 AJC1F405.468
GOTO999 AJC1F405.469
ELSEIF ( U_FIELD .NE. P_ROWS*ROW_LENGTH ) THEN AJC1F405.470
ERROR = 2 AJC1F405.471
GOTO999 AJC1F405.472
ELSEIF ( P_FIELD .NE. P_ROWS*ROW_LENGTH ) THEN AJC1F405.473
ERROR = 3 AJC1F405.474
GOTO999 AJC1F405.475
ELSEIF ( N_ROWS.LE.0 ) THEN AJC1F405.476
ERROR = 5 AJC1F405.477
GOTO999 AJC1F405.478
ELSEIF ( LAND_FIELD.GT.P_FIELD ) THEN AJC1F405.479
ERROR = 7 AJC1F405.480
GOTO999 AJC1F405.481
ENDIF AJC1F405.482
C AJC1F405.483
C--------------------------------------------------------------------- AJC1F405.484
CL Set pointers, etc. AJC1F405.485
C--------------------------------------------------------------------- AJC1F405.486
C AJC1F405.487
N_P_ROWS=N_ROWS AJC1F405.488
N_U_ROWS=N_ROWS AJC1F405.489
AJC1F405.490
P_POINTS=N_P_ROWS*ROW_LENGTH AJC1F405.491
U_POINTS=N_U_ROWS*ROW_LENGTH AJC1F405.492
AJC1F405.493
P1 = 1 AJC1F405.494
U1 = 1 AJC1F405.495
C AJC1F405.496
C--------------------------------------------------------------------- AJC1F405.497
CL Set compressed land point pointers. AJC1F405.498
C--------------------------------------------------------------------- AJC1F405.499
C AJC1F405.500
LAND1=0 AJC1F405.501
DO 1 I=1,P1+P_POINTS-1 AJC1F405.502
IF (LAND_INDEX(I).GE.P1) THEN AJC1F405.503
LAND1 = I AJC1F405.504
GOTO2 AJC1F405.505
ENDIF AJC1F405.506
1 CONTINUE AJC1F405.507
2 CONTINUE AJC1F405.508
LAND_PTS=0 AJC1F405.509
DO 3 I=P1,P1+P_POINTS-1 AJC1F405.510
IF (LAND_MASK(I)) LAND_PTS = LAND_PTS + 1 AJC1F405.511
3 CONTINUE AJC1F405.512
*ENDIF BDYLYR5A.818
BDYLYR5A.819
!----------------------------------------------------------------------- BDYLYR5A.820
! Diagnose the plant functional types at each location. BDYLYR5A.821
! Assume : Broadleaf Trees if rootdepth > 0.8m BDYLYR5A.822
! C3 Grass if rootdepth < 0.8m BDYLYR5A.823
!----------------------------------------------------------------------- BDYLYR5A.824
DO L=1,LAND_FIELD BDYLYR5A.825
IF (ROOTD(L).GT.0.8) THEN BDYLYR5A.826
F_TYPE(L)=1 BDYLYR5A.827
ELSE BDYLYR5A.828
F_TYPE(L)=3 BDYLYR5A.829
ENDIF BDYLYR5A.830
ENDDO BDYLYR5A.831
BDYLYR5A.832
IF(LAND_FIELD.GT.0) THEN ! Omit if no land points ARR0F403.31
!----------------------------------------------------------------------- BDYLYR5A.833
! Calculate the thermal conductivity of the top soil layer. BDYLYR5A.834
!----------------------------------------------------------------------- BDYLYR5A.835
CALL HEAT_CON (LAND_FIELD,HCON,STHU,STHF,SMVCST,HCONS,LTIMER) BDYLYR5A.836
BDYLYR5A.837
!----------------------------------------------------------------------- BDYLYR5A.838
! Calculate the soil moisture in the root zone. BDYLYR5A.839
!----------------------------------------------------------------------- BDYLYR5A.840
CALL SMC_ROOT (LAND_FIELD,SM_LEVELS,F_TYPE,DZSOIL,ROOTD,STHU, APA1F405.338
& VFRAC,SMVCST,SMVCWT,SMC,V_ROOT,V_SOIL,WT_EXT,LTIMER) APA1F405.339
ENDIF ! End test on land points ARR0F403.32
BDYLYR5A.843
C BDYLYR5A.844
C----------------------------------------------------------------------- BDYLYR5A.845
CL 1. Perform calculations in what the documentation describes as BDYLYR5A.846
CL subroutine Z_DZ. In fact, a separate subroutine isn't used. BDYLYR5A.847
C----------------------------------------------------------------------- BDYLYR5A.848
C BDYLYR5A.849
CL 1.1 Initialise ZLB(,0) (to zero, of course, this being the height BDYLYR5A.850
CL of the surface above the surface). BDYLYR5A.851
C BDYLYR5A.852
DO 4 I=P1,P1+P_POINTS-1 BDYLYR5A.853
ZLB(I,0)=0.0 BDYLYR5A.854
4 CONTINUE BDYLYR5A.855
C BDYLYR5A.856
CL 1.2 Calculate layer depths and heights, and construct wind fields on BDYLYR5A.857
CL P-grid. This involves calling subroutines Z and UV_TO_P. BDYLYR5A.858
CL Virtual temperature is also calculated, as a by-product. BDYLYR5A.859
C BDYLYR5A.860
C NB RDZ TEMPORARILY used to return DELTA_Z_LOWER, the lower half layer BDYLYR5A.861
C thickness BDYLYR5A.862
C BDYLYR5A.863
DO 5 K=1,BL_LEVELS BDYLYR5A.864
CALL Z(P_POINTS,EXNER(P1,K),EXNER(P1,K+1),PSTAR(P1), BDYLYR5A.865
+ AKH(K),BKH(K),Q(P1,K),QCF(P1,K), BDYLYR5A.866
+ QCL(P1,K),T(P1,K),ZLB(P1,K-1),TV_RDZUV(P1,K), BDYLYR5A.867
+ ZLB(P1,K),DZL(P1,K),RDZ(P1,K),LTIMER) BDYLYR5A.868
*IF -DEF,SCMA AJC1F405.513
CALL UV_TO_P(U(U1,K),U_P(P1,K), BDYLYR5A.870
+ U_POINTS,P_POINTS,ROW_LENGTH,N_U_ROWS) BDYLYR5A.871
CALL UV_TO_P(V(U1,K),V_P(P1,K), BDYLYR5A.872
+ U_POINTS,P_POINTS,ROW_LENGTH,N_U_ROWS) BDYLYR5A.873
*ELSE BDYLYR5A.874
DO I = P1, P1-1+P_POINTS AJC1F405.514
U_P(i,K) = U(i,K) AJC1F405.515
V_P(i,K) = V(i,K) AJC1F405.516
ENDDO AJC1F405.517
*ENDIF BDYLYR5A.877
5 CONTINUE BDYLYR5A.878
DO 61 K=BL_LEVELS,2,-1 BDYLYR5A.879
DO 62 I=P1,P1+P_POINTS-1 BDYLYR5A.880
RDZ(I,K)=1.0/(RDZ(I,K)+(DZL(I,K-1)-RDZ(I,K-1))) BDYLYR5A.881
62 CONTINUE BDYLYR5A.882
61 CONTINUE BDYLYR5A.883
DO 6 I=P1,P1+P_POINTS-1 BDYLYR5A.884
Z1(I)=RDZ(I,1) BDYLYR5A.885
RDZ(I,1)=1.0/RDZ(I,1) BDYLYR5A.886
6 CONTINUE BDYLYR5A.887
C BDYLYR5A.888
C BDYLYR5A.889
C----------------------------------------------------------------------- BDYLYR5A.890
CL 3. Calls to SICE_HTF now after IMPL_CAL BDYLYR5A.891
C----------------------------------------------------------------------- BDYLYR5A.892
C BDYLYR5A.893
C BDYLYR5A.894
C----------------------------------------------------------------------- BDYLYR5A.895
CL 4. Surface turbulent exchange coefficients and "explicit" fluxes BDYLYR5A.896
CL (P243a, routine SF_EXCH). BDYLYR5A.897
CL Wind mixing "power" and some values required for other, later, BDYLYR5A.898
CL diagnostic calculations, are also evaluated if requested. BDYLYR5A.899
C----------------------------------------------------------------------- BDYLYR5A.900
C BDYLYR5A.901
*IF DEF,SCMA AJC0F405.53
C set RHOKE to the FLUX_E forcing input by namelist AJC0F405.54
If (OBS) then AJC0F405.55
Do i = 1, P_FIELD AJC0F405.56
RHOKE(i) = FACTOR_RHOKH(i) AJC0F405.57
enddo AJC0F405.58
endif AJC0F405.59
*ENDIF AJC0F405.60
GSM1F404.45
IF(LAND_FIELD.GT.0) THEN GSM1F404.46
C Initialise any uncalculated points GSM4F403.4
DO I=1,LAND1 GSM4F403.5
GPP(I)=0. GSM4F403.6
NPP(I)=0. GSM4F403.7
RESP_P(I)=0. GSM4F403.8
FSMC(I)=0. ANG1F405.66
ENDDO GSM4F403.9
DO I=LAND_PTS+LAND1-1,LAND_FIELD GSM4F403.10
GPP(I)=0. GSM4F403.11
NPP(I)=0. GSM4F403.12
RESP_P(I)=0. GSM4F403.13
FSMC(I)=0. ANG1F405.67
ENDDO GSM4F403.14
ENDIF ! if land points exist GSM1F404.47
GSM4F403.15
CALL SF_EXCH ( BDYLYR5A.902
+ P_POINTS,LAND_PTS,U_POINTS,ROW_LENGTH,N_P_ROWS,N_U_ROWS, BDYLYR5A.903
+ LAND_INDEX(LAND1),P1,GATHER, BDYLYR5A.905
+ AK(1),BK(1), BDYLYR5A.907
+ CANOPY(LAND1),CATCH(LAND1),CO2_MMR,CF(P1,1), BDYLYR5A.908
+ SM_LEVELS,DZSOIL(1),HCONS(LAND1),F_TYPE(LAND1), BDYLYR5A.909
+ HT(LAND1),LAI(LAND1),PHOTOSYNTH_ACT_RAD(P1),GPP(LAND1), BDYLYR5A.910
+ NPP(LAND1),RESP_P(LAND1), BDYLYR5A.911
+ ICE_FRACT(P1),LAND_MASK(P1),LYING_SNOW(P1),PSTAR(P1),Q(P1,1), BDYLYR5A.912
+ QCF(P1,1),QCL(P1,1),RADNET_C(P1),GC(LAND1),RESIST(LAND1), APA1F405.340
+ ROOTD(LAND1),SMC(LAND1),SMVCCL(LAND1),SMVCWT(LAND1), BDYLYR5A.914
+ T(P1,1),TIMESTEP,TI(P1),T_SOIL(LAND1,1),TSTAR(P1), BDYLYR5A.915
+ U(U1,1),V(U1,1),U_P(P1,1),V_P(P1,1),U_0(U1),V_0(U1), BDYLYR5A.916
+ V_ROOT(LAND1),V_SOIL(LAND1),VFRAC(LAND1), BDYLYR5A.917
+ Z0V(P1),SIL_OROG_LAND(LAND1),Z1(P1), APA1F405.341
+ CANCAP(P1),Z0MSEA(P1),HO2R2_OROG(LAND1), APA1F405.342
& ALPHA1(P1),ASHTF(P1),BQ_1(P1),BT_1(P1),BF_1(P1),CD(P1),CH(P1), ADM3F404.68
& EPOT(P1),FQW(P1,1),FSMC(LAND1),FTL(P1,1),E_SEA(P1),H_SEA(P1), ANG1F405.68
+ TAUX(U1,1),TAUY(U1,1),QW(P1,1),FRACA(P1),RESFS(P1),F_SE(P1), BDYLYR5A.921
& RESFT(P1),RHOKE(P1),RHOKH(P1,1),RHOKM(U1,1), ANG1F405.69
& RHOKPM(P1),RHOKPM_POT(P1), ANG1F405.70
+ RIB(P1),TL(P1,1),VSHR(P1),Z0H(P1),Z0M(P1), BDYLYR5A.923
+ Z0M_EFF(P1),H_BLEND(P1),T1_SD(P1),Q1_SD(P1), BDYLYR5A.924
+ RHO_CD_MODV1(P1),CDR10M(U1),CHR1P5M(P1),CER1P5M(P1),FME(P1), BDYLYR5A.925
+ SU10,SV10,SQ1P5,ST1P5,SFME, BDYLYR5A.926
+ RHO_ARESIST(P1),ARESIST(P1),RESIST_B(P1), BDYLYR5A.927
+ NRML(P1),L_Z0_OROG,L_RMBL,L_BL_LSPICE,ERR,LTIMER ADM3F404.69
*IF DEF,SCMA AJC0F405.61
& ,OBS AJC0F405.62
*ENDIF AJC0F405.63
+) BDYLYR5A.929
IF (ERR.GT.0) THEN BDYLYR5A.930
ERROR = ERR + 10 BDYLYR5A.931
GOTO999 BDYLYR5A.932
ENDIF BDYLYR5A.933
C BDYLYR5A.934
C----------------------------------------------------------------------- BDYLYR5A.935
CL 5. Turbulent exchange coefficients and "explicit" fluxes between BDYLYR5A.936
CL model layers in the boundary layer (P243b, routine KMKH). BDYLYR5A.937
C----------------------------------------------------------------------- BDYLYR5A.938
C BDYLYR5A.939
CALL KMKH ( BDYLYR5A.940
+ P_FIELD,U_FIELD,P1,U1, BDYLYR5A.941
+ P_POINTS,U_POINTS,ROW_LENGTH,N_P_ROWS,N_U_ROWS,BL_LEVELS, BDYLYR5A.942
+ TIMESTEP,AK,BK,AKH,BKH,DELTA_AK,DELTA_BK,CCA,BQ_1,BT_1,BF_1, ADM3F404.70
& CF,DZL, ADM3F404.71
+ PSTAR,Q,QCF,QCL,RDZ,T,TV_RDZUV, BDYLYR5A.944
+ U,U_P,V,V_P,Z0M_EFF,ZLB(1,0),H_BLEND, BDYLYR5A.945
+ FQW,FTL,TAUX,TAUY,QW, BDYLYR5A.946
+ RHOKM,RHOKH,TL,ZH,TV_RDZUV(1,2),RHO_KM(1,2), BDYLYR5A.947
+ CCB,CCT,L_MOM,L_MIXLEN, ARN1F403.50
& L_BL_LSPICE, ADM3F404.72
+ NRML,ERR,LTIMER BDYLYR5A.949
+) BDYLYR5A.950
IF (ERR.GT.0) THEN BDYLYR5A.951
ERROR = ERR + 20 BDYLYR5A.952
GOTO999 BDYLYR5A.953
ENDIF BDYLYR5A.954
C BDYLYR5A.955
C----------------------------------------------------------------------- BDYLYR5A.956
CL 6. "Implicit" calculation of increments for TSTAR and atmospheric BDYLYR5A.957
CL boundary layer variables (P244, routine IMPL_CAL). BDYLYR5A.958
CL 10-metre wind components are also diagnosed if requested. BDYLYR5A.959
C----------------------------------------------------------------------- BDYLYR5A.960
C BDYLYR5A.961
CALL IMPL_CAL( BDYLYR5A.962
+ P_FIELD,U_FIELD,P1,U1, BDYLYR5A.963
+ P_POINTS,U_POINTS,BL_LEVELS,ROW_LENGTH,N_P_ROWS,N_U_ROWS, BDYLYR5A.964
+ ALPHA1,ASHTF,CDR10M,DELTA_AK,DELTA_BK, BDYLYR5A.965
+ RHOKH(1,2),RHOKM(1,2), BDYLYR5A.966
+ ICE_FRACT,LYING_SNOW,PSTAR,RADNET_C,RESFT,RHOKPM, APA1F405.343
& RHOKPM_POT, ANG1F405.71
+ U_0,V_0,TIMESTEP,LAND_MASK,SU10,SV10, BDYLYR5A.968
& EPOT,FQW,FTL,E_SEA,H_SEA,QW, ANG1F405.72
+ RHOKE,RHOKH(1,1),RHOKM(1,1),TL,U,V, BDYLYR5A.970
+ DTRDZ,DTRDZ_RML,TAUX,TAUY,SURF_HT_FLUX,U10M,V10M,NRML, BDYLYR5A.971
+ ERR,LTIMER BDYLYR5A.972
+) BDYLYR5A.973
IF (ERR.GT.0) THEN BDYLYR5A.974
ERROR = ERR + 30 BDYLYR5A.975
GOTO999 BDYLYR5A.976
ENDIF BDYLYR5A.977
C BDYLYR5A.978
CL 6.1 Convert FTL to sensible heat flux in Watts per square metre. BDYLYR5A.979
C BDYLYR5A.980
DO 7 K=1,BL_LEVELS BDYLYR5A.981
Cfpp$ Select(CONCUR) BDYLYR5A.982
DO 71 I=P1,P1+P_POINTS-1 BDYLYR5A.983
FTL(I,K) = FTL(I,K)*CP BDYLYR5A.984
71 CONTINUE BDYLYR5A.985
7 CONTINUE BDYLYR5A.986
C BDYLYR5A.987
C----------------------------------------------------------------------- BDYLYR5A.988
C Diagnose surface temperature and increment sub-surface temperatures BDYLYR5A.989
C for land and sea-ice. BDYLYR5A.990
C----------------------------------------------------------------------- BDYLYR5A.991
C BDYLYR5A.992
C----------------------------------------------------------------------- BDYLYR5A.993
CL Sea-ice (P241, routine SICE_HTF). BDYLYR5A.994
C----------------------------------------------------------------------- BDYLYR5A.995
C BDYLYR5A.996
CALL SICE_HTF( BDYLYR5A.997
+ ASHTF(P1),DI(P1),ICE_FRACT(P1),SURF_HT_FLUX(P1),TIMESTEP, BDYLYR5A.998
+ LAND_MASK(P1),P_POINTS,TI(P1),TSTAR(P1),ASURF(P1), BDYLYR5A.999
+ SEA_ICE_HTF(P1),LTIMER BDYLYR5A.1000
+) BDYLYR5A.1001
C BDYLYR5A.1002
C----------------------------------------------------------------------- BDYLYR5A.1003
CL Diagnose the land surface temperature (previously in SOIL_HTF) BDYLYR5A.1004
C----------------------------------------------------------------------- BDYLYR5A.1005
C BDYLYR5A.1006
DO I=LAND1,LAND1+LAND_PTS-1 BDYLYR5A.1015
J = LAND_INDEX(I) BDYLYR5A.1016
TSTAR(J) = T_SOIL(I,1) + SURF_HT_FLUX(J) / ASHTF(J) BDYLYR5A.1017
ENDDO BDYLYR5A.1018
C BDYLYR5A.1020
C----------------------------------------------------------------------- BDYLYR5A.1021
CL 7. Surface evaporation components and updating of surface BDYLYR5A.1022
CL temperature (P245, routine SF_EVAP). BDYLYR5A.1023
CL The following diagnostics are also calculated, as requested :- BDYLYR5A.1024
CL Heat flux due to melting of sea-ice; specific humidity at 1.5 BDYLYR5A.1025
CL metres; temperature at 1.5 metres. BDYLYR5A.1026
C----------------------------------------------------------------------- BDYLYR5A.1027
C BDYLYR5A.1028
CALL SF_EVAP ( BDYLYR5A.1029
+ P_FIELD,P1,LAND_FIELD,LAND1, BDYLYR5A.1030
+ P_POINTS,BL_LEVELS,LAND_MASK,LAND_PTS,LAND_INDEX, BDYLYR5A.1034
+ ALPHA1,ASURF,ASHTF,CANOPY,CATCH, BDYLYR5A.1036
+ DTRDZ,DTRDZ_RML,E_SEA,FRACA, BDYLYR5A.1037
+ ICE_FRACT,NRML,RHOKH,SMC,TIMESTEP,CER1P5M,CHR1P5M, BDYLYR5A.1038
+ PSTAR,RESFS,RESFT,Z1,Z0M,Z0H,SQ1P5,ST1P5,SIMLT,SMLT, BDYLYR5A.1039
+ FTL,FQW,LYING_SNOW,QW,SURF_HT_FLUX,TL,TSTAR,TI, BDYLYR5A.1040
+ ECAN,ES,EI,SICE_MLT_HTF,SNOMLT_SURF_HTF,SNOWMELT, BDYLYR5A.1041
+ Q1P5M,T1P5M,LTIMER BDYLYR5A.1042
+) BDYLYR5A.1043
C BDYLYR5A.1044
CL 7.1 Copy T and Q from workspace to INOUT space. BDYLYR5A.1045
C BDYLYR5A.1046
DO K=1,BL_LEVELS BDYLYR5A.1047
Cfpp$ Select(CONCUR) BDYLYR5A.1048
DO I=P1,P1+P_POINTS-1 BDYLYR5A.1049
T(I,K)=TL(I,K) BDYLYR5A.1050
Q(I,K)=QW(I,K) BDYLYR5A.1051
ENDDO BDYLYR5A.1052
ENDDO BDYLYR5A.1053
C BDYLYR5A.1054
C----------------------------------------------------------------------- BDYLYR5A.1055
CL 8. Calculate surface latent heat flux diagnostic. BDYLYR5A.1056
C----------------------------------------------------------------------- BDYLYR5A.1057
C BDYLYR5A.1058
IF (SLH) THEN BDYLYR5A.1059
DO 9 I=P1,P1+P_POINTS-1 BDYLYR5A.1060
LATENT_HEAT(I) = LC*FQW(I,1) + LF*EI(I) BDYLYR5A.1061
9 CONTINUE BDYLYR5A.1062
ENDIF BDYLYR5A.1063
999 CONTINUE ! Branch for error exit. BDYLYR5A.1064
BDYLYR5A.1065
!----------------------------------------------------------------------- BDYLYR5A.1066
! Diagnose the soil evaporation, the transpiration and the water BDYLYR5A.1067
! extracted from each soil layer BDYLYR5A.1068
!----------------------------------------------------------------------- BDYLYR5A.1069
DO N=1,SM_LEVELS BDYLYR5A.1089
DO I=LAND1,LAND1+LAND_PTS-1 BDYLYR5A.1090
J = LAND_INDEX(I) BDYLYR5A.1091
EXT(I,N)=WT_EXT(I,N)*(1-F_SE(J))*ES(J) BDYLYR5A.1092
ENDDO BDYLYR5A.1093
ENDDO BDYLYR5A.1094
BDYLYR5A.1095
CDIR$ IVDEP BDYLYR5A.1096
! Fujitsu vectorization directive GRB0F405.193
!OCL NOVREC GRB0F405.194
C Initialise ETRAN otherwise sea points remain uninitialised GSM4F403.16
DO I=1,P_FIELD GSM4F403.17
ETRAN(I)=0. GSM1F404.48
ENDDO GSM4F403.19
DO I=LAND1,LAND1+LAND_PTS-1 BDYLYR5A.1097
J = LAND_INDEX(I) BDYLYR5A.1098
ESOIL(J)=F_SE(J)*ES(J) BDYLYR5A.1099
ETRAN(J)=(1-F_SE(J))*ES(J) BDYLYR5A.1100
EXT(I,1)=EXT(I,1)+ESOIL(J) BDYLYR5A.1101
ENDDO BDYLYR5A.1102
APA1F405.344
C----------------------------------------------------------------------- APA1F405.345
C Diagnose the true value of the surface soil heat flux over land points APA1F405.346
C----------------------------------------------------------------------- APA1F405.347
DO I=LAND1,LAND1+LAND_PTS-1 APA1F405.348
J = LAND_INDEX(I) APA1F405.349
SURF_HT_FLUX(J) = SURF_HT_FLUX(J) - CANCAP(J) * APA1F405.350
+ ( TSTAR(J) - T_SOIL(I,1) ) / TIMESTEP APA1F405.351
ENDDO APA1F405.352
APA1F405.353
BDYLYR5A.1104
IF (LTIMER) THEN BDYLYR5A.1105
CALL TIMER('BDYLAYR ',4) BDYLYR5A.1106
ENDIF BDYLYR5A.1107
BDYLYR5A.1108
RETURN BDYLYR5A.1109
END BDYLYR5A.1110
*ENDIF BDYLYR5A.1111