(git:db0abe2)
Loading...
Searching...
No Matches
cp_output_handling.F
Go to the documentation of this file.
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! **************************************************************************************************
26 USE cp_files, ONLY: close_file,&
51 USE kinds, ONLY: default_path_length,&
53 USE machine, ONLY: m_mov
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'
73
74 INTEGER, PARAMETER, PUBLIC :: add_last_no = 0, &
75 add_last_numeric = 1, &
77 INTEGER, PARAMETER, PUBLIC :: silent_print_level = 0, &
78 low_print_level = 1, &
80 high_print_level = 3, &
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, &
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), &
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
120
121CONTAINS
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 SUBROUTINE cp_print_key_section_create(print_key_section, location, name, description, &
144 print_level, each_iter_names, each_iter_values, add_last, filename, &
145 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 cpassert(.NOT. ASSOCIATED(print_key_section))
168 my_print_level = debug_print_level
169 IF (PRESENT(print_level)) my_print_level = print_level
170 my_do_backup = .false.
171 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 citations=citations)
176
177 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, &
192 CALL section_add_keyword(print_key_section, keyword)
193 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 default_i_val=cp_out_default)
199 CALL section_add_keyword(print_key_section, keyword)
200 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 citations=citations)
215
216 ! Enforce the presence or absence of both.. or give an error
217 check = (PRESENT(each_iter_names)) .EQV. (PRESENT(each_iter_values))
218 cpassert(check)
219 ext_each = (PRESENT(each_iter_names)) .AND. (PRESENT(each_iter_values))
220
221 DO i_each = 1, SIZE(each_possible_labels)
222 my_value = 1
223 IF (ext_each) THEN
224 check = sum(index(each_iter_names, each_possible_labels(i_each))) <= 1
225 cpassert(check)
226 DO i_iter = 1, SIZE(each_iter_names)
227 IF (index(trim(each_iter_names(i_iter)), trim(each_possible_labels(i_each))) /= 0) THEN
228 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 default_i_val=my_value)
236 CALL section_add_keyword(subsection, keyword)
237 CALL keyword_release(keyword)
238 END DO
239 CALL section_add_subsection(print_key_section, subsection)
240 CALL section_release(subsection)
241
242 my_add_last = add_last_no
243 IF (PRESENT(add_last)) THEN
244 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"), &
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 default_i_val=my_add_last)
260 CALL section_add_keyword(print_key_section, keyword)
261 CALL keyword_release(keyword)
262
263 my_comm_iter_levels = 0
264 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 default_i_val=my_comm_iter_levels)
274 CALL section_add_keyword(print_key_section, keyword)
275 CALL keyword_release(keyword)
276
277 my_filename = ""
278 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 default_lc_val=my_filename)
291 CALL section_add_keyword(print_key_section, keyword)
292 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 usage="LOG_PRINT_KEY <LOGICAL>", default_l_val=.false., lone_keyword_l_val=.true.)
298 CALL section_add_keyword(print_key_section, keyword)
299 CALL keyword_release(keyword)
300
301 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 usage="UNIT angstrom", default_c_val=trim(unit_str))
306 CALL section_add_keyword(print_key_section, keyword)
307 CALL keyword_release(keyword)
308 END IF
309
310 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 usage="BACKUP_COPIES {int}", default_i_val=1)
320 CALL section_add_keyword(print_key_section, keyword)
321 CALL keyword_release(keyword)
322 END IF
323 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 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 res = 0
358 IF (PRESENT(first_time)) first_time = .false.
359 cpassert(basis_section%ref_count > 0)
360 IF (PRESENT(used_print_key)) NULLIFY (used_print_key)
361
362 IF (PRESENT(print_key_path)) THEN
363 end_str = len_trim(print_key_path)
364 to_path = index(print_key_path, "/")
365 IF (to_path < 1) THEN
366 to_path = end_str + 1
367 END IF
368
369 IF (to_path > 1) THEN
370 print_key => section_vals_get_subs_vals(basis_section, &
371 print_key_path(1:(to_path - 1)))
372 ELSE
373 print_key => basis_section
374 END IF
375 cpassert(ASSOCIATED(print_key))
376 cpassert(print_key%ref_count > 0)
377 IF (to_path + 1 < end_str) THEN
378 CALL section_vals_val_get(print_key, print_key_path((to_path + 1):end_str), &
379 l_val=flags)
380 ELSE
381 flags = .true.
382 END IF
383 ELSE
384 print_key => basis_section
385 flags = .true.
386 END IF
387 IF (PRESENT(used_print_key)) used_print_key => print_key
388
389 IF (.NOT. flags) RETURN
390
391 CALL section_vals_val_get(print_key, "__CONTROL_VAL", &
392 i_val=my_control_val)
393 is_on = cp_printkey_is_on(iteration_info, print_key)
394
395 ! a shortcut for most common case
396 IF (my_control_val == cp_out_default .AND. .NOT. is_on) RETURN
397
398 is_iter = cp_printkey_is_iter(iteration_info, print_key, first_time=first_time)
399
400 IF (btest(my_control_val, cp_p_store)) THEN
401 res = ibset(res, cp_p_store)
402 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 ELSE IF (btest(my_control_val, cp_p_store_each) .AND. is_iter) THEN
405 res = ibset(res, cp_p_store)
406 END IF
407
408 IF (btest(my_control_val, cp_p_file)) THEN
409 res = ibset(res, cp_p_file)
410 ELSE IF (btest(my_control_val, cp_p_file_if) .AND. is_iter .AND. is_on) THEN
411 res = ibset(res, cp_p_file)
412 ELSE IF (btest(my_control_val, cp_p_file_each) .AND. is_iter) THEN
413 res = ibset(res, cp_p_file)
414 END IF
415 IF (btest(my_control_val, cp_p_calc) .OR. res /= 0) THEN
416 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 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 cpassert(iteration_info%ref_count > 0)
436 IF (.NOT. ASSOCIATED(print_key)) THEN
437 res = (iteration_info%print_level > debug_print_level)
438 ELSE
439 cpassert(print_key%ref_count > 0)
440 CALL section_vals_val_get(print_key, "_SECTION_PARAMETERS_", i_val=print_level)
441 res = iteration_info%print_level >= print_level
442 END IF
443 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 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 cpassert(iteration_info%ref_count > 0)
467 IF (.NOT. ASSOCIATED(print_key)) THEN
468 res = (iteration_info%print_level > debug_print_level)
469 first = all(iteration_info%iteration(1:iteration_info%n_rlevel) == 1)
470 ELSE
471 cpassert(print_key%ref_count > 0)
472 res = .false.
473 first = .false.
474 CALL section_vals_val_get(print_key, "ADD_LAST", i_val=add_last)
475 res = .true.
476 first = .true.
477 DO ilevel = 1, iteration_info%n_rlevel
478 level_passed = .false.
479 CALL section_vals_val_get(print_key, "EACH%"//trim(iteration_info%level_name(ilevel)), &
480 i_val=ival)
481 IF (ival > 0) THEN
482 iter_nr = iteration_info%iteration(ilevel)
483 IF (iter_nr/ival > 1) first = .false.
484 IF (modulo(iter_nr, ival) == 0) THEN
485 level_passed = .true.
486 END IF
487 END IF
488 IF (add_last == add_last_numeric .OR. add_last == add_last_symbolic) THEN
489 IF (iteration_info%last_iter(ilevel)) THEN
490 level_passed = .true.
491 END IF
492 END IF
493 IF (.NOT. level_passed) res = .false.
494 END DO
495 END IF
496 first = first .AND. res
497 IF (PRESENT(first_time)) first_time = first
498 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 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 res = ""
528 my_for_file = .false.
529 IF (PRESENT(for_file)) my_for_file = for_file
530 cpassert(ASSOCIATED(iter_info))
531 cpassert(iter_info%ref_count > 0)
532 NULLIFY (my_print_key)
533 IF (PRESENT(print_key)) my_print_key => print_key
534 s_level = 1
535 IF (ASSOCIATED(my_print_key)) THEN
536 CALL section_vals_val_get(my_print_key, "ADD_LAST", i_val=add_last)
537 CALL section_vals_val_get(my_print_key, "COMMON_ITERATION_LEVELS", i_val=c_i_level)
538 n_rlevel = iter_info%n_rlevel
539 IF (my_for_file) n_rlevel = min(n_rlevel, max(0, n_rlevel - c_i_level))
540 DO ilevel = s_level, n_rlevel
541 IF (iter_info%last_iter(ilevel)) THEN
542 IF (add_last == add_last_symbolic) THEN
543 WRITE (res(9*ilevel - 8:9*ilevel), "('l_')")
544 ELSE
545 WRITE (res(9*ilevel - 8:9*ilevel), "(i8,'_')") iter_info%iteration(ilevel)
546 END IF
547 ELSE
548 WRITE (res(9*ilevel - 8:9*ilevel), "(i8,'_')") iter_info%iteration(ilevel)
549 END IF
550 END DO
551 ELSE
552 DO ilevel = s_level, iter_info%n_rlevel
553 WRITE (res(9*ilevel - 8:9*ilevel), "(i8,'_')") iter_info%iteration(ilevel)
554 END DO
555 END IF
556 CALL compress(res, .true.)
557 IF (len_trim(res) > 0) THEN
558 res(len_trim(res):len_trim(res)) = " "
559 END IF
560 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 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 my_last = .false.
583 my_increment = 1
584 IF (PRESENT(last)) my_last = last
585 IF (PRESENT(increment)) my_increment = increment
586 IF (PRESENT(iter_nr_out)) iter_nr_out = -1
587
588 cpassert(ASSOCIATED(iteration_info))
589 cpassert(iteration_info%ref_count > 0)
590 IF (PRESENT(iter_nr)) THEN
591 iteration_info%iteration(iteration_info%n_rlevel) = iter_nr
592 ELSE
593 iteration_info%iteration(iteration_info%n_rlevel) = &
594 iteration_info%iteration(iteration_info%n_rlevel) + my_increment
595 END IF
596 ! If requested provide the value of the iteration level
597 IF (PRESENT(iter_nr_out)) iter_nr_out = iteration_info%iteration(iteration_info%n_rlevel)
598
599 ! Possibly setup the LAST flag
600 iteration_info%last_iter(iteration_info%n_rlevel) = my_last
601 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 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 cpassert(ASSOCIATED(iteration_info))
616 cpassert(iteration_info%ref_count > 0)
617 DO rlevel = iteration_info%n_rlevel, 1, -1
618 IF (iteration_info%level_name(rlevel) == level_name) EXIT
619 END DO
620
621 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 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 cpassert(ASSOCIATED(iteration_info))
641 cpassert(iteration_info%ref_count > 0)
642 IF (PRESENT(rlevel)) THEN
643 cpassert(rlevel > 0 .AND. rlevel <= iteration_info%n_rlevel)
644 ilevel = rlevel
645 ELSE
646 ilevel = iteration_info%n_rlevel
647 END IF
648
649 IF (PRESENT(iter_nr)) iter_nr = iteration_info%iteration(ilevel)
650 IF (PRESENT(last_iter)) last_iter = iteration_info%last_iter(ilevel)
651 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 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 cpassert(ASSOCIATED(logger))
671 iteration_info => logger%iter_info
672 cpassert(ASSOCIATED(iteration_info))
673 cpassert(iteration_info%ref_count > 0)
674 found = .false.
675 DO i = 1, SIZE(each_possible_labels)
676 IF (trim(level_name) == trim(each_possible_labels(i))) THEN
677 found = .true.
678 EXIT
679 END IF
680 END DO
681 IF (found) THEN
682 CALL cp_iteration_info_retain(iteration_info)
683 iteration_info%n_rlevel = iteration_info%n_rlevel + 1
684 CALL reallocate(iteration_info%iteration, 1, iteration_info%n_rlevel)
685 CALL reallocate(iteration_info%level_name, 1, iteration_info%n_rlevel)
686 CALL reallocate(iteration_info%last_iter, 1, iteration_info%n_rlevel)
687 iteration_info%iteration(iteration_info%n_rlevel) = 0
688 iteration_info%level_name(iteration_info%n_rlevel) = level_name
689 iteration_info%last_iter(iteration_info%n_rlevel) = .false.
690 IF (PRESENT(n_rlevel_new)) n_rlevel_new = iteration_info%n_rlevel
691 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 "Please update the module: cp_iter_types.")
696 END IF
697
698 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 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 cpassert(ASSOCIATED(logger))
717 iteration_info => logger%iter_info
718 cpassert(ASSOCIATED(iteration_info))
719 cpassert(iteration_info%ref_count > 0)
720 IF (PRESENT(n_rlevel_att)) THEN
721 cpassert(n_rlevel_att == iteration_info%n_rlevel)
722 END IF
723 CALL cp_iter_level_print(logger, "R")
724 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 check = iteration_info%level_name(iteration_info%n_rlevel) == level_name
728 cpassert(check)
729 iteration_info%n_rlevel = iteration_info%n_rlevel - 1
730 CALL reallocate(iteration_info%iteration, 1, iteration_info%n_rlevel)
731 CALL reallocate(iteration_info%level_name, 1, iteration_info%n_rlevel)
732 CALL reallocate(iteration_info%last_iter, 1, iteration_info%n_rlevel)
733 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 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 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 iteration_info => logger%iter_info
761 my_local = .false.
762 IF (PRESENT(local)) my_local = local
763 IF (my_local .OR. logger%para_env%is_source()) THEN
764 IF (iteration_info%iter_print >= iter_silent) THEN
765 rlevel = iteration_info%n_rlevel
766 cpassert(rlevel > 0)
767 level_name = trim(adjustl(iteration_info%level_name(rlevel)))
768 CALL cp_get_iter_nr(iteration_info, rlevel, iter_nr)
769 IF (iteration_info%iter_print > iter_silent) THEN
770 unit_nr = cp_logger_get_unit_nr(logger, local=my_local)
771 IF (unit_nr > 0) THEN
772 WRITE (unit=unit_nr, fmt="()")
773 ! The current iteration level
774 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 "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 "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 "can have a message printed.")
785 END SELECT
786 ! The rest of stack of iteration levels
787 IF (iteration_info%iter_print > iter_notice) THEN
788 DO WHILE (rlevel > min_iter_level)
789 rlevel = rlevel - 1
790 level_name = trim(adjustl(iteration_info%level_name(rlevel)))
791 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 "ITER_LV| *", rlevel, "[ "//level_name//" ]", iter_nr
794 END DO
795 END IF
796 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 "that does not receive the GLOBAL%ITER_LEVEL_VERBOSITY setting.")
803 END IF
804 END IF
805
806 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 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 CALL section_vals_val_get(print_key, "FILENAME", c_val=outpath)
848 IF (outpath(1:1) == '=') THEN
849 cpassert(len(outpath) - 1 <= len(filename))
850 filename = outpath(2:)
851 RETURN
852 END IF
853 IF (outpath == "__STD_OUT__") outpath = ""
854 outname = outpath
855 has_root = .false.
856 my_ind1 = index(outpath, "/")
857 my_ind2 = len_trim(outpath)
858 IF (my_ind1 /= 0) THEN
859 has_root = .true.
860 DO WHILE (index(outpath(my_ind1 + 1:my_ind2), "/") /= 0)
861 my_ind1 = index(outpath(my_ind1 + 1:my_ind2), "/") + my_ind1
862 END DO
863 IF (my_ind1 == my_ind2) THEN
864 outname = ""
865 ELSE
866 outname = outpath(my_ind1 + 1:my_ind2)
867 END IF
868 END IF
869
870 IF (PRESENT(middle_name)) THEN
871 IF (outname /= "") THEN
872 my_middle_name = "-"//trim(outname)//"-"//middle_name
873 ELSE
874 my_middle_name = "-"//middle_name
875 END IF
876 ELSE
877 IF (outname /= "") THEN
878 my_middle_name = "-"//trim(outname)
879 ELSE
880 my_middle_name = ""
881 END IF
882 END IF
883
884 IF (.NOT. has_root) THEN
885 root = trim(logger%iter_info%project_name)//trim(my_middle_name)
886 ELSE IF (outname == "") THEN
887 root = outpath(1:my_ind1)//trim(logger%iter_info%project_name)//trim(my_middle_name)
888 ELSE
889 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 postfix = "-"//trim(cp_iter_string(logger%iter_info, print_key=print_key, for_file=.true.))
894 IF (trim(postfix) == "-") postfix = ""
895
896 ! and add the extension
897 postfix = trim(postfix)//extension
898 ! and let the logger generate the filename
899 CALL cp_logger_generate_filename(logger, res=filename, &
900 root=root, postfix=postfix, local=my_local)
901
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 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 my_local = .false.
967 my_do_backup = .false.
968 my_mpi_io = .false.
969 replace = .false.
970 found = .false.
971 res = -1
972 my_file_form = "FORMATTED"
973 my_file_position = "APPEND"
974 my_file_action = "WRITE"
975 my_file_status = "UNKNOWN"
976 my_on_file = .false.
977 mpi_amode = 0
978 IF (PRESENT(file_form)) my_file_form = file_form
979 IF (PRESENT(file_position)) my_file_position = file_position
980 IF (PRESENT(file_action)) my_file_action = file_action
981 IF (PRESENT(file_status)) my_file_status = file_status
982 IF (PRESENT(do_backup)) my_do_backup = do_backup
983 IF (PRESENT(on_file)) my_on_file = on_file
984 IF (PRESENT(local)) my_local = local
985 IF (PRESENT(is_new_file)) is_new_file = .false.
986 IF (PRESENT(mpi_io)) THEN
987#if defined(__parallel)
988 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 trim(my_file_action), trim(my_file_status), trim(my_file_position))
996 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 mpi_io = my_mpi_io
1003 END IF
1004 NULLIFY (print_key)
1005 cpassert(ASSOCIATED(logger))
1006 cpassert(basis_section%ref_count > 0)
1007 cpassert(logger%ref_count > 0)
1008 my_should_output = btest(cp_print_key_should_output(logger%iter_info, &
1009 basis_section, print_key_path, used_print_key=print_key), cp_p_file)
1010 IF (PRESENT(ignore_should_output)) my_should_output = my_should_output .OR. ignore_should_output
1011 IF (.NOT. my_should_output) RETURN
1012 IF (my_local .OR. &
1013 logger%para_env%is_source() .OR. &
1014 my_mpi_io) THEN
1015
1016 CALL section_vals_val_get(print_key, "FILENAME", c_val=outpath)
1017 IF (outpath == '__STD_OUT__' .AND. .NOT. my_on_file) THEN
1018 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 my_local)
1028 ! Give back info about a possible existence of the file if required
1029 IF (PRESENT(is_new_file)) THEN
1030 INQUIRE (file=filename, exist=found)
1031 is_new_file = .NOT. found
1032 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 IF (PRESENT(log_filename)) THEN
1037 do_log = log_filename
1038 ELSE
1039 CALL section_vals_val_get(print_key, "LOG_PRINT_KEY", l_val=do_log)
1040 END IF
1041 ! If required do a backup
1042 IF (my_do_backup) THEN
1043 INQUIRE (file=filename, exist=found)
1044 CALL section_vals_val_get(print_key, "BACKUP_COPIES", i_val=nbak)
1045 IF (nbak /= 0) THEN
1046 iteration_info => logger%iter_info
1047 s_backup_level = 0
1048 IF (ASSOCIATED(print_key%ibackup)) s_backup_level = SIZE(print_key%ibackup)
1049 CALL section_vals_val_get(print_key, "COMMON_ITERATION_LEVELS", i_val=c_i_level)
1050 my_backup_level = max(1, iteration_info%n_rlevel - c_i_level + 1)
1051 f_backup_level = max(s_backup_level, my_backup_level)
1052 IF (f_backup_level > s_backup_level) THEN
1053 CALL reallocate(print_key%ibackup, 1, f_backup_level)
1054 DO i = s_backup_level + 1, f_backup_level
1055 print_key%ibackup(i) = 0
1056 END DO
1057 END IF
1058 IF (found) THEN
1059 print_key%ibackup(my_backup_level) = print_key%ibackup(my_backup_level) + 1
1060 my_nbak = print_key%ibackup(my_backup_level)
1061 ! Recent backup copies correspond to lower backup indexes
1062 DO i = min(nbak, my_nbak), 2, -1
1063 filename_bak_1 = trim(filename)//".bak-"//adjustl(cp_to_string(i))
1064 filename_bak_2 = trim(filename)//".bak-"//adjustl(cp_to_string(i - 1))
1065 IF (do_log) THEN
1066 unit_nr = cp_logger_get_unit_nr(logger, local=my_local)
1067 IF (unit_nr > 0) THEN
1068 WRITE (unit_nr, *) "Moving file "//trim(filename_bak_2)// &
1069 " into file "//trim(filename_bak_1)//"."
1070 END IF
1071 END IF
1072 INQUIRE (file=filename_bak_2, exist=found)
1073 IF (.NOT. found) THEN
1074 IF (do_log) THEN
1075 unit_nr = cp_logger_get_unit_nr(logger, local=my_local)
1076 IF (unit_nr > 0) THEN
1077 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 IF (my_local .OR. logger%para_env%is_source()) THEN
1084 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 filename_bak = trim(filename)//".bak-"//adjustl(cp_to_string(1))
1090 IF (do_log) THEN
1091 unit_nr = cp_logger_get_unit_nr(logger, local=my_local)
1092 IF (unit_nr > 0) THEN
1093 WRITE (unit_nr, *) "Moving file "//trim(filename)//" into file "//trim(filename_bak)//"."
1094 END IF
1095 END IF
1096 IF (my_local .OR. logger%para_env%is_source()) THEN
1097 CALL m_mov(trim(filename), trim(filename_bak))
1098 END IF
1099 ELSE
1100 ! Zero the backup history for this new iteration level..
1101 print_key%ibackup(my_backup_level) = 0
1102 END IF
1103 END IF
1104 END IF
1105
1106 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 file_position=my_file_position, file_access=file_access, unit_number=res)
1110 ELSE
1111 IF (replace) CALL mp_file_delete(filename)
1112 CALL mp_unit%open(groupid=logger%para_env, &
1113 filepath=filename, amode_status=mpi_amode)
1114 IF (PRESENT(fout)) fout = filename
1115 res = mp_unit%get_handle()
1116 END IF
1117 IF (do_log) THEN
1118 unit_nr = cp_logger_get_unit_nr(logger, local=my_local)
1119 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 trim(filename)
1123 END IF
1124 END IF
1125 END IF
1126 ELSE
1127 res = -1
1128 END IF
1129 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 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 my_local = .false.
1170 my_on_file = .false.
1171 my_mpi_io = .false.
1172 NULLIFY (print_key)
1173 IF (PRESENT(local)) my_local = local
1174 IF (PRESENT(on_file)) my_on_file = on_file
1175 IF (PRESENT(mpi_io)) my_mpi_io = mpi_io
1176 cpassert(ASSOCIATED(logger))
1177 cpassert(basis_section%ref_count > 0)
1178 cpassert(logger%ref_count > 0)
1179 my_should_output = btest(cp_print_key_should_output(logger%iter_info, basis_section, &
1180 print_key_path, used_print_key=print_key), cp_p_file)
1181 IF (PRESENT(ignore_should_output)) my_should_output = my_should_output .OR. ignore_should_output
1182 IF (my_should_output .AND. (my_local .OR. &
1183 logger%para_env%is_source() .OR. &
1184 my_mpi_io)) THEN
1185 CALL section_vals_val_get(print_key, "FILENAME", c_val=outpath)
1186 IF (my_on_file .OR. outpath /= '__STD_OUT__') THEN
1187 cpassert(unit_nr > 0)
1188 IF (.NOT. my_mpi_io) THEN
1189 CALL close_file(unit_nr, "KEEP")
1190 ELSE
1191 CALL mp_unit%set_handle(unit_nr)
1192 CALL mp_unit%close()
1193 END IF
1194 unit_nr = -1
1195 ELSE
1196 unit_nr = -1
1197 END IF
1198 END IF
1199 cpassert(unit_nr == -1)
1200 unit_nr = -1
1201 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 SUBROUTINE cp_mpi_io_set(flag)
1211 LOGICAL, INTENT(IN) :: flag
1212
1213 enable_mpi_io = flag
1214 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 FUNCTION cp_mpi_io_get() RESULT(flag)
1224 LOGICAL :: flag
1225
1226 flag = enable_mpi_io
1227 END FUNCTION cp_mpi_io_get
1228
1229END MODULE cp_output_handling
static GRID_HOST_DEVICE int modulo(int a, int m)
Equivalent of Fortran's MODULO, which always return a positive number. https://gcc....
Utility routines to open and close files.
Definition cp_files.F:22
subroutine, public open_file(file_name, unit_number, file_status, file_form, file_action, file_position, file_pad, file_access, debug)
Opens a file and returns its logical unit number.
Definition cp_files.F:197
subroutine, public close_file(unit_number, file_status)
Closes an open file given by its logical unit number.
Definition cp_files.F:64
Collection of routines to handle the iteration info.
integer, parameter, public iter_silent
character(len=default_path_length), dimension(19), parameter, public each_possible_labels
subroutine, public cp_iteration_info_retain(iteration_info)
retains the iteration_info (see doc/ReferenceCounting.html)
subroutine, public cp_iteration_info_release(iteration_info)
releases the iteration_info (see doc/ReferenceCounting.html)
character(len=default_path_length), dimension(19), parameter, public each_desc_labels
integer, parameter, public iter_notice
various routines to log and control the output. The idea is that decisions about where to log should ...
recursive integer function, public cp_logger_get_default_unit_nr(logger, local, skip_not_ionode)
asks the default unit number of the given logger. try to use cp_logger_get_unit_nr
integer function, public cp_logger_get_unit_nr(logger, local)
returns the unit nr for the requested kind of log.
subroutine, public cp_logger_generate_filename(logger, res, root, postfix, local)
generates a unique filename (ie adding eventual suffixes and process ids)
routines to handle the output, The idea is to remove the decision of wheter to output and what to out...
integer, parameter, public cp_out_calc
subroutine, public cp_print_key_section_create(print_key_section, location, name, description, print_level, each_iter_names, each_iter_values, add_last, filename, common_iter_levels, citations, unit_str, do_backup)
creates a print_key section
integer, parameter, public cp_out_file_each
integer, parameter, public cp_p_store_each
subroutine, public cp_add_iter_level(logger, level_name, n_rlevel_new)
Adds an iteration level.
character(len=default_string_length) function, public cp_iter_string(iter_info, print_key, for_file)
returns the iteration string, a string that is useful to create unique filenames (once you trim it)
subroutine, public cp_mpi_io_set(flag)
Sets flag which determines whether or not to use MPI I/O for I/O routines that have been parallized w...
integer, parameter, public cp_out_default
integer, parameter, public cp_out_store_if
integer, parameter, public debug_print_level
integer, parameter, public cp_out_store_each
integer, parameter, public cp_p_calc
integer, parameter, public cp_p_store_if
integer, parameter, public cp_out_file_if
integer, parameter, public cp_out_store
integer, parameter, public low_print_level
integer, parameter, public medium_print_level
character(len=default_path_length) function, public cp_print_key_generate_filename(logger, print_key, middle_name, extension, my_local)
Utility function that returns a unit number to write the print key. Might open a file with a unique f...
subroutine, public cp_print_key_finished_output(unit_nr, logger, basis_section, print_key_path, local, ignore_should_output, on_file, mpi_io)
should be called after you finish working with a unit obtained with cp_print_key_unit_nr,...
integer, parameter, public cp_p_file
integer, parameter, public cp_out_none
integer, parameter, public high_print_level
logical function, public cp_mpi_io_get()
Gets flag which determines whether or not to use MPI I/O for I/O routines that have been parallized w...
logical function, public cp_printkey_is_on(iteration_info, print_key)
returns true if the printlevel activates this printkey does not look if this iteration it should be p...
subroutine, public cp_iterate(iteration_info, last, iter_nr, increment, iter_nr_out)
adds one to the actual iteration
integer, parameter, public add_last_symbolic
integer, parameter, public cp_p_file_if
integer function, public cp_print_key_should_output(iteration_info, basis_section, print_key_path, used_print_key, first_time)
returns what should be done with the given property if btest(res,cp_p_store) then the property should...
integer, parameter, public add_last_numeric
integer, parameter, public silent_print_level
subroutine, public cp_rm_iter_level(logger, level_name, n_rlevel_att)
Removes an iteration level.
integer function, public cp_get_iter_level_by_name(iteration_info, level_name)
Return the index of an iteration level by its name.
integer, parameter, public cp_out_file
integer, parameter, public cp_p_file_each
integer, parameter, public cp_p_store
integer, parameter, public add_last_no
integer function, public cp_print_key_unit_nr(logger, basis_section, print_key_path, extension, middle_name, local, log_filename, ignore_should_output, file_form, file_position, file_action, file_status, do_backup, on_file, is_new_file, mpi_io, fout, file_access)
...
subroutine, public cp_get_iter_nr(iteration_info, rlevel, iter_nr, last_iter)
Return the current iteration number at a given level.
represents keywords in an input
subroutine, public keyword_release(keyword)
releases the given keyword (see doc/ReferenceCounting.html)
subroutine, public keyword_create(keyword, location, name, description, usage, type_of_var, n_var, repeats, variants, default_val, default_l_val, default_r_val, default_lc_val, default_c_val, default_i_val, default_l_vals, default_r_vals, default_c_vals, default_i_vals, lone_keyword_val, lone_keyword_l_val, lone_keyword_r_val, lone_keyword_c_val, lone_keyword_i_val, lone_keyword_l_vals, lone_keyword_r_vals, lone_keyword_c_vals, lone_keyword_i_vals, enum_c_vals, enum_i_vals, enum, enum_strict, enum_desc, unit_str, citations, deprecation_notice, removed)
creates a keyword object
objects that represent the structure of input sections and the data contained in an input section
subroutine, public section_create(section, location, name, description, n_keywords, n_subsections, repeats, citations, deprecation_notice)
creates a list of keywords
subroutine, public section_add_keyword(section, keyword)
adds a keyword to the given section
subroutine, public section_add_subsection(section, subsection)
adds a subsection to the given section
recursive type(section_vals_type) function, pointer, public section_vals_get_subs_vals(section_vals, subsection_name, i_rep_section, can_return_null)
returns the values of the requested subsection
recursive subroutine, public section_release(section)
releases the given keyword list (see doc/ReferenceCounting.html)
subroutine, public section_vals_val_get(section_vals, keyword_name, i_rep_section, i_rep_val, n_rep_val, val, l_val, i_val, r_val, c_val, l_vals, i_vals, r_vals, c_vals, explicit)
returns the requested value
Defines the basic variable types.
Definition kinds.F:23
integer, parameter, public default_string_length
Definition kinds.F:57
integer, parameter, public default_path_length
Definition kinds.F:58
Machine interface based on Fortran 2003 and POSIX.
Definition machine.F:17
subroutine, public m_mov(source, target)
...
Definition machine.F:727
Utility routines for the memory handling.
Interface to the message passing library MPI.
subroutine, public mp_file_delete(filepath, info)
Deletes a file. Auxiliary routine to emulate 'replace' action for mp_file_open. Only the master proce...
subroutine, public mp_file_get_amode(mpi_io, replace, amode, form, action, status, position)
(parallel) Utility routine to determine MPI file access mode based on variables
Utilities for string manipulations.
subroutine, public compress(string, full)
Eliminate multiple space characters in a string. If full is .TRUE., then all spaces are eliminated.
character(len=1), parameter, public newline
contains the information about the current state of the program to be able to decide if output is nec...
type of a logger, at the moment it contains just a print level starting at which level it should be l...
represent a keyword in the input
represent a section of the input file