Line data Source code
1 : !--------------------------------------------------------------------------------------------------!
2 : ! CP2K: A general program to perform molecular dynamics simulations !
3 : ! Copyright 2000-2026 CP2K developers group <https://cp2k.org> !
4 : ! !
5 : ! SPDX-License-Identifier: GPL-2.0-or-later !
6 : !--------------------------------------------------------------------------------------------------!
7 :
8 : ! **************************************************************************************************
9 : !> \brief objects that represent the structure of input sections and the data
10 : !> contained in an input section
11 : !> \par History
12 : !> 06.2004 created [fawzi]
13 : !> \author fawzi
14 : ! **************************************************************************************************
15 : MODULE input_section_types
16 :
17 : USE cp_linked_list_input, ONLY: &
18 : cp_sll_val_create, cp_sll_val_dealloc, cp_sll_val_get_el_at, cp_sll_val_get_length, &
19 : cp_sll_val_get_rest, cp_sll_val_insert_el_at, cp_sll_val_next, cp_sll_val_p_type, &
20 : cp_sll_val_rm_el_at, cp_sll_val_set_el_at, cp_sll_val_type
21 : USE cp_log_handling, ONLY: cp_to_string
22 : USE cp_parser_types, ONLY: default_section_character
23 : USE input_keyword_types, ONLY: keyword_describe,&
24 : keyword_p_type,&
25 : keyword_release,&
26 : keyword_retain,&
27 : keyword_type,&
28 : keyword_typo_match,&
29 : write_keyword_xml
30 : USE input_val_types, ONLY: lchar_t,&
31 : no_t,&
32 : val_create,&
33 : val_duplicate,&
34 : val_get,&
35 : val_release,&
36 : val_type,&
37 : val_write
38 : USE kinds, ONLY: default_path_length,&
39 : default_string_length,&
40 : dp
41 : USE print_messages, ONLY: print_message
42 : USE reference_manager, ONLY: get_citation_key
43 : USE string_utilities, ONLY: a2s,&
44 : substitute_special_xml_tokens,&
45 : typo_match,&
46 : uppercase
47 : #include "../base/base_uses.f90"
48 :
49 : IMPLICIT NONE
50 : PRIVATE
51 :
52 : LOGICAL, PRIVATE, PARAMETER :: debug_this_module = .TRUE.
53 : CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'input_section_types'
54 :
55 : PUBLIC :: section_type
56 : PUBLIC :: section_create, section_release, section_describe, &
57 : section_get_subsection, section_get_keyword, &
58 : section_add_keyword, section_add_subsection
59 : PUBLIC :: section_get_subsection_index, section_get_keyword_index
60 :
61 : PUBLIC :: section_vals_type
62 : PUBLIC :: section_vals_create, section_vals_retain, section_vals_release, &
63 : section_vals_get, section_vals_get_subs_vals, section_vals_val_get, section_vals_list_get, &
64 : section_vals_write, section_vals_add_values, section_vals_get_subs_vals2, &
65 : section_vals_val_set, section_vals_val_unset, section_vals_get_subs_vals3, &
66 : section_vals_set_subs_vals, section_vals_duplicate, section_vals_remove_values
67 : PUBLIC :: write_section_xml
68 :
69 : PUBLIC :: section_get_ival, &
70 : section_get_ivals, &
71 : section_get_rval, &
72 : section_get_lval
73 : PUBLIC :: section_typo_match, typo_match_section, typo_matching_rank, typo_matching_line
74 :
75 : ! **************************************************************************************************
76 : !> \brief represent a pointer to a section (to make arrays of pointers)
77 : !> \param section the pointer to the section
78 : !> \author fawzi
79 : ! **************************************************************************************************
80 : TYPE section_p_type
81 : TYPE(section_type), POINTER :: section => NULL()
82 : END TYPE section_p_type
83 :
84 : ! **************************************************************************************************
85 : !> \brief represent a section of the input file
86 : !> \note
87 : !> - frozen: if the section has been frozen (and no keyword/subsections
88 : !> can be added)
89 : !> - repeats: if the section can be repeated more than once in the same
90 : !> context
91 : !> - ref_count: reference count (see doc/ReferenceCounting.html)
92 : !> - n_keywords: the number of keywords in this section
93 : !> - name: name of the section
94 : !> - location where in the source code (file and line) the section is created
95 : !> - description: description of the section
96 : !> - citations: references to literature associated to this section
97 : !> - keywords: array with the keywords of this section (might be
98 : !> oversized)
99 : !> - subsections: sections contained in this section
100 : !> \author fawzi
101 : ! **************************************************************************************************
102 : TYPE section_type
103 : LOGICAL :: frozen = .FALSE., repeats = .FALSE.
104 : INTEGER :: ref_count = 0, n_keywords = 0, n_subsections = 0
105 : CHARACTER(len=default_string_length) :: name = ""
106 : CHARACTER(len=default_string_length) :: location = ""
107 : CHARACTER, DIMENSION(:), POINTER :: description => Null()
108 : CHARACTER(LEN=:), ALLOCATABLE :: deprecation_notice
109 : INTEGER, POINTER, DIMENSION(:) :: citations => NULL()
110 : TYPE(keyword_p_type), DIMENSION(:), POINTER :: keywords => NULL()
111 : TYPE(section_p_type), POINTER, DIMENSION(:) :: subsections => NULL()
112 : END TYPE section_type
113 :
114 : ! **************************************************************************************************
115 : !> \brief repesents a pointer to a parsed section (to make arrays of pointers)
116 : !> \param section_vals the pointer to the parsed section
117 : !> \author fawzi
118 : ! **************************************************************************************************
119 : TYPE section_vals_p_type
120 : TYPE(section_vals_type), POINTER :: section_vals => NULL()
121 : END TYPE section_vals_p_type
122 :
123 : ! **************************************************************************************************
124 : !> \brief stores the values of a section
125 : !> \author fawzi
126 : ! **************************************************************************************************
127 : TYPE section_vals_type
128 : INTEGER :: ref_count = 0
129 : INTEGER, POINTER, DIMENSION(:) :: ibackup => NULL()
130 : TYPE(section_type), POINTER :: section => NULL()
131 : TYPE(cp_sll_val_p_type), DIMENSION(:, :), POINTER :: values => NULL()
132 : TYPE(section_vals_p_type), DIMENSION(:, :), POINTER :: subs_vals => NULL()
133 : END TYPE section_vals_type
134 :
135 : TYPE(section_type), POINTER, SAVE :: typo_match_section => NULL()
136 : INTEGER, PARAMETER :: n_typo_matches = 5
137 : INTEGER, DIMENSION(n_typo_matches) :: typo_matching_rank = 0
138 : CHARACTER(LEN=default_string_length*5), DIMENSION(n_typo_matches):: typo_matching_line = ""
139 :
140 : CONTAINS
141 :
142 : ! **************************************************************************************************
143 : !> \brief creates a list of keywords
144 : !> \param section the list to be created
145 : !> \param location from where in the source code section_create() is called
146 : !> \param name ...
147 : !> \param description ...
148 : !> \param n_keywords hint about the number of keywords, defaults to 10
149 : !> \param n_subsections a hint about how many sections will be added to this
150 : !> structure, defaults to 0
151 : !> \param repeats if this section can repeat (defaults to false)
152 : !> \param citations ...
153 : !> \param deprecation_notice show this warning that the section is deprecated
154 : !> \author fawzi
155 : ! **************************************************************************************************
156 111866071 : SUBROUTINE section_create(section, location, name, description, n_keywords, &
157 6462447 : n_subsections, repeats, citations, deprecation_notice)
158 :
159 : TYPE(section_type), POINTER :: section
160 : CHARACTER(len=*), INTENT(in) :: location, name, description
161 : INTEGER, INTENT(in), OPTIONAL :: n_keywords, n_subsections
162 : LOGICAL, INTENT(in), OPTIONAL :: repeats
163 : INTEGER, DIMENSION(:), INTENT(IN), OPTIONAL :: citations
164 : CHARACTER(len=*), INTENT(IN), OPTIONAL :: deprecation_notice
165 :
166 : INTEGER :: i, my_n_keywords, my_n_subsections, n
167 :
168 111866071 : CPASSERT(.NOT. ASSOCIATED(section))
169 111866071 : my_n_keywords = 10
170 111866071 : IF (PRESENT(n_keywords)) my_n_keywords = n_keywords
171 111866071 : my_n_subsections = 0
172 111866071 : IF (PRESENT(n_subsections)) my_n_subsections = n_subsections
173 :
174 111866071 : ALLOCATE (section)
175 111866071 : section%ref_count = 1
176 :
177 111866071 : section%n_keywords = 0
178 111866071 : section%n_subsections = 0
179 111866071 : section%location = location
180 :
181 111866071 : CPASSERT(LEN_TRIM(name) > 0)
182 111866071 : section%name = name
183 111866071 : CALL uppercase(section%name)
184 :
185 111866071 : n = LEN_TRIM(description)
186 335447337 : ALLOCATE (section%description(n))
187 9835761021 : DO i = 1, n
188 9835761021 : section%description(i) = description(i:i)
189 : END DO
190 :
191 111866071 : section%frozen = .FALSE.
192 111866071 : section%repeats = .FALSE.
193 111866071 : IF (PRESENT(repeats)) section%repeats = repeats
194 :
195 111866071 : NULLIFY (section%citations)
196 111866071 : IF (PRESENT(citations)) THEN
197 19387341 : ALLOCATE (section%citations(SIZE(citations)))
198 18790907 : section%citations = citations
199 : END IF
200 :
201 1189858734 : ALLOCATE (section%keywords(-1:my_n_keywords))
202 966126592 : DO i = -1, my_n_keywords
203 966126592 : NULLIFY (section%keywords(i)%keyword)
204 : END DO
205 :
206 239088074 : ALLOCATE (section%subsections(my_n_subsections))
207 121748210 : DO i = 1, my_n_subsections
208 121748210 : NULLIFY (section%subsections(i)%section)
209 : END DO
210 :
211 111866071 : IF (PRESENT(deprecation_notice)) THEN
212 10643 : section%deprecation_notice = TRIM(deprecation_notice)
213 : END IF
214 :
215 111866071 : END SUBROUTINE section_create
216 :
217 : ! **************************************************************************************************
218 : !> \brief retains the given keyword list (see doc/ReferenceCounting.html)
219 : !> \param section the list to retain
220 : !> \author fawzi
221 : ! **************************************************************************************************
222 238434943 : SUBROUTINE section_retain(section)
223 :
224 : TYPE(section_type), POINTER :: section
225 :
226 238434943 : CPASSERT(ASSOCIATED(section))
227 238434943 : CPASSERT(section%ref_count > 0)
228 238434943 : section%ref_count = section%ref_count + 1
229 :
230 238434943 : END SUBROUTINE section_retain
231 :
232 : ! **************************************************************************************************
233 : !> \brief releases the given keyword list (see doc/ReferenceCounting.html)
234 : !> \param section the list to release
235 : !> \author fawzi
236 : ! **************************************************************************************************
237 465989270 : RECURSIVE SUBROUTINE section_release(section)
238 :
239 : TYPE(section_type), POINTER :: section
240 :
241 : INTEGER :: i
242 :
243 465989270 : IF (ASSOCIATED(section)) THEN
244 350301014 : CPASSERT(section%ref_count > 0)
245 350301014 : section%ref_count = section%ref_count - 1
246 350301014 : IF (section%ref_count == 0) THEN
247 111866071 : IF (ASSOCIATED(section%citations)) THEN
248 6462447 : DEALLOCATE (section%citations)
249 : END IF
250 111866071 : IF (ASSOCIATED(section%keywords)) THEN
251 1444843623 : DO i = -1, UBOUND(section%keywords, 1)
252 1332977552 : CALL keyword_release(section%keywords(i)%keyword)
253 : END DO
254 111866071 : DEALLOCATE (section%keywords)
255 : END IF
256 111866071 : section%n_keywords = 0
257 111866071 : IF (ASSOCIATED(section%subsections)) THEN
258 339349960 : DO i = 1, SIZE(section%subsections)
259 339349960 : CALL section_release(section%subsections(i)%section)
260 : END DO
261 111866071 : DEALLOCATE (section%subsections)
262 : END IF
263 111866071 : DEALLOCATE (section%description)
264 111866071 : DEALLOCATE (section)
265 : END IF
266 350301014 : NULLIFY (section)
267 : END IF
268 :
269 465989270 : END SUBROUTINE section_release
270 :
271 : ! **************************************************************************************************
272 : !> \brief collects additional information on the section for IO + documentation
273 : !> \param section ...
274 : !> \return ...
275 : !> \author fawzi
276 : ! **************************************************************************************************
277 1 : FUNCTION get_section_info(section) RESULT(message)
278 :
279 : TYPE(section_type), INTENT(IN) :: section
280 : CHARACTER(LEN=default_path_length) :: message
281 :
282 : INTEGER :: length
283 :
284 1 : message = " "
285 1 : length = LEN_TRIM(a2s(section%description))
286 1 : IF (length > 0) THEN
287 1 : IF (section%description(length) /= ".") THEN
288 0 : message = "."
289 : END IF
290 : END IF
291 1 : IF (section%repeats) THEN
292 0 : message = TRIM(message)//" This section can be repeated."
293 : ELSE
294 1 : message = TRIM(message)//" This section can not be repeated."
295 : END IF
296 :
297 1 : END FUNCTION get_section_info
298 :
299 : ! **************************************************************************************************
300 : !> \brief prints a description of the given section
301 : !> \param section the section to describe
302 : !> \param unit_nr the unit to write to
303 : !> \param level the level of output: 0: just section name, 1:keywords,
304 : !> then see keyword_describe :-)
305 : !> \param hide_root if the name of the first section should be hidden
306 : !> (defaults to false).
307 : !> \param recurse ...
308 : !> \author fawzi
309 : ! **************************************************************************************************
310 2 : RECURSIVE SUBROUTINE section_describe(section, unit_nr, level, hide_root, recurse)
311 :
312 : TYPE(section_type), INTENT(IN), POINTER :: section
313 : INTEGER, INTENT(in) :: unit_nr, level
314 : LOGICAL, INTENT(in), OPTIONAL :: hide_root
315 : INTEGER, INTENT(in), OPTIONAL :: recurse
316 :
317 : CHARACTER(LEN=default_path_length) :: message
318 : INTEGER :: ikeyword, isub, my_recurse
319 : LOGICAL :: my_hide_root
320 :
321 2 : IF (unit_nr > 0) THEN
322 1 : my_hide_root = .FALSE.
323 1 : IF (PRESENT(hide_root)) my_hide_root = hide_root
324 1 : my_recurse = 0
325 1 : IF (PRESENT(recurse)) my_recurse = recurse
326 1 : IF (ASSOCIATED(section)) THEN
327 1 : CPASSERT(section%ref_count > 0)
328 :
329 1 : IF (.NOT. my_hide_root) THEN
330 1 : WRITE (UNIT=unit_nr, FMT="('*** section &',A,' ***')") TRIM(ADJUSTL(section%name))
331 : END IF
332 1 : IF (level > 1) THEN
333 1 : message = get_section_info(section)
334 1 : CALL print_message(TRIM(a2s(section%description))//TRIM(message), unit_nr, 0, 0, 0)
335 : END IF
336 1 : IF (level > 0) THEN
337 1 : IF (ASSOCIATED(section%keywords(-1)%keyword)) THEN
338 : CALL keyword_describe(section%keywords(-1)%keyword, unit_nr, &
339 0 : level)
340 : END IF
341 1 : IF (ASSOCIATED(section%keywords(0)%keyword)) THEN
342 : CALL keyword_describe(section%keywords(0)%keyword, unit_nr, &
343 0 : level)
344 : END IF
345 20 : DO ikeyword = 1, section%n_keywords
346 : CALL keyword_describe(section%keywords(ikeyword)%keyword, unit_nr, &
347 20 : level)
348 : END DO
349 : END IF
350 1 : IF (section%n_subsections > 0 .AND. my_recurse >= 0) THEN
351 1 : IF (.NOT. my_hide_root) THEN
352 1 : WRITE (UNIT=unit_nr, FMT="('** subsections **')")
353 : END IF
354 15 : DO isub = 1, section%n_subsections
355 15 : IF (my_recurse > 0) THEN
356 : CALL section_describe(section%subsections(isub)%section, unit_nr, &
357 0 : level, recurse=my_recurse - 1)
358 : ELSE
359 14 : WRITE (UNIT=unit_nr, FMT="(1X,A)") section%subsections(isub)%section%name
360 : END IF
361 : END DO
362 : END IF
363 1 : IF (.NOT. my_hide_root) THEN
364 1 : WRITE (UNIT=unit_nr, FMT="('*** &end section ',A,' ***')") TRIM(ADJUSTL(section%name))
365 : END IF
366 : ELSE
367 0 : WRITE (unit_nr, "(a)") '<section *null*>'
368 : END IF
369 : END IF
370 :
371 2 : END SUBROUTINE section_describe
372 :
373 : ! **************************************************************************************************
374 : !> \brief returns the index of requested subsection (-1 if not found)
375 : !> \param section the root section
376 : !> \param subsection_name the name of the subsection you want to get
377 : !> \return ...
378 : !> \author fawzi
379 : !> \note
380 : !> private utility function
381 : ! **************************************************************************************************
382 44862627 : FUNCTION section_get_subsection_index(section, subsection_name) RESULT(res)
383 :
384 : TYPE(section_type), INTENT(IN) :: section
385 : CHARACTER(len=*), INTENT(IN) :: subsection_name
386 : INTEGER :: res
387 :
388 : CHARACTER(len=default_string_length) :: upc_name
389 : INTEGER :: isub
390 :
391 0 : CPASSERT(section%ref_count > 0)
392 44862627 : res = -1
393 44862627 : upc_name = subsection_name
394 44862627 : CALL uppercase(upc_name)
395 386022341 : DO isub = 1, section%n_subsections
396 386022196 : CPASSERT(ASSOCIATED(section%subsections(isub)%section))
397 386022341 : IF (section%subsections(isub)%section%name == upc_name) THEN
398 : res = isub
399 : EXIT
400 : END IF
401 : END DO
402 :
403 44862627 : END FUNCTION section_get_subsection_index
404 :
405 : ! **************************************************************************************************
406 : !> \brief returns the requested subsection
407 : !> \param section the root section
408 : !> \param subsection_name the name of the subsection you want to get
409 : !> \return ...
410 : !> \author fawzi
411 : ! **************************************************************************************************
412 174 : FUNCTION section_get_subsection(section, subsection_name) RESULT(res)
413 :
414 : TYPE(section_type), INTENT(IN) :: section
415 : CHARACTER(len=*), INTENT(IN) :: subsection_name
416 : TYPE(section_type), POINTER :: res
417 :
418 : INTEGER :: isub
419 :
420 174 : isub = section_get_subsection_index(section, subsection_name)
421 174 : IF (isub > 0) THEN
422 174 : res => section%subsections(isub)%section
423 : ELSE
424 : NULLIFY (res)
425 : END IF
426 :
427 174 : END FUNCTION section_get_subsection
428 :
429 : ! **************************************************************************************************
430 : !> \brief returns the index of the requested keyword (or -2 if not found)
431 : !> \param section the section the keyword is in
432 : !> \param keyword_name the keyword you are interested in
433 : !> \return ...
434 : !> \author fawzi
435 : !> \note
436 : !> private utility function
437 : ! **************************************************************************************************
438 45578500 : FUNCTION section_get_keyword_index(section, keyword_name) RESULT(res)
439 :
440 : TYPE(section_type), INTENT(IN) :: section
441 : CHARACTER(len=*), INTENT(IN) :: keyword_name
442 : INTEGER :: res
443 :
444 : INTEGER :: ik, in
445 : CHARACTER(len=default_string_length) :: upc_name
446 :
447 0 : CPASSERT(section%ref_count > 0)
448 45578500 : CPASSERT(ASSOCIATED(section%keywords))
449 45578500 : res = -2
450 45578500 : upc_name = keyword_name
451 45578500 : CALL uppercase(upc_name)
452 136735500 : DO ik = -1, 0
453 136735500 : IF (ASSOCIATED(section%keywords(ik)%keyword)) THEN
454 31218905 : IF (section%keywords(ik)%keyword%names(1) == upc_name) THEN
455 9780984 : res = ik
456 : END IF
457 : END IF
458 : END DO
459 45578500 : IF (res == -2) THEN
460 332607129 : k_search_loop: DO ik = 1, section%n_keywords
461 332315861 : CPASSERT(ASSOCIATED(section%keywords(ik)%keyword))
462 650850293 : DO in = 1, SIZE(section%keywords(ik)%keyword%names)
463 650559025 : IF (section%keywords(ik)%keyword%names(in) == upc_name) THEN
464 : res = ik
465 : EXIT k_search_loop
466 : END IF
467 : END DO
468 : END DO k_search_loop
469 : END IF
470 :
471 45578500 : END FUNCTION section_get_keyword_index
472 :
473 : ! **************************************************************************************************
474 : !> \brief returns the requested keyword
475 : !> \param section the section the keyword is in
476 : !> \param keyword_name the keyword you are interested in
477 : !> \return ...
478 : !> \author fawzi
479 : ! **************************************************************************************************
480 59226 : RECURSIVE FUNCTION section_get_keyword(section, keyword_name) RESULT(res)
481 :
482 : TYPE(section_type), INTENT(IN) :: section
483 : CHARACTER(len=*), INTENT(IN) :: keyword_name
484 : TYPE(keyword_type), POINTER :: res
485 :
486 : INTEGER :: ik, my_index
487 :
488 59226 : IF (INDEX(keyword_name, "%") /= 0) THEN
489 2921 : my_index = INDEX(keyword_name, "%") + 1
490 2921 : CPASSERT(ASSOCIATED(section%subsections))
491 19642 : DO ik = LBOUND(section%subsections, 1), UBOUND(section%subsections, 1)
492 13800 : IF (section%subsections(ik)%section%name == keyword_name(1:my_index - 2)) EXIT
493 : END DO
494 2921 : CPASSERT(ik <= UBOUND(section%subsections, 1))
495 2921 : res => section_get_keyword(section%subsections(ik)%section, keyword_name(my_index:))
496 : ELSE
497 56305 : ik = section_get_keyword_index(section, keyword_name)
498 56305 : IF (ik == -2) THEN
499 : NULLIFY (res)
500 : ELSE
501 56305 : res => section%keywords(ik)%keyword
502 : END IF
503 : END IF
504 :
505 59226 : END FUNCTION section_get_keyword
506 :
507 : ! **************************************************************************************************
508 : !> \brief adds a keyword to the given section
509 : !> \param section the section to which the keyword should be added
510 : !> \param keyword the keyword to add
511 : !> \author fawzi
512 : ! **************************************************************************************************
513 848312579 : SUBROUTINE section_add_keyword(section, keyword)
514 :
515 : TYPE(section_type), INTENT(INOUT) :: section
516 : TYPE(keyword_type), INTENT(IN), POINTER :: keyword
517 :
518 : INTEGER :: i, j, k
519 848312579 : TYPE(keyword_p_type), DIMENSION(:), POINTER :: new_keywords
520 :
521 0 : CPASSERT(section%ref_count > 0)
522 848312579 : CPASSERT(.NOT. section%frozen)
523 848312579 : CPASSERT(ASSOCIATED(keyword))
524 848312579 : CPASSERT(keyword%ref_count > 0)
525 848312579 : CALL keyword_retain(keyword)
526 848312579 : IF (keyword%names(1) == "_SECTION_PARAMETERS_") THEN
527 88095488 : CALL keyword_release(section%keywords(-1)%keyword)
528 88095488 : section%keywords(-1)%keyword => keyword
529 760217091 : ELSE IF (keyword%names(1) == "_DEFAULT_KEYWORD_") THEN
530 2138276 : CALL keyword_release(section%keywords(0)%keyword)
531 2138276 : section%keywords(0)%keyword => keyword
532 : ELSE
533 1534085010 : DO k = 1, SIZE(keyword%names)
534 7133083567 : DO i = 1, section%n_keywords
535 12142690399 : DO j = 1, SIZE(section%keywords(i)%keyword%names)
536 11366684204 : IF (keyword%names(k) == section%keywords(i)%keyword%names(j)) THEN
537 : CALL cp_abort(__LOCATION__, &
538 : "trying to add a keyword with a name ("// &
539 : TRIM(keyword%names(k))//") that was already used in section " &
540 0 : //TRIM(section%name))
541 : END IF
542 : END DO
543 : END DO
544 : END DO
545 :
546 1516157630 : IF (UBOUND(section%keywords, 1) == section%n_keywords) THEN
547 750995220 : ALLOCATE (new_keywords(-1:section%n_keywords + 10))
548 310774068 : DO i = -1, section%n_keywords
549 310774068 : new_keywords(i)%keyword => section%keywords(i)%keyword
550 : END DO
551 440221152 : DO i = section%n_keywords + 1, UBOUND(new_keywords, 1)
552 403536056 : NULLIFY (new_keywords(i)%keyword)
553 : END DO
554 36685096 : DEALLOCATE (section%keywords)
555 36685096 : section%keywords => new_keywords
556 : END IF
557 758078815 : section%n_keywords = section%n_keywords + 1
558 758078815 : section%keywords(section%n_keywords)%keyword => keyword
559 : END IF
560 :
561 848312579 : END SUBROUTINE section_add_keyword
562 :
563 : ! **************************************************************************************************
564 : !> \brief adds a subsection to the given section
565 : !> \param section to section to which you want to add a subsection
566 : !> \param subsection the subsection to add
567 : !> \author fawzi
568 : ! **************************************************************************************************
569 111819595 : SUBROUTINE section_add_subsection(section, subsection)
570 :
571 : TYPE(section_type), INTENT(INOUT) :: section
572 : TYPE(section_type), INTENT(IN), POINTER :: subsection
573 :
574 : INTEGER :: i
575 111819595 : TYPE(section_p_type), DIMENSION(:), POINTER :: new_subsections
576 :
577 0 : CPASSERT(section%ref_count > 0)
578 111819595 : CPASSERT(ASSOCIATED(subsection))
579 111819595 : CPASSERT(subsection%ref_count > 0)
580 111819595 : IF (SIZE(section%subsections) < section%n_subsections + 1) THEN
581 3118229620 : ALLOCATE (new_subsections(section%n_subsections + 10))
582 2857107520 : DO i = 1, section%n_subsections
583 2857107520 : new_subsections(i)%section => section%subsections(i)%section
584 : END DO
585 239361925 : DO i = section%n_subsections + 1, SIZE(new_subsections)
586 239361925 : NULLIFY (new_subsections(i)%section)
587 : END DO
588 21760175 : DEALLOCATE (section%subsections)
589 21760175 : section%subsections => new_subsections
590 : END IF
591 28506633479 : DO i = 1, section%n_subsections
592 28506633479 : IF (subsection%name == section%subsections(i)%section%name) THEN
593 : CALL cp_abort(__LOCATION__, &
594 : "trying to add a subsection with a name ("// &
595 : TRIM(subsection%name)//") that was already used in section " &
596 0 : //TRIM(section%name))
597 : END IF
598 : END DO
599 111819595 : CALL section_retain(subsection)
600 111819595 : section%n_subsections = section%n_subsections + 1
601 111819595 : section%subsections(section%n_subsections)%section => subsection
602 :
603 111819595 : END SUBROUTINE section_add_subsection
604 :
605 : ! **************************************************************************************************
606 : !> \brief creates a object where to store the values of a section
607 : !> \param section_vals the parsed section that will be created
608 : !> \param section the structure of the section that you want to parse
609 : !> \author fawzi
610 : ! **************************************************************************************************
611 126615348 : RECURSIVE SUBROUTINE section_vals_create(section_vals, section)
612 :
613 : TYPE(section_vals_type), POINTER :: section_vals
614 : TYPE(section_type), POINTER :: section
615 :
616 : INTEGER :: i
617 :
618 126615348 : CPASSERT(.NOT. ASSOCIATED(section_vals))
619 126615348 : ALLOCATE (section_vals)
620 126615348 : section_vals%ref_count = 1
621 126615348 : CALL section_retain(section)
622 126615348 : section_vals%section => section
623 126615348 : section%frozen = .TRUE.
624 253230696 : ALLOCATE (section_vals%values(-1:section%n_keywords, 0))
625 522893892 : ALLOCATE (section_vals%subs_vals(section%n_subsections, 1))
626 253156114 : DO i = 1, section%n_subsections
627 126540766 : NULLIFY (section_vals%subs_vals(i, 1)%section_vals)
628 : CALL section_vals_create(section_vals%subs_vals(i, 1)%section_vals, &
629 253156114 : section=section%subsections(i)%section)
630 : END DO
631 :
632 126615348 : NULLIFY (section_vals%ibackup)
633 :
634 126615348 : END SUBROUTINE section_vals_create
635 :
636 : ! **************************************************************************************************
637 : !> \brief retains the given section values (see doc/ReferenceCounting.html)
638 : !> \param section_vals the object to retain
639 : !> \author fawzi
640 : ! **************************************************************************************************
641 77652 : SUBROUTINE section_vals_retain(section_vals)
642 :
643 : TYPE(section_vals_type), POINTER :: section_vals
644 :
645 77652 : CPASSERT(ASSOCIATED(section_vals))
646 77652 : CPASSERT(section_vals%ref_count > 0)
647 77652 : section_vals%ref_count = section_vals%ref_count + 1
648 :
649 77652 : END SUBROUTINE section_vals_retain
650 :
651 : ! **************************************************************************************************
652 : !> \brief releases the given object
653 : !> \param section_vals the section_vals to release
654 : !> \author fawzi
655 : ! **************************************************************************************************
656 126709204 : RECURSIVE SUBROUTINE section_vals_release(section_vals)
657 :
658 : TYPE(section_vals_type), POINTER :: section_vals
659 :
660 : INTEGER :: i, j
661 : TYPE(cp_sll_val_type), POINTER :: vals
662 : TYPE(val_type), POINTER :: el
663 :
664 126709204 : IF (ASSOCIATED(section_vals)) THEN
665 126693000 : CPASSERT(section_vals%ref_count > 0)
666 126693000 : section_vals%ref_count = section_vals%ref_count - 1
667 126693000 : IF (section_vals%ref_count == 0) THEN
668 126615348 : CALL section_release(section_vals%section)
669 126919538 : DO j = 1, SIZE(section_vals%values, 2)
670 131082817 : DO i = -1, UBOUND(section_vals%values, 1)
671 3859089 : vals => section_vals%values(i, j)%list
672 4808536 : DO WHILE (cp_sll_val_next(vals, el_att=el))
673 949447 : CALL val_release(el)
674 : END DO
675 4163279 : CALL cp_sll_val_dealloc(section_vals%values(i, j)%list)
676 : END DO
677 : END DO
678 126615348 : DEALLOCATE (section_vals%values)
679 253253876 : DO j = 1, SIZE(section_vals%subs_vals, 2)
680 379855754 : DO i = 1, SIZE(section_vals%subs_vals, 1)
681 253240406 : CALL section_vals_release(section_vals%subs_vals(i, j)%section_vals)
682 : END DO
683 : END DO
684 126615348 : DEALLOCATE (section_vals%subs_vals)
685 126615348 : IF (ASSOCIATED(section_vals%ibackup)) THEN
686 4405 : DEALLOCATE (section_vals%ibackup)
687 : END IF
688 126615348 : DEALLOCATE (section_vals)
689 : END IF
690 : END IF
691 :
692 126709204 : END SUBROUTINE section_vals_release
693 :
694 : ! **************************************************************************************************
695 : !> \brief returns various attributes about the section_vals
696 : !> \param section_vals the section vals you want information from
697 : !> \param ref_count ...
698 : !> \param n_repetition number of repetitions of the section
699 : !> \param n_subs_vals_rep number of repetitions of the subsections values
700 : !> (max(1,n_repetition))
701 : !> \param section ...
702 : !> \param explicit if the section was explicitly present in
703 : !> \author fawzi
704 : !> \note For the other arguments see the attributes of section_vals_type
705 : ! **************************************************************************************************
706 4951200 : SUBROUTINE section_vals_get(section_vals, ref_count, n_repetition, &
707 : n_subs_vals_rep, section, explicit)
708 :
709 : TYPE(section_vals_type), INTENT(IN) :: section_vals
710 : INTEGER, INTENT(out), OPTIONAL :: ref_count, n_repetition, n_subs_vals_rep
711 : TYPE(section_type), OPTIONAL, POINTER :: section
712 : LOGICAL, INTENT(out), OPTIONAL :: explicit
713 :
714 4951200 : CPASSERT(section_vals%ref_count > 0)
715 4951200 : IF (PRESENT(ref_count)) ref_count = section_vals%ref_count
716 4951200 : IF (PRESENT(section)) section => section_vals%section
717 4951200 : IF (PRESENT(n_repetition)) n_repetition = SIZE(section_vals%values, 2)
718 4951200 : IF (PRESENT(n_subs_vals_rep)) n_subs_vals_rep = SIZE(section_vals%subs_vals, 2)
719 4951200 : IF (PRESENT(explicit)) explicit = (SIZE(section_vals%values, 2) > 0)
720 :
721 4951200 : END SUBROUTINE section_vals_get
722 :
723 : ! **************************************************************************************************
724 : !> \brief returns the values of the requested subsection
725 : !> \param section_vals the root section
726 : !> \param subsection_name the name of the requested subsection
727 : !> \param i_rep_section index of the repetition of section_vals from which
728 : !> you want to extract the subsection (defaults to 1)
729 : !> \param can_return_null if the results can be null (defaults to false)
730 : !> \return ...
731 : !> \author fawzi
732 : ! **************************************************************************************************
733 44529704 : RECURSIVE FUNCTION section_vals_get_subs_vals(section_vals, subsection_name, &
734 : i_rep_section, can_return_null) RESULT(res)
735 :
736 : TYPE(section_vals_type), INTENT(IN) :: section_vals
737 : CHARACTER(len=*), INTENT(IN) :: subsection_name
738 : INTEGER, INTENT(IN), OPTIONAL :: i_rep_section
739 : LOGICAL, INTENT(IN), OPTIONAL :: can_return_null
740 : TYPE(section_vals_type), POINTER :: res
741 :
742 : INTEGER :: irep, isection, my_index
743 : LOGICAL :: is_path, my_can_return_null
744 :
745 44529704 : CPASSERT(section_vals%ref_count > 0)
746 :
747 44529704 : my_can_return_null = .FALSE.
748 44529704 : IF (PRESENT(can_return_null)) my_can_return_null = can_return_null
749 44529704 : NULLIFY (res)
750 44529704 : irep = 1
751 44529704 : IF (PRESENT(i_rep_section)) irep = i_rep_section
752 :
753 : ! prepare for recursive parsing of subsections. i_rep_section will be used for last section
754 44529704 : my_index = INDEX(subsection_name, "%")
755 44529704 : IF (my_index == 0) THEN
756 26252977 : is_path = .FALSE.
757 26252977 : my_index = LEN_TRIM(subsection_name)
758 : ELSE
759 18276727 : is_path = .TRUE.
760 18276727 : irep = 1
761 18276727 : my_index = my_index - 1
762 : END IF
763 :
764 44529704 : CPASSERT(irep <= SIZE(section_vals%subs_vals, 2))
765 :
766 44529704 : isection = section_get_subsection_index(section_vals%section, subsection_name(1:my_index))
767 44529704 : IF (isection > 0) res => section_vals%subs_vals(isection, irep)%section_vals
768 44529704 : IF (.NOT. (ASSOCIATED(res) .OR. my_can_return_null)) THEN
769 : CALL cp_abort(__LOCATION__, &
770 : "could not find subsection "//TRIM(subsection_name(1:my_index))//" in section "// &
771 0 : TRIM(section_vals%section%name)//" at ")
772 : END IF
773 44529704 : IF (is_path .AND. ASSOCIATED(res)) THEN
774 : res => section_vals_get_subs_vals(res, subsection_name(my_index + 2:LEN_TRIM(subsection_name)), &
775 18276727 : i_rep_section, can_return_null)
776 : END IF
777 :
778 44529704 : END FUNCTION section_vals_get_subs_vals
779 :
780 : ! **************************************************************************************************
781 : !> \brief returns the values of the n-th non default subsection (null if no
782 : !> such section exists (not so many non default section))
783 : !> \param section_vals the root section
784 : !> \param i_section index of the section
785 : !> \param i_rep_section index of the repetition of section_vals from which
786 : !> you want to extract the subsection (defaults to 1)
787 : !> \return ...
788 : !> \author fawzi
789 : ! **************************************************************************************************
790 2601579 : FUNCTION section_vals_get_subs_vals2(section_vals, i_section, i_rep_section) RESULT(res)
791 :
792 : TYPE(section_vals_type), POINTER :: section_vals
793 : INTEGER, INTENT(in) :: i_section
794 : INTEGER, INTENT(in), OPTIONAL :: i_rep_section
795 : TYPE(section_vals_type), POINTER :: res
796 :
797 : INTEGER :: i, irep, isect_att
798 :
799 2601579 : CPASSERT(ASSOCIATED(section_vals))
800 2601579 : CPASSERT(section_vals%ref_count > 0)
801 2601579 : NULLIFY (res)
802 2601579 : irep = 1
803 2601579 : IF (PRESENT(i_rep_section)) irep = i_rep_section
804 2601579 : CPASSERT(irep <= SIZE(section_vals%subs_vals, 2))
805 2601579 : isect_att = 0
806 1444361288 : DO i = 1, section_vals%section%n_subsections
807 1444361288 : IF (SIZE(section_vals%subs_vals(i, irep)%section_vals%values, 2) > 0) THEN
808 2710871 : isect_att = isect_att + 1
809 2710871 : IF (isect_att == i_section) THEN
810 : res => section_vals%subs_vals(i, irep)%section_vals
811 : EXIT
812 : END IF
813 : END IF
814 : END DO
815 2601579 : END FUNCTION section_vals_get_subs_vals2
816 :
817 : ! **************************************************************************************************
818 : !> \brief returns the values of the n-th non default subsection (null if no
819 : !> such section exists (not so many non default section))
820 : !> \param section_vals the root section
821 : !> \param subsection_name ...
822 : !> \param i_rep_section index of the repetition of section_vals from which
823 : !> you want to extract the subsection (defaults to 1)
824 : !> \return ...
825 : !> \author fawzi
826 : ! **************************************************************************************************
827 77402 : FUNCTION section_vals_get_subs_vals3(section_vals, subsection_name, &
828 : i_rep_section) RESULT(res)
829 :
830 : TYPE(section_vals_type), INTENT(IN) :: section_vals
831 : CHARACTER(LEN=*), INTENT(IN) :: subsection_name
832 : INTEGER, INTENT(in), OPTIONAL :: i_rep_section
833 : TYPE(section_vals_type), POINTER :: res
834 :
835 : INTEGER :: i_section, irep
836 :
837 77402 : CPASSERT(section_vals%ref_count > 0)
838 77402 : NULLIFY (res)
839 77402 : irep = 1
840 77402 : IF (PRESENT(i_rep_section)) irep = i_rep_section
841 77402 : CPASSERT(irep <= SIZE(section_vals%subs_vals, 2))
842 77402 : i_section = section_get_subsection_index(section_vals%section, subsection_name)
843 77402 : res => section_vals%subs_vals(i_section, irep)%section_vals
844 :
845 77402 : END FUNCTION section_vals_get_subs_vals3
846 :
847 : ! **************************************************************************************************
848 : !> \brief adds the place to store the values of a repetition of the section
849 : !> \param section_vals the section you want to extend
850 : !> \author fawzi
851 : ! **************************************************************************************************
852 314070 : SUBROUTINE section_vals_add_values(section_vals)
853 :
854 : TYPE(section_vals_type), INTENT(INOUT) :: section_vals
855 :
856 : INTEGER :: i, j
857 314070 : TYPE(cp_sll_val_p_type), DIMENSION(:, :), POINTER :: new_values
858 : TYPE(section_vals_p_type), DIMENSION(:, :), &
859 314070 : POINTER :: new_sps
860 :
861 0 : CPASSERT(section_vals%ref_count > 0)
862 6424683 : ALLOCATE (new_values(-1:UBOUND(section_vals%values, 1), SIZE(section_vals%values, 2) + 1))
863 372234 : DO j = 1, SIZE(section_vals%values, 2)
864 1288419 : DO i = -1, UBOUND(section_vals%values, 1)
865 916185 : new_values(i, j)%list => section_vals%values(i, j)%list
866 : END DO
867 : END DO
868 314070 : DEALLOCATE (section_vals%values)
869 314070 : section_vals%values => new_values
870 314070 : j = SIZE(new_values, 2)
871 4566288 : DO i = -1, UBOUND(new_values, 1)
872 4252218 : NULLIFY (new_values(i, j)%list)
873 : END DO
874 :
875 314070 : IF (SIZE(new_values, 2) > 1) THEN
876 : ALLOCATE (new_sps(SIZE(section_vals%subs_vals, 1), &
877 351344 : SIZE(section_vals%subs_vals, 2) + 1))
878 81344 : DO j = 1, SIZE(section_vals%subs_vals, 2)
879 211156 : DO i = 1, SIZE(section_vals%subs_vals, 1)
880 187976 : new_sps(i, j)%section_vals => section_vals%subs_vals(i, j)%section_vals
881 : END DO
882 : END DO
883 23180 : DEALLOCATE (section_vals%subs_vals)
884 23180 : section_vals%subs_vals => new_sps
885 23180 : j = SIZE(new_sps, 2)
886 84292 : DO i = 1, SIZE(new_sps, 1)
887 61112 : NULLIFY (new_sps(i, j)%section_vals)
888 : CALL section_vals_create(new_sps(i, SIZE(new_sps, 2))%section_vals, &
889 84292 : section=section_vals%section%subsections(i)%section)
890 : END DO
891 : END IF
892 :
893 314070 : END SUBROUTINE section_vals_add_values
894 :
895 : ! **************************************************************************************************
896 : !> \brief removes the values of a repetition of the section
897 : !> \param section_vals the section you want to extend
898 : !> \author fawzi
899 : ! **************************************************************************************************
900 68395 : SUBROUTINE section_vals_remove_values(section_vals)
901 :
902 : TYPE(section_vals_type), POINTER :: section_vals
903 :
904 : INTEGER :: i, j
905 68395 : TYPE(cp_sll_val_p_type), DIMENSION(:, :), POINTER :: new_values
906 : TYPE(cp_sll_val_type), POINTER :: vals
907 : TYPE(val_type), POINTER :: el
908 :
909 68395 : IF (ASSOCIATED(section_vals)) THEN
910 68395 : CPASSERT(section_vals%ref_count > 0)
911 68395 : NULLIFY (el, vals)
912 : ! Allocate a null 0 dimension array of values
913 205185 : ALLOCATE (new_values(-1:section_vals%section%n_keywords, 0))
914 : ! Release old values
915 78275 : DO j = 1, SIZE(section_vals%values, 2)
916 167214 : DO i = -1, UBOUND(section_vals%values, 1)
917 79059 : vals => section_vals%values(i, j)%list
918 686938 : DO WHILE (cp_sll_val_next(vals, el_att=el))
919 607879 : CALL val_release(el)
920 : END DO
921 88939 : CALL cp_sll_val_dealloc(section_vals%values(i, j)%list)
922 : END DO
923 : END DO
924 68395 : DEALLOCATE (section_vals%values)
925 68395 : section_vals%values => new_values
926 : END IF
927 :
928 68395 : END SUBROUTINE section_vals_remove_values
929 :
930 : ! **************************************************************************************************
931 : !> \brief ...
932 : !> \param section_vals ...
933 : !> \param keyword_name ...
934 : !> \return ...
935 : ! **************************************************************************************************
936 0 : FUNCTION section_get_cval(section_vals, keyword_name) RESULT(res)
937 :
938 : TYPE(section_vals_type), INTENT(IN) :: section_vals
939 : CHARACTER(len=*), INTENT(in) :: keyword_name
940 : CHARACTER(LEN=default_string_length) :: res
941 :
942 0 : CALL section_vals_val_get(section_vals, keyword_name, c_val=res)
943 :
944 0 : END FUNCTION section_get_cval
945 :
946 : ! **************************************************************************************************
947 : !> \brief ...
948 : !> \param section_vals ...
949 : !> \param keyword_name ...
950 : !> \return ...
951 : ! **************************************************************************************************
952 550696 : FUNCTION section_get_rval(section_vals, keyword_name) RESULT(res)
953 :
954 : TYPE(section_vals_type), INTENT(IN) :: section_vals
955 : CHARACTER(len=*), INTENT(in) :: keyword_name
956 : REAL(kind=dp) :: res
957 :
958 550696 : CALL section_vals_val_get(section_vals, keyword_name, r_val=res)
959 :
960 550696 : END FUNCTION section_get_rval
961 :
962 : ! **************************************************************************************************
963 : !> \brief ...
964 : !> \param section_vals ...
965 : !> \param keyword_name ...
966 : !> \return ...
967 : ! **************************************************************************************************
968 0 : FUNCTION section_get_rvals(section_vals, keyword_name) RESULT(res)
969 :
970 : TYPE(section_vals_type), INTENT(IN) :: section_vals
971 : CHARACTER(len=*), INTENT(in) :: keyword_name
972 : REAL(kind=dp), DIMENSION(:), POINTER :: res
973 :
974 0 : CALL section_vals_val_get(section_vals, keyword_name, r_vals=res)
975 :
976 0 : END FUNCTION section_get_rvals
977 :
978 : ! **************************************************************************************************
979 : !> \brief ...
980 : !> \param section_vals ...
981 : !> \param keyword_name ...
982 : !> \return ...
983 : ! **************************************************************************************************
984 477506 : FUNCTION section_get_ival(section_vals, keyword_name) RESULT(res)
985 :
986 : TYPE(section_vals_type), INTENT(IN) :: section_vals
987 : CHARACTER(len=*), INTENT(in) :: keyword_name
988 : INTEGER :: res
989 :
990 477506 : CALL section_vals_val_get(section_vals, keyword_name, i_val=res)
991 :
992 477506 : END FUNCTION section_get_ival
993 :
994 : ! **************************************************************************************************
995 : !> \brief ...
996 : !> \param section_vals ...
997 : !> \param keyword_name ...
998 : !> \return ...
999 : ! **************************************************************************************************
1000 10948 : FUNCTION section_get_ivals(section_vals, keyword_name) RESULT(res)
1001 :
1002 : TYPE(section_vals_type), INTENT(IN) :: section_vals
1003 : CHARACTER(len=*), INTENT(in) :: keyword_name
1004 : INTEGER, DIMENSION(:), POINTER :: res
1005 :
1006 10948 : CALL section_vals_val_get(section_vals, keyword_name, i_vals=res)
1007 :
1008 10948 : END FUNCTION section_get_ivals
1009 :
1010 : ! **************************************************************************************************
1011 : !> \brief ...
1012 : !> \param section_vals ...
1013 : !> \param keyword_name ...
1014 : !> \return ...
1015 : ! **************************************************************************************************
1016 109685 : FUNCTION section_get_lval(section_vals, keyword_name) RESULT(res)
1017 :
1018 : TYPE(section_vals_type), INTENT(IN) :: section_vals
1019 : CHARACTER(len=*), INTENT(in) :: keyword_name
1020 : LOGICAL :: res
1021 :
1022 109685 : CALL section_vals_val_get(section_vals, keyword_name, l_val=res)
1023 :
1024 109685 : END FUNCTION section_get_lval
1025 :
1026 : ! **************************************************************************************************
1027 : !> \brief returns the requested value
1028 : !> \param section_vals ...
1029 : !> \param keyword_name the name of the keyword you want
1030 : !> \param i_rep_section which repetition of the section you are interested in
1031 : !> (defaults to 1)
1032 : !> \param i_rep_val which repetition of the keyword/val you are interested in
1033 : !> (defaults to 1)
1034 : !> \param n_rep_val returns number of val available
1035 : !> \param val ...
1036 : !> \param l_val ,i_val,r_val,c_val: returns the logical,integer,real or
1037 : !> character value
1038 : !> \param i_val ...
1039 : !> \param r_val ...
1040 : !> \param c_val ...
1041 : !> \param l_vals ,i_vals,r_vals,c_vals: returns the logical,integer,real or
1042 : !> character arrays. The val reamins the owner of the array
1043 : !> \param i_vals ...
1044 : !> \param r_vals ...
1045 : !> \param c_vals ...
1046 : !> \param explicit ...
1047 : !> \author fawzi
1048 : ! **************************************************************************************************
1049 44124794 : SUBROUTINE section_vals_val_get(section_vals, keyword_name, i_rep_section, &
1050 : i_rep_val, n_rep_val, val, l_val, i_val, r_val, c_val, l_vals, i_vals, r_vals, &
1051 : c_vals, explicit)
1052 :
1053 : TYPE(section_vals_type), INTENT(IN), TARGET :: section_vals
1054 : CHARACTER(len=*), INTENT(in) :: keyword_name
1055 : INTEGER, INTENT(in), OPTIONAL :: i_rep_section, i_rep_val
1056 : INTEGER, INTENT(out), OPTIONAL :: n_rep_val
1057 : TYPE(val_type), OPTIONAL, POINTER :: val
1058 : LOGICAL, INTENT(out), OPTIONAL :: l_val
1059 : INTEGER, INTENT(out), OPTIONAL :: i_val
1060 : REAL(KIND=DP), INTENT(out), OPTIONAL :: r_val
1061 : CHARACTER(LEN=*), INTENT(out), OPTIONAL :: c_val
1062 : LOGICAL, DIMENSION(:), OPTIONAL, POINTER :: l_vals
1063 : INTEGER, DIMENSION(:), OPTIONAL, POINTER :: i_vals
1064 : REAL(KIND=DP), DIMENSION(:), OPTIONAL, POINTER :: r_vals
1065 : CHARACTER(LEN=default_string_length), &
1066 : DIMENSION(:), OPTIONAL, POINTER :: c_vals
1067 : LOGICAL, INTENT(out), OPTIONAL :: explicit
1068 :
1069 : INTEGER :: ik, irk, irs, len_key, my_index, &
1070 : tmp_index
1071 : LOGICAL :: valRequested
1072 : TYPE(cp_sll_val_type), POINTER :: vals
1073 : TYPE(keyword_type), POINTER :: keyword
1074 : TYPE(section_type), POINTER :: section
1075 : TYPE(section_vals_type), POINTER :: s_vals
1076 : TYPE(val_type), POINTER :: my_val
1077 :
1078 44124794 : CPASSERT(section_vals%ref_count > 0)
1079 :
1080 44124794 : my_index = INDEX(keyword_name, '%') + 1
1081 44124794 : len_key = LEN_TRIM(keyword_name)
1082 44124794 : IF (my_index > 1) THEN
1083 3359767 : DO
1084 12632298 : tmp_index = INDEX(keyword_name(my_index:len_key), "%")
1085 12632298 : IF (tmp_index <= 0) EXIT
1086 3359767 : my_index = my_index + tmp_index
1087 : END DO
1088 9272531 : s_vals => section_vals_get_subs_vals(section_vals, keyword_name(1:my_index - 2))
1089 : ELSE
1090 : s_vals => section_vals
1091 : END IF
1092 :
1093 44124794 : irk = 1
1094 44124794 : irs = 1
1095 44124794 : IF (PRESENT(i_rep_section)) irs = i_rep_section
1096 44124794 : IF (PRESENT(i_rep_val)) irk = i_rep_val
1097 44124794 : IF (PRESENT(val)) NULLIFY (val)
1098 44124794 : IF (PRESENT(explicit)) explicit = .FALSE.
1099 44124794 : section => s_vals%section
1100 : valRequested = PRESENT(l_val) .OR. PRESENT(i_val) .OR. PRESENT(r_val) .OR. &
1101 : PRESENT(c_val) .OR. PRESENT(l_vals) .OR. PRESENT(i_vals) .OR. &
1102 44124794 : PRESENT(r_vals) .OR. PRESENT(c_vals)
1103 44124794 : ik = section_get_keyword_index(s_vals%section, keyword_name(my_index:len_key))
1104 44124794 : IF (ik == -2) THEN
1105 : CALL cp_abort(__LOCATION__, &
1106 : "section "//TRIM(section%name)//" does not contain keyword "// &
1107 0 : TRIM(keyword_name(my_index:len_key)))
1108 : END IF
1109 44124794 : keyword => section%keywords(ik)%keyword
1110 44124794 : IF (.NOT. (irs > 0 .AND. irs <= SIZE(s_vals%subs_vals, 2))) THEN
1111 : CALL cp_abort(__LOCATION__, &
1112 : "section repetition requested ("//cp_to_string(irs)// &
1113 : ") out of bounds (1:"//cp_to_string(SIZE(s_vals%subs_vals, 2)) &
1114 0 : //")")
1115 : END IF
1116 44124794 : NULLIFY (my_val)
1117 44124794 : IF (PRESENT(n_rep_val)) n_rep_val = 0
1118 44124794 : IF (irs <= SIZE(s_vals%values, 2)) THEN ! the section was parsed
1119 11126703 : vals => s_vals%values(ik, irs)%list
1120 11126703 : IF (PRESENT(n_rep_val)) n_rep_val = cp_sll_val_get_length(vals)
1121 11126703 : IF (.NOT. ASSOCIATED(vals)) THEN
1122 : ! this keyword was not parsed
1123 7224890 : IF (ASSOCIATED(keyword%default_value)) THEN
1124 6719007 : my_val => keyword%default_value
1125 6719007 : IF (PRESENT(n_rep_val)) n_rep_val = 1
1126 : END IF
1127 : ELSE
1128 : my_val => cp_sll_val_get_el_at(s_vals%values(ik, irs)%list, &
1129 3901813 : irk)
1130 3901813 : IF (PRESENT(explicit)) explicit = .TRUE.
1131 : END IF
1132 32998091 : ELSE IF (ASSOCIATED(keyword%default_value)) THEN
1133 32955344 : IF (PRESENT(n_rep_val)) n_rep_val = 1
1134 32955344 : my_val => keyword%default_value
1135 : END IF
1136 44124794 : IF (PRESENT(val)) val => my_val
1137 44124794 : IF (valRequested) THEN
1138 41300756 : IF (.NOT. ASSOCIATED(my_val)) THEN
1139 : CALL cp_abort(__LOCATION__, &
1140 : "Value requested, but no value set getting value from "// &
1141 : "keyword "//TRIM(keyword_name(my_index:len_key))//" of section "// &
1142 0 : TRIM(section%name))
1143 : END IF
1144 : CALL val_get(my_val, l_val=l_val, i_val=i_val, r_val=r_val, &
1145 : c_val=c_val, l_vals=l_vals, i_vals=i_vals, r_vals=r_vals, &
1146 121688940 : c_vals=c_vals)
1147 : END IF
1148 :
1149 44124794 : END SUBROUTINE section_vals_val_get
1150 :
1151 : ! **************************************************************************************************
1152 : !> \brief returns the requested list
1153 : !> \param section_vals ...
1154 : !> \param keyword_name the name of the keyword you want
1155 : !> \param i_rep_section which repetition of the section you are interested in
1156 : !> (defaults to 1)
1157 : !> \param list ...
1158 : !> \author Joost VandeVondele
1159 : !> \note
1160 : !> - most useful if the full list is needed anyway, so that faster iteration can be used
1161 : ! **************************************************************************************************
1162 10525 : SUBROUTINE section_vals_list_get(section_vals, keyword_name, i_rep_section, &
1163 : list)
1164 :
1165 : TYPE(section_vals_type), INTENT(IN), POINTER :: section_vals
1166 : CHARACTER(len=*), INTENT(in) :: keyword_name
1167 : INTEGER, OPTIONAL :: i_rep_section
1168 : TYPE(cp_sll_val_type), POINTER :: list
1169 :
1170 : INTEGER :: ik, irs, len_key, my_index, tmp_index
1171 : TYPE(section_type), POINTER :: section
1172 : TYPE(section_vals_type), POINTER :: s_vals
1173 :
1174 10525 : CPASSERT(ASSOCIATED(section_vals))
1175 10525 : CPASSERT(section_vals%ref_count > 0)
1176 10525 : NULLIFY (list)
1177 10525 : my_index = INDEX(keyword_name, '%') + 1
1178 10525 : len_key = LEN_TRIM(keyword_name)
1179 10525 : IF (my_index > 1) THEN
1180 0 : DO
1181 0 : tmp_index = INDEX(keyword_name(my_index:len_key), "%")
1182 0 : IF (tmp_index <= 0) EXIT
1183 0 : my_index = my_index + tmp_index
1184 : END DO
1185 0 : s_vals => section_vals_get_subs_vals(section_vals, keyword_name(1:my_index - 2))
1186 : ELSE
1187 10525 : s_vals => section_vals
1188 : END IF
1189 :
1190 10525 : irs = 1
1191 10525 : IF (PRESENT(i_rep_section)) irs = i_rep_section
1192 10525 : section => s_vals%section
1193 10525 : ik = section_get_keyword_index(s_vals%section, keyword_name(my_index:len_key))
1194 10525 : IF (ik == -2) THEN
1195 : CALL cp_abort(__LOCATION__, &
1196 : "section "//TRIM(section%name)//" does not contain keyword "// &
1197 0 : TRIM(keyword_name(my_index:len_key)))
1198 : END IF
1199 10525 : IF (.NOT. (irs > 0 .AND. irs <= SIZE(s_vals%subs_vals, 2))) THEN
1200 : CALL cp_abort(__LOCATION__, &
1201 : "section repetition requested ("//cp_to_string(irs)// &
1202 : ") out of bounds (1:"//cp_to_string(SIZE(s_vals%subs_vals, 2)) &
1203 0 : //")")
1204 : END IF
1205 10525 : list => s_vals%values(ik, irs)%list
1206 :
1207 10525 : END SUBROUTINE section_vals_list_get
1208 :
1209 : ! **************************************************************************************************
1210 : !> \brief sets the requested value
1211 : !> \param section_vals ...
1212 : !> \param keyword_name the name of the keyword you want (can be a path
1213 : !> separated by '%')
1214 : !> \param i_rep_section isection which repetition of the section you are
1215 : !> nterested in (defaults to 1)
1216 : !> \param i_rep_val which repetition of the keyword/val you are interested in
1217 : !> (defaults to 1)
1218 : !> \param val ...
1219 : !> \param l_val ,i_val,r_val,c_val: sets the logical,integer,real or
1220 : !> character value
1221 : !> \param i_val ...
1222 : !> \param r_val ...
1223 : !> \param c_val ...
1224 : !> \param l_vals_ptr ,i_vals_ptr,r_vals,c_vals: sets the logical,integer,real or
1225 : !> character arrays. The val becomes the owner of the array
1226 : !> \param i_vals_ptr ...
1227 : !> \param r_vals_ptr ...
1228 : !> \param c_vals_ptr ...
1229 : !> \author fawzi
1230 : ! **************************************************************************************************
1231 432357 : SUBROUTINE section_vals_val_set(section_vals, keyword_name, i_rep_section, i_rep_val, &
1232 : val, l_val, i_val, r_val, c_val, l_vals_ptr, i_vals_ptr, r_vals_ptr, c_vals_ptr)
1233 :
1234 : TYPE(section_vals_type), POINTER :: section_vals
1235 : CHARACTER(len=*), INTENT(in) :: keyword_name
1236 : INTEGER, INTENT(in), OPTIONAL :: i_rep_section, i_rep_val
1237 : TYPE(val_type), OPTIONAL, POINTER :: val
1238 : LOGICAL, INTENT(in), OPTIONAL :: l_val
1239 : INTEGER, INTENT(in), OPTIONAL :: i_val
1240 : REAL(KIND=DP), INTENT(in), OPTIONAL :: r_val
1241 : CHARACTER(LEN=*), INTENT(in), OPTIONAL :: c_val
1242 : LOGICAL, DIMENSION(:), OPTIONAL, POINTER :: l_vals_ptr
1243 : INTEGER, DIMENSION(:), OPTIONAL, POINTER :: i_vals_ptr
1244 : REAL(KIND=DP), DIMENSION(:), OPTIONAL, POINTER :: r_vals_ptr
1245 : CHARACTER(LEN=default_string_length), &
1246 : DIMENSION(:), OPTIONAL, POINTER :: c_vals_ptr
1247 :
1248 : INTEGER :: ik, irk, irs, len_key, my_index, &
1249 : tmp_index
1250 : LOGICAL :: valSet
1251 : TYPE(cp_sll_val_type), POINTER :: vals
1252 : TYPE(keyword_type), POINTER :: keyword
1253 : TYPE(section_type), POINTER :: section
1254 : TYPE(section_vals_type), POINTER :: s_vals
1255 : TYPE(val_type), POINTER :: my_val, old_val
1256 :
1257 432357 : CPASSERT(ASSOCIATED(section_vals))
1258 432357 : CPASSERT(section_vals%ref_count > 0)
1259 :
1260 432357 : my_index = INDEX(keyword_name, '%') + 1
1261 432357 : len_key = LEN_TRIM(keyword_name)
1262 432357 : IF (my_index > 1) THEN
1263 8438 : DO
1264 85285 : tmp_index = INDEX(keyword_name(my_index:len_key), "%")
1265 85285 : IF (tmp_index <= 0) EXIT
1266 8438 : my_index = my_index + tmp_index
1267 : END DO
1268 76847 : s_vals => section_vals_get_subs_vals(section_vals, keyword_name(1:my_index - 2))
1269 : ELSE
1270 355510 : s_vals => section_vals
1271 : END IF
1272 :
1273 432357 : irk = 1
1274 432357 : irs = 1
1275 432357 : IF (PRESENT(i_rep_section)) irs = i_rep_section
1276 432357 : IF (PRESENT(i_rep_val)) irk = i_rep_val
1277 432357 : section => s_vals%section
1278 432357 : ik = section_get_keyword_index(s_vals%section, keyword_name(my_index:len_key))
1279 432357 : IF (ik == -2) THEN
1280 : CALL cp_abort(__LOCATION__, &
1281 : "section "//TRIM(section%name)//" does not contain keyword "// &
1282 0 : TRIM(keyword_name(my_index:len_key)))
1283 : END IF
1284 : ! Add values..
1285 29841 : DO
1286 462198 : IF (irs <= SIZE(s_vals%values, 2)) EXIT
1287 29841 : CALL section_vals_add_values(s_vals)
1288 : END DO
1289 432357 : IF (.NOT. (irs > 0 .AND. irs <= SIZE(s_vals%subs_vals, 2))) THEN
1290 : CALL cp_abort(__LOCATION__, &
1291 : "section repetition requested ("//cp_to_string(irs)// &
1292 : ") out of bounds (1:"//cp_to_string(SIZE(s_vals%subs_vals, 2)) &
1293 0 : //")")
1294 : END IF
1295 432357 : keyword => s_vals%section%keywords(ik)%keyword
1296 432357 : NULLIFY (my_val)
1297 432357 : IF (PRESENT(val)) my_val => val
1298 : valSet = PRESENT(l_val) .OR. PRESENT(i_val) .OR. PRESENT(r_val) .OR. &
1299 : PRESENT(c_val) .OR. PRESENT(l_vals_ptr) .OR. PRESENT(i_vals_ptr) .OR. &
1300 432357 : PRESENT(r_vals_ptr) .OR. PRESENT(c_vals_ptr)
1301 432357 : IF (ASSOCIATED(my_val)) THEN
1302 : ! check better?
1303 0 : IF (valSet) THEN
1304 : CALL cp_abort(__LOCATION__, &
1305 : " both val and values present, in setting "// &
1306 : "keyword "//TRIM(keyword_name(my_index:len_key))//" of section "// &
1307 0 : TRIM(section%name))
1308 : END IF
1309 : ELSE
1310 : ! ignore ?
1311 432357 : IF (.NOT. valSet) THEN
1312 : CALL cp_abort(__LOCATION__, &
1313 : " empty value in setting "// &
1314 : "keyword "//TRIM(keyword_name(my_index:len_key))//" of section "// &
1315 0 : TRIM(section%name))
1316 : END IF
1317 0 : CPASSERT(valSet)
1318 432357 : IF (keyword%type_of_var == lchar_t) THEN
1319 125512 : CALL val_create(my_val, lc_val=c_val, lc_vals_ptr=c_vals_ptr)
1320 : ELSE
1321 : CALL val_create(my_val, l_val=l_val, i_val=i_val, r_val=r_val, &
1322 : c_val=c_val, l_vals_ptr=l_vals_ptr, i_vals_ptr=i_vals_ptr, &
1323 : r_vals_ptr=r_vals_ptr, &
1324 1105261 : c_vals_ptr=c_vals_ptr, enum=keyword%enum)
1325 : END IF
1326 432357 : CPASSERT(ASSOCIATED(my_val))
1327 432357 : CPASSERT(my_val%type_of_var == keyword%type_of_var)
1328 : END IF
1329 432357 : vals => s_vals%values(ik, irs)%list
1330 432357 : IF (irk == -1) THEN
1331 0 : CALL cp_sll_val_insert_el_at(vals, my_val, index=-1)
1332 432357 : ELSE IF (irk <= cp_sll_val_get_length(vals)) THEN
1333 207693 : IF (irk <= 0) THEN
1334 : CALL cp_abort(__LOCATION__, &
1335 : "invalid irk "//TRIM(ADJUSTL(cp_to_string(irk)))// &
1336 : " in keyword "//TRIM(keyword_name(my_index:len_key))//" of section "// &
1337 0 : TRIM(section%name))
1338 : END IF
1339 207693 : old_val => cp_sll_val_get_el_at(vals, index=irk)
1340 207693 : CALL val_release(old_val)
1341 207693 : CALL cp_sll_val_set_el_at(vals, value=my_val, index=irk)
1342 224664 : ELSE IF (irk > cp_sll_val_get_length(vals) + 1) THEN
1343 : ! change?
1344 : CALL cp_abort(__LOCATION__, &
1345 : "cannot add extra keyword repetitions to keyword" &
1346 : //TRIM(keyword_name(my_index:len_key))//" of section "// &
1347 0 : TRIM(section%name))
1348 : ELSE
1349 224664 : CALL cp_sll_val_insert_el_at(vals, my_val, index=irk)
1350 : END IF
1351 432357 : s_vals%values(ik, irs)%list => vals
1352 : NULLIFY (my_val)
1353 432357 : END SUBROUTINE section_vals_val_set
1354 :
1355 : ! **************************************************************************************************
1356 : !> \brief unsets (removes) the requested value (if it is a keyword repetitions
1357 : !> removes the repetition, so be careful: the repetition indices bigger
1358 : !> than the actual change.
1359 : !> \param section_vals ...
1360 : !> \param keyword_name the name of the keyword you want (can be a path
1361 : !> separated by '%')
1362 : !> \param i_rep_section which repetition of the section you are interested in
1363 : !> (defaults to 1)
1364 : !> \param i_rep_val which repetition of the keyword/val you are interested in
1365 : !> (defaults to 1)
1366 : !> \author fawzi
1367 : ! **************************************************************************************************
1368 224167 : SUBROUTINE section_vals_val_unset(section_vals, keyword_name, i_rep_section, i_rep_val)
1369 :
1370 : TYPE(section_vals_type), POINTER :: section_vals
1371 : CHARACTER(len=*), INTENT(in) :: keyword_name
1372 : INTEGER, INTENT(in), OPTIONAL :: i_rep_section, i_rep_val
1373 :
1374 : INTEGER :: ik, irk, irs, len_key, my_index, &
1375 : tmp_index
1376 : TYPE(cp_sll_val_type), POINTER :: pos
1377 : TYPE(section_type), POINTER :: section
1378 : TYPE(section_vals_type), POINTER :: s_vals
1379 : TYPE(val_type), POINTER :: old_val
1380 :
1381 224167 : NULLIFY (pos)
1382 224167 : CPASSERT(ASSOCIATED(section_vals))
1383 224167 : CPASSERT(section_vals%ref_count > 0)
1384 :
1385 224167 : my_index = INDEX(keyword_name, '%') + 1
1386 224167 : len_key = LEN_TRIM(keyword_name)
1387 224167 : IF (my_index > 1) THEN
1388 332 : DO
1389 27186 : tmp_index = INDEX(keyword_name(my_index:len_key), "%")
1390 27186 : IF (tmp_index <= 0) EXIT
1391 332 : my_index = my_index + tmp_index
1392 : END DO
1393 26854 : s_vals => section_vals_get_subs_vals(section_vals, keyword_name(1:my_index - 2))
1394 : ELSE
1395 197313 : s_vals => section_vals
1396 : END IF
1397 :
1398 224167 : irk = 1
1399 224167 : irs = 1
1400 224167 : IF (PRESENT(i_rep_section)) irs = i_rep_section
1401 224167 : IF (PRESENT(i_rep_val)) irk = i_rep_val
1402 224167 : section => s_vals%section
1403 224167 : ik = section_get_keyword_index(s_vals%section, keyword_name(my_index:len_key))
1404 224167 : IF (ik == -2) THEN
1405 : CALL cp_abort(__LOCATION__, &
1406 : "section "//TRIM(section%name)//" does not contain keyword "// &
1407 0 : TRIM(keyword_name(my_index:len_key)))
1408 : END IF
1409 : ! ignore unset of non set values
1410 224167 : IF (irs <= SIZE(s_vals%values, 2)) THEN
1411 224167 : IF (.NOT. (irs > 0 .AND. irs <= SIZE(s_vals%subs_vals, 2))) THEN
1412 : CALL cp_abort(__LOCATION__, &
1413 : "section repetition requested ("//cp_to_string(irs)// &
1414 : ") out of bounds (1:"//cp_to_string(SIZE(s_vals%subs_vals, 2)) &
1415 0 : //")")
1416 : END IF
1417 224167 : IF (irk == -1) THEN
1418 0 : pos => cp_sll_val_get_rest(s_vals%values(ik, irs)%list, iter=-1)
1419 : ELSE
1420 224167 : pos => cp_sll_val_get_rest(s_vals%values(ik, irs)%list, iter=irk - 1)
1421 : END IF
1422 224167 : IF (ASSOCIATED(pos)) THEN
1423 56131 : old_val => cp_sll_val_get_el_at(s_vals%values(ik, irs)%list, index=irk)
1424 56131 : CALL val_release(old_val)
1425 56131 : CALL cp_sll_val_rm_el_at(s_vals%values(ik, irs)%list, index=irk)
1426 : END IF
1427 : END IF
1428 :
1429 224167 : END SUBROUTINE section_vals_val_unset
1430 :
1431 : ! **************************************************************************************************
1432 : !> \brief writes the values in the given section in a way that is suitable to
1433 : !> the automatic parsing
1434 : !> \param section_vals the section to write out
1435 : !> \param unit_nr the unit where to write to
1436 : !> \param hide_root ...
1437 : !> \param hide_defaults ...
1438 : !> \author fawzi
1439 : !> \note
1440 : !> skips required sections which weren't read
1441 : ! **************************************************************************************************
1442 2422374 : RECURSIVE SUBROUTINE section_vals_write(section_vals, unit_nr, hide_root, hide_defaults)
1443 :
1444 : TYPE(section_vals_type), INTENT(IN) :: section_vals
1445 : INTEGER, INTENT(in) :: unit_nr
1446 : LOGICAL, INTENT(in), OPTIONAL :: hide_root, hide_defaults
1447 :
1448 : INTEGER, PARAMETER :: incr = 2
1449 :
1450 : CHARACTER(LEN=1) :: first_key_char, first_sec_char
1451 : CHARACTER(LEN=25) :: myfmt
1452 : INTEGER :: i_rep_s, ik, isec, ival, nr, nval
1453 : INTEGER, SAVE :: indent = 1
1454 : LOGICAL :: defaultSection, explicit, &
1455 : my_hide_defaults, my_hide_root
1456 : TYPE(cp_sll_val_type), POINTER :: new_pos, vals
1457 : TYPE(keyword_type), POINTER :: keyword
1458 : TYPE(section_type), POINTER :: section
1459 : TYPE(section_vals_type), POINTER :: sval
1460 : TYPE(val_type), POINTER :: val
1461 :
1462 2422374 : my_hide_root = .FALSE.
1463 2422374 : my_hide_defaults = .TRUE.
1464 2422374 : IF (PRESENT(hide_root)) my_hide_root = hide_root
1465 2422374 : IF (PRESENT(hide_defaults)) my_hide_defaults = hide_defaults
1466 :
1467 2422374 : CPASSERT(section_vals%ref_count > 0)
1468 2422374 : IF (unit_nr > 0) THEN
1469 2422374 : CALL section_vals_get(section_vals, explicit=explicit, n_repetition=nr, section=section)
1470 2422374 : IF (ALLOCATED(section%deprecation_notice)) THEN
1471 0 : first_sec_char = "#"
1472 : ELSE
1473 2422374 : first_sec_char = " "
1474 : END IF
1475 2422374 : IF (explicit .OR. (.NOT. my_hide_defaults)) THEN
1476 554563 : DO i_rep_s = 1, nr
1477 284147 : IF (.NOT. my_hide_root) THEN
1478 275823 : WRITE (UNIT=myfmt, FMT="(A1,I0,A4)") "(", indent, "X,A)"
1479 275823 : IF (ASSOCIATED(section%keywords(-1)%keyword)) THEN
1480 : WRITE (UNIT=unit_nr, FMT=myfmt, ADVANCE="NO") &
1481 57398 : TRIM(first_sec_char)//default_section_character//TRIM(ADJUSTL(section%name))
1482 : ELSE
1483 : WRITE (UNIT=unit_nr, FMT=myfmt) &
1484 218425 : TRIM(first_sec_char)//default_section_character//TRIM(ADJUSTL(section%name))
1485 : END IF
1486 : END IF
1487 284147 : defaultSection = (SIZE(section_vals%values, 2) == 0)
1488 284147 : IF (.NOT. defaultSection) THEN
1489 284147 : IF (.NOT. my_hide_root) indent = indent + incr
1490 284147 : WRITE (UNIT=myfmt, FMT="(A1,I0,A4)") "(", indent, "X,A)"
1491 3080093 : DO ik = -1, section%n_keywords
1492 2795946 : keyword => section%keywords(ik)%keyword
1493 3080093 : IF (ASSOCIATED(keyword)) THEN
1494 2316337 : IF (ALLOCATED(keyword%deprecation_notice) .OR. &
1495 : ALLOCATED(section%deprecation_notice)) THEN
1496 : ! Comment deprecated keyword
1497 17911 : first_key_char = "#"
1498 : ELSE
1499 2298426 : first_key_char = " "
1500 : END IF
1501 2316337 : IF (keyword%type_of_var /= no_t .AND. keyword%names(1) (1:2) /= "__") THEN
1502 : CALL section_vals_val_get(section_vals, keyword%names(1), &
1503 2258001 : i_rep_s, n_rep_val=nval)
1504 2258001 : IF (i_rep_s <= SIZE(section_vals%values, 2)) THEN
1505 : ! Section was parsed
1506 2258001 : vals => section_vals%values(ik, i_rep_s)%list
1507 5623736 : DO ival = 1, nval
1508 3365735 : IF (ival == 1) THEN
1509 : new_pos => vals
1510 : ELSE
1511 1270219 : new_pos => new_pos%rest
1512 : END IF
1513 3365735 : IF (.NOT. ASSOCIATED(new_pos)) THEN
1514 : ! this keyword was not parsed
1515 1525208 : IF (ASSOCIATED(keyword%default_value)) THEN
1516 1525208 : val => keyword%default_value
1517 1525208 : IF (my_hide_defaults) CYCLE
1518 : END IF
1519 : ELSE
1520 1840527 : val => new_pos%first_el
1521 : END IF
1522 1844572 : IF (keyword%names(1) /= '_DEFAULT_KEYWORD_' .AND. &
1523 : keyword%names(1) /= '_SECTION_PARAMETERS_') THEN
1524 : WRITE (UNIT=unit_nr, FMT=myfmt, ADVANCE="NO") &
1525 486952 : TRIM(first_key_char)//TRIM(keyword%names(1))
1526 1357620 : ELSE IF (keyword%names(1) == '_DEFAULT_KEYWORD_' .AND. &
1527 : keyword%type_of_var /= lchar_t) THEN
1528 454352 : WRITE (UNIT=unit_nr, FMT=myfmt, ADVANCE="NO")
1529 : END IF
1530 5623736 : CALL val_write(val, unit_nr=unit_nr, unit=keyword%unit, fmt=myfmt)
1531 : END DO
1532 0 : ELSE IF (ASSOCIATED(keyword%default_value)) THEN
1533 : ! Section was not parsed but default for the keywords may exist
1534 0 : IF (my_hide_defaults) CYCLE
1535 0 : val => keyword%default_value
1536 0 : IF (keyword%names(1) /= '_DEFAULT_KEYWORD_' .AND. &
1537 : keyword%names(1) /= '_SECTION_PARAMETERS_') THEN
1538 : WRITE (UNIT=unit_nr, FMT=myfmt, ADVANCE="NO") &
1539 0 : TRIM(first_key_char)//TRIM(keyword%names(1))
1540 0 : ELSE IF (keyword%names(1) == '_DEFAULT_KEYWORD_' .AND. &
1541 : keyword%type_of_var /= lchar_t) THEN
1542 0 : WRITE (UNIT=unit_nr, FMT=myfmt, ADVANCE="NO")
1543 : END IF
1544 0 : CALL val_write(val, unit_nr=unit_nr, unit=keyword%unit, fmt=myfmt)
1545 : END IF
1546 : END IF
1547 : END IF
1548 : END DO
1549 284147 : IF (ASSOCIATED(section_vals%subs_vals)) THEN
1550 2698197 : DO isec = 1, SIZE(section_vals%subs_vals, 1)
1551 2414050 : sval => section_vals%subs_vals(isec, i_rep_s)%section_vals
1552 2698197 : IF (ASSOCIATED(sval)) THEN
1553 2414050 : CALL section_vals_write(sval, unit_nr=unit_nr, hide_defaults=hide_defaults)
1554 : END IF
1555 : END DO
1556 : END IF
1557 : END IF
1558 2706521 : IF (.NOT. my_hide_root) THEN
1559 275823 : indent = indent - incr
1560 275823 : WRITE (UNIT=myfmt, FMT="(A1,I0,A4)") "(", indent, "X,A)"
1561 : WRITE (UNIT=unit_nr, FMT=myfmt) &
1562 : TRIM(first_sec_char)//default_section_character// &
1563 275823 : "END "//TRIM(ADJUSTL(section%name))
1564 : END IF
1565 : END DO
1566 : END IF
1567 : END IF
1568 :
1569 2422374 : END SUBROUTINE section_vals_write
1570 :
1571 : ! **************************************************************************************************
1572 : !> \brief writes the values in the given section in xml
1573 : !> \param section ...
1574 : !> \param level ...
1575 : !> \param unit_number ...
1576 : ! **************************************************************************************************
1577 0 : RECURSIVE SUBROUTINE write_section_xml(section, level, unit_number)
1578 :
1579 : TYPE(section_type), POINTER :: section
1580 : INTEGER, INTENT(IN) :: level, unit_number
1581 :
1582 : CHARACTER(LEN=3) :: repeats
1583 : CHARACTER(LEN=8) :: short_string
1584 : INTEGER :: i, l0, l1, l2
1585 :
1586 0 : IF (ASSOCIATED(section)) THEN
1587 :
1588 0 : CPASSERT(section%ref_count > 0)
1589 :
1590 : ! Indentation for current level, next level, etc.
1591 :
1592 0 : l0 = level
1593 0 : l1 = level + 1
1594 0 : l2 = level + 2
1595 :
1596 0 : IF (section%repeats) THEN
1597 0 : repeats = "yes"
1598 : ELSE
1599 0 : repeats = "no "
1600 : END IF
1601 :
1602 0 : WRITE (UNIT=unit_number, FMT="(A)") &
1603 0 : REPEAT(" ", l0)//"<SECTION repeats="""//TRIM(repeats)//""">", &
1604 0 : REPEAT(" ", l1)//"<NAME>"//TRIM(section%name)//"</NAME>", &
1605 : REPEAT(" ", l1)//"<DESCRIPTION>"// &
1606 : TRIM(substitute_special_xml_tokens(a2s(section%description))) &
1607 0 : //"</DESCRIPTION>"
1608 :
1609 0 : IF (ALLOCATED(section%deprecation_notice)) THEN
1610 : WRITE (UNIT=unit_number, FMT="(A)") REPEAT(" ", l1)//"<DEPRECATION_NOTICE>"// &
1611 : TRIM(substitute_special_xml_tokens(section%deprecation_notice)) &
1612 0 : //"</DEPRECATION_NOTICE>"
1613 : END IF
1614 :
1615 0 : IF (ASSOCIATED(section%citations)) THEN
1616 0 : DO i = 1, SIZE(section%citations, 1)
1617 0 : short_string = ""
1618 0 : WRITE (UNIT=short_string, FMT="(I8)") section%citations(i)
1619 0 : WRITE (UNIT=unit_number, FMT="(A)") &
1620 0 : REPEAT(" ", l1)//"<REFERENCE>", &
1621 0 : REPEAT(" ", l2)//"<NAME>"//TRIM(get_citation_key(section%citations(i)))//"</NAME>", &
1622 0 : REPEAT(" ", l2)//"<NUMBER>"//TRIM(ADJUSTL(short_string))//"</NUMBER>", &
1623 0 : REPEAT(" ", l1)//"</REFERENCE>"
1624 : END DO
1625 : END IF
1626 :
1627 0 : WRITE (UNIT=unit_number, FMT="(A)") &
1628 0 : REPEAT(" ", l1)//"<LOCATION>"//TRIM(section%location)//"</LOCATION>"
1629 :
1630 0 : DO i = -1, section%n_keywords
1631 0 : IF (ASSOCIATED(section%keywords(i)%keyword)) THEN
1632 0 : CALL write_keyword_xml(section%keywords(i)%keyword, l1, unit_number)
1633 : END IF
1634 : END DO
1635 :
1636 0 : DO i = 1, section%n_subsections
1637 0 : CALL write_section_xml(section%subsections(i)%section, l1, unit_number)
1638 : END DO
1639 :
1640 0 : WRITE (UNIT=unit_number, FMT="(A)") REPEAT(" ", l0)//"</SECTION>"
1641 :
1642 : END IF
1643 :
1644 0 : END SUBROUTINE write_section_xml
1645 :
1646 : ! **************************************************************************************************
1647 : !> \brief ...
1648 : !> \param section ...
1649 : !> \param section_name ...
1650 : !> \param unknown_string ...
1651 : !> \param location_string ...
1652 : !> \param matching_rank ...
1653 : !> \param matching_string ...
1654 : !> \param bonus ...
1655 : ! **************************************************************************************************
1656 0 : RECURSIVE SUBROUTINE section_typo_match(section, section_name, unknown_string, location_string, &
1657 0 : matching_rank, matching_string, bonus)
1658 :
1659 : TYPE(section_type), INTENT(IN), POINTER :: section
1660 : CHARACTER(LEN=*) :: section_name, unknown_string, &
1661 : location_string
1662 : INTEGER, DIMENSION(:), INTENT(INOUT) :: matching_rank
1663 : CHARACTER(LEN=*), DIMENSION(:), INTENT(INOUT) :: matching_string
1664 : INTEGER, INTENT(IN) :: bonus
1665 :
1666 0 : CHARACTER(LEN=LEN(matching_string(1))) :: line
1667 : INTEGER :: i, imatch, imax, irank, newbonus
1668 :
1669 0 : IF (ASSOCIATED(section)) THEN
1670 0 : CPASSERT(section%ref_count > 0)
1671 0 : imatch = typo_match(TRIM(section%name), TRIM(unknown_string))
1672 0 : IF (imatch > 0) THEN
1673 0 : imatch = imatch + bonus
1674 : WRITE (UNIT=line, FMT='(T2,A)') &
1675 : " subsection "//TRIM(ADJUSTL(section%name))// &
1676 0 : " in section "//TRIM(ADJUSTL(location_string))
1677 0 : imax = SIZE(matching_rank, 1)
1678 0 : irank = imax + 1
1679 0 : DO I = imax, 1, -1
1680 0 : IF (imatch > matching_rank(I)) irank = i
1681 : END DO
1682 0 : IF (irank <= imax) THEN
1683 0 : matching_rank(irank + 1:imax) = matching_rank(irank:imax - 1)
1684 0 : matching_string(irank + 1:imax) = matching_string(irank:imax - 1)
1685 0 : matching_rank(irank) = imatch
1686 0 : matching_string(irank) = line
1687 : END IF
1688 : END IF
1689 :
1690 0 : IF (section_name == section%name) THEN
1691 0 : newbonus = 10
1692 : ELSE
1693 0 : newbonus = 0
1694 : END IF
1695 :
1696 0 : DO i = -1, section%n_keywords
1697 0 : IF (ASSOCIATED(section%keywords(i)%keyword)) THEN
1698 : CALL keyword_typo_match(section%keywords(i)%keyword, unknown_string, location_string// &
1699 0 : "%"//TRIM(section%name), matching_rank, matching_string, newbonus)
1700 : END IF
1701 : END DO
1702 :
1703 0 : DO i = 1, section%n_subsections
1704 : CALL section_typo_match(section%subsections(i)%section, section_name, unknown_string, &
1705 0 : location_string//"%"//TRIM(section%name), matching_rank, matching_string, newbonus)
1706 : END DO
1707 :
1708 : END IF
1709 :
1710 0 : END SUBROUTINE section_typo_match
1711 :
1712 : ! **************************************************************************************************
1713 : !> \brief replaces of the requested subsection with the one given
1714 : !> \param section_vals the root section
1715 : !> \param subsection_name the name of the subsection to replace
1716 : !> \param new_section_vals the new section_vals to use
1717 : !> \param i_rep_section index of the repetition of section_vals of which
1718 : !> you want to replace the subsection (defaults to 1)
1719 : !> \author fawzi
1720 : ! **************************************************************************************************
1721 4624 : SUBROUTINE section_vals_set_subs_vals(section_vals, subsection_name, &
1722 : new_section_vals, i_rep_section)
1723 : TYPE(section_vals_type), POINTER :: section_vals
1724 : CHARACTER(len=*), INTENT(in) :: subsection_name
1725 : TYPE(section_vals_type), POINTER :: new_section_vals
1726 : INTEGER, INTENT(in), OPTIONAL :: i_rep_section
1727 :
1728 : INTEGER :: irep, isection, len_key, my_index, &
1729 : tmp_index
1730 : TYPE(section_vals_type), POINTER :: s_vals
1731 :
1732 4624 : CPASSERT(ASSOCIATED(section_vals))
1733 4624 : CPASSERT(section_vals%ref_count > 0)
1734 4624 : CPASSERT(ASSOCIATED(new_section_vals))
1735 4624 : CPASSERT(new_section_vals%ref_count > 0)
1736 :
1737 4624 : irep = 1
1738 4624 : IF (PRESENT(i_rep_section)) irep = i_rep_section
1739 :
1740 4624 : my_index = INDEX(subsection_name, '%') + 1
1741 4624 : len_key = LEN_TRIM(subsection_name)
1742 4624 : IF (my_index > 1) THEN
1743 5858 : DO
1744 8654 : tmp_index = INDEX(subsection_name(my_index:len_key), "%")
1745 8654 : IF (tmp_index <= 0) EXIT
1746 5858 : my_index = my_index + tmp_index
1747 : END DO
1748 2796 : s_vals => section_vals_get_subs_vals(section_vals, subsection_name(1:my_index - 2))
1749 : ELSE
1750 1828 : s_vals => section_vals
1751 : END IF
1752 :
1753 4624 : CPASSERT(irep <= SIZE(s_vals%subs_vals, 2))
1754 :
1755 4624 : isection = section_get_subsection_index(s_vals%section, subsection_name(my_index:LEN_TRIM(subsection_name)))
1756 4624 : IF (isection <= 0) THEN
1757 : CALL cp_abort(__LOCATION__, &
1758 : "could not find subsection "//subsection_name(my_index:LEN_TRIM(subsection_name))//" in section "// &
1759 0 : TRIM(section_vals%section%name)//" at ")
1760 : END IF
1761 4624 : CALL section_vals_retain(new_section_vals)
1762 4624 : CALL section_vals_release(s_vals%subs_vals(isection, irep)%section_vals)
1763 4624 : s_vals%subs_vals(isection, irep)%section_vals => new_section_vals
1764 :
1765 4624 : END SUBROUTINE section_vals_set_subs_vals
1766 :
1767 : ! **************************************************************************************************
1768 : !> \brief creates a deep copy from section_vals_in to section_vals_out
1769 : !> \param section_vals_in the section_vals to copy
1770 : !> \param section_vals_out the section_vals to create
1771 : !> \param i_rep_start ...
1772 : !> \param i_rep_end ...
1773 : !> \author fawzi
1774 : ! **************************************************************************************************
1775 1795 : SUBROUTINE section_vals_duplicate(section_vals_in, section_vals_out, &
1776 : i_rep_start, i_rep_end)
1777 : TYPE(section_vals_type), POINTER :: section_vals_in, section_vals_out
1778 : INTEGER, INTENT(IN), OPTIONAL :: i_rep_start, i_rep_end
1779 :
1780 1795 : CPASSERT(ASSOCIATED(section_vals_in))
1781 1795 : CPASSERT(.NOT. ASSOCIATED(section_vals_out))
1782 1795 : CALL section_vals_create(section_vals_out, section_vals_in%section)
1783 1795 : CALL section_vals_copy(section_vals_in, section_vals_out, i_rep_start, i_rep_end)
1784 1795 : END SUBROUTINE section_vals_duplicate
1785 :
1786 : ! **************************************************************************************************
1787 : !> \brief deep copy from section_vals_in to section_vals_out
1788 : !> \param section_vals_in the section_vals to copy
1789 : !> \param section_vals_out the section_vals where to copy
1790 : !> \param i_rep_low ...
1791 : !> \param i_rep_high ...
1792 : !> \author fawzi
1793 : !> \note
1794 : !> private, only works with a newly initialized section_vals_out
1795 : ! **************************************************************************************************
1796 5654107 : RECURSIVE SUBROUTINE section_vals_copy(section_vals_in, section_vals_out, &
1797 : i_rep_low, i_rep_high)
1798 : TYPE(section_vals_type), POINTER :: section_vals_in, section_vals_out
1799 : INTEGER, INTENT(IN), OPTIONAL :: i_rep_low, i_rep_high
1800 :
1801 : INTEGER :: iend, irep, isec, istart, ival
1802 : TYPE(cp_sll_val_type), POINTER :: v1, v2
1803 : TYPE(val_type), POINTER :: el
1804 :
1805 5654107 : NULLIFY (v2, el)
1806 :
1807 5654107 : CPASSERT(ASSOCIATED(section_vals_in))
1808 5654107 : CPASSERT(ASSOCIATED(section_vals_out))
1809 :
1810 5654107 : istart = 1
1811 5654107 : iend = SIZE(section_vals_in%values, 2)
1812 5654107 : IF (PRESENT(i_rep_low)) istart = i_rep_low
1813 5654107 : IF (PRESENT(i_rep_high)) iend = i_rep_high
1814 5672440 : DO irep = istart, iend
1815 18333 : CALL section_vals_add_values(section_vals_out)
1816 5891060 : DO ival = LBOUND(section_vals_in%values, 1), UBOUND(section_vals_in%values, 1)
1817 181954 : v1 => section_vals_in%values(ival, irep)%list
1818 200287 : IF (ASSOCIATED(v1)) THEN
1819 37714 : CALL val_duplicate(v1%first_el, el)
1820 37714 : CALL cp_sll_val_create(v2, el)
1821 37714 : NULLIFY (el)
1822 37714 : section_vals_out%values(ival, irep - istart + 1)%list => v2
1823 45974 : DO
1824 83688 : IF (.NOT. ASSOCIATED(v1%rest)) EXIT
1825 45974 : v1 => v1%rest
1826 45974 : CALL val_duplicate(v1%first_el, el)
1827 45974 : CALL cp_sll_val_create(v2%rest, first_el=el)
1828 45974 : NULLIFY (el)
1829 45974 : v2 => v2%rest
1830 : END DO
1831 : END IF
1832 : END DO
1833 : END DO
1834 5654107 : IF (.NOT. PRESENT(i_rep_low) .AND. (.NOT. PRESENT(i_rep_high))) THEN
1835 5653581 : IF (.NOT. (SIZE(section_vals_in%values, 2) == SIZE(section_vals_out%values, 2))) THEN
1836 0 : CPABORT("Incompatible sizes of values between input and output")
1837 : END IF
1838 5653581 : IF (.NOT. (SIZE(section_vals_in%subs_vals, 2) == SIZE(section_vals_out%subs_vals, 2))) THEN
1839 0 : CPABORT("Incompatible sizes of subsections between input and output")
1840 : END IF
1841 : END IF
1842 5654107 : iend = SIZE(section_vals_in%subs_vals, 2)
1843 5654107 : IF (PRESENT(i_rep_high)) iend = i_rep_high
1844 11309347 : DO irep = istart, iend
1845 16961659 : DO isec = 1, SIZE(section_vals_in%subs_vals, 1)
1846 : CALL section_vals_copy(section_vals_in%subs_vals(isec, irep)%section_vals, &
1847 11307552 : section_vals_out%subs_vals(isec, irep - istart + 1)%section_vals)
1848 : END DO
1849 : END DO
1850 :
1851 5654107 : END SUBROUTINE section_vals_copy
1852 :
1853 0 : END MODULE input_section_types
|
