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