Line data    Source code

       1              : ! ***********************************************************************
       2              : !
       3              : !   Copyright (C) 2025  The MESA Team
       4              : !
       5              : !   This program is free software: you can redistribute it and/or modify
       6              : !   it under the terms of the GNU Lesser General Public License
       7              : !   as published by the Free Software Foundation,
       8              : !   either version 3 of the License, or (at your option) any later version.
       9              : !
      10              : !   This program is distributed in the hope that it will be useful,
      11              : !   but WITHOUT ANY WARRANTY; without even the implied warranty of
      12              : !   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
      13              : !   See the GNU Lesser General Public License for more details.
      14              : !
      15              : !   You should have received a copy of the GNU Lesser General Public License
      16              : !   along with this program. If not, see <https://www.gnu.org/licenses/>.
      17              : !
      18              : ! ***********************************************************************
      19              : 
      20              : module colors_history
      21              : 
      22              :    use const_def, only: dp, mesa_dir
      23              :    use utils_lib, only: mesa_error
      24              :    use colors_def, only: Colors_General_Info, get_colors_ptr, num_color_filters, color_filter_names
      25              :    use colors_utils, only: remove_dat
      26              :    use bolometric, only: calculate_bolometric
      27              :    use synthetic, only: calculate_synthetic
      28              : 
      29              :    implicit none
      30              : 
      31              : contains
      32              : 
      33            0 :    integer function how_many_colors_history_columns(colors_handle)
      34              :       integer, intent(in) :: colors_handle
      35              :       integer :: num_cols, ierr
      36              :       type(Colors_General_Info), pointer :: colors_settings
      37              : 
      38              :       ierr = 0
      39            0 :       call get_colors_ptr(colors_handle, colors_settings, ierr)
      40            0 :       if (ierr /= 0) then
      41            0 :          write (*, *) 'failed in colors_ptr'
      42            0 :          num_cols = 0
      43            0 :          return
      44              :       end if
      45              : 
      46            0 :       if (.not. colors_settings%use_colors) then
      47              :          num_cols = 0
      48              :       else
      49            0 :          num_cols = 2 + num_color_filters
      50              :       end if
      51              : 
      52            0 :       how_many_colors_history_columns = num_cols
      53              :    end function how_many_colors_history_columns
      54              : 
      55            0 :    subroutine data_for_colors_history_columns( &
      56              :       t_eff, log_g, R, metallicity, &
      57            0 :       colors_handle, n, names, vals, ierr)
      58              :       real(dp), intent(in) :: t_eff, log_g, R, metallicity
      59              :       integer, intent(in) :: colors_handle, n
      60              :       character(len=80) :: names(n)
      61              :       real(dp) :: vals(n)
      62              :       integer, intent(out) :: ierr
      63              : 
      64              :       type(Colors_General_Info), pointer :: colors_settings
      65              :       integer :: i, filter_offset
      66            0 :       real(dp) :: d, bolometric_magnitude, bolometric_flux
      67              :       character(len=256) :: sed_filepath, filter_filepath, filter_name, filter_dir, vega_filepath
      68              :       logical :: make_sed
      69              : 
      70            0 :       real(dp), dimension(:), allocatable :: wavelengths, fluxes, filter_wavelengths, filter_trans
      71              : 
      72              :       ierr = 0
      73            0 :       call get_colors_ptr(colors_handle, colors_settings, ierr)
      74            0 :       if (ierr /= 0) then
      75            0 :          write (*, *) 'failed in get_colors_ptr'
      76            0 :          return
      77              :       end if
      78              : 
      79              :       !metallicity = colors_settings% metallicity
      80            0 :       d = colors_settings%distance
      81            0 :       sed_filepath = trim(mesa_dir)//colors_settings%stellar_atm
      82            0 :       filter_dir = trim(mesa_dir)//colors_settings%instrument
      83            0 :       vega_filepath = trim(mesa_dir)//colors_settings%vega_sed
      84            0 :       make_sed = colors_settings%make_csv
      85              : 
      86              :       call calculate_bolometric(t_eff, log_g, metallicity, R, d, &
      87            0 :                                 bolometric_magnitude, bolometric_flux, wavelengths, fluxes, sed_filepath)
      88            0 :       names(1) = "Mag_bol"
      89            0 :       vals(1) = bolometric_magnitude
      90            0 :       names(2) = "Flux_bol"
      91            0 :       vals(2) = bolometric_flux
      92            0 :       filter_offset = 2
      93              : 
      94            0 :       if (n == num_color_filters + filter_offset) then
      95            0 :          do i = 1, num_color_filters
      96            0 :             filter_name = trim(remove_dat(color_filter_names(i)))
      97            0 :             names(i + filter_offset) = filter_name
      98              : 
      99            0 :             filter_filepath = trim(filter_dir)//"/"//color_filter_names(i)
     100              : 
     101            0 :             if (t_eff >= 0 .and. metallicity >= 0) then
     102              :                vals(i + filter_offset) = calculate_synthetic(t_eff, log_g, metallicity, ierr, &
     103              :                                                              wavelengths, fluxes, filter_wavelengths, filter_trans, &
     104              :                                                              filter_filepath, vega_filepath, color_filter_names(i), &
     105            0 :                                                              make_sed, colors_settings%colors_results_directory)
     106            0 :                if (ierr /= 0) vals(i + filter_offset) = -1.0_dp
     107              :             else
     108            0 :                vals(i + filter_offset) = -1.0_dp
     109            0 :                ierr = 1
     110              :             end if
     111              :          end do
     112              :       else
     113            0 :          ierr = 1
     114            0 :          call mesa_error(__FILE__, __LINE__, 'colors: data_for_colors_history_columns array size mismatch')
     115              :       end if
     116              : 
     117            0 :    end subroutine data_for_colors_history_columns
     118              : 
     119              : end module colors_history