!# 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 calib
  
  use mod_types
  use mod_directories, only : calib_dir, bin_dir
  use mod_file_access, only : open_file, close_file, path_file
  use mod_constants, only : c_ang, area_10pc
  use mod_filters_constants, only : filters_list, undefined_mag, std_Vega_def, &
       Vega_SED_file, Sun_SED_file, TG_SED_file
  use mod_filters, only : struct_filter, read_filters, flux_band
  use mod_calib, only : format_output, unit_calib, fmt
  use mod_strings, only : quote_string
  use mod_code_version, only : version_id, version_date
  use mod_compiler, only : compiler
  use mod_convert_type, only : to_string
  use mod_ISO_8601, only : ISO_8601

  implicit none
!#......................................................................
  type(struct_filter), dimension(:), pointer :: filter => null()
  integer :: dim_lambda_Vega, dim_filter, dim_lambda_TG, dim_lambda_Sun
  real(DPR) :: filter_norm, lambda_mean, area_nu, lambda_pivot, area_lambda
  real(DPR) :: flux_band_Vega, lambda_eff_Vega, flux_band_TG, AB_Vega, TG_Vega, &
       lum_band_Sun, flux_band_Vega_unnorm, mag_abs_Sun, filter_width, &
       std_Vega, calibration
  real(DPR), dimension(:), allocatable :: irrad_Vega, lambda_Vega, &
       lambda_TG, flux_TG, lambda_Sun, lum_Sun
  integer :: unit_Vega, unit_Sun, unit_TG
  integer :: i_filter, i_lambda
  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_calib.txt"))
  read(unit_compiler,*) compiler
  call close_file(unit_compiler)

!# Read the spectrum of Vega.
  
  call open_file(unit_Vega, path_file(calib_dir, Vega_SED_file))
  read(unit_Vega, *) dim_lambda_Vega
  allocate(lambda_Vega(dim_lambda_Vega))
  allocate(irrad_Vega(dim_lambda_Vega))
  do i_lambda = 1, dim_lambda_Vega
     read(unit_Vega, *) lambda_Vega(i_lambda), irrad_Vega(i_lambda) 
  end do
  call close_file(unit_Vega)
  
!# Read the spectrum of the Sun.
 
  call open_file(unit_Sun, path_file(calib_dir, Sun_SED_file))
!# Intrinsic flux: erg/s/A.
  read(unit_Sun, *) dim_lambda_Sun
  allocate(lambda_Sun(dim_lambda_Sun))
  allocate(lum_Sun(dim_lambda_Sun))
  do i_lambda = 1, dim_lambda_Sun
     read(unit_Sun, *) lambda_Sun(i_lambda), lum_Sun(i_lambda) 
  end do
  call close_file(unit_Sun)
  
!# Read the spectrum of BD+17o4708 (F subdwarf used to calibrate the 
!# Thuan & Gunn system).
  
  call open_file(unit_TG, path_file(calib_dir, TG_SED_file))
  read(unit_TG, *) dim_lambda_TG
  allocate(lambda_TG(dim_lambda_TG))
  allocate(flux_TG(dim_lambda_TG))
  do i_lambda = 1, dim_lambda_TG
     read(unit_TG, *) lambda_TG(i_lambda), flux_TG(i_lambda) 
  end do
  call close_file(unit_TG)
  
!# Read the transmissions of the filters.
  
  call read_filters(path_file(calib_dir, filters_list), dim_filter, filter)

  call open_file(unit_calib, path_file(calib_dir, "calib.txt"), &
       status = "replace")
  write(unit_calib, "(a)") quote_string(version_id) // " !# `version_id`." 
  write(unit_calib, "(a)") quote_string(version_date) // " !# `version_date`." 
  write(unit_calib, "(a)") "!# Code ""calib"" executed at " // trim(run_begin_time) // "."     
  write(unit_calib, "(a)") "!# Compiler for ""calib"": " // trim(compiler) // "."

  call format_output("!# filter_id", "a" // to_string(maxval(len_trim(filter(:) % id)) + 2))
  call format_output("i_filter", "i3")
  call format_output("flux_band_Vega", "es9.3")
  call format_output("filter_norm", "es9.3")
  call format_output("lambda_mean", "es9.3")
  call format_output("lambda_eff_Vega", "es9.3")
  call format_output("AB_Vega", "f8.3")
  call format_output("TG_Vega", "f8.3")
  call format_output("lum_band_Sun", "es9.3")
  call format_output("mag_abs_Sun", "f8.3")
  call format_output("lambda_pivot", "es9.3")
  call format_output("filter_width", "es9.3")
  call format_output("calib_type", "a7")

  fmt = "(" // trim(fmt) // ")"
  write(unit_calib,*)

!# Computation of the areas, mean and effective wavelengths, AB-magnitudes 
!# of Vega and calibration constants of the filters.
 
  do i_filter = 1, dim_filter
!# In what follows, we use the notations of Bessel & Murphy (2012, PASP 124, 140; BM2012):
!# -- $S'(\lambda)$ is the system (filter + detector) **energy** response fonction; 
!# -- $S(\lambda)$ is the system **photon** response function.
!# One has $S'(\lambda) = \lambda S(\lambda)$, up to some disappearing constant factor.

!#----------------------------------------------------------------------
     
     area_lambda = flux_band(filter(i_filter), filter(i_filter) % dim_lambda, &
          filter(i_filter) % lambda(:), spread(1._DPR, 1, filter(i_filter) % dim_lambda))

!# Compute `filter_norm`.
     if (filter(i_filter) % calib_type == "IRAS") then
!# The IRAS photometric system is designed in such a way that, for an 
!# $f_\lambda \propto \lambda^{-1}$ (<=> $f_\nu \propto \nu^{-1}$) spectrum, 
!# one has
!#
!#    $\int{f_\lambda S'(\lambda) d\lambda}/`filter_norm` = f_{\lambda_0}$, 
!#
!# where $\lambda_0 = 12, 25, 60, 100 {\mu}m$.

        filter_norm = flux_band(filter(i_filter), filter(i_filter) % dim_lambda, &
             filter(i_filter) % lambda(:), &
             filter(i_filter) % lambda_nom / filter(i_filter) % lambda(:))

     else
!# `filter_norm` = $\int{S'(\lambda) d\lambda}$.

        filter_norm = area_lambda
     endif

!#----------------------------------------------------------------------
!# Mean wavelength
!# `lambda_mean` = $\int{\lambda S'(\lambda) d\lambda} / \int{S'(\lambda) d\lambda}$.
!# (= $\lambda'_0$, not $\lambda_0$, in BM2012.)
     lambda_mean = flux_band(filter(i_filter), filter(i_filter) % dim_lambda, &
          filter(i_filter) % lambda(:), filter(i_filter) % lambda(:)) / area_lambda

!#----------------------------------------------------------------------
!# Filter's width:
!# `filter_width`**2 = $\int{(\lambda - `lambda_mean`)^2 S'(\lambda) d\lambda} / \int{S'(\lambda) d\lambda}$.
!# Note: Koornneef et al. (1986, HiA 7, 833) define it as the standard deviation 
!# around $\lambda_0$, not $\lambda'_0$, and with "S'(\lambda)" replaced by "S(\lambda)".

     filter_width = sqrt(flux_band(filter(i_filter), filter(i_filter) % dim_lambda, &
          filter(i_filter) % lambda(:), (filter(i_filter) % lambda(:) - lambda_mean)**2) / area_lambda)

!#----------------------------------------------------------------------
!# Pivot wavelength
!# `lambda_pivot`**2 = $\int{\lambda S(\lambda) d\lambda} / \int{1/\lambda S(\lambda) d\lambda}$.
!#                   = $\int{S'(\lambda) d\lambda} / \int{1/\lambda^2 S'(\lambda) d\lambda}$.
!#
!# Note: <$f_\nu$> = <$f_\lambda$> * $`lambda_pivot`^2/c$.

     lambda_pivot = sqrt(flux_band(filter(i_filter), filter(i_filter) % dim_lambda, &
          filter(i_filter) % lambda(:), spread(1._DPR, 1, filter(i_filter) % dim_lambda)) / &
          flux_band(filter(i_filter), filter(i_filter) % dim_lambda, &
          filter(i_filter) % lambda(:), 1/filter(i_filter) % lambda(:)**2))

!#----------------------------------------------------------------------
!# Flux of Vega.
!# $\int{f_\lambda(Vega) S'(\lambda) d\lambda}$ / `filter_norm`.

     if (filter(i_filter) % calib_type == "D4000") then
        flux_band_Vega_unnorm = flux_band(filter(i_filter), dim_lambda_Vega, lambda_Vega, &
             irrad_Vega*lambda_Vega**2) / c_ang
     else
        flux_band_Vega_unnorm = flux_band(filter(i_filter), dim_lambda_Vega, lambda_Vega, &
          irrad_Vega)
     endif

     flux_band_Vega = flux_band_Vega_unnorm/filter_norm

!#----------------------------------------------------------------------
!# Effective wavelength of Vega.
!# $\int{\lambda f_\lambda(Vega) S'(\lambda) d\lambda} / \int{f_\lambda(Vega) S'(\lambda) d\lambda}$.

     if (filter(i_filter) % calib_type == "D4000") then
        lambda_eff_Vega = flux_band(filter(i_filter), dim_lambda_Vega, lambda_Vega, &
             lambda_Vega**3*irrad_Vega) / c_ang
     else
        lambda_eff_Vega = flux_band(filter(i_filter), dim_lambda_Vega, lambda_Vega, &
             lambda_Vega*irrad_Vega)
     endif

     if (flux_band_Vega_unnorm > 0) &
          lambda_eff_Vega = lambda_eff_Vega/flux_band_Vega_unnorm

!#----------------------------------------------------------------------
!# Apparent AB magnitude of Vega.
!# `area_nu` = $\int{c/\lambda^2 S'(\lambda) d\lambda}$.

     area_nu = flux_band(filter(i_filter), filter(i_filter) % dim_lambda, &
          filter(i_filter) % lambda(:), &
          c_ang/filter(i_filter) % lambda(:)**2)

     if (filter(i_filter) % calib_type == "D4000") then
        AB_Vega = -2.5_DPR*log10(flux_band(filter(i_filter), dim_lambda_Vega, lambda_Vega, &
             irrad_Vega)/area_nu)-48.60_DPR
     else
        AB_Vega = -2.5_DPR*log10(flux_band_Vega_unnorm/area_nu)-48.60_DPR
     endif

!#----------------------------------------------------------------------
!# Apparent Thuan & Gunn magnitude of Vega.

     if (filter(i_filter) % calib_type == "D4000") then
        flux_band_TG = flux_band(filter(i_filter), dim_lambda_TG, lambda_TG, &
             flux_TG*lambda_TG**2) / c_ang / filter_norm
     else
        flux_band_TG = flux_band(filter(i_filter), dim_lambda_TG, lambda_TG, &
             flux_TG)/filter_norm        
     endif

     if (flux_band_TG > 0) then
        TG_Vega = -2.5_DPR*log10(flux_band_Vega/flux_band_TG)+9.5_DPR
     else
        TG_Vega = undefined_mag
     end if

!#----------------------------------------------------------------------
!# Monochromatic luminosity of the Sun.
!# $f_\lambda(Sun) S'(\lambda) d\lambda$ / `filter_norm`.

     if (filter(i_filter) % calib_type == "D4000") then
        lum_band_Sun = flux_band(filter(i_filter), dim_lambda_Sun, lambda_Sun, &
             lum_Sun*lambda_Sun**2) / c_ang / filter_norm
     else
        lum_band_Sun = flux_band(filter(i_filter), dim_lambda_Sun, lambda_Sun, &
             lum_Sun)/filter_norm
     endif

!#----------------------------------------------------------------------
!# Absolute magnitude of the Sun. 

     if (filter(i_filter) % calib_type == "D4000") then
        calibration = undefined_mag
     else if (filter(i_filter) % calib_type == "HST") then !# ref = -21.10
        calibration = -21.10_DPR
     else if (filter(i_filter) % calib_type == "FOCA") then !# ref = -21.175
        calibration = -21.175_DPR
     else if (filter(i_filter) % calib_type == "IRAS") then
        calibration = undefined_mag
     else
        std_Vega = std_Vega_def + filter(i_filter) % ZPO
        if (filter(i_filter) % calib_type == "Vega") then !# ref = Vega
           calibration = 2.5_DPR*log10(flux_band_Vega) + std_Vega
        else if (filter(i_filter) % calib_type == "AB") then !# ref = AB
           calibration = 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
              calibration = undefined_mag
           else
              calibration = 2.5_DPR*log10(flux_band_Vega) + TG_Vega - std_Vega
           endif
        end if
     endif

     if (lum_band_Sun > 0 .and. calibration /= undefined_mag) then
           mag_abs_Sun = -2.5_DPR*log10(lum_band_Sun/area_10pc) &
                + calibration
        else
           mag_abs_Sun = undefined_mag
        end if

!#----------------------------------------------------------------------
!# Write output
     write(unit_calib, fmt) &
          adjustl("""" // trim(filter(i_filter) % id) // """") // repeat(" ",12), & !# To flush left the filter's name.
          i_filter, flux_band_Vega, filter_norm, lambda_mean, &
          lambda_eff_Vega, AB_Vega, TG_Vega, lum_band_Sun, mag_abs_Sun, &
          lambda_pivot, filter_width, &
          adjustl("""" // trim(filter(i_filter) % calib_type) // """") // repeat(" ",7)
  end do
  call close_file(unit_calib)
  deallocate(irrad_Vega, lambda_Vega, lambda_TG, flux_TG, lambda_Sun, lum_Sun)
  
end program calib
