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

program plot_spectra

  use mod_read_spectra_output
  use mod_types
  use mod_directories, only : spectra_dir
  use mod_select_file, only : select_several_files
  use mod_constants, only : spectra_list, pi, c_cm
  use mod_interp, only : bracket, interp_log_log
  use mod_convert_type

  implicit none
!#......................................................................
  character(std_string), dimension(:), pointer :: file_name => null()
  type(struct_spectra_output), dimension(:), allocatable :: data
  real :: x_min, x_max
  real(DPR) :: y_min, y_max
  real, dimension(:), allocatable :: x_max_file, x_min_file
  real(DPR), dimension(:), allocatable :: y_max_file, y_min_file
  integer :: i_cont, i_time, dim_file, i_file
  real, parameter :: bottom_margin = 0, top_margin = 0.1
  real :: tmp
  character(std_string) :: string
  integer, dimension(10), parameter :: color = (/1, 2, 3, 4, 5, 6, 7, 8, 9, 10/)
  integer, dimension(5), parameter :: line_style = (/1, 2, 3, 4, 5/)
  integer, dimension(1), parameter :: line_width = (/1/)
  logical :: erase
  integer :: pos_token, i_line

!# For the plot, emission lines are assumed to have a Gaussian profile 
!# with standard deviation `sigma` (in angstroems). Only the peak of lines 
!# is plotted.
!# Default full width at half-maximum, in km/s, from Mocz et al. (2012; 
!# MNRAS 425, 296):
  real(DPR), parameter :: FWHM_v_def = 10**2.2_DPR
!# Speed of light in km/s:
  real(DPR), parameter :: c_km = c_cm/1.e5_DPR
  real(DPR) :: sigma, FWHM_v
  integer :: error

  integer :: dim_time, dim_cont, dim_line, pos_line
  type struct_plot
     real, dimension(:), pointer :: x_cont => null(), x_line => null()
     real(DPR), dimension(:,:), pointer :: y_cont => null()
     real(DPR), dimension(:,:), pointer :: y_line_bottom => null()
     real(DPR), dimension(:,:), pointer :: y_line_top => null()
  end type struct_plot
  type(struct_plot), dimension(:), allocatable :: plotted
!#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

  write(*, "(a/)") "Possible input files (files of spectra):"
  call select_several_files(dir = spectra_dir, list = spectra_list, &
       selected_file = file_name, n_selected_files = dim_file, &
       back = .true.)

  if (dim_file == 0) stop

  write(*,*) "Reading files..."
  allocate(data(dim_file))
  do i_file = 1, dim_file
     call read_spectra_output(file_name(i_file), data(i_file))
  enddo

  dim_time = data(1) % dim_output_age
  dim_cont = data(1) % dim_cont
  dim_line = data(1) % dim_line

  allocate(plotted(dim_file))
  do i_file = 1, dim_file
     if (associated(plotted(i_file) % x_cont)) deallocate(plotted(i_file) % x_cont)
     allocate(plotted(i_file) % x_cont(data(i_file) % dim_cont))

     if (associated(plotted(i_file) % x_line)) deallocate(plotted(i_file) % x_line)
     allocate(plotted(i_file) % x_line(data(i_file) % dim_line))

     if (associated(plotted(i_file) % y_cont)) deallocate(plotted(i_file) % y_cont)
     allocate(plotted(i_file) % y_cont(data(i_file) % dim_output_age, &
          data(i_file) % dim_cont))

     if (associated(plotted(i_file) % y_line_bottom)) deallocate(plotted(i_file) % y_line_bottom)
     allocate(plotted(i_file) % y_line_bottom(data(i_file) % dim_output_age, &
          data(i_file) % dim_line))

     if (associated(plotted(i_file) % y_line_top)) deallocate(plotted(i_file) % y_line_top)
     allocate(plotted(i_file) % y_line_top(data(i_file) % dim_output_age, &
          data(i_file) % dim_line))
  enddo

  if (any(data(2:) % dim_output_age /= dim_time)) then
     write(*,*) "Warning: `dim_output_age` is not the same for all files."
  else 
     do i_file = 2, dim_file
        if (any(data(i_file) % output_age /= data(1) % output_age)) then
           write(*,*) "Warning: not the same `output_age` for all files."
           exit
        endif
     enddo
  endif

  if (any(data(2:) % dim_cont /= dim_cont)) then
     write(*,*) "Warning: `dim_cont` is not the same for all files."
  else 
     do i_file = 2, dim_file
        if (any(data(i_file) % lambda_cont /= data(1) % lambda_cont)) then
           write(*,*) "Warning: not the same `lambda_cont` for all files."
           exit
        endif
     enddo
  endif

  if (any(data(2:) % dim_line /= dim_line)) then
     write(*,*) "Warning: `dim_line` is not the same for all files."
  else
     do i_file = 2, dim_file
        if (any(data(i_file) % lambda_line /= data(1) % lambda_line)) then
           write(*,*) "Warning: not the same `lambda_line` for all files."
           exit
        endif
     enddo
  endif

  write(*,"(/a)") "Full width at half-maximum, in km/s, used to &
       &represent emission lines?"
  write(*,"(a, es8.2, a)") "Default: ", FWHM_v_def, " km/s."
  write(*,"(a)") "Press the <RETURN>/<ENTER> key to select the default &
       &value or provide a number."
  do 
     read(*, "(a)") string !# Not `read(*, *) string`!
     if (string /= "") then
        read(string, *, iostat = error) FWHM_v
        if (FWHM_v <= 0) error = 1
     else
        error = 0
        FWHM_v = FWHM_v_def
     end if
     if (error == 0) exit
     write(*, "(a)") "Invalid input!"
  enddo

  do i_file = 1, dim_file
     do i_cont = 1, data(i_file) % dim_cont
        plotted(i_file) % y_cont(:,i_cont) = &
             data(i_file) % lum_cont(:,i_cont) &
             * data(i_file) % lambda_cont(i_cont)
     enddo
     
     do i_line = 1, data(i_file) % dim_line
        pos_line = 0
        call bracket(data(i_file) % dim_cont, data(i_file) % lambda_cont(:), &
             data(i_file) % lambda_line(i_line), &
             pos_line)
        sigma = data(i_file) % lambda_line(i_line)* &
             FWHM_v/(2*sqrt(2*log(2._DPR)))/c_km
        do i_time = 1, data(i_file) % dim_output_age
           plotted(i_file) % y_line_bottom(i_time, i_line) = interp_log_log( &
                data(i_file) % lambda_cont(pos_line), &
                data(i_file) % lambda_cont(pos_line+1), &
                data(i_file) % lambda_cont(pos_line) * &
                data(i_file) % lum_cont(i_time, pos_line), &
                data(i_file) % lambda_cont(pos_line+1) * &
                data(i_file) % lum_cont(i_time, pos_line+1), &
                data(i_file) % lambda_line(i_line))
           plotted(i_file) % y_line_top(i_time, i_line) = &
                plotted(i_file) % y_line_bottom(i_time, i_line) + &
                data(i_file) % lambda_line(i_line) * &
                data(i_file) % L_line(i_time, i_line) / (sqrt(2*pi)*sigma)
        enddo
     enddo
  enddo

  allocate(x_max_file(dim_file))
  allocate(x_min_file(dim_file))
  allocate(y_max_file(dim_file))
  allocate(y_min_file(dim_file))

  do i_file = 1, dim_file
     y_max_file(i_file) = max(maxval(plotted(i_file) % y_cont(:, :)), &
          maxval(plotted(i_file) % y_line_top(:, :)))
     y_min_file(i_file) = minval(plotted(i_file) % y_cont(:, :), &
          mask = plotted(i_file) % y_cont(:, :) > tiny(1.))
  enddo
  y_max = log10(maxval(y_max_file(1:dim_file)))
  y_min = minval(y_min_file(1:dim_file))

  do i_file = 1, dim_file
     plotted(i_file) % x_cont(:) = log10(data(i_file) % lambda_cont(:))
     plotted(i_file) % x_line(:) = log10(data(i_file) % lambda_line(:))
     plotted(i_file) % y_cont(:, :) = &
          log10(max(plotted(i_file) % y_cont(:, :), y_min))
     plotted(i_file) % y_line_bottom(:, :) = &
          log10(plotted(i_file) % y_line_bottom(:, :))
     plotted(i_file) % y_line_top(:, :) = &
          log10(plotted(i_file) % y_line_top(:, :))
  enddo
  y_min = log10(y_min)

  do i_file = 1, dim_file
     x_max_file(i_file) = maxval(plotted(i_file) % x_cont(:))
     x_min_file(i_file) = minval(plotted(i_file) % x_cont(:))
  enddo
  x_max = maxval(x_max_file(:))
  x_min = minval(x_min_file(:))

  write(*, "(/a)") "x-axis: log_10(lambda/angstroem)."
  write(*, "(a)") "y-axis: log_10(lambda L_lambda/[erg s^-1/M_sys])."
  write(*, "(a)") "Default values of `x_min`, `x_max`, `y_min`, `y_max`:"
  write(*,*) x_min, x_max, y_min, y_max
  write(*, "(a)") "Enter modified values separated by commas. &
       &An empty value is unchanged."
  write(*, "(a)") "Press the <RETURN>/<ENTER> key after the last modified value &
       &to keep the remaining ones unchanged."
  read(*, "(a)") string !# Not `read(*,*) string`.
  string = adjustl(string)
  if (string /= "") then
     if (string(1:1) /= ",") then
        read(string,*) x_min
     endif
     pos_token = index(string, ",")
     if (pos_token /= 0) then
        string = adjustl(string(pos_token+1:))
        if (string(1:1) /= ",") then
           read(string,*) x_max
        endif
        pos_token = index(string, ",")
        if (pos_token /= 0) then
           string = adjustl(string(pos_token+1:))
           if (string(1:1) /= ",") then
              read(string,*) y_min
           endif
           pos_token = index(string, ",")
           if (pos_token /= 0) then
              string = adjustl(string(pos_token+1:))
              if (string /= "") then
                 read(string,*) y_max
              endif
           endif
        endif
     endif
  endif

  write(*, "(/a)") "Erase after each age?"
  call boolean_answer(erase, .true.)

  tmp = y_min
  y_min = (1.+bottom_margin)*y_min - bottom_margin*y_max
  y_max = -top_margin*tmp + (1.+top_margin)*y_max
  call pgbeg(0, "?", 1, 1) !# Enter pgplot.
  call pgask(.false.) !# Do not ask for confirmation when beginning an new plot.
  do i_time = 1, dim_time
     call pgsci(1) !# Color used for axes ("1" -> black).
     call pgsls(1) !# Line style for axes ("1" -> solid).
     call pgslw(1) !# Line width for axes.
     call pgscf(2) !# Default font ("2" -> serif, upright).
     call pgsch(1.) !# Size of characters.
     if (erase) then
        call pgenv(x_min, x_max, real(y_min), real(y_max), 0, 10) !# Plot's \
!# frame. "10" -> log scale along x-axis.
        call pglabel("\gl/\A", & !# x-axis label.
             "log\d10\u(\gl \fiL\fr\d\gl\u/[erg s\u-1\d/M\dsys\u])", & !# y-axis label.
             "Age = " // to_string(data(1) % output_age(i_time)) // " Myr") !# General label.
     else if (i_time == 1) then
        call pgenv(x_min, x_max, real(y_min), real(y_max), 0, 10)
        call pglabel("\gl/\A", &
             "log\d10\u(\gl \fiL\fr\d\gl\u/[erg s\u-1\d/\fiM\fr\dsys\u])", "")
     endif
     if (.not.erase) write(*,*) data(1) % output_age(i_time)
     do i_file = 1, dim_file
        call pgsci(color(mod(i_file-1, size(color))+1)) !# Color of the SED.
!# Uncomment the line "call pgsls[...]" below to change the style 
!# (dashed, etc.) of the SED for each file:
!        call pgsls(line_style(mod(i_file-1, size(line_style))+1))
        call pgslw(line_width(mod(i_file-1, size(line_width))+1)) !# Line width of the SED.
        call pgline(data(i_file) % dim_cont, plotted(i_file) % x_cont(:), &
             real(plotted(i_file) % y_cont(i_time, :))) !# Plot the SED.
!# Plot emission lines as vertical segments:
        do i_line = 1, data(i_file) % dim_line
           call pgmove(plotted(i_file) % x_line(i_line), &
                real(plotted(i_file) % y_line_bottom(i_time, i_line))) 
           call pgdraw(plotted(i_file) % x_line(i_line), &
                real(plotted(i_file) % y_line_top(i_time, i_line)))
!# Draw a small horizontal tick to see the top of the emission line 
!# if several SEDS are plotted and the height of the line is large enough:
           if ((dim_file > 1 .or. .not.erase) .and. &
              plotted(i_file) % y_line_top(i_time, i_line) - &
              plotted(i_file) % y_line_bottom(i_time, i_line) > &
              (y_max-y_min)/100) then
              call pgerr1(2, plotted(i_file) % x_line(i_line), &
                   real(plotted(i_file) % y_line_top(i_time, i_line)), 0., 1.)
           endif
        enddo
     enddo
     write(*, "(a)") "Press the <RETURN>/<ENTER> key to jump to the next time."
     read(*,*)
  enddo
  call pgend
  
end program plot_spectra
