SUBROUTINE IM_CAL_TQ ( 2,4IMCLTQ5B.46
& P_FIELD,P1 IMCLTQ5B.47
&,LAND_INDEX IMCLTQ5B.49
&,LAND_PTS,LAND1 IMCLTQ5B.51
&,P_POINTS,BL_LEVELS,N_TYPES,TILE_FRAC IMCLTQ5B.52
&,ALPHA1_GB,ALPHA1,ASHTF IMCLTQ5B.53
&,DTRDZ,DTRDZ_RML,RHOKH,RDZ IMCLTQ5B.54
&,ICE_FRACT,LYING_SNOW,RADNET_C,RESFT,RHOKPM_TILE APA1F405.485
&,RHOKPM_POT_TILE ANG1F405.194
&,TIMESTEP,LAND_MASK IMCLTQ5B.56
&,EPOT,EPOT_TILE ANG1F405.195
&,FQW,FQW_TILE,FTL,FTL_TILE,E_SEA,H_SEA,DQW_NT,QW ANG1F405.196
&,GAMMA,RHOKE,RHOKH_1,DTL_NT,TL IMCLTQ5B.58
&,SURF_HT_FLUX,NRML IMCLTQ5B.59
&,LTIMER IMCLTQ5B.60
&) IMCLTQ5B.61
IMCLTQ5B.62
IMPLICIT NONE IMCLTQ5B.63
IMCLTQ5B.64
LOGICAL LTIMER IMCLTQ5B.65
IMCLTQ5B.66
INTEGER IMCLTQ5B.67
& P_FIELD ! IN No. of points in P-grid. IMCLTQ5B.68
&,P1 ! IN First point to be processed in IMCLTQ5B.69
! P-grid. IMCLTQ5B.70
&,LAND1 ! IN First land point to be processed IMCLTQ5B.71
&,P_POINTS ! IN Number of P-grid points to be IMCLTQ5B.72
! processed. IMCLTQ5B.73
&,LAND_PTS ! IN Number of land points to be IMCLTQ5B.77
! processed. IMCLTQ5B.78
&,BL_LEVELS ! IN No. of atmospheric levels for IMCLTQ5B.82
! which boundary layer fluxes are IMCLTQ5B.83
! calculated. IMCLTQ5B.84
&,N_TYPES ! IN Number of land surface tiles IMCLTQ5B.85
&,LAND_INDEX(P_FIELD) ! IN LAND_INDEX(I)=J => the Jth IMCLTQ5B.86
! point in P_FIELD is the Ith IMCLTQ5B.87
! land point. IMCLTQ5B.88
IMCLTQ5B.89
REAL IMCLTQ5B.90
& DTRDZ(P_FIELD,BL_LEVELS) ! IN dz for bottom BL_LEVELS IMCLTQ5B.91
&,RDZ(P_FIELD,BL_LEVELS) ! IN 1./dz IMCLTQ5B.92
&,ALPHA1_GB(P_FIELD) ! IN Gradient of saturated specific IMCLTQ5B.93
! humidity with respect to IMCLTQ5B.94
! temperature between the bottom IMCLTQ5B.95
! model layer and the surface. IMCLTQ5B.96
&,ALPHA1(P_FIELD,N_TYPES) ! IN Gradient of saturated specific IMCLTQ5B.97
! humidity with respect to IMCLTQ5B.98
! temperature between the bottom IMCLTQ5B.99
! model layer and the surface. IMCLTQ5B.100
&,ASHTF(P_FIELD) ! IN Coefficient to calculate surface IMCLTQ5B.101
! heat flux into soil or sea-ice IMCLTQ5B.102
! (W/m2/K). IMCLTQ5B.103
&,RHOKH(P_FIELD,2:BL_LEVELS) ! IN Exchange coeff for FTL above IMCLTQ5B.104
! surface. IMCLTQ5B.105
&,GAMMA(BL_LEVELS) ! IN Implicit weighting. IMCLTQ5B.106
IMCLTQ5B.107
REAL ! Split to avoid > 19 continuations. IMCLTQ5B.108
& ICE_FRACT(P_FIELD) ! IN Fraction of grid-box which is IMCLTQ5B.109
! sea-ice (decimal fraction). IMCLTQ5B.110
&,LYING_SNOW(P_FIELD) ! IN Lying snow (kg per sq m ie "mm") IMCLTQ5B.111
&,RADNET_C(P_FIELD,N_TYPES) ! IN Area weighted ice component APA1F405.486
! of surface net radiation. IMCLTQ5B.113
! Modified for thermal canopy APA1F405.487
! over land. APA1F405.488
! (+ve downwards, W per sq m) IMCLTQ5B.114
&,RESFT(P_FIELD,N_TYPES) ! IN Total resistance factor IMCLTQ5B.115
&,RHOKPM(P_FIELD) ! IN Surface exchange coeff. IMCLTQ5B.116
&,RHOKPM_TILE(P_FIELD,N_TYPES)! IN Surface exchange coeff for tiles IMCLTQ5B.117
&,RHOKPM_POT_TILE(P_FIELD,N_TYPES) ANG1F405.197
! IN Surface exchange coeff. for ANG1F405.198
! potential evaporation. ANG1F405.199
&,TILE_FRAC(P_FIELD,N_TYPES) ! IN Tile fraction IMCLTQ5B.118
&,TIMESTEP ! IN Timestep in seconds. IMCLTQ5B.119
&,DTL_NT(P_FIELD,BL_LEVELS) ! IN Non-turbulent increment for TL. IMCLTQ5B.120
&,DQW_NT(P_FIELD,BL_LEVELS) ! IN Non-turbulent increment for QW. IMCLTQ5B.121
IMCLTQ5B.122
LOGICAL IMCLTQ5B.123
& LAND_MASK(P_FIELD) ! IN T for land, F elsewhere. IMCLTQ5B.124
IMCLTQ5B.125
! Next 5 arrays are all IN as "explicit" fluxes from P243 (SF_EXCH and IMCLTQ5B.126
! possibly KMKH), and OUT as "implicit" fluxes. IMCLTQ5B.127
IMCLTQ5B.128
REAL IMCLTQ5B.129
& FQW(P_FIELD,BL_LEVELS) ! INOUT Flux of QW (ie., for surface, IMCLTQ5B.130
! total evaporation). Kg/sq m/s IMCLTQ5B.131
&,FQW_TILE(P_FIELD,N_TYPES) ! INOUT Tile flux of QW. Kg/sq m/s IMCLTQ5B.132
&,EPOT(P_FIELD) ! INOUT Potential evaporation rate. ANG1F405.200
&,EPOT_TILE(P_FIELD,N_TYPES) ! INOUT Tile potential evaporation ANG1F405.201
! rate. ANG1F405.202
&,FTL(P_FIELD,BL_LEVELS) ! INOUT Flux of TL (ie., for surface, IMCLTQ5B.133
! H/Cp where H is sensible heat IMCLTQ5B.134
! in W per sq m). IMCLTQ5B.135
&,FTL_TILE(P_FIELD,N_TYPES) ! INOUT Tile flux of TL IMCLTQ5B.136
&,E_SEA(P_FIELD) ! INOUT Evaporation from sea times IMCLTQ5B.137
! leads fraction (kg/m2/s). IMCLTQ5B.138
! Zero over land. IMCLTQ5B.139
&,H_SEA(P_FIELD) ! INOUT Surface sensible heat flux ov IMCLTQ5B.140
! sea times leads fraction (W/m IMCLTQ5B.141
! Zero over land. IMCLTQ5B.142
&,QW(P_FIELD,BL_LEVELS) ! INOUT Total water content (kg per IMCLTQ5B.143
! kg air). From P243. IMCLTQ5B.144
&,RHOKE(P_FIELD,N_TYPES) ! IN Surface exchange coeff. for IMCLTQ5B.145
! FQW. IMCLTQ5B.146
! OUT =RHOKE to satisfy STASH. IMCLTQ5B.147
&,RHOKH_1(P_FIELD) ! IN Surface exchange coeffs for IMCLTQ5B.148
! FTL, IMCLTQ5B.149
! OUT =RHOKH_1 to satisfy STASH. IMCLTQ5B.150
&,TL(P_FIELD,BL_LEVELS) ! INOUT Liquid/frozen water IMCLTQ5B.151
! temperature (K). From P243. IMCLTQ5B.152
IMCLTQ5B.153
REAL IMCLTQ5B.154
& SURF_HT_FLUX(P_FIELD,N_TYPES)! OUT Net downward heat flux at IMCLTQ5B.155
! surface over land or sea-ice IMCLTQ5B.156
! fraction of gridbox (W/m2). IMCLTQ5B.157
&,DTRDZ_RML(P_FIELD) ! OUT dz for the rapidly mixing layer IMCLTQ5B.158
! (needed in P245). IMCLTQ5B.159
INTEGER IMCLTQ5B.160
& NRML(P_FIELD) ! IN The number of model layers IMCLTQ5B.161
! in the unstable rapidly mixing IMCLTQ5B.162
! layer. Zero if surface layer IMCLTQ5B.163
! is stable. IMCLTQ5B.164
IMCLTQ5B.165
! External references :- IMCLTQ5B.166
EXTERNAL TIMER IMCLTQ5B.167
IMCLTQ5B.168
! Local and other symbolic constants :- IMCLTQ5B.169
*CALL C_EPSLON 
IMCLTQ5B.170
*CALL C_G IMCLTQ5B.171
*CALL C_LHEAT IMCLTQ5B.172
*CALL C_R_CP IMCLTQ5B.173
*CALL C_SICEHC ! Holds integer AI IMCLTQ5B.174
IMCLTQ5B.175
IMCLTQ5B.176
REAL LS IMCLTQ5B.177
PARAMETER ( IMCLTQ5B.178
& LS=LC+LF ! Latent heat of sublimation (J per kg). IMCLTQ5B.179
&) IMCLTQ5B.180
IMCLTQ5B.181
! Workspace :- IMCLTQ5B.182
! 6*BL_LEVELS + 2 blocks of real workspace are required. IMCLTQ5B.183
REAL IMCLTQ5B.184
& AQ_AM(P_FIELD,BL_LEVELS) ! As AQ: "Q" elements of matrix in IMCLTQ5B.185
! eqn P244.79 (modified during IMCLTQ5B.186
! Gaussian elimination process). IMCLTQ5B.187
! As AM: elements of matrix in eqn IMCLTQ5B.188
! P244.80 (also get modified). IMCLTQ5B.189
&,AQ_RML(P_FIELD) ! Matrix element for humidity in IMCLTQ5B.190
! rapidly mixing layer. Then briefly IMCLTQ5B.191
! used for DELTAP on the UV grid. IMCLTQ5B.192
&,AT_ATQ(P_FIELD,BL_LEVELS) ! Elements in atmospheric T rows of IMCLTQ5B.193
! matrix in eqn P244.79 (modified IMCLTQ5B.194
! during Gaussian elimination). IMCLTQ5B.195
&,AT_RML(P_FIELD) ! Matrix element for temperature in IMCLTQ5B.196
! rapidly mixing layer. IMCLTQ5B.197
&,BPM(P_FIELD,N_TYPES) ! Used in calculating elements of IMCLTQ5B.198
! TL(1) and QW(1) rows of matrix. IMCLTQ5B.199
&,BPM_GB(P_FIELD) ! Used in calculating elements of IMCLTQ5B.200
! TL(1) and QW(1) rows of matrix. IMCLTQ5B.201
&,DELTAP(P_FIELD,BL_LEVELS) ! -g.dt/dp for the rapidly mixing IMCLTQ5B.202
! layer IMCLTQ5B.203
&,DELTAP_RML(P_FIELD) ! -g.dt/dp for the rapidly mixing IMCLTQ5B.204
! layer IMCLTQ5B.205
&,DELTA_QW(P_FIELD) ! Increment in QW. IMCLTQ5B.206
&,DELTA_TL(P_FIELD) ! Increment in TL. IMCLTQ5B.207
&,DQW_RML(P_FIELD) ! Rapidly mixing layer increment IMCLTQ5B.208
! to QW. IMCLTQ5B.209
&,DQW(P_FIELD,BL_LEVELS) ! Delta QW elements of vector IMCLTQ5B.210
! on RHS, then LHS, of eqn P244.79. IMCLTQ5B.211
&,DTL(P_FIELD,BL_LEVELS) ! Delta TL (for atmosphere) IMCLTQ5B.212
! elements of vector on RHS, then IMCLTQ5B.213
! LHS, of eqn P244.79. IMCLTQ5B.214
&,DTL_RML(P_FIELD) ! Delta TL for rapidly mixing layer. IMCLTQ5B.215
&,FQW_ICE(P_FIELD) ! "Explicit" surface flux of QW for IMCLTQ5B.216
! sea-ice fraction of gridsquare. IMCLTQ5B.217
&,FTL_ICE(P_FIELD) ! "Explicit" surface flux of TL for IMCLTQ5B.218
! sea-ice fraction of gridsquare. IMCLTQ5B.219
&,GAMMA_RKE_DQ(P_FIELD) ! Gamma*rhoke*dq IMCLTQ5B.220
&,LAT_HEAT(P_FIELD) ! Latent heat of evaporation for IMCLTQ5B.221
! snow-free land or sublimation for IMCLTQ5B.222
! snow-covered land. IMCLTQ5B.223
&,RHOKE_PM_GB(P_FIELD) ! tile avg of RHOKE*RHOKPM IMCLTQ5B.224
IMCLTQ5B.225
! Local scalars :- IMCLTQ5B.226
REAL IMCLTQ5B.227
& CTQ ! Matrix element in P244.??, for local increments to rml IMCLTQ5B.228
&,CQ ! Matrix element in "Q" row in eqn P244.79. IMCLTQ5B.229
&,CQ_RML ! As above but for rapidly mixing layer increment. IMCLTQ5B.230
&,CT ! Matrix element in "T" row in eqn P244.79. IMCLTQ5B.231
&,CT_RML ! As above but for rapidly mixing layer increment. IMCLTQ5B.232
&,RBTQ ! Reciprocal of B P244.??, for local increments to rml IMCLTQ5B.233
&,RBQ ! Reciprocal of BQ(') (eqns P244.98, 101, 104). IMCLTQ5B.234
&,RBQ_RML ! As above but for the rapidly mixing layer increment. IMCLTQ5B.235
&,RBT ! Reciprocal of BT' (eqns P244.107, 110, 113). IMCLTQ5B.236
&,RBT_RML ! As above but for the rapidly mixing layer increment. IMCLTQ5B.237
&,temp1 ! temporary IMCLTQ5B.238
&,temp2 ! temporary IMCLTQ5B.239
&,temp3 ! temporary ANG1F405.203
IMCLTQ5B.240
INTEGER IMCLTQ5B.241
& BLM1 ! BL_LEVELS minus 1. IMCLTQ5B.242
&,NRMLP1 ! NRML plus 1. IMCLTQ5B.243
&,I ! Loop counter (horizontal field index). IMCLTQ5B.244
&,L ! Loop counter (horizontal field index). IMCLTQ5B.245
&,ITILE ! Loop counter (land surface tile index). IMCLTQ5B.246
&,K ! Loop counter (vertical index). IMCLTQ5B.247
IMCLTQ5B.248
!----------------------------------------------------------------------- IMCLTQ5B.249
!! 0. Check that the scalars input to define the grid are consistent. IMCLTQ5B.250
! See comments to routine SF_EXCH for details. IMCLTQ5B.251
!----------------------------------------------------------------------- IMCLTQ5B.252
IMCLTQ5B.253
IF (LTIMER) THEN IMCLTQ5B.254
CALL TIMER('IMCALTQ ',3) IMCLTQ5B.255
ENDIF IMCLTQ5B.256
IMCLTQ5B.257
BLM1 = BL_LEVELS-1 IMCLTQ5B.258
IMCLTQ5B.259
!----------------------------------------------------------------------- IMCLTQ5B.260
!! (A) Calculations on P-grid. IMCLTQ5B.261
!----------------------------------------------------------------------- IMCLTQ5B.262
IMCLTQ5B.263
!----------------------------------------------------------------------- IMCLTQ5B.264
!! 1. Calculate implicit T and Q increments due to local mixing within IMCLTQ5B.265
!! the rapidly mixing layer (where it exists). IMCLTQ5B.266
!! The surface fluxes FTL(I,1), FQW(I,1) are used for calculating IMCLTQ5B.267
!! the rapidly mixing layer (rml) increments but not here. IMCLTQ5B.268
!! Therefore the matrix equation we must solve to find the implicit IMCLTQ5B.269
!! T and Q increments due to local mixing within the rml does not IMCLTQ5B.270
!! have a "surface" row and we can solve for the T and Q increments IMCLTQ5B.271
!! for K = 1 to NRML simultaneously. IMCLTQ5B.272
!----------------------------------------------------------------------- IMCLTQ5B.273
IMCLTQ5B.274
DO K = 1,BL_LEVELS IMCLTQ5B.275
DO I = P1,P1+P_POINTS-1 IMCLTQ5B.276
DELTAP(I,K) = -G * TIMESTEP/DTRDZ(I,K) IMCLTQ5B.277
ENDDO ! Loop over p-points IMCLTQ5B.278
ENDDO ! Loop over bl-levels IMCLTQ5B.279
IMCLTQ5B.280
!----------------------------------------------------------------------- IMCLTQ5B.281
!! 1.1 Start 'upward sweep' with lowest model layer, which will be the IMCLTQ5B.282
!! bottom of the rapidly mixing layer (rml) if it exists. IMCLTQ5B.283
!----------------------------------------------------------------------- IMCLTQ5B.284
IMCLTQ5B.285
DO I=P1,P1+P_POINTS-1 IMCLTQ5B.286
IMCLTQ5B.287
RHOKE_PM_GB(I) = 0.0 ! set to zero IMCLTQ5B.288
BPM_GB(I) = 0.0 IMCLTQ5B.289
IMCLTQ5B.290
LAT_HEAT(I) = LC IMCLTQ5B.291
IF (LAND_MASK(I)) THEN IMCLTQ5B.292
IF (LYING_SNOW(I).GT.0.0) LAT_HEAT(I) = LS IMCLTQ5B.293
ELSE IMCLTQ5B.294
IF (ICE_FRACT(I).GT.0.0) LAT_HEAT(I) = LS IMCLTQ5B.295
ENDIF IMCLTQ5B.296
IF (NRML(I) .GE. 2) THEN IMCLTQ5B.297
IMCLTQ5B.298
! "Explicit" increments due to local mixing within the rml. IMCLTQ5B.299
! P244.49/31 but surface flux used in rml increment calculations. IMCLTQ5B.300
IMCLTQ5B.301
! Add non-turbulent increments here IMCLTQ5B.302
DQW(I,1) = -DTRDZ(I,1) * FQW(I,2) + DQW_NT(I,1) IMCLTQ5B.303
IMCLTQ5B.304
DTL(I,1) = -DTRDZ(I,1) * FTL(I,2) + DTL_NT(I,1) IMCLTQ5B.305
IMCLTQ5B.306
! Define matrix elements (CTQ always zero for this case). IMCLTQ5B.307
IMCLTQ5B.308
AT_ATQ(I,1) = -DTRDZ(I,1) * GAMMA(2)*RHOKH(I,2)*RDZ(I,2) IMCLTQ5B.309
! ! P244.28 IMCLTQ5B.310
RBTQ = 1.0 / ( 1.0 - AT_ATQ(I,1) ) ! Reciprocal of P244.110 IMCLTQ5B.311
IMCLTQ5B.312
! Now start Gaussian elimination IMCLTQ5B.313
IMCLTQ5B.314
DQW(I,1) = RBTQ * DQW(I,1) ! P244.102 IMCLTQ5B.315
DTL(I,1) = RBTQ * DTL(I,1) ! P244.111 IMCLTQ5B.316
IMCLTQ5B.317
AT_ATQ(I,1) = RBTQ * AT_ATQ(I,1) ! P244.112 IMCLTQ5B.318
IMCLTQ5B.319
! Start calculating DELTAP_RML. Mid-level depths added in 2.2 below. IMCLTQ5B.320
IMCLTQ5B.321
DELTAP_RML(I) = DELTAP(I,1) IMCLTQ5B.322
ELSE ! No rapidly mixing layer calculations IMCLTQ5B.323
DTRDZ_RML(I) = 1.E30 IMCLTQ5B.324
DQW_RML(I) = 1.E30 IMCLTQ5B.325
DTL_RML(I) = 1.E30 IMCLTQ5B.326
AQ_RML(I) = 1.E30 IMCLTQ5B.327
AT_RML(I) = 1.E30 IMCLTQ5B.328
ENDIF IMCLTQ5B.329
ENDDO ! Loop over p_points IMCLTQ5B.330
IMCLTQ5B.331
!----------------------------------------------------------------------- IMCLTQ5B.332
!! 2.2 Continue upward sweep through middle of the rapidly mixing layer IMCLTQ5B.333
!! (if it exists) and to its top. NB NRML is always < temp= BLM1. IMCLTQ5B.334
!----------------------------------------------------------------------- IMCLTQ5B.335
IMCLTQ5B.336
DO K=2,BLM1 IMCLTQ5B.337
DO I=P1,P1+P_POINTS-1 IMCLTQ5B.338
IMCLTQ5B.339
! If in the top rapidly mixing layer then do not include flux at its IMCLTQ5B.340
! top in the calculation ie FQW(I,NRML+1) and FTL(I,NRML+1) are not IMCLTQ5B.341
! included here; they are taken account of in the non-local mixing IMCLTQ5B.342
! through the "rapidly mixing layer". IMCLTQ5B.343
IMCLTQ5B.344
IF ( K .EQ. NRML(I) ) THEN IMCLTQ5B.345
IMCLTQ5B.346
! Add final DELTAP contribution to DELTAP_RML and then calculate IMCLTQ5B.347
! DTRDZ_RML. Lower level contributions added in 2.1 and below. IMCLTQ5B.348
IMCLTQ5B.349
DELTAP_RML(I) = DELTAP_RML(I) + DELTAP(I,K) IMCLTQ5B.350
DTRDZ_RML(I) =-G * TIMESTEP / DELTAP_RML(I) IMCLTQ5B.351
IMCLTQ5B.352
IMCLTQ5B.353
! "Explicit" flux divergence across layer giving explicit IMCLTQ5B.354
! increment due to the local mixing at the top of rml. IMCLTQ5B.355
IMCLTQ5B.356
DQW(I,K) = DTRDZ(I,K) * FQW(I,K) + DQW_NT(I,K) IMCLTQ5B.357
IMCLTQ5B.358
DTL(I,K) = DTRDZ(I,K) * FTL(I,K) + DTL_NT(I,K) IMCLTQ5B.359
IMCLTQ5B.360
IMCLTQ5B.361
! Define matrix elements (A always zero for this case). IMCLTQ5B.362
IMCLTQ5B.363
CTQ = -DTRDZ(I,K) * GAMMA(k)*RHOKH(I,K)*RDZ(I,K) ! P244.36 IMCLTQ5B.364
RBTQ = 1.0 / ( 1.0 - CTQ*( 1.0 + AT_ATQ(I,K-1) ) ) IMCLTQ5B.365
! ... Reciprocal of P244.113 IMCLTQ5B.366
! Now start Gaussian elimination IMCLTQ5B.367
IMCLTQ5B.368
DQW(I,K) = RBTQ * ( DQW(I,K) - CTQ*DQW(I,K-1) ) IMCLTQ5B.369
DTL(I,K) = RBTQ * ( DTL(I,K) - CTQ*DTL(I,K-1) ) IMCLTQ5B.370
ELSEIF (K .LT. NRML(I)) THEN IMCLTQ5B.371
IMCLTQ5B.372
! Add layer depths to form total rml depth. IMCLTQ5B.373
IMCLTQ5B.374
DELTAP_RML(I) = DELTAP_RML(I) + DELTAP(I,K) IMCLTQ5B.375
IMCLTQ5B.376
! "Explicit" flux divergence across layer giving explicit IMCLTQ5B.377
! increment due to the local mixing.P244.54/38 IMCLTQ5B.378
IMCLTQ5B.379
DQW(I,K) = -DTRDZ(I,K) * ( FQW(I,K+1) - FQW(I,K) ) IMCLTQ5B.380
& + DQW_NT(I,K) IMCLTQ5B.381
IMCLTQ5B.382
DTL(I,K) = -DTRDZ(I,K) * ( FTL(I,K+1) - FTL(I,K) ) IMCLTQ5B.383
& + DTL_NT(I,K) IMCLTQ5B.384
IMCLTQ5B.385
! Define matrix elements. IMCLTQ5B.386
IMCLTQ5B.387
AT_ATQ(I,K) = -DTRDZ(I,K) * IMCLTQ5B.388
& GAMMA(K+1)*RHOKH(I,K+1)*RDZ(I,K+1) IMCLTQ5B.389
CTQ = -DTRDZ(I,K) * GAMMA(k)*RHOKH(I,K)*RDZ(I,K)! P244.36 IMCLTQ5B.390
RBTQ = 1.0 / ( 1.0 - AT_ATQ(I,K) IMCLTQ5B.391
& - CTQ * ( 1.0 + AT_ATQ(I,K-1) ) ) IMCLTQ5B.392
! ... Reciprocal of P244.113 IMCLTQ5B.393
! Now start Gaussian elimination IMCLTQ5B.394
IMCLTQ5B.395
DQW(I,K) = RBTQ * ( DQW(I,K) - CTQ*DQW(I,K-1) ) IMCLTQ5B.396
DTL(I,K) = RBTQ * ( DTL(I,K) - CTQ*DTL(I,K-1) ) IMCLTQ5B.397
AT_ATQ(I,K) = RBTQ * AT_ATQ(I,K) ! P244.115 IMCLTQ5B.398
ENDIF IMCLTQ5B.399
ENDDO !p_points IMCLTQ5B.400
ENDDO !blm1 IMCLTQ5B.401
IMCLTQ5B.402
!----------------------------------------------------------------------- IMCLTQ5B.403
!! 2.3 Downward sweep through matrix. Add implicit increments due to IMCLTQ5B.404
!! local mixing within the rapidly mixing layer. Update fluxes of IMCLTQ5B.405
!! heat and moisture at the surface and the top-of-rml using IMCLTQ5B.406
!! local mixing increments for layers 1 and NRML respectively. IMCLTQ5B.407
!----------------------------------------------------------------------- IMCLTQ5B.408
IMCLTQ5B.409
DO K=BLM1,1,-1 IMCLTQ5B.410
DO I=P1,P1+P_POINTS-1 IMCLTQ5B.411
IF ((NRML(I) .GE. 2) .AND. (K .EQ. NRML(I))) THEN IMCLTQ5B.412
QW(I,K) = QW(I,K) + DQW(I,K) ! P244.128 IMCLTQ5B.413
TL(I,K) = TL(I,K) + DTL(I,K) ! P244.127 IMCLTQ5B.414
FQW(I,K+1) = FQW(I,K+1) IMCLTQ5B.415
& + GAMMA(K+1)*RHOKH(I,K+1)*RDZ(I,K+1)*DQW(I,K) IMCLTQ5B.416
FTL(I,K+1) = FTL(I,K+1) IMCLTQ5B.417
& + GAMMA(K+1)*RHOKH(I,K+1)*RDZ(I,K+1)*DTL(I,K) IMCLTQ5B.418
ELSEIF ((NRML(I) .GE. 2) .AND. (K .LT. NRML(I))) THEN IMCLTQ5B.419
DQW(I,K) = DQW(I,K) IMCLTQ5B.420
& - AT_ATQ(I,K)*DQW(I,K+1) ! P244.??? IMCLTQ5B.421
DTL(I,K) = DTL(I,K) IMCLTQ5B.422
& - AT_ATQ(I,K)*DTL(I,K+1) ! P244.??? IMCLTQ5B.423
QW(I,K) = QW(I,K) + DQW(I,K) ! P244.128 IMCLTQ5B.424
TL(I,K) = TL(I,K) + DTL(I,K) ! P244.127 IMCLTQ5B.425
ENDIF IMCLTQ5B.426
IMCLTQ5B.427
IF ((NRML(I) .GE. 2) .AND. (K .EQ. 1)) THEN IMCLTQ5B.428
IMCLTQ5B.429
IF (LAND_MASK(I)) THEN IMCLTQ5B.430
IMCLTQ5B.431
DO ITILE=1,N_TYPES IMCLTQ5B.432
GAMMA_RKE_DQ(I) = GAMMA(1)*RHOKE(I,ITILE) * IMCLTQ5B.433
& (DQW(I,1) - ALPHA1(I,ITILE)*DTL(I,1)) IMCLTQ5B.434
IMCLTQ5B.435
FTL_TILE(I,ITILE) = FTL_TILE(I,ITILE) + IMCLTQ5B.436
& RHOKPM_TILE(I,ITILE)*(LAT_HEAT(I)* IMCLTQ5B.437
& GAMMA_RKE_DQ(I)- GAMMA(1)*ASHTF(I)*DTL(I,1)) IMCLTQ5B.438
IMCLTQ5B.439
FQW_TILE(I,ITILE) = FQW_TILE(I,ITILE) - IMCLTQ5B.440
& RHOKPM_TILE(I,ITILE) * (CP*GAMMA_RKE_DQ(I) + IMCLTQ5B.441
& GAMMA(1)*RESFT(I,ITILE)*ASHTF(I)*DQW(I,1)) IMCLTQ5B.442
EPOT_TILE(I,ITILE) = EPOT_TILE(I,ITILE) - ANG1F405.204
& RHOKPM_POT_TILE(I,ITILE) * ANG1F405.205
& (CP*GAMMA_RKE_DQ(I) + ANG1F405.206
& GAMMA(1)*ASHTF(I)*DQW(I,1)) ANG1F405.207
IMCLTQ5B.443
ENDDO ! ITILE IMCLTQ5B.444
IMCLTQ5B.445
ELSEIF (ICE_FRACT(I) .GT. 0.0) THEN IMCLTQ5B.446
IMCLTQ5B.447
GAMMA_RKE_DQ(I) = GAMMA(1)*RHOKE(I,1) * IMCLTQ5B.448
& (DQW(I,1) - ALPHA1(I,1)*DTL(I,1)) IMCLTQ5B.449
IMCLTQ5B.450
FQW_ICE(I) = FQW(I,1) - E_SEA(I) - RHOKPM_TILE(I,1) * IMCLTQ5B.451
& (CP*GAMMA_RKE_DQ(I) + GAMMA(1)*ASHTF(I)*DQW(I,1)) IMCLTQ5B.452
FTL_ICE(I) = FTL(I,1) - H_SEA(I)/CP + RHOKPM_TILE(I,1) * IMCLTQ5B.453
& (LS*GAMMA_RKE_DQ(I) - GAMMA(1)*ASHTF(I)*DTL(I,1)) IMCLTQ5B.454
E_SEA(I) = E_SEA(I) - (1.0 - ICE_FRACT(I)) * IMCLTQ5B.455
& GAMMA(1)*RHOKH_1(I)*DQW(I,1) IMCLTQ5B.456
H_SEA(I) = H_SEA(I) - (1.0 - ICE_FRACT(I)) * CP * IMCLTQ5B.457
& GAMMA(1)*RHOKH_1(I)*DTL(I,1) IMCLTQ5B.458
FTL_TILE(I,1) = FTL_ICE(I) + H_SEA(I)/CP IMCLTQ5B.459
FQW_TILE(I,1) = FQW_ICE(I) + E_SEA(I) IMCLTQ5B.460
EPOT_TILE(I,1) = FQW_ICE(I) + E_SEA(I) ANG1F405.208
IMCLTQ5B.461
ELSE ! ordinary sea point IMCLTQ5B.462
FTL_TILE(I,1) = FTL(I,1) - IMCLTQ5B.463
& GAMMA(1)*RHOKH_1(I)*DTL(I,1) IMCLTQ5B.464
FQW_TILE(I,1) = FQW(I,1) - IMCLTQ5B.465
& GAMMA(1)*RHOKH_1(I)*DQW(I,1) IMCLTQ5B.466
EPOT_TILE(I,1) = EPOT(I) - ANG1F405.209
& GAMMA(1)*RHOKH_1(I)*DQW(I,1) ANG1F405.210
ANG1F405.211
IMCLTQ5B.467
ENDIF ! land/ice/sea IMCLTQ5B.468
IMCLTQ5B.469
ENDIF ! nrml >= 2 and k=1 IMCLTQ5B.470
IMCLTQ5B.471
! Reset level 1 fluxes to zero before reaveraging tiles IMCLTQ5B.472
IMCLTQ5B.473
ENDDO ! p_points IMCLTQ5B.474
ENDDO !blm,-1,1 IMCLTQ5B.475
IMCLTQ5B.476
IMCLTQ5B.477
DO I=P1,P1+P_POINTS-1 IMCLTQ5B.478
IF(LAND_MASK(I)) THEN IMCLTQ5B.479
FTL(I,1)=0.0 IMCLTQ5B.480
FQW(I,1)=0.0 IMCLTQ5B.481
EPOT(I)=0.0 ANG1F405.212
ELSE IMCLTQ5B.482
FTL(I,1)=FTL_TILE(I,1) IMCLTQ5B.483
FQW(I,1)=FQW_TILE(I,1) IMCLTQ5B.484
RHOKE_PM_GB(I)=RHOKE(I,1)*RHOKPM_TILE(I,1) IMCLTQ5B.485
ENDIF IMCLTQ5B.486
ENDDO IMCLTQ5B.487
IMCLTQ5B.488
IMCLTQ5B.489
DO ITILE=1,N_TYPES IMCLTQ5B.490
DO I=P1,P1+P_POINTS-1 IMCLTQ5B.491
IF(LAND_MASK(I)) THEN IMCLTQ5B.492
FTL(I,1)=FTL(I,1)+FTL_TILE(I,ITILE)*TILE_FRAC(I,ITILE) IMCLTQ5B.493
FQW(I,1)=FQW(I,1)+FQW_TILE(I,ITILE)*TILE_FRAC(I,ITILE) IMCLTQ5B.494
EPOT(I)=EPOT(I)+EPOT_TILE(I,ITILE)*TILE_FRAC(I,ITILE) ANG1F405.213
RHOKE_PM_GB(I) = RHOKE_PM_GB(I) + TILE_FRAC(I,ITILE)* IMCLTQ5B.495
& RHOKE(I,ITILE)*RHOKPM_TILE(I,ITILE) IMCLTQ5B.496
IMCLTQ5B.497
ELSE IMCLTQ5B.498
FTL_TILE(I,ITILE) = FTL(I,1) IMCLTQ5B.499
FQW_TILE(I,ITILE) = FQW(I,1) IMCLTQ5B.500
EPOT_TILE(I,ITILE) = EPOT(I) ANG1F405.214
ENDIF IMCLTQ5B.501
ENDDO IMCLTQ5B.502
ENDDO IMCLTQ5B.503
IMCLTQ5B.504
!----------------------------------------------------------------------- IMCLTQ5B.505
!! 3. Calculate those matrix and vector elements on the LHS of eqn IMCLTQ5B.506
!! P244.79 which are to do with implicit solution of the moisture IMCLTQ5B.507
!! transport problem at the surface, above the rml (if it exists) IMCLTQ5B.508
!! and between all levels if it does not. IMCLTQ5B.509
!! Begin with "upward sweep" through lower half of matrix). IMCLTQ5B.510
!----------------------------------------------------------------------- IMCLTQ5B.511
!! 3.1 Row of matrix applying to QW transport into top "boundary" IMCLTQ5B.512
!! layer of model atmosphere. IMCLTQ5B.513
!----------------------------------------------------------------------- IMCLTQ5B.514
IMCLTQ5B.515
DO I=P1,P1+P_POINTS-1 IMCLTQ5B.516
! Include non-turbulent increments. IMCLTQ5B.517
DQW(I,BL_LEVELS) = DTRDZ(I,BL_LEVELS) * FQW(I,BL_LEVELS) IMCLTQ5B.518
& +DQW_NT(I,BL_LEVELS) IMCLTQ5B.519
! ... P244.58 IMCLTQ5B.520
IMCLTQ5B.521
AQ_AM(I,BL_LEVELS) = -DTRDZ(I,BL_LEVELS) ! P244.56 IMCLTQ5B.522
& * GAMMA(BL_LEVELS)*RHOKH(I,BL_LEVELS)* IMCLTQ5B.523
& RDZ(I,BL_LEVELS) IMCLTQ5B.524
IMCLTQ5B.525
RBQ = 1.0 / ( 1.0 - AQ_AM(I,BL_LEVELS) ) ! Reciprocal P244.98 IMCLTQ5B.526
DQW(I,BL_LEVELS) = RBQ * DQW(I,BL_LEVELS) ! P244.99 IMCLTQ5B.527
AQ_AM(I,BL_LEVELS) = RBQ * AQ_AM(I,BL_LEVELS) ! P244.100 IMCLTQ5B.528
ENDDO IMCLTQ5B.529
IMCLTQ5B.530
!----------------------------------------------------------------------- IMCLTQ5B.531
!! 3.2 Rows of matrix applying to "middle of boundary layer" model IMCLTQ5B.532
!! layers, i.e. all but the topmost and bottom layers. IMCLTQ5B.533
!----------------------------------------------------------------------- IMCLTQ5B.534
IMCLTQ5B.535
DO K=BLM1,2,-1 IMCLTQ5B.536
DO I=P1,P1+P_POINTS-1 IMCLTQ5B.537
IMCLTQ5B.538
! "Explicit" flux divergence across layer giving explicit QW increment. IMCLTQ5B.539
IMCLTQ5B.540
IF ( K .GT. NRML(I) ) THEN IMCLTQ5B.541
DQW(I,K) = -DTRDZ(I,K) * ( FQW(I,K+1) - FQW(I,K) ) IMCLTQ5B.542
& + DQW_NT(I,K) IMCLTQ5B.543
! ... P244.54 IMCLTQ5B.544
IMCLTQ5B.545
CQ = -DTRDZ(I,K) * GAMMA(K+1)*RHOKH(I,K+1)*RDZ(I,K+1) IMCLTQ5B.546
! ! P244.52 IMCLTQ5B.547
AQ_AM(I,K) = -DTRDZ(I,K) * GAMMA(K)*RHOKH(I,K)*RDZ(I,K) IMCLTQ5B.548
! ! P244.51 IMCLTQ5B.549
RBQ = 1.0 / ( 1.0 - AQ_AM(I,K) - CQ*( 1.0 + AQ_AM(I,K+1) ) ) IMCLTQ5B.550
! 1 2 2 1 IMCLTQ5B.551
! ... reciprocal of P244.101 IMCLTQ5B.552
IMCLTQ5B.553
! Now include non-turbulent increments. IMCLTQ5B.554
DQW(I,K) = RBQ * (DQW(I,K) - CQ*DQW(I,K+1) ) ! P244.102 IMCLTQ5B.555
IMCLTQ5B.556
AQ_AM(I,K) = RBQ * AQ_AM(I,K) ! P244.103 IMCLTQ5B.557
ENDIF IMCLTQ5B.558
ENDDO ! P_points IMCLTQ5B.559
ENDDO !blm1,2,-1 IMCLTQ5B.560
IMCLTQ5B.561
!----------------------------------------------------------------------- IMCLTQ5B.562
!! 3.3 Bottom model layer QW row of matrix equation. IMCLTQ5B.563
!----------------------------------------------------------------------- IMCLTQ5B.564
IMCLTQ5B.565
IMCLTQ5B.566
DO I=P1,P1+P_POINTS-1 IMCLTQ5B.567
IMCLTQ5B.568
DO ITILE=1,N_TYPES IMCLTQ5B.569
IF (LAND_MASK(I)) THEN IMCLTQ5B.570
BPM(I,ITILE) = GAMMA(1)*ASHTF(I)*RHOKPM_TILE(I,ITILE) IMCLTQ5B.571
ELSE IMCLTQ5B.572
BPM(I,ITILE) = (1. - ICE_FRACT(I))*GAMMA(1)*RHOKH_1(I) + IMCLTQ5B.573
& GAMMA(1)*ASHTF(I)*RHOKPM_TILE(I,1) IMCLTQ5B.574
ENDIF IMCLTQ5B.575
IMCLTQ5B.576
BPM_GB(I)=BPM_GB(I) + BPM(I,ITILE) * TILE_FRAC(I,ITILE) IMCLTQ5B.577
IMCLTQ5B.578
ENDDO !n_types IMCLTQ5B.579
IMCLTQ5B.580
IF ( NRML(I) .GE. 2 ) THEN IMCLTQ5B.581
IMCLTQ5B.582
!----------------------------------------------------------------------- IMCLTQ5B.583
!! 3.3.1 Start calculating rapidly mixing layer increments. IMCLTQ5B.584
!----------------------------------------------------------------------- IMCLTQ5B.585
IMCLTQ5B.586
NRMLP1 = NRML(I) + 1 IMCLTQ5B.587
IMCLTQ5B.588
! "Explicit" QW increment for the rapidly mixing layer. IMCLTQ5B.589
IMCLTQ5B.590
DQW_RML(I) = -DTRDZ_RML(I) * ( FQW(I,NRMLP1) - FQW(I,1) ) IMCLTQ5B.591
IMCLTQ5B.592
! Define coefficients A,B,C, for implicit calculations. IMCLTQ5B.593
IMCLTQ5B.594
AQ_RML(I) = - DTRDZ_RML(I)*GAMMA(1)*CP*RHOKE_PM_GB(I) IMCLTQ5B.595
IMCLTQ5B.596
CQ_RML = -DTRDZ_RML(I) * GAMMA(NRMLP1) IMCLTQ5B.597
& *RHOKH(I,NRMLP1)*RDZ(I,NRMLP1) IMCLTQ5B.598
IMCLTQ5B.599
RBQ_RML=0.0 IMCLTQ5B.600
IMCLTQ5B.601
IF (LAND_MASK(I)) THEN IMCLTQ5B.602
DO ITILE=1,N_TYPES IMCLTQ5B.603
IMCLTQ5B.604
RBQ_RML = RBQ_RML + TILE_FRAC(I,ITILE) * IMCLTQ5B.605
& 1./(1. - AQ_RML(I) - CQ_RML*(1. + AQ_AM(I,NRMLP1)) IMCLTQ5B.606
& + DTRDZ_RML(I)*RESFT(I,ITILE)*BPM(I,ITILE) ) IMCLTQ5B.607
IMCLTQ5B.608
ENDDO ! n_types IMCLTQ5B.609
ELSE IMCLTQ5B.610
RBQ_RML = 1./(1. - AQ_RML(I) IMCLTQ5B.611
& - CQ_RML*(1. + AQ_AM(I,NRMLP1)) IMCLTQ5B.612
& + DTRDZ_RML(I)*RESFT(I,1)*BPM_GB(I) ) IMCLTQ5B.613
ENDIF IMCLTQ5B.614
IMCLTQ5B.615
DQW_RML(I) = RBQ_RML * ( DQW_RML(I) IMCLTQ5B.616
& - CQ_RML * DQW(I,NRMLP1) ) IMCLTQ5B.617
AQ_RML(I) = RBQ_RML * AQ_RML(I) IMCLTQ5B.618
ELSE IMCLTQ5B.619
IMCLTQ5B.620
! "Explicit" increment for QW(1) when there is no rapidly mixing IMCLTQ5B.621
! layer or when it is only one model layer in depth. IMCLTQ5B.622
IMCLTQ5B.623
DQW(I,1) = - DTRDZ(I,1)*(FQW(I,2) - FQW(I,1)) + DQW_NT(I,1) IMCLTQ5B.624
IMCLTQ5B.625
AQ_AM(I,1) = - DTRDZ(I,1)*GAMMA(1)*CP*RHOKE_PM_GB(I) IMCLTQ5B.626
IMCLTQ5B.627
CQ = - DTRDZ(I,1)*GAMMA(2)*RHOKH(I,2)*RDZ(I,2) IMCLTQ5B.628
IMCLTQ5B.629
RBQ=0.0 IMCLTQ5B.630
IMCLTQ5B.631
DO ITILE=1,N_TYPES IMCLTQ5B.632
IF (LAND_MASK(I)) THEN IMCLTQ5B.633
RBQ = RBQ + TILE_FRAC(I,ITILE) * IMCLTQ5B.634
& 1./( 1. - AQ_AM(I,1) - CQ*(1. + AQ_AM(I,2)) IMCLTQ5B.635
& + DTRDZ(I,1)*RESFT(I,ITILE)*BPM(I,ITILE) ) IMCLTQ5B.636
ELSEIF(ITILE .EQ. 1) THEN IMCLTQ5B.637
RBQ = 1./( 1. - AQ_AM(I,1) - CQ*(1. + AQ_AM(I,2)) IMCLTQ5B.638
& + DTRDZ(I,1)*RESFT(I,1)*BPM(I,1) ) IMCLTQ5B.639
ENDIF IMCLTQ5B.640
ENDDO ! n_types IMCLTQ5B.641
IMCLTQ5B.642
DQW(I,1) = RBQ*(DQW(I,1) - CQ*DQW(I,2)) IMCLTQ5B.643
AQ_AM(I,1) = RBQ*AQ_AM(I,1) IMCLTQ5B.644
ENDIF IMCLTQ5B.645
ENDDO IMCLTQ5B.646
IMCLTQ5B.647
!----------------------------------------------------------------------- IMCLTQ5B.648
!! 4. Calculate those matrix and vector elements on the LHS of eqn IMCLTQ5B.649
!! P244.79 which are to do with implicit solution of the heat IMCLTQ5B.650
!! transport problem (i.e. for ice/liquid IMCLTQ5B.651
!! water temperatures in atmospheric boundary layer), and begin the IMCLTQ5B.652
!! solution algorithm (perform "upward sweep" through upper half of IMCLTQ5B.653
!! matrix). IMCLTQ5B.654
!----------------------------------------------------------------------- IMCLTQ5B.655
IMCLTQ5B.656
!----------------------------------------------------------------------- IMCLTQ5B.657
!! 4.2 Lowest atmospheric layer TL row of matrix. IMCLTQ5B.658
!----------------------------------------------------------------------- IMCLTQ5B.659
DO I=P1,P1+P_POINTS-1 IMCLTQ5B.660
IF (NRML(I) .GE. 2) THEN IMCLTQ5B.661
NRMLP1 = NRML(I) + 1 IMCLTQ5B.662
IMCLTQ5B.663
! "Explicit" rapidly mixing layer increment for TL. IMCLTQ5B.664
IMCLTQ5B.665
DTL_RML(I) = - DTRDZ_RML(I) * ( FTL(I,NRMLP1) - FTL(I,1) ) IMCLTQ5B.666
AT_RML(I) = - DTRDZ_RML(I)*GAMMA(NRMLP1)* IMCLTQ5B.667
& RHOKH(I,NRMLP1)*RDZ(I,NRMLP1) IMCLTQ5B.668
IMCLTQ5B.669
CT_RML = - DTRDZ_RML(I)*GAMMA(1)*RHOKE_PM_GB(I)*LAT_HEAT(I) IMCLTQ5B.670
IMCLTQ5B.671
RBT_RML=0.0 IMCLTQ5B.672
IF(LAND_MASK(I)) THEN IMCLTQ5B.673
DO ITILE=1,N_TYPES IMCLTQ5B.674
IMCLTQ5B.675
RBT_RML = RBT_RML + TILE_FRAC(I,ITILE) * IMCLTQ5B.676
& 1./(1. - AT_RML(I) - ALPHA1(I,ITILE)*CT_RML* IMCLTQ5B.677
& (1.+AQ_RML(I)) + DTRDZ_RML(I)*BPM(I,ITILE) ) IMCLTQ5B.678
ENDDO IMCLTQ5B.679
ELSE IMCLTQ5B.680
RBT_RML = 1./(1. - AT_RML(I) - ALPHA1(I,1)*CT_RML* IMCLTQ5B.681
& (1.+AQ_RML(I)) + DTRDZ_RML(I)*BPM(I,1) ) IMCLTQ5B.682
ENDIF IMCLTQ5B.683
IMCLTQ5B.684
DTL_RML(I) = RBT_RML*(DTL_RML(I) - CT_RML*DQW_RML(I)) IMCLTQ5B.685
AT_RML(I) = RBT_RML * AT_RML(I) IMCLTQ5B.686
ELSE IMCLTQ5B.687
IMCLTQ5B.688
! "Explicit" increment to TL(1) when there is no rapidly mixing layer IMCLTQ5B.689
! or it does not extend beyond the bottom model layer. IMCLTQ5B.690
IMCLTQ5B.691
DTL(I,1) = - DTRDZ(I,1)*(FTL(I,2) - FTL(I,1)) IMCLTQ5B.692
& + DTL_NT(I,1) IMCLTQ5B.693
CT = - DTRDZ(I,1)*GAMMA(1)*RHOKE_PM_GB(I)*LAT_HEAT(I) IMCLTQ5B.694
IMCLTQ5B.695
AT_ATQ(I,1) = - DTRDZ(I,1)*GAMMA(2)*RHOKH(I,2)*RDZ(I,2) IMCLTQ5B.696
IMCLTQ5B.697
RBT=0.0 IMCLTQ5B.698
IMCLTQ5B.699
DO ITILE=1,N_TYPES IMCLTQ5B.700
IMCLTQ5B.701
IF(LAND_MASK(I)) THEN IMCLTQ5B.702
RBT = RBT + TILE_FRAC(I,ITILE) * IMCLTQ5B.703
& 1./( 1. - AT_ATQ(I,1) - ALPHA1(I,ITILE)*CT* IMCLTQ5B.704
& (1. + AQ_AM(I,1)) + DTRDZ(I,1)*BPM(I,ITILE) ) IMCLTQ5B.705
ELSEIF(ITILE .EQ.1) THEN IMCLTQ5B.706
RBT = 1./( 1. - AT_ATQ(I,1) - ALPHA1(I,1)*CT* IMCLTQ5B.707
& (1. + AQ_AM(I,1)) + DTRDZ(I,1)*BPM(I,1) ) IMCLTQ5B.708
ENDIF IMCLTQ5B.709
ENDDO IMCLTQ5B.710
IMCLTQ5B.711
DTL(I,1) = RBT*(DTL(I,1) - CT*DQW(I,1)) IMCLTQ5B.712
AT_ATQ(I,1) = RBT*AT_ATQ(I,1) IMCLTQ5B.713
ENDIF IMCLTQ5B.714
ENDDO IMCLTQ5B.715
!----------------------------------------------------------------------- IMCLTQ5B.716
!! 4.3 Rows of matrix applying to TL transport into model layers in the IMCLTQ5B.717
!! "middle" of the "boundary" layer, i.e. all but the bottom layer IMCLTQ5B.718
!! and the top "boundary" layer. IMCLTQ5B.719
!----------------------------------------------------------------------- IMCLTQ5B.720
DO K=2,BLM1 IMCLTQ5B.721
DO I=P1,P1+P_POINTS-1 IMCLTQ5B.722
IMCLTQ5B.723
! "Explicit" flux divergence across layer giving explicit TL increment IMCLTQ5B.724
! due to mixing above rml if it exists or for all levels if it does IMCLTQ5B.725
! not. IMCLTQ5B.726
IMCLTQ5B.727
NRMLP1 = NRML(I) + 1 IMCLTQ5B.728
IF (K .GT. NRML(I)) THEN IMCLTQ5B.729
DTL(I,K) = -DTRDZ(I,K) * ( FTL(I,K+1) - FTL(I,K) ) IMCLTQ5B.730
& +DTL_NT(I,K) IMCLTQ5B.731
! ... P244.38 IMCLTQ5B.732
IMCLTQ5B.733
AT_ATQ(I,K) = -DTRDZ(I,K)*GAMMA(K+1)* IMCLTQ5B.734
& RHOKH(I,K+1)*RDZ(I,K+1) ! P244.35 IMCLTQ5B.735
CT = -DTRDZ(I,K) * GAMMA(K)*RHOKH(I,K)*RDZ(I,K) ! P244.36 IMCLTQ5B.736
IF ((NRML(I) .GE. 2) .AND. (K .EQ. NRMLP1)) THEN IMCLTQ5B.737
RBT = 1.0 / ( 1.0 - AT_ATQ(I,K) - CT*( 1.0 + AT_RML(I) ) ) IMCLTQ5B.738
DTL(I,K) = RBT * ( DTL(I,K) - CT*DTL_RML(I) ) IMCLTQ5B.739
ELSE IMCLTQ5B.740
RBT = 1.0 / ( 1.0 - AT_ATQ(I,K) IMCLTQ5B.741
& - CT*( 1.0 + AT_ATQ(I,K-1) ) ) IMCLTQ5B.742
! 1 2 2 1 IMCLTQ5B.743
! ... Reciprocal of P244.113 IMCLTQ5B.744
IMCLTQ5B.745
DTL(I,K) = RBT * ( DTL(I,K) - CT*DTL(I,K-1) ) IMCLTQ5B.746
! ... P244.114 IMCLTQ5B.747
ENDIF IMCLTQ5B.748
AT_ATQ(I,K) = RBT * AT_ATQ(I,K) ! P244.115 IMCLTQ5B.749
ENDIF IMCLTQ5B.750
ENDDO IMCLTQ5B.751
ENDDO IMCLTQ5B.752
!----------------------------------------------------------------------- IMCLTQ5B.753
!! 4.4 Top "boundary" layer TL row of matrix. TL for this layer can IMCLTQ5B.754
!! then be, and is, updated. IMCLTQ5B.755
!----------------------------------------------------------------------- IMCLTQ5B.756
DO I=P1,P1+P_POINTS-1 IMCLTQ5B.757
DTL(I,BL_LEVELS) = DTRDZ(I,BL_LEVELS) * FTL(I,BL_LEVELS) IMCLTQ5B.758
& + DTL_NT(I,BL_LEVELS) IMCLTQ5B.759
! ... P244.42 IMCLTQ5B.760
CT = -DTRDZ(I,BL_LEVELS) * GAMMA(BL_LEVELS)* IMCLTQ5B.761
& RHOKH(I,BL_LEVELS)*RDZ(I,BL_LEVELS) IMCLTQ5B.762
IMCLTQ5B.763
IF (NRML(I) .EQ. BLM1) THEN IMCLTQ5B.764
RBT = 1.0 / ( 1.0 - CT*( 1.0 + AT_RML(I) ) ) IMCLTQ5B.765
DTL(I,BL_LEVELS) = RBT * ( DTL(I,BL_LEVELS) IMCLTQ5B.766
& - CT*DTL_RML(I) ) IMCLTQ5B.767
ELSE IMCLTQ5B.768
RBT = 1.0 / ( 1.0 - CT*( 1.0 + AT_ATQ(I,BLM1) ) ) IMCLTQ5B.769
! ... Reciprocal of P244.116 IMCLTQ5B.770
IMCLTQ5B.771
DTL(I,BL_LEVELS) = RBT * ( DTL(I,BL_LEVELS) IMCLTQ5B.772
& - CT*DTL(I,BLM1) ) ! P244.117 IMCLTQ5B.773
ENDIF IMCLTQ5B.774
IMCLTQ5B.775
TL(I,BL_LEVELS) = TL(I,BL_LEVELS) + DTL(I,BL_LEVELS) ! P244.127 IMCLTQ5B.776
IMCLTQ5B.777
ENDDO IMCLTQ5B.778
IMCLTQ5B.779
!----------------------------------------------------------------------- IMCLTQ5B.780
!! 5. "Downward sweep" through whole matrix. TL, QW and IMCLTQ5B.781
!! updated when the final implicit increments have been calculated. IMCLTQ5B.782
!----------------------------------------------------------------------- IMCLTQ5B.783
!! 5.1 Remaining TL rows of matrix and add implicit increments above IMCLTQ5B.784
!! the rml or at all levels if it is less than two layers thick. IMCLTQ5B.785
!----------------------------------------------------------------------- IMCLTQ5B.786
IMCLTQ5B.787
DO K=BLM1,1,-1 IMCLTQ5B.788
DO I=P1,P1+P_POINTS-1 IMCLTQ5B.789
IF ( (K .GT. NRML(I)) .OR. (NRML(I) .LT. 2) ) THEN IMCLTQ5B.790
DTL(I,K) = DTL(I,K) - AT_ATQ(I,K)*DTL(I,K+1) IMCLTQ5B.791
! P244.118 IMCLTQ5B.792
TL(I,K) = TL(I,K) + DTL(I,K) ! P244.127 IMCLTQ5B.793
ENDIF IMCLTQ5B.794
ENDDO IMCLTQ5B.795
ENDDO IMCLTQ5B.796
IMCLTQ5B.797
!----------------------------------------------------------------------- IMCLTQ5B.798
!! 5.2 Rapidly mixing layer increments IMCLTQ5B.799
!----------------------------------------------------------------------- IMCLTQ5B.800
IMCLTQ5B.801
DO I=P1,P1+P_POINTS-1 IMCLTQ5B.802
IF ( NRML(I) .GE. 2 ) THEN IMCLTQ5B.803
NRMLP1 = NRML(I) + 1 IMCLTQ5B.804
DTL_RML(I) = DTL_RML(I) - AT_RML(I) * DTL(I,NRMLP1) IMCLTQ5B.805
DQW_RML(I) = DQW_RML(I) IMCLTQ5B.806
& - AQ_RML(I) * ALPHA1_GB(I) * DTL_RML(I) IMCLTQ5B.807
TL(I,1) = TL(I,1) + DTL_RML(I) IMCLTQ5B.808
QW(I,1) = QW(I,1) + DQW_RML(I) IMCLTQ5B.809
ELSE IMCLTQ5B.810
IMCLTQ5B.811
!----------------------------------------------------------------------- IMCLTQ5B.812
!! 5.3 Lowest-level QW row of matrix; local mixing where there is no rml IMCLTQ5B.813
!----------------------------------------------------------------------- IMCLTQ5B.814
IMCLTQ5B.815
DQW(I,1) = DQW(I,1) - ALPHA1_GB(I)*AQ_AM(I,1)*DTL(I,1) IMCLTQ5B.816
QW(I,1) = QW(I,1) + DQW(I,1) ! P244.128 IMCLTQ5B.817
ENDIF IMCLTQ5B.818
ENDDO IMCLTQ5B.819
IMCLTQ5B.820
!----------------------------------------------------------------------- IMCLTQ5B.821
!! 5.4 Remaining QW rows of matrix + updating of QW's. IMCLTQ5B.822
!! Add implicit increments due to mixing above rml or at all levels IMCLTQ5B.823
!! if there it does not exist. IMCLTQ5B.824
!----------------------------------------------------------------------- IMCLTQ5B.825
IMCLTQ5B.826
DO K=2,BL_LEVELS IMCLTQ5B.827
DO I=P1,P1+P_POINTS-1 IMCLTQ5B.828
IF (K .GT. NRML(I)) THEN IMCLTQ5B.829
IMCLTQ5B.830
IF ((NRML(I) .GE. 2) .AND. (K-1 .EQ. NRML(I))) THEN IMCLTQ5B.831
DQW(I,K) = DQW(I,K) - AQ_AM(I,K)*DQW_RML(I) IMCLTQ5B.832
ELSE IMCLTQ5B.833
DQW(I,K) = DQW(I,K) - AQ_AM(I,K)*DQW(I,K-1) ! P244.121 IMCLTQ5B.834
ENDIF IMCLTQ5B.835
IMCLTQ5B.836
QW(I,K) = QW(I,K) + DQW(I,K) ! P244.128 IMCLTQ5B.837
ELSE IMCLTQ5B.838
IMCLTQ5B.839
! Add the increments due to rapid mixing if in the rapidly mixing layer IMCLTQ5B.840
IMCLTQ5B.841
TL(I,K) = TL(I,K) + DTL_RML(I) IMCLTQ5B.842
QW(I,K) = QW(I,K) + DQW_RML(I) IMCLTQ5B.843
ENDIF IMCLTQ5B.844
IMCLTQ5B.845
ENDDO !p_points IMCLTQ5B.846
ENDDO !bl_levels IMCLTQ5B.847
IMCLTQ5B.848
!----------------------------------------------------------------------- IMCLTQ5B.849
!! 6. Calculate final implicit fluxes of heat and moisture. IMCLTQ5B.850
!----------------------------------------------------------------------- IMCLTQ5B.851
!! 6.1 Surface fluxes for the 3 surface types: land, sea-ice, ordinary IMCLTQ5B.852
!! sea. Pass out the value of RHOKH(,1) in GAMMA*RHOKH_1 to satisfy IMCLTQ5B.853
!! STASH GAMMA*RHOKH_RDZ will contain precisely that on output. IMCLTQ5B.854
!----------------------------------------------------------------------- IMCLTQ5B.855
IMCLTQ5B.856
DO I=P1,P1+P_POINTS-1 IMCLTQ5B.857
IF ( NRML(I) .GE. 2 ) THEN IMCLTQ5B.858
DELTA_TL(I) = DTL_RML(I) IMCLTQ5B.859
DELTA_QW(I) = DQW_RML(I) IMCLTQ5B.860
ELSE IMCLTQ5B.861
DELTA_TL(I) = DTL(I,1) IMCLTQ5B.862
DELTA_QW(I) = DQW(I,1) IMCLTQ5B.863
ENDIF IMCLTQ5B.864
IMCLTQ5B.865
GAMMA_RKE_DQ(I) = GAMMA(1)*RHOKE(I,1)* IMCLTQ5B.866
& (DELTA_QW(I) - ALPHA1(I,1)*DELTA_TL(I)) IMCLTQ5B.867
ENDDO !p_points IMCLTQ5B.868
IMCLTQ5B.869
IMCLTQ5B.870
DO ITILE=1,N_TYPES IMCLTQ5B.871
IMCLTQ5B.872
CDIR$ IVDEP IMCLTQ5B.878
! Fujitsu vectorization directive GRB0F405.359
!OCL NOVREC GRB0F405.360
DO L=LAND1,LAND1+LAND_PTS-1 IMCLTQ5B.879
I = LAND_INDEX(L) IMCLTQ5B.880
IMCLTQ5B.882
! overwrite gamma_rke_dq for land points only IMCLTQ5B.883
GAMMA_RKE_DQ(I) = GAMMA(1)*RHOKE(I,ITILE)* IMCLTQ5B.884
& (DELTA_QW(I) - ALPHA1(I,ITILE)*DELTA_TL(I)) IMCLTQ5B.885
IMCLTQ5B.886
temp1= RHOKPM_TILE(I,ITILE)*( LAT_HEAT(I)*GAMMA_RKE_DQ(I) - IMCLTQ5B.887
& GAMMA(1)*ASHTF(I)*DELTA_TL(I) ) IMCLTQ5B.888
IMCLTQ5B.889
FTL_TILE(I,ITILE) = FTL_TILE(I,ITILE) + temp1 IMCLTQ5B.890
FTL(I,1) = FTL(I,1) + temp1 * TILE_FRAC(I,ITILE) IMCLTQ5B.891
IMCLTQ5B.892
IMCLTQ5B.893
temp2= RHOKPM_TILE(I,ITILE)*( CP*GAMMA_RKE_DQ(I) + IMCLTQ5B.894
& GAMMA(1)*RESFT(I,ITILE)*ASHTF(I)*DELTA_QW(I) ) IMCLTQ5B.895
IMCLTQ5B.896
FQW_TILE(I,ITILE) = FQW_TILE(I,ITILE) - temp2 IMCLTQ5B.897
FQW(I,1) = FQW(I,1) - temp2 * TILE_FRAC(I,ITILE) IMCLTQ5B.898
temp3= RHOKPM_TILE(I,ITILE)*( CP*GAMMA_RKE_DQ(I) + ANG1F405.215
& GAMMA(1)*ASHTF(I)*DELTA_QW(I) ) ANG1F405.216
ANG1F405.217
EPOT_TILE(I,ITILE) = EPOT_TILE(I,ITILE) - temp3 ANG1F405.218
EPOT(I) = EPOT(I) - temp3 * TILE_FRAC(I,ITILE) ANG1F405.219
IMCLTQ5B.899
SURF_HT_FLUX(I,ITILE) = RADNET_C(I,ITILE) - APA1F405.489
& LAT_HEAT(I)*FQW_TILE(I,ITILE) - CP*FTL_TILE(I,ITILE) IMCLTQ5B.901
IMCLTQ5B.902
IMCLTQ5B.903
IMCLTQ5B.904
IF(ITILE .EQ. 1) THEN IMCLTQ5B.905
FTL_ICE(I) = 0.0 IMCLTQ5B.906
FQW_ICE(I) = 0.0 IMCLTQ5B.907
ENDIF IMCLTQ5B.908
IMCLTQ5B.909
ENDDO ! land points IMCLTQ5B.913
ENDDO ! End of Tile loop IMCLTQ5B.914
IMCLTQ5B.915
IMCLTQ5B.916
DO I=P1,P1+P_POINTS-1 IMCLTQ5B.917
IMCLTQ5B.918
IF (.NOT. LAND_MASK(I) .AND. ICE_FRACT(I).GT.0.0) THEN IMCLTQ5B.919
FQW_ICE(I) = FQW(I,1) - E_SEA(I) - RHOKPM_TILE(I,1) * IMCLTQ5B.920
& (CP*GAMMA_RKE_DQ(I) + GAMMA(1)*ASHTF(I)*DELTA_QW(I)) IMCLTQ5B.921
FTL_ICE(I) = FTL(I,1) - H_SEA(I)/CP + RHOKPM_TILE(I,1) * IMCLTQ5B.922
& (LS*GAMMA_RKE_DQ(I) - GAMMA(1)*ASHTF(I)*DELTA_TL(I)) IMCLTQ5B.923
E_SEA(I) = E_SEA(I) - (1.0 - ICE_FRACT(I)) * IMCLTQ5B.924
& GAMMA(1)*RHOKE(I,1)*DELTA_QW(I) IMCLTQ5B.925
H_SEA(I) = H_SEA(I) - (1.0 - ICE_FRACT(I)) * CP * IMCLTQ5B.926
& GAMMA(1)*RHOKH_1(I)*DELTA_TL(I) IMCLTQ5B.927
FTL(I,1) = FTL_ICE(I) + H_SEA(I)/CP IMCLTQ5B.928
FQW(I,1) = FQW_ICE(I) + E_SEA(I) IMCLTQ5B.929
IMCLTQ5B.930
FTL_TILE(I,1)=FTL(I,1) IMCLTQ5B.931
FQW_TILE(I,1)=FQW(I,1) IMCLTQ5B.932
EPOT(I) = FQW_ICE(I) + E_SEA(I) ANG1F405.220
EPOT_TILE(I,1)=EPOT(I) ANG1F405.221
ANG1F405.222
IMCLTQ5B.933
SURF_HT_FLUX(I,1) = RADNET_C(I,1) - LS*FQW_ICE(I) - APA1F405.490
& CP*FTL_ICE(I) IMCLTQ5B.935
IMCLTQ5B.936
! ordinary sea point IMCLTQ5B.937
ELSEIF(.NOT. LAND_MASK(I) .AND. ICE_FRACT(I).EQ.0.0) THEN IMCLTQ5B.938
IMCLTQ5B.939
FTL(I,1) = FTL(I,1) - GAMMA(1)*RHOKH_1(I)*DELTA_TL(I) IMCLTQ5B.940
FQW(I,1) = FQW(I,1) - GAMMA(1)*RHOKH_1(I)*DELTA_QW(I) IMCLTQ5B.941
IMCLTQ5B.942
FTL_TILE(I,1)=FTL(I,1) IMCLTQ5B.943
FQW_TILE(I,1)=FQW(I,1) IMCLTQ5B.944
EPOT(I) = EPOT(I) - GAMMA(1)*RHOKH_1(I)*DELTA_QW(I) ANG1F405.223
EPOT_TILE(I,1)=EPOT(I) ANG1F405.224
IMCLTQ5B.945
E_SEA(I) = FQW(I,1) IMCLTQ5B.946
H_SEA(I) = FTL(I,1)*CP IMCLTQ5B.947
IMCLTQ5B.948
FTL_ICE(I) = 0.0 IMCLTQ5B.949
FQW_ICE(I) = 0.0 IMCLTQ5B.950
ARN1F404.14
SURF_HT_FLUX(I,1) = RADNET_C(I,1) - LC*E_SEA(I) - H_SEA(I) APA1F405.491
IMCLTQ5B.951
ENDIF IMCLTQ5B.952
ENDDO IMCLTQ5B.953
IMCLTQ5B.954
C----------------------------------------------------------------------- ANG1F405.225
CL Ensures that the potential evaporation rate equals the evaporation ANG1F405.226
CL rate, when there is net condensation. Otherwise E/Ep could be ANG1F405.227
CL <0 or >1 when the implicit adjustment is added. ANG1F405.228
C----------------------------------------------------------------------- ANG1F405.229
DO I=P1,P1+P_POINTS-1 ANG1F405.230
IF(FQW(I,1).LT.0.0)THEN ANG1F405.231
EPOT(I)=FQW(I,1) ANG1F405.232
ENDIF ANG1F405.233
ENDDO ANG1F405.234
!----------------------------------------------------------------------- IMCLTQ5B.955
!! 6.2 Fluxes at layer interfaces above the surface. IMCLTQ5B.956
!----------------------------------------------------------------------- IMCLTQ5B.957
DO K=2,BL_LEVELS IMCLTQ5B.958
DO I=P1,P1+P_POINTS-1 IMCLTQ5B.959
IMCLTQ5B.960
! Calculate and store fluxes due to local mixing. IMCLTQ5B.961
! FTL(local mixing) stored in array AT, IMCLTQ5B.962
! FQW(local mixing) stored in array AQ_AM. IMCLTQ5B.963
IMCLTQ5B.964
NRMLP1 = NRML(I) + 1 IMCLTQ5B.965
IF ((NRML(I) .GE. 2) .AND. (K .EQ. NRMLP1)) THEN IMCLTQ5B.966
AT_ATQ(I,K) = FTL(I,K) - GAMMA(K)*RHOKH(I,K)*RDZ(I,K) IMCLTQ5B.967
& * ( DTL(I,K) - DTL_RML(I) ) IMCLTQ5B.968
AQ_AM(I,K) = FQW(I,K) - GAMMA(K)*RHOKH(I,K)*RDZ(I,K) IMCLTQ5B.969
& * ( DQW(I,K) - DQW_RML(I) ) IMCLTQ5B.970
ELSE IMCLTQ5B.971
AT_ATQ(I,K) = FTL(I,K) - GAMMA(K)*RHOKH(I,K)*RDZ(I,K) IMCLTQ5B.972
& * ( DTL(I,K) - DTL(I,K-1) ) IMCLTQ5B.973
AQ_AM(I,K) = FQW(I,K) - GAMMA(K)*RHOKH(I,K)*RDZ(I,K) IMCLTQ5B.974
& * ( DQW(I,K) - DQW(I,K-1) ) IMCLTQ5B.975
ENDIF IMCLTQ5B.976
IMCLTQ5B.977
! Now calculate the implicit fluxes including both local mixing and IMCLTQ5B.978
! if appropriate also the fluxes due to rapid mixing through layers. IMCLTQ5B.979
IMCLTQ5B.980
IF ( K .EQ. 2 ) THEN IMCLTQ5B.981
IF ( NRML(I) .GE. 2 ) THEN IMCLTQ5B.982
FTL(I,K) = AT_ATQ(I,K) IMCLTQ5B.983
& + FTL(I,K-1) - DTL_RML(I) / DTRDZ(I,K-1) IMCLTQ5B.984
FQW(I,K) = AQ_AM(I,K) IMCLTQ5B.985
& + FQW(I,K-1) - DQW_RML(I) / DTRDZ(I,K-1) IMCLTQ5B.986
ELSE IMCLTQ5B.987
FTL(I,K) = AT_ATQ(I,K) IMCLTQ5B.988
FQW(I,K) = AQ_AM(I,K) IMCLTQ5B.989
ENDIF IMCLTQ5B.990
ELSEIF ( K .LE. NRML(I) ) THEN IMCLTQ5B.991
FTL(I,K) = AT_ATQ(I,K) - AT_ATQ(I,K-1) IMCLTQ5B.992
& + FTL(I,K-1) - DTL_RML(I) / DTRDZ(I,K-1) IMCLTQ5B.993
FQW(I,K) = AQ_AM(I,K) - AQ_AM(I,K-1) IMCLTQ5B.994
& + FQW(I,K-1) - DQW_RML(I) / DTRDZ(I,K-1) IMCLTQ5B.995
ELSE IMCLTQ5B.996
FTL(I,K) = AT_ATQ(I,K) IMCLTQ5B.997
FQW(I,K) = AQ_AM(I,K) IMCLTQ5B.998
ENDIF IMCLTQ5B.999
ENDDO ! p_points IMCLTQ5B.1000
ENDDO ! bl_levels IMCLTQ5B.1001
IMCLTQ5B.1002
IF (LTIMER) THEN IMCLTQ5B.1003
CALL TIMER('IMCALTQ ',4) IMCLTQ5B.1004
ENDIF IMCLTQ5B.1005
IMCLTQ5B.1006
RETURN IMCLTQ5B.1007
END IMCLTQ5B.1008
*ENDIF IMCLTQ5B.1009