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 res = stack_pointer 148 END FUNCTION dbcsr_default_logger_stack_size 149 150 SUBROUTINE dbcsr_add_default_logger(logger) 151 !! adds a default logger. 152 !! MUST be called before logging occurs 153 !! @note 154 !! increments a stack of default loggers the latest one will be 155 !! available within the program 156 157 TYPE(dbcsr_logger_type), POINTER :: logger 158 159 CHARACTER(len=*), PARAMETER :: routineN = 'dbcsr_add_default_logger', & 160 routineP = moduleN//':'//routineN 161 162 IF (stack_pointer + 1 > max_stack_pointer) THEN 163 CALL dbcsr_abort(__LOCATION__, routineP// & 164 "too many default loggers, increase max_stack_pointer in "//moduleN) 165 ENDIF 166 167 stack_pointer = stack_pointer + 1 168 NULLIFY (default_logger_stack(stack_pointer)%dbcsr_default_logger) 169 170 default_logger_stack(stack_pointer)%dbcsr_default_logger => logger 171 CALL dbcsr_logger_retain(logger) 172 173 END SUBROUTINE dbcsr_add_default_logger 174 175 SUBROUTINE dbcsr_rm_default_logger() 176 !! the cousin of dbcsr_add_default_logger, decrements the stack, so that 177 !! the default logger is what it has 178 !! been 179 180 IF (stack_pointer - 1 < 0) THEN 181 CALL dbcsr_abort(__LOCATION__, moduleN//":dbcsr_rm_default_logger"// & 182 "can not destroy default logger "//moduleN) 183 ENDIF 184 185 CALL dbcsr_logger_release(default_logger_stack(stack_pointer)%dbcsr_default_logger) 186 NULLIFY (default_logger_stack(stack_pointer)%dbcsr_default_logger) 187 stack_pointer = stack_pointer - 1 188 189 END SUBROUTINE dbcsr_rm_default_logger 190 191 FUNCTION dbcsr_get_default_logger() RESULT(res) 192 !! returns the default logger 193 !! @note 194 !! initializes the default loggers if necessary 195 196 TYPE(dbcsr_logger_type), POINTER :: res 197 198 IF (.NOT. stack_pointer > 0) THEN 199 CALL dbcsr_abort(__LOCATION__, "dbcsr_log_handling:dbcsr_get_default_logger"// & 200 "default logger not yet initialized (CALL dbcsr_init_default_logger)") 201 END IF 202 res => default_logger_stack(stack_pointer)%dbcsr_default_logger 203 IF (.NOT. ASSOCIATED(res)) THEN 204 CALL dbcsr_abort(__LOCATION__, "dbcsr_log_handling:dbcsr_get_default_logger"// & 205 "default logger is null (released too much ?)") 206 END IF 207 END FUNCTION dbcsr_get_default_logger 208 209! ================== log ================== 210 211 SUBROUTINE dbcsr_logger_create(logger, mp_env, print_level, & 212 default_global_unit_nr, default_local_unit_nr, global_filename, & 213 local_filename, close_global_unit_on_dealloc, iter_info, & 214 close_local_unit_on_dealloc, suffix, template_logger) 215 !! initializes a logger 216 !! @note 217 !! the handling of *_filename, default_*_unit_nr, close_*_unit_on_dealloc 218 !! tries to take the right decision with different inputs, and thus is a 219 !! little complex. 220 221 TYPE(dbcsr_logger_type), POINTER :: logger 222 !! the logger to initialize 223 TYPE(dbcsr_mp_obj), OPTIONAL :: mp_env 224 !! the parallel environment (this is most likely the global parallel environment 225 INTEGER, INTENT(in), OPTIONAL :: print_level, default_global_unit_nr, & 226 default_local_unit_nr 227 !! the level starting with which something is written (defaults to dbcsr_note_level) 228 !! the default unit_nr for output (if not given, and no file is given defaults to the standard output) 229 !! the default unit number for local (i.e. task) output. If not given defaults to a out.taskid file created upon 230 CHARACTER(len=*), INTENT(in), OPTIONAL :: global_filename, local_filename 231 !! a new file to open (can be given instead of the global_unit_nr) 232 !! a new file to open (with suffix and mp_env%mp%mynode appended). Can be given instead of the default_local_unit_nr). the 233 !! file is created only upon the first local logging request 234 LOGICAL, INTENT(in), OPTIONAL :: close_global_unit_on_dealloc 235 !! if the unit should be closed when the logger is deallocated (defaults to true if a local_filename is given, to false 236 !! otherwise) 237 TYPE(dbcsr_iteration_info_type), OPTIONAL, POINTER :: iter_info 238 LOGICAL, INTENT(in), OPTIONAL :: close_local_unit_on_dealloc 239 !! if the unit should be closed when the logger is deallocated (defaults to true) 240 CHARACTER(len=*), INTENT(in), OPTIONAL :: suffix 241 !! the suffix that should be added to all the generated filenames 242 TYPE(dbcsr_logger_type), OPTIONAL, POINTER :: template_logger 243 !! a logger from where to take the unspecified things 244 245 CHARACTER(len=*), PARAMETER :: routineN = 'dbcsr_logger_create', & 246 routineP = moduleN//':'//routineN 247 248 INTEGER :: stat 249 250 ALLOCATE (logger, stat=stat) 251 IF (stat /= 0) & 252 DBCSR_ABORT(routineP//" could not ALLOCATE a logger") 253 254 NULLIFY (logger%iter_info) 255 logger%ref_count = 1 256 last_logger_id_nr = last_logger_id_nr + 1 257 logger%id_nr = last_logger_id_nr 258 259 IF (PRESENT(template_logger)) THEN 260 IF (template_logger%ref_count < 1) & 261 DBCSR_ABORT(routineP//" template_logger%ref_count<1") 262 logger%print_level = template_logger%print_level 263 logger%default_global_unit_nr = template_logger%default_global_unit_nr 264 logger%close_local_unit_on_dealloc = template_logger%close_local_unit_on_dealloc 265 IF (logger%close_local_unit_on_dealloc) THEN 266 logger%default_local_unit_nr = -1 267 ELSE 268 logger%default_local_unit_nr = template_logger%default_local_unit_nr 269 END IF 270 logger%close_global_unit_on_dealloc = template_logger%close_global_unit_on_dealloc 271 IF (logger%close_global_unit_on_dealloc) THEN 272 logger%default_global_unit_nr = -1 273 ELSE 274 logger%default_global_unit_nr = template_logger%default_global_unit_nr 275 END IF 276 logger%local_filename = template_logger%local_filename 277 logger%global_filename = template_logger%global_filename 278 logger%mp_env = template_logger%mp_env 279 logger%suffix = template_logger%suffix 280 logger%iter_info => template_logger%iter_info 281 ELSE 282 ! create a file if nothing is specified, one can also get the unit from the default logger 283 ! which should have something reasonable as the argument is required in that case 284 logger%default_global_unit_nr = -1 285 logger%close_global_unit_on_dealloc = .TRUE. 286 logger%local_filename = "localLog" 287 logger%global_filename = "mainLog" 288 logger%print_level = dbcsr_note_level 289 ! generate a file for default local logger 290 ! except the ionode that should write to the default global logger 291 logger%default_local_unit_nr = -1 292 logger%close_local_unit_on_dealloc = .TRUE. 293 logger%suffix = "" 294 END IF 295 IF (PRESENT(mp_env)) logger%mp_env = mp_env 296 IF (.NOT. ASSOCIATED(logger%mp_env%mp)) & 297 DBCSR_ABORT(routineP//" mp env not associated") 298 299 IF (logger%mp_env%mp%refcount < 1) & 300 DBCSR_ABORT(routineP//" mp_env%ref_count<1") 301 logger%mp_env%mp%refcount = logger%mp_env%mp%refcount + 1 302 303 IF (PRESENT(print_level)) logger%print_level = print_level 304 305 IF (PRESENT(default_global_unit_nr)) & 306 logger%default_global_unit_nr = default_global_unit_nr 307 IF (PRESENT(global_filename)) THEN 308 logger%global_filename = global_filename 309 logger%close_global_unit_on_dealloc = .TRUE. 310 logger%default_global_unit_nr = -1 311 END IF 312 IF (PRESENT(close_global_unit_on_dealloc)) THEN 313 logger%close_global_unit_on_dealloc = close_global_unit_on_dealloc 314 IF (PRESENT(default_global_unit_nr) .AND. PRESENT(global_filename) .AND. & 315 (.NOT. close_global_unit_on_dealloc)) THEN 316 logger%default_global_unit_nr = default_global_unit_nr 317 END IF 318 END IF 319 320 IF (PRESENT(default_local_unit_nr)) & 321 logger%default_local_unit_nr = default_local_unit_nr 322 IF (PRESENT(local_filename)) THEN 323 logger%local_filename = local_filename 324 logger%close_local_unit_on_dealloc = .TRUE. 325 logger%default_local_unit_nr = -1 326 END IF 327 IF (PRESENT(suffix)) logger%suffix = suffix 328 329 IF (PRESENT(close_local_unit_on_dealloc)) THEN 330 logger%close_local_unit_on_dealloc = close_local_unit_on_dealloc 331 IF (PRESENT(default_local_unit_nr) .AND. PRESENT(local_filename) .AND. & 332 (.NOT. close_local_unit_on_dealloc)) THEN 333 logger%default_local_unit_nr = default_local_unit_nr 334 END IF 335 END IF 336 337 IF (logger%default_local_unit_nr == -1) THEN 338 IF (logger%mp_env%mp%mynode == logger%mp_env%mp%source) THEN 339 logger%default_local_unit_nr = logger%default_global_unit_nr 340 logger%close_local_unit_on_dealloc = .FALSE. 341 ENDIF 342 ENDIF 343 IF (PRESENT(iter_info)) logger%iter_info => iter_info 344 IF (ASSOCIATED(logger%iter_info)) THEN 345 CALL dbcsr_iteration_info_retain(logger%iter_info) 346 ELSE 347 CALL dbcsr_iteration_info_create(logger%iter_info, "") 348 END IF 349 END SUBROUTINE dbcsr_logger_create 350 351 SUBROUTINE dbcsr_logger_retain(logger) 352 !! retains the given logger (to be called to keep a shared copy of 353 !! the logger) 354 355 TYPE(dbcsr_logger_type), POINTER :: logger 356 !! the logger to retain 357 358 CHARACTER(len=*), PARAMETER :: routineN = 'dbcsr_logger_retain', & 359 routineP = moduleN//':'//routineN 360 361 IF (.NOT. ASSOCIATED(logger)) & 362 DBCSR_ABORT(routineP//" logger not associated") 363 IF (logger%ref_count < 1) & 364 DBCSR_ABORT(routineP//" logger%ref_count<1") 365 logger%ref_count = logger%ref_count + 1 366 END SUBROUTINE dbcsr_logger_retain 367 368 SUBROUTINE dbcsr_logger_release(logger) 369 !! releases this logger 370 371 TYPE(dbcsr_logger_type), POINTER :: logger 372 !! the logger to release 373 374 CHARACTER(len=*), PARAMETER :: routineN = 'dbcsr_logger_release', & 375 routineP = moduleN//':'//routineN 376 377 IF (ASSOCIATED(logger)) THEN 378 IF (logger%ref_count < 1) & 379 DBCSR_ABORT(routineP//" logger%ref_count<1") 380 logger%ref_count = logger%ref_count - 1 381 IF (logger%ref_count == 0) THEN 382 IF (logger%close_global_unit_on_dealloc .AND. & 383 logger%default_global_unit_nr >= 0) THEN 384 CALL close_file(logger%default_global_unit_nr) 385 logger%close_global_unit_on_dealloc = .FALSE. 386 logger%default_global_unit_nr = -1 387 END IF 388 IF (logger%close_local_unit_on_dealloc .AND. & 389 logger%default_local_unit_nr >= 0) THEN 390 CALL close_file(logger%default_local_unit_nr) 391 logger%close_local_unit_on_dealloc = .FALSE. 392 logger%default_local_unit_nr = -1 393 END IF 394 CALL dbcsr_mp_release(logger%mp_env) 395 CALL dbcsr_iteration_info_release(logger%iter_info) 396 DEALLOCATE (logger) 397 END IF 398 END IF 399 END SUBROUTINE dbcsr_logger_release 400 401 FUNCTION dbcsr_logger_would_log(logger, level) RESULT(res) 402 !! this function can be called to check if the logger would log 403 !! a message with the given level from the given source 404 !! you should use this function if you do direct logging 405 !! (without using dbcsr_logger_log), or if you want to know if the generation 406 !! of some costly log info is necessary 407 408 TYPE(dbcsr_logger_type), POINTER :: logger 409 !! the logger you want to log in 410 INTEGER, INTENT(in) :: level 411 !! describes the of the message: dbcsr_fatal_level(3), dbcsr_failure_level(2), dbcsr_warning_level(1), dbcsr_note_level(0). 412 LOGICAL :: res 413 414 CHARACTER(len=*), PARAMETER :: routineN = 'dbcsr_logger_would_log', & 415 routineP = moduleN//':'//routineN 416 417 TYPE(dbcsr_logger_type), POINTER :: lggr 418 419 lggr => logger 420 IF (.NOT. ASSOCIATED(lggr)) lggr => dbcsr_get_default_logger() 421 IF (lggr%ref_count < 1) & 422 DBCSR_ABORT(routineP//" logger%ref_count<1") 423 424 res = level >= lggr%print_level 425 END FUNCTION dbcsr_logger_would_log 426 427 FUNCTION dbcsr_logger_get_unit_nr(logger, local) RESULT(res) 428 !! returns the unit nr for the requested kind of log. 429 430 TYPE(dbcsr_logger_type), POINTER :: logger 431 !! the logger you want to log in 432 LOGICAL, INTENT(in), OPTIONAL :: local 433 !! if true returns a local logger (one per task), otherwise returns a global logger (only the process with 434 !! mp_env%mp%mynode== mp_env%mp%source should write to the global logger). Defaults to false 435 INTEGER :: res 436 437 res = dbcsr_logger_get_default_unit_nr(logger, local=local) 438 END FUNCTION dbcsr_logger_get_unit_nr 439 440 FUNCTION dbcsr_logger_get_default_io_unit(logger) RESULT(res) 441 !! returns the unit nr for the ionode (-1 on all other processors) 442 !! skips as well checks if the procs calling this function is not the ionode 443 444 TYPE(dbcsr_logger_type), OPTIONAL, POINTER :: logger 445 !! the logger you want to log in 446 INTEGER :: res 447 448 TYPE(dbcsr_logger_type), POINTER :: local_logger 449 450 IF (PRESENT(logger)) THEN 451 local_logger => logger 452 ELSE IF (stack_pointer == 0) THEN 453 res = -1 ! edge case: default logger not yet/anymore available 454 RETURN 455 ELSE 456 local_logger => dbcsr_get_default_logger() 457 ENDIF 458 459 res = dbcsr_logger_get_default_unit_nr(local_logger, local=.FALSE., skip_not_ionode=.TRUE.) 460 END FUNCTION dbcsr_logger_get_default_io_unit 461 462! *************************** dbcsr_logger_type settings *************************** 463 464 SUBROUTINE dbcsr_logger_set_log_level(logger, level) 465 !! changes the logging level. Log messages with a level less than the one 466 !! given wo not be printed. 467 468 TYPE(dbcsr_logger_type), POINTER :: logger 469 !! the logger to change 470 INTEGER, INTENT(in) :: level 471 !! the new logging level for the logger 472 473 CHARACTER(len=*), PARAMETER :: routineN = 'dbcsr_logger_set_log_level', & 474 routineP = moduleN//':'//routineN 475 476 IF (.NOT. ASSOCIATED(logger)) & 477 DBCSR_ABORT(routineP//" logger not associated") 478 IF (logger%ref_count < 1) & 479 DBCSR_ABORT(routineP//" logger%ref_count<1") 480 logger%print_level = level 481 END SUBROUTINE dbcsr_logger_set_log_level 482 483 RECURSIVE FUNCTION dbcsr_logger_get_default_unit_nr(logger, local, skip_not_ionode) RESULT(res) 484 !! asks the default unit number of the given logger. 485 !! try to use dbcsr_logger_get_unit_nr 486 487 TYPE(dbcsr_logger_type), OPTIONAL, POINTER :: logger 488 !! the logger you want info from 489 LOGICAL, INTENT(in), OPTIONAL :: local, skip_not_ionode 490 !! if you want the local unit nr (defaults to false) 491 INTEGER :: res 492 493 CHARACTER(len=*), PARAMETER :: routineN = 'dbcsr_logger_get_default_unit_nr', & 494 routineP = moduleN//':'//routineN 495 496 CHARACTER(len=default_path_length) :: filename, host_name 497 INTEGER :: iostat, pid 498 LOGICAL :: loc, skip 499 TYPE(dbcsr_logger_type), POINTER :: lggr 500 501 loc = .TRUE. 502 skip = .FALSE. 503 IF (PRESENT(logger)) THEN 504 lggr => logger 505 ELSE 506 NULLIFY (lggr) 507 ENDIF 508 IF (.NOT. ASSOCIATED(lggr)) lggr => dbcsr_get_default_logger() 509 IF (lggr%ref_count < 1) & 510 DBCSR_ABORT(routineP//" logger%ref_count<1") 511 512 IF (PRESENT(local)) loc = local 513 IF (PRESENT(skip_not_ionode)) skip = skip_not_ionode 514 IF (.NOT. loc) THEN 515 IF (lggr%default_global_unit_nr <= 0) THEN 516 IF (lggr%mp_env%mp%mynode == lggr%mp_env%mp%source) THEN 517 CALL dbcsr_logger_generate_filename(lggr, filename, lggr%global_filename, & 518 ".out", local=.FALSE.) 519 CALL open_file(TRIM(filename), file_status="unknown", & 520 file_action="WRITE", file_position="APPEND", & 521 unit_number=lggr%default_global_unit_nr) 522 ELSE IF (.NOT. skip) THEN 523 lggr%default_global_unit_nr = dbcsr_logger_get_default_unit_nr(lggr, .TRUE.) 524 lggr%close_global_unit_on_dealloc = .FALSE. 525 ELSE 526 lggr%default_global_unit_nr = -1 527 lggr%close_global_unit_on_dealloc = .FALSE. 528 END IF 529 END IF 530 IF ((lggr%mp_env%mp%mynode /= lggr%mp_env%mp%source) .AND. (.NOT. skip)) THEN 531 WRITE (UNIT=lggr%default_global_unit_nr, FMT='(/,T2,A)', IOSTAT=iostat) & 532 ' *** WARNING non ionode asked for global logger ***' 533 IF (iostat /= 0) THEN 534 CALL m_getpid(pid) 535 CALL m_hostnm(host_name) 536 PRINT *, " *** Error trying to WRITE to the local logger ***" 537 PRINT *, " *** MPI_id = ", lggr%mp_env%mp%mynode 538 PRINT *, " *** MPI_Communicator = ", lggr%mp_env%mp%mp_group 539 PRINT *, " *** PID = ", pid 540 PRINT *, " *** Hostname = "//TRIM(host_name) 541 CALL print_stack(default_output_unit) 542 ELSE 543 CALL print_stack(lggr%default_global_unit_nr) 544 END IF 545 END IF 546 res = lggr%default_global_unit_nr 547 ELSE 548 IF (lggr%default_local_unit_nr <= 0) THEN 549 CALL dbcsr_logger_generate_filename(lggr, filename, lggr%local_filename, & 550 ".out", local=.TRUE.) 551 CALL open_file(TRIM(filename), file_status="unknown", & 552 file_action="WRITE", & 553 file_position="APPEND", & 554 unit_number=lggr%default_local_unit_nr) 555 WRITE (UNIT=lggr%default_local_unit_nr, FMT='(/,T2,A,I0,A,I0,A)', IOSTAT=iostat) & 556 '*** Local logger file of MPI task ', lggr%mp_env%mp%mynode, & 557 ' in communicator ', lggr%mp_env%mp%mp_group, ' ***' 558 IF (iostat == 0) THEN 559 CALL m_getpid(pid) 560 CALL m_hostnm(host_name) 561 WRITE (UNIT=lggr%default_local_unit_nr, FMT='(T2,A,I0)', IOSTAT=iostat) & 562 '*** PID = ', pid, & 563 '*** Hostname = '//host_name 564 CALL print_stack(lggr%default_local_unit_nr) 565 END IF 566 IF (iostat /= 0) THEN 567 CALL m_getpid(pid) 568 CALL m_hostnm(host_name) 569 PRINT *, " *** Error trying to WRITE to the local logger ***" 570 PRINT *, " *** MPI_id = ", lggr%mp_env%mp%mynode 571 PRINT *, " *** MPI_Communicator = ", lggr%mp_env%mp%mp_group 572 PRINT *, " *** PID = ", pid 573 PRINT *, " *** Hostname = "//TRIM(host_name) 574 CALL print_stack(default_output_unit) 575 END IF 576 577 END IF 578 res = lggr%default_local_unit_nr 579 END IF 580 END FUNCTION dbcsr_logger_get_default_unit_nr 581 582 SUBROUTINE dbcsr_logger_generate_filename(logger, res, root, postfix, & 583 local) 584 !! generates a unique filename (ie adding eventual suffixes and 585 !! process ids) 586 !! @note 587 !! this should be a function returning a variable length string. 588 !! All spaces are moved to the end of the string. 589 !! Not fully optimized: result must be a little longer than the 590 !! resulting compressed filename 591 592 TYPE(dbcsr_logger_type), POINTER :: logger 593 CHARACTER(len=*), INTENT(inout) :: res 594 !! the resulting string 595 CHARACTER(len=*), INTENT(in) :: root, postfix 596 !! the start of filename 597 !! the end of the name 598 LOGICAL, INTENT(in), OPTIONAL :: local 599 !! if the name should be local to this task (defaults to false) 600 601 CHARACTER(len=*), PARAMETER :: routineN = 'dbcsr_logger_generate_filename', & 602 routineP = moduleN//':'//routineN 603 604 LOGICAL :: loc 605 TYPE(dbcsr_logger_type), POINTER :: lggr 606 607 loc = .FALSE. 608 res = ' ' 609 lggr => logger 610 611 IF (.NOT. ASSOCIATED(lggr)) lggr => dbcsr_get_default_logger() 612 IF (lggr%ref_count < 1) & 613 DBCSR_ABORT(routineP//" logger%ref_count<1") 614 IF (PRESENT(local)) loc = local 615 IF (loc) THEN 616 res = TRIM(root)//TRIM(lggr%suffix)//'_p'// & 617 dbcsr_to_string(lggr%mp_env%mp%mynode)//postfix 618 ELSE 619 res = TRIM(root)//TRIM(lggr%suffix)//postfix 620 END IF 621 CALL compress(res, full=.TRUE.) 622 END SUBROUTINE dbcsr_logger_generate_filename 623 624 SUBROUTINE dbcsr_logger_set(logger, local_filename, global_filename) 625 !! sets various attributes of the given logger 626 627 TYPE(dbcsr_logger_type), POINTER :: logger 628 !! the logger you want to change 629 CHARACTER(len=*), INTENT(in), OPTIONAL :: local_filename, global_filename 630 !! the root of the name of the file used for local logging 631 !! the root of the name of the file used for global logging 632 633 CHARACTER(len=*), PARAMETER :: routineN = 'dbcsr_logger_set', & 634 routineP = moduleN//':'//routineN 635 636 IF (.NOT. ASSOCIATED(logger)) & 637 DBCSR_ABORT(routineP//" unassociated logger") 638 IF (PRESENT(local_filename)) logger%local_filename = local_filename 639 IF (PRESENT(global_filename)) logger%global_filename = global_filename 640 END SUBROUTINE dbcsr_logger_set 641 642 FUNCTION dbcsr_int_to_string(i) RESULT(res) 643 !! converts an int to a string 644 !! (should be a variable length string, but that does not work with 645 !! all the compilers) 646 647 INTEGER, INTENT(in) :: i 648 !! the integer to convert 649 CHARACTER(len=6) :: res 650 651 CHARACTER(len=6) :: t_res 652 INTEGER :: iostat 653 REAL(KIND=dp) :: tmp_r 654 655 iostat = 0 656 IF (i > 999999 .OR. i < -99999) THEN 657 tmp_r = i 658 WRITE (t_res, fmt='(es6.1)', iostat=iostat) tmp_r 659 ELSE 660 WRITE (t_res, fmt='(i6)', iostat=iostat) i 661 END IF 662 res = t_res 663 IF (iostat /= 0) THEN 664 PRINT *, "dbcsr_int_to_string ioerror", iostat 665 CALL print_stack(dbcsr_logger_get_default_unit_nr()) 666 END IF 667 END FUNCTION dbcsr_int_to_string 668 669 FUNCTION dbcsr_real_dp_to_string(val) RESULT(res) 670 !! convert a double precision real in a string 671 !! (should be a variable length string, but that does not work with 672 !! all the compilers) 673 674 REAL(KIND=dp), INTENT(in) :: val 675 !! the number to convert 676 CHARACTER(len=11) :: res 677 678 WRITE (res, '(es11.4)') val 679 END FUNCTION dbcsr_real_dp_to_string 680 681 FUNCTION dbcsr_logical_to_string(val) RESULT(res) 682 !! convert a logical in a string ('T' or 'F') 683 684 LOGICAL, INTENT(in) :: val 685 !! the number to convert 686 CHARACTER(len=1) :: res 687 688 IF (val) THEN 689 res = 'T' 690 ELSE 691 res = 'F' 692 END IF 693 END FUNCTION dbcsr_logical_to_string 694 695END MODULE dbcsr_log_handling 696