*IF DEF,A03_7A BL_IC7A.2
C *****************************COPYRIGHT****************************** BL_IC7A.3
C (c) CROWN COPYRIGHT 1997, METEOROLOGICAL OFFICE, All Rights Reserved. BL_IC7A.4
C BL_IC7A.5
C Use, duplication or disclosure of this code is subject to the BL_IC7A.6
C restrictions as set forth in the contract. BL_IC7A.7
C BL_IC7A.8
C Meteorological Office BL_IC7A.9
C London Road BL_IC7A.10
C BRACKNELL BL_IC7A.11
C Berkshire UK BL_IC7A.12
C RG12 2SZ BL_IC7A.13
C BL_IC7A.14
C If no contract has been raised with this copy of the code, the use, BL_IC7A.15
C duplication or disclosure of it is strictly prohibited. Permission BL_IC7A.16
C to do so must first be obtained in writing from the Head of Numerical BL_IC7A.17
C Modelling at the above address. BL_IC7A.18
C ******************************COPYRIGHT****************************** BL_IC7A.19
!!! Subroutine BL_INTCT ------------------------------------------- BL_IC7A.20
!!! BL_IC7A.21
!!! Purpose : Intermediate control level to call requested version of BL_IC7A.22
!!! BDY_LAYR with the appropriate arguments. BL_IC7A.23
!!! BL_IC7A.24
!!! Level 3 control routine BL_IC7A.25
!!! version for CRAY YMP BL_IC7A.26
!!! BL_IC7A.27
!!! Model Modification history: BL_IC7A.28
!!! version Date BL_IC7A.29
!!! 4.3 2/2/97 new deck. S Jackson BL_IC7A.30
!!! 4.4 25/6/97 Modified for MOSES II tile model. R Essery BL_IC7A.31
!!! 4.4 18/09/97 Extra arguments RAD_HR and RADHR_DIM1 for BDYLYR6A BL_IC7A.32
!!! Cyndy Bunton BL_IC7A.33
!!! 4.4 24/11/97 Move grid definitions up from BDY_LAYR. R.A.Betts BL_IC7A.34
!!! 4.5 24/4/98 New diagnostics ZHT and BL_TYPE_1 to _6 for ARN0F405.169
!!! BDYLYR6A R.N.B.Smith ARN0F405.170
!!! 4.5 Jul. 98 Kill the IBM specific lines. (JCThil) AJC1F405.312
!!! 4.5 24/06/98 Output TILE_FRAC as diagnostic. R.A.Betts ABX1F405.750
!!! 4.5 07/09/98 Output GPP_FT and RESP_P_FT as diagnostics. ABX1F405.751
!!! Richard Betts ABX1F405.752
!!! BL_IC7A.35
!!! Programming standard : unified model documentation paper No 3 BL_IC7A.36
!!! BL_IC7A.37
!!! System components covered : P24 BL_IC7A.38
!!! BL_IC7A.39
!!! System task : P0 BL_IC7A.40
!!! BL_IC7A.41
!!!END ----------------------------------------------------------------- BL_IC7A.42
! Arguments :- BL_IC7A.43
SUBROUTINE BL_INTCT ( 2,8BL_IC7A.44
BL_IC7A.45
! IN values defining field dimensions and subset to be processed : BL_IC7A.46
& P_FIELD,U_FIELD,LAND_FIELD,LAND_FIELD_TRIF,NPFT_TRIF, ABX1F405.753
& P_ROWS,FIRST_ROW,N_ROWS,ROW_LENGTH, BL_IC7A.48
BL_IC7A.49
! IN values defining vertical grid of model atmosphere : BL_IC7A.50
& BL_LEVELS,P_LEVELS,AK,BK,AKH,BKH,DELTA_AK,DELTA_BK, BL_IC7A.51
& EXNER, BL_IC7A.52
BL_IC7A.53
! IN soil/vegetation/land surface data : BL_IC7A.54
& LAND_MASK,GATHER,LAND_INDEX, BL_IC7A.59
& ST_LEVELS,SM_LEVELS,CANHT,CANOPY,CATCH,HCAP, BL_IC7A.60
& HCON,LAI,LAYER_DEPTH, BL_IC7A.61
& LYING_SNOW,RESIST,ROOTD,SMC,SMVCCL,SMVCST,SMVCWT, BL_IC7A.63
& VFRAC,Z0V,SIL_OROG_LAND,L_Z0_OROG, BL_IC7A.64
& HO2R2_OROG, BL_IC7A.65
BL_IC7A.66
! IN sea/sea-ice data : BL_IC7A.67
& DI,ICE_FRACT,U_0,V_0, BL_IC7A.68
BL_IC7A.69
! IN cloud data : BL_IC7A.70
& CF,QCF,QCL, BL_IC7A.71
& CCA,CCB,CCT, BL_IC7A.72
BL_IC7A.73
! IN everything not covered so far : BL_IC7A.74
& RAD_HR,RADHR_DIM1, BL_IC7A.75
& CO2_MMR,PHOTOSYNTH_ACT_RAD,PSTAR,RADNET, BL_IC7A.76
& TIMESTEP,L_RMBL,L_BL_LSPICE,L_MOM,L_MIXLEN, BL_IC7A.77
BL_IC7A.78
! INOUT data : BL_IC7A.79
& GS,Q,STHF,STHU,T,T_DEEP_SOIL,TI,TSTAR,U,V,Z0MSEA, BL_IC7A.80
BL_IC7A.81
! OUT Diagnostic not requiring STASH flags : BL_IC7A.82
& CD,CH,E_SEA,ETRAN,FQW,FTL,GPP,H_SEA, BL_IC7A.83
& NPP,RESP_P,RHOKH,RHOKM,RIB,SEA_ICE_HTF, BL_IC7A.84
& TAUX,TAUY,VSHR,ZHT, ARN0F405.171
& EPOT,FSMC, ANG1F405.48
BL_IC7A.86
! OUT diagnostic requiring STASH flags : BL_IC7A.87
& FME,SICE_MLT_HTF,SNOMLT_SURF_HTF,LATENT_HEAT, BL_IC7A.88
& Q1P5M,T1P5M,U10M,V10M, BL_IC7A.89
! (IN) STASH flags :- BL_IC7A.90
& SFME,SIMLT,SMLT,SLH,SQ1P5,ST1P5,SU10,SV10, BL_IC7A.91
BL_IC7A.92
! OUT data required for tracer mixing : BL_IC7A.93
& RHO_ARESIST,ARESIST,RESIST_B, BL_IC7A.94
& NRML, BL_IC7A.95
BL_IC7A.96
! OUT data required for 4D_VAR : BL_IC7A.97
& RHO_CD_MODV1,RHO_KM, BL_IC7A.98
BL_IC7A.99
! OUT data required elsewhere in UM system : BL_IC7A.100
& BL_TYPE_1,BL_TYPE_2,BL_TYPE_3,BL_TYPE_4,BL_TYPE_5,BL_TYPE_6, ARN0F405.172
& ECAN,EI,ES,EXT,SNOWMELT, BL_IC7A.101
& SURF_HT_FLUX,ZH,T1_SD,Q1_SD,ERROR, BL_IC7A.102
BL_IC7A.103
! Additional arguments for 7A boundary layer (MOSES II) BL_IC7A.104
! IN BL_IC7A.107
& L_PHENOL,L_TRIFFID,L_NEG_TSTAR, ABX1F405.754
& CANHT_FT,CANOPY_TILE,CATCH_TILE,CS,LAI_FT, BL_IC7A.108
& FRAC,SNOW_FRAC,RAD_NO_SNOW,RAD_SNOW,TSNOW,Z0V_TILE, BL_IC7A.109
& CO2_3D,CO2_DIM,L_CO2_INTERACTIVE, ACN1F405.114
! INOUT BL_IC7A.110
& TSTAR_TILE, BL_IC7A.111
& G_LEAF_ACC,NPP_FT_ACC,RESP_W_FT_ACC,RESP_S_ACC, BL_IC7A.112
! OUT BL_IC7A.113
& ECAN_TILE,ESOIL_TILE,FTL_TILE, BL_IC7A.114
& G_LEAF,GPP_FT,NPP_FT,RESP_P_FT,RESP_S,RESP_W_FT, ABX1F405.755
& RHO_ARESIST_TILE,ARESIST_TILE,RESIST_B_TILE, BL_IC7A.116
& RIB_TILE,SNOW_SURF_HTF,SOIL_SURF_HTF, BL_IC7A.117
& TILE_INDEX,TILE_PTS,TILE_FRAC, ABX1F405.756
BL_IC7A.118
! LOGICAL LTIMER BL_IC7A.119
& LTIMER BL_IC7A.120
&) BL_IC7A.121
IMPLICIT NONE BL_IC7A.122
BL_IC7A.123
! Inputs :- BL_IC7A.124
BL_IC7A.125
! (a) Defining horizontal grid and subset thereof to be processed. BL_IC7A.126
! Checked for consistency in BDY_LAYR. BL_IC7A.128
! All dimensions set to 1 for single column model. BL_IC7A.130
BL_IC7A.132
INTEGER BL_IC7A.133
& P_FIELD ! IN No. of P-points in whole grid BL_IC7A.134
! ! (for dimensioning only). BL_IC7A.135
&,U_FIELD ! IN No. of UV-points in whole grid. BL_IC7A.136
&,LAND_FIELD ! IN No. of land points in whole grid. BL_IC7A.137
&,LAND_FIELD_TRIF ! IN For dimensioning land fields ABX1F405.757
! ! available only with TRIFFID ABX1F405.758
! ! Set to LAND_FIELD when TRIFFID on, ABX1F405.759
! ! set to 1 when TRIFFID off. ABX1F405.760
&,NPFT_TRIF ! IN For dimensioning PFT fields ABX1F405.761
! ! available only with TRIFFID ABX1F405.762
! ! Set to NPFT when TRIFFID on, ABX1F405.763
! ! set to 1 when TRIFFID off. ABX1F405.764
&,P_ROWS ! IN No. of P-rows in whole grid BL_IC7A.138
! ! (for dimensioning only). BL_IC7A.139
&,FIRST_ROW ! IN First row of data to be treated, BL_IC7A.140
! ! referred to P-grid. BL_IC7A.141
&,N_ROWS ! IN No. of rows of data to be BL_IC7A.142
! ! treated, referred to P-grid. BL_IC7A.143
&,ROW_LENGTH ! IN No. of points in one row. BL_IC7A.144
BL_IC7A.145
! (b) Defining vertical grid of model atmosphere. BL_IC7A.146
BL_IC7A.147
INTEGER BL_IC7A.148
& BL_LEVELS ! IN Max. no. of "boundary" levels BL_IC7A.149
! ! allowed.Assumed <= 30 for dim- BL_IC7A.150
! ! sioning of GAMMA in common deck BL_IC7A.151
! ! C_GAMMA used in SF_EXCH and KMKH BL_IC7A.152
&,P_LEVELS ! IN Total no. of vertical levels in BL_IC7A.153
! ! the model atmosphere. BL_IC7A.154
&,RADHR_DIM1 ! IN Dimension for RAD_HR BL_IC7A.155
REAL BL_IC7A.156
& AK(P_LEVELS) ! IN Hybrid 'A' for all levels. BL_IC7A.157
&,BK(P_LEVELS) ! IN Hybrid 'B' for all levels. BL_IC7A.158
&,AKH(P_LEVELS+1) ! IN Hybrid 'A' for layer interfaces. BL_IC7A.159
&,BKH(P_LEVELS+1) ! IN Hybrid 'B' for layer interfaces. BL_IC7A.160
&,DELTA_AK(P_LEVELS) ! IN Difference of hybrid 'A' across BL_IC7A.161
! ! layers (K-1/2 to K+1/2). BL_IC7A.162
! ! NB: Upper minus lower. BL_IC7A.163
&,DELTA_BK(P_LEVELS) ! IN Difference of hybrid 'B' across BL_IC7A.164
! ! layers (K-1/2 to K+1/2). BL_IC7A.165
! ! NB: Upper minus lower. BL_IC7A.166
&,EXNER(P_FIELD,BL_LEVELS+1)! IN Exner function. EXNER(,K) is BL_IC7A.167
! ! value for LOWER BOUNDARY of BL_IC7A.168
! ! level K. BL_IC7A.169
BL_IC7A.170
! (c) Soil/vegetation/land surface parameters (mostly constant). BL_IC7A.171
BL_IC7A.172
LOGICAL BL_IC7A.173
& LAND_MASK(P_FIELD) ! IN T if land, F elsewhere. BL_IC7A.174
&,L_CO2_INTERACTIVE ACN1F405.115
&,L_Z0_OROG ! IN T to use simple orog.roughness BL_IC7A.175
! ! treatment in SF_EXCH BL_IC7A.176
&,GATHER ! IN T if gather to sea-ice points BL_IC7A.178
! ! in SF_EXCH. Saves a lot of un- BL_IC7A.179
! ! necessary calculations if there BL_IC7A.180
! ! are relatively few sea-ice points BL_IC7A.181
BL_IC7A.182
INTEGER BL_IC7A.183
& LAND_INDEX(P_FIELD) ! IN LAND_INDEX(I)=J => the Jth BL_IC7A.184
! ! point in P_FIELD is the Ith BL_IC7A.185
! ! land point. BL_IC7A.186
BL_IC7A.188
*CALL NSTYPES 
BL_IC7A.189
BL_IC7A.190
INTEGER BL_IC7A.191
& ST_LEVELS ! IN No. of deep soil temp. levels BL_IC7A.192
&,SM_LEVELS ! IN No. of soil moisture levels BL_IC7A.193
&,CO2_DIM ! number of points in CO2 field. ACN1F405.116
BL_IC7A.194
REAL BL_IC7A.195
& CANHT_FT(LAND_FIELD,NPFT) ! IN Canopy height (m) BL_IC7A.196
&,CANOPY_TILE(LAND_FIELD,NTYPE-1) BL_IC7A.197
! ! IN Surface/canopy water for snow-free BL_IC7A.198
! ! land tiles (kg per sq m) BL_IC7A.199
&,CATCH_TILE(LAND_FIELD,NTYPE-1) BL_IC7A.200
! ! IN Surface/canopy water capacity of BL_IC7A.201
! ! snow-free land tiles (kg per sq m) BL_IC7A.202
&,CS(LAND_FIELD) ! IN Soil carbon (kg C/m2). BL_IC7A.203
&,HCON(LAND_FIELD) ! IN Soil thermal conductivity (W/m/K). BL_IC7A.204
&,HO2R2_OROG(LAND_FIELD) ! IN Dummy used only in version 3A. BL_IC7A.205
&,LAI_FT(LAND_FIELD,NPFT) ! IN Leaf area index BL_IC7A.206
&,LYING_SNOW(P_FIELD) ! IN Lying snow (kg per sq m). BL_IC7A.207
! ! Must be global for coupled model, BL_IC7A.209
! ! ie dimension P_FIELD not LAND_FIEL BL_IC7A.210
&,SIL_OROG_LAND(LAND_FIELD) ! IN Silhouette area of unresolved BL_IC7A.212
! ! orography per unit horizontal area BL_IC7A.213
! ! on land points only. BL_IC7A.214
&,SMVCCL(LAND_FIELD) ! IN Critical volumetric SMC (cubic m BL_IC7A.215
! ! per cubic m of soil). BL_IC7A.216
&,SMVCST(LAND_FIELD) ! IN Volumetric saturation point (cubic BL_IC7A.217
! ! per cubic m of soil). BL_IC7A.218
&,SMVCWT(LAND_FIELD) ! IN Volumetric wilting point (cubic m BL_IC7A.219
! ! per cubic m of soil). BL_IC7A.220
&,STHF(LAND_FIELD,SM_LEVELS)! IN Frozen soil moisture content of BL_IC7A.221
! ! each layer as a fraction of BL_IC7A.222
! ! saturation. BL_IC7A.223
&,STHU(LAND_FIELD,SM_LEVELS)! IN Unfrozen soil moisture content of BL_IC7A.224
! ! each layer as a fraction of BL_IC7A.225
! ! saturation. BL_IC7A.226
&,FRAC(LAND_FIELD,NTYPE) ! IN Tile fracs excluding snow cover BL_IC7A.227
&,SNOW_FRAC(LAND_FIELD) ! IN Snow fraction. BL_IC7A.228
&,TSNOW(LAND_FIELD) ! IN Snow surface layer temp. (K). BL_IC7A.229
&,Z0V(P_FIELD) ! IN GBM snow-free roughness length (m) BL_IC7A.230
! ! NB:UM uses same storage for Z0MSEA BL_IC7A.231
! ! so for sea points this is INOUT. BL_IC7A.232
&,Z0V_TILE(LAND_FIELD,NTYPE)! IN Tile roughness lengths (m). BL_IC7A.233
BL_IC7A.234
! (d) Sea/sea-ice data. BL_IC7A.235
BL_IC7A.236
REAL BL_IC7A.237
& DI(P_FIELD) ! IN "Equivalent thickness" of sea-ice BL_IC7A.238
! ! (m). BL_IC7A.239
&,ICE_FRACT(P_FIELD) ! IN Fraction of gridbox covered by BL_IC7A.240
! ! sea-ice (decimal fraction). BL_IC7A.241
&,U_0(U_FIELD) ! IN W'ly component of surface current BL_IC7A.242
! ! (metres per second). BL_IC7A.243
&,V_0(U_FIELD) ! IN S'ly component of surface current BL_IC7A.244
! ! (metres per second). BL_IC7A.245
BL_IC7A.246
! (e) Cloud data. BL_IC7A.247
BL_IC7A.248
REAL BL_IC7A.249
& CF(P_FIELD,BL_LEVELS) ! IN Cloud fraction (decimal). BL_IC7A.250
&,QCF(P_FIELD,BL_LEVELS) ! IN Cloud ice (kg per kg air) BL_IC7A.251
&,QCL(P_FIELD,BL_LEVELS) ! IN Cloud liquid water (kg/kg air). BL_IC7A.252
&,CCA(P_FIELD) ! IN Convective Cloud Amount (decimal). BL_IC7A.253
BL_IC7A.254
INTEGER BL_IC7A.255
& CCB(P_FIELD) ! IN Convective Cloud Base BL_IC7A.256
&,CCT(P_FIELD) ! IN Convective Cloud Top BL_IC7A.257
BL_IC7A.258
! (f) Atmospheric + any other data not covered so far, incl control. BL_IC7A.259
BL_IC7A.260
REAL BL_IC7A.261
& CO2_MMR ! IN CO2 Mass Mixing Ratio BL_IC7A.262
&,CO2_3D(CO2_DIM) ! 3D CO2 field if required. ACN1F405.117
&,PHOTOSYNTH_ACT_RAD(P_FIELD)! IN Net downward shortwave radiation BL_IC7A.263
! ! in band 1 (w/m2). BL_IC7A.264
&,PSTAR(P_FIELD) ! IN Surface pressure (Pascals). BL_IC7A.265
+,RADNET(P_FIELD) ! IN Surface net radiation (W/sq m, BL_IC7A.266
C ! positive downwards). BL_IC7A.267
&,RAD_NO_SNOW(P_FIELD) ! IN Surface net radiation, snow-free BL_IC7A.268
! ! fraction of gridbox. BL_IC7A.269
&,RAD_SNOW(P_FIELD) ! IN Surface net radiation, snow- BL_IC7A.270
! ! covered fraction of gridbox. BL_IC7A.271
+,RAD_HR(RADHR_DIM1,BL_LEVELS) BL_IC7A.272
! ! IN Radiative heating rates BL_IC7A.273
! ! - not used in A03_7A. BL_IC7A.274
&,TIMESTEP ! IN Timestep (seconds). BL_IC7A.275
BL_IC7A.276
LOGICAL BL_IC7A.277
& LTIMER ! IN Logical switch for TIMER diags BL_IC7A.278
&,L_RMBL ! IN T to use rapidly mixing BL_IC7A.279
! ! boundary scheme in IMPL_CAL BL_IC7A.280
&,L_BL_LSPICE ! IN Use if 3A large scale precip BL_IC7A.281
&,L_MOM ! IN Switch for convective momentum BL_IC7A.282
! ! transport. BL_IC7A.283
&,L_PHENOL ! IN Indicates whether phenology in use ABX1F405.765
&,L_TRIFFID ! IN Indicates whether TRIFFID in use. ABX1F405.766
&,L_NEG_TSTAR ! IN Switch for -ve TSTAR error check ABX1F405.767
BL_IC7A.284
! STASH flags :- BL_IC7A.285
BL_IC7A.286
LOGICAL BL_IC7A.287
& SFME ! IN Flag for FME (q.v.). BL_IC7A.288
&,SMLT ! IN Flag for SICE_MLT_HTF (q.v.) BL_IC7A.289
&,SIMLT ! IN Flag BL_IC7A.290
&,SLH ! IN Flag for LATENT_HEAT (q.v.) BL_IC7A.291
&,SQ1P5 ! IN Flag for Q1P5M (q.v.) BL_IC7A.292
&,ST1P5 ! IN Flag for T1P5M (q.v.) BL_IC7A.293
&,SU10 ! IN Flag for U10M (q.v.) BL_IC7A.294
&,SV10 ! IN Flag for V10M (q.v.) BL_IC7A.295
BL_IC7A.296
! In/outs :- BL_IC7A.297
BL_IC7A.298
REAL BL_IC7A.299
& GS(LAND_FIELD) ! INOUT "Stomatal" conductance to BL_IC7A.300
! ! evaporation (m/s). BL_IC7A.301
&,Q(P_FIELD,BL_LEVELS) ! INOUT Input:specific humidity BL_IC7A.302
! ! ( kg water per kg air). BL_IC7A.303
! ! Output:total water content BL_IC7A.304
! ! (Q)(kg water per kg air). BL_IC7A.305
&,T(P_FIELD,BL_LEVELS) ! INOUT Input:atmospheric temp(K) BL_IC7A.306
! ! Output:liquid/frozen water BL_IC7A.307
! ! temperature (TL) (K) BL_IC7A.308
&,T_DEEP_SOIL(LAND_FIELD,ST_LEVELS) BL_IC7A.309
! ! INOUT Deep soil temperatures (K). BL_IC7A.310
&,TI(P_FIELD) ! INOUT Sea-ice surface layer BL_IC7A.311
! ! temperature (K) BL_IC7A.312
&,TSTAR(P_FIELD) ! INOUT Surface temperature (K). BL_IC7A.313
&,TSTAR_TILE(LAND_FIELD,NTYPE) BL_IC7A.314
! ! INOUT Surface tile temperature BL_IC7A.315
&,U(U_FIELD,BL_LEVELS) ! INOUT W'ly wind component (m/s). BL_IC7A.316
&,V(U_FIELD,BL_LEVELS) ! INOUT S'ly wind component (m/s). BL_IC7A.317
&,Z0MSEA(P_FIELD) ! INOUT Sea-surface roughness BL_IC7A.318
! ! length for momentum (m). BL_IC7A.319
! ! NB: same storage is used BL_IC7A.320
! ! for Z0V, so the intent is BL_IC7A.321
! ! IN for land points. BL_IC7A.322
BL_IC7A.323
! Accumulation prognostics for PHENOLOGY and TRIFFID. ABX1F405.768
! NPP_FT_ACC, RESP_W_FT_ACC and RESP_S_ACC are only allocated D1 space ABX1F405.769
! when TRIFFID is in use, so their dimensions here are set accordingly. ABX1F405.770
ABX1F405.771
REAL ABX1F405.772
& G_LEAF_ACC(LAND_FIELD,NPFT) ! INOUT Accumulated G_LEAF ABX1F405.773
&,NPP_FT_ACC(LAND_FIELD_TRIF,NPFT_TRIF)! INOUT Accumulated NPP_FT ABX1F405.774
&,RESP_W_FT_ACC(LAND_FIELD_TRIF,NPFT_TRIF) ! INOUT Accum RESP_W_FT ABX1F405.775
&,RESP_S_ACC(LAND_FIELD_TRIF) ! INOUT Accumulated RESP_S ABX1F405.776
ABX1F405.777
BL_IC7A.332
! Outputs :- BL_IC7A.333
BL_IC7A.334
!-1 Diagnostic (or effectively so - includes coupled model requisites):- BL_IC7A.335
BL_IC7A.336
INTEGER BL_IC7A.337
& TILE_INDEX(LAND_FIELD,NTYPE) BL_IC7A.338
! ! OUT Index of tile points. BL_IC7A.339
&,TILE_PTS(NTYPE) ! OUT Number of tile points. BL_IC7A.340
BL_IC7A.341
! (a) Calculated anyway (use STASH space from higher level) :- BL_IC7A.342
BL_IC7A.343
REAL BL_IC7A.344
& CD(P_FIELD) ! OUT Turbulent surface exchange (bulk BL_IC7A.345
! ! transfer) coefficient for BL_IC7A.346
! ! momentum. BL_IC7A.347
&,CH(P_FIELD) ! OUT Turbulent surface exchange (bulk BL_IC7A.348
! ! transfer) coefficient for heat BL_IC7A.349
! ! and/or moisture. BL_IC7A.350
&,ECAN(P_FIELD) ! OUT Gridbox mean evaporation from BL_IC7A.351
! ! canopy / surface store (kg/m2/s). BL_IC7A.352
! ! Zero over sea. BL_IC7A.353
&,E_SEA(P_FIELD) ! OUT Evaporation from sea times leads BL_IC7A.354
! ! fraction. Zero over land. BL_IC7A.355
! ! (kg per square metre per sec). BL_IC7A.356
&,EPOT(P_FIELD) ! Dummy. ANG1F405.49
&,ESOIL_TILE(LAND_FIELD,NTYPE-1) BL_IC7A.357
! OUT ES for snow-free land tiles BL_IC7A.358
&,FQW(P_FIELD,BL_LEVELS) ! OUT Moisture flux between layers BL_IC7A.359
! ! (kg per square metre per sec). BL_IC7A.360
! ! FQW(,1) is total water flux BL_IC7A.361
! ! from surface, 'E'. BL_IC7A.362
&,FSMC(LAND_FIELD) ! Dummy. ANG1F405.50
&,FTL(P_FIELD,BL_LEVELS) ! OUT FTL(,K) contains net turbulent BL_IC7A.363
! ! sensible heat flux into layer K BL_IC7A.364
! ! from below; so FTL(,1) is the BL_IC7A.365
! ! surface sensible heat, H. (W/m2) BL_IC7A.366
&,FTL_TILE(LAND_FIELD,NTYPE) BL_IC7A.367
! ! OUT Surface FTL for land tiles BL_IC7A.368
&,G_LEAF(LAND_FIELD,NPFT) ! OUT Leaf turnover rate (/360days). ABX1F405.778
&,GPP(LAND_FIELD) ! OUT Gross primary productivity BL_IC7A.370
! ! (kg C/m2/s). BL_IC7A.371
&,GPP_FT(LAND_FIELD,NPFT) ! OUT Gross primary productivity ABX1F405.779
! ! on PFTs (kg C/m2/s). ABX1F405.780
&,H_SEA(P_FIELD) ! OUT Surface sensible heat flux over BL_IC7A.372
! ! sea times leads fraction. (W/m2) BL_IC7A.373
&,NPP(LAND_FIELD) ! OUT Net primary productivity BL_IC7A.374
! ! (kg C/m2/s). BL_IC7A.375
&,NPP_FT(LAND_FIELD,NPFT) ! OUT Net primary productivity BL_IC7A.376
! ! (kg C/m2/s). BL_IC7A.377
&,RESP_P(LAND_FIELD) ! OUT Plant respiration (kg C/m2/s). BL_IC7A.378
&,RESP_P_FT(LAND_FIELD,NPFT) ! OUT Plant respiration on PFTs ABX1F405.781
! ! (kg C/m2/s). ABX1F405.782
ABX1F405.783
&,RESP_S(LAND_FIELD) ! OUT Soil respiration (kg C/m2/s). BL_IC7A.379
&,RESP_W_FT(LAND_FIELD,NPFT)! OUT Wood maintenance respiration BL_IC7A.380
! ! (kg C/m2/s). BL_IC7A.381
&,RHOKH(P_FIELD,BL_LEVELS) ! OUT Exchange coeffs for moisture. BL_IC7A.382
&,RHOKM(U_FIELD,BL_LEVELS) ! OUT Exchange coefficients for BL_IC7A.383
! ! momentum (on UV-grid, with 1st BL_IC7A.384
! ! and last rows undefined (or, at BL_IC7A.385
! ! present, set to "missing data")). BL_IC7A.386
&,RIB(P_FIELD) ! OUT Bulk Richardson number for lowest BL_IC7A.387
! ! layer. BL_IC7A.388
&,RIB_TILE(LAND_FIELD,NTYPE)! OUT RIB for land tiles. BL_IC7A.389
&,SEA_ICE_HTF(P_FIELD) ! OUT Heat flux through sea-ice (W per BL_IC7A.390
! ! sq m, positive downwards). BL_IC7A.391
&,SMC(LAND_FIELD) ! OUT Available moisture in the BL_IC7A.392
! ! soil profile (mm). BL_IC7A.393
&,SURF_HT_FLUX(P_FIELD) ! OUT Net downward heat flux at surface BL_IC7A.394
! ! over land or sea-ice fraction of BL_IC7A.395
! ! gridbox (W/m2) BL_IC7A.396
&,TAUX(U_FIELD,BL_LEVELS) ! OUT W'ly component of surface wind BL_IC7A.397
! ! stress (N/sq m).(On UV-grid with BL_IC7A.398
! ! first and last rows undefined or BL_IC7A.399
! ! at present, set to 'missing data' BL_IC7A.400
&,TAUY(U_FIELD,BL_LEVELS) ! OUT S'ly component of surface wind BL_IC7A.401
! ! stress (N/sq m). On UV-grid; BL_IC7A.402
! ! comments as per TAUX. BL_IC7A.403
&,TILE_FRAC(LAND_FIELD,NTYPE) ABX1F405.784
! ! OUT Tile fractions adjusted for snow. ABX1F405.785
! ! 1 to NTYPE-1: snow-free fraction. ABX1F405.786
! ! NTYPE:land-ice plus snow fraction. ABX1F405.787
&,VSHR(P_FIELD) ! OUT Magnitude of surface-to-lowest BL_IC7A.404
! ! atm level wind shear (m per s). BL_IC7A.405
&,RHO_CD_MODV1(P_FIELD) ! OUT Surface air density * drag coef. BL_IC7A.406
! ! mod(v1 - v0) before interpolation. BL_IC7A.407
&,RHO_KM(P_FIELD,2:BL_LEVELS)! OUT Air density * turbulent mixing BL_IC7A.408
! ! coef. for momentum before BL_IC7A.409
&,RHO_ARESIST(P_FIELD) ! OUT, RHOSTAR*CD_STD*VSHR for SCYCLE BL_IC7A.410
&,ARESIST(P_FIELD) ! OUT, 1/(CD_STD*VSHR) for SCYCLE BL_IC7A.411
&,RESIST_B(P_FIELD) ! OUT,(1/CH-1/CD_STD)/VSHR for SCYCLE BL_IC7A.412
&,RHO_ARESIST_TILE(LAND_FIELD,NTYPE) BL_IC7A.413
! ! OUT RHOSTAR*CD_STD*VSHR on land tiles BL_IC7A.414
&,ARESIST_TILE(LAND_FIELD,NTYPE) BL_IC7A.415
! ! OUT 1/(CD_STD*VSHR) on land tiles BL_IC7A.416
&,RESIST_B_TILE(LAND_FIELD,NTYPE) BL_IC7A.417
! ! OUT (1/CH-1/CD_STD)/VSHR on land tiles BL_IC7A.418
! BL_IC7A.419
INTEGER BL_IC7A.420
& NRML(P_FIELD) ! OUT Number of model layers in the BL_IC7A.421
! ! Rapidly Mixing Layer; diagnosed BL_IC7A.422
! ! in SF_EXCH and KMKH and used in BL_IC7A.423
! ! IMPL_CAL, SF_EVAP and TR_MIX. BL_IC7A.424
BL_IC7A.425
! (b) Not passed between lower-level routines (not in workspace at this BL_IC7A.426
! level) :- BL_IC7A.427
BL_IC7A.428
REAL BL_IC7A.429
& FME(P_FIELD) ! OUT Wind mixing "power" (W per sq m). BL_IC7A.430
&,SICE_MLT_HTF(P_FIELD) ! OUT Heat flux due to melting of sea- BL_IC7A.431
! ! ice (Watts per sq metre). BL_IC7A.432
&,SNOMLT_SURF_HTF(P_FIELD) BL_IC7A.433
&,LATENT_HEAT(P_FIELD) ! OUT Surface latent heat flux, +ve BL_IC7A.434
! ! upwards (Watts per sq m). BL_IC7A.435
&,Q1P5M(P_FIELD) ! OUT Q at 1.5 m (kg water per kg air). BL_IC7A.436
&,T1P5M(P_FIELD) ! OUT T at 1.5 m (K). BL_IC7A.437
&,U10M(U_FIELD) ! OUT U at 10 m (m per s). BL_IC7A.438
&,V10M(U_FIELD) ! OUT V at 10 m (m per s). BL_IC7A.439
&,ZHT(P_FIELD) ! OUT Dummy (diagnostics for BDYLYR6A) ARN0F405.173
&,BL_TYPE_1(P_FIELD) ! OUT Dummy (diagnostics for BDYLYR6A) ARN0F405.174
&,BL_TYPE_2(P_FIELD) ! OUT Dummy (diagnostics for BDYLYR6A) ARN0F405.175
&,BL_TYPE_3(P_FIELD) ! OUT Dummy (diagnostics for BDYLYR6A) ARN0F405.176
&,BL_TYPE_4(P_FIELD) ! OUT Dummy (diagnostics for BDYLYR6A) ARN0F405.177
&,BL_TYPE_5(P_FIELD) ! OUT Dummy (diagnostics for BDYLYR6A) ARN0F405.178
&,BL_TYPE_6(P_FIELD) ! OUT Dummy (diagnostics for BDYLYR6A) ARN0F405.179
ARN0F405.180
BL_IC7A.440
!-2 Genuinely output, needed by other atmospheric routines :- BL_IC7A.441
BL_IC7A.442
REAL BL_IC7A.443
& ECAN_TILE(LAND_FIELD,NTYPE-1) BL_IC7A.444
! OUT ECAN for snow-free land tiles BL_IC7A.445
&,EI(P_FIELD) ! OUT Sublimation from lying snow or sea-ice BL_IC7A.446
! ! (kg/m2/s). BL_IC7A.447
&,ES(P_FIELD) ! OUT Surface evapotranspiration from soil BL_IC7A.448
! ! moisture store (kg/m2/s). BL_IC7A.449
&,EXT(LAND_FIELD,SM_LEVELS) BL_IC7A.450
! ! OUT Extraction of water from each soil layer BL_IC7A.451
! ! (kg/m2/s). BL_IC7A.452
&,SNOWMELT(P_FIELD) BL_IC7A.453
! ! OUT Snowmelt (kg/m/s). BL_IC7A.454
&,SNOW_SURF_HTF(LAND_FIELD) BL_IC7A.455
! ! OUT Net downward heat flux at BL_IC7A.456
! ! snow surface (W/m2). BL_IC7A.457
&,SOIL_SURF_HTF(LAND_FIELD) BL_IC7A.458
! ! OUT Net downward heat flux at BL_IC7A.459
! ! snow-free land surface (W/m2). BL_IC7A.460
&,ZH(P_FIELD) ! OUT Height above surface of top of boundary BL_IC7A.461
! ! layer (metres). BL_IC7A.462
&,T1_SD(P_FIELD) ! OUT Standard deviation of turbulent fluctuations BL_IC7A.463
! ! of layer 1 temperature; for use in BL_IC7A.464
! ! initiating convection. BL_IC7A.465
&,Q1_SD(P_FIELD) ! OUT Standard deviation of turbulent fluctuations BL_IC7A.466
! ! of layer 1 humidity; for use in initiating BL_IC7A.467
! ! convection. BL_IC7A.468
BL_IC7A.469
INTEGER BL_IC7A.470
& ERROR ! OUT 0 - AOK; BL_IC7A.471
! ! 1 to 7 - bad grid definition detected; BL_IC7A.473
BL_IC7A.477
! Local variables BL_IC7A.478
REAL BL_IC7A.479
& GS_TILE(LAND_FIELD,NTYPE)! LOCAL Surface conductance for BL_IC7A.480
! ! land tiles BL_IC7A.481
&,WT_EXT(LAND_FIELD,SM_LEVELS) BL_IC7A.482
! ! LOCAL Fraction of evapotranspiration BL_IC7A.483
! ! which is extracted from each BL_IC7A.484
! ! soil layer. BL_IC7A.485
&,Z1(P_FIELD) ! LOCAL Height of lowest level (m). BL_IC7A.486
INTEGER BL_IC7A.491
& TILE_INDEX_S(LAND_FIELD,NTYPE) BL_IC7A.492
! ! LOCAL Index for TILE_FRAC. BL_IC7A.493
&,TILE_PTS_S(NTYPE) ! LOCAL Number of points for TILE_FRAC. BL_IC7A.494
BL_IC7A.495
INTEGER BL_IC7A.496
& I ! LOCAL P-point index BL_IC7A.497
&,L ! LOCAL Land point index BL_IC7A.498
&,N ! LOCAL Tile index BL_IC7A.499
&,N_P_ROWS ! LOCAL No of P-rows being processed. BL_IC7A.500
&,N_U_ROWS ! LOCAL No of UV-rows being processed. BL_IC7A.501
&,P_POINTS ! LOCAL No of P-points being processed. BL_IC7A.502
&,P1 ! LOCAL First P-point to be processed. BL_IC7A.503
&,LAST_POINT ! LOCAL Last P-point to be processed. BL_IC7A.504
&,LAND1 ! LOCAL First land-point to be processed BL_IC7A.505
! ! 1 <= LAND1 <= LAND_FIELD BL_IC7A.506
&,LAND_PTS ! LOCAL No of land points processed. BL_IC7A.507
&,U_POINTS ! LOCAL No of UV-points being processed. BL_IC7A.508
&,U1 ! LOCAL First UV-point to be processed. BL_IC7A.509
BL_IC7A.510
REAL ABX1F405.788
& SECS_PER_360DAYS ! LOCAL Number of seconds in 360 days ABX1F405.789
ABX1F405.790
PARAMETER(SECS_PER_360DAYS=31104000.0) ABX1F405.791
ABX1F405.792
BL_IC7A.511
BL_IC7A.512
! Dummy variables not used by MOSES II BL_IC7A.513
REAL BL_IC7A.514
& CANHT(LAND_FIELD) BL_IC7A.515
&,CANOPY(LAND_FIELD) BL_IC7A.516
&,CATCH(LAND_FIELD) BL_IC7A.517
&,ETRAN(P_FIELD) BL_IC7A.518
&,HCAP(LAND_FIELD) BL_IC7A.519
&,LAI(LAND_FIELD) BL_IC7A.520
&,LAYER_DEPTH(SM_LEVELS) BL_IC7A.521
&,RESIST(LAND_FIELD) BL_IC7A.522
&,ROOTD(LAND_FIELD) BL_IC7A.523
&,VFRAC(LAND_FIELD) BL_IC7A.524
LOGICAL BL_IC7A.525
& L_MIXLEN BL_IC7A.526
BL_IC7A.527
! External subroutines called ABX1F405.793
EXTERNAL ABX1F405.794
& TILEPTS ! Calculates number of points occupied by each ABX1F405.795
! ! tile and their indices on the land field ABX1F405.796
&,VSHR_Z1 ! Calculates level 1 windspeed and height. ABX1F405.797
&,PHYSIOL ! Models plant physiology ABX1F405.798
&,BDY_LAYR ! Models surface fluxes and boundary layer processes ABX1F405.799
ABX1F405.800
*IF -DEF,SCMA AJC1F405.313
!----------------------------------------------------------------------- BL_IC7A.529
!! 0. Verify grid/subset definitions. Arakawa 'B' grid with P-rows at BL_IC7A.530
!! extremes is assumed. Extreme-most P-rows are ignored; extreme- BL_IC7A.531
!! most UV-rows are used only for interpolation and are not updated. BL_IC7A.532
!----------------------------------------------------------------------- BL_IC7A.533
BL_IC7A.534
IF ( BL_LEVELS.LT.1 .OR. SM_LEVELS.LT.1 .OR. P_ROWS.LT.3 ) THEN BL_IC7A.535
ERROR = 1 BL_IC7A.536
GOTO999 BL_IC7A.537
*IF -DEF,MPP BL_IC7A.538
ELSEIF ( U_FIELD .NE. (P_ROWS-1)*ROW_LENGTH ) THEN BL_IC7A.539
*ELSE BL_IC7A.540
ELSEIF ( U_FIELD .NE. P_ROWS*ROW_LENGTH ) THEN BL_IC7A.541
*ENDIF BL_IC7A.542
ERROR = 2 BL_IC7A.543
GOTO999 BL_IC7A.544
ELSEIF ( P_FIELD .NE. P_ROWS*ROW_LENGTH ) THEN BL_IC7A.545
ERROR = 3 BL_IC7A.546
GOTO999 BL_IC7A.547
ELSEIF ( FIRST_ROW.LE.1 .OR. FIRST_ROW.GE.P_ROWS ) THEN BL_IC7A.548
ERROR = 4 BL_IC7A.549
GOTO999 BL_IC7A.550
ELSEIF ( N_ROWS.LE.0 ) THEN BL_IC7A.551
ERROR = 5 BL_IC7A.552
GOTO999 BL_IC7A.553
*IF -DEF,MPP BL_IC7A.554
ELSEIF ( (FIRST_ROW+N_ROWS) .GT. P_ROWS ) THEN BL_IC7A.555
*ELSE BL_IC7A.556
ELSEIF ( (FIRST_ROW+N_ROWS-1) .GT. P_ROWS ) THEN BL_IC7A.557
*ENDIF BL_IC7A.558
ERROR = 6 BL_IC7A.559
GOTO999 BL_IC7A.560
ELSEIF ( LAND_FIELD.GT.P_FIELD ) THEN BL_IC7A.561
ERROR = 7 BL_IC7A.562
GOTO999 BL_IC7A.563
ENDIF BL_IC7A.564
BL_IC7A.565
!----------------------------------------------------------------------- BL_IC7A.566
!! Set pointers, etc. BL_IC7A.567
!----------------------------------------------------------------------- BL_IC7A.568
BL_IC7A.569
N_P_ROWS = N_ROWS BL_IC7A.570
N_U_ROWS = N_ROWS + 1 BL_IC7A.571
BL_IC7A.572
P_POINTS = N_P_ROWS * ROW_LENGTH BL_IC7A.573
U_POINTS = N_U_ROWS * ROW_LENGTH BL_IC7A.574
BL_IC7A.575
P1 = 1 + (FIRST_ROW-1)*ROW_LENGTH BL_IC7A.576
U1 = 1 + (FIRST_ROW-2)*ROW_LENGTH BL_IC7A.577
BL_IC7A.578
LAST_POINT = P1 + P_POINTS - 1 BL_IC7A.579
BL_IC7A.580
!----------------------------------------------------------------------- BL_IC7A.581
!! Set compressed land point pointers. BL_IC7A.582
!----------------------------------------------------------------------- BL_IC7A.583
BL_IC7A.584
LAND1=0 BL_IC7A.585
DO I=1,P1+P_POINTS-1 BL_IC7A.586
IF (LAND_INDEX(I).GE.P1) THEN BL_IC7A.587
LAND1 = I BL_IC7A.588
GOTO2 BL_IC7A.589
ENDIF BL_IC7A.590
ENDDO BL_IC7A.591
2 CONTINUE BL_IC7A.592
BL_IC7A.593
LAND_PTS=0 BL_IC7A.594
DO I=P1,P1+P_POINTS-1 BL_IC7A.595
IF (LAND_MASK(I)) LAND_PTS = LAND_PTS + 1 BL_IC7A.596
ENDDO BL_IC7A.597
BL_IC7A.598
*ELSE BL_IC7A.599
BL_IC7A.600
!----------------------------------------------------------------------- BL_IC7A.601
!! 0. Check grid definition arguments. This is single column model, so BL_IC7A.602
!! horizontal dimensions should all be 1. BL_IC7A.603
!----------------------------------------------------------------------- BL_IC7A.604
BL_IC7A.605
IF ( BL_LEVELS.LT.1 .OR. SM_LEVELS.LT.1) THEN BL_IC7A.606
ERROR = 1 BL_IC7A.607
GOTO999 BL_IC7A.608
ENDIF BL_IC7A.614
BL_IC7A.615
!----------------------------------------------------------------------- BL_IC7A.616
!! Set pointers, etc. Again most are 1 for single column model. BL_IC7A.617
!----------------------------------------------------------------------- BL_IC7A.618
BL_IC7A.619
N_P_ROWS = N_ROWS AJC1F405.314
N_U_ROWS = N_ROWS AJC1F405.315
AJC1F405.316
P_POINTS = N_P_ROWS * ROW_LENGTH AJC1F405.317
U_POINTS = N_U_ROWS * ROW_LENGTH AJC1F405.318
AJC1F405.319
P1 = 1 AJC1F405.320
U1 = 1 AJC1F405.321
AJC1F405.322
LAST_POINT = P1 + P_POINTS - 1 AJC1F405.323
AJC1F405.324
!--------------------------------------------------------------------- AJC1F405.325
!! Set compressed land point pointers. AJC1F405.326
!--------------------------------------------------------------------- AJC1F405.327
AJC1F405.328
LAND1=0 AJC1F405.329
DO I=1,P1+P_POINTS-1 AJC1F405.330
IF (LAND_INDEX(I).GE.P1) THEN AJC1F405.331
LAND1 = I AJC1F405.332
GOTO2 AJC1F405.333
ENDIF AJC1F405.334
ENDDO AJC1F405.335
2 CONTINUE AJC1F405.336
AJC1F405.337
LAND_PTS=0 AJC1F405.338
DO I=P1,P1+P_POINTS-1 AJC1F405.339
IF (LAND_MASK(I)) LAND_PTS = LAND_PTS + 1 AJC1F405.340
ENDDO AJC1F405.341
*ENDIF BL_IC7A.631
BL_IC7A.632
!----------------------------------------------------------------------- BL_IC7A.633
! Call TILEPTS to calculate TILE_PTS and TILE_INDEX BL_IC7A.634
!----------------------------------------------------------------------- BL_IC7A.635
CALL TILEPTS(P_FIELD,LAND_FIELD,LAND1,LAND_PTS, BL_IC7A.636
& FRAC,TILE_PTS,TILE_INDEX) BL_IC7A.637
BL_IC7A.638
BL_IC7A.639
BL_IC7A.640
!----------------------------------------------------------------------- BL_IC7A.641
! Call MOSES II physiology routine to calculate surface conductances BL_IC7A.642
! and carbon fluxes. BL_IC7A.643
! VSHR_Z1 provides level 1 windspeed and height. BL_IC7A.644
!----------------------------------------------------------------------- BL_IC7A.645
BL_IC7A.646
CALL VSHR_Z1 ( BL_IC7A.647
& P_FIELD,U_FIELD,LTIMER, BL_IC7A.648
& N_ROWS,FIRST_ROW,ROW_LENGTH, BL_IC7A.650
& AKH,BKH,EXNER,PSTAR,Q,QCF,QCL,T,U,V,U_0,V_0, BL_IC7A.652
& VSHR,Z1 BL_IC7A.653
& ) BL_IC7A.654
BL_IC7A.655
BL_IC7A.656
CALL PHYSIOL ( BL_IC7A.657
& LAND_FIELD,LAND_PTS,LAND1, BL_IC7A.658
& LAND_INDEX, BL_IC7A.660
& P_FIELD,SM_LEVELS,TILE_PTS,TILE_INDEX, BL_IC7A.662
& CO2_MMR,CO2_3D,CO2_DIM,L_CO2_INTERACTIVE, ACN1F405.118
& CS,FRAC,CANHT_FT,PHOTOSYNTH_ACT_RAD, ACN1F405.119
& LAI_FT,PSTAR,Q,STHU,TIMESTEP,T_DEEP_SOIL,TSTAR_TILE, BL_IC7A.664
& SMVCCL,SMVCST,SMVCWT,VSHR,Z0V_TILE,Z1, BL_IC7A.665
& G_LEAF,GS,GS_TILE,GPP,GPP_FT,NPP,NPP_FT, ABX1F405.801
& RESP_P,RESP_P_FT,RESP_S,RESP_W_FT,SMC,WT_EXT ABX1F405.802
& ) BL_IC7A.668
BL_IC7A.669
!---------------------------------------------------------------------- ABX1F405.803
! Increment accumulation of leaf turnover rate. ABX1F405.804
! This is required for leaf phenology and/or TRIFFID, either of ABX1F405.805
! which can be enabled independently of the other. ABX1F405.806
!---------------------------------------------------------------------- ABX1F405.807
IF (L_PHENOL.OR.L_TRIFFID) THEN ABX1F405.808
DO N=1,NPFT ABX1F405.809
DO L=LAND1,LAND1+LAND_PTS-1 ABX1F405.810
G_LEAF_ACC(L,N) = G_LEAF_ACC(L,N) + ABX1F405.811
& G_LEAF(L,N)*(TIMESTEP/SECS_PER_360DAYS) ABX1F405.812
ENDDO ABX1F405.813
ENDDO ABX1F405.814
ENDIF ABX1F405.815
ABX1F405.816
!---------------------------------------------------------------------- ABX1F405.817
! Increment accumulation prognostics for TRIFFID ABX1F405.818
!---------------------------------------------------------------------- ABX1F405.819
IF (L_TRIFFID) THEN ABX1F405.820
DO N=1,NPFT ABX1F405.821
DO L=LAND1,LAND1+LAND_PTS-1 ABX1F405.822
NPP_FT_ACC(L,N) = NPP_FT_ACC(L,N) + NPP_FT(L,N)*TIMESTEP ABX1F405.823
RESP_W_FT_ACC(L,N) = RESP_W_FT_ACC(L,N) ABX1F405.824
& + RESP_W_FT(L,N)*TIMESTEP ABX1F405.825
ENDDO ABX1F405.826
ENDDO ABX1F405.827
DO L=LAND1,LAND1+LAND_PTS-1 ABX1F405.828
RESP_S_ACC(L) = RESP_S_ACC(L) + RESP_S(L)*TIMESTEP ABX1F405.829
ENDDO ABX1F405.830
ENDIF ABX1F405.831
ABX1F405.832
BL_IC7A.685
!----------------------------------------------------------------------- BL_IC7A.686
! Calculate modified snow-free tile fractions for all but the ice tile BL_IC7A.687
!----------------------------------------------------------------------- BL_IC7A.688
DO N=1,NTYPE-1 BL_IC7A.689
DO L=1,LAND_FIELD ABX1F405.833
TILE_FRAC(L,N) = (1. - SNOW_FRAC(L))*FRAC(L,N) BL_IC7A.691
ENDDO BL_IC7A.692
ENDDO BL_IC7A.693
BL_IC7A.694
!----------------------------------------------------------------------- BL_IC7A.695
! Calculate the areal fraction of an "ice plus snow" tile by adding the BL_IC7A.696
! snow-covered fractions of all other tiles onto the areal fraction of BL_IC7A.697
! the land-ice tile BL_IC7A.698
!----------------------------------------------------------------------- BL_IC7A.699
N = NTYPE BL_IC7A.700
DO L=1,LAND_FIELD ABX1F405.834
TILE_FRAC(L,N) = FRAC(L,N) + SNOW_FRAC(L)*(1-FRAC(L,N)) BL_IC7A.702
ENDDO BL_IC7A.703
BL_IC7A.704
!----------------------------------------------------------------------- BL_IC7A.705
! Call TILEPTS to calculate TILE_PTS_S and TILE_INDEX_S BL_IC7A.706
!----------------------------------------------------------------------- BL_IC7A.707
CALL TILEPTS(P_FIELD,LAND_FIELD,LAND1,LAND_PTS, BL_IC7A.708
& TILE_FRAC,TILE_PTS_S,TILE_INDEX_S) BL_IC7A.709
BL_IC7A.710
!----------------------------------------------------------------------- BL_IC7A.711
! Call boundary layer routine carrying-out tile calculations on BL_IC7A.712
! snow-modified tiles BL_IC7A.713
!----------------------------------------------------------------------- BL_IC7A.714
BL_IC7A.715
CALL BDY_LAYR ( BL_IC7A.716
BL_IC7A.717
! IN values defining field dimensions and subset to be processed : BL_IC7A.718
& P_FIELD,U_FIELD,LAND_FIELD, BL_IC7A.719
& P_ROWS,FIRST_ROW,N_ROWS,ROW_LENGTH, BL_IC7A.720
& N_P_ROWS,N_U_ROWS,P_POINTS,P1,LAND1,LAND_PTS,U_POINTS,U1, BL_IC7A.721
BL_IC7A.722
! IN values defining vertical grid of model atmosphere : BL_IC7A.723
& BL_LEVELS,P_LEVELS,AK,BK,AKH,BKH,DELTA_AK,DELTA_BK, BL_IC7A.724
& EXNER, BL_IC7A.725
BL_IC7A.726
! IN soil/vegetation/land surface data : BL_IC7A.727
& LAND_INDEX, BL_IC7A.729
& LAND_MASK,L_Z0_OROG, BL_IC7A.731
& NTYPE,TILE_INDEX_S,TILE_PTS_S,SM_LEVELS, BL_IC7A.732
& CANOPY_TILE,CATCH_TILE,GS_TILE,HCON,HO2R2_OROG,LYING_SNOW, BL_IC7A.733
& SIL_OROG_LAND,SMC,SMVCST,STHF,STHU, BL_IC7A.734
& TILE_FRAC,WT_EXT,Z0V,Z0V_TILE, BL_IC7A.735
BL_IC7A.736
! IN sea/sea-ice data : BL_IC7A.737
& DI,ICE_FRACT,U_0,V_0, BL_IC7A.738
BL_IC7A.739
! IN cloud data : BL_IC7A.740
& CF,QCF,QCL,CCA,CCB,CCT, BL_IC7A.741
BL_IC7A.742
! IN everything not covered so far : BL_IC7A.743
& PSTAR,RAD_NO_SNOW,RAD_SNOW,TIMESTEP,VSHR, BL_IC7A.744
& L_RMBL,L_BL_LSPICE,L_MOM,L_NEG_TSTAR, ABX1F405.835
BL_IC7A.746
! IN STASH flags :- BL_IC7A.747
& SFME,SIMLT,SMLT,SLH,SQ1P5,ST1P5,SU10,SV10, BL_IC7A.748
BL_IC7A.749
! INOUT data : BL_IC7A.750
& Q,T,T_DEEP_SOIL,TSNOW,TI,TSTAR,TSTAR_TILE, BL_IC7A.751
& U,V,Z0MSEA, BL_IC7A.752
BL_IC7A.753
! OUT Diagnostic not requiring STASH flags : BL_IC7A.754
& CD,CH,ECAN,E_SEA,ESOIL_TILE,FQW, BL_IC7A.755
& FTL,FTL_TILE,H_SEA,RHOKH,RHOKM, BL_IC7A.756
& RIB,RIB_TILE,SEA_ICE_HTF,SURF_HT_FLUX,TAUX,TAUY, BL_IC7A.757
BL_IC7A.758
! OUT diagnostic requiring STASH flags : BL_IC7A.759
& FME,SICE_MLT_HTF,SNOMLT_SURF_HTF,LATENT_HEAT, BL_IC7A.760
& Q1P5M,T1P5M,U10M,V10M, BL_IC7A.761
BL_IC7A.762
! OUT data required for tracer mixing : BL_IC7A.763
& RHO_ARESIST,ARESIST,RESIST_B, BL_IC7A.764
& RHO_ARESIST_TILE,ARESIST_TILE,RESIST_B_TILE, BL_IC7A.765
& NRML, BL_IC7A.766
BL_IC7A.767
! OUT data required for 4D_VAR : BL_IC7A.768
& RHO_CD_MODV1,RHO_KM, BL_IC7A.769
BL_IC7A.770
! OUT data required elsewhere in UM system : BL_IC7A.771
& ECAN_TILE,EI,ES,EXT,SNOWMELT,ZH, BL_IC7A.772
& SOIL_SURF_HTF,SNOW_SURF_HTF, BL_IC7A.773
& T1_SD,Q1_SD,ERROR, BL_IC7A.774
BL_IC7A.775
! LOGICAL LTIMER BL_IC7A.776
& LTIMER BL_IC7A.777
& ) BL_IC7A.778
BL_IC7A.779
999 CONTINUE ! Branch for error exit. BL_IC7A.780
BL_IC7A.781
RETURN BL_IC7A.782
END BL_IC7A.783
BL_IC7A.784
*ENDIF BL_IC7A.785