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

  implicit none
  private
  public :: SSP_emission

contains

!#======================================================================
  
  subroutine SSP_emission(metallicity, &
       IMF_file, IMF_dim_slope, IMF_bin_coeff, IMF_bin_bottom_mass, &
       IMF_bin_slope, IMF_mass_min, IMF_mass_max, IMF_norm, &
       dim_isoch, isoch, HI_rate_SSP, HeI_rate_SSP, HeII_rate_SSP, &
       HI_power_SSP, HeI_power_SSP, HeII_power_SSP, L_bol_tot, &
       L_spec, dim_low_T, &
       metallicity_SL, dim_SL, T_SL_max, T_SL_min, dim_spec, stel_lib)

    use mod_types
    use mod_isochrone
    use mod_IMF, only : IMF_d_n
    use mod_stel_lib, only : interp_stel_lib, struct_stel_lib
    use mod_SSPs_constants, only : d_l10_m_isoch, d_T_isoch, d_L_isoch

    implicit none
    real(DPR), intent(in) :: metallicity
    character(len=*), intent(in) :: IMF_file
    integer, intent(in) :: IMF_dim_slope
    real(DPR), dimension(:), intent(in) :: IMF_bin_coeff, IMF_bin_bottom_mass, &
         IMF_bin_slope
    real(DPR), intent(in) :: IMF_mass_min, IMF_mass_max, IMF_norm
    integer, intent(in) :: dim_isoch
    type(struct_isoch), intent(in) :: isoch
    real(DPR), intent(out) :: HI_rate_SSP, HeI_rate_SSP, HeII_rate_SSP, HI_power_SSP, &
         HeI_power_SSP, HeII_power_SSP, L_bol_tot
    type(irreg_array_DPR), dimension(:), intent(inout) :: L_spec !# `intent(inout)` needed. \
!# Why does it fail with `intent(out)`???
    integer, intent(in) :: dim_low_T
    integer, intent(in) :: dim_SL
    integer, dimension(:), intent(in) :: dim_spec
    real(DPR), dimension(:), intent(in) :: metallicity_SL, T_SL_max, T_SL_min
    type(struct_stel_lib), dimension(:), intent(in) :: stel_lib
!#......................................................................
    integer :: i_isoch, dim_bin, i_bin, j1_inf, j2_inf, j3_inf, j4_inf, j1_sup, j2_sup, &
         j3_sup, j4_sup
    real(DPR) :: d_n, d_l10_mass, m_sub, T_sub, l10_L_sub, g_sub, &
         alpha1, alpha2, alpha3, alpha4, &
         L_sub, beta, metallicity_inf, metallicity_sup
    real(DPR) :: alpha1_inf, alpha2_inf, alpha3_inf, alpha4_inf, &
         alpha1_sup, alpha2_sup, alpha3_sup, alpha4_sup
    integer :: i_SL_sup12, i_SL_sup34, i_SL_inf12,i_SL_inf34
    integer :: i_low_T_sup, i_low_T_inf, i_high_T_sup, i_high_T_inf, i_SL
    type(struct_isoch), pointer :: isoch_node => null(), isoch1 => null(), &
         isoch2 => null()
!#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
    
    do i_SL = 1, dim_SL
       L_spec(i_SL) % val(0:) = 0
    enddo
!# Bolometric luminosity.
    L_bol_tot = 0
!# Number rate of photons ionizing H.
    HI_rate_SSP = 0
    HI_power_SSP = 0
!# Number of photons ionizing He once.
    HeI_rate_SSP = 0
    HeI_power_SSP = 0
!# Number of photons ionizing He twice.
    HeII_rate_SSP = 0
    HeII_power_SSP = 0

    isoch_node => isoch % ptr
    do i_isoch = 1, dim_isoch-1
       isoch1 => isoch_node
       isoch2 => isoch_node % ptr
       isoch_node => isoch2

!# Subdivision of the isochrone in smaller bins.

       dim_bin = int((max(isoch2 % m-isoch1 % m, 0._DPR))/d_l10_m_isoch+1) &
            +int(abs(isoch2 % T-isoch1 % T)/d_T_isoch+1) &
            +int(abs(isoch2 % L-isoch1 % L)/d_L_isoch+1)
       d_l10_mass = (max(isoch2 % m-isoch1 % m, 0._DPR))/dim_bin

       do i_bin = 0, dim_bin-1
          m_sub = isoch1 % m+(i_bin+0.5_DPR)*d_l10_mass
          d_n = IMF_d_n(m_sub, d_l10_mass, IMF_file, IMF_dim_slope, &
               IMF_bin_coeff, IMF_bin_bottom_mass, IMF_bin_slope, &
               IMF_mass_min, IMF_mass_max, IMF_norm)
          T_sub = isoch1 % T+(i_bin+0.5_DPR)*(isoch2 % T-isoch1 % T)/dim_bin
          l10_L_sub = isoch1 % L+(i_bin+0.5_DPR)*(isoch2 % L-isoch1 % L)/dim_bin
          g_sub = isoch1 % g+(i_bin+0.5_DPR)*(isoch2 % g-isoch1 % g)/dim_bin

          L_sub = 10**l10_L_sub
          L_bol_tot = L_bol_tot+d_n*L_sub
!# bin number `i_bin`: centered on `m_sub` (log10(mass)) and of width `d_l10_mass`
!#                   (log10(mass)); contains `d_n` stars.

!# Computation of the radiation emitted in stellar spectra with a metallicity 
!# BELOW that of the tracks (idem for the number of photons).

          if (metallicity <= metallicity_SL(1)) then
             i_low_T_inf = 1
             i_low_T_sup = 1
          else if (metallicity >= metallicity_SL(dim_low_T)) then
             i_low_T_inf = dim_low_T
             i_low_T_sup = dim_low_T
          else
             do i_SL = 1, dim_low_T-1
                if (metallicity_SL(i_SL) <= metallicity .and. &
                     metallicity <= metallicity_SL(i_SL+1)) then
                   i_low_T_inf = i_SL
                   i_low_T_sup = i_SL+1
                   exit
                endif
             enddo
          endif

          if (metallicity <= metallicity_SL(dim_low_T+1)) then
             i_high_T_inf = dim_low_T+1
             i_high_T_sup = dim_low_T+1
          else if (metallicity >= metallicity_SL(dim_SL)) then
             i_high_T_inf = dim_SL
             i_high_T_sup = dim_SL
          else
             do i_SL = dim_low_T+1, dim_SL-1
                if (metallicity_SL(i_SL) <= metallicity .and. &
                     metallicity <= metallicity_SL(i_SL+1)) then
                   i_high_T_inf = i_SL
                   i_high_T_sup = i_SL+1
                   exit
                endif
             enddo
          endif

          if (T_sub <= T_SL_max(i_low_T_sup)) then
!# Within or below the temperature domain of the library of cold stellar spectra.
             i_SL_sup12 = i_low_T_sup
             i_SL_sup34 = i_low_T_sup
          else if (T_sub >= T_SL_min(i_high_T_sup)) then
!# Within or above the temperature domain of the library of hot stellar spectra.
             i_SL_sup12 = i_high_T_sup
             i_SL_sup34 = i_high_T_sup
          else
!# Between the cold and the hot library of stellar spectra.
             i_SL_sup12 = i_high_T_sup
             i_SL_sup34 = i_low_T_sup
             do i_SL = i_low_T_sup-1, 1, -1
                if (metallicity_SL(i_SL) >= metallicity_SL(i_high_T_sup) .and. &
                     T_SL_max(i_SL) >= T_sub) then
                   i_SL_sup12 = i_SL
                   exit
                endif
             enddo
          endif

          if (T_sub <= T_SL_max(i_low_T_inf)) then
!# Within or below the temperature domain of the library of cold stellar spectra.
             i_SL_inf12 = i_low_T_inf
             i_SL_inf34 = i_low_T_inf
          else if (T_sub >= T_SL_min(i_high_T_inf)) then
!# Within or above the temperature domain of the library of hot stellar spectra.
             i_SL_inf12 = i_high_T_inf
             i_SL_inf34 = i_high_T_inf
          else
!# Between the cold and the hot library of stellar spectra.
             i_SL_inf12 = i_high_T_inf
             i_SL_inf34 = i_low_T_inf
             do i_SL = i_low_T_inf-1, 1, -1
                if (metallicity_SL(i_SL) >= metallicity_SL(i_high_T_inf) .and. &
                     T_SL_max(i_SL) >= T_sub) then
                   i_SL_inf12 = i_SL
                   exit
                endif
             enddo
          endif

          call interp_stel_lib(T_sub, g_sub, j1_inf, j2_inf, j3_inf, j4_inf, &
               alpha1_inf, alpha2_inf, alpha3_inf, alpha4_inf, &
               i_SL_inf12, i_SL_inf34, dim_spec, stel_lib)

          call interp_stel_lib(T_sub, g_sub, j1_sup, j2_sup, j3_sup, j4_sup, &
               alpha1_sup, alpha2_sup, alpha3_sup, alpha4_sup, &
               i_SL_sup12, i_SL_sup34, dim_spec, stel_lib)

          metallicity_inf = metallicity_SL(i_SL_inf34) + &
               (metallicity_SL(i_SL_inf12)-metallicity_SL(i_SL_inf34)) &
               *(alpha1_inf+alpha2_inf)
          metallicity_sup = metallicity_SL(i_SL_sup34) + &
               (metallicity_SL(i_SL_sup12)-metallicity_SL(i_SL_sup34)) &
               *(alpha1_sup+alpha2_sup)

          if (metallicity < metallicity_inf) then
             beta = 1
          else if (metallicity > metallicity_sup) then
             beta = 0
          else if (metallicity_inf == metallicity_sup) then
             beta = 0.5_DPR
          else
             beta = (metallicity_sup-metallicity)/ &
                  (metallicity_sup-metallicity_inf)
          endif

          alpha1 = alpha1_inf*beta
          alpha2 = alpha2_inf*beta
          alpha3 = alpha3_inf*beta
          alpha4 = alpha4_inf*beta
          HI_rate_SSP = HI_rate_SSP+L_sub*d_n*( &
               alpha1*stel_lib(i_SL_inf12) % HI_rate_star(j1_inf) &
               +alpha2*stel_lib(i_SL_inf12) % HI_rate_star(j2_inf) &
               +alpha3*stel_lib(i_SL_inf34) % HI_rate_star(j3_inf) &
               +alpha4*stel_lib(i_SL_inf34) % HI_rate_star(j4_inf))
          HeI_rate_SSP = HeI_rate_SSP+L_sub*d_n*( &
               alpha1*stel_lib(i_SL_inf12) % HeI_rate_star(j1_inf) &
               +alpha2*stel_lib(i_SL_inf12) % HeI_rate_star(j2_inf) &
               +alpha3*stel_lib(i_SL_inf34) % HeI_rate_star(j3_inf) &
               +alpha4*stel_lib(i_SL_inf34) % HeI_rate_star(j4_inf))
          HeII_rate_SSP = HeII_rate_SSP+L_sub*d_n*( &
               alpha1*stel_lib(i_SL_inf12) % HeII_rate_star(j1_inf) &
               +alpha2*stel_lib(i_SL_inf12) % HeII_rate_star(j2_inf) &
               +alpha3*stel_lib(i_SL_inf34) % HeII_rate_star(j3_inf) &
               +alpha4*stel_lib(i_SL_inf34) % HeII_rate_star(j4_inf))

          HI_power_SSP = HI_power_SSP+L_sub*d_n*( &
               alpha1*stel_lib(i_SL_inf12) % HI_power_star(j1_inf) &
               +alpha2*stel_lib(i_SL_inf12) % HI_power_star(j2_inf) &
               +alpha3*stel_lib(i_SL_inf34) % HI_power_star(j3_inf) &
               +alpha4*stel_lib(i_SL_inf34) % HI_power_star(j4_inf))
          HeI_power_SSP = HeI_power_SSP+L_sub*d_n*( &
               alpha1*stel_lib(i_SL_inf12) % HeI_power_star(j1_inf) &
               +alpha2*stel_lib(i_SL_inf12) % HeI_power_star(j2_inf) &
               +alpha3*stel_lib(i_SL_inf34) % HeI_power_star(j3_inf) &
               +alpha4*stel_lib(i_SL_inf34) % HeI_power_star(j4_inf))
          HeII_power_SSP = HeII_power_SSP+L_sub*d_n*( &
               alpha1*stel_lib(i_SL_inf12) % HeII_power_star(j1_inf) &
               +alpha2*stel_lib(i_SL_inf12) % HeII_power_star(j2_inf) &
               +alpha3*stel_lib(i_SL_inf34) % HeII_power_star(j3_inf) &
               +alpha4*stel_lib(i_SL_inf34) % HeII_power_star(j4_inf))

          L_spec(i_SL_inf12) % val(j1_inf) = L_spec(i_SL_inf12) % val(j1_inf) &
               + L_sub*alpha1*d_n
          L_spec(i_SL_inf12) % val(j2_inf) = L_spec(i_SL_inf12) % val(j2_inf) &
               + L_sub*alpha2*d_n
          L_spec(i_SL_inf34) % val(j3_inf) = L_spec(i_SL_inf34) % val(j3_inf) &
               + L_sub*alpha3*d_n
          L_spec(i_SL_inf34) % val(j4_inf) = L_spec(i_SL_inf34) % val(j4_inf) &
               + L_sub*alpha4*d_n

!# Computation of the radiation emitted in stellar spectra with a metallicity 
!# ABOVE that of the tracks (idem for the number of photons).

          alpha1 = alpha1_sup*(1-beta)
          alpha2 = alpha2_sup*(1-beta)
          alpha3 = alpha3_sup*(1-beta)
          alpha4 = alpha4_sup*(1-beta)
          HI_rate_SSP = HI_rate_SSP+L_sub*d_n*( &
               alpha1*stel_lib(i_SL_sup12) % HI_rate_star(j1_sup) &
               +alpha2*stel_lib(i_SL_sup12) % HI_rate_star(j2_sup) &
               +alpha3*stel_lib(i_SL_sup34) % HI_rate_star(j3_sup) &
               +alpha4*stel_lib(i_SL_sup34) % HI_rate_star(j4_sup))
          HeI_rate_SSP = HeI_rate_SSP+L_sub*d_n*( &
               alpha1*stel_lib(i_SL_sup12) % HeI_rate_star(j1_sup) &
               +alpha2*stel_lib(i_SL_sup12) % HeI_rate_star(j2_sup) &
               +alpha3*stel_lib(i_SL_sup34) % HeI_rate_star(j3_sup) &
               +alpha4*stel_lib(i_SL_sup34) % HeI_rate_star(j4_sup))
          HeII_rate_SSP = HeII_rate_SSP+L_sub*d_n*( &
               alpha1*stel_lib(i_SL_sup12) % HeII_rate_star(j1_sup) &
               +alpha2*stel_lib(i_SL_sup12) % HeII_rate_star(j2_sup) &
               +alpha3*stel_lib(i_SL_sup34) % HeII_rate_star(j3_sup) &
               +alpha4*stel_lib(i_SL_sup34) % HeII_rate_star(j4_sup))

          HI_power_SSP = HI_power_SSP+L_sub*d_n*( &
               alpha1*stel_lib(i_SL_sup12) % HI_power_star(j1_sup) &
               +alpha2*stel_lib(i_SL_sup12) % HI_power_star(j2_sup) &
               +alpha3*stel_lib(i_SL_sup34) % HI_power_star(j3_sup) &
               +alpha4*stel_lib(i_SL_sup34) % HI_power_star(j4_sup))
          HeI_power_SSP = HeI_power_SSP+L_sub*d_n*( &
               alpha1*stel_lib(i_SL_sup12) % HeI_power_star(j1_sup) &
               +alpha2*stel_lib(i_SL_sup12) % HeI_power_star(j2_sup) &
               +alpha3*stel_lib(i_SL_sup34) % HeI_power_star(j3_sup) &
               +alpha4*stel_lib(i_SL_sup34) % HeI_power_star(j4_sup))
          HeII_power_SSP = HeII_power_SSP+L_sub*d_n*( &
               alpha1*stel_lib(i_SL_sup12) % HeII_power_star(j1_sup) &
               +alpha2*stel_lib(i_SL_sup12) % HeII_power_star(j2_sup) &
               +alpha3*stel_lib(i_SL_sup34) % HeII_power_star(j3_sup) &
               +alpha4*stel_lib(i_SL_sup34) % HeII_power_star(j4_sup))

          L_spec(i_SL_sup12) % val(j1_sup) = L_spec(i_SL_sup12) % val(j1_sup) &
               + L_sub*alpha1*d_n
          L_spec(i_SL_sup12) % val(j2_sup) = L_spec(i_SL_sup12) % val(j2_sup) &
               + L_sub*alpha2*d_n
          L_spec(i_SL_sup34) % val(j3_sup) = L_spec(i_SL_sup34) % val(j3_sup) &
               + L_sub*alpha3*d_n
          L_spec(i_SL_sup34) % val(j4_sup) = L_spec(i_SL_sup34) % val(j4_sup) &
               + L_sub*alpha4*d_n
       end do
    end do

  end subroutine SSP_emission

end module mod_SSP_emission
