!# 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_nebular
  
  private
  public :: nebular_computations

contains

!#======================================================================
  
  subroutine nebular_computations(inner_radius, H_density, &
       n_Z_neb, n_Q_neb, Z_neb, Q_neb, &
       dim_lambda, lambda, rel_lum_neb_cont, &
       dim_line, lambda_line, rel_L_line, line_id, i_Lyman_alpha, &
       i_Lyman_break, Q_neb_weight_DISM, &
       rel_lum_other_lines, rel_volume_neb)

    use mod_types
    use mod_directories, only : Cloudy_dir
    use mod_constants, only : lambda_Lyman_break_A, parsec, neb_set
    use mod_file_access, only : open_file, close_file, path_file, skip_comment_lines
    use mod_interp, only : interp_lin_log, compute_weights
    use mod_heap_index, only : heap_index
    use mod_scenario, only : l10_mean_U_DISM
    
    implicit none
    real(CDR), intent(out) :: inner_radius, H_density
    integer, intent(out) :: n_Z_neb, n_Q_neb
    real(CDR), dimension(:), pointer :: Z_neb, Q_neb
    real(CDR), dimension(:,:), pointer :: Q_neb_weight_DISM
    integer, intent(in) :: dim_lambda
    real(CDR), dimension(:), intent(in) :: lambda
    real(CDR), dimension(:,:,:), pointer :: rel_lum_neb_cont
    integer, intent(out) :: dim_line
    real(CDR), dimension(:), pointer :: lambda_line
    real(CDR), dimension(:,:,:), pointer :: rel_L_line
    character(len=*), dimension(:), pointer :: line_id
    integer, intent(out) :: i_Lyman_alpha, i_Lyman_break
    real(CDR), dimension(:,:), pointer :: rel_lum_other_lines
    real(DPR), dimension(:,:), pointer :: rel_volume_neb
!#......................................................................
    integer :: unit, unit2, i_neb_cont, i_lambda, i_Z, i_Q
    character(len=long_string) :: neb_lines_list_file, neb_cont_wavelengths_file
    character(len=long_string) :: neb_lines_file, neb_cont_file
    real(CDR), dimension(:), allocatable :: rel_lum_neb_cont0, l10_mean_U
    integer :: dim_neb_cont, unit_HII 
    real(CDR), dimension(:), allocatable :: lambda_neb_cont
    integer :: i_line
    integer, dimension(:), allocatable :: idx
!#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
   
    call open_file(unit, file=path_file(Cloudy_dir, neb_set))
    read(unit,*) inner_radius
    inner_radius = inner_radius*parsec
    
    read(unit,*) H_density
    H_density = 10**H_density

    read(unit,*) n_Z_neb, n_Q_neb
    allocate(Z_neb(n_Z_neb))
    allocate(Q_neb(n_Q_neb))
    allocate(Q_neb_weight_DISM(n_Z_neb, n_Q_neb))
    read(unit,*) Z_neb(:)
    read(unit,*) Q_neb(:)

    read(unit,*) neb_lines_list_file
    call open_file(unit2, file=path_file(Cloudy_dir, neb_lines_list_file))
    read(unit2,*) dim_line
    call skip_comment_lines(unit2)
    if (associated(lambda_line)) deallocate(lambda_line)
    allocate(lambda_line(dim_line))
    if (associated(line_id)) deallocate(line_id)
    allocate(line_id(dim_line))
    do i_line = 1, dim_line
       read(unit2,*) line_id(i_line), lambda_line(i_line)
    end do    
    close(unit2)

    read(unit,*) neb_cont_wavelengths_file
    call open_file(unit2, file=path_file(Cloudy_dir, neb_cont_wavelengths_file))
    read(unit2, *) dim_neb_cont
    if (allocated(lambda_neb_cont)) then
       deallocate(lambda_neb_cont)
    endif
    allocate(lambda_neb_cont(dim_neb_cont))
    do i_neb_cont = 1, dim_neb_cont
       read(unit2,*) lambda_neb_cont(i_neb_cont)
    end do
    close(unit2)

    if (associated(rel_volume_neb)) deallocate(rel_volume_neb)
    allocate(rel_volume_neb(n_Z_neb, n_Q_neb))
    allocate(l10_mean_U(n_Q_neb))
    if (associated(rel_lum_other_lines)) deallocate(rel_lum_other_lines)
    allocate(rel_lum_other_lines(n_Z_neb, n_Q_neb))

    if (associated(rel_L_line)) deallocate(rel_L_line)
    allocate(rel_L_line(n_Z_neb, n_Q_neb, dim_line))

    if (allocated(rel_lum_neb_cont0)) deallocate(rel_lum_neb_cont0)
    allocate(rel_lum_neb_cont0(dim_neb_cont))

    if (associated(rel_lum_neb_cont)) deallocate(rel_lum_neb_cont)
    allocate(rel_lum_neb_cont(n_Z_neb, n_Q_neb, dim_lambda))

    do i_Z = 1, n_Z_neb
       do i_Q = 1, n_Q_neb
          read(unit,*) rel_volume_neb(i_Z, i_Q)
          read(unit,*) l10_mean_U(i_Q)
          read(unit,*) neb_lines_file
          read(unit,*) neb_cont_file

          call open_file(unit2, path_file(Cloudy_dir, neb_lines_file))
          read(unit2,*) rel_lum_other_lines(i_Z, i_Q)
          do i_line = 1, dim_line
             read(unit2,*) rel_L_line(i_Z, i_Q, i_line)
          enddo
          call close_file(unit2)

          call open_file(unit2, path_file(Cloudy_dir, neb_cont_file))
          do i_neb_cont = 1, dim_neb_cont
             read(unit2,*) rel_lum_neb_cont0(i_neb_cont)
          enddo
          do i_lambda = 1, dim_lambda
             if (lambda(i_lambda) < lambda_neb_cont(1)) then
                rel_lum_neb_cont(i_Z, i_Q, i_lambda) = 0
             else if (lambda(i_lambda) > lambda_neb_cont(dim_neb_cont)) then
                i_neb_cont = dim_neb_cont-1
                rel_lum_neb_cont(i_Z, i_Q, i_lambda) = interp_lin_log( &
                     1/lambda_neb_cont(i_neb_cont), &
                     1/lambda_neb_cont(i_neb_cont+1), &
                     rel_lum_neb_cont0(i_neb_cont), &
                     rel_lum_neb_cont0(i_neb_cont+1), 1/lambda(i_lambda))
             else
                i_neb_cont = 1
                do
                   if (lambda_neb_cont(i_neb_cont) <= lambda(i_lambda) .and. &
                        lambda(i_lambda) <= lambda_neb_cont(i_neb_cont+1)) exit
                   if (i_neb_cont >= dim_neb_cont) exit
                   i_neb_cont = i_neb_cont+1
                end do
                if (lambda_neb_cont(i_neb_cont) <= lambda(i_lambda) .and. &
                     lambda(i_lambda) <= lambda_neb_cont(i_neb_cont+1)) then !# ??? And if not?
                   rel_lum_neb_cont(i_Z, i_Q, i_lambda) = interp_lin_log( &
                        1/lambda_neb_cont(i_neb_cont), &
                        1/lambda_neb_cont(i_neb_cont+1), &
                        rel_lum_neb_cont0(i_neb_cont), &
                        rel_lum_neb_cont0(i_neb_cont+1), 1/lambda(i_lambda))
                else
                   write(*,*) "Error in ""mod_nebular.f90"". Stopped."
                   stop
                endif
             endif
          enddo
          call close_file(unit2)
       enddo
       call compute_weights(l10_mean_U(:), l10_mean_U_DISM, &
            Q_neb_weight_DISM(i_Z,:), interp_proc="interp_lin_lin")
    enddo
    call close_file(unit)
    deallocate(l10_mean_U)

!# Check that the same identifier is not used for two emission lines or more.
    allocate(idx(dim_line))
    call heap_index(line_id, idx)
    do i_line = 1, dim_line-1
       if (line_id(idx(i_line)) == line_id(idx(i_line+1))) then
          write(*,"(a,i0,a,i0,a)") "The emission lines ", idx(i_line), &
               " and ", idx(i_line+1), " share the same identifier, """ // &
               trim(line_id(idx(i_line))) // """. Stopped."
          stop
       end if
    enddo
    deallocate(idx)

!# Find the index of Lyman alpha.
    i_Lyman_alpha = 0
    do i_line = 1, dim_line
       if (line_id(i_line) == "H_I__1215.67_A") then
          i_Lyman_alpha = i_line
          exit
       endif
    end do
    if (i_Lyman_alpha == 0) then
       write(*,"(a)") "Identifier ""H_I__1215.67_A"" was not found for &
            &Lyman alpha. Stopped."
       stop
    endif

!# Find the indices of the stellar wavelengths bracketing the Lyman break.
    i_Lyman_break = 0
    do while (lambda(i_Lyman_break+1) < lambda_Lyman_break_A)
       i_Lyman_break = i_Lyman_break+1
    enddo
    
    call close_file(unit_HII)
    
  end subroutine nebular_computations

end module mod_nebular
