Line data Source code
1 : ! ***********************************************************************
2 : !
3 : ! Copyright (C) 2026 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 : !> Reading nested namelists
21 : module utils_namelist
22 : implicit none
23 : private
24 :
25 : integer, parameter :: max_nested_inlists = 10
26 : integer, parameter :: max_extra_inlists = 5
27 :
28 : abstract interface
29 : !> Read a single inlist
30 : !>
31 : !> Implementations of this interface should only read one namelist (with the unit, iostat, and iomsg passed to read) and
32 : !> optionally set the extra_inlists and extra_inlists_mask arguments. Each element of extra_inlists for which
33 : !> extra_inlists_mask is set to true will also be read in by read_namelist. If there is no need to read in extra inlists,
34 : !> just set all elements of extra_inlists_mask to false.
35 : subroutine reader(unit, iostat, iomsg, extra_inlists, extra_inlists_mask)
36 : use const_def, only: strlen
37 : import max_extra_inlists
38 : implicit none
39 : integer, intent(in) :: unit
40 : integer, intent(out) :: iostat
41 : character(len=strlen), intent(out) :: iomsg
42 : character(len=strlen), dimension(max_extra_inlists), intent(out) :: extra_inlists
43 : logical, dimension(max_extra_inlists), intent(out) :: extra_inlists_mask
44 : end subroutine reader
45 : end interface
46 :
47 : type missing_namelist
48 : integer, private :: action
49 : end type missing_namelist
50 :
51 : type(missing_namelist), public, parameter :: missing_namelist_error = missing_namelist(0)
52 : type(missing_namelist), public, parameter :: missing_namelist_warning = missing_namelist(1)
53 : type(missing_namelist), public, parameter :: missing_namelist_silent = missing_namelist(2)
54 :
55 : public :: read_namelist, missing_namelist, reader, max_extra_inlists
56 :
57 : contains
58 : !> Read a nested set of namelists starting from a single file.
59 : !>
60 : !> This also handles error reporting to the user. Missing namelist
61 : !> entries are handled based on the value of the `missing` argument.
62 13 : subroutine read_namelist(file, r, namelist_name, ierr, missing)
63 : character(len=*), intent(in) :: file
64 : procedure(reader) :: r
65 : character(len=*), intent(in) :: namelist_name
66 : integer, intent(out) :: ierr
67 : type(missing_namelist), intent(in) :: missing
68 :
69 13 : if (len_trim(file) == 0) then
70 1 : ierr = 0
71 1 : return
72 : end if
73 :
74 12 : call read_one_namelist(file, r, namelist_name, 1, ierr, missing)
75 : end subroutine read_namelist
76 :
77 24 : recursive subroutine read_one_namelist(file, r, namelist_name, level, ierr, missing)
78 : use const_def, only: strlen
79 :
80 : character(len=*), intent(in) :: file
81 : procedure(reader) :: r
82 : character(len=*), intent(in) :: namelist_name
83 : integer, intent(in) :: level
84 : integer, intent(out) :: ierr
85 : type(missing_namelist), intent(in) :: missing
86 :
87 : integer :: iostat, unit, i
88 : character(len=strlen) :: iomsg
89 : character(len=strlen), dimension(max_extra_inlists) :: extra_inlists
90 : logical, dimension(max_extra_inlists) :: extra_inlists_mask
91 :
92 12 : if (level >= max_nested_inlists) then
93 0 : write(*, *) '[ERROR]: too many levels of nested ', namelist_name, ' inlist files'
94 0 : ierr = -1
95 1 : return
96 : end if
97 :
98 : open(newunit = unit, file = trim(file), action = 'read', &
99 12 : delim = 'quote', status = 'old', iostat = iostat, iomsg = iomsg)
100 :
101 12 : if (iostat /= 0) then
102 0 : write(*, *) '[ERROR]: Failed to open ', namelist_name, &
103 0 : ' namelist file "', trim(file), '". Error message: "', trim(iomsg), '"'
104 0 : ierr = -1
105 0 : return
106 : end if
107 :
108 12 : call r(unit, iostat, iomsg, extra_inlists, extra_inlists_mask)
109 :
110 12 : close(unit)
111 :
112 12 : if (iostat /= 0) then
113 1 : if (is_iostat_end(iostat)) then
114 1 : select case(missing%action)
115 : case(missing_namelist_error%action)
116 0 : write(*, *) '[ERROR]: Failed to read ', namelist_name, &
117 0 : ' namelist from "', trim(file), '". Namelist ', namelist_name, ' is not found'
118 0 : ierr = -1
119 : case(missing_namelist_warning%action)
120 1 : write(*, *) '[WARNING]: Failed to read ', namelist_name, &
121 2 : ' namelist from "', trim(file), '". Namelist ', namelist_name, ' is not found'
122 : case(missing_namelist_silent%action)
123 : ! Do nothing
124 : end select
125 : extra_inlists_mask(:) = .false.
126 : else
127 0 : write(*, *) '[ERROR]: Failed to read ', namelist_name, &
128 0 : ' namelist from "', trim(file), '". Error message: "', trim(iomsg), '"'
129 0 : ierr = -1
130 : end if
131 1 : return
132 : end if
133 :
134 66 : do i=1, max_extra_inlists
135 66 : if (extra_inlists_mask(i) .and. len_trim(extra_inlists(i)) /= 0) then
136 0 : call read_one_namelist(extra_inlists(i), r, namelist_name, level + 1, ierr, missing)
137 :
138 0 : if (ierr /= 0) then
139 : return
140 : end if
141 : end if
142 : end do
143 :
144 : end subroutine read_one_namelist
145 0 : end module utils_namelist
|
