MODULE Micro_UKME
  USE StratCloudFraction, ONLY:       &
      Init_StratCloudFraction,Run_StratCloudFraction

  IMPLICIT NONE
  PRIVATE
  !LS_PPN____LSPCON_GAMMAF
  !      |
  !      |___LS_PPNC_______LSP_ICE_______QSAT_mix 
  !                |              |         
  !                |__LSP_SCAV    |______qsat_wat_mix
  !                               |
  !                               |______QSAT_WAT
  
  ! 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
  !#########################################################################################################
  REAL(KIND=r8), PARAMETER :: Epsilonk  = 0.62198_r8
  REAL(KIND=r8), PARAMETER :: Epsilon   = 0.62198_r8
  REAL(KIND=r8), PARAMETER :: C_Virtual = 1.0_r8/Epsilon-1.0_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 :: recip_a2  =1.0_r8/(earth_radius*earth_radius)     ! 1/(radius of earth)^2
  REAL (KIND=r8), PARAMETER   :: gasr  =                  287.05_r8! gas constant of dry air        (j/kg/k)

  !*----------------------------------------------------------------------
  !*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

  !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.

!  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/)


  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
  !
  !#########################################################################################################
  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
  PUBLIC :: Init_Micro_UKME
  PUBLIC :: RunMicro_UKME
CONTAINS
   SUBROUTINE Init_Micro_UKME(iMax)
    IMPLICIT NONE
    INTEGER , INTENT(IN   ) :: iMax

      CALL qsat_wat_data()
      CALL qsat_data()
      CALL Init_StratCloudFraction(iMax)
   END SUBROUTINE Init_Micro_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 RunMicro_UKME(&
                        kMax           , &
                        nCols          , &
                        si             , &
                        sl             , &
                        TIMESTEP       , &
                        pblh           , &
                        colrad         , &
                        kuo            , &
                        q              , &
                        QCF            , &
                        QCL            , &
                        qcf2           , &
                        T              , &
                        gps            , &
                        CF             , &
                        CFL            , &
                        CFF            , &
                        SNOW_DEPTH     , &
                        LAND_FRACT     , &
                        topo           , &
                        LSRAIN         , &
                        LSSNOW           )
    IMPLICIT NONE

    INTEGER, INTENT(IN   ) :: kMax                                 ! Number of model levels
    INTEGER, INTENT(IN   ) :: nCols           
    REAL(KIND=r8)   , INTENT(IN   ) :: si(kMax+1)
    REAL(KIND=r8)   , INTENT(IN   ) :: sl(kMax)
    REAL(KIND=r8)   , INTENT(IN   ) :: TIMESTEP                 ! IN Timestep (sec).
    REAL(KIND=r8)   , INTENT(IN   ) :: pblh      (nCols)
    REAL(KIND=r8)   , INTENT(IN   ) :: colrad    (nCols)
    INTEGER         , INTENT(IN   ) :: kuo       (nCols)
    REAL(KIND=r8)   , INTENT(INOUT) :: Q         (nCols,kMax)   ! Specific humidity  (kg water
    REAL(KIND=r8)   , INTENT(INOUT) :: QCF       (nCols,kMax)   ! Cloud ice          (kg per kg air).
    REAL(KIND=r8)   , INTENT(INOUT) :: QCL       (nCols,kMax)   ! Cloud liquid water (kg per
    REAL(KIND=r8)   , INTENT(INOUT) :: T         (nCols,kMax)   ! Temperature        (K).
    REAL(KIND=r8)   , INTENT(IN   ) :: gps       (nCols)   
    REAL(KIND=r8)   , INTENT(INOUT) :: qcf2      (nCols,kMax)   ! Ice                (kg per kg air)
    REAL(KIND=r8)   , INTENT(INOUT) :: CF        (nCols,kMax)   ! IN Cloud fraction.
    REAL(KIND=r8)   , INTENT(INOUT) :: CFL       (nCols,kMax)   ! IN Cloud liquid fraction.
    REAL(KIND=r8)   , INTENT(INOUT) :: CFF       (nCols,kMax)   ! IN Cloud ice fraction.
    REAL(KIND=r8)   , INTENT(IN   ) :: SNOW_DEPTH(nCols)                 !, INTENT(IN   )IN Snow depth (m)
    REAL(KIND=r8)   , INTENT(IN   ) :: LAND_FRACT(nCols)                 !, INTENT(IN   )IN Land fraction
    REAL(KIND=r8)   , INTENT(IN   ) :: topo      (nCols)
    REAL(KIND=r8)   , INTENT(OUT  ) :: LSRAIN    (nCols)        ! OUT Surface rainfall rate (kg / sq m /
    REAL(KIND=r8)   , INTENT(OUT  ) :: LSSNOW    (nCols)        ! OUT Surface snowfall rate (kg / sq m /
    
    REAL(KIND=r8)    :: LSRAIN3D  (nCols,kMax)   ! OUT Rain rate out of each model layer
    REAL(KIND=r8)    :: LSSNOW3D  (nCols,kMax)        ! OUT Snow rate out of each model layer
    REAL(KIND=r8)    :: RAINFRAC3D(nCols,kMax)        ! OUT rain fraction out of each model layer




    LOGICAL        :: L_MURK                               !, INTENT(IN   )IN Aerosol needs scavenging.
    REAL(KIND=r8)  :: AEROSOL   (nCols,kMax)   !, INTENT(INOUT)  Aerosol            (K).

    LOGICAL :: L_USE_SULPHATE_AUTOCONV              !, INTENT(IN   )IN True if sulphate aerosol used in autoconversion (i.e. second indirect effect)
    LOGICAL :: L_SEASALT_CCN                        !, INTENT(IN   )IN True if sea-salt required for second indirect effect.
    LOGICAL :: L_BIOMASS_CCN                        !, INTENT(IN   )IN True if biomass smoke used for 2nd indirect effect.
    LOGICAL :: L_OCFF_CCN                           !, INTENT(IN   )IN True if fossil-fuel organic carbon aerosol is used for 2nd indirect effect
    LOGICAL :: L_use_biogenic                       !, INTENT(IN   )IN True if biogenic aerosol used for 2nd indirect effect.
    LOGICAL :: L_AUTO_DEBIAS                        !, INTENT(IN   )IN True if autoconversion de-biasing scheme selected.
    LOGICAL :: L_mcr_qcf2                           !, INTENT(IN   )IN Use second prognostic ice if T
    LOGICAL :: L_it_melting                         !, INTENT(IN   )IN Use iterative melting
    LOGICAL :: L_pc2                                !, INTENT(IN   )IN Use the PC2 cloud and condenstn scheme
    LOGICAL :: L_mixing_ratio                       !, INTENT(IN   )   Use mixing ratios removed by deposition depending on
                                                    !                   amount of ice in each category
    LOGICAL :: L_autoconv_murk                      !, INTENT(IN   ) Use murk aerosol to calc. drop number


    REAL(KIND=r8)    :: SO4_AIT      (nCols,kMax)            !, INTENT(IN   )Sulphur Cycle tracers (mmr kg/kg)
    REAL(KIND=r8)    :: SO4_ACC      (nCols,kMax)            !, INTENT(IN   )Sulphur Cycle tracers (mmr kg/kg)
    REAL(KIND=r8)    :: SO4_DIS      (nCols,kMax)            !, INTENT(IN   )Sulphur Cycle tracers (mmr kg/kg)
    REAL(KIND=r8)    :: BMASS_AGD    (nCols,kMax)            !, INTENT(IN   )Biomass smoke tracers
    REAL(KIND=r8)    :: BMASS_CLD    (nCols,kMax)            !, INTENT(IN   )Biomass smoke tracers
    REAL(KIND=r8)    :: OCFF_AGD     (nCols,kMax)            !, INTENT(IN   )Fossil-fuel organic carbon tracers
    REAL(KIND=r8)    :: OCFF_CLD     (nCols,kMax)            !, INTENT(IN   )Fossil-fuel organic carbon tracers
    REAL(KIND=r8)    :: SEA_SALT_FILM(nCols,kMax)            !, INTENT(IN   )(m-3)
    REAL(KIND=r8)    :: SEA_SALT_JET (nCols,kMax)            !, INTENT(IN   )(m-3)
    REAL(KIND=r8)    :: biogenic     (nCols,kMax)            !, INTENT(IN   )(m.m.r.)
    REAL(KIND=r8)    :: RHCRIT       (nCols,kMax)            !, INTENT(IN   )IN Critical humidity for cloud formation.
    REAL(KIND=r8)    :: ec_auto                              !, INTENT(IN   )Collision coalescence efficiency
    REAL(KIND=r8)    :: Ntot_land                            !, INTENT(IN   )Number of droplets over land / m-3
    REAL(KIND=r8)    :: Ntot_sea                             !, INTENT(IN   )Number of droplets over sea / m-3
    REAL(KIND=r8)    :: x1i                                  !, INTENT(IN   )Intercept of aggregate size distribution
    REAL(KIND=r8)    :: x1ic                                 !, INTENT(IN   )Intercept of crystal size distribution
    REAL(KIND=r8)    :: x1r                                  !, INTENT(IN   )Intercept of raindrop size distribution
    REAL(KIND=r8)    :: x2r                                  !, INTENT(IN   )Scaling parameter of raindrop size distribn
    REAL(KIND=r8)    :: x4r                                  !, INTENT(IN   )Shape parameter of raindrop size distribution
    INTEGER          :: ERROR                                ! OUT Return code - 0 if OK, 1 if bad arguments.
    REAL(KIND=r8)    :: rho(nCols,kMax)     

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

    REAL(KIND=r8)    :: zi   (nCols,kMax+1)     ! Height above surface at interfaces
    REAL(KIND=r8)    :: zm   (nCols,kMax)        ! Geopotential height at mid level
    REAL(KIND=r8)    :: r_rho_levels       (1:nCols,1:kMax) ! height of rho level above earth's centre (m)
    REAL(KIND=r8)    :: r_theta_levels     (1:nCols,0:kMax) ! height of theta level above earth's centre (m)
    REAL(KIND=r8)    :: p_layer_boundaries (1:nCols,0:kMax)    !, INTENT(IN   )
    REAL(KIND=r8)    :: rho_r2             (1:nCols,1:kMax)    !, INTENT(IN   )IN Air density * earth radius**2
    REAL(KIND=r8)    :: p                  (1:nCols,1:kMax+1)  ! pressure at all points, on u,v levels (Pa).
    REAL(KIND=r8)    :: p_theta_levels     (1:nCols,1:kMax)    ! pressure at all points (Pa).

    INTEGER :: i,k
    INTEGER :: kflip


    DO i=1,nCols
       flip_pint       (i,kMax+1) = gps(i)*si(1) ! gps --> Pa
    END DO

    DO k=kMax,1,-1
       kflip=kMax+2-k
       DO i=1,nCols
          flip_pint    (i,k)      = MAX(si(kflip)*gps(i) ,1.0e-12_r8)
       END DO
    END DO
    DO k=1,kMax
       kflip=kMax+1-k
       DO i=1,nCols
          flip_t   (i,kflip) =  T (i,k)
          flip_q   (i,kflip) =  Q (i,k)
          flip_pmid(i,kflip) =  sl(  k)*gps (i)
       END DO
    END DO

    DO k=1,kMax
       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,kMax+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:kMax+1)   , flip_pint (1:nCols,1:kMax+1)  , &
         flip_pmid  (1:nCols,1:kMax)     , flip_pdel  (1:nCols,1:kMax)   , flip_rpdel(1:nCols,1:kMax)   , &
         flip_t     (1:nCols,1:kMax)     , flip_q     (1:nCols,1:kMax)   , rair   , gravit , zvir   ,&
         flip_zi    (1:nCols,1:kMax+1)   , flip_zm    (1:nCols,1:kMax)   , nCols   ,nCols, kMax)

    DO i=1,nCols
          zi(i,1) = flip_zi    (i,kMax+1)
          p (i,1) = flip_pint    (i,kMax+1)
    END DO
    DO k=1,kMax
       kflip=kMax+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)
       p_layer_boundaries (i,0) = flip_pint(i,kMax+1)
    END DO
    
    DO k=1,kMax
       kflip=kMax+1-k
       DO i=1,nCols
          R_THETA_LEVELS     (i,k) = (EARTH_RADIUS + MAX(topo(i),0.0_r8)) + zi    (i,k+1)
          r_rho_levels       (i,k) = (EARTH_RADIUS + MAX(topo(i),0.0_r8)) + zm    (i,k)
          p_theta_levels     (i,k) = flip_pmid(i,kflip)    !, INTENT(IN)
          p_layer_boundaries (i,k) = flip_pint(i,kflip)    !, INTENT(IN)
          !PRINT*,R_THETA_LEVELS       (i,k),state_zi    (i,kMax+1-k)

          !j/kg/kelvin
          !
          ! P = rho * R * T
          !
          !            P
          ! rho  = -------
          !          R * T
          !
          !           1             R * T
          !  rrho = ----- =        -------
          !          rho              P
          !
          !
          rho   (i,k) = (flip_pmid(i,kflip)/(gasr*flip_t   (i,kflip)))         ! density

          rho_r2(i,k) = rho(i,k) *( r_rho_levels(i,k) * r_rho_levels(i,k) )    !, INTENT(IN)IN Air density * earth radius**2 !         Reference density of air (kg m-3)*m**2

       END DO
    END DO

    L_MURK                 =.FALSE.    !, INTENT(IN   )IN Aerosol needs scavenging.
    L_autoconv_murk        =.FALSE.     !, INTENT(IN   )IN Use murk aerosol to calc. drop number
    AEROSOL=0.0_r8

    L_USE_SULPHATE_AUTOCONV=.FALSE.    !, INTENT(IN   )IN True if sulphate aerosol used in autoconversion (i.e. second indirect effect)
    L_SEASALT_CCN          =.FALSE.    !, INTENT(IN   )IN True if sea-salt required for second indirect effect.
    L_BIOMASS_CCN          =.FALSE.    !, INTENT(IN   )IN True if biomass smoke used for 2nd indirect effect.
    L_OCFF_CCN             =.FALSE.    !, INTENT(IN   )IN True if fossil-fuel organic carbon aerosol is used for 2nd indirect effect
    L_use_biogenic         =.FALSE.    !, INTENT(IN   )IN True if biogenic aerosol used for 2nd indirect effect.
    L_AUTO_DEBIAS          =.TRUE.     !, INTENT(IN   )IN True if autoconversion de-biasing scheme selected.
    L_mcr_qcf2             =.TRUE.     !, INTENT(IN   )IN Use second prognostic ice if T
    L_it_melting           =.TRUE.     !, INTENT(IN   )IN Use iterative melting
    L_pc2                  =.FALSE.    !, INTENT(IN   )IN Use the PC2 cloud and condenstn scheme
    L_mixing_ratio         =.FALSE.    !, INTENT(IN   )IN Use mixing ratios removed by deposition depending on

    EC_AUTO=0.425_r8             !Collision coalescence efficiency
    NTOT_LAND=3.0E8_r8           ! Number of droplets over land / m-3
    NTOT_SEA=1.0E8_r8            ! Number of droplets over sea / m-3
                                       !                  amount of ice in each category
    X1I=4.0E6_r8    !, INTENT(IN)Intercept of aggregate size distribution
    X1IC=80.0E6_r8  !, INTENT(IN)Intercept of crystal size distribution
    X1R  =26.2_r8   !, INTENT(IN)Intercept of raindrop size distribution
    x2r  =1.57_r8   !, INTENT(IN)Scaling parameter of raindrop size distribn
    x4r  = 1.0_r8   !, INTENT(IN)Shape parameter of raindrop size distribution

    DO k=1,kMax
       DO i=1,nCols
          SO4_AIT      (i,k)=0.0_r8
          SO4_ACC      (i,k)=0.0_r8
          SO4_DIS      (i,k)=0.0_r8
          BMASS_AGD    (i,k)=0.0_r8
          BMASS_CLD    (i,k)=0.0_r8
          OCFF_AGD     (i,k)=0.0_r8
          OCFF_CLD     (i,k)=0.0_r8
          SEA_SALT_FILM(i,k)=0.0_r8
          SEA_SALT_JET (i,k)=0.0_r8
          biogenic     (i,k)=0.0_r8
          RHCRIT       (i,k)=RHCRIT0(idx(kMax,38,k))
       END DO
    END DO    

    CALL Run_StratCloudFraction(&
                        nCols                             , &!INTEGER   , INTENT(IN   ) :: nCols
                        kMax                              , &!INTEGER   , INTENT(IN   ) :: LEVELS
                        L_mcr_qcf2                        , &!LOGICAL, INTENT(IN   ) :: L_mcr_qcf2              ! IN Use second prognostic ice if T
                        l_mixing_ratio                    , &!LOGICAL,INTENT(IN   ) :: l_mixing_ratio! true if using mixing ratio formulation
                        RHCRIT         (1:nCols,1:kMax  ) , &!REAL(KIND=r8), INTENT(IN   ) :: rhcrit	    (nCols,LEVELS) 
                        zi             (1:nCols,1:kMax+1) , &!REAL(KIND=r8), INTENT(IN   ) :: zi      (1:nCols,1:LEVELS+1)
                        zm             (1:nCols,1:kMax)   , &!REAL(KIND=r8), INTENT(IN   ) :: zm      (1:nCols,1:LEVELS) 
                        pblh           (1:nCols)          , &!REAL(KIND=r8), INTENT(IN   ) :: pblh    (1:nCols)   !
                        colrad         (1:nCols)          , &!REAL(KIND=r8), INTENT(IN   ) :: colrad  (1:nCols)   !
                        p              (1:nCols,1:kMax+1) , &!REAL(KIND=r8), INTENT(IN   ) :: p    (1:nCols,1:LEVELS+1)   ! pressure at all points, on theta levels (Pa).
                        p_theta_levels (1:nCols,1:kMax)   , &!REAL(KIND=r8), INTENT(IN   ) :: p_theta_levels(nCols,levels)    ! pressure at all points (Pa).
                        R_THETA_LEVELS (1:nCols,0:kMax)   , &!REAL(KIND=r8), INTENT(IN   ) :: r_theta_levels(1:nCols,0:LEVELS) ! height of theta level above earth's centre (m)
                        kuo            (1:nCols)          , &!INTEGER      , INTENT(IN   ) :: kuo     (1:nCols) 
                        t              (1:nCols,1:kMax)   , &!REAL(KIND=r8), INTENT(INOUT) :: T3      (1:nCols,LEVELS)
                        q              (1:nCols,1:kMax)   , &!REAL(KIND=r8), INTENT(INOUT) :: q       (1:nCols,LEVELS)
                        qcl            (1:nCols,1:kMax)   , &!REAL(KIND=r8), INTENT(INOUT) :: qcl     (1:nCols,LEVELS)
                        qcf            (1:nCols,1:kMax)   , &!REAL(KIND=r8), INTENT(IN   ) :: qcf     (1:nCols,LEVELS)
                        qcf2           (1:nCols,1:kMax)   , &!REAL(KIND=r8), INTENT(IN   ) :: qcf2    (1:nCols,LEVELS)
                        CF             (1:nCols,1:kMax)   , &!REAL(KIND=r8), INTENT(INOUT) :: CF      (nCols,LEVELS) !Cloud fraction at processed levels (decimal fraction).
                        CFL            (1:nCols,1:kMax)   , &!REAL(KIND=r8), INTENT(INOUT) :: CFL     (nCols,LEVELS) !Liquid cloud fraction at processed levels (decimal fraction).
                        CFF            (1:nCols,1:kMax)     )!REAL(KIND=r8), INTENT(INOUT) :: CFF     (nCols,LEVELS) !Frozen cloud fraction at processed levels (decimal fraction).

      CALL LS_PPN(&
       p_layer_boundaries     , &!REAL   , INTENT(IN   ) :: p_layer_boundaries (nCols,0:kMax)    !
       p_theta_levels         , &!REAL   , INTENT(IN   ) :: p_theta_levels     (nCols,kMax)      !
       TIMESTEP               , &!REAL   , INTENT(IN   ) :: TIMESTEP                ! IN Timestep (sec).
       L_autoconv_murk        , &!LOGICAL, INTENT(IN   ) :: L_autoconv_murk! Use murk aerosol to calc. drop number
       ec_auto                , &!REAL   , INTENT(IN   ) :: ec_auto        ! Collision coalescence efficiency
       Ntot_land              , &!REAL   , INTENT(IN   ) :: Ntot_land      ! Number of droplets over land / m-3
       Ntot_sea               , &!REAL   , INTENT(IN   ) :: Ntot_sea       ! Number of droplets over sea / m-3
       x1i                    , &!REAL   , INTENT(IN   ) :: x1i            ! Intercept of aggregate size distribution
       x1ic                   , &!REAL   , INTENT(IN   ) :: x1ic           ! Intercept of crystal size distribution
       x1r                    , &!REAL   , INTENT(IN   ) :: x1r            ! Intercept of raindrop size distribution
       x2r                    , &!REAL   , INTENT(IN   ) :: x2r            ! Scaling parameter of raindrop size distribn
       x4r                    , &!REAL   , INTENT(IN   ) :: x4r            ! Shape parameter of raindrop size distribution
       CF                     , &!REAL   , INTENT(IN   ) :: CF  (nCols,kMax)      ! IN Cloud fraction.
       CFL                    , &!REAL   , INTENT(IN   ) :: CFL                (nCols,kMax)      ! IN Cloud liquid fraction.
       CFF                    , &!REAL   , INTENT(IN   ) :: CFF                (nCols,kMax)      ! IN Cloud ice fraction.
       RHCRIT                 , &!REAL   , INTENT(IN   ) :: RHCRIT             (nCols,kMax)      ! IN Critical humidity for cloud formation.
       kMax                   , &!INTEGER, INTENT(IN   ) :: kMax                                 ! Number of model levels
       rho_r2                 , &!REAL   , INTENT(IN   ) :: rho_r2             (1:nCols,kMax)    ! IN Air density * earth radius**2
       r_rho_levels           , &!REAL   , INTENT(IN   ) :: r_rho_levels       (1:nCols,kMax)    ! IN Earths radius at each rho level
       r_theta_levels         , &!REAL   , INTENT(IN   ) :: r_theta_levels     (1:nCols,0:kMax)  ! IN Earths radius at each theta level
       q                      , &!REAL   , INTENT(INOUT) :: Q      (nCols,kMax)   ! Specific humidity  (kg water
       qcf                    , &!REAL   , INTENT(INOUT) :: QCF    (nCols,kMax)   ! Cloud ice          (kg per kg air).
       qcl                    , &!REAL   , INTENT(INOUT) :: QCL    (nCols,kMax)   ! Cloud liquid water (kg per
       T                      , &!REAL   , INTENT(INOUT) :: T      (nCols,kMax)   ! Temperature        (K).
       qcf2                   , &!REAL   , INTENT(INOUT) :: qcf2   (nCols,kMax)   ! Ice                (kg per kg air)
       L_mcr_qcf2             , &!LOGICAL, INTENT(IN   ) :: L_mcr_qcf2              ! IN Use second prognostic ice if T
       L_it_melting           , &!LOGICAL, INTENT(IN   ) :: L_it_melting            ! IN Use iterative melting
       L_USE_SULPHATE_AUTOCONV, &!LOGICAL, INTENT(IN   ) :: L_USE_SULPHATE_AUTOCONV ! IN True if sulphate aerosol used in autoconversion (i.e. second indirect effect)
       L_AUTO_DEBIAS          , &!LOGICAL, INTENT(IN   ) :: L_AUTO_DEBIAS           ! IN True if autoconversion de-biasing scheme selected.
       l_mixing_ratio         , &!LOGICAL, INTENT(IN   ) :: L_mixing_ratio ! Use mixing ratios removed by deposition depending on
       SEA_SALT_FILM          , &!REAL   , INTENT(IN   ) :: SEA_SALT_FILM(nCols,kMax)! (m-3)
       SEA_SALT_JET           , &!REAL   , INTENT(IN   ) :: SEA_SALT_JET (nCols,kMax)! (m-3)
       L_SEASALT_CCN          , &!LOGICAL, INTENT(IN   ) :: L_SEASALT_CCN           ! IN True if sea-salt required for second indirect effect.
       L_use_biogenic         , &!LOGICAL, INTENT(IN   ) :: L_use_biogenic          ! IN True if biogenic aerosol used for 2nd indirect effect.
       biogenic               , &!REAL   , INTENT(IN   ) :: biogenic     (nCols,kMax)           ! (m.m.r.)
       SNOW_DEPTH             , &!REAL   , INTENT(IN   ) :: SNOW_DEPTH(nCols)        ! IN Snow depth (m)
       LAND_FRACT             , &!REAL   , INTENT(IN   ) :: LAND_FRACT(nCols)        ! IN Land fraction
       SO4_AIT                , &!REAL   , INTENT(IN   ) :: SO4_AIT   (nCols,kMax)   !Sulphur Cycle tracers (mmr kg/kg)
       SO4_ACC                , &!REAL   , INTENT(IN   ) :: SO4_ACC   (nCols,kMax)   !Sulphur Cycle tracers (mmr kg/kg)
       SO4_DIS                , &!REAL   , INTENT(IN   ) :: SO4_DIS   (nCols,kMax)   !Sulphur Cycle tracers (mmr kg/kg)
       BMASS_AGD              , &!REAL   , INTENT(IN   ) :: BMASS_AGD (nCols,kMax)   !Biomass smoke tracers
       BMASS_CLD              , &!REAL   , INTENT(IN   ) :: BMASS_CLD (nCols,kMax)   !Biomass smoke tracers
       L_BIOMASS_CCN          , &!LOGICAL, INTENT(IN   ) :: L_BIOMASS_CCN           ! IN True if biomass smoke used for 2nd indirect effect.
       OCFF_AGD               , &!REAL   , INTENT(IN   ) :: OCFF_AGD  (nCols,kMax)   !Fossil-fuel organic carbon tracers
       OCFF_CLD               , &!REAL   , INTENT(IN   ) :: OCFF_CLD  (nCols,kMax)   !Fossil-fuel organic carbon tracers
       L_OCFF_CCN             , &!LOGICAL, INTENT(IN   ) :: L_OCFF_CCN              ! IN True if fossil-fuel organic carbon aerosol is used for 2nd indirect effect
       AEROSOL                , &!REAL   , INTENT(INOUT) :: AEROSOL(nCols,kMax)   ! Aerosol            (K).
       L_MURK                 , &!LOGICAL, INTENT(IN   ) :: L_MURK                  ! IN Aerosol needs scavenging.
       L_pc2                  , &!LOGICAL, INTENT(IN   ) :: L_pc2                   ! IN Use the PC2 cloud and condenstn scheme
       LSRAIN                 , &!REAL   , INTENT(OUT  ) :: LSRAIN(nCols)       ! OUT Surface rainfall rate (kg / sq m /
       LSSNOW                 , &!REAL   , INTENT(OUT  ) :: LSSNOW(nCols)       ! OUT Surface snowfall rate (kg / sq m /
       LSRAIN3D               , &!REAL   , INTENT(OUT  ) :: LSRAIN3D(nCols,kMax)! OUT Rain rate out of each model layer
       LSSNOW3D               , &!REAL   , INTENT(OUT  ) :: LSSNOW3D(nCols,kMax)! OUT Snow rate out of each model layer
       RAINFRAC3D             , &!REAL   , INTENT(OUT  ) :: RAINFRAC3D(nCols,kMax)! OUT rain fraction out of each model layer
       nCols                  , &!INTEGER, INTENT(IN   ) :: nCols           
       ERROR                    &!INTEGER, INTENT(OUT  ) ::  ERROR          ! OUT Return code - 0 if OK, 1 if bad arguments.
       )
      ! (kg m^-2 s^-1).  0.001m/s
    !
    ! after cumulus parameterization
    ! out  tn1, qn1, prec, kuo,ktop, kbot
    !
    DO i = 1,nCols
      LSRAIN(i) = 0.5_r8*LSRAIN(i)*TIMESTEP/1000.0_r8! convert mm/s to meters
      LSSNOW(i) = 0.5_r8*LSSNOW(i)*TIMESTEP/1000.0_r8! convert mm/s to meters
    ! RAINCV(i)=dtime*pre1(i)             !in mm/sec(ditme),by 0.5_r8(if leap-frog or 2dt)
    ! RAINCV(i)=RAINCV(i)/1000.0_r8       !in m for gcm
    END DO


   END SUBROUTINE RunMicro_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*******************************
  !
  !*LL  SUBROUTINES LS_PPN and LS_PPNC------------------------------------
  !LL  Purpose:
  !LL          LS_PPN and LS_PPNC:
  !LL           Calculate large-scale (dynamical) precipitation.
  !LL           LS_PPNC is the gather/scatter routine which then
  !LL           calls LSP_ICE.
  !LL  Note: in all cases, level counters (incl subscripts) run from 1
  !LL        (lowest model layer) to kMax (topmost "wet" model
  !LL        layer) - it is assumed that the bottom kMax layers are
  !LL        the "wet" layers.
  !LL
  !LL  Put through fpp on Cray.  Activate *IF definition CRAY if running
  !LL  on the Cray.
  !LL
  !LL  Modification History from Version 4.4
  !LL     Version    Date
  !LL       4.5      March 98          New Deck        Damian Wilson
  !
  !         5.1      16-12-99   Change to allow 3D RHcrit diagnostic
  !                             in place of 1D parameter. AC Bushell
  !         5.2      25/10/00   Reintroduction of tracers. P.Selwood
  !         5.2      21-11-00   Allow interfacting with 3C scheme.
  !                             Return diagnostics. Damian Wilson
  !LL
  !         5.2      28-11-00   Pass down sea-salt arrays.
  !                                                       A. Jones
  !         5.3      29-08-01   Introduce logical to control effect of
  !                             sulphate aerosol on autoconversion.
  !                                                       A. Jones
  !         5.3      24-09-01   Tidy up code (mostly redundant) relating
  !                             to the sulphur cycle.     A. Jones
  !         5.4      30-08-02   Remove lscav_agedsoot, which is now
  !                             calculated in microphys_ctl.  P. Davison
  !         5.4      27-07-02   Change cloud fractions to prognostics
  !                             for PC2                   D. Wilson
  !
  !         5.4      25-04-02   Pass land fraction down to LSP_ICE.
  !                                                       A. Jones
  !         5.5      03-02-03   Pass extra microphysics variables
  !                             down to LSP_ICE.           R.M.Forbes
  !         5.5      03-02-03   Include extra microphysics variables
  !                             (qcf2,qrain,qgraup)          R.M.Forbes
  !         6.1      01-08-04   Include variables for prognostic rain
  !                             and graupel.             R.M.Forbes
  !         6.1      07-04-04   Add biomass smoke to call to LSP_ICE.
  !                                                          A. Jones
  !         6.1      07-04-04   Pass switch for autoconversion de-biasing
  !                             down to LSP_ICE.              A. Jones
  !         6.2      22-08-05   Remove commented out code. P.Selwood.
  !         6.2      23-11-05   Pass through precip variables from
  !                             UMUI. Damian Wilson
  !         6.2      11-01-06   Include non-hydrostatic calculation
  !                             of air density and model thickness.
  !                                                       D. Wilson
  !         6.2      31-01-06   Pass process rate diags through. R.Forbes
  !         6.4      10-01-07   Provide mixing ratio logical control
  !                                                       D. Wilson
  !LL  Programming standard: Unified Model Documentation Paper No 3
  !LL
  !LL  Documentation: UM Documentation Paper 26.
  !LL
  !*L  Arguments:---------------------------------------------------------
  SUBROUTINE LS_PPN(&
       p_layer_boundaries     , &!REAL   , INTENT(IN   ) :: p_layer_boundaries (nCols,0:kMax)    !
       p_theta_levels         , &!REAL   , INTENT(IN   ) :: p_theta_levels     (nCols,kMax)      !
       TIMESTEP               , &!REAL   , INTENT(IN   ) :: TIMESTEP                ! IN Timestep (sec).
       L_autoconv_murk        , &!LOGICAL, INTENT(IN   ) :: L_autoconv_murk! Use murk aerosol to calc. drop number
       ec_auto                , &!REAL   , INTENT(IN   ) :: ec_auto        ! Collision coalescence efficiency
       Ntot_land              , &!REAL   , INTENT(IN   ) :: Ntot_land      ! Number of droplets over land / m-3
       Ntot_sea               , &!REAL   , INTENT(IN   ) :: Ntot_sea       ! Number of droplets over sea / m-3
       x1i                    , &!REAL   , INTENT(IN   ) :: x1i            ! Intercept of aggregate size distribution
       x1ic                   , &!REAL   , INTENT(IN   ) :: x1ic           ! Intercept of crystal size distribution
       x1r                    , &!REAL   , INTENT(IN   ) :: x1r            ! Intercept of raindrop size distribution
       x2r                    , &!REAL   , INTENT(IN   ) :: x2r            ! Scaling parameter of raindrop size distribn
       x4r                    , &!REAL   , INTENT(IN   ) :: x4r            ! Shape parameter of raindrop size distribution
       CF                     , &!REAL   , INTENT(IN   ) :: CF  (nCols,kMax)      ! IN Cloud fraction.
       CFL                    , &!REAL   , INTENT(IN   ) :: CFL                (nCols,kMax)      ! IN Cloud liquid fraction.
       CFF                    , &!REAL   , INTENT(IN   ) :: CFF                (nCols,kMax)      ! IN Cloud ice fraction.
       RHCRIT                 , &!REAL   , INTENT(IN   ) :: RHCRIT             (nCols,kMax)      ! IN Critical humidity for cloud formation.
       kMax                   , &!INTEGER, INTENT(IN   ) :: kMax                                 ! Number of model levels
       rho_r2                 , &!REAL   , INTENT(IN   ) :: rho_r2             (1:nCols,kMax)    ! IN Air density * earth radius**2
       r_rho_levels           , &!REAL   , INTENT(IN   ) :: r_rho_levels       (1:nCols,kMax)    ! IN Earths radius at each rho level
       r_theta_levels         , &!REAL   , INTENT(IN   ) :: r_theta_levels     (1:nCols,0:kMax)  ! IN Earths radius at each theta level
       q                      , &!REAL   , INTENT(INOUT) :: Q      (nCols,kMax)   ! Specific humidity  (kg water
       qcf                    , &!REAL   , INTENT(INOUT) :: QCF    (nCols,kMax)   ! Cloud ice          (kg per kg air).
       qcl                    , &!REAL   , INTENT(INOUT) :: QCL    (nCols,kMax)   ! Cloud liquid water (kg per
       T                      , &!REAL   , INTENT(INOUT) :: T      (nCols,kMax)   ! Temperature        (K).
       qcf2                   , &!REAL   , INTENT(INOUT) :: qcf2   (nCols,kMax)   ! Ice                (kg per kg air)
       L_mcr_qcf2             , &!LOGICAL, INTENT(IN   ) :: L_mcr_qcf2              ! IN Use second prognostic ice if T
       L_it_melting           , &!LOGICAL, INTENT(IN   ) :: L_it_melting            ! IN Use iterative melting
       L_USE_SULPHATE_AUTOCONV, &!LOGICAL, INTENT(IN   ) :: L_USE_SULPHATE_AUTOCONV ! IN True if sulphate aerosol used in autoconversion (i.e. second indirect effect)
       L_AUTO_DEBIAS          , &!LOGICAL, INTENT(IN   ) :: L_AUTO_DEBIAS           ! IN True if autoconversion de-biasing scheme selected.
       l_mixing_ratio         , &!LOGICAL, INTENT(IN   ) :: L_mixing_ratio ! Use mixing ratios removed by deposition depending on
       SEA_SALT_FILM          , &!REAL   , INTENT(IN   ) :: SEA_SALT_FILM(nCols,kMax)! (m-3)
       SEA_SALT_JET           , &!REAL   , INTENT(IN   ) :: SEA_SALT_JET (nCols,kMax)! (m-3)
       L_SEASALT_CCN          , &!LOGICAL, INTENT(IN   ) :: L_SEASALT_CCN           ! IN True if sea-salt required for second indirect effect.
       L_use_biogenic         , &!LOGICAL, INTENT(IN   ) :: L_use_biogenic          ! IN True if biogenic aerosol used for 2nd indirect effect.
       biogenic               , &!REAL   , INTENT(IN   ) :: biogenic     (nCols,kMax)           ! (m.m.r.)
       SNOW_DEPTH             , &!REAL   , INTENT(IN   ) :: SNOW_DEPTH(nCols)        ! IN Snow depth (m)
       LAND_FRACT             , &!REAL   , INTENT(IN   ) :: LAND_FRACT(nCols)        ! IN Land fraction
       SO4_AIT                , &!REAL   , INTENT(IN   ) :: SO4_AIT   (nCols,kMax)   !Sulphur Cycle tracers (mmr kg/kg)
       SO4_ACC                , &!REAL   , INTENT(IN   ) :: SO4_ACC   (nCols,kMax)   !Sulphur Cycle tracers (mmr kg/kg)
       SO4_DIS                , &!REAL   , INTENT(IN   ) :: SO4_DIS   (nCols,kMax)   !Sulphur Cycle tracers (mmr kg/kg)
       BMASS_AGD              , &!REAL   , INTENT(IN   ) :: BMASS_AGD (nCols,kMax)   !Biomass smoke tracers
       BMASS_CLD              , &!REAL   , INTENT(IN   ) :: BMASS_CLD (nCols,kMax)   !Biomass smoke tracers
       L_BIOMASS_CCN          , &!LOGICAL, INTENT(IN   ) :: L_BIOMASS_CCN           ! IN True if biomass smoke used for 2nd indirect effect.
       OCFF_AGD               , &!REAL   , INTENT(IN   ) :: OCFF_AGD  (nCols,kMax)   !Fossil-fuel organic carbon tracers
       OCFF_CLD               , &!REAL   , INTENT(IN   ) :: OCFF_CLD  (nCols,kMax)   !Fossil-fuel organic carbon tracers
       L_OCFF_CCN             , &!LOGICAL, INTENT(IN   ) :: L_OCFF_CCN              ! IN True if fossil-fuel organic carbon aerosol is used for 2nd indirect effect
       AEROSOL                , &!REAL   , INTENT(INOUT) :: AEROSOL(nCols,kMax)   ! Aerosol            (K).
       L_MURK                 , &!LOGICAL, INTENT(IN   ) :: L_MURK                  ! IN Aerosol needs scavenging.
       L_pc2                  , &!LOGICAL, INTENT(IN   ) :: L_pc2                   ! IN Use the PC2 cloud and condenstn scheme
       LSRAIN                 , &!REAL   , INTENT(OUT  ) :: LSRAIN(nCols)       ! OUT Surface rainfall rate (kg / sq m /
       LSSNOW                 , &!REAL   , INTENT(OUT  ) :: LSSNOW(nCols)       ! OUT Surface snowfall rate (kg / sq m /
       LSRAIN3D               , &!REAL   , INTENT(OUT  ) :: LSRAIN3D(nCols,kMax)! OUT Rain rate out of each model layer
       LSSNOW3D               , &!REAL   , INTENT(OUT  ) :: LSSNOW3D(nCols,kMax)! OUT Snow rate out of each model layer
       RAINFRAC3D             , &!REAL   , INTENT(OUT  ) :: RAINFRAC3D(nCols,kMax)! OUT rain fraction out of each model layer
       nCols                  , &!INTEGER, INTENT(IN   ) :: nCols           
       ERROR                    &!INTEGER, INTENT(OUT  ) ::  ERROR          ! OUT Return code - 0 if OK, 1 if bad arguments.
       )

    IMPLICIT NONE

    INTEGER, INTENT(IN) :: kMax                                 ! Number of model levels
    INTEGER, INTENT(IN) :: nCols           
    REAL(KIND=r8)   , INTENT(INOUT) :: CF                 (nCols,kMax)      ! IN Cloud fraction.
    REAL(KIND=r8)   , INTENT(IN) :: p_theta_levels     (nCols,kMax)      !
    REAL(KIND=r8)   , INTENT(IN) :: p_layer_boundaries (nCols,0:kMax)    !
    REAL(KIND=r8)   , INTENT(IN) :: RHCRIT             (nCols,kMax)      ! IN Critical humidity for cloud formation.
    REAL(KIND=r8)   , INTENT(INOUT) :: CFL                (nCols,kMax)      ! IN Cloud liquid fraction.
    REAL(KIND=r8)   , INTENT(INOUT) :: CFF                (nCols,kMax)      ! IN Cloud ice fraction.
    REAL(KIND=r8)   , INTENT(IN) :: rho_r2             (1:nCols,kMax)    ! IN Air density * earth radius**2
    REAL(KIND=r8)   , INTENT(IN) :: r_rho_levels       (1:nCols,kMax)    ! IN Earths radius at each rho level
    REAL(KIND=r8)   , INTENT(IN) :: r_theta_levels     (1:nCols,0:kMax)  ! IN Earths radius at each theta level
    REAL(KIND=r8)   , INTENT(IN) :: TIMESTEP                ! IN Timestep (sec).
    LOGICAL, INTENT(IN) :: L_MURK                  ! IN Aerosol needs scavenging.
    LOGICAL, INTENT(IN) :: L_USE_SULPHATE_AUTOCONV ! IN True if sulphate aerosol used in autoconversion (i.e. second indirect effect)
    LOGICAL, INTENT(IN) :: L_SEASALT_CCN           ! IN True if sea-salt required for second indirect effect.
    LOGICAL, INTENT(IN) :: L_BIOMASS_CCN           ! IN True if biomass smoke used for 2nd indirect effect.
    LOGICAL, INTENT(IN) :: L_OCFF_CCN              ! IN True if fossil-fuel organic carbon aerosol is used for 2nd indirect effect
    LOGICAL, INTENT(IN) :: L_use_biogenic          ! IN True if biogenic aerosol used for 2nd indirect effect.
    LOGICAL, INTENT(IN) :: L_AUTO_DEBIAS           ! IN True if autoconversion de-biasing scheme selected.
    LOGICAL, INTENT(IN) :: L_mcr_qcf2              ! IN Use second prognostic ice if T
    LOGICAL, INTENT(IN) :: L_it_melting            ! IN Use iterative melting
    LOGICAL, INTENT(IN) :: L_pc2                   ! IN Use the PC2 cloud and condenstn scheme

    REAL(KIND=r8), INTENT(INOUT) :: Q      (nCols,kMax)   ! Specific humidity  (kg water
    REAL(KIND=r8), INTENT(INOUT) :: QCF    (nCols,kMax)   ! Cloud ice          (kg per kg air).
    REAL(KIND=r8), INTENT(INOUT) :: QCL    (nCols,kMax)   ! Cloud liquid water (kg per
    REAL(KIND=r8), INTENT(INOUT) :: T      (nCols,kMax)   ! Temperature        (K).
    REAL(KIND=r8), INTENT(INOUT) :: qcf2   (nCols,kMax)   ! Ice                (kg per kg air)
    REAL(KIND=r8), INTENT(INOUT) :: AEROSOL(nCols,kMax)   ! Aerosol            (K).

    REAL(KIND=r8),INTENT(INOUT) :: SO4_AIT   (nCols,kMax)   !Sulphur Cycle tracers (mmr kg/kg)
    REAL(KIND=r8),INTENT(INOUT) :: SO4_ACC   (nCols,kMax)   !Sulphur Cycle tracers (mmr kg/kg)
    REAL(KIND=r8),INTENT(INOUT) :: SO4_DIS   (nCols,kMax)   !Sulphur Cycle tracers (mmr kg/kg)
    REAL(KIND=r8),INTENT(INOUT) :: BMASS_AGD (nCols,kMax)   !Biomass smoke tracers
    REAL(KIND=r8),INTENT(INOUT) :: BMASS_CLD (nCols,kMax)   !Biomass smoke tracers
    REAL(KIND=r8),INTENT(INOUT) :: OCFF_AGD  (nCols,kMax)   !Fossil-fuel organic carbon tracers
    REAL(KIND=r8),INTENT(INOUT) :: OCFF_CLD  (nCols,kMax)   !Fossil-fuel organic carbon tracers
    REAL(KIND=r8),INTENT(IN   ) :: SNOW_DEPTH(nCols)        ! IN Snow depth (m)
    REAL(KIND=r8),INTENT(IN   ) :: LAND_FRACT(nCols)        ! IN Land fraction
    REAL(KIND=r8),INTENT(IN   ) :: SEA_SALT_FILM(nCols,kMax)! (m-3)
    REAL(KIND=r8),INTENT(IN   ) :: SEA_SALT_JET (nCols,kMax)! (m-3)
    REAL(KIND=r8),INTENT(IN   ) :: biogenic     (nCols,kMax)           ! (m.m.r.)
    LOGICAL, INTENT(IN) :: L_mixing_ratio ! Use mixing ratios removed by deposition depending on
                                          ! amount of ice in each category
    LOGICAL, INTENT(IN) :: L_autoconv_murk! Use murk aerosol to calc. drop number

    REAL(KIND=r8)   , INTENT(IN) :: ec_auto        ! Collision coalescence efficiency
    REAL(KIND=r8)   , INTENT(IN) :: Ntot_land      ! Number of droplets over land / m-3
    REAL(KIND=r8)   , INTENT(IN) :: Ntot_sea       ! Number of droplets over sea / m-3
    REAL(KIND=r8)   , INTENT(IN) :: x1i            ! Intercept of aggregate size distribution
    REAL(KIND=r8)   , INTENT(IN) :: x1ic           ! Intercept of crystal size distribution
    REAL(KIND=r8)   , INTENT(IN) :: x1r            ! Intercept of raindrop size distribution
    REAL(KIND=r8)   , INTENT(IN) :: x2r            ! Scaling parameter of raindrop size distribn
    REAL(KIND=r8)   , INTENT(IN) :: x4r            ! Shape parameter of raindrop size distribution

    REAL(KIND=r8)   , INTENT(OUT  ) :: LSRAIN(nCols)       ! OUT Surface rainfall rate (kg / sq m /
    REAL(KIND=r8)   , INTENT(OUT  ) :: LSSNOW(nCols)       ! OUT Surface snowfall rate (kg / sq m /
    REAL(KIND=r8)   , INTENT(OUT  ) :: LSRAIN3D(nCols,kMax)! OUT Rain rate out of each model layer
    REAL(KIND=r8)   , INTENT(OUT  ) :: LSSNOW3D(nCols,kMax)! OUT Snow rate out of each model layer
    REAL(KIND=r8)   , INTENT(OUT  ) :: RAINFRAC3D(nCols,kMax)! OUT rain fraction out of each model layer
    INTEGER, INTENT(OUT  ) ::  ERROR          ! OUT Return code - 0 if OK, 1 if bad arguments.


    !*L  Workspace usage ---------------------------------------------------
    !
    LOGICAL :: L_non_hydrostatic ! Use non-hydrostatic formulation of layer thicknesses

    !ajm      LOGICAL
    !ajm     & H(PFIELD)      ! Used as "logical" in compression.
    INTEGER :: IX(nCols)    ! Index for compress/expand.
    REAL(KIND=r8)    :: VFALL(nCols)        ! snow fall velocity (m per s).
    REAL(KIND=r8)    :: VFALL2(nCols)       ! fall velocity for qcf2 (m/s)
    REAL(KIND=r8)    :: LSSNOW2(nCols)      ! snowfall rate for qcf2
    REAL(KIND=r8)    :: VFALL_RAIN(nCols)   ! fall velocity for rain (m/s)
    REAL(KIND=r8)    :: VFALL_GRAUP(nCols)  ! fall vel. for graupel (m/s)
    REAL(KIND=r8)    :: CTTEMP(nCols)
    REAL(KIND=r8)    :: RAINFRAC(nCols)
    REAL(KIND=r8)    :: FRAC_ICE_ABOVE(nCols) ! Cloud ice fraction
    !                                            in layer above
    REAL(KIND=r8)    :: layer_thickness(nCols)
    REAL(KIND=r8)    :: rho1(nCols)
    REAL(KIND=r8)    :: rho2(nCols)
    REAL(KIND=r8)    :: deltaz(nCols,kMax)
    REAL(KIND=r8)    :: rhodz_dry(nCols,kMax)
    REAL(KIND=r8)    :: rhodz_moist(nCols,kMax)
    REAL(KIND=r8)    :: q_total(nCols)
    REAL(KIND=r8)    :: LSGRAUP(nCols)      ! Graupel fall rate (kg/m2/s)

    INTEGER :: biog_dim_ice ! local ! Array dimension for passing to LSP_ICE.
    INTEGER :: biogenic_ptr ! local ! Pointer for biogenic aerosol array.
    INTEGER :: salt_dim_ice    ! Array dimension for passing to LSP_ICE.
    INTEGER :: sea_salt_ptr    ! Pointer for sea-salt arrays.

    ! Allocate CX and CONSTP arrays
    ! Start C_LSPSIZ
    ! Description: Include file containing idealised forcing options
    ! Author:      R. Forbes
    !
    ! History:
    ! Version  Date      Comment
    ! -------  ----      -------
    !   6.1    01/08/04  Increase dimension for rain/graupel.  R.Forbes
    !   6.2    22/08/05  Include the step size between ice categories.
    !                                                   Damian Wilson

    ! Sets up the size of arrays for CX and CONSTP
    REAL(KIND=r8)    :: CX(80)
    REAL(KIND=r8)    :: CONSTP(80)
    INTEGER,PARAMETER:: ice_type_offset=20

    ! End C_LSPSIZ
    ! --------------------------COMDECK C_LSPMIC----------------------------
    ! SPECIFIES MICROPHYSICAL PARAMETERS FOR AUTOCONVERSION, HALLETT MOSSOP
    ! PROCESS, ICE NUCLEATION. ALSO SPECIFIES NUMBER OF ITERATIONS OF
    ! THE MICROPHYSICS AND ICE CLOUD FRACTION METHOD
    ! ----------------------------------------------------------------------
    !
    ! History:
    !
    ! Version    Date     Comment
    ! -------    ----     -------
    !   5.4    16/08/02   Correct comment line, add PC2 parameters and
    !                     move THOMO to c_micro     Damian Wilson
    !   6.0    11/08/03   Correct value of wind_shear_factor for PC2
    !                                                          Damian Wilson
    !   6.2    17/11/05   Remove variables that are now in UMUI. D. Wilson
    !   6.2    03/02/06   Include droplet settling logical. Damian Wilson
    !
    ! ----------------------------------------------------------------------
    !      AUTOCONVERSION TERMS
    ! ----------------------------------------------------------------------
    !
    !     LOGICAL, PARAMETER :: L_AUTOCONV_MURK is set in UMUI
    ! Set to .TRUE. to calculate droplet concentration from MURK aerosol,
    ! which will override L_USE_SULPHATE_AUTOCONV (second indirect effect
    ! of sulphate aerosol). If both are .FALSE., droplet concentrations
    ! from comdeck C_MICRO are used to be consistent with the values
    ! used in the radiation scheme.

    ! This next set of parameters is to allow the 3B scheme to
    ! be replicated at 3C/3D
    ! Inhomogeneity factor for autoconversion rate
    REAL(KIND=r8),PARAMETER:: INHOMOG_RATE=1.0_r8

    ! Inhomogeneity factor for autoconversion limit
    REAL(KIND=r8),PARAMETER:: INHOMOG_LIM=1.0_r8

    ! Threshold droplet radius for autoconversion
    REAL(KIND=r8),PARAMETER:: R_THRESH=7.0E-6_r8
    ! End of 3B repeated code

    !Do not alter R_AUTO and N_AUTO since these values are effectively
    ! hard wired into a numerical approximation in the autoconversion
    ! code. EC_AUTO will be multiplied by CONSTS_AUTO

    ! Threshold radius for autoconversion
    REAL(KIND=r8), PARAMETER :: R_AUTO=20.0E-6_r8

    ! Critical droplet number for autoconversion
    REAL(KIND=r8), PARAMETER :: N_AUTO=1000.0_r8

    ! Collision coalesence efficiency for autoconversion
    !      REAL(KIND=r8), PARAMETER :: EC_AUTO is set in UMUI

    ! The autoconversion powers define the variation of the rate with
    ! liquid water content and droplet concentration. The following are
    ! from Tripoli and Cotton

    !  Dependency of autoconversion rate on droplet concentration
    REAL(KIND=r8), PARAMETER :: POWER_DROPLET_AUTO=-0.33333_r8

    ! Dependency of autoconversion rate on water content
    REAL(KIND=r8), PARAMETER :: POWER_QCL_AUTO=2.33333_r8

    ! Dependency of autoconversion rate on air density
    REAL(KIND=r8), PARAMETER :: power_rho_auto=1.33333_r8

    ! CONSTS_AUTO = (4 pi)/( 18 (4 pi/3)^(4/3)) g /  mu (rho_w)^(1/3)
    ! See UM documentation paper 26, equation P26.132_r8

    ! Combination of physical constants
    REAL(KIND=r8), PARAMETER :: CONSTS_AUTO=5907.24_r8

    ! Quantites for calculation of drop number by aerosols.
    ! Need only set if L_AUTOCONV_MURK=.TRUE.  See file C_VISBTY

    ! Scaling concentration (m-3) in droplet number concentration
    REAL(KIND=r8), PARAMETER :: N0_MURK=500.0E6_r8

    ! Scaling mass (kg/kg) in droplet number calculation from aerosols
    REAL(KIND=r8), PARAMETER :: M0_MURK=1.458E-8_r8

    ! Power in droplet number calculation from aerosols
    REAL(KIND=r8), PARAMETER :: POWER_MURK=0.5_r8

    ! Ice water content threshold for graupel autoconversion (kg/m^3)
    REAL(KIND=r8), PARAMETER :: AUTO_GRAUP_QCF_THRESH = 3.E-4_r8

    ! Temperature threshold for graupel autoconversion (degC)
    REAL(KIND=r8), PARAMETER :: AUTO_GRAUP_T_THRESH = -4.0_r8

    ! Temperature threshold for graupel autoconversion
    REAL(KIND=r8), PARAMETER :: AUTO_GRAUP_COEFF = 0.5_r8

    !-----------------------------------------------------------------
    ! Iterations of microphysics
    !-----------------------------------------------------------------

    ! Number of iterations in microphysics.
    INTEGER,PARAMETER :: LSITER=8
    ! Advise 1 iteration for every 10 minutes or less of timestep.

    !-----------------------------------------------------------------
    ! Nucleation of ice
    !-----------------------------------------------------------------

    ! Note that the assimilation scheme uses temperature thresholds
    ! in its calculation of qsat.

    ! Nucleation mass
    REAL(KIND=r8), PARAMETER :: M0=1.0E-12_r8

    ! Maximum Temp for ice nuclei nucleation (deg C)
    REAL(KIND=r8), PARAMETER :: TNUC=-10.0_r8

    ! Maximum temperature for homogenous nucleation is now in c_micro
    ! so that it is available to code outside of section A04.

    !  1.0/Scaling quantity for ice in crystals
    REAL(KIND=r8), PARAMETER :: QCF0=1.0E4_r8       ! This is an inverse quantity

    ! Minimum allowed QCF after microphysics
    REAL(KIND=r8),PARAMETER:: QCFMIN=1.0E-8_r8

    ! 1/scaling temperature in aggregate fraction calculation
    REAL(KIND=r8), PARAMETER :: T_SCALING=0.0384_r8

    !  Minimum temperature limit in calculation  of N0 for ice (deg C)
    REAL(KIND=r8), PARAMETER :: T_AGG_MIN=-45.0_r8

    !-----------------------------------------------------------------
    ! Hallett Mossop process
    !-----------------------------------------------------------------

    ! Switch off Hallett Mossop in this version but allow
    ! functionality

    ! Min temp for production of Hallett Mossop splinters (deg C)
    REAL(KIND=r8), PARAMETER :: HM_T_MIN=-8.0_r8

    ! Max temp for production of Hallett Mossop splinters (deg C)
    REAL(KIND=r8), PARAMETER :: HM_T_MAX=-273.0_r8
    ! REAL(KIND=r8), PARAMETER :: HM_T_MAX=-3.0

    !  Residence distance for Hallett Mossop splinters (1/deg C)
    REAL(KIND=r8), PARAMETER :: HM_DECAY=1.0_r8/7.0_r8

    ! Reciprocal of scaling liquid water content for HM process
    REAL(KIND=r8), PARAMETER :: HM_RQCL=1.0_r8/0.1E-3_r8

    !-----------------------------------------------------------------
    ! PC2 Cloud Scheme Terms
    !-----------------------------------------------------------------

    ! Specifies the ice content (in terms of a fraction of qsat_liq)
    ! that corresponds to a factor of two reduction in the width of
    ! the vapour distribution in the liquid-free part of the gridbox.
    REAL(KIND=r8), PARAMETER :: ICE_WIDTH=0.04_r8

    ! Parameter that governs the rate of spread of ice cloud fraction
    ! due to windshear
    REAL(KIND=r8), PARAMETER :: WIND_SHEAR_FACTOR = 1.5E-4_r8

    !-----------------------------------------------------------------
    ! Droplet settling
    !-----------------------------------------------------------------
    ! Use the droplet settling code (not available for 3C).
    LOGICAL, PARAMETER :: l_droplet_settle = .FALSE.

    !  External subroutines called -----------------------------------------
    !EXTERNAL LS_PPNC,LSPCON
    !*----------------------------------------------------------------------
    !  Physical constants -------------------------------------------------
    REAL(KIND=r8)    ,PARAMETER :: CFMIN=1.0E-3_r8    ! Used for LS_PPNC  compress.
    !  Define local variables ----------------------------------------------
    INTEGER :: I,K ! Loop counters: I - horizontal field index;
    !                                      K - vertical level index.
    INTEGER :: N              ! "nval" for WHEN routine.
    !
    REAL(KIND=r8)    :: work  ! work variable

    !-----------------------------------------------------------------------
    ERROR=0

    ! Define l_non_hydrostatic and l_mixing_ratio. These would be best
    ! passed from the UMUI, but we will keep them here for the moment.
    !IF (l_mixing_ratio .OR. (h_sect(4)  /=  '03B' .AND. h_sect(4)  /=  '03C') ) THEN
    IF (l_mixing_ratio) THEN
       l_non_hydrostatic = .TRUE.   ! This uses most physically accurate code.
    ELSE
       l_non_hydrostatic = .FALSE.  ! This ensures bit reproducibility
    END IF
    CX       =0.0_r8
    CONSTP   =0.0_r8
    ERROR =0

    ! Define CX and CONSTP values
    ! DEPENDS ON: lspcon
    CALL LSPCON( &
         CX        , & !REAL(KIND=r8), INTENT(OUT  ) :: CX(80)
         CONSTP    , & !REAL, INTENT(OUT  ) :: CONSTP(80)
         x1i       , & !REAL, INTENT(IN   ) ::  x1i  ! Intercept of aggregate size distribution
         x1ic      , & !REAL, INTENT(IN   ) ::  x1ic ! Intercept of crystal size distribution
         x1r       , & !REAL, INTENT(IN   ) ::  x1r  ! Intercept of raindrop size distribution
         x2r       , & !REAL, INTENT(IN   ) ::  x2r  ! Scaling parameter of raindrop size distribution
         x4r         ) !REAL, INTENT(IN   ) ::  x4r  ! Shape parameter of raindrop size distribution
    !-----------------------------------------------------------------------
    !L Internal structure.
    !L 1. Initialise rain and snow to zero.
    !   Initialise scavenged amounts of S Cycle tracers to 0 for full field
    !-----------------------------------------------------------------------
    DO I=1,nCols
       IX      (I)=0
       LSRAIN  (I)=0.0_r8
       LSSNOW  (I)=0.0_r8
       LSSNOW2 (i)=0.0_r8
       LSGRAUP (i)=0.0_r8
       CTTEMP      (I)=0.0_r8
       RAINFRAC    (I)=0.0_r8
       FRAC_ICE_ABOVE(I)=0.0_r8
       VFALL       (I)=0.0_r8
       VFALL2      (i)=0.0_r8
       VFALL_RAIN  (i)=0.0_r8
       VFALL_GRAUP (i)=0.0_r8
       q_total     (i)=0.0_r8
       rho1(i)=0.0_r8
       rho2(i)=0.0_r8
       layer_thickness(i)=0.0_r8
    END DO ! Loop over points,i
    DO k = 1, kMax
       DO i = 1, nCols
          LSRAIN3D   (i,k)=0.0_r8! OUT Rain rate out of each model layer
          LSSNOW3D   (i,k)=0.0_r8! OUT Snow rate out of each model layer
          RAINFRAC3D (i,k)=0.0_r8! OUT rain fraction out of each model layer
          deltaz     (i,k)=0.0_r8
          rhodz_dry  (i,k)=0.0_r8
          rhodz_moist(i,k)=0.0_r8
       END DO ! Loop over points,i
    END DO ! Loop over points,i

    IF (l_non_hydrostatic) THEN
       ! ----------------------------------------------------------------------
       ! Calculate the (non-hydrostatic) layer thicknesses (deltaz) and air
       ! densities multiplied by deltaz (rhodz_moist and rhodz_dry).
       ! ----------------------------------------------------------------------
       ! We should note that this formulation, although better than the
       ! hydrostatic formulation, is still not entirely conservative. To ensure
       ! conservation we would need to rewrite the large-scale precipitation
       ! scheme to consider masses in terms of rho<q>, and
       ! not the current <rho>q formulation.

       ! We only need to calculate averages for the moist levels
       DO k = 1, kMax
          DO i = 1, nCols

             ! Calculate densities at the boundaries of the layer
             ! by removing the r**2 term from rho_r2.
             ! Rho1 is the density at the lower boundary.
             rho1(i)= rho_r2(i,k)/( r_rho_levels(i,k) * r_rho_levels(i,k) )

             ! Check whether there is a rho level above the current
             ! moist level.
             IF (k  <   kMax) THEN
                ! Rho2 is the density at the upper boundary.
                rho2(i)= rho_r2(i,k+1)/( r_rho_levels(i,k+1) * r_rho_levels(i,k+1) )

                ! Calculate the average value of rho across the layer
                ! multiplied by the layer thickness and the layer
                ! thickness.
                rhodz_moist(i,k) = rho2(i) * ( r_theta_levels(i,k) - r_rho_levels(i,k) ) &
                     &                          +  rho1(i) * ( r_rho_levels(i,k+1) - r_theta_levels(i,k) )
                deltaz(i,k) = r_rho_levels(i,k+1) - r_rho_levels(i,k)

                IF (k  ==  1) THEN
                   ! For the lowest layer we need to extend the lower
                   ! boundary from the first rho level to the surface.
                   ! The surface is the 0'th theta level.
                   deltaz     (i,1) = r_rho_levels(i,2) - r_theta_levels(i,0)
                   rhodz_moist(i,1) = rhodz_moist(i,1)*deltaz(i,1) &
                        &                   / (r_rho_levels(i,2)-r_rho_levels(i,1))
                END IF  ! k  ==  1

             ELSE
                ! For a top layer higher than the highest rho level
                ! we can calculate a pseudo rho level. We will assume
                ! it has a similar density to the rho level below
                ! and that the intervening theta level is in the centre
                ! of the layer.
                deltaz     (i,k) = 2.0_r8*(r_theta_levels(i,k) - r_rho_levels(i,k))
                rhodz_moist(i,k) = rho1(i) * deltaz(i,k)
             END IF  ! k  <   kMax

             ! Calculate total moisture
             q_total(i) = q(i,k) + qcl(i,k) + qcf(i,k)

             IF (l_mcr_qcf2) THEN
                q_total(i) = q_total(i) + qcf2(i,k)
             END IF  ! l_mcr_qcf2




             ! Rho_r2 uses the moist density of air. If the mixing
             ! ratio framework is in place then we need to also know
             ! the dry density of air.
             IF (l_mixing_ratio) THEN
                rhodz_dry(i,k) = rhodz_moist(i,k)/ (1.0_r8 + q_total(i))
             ELSE
                rhodz_dry(i,k) = rhodz_moist(i,k)* (1.0_r8 - q_total(i))
             END IF  ! l_mixing_ratio

          END DO  ! i
       END DO  ! k

    END IF  ! L_non_hydrostatic
    !
    !-----------------------------------------------------------------------
    !L 2. Loop round levels from top down (counting bottom level as level 1,
    !L    as is standard in the Unified model).
    !-----------------------------------------------------------------------
    !
    DO K=kMax,1,-1


       !-----------------------------------------------------------------------
       !L 2.5 Form INDEX IX to gather/scatter variables in LS_PPNC
       !-----------------------------------------------------------------------
       !
       !  Set index where cloud fraction > CFMIN or where non-zero pptn
       !  Note: whenimd is functionally equivalent to WHENILE (but autotasks).
       !
       !
       N=0
       DO i = 1,nCols
          layer_thickness(i) = p_layer_boundaries(i,k) - p_layer_boundaries(i,k-1)

          ! Set up IF statement to determine whether to call the
          ! microphysics code for this grid box (i.e. if there is
          ! already condensate in the grid box or there is
          ! precipitation about to fall into the grid box)
          work = QCF(i,k)
          ! Include extra microphysics variables if in use
          IF (L_mcr_qcf2 )  work = work + QCF2(i,k) + LSSNOW2(i)
          IF (CFL(i,k) > CFMIN  .OR. (LSRAIN(i)+LSSNOW(i)) > 0.0_r8 .OR. work > 0.0_r8) THEN
             ! include this grid box.
             ! Strictly speaking the CFL > CFMIN clause is too
             ! restrictive since ice nucleation does not require
             ! liquid water, but the code would be very messy.
             N = N + 1
             IX(N) = i
          END IF
       END DO ! Loop over points,i
       !
       IF(N >  0)THEN

          IF (L_SEASALT_CCN) THEN
             sea_salt_ptr=K
             salt_dim_ice=N
          ELSE
             sea_salt_ptr=1
             salt_dim_ice=1
          ENDIF

          IF (L_use_biogenic) THEN
             biogenic_ptr=K
             biog_dim_ice=N
          ELSE
             biogenic_ptr=1
             biog_dim_ice=1
          ENDIF

          ! DEPENDS ON: ls_ppnc
          CALL LS_PPNC( &
               IX                             , & !INTEGER ,INTENT(IN   ) :: IX(nCols*rows,2)! IN gather/scatter index
               N                              , & !INTEGER ,INTENT(IN   ) :: N               ! IN Number of points where pptn non-zero from above or where CF>CFMIN
               TIMESTEP                       , & !REAL    ,INTENT(IN   ) :: TIMESTEP        ! IN Timestep (sec).
               LSRAIN                         , & !REAL    ,INTENT(INOUT) :: LSRAIN(nCols,rows)             ! INOUT Surface rainfall rate (kg m^-2 s^-1).
               LSSNOW                         , & !REAL    ,INTENT(INOUT) :: LSSNOW(nCols,rows)             ! INOUT Surface snowfall rate (kg m^-2 s^-1).
               LSSNOW2                        , & !REAL    ,INTENT(INOUT) :: LSSNOW2(nCols,rows)       ! INOUT layer snowfall rate (kg m^-2 s^-1).
               LSGRAUP                        , & !REAL    ,INTENT(INOUT) :: LSGRAUP(nCols,rows)       ! INOUT layer graupelfall rate (kg m^-2 s^-1)
               CF    (1,K)                    , & !REAL    ,INTENT(INOUT) :: CF (nCols,rows) ! IN Cloud fraction.
               CFL   (1,K)                    , & !REAL    ,INTENT(INOUT) :: CFL(nCols,rows) ! IN Cloud liquid fraction.
               CFF   (1,K)                    , & !REAL    ,INTENT(INOUT) :: CFF(nCols,rows) ! IN Cloud ice fraction.
               QCF   (1,K)                    , & !REAL    ,INTENT(INOUT) :: QCF(nCols,rows) ! INOUT Cloud ice (kg per kg air).
               QCL   (1,K)                    , & !REAL    ,INTENT(INOUT) :: QCL(nCols,rows)            ! INOUT Cloud liquid water (kg per kg air).
               T     (1,K)                    , & !REAL    ,INTENT(INOUT) :: T(nCols,rows)             ! INOUT Temperature (K).
               QCF2  (1,K)                    , & !REAL    ,INTENT(INOUT) :: QCF2(nCols,rows)            ! INOUT Cloud ice2 (kg per kg air).
               L_mcr_qcf2                     , & !LOGICAL ,INTENT(IN   ) :: L_mcr_qcf2                         ! IN Use second prognostic ice if T
               L_it_melting                   , & !LOGICAL ,INTENT(IN   ) :: L_it_melting                   ! IN Use iterative melting
               l_non_hydrostatic              , & !LOGICAL ,INTENT(IN   ) :: L_non_hydrostatic                 ! IN Use non-hydrostatic calculation of model layer depths
               l_mixing_ratio                 , & !LOGICAL ,INTENT(IN   ) :: L_mixing_ratio                 ! IN q is a mixing ratio
               SO4_AIT(1,K)                   , & !REAL    ,INTENT(INOUT) :: SO4_AIT     (nCols, rows) !INOUT S Cycle tracers & scavngd amoun
               SO4_ACC(1,K)                   , & !REAL    ,INTENT(INOUT) :: SO4_ACC     (nCols, rows) !INOUT S Cycle tracers & scavngd amoun
               SO4_DIS(1,K)                   , & !REAL    ,INTENT(INOUT) :: SO4_DIS     (nCols, rows) !INOUT S Cycle tracers & scavngd amoun
               BMASS_AGD(1,K)                 , & !REAL    ,INTENT(INOUT) :: BMASS_AGD   (nCols, rows) !INOUT S Cycle tracers & scavngd amoun
               BMASS_CLD(1,K)                 , & !REAL    ,INTENT(INOUT) :: BMASS_CLD   (nCols, rows) !INOUT S Cycle tracers & scavngd amoun
               L_BIOMASS_CCN                  , & !LOGICAL ,INTENT(IN   ) :: L_BIOMASS_CCN                  ! IN Biomass smoke aerosols used for
               OCFF_AGD(1,K)                  , & !REAL    ,INTENT(INOUT) :: OCFF_AGD    (nCols, rows) !INOUT S Cycle tracers & scavngd amoun
               OCFF_CLD(1,K)                  , & !REAL    ,INTENT(INOUT) :: OCFF_CLD    (nCols, rows) !INOUT S Cycle tracers & scavngd amoun
               L_OCFF_CCN                     , & !LOGICAL ,INTENT(IN   ) :: L_OCFF_CCN                         ! IN Fossil-fuel organic carbon
               AEROSOL(1,K)                   , & !REAL    ,INTENT(INOUT) :: AEROSOL(nCols,rows)            ! INOUT Aerosol (K).
               L_MURK                         , & !LOGICAL ,INTENT(IN   ) :: L_MURK                         ! IN Aerosol needs scavenging.
               l_pc2                          , & !LOGICAL ,INTENT(IN   ) :: L_pc2                          ! IN Use PC2 cloud and condensation
               SNOW_DEPTH                     , & !REAL    ,INTENT(IN   ) :: SNOW_DEPTH(nCols, rows)
               LAND_FRACT                     , & !REAL    ,INTENT(IN   ) :: LAND_FRACT(nCols, rows)
               L_USE_SULPHATE_AUTOCONV        , & !LOGICAL ,INTENT(IN   ) :: L_USE_SULPHATE_AUTOCONV         ! IN Sulphate aerosols used in
               L_AUTO_DEBIAS                  , & !LOGICAL ,INTENT(IN   ) :: L_AUTO_DEBIAS                  ! IN Use autoconversion de-biasing
               SEA_SALT_FILM(1,sea_salt_ptr), & !REAL    ,INTENT(IN   ) :: SEA_SALT_FILM(nCols, salt_dim2)
               SEA_SALT_JET (1,sea_salt_ptr), & ! REAL   ,INTENT(IN   ) :: SEA_SALT_JET(nCols, salt_dim2)
               L_SEASALT_CCN                  , & !LOGICAL ,INTENT(IN   ) :: L_SEASALT_CCN                  ! IN Sea-salt aerosols used for second indirect effect if T
               salt_dim_ice                   , & !INTEGER ,INTENT(IN   ) :: salt_dim_ice  ! Dimension to use for call to LSP_ICE.
               L_use_biogenic                 , & !LOGICAL ,INTENT(IN   ) :: L_biogenic_CCN                 ! IN Biogenic aerosol used for second indirect effect if T
               biogenic(1, biogenic_ptr)      , & !REAL    ,INTENT(IN   ) :: biogenic(nCols, rows)
               biog_dim_ice                   , & !INTEGER ,INTENT(IN   ) :: biog_dim_ice  !     "     "        "   "        "   "          "   .
               Q(1,K)                         , & !REAL    ,INTENT(INOUT) :: Q(nCols,rows)             ! INOUT Specific humidity (kg water/kg air).
               p_theta_levels(1,K)            , & !REAL    ,INTENT(IN   ) :: p_theta_levels(nCols,rows)
               layer_thickness                , & !REAL    ,INTENT(IN   ) :: layer_thickness(nCols,rows)! IN thickness of layer (Pa)
               deltaz(1,k)                    , & !REAL    ,INTENT(IN   ) :: deltaz(nCols,rows)            ! IN thickness of layer (m)
               rhodz_dry(1,k)                 , & !REAL    ,INTENT(IN   ) :: rhodz_dry(nCols,rows)     ! Dry air density layer thickness (kg m-2)
               rhodz_moist(1,k)               , & !REAL    ,INTENT(IN   ) :: rhodz_moist(nCols,rows)   ! Moist air density layer thickness (kg m-2)
               nCols                          , & !INTEGER ,INTENT(IN   ) :: nCols    ! IN gather/scatter index
               RHCRIT(1,K)                    , & !REAL    ,INTENT(IN   ) :: RHCRIT(nCols,rhc_rows)! IN Critical humidity for cloud formation.
               VFALL                          , & !REAL    ,INTENT(INOUT) :: VFALL(nCols,rows)            ! INOUT fall velocity of ice (m per
               VFALL2                         , & !REAL    ,INTENT(INOUT) :: VFALL2(nCols,rows)            ! INOUT fall vel. of rain (m/s)
               VFALL_RAIN                     , & !REAL    ,INTENT(INOUT) :: VFALL_RAIN(nCols,rows)    ! INOUT fall vel. of rain (m/s)
               VFALL_GRAUP                    , & !REAL    ,INTENT(INOUT) :: VFALL_GRAUP(nCols,rows)   ! INOUT fall vel. of graupel (m/s)
               FRAC_ICE_ABOVE                 , & !REAL    ,INTENT(INOUT) :: FRAC_ICE_ABOVE(nCols,rows)! INOUT Ice fraction from layer above water.
               CTTEMP                         , & !REAL    ,INTENT(INOUT) :: CTTEMP(nCols,rows)            ! INOUT Ice cloud top temperature (K)
               RAINFRAC                       , & !REAL    ,INTENT(INOUT) :: RAINFRAC(nCols,rows)      ! INOUT Rain fraction.
               CX                             , & !REAL    ,INTENT(IN   ) ::  CX(80)
               CONSTP                         , & !REAL    ,INTENT(IN   ) ::  CONSTP(80)
               L_autoconv_murk                , & !LOGICAL ,INTENT(IN   ) :: L_autoconv_murk                 ! Use murk aerosol to calc. drop number
               ec_auto                        , & !REAL    ,INTENT(IN   ) :: ec_auto                         ! Collision coalescence efficiency
               Ntot_land                      , & !REAL    ,INTENT(IN   ) :: Ntot_land                         ! Number of droplets over land / m-3
               Ntot_sea                         & !REAL    ,INTENT(IN   ) :: Ntot_sea                         ! Number of droplets over sea / m-3
               )
       ENDIF
       !
       ! Copy rainfall and snowfall rates to 3D fields for diagnostic output
       !
       IF (nCols  ==  nCols .AND. kMax  ==  kMax) THEN
          ! Only copy rain and snow to 3D fields if arrays are dimensionalized.
          DO i=1,nCols
             LSRAIN3D  (I,K) = LSRAIN(I) 
             LSSNOW3D  (I,K) = LSSNOW(I) + LSSNOW2(I) + LSGRAUP(I)
             RAINFRAC3D(I,K) = RAINFRAC(I)
          END DO
       ENDIF
       !
    END DO ! Loop over K

    ! Add together ice crystals, snow aggregates and graupel
    ! for surface snow rate (kg/m2/s)

    IF (L_mcr_qcf2) THEN
       DO i = 1,nCols
          LSSNOW(i) = LSSNOW(i) + LSSNOW2(i) + LSGRAUP(i)
       END DO
    END IF

    IF (L_droplet_settle) THEN
       ! Add droplet settling to the large-scale precip rate in order
       ! to be able to have a full water budget with the precipitation
       ! diagnostics.
       DO i = 1,nCols
          LSRAIN(i) = LSRAIN(i) 
       END DO
    END IF

!20  CONTINUE                  ! Branch for error exit
    RETURN
  END SUBROUTINE LS_PPN
  !*LL  SUBROUTINE LS_PPNC------------------------------------------------
  !*L  Arguments:---------------------------------------------------------



  ! *****************************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*******************************
  !
  !*LL  SUBROUTINES LS_PPN and LS_PPNC------------------------------------
  !LL  Purpose:
  !LL          LS_PPN and LS_PPNC:
  !LL           Calculate large-scale (dynamical) precipitation.
  !LL           LS_PPNC is the gather/scatter routine which then
  !LL           calls LSP_ICE.
  !LL  Note: in all cases, level counters (incl subscripts) run from 1
  !LL        (lowest model layer) to kMax (topmost "wet" model
  !LL        layer) - it is assumed that the bottom kMax layers are
  !LL        the "wet" layers.
  !LL
  !LL  Put through fpp on Cray.  Activate *IF definition CRAY if running
  !LL  on the Cray.
  !LL
  !LL  Modification History from Version 4.4
  !LL     Version    Date
  !LL       4.5      March 98          New Deck        Damian Wilson
  !
  !         5.1      16-12-99   Change to allow 3D RHcrit diagnostic
  !                             in place of 1D parameter. AC Bushell
  !         5.2      25/10/00   Reintroduction of tracers. P.Selwood
  !         5.2      21-11-00   Allow interfacting with 3C scheme.
  !                             Return diagnostics. Damian Wilson
  !LL
  !         5.2      28-11-00   Pass down sea-salt arrays.
  !                                                       A. Jones
  !         5.3      29-08-01   Introduce logical to control effect of
  !                             sulphate aerosol on autoconversion.
  !                                                       A. Jones
  !         5.3      24-09-01   Tidy up code (mostly redundant) relating
  !                             to the sulphur cycle.     A. Jones
  !         5.4      30-08-02   Remove lscav_agedsoot, which is now
  !                             calculated in microphys_ctl.  P. Davison
  !         5.4      27-07-02   Change cloud fractions to prognostics
  !                             for PC2                   D. Wilson
  !
  !         5.4      25-04-02   Pass land fraction down to LSP_ICE.
  !                                                       A. Jones
  !         5.5      03-02-03   Pass extra microphysics variables
  !                             down to LSP_ICE.           R.M.Forbes
  !         5.5      03-02-03   Include extra microphysics variables
  !                             (qcf2,qrain,qgraup)          R.M.Forbes
  !         6.1      01-08-04   Include variables for prognostic rain
  !                             and graupel.             R.M.Forbes
  !         6.1      07-04-04   Add biomass smoke to call to LSP_ICE.
  !                                                          A. Jones
  !         6.1      07-04-04   Pass switch for autoconversion de-biasing
  !                             down to LSP_ICE.              A. Jones
  !         6.2      22-08-05   Remove commented out code. P.Selwood.
  !         6.2      23-11-05   Pass through precip variables from
  !                             UMUI. Damian Wilson
  !         6.2      11-01-06   Include non-hydrostatic calculation
  !                             of air density and model thickness.
  !                                                       D. Wilson
  !         6.2      31-01-06   Pass process rate diags through. R.Forbes
  !LL  Programming standard: Unified Model Documentation Paper No 3
  !LL
  !LL  Documentation: UM Documentation Paper 26.
  !LL
  !*L  Arguments:---------------------------------------------------------
  !*LL  SUBROUTINE LS_PPNC------------------------------------------------
  !*L  Arguments:---------------------------------------------------------
  SUBROUTINE LS_PPNC(                                               &
       IX                      , &!INTEGER ,INTENT(IN   ) :: IX(nCols*rows,2)! IN gather/scatter index
       N                       , &!INTEGER ,INTENT(IN   ) :: N               ! IN Number of points where pptn non-zero from above or where CF>CFMIN
       TIMESTEP                , &!REAL    ,INTENT(IN   ) :: TIMESTEP        ! IN Timestep (sec).
       LSRAIN                  , &!REAL    , INTENT(INOUT) :: LSRAIN(nCols,rows)        ! INOUT Surface rainfall rate (kg m^-2 s^-1).
       LSSNOW                  , &!REAL    , INTENT(INOUT) :: LSSNOW(nCols,rows)        ! INOUT Surface snowfall rate (kg m^-2 s^-1).
       LSSNOW2                 , &!REAL    , INTENT(INOUT) :: LSSNOW2(nCols,rows)       ! INOUT layer snowfall rate (kg m^-2 s^-1).
       LSGRAUP                 , &!REAL    , INTENT(INOUT) :: LSGRAUP(nCols,rows)       ! INOUT layer graupelfall rate (kg m^-2 s^-1)
       CF                      , &!REAL    ,INTENT(INOUT) :: CF (nCols,rows) ! IN Cloud fraction.
       CFL                     , &!REAL    ,INTENT(INOUT) :: CFL(nCols,rows) ! IN Cloud liquid fraction.
       CFF                     , &!REAL    ,INTENT(INOUT) :: CFF(nCols,rows) ! IN Cloud ice fraction.
       QCF                     , &!REAL   , INTENT(INOUT) :: QCF(nCols,rows) ! INOUT Cloud ice (kg per kg air).
       QCL                     , &!REAL   , INTENT(INOUT) :: QCL(nCols,rows)           ! INOUT Cloud liquid water (kg per kg air).
       T                       , &!REAL   , INTENT(INOUT) :: T(nCols,rows)             ! INOUT Temperature (K).
       QCF2                    , &!REAL   , INTENT(INOUT) :: QCF2(nCols,rows)          ! INOUT Cloud ice2 (kg per kg air).
       L_mcr_qcf2              , &!LOGICAL , INTENT(IN  ) :: L_mcr_qcf2                     ! IN Use second prognostic ice if T
       L_it_melting            , &!LOGICAL , INTENT(IN  ) :: L_it_melting                   ! IN Use iterative melting
       l_non_hydrostatic       , &!LOGICAL , INTENT(IN  ) :: L_non_hydrostatic              ! IN Use non-hydrostatic calculation of model layer depths
       l_mixing_ratio          , &!LOGICAL , INTENT(IN  ) :: L_mixing_ratio                 ! IN q is a mixing ratio
       SO4_AIT                 , &!REAL   , INTENT(INOUT) :: SO4_AIT     (nCols, rows) !INOUT S Cycle tracers & scavngd amoun
       SO4_ACC                 , &!REAL   , INTENT(INOUT) :: SO4_ACC     (nCols, rows) !INOUT S Cycle tracers & scavngd amoun
       SO4_DIS                 , &!REAL   , INTENT(INOUT) :: SO4_DIS     (nCols, rows) !INOUT S Cycle tracers & scavngd amoun
       BMASS_AGD               , &!REAL   , INTENT(INOUT) :: BMASS_AGD   (nCols, rows) !INOUT S Cycle tracers & scavngd amoun
       BMASS_CLD               , &!REAL   , INTENT(INOUT) :: BMASS_CLD   (nCols, rows) !INOUT S Cycle tracers & scavngd amoun
       L_BIOMASS_CCN           , &!LOGICAL , INTENT(IN  ) :: L_BIOMASS_CCN                  ! IN Biomass smoke aerosols used for
       OCFF_AGD                , &!REAL   , INTENT(INOUT) :: OCFF_AGD    (nCols, rows) !INOUT S Cycle tracers & scavngd amoun
       OCFF_CLD                , &!REAL   , INTENT(INOUT) :: OCFF_CLD    (nCols, rows) !INOUT S Cycle tracers & scavngd amoun
       L_OCFF_CCN              , &!LOGICAL , INTENT(IN  ) :: L_OCFF_CCN                     ! IN Fossil-fuel organic carbon
       AEROSOL                 , &!REAL   , INTENT(INOUT) :: AEROSOL(nCols,rows)       ! INOUT Aerosol (K).
       L_MURK                  , &!LOGICAL , INTENT(IN  ) :: L_MURK                         ! IN Aerosol needs scavenging.
       l_pc2                   , &!LOGICAL , INTENT(IN  ) :: L_pc2                          ! IN Use PC2 cloud and condensation
       SNOW_DEPTH              , &!REAL    ,INTENT(IN   ) :: SNOW_DEPTH(nCols, rows)
       LAND_FRACT              , &!REAL    ,INTENT(IN   ) :: LAND_FRACT(nCols, rows)
       L_USE_SULPHATE_AUTOCONV , &!LOGICAL , INTENT(IN  ) :: L_USE_SULPHATE_AUTOCONV        ! IN Sulphate aerosols used in
       L_AUTO_DEBIAS           , &!LOGICAL , INTENT(IN  ) :: L_AUTO_DEBIAS                  ! IN Use autoconversion de-biasing
       SEA_SALT_FILM           , &!REAL    ,INTENT(IN   ) :: SEA_SALT_FILM(nCols, salt_dim2)
       SEA_SALT_JET            , &!REAL    ,INTENT(IN   ) :: SEA_SALT_JET(nCols, salt_dim2)
       L_SEASALT_CCN           , &!LOGICAL , INTENT(IN  ) :: L_SEASALT_CCN                  ! IN Sea-salt aerosols used for second indirect effect if T
       salt_dim_ice            , &!INTEGER ,INTENT(IN   ) :: salt_dim_ice  ! Dimension to use for call to LSP_ICE.
       L_biogenic_CCN          , &!LOGICAL , INTENT(IN  ) :: L_biogenic_CCN                 ! IN Biogenic aerosol used for second indirect effect if T
       biogenic                , &!REAL    ,INTENT(IN   ) :: biogenic(nCols, rows)
       biog_dim_ice            , &!INTEGER ,INTENT(IN   ) :: biog_dim_ice  !     "     "   "   "   "   "     "   .
       Q                       , &!REAL   , INTENT(INOUT) :: Q(nCols,rows)             ! INOUT Specific humidity (kg water/kg air).
       p_theta_levels          , &!REAL    ,INTENT(IN   ) :: p_theta_levels(nCols,rows)
       layer_thickness         , &!REAL    ,INTENT(IN   ) :: layer_thickness(nCols,rows)! IN thickness of layer (Pa)
       deltaz                  , &!REAL    ,INTENT(IN   ) :: deltaz(nCols,rows)        ! IN thickness of layer (m)
       rhodz_dry               , &!REAL    ,INTENT(IN   ) :: rhodz_dry(nCols,rows)     ! Dry air density layer thickness (kg m-2)
       rhodz_moist             , &!REAL    ,INTENT(IN   ) :: rhodz_moist(nCols,rows)   ! Moist air density layer thickness (kg m-2)
       nCols                   , &!INTEGER ,INTENT(IN   ) :: nCols    ! IN gather/scatter index
       RHCRIT                  , &!REAL    ,INTENT(IN   ) :: RHCRIT(nCols,rhc_rows)! IN Critical humidity for cloud formation.
       VFALL                   , &!REAL   , INTENT(INOUT) :: VFALL(nCols,rows)         ! INOUT fall velocity of ice (m per
       VFALL2                  , &!REAL   , INTENT(INOUT) :: VFALL2(nCols,rows)        ! INOUT fall vel. of rain (m/s)
       VFALL_RAIN              , &!REAL   , INTENT(INOUT) :: VFALL_RAIN(nCols,rows)    ! INOUT fall vel. of rain (m/s)
       VFALL_GRAUP             , &!REAL   , INTENT(INOUT) :: VFALL_GRAUP(nCols,rows)   ! INOUT fall vel. of graupel (m/s)
       FRAC_ICE_ABOVE          , &!REAL   , INTENT(INOUT) :: FRAC_ICE_ABOVE(nCols,rows)! INOUT Ice fraction from layer above water.
       CTTEMP                  , &!REAL   , INTENT(INOUT) :: CTTEMP(nCols,rows)        ! INOUT Ice cloud top temperature (K)
       RAINFRAC                , &!REAL   , INTENT(INOUT) :: RAINFRAC(nCols,rows)      ! INOUT Rain fraction.
       CX                      , &!REAL    ,INTENT(IN   ) ::  CX(80)
       CONSTP                  , &!REAL    ,INTENT(IN   ) ::  CONSTP(80)
       L_autoconv_murk         , &!LOGICAL ,INTENT(IN   ) :: L_autoconv_murk                ! Use murk aerosol to calc. drop number
       ec_auto                 , &!REAL    ,INTENT(IN   ) :: ec_auto                        ! Collision coalescence efficiency
       Ntot_land               , &!REAL    ,INTENT(IN   ) :: Ntot_land                      ! Number of droplets over land / m-3
       Ntot_sea                  &!REAL    ,INTENT(IN   ) :: Ntot_sea                       ! Number of droplets over sea / m-3
       )

    IMPLICIT NONE

    INTEGER ,INTENT(IN   ) :: N             ! IN Number of points where pptn non-zero from above or where CF>CFMIN
    INTEGER ,INTENT(IN   ) :: nCols    ! IN gather/scatter index
    INTEGER ,INTENT(IN   ) :: IX(nCols)! IN gather/scatter index
    INTEGER ,INTENT(IN   ) :: salt_dim_ice  ! Dimension to use for call to LSP_ICE.
    INTEGER ,INTENT(IN   ) :: biog_dim_ice  !     "     "   "   "   "   "     "   .
    ! 
    ! CF, CFL and CFF are IN/OUT if the PC2 cloud scheme is in use.
    !
    REAL(KIND=r8)    ,INTENT(INOUT) :: CF (nCols) ! IN Cloud fraction.
    REAL(KIND=r8)    ,INTENT(INOUT) :: CFL(nCols) ! IN Cloud liquid fraction.
    REAL(KIND=r8)    ,INTENT(INOUT) :: CFF(nCols) ! IN Cloud ice fraction.
    REAL(KIND=r8)    ,INTENT(IN   ) :: p_theta_levels(nCols)
    REAL(KIND=r8)    ,INTENT(IN   ) :: layer_thickness(nCols)! IN thickness of layer (Pa)
    REAL(KIND=r8)    ,INTENT(IN   ) :: deltaz(nCols)        ! IN thickness of layer (m)
    REAL(KIND=r8)    ,INTENT(IN   ) :: rhodz_dry(nCols)     ! Dry air density layer thickness (kg m-2)
    REAL(KIND=r8)    ,INTENT(IN   ) :: rhodz_moist(nCols)   ! Moist air density layer thickness (kg m-2)

    REAL(KIND=r8)    ,INTENT(IN   ) :: RHCRIT(nCols)! IN Critical humidity for cloud formation.
    REAL(KIND=r8)    ,INTENT(IN   ) :: TIMESTEP                       ! IN Timestep (sec).
    ! for conversion to ppn (kg water per m**3).

    LOGICAL , INTENT(IN  ) :: L_MURK                         ! IN Aerosol needs scavenging.
    LOGICAL , INTENT(IN  ) :: L_USE_SULPHATE_AUTOCONV        ! IN Sulphate aerosols used in
    ! autoconversion if T (i.e.
    ! second indirect effect)
    LOGICAL , INTENT(IN  ) :: L_SEASALT_CCN                  ! IN Sea-salt aerosols used for second indirect effect if T
    LOGICAL , INTENT(IN  ) :: L_BIOMASS_CCN                  ! IN Biomass smoke aerosols used for
    !                                                              ! second indirect effect if T
    LOGICAL , INTENT(IN  ) :: L_OCFF_CCN                     ! IN Fossil-fuel organic carbon
    ! aerosol used for second indirect effect if T
    LOGICAL , INTENT(IN  ) :: L_biogenic_CCN                 ! IN Biogenic aerosol used for second indirect effect if T
    LOGICAL , INTENT(IN  ) :: L_AUTO_DEBIAS                  ! IN Use autoconversion de-biasing
    LOGICAL , INTENT(IN  ) :: L_pc2                          ! IN Use PC2 cloud and condensation
    LOGICAL , INTENT(IN  ) :: L_mcr_qcf2                     ! IN Use second prognostic ice if T
    LOGICAL , INTENT(IN  ) :: L_it_melting                   ! IN Use iterative melting
    LOGICAL , INTENT(IN  ) :: L_non_hydrostatic              ! IN Use non-hydrostatic calculation of model layer depths
    LOGICAL , INTENT(IN  ) :: L_mixing_ratio                 ! IN q is a mixing ratio
    ! removed by deposition depending on amount of ice in each category
    !

    REAL(KIND=r8)   , INTENT(INOUT) :: Q(nCols)             ! INOUT Specific humidity (kg water/kg air).
    REAL(KIND=r8)   , INTENT(INOUT) :: QCF(nCols)           ! INOUT Cloud ice (kg per kg air).
    REAL(KIND=r8)   , INTENT(INOUT) :: QCL(nCols)           ! INOUT Cloud liquid water (kg per kg air).
    REAL(KIND=r8)   , INTENT(INOUT) :: QCF2(nCols)          ! INOUT Cloud ice2 (kg per kg air).
    REAL(KIND=r8)   , INTENT(INOUT) :: T(nCols)             ! INOUT Temperature (K).
    REAL(KIND=r8)   , INTENT(INOUT) :: AEROSOL(nCols)       ! INOUT Aerosol (K).
    REAL(KIND=r8)   , INTENT(INOUT) :: LSRAIN(nCols)        ! INOUT Surface rainfall rate (kg m^-2 s^-1).
    REAL(KIND=r8)   , INTENT(INOUT) :: LSSNOW(nCols)        ! INOUT Surface snowfall rate (kg m^-2 s^-1).
    REAL(KIND=r8)   , INTENT(INOUT) :: LSSNOW2(nCols)       ! INOUT layer snowfall rate (kg m^-2 s^-1).
    REAL(KIND=r8)   , INTENT(INOUT) :: LSGRAUP(nCols)       ! INOUT layer graupelfall rate (kg m^-2 s^-1)
    REAL(KIND=r8)   , INTENT(INOUT) :: CTTEMP(nCols)        ! INOUT Ice cloud top temperature (K)
    REAL(KIND=r8)   , INTENT(INOUT) :: RAINFRAC(nCols)      ! INOUT Rain fraction.
    REAL(KIND=r8)   , INTENT(INOUT) :: FRAC_ICE_ABOVE(nCols)! INOUT Ice fraction from layer above water.
    REAL(KIND=r8)   , INTENT(INOUT) :: VFALL(nCols)         ! INOUT fall velocity of ice (m per
    REAL(KIND=r8)   , INTENT(INOUT) :: VFALL2(nCols)        ! INOUT fall vel. of rain (m/s)
    REAL(KIND=r8)   , INTENT(INOUT) :: VFALL_RAIN(nCols)    ! INOUT fall vel. of rain (m/s)
    REAL(KIND=r8)   , INTENT(INOUT) :: VFALL_GRAUP(nCols)   ! INOUT fall vel. of graupel (m/s)

    REAL(KIND=r8)   , INTENT(INOUT) :: SO4_AIT     (nCols) !INOUT S Cycle tracers & scavngd amoun
    REAL(KIND=r8)   , INTENT(INOUT) :: SO4_ACC     (nCols) !INOUT S Cycle tracers & scavngd amoun
    REAL(KIND=r8)   , INTENT(INOUT) :: SO4_DIS     (nCols) !INOUT S Cycle tracers & scavngd amoun
    REAL(KIND=r8)   , INTENT(INOUT) :: BMASS_AGD   (nCols) !INOUT S Cycle tracers & scavngd amoun
    REAL(KIND=r8)   , INTENT(INOUT) :: BMASS_CLD   (nCols) !INOUT S Cycle tracers & scavngd amoun
    REAL(KIND=r8)   , INTENT(INOUT) :: OCFF_AGD    (nCols) !INOUT S Cycle tracers & scavngd amoun
    REAL(KIND=r8)   , INTENT(INOUT) :: OCFF_CLD    (nCols) !INOUT S Cycle tracers & scavngd amoun


    !
    REAL(KIND=r8)    ,INTENT(IN   ) :: SNOW_DEPTH(nCols)
    REAL(KIND=r8)    ,INTENT(IN   ) :: LAND_FRACT(nCols)
    ! Sets up the size of arrays for CX and CONSTP
    REAL(KIND=r8)    ,INTENT(IN   ) ::  CX(80)
    REAL(KIND=r8)    ,INTENT(IN   ) ::  CONSTP(80)

    !
    REAL(KIND=r8)    ,INTENT(IN   ) :: SEA_SALT_FILM(nCols)
    REAL(KIND=r8)    ,INTENT(IN   ) :: SEA_SALT_JET (nCols)
    !
    REAL(KIND=r8)    ,INTENT(IN   ) :: biogenic(nCols)
    !
    LOGICAL ,INTENT(IN   ) :: L_autoconv_murk                ! Use murk aerosol to calc. drop number

    REAL(KIND=r8)    ,INTENT(IN   ) :: ec_auto                        ! Collision coalescence efficiency
    REAL(KIND=r8)    ,INTENT(IN   ) :: Ntot_land                      ! Number of droplets over land / m-3
    REAL(KIND=r8)    ,INTENT(IN   ) :: Ntot_sea                       ! Number of droplets over sea / m-3

    ! Microphysical process rate diagnostics (2D arrays on one level)
    ! Note: These arrays will only increase memory usage and are
    !       only referenced if the particular diagnostic is active



    !*L  Workspace usage ---------------------------------------------------
    !
    !ajm      REAL(KIND=r8)    ::      & PSTAR_C(N)         ! gathered Surface pressure (Pa).
    REAL(KIND=r8)    :: CF_C(N)                       ! gathered Cloud fraction.
    REAL(KIND=r8)    :: Q_C(N)                        ! gathered Specific humidity (kg water/kg air).
    REAL(KIND=r8)    :: QCF_C(N)                      ! gathered Cloud ice (kg per kg air).
    REAL(KIND=r8)    :: QCL_C(N)                      ! gathered Cloud liquid water (kg per kg air).
    REAL(KIND=r8)    :: QCF2_C(N)                     ! gathered cloud ice2 (kg per kg air).
    REAL(KIND=r8)    :: T_C(N)                        ! gathered Temperature (K).
    REAL(KIND=r8)    :: AERO_C(N)                     ! gathered Aerosol.
    REAL(KIND=r8)    :: LSRAIN_C(N)                   ! gathered Surface rainfall rate (kg per sq m per s).
    REAL(KIND=r8)    :: LSSNOW_C(N)                   ! gathered Surface snowfall rate (kg per sq m per s).
    REAL(KIND=r8)    :: LSSNOW2_C(N)                  ! gathered layer snowfall rate (kg per sq m per s).
    REAL(KIND=r8)    :: LSGRAUP_C(N)                  ! gathered layer graupel fall rate (kg/sq m/s)
    REAL(KIND=r8)    :: CTTEMP_C(N)                   ! gathered ice cloud top temperature.
    REAL(KIND=r8)    :: RAINFRAC_C(N)                 ! gathered rain fraction.
    REAL(KIND=r8)    :: FRAC_ICE_ABOVE_C(N)           ! gathered fraction of ice in layer above
    REAL(KIND=r8)    :: CFL_C(N)                      ! gathered Cloud liquid fraction.
    REAL(KIND=r8)    :: CFF_C(N)                      ! gathered Cloud ice fraction.
    REAL(KIND=r8)    :: VFALL_C(N)                    ! gathered fall velocity (m per s).
    REAL(KIND=r8)    :: VFALL2_C(N)                   ! gathered fall velocity for qcf2 (m per s).
    REAL(KIND=r8)    :: VFALL_RAIN_C(N)               ! gathered fall velocity for qcf2 (m per s).
    REAL(KIND=r8)    :: VFALL_GRAUP_C(N)              ! gathered fall velocity for qcf2 (m per s).
    REAL(KIND=r8)    :: SEA_SALT_FILM_C(salt_dim_ice) ! gathered film-mode sea-salt (m-3)
    REAL(KIND=r8)    :: SEA_SALT_JET_C (salt_dim_ice) ! gathered jet-mode sea-salt (m-3)
    REAL(KIND=r8)    :: biogenic_C(biog_dim_ice)      ! gathered biogenic aerosol (m.m.r.)
    REAL(KIND=r8)    :: RHC_C(N)                      ! gathered RH_crit value at points.

    REAL(KIND=r8)    :: SO4_AIT_C(N)                  ! gathered sulphate aerosol arrays
    REAL(KIND=r8)    :: SO4_ACC_C(N)                  ! gathered sulphate aerosol arrays
    REAL(KIND=r8)    :: SO4_DIS_C(N)                  ! gathered sulphate aerosol arrays
    !
    REAL(KIND=r8)    :: BMASS_AGD_C(N)                ! gathered biomass aerosol arrays
    REAL(KIND=r8)    :: BMASS_CLD_C(N)                ! gathered biomass aerosol arrays
    !
    REAL(KIND=r8)    :: OCFF_AGD_C(N)                 ! gathered fossil-fuel org carb aerosol arrays
    REAL(KIND=r8)    :: OCFF_CLD_C(N)                 ! gathered fossil-fuel org carb aerosol arrays

    !
    REAL(KIND=r8)    :: SNOW_DEPTH_C(N)
    REAL(KIND=r8)    :: LAND_FRACT_C(N)

    !
    REAL(KIND=r8)    :: RHODZ(N)                      ! WORK Used for air mass p.u.a. in successive layers.
    REAL(KIND=r8)    :: deltaz_c(n)                   ! Thickness of layer (m)
    REAL(KIND=r8)    :: rhodz_dry_c(n)                ! Dry air density * layer thickness (kg m-2)
    REAL(KIND=r8)    :: rhodz_moist_c(n)              ! Moist air density * layer thickness (kg m-2)

    REAL(KIND=r8)    :: P(N)                          ! WORK Used for pressure at successive levels.
    !
    ! Microphysical process rate diagnostics (compressed arrays)

    ! Call size of CX and CONSTP
    ! Start C_LSPSIZ
    ! Description: Include file containing idealised forcing options
    ! Author:      R. Forbes
    !
    ! History:
    ! Version  Date      Comment
    ! -------  ----      -------
    !   6.1    01/08/04  Increase dimension for rain/graupel.  R.Forbes
    !   6.2    22/08/05  Include the step size between ice categories.
    !                                                   Damian Wilson

    INTEGER,PARAMETER:: ice_type_offset=20

    ! End C_LSPSIZ
    ! Call comdeck containing ls ppn scavenging coeffs for Sulphur Cycle
    !
    !  External subroutines called -----------------------------------------
    !EXTERNAL LSP_ICE,LSP_SCAV
    !     &        ,SLSPSCV
    !*----------------------------------------------------------------------
    !  Physical constants -------------------------------------------------
    !*L------------------COMDECK C_G----------------------------------------
    ! G IS MEAN ACCEL DUE TO GRAVITY AT EARTH'S SURFACE

    REAL(KIND=r8), PARAMETER :: G = 9.80665_r8

    !*----------------------------------------------------------------------
    REAL(KIND=r8) , PARAMETER :: P1UPONG=1.0_r8/G           ! One upon g (sq seconds per m).
    !  Define local variables ----------------------------------------------
    INTEGER :: MULTRHC         ! Zero if (nCols*rhc_rows) le 1, else 1
    !
    INTEGER :: I,II
    ! Loop counters: I - horizontal field index;
    INTEGER :: IRHI   !           : IRHI,IRHJ-indices for RHcrit.
    CF_C=0.0_r8;      Q_C=0.0_r8;     QCF_C=0.0_r8;    QCL_C=0.0_r8;    QCF2_C=0.0_r8;
    T_C=0.0_r8 ;      AERO_C=0.0_r8;  LSRAIN_C=0.0_r8; LSSNOW_C=0.0_r8; LSSNOW2_C=0.0_r8;
    LSGRAUP_C=0.0_r8; CTTEMP_C=0.0_r8;RAINFRAC_C=0.0_r8;FRAC_ICE_ABOVE_C=0.0_r8;    &
    CFL_C=0.0_r8;    CFF_C=0.0_r8;    VFALL_C=0.0_r8;
    VFALL2_C=0.0_r8;    VFALL_RAIN_C=0.0_r8;    VFALL_GRAUP_C=0.0_r8
    SEA_SALT_FILM_C=0.0_r8;    SEA_SALT_JET_C =0.0_r8;    biogenic_C=0.0_r8
    RHC_C=0.0_r8;    SO4_AIT_C=0.0_r8;    SO4_ACC_C=0.0_r8;
    SO4_DIS_C=0.0_r8;        BMASS_AGD_C=0.0_r8;    BMASS_CLD_C=0.0_r8;
    OCFF_AGD_C=0.0_r8;    OCFF_CLD_C=0.0_r8;
    SNOW_DEPTH_C=0.0_r8;    LAND_FRACT_C=0.0_r8;
    RHODZ=0.0_r8;    deltaz_c=0.0_r8;    rhodz_dry_c=0.0_r8;    rhodz_moist_c=0.0_r8;
    P=0.0_r8;                          
    !
    !-----------------------------------------------------------------------
    !L Internal structure.
    !L 1. gather variables using index
    !-----------------------------------------------------------------------
    IF ( (nCols )  >   1) THEN
       MULTRHC = 1
    ELSE
       MULTRHC = 0
    END IF
    !
    DO I=1,N
       II=IX(I)
       ! IJ=IX(I,2)
       IRHI = (MULTRHC * (II - 1)) + 1
       !IRHJ = (MULTRHC * (IJ - 1)) + 1
       LSRAIN_C(I)        = LSRAIN(II)
       LSSNOW_C(I)        = LSSNOW(II)
       LSSNOW2_C(I)       = LSSNOW2(II)
       LSGRAUP_C(I)       = LSGRAUP(II)
       CTTEMP_C(I)        = CTTEMP(II)
       RAINFRAC_C(I)      = RAINFRAC(II)
       FRAC_ICE_ABOVE_C(I)= FRAC_ICE_ABOVE(II)
       !ajm        PSTAR_C(I) =PSTAR(II)
       P(I)               = p_theta_levels(II)
       RHODZ(I)           = -P1UPONG*layer_thickness(II)
       deltaz_c(i)        = deltaz(ii)
       rhodz_dry_c(i)     = rhodz_dry(ii)
       rhodz_moist_c(i)   = rhodz_moist(ii)
       CF_C (I)           = CF(II)
       CFL_C(I)           = CFL(II)
       CFF_C(I)           = CFF(II)
       QCF_C(I)           = QCF(II)
       QCL_C(I)           = QCL(II)
       Q_C(I)=Q(II)
       T_C(I)=T(II)
       IF (L_mcr_qcf2) QCF2_C(I) = QCF2(II)
       IF (L_MURK) AERO_C(I)=AEROSOL(II)
       VFALL_C(I)=VFALL(II)
       VFALL2_C(I) = VFALL2(II)
       VFALL_RAIN_C(I) = VFALL_RAIN(II)
       VFALL_GRAUP_C(I) = VFALL_GRAUP(II)
       RHC_C(I)=RHCRIT(IRHI)
       IF (L_USE_SULPHATE_AUTOCONV) THEN
          SO4_AIT_C(I)=SO4_AIT(II)
          SO4_ACC_C(I)=SO4_ACC(II)
          SO4_DIS_C(I)=SO4_DIS(II)
       END IF
       IF (L_SEASALT_CCN) THEN
          SEA_SALT_FILM_C(I)=SEA_SALT_FILM(II)
          SEA_SALT_JET_C(I)=SEA_SALT_JET(II)
       ELSE
          SEA_SALT_FILM_C(1)=SEA_SALT_FILM(1)
          SEA_SALT_JET_C(1)=SEA_SALT_JET(1)
       ENDIF
       IF (L_BIOMASS_CCN) THEN
          BMASS_AGD_C(I)=BMASS_AGD(II)
          BMASS_CLD_C(I)=BMASS_CLD(II)
       ELSE
          BMASS_AGD_C(I)=BMASS_AGD(1)
          BMASS_CLD_C(I)=BMASS_CLD(1)
       ENDIF
       IF (L_biogenic_CCN) THEN
          biogenic_C(I)=biogenic(II)
       ELSE
          biogenic_C(1)=biogenic(1)
       ENDIF
       IF (L_OCFF_CCN) THEN
          OCFF_AGD_C(I)=OCFF_AGD(II)
          OCFF_CLD_C(I)=OCFF_CLD(II)
       ELSE
          OCFF_AGD_C(I)=OCFF_AGD(1)
          OCFF_CLD_C(I)=OCFF_CLD(1)
       ENDIF
       SNOW_DEPTH_C(I)=SNOW_DEPTH(II)
       LAND_FRACT_C(I)=LAND_FRACT(II)

       ! Process diagnostic arrays are initialised to zero in LSP_ICE
    END DO ! Loop over points
    !
    !-----------------------------------------------------------------------
    ! ICE FORMATION/EVAPORATION/MELTING
    ! WATER CLOUD AND RAIN FORMATION/EVAPORATION
    !-----------------------------------------------------------------------
    ! The call to LSP_ICE replaces the calls to LSP_EVAP, LSPFRMT
    ! and LSP_FORM.
    ! CFL_C contains cloud fraction for ice
    ! CFF_C contains cloud fraction for water
    ! DEPENDS ON: lsp_ice
    CALL LSP_ICE( &
         P                       , &!REAL(KIND=r8)   , INTENT(IN   ) :: P(POINTS)          ! Air pressure at this level (Pa).
         RHODZ                   , &!REAL   , INTENT(IN   ) :: RHODZ(POINTS)      ! Air mass p.u.a. in this layer (kg per sq m).
         deltaz_c                , &!REAL   , INTENT(IN   ) :: deltaz(points)     ! Depth of layer / m
         rhodz_dry_c             , &!REAL   , INTENT(IN   ) :: rhodz_dry(points)  ! Density of dry air / kg m-3
         rhodz_moist_c           , &!REAL   , INTENT(IN   ) :: rhodz_moist(points)! Density of moist air / kg m-3
         TIMESTEP                , &!REAL   , INTENT(IN   ) :: TIMESTEPFIXED      ! Timestep of physics in model (s).
         N                       , &!INTEGER, INTENT(IN   ) :: POINTS       ! Number of points to be processed.
         L_MURK                  , &!LOGICAL, INTENT(IN   ) :: L_MURK       ! Murk aerosol is a valid quantity
         RHC_C                   , &!REAL   , INTENT(IN   ) :: RHCPT(POINTS)      ! Critical relative humidity of all points for cloud formation.
         L_USE_SULPHATE_AUTOCONV , &!LOGICAL, INTENT(IN   ) :: L_USE_SULPHATE_AUTOCONV!Switch to use sulphate aerosol in the calculation of cloud
         L_AUTO_DEBIAS           , &!LOGICAL, INTENT(IN   ) :: L_AUTO_DEBIAS  ! Switch to apply de-biasing correction to autoconversion rate.
         L_mcr_qcf2              , &!LOGICAL, INTENT(IN   ) :: L_mcr_qcf2   ! true if using 2nd cloud ice prognostic
         L_it_melting            , &!LOGICAL, INTENT(IN   ) :: L_it_melting           ! true if using iterative melting
         l_non_hydrostatic       , &!LOGICAL, INTENT(IN   ) :: L_non_hydrostatic ! Use non hydrostatic layer masses
         l_mixing_ratio          , &!LOGICAL, INTENT(IN   ) :: L_mixing_ratio    ! Use mixing ratio formulation
         SO4_ACC_C               , &!REAL   , INTENT(IN   ) :: SO4_ACC(POINTS)    ! Sulphur cycle variable
         SO4_DIS_C               , &!REAL   , INTENT(IN   ) :: SO4_DIS(POINTS)    ! Sulphur cycle variable
         !SO4_AIT_C               , &!REAL   , INTENT(IN   ) :: SO4_AIT(POINTS)    ! Sulphur cycle variable
         L_BIOMASS_CCN           , &!LOGICAL, INTENT(IN   ) :: L_BIOMASS_CCN! Switch to supplement sulphate aerosol with biomass smoke
         BMASS_AGD_C             , &!REAL   , INTENT(IN   ) :: BMASS_AGD(POINTS)  ! Aged biomass smoke mass mixing ratio
         BMASS_CLD_C             , &!REAL   , INTENT(IN   ) :: BMASS_CLD(POINTS)  ! In-cloud biomass smoke mass mixing ratio
         L_OCFF_CCN              , &!LOGICAL, INTENT(IN   ) :: L_OCFF_CCN   ! Switch to supplement sulphate aerosol with fossil-fuel organic
         OCFF_AGD_C              , &!REAL   , INTENT(IN   ) :: OCFF_AGD(POINTS)   ! Aged fossil-fuel organic carbon mass mixing ratio
         OCFF_CLD_C              , &!REAL   , INTENT(IN   ) :: OCFF_CLD(POINTS)   ! In-cloud fossil-fuel organic carbon mass mixing ratio
         L_SEASALT_CCN           , &!LOGICAL, INTENT(IN   ) :: L_SEASALT_CCN! Switch to supplement sulphate aerosol with sea-salt if the
         SEA_SALT_FILM_C         , &!REAL   , INTENT(IN   ) :: SEA_SALT_FILM(SALT_DIM_ICE)! Film-mode sea-salt aerosol number concentration (m-3)
         SEA_SALT_JET_C          , &!REAL   , INTENT(IN   ) :: SEA_SALT_JET(SALT_DIM_ICE) ! Jet-mode sea-salt aerosol number concentration (m-3)
         salt_dim_ice            , &!INTEGER, INTENT(IN   ) :: SALT_DIM_ICE ! Number of points for sea-salt arrays (either POINTS or 1)
         L_biogenic_CCN          , &!LOGICAL, INTENT(IN   ) :: L_biogenic_CCN !Switch to supplement sulphate aerosol with biogenic aerosol
         biogenic_C              , &!REAL   , INTENT(IN   ) :: biogenic(biog_dim_ice)     ! Biogenic aerosol m.m.r.
         biog_dim_ice            , &!INTEGER, INTENT(IN   ) :: biog_dim_ice ! Number of points for biogenic array  (either POINTS or 1)
         SNOW_DEPTH_C            , &!REAL   , INTENT(IN   ) :: SNOW_DEPTH(POINTS) ! Snow depth for aerosol amount (m)
         LAND_FRACT_C            , &!REAL   , INTENT(IN   ) :: LAND_FRACT(POINTS) ! Land fraction
         AERO_C                  , &!REAL   , INTENT(IN   ) :: AEROSOL(POINTS)    ! Aerosol mass (ug/kg)
         L_autoconv_murk         , &!LOGICAL, INTENT(IN   ) :: L_autoconv_murk! Use murk aerosol to calc. drop number
         ec_auto                 , &!Real   , INTENT(IN   ) :: ec_auto       ! Collision coalescence efficiency
         Ntot_land               , &!Real   , INTENT(IN   ) :: Ntot_land     ! Number of droplets over land / m-3
         Ntot_sea                , &!Real   , INTENT(IN   ) :: Ntot_sea      ! Number of droplets over sea  / m-3
         QCF_C                   , &!REAL   , INTENT(INOUT) :: QCF(POINTS)   ! Cloud ice (kg water per kg air).
         QCL_C                   , &!REAL   , INTENT(INOUT) :: QCL(POINTS)   ! Cloud liquid water (kg water per kg air).
         Q_C                     , &!REAL   , INTENT(INOUT) :: Q(POINTS)     ! Specific humidity at this level (kg water per kg air).
         QCF2_C                  , &!REAL   , INTENT(INOUT) :: QCF2(POINTS)  ! Second cloud ice (kg water per kg air).
         LSRAIN_C                , &!REAL   , INTENT(INOUT) :: RAIN(POINTS)  ! On input: Rate of rainfall entering this layer from above.
         LSSNOW_C                , &!REAL   , INTENT(INOUT) :: SNOW_AGG(POINTS) ! Dummy in 3C version of the code
         VFALL_C                 , &!REAL   , INTENT(INOUT) :: VF(POINTS)      ! On input: Fall velocity of snow aggregates entering layer.
         LSSNOW2_C               , &!REAL   , INTENT(INOUT) :: SNOW_CRY(POINTS)! On input: Rate of snow crystals entering layer from above.
         VFALL2_C                , &!REAL   , INTENT(INOUT) :: VF_CRY(POINTS)  ! On input: Fall velocity of snow crystals entering this layer.
         FRAC_ICE_ABOVE_C        , &!REAL   , INTENT(INOUT) :: FRAC_ICE_ABOVE(POINTS)! Fraction of ice in layer above (no units)
         CTTEMP_C                , &!REAL   , INTENT(INOUT) :: CTTEMP(POINTS)        ! Ice cloud top temperature (K)
         RAINFRAC_C              , &!REAL   , INTENT(INOUT) :: RAINFRAC(POINTS)      ! Rain fraction (no units)
         T_C                     , &!REAL   , INTENT(INOUT) :: T(POINTS)     ! Temperature at this level (K).
         CF_C                    , &!REAL   , INTENT(IN   ) :: CFKEEP(POINTS)     ! Total cloud fraction in this layer (no units).
         CFL_C                   , &!REAL   , INTENT(IN   ) :: CFLIQ(POINTS)      ! Liquid cloud fraction in this layer (no units).
         CFF_C                   , &!REAL   , INTENT(IN   ) :: CFICEKEEP(POINTS)  ! Frozen cloud fraction in this layer (no units).
         CX                      , &!REAL   , INTENT(IN   ) :: CX(80)
         CONSTP                    &!REAL   , INTENT(IN   ) :: CONSTP(80)
         )
    !-----------------------------------------------------------------------
    !L 3.4 Lose aerosol by scavenging: call LSP_SCAV
    !-----------------------------------------------------------------------
    !
    IF (L_MURK)  THEN
       ! DEPENDS ON: lsp_scav
       CALL LSP_SCAV( &
            TIMESTEP, & !REAL   , INTENT(IN   ) :: TIMESTEP! Input real scalar :- IN Timestep (s).
            N       , & !INTEGER, INTENT(IN   ) :: POINTS  ! Input integer scalar :- IN Number of points to be processed.
            LSRAIN_C, & !REAL   , INTENT(IN   ) :: RAIN(POINTS)  ! Input real arrays :- IN Rate of rainfall in this layer from above! (kg per sq m per s).
            LSSNOW_C, & !REAL   , INTENT(IN   ) :: SNOW(POINTS)  ! IN Rate of snowfall in this layer from above (kg per sq m per s).
            AERO_C    ) !REAL   , INTENT(INOUT) :: AEROSOL(POINTS) ! Updated real arrays :-INOUT Aerosol mixing ratio
    ENDIF
    !
    !-----------------------------------------------------------------------
    !L 4  Scatter back arrays which will have been changed.
    !L
    !-----------------------------------------------------------------------
    !

    DO I=1,N
       II=IX(I)
       !IJ=IX(I,2)
       T(II)=T_C(I)
       Q(II)=Q_C(I)
       QCF(II)=QCF_C(I)
       QCL(II)=QCL_C(I)
       IF (L_mcr_qcf2) QCF2(II) = QCF2_C(I)
       IF (L_MURK) AEROSOL(II)=AERO_C(I)
       LSRAIN(II)=LSRAIN_C(I)
       LSSNOW(II)=LSSNOW_C(I)
       LSSNOW2(II)=LSSNOW2_C(I)
       LSGRAUP(II)=LSGRAUP_C(I)
       CTTEMP(II)=CTTEMP_C(I)
       RAINFRAC(II)=RAINFRAC_C(I)
       FRAC_ICE_ABOVE(II)=FRAC_ICE_ABOVE_C(I)
       IF (L_pc2) THEN
          CFF(II)=CFF_C(I)
          CFL(II)=CFL_C(I)
          CF (II)=CF_C(I)
       END IF  ! L_pc2

       VFALL(II)=VFALL_C(I)
       VFALL2(II)=VFALL2_C(I)
       VFALL_RAIN(II)=VFALL_RAIN_C(I)
       VFALL_GRAUP(II)=VFALL_GRAUP_C(I)
       ! Only store process rates in array for diagnostic
       ! if a particular diagnostic is requested,
       ! otherwise overwriting will occur
       ! (space for the 3D array in MCR_CTL is only allocated
       ! if the diagnostic is active, to save memory)
    END DO ! Loop over points
    !
    !
    RETURN
  END SUBROUTINE LS_PPNC



  ! *****************************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*******************************
  !+ Precipitation microphysics calculations.
  ! Subroutine Interface:
  SUBROUTINE LSP_ICE(&
       P                      , &!REAL   , INTENT(IN   ) :: P(POINTS)          ! Air pressure at this level (Pa).
       RHODZ                  , &!REAL   , INTENT(IN   ) :: RHODZ(POINTS)      ! Air mass p.u.a. in this layer (kg per sq m).
       deltaz                 , &!REAL   , INTENT(IN   ) :: deltaz(points)     ! Depth of layer / m
       rhodz_dry              , &!REAL   , INTENT(IN   ) :: rhodz_dry(points)  ! Density of dry air / kg m-3
       rhodz_moist            , &!REAL   , INTENT(IN   ) :: rhodz_moist(points)! Density of moist air / kg m-3
       TIMESTEPFIXED          , &!REAL   , INTENT(IN   ) :: TIMESTEPFIXED      ! Timestep of physics in model (s).
       POINTS                 , &!INTEGER, INTENT(IN   ) :: POINTS       ! Number of points to be processed.
       L_MURK                 , &!LOGICAL, INTENT(IN   ) :: L_MURK       ! Murk aerosol is a valid quantity
       RHCPT                  , &!REAL   , INTENT(IN   ) :: RHCPT(POINTS)      ! Critical relative humidity of all points for cloud formation.
       L_USE_SULPHATE_AUTOCONV, &!LOGICAL, INTENT(IN   ) :: L_USE_SULPHATE_AUTOCONV!Switch to use sulphate aerosol in the calculation of cloud
       L_AUTO_DEBIAS          , &!LOGICAL, INTENT(IN   ) :: L_AUTO_DEBIAS  ! Switch to apply de-biasing correction to autoconversion rate.
       L_mcr_qcf2             , &!LOGICAL, INTENT(IN   ) :: L_mcr_qcf2   ! true if using 2nd cloud ice prognostic
       L_it_melting           , &!LOGICAL, INTENT(IN   ) :: L_it_melting      ! true if using iterative melting
       l_non_hydrostatic      , &!LOGICAL, INTENT(IN   ) :: L_non_hydrostatic ! Use non hydrostatic layer masses
       l_mixing_ratio         , &!LOGICAL, INTENT(IN   ) :: L_mixing_ratio    ! Use mixing ratio formulation
       SO4_ACC                , &!REAL   , INTENT(IN   ) :: SO4_ACC(POINTS)    ! Sulphur cycle variable
       SO4_DIS                , &!REAL   , INTENT(IN   ) :: SO4_DIS(POINTS)    ! Sulphur cycle variable
!       SO4_AIT                , &!REAL   , INTENT(IN   ) :: SO4_AIT(POINTS)    ! Sulphur cycle variable
       L_BIOMASS_CCN          , &!LOGICAL, INTENT(IN   ) :: L_BIOMASS_CCN! Switch to supplement sulphate aerosol with biomass smoke
       BMASS_AGD              , &!REAL   , INTENT(IN   ) :: BMASS_AGD(POINTS)  ! Aged biomass smoke mass mixing ratio
       BMASS_CLD              , &!REAL   , INTENT(IN   ) :: BMASS_CLD(POINTS)  ! In-cloud biomass smoke mass mixing ratio
       L_OCFF_CCN             , &!LOGICAL, INTENT(IN   ) :: L_OCFF_CCN   ! Switch to supplement sulphate aerosol with fossil-fuel organic
       OCFF_AGD               , &!REAL   , INTENT(IN   ) :: OCFF_AGD(POINTS)   ! Aged fossil-fuel organic carbon mass mixing ratio
       OCFF_CLD               , &!REAL   , INTENT(IN   ) :: OCFF_CLD(POINTS)   ! In-cloud fossil-fuel organic carbon mass mixing ratio
       L_SEASALT_CCN          , &!LOGICAL, INTENT(IN   ) :: L_SEASALT_CCN! Switch to supplement sulphate aerosol with sea-salt if the
       SEA_SALT_FILM          , &!REAL   , INTENT(IN   ) :: SEA_SALT_FILM(SALT_DIM_ICE)! Film-mode sea-salt aerosol number concentration (m-3)
       SEA_SALT_JET           , &!REAL   , INTENT(IN   ) :: SEA_SALT_JET(SALT_DIM_ICE) ! Jet-mode sea-salt aerosol number concentration (m-3)
       SALT_DIM_ICE           , &!INTEGER, INTENT(IN   ) :: SALT_DIM_ICE ! Number of points for sea-salt arrays (either POINTS or 1)
       L_biogenic_CCN         , &!LOGICAL, INTENT(IN   ) :: L_biogenic_CCN !Switch to supplement sulphate aerosol with biogenic aerosol
       biogenic               , &!REAL   , INTENT(IN   ) :: biogenic(biog_dim_ice)     ! Biogenic aerosol m.m.r.
       biog_dim_ice           , &!INTEGER, INTENT(IN   ) :: biog_dim_ice ! Number of points for biogenic array  (either POINTS or 1)
       SNOW_DEPTH             , &!REAL   , INTENT(IN   ) :: SNOW_DEPTH(POINTS) ! Snow depth for aerosol amount (m)
       LAND_FRACT             , &!REAL   , INTENT(IN   ) :: LAND_FRACT(POINTS) ! Land fraction
       AEROSOL                , &!REAL   , INTENT(IN   ) :: AEROSOL(POINTS)    ! Aerosol mass (ug/kg)
       L_autoconv_murk        , &!LOGICAL, INTENT(IN   ) :: L_autoconv_murk! Use murk aerosol to calc. drop number
       ec_auto                , &!Real   , INTENT(IN   ) :: ec_auto       ! Collision coalescence efficiency
       Ntot_land              , &!Real   , INTENT(IN   ) :: Ntot_land     ! Number of droplets over land / m-3
       Ntot_sea               , &!Real   , INTENT(IN   ) :: Ntot_sea      ! Number of droplets over sea  / m-3
       QCF                    , &!REAL   , INTENT(INOUT) :: QCF(POINTS)   !         Cloud ice (kg water per kg air).
       QCL                    , &!REAL   , INTENT(INOUT) :: QCL(POINTS)   !         Cloud liquid water (kg water per kg air).
       Q                      , &!REAL   , INTENT(INOUT) :: Q(POINTS)     !         Specific humidity at this level (kg water per kg air).
       QCF2                   , &!REAL   , INTENT(INOUT) :: QCF2(POINTS)  !         Second cloud ice (kg water per kg air).
       RAIN                   , &!REAL   , INTENT(INOUT) :: RAIN(POINTS)  !         On input: Rate of rainfall entering this layer from above.
       SNOW_AGG               , &!REAL   , INTENT(INOUT) :: SNOW_AGG (POINTS) ! Dummy in 3C version of the code
       VF                     , &!REAL   , INTENT(INOUT) :: VF(POINTS)      ! On input: Fall velocity of snow aggregates entering layer.
       SNOW_CRY               , &!REAL   , INTENT(INOUT) :: SNOW_CRY(POINTS)! On input: Rate of snow crystals entering layer from above.
       VF_CRY                 , &!REAL   , INTENT(INOUT) :: VF_CRY(POINTS)  ! On input: Fall velocity of snow crystals entering this layer.
       FRAC_ICE_ABOVE         , &!REAL   , INTENT(INOUT) :: FRAC_ICE_ABOVE(POINTS)! Fraction of ice in layer above (no units)
       CTTEMP                 , &!REAL   , INTENT(INOUT) :: CTTEMP(POINTS)        ! Ice cloud top temperature (K)
       RAINFRAC               , &!REAL   , INTENT(INOUT) :: RAINFRAC(POINTS)      ! Rain fraction (no units)
       T                      , &!REAL   , INTENT(INOUT) :: T(POINTS)     !         Temperature at this level (K).
       CFKEEP                 , &!REAL   , INTENT(IN   ) :: CFKEEP(POINTS)     ! Total cloud fraction in this layer (no units).
       CFLIQ                  , &!REAL   , INTENT(IN   ) :: CFLIQ(POINTS)      ! Liquid cloud fraction in this layer (no units).
       CFICEKEEP              , &!REAL   , INTENT(IN   ) :: CFICEKEEP(POINTS)  ! Frozen cloud fraction in this layer (no units).
       CX                     , &!REAL   , INTENT(IN   ) :: CX(80)
       CONSTP                   &!REAL   , INTENT(IN   ) :: CONSTP(80)
       )


    IMPLICIT NONE
    !
    ! Description:
    !   Updates ice, liquid and vapour contents and temperature as a
    !   result of microphysical processes.
    !
    ! Method:
    !   Calculates transfers of water between vapour, ice, cloud liquid
    !   and rain. Advects ice downwards. Processes included are:
    !   Fall of ice into and out of the layer;
    !   Homogenous and heterogenous nucleation of ice;
    !   Deposition and sublimation of ice;
    !   Riming; riming by supercooled raindrops;
    !   Melting of ice; Evaporation of rain; accretion;
    !   Autoconversion of liquid water to rain.
    !   This is described in Unified Model Documentation Paper 26.
    !
    !   Microphysics options:
    !   - Second prognostic cloud ice variables
    !      Active if L_mcr_qcf2=.True.
    !      The code supports the use of a second cloud ice prognostic
    !      variable so that both cloud ice aggregates (QCF and QCF_AGG)
    !      and cloud ice pristine crystals (QCF2 and QCF_CRY) can be
    !      represented and advected.
    !      At UM5.5 this code is still experimental.
    !   - Prognostic rain (controlled by L_mcr_qrain)
    !     At UM5.5 no microphysical process/sedimentation code is present.
    !   - Prognostic graupel (controlled by L_mcr_qrain)
    !     At UM5.5 no microphysical process/sedimentation code is present.
    !
    ! Current Code Owner: Damian Wilson
    !
    ! History:
    ! Version   Date     Comment
    ! -------   ----     -------
    ! 5.2       21/11/00 Original code. Damian Wilson
    !LL  5.3  24/09/01  Portability changes.    Z. Gardner
    ! 5.3       06/08/01 Modify fall out algorithm to be more numerically
    !                    stable. Adjust the layer density calculation to
    !                    be more numerically robust.  Damian Wilson
    !           03/12/01 Correct wet bulb temperature calculation.
    !                                                 Damian Wilson
    !
    !
    ! 5.3       29/08/01 Introduce logical to control effect of sulphate
    !                    aerosol on autoconversion.  Andy Jones
    ! 5.4       02/09/02 Include c_micro for homogenous freezing
    !                    temperature                 Damian Wilson
    !
    ! 5.4       25/04/02 Replace land/sea mask with land fraction field
    !                    in call to NUMBER_DROPLET.
    !                                             Andy Jones
    ! 5.5       03/02/03 Include second ice, rain and graupel prognostic
    !                    variables.                            R.M.Forbes
    ! 5.5       24/02/03 Correct sign error in evaporation of melting snow
    !                    term.                    Damian Wilson
    ! 6.1       01/08/04 Include dummy variables in argument list. R.Forbes
    ! 6.1       30/07/04 Alter the subgrid-scale treatment in the
    !                    deposition/sublimation term.  Damian Wilson
    ! 6.1       05/05/04 Correct evaporation of rain error in the
    !                    non VECTLIB branch of the code. Damian Wilson
    ! 6.1       07/04/04 Add biomass smoke to call to NUMBER_DROPLET.
    !                                             Andy Jones
    ! 6.1       07/04/04 Add option to apply bias-removal scheme to the
    !                    autoconversion.          Andy Jones
    ! 6.2       02/11/05 Provide a minimum limit to width of PDF
    !                    in deposition term.  Damian Wilson
    ! 6.2       02/11/05 Add iterative melting    Damian Wilson
    ! 6.2       23/11/05 Pass through precip variables from UMUI. D. Wilson
    ! 6.2       12/01/06 Pass in dummy variables for non-hydrostatic code
    !                                                      Damian Wilson
    ! 6.2       20/10/05 Update comments for bias-removal scheme.
    !                                             Andy Jones
    ! 6.2       31/01/06 Pass in dummy rate diagnostics. Richard Forbes
    ! 6.4       10/01/07 Include mixing ratio control logical. D. Wilson
    !
    ! Code Description:
    !   Language: FORTRAN 77 + common extensions.
    !   This code is written to UMDP3 v6 programming standards.
    !
    INTEGER, INTENT(IN   ) :: POINTS       ! Number of points to be processed.
    INTEGER, INTENT(IN   ) :: SALT_DIM_ICE ! Number of points for sea-salt arrays (either POINTS or 1)
    INTEGER, INTENT(IN   ) :: biog_dim_ice ! Number of points for biogenic array  (either POINTS or 1)
    !
    LOGICAL, INTENT(IN   ) :: L_MURK       ! Murk aerosol is a valid quantity
    LOGICAL, INTENT(IN   ) :: L_USE_SULPHATE_AUTOCONV!Switch to use sulphate aerosol in the calculation of cloud
    !droplet number concentration in the autoconversion section,
    !i.e. activate the second indirect ("lifetime") effect.
    LOGICAL, INTENT(IN   ) :: L_SEASALT_CCN! Switch to supplement sulphate aerosol with sea-salt if the
    ! second indirect effect is active.
    LOGICAL, INTENT(IN   ) :: L_BIOMASS_CCN! Switch to supplement sulphate aerosol with biomass smoke
    ! aerosol if the second indirect effect is active.
    LOGICAL, INTENT(IN   ) :: L_OCFF_CCN   ! Switch to supplement sulphate aerosol with fossil-fuel organic
    ! carbon aerosol if the second indirect effect is active.
    LOGICAL, INTENT(IN   ) :: L_biogenic_CCN !Switch to supplement sulphate aerosol with biogenic aerosol
    ! if the second indirect effect is active.
    LOGICAL, INTENT(IN   ) :: L_AUTO_DEBIAS  ! Switch to apply de-biasing correction to autoconversion rate.
    LOGICAL, INTENT(IN   ) :: L_mcr_qcf2        ! true if using 2nd cloud ice prognostic
    LOGICAL, INTENT(IN   ) :: L_it_melting      ! true if using iterative melting
    LOGICAL, INTENT(IN   ) :: L_non_hydrostatic ! Use non hydrostatic layer masses
    LOGICAL, INTENT(IN   ) :: L_mixing_ratio    ! Use mixing ratio formulation
    !
    REAL(KIND=r8)   , INTENT(IN   ) :: TIMESTEPFIXED      ! Timestep of physics in model (s).
    REAL(KIND=r8)   , INTENT(IN   ) :: CFLIQ(POINTS)      ! Liquid cloud fraction in this layer (no units).
    REAL(KIND=r8)   , INTENT(IN   ) :: CFICEKEEP(POINTS)  ! Frozen cloud fraction in this layer (no units).
    REAL(KIND=r8)   , INTENT(IN   ) :: CFKEEP(POINTS)     ! Total cloud fraction in this layer (no units).
    REAL(KIND=r8)   , INTENT(IN   ) :: P(POINTS)          ! Air pressure at this level (Pa).
    REAL(KIND=r8)   , INTENT(IN   ) :: RHODZ(POINTS)      ! Air mass p.u.a. in this layer (kg per sq m).
    REAL(KIND=r8)   , INTENT(IN   ) :: deltaz(points)     ! Depth of layer / m
    REAL(KIND=r8)   , INTENT(IN   ) :: rhodz_dry(points)  ! Density of dry air / kg m-3
    REAL(KIND=r8)   , INTENT(IN   ) :: rhodz_moist(points)! Density of moist air / kg m-3
    REAL(KIND=r8)   , INTENT(IN   ) :: SO4_ACC(POINTS)    ! Sulphur cycle variable
    REAL(KIND=r8)   , INTENT(IN   ) :: SO4_DIS(POINTS)    ! Sulphur cycle variable
    !REAL(KIND=r8)   , INTENT(IN   ) :: SO4_AIT(POINTS)    ! Sulphur cycle variable
    REAL(KIND=r8)   , INTENT(IN   ) :: BMASS_AGD(POINTS)  ! Aged biomass smoke mass mixing ratio
    REAL(KIND=r8)   , INTENT(IN   ) :: BMASS_CLD(POINTS)  ! In-cloud biomass smoke mass mixing ratio
    REAL(KIND=r8)   , INTENT(IN   ) :: OCFF_AGD(POINTS)   ! Aged fossil-fuel organic carbon mass mixing ratio
    REAL(KIND=r8)   , INTENT(IN   ) :: OCFF_CLD(POINTS)   ! In-cloud fossil-fuel organic carbon mass mixing ratio
    REAL(KIND=r8)   , INTENT(IN   ) :: SNOW_DEPTH(POINTS) ! Snow depth for aerosol amount (m)
    REAL(KIND=r8)   , INTENT(IN   ) :: LAND_FRACT(POINTS) ! Land fraction
    REAL(KIND=r8)   , INTENT(IN   ) :: AEROSOL(POINTS)    ! Aerosol mass (ug/kg)
    REAL(KIND=r8)   , INTENT(IN   ) :: RHCPT(POINTS)      ! Critical relative humidity of all points for cloud formation.
    REAL(KIND=r8)   , INTENT(IN   ) :: SEA_SALT_FILM(SALT_DIM_ICE)! Film-mode sea-salt aerosol number concentration (m-3)
    REAL(KIND=r8)   , INTENT(IN   ) :: SEA_SALT_JET(SALT_DIM_ICE) ! Jet-mode sea-salt aerosol number concentration (m-3)
    REAL(KIND=r8)   , INTENT(IN   ) :: biogenic(biog_dim_ice)     ! Biogenic aerosol m.m.r.
    !
    ! End C_LSPSIZ
    !
    REAL(KIND=r8)   , INTENT(INOUT) :: Q(POINTS)     !         Specific humidity at this level (kg water per kg air).
    REAL(KIND=r8)   , INTENT(INOUT) :: QCF(POINTS)   !         Cloud ice (kg water per kg air).
    REAL(KIND=r8)   , INTENT(INOUT) :: QCL(POINTS)   !         Cloud liquid water (kg water per kg air).
    REAL(KIND=r8)   , INTENT(INOUT) :: QCF2(POINTS)  !         Second cloud ice (kg water per kg air).
    REAL(KIND=r8)   , INTENT(INOUT) :: T(POINTS)     !         Temperature at this level (K).
    REAL(KIND=r8)   , INTENT(INOUT) :: RAIN(POINTS)  !         On input: Rate of rainfall entering this layer from above.
    !         On output: Rate of rainfall leaving this layer.
    !                   (kg m-2 s-1).
    REAL(KIND=r8)   , INTENT(INOUT) :: SNOW_AGG(POINTS)! On input: Rate of snow aggregates entering layer from above.
    ! On output: Rate of snow aggregates leaving this layer.
    ! (kg m-2 s-1). If only one ice prognostic is active
    ! then this variable contains all the snow.
    REAL(KIND=r8)   , INTENT(INOUT) :: SNOW_CRY(POINTS)! On input: Rate of snow crystals entering layer from above.
    ! On Output: Rate of snow crystals leaving this layer.
    ! (kg m-2 s-1). Only non-zero if two ice
    ! prognostics in use.
    REAL(KIND=r8)   , INTENT(INOUT) :: VF(POINTS)      ! On input: Fall velocity of snow aggregates entering layer.
    ! On Output: Fall velocity of snow aggregates leaving layer.
    ! (m s-1). If only one ice prognostic is active
    ! then this is the velocity of all falling snow.
    REAL(KIND=r8)   , INTENT(INOUT) :: VF_CRY(POINTS)  ! On input: Fall velocity of snow crystals entering this layer.
    ! On Output: Fall velocity of snow crystals leaving this layer.
    ! (m s-1). Only used if two ice prognostics in use.
    REAL(KIND=r8)   , INTENT(INOUT) :: CTTEMP(POINTS)        ! Ice cloud top temperature (K)
    REAL(KIND=r8)   , INTENT(INOUT) :: RAINFRAC(POINTS)      ! Rain fraction (no units)
    REAL(KIND=r8)   , INTENT(INOUT) :: FRAC_ICE_ABOVE(POINTS)! Fraction of ice in layer above (no units)
    !
    ! Process rate diagnostics (Dummy arrays in 3C version of code)
    !
    ! Sets up the size of arrays for CX and CONSTP
    REAL(KIND=r8)   , INTENT(IN   ) ::  CX(80)
    REAL(KIND=r8)   , INTENT(IN   ) ::  CONSTP(80)

    !
    LOGICAL, INTENT(IN   ) :: L_autoconv_murk! Use murk aerosol to calc. drop number

    REAL(KIND=r8)   , INTENT(IN   ) :: ec_auto       ! Collision coalescence efficiency
    REAL(KIND=r8)   , INTENT(IN   ) :: Ntot_land     ! Number of droplets over land / m-3
    REAL(KIND=r8)   , INTENT(IN   ) :: Ntot_sea      ! Number of droplets over sea  / m-3

    ! Declarations:
    !
    ! Global variables:
    !*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

    !*----------------------------------------------------------------------
    ! --------------------------COMDECK C_LSPMIC----------------------------
    ! SPECIFIES MICROPHYSICAL PARAMETERS FOR AUTOCONVERSION, HALLETT MOSSOP
    ! PROCESS, ICE NUCLEATION. ALSO SPECIFIES NUMBER OF ITERATIONS OF
    ! THE MICROPHYSICS AND ICE CLOUD FRACTION METHOD
    ! ----------------------------------------------------------------------
    !
    ! History:
    !
    ! Version    Date     Comment
    ! -------    ----     -------
    !   5.4    16/08/02   Correct comment line, add PC2 parameters and
    !                     move THOMO to c_micro     Damian Wilson
    !   6.0    11/08/03   Correct value of wind_shear_factor for PC2
    !                                                          Damian Wilson
    !   6.2    17/11/05   Remove variables that are now in UMUI. D. Wilson
    !   6.2    03/02/06   Include droplet settling logical. Damian Wilson
    !
    ! ----------------------------------------------------------------------
    !      AUTOCONVERSION TERMS
    ! ----------------------------------------------------------------------
    !
    !     LOGICAL, PARAMETER :: L_AUTOCONV_MURK is set in UMUI
    ! Set to .TRUE. to calculate droplet concentration from MURK aerosol,
    ! which will override L_USE_SULPHATE_AUTOCONV (second indirect effect
    ! of sulphate aerosol). If both are .FALSE., droplet concentrations
    ! from comdeck C_MICRO are used to be consistent with the values
    ! used in the radiation scheme.

    ! This next set of parameters is to allow the 3B scheme to
    ! be replicated at 3C/3D
    ! Inhomogeneity factor for autoconversion rate
    REAL(KIND=r8),PARAMETER:: INHOMOG_RATE=1.0_r8

    ! Inhomogeneity factor for autoconversion limit
    REAL(KIND=r8),PARAMETER:: INHOMOG_LIM=1.0_r8

    ! Threshold droplet radius for autoconversion
    REAL(KIND=r8),PARAMETER:: R_THRESH=7.0E-6_r8
    ! End of 3B repeated code

    !Do not alter R_AUTO and N_AUTO since these values are effectively
    ! hard wired into a numerical approximation in the autoconversion
    ! code. EC_AUTO will be multiplied by CONSTS_AUTO

    ! Threshold radius for autoconversion
    REAL(KIND=r8), PARAMETER :: R_AUTO=20.0E-6_r8

    ! Critical droplet number for autoconversion
    REAL(KIND=r8), PARAMETER :: N_AUTO=1000.0_r8

    ! Collision coalesence efficiency for autoconversion
    !      REAL(KIND=r8), PARAMETER :: EC_AUTO is set in UMUI

    ! The autoconversion powers define the variation of the rate with
    ! liquid water content and droplet concentration. The following are
    ! from Tripoli and Cotton

    !  Dependency of autoconversion rate on droplet concentration
    REAL(KIND=r8), PARAMETER :: POWER_DROPLET_AUTO=-0.33333_r8

    ! Dependency of autoconversion rate on water content
    REAL(KIND=r8), PARAMETER :: POWER_QCL_AUTO=2.33333_r8

    ! Dependency of autoconversion rate on air density
    REAL(KIND=r8), PARAMETER :: power_rho_auto=1.33333_r8

    ! CONSTS_AUTO = (4 pi)/( 18 (4 pi/3)^(4/3)) g /  mu (rho_w)^(1/3)
    ! See UM documentation paper 26, equation P26.132

    ! Combination of physical constants
    REAL(KIND=r8), PARAMETER :: CONSTS_AUTO=5907.24_r8

    ! Quantites for calculation of drop number by aerosols.
    ! Need only set if L_AUTOCONV_MURK=.TRUE.  See file C_VISBTY

    ! Scaling concentration (m-3) in droplet number concentration
    REAL(KIND=r8), PARAMETER :: N0_MURK=500.0E6_r8

    ! Scaling mass (kg/kg) in droplet number calculation from aerosols
    REAL(KIND=r8), PARAMETER :: M0_MURK=1.458E-8_r8

    ! Power in droplet number calculation from aerosols
    REAL(KIND=r8), PARAMETER :: POWER_MURK=0.5_r8

    ! Ice water content threshold for graupel autoconversion (kg/m^3)
    REAL(KIND=r8), PARAMETER :: AUTO_GRAUP_QCF_THRESH = 3.E-4_r8

    ! Temperature threshold for graupel autoconversion (degC)
    REAL(KIND=r8), PARAMETER :: AUTO_GRAUP_T_THRESH = -4.0_r8

    ! Temperature threshold for graupel autoconversion
    REAL(KIND=r8), PARAMETER :: AUTO_GRAUP_COEFF = 0.5_r8

    !-----------------------------------------------------------------
    ! Iterations of microphysics
    !-----------------------------------------------------------------

    ! Number of iterations in microphysics.
    INTEGER,PARAMETER :: LSITER=8
    ! Advise 1 iteration for every 10 minutes or less of timestep.

    !-----------------------------------------------------------------
    ! Nucleation of ice
    !-----------------------------------------------------------------

    ! Note that the assimilation scheme uses temperature thresholds
    ! in its calculation of qsat.

    ! Nucleation mass
    REAL(KIND=r8), PARAMETER :: M0=1.0E-12_r8

    ! Maximum Temp for ice nuclei nucleation (deg C)
    REAL(KIND=r8), PARAMETER :: TNUC=-10.0_r8

    ! Maximum temperature for homogenous nucleation is now in c_micro
    ! so that it is available to code outside of section A04.

    !  1.0/Scaling quantity for ice in crystals
    REAL(KIND=r8), PARAMETER :: QCF0=1.0E4_r8       ! This is an inverse quantity

    ! Minimum allowed QCF after microphysics
    REAL(KIND=r8),PARAMETER:: QCFMIN=1.0E-8_r8

    ! 1/scaling temperature in aggregate fraction calculation
    REAL(KIND=r8), PARAMETER :: T_SCALING=0.0384_r8

    !  Minimum temperature limit in calculation  of N0 for ice (deg C)
    REAL(KIND=r8), PARAMETER :: T_AGG_MIN=-45.0_r8

    !-----------------------------------------------------------------
    ! Hallett Mossop process
    !-----------------------------------------------------------------

    ! Switch off Hallett Mossop in this version but allow
    ! functionality

    ! Min temp for production of Hallett Mossop splinters (deg C)
    REAL(KIND=r8), PARAMETER :: HM_T_MIN=-8.0_r8

    ! Max temp for production of Hallett Mossop splinters (deg C)
    REAL(KIND=r8), PARAMETER :: HM_T_MAX=-273.0_r8
    ! REAL(KIND=r8), PARAMETER :: HM_T_MAX=-3.0_r8

    !  Residence distance for Hallett Mossop splinters (1/deg C)
    REAL(KIND=r8), PARAMETER :: HM_DECAY=1.0_r8/7.0_r8

    ! Reciprocal of scaling liquid water content for HM process
    REAL(KIND=r8), PARAMETER :: HM_RQCL=1.0_r8/0.1E-3_r8

    !-----------------------------------------------------------------
    ! PC2 Cloud Scheme Terms
    !-----------------------------------------------------------------

    ! Specifies the ice content (in terms of a fraction of qsat_liq)
    ! that corresponds to a factor of two reduction in the width of
    ! the vapour distribution in the liquid-free part of the gridbox.
    REAL(KIND=r8), PARAMETER :: ICE_WIDTH=0.04_r8

    ! Parameter that governs the rate of spread of ice cloud fraction
    ! due to windshear
    REAL(KIND=r8), PARAMETER :: WIND_SHEAR_FACTOR = 1.5E-4_r8

    !-----------------------------------------------------------------
    ! Droplet settling
    !-----------------------------------------------------------------
    ! Use the droplet settling code (not available for 3C).
    LOGICAL, PARAMETER :: l_droplet_settle = .FALSE.

    !
    ! Description:
    !
    !  Contains various cloud droplet parameters, defined for
    !  land and sea areas.
    !
    !  NTOT_* is the total number concentration (m-3) of cloud droplets;
    !  KPARAM_* is the ratio of the cubes of the volume-mean radius
    !                                           and the effective radius;
    !  DCONRE_* is the effective radius (m) for deep convective clouds;
    !  DEEP_CONVECTION_LIMIT_* is the threshold depth (m) bewteen shallow
    !                                          and deep convective cloud.
    !
    ! Current Code Owner: Andy Jones
    !
    ! History:
    !
    ! Version   Date     Comment
    ! -------   ----     -------
    !    1     040894   Original code.    Andy Jones
    !  5.2     111000   Updated in line with Bower et al. 1994 (J. Atmos.
    !                   Sci., 51, 2722-2732) and subsequent pers. comms.
    !                   Droplet concentrations now as used in HadAM4.
    !                                     Andy Jones
    !  5.4     02/09/02 Moved THOMO here from C_LSPMIC.      Damian Wilson
    !  6.2     17/11/05 Remove variables that are now in UMUI. D. Wilson
    !
    !     REAL(KIND=r8),PARAMETER:: NTOT_LAND is set in UMUI
    !     REAL(KIND=r8),PARAMETER:: NTOT_SEA is set in UMUI
    REAL(KIND=r8),PARAMETER:: KPARAM_LAND = 0.67_r8
    REAL(KIND=r8),PARAMETER:: KPARAM_SEA = 0.80_r8
    REAL(KIND=r8),PARAMETER:: DCONRE_LAND = 9.5E-06_r8
    REAL(KIND=r8),PARAMETER:: DCONRE_SEA = 16.0E-06_r8
    REAL(KIND=r8),PARAMETER:: DEEP_CONVECTION_LIMIT_LAND = 500.0_r8
    REAL(KIND=r8),PARAMETER:: DEEP_CONVECTION_LIMIT_SEA = 1500.0_r8
    !
    ! Maximum Temp for homogenous nucleation (deg C)
    REAL(KIND=r8),PARAMETER:: THOMO = -40.0_r8
    !*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
    ! --------------------------COMDECK C_LSPDIF---------------------------
    ! input variables
    !
    ! Values of reference variables
    REAL(KIND=r8),PARAMETER:: AIR_DENSITY0=1.0_r8             ! kg m-3
    REAL(KIND=r8),PARAMETER:: AIR_VISCOSITY0=1.717E-5_r8      ! kg m-1 s-1
    REAL(KIND=r8),PARAMETER:: AIR_CONDUCTIVITY0=2.40E-2_r8    ! J m-1 s-1 K-1
    REAL(KIND=r8),PARAMETER:: AIR_DIFFUSIVITY0=2.21E-5_r8     ! m2 s-1
    REAL(KIND=r8),PARAMETER:: AIR_PRESSURE0=1.0E5_r8          ! Pa

    ! Values of diffusional growth parameters
    ! Terms in deposition and sublimation
    REAL(KIND=r8),PARAMETER:: APB1=(LC+LF)**2 * EPSILON /(R*AIR_CONDUCTIVITY0)
    REAL(KIND=r8),PARAMETER:: APB2=(LC+LF) / AIR_CONDUCTIVITY0
    REAL(KIND=r8),PARAMETER:: APB3=R/(EPSILON*AIR_PRESSURE0*AIR_DIFFUSIVITY0)
    ! Terms in evap of melting snow and rain
    REAL(KIND=r8),PARAMETER:: APB4=LC**2*EPSILON/(R*AIR_CONDUCTIVITY0)
    REAL(KIND=r8),PARAMETER:: APB5=LC /AIR_CONDUCTIVITY0
    REAL(KIND=r8),PARAMETER:: APB6=R/(EPSILON*AIR_PRESSURE0*AIR_DIFFUSIVITY0)

    ! Values of numerical approximation to wet bulb temperature
    ! Numerical fit to wet bulb temperature
    REAL(KIND=r8),PARAMETER:: TW1=1329.31_r8
    REAL(KIND=r8),PARAMETER:: TW2=0.0074615_r8
    REAL(KIND=r8),PARAMETER:: TW3=0.85E5_r8
    ! Numerical fit to wet bulb temperature
    REAL(KIND=r8),PARAMETER:: TW4=40.637_r8
    REAL(KIND=r8),PARAMETER:: TW5=275.0_r8

    ! Ventilation parameters
    REAL(KIND=r8),PARAMETER:: SC=0.6_r8
    ! f(v)  =  VENT_ICE1 + VENT_ICE2  Sc**(1/3) * Re**(1/2)
    REAL(KIND=r8),PARAMETER:: VENT_ICE1=0.65_r8
    REAL(KIND=r8),PARAMETER:: VENT_ICE2=0.44_r8
    ! f(v)  =  VENT_RAIN1 + VENT_RAIN2  Sc**(1/3) * Re**(1/2)
    REAL(KIND=r8),PARAMETER:: VENT_RAIN1=0.78_r8
    REAL(KIND=r8),PARAMETER:: VENT_RAIN2=0.31_r8
    ! c_lspdif will call c_r_cp, c_epslon and c_lheat
    !*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

    !*----------------------------------------------------------------------
    !
    ! Subroutine arguments
    !
    ! Obtain the size for CX and CONSTP
    ! Start C_LSPSIZ
    ! Description: Include file containing idealised forcing options
    ! Author:      R. Forbes
    !
    ! History:
    ! Version  Date      Comment
    ! -------  ----      -------
    !   6.1    01/08/04  Increase dimension for rain/graupel.  R.Forbes
    !   6.2    22/08/05  Include the step size between ice categories.
    !                                                   Damian Wilson

    ! Sets up the size of arrays for CX and CONSTP
    !      REAL(KIND=r8) CX(80),CONSTP(80)
    INTEGER,PARAMETER:: ice_type_offset=20


    !  Local parameters
    REAL(KIND=r8),PARAMETER:: LCRCP=LC/CP!         Latent heat of condensation / cp (K).
    REAL(KIND=r8),PARAMETER:: LFRCP=LF/CP!         Latent heat of fusion / cp (K).
    REAL(KIND=r8),PARAMETER:: LSRCP=LCRCP+LFRCP!         Sum of the above (S for Sublimation).
    REAL(KIND=r8),PARAMETER:: RHO1=1.0_r8!         Reference density of air (kg m-3)
    REAL(KIND=r8),PARAMETER:: ONE_OVER_EPSILON=1.0_r8/EPSILON!        Inverse of epsilon to speed up calculations
    REAL(KIND=r8),PARAMETER:: ONE_OVER_ZERODEGC=1.0_r8/ZERODEGC!        Inverse of zero degrees Celsius to speed up code (K-1)
    !
    !  Local scalars and dynamic arrays
    !
    INTEGER :: I            !         Loop counter (horizontal field index).
    INTEGER :: J            !         Counter for the iterations
    INTEGER :: K            !         Counter for the LSITER2 loop
    INTEGER :: LSITER2      !         Number of times advection and melting sections are iterated
    INTEGER :: KK           !         Variable for condensed points compression
    INTEGER :: SEA_SALT_PTR !         Pointer for sea-salt arrays
    INTEGER :: BIOMASS_PTR  !         Pointer for biomass smoke arrays
    INTEGER :: OCFF_PTR     !         Pointer for fossil-fuel organic carbon arrays
    INTEGER :: biogenic_ptr !         Pointer for biogenic aerosol arrays
    !
    REAL(KIND=r8) :: QS(POINTS)         !         Saturated sp humidity for (T,p) in layer (kg kg-1)
    REAL(KIND=r8) :: QSL(POINTS)        !         Saturated sp humidity for (T,p) in layer
                                        !         wrt water at all temps (kg kg-1)
    REAL(KIND=r8) :: SNOWT_AGG(POINTS)  !         Cumulative fall out of snow aggregates within iterations.
                                        !         (kg m-2 s-1). If only one ice prognostic is active then
                                        !         this variable contains all the snow.
    REAL(KIND=r8) :: SNOWT_CRY(POINTS)  !         Cumulative fall out of snow crystals within iterations.
                                        !         (kg m-2 s-1). Only non-zero if two ice prognostics in use.
                                        !REAL(KIND=r8) :: NUMBER_DROPLET     !         Droplet concentration calculated using a function (m-3)
    REAL(KIND=r8) :: RHO(POINTS)        !         Density of air in the layer (kg m-3).
    REAL(KIND=r8) :: RHOR(POINTS)       !         1.0/RHO to speed up calculations (kg-1 m3).
    REAL(KIND=r8) :: ESI(POINTS)        !         saturation vapour pressure (wrt ice below zero Celsius)(Pa)
    REAL(KIND=r8) :: ESW(POINTS)        !         saturation vapour pressure (wrt water at all temperatures)(Pa)
    REAL(KIND=r8) :: DQI                !         increment to/from ice/snow (kg kg-1)
    REAL(KIND=r8) :: DQIL               !         increment to/from cloud water (kg kg-1)
    REAL(KIND=r8) :: DPR                !         increment to/from rain (kg m-2 s-1)
    REAL(KIND=r8) :: CFICE(POINTS)      !         fraction of ice inferred for the microphysics (no units).
    REAL(KIND=r8) :: CFICEI(POINTS)     !         inverse of CFICE (no units)
    REAL(KIND=r8) :: CF(POINTS)         !         total cloud fraction for the microphysics (no units)
    REAL(KIND=r8) :: FQI_AGG(POINTS)    !         fallspeed for aggregates (m s-1)
    REAL(KIND=r8) :: FQI_CRY(POINTS)    !         fallspeed for aggregates (m s-1)
    REAL(KIND=r8) :: DHI(POINTS)        !         CFL limit (s m-1)
    REAL(KIND=r8) :: DHIR(POINTS)       !         1.0/DHI (m s-1)
    REAL(KIND=r8) :: DHILSITERR(POINTS) !         1.0/(DHI*LSITER) (m s-1)
    REAL(KIND=r8) :: FQIRQI_AGG         !         saved flux of ice out of layer (kg m-2 s-1)
    REAL(KIND=r8) :: FQIRQI2_AGG(POINTS)!         saved flux of ice out of layer from layer above (kg m-2 s-1)
    REAL(KIND=r8) :: FQIRQI_CRY         !         saved flux of ice out of layer (kg m-2 s-1)
    REAL(KIND=r8) :: FQIRQI2_CRY(POINTS)!         saved flux of ice out of layer from layer above (kg m-2 s-1)
    REAL(KIND=r8) :: QCLNEW             !         updated liquid cloud in implicit calculations (kg kg-1)
    REAL(KIND=r8) :: TEMP7              !         temporary variable
    REAL(KIND=r8) :: TEMPW              !         temporary for vapour calculations
    REAL(KIND=r8) :: t_rapid_melt       !         Rapid melting temperature
    REAL(KIND=r8) :: PR02               !         term in evaporation of rain
    REAL(KIND=r8) :: PR04               !         square of pr02
    REAL(KIND=r8) :: QC                 !         term in autoconversion of cloud to rain (kg kg-1)
    REAL(KIND=r8) :: APLUSB             !         denominator in deposition or evaporation of ice
    REAL(KIND=r8) :: CORR(POINTS)       !         density correction for fall speed (no units)
    REAL(KIND=r8) :: ROCOR(POINTS)      !         density correction for fall speed (no units)
    REAL(KIND=r8) :: VR1                !         Mean fall speed of rain (m s-1)
    REAL(KIND=r8) :: VS1                !         Mean fall speed of snow (m s-1)
    REAL(KIND=r8) :: LAMR1              !         Inverse lambda in rain exponential distribution (m)
    REAL(KIND=r8) :: LAMR2              !         Inverse lambda in rain exponential distribution (m)
    REAL(KIND=r8) :: LAMFAC1            !         Expression containing calculations with lambda
    REAL(KIND=r8) :: LAMS1              !         Inverse lambda in snow exponential distribution (m)
    REAL(KIND=r8) :: FV1                !         Mean velocity difference between rain and snow (m s-1)
    REAL(KIND=r8) :: TIMESTEP           !         Timestep of each iteration (s)
    REAL(KIND=r8) :: CORR2(POINTS)      !         Temperature correction of viscosity etc. (no units)
    REAL(KIND=r8) :: RHNUC              !         Relative humidity required for nucleation (no units)
    REAL(KIND=r8) :: TCG(POINTS)        !         Temperature Factor for aggregate size distribution (no units)
    REAL(KIND=r8) :: TCGI(POINTS)       !         Inverse of TCG (no units)
    REAL(KIND=r8) :: TCGC(POINTS)       !         Temperature Factor for crystal size distribution (no units)
    REAL(KIND=r8) :: TCGCI(POINTS)      !         Inverse of TCGC (no units)
    REAL(KIND=r8) :: RATEQS(POINTS)     !         Sub grid model variable (no units)
    REAL(KIND=r8) :: HM_NORMALIZE       !         Normalization for Hallett Mossop process (no units)
    REAL(KIND=r8) :: HM_RATE            !         Increase in deposition due to Hallett Mossop process(no units)
    REAL(KIND=r8) :: AREA_LIQ(POINTS)   !         Liquid only area of gridbox (no units)
    REAL(KIND=r8) :: AREA_MIX(POINTS)   !         Mixed phase area of gridbox (no units)
    REAL(KIND=r8) :: AREA_ICE(POINTS)   !         Ice only area of gridbox (no units)
    REAL(KIND=r8) :: AREA_CLEAR(POINTS) !         Cloud free area of gridbox (no units)
    REAL(KIND=r8) :: RAIN_LIQ(POINTS)   !         Overlap fraction of gridbox between rain and liquid cloud
    REAL(KIND=r8) :: RAIN_MIX(POINTS)   !         Overlap fraction of gridbox between rain and mixed phase cloud
    REAL(KIND=r8) :: RAIN_ICE(POINTS)   !         Overlap fraction of gridbox between rain and ice cloud
    REAL(KIND=r8) :: RAIN_CLEAR(POINTS) !         Overlap fraction of gridbox between rain and no cloud
    REAL(KIND=r8) :: Q_ICE(POINTS)      !         Vapour content in the ice only part of the grid box (kg kg-1)
    REAL(KIND=r8) :: Q_CLEAR(POINTS)    !         Vapour content in the cloud free part of the grid box(kg kg-1)
    REAL(KIND=r8) :: QCF_AGG(POINTS)    !         QCF in the form of aggregates (kg kg-1)
    REAL(KIND=r8) :: QCF_CRY(POINTS)    !         QCF in the form of crystals (kg kg-1)
    REAL(KIND=r8) :: FRAC_AGG(POINTS)   !         Fraction of aggregates (no units)
    REAL(KIND=r8) :: TEMP1(POINTS)      !         Temporary arrays for T3E vector functions
    REAL(KIND=r8) :: TEMP3(POINTS)      !         Temporary arrays for T3E vector functions
    REAL(KIND=r8) :: N_DROP(POINTS)     !         Droplet concentration (m-3)
    REAL(KIND=r8) :: A_FACTOR(POINTS)   !         Numerical factors in autoconversion calculation
    REAL(KIND=r8) :: B_FACTOR(POINTS)   !         Numerical factors in autoconversion calculation
    REAL(KIND=r8) :: R_MEAN(POINTS)     !         Mean droplet radius (m)
    REAL(KIND=r8) :: R_MEAN0            !         Constant in the calculation of R_MEAN
    REAL(KIND=r8) :: N_GT_20            !         Concentration of particles greater than a threshold radius in size (m-3)
    REAL(KIND=r8) :: AUTOLIM            !         Minimum water content for autoconversion (kg m-3)
    REAL(KIND=r8) :: AUTORATE           !         Rate constant for autoconversion
    REAL(KIND=r8) :: AC_FACTOR          !         Autoconversion de-biasing factor
    REAL(KIND=r8) :: T_L(POINTS)        !         Subsidiary terms used in the autoconversion de-biasing
    REAL(KIND=r8) :: QSL_TL(POINTS)     !         Subsidiary terms used in the autoconversion de-biasing
    REAL(KIND=r8) :: ALPHA_L            !         Subsidiary terms used in the autoconversion de-biasing
    REAL(KIND=r8) :: A_L                !         Subsidiary terms used in the autoconversion de-biasing
    REAL(KIND=r8) :: SIGMA_S            !         Subsidiary terms used in the autoconversion de-biasing
    REAL(KIND=r8) :: G_L                !         Subsidiary terms used in the autoconversion de-biasing
    REAL(KIND=r8) :: GACB               !         Subsidiary terms used in the autoconversion de-biasing
    REAL(KIND=r8) :: QCFAUTOLIM         !         Minimum ice content for autoconversion (kg/kg)
    REAL(KIND=r8) :: QCFAUTORATE        !         Rate constant for ice autoconversion
    REAL(KIND=r8) :: QCF_TOT(POINTS)    !         Total amount of ice (crystals+aggregates)
    REAL(KIND=r8) :: LHEAT_CORREC_LIQ(POINTS)!         Reduction factor in evaporation limits because of latent heat
    REAL(KIND=r8) :: LHEAT_CORREC_ICE(POINTS)!         Reduction factor in evaporation limits because of latent heat
    REAL(KIND=r8) :: TEMPR              !         Temporary for optimization
    REAL(KIND=r8) :: DQI_DEP
    REAL(KIND=r8) :: DQI_SUB
    REAL(KIND=r8) :: TEMPW_DEP
    REAL(KIND=r8) :: TEMPW_SUB
    REAL(KIND=r8) :: WIDTH(POINTS)
    REAL(KIND=r8) :: Q_ICE_1(POINTS)
    REAL(KIND=r8) :: Q_ICE_2(POINTS)
    REAL(KIND=r8) :: AREA_ICE_1(POINTS)
    REAL(KIND=r8) :: AREA_ICE_2(POINTS)!         Subgrid splitting for deposition term
    LSITER2     =0;    KK =0;    SEA_SALT_PTR=0;    BIOMASS_PTR =0
    OCFF_PTR    =0;    biogenic_ptr=0
    QS=0.0_r8;QSL=0.0_r8;SNOWT_AGG=0.0_r8;SNOWT_CRY=0.0_r8;RHO=0.0_r8;RHOR=0.0_r8;
    ESI=0.0_r8;ESW=0.0_r8;DQI=0.0_r8;DQIL=0.0_r8;DPR=0.0_r8;CFICE=0.0_r8
    CFICEI=0.0_r8;CF=0.0_r8;FQI_AGG=0.0_r8;FQI_CRY=0.0_r8;DHI=0.0_r8;DHIR=0.0_r8;
    DHILSITERR=0.0_r8; FQIRQI_AGG=0.0_r8;FQIRQI2_AGG=0.0_r8;FQIRQI_CRY=0.0_r8;
    FQIRQI2_CRY=0.0_r8;QCLNEW=0.0_r8;TEMP7=0.0_r8;TEMPW=0.0_r8;t_rapid_melt=0.0_r8;
    PR02=0.0_r8;PR04=0.0_r8;QC=0.0_r8;APLUSB=0.0_r8;CORR=0.0_r8;ROCOR=0.0_r8;
    VR1=0.0_r8;VS1=0.0_r8;LAMR1=0.0_r8;LAMR2=0.0_r8;LAMFAC1=0.0_r8;LAMS1=0.0_r8;
    FV1=0.0_r8;TIMESTEP=0.0_r8;CORR2=0.0_r8;RHNUC=0.0_r8;TCG=0.0_r8;
    TCGI=0.0_r8;TCGC=0.0_r8;TCGCI=0.0_r8;RATEQS=0.0_r8;HM_NORMALIZE=0.0_r8;
    HM_RATE=0.0_r8;AREA_LIQ=0.0_r8;AREA_MIX=0.0_r8;AREA_ICE=0.0_r8;AREA_CLEAR=0.0_r8; 
    RAIN_LIQ=0.0_r8;RAIN_MIX=0.0_r8;RAIN_ICE=0.0_r8;RAIN_CLEAR=0.0_r8;Q_ICE=0.0_r8;
    Q_CLEAR=0.0_r8;QCF_AGG=0.0_r8;QCF_CRY=0.0_r8;FRAC_AGG=0.0_r8;TEMP1=0.0_r8;TEMP3=0.0_r8;
    N_DROP=0.0_r8;A_FACTOR=0.0_r8;B_FACTOR=0.0_r8;R_MEAN=0.0_r8;R_MEAN0=0.0_r8;
    N_GT_20=0.0_r8;AUTOLIM=0.0_r8;AUTORATE=0.0_r8;AC_FACTOR=0.0_r8;T_L=0.0_r8;
    QSL_TL=0.0_r8;ALPHA_L=0.0_r8;A_L=0.0_r8;SIGMA_S=0.0_r8;G_L=0.0_r8;
    GACB=0.0_r8;QCFAUTOLIM=0.0_r8;QCFAUTORATE=0.0_r8;QCF_TOT=0.0_r8;
    LHEAT_CORREC_LIQ=0.0_r8;LHEAT_CORREC_ICE=0.0_r8;TEMPR=0.0_r8;DQI_DEP=0.0_r8;
    DQI_SUB=0.0_r8;TEMPW_DEP=0.0_r8;TEMPW_SUB=0.0_r8;WIDTH=0.0_r8;Q_ICE_1=0.0_r8;
    Q_ICE_2=0.0_r8;AREA_ICE_1=0.0_r8;AREA_ICE_2=0.0_r8;
    !
    !  Function and Subroutine calls
    !EXTERNAL NUMBER_DROPLET
    !
    !- End of header
    !
    ! ----------------------------------------------------------------------
    !  2.1 Set up some variables
    ! ----------------------------------------------------------------------
    ! Set up the iterations
    TIMESTEP=TIMESTEPFIXED/LSITER

    DO I=1,POINTS
       ! Set up SNOWT to be zero for all I
       SNOWT_CRY(I) = 0.0_r8
       SNOWT_AGG(I) = 0.0_r8
    END DO

    ! Set qcf for crystals and aggregates depending on
    ! whether there are one or two ice prognostics

    IF (L_mcr_qcf2) THEN ! two ice prognostics

       DO I=1,POINTS
          QCF_CRY(I) = QCF2(I)
          QCF_AGG(I) = QCF(I)
       END DO

    ELSE ! only one ice prognostic, split diagnostically

       DO I=1,POINTS ! Points 0
          ! Work out fraction of ice in aggregates
          FRAC_AGG(I)=MAX(1.0_r8-EXP(-T_SCALING*MAX((T(I)-CTTEMP(I)),0.0_r8)   &
               &               *MAX(QCF(I),0.0_r8)*QCF0) , 0.0_r8)
       END DO ! Points 0
       ! Points_do1:
       DO I=1,POINTS
          ! Allocate ice content to crystals and aggregates
          QCF_CRY(I)=QCF(I)*(1.0_r8-FRAC_AGG(I))
          QCF_AGG(I)=QCF(I)*FRAC_AGG(I)
          ! Assume falling snow is partitioned into crystals and
          ! aggregates, SNOW_AGG contains total snow on input
          SNOW_CRY(I)=SNOW_AGG(I)*(1.0_r8-FRAC_AGG(I))
          SNOW_AGG(I)=SNOW_AGG(I)*FRAC_AGG(I)

          ! The compiler should unroll the above loop so break it here
       END DO
    ENDIF ! on L_mcr_qcf2 (number of ice prognostics)

    DO I=1,POINTS
       QCF_TOT(I) = QCF_CRY(I) + QCF_AGG(I)
    END DO

    ! Set up Hallett Mossop calculation
    HM_NORMALIZE=1.0_r8/(1.0_r8-EXP((HM_T_MIN-HM_T_MAX)*HM_DECAY))
    ! Set up autoconversion factor
    R_MEAN0=(27.0_r8/(80.0_r8*PI*1000.0_r8))**(-1.0_r8/3.0_r8)
    ! ----------------------------------------------------------------------
    !  2.2 Start iterating.
    ! ----------------------------------------------------------------------
    ! Iters_do1:
    DO J=1,LSITER
       ! ----------------------------------------------------------------------
       !  2.3  Calculate saturation specific humidities
       ! ----------------------------------------------------------------------
       ! Qsat with respect to ice
       CALL QSAT_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
            &  )

       !
       ! Qsat with respect to liquid water
       ! 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                &! Real, intent(in)  :: T(npnts) !  Temperature (K).
            &, P                &! Real, 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
            &  )

       ! ----------------------------------------------------------------------
       !  2.4 Start loop over points.
       ! ----------------------------------------------------------------------
       ! Points_do2:
       DO I=1,POINTS
          !
          ! ----------------------------------------------------------------------
          !  3.1 Calculate density of air and density dependent correction factors
          ! ----------------------------------------------------------------------
          ESI(I)=QS(I)*P(I)*ONE_OVER_EPSILON
          ESW(I)=QSL(I)*P(I)*ONE_OVER_EPSILON

          !-----------------------------------------------
          ! Calculate density of air
          !-----------------------------------------------
          IF (l_non_hydrostatic) THEN
             IF (l_mixing_ratio) THEN
                ! rho is the dry density
                rho(i) = rhodz_dry(i) / deltaz(i)
             ELSE
                ! rho is the moist density
                rho(i) = rhodz_moist(i) / deltaz(i)
             END IF  ! l_mixing_ratio
          ELSE
             ! Use the pressure to retrieve the moist density.
             ! An exact expression for the air density is
             ! rho = p / (1+c_virtual q - qcl - qcf) / RT but
             ! the approximation below is more numerically
             ! stable.
             rho(i) = p(i)*(1.0_r8-c_virtual*q(i)+qcl(i)+qcf_tot(i))           &
                  &           /(R*T(i))
          END IF  ! l_non_hydrostatic

          RHOR(I)=1.0_r8/MAX(RHO(I),0.00001_r8)
          ! Estimate latent heat correction to rate of evaporation etc.
          LHEAT_CORREC_LIQ(I)=1.0_r8/(1.0_r8+EPSILON*LC**2*QSL(I)              &
               &                            /(CP*R*T(I)**2))
          LHEAT_CORREC_ICE(I)=1.0_r8/(1.0_r8+EPSILON*(LC+LF)**2*QS(I)          &
               &                            /(CP*R*T(I)**2))
       END DO
       DO I=1,POINTS
          ! Correction factor of fall speeds etc. due to density.
          IF (l_mixing_ratio .AND. l_non_hydrostatic) THEN
             corr(i) = (rho1*deltaz(i) / rhodz_moist(i))**0.4_r8
          ELSE
             corr(i) = (rho1*rhor(i))**0.4_r8
          END IF
          ! Correction factor in viscosity etc. due to temperature.
          CORR2(I)=(T(I)*ONE_OVER_ZERODEGC)**1.5_r8 * (393.0_r8/(T(I)+120.0_r8))
       ENDDO
       DO I=1,POINTS
          ! ----------------------------------------------------------------------
          !  3.2 Calculate particle size distributions. Use vector functions
          !       if available because they are much faster
          ! ----------------------------------------------------------------------
          ! Combined correction factor
          IF (l_mixing_ratio .AND. l_non_hydrostatic) THEN
             rocor(i) = SQRT(rhodz_moist(i)/deltaz(i)*corr(i)*corr2(i))
          ELSE
             rocor(i) = SQRT(rho(i)*corr(i)*corr2(i))
          END IF
          ! Calculate a temperature factor for N0aggregates. CX(32)>0.0
          ! if there is a temperature dependence, and 0.0 if there is not.
          TCG(I)=EXP(-CX(32)*MAX(T(I)-ZERODEGC,T_AGG_MIN))
          ! Temperature dependence for N0crystals
          TCGC(I)=EXP(-CX(12)*MAX(T(I)-ZERODEGC,T_AGG_MIN))
          ! Define inverse of TCG values to speed up calculations
          TCGI(I)=1.0_r8/TCG(I)
          TCGCI(I)=1.0_r8/TCGC(I)
       ENDDO
       DO I=1,POINTS
          !
          ! ----------------------------------------------------------------------
          !  4.1 Check that ice cloud fraction is sensible.
          ! ----------------------------------------------------------------------
          CFICE(I)=MAX(MAX(CFICEKEEP(I),0.01_r8),FRAC_ICE_ABOVE(I))
          CFICEI(I)=1.0_r8/CFICE(I)
          CF(I)=CFKEEP(I)
          CF(I)=MAX(CF(I),CFICE(I))
          ! Break loop to aid efficient pipelining of calculations
       END DO
       DO I=1,POINTS
          RATEQS(I)=RHCPT(I)   ! Sub grid parameter
          FRAC_ICE_ABOVE(I)=CFICEKEEP(I)
          !
          ! ----------------------------------------------------------------------
          !  4.2 Calculate overlaps of liquid, ice and rain fractions
          ! ----------------------------------------------------------------------
          AREA_LIQ(I)=CF(I)-CFICE(I)
          AREA_MIX(I)=CFICE(I)+CFLIQ(I)-CF(I)
          AREA_ICE(I)=CF(I)-CFLIQ(I)
          AREA_CLEAR(I)=1.0_r8-CF(I)
          ! Break loop again since the above can be pipelined and the next loop
          ! the compiler should unroll
       END DO
       DO I=1,POINTS
          RAIN_LIQ(I)=MIN(AREA_LIQ(I),RAINFRAC(I))
          RAIN_MIX(I)=MIN(AREA_MIX(I),RAINFRAC(I)-RAIN_LIQ(I))
          RAIN_ICE(I)=                                                   &
               &            MIN(AREA_ICE(I),RAINFRAC(I)-RAIN_LIQ(I)-RAIN_MIX(I))
          RAIN_CLEAR(I)=RAINFRAC(I)-RAIN_LIQ(I)-RAIN_MIX(I)-RAIN_ICE(I)
       END DO
       DO I=1,POINTS
          ! ----------------------------------------------------------------------
          !  4.3 Calculate vapour contents in ice only and clear regions
          ! ----------------------------------------------------------------------
          IF (CFLIQ(I)  <   1.0_r8) THEN
             ! TEMPW is the mean vapour content in the ice only and clear regions
             TEMPW=(Q(I) - CFLIQ(I)*QSL(I)) / (1.0_r8 - CFLIQ(I))
             TEMP7 = ICE_WIDTH * QSL(I)
             ! 0.001 is to avoid divide by zero problems
             WIDTH(I) = 2.0_r8 *(1.0_r8-RATEQS(I))*QSL(I)                       &
                  &                    *MAX(  (1.0_r8-0.5_r8*QCF(I)/TEMP7),0.001_r8  )
             ! The full width cannot be greater than 2q because otherwise part of
             ! gridbox would have negative q.
             ! However, we must also ensure that a q of zero cannot produce an error.
             WIDTH(I) = MIN(WIDTH(I) ,    MAX(2.0_r8*Q(I),0.001_r8*QS(I) )    )
             IF (AREA_ICE(I)  >   0.0_r8) THEN
                Q_CLEAR(I)= TEMPW - 0.5_r8*WIDTH(I)*AREA_ICE(I)
                Q_ICE(I)=(Q(I)-CFLIQ(I)*QSL(I)-AREA_CLEAR(I)*Q_CLEAR(I))  &
                     &                / AREA_ICE(I)
             ELSE
                Q_CLEAR(I) = TEMPW
                Q_ICE(I)=0.0_r8
             END IF
          ELSE
             ! Q_CLEAR and Q_ICE are undefined. Set them to zero
             WIDTH(I)=1.0_r8
             Q_CLEAR(I)=0.0_r8
             Q_ICE(I)=0.0_r8
          ENDIF
          ! ----------------------------------------------------------------------
          !  4.4 Update ice cloud top temperature if no ice falling in
          ! ----------------------------------------------------------------------
          IF (SNOW_CRY(I)+SNOW_AGG(I)  <=  0.0_r8) THEN
             CTTEMP(I)=T(I)
          ENDIF
          ! ----------------------------------------------------------------------
          !  4.5  Remove any small amount of ice to be tidy.
          !      If QCF is less than QCFMIN and isn't growing
          !      by deposition (assumed to be given by RHCPT) then remove it.
          ! ----------------------------------------------------------------------
          IF (QCF_TOT(I)  <   QCFMIN) THEN
             IF (T(I) >  ZERODEGC .OR.                                    &
                  &       (Q_ICE(I)  <=  QS(I) .AND. AREA_MIX(I)  <=  0.0_r8)           &
                  &       .OR. QCF_TOT(I)  <   0.0_r8)  THEN
                Q(I)=Q(I)+QCF_TOT(I)
                T(I)=T(I)-LSRCP*QCF_TOT(I)
                QCF(I)     = 0.0_r8
                QCF_TOT(I) = 0.0_r8
                QCF_AGG(I) = 0.0_r8
                QCF_CRY(I) = 0.0_r8
             END IF
          END IF
       END DO
       ! ----------------------------------------------------------------------
       !  5.1   Falling ice is advected downwards
       ! ----------------------------------------------------------------------
       ! Estimate fall speed out of this layer. We want to avoid advecting
       ! very small amounts of snow between layers, as this can cause numerical
       ! problems in other routines, so if QCF is smaller than a single
       ! nucleation mass per metre cubed don't advect it.
       DO I=1,POINTS
          IF (QCF_AGG(I) >  M0) THEN
             FQI_AGG(I)=CONSTP(24)*CORR(I)*                               &
                  &     (RHO(I)*QCF_AGG(I)*CONSTP(25)*TCGI(I)*CFICEI(I))**CX(23)
          ELSE
             ! QCF is smaller than zero so set fall speed to zero
             FQI_AGG(I)=0.0_r8
             ! Endif for calculation of fall speed
          END IF
          IF (QCF_CRY(I) >  M0) THEN
             FQI_CRY(I)=CONSTP(4)*CORR(I)*                                &
                  &       (RHO(I)*QCF_CRY(I)*CONSTP(5)*TCGCI(I)*CFICEI(I))**CX(3)
          ELSE
             ! QCF is smaller than zero so set fall speed to zero
             FQI_CRY(I)=0.0_r8
             ! Endif for calculation of fall speed
          END IF
          !
          ! ----------------------------------------------------------------------
          !  5.2 Calculate CFL quantity of timestep over level separation.
          ! ----------------------------------------------------------------------
          IF (l_non_hydrostatic) THEN
             ! Use the formulation based on the heights of the levels
             dhi(i) = timestep/deltaz(i)
          ELSE
             ! Use the formulation based on the pressure difference
             ! across a layer.
             dhi(i)        = timestep * rho(i)/rhodz(i)
          END IF

          ! Define DHIR and DHILSITERR(I) to speed up calculations.
          DHIR(I)=1.0_r8/DHI(I)
          DHILSITERR(I)=1.0_r8/(DHI(I)*LSITER)
          !
          ! ----------------------------------------------------------------------
          !  5.2a Adjust fall speeds to make a linear combination of the fall
          !       speed from the layer above. This ensures that the fall speed of
          !       ice in this layer will not be calculated as zero even though
          !       there is ice falling into it from above.
          ! ----------------------------------------------------------------------
          ! If using two cloud ice prognostics, calculate fallspeeds
          !  separately for crystals and aggregates, in which case
          !  VF represents aggregates, VF_CRY represents crystals
          ! Otherwise calculate an average fallspeed represented by VF

          IF (L_mcr_qcf2) THEN

             ! Crystals
             TEMP7 = SNOW_CRY(I)*DHI(I)*RHOR(I)
             IF (QCF_CRY(I)+TEMP7  >   M0) THEN
                TEMPR = 1.0_r8/(QCF_CRY(I)+TEMP7)
                FQI_CRY(I)=(FQI_CRY(I)*QCF_CRY(I)+VF_CRY(I)*TEMP7)*TEMPR
                VF_CRY(I) = FQI_CRY(I)
             ELSE
                VF_CRY(I)=0.0_r8
             ENDIF

             ! Aggregates
             TEMP7 = SNOW_AGG(I)*DHI(I)*RHOR(I)
             IF (QCF_AGG(I)+TEMP7  >   M0) THEN
                TEMPR = 1.0_r8/(QCF_AGG(I)+TEMP7)
                FQI_AGG(I)=(FQI_AGG(I)*QCF_AGG(I)+VF(I)*TEMP7)*TEMPR
                VF(I) = FQI_AGG(I)
             ELSE
                VF(I)=0.0_r8
             ENDIF

          ELSE ! L_mcr_qcf2=.F.-> use totals to estimate fallspeed

             TEMP7 = (SNOW_AGG(I) + SNOW_CRY(I)) *DHI(I)*RHOR(I)
             IF((QCF_CRY(I)+QCF_AGG(I)+TEMP7)  >   M0) THEN
                TEMPR=1.0_r8 / (QCF_CRY(I)+QCF_AGG(I)+TEMP7)
                FQI_CRY(I)=(FQI_CRY(I)*(QCF_CRY(I)+QCF_AGG(I))+VF(I)*TEMP7)  &
                     &                * TEMPR
                FQI_AGG(I)=(FQI_AGG(I)*(QCF_CRY(I)+QCF_AGG(I))+VF(I)*TEMP7)  &
                     &                * TEMPR
                VF(I)=FQI_CRY(I)*(1.0_r8-FRAC_AGG(I))+FQI_AGG(I)*FRAC_AGG(I)
             ELSE
                VF(I)=0.0_r8
             ENDIF

          ENDIF ! on L_mcr_qcf2
          !
          ! ----------------------------------------------------------------------
          !  5.2b Calculate the additional iterations required by the advection
          ! and melting schemes.
          ! ----------------------------------------------------------------------
          !
          IF ((QCF_CRY(I)+QCF_AGG(I)) >  M0.AND.T(I) >  ZERODEGC.AND.    &
               &       T(I) <  (ZERODEGC+2.0_r8) .AND. l_it_melting) THEN
             LSITER2 = INT(MAX(FQI_CRY(I),FQI_AGG(I))*DHI(I) + 1)
             IF (LSITER2  >   5) THEN
                LSITER2 = 5
             ENDIF
          ELSE
             LSITER2 = 1
          ENDIF
          !
          ! Now start the additional iterations loop
          DO K=1,LSITER2
             !
             ! ----------------------------------------------------------------------
             !  5.3 Analytical Solution
             ! ----------------------------------------------------------------------
             ! FQIRQI2 is used as a temporary for the exponential function
             ! Calculate values point by point
             FQIRQI2_AGG(I)=EXP(-FQI_AGG(I)*DHI(I)/LSITER2)
             FQIRQI2_CRY(I)=EXP(-FQI_CRY(I)*DHI(I)/LSITER2)
             ! Advect aggregates
             IF (FQI_AGG(I)  >   0.0_r8) THEN
                ! Assume falling snow is partitioned into crystals and
                ! aggregates
                FQIRQI_AGG = SNOW_AGG(I)+DHIR(I)*LSITER2*                    &
                     &                  (RHO(I)*QCF_AGG(I)-SNOW_AGG(I)/FQI_AGG(I))      &
                     &                  * (1.0_r8-FQIRQI2_AGG(I))
                QCF_AGG(I) = SNOW_AGG(I)*RHOR(I)/FQI_AGG(I)                  &
                     &                  * (1.0_r8-FQIRQI2_AGG(I))                          &
                     &                  + QCF_AGG(I)*FQIRQI2_AGG(I)
             ELSE  ! No fall of QCF out of the layer
                FQIRQI_AGG = 0.0_r8
                QCF_AGG(I) = SNOW_AGG(I)*RHOR(I)*DHI(I)/LSITER2
             END IF

             ! Advect crystals
             IF (FQI_CRY(I)  >   0.0_r8) THEN
                FQIRQI_CRY = SNOW_CRY(I)+DHIR(I)*LSITER2*                    &
                     &                  (RHO(I)*QCF_CRY(I)-SNOW_CRY(I)/FQI_CRY(I))      &
                     &                  * (1.0_r8-FQIRQI2_CRY(I))
                QCF_CRY(I) = SNOW_CRY(I)*RHOR(I)/FQI_CRY(I)                  &
                     &                  * (1.0_r8-FQIRQI2_CRY(I))                          &
                     &                  + QCF_CRY(I)*FQIRQI2_CRY(I)
             ELSE  ! No fall of QCF out of the layer
                FQIRQI_CRY=0.0_r8
                QCF_CRY(I)=SNOW_CRY(I)*RHOR(I)*DHI(I)/LSITER2
             END IF
             ! No need to compute fall speed out of the layer in this method.
             ! ----------------------------------------------------------------------
             !  5.4 Snow is used to save fall out of layer
             !      for calculation of fall into next layer
             ! ----------------------------------------------------------------------
             SNOWT_CRY(I) = SNOWT_CRY(I) + (FQIRQI_CRY)/(LSITER*LSITER2)
             SNOWT_AGG(I) = SNOWT_AGG(I) + (FQIRQI_AGG)/(LSITER*LSITER2)
             !
             ! ----------------------------------------------------------------------
             !  11  Melting of snow. Uses a numerical approximation to the wet bulb
             !      temperature.
             ! ----------------------------------------------------------------------
             IF (L_it_melting) THEN
                ! Do iterative melting

                IF(QCF_CRY(I) >  M0.AND.T(I) >  ZERODEGC)THEN
                   ! ----------------------------------------------------------------------
                   !  11.1 Crystals first
                   ! ----------------------------------------------------------------------
                   ! An approximate calculation of wet bulb temperature
                   ! TEMPW represents AVERAGE supersaturation in the ice
                   ! Strictly speaking, we need to do two melting calculations,
                   ! for the two different wet bulb temperatures.
                   TEMPW=AREA_ICE(I)*MAX(QSL(I)-Q_ICE(I),0.0_r8)*CFICEI(I)
                   TEMP7=T(I)-ZERODEGC-TEMPW                                    &
                        &           *(TW1+TW2*(P(I)-TW3) - TW4*(T(I)-TW5) )
                   TEMP7=MAX(TEMP7,0.0_r8)
                   ! End of wet bulb temp formulations.
                   PR02=RHO(I)*MAX(QCF_CRY(I),0.0_r8)*CFICEI(I)*CONSTP(5)*TCGCI(I)
                   DPR=TCGC(I)*CONSTP(14)*TIMESTEP/LSITER2*                     &
                        &            (CONSTP(7)*CORR2(I)*PR02**CX(4)                       &
                        &         + CONSTP(8)*ROCOR(I)*PR02**CX(5))*RHOR(I)
                   ! Solve implicitly in terms of temperature
                   DPR=TEMP7*(1.0_r8-1.0_r8/(1.0_r8+DPR*LFRCP))/LFRCP
                   DPR=MIN(DPR,QCF_CRY(I))
                   ! Update values of ice and Rain
                   QCF_CRY(I)=QCF_CRY(I)-DPR
                   RAIN(I)=RAIN(I)+DPR*RHO(I)*DHILSITERR(I)
                   T(I)=T(I)-LFRCP*DPR
                   IF (DPR >  0.0_r8) THEN
                      RAINFRAC(I)=MAX(RAINFRAC(I),CFICE(I))
                      ! Update rain fractions
                      RAIN_LIQ(I)=MIN(AREA_LIQ(I),RAINFRAC(I))
                      RAIN_MIX(I)=MIN(AREA_MIX(I),RAINFRAC(I)-RAIN_LIQ(I))
                      RAIN_ICE(I)=                                               &
                           &            MIN(AREA_ICE(I),RAINFRAC(I)-RAIN_LIQ(I)-RAIN_MIX(I))
                      RAIN_CLEAR(I)=                                             &
                           &            RAINFRAC(I)-RAIN_LIQ(I)-RAIN_MIX(I)-RAIN_ICE(I)
                   ENDIF
                   ! ENDIF for melting snow
                END IF
                !
                ! ----------------------------------------------------------------------
                !  11.1 Aggregates next
                ! ----------------------------------------------------------------------
                IF(QCF_AGG(I) >  M0.AND.T(I) >  ZERODEGC)THEN
                   ! An approximate calculation of wet bulb temperature
                   ! TEMPW represents AVERAGE supersaturation in the ice
                   ! Strictly speaking, we need to do two melting calculations,
                   ! for the two different wet bulb temperatures.
                   TEMPW=AREA_ICE(I)*MAX(QSL(I)-Q_ICE(I),0.0_r8)*CFICEI(I)
                   TEMP7=T(I)-ZERODEGC-TEMPW                                    &
                        &           *(TW1+TW2*(P(I)-TW3) - TW4*(T(I)-TW5) )
                   TEMP7=MAX(TEMP7,0.0_r8)
                   ! End of wet bulb temp formulations.
                   PR02=RHO(I)*MAX(QCF_AGG(I),0.0_r8)*CFICEI(I)*CONSTP(25)*TCGI(I)
                   DPR=TCG(I)*CONSTP(34)*TIMESTEP/LSITER2*                      &
                        &            (CONSTP(27)*CORR2(I)*PR02**CX(24)                     &
                        &         + CONSTP(28)*ROCOR(I)*PR02**CX(25))*RHOR(I)
                   ! Solve implicitly in terms of temperature
                   DPR=TEMP7*(1.0_r8-1.0_r8/(1.0_r8+DPR*LFRCP))/LFRCP
                   DPR=MIN(DPR,QCF_AGG(I))
                   ! Update values of ice and Rain
                   QCF_AGG(I)=QCF_AGG(I)-DPR
                   RAIN(I)=RAIN(I)+DPR*RHO(I)*DHILSITERR(I)
                   T(I)=T(I)-LFRCP*DPR
                   IF (DPR >  0.0_r8) THEN
                      RAINFRAC(I)=MAX(RAINFRAC(I),CFICE(I))
                      ! Update rain fractions
                      RAIN_LIQ(I)=MIN(AREA_LIQ(I),RAINFRAC(I))
                      RAIN_MIX(I)=MIN(AREA_MIX(I),RAINFRAC(I)-RAIN_LIQ(I))
                      RAIN_ICE(I)=                                               &
                           &            MIN(AREA_ICE(I),RAINFRAC(I)-RAIN_LIQ(I)-RAIN_MIX(I))
                      RAIN_CLEAR(I)=                                             &
                           &            RAINFRAC(I)-RAIN_LIQ(I)-RAIN_MIX(I)-RAIN_ICE(I)
                   ENDIF
                   ! ENDIF for melting snow
                END IF

             END IF  ! l_it_melting
             !
             ! End of loop over additional iterations
          ENDDO
          !
          ! ----------------------------------------------------------------------
          !  6.1 Homogenous nucleation takes place at temperatures less than THOMO
          ! ----------------------------------------------------------------------
          IF (T(I) <  (ZERODEGC+THOMO)) THEN
             ! Turn all liquid to ice
             QCF_CRY(I)=QCF_CRY(I)+QCL(I)
             T(I)=T(I)+LFRCP*QCL(I)
             QCL(I)=0.0_r8
          END IF
          ! ----------------------------------------------------------------------
          !  6.2 Heteorgenous nucleation occurs for temps less than TNUC deg C
          ! ----------------------------------------------------------------------
          IF (T(I) <  (ZERODEGC+TNUC).AND.                             &
               &       QCF_TOT(I) <  (1.0E5_r8*M0*RHOR(I))) THEN
             ! Calculate number of active ice nucleii.
             DQI=MIN(0.01_r8*EXP(-0.6_r8*(T(I)-ZERODEGC)),1.0E5_r8)
             ! Each nucleus can grow to arbitary mass of M0 kg
             DQI=M0*DQI*RHOR(I)
             ! DQI is amount of nucleation
             DQI=MAX(DQI-QCF_TOT(I),0.0_r8)
             IF (DQI >  0.0_r8) THEN
                ! RHNUC represents how much moisture is available for ice formation.
                RHNUC=(188.92_r8+2.81_r8*(T(I)-ZERODEGC)                         &
                     &       +0.013336_r8*(T(I)-ZERODEGC)**2)*0.01_r8
                RHNUC=MIN(RHNUC,1.0_r8)-0.1_r8
                ! Predict transfer of mass to ice.
                RHNUC=MAX(QSL(I)*RHNUC,QS(I))
                ! DQIL is amount of moisture available
                DQIL=(QCL(I)+QSL(I)-RHNUC)*CFLIQ(I)                        &
                     &            +MAX(Q_ICE(I)-RHNUC,0.0_r8)*AREA_ICE(I)                  &
                     &            +MAX(Q_CLEAR(I)-RHNUC,0.0_r8)*AREA_CLEAR(I)
                DQI=MAX(MIN(DQI,DQIL*LHEAT_CORREC_ICE(I)),0.0_r8)
                QCF_CRY(I)=QCF_CRY(I)+DQI
                ! This comes initially from liquid water
                DQIL=MIN(DQI,QCL(I))
                QCL(I)=QCL(I)-DQIL
                T(I)=T(I)+LFRCP*DQIL
                ! If more moisture is required then nucleation removes from vapour.
                DQI=DQI-DQIL
                T(I)=T(I)+LSRCP*DQI
                Q(I)=Q(I)-DQI
                ! END IFs for nucleation
             END IF
          END IF
          !
          ! ----------------------------------------------------------------------
          !  7   Deposition/Sublimation of snow.
          !      Hallett Mossop process enhances growth.
          ! ----------------------------------------------------------------------
          ! Assume we can't calculate a meaningful width
          IF (Q_ICE(I)  >   QS(I)) THEN
             ! Deposition
             AREA_ICE_1(I) = AREA_ICE(I)
             AREA_ICE_2(I) = 0.0_r8
             Q_ICE_1(I)    = Q_ICE(I)
             Q_ICE_2(I)    = QS(I)       ! Dummy value
          ELSE
             ! Sublimation
             AREA_ICE_1(I) = 0.0_r8
             AREA_ICE_2(I) = AREA_ICE(I)
             Q_ICE_1(I)    = QS(I)       ! Dummy value
             Q_ICE_2(I)    = Q_ICE(I)
          END IF
          IF (AREA_ICE(I)  >   0.0_r8) THEN
             TEMP7 = 0.5_r8*AREA_ICE(I) + (Q_ICE(I)-QS(I)) / WIDTH(I)
             ! Temp7 is now the estimate of the proportion of the gridbox which
             ! contains ice and has local q greater than saturation wrt ice
             IF (TEMP7  >   0.0_r8 .AND. TEMP7  <   AREA_ICE(I)) THEN
                ! Calculate values of q in each region.
                ! These overwrite previous estimates.
                AREA_ICE_1(I) = TEMP7
                AREA_ICE_2(I) = AREA_ICE(I) - AREA_ICE_1(I)
                Q_ICE_1(I)=QS(I) + 0.5_r8 * AREA_ICE_1(I) * WIDTH(I)
                Q_ICE_2(I)=QS(I) - 0.5_r8 * AREA_ICE_2(I) * WIDTH(I)
             END IF
          END IF
       ENDDO
       !
       DO I=1,POINTS
          IF (QCF_CRY(I) >  M0.AND.T(I) <  ZERODEGC) THEN
             TEMP3(I)=QCF_CRY(I)+QCF_AGG(I)
             ! Diffusional parameters
             APLUSB=(APB1-APB2*T(I))*ESI(I)
             APLUSB=APLUSB+(T(I)**3)*P(I)*APB3
             ! Moisture available from subgrid scale calculation
             TEMPW_DEP = QSL(I)*AREA_MIX(I)                             &
                  &                 + MIN(Q_ICE_1(I),QSL(I)) * AREA_ICE_1(I)         &
                  &                 - QS(I) * (AREA_MIX(I) + AREA_ICE_1(I))
             TEMPW_SUB = (Q_ICE_2(I) - QS(I)) * AREA_ICE_2(I)
             PR02=RHO(I)*MAX(QCF_CRY(I),0.0_r8)                            &
                  &                  *CFICEI(I)*CONSTP(5)*TCGCI(I)
             LAMR1=PR02**CX(4)
             LAMR2=PR02**CX(5)
             ! Transfer rate
             DQI=TCGC(I)*CONSTP(6)*T(I)**2*ESI(I)*                      &
                  &       (CONSTP(7)*CORR2(I)*LAMR1+CONSTP(8)*ROCOR(I)*              &
                  &       LAMR2)/(QS(I)*APLUSB*RHO(I))
             DQI_DEP = DQI * TEMPW_DEP
             DQI_SUB = DQI * TEMPW_SUB
             ! Limits depend on whether deposition or sublimation occurs
             IF (DQI_DEP >  0.0_r8) THEN
                ! Deposition is occuring.
                ! Hallett Mossop Enhancement
                IF ( (T(I)-ZERODEGC)  >=  HM_T_MAX) THEN
                   ! Temperature is greater than maximum threshold for HM.
                   HM_RATE=0.0_r8
                ELSEIF ((T(I)-ZERODEGC)  <   HM_T_MAX                    &
                     ! Temperature is between HM thresholds
                     &           .AND. (T(I)-ZERODEGC)  >   HM_T_MIN) THEN
                   HM_RATE=(1.0_r8-EXP( (T(I)-ZERODEGC-HM_T_MAX)*HM_DECAY) ) &
                        &             *HM_NORMALIZE
                ELSE
                   ! Temperature is less than minimum threshold for HM.
                   HM_RATE=EXP( (T(I)-ZERODEGC-HM_T_MIN)*HM_DECAY)
                ENDIF
                ! Calculate enhancement factor for HM process.
                HM_RATE=1.0_r8+HM_RATE*QCL(I)*HM_RQCL
                ! The molecular diffusion to or from the surface is more efficient
                ! when a particle is at a molecular step. This is more likely when
                ! a particle is subliming. For growth, reduce the rate by 10 percent.
                HM_RATE=0.9_r8*HM_RATE
                TEMPW_DEP=TEMPW_DEP*LHEAT_CORREC_ICE(I)
                ! Calculate Transfer. Limit is available moisture.
                IF (CFLIQ(I) >  0.0_r8) THEN
                   ! Add on liquid water contribution to available moisture
                   ! The latent heat correction at this stage becomes very tedious to
                   ! calculate. Freezing the liquid should raise qsat and hence allow
                   ! for some evaporation of liquid itself. It is best to assume that
                   ! no latent heat effect from the freezing should be employed.
                   TEMPW_DEP=TEMPW_DEP+QCL(I)*AREA_MIX(I)/CFLIQ(I)        &
                        &                    +MAX((Q_ICE_1(I)-QSL(I)),0.0_r8)*AREA_ICE_1(I)
                ENDIF
                DQI_DEP=MIN(DQI_DEP*TIMESTEP*HM_RATE,TEMPW_DEP)
             END IF
             IF (DQI_SUB <  0.0_r8) THEN
                ! Sublimation is occuring. Limits are spare moisture capacity and QCF
                ! outside the liquid cloud
                DQI_SUB=MAX(MAX                                          &
                     &                 (DQI_SUB*TIMESTEP,TEMPW_SUB*LHEAT_CORREC_ICE(I)) &
                     &                 ,-(QCF_CRY(I) * AREA_ICE_2(I) * CFICEI(I) ))
             END IF
             ! Adjust ice content
             QCF_CRY(I)=QCF_CRY(I)+DQI_DEP+DQI_SUB
             !
             IF (CFLIQ(I) >  0.0_r8 .AND. AREA_MIX(I) >  0.0_r8               &
                  &            .AND. QCL(I) >  0.0_r8) THEN
                ! Deposition removes some liquid water content.
                !
                ! First estimate of the liquid water removed is explicit
                DQIL=MAX(MIN( DQI_DEP*AREA_MIX(I)                        &
                     &                /(AREA_MIX(I)+AREA_ICE_1(I)),                     &
                     &                QCL(I)*AREA_MIX(I)/CFLIQ(I)),0.0_r8)
             ELSE
                ! Deposition does not remove any liquid water content
                DQIL=0.0_r8
             ENDIF
             ! Adjust liquid content (deposits before vapour by Bergeron Findeison
             !  process).
             QCL(I)=QCL(I)-DQIL
             T(I)=T(I)+LFRCP*DQIL
             DQI=DQI_DEP+DQI_SUB-DQIL
             ! Adjust vapour content
             Q(I)=Q(I)-DQI
             T(I)=T(I)+LSRCP*DQI
             ! END IF for QCF >  M0.
          END IF
          !
       ENDDO
       ! ----------------------------------------------------------------------
       !  7.2 Now aggregates
       ! ----------------------------------------------------------------------
       DO I=1,POINTS
          IF (QCF_AGG(I) >  M0.AND.T(I) <  ZERODEGC) THEN
             TEMP3(I)=QCF_CRY(I)+QCF_AGG(I)
             ! Diffusional parameters
             APLUSB=(APB1-APB2*T(I))*ESI(I)
             APLUSB=APLUSB+(T(I)**3)*P(I)*APB3
             ! Moisture available from subgrid scale calculation
             TEMPW_DEP = QSL(I)*AREA_MIX(I)                             &
                  &                 + MIN(Q_ICE_1(I),QSL(I)) * AREA_ICE_1(I)         &
                  &                 - QS(I) * (AREA_MIX(I) + AREA_ICE_1(I))
             TEMPW_SUB = (Q_ICE_2(I) - QS(I)) * AREA_ICE_2(I)
             PR02=RHO(I)*MAX(QCF_AGG(I),0.0_r8)                            &
                  &                  *CFICEI(I)*CONSTP(25)*TCGI(I)
             LAMR1=PR02**CX(24)
             LAMR2=PR02**CX(25)
             ! Transfer rate
             DQI=TCGC(I)*CONSTP(26)*T(I)**2*ESI(I)*                     &
                  &       (CONSTP(27)*CORR2(I)*LAMR1+CONSTP(28)*ROCOR(I)*            &
                  &       LAMR2)/(QS(I)*APLUSB*RHO(I))
             DQI_DEP = DQI * TEMPW_DEP
             DQI_SUB = DQI * TEMPW_SUB
             ! Limits depend on whether deposition or sublimation occurs
             IF (DQI_DEP >  0.0_r8) THEN
                ! Deposition is occuring.
                !
                ! The molecular diffusion to or from the surface is more efficient
                ! when a particle is at a molecular step. This is more likely when
                ! a particle is subliming. For growth, reduce the rate by 10 percent.
                DQI_DEP=0.9_r8*DQI_DEP
                TEMPW_DEP=TEMPW_DEP*LHEAT_CORREC_ICE(I)
                ! Calculate Transfer. Limit is available moisture.
                IF (CFLIQ(I) >  0.0_r8) THEN
                   ! Add on liquid water contribution to available moisture
                   TEMPW_DEP=TEMPW_DEP+QCL(I)*AREA_MIX(I)/CFLIQ(I)        &
                        &                    +MAX((Q_ICE_1(I)-QSL(I)),0.0_r8)*AREA_ICE_1(I)
                ENDIF
                DQI_DEP=MIN(DQI_DEP*TIMESTEP,TEMPW_DEP)
             END IF
             IF (DQI_SUB  <   0.0_r8) THEN
                ! Sublimation is occuring. Limits are spare moisture capacity and QCF
                ! outside liquid cloud
                DQI_SUB=MAX(MAX(                                         &
                     &                 DQI_SUB*TIMESTEP,TEMPW_SUB*LHEAT_CORREC_ICE(I))  &
                     &                    ,-(QCF_AGG(I) * AREA_ICE_2(I) * CFICEI(I) ))
             END IF
             ! Adjust ice content
             QCF_AGG(I)=QCF_AGG(I)+DQI_SUB+DQI_DEP
             !
             IF (CFLIQ(I) >  0.0_r8 .AND. AREA_MIX(I) >  0.0_r8               &
                  &            .AND. QCL(I) >  0.0_r8) THEN
                ! Deposition removes some liquid water content.
                !
                ! First estimate of the liquid water removed is explicit
                DQIL=MAX(MIN( DQI_DEP*AREA_MIX(I)                        &
                     &                /(AREA_MIX(I)+AREA_ICE_1(I)),                     &
                     &                QCL(I)*AREA_MIX(I)/CFLIQ(I)),0.0_r8)
             ELSE
                ! Deposition does not remove any liquid water content
                DQIL=0.0_r8
             ENDIF
             ! Adjust liquid content (deposits before vapour by Bergeron Findeison
             !  process).
             QCL(I)=QCL(I)-DQIL
             T(I)=T(I)+LFRCP*DQIL
             DQI=DQI_DEP+DQI_SUB-DQIL
             ! Adjust vapour content
             Q(I)=Q(I)-DQI
             T(I)=T(I)+LSRCP*DQI
             ! END IF for QCF >  M0.
          END IF

          ! ----------------------------------------------------------------------
          !  7.5  Autoconversion of ice crystals to aggregates
          ! ----------------------------------------------------------------------
          IF (L_mcr_qcf2 .AND. QCF_CRY(I) >  M0) THEN

             ! Simple explicit Kessler type param. of autoconversion
             ! Autoconversion rate from Lin et al. (1983)
             ! QCFAUTORATE = 0.005*EXP(0.025*(T(I)-273.16))

             ! Set autoconversion limit to emulate split-ice scheme
             QCFAUTOLIM = (QCF_AGG(I)+QCF_CRY(I))                       &
                  &               *MAX(EXP(-T_SCALING*MAX((T(I)-CTTEMP(I)),0.0_r8)      &
                  &               *MAX(QCF_AGG(I)+QCF_CRY(I),0.0_r8)*QCF0) , 0.0_r8)

             ! Set rate to emulate spilt-ice scheme, i.e. infinite
             QCFAUTORATE = 1.0_r8/TIMESTEP

             QC  = MIN(QCFAUTOLIM,QCF_CRY(I))
             DPR = MIN(QCFAUTORATE*TIMESTEP*(QCF_CRY(I)-QC)             &
                  &                 ,QCF_CRY(I)-QC)

             ! End of calculation of autoconversion amount DPR
             QCF_CRY(I) = QCF_CRY(I)-DPR
             QCF_AGG(I) = QCF_AGG(I)+DPR

          END IF  ! on autoconversion of crystals to agg


          ! ----------------------------------------------------------------------
          !      Transfer processes only active at T less than 0 deg C
          ! ----------------------------------------------------------------------
          IF(T(I) <  ZERODEGC) THEN
             !
             ! ----------------------------------------------------------------------
             !  8   Riming of snow by cloud water -implicit in QCL
             ! ----------------------------------------------------------------------
             IF (QCF_CRY(I) >  M0.AND.QCL(I) >  0.0_r8                       &
                  &         .AND.AREA_MIX(I) >  0.0_r8.AND.CFLIQ(I) >  0.0_r8) THEN
                ! ----------------------------------------------------------------------
                !  8.1 Crystals first
                ! ----------------------------------------------------------------------
                ! Calculate water content of mixed phase region
                QCLNEW=QCL(I)/(CFLIQ(I)+CFLIQ(I)*CONSTP(9)*TCGC(I)*CORR(I) &
                     &                *TIMESTEP*(RHO(I)*QCF_CRY(I)*CFICEI(I)            &
                     &                *CONSTP(5)*TCGCI(I))**CX(6))
                ! Convert to new grid box total water content
                QCLNEW=QCL(I)*AREA_LIQ(I)/CFLIQ(I)+QCLNEW*AREA_MIX(I)
                ! Recalculate water contents
                QCF_CRY(I)=QCF_CRY(I)+(QCL(I)-QCLNEW)
                T(I)=T(I)+LFRCP*(QCL(I)-QCLNEW)
                QCL(I)=QCLNEW
                ! END IF for QCF >  M0.AND.QCL(I) >  0.0
             END IF
             !
             IF (QCF_AGG(I) >  M0.AND.QCL(I) >  0.0_r8                       &
                  &         .AND.AREA_MIX(I) >  0.0_r8.AND.CFLIQ(I) >  0.0_r8) THEN
                ! ----------------------------------------------------------------------
                !  8.2 Aggregates next
                ! ----------------------------------------------------------------------
                ! Calculate water content of mixed phase region
                QCLNEW=QCL(I)/(CFLIQ(I)+CFLIQ(I)*CONSTP(29)*TCG(I)*CORR(I)&
                     &                *TIMESTEP*(RHO(I)*QCF_AGG(I)*CFICEI(I)            &
                     &                *CONSTP(25)*TCGI(I))**CX(26))
                ! Convert to new grid box total water content
                QCLNEW=QCL(I)*AREA_LIQ(I)/CFLIQ(I)+QCLNEW*AREA_MIX(I)
                ! Recalculate water contents
                QCF_AGG(I)=QCF_AGG(I)+(QCL(I)-QCLNEW)
                T(I)=T(I)+LFRCP*(QCL(I)-QCLNEW)
                QCL(I)=QCLNEW
                ! END IF for QCF >  M0.AND.QCL(I) >  0.0
             END IF
             !
             ! ----------------------------------------------------------------------
             !  9   Capture of rain by snow
             ! ----------------------------------------------------------------------
             IF (QCF_CRY(I) >  M0 .AND. RAIN(I)  >   0.0_r8                  &
                  &          .AND. (RAIN_MIX(I)+RAIN_ICE(I)) >  0.0_r8) THEN
                ! ----------------------------------------------------------------------
                !  9.1 Crystals first
                ! ----------------------------------------------------------------------
                ! Calculate velocities
                VR1=CORR(I)*CONSTP(41)/6.0_r8*                                &
                     &              (RAIN(I)/(RAINFRAC(I)*CONSTP(42)*CORR(I)))**CX(41)
                VS1=CONSTP(4)*CORR(I)*(RHO(I)*QCF_CRY(I)*CFICEI(I)         &
                     &           *CONSTP(5)*TCGCI(I))**CX(3)
                ! Estimate the mean absolute differences in velocities.
                FV1=MAX(ABS(VR1-VS1),(VR1+VS1)/8.0_r8)
                ! Calculate functions of slope parameter lambda
                LAMR1=(RAIN(I)/(RAINFRAC(I)*CONSTP(42)*CORR(I)))**(CX(42))
                LAMS1=(RHO(I)*QCF_CRY(I)*CFICEI(I)                         &
                     &               *CONSTP(5)*TCGCI(I))**(-CX(7))
                LAMFAC1=CONSTP(10)*CONSTP(43)*                             &
                     &                 (LAMR1**CX(43)*LAMS1**CX(8)) +                   &
                     &               CONSTP(11)*CONSTP(44)*                             &
                     &                 (LAMR1**CX(44)*LAMS1**CX(9)) +                   &
                     &               CONSTP(12)*CONSTP(45)*                             &
                     &                 (LAMR1**CX(45)*LAMS1**CX(10))
                ! Calculate transfer
                DPR=TCGC(I)*CONSTP(13)*LAMS1**(-CX(11))*LAMR1**(-CX(46))*FV1* &
                     &       LAMFAC1*TIMESTEP*RHOR(I)*(RAIN_MIX(I)+RAIN_ICE(I))
                DPR=MIN(DPR,RAIN(I)*(DHI(I)*LSITER)*RHOR(I)                &
                     &                   *(RAIN_MIX(I)+RAIN_ICE(I))/RAINFRAC(I))
                ! Adjust ice and rain contents
                QCF_CRY(I)=QCF_CRY(I)+DPR
                RAIN(I)=RAIN(I)-DPR*RHO(I)*DHILSITERR(I)
                T(I)=T(I)+LFRCP*DPR
                RAINFRAC(I)=RAINFRAC(I)*RAIN(I)/                           &
                     &                   (RAIN(I)+DPR*RHO(I)*DHILSITERR(I))
                ! Update rain fractions
                RAIN_LIQ(I)=MIN(AREA_LIQ(I),RAINFRAC(I))
                RAIN_MIX(I)=MIN(AREA_MIX(I),RAINFRAC(I)-RAIN_LIQ(I))
                RAIN_ICE(I)=                                               &
                     &            MIN(AREA_ICE(I),RAINFRAC(I)-RAIN_LIQ(I)-RAIN_MIX(I))
                RAIN_CLEAR(I)=                                             &
                     &            RAINFRAC(I)-RAIN_LIQ(I)-RAIN_MIX(I)-RAIN_ICE(I)
                ! Endif for RAIN >  0.0 in capture term
             END IF
             !
             ! ----------------------------------------------------------------------
             !  9.2  Aggregates next
             ! ----------------------------------------------------------------------
             IF (QCF_AGG(I) >  M0 .AND. RAIN(I)  >   0.0_r8                  &
                  &          .AND. (RAIN_MIX(I)+RAIN_ICE(I)) >  0.0_r8) THEN
                ! Calculate velocities
                VR1=CORR(I)*CONSTP(41)/6.0_r8*                                &
                     &              (RAIN(I)/(RAINFRAC(I)*CONSTP(42)*CORR(I)))**CX(41)
                VS1=CONSTP(24)*CORR(I)*(RHO(I)*QCF_AGG(I)*CFICEI(I)        &
                     &           *CONSTP(25)*TCGI(I))**CX(23)
                ! Estimate the mean absolute differences in velocities.
                FV1=MAX(ABS(VR1-VS1),(VR1+VS1)/8.0_r8)
                ! Calculate functions of slope parameter lambda
                LAMR1=(RAIN(I)/(RAINFRAC(I)*CONSTP(42)*CORR(I)))**(CX(42))
                LAMS1=(RHO(I)*QCF_AGG(I)*CFICEI(I)                         &
                     &             *CONSTP(25)*TCGI(I))**(-CX(27))
                LAMFAC1=CONSTP(30)*CONSTP(43)*                             &
                     &                 (LAMR1**CX(43)*LAMS1**CX(28)) +                  &
                     &               CONSTP(31)*CONSTP(44)*                             &
                     &                 (LAMR1**CX(44)*LAMS1**CX(29)) +                  &
                     &               CONSTP(32)*CONSTP(45)*                             &
                     &                 (LAMR1**CX(45)*LAMS1**CX(30))
                ! Calculate transfer
                DPR=TCG(I)*CONSTP(33)*LAMS1**(-CX(31))*LAMR1**(-CX(46))*FV1*  &
                     &       LAMFAC1*TIMESTEP*RHOR(I)*(RAIN_MIX(I)+RAIN_ICE(I))
                DPR=MIN(DPR,RAIN(I)*(DHI(I)*LSITER)*RHOR(I)                &
                     &                   *(RAIN_MIX(I)+RAIN_ICE(I))/RAINFRAC(I))
                ! Adjust ice and rain contents
                QCF_AGG(I)=QCF_AGG(I)+DPR
                RAIN(I)=RAIN(I)-DPR*RHO(I)*DHILSITERR(I)
                T(I)=T(I)+LFRCP*DPR
                RAINFRAC(I)=RAINFRAC(I)*RAIN(I)/                           &
                     &                   (RAIN(I)+DPR*RHO(I)*DHILSITERR(I))
                ! Update rain fractions
                RAIN_LIQ(I)=MIN(AREA_LIQ(I),RAINFRAC(I))
                RAIN_MIX(I)=MIN(AREA_MIX(I),RAINFRAC(I)-RAIN_LIQ(I))
                RAIN_ICE(I)=                                               &
                     &            MIN(AREA_ICE(I),RAINFRAC(I)-RAIN_LIQ(I)-RAIN_MIX(I))
                RAIN_CLEAR(I)=                                             &
                     &            RAINFRAC(I)-RAIN_LIQ(I)-RAIN_MIX(I)-RAIN_ICE(I)
                !      Endif for RAIN >  0.0_r8 in capture term
             END IF
             ! ----------------------------------------------------------------------
             !      End of transfer processes only active at T less than 0 deg C
             ! ----------------------------------------------------------------------
          END IF
          ! ----------------------------------------------------------------------
          !  10  Evaporate melting snow
          ! ----------------------------------------------------------------------
          IF(QCF_CRY(I) >  M0.AND.T(I) >  ZERODEGC)THEN
             ! ----------------------------------------------------------------------
             !  10.1 Crystals first
             ! ----------------------------------------------------------------------
             ! Calculate transfer as a function of QCF, T and specific humidity
             PR02=RHO(I)*MAX(QCF_CRY(I),0.0_r8)*CFICEI(I)*CONSTP(5)*TCGCI(I)
             PR04=((APB4-APB5*T(I))*ESW(I)+APB6*P(I)*T(I)**3)
             DPR=TCGC(I)*CONSTP(6)*T(I)**2*ESW(I)*TIMESTEP*               &
                  &     (CONSTP(7)*CORR2(I)*PR02**CX(4)                              &
                  &      +CONSTP(8)*ROCOR(I)*PR02**CX(5))/(QSL(I)*RHO(I)*PR04)
             ! TEMPW is the subsaturation in the ice region
             TEMPW=AREA_ICE(I)*(QSL(I)-Q_ICE(I))
             DPR=DPR*TEMPW
             DPR=MAX(MIN(DPR,TEMPW*LHEAT_CORREC_LIQ(I)),0.0_r8)
             ! Extra check to see we don't get a negative QCF
             DPR=MIN(DPR,QCF_CRY(I))
             ! Update values of ice and vapour
             QCF_CRY(I)=QCF_CRY(I)-DPR
             Q(I)=Q(I)+DPR
             T(I)=T(I)-DPR*LSRCP
          END IF
          !
          IF(QCF_AGG(I) >  M0.AND.T(I) >  ZERODEGC)THEN
             ! ----------------------------------------------------------------------
             !  10.2 Aggregates next
             ! ----------------------------------------------------------------------
             ! Calculate transfer as a function of QCF, T and specific humidity
             PR02=RHO(I)*MAX(QCF_AGG(I),0.0_r8)*CFICEI(I)*CONSTP(25)*TCGI(I)
             PR04=((APB4-APB5*T(I))*ESW(I)+APB6*P(I)*T(I)**3)
             DPR=TCG(I)*CONSTP(26)*T(I)**2*ESW(I)*TIMESTEP*               &
                  &     (CONSTP(27)*CORR2(I)*PR02**CX(24)                            &
                  &      +CONSTP(28)*ROCOR(I)*PR02**CX(25))/(QSL(I)*RHO(I)*PR04)
             ! TEMPW is the subsaturation in the ice region
             TEMPW=AREA_ICE(I)*(QSL(I)-Q_ICE(I))
             DPR=DPR*TEMPW
             DPR=MAX(MIN(DPR,TEMPW*LHEAT_CORREC_LIQ(I)),0.0_r8)
             ! Extra check to see we don't get a negative QCF
             DPR=MIN(DPR,QCF_AGG(I))
             ! Update values of ice and vapour
             QCF_AGG(I)=QCF_AGG(I)-DPR
             Q(I)=Q(I)+DPR
             T(I)=T(I)-DPR*LSRCP
          END IF
          !
          !
          ! If iterative melting is active then we have already done this term.
          !
          IF (.NOT. l_it_melting) THEN
             ! ----------------------------------------------------------------------
             !  11  Melting of snow. Uses a numerical approximation to the wet bulb
             !      temperature.
             ! ----------------------------------------------------------------------
             IF(QCF_CRY(I) >  M0.AND.T(I) >  ZERODEGC)THEN
                ! ----------------------------------------------------------------------
                !  11.1 Crystals first
                ! ----------------------------------------------------------------------
                ! An approximate calculation of wet bulb temperature
                ! TEMPW represents AVERAGE supersaturation in the ice
                ! Strictly speaking, we need to do two melting calculations,
                ! for the two different wet bulb temperatures.
                TEMPW=AREA_ICE(I)*MAX(QSL(I)-Q_ICE(I),0.0_r8)*CFICEI(I)
                TEMP7=T(I)-ZERODEGC-TEMPW                                    &
                     &           *(TW1+TW2*(P(I)-TW3) - TW4*(T(I)-TW5) )
                TEMP7=MAX(TEMP7,0.0_r8)
                ! End of wet bulb temp formulations.
                PR02=RHO(I)*QCF_CRY(I)*CFICEI(I)*CONSTP(5)*TCGCI(I)
                DPR=TCGC(I)*CONSTP(14)*TIMESTEP*                             &
                     &            (CONSTP(7)*CORR2(I)*PR02**CX(4)                       &
                     &         + CONSTP(8)*ROCOR(I)*PR02**CX(5))*RHOR(I)
                ! Solve implicitly in terms of temperature
                DPR=TEMP7*(1.0_r8-1.0_r8/(1.0_r8+DPR*LFRCP))/LFRCP
                DPR=MIN(DPR,QCF_CRY(I))
                ! Update values of ice and Rain
                QCF_CRY(I)=QCF_CRY(I)-DPR
                RAIN(I)=RAIN(I)+DPR*RHO(I)*DHILSITERR(I)
                T(I)=T(I)-LFRCP*DPR
                IF (DPR >  0.0_r8) THEN
                   RAINFRAC(I)=MAX(RAINFRAC(I),CFICE(I))
                   ! Update rain fractions
                   RAIN_LIQ(I)=MIN(AREA_LIQ(I),RAINFRAC(I))
                   RAIN_MIX(I)=MIN(AREA_MIX(I),RAINFRAC(I)-RAIN_LIQ(I))
                   RAIN_ICE(I)=                                               &
                        &            MIN(AREA_ICE(I),RAINFRAC(I)-RAIN_LIQ(I)-RAIN_MIX(I))
                   RAIN_CLEAR(I)=                                             &
                        &            RAINFRAC(I)-RAIN_LIQ(I)-RAIN_MIX(I)-RAIN_ICE(I)
                ENDIF
                ! ENDIF for melting snow
             END IF
             !
             ! ----------------------------------------------------------------------
             !  11.1 Aggregates next
             ! ----------------------------------------------------------------------
             IF(QCF_AGG(I) >  M0.AND.T(I) >  ZERODEGC)THEN
                ! An approximate calculation of wet bulb temperature
                ! TEMPW represents AVERAGE supersaturation in the ice
                ! Strictly speaking, we need to do two melting calculations,
                ! for the two different wet bulb temperatures.
                TEMPW=AREA_ICE(I)*MAX(QSL(I)-Q_ICE(I),0.0_r8)*CFICEI(I)
                TEMP7=T(I)-ZERODEGC-TEMPW                                    &
                     &           *(TW1+TW2*(P(I)-TW3) - TW4*(T(I)-TW5) )
                TEMP7=MAX(TEMP7,0.0_r8)
                ! End of wet bulb temp formulations.
                PR02=RHO(I)*QCF_AGG(I)*CFICEI(I)*CONSTP(25)*TCGI(I)
                DPR=TCG(I)*CONSTP(34)*TIMESTEP*                              &
                     &            (CONSTP(27)*CORR2(I)*PR02**CX(24)                     &
                     &         + CONSTP(28)*ROCOR(I)*PR02**CX(25))*RHOR(I)
                ! Solve implicitly in terms of temperature
                DPR=TEMP7*(1.0_r8-1.0_r8/(1.0_r8+DPR*LFRCP))/LFRCP
                DPR=MIN(DPR,QCF_AGG(I))
                ! Update values of ice and Rain
                QCF_AGG(I)=QCF_AGG(I)-DPR
                RAIN(I)=RAIN(I)+DPR*RHO(I)*DHILSITERR(I)
                T(I)=T(I)-LFRCP*DPR
                IF (DPR >  0.0_r8) THEN
                   RAINFRAC(I)=MAX(RAINFRAC(I),CFICE(I))
                   ! Update rain fractions
                   RAIN_LIQ(I)=MIN(AREA_LIQ(I),RAINFRAC(I))
                   RAIN_MIX(I)=MIN(AREA_MIX(I),RAINFRAC(I)-RAIN_LIQ(I))
                   RAIN_ICE(I)=                                               &
                        &            MIN(AREA_ICE(I),RAINFRAC(I)-RAIN_LIQ(I)-RAIN_MIX(I))
                   RAIN_CLEAR(I)=                                             &
                        &            RAINFRAC(I)-RAIN_LIQ(I)-RAIN_MIX(I)-RAIN_ICE(I)
                ENDIF
                ! ENDIF for melting snow
             END IF
             !
          END IF  ! l_it_melting
          !
          ! ----------------------------------------------------------------------
          !  12.-1 Evaporate all small rain contents to avoid numerical problems
          ! ----------------------------------------------------------------------
          IF (RAIN(I)  <   ( QCFMIN*DHILSITERR(I)*RHO(I) ) ) THEN
             ! Evaporate all this rain
             DPR=RAIN(I)*RHOR(I)*DHI(I)*LSITER
             T(I)=T(I)-LCRCP*DPR
             Q(I)=Q(I)+DPR
             RAIN(I)=0.0_r8
             ! Update rain fractions
             RAINFRAC(I)=0.0_r8
             RAIN_LIQ(I)=0.0_r8
             RAIN_MIX(I)=0.0_r8
             RAIN_ICE(I)=0.0_r8
             RAIN_CLEAR(I)=0.0_r8
          ENDIF
          ! ----------------------------------------------------------------------
          !      Break loop at this point to use vector multiplication
          ! ----------------------------------------------------------------------
       ENDDO
       !
       ! ----------------------------------------------------------------------
       !  12  Evaporation of rain - implicit in subsaturation
       ! ----------------------------------------------------------------------
       DO I=1,POINTS
          IF(RAIN(I) >  0.0_r8.AND.RAINFRAC(I) >  0.0_r8)THEN
             PR04=((APB4-APB5*T(I))*ESW(I)+APB6*P(I)*T(I)**3)
             ! Define LAMR1 and LAMR2
             LAMR1=RAIN(I)/(CONSTP(42)*CORR(I)*RAINFRAC(I))
             LAMR2=LAMR1**(CX(47)*CX(48))
             LAMR1=LAMR1**(CX(49)*CX(48))
             ! New, consistent evaporation method, with rain fall speed relationship.
             DPR=CONSTP(46)*T(I)**2*ESW(I)*TIMESTEP
             DPR=DPR*( (CONSTP(47)*CORR2(I)*LAMR2)                        &
                  &               + (CONSTP(48)*ROCOR(I)*LAMR1) )
             ! Calculate transfers.
             ! TEMP7 is grid box mean supersaturation. This provides a limit.
             TEMP7=(Q_ICE(I)-QSL(I))*RAIN_ICE(I)                          &
                  &           +(Q_CLEAR(I)-QSL(I))*RAIN_CLEAR(I)
             DPR=DPR*MAX(-TEMP7*LHEAT_CORREC_LIQ(I),0.0_r8)                  &
                  &           /(QSL(I)*RHO(I)*PR04+DPR)
             DPR=DPR*RHO(I)*DHILSITERR(I)
             ! Another limit is on the amount of rain available
             DPR=MIN(DPR,RAIN(I)*                                         &
                  &            (RAIN_ICE(I)+RAIN_CLEAR(I))/RAINFRAC(I))
             ! Update values of rain
             RAIN(I)=RAIN(I)-DPR
             ! Update vapour and temperature
             Q(I)=Q(I)+DPR*DHI(I)*LSITER*RHOR(I)
             T(I)=T(I)-DPR*LCRCP*DHI(I)*LSITER*RHOR(I)
             RAINFRAC(I)=RAINFRAC(I)*RAIN(I)/(RAIN(I)+DPR)
             ! Update rain fractions
             RAIN_LIQ(I)=MIN(AREA_LIQ(I),RAINFRAC(I))
             RAIN_MIX(I)=MIN(AREA_MIX(I),RAINFRAC(I)-RAIN_LIQ(I))
             RAIN_ICE(I)=                                                 &
                  &            MIN(AREA_ICE(I),RAINFRAC(I)-RAIN_LIQ(I)-RAIN_MIX(I))
             RAIN_CLEAR(I)=RAINFRAC(I)-RAIN_LIQ(I)-RAIN_MIX(I)-RAIN_ICE(I)
             ! END IF for evaporation of rain.
          END IF
       END DO
       !
       ! ----------------------------------------------------------------------
       !  13  Accretion of cloud on rain - implicit in liquid water content
       ! ----------------------------------------------------------------------
       KK=0
       DO I=1,POINTS
          IF(RAINFRAC(I) >  0.0_r8.AND.RAIN(I) >  0.0_r8                       &
               &      .AND.CFLIQ(I) >  0.0_r8)THEN
             KK=KK+1
             ! New accretion formulation.
             TEMP1(KK)=RAIN(I)/(RAINFRAC(I)*CONSTP(42)*CORR(I))
             ! QCLNEW is the in cloud water content left
          END IF
       END DO
       KK=0
       DO I=1,POINTS
          IF(RAINFRAC(I) >  0.0_r8.AND.RAIN(I) >  0.0_r8                       &
               &      .AND.CFLIQ(I) >  0.0_r8)THEN
             KK=KK+1
             QCLNEW=QCL(I)/((CFLIQ(I)+CFLIQ(I)*CONSTP(49)*CORR(I)         &
                  &                             *TIMESTEP*TEMP1(KK)**CX(50)))
             ! Convert QCLNEW to a gridbox mean
             ! TEMP7 is overlap of liquid cloud but no rain
             TEMP7=MAX(CFLIQ(I)-RAIN_LIQ(I)-RAIN_MIX(I),0.0_r8)
             QCLNEW=QCLNEW*(RAIN_LIQ(I)+RAIN_MIX(I))+QCL(I)/CFLIQ(I)*TEMP7
             ! Now calculate increments to rain.
             RAIN(I)=RAIN(I)+(QCL(I)-QCLNEW)*RHO(I)*DHILSITERR(I)
             QCL(I)=QCL(I)-(QCL(I)-QCLNEW)
             ! END IF for accretion of cloud on rain.
          END IF
       END DO
       !
       ! ----------------------------------------------------------------------
       !  14  Autoconversion of cloud to rain
       ! ----------------------------------------------------------------------
       ! This looks complicated because there are several routes through
       ! depending on whether we are using a second indirect effect,
       ! have a land or sea point or are using the T3E optimizations. Look
       ! at UMDP 26 to see what is going on.
       !
       KK=0 ! Index counter
       ! ----------------------------------------------------------------------
       !  14.1 Calculate the droplet concentration.
       ! ----------------------------------------------------------------------
       ! There are several possible methods.
       !
       IF (L_AUTOCONV_MURK .AND. L_MURK) THEN ! Use murk aerosol
          DO I=1,POINTS ! Loop b2
             IF (QCL(I) >  0.0_r8.AND.CFLIQ(I) >  0.0_r8) THEN ! Proceed
                KK=KK+1
                ! Convert aerosol mass to droplet number. See subroutine VISBTY
                N_DROP(KK) = MAX(AEROSOL(I)/M0_MURK*1.0E-9_r8, 0.0001_r8)
                !              1.0E-9 converts from ug/kg to kg/kg
                N_DROP(KK)=N0_MURK*N_DROP(KK)**POWER_MURK
             END IF ! Proceed
          END DO ! Loop b2
          !
       ELSE ! Calculate number of droplets either from the sulphate
          !             (and optionally other) aerosol(s) or from a fixed value
          !
          KK=0
          DO I=1, POINTS ! Loop x
             IF (QCL(I)  >   0.0_r8 .AND. CFLIQ(I)  >   0.0_r8) THEN ! Proceed
                IF (L_SEASALT_CCN) THEN
                   SEA_SALT_PTR=I
                ELSE
                   SEA_SALT_PTR=1
                ENDIF
                IF (L_BIOMASS_CCN) THEN
                   BIOMASS_PTR=I
                ELSE
                   BIOMASS_PTR=1
                ENDIF
                IF (L_OCFF_CCN) THEN
                   OCFF_PTR=I
                ELSE
                   OCFF_PTR=1
                ENDIF
                IF (L_biogenic_CCN) THEN
                   biogenic_ptr=I
                ELSE
                   biogenic_ptr=1
                ENDIF
                KK=KK+1
                ! DEPENDS ON: number_droplet
                N_DROP(KK)=NUMBER_DROPLET(&
                     L_USE_SULPHATE_AUTOCONV      , & !  L_AEROSOL_DROPLET, &
                     .FALSE.                      , & !  L_NH42SO4, &
                     !SO4_AIT(I)                  , & ! !AITKEN_SULPHATE  , &
                     SO4_ACC(I)                   , & !  ACCUM_SULPHATE, &
                     SO4_DIS(I)                   , & !  DISS_SULPHATE, &
                     L_SEASALT_CCN                , & !  L_SEASALT_CCN, &
                     SEA_SALT_FILM(SEA_SALT_PTR)  , & !  SEA_SALT_FILM, &
                     SEA_SALT_JET(SEA_SALT_PTR)   , & !  SEA_SALT_JET, &
                     L_biogenic_CCN               , & !  L_BIOGENIC_CCN, &
                     biogenic(biogenic_ptr)       , & !  BIOGENIC , &
                     L_BIOMASS_CCN                , & !  L_BIOMASS_CCN, &
                     BMASS_AGD(BIOMASS_PTR)       , & !  BIOMASS_AGED, &
                     BMASS_CLD(BIOMASS_PTR)       , & !  BIOMASS_CLOUD, &
                     L_OCFF_CCN                   , & !  L_OCFF_CCN, &
                     OCFF_AGD(OCFF_PTR)           , & !  OCFF_AGED, &
                     OCFF_CLD(OCFF_PTR)           , & !  OCFF_CLOUD, &
                     RHO(I)                       , & !  DENSITY_AIR, &
                     SNOW_DEPTH(I)                , & !  SNOW_DEPTH, &
                     LAND_FRACT(I)                , & !  LAND_FRACT, &
                     Ntot_land                    , & !  NTOT_LAND, &
                     Ntot_sea                       ) !  NTOT_SEA   )
             ENDIF ! Proceed
          END DO ! Loop x
          !
       ENDIF
       ! ----------------------------------------------------------------------
       !  14.2 Calculate whether a sufficient concentration of large droplets
       !      is present to allow autoconversion. Calculate its rate.
       ! ----------------------------------------------------------------------
       IF (L_AUTO_DEBIAS) THEN
          DO I=1,POINTS
             T_L(I)=T(I)-(LCRCP*QCL(I))
          END DO
          ! DEPENDS ON: qsat_wat
          !          CALL QSAT_WAT(QSL_TL,T_L,P,POINTS)
          CALL QSAT_WAT (&
               !      Output field
               &  QSL_TL      &!REAL   , INTENT(OUT)  ::  QS(NPNTS) ! SATURATION MIXING RATIO AT TEMPERATURE T AND PRESSURE P (KG/KG)
               !      Input fields
               &, T_L         &!REAL   , INTENT(IN   ) :: T(NPNTS)  !Temperature (K).
               &, P           &!REAL   , INTENT(IN   ) :: P(NPNTS)  !Pressure (Pa).
               !      Array dimensions
               &, POINTS      &!INTEGER, INTENT(IN   ) :: NPNTS  !, INTENT(IN)
               &  )


       ENDIF
       KK=0
       DO I=1,POINTS ! Loop e
          IF (QCL(I) >  0.0_r8.AND.CFLIQ(I) >  0.0_r8) THEN ! Proceed
             KK=KK+1
             ! Non T3E code. This is rather easier to follow.
             !
             ! Calculate inverse of mean droplet size
             R_MEAN(KK)=R_MEAN0*(RHO(I)*QCL(I)                            &
                  &                /(CFLIQ(I)*N_DROP(KK)))**(-1.0_r8/3.0_r8)
             ! Calculate numerical factors
             B_FACTOR(KK)=3.0_r8*R_MEAN(KK)
             A_FACTOR(KK)=N_DROP(KK)*0.5_r8
             ! Calculate droplet number concentration greater than threshold radius
             N_GT_20=(B_FACTOR(KK)**2*A_FACTOR(KK))*R_AUTO**2             &
                  &                                   *EXP(-B_FACTOR(KK)*R_AUTO)     &
                  &            +(2.0_r8*B_FACTOR(KK)*A_FACTOR(KK))*R_AUTO                &
                  &                                   *EXP(-B_FACTOR(KK)*R_AUTO)     &
                  &            +(2.0_r8*A_FACTOR(KK))                                    &
                  &                                   *EXP(-B_FACTOR(KK)*R_AUTO)
             ! Test to see if there is a sufficient concentration of
             ! droplets >20um for autoconversion to proceed (i.e. > N_AUTO):
             IF (N_GT_20  >=  N_AUTO) THEN ! Number
                AUTORATE=CONSTS_AUTO*EC_AUTO                              &
                     &                 *N_DROP(KK)**POWER_DROPLET_AUTO
             ELSE ! Number
                AUTORATE=0.0_r8
             END IF ! Number
             !
             ! ----------------------------------------------------------------------
             !  14.2.1 Optionally de-bias the autoconversion rate.
             ! ----------------------------------------------------------------------
             ! If this option is active, the autoconversion rate is corrected ("de-
             ! biased") based on Wood et al. (Atmos. Res., 65, 109-128, 2002).
             ! This correction should only be used if the second indirect (or "life-
             ! time") effect has been selected (i.e. cloud droplet number is calcul-
             ! ated interactively) and if the diagnostic RHcrit scheme is on (i.e. an
             ! interactive measure of cloud inhomogeneity is available).
             !
             IF (L_AUTO_DEBIAS) THEN

                IF (QCL(I)  <   1.0E-15_r8) THEN  ! Don't bother for very
                   ! small LWCs - avoids
                   AC_FACTOR=1.0_r8                ! AC_FACTOR --> infinity.

                ELSE

                   ALPHA_L=EPSILON*LC*QSL_TL(I)/(R*T_L(I)**2)
                   A_L=1.0_r8/(1.0_r8+(LCRCP*ALPHA_L))
                   SIGMA_S=(1.0_r8-RHCPT(I))*A_L*QSL_TL(I)/SQRT(6.0_r8)
                   G_L=1.15_r8*(POWER_QCL_AUTO-1.0_r8)*SIGMA_S
                   GACB=EXP(-1.0_r8*QCL(I)/G_L)

                   AC_FACTOR=MAX(                                           &
                        &                  (CFLIQ(I)**(POWER_QCL_AUTO-1.0_r8))*1.0_r8/(1.0_r8-GACB) &
                        &                  ,1.0_r8)

                ENDIF

                AUTORATE=AC_FACTOR*AUTORATE

             ENDIF
             !
             ! ----------------------------------------------------------------------
             !  14.3 How much water content can autoconversion remove?
             ! ----------------------------------------------------------------------
             ! Calculate value of local liquid water content at which the droplet
             ! concentration with radii greater than 20um will
             ! fall below a threshold (1000 m-3), and so determine the minimum
             ! liquid water content AUTOLIM: This is a numerical approximation
             ! which ideally could be expressed in terms of N_AUTO and R_AUTO
             ! but isn't.
             AUTOLIM=(6.20E-31_r8*N_DROP(KK)**3)-(5.53E-22_r8*N_DROP(KK)**2)    &
                  &               +(4.54E-13_r8*N_DROP(KK))+(3.71E-6_r8)-(7.59_r8/N_DROP(KK))
             ! Calculate maximum amount of liquid that can be removed from the
             ! grid box
             QC=MIN(AUTOLIM*CFLIQ(I)*RHOR(I),QCL(I))
             ! Calculate autoconversion amount (finally!)
             DPR=MIN(AUTORATE                                             &
                  &              *(RHO(I)*QCL(I)/CFLIQ(I))**(POWER_QCL_AUTO-1.0_r8)     &
                  &              *TIMESTEP*QCL(I)/CORR2(I),QCL(I)-QC)
             ! Update liquid water content and rain
             QCL(I)=QCL(I)-DPR
             RAIN(I)=RAIN(I)+DPR*RHO(I)*DHILSITERR(I)
             ! Update rain fractions
             IF (DPR >  0.0_r8) THEN ! Rain fraction
                RAINFRAC(I)=MAX(RAINFRAC(I),CFLIQ(I))
                RAIN_LIQ(I)=MIN(AREA_LIQ(I),RAINFRAC(I))
                RAIN_MIX(I)=MIN(AREA_MIX(I),RAINFRAC(I)-RAIN_LIQ(I))
                RAIN_ICE(I)=                                               &
                     &            MIN(AREA_ICE(I),RAINFRAC(I)-RAIN_LIQ(I)-RAIN_MIX(I))
                RAIN_CLEAR(I)=                                             &
                     &            RAINFRAC(I)-RAIN_LIQ(I)-RAIN_MIX(I)-RAIN_ICE(I)
             ENDIF ! Rain fraction
          END IF ! Proceed
          ! ----------------------------------------------------------------------
          !  14.4 Remove small rain amounts.
          ! ----------------------------------------------------------------------
          IF (RAIN(I) <= (QCFMIN*DHILSITERR(I)*RHO(I))                   &
                                ! Tidy up rain
               &       .AND.QCL(I) <= 0.0_r8) THEN
             RAINFRAC(I)=0.0_r8
             Q(I)=Q(I)+RAIN(I)*DHI(I)*RHOR(I)*LSITER
             T(I)=T(I)-RAIN(I)*LCRCP*DHI(I)*LSITER*RHOR(I)
             RAIN(I)=0.0_r8
             ! Update rain fractions
             RAINFRAC(I)=0.0_r8
             RAIN_LIQ(I)=0.0_r8
             RAIN_MIX(I)=0.0_r8
             RAIN_ICE(I)=0.0_r8
             RAIN_CLEAR(I)=0.0_r8
          ENDIF ! Tidy up rain
          ! ----------------------------------------------------------------------
          !  15  Now continue the loops over points and iterations.
          ! ----------------------------------------------------------------------
          ! Continue DO loop over points
       END DO ! Loop e or e2
       ! Continue DO loop over iterations
    END DO ! Iters_do1
    !
    ! Copy contents of SNOWT to SNOW, to fall into next layer down
    ! Points_do3
    DO I=1,POINTS
       IF (L_mcr_qcf2) THEN ! two ice prognostics
          QCF(I)  = QCF_AGG(I)
          QCF2(I) = QCF_CRY(I)
          SNOW_CRY(I) = SNOWT_CRY(I)
          SNOW_AGG(I) = SNOWT_AGG(I)
       ELSE ! only one ice prognostic, put all snow in to snow_cry
          QCF(I) = QCF_CRY(I) + QCF_AGG(I)
          SNOW_CRY(I) = 0.0_r8  ! Redundant variable
          SNOW_AGG(I) = SNOWT_CRY(I) + SNOWT_AGG(I)
       ENDIF ! on L_mcr_qcf2
       ! ----------------------------------------------------------------------
       !  16.1 Remove any small amount of QCF which is left over to be tidy.
       !       If QCF is less than QCFMIN and isn't growing
       !       by deposition (assumed to be given by RHCPT) then remove it.
       ! ----------------------------------------------------------------------
       IF (L_mcr_qcf2) THEN

          ! Aggregates
          IF (QCF(I) <  QCFMIN) THEN
             IF (T(I) >  ZERODEGC .OR.                                   &
                  &        (Q_ICE(I)  <=  QS(I) .AND. AREA_MIX(I)  <=  0.0_r8)          &
                  &        .OR. QCF(I) <  0.0_r8) THEN
                Q(I)=Q(I)+QCF(I)
                T(I)=T(I)-LSRCP*QCF(I)
                QCF(I)=0.0_r8
             END IF
          END IF
          ! Crystals
          IF (QCF2(I) <  QCFMIN) THEN
             IF (T(I) >  ZERODEGC .OR.                                   &
                  &        (Q_ICE(I)  <=  QS(I) .AND. AREA_MIX(I)  <=  0.0_r8)          &
                  &        .OR. QCF2(I) <  0.0_r8) THEN
                Q(I)=Q(I)+QCF2(I)
                T(I)=T(I)-LSRCP*QCF2(I)
                QCF2(I)=0.0_r8
                ! Update ice cloud top temperature
                IF (QCF(I) == 0.0_r8) CTTEMP(I)=T(I)
             END IF
          END IF

       ELSE  ! only one prognostic is active

          IF (QCF(I) <  QCFMIN) THEN
             IF (T(I) >  ZERODEGC .OR.                                   &
                  &        (Q_ICE(I)  <=  QS(I) .AND. AREA_MIX(I)  <=  0.0_r8)          &
                  &        .OR. QCF(I) <  0.0_r8) THEN
                Q(I)=Q(I)+QCF(I)
                T(I)=T(I)-LSRCP*QCF(I)
                QCF(I)=0.0_r8
                ! Update ice cloud top temperature
                CTTEMP(I)=T(I)
             END IF
          END IF

       END IF  ! on L_mcr_qcf2

       ! ----------------------------------------------------------------------
       !  16.2 Emergency melting of any excess snow to avoid surface snowfall
       !       at high temperatures.
       ! ----------------------------------------------------------------------
       ! Define rapid melting temperature
       IF (l_it_melting) THEN
          t_rapid_melt = zerodegc + 2.0_r8
       ELSE
          t_rapid_melt = zerodegc
       END IF
       !
       ! Melt SNOW_AGG first
       IF (SNOW_AGG(I)  >   0.0_r8 .AND. T(I)  >   (t_rapid_melt)) THEN
          ! Numerical approximation of wet bulb temperature.
          ! Similar to the melting calculation in section 11.
          TEMPW=AREA_ICE(I)*MAX(QSL(I)-Q_ICE(I),0.0_r8)*CFICEI(I)
          TEMP7=T(I)-ZERODEGC-TEMPW*(TW1+TW2*(P(I)-TW3)-TW4*(T(I)-TW5))
          TEMP7=MAX(TEMP7,0.0_r8)
          ! End of wet bulb calculation
          ! Remember that DHI uses the shortened timestep which is why LSITER
          ! appears in the following statements.
          DPR=TEMP7/(LFRCP*LSITER)
          DPR = MIN(DPR,SNOW_AGG(I)*DHI(I)*RHOR(I))
          ! Update values of snow and rain
          SNOW_AGG(I) = SNOW_AGG(I) - DPR*RHO(I)*DHIR(I)
          RAIN(I)=RAIN(I)+DPR*RHO(I)*DHIR(I)
          T(I)=T(I)-LFRCP*DPR*LSITER
          ! END IF for emergency melting of snow
       END IF

       ! If ice crystals prognostic is active, also melt snow_cry
       IF (L_mcr_qcf2 .AND.                                            &
            &      SNOW_CRY(I)  >   0.0_r8 .AND. T(I)  >   (t_rapid_melt)) THEN
          ! Numerical approximation of wet bulb temperature.
          ! Similar to the melting calculation in section 11.
          TEMPW=AREA_ICE(I)*MAX(QSL(I)-Q_ICE(I),0.0_r8)*CFICEI(I)
          TEMP7=T(I)-ZERODEGC-TEMPW*(TW1+TW2*(P(I)-TW3)-TW4*(T(I)-TW5))
          TEMP7=MAX(TEMP7,0.0_r8)
          ! End of wet bulb calculation
          ! Remember that DHI uses the shortened timestep which is
          ! why LSITER appears in the following statements.
          DPR = TEMP7/(LFRCP*LSITER)
          DPR = MIN(DPR, SNOW_CRY(I)*DHI(I)*RHOR(I))
          ! Update values of snow and rain
          SNOW_CRY(I) = SNOW_CRY(I) - DPR*RHO(I)*DHIR(I)
          RAIN(I)     = RAIN(I)     + DPR*RHO(I)*DHIR(I)
          T(I)        = T(I)        - LFRCP*DPR*LSITER
       END IF  ! on emergency melting of SNOW_CRY
       !
       ! END DO for tidying up small amounts of ice and snow.
    END DO ! Points_do3
    ! ----------------------------------------------------------------------
    !  17  End of the LSP_ICE subroutine
    ! ----------------------------------------------------------------------
    RETURN
  END SUBROUTINE LSP_ICE



  ! *****************************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*******************************
  !
  !*LL  SUBROUTINE LSP_SCAV-----------------------------------------------
  !LL
  !LL  Purpose: Scavenge aerosol by large scale precipitation.
  !LL
  !LL  Model            Modification history from model version 3.0:
  !LL version  Date
  !LL  3.4  15/08/94  New routine. Pete Clark.
  !LL
  !LL  Programming standard: Unified Model Documentation Paper No 3,
  !LL                        Version 7, dated 11/3/93.
  !LL
  !LL  Logical component covered: Part of P26.
  !LL
  !LL  System task:
  !LL
  !LL  Documentation: Unified Model Documentation Paper No 26.
  !*
  !*L  Arguments:---------------------------------------------------------
  SUBROUTINE LSP_SCAV(&
       TIMESTEP   , &!REAL   , INTENT(IN   ) :: TIMESTEP! Input real scalar :- IN Timestep (s).
       POINTS     , &!INTEGER, INTENT(IN   ) :: POINTS  ! Input integer scalar :- IN Number of points to be processed.
       RAIN       , &!REAL   , INTENT(IN   ) :: RAIN(POINTS)  ! Input real arrays :- IN Rate of rainfall in this layer from above! (kg per sq m per s).
       SNOW       , &!REAL   , INTENT(IN   ) :: SNOW(POINTS)  ! IN Rate of snowfall in this layer from above (kg per sq m per s).
       AEROSOL      &!REAL   , INTENT(INOUT) :: AEROSOL(POINTS) ! Updated real arrays :-INOUT Aerosol mixing ratio
       )
    IMPLICIT NONE
    INTEGER, INTENT(IN   ) :: POINTS  ! Input integer scalar :-
    ! IN Number of points to be processed.
    REAL(KIND=r8)   , INTENT(IN   ) :: TIMESTEP! Input real scalar :- IN Timestep (s).
    REAL(KIND=r8)   , INTENT(IN   ) :: RAIN(POINTS)  ! Input real arrays :-
    ! IN Rate of rainfall in this layer from
    ! above
    ! (kg per sq m per s).
    REAL(KIND=r8)   , INTENT(IN   ) :: SNOW(POINTS)  ! IN Rate of snowfall in this layer from
    !       above
    !       (kg per sq m per s).
    REAL(KIND=r8)    , INTENT(INOUT) :: AEROSOL(POINTS) ! Updated real arrays :-
    ! INOUT Aerosol mixing ratio
    !*L   External subprogram called :-
    !     EXTERNAL None
    !-----------------------------------------------------------------------
    !  Define local scalars.
    !-----------------------------------------------------------------------
    !  (a) Reals effectively expanded to workspace by the Cray (using
    !      vector registers).
    REAL(KIND=r8) :: RRAIN
    REAL(KIND=r8) :: RSNOW
    REAL(KIND=r8),PARAMETER  :: KRAIN  =1.0E-4_r8     ! REAL(KIND=r8) workspace.
    REAL(KIND=r8),PARAMETER  :: KSNOW  =1.0E-4_r8     ! REAL(KIND=r8) workspace.
    !  (b) Others.
    INTEGER :: I       ! Loop counter (horizontal field index).
    !
    ! Overall rate = KRAIN*(R) where R is in mm/hr=kg/m2/s*3600.0
    RRAIN=KRAIN*TIMESTEP*3600.0_r8
    RSNOW=KSNOW*TIMESTEP*3600.0_r8
    DO I=1,POINTS
       AEROSOL(I)=AEROSOL(I)/(1.0_r8+RRAIN*RAIN(I)+RSNOW*SNOW(I))
    END DO
    RETURN
  END SUBROUTINE LSP_SCAV





  ! *****************************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*******************************
  !+ Calculates constants used in large-scale precipitation scheme.
  SUBROUTINE LSPCON( &
       CX        , &!REAL, INTENT(OUT   ) :: CX(80)
       CONSTP    , &!REAL, INTENT(OUT   ) :: CONSTP(80)
       x1i       , &!REAL, INTENT(IN   ) ::  x1i  ! Intercept of aggregate size distribution
       x1ic      , &!REAL, INTENT(IN   ) ::  x1ic ! Intercept of crystal size distribution
       x1r       , &!REAL, INTENT(IN   ) ::  x1r  ! Intercept of raindrop size distribution
       x2r       , &!REAL, INTENT(IN   ) ::  x2r  ! Scaling parameter of raindrop size distribution
       x4r         )!REAL, INTENT(IN   ) ::  x4r  ! Shape parameter of raindrop size distribution

    IMPLICIT NONE
    !
    !  Description:
    !     Calculates constants used within the LSP_ICE routine.
    !
    !  Method:
    !     Calculate powers, gamma functions and constants from combinations
    !     of physical parameters selected by the comdecks.
    !
    !  Current Code Owner:  Damian Wilson
    !
    !  History:
    !  Version   Date     Comment
    !   5.2      21/11/00 Original code.  Damian Wilson
    !   5.3      21/11/00 Removes duplicate declarations.  A van der Wal
    !   6.1      01/08/04 Include additional constants for ice crystal,
    !                     aggregate, graupel and rain prognostics R.Forbes
    !   6.2      15/08/05 Free format fixes. P.Selwood.
    !   6.2      23/11/05 Pass through precip variables from UMUI
    !                                               Damian Wilson
    !
    !  Code description:
    !   Language: FORTRAN 77 + common extensions.
    !   This code is written to UMDP3 v6 programming standards.
    !
    ! Declarations:
    !
    ! Global variables:
    ! End C_LSPSIZ
    !
    !, Intent(IN)
    REAL(KIND=r8), INTENT(IN   ) ::  x1i  ! Intercept of aggregate size distribution
    REAL(KIND=r8), INTENT(IN   ) ::  x1ic ! Intercept of crystal size distribution
    REAL(KIND=r8), INTENT(IN   ) ::  x1r  ! Intercept of raindrop size distribution
    REAL(KIND=r8), INTENT(IN   ) ::  x2r  ! Scaling parameter of raindrop size distribution
    REAL(KIND=r8), INTENT(IN   ) ::  x4r  ! Shape parameter of raindrop size distribution
    ! Sets up the size of arrays for CX and CONSTP
    REAL(KIND=r8), INTENT(OUT   ) :: CX(80)
    REAL(KIND=r8), INTENT(OUT   ) :: CONSTP(80)


    ! C_LSPDRP start

    ! Microphysics parameters

    ! Drop size distribution for rain: N(D) =  N0 D^m exp(-lambda D)
    ! where N0 = X1R lambda^X2R  and m=X4R
    !     REAL, PARAMETER :: X1R is set in the UMUI
    !     REAL, PARAMETER :: X2R is set in the UMUI
    !     REAL, PARAMETER :: X4R is set in the UMUI

    ! Drop size distribution for graupel: N(D) =  N0 D^m exp(-lambda D)
    ! where N0 = X1G lambda^X2G  and m=X4G
    REAL(KIND=r8), PARAMETER :: X1G=5.E25_r8
    REAL(KIND=r8), PARAMETER :: X2G=-4.0_r8
    REAL(KIND=r8), PARAMETER :: X4G=2.5_r8

    ! Particle size distribution for ice: N(D) = N0 D^m exp(-lambda D)
    ! where N0 = X1I TCG lambda^X2I, m=X4I and TCG=exp(- X3I T[deg C])
    !     REAL(KIND=r8), PARAMETER :: X1I is set in the UMUI
    REAL(KIND=r8), PARAMETER :: X2I=0.0_r8
    REAL(KIND=r8), PARAMETER :: X3I=0.1222_r8
    REAL(KIND=r8), PARAMETER :: X4I=0.0_r8
    !     REAL(KIND=r8), PARAMETER :: X1IC is set in the UMUI
    REAL(KIND=r8), PARAMETER :: X2IC=0.0_r8
    REAL(KIND=r8), PARAMETER :: X3IC=0.1222_r8
    REAL(KIND=r8), PARAMETER :: X4IC=0.0_r8

    ! Mass diameter relationship for graupel:  m(D) = AG D^BG
    REAL(KIND=r8), PARAMETER :: AG=261.8_r8
    REAL(KIND=r8), PARAMETER :: BG=3.0_r8

    ! Mass diameter relationship for ice:  m(D) = AI D^BI
    REAL(KIND=r8), PARAMETER :: AI=0.0444_r8
    REAL(KIND=r8), PARAMETER :: BI=2.1_r8
    REAL(KIND=r8), PARAMETER :: AIC=0.587_r8
    REAL(KIND=r8), PARAMETER :: BIC=2.45_r8

    ! The area diameter relationships are only used if
    ! L_CALCFALL=.TRUE.
    ! Area diameter relationship for ice:  Area(D) = RI D^SI
    REAL(KIND=r8), PARAMETER :: RI=0.131_r8
    REAL(KIND=r8), PARAMETER :: SI=1.88_r8
    REAL(KIND=r8), PARAMETER :: RIC=0.131_r8
    REAL(KIND=r8), PARAMETER :: SIC=1.88_r8

    ! The Best/Reynolds relationships are only used if
    ! L_CALCFALL=.TRUE.
    ! Relationship between Best number and Reynolds number:
    ! Re(D) =EI Be^FI
    REAL(KIND=r8), PARAMETER :: EI=0.2072_r8
    REAL(KIND=r8), PARAMETER :: FI=0.638_r8
    REAL(KIND=r8), PARAMETER :: EIC=0.2072_r8
    REAL(KIND=r8), PARAMETER :: FIC=0.638_r8

    ! The fall speeds of ice particles are only used if
    ! L_CALCFALL=.FALSE.
    ! Fall speed diameter relationships for ice:
    ! vt(D) = CI D^DI
    REAL(KIND=r8), PARAMETER :: CI0=14.3_r8
    REAL(KIND=r8), PARAMETER :: DI0=0.416_r8
    REAL(KIND=r8), PARAMETER :: CIC0=74.5_r8
    REAL(KIND=r8), PARAMETER :: DIC0=0.640_r8

    ! Axial ratio (c-axis divided by a-axis) ESTIMATES. These are not
    ! consistent with those from the area diameter relationships.
    REAL(KIND=r8), PARAMETER :: AR=1.0_r8
    REAL(KIND=r8), PARAMETER :: ARC=1.0_r8

    ! Fall speed diameter relationship for rain: vt(D) = CR D^DR
    REAL(KIND=r8), PARAMETER :: CR=386.8_r8
    REAL(KIND=r8), PARAMETER :: DR=0.67_r8

    ! Fall speed diameter relationship for graupel: vt(D) = CG D^DG
    REAL(KIND=r8), PARAMETER :: CG=253.0_r8
    REAL(KIND=r8), PARAMETER :: DG=0.734_r8

    ! Do we wish to calculate the ice fall velocities?
    ! TRUE if calculate speeds, FALSE if specify speeds
    LOGICAL, PARAMETER :: L_CALCFALL=.TRUE.
    !*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

    !*----------------------------------------------------------------------
    REAL(KIND=r8),PARAMETER :: RHO_WATER = 1000.0_r8! DENSITY OF WATER (KG/M3)
    !
    !
    !*L------------------COMDECK C_G----------------------------------------
    ! G IS MEAN ACCEL DUE TO GRAVITY AT EARTH'S SURFACE

    REAL(KIND=r8), PARAMETER :: G = 9.80665_r8

    !*----------------------------------------------------------------------
    !*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
    ! --------------------------COMDECK C_LSPDIF---------------------------
    ! input variables
    !
    ! Values of reference variables
    REAL(KIND=r8),PARAMETER:: AIR_DENSITY0=1.0_r8             ! kg m-3
    REAL(KIND=r8),PARAMETER:: AIR_VISCOSITY0=1.717E-5_r8      ! kg m-1 s-1
    REAL(KIND=r8),PARAMETER:: AIR_CONDUCTIVITY0=2.40E-2_r8    ! J m-1 s-1 K-1
    REAL(KIND=r8),PARAMETER:: AIR_DIFFUSIVITY0=2.21E-5_r8     ! m2 s-1
    REAL(KIND=r8),PARAMETER:: AIR_PRESSURE0=1.0E5_r8          ! Pa

    ! Values of diffusional growth parameters
    ! Terms in deposition and sublimation
    REAL(KIND=r8),PARAMETER:: APB1=(LC+LF)**2 * EPSILON /(R*AIR_CONDUCTIVITY0)
    REAL(KIND=r8),PARAMETER:: APB2=(LC+LF) / AIR_CONDUCTIVITY0
    REAL(KIND=r8),PARAMETER:: APB3=R/(EPSILON*AIR_PRESSURE0*AIR_DIFFUSIVITY0)
    ! Terms in evap of melting snow and rain
    REAL(KIND=r8),PARAMETER:: APB4=LC**2*EPSILON/(R*AIR_CONDUCTIVITY0)
    REAL(KIND=r8),PARAMETER:: APB5=LC /AIR_CONDUCTIVITY0
    REAL(KIND=r8),PARAMETER:: APB6=R/(EPSILON*AIR_PRESSURE0*AIR_DIFFUSIVITY0)

    ! Values of numerical approximation to wet bulb temperature
    ! Numerical fit to wet bulb temperature
    REAL(KIND=r8),PARAMETER:: TW1=1329.31_r8
    REAL(KIND=r8),PARAMETER:: TW2=0.0074615_r8
    REAL(KIND=r8),PARAMETER:: TW3=0.85E5_r8
    ! Numerical fit to wet bulb temperature
    REAL(KIND=r8),PARAMETER:: TW4=40.637_r8
    REAL(KIND=r8),PARAMETER:: TW5=275.0_r8

    ! Ventilation parameters
    REAL(KIND=r8),PARAMETER:: SC=0.6_r8
    ! f(v)  =  VENT_ICE1 + VENT_ICE2  Sc**(1/3) * Re**(1/2)
    REAL(KIND=r8),PARAMETER:: VENT_ICE1=0.65_r8
    REAL(KIND=r8),PARAMETER:: VENT_ICE2=0.44_r8
    ! f(v)  =  VENT_RAIN1 + VENT_RAIN2  Sc**(1/3) * Re**(1/2)
    REAL(KIND=r8),PARAMETER:: VENT_RAIN1=0.78_r8
    REAL(KIND=r8),PARAMETER:: VENT_RAIN2=0.31_r8
    !
    ! Subroutine arguments
    !  Obtain the size of CONSTP and CX
    ! Start C_LSPSIZ
    ! Description: Include file containing idealised forcing options
    ! Author:      R. Forbes
    !
    ! History:
    ! Version  Date      Comment
    ! -------  ----      -------
    !   6.1    01/08/04  Increase dimension for rain/graupel.  R.Forbes
    !   6.2    22/08/05  Include the step size between ice categories.
    !                                                   Damian Wilson

    INTEGER,PARAMETER:: ice_type_offset=20


    ! Counter to print out the contents of CX and CONSTP
    REAL(KIND=r8) :: TEMP 
    ! Forms input to the GAMMAF routine which calculates gamma functions.
    REAL(KIND=r8) :: G1, G2, G3
    REAL(KIND=r8) :: GB1, GB2, GB3
    REAL(KIND=r8) :: GBC1, GBD1, GBDC1
    REAL(KIND=r8) :: GC1, GC2, GC3
    REAL(KIND=r8) :: GD3, GDC3, GD52, GDC52
    REAL(KIND=r8) :: GDR3, GDR4, GDR52
    REAL(KIND=r8) :: GR2, GR4, GR5, GR6
    REAL(KIND=r8) :: GG1, GGB1, GGBD1
    REAL(KIND=r8) :: GG2, GDG52, GDG3, GG3
    ! Represents the gamma function of BI+DI+1 etc.
    ! Fall speed of ice particles parameters
    REAL(KIND=r8) :: CI,DI,CIC,DIC
    !
    ! Function and subroutine calls:
    !EXTERNAL GAMMAF
    !
    !- End of header
    !
    ! Do we need to calculate fall speeds?
    IF (L_CALCFALL) THEN
       ! Define fall speeds
       CI=EI*AIR_VISCOSITY0**(1.0_r8-2.0_r8*FI)                       &
            &            *AIR_DENSITY0**(FI-1.0_r8)                               &
            &            *(2.0_r8*G)**FI*(AI/RI)**FI
       DI=FI*(BI+2.0_r8-SI)-1.0_r8
       CIC=EIC*AIR_VISCOSITY0**(1.0_r8-2.0_r8*FIC)                    &
            &            *AIR_DENSITY0**(FIC-1.0_r8)                              &
            &            *(2.0_r8*G)**FIC*(AIC/RIC)**FIC
       DIC=FIC*(BIC+2.0_r8-SIC)-1.0_r8
    ELSE
       ! Use preset parameters
       CI=CI0
       DI=DI0
       CIC=CIC0
       DIC=DIC0
    ENDIF  ! Calculation of fall speeds
    !
    ! CX values. 1-20 are for the crystal population. 21-40 are for the
    ! aggregate population. 41-60 are for rain.
    ! Crystals
    CX(1)=(BIC+1.0_r8+X4IC-X2IC)/BIC
    CX(2)=-(X4IC+1.0_r8-X2IC)/BIC
    CX(3)=DIC/(BIC+1.0_r8+X4IC-X2IC)
    CX(4)=(2.0_r8+X4IC-X2IC)/(BIC+1.0_r8+X4IC-X2IC)
    CX(5)=(5.0_r8+DIC+2.0_r8*X4IC-2.0_r8*X2IC)*0.5_r8/(BIC+1.0_r8+X4IC-X2IC)
    CX(6)=(3.0_r8+DIC+X4IC-X2IC)/(BIC+1.0_r8+X4IC-X2IC)
    CX(7)=1.0_r8/(X2IC-X4IC-1.0_r8-BIC)
    CX(8)=1.0_r8+X4IC
    CX(9)=2.0_r8+X4IC
    CX(10)=3.0_r8+X4IC
    CX(11)=X2IC
    CX(12)=X3IC
    CX(13)=1.0_r8+X4IC+BIC
    CX(14)=BIC

    ! Aggregates
    CX(23)=DI/(BI+1.0_r8+X4I-X2I)
    CX(24)=(2.0_r8+X4I-X2I)/(BI+1.0_r8+X4I-X2I)
    CX(25)=(5.0_r8+DI+2.0_r8*X4I-2.0_r8*X2I)*0.5_r8/(BI+1.0_r8+X4I-X2I)
    CX(26)=(3.0_r8+DI+X4I-X2I)/(BI+1.0_r8+X4I-X2I)
    CX(27)=1.0_r8/(X2I-X4I-1.0_r8-BI)
    CX(28)=1.0_r8+X4I
    CX(29)=2.0_r8+X4I
    CX(30)=3.0_r8+X4I
    CX(31)=X2I
    CX(32)=X3I
    CX(33)=3.0_r8+X4I+BI
    CX(34)=2.0_r8+X4I+BI
    CX(35)=1.0_r8+X4I+BI
    ! Rain
    CX(41)=DR/(4.0_r8+DR-X2R+X4R)
    CX(42)=1.0_r8/(4.0_r8+DR-X2R+X4R)
    CX(43)=6.0_r8+X4R
    CX(44)=5.0_r8+X4R
    CX(45)=4.0_r8+X4R
    CX(46)=X2R
    CX(47)=2.0_r8+X4R-X2R
    CX(48)=1.0_r8/(4.0_r8+X4R+DR-X2R)
    CX(49)=(DR+5.0_r8)*0.5_r8-X2R+X4R
    CX(50)=(3.0_r8+DR-X2R+X4R)/(4.0_r8+DR-X2R+X4R)
    ! Rain mixing ratio
    CX(51)=DR/(4.0_r8-X2R+X4R)
    CX(52)=1.0_r8/(4.0_r8-X2R+X4R)
    CX(53)=(3.0_r8+DR-X2R+X4R)/(4.0_r8-X2R+X4R)
    !
    ! Graupel

    CX(63)=DG/(BG+1.0_r8+X4G-X2G)
    CX(64)=(2.0_r8+X4G-X2G)/(BG+1.0_r8+X4G-X2G)
    CX(65)=(5.0_r8+DG+2.0_r8*X4G-2.0_r8*X2G)*0.5_r8/(BG+1.0_r8+X4G-X2G)
    CX(66)=(3.0_r8+DG+X4G-X2G)/(BG+1.0_r8+X4G-X2G)
    CX(67)=1.0_r8/(X2G-X4G-1.0_r8-BG)
    CX(68)=1.0_r8+X4G
    CX(69)=2.0_r8+X4G
    CX(70)=3.0_r8+X4G
    CX(71)=X2G

    CX(73)=3.0_r8+X4G+BG
    CX(74)=2.0_r8+X4G+BG
    CX(75)=1.0_r8+X4G+BG

    ! Values 69 to 80 are unused
    ! Define gamma values
    ! Crystals
    TEMP=1.0_r8+X4IC
    ! DEPENDS ON: gammaf
    CALL GAMMAF(TEMP,GC1)
    TEMP=BIC+1.0_r8+X4IC
    ! DEPENDS ON: gammaf
    CALL GAMMAF(TEMP,GBC1)
    TEMP=BIC+DIC+1.0_r8+X4IC
    ! DEPENDS ON: gammaf
    CALL GAMMAF(TEMP,GBDC1)
    TEMP=2.0_r8+X4IC
    ! DEPENDS ON: gammaf
    CALL GAMMAF(TEMP,GC2)
    TEMP=(DIC+5.0_r8+2.0_r8*X4IC)*0.5_r8
    ! DEPENDS ON: gammaf
    CALL GAMMAF(TEMP,GDC52)
    TEMP=DIC+3.0_r8+X4IC
    ! DEPENDS ON: gammaf
    CALL GAMMAF(TEMP,GDC3)
    TEMP=3.0_r8+X4IC
    ! DEPENDS ON: gammaf
    CALL GAMMAF(TEMP,GC3)
    ! Aggregates
    TEMP=1.0_r8+X4I
    ! DEPENDS ON: gammaf
    CALL GAMMAF(TEMP,G1)
    TEMP=BI+1.0_r8+X4I
    ! DEPENDS ON: gammaf
    CALL GAMMAF(TEMP,GB1)
    TEMP=BI+2.0_r8+X4I
    ! DEPENDS ON: gammaf
    CALL GAMMAF(TEMP,GB2)
    TEMP=BI+3.0_r8+X4I
    ! DEPENDS ON: gammaf
    CALL GAMMAF(TEMP,GB3)
    TEMP=BI+DI+1.0_r8+X4I
    ! DEPENDS ON: gammaf
    CALL GAMMAF(TEMP,GBD1)
    TEMP=2.0_r8+X4I
    ! DEPENDS ON: gammaf
    CALL GAMMAF(TEMP,G2)
    TEMP=(DI+5.0_r8+2.0_r8*X4I)*0.5_r8
    ! DEPENDS ON: gammaf
    CALL GAMMAF(TEMP,GD52)
    TEMP=DI+3.0_r8+X4I
    ! DEPENDS ON: gammaf
    CALL GAMMAF(TEMP,GD3)
    TEMP=3.0_r8+X4I
    ! DEPENDS ON: gammaf
    CALL GAMMAF(TEMP,G3)
    ! Rain
    TEMP=DR+4.0_r8+X4R
    ! DEPENDS ON: gammaf
    CALL GAMMAF(TEMP,GDR4)
    TEMP=4.0_r8+X4R
    ! DEPENDS ON: gammaf
    CALL GAMMAF(TEMP,GR4)
    TEMP=6.0_r8+X4R
    ! DEPENDS ON: gammaf
    CALL GAMMAF(TEMP,GR6)
    TEMP=5.0_r8+X4R
    ! DEPENDS ON: gammaf
    CALL GAMMAF(TEMP,GR5)
    TEMP=2.0_r8+X4R
    ! DEPENDS ON: gammaf
    CALL GAMMAF(TEMP,GR2)
    TEMP=(DR+5.0_r8+2.0_r8*X4R)*0.5_r8
    ! DEPENDS ON: gammaf
    CALL GAMMAF(TEMP,GDR52)
    TEMP=DR+3.0_r8+X4R
    ! DEPENDS ON: gammaf
    CALL GAMMAF(TEMP,GDR3)
    ! Graupel
    TEMP=1.0_r8+X4G
    ! DEPENDS ON: gammaf
    CALL GAMMAF(TEMP,GG1)
    TEMP=BG+1.0_r8+X4G
    ! DEPENDS ON: gammaf
    CALL GAMMAF(TEMP,GGB1)
    TEMP=BG+DG+1.0_r8+X4G
    ! DEPENDS ON: gammaf
    CALL GAMMAF(TEMP,GGBD1)
    TEMP=2.0_r8+X4G
    ! DEPENDS ON: gammaf
    CALL GAMMAF(TEMP,GG2)
    TEMP=(DG+5.0_r8+2.0_r8*X4G)*0.5_r8
    ! DEPENDS ON: gammaf
    CALL GAMMAF(TEMP,GDG52)
    TEMP=DG+3.0_r8+X4G
    ! DEPENDS ON: gammaf
    CALL GAMMAF(TEMP,GDG3)
    TEMP=3.0_r8+X4G
    ! DEPENDS ON: gammaf
    CALL GAMMAF(TEMP,GG3)

    !
    ! CONSTP values. 1-20 are for the crystal population. 21-40 are for the
    ! aggregate population. 41-60 are for rain.
    ! Crystals
    CONSTP(1)=X1IC
    CONSTP(2)=1.0_r8/GC1
    CONSTP(3)=1.0_r8/(AIC*GBC1)
    CONSTP(4)=CIC*GBDC1/GBC1
    CONSTP(5)=1.0_r8/(AIC*X1IC*GBC1)
    CONSTP(6)=2.0_r8*PI*X1IC
    CONSTP(7)=VENT_ICE1*GC2
    CONSTP(8)=VENT_ICE2*SC**(1.0_r8/3.0_r8)/AIR_VISCOSITY0**0.5_r8      &
         &                 *SQRT(CIC)*GDC52
    CONSTP(9)=PI*0.25_r8*X1IC*CIC*GDC3
    CONSTP(10)=5.0_r8*GC1
    CONSTP(11)=2.0_r8*GC2
    CONSTP(12)=0.25_r8*GC3
    CONSTP(13)=PI**2*RHO_WATER*X1IC*X1R
    CONSTP(14)=2.0_r8*PI*AIR_CONDUCTIVITY0/LF*X1IC
    ! Capacitance relative to spheres of same maximum dimension
    ! Formula depends on value of axial ratio
    CONSTP(15)=ARC
    IF (ARC  >   1.0_r8) THEN
       ! Prolate
       CONSTP(15)=(1.0_r8-(1.0_r8/CONSTP(15))**2)**0.5_r8 /&
            &     LOG( CONSTP(15) + (CONSTP(15)**2-1.0_r8)**0.5_r8 )
    ELSEIF (ARC  ==  1.0_r8) THEN
       ! Spherical
       CONSTP(15)=1.0_r8
    ELSE
       ! Oblate
       CONSTP(15)=(1.0_r8-CONSTP(15)**2)**0.5_r8                      &
            &                    /ASIN((1.0_r8-CONSTP(15)**2)**0.5_r8)
    ENDIF
    ! Now adjust diffusional growth constants for capacitance
    CONSTP(6)=CONSTP(6)*CONSTP(15)
    CONSTP(14)=CONSTP(14)*CONSTP(15)
    !
    ! Values 16 to 23 are unused
    ! Aggregates
    CONSTP(24)=CI*GBD1/GB1
    CONSTP(25)=1.0_r8/(AI*X1I*GB1)
    CONSTP(26)=2.0_r8*PI*X1I
    CONSTP(27)=VENT_ICE1*G2
    CONSTP(28)=VENT_ICE2*SC**(1.0_r8/3.0_r8)/AIR_VISCOSITY0**0.5_r8     &
         &                  *SQRT(CI)*GD52
    CONSTP(29)=PI*0.25_r8*X1I*CI*GD3
    CONSTP(30)=5.0_r8*G1
    CONSTP(31)=2.0_r8*G2
    CONSTP(32)=0.25_r8*G3
    CONSTP(33)=PI**2*RHO_WATER*X1I*X1R
    CONSTP(34)=2.0_r8*PI*AIR_CONDUCTIVITY0/LF*X1I
    ! Capacitance relative to spheres of same maximum dimension
    ! Formula depends on value of axial ratio
    CONSTP(35)=AR
    IF (AR  >   1.0_r8) THEN
       ! Prolate
       CONSTP(35)=(1.0_r8-(1.0_r8/CONSTP(35))**2)**0.5_r8 /              &
            &                    LOG( CONSTP(35) + (CONSTP(35)**2-1.0_r8)**0.5_r8 )
    ELSEIF (AR  ==  1.0_r8) THEN
       ! Spherical
       CONSTP(35)=1.0_r8
    ELSE
       ! Oblate
       CONSTP(35)=(1.0_r8-CONSTP(35)**2)**0.5_r8                      &
            &                    / ASIN((1.0_r8-CONSTP(35)**2)**0.5_r8)
    ENDIF
    ! Now adjust diffusional growth constants for capacitance
    CONSTP(26)=CONSTP(26)*CONSTP(35)
    CONSTP(34)=CONSTP(34)*CONSTP(35)
    !
    CONSTP(36) = GC1*GB3
    CONSTP(37) = 2.0_r8*GC2*GB2
    CONSTP(38) = GC3*GB1
    CONSTP(39) = AI*X1IC*X1I*PI/4.0_r8

    ! Rain
    CONSTP(41)=6.0_r8*CR*GDR4/GR4
    CONSTP(42)=PI*RHO_WATER/6.0_r8*X1R*GDR4*CR
    CONSTP(43)=1.0_r8/120.0_r8*GR6
    CONSTP(44)=1.0_r8/24.0_r8*GR5
    CONSTP(45)=1.0_r8/6.0_r8*GR4
    CONSTP(46)=2.0_r8*PI*X1R
    CONSTP(47)=VENT_RAIN1*GR2
    CONSTP(48)=VENT_RAIN2*SC**(1.0_r8/3.0_r8)/AIR_VISCOSITY0**0.5_r8    &
         &                  *GDR52*SQRT(CR)
    CONSTP(49)=PI*0.25_r8*X1R*CR*GDR3
    CONSTP(50)=1.0_r8/(PI*RHO_WATER*X1R*GR4/6.0_r8)
    ! Values 51 to 60 are unused
    !
    ! Graupel
    CONSTP(64) = CG*GGBD1/GGB1
    CONSTP(65) = 1.0_r8/(AG*X1G*GGB1)
    CONSTP(67) = VENT_RAIN1*GG2
    CONSTP(68) = VENT_RAIN2*SC**(1.0_r8/3.0_r8)/AIR_VISCOSITY0**0.5_r8  &
         &                    *SQRT(CG)*GDG52
    CONSTP(69) = PI*0.25_r8*X1G*CG*GDG3
    CONSTP(74) = 2.0_r8*PI*AIR_CONDUCTIVITY0*X1G/LF
    CONSTP(76) = GG1*GB3
    CONSTP(77) = 2.0_r8*GG2*GB2
    CONSTP(78) = GG3*GB1
    CONSTP(79) = AI*X1G*X1I*PI/4.0_r8

    ! End the subroutine
    RETURN
  END SUBROUTINE LSPCON
  !
  !  SUBROUTINE GAMMAF--------------------------------------------------
  !   PURPOSE: CALCULATES COMPLETE GAMMAF FUNCTION BY
  !   A POLYNOMIAL APPROXIMATION
  ! --------------------------------------------------------------------
  !





  ! *****************************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*******************************
  !+ Calculates constants used in large-scale precipitation scheme.
  !
  !  SUBROUTINE GAMMAF--------------------------------------------------
  !   PURPOSE: CALCULATES COMPLETE GAMMAF FUNCTION BY
  !   A POLYNOMIAL APPROXIMATION
  ! --------------------------------------------------------------------
  SUBROUTINE GAMMAF(Y,GAM)
    IMPLICIT NONE
    REAL(KIND=r8), INTENT(IN   ) :: Y  !, INTENT(IN)
    REAL(KIND=r8), INTENT(OUT  ) :: GAM
    ! Gamma function of Y
    !
    ! LOCAL VARIABLE
    INTEGER :: I,M
    REAL(KIND=r8)    :: GG,G,PARE,X
    ! --------------------------------------------------------------------
    GG=1.0_r8
    M=INT(Y)
    X=Y-M
    IF (M /= 1) THEN
       DO I=1,M-1
          G=Y-I
          GG=GG*G
       END DO
    END IF
    PARE=-0.5748646_r8*X+0.9512363_r8*X*X-0.6998588_r8*X*X*X              &
         +0.4245549_r8*X*X*X*X-0.1010678_r8*X*X*X*X*X+1.0_r8
    GAM=PARE*GG
    RETURN
  END SUBROUTINE GAMMAF
  !



  ! *****************************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*******************************
  !+ Function to calculate cloud droplet number concentration.
  !
  ! Purpose:
  !   Cloud droplet number concentration is calculated from aerosol
  !   concentration or else fixed values are assigned.
  !
  ! Method:
  !   Sulphate aerosol mass concentration is converted to number
  !   concentration by assuming a log-normal size distribution.
  !   Sea-salt and/or biomass-burning aerosols may then
  !   be added if required. The total is then converted to cloud
  !   droplet concentration following the parametrization of
  !   Jones et al. (1994) and lower limits are imposed.
  !   Alternatively, fixed droplet values are assigned if the
  !   parametrization is not required.
  !
  ! Current Owner of Code: A. Jones
  !
  ! History:
  !       Version         Date                    Comment
  !       6.2             20-10-05                Based on NDROP1.
  !                                               Aitken-mode SO4 no
  !                                               longer used & aerosol
  !                                               parameters revised.
  !                                               (A. Jones)
  !
  !
  ! Description of Code:
  !   FORTRAN 77  with extensions listed in documentation.
  !
  !- ---------------------------------------------------------------------
  REAL(KIND=r8) FUNCTION NUMBER_DROPLET( &
       L_AEROSOL_DROPLET, &
       L_NH42SO4        , &
      !AITKEN_SULPHATE  , &
       ACCUM_SULPHATE   , &
       DISS_SULPHATE    , &
       L_SEASALT_CCN    , &
       SEA_SALT_FILM    , &
       SEA_SALT_JET     , &
       L_BIOGENIC_CCN   , &
       BIOGENIC         , &
       L_BIOMASS_CCN    , &
       BIOMASS_AGED     , &
       BIOMASS_CLOUD    , &
       L_OCFF_CCN       , &
       OCFF_AGED        , &
       OCFF_CLOUD       , &
       DENSITY_AIR      , &
       SNOW_DEPTH       , &
       LAND_FRACT       , &
       NTOT_LAND        , &
       NTOT_SEA           )



    IMPLICIT NONE


    !     Comdecks included:
    !*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

    !*----------------------------------------------------------------------


    LOGICAL, INTENT(IN   ) ::  L_AEROSOL_DROPLET !             Flag to use aerosols to find droplet number
    LOGICAL, INTENT(IN   ) ::  L_NH42SO4         !             Is the input "sulphate" aerosol in the form of
    !             ammonium sulphate (T) or just sulphur (F)?
    LOGICAL, INTENT(IN   ) ::  L_SEASALT_CCN     !             Is sea-salt aerosol to be used?
    LOGICAL, INTENT(IN   ) ::  L_BIOMASS_CCN     !             Is biomass smoke aerosol to be used?
    LOGICAL, INTENT(IN   ) ::  L_BIOGENIC_CCN    !             Is biogenic aerosol to be used?
    LOGICAL, INTENT(IN   ) ::  L_OCFF_CCN        !             Is fossil-fuel organic carbon aerosol to be used?

    !      REAL    ::  AITKEN_SULPHATE                  !not use      Dummy in version 2 of the routine
    REAL(KIND=r8)   , INTENT(IN   ) ::  ACCUM_SULPHATE    !             Mixing ratio of accumulation-mode sulphate aerosol
    REAL(KIND=r8)   , INTENT(IN   ) ::  DISS_SULPHATE     !             Mixing ratio of dissolved sulphate aerosol
    REAL(KIND=r8)   , INTENT(IN   ) ::  BIOMASS_AGED      !             Mixing ratio of aged biomass smoke
    REAL(KIND=r8)   , INTENT(IN   ) ::  BIOMASS_CLOUD     !             Mixing ratio of in-cloud biomass smoke
    REAL(KIND=r8)   , INTENT(IN   ) ::  SEA_SALT_FILM     !             Number concentration of film-mode sea salt aerosol (m-3)
    REAL(KIND=r8)   , INTENT(IN   ) ::  SEA_SALT_JET      !             Number concentration of jet-mode sea salt aerosol (m-3)
    REAL(KIND=r8)   , INTENT(IN   ) ::  BIOGENIC          !             Mixing ratio of biogenic aerosol
    REAL(KIND=r8)   , INTENT(IN   ) ::  OCFF_AGED         !             Mixing ratio of aged fossil-fuel organic carbon
    REAL(KIND=r8)   , INTENT(IN   ) ::  OCFF_CLOUD        !             Mixing ratio of in-cloud fossil-fuel organic carbon
    REAL(KIND=r8)   , INTENT(IN   ) ::  DENSITY_AIR       !             Density of air (kg m-3)
    REAL(KIND=r8)   , INTENT(IN   ) ::  SNOW_DEPTH        !             Snow depth (m; >5000 is flag for ice-sheets)
    REAL(KIND=r8)   , INTENT(IN   ) ::  LAND_FRACT        !             Land fraction
    REAL(KIND=r8)   , INTENT(IN   ) ::  NTOT_LAND         !             Droplet number over land if parameterization is off (m-3)
    REAL(KIND=r8)   , INTENT(IN   ) ::  NTOT_SEA          !             Droplet number over sea if parameterization is off (m-3)

    !REAL(KIND=r8)    :: NUMBER_DROPLET     !             Returned number concentration of cloud droplets (m-3)



    !     Local variables:

    REAL(KIND=r8)    ::  PARTICLE_VOLUME   !             Mean volume of aerosol particle
    REAL(KIND=r8)    ::  N_CCN             !             Number density of CCN

    REAL(KIND=r8) ,PARAMETER :: RADIUS_0_NH42SO4=9.5E-8_r8  ! Median radius of log-normal distribution for (NH4)2SO4
    REAL(KIND=r8) ,PARAMETER :: SIGMA_0_NH42SO4=1.4_r8      ! Geometric standard deviation of same
    REAL(KIND=r8) ,PARAMETER :: DENSITY_NH42SO4=1.769E+03_r8! Density of ammonium sulphate aerosol
    REAL(KIND=r8) ,PARAMETER :: RADIUS_0_BIOMASS=1.2E-07_r8 ! Median radius of log-normal distribution for biomass smoke
    REAL(KIND=r8) ,PARAMETER :: SIGMA_0_BIOMASS=1.30_r8     ! Geometric standard deviation of same
    REAL(KIND=r8) ,PARAMETER :: DENSITY_BIOMASS=1.35E+03_r8 ! Density of biomass smoke aerosol
    REAL(KIND=r8) ,PARAMETER :: RADIUS_0_BIOGENIC=9.5E-08_r8! Median radius of log-normal dist. for biogenic aerosol
    REAL(KIND=r8) ,PARAMETER :: SIGMA_0_BIOGENIC=1.50_r8    ! Geometric standard deviation of same
    REAL(KIND=r8) ,PARAMETER :: DENSITY_BIOGENIC=1.3E+03_r8 ! Density of biogenic aerosol
    REAL(KIND=r8) ,PARAMETER :: RADIUS_0_OCFF=0.12E-06_r8   ! Median radius of log-normal dist. for OCFF aerosol
    REAL(KIND=r8) ,PARAMETER :: SIGMA_0_OCFF=1.30_r8        ! Geometric standard deviation of same
    REAL(KIND=r8) ,PARAMETER :: DENSITY_OCFF=1350.0_r8      ! Density of OCFF aerosol




    IF (L_AEROSOL_DROPLET) THEN

       !        If active, aerosol concentrations are used to calculate the
       !        number of CCN, which is then used to determine the number
       !        concentration of cloud droplets (m-3).

       PARTICLE_VOLUME=(4.0E+00_r8*PI/3.0E+00_r8)*RADIUS_0_NH42SO4**3       &
            &                         *EXP(4.5E+00_r8*(LOG(SIGMA_0_NH42SO4))**2)

       IF (L_NH42SO4) THEN
          !           Input data have already been converted to ammonium sulphate.
          N_CCN=(ACCUM_SULPHATE+DISS_SULPHATE)                        &
               &                  *DENSITY_AIR/(DENSITY_NH42SO4*PARTICLE_VOLUME)
       ELSE
          !           Convert m.m.r. of sulphur to ammonium sulphate by
          !           multiplying by ratio of molecular weights:
          N_CCN=(ACCUM_SULPHATE+DISS_SULPHATE)*4.125_r8                  &
               &                  *DENSITY_AIR/(DENSITY_NH42SO4*PARTICLE_VOLUME)
       ENDIF

       IF (L_SEASALT_CCN) THEN
          N_CCN=N_CCN+SEA_SALT_FILM+SEA_SALT_JET
       ENDIF

       IF (L_BIOMASS_CCN) THEN
          PARTICLE_VOLUME=(4.0E+00_r8*PI/3.0E+00_r8)*RADIUS_0_BIOMASS**3    &
               &                         *EXP(4.5E+00_r8*(LOG(SIGMA_0_BIOMASS))**2)
          N_CCN=N_CCN+((BIOMASS_AGED+BIOMASS_CLOUD)*DENSITY_AIR       &
               &                             /(DENSITY_BIOMASS*PARTICLE_VOLUME))
       ENDIF

       IF (L_BIOGENIC_CCN) THEN
          PARTICLE_VOLUME=(4.0E+00_r8*PI/3.0E+00_r8)*RADIUS_0_BIOGENIC**3   &
               &                         *EXP(4.5E+00_r8*(LOG(SIGMA_0_BIOGENIC))**2)
          N_CCN=N_CCN+(BIOGENIC*DENSITY_AIR                           &
               &                             /(DENSITY_BIOGENIC*PARTICLE_VOLUME))
       ENDIF

       IF (L_OCFF_CCN) THEN
          PARTICLE_VOLUME=(4.0E+00_r8*PI/3.0E+00_r8)*RADIUS_0_OCFF**3       &
               &                         *EXP(4.5E+00_r8*(LOG(SIGMA_0_OCFF))**2)
          N_CCN=N_CCN+((OCFF_AGED+OCFF_CLOUD)*DENSITY_AIR             &
               &                             /(DENSITY_OCFF*PARTICLE_VOLUME))
       ENDIF

       !        Apply relation of Jones et al. (1994) to get droplet number
       !        and apply minimum value (equivalent to 5 cm-3):

       NUMBER_DROPLET=3.75E+08_r8*(1.0E+00_r8-EXP(-2.5E-9_r8*N_CCN))

       IF (NUMBER_DROPLET  <   5.0E+06_r8) THEN
          NUMBER_DROPLET=5.0E+06_r8
       ENDIF

       !        If gridbox is more than 20% land AND this land is not covered
       !        by an ice-sheet, use larger minimum droplet number (=35 cm-3):

       IF (LAND_FRACT  >   0.2_r8 .AND. SNOW_DEPTH  <   5000.0_r8           &
            &                        .AND. NUMBER_DROPLET  <   35.0E+06_r8) THEN
          NUMBER_DROPLET=35.0E+06_r8
       ENDIF

    ELSE

       !        Without aerosols, the number of droplets is fixed; a simple
       !        50% criterion is used for land or sea in this case.

       IF (LAND_FRACT  >=  0.5_r8) THEN
          NUMBER_DROPLET=NTOT_LAND
       ELSE
          NUMBER_DROPLET=NTOT_SEA
       ENDIF
       !
    ENDIF
    !
    !
    !
    RETURN
  END FUNCTION NUMBER_DROPLET




  ! *****************************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_data()
    !
    !  Local dynamic arrays-------------------------------------------------
    REAL(KIND=r8) :: ES_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.
    DATA (ES_Aux(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_Aux(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_Aux(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_Aux(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_Aux(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_Aux(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_Aux(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_Aux(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_Aux(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_Aux(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_Aux(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_Aux(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_Aux(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_Aux(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_Aux(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_Aux(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_Aux(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/
    !

    ES=ES_Aux
  END SUBROUTINE qsat_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*******************************
  !
  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/mixing Scheme(Qsat):Vapour to Liquid/Ice
  !
  ! Subroutine Interface:
  SUBROUTINE QSAT_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 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.
    !
    ! 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).
    !    INTEGER(KIND=i8), INTENT(in)  :: mskant(npnts)

    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
    !
    !-----------------------------------------------------------------------
    QmixS=0.0_r8
    !-----------------------------------------------------------------------
    !
    ! loop over points
    !
    DO i = 1, npnts-1,2
       !       IF(mskant(i) == 1_i8)THEN

       !      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)   *ES(itable) + atable*ES(itable+1)
       QmixS(I+1) = (1.0_r8 - atable_p1)*ES(itable_p1) +                 &
            atable_p1*ES(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)   = ( epsilonk*QmixS(I) ) /                            &
               ( MAX(P(I),  1.1_r8*QmixS(I))   - QmixS(I) )
          QmixS(I+1) = ( epsilonk*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)   = ( epsilonk*QmixS(I) ) /                           &
               ( MAX(P(I),  QmixS(I))   - one_minus_epsilon*QmixS(I) )
          QmixS(I+1) = ( epsilonk*QmixS(I+1) ) /                         &
               ( MAX(P(I+1),QmixS(I+1)) - one_minus_epsilon*QmixS(I+1))

       ENDIF  ! test on lq_mix
       !
       !       END IF
    END DO  ! Npnts_do_1

    II = I
    DO I = II, NPNTS
       !       IF(mskant(i) == 1_i8)THEN

       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)*ES(itable) + atable*ES(itable+1)
       QmixS(I) = QmixS(I) * fsubw

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

    RETURN
  END SUBROUTINE QSAT_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*******************************
  !
  !+ Saturation Specific Humidity Scheme (Qsat_Wat): Vapour to Liquid.
  ! Subroutine Interface:
  SUBROUTINE qsat_wat_mix ( &
       !      Output field
       &  QmixS            &! Real, intent(out)   ::  QmixS(npnts)
                                ! Output Saturation mixing ratio or saturation specific
                                ! humidity 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  ! 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
    QmixS=0.0_r8; fsubw=0.0_r8; fsubw_p1 =0.0_r8 ; atable=0.0_r8; atable_p1 =0.0_r8
    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*******************************
  !
  !+ 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/
    !
    QS=0.0_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
  ! ======================================================================
  !===============================================================================
  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
    zi= 0.0_r8;    zm= 0.0_r8;    hkk= 0.0_r8;hkl= 0.0_r8
    rog= 0.0_r8;tv = 0.0_r8;tvfac= 0.0_r8
    !
    !-----------------------------------------------------------------------
    !
    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 Micro_UKME

!PROGRAM Main
!  Use Micro_UKME
!END PROGRAM Main
