MOM_error_handler.F90
1! This file is part of MOM6, the Modular Ocean Model version 6.
2! See the LICENSE file for licensing information.
3! SPDX-License-Identifier: Apache-2.0
4
5!> Routines for error handling and I/O management
6module mom_error_handler
7
8use mom_coms_infra, only : num_pes
9use mom_error_infra, only : mom_err, is_root_pe, stdlog, stdout, note, warning, fatal
12use posix, only : sigjmp_buf, siglongjmp
14
15! MOM_error_infra does not provide stderr . We only use stderr in this module
16! *IF* FMS has not been initialized. Further, stderr is only used internally and
17! not made public. Other modules should obtain stderr from MOM_io.
18use iso_fortran_env, only : stderr=>error_unit
19
20implicit none ; private
21
22! These routines are found in this module.
24public :: mom_set_verbosity, mom_get_verbosity, mom_verbose_enough
25public :: calltree_showquery, calltree_enter, calltree_leave, calltree_waypoint
26! These routines are simply passed-through from MOM_error_infra
27public :: is_root_pe, stdlog, stdout
28!> Integer parameters encoding the severity of an error message
29public :: note, warning, fatal
30public :: disable_fatal_errors, enable_fatal_errors, set_skip_mpi
31
32integer :: verbosity = 6
33!< Verbosity level:
34!! 0 - FATAL messages only
35!! 1 - FATAL + WARNING messages only
36!! 2 - FATAL + WARNING + NOTE messages only [default]
37!! 3 - above + informational
38!! 4 -
39!! 5 -
40!! 6 - above + call tree
41!! 7 -
42!! 8 -
43!! 9 - anything and everything (also set with DEBUG=True)
44
45! Note that this module default will only hold until the
46! VERBOSITY parameter is parsed and the given default imposed.
47! We set it to 6 here so that the call tree will print before
48! the parser has been initialized
49! Also note that this is a module variable rather than contained in
50! a type passed by argument (preferred for most data) for convenience
51! and to reduce obfuscation of code
52logical :: verbosity_set = .false.
53!< True if the verbosity has already been set at run-time.
54
55integer :: calltreeindentlevel = 0
56!< The level of calling within the call tree
57
58! Error handling
59
60logical :: ignore_fatal = .false.
61 !< If true, ignore FATAL errors and jump to a prior state.
62integer, parameter :: err_signal = sigusr1
63 !< Signal used to trigger the error handler
64integer :: err_pid
65 !< Process ID for the error handler (either self or MPI launcher)
66procedure(handler_interface), pointer :: prior_handler
67 !< The default signal handler used before signal() setup (usually SIG_DFT)
68type(sigjmp_buf) :: prior_env
69 !< Buffer containing the program state to be recovered by longjmp
70logical :: skip_mpi_dep = .false.
71 !< If true, bypass any calls that require FMS (MPI) to have been initialized.
72 !! Use s/r set_skip_mpi() to change this flag. By default, set_skip_mpi() does not
73 !! need to be called and this flag is false so that FMS (and MPI) should be
74 !! initialized.
75
76contains
77
78!> This provides a convenient interface for writing an informative comment, depending
79!! on the model's current verbosity setting and the verbosity level for this message.
80subroutine mom_mesg(message, verb, all_print)
81 character(len=*), intent(in) :: message !< A message to write out
82 integer, optional, intent(in) :: verb !< A level of verbosity for this message
83 logical, optional, intent(in) :: all_print !< If present and true, any PEs are
84 !! able to write this message.
85 ! This provides a convenient interface for writing an informative comment.
86 integer :: verb_msg
87 logical :: write_msg
88
89 if (skip_mpi_dep) then
90 write_msg = .true.
91 else
92 write_msg = is_root_pe()
93 endif
94 if (present(all_print)) write_msg = write_msg .or. all_print
95
96 verb_msg = 2 ; if (present(verb)) verb_msg = verb
97 if (write_msg .and. (verbosity >= verb_msg)) call loc_mom_err(note, message)
98
99end subroutine mom_mesg
100
101!> Enable error handling, replacing FATALs in MOM_error with err_handler.
102subroutine disable_fatal_errors(env)
103 type(sigjmp_buf), intent(in) :: env
104 !> Process recovery state after FATAL errors
105
106 integer :: sig
107
108 ignore_fatal = .true.
109
110 ! TODO: Only need to call this once; move to an init() function?
111 if (num_pes() > 1) then
112 err_pid = getppid()
113 else
114 err_pid = getpid()
115 endif
116
117 ! Store the program state
118 prior_env = env
119
120 ! Setup the signal handler
121 ! NOTE: Passing parameters to signal() in GFortran causes a compiler error.
122 ! We avert this by copying err_signal to a variable.
123 sig = err_signal
124 ! TODO: Use sigaction() in place of signal()
125 prior_handler => signal(sig, err_handler)
126end subroutine disable_fatal_errors
127
128!> Disable the error handler and abort on FATAL
129subroutine enable_fatal_errors()
130 integer :: sig
131 procedure(handler_interface), pointer :: dummy
132
133 ignore_fatal = .false.
134 err_pid = -1 ! NOTE: 0 might be safer, since it's unusable.
135
136 ! Restore the original signal handler (usually SIG_DFT).
137 sig = err_signal
138 ! NOTE: As above, we copy the err_signal to accommodate GFortran.
139 dummy => signal(sig, prior_handler)
140end subroutine enable_fatal_errors
141
142!> Enable/disable skipping MPI dependent behaviors
143subroutine set_skip_mpi(skip)
144 logical, intent(in) :: skip !< State to assign
145
146 skip_mpi_dep = skip
147
148end subroutine set_skip_mpi
149
150!> This provides a convenient interface for writing an error message
151!! with run-time filter based on a verbosity and the severity of the error.
152subroutine mom_error(level, message, all_print)
153 integer, intent(in) :: level !< The severity level of this message
154 character(len=*), intent(in) :: message !< A message to write out
155 logical, optional, intent(in) :: all_print !< If present and true, any PEs are
156 !! able to write this message.
157 logical :: write_msg
158 integer :: rc
159
160 if (skip_mpi_dep) then
161 write_msg = .true.
162 else
163 write_msg = is_root_pe()
164 endif
165 if (present(all_print)) write_msg = write_msg .or. all_print
166
167 select case (level)
168 case (note)
169 if (write_msg.and.verbosity>=2) call loc_mom_err(note, message)
170 case (warning)
171 if (write_msg.and.verbosity>=1) call loc_mom_err(warning, message)
172 case (fatal)
173 if (ignore_fatal) then
174 print *, "(FATAL): " // message
175 rc = kill(err_pid, err_signal)
176 ! NOTE: MPI launchers require, in their words, "a few seconds" to
177 ! propagate the signal to the nodes, so we wait here to avoid
178 ! anomalous FATAL calls.
179 ! In practice, the signal will take control before sleep() completes.
180 rc = sleep(3)
181 endif
182 if (verbosity>=0) call loc_mom_err(fatal, message)
183 case default
184 call loc_mom_err(level, message)
185 end select
186end subroutine mom_error
187
188!> A private routine through which all error/warning/note messages are written
189!! by this module.
190subroutine loc_mom_err(level, message)
191 integer, intent(in) :: level !< The severity level of this message
192 character(len=*), intent(in) :: message !< A message to write out
193
194 if (.not. skip_mpi_dep) then
195 call mom_err(level, message)
196 else
197 ! FMS (and therefore MPI) have not been initialized
198 write(stdout(),'(a)') trim(message) ! Send message to stdout
199 select case (level)
200 case (warning)
201 write(stderr,'("WARNING ",a)') trim(message) ! Additionally send message to stderr
202 case (fatal)
203 write(stderr,'("ERROR: ",a)') trim(message) ! Additionally send message to stderr
204 end select
205 endif
206
207end subroutine loc_mom_err
208
209!> This subroutine sets the level of verbosity filtering MOM error messages
210subroutine mom_set_verbosity(verb, may_reset)
211 integer, intent(in) :: verb !< A level of verbosity to set
212 logical, optional, intent(in) :: may_reset !< If true, set the verbosity even if it has been set
213 !! before, perhaps by another component like SIS2.
214 character(len=80) :: msg
215 if (verb>=0 .and. verb<10) then
216 if (.not.verbosity_set) verbosity = verb
217 if (present(may_reset)) then
218 if (may_reset) verbosity = verb
219 endif
220 verbosity_set = .true.
221 else
222 write(msg,'("Attempt to set verbosity outside of range (0-9). verb=",I0)') verb
223 call mom_error(fatal, msg)
224 endif
225end subroutine mom_set_verbosity
226
227!> This subroutine gets the level of verbosity filtering MOM error messages
228function mom_get_verbosity()
229 integer :: mom_get_verbosity
230 mom_get_verbosity = verbosity
231end function mom_get_verbosity
232
233!> This tests whether the level of verbosity filtering MOM error messages is
234!! sufficient to write a message of verbosity level verb
235function mom_verbose_enough(verb)
236 integer, intent(in) :: verb !< A level of verbosity to test
237 logical :: mom_verbose_enough
238 mom_verbose_enough = (verbosity >= verb)
239end function mom_verbose_enough
240
241!> Returns True, if the verbosity>=6 indicating to show the call tree
242function calltree_showquery()
243 ! Local variables
244 logical :: calltree_showquery
245 calltree_showquery = (verbosity >= 6)
246end function calltree_showquery
247
248!> Writes a message about entering a subroutine if call tree reporting is active
249subroutine calltree_enter(mesg,n)
250 character(len=*), intent(in) :: mesg !< Message to write
251 integer, optional, intent(in) :: n !< An optional integer to write at end of message
252 ! Local variables
253 character(len=8) :: nasstring
254 calltreeindentlevel = calltreeindentlevel + 1
255 if (verbosity<6) return
256 if (is_root_pe()) then
257 nasstring = ''
258 if (present(n)) then
259 write(nasstring(1:8),'(i8)') n
260 call loc_mom_err(note, 'callTree: '// &
261 repeat(' ',calltreeindentlevel-1)//'loop '//trim(mesg)//trim(nasstring))
262 else
263 call loc_mom_err(note, 'callTree: '// &
264 repeat(' ',calltreeindentlevel-1)//'---> '//trim(mesg))
265 endif
266 endif
267end subroutine calltree_enter
268
269!> Writes a message about leaving a subroutine if call tree reporting is active
270subroutine calltree_leave(mesg)
271 character(len=*) :: mesg !< Message to write
272 if (calltreeindentlevel<1) write(0,*) 'callTree_leave: error callTreeIndentLevel=',calltreeindentlevel,trim(mesg)
273 calltreeindentlevel = calltreeindentlevel - 1
274 if (verbosity<6) return
275 if (is_root_pe()) call loc_mom_err(note, 'callTree: '// &
276 repeat(' ',calltreeindentlevel)//'<--- '//trim(mesg))
277end subroutine calltree_leave
278
279!> Writes a message about reaching a milestone if call tree reporting is active
280subroutine calltree_waypoint(mesg,n)
281 character(len=*), intent(in) :: mesg !< Message to write
282 integer, optional, intent(in) :: n !< An optional integer to write at end of message
283 ! Local variables
284 character(len=8) :: nasstring
285 if (calltreeindentlevel<0) write(0,*) 'callTree_waypoint: error callTreeIndentLevel=',calltreeindentlevel,trim(mesg)
286 if (verbosity<6) return
287 if (is_root_pe()) then
288 nasstring = ''
289 if (present(n)) then
290 write(nasstring(1:8),'(i8)') n
291 call loc_mom_err(note, 'callTree: '// &
292 repeat(' ',calltreeindentlevel)//'loop '//trim(mesg)//trim(nasstring))
293 else
294 call loc_mom_err(note, 'callTree: '// &
295 repeat(' ',calltreeindentlevel)//'o '//trim(mesg))
296 endif
297 endif
298end subroutine calltree_waypoint
299
300!> Issues a FATAL error if the assertion fails, i.e. the first argument is false.
301subroutine assert(logical_arg, msg)
302 logical, intent(in) :: logical_arg !< If false causes a FATAL error
303 character(len=*), intent(in) :: msg !< Message to issue in case of failed assertion
304
305 if (.not. logical_arg) then
306 call mom_error(fatal, msg)
307 endif
308end subroutine assert
309
310!> Restore the process state via longjmp after receiving a signal.
311subroutine err_handler(sig)
312 integer, intent(in) :: sig
313 !< Signal passed to the handler (unused)
314 call siglongjmp(prior_env, 1)
315end subroutine
316
317end module mom_error_handler