1!--------------------------------------------------------------------------------------------------! 2! Copyright (C) by the DBCSR developers group - All rights reserved ! 3! This file is part of the DBCSR library. ! 4! ! 5! For information on the license, see the LICENSE file. ! 6! For further information please visit https://dbcsr.cp2k.org ! 7! SPDX-License-Identifier: GPL-2.0+ ! 8!--------------------------------------------------------------------------------------------------! 9 10MODULE dbcsr_log_handling 11 !! various routines to log and control the output. 12 !! The idea is that decisions about where to log should not be done in 13 !! the code that generates the log, but should be globally changeable 14 !! a central place. 15 !! So some care has been taken to have enough information about the 16 !! place from where the log comes so that in the future intelligent and 17 !! flexible decisions can be taken by the logger, without having to change 18 !! other code. 19 !! @note 20 !! contains also routines to convert to a string. 21 !! in my idea they should have been with variable length, 22 !! (i.e. they should have returned a trim(adjustl(actual_result))) 23 !! As a logger should be robust, at the moment I have given up. 24 !! At the moment logging and output refer to the same object 25 !! (dbcsr_logger_type) 26 !! as these are actually different it might be better to separate them 27 !! (they have already separate routines in a separate module 28 !! @see dbcsr_output_handling). 29 !! some practices (use of print *, no dbcsr_error_type, 30 !! manual retain release of some objects) are dictated by the need to 31 !! have minimal dependency 32 !! @endnote 33 !! 34 !! @see dbcsr_error_handling 35 !! @version 12.2001 36 37 USE dbcsr_files, ONLY: close_file, & 38 open_file 39 USE dbcsr_iter_types, ONLY: dbcsr_iteration_info_create, & 40 dbcsr_iteration_info_release, & 41 dbcsr_iteration_info_retain, & 42 dbcsr_iteration_info_type 43 USE dbcsr_kinds, ONLY: default_path_length, & 44 default_string_length, & 45 dp 46 USE dbcsr_machine, ONLY: default_output_unit, & 47 m_getpid, & 48 m_hostnm 49 USE dbcsr_methods, ONLY: dbcsr_mp_release 50 USE dbcsr_string_utilities, ONLY: compress 51 USE dbcsr_timings, ONLY: print_stack 52 USE dbcsr_types, ONLY: dbcsr_mp_obj 53#include "base/dbcsr_base_uses.f90" 54 55 IMPLICIT NONE 56 PRIVATE 57 58 !API types 59 PUBLIC :: dbcsr_logger_type, dbcsr_logger_p_type 60 !API parameter vars 61 PUBLIC :: dbcsr_note_level, dbcsr_warning_level, dbcsr_failure_level, dbcsr_fatal_level 62 !API default loggers 63 PUBLIC :: dbcsr_get_default_logger, dbcsr_add_default_logger, dbcsr_rm_default_logger, & 64 dbcsr_default_logger_stack_size 65 !API logger routines 66 PUBLIC :: dbcsr_logger_create, dbcsr_logger_retain, dbcsr_logger_release, & 67 dbcsr_logger_would_log, dbcsr_logger_set, dbcsr_logger_get_default_unit_nr, & 68 dbcsr_logger_get_default_io_unit, dbcsr_logger_get_unit_nr, & 69 dbcsr_logger_set_log_level, dbcsr_logger_generate_filename, & 70 dbcsr_to_string 71 72 CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'dbcsr_log_handling' 73 LOGICAL, PRIVATE, PARAMETER :: debug_this_module = .FALSE. 74 75 !! level of an error 76 INTEGER, PARAMETER :: dbcsr_fatal_level = 3 77 !! level of a failure 78 INTEGER, PARAMETER :: dbcsr_failure_level = 2 79 !! level of a warning 80 INTEGER, PARAMETER :: dbcsr_warning_level = 1 81 !! level of a note 82 INTEGER, PARAMETER :: dbcsr_note_level = 0 83 84 !! a generic function to trasform different types to strings 85 INTERFACE dbcsr_to_string 86 MODULE PROCEDURE dbcsr_int_to_string, dbcsr_real_dp_to_string, dbcsr_logical_to_string 87 END INTERFACE 88 89 TYPE dbcsr_logger_type 90 !! type of a logger, at the moment it contains just a print level 91 !! starting at which level it should be logged 92 !! (0 note, 1 warning, 2 failure, 3 fatal) 93 !! it could be expanded with the ability to focus on one or more 94 !! module/object/thread/processor 95 !! @note 96 !! This should be private, but as the output functions have been 97 !! moved to another module and there is no "friend" keyword, they 98 !! are public. 99 !! DO NOT USE THE INTERNAL COMPONENTS DIRECTLY!!! 100 101 INTEGER :: id_nr, ref_count 102 !! unique number to identify the logger 103 !! reference count (see cp2k/doc/ReferenceCounting.html) 104 INTEGER :: print_level 105 !! the level starting at which something gets printed 106 INTEGER :: default_local_unit_nr 107 !! default unit for local logging (-1 if not yet initialized). Local logging guarantee to each task its own file. 108 INTEGER :: default_global_unit_nr 109 !! default unit for global logging (-1 if not yet initialized). This unit is valid only on the processor with 110 !! %mp_env%mp%mynode==%mv_env%mp%source. 111 LOGICAL :: close_local_unit_on_dealloc, close_global_unit_on_dealloc 112 !! if the local unit should be closed when this logger is deallocated 113 !! whether the global unit should be closed when this logger is deallocated 114 CHARACTER(len=default_string_length) :: suffix 115 !! a short string that is used as suffix in all the filenames created by this logger. Can be used to guarantee the 116 !! uniqueness of generated filename 117 CHARACTER(len=default_path_length) :: local_filename, global_filename 118 !! the root of the name of the file used for local logging (can be different from the name of the file corresponding to 119 !! default_local_unit_nr, only the one used if the unit needs to be opened) 120 !! the root of the name of the file used for global logging (can be different from the name of the file corresponding to 121 !! default_global_unit_nr, only the one used if the unit needs to be opened) 122 TYPE(dbcsr_mp_obj) :: mp_env 123 !! the parallel environment for the output. 124 TYPE(dbcsr_iteration_info_type), POINTER :: iter_info 125 END TYPE dbcsr_logger_type 126 127 TYPE dbcsr_logger_p_type 128 TYPE(dbcsr_logger_type), POINTER :: p => Null() 129 END TYPE dbcsr_logger_p_type 130 131! ************************************************************************************************** 132 TYPE default_logger_stack_type 133 TYPE(dbcsr_logger_type), POINTER :: dbcsr_default_logger => Null() 134 END TYPE default_logger_stack_type 135 136 INTEGER, PRIVATE :: stack_pointer = 0 137 INTEGER, PARAMETER, PRIVATE :: max_stack_pointer = 10 138 TYPE(default_logger_stack_type), SAVE, DIMENSION(max_stack_pointer) :: default_logger_stack 139 140 INTEGER, SAVE, PRIVATE :: last_logger_id_nr = 0 141 142CONTAINS 143 144 FUNCTION dbcsr_default_logger_stack_size() RESULT(res) 145 INTEGER :: res 146 147 CHARACTER(len=*), PARAMETER :: routineN = 'dbcsr_default_logger_stack_size', & 148 routineP = moduleN//':'//routineN 149 150 res = stack_pointer 151 END FUNCTION dbcsr_default_logger_stack_size 152 153 SUBROUTINE dbcsr_add_default_logger(logger) 154 !! adds a default logger. 155 !! MUST be called before logging occurs 156 !! @note 157 !! increments a stack of default loggers the latest one will be 158 !! available within the program 159 160 TYPE(dbcsr_logger_type), POINTER :: logger 161 162 CHARACTER(len=*), PARAMETER :: routineN = 'dbcsr_add_default_logger', & 163 routineP = moduleN//':'//routineN 164 165 IF (stack_pointer + 1 > max_stack_pointer) THEN 166 CALL dbcsr_abort(__LOCATION__, routineP// & 167 "too many default loggers, increase max_stack_pointer in "//moduleN) 168 ENDIF 169 170 stack_pointer = stack_pointer + 1 171 NULLIFY (default_logger_stack(stack_pointer)%dbcsr_default_logger) 172 173 default_logger_stack(stack_pointer)%dbcsr_default_logger => logger 174 CALL dbcsr_logger_retain(logger) 175 176 END SUBROUTINE dbcsr_add_default_logger 177 178 SUBROUTINE dbcsr_rm_default_logger() 179 !! the cousin of dbcsr_add_default_logger, decrements the stack, so that 180 !! the default logger is what it has 181 !! been 182 183 IF (stack_pointer - 1 < 0) THEN 184 CALL dbcsr_abort(__LOCATION__, moduleN//":dbcsr_rm_default_logger"// & 185 "can not destroy default logger "//moduleN) 186 ENDIF 187 188 CALL dbcsr_logger_release(default_logger_stack(stack_pointer)%dbcsr_default_logger) 189 NULLIFY (default_logger_stack(stack_pointer)%dbcsr_default_logger) 190 stack_pointer = stack_pointer - 1 191 192 END SUBROUTINE dbcsr_rm_default_logger 193 194 FUNCTION dbcsr_get_default_logger() RESULT(res) 195 !! returns the default logger 196 !! @note 197 !! initializes the default loggers if necessary 198 199 TYPE(dbcsr_logger_type), POINTER :: res 200 201 IF (.NOT. stack_pointer > 0) THEN 202 CALL dbcsr_abort(__LOCATION__, "dbcsr_log_handling:dbcsr_get_default_logger"// & 203 "default logger not yet initialized (CALL dbcsr_init_default_logger)") 204 END IF 205 res => default_logger_stack(stack_pointer)%dbcsr_default_logger 206 IF (.NOT. ASSOCIATED(res)) THEN 207 CALL dbcsr_abort(__LOCATION__, "dbcsr_log_handling:dbcsr_get_default_logger"// & 208 "default logger is null (released too much ?)") 209 END IF 210 END FUNCTION dbcsr_get_default_logger 211 212! ================== log ================== 213 214 SUBROUTINE dbcsr_logger_create(logger, mp_env, print_level, & 215 default_global_unit_nr, default_local_unit_nr, global_filename, & 216 local_filename, close_global_unit_on_dealloc, iter_info, & 217 close_local_unit_on_dealloc, suffix, template_logger) 218 !! initializes a logger 219 !! @note 220 !! the handling of *_filename, default_*_unit_nr, close_*_unit_on_dealloc 221 !! tries to take the right decision with different inputs, and thus is a 222 !! little complex. 223 224 TYPE(dbcsr_logger_type), POINTER :: logger 225 !! the logger to initialize 226 TYPE(dbcsr_mp_obj), OPTIONAL :: mp_env 227 !! the parallel environment (this is most likely the global parallel environment 228 INTEGER, INTENT(in), OPTIONAL :: print_level, default_global_unit_nr, & 229 default_local_unit_nr 230 !! the level starting with which something is written (defaults to dbcsr_note_level) 231 !! the default unit_nr for output (if not given, and no file is given defaults to the standard output) 232 !! the default unit number for local (i.e. task) output. If not given defaults to a out.taskid file created upon 233 CHARACTER(len=*), INTENT(in), OPTIONAL :: global_filename, local_filename 234 !! a new file to open (can be given instead of the global_unit_nr) 235 !! a new file to open (with suffix and mp_env%mp%mynode appended). Can be given instead of the default_local_unit_nr). the 236 !! file is created only upon the first local logging request 237 LOGICAL, INTENT(in), OPTIONAL :: close_global_unit_on_dealloc 238 !! if the unit should be closed when the logger is deallocated (defaults to true if a local_filename is given, to false 239 !! otherwise) 240 TYPE(dbcsr_iteration_info_type), OPTIONAL, POINTER :: iter_info 241 LOGICAL, INTENT(in), OPTIONAL :: close_local_unit_on_dealloc 242 !! if the unit should be closed when the logger is deallocated (defaults to true) 243 CHARACTER(len=*), INTENT(in), OPTIONAL :: suffix 244 !! the suffix that should be added to all the generated filenames 245 TYPE(dbcsr_logger_type), OPTIONAL, POINTER :: template_logger 246 !! a logger from where to take the unspecified things 247 248 CHARACTER(len=*), PARAMETER :: routineN = 'dbcsr_logger_create', & 249 routineP = moduleN//':'//routineN 250 251 INTEGER :: stat 252 253 ALLOCATE (logger, stat=stat) 254 IF (stat /= 0) & 255 DBCSR_ABORT(routineP//" could not ALLOCATE a logger") 256 257 NULLIFY (logger%iter_info) 258 logger%ref_count = 1 259 last_logger_id_nr = last_logger_id_nr + 1 260 logger%id_nr = last_logger_id_nr 261 262 IF (PRESENT(template_logger)) THEN 263 IF (template_logger%ref_count < 1) & 264 DBCSR_ABORT(routineP//" template_logger%ref_count<1") 265 logger%print_level = template_logger%print_level 266 logger%default_global_unit_nr = template_logger%default_global_unit_nr 267 logger%close_local_unit_on_dealloc = template_logger%close_local_unit_on_dealloc 268 IF (logger%close_local_unit_on_dealloc) THEN 269 logger%default_local_unit_nr = -1 270 ELSE 271 logger%default_local_unit_nr = template_logger%default_local_unit_nr 272 END IF 273 logger%close_global_unit_on_dealloc = template_logger%close_global_unit_on_dealloc 274 IF (logger%close_global_unit_on_dealloc) THEN 275 logger%default_global_unit_nr = -1 276 ELSE 277 logger%default_global_unit_nr = template_logger%default_global_unit_nr 278 END IF 279 logger%local_filename = template_logger%local_filename 280 logger%global_filename = template_logger%global_filename 281 logger%mp_env = template_logger%mp_env 282 logger%suffix = template_logger%suffix 283 logger%iter_info => template_logger%iter_info 284 ELSE 285 ! create a file if nothing is specified, one can also get the unit from the default logger 286 ! which should have something reasonable as the argument is required in that case 287 logger%default_global_unit_nr = -1 288 logger%close_global_unit_on_dealloc = .TRUE. 289 logger%local_filename = "localLog" 290 logger%global_filename = "mainLog" 291 logger%print_level = dbcsr_note_level 292 ! generate a file for default local logger 293 ! except the ionode that should write to the default global logger 294 logger%default_local_unit_nr = -1 295 logger%close_local_unit_on_dealloc = .TRUE. 296 logger%suffix = "" 297 END IF 298 IF (PRESENT(mp_env)) logger%mp_env = mp_env 299 IF (.NOT. ASSOCIATED(logger%mp_env%mp)) & 300 DBCSR_ABORT(routineP//" mp env not associated") 301 302 IF (logger%mp_env%mp%refcount < 1) & 303 DBCSR_ABORT(routineP//" mp_env%ref_count<1") 304 logger%mp_env%mp%refcount = logger%mp_env%mp%refcount + 1 305 306 IF (PRESENT(print_level)) logger%print_level = print_level 307 308 IF (PRESENT(default_global_unit_nr)) & 309 logger%default_global_unit_nr = default_global_unit_nr 310 IF (PRESENT(global_filename)) THEN 311 logger%global_filename = global_filename 312 logger%close_global_unit_on_dealloc = .TRUE. 313 logger%default_global_unit_nr = -1 314 END IF 315 IF (PRESENT(close_global_unit_on_dealloc)) THEN 316 logger%close_global_unit_on_dealloc = close_global_unit_on_dealloc 317 IF (PRESENT(default_global_unit_nr) .AND. PRESENT(global_filename) .AND. & 318 (.NOT. close_global_unit_on_dealloc)) THEN 319 logger%default_global_unit_nr = default_global_unit_nr 320 END IF 321 END IF 322 323 IF (PRESENT(default_local_unit_nr)) & 324 logger%default_local_unit_nr = default_local_unit_nr 325 IF (PRESENT(local_filename)) THEN 326 logger%local_filename = local_filename 327 logger%close_local_unit_on_dealloc = .TRUE. 328 logger%default_local_unit_nr = -1 329 END IF 330 IF (PRESENT(suffix)) logger%suffix = suffix 331 332 IF (PRESENT(close_local_unit_on_dealloc)) THEN 333 logger%close_local_unit_on_dealloc = close_local_unit_on_dealloc 334 IF (PRESENT(default_local_unit_nr) .AND. PRESENT(local_filename) .AND. & 335 (.NOT. close_local_unit_on_dealloc)) THEN 336 logger%default_local_unit_nr = default_local_unit_nr 337 END IF 338 END IF 339 340 IF (logger%default_local_unit_nr == -1) THEN 341 IF (logger%mp_env%mp%mynode == logger%mp_env%mp%source) THEN 342 logger%default_local_unit_nr = logger%default_global_unit_nr 343 logger%close_local_unit_on_dealloc = .FALSE. 344 ENDIF 345 ENDIF 346 IF (PRESENT(iter_info)) logger%iter_info => iter_info 347 IF (ASSOCIATED(logger%iter_info)) THEN 348 CALL dbcsr_iteration_info_retain(logger%iter_info) 349 ELSE 350 CALL dbcsr_iteration_info_create(logger%iter_info, "") 351 END IF 352 END SUBROUTINE dbcsr_logger_create 353 354 SUBROUTINE dbcsr_logger_retain(logger) 355 !! retains the given logger (to be called to keep a shared copy of 356 !! the logger) 357 358 TYPE(dbcsr_logger_type), POINTER :: logger 359 !! the logger to retain 360 361 CHARACTER(len=*), PARAMETER :: routineN = 'dbcsr_logger_retain', & 362 routineP = moduleN//':'//routineN 363 364 IF (.NOT. ASSOCIATED(logger)) & 365 DBCSR_ABORT(routineP//" logger not associated") 366 IF (logger%ref_count < 1) & 367 DBCSR_ABORT(routineP//" logger%ref_count<1") 368 logger%ref_count = logger%ref_count + 1 369 END SUBROUTINE dbcsr_logger_retain 370 371 SUBROUTINE dbcsr_logger_release(logger) 372 !! releases this logger 373 374 TYPE(dbcsr_logger_type), POINTER :: logger 375 !! the logger to release 376 377 CHARACTER(len=*), PARAMETER :: routineN = 'dbcsr_logger_release', & 378 routineP = moduleN//':'//routineN 379 380 IF (ASSOCIATED(logger)) THEN 381 IF (logger%ref_count < 1) & 382 DBCSR_ABORT(routineP//" logger%ref_count<1") 383 logger%ref_count = logger%ref_count - 1 384 IF (logger%ref_count == 0) THEN 385 IF (logger%close_global_unit_on_dealloc .AND. & 386 logger%default_global_unit_nr >= 0) THEN 387 CALL close_file(logger%default_global_unit_nr) 388 logger%close_global_unit_on_dealloc = .FALSE. 389 logger%default_global_unit_nr = -1 390 END IF 391 IF (logger%close_local_unit_on_dealloc .AND. & 392 logger%default_local_unit_nr >= 0) THEN 393 CALL close_file(logger%default_local_unit_nr) 394 logger%close_local_unit_on_dealloc = .FALSE. 395 logger%default_local_unit_nr = -1 396 END IF 397 CALL dbcsr_mp_release(logger%mp_env) 398 CALL dbcsr_iteration_info_release(logger%iter_info) 399 DEALLOCATE (logger) 400 END IF 401 END IF 402 END SUBROUTINE dbcsr_logger_release 403 404 FUNCTION dbcsr_logger_would_log(logger, level) RESULT(res) 405 !! this function can be called to check if the logger would log 406 !! a message with the given level from the given source 407 !! you should use this function if you do direct logging 408 !! (without using dbcsr_logger_log), or if you want to know if the generation 409 !! of some costly log info is necessary 410 411 TYPE(dbcsr_logger_type), POINTER :: logger 412 !! the logger you want to log in 413 INTEGER, INTENT(in) :: level 414 !! describes the of the message: dbcsr_fatal_level(3), dbcsr_failure_level(2), dbcsr_warning_level(1), dbcsr_note_level(0). 415 LOGICAL :: res 416 417 CHARACTER(len=*), PARAMETER :: routineN = 'dbcsr_logger_would_log', & 418 routineP = moduleN//':'//routineN 419 420 TYPE(dbcsr_logger_type), POINTER :: lggr 421 422 lggr => logger 423 IF (.NOT. ASSOCIATED(lggr)) lggr => dbcsr_get_default_logger() 424 IF (lggr%ref_count < 1) & 425 DBCSR_ABORT(routineP//" logger%ref_count<1") 426 427 res = level >= lggr%print_level 428 END FUNCTION dbcsr_logger_would_log 429 430 FUNCTION dbcsr_logger_get_unit_nr(logger, local) RESULT(res) 431 !! returns the unit nr for the requested kind of log. 432 433 TYPE(dbcsr_logger_type), POINTER :: logger 434 !! the logger you want to log in 435 LOGICAL, INTENT(in), OPTIONAL :: local 436 !! if true returns a local logger (one per task), otherwise returns a global logger (only the process with 437 !! mp_env%mp%mynode== mp_env%mp%source should write to the global logger). Defaults to false 438 INTEGER :: res 439 440 res = dbcsr_logger_get_default_unit_nr(logger, local=local) 441 END FUNCTION dbcsr_logger_get_unit_nr 442 443 FUNCTION dbcsr_logger_get_default_io_unit(logger) RESULT(res) 444 !! returns the unit nr for the ionode (-1 on all other processors) 445 !! skips as well checks if the procs calling this function is not the ionode 446 447 TYPE(dbcsr_logger_type), OPTIONAL, POINTER :: logger 448 !! the logger you want to log in 449 INTEGER :: res 450 451 TYPE(dbcsr_logger_type), POINTER :: local_logger 452 453 IF (PRESENT(logger)) THEN 454 local_logger => logger 455 ELSE IF (stack_pointer == 0) THEN 456 res = -1 ! edge case: default logger not yet/anymore available 457 RETURN 458 ELSE 459 local_logger => dbcsr_get_default_logger() 460 ENDIF 461 462 res = dbcsr_logger_get_default_unit_nr(local_logger, local=.FALSE., skip_not_ionode=.TRUE.) 463 END FUNCTION dbcsr_logger_get_default_io_unit 464 465! *************************** dbcsr_logger_type settings *************************** 466 467 SUBROUTINE dbcsr_logger_set_log_level(logger, level) 468 !! changes the logging level. Log messages with a level less than the one 469 !! given wo not be printed. 470 471 TYPE(dbcsr_logger_type), POINTER :: logger 472 !! the logger to change 473 INTEGER, INTENT(in) :: level 474 !! the new logging level for the logger 475 476 CHARACTER(len=*), PARAMETER :: routineN = 'dbcsr_logger_set_log_level', & 477 routineP = moduleN//':'//routineN 478 479 IF (.NOT. ASSOCIATED(logger)) & 480 DBCSR_ABORT(routineP//" logger not associated") 481 IF (logger%ref_count < 1) & 482 DBCSR_ABORT(routineP//" logger%ref_count<1") 483 logger%print_level = level 484 END SUBROUTINE dbcsr_logger_set_log_level 485 486 RECURSIVE FUNCTION dbcsr_logger_get_default_unit_nr(logger, local, skip_not_ionode) RESULT(res) 487 !! asks the default unit number of the given logger. 488 !! try to use dbcsr_logger_get_unit_nr 489 490 TYPE(dbcsr_logger_type), OPTIONAL, POINTER :: logger 491 !! the logger you want info from 492 LOGICAL, INTENT(in), OPTIONAL :: local, skip_not_ionode 493 !! if you want the local unit nr (defaults to false) 494 INTEGER :: res 495 496 CHARACTER(len=*), PARAMETER :: routineN = 'dbcsr_logger_get_default_unit_nr', & 497 routineP = moduleN//':'//routineN 498 499 CHARACTER(len=default_path_length) :: filename, host_name 500 INTEGER :: iostat, pid 501 LOGICAL :: loc, skip 502 TYPE(dbcsr_logger_type), POINTER :: lggr 503 504 loc = .TRUE. 505 skip = .FALSE. 506 IF (PRESENT(logger)) THEN 507 lggr => logger 508 ELSE 509 NULLIFY (lggr) 510 ENDIF 511 IF (.NOT. ASSOCIATED(lggr)) lggr => dbcsr_get_default_logger() 512 IF (lggr%ref_count < 1) & 513 DBCSR_ABORT(routineP//" logger%ref_count<1") 514 515 IF (PRESENT(local)) loc = local 516 IF (PRESENT(skip_not_ionode)) skip = skip_not_ionode 517 IF (.NOT. loc) THEN 518 IF (lggr%default_global_unit_nr <= 0) THEN 519 IF (lggr%mp_env%mp%mynode == lggr%mp_env%mp%source) THEN 520 CALL dbcsr_logger_generate_filename(lggr, filename, lggr%global_filename, & 521 ".out", local=.FALSE.) 522 CALL open_file(TRIM(filename), file_status="unknown", & 523 file_action="WRITE", file_position="APPEND", & 524 unit_number=lggr%default_global_unit_nr) 525 ELSE IF (.NOT. skip) THEN 526 lggr%default_global_unit_nr = dbcsr_logger_get_default_unit_nr(lggr, .TRUE.) 527 lggr%close_global_unit_on_dealloc = .FALSE. 528 ELSE 529 lggr%default_global_unit_nr = -1 530 lggr%close_global_unit_on_dealloc = .FALSE. 531 END IF 532 END IF 533 IF ((lggr%mp_env%mp%mynode /= lggr%mp_env%mp%source) .AND. (.NOT. skip)) THEN 534 WRITE (UNIT=lggr%default_global_unit_nr, FMT='(/,T2,A)', IOSTAT=iostat) & 535 ' *** WARNING non ionode asked for global logger ***' 536 IF (iostat /= 0) THEN 537 CALL m_getpid(pid) 538 CALL m_hostnm(host_name) 539 PRINT *, " *** Error trying to WRITE to the local logger ***" 540 PRINT *, " *** MPI_id = ", lggr%mp_env%mp%mynode 541 PRINT *, " *** MPI_Communicator = ", lggr%mp_env%mp%mp_group 542 PRINT *, " *** PID = ", pid 543 PRINT *, " *** Hostname = "//TRIM(host_name) 544 CALL print_stack(default_output_unit) 545 ELSE 546 CALL print_stack(lggr%default_global_unit_nr) 547 END IF 548 END IF 549 res = lggr%default_global_unit_nr 550 ELSE 551 IF (lggr%default_local_unit_nr <= 0) THEN 552 CALL dbcsr_logger_generate_filename(lggr, filename, lggr%local_filename, & 553 ".out", local=.TRUE.) 554 CALL open_file(TRIM(filename), file_status="unknown", & 555 file_action="WRITE", & 556 file_position="APPEND", & 557 unit_number=lggr%default_local_unit_nr) 558 WRITE (UNIT=lggr%default_local_unit_nr, FMT='(/,T2,A,I0,A,I0,A)', IOSTAT=iostat) & 559 '*** Local logger file of MPI task ', lggr%mp_env%mp%mynode, & 560 ' in communicator ', lggr%mp_env%mp%mp_group, ' ***' 561 IF (iostat == 0) THEN 562 CALL m_getpid(pid) 563 CALL m_hostnm(host_name) 564 WRITE (UNIT=lggr%default_local_unit_nr, FMT='(T2,A,I0)', IOSTAT=iostat) & 565 '*** PID = ', pid, & 566 '*** Hostname = '//host_name 567 CALL print_stack(lggr%default_local_unit_nr) 568 END IF 569 IF (iostat /= 0) THEN 570 CALL m_getpid(pid) 571 CALL m_hostnm(host_name) 572 PRINT *, " *** Error trying to WRITE to the local logger ***" 573 PRINT *, " *** MPI_id = ", lggr%mp_env%mp%mynode 574 PRINT *, " *** MPI_Communicator = ", lggr%mp_env%mp%mp_group 575 PRINT *, " *** PID = ", pid 576 PRINT *, " *** Hostname = "//TRIM(host_name) 577 CALL print_stack(default_output_unit) 578 END IF 579 580 END IF 581 res = lggr%default_local_unit_nr 582 END IF 583 END FUNCTION dbcsr_logger_get_default_unit_nr 584 585 SUBROUTINE dbcsr_logger_generate_filename(logger, res, root, postfix, & 586 local) 587 !! generates a unique filename (ie adding eventual suffixes and 588 !! process ids) 589 !! @note 590 !! this should be a function returning a variable length string. 591 !! All spaces are moved to the end of the string. 592 !! Not fully optimized: result must be a little longer than the 593 !! resulting compressed filename 594 595 TYPE(dbcsr_logger_type), POINTER :: logger 596 CHARACTER(len=*), INTENT(inout) :: res 597 !! the resulting string 598 CHARACTER(len=*), INTENT(in) :: root, postfix 599 !! the start of filename 600 !! the end of the name 601 LOGICAL, INTENT(in), OPTIONAL :: local 602 !! if the name should be local to this task (defaults to false) 603 604 CHARACTER(len=*), PARAMETER :: routineN = 'dbcsr_logger_generate_filename', & 605 routineP = moduleN//':'//routineN 606 607 LOGICAL :: loc 608 TYPE(dbcsr_logger_type), POINTER :: lggr 609 610 loc = .FALSE. 611 res = ' ' 612 lggr => logger 613 614 IF (.NOT. ASSOCIATED(lggr)) lggr => dbcsr_get_default_logger() 615 IF (lggr%ref_count < 1) & 616 DBCSR_ABORT(routineP//" logger%ref_count<1") 617 IF (PRESENT(local)) loc = local 618 IF (loc) THEN 619 res = TRIM(root)//TRIM(lggr%suffix)//'_p'// & 620 dbcsr_to_string(lggr%mp_env%mp%mynode)//postfix 621 ELSE 622 res = TRIM(root)//TRIM(lggr%suffix)//postfix 623 END IF 624 CALL compress(res, full=.TRUE.) 625 END SUBROUTINE dbcsr_logger_generate_filename 626 627 SUBROUTINE dbcsr_logger_set(logger, local_filename, global_filename) 628 !! sets various attributes of the given logger 629 630 TYPE(dbcsr_logger_type), POINTER :: logger 631 !! the logger you want to change 632 CHARACTER(len=*), INTENT(in), OPTIONAL :: local_filename, global_filename 633 !! the root of the name of the file used for local logging 634 !! the root of the name of the file used for global logging 635 636 CHARACTER(len=*), PARAMETER :: routineN = 'dbcsr_logger_set', & 637 routineP = moduleN//':'//routineN 638 639 IF (.NOT. ASSOCIATED(logger)) & 640 DBCSR_ABORT(routineP//" unassociated logger") 641 IF (PRESENT(local_filename)) logger%local_filename = local_filename 642 IF (PRESENT(global_filename)) logger%global_filename = global_filename 643 END SUBROUTINE dbcsr_logger_set 644 645 FUNCTION dbcsr_int_to_string(i) RESULT(res) 646 !! converts an int to a string 647 !! (should be a variable length string, but that does not work with 648 !! all the compilers) 649 650 INTEGER, INTENT(in) :: i 651 !! the integer to convert 652 CHARACTER(len=6) :: res 653 654 CHARACTER(len=6) :: t_res 655 INTEGER :: iostat 656 REAL(KIND=dp) :: tmp_r 657 658 iostat = 0 659 IF (i > 999999 .OR. i < -99999) THEN 660 tmp_r = i 661 WRITE (t_res, fmt='(es6.1)', iostat=iostat) tmp_r 662 ELSE 663 WRITE (t_res, fmt='(i6)', iostat=iostat) i 664 END IF 665 res = t_res 666 IF (iostat /= 0) THEN 667 PRINT *, "dbcsr_int_to_string ioerror", iostat 668 CALL print_stack(dbcsr_logger_get_default_unit_nr()) 669 END IF 670 END FUNCTION dbcsr_int_to_string 671 672 FUNCTION dbcsr_real_dp_to_string(val) RESULT(res) 673 !! convert a double precision real in a string 674 !! (should be a variable length string, but that does not work with 675 !! all the compilers) 676 677 REAL(KIND=dp), INTENT(in) :: val 678 !! the number to convert 679 CHARACTER(len=11) :: res 680 681 WRITE (res, '(es11.4)') val 682 END FUNCTION dbcsr_real_dp_to_string 683 684 FUNCTION dbcsr_logical_to_string(val) RESULT(res) 685 !! convert a logical in a string ('T' or 'F') 686 687 LOGICAL, INTENT(in) :: val 688 !! the number to convert 689 CHARACTER(len=1) :: res 690 691 IF (val) THEN 692 res = 'T' 693 ELSE 694 res = 'F' 695 END IF 696 END FUNCTION dbcsr_logical_to_string 697 698END MODULE dbcsr_log_handling 699