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

  use mod_interp, only : bracket
  use mod_types, only : DPR

  implicit none
  private
  type :: struct_isoch
!# Next point on the isochrone:
     type(struct_isoch), pointer :: ptr => null()
!# Current point:
     real(DPR) :: m !# log10(initial mass/M_sol).
     real(DPR) :: T !# log10(effective temperature/kelvin).
     real(DPR) :: L !# log10(bolometric luminosity/L_sol).
     real(DPR) :: g !# log10(surface gravity/(cm.s^-2)).
  end type struct_isoch
  public :: compute_isochrone, compute_isochrone_WD, struct_isoch

contains

!#======================================================================
  
  subroutine compute_isochrone(time, dim_isoch, isoch, isoch_node, top_isoch_mass, &
       std_track, n_VLM, n_He_flash, n_MS, n_HB)

    use mod_types
    use mod_tracks, only : struct_track
    
    implicit none
    real(CDR), intent(in) :: time !# in Myr.
    integer, intent(out) :: dim_isoch
    type(struct_isoch), intent(out) :: isoch
    type(struct_isoch), pointer :: isoch_node
    real(DPR), intent(out) :: top_isoch_mass
    type(struct_track), dimension(:), intent(in) :: std_track
    integer, intent(in) :: n_VLM, n_He_flash, n_MS, n_HB
!#......................................................................
    
!# Used in "mod_isochrone.f90" to avoid interpolating between a stellar evolutionary track
!# with equivalent points corresponding to those of the previous mass and the same track with
!# equivalent points corresponding to those of the next mass:
    real(DPR), parameter :: eps_init_mass = 1.e-6_DPR !# (Probably useless since the test on \
!# `init_mass` is a strict inequality.)
    integer :: i, j, j1, j2
    real(DPR) :: alpha
!#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
    
    call isoch_initialize(isoch)

    dim_isoch = 0
    if (time > 0) then

!# Very low mass stars: {
       do i = 1, n_VLM
          dim_isoch = dim_isoch+1
          j = 0
          call bracket(std_track(i) % dim_age, std_track(i) % age(:), &
               real(time, kind(std_track(i) % age)), j)
          alpha = (time-std_track(i) % age(j))/(std_track(i) % age(j+1)-std_track(i) % age(j))
          call isoch_new_node(isoch, isoch_node)
          isoch_node % m = std_track(i) % l10_init_mass
          top_isoch_mass = isoch_node % m
          isoch_node % T = std_track(i) % T_eff(j)+alpha*(std_track(i) % T_eff(j+1)-std_track(i) % T_eff(j))
          isoch_node % L = std_track(i) % lum(j)+alpha*(std_track(i) % lum(j+1)-std_track(i) % lum(j))      
          isoch_node % g = std_track(i) % grav(j)+alpha*(std_track(i) % grav(j+1)-std_track(i) % grav(j))
       end do
!# }
       
       do i = n_VLM+1, n_VLM+n_He_flash-1
          if ((std_track(i) % dim_age == std_track(i+1) % dim_age) .and. &
               (std_track(i) % init_mass < std_track(i+1) % init_mass - &
               eps_init_mass)) then
             if (((std_track(i) % age(1)-time)*(std_track(i+1) % age(std_track(i+1) % dim_age)-time) <= 0) .or. &
                  ((std_track(i) % age(std_track(i) % dim_age)-time)*(std_track(i+1) % age(1)-time) <= 0)) then

                call find_j(time, i, j1, std_track)
                call find_j(time, i+1, j2, std_track)

                call on_track(time, i, j1, dim_isoch, isoch, isoch_node, top_isoch_mass, &
                     std_track)

                call between_tracks(time, i, j1, j2, dim_isoch, isoch, isoch_node, top_isoch_mass, &
                     std_track)

                call on_track(time, i+1, j2, dim_isoch, isoch, isoch_node, top_isoch_mass, &
                     std_track)

             end if
          end if
       end do

       i = n_VLM+n_He_flash
       do j = 1, std_track(i) % dim_age-1
          if (std_track(i) % age(j) <= time .and. time <= std_track(i) % age(j+1)) then
             dim_isoch = dim_isoch+1
             alpha = (time-std_track(i) % age(j))/(std_track(i) % age(j+1)-std_track(i) % age(j))
             call isoch_new_node(isoch, isoch_node)
             isoch_node % m = std_track(i) % l10_init_mass
             top_isoch_mass = isoch_node % m
             isoch_node % T = std_track(i) % T_eff(j)+alpha*(std_track(i) % T_eff(j+1)-std_track(i) % T_eff(j))
             isoch_node % L = std_track(i) % lum(j)+alpha*(std_track(i) % lum(j+1)-std_track(i) % lum(j))      
             isoch_node % g = std_track(i) % grav(j)+alpha*(std_track(i) % grav(j+1)-std_track(i) % grav(j))
          end if
       end do
       do i = n_MS+1, n_MS+n_HB-1
          if ((std_track(i) % dim_age == std_track(i+1) % dim_age) .and. &
               (std_track(i) % init_mass < std_track(i+1) % init_mass - &
               eps_init_mass)) then
             if (((std_track(i) % age(1)-time)*(std_track(i+1) % age(std_track(i+1) % dim_age)-time) <= 0) .or. &
                  ((std_track(i) % age(std_track(i) % dim_age)-time)*(std_track(i+1) % age(1)-time) <= 0)) then

                call find_j(time, i, j1, std_track)
                call find_j(time, i+1, j2, std_track)

                call on_track(time, i, j1, dim_isoch, isoch, isoch_node, top_isoch_mass, &
                     std_track)

                call between_tracks(time, i, j1, j2, dim_isoch, isoch, isoch_node, top_isoch_mass, &
                     std_track)
                
                call on_track(time, i+1, j2, dim_isoch, isoch, isoch_node, top_isoch_mass, &
                     std_track)

             end if
          end if
       end do

       i = n_MS+n_HB
       do j = 1, std_track(i) % dim_age-1
          if (std_track(i) % age(j) <= time .and. time <= std_track(i) % age(j+1)) then
             dim_isoch = dim_isoch+1
             alpha = (time-std_track(i) % age(j))/(std_track(i) % age(j+1)-std_track(i) % age(j))
             call isoch_new_node(isoch, isoch_node)
             isoch_node % m = std_track(i) % l10_init_mass
             top_isoch_mass = isoch_node % m
             isoch_node % T = std_track(i) % T_eff(j)+alpha*(std_track(i) % T_eff(j+1)-std_track(i) % T_eff(j))
             isoch_node % L = std_track(i) % lum(j)+alpha*(std_track(i) % lum(j+1)-std_track(i) % lum(j))      
             isoch_node % g = std_track(i) % grav(j)+alpha*(std_track(i) % grav(j+1)-std_track(i) % grav(j))
          end if
       end do

       do i = n_VLM+n_He_flash+1, n_MS-1
          if ((std_track(i) % dim_age == std_track(i+1) % dim_age) .and. &
               (std_track(i) % init_mass < std_track(i+1) % init_mass - &
               eps_init_mass)) then
             if (((std_track(i) % age(1)-time)*(std_track(i+1) % age(std_track(i+1) % dim_age)-time) <= 0) .or. &
                  ((std_track(i) % age(std_track(i) % dim_age)-time)*(std_track(i+1) % age(1)-time) <= 0)) then

                call find_j(time, i, j1, std_track)
                call find_j(time, i+1, j2, std_track)

                call on_track(time, i, j1, dim_isoch, isoch, isoch_node, top_isoch_mass, &
                     std_track)

                call between_tracks(time, i, j1, j2, dim_isoch, isoch, isoch_node, top_isoch_mass, &
                     std_track)

                call on_track(time, i+1, j2, dim_isoch, isoch, isoch_node, top_isoch_mass, &
                     std_track)

             end if
          end if
       end do

       i = n_MS
       do j = 1, std_track(i) % dim_age-1
          if (std_track(i) % age(j) <= time .and. time <= std_track(i) % age(j+1)) then
             dim_isoch = dim_isoch+1
             alpha = (time-std_track(i) % age(j))/(std_track(i) % age(j+1)-std_track(i) % age(j))
             call isoch_new_node(isoch, isoch_node)             
             isoch_node % m = std_track(i) % l10_init_mass
             top_isoch_mass = isoch_node % m
             isoch_node % T = std_track(i) % T_eff(j)+alpha*(std_track(i) % T_eff(j+1)-std_track(i) % T_eff(j))
             isoch_node % L = std_track(i) % lum(j)+alpha*(std_track(i) % lum(j+1)-std_track(i) % lum(j))      
             isoch_node % g = std_track(i) % grav(j)+alpha*(std_track(i) % grav(j+1)-std_track(i) % grav(j))
          end if
       end do
    else

!# Time = 0. The isochrone is the ZAMS.

       do i = 1, n_MS
          dim_isoch = dim_isoch+1
          call isoch_new_node(isoch, isoch_node)
          isoch_node % m = std_track(i) % l10_init_mass
          top_isoch_mass = isoch_node % m
          isoch_node % T = std_track(i) % T_eff(1)
          isoch_node % L = std_track(i) % lum(1)
          isoch_node % g = std_track(i) % grav(1)
       end do
    end if

  end subroutine compute_isochrone

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

  subroutine compute_isochrone_WD(time, dim_isoch, isoch, isoch_node, &
       dim_WD, WD_track, dim_age_WD)
    
    use mod_types
    use mod_tracks, only : struct_track

    implicit none
    real(CDR), intent(in) :: time
    integer, intent(inout) :: dim_isoch
    type(struct_isoch), intent(inout) :: isoch
    type(struct_isoch), pointer :: isoch_node
    integer, intent(in) :: dim_WD, dim_age_WD
    type(struct_track), dimension(:), intent(in) :: WD_track
!#......................................................................
    integer :: i, j, j1, j2
    real(DPR) :: alpha
!#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

    do i = 1, dim_WD-1
       if (((WD_track(i) % age(1)-time)*(WD_track(i+1) % age(dim_age_WD)-time) <= 0) .or. &
            ((WD_track(i) % age(dim_age_WD)-time)*(WD_track(i+1) % age(1)-time) <= 0)) then
          j1 = 1
          j2 = 1
          if (WD_track(i) % age(1) > time) j1 = 0
          if (WD_track(i) % age(dim_age_WD) < time) j1 = dim_age_WD
          if (WD_track(i+1) % age(1) > time) j2 = 0
          if (WD_track(i+1) % age(dim_age_WD) < time) j2 = dim_age_WD
          if (j1 /= 0 .and. j1 /= dim_age_WD) then
             j1 = 0
             call bracket(dim_age_WD, WD_track(i) % age(1:dim_age_WD), &
                  real(time, kind(WD_track(i) % age)), j1)
          end if
          if (j2 /= 0 .and. j2 /= dim_age_WD) then
             j2 = 0
             call bracket(dim_age_WD, WD_track(i+1) % age(1:dim_age_WD), &
                  real(time, kind(WD_track(i) % age)), j2)
          end if
          if (j1 /= 0 .and. j1 /= dim_age_WD) then
             dim_isoch = dim_isoch+1
             alpha = (time-WD_track(i) % age(j1))/(WD_track(i) % age(j1+1)-WD_track(i) % age(j1))
             call isoch_new_node(isoch, isoch_node)
             isoch_node % m = WD_track(i) % l10_init_mass
             isoch_node % T = WD_track(i) % T_eff(j1)+alpha*(WD_track(i) % T_eff(j1+1)-WD_track(i) % T_eff(j1))
             isoch_node % L = WD_track(i) % lum(j1)+alpha*(WD_track(i) % lum(j1+1)-WD_track(i) % lum(j1))
             isoch_node % g = WD_track(i) % grav(j1)+alpha*(WD_track(i) % grav(j1+1)-WD_track(i) % grav(j1))
          end if
          if (j1 > j2) then
             do j = j1, j2+1, -1
                alpha = log10(time/WD_track(i+1) % age(j))/log10(WD_track(i) % age(j)/ &
                     WD_track(i+1) % age(j))
                dim_isoch = dim_isoch+1
                call isoch_new_node(isoch, isoch_node)
                isoch_node % m = alpha*WD_track(i) % l10_init_mass + &
                     (1-alpha)*WD_track(i+1) % l10_init_mass
                isoch_node % T = alpha*WD_track(i) % T_eff(j)+(1-alpha)*WD_track(i+1) % T_eff(j)
                isoch_node % L = alpha*WD_track(i) % lum(j)+(1-alpha)*WD_track(i+1) % lum(j)
                isoch_node % g = alpha*WD_track(i) % grav(j)+(1-alpha)*WD_track(i+1) % grav(j)
             end do
          else
             do j = j1+1, j2
                alpha = log10(time/WD_track(i+1) % age(j))/log10(WD_track(i) % age(j)/ &
                     WD_track(i+1) % age(j))
                dim_isoch = dim_isoch+1
                call isoch_new_node(isoch, isoch_node)
                isoch_node % m = alpha*WD_track(i) % l10_init_mass + &
                     (1-alpha)*WD_track(i+1) % l10_init_mass
                isoch_node % T = alpha*WD_track(i) % T_eff(j)+(1-alpha)*WD_track(i+1) % T_eff(j)
                isoch_node % L = alpha*WD_track(i) % lum(j)+(1-alpha)*WD_track(i+1) % lum(j)
                isoch_node % g = alpha*WD_track(i) % grav(j)+(1-alpha)*WD_track(i+1) % grav(j)
             end do
          end if
          if (j2 /= 0 .and. j2 /= dim_age_WD) then
             dim_isoch = dim_isoch+1
             alpha = (time-WD_track(i+1) % age(j2))/(WD_track(i+1) % age(j2+1)-WD_track(i+1) % age(j2))
             call isoch_new_node(isoch, isoch_node)
             isoch_node % m = WD_track(i+1) % l10_init_mass
             isoch_node % T = WD_track(i+1) % T_eff(j2)+alpha*(WD_track(i+1) % T_eff(j2+1) &
                  -WD_track(i+1) % T_eff(j2))
             isoch_node % L = WD_track(i+1) % lum(j2)+alpha*(WD_track(i+1) % lum(j2+1)-WD_track(i+1) % lum(j2))
             isoch_node % g = WD_track(i+1) % grav(j2)+alpha*(WD_track(i+1) % grav(j2+1) &
                  -WD_track(i+1) % grav(j2))
          end if
       end if
    end do

  end subroutine compute_isochrone_WD

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

  subroutine find_j(time, i, j, std_track)

    use mod_types
    use mod_tracks, only : struct_track
    
    implicit none
    real(CDR), intent(in) :: time
    integer, intent(in) :: i
    integer, intent(out) :: j
    type(struct_track), dimension(:), intent(in) :: std_track
!#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
    
    if (std_track(i) % age(1) > time) then 
       j = 0
    else if (std_track(i) % age(std_track(i) % dim_age) < time) then
       j = std_track(i) % dim_age
    else
       j = 0
       call bracket(std_track(i) % dim_age, std_track(i) % age(:), &
            real(time, kind(std_track(i) % age)), j)
    end if

  end subroutine find_j

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

  subroutine on_track(time, i, j, dim_isoch, isoch, isoch_node, &
       top_isoch_mass, &
       std_track)

    use mod_types
    use mod_tracks, only : struct_track
    
    implicit none
    real(CDR), intent(in) :: time
    integer, intent(in) :: i, j
    integer, intent(inout) :: dim_isoch
    type(struct_isoch), intent(inout) :: isoch
    type(struct_isoch), pointer :: isoch_node
    real(DPR), intent(out) :: top_isoch_mass
    type(struct_track), dimension(:), intent(in) :: std_track
!#......................................................................
    real(DPR) :: alpha
!#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

    if (j /= 0 .and. j /= std_track(i) % dim_age) then
       dim_isoch = dim_isoch+1
       alpha = (time-std_track(i) % age(j))/(std_track(i) % age(j+1)-std_track(i) % age(j))
       call isoch_new_node(isoch, isoch_node)
       isoch_node % m = std_track(i) % l10_init_mass
       top_isoch_mass = isoch_node % m
       isoch_node % T = std_track(i) % T_eff(j)+alpha*(std_track(i) % T_eff(j+1)-std_track(i) % T_eff(j))
       isoch_node % L = std_track(i) % lum(j)+alpha*(std_track(i) % lum(j+1)-std_track(i) % lum(j))      
       isoch_node % g = std_track(i) % grav(j)+alpha*(std_track(i) % grav(j+1)-std_track(i) % grav(j))
    end if

  end subroutine on_track

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

  subroutine between_tracks(time, i, j1, j2, dim_isoch, isoch, isoch_node, &
       top_isoch_mass, &
       std_track)

    use mod_types
    use mod_tracks, only : struct_track

    implicit none
    real(CDR), intent(in) :: time
    integer, intent(in) :: i, j1, j2
    integer, intent(inout) :: dim_isoch
    type(struct_isoch), intent(inout) :: isoch
    type(struct_isoch), pointer :: isoch_node
    real(DPR), intent(out) :: top_isoch_mass
    type(struct_track), dimension(:), intent(in) :: std_track
!#......................................................................
    integer :: first, last, step, j
    real(DPR) :: alpha
!#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

    if (j1 > j2) then
       first = j1
       last = j2+1
       step = -1
    else
       first = j1+1
       last = j2
       step = 1
    endif
    do j = first, last, step
       alpha = log10(time/std_track(i+1) % age(j)) / &
            log10(std_track(i) % age(j)/std_track(i+1) % age(j))
       dim_isoch = dim_isoch+1
       call isoch_new_node(isoch, isoch_node)
       isoch_node % m = alpha*std_track(i) % l10_init_mass + &
            (1-alpha)*std_track(i+1) % l10_init_mass
       top_isoch_mass = isoch_node % m
       isoch_node % T = alpha*std_track(i) % T_eff(j)+(1-alpha)*std_track(i+1) % T_eff(j)
       isoch_node % L = alpha*std_track(i) % lum(j)+(1-alpha)*std_track(i+1) % lum(j)
       isoch_node % g = alpha*std_track(i) % grav(j)+(1-alpha)*std_track(i+1) % grav(j)
    end do

  end subroutine between_tracks

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

  subroutine isoch_initialize(isoch)

    implicit none
    type(struct_isoch), intent(inout) :: isoch
!#......................................................................
    type(struct_isoch), pointer :: isoch_node
!#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

!# Delete previous isochrone, if any.
    isoch_node => isoch % ptr
    do
       if (.not.associated(isoch_node)) exit
       isoch % ptr => isoch_node % ptr
       deallocate(isoch_node)
       isoch_node => isoch % ptr
    enddo

!# Set the head of the linked list of isochrone nodes.
    nullify(isoch % ptr)

  end subroutine isoch_initialize

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

  subroutine isoch_new_node(isoch, isoch_node)

    implicit none
    type(struct_isoch), intent(inout) :: isoch
    type(struct_isoch), pointer :: isoch_node
!#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

    if (.not.associated(isoch % ptr)) then
       allocate(isoch % ptr)
       isoch_node => isoch % ptr
    else
       allocate(isoch_node % ptr)
       isoch_node => isoch_node % ptr
    endif
    nullify(isoch_node % ptr)

  end subroutine isoch_new_node

end module mod_isochrone
