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

  use mod_types

  implicit none
  private
  type :: struct_GSD
     integer :: dim_radius
     real(CDR), dimension(:), pointer :: radius => null()
     real(CDR), dimension(:), pointer :: number => null()
  end type struct_GSD

  type :: struct_grain_abs
     integer :: dim_radius
     real(CDR), dimension(:), pointer :: radius => null()
     integer :: dim_lambda
     real(CDR), dimension(:), pointer :: lambda => null()
     real(DPR), dimension(:), pointer :: lambda_interm => null()
     real(CDR), dimension(:, :), pointer :: Q_abs => null()
     real(CDR), dimension(:), pointer :: d_S_grain => null()
     real(CDR), dimension(:), pointer :: kappa_ext => null()
     real(CDR), dimension(:), pointer :: albedo => null()
     real(CDR), dimension(:), pointer :: asym => null()
  end type struct_grain_abs
  public :: read_dust, struct_grain_abs

contains

!#======================================================================
  
  subroutine read_dust(grain_abs, &
       grain_density, grain_mean_atomic_mass, grains_file, dim_species, &
       species_id, carb_frac, sil_frac, carb_sublim_temp, sil_sublim_temp, sublim_temp)

    use mod_types
    use mod_directories, only : dust_dir
    use mod_file_access, only : open_file, close_file, path_file
    use mod_interp, only : interp_log_log, interp_log_lin
    use mod_interm_grid, only : interm_grid

    implicit none
    type(struct_grain_abs), dimension(:), pointer :: grain_abs
    real(CDR), dimension(:), pointer :: grain_density, grain_mean_atomic_mass
    character(len=*), intent(in) :: grains_file
    integer, intent(out) :: dim_species
    character(len=*), dimension(:), pointer :: species_id
    real(CDR), dimension(:), pointer :: carb_frac, sil_frac, sublim_temp
    real(CDR), intent(in) :: carb_sublim_temp, sil_sublim_temp
!#......................................................................
    integer :: i_species, i_lambda, i_radius, unit, dim_radius, dim_lambda
    character(std_string), dimension(:), pointer :: grain_opt_prop_file => null()
    real(CDR), dimension(:,:), allocatable :: Q_sca, cos_sca
    real(CDR) :: unused_number, m_C, m_sil
    logical, dimension(:), pointer :: carbonaceous => null()

    type(struct_GSD), dimension(:), pointer :: GSD => null()
    real(CDR), dimension(:), pointer :: radius_GSD_min => null(), radius_GSD_max => null(), grain_mass => null()

    integer :: dim_radius_supp, dim_radius_tmp
    real(CDR), dimension(:), allocatable :: radius_supp, radius_tmp
    real(CDR), dimension(:,:), allocatable :: Q_abs_tmp, Q_sca_tmp, cos_sca_tmp
!#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
    
    call read_grain_size_distribution(grains_file, &
         GSD, dim_species, grain_opt_prop_file, carbonaceous)

!# Read dust properties (absorption, albedo, asymmetry)
!# for graphites and silicates.

    if (associated(species_id)) deallocate(species_id)
    allocate(species_id(dim_species))
    if (associated(grain_density)) deallocate(grain_density)
    allocate(grain_density(dim_species))
    if (associated(grain_mean_atomic_mass)) deallocate(grain_mean_atomic_mass)
    allocate(grain_mean_atomic_mass(dim_species))
    if (associated(radius_GSD_min)) deallocate(radius_GSD_min)
    allocate(radius_GSD_min(dim_species))
    if (associated(radius_GSD_max)) deallocate(radius_GSD_max)
    allocate(radius_GSD_max(dim_species))
    if (associated(grain_mass)) deallocate(grain_mass) ; allocate(grain_mass(dim_species))

    if (associated(grain_abs)) then
       do i_species = 1, size(grain_abs)
          if (associated(grain_abs(i_species) % radius)) deallocate(grain_abs(i_species) % radius)
          if (associated(grain_abs(i_species) % lambda)) deallocate(grain_abs(i_species) % lambda)
          if (associated(grain_abs(i_species) % lambda_interm)) deallocate(grain_abs(i_species) % lambda_interm)
          if (associated(grain_abs(i_species) % Q_abs)) deallocate(grain_abs(i_species) % Q_abs)
          if (associated(grain_abs(i_species) % d_S_grain)) deallocate(grain_abs(i_species) % d_S_grain)
          if (associated(grain_abs(i_species) % kappa_ext)) deallocate(grain_abs(i_species) % kappa_ext)
          if (associated(grain_abs(i_species) % albedo)) deallocate(grain_abs(i_species) % albedo)
          if (associated(grain_abs(i_species) % asym)) deallocate(grain_abs(i_species) % asym)
       enddo
       deallocate(grain_abs)
    endif
    allocate(grain_abs(dim_species))
    
    do i_species = 1, dim_species
       call open_file(unit, path_file(dust_dir, grain_opt_prop_file(i_species)))
       read(unit,*) species_id(i_species)
       read(unit,*) grain_density(i_species)
       read(unit,*) grain_mean_atomic_mass(i_species)
       read(unit,*) dim_radius_tmp
       read(unit,*) dim_lambda
       grain_abs(i_species) % dim_lambda = dim_lambda

       if (allocated(radius_tmp)) deallocate(radius_tmp)
       allocate(radius_tmp(dim_radius_tmp))

       if (associated(grain_abs(i_species) % lambda)) deallocate(grain_abs(i_species) % lambda)
       allocate(grain_abs(i_species) % lambda(dim_lambda))

       if (associated(grain_abs(i_species) % kappa_ext)) deallocate(grain_abs(i_species) % kappa_ext)
       allocate(grain_abs(i_species) % kappa_ext(dim_lambda))

       if (associated(grain_abs(i_species) % albedo)) deallocate(grain_abs(i_species) % albedo)
       allocate(grain_abs(i_species) % albedo(dim_lambda))

       if (associated(grain_abs(i_species) % asym)) deallocate(grain_abs(i_species) % asym)
       allocate(grain_abs(i_species) % asym(dim_lambda))

       if (allocated(Q_abs_tmp)) deallocate(Q_abs_tmp)
       allocate(Q_abs_tmp(dim_radius_tmp, dim_lambda))

       if (allocated(Q_sca_tmp)) deallocate(Q_sca_tmp)
       allocate(Q_sca_tmp(dim_radius_tmp, dim_lambda))

       if (allocated(cos_sca_tmp)) deallocate(cos_sca_tmp)
       allocate(cos_sca_tmp(dim_radius_tmp, dim_lambda))

       do i_radius = 1, dim_radius_tmp
          read(unit,*)
          read(unit,*) radius_tmp(i_radius)
          read(unit,*)
          do i_lambda = dim_lambda, 1, -1
             if (grain_opt_prop_file(i_species) == "PAHneu_30" .or. &
                  grain_opt_prop_file(i_species) == "PAHion_30") then
                read(unit,*) grain_abs(i_species) % lambda(i_lambda), unused_number, &
                     Q_abs_tmp(i_radius, i_lambda), &
                     Q_sca_tmp(i_radius, i_lambda), cos_sca_tmp(i_radius, i_lambda)
             else
                read(unit,*) grain_abs(i_species) % lambda(i_lambda), &
                     Q_abs_tmp(i_radius, i_lambda), &
                     Q_sca_tmp(i_radius, i_lambda), cos_sca_tmp(i_radius, i_lambda)
             endif
          enddo
       enddo
       call close_file(unit)

       call interm_grid(grain_abs(i_species) % dim_lambda, &
            real(grain_abs(i_species) % lambda(:), DPR), &
            grain_abs(i_species) % lambda_interm)

       radius_GSD_min(i_species) = minval(GSD(i_species) % radius(:), &
            mask = GSD(i_species) % number(:) > 0)
       radius_GSD_max(i_species) = maxval(GSD(i_species) % radius(:), &
            mask = GSD(i_species) % number(:) > 0)

!# Extrapolate below `radius_tmp(1)` if `radius_GSD_min(i_species)` is smaller.

       dim_radius_supp = max( &
            ceiling(log10(radius_tmp(1)/radius_GSD_min(i_species))/ &
            log10(radius_tmp(dim_radius_tmp)/radius_tmp(1))*dim_radius_tmp), &
            0)
       if (allocated(radius_supp)) deallocate(radius_supp)
       allocate(radius_supp(dim_radius_supp))
       do i_radius = 1, dim_radius_supp
          radius_supp(i_radius) = 10**(log10(radius_tmp(1)) - &
               (dim_radius_supp-i_radius+1)*log10(radius_tmp(dim_radius_tmp)/radius_tmp(1))/ &
               dim_radius_tmp)
       enddo

       dim_radius = dim_radius_tmp + dim_radius_supp
       grain_abs(i_species) % dim_radius = dim_radius

       if (associated(grain_abs(i_species) % radius)) deallocate(grain_abs(i_species) % radius)
       allocate(grain_abs(i_species) % radius(dim_radius))

       if (associated(grain_abs(i_species) % d_S_grain)) deallocate(grain_abs(i_species) % d_S_grain)
       allocate(grain_abs(i_species) % d_S_grain(dim_radius))

       if (associated(grain_abs(i_species) % Q_abs)) deallocate(grain_abs(i_species) % Q_abs)
       allocate(grain_abs(i_species) % Q_abs(dim_radius, dim_lambda))

       if (allocated(Q_sca)) deallocate(Q_sca)
       allocate(Q_sca(dim_radius, dim_lambda))

       if (allocated(cos_sca)) deallocate(cos_sca)
       allocate(cos_sca(dim_radius, dim_lambda))


!# Shift indices up by `dim_radius_supp` to leave space for extrapolated values.
       grain_abs(i_species) % radius(1+dim_radius_supp : dim_radius) = &
            radius_tmp(1:dim_radius_tmp)
       grain_abs(i_species) % Q_abs(1+dim_radius_supp : dim_radius, :) = &
            Q_abs_tmp(1:dim_radius_tmp, :)
       Q_sca(1+dim_radius_supp : dim_radius, :) = &
            Q_sca_tmp(1:dim_radius_tmp, :)
       cos_sca(1+dim_radius_supp : dim_radius, :) = &
            cos_sca_tmp(1:dim_radius_tmp, :)

!# Additional values are computed by extrapolation at radii below the smallest value in the grain_opt_prop_file.
!# ??? Should radii be also added above the largest value in the grain_opt_prop_file?

       do i_radius = 1, dim_radius_supp
          grain_abs(i_species) % radius(i_radius) = radius_supp(i_radius)
          do i_lambda = 1, dim_lambda
!# Inter/extrapolation in `Q_abs/radius` is more accurate than in `Q_abs`.
             grain_abs(i_species) % Q_abs(i_radius, i_lambda) = grain_abs(i_species) % radius(i_radius) * &
                  interp_log_log(grain_abs(i_species) % radius(dim_radius_supp+1), &
                  grain_abs(i_species) % radius(dim_radius_supp+2), &
                  grain_abs(i_species) % Q_abs(dim_radius_supp+1, i_lambda) / &
                  grain_abs(i_species) % radius(dim_radius_supp+1), &
                  grain_abs(i_species) % Q_abs(dim_radius_supp+2, i_lambda) / &
                  grain_abs(i_species) % radius(dim_radius_supp+2), grain_abs(i_species) % radius(i_radius))
!# Inter/extrapolation in `Q_sca/radius**4` is more accurate than in `Q_sca`.
             Q_sca(i_radius, i_lambda) = grain_abs(i_species) % radius(i_radius)**4 * &
                  interp_log_log(grain_abs(i_species) % radius(dim_radius_supp+1), &
                  grain_abs(i_species) % radius(dim_radius_supp+2), &
                  Q_sca(dim_radius_supp+1, i_lambda)/grain_abs(i_species) % radius(dim_radius_supp+1)**4, &
                  Q_sca(dim_radius_supp+2, i_lambda)/grain_abs(i_species) % radius(dim_radius_supp+2)**4, &
                  grain_abs(i_species) % radius(i_radius))
             cos_sca(i_radius, i_lambda) = interp_log_lin(grain_abs(i_species) % radius(dim_radius_supp+1), &
                  grain_abs(i_species) % radius(dim_radius_supp+2), &
                  cos_sca(dim_radius_supp+1, i_lambda), cos_sca(dim_radius_supp+2, i_lambda), &
                  grain_abs(i_species) % radius(i_radius))
             cos_sca(i_radius, i_lambda) = min(max(cos_sca(i_radius, i_lambda), -1._CDR), 1._CDR)
          enddo
       enddo

       call grain_size_distribution(dim_radius, grain_abs(i_species) % radius(:), &
            grain_density(i_species), grain_abs(i_species) % d_S_grain(:), &
            GSD(i_species), grain_mass(i_species))

       call compute_kappa(dim_radius, grain_abs(i_species) % d_S_grain(:), &
            dim_lambda, grain_abs(i_species) % Q_abs(:,:), Q_sca, cos_sca, &
            grain_abs(i_species) % kappa_ext(:), grain_abs(i_species) % albedo(:), grain_abs(i_species) % asym(:))
    enddo

!# Determination of the mass fractions of PAH and graphite, assuming continuity of the
!# grain size distribution at "radius_PAH_max". Actually, the mass fraction of PAH is only
!# the carbon mass fraction.

    if (associated(carb_frac)) deallocate(carb_frac)
    if (associated(sil_frac)) deallocate(sil_frac)
    allocate(carb_frac(dim_species))
    allocate(sil_frac(dim_species))
    if (associated(sublim_temp)) deallocate(sublim_temp)
    allocate(sublim_temp(dim_species))

    m_C = sum(grain_mass, mask = carbonaceous)
    m_sil = sum(grain_mass, mask = .not.carbonaceous)
    do i_species = 1, dim_species
       if (carbonaceous(i_species)) then
          carb_frac(i_species) = grain_mass(i_species)/m_C
          sil_frac(i_species) = 0
          sublim_temp(i_species) = carb_sublim_temp
       else
          carb_frac(i_species) = 0
          sil_frac(i_species) = grain_mass(i_species)/m_sil
          sublim_temp(i_species) = sil_sublim_temp
       endif
    enddo

  end subroutine read_dust

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

  subroutine read_grain_size_distribution(grains_file, GSD, &
       dim_species, grain_opt_prop_file, carbonaceous)

    use mod_types
    use mod_directories, only : dust_dir
    use mod_file_access, only : open_file, close_file, path_file
    use mod_strings, only : down_case, quote_string
    
    implicit none
    character(len=*), intent(in) :: grains_file
    type(struct_GSD), dimension(:), pointer :: GSD
    integer, intent(out) :: dim_species
    character(len=*), dimension(:), pointer :: grain_opt_prop_file
    logical, dimension(:), pointer :: carbonaceous
!#......................................................................
    integer :: unit, i_species, i_radius, dim_radius
    character(std_string) :: GSD_type
    real(CDR) :: slope, slope_prev, norm
    logical :: numbers
!#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
    
    call open_file(unit, path_file(dust_dir, grains_file))
    read(unit,*) GSD_type, dim_species

    GSD_type = adjustl(down_case(GSD_type))
    if (GSD_type == "numbers") then
       numbers = .true.
    else if (GSD_type == "slopes") then
       numbers = .false.
    else
       write(*, "(a)") quote_string(grains_file) // ": either the number of grains &
            &(""numbers"" keyword) or the slope (""slopes"" keyword) of the &
            &size distribution should be given for the grain size distribution. Stopped."
       stop
    endif

    if (associated(grain_opt_prop_file)) deallocate(grain_opt_prop_file)
    allocate(grain_opt_prop_file(dim_species))
    if (associated(carbonaceous)) deallocate(carbonaceous)
    allocate(carbonaceous(dim_species))
    if (associated(GSD)) then
       do i_species = 1, size(GSD)
          if (associated(GSD(i_species) % radius)) deallocate(GSD(i_species) % radius)
          if (associated(GSD(i_species) % number)) deallocate(GSD(i_species) % number)
       enddo
       deallocate(GSD)
    endif
    allocate(GSD(dim_species))

    if (numbers) then
       do i_species = 1, dim_species
          read(unit,*) dim_radius, grain_opt_prop_file(i_species), carbonaceous(i_species)
          GSD(i_species) % dim_radius = dim_radius
          if (associated(GSD(i_species) % radius)) deallocate(GSD(i_species) % radius)
          allocate(GSD(i_species) % radius(dim_radius))
          if (associated(GSD(i_species) % number)) deallocate(GSD(i_species) % number)
          allocate(GSD(i_species) % number(dim_radius))
          do i_radius = 1, dim_radius
             read(unit,*) GSD(i_species) % radius(i_radius), GSD(i_species) % number(i_radius)
          enddo
       enddo
    else !# "slopes".
       do i_species = 1, dim_species
          read(unit,*) GSD(i_species) % dim_radius, grain_opt_prop_file(i_species), carbonaceous(i_species), &
               norm
          if (associated(GSD(i_species) % radius)) deallocate(GSD(i_species) % radius)
          allocate(GSD(i_species) % radius(dim_radius))
          if (associated(GSD(i_species) % number)) deallocate(GSD(i_species) % number)
          allocate(GSD(i_species) % number(dim_radius))
          do i_radius = 1, GSD(i_species) % dim_radius
             if (i_radius < GSD(i_species) % dim_radius) then
                read(unit,*) GSD(i_species) % radius(i_radius), slope
             else
                read(unit,*) GSD(i_species) % radius(i_radius)
             endif
             if (i_radius == 1) then
                GSD(i_species) % number(i_radius) = norm
             else
                GSD(i_species) % number(i_radius) = GSD(i_species) % number(i_radius-1) * &
                     (GSD(i_species) % radius(i_radius)/GSD(i_species) % radius(i_radius-1))**slope_prev
             endif
             slope_prev = slope
          enddo
       enddo
    endif

    call close_file(unit)

  end subroutine read_grain_size_distribution

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

  subroutine grain_size_distribution(dim_radius, radius, &
       grain_density, d_S_grain, GSD, grain_mass)

    use mod_types
    use mod_constants, only : pi, um_to_cm
    use mod_spectra_constants, only : d_l10_rad0
    use mod_interp, only : bracket, interp_log_log
    use mod_interm_grid
    
    implicit none
    integer, intent(in) :: dim_radius
    real(CDR), dimension(:), intent(in) :: radius
    real(CDR), intent(in) :: grain_density
    real(CDR), dimension(:), intent(out) :: d_S_grain
    type(struct_GSD), intent(in) :: GSD
    real(CDR), intent(out) :: grain_mass
!#......................................................................
    real(CDR), dimension(:), pointer :: radius_interm => null()
    real(CDR) :: radius_bottom, radius_top, &
         rad_sub, d_l10_rad_sub, d_rad_sub, d_n
    integer :: i_radius, i_rad_sub, n_rad_sub, i_bracket
    real(CDR) :: n_tot, V_grain
!#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::    

    n_tot = 0

    call interm_grid(dim_radius, radius, radius_interm)

    d_S_grain(:) = 0
    V_grain = 0
    do i_radius = 1, dim_radius
       radius_bottom = radius_interm(i_radius)
       radius_top = radius_interm(i_radius+1)
       if (radius_top > radius_bottom) then
          n_rad_sub = ceiling(log10(radius_top/radius_bottom)/d_l10_rad0)
          d_l10_rad_sub = log10(radius_top/radius_bottom)/n_rad_sub
          i_bracket = 0
          do i_rad_sub = 1, n_rad_sub
             rad_sub = radius_bottom*10**((i_rad_sub-0.5_CDR)*d_l10_rad_sub)
             d_rad_sub = d_l10_rad_sub * rad_sub * log(10._CDR)
             call bracket(GSD % dim_radius, GSD % radius(:), rad_sub, i_bracket)
             if (rad_sub >= GSD % radius(1) .and. rad_sub <= GSD % radius(GSD % dim_radius)) then
                d_n = interp_log_log(GSD % radius(i_bracket), GSD % radius(i_bracket+1), &
                     GSD % number(i_bracket), GSD % number(i_bracket+1), rad_sub)*d_rad_sub
             else
                d_n = 0
             endif
             n_tot = n_tot + d_n
             d_S_grain(i_radius) = d_S_grain(i_radius)+d_n*pi*rad_sub**2
             V_grain = V_grain+d_n*4*pi*rad_sub**3/3
          enddo
       endif
    enddo

!# Normalization to the mass of grains of the species.

    grain_mass = grain_density * V_grain
    if (grain_mass > 0) d_S_grain(:) = d_S_grain(:)/grain_mass/um_to_cm !# in cm2.g-1.

  end subroutine grain_size_distribution

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

  subroutine compute_kappa(dim_radius, d_S_grain, dim_lambda_grains, &
       Q_abs, Q_sca, cos_sca, kappa_ext, albedo, asym)

    use mod_types
    
    implicit none
    integer, intent(in) :: dim_lambda_grains, dim_radius
    real(CDR), dimension(:), intent(in) :: d_S_grain
    real(CDR), dimension(:, :), intent(in) :: Q_abs
    real(CDR), dimension(:, :), intent(in) :: Q_sca, cos_sca
    real(CDR), dimension(:), intent(out) :: kappa_ext, &
         albedo, asym
!#......................................................................
    real(CDR) :: kappa_sca, kappa_abs
    integer :: i_lambda, i_radius
!#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

    do i_lambda = 1, dim_lambda_grains
       kappa_abs = 0
       kappa_sca = 0
       asym(i_lambda) = 0
       do i_radius = 1, dim_radius
          kappa_abs = kappa_abs + Q_abs(i_radius, i_lambda)*d_S_grain(i_radius)
          kappa_sca = kappa_sca + Q_sca(i_radius, i_lambda)*d_S_grain(i_radius)
          asym(i_lambda) = asym(i_lambda) + &
               cos_sca(i_radius, i_lambda)*Q_sca(i_radius, i_lambda)*d_S_grain(i_radius)
       enddo
       if (kappa_sca > 0) then
          asym(i_lambda) = asym(i_lambda)/kappa_sca
       else
          asym(i_lambda) = 0
       endif
!# Opacity (extinction = absorption + scattering) in cm^2.g^-1.
       kappa_ext(i_lambda) = kappa_abs+kappa_sca
       if (kappa_ext(i_lambda) > 0) then
          albedo(i_lambda) = kappa_sca/kappa_ext(i_lambda)
       else
          albedo(i_lambda) = 0
       endif
    enddo

  end subroutine compute_kappa

end module mod_grain_properties
