| 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 |
|---|