Line data Source code
1 : !--------------------------------------------------------------------------------------------------!
2 : ! CP2K: A general program to perform molecular dynamics simulations !
3 : ! Copyright 2000-2026 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 : iter_notice,&
34 : iter_silent
35 : USE cp_log_handling, ONLY: cp_logger_generate_filename,&
36 : cp_logger_get_default_unit_nr,&
37 : cp_logger_get_unit_nr,&
38 : cp_logger_type,&
39 : cp_to_string
40 : USE input_keyword_types, ONLY: keyword_create,&
41 : keyword_release,&
42 : keyword_type
43 : USE input_section_types, ONLY: section_add_keyword,&
44 : section_add_subsection,&
45 : section_create,&
46 : section_release,&
47 : section_type,&
48 : section_vals_get_subs_vals,&
49 : section_vals_type,&
50 : section_vals_val_get
51 : USE kinds, ONLY: default_path_length,&
52 : default_string_length
53 : USE machine, ONLY: m_mov
54 : USE memory_utilities, ONLY: reallocate
55 : USE message_passing, ONLY: mp_file_delete,&
56 : mp_file_get_amode,&
57 : mp_file_type
58 : USE string_utilities, ONLY: compress,&
59 : newline,&
60 : s2a
61 : #include "../base/base_uses.f90"
62 :
63 : IMPLICIT NONE
64 : PRIVATE
65 :
66 : LOGICAL, PRIVATE, PARAMETER :: debug_this_module = .TRUE.
67 : CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'cp_output_handling'
68 : PUBLIC :: cp_print_key_should_output, cp_iterate, cp_get_iter_level_by_name, cp_get_iter_nr
69 : PUBLIC :: cp_add_iter_level, cp_rm_iter_level
70 : PUBLIC :: cp_iter_string, cp_print_key_section_create
71 : PUBLIC :: cp_print_key_unit_nr, cp_print_key_finished_output
72 : PUBLIC :: cp_print_key_generate_filename, cp_printkey_is_on
73 :
74 : INTEGER, PARAMETER, PUBLIC :: add_last_no = 0, &
75 : add_last_numeric = 1, &
76 : add_last_symbolic = 2
77 : INTEGER, PARAMETER, PUBLIC :: silent_print_level = 0, &
78 : low_print_level = 1, &
79 : medium_print_level = 2, &
80 : high_print_level = 3, &
81 : debug_print_level = 4
82 :
83 : !! flags controlling the printing and storing of a property.
84 : !!
85 : !! cp_out_none: do not calculate the property
86 : !! cp_out_file_if : if the printkey says it calculate and output the property
87 : !! cp_out_store_if : if the printkey says it calculate and store in memory
88 : !! the property
89 : !! cp_out_file_each: calculate and output the property with the same periodicity
90 : !! as said in the printkey (irrespective of the activation of
91 : !! the printkey)
92 : !! cp_out_store_each: calculate and store the property with the same periodicity
93 : !! as said in the printkey (irrespective of the activation of
94 : !! the printkey)
95 : !! cp_out_file: always calculate and output the property
96 : !! cp_out_store: always calculate and store in memory the property
97 : !! cp_out_calc: just calculate the value (independently from the fact that there
98 : !! should be output)
99 : !! cp_out_default: the default value for property flags (cp_out_file_if)
100 : !!
101 : !! this flags can be ior-ed together:
102 : !! ior(cp_out_file_if,cp_out_store_if): if the printkey says it both print
103 : !! and store the property
104 : !!
105 : !! there is no guarantee that a property is not stored if it is not necessary
106 : !! not all printkeys have a control flag
107 : INTEGER, PUBLIC, PARAMETER :: cp_p_file_if = 3, cp_p_store_if = 4, &
108 : cp_p_store = 2, cp_p_file = 1, cp_p_file_each = 5, cp_p_store_each = 6, cp_p_calc = 7
109 : INTEGER, PUBLIC, PARAMETER :: cp_out_none = 0, cp_out_file_if = IBSET(0, cp_p_file_if), &
110 : cp_out_store_if = IBSET(0, cp_p_store_if), cp_out_file = IBSET(0, cp_p_file), &
111 : cp_out_store = IBSET(0, cp_p_store), cp_out_calc = IBSET(0, cp_p_calc), &
112 : cp_out_file_each = IBSET(0, cp_p_file_each), &
113 : cp_out_store_each = IBSET(0, cp_p_store_each), &
114 : cp_out_default = cp_out_file_if
115 :
116 : ! Flag determining if MPI I/O should be enabled for functions that support it
117 : LOGICAL, PRIVATE, SAVE :: enable_mpi_io = .FALSE.
118 : ! Public functions to set/get the flags
119 : PUBLIC :: cp_mpi_io_set, cp_mpi_io_get
120 :
121 : CONTAINS
122 :
123 : ! **************************************************************************************************
124 : !> \brief creates a print_key section
125 : !> \param print_key_section the print key to create
126 : !> \param location from where in the source code cp_print_key_section_create() is called
127 : !> \param name the name of the print key
128 : !> \param description the description of the print key
129 : !> \param print_level print level starting at which the printing takes place
130 : !> (defaults to debug_print_level)
131 : !> \param each_iter_names ...
132 : !> \param each_iter_values ...
133 : !> \param add_last ...
134 : !> \param filename ...
135 : !> \param common_iter_levels ...
136 : !> \param citations ...
137 : !> \param unit_str specifies an unit of measure for output quantity. If not
138 : !> provided the control is totally left to how the output was coded
139 : !> (i.e. USERS have no possibility to change it)
140 : !> \param do_backup if the BACKUP_COPIES keyword should be added to allow for backup
141 : !> \author fawzi
142 : ! **************************************************************************************************
143 1572159 : SUBROUTINE cp_print_key_section_create(print_key_section, location, name, description, &
144 1572159 : print_level, each_iter_names, each_iter_values, add_last, filename, &
145 37119 : common_iter_levels, citations, unit_str, do_backup)
146 : TYPE(section_type), POINTER :: print_key_section
147 : CHARACTER(len=*), INTENT(IN) :: location, name, description
148 : INTEGER, INTENT(IN), OPTIONAL :: print_level
149 : CHARACTER(LEN=*), DIMENSION(:), INTENT(IN), &
150 : OPTIONAL :: each_iter_names
151 : INTEGER, DIMENSION(:), INTENT(IN), OPTIONAL :: each_iter_values
152 : INTEGER, INTENT(IN), OPTIONAL :: add_last
153 : CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: filename
154 : INTEGER, INTENT(IN), OPTIONAL :: common_iter_levels
155 : INTEGER, DIMENSION(:), OPTIONAL :: citations
156 : CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: unit_str
157 : LOGICAL, OPTIONAL :: do_backup
158 :
159 : CHARACTER(len=default_path_length) :: my_filename
160 : INTEGER :: i_each, i_iter, my_add_last, &
161 : my_comm_iter_levels, my_print_level, &
162 : my_value
163 : LOGICAL :: check, ext_each, my_do_backup
164 : TYPE(keyword_type), POINTER :: keyword
165 : TYPE(section_type), POINTER :: subsection
166 :
167 1572159 : CPASSERT(.NOT. ASSOCIATED(print_key_section))
168 1572159 : my_print_level = debug_print_level
169 1572159 : IF (PRESENT(print_level)) my_print_level = print_level
170 1572159 : my_do_backup = .FALSE.
171 1572159 : IF (PRESENT(do_backup)) my_do_backup = do_backup
172 :
173 : CALL section_create(print_key_section, location=location, name=name, description=description, &
174 : n_keywords=2, n_subsections=0, repeats=.FALSE., &
175 3107199 : citations=citations)
176 :
177 1572159 : NULLIFY (keyword, subsection)
178 : CALL keyword_create(keyword, __LOCATION__, name="_SECTION_PARAMETERS_", &
179 : description="Level starting at which this property is printed. "// &
180 : "Printing is activated when the GLOBAL/PRINT_LEVEL of a task is "// &
181 : "higher than or equal to the level as specified here; to override "// &
182 : "this comparison, use ON to always print or OFF to never print. "// &
183 : "Explicitly giving the section without a level or ON or OFF is "// &
184 : "treated as if SILENT is specified, whereas omitting the section "// &
185 : "is treated implicitly using the default value.", &
186 : usage="silent", &
187 : default_i_val=my_print_level, lone_keyword_i_val=silent_print_level, &
188 : enum_c_vals=s2a("on", "off", "silent", "low", "medium", "high", "debug"), &
189 : enum_i_vals=[silent_print_level - 1, debug_print_level + 1, &
190 : silent_print_level, low_print_level, &
191 1572159 : medium_print_level, high_print_level, debug_print_level])
192 1572159 : CALL section_add_keyword(print_key_section, keyword)
193 1572159 : CALL keyword_release(keyword)
194 :
195 : CALL keyword_create(keyword, __LOCATION__, name="__CONTROL_VAL", &
196 : description=' hidden parameter that controls storage, printing,...'// &
197 : ' of the print_key', &
198 1572159 : default_i_val=cp_out_default)
199 1572159 : CALL section_add_keyword(print_key_section, keyword)
200 1572159 : CALL keyword_release(keyword)
201 :
202 : CALL section_create(subsection, __LOCATION__, name="EACH", &
203 : description="This section specifies how often this property is printed. "// &
204 : "Each keyword inside this section is mapping to a specific iteration level and "// &
205 : "the value of each of these keywords is matched with the iteration level during "// &
206 : "the calculation. A value of 0 or negative turns off printing for the iteration "// &
207 : "level. How to handle the last iteration is treated separately in the ADD_LAST "// &
208 : "keyword outside of this section; each iteration level might print the last "// &
209 : "iteration even if the corresponding value is set to 0 or negative. "// &
210 : "If an iteration level is specified that is not present in the flow of "// &
211 : "the calculation, it is just ignored; switch GLOBAL/ITER_LEVEL_VERBOSITY "// &
212 : "to NOTICE or STACK to print information about existing iteration levels.", &
213 : n_keywords=2, n_subsections=0, repeats=.FALSE., &
214 3107199 : citations=citations)
215 :
216 : ! Enforce the presence or absence of both.. or give an error
217 1572159 : check = (PRESENT(each_iter_names)) .EQV. (PRESENT(each_iter_values))
218 1572159 : CPASSERT(check)
219 1572159 : ext_each = (PRESENT(each_iter_names)) .AND. (PRESENT(each_iter_values))
220 :
221 31443180 : DO i_each = 1, SIZE(each_possible_labels)
222 29871021 : my_value = 1
223 29871021 : IF (ext_each) THEN
224 4195884 : check = SUM(INDEX(each_iter_names, each_possible_labels(i_each))) <= 1
225 1611048 : CPASSERT(check)
226 4195884 : DO i_iter = 1, SIZE(each_iter_names)
227 4195884 : IF (INDEX(TRIM(each_iter_names(i_iter)), TRIM(each_possible_labels(i_each))) /= 0) THEN
228 127502 : my_value = each_iter_values(i_iter)
229 : END IF
230 : END DO
231 : END IF
232 : CALL keyword_create(keyword, __LOCATION__, name=TRIM(each_possible_labels(i_each)), &
233 : description=TRIM(each_desc_labels(i_each)), &
234 : usage=TRIM(each_possible_labels(i_each))//" <INTEGER>", &
235 29871021 : default_i_val=my_value)
236 29871021 : CALL section_add_keyword(subsection, keyword)
237 31443180 : CALL keyword_release(keyword)
238 : END DO
239 1572159 : CALL section_add_subsection(print_key_section, subsection)
240 1572159 : CALL section_release(subsection)
241 :
242 1572159 : my_add_last = add_last_no
243 1572159 : IF (PRESENT(add_last)) THEN
244 510516 : my_add_last = add_last
245 : END IF
246 : CALL keyword_create(keyword, __LOCATION__, name="ADD_LAST", &
247 : description="If the last iteration should be added, and if it "// &
248 : "should be marked symbolically (with lowercase letter l) or with "// &
249 : "the iteration number. "// &
250 : "Not every iteration level is able to identify the last iteration "// &
251 : "early enough to be able to output. When this keyword is activated "// &
252 : "all iteration levels are checked for the last iteration step.", &
253 : usage="ADD_LAST (NO|NUMERIC|SYMBOLIC)", &
254 : enum_c_vals=s2a("no", "numeric", "symbolic"), &
255 : enum_i_vals=[add_last_no, add_last_numeric, add_last_symbolic], &
256 : enum_desc=s2a("Do not mark last iteration specifically", &
257 : "Mark last iteration with its iteration number", &
258 : "Mark last iteration with lowercase letter l"), &
259 1572159 : default_i_val=my_add_last)
260 1572159 : CALL section_add_keyword(print_key_section, keyword)
261 1572159 : CALL keyword_release(keyword)
262 :
263 1572159 : my_comm_iter_levels = 0
264 1572159 : IF (PRESENT(common_iter_levels)) my_comm_iter_levels = common_iter_levels
265 : CALL keyword_create(keyword, __LOCATION__, name="COMMON_ITERATION_LEVELS", &
266 : description="How many iteration levels should be written "// &
267 : "in the same file (no extra information about the actual "// &
268 : "iteration level is written to the file). Set to 0 to use "// &
269 : "the current iteration level, 1 to use the next level, ..., "// &
270 : "in the stack of iteration levels (printed by setting the "// &
271 : "GLOBAL/ITER_LEVEL_VERBOSITY to STACK).", &
272 : usage="COMMON_ITERATION_LEVELS <INTEGER>", &
273 1572159 : default_i_val=my_comm_iter_levels)
274 1572159 : CALL section_add_keyword(print_key_section, keyword)
275 1572159 : CALL keyword_release(keyword)
276 :
277 1572159 : my_filename = ""
278 1572159 : IF (PRESENT(filename)) my_filename = filename
279 : CALL keyword_create(keyword, __LOCATION__, name="FILENAME", &
280 : description="Controls part of the filename for output."//newline//newline// &
281 : "* Use `__STD_OUT__` (exactly as written here) for the screen or "// &
282 : "standard logger (stdout)."//newline// &
283 : "* Use `filename` to obtain `projectname-filename` with "// &
284 : "`projectname` defined by &GLOBAL/PROJECT_NAME."//newline// &
285 : "* Use `./filename` to get a filename with a middle name (if present), "// &
286 : "iteration numbers and extension always added to the filename."//newline// &
287 : "* Use `=filename` to get `filename` always exactly as typed, but "// &
288 : "please note that this can lead to clashes of filenames.", &
289 : usage="FILENAME ./filename ", &
290 1572159 : default_lc_val=my_filename)
291 1572159 : CALL section_add_keyword(print_key_section, keyword)
292 1572159 : CALL keyword_release(keyword)
293 :
294 : CALL keyword_create(keyword, __LOCATION__, name="LOG_PRINT_KEY", &
295 : description="This keywords enables the logger for the print_key (a message is printed on "// &
296 : "screen everytime data, controlled by this print_key, are written)", &
297 1572159 : usage="LOG_PRINT_KEY <LOGICAL>", default_l_val=.FALSE., lone_keyword_l_val=.TRUE.)
298 1572159 : CALL section_add_keyword(print_key_section, keyword)
299 1572159 : CALL keyword_release(keyword)
300 :
301 1572159 : IF (PRESENT(unit_str)) THEN
302 : CALL keyword_create(keyword, __LOCATION__, name="UNIT", &
303 : description='Specify the unit of measurement for the quantity in output. '// &
304 : "All available CP2K units can be used.", &
305 52869 : usage="UNIT angstrom", default_c_val=TRIM(unit_str))
306 52869 : CALL section_add_keyword(print_key_section, keyword)
307 52869 : CALL keyword_release(keyword)
308 : END IF
309 :
310 1572159 : IF (my_do_backup) THEN
311 : CALL keyword_create(keyword, __LOCATION__, name="BACKUP_COPIES", &
312 : description="Specifies the maximum number of backup copies preserved "// &
313 : "when iterations will repeatedly print to the same filename. If set to "// &
314 : "N > 0, the files will be automatically rotated by appending a suffix: "// &
315 : "the most recent print is `{filename}` (defined by FILENAME keyword), "// &
316 : "the last one is moved to `{filename}.bak-1`, the second to last moved "// &
317 : "to `{filename}.bak-2`, ..., up to `{filename}.bak-N`. Set to 0 to "// &
318 : "disable backup preservation and rewrite always the same `{filename}`.", &
319 33261 : usage="BACKUP_COPIES {int}", default_i_val=1)
320 33261 : CALL section_add_keyword(print_key_section, keyword)
321 33261 : CALL keyword_release(keyword)
322 : END IF
323 1572159 : END SUBROUTINE cp_print_key_section_create
324 :
325 : ! **************************************************************************************************
326 : !> \brief returns what should be done with the given property
327 : !> if btest(res,cp_p_store) then the property should be stored in memory
328 : !> if btest(res,cp_p_file) then the property should be print ed to a file
329 : !> if res==0 then nothing should be done
330 : !> \param iteration_info information about the actual iteration level
331 : !> \param basis_section section that contains the printkey
332 : !> \param print_key_path path to the printkey- "%" between sections, and
333 : !> optionally a "/" and a logical flag to check). Might be empty.
334 : !> \param used_print_key here the print_key that was used is returned
335 : !> \param first_time if it ist the first time that an output is written
336 : !> (not fully correct, but most of the time)
337 : !> \return ...
338 : !> \author fawzi
339 : !> \note
340 : !> not all the propreties support can be stored
341 : ! **************************************************************************************************
342 19345188 : FUNCTION cp_print_key_should_output(iteration_info, basis_section, &
343 : print_key_path, used_print_key, first_time) &
344 : RESULT(res)
345 : TYPE(cp_iteration_info_type), INTENT(IN) :: iteration_info
346 : TYPE(section_vals_type), INTENT(IN), TARGET :: basis_section
347 : CHARACTER(len=*), INTENT(IN), OPTIONAL :: print_key_path
348 : TYPE(section_vals_type), INTENT(INOUT), OPTIONAL, &
349 : POINTER :: used_print_key
350 : LOGICAL, INTENT(OUT), OPTIONAL :: first_time
351 : INTEGER :: res
352 :
353 : INTEGER :: end_str, my_control_val, to_path
354 : LOGICAL :: flags, is_iter, is_on
355 : TYPE(section_vals_type), POINTER :: print_key
356 :
357 10477533 : res = 0
358 10477533 : IF (PRESENT(first_time)) first_time = .FALSE.
359 10477533 : CPASSERT(basis_section%ref_count > 0)
360 10477533 : IF (PRESENT(used_print_key)) NULLIFY (used_print_key)
361 :
362 10477533 : IF (PRESENT(print_key_path)) THEN
363 9686346 : end_str = LEN_TRIM(print_key_path)
364 9686346 : to_path = INDEX(print_key_path, "/")
365 9686346 : IF (to_path < 1) THEN
366 7694529 : to_path = end_str + 1
367 : END IF
368 :
369 9686346 : IF (to_path > 1) THEN
370 : print_key => section_vals_get_subs_vals(basis_section, &
371 9403905 : print_key_path(1:(to_path - 1)))
372 : ELSE
373 282441 : print_key => basis_section
374 : END IF
375 9686346 : CPASSERT(ASSOCIATED(print_key))
376 9686346 : CPASSERT(print_key%ref_count > 0)
377 9686346 : IF (to_path + 1 < end_str) THEN
378 : CALL section_vals_val_get(print_key, print_key_path((to_path + 1):end_str), &
379 1991817 : l_val=flags)
380 : ELSE
381 7694529 : flags = .TRUE.
382 : END IF
383 : ELSE
384 791187 : print_key => basis_section
385 791187 : flags = .TRUE.
386 : END IF
387 10477533 : IF (PRESENT(used_print_key)) used_print_key => print_key
388 :
389 10477533 : IF (.NOT. flags) RETURN
390 :
391 : CALL section_vals_val_get(print_key, "__CONTROL_VAL", &
392 8867655 : i_val=my_control_val)
393 8867655 : is_on = cp_printkey_is_on(iteration_info, print_key)
394 :
395 : ! a shortcut for most common case
396 8867655 : IF (my_control_val == cp_out_default .AND. .NOT. is_on) RETURN
397 :
398 2492902 : is_iter = cp_printkey_is_iter(iteration_info, print_key, first_time=first_time)
399 :
400 2492902 : IF (BTEST(my_control_val, cp_p_store)) THEN
401 : res = IBSET(res, cp_p_store)
402 2492902 : ELSE IF (BTEST(my_control_val, cp_p_store_if) .AND. is_iter .AND. is_on) THEN
403 : res = IBSET(res, cp_p_store)
404 2492902 : ELSE IF (BTEST(my_control_val, cp_p_store_each) .AND. is_iter) THEN
405 0 : res = IBSET(res, cp_p_store)
406 : END IF
407 :
408 2492902 : IF (BTEST(my_control_val, cp_p_file)) THEN
409 0 : res = IBSET(res, cp_p_file)
410 2492902 : ELSE IF (BTEST(my_control_val, cp_p_file_if) .AND. is_iter .AND. is_on) THEN
411 1975445 : res = IBSET(res, cp_p_file)
412 517457 : ELSE IF (BTEST(my_control_val, cp_p_file_each) .AND. is_iter) THEN
413 0 : res = IBSET(res, cp_p_file)
414 : END IF
415 2492902 : IF (BTEST(my_control_val, cp_p_calc) .OR. res /= 0) THEN
416 1975445 : res = IBSET(res, cp_p_calc)
417 : END IF
418 : END FUNCTION cp_print_key_should_output
419 :
420 : ! **************************************************************************************************
421 : !> \brief returns true if the printlevel activates this printkey
422 : !> does not look if this iteration it should be printed
423 : !> \param iteration_info information about the actual iteration level
424 : !> \param print_key the section values of the key to be printed
425 : !> \return ...
426 : !> \author fawzi
427 : ! **************************************************************************************************
428 8901930 : FUNCTION cp_printkey_is_on(iteration_info, print_key) RESULT(res)
429 : TYPE(cp_iteration_info_type), INTENT(IN) :: iteration_info
430 : TYPE(section_vals_type), POINTER :: print_key
431 : LOGICAL :: res
432 :
433 : INTEGER :: print_level
434 :
435 8901930 : CPASSERT(iteration_info%ref_count > 0)
436 8901930 : IF (.NOT. ASSOCIATED(print_key)) THEN
437 0 : res = (iteration_info%print_level > debug_print_level)
438 : ELSE
439 8901930 : CPASSERT(print_key%ref_count > 0)
440 8901930 : CALL section_vals_val_get(print_key, "_SECTION_PARAMETERS_", i_val=print_level)
441 8901930 : res = iteration_info%print_level >= print_level
442 : END IF
443 8901930 : END FUNCTION cp_printkey_is_on
444 :
445 : ! **************************************************************************************************
446 : !> \brief returns if the actual iteration matches those selected by the
447 : !> given printkey. Does not check it the prinkey is active (at the
448 : !> actual print_level)
449 : !> \param iteration_info information about the actual iteration level
450 : !> \param print_key the section values of the key to be printed
451 : !> \param first_time returns if it is the first time that output is written
452 : !> (not fully correct, but most of the time)
453 : !> \return ...
454 : !> \author fawzi
455 : ! **************************************************************************************************
456 2492902 : FUNCTION cp_printkey_is_iter(iteration_info, print_key, first_time) &
457 : RESULT(res)
458 : TYPE(cp_iteration_info_type), INTENT(IN) :: iteration_info
459 : TYPE(section_vals_type), POINTER :: print_key
460 : LOGICAL, INTENT(OUT), OPTIONAL :: first_time
461 : LOGICAL :: res
462 :
463 : INTEGER :: add_last, ilevel, iter_nr, ival
464 : LOGICAL :: first, level_passed
465 :
466 2492902 : CPASSERT(iteration_info%ref_count > 0)
467 2492902 : IF (.NOT. ASSOCIATED(print_key)) THEN
468 0 : res = (iteration_info%print_level > debug_print_level)
469 0 : first = ALL(iteration_info%iteration(1:iteration_info%n_rlevel) == 1)
470 : ELSE
471 2492902 : CPASSERT(print_key%ref_count > 0)
472 2492902 : res = .FALSE.
473 2492902 : first = .FALSE.
474 2492902 : CALL section_vals_val_get(print_key, "ADD_LAST", i_val=add_last)
475 2492902 : res = .TRUE.
476 2492902 : first = .TRUE.
477 7285945 : DO ilevel = 1, iteration_info%n_rlevel
478 4793043 : level_passed = .FALSE.
479 : CALL section_vals_val_get(print_key, "EACH%"//TRIM(iteration_info%level_name(ilevel)), &
480 4793043 : i_val=ival)
481 4793043 : IF (ival > 0) THEN
482 4779143 : iter_nr = iteration_info%iteration(ilevel)
483 4779143 : IF (iter_nr/ival > 1) first = .FALSE.
484 4779143 : IF (MODULO(iter_nr, ival) == 0) THEN
485 3891025 : level_passed = .TRUE.
486 : END IF
487 : END IF
488 4793043 : IF (add_last == add_last_numeric .OR. add_last == add_last_symbolic) THEN
489 2561247 : IF (iteration_info%last_iter(ilevel)) THEN
490 : level_passed = .TRUE.
491 : END IF
492 : END IF
493 7129114 : IF (.NOT. level_passed) res = .FALSE.
494 : END DO
495 : END IF
496 2492902 : first = first .AND. res
497 2492902 : IF (PRESENT(first_time)) first_time = first
498 2492902 : END FUNCTION cp_printkey_is_iter
499 :
500 : ! **************************************************************************************************
501 : !> \brief returns the iteration string, a string that is useful to create
502 : !> unique filenames (once you trim it)
503 : !> \param iter_info the iteration info from where to take the iteration
504 : !> number
505 : !> \param print_key the print key to optionally show the last iteration
506 : !> symbolically
507 : !> \param for_file if the string is to be used for file generation
508 : !> (and should consequently ignore some iteration levels depending
509 : !> on COMMON_ITERATION_LEVELS).
510 : !> Defaults to false.
511 : !> \return ...
512 : !> \author fawzi
513 : !> \note
514 : !> If the root level is 1 removes it
515 : ! **************************************************************************************************
516 107066 : FUNCTION cp_iter_string(iter_info, print_key, for_file) RESULT(res)
517 : TYPE(cp_iteration_info_type), POINTER :: iter_info
518 : TYPE(section_vals_type), OPTIONAL, POINTER :: print_key
519 : LOGICAL, INTENT(IN), OPTIONAL :: for_file
520 : CHARACTER(len=default_string_length) :: res
521 :
522 : INTEGER :: add_last, c_i_level, ilevel, n_rlevel, &
523 : s_level
524 : LOGICAL :: my_for_file
525 : TYPE(section_vals_type), POINTER :: my_print_key
526 :
527 107066 : res = ""
528 107066 : my_for_file = .FALSE.
529 107066 : IF (PRESENT(for_file)) my_for_file = for_file
530 107066 : CPASSERT(ASSOCIATED(iter_info))
531 107066 : CPASSERT(iter_info%ref_count > 0)
532 107066 : NULLIFY (my_print_key)
533 107066 : IF (PRESENT(print_key)) my_print_key => print_key
534 107066 : s_level = 1
535 105625 : IF (ASSOCIATED(my_print_key)) THEN
536 105625 : CALL section_vals_val_get(my_print_key, "ADD_LAST", i_val=add_last)
537 105625 : CALL section_vals_val_get(my_print_key, "COMMON_ITERATION_LEVELS", i_val=c_i_level)
538 105625 : n_rlevel = iter_info%n_rlevel
539 105625 : IF (my_for_file) n_rlevel = MIN(n_rlevel, MAX(0, n_rlevel - c_i_level))
540 191765 : DO ilevel = s_level, n_rlevel
541 191765 : IF (iter_info%last_iter(ilevel)) THEN
542 4097 : IF (add_last == add_last_symbolic) THEN
543 0 : WRITE (res(9*ilevel - 8:9*ilevel), "('l_')")
544 : ELSE
545 4097 : WRITE (res(9*ilevel - 8:9*ilevel), "(i8,'_')") iter_info%iteration(ilevel)
546 : END IF
547 : ELSE
548 82043 : WRITE (res(9*ilevel - 8:9*ilevel), "(i8,'_')") iter_info%iteration(ilevel)
549 : END IF
550 : END DO
551 : ELSE
552 3920 : DO ilevel = s_level, iter_info%n_rlevel
553 3920 : WRITE (res(9*ilevel - 8:9*ilevel), "(i8,'_')") iter_info%iteration(ilevel)
554 : END DO
555 : END IF
556 107066 : CALL compress(res, .TRUE.)
557 107066 : IF (LEN_TRIM(res) > 0) THEN
558 78021 : res(LEN_TRIM(res):LEN_TRIM(res)) = " "
559 : END IF
560 107066 : END FUNCTION cp_iter_string
561 :
562 : ! **************************************************************************************************
563 : !> \brief adds one to the actual iteration
564 : !> \param iteration_info the iteration info to update
565 : !> \param last if this iteration is the last one (defaults to false)
566 : !> \param iter_nr ...
567 : !> \param increment ...
568 : !> \param iter_nr_out ...
569 : !> \author fawzi
570 : !> \note
571 : !> this is supposed to be called at the beginning of each iteration
572 : ! **************************************************************************************************
573 362719 : SUBROUTINE cp_iterate(iteration_info, last, iter_nr, increment, iter_nr_out)
574 : TYPE(cp_iteration_info_type), POINTER :: iteration_info
575 : LOGICAL, INTENT(IN), OPTIONAL :: last
576 : INTEGER, INTENT(IN), OPTIONAL :: iter_nr, increment
577 : INTEGER, INTENT(OUT), OPTIONAL :: iter_nr_out
578 :
579 : INTEGER :: my_increment
580 : LOGICAL :: my_last
581 :
582 362719 : my_last = .FALSE.
583 362719 : my_increment = 1
584 362719 : IF (PRESENT(last)) my_last = last
585 362719 : IF (PRESENT(increment)) my_increment = increment
586 362719 : IF (PRESENT(iter_nr_out)) iter_nr_out = -1
587 :
588 362719 : CPASSERT(ASSOCIATED(iteration_info))
589 362719 : CPASSERT(iteration_info%ref_count > 0)
590 362719 : IF (PRESENT(iter_nr)) THEN
591 327523 : iteration_info%iteration(iteration_info%n_rlevel) = iter_nr
592 : ELSE
593 : iteration_info%iteration(iteration_info%n_rlevel) = &
594 35196 : iteration_info%iteration(iteration_info%n_rlevel) + my_increment
595 : END IF
596 : ! If requested provide the value of the iteration level
597 362719 : IF (PRESENT(iter_nr_out)) iter_nr_out = iteration_info%iteration(iteration_info%n_rlevel)
598 :
599 : ! Possibly setup the LAST flag
600 362719 : iteration_info%last_iter(iteration_info%n_rlevel) = my_last
601 362719 : END SUBROUTINE cp_iterate
602 :
603 : ! **************************************************************************************************
604 : !> \brief Return the index of an iteration level by its name.
605 : !> \param iteration_info the iteration info to query
606 : !> \param level_name level name to query.
607 : !> \return iteration level index or 0 if there is no such level
608 : !> \author Sergey Chulkov
609 : ! **************************************************************************************************
610 0 : FUNCTION cp_get_iter_level_by_name(iteration_info, level_name) RESULT(rlevel)
611 : TYPE(cp_iteration_info_type), INTENT(IN), POINTER :: iteration_info
612 : CHARACTER(LEN=*), INTENT(IN) :: level_name
613 : INTEGER :: rlevel
614 :
615 0 : CPASSERT(ASSOCIATED(iteration_info))
616 0 : CPASSERT(iteration_info%ref_count > 0)
617 0 : DO rlevel = iteration_info%n_rlevel, 1, -1
618 0 : IF (iteration_info%level_name(rlevel) == level_name) EXIT
619 : END DO
620 :
621 0 : END FUNCTION cp_get_iter_level_by_name
622 :
623 : ! **************************************************************************************************
624 : !> \brief Return the current iteration number at a given level.
625 : !> \param iteration_info the iteration info to query
626 : !> \param rlevel index of the iteration level. Use the level on top of the stack,
627 : !> if it is not given
628 : !> \param iter_nr iteration number [out]
629 : !> \param last_iter last iteration flag [out]
630 : !> \author Sergey Chulkov
631 : ! **************************************************************************************************
632 47804 : SUBROUTINE cp_get_iter_nr(iteration_info, rlevel, iter_nr, last_iter)
633 : TYPE(cp_iteration_info_type), INTENT(IN), POINTER :: iteration_info
634 : INTEGER, INTENT(IN), OPTIONAL :: rlevel
635 : INTEGER, INTENT(OUT), OPTIONAL :: iter_nr
636 : LOGICAL, INTENT(OUT), OPTIONAL :: last_iter
637 :
638 : INTEGER :: ilevel
639 :
640 47804 : CPASSERT(ASSOCIATED(iteration_info))
641 47804 : CPASSERT(iteration_info%ref_count > 0)
642 47804 : IF (PRESENT(rlevel)) THEN
643 47804 : CPASSERT(rlevel > 0 .AND. rlevel <= iteration_info%n_rlevel)
644 : ilevel = rlevel
645 : ELSE
646 0 : ilevel = iteration_info%n_rlevel
647 : END IF
648 :
649 47804 : IF (PRESENT(iter_nr)) iter_nr = iteration_info%iteration(ilevel)
650 47804 : IF (PRESENT(last_iter)) last_iter = iteration_info%last_iter(ilevel)
651 47804 : END SUBROUTINE cp_get_iter_nr
652 :
653 : ! **************************************************************************************************
654 : !> \brief Adds an iteration level
655 : !> \param logger the logger with the iteration info to which an iteration level has
656 : !> to be added
657 : !> \param level_name the name of this level, for pretty printing only, right now
658 : !> \param n_rlevel_new number of iteration levels after this call
659 : !> \author fawzi
660 : ! **************************************************************************************************
661 47861 : SUBROUTINE cp_add_iter_level(logger, level_name, n_rlevel_new)
662 : TYPE(cp_logger_type), POINTER :: logger
663 : CHARACTER(LEN=*), INTENT(IN) :: level_name
664 : INTEGER, INTENT(OUT), OPTIONAL :: n_rlevel_new
665 :
666 : INTEGER :: i
667 : LOGICAL :: found
668 : TYPE(cp_iteration_info_type), POINTER :: iteration_info
669 :
670 0 : CPASSERT(ASSOCIATED(logger))
671 47861 : iteration_info => logger%iter_info
672 47861 : CPASSERT(ASSOCIATED(iteration_info))
673 47861 : CPASSERT(iteration_info%ref_count > 0)
674 47861 : found = .FALSE.
675 257483 : DO i = 1, SIZE(each_possible_labels)
676 257483 : IF (TRIM(level_name) == TRIM(each_possible_labels(i))) THEN
677 : found = .TRUE.
678 : EXIT
679 : END IF
680 : END DO
681 47861 : IF (found) THEN
682 47861 : CALL cp_iteration_info_retain(iteration_info)
683 47861 : iteration_info%n_rlevel = iteration_info%n_rlevel + 1
684 47861 : CALL reallocate(iteration_info%iteration, 1, iteration_info%n_rlevel)
685 47861 : CALL reallocate(iteration_info%level_name, 1, iteration_info%n_rlevel)
686 47861 : CALL reallocate(iteration_info%last_iter, 1, iteration_info%n_rlevel)
687 47861 : iteration_info%iteration(iteration_info%n_rlevel) = 0
688 47861 : iteration_info%level_name(iteration_info%n_rlevel) = level_name
689 47861 : iteration_info%last_iter(iteration_info%n_rlevel) = .FALSE.
690 47861 : IF (PRESENT(n_rlevel_new)) n_rlevel_new = iteration_info%n_rlevel
691 47861 : CALL cp_iter_level_print(logger, "A")
692 : ELSE
693 : CALL cp_abort(__LOCATION__, &
694 : "Trying to create an iteration level ("//TRIM(level_name)//") not defined. "// &
695 0 : "Please update the module: cp_iter_types.")
696 : END IF
697 :
698 47861 : END SUBROUTINE cp_add_iter_level
699 :
700 : ! **************************************************************************************************
701 : !> \brief Removes an iteration level
702 : !> \param logger the logger with the iteration info to which an iteration level has
703 : !> to be removed
704 : !> \param level_name level_name to be destroyed (if does not match gives an error)
705 : !> \param n_rlevel_att iteration level before the call (to do some checks)
706 : !> \author fawzi
707 : ! **************************************************************************************************
708 47861 : SUBROUTINE cp_rm_iter_level(logger, level_name, n_rlevel_att)
709 : TYPE(cp_logger_type), POINTER :: logger
710 : CHARACTER(LEN=*), INTENT(IN) :: level_name
711 : INTEGER, INTENT(IN), OPTIONAL :: n_rlevel_att
712 :
713 : LOGICAL :: check
714 : TYPE(cp_iteration_info_type), POINTER :: iteration_info
715 :
716 47861 : CPASSERT(ASSOCIATED(logger))
717 47861 : iteration_info => logger%iter_info
718 47861 : CPASSERT(ASSOCIATED(iteration_info))
719 47861 : CPASSERT(iteration_info%ref_count > 0)
720 47861 : IF (PRESENT(n_rlevel_att)) THEN
721 6434 : CPASSERT(n_rlevel_att == iteration_info%n_rlevel)
722 : END IF
723 47861 : CALL cp_iter_level_print(logger, "R")
724 47861 : CALL cp_iteration_info_release(iteration_info)
725 : ! This check that the iteration levels are consistently created and destroyed..
726 : ! Never remove this check..
727 47861 : check = iteration_info%level_name(iteration_info%n_rlevel) == level_name
728 47861 : CPASSERT(check)
729 47861 : iteration_info%n_rlevel = iteration_info%n_rlevel - 1
730 47861 : CALL reallocate(iteration_info%iteration, 1, iteration_info%n_rlevel)
731 47861 : CALL reallocate(iteration_info%level_name, 1, iteration_info%n_rlevel)
732 47861 : CALL reallocate(iteration_info%last_iter, 1, iteration_info%n_rlevel)
733 47861 : END SUBROUTINE cp_rm_iter_level
734 :
735 : ! **************************************************************************************************
736 : !> \brief Print information entering or exiting an iteration level
737 : !> \param logger the logger with iteration info and para_env
738 : !> \param direction entering (A) or exiting (R) the iteration level
739 : !> \param local if the unit should be local to this task
740 : !> \author Zilong HE
741 : ! **************************************************************************************************
742 95722 : SUBROUTINE cp_iter_level_print(logger, direction, local)
743 : TYPE(cp_logger_type), POINTER :: logger
744 : CHARACTER(LEN=1), INTENT(IN) :: direction
745 : LOGICAL, INTENT(IN), OPTIONAL :: local
746 :
747 : INTEGER, PARAMETER :: min_iter_level = 2
748 :
749 95722 : CHARACTER(LEN=:), ALLOCATABLE :: level_name
750 : INTEGER :: iter_nr, rlevel, unit_nr
751 : LOGICAL :: my_local
752 : TYPE(cp_iteration_info_type), POINTER :: iteration_info
753 :
754 : ! min_iter_level = 2 is to skip iteration_info%level_name(1)
755 : ! which corresponds to a fictitious __ROOT__ level added in
756 : ! the init_cp2k subroutine. The level_name should be one of
757 : ! the list each_possible_labels; the following WRITE format
758 : ! assumes implicitly a maximum length of 27 characters.
759 :
760 95722 : iteration_info => logger%iter_info
761 95722 : my_local = .FALSE.
762 95722 : IF (PRESENT(local)) my_local = local
763 95722 : IF (my_local .OR. logger%para_env%is_source()) THEN
764 48508 : IF (iteration_info%iter_print >= iter_silent) THEN
765 47770 : rlevel = iteration_info%n_rlevel
766 47770 : CPASSERT(rlevel > 0)
767 47770 : level_name = TRIM(ADJUSTL(iteration_info%level_name(rlevel)))
768 47770 : CALL cp_get_iter_nr(iteration_info, rlevel, iter_nr)
769 47770 : IF (iteration_info%iter_print > iter_silent) THEN
770 190 : unit_nr = cp_logger_get_unit_nr(logger, local=my_local)
771 190 : IF (unit_nr > 0) THEN
772 190 : WRITE (UNIT=unit_nr, FMT="()")
773 : ! The current iteration level
774 95 : SELECT CASE (direction)
775 : CASE ("A") ! After adding level in cp_add_iter_level
776 : WRITE (UNIT=unit_nr, FMT="(T2,A,T37,I3,T41,A,T73,I8)") &
777 95 : "ITER_LV| >>>>>>>> Entering level +", rlevel, "[ "//level_name//" ]", iter_nr
778 : CASE ("R") ! Before removing level in cp_rm_iter_level
779 : WRITE (UNIT=unit_nr, FMT="(T2,A,T37,I3,T41,A,T73,I8)") &
780 95 : "ITER_LV| <<<<<<<< Exiting level -", rlevel, "[ "//level_name//" ]", iter_nr
781 : CASE DEFAULT
782 : CALL cp_abort(__LOCATION__, &
783 : "Only entering (A) or exiting (R) an iteration level "// &
784 190 : "can have a message printed.")
785 : END SELECT
786 : ! The rest of stack of iteration levels
787 190 : IF (iteration_info%iter_print > iter_notice) THEN
788 114 : DO WHILE (rlevel > min_iter_level)
789 34 : rlevel = rlevel - 1
790 34 : level_name = TRIM(ADJUSTL(iteration_info%level_name(rlevel)))
791 34 : CALL cp_get_iter_nr(iteration_info, rlevel, iter_nr)
792 : WRITE (UNIT=unit_nr, FMT="(T2,A,T37,I3,T41,A,T73,I8)") &
793 114 : "ITER_LV| *", rlevel, "[ "//level_name//" ]", iter_nr
794 : END DO
795 : END IF
796 190 : WRITE (UNIT=unit_nr, FMT="()")
797 : END IF
798 : END IF
799 : ELSE
800 : CALL cp_warn(__LOCATION__, &
801 : "An iteration level has been added to or removed from a logger "// &
802 738 : "that does not receive the GLOBAL%ITER_LEVEL_VERBOSITY setting.")
803 : END IF
804 : END IF
805 :
806 47770 : END SUBROUTINE cp_iter_level_print
807 :
808 : ! **************************************************************************************************
809 : !> \brief Utility function that returns a unit number to write the print key.
810 : !> Might open a file with a unique filename, generated from
811 : !> the print_key name and iteration info.
812 : !>
813 : !> Normally a valid unit (>0) is returned only if cp_print_key_should_output
814 : !> says that the print_key should be printed, and if the unit is global
815 : !> only the io node has a valid unit.
816 : !> So in many cases you can decide if you should print just checking if
817 : !> the returned units is bigger than 0.
818 : !>
819 : !> IMPORTANT you should call cp_finished_output when an iteration output is
820 : !> finished (to immediately close the file that might have been opened)
821 : !> \param logger the logger for the parallel environment, iteration info
822 : !> and filename generation
823 : !> \param print_key ...
824 : !> \param middle_name name to be added to the generated filename, useful when
825 : !> print_key activates different distinct outputs, to be able to
826 : !> distinguish them
827 : !> \param extension extension to be applied to the filename (including the ".")
828 : !> \param my_local if the unit should be local to this task, or global to the
829 : !> program (defaults to false).
830 : !> \return ...
831 : !> \author Fawzi Mohamed
832 : ! **************************************************************************************************
833 106155 : FUNCTION cp_print_key_generate_filename(logger, print_key, middle_name, extension, &
834 : my_local) RESULT(filename)
835 : TYPE(cp_logger_type), POINTER :: logger
836 : TYPE(section_vals_type), POINTER :: print_key
837 : CHARACTER(len=*), INTENT(IN), OPTIONAL :: middle_name
838 : CHARACTER(len=*), INTENT(IN) :: extension
839 : LOGICAL, INTENT(IN) :: my_local
840 : CHARACTER(len=default_path_length) :: filename
841 :
842 : CHARACTER(len=default_path_length) :: outName, outPath, postfix, root
843 : CHARACTER(len=default_string_length) :: my_middle_name
844 : INTEGER :: my_ind1, my_ind2
845 : LOGICAL :: has_root
846 :
847 106155 : CALL section_vals_val_get(print_key, "FILENAME", c_val=outPath)
848 106155 : IF (outPath(1:1) == '=') THEN
849 : CPASSERT(LEN(outPath) - 1 <= LEN(filename))
850 593 : filename = outPath(2:)
851 593 : RETURN
852 : END IF
853 105562 : IF (outPath == "__STD_OUT__") outPath = ""
854 105562 : outName = outPath
855 105562 : has_root = .FALSE.
856 105562 : my_ind1 = INDEX(outPath, "/")
857 105562 : my_ind2 = LEN_TRIM(outPath)
858 105562 : IF (my_ind1 /= 0) THEN
859 3937 : has_root = .TRUE.
860 3937 : DO WHILE (INDEX(outPath(my_ind1 + 1:my_ind2), "/") /= 0)
861 3937 : my_ind1 = INDEX(outPath(my_ind1 + 1:my_ind2), "/") + my_ind1
862 : END DO
863 3937 : IF (my_ind1 == my_ind2) THEN
864 0 : outName = ""
865 : ELSE
866 3937 : outName = outPath(my_ind1 + 1:my_ind2)
867 : END IF
868 : END IF
869 :
870 105562 : IF (PRESENT(middle_name)) THEN
871 40304 : IF (outName /= "") THEN
872 648 : my_middle_name = "-"//TRIM(outName)//"-"//middle_name
873 : ELSE
874 39656 : my_middle_name = "-"//middle_name
875 : END IF
876 : ELSE
877 65258 : IF (outName /= "") THEN
878 30556 : my_middle_name = "-"//TRIM(outName)
879 : ELSE
880 34702 : my_middle_name = ""
881 : END IF
882 : END IF
883 :
884 105562 : IF (.NOT. has_root) THEN
885 101625 : root = TRIM(logger%iter_info%project_name)//TRIM(my_middle_name)
886 3937 : ELSE IF (outName == "") THEN
887 0 : root = outPath(1:my_ind1)//TRIM(logger%iter_info%project_name)//TRIM(my_middle_name)
888 : ELSE
889 3937 : root = outPath(1:my_ind1)//my_middle_name(2:LEN_TRIM(my_middle_name))
890 : END IF
891 :
892 : ! use the cp_iter_string as a postfix
893 105562 : postfix = "-"//TRIM(cp_iter_string(logger%iter_info, print_key=print_key, for_file=.TRUE.))
894 105562 : IF (TRIM(postfix) == "-") postfix = ""
895 :
896 : ! and add the extension
897 105562 : postfix = TRIM(postfix)//extension
898 : ! and let the logger generate the filename
899 : CALL cp_logger_generate_filename(logger, res=filename, &
900 105562 : root=root, postfix=postfix, local=my_local)
901 :
902 : END FUNCTION cp_print_key_generate_filename
903 :
904 : ! **************************************************************************************************
905 : !> \brief ...
906 : !> \param logger ...
907 : !> \param basis_section ...
908 : !> \param print_key_path ...
909 : !> \param extension ...
910 : !> \param middle_name ...
911 : !> \param local ...
912 : !> \param log_filename ...
913 : !> \param ignore_should_output ...
914 : !> \param file_form ...
915 : !> \param file_position ...
916 : !> \param file_action ...
917 : !> \param file_status ...
918 : !> \param do_backup ...
919 : !> \param on_file ...
920 : !> \param is_new_file true if this rank created a new (or rewound) file, false otherwise
921 : !> \param mpi_io True if the file should be opened in parallel on all processors belonging to
922 : !> the communicator group. Automatically disabled if the file form or access mode
923 : !> is unsuitable for MPI IO. Return value indicates whether MPI was actually used
924 : !> and therefore the flag must also be passed to the file closing directive.
925 : !> \param fout Name of the actual file where the output will be written. Needed mainly for MPI IO
926 : !> because inquiring the filename from the MPI filehandle does not work across
927 : !> all MPI libraries.
928 : !> \param file_access Fortran access mode (SEQUENTIAL by default, or STREAM); unused with MPI I/O
929 : !> \return ...
930 : ! **************************************************************************************************
931 3152109 : FUNCTION cp_print_key_unit_nr(logger, basis_section, print_key_path, extension, &
932 : middle_name, local, log_filename, ignore_should_output, file_form, file_position, &
933 : file_action, file_status, do_backup, on_file, is_new_file, mpi_io, &
934 : fout, file_access) RESULT(res)
935 : TYPE(cp_logger_type), POINTER :: logger
936 : TYPE(section_vals_type), INTENT(IN) :: basis_section
937 : CHARACTER(len=*), INTENT(IN), OPTIONAL :: print_key_path
938 : CHARACTER(len=*), INTENT(IN) :: extension
939 : CHARACTER(len=*), INTENT(IN), OPTIONAL :: middle_name
940 : LOGICAL, INTENT(IN), OPTIONAL :: local, log_filename, ignore_should_output
941 : CHARACTER(len=*), INTENT(IN), OPTIONAL :: file_form, file_position, file_action, &
942 : file_status
943 : LOGICAL, INTENT(IN), OPTIONAL :: do_backup, on_file
944 : LOGICAL, INTENT(OUT), OPTIONAL :: is_new_file
945 : LOGICAL, INTENT(INOUT), OPTIONAL :: mpi_io
946 : CHARACTER(len=default_path_length), INTENT(OUT), &
947 : OPTIONAL :: fout
948 : CHARACTER(len=*), INTENT(IN), OPTIONAL :: file_access
949 : INTEGER :: res
950 :
951 : CHARACTER(len=default_path_length) :: filename, filename_bak, filename_bak_1, &
952 : filename_bak_2
953 : CHARACTER(len=default_string_length) :: my_file_action, my_file_form, &
954 : my_file_position, my_file_status, &
955 : outPath
956 : INTEGER :: c_i_level, f_backup_level, i, mpi_amode, &
957 : my_backup_level, my_nbak, nbak, &
958 : s_backup_level, unit_nr
959 : LOGICAL :: do_log, found, my_do_backup, my_local, &
960 : my_mpi_io, my_on_file, &
961 : my_should_output, replace
962 : TYPE(cp_iteration_info_type), POINTER :: iteration_info
963 : TYPE(mp_file_type) :: mp_unit
964 : TYPE(section_vals_type), POINTER :: print_key
965 :
966 3152109 : my_local = .FALSE.
967 3152109 : my_do_backup = .FALSE.
968 3152109 : my_mpi_io = .FALSE.
969 3152109 : replace = .FALSE.
970 3152109 : found = .FALSE.
971 3152109 : res = -1
972 3152109 : my_file_form = "FORMATTED"
973 3152109 : my_file_position = "APPEND"
974 3152109 : my_file_action = "WRITE"
975 3152109 : my_file_status = "UNKNOWN"
976 3152109 : my_on_file = .FALSE.
977 3152109 : mpi_amode = 0
978 337120 : IF (PRESENT(file_form)) my_file_form = file_form
979 3152109 : IF (PRESENT(file_position)) my_file_position = file_position
980 3152109 : IF (PRESENT(file_action)) my_file_action = file_action
981 3152109 : IF (PRESENT(file_status)) my_file_status = file_status
982 3152109 : IF (PRESENT(do_backup)) my_do_backup = do_backup
983 3152109 : IF (PRESENT(on_file)) my_on_file = on_file
984 3152109 : IF (PRESENT(local)) my_local = local
985 3152109 : IF (PRESENT(is_new_file)) is_new_file = .FALSE.
986 3152109 : IF (PRESENT(mpi_io)) THEN
987 : #if defined(__parallel)
988 2032 : IF (cp_mpi_io_get() .AND. logger%para_env%num_pe > 1 .AND. mpi_io) THEN
989 : my_mpi_io = .TRUE.
990 : ELSE
991 : my_mpi_io = .FALSE.
992 : END IF
993 : IF (my_mpi_io) THEN
994 : CALL mp_file_get_amode(mpi_io, replace, mpi_amode, TRIM(my_file_form), &
995 2032 : TRIM(my_file_action), TRIM(my_file_status), TRIM(my_file_position))
996 3902 : replace = replace .AND. logger%para_env%is_source()
997 : END IF
998 : #else
999 : my_mpi_io = .FALSE.
1000 : #endif
1001 : ! Set return value
1002 2032 : mpi_io = my_mpi_io
1003 : END IF
1004 3152109 : NULLIFY (print_key)
1005 3152109 : CPASSERT(ASSOCIATED(logger))
1006 3152109 : CPASSERT(basis_section%ref_count > 0)
1007 3152109 : CPASSERT(logger%ref_count > 0)
1008 : my_should_output = BTEST(cp_print_key_should_output(logger%iter_info, &
1009 3170239 : basis_section, print_key_path, used_print_key=print_key), cp_p_file)
1010 3152109 : IF (PRESENT(ignore_should_output)) my_should_output = my_should_output .OR. ignore_should_output
1011 3144549 : IF (.NOT. my_should_output) RETURN
1012 : IF (my_local .OR. &
1013 955331 : logger%para_env%is_source() .OR. &
1014 : my_mpi_io) THEN
1015 :
1016 497415 : CALL section_vals_val_get(print_key, "FILENAME", c_val=outPath)
1017 497415 : IF (outPath == '__STD_OUT__' .AND. .NOT. my_on_file) THEN
1018 402561 : res = cp_logger_get_default_unit_nr(logger, local=my_local)
1019 : ELSE
1020 : !
1021 : ! complex logic to build filename:
1022 : ! 1) Try to avoid '--' and '-.'
1023 : ! 2) If outPath contains '/' (as in ./filename) do not prepend the project_name
1024 : !
1025 : ! if it is actually a full path, use it as the root
1026 : filename = cp_print_key_generate_filename(logger, print_key, middle_name, extension, &
1027 154979 : my_local)
1028 : ! Give back info about a possible existence of the file if required
1029 94854 : IF (PRESENT(is_new_file)) THEN
1030 49993 : INQUIRE (FILE=filename, EXIST=found)
1031 49993 : is_new_file = .NOT. found
1032 49993 : IF (my_file_position == "REWIND") is_new_file = .TRUE.
1033 : END IF
1034 : ! Check is we have to log any operation performed on the file..
1035 : do_log = .FALSE.
1036 94854 : IF (PRESENT(log_filename)) THEN
1037 2336 : do_log = log_filename
1038 : ELSE
1039 92518 : CALL section_vals_val_get(print_key, "LOG_PRINT_KEY", l_val=do_log)
1040 : END IF
1041 : ! If required do a backup
1042 94854 : IF (my_do_backup) THEN
1043 18938 : INQUIRE (FILE=filename, EXIST=found)
1044 18938 : CALL section_vals_val_get(print_key, "BACKUP_COPIES", i_val=nbak)
1045 18938 : IF (nbak /= 0) THEN
1046 16215 : iteration_info => logger%iter_info
1047 16215 : s_backup_level = 0
1048 16215 : IF (ASSOCIATED(print_key%ibackup)) s_backup_level = SIZE(print_key%ibackup)
1049 16215 : CALL section_vals_val_get(print_key, "COMMON_ITERATION_LEVELS", i_val=c_i_level)
1050 16215 : my_backup_level = MAX(1, iteration_info%n_rlevel - c_i_level + 1)
1051 16215 : f_backup_level = MAX(s_backup_level, my_backup_level)
1052 16215 : IF (f_backup_level > s_backup_level) THEN
1053 4533 : CALL reallocate(print_key%ibackup, 1, f_backup_level)
1054 10407 : DO i = s_backup_level + 1, f_backup_level
1055 10407 : print_key%ibackup(i) = 0
1056 : END DO
1057 : END IF
1058 16215 : IF (found) THEN
1059 13107 : print_key%ibackup(my_backup_level) = print_key%ibackup(my_backup_level) + 1
1060 13107 : my_nbak = print_key%ibackup(my_backup_level)
1061 : ! Recent backup copies correspond to lower backup indexes
1062 13119 : DO i = MIN(nbak, my_nbak), 2, -1
1063 12 : filename_bak_1 = TRIM(filename)//".bak-"//ADJUSTL(cp_to_string(i))
1064 12 : filename_bak_2 = TRIM(filename)//".bak-"//ADJUSTL(cp_to_string(i - 1))
1065 12 : IF (do_log) THEN
1066 12 : unit_nr = cp_logger_get_unit_nr(logger, local=my_local)
1067 12 : IF (unit_nr > 0) THEN
1068 : WRITE (unit_nr, *) "Moving file "//TRIM(filename_bak_2)// &
1069 12 : " into file "//TRIM(filename_bak_1)//"."
1070 : END IF
1071 : END IF
1072 12 : INQUIRE (FILE=filename_bak_2, EXIST=found)
1073 13119 : IF (.NOT. found) THEN
1074 0 : IF (do_log) THEN
1075 0 : unit_nr = cp_logger_get_unit_nr(logger, local=my_local)
1076 0 : IF (unit_nr > 0) THEN
1077 0 : WRITE (unit_nr, *) "File "//TRIM(filename_bak_2)//" not existing.."
1078 : END IF
1079 : END IF
1080 : ELSE
1081 : ! Shared file: rotate on the source rank only; per-task
1082 : ! (my_local) files are per-rank, rotated by their owner.
1083 12 : IF (my_local .OR. logger%para_env%is_source()) THEN
1084 12 : CALL m_mov(TRIM(filename_bak_2), TRIM(filename_bak_1))
1085 : END IF
1086 : END IF
1087 : END DO
1088 : ! The last backup is always the one with index 1
1089 13107 : filename_bak = TRIM(filename)//".bak-"//ADJUSTL(cp_to_string(1))
1090 13107 : IF (do_log) THEN
1091 68 : unit_nr = cp_logger_get_unit_nr(logger, local=my_local)
1092 68 : IF (unit_nr > 0) THEN
1093 68 : WRITE (unit_nr, *) "Moving file "//TRIM(filename)//" into file "//TRIM(filename_bak)//"."
1094 : END IF
1095 : END IF
1096 13107 : IF (my_local .OR. logger%para_env%is_source()) THEN
1097 13107 : CALL m_mov(TRIM(filename), TRIM(filename_bak))
1098 : END IF
1099 : ELSE
1100 : ! Zero the backup history for this new iteration level..
1101 3108 : print_key%ibackup(my_backup_level) = 0
1102 : END IF
1103 : END IF
1104 : END IF
1105 :
1106 94854 : IF (.NOT. my_mpi_io) THEN
1107 : CALL open_file(file_name=filename, file_status=my_file_status, &
1108 : file_form=my_file_form, file_action=my_file_action, &
1109 185641 : file_position=my_file_position, file_access=file_access, unit_number=res)
1110 : ELSE
1111 2032 : IF (replace) CALL mp_file_delete(filename)
1112 : CALL mp_unit%open(groupid=logger%para_env, &
1113 2032 : filepath=filename, amode_status=mpi_amode)
1114 2032 : IF (PRESENT(fout)) fout = filename
1115 2032 : res = mp_unit%get_handle()
1116 : END IF
1117 94854 : IF (do_log) THEN
1118 79 : unit_nr = cp_logger_get_unit_nr(logger, local=my_local)
1119 79 : IF (unit_nr > 0) THEN
1120 : WRITE (unit_nr, *) "Writing "//TRIM(print_key%section%name)//" "// &
1121 : TRIM(cp_iter_string(logger%iter_info))//" to "// &
1122 79 : TRIM(filename)
1123 : END IF
1124 : END IF
1125 : END IF
1126 : ELSE
1127 457916 : res = -1
1128 : END IF
1129 4107440 : END FUNCTION cp_print_key_unit_nr
1130 :
1131 : ! **************************************************************************************************
1132 : !> \brief should be called after you finish working with a unit obtained with
1133 : !> cp_print_key_unit_nr, so that the file that might have been opened
1134 : !> can be closed.
1135 : !>
1136 : !> the inputs should be exactly the same of the corresponding
1137 : !> cp_print_key_unit_nr
1138 : !> \param unit_nr ...
1139 : !> \param logger ...
1140 : !> \param basis_section ...
1141 : !> \param print_key_path ...
1142 : !> \param local ...
1143 : !> \param ignore_should_output ...
1144 : !> \param on_file ...
1145 : !> \param mpi_io True if file was opened in parallel with MPI
1146 : !> \par History
1147 : !> 08.2002 created [fawzi]
1148 : !> \author Fawzi Mohamed
1149 : !> \note
1150 : !> closes if the corresponding filename of the printkey is
1151 : !> not __STD_OUT__
1152 : ! **************************************************************************************************
1153 2998982 : SUBROUTINE cp_print_key_finished_output(unit_nr, logger, basis_section, &
1154 : print_key_path, local, ignore_should_output, on_file, &
1155 : mpi_io)
1156 : INTEGER, INTENT(INOUT) :: unit_nr
1157 : TYPE(cp_logger_type), POINTER :: logger
1158 : TYPE(section_vals_type), INTENT(IN) :: basis_section
1159 : CHARACTER(len=*), INTENT(IN), OPTIONAL :: print_key_path
1160 : LOGICAL, INTENT(IN), OPTIONAL :: local, ignore_should_output, on_file, &
1161 : mpi_io
1162 :
1163 : CHARACTER(len=default_string_length) :: outPath
1164 : LOGICAL :: my_local, my_mpi_io, my_on_file, &
1165 : my_should_output
1166 : TYPE(mp_file_type) :: mp_unit
1167 : TYPE(section_vals_type), POINTER :: print_key
1168 :
1169 2998982 : my_local = .FALSE.
1170 2998982 : my_on_file = .FALSE.
1171 2998982 : my_mpi_io = .FALSE.
1172 2998982 : NULLIFY (print_key)
1173 3030 : IF (PRESENT(local)) my_local = local
1174 2998982 : IF (PRESENT(on_file)) my_on_file = on_file
1175 2998982 : IF (PRESENT(mpi_io)) my_mpi_io = mpi_io
1176 2998982 : CPASSERT(ASSOCIATED(logger))
1177 2998982 : CPASSERT(basis_section%ref_count > 0)
1178 2998982 : CPASSERT(logger%ref_count > 0)
1179 : my_should_output = BTEST(cp_print_key_should_output(logger%iter_info, basis_section, &
1180 3043617 : print_key_path, used_print_key=print_key), cp_p_file)
1181 2998982 : IF (PRESENT(ignore_should_output)) my_should_output = my_should_output .OR. ignore_should_output
1182 2998982 : IF (my_should_output .AND. (my_local .OR. &
1183 : logger%para_env%is_source() .OR. &
1184 : my_mpi_io)) THEN
1185 425040 : CALL section_vals_val_get(print_key, "FILENAME", c_val=outPath)
1186 425040 : IF (my_on_file .OR. outPath /= '__STD_OUT__') THEN
1187 92045 : CPASSERT(unit_nr > 0)
1188 92045 : IF (.NOT. my_mpi_io) THEN
1189 90013 : CALL close_file(unit_nr, "KEEP")
1190 : ELSE
1191 2032 : CALL mp_unit%set_handle(unit_nr)
1192 2032 : CALL mp_unit%close()
1193 : END IF
1194 92045 : unit_nr = -1
1195 : ELSE
1196 332995 : unit_nr = -1
1197 : END IF
1198 : END IF
1199 2998982 : CPASSERT(unit_nr == -1)
1200 2998982 : unit_nr = -1
1201 2998982 : END SUBROUTINE cp_print_key_finished_output
1202 :
1203 : ! **************************************************************************************************
1204 : !> \brief Sets flag which determines whether or not to use MPI I/O for I/O routines that
1205 : !> have been parallized with MPI
1206 : !> \param flag ...
1207 : !> \par History
1208 : !> 09.2018 created [Nico Holmberg]
1209 : ! **************************************************************************************************
1210 11793 : SUBROUTINE cp_mpi_io_set(flag)
1211 : LOGICAL, INTENT(IN) :: flag
1212 :
1213 11793 : enable_mpi_io = flag
1214 11793 : END SUBROUTINE cp_mpi_io_set
1215 :
1216 : ! **************************************************************************************************
1217 : !> \brief Gets flag which determines whether or not to use MPI I/O for I/O routines that
1218 : !> have been parallized with MPI
1219 : !> \return ...
1220 : !> \par History
1221 : !> 09.2018 created [Nico Holmberg]
1222 : ! **************************************************************************************************
1223 2078 : FUNCTION cp_mpi_io_get() RESULT(flag)
1224 : LOGICAL :: flag
1225 :
1226 2078 : flag = enable_mpi_io
1227 2078 : END FUNCTION cp_mpi_io_get
1228 :
1229 : END MODULE cp_output_handling
|
