*IF DEF,A03_3A                                                             ASJ4F401.1      
C ******************************COPYRIGHT******************************    GTS2F400.451    
C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved.    GTS2F400.452    
C                                                                          GTS2F400.453    
C Use, duplication or disclosure of this code is subject to the            GTS2F400.454    
C restrictions as set forth in the contract.                               GTS2F400.455    
C                                                                          GTS2F400.456    
C                Meteorological Office                                     GTS2F400.457    
C                London Road                                               GTS2F400.458    
C                BRACKNELL                                                 GTS2F400.459    
C                Berkshire UK                                              GTS2F400.460    
C                RG12 2SZ                                                  GTS2F400.461    
C                                                                          GTS2F400.462    
C If no contract has been raised with this copy of the code, the use,      GTS2F400.463    
C duplication or disclosure of it is strictly prohibited.  Permission      GTS2F400.464    
C to do so must first be obtained in writing from the Head of Numerical    GTS2F400.465    
C Modelling at the above address.                                          GTS2F400.466    
C ******************************COPYRIGHT******************************    GTS2F400.467    
C                                                                          GTS2F400.468    
C*LL  SUBROUTINE BDY_LAYR-----------------------------------------------   BDYLYR3A.3      
CLL                                                                        BDYLYR3A.4      
CLL  Purpose: Calculate turbulent fluxes of heat, moisture and momentum    BDYLYR3A.5      
CLL           between (a) surface and atmosphere, (b) atmospheric levels   BDYLYR3A.6      
CLL           within the boundary layer, and/or the effects of these       BDYLYR3A.7      
CLL           fluxes on the primary model variables.  The flux of heat     BDYLYR3A.8      
CLL           into and through the soil is also modelled.  Numerous        BDYLYR3A.9      
CLL           related diagnostics are also calculated.                     BDYLYR3A.10     
CLL                                                                        BDYLYR3A.12     
CLL  If the point for a single column run is a sea point then the          BDYLYR3A.13     
CLL    land mask ensures that correct calculations are done; LAND_FIELD    BDYLYR3A.14     
CLL    dimensions land point arrays and so its value is irrelevent in      BDYLYR3A.15     
CLL    this case. An error is generated if LAND_FIELD is not one in the    BDYLYR3A.16     
CLL    land point case.                                                    BDYLYR3A.17     
CLL           F E Hewer, July 1990: removed call to LS_CLD.                BDYLYR3A.19     
CLL    This version passes out liquid/frozen water temperature in          BDYLYR3A.20     
CLL    array "T" (TL), and total water content in array "Q" (QW).          BDYLYR3A.21     
CLL    These may be converted to T and Q respectively by calling           BDYLYR3A.22     
CLL    the large scale cloud routine, LS_CLD.                              BDYLYR3A.23     
CLL            F E Hewer, August 1990: land point data stored              BDYLYR3A.24     
CLL    on land points only (dimension: LAND_FIELD, arrays:CANOPY, CATCH    BDYLYR3A.25     
CLL    HCAP, HCON, RESIST, ROOTDEP, SMC, SMVCCL, SMVCWT, T_DEEP_SOIL)      BDYLYR3A.26     
CLL    Arrays whose elements may contain values over both sea and land     BDYLYR3A.27     
CLL    points are compressed onto land points for land calculations if     BDYLYR3A.28     
CLL    defined variable IBM is NOT selected. RHOKM,RHOKH redefined as      BDYLYR3A.29     
CLL    workspace.                                                          BDYLYR3A.30     
CLL                                                                        BDYLYR3A.31     
CLL  Suitable for single column use                                        AJC1F405.519    
CLL                                                                        BDYLYR3A.33     
CLL F.Hewer     <- programmer of some or all of previous code or changes   BDYLYR3A.34     
CLL C.Wilson    <- programmer of some or all of previous code or changes   BDYLYR3A.35     
CLL                                                                        BDYLYR3A.36     
CLL  Model            Modification history:                                BDYLYR3A.37     
CLL version  Date                                                          BDYLYR3A.38     
CLL   3.4  18/10/94   *DECK inserted into UM version 3.4. S Jackson        BDYLYR3A.39     
CLL                                                                        BDYLYR3A.40     
CLL   4.0  05/01/95   rhostar*cD*modv1 and rho*Km output via argument      ASJ1F400.1      
CLL                   list for STASHing.                R.N.B.Smith        ASJ1F400.2      
CLL                                                                        ASJ1F400.3      
CLL   4.0  30/12/94   References to z0h_eff removed for reformulated       ARN1F400.2      
CLL                   surface transfer coefficients for scalars.           ARN1F400.3      
CLL                                                   R.N.B.Smith          ARN1F400.4      
!     4.1   23/05/96   MPP code: Change updateable area  P.Burton          APBGF401.1      
CLL   4.1   5/6/96    DS_LEVELS chnaged to ST_LEVELS and SM_LEVELS         AJS1F401.1085   
CLL                   C.Bunton                                             AJS1F401.1086   
CLL                                                                        ASJ3F401.1      
CLL   4.1  08/05/96   Logical L_RMBL included to select rapidly mixing     ASJ3F401.2      
CLL                   boundary layer scheme        Simon Jackson           ASJ3F401.3      
CLL                                                                        ASJ3F401.4      
CLL   4.1   08/05/96  decks A03_2C and A03_3B removed                      ASJ4F401.2      
CLL                                     S D Jackson                        ASJ4F401.3      
CLL   4.2   Oct. 96   T3E migration - *DEF CRAY removed                    GSS1F402.60     
CLL                                     S J Swarbrick                      GSS1F402.61     
CLL                                                                        ASJ4F401.4      
CLL   4.3  04/02/97   Logical switches L_MOM and L_MIXLEN passed down      ARN1F403.27     
CLL                   to KHKH and thence EXCOEF.                           ARN1F403.28     
CLL                                                     R.N.B.Smith        ARN1F403.29     
CLL   4.4  08/09/97   L_BL_LSPICE specifies mixed phase precipitation      ADM3F404.204    
CLL                   scheme                     D.Wilson                  ADM3F404.205    
!!!  4.5    Jul. 98  Kill the IBM specific lines. (JCThil)                 AJC1F405.518    
CLL                                                                        ARN1F403.30     
CLL  Programming standard: Unified Model Documentation Paper No 4,         BDYLYR3A.41     
CLL                        Version ?, dated ?.                             BDYLYR3A.42     
CLL                                                                        BDYLYR3A.43     
CLL  System component covered: P24.                                        BDYLYR3A.44     
CLL                                                                        BDYLYR3A.45     
CLL  Project task:                                                         BDYLYR3A.46     
CLL                                                                        BDYLYR3A.47     
CLL  Documentation: UMDP 24.                                               BDYLYR3A.48     
CLL                                                                        BDYLYR3A.49     
CLL---------------------------------------------------------------------   BDYLYR3A.50     
C*                                                                         BDYLYR3A.51     
C*L---------------------------------------------------------------------   BDYLYR3A.52     
C    Arguments :-                                                          BDYLYR3A.53     

      SUBROUTINE BDY_LAYR (                                                 4,80BDYLYR3A.54     
                                                                           BDYLYR3A.55     
C IN values defining field dimensions and subset to be processed :         BDYLYR3A.56     
     + P_FIELD,U_FIELD,LAND_FIELD,P_ROWS,FIRST_ROW,N_ROWS,ROW_LENGTH       BDYLYR3A.57     
                                                                           BDYLYR3A.58     
C IN values defining vertical grid of model atmosphere :                   BDYLYR3A.59     
     +,BL_LEVELS,P_LEVELS,AK,BK,AKH,BKH,DELTA_AK,DELTA_BK                  BDYLYR3A.60     
     +,EXNER                                                               BDYLYR3A.61     
                                                                           BDYLYR3A.62     
C IN soil/vegetation/land surface data :                                   BDYLYR3A.63     
     +,LAND_MASK,GATHER,LAND_INDEX                                         BDYLYR3A.67     
     +,ST_LEVELS,SM_LEVELS,CANOPY,CATCH,HCAP,HCON,LAYER_DEPTH              AJS1F401.1088   
     +,LYING_SNOW,RESIST,ROOTD,SMC,SMVCCL,SMVCWT,Z0V,SIL_OROG_LAND         BDYLYR3A.70     
     +,L_Z0_OROG,HO2R2_OROG                                                BDYLYR3A.71     
                                                                           BDYLYR3A.72     
C IN sea/sea-ice data :                                                    BDYLYR3A.73     
     +,DI,ICE_FRACT,U_0,V_0                                                BDYLYR3A.74     
                                                                           BDYLYR3A.75     
C IN cloud data :                                                          BDYLYR3A.76     
     +,CF,QCF,QCL                                                          BDYLYR3A.77     
     +,CCA,CCB,CCT                                                         BDYLYR3A.78     
                                                                           BDYLYR3A.79     
C IN everything not covered so far :                                       BDYLYR3A.80     
     +,PSTAR,RADNET,TIMESTEP,L_RMBL,L_BL_LSPICE,L_MOM,L_MIXLEN             ADM3F404.206    
                                                                           BDYLYR3A.82     
C INOUT data :                                                             BDYLYR3A.83     
     +,Q,T,T_DEEP_SOIL,TSTAR,U,V,Z0MSEA                                    BDYLYR3A.84     
                                                                           BDYLYR3A.85     
C OUT Diagnostic not requiring STASH flags :                               BDYLYR3A.86     
     +,CD,CH,E_SEA,FQW,FTL,H_SEA,RHOKH,RHOKM,RIB                           BDYLYR3A.87     
     +,SEA_ICE_HTF,SOIL_HT_FLUX,TAUX,TAUY,VSHR                             BDYLYR3A.88     
                                                                           BDYLYR3A.89     
C OUT diagnostic requiring STASH flags :                                   BDYLYR3A.90     
     +,FME,SICE_MLT_HTF,LATENT_HEAT,Q1P5M,T1P5M,U10M,V10M                  BDYLYR3A.91     
C (IN) STASH flags :-                                                      BDYLYR3A.92     
     +,SFME,SMLT,SLH,SQ1P5,ST1P5,SU10,SV10                                 BDYLYR3A.93     
                                                                           BDYLYR3A.94     
C OUT data required for tracer mixing :                                    BDYLYR3A.95     
     &,NRML                                                                BDYLYR3A.96     
                                                                           BDYLYR3A.97     
C OUT data required for 4D-VAR :                                           ASJ1F400.4      
     &,RHO_CD_MODV1,RHO_KM                                                 ASJ1F400.5      
                                                                           ASJ1F400.6      
C OUT data required elsewhere in UM system :                               BDYLYR3A.98     
     +,ECAN,EI,ES,ZH,T1_SD,Q1_SD,ERROR                                     BDYLYR3A.99     
                                                                           BDYLYR3A.100    
C LOGICAL LTIMER                                                           BDYLYR3A.101    
     +,LTIMER                                                              BDYLYR3A.102    
*IF DEF,SCMA                                                               AJC0F405.64     
     &  ,FACTOR_RHOKH,OBS                                                  AJC0F405.65     
*ENDIF                                                                     AJC0F405.66     
     +)                                                                    BDYLYR3A.103    
      IMPLICIT NONE                                                        BDYLYR3A.104    
C                                                                          BDYLYR3A.105    
C  Inputs :-                                                               BDYLYR3A.106    
C                                                                          BDYLYR3A.107    
C (a) Defining horizontal grid and subset thereof to be processed.         BDYLYR3A.108    
C                                                                          BDYLYR3A.109    
      INTEGER                                                              BDYLYR3A.110    
     + P_FIELD                    ! IN No. of P-points in whole grid       BDYLYR3A.111    
C                                 !    (for dimensioning only).            BDYLYR3A.112    
     +,U_FIELD                    ! IN No. of UV-points in whole grid.     BDYLYR3A.116    
C                                 !    (Checked for consistency with       BDYLYR3A.118    
C                                 !    P_FIELD and P_ROWS; there must      BDYLYR3A.119    
C                                 !    be 1 less UV than P row.)           BDYLYR3A.120    
     +,LAND_FIELD                 ! IN No.of land points in whole grid.    BDYLYR3A.124    
C                                 !    (Checked for consistency with       BDYLYR3A.126    
C                                 !    P_FIELD )                           BDYLYR3A.127    
     +,P_ROWS                     ! IN No. of P-rows in whole grid         BDYLYR3A.132    
C                                 !    (for dimensioning only).            BDYLYR3A.133    
     +,FIRST_ROW                  ! IN First row of data to be treated,    BDYLYR3A.137    
C                                 !    referred to P-grid (must be > 1     BDYLYR3A.139    
C                                 !    since "polar" rows are never        BDYLYR3A.140    
C                                 !    treated).                           BDYLYR3A.141    
     +,N_ROWS                     ! IN No. of rows of data to be           BDYLYR3A.145    
C                                 !    treated, referred to P-grid.        BDYLYR3A.146    
C                                 !    FIRST_ROW+N_ROWS-1 must be less     BDYLYR3A.148    
C                                 !    than P_ROWS, since "polar" rows     BDYLYR3A.149    
C                                 !    are never treated.                  BDYLYR3A.150    
     +,ROW_LENGTH                 ! IN No. of points in one row.           BDYLYR3A.154    
C                                 !    (Checked for consistency with       BDYLYR3A.156    
C                                 !    P_FIELD and N_ROWS.)                BDYLYR3A.157    
C                                                                          BDYLYR3A.161    
C (b) Defining vertical grid of model atmosphere.                          BDYLYR3A.162    
C                                                                          BDYLYR3A.163    
      INTEGER                                                              BDYLYR3A.164    
     + BL_LEVELS                  ! IN Max. no. of "boundary" levels       BDYLYR3A.165    
C                                 !    allowed.Assumed <= 30 for dim-      BDYLYR3A.166    
C                                 !    sioning of GAMMA in common deck     BDYLYR3A.167    
C                                 !    C_GAMMA used in SF_EXCH and KMKH    BDYLYR3A.168    
     +,P_LEVELS                   ! IN Total no. of vertical levels in     BDYLYR3A.169    
C                                 !    the model atmosphere.               BDYLYR3A.170    
      REAL                                                                 BDYLYR3A.171    
     + AK(P_LEVELS)                ! IN Hybrid 'A' for all levels.         BDYLYR3A.172    
     +,BK(P_LEVELS)                ! IN Hybrid 'B' for all levels.         BDYLYR3A.173    
     +,AKH(P_LEVELS+1)             ! IN Hybrid 'A' for layer interfaces.   BDYLYR3A.174    
     +,BKH(P_LEVELS+1)             ! IN Hybrid 'B' for layer interfaces.   BDYLYR3A.175    
     +,DELTA_AK(P_LEVELS)          ! IN Difference of hybrid 'A' across    BDYLYR3A.176    
C                                  !    layers (K-1/2 to K+1/2).           BDYLYR3A.177    
C                                  !    NB: Upper minus lower.             BDYLYR3A.178    
     +,DELTA_BK(P_LEVELS)          ! IN Difference of hybrid 'B' across    BDYLYR3A.179    
C                                  !    layers (K-1/2 to K+1/2).           BDYLYR3A.180    
C                                  !    NB: Upper minus lower.             BDYLYR3A.181    
     +,EXNER(P_FIELD,BL_LEVELS+1)  ! IN Exner function.  EXNER(,K) is      BDYLYR3A.182    
C                                  !    value for LOWER BOUNDARY of        BDYLYR3A.183    
C                                  !    level K.                           BDYLYR3A.184    
C                                                                          BDYLYR3A.185    
C (c) Soil/vegetation/land surface parameters (mostly constant).           BDYLYR3A.186    
C                                                                          BDYLYR3A.187    
      LOGICAL                                                              BDYLYR3A.188    
     + LAND_MASK(P_FIELD)        ! IN T if land, F elsewhere.              BDYLYR3A.189    
     +,GATHER                    ! IN T if gather to sea-ice points        BDYLYR3A.190    
C                                !    in SF_EXCH. Saves a lot of un-       BDYLYR3A.191    
C                                !    necessary calculations if there      BDYLYR3A.192    
C                                !    are relatively few sea-ice points    BDYLYR3A.193    
     +,L_Z0_OROG                 ! IN T to use orog.roughness              BDYLYR3A.194    
C                                !    treatment in SF_EXCH                 BDYLYR3A.195    
*IF DEF,SCMA                                                               AJC0F405.67     
      LOGICAL OBS               ! Switch for OBS forcing                   AJC0F405.68     
*ENDIF                                                                     AJC0F405.69     
     +,L_RMBL                    ! IN T to use rapidly mixing boundary     ASJ3F401.6      
C                                !    scheme in IMPL_CAL                   ASJ3F401.7      
     &,L_BL_LSPICE           ! IN                                          ADM3F404.207    
!                              TRUE  Use scientific treatment of mixed     ADM3F404.208    
!                                    phase precip scheme.                  ADM3F404.209    
!                              FALSE Do not use mixed phase precip         ADM3F404.210    
!                                    considerations                        ADM3F404.211    
     &,L_MOM                     ! IN Switch for convective momentum       ARN1F403.32     
C                                !    transport.                           ARN1F403.33     
     &,L_MIXLEN                  ! IN Switch for reducing the turbulent    ARN1F403.34     
C                                !    mixing length above the top of the   ARN1F403.35     
C                                !    boundary layer.                      ARN1F403.36     
C                                                                          ARN1F403.37     
      INTEGER                                                              BDYLYR3A.197    
     + LAND_INDEX(P_FIELD)       ! IN LAND_INDEX(I)=J => the Jth           BDYLYR3A.198    
C                                !    point in P_FIELD is the Ith          BDYLYR3A.199    
C                                !    land point.                          BDYLYR3A.200    
      INTEGER                                                              BDYLYR3A.202    
     + ST_LEVELS                 ! IN No. of deep soil levels              AJS1F401.1089   
     +,SM_LEVELS                 ! IN No. of soil moisture levels          AJS1F401.1090   
C                                !                                         AJS1F401.1091   
      REAL                                                                 BDYLYR3A.205    
     + CANOPY(LAND_FIELD)        ! IN Surface/canopy water (kg per sq m)   BDYLYR3A.206    
     +,CATCH(LAND_FIELD)         ! IN Surface/canopy water capacity        BDYLYR3A.207    
C                                !    (kg per sq m).                       BDYLYR3A.208    
*IF DEF,SCMA                                                               AJC0F405.70     
     &  ,FACTOR_RHOKH(P_FIELD)  ! IN Factor for modifying surface          AJC0F405.71     
                                !  fluxes if OBS forcing used              AJC0F405.72     
*ENDIF                                                                     AJC0F405.73     
     +,HCAP(LAND_FIELD)          ! IN Soil heat capacity (J / K / m**3).   BDYLYR3A.209    
     +,HCON(LAND_FIELD)          ! IN Soil thermal conductivity (W/m/K).   BDYLYR3A.210    
     +,LAYER_DEPTH(ST_LEVELS+1) ! IN Depths of soil layers, as multiple    AJS1F401.1092   
C                                !    of depth of top layer, counting      BDYLYR3A.212    
C                                !    from top down and including first    BDYLYR3A.213    
C                                !    layer (i.e. 1st value must be 1).    BDYLYR3A.214    
     +,LYING_SNOW(P_FIELD)       ! IN Lying snow (kg per sq m).            BDYLYR3A.215    
C                                !    Must be global for coupled model,    BDYLYR3A.217    
C                                !    ie dimension P_FIELD not LAND_FIEL   BDYLYR3A.218    
     +,RESIST(LAND_FIELD)        ! IN "Stomatal" resistance to             BDYLYR3A.220    
C                                !    evaporation (seconds per metre).     BDYLYR3A.221    
     +,ROOTD(LAND_FIELD)         ! IN Depth of active soil layer ("root    BDYLYR3A.222    
C                                !    depth") (metres).                    BDYLYR3A.223    
     +,SMC(LAND_FIELD)           ! IN Soil moisture content (kg / sq m).   BDYLYR3A.224    
     +,SMVCCL(LAND_FIELD)        ! IN Critical volumetric SMC (cubic m     BDYLYR3A.225    
C                                !    per cubic m of soil).                BDYLYR3A.226    
     +,SMVCWT(LAND_FIELD)        ! IN Volumetric wilting point (cubic m    BDYLYR3A.227    
C                                !    per cubic m of soil).                BDYLYR3A.228    
     +,Z0V(P_FIELD)              ! IN Vegetative roughness length (m).     BDYLYR3A.229    
C                                !    NB:UM uses same storage for Z0MSEA   BDYLYR3A.230    
C                                !    so for sea points this is INOUT.     BDYLYR3A.231    
     +,SIL_OROG_LAND(LAND_FIELD) ! IN Silhouette area of unresolved        BDYLYR3A.232    
C                                !    orography per unit horizontal area   BDYLYR3A.233    
C                                !    on land points only.                 BDYLYR3A.234    
     +,HO2R2_OROG(LAND_FIELD)    ! IN Standard Deviation of orography.     BDYLYR3A.235    
C                                !    equivilent to peak to trough         BDYLYR3A.236    
C                                !    height of unresolved orography       BDYLYR3A.237    
C                                !    devided by 2SQRT(2) on land          BDYLYR3A.238    
C                                !    points only (m)                      BDYLYR3A.239    
C                                                                          BDYLYR3A.240    
C (d) Sea/sea-ice data.                                                    BDYLYR3A.241    
C                                                                          BDYLYR3A.242    
      REAL                                                                 BDYLYR3A.243    
     + DI(P_FIELD)               ! IN "Equivalent thickness" of sea-ice    BDYLYR3A.244    
C                                !    (m).                                 BDYLYR3A.245    
     +,ICE_FRACT(P_FIELD)        ! IN Fraction of gridbox covered by       BDYLYR3A.246    
C                                !    sea-ice (decimal fraction).          BDYLYR3A.247    
     +,U_0(U_FIELD)              ! IN W'ly component of surface current    BDYLYR3A.248    
C                                !    (metres per second).                 BDYLYR3A.249    
     +,V_0(U_FIELD)              ! IN S'ly component of surface current    BDYLYR3A.250    
C                                !    (metres per second).                 BDYLYR3A.251    
C                                                                          BDYLYR3A.252    
C (e) Cloud data.                                                          BDYLYR3A.253    
C                                                                          BDYLYR3A.254    
      REAL                                                                 BDYLYR3A.255    
     + CF(P_FIELD,BL_LEVELS)     ! IN Cloud fraction (decimal).            BDYLYR3A.256    
     +,QCF(P_FIELD,BL_LEVELS)    ! IN Cloud ice (kg per kg air)            BDYLYR3A.257    
     +,QCL(P_FIELD,BL_LEVELS)    ! IN Cloud liquid water (kg               BDYLYR3A.258    
C                                !       per kg air).                      BDYLYR3A.259    
     +,CCA(P_FIELD)              ! IN Convective Cloud Amount (decimal).   BDYLYR3A.260    
      INTEGER                                                              BDYLYR3A.261    
     + CCB(P_FIELD)              ! IN Convective Cloud Base                BDYLYR3A.262    
     +,CCT(P_FIELD)              ! IN Convective Cloud Top                 BDYLYR3A.263    
C                                                                          BDYLYR3A.264    
C (f) Atmospheric + any other data not covered so far, incl control.       BDYLYR3A.265    
C                                                                          BDYLYR3A.266    
      REAL                                                                 BDYLYR3A.267    
     + PSTAR(P_FIELD)            ! IN Surface pressure (Pascals).          BDYLYR3A.268    
     +,RADNET(P_FIELD)           ! IN Surface net radiation (W/sq m,       BDYLYR3A.269    
C                                !    positive downwards).                 BDYLYR3A.270    
     +,TIMESTEP                  ! IN Timestep (seconds).                  BDYLYR3A.271    
C                                                                          BDYLYR3A.272    
      LOGICAL LTIMER             ! Logical switch for TIMER diags          BDYLYR3A.273    
C                                                                          BDYLYR3A.274    
C  STASH flags :-                                                          BDYLYR3A.275    
C                                                                          BDYLYR3A.276    
      LOGICAL                                                              BDYLYR3A.277    
     + SFME    ! IN Flag for FME (q.v.).                                   BDYLYR3A.278    
     +,SMLT    ! IN Flag for SICE_MLT_HTF (q.v.)                           BDYLYR3A.279    
     +,SLH     ! IN Flag for LATENT_HEAT (q.v.)                            BDYLYR3A.280    
     +,SQ1P5   ! IN Flag for Q1P5M (q.v.)                                  BDYLYR3A.281    
     +,ST1P5   ! IN Flag for T1P5M (q.v.)                                  BDYLYR3A.282    
     +,SU10    ! IN Flag for U10M (q.v.)                                   BDYLYR3A.283    
     +,SV10    ! IN Flag for V10M (q.v.)                                   BDYLYR3A.284    
C                                                                          BDYLYR3A.285    
C  In/outs :-                                                              BDYLYR3A.286    
C                                                                          BDYLYR3A.287    
      REAL                                                                 BDYLYR3A.288    
     + Q(P_FIELD,BL_LEVELS)            ! INOUT Input:specific humidity     BDYLYR3A.289    
C                                      !       ( kg water per kg air).     BDYLYR3A.290    
C                                      !      Output:total water content   BDYLYR3A.291    
C                                      !      (Q)(kg water per kg air).    BDYLYR3A.292    
     +,T(P_FIELD,BL_LEVELS)            ! INOUT Input:atmospheric temp(K)   BDYLYR3A.293    
C                                      !      Output:liquid/frozen water   BDYLYR3A.294    
C                                      !       temperature (TL) (K)        BDYLYR3A.295    
     +,T_DEEP_SOIL(LAND_FIELD,ST_LEVELS) ! INOUT Deep soil temperatures    AJS1F401.1093   
C                                        !       (K).                      BDYLYR3A.297    
     +,TSTAR(P_FIELD)                  ! INOUT Surface temperature         BDYLYR3A.298    
C                                      !       (= top soil layer           BDYLYR3A.299    
C                                      !       temperature) (K).           BDYLYR3A.300    
     +,U(U_FIELD,BL_LEVELS)            ! INOUT W'ly wind component         BDYLYR3A.301    
C                                      !       (metres per second).        BDYLYR3A.302    
     +,V(U_FIELD,BL_LEVELS)            ! INOUT S'ly wind component         BDYLYR3A.303    
C                                      !       (metres per second).        BDYLYR3A.304    
     +,Z0MSEA(P_FIELD)                 ! INOUT Sea-surface roughness       BDYLYR3A.305    
C                                      !       length for momentum (m).    BDYLYR3A.306    
C                                      !       NB: same storage is used    BDYLYR3A.307    
C                                      !       for Z0V, so the intent is   BDYLYR3A.308    
C                                      !       IN for land points.         BDYLYR3A.309    
C                                                                          BDYLYR3A.310    
C  Outputs :-                                                              BDYLYR3A.311    
C                                                                          BDYLYR3A.312    
C-1 Diagnostic (or effectively so - includes coupled model requisites):-   BDYLYR3A.313    
C                                                                          BDYLYR3A.314    
C  (a) Calculated anyway (use STASH space from higher level) :-            BDYLYR3A.315    
C                                                                          BDYLYR3A.316    
      REAL                                                                 BDYLYR3A.317    
     + CD(P_FIELD)               ! OUT Turbulent surface exchange (bulk    BDYLYR3A.318    
C                                !     transfer) coefficient for           BDYLYR3A.319    
C                                !     momentum.                           BDYLYR3A.320    
     +,CH(P_FIELD)               ! OUT Turbulent surface exchange (bulk    BDYLYR3A.321    
C                                !     transfer) coefficient for heat      BDYLYR3A.322    
C                                !     and/or moisture.                    BDYLYR3A.323    
     +,E_SEA(P_FIELD)            ! OUT Evaporation from sea times leads    BDYLYR3A.324    
C                                !     fraction. Zero over land.           BDYLYR3A.325    
C                                !     (kg per square metre per sec).      BDYLYR3A.326    
     +,FQW(P_FIELD,BL_LEVELS)    ! OUT Moisture flux between layers        BDYLYR3A.327    
C                                !     (kg per square metre per sec).      BDYLYR3A.328    
C                                !     FQW(,1) is total water flux         BDYLYR3A.329    
C                                !     from surface, 'E'.                  BDYLYR3A.330    
     +,FTL(P_FIELD,BL_LEVELS)    ! OUT FTL(,K) contains net turbulent      BDYLYR3A.331    
C                                !     sensible heat flux into layer K     BDYLYR3A.332    
C                                !     from below; so FTL(,1) is the       BDYLYR3A.333    
C                                !     surface sensible heat, H.  (W/m2)   BDYLYR3A.334    
     +,H_SEA(P_FIELD)            ! OUT Surface sensible heat flux over     BDYLYR3A.335    
C                                !     sea times leads fraction. (W/m2)    BDYLYR3A.336    
     +,RHOKH(P_FIELD,BL_LEVELS)  ! OUT Exchange coeffs for moisture.       BDYLYR3A.337    
C                                !     Surface:out of SF_EXCH containing   BDYLYR3A.338    
C                                !     GAMMA(1)*RHOKH,after IMPL_CAL       BDYLYR3A.339    
C                                !     contains only RHOKH.                BDYLYR3A.340    
C                                !     Above surface:out of KMKH cont-     BDYLYR3A.341    
C                                !     aining GAMMA(1)*RHOKH(,1)*RDZ(,1)   BDYLYR3A.342    
     +,RHOKM(U_FIELD,BL_LEVELS)  ! OUT Exchange coefficients for           BDYLYR3A.343    
C                                !     momentum (on UV-grid, with 1st      BDYLYR3A.344    
C                                !     and last rows undefined (or, at     BDYLYR3A.345    
C                                !     present, set to "missing data")).   BDYLYR3A.346    
C                                !     Surface:out of SF_EXCH containing   BDYLYR3A.347    
C                                !     GAMMA(1)*RHOKH,after IMPL_CAL       BDYLYR3A.348    
C                                !     contains only RHOKH.                BDYLYR3A.349    
C                                !     Above surface:out of KMKH cont-     BDYLYR3A.350    
C                                !     aining GAMMA(1)*RHOKH(,1)*RDZ(,1)   BDYLYR3A.351    
     +,RIB(P_FIELD)              ! OUT Bulk Richardson number for lowest   BDYLYR3A.352    
C                                !     layer.                              BDYLYR3A.353    
     +,SEA_ICE_HTF(P_FIELD)      ! OUT Heat flux through sea-ice (W per    BDYLYR3A.354    
C                                !     sq m, positive downwards).          BDYLYR3A.355    
     +,SOIL_HT_FLUX(P_FIELD)     ! OUT Heat flux from soil layer 1 to      BDYLYR3A.356    
C                                !     soil layer 2, i.e. from surface     BDYLYR3A.357    
C                                !     to deep soil layer 1, i.e. +ve      BDYLYR3A.358    
C                                !     downwards (Watts per sq m).         BDYLYR3A.359    
     +,TAUX(U_FIELD,BL_LEVELS)   ! OUT W'ly component of surface wind      BDYLYR3A.360    
C                                !     stress (N/sq m).(On UV-grid with    BDYLYR3A.361    
C                                !     first and last rows undefined or    BDYLYR3A.362    
C                                !     at present, set to 'missing data'   BDYLYR3A.363    
     +,TAUY(U_FIELD,BL_LEVELS)   ! OUT S'ly component of surface wind      BDYLYR3A.364    
C                                !     stress (N/sq m).  On UV-grid;       BDYLYR3A.365    
C                                !     comments as per TAUX.               BDYLYR3A.366    
     +,VSHR(P_FIELD)             ! OUT Magnitude of surface-to-lowest      BDYLYR3A.367    
C                                !     atm level wind shear (m per s).     BDYLYR3A.368    
C                                                                          BDYLYR3A.369    
     &,RHO_CD_MODV1(P_FIELD)     ! OUT Surface air density * drag coef.*   ASJ1F400.7      
C                                !     mod(v1 - v0) before interpolation   ASJ1F400.8      
     &,RHO_KM(P_FIELD,2:BL_LEVELS) ! OUT Air density * turbulent mixing    ASJ1F400.9      
C                                !     coefficient for momentum before     ASJ1F400.10     
C                                      interpolation.                      ASJ1F400.11     
      INTEGER                                                              BDYLYR3A.370    
     + NRML(P_FIELD)             ! OUT Number of model layers in the       BDYLYR3A.371    
C                                !     Rapidly Mixing Layer; diagnosed     BDYLYR3A.372    
C                                !     in SF_EXCH and KMKH and used in     BDYLYR3A.373    
C                                !     IMPL_CAL, SF_EVAP and TR_MIX.       BDYLYR3A.374    
C                                                                          BDYLYR3A.375    
C  (b) Not passed between lower-level routines (not in workspace at this   BDYLYR3A.376    
C      level) :-                                                           BDYLYR3A.377    
C                                                                          BDYLYR3A.378    
      REAL                                                                 BDYLYR3A.379    
     + FME(P_FIELD)             ! OUT Wind mixing "power" (W per sq m).    BDYLYR3A.380    
     +,SICE_MLT_HTF(P_FIELD)    ! OUT Heat flux due to melting of sea-     BDYLYR3A.381    
C                               !     ice (Watts per sq metre).            BDYLYR3A.382    
     +,LATENT_HEAT(P_FIELD)     ! OUT Surface latent heat flux, +ve        BDYLYR3A.383    
C                               !     upwards (Watts per sq m).            BDYLYR3A.384    
     +,Q1P5M(P_FIELD)           ! OUT Q at 1.5 m (kg water per kg air).    BDYLYR3A.385    
     +,T1P5M(P_FIELD)           ! OUT T at 1.5 m (K).                      BDYLYR3A.386    
     +,U10M(U_FIELD)            ! OUT U at 10 m (m per s).                 BDYLYR3A.387    
     +,V10M(U_FIELD)            ! OUT V at 10 m (m per s).                 BDYLYR3A.388    
C                                                                          BDYLYR3A.389    
C-2 Genuinely output, needed by other atmospheric routines :-              BDYLYR3A.390    
C                                                                          BDYLYR3A.391    
      REAL                                                                 BDYLYR3A.392    
     + ECAN(P_FIELD)  ! OUT Gridbox mean evaporation from canopy/surface   BDYLYR3A.393    
C                     !     store (kg per sq m per s).  Zero over sea.     BDYLYR3A.394    
     +,EI(P_FIELD)    ! OUT Sublimation from lying snow or sea-ice (kg     BDYLYR3A.395    
C                     !     per sq m per sec).                             BDYLYR3A.396    
     +,ES(P_FIELD)    ! OUT Surface evapotranspiration through a           BDYLYR3A.397    
C                     !     resistance which is not entirely aerodynamic   BDYLYR3A.398    
C                     !     i.e. "soil evaporation".  Always non-          BDYLYR3A.399    
C                     !     negative.  Kg per sq m per sec.                BDYLYR3A.400    
     +,ZH(P_FIELD)    ! OUT Height above surface of top of boundary        BDYLYR3A.401    
C                     !     layer (metres).                                BDYLYR3A.402    
     &,T1_SD(P_FIELD) ! OUT Standard deviation of turbulent fluctuations   BDYLYR3A.403    
C                     !     of layer 1 temperature; for use in             BDYLYR3A.404    
C                     !     initiating convection.                         BDYLYR3A.405    
     &,Q1_SD(P_FIELD) ! OUT Standard deviation of turbulent fluctuations   BDYLYR3A.406    
C                     !     of layer 1 humidity; for use in initiating     BDYLYR3A.407    
C                     !     convection.                                    BDYLYR3A.408    
      INTEGER                                                              BDYLYR3A.409    
     + ERROR          ! OUT 0 - AOK;                                       BDYLYR3A.410    
C                     !     1 to 7  - bad grid definition detected;        BDYLYR3A.412    
C                     !     11 - error in SF_EXCH;                         BDYLYR3A.416    
C                     !     21 - error in KMKH;                            BDYLYR3A.417    
C                     !     31 - error in IMPL_CAL;                        BDYLYR3A.418    
C                     !     41 - error in SOIL_HTF.                        BDYLYR3A.420    
C*----------------------------------------------------------------------   BDYLYR3A.422    
C*L---------------------------------------------------------------------   BDYLYR3A.423    
C  External routines called :-                                             BDYLYR3A.424    
C                                                                          BDYLYR3A.425    
      EXTERNAL Z,SICE_HTF,SOIL_HTF,SF_EXCH,KMKH,IMPL_CAL,SF_EVAP           BDYLYR3A.426    
      EXTERNAL TIMER                                                       BDYLYR3A.427    
*IF -DEF,SCMA                                                              AJC1F405.520    
      EXTERNAL UV_TO_P                                                     BDYLYR3A.429    
*ENDIF                                                                     BDYLYR3A.430    
C*----------------------------------------------------------------------   BDYLYR3A.431    
C*L---------------------------------------------------------------------   BDYLYR3A.432    
C   Symbolic constants (parameters) reqd in top-level routine :-           BDYLYR3A.433    
C                                                                          BDYLYR3A.434    
*CALL C_R_CP                                                               BDYLYR3A.435    
*CALL C_LHEAT                                                              BDYLYR3A.436    
C*----------------------------------------------------------------------   BDYLYR3A.437    
C                                                                          BDYLYR3A.438    
C  Workspace :-                                                            BDYLYR3A.439    
C                                                                          BDYLYR3A.440    
      REAL                                                                 BDYLYR3A.516    
     + DZL(P_FIELD,BL_LEVELS)     ! WORK DZL(,K) is depth in m of layer    BDYLYR3A.517    
C                                 !      K, i.e. distance from boundary    BDYLYR3A.518    
C                                 !      K-1/2 to boundary K+1/2.          BDYLYR3A.519    
     +,FQW_LEAD(P_FIELD)          ! WORK FQW for leads fractn of grid sq   BDYLYR3A.520    
     +,FTL_LEAD(P_FIELD)          ! WORK FTL for leads fractn of grid sq   BDYLYR3A.521    
     +,QW(P_FIELD,BL_LEVELS)      ! WORK Total water content, but          BDYLYR3A.522    
C                                 !      replaced by specific humidity     BDYLYR3A.523    
C                                 !      in LS_CLD.                        BDYLYR3A.524    
     +,RDZ(P_FIELD,BL_LEVELS)     ! WORK RDZ(,1) is the reciprocal         BDYLYR3A.525    
C                                 !      of the height of level 1, i.e.    BDYLYR3A.526    
C                                 !      of the middle of layer 1.  For    BDYLYR3A.527    
C                                 !      K > 1, RDZ(,K) is the             BDYLYR3A.528    
C                                 !      reciprocal of the vertical        BDYLYR3A.529    
C                                 !      distance from level K-1 to        BDYLYR3A.530    
C                                 !      level K.                          BDYLYR3A.531    
     +,TL(P_FIELD,BL_LEVELS)      ! WORK Ice/liquid water temperature,     BDYLYR3A.532    
C                                 !      but replaced by T in LS_CLD.      BDYLYR3A.533    
     +,TSTAR_NL(P_FIELD)          ! WORK TSTAR No Leads (K).               BDYLYR3A.534    
     +,TV_RDZUV(P_FIELD,BL_LEVELS) ! WORK Virtual temp at start (TV).      BDYLYR3A.535    
C                                  !      RDZ (K > 1) on UV-grid.          BDYLYR3A.536    
C                                  !      Comments as per RHOKM (RDZUV).   BDYLYR3A.537    
     +,U_P(P_FIELD,BL_LEVELS)     ! WORK U on P-grid.                      BDYLYR3A.538    
     +,V_P(P_FIELD,BL_LEVELS)     ! WORK V on P-grid.                      BDYLYR3A.539    
     +,ZLB(P_FIELD,0:BL_LEVELS)   ! WORK ZLB(,K) is the height of the      BDYLYR3A.540    
C                                 !      upper boundary of layer K         BDYLYR3A.541    
C                                 !      ( = 0.0 for "K=0").               BDYLYR3A.542    
      REAL                                                                 BDYLYR3A.543    
     + ASOIL_1(P_FIELD)           ! WORK Soil thermodynamic coefficient.   BDYLYR3A.544    
     +,BQ_1(P_FIELD)              ! WORK A buoyancy parameter for the      BDYLYR3A.545    
C                                 !      lowest atmospheric level.         BDYLYR3A.546    
     +,BT_1(P_FIELD)              ! WORK A buoyancy parameter for the      BDYLYR3A.547    
C                                 !      lowest atmospheric level.         BDYLYR3A.548    
     &,BF_1(P_FIELD)                                                       ADM3F404.212    
!        WORK   A bouyancy parameter for the lowest atmospheric level      ADM3F404.213    
     +,DQW_1(P_FIELD)             ! WORK Increment for QW(,1).             BDYLYR3A.549    
     +,DQW_RML(P_FIELD)           ! WORK Increment for QW in the           BDYLYR3A.550    
C                                 !      Rapidly Mixing Layer.             BDYLYR3A.551    
     +,DTRDZ(P_FIELD,BL_LEVELS)   ! WORK -g.dt/dp for model layers.        BDYLYR3A.552    
     +,DTRDZ_RML(P_FIELD)         ! WORK -g.dt/dp for the rapidly          BDYLYR3A.553    
C                                 !      mixing layer.                     BDYLYR3A.554    
     +,DTSTAR(P_FIELD)            ! WORK Increment for TSTAR.              BDYLYR3A.555    
     +,EA(P_FIELD)                ! WORK Surface evaporation with only     BDYLYR3A.556    
C                                 !      aerodynamic resistance (+ve),     BDYLYR3A.557    
C                                 !      or condensation (-ve),            BDYLYR3A.558    
C                                 !      averaged over gridbox.            BDYLYR3A.559    
     +,ESL(P_FIELD)               ! WORK ES (q.v.) without fractional      BDYLYR3A.560    
C                                 !      weighting factor FRACS.  "L"      BDYLYR3A.561    
C                                 !      is for "local".                   BDYLYR3A.562    
     +,RHOKE(P_FIELD)             ! WORK Surface exchange coefficient      BDYLYR3A.563    
C                                 !      for FQW.                          BDYLYR3A.564    
     +,RHOKEA(P_FIELD)            ! WORK Surface exchange coefficient      BDYLYR3A.565    
C                                 !      for EA.                           BDYLYR3A.566    
     +,RHOKES(P_FIELD)            ! WORK Surface exchange coefficient      BDYLYR3A.567    
C                                 !      for ES.                           BDYLYR3A.568    
     +,RHOKESL(P_FIELD)           ! WORK Surface exchange coefficient      BDYLYR3A.569    
C                                 !      for ESL.                          BDYLYR3A.570    
     +,Z0H(P_FIELD)               ! WORK Roughness length for heat and     BDYLYR3A.571    
C                                 !      moisture.                         BDYLYR3A.572    
     +,Z0M(P_FIELD)               ! WORK Roughness length for momentum.    BDYLYR3A.573    
     +,Z1(P_FIELD)                ! WORK Height of lowest level (i.e.      BDYLYR3A.574    
C                                 !      height of middle of lowest        BDYLYR3A.575    
C                                 !      layer).                           BDYLYR3A.576    
     +,H_BLEND(P_FIELD)           ! WORK Blending height used as part of   BDYLYR3A.577    
C                                 !      effective roughness scheme        BDYLYR3A.578    
     +,Z0M_EFF(P_FIELD)           ! WORK Effective roughness length for    BDYLYR3A.581    
C                                 !      momentum                          BDYLYR3A.582    
      REAL                                                                 BDYLYR3A.583    
     + CDR10M(U_FIELD)            ! WORK Ratio of CD's reqd for            BDYLYR3A.584    
C                                 !      calculation of 10 m wind.         BDYLYR3A.585    
C                                 !      On UV-grid; comments as per       BDYLYR3A.586    
C                                 !      RHOKM.                            BDYLYR3A.587    
     +,CER1P5M(P_FIELD)           ! WORK Ratio of coefficients reqd for    BDYLYR3A.588    
C                                 !      calculation of 1.5 m Q.           BDYLYR3A.589    
     +,CHR1P5M(P_FIELD)           ! WORK Ratio of coefficients reqd for    BDYLYR3A.590    
C                                 !      calculation of 1.5 m T.           BDYLYR3A.591    
C                                                                          BDYLYR3A.593    
C  Local scalars :-                                                        BDYLYR3A.594    
C                                                                          BDYLYR3A.595    
      INTEGER                                                              BDYLYR3A.596    
     + ERR        ! LOCAL Return codes from lower-level routines.          BDYLYR3A.597    
     +,I          ! LOCAL Loop counter (horizontal field index).           BDYLYR3A.598    
     +,K          ! LOCAL Loop counter (vertical level index).             BDYLYR3A.599    
     +,N_P_ROWS   ! LOCAL No of P-rows being processed.                    BDYLYR3A.600    
     +,N_U_ROWS   ! LOCAL No of UV-rows being processed.                   BDYLYR3A.601    
     +,P_POINTS   ! LOCAL No of P-points being processed.                  BDYLYR3A.603    
     +,P1         ! LOCAL First P-point to be processed.                   BDYLYR3A.604    
     +,LAND1      ! LOCAL First land-point to be processed.                BDYLYR3A.605    
C                 !           1 <= LAND1 <= LAND_FIELD                     BDYLYR3A.606    
     +,LAND_PTS   ! LOCAL No of land points being processed.               BDYLYR3A.607    
     +,SEA_FIELD  ! LOCAL No of sea points in the full field.              BDYLYR3A.608    
     +,SEA_PTS    ! LOCAL No of sea points being processed.                BDYLYR3A.609    
     +,U_POINTS   ! LOCAL No of UV-points being processed.                 BDYLYR3A.610    
     +,U1         ! LOCAL First UV-point to be processed.                  BDYLYR3A.611    
      IF (LTIMER) THEN                                                     BDYLYR3A.612    
        CALL TIMER('BDYLAYR ',3)                                           BDYLYR3A.613    
      ENDIF                                                                BDYLYR3A.614    
      ERROR = 0                                                            BDYLYR3A.615    
*IF -DEF,SCMA                                                              AJC1F405.521    
C                                                                          BDYLYR3A.617    
C-----------------------------------------------------------------------   BDYLYR3A.618    
CL 0. Verify grid/subset definitions.  Arakawa 'B' grid with P-rows at     BDYLYR3A.619    
CL    extremes is assumed.  Extreme-most P-rows are ignored; extreme-      BDYLYR3A.620    
CL    most UV-rows are used only for interpolation and are not updated.    BDYLYR3A.621    
C-----------------------------------------------------------------------   BDYLYR3A.622    
C                                                                          BDYLYR3A.623    
      IF ( BL_LEVELS.LT.1 .OR. ST_LEVELS.LT.1                              AJS1F401.1094   
     &.OR. P_ROWS.LT.3 ) THEN                                              AJS1F401.1095   
        ERROR = 1                                                          BDYLYR3A.625    
        GOTO999                                                            BDYLYR3A.626    
*IF -DEF,MPP                                                               APBGF401.2      
      ELSEIF ( U_FIELD .NE. (P_ROWS-1)*ROW_LENGTH ) THEN                   BDYLYR3A.627    
*ELSE                                                                      APBGF401.3      
      ELSEIF ( U_FIELD .NE. (P_ROWS)*ROW_LENGTH ) THEN                     APBGF401.4      
*ENDIF                                                                     APBGF401.5      
        ERROR = 2                                                          BDYLYR3A.628    
        GOTO999                                                            BDYLYR3A.629    
      ELSEIF ( P_FIELD .NE. P_ROWS*ROW_LENGTH ) THEN                       BDYLYR3A.630    
        ERROR = 3                                                          BDYLYR3A.631    
        GOTO999                                                            BDYLYR3A.632    
      ELSEIF ( FIRST_ROW.LE.1 .OR. FIRST_ROW.GE.P_ROWS ) THEN              BDYLYR3A.633    
        ERROR = 4                                                          BDYLYR3A.634    
        GOTO999                                                            BDYLYR3A.635    
      ELSEIF ( N_ROWS.LE.0 ) THEN                                          BDYLYR3A.636    
        ERROR = 5                                                          BDYLYR3A.637    
        GOTO999                                                            BDYLYR3A.638    
*IF -DEF,MPP                                                               APBGF401.6      
      ELSEIF ( (FIRST_ROW+N_ROWS) .GT. P_ROWS ) THEN                       BDYLYR3A.639    
*ELSE                                                                      APBGF401.7      
      ELSEIF ( (FIRST_ROW+N_ROWS-1) .GT. P_ROWS ) THEN                     APBGF401.8      
*ENDIF                                                                     APBGF401.9      
        ERROR = 6                                                          BDYLYR3A.640    
        GOTO999                                                            BDYLYR3A.641    
      ELSEIF ( LAND_FIELD.GT.P_FIELD ) THEN                                BDYLYR3A.642    
        ERROR = 7                                                          BDYLYR3A.643    
        GOTO999                                                            BDYLYR3A.644    
      ENDIF                                                                BDYLYR3A.645    
C                                                                          BDYLYR3A.646    
C-----------------------------------------------------------------------   BDYLYR3A.647    
CL    Set pointers, etc.                                                   BDYLYR3A.648    
C-----------------------------------------------------------------------   BDYLYR3A.649    
C                                                                          BDYLYR3A.650    
      N_P_ROWS=N_ROWS                                                      APBGF401.10     
      N_U_ROWS=N_ROWS+1                                                    APBGF401.11     
                                                                           APBGF401.12     
      P_POINTS=N_P_ROWS*ROW_LENGTH                                         APBGF401.13     
      U_POINTS=N_U_ROWS*ROW_LENGTH                                         APBGF401.14     
                                                                           APBGF401.15     
      P1=1+(FIRST_ROW-1)*ROW_LENGTH                                        APBGF401.16     
      U1=1+(FIRST_ROW-2)*ROW_LENGTH                                        APBGF401.17     
C                                                                          BDYLYR3A.658    
C-----------------------------------------------------------------------   BDYLYR3A.659    
CL    Set compressed land point pointers.                                  BDYLYR3A.660    
C-----------------------------------------------------------------------   BDYLYR3A.661    
C                                                                          BDYLYR3A.662    
      LAND1=0                                                              BDYLYR3A.663    
      DO 1 I=1,P1+P_POINTS-1                                               BDYLYR3A.664    
        IF (LAND_INDEX(I).GE.P1) THEN                                      BDYLYR3A.665    
          LAND1 = I                                                        BDYLYR3A.666    
          GOTO2                                                            BDYLYR3A.667    
        ENDIF                                                              BDYLYR3A.668    
   1  CONTINUE                                                             BDYLYR3A.669    
   2  CONTINUE                                                             BDYLYR3A.670    
      LAND_PTS=0                                                           BDYLYR3A.671    
      DO 3 I=P1,P1+P_POINTS-1                                              BDYLYR3A.672    
        IF (LAND_MASK(I)) LAND_PTS = LAND_PTS + 1                          BDYLYR3A.673    
   3  CONTINUE                                                             BDYLYR3A.674    
*ELSE                                                                      BDYLYR3A.675    
C                                                                          AJC1F405.522    
C---------------------------------------------------------------------     AJC1F405.523    
CL 0. Check grid definition arguments.                                     AJC1F405.524    
C---------------------------------------------------------------------     AJC1F405.525    
C                                                                          AJC1F405.526    
      IF ( BL_LEVELS.LT.1                                                  AJC1F405.527    
     & .OR. ST_LEVELS.LT.1 .OR.SM_LEVELS.LT.1 ) THEN                       AJC1F405.528    
        ERROR = 1                                                          AJC1F405.529    
        GOTO999                                                            AJC1F405.530    
      ELSEIF ( U_FIELD .NE. P_ROWS*ROW_LENGTH ) THEN                       AJC1F405.531    
        ERROR = 2                                                          AJC1F405.532    
        GOTO999                                                            AJC1F405.533    
      ELSEIF ( P_FIELD .NE. P_ROWS*ROW_LENGTH ) THEN                       AJC1F405.534    
        ERROR = 3                                                          AJC1F405.535    
        GOTO999                                                            AJC1F405.536    
      ELSEIF ( N_ROWS.LE.0 ) THEN                                          AJC1F405.537    
        ERROR = 5                                                          AJC1F405.538    
        GOTO999                                                            AJC1F405.539    
      ELSEIF ( LAND_FIELD.GT.P_FIELD ) THEN                                AJC1F405.540    
        ERROR = 7                                                          AJC1F405.541    
        GOTO999                                                            AJC1F405.542    
      ENDIF                                                                AJC1F405.543    
C                                                                          AJC1F405.544    
C---------------------------------------------------------------------     AJC1F405.545    
CL    Set pointers, etc.                                                   AJC1F405.546    
C---------------------------------------------------------------------     AJC1F405.547    
C                                                                          AJC1F405.548    
      N_P_ROWS=N_ROWS                                                      AJC1F405.549    
      N_U_ROWS=N_ROWS                                                      AJC1F405.550    
                                                                           AJC1F405.551    
      P_POINTS=N_P_ROWS*ROW_LENGTH                                         AJC1F405.552    
      U_POINTS=N_U_ROWS*ROW_LENGTH                                         AJC1F405.553    
                                                                           AJC1F405.554    
      P1 = 1                                                               AJC1F405.555    
      U1 = 1                                                               AJC1F405.556    
C                                                                          AJC1F405.557    
C---------------------------------------------------------------------     AJC1F405.558    
CL    Set compressed land point pointers.                                  AJC1F405.559    
C---------------------------------------------------------------------     AJC1F405.560    
C                                                                          AJC1F405.561    
      LAND1=0                                                              AJC1F405.562    
      DO 1 I=1,P1+P_POINTS-1                                               AJC1F405.563    
        IF (LAND_INDEX(I).GE.P1) THEN                                      AJC1F405.564    
          LAND1 = I                                                        AJC1F405.565    
          GOTO2                                                            AJC1F405.566    
        ENDIF                                                              AJC1F405.567    
   1  CONTINUE                                                             AJC1F405.568    
   2  CONTINUE                                                             AJC1F405.569    
      LAND_PTS=0                                                           AJC1F405.570    
      DO 3 I=P1,P1+P_POINTS-1                                              AJC1F405.571    
        IF (LAND_MASK(I)) LAND_PTS = LAND_PTS + 1                          AJC1F405.572    
   3  CONTINUE                                                             AJC1F405.573    
*ENDIF                                                                     BDYLYR3A.706    
C                                                                          BDYLYR3A.707    
C-----------------------------------------------------------------------   BDYLYR3A.708    
CL 1.  Perform calculations in what the documentation describes as         BDYLYR3A.709    
CL     subroutine Z_DZ.  In fact, a separate subroutine isn't used.        BDYLYR3A.710    
C-----------------------------------------------------------------------   BDYLYR3A.711    
C                                                                          BDYLYR3A.712    
CL 1.1 Initialise ZLB(,0) (to zero, of course, this being the height       BDYLYR3A.713    
CL     of the surface above the surface).                                  BDYLYR3A.714    
C                                                                          BDYLYR3A.715    
      DO 4 I=P1,P1+P_POINTS-1                                              BDYLYR3A.716    
        ZLB(I,0)=0.0                                                       BDYLYR3A.717    
    4 CONTINUE                                                             BDYLYR3A.718    
C                                                                          BDYLYR3A.719    
CL 1.2 Calculate layer depths and heights, and construct wind fields on    BDYLYR3A.720    
CL     P-grid.  This involves calling subroutines Z and UV_TO_P.           BDYLYR3A.721    
CL     Virtual temperature is also calculated, as a by-product.            BDYLYR3A.722    
C                                                                          BDYLYR3A.723    
C NB RDZ  TEMPORARILY used to return DELTA_Z_LOWER, the lower half layer   BDYLYR3A.724    
C    thickness                                                             BDYLYR3A.725    
C                                                                          BDYLYR3A.726    
      DO 5 K=1,BL_LEVELS                                                   BDYLYR3A.727    
        CALL Z(P_POINTS,EXNER(P1,K),EXNER(P1,K+1),PSTAR(P1),               BDYLYR3A.728    
     +    AKH(K),BKH(K),Q(P1,K),QCF(P1,K),                                 BDYLYR3A.729    
     +    QCL(P1,K),T(P1,K),ZLB(P1,K-1),TV_RDZUV(P1,K),                    BDYLYR3A.730    
     +    ZLB(P1,K),DZL(P1,K),RDZ(P1,K),LTIMER)                            BDYLYR3A.731    
*IF -DEF,SCMA                                                              AJC1F405.574    
        CALL UV_TO_P(U(U1,K),U_P(P1,K),                                    BDYLYR3A.733    
     +               U_POINTS,P_POINTS,ROW_LENGTH,N_U_ROWS)                BDYLYR3A.734    
        CALL UV_TO_P(V(U1,K),V_P(P1,K),                                    BDYLYR3A.735    
     +               U_POINTS,P_POINTS,ROW_LENGTH,N_U_ROWS)                BDYLYR3A.736    
*ELSE                                                                      BDYLYR3A.737    
      DO I = P1, P1-1+P_POINTS                                             AJC1F405.575    
        U_P(i,K) = U(i,K)                                                  AJC1F405.576    
        V_P(i,K) = V(i,K)                                                  AJC1F405.577    
      ENDDO                                                                AJC1F405.578    
*ENDIF                                                                     BDYLYR3A.740    
    5 CONTINUE                                                             BDYLYR3A.741    
      DO 61 K=BL_LEVELS,2,-1                                               BDYLYR3A.742    
        DO 62 I=P1,P1+P_POINTS-1                                           BDYLYR3A.743    
          RDZ(I,K)=1.0/(RDZ(I,K)+(DZL(I,K-1)-RDZ(I,K-1)))                  BDYLYR3A.744    
   62   CONTINUE                                                           BDYLYR3A.745    
   61 CONTINUE                                                             BDYLYR3A.746    
      DO 6 I=P1,P1+P_POINTS-1                                              BDYLYR3A.747    
        Z1(I)=RDZ(I,1)                                                     BDYLYR3A.748    
        RDZ(I,1)=1.0/RDZ(I,1)                                              BDYLYR3A.749    
    6 CONTINUE                                                             BDYLYR3A.750    
C                                                                          BDYLYR3A.751    
C-----------------------------------------------------------------------   BDYLYR3A.752    
CL 2.  Heat flux through sea-ice (P241, routine SICE_HTF).                 BDYLYR3A.753    
C-----------------------------------------------------------------------   BDYLYR3A.754    
C                                                                          BDYLYR3A.755    
      CALL SICE_HTF(                                                       BDYLYR3A.756    
     + DI(P1),ICE_FRACT(P1),LAND_MASK(P1),TSTAR(P1),P_POINTS,              BDYLYR3A.757    
     + SEA_ICE_HTF(P1),LTIMER                                              BDYLYR3A.758    
     +)                                                                    BDYLYR3A.759    
C                                                                          BDYLYR3A.760    
C-----------------------------------------------------------------------   BDYLYR3A.761    
CL 3.  Heat fluxes through soil (P242, routine SOIL_HTF).                  BDYLYR3A.762    
C-----------------------------------------------------------------------   BDYLYR3A.763    
C                                                                          BDYLYR3A.764    
      CALL SOIL_HTF(                                                       BDYLYR3A.765    
     + HCAP,HCON,LAYER_DEPTH,LYING_SNOW,TSTAR,LAND_MASK,TIMESTEP,          BDYLYR3A.766    
     + P_FIELD,LAND_FIELD,P_POINTS,P1,                                     BDYLYR3A.767    
     + LAND_PTS,LAND1,LAND_INDEX,                                          BDYLYR3A.769    
     + ST_LEVELS+1,T_DEEP_SOIL,ASOIL_1,SOIL_HT_FLUX                        AJS1F401.1097   
     +,LTIMER)                                                             BDYLYR3A.776    
C                                                                          BDYLYR3A.783    
C-----------------------------------------------------------------------   BDYLYR3A.784    
CL 4.  Surface turbulent exchange coefficients and "explicit" fluxes       BDYLYR3A.785    
CL     (P243a, routine SF_EXCH).                                           BDYLYR3A.786    
CL     Wind mixing "power" and some values required for other, later,      BDYLYR3A.787    
CL     diagnostic calculations, are also evaluated if requested.           BDYLYR3A.788    
C-----------------------------------------------------------------------   BDYLYR3A.789    
C                                                                          BDYLYR3A.790    
      CALL SF_EXCH (                                                       BDYLYR3A.791    
     + P_POINTS,LAND_PTS,U_POINTS,ROW_LENGTH,N_P_ROWS,N_U_ROWS,            BDYLYR3A.792    
     + LAND_INDEX(LAND1),P1,GATHER,                                        BDYLYR3A.794    
     + AK(1),BK(1),TIMESTEP,CANOPY(LAND1),CATCH(LAND1),CF(P1,1),           BDYLYR3A.796    
     + ICE_FRACT(P1),LAND_MASK(P1),PSTAR(P1),Q(P1,1),QCF(P1,1),            BDYLYR3A.797    
     + QCL(P1,1),RESIST(LAND1),ROOTD(LAND1),SMC(LAND1),                    BDYLYR3A.798    
     + SMVCCL(LAND1),SMVCWT(LAND1),LYING_SNOW(P1),T(P1,1),TSTAR(P1),       BDYLYR3A.799    
     + U(U1,1),V(U1,1),U_P(P1,1),V_P(P1,1),U_0(U1),V_0(U1),                BDYLYR3A.800    
     + Z0V(P1),SIL_OROG_LAND(LAND1),Z1(P1),Z0MSEA(P1),HO2R2_OROG(LAND1),   BDYLYR3A.801    
     & BQ_1(P1),BT_1(P1),BF_1(P1),CD(P1),CH(P1),                           ADM3F404.214    
     + EA(P1),ES(P1),ESL(P1),FQW(P1,1),FQW_LEAD(P1),FTL(P1,1),             BDYLYR3A.803    
     + FTL_LEAD(P1),TAUX(U1,1),TAUY(U1,1),QW(P1,1),RHOKE(P1),              BDYLYR3A.804    
     + RHOKEA(P1),RHOKES(P1),RHOKESL(P1),RHOKH(P1,1),RHOKM(U1,1),          BDYLYR3A.805    
     + RIB(P1),TL(P1,1),TSTAR_NL(P1),VSHR(P1),Z0H(P1),Z0M(P1),             BDYLYR3A.806    
     + Z0M_EFF(P1),H_BLEND(P1),T1_SD(P1),Q1_SD(P1),                        ARN1F400.5      
     & RHO_CD_MODV1(P1),CDR10M(U1),CHR1P5M(P1),CER1P5M(P1),FME(P1),        ASJ1F400.12     
     + SU10,SV10,SQ1P5,ST1P5,SFME,                                         BDYLYR3A.809    
     + NRML(P1),L_Z0_OROG,L_RMBL,L_BL_LSPICE,ERR,LTIMER                    ADM3F404.215    
*IF DEF,SCMA                                                               AJC0F405.74     
     &  ,FACTOR_RHOKH,OBS                                                  AJC0F405.75     
*ENDIF                                                                     AJC0F405.76     
     +)                                                                    BDYLYR3A.811    
      IF (ERR.GT.0) THEN                                                   BDYLYR3A.812    
        ERROR = ERR + 10                                                   BDYLYR3A.813    
        GOTO999                                                            BDYLYR3A.814    
      ENDIF                                                                BDYLYR3A.815    
C                                                                          BDYLYR3A.816    
C-----------------------------------------------------------------------   BDYLYR3A.817    
CL 5.  Turbulent exchange coefficients and "explicit" fluxes between       BDYLYR3A.818    
CL     model layers in the boundary layer (P243b, routine KMKH).           BDYLYR3A.819    
C-----------------------------------------------------------------------   BDYLYR3A.820    
C                                                                          BDYLYR3A.821    
      CALL KMKH (                                                          BDYLYR3A.822    
     + P_FIELD,U_FIELD,P1,U1,                                              BDYLYR3A.823    
     + P_POINTS,U_POINTS,ROW_LENGTH,N_P_ROWS,N_U_ROWS,BL_LEVELS,           BDYLYR3A.824    
     + TIMESTEP,AK,BK,AKH,BKH,DELTA_AK,DELTA_BK,CCA,BQ_1,BT_1,BF_1,        ADM3F404.216    
     & CF,DZL,                                                             ADM3F404.217    
     + PSTAR,Q,QCF,QCL,RDZ,T,TV_RDZUV,                                     BDYLYR3A.826    
     + U,U_P,V,V_P,Z0M_EFF,ZLB(1,0),H_BLEND,                               BDYLYR3A.827    
     + FQW,FTL,TAUX,TAUY,QW,                                               BDYLYR3A.828    
     + RHOKM,RHOKH,TL,ZH,TV_RDZUV(1,2),RHO_KM(1,2),                        ASJ1F400.13     
     + CCB,CCT,L_MOM,L_MIXLEN,                                             ARN1F403.38     
     & L_BL_LSPICE,                                                        ADM3F404.218    
     + NRML,ERR,LTIMER                                                     BDYLYR3A.831    
     +)                                                                    BDYLYR3A.832    
      IF (ERR.GT.0) THEN                                                   BDYLYR3A.833    
        ERROR = ERR + 20                                                   BDYLYR3A.834    
        GOTO999                                                            BDYLYR3A.835    
      ENDIF                                                                BDYLYR3A.836    
C                                                                          BDYLYR3A.837    
C-----------------------------------------------------------------------   BDYLYR3A.838    
CL 6.  "Implicit" calculation of increments for TSTAR and atmospheric      BDYLYR3A.839    
CL     boundary layer variables (P244, routine IMPL_CAL).                  BDYLYR3A.840    
CL     10-metre wind components are also diagnosed if requested.           BDYLYR3A.841    
C-----------------------------------------------------------------------   BDYLYR3A.842    
C                                                                          BDYLYR3A.843    
      CALL IMPL_CAL(                                                       BDYLYR3A.844    
     + P_FIELD,U_FIELD,P1,U1,                                              BDYLYR3A.845    
     + P_POINTS,U_POINTS,BL_LEVELS,ROW_LENGTH,N_P_ROWS,N_U_ROWS,           BDYLYR3A.846    
     + CDR10M,U_0,V_0,SU10,SV10,                                           BDYLYR3A.847    
     + ASOIL_1,DELTA_AK,DELTA_BK,FQW_LEAD,FTL_LEAD,                        BDYLYR3A.848    
     + RHOKE,RHOKEA,RHOKES,RHOKESL,                                        BDYLYR3A.849    
     + RHOKH(1,2),RHOKM(1,2),                                              BDYLYR3A.850    
     + ICE_FRACT,LAND_MASK,LYING_SNOW,PSTAR,RADNET,                        BDYLYR3A.851    
     + SEA_ICE_HTF,SOIL_HT_FLUX,TIMESTEP,TSTAR_NL,                         BDYLYR3A.852    
     + EA,ES,ESL,FQW,FTL,QW,RHOKH(1,1),RHOKM(1,1),TSTAR,TL,                BDYLYR3A.853    
     + U,V,DQW_1,DQW_RML,DTRDZ,DTRDZ_RML,DTSTAR,                           BDYLYR3A.854    
     + E_SEA,H_SEA,TAUX,TAUY,                                              BDYLYR3A.855    
     + U10M,V10M,                                                          BDYLYR3A.856    
     + NRML,ERR,LTIMER                                                     BDYLYR3A.857    
     +)                                                                    BDYLYR3A.858    
      IF (ERR.GT.0) THEN                                                   BDYLYR3A.859    
        ERROR = ERR + 30                                                   BDYLYR3A.860    
        GOTO999                                                            BDYLYR3A.861    
      ENDIF                                                                BDYLYR3A.862    
C                                                                          BDYLYR3A.863    
CL 6.1 Convert FTL to sensible heat flux in Watts per square metre.        BDYLYR3A.864    
C                                                                          BDYLYR3A.865    
      DO 7 K=1,BL_LEVELS                                                   BDYLYR3A.866    
Cfpp$ Select(CONCUR)                                                       BDYLYR3A.867    
        DO 71 I=P1,P1+P_POINTS-1                                           BDYLYR3A.868    
          FTL(I,K) = FTL(I,K)*CP                                           BDYLYR3A.869    
   71   CONTINUE                                                           BDYLYR3A.870    
    7 CONTINUE                                                             BDYLYR3A.871    
C                                                                          BDYLYR3A.872    
C-----------------------------------------------------------------------   BDYLYR3A.873    
CL 7.  Surface evaporation components and updating of surface              BDYLYR3A.874    
CL     temperature (P245, routine SF_EVAP).                                BDYLYR3A.875    
CL     The following diagnostics are also calculated, as requested :-      BDYLYR3A.876    
CL     Heat flux due to melting of sea-ice; specific humidity at 1.5       BDYLYR3A.877    
CL     metres; temperature at 1.5 metres.                                  BDYLYR3A.878    
C-----------------------------------------------------------------------   BDYLYR3A.879    
C                                                                          BDYLYR3A.880    
      CALL SF_EVAP (                                                       BDYLYR3A.881    
     + P_FIELD,P1,LAND_FIELD,LAND1,                                        BDYLYR3A.882    
     + P_POINTS,BL_LEVELS,LAND_MASK,LAND_PTS,LAND_INDEX,                   BDYLYR3A.886    
     + ASOIL_1,CANOPY,CATCH,DTRDZ,DTRDZ_RML,                               BDYLYR3A.888    
     + EA,ESL,SOIL_HT_FLUX,E_SEA,                                          BDYLYR3A.889    
     + ICE_FRACT,LYING_SNOW,RADNET,SMC,TIMESTEP,                           BDYLYR3A.890    
     + CER1P5M,CHR1P5M,PSTAR,Z1,Z0M_EFF,Z0H,                               BDYLYR3A.891    
     + SQ1P5,ST1P5,SMLT,                                                   BDYLYR3A.892    
     + NRML,                                                               BDYLYR3A.893    
     + RHOKH,DQW_1,DQW_RML,DTSTAR,FTL,FQW,ES,QW,TL,TSTAR,                  BDYLYR3A.894    
     + ECAN,EI                                                             BDYLYR3A.895    
     +,SICE_MLT_HTF,Q1P5M,T1P5M,LTIMER                                     BDYLYR3A.896    
     +)                                                                    BDYLYR3A.897    
C                                                                          BDYLYR3A.898    
CL 7.1 Copy T and Q from workspace to INOUT space.                         BDYLYR3A.899    
C                                                                          BDYLYR3A.900    
      DO K=1,BL_LEVELS                                                     BDYLYR3A.901    
Cfpp$  Select(CONCUR)                                                      BDYLYR3A.902    
        DO I=P1,P1+P_POINTS-1                                              BDYLYR3A.903    
          T(I,K)=TL(I,K)                                                   BDYLYR3A.904    
          Q(I,K)=QW(I,K)                                                   BDYLYR3A.905    
        ENDDO                                                              BDYLYR3A.906    
      ENDDO                                                                BDYLYR3A.907    
C                                                                          BDYLYR3A.908    
C-----------------------------------------------------------------------   BDYLYR3A.909    
CL 8.  Calculate surface latent heat flux diagnostic.                      BDYLYR3A.910    
C-----------------------------------------------------------------------   BDYLYR3A.911    
C                                                                          BDYLYR3A.912    
      IF (SLH) THEN                                                        BDYLYR3A.913    
        DO 9 I=P1,P1+P_POINTS-1                                            BDYLYR3A.914    
          LATENT_HEAT(I) = LC*FQW(I,1) + LF*EI(I)                          BDYLYR3A.915    
    9   CONTINUE                                                           BDYLYR3A.916    
      ENDIF                                                                BDYLYR3A.917    
  999  CONTINUE  ! Branch for error exit.                                  BDYLYR3A.918    
                                                                           BDYLYR3A.919    
      IF (LTIMER) THEN                                                     BDYLYR3A.920    
        CALL TIMER('BDYLAYR ',4)                                           BDYLYR3A.921    
      ENDIF                                                                BDYLYR3A.922    
                                                                           BDYLYR3A.923    
      RETURN                                                               BDYLYR3A.924    
      END                                                                  BDYLYR3A.925    
*ENDIF                                                                     BDYLYR3A.926