Neko 1.99.1
A portable framework for high-order spectral element flow simulations
Loading...
Searching...
No Matches
log.f90
Go to the documentation of this file.
1! Copyright (c) 2021-2024, The Neko Authors
2! All rights reserved.
3!
4! Redistribution and use in source and binary forms, with or without
5! modification, are permitted provided that the following conditions
6! are met:
7!
8! * Redistributions of source code must retain the above copyright
9! notice, this list of conditions and the following disclaimer.
10!
11! * Redistributions in binary form must reproduce the above
12! copyright notice, this list of conditions and the following
13! disclaimer in the documentation and/or other materials provided
14! with the distribution.
15!
16! * Neither the name of the authors nor the names of its
17! contributors may be used to endorse or promote products derived
18! from this software without specific prior written permission.
19!
20! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
21! "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
22! LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
23! FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
24! COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
25! INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
26! BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
27! LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
28! CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
29! LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
30! ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
31! POSSIBILITY OF SUCH DAMAGE.
32!
34module logger
35 use comm, only : pe_rank
36 use num_types, only : rp
37 use utils, only: neko_error
38 use, intrinsic :: iso_fortran_env, only: stdout => output_unit, &
39 stderr => error_unit
40 implicit none
41 private
42
43 ! > Size of the log message buffer
44 !! @note This adjust for the leading space applied by `write`. 80 character
45 !! output log leaves 79 characters for the message.
46 integer, public, parameter :: log_size = 79
47
48 type, public :: log_t
49 integer, private :: indent_
50 integer, private :: section_id_
51 integer, private :: tab_size_
52 integer, private :: level_
53 integer, private :: unit_
54 contains
55 procedure, pass(this) :: init => log_init
56 procedure, pass(this) :: free => log_free
57 procedure, pass(this) :: begin => log_begin
58 procedure, pass(this) :: end => log_end
59 procedure, pass(this) :: indent => log_indent
60 procedure, pass(this) :: newline => log_newline
61 procedure, pass(this) :: message => log_message
62 procedure, pass(this) :: section => log_section
63 procedure, pass(this) :: header => log_header
64 procedure, pass(this) :: error => log_error
65 procedure, pass(this) :: warning => log_warning
66 procedure, pass(this) :: end_section => log_end_section
67 end type log_t
68
70 type(log_t), public :: neko_log
72 integer, public, parameter :: neko_log_quiet = 0
74 integer, public, parameter :: neko_log_info = 1
76 integer, public, parameter :: neko_log_verbose = 2
78 integer, public, parameter :: neko_log_debug = 10
79
80contains
81
83 subroutine log_init(this)
84 class(log_t), intent(inout) :: this
85 character(len=255) :: log_level
86 character(len=255) :: log_tab_size
87 character(len=255) :: log_file
88 integer :: envvar_len
89
90 this%indent_ = 0
91 this%section_id_ = 0
92
93 call get_environment_variable("NEKO_LOG_TAB_SIZE", log_tab_size, envvar_len)
94 if (envvar_len .gt. 0) then
95 read(log_tab_size(1:envvar_len), *) this%tab_size_
96 else
97 this%tab_size_ = 1
98 end if
99
100 call get_environment_variable("NEKO_LOG_LEVEL", log_level, envvar_len)
101 if (envvar_len .gt. 0) then
102 read(log_level(1:envvar_len), *) this%level_
103 else
104 this%level_ = neko_log_info
105 end if
106
107 call get_environment_variable("NEKO_LOG_FILE", log_file, envvar_len)
108 if (envvar_len .gt. 0) then
109 open(newunit = this%unit_, file = trim(log_file), status = 'replace', &
110 action = 'write')
111 else
112 this%unit_ = stdout
113 end if
114
115 end subroutine log_init
116
118 subroutine log_free(this)
119 class(log_t), intent(inout) :: this
120
121 if (this%section_id_ .ne. 0) then
122 call neko_error("Log is unbalanced")
123 end if
124
125 if (this%unit_ .ne. stdout) then
126 close(this%unit_)
127 end if
128
129 this%indent_ = 0
130 this%level_ = neko_log_info
131 this%unit_ = -1
132
133 end subroutine log_free
134
136 subroutine log_begin(this)
137 class(log_t), intent(inout) :: this
138
139 if (pe_rank .eq. 0) then
140 this%section_id_ = this%section_id_ + 1
141 this%indent_ = this%indent_ + this%tab_size_
142 end if
143
144 end subroutine log_begin
145
147 subroutine log_end(this)
148 class(log_t), intent(inout) :: this
149
150 if (pe_rank .eq. 0) then
151 if (this%section_id_ .eq. 0) then
152 call neko_error("Log is unbalanced")
153 end if
154 this%section_id_ = this%section_id_ - 1
155 this%indent_ = this%indent_ - this%tab_size_
156 end if
157
158 end subroutine log_end
159
161 subroutine log_indent(this)
162 class(log_t), intent(in) :: this
163
164 if (pe_rank .eq. 0) then
165 write(this%unit_, '(A)', advance = 'no') repeat(' ', this%indent_)
166 end if
167
168 end subroutine log_indent
169
171 subroutine log_newline(this, lvl)
172 class(log_t), intent(in) :: this
173 integer, optional :: lvl
174
175 integer :: lvl_
176
177 if (present(lvl)) then
178 lvl_ = lvl
179 else
180 lvl_ = neko_log_info
181 end if
182
183 if (lvl_ .gt. this%level_) then
184 return
185 end if
186
187 if (pe_rank .eq. 0) then
188 write(this%unit_, '(A)') ''
189 end if
190
191 end subroutine log_newline
192
194 subroutine log_message(this, msg, lvl)
195 class(log_t), intent(in) :: this
196 character(len=*), intent(in) :: msg
197 integer, optional :: lvl
198 integer :: lvl_
199
200 if (present(lvl)) then
201 lvl_ = lvl
202 else
203 lvl_ = neko_log_info
204 end if
205
206 if (lvl_ .gt. this%level_) then
207 return
208 end if
209
210 if (pe_rank .eq. 0) then
211 call this%indent()
212 write(this%unit_, '(A)') trim(msg)
213 end if
214
215 end subroutine log_message
216
218 subroutine log_header(this, version, build_info)
219 class(log_t), intent(in) :: this
220 character(len=*), intent(in) :: version
221 character(len=*), intent(in) :: build_info
222
223 if (pe_rank .eq. 0) then
224 write(this%unit_, '(A)') ''
225 write(this%unit_, '(1X,A)') ' _ __ ____ __ __ ____ '
226 write(this%unit_, '(1X,A)') ' / |/ / / __/ / //_/ / __ \ '
227 write(this%unit_, '(1X,A)') ' / / / _/ / ,< / /_/ / '
228 write(this%unit_, '(1X,A)') '/_/|_/ /___/ /_/|_| \____/ '
229 write(this%unit_, '(A)') ''
230 write(this%unit_, '(1X,A,A,A)') '(version: ', trim(version), ')'
231 write(this%unit_, '(1X,A)') trim(build_info)
232 write(this%unit_, '(A)') ''
233 end if
234
235 end subroutine log_header
236
238 subroutine log_error(this, msg)
239 class(log_t), intent(in) :: this
240 character(len=*), intent(in) :: msg
241
242 if (pe_rank .eq. 0) then
243 call this%indent()
244 write(stderr, '(A,A,A)') '*** ERROR: ', trim(msg), ' ***'
245 end if
246
247 end subroutine log_error
248
250 subroutine log_warning(this, msg)
251 class(log_t), intent(in) :: this
252 character(len=*), intent(in) :: msg
253
254 if (pe_rank .eq. 0) then
255 call this%indent()
256 write(this%unit_, '(A,A,A)') '*** WARNING: ', trim(msg), ' ***'
257 end if
258
259 end subroutine log_warning
260
262 subroutine log_section(this, msg, lvl)
263 class(log_t), intent(inout) :: this
264 character(len=*), intent(in) :: msg
265 integer, optional :: lvl
266
267 character(len=LOG_SIZE) :: log_msg
268 integer :: pre, pos
269
270 call this%begin()
271
272 if (pe_rank .eq. 0) then
273 pre = (30 - len_trim(msg)) / 2
274 pos = 30 - (len_trim(msg) + pre)
275
276 write(log_msg, '(A,A,A)') repeat('-', pre), trim(msg), repeat('-', pos)
277
278 call this%newline(lvl)
279 call this%message(trim(log_msg), lvl)
280 end if
281
282 end subroutine log_section
283
285 subroutine log_end_section(this, msg, lvl)
286 class(log_t), intent(inout) :: this
287 character(len=*), intent(in), optional :: msg
288 integer, optional :: lvl
289 integer :: lvl_
290
291 if (present(msg)) then
292 call this%message(msg, lvl)
293 end if
294
295 call this%end()
296
297 end subroutine log_end_section
298
299 !
300 ! Rudimentary C interface
301 !
302
305 subroutine log_message_c(c_msg) bind(c, name = 'log_message')
306 use, intrinsic :: iso_c_binding
307 character(kind=c_char), dimension(*), intent(in) :: c_msg
308 character(len=LOG_SIZE) :: msg
309 integer :: len
310
311 if (pe_rank .eq. 0) then
312 len = 0
313 do
314 if (c_msg(len+1) .eq. c_null_char) exit
315 len = len + 1
316 msg(len:len) = c_msg(len)
317 end do
318
319 call neko_log%message(trim(msg(1:len)))
320 end if
321
322 end subroutine log_message_c
323
326 subroutine log_error_c(c_msg) bind(c, name = "log_error")
327 use, intrinsic :: iso_c_binding
328 character(kind=c_char), dimension(*), intent(in) :: c_msg
329 character(len=LOG_SIZE) :: msg
330 integer :: len
331
332 if (pe_rank .eq. 0) then
333 len = 0
334 do
335 if (c_msg(len+1) .eq. c_null_char) exit
336 len = len + 1
337 msg(len:len) = c_msg(len)
338 end do
339
340 call neko_log%indent()
341 write(stderr, '(A,A,A)') '*** ERROR: ', trim(msg(1:len)), ' ***'
342 end if
343
344 end subroutine log_error_c
345
348 subroutine log_warning_c(c_msg) bind(c, name = "log_warning")
349 use, intrinsic :: iso_c_binding
350 character(kind=c_char), dimension(*), intent(in) :: c_msg
351 character(len=LOG_SIZE) :: msg
352 integer :: len
353
354 if (pe_rank .eq. 0) then
355 len = 0
356 do
357 if (c_msg(len+1) .eq. c_null_char) exit
358 len = len + 1
359 msg(len:len) = c_msg(len)
360 end do
361
362 call neko_log%indent()
363 write(neko_log%unit_, '(A,A,A)') &
364 '*** WARNING: ', trim(msg(1:len)), ' ***'
365 end if
366
367 end subroutine log_warning_c
368
371 subroutine log_section_c(c_msg) bind(c, name = "log_section")
372 use, intrinsic :: iso_c_binding
373 character(kind=c_char), dimension(*), intent(in) :: c_msg
374 character(len=LOG_SIZE) :: msg
375 integer :: len
376
377 if (pe_rank .eq. 0) then
378 len = 0
379 do
380 if (c_msg(len+1) .eq. c_null_char) exit
381 len = len + 1
382 msg(len:len) = c_msg(len)
383 end do
384
385 call neko_log%section(trim(msg(1:len)))
386 end if
387
388 end subroutine log_section_c
389
392 subroutine log_end_section_c() bind(c, name = "log_end_section")
393
394 call neko_log%end_section()
395
396 end subroutine log_end_section_c
397
398end module logger
Definition comm.F90:1
integer, public pe_rank
MPI rank.
Definition comm.F90:55
Module for file I/O operations.
Definition file.f90:34
Logging routines.
Definition log.f90:34
subroutine log_end_section_c()
End a log section (from C)
Definition log.f90:393
subroutine log_end(this)
Decrease indention level.
Definition log.f90:148
subroutine log_header(this, version, build_info)
Write the Neko header to a log.
Definition log.f90:219
integer, parameter, public neko_log_verbose
Verbose log level.
Definition log.f90:76
subroutine log_message(this, msg, lvl)
Write a message to a log.
Definition log.f90:195
integer, parameter, public neko_log_quiet
Always logged.
Definition log.f90:72
subroutine log_begin(this)
Increase indention level.
Definition log.f90:137
subroutine log_message_c(c_msg)
Write a message to a log (from C)
Definition log.f90:306
subroutine log_end_section(this, msg, lvl)
End a log section.
Definition log.f90:286
subroutine log_init(this)
Initialize a log.
Definition log.f90:84
subroutine log_warning(this, msg)
Write a warning message to a log.
Definition log.f90:251
subroutine log_error_c(c_msg)
Write an error message to a log (from C)
Definition log.f90:327
subroutine log_indent(this)
Indent a log.
Definition log.f90:162
subroutine log_warning_c(c_msg)
Write a warning message to a log (from C)
Definition log.f90:349
subroutine log_newline(this, lvl)
Write a new line to a log.
Definition log.f90:172
subroutine log_section_c(c_msg)
Begin a new log section (from C)
Definition log.f90:372
integer, parameter, public neko_log_debug
Debug log level.
Definition log.f90:78
type(log_t), public neko_log
Global log stream.
Definition log.f90:70
integer, parameter, public log_size
Definition log.f90:46
integer, parameter, public neko_log_info
Default log level.
Definition log.f90:74
subroutine log_free(this)
Free a log.
Definition log.f90:119
subroutine log_section(this, msg, lvl)
Begin a new log section.
Definition log.f90:263
subroutine log_error(this, msg)
Write an error message to a log.
Definition log.f90:239
integer, parameter, public rp
Global precision used in computations.
Definition num_types.f90:12
Utilities.
Definition utils.f90:35