MODULE CloudFraction_UKME
  IMPLICIT NONE
  ! Selecting Kinds
  INTEGER, PARAMETER :: r4 = SELECTED_REAL_KIND(6)  ! Kind for 32-bits Real Numbers
  INTEGER, PARAMETER :: i4 = SELECTED_INT_KIND(9)   ! Kind for 32-bits Integer Numbers
  INTEGER, PARAMETER :: r8 = SELECTED_REAL_KIND(15) ! Kind for 64-bits Real Numbers
  INTEGER, PARAMETER :: i8 = SELECTED_INT_KIND(14)  ! Kind for 64-bits Integer Numbers
  INTEGER, PARAMETER :: r16 = SELECTED_REAL_KIND(31)! Kind for 128-bits Real Numbers

  !ftn -g  -fbounds-check -Waliasing -Wall -fbacktrace -ffpe-trap=invalid,overflow,zero  -finit-real=nan -finit-integer=nan -fconvert=big-endian  -ffree-line-length-none  -O0 -Warray-bounds  -ffast-math -funroll-loops -ftree-vectorizer-verbose=2 

  !
  !
  !  qt_bal_cld_____ls_arcld______ls_cld
  !                            |
  !                            |__qsat_wat_mix
  !                            |
  !                            |__qsat_wat_mix
  !                            |
  !                            |__qsat_wat_mix
  !                            |
  !                            |__ls_cld
  !                            |
  !                            |__ls_cld
  !                            |
  !                            |__LS_ACF_Brooks
  !
  !
  !*----------------------------------------------------------------------
  !*L------------------COMDECK C_O_DG_C-----------------------------------
  ! ZERODEGC IS CONVERSION BETWEEN DEGREES CELSIUS AND KELVIN
  ! TFS IS TEMPERATURE AT WHICH SEA WATER FREEZES
  ! TM IS TEMPERATURE AT WHICH FRESH WATER FREEZES AND ICE MELTS

  REAL(KIND=r8), PARAMETER :: ZeroDegC = 273.15_r8
  REAL(KIND=r8), PARAMETER :: TFS      = 271.35_r8
  REAL(KIND=r8), PARAMETER :: TM       = 273.15_r8
  REAL(r8),PARAMETER :: SHR_CONST_CPDAIR = 1.00464e3_r8    ! specific heat of dry air ~ J/kg/K
  REAL(R8),PARAMETER :: SHR_CONST_CPWV   = 1.810e3_R8      ! specific heat of water vap ~ J/kg/K
  REAL(R8),PARAMETER :: SHR_CONST_G      = 9.80616_R8      ! acceleration of gravity ~ m/s^2
  REAL(R8),PARAMETER :: SHR_CONST_MWDAIR = 28.966_R8       ! molecular weight dry air ~ kg/kmole  
  REAL(r8),PARAMETER :: SHR_CONST_MWWV   = 18.016_r8       ! molecular weight water vapor
  REAL(R8),PARAMETER :: SHR_CONST_BOLTZ  = 1.38065e-23_R8  ! Boltzmann's constant ~ J/K/molecule
  REAL(R8),PARAMETER :: SHR_CONST_AVOGAD = 6.02214e26_R8   ! Avogadro's number ~ molecules/kmole  
  REAL(R8),PARAMETER :: SHR_CONST_RGAS   = SHR_CONST_AVOGAD*SHR_CONST_BOLTZ ! Universal gas constant ~ J/K/kmole
  REAL(R8),PARAMETER :: SHR_CONST_RDAIR  = SHR_CONST_RGAS/SHR_CONST_MWDAIR  ! Dry air gas constant ~ J/K/kg

  REAL(r8),PARAMETER :: SHR_CONST_RWV    = SHR_CONST_RGAS/SHR_CONST_MWWV    ! Water vapor gas constant ~ J/K/kg

  REAL(r8),PARAMETER :: SHR_CONST_Pi                 = 3.14159265358979323846_r8

  REAL(r8),PARAMETER :: rair   = SHR_CONST_RDAIR    ! Gas constant for dry air (J/K/kg)
  REAL(r8),PARAMETER :: gravit = SHR_CONST_G      ! gravitational acceleration
  REAL(r8),PARAMETER :: zvir   = SHR_CONST_RWV/SHR_CONST_RDAIR - 1          ! rh2o/rair - 1

  REAL(KIND=r8), PARAMETER  :: Earth_Radius = 6371229.0_r8

  REAL(KIND=r8), PARAMETER :: Epsilonk  = 0.62198_r8

  REAL(KIND=r8), PARAMETER :: Epsilon   = 0.62198_r8
  !ftn -g  -fbounds-check -Waliasing -Wall -fbacktrace -ffpe-trap=invalid,overflow,zero  -finit-real=nan -finit-integer=nan -fconvert=big-endian  -ffree-line-length-none  -O0 -Warray-bounds  -ffast-math -funroll-loops -ftree-vectorizer-verbose=2 
  REAL(KIND=r8), PARAMETER :: one_minus_epsilon = 1.0_r8 -epsilonk
  !      One minus the ratio of the molecular weights of water and dry
  !      air

  REAL(KIND=r8), PARAMETER :: T_low  = 183.15_r8 ! Lowest temperature for which look_up table of
  ! saturation water vapour presssure is valid (K)
  REAL(KIND=r8), PARAMETER :: T_high = 338.15_r8 ! Highest temperature for which look_up table of
  ! saturation water vapour presssure is valid (K)
  REAL(KIND=r8), PARAMETER :: delta_T = 0.1_r8    ! temperature increment of the look-up table
  ! of saturation vapour pressures.

  INTEGER, PARAMETER :: N = INT(((T_high - T_low + (delta_T*0.5_r8))/delta_T) + 1.0_r8)
  !      Gives  N=1551, size of the look-up table of saturation water
  !      vapour pressure.

  INTEGER :: IESW     ! loop counter for data statement look-up table

  REAL(KIND=r8) :: ESW2(0:N+1)
  !                         TABLE OF SATURATION WATER VAPOUR PRESSURE (PA)
  !                       - SET BY DATA STATEMENT CALCULATED FROM THE
  !                         GOFF-GRATCH FORMULAE AS TAKEN FROM LANDOLT-
  !                         BORNSTEIN, 1987 NUMERICAL DATA AND FUNCTIONAL
  !                         RELATIONSHIPS IN SCIENCE AND TECHNOLOGY.
  !                         GROUP V/ VOL 4B METEOROLOGY. PHYSICAL AND
  !                         CHEMICAL PROPERTIES OF AIR, P35
  ! Large scale cloud:

  LOGICAL :: L_eacf                ! Use empirically adjusted
  ! cloud fraction

  INTEGER :: cloud_fraction_method ! Selects total cloud fraction
  ! calculation method
  INTEGER :: ice_fraction_method   ! Selects ice cloud fraction
  ! calculation method

  REAL(KIND=r8)    :: overlap_ice_liquid    ! Generic overlap parameter
  ! between ice and liquid phases
  REAL(KIND=r8)    :: ctt_weight            ! Cloud top temperature weight
  REAL(KIND=r8)    :: t_weight              ! Local temperature weight
  REAL(KIND=r8)    :: qsat_fixed            ! Prescribed qsat value
  REAL(KIND=r8)    :: sub_cld               ! Scaling factor
  !  REAL(KIND=r8)    :: dbsdtbs_turb_0        ! PC2 erosion rate / s-1

  !      NAMELIST/RUN_Cloud/L_eacf,cloud_fraction_method,                  &
  !     &  overlap_ice_liquid,ice_fraction_method,ctt_weight,t_weight,     &
  !     &  qsat_fixed,sub_cld,dbsdtbs_turb_0
  INTEGER :: iMax

 ! REAL(KIND=r8), PARAMETER :: RHCRIT0(1:38) = (/&
 !      0.950_r8,0.925_r8,0.900_r8,0.900_r8,0.900_r8,0.900_r8,0.850_r8,0.850_r8,0.850_r8,0.800_r8, &
 !      0.800_r8,0.800_r8,0.800_r8,0.800_r8,0.800_r8,0.800_r8,0.800_r8,0.800_r8,0.800_r8,0.800_r8, &
 !      0.800_r8,0.800_r8,0.800_r8,0.800_r8,0.800_r8,0.800_r8,0.800_r8,0.800_r8,0.800_r8,0.800_r8, &
 !      0.800_r8,0.800_r8,0.800_r8,0.800_r8,0.800_r8,0.800_r8,0.800_r8,0.800_r8/)
!
 REAL(KIND=r8), PARAMETER :: RHCRIT0(1:38) = (/&
       0.990_r8,0.955_r8,0.940_r8,0.940_r8,0.940_r8,0.940_r8,0.920_r8,0.920_r8,0.920_r8,0.900_r8, &
       0.900_r8,0.900_r8,0.900_r8,0.900_r8,0.900_r8,0.900_r8,0.900_r8,0.900_r8,0.900_r8,0.900_r8, &
       0.900_r8,0.900_r8,0.900_r8,0.900_r8,0.900_r8,0.900_r8,0.900_r8,0.900_r8,0.900_r8,0.900_r8, &
       0.900_r8,0.900_r8,0.900_r8,0.900_r8,0.900_r8,0.900_r8,0.900_r8,0.900_r8/)


  PUBLIC :: Init_CloudFraction_UKME
  PUBLIC :: Run_CloudFraction_UKME

CONTAINS

  SUBROUTINE Init_CloudFraction_UKME(iMax_in)
    IMPLICIT NONE
    INTEGER , INTENT(IN   )  ::  iMax_in
    iMax=iMax_in
    CALL qsat_wat_data()

  END SUBROUTINE Init_CloudFraction_UKME

  INTEGER FUNCTION idx(xMax,yMax,x)
    IMPLICIT NONE
    INTEGER, INTENT(IN   ) :: xMax
    INTEGER, INTENT(IN   ) :: yMax
    INTEGER, INTENT(IN   ) :: x
    REAL(KIND=r8) :: tag_alfa,a

    tag_alfa=REAL(yMax - 1 )/ REAL(xMax - 1)
    ! x=1 ; y=1
    a=1.0_r8 - tag_alfa
    idx = INT(a + tag_alfa*x)
  END FUNCTION idx

  SUBROUTINE Run_CloudFraction_UKME(nCols,LEVELS,si,sl,pblh,colrad,topo,ps,kuo,T3,q ,qcl ,qcf ,qcf2,CF ,CFL,CFF)
    INTEGER      , INTENT(IN   ) :: nCols
    INTEGER      , INTENT(IN   ) :: LEVELS
    REAL(KIND=r8), INTENT(IN   ) :: si      (LEVELS+1)   !
    REAL(KIND=r8), INTENT(IN   ) :: sl      (LEVELS)   !
    REAL(KIND=r8), INTENT(IN   ) :: pblh    (1:nCols)   !
    REAL(KIND=r8), INTENT(IN   ) :: colrad  (1:nCols)   !
    REAL(KIND=r8), INTENT(IN   ) :: topo    (1:nCols)   !
    REAL(KIND=r8), INTENT(IN   ) :: ps      (1:nCols)   ! pressure at all points, on theta levels (Pa).
    INTEGER      , INTENT(IN   ) :: kuo     (1:nCols) 
    REAL(KIND=r8), INTENT(INOUT) :: T3      (1:nCols,LEVELS)
    REAL(KIND=r8), INTENT(INOUT) :: q       (1:nCols,LEVELS)
    REAL(KIND=r8), INTENT(INOUT) :: qcl     (1:nCols,LEVELS)
    REAL(KIND=r8), INTENT(IN   ) :: qcf     (1:nCols,LEVELS)
    REAL(KIND=r8), INTENT(IN   ) :: qcf2    (1:nCols,LEVELS)
    REAL(KIND=r8), INTENT(OUT  ) :: CF      (nCols,LEVELS) !Cloud fraction at processed levels (decimal fraction).
    REAL(KIND=r8), INTENT(OUT  ) :: CFL     (nCols,LEVELS) !Liquid cloud fraction at processed levels (decimal fraction).
    REAL(KIND=r8), INTENT(OUT  ) :: CFF     (nCols,LEVELS) !Frozen cloud fraction at processed levels (decimal fraction).

    INTEGER       :: ntml          (nCols)       
    LOGICAL       :: cumulus       (nCols)           ! bl convection flag
    REAL(KIND=r8) :: p_theta_levels(nCols,levels)    ! pressure at all points (Pa).
    REAL(KIND=r8) :: p             (nCols,LEVELS+1)  ! pressure at all points, on u,v levels (Pa).
    REAL(KIND=r8) :: rhcrit        (nCols,LEVELS)    ! Critical relative humidity.  See the the paragraph incorporating
                      ! eqs P292.11 to P292.14; the values need to be tuned for a given
    ! set of levels.
    INTEGER       :: bl_levels                       ! No. of boundary layer levels
    REAL(KIND=r8) :: delta_lambda
    REAL(KIND=r8) :: delta_phi
    REAL(KIND=r8) :: FV_cos_theta_latitude(nCols)     ! Finite volume cos(lat)
    LOGICAL       :: L_CLD_AREA    ! true if using area cloud fraction (ACF)
    LOGICAL       :: L_ACF_Cusack  ! ... and selected Cusack and PC2 off
    LOGICAL       :: L_ACF_Brooks  ! ... and selected Brooks
    LOGICAL       :: L_eacf        ! true if using empirically adjusted cloud fraction
    LOGICAL       :: L_conv4a      ! true if using 4A convection scheme
    LOGICAL       :: L_mcr_qcf2    ! true if second cloud ice variable in use
    LOGICAL       :: l_mixing_ratio! true if using mixing ratio formulation

    REAL(KIND=r8) :: area_cloud_fraction  (1:nCols, LEVELS)
    REAL(KIND=r8) :: bulk_cloud_fraction  (1:nCols,LEVELS)
    REAL(KIND=r8) :: cloud_fraction_liquid(1:nCols, LEVELS)
    REAL(KIND=r8) :: cloud_fraction_frozen(1:nCols, LEVELS)
    REAL(KIND=r8) :: r_theta_levels     (1:nCols,0:LEVELS) ! height of theta level above earth's centre (m)
    REAL(KIND=r8) :: zi   (1:nCols,1:LEVELS+1)! Height above surface at interfaces 
    REAL(KIND=r8) :: zm   (1:nCols,1:LEVELS)  ! Geopotential height at mid level

    REAL(KIND=r8) :: flip_pint  (nCols,LEVELS+1)   ! Interface pressures  
    REAL(KIND=r8) :: flip_pmid  (nCols,LEVELS)     ! Midpoint pressures 
    REAL(KIND=r8) :: flip_t     (nCols,LEVELS)     ! temperature
    REAL(KIND=r8) :: flip_q     (nCols,LEVELS)     ! specific humidity
    REAL(KIND=r8) :: flip_pdel  (nCols,LEVELS)     ! layer thickness
    REAL(KIND=r8) :: flip_rpdel (nCols,LEVELS)     ! inverse of layer thickness
    REAL(KIND=r8) :: flip_lnpmid(nCols,LEVELS)     ! Log Midpoint pressures    
    REAL(KIND=r8) :: flip_lnpint(nCols,LEVELS+1)   ! Log interface pressures
    REAL(KIND=r8) :: flip_zi   (1:nCols,1:LEVELS+1)! Height above surface at interfaces 
    REAL(KIND=r8) :: flip_zm   (1:nCols,1:LEVELS)  ! Geopotential height at mid level
    INTEGER :: kflip
    INTEGER :: i
    INTEGER :: k

    !*----------------------------------------------------------------------
    ! C_LHEAT start

    ! latent heat of condensation of water at 0degc
    REAL(KIND=r8),PARAMETER:: LC=2.501E6_r8

    ! latent heat of fusion at 0degc
    REAL(KIND=r8),PARAMETER:: LF=0.334E6_r8
    ! CP IS SPECIFIC HEAT OF DRY AIR AT CONSTANT PRESSURE
    REAL(KIND=r8), PARAMETER  :: CP     = 1005.0_r8



    DO i=1,nCols
       flip_pint       (i,LEVELS+1) = ps(i)*si(1) ! gps --> Pa
    END DO
    DO k=LEVELS,1,-1
       kflip=LEVELS+2-k
       DO i=1,nCols
          flip_pint    (i,k)      = MAX(si(kflip)*ps(i) ,1.0e-12_r8)
       END DO
    END DO
    DO k=1,LEVELS
       kflip=LEVELS+1-k
       DO i=1,nCols
          flip_t   (i,kflip) =  T3 (i,k)
          flip_q   (i,kflip) =  Q (i,k)
          flip_pmid(i,kflip) =  sl(  k)*ps (i)
       END DO
    END DO
    DO k=1,LEVELS
       DO i=1,nCols    
          flip_pdel    (i,k) = MAX(flip_pint(i,k+1) - flip_pint(i,k),1.0e-12_r8)
          flip_rpdel   (i,k) = 1.0_r8/MAX((flip_pint(i,k+1) - flip_pint(i,k)),1.0e-12_r8)
          flip_lnpmid  (i,k) = LOG(flip_pmid(i,k))
       END DO
    END DO
    DO k=1,LEVELS+1
       DO i=1,nCols
          flip_lnpint(i,k) =  LOG(flip_pint  (i,k))
       END DO
    END DO
    !
    !..delsig     k=2  ****gu,gv,gt,gq,gyu,gyv,gtd,gqd,sl*** } delsig(2)
    !             k=3/2----si,ric,rf,km,kh,b,l -----------
    !             k=1  ****gu,gv,gt,gq,gyu,gyv,gtd,gqd,sl*** } delsig(1)
    !             k=1/2----si ----------------------------

    ! Derive new temperature and geopotential fields

    CALL geopotential_t(                                 &
         flip_lnpint(1:nCols,1:LEVELS+1)   , flip_pint  (1:nCols,1:LEVELS+1) , &
         flip_pmid  (1:nCols,1:LEVELS)     , flip_pdel  (1:nCols,1:LEVELS)   , flip_rpdel(1:nCols,1:LEVELS)   , &
         flip_t     (1:nCols,1:LEVELS)     , flip_q     (1:nCols,1:LEVELS)   , rair   , gravit , zvir   ,&
         flip_zi    (1:nCols,1:LEVELS+1)   , flip_zm    (1:nCols,1:LEVELS)   , nCols   ,nCols, LEVELS)

    DO i=1,nCols
       zi(i,1) = flip_zi      (i,LEVELS+1)
       p (i,1) = flip_pint    (i,LEVELS+1)

    END DO
    DO k=1,LEVELS
       kflip=LEVELS+1-k
       DO i=1,nCols
          zi (i,k+1) = flip_zi    (i,kflip)
          zm (i,k  ) = flip_zm    (i,kflip)
          p  (i,k+1) = flip_pint  (i,kflip)
          p_theta_levels(i,k) = flip_pmid(i,kflip)
       END DO
    END DO
    DO i=1,nCols
       R_THETA_LEVELS(i,0)      = Earth_Radius + MAX(topo(i),0.0_r8) + zi(i,1)
    END DO
    DO k=1,LEVELS
       DO i=1,nCols
          R_THETA_LEVELS(i,k)   = (Earth_Radius + MAX(topo(i),0.0_r8)) + zi(i,k+1)
       END DO
    END DO

    DO k=1,LEVELS
       DO i=1,nCols
          RHCRIT       (i,k)=RHCRIT0(idx(LEVELS,38,k))
       END DO
    END DO
    ntml=1
    DO k=1,LEVELS
       DO i=1,nCols
          IF(zm(i,k) <= pblh(i))THEN
             ntml(i)=k
          END IF
       END DO
    END DO

    bl_levels=LEVELS
    !cloud_fraction_method  =  1!  Use minimum overlap condition
    cloud_fraction_method  =  2! Calculate possible overlaps between ice and liquid in THIS layer
    ! =\ 1 and 2 No total cloud fraction method defined
    !ice_fraction_method    =  1
    ice_fraction_method    =  2! Use cloud top temperature and a fixed qsat to give QCFRBS
    ! No ice cloud fraction method defined
    overlap_ice_liquid     =  0.5! Generic overlap parameter between ice and liquid phases
    !IF (ICE_FRACTION_METHOD  ==  2) THEN
    CTT_WEIGHT  =0.20_r8 ! Cloud top temperature weight
    T_WEIGHT    =0.60_r8 ! Local temperature weight
    qsat_fixed  =0.062198_r8     ! Prescribed qsat value Saturation mixing ratio or saturation specific humidity at temperature(kg/kg).
    sub_cld     =0.06_r8     ! Scaling factor
    !SUBGRID = SUB_CLD ** (1.0_r8-T_WEIGHT)/ QSAT_FIXED ** (1.0_r8-T_WEIGHT-CTT_WEIGHT) ice_fraction_method eq 2
    !          CALL qsat_wat_mix(QSL_CTT,CTT,p_theta_levels(1,1,k),          &
    !                        nCols*rows,l_mixing_ratio)
    DO i = 1, nCols
       ! colrad.....colatitude  colrad=0 - 3.14 (0-180)from np to sp in radians
       !IF((((colrad(i)*180.0_r8)/3.1415926e0_r8)-90.0_r8)  > 0.0_r8 ) THEN
       FV_cos_theta_latitude(i)   = COS(((colrad(i)))-(3.1415926e0_r8/2.0_r8))
       IF(kuo(i) > 0) cumulus(i)=.TRUE.
    ENDDO
    !180-----pi
    !  x     y
    !  y = x*pi/180
    delta_lambda=(360.0_r8/iMax)*(3.1415926e0_r8/180.0_r8)
    delta_phi   =(360.0_r8/iMax)*(3.1415926e0_r8/180.0_r8)


    L_CLD_AREA    = .TRUE.! true if using area cloud fraction (ACF)
    L_ACF_Cusack  = .TRUE.! ... and selected Cusack and PC2 off
    L_ACF_Brooks  = .TRUE.! ... and selected Brooks
    L_eacf        = .TRUE.! true if using empirically adjusted cloud fraction
    L_conv4a      = .FALSE.! true if using 4A convection scheme
    L_mcr_qcf2    = .FALSE.     !, INTENT(IN   )IN Use second prognostic ice if T
    L_mixing_ratio= .TRUE.     !, INTENT(IN   )IN Use mixing ratios removed by deposition depending on

    CALL qt_bal_cld ( &
         ps                    , &!Real   ,INTENT(IN   ) :: p_star        (1:nCols)
         p_theta_levels        , &!Real   ,INTENT(IN   ) :: p_theta_levels(1:nCols,LEVELS)
         p                     , &!Real   ,INTENT(IN   ) :: p             (1:nCols,LEVELS+1)
         T3                    , &!Real   ,INTENT(INOUT) :: T3            (1:nCols,LEVELS)
         q                     , &!Real   ,INTENT(INOUT) :: q             (1:nCols,LEVELS)
         qcl                   , &!Real   ,INTENT(INOUT) :: qcl           (1:nCols,LEVELS)
         qcf                   , &!Real   ,INTENT(IN   ) :: qcf           (1:nCols,LEVELS)
         qcf2                  , &!Real   ,INTENT(IN   ) :: qcf2          (1:nCols,LEVELS)
         rhcrit                , &!Real   ,INTENT(IN   ) :: rhcpt         (1:nCols,LEVELS)
         nCols                 , &!Integer,INTENT(IN   ) :: nCols
         bl_levels             , &!Integer,INTENT(IN   ) :: bl_levels
         cloud_fraction_method , &!Integer,Intent(IN   ) :: cloud_fraction_method  ! Method for calculating total cloud fract
         overlap_ice_liquid    , &!Real   ,Intent(IN   ) :: overlap_ice_liquid   ! Overlap between ice and liquid phases
         ice_fraction_method   , &!Integer,Intent(IN   ) :: ice_fraction_method        ! Method for calculating ice cloud frac.
         ctt_weight            , &!Real   ,Intent(IN   ) :: ctt_weight              ! Weighting of cloud top temperature
         t_weight              , &!Real   ,Intent(IN   ) :: t_weight              ! Weighting of local temperature
         qsat_fixed            , &!Real   ,Intent(IN   ) :: qsat_fixed              ! Fixed value of saturation humidity
         sub_cld               , &!Real   ,Intent(IN   ) :: sub_cld              ! Scaling parameter
         LEVELS                , &!Integer,INTENT(IN   ) :: LEVELS                    ! number of model levels where moisture
         delta_lambda          , &!Real   ,INTENT(IN   ) :: delta_lambda
         delta_phi             , &!Real   ,INTENT(IN   ) :: delta_phi
         r_theta_levels        , &!Real   ,INTENT(IN   ) :: r_theta_levels(1:nCols,0:LEVELS)
         FV_cos_theta_latitude , &!Real   ,INTENT(IN   ) :: FV_cos_theta_latitude (1:nCols)
         lc                    , &!Real   ,INTENT(IN   ) :: lc
         cp                    , &!Real   ,INTENT(IN   ) :: cp
         L_cld_area            , &!LOGICAL,INTENT(IN   ) :: L_CLD_AREA        ! true if using area cloud fraction (ACF)
         L_ACF_Cusack          , &!LOGICAL,INTENT(IN   ) :: L_ACF_Cusack  ! ... and selected Cusack and PC2 off
         L_ACF_Brooks          , &!LOGICAL,INTENT(IN   ) :: L_ACF_Brooks  ! ... and selected Brooks
         L_eacf                , &!LOGICAL,INTENT(IN   ) :: L_eacf        ! true if using empirically adjusted cloud fraction
         L_mcr_qcf2            , &!LOGICAL,INTENT(IN   ) :: L_mcr_qcf2        ! true if second cloud ice variable in use
         l_mixing_ratio        , &!LOGICAL,INTENT(IN   ) :: l_mixing_ratio! true if using mixing ratio formulation
         ntml                  , &!Integer,Intent(IN   ) :: ntml (nCols)
         cumulus               , &!Logical,Intent(IN   ) :: cumulus (nCols) ! bl convection flag
         L_conv4a              , &!LOGICAL,INTENT(IN   ) :: L_conv4a        ! true if using 4A convection scheme
         area_cloud_fraction   , &!Real   ,INTENT(OUT  ) :: area_cloud_fraction  (1:nCols, LEVELS)
         bulk_cloud_fraction   , &!Real   ,INTENT(OUT  ) :: bulk_cloud_fraction  (1:nCols, LEVELS)
         cloud_fraction_liquid , &!Real   ,INTENT(OUT  ) :: cloud_fraction_liquid(1:nCols, LEVELS)
         cloud_fraction_frozen   )!Real   ,INTENT(OUT  ) :: cloud_fraction_frozen(1:nCols, LEVELS)
    DO k=1,LEVELS
       DO i=1,nCols
          CF (i,k)= bulk_cloud_fraction  (i, k)! Cloud fraction at processed levels (decimal fraction).
          CFL(i,k)= cloud_fraction_liquid(i, k)! Liquid cloud fraction at processed levels (decimal fraction).
          CFF(i,k)= cloud_fraction_frozen(i, k)! Frozen cloud fraction at processed levels (decimal fraction).
       END DO
    END DO

  END SUBROUTINE Run_CloudFraction_UKME

  ! *****************************COPYRIGHT*******************************
  ! (C) Crown copyright Met Office. All rights reserved.
  ! For further details please refer to the file COPYRIGHT.txt
  ! which you should have received as part of this distribution.
  ! *****************************COPYRIGHT*******************************
  ! Subroutine qt_bal_cld
  SUBROUTINE qt_bal_cld (&!
       p_star                , &!Real  , INTENT(IN   ) ::  p_star        (1:nCols)
       p_theta_levels        , &!Real  , INTENT(IN   ) ::  p_theta_levels(1:nCols,LEVELS)
       p                     , &!Real  , INTENT(IN   ) ::  p             (1:nCols,LEVELS+1)
       T3                    , &!Real  , INTENT(INOUT) ::  T3            (1:nCols,LEVELS)
       q                     , &!Real  , INTENT(INOUT) ::  q             (1:nCols,LEVELS)
       qcl                   , &!Real  , INTENT(INOUT) ::  qcl           (1:nCols,LEVELS)
       qcf                   , &!Real  , INTENT(IN   ) ::  qcf           (1:nCols,LEVELS)
       qcf2                  , &!Real  , INTENT(IN   ) ::  qcf2          (1:nCols,LEVELS)
       rhcpt                 , &!Real  , INTENT(IN   ) ::  rhcpt         (1:nCols,LEVELS)
       nCols                 , &!Integer, INTENT(IN   ) ::  nCols
       bl_levels             , &!Integer, INTENT(IN   ) ::  bl_levels
       cloud_fraction_method , &!Integer, Intent(IN  ) ::   cloud_fraction_method  ! Method for calculating total cloud fraction
       overlap_ice_liquid    , &!Real    , Intent(IN ) :: overlap_ice_liquid   ! Overlap between ice and liquid phases
       ice_fraction_method   , &!Integer, Intent(IN  ) :: ice_fraction_method    ! Method for calculating ice cloud frac.
       ctt_weight            , &!Real    , Intent(IN ) ::  ctt_weight          ! Weighting of cloud top temperature
       t_weight              , &!Real    , Intent(IN ) ::  t_weight            ! Weighting of local temperature
       qsat_fixed            , &!Real    , Intent(IN ) ::  qsat_fixed          ! Fixed value of saturation humidity
       sub_cld               , &!Real    , Intent(IN ) ::  sub_cld             ! Scaling parameter
       LEVELS                , &!Integer, INTENT(IN   ) ::  LEVELS                   ! number of model levels where moisture
       delta_lambda          , &!Real  , INTENT(IN   ) ::  delta_lambda
       delta_phi             , &!Real  , INTENT(IN   ) ::  delta_phi
       r_theta_levels        , &!Real  , INTENT(IN   ) ::  r_theta_levels(1:nCols,0:LEVELS)
       FV_cos_theta_latitude , &!Real  , INTENT(IN   ) ::  FV_cos_theta_latitude (1:nCols)
       lc                    , &!Real , INTENT(IN   ) ::  lc
       cp                    , &!Real , INTENT(IN   ) ::  cp
       L_cld_area            , &!LOGICAL, INTENT(IN   ) :: L_CLD_AREA    ! true if using area cloud fraction (ACF)
       L_ACF_Cusack          , &!LOGICAL, INTENT(IN   ) :: L_ACF_Cusack  ! ... and selected Cusack and PC2 off
       L_ACF_Brooks          , &!LOGICAL, INTENT(IN   ) :: L_ACF_Brooks  ! ... and selected Brooks
       L_eacf                , &!LOGICAL, INTENT(IN   ) :: L_eacf        ! true if using empirically adjusted cloud fraction
       L_mcr_qcf2            , &!LOGICAL, INTENT(IN   ) :: L_mcr_qcf2    ! true if second cloud ice variable in use
       l_mixing_ratio        , &!LOGICAL, INTENT(IN   ) :: l_mixing_ratio! true if using mixing ratio formulation
       ntml                  , &!Integer     , Intent(IN) ::  ntml (nCols)
       cumulus               , &!Logical      , Intent(IN) :: cumulus (nCols) ! bl convection flag
       L_conv4a              , &!LOGICAL, INTENT(IN   ) :: L_conv4a      ! true if using 4A convection scheme
       area_cloud_fraction   , &!Real   , INTENT(OUT) ::   area_cloud_fraction  (1:nCols, LEVELS)
       bulk_cloud_fraction   , &!Real   , INTENT(OUT) ::   bulk_cloud_fraction  (1:nCols,LEVELS)
       cloud_fraction_liquid , &!Real   , INTENT(OUT) ::   cloud_fraction_liquid(1:nCols, LEVELS)
       cloud_fraction_frozen   )!Real   , INTENT(OUT) ::   cloud_fraction_frozen(1:nCols, LEVELS)

    ! Purpose:
    !        reset q, t and the cloud fields to be consistent at the
    !        end of the timestep
    !
    ! Method:
    !          Is described in ;
    !
    ! Original Progammer: Andy Malcolm
    ! Current code owner: Andy Malcolm
    !
    ! History:
    ! Version   Date       Comment
    ! -------  -------     -------
    !  5.4     28/08/02    New Deck                   Andy Malcolm
    !  5.5     03/02/03    Add qcf2 to qcf if active.      Richard Forbes
    !  5.5     20/02/03    Inserted missing #endif    P.Dando
    !  6.2     07/11/05   Pass cloud variables from UMUI. D. Wilson
    !  6.4     08/11/06    Include Brooks Area Cloud Fraction D. Wilson
    !  6.4     10/01/07    Add logical control for mixing ratios. D. Wilson
    !
    ! Code Description:
    !   Language: FORTRAN 77 + CRAY extensions
    !   This code is written to UMDP3 programming standards.
    !

    IMPLICIT NONE

    INTEGER, INTENT(IN   ) ::  LEVELS                   ! number of model levels where moisture
    ! variables are held
    INTEGER, INTENT(IN   ) ::  nCols
    INTEGER, INTENT(IN   ) ::  bl_levels
    ! physical constants
    REAL(KIND=r8) , INTENT(IN   ) ::  lc
    REAL(KIND=r8) , INTENT(IN   ) ::  cp

    LOGICAL, INTENT(IN   ) :: L_CLD_AREA    ! true if using area cloud fraction (ACF)
    LOGICAL, INTENT(IN   ) :: L_ACF_Cusack  ! ... and selected Cusack and PC2 off
    LOGICAL, INTENT(IN   ) :: L_ACF_Brooks  ! ... and selected Brooks
    LOGICAL, INTENT(IN   ) :: L_eacf        ! true if using empirically adjusted cloud fraction
    LOGICAL, INTENT(IN   ) :: L_conv4a      ! true if using 4A convection scheme
    LOGICAL, INTENT(IN   ) :: L_mcr_qcf2    ! true if second cloud ice variable in use
    LOGICAL, INTENT(IN   ) :: l_mixing_ratio! true if using mixing ratio formulation

    REAL(KIND=r8)  , INTENT(IN   ) ::  p             (1:nCols,LEVELS+1)
    REAL(KIND=r8)  , INTENT(IN   ) ::  p_theta_levels(1:nCols,LEVELS)
    REAL(KIND=r8)  , INTENT(IN   ) ::  p_star        (1:nCols)
    REAL(KIND=r8)  , INTENT(INOUT) ::  T3            (1:nCols,LEVELS)
    REAL(KIND=r8)  , INTENT(INOUT) ::  q             (1:nCols,LEVELS)
    REAL(KIND=r8)  , INTENT(INOUT) ::  qcl           (1:nCols,LEVELS)
    REAL(KIND=r8)  , INTENT(IN   ) ::  qcf           (1:nCols,LEVELS)
    REAL(KIND=r8)  , INTENT(IN   ) ::  qcf2          (1:nCols,LEVELS)
    REAL(KIND=r8)  , INTENT(IN   ) ::  rhcpt         (1:nCols,LEVELS)
    ! coordinate arrays
    REAL(KIND=r8)  , INTENT(IN   ) ::  r_theta_levels(1:nCols,0:LEVELS)
    REAL(KIND=r8)  , INTENT(IN   ) ::  delta_lambda
    REAL(KIND=r8)  , INTENT(IN   ) ::  delta_phi
    ! trig arrays
    REAL(KIND=r8)  , INTENT(IN   ) ::  FV_cos_theta_latitude (1:nCols)
    !
    INTEGER, INTENT(IN  ) :: cloud_fraction_method  ! Method for calculating total cloud fraction
    INTEGER, INTENT(IN  ) :: ice_fraction_method    ! Method for calculating ice cloud frac.

    REAL(KIND=r8)    , INTENT(IN ) :: overlap_ice_liquid   ! Overlap between ice and liquid phases
    REAL(KIND=r8)    , INTENT(IN ) :: ctt_weight          ! Weighting of cloud top temperature
    REAL(KIND=r8)    , INTENT(IN ) :: t_weight            ! Weighting of local temperature
    REAL(KIND=r8)    , INTENT(IN ) :: qsat_fixed          ! Fixed value of saturation humidity
    REAL(KIND=r8)    , INTENT(IN ) :: sub_cld             ! Scaling parameter

    ! Diagnostic variables

    REAL(KIND=r8)   , INTENT(OUT) :: area_cloud_fraction  (1:nCols, LEVELS)
    REAL(KIND=r8)   , INTENT(OUT) :: bulk_cloud_fraction  (1:nCols, LEVELS)!CF (nCols,LEVELS) Cloud fraction at processed levels (decimal fraction).
    REAL(KIND=r8)   , INTENT(OUT) :: cloud_fraction_liquid(1:nCols, LEVELS)!CFL(nCols,LEVELS) Liquid cloud fraction at processed levels (decimal fraction).
    REAL(KIND=r8)   , INTENT(OUT) :: cloud_fraction_frozen(1:nCols, LEVELS)!CFF(nCols,LEVELS) Frozen cloud fraction at processed levels (decimal fraction).

    INTEGER     , INTENT(IN) ::  ntml (nCols)

    LOGICAL      , INTENT(IN) :: cumulus (nCols) ! bl convection flag

    ! Local variables
    REAL(KIND=r8) ::  p_layer_centres(nCols, 0:LEVELS) 
    ! pressure at layer centres. Same as p_theta_levels
    !except bottom level = p_star, and at top = 0.
    REAL(KIND=r8) ::  p_layer_boundaries(nCols, 0:LEVELS) 
    REAL(KIND=r8) ::  tl       (nCols, LEVELS) 
    REAL(KIND=r8) ::  qt       (nCols, LEVELS) 
    REAL(KIND=r8) ::  qcf_in   (nCols, LEVELS) 
    REAL(KIND=r8) ::  qcl_out  (nCols, LEVELS)
    REAL(KIND=r8) ::  cf_inout (nCols, LEVELS)
    REAL(KIND=r8) ::  cfl_inout(nCols, LEVELS)
    REAL(KIND=r8) ::  cff_inout(nCols, LEVELS)


    INTEGER ::  large_levels
    INTEGER ::  levels_per_level

    INTEGER :: i,k,errorstatus     ! loop variables

    DO i = 1, nCols
       p_layer_centres(i,0)    = p_star(i)
       p_layer_boundaries(i,0) = p_star(i)
    END DO

    DO k = 1, LEVELS-1
       DO i = 1, nCols
          p_layer_centres   (i,k) = p_theta_levels(i,k)
          p_layer_boundaries(i,k) = p(i,k+1)
       END DO
    END DO
    k=LEVELS
    DO i = 1, nCols
       p_layer_centres(i,k) = p_theta_levels(i,k)
       p_layer_boundaries(i,k) = 0.0_r8
    END DO

    ! ----------------------------------------------------------------------
    ! Section  Convert qT and Tl for input to cloud scheme.
    ! ----------------------------------------------------------------------

    ! Create Tl and qT
    DO k = 1, LEVELS
       DO i = 1, nCols
          ! Tl(i,k)       = (theta(i,k) *exner_theta_levels(i,k)) - (lc * qcl(i,k)) / cp
          Tl(i,k)       = T3(i,k) - (lc * qcl(i,k)) / cp

          qt(i,k)       = q(i,k) + qcl(i,k)
          qcf_in(i,k)   = qcf(i,k)
          cf_inout(i,k) = bulk_cloud_fraction(i,k)
          cfl_inout(i,k)= cloud_fraction_liquid(i,k)
          cff_inout(i,k)= cloud_fraction_frozen(i,k)
       END DO
    END DO

    ! If second cloud ice variable in use then add to qcf
    ! for the cloud scheme call
    IF (L_mcr_qcf2) qcf_in(:,:) = qcf_in(:,:) + qcf2(1:nCols,:)

    ! ----------------------------------------------------------------------
    ! Section BL.4b Call cloud scheme to convert Tl and qT to T, q and qcl
    !              calculate bulk_cloud fields from qT and qcf
    !               and calculate area_cloud fields.
    ! ----------------------------------------------------------------------
    !

    ! Determine number of sublevels for vertical gradient area cloud
    ! Want an odd number of sublevels per level: 3 is hardwired in do loops
    levels_per_level = 3
    large_levels = ((LEVELS - 2)*levels_per_level) + 2
    !
    ! DEPENDS ON: ls_arcld
    CALL ls_arcld( &
                                !      Pressure related fields
         p_layer_centres       , &!REAL    , INTENT(IN) :: p_layer_centres(nCols,0:LEVELS)
         RHCPT                 , &!REAL    , INTENT(IN) :: rhcrit(nCols,LEVELS)
         p_layer_boundaries    , &!REAL    , INTENT(IN) :: p_layer_boundaries(nCols,0:LEVELS)
                                !      Array dimensions
         LEVELS                , &!INTEGER , INTENT(IN)  ::  LEVELS
         nCols                 , &!INTEGER , INTENT(IN)  ::  nCols
         bl_levels             , &!INTEGER , INTENT(IN)  ::  bl_levels
         cloud_fraction_method , &!Integer , Intent(IN) :: cloud_fraction_method ! Method for calculating total cloud fraction
         overlap_ice_liquid    , &!Real    , Intent(IN) :: overlap_ice_liquid ! Overlap between ice and liquid phases
         ice_fraction_method   , &!Integer , Intent(IN) :: ice_fraction_method      ! Method for calculating ice cloud frac.
         ctt_weight            , &!Real    , Intent(IN) :: ctt_weight          ! Weighting of cloud top temperature
         t_weight              , &!Real    , Intent(IN) :: t_weight          ! Weighting of local temperature
         qsat_fixed            , &!Real    , Intent(IN) :: qsat_fixed          ! Fixed value of saturation humidity
         sub_cld               , &!Real    , Intent(IN) :: sub_cld           ! Scaling parameter
         levels_per_level      , &!INTEGER , INTENT(IN)  ::  levels_per_level
         large_levels          , &!INTEGER , INTENT(IN)  ::  large_levels
                                !      Switch on area cloud calcuculation and select which to use
         L_cld_area            , &!LOGICAL , INTENT(IN) :: L_AREA_CLOUD
         L_ACF_Cusack          , &!LOGICAL , INTENT(IN) :: L_ACF_Cusack
         L_ACF_Brooks          , &!LOGICAL , INTENT(IN) :: L_ACF_Brooks
         L_eacf                , &!LOGICAL , INTENT(IN) :: L_eacf
                                !      Needed for LS_ACF_Brooks
         delta_lambda          , &!REAL    , INTENT(IN) ::  delta_lambda     ! EW (x) grid spacing in radians
         delta_phi             , &!REAL    , INTENT(IN) ::  delta_phi         ! NS (y) grid spacing in radians
         r_theta_levels        , &!REAL    , INTENT(IN) ::  r_theta_levels (1:nCols,0:LEVELS) ! height of theta levels (from centre of earth)
         FV_cos_theta_latitude , &!REAL    , INTENT(IN) ::  FV_cos_theta_latitude (1:nCols)
                                !      Convection diagnosis inforormation (only used for a05_4a)
         ntml                  , &!INTEGER , INTENT(IN)  ::  ntml(nCols)
         cumulus               , &!LOGICAL , INTENT(IN) :: cumulus(nCols)
         L_conv4a              , &!LOGICAL , INTENT(IN) :: L_conv4a 
         l_mixing_ratio        , &!LOGICAL , INTENT(IN) :: L_mixing_ratio
                                !      Prognostic Fields
         qcf_in                , &!REAL    , INTENT(IN) :: qcf_latest(nCols,LEVELS)
         Tl                    , &!REAL    , INTENT(INOUT) :: T_latest(nCols,LEVELS)
         qt                    , &!REAL    , INTENT(INOUT) :: q_latest(nCols,LEVELS)
         qcl_out               , &!REAL  , INTENT(OUT)  ::  qcl_latest(nCols,LEVELS)
                                !      Various cloud fractions
         area_cloud_fraction   , &!REAL  , INTENT(OUT)  ::  area_cloud_fraction(nCols,LEVELS)
         cf_inout              , &!REAL  , INTENT(OUT)  ::  bulk_cloud_fraction(nCols,LEVELS)
         cfl_inout             , &!REAL  , INTENT(OUT)  ::  cloud_fraction_liquid(nCols,LEVELS)
         cff_inout             , &!REAL  , INTENT(OUT)  ::  cloud_fraction_frozen(nCols,LEVELS)
         errorstatus             )!INTEGER,INTENT(OUT)  ::  error_code

    ! qt holds q (no halos), tl holds t(no halos),
    ! qcl_out holds qcl(no halos)
    DO k = 1, LEVELS
       DO i = 1, nCols
          !theta(i,k)                 = tl(i,k)/exner_theta_levels(i,k)
          T3(i,k)                    = tl(i,k)
          q(i,k)                     = qt(i,k)
          qcl(i,k)                   = qcl_out(i,k)
          bulk_cloud_fraction(i,k)   = cf_inout(i,k)
          cloud_fraction_liquid(i,k) = cfl_inout(i,k)
          cloud_fraction_frozen(i,k) = cff_inout(i,k)
       END DO
    END DO

    RETURN
  END SUBROUTINE qt_bal_cld




  ! *****************************COPYRIGHT*******************************
  ! (C) Crown copyright Met Office. All rights reserved.
  ! For further details please refer to the file COPYRIGHT.txt
  ! which you should have received as part of this distribution.
  ! *****************************COPYRIGHT*******************************
  !
  !+ Large-scale Area (Vertical Gradient) Cloud Scheme.
  ! Subroutine Interface:
  SUBROUTINE LS_ARCLD(    &
                                !      Pressure related fields
       p_layer_centres       ,&!REAL    , INTENT(IN) :: p_layer_centres(nCols,0:LEVELS)
       rhcrit                ,&!REAL    , INTENT(IN) :: rhcrit(nCols,LEVELS)
       p_layer_boundaries    ,&!REAL    , INTENT(IN) :: p_layer_boundaries(nCols,0:LEVELS)
                                !      Array dimensions
       LEVELS                ,&!INTEGER , INTENT(IN)  ::  LEVELS
       nCols                 ,&!INTEGER , INTENT(IN)  ::  nCols
       bl_levels             ,&!INTEGER , INTENT(IN)  ::  bl_levels
       cloud_fraction_method ,&!Integer , Intent(IN) :: cloud_fraction_method ! Method for calculating total cloud fraction
       overlap_ice_liquid    ,&!Real    , Intent(IN) :: overlap_ice_liquid ! Overlap between ice and liquid phases
       ice_fraction_method   ,&!Integer , Intent(IN) :: ice_fraction_method    ! Method for calculating ice cloud frac.
       ctt_weight            ,&!Real    , Intent(IN) :: ctt_weight         ! Weighting of cloud top temperature
       t_weight              ,&!Real    , Intent(IN) :: t_weight           ! Weighting of local temperature
       qsat_fixed            ,&!Real    , Intent(IN) :: qsat_fixed         ! Fixed value of saturation humidity
       sub_cld               ,&!Real    , Intent(IN) :: sub_cld                ! Scaling parameter
       levels_per_level      ,&!INTEGER , INTENT(IN)  ::  levels_per_level
       large_levels          ,&!INTEGER , INTENT(IN)  ::  large_levels
                                !      Switch on area cloud calculation and select which to use
       L_AREA_CLOUD          ,&!LOGICAL , INTENT(IN) :: L_AREA_CLOUD
       L_ACF_Cusack          ,&!LOGICAL , INTENT(IN) :: L_ACF_Cusack
       L_ACF_Brooks          ,&!LOGICAL , INTENT(IN) :: L_ACF_Brooks
       L_eacf                ,&!LOGICAL , INTENT(IN) :: L_eacf
                                !      Needed for LS_ACF_Brooks
       delta_lambda          ,&!REAL    , INTENT(IN) ::  delta_lambda     ! EW (x) grid spacing in radians
       delta_phi             ,&!REAL    , INTENT(IN) ::  delta_phi        ! NS (y) grid spacing in radians
       r_theta_levels        ,&!REAL    , INTENT(IN) ::  r_theta_levels (1:nCols,0:LEVELS) ! height of theta levels (from centre of earth)
       FV_cos_theta_latitude ,&!REAL    , INTENT(IN) ::  FV_cos_theta_latitude (1:nCols)
                                !      Convection diagnosis information (only used for a05_4a)
       ntml                  ,&!INTEGER , INTENT(IN)  ::  ntml(nCols)
       cumulus               ,&!LOGICAL , INTENT(IN) :: cumulus(nCols)
       L_conv4a              ,&!LOGICAL , INTENT(IN) :: L_conv4a 
       L_mixing_ratio        ,&!LOGICAL , INTENT(IN) :: L_mixing_ratio
                                !      Prognostic Fields
       qcf_latest            ,&!REAL    , INTENT(IN) :: qcf_latest(nCols,LEVELS)
       T_latest              ,&!REAL    , INTENT(INOUT) :: T_latest(nCols,LEVELS)
       q_latest              ,&!REAL    , INTENT(INOUT) :: q_latest(nCols,LEVELS)
       qcl_latest            ,&!REAL  , INTENT(OUT)  ::  qcl_latest(nCols,LEVELS)
                                !      Various cloud fractions
       area_cloud_fraction   ,&!REAL  , INTENT(OUT)  ::  area_cloud_fraction(nCols,LEVELS)
       bulk_cloud_fraction   ,&!REAL  , INTENT(OUT)  ::  bulk_cloud_fraction(nCols,LEVELS)
       cloud_fraction_liquid ,&!REAL  , INTENT(OUT)  ::  cloud_fraction_liquid(nCols,LEVELS)
       cloud_fraction_frozen ,&!REAL  , INTENT(OUT)  ::  cloud_fraction_frozen(nCols,LEVELS)
       error_code             )!INTEGER,INTENT(OUT)  ::  error_code
    !
    IMPLICIT NONE
    !
    ! Purpose:
    !   This subroutine calculates liquid and ice cloud fractional cover
    !   for use with the enhanced precipitation microphysics scheme. It
    !   also returns area and bulk cloud fractions for use in radiation.
    !
    ! Method:
    !   Statistical cloud scheme separates input moisture into specific
    !   humidity and cloud liquid water. Temperature calculated from liquid
    !   water temperature. Cloud fractions calculated from statistical
    !   relation between cloud fraction and cloud liquid/ice water content.
    !   Area cloud fraction calculated by subdividing layers, calculating
    !   cloud on each sublayer and taking maximum (use mean for bulk cloud).
    !
    ! Current Owner of Code: A. C. Bushell
    !
    ! History:
    ! Version   Date     Comment
    !  4.5    14-05-98   Original Code (Stephen Cusack for HadAM4)
    !
    !  5.0    14-05-98   Rewritten for New Dynamics with simplified
    !                    interpolation.  AC Bushell
    !
    !  5.1    15-12-99   Change to allow 3D RHcrit specification. AC Bushell
    !
    !  5.2    01-11-00   Remove temporary test diagnostics.       AC Bushell
    !
    !
    !  5.4   10-09-02    If cumulus convection is diagnosed the large
    !                    scale cloud is not allowed in the levels around
    !                    cumulus cloud-base.           Gill Martin
    !  6.2   07-11-05    Pass cloud variables from UMUI.  D. Wilson
    !  6.4   08/11/06    Include Brooks Area Cloud Fraction D. Wilson
    !  6.4   07-08-06    Enable mixing ratios to be used.  D. Wilson
    ! Description of Code:
    !   FORTRAN 77  + common extensions also in Fortran90.
    !   This code is written to UMDP3 version 6 programming standards.
    !
    !   Documentation: UMDP No.29
    !
    !  Global Variables:----------------------------------------------------
    !*L------------------COMDECK C_R_CP-------------------------------------
    ! History:
    ! Version  Date      Comment.
    !  5.0  07/05/99  Add variable P_zero for consistency with
    !                 conversion to C-P 'C' dynamics grid. R. Rawlins
    !  5.1  07/03/00  Fixed/Free format conversion   P. Selwood

    ! R IS GAS CONSTANT FOR DRY AIR
    ! CP IS SPECIFIC HEAT OF DRY AIR AT CONSTANT PRESSURE
    ! PREF IS REFERENCE SURFACE PRESSURE

    REAL(KIND=r8), PARAMETER  :: R      = 287.05_r8
    REAL(KIND=r8), PARAMETER  :: CP     = 1005.0_r8
    REAL(KIND=r8), PARAMETER  :: Kappa  = R/CP
    REAL(KIND=r8), PARAMETER  :: Pref   = 100000.0_r8

    ! Reference surface pressure = PREF
    REAL(KIND=r8), PARAMETER  :: P_zero = Pref
    REAL(KIND=r8), PARAMETER  :: sclht  = 6.8E+03_r8  ! Scale Height H
    !*----------------------------------------------------------------------
    ! C_LHEAT start

    ! latent heat of condensation of water at 0degc
    REAL(KIND=r8),PARAMETER:: LC=2.501E6_r8

    ! latent heat of fusion at 0degc
    REAL(KIND=r8),PARAMETER:: LF=0.334E6_r8

    ! C_LHEAT end
    !
    !  Subroutine Arguments:------------------------------------------------
    !
    ! arguments with intent in. ie: input variables.
    !
    INTEGER , INTENT(IN)  ::  LEVELS
    !       No. of levels being processed by cloud scheme.
    INTEGER , INTENT(IN)  ::  bl_levels
    !       No. of boundary layer levels
    INTEGER , INTENT(IN)  ::  nCols
    !       Horizontal dimensions of rh_crit diagnostic.
    INTEGER , INTENT(IN)  ::  levels_per_level
    !       No. of sub-levels being processed by area cloud scheme.
    !       Want an odd number of sublevels per level.
    !       NB: levels_per_level = 3 is currently hardwired in the do loops
    INTEGER , INTENT(IN)  ::  large_levels! Total no. of sub-levels being processed by cloud scheme.
    !       Currently ((LEVELS - 2)*levels_per_level) + 2
    !
    INTEGER , INTENT(IN)  ::  ntml(nCols)!  Height of diagnosed BL top
    LOGICAL , INTENT(IN) :: L_AREA_CLOUD ! true if using area cloud fraction (ACF)
    LOGICAL , INTENT(IN) :: L_ACF_Cusack ! ... and selected Cusack and PC2 off
    LOGICAL , INTENT(IN) :: L_ACF_Brooks ! ... and selected Brooks
    LOGICAL , INTENT(IN) :: L_eacf       ! true if using empirically adjusted cloud fraction
    LOGICAL , INTENT(IN) :: L_mixing_ratio ! true if using mixing rations
    !
    LOGICAL , INTENT(IN) :: L_conv4a        ! true if using 4A convection scheme
    LOGICAL , INTENT(IN) :: cumulus(nCols)   ! Logical indicator of convection

    REAL(KIND=r8)    , INTENT(IN) :: qcf_latest(nCols,LEVELS)
    !       Cloud ice content at processed levels (kg water per kg air).
    REAL(KIND=r8)    , INTENT(IN) :: p_layer_centres(nCols,0:LEVELS)
    !       pressure at all points, on theta levels (Pa).
    REAL(KIND=r8)    , INTENT(IN) :: rhcrit(nCols,LEVELS)
    !       Critical relative humidity.  See the the paragraph incorporating
    !       eqs P292.11 to P292.14; the values need to be tuned for a given
    !       set of levels.
    REAL(KIND=r8)    , INTENT(IN) :: p_layer_boundaries(nCols,0:LEVELS)
    !       pressure at all points, on u,v levels (Pa).
    REAL(KIND=r8)    , INTENT(IN) ::  r_theta_levels (1:nCols,0:LEVELS) ! height of theta levels (from centre of earth)
    REAL(KIND=r8)    , INTENT(IN) ::  FV_cos_theta_latitude (1:nCols)
    ! Finite volume cos(lat)
    REAL(KIND=r8)    , INTENT(IN) ::  delta_lambda     ! EW (x) grid spacing in radians
    REAL(KIND=r8)    , INTENT(IN) ::  delta_phi        ! NS (y) grid spacing in radians

    !
    INTEGER , INTENT(IN) :: cloud_fraction_method ! Method for calculating total cloud fraction
    INTEGER , INTENT(IN) :: ice_fraction_method    ! Method for calculating ice cloud frac.

    REAL(KIND=r8)    , INTENT(IN) :: overlap_ice_liquid ! Overlap between ice and liquid phases
    REAL(KIND=r8)    , INTENT(IN) :: ctt_weight         ! Weighting of cloud top temperature
    REAL(KIND=r8)    , INTENT(IN) :: t_weight           ! Weighting of local temperature
    REAL(KIND=r8)    , INTENT(IN) :: qsat_fixed         ! Fixed value of saturation humidity
    REAL(KIND=r8)    , INTENT(IN) :: sub_cld                ! Scaling parameter
    !
    ! arguments with intent in/out. ie: input variables changed on output.
    !
    REAL(KIND=r8)    , INTENT(INOUT) :: q_latest(nCols,LEVELS)
    !       On input : Vapour + liquid water content (QW) (kg per kg air).
    !       On output: Specific humidity at processed levels
    !                   (kg water per kg air).
    REAL(KIND=r8)    , INTENT(INOUT) :: T_latest(nCols,LEVELS)
    !       On input : Liquid water temperature (TL) (K).
    !       On output: Temperature at processed levels (K).
    !
    ! arguments with intent out. ie: output variables.
    !
    !     Error Status:
    INTEGER,INTENT(OUT)  ::  error_code  !, 0 if OK; 1 if bad arguments.
    !
    REAL(KIND=r8)  , INTENT(OUT)  ::  qcl_latest(nCols,LEVELS)
    !       Cloud liquid content at processed levels (kg water per kg air).
    REAL(KIND=r8)  , INTENT(OUT)  ::  area_cloud_fraction(nCols,LEVELS)
    !       Area cloud fraction at processed levels (decimal fraction).
    REAL(KIND=r8)  , INTENT(OUT)  ::  bulk_cloud_fraction(nCols,LEVELS)
    !       Cloud fraction at processed levels (decimal fraction).
    REAL(KIND=r8)  , INTENT(OUT)  ::  cloud_fraction_liquid(nCols,LEVELS)
    !       Liquid cloud fraction at processed levels (decimal fraction).
    REAL(KIND=r8)  , INTENT(OUT)  ::  cloud_fraction_frozen(nCols,LEVELS)
    !       Frozen cloud fraction at processed levels (decimal fraction).
    !
    !  Local parameters and other physical constants------------------------
    REAL(KIND=r8),PARAMETER  :: LCRCP =LC/CP! Derived parameters. ! Lat ht of condensation/Cp.
    REAL(KIND=r8),PARAMETER  :: drat_thresh =3.0E-1_r8           ! Test for continuity of sub-levels
    REAL(KIND=r8),PARAMETER  :: tol_test    =1.0E-11_r8           ! Tolerance for non-zero humidities
    !
    !  Local scalars--------------------------------------------------------
    !
    !  (a) Scalars effectively expanded to workspace by the Cray (using
    !      vector registers).
    REAL(KIND=r8) ::  qt_norm_next
    ! Temporary space for qT_norm
    REAL(KIND=r8) ::   stretcher
    !
    REAL(KIND=r8) ::   inverse_level
    ! Set to (1._r8 / levels_per_level)
    REAL(KIND=r8) ::   delta_p        ! Layer pressure thickness * inverse_level
    !
    !  (b) Others.
    INTEGER i,k      ! Loop counters: k - vertical level index.
    !                                       i,j - horizontal field index.
    INTEGER k_index    ! Extra loop counter for large arrays.
    !
    !  Local dynamic arrays-------------------------------------------------
    !    11 blocks of real workspace are required.
    REAL(KIND=r8)  :: qsl(nCols)
    !        Saturated specific humidity for temp TL or T.
    REAL(KIND=r8) ::   qt_norm(nCols)
    !        Total water content normalized to qSAT_WAT.
    REAL(KIND=r8) ::   rhcrit_large(nCols,large_levels)
    !
    REAL(KIND=r8) ::   p_large(nCols,large_levels)
    !
    REAL(KIND=r8) ::   T_large(nCols,large_levels)
    !
    REAL(KIND=r8) ::   q_large(nCols,large_levels)
    !
    REAL(KIND=r8) ::   qcf_large(nCols,large_levels)
    !
    REAL(KIND=r8) ::   cloud_fraction_large(nCols,large_levels)
    !
    REAL(KIND=r8) ::   qcl_large(nCols,large_levels)
    !
    REAL(KIND=r8) ::   cloud_fraction_liquid_large(nCols,large_levels)
    !
    REAL(KIND=r8) ::   cloud_fraction_frozen_large(nCols,large_levels)
    !
    INTEGER :: ntml_large(nCols)

    LOGICAL :: linked(nCols,LEVELS)
    !       True for sub-layers that have similar supersaturation properties
    !
    !  External subroutine calls: ------------------------------------------
    !      EXTERNAL QSAT_WAT,LS_CLD,LS_ACF_BROOKS
    !- End of Header
    ! ----------------------------------------------------------------------
    !  Check input arguments for potential over-writing problems.
    ! ----------------------------------------------------------------------
    error_code=0
    !
    ! ==Main Block==--------------------------------------------------------
    ! Subroutine structure :
    ! Loop round levels to be processed.
    ! ----------------------------------------------------------------------
    ! Lsarc_if1:
    IF (.NOT. L_AREA_CLOUD) THEN
       !     As before
       !
       ! DEPENDS ON: ls_cld
       CALL ls_cld(&
                                !Pressure related fields
            p_layer_centres(1,1)  , &  !REAL    , INTENT(IN) :: p_theta_levels(nCols,levels)! pressure at all points (Pa).
            rhcrit                , &  !REAL    , INTENT(IN) :: RHCRIT(nCols,LEVELS)
                                !      Array dimensions
            LEVELS                , &  !INTEGER , INTENT(IN) :: LEVELS!          No. of levels being processed.
            bl_levels             , &  !INTEGER , INTENT(IN) :: BL_LEVELS!       No. of boundary layer levels
            nCols                 , &  !INTEGER , INTENT(IN) :: nCols
            cloud_fraction_method , &  !Integer , Intent(IN) :: cloud_fraction_method ! Method for calculating
            overlap_ice_liquid    , &  !Real    , Intent(IN) :: overlap_ice_liquid ! Overlap between ice and liquid phases
            ice_fraction_method   , &  !Integer , Intent(IN) :: ice_fraction_method   ! Method for calculating ice 
            ctt_weight            , &  !Real    , Intent(IN) :: ctt_weight! Weighting of cloud top temperature
            t_weight              , &  !Real    , Intent(IN) :: t_weight  ! Weighting of local temperature
            qsat_fixed            , &  !Real    , Intent(IN) :: qsat_fixed ! Fixed value of saturation humidity
            sub_cld               , &  !Real    , Intent(IN) :: sub_cld                   ! Scaling parameter
                                !      From convection diagnosis (s (only used if a05_4a)
            ntml                  , &  !INTEGER, INTENT(IN   ) :: NTML(nCols)     ! IN Height of diagnosed BL top
            cumulus               , &  !LOGICAL, INTENT(IN   ) ::  CUMULUS(nCols)  ! IN Logical indicator of convection
            L_conv4a              , &  !LOGICAL, INTENT(IN   ) ::  L_conv4a! IN true if using 4A convection scheme
            L_eacf                , &  !LOGICAL, INTENT(IN   ) ::  L_eacf! IN true if using empirically adjusted cloud
            L_mixing_ratio        , &  !LOGICAL, INTENT(IN   ) ::  L_mixing_ratio  ! IN true if using mixing ratios
                                !      Prognostic Fields
            T_latest              , &  !REAL   , INTENT(INOUT) ::        T(nCols,LEVELS)
            bulk_cloud_fraction   , &  !REAL, INTENT(OUT)        ::  CF
            q_latest              , &  !REAL   , INTENT(INOUT) ::  Q(nCols,LEVELS)
            qcf_latest            , &  !REAL    , INTENT(IN) :: QCF(nCols,LEVELS)!Cloud ice content at processed levels 
            qcl_latest            , &  !REAL, INTENT(OUT)        ::  QCL(nCols,LEVELS)
                                !      Liquid and frozen ice cloudoud fractions
            cloud_fraction_liquid , &  !REAL, INTENT(OUT)        ::  CFL(nCols,LEVELS)
            cloud_fraction_frozen , &  !REAL, INTENT(OUT)        ::  CFF(nCols,LEVELS)
            error_code               ) !INTEGER, INTENT(OUT) :: ERROR     !  0 if OK; 1 if bad arguments.
       !
       ! Lsarc_do1:
       DO k = 1, LEVELS
          DO i = 1, nCols
             area_cloud_fraction(i,k)=bulk_cloud_fraction(i,k)
          END DO
       END DO ! Lsarc_do1
       !
    ELSE ! L_area_cloud
       IF (L_ACF_CUSACK) THEN
          !       Vertical gradient area cloud option
          !
          inverse_level = 1.0_r8 / levels_per_level
          !
          ! Test for continuity between adjacent layers based on supersaturation
          ! (qt - qsl) / qsl : as we take differences the - qsl term drops out.
          ! DEPENDS ON: qsat_wat_mix
          CALL  qsat_wat_mix ( &
                                !      Output field
               qsl                        ,&! Real, intent(out)   ::  QmixS(npnts)
                                ! Output Saturation mixing ratio or saturation specific
                                ! humidity at temperature T and pressure P (kg/kg).
                                !      Input fields
               T_latest(1,1)            ,&! Real, intent(in)  :: T(npnts) !  Temperature (K).
               p_layer_centres(1,1)     ,&! Real, intent(in)  :: P(npnts) !  Pressure (Pa).  
                                !      Array dimensions
               nCols           ,&! Integer, intent(in) :: npnts  ! Points (=horizontal dimensions) being processed by qSAT scheme.
                                !      logical control
               l_mixing_ratio              )! logical, intent(in)  :: lq_mix
          ! .true. return qsat as a mixing ratio
          ! .false. return qsat as a specific humidity

          !        CALL qsat_wat_mix(  &
          !             qsl                    ,&
          !             T_latest(1,1,1)        ,&
          !             p_layer_centres(1,1,1) ,&
          !             nCols        ,&
          !             l_mixing_ratio          )

          DO i = 1, nCols
             qt_norm(i) =(q_latest(i,1)+qcf_latest(i,1))/qsl(i)
          END DO
          ! DEPENDS ON: qsat_wat_mix
          CALL  qsat_wat_mix ( &
                                !      Output field
               qsl                        ,&! Real, intent(out)   ::  QmixS(npnts)
                                ! Output Saturation mixing ratio or saturation specific
                                ! humidity at temperature T and pressure P (kg/kg).
                                !      Input fields
               T_latest(1,2)            ,&! Real, intent(in)  :: T(npnts) !  Temperature (K).
               p_layer_centres(1,2)     ,&! Real, intent(in)  :: P(npnts) !  Pressure (Pa).  
                                !      Array dimensions
               nCols           ,&! Integer, intent(in) :: npnts  ! Points (=horizontal dimensions) being processed by qSAT scheme.
                                !      logical control
               l_mixing_ratio              )! logical, intent(in)  :: lq_mix
          ! .true. return qsat as a mixing ratio
          ! .false. return qsat as a specific humidity

          !        CALL qsat_wat_mix(           &
          !             qsl                    ,&
          !             T_latest(1,1,2)        ,&
          !             p_layer_centres(1,1,2) ,&
          !             nCols        ,&
          !             l_mixing_ratio          )
          !
          ! Do nothing to top and bottom layers
          DO i = 1, nCols
             rhcrit_large(i,1) = rhcrit(i,1)
             rhcrit_large(i,large_levels)= rhcrit(i,LEVELS)
          END DO
          !
          ! Lsarc_do2:
          DO i = 1, nCols
             p_large(i,1) = p_layer_centres(i,1)
             T_large(i,1) = T_latest(i,1)
             q_large(i,1) = q_latest(i,1)
             qcf_large(i,1) = qcf_latest(i,1)
             !
             p_large(i,large_levels) = p_layer_centres(i,LEVELS)
             T_large(i,large_levels) = T_latest(i,LEVELS)
             q_large(i,large_levels) = q_latest(i,LEVELS)
             qcf_large(i,large_levels) = qcf_latest(i,LEVELS)
             ! Test for continuity (assumed if linked is .true.)
             qt_norm_next=(q_latest(i,2)+qcf_latest(i,2))/qsl(i)
             linked(i,1) =                                             &
                  (drat_thresh  >=  ABS(qt_norm(i) - qt_norm_next))
             qt_norm(i) = qt_norm_next
          END DO
          !
          ! Lsarc_do3:
          DO k = 2, (LEVELS - 1)
             k_index = 3 + (levels_per_level * (k-2))
             !
             ! DEPENDS ON: qsat_wat_mix
             CALL  qsat_wat_mix ( &
                                !      Output field
                  QSL                        ,&! Real, intent(out)   ::  QmixS(npnts)
                                ! Output Saturation mixing ratio or saturation specific
                                ! humidity at temperature T and pressure P (kg/kg).
                                !      Input fields
                  T_latest(1,(k+1))          ,&! Real, intent(in)  :: T(npnts) !  Temperature (K).
                  p_layer_centres(1,(k+1))   ,&! Real, intent(in)  :: P(npnts) !  Pressure (Pa).  
                                !      Array dimensions
                  nCols           ,&! Integer, intent(in) :: npnts  ! Points (=horizontal dimensions) being processed by qSAT scheme.
                                !      logical control
                  l_mixing_ratio              )! logical, intent(in)  :: lq_mix
             ! .true. return qsat as a mixing ratio
             ! .false. return qsat as a specific humidity

             !          CALL qsat_wat_mix(          &
             !           qsl                       ,&
             !           T_latest(1,1,(k+1))       ,&
             !           p_layer_centres(1,1,(k+1)),&
             !           nCols           ,&
             !           l_mixing_ratio             )
             !
             ! Select associated rhcrit values
             DO i = 1, nCols
                rhcrit_large(i,k_index-1) = rhcrit(i,k)
                rhcrit_large(i,k_index)   = rhcrit(i,k)
                rhcrit_large(i,k_index+1) = rhcrit(i,k)
             END DO
             !
             ! Lsarc_do3ij:
             DO i = 1, nCols
                ! Test for continuity (assumed if linked = .true.)
                qt_norm_next=(q_latest(i,(k+1))+qcf_latest(i,(k+1)))  &
                     / qsl(i)
                linked(i,k) =                                           &
                     (drat_thresh  >=  ABS(qt_norm(i) - qt_norm_next))
                qt_norm(i) = qt_norm_next
                !
                ! Select interpolated pressure levels
                delta_p = (p_layer_boundaries(i,(k-1)) -                &
                     p_layer_boundaries(i,k))    * inverse_level
                IF (p_layer_centres(i,k)  >=                            &
                     (p_layer_boundaries(i,k) + delta_p)) THEN
                   p_large(i,k_index) = p_layer_centres(i,k)
                ELSE
                   p_large(i,k_index) = 0.5_r8*(p_layer_boundaries(i,k) + &
                        p_layer_boundaries(i,(k-1)))
                ENDIF
                p_large(i,(k_index-1)) = p_large(i,k_index)+delta_p
                p_large(i,(k_index+1)) = p_large(i,k_index)-delta_p
                !
                ! Select variable values at layer centres
                T_large(i,k_index) = T_latest(i,k)
                q_large(i,k_index) = q_latest(i,k)
                qcf_large(i,k_index) = qcf_latest(i,k)
                !
                ! Calculate increment in variable values, pressure interpolation
                ! NB: Using X_large(i,(k_index+1)) as store for X increments
                ! Lsarc_if2:
                IF ( linked(i,(k-1)) ) THEN
                   IF ( linked(i,k) ) THEN
                      !               Interpolate from level k-1 to k+1
                      stretcher = delta_p /                                 &
                           (p_layer_centres(i,k-1)-p_layer_centres(i,k+1))
                      T_large(i,(k_index+1)) = stretcher *                &
                           (T_latest(i,(k+1)) - T_latest(i,(k-1)))
                      q_large(i,(k_index+1)) = stretcher *                &
                           (q_latest(i,(k+1)) - q_latest(i,(k-1)))
                      qcf_large(i,(k_index+1)) = stretcher *              &
                           (qcf_latest(i,(k+1)) - qcf_latest(i,(k-1)))
                   ELSE
                      !               Interpolate from level k-1 to k
                      stretcher = delta_p /                                 &
                           (p_layer_centres(i,k-1) - p_large(i,k_index))
                      T_large(i,(k_index+1)) = stretcher *                &
                           (T_large(i,k_index) - T_latest(i,(k-1)))
                      q_large(i,(k_index+1)) = stretcher *                &
                           (q_large(i,k_index) - q_latest(i,(k-1)))
                      qcf_large(i,(k_index+1)) = stretcher *              &
                           (qcf_large(i,k_index) - qcf_latest(i,(k-1)))
                   ENDIF
                   !
                ELSE
                   IF ( linked(i,k) ) THEN
                      !               Interpolate from level k to k+1
                      stretcher = delta_p /                                 &
                           (p_large(i,k_index) - p_layer_centres(i,k+1))
                      T_large(i,(k_index+1)) = stretcher *               &
                           (T_latest(i,(k+1)) - T_large(i,k_index))
                      q_large(i,(k_index+1)) = stretcher *               &
                           (q_latest(i,(k+1)) - q_large(i,k_index))
                      qcf_large(i,(k_index+1)) = stretcher *             &
                           (qcf_latest(i,(k+1)) - qcf_large(i,k_index))
                   ELSE
                      !               No interpolation, freeze at level k
                      T_large(i,(k_index+1)) = 0.0_r8
                      q_large(i,(k_index+1)) = 0.0_r8
                      qcf_large(i,(k_index+1)) = 0.0_r8
                   ENDIF
                   !
                END IF ! Lsarc_if2
                !
                ! Protect against q or qcf going negative (T would imply blow-up anyway)
                IF (q_large(i,k_index)  <                               &
                     (ABS(q_large(i,(k_index+1)))+tol_test))      &
                     q_large(i,(k_index+1)) = 0.0_r8
                IF (qcf_large(i,k_index)  <                             &
                     (ABS(qcf_large(i,(k_index+1)))+tol_test))  &
                     qcf_large(i,(k_index+1)) = 0.0_r8
                !
                ! Select variable values at level below layer centre
                T_large(i,(k_index-1)) = T_large(i,k_index) -         &
                     T_large(i,(k_index+1))
                q_large(i,(k_index-1)) = q_large(i,k_index) -         &
                     q_large(i,(k_index+1))
                qcf_large(i,(k_index-1))=qcf_large(i,k_index)-        &
                     qcf_large(i,(k_index+1))
                !
                ! Select variable values at level above layer centre
                ! NB: CEASE using X_large(i,(k_index+1)) as store for X increments.
                T_large(i,(k_index+1)) = T_large(i,(k_index+1)) +     &
                     T_large(i,k_index)
                q_large(i,(k_index+1)) = q_large(i,(k_index+1)) +     &
                     q_large(i,k_index)
                qcf_large(i,(k_index+1))=qcf_large(i,(k_index+1)) +   &
                     qcf_large(i,k_index)
             END DO
          END DO ! Lsarc_do3ij
          !
          !
          !
          ! Create an array of NTML values adjusted to the large levels

          DO i = 1, nCols
             ntml_large(i) = 3+(levels_per_level*(ntml(i)-1))
          END DO

          ! DEPENDS ON: ls_cld
          CALL ls_cld( &
                                !      Pressure related fields
               p_large                     , & !REAL    , INTENT(IN) :: p_theta_levels(nCols,levels)! pressure at all points (Pa).
               rhcrit_large                , & !REAL    , INTENT(IN) :: RHCRIT(nCols,LEVELS)
                                !      Array dimensions
               large_levels                , & !INTEGER , INTENT(IN) :: LEVELS!         No. of levels being processed.
               bl_levels                   , & !INTEGER , INTENT(IN) :: BL_LEVELS!            No. of boundary layer levels
               nCols                  , & !INTEGER , INTENT(IN) :: nCols
               cloud_fraction_method       , & !Integer , Intent(IN) :: cloud_fraction_method ! Method for calculating
               overlap_ice_liquid          , & !Real    , Intent(IN) :: overlap_ice_liquid ! Overlap between ice and liquid phases
               ice_fraction_method         , & !Integer , Intent(IN) :: ice_fraction_method   ! Method for calculating ice 
               ctt_weight                  , & !Real    , Intent(IN) :: ctt_weight! Weighting of cloud top temperature
               t_weight                    , & !Real    , Intent(IN) :: t_weight  ! Weighting of local temperature
               qsat_fixed                  , & !Real    , Intent(IN) :: qsat_fixed ! Fixed value of saturation humidity
               sub_cld                     , & !Real    , Intent(IN) :: sub_cld                  ! Scaling parameter
                                !      From convection diagnosis (only uss (only used if a05_4a)
               ntml_large                  , & !INTEGER, INTENT(IN        ) :: NTML(nCols)     ! IN Height of diagnosed BL top
               cumulus                     , & !LOGICAL, INTENT(IN        ) ::  CUMULUS(nCols)  ! IN Logical indicator of convection
               L_conv4a                    , & !LOGICAL, INTENT(IN        ) ::  L_conv4a! IN true if using 4A convection scheme
               L_eacf                      , & !LOGICAL, INTENT(IN        ) ::  L_eacf! IN true if using empirically adjusted cloud
               l_mixing_ratio              , & !LOGICAL, INTENT(IN        ) ::  L_mixing_ratio  ! IN true if using mixing ratios
                                !      Prognostic Fields
               T_large                     , & !REAL   , INTENT(INOUT) ::   T(nCols,LEVELS)
               cloud_fraction_large        , & !REAL, INTENT(OUT)   ::  CF
               q_large                     , & !REAL   , INTENT(INOUT) ::  Q(nCols,LEVELS)
               qcf_large                   , & !REAL    , INTENT(IN) :: QCF(nCols,LEVELS)!Cloud ice content at processed levels 
               qcl_large                   , & !REAL, INTENT(OUT)   ::  QCL(nCols,LEVELS)
                                !      Liquid and frozen ice cloud fractioud fractions
               cloud_fraction_liquid_large , & !REAL, INTENT(OUT)   ::  CFL(nCols,LEVELS)
               cloud_fraction_frozen_large , & !REAL, INTENT(OUT)   ::  CFF(nCols,LEVELS)
               error_code                    ) !INTEGER, INTENT(OUT) :: ERROR     !  0 if OK; 1 if bad arguments.

          ! Lsarc_do4:
          DO i = 1, nCols
             T_latest(i,1) = T_large(i,1)
             q_latest(i,1) = q_large(i,1)

             area_cloud_fraction(i,1) = cloud_fraction_large(i,1)
             bulk_cloud_fraction(i,1) = cloud_fraction_large(i,1)

             qcl_latest(i,1) = qcl_large(i,1)
             cloud_fraction_liquid(i,1) =                              &
                  cloud_fraction_liquid_large(i,1)
             cloud_fraction_frozen(i,1) =                              &
                  cloud_fraction_frozen_large(i,1)

             T_latest(i,LEVELS) = T_large(i,large_levels)
             q_latest(i,LEVELS) = q_large(i,large_levels)

             area_cloud_fraction(i,LEVELS) =                 &
                  cloud_fraction_large(i,large_levels)
             bulk_cloud_fraction(i,LEVELS) =                 &
                  cloud_fraction_large(i,large_levels)

             qcl_latest(i,LEVELS)=qcl_large(i,large_levels)
             cloud_fraction_liquid(i,LEVELS) =               &
                  cloud_fraction_liquid_large(i,large_levels)
             cloud_fraction_frozen(i,LEVELS) =               &
                  cloud_fraction_frozen_large(i,large_levels)
          END DO
          !
          ! Output variables for remaining layers
          ! Lsarc_do5:
          DO k = 2, (LEVELS - 1)
             k_index = 3 + (levels_per_level * (k-2))
             ! Lsarc_do5ij:
             DO i = 1, nCols
                ! Area cloud fraction is maximum of sub-layer cloud fractions
                area_cloud_fraction(i,k) =                              &
                     MAX( cloud_fraction_large(i,k_index),                   &
                     (MAX(cloud_fraction_large(i,(k_index+1)),          &
                     cloud_fraction_large(i,(k_index-1)))) )
                !
                ! Bulk cloud fraction is mean of sub-layer cloud fractions : strictly
                ! this is a pressure weighted mean being used to approximate a volume
                ! mean. Over the depth of a layer the difference should not be large.
                bulk_cloud_fraction(i,k) = inverse_level *              &
                     ( cloud_fraction_large(i,(k_index-1)) +              &
                     cloud_fraction_large(i, k_index)    +              &
                     cloud_fraction_large(i,(k_index+1)) )
                !
                ! The pressure weighted mean of qcf is the input qcf: do not update.
                !
                ! Qcl is the pressure weighted mean of qcl from each sub-layer.
                qcl_latest(i,k) = inverse_level *                       &
                     ( qcl_large(i,(k_index-1)) +                              &
                     qcl_large(i,k_index) + qcl_large(i,(k_index+1)) )
                !
                ! Liq. cloud fraction is mean of sub-layer cloud fractions : strictly
                ! this is a pressure weighted mean being used to approximate a volume
                ! mean. Over the depth of a layer the difference should not be large.
                cloud_fraction_liquid(i,k) = inverse_level *            &
                     ( cloud_fraction_liquid_large(i,(k_index-1)) +            &
                     cloud_fraction_liquid_large(i,k_index)     +            &
                     cloud_fraction_liquid_large(i,(k_index+1)) )
                !
                ! Froz cloud fraction is mean of sub-layer cloud fractions : strictly
                ! this is a pressure weighted mean being used to approximate a volume
                ! mean. Over the depth of a layer the difference should not be large.
                cloud_fraction_frozen(i,k) = inverse_level *            &
                     ( cloud_fraction_frozen_large(i,(k_index-1)) +            &
                     cloud_fraction_frozen_large(i,k_index)     +            &
                     cloud_fraction_frozen_large(i,(k_index+1)) )
                !
                ! Transform q_latest from qT(vapour + liquid) to specific humidity.
                ! Transform T_latest from TL(vapour + liquid) to temperature.
                q_latest(i,k) = q_latest(i,k) - qcl_latest(i,k)
                T_latest(i,k) = T_latest(i,k) +                       &
                     (qcl_latest(i,k) * LCRCP)
             END DO
             !
          END DO ! Lsarc_do5
          !
       ELSE IF (L_ACF_Brooks) THEN  ! L_ACF_Cusack or Brooks
          !
          !       As before, update variables that would have been updated
          !       without area cloud fraction on
          !
          ! DEPENDS ON: ls_cld
          CALL ls_cld(&
                                !      Pressure related fields
               p_layer_centres(1,1)    ,&!REAL    , INTENT(IN) :: p_theta_levels(nCols,levels)! pressure at all points (Pa).
               rhcrit                    ,&!REAL    , INTENT(IN) :: RHCRIT(nCols,LEVELS)
                                !      Array dimensions
               LEVELS          ,&!INTEGER , INTENT(IN) :: LEVELS!            No. of levels being processed.
               bl_levels                 ,&!INTEGER , INTENT(IN) :: BL_LEVELS!       No. of boundary layer levels
               nCols                ,&!INTEGER , INTENT(IN) :: nCols
               cloud_fraction_method     ,&!Integer , Intent(IN) :: cloud_fraction_method ! Method for calculating
               overlap_ice_liquid        ,&!Real    , Intent(IN) :: overlap_ice_liquid ! Overlap between ice and liquid phases
               ice_fraction_method       ,&!Integer , Intent(IN) :: ice_fraction_method   ! Method for calculating ice 
               ctt_weight                ,&!Real    , Intent(IN) :: ctt_weight! Weighting of cloud top temperature
               t_weight                  ,&!Real    , Intent(IN) :: t_weight  ! Weighting of local temperature
               qsat_fixed                ,&!Real    , Intent(IN) :: qsat_fixed ! Fixed value of saturation humidity
               sub_cld                   ,&!Real    , Intent(IN) :: sub_cld                     ! Scaling parameter
                                !      From convection diagnosis (ons (only used if a05_4a)
               ntml                      ,&!INTEGER, INTENT(IN   ) :: NTML(nCols)        ! IN Height of diagnosed BL top
               cumulus                   ,&!LOGICAL, INTENT(IN   ) ::  CUMULUS(nCols)  ! IN Logical indicator of convection
               L_conv4a                  ,&!LOGICAL, INTENT(IN   ) ::  L_conv4a! IN true if using 4A convection scheme
               L_eacf                    ,&!LOGICAL, INTENT(IN   ) ::  L_eacf! IN true if using empirically adusted cloud
               L_mixing_ratio            ,&!LOGICAL, INTENT(IN   ) ::  L_mixing_ratio  ! IN true if using mixing ratios
                                !      Prognostic Fields
               T_latest                  ,&!REAL   , INTENT(INOUT) ::   T(nCols,LEVELS)
               bulk_cloud_fraction       ,&!REAL, INTENT(OUT)   ::  CF
               q_latest                  ,&!REAL   , INTENT(INOUT) ::  Q(nCols,LEVELS)
               qcf_latest                ,&!REAL    , INTENT(IN) :: QCF(nCols,LEVELS)!Cloud ice content at processed levels 
               qcl_latest                ,&!REAL, INTENT(OUT)   ::  QCL(nCols,LEVELS)
                                !      Liquid and frozen ice cloud oud fractions
               cloud_fraction_liquid     ,&!REAL, INTENT(OUT)   ::  CFL(nCols,LEVELS)
               cloud_fraction_frozen     ,&!REAL, INTENT(OUT)   ::  CFF(nCols,LEVELS)
               error_code                 )!INTEGER, INTENT(OUT) :: ERROR        !  0 if OK; 1 if bad arguments.
          !
          !      Calculate the area cloud fraction

          ! DEPENDS ON: ls_acf_brooks
          CALL LS_ACF_Brooks ( &
                                ! model dimensions
               nCols            , &!INTEGER, INTENT(IN        ) ::  nCols
               LEVELS      , &!INTEGER, INTENT(IN        ) :: LEVELS
                                ! in coordinate information
               r_theta_levels        , &!Real ,INTENT(IN)::  r_theta_levels (nCols,0:LEVELS)
               delta_lambda          , &!Real ,INTENT(IN):: delta_lambda ! EW (x) grid spacing in radians
               delta_phi             , &!Real ,INTENT(IN):: delta_phi    ! NS (y) grid spacing in radians
                                ! trig arrays
               FV_cos_theta_latitude , &!Real ,INTENT(IN):: FV_cos_theta_latitude (1:nCols)! Finite volume cos(lat)
                                ! in data fields
               bulk_cloud_fraction   , &!Real ,INTENT(IN)::  bulk_cloud_fraction (nCols, LEVELS)
               cloud_fraction_liquid , &!Real  ,INTENT(IN):: cloud_fraction_liquid (nCols, LEVELS)
               cloud_fraction_frozen , &!Real  ,INTENT(IN):: cloud_fraction_frozen (nCols, LEVELS)
                                ! in logical control
               cumulus               , &!Logical, intent(in):: cumulus(nCols)
                                ! out data fields
               area_cloud_fraction     )!Real::   area_cloud_fraction (nCols, LEVELS)

          !
       END IF ! L_ACF_Brooks
    END IF ! Lsarc_if1  L_area_cloud
    !
    RETURN
  END SUBROUTINE LS_ARCLD
  ! ======================================================================




  !+    Brooks area cloud fraction parametrisation
  !
  !     *********************** COPYRIGHT *************************
  !     Crown Copyright <year>, The Met. Office. All rights reserved.
  !     *********************** COPYRIGHT *************************
  !
  !     Subroutine Interface:

  SUBROUTINE LS_ACF_Brooks ( &
                                ! model dimensions
       nCols                  ,&!INTEGER, INTENT(IN   ) ::  nCols
       LEVELS                 ,&!INTEGER, INTENT(IN   ) :: LEVELS
                                ! in coordinate information
       r_theta_levels         ,&!Real ,INTENT(IN)::  r_theta_levels (nCols,0:LEVELS)
       delta_lambda           ,&!Real ,INTENT(IN):: delta_lambda ! EW (x) grid spacing in radians
       delta_phi              ,&!Real ,INTENT(IN):: delta_phi    ! NS (y) grid spacing in radians
                                ! trig arrays
       FV_cos_theta_latitude  ,&!Real ,INTENT(IN):: FV_cos_theta_latitude (1:nCols)! Finite volume cos(lat)
                                ! in data fields
       bulk_cloud_fraction    ,&!Real ,INTENT(IN)::  bulk_cloud_fraction (nCols, LEVELS)
       cloud_fraction_liquid  ,&!Real  ,INTENT(IN):: cloud_fraction_liquid (nCols, LEVELS)
       cloud_fraction_frozen  ,&!Real  ,INTENT(IN):: cloud_fraction_frozen (nCols, LEVELS)
                                ! in logical control
       cumulus                ,&!Logical, intent(in):: cumulus(nCols)
                                ! out data fields
       area_cloud_fraction     )!Real::   area_cloud_fraction (nCols, LEVELS)

    !     Description:
    !       Calculates area_cloud_fraction from bulk_cloud_fraction
    !
    !     Method:
    !       The calculation is  based on the parametrisation in
    !       Brooks 2005 equations 2-3.
    !       (Brooks et al, July 2005, JAS vol 62 pp 2248-2260)
    !       The initial parametrisation uses the values in equations
    !       4,5,7 and 8 of the paper for ice and liquid cloud without
    !       wind shear.  For mixed phase clouds the maximum of the two
    !       area_cloud_fractions resulting will be used.
    !       Only area_cloud_fraction will be updated.
    !       Grid box size is needed to be known.
    !
    !     Current Code Owner: LS cloud scheme owner
    !
    !     History:
    !     Version  Date      Comment
    !
    !       6.4    19/09/05  Original code. (Amanda Kerr-Munslow, placed
    !                                        into UM by D Wilson)
    !
    !     Code Description:
    !       FORTRAN 77 with extensions recommended in the Met. Office
    !       F77 Standard.
    !
    IMPLICIT NONE

    ! Scalar arguments with INTENT(IN):

    ! Model dimensions
    INTEGER, INTENT(IN   ) ::  nCols
    ! number of points on a row
    INTEGER, INTENT(IN   ) :: LEVELS
    ! number of model levels where moisture
    ! variables are held

    ! Array Arguments with INTENT(IN)
    ! Co-ordinate arrays:
    REAL(KIND=r8) ,INTENT(IN)::  r_theta_levels (nCols,0:LEVELS)
    ! height of theta levels (from centre of earth)
    REAL(KIND=r8) ,INTENT(IN):: FV_cos_theta_latitude (1:nCols)! Finite volume cos(lat)
    REAL(KIND=r8) ,INTENT(IN):: delta_lambda ! EW (x) grid spacing in radians
    REAL(KIND=r8) ,INTENT(IN):: delta_phi    ! NS (y) grid spacing in radians

    ! Data arrays:
    REAL(KIND=r8) ,INTENT(IN)::  bulk_cloud_fraction (nCols, LEVELS)
    !       Cloud fraction at processed levels (decimal fraction).
    REAL(KIND=r8)  ,INTENT(IN):: cloud_fraction_liquid (nCols, LEVELS)
    !       Liquid cloud fraction at processed levels (decimal fraction).
    REAL(KIND=r8)  ,INTENT(IN):: cloud_fraction_frozen (nCols, LEVELS)
    !       Frozen cloud fraction at processed levels (decimal fraction).

    LOGICAL, INTENT(in):: cumulus(nCols)

    ! Arguments with INTENT(OUT):
    ! Data arrays:
    REAL(KIND=r8)::   area_cloud_fraction (nCols, LEVELS)
    !       Cloud fraction at processed levels (decimal fraction).

    ! Local Parameters:

    ! Parameters for liquid clouds, from Brooks 2005 equations 7 and 8
    REAL(KIND=r8) ,PARAMETER :: power_law_gradient_liquid = 0.1635_r8 ! A
    REAL(KIND=r8) ,PARAMETER :: vert_fit_liquid = 0.6694_r8   ! alpha
    REAL(KIND=r8) ,PARAMETER :: horiz_fit_liquid = -0.1882_r8 ! beta

    ! Parameters for frozen clouds, from Brooks 2005 equations 4 and 5
    REAL(KIND=r8),PARAMETER ::  power_law_gradient_frozen = 0.0880_r8! A
    REAL(KIND=r8),PARAMETER ::  vert_fit_frozen = 0.7679_r8  ! alpha
    REAL(KIND=r8),PARAMETER :: horiz_fit_frozen= -0.2254  ! beta

    ! Local Scalars:
    ! Loop counters
    INTEGER ::   i, k

    REAL(KIND=r8) ::  symmetric_adjustment_liquid
    !    function f in eqn 7 in Brooks 2005
    REAL(KIND=r8) ::   symmetric_adjustment_frozen
    !    function f in eqn 4 in Brooks 2005
    REAL(KIND=r8) ::  horiz_scale
    !    horizontal scale size of the grid box (m)
    REAL(KIND=r8) ::   vert_scale
    !    vertical scale size of the grid box (m)


    !  Local Arrays:
    REAL(KIND=r8) ::  acf_liquid (nCols, LEVELS)
    !    area cloud fraction based on liquid parameters
    REAL(KIND=r8) ::  acf_frozen (nCols, LEVELS)
    !    area cloud fraction based on frozen parameters

    !-    End of header
    ! ----------------------------------------------------------------------

    ! ==Main Block==--------------------------------------------------------

    ! Initialise arrays and local variables to zero
    DO k = 1, LEVELS
       DO i = 1, nCols
          area_cloud_fraction(i,k) = 0.0_r8
          acf_liquid(i,k) = 0.0_r8
          acf_frozen(i,k) = 0.0_r8
       END DO
    END DO
    horiz_scale = 0.0_r8
    vert_scale = 0.0_r8
    symmetric_adjustment_liquid = 0.0_r8
    symmetric_adjustment_frozen = 0.0_r8

    DO k = 1, LEVELS
       DO i = 1, nCols
          !
          ! Test if bulk_cloud_fraction is within bounds of possibility
          !
          IF ( bulk_cloud_fraction(i,k) <= 0.0_r8 ) THEN

             area_cloud_fraction(i,k) = 0.0_r8

          ELSE IF ( bulk_cloud_fraction(i,k) >= 1.0_r8 ) THEN

             area_cloud_fraction(i,k) = 1.0_r8

          ELSE IF (cumulus(i)) THEN
             ! This is a convective point so do not apply the
             ! area cloud representation
             area_cloud_fraction(i,k) = bulk_cloud_fraction(i,k)

          ELSE

             ! Only calculate area_cloud_fraction if the bulk_cloud_fraction
             ! is between (not equal to) 0.0_r8 and 1.0_r8
             !
             ! Calculate horizontal and vertical scales.
             ! The horizontal scale is taken as the square root of the
             ! area of the grid box.
             ! The vertical scale is taken as the difference in radius
             ! from the centre of the Earth between the upper and lower
             ! boundaries of the grid box.

             horiz_scale = SQRT (                                      &
                  r_theta_levels(i,k)                   &
                  * r_theta_levels(i,k)                 &
                  * delta_lambda * delta_phi              &
                  * FV_cos_theta_latitude(i) )
             IF (k .EQ. LEVELS) THEN
                ! Assume top layer thickness is the same as the
                ! thickness of the layer below
                vert_scale =  r_theta_levels(i,k)                     &
                     - r_theta_levels(i,k-1)
             ELSE 
                vert_scale =  r_theta_levels(i,k+1)                   &
                     - r_theta_levels(i,k)
             END IF  ! k eq LEVELS

             ! Calculate the symmetric_adjustment (f).
             ! This parameter controls the extent to which the area cloud fraction
             ! is greater than the bulk cloud fraction.  If f = 0, they are equal.

             symmetric_adjustment_liquid =                             &
                  power_law_gradient_liquid                      &
                  * ( vert_scale ** vert_fit_liquid )            &
                  * ( horiz_scale ** horiz_fit_liquid )
             symmetric_adjustment_frozen =                             &
                  power_law_gradient_frozen                      &
                  * ( vert_scale ** vert_fit_frozen )            &
                  * ( horiz_scale ** horiz_fit_frozen )

             ! Calculate the area cloud fractions for liquid and frozen cloud
             ! Calculate the liquid and frozen fractions separately to
             ! allow for greatest flexibility in future choice of decisions
             ! regarding mixed phase cloud.

             acf_liquid(i,k) = 1.0_r8/                                   &
                  ( 1.0_r8 + ( EXP(-1.0_r8*symmetric_adjustment_liquid)         &
                  * ( 1.0_r8/bulk_cloud_fraction(i,k) - 1.0_r8) ) )
             acf_frozen(i,k) = 1.0_r8/                                   &
                  ( 1.0_r8 + ( EXP(-1.0_r8*symmetric_adjustment_frozen)         &
                  * ( 1.0_r8/bulk_cloud_fraction(i,k) - 1.0_r8) ) )

             ! Calculate the final area cloud fraction for each grid box
             ! Currently this is based on which there is more of, ice or liquid.

             IF ( cloud_fraction_frozen(i,k) == 0.0_r8 ) THEN
                IF ( cloud_fraction_liquid(i,k) == 0.0_r8 ) THEN

                   ! If there is no liquid or frozen cloud, there should be no area cloud
                   area_cloud_fraction(i,k) = 0.0_r8

                ELSE

                   ! If there is no frozen cloud but there is liquid cloud,
                   ! then the area cloud fraction is given by the liquid parametrisation
                   ! 0 no cloud, 1 either, 2 liq, 3 ice'
                   area_cloud_fraction(i,k) = acf_liquid(i,k)
                END IF

             ELSE ! cloud_fraction_frozen

                IF ( cloud_fraction_liquid(i,k) == 0.0_r8 ) THEN

                   ! If there is frozen cloud but there is no liquid cloud,
                   ! then the area cloud fraction is given by the frozen parametrisation
                   area_cloud_fraction(i,k) = acf_frozen(i,k)

                ELSE

                   ! If there is frozen cloud and there is liquid cloud,
                   ! then the area cloud fraction is given by the maximum of the two
                   ! parametrisations
                   area_cloud_fraction(i,k) =                          &
                        MAX( acf_liquid(i,k),acf_frozen(i,k) )

                END IF

             END IF ! cloud_fraction_frozen

          END IF ! bulk_cloud_fraction between 0.0_r8 and 1.0_r8

       END DO
    END DO

    RETURN
  END SUBROUTINE LS_ACF_Brooks
  ! ======================================================================


  ! *****************************COPYRIGHT*******************************
  ! (C) Crown copyright Met Office. All rights reserved.
  ! For further details please refer to the file COPYRIGHT.txt
  ! which you should have received as part of this distribution.
  ! *****************************COPYRIGHT*******************************
  !
  !+ Large-scale Cloud Scheme.
  ! Subroutine Interface:
  SUBROUTINE LS_CLD( &
                                !      Pressure related fields
       p_theta_levels        ,& !REAL    , INTENT(IN) :: p_theta_levels(nCols,levels)! pressure at all points (Pa).
       RHCRIT                ,& !REAL    , INTENT(IN) :: RHCRIT(nCols,LEVELS)
                                !      Array dimensions
       LEVELS                ,& !INTEGER , INTENT(IN) :: LEVELS!       No. of levels being processed.
       BL_LEVELS             ,& !INTEGER , INTENT(IN) :: BL_LEVELS!       No. of boundary layer levels
       nCols                 ,& !INTEGER , INTENT(IN) :: nCols
       cloud_fraction_method ,& !Integer , Intent(IN) :: cloud_fraction_method ! Method for calculating
       overlap_ice_liquid    ,& !Real    , Intent(IN) :: overlap_ice_liquid ! Overlap between ice and liquid phases
       ice_fraction_method   ,& !Integer , Intent(IN) :: ice_fraction_method   ! Method for calculating ice 
       ctt_weight            ,& !Real    , Intent(IN) :: ctt_weight! Weighting of cloud top temperature
       t_weight              ,& !Real    , Intent(IN) :: t_weight  ! Weighting of local temperature
       qsat_fixed            ,& !Real    , Intent(IN) :: qsat_fixed ! Fixed value of saturation humidity
       sub_cld               ,& !Real    , Intent(IN) :: sub_cld                ! Scaling parameter
                                !      From convection diagnosis (only used if a05_4a)
       ntml                  ,& !INTEGER, INTENT(IN   ) :: NTML(nCols)     ! IN Height of diagnosed BL top
       cumulus               ,& !LOGICAL, INTENT(IN   ) ::  CUMULUS(nCols)  ! IN Logical indicator of convection
       L_conv4a              ,& !LOGICAL, INTENT(IN   ) ::  L_conv4a! IN true if using 4A convection scheme
       L_eacf                ,& !LOGICAL, INTENT(IN   ) ::  L_eacf! IN true if using empirically adjusted cloud
       L_mixing_ratio        ,& !LOGICAL, INTENT(IN   ) ::  L_mixing_ratio  ! IN true if using mixing ratios
                                !      Prognostic Fields
       T                     ,& !REAL   , INTENT(INOUT) ::   T(nCols,LEVELS)
       CF                    ,& !REAL, INTENT(OUT)   ::  CF
       Q                     ,& !REAL   , INTENT(INOUT) ::  Q(nCols,LEVELS)
       QCF                   ,& !REAL    , INTENT(IN) :: QCF(nCols,LEVELS)!Cloud ice content at processed levels 
       QCL                   ,& !REAL, INTENT(OUT)   ::  QCL(nCols,LEVELS)
                                !      Liquid and frozen ice cloud fractions
       CFL                   ,& !REAL, INTENT(OUT)   ::  CFL(nCols,LEVELS)
       CFF                   ,& !REAL, INTENT(OUT)   ::  CFF(nCols,LEVELS)
       ERROR                  ) !INTEGER, INTENT(OUT) :: ERROR     !  0 if OK; 1 if bad arguments.
    !

    IMPLICIT NONE
    !
    ! Purpose:
    !   This subroutine calculates liquid and ice cloud fractional cover
    !   for use with the enhanced precipitation microphysics scheme.
    !
    ! Method:
    !   Statistical cloud scheme separates input moisture into specific
    !   humidity and cloud liquid water. Temperature calculated from liquid
    !   water temperature. Cloud fractions calculated from statistical
    !   relation between cloud fraction and cloud liquid/ice water content.
    !
    ! Current Owner of Code: A. C. Bushell
    !
    ! History:
    ! Version   Date     Comment
    !  4.4    14-11-96   Original Code (A. C. Bushell from Wilson/Ballard)
    !
    !  4.5    16-01-98   Change to estimated bs in ice cloud fraction
    !                    calculation (use QSat_Wat).  AC Bushell
    !
    !  5.1    09-12-99   Change to allow 3D RHcrit specification. AC Bushell
    !
    !  5.2    21-11-00   Changes to ice cloud fraction. Damian Wilson
    !
    !LL  5.3  24/09/01  Portability changes.    Z. Gardner
    !
    !  5.4   10-09-02    If cumulus convection is diagnosed the large
    !                    scale cloud is not allowed in the levels around
    !                    cumulus cloud-base.           Gill Martin
    !
    !  5.5   11-02-03    Fix to allow RHcrit = 1.   R.M. Forbes
    !  6.0  19/08/03  NEC SX-6 optimisation - Avoid bank conflicts by
    !                 replacing repeated access to RHCRIT(1,1,K) by
    !                 temporary scalar.  R Barnes & J-C Rioual.
    !  6.2  20/03/06  Revised SX-6 optimisation by J-C Rioual.
    !                 Lodged by M Saunby.
    !  6.2  07-11-05  Include the EACF parametrization for cloud
    !                    fraction.                             D. Wilson
    !  6.2  22-11-05  Include cloud parametrization quantities. D. Wilson
    !  6.4  19-12-06  NEC vectorisation optimisation and tidy-up comments.
    !                 P.Selwood.
    !  6.4  07-08-06  Include mixing ratio formulation. D. Wilson
    !
    ! Description of Code:
    !   FORTRAN 77  + common extensions also in Fortran90.
    !   This code is written to UMDP3 version 6 programming standards.
    !
    !   Documentation: UMDP No. 29
    !

    !  Global Variables:----------------------------------------------------
    ! History:
    ! Version  Date  Comment
    !  3.4   18/5/94 Add PP missing data indicator. J F Thomson
    !  5.1    6/3/00 Convert to Free/Fixed format. P Selwood
    !*L------------------COMDECK C_MDI-------------------------------------
    ! PP missing data indicator (-1.0E+30_r8)
    REAL(KIND=r8), PARAMETER    :: RMDI_PP  = -1.0E+30_r8

    ! Old REAL(KIND=r8) missing data indicator (-32768.0_r8)
    REAL(KIND=r8), PARAMETER    :: RMDI_OLD = -32768.0_r8

    ! New REAL(KIND=r8) missing data indicator (-2**30)
    REAL(KIND=r8), PARAMETER    :: RMDI     = -32768.0_r8*32768.0_r8

    ! Integer missing data indicator
    INTEGER, PARAMETER :: IMDI     = -32768
    !*----------------------------------------------------------------------
    !*L------------------COMDECK C_PI---------------------------------------
    !LL
    !LL 4.0 19/09/95  New value for PI. Old value incorrect
    !LL               from 12th decimal place. D. Robinson
    !LL 5.1 7/03/00   Fixed/Free format P.Selwood
    !LL

    ! Pi
    REAL(KIND=r8), PARAMETER :: Pi                 = 3.14159265358979323846_r8

    ! Conversion factor degrees to radians
    REAL(KIND=r8), PARAMETER :: Pi_Over_180        = Pi/180.0_r8

    ! Conversion factor radians to degrees
    REAL(KIND=r8), PARAMETER :: Recip_Pi_Over_180  = 180.0_r8/Pi

    !*----------------------------------------------------------------------
    !
    !  History
    !
    !  6.2   17/11/05  Remove variables that are now set in UMUI. D. Wilson
    ! start C_CLDSGS


    ! Minimum ice content to perform calculations
    REAL(KIND=r8),PARAMETER :: QCFMIN=1.0E-8_r8

    ! end C_CLDSGS
    !
    !  Subroutine Arguments:------------------------------------------------
    INTEGER , INTENT(IN) :: LEVELS!       No. of levels being processed.
    INTEGER , INTENT(IN) :: BL_LEVELS!       No. of boundary layer levels
    INTEGER , INTENT(IN) :: nCols
    !
    REAL(KIND=r8)    , INTENT(IN) :: QCF(nCols,LEVELS)!Cloud ice content at processed levels (kg water per kg air).
    REAL(KIND=r8)    , INTENT(IN) :: p_theta_levels(nCols,levels)! pressure at all points (Pa).
    REAL(KIND=r8)    , INTENT(IN) :: RHCRIT(nCols,LEVELS)
    !       Critical relative humidity.  See the the paragraph incorporating
    !       eqs P292.11 to P292.14; the values need to be tuned for the give
    !       set of levels.
    !
    INTEGER , INTENT(IN) :: cloud_fraction_method ! Method for calculating
    ! total cloud fraction
    INTEGER , INTENT(IN) :: ice_fraction_method   ! Method for calculating ice cloud frac.

    REAL(KIND=r8)    , INTENT(IN) :: overlap_ice_liquid ! Overlap between ice and liquid phases
    REAL(KIND=r8)    , INTENT(IN) :: ctt_weight! Weighting of cloud top temperature
    REAL(KIND=r8)    , INTENT(IN) :: t_weight  ! Weighting of local temperature
    REAL(KIND=r8)    , INTENT(IN) :: qsat_fixed ! Fixed value of saturation humidity
    REAL(KIND=r8)    , INTENT(IN) :: sub_cld                ! Scaling parameter
    !
    INTEGER, INTENT(IN   ) :: NTML(nCols)     ! IN Height of diagnosed BL top

    LOGICAL, INTENT(IN   ) ::  L_conv4a! IN true if using 4A convection scheme
    LOGICAL, INTENT(IN   ) ::  L_eacf! IN true if using empirically adjusted cloud
    !    fraction parametrization
    LOGICAL, INTENT(IN   ) ::  L_mixing_ratio  ! IN true if using mixing ratios

    LOGICAL, INTENT(IN   ) ::  CUMULUS(nCols)  ! IN Logical indicator of convection

    REAL(KIND=r8)   , INTENT(INOUT) ::  Q(nCols,LEVELS)
    !       On input : Total water content (QW) (kg per kg air).
    !       On output: Specific humidity at processed levels
    !                   (kg water per kg air).
    REAL(KIND=r8)   , INTENT(INOUT) ::   T(nCols,LEVELS)
    !       On input : Liquid/frozen water temperature (TL) (K).
    !       On output: Temperature at processed levels (K).
    !
    REAL(KIND=r8), INTENT(OUT)   ::  CF(nCols,LEVELS) 
    !       Cloud fraction at processed levels (decimal fraction).
    REAL(KIND=r8), INTENT(OUT)   ::  QCL(nCols,LEVELS)
    !       Cloud liquid water content at processed levels (kg per kg air).
    REAL(KIND=r8), INTENT(OUT)   ::  CFL(nCols,LEVELS)
    !       Liquid cloud fraction at processed levels (decimal fraction).
    REAL(KIND=r8), INTENT(OUT)   ::  CFF(nCols,LEVELS)
    !       Frozen cloud fraction at processed levels (decimal fraction).
    !
    !     Error Status:
    INTEGER, INTENT(OUT) :: ERROR     !  0 if OK; 1 if bad arguments.
    !
    !  Local parameters and other physical constants------------------------
    REAL(KIND=r8) :: ROOTWO       ! Sqrt(2.)
    REAL(KIND=r8) :: SUBGRID      ! Subgrid parameter in ice cloud calculation
    !
    !  Local scalars--------------------------------------------------------
    !
    !  (a) Scalars effectively expanded to workspace by the Cray (using
    !      vector registers).
    REAL(KIND=r8) :: PHIQCF    ! Arc-cosine term in Cloud ice fraction calc.
    REAL(KIND=r8) :: COSQCF    ! Cosine term in Cloud ice fraction calc.
    REAL(KIND=r8) :: OVERLAP_MAX ! Maximum possible overlap
    REAL(KIND=r8) :: OVERLAP_MIN ! Minimum possible overlap
    REAL(KIND=r8) :: OVERLAP_RANDOM! Random overlap
    REAL(KIND=r8) :: TEMP0 
    REAL(KIND=r8) :: TEMP1
    REAL(KIND=r8) :: TEMP2! Temporaries for combinations of the
    REAL(KIND=r8) :: QN_IMP!! overlap parameters
    REAL(KIND=r8) :: QN_ADJ!! overlap parameters
    !
    !  (b) Others.
    INTEGER ::  K,I       ! Loop counters: K - vertical level index.
    !                                        I,J - horizontal field indices.
    !
    INTEGER :: QC_POINTS  ! No. points with non-zero cloud
    INTEGER :: MULTRHC   ! Zero if (nCols*nCols) le 1, else 1
    !
    !  Local dynamic arrays-------------------------------------------------
    !    6 blocks of REAL(KIND=r8) workspace are required.
    REAL(KIND=r8) :: QCFRBS(nCols)! qCF / bs
    REAL(KIND=r8) :: QSL(nCols)!Saturated specific humidity for temp TL or T.
    REAL(KIND=r8) :: QSL_CTT(nCols)!Saturated specific humidity wrt liquid at cloud top temperature
    REAL(KIND=r8) :: QN(nCols)!Cloud water normalised with BS.
    REAL(KIND=r8) :: GRID_QC(nCols,LEVELS)!Gridbox mean saturation excess at processed levels
    !        (kg per kg air). Set to RMDI when cloud is absent.
    REAL(KIND=r8) :: BS(nCols,LEVELS)!Maximum moisture fluctuation /6*sigma at processed levels
    !        (kg per kg air). Set to RMDI when cloud is absent.
    REAL(KIND=r8) :: CTT(nCols)!Ice cloud top temperature (K) - as coded it is REAL(KIND=r8)ly TL
    LOGICAL :: LQC(nCols)      ! True for points with non-zero cloud
    INTEGER :: INDEX(nCols,1)  ! Index for points with non-zero cloud
    INTEGER :: LLWIC(nCols)!       Last Level With Ice Cloud
    REAL(KIND=r8)    :: RHCRITX              ! scalar copy of RHCRIT(I,J,K)
    !
    !  External subroutine calls: ------------------------------------------
    !      EXTERNAL QSAT,QSAT_WAT,LS_CLD_C
    !- End of Header
    ! ----------------------------------------------------------------------
    !  Check input arguments for potential over-writing problems.
    ! ----------------------------------------------------------------------
    ERROR=0
    !
    IF ( (nCols * nCols)  >   1) THEN
       MULTRHC = 1
    ELSE
       MULTRHC = 0
    END IF
    !
    ! ==Main Block==--------------------------------------------------------
    ! Subroutine structure :
    ! Loop round levels to be processed.
    ! ----------------------------------------------------------------------
    ! Initialize cloud-top-temperature and last-level-with-ice-cloud arrays
    !CDIR COLLAPSE
    DO i=1,nCols
       CTT(I)=0.0_r8
       LLWIC(I)=0
    END DO
    ! Levels_do1:
    DO K=LEVELS,1,-1
       !
       ! ----------------------------------------------------------------------
       ! 1. Calculate QSAT at liquid/ice water temperature, TL, and initialize
       !    cloud water, sub-grid distribution and fraction arrays.
       !    This requires a preliminary calculation of the pressure.
       !    NB: On entry to the subroutine 'T' is TL and 'Q' is QW.
       ! ----------------------------------------------------------------------
       ! Rows_do1:
       !CDIR COLLAPSE
       ! nCols_do1:
       DO I=1,nCols
          QCL(I,K) = 0.0_r8
          CFL(I,K) = 0.0_r8
          GRID_QC(I,K) = RMDI
          BS(I,K) = RMDI
       END DO ! nCols_do1
       !
       ! DEPENDS ON: qsat_wat_mix
       CALL  qsat_wat_mix ( &
                                !      Output field
            QSL                   ,&! REAL(KIND=r8), intent(out)   ::  QmixS(npnts)
                                ! Output Saturation mixing ratio or saturation specific
                                ! humidity at temperature T and pressure P (kg/kg).
                                !      Input fields
            T             (1,K) ,&! REAL(KIND=r8), intent(in)  :: T(npnts) !  Temperature (K).
            P_theta_levels(1,k) ,&! REAL(KIND=r8), intent(in)  :: P(npnts) !  Pressure (Pa).  
                                !      Array dimensions
            nCols      ,&! Integer, intent(in) :: npnts  ! Points (=horizontal dimensions) being processed by qSAT scheme.
                                !      logical control
            l_mixing_ratio         )! logical, intent(in)  :: lq_mix
       ! .true. return qsat as a mixing ratio
       ! .false. return qsat as a specific humidity

       !
       ! nCols_do2:
       DO I=1,nCols
          IF (MULTRHC==1) THEN
             RHCRITX = RHCRIT(I,K)
          ELSE
             RHCRITX = RHCRIT(1,K)
          END IF

          ! Omit CUMULUS points below (and including) NTML+1

          IF ( .NOT. L_conv4a .OR. (L_conv4a .AND.                     &
               (.NOT. CUMULUS(I) .OR. ( CUMULUS(I)                   &
               .AND. (K  >   NTML(I)+1) ))) ) THEN

             ! Rhcrit_if:
             IF (RHCRITX  <   1.0_r8) THEN
                ! ----------------------------------------------------------------------
                ! 2. Calculate the quantity QN = QC/BS = (QW/QSL-1)/(1-RHcrit)
                !    if RHcrit is less than 1
                ! ----------------------------------------------------------------------
                !
                QN(I) = (Q(I,K) / QSL(I) - 1.0_r8) /                    &
                     (1.0_r8 - RHCRITX)
                !
                ! ----------------------------------------------------------------------
                ! 3. Set logical variable for cloud, LQC, for the case RHcrit < 1;
                !    where QN > -1, i.e. qW/qSAT(TL,P) > RHcrit, there is cloud
                ! ----------------------------------------------------------------------
                !
                LQC(I) = (QN(I)  >   -1.)
             ELSE
                ! ----------------------------------------------------------------------
                ! 2.a Calculate QN = QW - QSL if RHcrit equals 1
                ! ----------------------------------------------------------------------
                !
                QN(I) = Q(I,K) - QSL(I)
                !
                ! ----------------------------------------------------------------------
                ! 3.a Set logical variable for cloud, LQC, for the case RHcrit = 1;
                !     where QN > 0, i.e. qW > qSAT(TL,P), there is cloud
                ! ----------------------------------------------------------------------
                !
                LQC(I) = (QN(I)  >   0.0_r8)
             END IF ! Rhcrit_if
          ELSEIF (L_conv4a) THEN
             LQC(I) = .FALSE.
          END IF  ! Test on CUMULUS and NTML for a05_4a only
       END DO ! nCols_do2
       !
       ! ----------------------------------------------------------------------
       ! 4. Form index of points where non-zero liquid cloud fraction
       ! ----------------------------------------------------------------------
       !
       QC_POINTS=0
       ! nCols_do3:
       DO I=1,nCols
          IF (LQC(I)) THEN
             QC_POINTS = QC_POINTS + 1
             INDEX(QC_POINTS,1) = I
          END IF
       END DO ! nCols_do3
       !
       ! ----------------------------------------------------------------------
       ! 5. Call LS_CLD_C to calculate cloud water content, specific humidity,
       !                  water cloud fraction and determine temperature.
       ! ----------------------------------------------------------------------
       ! Qc_points_if:
       IF (QC_POINTS  >   0) THEN
          ! DEPENDS ON: ls_cld_c
          CALL LS_CLD_C( &
               P_theta_levels  (1,K) , & !REAL(KIND=r8), INTENT(IN) :: P_F(nCols)!  pressure (Pa).
               RHCRIT          (1,K) , & !REAL(KIND=r8), INTENT(IN) :: RHCRIT(nCols)! Critical relative humidity.
               QSL                   , & !REAL(KIND=r8), INTENT(IN) :: QSL_F(nCols)!    saturated humidity at 
               QN                    , & !REAL(KIND=r8), INTENT(IN) :: QN_F(nCols)!   Normalised super/subsaturation
               Q               (1,K) , & !REAL(KIND=r8), INTENT(INOUT) :: Q_F(nCols)!       On input : Vapour + liquid water content (QW)
               T               (1,K) , & !REAL(KIND=r8), INTENT(INOUT) :: T_F(nCols)!       On input : Liquid water temperature (TL)
               QCL             (1,K) , & !REAL(KIND=r8), INTENT(OUT  ) :: QCL_F(nCols)!       Cloud liquid water content 
               CFL             (1,K) , & !REAL(KIND=r8), INTENT(OUT  ) :: CF_F(nCols)!       Liquid cloud fraction at processed levels.
               GRID_QC         (1,K) , & !REAL(KIND=r8), INTENT(OUT  ) :: GRID_QC_F(nCols)!   Super/subsaturation on processed levels
               BS              (1,K) , & !REAL(KIND=r8), INTENT(OUT  ) :: BS_F(nCols)!       Value of bs at processed levels
               INDEX                 , & !INTEGER , INTENT(IN) :: INDEX(nCols,1)! INDEX for  points with non-zero 
               QC_POINTS             , & !INTEGER , INTENT(IN) :: POINTS !       No. of gridpoints with non-zero cloud
               nCols                 , & !INTEGER , INTENT(IN) :: nCols !       No. of gridpoints being processed.
               BL_LEVELS             , & !INTEGER , INTENT(IN) :: BL_LEVELS! No. of boundary layer levels
               K                     , & !INTEGER , INTENT(IN) :: K !  Level no.
               L_eacf                , & !LOGICAL , INTENT(IN) :: L_eacf  !  Use empirically adjusted cloud fraction
               l_mixing_ratio           )!LOGICAL , INTENT(IN) :: L_mixing_ratio   !  Use mixing ratio formulation
       END IF ! Qc_points_if
       !
       ! ----------------------------------------------------------------------
       ! 6. Calculate cloud fractions for ice clouds.
       !    THIS IS STILL HIGHLY EXPERIMENTAL.
       !    Begin by calculating Qsat_wat(T,P), at Temp. T, for estimate of bs.
       ! ----------------------------------------------------------------------
       DO i=1,nCols
          ! Check for last level with cloud and update cloud top temperature
          IF (LLWIC(I)  /=  K+1) THEN
             CTT(I)=T(I,K)
          END IF
          ! Check for significant ice content and update last level with ice cloud
          IF (QCF(I,K)  >   QCFMIN) THEN
             LLWIC(I)=K
          ENDIF
       END DO
       ! DEPENDS ON: qsat_wat_mix
       CALL  qsat_wat_mix ( &
                                !      Output field
            QSL                   ,&! REAL(KIND=r8), intent(out)   ::  QmixS(npnts)
                                ! Output Saturation mixing ratio or saturation specific
                                ! humidity at temperature T and pressure P (kg/kg).
                                !      Input fields
            T             (1,K) ,&! REAL(KIND=r8), intent(in)  :: T(npnts) !  Temperature (K).
            P_theta_levels(1,k) ,&! REAL(KIND=r8), intent(in)  :: P(npnts) !  Pressure (Pa).  
                                !      Array dimensions
            nCols              ,&! Integer, intent(in) :: npnts  ! Points (=horizontal dimensions) being processed by qSAT scheme.
                                !      logical control
            l_mixing_ratio         )! logical, intent(in)  :: lq_mix
       ! .true. return qsat as a mixing ratio
       ! .false. return qsat as a specific humidity

       !        CALL qsat_wat_mix(QSL,T(1,1,K),P_theta_levels(1,1,k),           &
       !                      nCols*rows,l_mixing_ratio)
       ROOTWO = SQRT(2.0_r8)
       IF (ICE_FRACTION_METHOD  ==  2) THEN
          ! Use cloud top temperature and a fixed qsat to give QCFRBS
          ! DEPENDS ON: qsat_wat_mix
          CALL  qsat_wat_mix ( &
                                !      Output field
               QSL_CTT               ,&! REAL(KIND=r8), intent(out)   ::  QmixS(npnts)
                                ! Output Saturation mixing ratio or saturation specific
                                ! humidity at temperature T and pressure P (kg/kg).
                                !      Input fields
               CTT                   ,&! REAL(KIND=r8), intent(in)  :: T(npnts) !  Temperature (K).
               p_theta_levels(1,k) ,&! REAL(KIND=r8), intent(in)  :: P(npnts) !  Pressure (Pa).  
                                !      Array dimensions
               nCols      ,&! Integer, intent(in) :: npnts  ! Points (=horizontal dimensions) being processed by qSAT scheme.
                                !      logical control
               l_mixing_ratio         )! logical, intent(in)  :: lq_mix
          ! .true. return qsat as a mixing ratio
          ! .false. return qsat as a specific humidity

          !          CALL qsat_wat_mix(QSL_CTT,CTT,p_theta_levels(1,1,k),          &
          !                        nCols*rows,l_mixing_ratio)
          SUBGRID = SUB_CLD ** (1.0_r8-T_WEIGHT)                           &
               / QSAT_FIXED ** (1.0_r8-T_WEIGHT-CTT_WEIGHT)
       END IF ! ice_fraction_method eq 2
       !
       ! nCols_do4:
       DO I=1,nCols
          IF ( MULTRHC== 1) THEN
             RHCRITX = RHCRIT(I,K)
          ELSE
             RHCRITX = RHCRIT(1,K)
          ENDIF
          ! ----------------------------------------------------------------------
          ! 6a Calculate qCF/bs.
          ! ----------------------------------------------------------------------
          ! Rhcrit_if2:
          IF (RHCRITX  <   1.0_r8) THEN
             !
             IF (ICE_FRACTION_METHOD  ==  1) THEN
                QCFRBS(i)=  QCF(I,K) / ((1.0_r8-RHCRITX) * QSL(I))
             ELSEIF (ICE_FRACTION_METHOD  ==  2) THEN
                QCFRBS(i) = SUBGRID * QCF(I,K) / ((1.0_r8-RHCRITX)          &
                     * QSL_CTT(I)**CTT_WEIGHT*QSL(I)**T_WEIGHT)
             ELSE
                ! No ice cloud fraction method defined
             END IF ! ice_fraction_method
             !
             ! ----------------------------------------------------------------------
             ! 6b Calculate frozen cloud fraction from frozen cloud water content.
             ! ----------------------------------------------------------------------
             IF (QCFRBS(i)  <=  0.0_r8) THEN
                CFF(I,K) = 0.0_r8
             ELSEIF (0.0_r8  <   QCFRBS(i)  .AND. (6.0_r8 * QCFRBS(i))  <=  1.0_r8) THEN
                CFF(I,K) = 0.5_r8 * ((6.0_r8 * QCFRBS(i))**(2.0_r8/3.0_r8))
             ELSEIF (1.0_r8  <   (6.0_r8*QCFRBS(i)) .AND. QCFRBS(i)  <   1.0_r8) THEN
                PHIQCF = ACOS(ROOTWO * 0.75_r8 * (1.0_r8 - QCFRBS(i)))
                COSQCF = COS((PHIQCF + (4.0_r8 * PI)) / 3.0_r8)
                CFF(I,K) = 1.0_r8 - (4.0_r8 * COSQCF * COSQCF)
             ELSEIF (QCFRBS(i)  >=  1.0_r8) THEN
                CFF(I,K) = 1.0_r8
             END IF
             IF (L_eacf) THEN  ! Empirically adjusted cloud fraction
                ! Back out QN
                IF (0.0_r8 <  QCFRBS(i)  .AND. (6.0_r8 * QCFRBS(i))  <=  1.0_r8) THEN
                   QN_IMP=SQRT(2.0_r8*CFF(I,K))-1.0_r8
                ELSEIF (1.0_r8  <   (6.0_r8*QCFRBS(i)) .AND. QCFRBS(i) <  1.0_r8) THEN
                   QN_IMP=1.0_r8-SQRT((1.0_r8-CFF(I,K))*2.0_r8)
                ELSE
                   QN_IMP = 1.0_r8
                ENDIF

                ! Modify QN with EACF relationship
                IF (K >  BL_LEVELS) THEN
                   QN_ADJ=(QN_IMP+0.0955_r8)/(1.0_r8-0.0955_r8)
                ELSE
                   QN_ADJ=(QN_IMP+0.184_r8)/(1.0_r8-0.184_r8)
                ENDIF

                ! Recalculate ice cloud fraction with modified QN
                IF (QCFRBS(i)  <=  0.0_r8) THEN
                   CFF(I,K) = 0.0_r8
                ELSEIF (QN_ADJ  <=  0.0_r8) THEN
                   CFF(I,K) = 0.5_r8 * (1.0_r8 + QN_ADJ) * (1.0_r8 + QN_ADJ)
                ELSEIF (QN_ADJ  <   1.0_r8) THEN
                   CFF(I,K) = 1.0_r8 - 0.5_r8 * (1.0_r8-QN_ADJ) * (1.0_r8-QN_ADJ)
                ELSE
                   CFF(I,K) = 1.0_r8
                ENDIF

             END IF  ! L_eacf
             !

          ELSE ! RHcrit = 1, set cloud fraction to 1 or 0
             !
             IF (QCF(I,K)  >   0.0_r8) THEN
                CFF(I,K) = 1.0_r8
             ELSE
                CFF(I,K) = 0.0_r8
             ENDIF
             !
          ENDIF
       END DO ! nCols_do4

       ! ----------------------------------------------------------------------
       ! 6c Calculate combined cloud fraction.
       ! ----------------------------------------------------------------------
       ! nCols_do5:
       DO I=1,nCols
          IF (CLOUD_FRACTION_METHOD  ==  1) THEN
             !           Use minimum overlap condition
             CF(I,K) = MIN(CFL(I,K)+CFF(I,K), 1.0_r8)
          ELSEIF (CLOUD_FRACTION_METHOD  ==  2) THEN
             ! Calculate possible overlaps between ice and liquid in THIS layer
             OVERLAP_MAX=MIN(CFL(I,K),CFF(I,K))
             OVERLAP_MIN=MAX(CFL(I,K)+CFF(I,K)-1.0_r8,0.0_r8)
             OVERLAP_RANDOM=CFL(I,K)*CFF(I,K)
             ! Now use the specified degree of overlap to calculate the total
             ! cloud fraction (= cfice + cfliq - overlap)
             TEMP0=OVERLAP_RANDOM
             TEMP1=0.5_r8*(OVERLAP_MAX-OVERLAP_MIN)
             TEMP2=0.5_r8*(OVERLAP_MAX+OVERLAP_MIN)-OVERLAP_RANDOM
             CF(I,K)=CFL(I,K)+CFF(I,K)                                &
                  -(TEMP0+TEMP1*OVERLAP_ICE_LIQUID                    &
                  +TEMP2*OVERLAP_ICE_LIQUID*OVERLAP_ICE_LIQUID)
             ! Check that the overlap wasnt negative
             CF(I,K)=MIN(CF(I,K),CFL(I,K)+CFF(I,K))
          ELSE
             ! No total cloud fraction method defined
          END IF ! cloud_fraction_method
          !
       END DO ! nCols_do5
       !
    END DO ! Levels_do
    !
    RETURN
  END SUBROUTINE LS_CLD


  ! *****************************COPYRIGHT*******************************
  ! (C) Crown copyright Met Office. All rights reserved.
  ! For further details please refer to the file COPYRIGHT.txt
  ! which you should have received as part of this distribution.
  ! *****************************COPYRIGHT*******************************
  !
  !+ Large-scale Cloud Scheme.
  ! Subroutine Interface:
  ! ======================================================================
  !
  !+ Large-scale Cloud Scheme Compression routine (Cloud points only).
  ! Subroutine Interface:
  SUBROUTINE LS_CLD_C( &
       P_F           , &!REAL(KIND=r8)    , INTENT(IN) :: P_F(nCols)!       pressure (Pa).
       RHCRIT        , &!REAL(KIND=r8)    , INTENT(IN) :: RHCRIT(nCols)! Critical relative humidity.
       QSL_F         , &!REAL(KIND=r8)    , INTENT(IN) :: QSL_F(nCols)!       saturated humidity at 
       QN_F          , &!REAL(KIND=r8)    , INTENT(IN) :: QN_F(nCols)!       Normalised super/subsaturation
       Q_F           , &!REAL(KIND=r8)    , INTENT(INOUT) :: Q_F(nCols)!       On input : Vapour + liquid water content (QW)
       T_F           , &!REAL(KIND=r8)    , INTENT(INOUT) :: T_F(nCols)!       On input : Liquid water temperature (TL)
       QCL_F         , &!REAL(KIND=r8)    , INTENT(OUT  ) :: QCL_F(nCols)!       Cloud liquid water content 
       CF_F          , &!REAL(KIND=r8)    , INTENT(OUT  ) :: CF_F(nCols)!       Liquid cloud fraction at processed levels.
       GRID_QC_F     , &!REAL(KIND=r8)    , INTENT(OUT  ) :: GRID_QC_F(nCols)!       Super/subsaturation on processed levels
       BS_F          , &!REAL(KIND=r8)    , INTENT(OUT  ) :: BS_F(nCols)!       Value of bs at processed levels
       INDEX         , &!INTEGER , INTENT(IN) :: INDEX   (nCols,1)! INDEX for  points with non-zero 
       POINTS        , &!INTEGER , INTENT(IN) :: POINTS !       No. of gridpoints with non-zero cloud
       nCols         , &!INTEGER , INTENT(IN) :: nCols !       No. of gridpoints being processed.
       BL_LEVELS     , &!INTEGER , INTENT(IN) :: BL_LEVELS!       No. of boundary layer levels
       K             , &!INTEGER , INTENT(IN) :: K        !        Level no.
       L_eacf        , &!LOGICAL , INTENT(IN) :: L_eacf  !  Use empirically adjusted cloud fraction
       l_mixing_ratio  )!LOGICAL , INTENT(IN) :: L_mixing_ratio   !  Use mixing ratio formulation
    !
    IMPLICIT NONE
    !  Subroutine Arguments:------------------------------------------------
    INTEGER , INTENT(IN) :: nCols !       No. of gridpoints being processed.
    INTEGER , INTENT(IN) :: BL_LEVELS!       No. of boundary layer levels
    INTEGER , INTENT(IN) :: K        !        Level no.
    INTEGER , INTENT(IN) :: POINTS !       No. of gridpoints with non-zero cloud
    INTEGER , INTENT(IN) :: INDEX   (nCols,1)! INDEX for  points with non-zero cloud from lowest model level.
    !
    REAL(KIND=r8)    , INTENT(IN) :: RHCRIT(nCols)! Critical relative humidity.  See the paragraph incorporating
    !       eqs P292.11 to P292.14.
    REAL(KIND=r8)    , INTENT(IN) :: P_F(nCols)!       pressure (Pa).
    REAL(KIND=r8)    , INTENT(IN) :: QSL_F(nCols)!       saturated humidity at temperature TL, and pressure P_F
    REAL(KIND=r8)    , INTENT(IN) :: QN_F(nCols)!       Normalised super/subsaturation ( = QC/BS).
    !
    LOGICAL , INTENT(IN) :: L_eacf  !  Use empirically adjusted cloud fraction
    LOGICAL , INTENT(IN) :: L_mixing_ratio   !  Use mixing ratio formulation
    !
    REAL(KIND=r8)    , INTENT(INOUT) :: Q_F(nCols)!       On input : Vapour + liquid water content (QW) (kg per kg air).
    !       On output: Specific humidity at processed levels
    !                   (kg water per kg air).
    REAL(KIND=r8)    , INTENT(INOUT) :: T_F(nCols)!       On input : Liquid water temperature (TL) (K).
    !       On output: Temperature at processed levels (K).
    !
    REAL(KIND=r8)    , INTENT(OUT  ) :: QCL_F(nCols)!       Cloud liquid water content at processed levels (kg per kg air).
    REAL(KIND=r8)    , INTENT(OUT  ) :: CF_F(nCols)!       Liquid cloud fraction at processed levels.
    REAL(KIND=r8)    , INTENT(OUT  ) :: GRID_QC_F(nCols)!       Super/subsaturation on processed levels. Input initially RMDI.
    REAL(KIND=r8)    , INTENT(OUT  ) :: BS_F(nCols)!       Value of bs at processed levels. Input initialized to RMDI.

    !
    ! Purpose: Calculates liquid cloud water amounts and cloud amounts,
    !          temperature and specific humidity from cloud-conserved and
    !          other model variables. This is done for one model level.
    !
    ! Current Owner of Code: A. C. Bushell
    !
    ! History:
    ! Version   Date     Comment
    !  4.4    14-11-96   Original Code (A. C. Bushell from Wilson/Ballard)
    !  6.2    07-11-05   Include the EACF parametrization for cloud
    !                    fraction.                            D. Wilson
    !  6.4    08-08-06   Include mixing ratio formulation. D. Wilson
    !
    ! Description of Code:
    !   FORTRAN 77  + common extensions also in Fortran90.
    !   This code is written to UMDP3 version 6 programming standards.
    !
    !   Documentation: UMDP No.29
    !
    !  Global Variables:----------------------------------------------------
    !*L------------------COMDECK C_R_CP-------------------------------------
    ! History:
    ! Version  Date      Comment.
    !  5.0  07/05/99  Add variable P_zero for consistency with
    !                 conversion to C-P 'C' dynamics grid. R. Rawlins
    !  5.1  07/03/00  Fixed/Free format conversion   P. Selwood

    ! R IS GAS CONSTANT FOR DRY AIR
    ! CP IS SPECIFIC HEAT OF DRY AIR AT CONSTANT PRESSURE
    ! PREF IS REFERENCE SURFACE PRESSURE

    REAL(KIND=r8), PARAMETER  :: R      = 287.05_r8
    REAL(KIND=r8), PARAMETER  :: CP     = 1005.0_r8
    REAL(KIND=r8), PARAMETER  :: Kappa  = R/CP
    REAL(KIND=r8), PARAMETER  :: Pref   = 100000.0_r8

    ! Reference surface pressure = PREF
    REAL(KIND=r8), PARAMETER  :: P_zero = Pref
    REAL(KIND=r8), PARAMETER  :: sclht  = 6.8E+03_r8  ! Scale Height H
    !*----------------------------------------------------------------------
    !*L------------------COMDECK C_EPSLON-----------------------------------
    ! EPSILON IS RATIO OF MOLECULAR WEIGHTS OF WATER AND DRY AIR

    REAL(KIND=r8), PARAMETER :: Epsilon   = 0.62198_r8
    REAL(KIND=r8), PARAMETER :: C_Virtual = 1.0_r8/Epsilon-1.0_r8

    !*----------------------------------------------------------------------
    ! C_LHEAT start

    ! latent heat of condensation of water at 0degc
    REAL(KIND=r8),PARAMETER:: LC=2.501E6_r8

    ! latent heat of fusion at 0degc
    REAL(KIND=r8),PARAMETER:: LF=0.334E6_r8

    ! C_LHEAT end
    !
    !
    !  Local parameters and other physical constants------------------------
    REAL(KIND=r8), PARAMETER :: ALPHL=EPSILON*LC/R ! For liquid AlphaL calculation.
    REAL(KIND=r8), PARAMETER :: LCRCP=LC/CP    ! Lat ht of condensation/Cp.
    INTEGER , PARAMETER :: ITS=5    ! Total number of iterations
    INTEGER , PARAMETER :: WTN=0.75_r8  ! Weighting for ALPHAL iteration
    !
    !  Local scalars--------------------------------------------------------
    !
    !  (a) Scalars effectively expanded to workspace by the Cray (using
    !      vector registers).
    REAL(KIND=r8)  :: AL                         ! LOCAL AL (see equation P292.6).
    REAL(KIND=r8)  :: ALPHAL
    ! LOCAL ALPHAL (see equation P292.5).
    REAL(KIND=r8)  :: QN_ADJ
    REAL(KIND=r8)  :: RHCRITX          ! scalar copy of RHCRIT(I,J)
    INTEGER   :: MULTRHC          ! Zero if (nCols*nCols) le 1, else 1
    !
    !  (b) Others.
    INTEGER   I,II,N   ! Loop counters:I,II-horizontal field index.
    !                                       : N - iteration counter.
    !
    !  Local dynamic arrays-------------------------------------------------
    !    7 blocks of REAL(KIND=r8) workspace are required.
    REAL(KIND=r8)  :: P(POINTS)
    !       Pressure  (Pa).
    REAL(KIND=r8)  :: QS(POINTS)
    !       Saturated spec humidity for temp T.
    REAL(KIND=r8)  :: QCN(POINTS)
    !       Cloud water normalised with BS.
    REAL(KIND=r8)  :: T(POINTS)
    !       temperature.
    REAL(KIND=r8)  :: Q(POINTS)
    !       specific humidity.
    REAL(KIND=r8)  :: BS(POINTS)
    !       Sigmas*sqrt(6): sigmas the parametric standard deviation of
    !       local cloud water content fluctuations.
    REAL(KIND=r8)  :: ALPHAL_NM1(POINTS)
    !       ALPHAL at previous iteration.
    !
    !  External subroutine calls: ------------------------------------------
    !      EXTERNAL QSAT_WAT
    !
    !- End of Header
    !
    ! ==Main Block==--------------------------------------------------------
    ! Operate on INDEXed points with non-zero cloud fraction.
    ! ----------------------------------------------------------------------
    IF ( (nCols * nCols)  >   1) THEN
       MULTRHC = 1
    ELSE
       MULTRHC = 0
    END IF
    !
    !        RHCRITX = RHCRIT(1,1)
    ! Points_do1:
    !CDIR NODEP
    DO I=1, POINTS
       II = INDEX(I,1)
       IF ( MULTRHC== 1) THEN
          RHCRITX = RHCRIT(II)
       ELSE
          RHCRITX = RHCRIT(1)
       ENDIF
       P(I)  = P_F(II)
       QCN(I)= QN_F(II)
       ! ----------------------------------------------------------------------
       ! 1. Calculate ALPHAL (eq P292.5) and AL (P292.6).
       !    CAUTION: T_F acts as TL (input value) until update in final section
       !    CAUTION: Q_F acts as QW (input value) until update in final section
       ! ----------------------------------------------------------------------
       !
       ALPHAL = ALPHL * QSL_F(II) / (T_F(II) * T_F(II)) !P292.5
       AL = 1.0_r8 / (1.0_r8 + (LCRCP * ALPHAL))                    ! P292.6
       ALPHAL_NM1(I) = ALPHAL
       !
       ! Rhcrit_if1:
       IF (RHCRITX  <   1.0_r8) THEN
          ! ----------------------------------------------------------------------
          ! 2. Calculate BS (ie. sigma*sqrt(6), where sigma is
          !    as in P292.14) and normalised cloud water QCN=qc/BS, using eqs
          !    P292.15 & 16 if RHcrit < 1.
          ! N.B. QN (input) is initially in QCN
          ! N.B. QN does not depend on AL and so CF and QCN can be calculated
          !      outside the iteration (which is performed in LS_CLD_C).
          !      QN is > -1 for all points processed so CF > 0.
          ! ----------------------------------------------------------------------
          !
          BS(I) = (1.0_r8-RHCRITX) * AL * QSL_F(II)  ! P292.14
          IF (QCN(I)  <=  0.0_r8) THEN
             CF_F(II) = 0.5_r8 * (1.0_r8 + QCN(I)) * (1.0_r8 + QCN(I))
             QCN(I)= (1.0_r8 + QCN(I)) * (1.0_r8 + QCN(I)) * (1.0_r8 + QCN(I)) / 6.0_r8
          ELSEIF (QCN(I)  <   1.0_r8) THEN
             CF_F(II) = 1.0_r8 - 0.5_r8 * (1.0_r8 - QCN(I)) * (1.0_r8 - QCN(I))
             QCN(I)=QCN(I) + (1.0_r8-QCN(I)) * (1.0_r8-QCN(I)) * (1.0_r8-QCN(I))/6.0_r8
          ELSE ! QN  >=  1
             CF_F(II) = 1.0_r8
          END IF ! QCN_if
          !
          ! ----------------------------------------------------------------------
          ! 3.b If necessary, modify cloud fraction using empirically adjusted
          !     cloud fraction parametrization, but keep liquid content the same.
          ! ----------------------------------------------------------------------
          IF (L_eacf) THEN
             ! Adjust QN according to EACF parametrization

             IF (K <= BL_LEVELS) THEN
                QN_ADJ=(QN_F(II)+0.184_r8)/(1.0_r8-0.184_r8)
             ELSE
                QN_ADJ=(QN_F(II)+0.0955_r8)/(1.0_r8-0.0955_r8)
             ENDIF

             !         Calculate cloud fraction using adjusted QN
             IF (QN_ADJ  <=  0.0_r8) THEN
                CF_F(II) = 0.5_r8 * (1.0_r8 + QN_ADJ) * (1.0_r8 + QN_ADJ)
             ELSEIF (QN_ADJ  <   1.0_r8) THEN
                CF_F(II) = 1.0_r8 - 0.5_r8 * (1.0_r8 - QN_ADJ) * (1.0_r8 - QN_ADJ)
             ELSE ! QN_ADJ  >=  1
                CF_F(II) = 1.0_r8
             ENDIF ! QN_ADJ_if

          ENDIF  ! l_eacf
          !
       ELSE ! i.e. if RHcrit = 1
          ! ----------------------------------------------------------------------
          ! 3.a If RHcrit = 1., all points processed have QN > 0 and CF = 1.
          ! ----------------------------------------------------------------------
          BS(I) = AL
          CF_F(II) = 1.0_r8
       END IF ! Rhcrit_if1
       !
       ! ----------------------------------------------------------------------
       ! 3.1 Calculate 1st approx. to qc (store in QCL)
       ! ----------------------------------------------------------------------
       !
       QCL_F(II) = QCN(I) * BS(I)
       !
       ! ----------------------------------------------------------------------
       ! 3.2 Calculate 1st approx. specific humidity (total minus cloud water)
       ! ----------------------------------------------------------------------
       !
       Q(I) = Q_F(II) - QCL_F(II)
       !
       ! ----------------------------------------------------------------------
       ! 3.3 Calculate 1st approx. to temperature, adjusting for latent heating
       ! ----------------------------------------------------------------------
       !
       T(I) = T_F(II) + LCRCP*QCL_F(II)
    END DO ! Points_do1
    !
    ! ----------------------------------------------------------------------
    ! 4. Iteration to find better cloud water values.
    ! ----------------------------------------------------------------------
    ! Its_if:
    IF (ITS  >=  2) THEN
       ! Its_do:
       DO N=2, ITS
          !
          ! DEPENDS ON: qsat_wat_mix
          CALL  qsat_wat_mix ( &
                                !      Output field
               QS                   ,&! REAL(KIND=r8), intent(out)   ::  QmixS(npnts)
                                ! Output Saturation mixing ratio or saturation specific
                                ! humidity at temperature T and pressure P (kg/kg).
                                !      Input fields
               T                    ,&! REAL(KIND=r8), intent(in)  :: T(npnts) !  Temperature (K).
               P                    ,&! REAL(KIND=r8), intent(in)  :: P(npnts) !  Pressure (Pa).  
                                !      Array dimensions
               POINTS               ,&! Integer, intent(in) :: npnts  ! Points (=horizontal dimensions) being processed by qSAT scheme.
                                !      logical control
               l_mixing_ratio         )! logical, intent(in)  :: lq_mix
          ! .true. return qsat as a mixing ratio
          ! .false. return qsat as a specific humidity

          !          CALL qsat_wat_mix(QS,T,P,POINTS,l_mixing_ratio)
          ! Points_do2:
          RHCRITX = RHCRIT(1)
          DO I=1, POINTS
             II = INDEX(I,1)
             IF ( MULTRHC== 1) THEN
                RHCRITX = RHCRIT(II)
             ELSE
                RHCRITX = RHCRIT(1)
             ENDIF
             ! T_if:
             IF (T(I)  >   T_F(II)) THEN
                !           NB. T > TL implies cloud fraction > 0.
                ALPHAL = (QS(I) - QSL_F(II)) / (T(I) - T_F(II))
                ALPHAL = WTN * ALPHAL + (1.0_r8 - WTN) * ALPHAL_NM1(I)
                ALPHAL_NM1(I) = ALPHAL
                AL = 1.0_r8 / (1.0_r8 + (LCRCP * ALPHAL))
                ! Rhcrit_if2:
                IF (RHCRITX  <   1.0_r8) THEN
                   BS(I) = (1.0_r8-RHCRITX) * AL * QSL_F(II)
                   !                                                             P292.14
                ELSE
                   BS(I) = AL
                END IF  ! Rhcrit_if2
                !
                ! ----------------------------------------------------------------------
                ! 4.1 Calculate Nth approx. to qc (store in QCL).
                ! ----------------------------------------------------------------------
                !
                QCL_F(II) = QCN(I) * BS(I)
                !
                ! ----------------------------------------------------------------------
                ! 4.2 Calculate Nth approx. spec. humidity (total minus cloud water).
                ! ----------------------------------------------------------------------
                !
                Q(I) = Q_F(II) - QCL_F(II)
                !
                ! ----------------------------------------------------------------------
                ! 4.3 Calculate Nth approx. to temperature, adjusting for latent heating
                ! ----------------------------------------------------------------------
                !
                T(I) = T_F(II) + LCRCP * QCL_F(II)
                !
             END IF ! T_if
          END DO ! Points_do2
       END DO ! Its_do
    END IF ! Its_if
    !
    ! ----------------------------------------------------------------------
    ! 5. Finally scatter back cloud point results to full field arrays.
    !    CAUTION: T_F updated from TL (input) to T (output)
    !    CAUTION: Q_F updated from QW (input) to Q (output)
    ! ----------------------------------------------------------------------
    !
    !DIR$ IVDEP
    ! Points_do3:
    DO I=1,POINTS
       II = INDEX(I,1)
       Q_F(II) = Q(I)
       T_F(II) = T(I)
       GRID_QC_F(II) = BS(I) * QN_F(II)
       BS_F(II) = BS(I)
    END DO ! Points_do3
    !
    RETURN
  END SUBROUTINE LS_CLD_C
  ! ======================================================================

  ! *****************************COPYRIGHT*******************************
  ! (C) Crown copyright Met Office. All rights reserved.
  ! For further details please refer to the file COPYRIGHT.txt
  ! which you should have received as part of this distribution.
  ! *****************************COPYRIGHT*******************************
  !
  !+ Saturation Specific Humidity Scheme (Qsat_Wat): Vapour to Liquid.
  ! Subroutine Interface:
  SUBROUTINE qsat_wat_mix ( &
                                !      Output field
       &  QmixS            &! REAL(KIND=r8), intent(out)   ::  QmixS(npnts)
                                ! Output Saturation mixing ratio or saturation specific
                                ! humidity at temperature T and pressure P (kg/kg).
                                !      Input fields
       &, T                &! REAL(KIND=r8), intent(in)  :: T(npnts) !  Temperature (K).
       &, P                &! REAL(KIND=r8), intent(in)  :: P(npnts) !  Pressure (Pa).  
                                !      Array dimensions
       &, NPNTS            &! Integer, intent(in) :: npnts  ! Points (=horizontal dimensions) being processed by qSAT scheme.
                                !      logical control
       &, lq_mix           &! logical, intent(in)  :: lq_mix
                                ! .true. return qsat as a mixing ratio
                                ! .false. return qsat as a specific humidity
       &  )

    IMPLICIT NONE

    ! Purpose:
    !   Returns a saturation specific humidity or mixing ratio given a
    !   temperature and pressure using the saturation vapour pressure
    !   calculated using the Goff-Gratch formulae, adopted by the WMO as
    !   taken from Landolt-Bornstein, 1987 Numerical Data and Functional
    !   Relationships in Science and Technolgy. Group V/vol 4B meteorology.
    !   Phyiscal and Chemical properties or air, P35.
    !
    !   Values in the lookup table are over water above and below 0 deg C.
    !
    !   Note : For vapour pressure over water this formula is valid for
    !   temperatures between 373K and 223K. The values for saturated vapour
    !   over water in the lookup table below are out of the lower end of
    !   this range. However it is standard WMO practice to use the formula
    !   below its accepted range for use with the calculation of dew points
    !   in the upper atmosphere
    !
    ! Method:
    !   Uses lookup tables to find eSAT, calculates qSAT directly from that.
    !
    ! Current Owner of Code: Owner of large-scale cloud code.
    !
    ! Code Description:
    !   Language: FORTRAN 77  + common extensions also in Fortran90.
    !   This code is written to UMDP3 version 6 programming standards.
    !
    !   Documentation: UMDP No.29
    !
    ! Declarations:
    !
    !  Global Variables:----------------------------------------------------
    !
    !  Subroutine Arguments:------------------------------------------------
    !
    ! arguments with intent in. ie: input variables.

    INTEGER, INTENT(in) :: npnts
    ! Points (=horizontal dimensions) being processed by qSAT scheme.

    REAL(KIND=r8), INTENT(in)  :: T(npnts) !  Temperature (K).
    REAL(KIND=r8), INTENT(in)  :: P(npnts) !  Pressure (Pa).  

    LOGICAL, INTENT(in)  :: lq_mix
    !  .true. return qsat as a mixing ratio
    !  .false. return qsat as a specific humidity

    ! arguments with intent out

    REAL(KIND=r8), INTENT(out)   ::  QmixS(npnts)
    ! Output Saturation mixing ratio or saturation specific
    ! humidity at temperature T and pressure P (kg/kg).

    !-----------------------------------------------------------------------
    !  Local scalars
    !-----------------------------------------------------------------------

    INTEGER :: itable, itable_p1    ! Work variables

    REAL(KIND=r8) :: atable, atable_p1       ! Work variables

    REAL(KIND=r8) :: fsubw, fsubw_p1    
    ! FACTOR THAT CONVERTS FROM SAT VAPOUR PRESSURE IN A PURE 
    ! WATER SYSTEM TO SAT VAPOUR PRESSURE IN AIR.

    REAL(KIND=r8) :: TT, TT_P1

    REAL(KIND=r8), PARAMETER :: R_delta_T = 1.0_r8/delta_T

    INTEGER :: I, II 

    !-----------------------------------------------------------------------
    ! loop over points

    DO i = 1, npnts-1, 2

       !      Compute the factor that converts from sat vapour pressure in a
       !      pure water system to sat vapour pressure in air, fsubw.
       !      This formula is taken from equation A4.7 of Adrian Gill's book:
       !      Atmosphere-Ocean Dynamics. Note that his formula works in terms
       !      of pressure in mb and temperature in Celsius, so conversion of
       !      units leads to the slightly different equation used here.

       fsubw    = 1.0_r8 + 1.0E-8_r8*P(I)   * ( 4.5_r8 +                        &
            6.0E-4_r8*( T(I)   - zerodegC ) * ( T(I) - zerodegC ) )
       fsubw_p1 = 1.0_r8 + 1.0E-8_r8*P(I+1) * ( 4.5_r8 +                        &
            6.0E-4_r8*( T(I+1) - zerodegC ) * ( T(I+1) - zerodegC ) )

       !      Use the lookup table to find saturated vapour pressure, and store
       !      it in qmixs.

       TT = MAX(T_low,T(I))
       TT = MIN(T_high,TT)
       atable = (TT - T_low + delta_T) * R_delta_T
       itable = INT(atable)
       atable = atable - itable

       TT_p1 = MAX(T_low,T(I+1))
       TT_p1 = MIN(T_high,TT_p1)
       atable_p1 = (TT_p1 - T_low + delta_T) * R_delta_T
       itable_p1 = INT(atable_p1)
       atable_p1 = atable_p1 - itable_p1

       QmixS(I)   = (1.0_r8 - atable)    * ESW2(itable)    +                  &
            atable*ESW2(itable+1)
       QmixS(I+1) = (1.0_r8 - atable_p1) * ESW2(itable_p1) +                  &
            atable_p1*ESW2(itable_p1+1)

       !      Multiply by fsubw to convert to saturated vapour pressure in air
       !      (equation A4.6 of Adrian Gill's book).

       QmixS(I)   = QmixS(I)   * fsubw
       QmixS(I+1) = QmixS(I+1) * fsubw_p1

       !      Now form the accurate expression for qmixs, which is a rearranged
       !      version of equation A4.3 of Gill's book.

       !-----------------------------------------------------------------------
       ! For mixing ratio,  rsat = epsilon *e/(p-e)
       ! e - saturation vapour pressure
       ! Note applying the fix to qsat for specific humidity at low pressures
       ! is not possible, this implies mixing ratio qsat tends to infinity.
       ! If the pressure is very low then the mixing ratio value may become
       ! very large.
       !-----------------------------------------------------------------------
       IF (lq_mix) THEN
          QmixS(I)   = ( epsilon*QmixS(I) ) /                            &
               ( MAX(P(I),  1.1_r8*QmixS(I))   - QmixS(I) )
          QmixS(I+1) = ( epsilon*QmixS(I+1) ) /                          &
               ( MAX(P(I+1),1.1_r8*QmixS(I+1)) - QmixS(I+1) )
          !-----------------------------------------------------------------------
          ! For specific humidity,   qsat = epsilon*e/(p-(1-epsilon)e)
          !
          ! Note that at very low pressure we apply a fix, to prevent a
          ! singularity (qsat tends to 1. kg/kg).
          !-----------------------------------------------------------------------
       ELSE
          QmixS(I)   = ( epsilon*QmixS(I) ) /                            &
               ( MAX(P(I),  QmixS(I))   - one_minus_epsilon*QmixS(I) )
          QmixS(I+1) = ( epsilon*QmixS(I+1) ) /                          &
               ( MAX(P(I+1),QmixS(I+1)) - one_minus_epsilon*QmixS(I+1))
       ENDIF  ! test on lq_mix
    END DO  ! Npnts_do_1

    ii = i
    DO i = ii, npnts
       fsubw = 1.0_r8 + 1.0E-8_r8*P(I)*( 4.5_r8 +                               &
            &    6.0E-4_r8*( T(I) - zerodegC )*( T(I) - zerodegC ) )

       TT = MAX(T_low,T(I))
       TT = MIN(T_high,TT)
       atable = (TT - T_low + delta_T) * R_delta_T
       itable = INT(atable)
       atable = atable - itable

       QmixS(I) = (1.0_r8 - atable)*ESW2(itable) + atable*ESW2(itable+1)
       QmixS(I) = QmixS(I) * fsubw

       IF (lq_mix) THEN
          QmixS(I) = ( epsilon*QmixS(I) ) /                              &
               &              ( MAX(P(I),1.1_r8*QmixS(i)) - QmixS(I) )
       ELSE
          QmixS(I) = ( epsilon*QmixS(I) ) /                              &
               &               ( MAX(P(I),QmixS(I)) - one_minus_epsilon*QmixS(I) )
       ENDIF  ! test on lq_mix
    END DO  ! Npnts_do_1

    RETURN
  END SUBROUTINE qsat_wat_mix
  ! ======================================================================
  ! ======================================================================
  ! *****************************COPYRIGHT*******************************
  ! (C) Crown copyright Met Office. All rights reserved.
  ! For further details please refer to the file COPYRIGHT.txt
  ! which you should have received as part of this distribution.
  ! *****************************COPYRIGHT*******************************
  !
  SUBROUTINE qsat_wat_data()
    !
    !  Local dynamic arrays-------------------------------------------------
    REAL(KIND=r8) :: ESW_Aux(0:N+1)    ! TABLE OF SATURATION WATER VAPOUR PRESSURE (PA)
    !                       - SET BY DATA STATEMENT CALCULATED FROM THE
    !                         GOFF-GRATCH FORMULAE AS TAKEN FROM LANDOLT-
    !                         BORNSTEIN, 1987 NUMERICAL DATA AND FUNCTIONAL
    !                         RELATIONSHIPS IN SCIENCE AND TECHNOLOGY.
    !                         GROUP V/ VOL 4B METEOROLOGY. PHYSICAL AND
    !                         CHEMICAL PROPERTIES OF AIR, P35
    !

    ! ----------------------------------------------------------------------
    ! SATURATION WATER VAPOUR PRESSURE
    !
    ! ABOVE 0 DEG C VALUES ARE OVER WATER
    !
    ! BELOW 0 DEC C VALUES ARE OVER ICE
    ! ----------------------------------------------------------------------
    ! Note: 0 element is a repeat of 1st element to cater for special case
    !       of low temperatures ( <= T_LOW) for which the array index is
    !       rounded down due to machine precision.
    ! ----------------------------------------------------------------------
    ! SATURATION WATER VAPOUR PRESSURE
    !
    ! VALUES ABOVE AND BELOW 0 DEG C ARE OVER WATER
    !
    ! VALUES BELOW -50 DEC C ARE OUTSIDE FORMAL RANGE OF WMO ADOPTED FORMULA
    ! (SEE ABOVE).  HOWEVER STANDARD PRACTICE TO USE THESE VALUES
    ! ----------------------------------------------------------------------
    ! Note: 0 element is a repeat of 1st element to cater for special case
    !       of low temperatures ( <= T_LOW) for which the array index is
    !       rounded down due to machine precision.
    DATA (ESW_Aux(IESW),IESW=    0, 95) / 0.186905E-01_r8,                      &
         0.186905E-01_r8,0.190449E-01_r8,0.194059E-01_r8,0.197727E-01_r8,0.201462E-01_r8, &
         0.205261E-01_r8,0.209122E-01_r8,0.213052E-01_r8,0.217050E-01_r8,0.221116E-01_r8, &
         0.225252E-01_r8,0.229463E-01_r8,0.233740E-01_r8,0.238090E-01_r8,0.242518E-01_r8, &
         0.247017E-01_r8,0.251595E-01_r8,0.256252E-01_r8,0.260981E-01_r8,0.265795E-01_r8, &
         0.270691E-01_r8,0.275667E-01_r8,0.280733E-01_r8,0.285876E-01_r8,0.291105E-01_r8, &
         0.296429E-01_r8,0.301835E-01_r8,0.307336E-01_r8,0.312927E-01_r8,0.318611E-01_r8, &
         0.324390E-01_r8,0.330262E-01_r8,0.336232E-01_r8,0.342306E-01_r8,0.348472E-01_r8, &
         0.354748E-01_r8,0.361117E-01_r8,0.367599E-01_r8,0.374185E-01_r8,0.380879E-01_r8, &
         0.387689E-01_r8,0.394602E-01_r8,0.401626E-01_r8,0.408771E-01_r8,0.416033E-01_r8, &
         0.423411E-01_r8,0.430908E-01_r8,0.438524E-01_r8,0.446263E-01_r8,0.454124E-01_r8, &
         0.462122E-01_r8,0.470247E-01_r8,0.478491E-01_r8,0.486874E-01_r8,0.495393E-01_r8, &
         0.504057E-01_r8,0.512847E-01_r8,0.521784E-01_r8,0.530853E-01_r8,0.540076E-01_r8, &
         0.549444E-01_r8,0.558959E-01_r8,0.568633E-01_r8,0.578448E-01_r8,0.588428E-01_r8, &
         0.598566E-01_r8,0.608858E-01_r8,0.619313E-01_r8,0.629926E-01_r8,0.640706E-01_r8, &
         0.651665E-01_r8,0.662795E-01_r8,0.674095E-01_r8,0.685570E-01_r8,0.697219E-01_r8, &
         0.709063E-01_r8,0.721076E-01_r8,0.733284E-01_r8,0.745679E-01_r8,0.758265E-01_r8, &
         0.771039E-01_r8,0.784026E-01_r8,0.797212E-01_r8,0.810577E-01_r8,0.824164E-01_r8, &
         0.837971E-01_r8,0.851970E-01_r8,0.866198E-01_r8,0.880620E-01_r8,0.895281E-01_r8, &
         0.910178E-01_r8,0.925278E-01_r8,0.940622E-01_r8,0.956177E-01_r8,0.971984E-01_r8/
    DATA (ESW_Aux(IESW),IESW= 96,190) /                                      &
         0.988051E-01_r8,0.100433E+00_r8,0.102085E+00_r8,0.103764E+00_r8,0.105467E+00_r8, &
         0.107196E+00_r8,0.108953E+00_r8,0.110732E+00_r8,0.112541E+00_r8,0.114376E+00_r8, &
         0.116238E+00_r8,0.118130E+00_r8,0.120046E+00_r8,0.121993E+00_r8,0.123969E+00_r8, &
         0.125973E+00_r8,0.128009E+00_r8,0.130075E+00_r8,0.132167E+00_r8,0.134296E+00_r8, &
         0.136452E+00_r8,0.138642E+00_r8,0.140861E+00_r8,0.143115E+00_r8,0.145404E+00_r8, &
         0.147723E+00_r8,0.150078E+00_r8,0.152466E+00_r8,0.154889E+00_r8,0.157346E+00_r8, &
         0.159841E+00_r8,0.162372E+00_r8,0.164939E+00_r8,0.167545E+00_r8,0.170185E+00_r8, &
         0.172866E+00_r8,0.175584E+00_r8,0.178340E+00_r8,0.181139E+00_r8,0.183977E+00_r8, &
         0.186855E+00_r8,0.189773E+00_r8,0.192737E+00_r8,0.195736E+00_r8,0.198783E+00_r8, &
         0.201875E+00_r8,0.205007E+00_r8,0.208186E+00_r8,0.211409E+00_r8,0.214676E+00_r8, &
         0.217993E+00_r8,0.221355E+00_r8,0.224764E+00_r8,0.228220E+00_r8,0.231728E+00_r8, &
         0.235284E+00_r8,0.238888E+00_r8,0.242542E+00_r8,0.246251E+00_r8,0.250010E+00_r8, &
         0.253821E+00_r8,0.257688E+00_r8,0.261602E+00_r8,0.265575E+00_r8,0.269607E+00_r8, &
         0.273689E+00_r8,0.277830E+00_r8,0.282027E+00_r8,0.286287E+00_r8,0.290598E+00_r8, &
         0.294972E+00_r8,0.299405E+00_r8,0.303904E+00_r8,0.308462E+00_r8,0.313082E+00_r8, &
         0.317763E+00_r8,0.322512E+00_r8,0.327324E+00_r8,0.332201E+00_r8,0.337141E+00_r8, &
         0.342154E+00_r8,0.347234E+00_r8,0.352387E+00_r8,0.357601E+00_r8,0.362889E+00_r8, &
         0.368257E+00_r8,0.373685E+00_r8,0.379194E+00_r8,0.384773E+00_r8,0.390433E+00_r8, &
         0.396159E+00_r8,0.401968E+00_r8,0.407861E+00_r8,0.413820E+00_r8,0.419866E+00_r8/
    DATA (ESW_Aux(IESW),IESW=191,285) /                                      &
         0.425999E+00_r8,0.432203E+00_r8,0.438494E+00_r8,0.444867E+00_r8,0.451332E+00_r8, &
         0.457879E+00_r8,0.464510E+00_r8,0.471226E+00_r8,0.478037E+00_r8,0.484935E+00_r8, &
         0.491920E+00_r8,0.499005E+00_r8,0.506181E+00_r8,0.513447E+00_r8,0.520816E+00_r8, &
         0.528279E+00_r8,0.535835E+00_r8,0.543497E+00_r8,0.551256E+00_r8,0.559113E+00_r8, &
         0.567081E+00_r8,0.575147E+00_r8,0.583315E+00_r8,0.591585E+00_r8,0.599970E+00_r8, &
         0.608472E+00_r8,0.617069E+00_r8,0.625785E+00_r8,0.634609E+00_r8,0.643556E+00_r8, &
         0.652611E+00_r8,0.661782E+00_r8,0.671077E+00_r8,0.680487E+00_r8,0.690015E+00_r8, &
         0.699656E+00_r8,0.709433E+00_r8,0.719344E+00_r8,0.729363E+00_r8,0.739518E+00_r8, &
         0.749795E+00_r8,0.760217E+00_r8,0.770763E+00_r8,0.781454E+00_r8,0.792258E+00_r8, &
         0.803208E+00_r8,0.814309E+00_r8,0.825528E+00_r8,0.836914E+00_r8,0.848422E+00_r8, &
         0.860086E+00_r8,0.871891E+00_r8,0.883837E+00_r8,0.895944E+00_r8,0.908214E+00_r8, &
         0.920611E+00_r8,0.933175E+00_r8,0.945890E+00_r8,0.958776E+00_r8,0.971812E+00_r8, &
         0.985027E+00_r8,0.998379E+00_r8,0.101193E+01_r8,0.102561E+01_r8,0.103949E+01_r8, &
         0.105352E+01_r8,0.106774E+01_r8,0.108213E+01_r8,0.109669E+01_r8,0.111144E+01_r8, &
         0.112636E+01_r8,0.114148E+01_r8,0.115676E+01_r8,0.117226E+01_r8,0.118791E+01_r8, &
         0.120377E+01_r8,0.121984E+01_r8,0.123608E+01_r8,0.125252E+01_r8,0.126919E+01_r8, &
         0.128604E+01_r8,0.130309E+01_r8,0.132036E+01_r8,0.133782E+01_r8,0.135549E+01_r8, &
         0.137339E+01_r8,0.139150E+01_r8,0.140984E+01_r8,0.142839E+01_r8,0.144715E+01_r8, &
         0.146616E+01_r8,0.148538E+01_r8,0.150482E+01_r8,0.152450E+01_r8,0.154445E+01_r8/
    DATA (ESW_Aux(IESW),IESW=286,380) /                                      &
         0.156459E+01_r8,0.158502E+01_r8,0.160564E+01_r8,0.162654E+01_r8,0.164766E+01_r8, &
         0.166906E+01_r8,0.169070E+01_r8,0.171257E+01_r8,0.173473E+01_r8,0.175718E+01_r8, &
         0.177984E+01_r8,0.180282E+01_r8,0.182602E+01_r8,0.184951E+01_r8,0.187327E+01_r8, &
         0.189733E+01_r8,0.192165E+01_r8,0.194629E+01_r8,0.197118E+01_r8,0.199636E+01_r8, &
         0.202185E+01_r8,0.204762E+01_r8,0.207372E+01_r8,0.210010E+01_r8,0.212678E+01_r8, &
         0.215379E+01_r8,0.218109E+01_r8,0.220873E+01_r8,0.223668E+01_r8,0.226497E+01_r8, &
         0.229357E+01_r8,0.232249E+01_r8,0.235176E+01_r8,0.238134E+01_r8,0.241129E+01_r8, &
         0.244157E+01_r8,0.247217E+01_r8,0.250316E+01_r8,0.253447E+01_r8,0.256617E+01_r8, &
         0.259821E+01_r8,0.263064E+01_r8,0.266341E+01_r8,0.269661E+01_r8,0.273009E+01_r8, &
         0.276403E+01_r8,0.279834E+01_r8,0.283302E+01_r8,0.286811E+01_r8,0.290358E+01_r8, &
         0.293943E+01_r8,0.297571E+01_r8,0.301236E+01_r8,0.304946E+01_r8,0.308702E+01_r8, &
         0.312491E+01_r8,0.316326E+01_r8,0.320208E+01_r8,0.324130E+01_r8,0.328092E+01_r8, &
         0.332102E+01_r8,0.336162E+01_r8,0.340264E+01_r8,0.344407E+01_r8,0.348601E+01_r8, &
         0.352838E+01_r8,0.357118E+01_r8,0.361449E+01_r8,0.365834E+01_r8,0.370264E+01_r8, &
         0.374737E+01_r8,0.379265E+01_r8,0.383839E+01_r8,0.388469E+01_r8,0.393144E+01_r8, &
         0.397876E+01_r8,0.402656E+01_r8,0.407492E+01_r8,0.412378E+01_r8,0.417313E+01_r8, &
         0.422306E+01_r8,0.427359E+01_r8,0.432454E+01_r8,0.437617E+01_r8,0.442834E+01_r8, &
         0.448102E+01_r8,0.453433E+01_r8,0.458816E+01_r8,0.464253E+01_r8,0.469764E+01_r8, &
         0.475321E+01_r8,0.480942E+01_r8,0.486629E+01_r8,0.492372E+01_r8,0.498173E+01_r8/
    DATA (ESW_Aux(IESW),IESW=381,475) /                                      &
         0.504041E+01_r8,0.509967E+01_r8,0.515962E+01_r8,0.522029E+01_r8,0.528142E+01_r8, &
         0.534337E+01_r8,0.540595E+01_r8,0.546912E+01_r8,0.553292E+01_r8,0.559757E+01_r8, &
         0.566273E+01_r8,0.572864E+01_r8,0.579532E+01_r8,0.586266E+01_r8,0.593075E+01_r8, &
         0.599952E+01_r8,0.606895E+01_r8,0.613918E+01_r8,0.621021E+01_r8,0.628191E+01_r8, &
         0.635433E+01_r8,0.642755E+01_r8,0.650162E+01_r8,0.657639E+01_r8,0.665188E+01_r8, &
         0.672823E+01_r8,0.680532E+01_r8,0.688329E+01_r8,0.696198E+01_r8,0.704157E+01_r8, &
         0.712206E+01_r8,0.720319E+01_r8,0.728534E+01_r8,0.736829E+01_r8,0.745204E+01_r8, &
         0.753671E+01_r8,0.762218E+01_r8,0.770860E+01_r8,0.779588E+01_r8,0.788408E+01_r8, &
         0.797314E+01_r8,0.806318E+01_r8,0.815408E+01_r8,0.824599E+01_r8,0.833874E+01_r8, &
         0.843254E+01_r8,0.852721E+01_r8,0.862293E+01_r8,0.871954E+01_r8,0.881724E+01_r8, &
         0.891579E+01_r8,0.901547E+01_r8,0.911624E+01_r8,0.921778E+01_r8,0.932061E+01_r8, &
         0.942438E+01_r8,0.952910E+01_r8,0.963497E+01_r8,0.974181E+01_r8,0.984982E+01_r8, &
         0.995887E+01_r8,0.100690E+02_r8,0.101804E+02_r8,0.102926E+02_r8,0.104063E+02_r8, &
         0.105210E+02_r8,0.106367E+02_r8,0.107536E+02_r8,0.108719E+02_r8,0.109912E+02_r8, &
         0.111116E+02_r8,0.112333E+02_r8,0.113563E+02_r8,0.114804E+02_r8,0.116056E+02_r8, &
         0.117325E+02_r8,0.118602E+02_r8,0.119892E+02_r8,0.121197E+02_r8,0.122513E+02_r8, &
         0.123844E+02_r8,0.125186E+02_r8,0.126543E+02_r8,0.127912E+02_r8,0.129295E+02_r8, &
         0.130691E+02_r8,0.132101E+02_r8,0.133527E+02_r8,0.134965E+02_r8,0.136415E+02_r8, &
         0.137882E+02_r8,0.139361E+02_r8,0.140855E+02_r8,0.142366E+02_r8,0.143889E+02_r8/
    DATA (ESW_Aux(IESW),IESW=476,570) /                                      &
         0.145429E+02_r8,0.146982E+02_r8,0.148552E+02_r8,0.150135E+02_r8,0.151735E+02_r8, &
         0.153349E+02_r8,0.154979E+02_r8,0.156624E+02_r8,0.158286E+02_r8,0.159965E+02_r8, &
         0.161659E+02_r8,0.163367E+02_r8,0.165094E+02_r8,0.166838E+02_r8,0.168597E+02_r8, &
         0.170375E+02_r8,0.172168E+02_r8,0.173979E+02_r8,0.175806E+02_r8,0.177651E+02_r8, &
         0.179513E+02_r8,0.181394E+02_r8,0.183293E+02_r8,0.185210E+02_r8,0.187146E+02_r8, &
         0.189098E+02_r8,0.191066E+02_r8,0.193059E+02_r8,0.195065E+02_r8,0.197095E+02_r8, &
         0.199142E+02_r8,0.201206E+02_r8,0.203291E+02_r8,0.205397E+02_r8,0.207522E+02_r8, &
         0.209664E+02_r8,0.211831E+02_r8,0.214013E+02_r8,0.216221E+02_r8,0.218448E+02_r8, &
         0.220692E+02_r8,0.222959E+02_r8,0.225250E+02_r8,0.227559E+02_r8,0.229887E+02_r8, &
         0.232239E+02_r8,0.234614E+02_r8,0.237014E+02_r8,0.239428E+02_r8,0.241872E+02_r8, &
         0.244335E+02_r8,0.246824E+02_r8,0.249332E+02_r8,0.251860E+02_r8,0.254419E+02_r8, &
         0.256993E+02_r8,0.259600E+02_r8,0.262225E+02_r8,0.264873E+02_r8,0.267552E+02_r8, &
         0.270248E+02_r8,0.272970E+02_r8,0.275719E+02_r8,0.278497E+02_r8,0.281295E+02_r8, &
         0.284117E+02_r8,0.286965E+02_r8,0.289843E+02_r8,0.292743E+02_r8,0.295671E+02_r8, &
         0.298624E+02_r8,0.301605E+02_r8,0.304616E+02_r8,0.307650E+02_r8,0.310708E+02_r8, &
         0.313803E+02_r8,0.316915E+02_r8,0.320064E+02_r8,0.323238E+02_r8,0.326437E+02_r8, &
         0.329666E+02_r8,0.332928E+02_r8,0.336215E+02_r8,0.339534E+02_r8,0.342885E+02_r8, &
         0.346263E+02_r8,0.349666E+02_r8,0.353109E+02_r8,0.356572E+02_r8,0.360076E+02_r8, &
         0.363606E+02_r8,0.367164E+02_r8,0.370757E+02_r8,0.374383E+02_r8,0.378038E+02_r8/
    DATA (ESW_Aux(IESW),IESW=571,665) /                                      &
         0.381727E+02_r8,0.385453E+02_r8,0.389206E+02_r8,0.392989E+02_r8,0.396807E+02_r8, &
         0.400663E+02_r8,0.404555E+02_r8,0.408478E+02_r8,0.412428E+02_r8,0.416417E+02_r8, &
         0.420445E+02_r8,0.424502E+02_r8,0.428600E+02_r8,0.432733E+02_r8,0.436900E+02_r8, &
         0.441106E+02_r8,0.445343E+02_r8,0.449620E+02_r8,0.453930E+02_r8,0.458280E+02_r8, &
         0.462672E+02_r8,0.467096E+02_r8,0.471561E+02_r8,0.476070E+02_r8,0.480610E+02_r8, &
         0.485186E+02_r8,0.489813E+02_r8,0.494474E+02_r8,0.499170E+02_r8,0.503909E+02_r8, &
         0.508693E+02_r8,0.513511E+02_r8,0.518376E+02_r8,0.523277E+02_r8,0.528232E+02_r8, &
         0.533213E+02_r8,0.538240E+02_r8,0.543315E+02_r8,0.548437E+02_r8,0.553596E+02_r8, &
         0.558802E+02_r8,0.564046E+02_r8,0.569340E+02_r8,0.574672E+02_r8,0.580061E+02_r8, &
         0.585481E+02_r8,0.590963E+02_r8,0.596482E+02_r8,0.602041E+02_r8,0.607649E+02_r8, &
         0.613311E+02_r8,0.619025E+02_r8,0.624779E+02_r8,0.630574E+02_r8,0.636422E+02_r8, &
         0.642324E+02_r8,0.648280E+02_r8,0.654278E+02_r8,0.660332E+02_r8,0.666426E+02_r8, &
         0.672577E+02_r8,0.678771E+02_r8,0.685034E+02_r8,0.691328E+02_r8,0.697694E+02_r8, &
         0.704103E+02_r8,0.710556E+02_r8,0.717081E+02_r8,0.723639E+02_r8,0.730269E+02_r8, &
         0.736945E+02_r8,0.743681E+02_r8,0.750463E+02_r8,0.757309E+02_r8,0.764214E+02_r8, &
         0.771167E+02_r8,0.778182E+02_r8,0.785246E+02_r8,0.792373E+02_r8,0.799564E+02_r8, &
         0.806804E+02_r8,0.814109E+02_r8,0.821479E+02_r8,0.828898E+02_r8,0.836384E+02_r8, &
         0.843922E+02_r8,0.851525E+02_r8,0.859198E+02_r8,0.866920E+02_r8,0.874712E+02_r8, &
         0.882574E+02_r8,0.890486E+02_r8,0.898470E+02_r8,0.906525E+02_r8,0.914634E+02_r8/
    DATA (ESW_Aux(IESW),IESW=666,760) /                                      &
         0.922814E+02_r8,0.931048E+02_r8,0.939356E+02_r8,0.947736E+02_r8,0.956171E+02_r8, &
         0.964681E+02_r8,0.973246E+02_r8,0.981907E+02_r8,0.990605E+02_r8,0.999399E+02_r8, &
         0.100825E+03_r8,0.101718E+03_r8,0.102617E+03_r8,0.103523E+03_r8,0.104438E+03_r8, &
         0.105358E+03_r8,0.106287E+03_r8,0.107221E+03_r8,0.108166E+03_r8,0.109115E+03_r8, &
         0.110074E+03_r8,0.111039E+03_r8,0.112012E+03_r8,0.112992E+03_r8,0.113981E+03_r8, &
         0.114978E+03_r8,0.115981E+03_r8,0.116993E+03_r8,0.118013E+03_r8,0.119041E+03_r8, &
         0.120077E+03_r8,0.121122E+03_r8,0.122173E+03_r8,0.123234E+03_r8,0.124301E+03_r8, &
         0.125377E+03_r8,0.126463E+03_r8,0.127556E+03_r8,0.128657E+03_r8,0.129769E+03_r8, &
         0.130889E+03_r8,0.132017E+03_r8,0.133152E+03_r8,0.134299E+03_r8,0.135453E+03_r8, &
         0.136614E+03_r8,0.137786E+03_r8,0.138967E+03_r8,0.140158E+03_r8,0.141356E+03_r8, &
         0.142565E+03_r8,0.143781E+03_r8,0.145010E+03_r8,0.146247E+03_r8,0.147491E+03_r8, &
         0.148746E+03_r8,0.150011E+03_r8,0.151284E+03_r8,0.152571E+03_r8,0.153862E+03_r8, &
         0.155168E+03_r8,0.156481E+03_r8,0.157805E+03_r8,0.159137E+03_r8,0.160478E+03_r8, &
         0.161832E+03_r8,0.163198E+03_r8,0.164569E+03_r8,0.165958E+03_r8,0.167348E+03_r8, &
         0.168757E+03_r8,0.170174E+03_r8,0.171599E+03_r8,0.173037E+03_r8,0.174483E+03_r8, &
         0.175944E+03_r8,0.177414E+03_r8,0.178892E+03_r8,0.180387E+03_r8,0.181886E+03_r8, &
         0.183402E+03_r8,0.184930E+03_r8,0.186463E+03_r8,0.188012E+03_r8,0.189571E+03_r8, &
         0.191146E+03_r8,0.192730E+03_r8,0.194320E+03_r8,0.195930E+03_r8,0.197546E+03_r8, &
         0.199175E+03_r8,0.200821E+03_r8,0.202473E+03_r8,0.204142E+03_r8,0.205817E+03_r8/
    DATA (ESW_Aux(IESW),IESW=761,855) /                                      &
         0.207510E+03_r8,0.209216E+03_r8,0.210928E+03_r8,0.212658E+03_r8,0.214398E+03_r8, &
         0.216152E+03_r8,0.217920E+03_r8,0.219698E+03_r8,0.221495E+03_r8,0.223297E+03_r8, &
         0.225119E+03_r8,0.226951E+03_r8,0.228793E+03_r8,0.230654E+03_r8,0.232522E+03_r8, &
         0.234413E+03_r8,0.236311E+03_r8,0.238223E+03_r8,0.240151E+03_r8,0.242090E+03_r8, &
         0.244049E+03_r8,0.246019E+03_r8,0.248000E+03_r8,0.249996E+03_r8,0.252009E+03_r8, &
         0.254037E+03_r8,0.256077E+03_r8,0.258128E+03_r8,0.260200E+03_r8,0.262284E+03_r8, &
         0.264384E+03_r8,0.266500E+03_r8,0.268629E+03_r8,0.270779E+03_r8,0.272936E+03_r8, &
         0.275110E+03_r8,0.277306E+03_r8,0.279509E+03_r8,0.281734E+03_r8,0.283966E+03_r8, &
         0.286227E+03_r8,0.288494E+03_r8,0.290780E+03_r8,0.293083E+03_r8,0.295398E+03_r8, &
         0.297737E+03_r8,0.300089E+03_r8,0.302453E+03_r8,0.304841E+03_r8,0.307237E+03_r8, &
         0.309656E+03_r8,0.312095E+03_r8,0.314541E+03_r8,0.317012E+03_r8,0.319496E+03_r8, &
         0.322005E+03_r8,0.324527E+03_r8,0.327063E+03_r8,0.329618E+03_r8,0.332193E+03_r8, &
         0.334788E+03_r8,0.337396E+03_r8,0.340025E+03_r8,0.342673E+03_r8,0.345329E+03_r8, &
         0.348019E+03_r8,0.350722E+03_r8,0.353440E+03_r8,0.356178E+03_r8,0.358938E+03_r8, &
         0.361718E+03_r8,0.364513E+03_r8,0.367322E+03_r8,0.370160E+03_r8,0.373012E+03_r8, &
         0.375885E+03_r8,0.378788E+03_r8,0.381691E+03_r8,0.384631E+03_r8,0.387579E+03_r8, &
         0.390556E+03_r8,0.393556E+03_r8,0.396563E+03_r8,0.399601E+03_r8,0.402646E+03_r8, &
         0.405730E+03_r8,0.408829E+03_r8,0.411944E+03_r8,0.415083E+03_r8,0.418236E+03_r8, &
         0.421422E+03_r8,0.424632E+03_r8,0.427849E+03_r8,0.431099E+03_r8,0.434365E+03_r8/
    DATA (ESW_Aux(IESW),IESW=856,950) /                                      &
         0.437655E+03_r8,0.440970E+03_r8,0.444301E+03_r8,0.447666E+03_r8,0.451038E+03_r8, &
         0.454445E+03_r8,0.457876E+03_r8,0.461316E+03_r8,0.464790E+03_r8,0.468281E+03_r8, &
         0.471798E+03_r8,0.475342E+03_r8,0.478902E+03_r8,0.482497E+03_r8,0.486101E+03_r8, &
         0.489741E+03_r8,0.493408E+03_r8,0.497083E+03_r8,0.500804E+03_r8,0.504524E+03_r8, &
         0.508290E+03_r8,0.512074E+03_r8,0.515877E+03_r8,0.519717E+03_r8,0.523566E+03_r8, &
         0.527462E+03_r8,0.531367E+03_r8,0.535301E+03_r8,0.539264E+03_r8,0.543245E+03_r8, &
         0.547265E+03_r8,0.551305E+03_r8,0.555363E+03_r8,0.559462E+03_r8,0.563579E+03_r8, &
         0.567727E+03_r8,0.571905E+03_r8,0.576102E+03_r8,0.580329E+03_r8,0.584576E+03_r8, &
         0.588865E+03_r8,0.593185E+03_r8,0.597514E+03_r8,0.601885E+03_r8,0.606276E+03_r8, &
         0.610699E+03_r8,0.615151E+03_r8,0.619625E+03_r8,0.624140E+03_r8,0.628671E+03_r8, &
         0.633243E+03_r8,0.637845E+03_r8,0.642465E+03_r8,0.647126E+03_r8,0.651806E+03_r8, &
         0.656527E+03_r8,0.661279E+03_r8,0.666049E+03_r8,0.670861E+03_r8,0.675692E+03_r8, &
         0.680566E+03_r8,0.685471E+03_r8,0.690396E+03_r8,0.695363E+03_r8,0.700350E+03_r8, &
         0.705381E+03_r8,0.710444E+03_r8,0.715527E+03_r8,0.720654E+03_r8,0.725801E+03_r8, &
         0.730994E+03_r8,0.736219E+03_r8,0.741465E+03_r8,0.746756E+03_r8,0.752068E+03_r8, &
         0.757426E+03_r8,0.762819E+03_r8,0.768231E+03_r8,0.773692E+03_r8,0.779172E+03_r8, &
         0.784701E+03_r8,0.790265E+03_r8,0.795849E+03_r8,0.801483E+03_r8,0.807137E+03_r8, &
         0.812842E+03_r8,0.818582E+03_r8,0.824343E+03_r8,0.830153E+03_r8,0.835987E+03_r8, &
         0.841871E+03_r8,0.847791E+03_r8,0.853733E+03_r8,0.859727E+03_r8,0.865743E+03_r8/
    DATA (ESW_Aux(IESW),IESW=951,1045) /                                     &
         0.871812E+03_r8,0.877918E+03_r8,0.884046E+03_r8,0.890228E+03_r8,0.896433E+03_r8, &
         0.902690E+03_r8,0.908987E+03_r8,0.915307E+03_r8,0.921681E+03_r8,0.928078E+03_r8, &
         0.934531E+03_r8,0.941023E+03_r8,0.947539E+03_r8,0.954112E+03_r8,0.960708E+03_r8, &
         0.967361E+03_r8,0.974053E+03_r8,0.980771E+03_r8,0.987545E+03_r8,0.994345E+03_r8, &
         0.100120E+04_r8,0.100810E+04_r8,0.101502E+04_r8,0.102201E+04_r8,0.102902E+04_r8, &
         0.103608E+04_r8,0.104320E+04_r8,0.105033E+04_r8,0.105753E+04_r8,0.106475E+04_r8, &
         0.107204E+04_r8,0.107936E+04_r8,0.108672E+04_r8,0.109414E+04_r8,0.110158E+04_r8, &
         0.110908E+04_r8,0.111663E+04_r8,0.112421E+04_r8,0.113185E+04_r8,0.113952E+04_r8, &
         0.114725E+04_r8,0.115503E+04_r8,0.116284E+04_r8,0.117071E+04_r8,0.117861E+04_r8, &
         0.118658E+04_r8,0.119459E+04_r8,0.120264E+04_r8,0.121074E+04_r8,0.121888E+04_r8, &
         0.122709E+04_r8,0.123534E+04_r8,0.124362E+04_r8,0.125198E+04_r8,0.126036E+04_r8, &
         0.126881E+04_r8,0.127731E+04_r8,0.128584E+04_r8,0.129444E+04_r8,0.130307E+04_r8, &
         0.131177E+04_r8,0.132053E+04_r8,0.132931E+04_r8,0.133817E+04_r8,0.134705E+04_r8, &
         0.135602E+04_r8,0.136503E+04_r8,0.137407E+04_r8,0.138319E+04_r8,0.139234E+04_r8, &
         0.140156E+04_r8,0.141084E+04_r8,0.142015E+04_r8,0.142954E+04_r8,0.143896E+04_r8, &
         0.144845E+04_r8,0.145800E+04_r8,0.146759E+04_r8,0.147725E+04_r8,0.148694E+04_r8, &
         0.149672E+04_r8,0.150655E+04_r8,0.151641E+04_r8,0.152635E+04_r8,0.153633E+04_r8, &
         0.154639E+04_r8,0.155650E+04_r8,0.156665E+04_r8,0.157688E+04_r8,0.158715E+04_r8, &
         0.159750E+04_r8,0.160791E+04_r8,0.161836E+04_r8,0.162888E+04_r8,0.163945E+04_r8/
    DATA (ESW_Aux(IESW),IESW=1046,1140) /                                    &
         0.165010E+04_r8,0.166081E+04_r8,0.167155E+04_r8,0.168238E+04_r8,0.169325E+04_r8, &
         0.170420E+04_r8,0.171522E+04_r8,0.172627E+04_r8,0.173741E+04_r8,0.174859E+04_r8, &
         0.175986E+04_r8,0.177119E+04_r8,0.178256E+04_r8,0.179402E+04_r8,0.180552E+04_r8, &
         0.181711E+04_r8,0.182877E+04_r8,0.184046E+04_r8,0.185224E+04_r8,0.186407E+04_r8, &
         0.187599E+04_r8,0.188797E+04_r8,0.190000E+04_r8,0.191212E+04_r8,0.192428E+04_r8, &
         0.193653E+04_r8,0.194886E+04_r8,0.196122E+04_r8,0.197368E+04_r8,0.198618E+04_r8, &
         0.199878E+04_r8,0.201145E+04_r8,0.202416E+04_r8,0.203698E+04_r8,0.204983E+04_r8, &
         0.206278E+04_r8,0.207580E+04_r8,0.208887E+04_r8,0.210204E+04_r8,0.211525E+04_r8, &
         0.212856E+04_r8,0.214195E+04_r8,0.215538E+04_r8,0.216892E+04_r8,0.218249E+04_r8, &
         0.219618E+04_r8,0.220994E+04_r8,0.222375E+04_r8,0.223766E+04_r8,0.225161E+04_r8, &
         0.226567E+04_r8,0.227981E+04_r8,0.229399E+04_r8,0.230829E+04_r8,0.232263E+04_r8, &
         0.233708E+04_r8,0.235161E+04_r8,0.236618E+04_r8,0.238087E+04_r8,0.239560E+04_r8, &
         0.241044E+04_r8,0.242538E+04_r8,0.244035E+04_r8,0.245544E+04_r8,0.247057E+04_r8, &
         0.248583E+04_r8,0.250116E+04_r8,0.251654E+04_r8,0.253204E+04_r8,0.254759E+04_r8, &
         0.256325E+04_r8,0.257901E+04_r8,0.259480E+04_r8,0.261073E+04_r8,0.262670E+04_r8, &
         0.264279E+04_r8,0.265896E+04_r8,0.267519E+04_r8,0.269154E+04_r8,0.270794E+04_r8, &
         0.272447E+04_r8,0.274108E+04_r8,0.275774E+04_r8,0.277453E+04_r8,0.279137E+04_r8, &
         0.280834E+04_r8,0.282540E+04_r8,0.284251E+04_r8,0.285975E+04_r8,0.287704E+04_r8, &
         0.289446E+04_r8,0.291198E+04_r8,0.292954E+04_r8,0.294725E+04_r8,0.296499E+04_r8/
    DATA (ESW_Aux(IESW),IESW=1141,1235) /                                    &
         0.298288E+04_r8,0.300087E+04_r8,0.301890E+04_r8,0.303707E+04_r8,0.305529E+04_r8, &
         0.307365E+04_r8,0.309211E+04_r8,0.311062E+04_r8,0.312927E+04_r8,0.314798E+04_r8, &
         0.316682E+04_r8,0.318577E+04_r8,0.320477E+04_r8,0.322391E+04_r8,0.324310E+04_r8, &
         0.326245E+04_r8,0.328189E+04_r8,0.330138E+04_r8,0.332103E+04_r8,0.334073E+04_r8, &
         0.336058E+04_r8,0.338053E+04_r8,0.340054E+04_r8,0.342069E+04_r8,0.344090E+04_r8, &
         0.346127E+04_r8,0.348174E+04_r8,0.350227E+04_r8,0.352295E+04_r8,0.354369E+04_r8, &
         0.356458E+04_r8,0.358559E+04_r8,0.360664E+04_r8,0.362787E+04_r8,0.364914E+04_r8, &
         0.367058E+04_r8,0.369212E+04_r8,0.371373E+04_r8,0.373548E+04_r8,0.375731E+04_r8, &
         0.377929E+04_r8,0.380139E+04_r8,0.382355E+04_r8,0.384588E+04_r8,0.386826E+04_r8, &
         0.389081E+04_r8,0.391348E+04_r8,0.393620E+04_r8,0.395910E+04_r8,0.398205E+04_r8, &
         0.400518E+04_r8,0.402843E+04_r8,0.405173E+04_r8,0.407520E+04_r8,0.409875E+04_r8, &
         0.412246E+04_r8,0.414630E+04_r8,0.417019E+04_r8,0.419427E+04_r8,0.421840E+04_r8, &
         0.424272E+04_r8,0.426715E+04_r8,0.429165E+04_r8,0.431634E+04_r8,0.434108E+04_r8, &
         0.436602E+04_r8,0.439107E+04_r8,0.441618E+04_r8,0.444149E+04_r8,0.446685E+04_r8, &
         0.449241E+04_r8,0.451810E+04_r8,0.454385E+04_r8,0.456977E+04_r8,0.459578E+04_r8, &
         0.462197E+04_r8,0.464830E+04_r8,0.467468E+04_r8,0.470127E+04_r8,0.472792E+04_r8, &
         0.475477E+04_r8,0.478175E+04_r8,0.480880E+04_r8,0.483605E+04_r8,0.486336E+04_r8, &
         0.489087E+04_r8,0.491853E+04_r8,0.494623E+04_r8,0.497415E+04_r8,0.500215E+04_r8, &
         0.503034E+04_r8,0.505867E+04_r8,0.508707E+04_r8,0.511568E+04_r8,0.514436E+04_r8/
    DATA (ESW_Aux(IESW),IESW=1236,1330) /                                    &
         0.517325E+04_r8,0.520227E+04_r8,0.523137E+04_r8,0.526068E+04_r8,0.529005E+04_r8, &
         0.531965E+04_r8,0.534939E+04_r8,0.537921E+04_r8,0.540923E+04_r8,0.543932E+04_r8, &
         0.546965E+04_r8,0.550011E+04_r8,0.553064E+04_r8,0.556139E+04_r8,0.559223E+04_r8, &
         0.562329E+04_r8,0.565449E+04_r8,0.568577E+04_r8,0.571727E+04_r8,0.574884E+04_r8, &
         0.578064E+04_r8,0.581261E+04_r8,0.584464E+04_r8,0.587692E+04_r8,0.590924E+04_r8, &
         0.594182E+04_r8,0.597455E+04_r8,0.600736E+04_r8,0.604039E+04_r8,0.607350E+04_r8, &
         0.610685E+04_r8,0.614036E+04_r8,0.617394E+04_r8,0.620777E+04_r8,0.624169E+04_r8, &
         0.627584E+04_r8,0.631014E+04_r8,0.634454E+04_r8,0.637918E+04_r8,0.641390E+04_r8, &
         0.644887E+04_r8,0.648400E+04_r8,0.651919E+04_r8,0.655467E+04_r8,0.659021E+04_r8, &
         0.662599E+04_r8,0.666197E+04_r8,0.669800E+04_r8,0.673429E+04_r8,0.677069E+04_r8, &
         0.680735E+04_r8,0.684415E+04_r8,0.688104E+04_r8,0.691819E+04_r8,0.695543E+04_r8, &
         0.699292E+04_r8,0.703061E+04_r8,0.706837E+04_r8,0.710639E+04_r8,0.714451E+04_r8, &
         0.718289E+04_r8,0.722143E+04_r8,0.726009E+04_r8,0.729903E+04_r8,0.733802E+04_r8, &
         0.737729E+04_r8,0.741676E+04_r8,0.745631E+04_r8,0.749612E+04_r8,0.753602E+04_r8, &
         0.757622E+04_r8,0.761659E+04_r8,0.765705E+04_r8,0.769780E+04_r8,0.773863E+04_r8, &
         0.777975E+04_r8,0.782106E+04_r8,0.786246E+04_r8,0.790412E+04_r8,0.794593E+04_r8, &
         0.798802E+04_r8,0.803028E+04_r8,0.807259E+04_r8,0.811525E+04_r8,0.815798E+04_r8, &
         0.820102E+04_r8,0.824427E+04_r8,0.828757E+04_r8,0.833120E+04_r8,0.837493E+04_r8, &
         0.841895E+04_r8,0.846313E+04_r8,0.850744E+04_r8,0.855208E+04_r8,0.859678E+04_r8/
    DATA (ESW_Aux(IESW),IESW=1331,1425) /                                    &
         0.864179E+04_r8,0.868705E+04_r8,0.873237E+04_r8,0.877800E+04_r8,0.882374E+04_r8, &
         0.886979E+04_r8,0.891603E+04_r8,0.896237E+04_r8,0.900904E+04_r8,0.905579E+04_r8, &
         0.910288E+04_r8,0.915018E+04_r8,0.919758E+04_r8,0.924529E+04_r8,0.929310E+04_r8, &
         0.934122E+04_r8,0.938959E+04_r8,0.943804E+04_r8,0.948687E+04_r8,0.953575E+04_r8, &
         0.958494E+04_r8,0.963442E+04_r8,0.968395E+04_r8,0.973384E+04_r8,0.978383E+04_r8, &
         0.983412E+04_r8,0.988468E+04_r8,0.993534E+04_r8,0.998630E+04_r8,0.100374E+05_r8, &
         0.100888E+05_r8,0.101406E+05_r8,0.101923E+05_r8,0.102444E+05_r8,0.102966E+05_r8, &
         0.103492E+05_r8,0.104020E+05_r8,0.104550E+05_r8,0.105082E+05_r8,0.105616E+05_r8, &
         0.106153E+05_r8,0.106693E+05_r8,0.107234E+05_r8,0.107779E+05_r8,0.108325E+05_r8, &
         0.108874E+05_r8,0.109425E+05_r8,0.109978E+05_r8,0.110535E+05_r8,0.111092E+05_r8, &
         0.111653E+05_r8,0.112217E+05_r8,0.112782E+05_r8,0.113350E+05_r8,0.113920E+05_r8, &
         0.114493E+05_r8,0.115070E+05_r8,0.115646E+05_r8,0.116228E+05_r8,0.116809E+05_r8, &
         0.117396E+05_r8,0.117984E+05_r8,0.118574E+05_r8,0.119167E+05_r8,0.119762E+05_r8, &
         0.120360E+05_r8,0.120962E+05_r8,0.121564E+05_r8,0.122170E+05_r8,0.122778E+05_r8, &
         0.123389E+05_r8,0.124004E+05_r8,0.124619E+05_r8,0.125238E+05_r8,0.125859E+05_r8, &
         0.126484E+05_r8,0.127111E+05_r8,0.127739E+05_r8,0.128372E+05_r8,0.129006E+05_r8, &
         0.129644E+05_r8,0.130285E+05_r8,0.130927E+05_r8,0.131573E+05_r8,0.132220E+05_r8, &
         0.132872E+05_r8,0.133526E+05_r8,0.134182E+05_r8,0.134842E+05_r8,0.135503E+05_r8, &
         0.136168E+05_r8,0.136836E+05_r8,0.137505E+05_r8,0.138180E+05_r8,0.138854E+05_r8/
    DATA (ESW_Aux(IESW),IESW=1426,1520) /                                    &
         0.139534E+05_r8,0.140216E+05_r8,0.140900E+05_r8,0.141588E+05_r8,0.142277E+05_r8, &
         0.142971E+05_r8,0.143668E+05_r8,0.144366E+05_r8,0.145069E+05_r8,0.145773E+05_r8, &
         0.146481E+05_r8,0.147192E+05_r8,0.147905E+05_r8,0.148622E+05_r8,0.149341E+05_r8, &
         0.150064E+05_r8,0.150790E+05_r8,0.151517E+05_r8,0.152250E+05_r8,0.152983E+05_r8, &
         0.153721E+05_r8,0.154462E+05_r8,0.155205E+05_r8,0.155952E+05_r8,0.156701E+05_r8, &
         0.157454E+05_r8,0.158211E+05_r8,0.158969E+05_r8,0.159732E+05_r8,0.160496E+05_r8, &
         0.161265E+05_r8,0.162037E+05_r8,0.162811E+05_r8,0.163589E+05_r8,0.164369E+05_r8, &
         0.165154E+05_r8,0.165942E+05_r8,0.166732E+05_r8,0.167526E+05_r8,0.168322E+05_r8, &
         0.169123E+05_r8,0.169927E+05_r8,0.170733E+05_r8,0.171543E+05_r8,0.172356E+05_r8, &
         0.173173E+05_r8,0.173993E+05_r8,0.174815E+05_r8,0.175643E+05_r8,0.176471E+05_r8, &
         0.177305E+05_r8,0.178143E+05_r8,0.178981E+05_r8,0.179826E+05_r8,0.180671E+05_r8, &
         0.181522E+05_r8,0.182377E+05_r8,0.183232E+05_r8,0.184093E+05_r8,0.184955E+05_r8, &
         0.185823E+05_r8,0.186695E+05_r8,0.187568E+05_r8,0.188447E+05_r8,0.189326E+05_r8, &
         0.190212E+05_r8,0.191101E+05_r8,0.191991E+05_r8,0.192887E+05_r8,0.193785E+05_r8, &
         0.194688E+05_r8,0.195595E+05_r8,0.196503E+05_r8,0.197417E+05_r8,0.198332E+05_r8, &
         0.199253E+05_r8,0.200178E+05_r8,0.201105E+05_r8,0.202036E+05_r8,0.202971E+05_r8, &
         0.203910E+05_r8,0.204853E+05_r8,0.205798E+05_r8,0.206749E+05_r8,0.207701E+05_r8, &
         0.208659E+05_r8,0.209621E+05_r8,0.210584E+05_r8,0.211554E+05_r8,0.212524E+05_r8, &
         0.213501E+05_r8,0.214482E+05_r8,0.215465E+05_r8,0.216452E+05_r8,0.217442E+05_r8/
    DATA (ESW_Aux(IESW),IESW=1521,1552) /                                    &
         0.218439E+05_r8,0.219439E+05_r8,0.220440E+05_r8,0.221449E+05_r8,0.222457E+05_r8, &
         0.223473E+05_r8,0.224494E+05_r8,0.225514E+05_r8,0.226542E+05_r8,0.227571E+05_r8, &
         0.228606E+05_r8,0.229646E+05_r8,0.230687E+05_r8,0.231734E+05_r8,0.232783E+05_r8, &
         0.233839E+05_r8,0.234898E+05_r8,0.235960E+05_r8,0.237027E+05_r8,0.238097E+05_r8, &
         0.239173E+05_r8,0.240254E+05_r8,0.241335E+05_r8,0.242424E+05_r8,0.243514E+05_r8, &
         0.244611E+05_r8,0.245712E+05_r8,0.246814E+05_r8,0.247923E+05_r8,0.249034E+05_r8, &
         0.250152E+05_r8,0.250152E+05_r8/
    ESW2=ESW_Aux
  END SUBROUTINE qsat_wat_data

  ! ======================================================================




  ! *****************************COPYRIGHT*******************************
  ! (C) Crown copyright Met Office. All rights reserved.
  ! For further details please refer to the file COPYRIGHT.txt
  ! which you should have received as part of this distribution.
  ! *****************************COPYRIGHT*******************************
  !
  !+ Saturation Specific Humidity Scheme (Qsat_Wat): Vapour to Liquid.
  ! Subroutine Interface:
  SUBROUTINE QSAT_WAT (&
                                !      Output field
       &  QS      &!REAL   , INTENT(OUT)  ::  QS(NPNTS) ! SATURATION MIXING RATIO AT TEMPERATURE T AND PRESSURE P (KG/KG)
                                !      Input fields
       &, T       &!REAL   , INTENT(IN   ) :: T(NPNTS)  !Temperature (K).
       &, P       &!REAL   , INTENT(IN   ) :: P(NPNTS)  !Pressure (Pa).
                                !      Array dimensions
       &, NPNTS   &!INTEGER, INTENT(IN   ) :: NPNTS  !, INTENT(IN)
       &  )
    !
    IMPLICIT NONE
    !
    ! Purpose:
    !   RETURNS A SATURATION MIXING RATIO GIVEN A TEMPERATURE AND PRESSURE
    !   USING SATURATION VAPOUR PRESSURES CALCULATED USING THE GOFF-GRATCH
    !   FORMULAE, ADOPTED BY THE WMO AS TAKEN FROM LANDOLT-BORNSTEIN, 1987
    !   NUMERICAL DATA AND FUNCTIONAL RELATIONSHIPS IN SCIENCE AND
    !   TECHNOLOGY. GROUP V/VOL 4B METEOROLOGY. PHYSICAL AND CHEMICAL
    !   PROPERTIES OF AIR, P35
    !
    !   VALUES IN THE LOOKUP TABLE ARE OVER WATER ABOVE AND BELOW 0 DEG C.
    !
    !   NOTE : FOR VAPOUR PRESSURE OVER WATER THIS FORMULA IS VALID FOR
    !   TEMPERATURES BETWEEN 373K AND 223K.  THE VALUES FOR SATURATED VAPOUR
    !   OVER WATER IN THE LOOKUP TABLE BELOW ARE OUT OF THE LOWER END OF
    !   THIS RANGE.  HOWEVER IT IS STANDARD WMO PRACTICE TO USE THE FORMULA
    !   BELOW ITS ACCEPTED RANGE FOR USE WITH THE CALCULATION OF DEW POINTS
    !   IN THE UPPER ATMOSPHERE
    !
    ! Method:
    !   Uses lookup tables to find eSAT, calculates qSAT directly from that.
    !
    ! Current Owner of Code: OWNER OF LARGE_SCALE CLOUD CODE.
    !
    ! History:
    !   Version  Date    Comment
    !    5.1   14-03-00  Correct 2B (optimized) version for use in UM5.x .
    !                                                        A.C.Bushell
    !    6.2   03-02-06  Moved to a71_1a.  P.Selwood
    !
    ! Code Description:
    !   Language: FORTRAN 77  + common extensions also in Fortran90.
    !   This code is written to UMDP3 version 6 programming standards.
    !
    !   Documentation: UMDP No.29
    !
    ! Declarations:
    !
    !  Global Variables:----------------------------------------------------
    !*L------------------COMDECK C_EPSLON-----------------------------------
    ! EPSILON IS RATIO OF MOLECULAR WEIGHTS OF WATER AND DRY AIR

    REAL(KIND=r8), PARAMETER :: Epsilon   = 0.62198_r8
    REAL(KIND=r8), PARAMETER :: C_Virtual = 1.0_r8/Epsilon-1.0_r8

    !*----------------------------------------------------------------------
    !*L------------------COMDECK C_O_DG_C-----------------------------------
    ! ZERODEGC IS CONVERSION BETWEEN DEGREES CELSIUS AND KELVIN
    ! TFS IS TEMPERATURE AT WHICH SEA WATER FREEZES
    ! TM IS TEMPERATURE AT WHICH FRESH WATER FREEZES AND ICE MELTS

    REAL(KIND=r8), PARAMETER :: ZeroDegC = 273.15_r8
    REAL(KIND=r8), PARAMETER :: TFS      = 271.35_r8
    REAL(KIND=r8), PARAMETER :: TM       = 273.15_r8

    !*----------------------------------------------------------------------
    !
    !  Subroutine Arguments:------------------------------------------------
    !
    ! arguments with intent in. ie: input variables.
    !
    INTEGER, INTENT(IN   ) :: NPNTS                   !, INTENT(IN)
    !       Points (=horizontal dimensions) being processed by qSAT scheme.
    !
    REAL(KIND=r8)   , INTENT(IN   ) :: T(NPNTS)  !       Temperature (K).
    REAL(KIND=r8)   , INTENT(IN   ) :: P(NPNTS)  !       Pressure (Pa).
    !
    ! arguments with intent out. ie: output variables.
    !
    REAL(KIND=r8)   , INTENT(OUT)  ::  QS(NPNTS) ! SATURATION MIXING RATIO AT TEMPERATURE T AND PRESSURE P (KG/KG)
    !
    !  Local parameters and other physical constants------------------------
    !REAL(KIND=r8) ONE_MINUS_EPSILON  ! ONE MINUS THE RATIO OF THE MOLECULAR
    !                               WEIGHTS OF WATER AND DRY AIR
    !
    !REAL(KIND=r8) T_LOW        ! LOWEST TEMPERATURE FOR WHICH LOOK-UP TABLE OF
    !                         SATURATION WATER VAPOUR PRESSURE IS VALID (K)
    !
    !REAL(KIND=r8) T_HIGH       ! HIGHEST TEMPERATURE FOR WHICH LOOK-UP TABLE OF
    !                         SATURATION WATER VAPOUR PRESSURE IS VALID (K)
    !
    !REAL(KIND=r8) DELTA_T      ! TEMPERATURE INCREMENT OF THE LOOK-UP
    ! TABLE OF SATURATION VAPOUR PRESSURES
    !
    !INTEGER N         ! SIZE OF LOOK-UP TABLE OF SATURATION
    ! WATER VAPOUR PRESSURES
    !
    REAL(KIND=r8), PARAMETER :: ONE_MINUS_EPSILON = 1.0_r8 - EPSILON
    REAL(KIND=r8), PARAMETER :: T_LOW = 183.15_r8
    REAL(KIND=r8), PARAMETER :: T_HIGH = 338.15_r8
    REAL(KIND=r8), PARAMETER :: DELTA_T = 0.1_r8
    INTEGER, PARAMETER :: N = INT(((T_HIGH - T_LOW + (DELTA_T*0.5_r8))/DELTA_T) + 1.0_r8)
    ! gives N=1551
    !
    !  Local scalars--------------------------------------------------------
    !
    !  (a) Scalars effectively expanded to workspace by the Cray (using
    !      vector registers).
    !
    INTEGER ITABLE    ! WORK VARIABLES
    !
    REAL(KIND=r8) ATABLE       ! WORK VARIABLES
    !
    !     VARIABLES INTRODUCED BY DLR.
    !
    REAL(KIND=r8) FSUBW        ! FACTOR THAT CONVERTS FROM SAT VAPOUR PRESSURE
    !                         IN A PURE WATER SYSTEM TO SAT VAPOUR PRESSURE
    !                         IN AIR.
    REAL(KIND=r8) TT
    !
    !  (b) Others.
    INTEGER I         ! LOOP COUNTERS
    !
    INTEGER IES       ! LOOP COUNTER FOR DATA STATEMENT LOOK-UP TABLE
    !
    !  Local dynamic arrays-------------------------------------------------
    REAL(KIND=r8) ES(0:N+1)    ! TABLE OF SATURATION WATER VAPOUR PRESSURE (PA)
    !                       - SET BY DATA STATEMENT CALCULATED FROM THE
    !                         GOFF-GRATCH FORMULAE AS TAKEN FROM LANDOLT-
    !                         BORNSTEIN, 1987 NUMERICAL DATA AND FUNCTIONAL
    !                         RELATIONSHIPS IN SCIENCE AND TECHNOLOGY.
    !                         GROUP V/ VOL 4B METEOROLOGY. PHYSICAL AND
    !                         CHEMICAL PROPERTIES OF AIR, P35
    !
    !  External subroutine calls: ------------------------------------------
    !     EXTERNAL None
    !- End of Header
    !
    ! ==Main Block==--------------------------------------------------------
    ! Subroutine structure :
    ! NO SIGNIFICANT STRUCTURE
    ! ----------------------------------------------------------------------
    ! SATURATION WATER VAPOUR PRESSURE
    !
    ! VALUES ABOVE AND BELOW 0 DEG C ARE OVER WATER
    !
    ! VALUES BELOW -50 DEC C ARE OUTSIDE FORMAL RANGE OF WMO ADOPTED FORMULA
    ! (SEE ABOVE).  HOWEVER STANDARD PRACTICE TO USE THESE VALUES
    ! ----------------------------------------------------------------------
    ! Note: 0 element is a repeat of 1st element to cater for special case
    !       of low temperatures ( <= T_LOW) for which the array index is
    !       rounded down due to machine precision.
    DATA (ES(IES),IES=    0, 95) / 0.186905E-01_r8,                      &
         &0.186905E-01_r8,0.190449E-01_r8,0.194059E-01_r8,0.197727E-01_r8,0.201462E-01_r8, &
         &0.205261E-01_r8,0.209122E-01_r8,0.213052E-01_r8,0.217050E-01_r8,0.221116E-01_r8, &
         &0.225252E-01_r8,0.229463E-01_r8,0.233740E-01_r8,0.238090E-01_r8,0.242518E-01_r8, &
         &0.247017E-01_r8,0.251595E-01_r8,0.256252E-01_r8,0.260981E-01_r8,0.265795E-01_r8, &
         &0.270691E-01_r8,0.275667E-01_r8,0.280733E-01_r8,0.285876E-01_r8,0.291105E-01_r8, &
         &0.296429E-01_r8,0.301835E-01_r8,0.307336E-01_r8,0.312927E-01_r8,0.318611E-01_r8, &
         &0.324390E-01_r8,0.330262E-01_r8,0.336232E-01_r8,0.342306E-01_r8,0.348472E-01_r8, &
         &0.354748E-01_r8,0.361117E-01_r8,0.367599E-01_r8,0.374185E-01_r8,0.380879E-01_r8, &
         &0.387689E-01_r8,0.394602E-01_r8,0.401626E-01_r8,0.408771E-01_r8,0.416033E-01_r8, &
         &0.423411E-01_r8,0.430908E-01_r8,0.438524E-01_r8,0.446263E-01_r8,0.454124E-01_r8, &
         &0.462122E-01_r8,0.470247E-01_r8,0.478491E-01_r8,0.486874E-01_r8,0.495393E-01_r8, &
         &0.504057E-01_r8,0.512847E-01_r8,0.521784E-01_r8,0.530853E-01_r8,0.540076E-01_r8, &
         &0.549444E-01_r8,0.558959E-01_r8,0.568633E-01_r8,0.578448E-01_r8,0.588428E-01_r8, &
         &0.598566E-01_r8,0.608858E-01_r8,0.619313E-01_r8,0.629926E-01_r8,0.640706E-01_r8, &
         &0.651665E-01_r8,0.662795E-01_r8,0.674095E-01_r8,0.685570E-01_r8,0.697219E-01_r8, &
         &0.709063E-01_r8,0.721076E-01_r8,0.733284E-01_r8,0.745679E-01_r8,0.758265E-01_r8, &
         &0.771039E-01_r8,0.784026E-01_r8,0.797212E-01_r8,0.810577E-01_r8,0.824164E-01_r8, &
         &0.837971E-01_r8,0.851970E-01_r8,0.866198E-01_r8,0.880620E-01_r8,0.895281E-01_r8, &
         &0.910178E-01_r8,0.925278E-01_r8,0.940622E-01_r8,0.956177E-01_r8,0.971984E-01_r8/
    DATA (ES(IES),IES= 96,190) /                                      &
         &0.988051E-01_r8,0.100433E+00_r8,0.102085E+00_r8,0.103764E+00_r8,0.105467E+00_r8, &
         &0.107196E+00_r8,0.108953E+00_r8,0.110732E+00_r8,0.112541E+00_r8,0.114376E+00_r8, &
         &0.116238E+00_r8,0.118130E+00_r8,0.120046E+00_r8,0.121993E+00_r8,0.123969E+00_r8, &
         &0.125973E+00_r8,0.128009E+00_r8,0.130075E+00_r8,0.132167E+00_r8,0.134296E+00_r8, &
         &0.136452E+00_r8,0.138642E+00_r8,0.140861E+00_r8,0.143115E+00_r8,0.145404E+00_r8, &
         &0.147723E+00_r8,0.150078E+00_r8,0.152466E+00_r8,0.154889E+00_r8,0.157346E+00_r8, &
         &0.159841E+00_r8,0.162372E+00_r8,0.164939E+00_r8,0.167545E+00_r8,0.170185E+00_r8, &
         &0.172866E+00_r8,0.175584E+00_r8,0.178340E+00_r8,0.181139E+00_r8,0.183977E+00_r8, &
         &0.186855E+00_r8,0.189773E+00_r8,0.192737E+00_r8,0.195736E+00_r8,0.198783E+00_r8, &
         &0.201875E+00_r8,0.205007E+00_r8,0.208186E+00_r8,0.211409E+00_r8,0.214676E+00_r8, &
         &0.217993E+00_r8,0.221355E+00_r8,0.224764E+00_r8,0.228220E+00_r8,0.231728E+00_r8, &
         &0.235284E+00_r8,0.238888E+00_r8,0.242542E+00_r8,0.246251E+00_r8,0.250010E+00_r8, &
         &0.253821E+00_r8,0.257688E+00_r8,0.261602E+00_r8,0.265575E+00_r8,0.269607E+00_r8, &
         &0.273689E+00_r8,0.277830E+00_r8,0.282027E+00_r8,0.286287E+00_r8,0.290598E+00_r8, &
         &0.294972E+00_r8,0.299405E+00_r8,0.303904E+00_r8,0.308462E+00_r8,0.313082E+00_r8, &
         &0.317763E+00_r8,0.322512E+00_r8,0.327324E+00_r8,0.332201E+00_r8,0.337141E+00_r8, &
         &0.342154E+00_r8,0.347234E+00_r8,0.352387E+00_r8,0.357601E+00_r8,0.362889E+00_r8, &
         &0.368257E+00_r8,0.373685E+00_r8,0.379194E+00_r8,0.384773E+00_r8,0.390433E+00_r8, &
         &0.396159E+00_r8,0.401968E+00_r8,0.407861E+00_r8,0.413820E+00_r8,0.419866E+00_r8/
    DATA (ES(IES),IES=191,285) /                                      &
         &0.425999E+00_r8,0.432203E+00_r8,0.438494E+00_r8,0.444867E+00_r8,0.451332E+00_r8, &
         &0.457879E+00_r8,0.464510E+00_r8,0.471226E+00_r8,0.478037E+00_r8,0.484935E+00_r8, &
         &0.491920E+00_r8,0.499005E+00_r8,0.506181E+00_r8,0.513447E+00_r8,0.520816E+00_r8, &
         &0.528279E+00_r8,0.535835E+00_r8,0.543497E+00_r8,0.551256E+00_r8,0.559113E+00_r8, &
         &0.567081E+00_r8,0.575147E+00_r8,0.583315E+00_r8,0.591585E+00_r8,0.599970E+00_r8, &
         &0.608472E+00_r8,0.617069E+00_r8,0.625785E+00_r8,0.634609E+00_r8,0.643556E+00_r8, &
         &0.652611E+00_r8,0.661782E+00_r8,0.671077E+00_r8,0.680487E+00_r8,0.690015E+00_r8, &
         &0.699656E+00_r8,0.709433E+00_r8,0.719344E+00_r8,0.729363E+00_r8,0.739518E+00_r8, &
         &0.749795E+00_r8,0.760217E+00_r8,0.770763E+00_r8,0.781454E+00_r8,0.792258E+00_r8, &
         &0.803208E+00_r8,0.814309E+00_r8,0.825528E+00_r8,0.836914E+00_r8,0.848422E+00_r8, &
         &0.860086E+00_r8,0.871891E+00_r8,0.883837E+00_r8,0.895944E+00_r8,0.908214E+00_r8, &
         &0.920611E+00_r8,0.933175E+00_r8,0.945890E+00_r8,0.958776E+00_r8,0.971812E+00_r8, &
         &0.985027E+00_r8,0.998379E+00_r8,0.101193E+01_r8,0.102561E+01_r8,0.103949E+01_r8, &
         &0.105352E+01_r8,0.106774E+01_r8,0.108213E+01_r8,0.109669E+01_r8,0.111144E+01_r8, &
         &0.112636E+01_r8,0.114148E+01_r8,0.115676E+01_r8,0.117226E+01_r8,0.118791E+01_r8, &
         &0.120377E+01_r8,0.121984E+01_r8,0.123608E+01_r8,0.125252E+01_r8,0.126919E+01_r8, &
         &0.128604E+01_r8,0.130309E+01_r8,0.132036E+01_r8,0.133782E+01_r8,0.135549E+01_r8, &
         &0.137339E+01_r8,0.139150E+01_r8,0.140984E+01_r8,0.142839E+01_r8,0.144715E+01_r8, &
         &0.146616E+01_r8,0.148538E+01_r8,0.150482E+01_r8,0.152450E+01_r8,0.154445E+01_r8/
    DATA (ES(IES),IES=286,380) /                                      &
         &0.156459E+01_r8,0.158502E+01_r8,0.160564E+01_r8,0.162654E+01_r8,0.164766E+01_r8, &
         &0.166906E+01_r8,0.169070E+01_r8,0.171257E+01_r8,0.173473E+01_r8,0.175718E+01_r8, &
         &0.177984E+01_r8,0.180282E+01_r8,0.182602E+01_r8,0.184951E+01_r8,0.187327E+01_r8, &
         &0.189733E+01_r8,0.192165E+01_r8,0.194629E+01_r8,0.197118E+01_r8,0.199636E+01_r8, &
         &0.202185E+01_r8,0.204762E+01_r8,0.207372E+01_r8,0.210010E+01_r8,0.212678E+01_r8, &
         &0.215379E+01_r8,0.218109E+01_r8,0.220873E+01_r8,0.223668E+01_r8,0.226497E+01_r8, &
         &0.229357E+01_r8,0.232249E+01_r8,0.235176E+01_r8,0.238134E+01_r8,0.241129E+01_r8, &
         &0.244157E+01_r8,0.247217E+01_r8,0.250316E+01_r8,0.253447E+01_r8,0.256617E+01_r8, &
         &0.259821E+01_r8,0.263064E+01_r8,0.266341E+01_r8,0.269661E+01_r8,0.273009E+01_r8, &
         &0.276403E+01_r8,0.279834E+01_r8,0.283302E+01_r8,0.286811E+01_r8,0.290358E+01_r8, &
         &0.293943E+01_r8,0.297571E+01_r8,0.301236E+01_r8,0.304946E+01_r8,0.308702E+01_r8, &
         &0.312491E+01_r8,0.316326E+01_r8,0.320208E+01_r8,0.324130E+01_r8,0.328092E+01_r8, &
         &0.332102E+01_r8,0.336162E+01_r8,0.340264E+01_r8,0.344407E+01_r8,0.348601E+01_r8, &
         &0.352838E+01_r8,0.357118E+01_r8,0.361449E+01_r8,0.365834E+01_r8,0.370264E+01_r8, &
         &0.374737E+01_r8,0.379265E+01_r8,0.383839E+01_r8,0.388469E+01_r8,0.393144E+01_r8, &
         &0.397876E+01_r8,0.402656E+01_r8,0.407492E+01_r8,0.412378E+01_r8,0.417313E+01_r8, &
         &0.422306E+01_r8,0.427359E+01_r8,0.432454E+01_r8,0.437617E+01_r8,0.442834E+01_r8, &
         &0.448102E+01_r8,0.453433E+01_r8,0.458816E+01_r8,0.464253E+01_r8,0.469764E+01_r8, &
         &0.475321E+01_r8,0.480942E+01_r8,0.486629E+01_r8,0.492372E+01_r8,0.498173E+01_r8/
    DATA (ES(IES),IES=381,475) /                                      &
         &0.504041E+01_r8,0.509967E+01_r8,0.515962E+01_r8,0.522029E+01_r8,0.528142E+01_r8, &
         &0.534337E+01_r8,0.540595E+01_r8,0.546912E+01_r8,0.553292E+01_r8,0.559757E+01_r8, &
         &0.566273E+01_r8,0.572864E+01_r8,0.579532E+01_r8,0.586266E+01_r8,0.593075E+01_r8, &
         &0.599952E+01_r8,0.606895E+01_r8,0.613918E+01_r8,0.621021E+01_r8,0.628191E+01_r8, &
         &0.635433E+01_r8,0.642755E+01_r8,0.650162E+01_r8,0.657639E+01_r8,0.665188E+01_r8, &
         &0.672823E+01_r8,0.680532E+01_r8,0.688329E+01_r8,0.696198E+01_r8,0.704157E+01_r8, &
         &0.712206E+01_r8,0.720319E+01_r8,0.728534E+01_r8,0.736829E+01_r8,0.745204E+01_r8, &
         &0.753671E+01_r8,0.762218E+01_r8,0.770860E+01_r8,0.779588E+01_r8,0.788408E+01_r8, &
         &0.797314E+01_r8,0.806318E+01_r8,0.815408E+01_r8,0.824599E+01_r8,0.833874E+01_r8, &
         &0.843254E+01_r8,0.852721E+01_r8,0.862293E+01_r8,0.871954E+01_r8,0.881724E+01_r8, &
         &0.891579E+01_r8,0.901547E+01_r8,0.911624E+01_r8,0.921778E+01_r8,0.932061E+01_r8, &
         &0.942438E+01_r8,0.952910E+01_r8,0.963497E+01_r8,0.974181E+01_r8,0.984982E+01_r8, &
         &0.995887E+01_r8,0.100690E+02_r8,0.101804E+02_r8,0.102926E+02_r8,0.104063E+02_r8, &
         &0.105210E+02_r8,0.106367E+02_r8,0.107536E+02_r8,0.108719E+02_r8,0.109912E+02_r8, &
         &0.111116E+02_r8,0.112333E+02_r8,0.113563E+02_r8,0.114804E+02_r8,0.116056E+02_r8, &
         &0.117325E+02_r8,0.118602E+02_r8,0.119892E+02_r8,0.121197E+02_r8,0.122513E+02_r8, &
         &0.123844E+02_r8,0.125186E+02_r8,0.126543E+02_r8,0.127912E+02_r8,0.129295E+02_r8, &
         &0.130691E+02_r8,0.132101E+02_r8,0.133527E+02_r8,0.134965E+02_r8,0.136415E+02_r8, &
         &0.137882E+02_r8,0.139361E+02_r8,0.140855E+02_r8,0.142366E+02_r8,0.143889E+02_r8/
    DATA (ES(IES),IES=476,570) /                                      &
         &0.145429E+02_r8,0.146982E+02_r8,0.148552E+02_r8,0.150135E+02_r8,0.151735E+02_r8, &
         &0.153349E+02_r8,0.154979E+02_r8,0.156624E+02_r8,0.158286E+02_r8,0.159965E+02_r8, &
         &0.161659E+02_r8,0.163367E+02_r8,0.165094E+02_r8,0.166838E+02_r8,0.168597E+02_r8, &
         &0.170375E+02_r8,0.172168E+02_r8,0.173979E+02_r8,0.175806E+02_r8,0.177651E+02_r8, &
         &0.179513E+02_r8,0.181394E+02_r8,0.183293E+02_r8,0.185210E+02_r8,0.187146E+02_r8, &
         &0.189098E+02_r8,0.191066E+02_r8,0.193059E+02_r8,0.195065E+02_r8,0.197095E+02_r8, &
         &0.199142E+02_r8,0.201206E+02_r8,0.203291E+02_r8,0.205397E+02_r8,0.207522E+02_r8, &
         &0.209664E+02_r8,0.211831E+02_r8,0.214013E+02_r8,0.216221E+02_r8,0.218448E+02_r8, &
         &0.220692E+02_r8,0.222959E+02_r8,0.225250E+02_r8,0.227559E+02_r8,0.229887E+02_r8, &
         &0.232239E+02_r8,0.234614E+02_r8,0.237014E+02_r8,0.239428E+02_r8,0.241872E+02_r8, &
         &0.244335E+02_r8,0.246824E+02_r8,0.249332E+02_r8,0.251860E+02_r8,0.254419E+02_r8, &
         &0.256993E+02_r8,0.259600E+02_r8,0.262225E+02_r8,0.264873E+02_r8,0.267552E+02_r8, &
         &0.270248E+02_r8,0.272970E+02_r8,0.275719E+02_r8,0.278497E+02_r8,0.281295E+02_r8, &
         &0.284117E+02_r8,0.286965E+02_r8,0.289843E+02_r8,0.292743E+02_r8,0.295671E+02_r8, &
         &0.298624E+02_r8,0.301605E+02_r8,0.304616E+02_r8,0.307650E+02_r8,0.310708E+02_r8, &
         &0.313803E+02_r8,0.316915E+02_r8,0.320064E+02_r8,0.323238E+02_r8,0.326437E+02_r8, &
         &0.329666E+02_r8,0.332928E+02_r8,0.336215E+02_r8,0.339534E+02_r8,0.342885E+02_r8, &
         &0.346263E+02_r8,0.349666E+02_r8,0.353109E+02_r8,0.356572E+02_r8,0.360076E+02_r8, &
         &0.363606E+02_r8,0.367164E+02_r8,0.370757E+02_r8,0.374383E+02_r8,0.378038E+02_r8/
    DATA (ES(IES),IES=571,665) /                                      &
         &0.381727E+02_r8,0.385453E+02_r8,0.389206E+02_r8,0.392989E+02_r8,0.396807E+02_r8, &
         &0.400663E+02_r8,0.404555E+02_r8,0.408478E+02_r8,0.412428E+02_r8,0.416417E+02_r8, &
         &0.420445E+02_r8,0.424502E+02_r8,0.428600E+02_r8,0.432733E+02_r8,0.436900E+02_r8, &
         &0.441106E+02_r8,0.445343E+02_r8,0.449620E+02_r8,0.453930E+02_r8,0.458280E+02_r8, &
         &0.462672E+02_r8,0.467096E+02_r8,0.471561E+02_r8,0.476070E+02_r8,0.480610E+02_r8, &
         &0.485186E+02_r8,0.489813E+02_r8,0.494474E+02_r8,0.499170E+02_r8,0.503909E+02_r8, &
         &0.508693E+02_r8,0.513511E+02_r8,0.518376E+02_r8,0.523277E+02_r8,0.528232E+02_r8, &
         &0.533213E+02_r8,0.538240E+02_r8,0.543315E+02_r8,0.548437E+02_r8,0.553596E+02_r8, &
         &0.558802E+02_r8,0.564046E+02_r8,0.569340E+02_r8,0.574672E+02_r8,0.580061E+02_r8, &
         &0.585481E+02_r8,0.590963E+02_r8,0.596482E+02_r8,0.602041E+02_r8,0.607649E+02_r8, &
         &0.613311E+02_r8,0.619025E+02_r8,0.624779E+02_r8,0.630574E+02_r8,0.636422E+02_r8, &
         &0.642324E+02_r8,0.648280E+02_r8,0.654278E+02_r8,0.660332E+02_r8,0.666426E+02_r8, &
         &0.672577E+02_r8,0.678771E+02_r8,0.685034E+02_r8,0.691328E+02_r8,0.697694E+02_r8, &
         &0.704103E+02_r8,0.710556E+02_r8,0.717081E+02_r8,0.723639E+02_r8,0.730269E+02_r8, &
         &0.736945E+02_r8,0.743681E+02_r8,0.750463E+02_r8,0.757309E+02_r8,0.764214E+02_r8, &
         &0.771167E+02_r8,0.778182E+02_r8,0.785246E+02_r8,0.792373E+02_r8,0.799564E+02_r8, &
         &0.806804E+02_r8,0.814109E+02_r8,0.821479E+02_r8,0.828898E+02_r8,0.836384E+02_r8, &
         &0.843922E+02_r8,0.851525E+02_r8,0.859198E+02_r8,0.866920E+02_r8,0.874712E+02_r8, &
         &0.882574E+02_r8,0.890486E+02_r8,0.898470E+02_r8,0.906525E+02_r8,0.914634E+02_r8/
    DATA (ES(IES),IES=666,760) /                                      &
         &0.922814E+02_r8,0.931048E+02_r8,0.939356E+02_r8,0.947736E+02_r8,0.956171E+02_r8, &
         &0.964681E+02_r8,0.973246E+02_r8,0.981907E+02_r8,0.990605E+02_r8,0.999399E+02_r8, &
         &0.100825E+03_r8,0.101718E+03_r8,0.102617E+03_r8,0.103523E+03_r8,0.104438E+03_r8, &
         &0.105358E+03_r8,0.106287E+03_r8,0.107221E+03_r8,0.108166E+03_r8,0.109115E+03_r8, &
         &0.110074E+03_r8,0.111039E+03_r8,0.112012E+03_r8,0.112992E+03_r8,0.113981E+03_r8, &
         &0.114978E+03_r8,0.115981E+03_r8,0.116993E+03_r8,0.118013E+03_r8,0.119041E+03_r8, &
         &0.120077E+03_r8,0.121122E+03_r8,0.122173E+03_r8,0.123234E+03_r8,0.124301E+03_r8, &
         &0.125377E+03_r8,0.126463E+03_r8,0.127556E+03_r8,0.128657E+03_r8,0.129769E+03_r8, &
         &0.130889E+03_r8,0.132017E+03_r8,0.133152E+03_r8,0.134299E+03_r8,0.135453E+03_r8, &
         &0.136614E+03_r8,0.137786E+03_r8,0.138967E+03_r8,0.140158E+03_r8,0.141356E+03_r8, &
         &0.142565E+03_r8,0.143781E+03_r8,0.145010E+03_r8,0.146247E+03_r8,0.147491E+03_r8, &
         &0.148746E+03_r8,0.150011E+03_r8,0.151284E+03_r8,0.152571E+03_r8,0.153862E+03_r8, &
         &0.155168E+03_r8,0.156481E+03_r8,0.157805E+03_r8,0.159137E+03_r8,0.160478E+03_r8, &
         &0.161832E+03_r8,0.163198E+03_r8,0.164569E+03_r8,0.165958E+03_r8,0.167348E+03_r8, &
         &0.168757E+03_r8,0.170174E+03_r8,0.171599E+03_r8,0.173037E+03_r8,0.174483E+03_r8, &
         &0.175944E+03_r8,0.177414E+03_r8,0.178892E+03_r8,0.180387E+03_r8,0.181886E+03_r8, &
         &0.183402E+03_r8,0.184930E+03_r8,0.186463E+03_r8,0.188012E+03_r8,0.189571E+03_r8, &
         &0.191146E+03_r8,0.192730E+03_r8,0.194320E+03_r8,0.195930E+03_r8,0.197546E+03_r8, &
         &0.199175E+03_r8,0.200821E+03_r8,0.202473E+03_r8,0.204142E+03_r8,0.205817E+03_r8/
    DATA (ES(IES),IES=761,855) /                                      &
         &0.207510E+03_r8,0.209216E+03_r8,0.210928E+03_r8,0.212658E+03_r8,0.214398E+03_r8, &
         &0.216152E+03_r8,0.217920E+03_r8,0.219698E+03_r8,0.221495E+03_r8,0.223297E+03_r8, &
         &0.225119E+03_r8,0.226951E+03_r8,0.228793E+03_r8,0.230654E+03_r8,0.232522E+03_r8, &
         &0.234413E+03_r8,0.236311E+03_r8,0.238223E+03_r8,0.240151E+03_r8,0.242090E+03_r8, &
         &0.244049E+03_r8,0.246019E+03_r8,0.248000E+03_r8,0.249996E+03_r8,0.252009E+03_r8, &
         &0.254037E+03_r8,0.256077E+03_r8,0.258128E+03_r8,0.260200E+03_r8,0.262284E+03_r8, &
         &0.264384E+03_r8,0.266500E+03_r8,0.268629E+03_r8,0.270779E+03_r8,0.272936E+03_r8, &
         &0.275110E+03_r8,0.277306E+03_r8,0.279509E+03_r8,0.281734E+03_r8,0.283966E+03_r8, &
         &0.286227E+03_r8,0.288494E+03_r8,0.290780E+03_r8,0.293083E+03_r8,0.295398E+03_r8, &
         &0.297737E+03_r8,0.300089E+03_r8,0.302453E+03_r8,0.304841E+03_r8,0.307237E+03_r8, &
         &0.309656E+03_r8,0.312095E+03_r8,0.314541E+03_r8,0.317012E+03_r8,0.319496E+03_r8, &
         &0.322005E+03_r8,0.324527E+03_r8,0.327063E+03_r8,0.329618E+03_r8,0.332193E+03_r8, &
         &0.334788E+03_r8,0.337396E+03_r8,0.340025E+03_r8,0.342673E+03_r8,0.345329E+03_r8, &
         &0.348019E+03_r8,0.350722E+03_r8,0.353440E+03_r8,0.356178E+03_r8,0.358938E+03_r8, &
         &0.361718E+03_r8,0.364513E+03_r8,0.367322E+03_r8,0.370160E+03_r8,0.373012E+03_r8, &
         &0.375885E+03_r8,0.378788E+03_r8,0.381691E+03_r8,0.384631E+03_r8,0.387579E+03_r8, &
         &0.390556E+03_r8,0.393556E+03_r8,0.396563E+03_r8,0.399601E+03_r8,0.402646E+03_r8, &
         &0.405730E+03_r8,0.408829E+03_r8,0.411944E+03_r8,0.415083E+03_r8,0.418236E+03_r8, &
         &0.421422E+03_r8,0.424632E+03_r8,0.427849E+03_r8,0.431099E+03_r8,0.434365E+03_r8/
    DATA (ES(IES),IES=856,950) /                                      &
         &0.437655E+03_r8,0.440970E+03_r8,0.444301E+03_r8,0.447666E+03_r8,0.451038E+03_r8, &
         &0.454445E+03_r8,0.457876E+03_r8,0.461316E+03_r8,0.464790E+03_r8,0.468281E+03_r8, &
         &0.471798E+03_r8,0.475342E+03_r8,0.478902E+03_r8,0.482497E+03_r8,0.486101E+03_r8, &
         &0.489741E+03_r8,0.493408E+03_r8,0.497083E+03_r8,0.500804E+03_r8,0.504524E+03_r8, &
         &0.508290E+03_r8,0.512074E+03_r8,0.515877E+03_r8,0.519717E+03_r8,0.523566E+03_r8, &
         &0.527462E+03_r8,0.531367E+03_r8,0.535301E+03_r8,0.539264E+03_r8,0.543245E+03_r8, &
         &0.547265E+03_r8,0.551305E+03_r8,0.555363E+03_r8,0.559462E+03_r8,0.563579E+03_r8, &
         &0.567727E+03_r8,0.571905E+03_r8,0.576102E+03_r8,0.580329E+03_r8,0.584576E+03_r8, &
         &0.588865E+03_r8,0.593185E+03_r8,0.597514E+03_r8,0.601885E+03_r8,0.606276E+03_r8, &
         &0.610699E+03_r8,0.615151E+03_r8,0.619625E+03_r8,0.624140E+03_r8,0.628671E+03_r8, &
         &0.633243E+03_r8,0.637845E+03_r8,0.642465E+03_r8,0.647126E+03_r8,0.651806E+03_r8, &
         &0.656527E+03_r8,0.661279E+03_r8,0.666049E+03_r8,0.670861E+03_r8,0.675692E+03_r8, &
         &0.680566E+03_r8,0.685471E+03_r8,0.690396E+03_r8,0.695363E+03_r8,0.700350E+03_r8, &
         &0.705381E+03_r8,0.710444E+03_r8,0.715527E+03_r8,0.720654E+03_r8,0.725801E+03_r8, &
         &0.730994E+03_r8,0.736219E+03_r8,0.741465E+03_r8,0.746756E+03_r8,0.752068E+03_r8, &
         &0.757426E+03_r8,0.762819E+03_r8,0.768231E+03_r8,0.773692E+03_r8,0.779172E+03_r8, &
         &0.784701E+03_r8,0.790265E+03_r8,0.795849E+03_r8,0.801483E+03_r8,0.807137E+03_r8, &
         &0.812842E+03_r8,0.818582E+03_r8,0.824343E+03_r8,0.830153E+03_r8,0.835987E+03_r8, &
         &0.841871E+03_r8,0.847791E+03_r8,0.853733E+03_r8,0.859727E+03_r8,0.865743E+03_r8/
    DATA (ES(IES),IES=951,1045) /                                     &
         &0.871812E+03_r8,0.877918E+03_r8,0.884046E+03_r8,0.890228E+03_r8,0.896433E+03_r8, &
         &0.902690E+03_r8,0.908987E+03_r8,0.915307E+03_r8,0.921681E+03_r8,0.928078E+03_r8, &
         &0.934531E+03_r8,0.941023E+03_r8,0.947539E+03_r8,0.954112E+03_r8,0.960708E+03_r8, &
         &0.967361E+03_r8,0.974053E+03_r8,0.980771E+03_r8,0.987545E+03_r8,0.994345E+03_r8, &
         &0.100120E+04_r8,0.100810E+04_r8,0.101502E+04_r8,0.102201E+04_r8,0.102902E+04_r8, &
         &0.103608E+04_r8,0.104320E+04_r8,0.105033E+04_r8,0.105753E+04_r8,0.106475E+04_r8, &
         &0.107204E+04_r8,0.107936E+04_r8,0.108672E+04_r8,0.109414E+04_r8,0.110158E+04_r8, &
         &0.110908E+04_r8,0.111663E+04_r8,0.112421E+04_r8,0.113185E+04_r8,0.113952E+04_r8, &
         &0.114725E+04_r8,0.115503E+04_r8,0.116284E+04_r8,0.117071E+04_r8,0.117861E+04_r8, &
         &0.118658E+04_r8,0.119459E+04_r8,0.120264E+04_r8,0.121074E+04_r8,0.121888E+04_r8, &
         &0.122709E+04_r8,0.123534E+04_r8,0.124362E+04_r8,0.125198E+04_r8,0.126036E+04_r8, &
         &0.126881E+04_r8,0.127731E+04_r8,0.128584E+04_r8,0.129444E+04_r8,0.130307E+04_r8, &
         &0.131177E+04_r8,0.132053E+04_r8,0.132931E+04_r8,0.133817E+04_r8,0.134705E+04_r8, &
         &0.135602E+04_r8,0.136503E+04_r8,0.137407E+04_r8,0.138319E+04_r8,0.139234E+04_r8, &
         &0.140156E+04_r8,0.141084E+04_r8,0.142015E+04_r8,0.142954E+04_r8,0.143896E+04_r8, &
         &0.144845E+04_r8,0.145800E+04_r8,0.146759E+04_r8,0.147725E+04_r8,0.148694E+04_r8, &
         &0.149672E+04_r8,0.150655E+04_r8,0.151641E+04_r8,0.152635E+04_r8,0.153633E+04_r8, &
         &0.154639E+04_r8,0.155650E+04_r8,0.156665E+04_r8,0.157688E+04_r8,0.158715E+04_r8, &
         &0.159750E+04_r8,0.160791E+04_r8,0.161836E+04_r8,0.162888E+04_r8,0.163945E+04_r8/
    DATA (ES(IES),IES=1046,1140) /                                    &
         &0.165010E+04_r8,0.166081E+04_r8,0.167155E+04_r8,0.168238E+04_r8,0.169325E+04_r8, &
         &0.170420E+04_r8,0.171522E+04_r8,0.172627E+04_r8,0.173741E+04_r8,0.174859E+04_r8, &
         &0.175986E+04_r8,0.177119E+04_r8,0.178256E+04_r8,0.179402E+04_r8,0.180552E+04_r8, &
         &0.181711E+04_r8,0.182877E+04_r8,0.184046E+04_r8,0.185224E+04_r8,0.186407E+04_r8, &
         &0.187599E+04_r8,0.188797E+04_r8,0.190000E+04_r8,0.191212E+04_r8,0.192428E+04_r8, &
         &0.193653E+04_r8,0.194886E+04_r8,0.196122E+04_r8,0.197368E+04_r8,0.198618E+04_r8, &
         &0.199878E+04_r8,0.201145E+04_r8,0.202416E+04_r8,0.203698E+04_r8,0.204983E+04_r8, &
         &0.206278E+04_r8,0.207580E+04_r8,0.208887E+04_r8,0.210204E+04_r8,0.211525E+04_r8, &
         &0.212856E+04_r8,0.214195E+04_r8,0.215538E+04_r8,0.216892E+04_r8,0.218249E+04_r8, &
         &0.219618E+04_r8,0.220994E+04_r8,0.222375E+04_r8,0.223766E+04_r8,0.225161E+04_r8, &
         &0.226567E+04_r8,0.227981E+04_r8,0.229399E+04_r8,0.230829E+04_r8,0.232263E+04_r8, &
         &0.233708E+04_r8,0.235161E+04_r8,0.236618E+04_r8,0.238087E+04_r8,0.239560E+04_r8, &
         &0.241044E+04_r8,0.242538E+04_r8,0.244035E+04_r8,0.245544E+04_r8,0.247057E+04_r8, &
         &0.248583E+04_r8,0.250116E+04_r8,0.251654E+04_r8,0.253204E+04_r8,0.254759E+04_r8, &
         &0.256325E+04_r8,0.257901E+04_r8,0.259480E+04_r8,0.261073E+04_r8,0.262670E+04_r8, &
         &0.264279E+04_r8,0.265896E+04_r8,0.267519E+04_r8,0.269154E+04_r8,0.270794E+04_r8, &
         &0.272447E+04_r8,0.274108E+04_r8,0.275774E+04_r8,0.277453E+04_r8,0.279137E+04_r8, &
         &0.280834E+04_r8,0.282540E+04_r8,0.284251E+04_r8,0.285975E+04_r8,0.287704E+04_r8, &
         &0.289446E+04_r8,0.291198E+04_r8,0.292954E+04_r8,0.294725E+04_r8,0.296499E+04_r8/
    DATA (ES(IES),IES=1141,1235) /                                    &
         &0.298288E+04_r8,0.300087E+04_r8,0.301890E+04_r8,0.303707E+04_r8,0.305529E+04_r8, &
         &0.307365E+04_r8,0.309211E+04_r8,0.311062E+04_r8,0.312927E+04_r8,0.314798E+04_r8, &
         &0.316682E+04_r8,0.318577E+04_r8,0.320477E+04_r8,0.322391E+04_r8,0.324310E+04_r8, &
         &0.326245E+04_r8,0.328189E+04_r8,0.330138E+04_r8,0.332103E+04_r8,0.334073E+04_r8, &
         &0.336058E+04_r8,0.338053E+04_r8,0.340054E+04_r8,0.342069E+04_r8,0.344090E+04_r8, &
         &0.346127E+04_r8,0.348174E+04_r8,0.350227E+04_r8,0.352295E+04_r8,0.354369E+04_r8, &
         &0.356458E+04_r8,0.358559E+04_r8,0.360664E+04_r8,0.362787E+04_r8,0.364914E+04_r8, &
         &0.367058E+04_r8,0.369212E+04_r8,0.371373E+04_r8,0.373548E+04_r8,0.375731E+04_r8, &
         &0.377929E+04_r8,0.380139E+04_r8,0.382355E+04_r8,0.384588E+04_r8,0.386826E+04_r8, &
         &0.389081E+04_r8,0.391348E+04_r8,0.393620E+04_r8,0.395910E+04_r8,0.398205E+04_r8, &
         &0.400518E+04_r8,0.402843E+04_r8,0.405173E+04_r8,0.407520E+04_r8,0.409875E+04_r8, &
         &0.412246E+04_r8,0.414630E+04_r8,0.417019E+04_r8,0.419427E+04_r8,0.421840E+04_r8, &
         &0.424272E+04_r8,0.426715E+04_r8,0.429165E+04_r8,0.431634E+04_r8,0.434108E+04_r8, &
         &0.436602E+04_r8,0.439107E+04_r8,0.441618E+04_r8,0.444149E+04_r8,0.446685E+04_r8, &
         &0.449241E+04_r8,0.451810E+04_r8,0.454385E+04_r8,0.456977E+04_r8,0.459578E+04_r8, &
         &0.462197E+04_r8,0.464830E+04_r8,0.467468E+04_r8,0.470127E+04_r8,0.472792E+04_r8, &
         &0.475477E+04_r8,0.478175E+04_r8,0.480880E+04_r8,0.483605E+04_r8,0.486336E+04_r8, &
         &0.489087E+04_r8,0.491853E+04_r8,0.494623E+04_r8,0.497415E+04_r8,0.500215E+04_r8, &
         &0.503034E+04_r8,0.505867E+04_r8,0.508707E+04_r8,0.511568E+04_r8,0.514436E+04_r8/
    DATA (ES(IES),IES=1236,1330) /                                    &
         &0.517325E+04_r8,0.520227E+04_r8,0.523137E+04_r8,0.526068E+04_r8,0.529005E+04_r8, &
         &0.531965E+04_r8,0.534939E+04_r8,0.537921E+04_r8,0.540923E+04_r8,0.543932E+04_r8, &
         &0.546965E+04_r8,0.550011E+04_r8,0.553064E+04_r8,0.556139E+04_r8,0.559223E+04_r8, &
         &0.562329E+04_r8,0.565449E+04_r8,0.568577E+04_r8,0.571727E+04_r8,0.574884E+04_r8, &
         &0.578064E+04_r8,0.581261E+04_r8,0.584464E+04_r8,0.587692E+04_r8,0.590924E+04_r8, &
         &0.594182E+04_r8,0.597455E+04_r8,0.600736E+04_r8,0.604039E+04_r8,0.607350E+04_r8, &
         &0.610685E+04_r8,0.614036E+04_r8,0.617394E+04_r8,0.620777E+04_r8,0.624169E+04_r8, &
         &0.627584E+04_r8,0.631014E+04_r8,0.634454E+04_r8,0.637918E+04_r8,0.641390E+04_r8, &
         &0.644887E+04_r8,0.648400E+04_r8,0.651919E+04_r8,0.655467E+04_r8,0.659021E+04_r8, &
         &0.662599E+04_r8,0.666197E+04_r8,0.669800E+04_r8,0.673429E+04_r8,0.677069E+04_r8, &
         &0.680735E+04_r8,0.684415E+04_r8,0.688104E+04_r8,0.691819E+04_r8,0.695543E+04_r8, &
         &0.699292E+04_r8,0.703061E+04_r8,0.706837E+04_r8,0.710639E+04_r8,0.714451E+04_r8, &
         &0.718289E+04_r8,0.722143E+04_r8,0.726009E+04_r8,0.729903E+04_r8,0.733802E+04_r8, &
         &0.737729E+04_r8,0.741676E+04_r8,0.745631E+04_r8,0.749612E+04_r8,0.753602E+04_r8, &
         &0.757622E+04_r8,0.761659E+04_r8,0.765705E+04_r8,0.769780E+04_r8,0.773863E+04_r8, &
         &0.777975E+04_r8,0.782106E+04_r8,0.786246E+04_r8,0.790412E+04_r8,0.794593E+04_r8, &
         &0.798802E+04_r8,0.803028E+04_r8,0.807259E+04_r8,0.811525E+04_r8,0.815798E+04_r8, &
         &0.820102E+04_r8,0.824427E+04_r8,0.828757E+04_r8,0.833120E+04_r8,0.837493E+04_r8, &
         &0.841895E+04_r8,0.846313E+04_r8,0.850744E+04_r8,0.855208E+04_r8,0.859678E+04_r8/
    DATA (ES(IES),IES=1331,1425) /                                    &
         &0.864179E+04_r8,0.868705E+04_r8,0.873237E+04_r8,0.877800E+04_r8,0.882374E+04_r8, &
         &0.886979E+04_r8,0.891603E+04_r8,0.896237E+04_r8,0.900904E+04_r8,0.905579E+04_r8, &
         &0.910288E+04_r8,0.915018E+04_r8,0.919758E+04_r8,0.924529E+04_r8,0.929310E+04_r8, &
         &0.934122E+04_r8,0.938959E+04_r8,0.943804E+04_r8,0.948687E+04_r8,0.953575E+04_r8, &
         &0.958494E+04_r8,0.963442E+04_r8,0.968395E+04_r8,0.973384E+04_r8,0.978383E+04_r8, &
         &0.983412E+04_r8,0.988468E+04_r8,0.993534E+04_r8,0.998630E+04_r8,0.100374E+05_r8, &
         &0.100888E+05_r8,0.101406E+05_r8,0.101923E+05_r8,0.102444E+05_r8,0.102966E+05_r8, &
         &0.103492E+05_r8,0.104020E+05_r8,0.104550E+05_r8,0.105082E+05_r8,0.105616E+05_r8, &
         &0.106153E+05_r8,0.106693E+05_r8,0.107234E+05_r8,0.107779E+05_r8,0.108325E+05_r8, &
         &0.108874E+05_r8,0.109425E+05_r8,0.109978E+05_r8,0.110535E+05_r8,0.111092E+05_r8, &
         &0.111653E+05_r8,0.112217E+05_r8,0.112782E+05_r8,0.113350E+05_r8,0.113920E+05_r8, &
         &0.114493E+05_r8,0.115070E+05_r8,0.115646E+05_r8,0.116228E+05_r8,0.116809E+05_r8, &
         &0.117396E+05_r8,0.117984E+05_r8,0.118574E+05_r8,0.119167E+05_r8,0.119762E+05_r8, &
         &0.120360E+05_r8,0.120962E+05_r8,0.121564E+05_r8,0.122170E+05_r8,0.122778E+05_r8, &
         &0.123389E+05_r8,0.124004E+05_r8,0.124619E+05_r8,0.125238E+05_r8,0.125859E+05_r8, &
         &0.126484E+05_r8,0.127111E+05_r8,0.127739E+05_r8,0.128372E+05_r8,0.129006E+05_r8, &
         &0.129644E+05_r8,0.130285E+05_r8,0.130927E+05_r8,0.131573E+05_r8,0.132220E+05_r8, &
         &0.132872E+05_r8,0.133526E+05_r8,0.134182E+05_r8,0.134842E+05_r8,0.135503E+05_r8, &
         &0.136168E+05_r8,0.136836E+05_r8,0.137505E+05_r8,0.138180E+05_r8,0.138854E+05_r8/
    DATA (ES(IES),IES=1426,1520) /                                    &
         &0.139534E+05_r8,0.140216E+05_r8,0.140900E+05_r8,0.141588E+05_r8,0.142277E+05_r8, &
         &0.142971E+05_r8,0.143668E+05_r8,0.144366E+05_r8,0.145069E+05_r8,0.145773E+05_r8, &
         &0.146481E+05_r8,0.147192E+05_r8,0.147905E+05_r8,0.148622E+05_r8,0.149341E+05_r8, &
         &0.150064E+05_r8,0.150790E+05_r8,0.151517E+05_r8,0.152250E+05_r8,0.152983E+05_r8, &
         &0.153721E+05_r8,0.154462E+05_r8,0.155205E+05_r8,0.155952E+05_r8,0.156701E+05_r8, &
         &0.157454E+05_r8,0.158211E+05_r8,0.158969E+05_r8,0.159732E+05_r8,0.160496E+05_r8, &
         &0.161265E+05_r8,0.162037E+05_r8,0.162811E+05_r8,0.163589E+05_r8,0.164369E+05_r8, &
         &0.165154E+05_r8,0.165942E+05_r8,0.166732E+05_r8,0.167526E+05_r8,0.168322E+05_r8, &
         &0.169123E+05_r8,0.169927E+05_r8,0.170733E+05_r8,0.171543E+05_r8,0.172356E+05_r8, &
         &0.173173E+05_r8,0.173993E+05_r8,0.174815E+05_r8,0.175643E+05_r8,0.176471E+05_r8, &
         &0.177305E+05_r8,0.178143E+05_r8,0.178981E+05_r8,0.179826E+05_r8,0.180671E+05_r8, &
         &0.181522E+05_r8,0.182377E+05_r8,0.183232E+05_r8,0.184093E+05_r8,0.184955E+05_r8, &
         &0.185823E+05_r8,0.186695E+05_r8,0.187568E+05_r8,0.188447E+05_r8,0.189326E+05_r8, &
         &0.190212E+05_r8,0.191101E+05_r8,0.191991E+05_r8,0.192887E+05_r8,0.193785E+05_r8, &
         &0.194688E+05_r8,0.195595E+05_r8,0.196503E+05_r8,0.197417E+05_r8,0.198332E+05_r8, &
         &0.199253E+05_r8,0.200178E+05_r8,0.201105E+05_r8,0.202036E+05_r8,0.202971E+05_r8, &
         &0.203910E+05_r8,0.204853E+05_r8,0.205798E+05_r8,0.206749E+05_r8,0.207701E+05_r8, &
         &0.208659E+05_r8,0.209621E+05_r8,0.210584E+05_r8,0.211554E+05_r8,0.212524E+05_r8, &
         &0.213501E+05_r8,0.214482E+05_r8,0.215465E+05_r8,0.216452E+05_r8,0.217442E+05_r8/
    DATA (ES(IES),IES=1521,1552) /                                    &
         &0.218439E+05_r8,0.219439E+05_r8,0.220440E+05_r8,0.221449E+05_r8,0.222457E+05_r8, &
         &0.223473E+05_r8,0.224494E+05_r8,0.225514E+05_r8,0.226542E+05_r8,0.227571E+05_r8, &
         &0.228606E+05_r8,0.229646E+05_r8,0.230687E+05_r8,0.231734E+05_r8,0.232783E+05_r8, &
         &0.233839E+05_r8,0.234898E+05_r8,0.235960E+05_r8,0.237027E+05_r8,0.238097E+05_r8, &
         &0.239173E+05_r8,0.240254E+05_r8,0.241335E+05_r8,0.242424E+05_r8,0.243514E+05_r8, &
         &0.244611E+05_r8,0.245712E+05_r8,0.246814E+05_r8,0.247923E+05_r8,0.249034E+05_r8, &
         &0.250152E+05_r8,0.250152E+05_r8/
    !
    ! Npnts_do_1:
    DO I=1,NPNTS
       !      COMPUTE THE FACTOR THAT CONVERTS FROM SAT VAPOUR PRESSURE IN A
       !      PURE WATER SYSTEM TO SAT VAPOUR PRESSURE IN AIR, FSUBW.
       !      THIS FORMULA IS TAKEN FROM EQUATION A4.7 OF ADRIAN GILL'S BOOK:
       !      ATMOSPHERE-ocean DYNAMICS. NOTE THAT HIS FORMULA WORKS IN TERMS
       !      OF PRESSURE IN MB AND TEMPERATURE IN CELSIUS, SO CONVERSION OF
       !      UNITS LEADS TO THE SLIGHTLY DIFFERENT EQUATION USED HERE.
       !
       FSUBW = 1.0_r8 + 1.0E-8_r8*P(I)*( 4.5_r8 +                               &
            &    6.0E-4_r8*( T(I) - ZERODEGC )*( T(I) - ZERODEGC ) )
       !
       !      USE THE LOOKUP TABLE TO FIND SATURATED VAPOUR PRESSURE, AND STORE
       !      IT IN QS.
       !
       TT = MAX(T_LOW,T(I))
       TT = MIN(T_HIGH,TT)
       !
       ATABLE = (TT - T_LOW + DELTA_T) / DELTA_T
       ITABLE = INT(ATABLE)
       ATABLE = ATABLE - ITABLE
       !
       QS(I) = (1.0_r8 - ATABLE)*ES(ITABLE) + ATABLE*ES(ITABLE+1)
       !
       !      MULTIPLY BY FSUBW TO CONVERT TO SATURATED VAPOUR PRESSURE IN AIR
       !      (EQUATION A4.6 OF ADRIAN GILL'S BOOK).
       !
       QS(I) = QS(I) * FSUBW
       !
       !      NOW FORM THE ACCURATE EXPRESSION FOR QS, WHICH IS A REARRANGED
       !      VERSION OF EQUATION A4.3 OF GILL'S BOOK.
       !
       !      NOTE THAT AT VERY LOW PRESSURES WE APPLY A FIX, TO PREVENT A
       !      SINGULARITY (Qsat tends to 1. kg/kg).
       !
       QS(I) = ( EPSILON*QS(I) ) /                                     &
            &          ( MAX(P(I),QS(I)) - ONE_MINUS_EPSILON*QS(I) )
       !
    END DO ! Npnts_do_1
    !
    RETURN
  END SUBROUTINE QSAT_WAT
  ! ======================================================================



  ! *****************************COPYRIGHT*******************************
  ! (C) Crown copyright Met Office. All rights reserved.
  ! For further details please refer to the file COPYRIGHT.txt
  ! which you should have received as part of this distribution.
  ! *****************************COPYRIGHT*******************************
  !
  !+ Saturation Specific Humidity Scheme (Qsat): Vapour to Liquid/Ice.
  ! Subroutine Interface:
  SUBROUTINE QSAT (                                                 &
                                !      Output field
       &  QS                                                              &
                                !      Input fields
       &, T, P                                                            &
                                !      Array dimensions
       &, NPNTS                                                           &
       &  )
    !
    IMPLICIT NONE
    !
    ! Purpose:
    !   RETURNS A SATURATION MIXING RATIO GIVEN A TEMPERATURE AND PRESSURE
    !   USING SATURATION VAPOUR PRESSURES CALCULATED USING THE GOFF-GRATCH
    !   FORMULAE, ADOPTED BY THE WMO AS TAKEN FROM LANDOLT-BORNSTEIN, 1987
    !   NUMERICAL DATA AND FUNCTIONAL RELATIONSHIPS IN SCIENCE AND
    !   TECHNOLOGY. GROUP V/VOL 4B METEOROLOGY. PHYSICAL AND CHEMICAL
    !   PROPERTIES OF AIR, P35
    !
    !   VALUES IN THE LOOKUP TABLE ARE OVER WATER ABOVE 0 DEG C AND OVER ICE
    !   BELOW THIS TEMPERATURE
    !
    ! Method:
    !   Uses lookup tables to find eSAT, calculates qSAT directly from that.
    !
    ! Current Owner of Code: OWNER OF LARGE_SCALE CLOUD CODE.
    !
    ! History:
    !   Version  Date    Comment
    !    5.1   14-03-00  Correct 2B (optimized) version for use in UM5.x .
    !                                                        A.C.Bushell
    !    6.2   03-02-06  Moved to a71_1a. P.Selwood
    !
    ! Code Description:
    !   Language: FORTRAN 77  + common extensions also in Fortran90.
    !   This code is written to UMDP3 version 6 programming standards.
    !
    !   Documentation: UMDP No.29
    !
    ! Declarations:
    !
    !  Global Variables:----------------------------------------------------
    !*L------------------COMDECK C_EPSLON-----------------------------------
    ! EPSILON IS RATIO OF MOLECULAR WEIGHTS OF WATER AND DRY AIR

    REAL(KIND=r8), PARAMETER :: Epsilon   = 0.62198_r8
    REAL(KIND=r8), PARAMETER :: C_Virtual = 1.0_r8/Epsilon-1.0_r8

    !*----------------------------------------------------------------------
    !*L------------------COMDECK C_O_DG_C-----------------------------------
    ! ZERODEGC IS CONVERSION BETWEEN DEGREES CELSIUS AND KELVIN
    ! TFS IS TEMPERATURE AT WHICH SEA WATER FREEZES
    ! TM IS TEMPERATURE AT WHICH FRESH WATER FREEZES AND ICE MELTS

    REAL(KIND=r8), PARAMETER :: ZeroDegC = 273.15_r8
    REAL(KIND=r8), PARAMETER :: TFS      = 271.35_r8
    REAL(KIND=r8), PARAMETER :: TM       = 273.15_r8

    !*----------------------------------------------------------------------
    !
    !  Subroutine Arguments:------------------------------------------------
    !
    ! arguments with intent in. ie: input variables.
    !
    INTEGER                                                           &
                                !, INTENT(IN)
         &  NPNTS
    !       Points (=horizontal dimensions) being processed by qSAT scheme.
    !
    REAL(KIND=r8)                                                              &
                                !, INTENT(IN)
         &  T(NPNTS)                                                        &
                                !       Temperature (K).
         &, P(NPNTS)
    !       Pressure (Pa).
    !
    ! arguments with intent out. ie: output variables.
    !
    REAL(KIND=r8)                                                              &
                                !, INTENT(OUT)
         &  QS(NPNTS)
    !       SATURATION MIXING RATIO AT TEMPERATURE T AND PRESSURE P (KG/KG)
    !
    !  Local parameters and other physical constants------------------------
    REAL(KIND=r8) ONE_MINUS_EPSILON  ! ONE MINUS THE RATIO OF THE MOLECULAR
    !                               WEIGHTS OF WATER AND DRY AIR
    !
    REAL(KIND=r8) T_LOW        ! LOWEST TEMPERATURE FOR WHICH LOOK-UP TABLE OF
    !                         SATURATION WATER VAPOUR PRESSURE IS VALID (K)
    !
    REAL(KIND=r8) T_HIGH       ! HIGHEST TEMPERATURE FOR WHICH LOOK-UP TABLE OF
    !                         SATURATION WATER VAPOUR PRESSURE IS VALID (K)
    !
    REAL(KIND=r8) DELTA_T      ! TEMPERATURE INCREMENT OF THE LOOK-UP
    ! TABLE OF SATURATION VAPOUR PRESSURES
    !
    INTEGER N         ! SIZE OF LOOK-UP TABLE OF SATURATION
    ! WATER VAPOUR PRESSURES
    !
    PARAMETER ( ONE_MINUS_EPSILON = 1.0_r8 - EPSILON,                    &
         &            T_LOW = 183.15_r8,                                       &
         &            T_HIGH = 338.15_r8,                                      &
         &            DELTA_T = 0.1_r8,                                        &
         &            N = ((T_HIGH - T_LOW + (DELTA_T*0.5_r8))/DELTA_T) + 1.0_r8  &
         &          )    ! gives N=1551
    !
    !  Local scalars--------------------------------------------------------
    !
    !  (a) Scalars effectively expanded to workspace by the Cray (using
    !      vector registers).
    !
    INTEGER ITABLE    ! WORK VARIABLES
    !
    REAL(KIND=r8) ATABLE       ! WORK VARIABLES
    !
    !     VARIABLES INTRODUCED BY DLR.
    !
    REAL(KIND=r8) FSUBW        ! FACTOR THAT CONVERTS FROM SAT VAPOUR PRESSURE
    !                         IN A PURE WATER SYSTEM TO SAT VAPOUR PRESSURE
    !                         IN AIR.
    REAL(KIND=r8) TT
    !
    !  (b) Others.
    INTEGER I         ! LOOP COUNTERS
    !
    INTEGER IES       ! LOOP COUNTER FOR DATA STATEMENT LOOK-UP TABLE
    !
    !  Local dynamic arrays-------------------------------------------------
    REAL(KIND=r8) ES(0:N+1)    ! TABLE OF SATURATION WATER VAPOUR PRESSURE (PA)
    !                       - SET BY DATA STATEMENT CALCULATED FROM THE
    !                         GOFF-GRATCH FORMULAE AS TAKEN FROM LANDOLT-
    !                         BORNSTEIN, 1987 NUMERICAL DATA AND FUNCTIONAL
    !                         RELATIONSHIPS IN SCIENCE AND TECHNOLOGY.
    !                         GROUP V/ VOL 4B METEOROLOGY. PHYSICAL AND
    !                         CHEMICAL PROPERTIES OF AIR, P35
    !
    !  External subroutine calls: ------------------------------------------
    !     EXTERNAL None
    !- End of Header
    !
    ! ==Main Block==--------------------------------------------------------
    ! Subroutine structure :
    ! NO SIGNIFICANT STRUCTURE
    ! ----------------------------------------------------------------------
    ! SATURATION WATER VAPOUR PRESSURE
    !
    ! ABOVE 0 DEG C VALUES ARE OVER WATER
    !
    ! BELOW 0 DEC C VALUES ARE OVER ICE
    ! ----------------------------------------------------------------------
    ! Note: 0 element is a repeat of 1st element to cater for special case
    !       of low temperatures ( <= T_LOW) for which the array index is
    !       rounded down due to machine precision.
    DATA (ES(IES),IES=    0, 95) / 0.966483E-02_r8,                      &
         &0.966483E-02_r8,0.984279E-02_r8,0.100240E-01_r8,0.102082E-01_r8,0.103957E-01_r8, &
         &0.105865E-01_r8,0.107803E-01_r8,0.109777E-01_r8,0.111784E-01_r8,0.113825E-01_r8, &
         &0.115902E-01_r8,0.118016E-01_r8,0.120164E-01_r8,0.122348E-01_r8,0.124572E-01_r8, &
         &0.126831E-01_r8,0.129132E-01_r8,0.131470E-01_r8,0.133846E-01_r8,0.136264E-01_r8, &
         &0.138724E-01_r8,0.141225E-01_r8,0.143771E-01_r8,0.146356E-01_r8,0.148985E-01_r8, &
         &0.151661E-01_r8,0.154379E-01_r8,0.157145E-01_r8,0.159958E-01_r8,0.162817E-01_r8, &
         &0.165725E-01_r8,0.168680E-01_r8,0.171684E-01_r8,0.174742E-01_r8,0.177847E-01_r8, &
         &0.181008E-01_r8,0.184216E-01_r8,0.187481E-01_r8,0.190801E-01_r8,0.194175E-01_r8, &
         &0.197608E-01_r8,0.201094E-01_r8,0.204637E-01_r8,0.208242E-01_r8,0.211906E-01_r8, &
         &0.215631E-01_r8,0.219416E-01_r8,0.223263E-01_r8,0.227172E-01_r8,0.231146E-01_r8, &
         &0.235188E-01_r8,0.239296E-01_r8,0.243465E-01_r8,0.247708E-01_r8,0.252019E-01_r8, &
         &0.256405E-01_r8,0.260857E-01_r8,0.265385E-01_r8,0.269979E-01_r8,0.274656E-01_r8, &
         &0.279405E-01_r8,0.284232E-01_r8,0.289142E-01_r8,0.294124E-01_r8,0.299192E-01_r8, &
         &0.304341E-01_r8,0.309571E-01_r8,0.314886E-01_r8,0.320285E-01_r8,0.325769E-01_r8, &
         &0.331348E-01_r8,0.337014E-01_r8,0.342771E-01_r8,0.348618E-01_r8,0.354557E-01_r8, &
         &0.360598E-01_r8,0.366727E-01_r8,0.372958E-01_r8,0.379289E-01_r8,0.385717E-01_r8, &
         &0.392248E-01_r8,0.398889E-01_r8,0.405633E-01_r8,0.412474E-01_r8,0.419430E-01_r8, &
         &0.426505E-01_r8,0.433678E-01_r8,0.440974E-01_r8,0.448374E-01_r8,0.455896E-01_r8, &
         &0.463545E-01_r8,0.471303E-01_r8,0.479191E-01_r8,0.487190E-01_r8,0.495322E-01_r8/
    DATA (ES(IES),IES= 96,190) /                                      &
         &0.503591E-01_r8,0.511977E-01_r8,0.520490E-01_r8,0.529145E-01_r8,0.537931E-01_r8, &
         &0.546854E-01_r8,0.555924E-01_r8,0.565119E-01_r8,0.574467E-01_r8,0.583959E-01_r8, &
         &0.593592E-01_r8,0.603387E-01_r8,0.613316E-01_r8,0.623409E-01_r8,0.633655E-01_r8, &
         &0.644053E-01_r8,0.654624E-01_r8,0.665358E-01_r8,0.676233E-01_r8,0.687302E-01_r8, &
         &0.698524E-01_r8,0.709929E-01_r8,0.721490E-01_r8,0.733238E-01_r8,0.745180E-01_r8, &
         &0.757281E-01_r8,0.769578E-01_r8,0.782061E-01_r8,0.794728E-01_r8,0.807583E-01_r8, &
         &0.820647E-01_r8,0.833905E-01_r8,0.847358E-01_r8,0.861028E-01_r8,0.874882E-01_r8, &
         &0.888957E-01_r8,0.903243E-01_r8,0.917736E-01_r8,0.932464E-01_r8,0.947407E-01_r8, &
         &0.962571E-01_r8,0.977955E-01_r8,0.993584E-01_r8,0.100942E+00_r8,0.102551E+00_r8, &
         &0.104186E+00_r8,0.105842E+00_r8,0.107524E+00_r8,0.109231E+00_r8,0.110963E+00_r8, &
         &0.112722E+00_r8,0.114506E+00_r8,0.116317E+00_r8,0.118153E+00_r8,0.120019E+00_r8, &
         &0.121911E+00_r8,0.123831E+00_r8,0.125778E+00_r8,0.127755E+00_r8,0.129761E+00_r8, &
         &0.131796E+00_r8,0.133863E+00_r8,0.135956E+00_r8,0.138082E+00_r8,0.140241E+00_r8, &
         &0.142428E+00_r8,0.144649E+00_r8,0.146902E+00_r8,0.149190E+00_r8,0.151506E+00_r8, &
         &0.153859E+00_r8,0.156245E+00_r8,0.158669E+00_r8,0.161126E+00_r8,0.163618E+00_r8, &
         &0.166145E+00_r8,0.168711E+00_r8,0.171313E+00_r8,0.173951E+00_r8,0.176626E+00_r8, &
         &0.179342E+00_r8,0.182096E+00_r8,0.184893E+00_r8,0.187724E+00_r8,0.190600E+00_r8, &
         &0.193518E+00_r8,0.196473E+00_r8,0.199474E+00_r8,0.202516E+00_r8,0.205604E+00_r8, &
         &0.208730E+00_r8,0.211905E+00_r8,0.215127E+00_r8,0.218389E+00_r8,0.221701E+00_r8/
    DATA (ES(IES),IES=191,285) /                                      &
         &0.225063E+00_r8,0.228466E+00_r8,0.231920E+00_r8,0.235421E+00_r8,0.238976E+00_r8, &
         &0.242580E+00_r8,0.246232E+00_r8,0.249933E+00_r8,0.253691E+00_r8,0.257499E+00_r8, &
         &0.261359E+00_r8,0.265278E+00_r8,0.269249E+00_r8,0.273274E+00_r8,0.277358E+00_r8, &
         &0.281498E+00_r8,0.285694E+00_r8,0.289952E+00_r8,0.294268E+00_r8,0.298641E+00_r8, &
         &0.303078E+00_r8,0.307577E+00_r8,0.312135E+00_r8,0.316753E+00_r8,0.321440E+00_r8, &
         &0.326196E+00_r8,0.331009E+00_r8,0.335893E+00_r8,0.340842E+00_r8,0.345863E+00_r8, &
         &0.350951E+00_r8,0.356106E+00_r8,0.361337E+00_r8,0.366636E+00_r8,0.372006E+00_r8, &
         &0.377447E+00_r8,0.382966E+00_r8,0.388567E+00_r8,0.394233E+00_r8,0.399981E+00_r8, &
         &0.405806E+00_r8,0.411714E+00_r8,0.417699E+00_r8,0.423772E+00_r8,0.429914E+00_r8, &
         &0.436145E+00_r8,0.442468E+00_r8,0.448862E+00_r8,0.455359E+00_r8,0.461930E+00_r8, &
         &0.468596E+00_r8,0.475348E+00_r8,0.482186E+00_r8,0.489124E+00_r8,0.496160E+00_r8, &
         &0.503278E+00_r8,0.510497E+00_r8,0.517808E+00_r8,0.525224E+00_r8,0.532737E+00_r8, &
         &0.540355E+00_r8,0.548059E+00_r8,0.555886E+00_r8,0.563797E+00_r8,0.571825E+00_r8, &
         &0.579952E+00_r8,0.588198E+00_r8,0.596545E+00_r8,0.605000E+00_r8,0.613572E+00_r8, &
         &0.622255E+00_r8,0.631059E+00_r8,0.639962E+00_r8,0.649003E+00_r8,0.658144E+00_r8, &
         &0.667414E+00_r8,0.676815E+00_r8,0.686317E+00_r8,0.695956E+00_r8,0.705728E+00_r8, &
         &0.715622E+00_r8,0.725641E+00_r8,0.735799E+00_r8,0.746082E+00_r8,0.756495E+00_r8, &
         &0.767052E+00_r8,0.777741E+00_r8,0.788576E+00_r8,0.799549E+00_r8,0.810656E+00_r8, &
         &0.821914E+00_r8,0.833314E+00_r8,0.844854E+00_r8,0.856555E+00_r8,0.868415E+00_r8/
    DATA (ES(IES),IES=286,380) /                                      &
         &0.880404E+00_r8,0.892575E+00_r8,0.904877E+00_r8,0.917350E+00_r8,0.929974E+00_r8, &
         &0.942771E+00_r8,0.955724E+00_r8,0.968837E+00_r8,0.982127E+00_r8,0.995600E+00_r8, &
         &0.100921E+01_r8,0.102304E+01_r8,0.103700E+01_r8,0.105116E+01_r8,0.106549E+01_r8, &
         &0.108002E+01_r8,0.109471E+01_r8,0.110962E+01_r8,0.112469E+01_r8,0.113995E+01_r8, &
         &0.115542E+01_r8,0.117107E+01_r8,0.118693E+01_r8,0.120298E+01_r8,0.121923E+01_r8, &
         &0.123569E+01_r8,0.125234E+01_r8,0.126923E+01_r8,0.128631E+01_r8,0.130362E+01_r8, &
         &0.132114E+01_r8,0.133887E+01_r8,0.135683E+01_r8,0.137500E+01_r8,0.139342E+01_r8, &
         &0.141205E+01_r8,0.143091E+01_r8,0.145000E+01_r8,0.146933E+01_r8,0.148892E+01_r8, &
         &0.150874E+01_r8,0.152881E+01_r8,0.154912E+01_r8,0.156970E+01_r8,0.159049E+01_r8, &
         &0.161159E+01_r8,0.163293E+01_r8,0.165452E+01_r8,0.167640E+01_r8,0.169852E+01_r8, &
         &0.172091E+01_r8,0.174359E+01_r8,0.176653E+01_r8,0.178977E+01_r8,0.181332E+01_r8, &
         &0.183709E+01_r8,0.186119E+01_r8,0.188559E+01_r8,0.191028E+01_r8,0.193524E+01_r8, &
         &0.196054E+01_r8,0.198616E+01_r8,0.201208E+01_r8,0.203829E+01_r8,0.206485E+01_r8, &
         &0.209170E+01_r8,0.211885E+01_r8,0.214637E+01_r8,0.217424E+01_r8,0.220242E+01_r8, &
         &0.223092E+01_r8,0.225979E+01_r8,0.228899E+01_r8,0.231855E+01_r8,0.234845E+01_r8, &
         &0.237874E+01_r8,0.240937E+01_r8,0.244040E+01_r8,0.247176E+01_r8,0.250349E+01_r8, &
         &0.253560E+01_r8,0.256814E+01_r8,0.260099E+01_r8,0.263431E+01_r8,0.266800E+01_r8, &
         &0.270207E+01_r8,0.273656E+01_r8,0.277145E+01_r8,0.280671E+01_r8,0.284248E+01_r8, &
         &0.287859E+01_r8,0.291516E+01_r8,0.295219E+01_r8,0.298962E+01_r8,0.302746E+01_r8/
    DATA (ES(IES),IES=381,475) /                                      &
         &0.306579E+01_r8,0.310454E+01_r8,0.314377E+01_r8,0.318351E+01_r8,0.322360E+01_r8, &
         &0.326427E+01_r8,0.330538E+01_r8,0.334694E+01_r8,0.338894E+01_r8,0.343155E+01_r8, &
         &0.347456E+01_r8,0.351809E+01_r8,0.356216E+01_r8,0.360673E+01_r8,0.365184E+01_r8, &
         &0.369744E+01_r8,0.374352E+01_r8,0.379018E+01_r8,0.383743E+01_r8,0.388518E+01_r8, &
         &0.393344E+01_r8,0.398230E+01_r8,0.403177E+01_r8,0.408175E+01_r8,0.413229E+01_r8, &
         &0.418343E+01_r8,0.423514E+01_r8,0.428746E+01_r8,0.434034E+01_r8,0.439389E+01_r8, &
         &0.444808E+01_r8,0.450276E+01_r8,0.455820E+01_r8,0.461423E+01_r8,0.467084E+01_r8, &
         &0.472816E+01_r8,0.478607E+01_r8,0.484468E+01_r8,0.490393E+01_r8,0.496389E+01_r8, &
         &0.502446E+01_r8,0.508580E+01_r8,0.514776E+01_r8,0.521047E+01_r8,0.527385E+01_r8, &
         &0.533798E+01_r8,0.540279E+01_r8,0.546838E+01_r8,0.553466E+01_r8,0.560173E+01_r8, &
         &0.566949E+01_r8,0.573807E+01_r8,0.580750E+01_r8,0.587749E+01_r8,0.594846E+01_r8, &
         &0.602017E+01_r8,0.609260E+01_r8,0.616591E+01_r8,0.623995E+01_r8,0.631490E+01_r8, &
         &0.639061E+01_r8,0.646723E+01_r8,0.654477E+01_r8,0.662293E+01_r8,0.670220E+01_r8, &
         &0.678227E+01_r8,0.686313E+01_r8,0.694495E+01_r8,0.702777E+01_r8,0.711142E+01_r8, &
         &0.719592E+01_r8,0.728140E+01_r8,0.736790E+01_r8,0.745527E+01_r8,0.754352E+01_r8, &
         &0.763298E+01_r8,0.772316E+01_r8,0.781442E+01_r8,0.790676E+01_r8,0.800001E+01_r8, &
         &0.809435E+01_r8,0.818967E+01_r8,0.828606E+01_r8,0.838343E+01_r8,0.848194E+01_r8, &
         &0.858144E+01_r8,0.868207E+01_r8,0.878392E+01_r8,0.888673E+01_r8,0.899060E+01_r8, &
         &0.909567E+01_r8,0.920172E+01_r8,0.930909E+01_r8,0.941765E+01_r8,0.952730E+01_r8/
    DATA (ES(IES),IES=476,570) /                                      &
         &0.963821E+01_r8,0.975022E+01_r8,0.986352E+01_r8,0.997793E+01_r8,0.100937E+02_r8, &
         &0.102105E+02_r8,0.103287E+02_r8,0.104481E+02_r8,0.105688E+02_r8,0.106909E+02_r8, &
         &0.108143E+02_r8,0.109387E+02_r8,0.110647E+02_r8,0.111921E+02_r8,0.113207E+02_r8, &
         &0.114508E+02_r8,0.115821E+02_r8,0.117149E+02_r8,0.118490E+02_r8,0.119847E+02_r8, &
         &0.121216E+02_r8,0.122601E+02_r8,0.124002E+02_r8,0.125416E+02_r8,0.126846E+02_r8, &
         &0.128290E+02_r8,0.129747E+02_r8,0.131224E+02_r8,0.132712E+02_r8,0.134220E+02_r8, &
         &0.135742E+02_r8,0.137278E+02_r8,0.138831E+02_r8,0.140403E+02_r8,0.141989E+02_r8, &
         &0.143589E+02_r8,0.145211E+02_r8,0.146845E+02_r8,0.148501E+02_r8,0.150172E+02_r8, &
         &0.151858E+02_r8,0.153564E+02_r8,0.155288E+02_r8,0.157029E+02_r8,0.158786E+02_r8, &
         &0.160562E+02_r8,0.162358E+02_r8,0.164174E+02_r8,0.166004E+02_r8,0.167858E+02_r8, &
         &0.169728E+02_r8,0.171620E+02_r8,0.173528E+02_r8,0.175455E+02_r8,0.177406E+02_r8, &
         &0.179372E+02_r8,0.181363E+02_r8,0.183372E+02_r8,0.185400E+02_r8,0.187453E+02_r8, &
         &0.189523E+02_r8,0.191613E+02_r8,0.193728E+02_r8,0.195866E+02_r8,0.198024E+02_r8, &
         &0.200200E+02_r8,0.202401E+02_r8,0.204626E+02_r8,0.206871E+02_r8,0.209140E+02_r8, &
         &0.211430E+02_r8,0.213744E+02_r8,0.216085E+02_r8,0.218446E+02_r8,0.220828E+02_r8, &
         &0.223241E+02_r8,0.225671E+02_r8,0.228132E+02_r8,0.230615E+02_r8,0.233120E+02_r8, &
         &0.235651E+02_r8,0.238211E+02_r8,0.240794E+02_r8,0.243404E+02_r8,0.246042E+02_r8, &
         &0.248704E+02_r8,0.251390E+02_r8,0.254109E+02_r8,0.256847E+02_r8,0.259620E+02_r8, &
         &0.262418E+02_r8,0.265240E+02_r8,0.268092E+02_r8,0.270975E+02_r8,0.273883E+02_r8/
    DATA (ES(IES),IES=571,665) /                                      &
         &0.276822E+02_r8,0.279792E+02_r8,0.282789E+02_r8,0.285812E+02_r8,0.288867E+02_r8, &
         &0.291954E+02_r8,0.295075E+02_r8,0.298222E+02_r8,0.301398E+02_r8,0.304606E+02_r8, &
         &0.307848E+02_r8,0.311119E+02_r8,0.314424E+02_r8,0.317763E+02_r8,0.321133E+02_r8, &
         &0.324536E+02_r8,0.327971E+02_r8,0.331440E+02_r8,0.334940E+02_r8,0.338475E+02_r8, &
         &0.342050E+02_r8,0.345654E+02_r8,0.349295E+02_r8,0.352975E+02_r8,0.356687E+02_r8, &
         &0.360430E+02_r8,0.364221E+02_r8,0.368042E+02_r8,0.371896E+02_r8,0.375790E+02_r8, &
         &0.379725E+02_r8,0.383692E+02_r8,0.387702E+02_r8,0.391744E+02_r8,0.395839E+02_r8, &
         &0.399958E+02_r8,0.404118E+02_r8,0.408325E+02_r8,0.412574E+02_r8,0.416858E+02_r8, &
         &0.421188E+02_r8,0.425551E+02_r8,0.429962E+02_r8,0.434407E+02_r8,0.438910E+02_r8, &
         &0.443439E+02_r8,0.448024E+02_r8,0.452648E+02_r8,0.457308E+02_r8,0.462018E+02_r8, &
         &0.466775E+02_r8,0.471582E+02_r8,0.476428E+02_r8,0.481313E+02_r8,0.486249E+02_r8, &
         &0.491235E+02_r8,0.496272E+02_r8,0.501349E+02_r8,0.506479E+02_r8,0.511652E+02_r8, &
         &0.516876E+02_r8,0.522142E+02_r8,0.527474E+02_r8,0.532836E+02_r8,0.538266E+02_r8, &
         &0.543737E+02_r8,0.549254E+02_r8,0.554839E+02_r8,0.560456E+02_r8,0.566142E+02_r8, &
         &0.571872E+02_r8,0.577662E+02_r8,0.583498E+02_r8,0.589392E+02_r8,0.595347E+02_r8, &
         &0.601346E+02_r8,0.607410E+02_r8,0.613519E+02_r8,0.619689E+02_r8,0.625922E+02_r8, &
         &0.632204E+02_r8,0.638550E+02_r8,0.644959E+02_r8,0.651418E+02_r8,0.657942E+02_r8, &
         &0.664516E+02_r8,0.671158E+02_r8,0.677864E+02_r8,0.684624E+02_r8,0.691451E+02_r8, &
         &0.698345E+02_r8,0.705293E+02_r8,0.712312E+02_r8,0.719398E+02_r8,0.726542E+02_r8/
    DATA (ES(IES),IES=666,760) /                                      &
         &0.733754E+02_r8,0.741022E+02_r8,0.748363E+02_r8,0.755777E+02_r8,0.763247E+02_r8, &
         &0.770791E+02_r8,0.778394E+02_r8,0.786088E+02_r8,0.793824E+02_r8,0.801653E+02_r8, &
         &0.809542E+02_r8,0.817509E+02_r8,0.825536E+02_r8,0.833643E+02_r8,0.841828E+02_r8, &
         &0.850076E+02_r8,0.858405E+02_r8,0.866797E+02_r8,0.875289E+02_r8,0.883827E+02_r8, &
         &0.892467E+02_r8,0.901172E+02_r8,0.909962E+02_r8,0.918818E+02_r8,0.927760E+02_r8, &
         &0.936790E+02_r8,0.945887E+02_r8,0.955071E+02_r8,0.964346E+02_r8,0.973689E+02_r8, &
         &0.983123E+02_r8,0.992648E+02_r8,0.100224E+03_r8,0.101193E+03_r8,0.102169E+03_r8, &
         &0.103155E+03_r8,0.104150E+03_r8,0.105152E+03_r8,0.106164E+03_r8,0.107186E+03_r8, &
         &0.108217E+03_r8,0.109256E+03_r8,0.110303E+03_r8,0.111362E+03_r8,0.112429E+03_r8, &
         &0.113503E+03_r8,0.114588E+03_r8,0.115684E+03_r8,0.116789E+03_r8,0.117903E+03_r8, &
         &0.119028E+03_r8,0.120160E+03_r8,0.121306E+03_r8,0.122460E+03_r8,0.123623E+03_r8, &
         &0.124796E+03_r8,0.125981E+03_r8,0.127174E+03_r8,0.128381E+03_r8,0.129594E+03_r8, &
         &0.130822E+03_r8,0.132058E+03_r8,0.133306E+03_r8,0.134563E+03_r8,0.135828E+03_r8, &
         &0.137109E+03_r8,0.138402E+03_r8,0.139700E+03_r8,0.141017E+03_r8,0.142338E+03_r8, &
         &0.143676E+03_r8,0.145025E+03_r8,0.146382E+03_r8,0.147753E+03_r8,0.149133E+03_r8, &
         &0.150529E+03_r8,0.151935E+03_r8,0.153351E+03_r8,0.154783E+03_r8,0.156222E+03_r8, &
         &0.157678E+03_r8,0.159148E+03_r8,0.160624E+03_r8,0.162117E+03_r8,0.163621E+03_r8, &
         &0.165142E+03_r8,0.166674E+03_r8,0.168212E+03_r8,0.169772E+03_r8,0.171340E+03_r8, &
         &0.172921E+03_r8,0.174522E+03_r8,0.176129E+03_r8,0.177755E+03_r8,0.179388E+03_r8/
    DATA (ES(IES),IES=761,855) /                                      &
         &0.181040E+03_r8,0.182707E+03_r8,0.184382E+03_r8,0.186076E+03_r8,0.187782E+03_r8, &
         &0.189503E+03_r8,0.191240E+03_r8,0.192989E+03_r8,0.194758E+03_r8,0.196535E+03_r8, &
         &0.198332E+03_r8,0.200141E+03_r8,0.201963E+03_r8,0.203805E+03_r8,0.205656E+03_r8, &
         &0.207532E+03_r8,0.209416E+03_r8,0.211317E+03_r8,0.213236E+03_r8,0.215167E+03_r8, &
         &0.217121E+03_r8,0.219087E+03_r8,0.221067E+03_r8,0.223064E+03_r8,0.225080E+03_r8, &
         &0.227113E+03_r8,0.229160E+03_r8,0.231221E+03_r8,0.233305E+03_r8,0.235403E+03_r8, &
         &0.237520E+03_r8,0.239655E+03_r8,0.241805E+03_r8,0.243979E+03_r8,0.246163E+03_r8, &
         &0.248365E+03_r8,0.250593E+03_r8,0.252830E+03_r8,0.255093E+03_r8,0.257364E+03_r8, &
         &0.259667E+03_r8,0.261979E+03_r8,0.264312E+03_r8,0.266666E+03_r8,0.269034E+03_r8, &
         &0.271430E+03_r8,0.273841E+03_r8,0.276268E+03_r8,0.278722E+03_r8,0.281185E+03_r8, &
         &0.283677E+03_r8,0.286190E+03_r8,0.288714E+03_r8,0.291266E+03_r8,0.293834E+03_r8, &
         &0.296431E+03_r8,0.299045E+03_r8,0.301676E+03_r8,0.304329E+03_r8,0.307006E+03_r8, &
         &0.309706E+03_r8,0.312423E+03_r8,0.315165E+03_r8,0.317930E+03_r8,0.320705E+03_r8, &
         &0.323519E+03_r8,0.326350E+03_r8,0.329199E+03_r8,0.332073E+03_r8,0.334973E+03_r8, &
         &0.337897E+03_r8,0.340839E+03_r8,0.343800E+03_r8,0.346794E+03_r8,0.349806E+03_r8, &
         &0.352845E+03_r8,0.355918E+03_r8,0.358994E+03_r8,0.362112E+03_r8,0.365242E+03_r8, &
         &0.368407E+03_r8,0.371599E+03_r8,0.374802E+03_r8,0.378042E+03_r8,0.381293E+03_r8, &
         &0.384588E+03_r8,0.387904E+03_r8,0.391239E+03_r8,0.394604E+03_r8,0.397988E+03_r8, &
         &0.401411E+03_r8,0.404862E+03_r8,0.408326E+03_r8,0.411829E+03_r8,0.415352E+03_r8/
    DATA (ES(IES),IES=856,950) /                                      &
         &0.418906E+03_r8,0.422490E+03_r8,0.426095E+03_r8,0.429740E+03_r8,0.433398E+03_r8, &
         &0.437097E+03_r8,0.440827E+03_r8,0.444570E+03_r8,0.448354E+03_r8,0.452160E+03_r8, &
         &0.455999E+03_r8,0.459870E+03_r8,0.463765E+03_r8,0.467702E+03_r8,0.471652E+03_r8, &
         &0.475646E+03_r8,0.479674E+03_r8,0.483715E+03_r8,0.487811E+03_r8,0.491911E+03_r8, &
         &0.496065E+03_r8,0.500244E+03_r8,0.504448E+03_r8,0.508698E+03_r8,0.512961E+03_r8, &
         &0.517282E+03_r8,0.521617E+03_r8,0.525989E+03_r8,0.530397E+03_r8,0.534831E+03_r8, &
         &0.539313E+03_r8,0.543821E+03_r8,0.548355E+03_r8,0.552938E+03_r8,0.557549E+03_r8, &
         &0.562197E+03_r8,0.566884E+03_r8,0.571598E+03_r8,0.576351E+03_r8,0.581131E+03_r8, &
         &0.585963E+03_r8,0.590835E+03_r8,0.595722E+03_r8,0.600663E+03_r8,0.605631E+03_r8, &
         &0.610641E+03_r8,0.615151E+03_r8,0.619625E+03_r8,0.624140E+03_r8,0.628671E+03_r8, &
         &0.633243E+03_r8,0.637845E+03_r8,0.642465E+03_r8,0.647126E+03_r8,0.651806E+03_r8, &
         &0.656527E+03_r8,0.661279E+03_r8,0.666049E+03_r8,0.670861E+03_r8,0.675692E+03_r8, &
         &0.680566E+03_r8,0.685471E+03_r8,0.690396E+03_r8,0.695363E+03_r8,0.700350E+03_r8, &
         &0.705381E+03_r8,0.710444E+03_r8,0.715527E+03_r8,0.720654E+03_r8,0.725801E+03_r8, &
         &0.730994E+03_r8,0.736219E+03_r8,0.741465E+03_r8,0.746756E+03_r8,0.752068E+03_r8, &
         &0.757426E+03_r8,0.762819E+03_r8,0.768231E+03_r8,0.773692E+03_r8,0.779172E+03_r8, &
         &0.784701E+03_r8,0.790265E+03_r8,0.795849E+03_r8,0.801483E+03_r8,0.807137E+03_r8, &
         &0.812842E+03_r8,0.818582E+03_r8,0.824343E+03_r8,0.830153E+03_r8,0.835987E+03_r8, &
         &0.841871E+03_r8,0.847791E+03_r8,0.853733E+03_r8,0.859727E+03_r8,0.865743E+03_r8/
    DATA (ES(IES),IES=951,1045) /                                     &
         &0.871812E+03_r8,0.877918E+03_r8,0.884046E+03_r8,0.890228E+03_r8,0.896433E+03_r8, &
         &0.902690E+03_r8,0.908987E+03_r8,0.915307E+03_r8,0.921681E+03_r8,0.928078E+03_r8, &
         &0.934531E+03_r8,0.941023E+03_r8,0.947539E+03_r8,0.954112E+03_r8,0.960708E+03_r8, &
         &0.967361E+03_r8,0.974053E+03_r8,0.980771E+03_r8,0.987545E+03_r8,0.994345E+03_r8, &
         &0.100120E+04_r8,0.100810E+04_r8,0.101502E+04_r8,0.102201E+04_r8,0.102902E+04_r8, &
         &0.103608E+04_r8,0.104320E+04_r8,0.105033E+04_r8,0.105753E+04_r8,0.106475E+04_r8, &
         &0.107204E+04_r8,0.107936E+04_r8,0.108672E+04_r8,0.109414E+04_r8,0.110158E+04_r8, &
         &0.110908E+04_r8,0.111663E+04_r8,0.112421E+04_r8,0.113185E+04_r8,0.113952E+04_r8, &
         &0.114725E+04_r8,0.115503E+04_r8,0.116284E+04_r8,0.117071E+04_r8,0.117861E+04_r8, &
         &0.118658E+04_r8,0.119459E+04_r8,0.120264E+04_r8,0.121074E+04_r8,0.121888E+04_r8, &
         &0.122709E+04_r8,0.123534E+04_r8,0.124362E+04_r8,0.125198E+04_r8,0.126036E+04_r8, &
         &0.126881E+04_r8,0.127731E+04_r8,0.128584E+04_r8,0.129444E+04_r8,0.130307E+04_r8, &
         &0.131177E+04_r8,0.132053E+04_r8,0.132931E+04_r8,0.133817E+04_r8,0.134705E+04_r8, &
         &0.135602E+04_r8,0.136503E+04_r8,0.137407E+04_r8,0.138319E+04_r8,0.139234E+04_r8, &
         &0.140156E+04_r8,0.141084E+04_r8,0.142015E+04_r8,0.142954E+04_r8,0.143896E+04_r8, &
         &0.144845E+04_r8,0.145800E+04_r8,0.146759E+04_r8,0.147725E+04_r8,0.148694E+04_r8, &
         &0.149672E+04_r8,0.150655E+04_r8,0.151641E+04_r8,0.152635E+04_r8,0.153633E+04_r8, &
         &0.154639E+04_r8,0.155650E+04_r8,0.156665E+04_r8,0.157688E+04_r8,0.158715E+04_r8, &
         &0.159750E+04_r8,0.160791E+04_r8,0.161836E+04_r8,0.162888E+04_r8,0.163945E+04_r8/
    DATA (ES(IES),IES=1046,1140) /                                    &
         &0.165010E+04_r8,0.166081E+04_r8,0.167155E+04_r8,0.168238E+04_r8,0.169325E+04_r8, &
         &0.170420E+04_r8,0.171522E+04_r8,0.172627E+04_r8,0.173741E+04_r8,0.174859E+04_r8, &
         &0.175986E+04_r8,0.177119E+04_r8,0.178256E+04_r8,0.179402E+04_r8,0.180552E+04_r8, &
         &0.181711E+04_r8,0.182877E+04_r8,0.184046E+04_r8,0.185224E+04_r8,0.186407E+04_r8, &
         &0.187599E+04_r8,0.188797E+04_r8,0.190000E+04_r8,0.191212E+04_r8,0.192428E+04_r8, &
         &0.193653E+04_r8,0.194886E+04_r8,0.196122E+04_r8,0.197368E+04_r8,0.198618E+04_r8, &
         &0.199878E+04_r8,0.201145E+04_r8,0.202416E+04_r8,0.203698E+04_r8,0.204983E+04_r8, &
         &0.206278E+04_r8,0.207580E+04_r8,0.208887E+04_r8,0.210204E+04_r8,0.211525E+04_r8, &
         &0.212856E+04_r8,0.214195E+04_r8,0.215538E+04_r8,0.216892E+04_r8,0.218249E+04_r8, &
         &0.219618E+04_r8,0.220994E+04_r8,0.222375E+04_r8,0.223766E+04_r8,0.225161E+04_r8, &
         &0.226567E+04_r8,0.227981E+04_r8,0.229399E+04_r8,0.230829E+04_r8,0.232263E+04_r8, &
         &0.233708E+04_r8,0.235161E+04_r8,0.236618E+04_r8,0.238087E+04_r8,0.239560E+04_r8, &
         &0.241044E+04_r8,0.242538E+04_r8,0.244035E+04_r8,0.245544E+04_r8,0.247057E+04_r8, &
         &0.248583E+04_r8,0.250116E+04_r8,0.251654E+04_r8,0.253204E+04_r8,0.254759E+04_r8, &
         &0.256325E+04_r8,0.257901E+04_r8,0.259480E+04_r8,0.261073E+04_r8,0.262670E+04_r8, &
         &0.264279E+04_r8,0.265896E+04_r8,0.267519E+04_r8,0.269154E+04_r8,0.270794E+04_r8, &
         &0.272447E+04_r8,0.274108E+04_r8,0.275774E+04_r8,0.277453E+04_r8,0.279137E+04_r8, &
         &0.280834E+04_r8,0.282540E+04_r8,0.284251E+04_r8,0.285975E+04_r8,0.287704E+04_r8, &
         &0.289446E+04_r8,0.291198E+04_r8,0.292954E+04_r8,0.294725E+04_r8,0.296499E+04_r8/
    DATA (ES(IES),IES=1141,1235) /                                    &
         &0.298288E+04_r8,0.300087E+04_r8,0.301890E+04_r8,0.303707E+04_r8,0.305529E+04_r8, &
         &0.307365E+04_r8,0.309211E+04_r8,0.311062E+04_r8,0.312927E+04_r8,0.314798E+04_r8, &
         &0.316682E+04_r8,0.318577E+04_r8,0.320477E+04_r8,0.322391E+04_r8,0.324310E+04_r8, &
         &0.326245E+04_r8,0.328189E+04_r8,0.330138E+04_r8,0.332103E+04_r8,0.334073E+04_r8, &
         &0.336058E+04_r8,0.338053E+04_r8,0.340054E+04_r8,0.342069E+04_r8,0.344090E+04_r8, &
         &0.346127E+04_r8,0.348174E+04_r8,0.350227E+04_r8,0.352295E+04_r8,0.354369E+04_r8, &
         &0.356458E+04_r8,0.358559E+04_r8,0.360664E+04_r8,0.362787E+04_r8,0.364914E+04_r8, &
         &0.367058E+04_r8,0.369212E+04_r8,0.371373E+04_r8,0.373548E+04_r8,0.375731E+04_r8, &
         &0.377929E+04_r8,0.380139E+04_r8,0.382355E+04_r8,0.384588E+04_r8,0.386826E+04_r8, &
         &0.389081E+04_r8,0.391348E+04_r8,0.393620E+04_r8,0.395910E+04_r8,0.398205E+04_r8, &
         &0.400518E+04_r8,0.402843E+04_r8,0.405173E+04_r8,0.407520E+04_r8,0.409875E+04_r8, &
         &0.412246E+04_r8,0.414630E+04_r8,0.417019E+04_r8,0.419427E+04_r8,0.421840E+04_r8, &
         &0.424272E+04_r8,0.426715E+04_r8,0.429165E+04_r8,0.431634E+04_r8,0.434108E+04_r8, &
         &0.436602E+04_r8,0.439107E+04_r8,0.441618E+04_r8,0.444149E+04_r8,0.446685E+04_r8, &
         &0.449241E+04_r8,0.451810E+04_r8,0.454385E+04_r8,0.456977E+04_r8,0.459578E+04_r8, &
         &0.462197E+04_r8,0.464830E+04_r8,0.467468E+04_r8,0.470127E+04_r8,0.472792E+04_r8, &
         &0.475477E+04_r8,0.478175E+04_r8,0.480880E+04_r8,0.483605E+04_r8,0.486336E+04_r8, &
         &0.489087E+04_r8,0.491853E+04_r8,0.494623E+04_r8,0.497415E+04_r8,0.500215E+04_r8, &
         &0.503034E+04_r8,0.505867E+04_r8,0.508707E+04_r8,0.511568E+04_r8,0.514436E+04_r8/
    DATA (ES(IES),IES=1236,1330) /                                    &
         &0.517325E+04_r8,0.520227E+04_r8,0.523137E+04_r8,0.526068E+04_r8,0.529005E+04_r8, &
         &0.531965E+04_r8,0.534939E+04_r8,0.537921E+04_r8,0.540923E+04_r8,0.543932E+04_r8, &
         &0.546965E+04_r8,0.550011E+04_r8,0.553064E+04_r8,0.556139E+04_r8,0.559223E+04_r8, &
         &0.562329E+04_r8,0.565449E+04_r8,0.568577E+04_r8,0.571727E+04_r8,0.574884E+04_r8, &
         &0.578064E+04_r8,0.581261E+04_r8,0.584464E+04_r8,0.587692E+04_r8,0.590924E+04_r8, &
         &0.594182E+04_r8,0.597455E+04_r8,0.600736E+04_r8,0.604039E+04_r8,0.607350E+04_r8, &
         &0.610685E+04_r8,0.614036E+04_r8,0.617394E+04_r8,0.620777E+04_r8,0.624169E+04_r8, &
         &0.627584E+04_r8,0.631014E+04_r8,0.634454E+04_r8,0.637918E+04_r8,0.641390E+04_r8, &
         &0.644887E+04_r8,0.648400E+04_r8,0.651919E+04_r8,0.655467E+04_r8,0.659021E+04_r8, &
         &0.662599E+04_r8,0.666197E+04_r8,0.669800E+04_r8,0.673429E+04_r8,0.677069E+04_r8, &
         &0.680735E+04_r8,0.684415E+04_r8,0.688104E+04_r8,0.691819E+04_r8,0.695543E+04_r8, &
         &0.699292E+04_r8,0.703061E+04_r8,0.706837E+04_r8,0.710639E+04_r8,0.714451E+04_r8, &
         &0.718289E+04_r8,0.722143E+04_r8,0.726009E+04_r8,0.729903E+04_r8,0.733802E+04_r8, &
         &0.737729E+04_r8,0.741676E+04_r8,0.745631E+04_r8,0.749612E+04_r8,0.753602E+04_r8, &
         &0.757622E+04_r8,0.761659E+04_r8,0.765705E+04_r8,0.769780E+04_r8,0.773863E+04_r8, &
         &0.777975E+04_r8,0.782106E+04_r8,0.786246E+04_r8,0.790412E+04_r8,0.794593E+04_r8, &
         &0.798802E+04_r8,0.803028E+04_r8,0.807259E+04_r8,0.811525E+04_r8,0.815798E+04_r8, &
         &0.820102E+04_r8,0.824427E+04_r8,0.828757E+04_r8,0.833120E+04_r8,0.837493E+04_r8, &
         &0.841895E+04_r8,0.846313E+04_r8,0.850744E+04_r8,0.855208E+04_r8,0.859678E+04_r8/
    DATA (ES(IES),IES=1331,1425) /                                    &
         &0.864179E+04_r8,0.868705E+04_r8,0.873237E+04_r8,0.877800E+04_r8,0.882374E+04_r8, &
         &0.886979E+04_r8,0.891603E+04_r8,0.896237E+04_r8,0.900904E+04_r8,0.905579E+04_r8, &
         &0.910288E+04_r8,0.915018E+04_r8,0.919758E+04_r8,0.924529E+04_r8,0.929310E+04_r8, &
         &0.934122E+04_r8,0.938959E+04_r8,0.943804E+04_r8,0.948687E+04_r8,0.953575E+04_r8, &
         &0.958494E+04_r8,0.963442E+04_r8,0.968395E+04_r8,0.973384E+04_r8,0.978383E+04_r8, &
         &0.983412E+04_r8,0.988468E+04_r8,0.993534E+04_r8,0.998630E+04_r8,0.100374E+05_r8, &
         &0.100888E+05_r8,0.101406E+05_r8,0.101923E+05_r8,0.102444E+05_r8,0.102966E+05_r8, &
         &0.103492E+05_r8,0.104020E+05_r8,0.104550E+05_r8,0.105082E+05_r8,0.105616E+05_r8, &
         &0.106153E+05_r8,0.106693E+05_r8,0.107234E+05_r8,0.107779E+05_r8,0.108325E+05_r8, &
         &0.108874E+05_r8,0.109425E+05_r8,0.109978E+05_r8,0.110535E+05_r8,0.111092E+05_r8, &
         &0.111653E+05_r8,0.112217E+05_r8,0.112782E+05_r8,0.113350E+05_r8,0.113920E+05_r8, &
         &0.114493E+05_r8,0.115070E+05_r8,0.115646E+05_r8,0.116228E+05_r8,0.116809E+05_r8, &
         &0.117396E+05_r8,0.117984E+05_r8,0.118574E+05_r8,0.119167E+05_r8,0.119762E+05_r8, &
         &0.120360E+05_r8,0.120962E+05_r8,0.121564E+05_r8,0.122170E+05_r8,0.122778E+05_r8, &
         &0.123389E+05_r8,0.124004E+05_r8,0.124619E+05_r8,0.125238E+05_r8,0.125859E+05_r8, &
         &0.126484E+05_r8,0.127111E+05_r8,0.127739E+05_r8,0.128372E+05_r8,0.129006E+05_r8, &
         &0.129644E+05_r8,0.130285E+05_r8,0.130927E+05_r8,0.131573E+05_r8,0.132220E+05_r8, &
         &0.132872E+05_r8,0.133526E+05_r8,0.134182E+05_r8,0.134842E+05_r8,0.135503E+05_r8, &
         &0.136168E+05_r8,0.136836E+05_r8,0.137505E+05_r8,0.138180E+05_r8,0.138854E+05_r8/
    DATA (ES(IES),IES=1426,1520) /                                    &
         &0.139534E+05_r8,0.140216E+05_r8,0.140900E+05_r8,0.141588E+05_r8,0.142277E+05_r8, &
         &0.142971E+05_r8,0.143668E+05_r8,0.144366E+05_r8,0.145069E+05_r8,0.145773E+05_r8, &
         &0.146481E+05_r8,0.147192E+05_r8,0.147905E+05_r8,0.148622E+05_r8,0.149341E+05_r8, &
         &0.150064E+05_r8,0.150790E+05_r8,0.151517E+05_r8,0.152250E+05_r8,0.152983E+05_r8, &
         &0.153721E+05_r8,0.154462E+05_r8,0.155205E+05_r8,0.155952E+05_r8,0.156701E+05_r8, &
         &0.157454E+05_r8,0.158211E+05_r8,0.158969E+05_r8,0.159732E+05_r8,0.160496E+05_r8, &
         &0.161265E+05_r8,0.162037E+05_r8,0.162811E+05_r8,0.163589E+05_r8,0.164369E+05_r8, &
         &0.165154E+05_r8,0.165942E+05_r8,0.166732E+05_r8,0.167526E+05_r8,0.168322E+05_r8, &
         &0.169123E+05_r8,0.169927E+05_r8,0.170733E+05_r8,0.171543E+05_r8,0.172356E+05_r8, &
         &0.173173E+05_r8,0.173993E+05_r8,0.174815E+05_r8,0.175643E+05_r8,0.176471E+05_r8, &
         &0.177305E+05_r8,0.178143E+05_r8,0.178981E+05_r8,0.179826E+05_r8,0.180671E+05_r8, &
         &0.181522E+05_r8,0.182377E+05_r8,0.183232E+05_r8,0.184093E+05_r8,0.184955E+05_r8, &
         &0.185823E+05_r8,0.186695E+05_r8,0.187568E+05_r8,0.188447E+05_r8,0.189326E+05_r8, &
         &0.190212E+05_r8,0.191101E+05_r8,0.191991E+05_r8,0.192887E+05_r8,0.193785E+05_r8, &
         &0.194688E+05_r8,0.195595E+05_r8,0.196503E+05_r8,0.197417E+05_r8,0.198332E+05_r8, &
         &0.199253E+05_r8,0.200178E+05_r8,0.201105E+05_r8,0.202036E+05_r8,0.202971E+05_r8, &
         &0.203910E+05_r8,0.204853E+05_r8,0.205798E+05_r8,0.206749E+05_r8,0.207701E+05_r8, &
         &0.208659E+05_r8,0.209621E+05_r8,0.210584E+05_r8,0.211554E+05_r8,0.212524E+05_r8, &
         &0.213501E+05_r8,0.214482E+05_r8,0.215465E+05_r8,0.216452E+05_r8,0.217442E+05_r8/
    DATA (ES(IES),IES=1521,1552) /                                    &
         &0.218439E+05_r8,0.219439E+05_r8,0.220440E+05_r8,0.221449E+05_r8,0.222457E+05_r8, &
         &0.223473E+05_r8,0.224494E+05_r8,0.225514E+05_r8,0.226542E+05_r8,0.227571E+05_r8, &
         &0.228606E+05_r8,0.229646E+05_r8,0.230687E+05_r8,0.231734E+05_r8,0.232783E+05_r8, &
         &0.233839E+05_r8,0.234898E+05_r8,0.235960E+05_r8,0.237027E+05_r8,0.238097E+05_r8, &
         &0.239173E+05_r8,0.240254E+05_r8,0.241335E+05_r8,0.242424E+05_r8,0.243514E+05_r8, &
         &0.244611E+05_r8,0.245712E+05_r8,0.246814E+05_r8,0.247923E+05_r8,0.249034E+05_r8, &
         &0.250152E+05_r8,0.250152E+05_r8/
    !
    ! Npnts_do_1:
    DO I=1,NPNTS
       !      COMPUTE THE FACTOR THAT CONVERTS FROM SAT VAPOUR PRESSURE IN A
       !      PURE WATER SYSTEM TO SAT VAPOUR PRESSURE IN AIR, FSUBW.
       !      THIS FORMULA IS TAKEN FROM EQUATION A4.7 OF ADRIAN GILL'S BOOK:
       !      ATMOSPHERE-ocean DYNAMICS. NOTE THAT HIS FORMULA WORKS IN TERMS
       !      OF PRESSURE IN MB AND TEMPERATURE IN CELSIUS, SO CONVERSION OF
       !      UNITS LEADS TO THE SLIGHTLY DIFFERENT EQUATION USED HERE.
       !
       FSUBW = 1.0_r8 + 1.0E-8_r8*P(I)*( 4.5_r8 +                               &
            &    6.0E-4_r8*( T(I) - ZERODEGC )*( T(I) - ZERODEGC ) )
       !
       !      USE THE LOOKUP TABLE TO FIND SATURATED VAPOUR PRESSURE, AND STORE
       !      IT IN QS.
       !
       TT = MAX(T_LOW,T(I))
       TT = MIN(T_HIGH,TT)
       !
       ATABLE = (TT - T_LOW + DELTA_T) / DELTA_T
       ITABLE = ATABLE
       ATABLE = ATABLE - ITABLE
       !
       QS(I) = (1.0_r8 - ATABLE)*ES(ITABLE) + ATABLE*ES(ITABLE+1)
       !
       !      MULTIPLY BY FSUBW TO CONVERT TO SATURATED VAPOUR PRESSURE IN AIR
       !      (EQUATION A4.6 OF ADRIAN GILL'S BOOK).
       !
       QS(I) = QS(I) * FSUBW
       !
       !      NOW FORM THE ACCURATE EXPRESSION FOR QS, WHICH IS A REARRANGED
       !      VERSION OF EQUATION A4.3 OF GILL'S BOOK.
       !
       !      NOTE THAT AT VERY LOW PRESSURES WE APPLY A FIX, TO PREVENT A
       !      SINGULARITY (Qsat tends to 1. kg/kg).
       !
       QS(I) = ( EPSILON*QS(I) ) /                                     &
            ( MAX(P(I),QS(I)) - ONE_MINUS_EPSILON*QS(I) )
       !
    END DO ! Npnts_do_1
    !
    RETURN
  END SUBROUTINE QSAT
  ! ======================================================================
  !===============================================================================
  SUBROUTINE geopotential_t(                                 &
       piln   ,  pint   , pmid   , pdel   , rpdel  , &
       t      , q      , rair   , gravit , zvir   ,          &
       zi     , zm     , ncol   ,nCols, kMax)

    !----------------------------------------------------------------------- 
    ! 
    ! Purpose: 
    ! Compute the geopotential height (above the surface) at the midpoints and 
    ! interfaces using the input temperatures and pressures.
    !
    !-----------------------------------------------------------------------

    IMPLICIT NONE

    !------------------------------Arguments--------------------------------
    !
    ! Input arguments
    !
    INTEGER , INTENT(in) :: ncol                 ! Number of longitudes
    INTEGER , INTENT(in) :: nCols
    INTEGER , INTENT(in) :: kMax
    REAL(r8), INTENT(in) :: piln (nCols,kMax+1)  ! Log interface pressures
    REAL(r8), INTENT(in) :: pint (nCols,kMax+1)  ! Interface pressures
    REAL(r8), INTENT(in) :: pmid (nCols,kMax)    ! Midpoint pressures
    REAL(r8), INTENT(in) :: pdel (nCols,kMax)    ! layer thickness
    REAL(r8), INTENT(in) :: rpdel(nCols,kMax)    ! inverse of layer thickness
    REAL(r8), INTENT(in) :: t    (nCols,kMax)    ! temperature
    REAL(r8), INTENT(in) :: q    (nCols,kMax)    ! specific humidity
    REAL(r8), INTENT(in) :: rair                 ! Gas constant for dry air
    REAL(r8), INTENT(in) :: gravit               ! Acceleration of gravity
    REAL(r8), INTENT(in) :: zvir                 ! rh2o/rair - 1

    ! Output arguments

    REAL(r8), INTENT(out) :: zi(nCols,kMax+1)     ! Height above surface at interfaces
    REAL(r8), INTENT(out) :: zm(nCols,kMax)      ! Geopotential height at mid level
    !
    !---------------------------Local variables-----------------------------
    !
    LOGICAL  :: fvdyn              ! finite volume dynamics
    INTEGER  :: i,k                ! Lon, level indices
    REAL(r8) :: hkk(nCols)         ! diagonal element of hydrostatic matrix
    REAL(r8) :: hkl(nCols)         ! off-diagonal element
    REAL(r8) :: rog                ! Rair / gravit
    REAL(r8) :: tv                 ! virtual temperature
    REAL(r8) :: tvfac              ! Tv/T
    !
    !-----------------------------------------------------------------------
    !
    rog = rair/gravit

    ! Set dynamics flag

    fvdyn = .FALSE.!dycore_is ('LR')

    ! The surface height is zero by definition.

    DO i = 1,ncol
       zi(i,kMax+1) = 0.0_r8
    END DO

    ! Compute zi, zm from bottom up. 
    ! Note, zi(i,k) is the interface above zm(i,k)

    DO k = kMax, 1, -1

       ! First set hydrostatic elements consistent with dynamics

       IF (fvdyn) THEN
          DO i = 1,ncol
             hkl(i) = piln(i,k+1) - piln(i,k)
             hkk(i) = 1.0_r8 - pint(i,k) * hkl(i) * rpdel(i,k)
          END DO
       ELSE
          DO i = 1,ncol
             hkl(i) = pdel(i,k) / pmid(i,k)
             hkk(i) = 0.5_r8 * hkl(i)
          END DO
       END IF

       ! Now compute tv, zm, zi

       DO i = 1,ncol
          tvfac   = 1.0_r8 + zvir * q(i,k)
          tv      = t(i,k) * tvfac

          zm(i,k) = zi(i,k+1) + rog * tv * hkk(i)
          zi(i,k) = zi(i,k+1) + rog * tv * hkl(i)
       END DO
    END DO

    RETURN
  END SUBROUTINE geopotential_t

END MODULE CloudFraction_UKME

