!# 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_SFC_DISM

  private
  public :: compute_stellar_spectrum, compute_nebular_spectrum, SFC_DISM_properties

contains

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

  subroutine compute_stellar_spectrum(convol_time, i_time, &
       dim_lambda_stel, beta, inv_time, lum_SSP, &
       SF_live_d_mass, &
       lum_stel_SFC_att_gas0, lum_stel_SFC_unatt0, &
       lum_stel_DISM_att_gas0, lum_stel_DISM_unatt0, &
       lum_stel_SFC0, &
       i_Lyman_break_stel, LC_gas_abs_birth_cloud, &
       LC_gas_abs_DISM, &
       dust_col_dens_birth_cloud, cloud_frac, &
       dim_species, grain_abs, species_weight, lambda_stel)

    use mod_types
    use mod_extinction, only : dust_optical_properties
    use mod_interp, only : Steffen3
    use mod_grain_properties, only : struct_grain_abs
    use mod_scenario, only : nebular_emission_SFC, nebular_emission_DISM, &
         extinction_SFC, cloud_duration

    implicit none
    real(CDR), dimension(:), intent(in) :: convol_time
    integer, intent(in) :: i_time
    integer, intent(in) :: dim_lambda_stel
    real(CDR), dimension(:), intent(out) :: lum_stel_SFC0
    real(CDR), dimension(:), intent(in) :: beta
    integer, dimension(:), intent(in) :: inv_time
    real(CDR), dimension(:, :, :), intent(in) :: lum_SSP
    real(DPR), dimension(:,:), intent(in) :: SF_live_d_mass
    integer, intent(in) :: i_Lyman_break_stel
    real(CDR), dimension(:), intent(in) :: LC_gas_abs_birth_cloud, &
         LC_gas_abs_DISM, dust_col_dens_birth_cloud, cloud_frac
    integer, intent(in) :: dim_species
    type(struct_grain_abs), dimension(:), intent(in) :: grain_abs
    real(CDR), dimension(:), intent(in) :: species_weight
    real(CDR), dimension(:), intent(in) :: lambda_stel
    real(CDR), dimension(:), intent(out) :: lum_stel_SFC_att_gas0, &
         lum_stel_SFC_unatt0, lum_stel_DISM_att_gas0, lum_stel_DISM_unatt0
!#......................................................................
    integer :: i_convol1, i_convol2
    integer :: i_lambda
    real(CDR) :: trans, albedo, asym, kappa_ext, tau_abs
!#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

!# Notations:
!#
!# `SFC`: star-forming clouds.
!#
!# `DISM`: diffuse interstellar medium,
!#
!# `lum_stel_*_unatt`: unattenuated emission of all stars in the medium.
!#
!# `lum_stel_*_att_gas`: emission of all stars in the medium,
!#     attenuated only by gas in the medium.
!#
!# `lum_stel_SFC`: emission of stars in star-forming clouds,
!#     attenuated by gas and dust in clouds only
!#     (if it were printed in the output file, should also be attenuated
!#     by gas and dust in the diffuse medium).

    lum_stel_SFC_unatt0(:) = 0
    lum_stel_SFC_att_gas0(:) = 0
    lum_stel_SFC0(:) = 0
    lum_stel_DISM_unatt0(:) = 0
    lum_stel_DISM_att_gas0(:) = 0

!# Unattenuated emission of stars:
    do i_convol1 = 1, i_time
       i_convol2 = i_time+1-i_convol1
       if (convol_time(i_convol2) <= cloud_duration) then
          do i_lambda = 1, dim_lambda_stel
             lum_stel_SFC_unatt0(i_lambda) = lum_stel_SFC_unatt0(i_lambda) &
                  + cloud_frac(i_convol2)*( &
                  beta(i_convol2)*sum(SF_live_d_mass(:,i_convol1)* &
                  lum_SSP(:,inv_time(i_convol2),i_lambda)) &
                  + (1-beta(i_convol2))*sum(SF_live_d_mass(:,i_convol1)* &
                  lum_SSP(:,inv_time(i_convol2)+1,i_lambda)))

             lum_stel_DISM_unatt0(i_lambda) = lum_stel_DISM_unatt0(i_lambda) &
                  + (1-cloud_frac(i_convol2))*( &
                  beta(i_convol2)*sum(SF_live_d_mass(:,i_convol1)* &
                  lum_SSP(:,inv_time(i_convol2),i_lambda)) &
                  + (1-beta(i_convol2))*sum(SF_live_d_mass(:,i_convol1)* &
                  lum_SSP(:,inv_time(i_convol2)+1,i_lambda)))
          enddo
       else !# Age > `cloud_duration`.
          do i_lambda = 1, dim_lambda_stel
!# `cloud_frac` = 0 for clusters older than `cloud_duration`: no contribution
!# to `lum_stel_SFC_unatt`.
             lum_stel_DISM_unatt0(i_lambda) = lum_stel_DISM_unatt0(i_lambda) &
                  + beta(i_convol2)*sum(SF_live_d_mass(:,i_convol1)* &
                  lum_SSP(:,inv_time(i_convol2),i_lambda)) &
                  + (1-beta(i_convol2))*sum(SF_live_d_mass(:,i_convol1)* &
                  lum_SSP(:,inv_time(i_convol2)+1,i_lambda))
          enddo
       endif
    enddo

!#----------------------------------------------------------------------

!# Transmitted emission of stars in star-forming clouds after attenuation by gas only:
    if (nebular_emission_SFC) then
       do i_convol1 = 1, i_time
          i_convol2 = i_time+1-i_convol1
          if (convol_time(i_convol2) <= cloud_duration) then
!# For Lyman continuum photons:
             do i_lambda = 1, i_Lyman_break_stel 
                lum_stel_SFC_att_gas0(i_lambda) = &
                     lum_stel_SFC_att_gas0(i_lambda) &
                     + cloud_frac(i_convol2)* &
                     (1-LC_gas_abs_birth_cloud(i_convol2))* &
                     (beta(i_convol2)*sum(SF_live_d_mass(:,i_convol1)* &
                     lum_SSP(:,inv_time(i_convol2),i_lambda)) &
                     + (1-beta(i_convol2))*sum(SF_live_d_mass(:,i_convol1)* &
                     lum_SSP(:,inv_time(i_convol2)+1,i_lambda)))
             enddo
          endif
       enddo

!# For non-ionizing photons:
       lum_stel_SFC_att_gas0(i_Lyman_break_stel+1:) = lum_stel_SFC_unatt0(i_Lyman_break_stel+1:)
    else !# `nebular_emission_SFC = .false.`.
       lum_stel_SFC_att_gas0(:) = lum_stel_SFC_unatt0(:)
    endif

!#----------------------------------------------------------------------

!# Transmitted emission of stars in the diffuse medium after attenuation by gas only:
    if (nebular_emission_DISM) then
       do i_convol1 = 1, i_time
          i_convol2 = i_time+1-i_convol1
          if (convol_time(i_convol2) <= cloud_duration) then
!# For Lyman continuum photons:
             do i_lambda = 1, i_Lyman_break_stel
                lum_stel_DISM_att_gas0(i_lambda) = &
                     lum_stel_DISM_att_gas0(i_lambda) &
                     + (1-cloud_frac(i_convol2))* &
                     (1-LC_gas_abs_DISM(i_convol2))* &
                     (beta(i_convol2)*sum(SF_live_d_mass(:,i_convol1)* &
                     lum_SSP(:,inv_time(i_convol2),i_lambda)) &
                     + (1-beta(i_convol2))*sum(SF_live_d_mass(:,i_convol1)* &
                     lum_SSP(:,inv_time(i_convol2)+1,i_lambda)))
             enddo

!# Note: Given the values of `LC_gas_abs_DISM` assigned in subroutine 
!# `SFC_DISM_properties` of "mod_extinction.f90", all Lyman continuum photons 
!# emitted by stars in the diffuse medium are assumed to be absorbed by gas, 
!# and only by gas, if they are young enough (age <= `HII_max_age`). 
!# (This excludes post-AGB stars, for instance, if `HII_max_age` = 50 Myr.)
!# As a consequence, `lum_stel_DISM_att_gas` is currently incremented 
!# in the Lyman continuum only for ages > `HII_max_age`.

          else !# `convol_time(i_convol2) > cloud_duration`.
!# `cloud_frac` = 0 for clusters older than `cloud_duration`: no contribution
!# to `lum_stel_SFC_att_gas`.
             do i_lambda = 1, i_Lyman_break_stel
                lum_stel_DISM_att_gas0(i_lambda) = &
                     lum_stel_DISM_att_gas0(i_lambda) &
                     + (1-LC_gas_abs_DISM(i_convol2))* &
                     (beta(i_convol2)*sum(SF_live_d_mass(:,i_convol1)* &
                     lum_SSP(:,inv_time(i_convol2),i_lambda)) &
                     + (1-beta(i_convol2))*sum(SF_live_d_mass(:,i_convol1)* &
                     lum_SSP(:,inv_time(i_convol2)+1,i_lambda)))
             end do
          endif
       enddo

!# For non-ionizing photons:
       lum_stel_DISM_att_gas0(i_Lyman_break_stel+1:) = lum_stel_DISM_unatt0(i_Lyman_break_stel+1:)
    else !# `nebular_emission_DISM = .false.`.
       lum_stel_DISM_att_gas0(:) = lum_stel_DISM_unatt0(:)
    endif

!#----------------------------------------------------------------------

!# Transmitted emission of stars after attenuation within star-forming clouds
!# by both gas and dust:
    if (extinction_SFC .and. nebular_emission_SFC) then
       do i_convol1 = 1, i_time
          i_convol2 = i_time+1-i_convol1
          if (convol_time(i_convol2) <= cloud_duration) then
             do i_lambda = i_Lyman_break_stel+1, dim_lambda_stel
                call dust_optical_properties(dim_species, grain_abs, &
                     lambda_stel(i_lambda), species_weight, kappa_ext, albedo, asym)
!# Assume scattering is forward only:
                tau_abs = kappa_ext*(1-albedo)*dust_col_dens_birth_cloud(i_convol2)
                trans = exp(-tau_abs)

                lum_stel_SFC0(i_lambda) = &
                     lum_stel_SFC0(i_lambda) + trans*cloud_frac(i_convol2)* &
                     (beta(i_convol2)*sum(SF_live_d_mass(:,i_convol1)* &
                     lum_SSP(:,inv_time(i_convol2),i_lambda)) &
                     + (1-beta(i_convol2))*sum(SF_live_d_mass(:,i_convol1)* &
                     lum_SSP(:,inv_time(i_convol2)+1,i_lambda)))
             enddo
          endif
       enddo
       lum_stel_SFC0(:i_Lyman_break_stel) = 0
    else !# `extinction_SFC = .false.` or `nebular_emission_SFC = .false.`.
       lum_stel_SFC0(:) = lum_stel_SFC_att_gas0(:)
    endif

  end subroutine compute_stellar_spectrum

!#======================================================================
!# ??? Will need to be divided in `_SFC` and `_DISM` subroutines if 
!# the fraction of Lyman continuum and Lyman alpha photons is not either 
!# 0 or 1.

  subroutine compute_nebular_spectrum(convol_time, i_time, dim_line, rel_L_line, &
       dim_lambda_stel, rel_lum_neb_cont, &
       SF_live_d_mass, LC_gas_abs_birth_cloud, LC_gas_abs_DISM, cloud_frac, &
       i_Lyman_alpha, &
       lum_neb_cont_SFC_unatt0, lum_neb_cont_SFC0, &
       lum_neb_cont_DISM_unatt0, &
       L_line_SFC_unatt, L_line_SFC, L_line_DISM_unatt, &
       M_dust_SFC, LC_power_SSP, &
       n_Z_neb, n_Q_neb, Z_neb_weight, Q_neb_weight_SFC, Q_neb_weight_DISM)

    use mod_types
    use mod_spectra_constants, only : HII_max_age
    use mod_scenario, only : nebular_emission_SFC, nebular_emission_DISM, &
         extinction_SFC, cloud_duration

    implicit none
    real(CDR), dimension(:), intent(in) :: convol_time
    integer, intent(in) :: i_time
    integer, intent(in) :: dim_line, dim_lambda_stel
    real(CDR), dimension(:,:,:), intent(in) :: rel_L_line
    real(CDR), dimension(:,:,:), intent(in) :: rel_lum_neb_cont
    real(CDR), dimension(:), intent(out) :: &
         L_line_SFC_unatt, L_line_SFC, L_line_DISM_unatt, &
         lum_neb_cont_SFC_unatt0, lum_neb_cont_SFC0, &
         lum_neb_cont_DISM_unatt0
    real(DPR), dimension(:,:), intent(in) :: SF_live_d_mass
    real(CDR), dimension(:), intent(in) :: LC_gas_abs_birth_cloud, &
         LC_gas_abs_DISM, cloud_frac
    integer, intent(in) :: i_Lyman_alpha
    real(CDR), intent(in) :: M_dust_SFC
    real(CDR), dimension(:,:), intent(in) :: LC_power_SSP
    integer, intent(in):: n_Z_neb, n_Q_neb
    real(CDR), dimension(:,:), intent(in) :: Z_neb_weight, Q_neb_weight_SFC, &
         Q_neb_weight_DISM
!#......................................................................
    integer :: i_convol1, i_convol2
    integer :: i_lambda, i_line
    real(CDR), dimension(n_Z_neb, n_Q_neb) :: neb_weight_SFC, neb_weight_DISM
    integer :: i_Z_neb, i_Q_neb
!#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

!# Many redundant computations in the present state.
!# Formulated to ease future improvements.

    lum_neb_cont_SFC_unatt0(:) = 0
    lum_neb_cont_SFC0(:) = 0
    lum_neb_cont_DISM_unatt0(:) = 0
    L_line_SFC_unatt(:) = 0
    L_line_SFC(:) = 0
    L_line_DISM_unatt(:) = 0

!#----------------------------------------------------------------------

!# Nebular emission from star-forming clouds:
    if(nebular_emission_SFC) then
       do i_convol1 = 1, i_time
          i_convol2 = i_time+1-i_convol1
          do i_Z_neb = 1, n_Z_neb
             do i_Q_neb = 1, n_Q_neb
                neb_weight_SFC(i_Z_neb,i_Q_neb) = Z_neb_weight(i_convol1,i_Z_neb) &
                     * Q_neb_weight_SFC(i_convol2,i_Q_neb)
             enddo
          enddo

          if (convol_time(i_convol2) <= cloud_duration) then
             do i_lambda = 1, dim_lambda_stel
                lum_neb_cont_SFC_unatt0(i_lambda) = &
                     lum_neb_cont_SFC_unatt0(i_lambda) &
                     + cloud_frac(i_convol2) * LC_gas_abs_birth_cloud(i_convol2) * &
                     sum(SF_live_d_mass(:,i_convol1) * LC_power_SSP(:, i_convol2)) * &
                     sum(neb_weight_SFC(:,:) * rel_lum_neb_cont(:,:,i_lambda))
             enddo

             do i_line = 1, dim_line
                L_line_SFC_unatt(i_line) = L_line_SFC_unatt(i_line) &
                     + cloud_frac(i_convol2) * LC_gas_abs_birth_cloud(i_convol2) * &
                     sum(SF_live_d_mass(:,i_convol1) * LC_power_SSP(:, i_convol2)) * &
                     sum(neb_weight_SFC(:,:) * rel_L_line(:,:,i_line))
             end do
          endif
       end do

!# ??? What about Lyman continuum photons possibly emitted by the HII gas shortward
!# of the Lyman break?
!# Should they be reabsorbed? Assume they are not...

!# Absorption of Lyman alpha photons by dust in star-forming clouds.
!# No absorption for other lines and nebular continuum.
       lum_neb_cont_SFC0(:) = lum_neb_cont_SFC_unatt0(:)
       L_line_SFC(:) = L_line_SFC_unatt(:)
       if (extinction_SFC .and. M_dust_SFC > 0) then
          L_line_SFC(i_Lyman_alpha) = 0
       endif
    endif

!#----------------------------------------------------------------------

!# Nebular emission from the diffuse medium:
    if(nebular_emission_DISM) then
       do i_convol1 = 1, i_time
          i_convol2 = i_time+1-i_convol1
          do i_Z_neb = 1, n_Z_neb
             do i_Q_neb = 1, n_Q_neb
                neb_weight_DISM(i_Z_neb,i_Q_neb) = Z_neb_weight(i_convol1,i_Z_neb) &
                     * Q_neb_weight_DISM(i_Z_neb,i_Q_neb)
             enddo
          enddo

          if (convol_time(i_convol2) <= cloud_duration) then
             do i_lambda = 1, dim_lambda_stel
                lum_neb_cont_DISM_unatt0(i_lambda) = &
                     lum_neb_cont_DISM_unatt0(i_lambda) &
                     + (1-cloud_frac(i_convol2)) * LC_gas_abs_DISM(i_convol2) * &
                     sum(SF_live_d_mass(:,i_convol1) * LC_power_SSP(:, i_convol2)) * &
                     sum(neb_weight_DISM(:,:) * rel_lum_neb_cont(:,:,i_lambda))
             enddo

             do i_line = 1, dim_line
                L_line_DISM_unatt(i_line) = L_line_DISM_unatt(i_line) &
                     + (1-cloud_frac(i_convol2)) * LC_gas_abs_DISM(i_convol2) * &
                     sum(SF_live_d_mass(:,i_convol1) * LC_power_SSP(:, i_convol2)) * &
                     sum(neb_weight_DISM(:,:) * rel_L_line(:,:,i_line))
             end do

          else if (convol_time(i_convol2) <= HII_max_age) then !# \
!#           `convol_time(i_convol2) > cloud_duration`.
!# All ionizing stars are in the diffuse medium.
             do i_lambda = 1, dim_lambda_stel
                lum_neb_cont_DISM_unatt0(i_lambda) = lum_neb_cont_DISM_unatt0(i_lambda) &
                     + LC_gas_abs_DISM(i_convol2) * &
                     sum(SF_live_d_mass(:,i_convol1) * LC_power_SSP(:, i_convol2)) * &
                     sum(neb_weight_DISM(:,:) * rel_lum_neb_cont(:,:,i_lambda))
             enddo

             do i_line = 1, dim_line
                L_line_DISM_unatt(i_line) = L_line_DISM_unatt(i_line) &
                     + LC_gas_abs_DISM(i_convol2) * &
                     sum(SF_live_d_mass(:,i_convol1) * LC_power_SSP(:, i_convol2)) * &
                     sum(neb_weight_DISM(:,:) * rel_L_line(:,:,i_line))
             end do
          endif
       end do

!# ??? What about Lyman continuum photons possibly emitted by the HII gas shortward
!# of the Lyman break?
!# Should they be reabsorbed? Assume they are not...
    endif

  end subroutine compute_nebular_spectrum

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

  subroutine SFC_DISM_properties(dim_species, grain_abs, &
       LC_rate_SSP, SF_live_d_mass, dust_abund, &
       species_weight, &
       LC_gas_abs_birth_cloud, LC_dust_abs_birth_cloud, &
       LC_gas_abs_DISM, Lyman_cont_rate, &
       Lyman_cont_dust_abs, Lyman_cont_gas_abs, dust_col_dens_birth_cloud, cloud_frac, &
       M_dust_SFC, ISM_over_H, &
       i_time, convol_time, &
       n_Q_neb, Q_neb, Q_neb_weight_SFC, inner_radius, H_density, &
       n_Z_neb, Z_neb_weight, rel_volume_neb)

    use mod_types
    use mod_interp, only : bracket, Steffen, compute_weights
    use mod_constants, only : H_atom_mass, &
         pi, L_sol, lambda_Lyman_break_um
    use mod_spectra_constants, only : HII_max_age
    use mod_grain_properties, only : struct_grain_abs
    use mod_scenario, only : nebular_emission_SFC, nebular_emission_DISM, &
         neb_emis_type_SFC, neb_emis_type_DISM, neb_emis_const_frac_SFC, neb_emis_const_frac_DISM, &
         cluster_stel_mass, extinction_SFC, &
         cloud_init_frac, cloud_power, cloud_duration
    use mod_extinction, only : dust_optical_properties

    implicit none
    integer, intent(in) :: i_time
    integer, intent(in) :: dim_species
    type(struct_grain_abs), dimension(:), intent(in) :: grain_abs
    real(CDR), dimension(:), intent(in) :: convol_time
    real(CDR), dimension(:,:), intent(in) :: LC_rate_SSP
    real(DPR), dimension(:,:), intent(in) :: SF_live_d_mass
    real(CDR), intent(in) :: dust_abund
    real(CDR), dimension(:), intent(in) :: species_weight
    real(CDR), dimension(:), intent(out) :: dust_col_dens_birth_cloud, cloud_frac
    real(CDR), dimension(:), intent(out) :: LC_gas_abs_birth_cloud, &
         LC_dust_abs_birth_cloud
    real(CDR), dimension(:), intent(out) :: LC_gas_abs_DISM
    real(CDR), intent(out) :: M_dust_SFC, Lyman_cont_rate
    real(CDR), intent(out) :: Lyman_cont_dust_abs, Lyman_cont_gas_abs
    real(CDR), intent(in) :: ISM_over_H
    integer, intent(in) :: n_Q_neb
    real(CDR), dimension(:), intent(in) :: Q_neb
    real(CDR), dimension(:,:), intent(out) :: Q_neb_weight_SFC
    real(CDR), intent(in) :: inner_radius, H_density
    integer, intent(in) :: n_Z_neb
    real(CDR), dimension(:,:), intent(in) :: Z_neb_weight
    real(DPR), dimension(:,:), intent(in) :: rel_volume_neb
!#......................................................................
    real(CDR) :: stellar_mass
    real(CDR) :: dust_col_dens_birth_cloud0
    real(CDR) :: albedo, asym, kappa_ext, M_ISM_birth_cloud
    real(DPR) :: LC_rate_birth_cloud, specific_LC_rate
    real(CDR) :: nb_clusters, M_stars_birth_cloud
    integer :: i_convol1, i_convol2, i_Z_neb, i_Q_neb
    real(CDR) :: M_dust_birth_cloud
    real(CDR) :: l10_LC_rate_birth_cloud
    real(CDR), dimension(n_Z_neb, n_Q_neb) :: Z_Q_neb_weight
    real(CDR) :: y_0, r_Stroemgren, tau_abs, y_i
    real(DPR) :: volume
!#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

!# Notations. All the quantities are for a galactic age of `convol_time(i_time)`.
!#
!# `Lyman_cont_rate`: emission rate of Lyman continuum photons by the galaxy, in number
!#     per unit time.
!#     Unlike `Lyman_cont_gas_abs`, it includes photons emitted after `HII_max_age`
!#     (e.g., from central stars of planetary nebulae).
!#
!# `stellar_mass`: mass of stars formed at time `convol_time(i_convol1)`.
!#     Their age is `convol_time(i_convol2)`.
!#
!# `nb_clusters`: number of clusters with an age of `convol_time(i_convol2)`.
!#     Computed assuming a typical initial mass (in stars) of `cluster_stel_mass`
!#     for the stellar cluster.
!#
!# `specific_LC_rate`: emission rate of Lyman continuum photons
!#     by stars with an age `convol_time(i_convol2)`, in number of photons
!#     per unit time per unit mass of the said stars.
!#
!# `cloud_frac`: fraction of stars aged `convol_time(i_convol2)` still in
!#     their parent cloud. These stars are called "the cloud's stars" in what follows.
!#
!# `M_stars_birth_cloud`: for a typical cluster, mass of the cloud's stars.
!#
!# `LC_rate_birth_cloud`: rate of Lyman continuum photons emitted by the cloud's stars
!#     of a typical cluster. In number of photons per unit time.
!#
!# `r_Stroemgren`: Stroemgren radius, if there is no dust, of the HII region
!#     surrounding the cloud's stars. It is assumed that the HII region is spherical
!#     and that all the cloud's stars are at its center.
!#     -> Quantity $r_S$ in Spitzer (1978, sec. 5.1.c).
!#
!# `H_density`: uniform space density of hydrogen in the HII region.
!#
!# `dust_col_dens_birth_cloud0`: column density of dust in the HII region, computed
!#     on a distance `r_Stroemgren`.
!#
!# `tau_abs`: dust absorption optical depth of the HII region at the Lyman break,
!#     computed on a distance `r_Stroemgren`.
!#     The factor `1-albedo` in the expression of `tau_abs` is due to the fact
!#     that, in the UV, scattering is mainly forward.
!#     -> Quantity $\tau_{Sd}$ in Spitzer.
!#
!# `dust_col_dens_birth_cloud`: column density of dust on the effective radius
!#     of the HII region (taking into account the volume reduction due to dust).
!#
!# `LC_gas_abs_birth_cloud`: fraction of Lyman continuum photons (in number) emitted
!#     by the cloud's stars and absorbed by gas in this cloud.
!#     In the "automatic" case adapted from Spitzer (1978), it is computed at the Lyman break, 
!#     because most of Lyman continuum photons have a wavelength near that of the break.
!#     In the "constant" case, Lyman continuum photons emitted by the cloud's stars
!#     and not absorbed by gas or dust in the cloud may be absorbed in the
!#     diffuse medium by dust but not by gas.
!#     In all cases, the same fraction is used at all wavelengths in the
!#     Lyman continuum.
!#
!# `LC_gas_abs_DISM`: fraction of Lyman continuum photons (in number) emitted by stars
!#     in the diffuse medium and absorbed by gas in this medium.
!#     This fraction is 1 in the "automatic" case and a constant in the "constant"
!#     case.
!#     In all cases, the same fraction is used at all wavelengths in the
!#     Lyman continuum.
!#
!# `LC_dust_abs_birth_cloud`: fraction of Lyman continuum photons (in number) emitted
!#     by the cloud's stars and absorbed by dust in this cloud.
!#     The same fraction is used at all wavelengths in the
!#     Lyman continuum.
!#
!# `M_ISM_birth_cloud`: mass of the ISM (gas and dust) in the cloud considered.
!#
!# `M_dust_birth_cloud`: mass of dust in the cloud considered.
!#
!# `M_dust_SFC`: mass of dust in all currently existing star-forming clouds.
!#
!# `Lyman_cont_gas_abs`: fraction of Lyman continuum photons (in number) absorbed
!#     by gas, whether in star-forming clouds or in the diffuse medium.
!#
!# `Lyman_cont_dust_abs`: fraction of Lyman continuum photons (in number) absorbed
!#     by dust (here, in star-forming clouds only; for the diffuse_medium, see 
!#     `attenuate_DISM`).

!#----------------------------------------------------------------------
!# Assumptions:
!#
!# Stars are assumed to form in clusters with a typical stellar mass given by
!# `cluster_stel_mass`.
!# If the age of the cluster, `convol_time(i_convol2)`, is larger than
!# `cloud_duration`, all the stars formed in the cluster are outside the dust
!# cloud;
!# if the age is less than `cloud_duration`, a fraction `cloud_frac` of the
!# stars formed in the cluster is inside the dust cloud.
!#
!# As modeled here, Lyman continuum photons emitted by stars younger
!# than `HII_max_age` and not in their parent cloud (whether younger
!# than `cloud_duration` or not) are absorbed by gas in the diffuse medium:
!# all of them if `neb_emis_type = "automatic"` or a constant fraction if
!# `neb_emis_type = "constant"`.
!# Lyman continuum photons emitted by hot stars older than `HII_max_age` (e.g.,
!# central stars of planetary nebulae) are not absorbed by gas and do not
!# produce any nebular emission.

    M_dust_SFC = 0
    Lyman_cont_rate = 0
    Lyman_cont_dust_abs = 0
    Lyman_cont_gas_abs = 0
    LC_gas_abs_birth_cloud(:) = 0
    LC_dust_abs_birth_cloud(:) = 0
    LC_gas_abs_DISM(:) = 0
    dust_col_dens_birth_cloud(:) = 0
    cloud_frac(:) = 0

    Q_neb_weight_SFC(:,:) = 0

    do i_convol1 = 1, i_time
       i_convol2 = i_time+1-i_convol1
       Lyman_cont_rate = Lyman_cont_rate + & !# Multiplied by `L_sol` later.
            sum(SF_live_d_mass(:,i_convol1)*LC_rate_SSP(:, i_convol2))

       if (convol_time(i_convol2) <= cloud_duration) then
          stellar_mass = sum(SF_live_d_mass(:,i_convol1))
          nb_clusters = stellar_mass/cluster_stel_mass
          if (stellar_mass > 0) then
             specific_LC_rate = L_sol* &
                  sum(SF_live_d_mass(:,i_convol1)*LC_rate_SSP(:, i_convol2))/ &
                  stellar_mass
          else
             specific_LC_rate = 0
          endif

          if (cloud_power == 0) then
             cloud_frac(i_convol2) = cloud_init_frac
          else
             cloud_frac(i_convol2) = cloud_init_frac * &
                  (1-convol_time(i_convol2)/cloud_duration)**cloud_power
          endif

!# For young stars in star-forming clouds:
          if (nebular_emission_SFC) then
             M_stars_birth_cloud = cluster_stel_mass * cloud_frac(i_convol2)
             LC_rate_birth_cloud = specific_LC_rate*M_stars_birth_cloud
             l10_LC_rate_birth_cloud = log10(max(LC_rate_birth_cloud,tiny(1._DPR)))
             call compute_weights(Q_neb, &
                  l10_LC_rate_birth_cloud, Q_neb_weight_SFC(i_convol2,:))
             do i_Z_neb = 1, n_Z_neb
                do i_Q_neb = 1, n_Q_neb
                   Z_Q_neb_weight(i_Z_neb, i_Q_neb) = &
                        Z_neb_weight(i_convol1, i_Z_neb) &
                        * Q_neb_weight_SFC(i_convol2, i_Q_neb)
                enddo
             enddo
             volume = LC_rate_birth_cloud*sum(Z_Q_neb_weight(:,:)*rel_volume_neb(:,:))
             r_Stroemgren = max((3/(4*pi)*volume+inner_radius**3)**(1._DPR/3), inner_radius)
             y_0 = inner_radius/r_Stroemgren


             call dust_optical_properties(dim_species, grain_abs, lambda_Lyman_break_um, &
                  species_weight, kappa_ext, albedo, asym)

!# ??? Should one use the dust abundance at `convol_time(i_time)` or at `convol_time(i_convol1)`?
!# Same question for `species_weight` and `ISM_over_H`.

             dust_col_dens_birth_cloud0 = dust_abund * &
                  r_Stroemgren * H_density*H_atom_mass * ISM_over_H

             if (extinction_SFC) then
                if (neb_emis_type_SFC == "automatic") then
                   tau_abs = kappa_ext*(1-albedo)*dust_col_dens_birth_cloud0
                   y_i = Spitzer_solve(y_0=y_0, tau_abs=tau_abs, eps=1.e-6_CDR)
                   if (y_0 < 1) then
                      LC_gas_abs_birth_cloud(i_convol2) = (y_i**3-y_0**3)/(1-y_0**3)
                   else
                      LC_gas_abs_birth_cloud(i_convol2) = 1
                   endif
                   LC_dust_abs_birth_cloud(i_convol2) = 1 - LC_gas_abs_birth_cloud(i_convol2)

                else !# `neb_emis_type_SFC = "constant"`.
                   LC_gas_abs_birth_cloud(i_convol2) = neb_emis_const_frac_SFC
                   y_i = (y_0**3 + &
                        LC_gas_abs_birth_cloud(i_convol2)*(1-y_0**3))**(1._DPR/3)
                   if (dust_abund > 0) LC_dust_abs_birth_cloud(i_convol2) &
                        = 1 - LC_gas_abs_birth_cloud(i_convol2)
                endif

                dust_col_dens_birth_cloud(i_convol2) = (y_i-y_0) * dust_col_dens_birth_cloud0

                M_ISM_birth_cloud = (4*pi)/3* &
                     r_Stroemgren**3*(y_i**3-y_0**3) &
                     *H_density*H_atom_mass*ISM_over_H

                M_dust_birth_cloud = dust_abund*M_ISM_birth_cloud

                M_dust_SFC = M_dust_SFC + M_dust_birth_cloud*nb_clusters
             else !# `extinction_SFC = .false.`.
                if (neb_emis_type_SFC == "automatic") then
                   LC_gas_abs_birth_cloud(i_convol2) = 1
                else if (neb_emis_type_SFC == "constant") then
                   LC_gas_abs_birth_cloud(i_convol2) = neb_emis_const_frac_SFC
                endif
                LC_dust_abs_birth_cloud(i_convol2) = 0
                dust_col_dens_birth_cloud(i_convol2) = 0
             endif
             Lyman_cont_gas_abs = Lyman_cont_gas_abs + &
                  LC_gas_abs_birth_cloud(i_convol2) * LC_rate_birth_cloud &
                  * nb_clusters
             Lyman_cont_dust_abs = Lyman_cont_dust_abs + &
                  LC_dust_abs_birth_cloud(i_convol2) * LC_rate_birth_cloud &
                  * nb_clusters
          else !# `nebular_emission_SFC = .false.`.
!~           LC_gas_abs_birth_cloud(i_convol2) = 0
!~           LC_dust_abs_birth_cloud(i_convol2) = 0 !# This, even if \
!# `extinction_SFC = .true.`, because there is no HII region.
!~           dust_col_dens_birth_cloud(i_convol2) = 0
          endif

!# For stars younger than `cloud_duration` but in the diffuse medium:
          if (nebular_emission_DISM) then
             if (neb_emis_type_DISM == "automatic") then
                LC_gas_abs_DISM(i_convol2) = 1
             else if (neb_emis_type_DISM == "constant") then
                LC_gas_abs_DISM(i_convol2) = neb_emis_const_frac_DISM
             endif
             Lyman_cont_gas_abs = Lyman_cont_gas_abs &
                  + (1-cloud_frac(i_convol2)) * LC_gas_abs_DISM(i_convol2) * L_sol * &
                  sum(SF_live_d_mass(:,i_convol1)*LC_rate_SSP(:, i_convol2))
          else !# `nebular_emission_DISM = .false.`.
!~             LC_gas_abs_DISM(i_convol2) = 0
          endif

       else if (convol_time(i_convol2) <= HII_max_age) then !# Age >= `cloud_duration`.
!# Note: if the line above is replaced by a simple `else`, then hot stars
!# older than `HII_max_age` (central stars of planetary nebulae, for instance)
!# will produce emission lines in the diffuse medium.

          if (nebular_emission_DISM) then
             if (neb_emis_type_DISM == "automatic") then
                LC_gas_abs_DISM(i_convol2) = 1
             else if (neb_emis_type_DISM == "constant") then
                LC_gas_abs_DISM(i_convol2) = neb_emis_const_frac_DISM
             endif
             Lyman_cont_gas_abs = Lyman_cont_gas_abs + LC_gas_abs_DISM(i_convol2) * L_sol * &
                  sum(SF_live_d_mass(:,i_convol1)*LC_rate_SSP(:, i_convol2))
          else !# `nebular_emission_DISM = .false.`.
!~             LC_gas_abs_DISM(i_convol2) = 0
          endif
       else !# Age >= `HII_max_age`.
          LC_gas_abs_DISM(i_convol2) = 0
       endif
    enddo

    Lyman_cont_rate = Lyman_cont_rate*L_sol

  end subroutine SFC_DISM_properties

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

  function Spitzer_func(tau_abs, y_0, y_i)

    use mod_types
    implicit none
    real(CDR) :: Spitzer_func
    real(CDR), intent(in) :: tau_abs, y_0, y_i

    real(DPR) :: u_0, u_i !# Double precision required for stability when \
!# `tau_abs` > 1.e-2 but `u_i` ~= `u_0`.

    u_0 = y_0*tau_abs
    u_i = y_i*tau_abs
    if (tau_abs > 1.e-2) then
       Spitzer_func = 3/(1-y_0**3)/tau_abs**3* &
            (exp(u_i-u_0)*(u_i**2-2*u_i+2) - (u_0**2-2*u_0+2))-1
    else !# First order development in tau_abs for numerical reasons. \
!#
       Spitzer_func = (y_i**3-1 + tau_abs/4*(y_0**4-4*y_0*y_i**3+3*y_i**4))/(1-y_0**3)
    endif

  end function Spitzer_func

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

  function Spitzer_solve(y_0, tau_abs, eps)

    use mod_types
    implicit none
    real(CDR) :: Spitzer_solve
    real(CDR), intent(in) :: y_0, tau_abs, eps

    real(CDR) :: y1, y2, z1, z2, y_i, z_i

    y1 = y_0
    y2 = 1
    z1 = -1 !# By definition.
    z2 = Spitzer_func(tau_abs, y_0, y2) !# Must be > 0 for `y2` = 1.

    do
       y_i = (y1+y2)/2
       z_i = Spitzer_func(tau_abs, y_0, y_i)
       if (z_i > 0) then
          y2 = y_i
          z2 = z_i
       else
          y1 = y_i
          z1 = z_i
       endif
       if (y2-y1 < eps) exit
    enddo
    if (y2 == y1) then
       Spitzer_solve = y1
    else
       Spitzer_solve = (y1*z2-y2*z1)/(z2-z1) !# Linear interpolation.
    endif

  end function Spitzer_solve

end module mod_SFC_DISM
