Line data Source code
1 : !--------------------------------------------------------------------------------------------------!
2 : ! CP2K: A general program to perform molecular dynamics simulations !
3 : ! Copyright 2000-2024 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 72437971 : SUBROUTINE section_create(section, location, name, description, n_keywords, &
157 4465555 : 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 72437971 : CPASSERT(.NOT. ASSOCIATED(section))
169 72437971 : my_n_keywords = 10
170 72437971 : IF (PRESENT(n_keywords)) my_n_keywords = n_keywords
171 72437971 : my_n_subsections = 0
172 72437971 : IF (PRESENT(n_subsections)) my_n_subsections = n_subsections
173 :
174 72437971 : ALLOCATE (section)
175 72437971 : section%ref_count = 1
176 :
177 : section%n_keywords = 0
178 : section%n_subsections = 0
179 72437971 : section%location = location
180 :
181 72437971 : CPASSERT(LEN_TRIM(name) > 0)
182 72437971 : section%name = name
183 72437971 : CALL uppercase(section%name)
184 :
185 72437971 : n = LEN_TRIM(description)
186 217194327 : ALLOCATE (section%description(n))
187 6583125287 : DO i = 1, n
188 6583125287 : section%description(i) = description(i:i)
189 : END DO
190 :
191 72437971 : section%frozen = .FALSE.
192 72437971 : section%repeats = .FALSE.
193 72437971 : IF (PRESENT(repeats)) section%repeats = repeats
194 :
195 72437971 : NULLIFY (section%citations)
196 72437971 : IF (PRESENT(citations)) THEN
197 13396665 : ALLOCATE (section%citations(SIZE(citations)))
198 13074611 : section%citations = citations
199 : END IF
200 :
201 747886941 : ALLOCATE (section%keywords(-1:my_n_keywords))
202 603010999 : DO i = -1, my_n_keywords
203 603010999 : NULLIFY (section%keywords(i)%keyword)
204 : END DO
205 :
206 156194056 : ALLOCATE (section%subsections(my_n_subsections))
207 79719662 : DO i = 1, my_n_subsections
208 79719662 : NULLIFY (section%subsections(i)%section)
209 : END DO
210 :
211 72437971 : IF (PRESENT(deprecation_notice)) THEN
212 17076 : section%deprecation_notice = TRIM(deprecation_notice)
213 : END IF
214 :
215 72437971 : 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 155495232 : SUBROUTINE section_retain(section)
223 :
224 : TYPE(section_type), POINTER :: section
225 :
226 155495232 : CPASSERT(ASSOCIATED(section))
227 155495232 : CPASSERT(section%ref_count > 0)
228 155495232 : section%ref_count = section%ref_count + 1
229 :
230 155495232 : 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 315759008 : RECURSIVE SUBROUTINE section_release(section)
238 :
239 : TYPE(section_type), POINTER :: section
240 :
241 : INTEGER :: i
242 :
243 315759008 : IF (ASSOCIATED(section)) THEN
244 227933203 : CPASSERT(section%ref_count > 0)
245 227933203 : section%ref_count = section%ref_count - 1
246 227933203 : IF (section%ref_count == 0) THEN
247 72437971 : IF (ASSOCIATED(section%citations)) THEN
248 4465555 : DEALLOCATE (section%citations)
249 : END IF
250 72437971 : IF (ASSOCIATED(section%keywords)) THEN
251 946289370 : DO i = -1, UBOUND(section%keywords, 1)
252 873851399 : CALL keyword_release(section%keywords(i)%keyword)
253 : END DO
254 72437971 : DEALLOCATE (section%keywords)
255 : END IF
256 72437971 : section%n_keywords = 0
257 72437971 : IF (ASSOCIATED(section%subsections)) THEN
258 232635722 : DO i = 1, SIZE(section%subsections)
259 232635722 : CALL section_release(section%subsections(i)%section)
260 : END DO
261 72437971 : DEALLOCATE (section%subsections)
262 : END IF
263 72437971 : DEALLOCATE (section%description)
264 72437971 : DEALLOCATE (section)
265 : END IF
266 227933203 : NULLIFY (section)
267 : END IF
268 :
269 315759008 : 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) &
330 1 : WRITE (UNIT=unit_nr, FMT="('*** section &',A,' ***')") TRIM(ADJUSTL(section%name))
331 1 : IF (level > 1) THEN
332 1 : message = get_section_info(section)
333 1 : CALL print_message(TRIM(a2s(section%description))//TRIM(message), unit_nr, 0, 0, 0)
334 : END IF
335 1 : IF (level > 0) THEN
336 1 : IF (ASSOCIATED(section%keywords(-1)%keyword)) THEN
337 : CALL keyword_describe(section%keywords(-1)%keyword, unit_nr, &
338 0 : level)
339 : END IF
340 1 : IF (ASSOCIATED(section%keywords(0)%keyword)) THEN
341 : CALL keyword_describe(section%keywords(0)%keyword, unit_nr, &
342 0 : level)
343 : END IF
344 20 : DO ikeyword = 1, section%n_keywords
345 : CALL keyword_describe(section%keywords(ikeyword)%keyword, unit_nr, &
346 20 : level)
347 : END DO
348 : END IF
349 1 : IF (section%n_subsections > 0 .AND. my_recurse >= 0) THEN
350 1 : IF (.NOT. my_hide_root) &
351 1 : WRITE (UNIT=unit_nr, FMT="('** subsections **')")
352 15 : DO isub = 1, section%n_subsections
353 15 : IF (my_recurse > 0) THEN
354 : CALL section_describe(section%subsections(isub)%section, unit_nr, &
355 0 : level, recurse=my_recurse - 1)
356 : ELSE
357 14 : WRITE (UNIT=unit_nr, FMT="(1X,A)") section%subsections(isub)%section%name
358 : END IF
359 : END DO
360 : END IF
361 1 : IF (.NOT. my_hide_root) &
362 1 : WRITE (UNIT=unit_nr, FMT="('*** &end section ',A,' ***')") TRIM(ADJUSTL(section%name))
363 : ELSE
364 0 : WRITE (unit_nr, "(a)") '<section *null*>'
365 : END IF
366 : END IF
367 :
368 2 : END SUBROUTINE section_describe
369 :
370 : ! **************************************************************************************************
371 : !> \brief returns the index of requested subsection (-1 if not found)
372 : !> \param section the root section
373 : !> \param subsection_name the name of the subsection you want to get
374 : !> \return ...
375 : !> \author fawzi
376 : !> \note
377 : !> private utility function
378 : ! **************************************************************************************************
379 35562447 : FUNCTION section_get_subsection_index(section, subsection_name) RESULT(res)
380 :
381 : TYPE(section_type), INTENT(IN) :: section
382 : CHARACTER(len=*), INTENT(IN) :: subsection_name
383 : INTEGER :: res
384 :
385 : CHARACTER(len=default_string_length) :: upc_name
386 : INTEGER :: isub
387 :
388 0 : CPASSERT(section%ref_count > 0)
389 35562447 : res = -1
390 35562447 : upc_name = subsection_name
391 35562447 : CALL uppercase(upc_name)
392 285159194 : DO isub = 1, section%n_subsections
393 285159085 : CPASSERT(ASSOCIATED(section%subsections(isub)%section))
394 285159194 : IF (section%subsections(isub)%section%name == upc_name) THEN
395 : res = isub
396 : EXIT
397 : END IF
398 : END DO
399 :
400 35562447 : END FUNCTION section_get_subsection_index
401 :
402 : ! **************************************************************************************************
403 : !> \brief returns the requested subsection
404 : !> \param section the root section
405 : !> \param subsection_name the name of the subsection you want to get
406 : !> \return ...
407 : !> \author fawzi
408 : ! **************************************************************************************************
409 164 : FUNCTION section_get_subsection(section, subsection_name) RESULT(res)
410 :
411 : TYPE(section_type), INTENT(IN) :: section
412 : CHARACTER(len=*), INTENT(IN) :: subsection_name
413 : TYPE(section_type), POINTER :: res
414 :
415 : INTEGER :: isub
416 :
417 164 : isub = section_get_subsection_index(section, subsection_name)
418 164 : IF (isub > 0) THEN
419 164 : res => section%subsections(isub)%section
420 : ELSE
421 : NULLIFY (res)
422 : END IF
423 :
424 164 : END FUNCTION section_get_subsection
425 :
426 : ! **************************************************************************************************
427 : !> \brief returns the index of the requested keyword (or -2 if not found)
428 : !> \param section the section the keyword is in
429 : !> \param keyword_name the keyword you are interested in
430 : !> \return ...
431 : !> \author fawzi
432 : !> \note
433 : !> private utility function
434 : ! **************************************************************************************************
435 36670737 : FUNCTION section_get_keyword_index(section, keyword_name) RESULT(res)
436 :
437 : TYPE(section_type), INTENT(IN) :: section
438 : CHARACTER(len=*), INTENT(IN) :: keyword_name
439 : INTEGER :: res
440 :
441 : INTEGER :: ik, in
442 : CHARACTER(len=default_string_length) :: upc_name
443 :
444 0 : CPASSERT(section%ref_count > 0)
445 36670737 : CPASSERT(ASSOCIATED(section%keywords))
446 36670737 : res = -2
447 36670737 : upc_name = keyword_name
448 36670737 : CALL uppercase(upc_name)
449 110012211 : DO ik = -1, 0
450 110012211 : IF (ASSOCIATED(section%keywords(ik)%keyword)) THEN
451 24386359 : IF (section%keywords(ik)%keyword%names(1) == upc_name) THEN
452 8123097 : res = ik
453 : END IF
454 : END IF
455 : END DO
456 36670737 : IF (res == -2) THEN
457 134249289 : k_search_loop: DO ik = 1, section%n_keywords
458 133966281 : CPASSERT(ASSOCIATED(section%keywords(ik)%keyword))
459 257049969 : DO in = 1, SIZE(section%keywords(ik)%keyword%names)
460 256766961 : IF (section%keywords(ik)%keyword%names(in) == upc_name) THEN
461 : res = ik
462 : EXIT k_search_loop
463 : END IF
464 : END DO
465 : END DO k_search_loop
466 : END IF
467 :
468 36670737 : END FUNCTION section_get_keyword_index
469 :
470 : ! **************************************************************************************************
471 : !> \brief returns the requested keyword
472 : !> \param section the section the keyword is in
473 : !> \param keyword_name the keyword you are interested in
474 : !> \return ...
475 : !> \author fawzi
476 : ! **************************************************************************************************
477 50808 : RECURSIVE FUNCTION section_get_keyword(section, keyword_name) RESULT(res)
478 :
479 : TYPE(section_type), INTENT(IN) :: section
480 : CHARACTER(len=*), INTENT(IN) :: keyword_name
481 : TYPE(keyword_type), POINTER :: res
482 :
483 : INTEGER :: ik, my_index
484 :
485 50808 : IF (INDEX(keyword_name, "%") /= 0) THEN
486 1988 : my_index = INDEX(keyword_name, "%") + 1
487 1988 : CPASSERT(ASSOCIATED(section%subsections))
488 13530 : DO ik = LBOUND(section%subsections, 1), UBOUND(section%subsections, 1)
489 9554 : IF (section%subsections(ik)%section%name == keyword_name(1:my_index - 2)) EXIT
490 : END DO
491 1988 : CPASSERT(ik <= UBOUND(section%subsections, 1))
492 1988 : res => section_get_keyword(section%subsections(ik)%section, keyword_name(my_index:))
493 : ELSE
494 48820 : ik = section_get_keyword_index(section, keyword_name)
495 48820 : IF (ik == -2) THEN
496 : NULLIFY (res)
497 : ELSE
498 48820 : res => section%keywords(ik)%keyword
499 : END IF
500 : END IF
501 :
502 50808 : END FUNCTION section_get_keyword
503 :
504 : ! **************************************************************************************************
505 : !> \brief adds a keyword to the given section
506 : !> \param section the section to which the keyword should be added
507 : !> \param keyword the keyword to add
508 : !> \author fawzi
509 : ! **************************************************************************************************
510 539503656 : SUBROUTINE section_add_keyword(section, keyword)
511 :
512 : TYPE(section_type), INTENT(INOUT) :: section
513 : TYPE(keyword_type), INTENT(IN), POINTER :: keyword
514 :
515 : INTEGER :: i, j, k
516 539503656 : TYPE(keyword_p_type), DIMENSION(:), POINTER :: new_keywords
517 :
518 0 : CPASSERT(section%ref_count > 0)
519 539503656 : CPASSERT(.NOT. section%frozen)
520 539503656 : CPASSERT(ASSOCIATED(keyword))
521 539503656 : CPASSERT(keyword%ref_count > 0)
522 539503656 : CALL keyword_retain(keyword)
523 539503656 : IF (keyword%names(1) == "_SECTION_PARAMETERS_") THEN
524 54372150 : CALL keyword_release(section%keywords(-1)%keyword)
525 54372150 : section%keywords(-1)%keyword => keyword
526 485131506 : ELSE IF (keyword%names(1) == "_DEFAULT_KEYWORD_") THEN
527 1867676 : CALL keyword_release(section%keywords(0)%keyword)
528 1867676 : section%keywords(0)%keyword => keyword
529 : ELSE
530 978025150 : DO k = 1, SIZE(keyword%names)
531 4476995916 : DO i = 1, section%n_keywords
532 7606979497 : DO j = 1, SIZE(section%keywords(i)%keyword%names)
533 7112218177 : IF (keyword%names(k) == section%keywords(i)%keyword%names(j)) THEN
534 : CALL cp_abort(__LOCATION__, &
535 : "trying to add a keyword with a name ("// &
536 : TRIM(keyword%names(k))//") that was already used in section " &
537 0 : //TRIM(section%name))
538 : END IF
539 : END DO
540 : END DO
541 : END DO
542 :
543 966527660 : IF (UBOUND(section%keywords, 1) == section%n_keywords) THEN
544 554380035 : ALLOCATE (new_keywords(-1:section%n_keywords + 10))
545 229371555 : DO i = -1, section%n_keywords
546 229371555 : new_keywords(i)%keyword => section%keywords(i)%keyword
547 : END DO
548 325008480 : DO i = section%n_keywords + 1, UBOUND(new_keywords, 1)
549 297924440 : NULLIFY (new_keywords(i)%keyword)
550 : END DO
551 27084040 : DEALLOCATE (section%keywords)
552 27084040 : section%keywords => new_keywords
553 : END IF
554 483263830 : section%n_keywords = section%n_keywords + 1
555 483263830 : section%keywords(section%n_keywords)%keyword => keyword
556 : END IF
557 :
558 539503656 : END SUBROUTINE section_add_keyword
559 :
560 : ! **************************************************************************************************
561 : !> \brief adds a subsection to the given section
562 : !> \param section to section to which you want to add a subsection
563 : !> \param subsection the subsection to add
564 : !> \author fawzi
565 : ! **************************************************************************************************
566 72396930 : SUBROUTINE section_add_subsection(section, subsection)
567 :
568 : TYPE(section_type), INTENT(INOUT) :: section
569 : TYPE(section_type), INTENT(IN), POINTER :: subsection
570 :
571 : INTEGER :: i
572 72396930 : TYPE(section_p_type), DIMENSION(:), POINTER :: new_subsections
573 :
574 0 : CPASSERT(section%ref_count > 0)
575 72396930 : CPASSERT(ASSOCIATED(subsection))
576 72396930 : CPASSERT(subsection%ref_count > 0)
577 72396930 : IF (SIZE(section%subsections) < section%n_subsections + 1) THEN
578 1780510273 : ALLOCATE (new_subsections(section%n_subsections + 10))
579 1597011001 : DO i = 1, section%n_subsections
580 1597011001 : new_subsections(i)%section => section%subsections(i)%section
581 : END DO
582 168207666 : DO i = section%n_subsections + 1, SIZE(new_subsections)
583 168207666 : NULLIFY (new_subsections(i)%section)
584 : END DO
585 15291606 : DEALLOCATE (section%subsections)
586 15291606 : section%subsections => new_subsections
587 : END IF
588 16102393808 : DO i = 1, section%n_subsections
589 16029996878 : IF (subsection%name == section%subsections(i)%section%name) &
590 : CALL cp_abort(__LOCATION__, &
591 : "trying to add a subsection with a name ("// &
592 : TRIM(subsection%name)//") that was already used in section " &
593 72396930 : //TRIM(section%name))
594 : END DO
595 72396930 : CALL section_retain(subsection)
596 72396930 : section%n_subsections = section%n_subsections + 1
597 72396930 : section%subsections(section%n_subsections)%section => subsection
598 :
599 72396930 : END SUBROUTINE section_add_subsection
600 :
601 : ! **************************************************************************************************
602 : !> \brief creates a object where to store the values of a section
603 : !> \param section_vals the parsed section that will be created
604 : !> \param section the structure of the section that you want to parse
605 : !> \author fawzi
606 : ! **************************************************************************************************
607 83098302 : RECURSIVE SUBROUTINE section_vals_create(section_vals, section)
608 :
609 : TYPE(section_vals_type), POINTER :: section_vals
610 : TYPE(section_type), POINTER :: section
611 :
612 : INTEGER :: i
613 :
614 83098302 : CPASSERT(.NOT. ASSOCIATED(section_vals))
615 83098302 : ALLOCATE (section_vals)
616 83098302 : section_vals%ref_count = 1
617 83098302 : CALL section_retain(section)
618 83098302 : section_vals%section => section
619 83098302 : section%frozen = .TRUE.
620 166196604 : ALLOCATE (section_vals%values(-1:section%n_keywords, 0))
621 344929851 : ALLOCATE (section_vals%subs_vals(section%n_subsections, 1))
622 166129452 : DO i = 1, section%n_subsections
623 83031150 : NULLIFY (section_vals%subs_vals(i, 1)%section_vals)
624 : CALL section_vals_create(section_vals%subs_vals(i, 1)%section_vals, &
625 166129452 : section=section%subsections(i)%section)
626 : END DO
627 :
628 83098302 : NULLIFY (section_vals%ibackup)
629 :
630 83098302 : END SUBROUTINE section_vals_create
631 :
632 : ! **************************************************************************************************
633 : !> \brief retains the given section values (see doc/ReferenceCounting.html)
634 : !> \param section_vals the object to retain
635 : !> \author fawzi
636 : ! **************************************************************************************************
637 74847 : SUBROUTINE section_vals_retain(section_vals)
638 :
639 : TYPE(section_vals_type), POINTER :: section_vals
640 :
641 74847 : CPASSERT(ASSOCIATED(section_vals))
642 74847 : CPASSERT(section_vals%ref_count > 0)
643 74847 : section_vals%ref_count = section_vals%ref_count + 1
644 :
645 74847 : END SUBROUTINE section_vals_retain
646 :
647 : ! **************************************************************************************************
648 : !> \brief releases the given object
649 : !> \param section_vals the section_vals to release
650 : !> \author fawzi
651 : ! **************************************************************************************************
652 83186865 : RECURSIVE SUBROUTINE section_vals_release(section_vals)
653 :
654 : TYPE(section_vals_type), POINTER :: section_vals
655 :
656 : INTEGER :: i, j
657 : TYPE(cp_sll_val_type), POINTER :: vals
658 : TYPE(val_type), POINTER :: el
659 :
660 83186865 : IF (ASSOCIATED(section_vals)) THEN
661 83173149 : CPASSERT(section_vals%ref_count > 0)
662 83173149 : section_vals%ref_count = section_vals%ref_count - 1
663 83173149 : IF (section_vals%ref_count == 0) THEN
664 83098302 : CALL section_release(section_vals%section)
665 83361830 : DO j = 1, SIZE(section_vals%values, 2)
666 86778773 : DO i = -1, UBOUND(section_vals%values, 1)
667 3153415 : vals => section_vals%values(i, j)%list
668 4001665 : DO WHILE (cp_sll_val_next(vals, el_att=el))
669 848250 : CALL val_release(el)
670 : END DO
671 3416943 : CALL cp_sll_val_dealloc(section_vals%values(i, j)%list)
672 : END DO
673 : END DO
674 83098302 : DEALLOCATE (section_vals%values)
675 166219044 : DO j = 1, SIZE(section_vals%subs_vals, 2)
676 249306182 : DO i = 1, SIZE(section_vals%subs_vals, 1)
677 166207880 : CALL section_vals_release(section_vals%subs_vals(i, j)%section_vals)
678 : END DO
679 : END DO
680 83098302 : DEALLOCATE (section_vals%subs_vals)
681 83098302 : IF (ASSOCIATED(section_vals%ibackup)) THEN
682 3746 : DEALLOCATE (section_vals%ibackup)
683 : END IF
684 83098302 : DEALLOCATE (section_vals)
685 : END IF
686 : END IF
687 :
688 83186865 : END SUBROUTINE section_vals_release
689 :
690 : ! **************************************************************************************************
691 : !> \brief returns various attributes about the section_vals
692 : !> \param section_vals the section vals you want information from
693 : !> \param ref_count ...
694 : !> \param n_repetition number of repetitions of the section
695 : !> \param n_subs_vals_rep number of repetitions of the subsections values
696 : !> (max(1,n_repetition))
697 : !> \param section ...
698 : !> \param explicit if the section was explicitly present in
699 : !> \author fawzi
700 : !> \note For the other arguments see the attributes of section_vals_type
701 : ! **************************************************************************************************
702 4244348 : SUBROUTINE section_vals_get(section_vals, ref_count, n_repetition, &
703 : n_subs_vals_rep, section, explicit)
704 :
705 : TYPE(section_vals_type), INTENT(IN) :: section_vals
706 : INTEGER, INTENT(out), OPTIONAL :: ref_count, n_repetition, n_subs_vals_rep
707 : TYPE(section_type), OPTIONAL, POINTER :: section
708 : LOGICAL, INTENT(out), OPTIONAL :: explicit
709 :
710 4244348 : CPASSERT(section_vals%ref_count > 0)
711 4244348 : IF (PRESENT(ref_count)) ref_count = section_vals%ref_count
712 4244348 : IF (PRESENT(section)) section => section_vals%section
713 4244348 : IF (PRESENT(n_repetition)) n_repetition = SIZE(section_vals%values, 2)
714 4244348 : IF (PRESENT(n_subs_vals_rep)) n_subs_vals_rep = SIZE(section_vals%subs_vals, 2)
715 4244348 : IF (PRESENT(explicit)) explicit = (SIZE(section_vals%values, 2) > 0)
716 :
717 4244348 : END SUBROUTINE section_vals_get
718 :
719 : ! **************************************************************************************************
720 : !> \brief returns the values of the requested subsection
721 : !> \param section_vals the root section
722 : !> \param subsection_name the name of the requested subsection
723 : !> \param i_rep_section index of the repetition of section_vals from which
724 : !> you want to extract the subsection (defaults to 1)
725 : !> \param can_return_null if the results can be null (defaults to false)
726 : !> \return ...
727 : !> \author fawzi
728 : ! **************************************************************************************************
729 35256947 : RECURSIVE FUNCTION section_vals_get_subs_vals(section_vals, subsection_name, &
730 : i_rep_section, can_return_null) RESULT(res)
731 :
732 : TYPE(section_vals_type), INTENT(IN) :: section_vals
733 : CHARACTER(len=*), INTENT(IN) :: subsection_name
734 : INTEGER, INTENT(IN), OPTIONAL :: i_rep_section
735 : LOGICAL, INTENT(IN), OPTIONAL :: can_return_null
736 : TYPE(section_vals_type), POINTER :: res
737 :
738 : INTEGER :: irep, isection, my_index
739 : LOGICAL :: is_path, my_can_return_null
740 :
741 35256947 : CPASSERT(section_vals%ref_count > 0)
742 :
743 35256947 : my_can_return_null = .FALSE.
744 35256947 : IF (PRESENT(can_return_null)) my_can_return_null = can_return_null
745 35256947 : NULLIFY (res)
746 35256947 : irep = 1
747 35256947 : IF (PRESENT(i_rep_section)) irep = i_rep_section
748 :
749 : ! prepare for recursive parsing of subsections. i_rep_section will be used for last section
750 35256947 : my_index = INDEX(subsection_name, "%")
751 35256947 : IF (my_index .EQ. 0) THEN
752 20630752 : is_path = .FALSE.
753 20630752 : my_index = LEN_TRIM(subsection_name)
754 : ELSE
755 14626195 : is_path = .TRUE.
756 14626195 : irep = 1
757 14626195 : my_index = my_index - 1
758 : END IF
759 :
760 35256947 : CPASSERT(irep <= SIZE(section_vals%subs_vals, 2))
761 :
762 35256947 : isection = section_get_subsection_index(section_vals%section, subsection_name(1:my_index))
763 35256947 : IF (isection > 0) res => section_vals%subs_vals(isection, irep)%section_vals
764 35256947 : IF (.NOT. (ASSOCIATED(res) .OR. my_can_return_null)) &
765 : CALL cp_abort(__LOCATION__, &
766 : "could not find subsection "//TRIM(subsection_name(1:my_index))//" in section "// &
767 0 : TRIM(section_vals%section%name)//" at ")
768 35256947 : IF (is_path .AND. ASSOCIATED(res)) THEN
769 : res => section_vals_get_subs_vals(res, subsection_name(my_index + 2:LEN_TRIM(subsection_name)), &
770 14626195 : i_rep_section, can_return_null)
771 : END IF
772 :
773 35256947 : END FUNCTION section_vals_get_subs_vals
774 :
775 : ! **************************************************************************************************
776 : !> \brief returns the values of the n-th non default subsection (null if no
777 : !> such section exists (not so many non default section))
778 : !> \param section_vals the root section
779 : !> \param i_section index of the section
780 : !> \param i_rep_section index of the repetition of section_vals from which
781 : !> you want to extract the subsection (defaults to 1)
782 : !> \return ...
783 : !> \author fawzi
784 : ! **************************************************************************************************
785 942145 : FUNCTION section_vals_get_subs_vals2(section_vals, i_section, i_rep_section) RESULT(res)
786 :
787 : TYPE(section_vals_type), POINTER :: section_vals
788 : INTEGER, INTENT(in) :: i_section
789 : INTEGER, INTENT(in), OPTIONAL :: i_rep_section
790 : TYPE(section_vals_type), POINTER :: res
791 :
792 : INTEGER :: i, irep, isect_att
793 :
794 942145 : CPASSERT(ASSOCIATED(section_vals))
795 942145 : CPASSERT(section_vals%ref_count > 0)
796 942145 : NULLIFY (res)
797 942145 : irep = 1
798 942145 : IF (PRESENT(i_rep_section)) irep = i_rep_section
799 942145 : CPASSERT(irep <= SIZE(section_vals%subs_vals, 2))
800 942145 : isect_att = 0
801 485616420 : DO i = 1, section_vals%section%n_subsections
802 485616420 : IF (SIZE(section_vals%subs_vals(i, irep)%section_vals%values, 2) > 0) THEN
803 1025713 : isect_att = isect_att + 1
804 1025713 : IF (isect_att == i_section) THEN
805 : res => section_vals%subs_vals(i, irep)%section_vals
806 : EXIT
807 : END IF
808 : END IF
809 : END DO
810 942145 : END FUNCTION section_vals_get_subs_vals2
811 :
812 : ! **************************************************************************************************
813 : !> \brief returns the values of the n-th non default subsection (null if no
814 : !> such section exists (not so many non default section))
815 : !> \param section_vals the root section
816 : !> \param subsection_name ...
817 : !> \param i_rep_section index of the repetition of section_vals from which
818 : !> you want to extract the subsection (defaults to 1)
819 : !> \return ...
820 : !> \author fawzi
821 : ! **************************************************************************************************
822 71624 : FUNCTION section_vals_get_subs_vals3(section_vals, subsection_name, &
823 : i_rep_section) RESULT(res)
824 :
825 : TYPE(section_vals_type), INTENT(IN) :: section_vals
826 : CHARACTER(LEN=*), INTENT(IN) :: subsection_name
827 : INTEGER, INTENT(in), OPTIONAL :: i_rep_section
828 : TYPE(section_vals_type), POINTER :: res
829 :
830 : INTEGER :: i_section, irep
831 :
832 71624 : CPASSERT(section_vals%ref_count > 0)
833 71624 : NULLIFY (res)
834 71624 : irep = 1
835 71624 : IF (PRESENT(i_rep_section)) irep = i_rep_section
836 71624 : CPASSERT(irep <= SIZE(section_vals%subs_vals, 2))
837 71624 : i_section = section_get_subsection_index(section_vals%section, subsection_name)
838 71624 : res => section_vals%subs_vals(i_section, irep)%section_vals
839 :
840 71624 : END FUNCTION section_vals_get_subs_vals3
841 :
842 : ! **************************************************************************************************
843 : !> \brief adds the place to store the values of a repetition of the section
844 : !> \param section_vals the section you want to extend
845 : !> \author fawzi
846 : ! **************************************************************************************************
847 273250 : SUBROUTINE section_vals_add_values(section_vals)
848 :
849 : TYPE(section_vals_type), INTENT(INOUT) :: section_vals
850 :
851 : INTEGER :: i, j
852 273250 : TYPE(cp_sll_val_p_type), DIMENSION(:, :), POINTER :: new_values
853 : TYPE(section_vals_p_type), DIMENSION(:, :), &
854 273250 : POINTER :: new_sps
855 :
856 0 : CPASSERT(section_vals%ref_count > 0)
857 5472559 : ALLOCATE (new_values(-1:UBOUND(section_vals%values, 1), SIZE(section_vals%values, 2) + 1))
858 330602 : DO j = 1, SIZE(section_vals%values, 2)
859 1205313 : DO i = -1, UBOUND(section_vals%values, 1)
860 874711 : new_values(i, j)%list => section_vals%values(i, j)%list
861 : END DO
862 : END DO
863 273250 : DEALLOCATE (section_vals%values)
864 273250 : section_vals%values => new_values
865 273250 : j = SIZE(new_values, 2)
866 3778098 : DO i = -1, UBOUND(new_values, 1)
867 3504848 : NULLIFY (new_values(i, j)%list)
868 : END DO
869 :
870 273250 : IF (SIZE(new_values, 2) > 1) THEN
871 : ALLOCATE (new_sps(SIZE(section_vals%subs_vals, 1), &
872 335974 : SIZE(section_vals%subs_vals, 2) + 1))
873 79792 : DO j = 1, SIZE(section_vals%subs_vals, 2)
874 203832 : DO i = 1, SIZE(section_vals%subs_vals, 1)
875 181392 : new_sps(i, j)%section_vals => section_vals%subs_vals(i, j)%section_vals
876 : END DO
877 : END DO
878 22440 : DEALLOCATE (section_vals%subs_vals)
879 22440 : section_vals%subs_vals => new_sps
880 22440 : j = SIZE(new_sps, 2)
881 78428 : DO i = 1, SIZE(new_sps, 1)
882 55988 : NULLIFY (new_sps(i, j)%section_vals)
883 : CALL section_vals_create(new_sps(i, SIZE(new_sps, 2))%section_vals, &
884 78428 : section=section_vals%section%subsections(i)%section)
885 : END DO
886 : END IF
887 :
888 273250 : END SUBROUTINE section_vals_add_values
889 :
890 : ! **************************************************************************************************
891 : !> \brief removes the values of a repetition of the section
892 : !> \param section_vals the section you want to extend
893 : !> \author fawzi
894 : ! **************************************************************************************************
895 68755 : SUBROUTINE section_vals_remove_values(section_vals)
896 :
897 : TYPE(section_vals_type), POINTER :: section_vals
898 :
899 : INTEGER :: i, j
900 68755 : TYPE(cp_sll_val_p_type), DIMENSION(:, :), POINTER :: new_values
901 : TYPE(cp_sll_val_type), POINTER :: vals
902 : TYPE(val_type), POINTER :: el
903 :
904 68755 : IF (ASSOCIATED(section_vals)) THEN
905 68755 : CPASSERT(section_vals%ref_count > 0)
906 68755 : NULLIFY (el, vals)
907 : ! Allocate a null 0 dimension array of values
908 206265 : ALLOCATE (new_values(-1:section_vals%section%n_keywords, 0))
909 : ! Release old values
910 78477 : DO j = 1, SIZE(section_vals%values, 2)
911 166382 : DO i = -1, UBOUND(section_vals%values, 1)
912 78183 : vals => section_vals%values(i, j)%list
913 667976 : DO WHILE (cp_sll_val_next(vals, el_att=el))
914 589793 : CALL val_release(el)
915 : END DO
916 87905 : CALL cp_sll_val_dealloc(section_vals%values(i, j)%list)
917 : END DO
918 : END DO
919 68755 : DEALLOCATE (section_vals%values)
920 68755 : section_vals%values => new_values
921 : END IF
922 :
923 68755 : END SUBROUTINE section_vals_remove_values
924 :
925 : ! **************************************************************************************************
926 : !> \brief ...
927 : !> \param section_vals ...
928 : !> \param keyword_name ...
929 : !> \return ...
930 : ! **************************************************************************************************
931 0 : FUNCTION section_get_cval(section_vals, keyword_name) RESULT(res)
932 :
933 : TYPE(section_vals_type), INTENT(IN) :: section_vals
934 : CHARACTER(len=*), INTENT(in) :: keyword_name
935 : CHARACTER(LEN=default_string_length) :: res
936 :
937 0 : CALL section_vals_val_get(section_vals, keyword_name, c_val=res)
938 :
939 0 : END FUNCTION section_get_cval
940 :
941 : ! **************************************************************************************************
942 : !> \brief ...
943 : !> \param section_vals ...
944 : !> \param keyword_name ...
945 : !> \return ...
946 : ! **************************************************************************************************
947 447442 : FUNCTION section_get_rval(section_vals, keyword_name) RESULT(res)
948 :
949 : TYPE(section_vals_type), INTENT(IN) :: section_vals
950 : CHARACTER(len=*), INTENT(in) :: keyword_name
951 : REAL(kind=dp) :: res
952 :
953 447442 : CALL section_vals_val_get(section_vals, keyword_name, r_val=res)
954 :
955 447442 : END FUNCTION section_get_rval
956 :
957 : ! **************************************************************************************************
958 : !> \brief ...
959 : !> \param section_vals ...
960 : !> \param keyword_name ...
961 : !> \return ...
962 : ! **************************************************************************************************
963 0 : FUNCTION section_get_rvals(section_vals, keyword_name) RESULT(res)
964 :
965 : TYPE(section_vals_type), INTENT(IN) :: section_vals
966 : CHARACTER(len=*), INTENT(in) :: keyword_name
967 : REAL(kind=dp), DIMENSION(:), POINTER :: res
968 :
969 0 : CALL section_vals_val_get(section_vals, keyword_name, r_vals=res)
970 :
971 0 : END FUNCTION section_get_rvals
972 :
973 : ! **************************************************************************************************
974 : !> \brief ...
975 : !> \param section_vals ...
976 : !> \param keyword_name ...
977 : !> \return ...
978 : ! **************************************************************************************************
979 374300 : FUNCTION section_get_ival(section_vals, keyword_name) RESULT(res)
980 :
981 : TYPE(section_vals_type), INTENT(IN) :: section_vals
982 : CHARACTER(len=*), INTENT(in) :: keyword_name
983 : INTEGER :: res
984 :
985 374300 : CALL section_vals_val_get(section_vals, keyword_name, i_val=res)
986 :
987 374300 : END FUNCTION section_get_ival
988 :
989 : ! **************************************************************************************************
990 : !> \brief ...
991 : !> \param section_vals ...
992 : !> \param keyword_name ...
993 : !> \return ...
994 : ! **************************************************************************************************
995 3586 : FUNCTION section_get_ivals(section_vals, keyword_name) RESULT(res)
996 :
997 : TYPE(section_vals_type), INTENT(IN) :: section_vals
998 : CHARACTER(len=*), INTENT(in) :: keyword_name
999 : INTEGER, DIMENSION(:), POINTER :: res
1000 :
1001 3586 : CALL section_vals_val_get(section_vals, keyword_name, i_vals=res)
1002 :
1003 3586 : END FUNCTION section_get_ivals
1004 :
1005 : ! **************************************************************************************************
1006 : !> \brief ...
1007 : !> \param section_vals ...
1008 : !> \param keyword_name ...
1009 : !> \return ...
1010 : ! **************************************************************************************************
1011 89455 : FUNCTION section_get_lval(section_vals, keyword_name) RESULT(res)
1012 :
1013 : TYPE(section_vals_type), INTENT(IN) :: section_vals
1014 : CHARACTER(len=*), INTENT(in) :: keyword_name
1015 : LOGICAL :: res
1016 :
1017 89455 : CALL section_vals_val_get(section_vals, keyword_name, l_val=res)
1018 :
1019 89455 : END FUNCTION section_get_lval
1020 :
1021 : ! **************************************************************************************************
1022 : !> \brief returns the requested value
1023 : !> \param section_vals ...
1024 : !> \param keyword_name the name of the keyword you want
1025 : !> \param i_rep_section which repetition of the section you are interested in
1026 : !> (defaults to 1)
1027 : !> \param i_rep_val which repetition of the keyword/val you are interested in
1028 : !> (defaults to 1)
1029 : !> \param n_rep_val returns number of val available
1030 : !> \param val ...
1031 : !> \param l_val ,i_val,r_val,c_val: returns the logical,integer,real or
1032 : !> character value
1033 : !> \param i_val ...
1034 : !> \param r_val ...
1035 : !> \param c_val ...
1036 : !> \param l_vals ,i_vals,r_vals,c_vals: returns the logical,integer,real or
1037 : !> character arrays. The val reamins the owner of the array
1038 : !> \param i_vals ...
1039 : !> \param r_vals ...
1040 : !> \param c_vals ...
1041 : !> \param explicit ...
1042 : !> \author fawzi
1043 : ! **************************************************************************************************
1044 35547768 : SUBROUTINE section_vals_val_get(section_vals, keyword_name, i_rep_section, &
1045 : i_rep_val, n_rep_val, val, l_val, i_val, r_val, c_val, l_vals, i_vals, r_vals, &
1046 : c_vals, explicit)
1047 :
1048 : TYPE(section_vals_type), INTENT(IN), TARGET :: section_vals
1049 : CHARACTER(len=*), INTENT(in) :: keyword_name
1050 : INTEGER, INTENT(in), OPTIONAL :: i_rep_section, i_rep_val
1051 : INTEGER, INTENT(out), OPTIONAL :: n_rep_val
1052 : TYPE(val_type), OPTIONAL, POINTER :: val
1053 : LOGICAL, INTENT(out), OPTIONAL :: l_val
1054 : INTEGER, INTENT(out), OPTIONAL :: i_val
1055 : REAL(KIND=DP), INTENT(out), OPTIONAL :: r_val
1056 : CHARACTER(LEN=*), INTENT(out), OPTIONAL :: c_val
1057 : LOGICAL, DIMENSION(:), OPTIONAL, POINTER :: l_vals
1058 : INTEGER, DIMENSION(:), OPTIONAL, POINTER :: i_vals
1059 : REAL(KIND=DP), DIMENSION(:), OPTIONAL, POINTER :: r_vals
1060 : CHARACTER(LEN=default_string_length), &
1061 : DIMENSION(:), OPTIONAL, POINTER :: c_vals
1062 : LOGICAL, INTENT(out), OPTIONAL :: explicit
1063 :
1064 : INTEGER :: ik, irk, irs, len_key, my_index, &
1065 : tmp_index
1066 : LOGICAL :: valRequested
1067 : TYPE(cp_sll_val_type), POINTER :: vals
1068 : TYPE(keyword_type), POINTER :: keyword
1069 : TYPE(section_type), POINTER :: section
1070 : TYPE(section_vals_type), POINTER :: s_vals
1071 : TYPE(val_type), POINTER :: my_val
1072 :
1073 35547768 : CPASSERT(section_vals%ref_count > 0)
1074 :
1075 35547768 : my_index = INDEX(keyword_name, '%') + 1
1076 35547768 : len_key = LEN_TRIM(keyword_name)
1077 35547768 : IF (my_index > 1) THEN
1078 2665839 : DO
1079 10519948 : tmp_index = INDEX(keyword_name(my_index:len_key), "%")
1080 10519948 : IF (tmp_index <= 0) EXIT
1081 2665839 : my_index = my_index + tmp_index
1082 : END DO
1083 7854109 : s_vals => section_vals_get_subs_vals(section_vals, keyword_name(1:my_index - 2))
1084 : ELSE
1085 : s_vals => section_vals
1086 : END IF
1087 :
1088 35547768 : irk = 1
1089 35547768 : irs = 1
1090 35547768 : IF (PRESENT(i_rep_section)) irs = i_rep_section
1091 35547768 : IF (PRESENT(i_rep_val)) irk = i_rep_val
1092 35547768 : IF (PRESENT(val)) NULLIFY (val)
1093 35547768 : IF (PRESENT(explicit)) explicit = .FALSE.
1094 35547768 : section => s_vals%section
1095 : valRequested = PRESENT(l_val) .OR. PRESENT(i_val) .OR. PRESENT(r_val) .OR. &
1096 : PRESENT(c_val) .OR. PRESENT(l_vals) .OR. PRESENT(i_vals) .OR. &
1097 35547768 : PRESENT(r_vals) .OR. PRESENT(c_vals)
1098 35547768 : ik = section_get_keyword_index(s_vals%section, keyword_name(my_index:len_key))
1099 35547768 : IF (ik == -2) &
1100 : CALL cp_abort(__LOCATION__, &
1101 : "section "//TRIM(section%name)//" does not contain keyword "// &
1102 0 : TRIM(keyword_name(my_index:len_key)))
1103 35547768 : keyword => section%keywords(ik)%keyword
1104 35547768 : IF (.NOT. (irs > 0 .AND. irs <= SIZE(s_vals%subs_vals, 2))) &
1105 : CALL cp_abort(__LOCATION__, &
1106 : "section repetition requested ("//cp_to_string(irs)// &
1107 : ") out of bounds (1:"//cp_to_string(SIZE(s_vals%subs_vals, 2)) &
1108 0 : //")")
1109 35547768 : NULLIFY (my_val)
1110 35547768 : IF (PRESENT(n_rep_val)) n_rep_val = 0
1111 35547768 : IF (irs <= SIZE(s_vals%values, 2)) THEN ! the section was parsed
1112 10107573 : vals => s_vals%values(ik, irs)%list
1113 10107573 : IF (PRESENT(n_rep_val)) n_rep_val = cp_sll_val_get_length(vals)
1114 10107573 : IF (.NOT. ASSOCIATED(vals)) THEN
1115 : ! this keyword was not parsed
1116 6617971 : IF (ASSOCIATED(keyword%default_value)) THEN
1117 6130450 : my_val => keyword%default_value
1118 6130450 : IF (PRESENT(n_rep_val)) n_rep_val = 1
1119 : END IF
1120 : ELSE
1121 : my_val => cp_sll_val_get_el_at(s_vals%values(ik, irs)%list, &
1122 3489602 : irk)
1123 3489602 : IF (PRESENT(explicit)) explicit = .TRUE.
1124 : END IF
1125 25440195 : ELSE IF (ASSOCIATED(keyword%default_value)) THEN
1126 25421021 : IF (PRESENT(n_rep_val)) n_rep_val = 1
1127 25421021 : my_val => keyword%default_value
1128 : END IF
1129 35547768 : IF (PRESENT(val)) val => my_val
1130 35547768 : IF (valRequested) THEN
1131 32843666 : IF (.NOT. ASSOCIATED(my_val)) &
1132 : CALL cp_abort(__LOCATION__, &
1133 : "Value requested, but no value set getting value from "// &
1134 : "keyword "//TRIM(keyword_name(my_index:len_key))//" of section "// &
1135 0 : TRIM(section%name))
1136 : CALL val_get(my_val, l_val=l_val, i_val=i_val, r_val=r_val, &
1137 : c_val=c_val, l_vals=l_vals, i_vals=i_vals, r_vals=r_vals, &
1138 96576774 : c_vals=c_vals)
1139 : END IF
1140 :
1141 35547768 : END SUBROUTINE section_vals_val_get
1142 :
1143 : ! **************************************************************************************************
1144 : !> \brief returns the requested list
1145 : !> \param section_vals ...
1146 : !> \param keyword_name the name of the keyword you want
1147 : !> \param i_rep_section which repetition of the section you are interested in
1148 : !> (defaults to 1)
1149 : !> \param list ...
1150 : !> \author Joost VandeVondele
1151 : !> \note
1152 : !> - most useful if the full list is needed anyway, so that faster iteration can be used
1153 : ! **************************************************************************************************
1154 8463 : SUBROUTINE section_vals_list_get(section_vals, keyword_name, i_rep_section, &
1155 : list)
1156 :
1157 : TYPE(section_vals_type), INTENT(IN), POINTER :: section_vals
1158 : CHARACTER(len=*), INTENT(in) :: keyword_name
1159 : INTEGER, OPTIONAL :: i_rep_section
1160 : TYPE(cp_sll_val_type), POINTER :: list
1161 :
1162 : INTEGER :: ik, irs, len_key, my_index, tmp_index
1163 : TYPE(section_type), POINTER :: section
1164 : TYPE(section_vals_type), POINTER :: s_vals
1165 :
1166 8463 : CPASSERT(ASSOCIATED(section_vals))
1167 8463 : CPASSERT(section_vals%ref_count > 0)
1168 8463 : NULLIFY (list)
1169 8463 : my_index = INDEX(keyword_name, '%') + 1
1170 8463 : len_key = LEN_TRIM(keyword_name)
1171 8463 : IF (my_index > 1) THEN
1172 0 : DO
1173 0 : tmp_index = INDEX(keyword_name(my_index:len_key), "%")
1174 0 : IF (tmp_index <= 0) EXIT
1175 0 : my_index = my_index + tmp_index
1176 : END DO
1177 0 : s_vals => section_vals_get_subs_vals(section_vals, keyword_name(1:my_index - 2))
1178 : ELSE
1179 8463 : s_vals => section_vals
1180 : END IF
1181 :
1182 8463 : irs = 1
1183 8463 : IF (PRESENT(i_rep_section)) irs = i_rep_section
1184 8463 : section => s_vals%section
1185 8463 : ik = section_get_keyword_index(s_vals%section, keyword_name(my_index:len_key))
1186 8463 : IF (ik == -2) &
1187 : CALL cp_abort(__LOCATION__, &
1188 : "section "//TRIM(section%name)//" does not contain keyword "// &
1189 0 : TRIM(keyword_name(my_index:len_key)))
1190 8463 : IF (.NOT. (irs > 0 .AND. irs <= SIZE(s_vals%subs_vals, 2))) &
1191 : CALL cp_abort(__LOCATION__, &
1192 : "section repetition requested ("//cp_to_string(irs)// &
1193 : ") out of bounds (1:"//cp_to_string(SIZE(s_vals%subs_vals, 2)) &
1194 0 : //")")
1195 8463 : list => s_vals%values(ik, irs)%list
1196 :
1197 8463 : END SUBROUTINE section_vals_list_get
1198 :
1199 : ! **************************************************************************************************
1200 : !> \brief sets the requested value
1201 : !> \param section_vals ...
1202 : !> \param keyword_name the name of the keyword you want (can be a path
1203 : !> separated by '%')
1204 : !> \param i_rep_section isection which repetition of the section you are
1205 : !> nterested in (defaults to 1)
1206 : !> \param i_rep_val which repetition of the keyword/val you are interested in
1207 : !> (defaults to 1)
1208 : !> \param val ...
1209 : !> \param l_val ,i_val,r_val,c_val: sets the logical,integer,real or
1210 : !> character value
1211 : !> \param i_val ...
1212 : !> \param r_val ...
1213 : !> \param c_val ...
1214 : !> \param l_vals_ptr ,i_vals_ptr,r_vals,c_vals: sets the logical,integer,real or
1215 : !> character arrays. The val becomes the owner of the array
1216 : !> \param i_vals_ptr ...
1217 : !> \param r_vals_ptr ...
1218 : !> \param c_vals_ptr ...
1219 : !> \author fawzi
1220 : ! **************************************************************************************************
1221 358032 : SUBROUTINE section_vals_val_set(section_vals, keyword_name, i_rep_section, i_rep_val, &
1222 : val, l_val, i_val, r_val, c_val, l_vals_ptr, i_vals_ptr, r_vals_ptr, c_vals_ptr)
1223 :
1224 : TYPE(section_vals_type), POINTER :: section_vals
1225 : CHARACTER(len=*), INTENT(in) :: keyword_name
1226 : INTEGER, INTENT(in), OPTIONAL :: i_rep_section, i_rep_val
1227 : TYPE(val_type), OPTIONAL, POINTER :: val
1228 : LOGICAL, INTENT(in), OPTIONAL :: l_val
1229 : INTEGER, INTENT(in), OPTIONAL :: i_val
1230 : REAL(KIND=DP), INTENT(in), OPTIONAL :: r_val
1231 : CHARACTER(LEN=*), INTENT(in), OPTIONAL :: c_val
1232 : LOGICAL, DIMENSION(:), OPTIONAL, POINTER :: l_vals_ptr
1233 : INTEGER, DIMENSION(:), OPTIONAL, POINTER :: i_vals_ptr
1234 : REAL(KIND=DP), DIMENSION(:), OPTIONAL, POINTER :: r_vals_ptr
1235 : CHARACTER(LEN=default_string_length), &
1236 : DIMENSION(:), OPTIONAL, POINTER :: c_vals_ptr
1237 :
1238 : INTEGER :: ik, irk, irs, len_key, my_index, &
1239 : tmp_index
1240 : LOGICAL :: valSet
1241 : TYPE(cp_sll_val_type), POINTER :: vals
1242 : TYPE(keyword_type), POINTER :: keyword
1243 : TYPE(section_type), POINTER :: section
1244 : TYPE(section_vals_type), POINTER :: s_vals
1245 : TYPE(val_type), POINTER :: my_val, old_val
1246 :
1247 358032 : CPASSERT(ASSOCIATED(section_vals))
1248 358032 : CPASSERT(section_vals%ref_count > 0)
1249 :
1250 358032 : my_index = INDEX(keyword_name, '%') + 1
1251 358032 : len_key = LEN_TRIM(keyword_name)
1252 358032 : IF (my_index > 1) THEN
1253 8126 : DO
1254 85547 : tmp_index = INDEX(keyword_name(my_index:len_key), "%")
1255 85547 : IF (tmp_index <= 0) EXIT
1256 8126 : my_index = my_index + tmp_index
1257 : END DO
1258 77421 : s_vals => section_vals_get_subs_vals(section_vals, keyword_name(1:my_index - 2))
1259 : ELSE
1260 280611 : s_vals => section_vals
1261 : END IF
1262 :
1263 358032 : irk = 1
1264 358032 : irs = 1
1265 358032 : IF (PRESENT(i_rep_section)) irs = i_rep_section
1266 358032 : IF (PRESENT(i_rep_val)) irk = i_rep_val
1267 358032 : section => s_vals%section
1268 358032 : ik = section_get_keyword_index(s_vals%section, keyword_name(my_index:len_key))
1269 358032 : IF (ik == -2) &
1270 : CALL cp_abort(__LOCATION__, &
1271 : "section "//TRIM(section%name)//" does not contain keyword "// &
1272 0 : TRIM(keyword_name(my_index:len_key)))
1273 : ! Add values..
1274 25787 : DO
1275 383819 : IF (irs <= SIZE(s_vals%values, 2)) EXIT
1276 25787 : CALL section_vals_add_values(s_vals)
1277 : END DO
1278 358032 : IF (.NOT. (irs > 0 .AND. irs <= SIZE(s_vals%subs_vals, 2))) &
1279 : CALL cp_abort(__LOCATION__, &
1280 : "section repetition requested ("//cp_to_string(irs)// &
1281 : ") out of bounds (1:"//cp_to_string(SIZE(s_vals%subs_vals, 2)) &
1282 0 : //")")
1283 358032 : keyword => s_vals%section%keywords(ik)%keyword
1284 358032 : NULLIFY (my_val)
1285 358032 : IF (PRESENT(val)) my_val => val
1286 : valSet = PRESENT(l_val) .OR. PRESENT(i_val) .OR. PRESENT(r_val) .OR. &
1287 : PRESENT(c_val) .OR. PRESENT(l_vals_ptr) .OR. PRESENT(i_vals_ptr) .OR. &
1288 358032 : PRESENT(r_vals_ptr) .OR. PRESENT(c_vals_ptr)
1289 358032 : IF (ASSOCIATED(my_val)) THEN
1290 : ! check better?
1291 0 : IF (valSet) &
1292 : CALL cp_abort(__LOCATION__, &
1293 : " both val and values present, in setting "// &
1294 : "keyword "//TRIM(keyword_name(my_index:len_key))//" of section "// &
1295 0 : TRIM(section%name))
1296 : ELSE
1297 : ! ignore ?
1298 358032 : IF (.NOT. valSet) &
1299 : CALL cp_abort(__LOCATION__, &
1300 : " empty value in setting "// &
1301 : "keyword "//TRIM(keyword_name(my_index:len_key))//" of section "// &
1302 0 : TRIM(section%name))
1303 0 : CPASSERT(valSet)
1304 358032 : IF (keyword%type_of_var == lchar_t) THEN
1305 107336 : CALL val_create(my_val, lc_val=c_val, lc_vals_ptr=c_vals_ptr)
1306 : ELSE
1307 : CALL val_create(my_val, l_val=l_val, i_val=i_val, r_val=r_val, &
1308 : c_val=c_val, l_vals_ptr=l_vals_ptr, i_vals_ptr=i_vals_ptr, &
1309 : r_vals_ptr=r_vals_ptr, &
1310 907730 : c_vals_ptr=c_vals_ptr, enum=keyword%enum)
1311 : END IF
1312 358032 : CPASSERT(ASSOCIATED(my_val))
1313 358032 : CPASSERT(my_val%type_of_var == keyword%type_of_var)
1314 : END IF
1315 358032 : vals => s_vals%values(ik, irs)%list
1316 358032 : IF (irk == -1) THEN
1317 0 : CALL cp_sll_val_insert_el_at(vals, my_val, index=-1)
1318 358032 : ELSE IF (irk <= cp_sll_val_get_length(vals)) THEN
1319 212935 : IF (irk <= 0) &
1320 : CALL cp_abort(__LOCATION__, &
1321 : "invalid irk "//TRIM(ADJUSTL(cp_to_string(irk)))// &
1322 : " in keyword "//TRIM(keyword_name(my_index:len_key))//" of section "// &
1323 0 : TRIM(section%name))
1324 212935 : old_val => cp_sll_val_get_el_at(vals, index=irk)
1325 212935 : CALL val_release(old_val)
1326 212935 : CALL cp_sll_val_set_el_at(vals, value=my_val, index=irk)
1327 145097 : ELSE IF (irk > cp_sll_val_get_length(vals) + 1) THEN
1328 : ! change?
1329 : CALL cp_abort(__LOCATION__, &
1330 : "cannot add extra keyword repetitions to keyword" &
1331 : //TRIM(keyword_name(my_index:len_key))//" of section "// &
1332 0 : TRIM(section%name))
1333 : ELSE
1334 145097 : CALL cp_sll_val_insert_el_at(vals, my_val, index=irk)
1335 : END IF
1336 358032 : s_vals%values(ik, irs)%list => vals
1337 : NULLIFY (my_val)
1338 358032 : END SUBROUTINE section_vals_val_set
1339 :
1340 : ! **************************************************************************************************
1341 : !> \brief unsets (removes) the requested value (if it is a keyword repetitions
1342 : !> removes the repetition, so be careful: the repetition indices bigger
1343 : !> than the actual change.
1344 : !> \param section_vals ...
1345 : !> \param keyword_name the name of the keyword you want (can be a path
1346 : !> separated by '%')
1347 : !> \param i_rep_section which repetition of the section you are interested in
1348 : !> (defaults to 1)
1349 : !> \param i_rep_val which repetition of the keyword/val you are interested in
1350 : !> (defaults to 1)
1351 : !> \author fawzi
1352 : ! **************************************************************************************************
1353 37912 : SUBROUTINE section_vals_val_unset(section_vals, keyword_name, i_rep_section, i_rep_val)
1354 :
1355 : TYPE(section_vals_type), POINTER :: section_vals
1356 : CHARACTER(len=*), INTENT(in) :: keyword_name
1357 : INTEGER, INTENT(in), OPTIONAL :: i_rep_section, i_rep_val
1358 :
1359 : INTEGER :: ik, irk, irs, len_key, my_index, &
1360 : tmp_index
1361 : TYPE(cp_sll_val_type), POINTER :: pos
1362 : TYPE(section_type), POINTER :: section
1363 : TYPE(section_vals_type), POINTER :: s_vals
1364 : TYPE(val_type), POINTER :: old_val
1365 :
1366 37912 : NULLIFY (pos)
1367 37912 : CPASSERT(ASSOCIATED(section_vals))
1368 37912 : CPASSERT(section_vals%ref_count > 0)
1369 :
1370 37912 : my_index = INDEX(keyword_name, '%') + 1
1371 37912 : len_key = LEN_TRIM(keyword_name)
1372 37912 : IF (my_index > 1) THEN
1373 316 : DO
1374 688 : tmp_index = INDEX(keyword_name(my_index:len_key), "%")
1375 688 : IF (tmp_index <= 0) EXIT
1376 316 : my_index = my_index + tmp_index
1377 : END DO
1378 372 : s_vals => section_vals_get_subs_vals(section_vals, keyword_name(1:my_index - 2))
1379 : ELSE
1380 37540 : s_vals => section_vals
1381 : END IF
1382 :
1383 37912 : irk = 1
1384 37912 : irs = 1
1385 37912 : IF (PRESENT(i_rep_section)) irs = i_rep_section
1386 37912 : IF (PRESENT(i_rep_val)) irk = i_rep_val
1387 37912 : section => s_vals%section
1388 37912 : ik = section_get_keyword_index(s_vals%section, keyword_name(my_index:len_key))
1389 37912 : IF (ik == -2) &
1390 : CALL cp_abort(__LOCATION__, &
1391 : "section "//TRIM(section%name)//" does not contain keyword "// &
1392 0 : TRIM(keyword_name(my_index:len_key)))
1393 : ! ignore unset of non set values
1394 37912 : IF (irs <= SIZE(s_vals%values, 2)) THEN
1395 37912 : IF (.NOT. (irs > 0 .AND. irs <= SIZE(s_vals%subs_vals, 2))) &
1396 : CALL cp_abort(__LOCATION__, &
1397 : "section repetition requested ("//cp_to_string(irs)// &
1398 : ") out of bounds (1:"//cp_to_string(SIZE(s_vals%subs_vals, 2)) &
1399 0 : //")")
1400 37912 : IF (irk == -1) THEN
1401 0 : pos => cp_sll_val_get_rest(s_vals%values(ik, irs)%list, iter=-1)
1402 : ELSE
1403 37912 : pos => cp_sll_val_get_rest(s_vals%values(ik, irs)%list, iter=irk - 1)
1404 : END IF
1405 37912 : IF (ASSOCIATED(pos)) THEN
1406 7360 : old_val => cp_sll_val_get_el_at(s_vals%values(ik, irs)%list, index=irk)
1407 7360 : CALL val_release(old_val)
1408 7360 : CALL cp_sll_val_rm_el_at(s_vals%values(ik, irs)%list, index=irk)
1409 : END IF
1410 : END IF
1411 :
1412 37912 : END SUBROUTINE section_vals_val_unset
1413 :
1414 : ! **************************************************************************************************
1415 : !> \brief writes the values in the given section in a way that is suitable to
1416 : !> the automatic parsing
1417 : !> \param section_vals the section to write out
1418 : !> \param unit_nr the unit where to write to
1419 : !> \param hide_root ...
1420 : !> \param hide_defaults ...
1421 : !> \author fawzi
1422 : !> \note
1423 : !> skips required sections which weren't read
1424 : ! **************************************************************************************************
1425 2350941 : RECURSIVE SUBROUTINE section_vals_write(section_vals, unit_nr, hide_root, hide_defaults)
1426 :
1427 : TYPE(section_vals_type), INTENT(IN) :: section_vals
1428 : INTEGER, INTENT(in) :: unit_nr
1429 : LOGICAL, INTENT(in), OPTIONAL :: hide_root, hide_defaults
1430 :
1431 : INTEGER, PARAMETER :: incr = 2
1432 :
1433 : CHARACTER(len=default_string_length) :: myfmt
1434 : INTEGER :: i_rep_s, ik, isec, ival, nr, nval
1435 : INTEGER, SAVE :: indent = 1
1436 : LOGICAL :: defaultSection, explicit, &
1437 : my_hide_defaults, my_hide_root
1438 : TYPE(cp_sll_val_type), POINTER :: new_pos, vals
1439 : TYPE(keyword_type), POINTER :: keyword
1440 : TYPE(section_type), POINTER :: section
1441 : TYPE(section_vals_type), POINTER :: sval
1442 : TYPE(val_type), POINTER :: val
1443 :
1444 2350941 : my_hide_root = .FALSE.
1445 2350941 : my_hide_defaults = .TRUE.
1446 2350941 : IF (PRESENT(hide_root)) my_hide_root = hide_root
1447 2350941 : IF (PRESENT(hide_defaults)) my_hide_defaults = hide_defaults
1448 :
1449 2350941 : CPASSERT(section_vals%ref_count > 0)
1450 2350941 : IF (unit_nr > 0) THEN
1451 2350926 : CALL section_vals_get(section_vals, explicit=explicit, n_repetition=nr, section=section)
1452 2350926 : IF (explicit .OR. (.NOT. my_hide_defaults)) THEN
1453 576825 : DO i_rep_s = 1, nr
1454 292665 : IF (.NOT. my_hide_root) THEN
1455 284169 : WRITE (UNIT=myfmt, FMT="(I0,A1)") indent, "X"
1456 284169 : IF (ASSOCIATED(section%keywords(-1)%keyword)) THEN
1457 : WRITE (UNIT=unit_nr, FMT="("//TRIM(myfmt)//",A)", ADVANCE="NO") &
1458 58532 : default_section_character//TRIM(ADJUSTL(section%name))
1459 : ELSE
1460 : WRITE (UNIT=unit_nr, FMT="("//TRIM(myfmt)//",A)") &
1461 225637 : default_section_character//TRIM(ADJUSTL(section%name))
1462 : END IF
1463 : END IF
1464 292665 : defaultSection = (SIZE(section_vals%values, 2) == 0)
1465 292665 : IF (.NOT. defaultSection) THEN
1466 292665 : IF (.NOT. my_hide_root) indent = indent + incr
1467 292665 : WRITE (UNIT=myfmt, FMT="(I0,A1)") indent, "X"
1468 3082816 : DO ik = -1, section%n_keywords
1469 2790151 : keyword => section%keywords(ik)%keyword
1470 3082816 : IF (ASSOCIATED(keyword)) THEN
1471 2294171 : IF (keyword%type_of_var /= no_t .AND. keyword%names(1) (1:2) /= "__") THEN
1472 : CALL section_vals_val_get(section_vals, keyword%names(1), &
1473 2233521 : i_rep_s, n_rep_val=nval)
1474 2233521 : IF (i_rep_s <= SIZE(section_vals%values, 2)) THEN
1475 : ! Section was parsed
1476 2233521 : vals => section_vals%values(ik, i_rep_s)%list
1477 5596344 : DO ival = 1, nval
1478 3362823 : IF (ival == 1) THEN
1479 : new_pos => vals
1480 : ELSE
1481 1291988 : new_pos => new_pos%rest
1482 : END IF
1483 3362823 : IF (.NOT. ASSOCIATED(new_pos)) THEN
1484 : ! this keyword was not parsed
1485 1482809 : IF (ASSOCIATED(keyword%default_value)) THEN
1486 1482809 : val => keyword%default_value
1487 1482809 : IF (my_hide_defaults) CYCLE
1488 : END IF
1489 : ELSE
1490 1880014 : val => new_pos%first_el
1491 : END IF
1492 1887272 : IF (keyword%names(1) /= '_DEFAULT_KEYWORD_' .AND. &
1493 : keyword%names(1) /= '_SECTION_PARAMETERS_') THEN
1494 : WRITE (UNIT=unit_nr, FMT="("//TRIM(myfmt)//",A)", ADVANCE="NO") &
1495 507185 : TRIM(keyword%names(1))
1496 1380087 : ELSE IF (keyword%names(1) == '_DEFAULT_KEYWORD_' .AND. &
1497 : keyword%type_of_var /= lchar_t) THEN
1498 450466 : WRITE (UNIT=unit_nr, FMT="("//TRIM(myfmt)//")", ADVANCE="NO")
1499 : END IF
1500 5596344 : CALL val_write(val, unit_nr=unit_nr, unit=keyword%unit, fmt=myfmt)
1501 : END DO
1502 0 : ELSE IF (ASSOCIATED(keyword%default_value)) THEN
1503 : ! Section was not parsed but default for the keywords may exist
1504 0 : IF (my_hide_defaults) CYCLE
1505 0 : val => keyword%default_value
1506 0 : IF (keyword%names(1) /= '_DEFAULT_KEYWORD_' .AND. &
1507 : keyword%names(1) /= '_SECTION_PARAMETERS_') THEN
1508 : WRITE (UNIT=unit_nr, FMT="("//TRIM(myfmt)//",A)", ADVANCE="NO") &
1509 0 : TRIM(keyword%names(1))
1510 0 : ELSE IF (keyword%names(1) == '_DEFAULT_KEYWORD_' .AND. &
1511 : keyword%type_of_var /= lchar_t) THEN
1512 0 : WRITE (UNIT=unit_nr, FMT="("//TRIM(myfmt)//")", ADVANCE="NO")
1513 : END IF
1514 0 : CALL val_write(val, unit_nr=unit_nr, unit=keyword%unit, fmt=myfmt)
1515 : END IF
1516 : END IF
1517 : END IF
1518 : END DO
1519 292665 : IF (ASSOCIATED(section_vals%subs_vals)) THEN
1520 2635095 : DO isec = 1, SIZE(section_vals%subs_vals, 1)
1521 2342430 : sval => section_vals%subs_vals(isec, i_rep_s)%section_vals
1522 2635095 : IF (ASSOCIATED(sval)) THEN
1523 2342430 : CALL section_vals_write(sval, unit_nr=unit_nr, hide_defaults=hide_defaults)
1524 : END IF
1525 : END DO
1526 : END IF
1527 : END IF
1528 2643591 : IF (.NOT. my_hide_root) THEN
1529 284169 : indent = indent - incr
1530 284169 : WRITE (UNIT=myfmt, FMT="(I0,A1)") indent, "X"
1531 : WRITE (UNIT=unit_nr, FMT="("//TRIM(myfmt)//",A)") &
1532 284169 : default_section_character//"END "//TRIM(ADJUSTL(section%name))
1533 : END IF
1534 : END DO
1535 : END IF
1536 : END IF
1537 :
1538 2350941 : END SUBROUTINE section_vals_write
1539 :
1540 : ! **************************************************************************************************
1541 : !> \brief writes the values in the given section in xml
1542 : !> \param section ...
1543 : !> \param level ...
1544 : !> \param unit_number ...
1545 : ! **************************************************************************************************
1546 0 : RECURSIVE SUBROUTINE write_section_xml(section, level, unit_number)
1547 :
1548 : TYPE(section_type), POINTER :: section
1549 : INTEGER, INTENT(IN) :: level, unit_number
1550 :
1551 : CHARACTER(LEN=3) :: repeats
1552 : CHARACTER(LEN=8) :: short_string
1553 : INTEGER :: i, l0, l1, l2
1554 :
1555 0 : IF (ASSOCIATED(section)) THEN
1556 :
1557 0 : CPASSERT(section%ref_count > 0)
1558 :
1559 : ! Indentation for current level, next level, etc.
1560 :
1561 0 : l0 = level
1562 0 : l1 = level + 1
1563 0 : l2 = level + 2
1564 :
1565 0 : IF (section%repeats) THEN
1566 0 : repeats = "yes"
1567 : ELSE
1568 0 : repeats = "no "
1569 : END IF
1570 :
1571 0 : WRITE (UNIT=unit_number, FMT="(A)") &
1572 0 : REPEAT(" ", l0)//"<SECTION repeats="""//TRIM(repeats)//""">", &
1573 0 : REPEAT(" ", l1)//"<NAME>"//TRIM(section%name)//"</NAME>", &
1574 : REPEAT(" ", l1)//"<DESCRIPTION>"// &
1575 : TRIM(substitute_special_xml_tokens(a2s(section%description))) &
1576 0 : //"</DESCRIPTION>"
1577 :
1578 0 : IF (ALLOCATED(section%deprecation_notice)) &
1579 : WRITE (UNIT=unit_number, FMT="(A)") REPEAT(" ", l1)//"<DEPRECATION_NOTICE>"// &
1580 : TRIM(substitute_special_xml_tokens(section%deprecation_notice)) &
1581 0 : //"</DEPRECATION_NOTICE>"
1582 :
1583 0 : IF (ASSOCIATED(section%citations)) THEN
1584 0 : DO i = 1, SIZE(section%citations, 1)
1585 0 : short_string = ""
1586 0 : WRITE (UNIT=short_string, FMT="(I8)") section%citations(i)
1587 0 : WRITE (UNIT=unit_number, FMT="(A)") &
1588 0 : REPEAT(" ", l1)//"<REFERENCE>", &
1589 0 : REPEAT(" ", l2)//"<NAME>"//TRIM(get_citation_key(section%citations(i)))//"</NAME>", &
1590 0 : REPEAT(" ", l2)//"<NUMBER>"//TRIM(ADJUSTL(short_string))//"</NUMBER>", &
1591 0 : REPEAT(" ", l1)//"</REFERENCE>"
1592 : END DO
1593 : END IF
1594 :
1595 0 : WRITE (UNIT=unit_number, FMT="(A)") &
1596 0 : REPEAT(" ", l1)//"<LOCATION>"//TRIM(section%location)//"</LOCATION>"
1597 :
1598 0 : DO i = -1, section%n_keywords
1599 0 : IF (ASSOCIATED(section%keywords(i)%keyword)) THEN
1600 0 : CALL write_keyword_xml(section%keywords(i)%keyword, l1, unit_number)
1601 : END IF
1602 : END DO
1603 :
1604 0 : DO i = 1, section%n_subsections
1605 0 : CALL write_section_xml(section%subsections(i)%section, l1, unit_number)
1606 : END DO
1607 :
1608 0 : WRITE (UNIT=unit_number, FMT="(A)") REPEAT(" ", l0)//"</SECTION>"
1609 :
1610 : END IF
1611 :
1612 0 : END SUBROUTINE write_section_xml
1613 :
1614 : ! **************************************************************************************************
1615 : !> \brief ...
1616 : !> \param section ...
1617 : !> \param section_name ...
1618 : !> \param unknown_string ...
1619 : !> \param location_string ...
1620 : !> \param matching_rank ...
1621 : !> \param matching_string ...
1622 : !> \param bonus ...
1623 : ! **************************************************************************************************
1624 0 : RECURSIVE SUBROUTINE section_typo_match(section, section_name, unknown_string, location_string, &
1625 0 : matching_rank, matching_string, bonus)
1626 :
1627 : TYPE(section_type), INTENT(IN), POINTER :: section
1628 : CHARACTER(LEN=*) :: section_name, unknown_string, &
1629 : location_string
1630 : INTEGER, DIMENSION(:), INTENT(INOUT) :: matching_rank
1631 : CHARACTER(LEN=*), DIMENSION(:), INTENT(INOUT) :: matching_string
1632 : INTEGER, INTENT(IN) :: bonus
1633 :
1634 0 : CHARACTER(LEN=LEN(matching_string(1))) :: line
1635 : INTEGER :: i, imatch, imax, irank, newbonus
1636 :
1637 0 : IF (ASSOCIATED(section)) THEN
1638 0 : CPASSERT(section%ref_count > 0)
1639 0 : imatch = typo_match(TRIM(section%name), TRIM(unknown_string))
1640 0 : IF (imatch > 0) THEN
1641 0 : imatch = imatch + bonus
1642 : WRITE (UNIT=line, FMT='(T2,A)') &
1643 : " subsection "//TRIM(ADJUSTL(section%name))// &
1644 0 : " in section "//TRIM(ADJUSTL(location_string))
1645 0 : imax = SIZE(matching_rank, 1)
1646 0 : irank = imax + 1
1647 0 : DO I = imax, 1, -1
1648 0 : IF (imatch > matching_rank(I)) irank = i
1649 : END DO
1650 0 : IF (irank <= imax) THEN
1651 0 : matching_rank(irank + 1:imax) = matching_rank(irank:imax - 1)
1652 0 : matching_string(irank + 1:imax) = matching_string(irank:imax - 1)
1653 0 : matching_rank(irank) = imatch
1654 0 : matching_string(irank) = line
1655 : END IF
1656 : END IF
1657 :
1658 0 : IF (section_name == section%name) THEN
1659 0 : newbonus = 10
1660 : ELSE
1661 0 : newbonus = 0
1662 : END IF
1663 :
1664 0 : DO i = -1, section%n_keywords
1665 0 : IF (ASSOCIATED(section%keywords(i)%keyword)) THEN
1666 : CALL keyword_typo_match(section%keywords(i)%keyword, unknown_string, location_string// &
1667 0 : "%"//TRIM(section%name), matching_rank, matching_string, newbonus)
1668 : END IF
1669 : END DO
1670 :
1671 0 : DO i = 1, section%n_subsections
1672 : CALL section_typo_match(section%subsections(i)%section, section_name, unknown_string, &
1673 0 : location_string//"%"//TRIM(section%name), matching_rank, matching_string, newbonus)
1674 : END DO
1675 :
1676 : END IF
1677 :
1678 0 : END SUBROUTINE section_typo_match
1679 :
1680 : ! **************************************************************************************************
1681 : !> \brief replaces of the requested subsection with the one given
1682 : !> \param section_vals the root section
1683 : !> \param subsection_name the name of the subsection to replace
1684 : !> \param new_section_vals the new section_vals to use
1685 : !> \param i_rep_section index of the repetition of section_vals of which
1686 : !> you want to replace the subsection (defaults to 1)
1687 : !> \author fawzi
1688 : ! **************************************************************************************************
1689 17111 : SUBROUTINE section_vals_set_subs_vals(section_vals, subsection_name, &
1690 : new_section_vals, i_rep_section)
1691 : TYPE(section_vals_type), POINTER :: section_vals
1692 : CHARACTER(len=*), INTENT(in) :: subsection_name
1693 : TYPE(section_vals_type), POINTER :: new_section_vals
1694 : INTEGER, INTENT(in), OPTIONAL :: i_rep_section
1695 :
1696 : INTEGER :: irep, isection, len_key, my_index, &
1697 : tmp_index
1698 : TYPE(section_vals_type), POINTER :: s_vals
1699 :
1700 17111 : CPASSERT(ASSOCIATED(section_vals))
1701 17111 : CPASSERT(section_vals%ref_count > 0)
1702 17111 : CPASSERT(ASSOCIATED(new_section_vals))
1703 17111 : CPASSERT(new_section_vals%ref_count > 0)
1704 :
1705 17111 : irep = 1
1706 17111 : IF (PRESENT(i_rep_section)) irep = i_rep_section
1707 :
1708 17111 : my_index = INDEX(subsection_name, '%') + 1
1709 17111 : len_key = LEN_TRIM(subsection_name)
1710 17111 : IF (my_index > 1) THEN
1711 18345 : DO
1712 33628 : tmp_index = INDEX(subsection_name(my_index:len_key), "%")
1713 33628 : IF (tmp_index <= 0) EXIT
1714 18345 : my_index = my_index + tmp_index
1715 : END DO
1716 15283 : s_vals => section_vals_get_subs_vals(section_vals, subsection_name(1:my_index - 2))
1717 : ELSE
1718 1828 : s_vals => section_vals
1719 : END IF
1720 :
1721 17111 : CPASSERT(irep <= SIZE(s_vals%subs_vals, 2))
1722 :
1723 17111 : isection = section_get_subsection_index(s_vals%section, subsection_name(my_index:LEN_TRIM(subsection_name)))
1724 17111 : IF (isection <= 0) &
1725 : CALL cp_abort(__LOCATION__, &
1726 : "could not find subsection "//subsection_name(my_index:LEN_TRIM(subsection_name))//" in section "// &
1727 0 : TRIM(section_vals%section%name)//" at ")
1728 17111 : CALL section_vals_retain(new_section_vals)
1729 17111 : CALL section_vals_release(s_vals%subs_vals(isection, irep)%section_vals)
1730 17111 : s_vals%subs_vals(isection, irep)%section_vals => new_section_vals
1731 :
1732 17111 : END SUBROUTINE section_vals_set_subs_vals
1733 :
1734 : ! **************************************************************************************************
1735 : !> \brief creates a deep copy from section_vals_in to section_vals_out
1736 : !> \param section_vals_in the section_vals to copy
1737 : !> \param section_vals_out the section_vals to create
1738 : !> \param i_rep_start ...
1739 : !> \param i_rep_end ...
1740 : !> \author fawzi
1741 : ! **************************************************************************************************
1742 1605 : SUBROUTINE section_vals_duplicate(section_vals_in, section_vals_out, &
1743 : i_rep_start, i_rep_end)
1744 : TYPE(section_vals_type), POINTER :: section_vals_in, section_vals_out
1745 : INTEGER, INTENT(IN), OPTIONAL :: i_rep_start, i_rep_end
1746 :
1747 1605 : CPASSERT(ASSOCIATED(section_vals_in))
1748 1605 : CPASSERT(.NOT. ASSOCIATED(section_vals_out))
1749 1605 : CALL section_vals_create(section_vals_out, section_vals_in%section)
1750 1605 : CALL section_vals_copy(section_vals_in, section_vals_out, i_rep_start, i_rep_end)
1751 1605 : END SUBROUTINE section_vals_duplicate
1752 :
1753 : ! **************************************************************************************************
1754 : !> \brief deep copy from section_vals_in to section_vals_out
1755 : !> \param section_vals_in the section_vals to copy
1756 : !> \param section_vals_out the section_vals where to copy
1757 : !> \param i_rep_low ...
1758 : !> \param i_rep_high ...
1759 : !> \author fawzi
1760 : !> \note
1761 : !> private, only works with a newly initialized section_vals_out
1762 : ! **************************************************************************************************
1763 4210327 : RECURSIVE SUBROUTINE section_vals_copy(section_vals_in, section_vals_out, &
1764 : i_rep_low, i_rep_high)
1765 : TYPE(section_vals_type), POINTER :: section_vals_in, section_vals_out
1766 : INTEGER, INTENT(IN), OPTIONAL :: i_rep_low, i_rep_high
1767 :
1768 : INTEGER :: iend, irep, isec, istart, ival
1769 : TYPE(cp_sll_val_type), POINTER :: v1, v2
1770 : TYPE(val_type), POINTER :: el
1771 :
1772 4210327 : NULLIFY (v2, el)
1773 :
1774 4210327 : CPASSERT(ASSOCIATED(section_vals_in))
1775 4210327 : CPASSERT(ASSOCIATED(section_vals_out))
1776 : ! IF(.NOT. ASSOCIATED(section_vals_in%section, section_vals_out%section))&
1777 : ! CPABORT("")
1778 :
1779 4210327 : istart = 1
1780 4210327 : iend = SIZE(section_vals_in%values, 2)
1781 4210327 : IF (PRESENT(i_rep_low)) istart = i_rep_low
1782 4210327 : IF (PRESENT(i_rep_high)) iend = i_rep_high
1783 4228180 : DO irep = istart, iend
1784 17853 : CALL section_vals_add_values(section_vals_out)
1785 4435842 : DO ival = LBOUND(section_vals_in%values, 1), UBOUND(section_vals_in%values, 1)
1786 171956 : v1 => section_vals_in%values(ival, irep)%list
1787 189809 : IF (ASSOCIATED(v1)) THEN
1788 36191 : CALL val_duplicate(v1%first_el, el)
1789 36191 : CALL cp_sll_val_create(v2, el)
1790 36191 : NULLIFY (el)
1791 36191 : section_vals_out%values(ival, irep - istart + 1)%list => v2
1792 45920 : DO
1793 82111 : IF (.NOT. ASSOCIATED(v1%rest)) EXIT
1794 45920 : v1 => v1%rest
1795 45920 : CALL val_duplicate(v1%first_el, el)
1796 45920 : CALL cp_sll_val_create(v2%rest, first_el=el)
1797 45920 : NULLIFY (el)
1798 45920 : v2 => v2%rest
1799 : END DO
1800 : END IF
1801 : END DO
1802 : END DO
1803 4210327 : IF (.NOT. PRESENT(i_rep_low) .AND. (.NOT. PRESENT(i_rep_high))) THEN
1804 4209823 : IF (.NOT. (SIZE(section_vals_in%values, 2) == SIZE(section_vals_out%values, 2))) &
1805 0 : CPABORT("")
1806 4209823 : IF (.NOT. (SIZE(section_vals_in%subs_vals, 2) == SIZE(section_vals_out%subs_vals, 2))) &
1807 0 : CPABORT("")
1808 : END IF
1809 4210327 : iend = SIZE(section_vals_in%subs_vals, 2)
1810 4210327 : IF (PRESENT(i_rep_high)) iend = i_rep_high
1811 8421783 : DO irep = istart, iend
1812 12630505 : DO isec = 1, SIZE(section_vals_in%subs_vals, 1)
1813 : CALL section_vals_copy(section_vals_in%subs_vals(isec, irep)%section_vals, &
1814 8420178 : section_vals_out%subs_vals(isec, irep - istart + 1)%section_vals)
1815 : END DO
1816 : END DO
1817 :
1818 4210327 : END SUBROUTINE section_vals_copy
1819 :
1820 0 : END MODULE input_section_types
|
