LCOV - code coverage report
Current view: top level - src/input - cp_output_handling.F (source / functions) Coverage Total Hit
Test: CP2K Regtests (git:42dac4a) Lines: 91.7 % 373 342
Test Date: 2025-07-25 12:55:17 Functions: 81.2 % 16 13

            Line data    Source code
       1              : !--------------------------------------------------------------------------------------------------!
       2              : !   CP2K: A general program to perform molecular dynamics simulations                              !
       3              : !   Copyright 2000-2025 CP2K developers group <https://cp2k.org>                                   !
       4              : !                                                                                                  !
       5              : !   SPDX-License-Identifier: GPL-2.0-or-later                                                      !
       6              : !--------------------------------------------------------------------------------------------------!
       7              : 
       8              : ! **************************************************************************************************
       9              : !> \brief routines to handle the output, The idea is to remove the
      10              : !>      decision of wheter to output and what to output from the code
      11              : !>      that does the output, and centralize it here.
      12              : !> \note
      13              : !>      These were originally together with the log handling routines,
      14              : !>      but have been spawned off. Some dependencies are still there,
      15              : !>      and some of the comments about log handling also applies to output
      16              : !>      handling: @see cp_log_handling
      17              : !> \par History
      18              : !>      12.2001 created [fawzi]
      19              : !>      08.2002 updated to new logger [fawzi]
      20              : !>      10.2004 big rewrite of the output methods, connected to the new
      21              : !>              input, and iteration_info [fawzi]
      22              : !>      08.2005 property flags [fawzi]
      23              : !> \author Fawzi Mohamed
      24              : ! **************************************************************************************************
      25              : MODULE cp_output_handling
      26              :    USE cp_files,                        ONLY: close_file,&
      27              :                                               open_file
      28              :    USE cp_iter_types,                   ONLY: cp_iteration_info_release,&
      29              :                                               cp_iteration_info_retain,&
      30              :                                               cp_iteration_info_type,&
      31              :                                               each_desc_labels,&
      32              :                                               each_possible_labels
      33              :    USE cp_log_handling,                 ONLY: cp_logger_generate_filename,&
      34              :                                               cp_logger_get_default_unit_nr,&
      35              :                                               cp_logger_get_unit_nr,&
      36              :                                               cp_logger_type,&
      37              :                                               cp_to_string
      38              :    USE input_keyword_types,             ONLY: keyword_create,&
      39              :                                               keyword_release,&
      40              :                                               keyword_type
      41              :    USE input_section_types,             ONLY: section_add_keyword,&
      42              :                                               section_add_subsection,&
      43              :                                               section_create,&
      44              :                                               section_release,&
      45              :                                               section_type,&
      46              :                                               section_vals_get_subs_vals,&
      47              :                                               section_vals_type,&
      48              :                                               section_vals_val_get
      49              :    USE kinds,                           ONLY: default_path_length,&
      50              :                                               default_string_length
      51              :    USE machine,                         ONLY: m_mov
      52              :    USE memory_utilities,                ONLY: reallocate
      53              :    USE message_passing,                 ONLY: mp_file_delete,&
      54              :                                               mp_file_get_amode,&
      55              :                                               mp_file_type
      56              :    USE string_utilities,                ONLY: compress,&
      57              :                                               s2a
      58              : #include "../base/base_uses.f90"
      59              : 
      60              :    IMPLICIT NONE
      61              :    PRIVATE
      62              : 
      63              :    LOGICAL, PRIVATE, PARAMETER :: debug_this_module = .TRUE.
      64              :    CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'cp_output_handling'
      65              :    PUBLIC :: cp_print_key_should_output, cp_iterate, cp_get_iter_level_by_name, cp_get_iter_nr, cp_add_iter_level, cp_rm_iter_level
      66              :    PUBLIC :: cp_iter_string, cp_print_key_section_create
      67              :    PUBLIC :: cp_print_key_unit_nr, cp_print_key_finished_output
      68              :    PUBLIC :: cp_print_key_generate_filename, cp_printkey_is_on
      69              : 
      70              :    INTEGER, PARAMETER, PUBLIC               :: add_last_no = 0, &
      71              :                                                add_last_numeric = 1, &
      72              :                                                add_last_symbolic = 2
      73              :    INTEGER, PARAMETER, PUBLIC               :: silent_print_level = 0, &
      74              :                                                low_print_level = 1, &
      75              :                                                medium_print_level = 2, &
      76              :                                                high_print_level = 3, &
      77              :                                                debug_print_level = 4
      78              : 
      79              : !! flags controlling the printing and storing of a property.
      80              : !!
      81              : !! cp_out_none: do not calculate the property
      82              : !! cp_out_file_if  : if the printkey says it calculate and output the property
      83              : !! cp_out_store_if : if the printkey says it calculate and store in memory
      84              : !!                   the property
      85              : !! cp_out_file_each: calculate and output the property with the same periodicity
      86              : !!                   as said in the printkey (irrespective of the activation of
      87              : !!                   the printkey)
      88              : !! cp_out_store_each: calculate and store the property with the same periodicity
      89              : !!                   as said in the printkey (irrespective of the activation of
      90              : !!                   the printkey)
      91              : !! cp_out_file: always calculate and output the property
      92              : !! cp_out_store: always calculate and store in memory the property
      93              : !! cp_out_calc: just calculate the value (independently from the fact that there
      94              : !!              should be output)
      95              : !! cp_out_default: the default value for property flags (cp_out_file_if)
      96              : !!
      97              : !! this flags can be ior-ed together:
      98              : !! ior(cp_out_file_if,cp_out_store_if): if the printkey says it both print
      99              : !!                                          and store the property
     100              : !!
     101              : !! there is no guarantee that a property is not stored if it is not necessary
     102              : !! not all printkeys have a control flag
     103              :    INTEGER, PUBLIC, PARAMETER :: cp_p_file_if = 3, cp_p_store_if = 4, &
     104              :                                  cp_p_store = 2, cp_p_file = 1, cp_p_file_each = 5, cp_p_store_each = 6, cp_p_calc = 7
     105              :    INTEGER, PUBLIC, PARAMETER :: cp_out_none = 0, cp_out_file_if = IBSET(0, cp_p_file_if), &
     106              :                                  cp_out_store_if = IBSET(0, cp_p_store_if), cp_out_file = IBSET(0, cp_p_file), &
     107              :                                  cp_out_store = IBSET(0, cp_p_store), cp_out_calc = IBSET(0, cp_p_calc), &
     108              :                                  cp_out_file_each = IBSET(0, cp_p_file_each), &
     109              :                                  cp_out_store_each = IBSET(0, cp_p_store_each), &
     110              :                                  cp_out_default = cp_out_file_if
     111              : 
     112              : ! Flag determining if MPI I/O should be enabled for functions that support it
     113              :    LOGICAL, PRIVATE, SAVE      :: enable_mpi_io = .FALSE.
     114              : ! Public functions to set/get the flags
     115              :    PUBLIC :: cp_mpi_io_set, cp_mpi_io_get
     116              : 
     117              : ! **************************************************************************************************
     118              : !> \brief stores the flags_env controlling the output of properties
     119              : !> \param ref_count reference count (see doc/ReferenceCounting.html)
     120              : !> \param n_flags number of flags stored in this type
     121              : !> \param names names of the stored flags
     122              : !> \param control_val value of the flag
     123              : !> \param input the input (with all the printkeys)
     124              : !> \param logger logger and iteration information (to know if output is needed)
     125              : !> \param strict if flags that were not stored can be read
     126              : !> \param default_val default value of the flags that are not explicitly
     127              : !>        stored
     128              : !> \note
     129              : !>      Two features of this object should be:
     130              : !>        1) easy state storage, one should be able to store the state of the
     131              : !>           flags, to some changes to them just for one (or few) force evaluations
     132              : !>           and then reset the original state. The actual implementation is good
     133              : !>           in this respect
     134              : !>        2) work well with subsections. This is a problem at the moment, as
     135              : !>           if you pass just a subsection of the input the control flags get lost.
     136              : !>        A better implementation should be done storing the flags also in the
     137              : !>        input itself to be transparent
     138              : !> \author fawzi
     139              : ! **************************************************************************************************
     140              :    TYPE cp_out_flags_type
     141              :       INTEGER :: ref_count = 0, n_flags = 0
     142              :       CHARACTER(default_string_length), DIMENSION(:), POINTER :: names => NULL()
     143              :       INTEGER, DIMENSION(:), POINTER :: control_val => NULL()
     144              :       TYPE(section_vals_type), POINTER :: input => NULL()
     145              :       TYPE(cp_logger_type), POINTER :: logger => NULL()
     146              :       LOGICAL :: strict = .FALSE.
     147              :       INTEGER :: default_val = 0
     148              :    END TYPE cp_out_flags_type
     149              : 
     150              : CONTAINS
     151              : 
     152              : ! **************************************************************************************************
     153              : !> \brief creates a print_key section
     154              : !> \param print_key_section the print key to create
     155              : !> \param location from where in the source code cp_print_key_section_create() is called
     156              : !> \param name the name of the print key
     157              : !> \param description the description of the print key
     158              : !> \param print_level print level starting at which the printing takes place
     159              : !>        (defaults to debug_print_level)
     160              : !> \param each_iter_names ...
     161              : !> \param each_iter_values ...
     162              : !> \param add_last ...
     163              : !> \param filename ...
     164              : !> \param common_iter_levels ...
     165              : !> \param citations ...
     166              : !> \param unit_str specifies an unit of measure for output quantity. If not
     167              : !>        provided the control is totally left to how the output was coded
     168              : !>        (i.e. USERS have no possibility to change it)
     169              : !> \author fawzi
     170              : ! **************************************************************************************************
     171      6480580 :    SUBROUTINE cp_print_key_section_create(print_key_section, location, name, description, &
     172      6480580 :                                           print_level, each_iter_names, each_iter_values, add_last, filename, &
     173       185122 :                                           common_iter_levels, citations, unit_str)
     174              :       TYPE(section_type), POINTER                        :: print_key_section
     175              :       CHARACTER(len=*), INTENT(IN)                       :: location, name, description
     176              :       INTEGER, INTENT(IN), OPTIONAL                      :: print_level
     177              :       CHARACTER(LEN=*), DIMENSION(:), INTENT(IN), &
     178              :          OPTIONAL                                        :: each_iter_names
     179              :       INTEGER, DIMENSION(:), INTENT(IN), OPTIONAL        :: each_iter_values
     180              :       INTEGER, INTENT(IN), OPTIONAL                      :: add_last
     181              :       CHARACTER(LEN=*), INTENT(IN), OPTIONAL             :: filename
     182              :       INTEGER, INTENT(IN), OPTIONAL                      :: common_iter_levels
     183              :       INTEGER, DIMENSION(:), OPTIONAL                    :: citations
     184              :       CHARACTER(LEN=*), INTENT(IN), OPTIONAL             :: unit_str
     185              : 
     186              :       CHARACTER(len=default_path_length)                 :: my_filename
     187              :       INTEGER                                            :: i_each, i_iter, my_add_last, &
     188              :                                                             my_comm_iter_levels, my_print_level, &
     189              :                                                             my_value
     190              :       LOGICAL                                            :: check, ext_each
     191              :       TYPE(keyword_type), POINTER                        :: keyword
     192              :       TYPE(section_type), POINTER                        :: subsection
     193              : 
     194      6480580 :       CPASSERT(.NOT. ASSOCIATED(print_key_section))
     195      6480580 :       my_print_level = debug_print_level
     196      6480580 :       IF (PRESENT(print_level)) my_print_level = print_level
     197              : 
     198              :       CALL section_create(print_key_section, location=location, name=name, description=description, &
     199              :                           n_keywords=2, n_subsections=0, repeats=.FALSE., &
     200     12776038 :                           citations=citations)
     201              : 
     202      6480580 :       NULLIFY (keyword, subsection)
     203              :       CALL keyword_create(keyword, __LOCATION__, name="_SECTION_PARAMETERS_", &
     204              :                           description="Level starting at which this property is printed", &
     205              :                           usage="silent", &
     206              :                           default_i_val=my_print_level, lone_keyword_i_val=silent_print_level, &
     207              :                           enum_c_vals=s2a("on", "off", "silent", "low", "medium", "high", "debug"), &
     208              :                           enum_i_vals=(/silent_print_level - 1, debug_print_level + 1, &
     209              :                                         silent_print_level, low_print_level, &
     210      6480580 :                                         medium_print_level, high_print_level, debug_print_level/))
     211      6480580 :       CALL section_add_keyword(print_key_section, keyword)
     212      6480580 :       CALL keyword_release(keyword)
     213              : 
     214              :       CALL keyword_create(keyword, __LOCATION__, name="__CONTROL_VAL", &
     215              :                           description=' hidden parameter that controls storage, printing,...'// &
     216              :                           ' of the print_key', &
     217      6480580 :                           default_i_val=cp_out_default)
     218      6480580 :       CALL section_add_keyword(print_key_section, keyword)
     219      6480580 :       CALL keyword_release(keyword)
     220              : 
     221              :       CALL section_create(subsection, __LOCATION__, name="EACH", &
     222              :                           description="This section specifies how often this property is printed. "// &
     223              :                           "Each keyword inside this section is mapping to a specific iteration level and "// &
     224              :                           "the value of each of these keywords is matched with the iteration level during "// &
     225              :                           "the calculation. How to handle the last iteration is treated "// &
     226              :                           "separately in ADD_LAST (this mean that each iteration level (MD, GEO_OPT, etc..), "// &
     227              :                           "though equal to 0, might print the last iteration). If an iteration level is specified "// &
     228              :                           "that is not present in the flow of the calculation it is just ignored.", &
     229              :                           n_keywords=2, n_subsections=0, repeats=.FALSE., &
     230     12776038 :                           citations=citations)
     231              : 
     232              :       ! Enforce the presence or absence of both.. or give an error
     233      6480580 :       check = (PRESENT(each_iter_names)) .EQV. (PRESENT(each_iter_values))
     234      6480580 :       CPASSERT(check)
     235      6480580 :       ext_each = (PRESENT(each_iter_names)) .AND. (PRESENT(each_iter_values))
     236              : 
     237    123131020 :       DO i_each = 1, SIZE(each_possible_labels)
     238    116650440 :          my_value = 1
     239    116650440 :          IF (ext_each) THEN
     240     20216520 :             check = SUM(INDEX(each_iter_names, each_possible_labels(i_each))) <= 1
     241      8437176 :             CPASSERT(check)
     242     20216520 :             DO i_iter = 1, SIZE(each_iter_names)
     243     20216520 :                IF (INDEX(TRIM(each_iter_names(i_iter)), TRIM(each_possible_labels(i_each))) /= 0) THEN
     244       623462 :                   my_value = each_iter_values(i_iter)
     245              :                END IF
     246              :             END DO
     247              :          END IF
     248              :          CALL keyword_create(keyword, __LOCATION__, name=TRIM(each_possible_labels(i_each)), &
     249              :                              description=TRIM(each_desc_labels(i_each)), &
     250              :                              usage=TRIM(each_possible_labels(i_each))//" <INTEGER>", &
     251    116650440 :                              default_i_val=my_value)
     252    116650440 :          CALL section_add_keyword(subsection, keyword)
     253    123131020 :          CALL keyword_release(keyword)
     254              :       END DO
     255      6480580 :       CALL section_add_subsection(print_key_section, subsection)
     256      6480580 :       CALL section_release(subsection)
     257              : 
     258      6480580 :       my_add_last = add_last_no
     259      6480580 :       IF (PRESENT(add_last)) THEN
     260      2538434 :          my_add_last = add_last
     261              :       END IF
     262              :       CALL keyword_create(keyword, __LOCATION__, name="ADD_LAST", &
     263              :                           description="If the last iteration should be added, and if it "// &
     264              :                           "should be marked symbolically (with lowercase letter l) or with "// &
     265              :                           "the iteration number. "// &
     266              :                           "Not every iteration level is able to identify the last iteration "// &
     267              :                           "early enough to be able to output. When this keyword is activated "// &
     268              :                           "all iteration levels are checked for the last iteration step.", &
     269              :                           usage="ADD_LAST (NO|NUMERIC|SYMBOLIC)", &
     270              :                           enum_c_vals=s2a("no", "numeric", "symbolic"), &
     271              :                           enum_i_vals=(/add_last_no, add_last_numeric, add_last_symbolic/), &
     272              :                           enum_desc=s2a("Do not mark last iteration specifically", &
     273              :                                         "Mark last iteration with its iteration number", &
     274              :                                         "Mark last iteration with lowercase letter l"), &
     275      6480580 :                           default_i_val=my_add_last)
     276      6480580 :       CALL section_add_keyword(print_key_section, keyword)
     277      6480580 :       CALL keyword_release(keyword)
     278              : 
     279      6480580 :       my_comm_iter_levels = 0
     280      6480580 :       IF (PRESENT(common_iter_levels)) my_comm_iter_levels = common_iter_levels
     281              :       CALL keyword_create(keyword, __LOCATION__, name="COMMON_ITERATION_LEVELS", &
     282              :                           description="How many iterations levels should be written"// &
     283              :                           " in the same file (no extra information about the actual"// &
     284              :                           " iteration level is written to the file)", &
     285              :                           usage="COMMON_ITERATION_LEVELS <INTEGER>", &
     286      6480580 :                           default_i_val=my_comm_iter_levels)
     287      6480580 :       CALL section_add_keyword(print_key_section, keyword)
     288      6480580 :       CALL keyword_release(keyword)
     289              : 
     290      6480580 :       my_filename = ""
     291      6480580 :       IF (PRESENT(filename)) my_filename = filename
     292              :       CALL keyword_create(keyword, __LOCATION__, name="FILENAME", &
     293              :                           description=' controls part of the filename for output. '// &
     294              :                           ' use __STD_OUT__ (exactly as written here) for the screen or standard logger. '// &
     295              :                           ' use filename to obtain projectname-filename. '// &
     296              :                           ' use ./filename to get filename.'// &
     297              :                           ' A middle name (if present), iteration numbers'// &
     298              :                           ' and extension are always added to the filename.'// &
     299              :                           ' if you want to avoid it use =filename, in this'// &
     300              :                           ' case the filename is always exactly as typed.'// &
     301              :                           ' Please note that this can lead to clashes of'// &
     302              :                           ' filenames.', &
     303              :                           usage="FILENAME ./filename ", &
     304      6480580 :                           default_lc_val=my_filename)
     305      6480580 :       CALL section_add_keyword(print_key_section, keyword)
     306      6480580 :       CALL keyword_release(keyword)
     307              : 
     308              :       CALL keyword_create(keyword, __LOCATION__, name="LOG_PRINT_KEY", &
     309              :                           description="This keywords enables the logger for the print_key (a message is printed on "// &
     310              :                           "screen everytime data, controlled by this print_key, are written)", &
     311      6480580 :                           usage="LOG_PRINT_KEY <LOGICAL>", default_l_val=.FALSE., lone_keyword_l_val=.TRUE.)
     312      6480580 :       CALL section_add_keyword(print_key_section, keyword)
     313      6480580 :       CALL keyword_release(keyword)
     314              : 
     315      6480580 :       IF (PRESENT(unit_str)) THEN
     316              :          CALL keyword_create(keyword, __LOCATION__, name="UNIT", &
     317              :                              description='Specify the unit of measurement for the quantity in output. '// &
     318              :                              "All available CP2K units can be used.", &
     319       332770 :                              usage="UNIT angstrom", default_c_val=TRIM(unit_str))
     320       332770 :          CALL section_add_keyword(print_key_section, keyword)
     321       332770 :          CALL keyword_release(keyword)
     322              :       END IF
     323      6480580 :    END SUBROUTINE cp_print_key_section_create
     324              : 
     325              : ! **************************************************************************************************
     326              : !> \brief returns what should be done with the given property
     327              : !>      if btest(res,cp_p_store) then the property should be stored in memory
     328              : !>      if btest(res,cp_p_file) then the property should be print ed to a file
     329              : !>      if res==0 then nothing should be done
     330              : !> \param iteration_info information about the actual iteration level
     331              : !> \param basis_section section that contains the printkey
     332              : !> \param print_key_path path to the printkey- "%" between sections, and
     333              : !>        optionally a "/" and a logical flag to check). Might be empty.
     334              : !> \param used_print_key here the print_key that was used is returned
     335              : !> \param first_time if it ist the first time that an output is written
     336              : !>        (not fully correct, but most of the time)
     337              : !> \return ...
     338              : !> \author fawzi
     339              : !> \note
     340              : !>      not all the propreties support can be stored
     341              : ! **************************************************************************************************
     342     16119734 :    FUNCTION cp_print_key_should_output(iteration_info, basis_section, &
     343              :                                        print_key_path, used_print_key, first_time) &
     344              :       RESULT(res)
     345              :       TYPE(cp_iteration_info_type), INTENT(IN)           :: iteration_info
     346              :       TYPE(section_vals_type), INTENT(IN), TARGET        :: basis_section
     347              :       CHARACTER(len=*), INTENT(IN), OPTIONAL             :: print_key_path
     348              :       TYPE(section_vals_type), INTENT(INOUT), OPTIONAL, &
     349              :          POINTER                                         :: used_print_key
     350              :       LOGICAL, INTENT(OUT), OPTIONAL                     :: first_time
     351              :       INTEGER                                            :: res
     352              : 
     353              :       INTEGER                                            :: end_str, my_control_val, to_path
     354              :       LOGICAL                                            :: flags, is_iter, is_on
     355              :       TYPE(section_vals_type), POINTER                   :: print_key
     356              : 
     357      8656481 :       res = 0
     358      8656481 :       IF (PRESENT(first_time)) first_time = .FALSE.
     359      8656481 :       CPASSERT(basis_section%ref_count > 0)
     360      8656481 :       IF (PRESENT(used_print_key)) NULLIFY (used_print_key)
     361              : 
     362      8656481 :       IF (PRESENT(print_key_path)) THEN
     363      8009898 :          end_str = LEN_TRIM(print_key_path)
     364      8009898 :          to_path = INDEX(print_key_path, "/")
     365      8009898 :          IF (to_path < 1) THEN
     366      6544387 :             to_path = end_str + 1
     367              :          END IF
     368              : 
     369      8009898 :          IF (to_path > 1) THEN
     370              :             print_key => section_vals_get_subs_vals(basis_section, &
     371      7825021 :                                                     print_key_path(1:(to_path - 1)))
     372              :          ELSE
     373       184877 :             print_key => basis_section
     374              :          END IF
     375      8009898 :          CPASSERT(ASSOCIATED(print_key))
     376      8009898 :          CPASSERT(print_key%ref_count > 0)
     377      8009898 :          IF (to_path + 1 < end_str) THEN
     378              :             CALL section_vals_val_get(print_key, print_key_path((to_path + 1):end_str), &
     379      1465511 :                                       l_val=flags)
     380              :          ELSE
     381      6544387 :             flags = .TRUE.
     382              :          END IF
     383              :       ELSE
     384       646583 :          print_key => basis_section
     385       646583 :          flags = .TRUE.
     386              :       END IF
     387      8656481 :       IF (PRESENT(used_print_key)) used_print_key => print_key
     388              : 
     389      8656481 :       IF (.NOT. flags) RETURN
     390              : 
     391              :       CALL section_vals_val_get(print_key, "__CONTROL_VAL", &
     392      7463253 :                                 i_val=my_control_val)
     393      7463253 :       is_on = cp_printkey_is_on(iteration_info, print_key)
     394              : 
     395              :       ! a shortcut for most common case
     396      7463253 :       IF (my_control_val == cp_out_default .AND. .NOT. is_on) RETURN
     397              : 
     398      2237614 :       is_iter = cp_printkey_is_iter(iteration_info, print_key, first_time=first_time)
     399              : 
     400      2237614 :       IF (BTEST(my_control_val, cp_p_store)) THEN
     401              :          res = IBSET(res, cp_p_store)
     402      2237614 :       ELSE IF (BTEST(my_control_val, cp_p_store_if) .AND. is_iter .AND. is_on) THEN
     403              :          res = IBSET(res, cp_p_store)
     404      2237614 :       ELSE IF (BTEST(my_control_val, cp_p_store_each) .AND. is_iter) THEN
     405            0 :          res = IBSET(res, cp_p_store)
     406              :       END IF
     407              : 
     408      2237614 :       IF (BTEST(my_control_val, cp_p_file)) THEN
     409            0 :          res = IBSET(res, cp_p_file)
     410      2237614 :       ELSE IF (BTEST(my_control_val, cp_p_file_if) .AND. is_iter .AND. is_on) THEN
     411      1809490 :          res = IBSET(res, cp_p_file)
     412       428124 :       ELSE IF (BTEST(my_control_val, cp_p_file_each) .AND. is_iter) THEN
     413            0 :          res = IBSET(res, cp_p_file)
     414              :       END IF
     415      2237614 :       IF (BTEST(my_control_val, cp_p_calc) .OR. res /= 0) THEN
     416      1809490 :          res = IBSET(res, cp_p_calc)
     417              :       END IF
     418              :    END FUNCTION cp_print_key_should_output
     419              : 
     420              : ! **************************************************************************************************
     421              : !> \brief returns true if the printlevel activates this printkey
     422              : !>      does not look if this iteration it should be printed
     423              : !> \param iteration_info information about the actual iteration level
     424              : !> \param print_key the section values of the key to be printed
     425              : !> \return ...
     426              : !> \author fawzi
     427              : ! **************************************************************************************************
     428      7470719 :    FUNCTION cp_printkey_is_on(iteration_info, print_key) RESULT(res)
     429              :       TYPE(cp_iteration_info_type), INTENT(IN)           :: iteration_info
     430              :       TYPE(section_vals_type), POINTER                   :: print_key
     431              :       LOGICAL                                            :: res
     432              : 
     433              :       INTEGER                                            :: print_level
     434              : 
     435      7470719 :       CPASSERT(iteration_info%ref_count > 0)
     436      7470719 :       IF (.NOT. ASSOCIATED(print_key)) THEN
     437            0 :          res = (iteration_info%print_level > debug_print_level)
     438              :       ELSE
     439      7470719 :          CPASSERT(print_key%ref_count > 0)
     440      7470719 :          CALL section_vals_val_get(print_key, "_SECTION_PARAMETERS_", i_val=print_level)
     441      7470719 :          res = iteration_info%print_level >= print_level
     442              :       END IF
     443      7470719 :    END FUNCTION cp_printkey_is_on
     444              : 
     445              : ! **************************************************************************************************
     446              : !> \brief returns if the actual iteration matches those selected by the
     447              : !>      given printkey. Does not check it the prinkey is active (at the
     448              : !>      actual print_level)
     449              : !> \param iteration_info information about the actual iteration level
     450              : !> \param print_key the section values of the key to be printed
     451              : !> \param first_time returns if it is the first time that output is written
     452              : !>        (not fully correct, but most of the time)
     453              : !> \return ...
     454              : !> \author fawzi
     455              : ! **************************************************************************************************
     456      2237614 :    FUNCTION cp_printkey_is_iter(iteration_info, print_key, first_time) &
     457              :       RESULT(res)
     458              :       TYPE(cp_iteration_info_type), INTENT(IN)           :: iteration_info
     459              :       TYPE(section_vals_type), POINTER                   :: print_key
     460              :       LOGICAL, INTENT(OUT), OPTIONAL                     :: first_time
     461              :       LOGICAL                                            :: res
     462              : 
     463              :       INTEGER                                            :: add_last, ilevel, iter_nr, ival
     464              :       LOGICAL                                            :: first, level_passed
     465              : 
     466      2237614 :       CPASSERT(iteration_info%ref_count > 0)
     467      2237614 :       IF (.NOT. ASSOCIATED(print_key)) THEN
     468            0 :          res = (iteration_info%print_level > debug_print_level)
     469            0 :          first = ALL(iteration_info%iteration(1:iteration_info%n_rlevel) == 1)
     470              :       ELSE
     471      2237614 :          CPASSERT(print_key%ref_count > 0)
     472      2237614 :          res = .FALSE.
     473      2237614 :          first = .FALSE.
     474      2237614 :          CALL section_vals_val_get(print_key, "ADD_LAST", i_val=add_last)
     475      2237614 :          res = .TRUE.
     476      2237614 :          first = .TRUE.
     477      6592052 :          DO ilevel = 1, iteration_info%n_rlevel
     478      4354438 :             level_passed = .FALSE.
     479              :             CALL section_vals_val_get(print_key, "EACH%"//TRIM(iteration_info%level_name(ilevel)), &
     480      4354438 :                                       i_val=ival)
     481      4354438 :             IF (ival > 0) THEN
     482      4329096 :                iter_nr = iteration_info%iteration(ilevel)
     483      4329096 :                IF (iter_nr/ival > 1) first = .FALSE.
     484      4329096 :                IF (MODULO(iter_nr, ival) == 0) THEN
     485      3628767 :                   level_passed = .TRUE.
     486              :                END IF
     487              :             END IF
     488      4354438 :             IF (add_last == add_last_numeric .OR. add_last == add_last_symbolic) THEN
     489      2327155 :                IF (iteration_info%last_iter(ilevel)) THEN
     490              :                   level_passed = .TRUE.
     491              :                END IF
     492              :             END IF
     493      6447070 :             IF (.NOT. level_passed) res = .FALSE.
     494              :          END DO
     495              :       END IF
     496      2237614 :       first = first .AND. res
     497      2237614 :       IF (PRESENT(first_time)) first_time = first
     498      2237614 :    END FUNCTION cp_printkey_is_iter
     499              : 
     500              : ! **************************************************************************************************
     501              : !> \brief returns the iteration string, a string that is useful to create
     502              : !>      unique filenames (once you trim it)
     503              : !> \param iter_info the iteration info from where to take the iteration
     504              : !>        number
     505              : !> \param print_key the print key to optionally show the last iteration
     506              : !>        symbolically
     507              : !> \param for_file if the string is to be used for file generation
     508              : !>        (and should consequently ignore some iteration levels depending
     509              : !>        on COMMON_ITERATION_LEVELS).
     510              : !>        Defaults to false.
     511              : !> \return ...
     512              : !> \author fawzi
     513              : !> \note
     514              : !>      If the root level is 1 removes it
     515              : ! **************************************************************************************************
     516        99109 :    FUNCTION cp_iter_string(iter_info, print_key, for_file) RESULT(res)
     517              :       TYPE(cp_iteration_info_type), POINTER              :: iter_info
     518              :       TYPE(section_vals_type), OPTIONAL, POINTER         :: print_key
     519              :       LOGICAL, INTENT(IN), OPTIONAL                      :: for_file
     520              :       CHARACTER(len=default_string_length)               :: res
     521              : 
     522              :       INTEGER                                            :: add_last, c_i_level, ilevel, n_rlevel, &
     523              :                                                             s_level
     524              :       LOGICAL                                            :: my_for_file
     525              :       TYPE(section_vals_type), POINTER                   :: my_print_key
     526              : 
     527        99109 :       res = ""
     528        99109 :       my_for_file = .FALSE.
     529        99109 :       IF (PRESENT(for_file)) my_for_file = for_file
     530        99109 :       CPASSERT(ASSOCIATED(iter_info))
     531        99109 :       CPASSERT(iter_info%ref_count > 0)
     532        99109 :       NULLIFY (my_print_key)
     533        99109 :       IF (PRESENT(print_key)) my_print_key => print_key
     534        99109 :       s_level = 1
     535        97750 :       IF (ASSOCIATED(my_print_key)) THEN
     536        97750 :          CALL section_vals_val_get(my_print_key, "ADD_LAST", i_val=add_last)
     537        97750 :          CALL section_vals_val_get(my_print_key, "COMMON_ITERATION_LEVELS", i_val=c_i_level)
     538        97750 :          n_rlevel = iter_info%n_rlevel
     539        97750 :          IF (my_for_file) n_rlevel = MIN(n_rlevel, MAX(0, n_rlevel - c_i_level))
     540       174571 :          DO ilevel = s_level, n_rlevel
     541       174571 :             IF (iter_info%last_iter(ilevel)) THEN
     542          691 :                IF (add_last == add_last_symbolic) THEN
     543            0 :                   WRITE (res(9*ilevel - 8:9*ilevel), "('l_')")
     544              :                ELSE
     545          691 :                   WRITE (res(9*ilevel - 8:9*ilevel), "(i8,'_')") iter_info%iteration(ilevel)
     546              :                END IF
     547              :             ELSE
     548        76130 :                WRITE (res(9*ilevel - 8:9*ilevel), "(i8,'_')") iter_info%iteration(ilevel)
     549              :             END IF
     550              :          END DO
     551              :       ELSE
     552         3696 :          DO ilevel = s_level, iter_info%n_rlevel
     553         3696 :             WRITE (res(9*ilevel - 8:9*ilevel), "(i8,'_')") iter_info%iteration(ilevel)
     554              :          END DO
     555              :       END IF
     556        99109 :       CALL compress(res, .TRUE.)
     557        99109 :       IF (LEN_TRIM(res) > 0) THEN
     558        72543 :          res(LEN_TRIM(res):LEN_TRIM(res)) = " "
     559              :       END IF
     560        99109 :    END FUNCTION cp_iter_string
     561              : 
     562              : ! **************************************************************************************************
     563              : !> \brief adds one to the actual iteration
     564              : !> \param iteration_info the iteration info to update
     565              : !> \param last if this iteration is the last one (defaults to false)
     566              : !> \param iter_nr ...
     567              : !> \param increment ...
     568              : !> \param iter_nr_out ...
     569              : !> \author fawzi
     570              : !> \note
     571              : !>      this is supposed to be called at the beginning of each iteration
     572              : ! **************************************************************************************************
     573       285043 :    SUBROUTINE cp_iterate(iteration_info, last, iter_nr, increment, iter_nr_out)
     574              :       TYPE(cp_iteration_info_type), POINTER              :: iteration_info
     575              :       LOGICAL, INTENT(IN), OPTIONAL                      :: last
     576              :       INTEGER, INTENT(IN), OPTIONAL                      :: iter_nr, increment
     577              :       INTEGER, INTENT(OUT), OPTIONAL                     :: iter_nr_out
     578              : 
     579              :       INTEGER                                            :: my_increment
     580              :       LOGICAL                                            :: my_last
     581              : 
     582       285043 :       my_last = .FALSE.
     583       285043 :       my_increment = 1
     584       285043 :       IF (PRESENT(last)) my_last = last
     585       285043 :       IF (PRESENT(increment)) my_increment = increment
     586       285043 :       IF (PRESENT(iter_nr_out)) iter_nr_out = -1
     587              : 
     588       285043 :       CPASSERT(ASSOCIATED(iteration_info))
     589       285043 :       CPASSERT(iteration_info%ref_count > 0)
     590       285043 :       IF (PRESENT(iter_nr)) THEN
     591       246635 :          iteration_info%iteration(iteration_info%n_rlevel) = iter_nr
     592              :       ELSE
     593              :          iteration_info%iteration(iteration_info%n_rlevel) = &
     594        38408 :             iteration_info%iteration(iteration_info%n_rlevel) + my_increment
     595              :       END IF
     596              :       ! If requested provide the value of the iteration level
     597       285043 :       IF (PRESENT(iter_nr_out)) iter_nr_out = iteration_info%iteration(iteration_info%n_rlevel)
     598              : 
     599              :       ! Possibly setup the LAST flag
     600       285043 :       iteration_info%last_iter(iteration_info%n_rlevel) = my_last
     601       285043 :    END SUBROUTINE cp_iterate
     602              : 
     603              : ! **************************************************************************************************
     604              : !> \brief Return the index of an iteration level by its name.
     605              : !> \param iteration_info the iteration info to query
     606              : !> \param level_name     level name to query.
     607              : !> \return iteration level index or 0 if there is no such level
     608              : !> \author Sergey Chulkov
     609              : ! **************************************************************************************************
     610            0 :    FUNCTION cp_get_iter_level_by_name(iteration_info, level_name) RESULT(rlevel)
     611              :       TYPE(cp_iteration_info_type), INTENT(IN), POINTER  :: iteration_info
     612              :       CHARACTER(LEN=*), INTENT(IN)                       :: level_name
     613              :       INTEGER                                            :: rlevel
     614              : 
     615            0 :       CPASSERT(ASSOCIATED(iteration_info))
     616            0 :       CPASSERT(iteration_info%ref_count > 0)
     617            0 :       DO rlevel = iteration_info%n_rlevel, 1, -1
     618            0 :          IF (iteration_info%level_name(rlevel) == level_name) EXIT
     619              :       END DO
     620              : 
     621            0 :    END FUNCTION cp_get_iter_level_by_name
     622              : 
     623              : ! **************************************************************************************************
     624              : !> \brief Return the current iteration number at a given level.
     625              : !> \param iteration_info the iteration info to query
     626              : !> \param rlevel         index of the iteration level. Use the level on top of the stack,
     627              : !>                       if it is not given
     628              : !> \param iter_nr        iteration number [out]
     629              : !> \param last_iter      last iteration flag [out]
     630              : !> \author Sergey Chulkov
     631              : ! **************************************************************************************************
     632            0 :    SUBROUTINE cp_get_iter_nr(iteration_info, rlevel, iter_nr, last_iter)
     633              :       TYPE(cp_iteration_info_type), INTENT(IN), POINTER  :: iteration_info
     634              :       INTEGER, INTENT(IN), OPTIONAL                      :: rlevel
     635              :       INTEGER, INTENT(OUT), OPTIONAL                     :: iter_nr
     636              :       LOGICAL, INTENT(OUT), OPTIONAL                     :: last_iter
     637              : 
     638              :       INTEGER                                            :: ilevel
     639              : 
     640            0 :       CPASSERT(ASSOCIATED(iteration_info))
     641            0 :       CPASSERT(iteration_info%ref_count > 0)
     642            0 :       IF (PRESENT(rlevel)) THEN
     643            0 :          CPASSERT(rlevel > 0 .AND. rlevel <= iteration_info%n_rlevel)
     644              :          ilevel = rlevel
     645              :       ELSE
     646            0 :          ilevel = iteration_info%n_rlevel
     647              :       END IF
     648              : 
     649            0 :       IF (PRESENT(iter_nr)) iter_nr = iteration_info%iteration(ilevel)
     650            0 :       IF (PRESENT(last_iter)) last_iter = iteration_info%last_iter(ilevel)
     651            0 :    END SUBROUTINE cp_get_iter_nr
     652              : 
     653              : ! **************************************************************************************************
     654              : !> \brief Adds an iteration level
     655              : !> \param iteration_info the iteration info to which an iteration level has
     656              : !>        to be added
     657              : !> \param level_name the name of this level, for pretty printing only, right now
     658              : !> \param n_rlevel_new number of iteration levels after this call
     659              : !> \author fawzi
     660              : ! **************************************************************************************************
     661        40301 :    SUBROUTINE cp_add_iter_level(iteration_info, level_name, n_rlevel_new)
     662              :       TYPE(cp_iteration_info_type), POINTER              :: iteration_info
     663              :       CHARACTER(LEN=*), INTENT(IN)                       :: level_name
     664              :       INTEGER, INTENT(OUT), OPTIONAL                     :: n_rlevel_new
     665              : 
     666              :       INTEGER                                            :: i
     667              :       LOGICAL                                            :: found
     668              : 
     669            0 :       CPASSERT(ASSOCIATED(iteration_info))
     670        40301 :       CPASSERT(iteration_info%ref_count > 0)
     671        40301 :       found = .FALSE.
     672       228615 :       DO i = 1, SIZE(each_possible_labels)
     673       228615 :          IF (TRIM(level_name) == TRIM(each_possible_labels(i))) THEN
     674              :             found = .TRUE.
     675              :             EXIT
     676              :          END IF
     677              :       END DO
     678        40301 :       IF (found) THEN
     679        40301 :          CALL cp_iteration_info_retain(iteration_info)
     680        40301 :          iteration_info%n_rlevel = iteration_info%n_rlevel + 1
     681        40301 :          CALL reallocate(iteration_info%iteration, 1, iteration_info%n_rlevel)
     682        40301 :          CALL reallocate(iteration_info%level_name, 1, iteration_info%n_rlevel)
     683        40301 :          CALL reallocate(iteration_info%last_iter, 1, iteration_info%n_rlevel)
     684        40301 :          iteration_info%iteration(iteration_info%n_rlevel) = 0
     685        40301 :          iteration_info%level_name(iteration_info%n_rlevel) = level_name
     686        40301 :          iteration_info%last_iter(iteration_info%n_rlevel) = .FALSE.
     687        40301 :          IF (PRESENT(n_rlevel_new)) n_rlevel_new = iteration_info%n_rlevel
     688              :       ELSE
     689              :          CALL cp_abort(__LOCATION__, &
     690              :                        "Trying to create an iteration level ("//TRIM(level_name)//") not defined. "// &
     691            0 :                        "Please update the module: cp_iter_types.")
     692              :       END IF
     693              : 
     694        40301 :    END SUBROUTINE cp_add_iter_level
     695              : 
     696              : ! **************************************************************************************************
     697              : !> \brief Removes an iteration level
     698              : !> \param iteration_info the iteration info to which an iteration level has
     699              : !>        to be removed
     700              : !> \param level_name level_name to be destroyed (if does not match gives an error)
     701              : !> \param n_rlevel_att iteration level before the call (to do some checks)
     702              : !> \author fawzi
     703              : ! **************************************************************************************************
     704        40301 :    SUBROUTINE cp_rm_iter_level(iteration_info, level_name, n_rlevel_att)
     705              :       TYPE(cp_iteration_info_type), POINTER              :: iteration_info
     706              :       CHARACTER(LEN=*), INTENT(IN)                       :: level_name
     707              :       INTEGER, INTENT(IN), OPTIONAL                      :: n_rlevel_att
     708              : 
     709              :       LOGICAL                                            :: check
     710              : 
     711        40301 :       CPASSERT(ASSOCIATED(iteration_info))
     712        40301 :       CPASSERT(iteration_info%ref_count > 0)
     713        40301 :       IF (PRESENT(n_rlevel_att)) THEN
     714         5136 :          CPASSERT(n_rlevel_att == iteration_info%n_rlevel)
     715              :       END IF
     716        40301 :       CALL cp_iteration_info_release(iteration_info)
     717              :       ! This check that the iteration levels are consistently created and destroyed..
     718              :       ! Never remove this check..
     719        40301 :       check = iteration_info%level_name(iteration_info%n_rlevel) == level_name
     720        40301 :       CPASSERT(check)
     721        40301 :       iteration_info%n_rlevel = iteration_info%n_rlevel - 1
     722        40301 :       CALL reallocate(iteration_info%iteration, 1, iteration_info%n_rlevel)
     723        40301 :       CALL reallocate(iteration_info%level_name, 1, iteration_info%n_rlevel)
     724        40301 :       CALL reallocate(iteration_info%last_iter, 1, iteration_info%n_rlevel)
     725        40301 :    END SUBROUTINE cp_rm_iter_level
     726              : 
     727              : ! **************************************************************************************************
     728              : !> \brief Utility function that returns a unit number to write the print key.
     729              : !>     Might open a file with a unique filename, generated from
     730              : !>     the print_key name and iteration info.
     731              : !>
     732              : !>     Normally a valid unit (>0) is returned only if cp_print_key_should_output
     733              : !>     says that the print_key should be printed, and if the unit is global
     734              : !>     only the io node has a valid unit.
     735              : !>     So in many cases you can decide if you should print just checking if
     736              : !>     the returned units is bigger than 0.
     737              : !>
     738              : !>     IMPORTANT you should call cp_finished_output when an iteration output is
     739              : !>     finished (to immediately close the file that might have been opened)
     740              : !> \param logger the logger for the parallel environment, iteration info
     741              : !>        and filename generation
     742              : !> \param print_key ...
     743              : !> \param middle_name name to be added to the generated filename, useful when
     744              : !>        print_key activates different distinct outputs, to be able to
     745              : !>        distinguish them
     746              : !> \param extension extension to be applied to the filename (including the ".")
     747              : !> \param my_local if the unit should be local to this task, or global to the
     748              : !>        program (defaults to false).
     749              : !> \return ...
     750              : !> \author Fawzi Mohamed
     751              : ! **************************************************************************************************
     752        98270 :    FUNCTION cp_print_key_generate_filename(logger, print_key, middle_name, extension, &
     753              :                                            my_local) RESULT(filename)
     754              :       TYPE(cp_logger_type), POINTER                      :: logger
     755              :       TYPE(section_vals_type), POINTER                   :: print_key
     756              :       CHARACTER(len=*), INTENT(IN), OPTIONAL             :: middle_name
     757              :       CHARACTER(len=*), INTENT(IN)                       :: extension
     758              :       LOGICAL, INTENT(IN)                                :: my_local
     759              :       CHARACTER(len=default_path_length)                 :: filename
     760              : 
     761              :       CHARACTER(len=default_path_length)                 :: outPath, postfix, root
     762              :       CHARACTER(len=default_string_length)               :: my_middle_name, outName
     763              :       INTEGER                                            :: my_ind1, my_ind2
     764              :       LOGICAL                                            :: has_root
     765              : 
     766        98270 :       CALL section_vals_val_get(print_key, "FILENAME", c_val=outPath)
     767        98270 :       IF (outPath(1:1) == '=') THEN
     768              :          CPASSERT(LEN(outPath) - 1 <= LEN(filename))
     769          581 :          filename = outPath(2:)
     770          581 :          RETURN
     771              :       END IF
     772        97689 :       IF (outPath == "__STD_OUT__") outPath = ""
     773        97689 :       outName = outPath
     774        97689 :       has_root = .FALSE.
     775        97689 :       my_ind1 = INDEX(outPath, "/")
     776        97689 :       my_ind2 = LEN_TRIM(outPath)
     777        97689 :       IF (my_ind1 /= 0) THEN
     778         3725 :          has_root = .TRUE.
     779         3725 :          DO WHILE (INDEX(outPath(my_ind1 + 1:my_ind2), "/") /= 0)
     780         3725 :             my_ind1 = INDEX(outPath(my_ind1 + 1:my_ind2), "/") + my_ind1
     781              :          END DO
     782         3725 :          IF (my_ind1 == my_ind2) THEN
     783            0 :             outName = ""
     784              :          ELSE
     785         3725 :             outName = outPath(my_ind1 + 1:my_ind2)
     786              :          END IF
     787              :       END IF
     788              : 
     789        97689 :       IF (PRESENT(middle_name)) THEN
     790        38704 :          IF (outName /= "") THEN
     791          606 :             my_middle_name = "-"//TRIM(outName)//"-"//middle_name
     792              :          ELSE
     793        38098 :             my_middle_name = "-"//middle_name
     794              :          END IF
     795              :       ELSE
     796        58985 :          IF (outName /= "") THEN
     797        24365 :             my_middle_name = "-"//TRIM(outName)
     798              :          ELSE
     799        34620 :             my_middle_name = ""
     800              :          END IF
     801              :       END IF
     802              : 
     803        97689 :       IF (.NOT. has_root) THEN
     804        93964 :          root = TRIM(logger%iter_info%project_name)//TRIM(my_middle_name)
     805         3725 :       ELSE IF (outName == "") THEN
     806            0 :          root = outPath(1:my_ind1)//TRIM(logger%iter_info%project_name)//TRIM(my_middle_name)
     807              :       ELSE
     808         3725 :          root = outPath(1:my_ind1)//my_middle_name(2:LEN_TRIM(my_middle_name))
     809              :       END IF
     810              : 
     811              :       ! use the cp_iter_string as a postfix
     812        97689 :       postfix = "-"//TRIM(cp_iter_string(logger%iter_info, print_key=print_key, for_file=.TRUE.))
     813        97689 :       IF (TRIM(postfix) == "-") postfix = ""
     814              : 
     815              :       ! and add the extension
     816        97689 :       postfix = TRIM(postfix)//extension
     817              :       ! and let the logger generate the filename
     818              :       CALL cp_logger_generate_filename(logger, res=filename, &
     819        97689 :                                        root=root, postfix=postfix, local=my_local)
     820              : 
     821              :    END FUNCTION cp_print_key_generate_filename
     822              : 
     823              : ! **************************************************************************************************
     824              : !> \brief ...
     825              : !> \param logger ...
     826              : !> \param basis_section ...
     827              : !> \param print_key_path ...
     828              : !> \param extension ...
     829              : !> \param middle_name ...
     830              : !> \param local ...
     831              : !> \param log_filename ...
     832              : !> \param ignore_should_output ...
     833              : !> \param file_form ...
     834              : !> \param file_position ...
     835              : !> \param file_action ...
     836              : !> \param file_status ...
     837              : !> \param do_backup ...
     838              : !> \param on_file ...
     839              : !> \param is_new_file true if this rank created a new (or rewound) file, false otherwise
     840              : !> \param mpi_io True if the file should be opened in parallel on all processors belonging to
     841              : !>               the communicator group. Automatically disabled if the file form or access mode
     842              : !>               is unsuitable for MPI IO. Return value indicates whether MPI was actually used
     843              : !>               and therefore the flag must also be passed to the file closing directive.
     844              : !> \param fout   Name of the actual file where the output will be written. Needed mainly for MPI IO
     845              : !>               because inquiring the filename from the MPI filehandle does not work across
     846              : !>               all MPI libraries.
     847              : !> \return ...
     848              : ! **************************************************************************************************
     849      2810802 :    FUNCTION cp_print_key_unit_nr(logger, basis_section, print_key_path, extension, &
     850              :                                  middle_name, local, log_filename, ignore_should_output, file_form, file_position, &
     851              :                                  file_action, file_status, do_backup, on_file, is_new_file, mpi_io, &
     852              :                                  fout) RESULT(res)
     853              :       TYPE(cp_logger_type), POINTER                      :: logger
     854              :       TYPE(section_vals_type), INTENT(IN)                :: basis_section
     855              :       CHARACTER(len=*), INTENT(IN), OPTIONAL             :: print_key_path
     856              :       CHARACTER(len=*), INTENT(IN)                       :: extension
     857              :       CHARACTER(len=*), INTENT(IN), OPTIONAL             :: middle_name
     858              :       LOGICAL, INTENT(IN), OPTIONAL                      :: local, log_filename, ignore_should_output
     859              :       CHARACTER(len=*), INTENT(IN), OPTIONAL             :: file_form, file_position, file_action, &
     860              :                                                             file_status
     861              :       LOGICAL, INTENT(IN), OPTIONAL                      :: do_backup, on_file
     862              :       LOGICAL, INTENT(OUT), OPTIONAL                     :: is_new_file
     863              :       LOGICAL, INTENT(INOUT), OPTIONAL                   :: mpi_io
     864              :       CHARACTER(len=default_path_length), INTENT(OUT), &
     865              :          OPTIONAL                                        :: fout
     866              :       INTEGER                                            :: res
     867              : 
     868              :       CHARACTER(len=default_path_length)                 :: filename, filename_bak, filename_bak_1, &
     869              :                                                             filename_bak_2
     870              :       CHARACTER(len=default_string_length)               :: my_file_action, my_file_form, &
     871              :                                                             my_file_position, my_file_status, &
     872              :                                                             outPath
     873              :       INTEGER                                            :: c_i_level, f_backup_level, i, mpi_amode, &
     874              :                                                             my_backup_level, my_nbak, nbak, &
     875              :                                                             s_backup_level, unit_nr
     876              :       LOGICAL                                            :: do_log, found, my_do_backup, my_local, &
     877              :                                                             my_mpi_io, my_on_file, &
     878              :                                                             my_should_output, replace
     879              :       TYPE(cp_iteration_info_type), POINTER              :: iteration_info
     880              :       TYPE(mp_file_type)                                 :: mp_unit
     881              :       TYPE(section_vals_type), POINTER                   :: print_key
     882              : 
     883      2810802 :       my_local = .FALSE.
     884      2810802 :       my_do_backup = .FALSE.
     885      2810802 :       my_mpi_io = .FALSE.
     886      2810802 :       replace = .FALSE.
     887      2810802 :       found = .FALSE.
     888      2810802 :       res = -1
     889      2810802 :       my_file_form = "FORMATTED"
     890      2810802 :       my_file_position = "APPEND"
     891      2810802 :       my_file_action = "WRITE"
     892      2810802 :       my_file_status = "UNKNOWN"
     893      2810802 :       my_on_file = .FALSE.
     894      2810802 :       mpi_amode = 0
     895       349604 :       IF (PRESENT(file_form)) my_file_form = file_form
     896      2810802 :       IF (PRESENT(file_position)) my_file_position = file_position
     897      2810802 :       IF (PRESENT(file_action)) my_file_action = file_action
     898      2810802 :       IF (PRESENT(file_status)) my_file_status = file_status
     899      2810802 :       IF (PRESENT(do_backup)) my_do_backup = do_backup
     900      2810802 :       IF (PRESENT(on_file)) my_on_file = on_file
     901      2810802 :       IF (PRESENT(local)) my_local = local
     902      2810802 :       IF (PRESENT(is_new_file)) is_new_file = .FALSE.
     903      2810802 :       IF (PRESENT(mpi_io)) THEN
     904              : #if defined(__parallel)
     905         2010 :          IF (cp_mpi_io_get() .AND. logger%para_env%num_pe > 1 .AND. mpi_io) THEN
     906              :             my_mpi_io = .TRUE.
     907              :          ELSE
     908              :             my_mpi_io = .FALSE.
     909              :          END IF
     910              :          IF (my_mpi_io) THEN
     911              :             CALL mp_file_get_amode(mpi_io, replace, mpi_amode, TRIM(my_file_form), &
     912         2010 :                                    TRIM(my_file_action), TRIM(my_file_status), TRIM(my_file_position))
     913         3858 :             replace = replace .AND. logger%para_env%is_source()
     914              :          END IF
     915              : #else
     916              :          my_mpi_io = .FALSE.
     917              : #endif
     918              :          ! Set return value
     919         2010 :          mpi_io = my_mpi_io
     920              :       END IF
     921      2810802 :       NULLIFY (print_key)
     922      2810802 :       CPASSERT(ASSOCIATED(logger))
     923      2810802 :       CPASSERT(basis_section%ref_count > 0)
     924      2810802 :       CPASSERT(logger%ref_count > 0)
     925              :       my_should_output = BTEST(cp_print_key_should_output(logger%iter_info, &
     926      2817007 :                                                           basis_section, print_key_path, used_print_key=print_key), cp_p_file)
     927      2810802 :       IF (PRESENT(ignore_should_output)) my_should_output = my_should_output .OR. ignore_should_output
     928      2801422 :       IF (.NOT. my_should_output) RETURN
     929              :       IF (my_local .OR. &
     930       879755 :           logger%para_env%is_source() .OR. &
     931              :           my_mpi_io) THEN
     932              : 
     933       459376 :          CALL section_vals_val_get(print_key, "FILENAME", c_val=outPath)
     934       459376 :          IF (outPath == '__STD_OUT__' .AND. .NOT. my_on_file) THEN
     935       369191 :             res = cp_logger_get_default_unit_nr(logger, local=my_local)
     936              :          ELSE
     937              :             !
     938              :             ! complex logic to build filename:
     939              :             !   1)  Try to avoid '--' and '-.'
     940              :             !   2)  If outPath contains '/' (as in ./filename) do not prepend the project_name
     941              :             !
     942              :             ! if it is actually a full path, use it as the root
     943              :             filename = cp_print_key_generate_filename(logger, print_key, middle_name, extension, &
     944       147415 :                                                       my_local)
     945              :             ! Give back info about a possible existence of the file if required
     946        90185 :             IF (PRESENT(is_new_file)) THEN
     947        49480 :                INQUIRE (FILE=filename, EXIST=found)
     948        49480 :                is_new_file = .NOT. found
     949        49480 :                IF (my_file_position == "REWIND") is_new_file = .TRUE.
     950              :             END IF
     951              :             ! Check is we have to log any operation performed on the file..
     952              :             do_log = .FALSE.
     953        90185 :             IF (PRESENT(log_filename)) THEN
     954         2240 :                do_log = log_filename
     955              :             ELSE
     956        87945 :                CALL section_vals_val_get(print_key, "LOG_PRINT_KEY", l_val=do_log)
     957              :             END IF
     958              :             ! If required do a backup
     959        90185 :             IF (my_do_backup) THEN
     960        17497 :                INQUIRE (FILE=filename, EXIST=found)
     961        17497 :                CALL section_vals_val_get(print_key, "BACKUP_COPIES", i_val=nbak)
     962        17497 :                IF (nbak /= 0) THEN
     963        14773 :                   iteration_info => logger%iter_info
     964        14773 :                   s_backup_level = 0
     965        14773 :                   IF (ASSOCIATED(print_key%ibackup)) s_backup_level = SIZE(print_key%ibackup)
     966        14773 :                   CALL section_vals_val_get(print_key, "COMMON_ITERATION_LEVELS", i_val=c_i_level)
     967        14773 :                   my_backup_level = MAX(1, iteration_info%n_rlevel - c_i_level + 1)
     968        14773 :                   f_backup_level = MAX(s_backup_level, my_backup_level)
     969        14773 :                   IF (f_backup_level > s_backup_level) THEN
     970         3828 :                      CALL reallocate(print_key%ibackup, 1, f_backup_level)
     971         8967 :                      DO i = s_backup_level + 1, f_backup_level
     972         8967 :                         print_key%ibackup(i) = 0
     973              :                      END DO
     974              :                   END IF
     975        14773 :                   IF (found) THEN
     976        12118 :                      print_key%ibackup(my_backup_level) = print_key%ibackup(my_backup_level) + 1
     977        12118 :                      my_nbak = print_key%ibackup(my_backup_level)
     978              :                      ! Recent backup copies correspond to lower backup indexes
     979        12130 :                      DO i = MIN(nbak, my_nbak), 2, -1
     980           12 :                         filename_bak_1 = TRIM(filename)//".bak-"//ADJUSTL(cp_to_string(i))
     981           12 :                         filename_bak_2 = TRIM(filename)//".bak-"//ADJUSTL(cp_to_string(i - 1))
     982           12 :                         IF (do_log) THEN
     983           12 :                            unit_nr = cp_logger_get_unit_nr(logger, local=my_local)
     984           12 :                            IF (unit_nr > 0) &
     985              :                               WRITE (unit_nr, *) "Moving file "//TRIM(filename_bak_2)// &
     986           12 :                               " into file "//TRIM(filename_bak_1)//"."
     987              :                         END IF
     988           12 :                         INQUIRE (FILE=filename_bak_2, EXIST=found)
     989        12130 :                         IF (.NOT. found) THEN
     990            0 :                            IF (do_log) THEN
     991            0 :                               unit_nr = cp_logger_get_unit_nr(logger, local=my_local)
     992            0 :                               IF (unit_nr > 0) &
     993            0 :                                  WRITE (unit_nr, *) "File "//TRIM(filename_bak_2)//" not existing.."
     994              :                            END IF
     995              :                         ELSE
     996           12 :                            CALL m_mov(TRIM(filename_bak_2), TRIM(filename_bak_1))
     997              :                         END IF
     998              :                      END DO
     999              :                      ! The last backup is always the one with index 1
    1000        12118 :                      filename_bak = TRIM(filename)//".bak-"//ADJUSTL(cp_to_string(1))
    1001        12118 :                      IF (do_log) THEN
    1002           95 :                         unit_nr = cp_logger_get_unit_nr(logger, local=my_local)
    1003           95 :                         IF (unit_nr > 0) &
    1004           95 :                            WRITE (unit_nr, *) "Moving file "//TRIM(filename)//" into file "//TRIM(filename_bak)//"."
    1005              :                      END IF
    1006        12118 :                      CALL m_mov(TRIM(filename), TRIM(filename_bak))
    1007              :                   ELSE
    1008              :                      ! Zero the backup history for this new iteration level..
    1009         2655 :                      print_key%ibackup(my_backup_level) = 0
    1010              :                   END IF
    1011              :                END IF
    1012              :             END IF
    1013              : 
    1014        90185 :             IF (.NOT. my_mpi_io) THEN
    1015              :                CALL open_file(file_name=filename, file_status=my_file_status, &
    1016              :                               file_form=my_file_form, file_action=my_file_action, &
    1017        88175 :                               file_position=my_file_position, unit_number=res)
    1018              :             ELSE
    1019         2010 :                IF (replace) CALL mp_file_delete(filename)
    1020              :                CALL mp_unit%open(groupid=logger%para_env, &
    1021         2010 :                                  filepath=filename, amode_status=mpi_amode)
    1022         2010 :                IF (PRESENT(fout)) fout = filename
    1023         2010 :                res = mp_unit%get_handle()
    1024              :             END IF
    1025        90185 :             IF (do_log) THEN
    1026          105 :                unit_nr = cp_logger_get_unit_nr(logger, local=my_local)
    1027          105 :                IF (unit_nr > 0) &
    1028              :                   WRITE (unit_nr, *) "Writing "//TRIM(print_key%section%name)//" "// &
    1029              :                   TRIM(cp_iter_string(logger%iter_info))//" to "// &
    1030          105 :                   TRIM(filename)
    1031              :             END IF
    1032              :          END IF
    1033              :       ELSE
    1034       420379 :          res = -1
    1035              :       END IF
    1036      3690557 :    END FUNCTION cp_print_key_unit_nr
    1037              : 
    1038              : ! **************************************************************************************************
    1039              : !> \brief should be called after you finish working with a unit obtained with
    1040              : !>      cp_print_key_unit_nr, so that the file that might have been opened
    1041              : !>      can be closed.
    1042              : !>
    1043              : !>      the inputs should be exactly the same of the corresponding
    1044              : !>      cp_print_key_unit_nr
    1045              : !> \param unit_nr ...
    1046              : !> \param logger ...
    1047              : !> \param basis_section ...
    1048              : !> \param print_key_path ...
    1049              : !> \param local ...
    1050              : !> \param ignore_should_output ...
    1051              : !> \param on_file ...
    1052              : !> \param mpi_io True if file was opened in parallel with MPI
    1053              : !> \par History
    1054              : !>      08.2002 created [fawzi]
    1055              : !> \author Fawzi Mohamed
    1056              : !> \note
    1057              : !>      closes if the corresponding filename of the printkey is
    1058              : !>      not __STD_OUT__
    1059              : ! **************************************************************************************************
    1060      2672109 :    SUBROUTINE cp_print_key_finished_output(unit_nr, logger, basis_section, &
    1061              :                                            print_key_path, local, ignore_should_output, on_file, &
    1062              :                                            mpi_io)
    1063              :       INTEGER, INTENT(INOUT)                             :: unit_nr
    1064              :       TYPE(cp_logger_type), POINTER                      :: logger
    1065              :       TYPE(section_vals_type), INTENT(IN)                :: basis_section
    1066              :       CHARACTER(len=*), INTENT(IN), OPTIONAL             :: print_key_path
    1067              :       LOGICAL, INTENT(IN), OPTIONAL                      :: local, ignore_should_output, on_file, &
    1068              :                                                             mpi_io
    1069              : 
    1070              :       CHARACTER(len=default_string_length)               :: outPath
    1071              :       LOGICAL                                            :: my_local, my_mpi_io, my_on_file, &
    1072              :                                                             my_should_output
    1073              :       TYPE(mp_file_type)                                 :: mp_unit
    1074              :       TYPE(section_vals_type), POINTER                   :: print_key
    1075              : 
    1076      2672109 :       my_local = .FALSE.
    1077      2672109 :       my_on_file = .FALSE.
    1078      2672109 :       my_mpi_io = .FALSE.
    1079      2672109 :       NULLIFY (print_key)
    1080         2418 :       IF (PRESENT(local)) my_local = local
    1081      2672109 :       IF (PRESENT(on_file)) my_on_file = on_file
    1082      2672109 :       IF (PRESENT(mpi_io)) my_mpi_io = mpi_io
    1083      2672109 :       CPASSERT(ASSOCIATED(logger))
    1084      2672109 :       CPASSERT(basis_section%ref_count > 0)
    1085      2672109 :       CPASSERT(logger%ref_count > 0)
    1086              :       my_should_output = BTEST(cp_print_key_should_output(logger%iter_info, basis_section, &
    1087      2701352 :                                                           print_key_path, used_print_key=print_key), cp_p_file)
    1088      2672109 :       IF (PRESENT(ignore_should_output)) my_should_output = my_should_output .OR. ignore_should_output
    1089      2672109 :       IF (my_should_output .AND. (my_local .OR. &
    1090              :                                   logger%para_env%is_source() .OR. &
    1091              :                                   my_mpi_io)) THEN
    1092       394149 :          CALL section_vals_val_get(print_key, "FILENAME", c_val=outPath)
    1093       394149 :          IF (my_on_file .OR. outPath .NE. '__STD_OUT__') THEN
    1094        88242 :             CPASSERT(unit_nr > 0)
    1095        88242 :             IF (.NOT. my_mpi_io) THEN
    1096        86232 :                CALL close_file(unit_nr, "KEEP")
    1097              :             ELSE
    1098         2010 :                CALL mp_unit%set_handle(unit_nr)
    1099         2010 :                CALL mp_unit%close()
    1100              :             END IF
    1101        88242 :             unit_nr = -1
    1102              :          ELSE
    1103       305907 :             unit_nr = -1
    1104              :          END IF
    1105              :       END IF
    1106      2672109 :       CPASSERT(unit_nr == -1)
    1107      2672109 :       unit_nr = -1
    1108      2672109 :    END SUBROUTINE cp_print_key_finished_output
    1109              : 
    1110              : ! **************************************************************************************************
    1111              : !> \brief Sets flag which determines whether or not to use MPI I/O for I/O routines that
    1112              : !>        have been parallized with MPI
    1113              : !> \param flag ...
    1114              : !> \par History
    1115              : !>      09.2018 created [Nico Holmberg]
    1116              : ! **************************************************************************************************
    1117         9835 :    SUBROUTINE cp_mpi_io_set(flag)
    1118              :       LOGICAL, INTENT(IN)                                :: flag
    1119              : 
    1120         9835 :       enable_mpi_io = flag
    1121         9835 :    END SUBROUTINE cp_mpi_io_set
    1122              : 
    1123              : ! **************************************************************************************************
    1124              : !> \brief Gets flag which determines whether or not to use MPI I/O for I/O routines that
    1125              : !>        have been parallized with MPI
    1126              : !> \return ...
    1127              : !> \par History
    1128              : !>      09.2018 created [Nico Holmberg]
    1129              : ! **************************************************************************************************
    1130         2048 :    FUNCTION cp_mpi_io_get() RESULT(flag)
    1131              :       LOGICAL                                            :: flag
    1132              : 
    1133         2048 :       flag = enable_mpi_io
    1134         2048 :    END FUNCTION cp_mpi_io_get
    1135              : 
    1136            0 : END MODULE cp_output_handling
        

Generated by: LCOV version 2.0-1