Line data Source code
1 : !--------------------------------------------------------------------------------------------------!
2 : ! CP2K: A general program to perform molecular dynamics simulations !
3 : ! Copyright 2000-2024 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 26716 : FUNCTION cp_default_logger_stack_size() RESULT(res)
173 : INTEGER :: res
174 :
175 26716 : res = stack_pointer
176 26716 : 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 111100 : 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 111100 : 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 111100 : stack_pointer = stack_pointer + 1
199 111100 : NULLIFY (default_logger_stack(stack_pointer)%cp_default_logger)
200 :
201 111100 : default_logger_stack(stack_pointer)%cp_default_logger => logger
202 111100 : CALL cp_logger_retain(logger)
203 :
204 111100 : 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 111100 : SUBROUTINE cp_rm_default_logger()
213 111100 : 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 111100 : CALL cp_logger_release(default_logger_stack(stack_pointer)%cp_default_logger)
219 111100 : NULLIFY (default_logger_stack(stack_pointer)%cp_default_logger)
220 111100 : stack_pointer = stack_pointer - 1
221 :
222 111100 : 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 11704396 : FUNCTION cp_get_default_logger() RESULT(res)
234 : TYPE(cp_logger_type), POINTER :: res
235 :
236 11704396 : 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 11704396 : res => default_logger_stack(stack_pointer)%cp_default_logger
241 11704396 : 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 11704396 : 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 19345 : 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 : NULLIFY (logger%para_env)
302 : NULLIFY (logger%iter_info)
303 19345 : logger%ref_count = 1
304 :
305 19345 : IF (PRESENT(template_logger)) THEN
306 124 : IF (template_logger%ref_count < 1) &
307 0 : CPABORT(routineP//" template_logger%ref_count<1")
308 124 : logger%print_level = template_logger%print_level
309 124 : logger%default_global_unit_nr = template_logger%default_global_unit_nr
310 124 : logger%close_local_unit_on_dealloc = template_logger%close_local_unit_on_dealloc
311 124 : IF (logger%close_local_unit_on_dealloc) THEN
312 59 : logger%default_local_unit_nr = -1
313 : ELSE
314 65 : logger%default_local_unit_nr = template_logger%default_local_unit_nr
315 : END IF
316 124 : logger%close_global_unit_on_dealloc = template_logger%close_global_unit_on_dealloc
317 124 : IF (logger%close_global_unit_on_dealloc) THEN
318 0 : logger%default_global_unit_nr = -1
319 : ELSE
320 124 : logger%default_global_unit_nr = template_logger%default_global_unit_nr
321 : END IF
322 124 : logger%local_filename = template_logger%local_filename
323 124 : logger%global_filename = template_logger%global_filename
324 124 : logger%para_env => template_logger%para_env
325 124 : logger%suffix = template_logger%suffix
326 124 : logger%iter_info => template_logger%iter_info
327 : ELSE
328 : ! create a file if nothing is specified, one can also get the unit from the default logger
329 : ! which should have something reasonable as the argument is required in that case
330 : logger%default_global_unit_nr = -1
331 19221 : logger%close_global_unit_on_dealloc = .TRUE.
332 19221 : logger%local_filename = "localLog"
333 19221 : logger%global_filename = "mainLog"
334 19221 : logger%print_level = cp_note_level
335 : ! generate a file for default local logger
336 : ! except the ionode that should write to the default global logger
337 : logger%default_local_unit_nr = -1
338 19221 : logger%close_local_unit_on_dealloc = .TRUE.
339 19221 : logger%suffix = ""
340 : END IF
341 19345 : IF (PRESENT(para_env)) logger%para_env => para_env
342 19345 : IF (.NOT. ASSOCIATED(logger%para_env)) &
343 0 : CPABORT(routineP//" para env not associated")
344 19345 : IF (.NOT. logger%para_env%is_valid()) &
345 0 : CPABORT(routineP//" para_env%ref_count<1")
346 19345 : CALL logger%para_env%retain()
347 :
348 19345 : IF (PRESENT(print_level)) logger%print_level = print_level
349 :
350 19345 : IF (PRESENT(default_global_unit_nr)) &
351 19227 : logger%default_global_unit_nr = default_global_unit_nr
352 19345 : IF (PRESENT(global_filename)) THEN
353 0 : logger%global_filename = global_filename
354 0 : logger%close_global_unit_on_dealloc = .TRUE.
355 0 : logger%default_global_unit_nr = -1
356 : END IF
357 19345 : IF (PRESENT(close_global_unit_on_dealloc)) THEN
358 19227 : logger%close_global_unit_on_dealloc = close_global_unit_on_dealloc
359 19227 : IF (PRESENT(default_global_unit_nr) .AND. PRESENT(global_filename) .AND. &
360 : (.NOT. close_global_unit_on_dealloc)) THEN
361 0 : logger%default_global_unit_nr = default_global_unit_nr
362 : END IF
363 : END IF
364 :
365 19345 : IF (PRESENT(default_local_unit_nr)) &
366 0 : logger%default_local_unit_nr = default_local_unit_nr
367 19345 : IF (PRESENT(local_filename)) THEN
368 0 : logger%local_filename = local_filename
369 0 : logger%close_local_unit_on_dealloc = .TRUE.
370 0 : logger%default_local_unit_nr = -1
371 : END IF
372 19345 : IF (PRESENT(suffix)) logger%suffix = suffix
373 :
374 19345 : IF (PRESENT(close_local_unit_on_dealloc)) THEN
375 0 : logger%close_local_unit_on_dealloc = close_local_unit_on_dealloc
376 0 : IF (PRESENT(default_local_unit_nr) .AND. PRESENT(local_filename) .AND. &
377 : (.NOT. close_local_unit_on_dealloc)) THEN
378 0 : logger%default_local_unit_nr = default_local_unit_nr
379 : END IF
380 : END IF
381 :
382 19345 : IF (logger%default_local_unit_nr == -1) THEN
383 19280 : IF (logger%para_env%is_source()) THEN
384 10058 : logger%default_local_unit_nr = logger%default_global_unit_nr
385 10058 : logger%close_local_unit_on_dealloc = .FALSE.
386 : END IF
387 : END IF
388 19345 : IF (PRESENT(iter_info)) logger%iter_info => iter_info
389 19345 : IF (ASSOCIATED(logger%iter_info)) THEN
390 124 : CALL cp_iteration_info_retain(logger%iter_info)
391 : ELSE
392 19221 : CALL cp_iteration_info_create(logger%iter_info, "")
393 : END IF
394 19345 : END SUBROUTINE cp_logger_create
395 :
396 : ! **************************************************************************************************
397 : !> \brief retains the given logger (to be called to keep a shared copy of
398 : !> the logger)
399 : !> \param logger the logger to retain
400 : !> \par History
401 : !> 08.2002 created [fawzi]
402 : !> \author Fawzi Mohamed
403 : ! **************************************************************************************************
404 119569 : SUBROUTINE cp_logger_retain(logger)
405 : TYPE(cp_logger_type), INTENT(INOUT) :: logger
406 :
407 : CHARACTER(len=*), PARAMETER :: routineN = 'cp_logger_retain', &
408 : routineP = moduleN//':'//routineN
409 :
410 119569 : IF (logger%ref_count < 1) &
411 0 : CPABORT(routineP//" logger%ref_count<1")
412 119569 : logger%ref_count = logger%ref_count + 1
413 119569 : END SUBROUTINE cp_logger_retain
414 :
415 : ! **************************************************************************************************
416 : !> \brief releases this logger
417 : !> \param logger the logger to release
418 : !> \par History
419 : !> 4.2002 created [fawzi]
420 : !> \author Fawzi Mohamed
421 : ! **************************************************************************************************
422 138914 : SUBROUTINE cp_logger_release(logger)
423 : TYPE(cp_logger_type), POINTER :: logger
424 :
425 : CHARACTER(len=*), PARAMETER :: routineN = 'cp_logger_release', &
426 : routineP = moduleN//':'//routineN
427 :
428 138914 : IF (ASSOCIATED(logger)) THEN
429 138914 : IF (logger%ref_count < 1) &
430 0 : CPABORT(routineP//" logger%ref_count<1")
431 138914 : logger%ref_count = logger%ref_count - 1
432 138914 : IF (logger%ref_count == 0) THEN
433 19345 : IF (logger%close_global_unit_on_dealloc .AND. &
434 : logger%default_global_unit_nr >= 0) THEN
435 0 : CALL close_file(logger%default_global_unit_nr)
436 0 : logger%close_global_unit_on_dealloc = .FALSE.
437 0 : logger%default_global_unit_nr = -1
438 : END IF
439 19345 : IF (logger%close_local_unit_on_dealloc .AND. &
440 : logger%default_local_unit_nr >= 0) THEN
441 234 : CALL close_file(logger%default_local_unit_nr)
442 234 : logger%close_local_unit_on_dealloc = .FALSE.
443 234 : logger%default_local_unit_nr = -1
444 : END IF
445 19345 : CALL mp_para_env_release(logger%para_env)
446 19345 : CALL cp_iteration_info_release(logger%iter_info)
447 19345 : DEALLOCATE (logger)
448 : END IF
449 : END IF
450 138914 : NULLIFY (logger)
451 138914 : END SUBROUTINE cp_logger_release
452 :
453 : ! **************************************************************************************************
454 : !> \brief this function can be called to check if the logger would log
455 : !> a message with the given level from the given source
456 : !> you should use this function if you do direct logging
457 : !> (without using cp_logger_log), or if you want to know if the generation
458 : !> of some costly log info is necessary
459 : !> \param logger the logger you want to log in
460 : !> \param level describes the of the message: cp_fatal_level(3),
461 : !> cp_failure_level(2), cp_warning_level(1), cp_note_level(0).
462 : !> \return ...
463 : !> \par History
464 : !> 4.2002 revised [fawzi]
465 : !> \author Fawzi Mohamed
466 : ! **************************************************************************************************
467 4283 : FUNCTION cp_logger_would_log(logger, level) RESULT(res)
468 : TYPE(cp_logger_type), POINTER :: logger
469 : INTEGER, INTENT(in) :: level
470 : LOGICAL :: res
471 :
472 : CHARACTER(len=*), PARAMETER :: routineN = 'cp_logger_would_log', &
473 : routineP = moduleN//':'//routineN
474 :
475 : TYPE(cp_logger_type), POINTER :: lggr
476 :
477 4283 : lggr => logger
478 4283 : IF (.NOT. ASSOCIATED(lggr)) lggr => cp_get_default_logger()
479 4283 : IF (lggr%ref_count < 1) &
480 0 : CPABORT(routineP//" logger%ref_count<1")
481 :
482 4283 : res = level >= lggr%print_level
483 4283 : END FUNCTION cp_logger_would_log
484 :
485 : ! **************************************************************************************************
486 : !> \brief returns the unit nr for the requested kind of log.
487 : !> \param logger the logger you want to log in
488 : !> \param local if true returns a local logger (one per task), otherwise
489 : !> returns a global logger (only the process with para_env%mepos==
490 : !> para_env%source should write to the global logger). Defaults to
491 : !> false
492 : !> \return ...
493 : !> \par History
494 : !> 4.2002 revised [fawzi]
495 : !> \author Fawzi Mohamed
496 : ! **************************************************************************************************
497 212 : FUNCTION cp_logger_get_unit_nr(logger, local) RESULT(res)
498 : TYPE(cp_logger_type), POINTER :: logger
499 : LOGICAL, INTENT(in), OPTIONAL :: local
500 : INTEGER :: res
501 :
502 212 : res = cp_logger_get_default_unit_nr(logger, local=local)
503 212 : END FUNCTION cp_logger_get_unit_nr
504 :
505 : ! **************************************************************************************************
506 : !> \brief returns the unit nr for the ionode (-1 on all other processors)
507 : !> skips as well checks if the procs calling this function is not the ionode
508 : !> \param logger the logger you want to log in
509 : !> \return ...
510 : !> \par History
511 : !> 12.2009 created [tlaino]
512 : !> \author Teodoro Laino
513 : ! **************************************************************************************************
514 7383006 : FUNCTION cp_logger_get_default_io_unit(logger) RESULT(res)
515 : TYPE(cp_logger_type), OPTIONAL, POINTER :: logger
516 : INTEGER :: res
517 :
518 : TYPE(cp_logger_type), POINTER :: local_logger
519 :
520 7383006 : IF (PRESENT(logger)) THEN
521 473152 : local_logger => logger
522 6909854 : ELSE IF (stack_pointer == 0) THEN
523 7383006 : res = -1 ! edge case: default logger not yet/anymore available
524 : RETURN
525 : ELSE
526 6909854 : local_logger => cp_get_default_logger()
527 : END IF
528 :
529 7383006 : res = cp_logger_get_default_unit_nr(local_logger, local=.FALSE., skip_not_ionode=.TRUE.)
530 7383006 : END FUNCTION cp_logger_get_default_io_unit
531 :
532 : ! *************************** cp_logger_type settings ***************************
533 :
534 : ! **************************************************************************************************
535 : !> \brief changes the logging level. Log messages with a level less than the one
536 : !> given wo not be printed.
537 : !> \param logger the logger to change
538 : !> \param level the new logging level for the logger
539 : !> \par History
540 : !> 4.2002 revised [fawzi]
541 : !> \author Fawzi Mohamed
542 : ! **************************************************************************************************
543 0 : SUBROUTINE cp_logger_set_log_level(logger, level)
544 : TYPE(cp_logger_type), INTENT(INOUT) :: logger
545 : INTEGER, INTENT(in) :: level
546 :
547 : CHARACTER(len=*), PARAMETER :: routineN = 'cp_logger_set_log_level', &
548 : routineP = moduleN//':'//routineN
549 :
550 0 : IF (logger%ref_count < 1) &
551 0 : CPABORT(routineP//" logger%ref_count<1")
552 0 : logger%print_level = level
553 0 : END SUBROUTINE cp_logger_set_log_level
554 :
555 : ! **************************************************************************************************
556 : !> \brief asks the default unit number of the given logger.
557 : !> try to use cp_logger_get_unit_nr
558 : !> \param logger the logger you want info from
559 : !> \param local if you want the local unit nr (defaults to false)
560 : !> \param skip_not_ionode ...
561 : !> \return ...
562 : !> \par History
563 : !> 4.2002 revised [fawzi]
564 : !> \author Fawzi Mohamed
565 : ! **************************************************************************************************
566 7828300 : RECURSIVE FUNCTION cp_logger_get_default_unit_nr(logger, local, skip_not_ionode) RESULT(res)
567 : TYPE(cp_logger_type), OPTIONAL, POINTER :: logger
568 : LOGICAL, INTENT(in), OPTIONAL :: local, skip_not_ionode
569 : INTEGER :: res
570 :
571 : CHARACTER(len=*), PARAMETER :: routineN = 'cp_logger_get_default_unit_nr', &
572 : routineP = moduleN//':'//routineN
573 :
574 : CHARACTER(len=default_path_length) :: filename, host_name
575 : INTEGER :: iostat, pid
576 : LOGICAL :: loc, skip
577 : TYPE(cp_logger_type), POINTER :: lggr
578 :
579 7828300 : loc = .TRUE.
580 7828300 : skip = .FALSE.
581 7828300 : IF (PRESENT(logger)) THEN
582 7826904 : lggr => logger
583 : ELSE
584 1396 : NULLIFY (lggr)
585 : END IF
586 7828300 : IF (.NOT. ASSOCIATED(lggr)) lggr => cp_get_default_logger()
587 7828300 : IF (lggr%ref_count < 1) &
588 0 : CPABORT(routineP//" logger%ref_count<1")
589 :
590 7828300 : IF (PRESENT(local)) loc = local
591 7828300 : IF (PRESENT(skip_not_ionode)) skip = skip_not_ionode
592 7828300 : IF (.NOT. loc) THEN
593 7780615 : IF (lggr%default_global_unit_nr <= 0) THEN
594 2984325 : IF (lggr%para_env%is_source()) THEN
595 : CALL cp_logger_generate_filename(lggr, filename, lggr%global_filename, &
596 0 : ".out", local=.FALSE.)
597 : CALL open_file(TRIM(filename), file_status="unknown", &
598 : file_action="WRITE", file_position="APPEND", &
599 0 : unit_number=lggr%default_global_unit_nr)
600 2984325 : ELSE IF (.NOT. skip) THEN
601 0 : lggr%default_global_unit_nr = cp_logger_get_default_unit_nr(lggr, .TRUE.)
602 0 : lggr%close_global_unit_on_dealloc = .FALSE.
603 : ELSE
604 2984325 : lggr%default_global_unit_nr = -1
605 2984325 : lggr%close_global_unit_on_dealloc = .FALSE.
606 : END IF
607 : END IF
608 7780615 : IF (.NOT. (lggr%para_env%is_source() .OR. skip)) THEN
609 : WRITE (UNIT=lggr%default_global_unit_nr, FMT='(/,T2,A)', IOSTAT=iostat) &
610 0 : ' *** WARNING non ionode asked for global logger ***'
611 0 : IF (iostat /= 0) THEN
612 0 : CALL m_getpid(pid)
613 0 : CALL m_hostnm(host_name)
614 0 : PRINT *, " *** Error trying to WRITE to the local logger ***"
615 0 : PRINT *, " *** MPI_id = ", lggr%para_env%mepos
616 0 : PRINT *, " *** MPI_Communicator = ", lggr%para_env%get_handle()
617 0 : PRINT *, " *** PID = ", pid
618 0 : PRINT *, " *** Hostname = "//TRIM(host_name)
619 0 : CALL print_stack(default_output_unit)
620 : ELSE
621 0 : CALL print_stack(lggr%default_global_unit_nr)
622 : END IF
623 : END IF
624 7780615 : res = lggr%default_global_unit_nr
625 : ELSE
626 47685 : IF (lggr%default_local_unit_nr <= 0) THEN
627 : CALL cp_logger_generate_filename(lggr, filename, lggr%local_filename, &
628 234 : ".out", local=.TRUE.)
629 : CALL open_file(TRIM(filename), file_status="unknown", &
630 : file_action="WRITE", &
631 : file_position="APPEND", &
632 234 : 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 234 : '*** Local logger file of MPI task ', lggr%para_env%mepos, &
635 468 : ' in communicator ', lggr%para_env%get_handle(), ' ***'
636 234 : IF (iostat == 0) THEN
637 234 : CALL m_getpid(pid)
638 234 : CALL m_hostnm(host_name)
639 : WRITE (UNIT=lggr%default_local_unit_nr, FMT='(T2,A,I0)', IOSTAT=iostat) &
640 234 : '*** PID = ', pid, &
641 468 : '*** Hostname = '//host_name
642 234 : CALL print_stack(lggr%default_local_unit_nr)
643 : END IF
644 234 : IF (iostat /= 0) THEN
645 0 : CALL m_getpid(pid)
646 0 : CALL m_hostnm(host_name)
647 0 : PRINT *, " *** Error trying to WRITE to the local logger ***"
648 0 : PRINT *, " *** MPI_id = ", lggr%para_env%mepos
649 0 : PRINT *, " *** MPI_Communicator = ", lggr%para_env%get_handle()
650 0 : PRINT *, " *** PID = ", pid
651 0 : PRINT *, " *** Hostname = "//TRIM(host_name)
652 0 : CALL print_stack(default_output_unit)
653 : END IF
654 :
655 : END IF
656 47685 : res = lggr%default_local_unit_nr
657 : END IF
658 7828300 : END FUNCTION cp_logger_get_default_unit_nr
659 :
660 : ! **************************************************************************************************
661 : !> \brief generates a unique filename (ie adding eventual suffixes and
662 : !> process ids)
663 : !> \param logger ...
664 : !> \param res the resulting string
665 : !> \param root the start of filename
666 : !> \param postfix the end of the name
667 : !> \param local if the name should be local to this task (defaults to false)
668 : !> \par History
669 : !> 08.2002 created [fawzi]
670 : !> \author Fawzi Mohamed
671 : !> \note
672 : !> this should be a function returning a variable length string.
673 : !> All spaces are moved to the end of the string.
674 : !> Not fully optimized: result must be a little longer than the
675 : !> resulting compressed filename
676 : ! **************************************************************************************************
677 96065 : SUBROUTINE cp_logger_generate_filename(logger, res, root, postfix, &
678 : local)
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
683 :
684 : CHARACTER(len=*), PARAMETER :: routineN = 'cp_logger_generate_filename', &
685 : routineP = moduleN//':'//routineN
686 :
687 : LOGICAL :: loc
688 : TYPE(cp_logger_type), POINTER :: lggr
689 :
690 96065 : loc = .FALSE.
691 96065 : res = ' '
692 96065 : lggr => logger
693 :
694 96065 : IF (.NOT. ASSOCIATED(lggr)) lggr => cp_get_default_logger()
695 96065 : IF (lggr%ref_count < 1) &
696 0 : CPABORT(routineP//" logger%ref_count<1")
697 96065 : IF (PRESENT(local)) loc = local
698 96065 : IF (loc) THEN
699 : res = TRIM(root)//TRIM(lggr%suffix)//'_p'// &
700 429 : cp_to_string(lggr%para_env%mepos)//postfix
701 : ELSE
702 95636 : res = TRIM(root)//TRIM(lggr%suffix)//postfix
703 : END IF
704 96065 : CALL compress(res, full=.TRUE.)
705 96065 : END SUBROUTINE cp_logger_generate_filename
706 :
707 : ! **************************************************************************************************
708 : !> \brief sets various attributes of the given logger
709 : !> \param logger the logger you want to change
710 : !> \param local_filename the root of the name of the file used for local
711 : !> logging
712 : !> \param global_filename the root of the name of the file used for
713 : !> global logging
714 : !> \author Fawzi Mohamed
715 : ! **************************************************************************************************
716 10909 : SUBROUTINE cp_logger_set(logger, local_filename, global_filename)
717 : TYPE(cp_logger_type), INTENT(INOUT) :: logger
718 : CHARACTER(len=*), INTENT(in), OPTIONAL :: local_filename, global_filename
719 :
720 10909 : IF (PRESENT(local_filename)) logger%local_filename = local_filename
721 10909 : IF (PRESENT(global_filename)) logger%global_filename = global_filename
722 10909 : END SUBROUTINE cp_logger_set
723 :
724 : ! **************************************************************************************************
725 : !> \brief converts an int to a string
726 : !> (should be a variable length string, but that does not work with
727 : !> all the compilers)
728 : !> \param i the integer to convert
729 : !> \param fmt Optional format string
730 : !> \return ...
731 : !> \par History
732 : !> 4.2002 revised [fawzi]
733 : !> \author Fawzi Mohamed, MK
734 : ! **************************************************************************************************
735 7525253 : FUNCTION cp_int_to_string(i, fmt) RESULT(res)
736 : INTEGER, INTENT(in) :: i
737 : CHARACTER(len=*), OPTIONAL :: fmt
738 : CHARACTER(len=25) :: res
739 :
740 : CHARACTER(len=25) :: t_res
741 : INTEGER :: iostat
742 : REAL(KIND=dp) :: tmp_r
743 :
744 7525253 : iostat = 0
745 7525253 : IF (PRESENT(fmt)) THEN
746 1824 : WRITE (t_res, FMT=fmt, IOSTAT=iostat) i
747 7523429 : ELSE IF (i > 999999 .OR. i < -99999) THEN
748 1 : tmp_r = i
749 1 : WRITE (t_res, FMT='(ES8.1)', IOSTAT=iostat) tmp_r
750 : ELSE
751 7523428 : WRITE (t_res, FMT='(I6)', IOSTAT=iostat) i
752 : END IF
753 7525253 : res = t_res
754 7525253 : IF (iostat /= 0) THEN
755 0 : PRINT *, "cp_int_to_string I/O error", iostat
756 0 : CALL print_stack(cp_logger_get_default_unit_nr())
757 : END IF
758 :
759 7525253 : END FUNCTION cp_int_to_string
760 :
761 : ! **************************************************************************************************
762 : !> \brief Convert a double precision real in a string
763 : !> (should be a variable length string, but that does not work with
764 : !> all the compilers)
765 : !> \param val the number to convert
766 : !> \param fmt Optional format string
767 : !> \return ...
768 : !> \par History
769 : !> 4.2002 revised [fawzi]
770 : !> \author Fawzi Mohamed, MK
771 : ! **************************************************************************************************
772 103396 : 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
776 :
777 : INTEGER :: iostat
778 :
779 103396 : IF (PRESENT(fmt)) THEN
780 1824 : WRITE (res, FMT=fmt, IOSTAT=iostat) val
781 : ELSE
782 101572 : WRITE (res, FMT='(ES11.4)', IOSTAT=iostat) val
783 : END IF
784 103396 : IF (iostat /= 0) THEN
785 0 : PRINT *, "cp_real_dp_to_string I/O error", iostat
786 0 : CALL print_stack(cp_logger_get_default_unit_nr())
787 : END IF
788 :
789 103396 : END FUNCTION cp_real_dp_to_string
790 :
791 : ! **************************************************************************************************
792 : !> \brief convert a logical in a string ('T' or 'F')
793 : !> \param val the number to convert
794 : !> \return ...
795 : !> \author fawzi
796 : ! **************************************************************************************************
797 0 : ELEMENTAL FUNCTION cp_logical_to_string(val) RESULT(res)
798 : LOGICAL, INTENT(in) :: val
799 : CHARACTER(len=1) :: res
800 :
801 0 : IF (val) THEN
802 0 : res = 'T'
803 : ELSE
804 0 : res = 'F'
805 : END IF
806 0 : END FUNCTION cp_logical_to_string
807 :
808 0 : END MODULE cp_log_handling
809 :
|
