Line data Source code
1 : !--------------------------------------------------------------------------------------------------!
2 : ! CP2K: A general program to perform molecular dynamics simulations !
3 : ! Copyright 2000-2025 CP2K developers group <https://cp2k.org> !
4 : ! !
5 : ! SPDX-License-Identifier: GPL-2.0-or-later !
6 : !--------------------------------------------------------------------------------------------------!
7 :
8 : ! **************************************************************************************************
9 : !> \brief routines to handle the output, The idea is to remove the
10 : !> decision of wheter to output and what to output from the code
11 : !> that does the output, and centralize it here.
12 : !> \note
13 : !> These were originally together with the log handling routines,
14 : !> but have been spawned off. Some dependencies are still there,
15 : !> and some of the comments about log handling also applies to output
16 : !> handling: @see cp_log_handling
17 : !> \par History
18 : !> 12.2001 created [fawzi]
19 : !> 08.2002 updated to new logger [fawzi]
20 : !> 10.2004 big rewrite of the output methods, connected to the new
21 : !> input, and iteration_info [fawzi]
22 : !> 08.2005 property flags [fawzi]
23 : !> \author Fawzi Mohamed
24 : ! **************************************************************************************************
25 : MODULE cp_output_handling
26 : USE cp_files, ONLY: close_file,&
27 : open_file
28 : USE cp_iter_types, ONLY: cp_iteration_info_release,&
29 : cp_iteration_info_retain,&
30 : cp_iteration_info_type,&
31 : each_desc_labels,&
32 : each_possible_labels
33 : USE cp_log_handling, ONLY: cp_logger_generate_filename,&
34 : cp_logger_get_default_unit_nr,&
35 : cp_logger_get_unit_nr,&
36 : cp_logger_type,&
37 : cp_to_string
38 : USE input_keyword_types, ONLY: keyword_create,&
39 : keyword_release,&
40 : keyword_type
41 : USE input_section_types, ONLY: section_add_keyword,&
42 : section_add_subsection,&
43 : section_create,&
44 : section_release,&
45 : section_type,&
46 : section_vals_get_subs_vals,&
47 : section_vals_type,&
48 : section_vals_val_get
49 : USE kinds, ONLY: default_path_length,&
50 : default_string_length
51 : USE machine, ONLY: m_mov
52 : USE memory_utilities, ONLY: reallocate
53 : USE message_passing, ONLY: mp_file_delete,&
54 : mp_file_get_amode,&
55 : mp_file_type
56 : USE string_utilities, ONLY: compress,&
57 : s2a
58 : #include "../base/base_uses.f90"
59 :
60 : IMPLICIT NONE
61 : PRIVATE
62 :
63 : LOGICAL, PRIVATE, PARAMETER :: debug_this_module = .TRUE.
64 : CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'cp_output_handling'
65 : PUBLIC :: cp_print_key_should_output, cp_iterate, cp_get_iter_level_by_name, cp_get_iter_nr, cp_add_iter_level, cp_rm_iter_level
66 : PUBLIC :: cp_iter_string, cp_print_key_section_create
67 : PUBLIC :: cp_print_key_unit_nr, cp_print_key_finished_output
68 : PUBLIC :: cp_print_key_generate_filename, cp_printkey_is_on
69 :
70 : INTEGER, PARAMETER, PUBLIC :: add_last_no = 0, &
71 : add_last_numeric = 1, &
72 : add_last_symbolic = 2
73 : INTEGER, PARAMETER, PUBLIC :: silent_print_level = 0, &
74 : low_print_level = 1, &
75 : medium_print_level = 2, &
76 : high_print_level = 3, &
77 : debug_print_level = 4
78 :
79 : !! flags controlling the printing and storing of a property.
80 : !!
81 : !! cp_out_none: do not calculate the property
82 : !! cp_out_file_if : if the printkey says it calculate and output the property
83 : !! cp_out_store_if : if the printkey says it calculate and store in memory
84 : !! the property
85 : !! cp_out_file_each: calculate and output the property with the same periodicity
86 : !! as said in the printkey (irrespective of the activation of
87 : !! the printkey)
88 : !! cp_out_store_each: calculate and store the property with the same periodicity
89 : !! as said in the printkey (irrespective of the activation of
90 : !! the printkey)
91 : !! cp_out_file: always calculate and output the property
92 : !! cp_out_store: always calculate and store in memory the property
93 : !! cp_out_calc: just calculate the value (independently from the fact that there
94 : !! should be output)
95 : !! cp_out_default: the default value for property flags (cp_out_file_if)
96 : !!
97 : !! this flags can be ior-ed together:
98 : !! ior(cp_out_file_if,cp_out_store_if): if the printkey says it both print
99 : !! and store the property
100 : !!
101 : !! there is no guarantee that a property is not stored if it is not necessary
102 : !! not all printkeys have a control flag
103 : INTEGER, PUBLIC, PARAMETER :: cp_p_file_if = 3, cp_p_store_if = 4, &
104 : cp_p_store = 2, cp_p_file = 1, cp_p_file_each = 5, cp_p_store_each = 6, cp_p_calc = 7
105 : INTEGER, PUBLIC, PARAMETER :: cp_out_none = 0, cp_out_file_if = IBSET(0, cp_p_file_if), &
106 : cp_out_store_if = IBSET(0, cp_p_store_if), cp_out_file = IBSET(0, cp_p_file), &
107 : cp_out_store = IBSET(0, cp_p_store), cp_out_calc = IBSET(0, cp_p_calc), &
108 : cp_out_file_each = IBSET(0, cp_p_file_each), &
109 : cp_out_store_each = IBSET(0, cp_p_store_each), &
110 : cp_out_default = cp_out_file_if
111 :
112 : ! Flag determining if MPI I/O should be enabled for functions that support it
113 : LOGICAL, PRIVATE, SAVE :: enable_mpi_io = .FALSE.
114 : ! Public functions to set/get the flags
115 : PUBLIC :: cp_mpi_io_set, cp_mpi_io_get
116 :
117 : ! **************************************************************************************************
118 : !> \brief stores the flags_env controlling the output of properties
119 : !> \param ref_count reference count (see doc/ReferenceCounting.html)
120 : !> \param n_flags number of flags stored in this type
121 : !> \param names names of the stored flags
122 : !> \param control_val value of the flag
123 : !> \param input the input (with all the printkeys)
124 : !> \param logger logger and iteration information (to know if output is needed)
125 : !> \param strict if flags that were not stored can be read
126 : !> \param default_val default value of the flags that are not explicitly
127 : !> stored
128 : !> \note
129 : !> Two features of this object should be:
130 : !> 1) easy state storage, one should be able to store the state of the
131 : !> flags, to some changes to them just for one (or few) force evaluations
132 : !> and then reset the original state. The actual implementation is good
133 : !> in this respect
134 : !> 2) work well with subsections. This is a problem at the moment, as
135 : !> if you pass just a subsection of the input the control flags get lost.
136 : !> A better implementation should be done storing the flags also in the
137 : !> input itself to be transparent
138 : !> \author fawzi
139 : ! **************************************************************************************************
140 : TYPE cp_out_flags_type
141 : INTEGER :: ref_count = 0, n_flags = 0
142 : CHARACTER(default_string_length), DIMENSION(:), POINTER :: names => NULL()
143 : INTEGER, DIMENSION(:), POINTER :: control_val => NULL()
144 : TYPE(section_vals_type), POINTER :: input => NULL()
145 : TYPE(cp_logger_type), POINTER :: logger => NULL()
146 : LOGICAL :: strict = .FALSE.
147 : INTEGER :: default_val = 0
148 : END TYPE cp_out_flags_type
149 :
150 : CONTAINS
151 :
152 : ! **************************************************************************************************
153 : !> \brief creates a print_key section
154 : !> \param print_key_section the print key to create
155 : !> \param location from where in the source code cp_print_key_section_create() is called
156 : !> \param name the name of the print key
157 : !> \param description the description of the print key
158 : !> \param print_level print level starting at which the printing takes place
159 : !> (defaults to debug_print_level)
160 : !> \param each_iter_names ...
161 : !> \param each_iter_values ...
162 : !> \param add_last ...
163 : !> \param filename ...
164 : !> \param common_iter_levels ...
165 : !> \param citations ...
166 : !> \param unit_str specifies an unit of measure for output quantity. If not
167 : !> provided the control is totally left to how the output was coded
168 : !> (i.e. USERS have no possibility to change it)
169 : !> \author fawzi
170 : ! **************************************************************************************************
171 6117174 : SUBROUTINE cp_print_key_section_create(print_key_section, location, name, description, &
172 6117174 : print_level, each_iter_names, each_iter_values, add_last, filename, &
173 184392 : common_iter_levels, citations, unit_str)
174 : TYPE(section_type), POINTER :: print_key_section
175 : CHARACTER(len=*), INTENT(IN) :: location, name, description
176 : INTEGER, INTENT(IN), OPTIONAL :: print_level
177 : CHARACTER(LEN=*), DIMENSION(:), INTENT(IN), &
178 : OPTIONAL :: each_iter_names
179 : INTEGER, DIMENSION(:), INTENT(IN), OPTIONAL :: each_iter_values
180 : INTEGER, INTENT(IN), OPTIONAL :: add_last
181 : CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: filename
182 : INTEGER, INTENT(IN), OPTIONAL :: common_iter_levels
183 : INTEGER, DIMENSION(:), OPTIONAL :: citations
184 : CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: unit_str
185 :
186 : CHARACTER(len=default_path_length) :: my_filename
187 : INTEGER :: i_each, i_iter, my_add_last, &
188 : my_comm_iter_levels, my_print_level, &
189 : my_value
190 : LOGICAL :: check, ext_each
191 : TYPE(keyword_type), POINTER :: keyword
192 : TYPE(section_type), POINTER :: subsection
193 :
194 6117174 : CPASSERT(.NOT. ASSOCIATED(print_key_section))
195 6117174 : my_print_level = debug_print_level
196 6117174 : IF (PRESENT(print_level)) my_print_level = print_level
197 :
198 : CALL section_create(print_key_section, location=location, name=name, description=description, &
199 : n_keywords=2, n_subsections=0, repeats=.FALSE., &
200 12049956 : citations=citations)
201 :
202 6117174 : NULLIFY (keyword, subsection)
203 : CALL keyword_create(keyword, __LOCATION__, name="_SECTION_PARAMETERS_", &
204 : description="Level starting at which this property is printed", &
205 : usage="silent", &
206 : default_i_val=my_print_level, lone_keyword_i_val=silent_print_level, &
207 : enum_c_vals=s2a("on", "off", "silent", "low", "medium", "high", "debug"), &
208 : enum_i_vals=(/silent_print_level - 1, debug_print_level + 1, &
209 : silent_print_level, low_print_level, &
210 6117174 : medium_print_level, high_print_level, debug_print_level/))
211 6117174 : CALL section_add_keyword(print_key_section, keyword)
212 6117174 : CALL keyword_release(keyword)
213 :
214 : CALL keyword_create(keyword, __LOCATION__, name="__CONTROL_VAL", &
215 : description=' hidden parameter that controls storage, printing,...'// &
216 : ' of the print_key', &
217 6117174 : default_i_val=cp_out_default)
218 6117174 : CALL section_add_keyword(print_key_section, keyword)
219 6117174 : CALL keyword_release(keyword)
220 :
221 : CALL section_create(subsection, __LOCATION__, name="EACH", &
222 : description="This section specifies how often this property is printed. "// &
223 : "Each keyword inside this section is mapping to a specific iteration level and "// &
224 : "the value of each of these keywords is matched with the iteration level during "// &
225 : "the calculation. How to handle the last iteration is treated "// &
226 : "separately in ADD_LAST (this mean that each iteration level (MD, GEO_OPT, etc..), "// &
227 : "though equal to 0, might print the last iteration). If an iteration level is specified "// &
228 : "that is not present in the flow of the calculation it is just ignored.", &
229 : n_keywords=2, n_subsections=0, repeats=.FALSE., &
230 12049956 : citations=citations)
231 :
232 : ! Enforce the presence or absence of both.. or give an error
233 6117174 : check = (PRESENT(each_iter_names)) .EQV. (PRESENT(each_iter_values))
234 6117174 : CPASSERT(check)
235 6117174 : ext_each = (PRESENT(each_iter_names)) .AND. (PRESENT(each_iter_values))
236 :
237 116226306 : DO i_each = 1, SIZE(each_possible_labels)
238 110109132 : my_value = 1
239 110109132 : IF (ext_each) THEN
240 19805544 : check = SUM(INDEX(each_iter_names, each_possible_labels(i_each))) <= 1
241 8238492 : CPASSERT(check)
242 19805544 : DO i_iter = 1, SIZE(each_iter_names)
243 19805544 : IF (INDEX(TRIM(each_iter_names(i_iter)), TRIM(each_possible_labels(i_each))) /= 0) THEN
244 611794 : my_value = each_iter_values(i_iter)
245 : END IF
246 : END DO
247 : END IF
248 : CALL keyword_create(keyword, __LOCATION__, name=TRIM(each_possible_labels(i_each)), &
249 : description=TRIM(each_desc_labels(i_each)), &
250 : usage=TRIM(each_possible_labels(i_each))//" <INTEGER>", &
251 110109132 : default_i_val=my_value)
252 110109132 : CALL section_add_keyword(subsection, keyword)
253 116226306 : CALL keyword_release(keyword)
254 : END DO
255 6117174 : CALL section_add_subsection(print_key_section, subsection)
256 6117174 : CALL section_release(subsection)
257 :
258 6117174 : my_add_last = add_last_no
259 6117174 : IF (PRESENT(add_last)) THEN
260 2372222 : my_add_last = add_last
261 : END IF
262 : CALL keyword_create(keyword, __LOCATION__, name="ADD_LAST", &
263 : description="If the last iteration should be added, and if it "// &
264 : "should be marked symbolically (with lowercase letter l) or with "// &
265 : "the iteration number. "// &
266 : "Not every iteration level is able to identify the last iteration "// &
267 : "early enough to be able to output. When this keyword is activated "// &
268 : "all iteration levels are checked for the last iteration step.", &
269 : usage="ADD_LAST (NO|NUMERIC|SYMBOLIC)", &
270 : enum_c_vals=s2a("no", "numeric", "symbolic"), &
271 : enum_i_vals=(/add_last_no, add_last_numeric, add_last_symbolic/), &
272 : enum_desc=s2a("Do not mark last iteration specifically", &
273 : "Mark last iteration with its iteration number", &
274 : "Mark last iteration with lowercase letter l"), &
275 6117174 : default_i_val=my_add_last)
276 6117174 : CALL section_add_keyword(print_key_section, keyword)
277 6117174 : CALL keyword_release(keyword)
278 :
279 6117174 : my_comm_iter_levels = 0
280 6117174 : IF (PRESENT(common_iter_levels)) my_comm_iter_levels = common_iter_levels
281 : CALL keyword_create(keyword, __LOCATION__, name="COMMON_ITERATION_LEVELS", &
282 : description="How many iterations levels should be written"// &
283 : " in the same file (no extra information about the actual"// &
284 : " iteration level is written to the file)", &
285 : usage="COMMON_ITERATION_LEVELS <INTEGER>", &
286 6117174 : default_i_val=my_comm_iter_levels)
287 6117174 : CALL section_add_keyword(print_key_section, keyword)
288 6117174 : CALL keyword_release(keyword)
289 :
290 6117174 : my_filename = ""
291 6117174 : IF (PRESENT(filename)) my_filename = filename
292 : CALL keyword_create(keyword, __LOCATION__, name="FILENAME", &
293 : description=' controls part of the filename for output. '// &
294 : ' use __STD_OUT__ (exactly as written here) for the screen or standard logger. '// &
295 : ' use filename to obtain projectname-filename. '// &
296 : ' use ./filename to get filename.'// &
297 : ' A middle name (if present), iteration numbers'// &
298 : ' and extension are always added to the filename.'// &
299 : ' if you want to avoid it use =filename, in this'// &
300 : ' case the filename is always exactly as typed.'// &
301 : ' Please note that this can lead to clashes of'// &
302 : ' filenames.', &
303 : usage="FILENAME ./filename ", &
304 6117174 : default_lc_val=my_filename)
305 6117174 : CALL section_add_keyword(print_key_section, keyword)
306 6117174 : CALL keyword_release(keyword)
307 :
308 : CALL keyword_create(keyword, __LOCATION__, name="LOG_PRINT_KEY", &
309 : description="This keywords enables the logger for the print_key (a message is printed on "// &
310 : "screen everytime data, controlled by this print_key, are written)", &
311 6117174 : usage="LOG_PRINT_KEY <LOGICAL>", default_l_val=.FALSE., lone_keyword_l_val=.TRUE.)
312 6117174 : CALL section_add_keyword(print_key_section, keyword)
313 6117174 : CALL keyword_release(keyword)
314 :
315 6117174 : IF (PRESENT(unit_str)) THEN
316 : CALL keyword_create(keyword, __LOCATION__, name="UNIT", &
317 : description='Specify the unit of measurement for the quantity in output. '// &
318 : "All available CP2K units can be used.", &
319 331464 : usage="UNIT angstrom", default_c_val=TRIM(unit_str))
320 331464 : CALL section_add_keyword(print_key_section, keyword)
321 331464 : CALL keyword_release(keyword)
322 : END IF
323 6117174 : 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 16222562 : 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 8703642 : res = 0
358 8703642 : IF (PRESENT(first_time)) first_time = .FALSE.
359 8703642 : CPASSERT(basis_section%ref_count > 0)
360 8703642 : IF (PRESENT(used_print_key)) NULLIFY (used_print_key)
361 :
362 8703642 : IF (PRESENT(print_key_path)) THEN
363 8055644 : end_str = LEN_TRIM(print_key_path)
364 8055644 : to_path = INDEX(print_key_path, "/")
365 8055644 : IF (to_path < 1) THEN
366 6599671 : to_path = end_str + 1
367 : END IF
368 :
369 8055644 : IF (to_path > 1) THEN
370 : print_key => section_vals_get_subs_vals(basis_section, &
371 7872579 : print_key_path(1:(to_path - 1)))
372 : ELSE
373 183065 : print_key => basis_section
374 : END IF
375 8055644 : CPASSERT(ASSOCIATED(print_key))
376 8055644 : CPASSERT(print_key%ref_count > 0)
377 8055644 : IF (to_path + 1 < end_str) THEN
378 : CALL section_vals_val_get(print_key, print_key_path((to_path + 1):end_str), &
379 1455973 : l_val=flags)
380 : ELSE
381 6599671 : flags = .TRUE.
382 : END IF
383 : ELSE
384 647998 : print_key => basis_section
385 647998 : flags = .TRUE.
386 : END IF
387 8703642 : IF (PRESENT(used_print_key)) used_print_key => print_key
388 :
389 8703642 : IF (.NOT. flags) RETURN
390 :
391 : CALL section_vals_val_get(print_key, "__CONTROL_VAL", &
392 7518920 : i_val=my_control_val)
393 7518920 : is_on = cp_printkey_is_on(iteration_info, print_key)
394 :
395 : ! a shortcut for most common case
396 7518920 : IF (my_control_val == cp_out_default .AND. .NOT. is_on) RETURN
397 :
398 2231621 : is_iter = cp_printkey_is_iter(iteration_info, print_key, first_time=first_time)
399 :
400 2231621 : IF (BTEST(my_control_val, cp_p_store)) THEN
401 : res = IBSET(res, cp_p_store)
402 2231621 : 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 2231621 : ELSE IF (BTEST(my_control_val, cp_p_store_each) .AND. is_iter) THEN
405 0 : res = IBSET(res, cp_p_store)
406 : END IF
407 :
408 2231621 : IF (BTEST(my_control_val, cp_p_file)) THEN
409 0 : res = IBSET(res, cp_p_file)
410 2231621 : ELSE IF (BTEST(my_control_val, cp_p_file_if) .AND. is_iter .AND. is_on) THEN
411 1802763 : res = IBSET(res, cp_p_file)
412 428858 : ELSE IF (BTEST(my_control_val, cp_p_file_each) .AND. is_iter) THEN
413 0 : res = IBSET(res, cp_p_file)
414 : END IF
415 2231621 : IF (BTEST(my_control_val, cp_p_calc) .OR. res /= 0) THEN
416 1802763 : 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 7526350 : 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 7526350 : CPASSERT(iteration_info%ref_count > 0)
436 7526350 : IF (.NOT. ASSOCIATED(print_key)) THEN
437 0 : res = (iteration_info%print_level > debug_print_level)
438 : ELSE
439 7526350 : CPASSERT(print_key%ref_count > 0)
440 7526350 : CALL section_vals_val_get(print_key, "_SECTION_PARAMETERS_", i_val=print_level)
441 7526350 : res = iteration_info%print_level >= print_level
442 : END IF
443 7526350 : 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 2231621 : 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 2231621 : CPASSERT(iteration_info%ref_count > 0)
467 2231621 : IF (.NOT. ASSOCIATED(print_key)) THEN
468 0 : res = (iteration_info%print_level > debug_print_level)
469 0 : first = ALL(iteration_info%iteration(1:iteration_info%n_rlevel) == 1)
470 : ELSE
471 2231621 : CPASSERT(print_key%ref_count > 0)
472 2231621 : res = .FALSE.
473 2231621 : first = .FALSE.
474 2231621 : CALL section_vals_val_get(print_key, "ADD_LAST", i_val=add_last)
475 2231621 : res = .TRUE.
476 2231621 : first = .TRUE.
477 6572370 : DO ilevel = 1, iteration_info%n_rlevel
478 4340749 : level_passed = .FALSE.
479 : CALL section_vals_val_get(print_key, "EACH%"//TRIM(iteration_info%level_name(ilevel)), &
480 4340749 : i_val=ival)
481 4340749 : IF (ival > 0) THEN
482 4311637 : iter_nr = iteration_info%iteration(ilevel)
483 4311637 : IF (iter_nr/ival > 1) first = .FALSE.
484 4311637 : IF (MODULO(iter_nr, ival) == 0) THEN
485 3616760 : level_passed = .TRUE.
486 : END IF
487 : END IF
488 4340749 : IF (add_last == add_last_numeric .OR. add_last == add_last_symbolic) THEN
489 2315586 : IF (iteration_info%last_iter(ilevel)) THEN
490 : level_passed = .TRUE.
491 : END IF
492 : END IF
493 6428868 : IF (.NOT. level_passed) res = .FALSE.
494 : END DO
495 : END IF
496 2231621 : first = first .AND. res
497 2231621 : IF (PRESENT(first_time)) first_time = first
498 2231621 : 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 98892 : 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 98892 : res = ""
528 98892 : my_for_file = .FALSE.
529 98892 : IF (PRESENT(for_file)) my_for_file = for_file
530 98892 : CPASSERT(ASSOCIATED(iter_info))
531 98892 : CPASSERT(iter_info%ref_count > 0)
532 98892 : NULLIFY (my_print_key)
533 98892 : IF (PRESENT(print_key)) my_print_key => print_key
534 98892 : s_level = 1
535 97549 : IF (ASSOCIATED(my_print_key)) THEN
536 97549 : CALL section_vals_val_get(my_print_key, "ADD_LAST", i_val=add_last)
537 97549 : CALL section_vals_val_get(my_print_key, "COMMON_ITERATION_LEVELS", i_val=c_i_level)
538 97549 : n_rlevel = iter_info%n_rlevel
539 97549 : IF (my_for_file) n_rlevel = MIN(n_rlevel, MAX(0, n_rlevel - c_i_level))
540 174272 : DO ilevel = s_level, n_rlevel
541 174272 : IF (iter_info%last_iter(ilevel)) THEN
542 687 : IF (add_last == add_last_symbolic) THEN
543 0 : WRITE (res(9*ilevel - 8:9*ilevel), "('l_')")
544 : ELSE
545 687 : WRITE (res(9*ilevel - 8:9*ilevel), "(i8,'_')") iter_info%iteration(ilevel)
546 : END IF
547 : ELSE
548 76036 : WRITE (res(9*ilevel - 8:9*ilevel), "(i8,'_')") iter_info%iteration(ilevel)
549 : END IF
550 : END DO
551 : ELSE
552 3648 : DO ilevel = s_level, iter_info%n_rlevel
553 3648 : WRITE (res(9*ilevel - 8:9*ilevel), "(i8,'_')") iter_info%iteration(ilevel)
554 : END DO
555 : END IF
556 98892 : CALL compress(res, .TRUE.)
557 98892 : IF (LEN_TRIM(res) > 0) THEN
558 72454 : res(LEN_TRIM(res):LEN_TRIM(res)) = " "
559 : END IF
560 98892 : 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 285216 : 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 285216 : my_last = .FALSE.
583 285216 : my_increment = 1
584 285216 : IF (PRESENT(last)) my_last = last
585 285216 : IF (PRESENT(increment)) my_increment = increment
586 285216 : IF (PRESENT(iter_nr_out)) iter_nr_out = -1
587 :
588 285216 : CPASSERT(ASSOCIATED(iteration_info))
589 285216 : CPASSERT(iteration_info%ref_count > 0)
590 285216 : IF (PRESENT(iter_nr)) THEN
591 246407 : iteration_info%iteration(iteration_info%n_rlevel) = iter_nr
592 : ELSE
593 : iteration_info%iteration(iteration_info%n_rlevel) = &
594 38809 : iteration_info%iteration(iteration_info%n_rlevel) + my_increment
595 : END IF
596 : ! If requested provide the value of the iteration level
597 285216 : IF (PRESENT(iter_nr_out)) iter_nr_out = iteration_info%iteration(iteration_info%n_rlevel)
598 :
599 : ! Possibly setup the LAST flag
600 285216 : iteration_info%last_iter(iteration_info%n_rlevel) = my_last
601 285216 : END SUBROUTINE cp_iterate
602 :
603 : ! **************************************************************************************************
604 : !> \brief Return the index of an iteration level by its name.
605 : !> \param iteration_info the iteration info to query
606 : !> \param level_name level name to query.
607 : !> \return iteration level index or 0 if there is no such level
608 : !> \author Sergey Chulkov
609 : ! **************************************************************************************************
610 0 : FUNCTION cp_get_iter_level_by_name(iteration_info, level_name) RESULT(rlevel)
611 : TYPE(cp_iteration_info_type), INTENT(IN), POINTER :: iteration_info
612 : CHARACTER(LEN=*), INTENT(IN) :: level_name
613 : INTEGER :: rlevel
614 :
615 0 : CPASSERT(ASSOCIATED(iteration_info))
616 0 : CPASSERT(iteration_info%ref_count > 0)
617 0 : DO rlevel = iteration_info%n_rlevel, 1, -1
618 0 : IF (iteration_info%level_name(rlevel) == level_name) EXIT
619 : END DO
620 :
621 0 : END FUNCTION cp_get_iter_level_by_name
622 :
623 : ! **************************************************************************************************
624 : !> \brief Return the current iteration number at a given level.
625 : !> \param iteration_info the iteration info to query
626 : !> \param rlevel index of the iteration level. Use the level on top of the stack,
627 : !> if it is not given
628 : !> \param iter_nr iteration number [out]
629 : !> \param last_iter last iteration flag [out]
630 : !> \author Sergey Chulkov
631 : ! **************************************************************************************************
632 0 : 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 0 : CPASSERT(ASSOCIATED(iteration_info))
641 0 : CPASSERT(iteration_info%ref_count > 0)
642 0 : IF (PRESENT(rlevel)) THEN
643 0 : CPASSERT(rlevel > 0 .AND. rlevel <= iteration_info%n_rlevel)
644 : ilevel = rlevel
645 : ELSE
646 0 : ilevel = iteration_info%n_rlevel
647 : END IF
648 :
649 0 : IF (PRESENT(iter_nr)) iter_nr = iteration_info%iteration(ilevel)
650 0 : IF (PRESENT(last_iter)) last_iter = iteration_info%last_iter(ilevel)
651 0 : END SUBROUTINE cp_get_iter_nr
652 :
653 : ! **************************************************************************************************
654 : !> \brief Adds an iteration level
655 : !> \param iteration_info 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 40137 : SUBROUTINE cp_add_iter_level(iteration_info, level_name, n_rlevel_new)
662 : TYPE(cp_iteration_info_type), POINTER :: iteration_info
663 : CHARACTER(LEN=*), INTENT(IN) :: level_name
664 : INTEGER, INTENT(OUT), OPTIONAL :: n_rlevel_new
665 :
666 : INTEGER :: i
667 : LOGICAL :: found
668 :
669 0 : CPASSERT(ASSOCIATED(iteration_info))
670 40137 : CPASSERT(iteration_info%ref_count > 0)
671 40137 : found = .FALSE.
672 227930 : DO i = 1, SIZE(each_possible_labels)
673 227930 : IF (TRIM(level_name) == TRIM(each_possible_labels(i))) THEN
674 : found = .TRUE.
675 : EXIT
676 : END IF
677 : END DO
678 40137 : IF (found) THEN
679 40137 : CALL cp_iteration_info_retain(iteration_info)
680 40137 : iteration_info%n_rlevel = iteration_info%n_rlevel + 1
681 40137 : CALL reallocate(iteration_info%iteration, 1, iteration_info%n_rlevel)
682 40137 : CALL reallocate(iteration_info%level_name, 1, iteration_info%n_rlevel)
683 40137 : CALL reallocate(iteration_info%last_iter, 1, iteration_info%n_rlevel)
684 40137 : iteration_info%iteration(iteration_info%n_rlevel) = 0
685 40137 : iteration_info%level_name(iteration_info%n_rlevel) = level_name
686 40137 : iteration_info%last_iter(iteration_info%n_rlevel) = .FALSE.
687 40137 : IF (PRESENT(n_rlevel_new)) n_rlevel_new = iteration_info%n_rlevel
688 : ELSE
689 : CALL cp_abort(__LOCATION__, &
690 : "Trying to create an iteration level ("//TRIM(level_name)//") not defined. "// &
691 0 : "Please update the module: cp_iter_types.")
692 : END IF
693 :
694 40137 : END SUBROUTINE cp_add_iter_level
695 :
696 : ! **************************************************************************************************
697 : !> \brief Removes an iteration level
698 : !> \param iteration_info the iteration info to which an iteration level has
699 : !> to be removed
700 : !> \param level_name level_name to be destroyed (if does not match gives an error)
701 : !> \param n_rlevel_att iteration level before the call (to do some checks)
702 : !> \author fawzi
703 : ! **************************************************************************************************
704 40137 : SUBROUTINE cp_rm_iter_level(iteration_info, level_name, n_rlevel_att)
705 : TYPE(cp_iteration_info_type), POINTER :: iteration_info
706 : CHARACTER(LEN=*), INTENT(IN) :: level_name
707 : INTEGER, INTENT(IN), OPTIONAL :: n_rlevel_att
708 :
709 : LOGICAL :: check
710 :
711 40137 : CPASSERT(ASSOCIATED(iteration_info))
712 40137 : CPASSERT(iteration_info%ref_count > 0)
713 40137 : IF (PRESENT(n_rlevel_att)) THEN
714 5118 : CPASSERT(n_rlevel_att == iteration_info%n_rlevel)
715 : END IF
716 40137 : CALL cp_iteration_info_release(iteration_info)
717 : ! This check that the iteration levels are consistently created and destroyed..
718 : ! Never remove this check..
719 40137 : check = iteration_info%level_name(iteration_info%n_rlevel) == level_name
720 40137 : CPASSERT(check)
721 40137 : iteration_info%n_rlevel = iteration_info%n_rlevel - 1
722 40137 : CALL reallocate(iteration_info%iteration, 1, iteration_info%n_rlevel)
723 40137 : CALL reallocate(iteration_info%level_name, 1, iteration_info%n_rlevel)
724 40137 : CALL reallocate(iteration_info%last_iter, 1, iteration_info%n_rlevel)
725 40137 : END SUBROUTINE cp_rm_iter_level
726 :
727 : ! **************************************************************************************************
728 : !> \brief Utility function that returns a unit number to write the print key.
729 : !> Might open a file with a unique filename, generated from
730 : !> the print_key name and iteration info.
731 : !>
732 : !> Normally a valid unit (>0) is returned only if cp_print_key_should_output
733 : !> says that the print_key should be printed, and if the unit is global
734 : !> only the io node has a valid unit.
735 : !> So in many cases you can decide if you should print just checking if
736 : !> the returned units is bigger than 0.
737 : !>
738 : !> IMPORTANT you should call cp_finished_output when an iteration output is
739 : !> finished (to immediately close the file that might have been opened)
740 : !> \param logger the logger for the parallel environment, iteration info
741 : !> and filename generation
742 : !> \param print_key ...
743 : !> \param middle_name name to be added to the generated filename, useful when
744 : !> print_key activates different distinct outputs, to be able to
745 : !> distinguish them
746 : !> \param extension extension to be applied to the filename (including the ".")
747 : !> \param my_local if the unit should be local to this task, or global to the
748 : !> program (defaults to false).
749 : !> \return ...
750 : !> \author Fawzi Mohamed
751 : ! **************************************************************************************************
752 98068 : FUNCTION cp_print_key_generate_filename(logger, print_key, middle_name, extension, &
753 : my_local) RESULT(filename)
754 : TYPE(cp_logger_type), POINTER :: logger
755 : TYPE(section_vals_type), POINTER :: print_key
756 : CHARACTER(len=*), INTENT(IN), OPTIONAL :: middle_name
757 : CHARACTER(len=*), INTENT(IN) :: extension
758 : LOGICAL, INTENT(IN) :: my_local
759 : CHARACTER(len=default_path_length) :: filename
760 :
761 : CHARACTER(len=default_path_length) :: outPath, postfix, root
762 : CHARACTER(len=default_string_length) :: my_middle_name, outName
763 : INTEGER :: my_ind1, my_ind2
764 : LOGICAL :: has_root
765 :
766 98068 : CALL section_vals_val_get(print_key, "FILENAME", c_val=outPath)
767 98068 : IF (outPath(1:1) == '=') THEN
768 : CPASSERT(LEN(outPath) - 1 <= LEN(filename))
769 580 : filename = outPath(2:)
770 580 : RETURN
771 : END IF
772 97488 : IF (outPath == "__STD_OUT__") outPath = ""
773 97488 : outName = outPath
774 97488 : has_root = .FALSE.
775 97488 : my_ind1 = INDEX(outPath, "/")
776 97488 : my_ind2 = LEN_TRIM(outPath)
777 97488 : IF (my_ind1 /= 0) THEN
778 3725 : has_root = .TRUE.
779 3725 : DO WHILE (INDEX(outPath(my_ind1 + 1:my_ind2), "/") /= 0)
780 3725 : my_ind1 = INDEX(outPath(my_ind1 + 1:my_ind2), "/") + my_ind1
781 : END DO
782 3725 : IF (my_ind1 == my_ind2) THEN
783 0 : outName = ""
784 : ELSE
785 3725 : outName = outPath(my_ind1 + 1:my_ind2)
786 : END IF
787 : END IF
788 :
789 97488 : IF (PRESENT(middle_name)) THEN
790 38673 : IF (outName /= "") THEN
791 606 : my_middle_name = "-"//TRIM(outName)//"-"//middle_name
792 : ELSE
793 38067 : my_middle_name = "-"//middle_name
794 : END IF
795 : ELSE
796 58815 : IF (outName /= "") THEN
797 24256 : my_middle_name = "-"//TRIM(outName)
798 : ELSE
799 34559 : my_middle_name = ""
800 : END IF
801 : END IF
802 :
803 97488 : IF (.NOT. has_root) THEN
804 93763 : root = TRIM(logger%iter_info%project_name)//TRIM(my_middle_name)
805 3725 : ELSE IF (outName == "") THEN
806 0 : root = outPath(1:my_ind1)//TRIM(logger%iter_info%project_name)//TRIM(my_middle_name)
807 : ELSE
808 3725 : root = outPath(1:my_ind1)//my_middle_name(2:LEN_TRIM(my_middle_name))
809 : END IF
810 :
811 : ! use the cp_iter_string as a postfix
812 97488 : postfix = "-"//TRIM(cp_iter_string(logger%iter_info, print_key=print_key, for_file=.TRUE.))
813 97488 : IF (TRIM(postfix) == "-") postfix = ""
814 :
815 : ! and add the extension
816 97488 : postfix = TRIM(postfix)//extension
817 : ! and let the logger generate the filename
818 : CALL cp_logger_generate_filename(logger, res=filename, &
819 97488 : root=root, postfix=postfix, local=my_local)
820 :
821 : END FUNCTION cp_print_key_generate_filename
822 :
823 : ! **************************************************************************************************
824 : !> \brief ...
825 : !> \param logger ...
826 : !> \param basis_section ...
827 : !> \param print_key_path ...
828 : !> \param extension ...
829 : !> \param middle_name ...
830 : !> \param local ...
831 : !> \param log_filename ...
832 : !> \param ignore_should_output ...
833 : !> \param file_form ...
834 : !> \param file_position ...
835 : !> \param file_action ...
836 : !> \param file_status ...
837 : !> \param do_backup ...
838 : !> \param on_file ...
839 : !> \param is_new_file true if this rank created a new (or rewound) file, false otherwise
840 : !> \param mpi_io True if the file should be opened in parallel on all processors belonging to
841 : !> the communicator group. Automatically disabled if the file form or access mode
842 : !> is unsuitable for MPI IO. Return value indicates whether MPI was actually used
843 : !> and therefore the flag must also be passed to the file closing directive.
844 : !> \param fout Name of the actual file where the output will be written. Needed mainly for MPI IO
845 : !> because inquiring the filename from the MPI filehandle does not work across
846 : !> all MPI libraries.
847 : !> \return ...
848 : ! **************************************************************************************************
849 2841915 : FUNCTION cp_print_key_unit_nr(logger, basis_section, print_key_path, extension, &
850 : middle_name, local, log_filename, ignore_should_output, file_form, file_position, &
851 : file_action, file_status, do_backup, on_file, is_new_file, mpi_io, &
852 : fout) RESULT(res)
853 : TYPE(cp_logger_type), POINTER :: logger
854 : TYPE(section_vals_type), INTENT(IN) :: basis_section
855 : CHARACTER(len=*), INTENT(IN), OPTIONAL :: print_key_path
856 : CHARACTER(len=*), INTENT(IN) :: extension
857 : CHARACTER(len=*), INTENT(IN), OPTIONAL :: middle_name
858 : LOGICAL, INTENT(IN), OPTIONAL :: local, log_filename, ignore_should_output
859 : CHARACTER(len=*), INTENT(IN), OPTIONAL :: file_form, file_position, file_action, &
860 : file_status
861 : LOGICAL, INTENT(IN), OPTIONAL :: do_backup, on_file
862 : LOGICAL, INTENT(OUT), OPTIONAL :: is_new_file
863 : LOGICAL, INTENT(INOUT), OPTIONAL :: mpi_io
864 : CHARACTER(len=default_path_length), INTENT(OUT), &
865 : OPTIONAL :: fout
866 : INTEGER :: res
867 :
868 : CHARACTER(len=default_path_length) :: filename, filename_bak, filename_bak_1, &
869 : filename_bak_2
870 : CHARACTER(len=default_string_length) :: my_file_action, my_file_form, &
871 : my_file_position, my_file_status, &
872 : outPath
873 : INTEGER :: c_i_level, f_backup_level, i, mpi_amode, &
874 : my_backup_level, my_nbak, nbak, &
875 : s_backup_level, unit_nr
876 : LOGICAL :: do_log, found, my_do_backup, my_local, &
877 : my_mpi_io, my_on_file, &
878 : my_should_output, replace
879 : TYPE(cp_iteration_info_type), POINTER :: iteration_info
880 : TYPE(mp_file_type) :: mp_unit
881 : TYPE(section_vals_type), POINTER :: print_key
882 :
883 2841915 : my_local = .FALSE.
884 2841915 : my_do_backup = .FALSE.
885 2841915 : my_mpi_io = .FALSE.
886 2841915 : replace = .FALSE.
887 2841915 : found = .FALSE.
888 2841915 : res = -1
889 2841915 : my_file_form = "FORMATTED"
890 2841915 : my_file_position = "APPEND"
891 2841915 : my_file_action = "WRITE"
892 2841915 : my_file_status = "UNKNOWN"
893 2841915 : my_on_file = .FALSE.
894 2841915 : mpi_amode = 0
895 357615 : IF (PRESENT(file_form)) my_file_form = file_form
896 2841915 : IF (PRESENT(file_position)) my_file_position = file_position
897 2841915 : IF (PRESENT(file_action)) my_file_action = file_action
898 2841915 : IF (PRESENT(file_status)) my_file_status = file_status
899 2841915 : IF (PRESENT(do_backup)) my_do_backup = do_backup
900 2841915 : IF (PRESENT(on_file)) my_on_file = on_file
901 2841915 : IF (PRESENT(local)) my_local = local
902 2841915 : IF (PRESENT(is_new_file)) is_new_file = .FALSE.
903 2841915 : IF (PRESENT(mpi_io)) THEN
904 : #if defined(__parallel)
905 2010 : IF (cp_mpi_io_get() .AND. logger%para_env%num_pe > 1 .AND. mpi_io) THEN
906 : my_mpi_io = .TRUE.
907 : ELSE
908 : my_mpi_io = .FALSE.
909 : END IF
910 : IF (my_mpi_io) THEN
911 : CALL mp_file_get_amode(mpi_io, replace, mpi_amode, TRIM(my_file_form), &
912 2010 : TRIM(my_file_action), TRIM(my_file_status), TRIM(my_file_position))
913 3858 : replace = replace .AND. logger%para_env%is_source()
914 : END IF
915 : #else
916 : my_mpi_io = .FALSE.
917 : #endif
918 : ! Set return value
919 2010 : mpi_io = my_mpi_io
920 : END IF
921 2841915 : NULLIFY (print_key)
922 2841915 : CPASSERT(ASSOCIATED(logger))
923 2841915 : CPASSERT(basis_section%ref_count > 0)
924 2841915 : CPASSERT(logger%ref_count > 0)
925 : my_should_output = BTEST(cp_print_key_should_output(logger%iter_info, &
926 2848130 : basis_section, print_key_path, used_print_key=print_key), cp_p_file)
927 2841915 : IF (PRESENT(ignore_should_output)) my_should_output = my_should_output .OR. ignore_should_output
928 2832539 : IF (.NOT. my_should_output) RETURN
929 : IF (my_local .OR. &
930 876645 : logger%para_env%is_source() .OR. &
931 : my_mpi_io) THEN
932 :
933 457819 : CALL section_vals_val_get(print_key, "FILENAME", c_val=outPath)
934 457819 : IF (outPath == '__STD_OUT__' .AND. .NOT. my_on_file) THEN
935 367826 : res = cp_logger_get_default_unit_nr(logger, local=my_local)
936 : ELSE
937 : !
938 : ! complex logic to build filename:
939 : ! 1) Try to avoid '--' and '-.'
940 : ! 2) If outPath contains '/' (as in ./filename) do not prepend the project_name
941 : !
942 : ! if it is actually a full path, use it as the root
943 : filename = cp_print_key_generate_filename(logger, print_key, middle_name, extension, &
944 147060 : my_local)
945 : ! Give back info about a possible existence of the file if required
946 89993 : IF (PRESENT(is_new_file)) THEN
947 49454 : INQUIRE (FILE=filename, EXIST=found)
948 49454 : is_new_file = .NOT. found
949 49454 : IF (my_file_position == "REWIND") is_new_file = .TRUE.
950 : END IF
951 : ! Check is we have to log any operation performed on the file..
952 : do_log = .FALSE.
953 89993 : IF (PRESENT(log_filename)) THEN
954 2238 : do_log = log_filename
955 : ELSE
956 87755 : CALL section_vals_val_get(print_key, "LOG_PRINT_KEY", l_val=do_log)
957 : END IF
958 : ! If required do a backup
959 89993 : IF (my_do_backup) THEN
960 17378 : INQUIRE (FILE=filename, EXIST=found)
961 17378 : CALL section_vals_val_get(print_key, "BACKUP_COPIES", i_val=nbak)
962 17378 : IF (nbak /= 0) THEN
963 14654 : iteration_info => logger%iter_info
964 14654 : s_backup_level = 0
965 14654 : IF (ASSOCIATED(print_key%ibackup)) s_backup_level = SIZE(print_key%ibackup)
966 14654 : CALL section_vals_val_get(print_key, "COMMON_ITERATION_LEVELS", i_val=c_i_level)
967 14654 : my_backup_level = MAX(1, iteration_info%n_rlevel - c_i_level + 1)
968 14654 : f_backup_level = MAX(s_backup_level, my_backup_level)
969 14654 : IF (f_backup_level > s_backup_level) THEN
970 3799 : CALL reallocate(print_key%ibackup, 1, f_backup_level)
971 8902 : DO i = s_backup_level + 1, f_backup_level
972 8902 : print_key%ibackup(i) = 0
973 : END DO
974 : END IF
975 14654 : IF (found) THEN
976 12025 : print_key%ibackup(my_backup_level) = print_key%ibackup(my_backup_level) + 1
977 12025 : my_nbak = print_key%ibackup(my_backup_level)
978 : ! Recent backup copies correspond to lower backup indexes
979 12037 : DO i = MIN(nbak, my_nbak), 2, -1
980 12 : filename_bak_1 = TRIM(filename)//".bak-"//ADJUSTL(cp_to_string(i))
981 12 : filename_bak_2 = TRIM(filename)//".bak-"//ADJUSTL(cp_to_string(i - 1))
982 12 : IF (do_log) THEN
983 12 : unit_nr = cp_logger_get_unit_nr(logger, local=my_local)
984 12 : IF (unit_nr > 0) &
985 : WRITE (unit_nr, *) "Moving file "//TRIM(filename_bak_2)// &
986 12 : " into file "//TRIM(filename_bak_1)//"."
987 : END IF
988 12 : INQUIRE (FILE=filename_bak_2, EXIST=found)
989 12037 : IF (.NOT. found) THEN
990 0 : IF (do_log) THEN
991 0 : unit_nr = cp_logger_get_unit_nr(logger, local=my_local)
992 0 : IF (unit_nr > 0) &
993 0 : WRITE (unit_nr, *) "File "//TRIM(filename_bak_2)//" not existing.."
994 : END IF
995 : ELSE
996 12 : CALL m_mov(TRIM(filename_bak_2), TRIM(filename_bak_1))
997 : END IF
998 : END DO
999 : ! The last backup is always the one with index 1
1000 12025 : filename_bak = TRIM(filename)//".bak-"//ADJUSTL(cp_to_string(1))
1001 12025 : IF (do_log) THEN
1002 95 : unit_nr = cp_logger_get_unit_nr(logger, local=my_local)
1003 95 : IF (unit_nr > 0) &
1004 95 : WRITE (unit_nr, *) "Moving file "//TRIM(filename)//" into file "//TRIM(filename_bak)//"."
1005 : END IF
1006 12025 : CALL m_mov(TRIM(filename), TRIM(filename_bak))
1007 : ELSE
1008 : ! Zero the backup history for this new iteration level..
1009 2629 : print_key%ibackup(my_backup_level) = 0
1010 : END IF
1011 : END IF
1012 : END IF
1013 :
1014 89993 : IF (.NOT. my_mpi_io) THEN
1015 : CALL open_file(file_name=filename, file_status=my_file_status, &
1016 : file_form=my_file_form, file_action=my_file_action, &
1017 87983 : file_position=my_file_position, unit_number=res)
1018 : ELSE
1019 2010 : IF (replace) CALL mp_file_delete(filename)
1020 : CALL mp_unit%open(groupid=logger%para_env, &
1021 2010 : filepath=filename, amode_status=mpi_amode)
1022 2010 : IF (PRESENT(fout)) fout = filename
1023 2010 : res = mp_unit%get_handle()
1024 : END IF
1025 89993 : IF (do_log) THEN
1026 105 : unit_nr = cp_logger_get_unit_nr(logger, local=my_local)
1027 105 : IF (unit_nr > 0) &
1028 : WRITE (unit_nr, *) "Writing "//TRIM(print_key%section%name)//" "// &
1029 : TRIM(cp_iter_string(logger%iter_info))//" to "// &
1030 105 : TRIM(filename)
1031 : END IF
1032 : END IF
1033 : ELSE
1034 418826 : res = -1
1035 : END IF
1036 3718560 : END FUNCTION cp_print_key_unit_nr
1037 :
1038 : ! **************************************************************************************************
1039 : !> \brief should be called after you finish working with a unit obtained with
1040 : !> cp_print_key_unit_nr, so that the file that might have been opened
1041 : !> can be closed.
1042 : !>
1043 : !> the inputs should be exactly the same of the corresponding
1044 : !> cp_print_key_unit_nr
1045 : !> \param unit_nr ...
1046 : !> \param logger ...
1047 : !> \param basis_section ...
1048 : !> \param print_key_path ...
1049 : !> \param local ...
1050 : !> \param ignore_should_output ...
1051 : !> \param on_file ...
1052 : !> \param mpi_io True if file was opened in parallel with MPI
1053 : !> \par History
1054 : !> 08.2002 created [fawzi]
1055 : !> \author Fawzi Mohamed
1056 : !> \note
1057 : !> closes if the corresponding filename of the printkey is
1058 : !> not __STD_OUT__
1059 : ! **************************************************************************************************
1060 2701158 : SUBROUTINE cp_print_key_finished_output(unit_nr, logger, basis_section, &
1061 : print_key_path, local, ignore_should_output, on_file, &
1062 : mpi_io)
1063 : INTEGER, INTENT(INOUT) :: unit_nr
1064 : TYPE(cp_logger_type), POINTER :: logger
1065 : TYPE(section_vals_type), INTENT(IN) :: basis_section
1066 : CHARACTER(len=*), INTENT(IN), OPTIONAL :: print_key_path
1067 : LOGICAL, INTENT(IN), OPTIONAL :: local, ignore_should_output, on_file, &
1068 : mpi_io
1069 :
1070 : CHARACTER(len=default_string_length) :: outPath
1071 : LOGICAL :: my_local, my_mpi_io, my_on_file, &
1072 : my_should_output
1073 : TYPE(mp_file_type) :: mp_unit
1074 : TYPE(section_vals_type), POINTER :: print_key
1075 :
1076 2701158 : my_local = .FALSE.
1077 2701158 : my_on_file = .FALSE.
1078 2701158 : my_mpi_io = .FALSE.
1079 2701158 : NULLIFY (print_key)
1080 2418 : IF (PRESENT(local)) my_local = local
1081 2701158 : IF (PRESENT(on_file)) my_on_file = on_file
1082 2701158 : IF (PRESENT(mpi_io)) my_mpi_io = mpi_io
1083 2701158 : CPASSERT(ASSOCIATED(logger))
1084 2701158 : CPASSERT(basis_section%ref_count > 0)
1085 2701158 : CPASSERT(logger%ref_count > 0)
1086 : my_should_output = BTEST(cp_print_key_should_output(logger%iter_info, basis_section, &
1087 2730313 : print_key_path, used_print_key=print_key), cp_p_file)
1088 2701158 : IF (PRESENT(ignore_should_output)) my_should_output = my_should_output .OR. ignore_should_output
1089 2701158 : IF (my_should_output .AND. (my_local .OR. &
1090 : logger%para_env%is_source() .OR. &
1091 : my_mpi_io)) THEN
1092 392749 : CALL section_vals_val_get(print_key, "FILENAME", c_val=outPath)
1093 392749 : IF (my_on_file .OR. outPath .NE. '__STD_OUT__') THEN
1094 88046 : CPASSERT(unit_nr > 0)
1095 88046 : IF (.NOT. my_mpi_io) THEN
1096 86036 : CALL close_file(unit_nr, "KEEP")
1097 : ELSE
1098 2010 : CALL mp_unit%set_handle(unit_nr)
1099 2010 : CALL mp_unit%close()
1100 : END IF
1101 88046 : unit_nr = -1
1102 : ELSE
1103 304703 : unit_nr = -1
1104 : END IF
1105 : END IF
1106 2701158 : CPASSERT(unit_nr == -1)
1107 2701158 : unit_nr = -1
1108 2701158 : END SUBROUTINE cp_print_key_finished_output
1109 :
1110 : ! **************************************************************************************************
1111 : !> \brief Sets flag which determines whether or not to use MPI I/O for I/O routines that
1112 : !> have been parallized with MPI
1113 : !> \param flag ...
1114 : !> \par History
1115 : !> 09.2018 created [Nico Holmberg]
1116 : ! **************************************************************************************************
1117 9799 : SUBROUTINE cp_mpi_io_set(flag)
1118 : LOGICAL, INTENT(IN) :: flag
1119 :
1120 9799 : enable_mpi_io = flag
1121 9799 : END SUBROUTINE cp_mpi_io_set
1122 :
1123 : ! **************************************************************************************************
1124 : !> \brief Gets flag which determines whether or not to use MPI I/O for I/O routines that
1125 : !> have been parallized with MPI
1126 : !> \return ...
1127 : !> \par History
1128 : !> 09.2018 created [Nico Holmberg]
1129 : ! **************************************************************************************************
1130 2048 : FUNCTION cp_mpi_io_get() RESULT(flag)
1131 : LOGICAL :: flag
1132 :
1133 2048 : flag = enable_mpi_io
1134 2048 : END FUNCTION cp_mpi_io_get
1135 :
1136 0 : END MODULE cp_output_handling
|
