*IF DEF,A03_6A                                                             BTQINT6A.2      
C *****************************COPYRIGHT******************************     BTQINT6A.3      
C (c) CROWN COPYRIGHT 1997, METEOROLOGICAL OFFICE, All Rights Reserved.    BTQINT6A.4      
C                                                                          BTQINT6A.5      
C Use, duplication or disclosure of this code is subject to the            BTQINT6A.6      
C restrictions as set forth in the contract.                               BTQINT6A.7      
C                                                                          BTQINT6A.8      
C                Meteorological Office                                     BTQINT6A.9      
C                London Road                                               BTQINT6A.10     
C                BRACKNELL                                                 BTQINT6A.11     
C                Berkshire UK                                              BTQINT6A.12     
C                RG12 2SZ                                                  BTQINT6A.13     
C                                                                          BTQINT6A.14     
C If no contract has been raised with this copy of the code, the use,      BTQINT6A.15     
C duplication or disclosure of it is strictly prohibited.  Permission      BTQINT6A.16     
C to do so must first be obtained in writing from the Head of Numerical    BTQINT6A.17     
C Modelling at the above address.                                          BTQINT6A.18     
C ******************************COPYRIGHT******************************    BTQINT6A.19     
! SUBROUTINE BTQ_INT                                                       BTQINT6A.20     
!!!  Purpose: To interpolate buoyancy parameters BT and BQ from full       BTQINT6A.21     
!!!  levels to half levels                                                 BTQINT6A.22     
!!!                                                                        BTQINT6A.23     
!!! ORIGINAL PROGRAMMER: J. James                                          BTQINT6A.24     
!!! CURRENT CODE OWNER:  R.N.B. Smith                                      BTQINT6A.25     
!!!                                                                        BTQINT6A.26     
!!! HISTORY:                                                               BTQINT6A.27     
!!! DATE   VERSION   COMMENT                                               BTQINT6A.28     
!!! ----   -------   -------                                               BTQINT6A.29     
!!!                                                                        BTQINT6A.30     
!!! 10/9/97  4.4     New Deck.  R.N.B.Smith                                BTQINT6A.31     
!!!                                                                        BTQINT6A.32     
!!! CODE DESCRIPTION:                                                      BTQINT6A.33     
!!!   LANGUAGE: FORTRAN 77 + CRAY EXTENSIONS                               BTQINT6A.34     
!!!   THIS CODE IS WRITTEN TO UMDP3 PROGRAMMING STANDARDS.                 BTQINT6A.35     
!!!                                                                        BTQINT6A.36     
!!! SYSTEM COMPONENT COVERED: P24                                          BTQINT6A.37     
!!!---------------------------------------------------------------------   BTQINT6A.38     

      SUBROUTINE BTQ_INT (                                                  2,4BTQINT6A.39     
     & P_FIELD,P1,P_POINTS,BL_LEVELS                                       BTQINT6A.40     
     &,DZL,RDZ,BQ,BT,BQ_CLD,BT_CLD,A_QS,A_DQSDT                            BTQINT6A.41     
     &,BQM,BTM,BQM_CLD,BTM_CLD,A_QSM,A_DQSDTM                              BTQINT6A.42     
     &,LTIMER                                                              BTQINT6A.43     
     &  )                                                                  BTQINT6A.44     
                                                                           BTQINT6A.45     
      IMPLICIT NONE                                                        BTQINT6A.46     
                                                                           BTQINT6A.47     
! ARGUMENTS WITH INTENT IN. IE: INPUT VARIABLES.                           BTQINT6A.48     
                                                                           BTQINT6A.49     
      LOGICAL LTIMER          ! IN Flag for TIMER diagnostics              BTQINT6A.50     
                                                                           BTQINT6A.51     
      INTEGER                                                              BTQINT6A.52     
     & P_FIELD                ! IN No. of P-grid points in whole field.    BTQINT6A.53     
     &,P1                     ! IN First P-grid point to be processed.     BTQINT6A.54     
     &,P_POINTS               ! IN No. of P-grid points to be processed.   BTQINT6A.55     
     &,BL_LEVELS              ! IN No. of atmospheric levels for which     BTQINT6A.56     
!                                boundary layer fluxes are calculated.     BTQINT6A.57     
!                                Assumed ! <=30 for dimensioning GAMMA()   BTQINT6A.58     
!                                in common deck C_GAMMA                    BTQINT6A.59     
      REAL                                                                 BTQINT6A.60     
     & DZL(P_FIELD,BL_LEVELS) ! IN Layer depths (m).  DZL(,K) is the       BTQINT6A.61     
!                                  distance from layer boundary K-1/2      BTQINT6A.62     
!                                  to layer boundary K+1/2.  For K=1       BTQINT6A.63     
!                                  the lower boundary is the surface.      BTQINT6A.64     
     &,RDZ(P_FIELD,BL_LEVELS) ! IN Reciprocal of distance between          BTQINT6A.65     
!                                  hybrid levels (m-1).  1/RDZ(,K) is      BTQINT6A.66     
!                                  the vertical distance from level        BTQINT6A.67     
!                                  K-1 to level K, except that for         BTQINT6A.68     
!                                  K=1 it is just the height of the        BTQINT6A.69     
!                                  lowest atmospheric level.               BTQINT6A.70     
     &,BQ(P_FIELD,BL_LEVELS)  ! IN A buoyancy parameter for clear air      BTQINT6A.71     
!                             !    on p,T,q-levels (full levels).          BTQINT6A.72     
     &,BT(P_FIELD,BL_LEVELS)  ! IN A buoyancy parameter for clear air      BTQINT6A.73     
!                             !    on p,T,q-levels (full levels).          BTQINT6A.74     
     &,BQ_CLD(P_FIELD,BL_LEVELS)                                           BTQINT6A.75     
!                             ! IN A buoyancy parameter for cloudy air     BTQINT6A.76     
!                             !    on p,T,q-levels (full levels).          BTQINT6A.77     
     &,BT_CLD(P_FIELD,BL_LEVELS)                                           BTQINT6A.78     
!                             ! IN A buoyancy parameter for cloudy air     BTQINT6A.79     
!                             !    on p,T,q-levels (full levels).          BTQINT6A.80     
     &,A_QS(P_FIELD,BL_LEVELS)                                             BTQINT6A.81     
!                             ! IN Saturated lapse rate factor             BTQINT6A.82     
!                             !    on p,T,q-levels (full levels).          BTQINT6A.83     
     &,A_DQSDT(P_FIELD,BL_LEVELS)                                          BTQINT6A.84     
!                             ! IN Saturated lapse rate factor             BTQINT6A.85     
!                             !    on p,T,q-levels (full levels).          BTQINT6A.86     
                                                                           BTQINT6A.87     
      REAL  ! OUT arrays,                                                  BTQINT6A.88     
     & BQM(P_FIELD,BL_LEVELS) ! OUT A buoyancy parameter for clear air     BTQINT6A.89     
!                             !    on intermediate levels (half levels):   BTQINT6A.90     
!                             !    (*,K) elements are k+1/2 values.        BTQINT6A.91     
     &,BTM(P_FIELD,BL_LEVELS) ! OUT A buoyancy parameter for clear air     BTQINT6A.92     
!                             !    on intermediate levels (half levels):   BTQINT6A.93     
!                             !    (*,K) elements are k+1/2 values.        BTQINT6A.94     
     &,BQM_CLD(P_FIELD,BL_LEVELS)                                          BTQINT6A.95     
!                             ! OUT A buoyancy parameter for cloudy air    BTQINT6A.96     
!                             !    on intermediate levels (half levels):   BTQINT6A.97     
!                             !    (*,K) elements are k+1/2 values.        BTQINT6A.98     
     &,BTM_CLD(P_FIELD,BL_LEVELS)                                          BTQINT6A.99     
!                             ! OUT A buoyancy parameter for cloudy air    BTQINT6A.100    
!                             !    on intermediate levels (half levels):   BTQINT6A.101    
!                             !    (*,K) elements are k+1/2 values.        BTQINT6A.102    
     &,A_QSM(P_FIELD,BL_LEVELS)                                            BTQINT6A.103    
!                             ! OUT Saturated lapse rate factor            BTQINT6A.104    
!                             !    on intermediate levels (half levels):   BTQINT6A.105    
!                             !    (*,K) elements are k+1/2 values.        BTQINT6A.106    
     &,A_DQSDTM(P_FIELD,BL_LEVELS)                                         BTQINT6A.107    
!                             ! OUT Saturated lapse rate factor            BTQINT6A.108    
!                             !    on intermediate levels (half levels):   BTQINT6A.109    
!                             !    (*,K) elements are k+1/2 values.        BTQINT6A.110    
                                                                           BTQINT6A.111    
                                                                           BTQINT6A.112    
!-----------------------------------------------------------------------   BTQINT6A.113    
!    External references :-                                                BTQINT6A.114    
      EXTERNAL TIMER                                                       BTQINT6A.115    
                                                                           BTQINT6A.116    
!-----------------------------------------------------------------------   BTQINT6A.117    
!    Local and other symbolic constants :-                                 BTQINT6A.118    
                                                                           BTQINT6A.119    
!  Define local storage.                                                   BTQINT6A.120    
                                                                           BTQINT6A.121    
!  (b) Scalars.                                                            BTQINT6A.122    
                                                                           BTQINT6A.123    
      REAL                                                                 BTQINT6A.124    
     & WK      ! Temporary in weighting factor.                            BTQINT6A.125    
     &,WKM1    ! Temporary in weighting factor.                            BTQINT6A.126    
                                                                           BTQINT6A.127    
      INTEGER                                                              BTQINT6A.128    
     & I       ! Loop counter (horizontal field index).                    BTQINT6A.129    
     &,K       ! Loop counter (vertical level index).                      BTQINT6A.130    
                                                                           BTQINT6A.131    
      IF (LTIMER) THEN                                                     BTQINT6A.132    
        CALL TIMER('BTQ_INT ',3)                                           BTQINT6A.133    
      ENDIF                                                                BTQINT6A.134    
!-----------------------------------------------------------------------   BTQINT6A.135    
!! 1.  Loop round levels.                                                  BTQINT6A.136    
!-----------------------------------------------------------------------   BTQINT6A.137    
                                                                           BTQINT6A.138    
      DO K=2,BL_LEVELS                                                     BTQINT6A.139    
        DO I=P1,P1+P_POINTS-1                                              BTQINT6A.140    
                                                                           BTQINT6A.141    
!-----------------------------------------------------------------------   BTQINT6A.142    
!! 1.1 Calculate buoyancy parameters at half levels,                       BTQINT6A.143    
!!     i.e. at level K-1/2, if current level is level K.                   BTQINT6A.144    
!-----------------------------------------------------------------------   BTQINT6A.145    
                                                                           BTQINT6A.146    
          WKM1 = 0.5 * DZL(I,K-1) * RDZ(I,K)         ! P243.C5 (2nd eqn)   BTQINT6A.147    
          WK = 0.5 * DZL(I,K) * RDZ(I,K)             ! P243.C5 (1st eqn)   BTQINT6A.148    
                                                                           BTQINT6A.149    
          BTM(I,K-1) = WKM1*BT(I,K) + WK*BT(I,K-1)                         BTQINT6A.150    
          BQM(I,K-1) = WKM1*BQ(I,K) + WK*BQ(I,K-1)                         BTQINT6A.151    
          BTM_CLD(I,K-1) = WKM1*BT_CLD(I,K) + WK*BT_CLD(I,K-1)             BTQINT6A.152    
          BQM_CLD(I,K-1) = WKM1*BQ_CLD(I,K) + WK*BQ_CLD(I,K-1)             BTQINT6A.153    
          A_QSM(I,K-1) = WKM1*A_QS(I,K) + WK*A_QS(I,K-1)                   BTQINT6A.154    
          A_DQSDTM(I,K-1) = WKM1*A_DQSDT(I,K) + WK*A_DQSDT(I,K-1)          BTQINT6A.155    
                                                                           BTQINT6A.156    
        ENDDO ! p_points                                                   BTQINT6A.157    
      ENDDO ! bl_levels                                                    BTQINT6A.158    
                                                                           BTQINT6A.159    
      IF (LTIMER) THEN                                                     BTQINT6A.160    
        CALL TIMER('BTQ_INT ',4)                                           BTQINT6A.161    
      ENDIF                                                                BTQINT6A.162    
                                                                           BTQINT6A.163    
      RETURN                                                               BTQINT6A.164    
      END                                                                  BTQINT6A.165    
*ENDIF                                                                     BTQINT6A.166