source: LMDZ6/branches/contrails/libf/phylmd/ecrad.v1.5.1/radiation_interface.F90 @ 5428

! radiation_interface.F90 - Public interface to radiation scheme
!
! (C) Copyright 2014- ECMWF.
!
! This software is licensed under the terms of the Apache Licence Version 2.0
! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
!
! In applying this licence, ECMWF does not waive the privileges and immunities
! granted to it by virtue of its status as an intergovernmental organisation
! nor does it submit to any jurisdiction.
!
! Author:  Robin Hogan
! Email:   r.j.hogan@ecmwf.int
!
! Modifications
!   2017-04-11  R. Hogan  Changes to enable generalized surface description
!   2017-09-08  R. Hogan  Reverted some changes
!
! To use the radiation scheme, create a configuration_type object,
! call "setup_radiation" on it once to load the look-up-tables and
! data describing how gas and hydrometeor absorption/scattering are to
! be represented, and call "radiation" multiple times on different
! input profiles.

module radiation_interface

  implicit none

  public  :: setup_radiation, set_gas_units, radiation
  private :: radiation_reverse

contains

  !---------------------------------------------------------------------
  ! Load the look-up-tables and data describing how gas and
  ! hydrometeor absorption/scattering are to be represented
  subroutine setup_radiation(config)

    use parkind1,         only : jprb
    use yomhook,          only : lhook, dr_hook
    use radiation_config, only : config_type, ISolverMcICA, &
         &   IGasModelMonochromatic, IGasModelIFSRRTMG, IGasModelECCKD
    use radiation_spectral_definition, only &
         &  : SolarReferenceTemperature, TerrestrialReferenceTemperature

    ! Currently there are two gas absorption models: RRTMG (default)
    ! and monochromatic
    use radiation_monochromatic,  only : &
         &   setup_gas_optics_mono     => setup_gas_optics, &
         &   setup_cloud_optics_mono   => setup_cloud_optics, &
         &   setup_aerosol_optics_mono => setup_aerosol_optics
    use radiation_ifs_rrtm,       only :  setup_gas_optics_rrtmg => setup_gas_optics
    use radiation_ecckd_interface,only :  setup_gas_optics_ecckd => setup_gas_optics
    use radiation_cloud_optics,   only :  setup_cloud_optics
    use radiation_general_cloud_optics, only :  setup_general_cloud_optics
    use radiation_aerosol_optics, only :  setup_aerosol_optics

    type(config_type), intent(inout) :: config

    real(jprb) :: hook_handle

    if (lhook) call dr_hook('radiation_interface:setup_radiation',0,hook_handle)

    ! Consolidate configuration data, including setting data file
    ! names
    call config%consolidate()

    ! Load the look-up tables from files in the specified directory
    if (config%i_gas_model == IGasModelMonochromatic) then
      call setup_gas_optics_mono(config, trim(config%directory_name))
    else if (config%i_gas_model == IGasModelIFSRRTMG) then
      call setup_gas_optics_rrtmg(config, trim(config%directory_name))
    else if (config%i_gas_model == IGasModelECCKD) then
      call setup_gas_optics_ecckd(config)
    end if

    ! Whether or not the "radiation" subroutine needs ssa_lw and g_lw
    ! arrays depends on whether longwave scattering by aerosols is to
    ! be included.  If not, one of the array dimensions will be set to
    ! zero.
    if (config%do_lw_aerosol_scattering) then
      config%n_g_lw_if_scattering = config%n_g_lw
    else
      config%n_g_lw_if_scattering = 0
    end if

    ! Whether or not the "radiation" subroutine needs ssa_lw_cloud and
    ! g_lw_cloud arrays depends on whether longwave scattering by
    ! hydrometeors is to be included.  If not, one of the array
    ! dimensions will be set to zero.
    if (config%do_lw_cloud_scattering) then
      config%n_bands_lw_if_scattering = config%n_bands_lw
    else
      config%n_bands_lw_if_scattering = 0
    end if

    ! If we have longwave scattering and McICA then even if there is
    ! no aerosol, it is convenient if single scattering albedo and
    ! g factor arrays are allocated before the call to
    ! solver_lw as they will be needed.
    if (config%do_lw_cloud_scattering &
         &  .and. config%i_solver_lw == ISolverMcICA) then
      config%n_g_lw_if_scattering = config%n_g_lw
    end if

    ! Consolidate the albedo/emissivity intervals with the shortwave
    ! and longwave spectral bands
    if (config%do_sw) then
      call config%consolidate_sw_albedo_intervals
    end if
    if (config%do_lw) then
      call config%consolidate_lw_emiss_intervals
    end if

    if (config%do_clouds) then
      if (config%i_gas_model == IGasModelMonochromatic) then
        !      call setup_cloud_optics_mono(config)
      elseif (config%use_general_cloud_optics) then
        call setup_general_cloud_optics(config)
      else
        call setup_cloud_optics(config)
      end if
    end if

    if (config%use_aerosols) then
      if (config%i_gas_model == IGasModelMonochromatic) then
!        call setup_aerosol_optics_mono(config)
      else 
        call setup_aerosol_optics(config)
      end if
    end if

    ! Load cloud water PDF look-up table for McICA
    if (         config%i_solver_sw == ISolverMcICA &
         &  .or. config%i_solver_lw == ISolverMcICA) then
      call config%pdf_sampler%setup(config%cloud_pdf_file_name, &
           &                        iverbose=config%iverbosesetup)
    end if

    if (lhook) call dr_hook('radiation_interface:setup_radiation',1,hook_handle)

  end subroutine setup_radiation


  !---------------------------------------------------------------------
  ! Scale the gas mixing ratios so that they have the units (and
  ! possibly scale factors) required by the specific gas absorption
  ! model.  This subroutine simply passes the gas object on to the
  ! module of the currently active gas model.
  subroutine set_gas_units(config, gas)
    
    use radiation_config
    use radiation_gas,             only : gas_type
    use radiation_monochromatic,   only : set_gas_units_mono  => set_gas_units
    use radiation_ifs_rrtm,        only : set_gas_units_ifs   => set_gas_units
    use radiation_ecckd_interface, only : set_gas_units_ecckd => set_gas_units

    type(config_type), intent(in)    :: config
    type(gas_type),    intent(inout) :: gas

    if (config%i_gas_model == IGasModelMonochromatic) then
      call set_gas_units_mono(gas)
    elseif (config%i_gas_model == IGasModelECCKD) then
      call set_gas_units_ecckd(gas)
    else
      call set_gas_units_ifs(gas)
    end if

  end subroutine set_gas_units


  !---------------------------------------------------------------------
  ! Run the radiation scheme according to the configuration in the
  ! config object. There are ncol profiles of which only istartcol to
  ! iendcol are to be processed, and there are nlev model levels.  The
  ! output fluxes are written to the flux object, and all other
  ! objects contain the input variables.  The variables may be defined
  ! either in order of increasing or decreasing pressure, but if in
  ! order of decreasing pressure then radiation_reverse will be called
  ! to reverse the order for the computation and then reverse the
  ! order of the output fluxes to match the inputs.
  subroutine radiation(ncol, nlev, istartcol, iendcol, config, &
       &  single_level, thermodynamics, gas, cloud, aerosol, flux)

    use parkind1,                 only : jprb
    use yomhook,                  only : lhook, dr_hook

    use radiation_io,             only : nulout
    use radiation_config,         only : config_type, &
         &   IGasModelMonochromatic, IGasModelIFSRRTMG, &
         &   ISolverMcICA, ISolverSpartacus, ISolverHomogeneous, &
         &   ISolverTripleclouds
    use radiation_single_level,   only : single_level_type
    use radiation_thermodynamics, only : thermodynamics_type
    use radiation_gas,            only : gas_type
    use radiation_cloud,          only : cloud_type
    use radiation_aerosol,        only : aerosol_type
    use radiation_flux,           only : flux_type
    use radiation_spartacus_sw,   only : solver_spartacus_sw
    use radiation_spartacus_lw,   only : solver_spartacus_lw
    use radiation_tripleclouds_sw,only : solver_tripleclouds_sw
    use radiation_tripleclouds_lw,only : solver_tripleclouds_lw
    use radiation_mcica_sw,       only : solver_mcica_sw
    use radiation_mcica_lw,       only : solver_mcica_lw
    use radiation_cloudless_sw,   only : solver_cloudless_sw
    use radiation_cloudless_lw,   only : solver_cloudless_lw
    use radiation_homogeneous_sw, only : solver_homogeneous_sw
    use radiation_homogeneous_lw, only : solver_homogeneous_lw
    use radiation_save,           only : save_radiative_properties

    ! Treatment of gas and hydrometeor optics 
    use radiation_monochromatic,  only : &
         &   gas_optics_mono         => gas_optics, &
         &   cloud_optics_mono       => cloud_optics, &
         &   add_aerosol_optics_mono => add_aerosol_optics
    use radiation_ifs_rrtm,       only : gas_optics_rrtmg => gas_optics
    use radiation_ecckd_interface,only : gas_optics_ecckd => gas_optics
    use radiation_cloud_optics,   only : cloud_optics
    use radiation_general_cloud_optics, only : general_cloud_optics
    use radiation_aerosol_optics, only : add_aerosol_optics

    ! Inputs
    integer, intent(in) :: ncol               ! number of columns
    integer, intent(in) :: nlev               ! number of model levels
    integer, intent(in) :: istartcol, iendcol ! range of columns to process
    type(config_type),        intent(in)   :: config
    type(single_level_type),  intent(in)   :: single_level
    type(thermodynamics_type),intent(in)   :: thermodynamics
    type(gas_type),           intent(in)   :: gas
    type(cloud_type),         intent(inout):: cloud
    type(aerosol_type),       intent(in)   :: aerosol
    ! Output
    type(flux_type),          intent(inout):: flux


    ! Local variables

    ! Layer optical depth, single scattering albedo and asymmetry factor of
    ! gases and aerosols at each longwave g-point, where the latter
    ! two variables are only defined if aerosol longwave scattering is
    ! enabled (otherwise both are treated as zero).
    real(jprb), dimension(config%n_g_lw,nlev,istartcol:iendcol) :: od_lw
    real(jprb), dimension(config%n_g_lw_if_scattering,nlev,istartcol:iendcol) :: &
         &  ssa_lw, g_lw

    ! Layer in-cloud optical depth, single scattering albedo and
    ! asymmetry factor of hydrometeors in each longwave band, where
    ! the latter two variables are only defined if hydrometeor
    ! longwave scattering is enabled (otherwise both are treated as
    ! zero).
    real(jprb), dimension(config%n_bands_lw,nlev,istartcol:iendcol) :: od_lw_cloud
    real(jprb), dimension(config%n_bands_lw_if_scattering,nlev,istartcol:iendcol) :: &
         &  ssa_lw_cloud, g_lw_cloud

    ! Layer optical depth, single scattering albedo and asymmetry factor of
    ! gases and aerosols at each shortwave g-point
    real(jprb), dimension(config%n_g_sw,nlev,istartcol:iendcol) :: od_sw, ssa_sw, g_sw

    ! Layer in-cloud optical depth, single scattering albedo and
    ! asymmetry factor of hydrometeors in each shortwave band
    real(jprb), dimension(config%n_bands_sw,nlev,istartcol:iendcol)   :: &
         &  od_sw_cloud, ssa_sw_cloud, g_sw_cloud

    ! The Planck function (emitted flux from a black body) at half
    ! levels
    real(jprb), dimension(config%n_g_lw,nlev+1,istartcol:iendcol) :: planck_hl

    ! The longwave emission from and albedo of the surface in each
    ! longwave g-point; note that these are weighted averages of the
    ! values from individual tiles
    real(jprb), dimension(config%n_g_lw, istartcol:iendcol) :: lw_emission
    real(jprb), dimension(config%n_g_lw, istartcol:iendcol) :: lw_albedo

    ! Direct and diffuse shortwave surface albedo in each shortwave
    ! g-point; note that these are weighted averages of the values
    ! from individual tiles
    real(jprb), dimension(config%n_g_sw, istartcol:iendcol) :: sw_albedo_direct
    real(jprb), dimension(config%n_g_sw, istartcol:iendcol) :: sw_albedo_diffuse

    ! The incoming shortwave flux into a plane perpendicular to the
    ! incoming radiation at top-of-atmosphere in each of the shortwave
    ! g-points
    real(jprb), dimension(config%n_g_sw,istartcol:iendcol) :: incoming_sw

    character(len=100) :: rad_prop_file_name
    character(*), parameter :: rad_prop_base_file_name = "radiative_properties"

    real(jprb) :: hook_handle

    if (lhook) call dr_hook('radiation_interface:radiation',0,hook_handle)

    if (thermodynamics%pressure_hl(istartcol,2) &
         &  < thermodynamics%pressure_hl(istartcol,1)) then
      ! Input arrays are arranged in order of decreasing pressure /
      ! increasing height: the following subroutine reverses them,
      ! call the radiation scheme and then reverses the returned
      ! fluxes
      call radiation_reverse(ncol, nlev, istartcol, iendcol, config, &
           &  single_level, thermodynamics, gas, cloud, aerosol, flux)
    else

      ! Input arrays arranged in order of increasing pressure /
      ! decreasing height: progress normally

      ! Extract surface albedos at each gridpoint
      call single_level%get_albedos(istartcol, iendcol, config, &
           &                        sw_albedo_direct, sw_albedo_diffuse, &
           &                        lw_albedo)

      ! Compute gas absorption optical depth in shortwave and
      ! longwave, shortwave single scattering albedo (i.e. fraction of
      ! extinction due to Rayleigh scattering), Planck functions and
      ! incoming shortwave flux at each g-point, for the specified
      ! range of atmospheric columns
      if (config%i_gas_model == IGasModelMonochromatic) then
        call gas_optics_mono(ncol,nlev,istartcol,iendcol, config, &
             &  single_level, thermodynamics, gas, lw_albedo, &
             &  od_lw, od_sw, ssa_sw, &
             &  planck_hl, lw_emission, incoming_sw)
      else if (config%i_gas_model == IGasModelIFSRRTMG) then
        call gas_optics_rrtmg(ncol,nlev,istartcol,iendcol, config, &
             &  single_level, thermodynamics, gas, &
             &  od_lw, od_sw, ssa_sw, lw_albedo=lw_albedo, &
             &  planck_hl=planck_hl, lw_emission=lw_emission, &
             &  incoming_sw=incoming_sw)
      else
        call gas_optics_ecckd(ncol,nlev,istartcol,iendcol, config, &
             &  single_level, thermodynamics, gas, &
             &  od_lw, od_sw, ssa_sw, lw_albedo=lw_albedo, &
             &  planck_hl=planck_hl, lw_emission=lw_emission, &
             &  incoming_sw=incoming_sw)
      end if

      if (config%do_clouds) then
        ! Crop the cloud fraction to remove clouds that have too small
        ! a fraction or water content; after this, we can safely
        ! assume that a cloud is present if cloud%fraction > 0.0.
        call cloud%crop_cloud_fraction(istartcol, iendcol, &
             &            config%cloud_fraction_threshold, &
             &            config%cloud_mixing_ratio_threshold)

        ! Compute hydrometeor absorption/scattering properties in each
        ! shortwave and longwave band
        if (config%i_gas_model == IGasModelMonochromatic) then
          call cloud_optics_mono(nlev, istartcol, iendcol, &
               &  config, thermodynamics, cloud, &
               &  od_lw_cloud, ssa_lw_cloud, g_lw_cloud, &
               &  od_sw_cloud, ssa_sw_cloud, g_sw_cloud)
        elseif (config%use_general_cloud_optics) then
          call general_cloud_optics(nlev, istartcol, iendcol, &
               &  config, thermodynamics, cloud, & 
               &  od_lw_cloud, ssa_lw_cloud, g_lw_cloud, &
               &  od_sw_cloud, ssa_sw_cloud, g_sw_cloud)
        else
          call cloud_optics(nlev, istartcol, iendcol, &
               &  config, thermodynamics, cloud, & 
               &  od_lw_cloud, ssa_lw_cloud, g_lw_cloud, &
               &  od_sw_cloud, ssa_sw_cloud, g_sw_cloud)
        end if
      end if ! do_clouds

      if (config%use_aerosols) then
        if (config%i_gas_model == IGasModelMonochromatic) then
!          call add_aerosol_optics_mono(nlev,istartcol,iendcol, &
!               &  config, thermodynamics, gas, aerosol, & 
!               &  od_lw, ssa_lw, g_lw, od_sw, ssa_sw, g_sw)
        else
          call add_aerosol_optics(nlev,istartcol,iendcol, &
               &  config, thermodynamics, gas, aerosol, & 
               &  od_lw, ssa_lw, g_lw, od_sw, ssa_sw, g_sw)
        end if
      else
        g_sw(:,:,istartcol:iendcol) = 0.0_jprb
        if (config%do_lw_aerosol_scattering) then
          ssa_lw(:,:,istartcol:iendcol) = 0.0_jprb
          g_lw(:,:,istartcol:iendcol)   = 0.0_jprb
        end if
      end if

      ! For diagnostic purposes, save these intermediate variables to
      ! a NetCDF file
      if (config%do_save_radiative_properties) then
        if (istartcol == 1 .and. iendcol == ncol) then
          rad_prop_file_name = rad_prop_base_file_name // ".nc"
        else
          write(rad_prop_file_name,'(a,a,i4.4,a,i4.4,a)') &
               &  rad_prop_base_file_name, '_', istartcol, '-',iendcol,'.nc'
        end if
        call save_radiative_properties(trim(rad_prop_file_name), &
             &  nlev, istartcol, iendcol, &
             &  config, single_level, thermodynamics, cloud, &
             &  planck_hl, lw_emission, lw_albedo, &
             &  sw_albedo_direct, sw_albedo_diffuse, incoming_sw, &
             &  od_lw, ssa_lw, g_lw, od_sw, ssa_sw, g_sw, &
             &  od_lw_cloud, ssa_lw_cloud, g_lw_cloud, &
             &  od_sw_cloud, ssa_sw_cloud, g_sw_cloud)
      end if

      if (config%do_lw) then
        if (config%iverbose >= 2) then
          write(nulout,'(a)') 'Computing longwave fluxes'
        end if

        if (config%i_solver_lw == ISolverMcICA) then
          ! Compute fluxes using the McICA longwave solver
          call solver_mcica_lw(nlev,istartcol,iendcol, &
               &  config, single_level, cloud, & 
               &  od_lw, ssa_lw, g_lw, od_lw_cloud, ssa_lw_cloud, &
               &  g_lw_cloud, planck_hl, lw_emission, lw_albedo, flux)
        else if (config%i_solver_lw == ISolverSPARTACUS) then
          ! Compute fluxes using the SPARTACUS longwave solver
          call solver_spartacus_lw(nlev,istartcol,iendcol, &
               &  config, thermodynamics, cloud, & 
               &  od_lw, ssa_lw, g_lw, od_lw_cloud, ssa_lw_cloud, g_lw_cloud, &
               &  planck_hl, lw_emission, lw_albedo, flux)
        else if (config%i_solver_lw == ISolverTripleclouds) then
          ! Compute fluxes using the Tripleclouds longwave solver
          call solver_tripleclouds_lw(nlev,istartcol,iendcol, &
               &  config, cloud, & 
               &  od_lw, ssa_lw, g_lw, od_lw_cloud, ssa_lw_cloud, g_lw_cloud, &
               &  planck_hl, lw_emission, lw_albedo, flux)
        elseif (config%i_solver_lw == ISolverHomogeneous) then
          ! Compute fluxes using the homogeneous solver
          call solver_homogeneous_lw(nlev,istartcol,iendcol, &
               &  config, cloud, & 
               &  od_lw, ssa_lw, g_lw, od_lw_cloud, ssa_lw_cloud, &
               &  g_lw_cloud, planck_hl, lw_emission, lw_albedo, flux)
        else
          ! Compute fluxes using the cloudless solver
          call solver_cloudless_lw(nlev,istartcol,iendcol, &
               &  config, od_lw, ssa_lw, g_lw, &
               &  planck_hl, lw_emission, lw_albedo, flux)
        end if
      end if

      if (config%do_sw) then
        if (config%iverbose >= 2) then
          write(nulout,'(a)') 'Computing shortwave fluxes'
        end if

        if (config%i_solver_sw == ISolverMcICA) then
          ! Compute fluxes using the McICA shortwave solver
          call solver_mcica_sw(nlev,istartcol,iendcol, &
               &  config, single_level, cloud, & 
               &  od_sw, ssa_sw, g_sw, od_sw_cloud, ssa_sw_cloud, &
               &  g_sw_cloud, sw_albedo_direct, sw_albedo_diffuse, &
               &  incoming_sw, flux)
        else if (config%i_solver_sw == ISolverSPARTACUS) then
          ! Compute fluxes using the SPARTACUS shortwave solver
          call solver_spartacus_sw(nlev,istartcol,iendcol, &
               &  config, single_level, thermodynamics, cloud, & 
               &  od_sw, ssa_sw, g_sw, od_sw_cloud, ssa_sw_cloud, &
               &  g_sw_cloud, sw_albedo_direct, sw_albedo_diffuse, &
               &  incoming_sw, flux)
        else if (config%i_solver_sw == ISolverTripleclouds) then
          ! Compute fluxes using the Tripleclouds shortwave solver
          call solver_tripleclouds_sw(nlev,istartcol,iendcol, &
               &  config, single_level, cloud, & 
               &  od_sw, ssa_sw, g_sw, od_sw_cloud, ssa_sw_cloud, &
               &  g_sw_cloud, sw_albedo_direct, sw_albedo_diffuse, &
               &  incoming_sw, flux)
        elseif (config%i_solver_sw == ISolverHomogeneous) then
          ! Compute fluxes using the homogeneous solver
          call solver_homogeneous_sw(nlev,istartcol,iendcol, &
               &  config, single_level, cloud, & 
               &  od_sw, ssa_sw, g_sw, od_sw_cloud, ssa_sw_cloud, &
               &  g_sw_cloud, sw_albedo_direct, sw_albedo_diffuse, &
               &  incoming_sw, flux)
        else
          ! Compute fluxes using the cloudless solver
          call solver_cloudless_sw(nlev,istartcol,iendcol, &
               &  config, single_level, od_sw, ssa_sw, g_sw, &
               &  sw_albedo_direct, sw_albedo_diffuse, &
               &  incoming_sw, flux)
        end if
      end if

      ! Store surface downwelling fluxes in bands from fluxes in g
      ! points
      call flux%calc_surface_spectral(config, istartcol, iendcol)

    end if
    
    if (lhook) call dr_hook('radiation_interface:radiation',1,hook_handle)

  end subroutine radiation


  !---------------------------------------------------------------------
  ! If the input arrays are arranged in order of decreasing pressure /
  ! increasing height then this subroutine reverses them, calls the
  ! radiation scheme and then reverses the returned fluxes. Since this
  ! subroutine calls, and is called by "radiation", it must be in this
  ! module to avoid circular dependencies.
  subroutine radiation_reverse(ncol, nlev, istartcol, iendcol, config, &
       &  single_level, thermodynamics, gas, cloud, aerosol, flux)
 
    use parkind1, only : jprb

    use radiation_io,             only : nulout
    use radiation_config,         only : config_type
    use radiation_single_level,   only : single_level_type
    use radiation_thermodynamics, only : thermodynamics_type
    use radiation_gas,            only : gas_type
    use radiation_cloud,          only : cloud_type
    use radiation_aerosol,        only : aerosol_type
    use radiation_flux,           only : flux_type

    ! Inputs
    integer, intent(in) :: ncol               ! number of columns
    integer, intent(in) :: nlev               ! number of model levels
    integer, intent(in) :: istartcol, iendcol ! range of columns to process
    type(config_type),        intent(in) :: config
    type(single_level_type),  intent(in) :: single_level
    type(thermodynamics_type),intent(in) :: thermodynamics
    type(gas_type),           intent(in) :: gas
    type(cloud_type),         intent(in) :: cloud
    type(aerosol_type),       intent(in) :: aerosol
    ! Output
    type(flux_type),          intent(inout):: flux

    ! Reversed data structures
    type(thermodynamics_type) :: thermodynamics_rev
    type(gas_type)            :: gas_rev
    type(cloud_type)          :: cloud_rev
    type(aerosol_type)        :: aerosol_rev
    type(flux_type)           :: flux_rev

    ! Start and end levels for aerosol data
    integer :: istartlev, iendlev

    if (config%iverbose >= 2) then
      write(nulout,'(a)') 'Reversing arrays to be in order of increasing pressure'
    end if

    ! Allocate reversed arrays
    call thermodynamics_rev%allocate(ncol, nlev)
    call cloud_rev%allocate(ncol, nlev)
    call flux_rev%allocate(config, istartcol, iendcol, nlev)
    if (allocated(aerosol%mixing_ratio)) then
      istartlev = nlev + 1 - aerosol%iendlev
      iendlev   = nlev + 1 - aerosol%istartlev
      call aerosol_rev%allocate(ncol, istartlev, iendlev, &
           &                    config%n_aerosol_types)
    end if

    ! Fill reversed thermodynamic arrays
    thermodynamics_rev%pressure_hl(istartcol:iendcol,:) &
         &  = thermodynamics%pressure_hl(istartcol:iendcol, nlev+1:1:-1)
    thermodynamics_rev%temperature_hl(istartcol:iendcol,:) &
         &  = thermodynamics%temperature_hl(istartcol:iendcol, nlev+1:1:-1)

    ! Fill reversed gas arrays
    call gas%reverse(istartcol, iendcol, gas_rev)

    if (config%do_clouds) then
      ! Fill reversed cloud arrays
      cloud_rev%q_liq(istartcol:iendcol,:) &
           &  = cloud%q_liq(istartcol:iendcol,nlev:1:-1)
      cloud_rev%re_liq(istartcol:iendcol,:) &
           &  = cloud%re_liq(istartcol:iendcol,nlev:1:-1)
      cloud_rev%q_ice(istartcol:iendcol,:) &
           &  = cloud%q_ice(istartcol:iendcol,nlev:1:-1)
      cloud_rev%re_ice(istartcol:iendcol,:) &
           &  = cloud%re_ice(istartcol:iendcol,nlev:1:-1)
      cloud_rev%fraction(istartcol:iendcol,:) &
           &  = cloud%fraction(istartcol:iendcol,nlev:1:-1)
      cloud_rev%overlap_param(istartcol:iendcol,:) &
           &  = cloud%overlap_param(istartcol:iendcol,nlev-1:1:-1)
      if (allocated(cloud%fractional_std)) then
        cloud_rev%fractional_std(istartcol:iendcol,:) &
             &  = cloud%fractional_std(istartcol:iendcol,nlev:1:-1)
      else
        cloud_rev%fractional_std(istartcol:iendcol,:) = 0.0_jprb       
      end if
      if (allocated(cloud%inv_cloud_effective_size)) then
        cloud_rev%inv_cloud_effective_size(istartcol:iendcol,:) &
             &  = cloud%inv_cloud_effective_size(istartcol:iendcol,nlev:1:-1)
      else
        cloud_rev%inv_cloud_effective_size(istartcol:iendcol,:) = 0.0_jprb
      end if
    end if

    if (allocated(aerosol%mixing_ratio)) then
      aerosol_rev%mixing_ratio(:,istartlev:iendlev,:) &
           &  = aerosol%mixing_ratio(:,aerosol%iendlev:aerosol%istartlev:-1,:)
    end if

    ! Run radiation scheme on reversed profiles
    call radiation(ncol, nlev,istartcol,iendcol, &
         &  config, single_level, thermodynamics_rev, gas_rev, &
         &  cloud_rev, aerosol_rev, flux_rev)

    ! Reorder fluxes
    if (allocated(flux%lw_up)) then
      flux%lw_up(istartcol:iendcol,:) &
           &  = flux_rev%lw_up(istartcol:iendcol,nlev+1:1:-1)
      flux%lw_dn(istartcol:iendcol,:) &
           &  = flux_rev%lw_dn(istartcol:iendcol,nlev+1:1:-1)
      if (allocated(flux%lw_up_clear)) then
        flux%lw_up_clear(istartcol:iendcol,:) &
             &  = flux_rev%lw_up_clear(istartcol:iendcol,nlev+1:1:-1)
        flux%lw_dn_clear(istartcol:iendcol,:) &
             &  = flux_rev%lw_dn_clear(istartcol:iendcol,nlev+1:1:-1)
      end if
    end if
    if (allocated(flux%sw_up)) then
      flux%sw_up(istartcol:iendcol,:) &
           &  = flux_rev%sw_up(istartcol:iendcol,nlev+1:1:-1)
      flux%sw_dn(istartcol:iendcol,:) &
           &  = flux_rev%sw_dn(istartcol:iendcol,nlev+1:1:-1)
      if (allocated(flux%sw_dn_direct)) then
        flux%sw_dn_direct(istartcol:iendcol,:) &
             &  = flux_rev%sw_dn_direct(istartcol:iendcol,nlev+1:1:-1)
      end if
      if (allocated(flux%sw_up_clear)) then
        flux%sw_up_clear(istartcol:iendcol,:) &
             &  = flux_rev%sw_up_clear(istartcol:iendcol,nlev+1:1:-1)
        flux%sw_dn_clear(istartcol:iendcol,:) &
             &  = flux_rev%sw_dn_clear(istartcol:iendcol,nlev+1:1:-1)
        if (allocated(flux%sw_dn_direct_clear)) then
          flux%sw_dn_direct_clear(istartcol:iendcol,:) &
               &  = flux_rev%sw_dn_direct_clear(istartcol:iendcol,nlev+1:1:-1)
        end if
      end if
    end if

    ! Deallocate reversed arrays
    call thermodynamics_rev%deallocate
    call gas_rev%deallocate
    call cloud_rev%deallocate
    call flux_rev%deallocate
    if (allocated(aerosol%mixing_ratio)) then
      call aerosol_rev%deallocate
    end if

  end subroutine radiation_reverse

end module radiation_interface