47 cp_iteration_info_type
58 #include "../base/base_uses.f90"
64 PUBLIC :: cp_logger_type, cp_logger_p_type
77 CHARACTER(len=*),
PARAMETER,
PRIVATE :: moduleN =
'cp_log_handling'
78 LOGICAL,
PRIVATE,
PARAMETER :: debug_this_module = .false.
90 INTERFACE cp_to_string
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 =
""
148 TYPE(mp_para_env_type),
POINTER :: para_env => null()
149 TYPE(cp_iteration_info_type),
POINTER :: iter_info => null()
150 END TYPE cp_logger_type
152 TYPE cp_logger_p_type
153 TYPE(cp_logger_type),
POINTER :: p => null()
154 END TYPE cp_logger_p_type
157 TYPE default_logger_stack_type
158 TYPE(cp_logger_type),
POINTER :: cp_default_logger => null()
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
188 TYPE(cp_logger_type),
INTENT(INOUT),
TARGET :: logger
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
234 TYPE(cp_logger_type),
POINTER :: res
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)
285 TYPE(cp_logger_type),
POINTER :: 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
294 TYPE(cp_logger_type),
OPTIONAL,
POINTER :: template_logger
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) &
307 cpabort(routinep//
" template_logger%ref_count<1")
308 logger%print_level = template_logger%print_level
309 logger%default_global_unit_nr = template_logger%default_global_unit_nr
310 logger%close_local_unit_on_dealloc = template_logger%close_local_unit_on_dealloc
311 IF (logger%close_local_unit_on_dealloc)
THEN
312 logger%default_local_unit_nr = -1
314 logger%default_local_unit_nr = template_logger%default_local_unit_nr
316 logger%close_global_unit_on_dealloc = template_logger%close_global_unit_on_dealloc
317 IF (logger%close_global_unit_on_dealloc)
THEN
318 logger%default_global_unit_nr = -1
320 logger%default_global_unit_nr = template_logger%default_global_unit_nr
322 logger%local_filename = template_logger%local_filename
323 logger%global_filename = template_logger%global_filename
324 logger%para_env => template_logger%para_env
325 logger%suffix = template_logger%suffix
326 logger%iter_info => template_logger%iter_info
330 logger%default_global_unit_nr = -1
331 logger%close_global_unit_on_dealloc = .true.
332 logger%local_filename =
"localLog"
333 logger%global_filename =
"mainLog"
337 logger%default_local_unit_nr = -1
338 logger%close_local_unit_on_dealloc = .true.
341 IF (
PRESENT(para_env)) logger%para_env => para_env
342 IF (.NOT.
ASSOCIATED(logger%para_env)) &
343 cpabort(routinep//
" para env not associated")
344 IF (.NOT. logger%para_env%is_valid()) &
345 cpabort(routinep//
" para_env%ref_count<1")
346 CALL logger%para_env%retain()
348 IF (
PRESENT(print_level)) logger%print_level = print_level
350 IF (
PRESENT(default_global_unit_nr)) &
351 logger%default_global_unit_nr = default_global_unit_nr
352 IF (
PRESENT(global_filename))
THEN
353 logger%global_filename = global_filename
354 logger%close_global_unit_on_dealloc = .true.
355 logger%default_global_unit_nr = -1
357 IF (
PRESENT(close_global_unit_on_dealloc))
THEN
358 logger%close_global_unit_on_dealloc = close_global_unit_on_dealloc
359 IF (
PRESENT(default_global_unit_nr) .AND.
PRESENT(global_filename) .AND. &
360 (.NOT. close_global_unit_on_dealloc))
THEN
361 logger%default_global_unit_nr = default_global_unit_nr
365 IF (
PRESENT(default_local_unit_nr)) &
366 logger%default_local_unit_nr = default_local_unit_nr
367 IF (
PRESENT(local_filename))
THEN
368 logger%local_filename = local_filename
369 logger%close_local_unit_on_dealloc = .true.
370 logger%default_local_unit_nr = -1
372 IF (
PRESENT(suffix)) logger%suffix = suffix
374 IF (
PRESENT(close_local_unit_on_dealloc))
THEN
375 logger%close_local_unit_on_dealloc = close_local_unit_on_dealloc
376 IF (
PRESENT(default_local_unit_nr) .AND.
PRESENT(local_filename) .AND. &
377 (.NOT. close_local_unit_on_dealloc))
THEN
378 logger%default_local_unit_nr = default_local_unit_nr
382 IF (logger%default_local_unit_nr == -1)
THEN
383 IF (logger%para_env%is_source())
THEN
384 logger%default_local_unit_nr = logger%default_global_unit_nr
385 logger%close_local_unit_on_dealloc = .false.
388 IF (
PRESENT(iter_info)) logger%iter_info => iter_info
389 IF (
ASSOCIATED(logger%iter_info))
THEN
390 CALL cp_iteration_info_retain(logger%iter_info)
392 CALL cp_iteration_info_create(logger%iter_info,
"")
405 TYPE(cp_logger_type),
INTENT(INOUT) :: logger
407 CHARACTER(len=*),
PARAMETER :: routinen =
'cp_logger_retain', &
408 routinep = modulen//
':'//routinen
410 IF (logger%ref_count < 1) &
411 cpabort(routinep//
" logger%ref_count<1")
412 logger%ref_count = logger%ref_count + 1
423 TYPE(cp_logger_type),
POINTER :: logger
425 CHARACTER(len=*),
PARAMETER :: routinen =
'cp_logger_release', &
426 routinep = modulen//
':'//routinen
428 IF (
ASSOCIATED(logger))
THEN
429 IF (logger%ref_count < 1) &
430 cpabort(routinep//
" logger%ref_count<1")
431 logger%ref_count = logger%ref_count - 1
432 IF (logger%ref_count == 0)
THEN
433 IF (logger%close_global_unit_on_dealloc .AND. &
434 logger%default_global_unit_nr >= 0)
THEN
435 CALL close_file(logger%default_global_unit_nr)
436 logger%close_global_unit_on_dealloc = .false.
437 logger%default_global_unit_nr = -1
439 IF (logger%close_local_unit_on_dealloc .AND. &
440 logger%default_local_unit_nr >= 0)
THEN
441 CALL close_file(logger%default_local_unit_nr)
442 logger%close_local_unit_on_dealloc = .false.
443 logger%default_local_unit_nr = -1
445 CALL mp_para_env_release(logger%para_env)
446 CALL cp_iteration_info_release(logger%iter_info)
468 TYPE(cp_logger_type),
POINTER :: logger
469 INTEGER,
INTENT(in) :: level
472 CHARACTER(len=*),
PARAMETER :: routinen =
'cp_logger_would_log', &
473 routinep = modulen//
':'//routinen
475 TYPE(cp_logger_type),
POINTER :: lggr
479 IF (lggr%ref_count < 1) &
480 cpabort(routinep//
" logger%ref_count<1")
482 res = level >= lggr%print_level
498 TYPE(cp_logger_type),
POINTER :: logger
499 LOGICAL,
INTENT(in),
OPTIONAL :: local
515 TYPE(cp_logger_type),
OPTIONAL,
POINTER :: logger
518 TYPE(cp_logger_type),
POINTER :: local_logger
520 IF (
PRESENT(logger))
THEN
521 local_logger => logger
522 ELSE IF (stack_pointer == 0)
THEN
544 TYPE(cp_logger_type),
INTENT(INOUT) :: logger
545 INTEGER,
INTENT(in) :: level
547 CHARACTER(len=*),
PARAMETER :: routinen =
'cp_logger_set_log_level', &
548 routinep = modulen//
':'//routinen
550 IF (logger%ref_count < 1) &
551 cpabort(routinep//
" logger%ref_count<1")
552 logger%print_level = level
567 TYPE(cp_logger_type),
OPTIONAL,
POINTER :: logger
568 LOGICAL,
INTENT(in),
OPTIONAL :: local, skip_not_ionode
571 CHARACTER(len=*),
PARAMETER :: routinen =
'cp_logger_get_default_unit_nr', &
572 routinep = modulen//
':'//routinen
574 CHARACTER(len=default_path_length) :: filename, host_name
575 INTEGER :: iostat, pid
577 TYPE(cp_logger_type),
POINTER :: lggr
581 IF (
PRESENT(logger))
THEN
587 IF (lggr%ref_count < 1) &
588 cpabort(routinep//
" logger%ref_count<1")
590 IF (
PRESENT(local)) loc = local
591 IF (
PRESENT(skip_not_ionode)) skip = skip_not_ionode
593 IF (lggr%default_global_unit_nr <= 0)
THEN
594 IF (lggr%para_env%is_source())
THEN
596 ".out", local=.false.)
597 CALL open_file(trim(filename), file_status=
"unknown", &
598 file_action=
"WRITE", file_position=
"APPEND", &
599 unit_number=lggr%default_global_unit_nr)
600 ELSE IF (.NOT. skip)
THEN
602 lggr%close_global_unit_on_dealloc = .false.
604 lggr%default_global_unit_nr = -1
605 lggr%close_global_unit_on_dealloc = .false.
608 IF (.NOT. (lggr%para_env%is_source() .OR. skip))
THEN
609 WRITE (unit=lggr%default_global_unit_nr, fmt=
'(/,T2,A)', iostat=iostat) &
610 ' *** WARNING non ionode asked for global logger ***'
611 IF (iostat /= 0)
THEN
613 CALL m_hostnm(host_name)
614 print *,
" *** Error trying to WRITE to the local logger ***"
615 print *,
" *** MPI_id = ", lggr%para_env%mepos
616 print *,
" *** MPI_Communicator = ", lggr%para_env%get_handle()
617 print *,
" *** PID = ", pid
618 print *,
" *** Hostname = "//trim(host_name)
619 CALL print_stack(default_output_unit)
621 CALL print_stack(lggr%default_global_unit_nr)
624 res = lggr%default_global_unit_nr
626 IF (lggr%default_local_unit_nr <= 0)
THEN
628 ".out", local=.true.)
629 CALL open_file(trim(filename), file_status=
"unknown", &
630 file_action=
"WRITE", &
631 file_position=
"APPEND", &
632 unit_number=lggr%default_local_unit_nr)
633 WRITE (unit=lggr%default_local_unit_nr, fmt=
'(/,T2,A,I0,A,I0,A)', iostat=iostat) &
634 '*** Local logger file of MPI task ', lggr%para_env%mepos, &
635 ' in communicator ', lggr%para_env%get_handle(),
' ***'
636 IF (iostat == 0)
THEN
638 CALL m_hostnm(host_name)
639 WRITE (unit=lggr%default_local_unit_nr, fmt=
'(T2,A,I0)', iostat=iostat) &
641 '*** Hostname = '//host_name
642 CALL print_stack(lggr%default_local_unit_nr)
644 IF (iostat /= 0)
THEN
646 CALL m_hostnm(host_name)
647 print *,
" *** Error trying to WRITE to the local logger ***"
648 print *,
" *** MPI_id = ", lggr%para_env%mepos
649 print *,
" *** MPI_Communicator = ", lggr%para_env%get_handle()
650 print *,
" *** PID = ", pid
651 print *,
" *** Hostname = "//trim(host_name)
652 CALL print_stack(default_output_unit)
656 res = lggr%default_local_unit_nr
679 TYPE(cp_logger_type),
POINTER :: logger
680 CHARACTER(len=*),
INTENT(inout) :: res
681 CHARACTER(len=*),
INTENT(in) :: root, postfix
682 LOGICAL,
INTENT(in),
OPTIONAL :: local
684 CHARACTER(len=*),
PARAMETER :: routinen =
'cp_logger_generate_filename', &
685 routinep = modulen//
':'//routinen
688 TYPE(cp_logger_type),
POINTER :: lggr
695 IF (lggr%ref_count < 1) &
696 cpabort(routinep//
" logger%ref_count<1")
697 IF (
PRESENT(local)) loc = local
699 res = trim(root)//trim(lggr%suffix)//
'_p'// &
700 cp_to_string(lggr%para_env%mepos)//postfix
702 res = trim(root)//trim(lggr%suffix)//postfix
704 CALL compress(res, full=.true.)
717 TYPE(cp_logger_type),
INTENT(INOUT) :: logger
718 CHARACTER(len=*),
INTENT(in),
OPTIONAL :: local_filename, global_filename
720 IF (
PRESENT(local_filename)) logger%local_filename = local_filename
721 IF (
PRESENT(global_filename)) logger%global_filename = global_filename
735 FUNCTION cp_int_to_string(i, fmt)
RESULT(res)
736 INTEGER,
INTENT(in) :: i
737 CHARACTER(len=*),
OPTIONAL :: fmt
738 CHARACTER(len=25) :: res
740 CHARACTER(len=25) :: t_res
742 REAL(kind=dp) :: tmp_r
745 IF (
PRESENT(fmt))
THEN
746 WRITE (t_res, fmt=fmt, iostat=iostat) i
747 ELSE IF (i > 999999 .OR. i < -99999)
THEN
749 WRITE (t_res, fmt=
'(ES8.1)', iostat=iostat) tmp_r
751 WRITE (t_res, fmt=
'(I6)', iostat=iostat) i
754 IF (iostat /= 0)
THEN
755 print *,
"cp_int_to_string I/O error", iostat
759 END FUNCTION cp_int_to_string
772 FUNCTION cp_real_dp_to_string(val, fmt)
RESULT(res)
773 REAL(kind=dp),
INTENT(in) :: val
774 CHARACTER(len=*),
OPTIONAL :: fmt
775 CHARACTER(len=25) :: res
779 IF (
PRESENT(fmt))
THEN
780 WRITE (res, fmt=fmt, iostat=iostat) val
782 WRITE (res, fmt=
'(ES11.4)', iostat=iostat) val
784 IF (iostat /= 0)
THEN
785 print *,
"cp_real_dp_to_string I/O error", iostat
789 END FUNCTION cp_real_dp_to_string
797 ELEMENTAL FUNCTION cp_logical_to_string(val)
RESULT(res)
798 LOGICAL,
INTENT(in) :: val
799 CHARACTER(len=1) :: res
806 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.