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

  use mod_types
  use mod_hash
  use mod_colors, only : dim_output_age
  use mod_filters_constants, only : undefined_mag

  implicit none
  private
  interface magnit
     module procedure magnit_scal, magnit_arr
  end interface magnit
  interface lum_band
     module procedure lum_band_scal, lum_band_arr
  end interface lum_band
  interface lum_band_rel_Sun
     module procedure lum_band_rel_Sun_scal, lum_band_rel_Sun_arr
  end interface lum_band_rel_Sun
  interface color
     module procedure color_scal, color_arr
  end interface color
  interface L_line
     module procedure L_line_scal, L_line_arr
  end interface L_line
  interface eq_width
     module procedure eq_width_scal, eq_width_arr
  end interface eq_width
  interface ISM_abund
     module procedure ISM_abund_scal, ISM_abund_arr
  end interface ISM_abund

  type(struct_hash), dimension(:), pointer, save :: hash_filter => null()
  integer, save :: dim_hash_filter

  type(struct_hash), dimension(:), pointer, save :: hash_line => null()
  integer, save :: dim_hash_line

  type(struct_hash), dimension(:), pointer, save :: hash_elem => null()
  integer, save :: dim_hash_elem

  real(DPR), dimension(:,:), allocatable, save :: magnit_aux !# Absolute magnitude.
  real(DPR), dimension(:,:), allocatable, save :: lum_band_aux
  real(DPR), dimension(:,:), allocatable, save :: L_line_aux
  real(DPR), dimension(:,:), allocatable, save :: eq_width_aux
  real(DPR), dimension(:,:), allocatable, save :: ISM_abund_aux

  real(DPR), dimension(:), allocatable, save :: lum_band_Sun
  public :: magnit, lum_band, lum_band_rel_Sun, color, L_line, eq_width, ISM_abund, &
       hash_filter, dim_hash_filter, hash_line, dim_hash_line, hash_elem, dim_hash_elem, &
       magnit_aux, lum_band_aux, lum_band_Sun, L_line_aux, eq_width_aux, ISM_abund_aux

contains

!#======================================================================
  
  function magnit_scal(i_output_age, filter_id)

    implicit none
    character(len=*), intent(in) :: filter_id
    integer, intent(in) :: i_output_age
    real(DPR) :: magnit_scal
!#......................................................................
    integer :: i_filter
    logical :: failed
!#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
    
    i_filter = hash_index(filter_id, hash_filter, failed)
    if (failed) then
       write(*,"(a)") """" // trim(filter_id) // &
            """: this identifier does not correspond to any filter. Stopped."
       stop
    endif
    magnit_scal = magnit_aux(i_output_age, i_filter)

  end function magnit_scal

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

  function magnit_arr(filter_id)

    implicit none
    character(len=*), intent(in) :: filter_id
    real(DPR), dimension(dim_output_age) :: magnit_arr
!#......................................................................
    integer :: i_filter
    logical :: failed
!#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
    
    i_filter = hash_index(filter_id, hash_filter, failed)
        if (failed) then
       write(*,"(a)") """" // trim(filter_id) // &
            """: this identifier does not correspond to any filter. Stopped."
       stop
    endif
    magnit_arr(1:dim_output_age) = magnit_aux(1:dim_output_age, i_filter)

  end function magnit_arr

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

  function lum_band_scal(i_output_age, filter_id)

    implicit none
    character(len=*), intent(in) :: filter_id
    integer, intent(in) :: i_output_age
    real(DPR) :: lum_band_scal
!#......................................................................
    integer :: i_filter
    logical :: failed
!#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
    
    i_filter = hash_index(filter_id, hash_filter, failed)
    if (failed) then
       write(*,"(a)") """" // trim(filter_id) // &
            """: this identifier does not correspond to any filter. Stopped."
       stop
    endif
    lum_band_scal = lum_band_aux(i_output_age, i_filter)

  end function lum_band_scal

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

  function lum_band_arr(filter_id)

    implicit none
    character(len=*), intent(in) :: filter_id
    real(DPR), dimension(dim_output_age) :: lum_band_arr
!#......................................................................
    integer :: i_filter
    logical :: failed
!#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
    
    i_filter = hash_index(filter_id, hash_filter, failed)
    if (failed) then
       write(*,"(a)") """" // trim(filter_id) // &
            """: this identifier does not correspond to any filter. Stopped."
       stop
    endif
    lum_band_arr(1:dim_output_age) = lum_band_aux(1:dim_output_age, i_filter)

  end function lum_band_arr

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

  function lum_band_rel_Sun_scal(i_output_age, filter_id)

    implicit none
    character(len=*), intent(in) :: filter_id
    integer, intent(in) :: i_output_age
    real(DPR) :: lum_band_rel_Sun_scal
!#......................................................................
    integer :: i_filter
    logical :: failed
!#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::  

    i_filter = hash_index(filter_id, hash_filter, failed)
    if (failed) then
       write(*,"(a)") """" // trim(filter_id) // &
            """: this identifier does not correspond to any filter. Stopped."
       stop
    endif
    lum_band_rel_Sun_scal = lum_band_aux(i_output_age, i_filter)/lum_band_Sun(i_filter)

  end function lum_band_rel_Sun_scal

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

  function lum_band_rel_Sun_arr(filter_id)

    implicit none
    character(len=*), intent(in) :: filter_id
    real(DPR), dimension(dim_output_age) :: lum_band_rel_Sun_arr
!#......................................................................
    integer :: i_filter
    logical :: failed
!#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
    
    i_filter = hash_index(filter_id, hash_filter, failed)
    if (failed) then
       write(*,"(a)") """" // trim(filter_id) // &
            """: this identifier does not correspond to any filter. Stopped."
       stop
    endif
    lum_band_rel_Sun_arr(1:dim_output_age) = lum_band_aux(1:dim_output_age, i_filter)/lum_band_Sun(i_filter)

  end function lum_band_rel_Sun_arr

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

  function color_scal(i_output_age, filter1_id, filter2_id)

    implicit none
    character(len=*), intent(in) :: filter1_id, filter2_id
    integer, intent(in) :: i_output_age
    real(DPR) :: color_scal
!#......................................................................
    integer :: i_filter1, i_filter2
    logical :: failed
!#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

    i_filter1 = hash_index(filter1_id, hash_filter, failed)
    if (failed) then
       write(*,"(a)") """" // trim(filter1_id) // &
            """: this identifier does not correspond to any filter. Stopped."
       stop
    endif

    i_filter2 = hash_index(filter2_id, hash_filter, failed)
    if (failed) then
       write(*,"(a)") """" // trim(filter2_id) // &
            """: this identifier does not correspond to any filter. Stopped."
       stop
    endif

    if (magnit_aux(i_output_age, i_filter1) /= undefined_mag .and. &
         magnit_aux(i_output_age, i_filter2) /= undefined_mag) then
       color_scal = magnit_aux(i_output_age, i_filter1) - magnit_aux(i_output_age, i_filter2)
    else
       color_scal = undefined_mag
    endif

  end function color_scal

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

  function color_arr(filter1_id, filter2_id)

    implicit none
    character(len=*), intent(in) :: filter1_id, filter2_id
    real(DPR), dimension(dim_output_age) :: color_arr
!#......................................................................
    integer :: i_filter1, i_filter2
    logical :: failed
!#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
    
    i_filter1 = hash_index(filter1_id, hash_filter, failed)
    if (failed) then
       write(*,"(a)") """" // trim(filter1_id) // &
            """: this identifier does not correspond to any filter. Stopped."
       stop
    endif

    i_filter2 = hash_index(filter2_id, hash_filter, failed)
    if (failed) then
       write(*,"(a)") """" // trim(filter2_id) // &
            """: this identifier does not correspond to any filter. Stopped."
       stop
    endif

    where (magnit_aux(:, i_filter1) /= undefined_mag .and. magnit_aux(:, i_filter2) /= undefined_mag)
       color_arr(:) = magnit_aux(:, i_filter1) - magnit_aux(:, i_filter2)
    elsewhere
       color_arr(:) = undefined_mag
    end where

  end function color_arr

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

  function L_line_scal(i_output_age, line_id)

    implicit none
    character(len=*), intent(in) :: line_id
    integer, intent(in) :: i_output_age
    real(DPR) :: L_line_scal
!#......................................................................
    integer :: i_line
    logical :: failed
!#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

    i_line = hash_index(line_id, hash_line, failed)
    if (failed) then
       write(*,"(a)") """" // trim(line_id) // &
            """: this identifier does not correspond to any emission line. Stopped."
       stop
    endif
    L_line_scal = L_line_aux(i_output_age, i_line)

  end function L_line_scal

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

  function L_line_arr(line_id)

    implicit none
    character(len=*), intent(in) :: line_id
    real(DPR), dimension(dim_output_age) :: L_line_arr
!#......................................................................
    integer :: i_line
    logical :: failed
!#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

    i_line = hash_index(line_id, hash_line, failed)
    if (failed) then
       write(*,"(a)") """" // trim(line_id) // &
            """: this identifier does not correspond to any emission line. Stopped."
       stop
    endif
    L_line_arr(1:dim_output_age) = L_line_aux(1:dim_output_age, i_line)

  end function L_line_arr

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

  function eq_width_scal(i_output_age, line_id)

    implicit none
    character(len=*), intent(in) :: line_id
    integer, intent(in) :: i_output_age
    real(DPR) :: eq_width_scal
!#......................................................................
    integer :: i_line
    logical :: failed
!#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

    i_line = hash_index(line_id, hash_line, failed)
    if (failed) then
       write(*,"(a)") """" // trim(line_id) // &
            """: this identifier does not correspond to any emission line. Stopped."
       stop
    endif
    eq_width_scal = eq_width_aux(i_output_age, i_line)

  end function eq_width_scal

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

  function eq_width_arr(line_id)

    implicit none
    character(len=*), intent(in) :: line_id
    real(DPR), dimension(dim_output_age) :: eq_width_arr
!#......................................................................
    integer :: i_line
    logical :: failed
!#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

    i_line = hash_index(line_id, hash_line, failed)
    if (failed) then
       write(*,"(a)") """" // trim(line_id) // &
            """: this identifier does not correspond to any emission line. Stopped."
       stop
    endif
    eq_width_arr(1:dim_output_age) = eq_width_aux(1:dim_output_age, i_line)

  end function eq_width_arr

!#======================================================================
  
  function ISM_abund_scal(i_output_age, elem_id)

    implicit none
    character(len=*), intent(in) :: elem_id
    integer, intent(in) :: i_output_age
    real(DPR) :: ISM_abund_scal
!#......................................................................
    integer :: i_elem
    logical :: failed
!#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
    
    i_elem = hash_index(elem_id, hash_elem, failed)
    if (failed) then
       write(*,"(a)") """" // trim(elem_id) // &
            """: this identifier does not correspond to any element. Stopped."
       stop
    endif
    ISM_abund_scal = ISM_abund_aux(i_output_age, i_elem)

  end function ISM_abund_scal

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

  function ISM_abund_arr(elem_id)

    implicit none
    character(len=*), intent(in) :: elem_id
    real(DPR), dimension(dim_output_age) :: ISM_abund_arr
!#......................................................................
    integer :: i_elem
    logical :: failed
!#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

    i_elem = hash_index(elem_id, hash_elem, failed)
    if (failed) then
       write(*,"(a)") """" // trim(elem_id) // &
            """: this identifier does not correspond to any element. Stopped."
       stop
    endif
    ISM_abund_arr(1:dim_output_age) = ISM_abund_aux(1:dim_output_age, i_elem)

  end function ISM_abund_arr

end module mod_magnit
