*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