Line data Source code
1 : !--------------------------------------------------------------------------------------------------!
2 : ! CP2K: A general program to perform molecular dynamics simulations !
3 : ! Copyright 2000-2026 CP2K developers group <https://cp2k.org> !
4 : ! !
5 : ! SPDX-License-Identifier: GPL-2.0-or-later !
6 : !--------------------------------------------------------------------------------------------------!
7 :
8 : ! **************************************************************************************************
9 : !> \brief various routines to log and control the output.
10 : !> The idea is that decisions about where to log should not be done in
11 : !> the code that generates the log, but should be globally changeable
12 : !> a central place.
13 : !> So some care has been taken to have enough information about the
14 : !> place from where the log comes so that in the future intelligent and
15 : !> flexible decisions can be taken by the logger, without having to change
16 : !> other code.
17 : !> \note
18 : !> contains also routines to convert to a string.
19 : !> in my idea they should have been with variable length,
20 : !> (i.e. they should have returned a trim(adjustl(actual_result)))
21 : !> As a logger should be robust, at the moment I have given up.
22 : !>
23 : !> At the moment logging and output refer to the same object
24 : !> (cp_logger_type)
25 : !> as these are actually different it might be better to separate them
26 : !> (they have already separate routines in a separate module
27 : !> @see cp_output_handling).
28 : !>
29 : !> some practices (use of print *, no cp_error_type,
30 : !> manual retain release of some objects) are dictated by the need to
31 : !> have minimal dependency
32 : !> \par History
33 : !> 08.2002 major update: retain, release, printkeys, para_env,
34 : !> local logging [fawzi]
35 : !> 02.2004 made a stack of default loggers [Joost VandeVondele]
36 : !> \par
37 : !> @see cp_error_handling
38 : !> \author Fawzi Mohamed
39 : !> @version 12.2001
40 : ! **************************************************************************************************
41 : MODULE cp_log_handling
42 : USE cp_files, ONLY: close_file,&
43 : open_file
44 : USE cp_iter_types, ONLY: cp_iteration_info_create,&
45 : cp_iteration_info_release,&
46 : cp_iteration_info_retain,&
47 : cp_iteration_info_type
48 : USE kinds, ONLY: default_path_length,&
49 : default_string_length,&
50 : dp
51 : USE machine, ONLY: default_output_unit,&
52 : m_getpid,&
53 : m_hostnm
54 : USE message_passing, ONLY: mp_para_env_release,&
55 : mp_para_env_type
56 : USE string_utilities, ONLY: compress
57 : USE timings, ONLY: print_stack
58 : #include "../base/base_uses.f90"
59 :
60 : IMPLICIT NONE
61 : PRIVATE
62 :
63 : !API types
64 : PUBLIC :: cp_logger_type, cp_logger_p_type
65 : !API parameter vars
66 : PUBLIC :: cp_note_level, cp_warning_level, cp_failure_level, cp_fatal_level
67 : !API default loggers
68 : PUBLIC :: cp_get_default_logger, cp_add_default_logger, cp_rm_default_logger, &
69 : cp_default_logger_stack_size
70 : !API logger routines
71 : PUBLIC :: cp_logger_create, cp_logger_retain, cp_logger_release, &
72 : cp_logger_would_log, cp_logger_set, cp_logger_get_default_unit_nr, &
73 : cp_logger_get_default_io_unit, cp_logger_get_unit_nr, &
74 : cp_logger_set_log_level, cp_logger_generate_filename, &
75 : cp_to_string
76 :
77 : CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'cp_log_handling'
78 : LOGICAL, PRIVATE, PARAMETER :: debug_this_module = .FALSE.
79 :
80 : !! level of an error
81 : INTEGER, PARAMETER :: cp_fatal_level = 3
82 : !! level of a failure
83 : INTEGER, PARAMETER :: cp_failure_level = 2
84 : !! level of a warning
85 : INTEGER, PARAMETER :: cp_warning_level = 1
86 : !! level of a note
87 : INTEGER, PARAMETER :: cp_note_level = 0
88 :
89 : !! a generic function to transform different types to strings
90 : INTERFACE cp_to_string
91 : MODULE PROCEDURE cp_int_to_string, cp_real_dp_to_string, cp_logical_to_string
92 : END INTERFACE
93 :
94 : ! **************************************************************************************************
95 : !> \brief type of a logger, at the moment it contains just a print level
96 : !> starting at which level it should be logged
97 : !> (0 note, 1 warning, 2 failure, 3 fatal)
98 : !> it could be expanded with the ability to focus on one or more
99 : !> module/object/thread/processor
100 : !> \param ref_count reference count (see cp2k/doc/ReferenceCounting.html)
101 : !> \param print_level the level starting at which something gets printed
102 : !> \param default_local_unit_nr default unit for local logging (-1 if not
103 : !> yet initialized). Local logging guarantee to each task its own
104 : !> file.
105 : !> \param default_global_unit_nr default unit for global logging
106 : !> (-1 if not yet initialized). This unit is valid only on the
107 : !> processor with %para_env%mepos==%para_env%source.
108 : !> \param para_env the parallel environment for the output.
109 : !> this might be a super environment of your computation environment
110 : !> i.e. be very careful not to do global operations like broadcast
111 : !> with a subset of its processors (use your computation environment
112 : !> instead).
113 : !> \param close_local_unit_on_dealloc if the local unit should be closed
114 : !> when this logger is deallocated
115 : !> \param close_global_unit_on_dealloc whether the global unit should be
116 : !> closed when this logger is deallocated
117 : !> \param suffix a short string that is used as suffix in all the filenames
118 : !> created by this logger. Can be used to guarantee the unicity of
119 : !> generated filename
120 : !> \param local_filename the root of the name of the file used for local
121 : !> logging (can be different from the name of the file corresponding
122 : !> to default_local_unit_nr, only the one used if the unit needs to
123 : !> be opened)
124 : !> \param global_filename the root of the name of the file used for
125 : !> global logging (can be different from the name of the file
126 : !> corresponding to default_global_unit_nr, only the one used if
127 : !> the unit needs to be opened)
128 : !> \param print_keys print keys that tell what should be logged/outputted
129 : !> \note
130 : !> This should be private, but as the output functions have been
131 : !> moved to another module and there is no "friend" keyword, they
132 : !> are public.
133 : !> DO NOT USE THE INTERNAL COMPONENTS DIRECTLY!!!
134 : !> \par History
135 : !> 04.2002 revised [fawzi]
136 : !> 08.2002 major update: retain, release, printkeys, para_env,
137 : !> local logging [fawzi]
138 : !> \author Fawzi Mohamed
139 : ! **************************************************************************************************
140 : TYPE cp_logger_type
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
151 :
152 : TYPE cp_logger_p_type
153 : TYPE(cp_logger_type), POINTER :: p => Null()
154 : END TYPE cp_logger_p_type
155 :
156 : ! **************************************************************************************************
157 : TYPE default_logger_stack_type
158 : TYPE(cp_logger_type), POINTER :: cp_default_logger => Null()
159 : END TYPE default_logger_stack_type
160 :
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
164 :
165 : CONTAINS
166 :
167 : ! **************************************************************************************************
168 : !> \brief ...
169 : !> \return ...
170 : !> \author fawzi
171 : ! **************************************************************************************************
172 32916 : FUNCTION cp_default_logger_stack_size() RESULT(res)
173 : INTEGER :: res
174 :
175 32916 : res = stack_pointer
176 32916 : END FUNCTION cp_default_logger_stack_size
177 :
178 : ! **************************************************************************************************
179 : !> \brief adds a default logger.
180 : !> MUST be called before logging occours
181 : !> \param logger ...
182 : !> \author Fawzi Mohamed
183 : !> \note
184 : !> increments a stack of default loggers the latest one will be
185 : !> available within the program
186 : ! **************************************************************************************************
187 121929 : SUBROUTINE cp_add_default_logger(logger)
188 : TYPE(cp_logger_type), INTENT(INOUT), TARGET :: logger
189 :
190 : CHARACTER(len=*), PARAMETER :: routineN = 'cp_add_default_logger', &
191 : routineP = moduleN//':'//routineN
192 :
193 121929 : IF (stack_pointer + 1 > max_stack_pointer) THEN
194 : CALL cp_abort(__LOCATION__, routineP// &
195 0 : "too many default loggers, increase max_stack_pointer in "//moduleN)
196 : END IF
197 :
198 121929 : stack_pointer = stack_pointer + 1
199 121929 : NULLIFY (default_logger_stack(stack_pointer)%cp_default_logger)
200 :
201 121929 : default_logger_stack(stack_pointer)%cp_default_logger => logger
202 121929 : CALL cp_logger_retain(logger)
203 :
204 121929 : END SUBROUTINE cp_add_default_logger
205 :
206 : ! **************************************************************************************************
207 : !> \brief the cousin of cp_add_default_logger, decrements the stack, so that
208 : !> the default logger is what it has
209 : !> been
210 : !> \author Joost VandeVondele
211 : ! **************************************************************************************************
212 121929 : SUBROUTINE cp_rm_default_logger()
213 121929 : IF (stack_pointer - 1 < 0) THEN
214 : CALL cp_abort(__LOCATION__, moduleN//":cp_rm_default_logger "// &
215 0 : "can not destroy default logger "//moduleN)
216 : END IF
217 :
218 121929 : CALL cp_logger_release(default_logger_stack(stack_pointer)%cp_default_logger)
219 121929 : NULLIFY (default_logger_stack(stack_pointer)%cp_default_logger)
220 121929 : stack_pointer = stack_pointer - 1
221 :
222 121929 : END SUBROUTINE cp_rm_default_logger
223 :
224 : ! **************************************************************************************************
225 : !> \brief returns the default logger
226 : !> \return ...
227 : !> \par History
228 : !> 4.2002 created [fawzi]
229 : !> \author Fawzi Mohamed
230 : !> \note
231 : !> initializes the default loggers if necessary
232 : ! **************************************************************************************************
233 14292005 : FUNCTION cp_get_default_logger() RESULT(res)
234 : TYPE(cp_logger_type), POINTER :: res
235 :
236 14292005 : IF (.NOT. stack_pointer > 0) THEN
237 : CALL cp_abort(__LOCATION__, "cp_log_handling:cp_get_default_logger "// &
238 0 : "default logger not yet initialized (CALL cp_init_default_logger)")
239 : END IF
240 14292005 : res => default_logger_stack(stack_pointer)%cp_default_logger
241 14292005 : IF (.NOT. ASSOCIATED(res)) THEN
242 : CALL cp_abort(__LOCATION__, "cp_log_handling:cp_get_default_logger "// &
243 0 : "default logger is null (released too much ?)")
244 : END IF
245 14292005 : END FUNCTION cp_get_default_logger
246 :
247 : ! ================== log ==================
248 :
249 : ! **************************************************************************************************
250 : !> \brief initializes a logger
251 : !> \param logger the logger to initialize
252 : !> \param para_env the parallel environment (this is most likely the global
253 : !> parallel environment
254 : !> \param print_level the level starting with which something is written
255 : !> (defaults to cp_note_level)
256 : !> \param default_global_unit_nr the default unit_nr for output
257 : !> (if not given, and no file is given defaults to the standard output)
258 : !> \param default_local_unit_nr the default unit number for local (i.e. task)
259 : !> output. If not given defaults to a out.taskid file created upon
260 : !> \param global_filename a new file to open (can be given instread of the
261 : !> global_unit_nr)
262 : !> \param local_filename a new file to open (with suffix and para_env%mepos
263 : !> appended). Can be given instread of the default_local_unit_nr).
264 : !> the file is created only upon the first local logging request
265 : !> \param close_global_unit_on_dealloc if the unit should be closed when the
266 : !> logger is deallocated (defaults to true if a local_filename is given,
267 : !> to false otherwise)
268 : !> \param iter_info ...
269 : !> \param close_local_unit_on_dealloc if the unit should be closed when the
270 : !> logger is deallocated (defaults to true)
271 : !> \param suffix the suffix that should be added to all the generated filenames
272 : !> \param template_logger a logger from where to take the unspecified things
273 : !> \par History
274 : !> 4.2002 created [fawzi]
275 : !> \author Fawzi Mohamed
276 : !> \note
277 : !> the handling of *_filename, default_*_unit_nr, close_*_unit_on_dealloc
278 : !> tries to take the right decision with different inputs, and thus is a
279 : !> little complex.
280 : ! **************************************************************************************************
281 22705 : SUBROUTINE cp_logger_create(logger, para_env, print_level, &
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
295 :
296 : CHARACTER(len=*), PARAMETER :: routineN = 'cp_logger_create', &
297 : routineP = moduleN//':'//routineN
298 :
299 0 : ALLOCATE (logger)
300 :
301 22705 : NULLIFY (logger%para_env)
302 22705 : NULLIFY (logger%iter_info)
303 22705 : logger%ref_count = 1
304 :
305 22705 : IF (PRESENT(template_logger)) THEN
306 124 : IF (template_logger%ref_count < 1) THEN
307 0 : CPABORT(routineP//" template_logger%ref_count<1")
308 : END IF
309 124 : logger%print_level = template_logger%print_level
310 124 : logger%default_global_unit_nr = template_logger%default_global_unit_nr
311 124 : logger%close_local_unit_on_dealloc = template_logger%close_local_unit_on_dealloc
312 124 : IF (logger%close_local_unit_on_dealloc) THEN
313 59 : logger%default_local_unit_nr = -1
314 : ELSE
315 65 : logger%default_local_unit_nr = template_logger%default_local_unit_nr
316 : END IF
317 124 : logger%close_global_unit_on_dealloc = template_logger%close_global_unit_on_dealloc
318 124 : IF (logger%close_global_unit_on_dealloc) THEN
319 0 : logger%default_global_unit_nr = -1
320 : ELSE
321 124 : logger%default_global_unit_nr = template_logger%default_global_unit_nr
322 : END IF
323 124 : logger%local_filename = template_logger%local_filename
324 124 : logger%global_filename = template_logger%global_filename
325 124 : logger%para_env => template_logger%para_env
326 124 : logger%suffix = template_logger%suffix
327 124 : logger%iter_info => template_logger%iter_info
328 : ELSE
329 : ! create a file if nothing is specified, one can also get the unit from the default logger
330 : ! which should have something reasonable as the argument is required in that case
331 22581 : logger%default_global_unit_nr = -1
332 22581 : logger%close_global_unit_on_dealloc = .TRUE.
333 22581 : logger%local_filename = "localLog"
334 22581 : logger%global_filename = "mainLog"
335 22581 : logger%print_level = cp_note_level
336 : ! generate a file for default local logger
337 : ! except the ionode that should write to the default global logger
338 22581 : logger%default_local_unit_nr = -1
339 22581 : logger%close_local_unit_on_dealloc = .TRUE.
340 22581 : logger%suffix = ""
341 : END IF
342 22705 : IF (PRESENT(para_env)) logger%para_env => para_env
343 22705 : IF (.NOT. ASSOCIATED(logger%para_env)) THEN
344 0 : CPABORT(routineP//" para env not associated")
345 : END IF
346 22705 : IF (.NOT. logger%para_env%is_valid()) THEN
347 0 : CPABORT(routineP//" para_env%ref_count<1")
348 : END IF
349 22705 : CALL logger%para_env%retain()
350 :
351 22705 : IF (PRESENT(print_level)) logger%print_level = print_level
352 :
353 22705 : IF (PRESENT(default_global_unit_nr)) THEN
354 22587 : logger%default_global_unit_nr = default_global_unit_nr
355 : END IF
356 22705 : IF (PRESENT(global_filename)) THEN
357 0 : logger%global_filename = global_filename
358 0 : logger%close_global_unit_on_dealloc = .TRUE.
359 0 : logger%default_global_unit_nr = -1
360 : END IF
361 22705 : IF (PRESENT(close_global_unit_on_dealloc)) THEN
362 22587 : logger%close_global_unit_on_dealloc = close_global_unit_on_dealloc
363 22587 : IF (PRESENT(default_global_unit_nr) .AND. PRESENT(global_filename) .AND. &
364 : (.NOT. close_global_unit_on_dealloc)) THEN
365 0 : logger%default_global_unit_nr = default_global_unit_nr
366 : END IF
367 : END IF
368 :
369 22705 : IF (PRESENT(default_local_unit_nr)) THEN
370 0 : logger%default_local_unit_nr = default_local_unit_nr
371 : END IF
372 22705 : IF (PRESENT(local_filename)) THEN
373 0 : logger%local_filename = local_filename
374 0 : logger%close_local_unit_on_dealloc = .TRUE.
375 0 : logger%default_local_unit_nr = -1
376 : END IF
377 22705 : IF (PRESENT(suffix)) logger%suffix = suffix
378 :
379 22705 : IF (PRESENT(close_local_unit_on_dealloc)) THEN
380 0 : logger%close_local_unit_on_dealloc = close_local_unit_on_dealloc
381 0 : IF (PRESENT(default_local_unit_nr) .AND. PRESENT(local_filename) .AND. &
382 : (.NOT. close_local_unit_on_dealloc)) THEN
383 0 : logger%default_local_unit_nr = default_local_unit_nr
384 : END IF
385 : END IF
386 :
387 22705 : IF (logger%default_local_unit_nr == -1) THEN
388 22640 : IF (logger%para_env%is_source()) THEN
389 11773 : logger%default_local_unit_nr = logger%default_global_unit_nr
390 11773 : logger%close_local_unit_on_dealloc = .FALSE.
391 : END IF
392 : END IF
393 22705 : IF (PRESENT(iter_info)) logger%iter_info => iter_info
394 22705 : IF (ASSOCIATED(logger%iter_info)) THEN
395 124 : CALL cp_iteration_info_retain(logger%iter_info)
396 : ELSE
397 22581 : CALL cp_iteration_info_create(logger%iter_info, "")
398 : END IF
399 22705 : END SUBROUTINE cp_logger_create
400 :
401 : ! **************************************************************************************************
402 : !> \brief retains the given logger (to be called to keep a shared copy of
403 : !> the logger)
404 : !> \param logger the logger to retain
405 : !> \par History
406 : !> 08.2002 created [fawzi]
407 : !> \author Fawzi Mohamed
408 : ! **************************************************************************************************
409 132492 : SUBROUTINE cp_logger_retain(logger)
410 : TYPE(cp_logger_type), INTENT(INOUT) :: logger
411 :
412 : CHARACTER(len=*), PARAMETER :: routineN = 'cp_logger_retain', &
413 : routineP = moduleN//':'//routineN
414 :
415 132492 : IF (logger%ref_count < 1) THEN
416 0 : CPABORT(routineP//" logger%ref_count<1")
417 : END IF
418 132492 : logger%ref_count = logger%ref_count + 1
419 132492 : END SUBROUTINE cp_logger_retain
420 :
421 : ! **************************************************************************************************
422 : !> \brief releases this logger
423 : !> \param logger the logger to release
424 : !> \par History
425 : !> 4.2002 created [fawzi]
426 : !> \author Fawzi Mohamed
427 : ! **************************************************************************************************
428 155197 : SUBROUTINE cp_logger_release(logger)
429 : TYPE(cp_logger_type), POINTER :: logger
430 :
431 : CHARACTER(len=*), PARAMETER :: routineN = 'cp_logger_release', &
432 : routineP = moduleN//':'//routineN
433 :
434 155197 : IF (ASSOCIATED(logger)) THEN
435 155197 : IF (logger%ref_count < 1) THEN
436 0 : CPABORT(routineP//" logger%ref_count<1")
437 : END IF
438 155197 : logger%ref_count = logger%ref_count - 1
439 155197 : IF (logger%ref_count == 0) THEN
440 22705 : IF (logger%close_global_unit_on_dealloc .AND. &
441 : logger%default_global_unit_nr >= 0) THEN
442 1 : CALL close_file(logger%default_global_unit_nr)
443 1 : logger%close_global_unit_on_dealloc = .FALSE.
444 1 : logger%default_global_unit_nr = -1
445 : END IF
446 22705 : IF (logger%close_local_unit_on_dealloc .AND. &
447 : logger%default_local_unit_nr >= 0) THEN
448 596 : CALL close_file(logger%default_local_unit_nr)
449 596 : logger%close_local_unit_on_dealloc = .FALSE.
450 596 : logger%default_local_unit_nr = -1
451 : END IF
452 22705 : CALL mp_para_env_release(logger%para_env)
453 22705 : CALL cp_iteration_info_release(logger%iter_info)
454 22705 : DEALLOCATE (logger)
455 : END IF
456 : END IF
457 155197 : NULLIFY (logger)
458 155197 : END SUBROUTINE cp_logger_release
459 :
460 : ! **************************************************************************************************
461 : !> \brief this function can be called to check if the logger would log
462 : !> a message with the given level from the given source
463 : !> you should use this function if you do direct logging
464 : !> (without using cp_logger_log), or if you want to know if the generation
465 : !> of some costly log info is necessary
466 : !> \param logger the logger you want to log in
467 : !> \param level describes the of the message: cp_fatal_level(3),
468 : !> cp_failure_level(2), cp_warning_level(1), cp_note_level(0).
469 : !> \return ...
470 : !> \par History
471 : !> 4.2002 revised [fawzi]
472 : !> \author Fawzi Mohamed
473 : ! **************************************************************************************************
474 5330 : FUNCTION cp_logger_would_log(logger, level) RESULT(res)
475 : TYPE(cp_logger_type), POINTER :: logger
476 : INTEGER, INTENT(in) :: level
477 : LOGICAL :: res
478 :
479 : CHARACTER(len=*), PARAMETER :: routineN = 'cp_logger_would_log', &
480 : routineP = moduleN//':'//routineN
481 :
482 : TYPE(cp_logger_type), POINTER :: lggr
483 :
484 5330 : lggr => logger
485 5330 : IF (.NOT. ASSOCIATED(lggr)) lggr => cp_get_default_logger()
486 5330 : IF (lggr%ref_count < 1) THEN
487 0 : CPABORT(routineP//" logger%ref_count<1")
488 : END IF
489 :
490 5330 : res = level >= lggr%print_level
491 5330 : END FUNCTION cp_logger_would_log
492 :
493 : ! **************************************************************************************************
494 : !> \brief returns the unit nr for the requested kind of log.
495 : !> \param logger the logger you want to log in
496 : !> \param local if true returns a local logger (one per task), otherwise
497 : !> returns a global logger (only the process with para_env%mepos==
498 : !> para_env%source should write to the global logger). Defaults to
499 : !> false
500 : !> \return ...
501 : !> \par History
502 : !> 4.2002 revised [fawzi]
503 : !> \author Fawzi Mohamed
504 : ! **************************************************************************************************
505 212 : FUNCTION cp_logger_get_unit_nr(logger, local) RESULT(res)
506 : TYPE(cp_logger_type), POINTER :: logger
507 : LOGICAL, INTENT(in), OPTIONAL :: local
508 : INTEGER :: res
509 :
510 212 : res = cp_logger_get_default_unit_nr(logger, local=local)
511 212 : END FUNCTION cp_logger_get_unit_nr
512 :
513 : ! **************************************************************************************************
514 : !> \brief returns the unit nr for the ionode (-1 on all other processors)
515 : !> skips as well checks if the procs calling this function is not the ionode
516 : !> \param logger the logger you want to log in
517 : !> \return ...
518 : !> \par History
519 : !> 12.2009 created [tlaino]
520 : !> \author Teodoro Laino
521 : ! **************************************************************************************************
522 9186260 : FUNCTION cp_logger_get_default_io_unit(logger) RESULT(res)
523 : TYPE(cp_logger_type), OPTIONAL, POINTER :: logger
524 : INTEGER :: res
525 :
526 : TYPE(cp_logger_type), POINTER :: local_logger
527 :
528 9186260 : IF (PRESENT(logger)) THEN
529 715220 : local_logger => logger
530 8471040 : ELSE IF (stack_pointer == 0) THEN
531 9186260 : res = -1 ! edge case: default logger not yet/anymore available
532 : RETURN
533 : ELSE
534 8471040 : local_logger => cp_get_default_logger()
535 : END IF
536 :
537 9186260 : res = cp_logger_get_default_unit_nr(local_logger, local=.FALSE., skip_not_ionode=.TRUE.)
538 9186260 : END FUNCTION cp_logger_get_default_io_unit
539 :
540 : ! *************************** cp_logger_type settings ***************************
541 :
542 : ! **************************************************************************************************
543 : !> \brief changes the logging level. Log messages with a level less than the one
544 : !> given wo not be printed.
545 : !> \param logger the logger to change
546 : !> \param level the new logging level for the logger
547 : !> \par History
548 : !> 4.2002 revised [fawzi]
549 : !> \author Fawzi Mohamed
550 : ! **************************************************************************************************
551 0 : SUBROUTINE cp_logger_set_log_level(logger, level)
552 : TYPE(cp_logger_type), INTENT(INOUT) :: logger
553 : INTEGER, INTENT(in) :: level
554 :
555 : CHARACTER(len=*), PARAMETER :: routineN = 'cp_logger_set_log_level', &
556 : routineP = moduleN//':'//routineN
557 :
558 0 : IF (logger%ref_count < 1) THEN
559 0 : CPABORT(routineP//" logger%ref_count<1")
560 : END IF
561 0 : logger%print_level = level
562 0 : END SUBROUTINE cp_logger_set_log_level
563 :
564 : ! **************************************************************************************************
565 : !> \brief asks the default unit number of the given logger.
566 : !> try to use cp_logger_get_unit_nr
567 : !> \param logger the logger you want info from
568 : !> \param local if you want the local unit nr (defaults to false)
569 : !> \param skip_not_ionode ...
570 : !> \return ...
571 : !> \par History
572 : !> 4.2002 revised [fawzi]
573 : !> \author Fawzi Mohamed
574 : ! **************************************************************************************************
575 9644209 : RECURSIVE FUNCTION cp_logger_get_default_unit_nr(logger, local, skip_not_ionode) RESULT(res)
576 : TYPE(cp_logger_type), OPTIONAL, POINTER :: logger
577 : LOGICAL, INTENT(in), OPTIONAL :: local, skip_not_ionode
578 : INTEGER :: res
579 :
580 : CHARACTER(len=*), PARAMETER :: routineN = 'cp_logger_get_default_unit_nr', &
581 : routineP = moduleN//':'//routineN
582 :
583 : CHARACTER(len=default_path_length) :: filename, host_name
584 : INTEGER :: iostat, pid
585 : LOGICAL :: loc, skip
586 : TYPE(cp_logger_type), POINTER :: lggr
587 :
588 9644209 : loc = .TRUE.
589 9644209 : skip = .FALSE.
590 9644209 : IF (PRESENT(logger)) THEN
591 9639892 : lggr => logger
592 : ELSE
593 4317 : NULLIFY (lggr)
594 : END IF
595 9644209 : IF (.NOT. ASSOCIATED(lggr)) lggr => cp_get_default_logger()
596 9644209 : IF (lggr%ref_count < 1) THEN
597 0 : CPABORT(routineP//" logger%ref_count<1")
598 : END IF
599 :
600 9644209 : IF (PRESENT(local)) loc = local
601 9644209 : IF (PRESENT(skip_not_ionode)) skip = skip_not_ionode
602 9644209 : IF (.NOT. loc) THEN
603 9577252 : IF (lggr%default_global_unit_nr <= 0) THEN
604 3853389 : IF (lggr%para_env%is_source()) THEN
605 : CALL cp_logger_generate_filename(lggr, filename, lggr%global_filename, &
606 0 : ".out", local=.FALSE.)
607 : CALL open_file(TRIM(filename), file_status="unknown", &
608 : file_action="WRITE", file_position="APPEND", &
609 0 : unit_number=lggr%default_global_unit_nr)
610 3853389 : ELSE IF (.NOT. skip) THEN
611 2 : lggr%default_global_unit_nr = cp_logger_get_default_unit_nr(lggr, .TRUE.)
612 2 : lggr%close_global_unit_on_dealloc = .FALSE.
613 : ELSE
614 3853387 : lggr%default_global_unit_nr = -1
615 3853387 : lggr%close_global_unit_on_dealloc = .FALSE.
616 : END IF
617 : END IF
618 9577252 : IF (.NOT. (lggr%para_env%is_source() .OR. skip)) THEN
619 : WRITE (UNIT=lggr%default_global_unit_nr, FMT='(/,T2,A)', IOSTAT=iostat) &
620 2 : ' *** WARNING non ionode asked for global logger ***'
621 2 : IF (iostat /= 0) THEN
622 0 : CALL m_getpid(pid)
623 0 : CALL m_hostnm(host_name)
624 0 : PRINT *, " *** Error trying to WRITE to the local logger ***"
625 0 : PRINT *, " *** MPI_id = ", lggr%para_env%mepos
626 0 : PRINT *, " *** MPI_Communicator = ", lggr%para_env%get_handle()
627 0 : PRINT *, " *** PID = ", pid
628 0 : PRINT *, " *** Hostname = "//TRIM(host_name)
629 0 : CALL print_stack(default_output_unit)
630 : ELSE
631 2 : CALL print_stack(lggr%default_global_unit_nr)
632 : END IF
633 : END IF
634 9577252 : res = lggr%default_global_unit_nr
635 : ELSE
636 66957 : IF (lggr%default_local_unit_nr <= 0) THEN
637 : CALL cp_logger_generate_filename(lggr, filename, lggr%local_filename, &
638 596 : ".out", local=.TRUE.)
639 : CALL open_file(TRIM(filename), file_status="unknown", &
640 : file_action="WRITE", &
641 : file_position="APPEND", &
642 596 : 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 596 : '*** Local logger file of MPI task ', lggr%para_env%mepos, &
645 1192 : ' in communicator ', lggr%para_env%get_handle(), ' ***'
646 596 : IF (iostat == 0) THEN
647 596 : CALL m_getpid(pid)
648 596 : CALL m_hostnm(host_name)
649 : WRITE (UNIT=lggr%default_local_unit_nr, FMT='(T2,A,I0)', IOSTAT=iostat) &
650 596 : '*** PID = ', pid, &
651 1192 : '*** Hostname = '//host_name
652 596 : CALL print_stack(lggr%default_local_unit_nr)
653 : END IF
654 596 : IF (iostat /= 0) THEN
655 0 : CALL m_getpid(pid)
656 0 : CALL m_hostnm(host_name)
657 0 : PRINT *, " *** Error trying to WRITE to the local logger ***"
658 0 : PRINT *, " *** MPI_id = ", lggr%para_env%mepos
659 0 : PRINT *, " *** MPI_Communicator = ", lggr%para_env%get_handle()
660 0 : PRINT *, " *** PID = ", pid
661 0 : PRINT *, " *** Hostname = "//TRIM(host_name)
662 0 : CALL print_stack(default_output_unit)
663 : END IF
664 :
665 : END IF
666 66957 : res = lggr%default_local_unit_nr
667 : END IF
668 9644209 : END FUNCTION cp_logger_get_default_unit_nr
669 :
670 : ! **************************************************************************************************
671 : !> \brief generates a unique filename (ie adding eventual suffixes and
672 : !> process ids)
673 : !> \param logger ...
674 : !> \param res the resulting string
675 : !> \param root the start of filename
676 : !> \param postfix the end of the name
677 : !> \param local if the name should be local to this task (defaults to false)
678 : !> \par History
679 : !> 08.2002 created [fawzi]
680 : !> \author Fawzi Mohamed
681 : !> \note
682 : !> this should be a function returning a variable length string.
683 : !> All spaces are moved to the end of the string.
684 : !> Not fully optimized: result must be a little longer than the
685 : !> resulting compressed filename
686 : ! **************************************************************************************************
687 101845 : SUBROUTINE cp_logger_generate_filename(logger, res, root, postfix, &
688 : local)
689 : TYPE(cp_logger_type), POINTER :: logger
690 : CHARACTER(len=*), INTENT(inout) :: res
691 : CHARACTER(len=*), INTENT(in) :: root, postfix
692 : LOGICAL, INTENT(in), OPTIONAL :: local
693 :
694 : CHARACTER(len=*), PARAMETER :: routineN = 'cp_logger_generate_filename', &
695 : routineP = moduleN//':'//routineN
696 :
697 : LOGICAL :: loc
698 : TYPE(cp_logger_type), POINTER :: lggr
699 :
700 101845 : loc = .FALSE.
701 101845 : res = ' '
702 101845 : lggr => logger
703 :
704 101845 : IF (.NOT. ASSOCIATED(lggr)) lggr => cp_get_default_logger()
705 101845 : IF (lggr%ref_count < 1) THEN
706 0 : CPABORT(routineP//" logger%ref_count<1")
707 : END IF
708 101845 : IF (PRESENT(local)) loc = local
709 101845 : IF (loc) THEN
710 : res = TRIM(root)//TRIM(lggr%suffix)//'_p'// &
711 819 : cp_to_string(lggr%para_env%mepos)//postfix
712 : ELSE
713 101026 : res = TRIM(root)//TRIM(lggr%suffix)//postfix
714 : END IF
715 101845 : CALL compress(res, full=.TRUE.)
716 101845 : END SUBROUTINE cp_logger_generate_filename
717 :
718 : ! **************************************************************************************************
719 : !> \brief sets various attributes of the given logger
720 : !> \param logger the logger you want to change
721 : !> \param local_filename the root of the name of the file used for local
722 : !> logging
723 : !> \param global_filename the root of the name of the file used for
724 : !> global logging
725 : !> \author Fawzi Mohamed
726 : ! **************************************************************************************************
727 12179 : SUBROUTINE cp_logger_set(logger, local_filename, global_filename)
728 : TYPE(cp_logger_type), INTENT(INOUT) :: logger
729 : CHARACTER(len=*), INTENT(in), OPTIONAL :: local_filename, global_filename
730 :
731 12177 : IF (PRESENT(local_filename)) logger%local_filename = local_filename
732 12179 : IF (PRESENT(global_filename)) logger%global_filename = global_filename
733 12179 : END SUBROUTINE cp_logger_set
734 :
735 : ! **************************************************************************************************
736 : !> \brief converts an int to a string
737 : !> (should be a variable length string, but that does not work with
738 : !> all the compilers)
739 : !> \param i the integer to convert
740 : !> \param fmt Optional format string
741 : !> \return ...
742 : !> \par History
743 : !> 4.2002 revised [fawzi]
744 : !> \author Fawzi Mohamed, MK
745 : ! **************************************************************************************************
746 9388048 : FUNCTION cp_int_to_string(i, fmt) RESULT(res)
747 : INTEGER, INTENT(in) :: i
748 : CHARACTER(len=*), OPTIONAL :: fmt
749 : CHARACTER(len=25) :: res
750 :
751 : CHARACTER(len=25) :: t_res
752 : INTEGER :: iostat
753 : REAL(KIND=dp) :: tmp_r
754 :
755 9388048 : iostat = 0
756 9388048 : IF (PRESENT(fmt)) THEN
757 1820 : WRITE (t_res, FMT=fmt, IOSTAT=iostat) i
758 9386228 : ELSE IF (i > 999999 .OR. i < -99999) THEN
759 1 : tmp_r = i
760 1 : WRITE (t_res, FMT='(ES8.1)', IOSTAT=iostat) tmp_r
761 : ELSE
762 9386227 : WRITE (t_res, FMT='(I6)', IOSTAT=iostat) i
763 : END IF
764 9388048 : res = t_res
765 9388048 : IF (iostat /= 0) THEN
766 0 : PRINT *, "cp_int_to_string I/O error", iostat
767 0 : CALL print_stack(cp_logger_get_default_unit_nr())
768 : END IF
769 :
770 9388048 : END FUNCTION cp_int_to_string
771 :
772 : ! **************************************************************************************************
773 : !> \brief Convert a double precision real in a string
774 : !> (should be a variable length string, but that does not work with
775 : !> all the compilers)
776 : !> \param val the number to convert
777 : !> \param fmt Optional format string
778 : !> \return ...
779 : !> \par History
780 : !> 4.2002 revised [fawzi]
781 : !> \author Fawzi Mohamed, MK
782 : ! **************************************************************************************************
783 103411 : 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
787 :
788 : INTEGER :: iostat
789 :
790 103411 : IF (PRESENT(fmt)) THEN
791 1820 : WRITE (res, FMT=fmt, IOSTAT=iostat) val
792 : ELSE
793 101591 : WRITE (res, FMT='(ES11.4)', IOSTAT=iostat) val
794 : END IF
795 103411 : IF (iostat /= 0) THEN
796 0 : PRINT *, "cp_real_dp_to_string I/O error", iostat
797 0 : CALL print_stack(cp_logger_get_default_unit_nr())
798 : END IF
799 :
800 103411 : END FUNCTION cp_real_dp_to_string
801 :
802 : ! **************************************************************************************************
803 : !> \brief convert a logical in a string ('T' or 'F')
804 : !> \param val the number to convert
805 : !> \return ...
806 : !> \author fawzi
807 : ! **************************************************************************************************
808 0 : ELEMENTAL FUNCTION cp_logical_to_string(val) RESULT(res)
809 : LOGICAL, INTENT(in) :: val
810 : CHARACTER(len=1) :: res
811 :
812 0 : IF (val) THEN
813 0 : res = 'T'
814 : ELSE
815 0 : res = 'F'
816 : END IF
817 0 : END FUNCTION cp_logical_to_string
818 :
819 0 : END MODULE cp_log_handling
820 :
|
