source: branches/2014/dev_r4650_UKMO14.12_STAND_ALONE_OBSOPER/NEMOGCM/TOOLS/SIREN/src/logger.f90 @ 5600

Last change on this file since 5600 was 5600, checked in by andrewryan, 5 years ago

merged in latest version of trunk alongside changes to SAO_SRC to be compatible with latest OBS

File size: 21.3 KB
Line 
1!----------------------------------------------------------------------
2! NEMO system team, System and Interface for oceanic RElocable Nesting
3!----------------------------------------------------------------------
4!
5! MODULE: logger
6!
7! DESCRIPTION:
8!> @brief This module create logger file and allow to fill it depending of verbosity.
9!> @details
10!> verbosity could be choosen between :
11!>    - trace : Most detailed information.
12!>    - debug : Detailed information on the flow through the system.
13!>    - info  : Interesting runtime events (startup/shutdown).
14!>    - warning: Use of deprecated APIs, poor use of API, 'almost' errors,
15!> other runtime situations that are undesirable or unexpected,
16!> but not necessarily "wrong".
17!>    - error : Other runtime errors or unexpected conditions.
18!>    - fatal : Severe errors that cause premature termination.<br />
19!>  default verbosity is warning
20!
21!> If total number of error exceeded maximum number
22!> authorized, program stop.
23!>
24!> to open/create logger file:<br/>
25!> @code
26!>    CALL logger_open(cd_file, [cd_verbosity,] [id_loggerid,] [id_maxerror])
27!> @endcode
28!> - cd_file is logger file name
29!> - cd_verbosity is verbosity to be used [optional, default 'warning']
30!> - id_loggerid is file id [optional, use only to flush]
31!> - id_maxerror is the maximum number of error authorized before program stop [optional, default 5]
32!>
33!> to close logger file:<br/>
34!> @code
35!> CALL logger_close()
36!> @endcode
37!>
38!> to write header in logger file:<br/>
39!> @code
40!> CALL logger_header()
41!> @endcode
42!>
43!> to write footer in logger file:<br/>
44!> @code
45!> CALL logger_footer()
46!> @endcode
47!>
48!> to flushing output:<br/>
49!> @code
50!> CALL logger_flush()
51!> @endcode
52!>
53!> to write TRACE message in logger file:<br/>
54!> @code
55!> CALL logger_trace(cd_msg [,ld_flush])
56!> @endcode
57!>    - cd_msg is TRACE message
58!>    - ld_flush to flush output [optional]
59!>
60!> to write DEBUG message in logger file:<br/>
61!> @code
62!> CALL logger_debug(cd_msg [,ld_flush])
63!> @endcode
64!>    - cd_msg is DEBUG message
65!>    - ld_flush to flush output [optional]
66!>
67!> to write INFO message in logger file:<br/>
68!> @code
69!> CALL logger_info(cd_msg [,ld_flush])
70!> @endcode
71!>    - cd_msg is INFO message
72!>    - ld_flush to flush output [optional]
73!>
74!> to write WARNING message in logger file:<br/>
75!> @code
76!> CALL logger_warn(cd_msg [,ld_flush])
77!> @endcode
78!>    - cd_msg is WARNING message
79!>    - ld_flush to flush output [optional]
80!>
81!> to write ERROR message in logger file:<br/>
82!> @code
83!> CALL logger_error(cd_msg [,ld_flush])
84!> @endcode
85!>    - cd_msg is ERROR message
86!>    - ld_flush to flush output [optional]
87!>
88!> to write FATAL message in logger file:<br/>
89!> @code
90!> CALL logger_fatal(cd_msg)
91!> @endcode
92!>    - cd_msg is FATAL message
93!>
94!> Examples :<br />
95!> @code
96!>   CALL logger_open('loggerfile.txt','info')
97!>
98!>   CALL logger_header()
99!>   CALL logger_debug('une info de debug')
100!>   CALL logger_info('une info')
101!>   CALL logger_warn('un warning')
102!>   CALL logger_error('une erreur')
103!>   CALL logger_footer()
104!>   CALL logger_close()
105!> @endcode
106!>
107!> @code
108!>   CALL logger_open('loggerfile.txt')
109!>
110!>   CALL logger_header()
111!>   CALL logger_debug('une info de debug')
112!>   CALL logger_info('une info')
113!>   CALL logger_warn('un warning')
114!>   CALL logger_error('une erreur')
115!>   CALL logger_footer()
116!>   CALL logger_close()
117!> @endcode
118!
119!> @author
120!> J.Paul
121! REVISION HISTORY:
122!> @date November, 2013- Initial Version
123!>
124!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
125!----------------------------------------------------------------------
126MODULE logger
127   USE kind                            ! F90 kind parameter
128   USE fct                             ! basic useful function
129   IMPLICIT NONE
130   ! NOTE_avoid_public_variables_if_possible
131
132   ! type and variable
133   PRIVATE :: TLOGGER            !< logger structure
134
135   PRIVATE :: tm_logger          !< logger structure
136   PRIVATE :: im_nverbosity      !< number of log level
137   PRIVATE :: cm_verbosity       !< verbosity array
138
139   ! function and subroutine
140   PUBLIC :: logger_open        !< create a log file with given verbosity
141   PUBLIC :: logger_close       !< close log file
142   PUBLIC :: logger_header      !< write header on log file
143   PUBLIC :: logger_footer      !< write footer on log file
144   PUBLIC :: logger_flush       !< flushing output
145   PUBLIC :: logger_trace       !< write trace    message in log file
146   PUBLIC :: logger_debug       !< write debug    message in log file
147   PUBLIC :: logger_info        !< write info     message in log file
148   PUBLIC :: logger_warn        !< write warning  message in log file
149   PUBLIC :: logger_error       !< write error    message in log file
150   PUBLIC :: logger_fatal       !< write fatal    message in log file, and stop
151
152   PRIVATE :: logger__write     ! cut message to get maximum of 80 character by line in log file
153
154   TYPE TLOGGER   !< logger structure
155      INTEGER(i4)       :: i_id = 0                 !< log file id
156      CHARACTER(LEN=lc) :: c_name                   !< log file name
157      CHARACTER(LEN=lc) :: c_verbosity = "warning"  !< verbosity choose
158      CHARACTER(LEN=lc) :: c_verb = ""              !< array of "verbosities" to used
159      INTEGER(i4)       :: i_nerror   = 0           !< number of error
160      INTEGER(i4)       :: i_nfatal   = 0           !< number of fatal error
161      INTEGER(i4)       :: i_maxerror = 5           !< maximum number of error before stoping program
162   END TYPE TLOGGER   
163
164   !  module variable
165   INTEGER(i4), PARAMETER :: im_nverbosity=6     !< number of log level
166   CHARACTER(len=*), DIMENSION(im_nverbosity), PARAMETER :: cm_verbosity= & !< verbosity array
167   &               (/ 'trace   ',&
168   &                  'debug   ',&
169   &                  'info    ',& 
170   &                  'warning ',&
171   &                  'error   ',&
172   &                  'fatal   '/)
173
174   TYPE(TLOGGER), SAVE :: tm_logger      !< logger structure
175                                                 
176CONTAINS
177   !-------------------------------------------------------------------
178   !> @brief This subroutine create a log file with default verbosity
179   !> ('warning').
180   !> @details
181   !> Optionally verbosity could be change to
182   !> ('trace','debug','info',warning','error','fatal').<br/>
183   !> Optionally maximum number of error allowed could be change.
184   !>
185   !> @author J.Paul
186   !> - November, 2013- Initial Version
187   !
188   !> @param[in] cd_file      log file name
189   !> @param[in] cd_verbosity log file verbosity
190   !> @param[in] id_logid     log file id (use to flush)
191   !> @param[in] id_maxerror  maximum number of error
192   !-------------------------------------------------------------------
193   SUBROUTINE logger_open(cd_file, cd_verbosity, id_logid, id_maxerror)
194      IMPLICIT NONE
195      ! Argument
196      CHARACTER(len=*), INTENT(IN) :: cd_file                ! log file name
197      CHARACTER(len=*), INTENT(IN), OPTIONAL :: cd_verbosity ! log file verbosity
198      INTEGER(i4),      INTENT(IN), OPTIONAL :: id_logid     ! log file id
199      INTEGER(i4),      INTENT(IN), OPTIONAL :: id_maxerror  ! log max error
200
201      ! local variable
202      INTEGER(i4) :: il_status
203
204      ! loop
205      INTEGER(i4) :: ji
206      !----------------------------------------------------------------
207      ! get id if not already define
208      IF( PRESENT(id_logid) )THEN
209         tm_logger%i_id=id_logid
210      ELSE
211         tm_logger%i_id=fct_getunit()
212      ENDIF
213
214      ! open log file
215      OPEN( tm_logger%i_id, &
216      &     STATUS="unknown",    &
217      &     FILE=TRIM(ADJUSTL(cd_file)),  &
218      &     ACTION="write",      &
219      &     POSITION="append",   &
220      &     IOSTAT=il_status)
221      CALL fct_err(il_status)
222
223      ! keep filename
224      tm_logger%c_name=TRIM(ADJUSTL(cd_file))
225
226      ! if present, change verbosity value
227      IF( PRESENT(cd_verbosity) )THEN
228         tm_logger%c_verbosity=TRIM(ADJUSTL(cd_verbosity))
229      ENDIF
230
231      ! compute "tab" of verbosity to be used
232      IF( TRIM(ADJUSTL(tm_logger%c_verb)) == "" )THEN
233         DO ji=im_nverbosity,1,-1
234            tm_logger%c_verb = &
235            &  TRIM(tm_logger%c_verb)//" "//TRIM(ADJUSTL(cm_verbosity(ji)))
236            IF( TRIM(tm_logger%c_verbosity) == TRIM(cm_verbosity(ji)) )THEN
237               EXIT
238            ENDIF
239         ENDDO
240      ENDIF
241
242      IF( PRESENT(id_maxerror) )THEN
243         tm_logger%i_maxerror=id_maxerror
244      ENDIF
245
246   END SUBROUTINE logger_open
247   !-------------------------------------------------------------------
248   !> @brief This subroutine close a log file.
249   !>
250   !> @author J.Paul
251   !> - November, 2013- Initial Version
252   !-------------------------------------------------------------------
253   SUBROUTINE logger_close()
254      IMPLICIT NONE
255      ! local variable
256      INTEGER(i4) :: il_status
257      !----------------------------------------------------------------
258      IF( tm_logger%i_id /= 0 )THEN
259         tm_logger%i_id = 0
260         CLOSE( tm_logger%i_id, &
261         &      IOSTAT=il_status)     
262         CALL fct_err(il_status)
263      ELSE
264          CALL logger_open('logger.log')
265          CALL logger_header()
266          CALL logger_fatal('you must have create logger to use logger_close')
267      ENDIF
268
269   END SUBROUTINE logger_close
270   !-------------------------------------------------------------------
271   !> @brief This subroutine flushing output into log file.
272   !>
273   !> @author J.Paul
274   !> - November, 2013- Initial Version
275   !-------------------------------------------------------------------
276   SUBROUTINE logger_flush()
277      IMPLICIT NONE
278      !----------------------------------------------------------------
279      IF( tm_logger%i_id /= 0 )THEN
280         CALL logger_close()
281         CALL logger_open( tm_logger%c_name, tm_logger%c_verbosity, tm_logger%i_id, &
282         &              tm_logger%i_maxerror )     
283      ELSE
284          CALL logger_open('logger.log')
285          CALL logger_header()
286          CALL logger_fatal('you must have create logger to use logger_flush')
287      ENDIF
288
289   END SUBROUTINE logger_flush
290   !-------------------------------------------------------------------
291   !> @brief This subroutine write header on log file.
292   !>
293   !> @author J.Paul
294   !> - November, 2013- Initial Version
295   !-------------------------------------------------------------------
296   RECURSIVE SUBROUTINE logger_header()
297      IMPLICIT NONE
298      ! local variable
299      INTEGER(i4)       :: il_status
300      !----------------------------------------------------------------
301      IF( tm_logger%i_id /= 0 )THEN
302         WRITE( tm_logger%i_id,    &
303            &   FMT='(4(a/))',     &
304            &   IOSTAT=il_status ) &
305            &   "--------------------------------------------------",&
306            &   "INIT     : verbosity "//TRIM(tm_logger%c_verbosity),&
307            &   "INIT     : max error "//TRIM(fct_str(tm_logger%i_maxerror)), &
308            &   "--------------------------------------------------"
309         CALL fct_err(il_status)
310      ELSE
311          CALL logger_open('logger.log')
312          CALL logger_header()
313          CALL logger_fatal('you must have create logger to use logger_header')
314      ENDIF
315
316   END SUBROUTINE logger_header
317   !-------------------------------------------------------------------
318   !> @brief This subroutine write footer on log file.
319   !>
320   !> @author J.Paul
321   !> - November, 2013- Initial Version
322   !-------------------------------------------------------------------
323   SUBROUTINE logger_footer()
324      IMPLICIT NONE
325      ! local variable
326      INTEGER(i4)       :: il_status
327      !----------------------------------------------------------------
328      IF( tm_logger%i_id /= 0 )THEN
329         WRITE( tm_logger%i_id,    &
330            &   FMT='(4(/a))',     &
331            &   IOSTAT=il_status ) &
332            &   "--------------------------------------------------",&
333            &   "END      : log ended ",              &
334            &   "END      : "//TRIM(fct_str(tm_logger%i_nerror))//   &
335            &   " ERROR detected ",                                  &
336            &   "END      : "//TRIM(fct_str(tm_logger%i_nfatal))//   &
337            &   " FATAL detected ",                                  &
338            &   "--------------------------------------------------"
339         CALL fct_err(il_status)
340      ELSE
341          CALL logger_open('logger.log')
342          CALL logger_header()
343          CALL logger_fatal('you must have create logger to use logger_footer')
344      ENDIF
345   END SUBROUTINE logger_footer
346   !-------------------------------------------------------------------
347   !> @brief This subroutine write trace message on log file.
348   !> @details
349   !> Optionally you could flush output.
350   !>
351   !> @author J.Paul
352   !> - November, 2013- Initial Version
353   !
354   !> @param[in] cd_msg    message to write
355   !> @param[in] ld_flush  flushing ouput
356   !-------------------------------------------------------------------
357   SUBROUTINE logger_trace(cd_msg, ld_flush)
358      IMPLICIT NONE
359      ! Argument
360      CHARACTER(LEN=*), INTENT(IN)  :: cd_msg
361      LOGICAL,          INTENT(IN), OPTIONAL :: ld_flush
362      !----------------------------------------------------------------
363      IF( tm_logger%i_id /= 0 )THEN
364         IF( INDEX(TRIM(tm_logger%c_verb),'trace')/=0 )THEN
365
366            CALL logger__write("TRACE   :",cd_msg)
367
368            IF( PRESENT(ld_flush) )THEN
369               IF( ld_flush )THEN
370                  CALL logger_flush()
371               ENDIF
372            ENDIF     
373         ENDIF
374      ELSE
375          CALL logger_open('logger.log')
376          CALL logger_header()
377          CALL logger_fatal('you must have create logger to use logger_trace')
378      ENDIF
379   END SUBROUTINE logger_trace
380   !-------------------------------------------------------------------
381   !> @brief This subroutine write debug message on log file.
382   !> @details
383   !> Optionally you could flush output.
384   !>
385   !> @author J.Paul
386   !> - November, 2013- Initial Version
387   !
388   !> @param[in] cd_msg    message to write
389   !> @param[in] ld_flush  flushing ouput
390   !-------------------------------------------------------------------
391   SUBROUTINE logger_debug(cd_msg, ld_flush)
392      IMPLICIT NONE
393      ! Argument
394      CHARACTER(LEN=*), INTENT(IN)  :: cd_msg
395      LOGICAL,          INTENT(IN), OPTIONAL :: ld_flush
396      !----------------------------------------------------------------
397      IF( tm_logger%i_id /= 0 )THEN
398         IF( INDEX(TRIM(tm_logger%c_verb),'debug')/=0 )THEN
399
400            CALL logger__write("DEBUG   :",cd_msg)
401
402            IF( PRESENT(ld_flush) )THEN
403               IF( ld_flush )THEN
404                  CALL logger_flush()
405               ENDIF
406            ENDIF     
407         ENDIF
408      ELSE
409          CALL logger_open('logger.log')
410          CALL logger_header()
411          CALL logger_fatal('you must have create logger to use logger_debug')
412      ENDIF
413   END SUBROUTINE logger_debug
414   !-------------------------------------------------------------------
415   !> @brief This subroutine write info message on log file.
416   !> @details
417   !> Optionally you could flush output.
418   !>
419   !> @author J.Paul
420   !> - November, 2013- Initial Version
421   !
422   !> @param[in] cd_msg    message to write
423   !> @param[in] ld_flush  flushing ouput
424   !-------------------------------------------------------------------
425   SUBROUTINE logger_info(cd_msg, ld_flush)
426      IMPLICIT NONE
427      ! Argument
428      CHARACTER(LEN=*), INTENT(IN)  :: cd_msg
429      LOGICAL,          INTENT(IN), OPTIONAL :: ld_flush
430      !----------------------------------------------------------------
431      IF( tm_logger%i_id /= 0 )THEN
432         IF( INDEX(TRIM(tm_logger%c_verb),'info')/=0 )THEN
433
434            CALL logger__write("INFO    :",cd_msg)
435
436            IF( PRESENT(ld_flush) )THEN
437               IF( ld_flush )THEN
438                  CALL logger_flush()
439               ENDIF
440            ENDIF     
441         ENDIF
442      ELSE
443          CALL logger_open('logger.log')
444          CALL logger_header()
445          CALL logger_fatal('you must have create logger to use logger_info')
446      ENDIF
447   END SUBROUTINE logger_info
448   !-------------------------------------------------------------------
449   !> @brief This subroutine write warning message on log file.
450   !> @details
451   !> Optionally you could flush output.
452   !>
453   !> @author J.Paul
454   !> - November, 2013- Initial Version
455   !
456   !> @param[in] cd_msg    message to write
457   !> @param[in] ld_flush  flushing ouput
458   !-------------------------------------------------------------------
459   SUBROUTINE logger_warn(cd_msg, ld_flush)
460      IMPLICIT NONE
461      ! Argument
462      CHARACTER(LEN=*), INTENT(IN)  :: cd_msg
463      LOGICAL,          INTENT(IN), OPTIONAL :: ld_flush
464      !----------------------------------------------------------------
465      IF( tm_logger%i_id /= 0 )THEN
466         IF( INDEX(TRIM(tm_logger%c_verb),'warn')/=0 )THEN
467
468            CALL logger__write("WARNING :",cd_msg)
469
470            IF( PRESENT(ld_flush) )THEN
471               IF( ld_flush )THEN
472                  CALL logger_flush()
473               ENDIF
474            ENDIF     
475         ENDIF
476      ELSE
477          CALL logger_open('logger.log')
478          CALL logger_header()
479          CALL logger_fatal('you must have create logger to use logger_warn')
480      ENDIF
481   END SUBROUTINE logger_warn
482   !-------------------------------------------------------------------
483   !> @brief This subroutine write error message on log file.
484   !> @details
485   !> Optionally you could flush output.
486   !>
487   !> @author J.Paul
488   !> - November, 2013- Initial Version
489   !
490   !> @param[in] cd_msg    message to write
491   !> @param[in] ld_flush  flushing ouput
492   !-------------------------------------------------------------------
493   SUBROUTINE logger_error(cd_msg, ld_flush)
494      IMPLICIT NONE
495      ! Argument
496      CHARACTER(LEN=*), INTENT(IN)  :: cd_msg
497      LOGICAL,          INTENT(IN), OPTIONAL :: ld_flush
498
499      ! local variable
500      CHARACTER(LEN=lc) :: cl_nerror
501      !----------------------------------------------------------------
502      IF( tm_logger%i_id /= 0 )THEN
503         ! increment the error number
504         tm_logger%i_nerror=tm_logger%i_nerror+1
505
506         IF( INDEX(TRIM(tm_logger%c_verb),'error')/=0 )THEN
507
508            CALL logger__write("ERROR   :",cd_msg)
509
510            IF( PRESENT(ld_flush) )THEN
511               IF( ld_flush )THEN
512                  CALL logger_flush()
513               ENDIF
514            ENDIF     
515         ENDIF
516
517         IF( tm_logger%i_nerror >= tm_logger%i_maxerror )THEN
518            WRITE(cl_nerror,*) tm_logger%i_maxerror
519            CALL logger_fatal(&
520            &  'Error count reached limit of '//TRIM(ADJUSTL(cl_nerror)) )
521         ENDIF
522      ELSE
523          CALL logger_open('logger.log')
524          CALL logger_header()
525          CALL logger_fatal('you must have create logger to use logger_error')
526      ENDIF
527
528   END SUBROUTINE logger_error
529   !-------------------------------------------------------------------
530   !> @brief This subroutine write fatal error message on log file,
531   !> close log file and stop process.
532   !>
533   !> @author J.Paul
534   !> - November, 2013- Initial Version
535   !
536   !> @param[in] cd_msg message to write
537   !-------------------------------------------------------------------
538   RECURSIVE SUBROUTINE logger_fatal(cd_msg)
539      IMPLICIT NONE
540      ! Argument
541      CHARACTER(LEN=*),           INTENT(IN) :: cd_msg
542      !----------------------------------------------------------------
543      IF( tm_logger%i_id /= 0 )THEN
544         IF( INDEX(TRIM(tm_logger%c_verb),'fatal')/=0 )THEN
545            ! increment the error number
546            tm_logger%i_nfatal=tm_logger%i_nfatal+1
547
548            CALL logger__write("FATAL   :",cd_msg)
549
550            CALL logger_footer()
551            CALL logger_close()
552
553            WRITE(*,*) 'FATAL ERROR'
554            STOP
555         ENDIF
556      ELSE
557          CALL logger_open('logger.log')
558          CALL logger_header()
559          CALL logger_fatal('you must have create logger to use logger_fatal')
560      ENDIF
561   END SUBROUTINE logger_fatal
562   !-------------------------------------------------------------------
563   !> @brief This subroutine cut message to get maximum of 80 character
564   !> by line in log file.
565   !>
566   !> @author J.Paul
567   !> - November, 2013- Initial Version
568   !
569   !> @param[in] cd_verb   verbosity of the message to write
570   !> @param[in] cd_msg    message to write
571   !-------------------------------------------------------------------
572   SUBROUTINE logger__write(cd_verb, cd_msg)
573      IMPLICIT NONE
574      ! Argument
575      CHARACTER(LEN=*),           INTENT(IN) :: cd_verb
576      CHARACTER(LEN=*),           INTENT(IN) :: cd_msg
577
578      ! local variable
579      INTEGER(i4)       :: il_status
580      INTEGER(i4)       :: il_verb
581      INTEGER(i4)       :: il_msg
582      CHARACTER(LEN=lc) :: cl_verb
583      CHARACTER(LEN=lc) :: cl_msg
584      CHARACTER(LEN=lc) :: cl_tmp
585
586      !----------------------------------------------------------------
587      cl_verb=TRIM(ADJUSTL(cd_verb))
588      cl_msg=TRIM(ADJUSTL(cd_msg))
589
590      il_verb=LEN_TRIM(cl_verb)
591      il_msg=LEN_TRIM(cl_msg)
592      DO WHILE( il_verb + il_msg > 78 )
593         cl_tmp=TRIM(cl_verb)//' '//TRIM(cl_msg(1:78-il_verb))
594
595         WRITE( tm_logger%i_id,  &
596         &      FMT=*,           &
597         &      IOSTAT=il_status &
598         &      ) TRIM(cl_tmp)
599         CALL fct_err(il_status)
600
601
602         cl_msg=cl_msg(78-il_verb+1:il_msg)
603         cl_verb="        :"
604
605         il_msg=LEN_TRIM(cl_msg)
606
607      ENDDO
608
609      cl_tmp=TRIM(cl_verb)//' '//TRIM(cl_msg)
610      WRITE( tm_logger%i_id,  &
611      &      FMT=*,           &
612      &      IOSTAT=il_status &
613      &      ) TRIM(cl_tmp)
614      CALL fct_err(il_status)
615
616   END SUBROUTINE logger__write
617END MODULE logger
618
Note: See TracBrowser for help on using the repository browser.