1 | MODULE logging |
---|
2 | |
---|
3 | ! see also use_logging.h |
---|
4 | ! macro LOGBUF accumulates log output into logging_buffer |
---|
5 | |
---|
6 | IMPLICIT NONE |
---|
7 | SAVE |
---|
8 | PRIVATE |
---|
9 | |
---|
10 | INTERFACE ! Explicit interfaces for plugins |
---|
11 | |
---|
12 | ! Plugin that typically prints all lines in the loggin buffer 'buf' and prepends tags (log level, timestamp, ...) |
---|
13 | SUBROUTINE plugin(lev, tag, buf) |
---|
14 | INTEGER, INTENT(IN) :: lev |
---|
15 | CHARACTER(*), INTENT(IN) :: tag, buf(:) |
---|
16 | END SUBROUTINE plugin |
---|
17 | |
---|
18 | ! Plugin that writes into string 'line' information about the gridpoint of index 'index' |
---|
19 | SUBROUTINE plugin_log_gridpoint(index, line) |
---|
20 | INTEGER, INTENT(IN) :: index ! index of gridpoint |
---|
21 | CHARACTER(*), INTENT(OUT) :: line |
---|
22 | END SUBROUTINE plugin_log_gridpoint |
---|
23 | |
---|
24 | END INTERFACE |
---|
25 | |
---|
26 | ! This module provides a default implementation of flush_plugin but the top-level driver is welcome to override it. |
---|
27 | PROCEDURE(plugin), POINTER :: flush_plugin => default_flush_plugin |
---|
28 | |
---|
29 | ! The top-level driver MUST provide an implementation for log_gridpoint_plugin |
---|
30 | PROCEDURE(plugin_log_gridpoint), POINTER :: log_gridpoint_plugin => NULL() |
---|
31 | |
---|
32 | INTEGER, PARAMETER :: linesize=10000, logging_bufsize=100 |
---|
33 | CHARACTER(linesize) :: logging_buf(logging_bufsize) |
---|
34 | |
---|
35 | INTEGER :: logging_lineno=0 |
---|
36 | |
---|
37 | ! messages with a log level higher > max_log_level are not printed |
---|
38 | INTEGER, PARAMETER, PUBLIC :: log_level_fatal=1, log_level_error=2, log_level_warn=3, log_level_info=4, log_level_dbg=5 |
---|
39 | INTEGER, PUBLIC :: max_log_level = log_level_info |
---|
40 | |
---|
41 | PUBLIC :: logging_buf, logging_bufsize, logging_lineno, flush_log, log_gridpoint, & |
---|
42 | flush_plugin, log_gridpoint_plugin |
---|
43 | |
---|
44 | CONTAINS |
---|
45 | |
---|
46 | SUBROUTINE flush_log(lev,tag) |
---|
47 | INTEGER, INTENT(IN) :: lev |
---|
48 | CHARACTER(*), INTENT(IN) :: tag |
---|
49 | IF(logging_lineno>0 .AND. lev<=max_log_level) CALL flush_plugin(lev, TRIM(tag), logging_buf(1:logging_lineno)) |
---|
50 | logging_lineno=0 |
---|
51 | END SUBROUTINE flush_log |
---|
52 | |
---|
53 | SUBROUTINE default_flush_plugin(lev, tag, buf) |
---|
54 | INTEGER, INTENT(IN) :: lev |
---|
55 | CHARACTER(*), INTENT(IN) :: tag, buf(:) |
---|
56 | CHARACTER(3), DIMENSION(log_level_dbg) :: dbtag = (/ 'FAT', 'ERR', 'WRN', 'INF', 'DBG' /) |
---|
57 | CHARACTER(100) :: prefix |
---|
58 | INTEGER :: i |
---|
59 | WRITE(prefix,*) '[', dbtag(lev), ' ', tag, ']' |
---|
60 | DO i=1, SIZE(buf) |
---|
61 | PRINT *, TRIM(prefix), TRIM(buf(i)) |
---|
62 | END DO |
---|
63 | END SUBROUTINE default_flush_plugin |
---|
64 | |
---|
65 | SUBROUTINE log_gridpoint(index) |
---|
66 | INTEGER, INTENT(IN) :: index |
---|
67 | logging_lineno = logging_lineno+1 |
---|
68 | CALL log_gridpoint_plugin(index, logging_buf(logging_lineno)) |
---|
69 | END SUBROUTINE log_gridpoint |
---|
70 | |
---|
71 | END MODULE logging |
---|