!# 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.
!#====================================================================== 

!# Code "colors" takes as input a file of spectra (the main output file of code 
!# "spectra"), processes it and outputs in a file of colors various quantities
!# as a function of the age of the modeled galaxy.
!#
!# To change the output, edit file "incl_colors.f90", and compile the code in
!# "bin_dir/" with the `make` command.

program colors

  use mod_types
  use mod_directories, only : calib_dir, colors_dir, spectra_dir, bin_dir
  use mod_dir_access, only : dir_sep
  use mod_file_access, only : open_file, close_file, file_name_decomposition, &
       path_file, extract_path, base_name, file_name_components, skip_comment_lines
  use mod_constants, only : area_10pc, spectra_list, c_ang
  use mod_filters_constants, only : filters_list, undefined_mag, std_Vega_def, M_bol_Sun
  use mod_filters, only : struct_filter, read_filters, flux_band
  use mod_read_spectra_output, only : read_spectra_output, struct_spectra_output
  use mod_select_file, only : select_single_file
  use mod_interp, only : interp_lin_lin
  use mod_colors
  use mod_hash
  use mod_magnit
  use mod_strings, only : quote_string, unquote_string
  use mod_code_version, only : version_id, version_date
  use mod_compiler, only : compiler
  use mod_convert_type, only : boolean_answer
  use mod_ISO_8601, only : ISO_8601

  implicit none
!#......................................................................
  character(std_string) :: spectra_file_name, spectra_base_name
  type(struct_spectra_output) :: data
  character(std_string+len("colors_")) :: colors_file, colors_file_def
  character(2*std_string) :: colors_full_name, colors_dir_name, &
       colors_base_name
  logical :: first_time
  type(struct_filter), dimension(:), pointer :: filter => null()

  character(len=std_string) :: name
  real(DPR), dimension(:), allocatable :: calib, filter_norm, lambda_mean, &
       lambda_pivot, filter_width, mag_abs_Sun

  integer :: i_elem, i_line, i_cont, dim_filter, unit_calib
  integer, dimension(:), allocatable :: pos_line

  real(DPR), dimension(:), allocatable :: D4000, M_bol, Dn4000
  real(DPR) :: flux_band_Vega, std_Vega, AB_Vega, TG_Vega, unused_number
  integer :: dim_elem, dim_cont, dim_line
  integer :: i_filter, i_output_age
  logical :: exist, overwrite
  integer :: unit_compiler
  character(len=25) :: run_begin_time
!#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

  call ISO_8601(local_time_extended = run_begin_time)
  
  call open_file(unit_compiler, path_file(bin_dir, "compil_colors.txt"))
  read(unit_compiler,*) compiler
  call close_file(unit_compiler)

!# Read the transmission of the filters.

  call read_filters(path_file(calib_dir, filters_list), dim_filter, filter)

!# Create the hash table for filters.

  call create_hash_table(filter(:) % id, hash_filter, dim_hash_filter)

!# Read the calibrations of the filters.

  if (allocated(calib)) deallocate(calib)
  allocate(calib(dim_filter))
  if (allocated(filter_norm)) deallocate(filter_norm)
  allocate(filter_norm(dim_filter))
  if (allocated(lum_band_Sun)) deallocate(lum_band_Sun)
  allocate(lum_band_Sun(dim_filter))
  if (allocated(lambda_mean)) deallocate(lambda_mean)
  allocate(lambda_mean(dim_filter))
  if (allocated(lambda_pivot)) deallocate(lambda_pivot)
  allocate(lambda_pivot(dim_filter))
  if (allocated(filter_width)) deallocate(filter_width)
  allocate(filter_width(dim_filter))
  if (allocated(mag_abs_Sun)) deallocate(mag_abs_Sun)
  allocate(mag_abs_Sun(dim_filter))

  call open_file(unit_calib, path_file(calib_dir, "calib.txt"))
  read(unit_calib, *) !# `version_id` of "calib".
  read(unit_calib, *) !# `version_date` of "calib".
  call skip_comment_lines(unit_calib)

  do i_filter = 1, dim_filter
     read(unit_calib, *) name, unused_number, flux_band_Vega, filter_norm(i_filter), &
          lambda_mean(i_filter), unused_number, AB_Vega, TG_Vega, lum_band_Sun(i_filter), &
          mag_abs_Sun(i_filter), lambda_pivot(i_filter), filter_width(i_filter)
     if (filter(i_filter) % calib_type == "D4000") then
        calib(i_filter) = undefined_mag
     else if (filter(i_filter) % calib_type == "HST") then !# ref = -21.10
        calib(i_filter) = -21.10_DPR
     else if (filter(i_filter) % calib_type == "FOCA") then !# ref = -21.175
        calib(i_filter) = -21.175_DPR
     else if (filter(i_filter) % calib_type == "IRAS") then
        calib(i_filter) = undefined_mag
     else
        std_Vega = std_Vega_def + filter(i_filter) % ZPO
        if (filter(i_filter) % calib_type == "Vega") then !# ref = Vega
           calib(i_filter) = 2.5_DPR*log10(flux_band_Vega) + std_Vega
        else if (filter(i_filter) % calib_type == "AB") then !# ref = AB
           calib(i_filter) = 2.5_DPR*log10(flux_band_Vega) + AB_Vega - std_Vega
        else if (filter(i_filter) % calib_type == "TG") then !# ref = BD+17d4708 (Thuan & Gunn system)
           if (TG_Vega == undefined_mag) then
              calib(i_filter) = undefined_mag
           else
              calib(i_filter) = 2.5_DPR*log10(flux_band_Vega) + TG_Vega - std_Vega
           endif
        end if
     endif
  end do
  call close_file(unit_calib)

  write(*, "(a)") "Name of the input file (file of spectra)?"
  call select_single_file(dir = spectra_dir, list = spectra_list, &
       selected_file = spectra_file_name, object = "input file", &
       objects = "input files", back = .true.)

  call file_name_decomposition(full_name=spectra_file_name, &
       base_name=spectra_base_name, dir_sep=dir_sep)
  colors_file_def = "colors_" // trim(spectra_base_name)

  first_time = .true.
  do 
     if (first_time) then
        write(*, "(/a)") "Name of the output file?"
        write(*, "(a/a)") "(If the file is in a subdirectory of """ // &
             trim(colors_dir) // """ or in another directory,", &
             "the path, relative to """ // trim(colors_dir) // &
             """ or absolute, must be present.)"
        write(*, "(a)") "Default: """ // trim(colors_file_def) // """"
     else
        write(*, "(a)") "Type the name of the output file of ""colors"" &
             &or press the <RETURN>/<ENTER> key to stop."
     endif
     read(*, "(a)") colors_file
     colors_file = adjustl(unquote_string(colors_file))
     if (colors_file == "") then
        if (first_time) then
           colors_file = colors_file_def
        else
           write(*, "(a)") "Stopped."
           stop
        endif
     endif
     call file_name_components(file_name=colors_file, path=colors_dir, &
          full_name=colors_full_name, dir_name=colors_dir_name, &
          base_name=colors_base_name, dir_sep=dir_sep)
     inquire(file = colors_full_name, exist=exist)
     if (.not.exist) then
        call open_file(unit_colors, colors_full_name, status = "new")
        exit
     else
        write(*, "(a)") "File """ // trim(colors_base_name) // &
             """ already exists in """ // trim(colors_dir_name) // &
             """. Do you want to overwrite it?"
        call boolean_answer(overwrite)
        if (overwrite) then
           call open_file(unit_colors, colors_full_name, &
                status = "replace")
           exit
        endif
        first_time = .false.
     endif
  end do

  write(unit_colors, "(a)") quote_string(version_id) // " !# `version_id`."
  write(unit_colors, "(a)") quote_string(version_date) // " !# `version_date`."
  write(unit_colors, "(a)") "!# Code ""colors"" executed at " // trim(run_begin_time) // "."     
  write(unit_colors, "(a)") "!# Compiler for ""colors"": " // trim(compiler) // "."
  write(unit_colors, "(a)") "!# `spectra_file` = " // &
       quote_string(spectra_file_name) // "."


!# Read the outputs of "spectra".

  call read_spectra_output(spectra_file_name, data)
  dim_output_age = data % dim_output_age
  if (associated(output_age)) deallocate(output_age)
  allocate(output_age(dim_output_age))
  output_age(:) = data % output_age(:)
  dim_elem = data % dim_elem
  dim_cont = data % dim_cont
  dim_line = data % dim_line

!# Create the hash table for ISM abundances of elements.

  call create_hash_table(data % elem_id(:), hash_elem, dim_hash_elem)  
  allocate(ISM_abund_aux(dim_output_age, dim_elem))
  do i_output_age = 1, dim_output_age
     do i_elem = 1, dim_elem
        ISM_abund_aux(i_output_age, i_elem) = data % ISM_abund(i_output_age, i_elem)
     enddo
  enddo

!# Create the hash table for emission lines.

  call create_hash_table(data % line_id(:), hash_line, dim_hash_line)

  allocate(D4000(dim_output_age))
  allocate(Dn4000(dim_output_age))
  allocate(M_bol(dim_output_age))
  allocate(pos_line(dim_line))
  allocate(L_line_aux(dim_output_age, dim_line))
  allocate(eq_width_aux(dim_output_age, dim_line))
  allocate(lum_band_aux(dim_output_age, dim_filter))
  allocate(magnit_aux(dim_output_age, dim_filter))

!# Find the index of the continuum wavelength just below the wavelength of the emission line.
!# ??? Should one do it in "spectra"?
  do i_line = 1, dim_line
     if ((data % lambda_line(i_line)-data % lambda_cont(1)) * &
          (data % lambda_line(i_line)-data % lambda_cont(dim_cont)) < 0) &
          then
        i_cont = 1
        do while (data % lambda_cont(i_cont) < data % lambda_line(i_line))
           i_cont = i_cont+1
        end do
        pos_line(i_line) = i_cont-1
     else
        pos_line(i_line) = 0
     end if
  end do

  do i_output_age = 1, dim_output_age
!# Equivalent width.
!# !!! Absorption in the continuum is not taken into account.
     do i_line = 1, dim_line
        L_line_aux(i_output_age, i_line) = data % L_line(i_output_age, i_line)
        if (pos_line(i_line) /= 0 .and. data % lum_cont(i_output_age,pos_line(i_line)) > 0) then
           eq_width_aux(i_output_age, i_line) = L_line_aux(i_output_age,i_line)/interp_lin_lin( &
                data % lambda_cont(pos_line(i_line)), &
                data % lambda_cont(pos_line(i_line)+1), &
                data % lum_cont(i_output_age, pos_line(i_line)), &
                data % lum_cont(i_output_age, pos_line(i_line)+1), &
                data % lambda_line(i_line))
        else
           eq_width_aux(i_output_age, i_line) = 0
        end if
     end do

     if (data % L_bol(i_output_age) > 0) then
        M_bol(i_output_age) = M_bol_Sun - 2.5_DPR*log10(data % L_bol(i_output_age))
     else
        M_bol(i_output_age) = 0
     endif

     do i_filter = 1, dim_filter
        if (filter(i_filter) % calib_type == "D4000") then
           lum_band_aux(i_output_age, i_filter) = flux_band(filter(i_filter), &
                dim_cont, real(data % lambda_cont, DPR), &
                real(data % lum_cont(i_output_age,:), DPR) * &
                data % lambda_cont**2, &             
                dim_line = dim_line, &
                lambda_line = real(data % lambda_line, DPR), &
                L_line = real(data % L_line(i_output_age,:), DPR) * &
                data % lambda_line**2) &
                / c_ang / filter_norm(i_filter)
        else
           lum_band_aux(i_output_age, i_filter) = flux_band(filter(i_filter), &
                dim_cont, real(data % lambda_cont, DPR), &
                real(data % lum_cont(i_output_age,:), DPR), &             
                dim_line = dim_line, &
                lambda_line = real(data % lambda_line, DPR), &
                L_line = real(data % L_line(i_output_age,:), DPR))/filter_norm(i_filter)
        endif
     enddo

     do i_filter = 1, dim_filter
        if (lum_band_aux(i_output_age, i_filter) > 0 .and. calib(i_filter) /= undefined_mag) then
           magnit_aux(i_output_age, i_filter) = -2.5_DPR*log10(lum_band_aux(i_output_age, i_filter)/area_10pc) &
                + calib(i_filter)
        else
           magnit_aux(i_output_age,i_filter) = undefined_mag
        end if
     end do

!# 4000A break index (Bruzual 1983) in the object's frame.

     if (lum_band(i_output_age, "D4000-") > 0 .and. lum_band(i_output_age, "D4000+") > 0) then
        D4000(i_output_age) = lum_band(i_output_age, "D4000+")/ &
             lum_band(i_output_age, "D4000-")
     end if

!# 4000A break narrow index (Balogh et al. 1999) in the object's frame.

     if (lum_band(i_output_age, "Dn4000-") > 0 .and. lum_band(i_output_age, "Dn4000+") > 0) then
        Dn4000(i_output_age) = lum_band(i_output_age, "Dn4000+")/ &
             lum_band(i_output_age, "Dn4000-")
     end if
  end do

!#----------------------------------------------------------------------
!# Outputs: {

  include "incl_colors.f90"

!# } :Outputs.
!#----------------------------------------------------------------------

  call close_file(unit_colors)
  deallocate(D4000, M_bol, Dn4000, pos_line, L_line_aux, eq_width_aux, lum_band_aux, magnit_aux, ISM_abund_aux)
  call delete_hash_table(hash_filter)
  call delete_hash_table(hash_line)
  call delete_hash_table(hash_elem)
  
end program colors
