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