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

CONTAINS








! *****************************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 to set the mixing ratios of gases.
!
! Purpose:
!   The full array of mass mixing ratios of gases is filled.
!
! Method:
!   The arrays of supplied mixing ratios are inverted and fed
!   into the array to pass to the radiation code. For well-mixed
!   gases the constant mixing ratios are fed into this array.
!
! Current Owner of Code: J. M. Edwards
!
! History:
!       Version         Date                    Comment
!       4.0             27-07-95                Original Code
!                                               (J. M. Edwards)
!       4.1             10-06-96                Ozone set in lower
!                                               levels.
!                                               (J. M. Edwards)
!       4.4             26-09-97                Conv. cloud amount on
!                                               model levs allowed for.
!                                               J.M.Gregory
!       4.5             18-05-98                Provision for treating
!                                               extra (H)(C)FCs
!                                               included.
!                                               (J. M. Edwards)
!       5.1             06-04-00                Move HCFCs to a more
!                                               natural place in the
!                                               code.
!                                               (J. M. Edwards)
!       5.1             06-04-00                Remove the explicit
!                                               limit on the
!                                               concentration of
!                                               water vapour.
!                                               (J. M. Edwards)
!       5.2             14-11-00                Add provision for an
!                                               extra radiative layer
!                                               above the top of the
!                                               model.
!                                               (J. M. Edwards)
!       5.4             29-05-02                Add diagnostic call
!                                               for column-integrated
!                                               cloud droplet number.
!                                               (A. Jones)
!       5.4             25-04-02                Replace land/sea mask
!                                               with land fraction in
!                                               call to NUMBER_DROPLET
!                                               (A. Jones)
!       5.5             17-02-03                Change I_CLIM_POINTER
!                                               for hp compilation
!                                               (M.Hughes)
!  6.1   20/08/03  Code for STOCHEM feedback.  C. Johnson
!       6.2             21/02/06   Updefs Added for version
!                                  control of radiation code
!                                            (J.-C. Thelen)
!  6.2   03-11-05   Enable HadGEM1 climatological aerosols. C. F. Durman
!                   Reworked to use switch instead of #defined. R Barnes
!  6.2   25/05/05  Convert compilation into a more universally portable
!                  form. Tom Edwards
!  6.2   15/12/05  Set negative specific humidities to zero.
!                                               (J. Manners)
!
! Description of Code:
!   FORTRAN 77  with extensions listed in documentation.
!
!- ---------------------------------------------------------------------
!+ Subroutine to set thermodynamic properties
!
! Purpose:
!   Pressures, temperatures at the centres and edges of layers
!   and the masses in layers are set.
!
! Method:
!   Straightforward.
!
! Current Owner of Code: J. M. Edwards
!
! History:
!       Version         Date                    Comment
!       4.0             27-07-95                Original Code
!                                               (J. M. Edwards)
!       4.1             10-06-96                Old formulation over
!                                               sea-ice removed.
!                                               (J. M. Edwards)
!       4.2             08-08-96                Ground temperature
!                                               set equal to that
!                                               in the middle of the
!                                               bottom layer.
!                                               (J. M. Edwards)
!       5.2             14-11-00                Add provision for an
!                                               extra radiative layer
!                                               above the top of the
!                                               model.
!                                               (J. M. Edwards)
!       5.3             25-04-01                Alter the specification
!                                               of temperature on rho
!                                               levels (layer
!                                               boundaries).  S.Cusack
!       5.3             25-04-01   Gather land, sea and
!                                  sea-ice temperatures and
!                                  land fraction. Replace TFS
!                                  with general sea temperature.
!                                       (N. Gedney)
!
! Description of Code:
!   FORTRAN 77  with extensions listed in documentation.
!
!- ---------------------------------------------------------------------
!+ Subroutine to assign Properties of Clouds.
!
! Purpose:
!   The fractions of different types of clouds and their microphysical
!   preoperties are set.
!
! Method:
!   Straightforward.
!
! Current Owner of Code: J. M. Edwards
!
! History:
!       Version         Date                    Comment
!       4.0             27-07-95                Original Code
!                                               (J. M. Edwards)
!       4.1             10-06-96                New flag L_AEROSOL_CCN
!                                               introduced to allow
!                                               inclusion of indirect
!                                               aerosol forcing alone.
!                                               Correction of comments
!                                               for LCCWC1 and LCCWC2.
!                                               Correction of level at
!                                               which temperature for
!                                               partitioning
!                                               convective homogeneously
!                                               mixed cloud is taken.
!                                               (J. M. Edwards)
!       4.4             08-04-97                Changes for new precip
!                                               scheme (qCF prognostic)
!                                               (A. C. Bushell)
!       4.4             15-09-97                A parametrization of
!                                               ice crystals with a
!                                               temperature dependedence
!                                               of the size has been
!                                               added.
!                                               Explicit checking of
!                                               the sizes of particles
!                                               for the domain of
!                                               validity of the para-
!                                               metrization has been
!                                               added.
!                                               (J. M. Edwards)
!       5.0             15-04-98   Changes to R2_SET_CLOUD_FIELD to use
!                                  original sect 9 cloud fraction when
!                                  an extended 'area' cloud fraction is
!                                  used everywhere else in Radiation.
!                                  A.C.Bushell
!       4.5             18-05-98                New option for
!                                               partitioning between
!                                               ice and water in
!                                               convective cloud
!                                               included.
!                                               (J. M. Edwards)
!       4.5             13/05/98   Changes to R2_SET_CLOUD_FIELD to use
!                                  original sect 9 cloud fraction when
!                                  an extended 'area' cloud fraction is
!                                  used everywhere else in Radiation.
!                                  S. Cusack
!       5.1             04-04-00                Remove obsolete tests
!                                               for convective cloud
!                                               and removal of very
!                                               thin cloud (no longer
!                                               required with current
!                                               solvers, but affects
!                                               bit-comparison).
!                                               (J. M. Edwards)
!       5.1             06-04-00                Correct some comments
!                                               and error messages.
!                                               (J. M. Edwards)
!       5.2             10-11-00                With local partitioning
!                                               of convective cloud
!                                               between water and ice
!                                               force homogeneous
!                                               nucleation at
!                                               -40 Celsius.
!       5.2             14-11-00                Add provision for an
!                                               extra radiative layer
!                                               above the top of the
!                                               model.
!                                               (J. M. Edwards)
!       5.2             15-11-00                Pass sea-salt variables
!                                               down to R2_RE_MRF_UMIST.
!                                               (A. Jones)
!       5.3             11-10-01                Convert returned
!                                               diagnostics to 2-D
!                                               arrays.
!                                               (J. M. Edwards)
!       5.4             22-07-02                Check on small cloud
!                                               fractions and liquid for
!                                               contents for PC2 scheme.
!                                               (D. Wilson)
!       5.5             24-02-03                Addition of new ice
!                                               aggregate
!                                               parametrization.
!                                               (J. M. Edwards)
!       6.1             07-04-04                Add biomass smoke
!                                               aerosol to call to
!                                               R2_RE_MRF_UMIST.
!                                               (A. Jones)
!       6.1             07-04-04                Add variables for
!                                               column-droplet
!                                               calculation.
!                                               (A. Jones)
!       6.2             24-11-05                Pass Ntot_land and
!                                               Ntot_sea from UMUI.
!                                               (Damian Wilson)
!       6.2             02-03-05                Pass through PC2 logical
!                                               (Damian Wilson)
!
!
! Description of Code:
!   FORTRAN 77  with extensions listed in documentation.
!
!- ---------------------------------------------------------------------
      SUBROUTINE R2_SET_CLOUD_FIELD( &
       N_PROFILE               , &
       NLEVS                   , &
       N_LAYER                 , &
       NCLDS                   , &
       I_GATHER                , &
       P                       , &
       T                       , &
       D_MASS                  , &
       CCB                     , &
       CCT                     , &
       CCA                     , &
       CCCWP                   , &
       LCCWC1                  , &
       LCCWC2                  , &
       LCA_AREA                , &
       LCA_BULK                , &
       L_PC2                   , &
       L_MICROPHYSICS          , &
       L_AEROSOL_CCN           , &
       SEA_SALT_FILM           , &
       SEA_SALT_JET            , &
       L_SEASALT_CCN           , &
       SALT_DIM_A              , &
       SALT_DIM_B              , &
       L_USE_BIOGENIC          , &
       BIOGENIC                , &
       BIOGENIC_DIM1           , &
       BIOGENIC_DIM2           , &
       SULP_DIM1               , &
       SULP_DIM2               , &
       ACCUM_SULPHATE          , &
       DISS_SULPHATE           , &
       AITKEN_SULPHATE         , &
       L_BIOMASS_CCN           , &
       BMASS_DIM1              , &
       BMASS_DIM2              , &
       AGED_BMASS              , &
       CLOUD_BMASS             , &
       L_OCFF_CCN              , &
       OCFF_DIM1               , &
       OCFF_DIM2               , &
       AGED_OCFF               , &
       CLOUD_OCFF              , &
       LYING_SNOW              , &
       L_CLOUD_WATER_PARTITION , &
       LAND_G                  , &
       FLANDG_G                , &
       I_CLOUD_REPRESENTATION  , &
       I_CONDENSED_PARAM       , &
       CONDENSED_MIN_DIM       , &
       CONDENSED_MAX_DIM       , &
       N_CONDENSED             , &
       TYPE_CONDENSED          , &
       W_CLOUD                 , &
       FRAC_CLOUD              , &
       L_LOCAL_CNV_PARTITION   , &
       CONDENSED_MIX_RAT_AREA  , &
       CONDENSED_DIM_CHAR      , &
       RE_CONV                 , &
       RE_CONV_FLAG            , &
       RE_STRAT                , &
       RE_STRAT_FLAG           , &
       WGT_CONV                , &
       WGT_CONV_FLAG           , &
       WGT_STRAT               , &
       WGT_STRAT_FLAG          , &
       LWP_STRAT               , &
       LWP_STRAT_FLAG          , &
       NTOT_DIAG               , &
       NTOT_DIAG_FLAG          , &
       STRAT_LWC_DIAG          , &
       STRAT_LWC_DIAG_FLAG     , &
       SO4_CCN_DIAG            , &
       SO4_CCN_DIAG_FLAG       , &
       COND_SAMP_WGT           , &
       COND_SAMP_WGT_FLAG      , &
       NC_DIAG                 , &
       NC_DIAG_FLAG            , &
       NC_WEIGHT               , &
       NC_WEIGHT_FLAG          , &
       col_list                , &
       row_list                , &
       row_length              , &
       rows                    , &
       NPD_FIELD               , &
       NPD_PROFILE             , &
       NPD_LAYER               , &
       NPD_AEROSOL_SPECIES     , &
       N_CCA_LEV               , &
       L_3D_CCA                , &
       Ntot_land               , &
       Ntot_sea                  )
!
!
!
      IMPLICIT NONE

!
!     COMDECKS INCLUDED.
! DIMFIX3A defines internal dimensions tied to algorithms for
! two-stream radiation code, mostly for clouds

      ! number of components of clouds
      INTEGER,PARAMETER:: NPD_CLOUD_COMPONENT=4

      ! number of permitted types of clouds.
      INTEGER,PARAMETER:: NPD_CLOUD_TYPE=4

      ! number of permitted representations of clouds.
      INTEGER,PARAMETER:: NPD_CLOUD_REPRESENTATION=4

      ! number of overlap coefficients for clouds
      INTEGER,PARAMETER:: NPD_OVERLAP_COEFF=18

      ! number of coefficients for two-stream sources
      INTEGER,PARAMETER:: NPD_SOURCE_COEFF=2

      ! number of regions in a layer
      INTEGER,PARAMETER:: NPD_REGION=3

! DIMFIX3A end
! CLDCMP3A sets components of clouds for two-stream radiation code.

      ! stratiform water droplets
      INTEGER,PARAMETER:: IP_CLCMP_ST_WATER=1

      ! stratiform ice crystals
      INTEGER,PARAMETER:: IP_CLCMP_ST_ICE=2

      ! convective water droplets
      INTEGER,PARAMETER:: IP_CLCMP_CNV_WATER=3

      ! convective ice crystals
      INTEGER,PARAMETER:: IP_CLCMP_CNV_ICE=4

! CLDCMP3A end
! CLDTYP3A defines cloud types for TWO-STREAM RADIATION CODE.

      INTEGER,PARAMETER:: IP_CLOUD_TYPE_HOMOGEN=1 ! water and ice
      INTEGER,PARAMETER:: IP_CLOUD_TYPE_WATER=1   ! Water only
      INTEGER,PARAMETER:: IP_CLOUD_TYPE_ICE=2     ! Ice only

      ! mixed-phase stratiform cloud
      INTEGER,PARAMETER:: IP_CLOUD_TYPE_STRAT=1

      ! mixed-phase convective cloud
      INTEGER,PARAMETER:: IP_CLOUD_TYPE_CONV=2

      INTEGER,PARAMETER:: IP_CLOUD_TYPE_SW=1 ! stratiform water cloud
      INTEGER,PARAMETER:: IP_CLOUD_TYPE_SI=2 ! stratiform ice cloud
      INTEGER,PARAMETER:: IP_CLOUD_TYPE_CW=3 ! convective water cloud
      INTEGER,PARAMETER:: IP_CLOUD_TYPE_CI=4 ! convective ice cloud

! CLDTYP3A end
! CLREPP3A defines representations of clouds in two-stream radiation
! code.

      ! all components are mixed homogeneously
      INTEGER,PARAMETER:: IP_CLOUD_HOMOGEN     = 1

      ! ice and water clouds are treated separately
      INTEGER,PARAMETER:: IP_CLOUD_ICE_WATER   = 2

      ! clouds are divided into homogeneously mixed stratiform and
      ! convective parts
      INTEGER,PARAMETER:: IP_CLOUD_CONV_STRAT  = 3

      ! clouds divided into ice and water phases and into stratiform and
      ! convective components.
      INTEGER,PARAMETER:: IP_CLOUD_CSIW        = 4

! Types of clouds (values in CLREPD3A)

      ! number of type of clouds in representation
      INTEGER :: NP_CLOUD_TYPE(NPD_CLOUD_REPRESENTATION)

      ! map of components contributing to types of clouds
      INTEGER :: IP_CLOUD_TYPE_MAP(NPD_CLOUD_COMPONENT,NPD_CLOUD_REPRESENTATION)

! CLREPP3A end
! ICLPRM3A defines numbers for ice cloud schemes in two-stream radiation
! code.
!
!   5.5   Feb 2003     Addition of the aggregate parametrization.
!                                                 John Edwards
!   6.2   Jan 2006     Various options for radiation code
!                      3Z added.   (J.-C. Thelen)
!

      ! number of cloud fitting schemes
      INTEGER,PARAMETER:: NPD_ICE_CLOUD_FIT=10

      ! parametrization of slingo and schrecker.
      INTEGER,PARAMETER:: IP_SLINGO_SCHRECKER_ICE=1

      ! unparametrized ice crystal data
       INTEGER,PARAMETER:: IP_ICE_UNPARAMETRIZED=3

      ! sun and shine's parametrization in the visible (version 2)
      INTEGER,PARAMETER:: IP_SUN_SHINE_VN2_VIS=4

      ! sun and shine's parametrization in the ir (version 2)
      INTEGER,PARAMETER:: IP_SUN_SHINE_VN2_IR=5

      ! scheme based on anomalous diffraction theory for ice crystals
      INTEGER,PARAMETER:: IP_ICE_ADT=6

!           ADT-based scheme for ice crystals using 10th order
!           polynomials
      INTEGER,PARAMETER:: IP_ICE_ADT_10=7
      ! Provisional agregate parametrization.
      INTEGER,PARAMETER:: IP_ICE_AGG_DE=12
!           Fu's parametrization in the solar region of the spectrum
      INTEGER,PARAMETER:: IP_ICE_FU_SOLAR=9
!           Fu's parametrization in the infra-red region of the spectrum
      INTEGER,PARAMETER:: IP_ICE_FU_IR=10
!           Parametrization of Slingo and Schrecker
!           (Moments of phase function).
      INTEGER,PARAMETER:: IP_SLINGO_SCHR_ICE_PHF=11
!           Parametrization like Fu
!           (Moments of phase function).
      INTEGER,PARAMETER:: IP_ICE_FU_PHF=13

! ICLPRM3A end
!*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, Parameter :: ZeroDegC = 273.15
      Real, Parameter :: TFS      = 271.35
      Real, Parameter :: TM       = 273.15

!*----------------------------------------------------------------------
!*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, Parameter  :: R      = 287.05
      Real, Parameter  :: CP     = 1005.
      Real, Parameter  :: Kappa  = R/CP
      Real, Parameter  :: Pref   = 100000.

      ! Reference surface pressure = PREF
      Real, Parameter  :: P_zero = Pref
      Real, Parameter  :: sclht  = 6.8E+03  ! Scale Height H

!
!*----------------------------------------------------------------------
!
!
!     DIMENSIONS OF ARRAYS:
      Integer, Intent(IN) :: row_length !Number of grid-points in EW-direction
!                              in the local domain
      Integer, Intent(IN) :: rows!Number of grid-points in NS-direction
!                              in the local domain
      INTEGER, INTENT(IN) :: NPD_FIELD
!             FIELD SIZE IN CALLING PROGRAM
      INTEGER, INTENT(IN) :: NPD_PROFILE
!             SIZE OF ARRAY OF PROFILES
      INTEGER, INTENT(IN) :: NPD_LAYER
!             MAXIMUM NUMBER OF LAYERS
      INTEGER, INTENT(IN) :: NPD_AEROSOL_SPECIES
!             MAXIMUM NUMBER OF AEROSOL_SPECIES
      INTEGER, INTENT(IN) :: SULP_DIM1
!             1ST DIMENSION OF ARRAYS OF SULPHATE
      INTEGER, INTENT(IN) :: SULP_DIM2
!             2ND DIMENSION OF ARRAYS OF SULPHATE
      INTEGER, INTENT(IN) :: BMASS_DIM1
!             1ST DIMENSION OF ARRAYS OF BIOMASS SMOKE
      INTEGER, INTENT(IN) :: BMASS_DIM2
!             2ND DIMENSION OF ARRAYS OF BIOMASS SMOKE
      INTEGER, INTENT(IN) :: OCFF_DIM1
!             1ST DIMENSION OF ARRAYS OF FOSSIL-FUEL ORGANIC CARBON
      INTEGER, INTENT(IN) :: OCFF_DIM2
!             2ND DIMENSION OF ARRAYS OF FOSSIL-FUEL ORGANIC CARBON
      INTEGER, INTENT(IN) :: SALT_DIM_A
!             1ST DIMENSION OF ARRAYS OF SEA-SALT
      INTEGER, INTENT(IN) :: SALT_DIM_B
!             2ND DIMENSION OF ARRAYS OF SEA-SALT
      INTEGER, INTENT(IN) :: BIOGENIC_DIM1
!             1ST DIMENSION OF BIOGENIC AEROSOL ARRAY
      INTEGER, INTENT(IN) :: BIOGENIC_DIM2
!             2ND DIMENSION OF BIOGENIC AEROSOL ARRAY
      INTEGER, INTENT(IN) :: N_CCA_LEV
!             NUMBER OF LEVELS FOR CONVECTIVE CLOUD AMOUNT
!
!     ACTUAL SIZES USED:
      INTEGER, INTENT(IN) :: N_PROFILE
!             NUMBER OF PROFILES
      INTEGER, INTENT(IN) :: NLEVS
!             Number of layers used outside the radiation scheme
      INTEGER, INTENT(IN) :: N_LAYER
!             Number of layers seen by the radiation code
      INTEGER, INTENT(IN) :: NCLDS
!             NUMBER OF CLOUDY LEVELS
!
!     GATHERING ARRAY:
      INTEGER, INTENT(IN) :: I_GATHER(NPD_FIELD) !LIST OF POINTS TO BE GATHERED
      Integer, Intent(IN) :: col_list(npd_field) !EW indices of gathered points in the 2-D domain
      Integer, Intent(IN) :: row_list(npd_field) !NS indices of gathered points in the 2-D domain
!
!     THERMODYNAMIC FIELDS:
      REAL   , INTENT(IN) :: P     (NPD_PROFILE, 0: NPD_LAYER)!PRESSURES
      REAL   , INTENT(IN) :: T     (NPD_PROFILE, 0: NPD_LAYER)!TEMPERATURES
      REAL   , INTENT(IN) :: D_MASS(NPD_PROFILE,    NPD_LAYER)!MASS THICKNESSES OF LAYERS
!
!     CONVECTIVE CLOUDS:
      INTEGER, INTENT(IN) :: CCB(NPD_FIELD)          !BASE OF CONVECTIVE CLOUD
      INTEGER, INTENT(IN) :: CCT(NPD_FIELD)          !TOP OF CONVECTIVE CLOUD
      REAL   , INTENT(IN) :: CCA(NPD_FIELD,N_CCA_LEV)!FRACTION OF CONVECTIVE CLOUD
      REAL   , INTENT(IN) :: CCCWP(NPD_FIELD)        !WATER PATH OF CONVECTIVE CLOUD
      LOGICAL, INTENT(IN) :: L_3D_CCA 
      LOGICAL, INTENT(IN) :: L_LOCAL_CNV_PARTITION

!             FLAG TO CARRY OUT THE PARTITIONING BETWEEN ICE
!             AND WATER IN CONVECTIVE CLOUDS AS A FUNCTION OF
!             THE LOCAL TEMPERATURE

      LOGICAL, INTENT(IN) :: L_SEASALT_CCN
!              FLAG FOR SEA-SALT PARAMETRIZATION FOR CCN
      LOGICAL, INTENT(IN) :: L_USE_BIOGENIC
!              FLAG TO USE BIOGENIC AEROSOLS AS CCN
      LOGICAL, INTENT(IN) :: L_BIOMASS_CCN
!              FLAG FOR SEA-SALT PARAMETRIZATION FOR CCN
      LOGICAL, INTENT(IN) :: L_OCFF_CCN
!              FLAG FOR FOSSIL-FUEL ORG CARB PARAMETRIZATION FOR CCN
!
!     LAYER CLOUDS:
      REAL, INTENT(IN) ::  LCCWC1(NPD_FIELD, NCLDS+1/(NCLDS+1))
!             LIQUID WATER CONTENTS
      REAL, INTENT(IN) ::  LCCWC2(NPD_FIELD, NCLDS+1/(NCLDS+1))
!             ICE WATER CONTENTS
      REAL, INTENT(IN) ::  LCA_AREA(NPD_FIELD, NCLDS+1/(NCLDS+1))
!             AREA COVERAGE FRACTIONS OF LAYER CLOUDS
      REAL, INTENT(IN) ::  LCA_BULK(NPD_FIELD, NCLDS+1/(NCLDS+1))
!             BULK COVERAGE FRACTIONS OF LAYER CLOUDS
!
!     ARRAYS FOR MICROPHYSICS:
      LOGICAL , INTENT(IN) :: L_MICROPHYSICS 
!             MICROPHYSICAL FLAG
      LOGICAL , INTENT(IN) :: L_PC2
!             PC2 cloud scheme is in use
      LOGICAL , INTENT(IN) :: L_AEROSOL_CCN
!             FLAG TO USE AEROSOLS TO FIND CCN
      LOGICAL , INTENT(IN) :: L_CLOUD_WATER_PARTITION
!             FLAG TO USE PROGNOSTIC CLOUD ICE CONTENTS
      LOGICAL , INTENT(IN) :: LAND_G(NPD_PROFILE)
!             FLAG FOR LAND POINTS
      REAL   , INTENT(IN)  ::  ACCUM_SULPHATE(SULP_DIM1, SULP_DIM2)
!             MIXING RATIOS OF ACCUMULATION-MODE SULPHATE
      REAL   , INTENT(IN)  ::  AITKEN_SULPHATE(SULP_DIM1, SULP_DIM2)
!             Mixing ratios of Aitken-mode sulphate
      REAL   , INTENT(IN)  ::  DISS_SULPHATE(SULP_DIM1, SULP_DIM2)
!             MIXING RATIOS OF DISSOLVED SULPHATE
      REAL   , INTENT(IN)  ::  AGED_BMASS(BMASS_DIM1, BMASS_DIM2)
!             MIXING RATIOS OF AGED BIOMASS SMOKE
      REAL   , INTENT(IN)  ::  CLOUD_BMASS(BMASS_DIM1, BMASS_DIM2)
!             MIXING RATIOS OF IN-CLOUD BIOMASS SMOKE
      REAL   , INTENT(IN)  ::  AGED_OCFF(OCFF_DIM1, OCFF_DIM2)
!             MIXING RATIOS OF AGED FOSSIL-FUEL ORGANIC CARBON
      REAL   , INTENT(IN)  ::  CLOUD_OCFF(OCFF_DIM1, OCFF_DIM2)
!             MIXING RATIOS OF IN-CLOUD FOSSIL-FUEL ORGANIC CARBON
      REAL   , INTENT(IN)  ::  SEA_SALT_FILM(SALT_DIM_A, SALT_DIM_B)
!             NUMBER CONCENTRATION OF FILM-MODE SEA-SALT AEROSOL
      REAL   , INTENT(IN)  ::  SEA_SALT_JET(SALT_DIM_A, SALT_DIM_B)
!             NUMBER CONCENTRATION OF JET-MODE SEA-SALT AEROSOL
      REAL   , INTENT(IN)  ::  BIOGENIC(BIOGENIC_DIM1, BIOGENIC_DIM2)
!             M.M.R. OF BIOGENIC AEROSOL
!
!     REPRESENTATION OF CLOUDS
      INTEGER, INTENT(IN) ::  I_CLOUD_REPRESENTATION
!             REPRESENTATION OF CLOUDS
!
!     PARAMETRIZATIONS FOR CLOUDS:
      INTEGER, INTENT(IN) ::  I_CONDENSED_PARAM(NPD_CLOUD_COMPONENT)
!             TYPES OF PARAMETRIZATION USED FOR CONDENSED
!             COMPONENTS IN CLOUDS
!     LIMITS ON SIZES OF PARTICLES
      REAL   , INTENT(IN) :: CONDENSED_MIN_DIM(NPD_CLOUD_COMPONENT)
!             MINIMUM DIMENSION OF EACH CONDENSED COMPONENT
      REAL   , INTENT(IN) :: CONDENSED_MAX_DIM(NPD_CLOUD_COMPONENT)
!             MAXIMUM DIMENSION OF EACH CONDENSED COMPONENT
!
      Real   , Intent(IN) :: Ntot_land ! Number of droplets over land / m-3
      Real   , Intent(IN) :: Ntot_sea  ! Number of droplets over sea / m-3
!
!     ASSIGNED CLOUD FIELDS:
      INTEGER , INTENT(OUT) ::  N_CONDENSED!NUMBER OF CONDENSED COMPONENTS
      INTEGER , INTENT(OUT) ::  TYPE_CONDENSED(NPD_CLOUD_COMPONENT)
!             TYPES OF CONDENSED COMPONENTS
      REAL    , INTENT(OUT) :: W_CLOUD(NPD_PROFILE, NPD_LAYER)
!             TOTAL AMOUNTS OF CLOUD
      REAL    , INTENT(OUT) :: FRAC_CLOUD(NPD_PROFILE, NPD_LAYER, NPD_CLOUD_TYPE)
!             FRACTION OF EACH TYPE OF CLOUD
      REAL    , INTENT(OUT) :: CONDENSED_DIM_CHAR(NPD_PROFILE, 0: NPD_LAYER, NPD_CLOUD_COMPONENT)
!             CHARACTERISTIC DIMENSIONS OF CLOUDY COMPONENTS
      REAL    , INTENT(OUT) :: CONDENSED_MIX_RAT_AREA(NPD_PROFILE, 0: NPD_LAYER , NPD_CLOUD_COMPONENT)
!             MASS MIXING RATIOS OF CONDENSED COMPONENTS USING AREA CLD
      REAL     :: NTOT_DIAG_G(NPD_PROFILE, NPD_LAYER)
!             DIAGNOSTIC ARRAY FOR NTOT (GATHERED)
      REAL     :: STRAT_LWC_DIAG_G(NPD_PROFILE, NPD_LAYER)
!             DIAGNOSTIC ARRAY FOR STRATIFORM LWC (GATHERED)
      REAL     :: SO4_CCN_DIAG_G(NPD_PROFILE, NPD_LAYER)
!             DIAGNOSTIC ARRAY FOR SO4 CCN MASS CONC (GATHERED)
!
!
      REAL, INTENT(IN   ) ::  LYING_SNOW(NPD_FIELD)     !  SNOW DEPTH (>5000m = LAND ICE SHEET)
      REAL ::  LYING_SNOW_G(NPD_PROFILE) !GATHERED VERSION OF THE ABOVE
      REAL, INTENT(IN   ) ::  FLANDG_G(NPD_PROFILE)     !GATHERED global LAND FRACTION FIELD
!
!     MICROPHYSICAL DIAGNOSTICS:
      LOGICAL, INTENT(IN   ) ::    RE_CONV_FLAG
!             DIAGNOSE EFFECTIVE RADIUS*WEIGHT FOR CONVECTIVE CLOUD
      LOGICAL, INTENT(IN   ) ::  RE_STRAT_FLAG
!             DIAGNOSE EFFECTIVE RADIUS*WEIGHT FOR STRATIFORM CLOUD
      LOGICAL, INTENT(IN   ) ::  WGT_CONV_FLAG
!             DIAGNOSE WEIGHT FOR CONVECTIVE CLOUD
      LOGICAL, INTENT(IN   ) ::  WGT_STRAT_FLAG
!             DIAGNOSE WEIGHT FOR STRATIFORM CLOUD
      LOGICAL, INTENT(IN   ) ::  LWP_STRAT_FLAG
!             DIAGNOSE LIQUID WATER PATH*WEIGHT FOR STRATIFORM CLOUD
      LOGICAL, INTENT(IN   ) ::  NTOT_DIAG_FLAG
!             DIAGNOSE DROPLET CONCENTRATION*WEIGHT
      LOGICAL, INTENT(IN   ) ::  STRAT_LWC_DIAG_FLAG
!             DIAGNOSE STRATIFORM LWC*WEIGHT
      LOGICAL, INTENT(IN   ) ::  SO4_CCN_DIAG_FLAG
!             DIAGNOSE SO4 CCN MASS CONC*COND. SAMP. WEIGHT
      LOGICAL, INTENT(IN   ) ::  COND_SAMP_WGT_FLAG
!             DIAGNOSE CONDITIONAL SAMPLING WEIGHT
      LOGICAL, INTENT(IN   ) ::  NC_DIAG_FLAG
!             DIAGNOSE COLUMN DROPLET CONCENTRATION * SAMP. WEIGHT
      LOGICAL, INTENT(IN   ) ::  NC_WEIGHT_FLAG
!             DIAGNOSE COLUMN DROPLET SAMPLING WEIGHT
!
      REAL , INTENT(OUT  ) :: RE_CONV(row_length, rows, NCLDS)
!             EFFECTIVE RADIUS*WEIGHT FOR CONVECTIVE CLOUD
      REAL , INTENT(OUT   ) :: RE_STRAT(row_length, rows, NCLDS)
!             EFFECTIVE RADIUS*WEIGHT FOR STRATIFORM CLOUD
      REAL , INTENT(OUT  ) :: WGT_CONV(row_length, rows, NCLDS)
!             WEIGHT FOR CONVECTIVE CLOUD
      REAL , INTENT(OUT   ) :: WGT_STRAT(row_length, rows, NCLDS)
!             WEIGHT FOR STRATIFORM CLOUD
      REAL , INTENT(OUT   ) :: LWP_STRAT(row_length, rows, NCLDS)
!             LIQUID WATER PATH*WEIGHT FOR STRATIFORM CLOUD
      REAL , INTENT(OUT   ) :: NTOT_DIAG(row_length, rows, NCLDS)
!             DROPLET CONCENTRATION*WEIGHT
      REAL , INTENT(OUT   ) :: STRAT_LWC_DIAG(row_length, rows, NCLDS)
!             STRATIFORM LWC*WEIGHT
      REAL , INTENT(OUT   ) :: SO4_CCN_DIAG(row_length, rows, NCLDS)
!             SO4 CCN MASS CONC*COND. SAMP. WEIGHT
      REAL , INTENT(OUT   ) :: COND_SAMP_WGT(row_length, rows, NCLDS)
!             CONDITIONAL SAMPLING WEIGHT
      REAL , INTENT(OUT   ) :: NC_DIAG(row_length, rows)
!             COLUMN DROPLET CONCENTRATION * SAMPLING WEIGHT
      REAL , INTENT(OUT   ) :: NC_WEIGHT(row_length, rows)
!             COLUMN DROPLET CONCENTRATION SAMPLING WEIGHT
!
!
!
!     LOCAL VARIABLES:
      INTEGER :: I
!             LOOP VARIABLE
      INTEGER :: J
!             LOOP VARIABLE
      INTEGER :: L
!             LOOP VARIABLE
      INTEGER :: LG
!             INDEX TO GATHER
!
      LOGICAL :: L_GLACIATED_TOP(NPD_PROFILE)
!             LOGICAL FOR GLACIATED TOPS IN CONVECTIVE CLOUD.
!
      REAL :: LIQ_FRAC(NPD_PROFILE)
!             FRACTION OF LIQUID CLOUD WATER
      REAL :: LIQ_FRAC_CONV(NPD_PROFILE)
!             FRACTION OF LIQUID WATER IN CONVECTIVE CLOUD
      REAL :: T_GATHER(NPD_PROFILE)
!             GATHERED TEMPERATURE FOR LSP_FOCWWIL
      REAL :: T_LIST(NPD_PROFILE)
!             LIST OF TEMPERATURES
      REAL :: TOTAL_MASS(NPD_PROFILE)
!             TOTAL MASS IN CONVECTIVE CLOUD
      REAL :: CC_DEPTH(NPD_PROFILE)
!             DEPTH OF CONVECTIVE CLOUD
      REAL :: CONDENSED_MIX_RAT_BULK(NPD_PROFILE, 0: NPD_LAYER,NPD_CLOUD_COMPONENT)
!             MASS MIXING RATIOS OF CONDENSED COMPONENTS USING BULK CLD
      REAL :: DENSITY_AIR(NPD_PROFILE, NPD_LAYER)
!             DENSITY OF AIR
      REAL :: CONVECTIVE_CLOUD_LAYER(NPD_PROFILE)
!             AMOUNT OF CONVECTIVE CLOUD IN TH CURRENT LAYER
      REAL :: STRAT_LIQ_CLOUD_FRACTION(NPD_PROFILE, NPD_LAYER)
!             STRATIFORM LIQUID CLOUD FRACTION (T>273K)
      REAL :: CONV_LIQ_CLOUD_FRACTION(NPD_PROFILE, NPD_LAYER)
!             CONVECTIVE LIQUID CLOUD FRACTION (T>273K)
      REAL :: NC_DIAG_G(NPD_PROFILE)
!             DIAGNOSTIC ARRAY FOR COLUMN DROPLET NUMBER (GTYPE_CONDENSEDATHERED)
      REAL :: NC_WEIGHT_G(NPD_PROFILE)
!             DIAGNOSTIC ARRAY FOR COL. DROP NO. SAMPLING WGT (GATHERED)
!
!
!     Parameters for the aggregate parametrization.
      REAL, Parameter :: a0_agg_cold = 7.5094588E-04
      REAL, Parameter :: b0_agg_cold = 5.0830326E-07
      REAL, Parameter :: a0_agg_warm = 1.3505403E-04
      REAL, Parameter :: b0_agg_warm = 2.6517429E-05
      REAL, Parameter :: t_switch    = 216.208
      REAL, Parameter :: t0_agg      = 279.5
      REAL, Parameter :: s0_agg      = 0.05
!
!
!     SET THE COMPONENTS WITHIN THE CLOUDS. IN THE UNIFIED MODEL WE
!     HAVE FOUR COMPONENTS: STRATIFORM ICE AND WATER AND CONVECTIVE
!     ICE AND WATER.
      N_CONDENSED=4
      TYPE_CONDENSED(1)=IP_CLCMP_ST_WATER
      TYPE_CONDENSED(2)=IP_CLCMP_ST_ICE
      TYPE_CONDENSED(3)=IP_CLCMP_CNV_WATER
      TYPE_CONDENSED(4)=IP_CLCMP_CNV_ICE
!
!
!
!     SET THE TOTAL AMOUNTS OF CLOUD AND THE FRACTIONS COMPRISED BY
!     CONVECTIVE AND STRATIFORM COMPONENTS.
!
!     ZERO THE AMOUNTS OF CLOUD IN THE UPPER LAYERS.
      DO I=1, N_LAYER-NCLDS
         DO L=1, N_PROFILE
            W_CLOUD(L, I)=0.0E+00
         ENDDO
      ENDDO
!
      IF (I_CLOUD_REPRESENTATION == IP_CLOUD_CONV_STRAT .AND.           &
          .NOT. L_CLOUD_WATER_PARTITION) THEN
!  This cloud representation not available with new cloud microphysics
!
!        THE CLOUDS ARE DIVIDED INTO MIXED-PHASE STRATIFORM AND
!        CONVECTIVE CLOUDS: LSP_FOCWWIL GIVES THE PARTITIONING BETWEEN
!        ICE AND WATER IN STRATIFORM CLOUDS AND IN CONVECTIVE CLOUD,
!        UNLESS THE OPTION TO PARTITION AS A FUNCTION OF THE LOCAL
!        TEMPERATURE IS SELECTED. WITHIN CONVECTIVE CLOUD THE LIQUID
!        WATER CONTENT IS DISTRIBUTED UNIFORMLY THROUGHOUT THE CLOUD.
!
!        CONVECTIVE CLOUD:
!
         DO I=N_LAYER+1-NCLDS, N_LAYER
            DO L=1, N_PROFILE
               CONDENSED_MIX_RAT_AREA(L, I, IP_CLCMP_CNV_WATER)=0.0E+00
               CONDENSED_MIX_RAT_AREA(L, I, IP_CLCMP_CNV_ICE)=0.0E+00
               CONDENSED_MIX_RAT_BULK(L, I, IP_CLCMP_CNV_WATER)=0.0E+00
               CONDENSED_MIX_RAT_BULK(L, I, IP_CLCMP_CNV_ICE)=0.0E+00
            ENDDO
         ENDDO
!
!
         IF (L_LOCAL_CNV_PARTITION) THEN
!
!           PARTITION BETWEEN ICE AND WATER USING THE RELATIONSHIPS
!           GIVEN IN BOWER ET AL. (1996, Q.J. 122 p 1815-1844). ICE
!           IS ALLOWED IN A LAYER WARMER THAN THE FREEZING POINT
!           ONLY IF THE TOP OF THE CLOUD IS GLACIATED.
!
            DO L=1, N_PROFILE
!              MIN is required since CCT may be 0 if there is no
!              convective cloud.
               L_GLACIATED_TOP(L)                                       &
                  =(T(L, MIN(N_LAYER+2-CCT(I_GATHER(L))                 &
                  , N_LAYER-NCLDS+1)) <  TM)
            ENDDO

         ELSE
!
!           PARTITION BETWEEN ICE AND WATER AS DIRECTED BY THE
!           TEMPERATURE IN THE MIDDLE OF THE TOP LAYER OF THE CLOUD.
!           THE PARTITIONING MAY BE PRECALCULATED IN THIS CASE.
!
            DO L=1, N_PROFILE
               T_GATHER(L)=T(L, MIN(N_LAYER+2-CCT(I_GATHER(L))          &
                  , N_LAYER-NCLDS+1))
            ENDDO
! DEPENDS ON: lsp_focwwil
            CALL LSP_FOCWWIL(   &
                 T_GATHER     , & !INTEGER, INTENT(IN        ) :: POINTS             ! IN Number of points to be processed.
                 N_PROFILE    , & !REAL   , INTENT(IN        ) :: T(POINTS)       ! IN Temperature at this level (K).
                 LIQ_FRAC_CONV  ) !REAL   , INTENT(OUT  ) :: ROCWWIL(POINTS) ! OUT Ratio Of Cloud Water Which Is Liquid.
!
         ENDIF
!
!
         DO L=1, N_PROFILE
            TOTAL_MASS(L)=0.0E+00
         ENDDO
!
         DO I=N_LAYER+1-NCLDS, N_LAYER
            DO L=1, N_PROFILE
               LG=I_GATHER(L)
               IF ( (CCT(LG) >= N_LAYER+2-I).AND.                       &
                    (CCB(LG) <= N_LAYER+1-I) ) THEN
                  TOTAL_MASS(L)=TOTAL_MASS(L)+D_MASS(L, I)
               ENDIF
            ENDDO
         ENDDO
!
         DO I=N_LAYER+1-NCLDS, N_LAYER
            DO L=1, N_PROFILE
               LG=I_GATHER(L)
               IF ( (CCT(LG) >= N_LAYER+2-I).AND.                       &
                    (CCB(LG) <= N_LAYER+1-I) ) THEN
                  IF (L_LOCAL_CNV_PARTITION) THEN
!                    THE PARTITIONING IS RECALCULATED FOR EACH LAYER
!                    OTHERWISE A GENERIC VALUE IS USED.
                     LIQ_FRAC_CONV(L)=MAX(0.0E+00, MIN(1.0E+00          &
                        , 1.61E-02*(T(L, I)-TM)+8.9E-01))
!                    Do not allow ice above 0 Celsius unless the top
!                    of the cloud is glaciated and force homogeneous
!                    nucleation at -40 Celsius.
                     IF ( (T(L, I) >  TM).AND.                          &
                          (.NOT.L_GLACIATED_TOP(L)) ) THEN
                       LIQ_FRAC_CONV(L)=1.0E+00
                     ELSE IF (T(L, I) <  TM-4.0E+01) THEN
                       LIQ_FRAC_CONV(L)=0.0E+00
                     ENDIF
                  ENDIF
                  CONDENSED_MIX_RAT_AREA(L, I, IP_CLCMP_CNV_WATER)      &
                     =CCCWP(LG)*LIQ_FRAC_CONV(L)                        &
                     /(TOTAL_MASS(L)+TINY(CCCWP))
                  CONDENSED_MIX_RAT_AREA(L, I, IP_CLCMP_CNV_ICE)        &
                     =CCCWP(LG)*(1.0E+00-LIQ_FRAC_CONV(L))              &
                     /(TOTAL_MASS(L)+TINY(CCCWP))
                  CONDENSED_MIX_RAT_BULK(L, I, IP_CLCMP_CNV_WATER)      &
                     =CCCWP(LG)*LIQ_FRAC_CONV(L)                        &
                     /(TOTAL_MASS(L)+TINY(CCCWP))
                  CONDENSED_MIX_RAT_BULK(L, I, IP_CLCMP_CNV_ICE)        &
                     =CCCWP(LG)*(1.0E+00-LIQ_FRAC_CONV(L))              &
                     /(TOTAL_MASS(L)+TINY(CCCWP))
               ENDIF
            ENDDO
         ENDDO
!
!
!        STRATIFORM CLOUDS:
!
!        PARTITION BETWEEN ICE AND WATER DEPENDING ON THE
!        LOCAL TEMPERATURE.
!
         DO I=1, NCLDS
! DEPENDS ON: lsp_focwwil
            CALL LSP_FOCWWIL( &
                 T(L, N_LAYER+1-I)    , &!INTEGER, INTENT(IN   ) :: POINTS            ! IN Number of points to be processed.
                 N_PROFILE            , &!REAL   , INTENT(IN   ) :: T(POINTS)            ! IN Temperature at this level (K).
                 LIQ_FRAC               )!REAL   , INTENT(OUT  ) :: ROCWWIL(POINTS) ! OUT Ratio Of Cloud Water Which Is Liquid.
            DO L=1, N_PROFILE
               LG=I_GATHER(L)
               IF (LCA_AREA(LG, I) >  EPSILON(LCA_AREA)) THEN
                 CONDENSED_MIX_RAT_AREA(L, N_LAYER+1-I                  &
                    , IP_CLCMP_ST_WATER)                                &
                     =(LCCWC1(LG, I)+LCCWC2(LG, I))                     &
                     *LIQ_FRAC(L)/LCA_AREA(LG, I)
                 CONDENSED_MIX_RAT_AREA(L, N_LAYER+1-I                  &
                    , IP_CLCMP_ST_ICE)                                  &
                     =(LCCWC1(LG, I)+LCCWC2(LG, I))                     &
                     *(1.0E+00-LIQ_FRAC(L))/LCA_AREA(LG, I)
               ELSE
                 CONDENSED_MIX_RAT_AREA(L, N_LAYER+1-I                  &
                    , IP_CLCMP_ST_WATER)=0.0E+00
                 CONDENSED_MIX_RAT_AREA(L, N_LAYER+1-I                  &
                    , IP_CLCMP_ST_ICE)=0.0E+00
               ENDIF
!
               IF (LCA_BULK(LG, I) >  EPSILON(LCA_BULK)) THEN
                 CONDENSED_MIX_RAT_BULK(L, N_LAYER+1-I                  &
                    , IP_CLCMP_ST_WATER)                                &
                     =(LCCWC1(LG, I)+LCCWC2(LG, I))                     &
                     *LIQ_FRAC(L)/LCA_BULK(LG, I)
                 CONDENSED_MIX_RAT_BULK(L, N_LAYER+1-I                  &
                    , IP_CLCMP_ST_ICE)                                  &
                     =(LCCWC1(LG, I)+LCCWC2(LG, I))                     &
                     *(1.0E+00-LIQ_FRAC(L))/LCA_BULK(LG, I)
               ELSE
                 CONDENSED_MIX_RAT_BULK(L, N_LAYER+1-I                  &
                    , IP_CLCMP_ST_WATER)=0.0E+00
                 CONDENSED_MIX_RAT_BULK(L, N_LAYER+1-I                  &
                    , IP_CLCMP_ST_ICE)=0.0E+00
               ENDIF
            ENDDO
         ENDDO
!
!
!        CLOUD FRACTIONS:
!
       IF (L_3D_CCA) THEN
         DO I=1, NCLDS
            DO L=1, N_PROFILE
               LG=I_GATHER(L)
               W_CLOUD(L, N_LAYER+1-I)                                  &
                  =CCA(LG,I)+(1.0E+00-CCA(LG,I))*LCA_AREA(LG, I)
               FRAC_CLOUD(L, N_LAYER+1-I, IP_CLOUD_TYPE_CONV)           &
                  =CCA(LG,I)/(W_CLOUD(L, N_LAYER+1-I)+TINY(CCA))
               FRAC_CLOUD(L, N_LAYER+1-I, IP_CLOUD_TYPE_STRAT)          &
                  =1.0E+00-FRAC_CLOUD(L, N_LAYER+1-I                    &
                  , IP_CLOUD_TYPE_CONV)
            ENDDO
         ENDDO
       ELSE
         DO I=1, NCLDS
            DO L=1, N_PROFILE
              LG=I_GATHER(L)
               IF ( (I <= CCT(LG)-1).AND.(I >= CCB(LG)) ) THEN
                  W_CLOUD(L, N_LAYER+1-I)                               &
                     =CCA(LG,1)+(1.0E+00-CCA(LG,1))*LCA_AREA(LG, I)
                  FRAC_CLOUD(L, N_LAYER+1-I, IP_CLOUD_TYPE_CONV)        &
                     =CCA(LG,1)/(W_CLOUD(L, N_LAYER+1-I)+TINY(CCA))
               ELSE
                  W_CLOUD(L, N_LAYER+1-I)=LCA_AREA(LG, I)
                  FRAC_CLOUD(L, N_LAYER+1-I, IP_CLOUD_TYPE_CONV)        &
                     =0.0E+00
               ENDIF
               FRAC_CLOUD(L, N_LAYER+1-I, IP_CLOUD_TYPE_STRAT)          &
                  =1.0E+00-FRAC_CLOUD(L, N_LAYER+1-I                    &
                  , IP_CLOUD_TYPE_CONV)
            ENDDO
         ENDDO
       ENDIF
!
!
!
!
      ELSE IF (I_CLOUD_REPRESENTATION == IP_CLOUD_CSIW) THEN
!
!        HERE THE CLOUDS ARE SPLIT INTO FOUR SEPARATE TYPES.
!        THE PARTITIONING BETWEEN ICE AND WATER IS REGARDED AS
!        DETERMINING THE AREAS WITHIN THE GRID_BOX COVERED BY
!        ICE OR WATER CLOUD, RATHER THAN AS DETERMINING THE IN-CLOUD
!        MIXING RATIOS. THE GRID-BOX MEAN ICE WATER CONTENTS IN
!        STRATIFORM CLOUDS MAY BE PREDICTED BY THE ICE MICROPHYSICS
!        SCHEME OR MAY BE DETERMINED AS A FUNCTION OF THE TEMPERATURE
!        (LSP_FOCWWIL). IN CONVECTIVE CLOUDS THE PARTITIONING MAY BE
!        DONE USING THE SAME FUNCTION, LSP_FOCWWIL, BASED ON A SINGLE
!        TEMPERATURE, OR USING A PARTITION BASED ON THE LOCAL
!        TEMPERATURE.
!
!        CONVECTIVE CLOUD:
!
          DO I=N_LAYER+1-NCLDS, N_LAYER
            DO L=1, N_PROFILE
               CONDENSED_MIX_RAT_AREA(L, I, IP_CLCMP_CNV_WATER)=0.0E+00
               CONDENSED_MIX_RAT_AREA(L, I, IP_CLCMP_CNV_ICE)=0.0E+00
               CONDENSED_MIX_RAT_BULK(L, I, IP_CLCMP_CNV_WATER)=0.0E+00
               CONDENSED_MIX_RAT_BULK(L, I, IP_CLCMP_CNV_ICE)=0.0E+00
            ENDDO
         ENDDO
!
         DO L=1, N_PROFILE
            TOTAL_MASS(L)=0.0E+00
         ENDDO
!
         DO I=N_LAYER+1-NCLDS, N_LAYER
            DO L=1, N_PROFILE
               LG=I_GATHER(L)
               IF ( (CCT(LG) >= N_LAYER+2-I).AND.                       &
                    (CCB(LG) <= N_LAYER+1-I) ) THEN
                  TOTAL_MASS(L)=TOTAL_MASS(L)+D_MASS(L, I)
               ENDIF
            ENDDO
         ENDDO
         DO I=N_LAYER+1-NCLDS, N_LAYER
            DO L=1, N_PROFILE
               LG=I_GATHER(L)
               IF ( (CCT(LG) >= N_LAYER+2-I).AND.                       &
                    (CCB(LG) <= N_LAYER+1-I) ) THEN
                  CONDENSED_MIX_RAT_AREA(L, I, IP_CLCMP_CNV_WATER)      &
                     =CCCWP(LG)/(TOTAL_MASS(L)+TINY(CCCWP))
                  CONDENSED_MIX_RAT_AREA(L, I, IP_CLCMP_CNV_ICE)        &
                     =CONDENSED_MIX_RAT_AREA(L, I, IP_CLCMP_CNV_WATER)
                  CONDENSED_MIX_RAT_BULK(L, I, IP_CLCMP_CNV_WATER)      &
                     =CCCWP(LG)/(TOTAL_MASS(L)+TINY(CCCWP))
                  CONDENSED_MIX_RAT_BULK(L, I, IP_CLCMP_CNV_ICE)        &
                     =CONDENSED_MIX_RAT_BULK(L, I, IP_CLCMP_CNV_WATER)
               ENDIF
            ENDDO
         ENDDO
!
!        STRATIFORM CLOUDS:
!
         DO I=1, NCLDS
            DO L=1, N_PROFILE
               LG=I_GATHER(L)
               IF (LCA_AREA(LG, I) >  EPSILON(LCA_AREA)) THEN
                 CONDENSED_MIX_RAT_AREA(L, N_LAYER+1-I                  &
                    , IP_CLCMP_ST_WATER)                                &
                    =(LCCWC1(LG, I)+LCCWC2(LG, I))/LCA_AREA(LG, I)
                 CONDENSED_MIX_RAT_AREA(L, N_LAYER+1-I                  &
                    , IP_CLCMP_ST_ICE)                                  &
                    =CONDENSED_MIX_RAT_AREA(L, N_LAYER+1-I              &
                    , IP_CLCMP_ST_WATER)
               ELSE
                 CONDENSED_MIX_RAT_AREA(L, N_LAYER+1-I                  &
                    , IP_CLCMP_ST_WATER)=0.0E+00
                 CONDENSED_MIX_RAT_AREA(L, N_LAYER+1-I                  &
                    , IP_CLCMP_ST_ICE)=0.0E+00
               ENDIF
!
               IF (LCA_BULK(LG, I) >  EPSILON(LCA_BULK)) THEN
                 CONDENSED_MIX_RAT_BULK(L, N_LAYER+1-I                  &
                    , IP_CLCMP_ST_WATER)                                &
                    =(LCCWC1(LG, I)+LCCWC2(LG, I))/LCA_BULK(LG, I)
                 CONDENSED_MIX_RAT_BULK(L, N_LAYER+1-I                  &
                    , IP_CLCMP_ST_ICE)                                  &
                    =CONDENSED_MIX_RAT_BULK(L, N_LAYER+1-I              &
                    , IP_CLCMP_ST_WATER)
               ELSE
                 CONDENSED_MIX_RAT_BULK(L, N_LAYER+1-I                  &
                    , IP_CLCMP_ST_WATER)=0.0E+00
                 CONDENSED_MIX_RAT_BULK(L, N_LAYER+1-I                  &
                    , IP_CLCMP_ST_ICE)=0.0E+00
               ENDIF
            ENDDO
         ENDDO
!
!
!        CLOUD FRACTIONS:
!
         IF (L_LOCAL_CNV_PARTITION) THEN
!
!           PARTITION BETWEEN ICE AND WATER USING THE RELATIONSHIPS
!           GIVEN IN BOWER ET AL. (1996, Q.J. 122 p 1815-1844). ICE
!           IS ALLOWED IN A LAYER WARMER THAN THE FREEZING POINT
!           ONLY IF THE TOP OF THE CLOUD IS GLACIATED.
!
            DO L=1, N_PROFILE
!              MIN is required since CCT may be 0 if there is no
!              convective cloud.
               L_GLACIATED_TOP(L)                                       &
                  =(T(L, MIN(N_LAYER+2-CCT(I_GATHER(L))                 &
                  , N_LAYER-NCLDS+1)) <  TM)
            ENDDO

         ELSE
!
!           PARTITION BETWEEN ICE AND WATER AS DIRECTED BY THE
!           TEMPERATURE IN THE MIDDLE OF THE TOP LAYER OF THE CLOUD.
!           THE PARTITIONING MAY BE PRECALCULATED IN THIS CASE.
!
            DO L=1, N_PROFILE
               T_GATHER(L)=T(L, MIN(N_LAYER+2-CCT(I_GATHER(L))          &
                  , N_LAYER-NCLDS+1))
            ENDDO
! DEPENDS ON: lsp_focwwil
            CALL LSP_FOCWWIL(&
               T_GATHER       , & !INTEGER, INTENT(IN        ) :: POINTS             ! IN Number of points to be processed.
               N_PROFILE      , & !REAL   , INTENT(IN        ) :: T(POINTS)       ! IN Temperature at this level (K).
               LIQ_FRAC_CONV    ) !REAL   , INTENT(OUT  ) :: ROCWWIL(POINTS) ! OUT Ratio Of Cloud Water Which Is Liquid.
!
         ENDIF
!
!
         DO I=N_LAYER+1-NCLDS, N_LAYER
!
            IF (.NOT. L_CLOUD_WATER_PARTITION)                          &
!           PARTITION STRATIFORM CLOUDS USING THE LOCAL TEMPERATURE.
! DEPENDS ON: lsp_focwwil
              CALL LSP_FOCWWIL( &
               T(1, I)        , & !INTEGER, INTENT(IN        ) :: POINTS             ! IN Number of points to be processed.
               N_PROFILE      , & !REAL   , INTENT(IN        ) :: T(POINTS)       ! IN Temperature at this level (K).
               LIQ_FRAC         ) !REAL   , INTENT(OUT  ) :: ROCWWIL(POINTS) ! OUT Ratio Of Cloud Water Which Is Liquid.
!
          IF (L_3D_CCA) THEN
            DO L=1, N_PROFILE
               LG=I_GATHER(L)
              CONVECTIVE_CLOUD_LAYER(L)=CCA(LG,N_LAYER+1-I)
            ENDDO
          ELSE
            DO L=1, N_PROFILE
            LG=I_GATHER(L)
               IF ( (CCT(LG) >= N_LAYER+2-I).AND.                       &
                    (CCB(LG) <= N_LAYER+1-I) ) THEN
                CONVECTIVE_CLOUD_LAYER(L)=CCA(LG,1)
               ELSE
                  CONVECTIVE_CLOUD_LAYER(L)=0.0E+00
               ENDIF
            ENDDO
          ENDIF
!
            DO L=1, N_PROFILE
            LG=I_GATHER(L)
               W_CLOUD(L, I)                                            &
                  =CONVECTIVE_CLOUD_LAYER(L)                            &
                  +(1.0E+00-CONVECTIVE_CLOUD_LAYER(L))                  &
                  *LCA_AREA(LG, N_LAYER+1-I)
!
               IF (L_CLOUD_WATER_PARTITION) THEN
!  PARTITION STRATIFORM CLOUDS USING THE RATIO OF CLOUD WATER CONTENTS.
                 IF (LCA_AREA(LG, N_LAYER+1-I) >   EPSILON(LCA_AREA)    &
                    .AND.                                               &
                    (LCCWC1(LG, N_LAYER+1-I) + LCCWC2(LG, N_LAYER+1-I)) &
                     >   0.0) THEN
                   LIQ_FRAC(L) = LCCWC1(LG, N_LAYER+1-I) /              &
                    (LCCWC1(LG, N_LAYER+1-I) + LCCWC2(LG, N_LAYER+1-I))
                 ELSE
                   LIQ_FRAC(L) = 0.0E+00
                 ENDIF
               ENDIF
!
               IF (L_LOCAL_CNV_PARTITION) THEN
!
!                THE PARTITIONING BETWEEN ICE AND WATER MUST BE
!                RECALCULATED FOR THIS LAYER AS A FUNCTION OF THE
!                LOCAL TEMPERATURE, BUT ICE IS ALLOWED ABOVE THE
!                FREEZING POINT ONLY IF THE TOP OF THE CLOUD IS
!                GLACIATED.
                 LIQ_FRAC_CONV(L)=MAX(0.0E+00, MIN(1.0E+00              &
                    , 1.61E-02*(T(L, I)-TM)+8.9E-01))
!                Do not allow ice above 0 Celsius unless the top
!                of the cloud is glaciated and force homogeneous
!                nucleation at -40 Celsius.
                 IF ( (T(L, I) >  TM).AND.                              &
                      (.NOT.L_GLACIATED_TOP(L)) ) THEN
                    LIQ_FRAC_CONV(L)=1.0E+00
                 ELSE IF (T(L, I) <  TM-4.0E+01) THEN
                    LIQ_FRAC_CONV=0.0E+00
                 ENDIF

               ENDIF
!
               FRAC_CLOUD(L, I, IP_CLOUD_TYPE_SW)                       &
                  =LIQ_FRAC(L)*(1.0E+00-CONVECTIVE_CLOUD_LAYER(L))      &
                  *LCA_AREA(LG, N_LAYER+1-I)                            &
                  /(W_CLOUD(L, I)+TINY(W_CLOUD))
               FRAC_CLOUD(L, I, IP_CLOUD_TYPE_SI)                       &
                  =(1.0E+00-LIQ_FRAC(L))                                &
                  *(1.0E+00-CONVECTIVE_CLOUD_LAYER(L))                  &
                  *LCA_AREA(LG, N_LAYER+1-I)                            &
                  /(W_CLOUD(L, I)+TINY(W_CLOUD))
               FRAC_CLOUD(L, I, IP_CLOUD_TYPE_CW)                       &
                  =LIQ_FRAC_CONV(L)*CONVECTIVE_CLOUD_LAYER(L)           &
                  /(W_CLOUD(L, I)+TINY(W_CLOUD))
               FRAC_CLOUD(L, I, IP_CLOUD_TYPE_CI)                       &
                  =(1.0E+00-LIQ_FRAC_CONV(L))*CONVECTIVE_CLOUD_LAYER(L) &
                  /(W_CLOUD(L, I)+TINY(W_CLOUD))
!
            ENDDO
         ENDDO
!
!
      ENDIF
!
!
!
!     EFFECTIVE RADII OF WATER CLOUDS: A MICROPHYSICAL PARAMETRIZATION
!     IS AVAILABLE; OTHERWISE STANDARD VALUES ARE USED.
!
      IF (L_MICROPHYSICS) THEN
!
!        STANDARD VALUES ARE USED FOR ICE CRYSTALS, BUT
!        A PARAMETRIZATION PROVIDED BY UMIST AND MRF
!        IS USED FOR DROPLETS.
!
!        CALCULATE THE DENSITY OF AIR.
         DO I=N_LAYER+1-NCLDS, N_LAYER
            DO L=1, N_PROFILE
               DENSITY_AIR(L, I)=P(L, I)/(R*T(L, I))
            ENDDO
         ENDDO
!
         DO L=1, N_PROFILE
            CC_DEPTH(L)=0.0E+00
         ENDDO
!
         DO L=1, N_PROFILE
            LG=I_GATHER(L)
!           This loop should be safe even when convective
!           cloud is not present, since CCB should not exceed CCT.
            DO I=N_LAYER+2-CCT(LG), N_LAYER+1-CCB(LG)
               CC_DEPTH(L)=CC_DEPTH(L)+D_MASS(L, I)/DENSITY_AIR(L, I)
            ENDDO
         ENDDO
!
         DO L=1, N_PROFILE
            LYING_SNOW_G(L)=LYING_SNOW(I_GATHER(L))
         ENDDO
!
         IF (NC_DIAG_FLAG) THEN
            DO I=N_LAYER+1-NCLDS, N_LAYER
               DO L=1, N_PROFILE
                  IF (T(L, I)  >=  TM) THEN
                     STRAT_LIQ_CLOUD_FRACTION(L, I)=W_CLOUD(L, I)       &
                                 *FRAC_CLOUD(L, I, IP_CLOUD_TYPE_SW)
                     CONV_LIQ_CLOUD_FRACTION(L, I)=W_CLOUD(L, I)        &
                                 *FRAC_CLOUD(L, I, IP_CLOUD_TYPE_CW)
                  ELSE
                     STRAT_LIQ_CLOUD_FRACTION(L, I)=0.0
                     CONV_LIQ_CLOUD_FRACTION(L, I)=0.0
                  ENDIF
               ENDDO
            ENDDO
         ENDIF
!
! DEPENDS ON: r2_re_mrf_umist

         CALL R2_RE_MRF_UMIST(&
             N_PROFILE                , &
             N_LAYER                  , &
             NCLDS                    , &
             I_GATHER                 , &
             L_PC2                    , &
             L_AEROSOL_CCN            , &
             L_BIOMASS_CCN            , &
             L_OCFF_CCN               , &
             SEA_SALT_FILM            , &
             SEA_SALT_JET             , &
             L_SEASALT_CCN            , &
             SALT_DIM_A               , &
             SALT_DIM_B               , &
             L_USE_BIOGENIC           , &
             BIOGENIC                 , &
             BIOGENIC_DIM1            , &
             BIOGENIC_DIM2            , &
             ACCUM_SULPHATE           , &
             DISS_SULPHATE            , &
             AITKEN_SULPHATE          , &
             AGED_BMASS               , &
             CLOUD_BMASS              , &
             AGED_OCFF                , &
             CLOUD_OCFF               , &
             LYING_SNOW_G             , &
             I_CLOUD_REPRESENTATION   , &
             LAND_G                   , &
             FLANDG_G                 , &
             DENSITY_AIR              , &
             CONDENSED_MIX_RAT_BULK   , &
             CC_DEPTH                 , &
             CONDENSED_DIM_CHAR       , &
             D_MASS                   , &
             STRAT_LIQ_CLOUD_FRACTION , &
             CONV_LIQ_CLOUD_FRACTION  , &
             NC_DIAG_FLAG             , &
             NC_DIAG_G                , &
             NC_WEIGHT_G              , &
             NTOT_DIAG_G              , &
             Ntot_land                , &
             Ntot_sea                 , &
             STRAT_LWC_DIAG_G         , &
             SO4_CCN_DIAG_G           , &
             SULP_DIM1                , &
             SULP_DIM2                , &
             BMASS_DIM1               , &
             BMASS_DIM2               , &
             OCFF_DIM1                , &
             OCFF_DIM2                , &
             NPD_FIELD                , &
             NPD_PROFILE              , &
             NPD_LAYER                , &
             NPD_AEROSOL_SPECIES        )
!
!        CONSTRAIN THE SIZES OF DROPLETS TO LIE WITHIN THE RANGE OF
!        VALIDITY OF THE PARAMETRIZATION SCHEME.
         DO I=N_LAYER+1-NCLDS, N_LAYER
            DO L=1, N_PROFILE
               CONDENSED_DIM_CHAR(L, I, IP_CLCMP_ST_WATER)              &
                  =MAX(CONDENSED_MIN_DIM(IP_CLCMP_ST_WATER)             &
                  , MIN(CONDENSED_MAX_DIM(IP_CLCMP_ST_WATER)            &
                  , CONDENSED_DIM_CHAR(L, I, IP_CLCMP_ST_WATER)))
               CONDENSED_DIM_CHAR(L, I, IP_CLCMP_CNV_WATER)             &
                  =MAX(CONDENSED_MIN_DIM(IP_CLCMP_CNV_WATER)            &
                  , MIN(CONDENSED_MAX_DIM(IP_CLCMP_CNV_WATER)           &
                  , CONDENSED_DIM_CHAR(L, I, IP_CLCMP_CNV_WATER)))
            ENDDO
         ENDDO
!
!
!        SET MICROPHYSICAL DIAGNOSTICS. WEIGHTS FOR CLOUD CALCULATED
!        HERE ARE USED SOLELY FOR THE MICROPHYSICS AND DO NOT HAVE
!        AN INDEPENDENT MEANING.
!
         IF (WGT_CONV_FLAG) THEN
            IF (I_CLOUD_REPRESENTATION == IP_CLOUD_CONV_STRAT) THEN
               DO I=1, NCLDS
                  DO L=1, N_PROFILE
                     WGT_CONV(col_list(l), row_list(l), I)              &
                        =W_CLOUD(L, N_LAYER+1-I)                        &
                        *FRAC_CLOUD(L, N_LAYER+1-I, IP_CLOUD_TYPE_CONV)
                  ENDDO
               ENDDO
            ELSE IF (I_CLOUD_REPRESENTATION == IP_CLOUD_CSIW) THEN
               DO I=1, NCLDS
                  DO L=1, N_PROFILE
                     WGT_CONV(col_list(l), row_list(l), I)              &
                        =W_CLOUD(L, N_LAYER+1-I)                        &
                        *FRAC_CLOUD(L, N_LAYER+1-I, IP_CLOUD_TYPE_CW)
                  ENDDO
               ENDDO
            ENDIF
         ENDIF
!
         IF (RE_CONV_FLAG) THEN
            DO I=1, NCLDS
               DO L=1, N_PROFILE
!                 EFFECTIVE RADII ARE GIVEN IN MICRONS.
                  RE_CONV(col_list(l), row_list(l), I)                  &
                     =CONDENSED_DIM_CHAR(L, N_LAYER+1-I                 &
                     , IP_CLCMP_CNV_WATER)                              &
                     *WGT_CONV(col_list(l), row_list(l), I)*1.0E+06
               ENDDO
            ENDDO
         ENDIF
!
         IF (WGT_STRAT_FLAG) THEN
            IF (I_CLOUD_REPRESENTATION == IP_CLOUD_CONV_STRAT) THEN
               DO I=1, NCLDS
                  DO L=1, N_PROFILE
                     WGT_STRAT(col_list(l), row_list(l), I)             &
                        =W_CLOUD(L, N_LAYER+1-I)                        &
                        *FRAC_CLOUD(L, N_LAYER+1-I                      &
                        , IP_CLOUD_TYPE_STRAT)
                  ENDDO
               ENDDO
            ELSE IF (I_CLOUD_REPRESENTATION == IP_CLOUD_CSIW) THEN
               DO I=1, NCLDS
                  DO L=1, N_PROFILE
                     WGT_STRAT(col_list(l), row_list(l), I)             &
                        =W_CLOUD(L, N_LAYER+1-I)                        &
                        *FRAC_CLOUD(L, N_LAYER+1-I, IP_CLOUD_TYPE_SW)
                  ENDDO
               ENDDO
            ENDIF
         ENDIF
!
         IF (RE_STRAT_FLAG) THEN
            DO I=1, NCLDS
               DO L=1, N_PROFILE
!                 EFFECTIVE RADII ARE GIVEN IN MICRONS.
                  RE_STRAT(col_list(l), row_list(l), I)                 &
                     =CONDENSED_DIM_CHAR(L, N_LAYER+1-I                 &
                     , IP_CLCMP_ST_WATER)                               &
                     *WGT_STRAT(col_list(l), row_list(l), I)*1.0E+06
               ENDDO
            ENDDO
         ENDIF

         IF (LWP_STRAT_FLAG) THEN
            DO I=1, NCLDS
               DO L=1, N_PROFILE
                  LWP_STRAT(col_list(l), row_list(l), I)                &
                     =CONDENSED_MIX_RAT_AREA(L, N_LAYER+1-I             &
                     , IP_CLCMP_ST_WATER)*D_MASS(L, N_LAYER+1-I)        &
                     *WGT_STRAT(col_list(l), row_list(l), I)
               ENDDO
            ENDDO
         ENDIF

         IF (NC_DIAG_FLAG .AND. NC_WEIGHT_FLAG) THEN
            DO L=1, N_PROFILE
               NC_DIAG(col_list(L), row_list(L))                        &
                  =NC_DIAG_G(L)*NC_WEIGHT_G(L)
            ENDDO
         ENDIF

         IF (NC_WEIGHT_FLAG) THEN
            DO L=1, N_PROFILE
               NC_WEIGHT(col_list(L), row_list(L))=NC_WEIGHT_G(L)
            ENDDO
         ENDIF

         IF (NTOT_DIAG_FLAG) THEN
            DO I=1, NCLDS
               DO L=1, N_PROFILE
                  NTOT_DIAG(col_list(l), row_list(l), I)                &
                     =NTOT_DIAG_G(L, N_LAYER+1-I)                       &
                     *WGT_STRAT(col_list(l), row_list(l), I)
               ENDDO
            ENDDO
         ENDIF

         IF (STRAT_LWC_DIAG_FLAG) THEN
            DO I=1, NCLDS
               DO L=1, N_PROFILE
                  STRAT_LWC_DIAG(col_list(l), row_list(l), I)           &
                     =STRAT_LWC_DIAG_G(L, N_LAYER+1-I)                  &
                     *WGT_STRAT(col_list(l), row_list(l), I)
               ENDDO
            ENDDO
         ENDIF

! Non-cloud diagnostics are "weighted" by the conditional sampling
! weight COND_SAMP_WGT, but as this is 1.0 if the SW radiation is
! active, and 0.0 if it is not, there is no need to actually
! multiply by it.

         IF (COND_SAMP_WGT_FLAG) THEN
            DO I=1, NCLDS
               DO L=1, N_PROFILE
                  COND_SAMP_WGT(col_list(l), row_list(l), I)=1.0
               ENDDO
            ENDDO
         ENDIF

         IF (SO4_CCN_DIAG_FLAG) THEN
            DO I=1, NCLDS
               DO L=1, N_PROFILE
                  SO4_CCN_DIAG(col_list(l), row_list(l), I)             &
                          =SO4_CCN_DIAG_G(L, N_LAYER+1-I)
               ENDDO
            ENDDO
         ENDIF
!
!
      ELSE
!
!        ALL EFFECTIVE RADII ARE SET TO STANDARD VALUES.
!
         DO I=N_LAYER+1-NCLDS, N_LAYER
            DO L=1, N_PROFILE
               CONDENSED_DIM_CHAR(L, I, IP_CLCMP_ST_WATER)=7.E-6
               CONDENSED_DIM_CHAR(L, I, IP_CLCMP_CNV_WATER)=7.E-6
            ENDDO
         ENDDO
!
      ENDIF
!
!
!
!     SET THE CHARACTERISTIC DIMENSIONS OF ICE CRYSTALS:
!
!     ICE CRYSTALS IN STRATIFORM CLOUDS:
!
      IF (I_CONDENSED_PARAM(IP_CLCMP_ST_ICE) ==                         &
         IP_SLINGO_SCHRECKER_ICE) THEN
!
!        THIS PARAMETRIZATION IS BASED ON THE EFFECTIVE RADIUS
!        AND A STANDARD VALUE OF 30-MICRONS IS ASSUMED.
!
         DO I=N_LAYER+1-NCLDS, N_LAYER
            DO L=1, N_PROFILE
               CONDENSED_DIM_CHAR(L, I, IP_CLCMP_ST_ICE)=30.E-6
            ENDDO
         ENDDO
!
      ELSE IF (I_CONDENSED_PARAM(IP_CLCMP_ST_ICE) ==                    &
         IP_ICE_ADT) THEN
!
!        THIS PARAMETRIZATION IS BASED ON THE MEAN MAXIMUM
!        DIMENSION OF THE CRYSTAL, DETERMINED AS A FUNCTION OF
!        THE LOCAL TEMPERATURE. THE SIZE IS LIMITED TO ITS VALUE
!        AT THE FREEZING LEVEL.
!
         DO I=N_LAYER+1-NCLDS, N_LAYER
            DO L=1, N_PROFILE
               CONDENSED_DIM_CHAR(L, I, IP_CLCMP_ST_ICE)                &
                  =MIN(7.198755E-04                                     &
                  , EXP(5.522E-02*(T(L, I)-2.7965E+02))/9.702E+02)
            ENDDO
         ENDDO
!
      ELSE IF (I_CONDENSED_PARAM(IP_CLCMP_ST_ICE) ==                    &
         IP_ICE_AGG_DE) THEN
!
!      Aggregate parametrization based on effective dimension.
!      In the initial form, the same approach is used for stratiform
!      and convective cloud.
!
!      The fit provided here is based on Stephan Havemann's fit of
!      Dge with temperature, consistent with David Mitchell's treatment
!      of the variation of the size distribution with temperature. The
!      parametrization of the optical properties is based on De
!      (=(3/2)volume/projected area), whereas Stephan's fit gives Dge
!      (=(2*SQRT(3)/3)*volume/projected area), which explains the
!      conversion factor. The fit to Dge is in two sections, because
!      Mitchell's relationship predicts a cusp at 216.208 K. Limits
!      of 8 and 124 microns are imposed on Dge: these are based on this
!      relationship and should be reviewed if it is changed. Note also
!      that the relationship given here is for polycrystals only.
       DO I=N_LAYER+1-NCLDS, N_LAYER
         DO L=1, N_PROFILE
!          Preliminary calculation of Dge.
           IF (T(L, I) < t_switch) THEN
             CONDENSED_DIM_CHAR(L, I, IP_CLCMP_ST_ICE)                  &
               = a0_agg_cold*EXP(s0_agg*(T(L, I)-t0_agg))+b0_agg_cold
           ELSE
             CONDENSED_DIM_CHAR(L, I, IP_CLCMP_ST_ICE)                  &
               = a0_agg_warm*EXP(s0_agg*(T(L, I)-t0_agg))+b0_agg_warm
           ENDIF
!          Limit and convert to De.
           CONDENSED_DIM_CHAR(L, I, IP_CLCMP_ST_ICE)                    &
             = (3.0/2.0)*(3.0/(2.0*SQRT(3.0)))*                         &
               MIN(1.24E-04, MAX(8.0E-06,                               &
               CONDENSED_DIM_CHAR(L, I, IP_CLCMP_ST_ICE)))
         ENDDO
       ENDDO
!
      ENDIF
!
!
!     ICE CRYSTALS IN CONVECTIVE CLOUDS:
!
      IF (I_CONDENSED_PARAM(IP_CLCMP_CNV_ICE) ==                        &
         IP_SLINGO_SCHRECKER_ICE) THEN
!
!        THIS PARAMETRIZATION IS BASED ON THE EFFECTIVE RADIUS
!        AND A STANDARD VALUE OF 30-MICRONS IS ASSUMED.
!
         DO I=N_LAYER+1-NCLDS, N_LAYER
            DO L=1, N_PROFILE
               CONDENSED_DIM_CHAR(L, I, IP_CLCMP_CNV_ICE)=30.E-6
            ENDDO
         ENDDO
!
      ELSE IF (I_CONDENSED_PARAM(IP_CLCMP_CNV_ICE) ==                   &
         IP_ICE_ADT) THEN
!
!        THIS PARAMETRIZATION IS BASED ON THE MEAN MAXIMUM
!        DIMENSION OF THE CRYSTAL, DETERMINED AS A FUNCTION OF
!        THE LOCAL TEMPERATURE. THE SIZE IS LIMITED TO ITS VALUE
!        AT THE FREEZING LEVEL.
!
         DO I=N_LAYER+1-NCLDS, N_LAYER
            DO L=1, N_PROFILE
               CONDENSED_DIM_CHAR(L, I, IP_CLCMP_CNV_ICE)               &
                  =MIN(7.198755E-04                                     &
                  , EXP(5.522E-02*(T(L, I)-2.7965E+02))/9.702E+02)
            ENDDO
         ENDDO
      ELSE IF (I_CONDENSED_PARAM(IP_CLCMP_CNV_ICE) ==                   &
         IP_ICE_AGG_DE) THEN
!
!      Aggregate parametrization based on effective dimension.
!      In the initial form, the same approach is used for stratiform
!      and convective cloud.
!
!      The fit provided here is based on Stephan Havemann's fit of
!      Dge with temperature, consistent with David Mitchell's treatment
!      of the variation of the size distribution with temperature. The
!      parametrization of the optical properties is based on De
!      (=(3/2)volume/projected area), whereas Stephan's fit gives Dge
!      (=(2*SQRT(3)/3)*volume/projected area), which explains the
!      conversion factor. The fit to Dge is in two sections, because
!      Mitchell's relationship predicts a cusp at 216.208 K. Limits
!      of 8 and 124 microns are imposed on Dge: these are based on this
!      relationship and should be reviewed if it is changed. Note also
!      that the relationship given here is for polycrystals only.
       DO I=N_LAYER+1-NCLDS, N_LAYER
         DO L=1, N_PROFILE
!          Preliminary calculation of Dge.
           IF (T(L, I) < t_switch) THEN
             CONDENSED_DIM_CHAR(L, I, IP_CLCMP_CNV_ICE)                 &
               = a0_agg_cold*EXP(s0_agg*(T(L, I)-t0_agg))+b0_agg_cold
           ELSE
             CONDENSED_DIM_CHAR(L, I, IP_CLCMP_CNV_ICE)                 &
               = a0_agg_warm*EXP(s0_agg*(T(L, I)-t0_agg))+b0_agg_warm
           ENDIF
!          Limit and convert to De.
           CONDENSED_DIM_CHAR(L, I, IP_CLCMP_CNV_ICE)                   &
             = (3.0/2.0)*(3.0/(2.0*SQRT(3.0)))*                         &
               MIN(1.24E-04, MAX(8.0E-06,                               &
               CONDENSED_DIM_CHAR(L, I, IP_CLCMP_CNV_ICE)))
         ENDDO
       ENDDO
!
!
      ENDIF
!
!
!
!     CONSTRAIN THE SIZES OF ICE CRYSTALS TO LIE WITHIN THE RANGE
!     OF VALIDITY OF THE PARAMETRIZATION SCHEME.
      DO I=N_LAYER+1-NCLDS, N_LAYER
         DO L=1, N_PROFILE
            CONDENSED_DIM_CHAR(L, I, IP_CLCMP_ST_ICE)                   &
               =MAX(CONDENSED_MIN_DIM(IP_CLCMP_ST_ICE)                  &
               , MIN(CONDENSED_MAX_DIM(IP_CLCMP_ST_ICE)                 &
               , CONDENSED_DIM_CHAR(L, I, IP_CLCMP_ST_ICE)))
            CONDENSED_DIM_CHAR(L, I, IP_CLCMP_CNV_ICE)                  &
               =MAX(CONDENSED_MIN_DIM(IP_CLCMP_CNV_ICE)                 &
               , MIN(CONDENSED_MAX_DIM(IP_CLCMP_CNV_ICE)                &
               , CONDENSED_DIM_CHAR(L, I, IP_CLCMP_CNV_ICE)))
         ENDDO
      ENDDO
!
!
!
      RETURN
      END SUBROUTINE R2_SET_CLOUD_FIELD
!+ Subroutine to set the parametrization schemes for clouds.
!
! Purpose:
!   The parametrization schemes for each component within a cloud
!   are set.
!
! Method:
!   Straightforward.
!
! Current Owner of Code: J. M. Edwards
!
! History:
!       Version         Date                    Comment
!       4.0             27-07-95                Original Code
!                                               (J. M. Edwards)
!       4.4             15-09-97                Code to check the
!                                               range of validity of
!                                               parametrizations
!                                               added.
!                                               (J. M. Edwards)
!       4.5             18-05-98                Error message for
!                                               ice corrected.
!                                               (J. M. Edwards)
!
! Description of Code:
!   FORTRAN 77  with extensions listed in documentation.
!
!- ---------------------------------------------------------------------
!+ Subroutine to set fields of aerosols.
!
! Purpose:
!   The mixing ratios of aerosols are transferred to the large array.
!
! Method:
!   Straightforward.
!
! Current Owner of Code: J. M. Edwards
!
! History:
!       Version         Date                    Comment
!       4.0             27-07-95                Original Code
!                                               (J. M. Edwards)
!       4.1             12-06-96                Code rewritten to
!                                               include two types
!                                               of sulphate provided
!                                               by the sulphur cycle.
!                                               (J. M. Edwards)
!       4.2             08-08-96                Climatological aerosol
!                                               model added.
!                                               (J. M. Edwards)
!       4.4             15-09-97                Code for aerosols
!                                               generalized to allow
!                                               arbitrary combinations.
!                                               (J. M. Edwards)
!       4.5   April 1998   Option to use interactive soot in place
!                          of climatological soot.     Luke Robinson.
!                          (Repositioned more logically at 5.1)
!                                                      J. M. Edwards
!       5.1             11-04-00                The boundary layer
!                                               depth is passed to
!                                               the routine setting
!                                               the climatological
!                                               aerosol.
!                                               (J. M. Edwards)
!       5.2             14-11-00                Add provision for an
!                                               extra radiative layer
!                                               above the top of the
!                                               model.
!                                               (J. M. Edwards)
!       5.2             15-11-00                Set up sea-salt aerosol
!                                               (and deactivate climat-
!                                               ological sea-salt) if
!                                               required.
!                                               (A. Jones)
!       5.3             16-10-01                Switch off the
!                                               climatological
!                                               water soluble aerosol
!                                               when the sulphur
!                                               cycle is on.
!                                               (J. M. Edwards)
!       5.3             04-04-01                Include mesoscale
!                                               aerosols if required.
!                                                            S. Cusack
!       5.4             09-05-02                Use L_USE_SOOT_DIRECT
!                                               to govern the extra-
!                                               polation of aerosol
!                                               soot to the extra top
!                                               layer if required.
!                                               (A. Jones)
!       5.5             05-02-03                Include biomass aerosol
!                                               if required.  P Davison
!       5.5             10-01-03                Revision to sea-salt
!                                               density parameter.
!                                               (A. Jones)
!       5.5             21-02-03                Include mineral dust
!                                               aerosol if required.
!                                               S Woodward
!
! Description of Code:
!   FORTRAN 77  with extensions listed in documentation.
!
!- ---------------------------------------------------------------------
!+ Subroutine to set fields of climatological aerosols in HADCM3.
!
! Purpose:
!   This routine sets the mixing ratios of climatological aerosols.
!   A separate subroutine is used to ensure that the mixing ratios
!   of these aerosols are bit-comparable with earlier versions of
!   the model where the choice of aerosols was more restricted:
!   keeping the code in its original form reduces the opportunity
!   for optimizations which compromise bit-reproducibilty.
!   The climatoogy used here is the one devised for HADCM3.
!
! Method:
!   Straightforward.
!
! Current Owner of Code: J. M. Edwards
!
! History:
!       Version         Date                    Comment
!       4.4             29-09-97                Original Code
!                                               very closely based on
!                                               previous versions of
!                                               this scheme.
!                                               (J. M. Edwards)
!  4.5  12/05/98  Swap loop order in final nest of loops to
!                 improve vectorization.  RBarnes@ecmwf.int
!       5.2             14-11-00                Add provision for an
!                                               extra radiative layer
!                                               above the top of the
!                                               model.
!                                               (J. M. Edwards)
!       5.2             14-11-00                Impose a minimum
!                                               thickness on the
!                                               layer filled by the
!                                               boundary layer
!                                               aerosol and correct
!                                               the dimensioning of T.
!                                               (J. M. Edwards)
!       5.3             17-10-01                Restrict the height
!                                               of the BL to ensure
!                                               that at least one layer
!                                               lies in the free
!                                               troposphere in all
!                                               cases. This is needed
!                                               to allow for changes
!                                               in the range of the
!                                               tropopause.
!
! Description of Code:
!   FORTRAN 77  with extensions listed in documentation.
!
!- ---------------------------------------------------------------------
!+ Subroutine to calculate the total cloud cover.
!
! Purpose:
!   The total cloud cover at all grid-points is determined.
!
! Method:
!   A separate calculation is made for each different assumption about
!   the overlap.
!
! Current Owner of Code: J. M. Edwards
!
! History:
!       Version         Date                    Comment
!       4.0             27-07-95                Original Code
!                                               (J. M. Edwards)
!       4.2             08-08-96                Code added for coherent
!                                               convective cloud.
!                                               (J. M. Edwards)
!       5.2             14-11-00                Add provision for an
!                                               extra radiative layer
!                                               above the top of the
!                                               model.
!                                               (J. M. Edwards)
!       5.4             22-07-02                Check that cloud
!                                               fraction is between 0
!                                               and 1 for PC2 scheme.
!                                               (D. Wilson)
!
! Description of Code:
!   FORTRAN 77  with extensions listed in documentation.
!
!- ---------------------------------------------------------------------
!+ Subroutine to implement the MRF UMIST parametrization.
!
! Purpose:
!   Effective Radii are calculated in accordance with this
!   parametrization.
!
! Method:
!   The number density of CCN is found from the concentration
!   of aerosols, if available. This yields the number density of
!   droplets: if aerosols are not present, the number of droplets
!   is fixed. Effective radii are calculated from the number of
!   droplets and the LWC. Limits are applied to these values. In
!   deep convective clouds fixed values are assumed.
!
! Current Owner of Code: J. M. Edwards
!
! History:
!       Version         Date                    Comment
!       4.0             27-07-95                Original Code
!                                               (J. M. Edwards)
!       4.4             15-09-97                Accumulation-mode
!                                               and dissolved sulphate
!                                               passed directly to
!                                               this routine to allow
!                                               the indirect effect to
!                                               be used without
!                                               aerosols being needed
!                                               in the spectral file.
!                                               (J. M. Edwards)
!       4.5             18-05-98                Obsolete bounds on
!                                               effective radius
!                                               removed.
!                                               (J. M. Edwards)
!       5.2             14-11-00                Add provision for an
!                                               extra radiative layer
!                                               above the top of the
!                                               model.
!                                               (J. M. Edwards)
!       5.2             15-11-00                Subroutine for droplet
!                                               number concentration
!                                               replaced by new function
!                                               with option to use sea-
!                                               salt to supplement
!                                               sulphate aerosol.
!                                               Treatment of convective
!                                               cloud effective radii
!                                               updated.
!                                               (A. Jones)
!       6.1             07-04-04                Add biomass smoke
!                                               aerosol to call to
!                                               NUMBER_DROPLET.
!                                               (A. Jones)
!       6.1             07-04-04                Add new variables for
!                                               column cloud droplet
!                                               calculation.
!                                               (A. Jones)
!       6.2             24-11-05                Pass Ntot_land and
!                                               Ntot_sea from UMUI.
!                                               (Damian Wilson)
!       6.2             02-03-05                Protect calculations
!                                               from failure in PC2
!                                               (Damian Wilson)
!
! Description of Code:
!   FORTRAN 77  with extensions listed in documentation.
!
!- ---------------------------------------------------------------------
!+ Subroutine to calculate column-integrated cloud droplet number.
!
! Purpose:
!   To calculate a diagnostic of column-integrated cloud droplet
!   number which may be validated aginst satellite data.
!
! Method:
!   Column cloud droplet concentration (i.e. number of droplets per
!   unit area) is calculated as the vertically integrated droplet
!   number concentration averaged over the portion of the gridbox
!   covered by stratiform and convective liquid cloud with T>273K.
!
! Current Owner of Code: A. Jones
!
! History:
!       Version         Date                    Comment
!       5.4             29-05-02                Original Code
!                                               (A. Jones)
!       6.1             07-04-04                Modified in accordance
!                                               with AVHRR retrievals:
!                                               only clouds >273K used,
!                                               convective clouds also
!                                               included.
!                                               (A. Jones)
!
!
! Description of Code:
!   FORTRAN 77  with extensions listed in documentation.
!
!- ---------------------------------------------------------------------
!+ Subroutine to set the actual process options for the radiation code.
!
! Purpose:
!   To set a consistent set of process options for the radiation.
!
! Method:
!   The global options for the spectral region are compared with the
!   contents of the spectral file. The global options should be set
!   to reflect the capabilities of the code enabled in the model.
!
! Current Owner of Code: J. M. Edwards
!
! History:
!       Version         Date                    Comment
!       4.1             04-03-96                Original Code
!                                               (J. M. Edwards)
!                                               Parts of this code are
!                                               rather redundant. The
!                                               form of writing is for
!                                               near consistency with
!                                               HADAM3.
!
!       4.5   April 1998   Check for inconsistencies between soot
!                          spectral file and options used. L Robinson.
!       5.3     04/04/01   Include mesoscale aerosol switch when
!                          checking if aerosols are required.  S. Cusack
!       5.4     09/05/02   Include logical flag for sea-salt aerosol.
!                                                              A. Jones
!       5.5     05/02/03   Include logical for biomass smoke
!                          aerosol.               P Davison
! Description of Code:
!   5.5    21/02/03 Add logical for d mineral dust
!                                                S Woodward
!   FORTRAN 77  with extensions listed in documentation.
!
!- ---------------------------------------------------------------------




! *****************************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_FOCWWIL--------------------------------------------
!LL
!LL  Purpose: Calculate from temperature the Fraction Of Cloud Water
!LL           Which Is Liquid.
!LL     NOTE: Operates within range 0 to -9 deg.C based upon MRF
!LL           observational analysis. Not robust to changes in TM or T0C
!LL
!LL A.Bushell   <- programmer of some or all of previous code or changes
!LL
!LL  Model
!LL version  Date     Modification history from model version 4.0:
!LL
!LL   4.0    27/09/95 Subroutine created from in-line COMDECK.
!       6.2             21/02/06   Updefs Added for version
!                                  control of radiation code
!                                            (J.-C. Thelen)
!LL
!LL
!LL  Programming standard: Unified Model Documentation Paper No 4,
!LL                        Version 1, dated 12/9/89.
!LL
!LL  Logical component covered: Part of P26.
!LL
!LL  System task:
!LL
!LL  Documentation: Unified Model Documentation Paper No 26: Eq 26.50.
!LL
!LL  Called by components P26, P23.
!*
!*L  Arguments:---------------------------------------------------------
      SUBROUTINE LSP_FOCWWIL( &
      T         , &!INTEGER, INTENT(IN   ) :: POINTS          ! IN Number of points to be processed.
      POINTS    , &!REAL   , INTENT(IN   ) :: T(POINTS)       ! IN Temperature at this level (K).
      ROCWWIL     )!REAL   , INTENT(OUT  ) :: ROCWWIL(POINTS) ! OUT Ratio Of Cloud Water Which Is Liquid.

      IMPLICIT NONE
          ! Input integer scalar :-
      INTEGER, INTENT(IN   ) :: POINTS          ! IN Number of points to be processed.
          ! Input real arrays :-
      REAL   , INTENT(IN   ) :: T(POINTS)       ! IN Temperature at this level (K).
          ! Updated real arrays :-
      REAL   , INTENT(OUT  ) :: ROCWWIL(POINTS) ! OUT Ratio Of Cloud Water Which Is Liquid.
!*L   External subprogram called :-
!     EXTERNAL None.
!*
!-----------------------------------------------------------------------
!  Common, then local, physical constants.
!-----------------------------------------------------------------------
!*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, Parameter :: ZeroDegC = 273.15
      Real, Parameter :: TFS      = 271.35
      Real, Parameter :: TM       = 273.15

!*----------------------------------------------------------------------
      REAL ,PARAMETER     :: TSTART=TM ! Temperature at which ROCWWIL reaches 1.
      REAL ,PARAMETER     :: TRANGE=9.0! Temperature range over which 0 < ROCWWIL < 1.
!-----------------------------------------------------------------------
!  Define local scalars.
!-----------------------------------------------------------------------
!  (a) Reals effectively expanded to workspace by the Cray (using
!      vector registers).
                        ! Real workspace. At end of DO loop, contains :-
      REAL :: TFOC      ! T(I) within DO loop. Allows routines to call
!                        LSP_FOCWWIL(WORK1, POINTS, WORK1) to save space
!  (b) Others.
      INTEGER :: I       ! Loop counter (horizontal field index).
!
      DO  I = 1, POINTS
!
        TFOC = T(I)
!-----------------------------------------------------------------------
!L 0. Calculate fraction of cloud water which is liquid (FL),
!L    according to equation P26.50.
!-----------------------------------------------------------------------
        IF (TFOC  <=  (TSTART - TRANGE)) THEN
!       Low temperatures, cloud water all frozen------------------------
          ROCWWIL(I) = 0.0
!
        ELSE IF (TFOC  <   TSTART) THEN
!       Intermediate temperatures---------------------------------------
          ROCWWIL(I) = (TFOC - TSTART + TRANGE) / TRANGE
!
        ELSE
!       High temperatures, cloud water all liquid-----------------------
          ROCWWIL(I) = 1.0
!
        END IF
!
      END DO ! Loop over points
!
      RETURN
      END SUBROUTINE LSP_FOCWWIL




! *****************************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 to set the mixing ratios of gases.
!
! Purpose:
!   The full array of mass mixing ratios of gases is filled.
!
! Method:
!   The arrays of supplied mixing ratios are inverted and fed
!   into the array to pass to the radiation code. For well-mixed
!   gases the constant mixing ratios are fed into this array.
!
! Current Owner of Code: J. M. Edwards
!
! History:
!       Version         Date                    Comment
!       4.0             27-07-95                Original Code
!                                               (J. M. Edwards)
!       4.1             10-06-96                Ozone set in lower
!                                               levels.
!                                               (J. M. Edwards)
!       4.4             26-09-97                Conv. cloud amount on
!                                               model levs allowed for.
!                                               J.M.Gregory
!       4.5             18-05-98                Provision for treating
!                                               extra (H)(C)FCs
!                                               included.
!                                               (J. M. Edwards)
!       5.1             06-04-00                Move HCFCs to a more
!                                               natural place in the
!                                               code.
!                                               (J. M. Edwards)
!       5.1             06-04-00                Remove the explicit
!                                               limit on the
!                                               concentration of
!                                               water vapour.
!                                               (J. M. Edwards)
!       5.2             14-11-00                Add provision for an
!                                               extra radiative layer
!                                               above the top of the
!                                               model.
!                                               (J. M. Edwards)
!       5.4             29-05-02                Add diagnostic call
!                                               for column-integrated
!                                               cloud droplet number.
!                                               (A. Jones)
!       5.4             25-04-02                Replace land/sea mask
!                                               with land fraction in
!                                               call to NUMBER_DROPLET
!                                               (A. Jones)
!       5.5             17-02-03                Change I_CLIM_POINTER
!                                               for hp compilation
!                                               (M.Hughes)
!  6.1   20/08/03  Code for STOCHEM feedback.  C. Johnson
!       6.2             21/02/06   Updefs Added for version
!                                  control of radiation code
!                                            (J.-C. Thelen)
!  6.2   03-11-05   Enable HadGEM1 climatological aerosols. C. F. Durman
!                   Reworked to use switch instead of #defined. R Barnes
!  6.2   25/05/05  Convert compilation into a more universally portable
!                  form. Tom Edwards
!  6.2   15/12/05  Set negative specific humidities to zero.
!                                               (J. Manners)
!
! Description of Code:
!   FORTRAN 77  with extensions listed in documentation.
!
!- ---------------------------------------------------------------------
!+ Subroutine to set thermodynamic properties
!
! Purpose:
!   Pressures, temperatures at the centres and edges of layers
!   and the masses in layers are set.
!
! Method:
!   Straightforward.
!
! Current Owner of Code: J. M. Edwards
!
! History:
!       Version         Date                    Comment
!       4.0             27-07-95                Original Code
!                                               (J. M. Edwards)
!       4.1             10-06-96                Old formulation over
!                                               sea-ice removed.
!                                               (J. M. Edwards)
!       4.2             08-08-96                Ground temperature
!                                               set equal to that
!                                               in the middle of the
!                                               bottom layer.
!                                               (J. M. Edwards)
!       5.2             14-11-00                Add provision for an
!                                               extra radiative layer
!                                               above the top of the
!                                               model.
!                                               (J. M. Edwards)
!       5.3             25-04-01                Alter the specification
!                                               of temperature on rho
!                                               levels (layer
!                                               boundaries).  S.Cusack
!       5.3             25-04-01   Gather land, sea and
!                                  sea-ice temperatures and
!                                  land fraction. Replace TFS
!                                  with general sea temperature.
!                                       (N. Gedney)
!
! Description of Code:
!   FORTRAN 77  with extensions listed in documentation.
!
!- ---------------------------------------------------------------------
!+ Subroutine to assign Properties of Clouds.
!
! Purpose:
!   The fractions of different types of clouds and their microphysical
!   preoperties are set.
!
! Method:
!   Straightforward.
!
! Current Owner of Code: J. M. Edwards
!
! History:
!       Version         Date                    Comment
!       4.0             27-07-95                Original Code
!                                               (J. M. Edwards)
!       4.1             10-06-96                New flag L_AEROSOL_CCN
!                                               introduced to allow
!                                               inclusion of indirect
!                                               aerosol forcing alone.
!                                               Correction of comments
!                                               for LCCWC1 and LCCWC2.
!                                               Correction of level at
!                                               which temperature for
!                                               partitioning
!                                               convective homogeneously
!                                               mixed cloud is taken.
!                                               (J. M. Edwards)
!       4.4             08-04-97                Changes for new precip
!                                               scheme (qCF prognostic)
!                                               (A. C. Bushell)
!       4.4             15-09-97                A parametrization of
!                                               ice crystals with a
!                                               temperature dependedence
!                                               of the size has been
!                                               added.
!                                               Explicit checking of
!                                               the sizes of particles
!                                               for the domain of
!                                               validity of the para-
!                                               metrization has been
!                                               added.
!                                               (J. M. Edwards)
!       5.0             15-04-98   Changes to R2_SET_CLOUD_FIELD to use
!                                  original sect 9 cloud fraction when
!                                  an extended 'area' cloud fraction is
!                                  used everywhere else in Radiation.
!                                  A.C.Bushell
!       4.5             18-05-98                New option for
!                                               partitioning between
!                                               ice and water in
!                                               convective cloud
!                                               included.
!                                               (J. M. Edwards)
!       4.5             13/05/98   Changes to R2_SET_CLOUD_FIELD to use
!                                  original sect 9 cloud fraction when
!                                  an extended 'area' cloud fraction is
!                                  used everywhere else in Radiation.
!                                  S. Cusack
!       5.1             04-04-00                Remove obsolete tests
!                                               for convective cloud
!                                               and removal of very
!                                               thin cloud (no longer
!                                               required with current
!                                               solvers, but affects
!                                               bit-comparison).
!                                               (J. M. Edwards)
!       5.1             06-04-00                Correct some comments
!                                               and error messages.
!                                               (J. M. Edwards)
!       5.2             10-11-00                With local partitioning
!                                               of convective cloud
!                                               between water and ice
!                                               force homogeneous
!                                               nucleation at
!                                               -40 Celsius.
!       5.2             14-11-00                Add provision for an
!                                               extra radiative layer
!                                               above the top of the
!                                               model.
!                                               (J. M. Edwards)
!       5.2             15-11-00                Pass sea-salt variables
!                                               down to R2_RE_MRF_UMIST.
!                                               (A. Jones)
!       5.3             11-10-01                Convert returned
!                                               diagnostics to 2-D
!                                               arrays.
!                                               (J. M. Edwards)
!       5.4             22-07-02                Check on small cloud
!                                               fractions and liquid for
!                                               contents for PC2 scheme.
!                                               (D. Wilson)
!       5.5             24-02-03                Addition of new ice
!                                               aggregate
!                                               parametrization.
!                                               (J. M. Edwards)
!       6.1             07-04-04                Add biomass smoke
!                                               aerosol to call to
!                                               R2_RE_MRF_UMIST.
!                                               (A. Jones)
!       6.1             07-04-04                Add variables for
!                                               column-droplet
!                                               calculation.
!                                               (A. Jones)
!       6.2             24-11-05                Pass Ntot_land and
!                                               Ntot_sea from UMUI.
!                                               (Damian Wilson)
!       6.2             02-03-05                Pass through PC2 logical
!                                               (Damian Wilson)
!
!
! Description of Code:
!   FORTRAN 77  with extensions listed in documentation.
!
!- ---------------------------------------------------------------------
!+ Subroutine to set the parametrization schemes for clouds.
!
! Purpose:
!   The parametrization schemes for each component within a cloud
!   are set.
!
! Method:
!   Straightforward.
!
! Current Owner of Code: J. M. Edwards
!
! History:
!       Version         Date                    Comment
!       4.0             27-07-95                Original Code
!                                               (J. M. Edwards)
!       4.4             15-09-97                Code to check the
!                                               range of validity of
!                                               parametrizations
!                                               added.
!                                               (J. M. Edwards)
!       4.5             18-05-98                Error message for
!                                               ice corrected.
!                                               (J. M. Edwards)
!
! Description of Code:
!   FORTRAN 77  with extensions listed in documentation.
!
!- ---------------------------------------------------------------------
!+ Subroutine to set fields of aerosols.
!
! Purpose:
!   The mixing ratios of aerosols are transferred to the large array.
!
! Method:
!   Straightforward.
!
! Current Owner of Code: J. M. Edwards
!
! History:
!       Version         Date                    Comment
!       4.0             27-07-95                Original Code
!                                               (J. M. Edwards)
!       4.1             12-06-96                Code rewritten to
!                                               include two types
!                                               of sulphate provided
!                                               by the sulphur cycle.
!                                               (J. M. Edwards)
!       4.2             08-08-96                Climatological aerosol
!                                               model added.
!                                               (J. M. Edwards)
!       4.4             15-09-97                Code for aerosols
!                                               generalized to allow
!                                               arbitrary combinations.
!                                               (J. M. Edwards)
!       4.5   April 1998   Option to use interactive soot in place
!                          of climatological soot.     Luke Robinson.
!                          (Repositioned more logically at 5.1)
!                                                      J. M. Edwards
!       5.1             11-04-00                The boundary layer
!                                               depth is passed to
!                                               the routine setting
!                                               the climatological
!                                               aerosol.
!                                               (J. M. Edwards)
!       5.2             14-11-00                Add provision for an
!                                               extra radiative layer
!                                               above the top of the
!                                               model.
!                                               (J. M. Edwards)
!       5.2             15-11-00                Set up sea-salt aerosol
!                                               (and deactivate climat-
!                                               ological sea-salt) if
!                                               required.
!                                               (A. Jones)
!       5.3             16-10-01                Switch off the
!                                               climatological
!                                               water soluble aerosol
!                                               when the sulphur
!                                               cycle is on.
!                                               (J. M. Edwards)
!       5.3             04-04-01                Include mesoscale
!                                               aerosols if required.
!                                                            S. Cusack
!       5.4             09-05-02                Use L_USE_SOOT_DIRECT
!                                               to govern the extra-
!                                               polation of aerosol
!                                               soot to the extra top
!                                               layer if required.
!                                               (A. Jones)
!       5.5             05-02-03                Include biomass aerosol
!                                               if required.  P Davison
!       5.5             10-01-03                Revision to sea-salt
!                                               density parameter.
!                                               (A. Jones)
!       5.5             21-02-03                Include mineral dust
!                                               aerosol if required.
!                                               S Woodward
!
! Description of Code:
!   FORTRAN 77  with extensions listed in documentation.
!
!- ---------------------------------------------------------------------
!+ Subroutine to set fields of climatological aerosols in HADCM3.
!
! Purpose:
!   This routine sets the mixing ratios of climatological aerosols.
!   A separate subroutine is used to ensure that the mixing ratios
!   of these aerosols are bit-comparable with earlier versions of
!   the model where the choice of aerosols was more restricted:
!   keeping the code in its original form reduces the opportunity
!   for optimizations which compromise bit-reproducibilty.
!   The climatoogy used here is the one devised for HADCM3.
!
! Method:
!   Straightforward.
!
! Current Owner of Code: J. M. Edwards
!
! History:
!       Version         Date                    Comment
!       4.4             29-09-97                Original Code
!                                               very closely based on
!                                               previous versions of
!                                               this scheme.
!                                               (J. M. Edwards)
!  4.5  12/05/98  Swap loop order in final nest of loops to
!                 improve vectorization.  RBarnes@ecmwf.int
!       5.2             14-11-00                Add provision for an
!                                               extra radiative layer
!                                               above the top of the
!                                               model.
!                                               (J. M. Edwards)
!       5.2             14-11-00                Impose a minimum
!                                               thickness on the
!                                               layer filled by the
!                                               boundary layer
!                                               aerosol and correct
!                                               the dimensioning of T.
!                                               (J. M. Edwards)
!       5.3             17-10-01                Restrict the height
!                                               of the BL to ensure
!                                               that at least one layer
!                                               lies in the free
!                                               troposphere in all
!                                               cases. This is needed
!                                               to allow for changes
!                                               in the range of the
!                                               tropopause.
!
! Description of Code:
!   FORTRAN 77  with extensions listed in documentation.
!
!- ---------------------------------------------------------------------
!+ Subroutine to calculate the total cloud cover.
!
! Purpose:
!   The total cloud cover at all grid-points is determined.
!
! Method:
!   A separate calculation is made for each different assumption about
!   the overlap.
!
! Current Owner of Code: J. M. Edwards
!
! History:
!       Version         Date                    Comment
!       4.0             27-07-95                Original Code
!                                               (J. M. Edwards)
!       4.2             08-08-96                Code added for coherent
!                                               convective cloud.
!                                               (J. M. Edwards)
!       5.2             14-11-00                Add provision for an
!                                               extra radiative layer
!                                               above the top of the
!                                               model.
!                                               (J. M. Edwards)
!       5.4             22-07-02                Check that cloud
!                                               fraction is between 0
!                                               and 1 for PC2 scheme.
!                                               (D. Wilson)
!
! Description of Code:
!   FORTRAN 77  with extensions listed in documentation.
!
!- ---------------------------------------------------------------------
!+ Subroutine to implement the MRF UMIST parametrization.
!
! Purpose:
!   Effective Radii are calculated in accordance with this
!   parametrization.
!
! Method:
!   The number density of CCN is found from the concentration
!   of aerosols, if available. This yields the number density of
!   droplets: if aerosols are not present, the number of droplets
!   is fixed. Effective radii are calculated from the number of
!   droplets and the LWC. Limits are applied to these values. In
!   deep convective clouds fixed values are assumed.
!
! Current Owner of Code: J. M. Edwards
!
! History:
!       Version         Date                    Comment
!       4.0             27-07-95                Original Code
!                                               (J. M. Edwards)
!       4.4             15-09-97                Accumulation-mode
!                                               and dissolved sulphate
!                                               passed directly to
!                                               this routine to allow
!                                               the indirect effect to
!                                               be used without
!                                               aerosols being needed
!                                               in the spectral file.
!                                               (J. M. Edwards)
!       4.5             18-05-98                Obsolete bounds on
!                                               effective radius
!                                               removed.
!                                               (J. M. Edwards)
!       5.2             14-11-00                Add provision for an
!                                               extra radiative layer
!                                               above the top of the
!                                               model.
!                                               (J. M. Edwards)
!       5.2             15-11-00                Subroutine for droplet
!                                               number concentration
!                                               replaced by new function
!                                               with option to use sea-
!                                               salt to supplement
!                                               sulphate aerosol.
!                                               Treatment of convective
!                                               cloud effective radii
!                                               updated.
!                                               (A. Jones)
!       6.1             07-04-04                Add biomass smoke
!                                               aerosol to call to
!                                               NUMBER_DROPLET.
!                                               (A. Jones)
!       6.1             07-04-04                Add new variables for
!                                               column cloud droplet
!                                               calculation.
!                                               (A. Jones)
!       6.2             24-11-05                Pass Ntot_land and
!                                               Ntot_sea from UMUI.
!                                               (Damian Wilson)
!       6.2             02-03-05                Protect calculations
!                                               from failure in PC2
!                                               (Damian Wilson)
!
! Description of Code:
!   FORTRAN 77  with extensions listed in documentation.
!
!- ---------------------------------------------------------------------
      SUBROUTINE R2_RE_MRF_UMIST( &
          N_PROFILE                , &
          N_LAYER                  , &
          NCLDS                    , &
          I_GATHER                 , &
          L_PC2                    , &
          L_AEROSOL_CCN            , &
          L_BIOMASS_CCN            , &
          L_OCFF_CCN               , &
          SEA_SALT_FILM            , &
          SEA_SALT_JET             , &
          L_SEASALT_CCN            , &
          SALT_DIM_A               , &
          SALT_DIM_B               , &
          L_USE_BIOGENIC           , &
          BIOGENIC                 , &
          BIOGENIC_DIM1            , &
          BIOGENIC_DIM2            , &
          ACCUM_SULPHATE           , &
          DISS_SULPHATE            , &
          AITKEN_SULPHATE          , &
          AGED_BMASS               , &
          CLOUD_BMASS              , &
          AGED_OCFF                , &
          CLOUD_OCFF               , &
          LYING_SNOW_G             , &
          I_CLOUD_REPRESENTATION   , &
          LAND_G                   , &
          FLANDG_G                 , &
          DENSITY_AIR              , &
          CONDENSED_MIX_RATIO      , &
          CC_DEPTH                 , &
          CONDENSED_RE             , &
          D_MASS                   , &
          STRAT_LIQ_CLOUD_FRACTION , &
          CONV_LIQ_CLOUD_FRACTION  , &
          NC_DIAG_FLAG             , &
          NC_DIAG_G                , &
          NC_WEIGHT_G              , &
          NTOT_DIAG_G              , &
          Ntot_land                , &
          Ntot_sea                 , &
          STRAT_LWC_DIAG_G         , &
          SO4_CCN_DIAG_G           , &
          SULP_DIM1                , &
          SULP_DIM2                , &
          BMASS_DIM1               , &
          BMASS_DIM2               , &
          OCFF_DIM1                , &
          OCFF_DIM2                , &
          NPD_FIELD                , &
          NPD_PROFILE              , &
          NPD_LAYER                , &
          NPD_AEROSOL_SPECIES        )
!
!
!
      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, Parameter :: Pi                 = 3.14159265358979323846

      ! Conversion factor degrees to radians
      Real, Parameter :: Pi_Over_180        = Pi/180.0

      ! Conversion factor radians to degrees
      Real, Parameter :: Recip_Pi_Over_180  = 180.0/Pi

!*----------------------------------------------------------------------
! C_DENSTY for subroutine SF_EXCH
! Gawd knows why this routine expects the sea to be fresh water. JRB
      REAL,PARAMETER:: RHOSEA = 1000.0 ! density of sea water (kg/m3)
      REAL,PARAMETER:: RHO_WATER = 1000.0! density of pure water (kg/m3)
! C_DENSTY end
!
! 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,PARAMETER:: NTOT_LAND is set in UMUI
!     REAL,PARAMETER:: NTOT_SEA is set in UMUI
      REAL,PARAMETER:: KPARAM_LAND = 0.67
      REAL,PARAMETER:: KPARAM_SEA = 0.80
      REAL,PARAMETER:: DCONRE_LAND = 9.5E-06
      REAL,PARAMETER:: DCONRE_SEA = 16.0E-06
      REAL,PARAMETER:: DEEP_CONVECTION_LIMIT_LAND = 500.0
      REAL,PARAMETER:: DEEP_CONVECTION_LIMIT_SEA = 1500.0
!
! Maximum Temp for homogenous nucleation (deg C)
      REAL,PARAMETER:: THOMO = -40.0
! DIMFIX3A defines internal dimensions tied to algorithms for
! two-stream radiation code, mostly for clouds

      ! number of components of clouds
      INTEGER,PARAMETER:: NPD_CLOUD_COMPONENT=4

      ! number of permitted types of clouds.
      INTEGER,PARAMETER:: NPD_CLOUD_TYPE=4

      ! number of permitted representations of clouds.
      INTEGER,PARAMETER:: NPD_CLOUD_REPRESENTATION=4

      ! number of overlap coefficients for clouds
      INTEGER,PARAMETER:: NPD_OVERLAP_COEFF=18

      ! number of coefficients for two-stream sources
      INTEGER,PARAMETER:: NPD_SOURCE_COEFF=2

      ! number of regions in a layer
      INTEGER,PARAMETER:: NPD_REGION=3

! DIMFIX3A end
! CLDCMP3A sets components of clouds for two-stream radiation code.

      ! stratiform water droplets
      INTEGER,PARAMETER:: IP_CLCMP_ST_WATER=1

      ! stratiform ice crystals
      INTEGER,PARAMETER:: IP_CLCMP_ST_ICE=2

      ! convective water droplets
      INTEGER,PARAMETER:: IP_CLCMP_CNV_WATER=3

      ! convective ice crystals
      INTEGER,PARAMETER:: IP_CLCMP_CNV_ICE=4

! CLDCMP3A end
! CLREPP3A defines representations of clouds in two-stream radiation
! code.

      ! all components are mixed homogeneously
      INTEGER,PARAMETER:: IP_CLOUD_HOMOGEN     = 1

      ! ice and water clouds are treated separately
      INTEGER,PARAMETER:: IP_CLOUD_ICE_WATER   = 2

      ! clouds are divided into homogeneously mixed stratiform and
      ! convective parts
      INTEGER,PARAMETER:: IP_CLOUD_CONV_STRAT  = 3

      ! clouds divided into ice and water phases and into stratiform and
      ! convective components.
      INTEGER,PARAMETER:: IP_CLOUD_CSIW        = 4

! Types of clouds (values in CLREPD3A)

      ! number of type of clouds in representation
      INTEGER :: NP_CLOUD_TYPE(NPD_CLOUD_REPRESENTATION)

      ! map of components contributing to types of clouds
      INTEGER :: IP_CLOUD_TYPE_MAP(NPD_CLOUD_COMPONENT,NPD_CLOUD_REPRESENTATION)

!
!
!     DUMMY ARGUMENTS:
!
!     SIZES OF ARRAYS:
      INTEGER, INTENT(IN) :: NPD_FIELD!SIZE OF INPUT FIELDS TO THE RADIATION
      INTEGER, INTENT(IN) :: NPD_PROFILE!MAXIMUM NUMBER OF PROFILES
      INTEGER, INTENT(IN) :: NPD_LAYER!MAXIMUM NUMBER OF LAYERS
      INTEGER, INTENT(IN) :: NPD_AEROSOL_SPECIES!MAXIMUM NUMBER OF AEROSOL SPECIES
      INTEGER, INTENT(IN) :: SULP_DIM1!1ST DIMENSION OF ARRAYS OF SULPHATE
      INTEGER, INTENT(IN) :: SULP_DIM2!2ND DIMENSION OF ARRAYS OF SULPHATE
      INTEGER, INTENT(IN) :: BMASS_DIM1!1ST DIMENSION OF ARRAYS OF BIOMASS SMOKE
      INTEGER, INTENT(IN) :: BMASS_DIM2!2ND DIMENSION OF ARRAYS OF BIOMASS SMOKE
      INTEGER, INTENT(IN) :: OCFF_DIM1!1ST DIMENSION OF ARRAYS OF FOSSIL-FUEL ORGANIC CARBON
      INTEGER, INTENT(IN) :: OCFF_DIM2!2ND DIMENSION OF ARRAYS OF FOSSIL-FUEL ORGANIC CARBON
      INTEGER, INTENT(IN) :: SALT_DIM_A!1ST DIMENSION OF ARRAYS OF SEA-SALT
      INTEGER, INTENT(IN) :: SALT_DIM_B!2ND DIMENSION OF ARRAYS OF SEA-SALT
      INTEGER, INTENT(IN) :: BIOGENIC_DIM1!1ST DIMENSION OF BIOGENIC AEROSOL ARRAY
      INTEGER, INTENT(IN) :: BIOGENIC_DIM2!2ND DIMENSION OF BIOGENIC AEROSOL ARRAY
!
      INTEGER, INTENT(IN) :: N_PROFILE!NUMBER OF ATMOSPHERIC PROFILES
      INTEGER, INTENT(IN) :: N_LAYER!Number of layers seen in radiation
      INTEGER, INTENT(IN) :: NCLDS!NUMBER OF CLOUDY LEVELS
!
      INTEGER, INTENT(IN) :: I_GATHER(NPD_FIELD)!LIST OF POINTS TO BE GATHERED
      LOGICAL, INTENT(IN) :: LAND_G(NPD_PROFILE)!GATHERED MASK FOR LAND POINTS
      INTEGER, INTENT(IN) :: I_CLOUD_REPRESENTATION!REPRESENTATION OF CLOUDS
!
!     VARIABLES FOR PC2
      LOGICAL, INTENT(IN) :: L_PC2 !PC2 cloud scheme is in use
!
!     VARIABLES FOR AEROSOLS
      LOGICAL, INTENT(IN) :: L_AEROSOL_CCN!FLAG TO USE AEROSOLS TO FIND CCN.
      LOGICAL, INTENT(IN) :: L_SEASALT_CCN!FLAG TO USE SEA-SALT AEROSOL FOR CCN
      LOGICAL, INTENT(IN) :: L_USE_BIOGENIC!FLAG TO USE BIOGENIC AEROSOL FOR CCN
      LOGICAL, INTENT(IN) :: L_BIOMASS_CCN!FLAG TO USE BIOMASS SMOKE AEROSOL FOR CCN
      LOGICAL, INTENT(IN) :: L_OCFF_CCN!FLAG TO USE FOSSIL-FUEL ORGANIC CARBON AEROSOL FOR CCN
      LOGICAL, INTENT(IN) :: NC_DIAG_FLAG!FLAG TO DIAGNOSE COLUMN-INTEGRATED DROPLET NUMBER
!
      REAL   , INTENT(IN) :: ACCUM_SULPHATE(SULP_DIM1, SULP_DIM2)!MIXING RATIOS OF ACCUMULATION MODE SULPHATE
      REAL   , INTENT(IN) :: AITKEN_SULPHATE(SULP_DIM1, SULP_DIM2)!Mixing ratios of Aitken-mode sulphate
      REAL   , INTENT(IN) :: DISS_SULPHATE(SULP_DIM1, SULP_DIM2)!MIXING RATIOS OF DISSOLVED SULPHATE
      REAL   , INTENT(IN) :: AGED_BMASS(BMASS_DIM1, BMASS_DIM2)!MIXING RATIOS OF AGED BIOMASS SMOKE
      REAL   , INTENT(IN) :: CLOUD_BMASS(BMASS_DIM1, BMASS_DIM2)!MIXING RATIOS OF IN-CLOUD BIOMASS SMOKE
      REAL   , INTENT(IN) :: AGED_OCFF(OCFF_DIM1, OCFF_DIM2)!MIXING RATIOS OF AGED FOSSIL-FUEL ORGANIC CARBON
      REAL   , INTENT(IN) :: CLOUD_OCFF(OCFF_DIM1, OCFF_DIM2)!MIXING RATIOS OF IN-CLOUD FOSSIL-FUEL ORGANIC CARBON
      REAL   , INTENT(IN) :: SEA_SALT_FILM(SALT_DIM_A, SALT_DIM_B)!NUMBER CONCENTRATION OF FILM-MODE SEA-SALT AEROSOL
      REAL   , INTENT(IN) :: SEA_SALT_JET(SALT_DIM_A, SALT_DIM_B)!NUMBER CONCENTRATION OF JET-MODE SEA-SALT AEROSOL
      REAL   , INTENT(IN) :: BIOGENIC(BIOGENIC_DIM1, BIOGENIC_DIM2)!M.M.R. OF BIOGENIC AEROSOL
!
      REAL   , INTENT(IN) :: DENSITY_AIR(NPD_PROFILE, NPD_LAYER)!DENSITY OF AIR
!
      REAL   , INTENT(IN) :: CONDENSED_MIX_RATIO(NPD_PROFILE, 0: NPD_LAYER, NPD_CLOUD_COMPONENT)
!             MIXING RATIOS OF CONDENSED SPECIES
      REAL   , INTENT(IN) :: CC_DEPTH(NPD_PROFILE)
!             DEPTH OF CONVECTIVE CLOUD
      REAL   , INTENT(IN) :: D_MASS(NPD_PROFILE, NPD_LAYER)
!             MASS THICKNESS OF LAYER
      REAL   , INTENT(IN) :: STRAT_LIQ_CLOUD_FRACTION(NPD_PROFILE, NPD_LAYER)
!             STRATIFORM LIQUID CLOUD COVER IN LAYERS (T>273K)
      REAL   , INTENT(IN) :: CONV_LIQ_CLOUD_FRACTION(NPD_PROFILE, NPD_LAYER)
!             CONVECTIVE LIQUID CLOUD COVER IN LAYERS (T>273K)
      Real   , Intent(IN) :: Ntot_land! Number of droplets over land / m-3
      Real   , Intent(IN) :: Ntot_sea ! Number of droplets over sea / m-3

!
      REAL   , INTENT(OUT) :: CONDENSED_RE(NPD_PROFILE, 0: NPD_LAYER, NPD_CLOUD_COMPONENT)
!             EFFECTIVE RADII OF CONDENSED COMPONENTS OF CLOUDS
!
      REAL   , INTENT(OUT) :: NTOT_DIAG_G(NPD_PROFILE, NPD_LAYER)
!             DIAGNOSTIC ARRAY FOR NTOT (GATHERED)
      REAL   , INTENT(OUT) :: STRAT_LWC_DIAG_G(NPD_PROFILE, NPD_LAYER)
!             DIAGNOSTIC ARRAY FOR STRATIFORM LWC (GATHERED)
      REAL   , INTENT(OUT) :: SO4_CCN_DIAG_G(NPD_PROFILE, NPD_LAYER)
!             DIAGNOSTIC ARRAY FOR SO4 CCN MASS CONC (GATHERED)
      REAL   , INTENT(OUT) :: NC_DIAG_G(NPD_PROFILE)
!             DIAGNOSTIC ARRAY FOR INTEGRATED DROPLET NUMBER (GATHERED)
      REAL   , INTENT(OUT) :: NC_WEIGHT_G(NPD_PROFILE)
!             DIAGNOSTIC ARRAY FOR INT DROP NO. SAMPLING WGT (GATHERED)
!
!
      REAL   , Intent(IN) :: LYING_SNOW_G(NPD_PROFILE)! GATHERED SNOW DEPTH (>5000m = LAND ICE SHEET)
      REAL   , Intent(IN) :: FLANDG_G(NPD_PROFILE)!             GATHERED global LAND FRACTION
!

!

! CLREPP3A end
!     LOCAL VARIABLES:
      INTEGER  :: I!             LOOP VARIABLE
      INTEGER  ::  L
!             LOOP VARIABLE
      INTEGER  ::  SULPHATE_PTR_A
      INTEGER  ::  SULPHATE_PTR_B
!             POINTERS FOR SULPHATE ARRAYS
      INTEGER  ::  SEASALT_PTR_A
      INTEGER  ::  SEASALT_PTR_B
!             POINTERS FOR SEA-SALT ARRAYS
      INTEGER  ::  BIOMASS_PTR_A
      INTEGER  ::  BIOMASS_PTR_B
!             POINTERS FOR BIOMASS SMOKE ARRAYS
      INTEGER  ::  OCFF_PTR_A
      INTEGER  ::  OCFF_PTR_B
!             POINTERS FOR FOSSIL-FUEL ORGANIC CARBON ARRAYS
      INTEGER  ::  BIOGENIC_PTR_A
      INTEGER  ::  BIOGENIC_PTR_B
!             POINTERS FOR BIOGENIC ARRAY
!
      REAL     ::  TOTAL_MIX_RATIO_ST(NPD_PROFILE)
!             TOTAL MIXING RATIO OF WATER SUBSTANCE IN STRATIFORM CLOUD
      REAL     ::  TOTAL_MIX_RATIO_CNV(NPD_PROFILE)
!             TOTAL MIXING RATIO OF WATER SUBSTANCE IN STRATIFORM CLOUD
      REAL     ::   TOTAL_STRAT_LIQ_CLOUD_FRACTION(NPD_PROFILE)
!             TOTAL STRATIFORM LIQUID CLOUD COVER (T>273K)
      REAL     ::  TOTAL_CONV_LIQ_CLOUD_FRACTION(NPD_PROFILE)
!             TOTAL CONVECTIVE LIQUID CLOUD COVER (T>273K)
!
      REAL     ::  N_DROP(NPD_PROFILE, NPD_LAYER)
!             NUMBER DENSITY OF DROPLETS
      REAL     ::  KPARAM
!             RATIO OF CUBES OF VOLUME RADIUS TO EFFECTIVE RADIUS
      REAL     ::  TEMP
!             Temporary in calculation of effective radius
!
!     FIXED CONSTANTS OF THE PARAMETRIZATION:
      REAL  , PARAMETER   ::  DEEP_CONVECTIVE_CLOUD=5.0E+02
!             THRESHOLD VALUE FOR DEEP CONVECTIVE CLOUD
!
!
!     Subroutines called:
!      EXTERNAL                                                          &
!     &     R2_CALC_TOTAL_CLOUD_COVER                                    &
!     &   , R2_COLUMN_DROPLET_CONC
!
!     Functions called:
!      REAL                                                              &
!     &     NUMBER_DROPLET
!             Function to calculate the number of clouds droplets
!      EXTERNAL                                                          &
!     &     NUMBER_DROPLET
!
!
!
!
!     CALCULATE THE NUMBER DENSITY OF DROPLETS
!
      DO I=N_LAYER+1-NCLDS, N_LAYER
         DO L=1, N_PROFILE
            IF (L_AEROSOL_CCN) THEN
               SULPHATE_PTR_A=I_GATHER(L)
               SULPHATE_PTR_B=N_LAYER+1-I
            ELSE
               SULPHATE_PTR_A=1
               SULPHATE_PTR_B=1
            ENDIF
            IF (L_SEASALT_CCN) THEN
               SEASALT_PTR_A=I_GATHER(L)
               SEASALT_PTR_B=N_LAYER+1-I
            ELSE
               SEASALT_PTR_A=1
               SEASALT_PTR_B=1
            ENDIF
            IF (L_BIOMASS_CCN) THEN
               BIOMASS_PTR_A=I_GATHER(L)
               BIOMASS_PTR_B=N_LAYER+1-I
            ELSE
               BIOMASS_PTR_A=1
               BIOMASS_PTR_B=1
            ENDIF
            IF (L_OCFF_CCN) THEN
               OCFF_PTR_A=I_GATHER(L)
               OCFF_PTR_B=N_LAYER+1-I
            ELSE
               OCFF_PTR_A=1
               OCFF_PTR_B=1
            ENDIF
            IF (L_USE_BIOGENIC) THEN
               BIOGENIC_PTR_A=I_GATHER(L)
               BIOGENIC_PTR_B=N_LAYER+1-I
            ELSE
               BIOGENIC_PTR_A=1
               BIOGENIC_PTR_B=1
            ENDIF
! DEPENDS ON: number_droplet
            N_DROP(L, I)=NUMBER_DROPLET(&                         !      REAL(KIND=r8) FUNCTION NUMBER_DROPLET( &
               L_AEROSOL_CCN                                   , &!           L_AEROSOL_DROPLET, &
               .TRUE.                                          , &!           L_NH42SO4        , &
!               AITKEN_SULPHATE(SULPHATE_PTR_A, SULPHATE_PTR_B) , &!          !AITKEN_SULPHATE  , &
               ACCUM_SULPHATE (SULPHATE_PTR_A, SULPHATE_PTR_B) , &!           ACCUM_SULPHATE   , &
               DISS_SULPHATE  (SULPHATE_PTR_A, SULPHATE_PTR_B) , &!           DISS_SULPHATE    , &
               L_SEASALT_CCN                                   , &!           L_SEASALT_CCN    , &
               SEA_SALT_FILM  (SEASALT_PTR_A, SEASALT_PTR_B)   , &!           SEA_SALT_FILM    , &
               SEA_SALT_JET   (SEASALT_PTR_A, SEASALT_PTR_B)   , &!           SEA_SALT_JET     , &
               L_USE_BIOGENIC                                  , &!           L_BIOGENIC_CCN   , &
               BIOGENIC       (BIOGENIC_PTR_A, BIOGENIC_PTR_B) , &!           BIOGENIC         , &
               L_BIOMASS_CCN                                   , &!           L_BIOMASS_CCN    , &
               AGED_BMASS     (BIOMASS_PTR_A, BIOMASS_PTR_B)   , &!           BIOMASS_AGED     , &
               CLOUD_BMASS    (BIOMASS_PTR_A, BIOMASS_PTR_B)   , &!           BIOMASS_CLOUD    , &
               L_OCFF_CCN                                      , &!           L_OCFF_CCN       , &
               AGED_OCFF      (OCFF_PTR_A, OCFF_PTR_B)         , &!           OCFF_AGED        , &
               CLOUD_OCFF     (OCFF_PTR_A, OCFF_PTR_B)         , &!           OCFF_CLOUD       , &
               DENSITY_AIR    (L, I)                           , &!           DENSITY_AIR      , &
               LYING_SNOW_G   (L)                              , &!           SNOW_DEPTH       , &
               FLANDG_G       (L)                              , &!           LAND_FRACT       , &
               Ntot_land                                       , &!           NTOT_LAND        , &
               Ntot_sea                                          )!           NTOT_SEA           )
         ENDDO
      ENDDO

!  Diagnose column-integrated cloud droplet number if required.

      IF (NC_DIAG_FLAG) THEN

! DEPENDS ON: r2_calc_total_cloud_cover
         CALL R2_CALC_TOTAL_CLOUD_COVER(   &
           N_PROFILE                     , &!INTEGER , INTENT(IN ):: N_PROFILE !NUMBER OF PROFILES
           N_LAYER                       , &!INTEGER , INTENT(IN ):: N_LAYER   !Number of layers seen in radiation
           NCLDS                         , &!INTEGER , INTENT(IN ):: NCLDS     !NUMBER OF CLOUDY LAYERS
           I_CLOUD_REPRESENTATION        , &!INTEGER , INTENT(IN ):: I_CLOUD   !CLOUD SCHEME EMPLOYED
           STRAT_LIQ_CLOUD_FRACTION      , &!REAL    , INTENT(IN ):: W_CLOUD_IN(NPD_PROFILE, NPD_LAYER)!CLOUD AMOUNTS
           TOTAL_STRAT_LIQ_CLOUD_FRACTION, &!REAL    , INTENT(OUT):: TOTAL_CLOUD_COVER(NPD_PROFILE) !TOTAL CLOUD COVER
           NPD_PROFILE                   , &!INTEGER , INTENT(IN )::  NPD_PROFILE!MAXIMUM NUMBER OF PROFILES
           NPD_LAYER                       )!INTEGER , INTENT(IN )::  NPD_LAYER  !MAXIMUM NUMBER OF LAYERS

! DEPENDS ON: r2_calc_total_cloud_cover
         CALL R2_CALC_TOTAL_CLOUD_COVER(   &
           N_PROFILE                     , &!INTEGER , INTENT(IN ):: N_PROFILE !NUMBER OF PROFILES
           N_LAYER                       , &!INTEGER , INTENT(IN ):: N_LAYER   !Number of layers seen in radiation
           NCLDS                         , &!INTEGER , INTENT(IN ):: NCLDS     !NUMBER OF CLOUDY LAYERS
           I_CLOUD_REPRESENTATION        , &!INTEGER , INTENT(IN ):: I_CLOUD   !CLOUD SCHEME EMPLOYED
           CONV_LIQ_CLOUD_FRACTION       , &!REAL    , INTENT(IN ):: W_CLOUD_IN(NPD_PROFILE, NPD_LAYER)!CLOUD AMOUNTS
           TOTAL_CONV_LIQ_CLOUD_FRACTION , &!REAL    , INTENT(OUT):: TOTAL_CLOUD_COVER(NPD_PROFILE) !TOTAL CLOUD COVER
           NPD_PROFILE                   , &!INTEGER , INTENT(IN )::  NPD_PROFILE!MAXIMUM NUMBER OF PROFILES
           NPD_LAYER                       )!INTEGER , INTENT(IN )::  NPD_LAYER  !MAXIMUM NUMBER OF LAYERS

! DEPENDS ON: r2_column_droplet_conc

         CALL R2_COLUMN_DROPLET_CONC(      & !
           NPD_PROFILE                   , & ! INTEGER, INTENT(IN   ) :: NPD_PROFILE!Maximum number of profiles
           NPD_LAYER                     , & ! INTEGER, INTENT(IN   ) :: NPD_LAYER  !Maximum number of layers
           N_PROFILE                     , & ! INTEGER, INTENT(IN   ) :: N_PROFILE  !Number of atmospheric profiles
           N_LAYER                       , & ! INTEGER, INTENT(IN   ) :: N_LAYER    !Number of layers seen in radiation
           NCLDS                         , & ! INTEGER, INTENT(IN   ) :: NCLDS      !Number of cloudy layers
           STRAT_LIQ_CLOUD_FRACTION      , & ! REAL   , INTENT(IN   ) :: STRAT_LIQ_CLOUD_FRACTION(NPD_PROFILE, NPD_LAYER)
           TOTAL_STRAT_LIQ_CLOUD_FRACTION, & ! REAL   , INTENT(IN   ) :: TOTAL_STRAT_LIQ_CLOUD_FRACTION(NPD_PROFILE)
           CONV_LIQ_CLOUD_FRACTION       , & ! REAL   , INTENT(IN   ) :: CONV_LIQ_CLOUD_FRACTION(NPD_PROFILE, NPD_LAYER)
           TOTAL_CONV_LIQ_CLOUD_FRACTION , & ! REAL   , INTENT(IN   ) :: TOTAL_CONV_LIQ_CLOUD_FRACTION(NPD_PROFILE)
           N_DROP                        , & ! REAL   , INTENT(IN   ) :: N_DROP(NPD_PROFILE, NPD_LAYER)
           D_MASS                        , & ! REAL   , INTENT(IN   ) :: D_MASS(NPD_PROFILE, NPD_LAYER)
           DENSITY_AIR                   , & ! REAL   , INTENT(IN   ) :: DENSITY_AIR(NPD_PROFILE, NPD_LAYER)
           NC_DIAG_G                     , & ! REAL   , INTENT(OUT  ) :: NC_DIAG(NPD_PROFILE)
           NC_WEIGHT_G                      )! REAL   , INTENT(OUT  ) :: NC_WEIGHT(NPD_PROFILE)

      ENDIF

!  Diagnose SO4 aerosol concentrations. Mass mixing ratio of ammonium
!  sulphate is converted to microgrammes of the sulphate ion per m3
!  for diagnostic purposes.

      IF (L_AEROSOL_CCN) THEN
         DO I=N_LAYER+1-NCLDS, N_LAYER
            DO L=1, N_PROFILE
               SO4_CCN_DIAG_G(L, I)=                                    &
                       (AITKEN_SULPHATE(I_GATHER(L), N_LAYER+1-I)      &
                        +ACCUM_SULPHATE(I_GATHER(L), N_LAYER+1-I)      &
                         +DISS_SULPHATE(I_GATHER(L), N_LAYER+1-I))     &
                      * DENSITY_AIR(L, I) * (96./132.) * 1.0E+09
            ENDDO
         ENDDO
      ENDIF
!
      DO I=N_LAYER+1-NCLDS, N_LAYER
!
!        FIND THE TOTAL MIXING RATIO OF WATER SUBSTANCE IN THE CLOUD
!        AS IMPLIED BY THE REPRESENTATION.
         IF (I_CLOUD_REPRESENTATION == IP_CLOUD_CONV_STRAT) THEN
            DO L=1, N_PROFILE
               TOTAL_MIX_RATIO_ST(L)                                    &
                 =CONDENSED_MIX_RATIO(L, I, IP_CLCMP_ST_WATER)         &
                 +CONDENSED_MIX_RATIO(L, I, IP_CLCMP_ST_ICE)
               TOTAL_MIX_RATIO_CNV(L)                                   &
                 =CONDENSED_MIX_RATIO(L, I, IP_CLCMP_CNV_WATER)        &
                 +CONDENSED_MIX_RATIO(L, I, IP_CLCMP_CNV_ICE)
            ENDDO
         ELSE IF (I_CLOUD_REPRESENTATION == IP_CLOUD_CSIW) THEN
            DO L=1, N_PROFILE
               TOTAL_MIX_RATIO_ST(L)                                    &
                 =CONDENSED_MIX_RATIO(L, I, IP_CLCMP_ST_WATER)
               TOTAL_MIX_RATIO_CNV(L)                                   &
                 =CONDENSED_MIX_RATIO(L, I, IP_CLCMP_CNV_WATER)
            ENDDO
         ENDIF
         DO L=1, N_PROFILE
            IF (LAND_G(L)) THEN
               KPARAM=KPARAM_LAND
            ELSE
               KPARAM=KPARAM_SEA
            ENDIF
            IF (.NOT. L_PC2) THEN
              CONDENSED_RE(L, I, IP_CLCMP_CNV_WATER)                    &
              =(3.0E+00*TOTAL_MIX_RATIO_CNV(L)*DENSITY_AIR(L, I)       &
              /(4.0E+00*PI*RHO_WATER*KPARAM*N_DROP(L, I)))             &
              **(1.0E+00/3.0E+00)
              CONDENSED_RE(L, I, IP_CLCMP_ST_WATER)                     &
              =(3.0E+00*TOTAL_MIX_RATIO_ST(L)*DENSITY_AIR(L, I)        &
              /(4.0E+00*PI*RHO_WATER*KPARAM*N_DROP(L, I)))             &
              **(1.0E+00/3.0E+00)
            ELSE
              TEMP                                                      &
              =(3.0E+00*TOTAL_MIX_RATIO_CNV(L)*DENSITY_AIR(L, I)       &
              /(4.0E+00*PI*RHO_WATER*KPARAM*N_DROP(L, I)))
              IF (TEMP  >=  0.0) THEN
                CONDENSED_RE(L, I, IP_CLCMP_CNV_WATER)                  &
               = TEMP**(1.0E+00/3.0E+00)
              ELSE
                CONDENSED_RE(L, I, IP_CLCMP_CNV_WATER) = 0.0
              END IF
              TEMP                                                      &
              =(3.0E+00*TOTAL_MIX_RATIO_ST(L)*DENSITY_AIR(L, I)        &
              /(4.0E+00*PI*RHO_WATER*KPARAM*N_DROP(L, I)))
              IF (TEMP  >=  0.0) THEN
                CONDENSED_RE(L, I, IP_CLCMP_ST_WATER)                   &
               = TEMP**(1.0E+00/3.0E+00)
              ELSE
                CONDENSED_RE(L, I, IP_CLCMP_ST_WATER) = 0.0
              END IF
            END IF
         ENDDO
         DO L=1, N_PROFILE
            NTOT_DIAG_G(L, I)=N_DROP(L, I)*1.0E-06
            STRAT_LWC_DIAG_G(L, I)                                      &
              =TOTAL_MIX_RATIO_ST(L)*DENSITY_AIR(L, I)*1.0E03
         ENDDO
      ENDDO
!
!     RESET THE EFFECTIVE RADII FOR DEEP CONVECTIVE CLOUDS.
      DO I=N_LAYER+1-NCLDS, N_LAYER
         DO L=1, N_PROFILE
            IF (LAND_G(L)) THEN
               IF (CC_DEPTH(L)  >   DEEP_CONVECTION_LIMIT_LAND) THEN
                  CONDENSED_RE(L, I, IP_CLCMP_CNV_WATER)=DCONRE_LAND
               ELSE
                  IF (CONDENSED_RE(L, I, IP_CLCMP_CNV_WATER)            &
                                                   >   DCONRE_LAND)    &
                 CONDENSED_RE(L, I, IP_CLCMP_CNV_WATER)=DCONRE_LAND
               ENDIF
            ELSE
               IF (CC_DEPTH(L)  >   DEEP_CONVECTION_LIMIT_SEA) THEN
                  CONDENSED_RE(L, I, IP_CLCMP_CNV_WATER)=DCONRE_SEA
               ELSE
                  IF (CONDENSED_RE(L, I, IP_CLCMP_CNV_WATER)            &
                                                   >   DCONRE_SEA)     &
                 CONDENSED_RE(L, I, IP_CLCMP_CNV_WATER)=DCONRE_SEA
               ENDIF
            ENDIF
         ENDDO
      ENDDO
!
!
!
      RETURN
      END SUBROUTINE R2_RE_MRF_UMIST
!+ Subroutine to calculate column-integrated cloud droplet number.
!
! Purpose:
!   To calculate a diagnostic of column-integrated cloud droplet
!   number which may be validated aginst satellite data.
!
! Method:
!   Column cloud droplet concentration (i.e. number of droplets per
!   unit area) is calculated as the vertically integrated droplet
!   number concentration averaged over the portion of the gridbox
!   covered by stratiform and convective liquid cloud with T>273K.
!
! Current Owner of Code: A. Jones
!
! History:
!       Version         Date                    Comment
!       5.4             29-05-02                Original Code
!                                               (A. Jones)
!       6.1             07-04-04                Modified in accordance
!                                               with AVHRR retrievals:
!                                               only clouds >273K used,
!                                               convective clouds also
!                                               included.
!                                               (A. Jones)
!
!
! Description of Code:
!   FORTRAN 77  with extensions listed in documentation.
!
!- ---------------------------------------------------------------------
!+ Subroutine to set the actual process options for the radiation code.
!
! Purpose:
!   To set a consistent set of process options for the radiation.
!
! Method:
!   The global options for the spectral region are compared with the
!   contents of the spectral file. The global options should be set
!   to reflect the capabilities of the code enabled in the model.
!
! Current Owner of Code: J. M. Edwards
!
! History:
!       Version         Date                    Comment
!       4.1             04-03-96                Original Code
!                                               (J. M. Edwards)
!                                               Parts of this code are
!                                               rather redundant. The
!                                               form of writing is for
!                                               near consistency with
!                                               HADAM3.
!
!       4.5   April 1998   Check for inconsistencies between soot
!                          spectral file and options used. L Robinson.
!       5.3     04/04/01   Include mesoscale aerosol switch when
!                          checking if aerosols are required.  S. Cusack
!       5.4     09/05/02   Include logical flag for sea-salt aerosol.
!                                                              A. Jones
!       5.5     05/02/03   Include logical for biomass smoke
!                          aerosol.               P Davison
! Description of Code:
!   5.5    21/02/03 Add logical for d mineral dust
!                                                S Woodward
!   FORTRAN 77  with extensions listed in documentation.
!
!- ---------------------------------------------------------------------





! *****************************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 to set the mixing ratios of gases.
!
! Purpose:
!   The full array of mass mixing ratios of gases is filled.
!
! Method:
!   The arrays of supplied mixing ratios are inverted and fed
!   into the array to pass to the radiation code. For well-mixed
!   gases the constant mixing ratios are fed into this array.
!
! Current Owner of Code: J. M. Edwards
!
! History:
!       Version         Date                    Comment
!       4.0             27-07-95                Original Code
!                                               (J. M. Edwards)
!       4.1             10-06-96                Ozone set in lower
!                                               levels.
!                                               (J. M. Edwards)
!       4.4             26-09-97                Conv. cloud amount on
!                                               model levs allowed for.
!                                               J.M.Gregory
!       4.5             18-05-98                Provision for treating
!                                               extra (H)(C)FCs
!                                               included.
!                                               (J. M. Edwards)
!       5.1             06-04-00                Move HCFCs to a more
!                                               natural place in the
!                                               code.
!                                               (J. M. Edwards)
!       5.1             06-04-00                Remove the explicit
!                                               limit on the
!                                               concentration of
!                                               water vapour.
!                                               (J. M. Edwards)
!       5.2             14-11-00                Add provision for an
!                                               extra radiative layer
!                                               above the top of the
!                                               model.
!                                               (J. M. Edwards)
!       5.4             29-05-02                Add diagnostic call
!                                               for column-integrated
!                                               cloud droplet number.
!                                               (A. Jones)
!       5.4             25-04-02                Replace land/sea mask
!                                               with land fraction in
!                                               call to NUMBER_DROPLET
!                                               (A. Jones)
!       5.5             17-02-03                Change I_CLIM_POINTER
!                                               for hp compilation
!                                               (M.Hughes)
!  6.1   20/08/03  Code for STOCHEM feedback.  C. Johnson
!       6.2             21/02/06   Updefs Added for version
!                                  control of radiation code
!                                            (J.-C. Thelen)
!  6.2   03-11-05   Enable HadGEM1 climatological aerosols. C. F. Durman
!                   Reworked to use switch instead of #defined. R Barnes
!  6.2   25/05/05  Convert compilation into a more universally portable
!                  form. Tom Edwards
!  6.2   15/12/05  Set negative specific humidities to zero.
!                                               (J. Manners)
!
! Description of Code:
!   FORTRAN 77  with extensions listed in documentation.
!
!- ---------------------------------------------------------------------
!+ Subroutine to set thermodynamic properties
!
! Purpose:
!   Pressures, temperatures at the centres and edges of layers
!   and the masses in layers are set.
!
! Method:
!   Straightforward.
!
! Current Owner of Code: J. M. Edwards
!
! History:
!       Version         Date                    Comment
!       4.0             27-07-95                Original Code
!                                               (J. M. Edwards)
!       4.1             10-06-96                Old formulation over
!                                               sea-ice removed.
!                                               (J. M. Edwards)
!       4.2             08-08-96                Ground temperature
!                                               set equal to that
!                                               in the middle of the
!                                               bottom layer.
!                                               (J. M. Edwards)
!       5.2             14-11-00                Add provision for an
!                                               extra radiative layer
!                                               above the top of the
!                                               model.
!                                               (J. M. Edwards)
!       5.3             25-04-01                Alter the specification
!                                               of temperature on rho
!                                               levels (layer
!                                               boundaries).  S.Cusack
!       5.3             25-04-01   Gather land, sea and
!                                  sea-ice temperatures and
!                                  land fraction. Replace TFS
!                                  with general sea temperature.
!                                       (N. Gedney)
!
! Description of Code:
!   FORTRAN 77  with extensions listed in documentation.
!
!- ---------------------------------------------------------------------
!+ Subroutine to assign Properties of Clouds.
!
! Purpose:
!   The fractions of different types of clouds and their microphysical
!   preoperties are set.
!
! Method:
!   Straightforward.
!
! Current Owner of Code: J. M. Edwards
!
! History:
!       Version         Date                    Comment
!       4.0             27-07-95                Original Code
!                                               (J. M. Edwards)
!       4.1             10-06-96                New flag L_AEROSOL_CCN
!                                               introduced to allow
!                                               inclusion of indirect
!                                               aerosol forcing alone.
!                                               Correction of comments
!                                               for LCCWC1 and LCCWC2.
!                                               Correction of level at
!                                               which temperature for
!                                               partitioning
!                                               convective homogeneously
!                                               mixed cloud is taken.
!                                               (J. M. Edwards)
!       4.4             08-04-97                Changes for new precip
!                                               scheme (qCF prognostic)
!                                               (A. C. Bushell)
!       4.4             15-09-97                A parametrization of
!                                               ice crystals with a
!                                               temperature dependedence
!                                               of the size has been
!                                               added.
!                                               Explicit checking of
!                                               the sizes of particles
!                                               for the domain of
!                                               validity of the para-
!                                               metrization has been
!                                               added.
!                                               (J. M. Edwards)
!       5.0             15-04-98   Changes to R2_SET_CLOUD_FIELD to use
!                                  original sect 9 cloud fraction when
!                                  an extended 'area' cloud fraction is
!                                  used everywhere else in Radiation.
!                                  A.C.Bushell
!       4.5             18-05-98                New option for
!                                               partitioning between
!                                               ice and water in
!                                               convective cloud
!                                               included.
!                                               (J. M. Edwards)
!       4.5             13/05/98   Changes to R2_SET_CLOUD_FIELD to use
!                                  original sect 9 cloud fraction when
!                                  an extended 'area' cloud fraction is
!                                  used everywhere else in Radiation.
!                                  S. Cusack
!       5.1             04-04-00                Remove obsolete tests
!                                               for convective cloud
!                                               and removal of very
!                                               thin cloud (no longer
!                                               required with current
!                                               solvers, but affects
!                                               bit-comparison).
!                                               (J. M. Edwards)
!       5.1             06-04-00                Correct some comments
!                                               and error messages.
!                                               (J. M. Edwards)
!       5.2             10-11-00                With local partitioning
!                                               of convective cloud
!                                               between water and ice
!                                               force homogeneous
!                                               nucleation at
!                                               -40 Celsius.
!       5.2             14-11-00                Add provision for an
!                                               extra radiative layer
!                                               above the top of the
!                                               model.
!                                               (J. M. Edwards)
!       5.2             15-11-00                Pass sea-salt variables
!                                               down to R2_RE_MRF_UMIST.
!                                               (A. Jones)
!       5.3             11-10-01                Convert returned
!                                               diagnostics to 2-D
!                                               arrays.
!                                               (J. M. Edwards)
!       5.4             22-07-02                Check on small cloud
!                                               fractions and liquid for
!                                               contents for PC2 scheme.
!                                               (D. Wilson)
!       5.5             24-02-03                Addition of new ice
!                                               aggregate
!                                               parametrization.
!                                               (J. M. Edwards)
!       6.1             07-04-04                Add biomass smoke
!                                               aerosol to call to
!                                               R2_RE_MRF_UMIST.
!                                               (A. Jones)
!       6.1             07-04-04                Add variables for
!                                               column-droplet
!                                               calculation.
!                                               (A. Jones)
!       6.2             24-11-05                Pass Ntot_land and
!                                               Ntot_sea from UMUI.
!                                               (Damian Wilson)
!       6.2             02-03-05                Pass through PC2 logical
!                                               (Damian Wilson)
!
!
! Description of Code:
!   FORTRAN 77  with extensions listed in documentation.
!
!- ---------------------------------------------------------------------
!+ Subroutine to set the parametrization schemes for clouds.
!
! Purpose:
!   The parametrization schemes for each component within a cloud
!   are set.
!
! Method:
!   Straightforward.
!
! Current Owner of Code: J. M. Edwards
!
! History:
!       Version         Date                    Comment
!       4.0             27-07-95                Original Code
!                                               (J. M. Edwards)
!       4.4             15-09-97                Code to check the
!                                               range of validity of
!                                               parametrizations
!                                               added.
!                                               (J. M. Edwards)
!       4.5             18-05-98                Error message for
!                                               ice corrected.
!                                               (J. M. Edwards)
!
! Description of Code:
!   FORTRAN 77  with extensions listed in documentation.
!
!- ---------------------------------------------------------------------
!+ Subroutine to set fields of aerosols.
!
! Purpose:
!   The mixing ratios of aerosols are transferred to the large array.
!
! Method:
!   Straightforward.
!
! Current Owner of Code: J. M. Edwards
!
! History:
!       Version         Date                    Comment
!       4.0             27-07-95                Original Code
!                                               (J. M. Edwards)
!       4.1             12-06-96                Code rewritten to
!                                               include two types
!                                               of sulphate provided
!                                               by the sulphur cycle.
!                                               (J. M. Edwards)
!       4.2             08-08-96                Climatological aerosol
!                                               model added.
!                                               (J. M. Edwards)
!       4.4             15-09-97                Code for aerosols
!                                               generalized to allow
!                                               arbitrary combinations.
!                                               (J. M. Edwards)
!       4.5   April 1998   Option to use interactive soot in place
!                          of climatological soot.     Luke Robinson.
!                          (Repositioned more logically at 5.1)
!                                                      J. M. Edwards
!       5.1             11-04-00                The boundary layer
!                                               depth is passed to
!                                               the routine setting
!                                               the climatological
!                                               aerosol.
!                                               (J. M. Edwards)
!       5.2             14-11-00                Add provision for an
!                                               extra radiative layer
!                                               above the top of the
!                                               model.
!                                               (J. M. Edwards)
!       5.2             15-11-00                Set up sea-salt aerosol
!                                               (and deactivate climat-
!                                               ological sea-salt) if
!                                               required.
!                                               (A. Jones)
!       5.3             16-10-01                Switch off the
!                                               climatological
!                                               water soluble aerosol
!                                               when the sulphur
!                                               cycle is on.
!                                               (J. M. Edwards)
!       5.3             04-04-01                Include mesoscale
!                                               aerosols if required.
!                                                            S. Cusack
!       5.4             09-05-02                Use L_USE_SOOT_DIRECT
!                                               to govern the extra-
!                                               polation of aerosol
!                                               soot to the extra top
!                                               layer if required.
!                                               (A. Jones)
!       5.5             05-02-03                Include biomass aerosol
!                                               if required.  P Davison
!       5.5             10-01-03                Revision to sea-salt
!                                               density parameter.
!                                               (A. Jones)
!       5.5             21-02-03                Include mineral dust
!                                               aerosol if required.
!                                               S Woodward
!
! Description of Code:
!   FORTRAN 77  with extensions listed in documentation.
!
!- ---------------------------------------------------------------------
!+ Subroutine to set fields of climatological aerosols in HADCM3.
!
! Purpose:
!   This routine sets the mixing ratios of climatological aerosols.
!   A separate subroutine is used to ensure that the mixing ratios
!   of these aerosols are bit-comparable with earlier versions of
!   the model where the choice of aerosols was more restricted:
!   keeping the code in its original form reduces the opportunity
!   for optimizations which compromise bit-reproducibilty.
!   The climatoogy used here is the one devised for HADCM3.
!
! Method:
!   Straightforward.
!
! Current Owner of Code: J. M. Edwards
!
! History:
!       Version         Date                    Comment
!       4.4             29-09-97                Original Code
!                                               very closely based on
!                                               previous versions of
!                                               this scheme.
!                                               (J. M. Edwards)
!  4.5  12/05/98  Swap loop order in final nest of loops to
!                 improve vectorization.  RBarnes@ecmwf.int
!       5.2             14-11-00                Add provision for an
!                                               extra radiative layer
!                                               above the top of the
!                                               model.
!                                               (J. M. Edwards)
!       5.2             14-11-00                Impose a minimum
!                                               thickness on the
!                                               layer filled by the
!                                               boundary layer
!                                               aerosol and correct
!                                               the dimensioning of T.
!                                               (J. M. Edwards)
!       5.3             17-10-01                Restrict the height
!                                               of the BL to ensure
!                                               that at least one layer
!                                               lies in the free
!                                               troposphere in all
!                                               cases. This is needed
!                                               to allow for changes
!                                               in the range of the
!                                               tropopause.
!
! Description of Code:
!   FORTRAN 77  with extensions listed in documentation.
!
!- ---------------------------------------------------------------------
!+ Subroutine to calculate the total cloud cover.
!
! Purpose:
!   The total cloud cover at all grid-points is determined.
!
! Method:
!   A separate calculation is made for each different assumption about
!   the overlap.
!
! Current Owner of Code: J. M. Edwards
!
! History:
!       Version         Date                    Comment
!       4.0             27-07-95                Original Code
!                                               (J. M. Edwards)
!       4.2             08-08-96                Code added for coherent
!                                               convective cloud.
!                                               (J. M. Edwards)
!       5.2             14-11-00                Add provision for an
!                                               extra radiative layer
!                                               above the top of the
!                                               model.
!                                               (J. M. Edwards)
!       5.4             22-07-02                Check that cloud
!                                               fraction is between 0
!                                               and 1 for PC2 scheme.
!                                               (D. Wilson)
!
! Description of Code:
!   FORTRAN 77  with extensions listed in documentation.
!
!- ---------------------------------------------------------------------
!+ Subroutine to implement the MRF UMIST parametrization.
!
! Purpose:
!   Effective Radii are calculated in accordance with this
!   parametrization.
!
! Method:
!   The number density of CCN is found from the concentration
!   of aerosols, if available. This yields the number density of
!   droplets: if aerosols are not present, the number of droplets
!   is fixed. Effective radii are calculated from the number of
!   droplets and the LWC. Limits are applied to these values. In
!   deep convective clouds fixed values are assumed.
!
! Current Owner of Code: J. M. Edwards
!
! History:
!       Version         Date                    Comment
!       4.0             27-07-95                Original Code
!                                               (J. M. Edwards)
!       4.4             15-09-97                Accumulation-mode
!                                               and dissolved sulphate
!                                               passed directly to
!                                               this routine to allow
!                                               the indirect effect to
!                                               be used without
!                                               aerosols being needed
!                                               in the spectral file.
!                                               (J. M. Edwards)
!       4.5             18-05-98                Obsolete bounds on
!                                               effective radius
!                                               removed.
!                                               (J. M. Edwards)
!       5.2             14-11-00                Add provision for an
!                                               extra radiative layer
!                                               above the top of the
!                                               model.
!                                               (J. M. Edwards)
!       5.2             15-11-00                Subroutine for droplet
!                                               number concentration
!                                               replaced by new function
!                                               with option to use sea-
!                                               salt to supplement
!                                               sulphate aerosol.
!                                               Treatment of convective
!                                               cloud effective radii
!                                               updated.
!                                               (A. Jones)
!       6.1             07-04-04                Add biomass smoke
!                                               aerosol to call to
!                                               NUMBER_DROPLET.
!                                               (A. Jones)
!       6.1             07-04-04                Add new variables for
!                                               column cloud droplet
!                                               calculation.
!                                               (A. Jones)
!       6.2             24-11-05                Pass Ntot_land and
!                                               Ntot_sea from UMUI.
!                                               (Damian Wilson)
!       6.2             02-03-05                Protect calculations
!                                               from failure in PC2
!                                               (Damian Wilson)
!
! Description of Code:
!   FORTRAN 77  with extensions listed in documentation.
!
!- ---------------------------------------------------------------------
!+ Subroutine to calculate column-integrated cloud droplet number.
!
! Purpose:
!   To calculate a diagnostic of column-integrated cloud droplet
!   number which may be validated aginst satellite data.
!
! Method:
!   Column cloud droplet concentration (i.e. number of droplets per
!   unit area) is calculated as the vertically integrated droplet
!   number concentration averaged over the portion of the gridbox
!   covered by stratiform and convective liquid cloud with T>273K.
!
! Current Owner of Code: A. Jones
!
! History:
!       Version         Date                    Comment
!       5.4             29-05-02                Original Code
!                                               (A. Jones)
!       6.1             07-04-04                Modified in accordance
!                                               with AVHRR retrievals:
!                                               only clouds >273K used,
!                                               convective clouds also
!                                               included.
!                                               (A. Jones)
!
!
! Description of Code:
!   FORTRAN 77  with extensions listed in documentation.
!
!- ---------------------------------------------------------------------
      SUBROUTINE R2_COLUMN_DROPLET_CONC(&!
       NPD_PROFILE                    , &! INTEGER, INTENT(IN        ) :: NPD_PROFILE!Maximum number of profiles
       NPD_LAYER                      , &! INTEGER, INTENT(IN        ) :: NPD_LAYER  !Maximum number of layers
       N_PROFILE                      , &! INTEGER, INTENT(IN        ) :: N_PROFILE  !Number of atmospheric profiles
       N_LAYER                        , &! INTEGER, INTENT(IN        ) :: N_LAYER        !Number of layers seen in radiation
       NCLDS                          , &! INTEGER, INTENT(IN        ) :: NCLDS        !Number of cloudy layers
       STRAT_LIQ_CLOUD_FRACTION       , &! REAL   , INTENT(IN        ) :: STRAT_LIQ_CLOUD_FRACTION(NPD_PROFILE, NPD_LAYER)
       TOTAL_STRAT_LIQ_CLOUD_FRACTION , &! REAL   , INTENT(IN        ) :: TOTAL_STRAT_LIQ_CLOUD_FRACTION(NPD_PROFILE)
       CONV_LIQ_CLOUD_FRACTION        , &! REAL   , INTENT(IN        ) :: CONV_LIQ_CLOUD_FRACTION(NPD_PROFILE, NPD_LAYER)
       TOTAL_CONV_LIQ_CLOUD_FRACTION  , &! REAL   , INTENT(IN        ) :: TOTAL_CONV_LIQ_CLOUD_FRACTION(NPD_PROFILE)
       N_DROP                         , &! REAL   , INTENT(IN        ) :: N_DROP(NPD_PROFILE, NPD_LAYER)
       D_MASS                         , &! REAL   , INTENT(IN        ) :: D_MASS(NPD_PROFILE, NPD_LAYER)
       DENSITY_AIR                    , &! REAL   , INTENT(IN        ) :: DENSITY_AIR(NPD_PROFILE, NPD_LAYER)
       NC_DIAG                        , &! REAL   , INTENT(OUT  ) :: NC_DIAG(NPD_PROFILE)
       NC_WEIGHT                        )! REAL   , INTENT(OUT  ) :: NC_WEIGHT(NPD_PROFILE)
!
!
!
      IMPLICIT NONE
!
!
!
!  Input variables:
!
      INTEGER, INTENT(IN   ) :: NPD_PROFILE!Maximum number of profiles
      INTEGER, INTENT(IN   ) :: NPD_LAYER  !Maximum number of layers
      INTEGER, INTENT(IN   ) :: N_PROFILE  !Number of atmospheric profiles
      INTEGER, INTENT(IN   ) :: N_LAYER    !Number of layers seen in radiation
      INTEGER, INTENT(IN   ) :: NCLDS      !Number of cloudy layers
!
      REAL   , INTENT(IN   ) :: STRAT_LIQ_CLOUD_FRACTION(NPD_PROFILE, NPD_LAYER)
!             Stratiform liquid (T>273K) cloud cover in layers
      REAL   , INTENT(IN   ) :: TOTAL_STRAT_LIQ_CLOUD_FRACTION(NPD_PROFILE)
!             Total liquid (T>273K) stratiform cloud cover
      REAL   , INTENT(IN   ) :: CONV_LIQ_CLOUD_FRACTION(NPD_PROFILE, NPD_LAYER)
!             Convective liquid (T>273K) cloud cover in layers
      REAL   , INTENT(IN   ) :: TOTAL_CONV_LIQ_CLOUD_FRACTION(NPD_PROFILE)
!             Total liquid (T>273K) convective cloud cover
      REAL   , INTENT(IN   ) :: N_DROP(NPD_PROFILE, NPD_LAYER)
!             Number concentration of cloud droplets (m-3)
      REAL   , INTENT(IN   ) :: D_MASS(NPD_PROFILE, NPD_LAYER)
!             Mass thickness of layer (kg m-2)
      REAL   , INTENT(IN   ) :: DENSITY_AIR(NPD_PROFILE, NPD_LAYER)
!             Air density (kg m-3)
!
!
!  Output variables:
!
      REAL   , INTENT(OUT  ) :: NC_DIAG(NPD_PROFILE)
!             Column-integrated droplet number diagnostic (m-2)
      REAL   , INTENT(OUT  ) :: NC_WEIGHT(NPD_PROFILE)
!             Weighting factor for column droplet number
!
!
!  Local variables:
!
      INTEGER :: I, L !Loop counters
!
      REAL    :: N_SUM_S
      REAL    :: N_SUM_C
!             Temporary sums
      REAL    :: NCOL_S
      REAL    :: WGT_S
      REAL    :: NCOL_C
      REAL    :: WGT_C
!             N-column values and weights for stratiform
!             and convective clouds separately.
!
!
!
      DO L=1, N_PROFILE

         N_SUM_S=0.0
         DO I=N_LAYER+1-NCLDS, N_LAYER
            N_SUM_S=N_SUM_S+(STRAT_LIQ_CLOUD_FRACTION(L, I)             &
                     *N_DROP(L, I)*D_MASS(L, I)/DENSITY_AIR(L, I))
         ENDDO

         N_SUM_C=0.0
         DO I=N_LAYER+1-NCLDS, N_LAYER
            N_SUM_C=N_SUM_C+(CONV_LIQ_CLOUD_FRACTION(L, I)              &
                     *N_DROP(L, I)*D_MASS(L, I)/DENSITY_AIR(L, I))
         ENDDO

         IF (TOTAL_STRAT_LIQ_CLOUD_FRACTION(L)  >   0.0) THEN
            NCOL_S=N_SUM_S/TOTAL_STRAT_LIQ_CLOUD_FRACTION(L)
            WGT_S=TOTAL_STRAT_LIQ_CLOUD_FRACTION(L)
         ELSE
            NCOL_S=0.0
            WGT_S=0.0
         ENDIF

         IF (TOTAL_CONV_LIQ_CLOUD_FRACTION(L)  >   0.0) THEN
            NCOL_C=N_SUM_C/TOTAL_CONV_LIQ_CLOUD_FRACTION(L)
            WGT_C=TOTAL_CONV_LIQ_CLOUD_FRACTION(L)
         ELSE
            NCOL_C=0.0
            WGT_C=0.0
         ENDIF

         IF ((WGT_S+WGT_C)  >   0.0) THEN
            NC_DIAG(L)=((NCOL_S*WGT_S)+(NCOL_C*WGT_C))/(WGT_S+WGT_C)
            NC_WEIGHT(L)=WGT_S+WGT_C
         ELSE
            NC_DIAG(L)=0.0
            NC_WEIGHT(L)=0.0
         ENDIF

      ENDDO
!
!     Note: weighting is done later in R2_SET_CLOUD_FIELD
!
!
!
      RETURN
      END SUBROUTINE R2_COLUMN_DROPLET_CONC
!+ Subroutine to set the actual process options for the radiation code.
!
! Purpose:
!   To set a consistent set of process options for the radiation.
!
! Method:
!   The global options for the spectral region are compared with the
!   contents of the spectral file. The global options should be set
!   to reflect the capabilities of the code enabled in the model.
!
! Current Owner of Code: J. M. Edwards
!
! History:
!       Version         Date                    Comment
!       4.1             04-03-96                Original Code
!                                               (J. M. Edwards)
!                                               Parts of this code are
!                                               rather redundant. The
!                                               form of writing is for
!                                               near consistency with
!                                               HADAM3.
!
!       4.5   April 1998   Check for inconsistencies between soot
!                          spectral file and options used. L Robinson.
!       5.3     04/04/01   Include mesoscale aerosol switch when
!                          checking if aerosols are required.  S. Cusack
!       5.4     09/05/02   Include logical flag for sea-salt aerosol.
!                                                              A. Jones
!       5.5     05/02/03   Include logical for biomass smoke
!                          aerosol.               P Davison
! Description of Code:
!   5.5    21/02/03 Add logical for d mineral dust
!                                                S Woodward
!   FORTRAN 77  with extensions listed in documentation.
!
!- ---------------------------------------------------------------------





! *****************************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 to set the mixing ratios of gases.
!
! Purpose:
!   The full array of mass mixing ratios of gases is filled.
!
! Method:
!   The arrays of supplied mixing ratios are inverted and fed
!   into the array to pass to the radiation code. For well-mixed
!   gases the constant mixing ratios are fed into this array.
!
! Current Owner of Code: J. M. Edwards
!
! History:
!       Version         Date                    Comment
!       4.0             27-07-95                Original Code
!                                               (J. M. Edwards)
!       4.1             10-06-96                Ozone set in lower
!                                               levels.
!                                               (J. M. Edwards)
!       4.4             26-09-97                Conv. cloud amount on
!                                               model levs allowed for.
!                                               J.M.Gregory
!       4.5             18-05-98                Provision for treating
!                                               extra (H)(C)FCs
!                                               included.
!                                               (J. M. Edwards)
!       5.1             06-04-00                Move HCFCs to a more
!                                               natural place in the
!                                               code.
!                                               (J. M. Edwards)
!       5.1             06-04-00                Remove the explicit
!                                               limit on the
!                                               concentration of
!                                               water vapour.
!                                               (J. M. Edwards)
!       5.2             14-11-00                Add provision for an
!                                               extra radiative layer
!                                               above the top of the
!                                               model.
!                                               (J. M. Edwards)
!       5.4             29-05-02                Add diagnostic call
!                                               for column-integrated
!                                               cloud droplet number.
!                                               (A. Jones)
!       5.4             25-04-02                Replace land/sea mask
!                                               with land fraction in
!                                               call to NUMBER_DROPLET
!                                               (A. Jones)
!       5.5             17-02-03                Change I_CLIM_POINTER
!                                               for hp compilation
!                                               (M.Hughes)
!  6.1   20/08/03  Code for STOCHEM feedback.  C. Johnson
!       6.2             21/02/06   Updefs Added for version
!                                  control of radiation code
!                                            (J.-C. Thelen)
!  6.2   03-11-05   Enable HadGEM1 climatological aerosols. C. F. Durman
!                   Reworked to use switch instead of #defined. R Barnes
!  6.2   25/05/05  Convert compilation into a more universally portable
!                  form. Tom Edwards
!  6.2   15/12/05  Set negative specific humidities to zero.
!                                               (J. Manners)
!
! Description of Code:
!   FORTRAN 77  with extensions listed in documentation.
!
!- ---------------------------------------------------------------------
!+ Subroutine to set thermodynamic properties
!
! Purpose:
!   Pressures, temperatures at the centres and edges of layers
!   and the masses in layers are set.
!
! Method:
!   Straightforward.
!
! Current Owner of Code: J. M. Edwards
!
! History:
!       Version         Date                    Comment
!       4.0             27-07-95                Original Code
!                                               (J. M. Edwards)
!       4.1             10-06-96                Old formulation over
!                                               sea-ice removed.
!                                               (J. M. Edwards)
!       4.2             08-08-96                Ground temperature
!                                               set equal to that
!                                               in the middle of the
!                                               bottom layer.
!                                               (J. M. Edwards)
!       5.2             14-11-00                Add provision for an
!                                               extra radiative layer
!                                               above the top of the
!                                               model.
!                                               (J. M. Edwards)
!       5.3             25-04-01                Alter the specification
!                                               of temperature on rho
!                                               levels (layer
!                                               boundaries).  S.Cusack
!       5.3             25-04-01   Gather land, sea and
!                                  sea-ice temperatures and
!                                  land fraction. Replace TFS
!                                  with general sea temperature.
!                                       (N. Gedney)
!
! Description of Code:
!   FORTRAN 77  with extensions listed in documentation.
!
!- ---------------------------------------------------------------------
!+ Subroutine to assign Properties of Clouds.
!
! Purpose:
!   The fractions of different types of clouds and their microphysical
!   preoperties are set.
!
! Method:
!   Straightforward.
!
! Current Owner of Code: J. M. Edwards
!
! History:
!       Version         Date                    Comment
!       4.0             27-07-95                Original Code
!                                               (J. M. Edwards)
!       4.1             10-06-96                New flag L_AEROSOL_CCN
!                                               introduced to allow
!                                               inclusion of indirect
!                                               aerosol forcing alone.
!                                               Correction of comments
!                                               for LCCWC1 and LCCWC2.
!                                               Correction of level at
!                                               which temperature for
!                                               partitioning
!                                               convective homogeneously
!                                               mixed cloud is taken.
!                                               (J. M. Edwards)
!       4.4             08-04-97                Changes for new precip
!                                               scheme (qCF prognostic)
!                                               (A. C. Bushell)
!       4.4             15-09-97                A parametrization of
!                                               ice crystals with a
!                                               temperature dependedence
!                                               of the size has been
!                                               added.
!                                               Explicit checking of
!                                               the sizes of particles
!                                               for the domain of
!                                               validity of the para-
!                                               metrization has been
!                                               added.
!                                               (J. M. Edwards)
!       5.0             15-04-98   Changes to R2_SET_CLOUD_FIELD to use
!                                  original sect 9 cloud fraction when
!                                  an extended 'area' cloud fraction is
!                                  used everywhere else in Radiation.
!                                  A.C.Bushell
!       4.5             18-05-98                New option for
!                                               partitioning between
!                                               ice and water in
!                                               convective cloud
!                                               included.
!                                               (J. M. Edwards)
!       4.5             13/05/98   Changes to R2_SET_CLOUD_FIELD to use
!                                  original sect 9 cloud fraction when
!                                  an extended 'area' cloud fraction is
!                                  used everywhere else in Radiation.
!                                  S. Cusack
!       5.1             04-04-00                Remove obsolete tests
!                                               for convective cloud
!                                               and removal of very
!                                               thin cloud (no longer
!                                               required with current
!                                               solvers, but affects
!                                               bit-comparison).
!                                               (J. M. Edwards)
!       5.1             06-04-00                Correct some comments
!                                               and error messages.
!                                               (J. M. Edwards)
!       5.2             10-11-00                With local partitioning
!                                               of convective cloud
!                                               between water and ice
!                                               force homogeneous
!                                               nucleation at
!                                               -40 Celsius.
!       5.2             14-11-00                Add provision for an
!                                               extra radiative layer
!                                               above the top of the
!                                               model.
!                                               (J. M. Edwards)
!       5.2             15-11-00                Pass sea-salt variables
!                                               down to R2_RE_MRF_UMIST.
!                                               (A. Jones)
!       5.3             11-10-01                Convert returned
!                                               diagnostics to 2-D
!                                               arrays.
!                                               (J. M. Edwards)
!       5.4             22-07-02                Check on small cloud
!                                               fractions and liquid for
!                                               contents for PC2 scheme.
!                                               (D. Wilson)
!       5.5             24-02-03                Addition of new ice
!                                               aggregate
!                                               parametrization.
!                                               (J. M. Edwards)
!       6.1             07-04-04                Add biomass smoke
!                                               aerosol to call to
!                                               R2_RE_MRF_UMIST.
!                                               (A. Jones)
!       6.1             07-04-04                Add variables for
!                                               column-droplet
!                                               calculation.
!                                               (A. Jones)
!       6.2             24-11-05                Pass Ntot_land and
!                                               Ntot_sea from UMUI.
!                                               (Damian Wilson)
!       6.2             02-03-05                Pass through PC2 logical
!                                               (Damian Wilson)
!
!
! Description of Code:
!   FORTRAN 77  with extensions listed in documentation.
!
!- ---------------------------------------------------------------------
!+ Subroutine to set the parametrization schemes for clouds.
!
! Purpose:
!   The parametrization schemes for each component within a cloud
!   are set.
!
! Method:
!   Straightforward.
!
! Current Owner of Code: J. M. Edwards
!
! History:
!       Version         Date                    Comment
!       4.0             27-07-95                Original Code
!                                               (J. M. Edwards)
!       4.4             15-09-97                Code to check the
!                                               range of validity of
!                                               parametrizations
!                                               added.
!                                               (J. M. Edwards)
!       4.5             18-05-98                Error message for
!                                               ice corrected.
!                                               (J. M. Edwards)
!
! Description of Code:
!   FORTRAN 77  with extensions listed in documentation.
!
!- ---------------------------------------------------------------------
!+ Subroutine to set fields of aerosols.
!
! Purpose:
!   The mixing ratios of aerosols are transferred to the large array.
!
! Method:
!   Straightforward.
!
! Current Owner of Code: J. M. Edwards
!
! History:
!       Version         Date                    Comment
!       4.0             27-07-95                Original Code
!                                               (J. M. Edwards)
!       4.1             12-06-96                Code rewritten to
!                                               include two types
!                                               of sulphate provided
!                                               by the sulphur cycle.
!                                               (J. M. Edwards)
!       4.2             08-08-96                Climatological aerosol
!                                               model added.
!                                               (J. M. Edwards)
!       4.4             15-09-97                Code for aerosols
!                                               generalized to allow
!                                               arbitrary combinations.
!                                               (J. M. Edwards)
!       4.5   April 1998   Option to use interactive soot in place
!                          of climatological soot.     Luke Robinson.
!                          (Repositioned more logically at 5.1)
!                                                      J. M. Edwards
!       5.1             11-04-00                The boundary layer
!                                               depth is passed to
!                                               the routine setting
!                                               the climatological
!                                               aerosol.
!                                               (J. M. Edwards)
!       5.2             14-11-00                Add provision for an
!                                               extra radiative layer
!                                               above the top of the
!                                               model.
!                                               (J. M. Edwards)
!       5.2             15-11-00                Set up sea-salt aerosol
!                                               (and deactivate climat-
!                                               ological sea-salt) if
!                                               required.
!                                               (A. Jones)
!       5.3             16-10-01                Switch off the
!                                               climatological
!                                               water soluble aerosol
!                                               when the sulphur
!                                               cycle is on.
!                                               (J. M. Edwards)
!       5.3             04-04-01                Include mesoscale
!                                               aerosols if required.
!                                                            S. Cusack
!       5.4             09-05-02                Use L_USE_SOOT_DIRECT
!                                               to govern the extra-
!                                               polation of aerosol
!                                               soot to the extra top
!                                               layer if required.
!                                               (A. Jones)
!       5.5             05-02-03                Include biomass aerosol
!                                               if required.  P Davison
!       5.5             10-01-03                Revision to sea-salt
!                                               density parameter.
!                                               (A. Jones)
!       5.5             21-02-03                Include mineral dust
!                                               aerosol if required.
!                                               S Woodward
!
! Description of Code:
!   FORTRAN 77  with extensions listed in documentation.
!
!- ---------------------------------------------------------------------
!+ Subroutine to set fields of climatological aerosols in HADCM3.
!
! Purpose:
!   This routine sets the mixing ratios of climatological aerosols.
!   A separate subroutine is used to ensure that the mixing ratios
!   of these aerosols are bit-comparable with earlier versions of
!   the model where the choice of aerosols was more restricted:
!   keeping the code in its original form reduces the opportunity
!   for optimizations which compromise bit-reproducibilty.
!   The climatoogy used here is the one devised for HADCM3.
!
! Method:
!   Straightforward.
!
! Current Owner of Code: J. M. Edwards
!
! History:
!       Version         Date                    Comment
!       4.4             29-09-97                Original Code
!                                               very closely based on
!                                               previous versions of
!                                               this scheme.
!                                               (J. M. Edwards)
!  4.5  12/05/98  Swap loop order in final nest of loops to
!                 improve vectorization.  RBarnes@ecmwf.int
!       5.2             14-11-00                Add provision for an
!                                               extra radiative layer
!                                               above the top of the
!                                               model.
!                                               (J. M. Edwards)
!       5.2             14-11-00                Impose a minimum
!                                               thickness on the
!                                               layer filled by the
!                                               boundary layer
!                                               aerosol and correct
!                                               the dimensioning of T.
!                                               (J. M. Edwards)
!       5.3             17-10-01                Restrict the height
!                                               of the BL to ensure
!                                               that at least one layer
!                                               lies in the free
!                                               troposphere in all
!                                               cases. This is needed
!                                               to allow for changes
!                                               in the range of the
!                                               tropopause.
!
! Description of Code:
!   FORTRAN 77  with extensions listed in documentation.
!
!- ---------------------------------------------------------------------
!+ Subroutine to calculate the total cloud cover.
!
! Purpose:
!   The total cloud cover at all grid-points is determined.
!
! Method:
!   A separate calculation is made for each different assumption about
!   the overlap.
!
! Current Owner of Code: J. M. Edwards
!
! History:
!       Version         Date                    Comment
!       4.0             27-07-95                Original Code
!                                               (J. M. Edwards)
!       4.2             08-08-96                Code added for coherent
!                                               convective cloud.
!                                               (J. M. Edwards)
!       5.2             14-11-00                Add provision for an
!                                               extra radiative layer
!                                               above the top of the
!                                               model.
!                                               (J. M. Edwards)
!       5.4             22-07-02                Check that cloud
!                                               fraction is between 0
!                                               and 1 for PC2 scheme.
!                                               (D. Wilson)
!
! Description of Code:
!   FORTRAN 77  with extensions listed in documentation.
!
!- ---------------------------------------------------------------------
      SUBROUTINE R2_CALC_TOTAL_CLOUD_COVER( &
          N_PROFILE         , &!INTEGER , INTENT(IN ):: N_PROFILE !NUMBER OF PROFILES
          N_LAYER           , &!INTEGER , INTENT(IN ):: N_LAYER   !Number of layers seen in radiation
          NCLDS             , &!INTEGER , INTENT(IN ):: NCLDS          !NUMBER OF CLOUDY LAYERS
          I_CLOUD           , &!INTEGER , INTENT(IN ):: I_CLOUD   !CLOUD SCHEME EMPLOYED
          W_CLOUD_IN        , &!REAL        , INTENT(IN ):: W_CLOUD_IN(NPD_PROFILE, NPD_LAYER)!CLOUD AMOUNTS
          TOTAL_CLOUD_COVER , &!REAL        , INTENT(OUT):: TOTAL_CLOUD_COVER(NPD_PROFILE) !TOTAL CLOUD COVER
          NPD_PROFILE       , &!INTEGER , INTENT(IN )::  NPD_PROFILE!MAXIMUM NUMBER OF PROFILES
          NPD_LAYER           )!INTEGER , INTENT(IN )::  NPD_LAYER  !MAXIMUM NUMBER OF LAYERS
!
!
!
      IMPLICIT NONE
!
!
!     DECLARATION OF ARRAY SIZES.
      INTEGER , INTENT(IN )::  NPD_PROFILE!MAXIMUM NUMBER OF PROFILES
      INTEGER , INTENT(IN )::  NPD_LAYER  !MAXIMUM NUMBER OF LAYERS
! CLSCHM3A end
!
!
!     DUMMY ARGUMENTS.
      INTEGER , INTENT(IN ):: N_PROFILE !NUMBER OF PROFILES
      INTEGER , INTENT(IN ):: N_LAYER   !Number of layers seen in radiation
      INTEGER , INTENT(IN ):: NCLDS     !NUMBER OF CLOUDY LAYERS
      INTEGER , INTENT(IN ):: I_CLOUD   !CLOUD SCHEME EMPLOYED
      REAL    , INTENT(IN ):: W_CLOUD_IN(NPD_PROFILE, NPD_LAYER)!CLOUD AMOUNTS
      REAL    , INTENT(OUT):: TOTAL_CLOUD_COVER(NPD_PROFILE) !TOTAL CLOUD COVER
!
!

!
!     COMDECKS INCLUDED
! CLSCHM3A defines reference numbers for cloud schemes in two-stream
! radiation code.

      ! maximum/random overlap in a mixed column
      INTEGER,PARAMETER:: IP_CLOUD_MIX_MAX=2

      ! random overlap in a mixed column
      INTEGER,PARAMETER:: IP_CLOUD_MIX_RANDOM=4

      ! maximum overlap in a column model
      INTEGER,PARAMETER:: IP_CLOUD_COLUMN_MAX=3

      ! clear column
      INTEGER,PARAMETER:: IP_CLOUD_CLEAR=5

      ! mixed column with split between  convective and layer cloud.
      INTEGER,PARAMETER:: IP_CLOUD_TRIPLE=6

      ! Coupled overlap with partial correlation of cloud
      INTEGER,Parameter:: IP_cloud_part_corr=7

      ! Coupled overlap with partial correlation of cloud
      ! with a separate treatment of convective cloud
      INTEGER,Parameter:: IP_cloud_part_corr_cnv=8

!
!
!     LOCAL VARIABLES.
      INTEGER :: L!             LOOP VARIABLE
      INTEGER :: I!             LOOP VARIABLE
      REAL    :: W_CLOUD(NPD_PROFILE, NPD_LAYER)
!
!
!
!     COPY W_CLOUD_IN TO W_CLOUD AND THEN CHECK THAT VALUES ARE
!     BETWEEN 0 AND 1.
!
         DO I=N_LAYER+1-NCLDS, N_LAYER
            DO L=1, N_PROFILE
              W_CLOUD(L,I) = MIN( MAX(W_CLOUD_IN(L,I),0.0) , 1.0 )
            ENDDO
         ENDDO
!
!     DIFFERENT OVERLAP ASSUMPTIONS ARE CODED INTO EACH SOLVER.
!
      IF (I_CLOUD == IP_CLOUD_MIX_MAX) THEN
!
!        USE THE TOTAL CLOUD COVER TEMPORARILY TO HOLD THE CLEAR-SKY
!        FRACTION AND CONVERT BACK TO CLOUD COVER LATER.
!        WE CALCULATE THIS QUANTITY BY IMAGINING A TOTALLY TRANSPARENT
!        ATMOSPHERE CONTAINING TOTALLY OPAQUE CLOUDS AND FINDING THE
!        TRANSMISSION.
         DO L=1, N_PROFILE
            TOTAL_CLOUD_COVER(L)=1.0E+00-W_CLOUD(L, N_LAYER+1-NCLDS)
         ENDDO
         DO I=N_LAYER+1-NCLDS, N_LAYER-1
            DO L=1, N_PROFILE
               IF (W_CLOUD(L, I+1) >  W_CLOUD(L, I)) THEN
                  TOTAL_CLOUD_COVER(L)=TOTAL_CLOUD_COVER(L)             &
                     *(1.0E+00-W_CLOUD(L, I+1))/(1.0E+00-W_CLOUD(L, I))
               ENDIF
            ENDDO
         ENDDO
         DO L=1, N_PROFILE
            TOTAL_CLOUD_COVER(L)=1.0E+00-TOTAL_CLOUD_COVER(L)
         ENDDO
!
      ELSE IF (I_CLOUD == IP_CLOUD_MIX_RANDOM) THEN
!
!        USE THE TOTAL CLOUD COVER TEMPORARILY TO HOLD THE CLEAR-SKY
!        FRACTION AND CONVERT BACK TO CLOUD COVER LATER.
         DO L=1, N_PROFILE
            TOTAL_CLOUD_COVER(L)=1.0E+00
         ENDDO
         DO I=N_LAYER+1-NCLDS, N_LAYER
            DO L=1, N_PROFILE
               TOTAL_CLOUD_COVER(L)=TOTAL_CLOUD_COVER(L)                &
                  *(1.0E+00-W_CLOUD(L, I))
            ENDDO
         ENDDO
         DO L=1, N_PROFILE
            TOTAL_CLOUD_COVER(L)=1.0E+00-TOTAL_CLOUD_COVER(L)
         ENDDO
!
      ELSE IF (I_CLOUD == IP_CLOUD_COLUMN_MAX) THEN
!
         DO L=1, N_PROFILE
            TOTAL_CLOUD_COVER(L)=0.0E+00
         ENDDO
         DO I=N_LAYER+1-NCLDS, N_LAYER
            DO L=1, N_PROFILE
               TOTAL_CLOUD_COVER(L)=MAX(TOTAL_CLOUD_COVER(L)            &
                 , W_CLOUD(L, I))
            ENDDO
         ENDDO
!
      ELSE IF (I_CLOUD == IP_CLOUD_TRIPLE) THEN
!
!        USE THE TOTAL CLOUD COVER TEMPORARILY TO HOLD THE CLEAR-SKY
!        FRACTION AND CONVERT BACK TO CLOUD COVER LATER.
!        WE CALCULATE THIS QUANTITY BY IMAGINING A TOTALLY TRANSPARENT
!        ATMOSPHERE CONTAINING TOTALLY OPAQUE CLOUDS AND FINDING THE
!        TRANSMISSION.
         DO L=1, N_PROFILE
            TOTAL_CLOUD_COVER(L)=1.0E+00-W_CLOUD(L, N_LAYER+1-NCLDS)
         ENDDO
         DO I=N_LAYER+1-NCLDS, N_LAYER-1
            DO L=1, N_PROFILE
               IF (W_CLOUD(L, I+1) >  W_CLOUD(L, I)) THEN
                  TOTAL_CLOUD_COVER(L)=TOTAL_CLOUD_COVER(L)             &
                     *(1.0E+00-W_CLOUD(L, I+1))/(1.0E+00-W_CLOUD(L, I))
               ENDIF
            ENDDO
         ENDDO
         DO L=1, N_PROFILE
            TOTAL_CLOUD_COVER(L)=1.0E+00-TOTAL_CLOUD_COVER(L)
         ENDDO
!
      ELSE IF (I_CLOUD == IP_CLOUD_CLEAR) THEN
!
         DO L=1, N_PROFILE
            TOTAL_CLOUD_COVER(L)=0.0E+00
         ENDDO
!
      ENDIF
!
!
!
      RETURN
      END SUBROUTINE R2_CALC_TOTAL_CLOUD_COVER
!+ Subroutine to implement the MRF UMIST parametrization.
!
! Purpose:
!   Effective Radii are calculated in accordance with this
!   parametrization.
!
! Method:
!   The number density of CCN is found from the concentration
!   of aerosols, if available. This yields the number density of
!   droplets: if aerosols are not present, the number of droplets
!   is fixed. Effective radii are calculated from the number of
!   droplets and the LWC. Limits are applied to these values. In
!   deep convective clouds fixed values are assumed.
!
! Current Owner of Code: J. M. Edwards
!
! History:
!       Version         Date                    Comment
!       4.0             27-07-95                Original Code
!                                               (J. M. Edwards)
!       4.4             15-09-97                Accumulation-mode
!                                               and dissolved sulphate
!                                               passed directly to
!                                               this routine to allow
!                                               the indirect effect to
!                                               be used without
!                                               aerosols being needed
!                                               in the spectral file.
!                                               (J. M. Edwards)
!       4.5             18-05-98                Obsolete bounds on
!                                               effective radius
!                                               removed.
!                                               (J. M. Edwards)
!       5.2             14-11-00                Add provision for an
!                                               extra radiative layer
!                                               above the top of the
!                                               model.
!                                               (J. M. Edwards)
!       5.2             15-11-00                Subroutine for droplet
!                                               number concentration
!                                               replaced by new function
!                                               with option to use sea-
!                                               salt to supplement
!                                               sulphate aerosol.
!                                               Treatment of convective
!                                               cloud effective radii
!                                               updated.
!                                               (A. Jones)
!       6.1             07-04-04                Add biomass smoke
!                                               aerosol to call to
!                                               NUMBER_DROPLET.
!                                               (A. Jones)
!       6.1             07-04-04                Add new variables for
!                                               column cloud droplet
!                                               calculation.
!                                               (A. Jones)
!       6.2             24-11-05                Pass Ntot_land and
!                                               Ntot_sea from UMUI.
!                                               (Damian Wilson)
!       6.2             02-03-05                Protect calculations
!                                               from failure in PC2
!                                               (Damian Wilson)
!
! Description of Code:
!   FORTRAN 77  with extensions listed in documentation.
!
!- ---------------------------------------------------------------------
!+ Subroutine to calculate column-integrated cloud droplet number.
!
! Purpose:
!   To calculate a diagnostic of column-integrated cloud droplet
!   number which may be validated aginst satellite data.
!
! Method:
!   Column cloud droplet concentration (i.e. number of droplets per
!   unit area) is calculated as the vertically integrated droplet
!   number concentration averaged over the portion of the gridbox
!   covered by stratiform and convective liquid cloud with T>273K.
!
! Current Owner of Code: A. Jones
!
! History:
!       Version         Date                    Comment
!       5.4             29-05-02                Original Code
!                                               (A. Jones)
!       6.1             07-04-04                Modified in accordance
!                                               with AVHRR retrievals:
!                                               only clouds >273K used,
!                                               convective clouds also
!                                               included.
!                                               (A. Jones)
!
!
! Description of Code:
!   FORTRAN 77  with extensions listed in documentation.
!
!- ---------------------------------------------------------------------
!+ Subroutine to set the actual process options for the radiation code.
!
! Purpose:
!   To set a consistent set of process options for the radiation.
!
! Method:
!   The global options for the spectral region are compared with the
!   contents of the spectral file. The global options should be set
!   to reflect the capabilities of the code enabled in the model.
!
! Current Owner of Code: J. M. Edwards
!
! History:
!       Version         Date                    Comment
!       4.1             04-03-96                Original Code
!                                               (J. M. Edwards)
!                                               Parts of this code are
!                                               rather redundant. The
!                                               form of writing is for
!                                               near consistency with
!                                               HADAM3.
!
!       4.5   April 1998   Check for inconsistencies between soot
!                          spectral file and options used. L Robinson.
!       5.3     04/04/01   Include mesoscale aerosol switch when
!                          checking if aerosols are required.  S. Cusack
!       5.4     09/05/02   Include logical flag for sea-salt aerosol.
!                                                              A. Jones
!       5.5     05/02/03   Include logical for biomass smoke
!                          aerosol.               P Davison
! Description of Code:
!   5.5    21/02/03 Add logical for d mineral dust
!                                                S Woodward
!   FORTRAN 77  with extensions listed in documentation.
!
!- ---------------------------------------------------------------------



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



END Module CalCloudCover
PROGRAM Main
  USE CalCloudCover
END PROGRAM Main
