58#include "../base/base_uses.f90"
77 CHARACTER(len=*),
PARAMETER,
PRIVATE :: moduleN =
'cp_log_handling'
78 LOGICAL,
PRIVATE,
PARAMETER :: debug_this_module = .false.
91 MODULE PROCEDURE cp_int_to_string, cp_real_dp_to_string, cp_logical_to_string
141 INTEGER :: ref_count = -1
142 INTEGER :: print_level = -1
143 INTEGER :: default_local_unit_nr = -1
144 INTEGER :: default_global_unit_nr = -1
145 LOGICAL :: close_local_unit_on_dealloc = .false., close_global_unit_on_dealloc = .false.
146 CHARACTER(len=default_string_length) :: suffix =
""
147 CHARACTER(len=default_path_length) :: local_filename =
"", global_filename =
""
157 TYPE default_logger_stack_type
159 END TYPE default_logger_stack_type
161 INTEGER,
PRIVATE :: stack_pointer = 0
162 INTEGER,
PARAMETER,
PRIVATE :: max_stack_pointer = 10
163 TYPE(default_logger_stack_type),
SAVE,
DIMENSION(max_stack_pointer) :: default_logger_stack
190 CHARACTER(len=*),
PARAMETER :: routinen =
'cp_add_default_logger', &
191 routinep = modulen//
':'//routinen
193 IF (stack_pointer + 1 > max_stack_pointer)
THEN
194 CALL cp_abort(__location__, routinep// &
195 "too many default loggers, increase max_stack_pointer in "//modulen)
198 stack_pointer = stack_pointer + 1
199 NULLIFY (default_logger_stack(stack_pointer)%cp_default_logger)
201 default_logger_stack(stack_pointer)%cp_default_logger => logger
213 IF (stack_pointer - 1 < 0)
THEN
214 CALL cp_abort(__location__, modulen//
":cp_rm_default_logger "// &
215 "can not destroy default logger "//modulen)
219 NULLIFY (default_logger_stack(stack_pointer)%cp_default_logger)
220 stack_pointer = stack_pointer - 1
236 IF (.NOT. stack_pointer > 0)
THEN
237 CALL cp_abort(__location__,
"cp_log_handling:cp_get_default_logger "// &
238 "default logger not yet initialized (CALL cp_init_default_logger)")
240 res => default_logger_stack(stack_pointer)%cp_default_logger
241 IF (.NOT.
ASSOCIATED(res))
THEN
242 CALL cp_abort(__location__,
"cp_log_handling:cp_get_default_logger "// &
243 "default logger is null (released too much ?)")
282 default_global_unit_nr, default_local_unit_nr, global_filename, &
283 local_filename, close_global_unit_on_dealloc, iter_info, &
284 close_local_unit_on_dealloc, suffix, template_logger)
286 TYPE(mp_para_env_type),
OPTIONAL,
POINTER :: para_env
287 INTEGER,
INTENT(in),
OPTIONAL :: print_level, default_global_unit_nr, &
288 default_local_unit_nr
289 CHARACTER(len=*),
INTENT(in),
OPTIONAL :: global_filename, local_filename
290 LOGICAL,
INTENT(in),
OPTIONAL :: close_global_unit_on_dealloc
291 TYPE(cp_iteration_info_type),
OPTIONAL,
POINTER :: iter_info
292 LOGICAL,
INTENT(in),
OPTIONAL :: close_local_unit_on_dealloc
293 CHARACTER(len=*),
INTENT(in),
OPTIONAL :: suffix
296 CHARACTER(len=*),
PARAMETER :: routinen =
'cp_logger_create', &
297 routinep = modulen//
':'//routinen
301 NULLIFY (logger%para_env)
302 NULLIFY (logger%iter_info)
305 IF (
PRESENT(template_logger))
THEN
306 IF (template_logger%ref_count < 1)
THEN
307 cpabort(routinep//
" template_logger%ref_count<1")
309 logger%print_level = template_logger%print_level
310 logger%default_global_unit_nr = template_logger%default_global_unit_nr
311 logger%close_local_unit_on_dealloc = template_logger%close_local_unit_on_dealloc
312 IF (logger%close_local_unit_on_dealloc)
THEN
313 logger%default_local_unit_nr = -1
315 logger%default_local_unit_nr = template_logger%default_local_unit_nr
317 logger%close_global_unit_on_dealloc = template_logger%close_global_unit_on_dealloc
318 IF (logger%close_global_unit_on_dealloc)
THEN
319 logger%default_global_unit_nr = -1
321 logger%default_global_unit_nr = template_logger%default_global_unit_nr
323 logger%local_filename = template_logger%local_filename
324 logger%global_filename = template_logger%global_filename
325 logger%para_env => template_logger%para_env
326 logger%suffix = template_logger%suffix
327 logger%iter_info => template_logger%iter_info
331 logger%default_global_unit_nr = -1
332 logger%close_global_unit_on_dealloc = .true.
333 logger%local_filename =
"localLog"
334 logger%global_filename =
"mainLog"
338 logger%default_local_unit_nr = -1
339 logger%close_local_unit_on_dealloc = .true.
342 IF (
PRESENT(para_env)) logger%para_env => para_env
343 IF (.NOT.
ASSOCIATED(logger%para_env))
THEN
344 cpabort(routinep//
" para env not associated")
346 IF (.NOT. logger%para_env%is_valid())
THEN
347 cpabort(routinep//
" para_env%ref_count<1")
349 CALL logger%para_env%retain()
351 IF (
PRESENT(print_level)) logger%print_level = print_level
353 IF (
PRESENT(default_global_unit_nr))
THEN
354 logger%default_global_unit_nr = default_global_unit_nr
356 IF (
PRESENT(global_filename))
THEN
357 logger%global_filename = global_filename
358 logger%close_global_unit_on_dealloc = .true.
359 logger%default_global_unit_nr = -1
361 IF (
PRESENT(close_global_unit_on_dealloc))
THEN
362 logger%close_global_unit_on_dealloc = close_global_unit_on_dealloc
363 IF (
PRESENT(default_global_unit_nr) .AND.
PRESENT(global_filename) .AND. &
364 (.NOT. close_global_unit_on_dealloc))
THEN
365 logger%default_global_unit_nr = default_global_unit_nr
369 IF (
PRESENT(default_local_unit_nr))
THEN
370 logger%default_local_unit_nr = default_local_unit_nr
372 IF (
PRESENT(local_filename))
THEN
373 logger%local_filename = local_filename
374 logger%close_local_unit_on_dealloc = .true.
375 logger%default_local_unit_nr = -1
377 IF (
PRESENT(suffix)) logger%suffix = suffix
379 IF (
PRESENT(close_local_unit_on_dealloc))
THEN
380 logger%close_local_unit_on_dealloc = close_local_unit_on_dealloc
381 IF (
PRESENT(default_local_unit_nr) .AND.
PRESENT(local_filename) .AND. &
382 (.NOT. close_local_unit_on_dealloc))
THEN
383 logger%default_local_unit_nr = default_local_unit_nr
387 IF (logger%default_local_unit_nr == -1)
THEN
388 IF (logger%para_env%is_source())
THEN
389 logger%default_local_unit_nr = logger%default_global_unit_nr
390 logger%close_local_unit_on_dealloc = .false.
393 IF (
PRESENT(iter_info)) logger%iter_info => iter_info
394 IF (
ASSOCIATED(logger%iter_info))
THEN
395 CALL cp_iteration_info_retain(logger%iter_info)
397 CALL cp_iteration_info_create(logger%iter_info,
"")
412 CHARACTER(len=*),
PARAMETER :: routinen =
'cp_logger_retain', &
413 routinep = modulen//
':'//routinen
415 IF (logger%ref_count < 1)
THEN
416 cpabort(routinep//
" logger%ref_count<1")
418 logger%ref_count = logger%ref_count + 1
431 CHARACTER(len=*),
PARAMETER :: routinen =
'cp_logger_release', &
432 routinep = modulen//
':'//routinen
434 IF (
ASSOCIATED(logger))
THEN
435 IF (logger%ref_count < 1)
THEN
436 cpabort(routinep//
" logger%ref_count<1")
438 logger%ref_count = logger%ref_count - 1
439 IF (logger%ref_count == 0)
THEN
440 IF (logger%close_global_unit_on_dealloc .AND. &
441 logger%default_global_unit_nr >= 0)
THEN
442 CALL close_file(logger%default_global_unit_nr)
443 logger%close_global_unit_on_dealloc = .false.
444 logger%default_global_unit_nr = -1
446 IF (logger%close_local_unit_on_dealloc .AND. &
447 logger%default_local_unit_nr >= 0)
THEN
448 CALL close_file(logger%default_local_unit_nr)
449 logger%close_local_unit_on_dealloc = .false.
450 logger%default_local_unit_nr = -1
452 CALL mp_para_env_release(logger%para_env)
453 CALL cp_iteration_info_release(logger%iter_info)
476 INTEGER,
INTENT(in) :: level
479 CHARACTER(len=*),
PARAMETER :: routinen =
'cp_logger_would_log', &
480 routinep = modulen//
':'//routinen
486 IF (lggr%ref_count < 1)
THEN
487 cpabort(routinep//
" logger%ref_count<1")
490 res = level >= lggr%print_level
507 LOGICAL,
INTENT(in),
OPTIONAL :: local
528 IF (
PRESENT(logger))
THEN
529 local_logger => logger
530 ELSE IF (stack_pointer == 0)
THEN
553 INTEGER,
INTENT(in) :: level
555 CHARACTER(len=*),
PARAMETER :: routinen =
'cp_logger_set_log_level', &
556 routinep = modulen//
':'//routinen
558 IF (logger%ref_count < 1)
THEN
559 cpabort(routinep//
" logger%ref_count<1")
561 logger%print_level = level
577 LOGICAL,
INTENT(in),
OPTIONAL :: local, skip_not_ionode
580 CHARACTER(len=*),
PARAMETER :: routinen =
'cp_logger_get_default_unit_nr', &
581 routinep = modulen//
':'//routinen
583 CHARACTER(len=default_path_length) :: filename, host_name
584 INTEGER :: iostat, pid
590 IF (
PRESENT(logger))
THEN
596 IF (lggr%ref_count < 1)
THEN
597 cpabort(routinep//
" logger%ref_count<1")
600 IF (
PRESENT(local)) loc = local
601 IF (
PRESENT(skip_not_ionode)) skip = skip_not_ionode
603 IF (lggr%default_global_unit_nr <= 0)
THEN
604 IF (lggr%para_env%is_source())
THEN
606 ".out", local=.false.)
607 CALL open_file(trim(filename), file_status=
"unknown", &
608 file_action=
"WRITE", file_position=
"APPEND", &
609 unit_number=lggr%default_global_unit_nr)
610 ELSE IF (.NOT. skip)
THEN
612 lggr%close_global_unit_on_dealloc = .false.
614 lggr%default_global_unit_nr = -1
615 lggr%close_global_unit_on_dealloc = .false.
618 IF (.NOT. (lggr%para_env%is_source() .OR. skip))
THEN
619 WRITE (unit=lggr%default_global_unit_nr, fmt=
'(/,T2,A)', iostat=iostat) &
620 ' *** WARNING non ionode asked for global logger ***'
621 IF (iostat /= 0)
THEN
623 CALL m_hostnm(host_name)
624 print *,
" *** Error trying to WRITE to the local logger ***"
625 print *,
" *** MPI_id = ", lggr%para_env%mepos
626 print *,
" *** MPI_Communicator = ", lggr%para_env%get_handle()
627 print *,
" *** PID = ", pid
628 print *,
" *** Hostname = "//trim(host_name)
629 CALL print_stack(default_output_unit)
631 CALL print_stack(lggr%default_global_unit_nr)
634 res = lggr%default_global_unit_nr
636 IF (lggr%default_local_unit_nr <= 0)
THEN
638 ".out", local=.true.)
639 CALL open_file(trim(filename), file_status=
"unknown", &
640 file_action=
"WRITE", &
641 file_position=
"APPEND", &
642 unit_number=lggr%default_local_unit_nr)
643 WRITE (unit=lggr%default_local_unit_nr, fmt=
'(/,T2,A,I0,A,I0,A)', iostat=iostat) &
644 '*** Local logger file of MPI task ', lggr%para_env%mepos, &
645 ' in communicator ', lggr%para_env%get_handle(),
' ***'
646 IF (iostat == 0)
THEN
648 CALL m_hostnm(host_name)
649 WRITE (unit=lggr%default_local_unit_nr, fmt=
'(T2,A,I0)', iostat=iostat) &
651 '*** Hostname = '//host_name
652 CALL print_stack(lggr%default_local_unit_nr)
654 IF (iostat /= 0)
THEN
656 CALL m_hostnm(host_name)
657 print *,
" *** Error trying to WRITE to the local logger ***"
658 print *,
" *** MPI_id = ", lggr%para_env%mepos
659 print *,
" *** MPI_Communicator = ", lggr%para_env%get_handle()
660 print *,
" *** PID = ", pid
661 print *,
" *** Hostname = "//trim(host_name)
662 CALL print_stack(default_output_unit)
666 res = lggr%default_local_unit_nr
690 CHARACTER(len=*),
INTENT(inout) :: res
691 CHARACTER(len=*),
INTENT(in) :: root, postfix
692 LOGICAL,
INTENT(in),
OPTIONAL :: local
694 CHARACTER(len=*),
PARAMETER :: routinen =
'cp_logger_generate_filename', &
695 routinep = modulen//
':'//routinen
705 IF (lggr%ref_count < 1)
THEN
706 cpabort(routinep//
" logger%ref_count<1")
708 IF (
PRESENT(local)) loc = local
710 res = trim(root)//trim(lggr%suffix)//
'_p'// &
713 res = trim(root)//trim(lggr%suffix)//postfix
715 CALL compress(res, full=.true.)
729 CHARACTER(len=*),
INTENT(in),
OPTIONAL :: local_filename, global_filename
731 IF (
PRESENT(local_filename)) logger%local_filename = local_filename
732 IF (
PRESENT(global_filename)) logger%global_filename = global_filename
746 FUNCTION cp_int_to_string(i, fmt)
RESULT(res)
747 INTEGER,
INTENT(in) :: i
748 CHARACTER(len=*),
OPTIONAL :: fmt
749 CHARACTER(len=25) :: res
751 CHARACTER(len=25) :: t_res
753 REAL(kind=dp) :: tmp_r
756 IF (
PRESENT(fmt))
THEN
757 WRITE (t_res, fmt=fmt, iostat=iostat) i
758 ELSE IF (i > 999999 .OR. i < -99999)
THEN
760 WRITE (t_res, fmt=
'(ES8.1)', iostat=iostat) tmp_r
762 WRITE (t_res, fmt=
'(I6)', iostat=iostat) i
765 IF (iostat /= 0)
THEN
766 print *,
"cp_int_to_string I/O error", iostat
770 END FUNCTION cp_int_to_string
783 FUNCTION cp_real_dp_to_string(val, fmt)
RESULT(res)
784 REAL(kind=dp),
INTENT(in) :: val
785 CHARACTER(len=*),
OPTIONAL :: fmt
786 CHARACTER(len=25) :: res
790 IF (
PRESENT(fmt))
THEN
791 WRITE (res, fmt=fmt, iostat=iostat) val
793 WRITE (res, fmt=
'(ES11.4)', iostat=iostat) val
795 IF (iostat /= 0)
THEN
796 print *,
"cp_real_dp_to_string I/O error", iostat
800 END FUNCTION cp_real_dp_to_string
808 ELEMENTAL FUNCTION cp_logical_to_string(val)
RESULT(res)
809 LOGICAL,
INTENT(in) :: val
810 CHARACTER(len=1) :: res
817 END FUNCTION cp_logical_to_string
Utility routines to open and close files. Tracking of preconnections.
subroutine, public open_file(file_name, file_status, file_form, file_action, file_position, file_pad, unit_number, debug, skip_get_unit_number, file_access)
Opens the requested file using a free unit number.
subroutine, public close_file(unit_number, file_status, keep_preconnection)
Close an open file given by its logical unit number. Optionally, keep the file and unit preconnected.
Collection of routines to handle the iteration info.
pure subroutine, public cp_iteration_info_create(iteration_info, project_name)
creates an output info object
subroutine, public cp_iteration_info_retain(iteration_info)
retains the iteration_info (see doc/ReferenceCounting.html)
subroutine, public cp_iteration_info_release(iteration_info)
releases the iteration_info (see doc/ReferenceCounting.html)
various routines to log and control the output. The idea is that decisions about where to log should ...
logical function, public cp_logger_would_log(logger, level)
this function can be called to check if the logger would log a message with the given level from the ...
recursive integer function, public cp_logger_get_default_unit_nr(logger, local, skip_not_ionode)
asks the default unit number of the given logger. try to use cp_logger_get_unit_nr
subroutine, public cp_logger_set(logger, local_filename, global_filename)
sets various attributes of the given logger
subroutine, public cp_rm_default_logger()
the cousin of cp_add_default_logger, decrements the stack, so that the default logger is what it has ...
subroutine, public cp_logger_release(logger)
releases this logger
integer, parameter, public cp_note_level
integer function, public cp_logger_get_unit_nr(logger, local)
returns the unit nr for the requested kind of log.
integer function, public cp_logger_get_default_io_unit(logger)
returns the unit nr for the ionode (-1 on all other processors) skips as well checks if the procs cal...
subroutine, public cp_logger_set_log_level(logger, level)
changes the logging level. Log messages with a level less than the one given wo not be printed.
subroutine, public cp_logger_create(logger, para_env, print_level, default_global_unit_nr, default_local_unit_nr, global_filename, local_filename, close_global_unit_on_dealloc, iter_info, close_local_unit_on_dealloc, suffix, template_logger)
initializes a logger
subroutine, public cp_logger_generate_filename(logger, res, root, postfix, local)
generates a unique filename (ie adding eventual suffixes and process ids)
integer function, public cp_default_logger_stack_size()
...
integer, parameter, public cp_failure_level
integer, parameter, public cp_fatal_level
subroutine, public cp_logger_retain(logger)
retains the given logger (to be called to keep a shared copy of the logger)
integer, parameter, public cp_warning_level
subroutine, public cp_add_default_logger(logger)
adds a default logger. MUST be called before logging occours
type(cp_logger_type) function, pointer, public cp_get_default_logger()
returns the default logger
Defines the basic variable types.
integer, parameter, public dp
integer, parameter, public default_string_length
integer, parameter, public default_path_length
Machine interface based on Fortran 2003 and POSIX.
subroutine, public m_getpid(pid)
...
integer, parameter, public default_output_unit
subroutine, public m_hostnm(hname)
...
Interface to the message passing library MPI.
subroutine, public mp_para_env_release(para_env)
releases the para object (to be called when you don't want anymore the shared copy of this object)
Utilities for string manipulations.
subroutine, public compress(string, full)
Eliminate multiple space characters in a string. If full is .TRUE., then all spaces are eliminated.
Timing routines for accounting.
subroutine, public print_stack(unit_nr)
Print current routine stack.
contains the information about the current state of the program to be able to decide if output is nec...
type of a logger, at the moment it contains just a print level starting at which level it should be l...
stores all the informations relevant to an mpi environment