!# This source file is part of code Pégase.3.0.1 (2019-02-21).
!# Copyright: Michel Fioc (Michel.Fioc@iap.fr), Sorbonne université, 
!# Institut d'astrophysique de Paris/CNRS, France.
!# 
!# Pégase.3.0.1 is governed by the CeCILL license under French law and abides 
!# by the rules of distribution of free software. You can use, modify and/or 
!# redistribute this software under the terms of the CeCILL license as circulated 
!# by CEA, CNRS and INRIA at "http://www.cecill.info". The text of this license
!# is also available in French and in English in directory "doc_dir/" of this
!# code.
!# 
!# As a counterpart to the access to the source code and to the rights to copy,
!# modify and redistribute it granted by the license, users are provided only
!# with a limited warranty, and the software's author, the holder of the
!# economic rights, and the successive licensors have only limited
!# liability. 
!# 
!# The fact that you are presently reading this means that you have had
!# knowledge of the CeCILL license and that you accept its terms.
!#====================================================================== 

module mod_extinction

  private
  public :: compute_opacity_DISM, compute_opacity_SFC, &
       compute_RF_DISM, compute_RF_SFC, &
       dust_optical_properties, attenuate_DISM

contains

!#======================================================================

  subroutine compute_opacity_DISM(ISM_mass, dim_cont, lambda_cont, &
       dim_line, lambda_line, i_Lyman_alpha, M_dust, carb_abund, sil_abund, &
       dim_species, grain_abs, &
       species_weight, tau_V, King, slab, disk, bulge, &
       cont_trans_DISM_tot, cont_trans_DISM_incl, &
       line_trans_DISM_tot, line_trans_DISM_incl, &
       opt_depth_warn_present, opt_depth_warn_min_lambda, opt_depth_warn_max_lambda, &
       kappa_abs_cont, kappa_abs_line, ISM_over_H)

    use mod_types
    use mod_interp, only : Steffen3, Steffen4
    use mod_constants, only : M_sol, H_atom_mass, &
         pi, parsec
    use mod_spectra_constants, only : King_factor, lambda_V
    use mod_RT, only : struct_RT_sph_sym, struct_RT_cyl_sym
    use mod_read_dust_transfer_param, only : bulge_tot_ratio, M_sys_spiral, &
         expo_radius, M_sys_spher, core_radius, extinction_DISM, geometry, &
         inclin_averaged, inclination, slab_factor
    use mod_grain_properties, only : struct_grain_abs

    implicit none
    real(CDR), intent(in) :: ISM_mass
    integer, intent(in) :: dim_cont, dim_line
    real(CDR), dimension(:), intent(in) :: lambda_cont
    real(CDR), dimension(:), intent(in) :: lambda_line
    real(CDR), intent(out) :: M_dust
    integer, intent(in) :: dim_species
    type(struct_grain_abs), dimension(:), intent(in) :: grain_abs
    real(CDR), intent(in) :: carb_abund, sil_abund
    real(CDR), dimension(:), intent(in) :: species_weight
    real(CDR), intent(out) :: tau_V
    real(CDR), intent(in) :: ISM_over_H
    integer, intent(in) :: i_Lyman_alpha

    type(struct_RT_sph_sym), intent(in) :: King
    type(struct_RT_cyl_sym), intent(in) :: slab, disk, bulge

    real(CDR), dimension(:), intent(out) :: cont_trans_DISM_tot, cont_trans_DISM_incl
    real(CDR), dimension(:), intent(out) :: line_trans_DISM_tot, line_trans_DISM_incl
    logical, intent(inout) :: opt_depth_warn_present
    real(CDR), intent(inout) :: opt_depth_warn_min_lambda, opt_depth_warn_max_lambda
    real(CDR), dimension(:), intent(out) :: kappa_abs_cont, kappa_abs_line
!#......................................................................
    real(CDR) :: H_col_dens, dust_col_dens, albedo, asym, tau
    integer :: i_cont, i_line, i_bracket1, i_bracket2, i_bracket3, i_bracket4
    real(CDR) :: kappa_ext, ln_trans
!#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

!# Extinction.

    tau_V = 0
    M_dust = 0
    cont_trans_DISM_tot(:) = 1
    cont_trans_DISM_incl(:) = 1
    line_trans_DISM_tot(:) = 1
    line_trans_DISM_incl(:) = 1
    kappa_abs_cont(:) = 0
    kappa_abs_line(:) = 0
    opt_depth_warn_min_lambda = lambda_cont(dim_cont)
    opt_depth_warn_max_lambda = lambda_cont(1)
    if (extinction_DISM) then
       if ((carb_abund > 0 .or. sil_abund > 0) .and. ISM_mass > 0) then !# `M_dust` > 0.

!# Mass fraction of dust components and dust mass in grams.
!# !!! The mass of dust in star-forming clouds is not subtracted.
          M_dust = (carb_abund+sil_abund)*ISM_mass*M_sol

!# Dust column density in g.cm^-2.

          if (geometry == "spheroidal") then
             dust_col_dens = King_factor* &
                  real(M_dust, DPR) & !# To avoid overflows.
                  *M_sys_spher/(core_radius*parsec)**2
          else if (geometry == "spiral") then
             dust_col_dens = real(M_dust, DPR) & !# To avoid overflows.
                  *M_sys_spiral/(2*pi*(expo_radius*parsec)**2)
          else if (geometry == "slab") then
             H_col_dens = slab_factor*ISM_mass
             dust_col_dens = (carb_abund+sil_abund)*H_col_dens &
                  *H_atom_mass*ISM_over_H
          else
             write(*, "(a)") "`geometry` """ // trim(geometry) // &
                  """ is undefined. Stopped."
             stop
          endif

          call dust_optical_properties(dim_species, grain_abs, &
               lambda_V, species_weight, kappa_ext, albedo, asym)
          tau_V = kappa_ext*dust_col_dens

          i_bracket1 = 0
          i_bracket2 = 0
          i_bracket3 = 0
          i_bracket4 = 0

!# Continuum, total.

          do i_cont = 1, dim_cont
             call dust_optical_properties(dim_species, grain_abs, &
                  lambda_cont(i_cont), species_weight, kappa_ext, albedo, asym)

             tau = kappa_ext*dust_col_dens
             kappa_abs_cont(i_cont) = kappa_ext*(1-albedo)

             if (geometry == "spheroidal") then
                if (tau > King % tau(King % dim_tau)) then
                   opt_depth_warn_min_lambda = min(opt_depth_warn_min_lambda, &
                        lambda_cont(i_cont))
                   opt_depth_warn_max_lambda = max(opt_depth_warn_max_lambda, &
                        lambda_cont(i_cont))
                   opt_depth_warn_present = .true.
                endif
                call Steffen3(King % tau, King % alb, King % asym, King % ln_trans_tot, &
                     King % dim_tau, King % dim_alb, King % dim_asym, tau, albedo, asym, &
                     ln_trans, i_bracket1, i_bracket2, i_bracket3)
                cont_trans_DISM_tot(i_cont) = exp(ln_trans)

             else if (geometry == "spiral") then
                if (tau > disk % tau(disk % dim_tau) .or. &
                     tau > bulge % tau(bulge % dim_tau)) then
                   opt_depth_warn_min_lambda = min(opt_depth_warn_min_lambda, &
                        lambda_cont(i_cont))
                   opt_depth_warn_max_lambda = max(opt_depth_warn_max_lambda, &
                        lambda_cont(i_cont))
                   opt_depth_warn_present = .true.
                   write(*,*) "spiral", tau, disk % tau(disk % dim_tau), &
                        bulge % tau(bulge % dim_tau), kappa_ext, &
                        dust_col_dens, M_dust, carb_abund, sil_abund, &
                        ISM_mass, M_sys_spiral, expo_radius, parsec, &
                        M_dust*M_sys_spiral
                   stop
                endif
                call Steffen3(disk % tau, disk % alb, disk % asym, disk % ln_trans_tot, &
                     disk % dim_tau, disk % dim_alb, disk % dim_asym, tau, albedo, asym, &
                     ln_trans, i_bracket1, i_bracket2, i_bracket3)
                cont_trans_DISM_tot(i_cont) = &
                     exp(ln_trans)*(1-bulge_tot_ratio)

                call Steffen3(bulge % tau, bulge % alb, bulge % asym, bulge % ln_trans_tot, &
                     bulge % dim_tau, bulge % dim_alb, bulge % dim_asym, tau, albedo, &
                     asym, ln_trans, i_bracket1, i_bracket2, i_bracket3)
                cont_trans_DISM_tot(i_cont) = &
                     cont_trans_DISM_tot(i_cont) + &
                     exp(ln_trans)*bulge_tot_ratio

             else if (geometry == "slab") then
                if (tau > slab % tau(slab % dim_tau)) then
                   opt_depth_warn_min_lambda = min(opt_depth_warn_min_lambda, &
                        lambda_cont(i_cont))
                   opt_depth_warn_max_lambda = max(opt_depth_warn_max_lambda, &
                        lambda_cont(i_cont))
                   opt_depth_warn_present = .true.
                endif
                call Steffen3(slab % tau, slab % alb, slab % asym, slab % ln_trans_tot, &
                     slab % dim_tau, slab % dim_alb, slab % dim_asym, tau, albedo, asym, &
                     ln_trans, i_bracket1, i_bracket2, i_bracket3)
                cont_trans_DISM_tot(i_cont) = exp(ln_trans)
             endif

!# Continuum, inclined.

             if (.not.inclin_averaged) then
                if (geometry == "spiral") then
                   if (tau > disk % tau(disk % dim_tau) .or. &
                        tau > bulge % tau(bulge % dim_tau)) then
                      opt_depth_warn_min_lambda = min(opt_depth_warn_min_lambda, &
                           lambda_cont(i_cont))
                      opt_depth_warn_max_lambda = max(opt_depth_warn_max_lambda, &
                           lambda_cont(i_cont))
                      opt_depth_warn_present = .true.
                   endif

!# Variable `null_deriv_at_0` is set to `.true.`
!# for the inner call of `Steffen` by subroutine `Steffen4`:
!# there, `x` is the inclination of the galaxy (`x = 0` means
!# face-on) and `y` is the fraction of light emerging in this
!# direction.
                   call Steffen4(disk % tau, disk % alb, disk % asym, disk % inclin, &
                        disk % ln_trans_incl, disk % dim_tau, disk % dim_alb, &
                        disk % dim_asym, &
                        disk % dim_inclin, tau, albedo, asym, inclination, &
                        ln_trans, i_bracket1, i_bracket2, i_bracket3, i_bracket4, null_deriv_at_0=.true.)
                   cont_trans_DISM_incl(i_cont) = &
                        exp(ln_trans)*(1-bulge_tot_ratio)

                   call Steffen4(bulge % tau, bulge % alb, bulge % asym, &
                        bulge % inclin, bulge % ln_trans_incl, bulge % dim_tau, &
                        bulge % dim_alb, bulge % dim_asym, &
                        bulge % dim_inclin, tau, albedo, asym, inclination, &
                        ln_trans, i_bracket1, i_bracket2, i_bracket3, i_bracket4, null_deriv_at_0=.true.)
                   cont_trans_DISM_incl(i_cont) = &
                        cont_trans_DISM_incl(i_cont) + &
                        exp(ln_trans)*bulge_tot_ratio

                else if (geometry == "slab") then
                   if (tau > slab % tau(slab % dim_tau)) then
                      opt_depth_warn_min_lambda = min(opt_depth_warn_min_lambda, &
                           lambda_cont(i_cont))
                      opt_depth_warn_max_lambda = max(opt_depth_warn_max_lambda, &
                           lambda_cont(i_cont))
                      opt_depth_warn_present = .true.
                   endif

!# Variable `null_deriv_at_0` is set to `.true.`
!# for the inner call of `Steffen` by subroutine `Steffen4`:
!# there, `x` is the inclination of the galaxy (`x = 0` means
!# face-on) and `y` is the fraction of light emerging in this
!# direction.
                   call Steffen4(slab % tau, slab % alb, slab % asym, slab % inclin, &
                        slab % ln_trans_incl, slab % dim_tau, slab % dim_alb, &
                        slab % dim_asym, slab % dim_inclin, tau, albedo, asym, &
                        inclination, ln_trans, i_bracket1, i_bracket2, i_bracket3, i_bracket4, null_deriv_at_0=.true.)
                   cont_trans_DISM_incl(i_cont) = exp(ln_trans)
                endif
             else
                cont_trans_DISM_incl(i_cont) = cont_trans_DISM_tot(i_cont)
             endif
          enddo

!# Lines, total.

          do i_line = 1, dim_line
             i_bracket1 = 0
             i_bracket2 = 0
             i_bracket3 = 0
             i_bracket4 = 0
             call dust_optical_properties(dim_species, grain_abs, lambda_line(i_line), species_weight, kappa_ext, albedo, asym)

             tau = kappa_ext*dust_col_dens
             kappa_abs_line(i_line) = kappa_ext*(1-albedo)
             if (geometry == "spheroidal") then
                if (tau > King % tau(King % dim_tau)) then
                   opt_depth_warn_min_lambda = min(opt_depth_warn_min_lambda, &
                        lambda_line(i_line))
                   opt_depth_warn_max_lambda = max(opt_depth_warn_max_lambda, &
                        lambda_line(i_line))
                   opt_depth_warn_present = .true.
                endif
                call Steffen3(King % tau, King % alb, King % asym, King % ln_trans_tot, &
                     King % dim_tau, King % dim_alb, King % dim_asym, tau, albedo, asym, &
                     ln_trans, i_bracket1, i_bracket2, i_bracket3)
                line_trans_DISM_tot(i_line) = exp(ln_trans)

             else if (geometry == "spiral") then
                if (tau > disk % tau(disk % dim_tau) .or. &
                     tau > bulge % tau(bulge % dim_tau)) then
                   opt_depth_warn_min_lambda = min(opt_depth_warn_min_lambda, &
                        lambda_line(i_line))
                   opt_depth_warn_max_lambda = max(opt_depth_warn_max_lambda, &
                        lambda_line(i_line))
                   opt_depth_warn_present = .true.
                endif

                call Steffen3(disk % tau, disk % alb, disk % asym, disk % ln_trans_tot, &
                     disk % dim_tau, disk % dim_alb, disk % dim_asym, tau, albedo, asym, &
                     ln_trans, i_bracket1, i_bracket2, i_bracket3)
                line_trans_DISM_tot(i_line) = &
                     exp(ln_trans)*(1-bulge_tot_ratio)

                call Steffen3(bulge % tau, bulge % alb, bulge % asym, bulge % ln_trans_tot, &
                     bulge % dim_tau, bulge % dim_alb, bulge % dim_asym, tau, albedo, &
                     asym, ln_trans, i_bracket1, i_bracket2, i_bracket3)
                line_trans_DISM_tot(i_line) = &
                     line_trans_DISM_tot(i_line) + &
                     exp(ln_trans)*bulge_tot_ratio

             else if (geometry == "slab") then
                if (tau > slab % tau(slab % dim_tau)) then
                   opt_depth_warn_min_lambda = min(opt_depth_warn_min_lambda, &
                        lambda_line(i_line))
                   opt_depth_warn_max_lambda = max(opt_depth_warn_max_lambda, &
                        lambda_line(i_line))
                   opt_depth_warn_present = .true.
                endif
                call Steffen3(slab % tau, slab % alb, slab % asym, slab % ln_trans_tot, &
                     slab % dim_tau, slab % dim_alb, slab % dim_asym, tau, albedo, asym, &
                     ln_trans, i_bracket1, i_bracket2, i_bracket3)
                line_trans_DISM_tot(i_line) = exp(ln_trans)
             endif

!# Lines, inclined.

             if (.not.inclin_averaged) then
                if (geometry == "spiral") then
                   if (tau > disk % tau(disk % dim_tau) .or. &
                        tau > bulge % tau(bulge % dim_tau)) then
                      opt_depth_warn_min_lambda = min(opt_depth_warn_min_lambda, &
                           lambda_line(i_line))
                      opt_depth_warn_max_lambda = max(opt_depth_warn_max_lambda, &
                           lambda_line(i_line))
                      opt_depth_warn_present = .true.
                   endif

!# Variable `null_deriv_at_0` is set to `.true.`
!# for the inner call of `Steffen` by subroutine `Steffen4`:
!# there, `x` is the inclination of the galaxy (`x = 0` means
!# face-on) and `y` is the fraction of light emerging in this
!# direction.
                   call Steffen4(disk % tau, disk % alb, disk % asym, disk % inclin, &
                        disk % ln_trans_incl, disk % dim_tau, disk % dim_alb, &
                        disk % dim_asym, disk % dim_inclin, tau, albedo, asym, &
                        inclination, ln_trans, i_bracket1, i_bracket2, i_bracket3, i_bracket4, null_deriv_at_0=.true.)
                   line_trans_DISM_incl(i_line) = &
                        exp(ln_trans)*(1-bulge_tot_ratio)

                   call Steffen4(bulge % tau, bulge % alb, bulge % asym, &
                        bulge % inclin, bulge % ln_trans_incl, bulge % dim_tau, &
                        bulge % dim_alb, bulge % dim_asym, &
                        bulge % dim_inclin, tau, albedo, asym, inclination, &
                        ln_trans, i_bracket1, i_bracket2, i_bracket3, i_bracket4, null_deriv_at_0=.true.)
                   line_trans_DISM_incl(i_line) = &
                        line_trans_DISM_incl(i_line) + &
                        exp(ln_trans)*bulge_tot_ratio

                else if (geometry == "slab") then
                   if (tau > slab % tau(slab % dim_tau)) then
                      opt_depth_warn_min_lambda = min(opt_depth_warn_min_lambda, &
                           lambda_line(i_line))
                      opt_depth_warn_max_lambda = max(opt_depth_warn_max_lambda, &
                           lambda_line(i_line))
                      opt_depth_warn_present = .true.
                   endif

!# Variable `null_deriv_at_0` is set to `.true.`
!# for the inner call of `Steffen` by subroutine `Steffen4`:
!# there, `x` is the inclination of the galaxy (`x = 0` means
!# face-on) and `y` is the fraction of light emerging in this
!# direction.
                   call Steffen4(slab % tau, slab % alb, slab % asym, slab % inclin, &
                        slab % ln_trans_incl, slab % dim_tau, slab % dim_alb, &
                        slab % dim_asym, slab % dim_inclin, tau, albedo, asym, &
                        inclination, ln_trans, i_bracket1, i_bracket2, i_bracket3, i_bracket4, null_deriv_at_0=.true.)
                   line_trans_DISM_incl(i_line) = exp(ln_trans)
                endif
             else
                line_trans_DISM_incl(i_line) = line_trans_DISM_tot(i_line)
             endif
          enddo

!# For Lyman alpha with `extinction_DISM = .true.` and `M_dust > 0`:
          line_trans_DISM_tot(i_Lyman_alpha) = 0
          line_trans_DISM_incl(i_Lyman_alpha) = 0

       endif
    endif

  end subroutine compute_opacity_DISM

!#======================================================================

  subroutine compute_opacity_SFC(dim_cont, lambda_cont, dim_line, lambda_line, &
       M_dust_SFC, carb_abund, sil_abund, dim_species, grain_abs, &
       species_weight, kappa_abs_cont, kappa_abs_line, lum_cont, lum_cont_unatt, &
       L_line, L_line_unatt, cont_trans_SFC, line_trans_SFC)

    use mod_types
    use mod_read_dust_transfer_param, only : extinction_SFC
    use mod_grain_properties, only : struct_grain_abs

    implicit none
    integer, intent(in) :: dim_cont, dim_line
    real(CDR), dimension(:), intent(in) :: lambda_cont
    real(CDR), dimension(:), intent(in) :: lambda_line
    real(CDR), intent(in) :: M_dust_SFC
    integer, intent(in) :: dim_species
    type(struct_grain_abs), dimension(:), intent(in) :: grain_abs
    real(CDR), intent(in) :: carb_abund, sil_abund
    real(CDR), dimension(:), intent(in) :: species_weight
    real(CDR), dimension(:), intent(out) :: kappa_abs_cont, kappa_abs_line
    real(CDR), dimension(:), intent(in) :: lum_cont, lum_cont_unatt, &
         L_line, L_line_unatt
    real(CDR), dimension(:), intent(out) :: cont_trans_SFC, line_trans_SFC
!#......................................................................
    real(CDR) :: albedo, asym
    integer :: i_cont, i_line
    real(CDR) :: kappa_ext
!#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

!# Extinction.

    cont_trans_SFC(:) = 1 !# `cont_trans_SFC` is used only to assess the effects of self-absorption.
    line_trans_SFC(:) = 1 !# `line_trans_SFC` is not used elsewhere.
    kappa_abs_cont(:) = 0
    kappa_abs_line(:) = 0

    if (extinction_SFC) then
       if (carb_abund > 0 .or. sil_abund > 0) then
!# !!! Does not depend on the mass of the diffuse ISM, `ISM_mass`. It is assumed
!# that even if the diffuse ISM has been entirely removed by star formation or
!# outflow, there is always enough residual ISM in the star-forming region so
!# that the HII region is ionization bounded.

          if (M_dust_SFC > 0) then
             do i_cont = 1, dim_cont
                call dust_optical_properties(dim_species, grain_abs, &
                     lambda_cont(i_cont), species_weight, kappa_ext, albedo, asym)

                kappa_abs_cont(i_cont) = kappa_ext*(1-albedo)

                if (lum_cont_unatt(i_cont) > 0) then
                   cont_trans_SFC(i_cont) = &
                        lum_cont(i_cont) / lum_cont_unatt(i_cont)
                else if (lum_cont_unatt(i_cont) == 0) then
                   cont_trans_SFC(i_cont) = 0
                endif
             enddo

             do i_line = 1, dim_line
                call dust_optical_properties(dim_species, grain_abs, &
                     lambda_line(i_line), species_weight, kappa_ext, albedo, asym)

                kappa_abs_line(i_line) = kappa_ext*(1-albedo)

                if (L_line_unatt(i_line) > 0) line_trans_SFC(i_line) = &
                     L_line(i_line) / L_line_unatt(i_line)
             enddo
          endif
       endif
    endif

  end subroutine compute_opacity_SFC

!#======================================================================

  subroutine compute_RF_SFC(dim_cont, dim_line, dim_species, &
       grain_abs, kappa_abs_cont, kappa_abs_line, &
       lambda_cont, lambda_line, M_dust_SFC, lum_cont, lum_cont_unatt, &
       L_line, L_line_unatt, &
       L_dust_SFC, RF_SFC, RF_cont_SFC, RF_line_SFC, &
       T_CBR)

    use mod_types
    use mod_constants, only : c_cm
    use mod_black_body, only : pi_B_lambda
    use mod_grain_properties, only : struct_grain_abs

    implicit none
    integer, intent(in) :: dim_cont, dim_line, dim_species
    real(CDR), dimension(:), intent(in) :: kappa_abs_cont, kappa_abs_line, &
         lambda_cont, lambda_line
    type(struct_grain_abs), dimension(:), intent(in) :: grain_abs
    real(CDR), intent(in) :: M_dust_SFC
    real(CDR), dimension(:), intent(in) :: lum_cont, L_line, &
         lum_cont_unatt, L_line_unatt
    real(CDR), intent(out) :: L_dust_SFC
    type(irreg_array_CDR), dimension(:), pointer :: RF_SFC
    real(CDR), dimension(:), intent(out) :: RF_cont_SFC
    real(CDR), dimension(:), intent(out) :: RF_line_SFC
    real(CDR), intent(in), optional :: T_CBR
!#......................................................................
    integer :: i_cont, i_line, i_species, dim_lambda_grains
!#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

    L_dust_SFC = 0
    do i_cont = 1, dim_cont
       if (kappa_abs_cont(i_cont) > 0 .and. M_dust_SFC > 0) then
          RF_cont_SFC(i_cont) = max(lum_cont_unatt(i_cont)-lum_cont(i_cont), 0._CDR)/ & !# ???
               kappa_abs_cont(i_cont)/M_dust_SFC/c_cm
       else
          RF_cont_SFC(i_cont) = 0
       endif

       if (i_cont < dim_cont) L_dust_SFC = L_dust_SFC &
            + ((lum_cont_unatt(i_cont)+lum_cont_unatt(i_cont+1))- &
            (lum_cont(i_cont)+lum_cont(i_cont+1))) * (lambda_cont(i_cont+1)-lambda_cont(i_cont))/2
    enddo

    do i_line = 1, dim_line
       if (kappa_abs_line(i_line) > 0 .and. M_dust_SFC > 0) then
          RF_line_SFC(i_line) = (L_line_unatt(i_line)-L_line(i_line))/ &
               kappa_abs_line(i_line)/M_dust_SFC/c_cm
       else
          RF_line_SFC(i_line) = 0
       endif
       L_dust_SFC = L_dust_SFC+L_line_unatt(i_line)-L_line(i_line)
    enddo

    if (present(T_CBR)) then
       RF_cont_SFC(1:dim_cont) = RF_cont_SFC(1:dim_cont) &
            + 4*pi_B_lambda(T_CBR, lambda_cont(1:dim_cont))/c_cm !# erg.um-1.cm-3
    endif

    if (associated(RF_SFC)) then
       do i_species = 1, size(RF_SFC)
          if (associated(RF_SFC(i_species) % val)) deallocate(RF_SFC(i_species) % val)
       enddo
       deallocate(RF_SFC)
    endif
    allocate(RF_SFC(dim_species))

    do i_species = 1, dim_species
       dim_lambda_grains = grain_abs(i_species) % dim_lambda
       if (associated(RF_SFC(i_species) % val)) deallocate(RF_SFC(i_species) % val)
       allocate(RF_SFC(i_species) % val(dim_lambda_grains))
       call rebin_RF(dim_cont, dim_line, lambda_cont, lambda_line, RF_cont_SFC, &
            RF_line_SFC, dim_lambda_grains, grain_abs(i_species) % lambda_interm(:), &
            RF_SFC(i_species) % val(:))
    enddo

  end subroutine compute_RF_SFC

!#======================================================================
!# ??? `M_dust_SFC` should not be used here. Use instead
!# `cont_trans_DISM_tot` and `line_trans_DISM_tot` for all continuum
!# wavelengths and emission lines.

  subroutine compute_RF_DISM(dim_cont, dim_line, dim_species, &
       grain_abs, kappa_abs_cont, kappa_abs_line, &
       lambda_cont, lambda_line, L_dust_SFC, M_dust, &
       lum_cont, L_line, cont_trans_DISM_tot, &
       line_trans_DISM_tot, L_dust_DISM, L_dust, RF_DISM, RF_cont_DISM, RF_line_DISM, &
       T_CBR)

    use mod_types
    use mod_constants, only : c_cm
    use mod_black_body, only : pi_B_lambda
    use mod_grain_properties, only : struct_grain_abs

    implicit none
    integer, intent(in) :: dim_cont, dim_line, dim_species
    real(CDR), dimension(:), intent(in) :: kappa_abs_cont, kappa_abs_line, &
         lambda_cont, lambda_line
    type(struct_grain_abs), dimension(:), intent(in) :: grain_abs
    real(CDR), intent(in) :: L_dust_SFC, M_dust
    real(CDR), dimension(:), intent(inout) :: lum_cont, L_line, &
         cont_trans_DISM_tot, line_trans_DISM_tot
    real(CDR), intent(out) :: L_dust_DISM, L_dust
    type(irreg_array_CDR), dimension(:), pointer :: RF_DISM
    real(CDR), dimension(:), intent(out) :: RF_cont_DISM
    real(CDR), dimension(:), intent(out) :: RF_line_DISM
    real(CDR), intent(in), optional :: T_CBR !# Temperature of the cosmic background \
!#                                              radiation field.
!#......................................................................
    integer :: i_cont, i_line, i_species, dim_lambda_grains
!#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

    do i_cont = 1, dim_cont
       if (kappa_abs_cont(i_cont) > 0) then
          RF_cont_DISM(i_cont) = lum_cont(i_cont)*(1-cont_trans_DISM_tot(i_cont))/ &
               kappa_abs_cont(i_cont)/M_dust/c_cm
       else
          RF_cont_DISM(i_cont) = 0
       endif
    enddo

    do i_line = 1, dim_line
       if (kappa_abs_line(i_line) > 0) then
          RF_line_DISM(i_line) = L_line(i_line)*(1-line_trans_DISM_tot(i_line))/ &
               kappa_abs_line(i_line)/M_dust/c_cm
       else
          RF_line_DISM(i_line) = 0
       endif
    enddo

    if (present(T_CBR)) then
       RF_cont_DISM(1:dim_cont) = RF_cont_DISM(1:dim_cont) &
            + 4*pi_B_lambda(T_CBR, lambda_cont(1:dim_cont))/c_cm !# erg.um-1.cm-3
    endif

    if (associated(RF_DISM)) then
       do i_species = 1, size(RF_DISM)
          if (associated(RF_DISM(i_species) % val)) deallocate(RF_DISM(i_species) % val)
       enddo
       deallocate(RF_DISM)
    endif
    allocate(RF_DISM(dim_species))
    do i_species = 1, dim_species
       dim_lambda_grains = grain_abs(i_species) % dim_lambda
       if (associated(RF_DISM(i_species) % val)) deallocate(RF_DISM(i_species) % val)
       allocate(RF_DISM(i_species) % val(dim_lambda_grains))
       call rebin_RF(dim_cont, dim_line, lambda_cont, lambda_line, RF_cont_DISM, &
            RF_line_DISM, dim_lambda_grains, grain_abs(i_species) % lambda_interm(:), &
            RF_DISM(i_species) % val(:))
    enddo

    L_dust_DISM = 0
    do i_cont = 1, dim_cont-1
       L_dust_DISM = L_dust_DISM &
            + (lum_cont(i_cont)*(1-cont_trans_DISM_tot(i_cont)) &
            + lum_cont(i_cont+1)*(1-cont_trans_DISM_tot(i_cont+1))) &
            * (lambda_cont(i_cont+1)-lambda_cont(i_cont))/2
    enddo
    do i_line = 1, dim_line
       L_dust_DISM = L_dust_DISM &
            +L_line(i_line)*(1-line_trans_DISM_tot(i_line))
    enddo

    L_dust = L_dust_DISM + L_dust_SFC

  end subroutine compute_RF_DISM

!#======================================================================

  subroutine dust_optical_properties(dim_species, grain_abs, lambda_cont, species_weight, kappa_ext, albedo, asym)

    use mod_types
    use mod_interp, only : bracket
    use mod_grain_properties, only : struct_grain_abs

    implicit none
    real(CDR), dimension(:), intent(in) :: species_weight
    integer, intent(in) :: dim_species
    type(struct_grain_abs), dimension(:), intent(in) :: grain_abs
    real(CDR), intent(in) :: lambda_cont
    real(CDR), intent(out) :: kappa_ext, albedo, asym
!#......................................................................
    integer :: i_species
    integer :: i_lambda
    real(CDR), dimension(dim_species) :: alpha
    real(CDR), dimension(dim_species) :: interp_kappa_ext_species, interp_albedo_species, interp_asym_species
!#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

    do i_species = 1, dim_species
       i_lambda = 0
       call bracket(grain_abs(i_species) % dim_lambda, grain_abs(i_species) % lambda(1:grain_abs(i_species) % dim_lambda), &
            lambda_cont, i_lambda)
       alpha(i_species) = (1/lambda_cont-1/grain_abs(i_species) % lambda(i_lambda)) / &
            (1/grain_abs(i_species) % lambda(i_lambda+1)-1/grain_abs(i_species) % lambda(i_lambda))
       interp_kappa_ext_species(i_species) = grain_abs(i_species) % kappa_ext(i_lambda) &
            + alpha(i_species)*(grain_abs(i_species) % kappa_ext(i_lambda+1) - grain_abs(i_species) % kappa_ext(i_lambda))
       interp_albedo_species(i_species) = grain_abs(i_species) % albedo(i_lambda) &
            + alpha(i_species)* (grain_abs(i_species) % albedo(i_lambda+1) - grain_abs(i_species) % albedo(i_lambda))
       interp_asym_species(i_species) = grain_abs(i_species) % asym(i_lambda) &
            + alpha(i_species)*(grain_abs(i_species) % asym(i_lambda+1) - grain_abs(i_species) % asym(i_lambda))
    enddo
    kappa_ext = sum(species_weight(1:dim_species)*interp_kappa_ext_species(1:dim_species))

    if (kappa_ext > 0) then
       albedo = sum(species_weight(1:dim_species)*interp_kappa_ext_species(1:dim_species)*interp_albedo_species(1:dim_species))
       albedo = albedo/kappa_ext
       if (albedo > 1) albedo = 1
       if (albedo > 0) then
          asym = sum(species_weight(1:dim_species)*interp_kappa_ext_species(1:dim_species) &
               *interp_albedo_species(1:dim_species)*interp_asym_species(1:dim_species))
          asym = asym/kappa_ext/albedo
          if (asym > 1) asym = 1
          if (asym < -1) asym = -1
       else
          albedo = 0
          asym = 0
       endif
    else
       kappa_ext = 0
       albedo = 0
       asym = 0
    endif

  end subroutine dust_optical_properties

!#======================================================================

  subroutine rebin_RF(dim_cont, dim_line, lambda_cont, lambda_line, &
       RF_cont, RF_line, dim_lambda_grains, lambda_grains_interm, &
       RF)

    use mod_types

    implicit none
    integer, intent(in) :: dim_cont, dim_line, dim_lambda_grains
    real(CDR), dimension(:), intent(in) :: lambda_cont, lambda_line, &
         RF_cont, RF_line
    real(DPR), dimension(:), intent(in) :: lambda_grains_interm
    real(CDR), dimension(:), intent(out) :: RF
!#......................................................................
    integer :: i
!#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

    do i = 1, dim_lambda_grains
       call average_RF(real(lambda_grains_interm(i), CDR), &
            real(lambda_grains_interm(i+1), CDR), dim_cont, &
            dim_line, lambda_cont, lambda_line, RF_cont, RF_line, RF(i))
    enddo

  end subroutine rebin_RF

!#======================================================================

  subroutine average_RF(lambda_grains_inf, lambda_grains_sup, dim_cont, &
       dim_line, lambda_cont, lambda_line, RF_cont, RF_line, RF)

    use mod_types
    use mod_interp, only : bracket, interp_log_log

    implicit none
    real(CDR), intent(in) :: lambda_grains_inf, lambda_grains_sup
    integer, intent(in) :: dim_cont, dim_line
    real(CDR), dimension(:), intent(in) :: lambda_cont, lambda_line, &
         RF_cont, RF_line
    real(CDR), intent(out) :: RF
!#......................................................................
    integer :: i_inf, i_sup, i
    real(CDR) :: RF_inf, RF_sup
!#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

    RF = 0
    i_inf = 0 ; i_sup = 0
    call bracket(dim_cont, lambda_cont, lambda_grains_inf, i_inf)
    call bracket(dim_cont, lambda_cont, lambda_grains_sup, i_sup)
    RF_inf = interp_log_log(lambda_cont(i_inf), lambda_cont(i_inf+1), &
         RF_cont(i_inf), RF_cont(i_inf+1), lambda_grains_inf)
    RF_sup = interp_log_log(lambda_cont(i_sup), lambda_cont(i_sup+1), &
         RF_cont(i_sup), RF_cont(i_sup+1), lambda_grains_sup)

    if (lambda_grains_inf <= lambda_cont(1)) then
       if (lambda_grains_sup <= lambda_cont(1)) then
!# lambda_grains_inf < lambda_grains_sup < lambda_cont(1)
          RF = (RF_inf+RF_sup)*(lambda_grains_sup-lambda_grains_inf)/2
       else
          if (lambda_grains_sup >= lambda_cont(dim_cont)) then
!# lambda_grains_inf < lambda_cont(1) < lambda_cont(n) < lambda_grains_sup
             RF = (RF_inf+RF_cont(1)) * &
                  (lambda_cont(1)-lambda_grains_inf)/2
             do i = 1, dim_cont-1
                RF = RF+(RF_cont(i)+RF_cont(i+1))*(lambda_cont(i+1) &
                     -lambda_cont(i))/2
             enddo
             RF = RF+(RF_cont(dim_cont)+RF_sup)* &
                  (lambda_grains_sup-lambda_cont(dim_cont))/2
          else
!# lambda_grains_inf < lambda_cont(1) < lambda_grains_sup < lambda_cont(n)
             RF = (RF_inf+RF_cont(1))* &
                  (lambda_cont(1)-lambda_grains_inf)/2
             do i = 1, i_sup-1
                RF = RF+(RF_cont(i)+RF_cont(i+1))*(lambda_cont(i+1) &
                     -lambda_cont(i))/2
             enddo
             RF = RF+(RF_cont(i_sup)+RF_sup)* &
                  (lambda_grains_sup-lambda_cont(i_sup))/2
          endif
       endif
    else
!# lambda_cont(1) < lambda_grains_inf
       if (lambda_grains_inf >= lambda_cont(dim_cont)) then
!# lambda_cont(n) < lambda_grains_inf < lambda_grains_sup
          RF = (RF_inf+RF_sup)*(lambda_grains_sup-lambda_grains_inf)/2
       else
!# lambda_cont(1) < lambda_grains_inf < lambda_cont(n)
          if (lambda_grains_sup >= lambda_cont(dim_cont)) then
!# lambda_cont(1) < lambda_grains_inf < lambda_cont(n) < lambda_grains_sup
             RF = (RF_inf+RF_cont(i_inf+1))* &
                  (lambda_cont(i_inf+1)-lambda_grains_inf)/2
             do i = i_inf+1, dim_cont-1
                RF = RF+(RF_cont(i)+RF_cont(i+1))*(lambda_cont(i+1) &
                     -lambda_cont(i))/2
             enddo
             RF = RF+(RF_cont(dim_cont)+RF_sup)* &
                  (lambda_grains_sup-lambda_cont(dim_cont))/2
          else
!# lambda_cont(1) < lambda_grains_inf < lambda_grains_sup < lambda_cont(n)
             if (i_sup == i_inf) then
!# lambda_cont(i_inf) < lambda_grains_inf < lambda_grains_sup
!# < lambda_cont(i_inf+1)
                RF = (RF_inf+RF_sup)* &
                     (lambda_grains_sup-lambda_grains_inf)/2
             else
!# lambda_cont(i_inf) < lambda_grains_inf < lambda_cont(i_inf+1)
!# < lambda_cont(i_sup) < lambda_grains_sup < lambda_cont(i_sup+1)
                RF = (RF_inf+RF_cont(i_inf+1))* &
                     (lambda_cont(i_inf+1)-lambda_grains_inf)/2

                do i = i_inf+1, i_sup-1
                   RF = RF+(RF_cont(i)+RF_cont(i+1))* &
                        (lambda_cont(i+1)-lambda_cont(i))/2
                enddo
                RF = RF+(RF_cont(i_sup)+RF_sup)* &
                     (lambda_grains_sup-lambda_cont(i_sup))/2
             endif
          endif
       endif
    endif

    do i = 1, dim_line
       if ((lambda_line(i) >= lambda_grains_inf) .and. &
            (lambda_line(i) < lambda_grains_sup)) RF = RF+RF_line(i)
    enddo
    RF = RF/(lambda_grains_sup-lambda_grains_inf)

  end subroutine average_RF

!#======================================================================

  subroutine attenuate_DISM(lum_cont, L_line, &
       cont_trans_DISM_incl, line_trans_DISM_incl, &
       lambda_cont, Lyman_cont_dust_abs, &
       cont_trans_DISM_tot, i_Lyman_break_cont)

    use mod_types
    use mod_constants, only : h_Planck, c_um

    implicit none
    real(CDR), dimension(:), intent(inout) :: lum_cont, L_line
    real(CDR), dimension(:), intent(in) :: cont_trans_DISM_incl, line_trans_DISM_incl
    real(CDR), dimension(:), intent(in) :: lambda_cont, cont_trans_DISM_tot
    real(CDR), intent(inout) :: Lyman_cont_dust_abs
    integer,  intent(in) :: i_Lyman_break_cont
!#......................................................................
    integer :: i_cont
    real(DPR) :: nb_phot
!#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

!# Number of Lyman continuum photons emitted by stars and absorbed in the
!# diffuse medium by dust:

    nb_phot = 0
    do i_cont = 1, i_Lyman_break_cont-1
       nb_phot = nb_phot + ( &
            lum_cont(i_cont)*(1-cont_trans_DISM_tot(i_cont)) &
            * lambda_cont(i_cont) &
            + lum_cont(i_cont+1)*(1-cont_trans_DISM_tot(i_cont+1)) &
            * lambda_cont(i_cont+1) &
            ) * (lambda_cont(i_cont+1)-lambda_cont(i_cont))
    enddo
    nb_phot = nb_phot / 2 / h_Planck / c_um

!# Units: `lum_cont` in erg.s-1.micrometer-1.M_sys-1;
!# `lambda_cont` in micrometers; `nb_phot` in s-1.M_sys-1.

    Lyman_cont_dust_abs = Lyman_cont_dust_abs + nb_phot

!# Continuum and line luminosities emerging from the galaxy in direction
!# `inclination` (or averaged on all directions if `inclin_averaged = .true.`).
    lum_cont(:) = lum_cont(:) * cont_trans_DISM_incl(:)
    L_line(:) = L_line(:) * line_trans_DISM_incl(:)

  end subroutine attenuate_DISM

end module mod_extinction
