Line data    Source code

       1              : ! ***********************************************************************
       2              : !
       3              : !   Copyright (C) 2025  Niall Miller & 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_def
      21              : 
      22              :    use const_def, only: dp
      23              : 
      24              :    implicit none
      25              : 
      26              :    ! Make everything in this module public by default
      27              :    public
      28              : 
      29              :    ! Colors Module control parameters
      30              :    type :: Colors_General_Info
      31              :       character(len=256) :: instrument
      32              :       character(len=256) :: vega_sed
      33              :       character(len=256) :: stellar_atm
      34              :       character(len=256) :: colors_results_directory
      35              :       real(dp) :: metallicity
      36              :       real(dp) :: distance
      37              :       logical :: make_csv
      38              :       logical :: use_colors
      39              :       ! bookkeeping
      40              :       integer :: handle
      41              :       logical :: in_use
      42              :    end type Colors_General_Info
      43              : 
      44              :    ! TODO: Use handles/caching in the future once we have more colors tables
      45              :    ! For now, we will just point to a single file
      46              :    integer :: num_color_filters
      47              :    character(len=100), allocatable :: color_filter_names(:)
      48              : 
      49              :    integer, parameter :: max_colors_handles = 10
      50              :    type(Colors_General_Info), target :: colors_handles(max_colors_handles)
      51              : 
      52              :    logical :: colors_is_initialized = .false.
      53              : 
      54              :    character(len=1000) :: colors_dir, colors_cache_dir, colors_temp_cache_dir
      55              :    logical :: colors_use_cache = .true.
      56              : 
      57              : contains
      58              : 
      59            1 :    subroutine colors_def_init(colors_cache_dir_in)
      60              :       use utils_lib, only: mkdir
      61              :       use const_def, only: mesa_data_dir, mesa_caches_dir, mesa_temp_caches_dir, use_mesa_temp_cache
      62              :       character(*), intent(in) :: colors_cache_dir_in
      63              :       integer :: i
      64              : 
      65            1 :       if (len_trim(colors_cache_dir_in) > 0) then
      66            0 :          colors_cache_dir = colors_cache_dir_in
      67            1 :       else if (len_trim(mesa_caches_dir) > 0) then
      68            0 :          colors_cache_dir = trim(mesa_caches_dir)//'/colors_cache'
      69              :       else
      70            1 :          colors_cache_dir = trim(mesa_data_dir)//'/colors_data/cache'
      71              :       end if
      72            1 :       call mkdir(colors_cache_dir)
      73              : 
      74           11 :       do i = 1, max_colors_handles
      75           10 :          colors_handles(i)%handle = i
      76           11 :          colors_handles(i)%in_use = .false.
      77              :       end do
      78              : 
      79            1 :       colors_temp_cache_dir = trim(mesa_temp_caches_dir)//'/colors_cache'
      80            1 :       if (use_mesa_temp_cache) call mkdir(colors_temp_cache_dir)
      81              : 
      82            1 :    end subroutine colors_def_init
      83              : 
      84            1 :    integer function do_alloc_colors(ierr)
      85              :       integer, intent(out) :: ierr
      86              :       integer :: i
      87            1 :       ierr = 0
      88            1 :       do_alloc_colors = -1
      89            2 :       !$omp critical (colors_handle)
      90            1 :       do i = 1, max_colors_handles
      91            1 :          if (.not. colors_handles(i)%in_use) then
      92            1 :             colors_handles(i)%in_use = .true.
      93            1 :             do_alloc_colors = i
      94            1 :             exit
      95              :          end if
      96              :       end do
      97              :       !$omp end critical (colors_handle)
      98            1 :       if (do_alloc_colors == -1) then
      99            0 :          ierr = -1
     100            0 :          return
     101              :       end if
     102            1 :       if (colors_handles(do_alloc_colors)%handle /= do_alloc_colors) then
     103            0 :          ierr = -1
     104            0 :          return
     105              :       end if
     106              :    end function do_alloc_colors
     107              : 
     108            1 :    subroutine do_free_colors(handle)
     109              :       integer, intent(in) :: handle
     110            1 :       if (handle >= 1 .and. handle <= max_colors_handles) &
     111            1 :          colors_handles(handle)%in_use = .false.
     112            1 :    end subroutine do_free_colors
     113              : 
     114            8 :    subroutine get_colors_ptr(handle, rq, ierr)
     115              :       integer, intent(in) :: handle
     116              :       type(Colors_General_Info), pointer, intent(out) :: rq
     117              :       integer, intent(out):: ierr
     118            8 :       if (handle < 1 .or. handle > max_colors_handles) then
     119            0 :          ierr = -1
     120            0 :          return
     121              :       end if
     122            8 :       rq => colors_handles(handle)
     123            8 :       ierr = 0
     124              :    end subroutine get_colors_ptr
     125              : 
     126            1 :    subroutine do_free_colors_tables
     127              : 
     128              :       ! TODO: implement me if needed, see kap
     129              : 
     130              :       ! for now, free the strings tables
     131            1 :       if (allocated(color_filter_names)) deallocate (color_filter_names)
     132              : 
     133            1 :    end subroutine do_free_colors_tables
     134              : 
     135            0 : end module colors_def