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 34145 : FUNCTION cp_default_logger_stack_size() RESULT(res)
173 : INTEGER :: res
174 :
175 34145 : res = stack_pointer
176 34145 : 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 114678 : 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 114678 : 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 114678 : stack_pointer = stack_pointer + 1
199 114678 : NULLIFY (default_logger_stack(stack_pointer)%cp_default_logger)
200 :
201 114678 : default_logger_stack(stack_pointer)%cp_default_logger => logger
202 114678 : CALL cp_logger_retain(logger)
203 :
204 114678 : 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 114676 : SUBROUTINE cp_rm_default_logger()
213 114676 : 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 114676 : CALL cp_logger_release(default_logger_stack(stack_pointer)%cp_default_logger)
219 114676 : NULLIFY (default_logger_stack(stack_pointer)%cp_default_logger)
220 114676 : stack_pointer = stack_pointer - 1
221 :
222 114676 : 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 15342629 : FUNCTION cp_get_default_logger() RESULT(res)
234 : TYPE(cp_logger_type), POINTER :: res
235 :
236 15342629 : 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 15342629 : res => default_logger_stack(stack_pointer)%cp_default_logger
241 15342629 : 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 15342629 : 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 14347 : 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 14347 : NULLIFY (logger%para_env)
302 14347 : NULLIFY (logger%iter_info)
303 14347 : logger%ref_count = 1
304 :
305 14347 : 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 14223 : logger%default_global_unit_nr = -1
332 14223 : logger%close_global_unit_on_dealloc = .TRUE.
333 14223 : logger%local_filename = "localLog"
334 14223 : logger%global_filename = "mainLog"
335 14223 : 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 14223 : logger%default_local_unit_nr = -1
339 14223 : logger%close_local_unit_on_dealloc = .TRUE.
340 14223 : logger%suffix = ""
341 : END IF
342 14347 : IF (PRESENT(para_env)) logger%para_env => para_env
343 14347 : IF (.NOT. ASSOCIATED(logger%para_env)) THEN
344 0 : CPABORT(routineP//" para env not associated")
345 : END IF
346 14347 : IF (.NOT. logger%para_env%is_valid()) THEN
347 0 : CPABORT(routineP//" para_env%ref_count<1")
348 : END IF
349 14347 : CALL logger%para_env%retain()
350 :
351 14347 : IF (PRESENT(print_level)) logger%print_level = print_level
352 :
353 14347 : IF (PRESENT(default_global_unit_nr)) THEN
354 14229 : logger%default_global_unit_nr = default_global_unit_nr
355 : END IF
356 14347 : 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 14347 : IF (PRESENT(close_global_unit_on_dealloc)) THEN
362 14229 : logger%close_global_unit_on_dealloc = close_global_unit_on_dealloc
363 14229 : 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 14347 : IF (PRESENT(default_local_unit_nr)) THEN
370 0 : logger%default_local_unit_nr = default_local_unit_nr
371 : END IF
372 14347 : 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 14347 : IF (PRESENT(suffix)) logger%suffix = suffix
378 :
379 14347 : 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 14347 : IF (logger%default_local_unit_nr == -1) THEN
388 14282 : IF (logger%para_env%is_source()) THEN
389 7611 : logger%default_local_unit_nr = logger%default_global_unit_nr
390 7611 : logger%close_local_unit_on_dealloc = .FALSE.
391 : END IF
392 : END IF
393 14347 : IF (PRESENT(iter_info)) logger%iter_info => iter_info
394 14347 : IF (ASSOCIATED(logger%iter_info)) THEN
395 124 : CALL cp_iteration_info_retain(logger%iter_info)
396 : ELSE
397 14223 : CALL cp_iteration_info_create(logger%iter_info, "")
398 : END IF
399 14347 : 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 125862 : 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 125862 : IF (logger%ref_count < 1) THEN
416 0 : CPABORT(routineP//" logger%ref_count<1")
417 : END IF
418 125862 : logger%ref_count = logger%ref_count + 1
419 125862 : 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 140206 : 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 140206 : IF (ASSOCIATED(logger)) THEN
435 140206 : IF (logger%ref_count < 1) THEN
436 0 : CPABORT(routineP//" logger%ref_count<1")
437 : END IF
438 140206 : logger%ref_count = logger%ref_count - 1
439 140206 : IF (logger%ref_count == 0) THEN
440 14345 : IF (logger%close_global_unit_on_dealloc .AND. &
441 : logger%default_global_unit_nr >= 0) THEN
442 0 : CALL close_file(logger%default_global_unit_nr)
443 0 : logger%close_global_unit_on_dealloc = .FALSE.
444 0 : logger%default_global_unit_nr = -1
445 : END IF
446 14345 : IF (logger%close_local_unit_on_dealloc .AND. &
447 : logger%default_local_unit_nr >= 0) THEN
448 605 : CALL close_file(logger%default_local_unit_nr)
449 605 : logger%close_local_unit_on_dealloc = .FALSE.
450 605 : logger%default_local_unit_nr = -1
451 : END IF
452 14345 : CALL mp_para_env_release(logger%para_env)
453 14345 : CALL cp_iteration_info_release(logger%iter_info)
454 14345 : DEALLOCATE (logger)
455 : END IF
456 : END IF
457 140206 : NULLIFY (logger)
458 140206 : 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 5642 : 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 5642 : lggr => logger
485 5642 : IF (.NOT. ASSOCIATED(lggr)) lggr => cp_get_default_logger()
486 5642 : IF (lggr%ref_count < 1) THEN
487 0 : CPABORT(routineP//" logger%ref_count<1")
488 : END IF
489 :
490 5642 : res = level >= lggr%print_level
491 5642 : 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 159 : 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 159 : res = cp_logger_get_default_unit_nr(logger, local=local)
511 159 : 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 10101603 : 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 10101603 : IF (PRESENT(logger)) THEN
529 762835 : local_logger => logger
530 9338768 : ELSE IF (stack_pointer == 0) THEN
531 10101603 : res = -1 ! edge case: default logger not yet/anymore available
532 : RETURN
533 : ELSE
534 9338644 : local_logger => cp_get_default_logger()
535 9338644 : IF (local_logger%ref_count < 1) THEN
536 : ! edge case: the default logger is just being released (e.g. a warning issued during
537 : ! cp_rm_default_logger). Do not abort, because the error handlers call this function
538 : ! themselves, which would result in an infinite recursion.
539 10101603 : res = -1
540 : RETURN
541 : END IF
542 : END IF
543 :
544 10101479 : res = cp_logger_get_default_unit_nr(local_logger, local=.FALSE., skip_not_ionode=.TRUE.)
545 10101479 : END FUNCTION cp_logger_get_default_io_unit
546 :
547 : ! *************************** cp_logger_type settings ***************************
548 :
549 : ! **************************************************************************************************
550 : !> \brief changes the logging level. Log messages with a level less than the one
551 : !> given wo not be printed.
552 : !> \param logger the logger to change
553 : !> \param level the new logging level for the logger
554 : !> \par History
555 : !> 4.2002 revised [fawzi]
556 : !> \author Fawzi Mohamed
557 : ! **************************************************************************************************
558 0 : SUBROUTINE cp_logger_set_log_level(logger, level)
559 : TYPE(cp_logger_type), INTENT(INOUT) :: logger
560 : INTEGER, INTENT(in) :: level
561 :
562 : CHARACTER(len=*), PARAMETER :: routineN = 'cp_logger_set_log_level', &
563 : routineP = moduleN//':'//routineN
564 :
565 0 : IF (logger%ref_count < 1) THEN
566 0 : CPABORT(routineP//" logger%ref_count<1")
567 : END IF
568 0 : logger%print_level = level
569 0 : END SUBROUTINE cp_logger_set_log_level
570 :
571 : ! **************************************************************************************************
572 : !> \brief asks the default unit number of the given logger.
573 : !> try to use cp_logger_get_unit_nr
574 : !> \param logger the logger you want info from
575 : !> \param local if you want the local unit nr (defaults to false)
576 : !> \param skip_not_ionode ...
577 : !> \return ...
578 : !> \par History
579 : !> 4.2002 revised [fawzi]
580 : !> \author Fawzi Mohamed
581 : ! **************************************************************************************************
582 10565892 : RECURSIVE FUNCTION cp_logger_get_default_unit_nr(logger, local, skip_not_ionode) RESULT(res)
583 : TYPE(cp_logger_type), OPTIONAL, POINTER :: logger
584 : LOGICAL, INTENT(in), OPTIONAL :: local, skip_not_ionode
585 : INTEGER :: res
586 :
587 : CHARACTER(len=*), PARAMETER :: routineN = 'cp_logger_get_default_unit_nr', &
588 : routineP = moduleN//':'//routineN
589 :
590 : CHARACTER(len=default_path_length) :: filename, host_name
591 : INTEGER :: iostat, pid
592 : LOGICAL :: loc, skip
593 : TYPE(cp_logger_type), POINTER :: lggr
594 :
595 10565892 : loc = .TRUE.
596 10565892 : skip = .FALSE.
597 10565892 : IF (PRESENT(logger)) THEN
598 10560972 : lggr => logger
599 : ELSE
600 4920 : NULLIFY (lggr)
601 : END IF
602 10565892 : IF (.NOT. ASSOCIATED(lggr)) lggr => cp_get_default_logger()
603 10565892 : IF (lggr%ref_count < 1) THEN
604 0 : CPABORT(routineP//" logger%ref_count<1")
605 : END IF
606 :
607 10565892 : IF (PRESENT(local)) loc = local
608 10565892 : IF (PRESENT(skip_not_ionode)) skip = skip_not_ionode
609 10565892 : IF (.NOT. loc) THEN
610 10503403 : IF (lggr%default_global_unit_nr <= 0) THEN
611 4303844 : IF (lggr%para_env%is_source()) THEN
612 : CALL cp_logger_generate_filename(lggr, filename, lggr%global_filename, &
613 0 : ".out", local=.FALSE.)
614 : CALL open_file(TRIM(filename), file_status="unknown", &
615 : file_action="WRITE", file_position="APPEND", &
616 0 : unit_number=lggr%default_global_unit_nr)
617 4303844 : ELSE IF (.NOT. skip) THEN
618 2 : lggr%default_global_unit_nr = cp_logger_get_default_unit_nr(lggr, .TRUE.)
619 2 : lggr%close_global_unit_on_dealloc = .FALSE.
620 : ELSE
621 4303842 : lggr%default_global_unit_nr = -1
622 4303842 : lggr%close_global_unit_on_dealloc = .FALSE.
623 : END IF
624 : END IF
625 10503403 : IF (.NOT. (lggr%para_env%is_source() .OR. skip)) THEN
626 : WRITE (UNIT=lggr%default_global_unit_nr, FMT='(/,T2,A)', IOSTAT=iostat) &
627 2 : ' *** WARNING non ionode asked for global logger ***'
628 2 : IF (iostat /= 0) THEN
629 0 : CALL m_getpid(pid)
630 0 : CALL m_hostnm(host_name)
631 0 : PRINT *, " *** Error trying to WRITE to the local logger ***"
632 0 : PRINT *, " *** MPI_id = ", lggr%para_env%mepos
633 0 : PRINT *, " *** MPI_Communicator = ", lggr%para_env%get_handle()
634 0 : PRINT *, " *** PID = ", pid
635 0 : PRINT *, " *** Hostname = "//TRIM(host_name)
636 0 : CALL print_stack(default_output_unit)
637 : ELSE
638 2 : CALL print_stack(lggr%default_global_unit_nr)
639 : END IF
640 : END IF
641 10503403 : res = lggr%default_global_unit_nr
642 : ELSE
643 62489 : IF (lggr%default_local_unit_nr <= 0) THEN
644 : CALL cp_logger_generate_filename(lggr, filename, lggr%local_filename, &
645 605 : ".out", local=.TRUE.)
646 : CALL open_file(TRIM(filename), file_status="unknown", &
647 : file_action="WRITE", &
648 : file_position="APPEND", &
649 605 : unit_number=lggr%default_local_unit_nr)
650 : WRITE (UNIT=lggr%default_local_unit_nr, FMT='(/,T2,A,I0,A,I0,A)', IOSTAT=iostat) &
651 605 : '*** Local logger file of MPI task ', lggr%para_env%mepos, &
652 1210 : ' in communicator ', lggr%para_env%get_handle(), ' ***'
653 605 : IF (iostat == 0) THEN
654 605 : CALL m_getpid(pid)
655 605 : CALL m_hostnm(host_name)
656 : WRITE (UNIT=lggr%default_local_unit_nr, FMT='(T2,A,I0)', IOSTAT=iostat) &
657 605 : '*** PID = ', pid, &
658 1210 : '*** Hostname = '//host_name
659 605 : CALL print_stack(lggr%default_local_unit_nr)
660 : END IF
661 605 : IF (iostat /= 0) THEN
662 0 : CALL m_getpid(pid)
663 0 : CALL m_hostnm(host_name)
664 0 : PRINT *, " *** Error trying to WRITE to the local logger ***"
665 0 : PRINT *, " *** MPI_id = ", lggr%para_env%mepos
666 0 : PRINT *, " *** MPI_Communicator = ", lggr%para_env%get_handle()
667 0 : PRINT *, " *** PID = ", pid
668 0 : PRINT *, " *** Hostname = "//TRIM(host_name)
669 0 : CALL print_stack(default_output_unit)
670 : END IF
671 :
672 : END IF
673 62489 : res = lggr%default_local_unit_nr
674 : END IF
675 10565892 : END FUNCTION cp_logger_get_default_unit_nr
676 :
677 : ! **************************************************************************************************
678 : !> \brief generates a unique filename (ie adding eventual suffixes and
679 : !> process ids)
680 : !> \param logger ...
681 : !> \param res the resulting string
682 : !> \param root the start of filename
683 : !> \param postfix the end of the name
684 : !> \param local if the name should be local to this task (defaults to false)
685 : !> \par History
686 : !> 08.2002 created [fawzi]
687 : !> \author Fawzi Mohamed
688 : !> \note
689 : !> this should be a function returning a variable length string.
690 : !> All spaces are moved to the end of the string.
691 : !> Not fully optimized: result must be a little longer than the
692 : !> resulting compressed filename
693 : ! **************************************************************************************************
694 105970 : SUBROUTINE cp_logger_generate_filename(logger, res, root, postfix, &
695 : local)
696 : TYPE(cp_logger_type), POINTER :: logger
697 : CHARACTER(len=*), INTENT(inout) :: res
698 : CHARACTER(len=*), INTENT(in) :: root, postfix
699 : LOGICAL, INTENT(in), OPTIONAL :: local
700 :
701 : CHARACTER(len=*), PARAMETER :: routineN = 'cp_logger_generate_filename', &
702 : routineP = moduleN//':'//routineN
703 :
704 : LOGICAL :: loc
705 : TYPE(cp_logger_type), POINTER :: lggr
706 :
707 105970 : loc = .FALSE.
708 105970 : res = ' '
709 105970 : lggr => logger
710 :
711 105970 : IF (.NOT. ASSOCIATED(lggr)) lggr => cp_get_default_logger()
712 105970 : IF (lggr%ref_count < 1) THEN
713 0 : CPABORT(routineP//" logger%ref_count<1")
714 : END IF
715 105970 : IF (PRESENT(local)) loc = local
716 105970 : IF (loc) THEN
717 : res = TRIM(root)//TRIM(lggr%suffix)//'_p'// &
718 826 : cp_to_string(lggr%para_env%mepos)//postfix
719 : ELSE
720 105144 : res = TRIM(root)//TRIM(lggr%suffix)//postfix
721 : END IF
722 105970 : CALL compress(res, full=.TRUE.)
723 105970 : END SUBROUTINE cp_logger_generate_filename
724 :
725 : ! **************************************************************************************************
726 : !> \brief sets various attributes of the given logger
727 : !> \param logger the logger you want to change
728 : !> \param local_filename the root of the name of the file used for local
729 : !> logging
730 : !> \param global_filename the root of the name of the file used for
731 : !> global logging
732 : !> \author Fawzi Mohamed
733 : ! **************************************************************************************************
734 12842 : SUBROUTINE cp_logger_set(logger, local_filename, global_filename)
735 : TYPE(cp_logger_type), INTENT(INOUT) :: logger
736 : CHARACTER(len=*), INTENT(in), OPTIONAL :: local_filename, global_filename
737 :
738 12838 : IF (PRESENT(local_filename)) logger%local_filename = local_filename
739 12842 : IF (PRESENT(global_filename)) logger%global_filename = global_filename
740 12842 : END SUBROUTINE cp_logger_set
741 :
742 : ! **************************************************************************************************
743 : !> \brief converts an int to a string
744 : !> (should be a variable length string, but that does not work with
745 : !> all the compilers)
746 : !> \param i the integer to convert
747 : !> \param fmt Optional format string
748 : !> \return ...
749 : !> \par History
750 : !> 4.2002 revised [fawzi]
751 : !> \author Fawzi Mohamed, MK
752 : ! **************************************************************************************************
753 8765334 : FUNCTION cp_int_to_string(i, fmt) RESULT(res)
754 : INTEGER, INTENT(in) :: i
755 : CHARACTER(len=*), OPTIONAL :: fmt
756 : CHARACTER(len=25) :: res
757 :
758 : CHARACTER(len=25) :: t_res
759 : INTEGER :: iostat
760 : REAL(KIND=dp) :: tmp_r
761 :
762 8765334 : iostat = 0
763 8765334 : IF (PRESENT(fmt)) THEN
764 1832 : WRITE (t_res, FMT=fmt, IOSTAT=iostat) i
765 8763502 : ELSE IF (i > 999999 .OR. i < -99999) THEN
766 1 : tmp_r = i
767 1 : WRITE (t_res, FMT='(ES8.1)', IOSTAT=iostat) tmp_r
768 : ELSE
769 8763501 : WRITE (t_res, FMT='(I6)', IOSTAT=iostat) i
770 : END IF
771 8765334 : res = t_res
772 8765334 : IF (iostat /= 0) THEN
773 0 : PRINT *, "cp_int_to_string I/O error", iostat
774 0 : CALL print_stack(cp_logger_get_default_unit_nr())
775 : END IF
776 :
777 8765334 : END FUNCTION cp_int_to_string
778 :
779 : ! **************************************************************************************************
780 : !> \brief Convert a double precision real in a string
781 : !> (should be a variable length string, but that does not work with
782 : !> all the compilers)
783 : !> \param val the number to convert
784 : !> \param fmt Optional format string
785 : !> \return ...
786 : !> \par History
787 : !> 4.2002 revised [fawzi]
788 : !> \author Fawzi Mohamed, MK
789 : ! **************************************************************************************************
790 103567 : FUNCTION cp_real_dp_to_string(val, fmt) RESULT(res)
791 : REAL(KIND=dp), INTENT(in) :: val
792 : CHARACTER(len=*), OPTIONAL :: fmt
793 : CHARACTER(len=25) :: res
794 :
795 : INTEGER :: iostat
796 :
797 103567 : IF (PRESENT(fmt)) THEN
798 1832 : WRITE (res, FMT=fmt, IOSTAT=iostat) val
799 : ELSE
800 101735 : WRITE (res, FMT='(ES11.4)', IOSTAT=iostat) val
801 : END IF
802 103567 : IF (iostat /= 0) THEN
803 0 : PRINT *, "cp_real_dp_to_string I/O error", iostat
804 0 : CALL print_stack(cp_logger_get_default_unit_nr())
805 : END IF
806 :
807 103567 : END FUNCTION cp_real_dp_to_string
808 :
809 : ! **************************************************************************************************
810 : !> \brief convert a logical in a string ('T' or 'F')
811 : !> \param val the number to convert
812 : !> \return ...
813 : !> \author fawzi
814 : ! **************************************************************************************************
815 0 : ELEMENTAL FUNCTION cp_logical_to_string(val) RESULT(res)
816 : LOGICAL, INTENT(in) :: val
817 : CHARACTER(len=1) :: res
818 :
819 0 : IF (val) THEN
820 0 : res = 'T'
821 : ELSE
822 0 : res = 'F'
823 : END IF
824 0 : END FUNCTION cp_logical_to_string
825 :
826 0 : END MODULE cp_log_handling
827 :
|
