LCOV - code coverage report
Current view: top level - src/input - cp_output_handling.F (source / functions) Hit Total Coverage
Test: CP2K Regtests (git:f515968) Lines: 342 357 95.8 %
Date: 2022-07-03 19:52:34 Functions: 13 14 92.9 %

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

Generated by: LCOV version 1.15