*IF DEF,A03_3A,OR,DEF,A03_5A AJS1F401.1482
C ******************************COPYRIGHT****************************** GTS2F400.5203
C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved. GTS2F400.5204
C GTS2F400.5205
C Use, duplication or disclosure of this code is subject to the GTS2F400.5206
C restrictions as set forth in the contract. GTS2F400.5207
C GTS2F400.5208
C Meteorological Office GTS2F400.5209
C London Road GTS2F400.5210
C BRACKNELL GTS2F400.5211
C Berkshire UK GTS2F400.5212
C RG12 2SZ GTS2F400.5213
C GTS2F400.5214
C If no contract has been raised with this copy of the code, the use, GTS2F400.5215
C duplication or disclosure of it is strictly prohibited. Permission GTS2F400.5216
C to do so must first be obtained in writing from the Head of Numerical GTS2F400.5217
C Modelling at the above address. GTS2F400.5218
C ******************************COPYRIGHT****************************** GTS2F400.5219
C GTS2F400.5220
C*LL SUBROUTINE KMKH--------------------------------------------------- KMKH3A.3
CLL KMKH3A.4
CLL Purpose: To calculate the turbulent mixing coefficients KM and KH KMKH3A.5
CLL and then the "explicit" turbulent fluxes for layer KMKH3A.6
CLL interfaces 1+1/2 to BL_LEVELS-1/2. KMKH3A.7
CLL KMKH3A.8
CLL KMKH3A.10
CLL Model Modification history from model version 3.0: KMKH3A.11
CLL version date KMKH3A.12
CLL KMKH3A.13
CLL 3.4 18/10/94 *DECK inserted into UM version 3.4. S Jackson KMKH3A.14
CLL KMKH3A.15
CLL 4.0 05/01/95 rho*Km before interpolation output via argument ASJ1F400.14
CLL list. R.N.B.Smith ASJ1F400.15
!LL 4.1 29/05/96 Remove U_ROWS check and add swapbounds for MPP APBGF401.88
!LL code. P.Burton APBGF401.89
CLL ASJ1F400.16
CLL 4.1 27/03/96 Correct declaration of ZLB. S Jackson ASJ2F401.1
CLL 4.2 Oct. 96 T3E migration - *DEF CRAY removed GSS1F402.66
CLL S J Swarbrick GSS1F402.67
!LL 4.2 08/01/97 Add SWAPBOUNDS for RHOKM. RTHBarnes. ARB2F402.41
!LL 4.3 14/01/97 MPP code : Corrected setting of polar rows GPB1F403.231
!LL P.Burton GPB1F403.232
!LL 4.3 18/03/97 Protect swapbounds by *IF DEF,MPP. RTHBarnes. ARB2F403.149
CLL 4.3 04/02/97 Number of model layers in turbulently mixed layer ARN1F403.78
CLL diagnosed and stored in NTML(*). ARN1F403.79
CLL NTML also passed to EX_COEF. ARN1F403.80
CLL Logical switches passed to EX_COEF. ARN1F403.81
CLL R.N.B.Smith ARN1F403.82
!LL 4.4 08/09/97 L_BL_LSPICE specifies mixed phase precipitation ADM3F404.135
!LL scheme D.Wilson ADM3F404.136
!!! 4.5 Jul. 98 Kill the IBM specific lines (JCThil) AJC1F405.133
CLL ARN1F403.83
CLL ARN1F403.84
CLL Programming standard: Unified Model Documentation Paper No 4, KMKH3A.16
CLL Version 2, dated 18/1/90. KMKH3A.17
CLL KMKH3A.18
CLL System component covered: Part of P243. KMKH3A.19
CLL KMKH3A.20
CLL Documentation: UMDP No.24 KMKH3A.21
CLL KMKH3A.22
CLL--------------------------------------------------------------------- KMKH3A.23
C* KMKH3A.24
C*L Arguments :- KMKH3A.25
SUBROUTINE KMKH ( 4,16KMKH3A.26
+ P_FIELD,U_FIELD,P1,U1, KMKH3A.27
+ P_POINTS,U_POINTS,ROW_LENGTH,P_ROWS,U_ROWS,BL_LEVELS KMKH3A.28
+,TIMESTEP,AK,BK,AKH,BKH,DELTA_AK,DELTA_BK,CCA,BQ_1,BT_1,BF_1 ADM3F404.137
&,CF,DZL ADM3F404.138
+,PSTAR,Q,QCF,QCL,RDZ,T,TV,U,U_P,V,V_P,Z0M,ZLB,H_BLEND KMKH3A.30
+,FQW,FTL,TAUX,TAUY,QW,RHOKM,RHOKH,TL,ZH KMKH3A.31
+,RDZUV,RHO_KM ASJ1F400.17
+,CCB,CCT,L_MOM,L_MIXLEN ARN1F403.85
&,L_BL_LSPICE ADM3F404.139
+,NRML KMKH3A.34
+,ERROR,LTIMER KMKH3A.35
+) KMKH3A.36
KMKH3A.37
IMPLICIT NONE KMKH3A.38
LOGICAL LTIMER ! IN Flag for TIMER diagnostics KMKH3A.39
&,L_BL_LSPICE ! IN ADM3F404.140
! TRUE Use scientific treatment of mixed ADM3F404.141
! phase precip scheme. ADM3F404.142
! FALSE Do not use mixed phase precip ADM3F404.143
! considerations ADM3F404.144
C ARN1F403.86
LOGICAL ARN1F403.87
& L_MOM ! IN Switch for convective momentum transport. ARN1F403.88
&,L_MIXLEN ! IN Switch for reducing the turbulent mixing ARN1F403.89
C ! length above the top of the boundary layer. ARN1F403.90
C ARN1F403.91
INTEGER KMKH3A.40
+ P_FIELD ! IN No. of P-grid points in whole field. KMKH3A.41
+,U_FIELD ! IN No. of UV-grid points in whole field. KMKH3A.42
+,P1 ! IN First P-grid point to be processed. KMKH3A.43
+,U1 ! IN First UV-grid point to be processed. KMKH3A.44
+,P_POINTS ! IN No. of P-grid points to be processed. KMKH3A.45
+,U_POINTS ! IN No. of UV-grid points to be processed. KMKH3A.46
+,ROW_LENGTH ! IN No. of points in latitude row (inclusive of KMKH3A.50
C ! endpoints for limited area model). KMKH3A.51
+,P_ROWS ! IN No. of P-rows of data to be processed. KMKH3A.55
+,U_ROWS ! IN No. of UV-rows of data to be processed. KMKH3A.59
+,BL_LEVELS ! IN No. of atmospheric levels for which boundary KMKH3A.63
C ! layer fluxes are calculated. Assumed <=30 KMKH3A.64
C ! for dimensioning GAMMA() in common deck C_GAMMA KMKH3A.65
REAL KMKH3A.66
+ TIMESTEP ! IN Timestep in seconds. KMKH3A.67
+,AK(BL_LEVELS) ! IN Hybrid "A" for boundary levels. KMKH3A.68
+,BK(BL_LEVELS) ! IN Hybrid "B" for boundary levels. KMKH3A.69
+,AKH(BL_LEVELS) ! IN Hybrid "A" for layer interfaces. KMKH3A.70
C ! AKH(K) is value for lower boundary KMKH3A.71
C ! of layer K. KMKH3A.72
+,BKH(BL_LEVELS) ! IN Hybrid "B" for layer interfaces. KMKH3A.73
C ! BKH(K) is value for lower boundary KMKH3A.74
C ! of layer K. KMKH3A.75
+,DELTA_AK(BL_LEVELS) ! IN Hybrid A-difference across layer. KMKH3A.76
+,DELTA_BK(BL_LEVELS) ! IN Hybrid B-difference across layer. KMKH3A.77
+,CCA(P_FIELD) ! IN Convective Cloud Amount. KMKH3A.78
+,BQ_1(P_FIELD) ! IN A buoyancy parameter for lowest KMKH3A.79
C ! atmospheric level (from routine KMKH3A.80
C ! SF_EXCH). KMKH3A.81
+,BT_1(P_FIELD) ! IN A buoyancy parameter for lowest KMKH3A.82
C ! atmospheric level (from routine KMKH3A.83
C ! SF_EXCH). KMKH3A.84
&,BF_1(P_FIELD) ADM3F404.145
! IN A buoyancy parameter for lowest ADM3F404.146
! atmospheric level (from routine SF_EXCH). ADM3F404.147
+,CF(P_FIELD,BL_LEVELS) ! IN Cloud fractions for boundary levs. KMKH3A.85
+,DZL(P_FIELD,BL_LEVELS) ! IN Layer depths (m). DZL(,K) is the KMKH3A.86
C ! distance from layer boundary K-1/2 KMKH3A.87
C ! to layer boundary K+1/2. For K=1 KMKH3A.88
C ! the lower boundary is the surface. KMKH3A.89
+,PSTAR(P_FIELD) ! IN Surface pressure (Pa). KMKH3A.90
+,Q(P_FIELD,BL_LEVELS) ! IN Sp humidity (kg water per kg air). KMKH3A.91
+,QCF(P_FIELD,BL_LEVELS) ! IN Cloud ice (kg per kg air). KMKH3A.92
+,QCL(P_FIELD,BL_LEVELS) ! IN Cloud liq water (kg per kg air). KMKH3A.93
REAL ! Split to keep continuation cards < 19 KMKH3A.94
+ RDZ(P_FIELD,BL_LEVELS) ! IN Reciprocal of distance between KMKH3A.95
C ! hybrid levels (m-1). 1/RDZ(,K) is KMKH3A.96
C ! the vertical distance from level KMKH3A.97
C ! K-1 to level K, except that for KMKH3A.98
C ! K=1 it is just the height of the KMKH3A.99
C ! lowest atmospheric level. KMKH3A.100
+,T(P_FIELD,BL_LEVELS) ! IN Temperature (K). KMKH3A.101
+,TV(P_FIELD,BL_LEVELS) ! IN Virtual temperature (K) - from KMKH3A.102
C ! SUBROUTINE Z. KMKH3A.103
+,U(U_FIELD,BL_LEVELS) ! IN Westerly wind component on UV-grid KMKH3A.104
C ! (m per s). KMKH3A.105
+,U_P(P_FIELD,BL_LEVELS) ! IN Westerly wind component on P-grid KMKH3A.106
C ! (m per s). KMKH3A.107
+,V(U_FIELD,BL_LEVELS) ! IN Southerly wind component on KMKH3A.108
C ! UV-grid (m per s). KMKH3A.109
+,V_P(P_FIELD,BL_LEVELS) ! IN Southerly wind component on P-grid KMKH3A.110
C ! (m per s). KMKH3A.111
+,Z0M(P_FIELD) ! IN Roughness length for momentum (m). KMKH3A.112
+,ZLB(P_FIELD,BL_LEVELS) ! IN ZLB(,K) is height above surface of ASJ2F401.2
C ! lower boundary of layer K (m). KMKH3A.114
+,H_BLEND(P_FIELD) ! IN Blending height for effective KMKH3A.115
C ! roughness scheme passed through KMKH3A.116
C ! EX_COEF KMKH3A.117
REAL ! Note: for all these INOUT arrays, KMKH3A.118
C ! apart from ZH, level 1 is IN KMKH3A.119
C ! (though not always used), and KMKH3A.120
C ! the other levels are all OUT. KMKH3A.121
+ FQW(P_FIELD,BL_LEVELS) ! INOUT "Explicit" flux of QW (i.e. KMKH3A.122
C ! evaporation) from layer below, KMKH3A.123
C ! on P-grid (kg per sq m per s). KMKH3A.124
+,FTL(P_FIELD,BL_LEVELS) ! INOUT "Explicit" flux of TL = H/CP KMKH3A.125
C ! (sensible heat/CP) from layer KMKH3A.126
C ! below, on P-grid. KMKH3A.127
+,TAUX(U_FIELD,BL_LEVELS) ! INOUT "Explicit" x-component of KMKH3A.128
C ! turbulent stress at level K-1/2 KMKH3A.129
C ! On UV-grid with first and last KMKH3A.130
C ! rows set to "missing data". KMKH3A.131
+,TAUY(U_FIELD,BL_LEVELS) ! INOUT "Explicit" y-component of KMKH3A.132
C ! turbulent stress at level K-1/2 KMKH3A.133
C ! On UV-grid with first and last KMKH3A.134
C ! rows set to "missing data". KMKH3A.135
+,QW(P_FIELD,BL_LEVELS) ! INOUT Total water content (kg per kg KMKH3A.136
C ! air). KMKH3A.137
+,RHOKM(U_FIELD,BL_LEVELS) ! INOUT Layer K-1 - to - layer K KMKH3A.138
C ! exchange coefficient for KMKH3A.139
C ! momentum, on UV-grid with first KMKH3A.140
C ! and last rows set to "missing KMKH3A.141
C ! data".Output as GAMMA*RHOKM* KMKH3A.142
C ! RDZUV for P244 (IMPL_CAL). KMKH3A.143
+,RHOKH(P_FIELD,BL_LEVELS) ! INOUT Layer K-1 - to - layer K KMKH3A.144
C ! exchange coefficient for FTL, KMKH3A.145
C ! on P-grid.Output as GAMMA* KMKH3A.146
C ! *RHOKH*RDZ for P244(IMPL_CAL) KMKH3A.147
+,TL(P_FIELD,BL_LEVELS) ! INOUT Liquid/frozen water temperature KMKH3A.148
C ! (K). KMKH3A.149
+,ZH(P_FIELD) ! INOUT Boundary layer height (m). KMKH3A.150
INTEGER KMKH3A.151
+ CCB(P_FIELD) ! IN Convective Cloud Base. KMKH3A.152
+,CCT(P_FIELD) ! IN Convective Cloud Top. KMKH3A.153
+,NRML(P_FIELD) ! INOUT Number of model layers in the KMKH3A.154
C ! unstable Rapidly Mixing Layer. KMKH3A.155
+,ERROR ! OUT 1 if bad arguments; 0 otherwise. KMKH3A.156
REAL KMKH3A.157
+ RDZUV(U_FIELD,2:BL_LEVELS) ! OUT RDZ on UV-grid, with first and KMKH3A.158
C ! last rows set to "missing KMKH3A.159
C ! data". KMKH3A.160
&,RHO_KM(P_FIELD,2:BL_LEVELS) ! OUT RHO * KM before interpolation ASJ1F400.18
C ! to UV-grid. ASJ1F400.19
C* KMKH3A.161
C*L--------------------------------------------------------------------- KMKH3A.162
C External references :- KMKH3A.163
*IF -DEF,SCMA AJC1F405.134
EXTERNAL P_TO_UV KMKH3A.165
*ENDIF KMKH3A.166
EXTERNAL TIMER KMKH3A.167
EXTERNAL QSAT,QSAT_WAT,EX_COEF ADM3F404.148
C* KMKH3A.169
C*L--------------------------------------------------------------------- KMKH3A.170
C Local and other symbolic constants :- KMKH3A.171
*CALL C_LHEAT
KMKH3A.172
*CALL C_R_CP
KMKH3A.173
*CALL C_G
KMKH3A.174
*CALL C_0_DG_C
KMKH3A.175
*CALL C_EPSLON
KMKH3A.176
*CALL C_GAMMA
KMKH3A.177
REAL ETAR,GRCP,LCRCP,LFRCP,LS,LSRCP KMKH3A.178
PARAMETER ( KMKH3A.179
+ ETAR=1.0/(1.0-EPSILON) ! Used in buoyancy parameter BETAC. KMKH3A.180
+,GRCP=G/CP ! Used in DZTL, FTL calculations. KMKH3A.181
+,LCRCP=LC/CP ! Latent heat of condensation / CP. KMKH3A.182
+,LFRCP=LF/CP ! Latent heat of fusion / CP. KMKH3A.183
+,LS=LC+LF ! Latent heat of sublimation. KMKH3A.184
+,LSRCP=LS/CP ! Latent heat of sublimation / CP. KMKH3A.185
+) KMKH3A.186
C* KMKH3A.187
C KMKH3A.188
C Define local storage. KMKH3A.189
C KMKH3A.190
C (a) Workspace. 6*BL_LEVELS-1 blocks of real workspace are required KMKH3A.191
C plus 1 block of logical. KMKH3A.192
C KMKH3A.193
C KMKH3A.195
LOGICAL KMKH3A.196
+ TOPBL(P_FIELD) ! Flag set when top of boundary layer KMKH3A.197
C ! is reached. KMKH3A.198
REAL KMKH3A.199
+ BQ(P_FIELD,2:BL_LEVELS) ! A buoyancy parameter (beta q tilde). KMKH3A.200
+,BT(P_FIELD,2:BL_LEVELS) ! A buoyancy parameter (beta T tilde). KMKH3A.201
C ! Re-used for DZLUV(,2:BL_LEVELS). KMKH3A.202
&,BF(P_FIELD,2:BL_LEVELS) ADM3F404.149
! A buoyancy parameter (beta F tilde). ADM3F404.150
+,RI(P_FIELD,2:BL_LEVELS) ! Richardson number for lower interface KMKH3A.203
C ! of layer. KMKH3A.204
+,RIM(P_FIELD,2:BL_LEVELS) ! Modified Richardson number for lower KMKH3A.205
C ! interface of layer. KMKH3A.206
+,DELTAP(P_FIELD,BL_LEVELS) ! Pressure difference across layer. KMKH3A.207
+,DTRDZ(P_FIELD,BL_LEVELS) ! -g.dt/dp for model layers. KMKH3A.208
+,DELTAP_RML(P_FIELD) ! Pressure difference across the KMKH3A.209
C ! rapidly mixing layer (if it exists). KMKH3A.210
+,QSL(P_FIELD) ! Saturated sp humidity at pressure and KMKH3A.211
C ! liquid/frozen water temperature of KMKH3A.212
C ! successive levels. KMKH3A.213
C ! Re-used for RHOKM. KMKH3A.214
INTEGER ARN1F403.92
& NTML(P_FIELD) ! No. of turbulently mixed model levels ARN1F403.93
C KMKH3A.215
C KMKH3A.239
C (b) Scalars. KMKH3A.240
C KMKH3A.241
REAL KMKH3A.242
+ AL ! Temporary in calculation of buoyancy parameters. KMKH3A.243
+,ALPHAL ! Temporary in calculation of buoyancy parameters. KMKH3A.244
+,BETAC ! Temporary in calculation of buoyancy parameters. KMKH3A.245
+,BETAQ ! Temporary in calculation of buoyancy parameters. KMKH3A.246
+,BETAT ! Temporary in calculation of buoyancy parameters. KMKH3A.247
+,BQM ! Temporary in calculation of Richardson number RI(,K) KMKH3A.248
+,BTM ! Temporary in calculation of Richardson number RI(,K) KMKH3A.249
&,BFM ADM3F404.151
! Temporary in calculation of Richardson number RI(,K) ADM3F404.152
+,DZB ! Temporary in calculation of Richardson number RI(,K). KMKH3A.250
+,DZQW ! Difference of QW between "current" and "lower" levels. KMKH3A.251
&,DZQI ADM3F404.153
! Difference of QI between "current" and "lower" levels. ADM3F404.154
+,DZTL ! Liquid/ice static energy difference between adjacent KMKH3A.252
C ! levels. KMKH3A.253
+,DZU ! Westerly wind shear between adjacent levels. KMKH3A.254
+,DZV ! Southerly wind shear between adjacent levels. KMKH3A.255
+,DVMOD2 ! Square of modulus of wind shear between adjacent levels KMKH3A.256
+,WK ! Temporary in calculation of RHO. KMKH3A.257
+,WKM1 ! Temporary in calculation of RHO. KMKH3A.258
+,DTRDZ_RML ! -g.dt/dp for the rapidly mixing layer. KMKH3A.259
+,DTL_RML ! Explicit TL increment for the rapidly mixing layer. KMKH3A.260
+,DQW_RML ! Explicit QW increment for the rapidly mixing layer. KMKH3A.261
+,DTL_RMLP1 ! Explicit TL increment for the model layer above KMKH3A.262
C ! the rapidly mixing layer. KMKH3A.263
+,DQW_RMLP1 ! Explicit QW increment for the model layer above KMKH3A.264
C ! the rapidly mixing layer. KMKH3A.265
+,RIT ! Temporary calculation of the modified Richardson KMKH3A.266
C ! number at the interface between the KMKH3A.267
C ! rapidly mixing layer and the model layer above it. KMKH3A.268
INTEGER KMKH3A.269
+ I ! Loop counter (horizontal field index). KMKH3A.270
+,J ! Offset counter in certain I loops. KMKH3A.271
+,K ! Loop counter (vertical level index). KMKH3A.272
+,KM1 ! K-1. KMKH3A.273
+,KP1 ! K-1 KMKH3A.274
+,MBL ! Maximum number of model layers allowed in the rapidly KMKH3A.275
C ! mixing layer; set to BL_LEVELS-1. KMKH3A.276
+,NRMLP1 ! NRML + 1 KMKH3A.277
+,NRMLP2 ! NRML + 2 KMKH3A.278
+,IT_COUNTER ! Iteration loop counter. KMKH3A.279
*IF DEF,MPP GPB1F403.233
! MPP Common block GPB1F403.234
*CALL PARVARS
GPB1F403.235
*ENDIF GPB1F403.236
C KMKH3A.280
C----------------------------------------------------------------------- KMKH3A.281
CL 0. Check that the scalars input to define the grid are consistent. KMKH3A.282
C See comments to routine SF_EXCH for details. KMKH3A.283
C----------------------------------------------------------------------- KMKH3A.284
C KMKH3A.285
IF (LTIMER) THEN KMKH3A.286
CALL TIMER
('KMKH ',3) KMKH3A.287
ENDIF KMKH3A.288
ERROR=0 KMKH3A.289
*IF DEF,MPP AJC1F405.135
IF ( AJC1F405.136
*ELSEIF DEF,SCMA AJC1F405.137
IF ( U_ROWS .NE. (P_ROWS) .OR. AJC1F405.138
*ELSE AJC1F405.139
IF ( U_ROWS .NE. (P_ROWS+1) .OR. AJC1F405.140
*ENDIF AJC1F405.141
+ U_POINTS .NE. (U_ROWS*ROW_LENGTH) .OR. KMKH3A.298
+ P_POINTS .NE. (P_ROWS*ROW_LENGTH) ) THEN KMKH3A.299
ERROR=1 KMKH3A.300
GOTO9 KMKH3A.301
ENDIF KMKH3A.302
C KMKH3A.304
C Set MBL, "maximum number of boundary levels" for the purposes of KMKH3A.305
C boundary layer height calculation. KMKH3A.306
C KMKH3A.307
MBL = BL_LEVELS - 1 KMKH3A.308
C KMKH3A.309
C----------------------------------------------------------------------- KMKH3A.310
CL 1. First loop round "boundary" levels. KMKH3A.311
C----------------------------------------------------------------------- KMKH3A.312
C KMKH3A.313
DO 1 K=2,BL_LEVELS KMKH3A.314
C KMKH3A.315
C----------------------------------------------------------------------- KMKH3A.316
CL 1.1 Calculate saturated specific humidity at pressure and ice/liquid KMKH3A.317
CL temperature of current level (TL, which is calculated here). KMKH3A.318
C Store pressure temporarily in BQ(*,K). KMKH3A.319
C----------------------------------------------------------------------- KMKH3A.320
C KMKH3A.321
DO 11 I=P1,P1+P_POINTS-1 KMKH3A.322
BQ(I,K) = AK(K) + BK(K)*PSTAR(I) KMKH3A.323
IF (L_BL_LSPICE) THEN ADM3F404.155
TL(I,K) = T(I,K) - LCRCP*QCL(I,K) ! P243.9 ADM3F404.156
ELSE ADM3F404.157
TL(I,K) = T(I,K) - LCRCP*QCL(I,K) - LSRCP*QCF(I,K) ! P243.9 ADM3F404.158
ENDIF ADM3F404.159
11 CONTINUE KMKH3A.325
IF (L_BL_LSPICE) THEN ADM3F404.160
CALL QSAT_WAT
(QSL(P1),TL(P1,K),BQ(P1,K),P_POINTS) ADM3F404.161
ELSE ADM3F404.162
CALL QSAT
(QSL(P1),TL(P1,K),BQ(P1,K),P_POINTS) ADM3F404.163
ENDIF ADM3F404.164
C KMKH3A.327
C----------------------------------------------------------------------- KMKH3A.328
CL 1.2 Calculate buoyancy parameters BT and BQ, required for the KMKH3A.329
CL calculation of Richardson numbers above the surface. KMKH3A.330
C----------------------------------------------------------------------- KMKH3A.331
C KMKH3A.332
DO 12 I=P1,P1+P_POINTS-1 KMKH3A.333
C KMKH3A.334
CL 1.2.1 Calculate total water content (QW) at current level. KMKH3A.335
C KMKH3A.336
IF (L_BL_LSPICE) THEN ADM3F404.165
QW(I,K) = Q(I,K) + QCL(I,K) ! P243.10 ADM3F404.166
ELSE ADM3F404.167
QW(I,K) = Q(I,K) + QCL(I,K) +QCF(I,K) ! P243.10 ADM3F404.168
ENDIF ADM3F404.169
BETAT = 1.0/T(I,K) ! P243.19 (1st eqn) KMKH3A.338
BETAQ = C_VIRTUAL/(1.0 +C_VIRTUAL*Q(I,K) -QCL(I,K) -QCF(I,K)) KMKH3A.339
C ... P243.19 (2nd eqn) KMKH3A.340
C KMKH3A.341
IF (TL(I,K).GT.TM.OR.L_BL_LSPICE) THEN ADM3F404.170
ALPHAL = (EPSILON * LC * QSL(I)) / ( R * TL(I,K) * TL(I,K) ) KMKH3A.343
C ... P243.20 (Clausius-Clapeyron) for TL above freezing KMKH3A.344
C KMKH3A.345
AL = 1.0 / (1.0 + LCRCP*ALPHAL) KMKH3A.346
C ... P243.21 for TL above freezing KMKH3A.347
C KMKH3A.348
BETAC = CF(I,K) * AL * ( LCRCP*BETAT - ETAR*BETAQ ) KMKH3A.349
C ... P243.19 (3rd eqn) for TL above freezing KMKH3A.350
C KMKH3A.351
ELSE KMKH3A.352
ALPHAL = (EPSILON * LS * QSL(I)) / ( R * TL(I,K) * TL(I,K) ) KMKH3A.353
C ... P243.20 (Clausius-Clapeyron) for TL below freezing KMKH3A.354
C KMKH3A.355
AL = 1.0 / (1.0 + LSRCP*ALPHAL) KMKH3A.356
C ... P243.21 for TL below freezing KMKH3A.357
C KMKH3A.358
BETAC = CF(I,K) * AL * ( LSRCP*BETAT - ETAR*BETAQ ) KMKH3A.359
C ... P243.19 (3rd eqn) for TL below freezing KMKH3A.360
C KMKH3A.361
ENDIF KMKH3A.362
BT(I,K) = BETAT - ALPHAL*BETAC ! P243.18 (1st eqn) KMKH3A.363
BQ(I,K) = BETAQ + BETAC ! P243.18 (2nd eqn) KMKH3A.364
BF(I,K) = BETAQ*EPSILON*ETAR ! P243.18 (2nd eqn) ADM3F404.171
! ADM3F404.172
IF (L_BL_LSPICE) THEN ADM3F404.173
TL(I,K) = T(I,K) - LCRCP*QCL(I,K) ! P243.9 ADM3F404.174
ENDIF ADM3F404.175
! ADM3F404.176
12 CONTINUE KMKH3A.365
1 CONTINUE KMKH3A.366
C KMKH3A.367
C----------------------------------------------------------------------- KMKH3A.368
CL 1.3 Initialise flag for having reached top of boundary layer ARN1F403.94
CL and also the number of turbulently mixed layers. ARN1F403.95
C----------------------------------------------------------------------- KMKH3A.371
C KMKH3A.372
DO 13 I=P1,P1+P_POINTS-1 KMKH3A.373
TOPBL(I) = .FALSE. KMKH3A.374
NTML(I) = 1 ARN1F403.96
13 CONTINUE KMKH3A.375
C KMKH3A.376
C----------------------------------------------------------------------- KMKH3A.377
CL 2. Second loop round "boundary" levels. KMKH3A.378
C----------------------------------------------------------------------- KMKH3A.379
C KMKH3A.380
DO 2 K=2,BL_LEVELS KMKH3A.381
KM1 = K-1 KMKH3A.382
DO 21 I=P1,P1+P_POINTS-1 KMKH3A.383
C KMKH3A.384
C----------------------------------------------------------------------- KMKH3A.385
CL 2.1 Calculate wind shear and other "jumps" between "current" and KMKH3A.386
CL previous (lower) level. KMKH3A.387
C----------------------------------------------------------------------- KMKH3A.388
C KMKH3A.389
DZU = U_P(I,K) - U_P(I,KM1) KMKH3A.390
DZV = V_P(I,K) - V_P(I,KM1) KMKH3A.391
DVMOD2 = MAX ( 1.0E-12 , DZU*DZU + DZV*DZV ) ! Used in P243.C1 KMKH3A.392
DZTL = TL(I,K) - TL(I,KM1) + GRCP/RDZ(I,K) ! Used in P243.C2 KMKH3A.393
DZQW = QW(I,K) - QW(I,KM1) ! Used in P243.C2 KMKH3A.394
DZQI = QCF(I,K) - QCF(I,KM1) ! Used in P243.C2 ADM3F404.177
C KMKH3A.395
C----------------------------------------------------------------------- KMKH3A.396
CL 2.2 Calculate buoyancy parameters BT, BQ, DZB at interface between KMKH3A.397
CL "current" and previous levels (i.e. at level K-1/2, if current KMKH3A.398
CL level is level K). KMKH3A.399
C----------------------------------------------------------------------- KMKH3A.400
C KMKH3A.401
WKM1 = 0.5 * DZL(I,KM1) * RDZ(I,K) ! P243.C5 (2nd eqn) KMKH3A.402
WK = 0.5 * DZL(I,K) * RDZ(I,K) ! P243.C5 (1st eqn) KMKH3A.403
IF (K.EQ.2) THEN KMKH3A.404
BTM = WK*BT(I,K) + WKM1*BT_1(I) ! P243.C3 (1st eqn) KMKH3A.405
BQM = WK*BQ(I,K) + WKM1*BQ_1(I) ! P243.C3 (2nd eqn) KMKH3A.406
BFM = WK*BF(I,K) + WKM1*BF_1(I) ! P243.C3 (2nd eqn) ADM3F404.178
ELSE KMKH3A.407
BTM = WK*BT(I,K) + WKM1*BT(I,KM1) ! P243.C3 (1st eqn) KMKH3A.408
BQM = WK*BQ(I,K) + WKM1*BQ(I,KM1) ! P243.C3 (2nd eqn) KMKH3A.409
BFM = WK*BF(I,K) + WKM1*BF(I,KM1) ! P243.C3 (2nd eqn) ADM3F404.179
ENDIF KMKH3A.410
IF (L_BL_LSPICE) THEN ADM3F404.180
DZB = BTM*DZTL + BQM*DZQW - BFM*DZQI ! P243.C2 (no g) ADM3F404.181
ELSE ADM3F404.182
DZB = BTM*DZTL + BQM*DZQW ! P243.C2 (no g) ADM3F404.183
ENDIF ADM3F404.184
C KMKH3A.412
C For rationale of next IF block, see the discussion in the last KMKH3A.413
C paragraph of Appendix C of the P243 documentation. KMKH3A.414
C KMKH3A.415
IF (DZB.GT.0.0) THEN KMKH3A.416
IF (K.EQ.2) THEN KMKH3A.417
BTM = 0.5 * ( BT(I,K) + BT_1(I) ) KMKH3A.418
BQM = 0.5 * ( BQ(I,K) + BQ_1(I) ) KMKH3A.419
BFM = 0.5 * ( BF(I,K) + BF_1(I) ) ADM3F404.185
ELSE KMKH3A.420
BTM = 0.5 * ( BT(I,K) + BT(I,KM1) ) KMKH3A.421
BQM = 0.5 * ( BQ(I,K) + BQ(I,KM1) ) KMKH3A.422
BFM = 0.5 * ( BF(I,K) + BF(I,KM1) ) ADM3F404.186
ENDIF KMKH3A.423
IF (L_BL_LSPICE) THEN ADM3F404.187
DZB = BTM*DZTL + BQM*DZQW - BFM*DZQI ADM3F404.188
ELSE ADM3F404.189
DZB = BTM*DZTL + BQM*DZQW ADM3F404.190
ENDIF ADM3F404.191
ENDIF KMKH3A.425
IF (K.EQ.2) THEN KMKH3A.426
BT_1(I) = BTM KMKH3A.427
BQ_1(I) = BQM KMKH3A.428
BF_1(I) = BFM ADM3F404.192
ELSE KMKH3A.429
BT(I,KM1) = BTM KMKH3A.430
BQ(I,KM1) = BQM KMKH3A.431
BF(I,KM1) = BFM ADM3F404.193
ENDIF KMKH3A.432
C KMKH3A.433
C----------------------------------------------------------------------- KMKH3A.434
CL 2.3 Calculate Richardson number Ri at the same interface. KMKH3A.435
C----------------------------------------------------------------------- KMKH3A.436
C KMKH3A.437
RI(I,K) = G * DZB / ( RDZ(I,K) * DVMOD2 ) KMKH3A.438
C KMKH3A.439
C----------------------------------------------------------------------- KMKH3A.440
CL 2.4 If either a stable layer (Ri > 1) or the maximum boundary layer KMKH3A.441
CL height has been reached, set boundary layer height (ZH) to KMKH3A.442
CL the height of the lower boundary of the current layer and set KMKH3A.443
CL the number of rapidly mixing layers if the surface layer is KMKH3A.444
CL unstable (as determined in subroutine SF_EXCH). KMKH3A.445
C----------------------------------------------------------------------- KMKH3A.446
C KMKH3A.447
IF ( .NOT.TOPBL(I) .AND. (RI(I,K).GT.1.0 .OR. K.GT.MBL) ) THEN KMKH3A.448
TOPBL(I) = .TRUE. KMKH3A.449
ZH(I) = ZLB(I,K) KMKH3A.450
NTML(I) = K-1 ARN1F403.97
IF ( NRML(I) .GT. 0 ) NRML(I) = K-1 KMKH3A.451
ENDIF KMKH3A.452
21 CONTINUE KMKH3A.453
2 CONTINUE KMKH3A.454
C KMKH3A.455
C----------------------------------------------------------------------- KMKH3A.456
CL 3. Subroutine EX_COEF. KMKH3A.457
C----------------------------------------------------------------------- KMKH3A.458
C KMKH3A.459
CALL EX_COEF
( KMKH3A.460
+ P_FIELD,U_FIELD,P1,P_POINTS,BL_LEVELS, KMKH3A.461
+ CCB,CCT,NTML,L_MOM,L_MIXLEN, ARN1F403.98
+ AKH,BKH,CCA,DZL,PSTAR,RDZ,RI,TV,U_P,V_P,ZH,ZLB,Z0M,H_BLEND, KMKH3A.463
+ RHOKM,RHOKH,LTIMER KMKH3A.464
+) KMKH3A.465
C KMKH3A.466
C----------------------------------------------------------------------- KMKH3A.467
CL 4. Calculate "explicit" fluxes of TL and QW. KMKH3A.468
C----------------------------------------------------------------------- KMKH3A.469
C KMKH3A.470
DO 4 K=2,BL_LEVELS KMKH3A.471
KM1 = K-1 KMKH3A.472
C----------------------------------------------------------------------- KMKH3A.473
CL 4.1 "Explicit" fluxes of TL and QW, on P-grid. KMKH3A.474
C----------------------------------------------------------------------- KMKH3A.475
DO 41 I=P1,P1+P_POINTS-1 KMKH3A.476
FTL(I,K) = -RHOKH(I,K) * KMKH3A.477
+ ( ( ( TL(I,K) - TL(I,KM1) ) * RDZ(I,K) ) + GRCP ) KMKH3A.478
C 1 2 3 3 2 1 KMKH3A.479
FQW(I,K) = -RHOKH(I,K) * ( QW(I,K) - QW(I,KM1) ) * RDZ(I,K) KMKH3A.480
41 CONTINUE KMKH3A.481
4 CONTINUE KMKH3A.482
C KMKH3A.483
C----------------------------------------------------------------------- KMKH3A.484
CL 4.2 Use explicit fluxes to calculate a modified Richardson number KMKH3A.485
CL at the top of the rapidly mixing layer (if it exists); if this KMKH3A.486
CL indicates that the r.m.l. can deepen due to heat and/or moisture KMKH3A.487
CL input from the surface then increase NRML(I). KMKH3A.488
C----------------------------------------------------------------------- KMKH3A.489
C KMKH3A.490
C Initialise pressure difference, dp, for the rapidly mixing layer. KMKH3A.491
C KMKH3A.492
DO I = P1,P1+P_POINTS-1 KMKH3A.493
DELTAP_RML(I) = 0.0 KMKH3A.494
ENDDO ! Loop over p-points KMKH3A.495
C KMKH3A.496
C Calculate pressure differences, dp, and -g.dt/dp for model layers KMKH3A.497
C and dp for the rapidly mixing layer. KMKH3A.498
C KMKH3A.499
DO 420 K = 1,BL_LEVELS KMKH3A.500
DO I = P1,P1+P_POINTS-1 KMKH3A.501
DELTAP(I,K) = DELTA_AK(K) + PSTAR(I)*DELTA_BK(K) KMKH3A.502
DTRDZ(I,K) = -G * TIMESTEP / DELTAP(I,K) KMKH3A.503
IF (K .LE. NRML(I)) DELTAP_RML(I) KMKH3A.504
& = DELTAP_RML(I) + DELTAP(I,K) KMKH3A.505
IF (K .GE. 2) RIM(I,K) = RI(I,K) KMKH3A.506
ENDDO ! Loop over p-points KMKH3A.507
420 CONTINUE ! Loop over bl-levels KMKH3A.508
C KMKH3A.509
C----------------------------------------------------------------------- KMKH3A.510
CL 4.2.1 Iterate BL_LEVELS-2 times; this allows an initial r.m.l. of KMKH3A.511
CL 1 model layer to deepen to BL_LEVELS-1 model layers a layer at KMKH3A.512
CL a time in each iteration. Some of these iterations may be KMKH3A.513
CL redundant if in fact the r.m.l. cannot deepen. KMKH3A.514
C----------------------------------------------------------------------- KMKH3A.515
DO 421 IT_COUNTER = 1,BL_LEVELS-2 KMKH3A.516
C KMKH3A.517
DO I = P1,P1+P_POINTS-1 KMKH3A.518
C !------------------------------------------------------------- KMKH3A.519
C ! Only check to see if the r.m.l. can deepen if it exists KMKH3A.520
C ! in the first place and has less than its maximum depth. KMKH3A.521
C !------------------------------------------------------------- KMKH3A.522
IF ((NRML(I) .GE. 1) .AND. (NRML(I) .LE. BL_LEVELS-2)) THEN KMKH3A.523
NRMLP1 = NRML(I) + 1 KMKH3A.524
NRMLP2 = NRML(I) + 2 KMKH3A.525
DTRDZ_RML = -G * TIMESTEP / DELTAP_RML(I) KMKH3A.526
C !----------------------------------------------------------- KMKH3A.527
C ! "Explicit" rapidly mixing layer increments to TL and QW. KMKH3A.528
C !----------------------------------------------------------- KMKH3A.529
DTL_RML = -DTRDZ_RML * ( FTL(I,NRMLP1) - FTL(I,1) ) KMKH3A.530
DQW_RML = -DTRDZ_RML * ( FQW(I,NRMLP1) - FQW(I,1) ) KMKH3A.531
C !----------------------------------------------------------- KMKH3A.532
C ! "Explicit" increments to TL and QW in the model layer KMKH3A.533
C ! above the rapidly mixing layer. KMKH3A.534
C !----------------------------------------------------------- KMKH3A.535
DTL_RMLP1 = -DTRDZ(I,NRMLP1) * KMKH3A.536
& ( FTL(I,NRMLP2) - FTL(I,NRMLP1) ) KMKH3A.537
DQW_RMLP1 = -DTRDZ(I,NRMLP1) * KMKH3A.538
& ( FQW(I,NRMLP2) - FQW(I,NRMLP1) ) KMKH3A.539
DZU = U_P(I,NRMLP1) - U_P(I,NRML(I)) KMKH3A.540
DZV = V_P(I,NRMLP1) - V_P(I,NRML(I)) KMKH3A.541
DVMOD2 = MAX (1.0E-12 , DZU*DZU + DZV*DZV) KMKH3A.542
C !----------------------------------------------------------- KMKH3A.543
C ! Calculate a modified Richardson number for the interface KMKH3A.544
C ! between the rapidly mixing layer and the model layer above KMKH3A.545
C !----------------------------------------------------------- KMKH3A.546
IF (NRML(I) .EQ. 1) THEN KMKH3A.547
RIT = RI(I,NRMLP1) + ( G/(RDZ(I,NRMLP1) * DVMOD2) ) * KMKH3A.548
& ( BT_1(I) * ( DTL_RMLP1 - DTL_RML ) KMKH3A.549
& + BQ_1(I) * ( DQW_RMLP1 - DQW_RML ) ) KMKH3A.550
ELSE ! NRML(I) .GT. 1 KMKH3A.551
RIT = RI(I,NRMLP1) + ( G/(RDZ(I,NRMLP1) * DVMOD2) ) * KMKH3A.552
& ( BT(I,NRML(I)) * ( DTL_RMLP1 - DTL_RML ) KMKH3A.553
& + BQ(I,NRML(I)) * ( DQW_RMLP1 - DQW_RML ) ) KMKH3A.554
ENDIF KMKH3A.555
IF ( RIT .LE. 1.0 ) THEN KMKH3A.556
C !--------------------------------------------------------- KMKH3A.557
C ! Deepen the rapidly mixing layer by one model layer KMKH3A.558
C !--------------------------------------------------------- KMKH3A.559
NRML(I) = NRMLP1 KMKH3A.560
DELTAP_RML(I) = DELTAP_RML(I) + DELTAP(I,NRMLP1) KMKH3A.561
ZH(I) = ZLB(I,NRMLP2) KMKH3A.562
IF (RIT .LT. RI(I,NRMLP1)) RIM(I,NRMLP1) = RIT KMKH3A.563
ENDIF KMKH3A.564
ENDIF ! NRML(I) .GE. 1 and .LE. BL_LEVELS-2 KMKH3A.565
ENDDO ! Loop over p-points KMKH3A.566
421 CONTINUE! Loop over iterations KMKH3A.567
C KMKH3A.568
C----------------------------------------------------------------------- KMKH3A.569
CL 4.2.2 Adjust the Richardson number at the top of the rapidly mixing KMKH3A.570
CL layer- the 'DZ' in the expression (P243.C1) is set to 100.0 m KMKH3A.571
CL rather than the model level separation (if the latter is KMKH3A.572
CL greater than 100 m). This is a simple way of adjusting for KMKH3A.573
CL inaccuracies in calculating gradients at inversions when the KMKH3A.574
CL model's vertical resolution is coarse. KMKH3A.575
C----------------------------------------------------------------------- KMKH3A.576
C KMKH3A.577
DO 422 K = 2,BL_LEVELS KMKH3A.578
KM1 = K-1 KMKH3A.579
DO I = P1,P1+P_POINTS-1 KMKH3A.580
IF ( (KM1 .EQ. NRML(I)) .AND. (100.0*RDZ(I,K) .LT. 1.0) ) KMKH3A.581
& RIM(I,K) = 100.0*RDZ(I,K)*RIM(I,K) KMKH3A.582
ENDDO ! Loop over p-points KMKH3A.583
422 CONTINUE! Loop over bl-levels KMKH3A.584
C KMKH3A.585
C----------------------------------------------------------------------- KMKH3A.586
CL 5. Subroutine EX_COEF using adjusted Richardson Number, RIM KMKH3A.587
C----------------------------------------------------------------------- KMKH3A.588
C KMKH3A.589
CALL EX_COEF
( KMKH3A.590
+ P_FIELD,U_FIELD,P1,P_POINTS,BL_LEVELS, KMKH3A.591
+ CCB,CCT,NTML,L_MOM,L_MIXLEN, ARN1F403.99
+ AKH,BKH,CCA,DZL,PSTAR,RDZ,RIM,TV,U_P,V_P,ZH,ZLB,Z0M,H_BLEND, KMKH3A.593
+ RHOKM,RHOKH,LTIMER KMKH3A.594
+) KMKH3A.595
C KMKH3A.596
C----------------------------------------------------------------------- KMKH3A.597
CL 6. Recalculate "explicit" fluxes of TL and QW, see section 4. above. KMKH3A.598
C----------------------------------------------------------------------- KMKH3A.599
C KMKH3A.600
DO 6 K=2,BL_LEVELS KMKH3A.601
KM1 = K-1 KMKH3A.602
C----------------------------------------------------------------------- KMKH3A.603
CL 6.1 "Explicit" fluxes of TL and QW, on P-grid. KMKH3A.604
CL Overwrite exchange coefficient with GAMMA*RHOKH*RDZ to avoid KMKH3A.605
CL unecessary multiplication in P244 (IMPL_CAL). RHOKH only used KMKH3A.606
CL in this combination hearafter. KMKH3A.607
CL RHOKM stored here for diagnostic output (N.B. before interpoln.) ASJ1F400.20
C----------------------------------------------------------------------- KMKH3A.608
DO 61 I=P1,P1+P_POINTS-1 KMKH3A.609
FTL(I,K) = -RHOKH(I,K) * KMKH3A.610
+ ( ( ( TL(I,K) - TL(I,KM1) ) * RDZ(I,K) ) + GRCP ) KMKH3A.611
C 1 2 3 3 2 1 KMKH3A.612
FQW(I,K) = -RHOKH(I,K) * ( QW(I,K) - QW(I,KM1) ) * RDZ(I,K) KMKH3A.613
RHOKH(I,K) = GAMMA(K) * RHOKH(I,K) * RDZ(I,K) KMKH3A.614
RHO_KM(I,K) = RHOKM(I,K) ASJ1F400.21
61 CONTINUE KMKH3A.615
6 CONTINUE KMKH3A.616
C KMKH3A.617
C KMKH3A.618
C----------------------------------------------------------------------- KMKH3A.619
CL 7. Calculate "explicit" turbulent stress components. KMKH3A.620
C----------------------------------------------------------------------- KMKH3A.621
C KMKH3A.622
*IF -DEF,SCMA AJC1F405.142
C KMKH3A.624
C----------------------------------------------------------------------- KMKH3A.625
CL 7.1 "Explicit" turbulent stress components, on UV-grid. KMKH3A.626
CL Overwrite exchange coefficient with GAMMA*RHOKM*RDZUV to avoid KMKH3A.627
CL unecessary multiplication in P244 (IMPL_CAL). RHOKM only used KMKH3A.628
CL in this combination hearafter. KMKH3A.629
C----------------------------------------------------------------------- KMKH3A.630
C KMKH3A.631
C Store DZL(,1) on UV-grid, in BT_1. KMKH3A.632
C KMKH3A.633
CALL P_TO_UV
(DZL(P1,1),BT_1(U1+ROW_LENGTH),P_POINTS, KMKH3A.634
+ P_POINTS,ROW_LENGTH,P_ROWS) KMKH3A.635
C KMKH3A.636
*IF DEF,MPP ARB2F403.150
C Need to update haloes of RHOKM before calling P_TO_UV ARB2F402.42
CALL SWAPBOUNDS
(RHOKM(1,2),ROW_LENGTH, ARB2F402.43
& U_FIELD/ROW_LENGTH,1,1,BL_LEVELS-1) ARB2F402.44
*ENDIF ARB2F403.151
ARB2F402.46
DO 7 K = 2,BL_LEVELS KMKH3A.637
KM1 = K-1 KMKH3A.638
C KMKH3A.639
C Store DZL(,K) on UV-grid in BT(,K), interpolate RHOKM to UV-grid via KMKH3A.640
C QSL. Note addressing of array elements; the first and last rows KMKH3A.641
C of genuinely UV-grid arrays are never accessed here. They get set KMKH3A.642
C to "missing data" (1.0E30) before being passed out of the routine. KMKH3A.643
C KMKH3A.644
CALL P_TO_UV
(DZL(P1,K),BT(U1+ROW_LENGTH,K), KMKH3A.645
+ P_POINTS,P_POINTS,ROW_LENGTH,P_ROWS) KMKH3A.646
C KMKH3A.647
CALL P_TO_UV
(RHOKM(P1,K),QSL(U1+ROW_LENGTH), KMKH3A.648
+ P_POINTS,P_POINTS,ROW_LENGTH,P_ROWS) KMKH3A.649
C KMKH3A.650
DO 71 I=U1+ROW_LENGTH,U1-ROW_LENGTH+U_POINTS-1 KMKH3A.651
RHOKM(I,K) = QSL(I) KMKH3A.652
IF (K.EQ.2) THEN KMKH3A.653
RDZUV(I,K) = 2.0 / ( BT(I,K) + BT_1(I) ) KMKH3A.654
ELSE KMKH3A.655
RDZUV(I,K) = 2.0 / ( BT(I,K) + BT(I,KM1) ) KMKH3A.656
ENDIF KMKH3A.657
TAUX(I,K) = RHOKM(I,K) * ( U(I,K) - U(I,KM1) ) * RDZUV(I,K) KMKH3A.658
TAUY(I,K) = RHOKM(I,K) * ( V(I,K) - V(I,KM1) ) * RDZUV(I,K) KMKH3A.659
RHOKM(I,K) = GAMMA(K) * RHOKM(I,K) * RDZUV(I,K) KMKH3A.660
71 CONTINUE KMKH3A.661
C KMKH3A.662
C----------------------------------------------------------------------- KMKH3A.663
CL 8. Set first and last rows of UV-grid variables to "missing data". KMKH3A.664
C----------------------------------------------------------------------- KMKH3A.665
C KMKH3A.666
*IF DEF,MPP GPB1F403.237
IF (attop) THEN GPB1F403.238
*ENDIF GPB1F403.239
DO I=U1,U1+ROW_LENGTH-1 GPB1F403.240
RHOKM(I,K) = 1.0E30 GPB1F403.241
TAUX(I,K) = 1.0E30 GPB1F403.242
TAUY(I,K) = 1.0E30 GPB1F403.243
RDZUV(I,K) = 1.0E30 GPB1F403.244
ENDDO GPB1F403.245
*IF DEF,MPP GPB1F403.246
ENDIF GPB1F403.247
GPB1F403.248
IF (atbase) THEN GPB1F403.249
*ENDIF GPB1F403.250
DO I= U1 + (U_ROWS-1)*ROW_LENGTH , U1 + U_ROWS*ROW_LENGTH - 1 GPB1F403.251
RHOKM(I,K) = 1.0E30 GPB1F403.252
TAUX(I,K) = 1.0E30 GPB1F403.253
TAUY(I,K) = 1.0E30 GPB1F403.254
RDZUV(I,K) = 1.0E30 GPB1F403.255
ENDDO GPB1F403.256
*IF DEF,MPP GPB1F403.257
ENDIF GPB1F403.258
*ENDIF GPB1F403.259
7 CONTINUE KMKH3A.701
C KMKH3A.702
*ELSE KMKH3A.703
C KMKH3A.704
C----------------------------------------------------------------------- KMKH3A.705
CL 7.1 "Explicit" fluxes of U and V (would be on UV-grid in non-SCM). KMKH3A.706
CL Overwrite exchange coefficient with GAMMA*RHOKM*RDZUV to avoid KMKH3A.707
CL unecessary multiplication in P244 (IMPL_CAL). RHOKM only used KMKH3A.708
CL in this combination hearafter. KMKH3A.709
C----------------------------------------------------------------------- KMKH3A.710
C KMKH3A.711
DO 7 K = 2,BL_LEVELS KMKH3A.712
KM1 = K-1 KMKH3A.713
DO 71 I=U1,U1+U_POINTS-1 KMKH3A.714
RDZUV(I,K) = 2.0 / ( DZL(I,K) + DZL(I,KM1) ) KMKH3A.715
TAUX(I,K) = RHOKM(I,K) * ( U(I,K) - U(I,KM1) ) * RDZUV(I,K) KMKH3A.716
TAUY(I,K) = RHOKM(I,K) * ( V(I,K) - V(I,KM1) ) * RDZUV(I,K) KMKH3A.717
RHOKM(I,K) = GAMMA(K) * RHOKM(I,K) * RDZUV(I,K) KMKH3A.718
71 CONTINUE KMKH3A.719
7 CONTINUE KMKH3A.720
C KMKH3A.721
*ENDIF KMKH3A.722
C KMKH3A.723
9 CONTINUE ! Branch for error exit. KMKH3A.724
C KMKH3A.725
IF (LTIMER) THEN KMKH3A.726
CALL TIMER
('KMKH ',4) KMKH3A.727
ENDIF KMKH3A.728
C KMKH3A.729
RETURN KMKH3A.730
END KMKH3A.731
*ENDIF KMKH3A.732