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
|
