(git:8917686)
Loading...
Searching...
No Matches
input_section_types.F
Go to the documentation of this file.
1!--------------------------------------------------------------------------------------------------!
2! CP2K: A general program to perform molecular dynamics simulations !
3! Copyright 2000-2026 CP2K developers group <https://cp2k.org> !
4! !
5! SPDX-License-Identifier: GPL-2.0-or-later !
6!--------------------------------------------------------------------------------------------------!
7
8! **************************************************************************************************
9!> \brief 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! **************************************************************************************************
15MODULE 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
140CONTAINS
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 SUBROUTINE section_create(section, location, name, description, n_keywords, &
157 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 cpassert(.NOT. ASSOCIATED(section))
169 my_n_keywords = 10
170 IF (PRESENT(n_keywords)) my_n_keywords = n_keywords
171 my_n_subsections = 0
172 IF (PRESENT(n_subsections)) my_n_subsections = n_subsections
173
174 ALLOCATE (section)
175 section%ref_count = 1
176
177 section%n_keywords = 0
178 section%n_subsections = 0
179 section%location = location
180
181 cpassert(len_trim(name) > 0)
182 section%name = name
183 CALL uppercase(section%name)
184
185 n = len_trim(description)
186 ALLOCATE (section%description(n))
187 DO i = 1, n
188 section%description(i) = description(i:i)
189 END DO
190
191 section%frozen = .false.
192 section%repeats = .false.
193 IF (PRESENT(repeats)) section%repeats = repeats
194
195 NULLIFY (section%citations)
196 IF (PRESENT(citations)) THEN
197 ALLOCATE (section%citations(SIZE(citations)))
198 section%citations = citations
199 END IF
200
201 ALLOCATE (section%keywords(-1:my_n_keywords))
202 DO i = -1, my_n_keywords
203 NULLIFY (section%keywords(i)%keyword)
204 END DO
205
206 ALLOCATE (section%subsections(my_n_subsections))
207 DO i = 1, my_n_subsections
208 NULLIFY (section%subsections(i)%section)
209 END DO
210
211 IF (PRESENT(deprecation_notice)) THEN
212 section%deprecation_notice = trim(deprecation_notice)
213 END IF
214
215 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 SUBROUTINE section_retain(section)
223
224 TYPE(section_type), POINTER :: section
225
226 cpassert(ASSOCIATED(section))
227 cpassert(section%ref_count > 0)
228 section%ref_count = section%ref_count + 1
229
230 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 RECURSIVE SUBROUTINE section_release(section)
238
239 TYPE(section_type), POINTER :: section
240
241 INTEGER :: i
242
243 IF (ASSOCIATED(section)) THEN
244 cpassert(section%ref_count > 0)
245 section%ref_count = section%ref_count - 1
246 IF (section%ref_count == 0) THEN
247 IF (ASSOCIATED(section%citations)) THEN
248 DEALLOCATE (section%citations)
249 END IF
250 IF (ASSOCIATED(section%keywords)) THEN
251 DO i = -1, ubound(section%keywords, 1)
252 CALL keyword_release(section%keywords(i)%keyword)
253 END DO
254 DEALLOCATE (section%keywords)
255 END IF
256 section%n_keywords = 0
257 IF (ASSOCIATED(section%subsections)) THEN
258 DO i = 1, SIZE(section%subsections)
259 CALL section_release(section%subsections(i)%section)
260 END DO
261 DEALLOCATE (section%subsections)
262 END IF
263 DEALLOCATE (section%description)
264 DEALLOCATE (section)
265 END IF
266 NULLIFY (section)
267 END IF
268
269 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 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 message = " "
285 length = len_trim(a2s(section%description))
286 IF (length > 0) THEN
287 IF (section%description(length) /= ".") THEN
288 message = "."
289 END IF
290 END IF
291 IF (section%repeats) THEN
292 message = trim(message)//" This section can be repeated."
293 ELSE
294 message = trim(message)//" This section can not be repeated."
295 END IF
296
297 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 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 IF (unit_nr > 0) THEN
322 my_hide_root = .false.
323 IF (PRESENT(hide_root)) my_hide_root = hide_root
324 my_recurse = 0
325 IF (PRESENT(recurse)) my_recurse = recurse
326 IF (ASSOCIATED(section)) THEN
327 cpassert(section%ref_count > 0)
328
329 IF (.NOT. my_hide_root) THEN
330 WRITE (unit=unit_nr, fmt="('*** section &',A,' ***')") trim(adjustl(section%name))
331 END IF
332 IF (level > 1) THEN
333 message = get_section_info(section)
334 CALL print_message(trim(a2s(section%description))//trim(message), unit_nr, 0, 0, 0)
335 END IF
336 IF (level > 0) THEN
337 IF (ASSOCIATED(section%keywords(-1)%keyword)) THEN
338 CALL keyword_describe(section%keywords(-1)%keyword, unit_nr, &
339 level)
340 END IF
341 IF (ASSOCIATED(section%keywords(0)%keyword)) THEN
342 CALL keyword_describe(section%keywords(0)%keyword, unit_nr, &
343 level)
344 END IF
345 DO ikeyword = 1, section%n_keywords
346 CALL keyword_describe(section%keywords(ikeyword)%keyword, unit_nr, &
347 level)
348 END DO
349 END IF
350 IF (section%n_subsections > 0 .AND. my_recurse >= 0) THEN
351 IF (.NOT. my_hide_root) THEN
352 WRITE (unit=unit_nr, fmt="('** subsections **')")
353 END IF
354 DO isub = 1, section%n_subsections
355 IF (my_recurse > 0) THEN
356 CALL section_describe(section%subsections(isub)%section, unit_nr, &
357 level, recurse=my_recurse - 1)
358 ELSE
359 WRITE (unit=unit_nr, fmt="(1X,A)") section%subsections(isub)%section%name
360 END IF
361 END DO
362 END IF
363 IF (.NOT. my_hide_root) THEN
364 WRITE (unit=unit_nr, fmt="('*** &end section ',A,' ***')") trim(adjustl(section%name))
365 END IF
366 ELSE
367 WRITE (unit_nr, "(a)") '<section *null*>'
368 END IF
369 END IF
370
371 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 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 cpassert(section%ref_count > 0)
392 res = -1
393 upc_name = subsection_name
394 CALL uppercase(upc_name)
395 DO isub = 1, section%n_subsections
396 cpassert(ASSOCIATED(section%subsections(isub)%section))
397 IF (section%subsections(isub)%section%name == upc_name) THEN
398 res = isub
399 EXIT
400 END IF
401 END DO
402
403 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 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 isub = section_get_subsection_index(section, subsection_name)
421 IF (isub > 0) THEN
422 res => section%subsections(isub)%section
423 ELSE
424 NULLIFY (res)
425 END IF
426
427 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 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 cpassert(section%ref_count > 0)
448 cpassert(ASSOCIATED(section%keywords))
449 res = -2
450 upc_name = keyword_name
451 CALL uppercase(upc_name)
452 DO ik = -1, 0
453 IF (ASSOCIATED(section%keywords(ik)%keyword)) THEN
454 IF (section%keywords(ik)%keyword%names(1) == upc_name) THEN
455 res = ik
456 END IF
457 END IF
458 END DO
459 IF (res == -2) THEN
460 k_search_loop: DO ik = 1, section%n_keywords
461 cpassert(ASSOCIATED(section%keywords(ik)%keyword))
462 DO in = 1, SIZE(section%keywords(ik)%keyword%names)
463 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 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 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 IF (index(keyword_name, "%") /= 0) THEN
489 my_index = index(keyword_name, "%") + 1
490 cpassert(ASSOCIATED(section%subsections))
491 DO ik = lbound(section%subsections, 1), ubound(section%subsections, 1)
492 IF (section%subsections(ik)%section%name == keyword_name(1:my_index - 2)) EXIT
493 END DO
494 cpassert(ik <= ubound(section%subsections, 1))
495 res => section_get_keyword(section%subsections(ik)%section, keyword_name(my_index:))
496 ELSE
497 ik = section_get_keyword_index(section, keyword_name)
498 IF (ik == -2) THEN
499 NULLIFY (res)
500 ELSE
501 res => section%keywords(ik)%keyword
502 END IF
503 END IF
504
505 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 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 TYPE(keyword_p_type), DIMENSION(:), POINTER :: new_keywords
520
521 cpassert(section%ref_count > 0)
522 cpassert(.NOT. section%frozen)
523 cpassert(ASSOCIATED(keyword))
524 cpassert(keyword%ref_count > 0)
525 CALL keyword_retain(keyword)
526 IF (keyword%names(1) == "_SECTION_PARAMETERS_") THEN
527 CALL keyword_release(section%keywords(-1)%keyword)
528 section%keywords(-1)%keyword => keyword
529 ELSE IF (keyword%names(1) == "_DEFAULT_KEYWORD_") THEN
530 CALL keyword_release(section%keywords(0)%keyword)
531 section%keywords(0)%keyword => keyword
532 ELSE
533 DO k = 1, SIZE(keyword%names)
534 DO i = 1, section%n_keywords
535 DO j = 1, SIZE(section%keywords(i)%keyword%names)
536 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 //trim(section%name))
541 END IF
542 END DO
543 END DO
544 END DO
545
546 IF (ubound(section%keywords, 1) == section%n_keywords) THEN
547 ALLOCATE (new_keywords(-1:section%n_keywords + 10))
548 DO i = -1, section%n_keywords
549 new_keywords(i)%keyword => section%keywords(i)%keyword
550 END DO
551 DO i = section%n_keywords + 1, ubound(new_keywords, 1)
552 NULLIFY (new_keywords(i)%keyword)
553 END DO
554 DEALLOCATE (section%keywords)
555 section%keywords => new_keywords
556 END IF
557 section%n_keywords = section%n_keywords + 1
558 section%keywords(section%n_keywords)%keyword => keyword
559 END IF
560
561 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 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 TYPE(section_p_type), DIMENSION(:), POINTER :: new_subsections
576
577 cpassert(section%ref_count > 0)
578 cpassert(ASSOCIATED(subsection))
579 cpassert(subsection%ref_count > 0)
580 IF (SIZE(section%subsections) < section%n_subsections + 1) THEN
581 ALLOCATE (new_subsections(section%n_subsections + 10))
582 DO i = 1, section%n_subsections
583 new_subsections(i)%section => section%subsections(i)%section
584 END DO
585 DO i = section%n_subsections + 1, SIZE(new_subsections)
586 NULLIFY (new_subsections(i)%section)
587 END DO
588 DEALLOCATE (section%subsections)
589 section%subsections => new_subsections
590 END IF
591 DO i = 1, section%n_subsections
592 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 //trim(section%name))
597 END IF
598 END DO
599 CALL section_retain(subsection)
600 section%n_subsections = section%n_subsections + 1
601 section%subsections(section%n_subsections)%section => subsection
602
603 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 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 cpassert(.NOT. ASSOCIATED(section_vals))
619 ALLOCATE (section_vals)
620 section_vals%ref_count = 1
621 CALL section_retain(section)
622 section_vals%section => section
623 section%frozen = .true.
624 ALLOCATE (section_vals%values(-1:section%n_keywords, 0))
625 ALLOCATE (section_vals%subs_vals(section%n_subsections, 1))
626 DO i = 1, section%n_subsections
627 NULLIFY (section_vals%subs_vals(i, 1)%section_vals)
628 CALL section_vals_create(section_vals%subs_vals(i, 1)%section_vals, &
629 section=section%subsections(i)%section)
630 END DO
631
632 NULLIFY (section_vals%ibackup)
633
634 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 SUBROUTINE section_vals_retain(section_vals)
642
643 TYPE(section_vals_type), POINTER :: section_vals
644
645 cpassert(ASSOCIATED(section_vals))
646 cpassert(section_vals%ref_count > 0)
647 section_vals%ref_count = section_vals%ref_count + 1
648
649 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 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 IF (ASSOCIATED(section_vals)) THEN
665 cpassert(section_vals%ref_count > 0)
666 section_vals%ref_count = section_vals%ref_count - 1
667 IF (section_vals%ref_count == 0) THEN
668 CALL section_release(section_vals%section)
669 DO j = 1, SIZE(section_vals%values, 2)
670 DO i = -1, ubound(section_vals%values, 1)
671 vals => section_vals%values(i, j)%list
672 DO WHILE (cp_sll_val_next(vals, el_att=el))
673 CALL val_release(el)
674 END DO
675 CALL cp_sll_val_dealloc(section_vals%values(i, j)%list)
676 END DO
677 END DO
678 DEALLOCATE (section_vals%values)
679 DO j = 1, SIZE(section_vals%subs_vals, 2)
680 DO i = 1, SIZE(section_vals%subs_vals, 1)
681 CALL section_vals_release(section_vals%subs_vals(i, j)%section_vals)
682 END DO
683 END DO
684 DEALLOCATE (section_vals%subs_vals)
685 IF (ASSOCIATED(section_vals%ibackup)) THEN
686 DEALLOCATE (section_vals%ibackup)
687 END IF
688 DEALLOCATE (section_vals)
689 END IF
690 END IF
691
692 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 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 cpassert(section_vals%ref_count > 0)
715 IF (PRESENT(ref_count)) ref_count = section_vals%ref_count
716 IF (PRESENT(section)) section => section_vals%section
717 IF (PRESENT(n_repetition)) n_repetition = SIZE(section_vals%values, 2)
718 IF (PRESENT(n_subs_vals_rep)) n_subs_vals_rep = SIZE(section_vals%subs_vals, 2)
719 IF (PRESENT(explicit)) explicit = (SIZE(section_vals%values, 2) > 0)
720
721 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 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 cpassert(section_vals%ref_count > 0)
746
747 my_can_return_null = .false.
748 IF (PRESENT(can_return_null)) my_can_return_null = can_return_null
749 NULLIFY (res)
750 irep = 1
751 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 my_index = index(subsection_name, "%")
755 IF (my_index == 0) THEN
756 is_path = .false.
757 my_index = len_trim(subsection_name)
758 ELSE
759 is_path = .true.
760 irep = 1
761 my_index = my_index - 1
762 END IF
763
764 cpassert(irep <= SIZE(section_vals%subs_vals, 2))
765
766 isection = section_get_subsection_index(section_vals%section, subsection_name(1:my_index))
767 IF (isection > 0) res => section_vals%subs_vals(isection, irep)%section_vals
768 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 trim(section_vals%section%name)//" at ")
772 END IF
773 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 i_rep_section, can_return_null)
776 END IF
777
778 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 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 cpassert(ASSOCIATED(section_vals))
800 cpassert(section_vals%ref_count > 0)
801 NULLIFY (res)
802 irep = 1
803 IF (PRESENT(i_rep_section)) irep = i_rep_section
804 cpassert(irep <= SIZE(section_vals%subs_vals, 2))
805 isect_att = 0
806 DO i = 1, section_vals%section%n_subsections
807 IF (SIZE(section_vals%subs_vals(i, irep)%section_vals%values, 2) > 0) THEN
808 isect_att = isect_att + 1
809 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 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 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 cpassert(section_vals%ref_count > 0)
838 NULLIFY (res)
839 irep = 1
840 IF (PRESENT(i_rep_section)) irep = i_rep_section
841 cpassert(irep <= SIZE(section_vals%subs_vals, 2))
842 i_section = section_get_subsection_index(section_vals%section, subsection_name)
843 res => section_vals%subs_vals(i_section, irep)%section_vals
844
845 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 SUBROUTINE section_vals_add_values(section_vals)
853
854 TYPE(section_vals_type), INTENT(INOUT) :: section_vals
855
856 INTEGER :: i, j
857 TYPE(cp_sll_val_p_type), DIMENSION(:, :), POINTER :: new_values
858 TYPE(section_vals_p_type), DIMENSION(:, :), &
859 POINTER :: new_sps
860
861 cpassert(section_vals%ref_count > 0)
862 ALLOCATE (new_values(-1:ubound(section_vals%values, 1), SIZE(section_vals%values, 2) + 1))
863 DO j = 1, SIZE(section_vals%values, 2)
864 DO i = -1, ubound(section_vals%values, 1)
865 new_values(i, j)%list => section_vals%values(i, j)%list
866 END DO
867 END DO
868 DEALLOCATE (section_vals%values)
869 section_vals%values => new_values
870 j = SIZE(new_values, 2)
871 DO i = -1, ubound(new_values, 1)
872 NULLIFY (new_values(i, j)%list)
873 END DO
874
875 IF (SIZE(new_values, 2) > 1) THEN
876 ALLOCATE (new_sps(SIZE(section_vals%subs_vals, 1), &
877 SIZE(section_vals%subs_vals, 2) + 1))
878 DO j = 1, SIZE(section_vals%subs_vals, 2)
879 DO i = 1, SIZE(section_vals%subs_vals, 1)
880 new_sps(i, j)%section_vals => section_vals%subs_vals(i, j)%section_vals
881 END DO
882 END DO
883 DEALLOCATE (section_vals%subs_vals)
884 section_vals%subs_vals => new_sps
885 j = SIZE(new_sps, 2)
886 DO i = 1, SIZE(new_sps, 1)
887 NULLIFY (new_sps(i, j)%section_vals)
888 CALL section_vals_create(new_sps(i, SIZE(new_sps, 2))%section_vals, &
889 section=section_vals%section%subsections(i)%section)
890 END DO
891 END IF
892
893 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 SUBROUTINE section_vals_remove_values(section_vals)
901
902 TYPE(section_vals_type), POINTER :: section_vals
903
904 INTEGER :: i, j
905 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 IF (ASSOCIATED(section_vals)) THEN
910 cpassert(section_vals%ref_count > 0)
911 NULLIFY (el, vals)
912 ! Allocate a null 0 dimension array of values
913 ALLOCATE (new_values(-1:section_vals%section%n_keywords, 0))
914 ! Release old values
915 DO j = 1, SIZE(section_vals%values, 2)
916 DO i = -1, ubound(section_vals%values, 1)
917 vals => section_vals%values(i, j)%list
918 DO WHILE (cp_sll_val_next(vals, el_att=el))
919 CALL val_release(el)
920 END DO
921 CALL cp_sll_val_dealloc(section_vals%values(i, j)%list)
922 END DO
923 END DO
924 DEALLOCATE (section_vals%values)
925 section_vals%values => new_values
926 END IF
927
928 END SUBROUTINE section_vals_remove_values
929
930! **************************************************************************************************
931!> \brief ...
932!> \param section_vals ...
933!> \param keyword_name ...
934!> \return ...
935! **************************************************************************************************
936 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 CALL section_vals_val_get(section_vals, keyword_name, c_val=res)
943
944 END FUNCTION section_get_cval
945
946! **************************************************************************************************
947!> \brief ...
948!> \param section_vals ...
949!> \param keyword_name ...
950!> \return ...
951! **************************************************************************************************
952 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 CALL section_vals_val_get(section_vals, keyword_name, r_val=res)
959
960 END FUNCTION section_get_rval
961
962! **************************************************************************************************
963!> \brief ...
964!> \param section_vals ...
965!> \param keyword_name ...
966!> \return ...
967! **************************************************************************************************
968 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 CALL section_vals_val_get(section_vals, keyword_name, r_vals=res)
975
976 END FUNCTION section_get_rvals
977
978! **************************************************************************************************
979!> \brief ...
980!> \param section_vals ...
981!> \param keyword_name ...
982!> \return ...
983! **************************************************************************************************
984 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 CALL section_vals_val_get(section_vals, keyword_name, i_val=res)
991
992 END FUNCTION section_get_ival
993
994! **************************************************************************************************
995!> \brief ...
996!> \param section_vals ...
997!> \param keyword_name ...
998!> \return ...
999! **************************************************************************************************
1000 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 CALL section_vals_val_get(section_vals, keyword_name, i_vals=res)
1007
1008 END FUNCTION section_get_ivals
1009
1010! **************************************************************************************************
1011!> \brief ...
1012!> \param section_vals ...
1013!> \param keyword_name ...
1014!> \return ...
1015! **************************************************************************************************
1016 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 CALL section_vals_val_get(section_vals, keyword_name, l_val=res)
1023
1024 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 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 cpassert(section_vals%ref_count > 0)
1079
1080 my_index = index(keyword_name, '%') + 1
1081 len_key = len_trim(keyword_name)
1082 IF (my_index > 1) THEN
1083 DO
1084 tmp_index = index(keyword_name(my_index:len_key), "%")
1085 IF (tmp_index <= 0) EXIT
1086 my_index = my_index + tmp_index
1087 END DO
1088 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 irk = 1
1094 irs = 1
1095 IF (PRESENT(i_rep_section)) irs = i_rep_section
1096 IF (PRESENT(i_rep_val)) irk = i_rep_val
1097 IF (PRESENT(val)) NULLIFY (val)
1098 IF (PRESENT(explicit)) explicit = .false.
1099 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 PRESENT(r_vals) .OR. PRESENT(c_vals)
1103 ik = section_get_keyword_index(s_vals%section, keyword_name(my_index:len_key))
1104 IF (ik == -2) THEN
1105 CALL cp_abort(__location__, &
1106 "section "//trim(section%name)//" does not contain keyword "// &
1107 trim(keyword_name(my_index:len_key)))
1108 END IF
1109 keyword => section%keywords(ik)%keyword
1110 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 //")")
1115 END IF
1116 NULLIFY (my_val)
1117 IF (PRESENT(n_rep_val)) n_rep_val = 0
1118 IF (irs <= SIZE(s_vals%values, 2)) THEN ! the section was parsed
1119 vals => s_vals%values(ik, irs)%list
1120 IF (PRESENT(n_rep_val)) n_rep_val = cp_sll_val_get_length(vals)
1121 IF (.NOT. ASSOCIATED(vals)) THEN
1122 ! this keyword was not parsed
1123 IF (ASSOCIATED(keyword%default_value)) THEN
1124 my_val => keyword%default_value
1125 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 irk)
1130 IF (PRESENT(explicit)) explicit = .true.
1131 END IF
1132 ELSE IF (ASSOCIATED(keyword%default_value)) THEN
1133 IF (PRESENT(n_rep_val)) n_rep_val = 1
1134 my_val => keyword%default_value
1135 END IF
1136 IF (PRESENT(val)) val => my_val
1137 IF (valrequested) THEN
1138 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 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 c_vals=c_vals)
1147 END IF
1148
1149 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 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 cpassert(ASSOCIATED(section_vals))
1175 cpassert(section_vals%ref_count > 0)
1176 NULLIFY (list)
1177 my_index = index(keyword_name, '%') + 1
1178 len_key = len_trim(keyword_name)
1179 IF (my_index > 1) THEN
1180 DO
1181 tmp_index = index(keyword_name(my_index:len_key), "%")
1182 IF (tmp_index <= 0) EXIT
1183 my_index = my_index + tmp_index
1184 END DO
1185 s_vals => section_vals_get_subs_vals(section_vals, keyword_name(1:my_index - 2))
1186 ELSE
1187 s_vals => section_vals
1188 END IF
1189
1190 irs = 1
1191 IF (PRESENT(i_rep_section)) irs = i_rep_section
1192 section => s_vals%section
1193 ik = section_get_keyword_index(s_vals%section, keyword_name(my_index:len_key))
1194 IF (ik == -2) THEN
1195 CALL cp_abort(__location__, &
1196 "section "//trim(section%name)//" does not contain keyword "// &
1197 trim(keyword_name(my_index:len_key)))
1198 END IF
1199 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 //")")
1204 END IF
1205 list => s_vals%values(ik, irs)%list
1206
1207 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 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 cpassert(ASSOCIATED(section_vals))
1258 cpassert(section_vals%ref_count > 0)
1259
1260 my_index = index(keyword_name, '%') + 1
1261 len_key = len_trim(keyword_name)
1262 IF (my_index > 1) THEN
1263 DO
1264 tmp_index = index(keyword_name(my_index:len_key), "%")
1265 IF (tmp_index <= 0) EXIT
1266 my_index = my_index + tmp_index
1267 END DO
1268 s_vals => section_vals_get_subs_vals(section_vals, keyword_name(1:my_index - 2))
1269 ELSE
1270 s_vals => section_vals
1271 END IF
1272
1273 irk = 1
1274 irs = 1
1275 IF (PRESENT(i_rep_section)) irs = i_rep_section
1276 IF (PRESENT(i_rep_val)) irk = i_rep_val
1277 section => s_vals%section
1278 ik = section_get_keyword_index(s_vals%section, keyword_name(my_index:len_key))
1279 IF (ik == -2) THEN
1280 CALL cp_abort(__location__, &
1281 "section "//trim(section%name)//" does not contain keyword "// &
1282 trim(keyword_name(my_index:len_key)))
1283 END IF
1284 ! Add values..
1285 DO
1286 IF (irs <= SIZE(s_vals%values, 2)) EXIT
1287 CALL section_vals_add_values(s_vals)
1288 END DO
1289 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 //")")
1294 END IF
1295 keyword => s_vals%section%keywords(ik)%keyword
1296 NULLIFY (my_val)
1297 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 PRESENT(r_vals_ptr) .OR. PRESENT(c_vals_ptr)
1301 IF (ASSOCIATED(my_val)) THEN
1302 ! check better?
1303 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 trim(section%name))
1308 END IF
1309 ELSE
1310 ! ignore ?
1311 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 trim(section%name))
1316 END IF
1317 cpassert(valset)
1318 IF (keyword%type_of_var == lchar_t) THEN
1319 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 c_vals_ptr=c_vals_ptr, enum=keyword%enum)
1325 END IF
1326 cpassert(ASSOCIATED(my_val))
1327 cpassert(my_val%type_of_var == keyword%type_of_var)
1328 END IF
1329 vals => s_vals%values(ik, irs)%list
1330 IF (irk == -1) THEN
1331 CALL cp_sll_val_insert_el_at(vals, my_val, index=-1)
1332 ELSE IF (irk <= cp_sll_val_get_length(vals)) THEN
1333 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 trim(section%name))
1338 END IF
1339 old_val => cp_sll_val_get_el_at(vals, index=irk)
1340 CALL val_release(old_val)
1341 CALL cp_sll_val_set_el_at(vals, value=my_val, index=irk)
1342 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 trim(section%name))
1348 ELSE
1349 CALL cp_sll_val_insert_el_at(vals, my_val, index=irk)
1350 END IF
1351 s_vals%values(ik, irs)%list => vals
1352 NULLIFY (my_val)
1353 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 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 NULLIFY (pos)
1382 cpassert(ASSOCIATED(section_vals))
1383 cpassert(section_vals%ref_count > 0)
1384
1385 my_index = index(keyword_name, '%') + 1
1386 len_key = len_trim(keyword_name)
1387 IF (my_index > 1) THEN
1388 DO
1389 tmp_index = index(keyword_name(my_index:len_key), "%")
1390 IF (tmp_index <= 0) EXIT
1391 my_index = my_index + tmp_index
1392 END DO
1393 s_vals => section_vals_get_subs_vals(section_vals, keyword_name(1:my_index - 2))
1394 ELSE
1395 s_vals => section_vals
1396 END IF
1397
1398 irk = 1
1399 irs = 1
1400 IF (PRESENT(i_rep_section)) irs = i_rep_section
1401 IF (PRESENT(i_rep_val)) irk = i_rep_val
1402 section => s_vals%section
1403 ik = section_get_keyword_index(s_vals%section, keyword_name(my_index:len_key))
1404 IF (ik == -2) THEN
1405 CALL cp_abort(__location__, &
1406 "section "//trim(section%name)//" does not contain keyword "// &
1407 trim(keyword_name(my_index:len_key)))
1408 END IF
1409 ! ignore unset of non set values
1410 IF (irs <= SIZE(s_vals%values, 2)) THEN
1411 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 //")")
1416 END IF
1417 IF (irk == -1) THEN
1418 pos => cp_sll_val_get_rest(s_vals%values(ik, irs)%list, iter=-1)
1419 ELSE
1420 pos => cp_sll_val_get_rest(s_vals%values(ik, irs)%list, iter=irk - 1)
1421 END IF
1422 IF (ASSOCIATED(pos)) THEN
1423 old_val => cp_sll_val_get_el_at(s_vals%values(ik, irs)%list, index=irk)
1424 CALL val_release(old_val)
1425 CALL cp_sll_val_rm_el_at(s_vals%values(ik, irs)%list, index=irk)
1426 END IF
1427 END IF
1428
1429 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 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 my_hide_root = .false.
1463 my_hide_defaults = .true.
1464 IF (PRESENT(hide_root)) my_hide_root = hide_root
1465 IF (PRESENT(hide_defaults)) my_hide_defaults = hide_defaults
1466
1467 cpassert(section_vals%ref_count > 0)
1468 IF (unit_nr > 0) THEN
1469 CALL section_vals_get(section_vals, explicit=explicit, n_repetition=nr, section=section)
1470 IF (ALLOCATED(section%deprecation_notice)) THEN
1471 first_sec_char = "#"
1472 ELSE
1473 first_sec_char = " "
1474 END IF
1475 IF (explicit .OR. (.NOT. my_hide_defaults)) THEN
1476 DO i_rep_s = 1, nr
1477 IF (.NOT. my_hide_root) THEN
1478 WRITE (unit=myfmt, fmt="(A1,I0,A4)") "(", indent, "X,A)"
1479 IF (ASSOCIATED(section%keywords(-1)%keyword)) THEN
1480 WRITE (unit=unit_nr, fmt=myfmt, advance="NO") &
1481 trim(first_sec_char)//default_section_character//trim(adjustl(section%name))
1482 ELSE
1483 WRITE (unit=unit_nr, fmt=myfmt) &
1484 trim(first_sec_char)//default_section_character//trim(adjustl(section%name))
1485 END IF
1486 END IF
1487 defaultsection = (SIZE(section_vals%values, 2) == 0)
1488 IF (.NOT. defaultsection) THEN
1489 IF (.NOT. my_hide_root) indent = indent + incr
1490 WRITE (unit=myfmt, fmt="(A1,I0,A4)") "(", indent, "X,A)"
1491 DO ik = -1, section%n_keywords
1492 keyword => section%keywords(ik)%keyword
1493 IF (ASSOCIATED(keyword)) THEN
1494 IF (ALLOCATED(keyword%deprecation_notice) .OR. &
1495 ALLOCATED(section%deprecation_notice)) THEN
1496 ! Comment deprecated keyword
1497 first_key_char = "#"
1498 ELSE
1499 first_key_char = " "
1500 END IF
1501 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 i_rep_s, n_rep_val=nval)
1504 IF (i_rep_s <= SIZE(section_vals%values, 2)) THEN
1505 ! Section was parsed
1506 vals => section_vals%values(ik, i_rep_s)%list
1507 DO ival = 1, nval
1508 IF (ival == 1) THEN
1509 new_pos => vals
1510 ELSE
1511 new_pos => new_pos%rest
1512 END IF
1513 IF (.NOT. ASSOCIATED(new_pos)) THEN
1514 ! this keyword was not parsed
1515 IF (ASSOCIATED(keyword%default_value)) THEN
1516 val => keyword%default_value
1517 IF (my_hide_defaults) cycle
1518 END IF
1519 ELSE
1520 val => new_pos%first_el
1521 END IF
1522 IF (keyword%names(1) /= '_DEFAULT_KEYWORD_' .AND. &
1523 keyword%names(1) /= '_SECTION_PARAMETERS_') THEN
1524 WRITE (unit=unit_nr, fmt=myfmt, advance="NO") &
1525 trim(first_key_char)//trim(keyword%names(1))
1526 ELSE IF (keyword%names(1) == '_DEFAULT_KEYWORD_' .AND. &
1527 keyword%type_of_var /= lchar_t) THEN
1528 WRITE (unit=unit_nr, fmt=myfmt, advance="NO")
1529 END IF
1530 CALL val_write(val, unit_nr=unit_nr, unit=keyword%unit, fmt=myfmt)
1531 END DO
1532 ELSE IF (ASSOCIATED(keyword%default_value)) THEN
1533 ! Section was not parsed but default for the keywords may exist
1534 IF (my_hide_defaults) cycle
1535 val => keyword%default_value
1536 IF (keyword%names(1) /= '_DEFAULT_KEYWORD_' .AND. &
1537 keyword%names(1) /= '_SECTION_PARAMETERS_') THEN
1538 WRITE (unit=unit_nr, fmt=myfmt, advance="NO") &
1539 trim(first_key_char)//trim(keyword%names(1))
1540 ELSE IF (keyword%names(1) == '_DEFAULT_KEYWORD_' .AND. &
1541 keyword%type_of_var /= lchar_t) THEN
1542 WRITE (unit=unit_nr, fmt=myfmt, advance="NO")
1543 END IF
1544 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 IF (ASSOCIATED(section_vals%subs_vals)) THEN
1550 DO isec = 1, SIZE(section_vals%subs_vals, 1)
1551 sval => section_vals%subs_vals(isec, i_rep_s)%section_vals
1552 IF (ASSOCIATED(sval)) THEN
1553 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 IF (.NOT. my_hide_root) THEN
1559 indent = indent - incr
1560 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 "END "//trim(adjustl(section%name))
1564 END IF
1565 END DO
1566 END IF
1567 END IF
1568
1569 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 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 IF (ASSOCIATED(section)) THEN
1587
1588 cpassert(section%ref_count > 0)
1589
1590 ! Indentation for current level, next level, etc.
1591
1592 l0 = level
1593 l1 = level + 1
1594 l2 = level + 2
1595
1596 IF (section%repeats) THEN
1597 repeats = "yes"
1598 ELSE
1599 repeats = "no "
1600 END IF
1601
1602 WRITE (unit=unit_number, fmt="(A)") &
1603 repeat(" ", l0)//"<SECTION repeats="""//trim(repeats)//""">", &
1604 repeat(" ", l1)//"<NAME>"//trim(section%name)//"</NAME>", &
1605 repeat(" ", l1)//"<DESCRIPTION>"// &
1606 trim(substitute_special_xml_tokens(a2s(section%description))) &
1607 //"</DESCRIPTION>"
1608
1609 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 //"</DEPRECATION_NOTICE>"
1613 END IF
1614
1615 IF (ASSOCIATED(section%citations)) THEN
1616 DO i = 1, SIZE(section%citations, 1)
1617 short_string = ""
1618 WRITE (unit=short_string, fmt="(I8)") section%citations(i)
1619 WRITE (unit=unit_number, fmt="(A)") &
1620 repeat(" ", l1)//"<REFERENCE>", &
1621 repeat(" ", l2)//"<NAME>"//trim(get_citation_key(section%citations(i)))//"</NAME>", &
1622 repeat(" ", l2)//"<NUMBER>"//trim(adjustl(short_string))//"</NUMBER>", &
1623 repeat(" ", l1)//"</REFERENCE>"
1624 END DO
1625 END IF
1626
1627 WRITE (unit=unit_number, fmt="(A)") &
1628 repeat(" ", l1)//"<LOCATION>"//trim(section%location)//"</LOCATION>"
1629
1630 DO i = -1, section%n_keywords
1631 IF (ASSOCIATED(section%keywords(i)%keyword)) THEN
1632 CALL write_keyword_xml(section%keywords(i)%keyword, l1, unit_number)
1633 END IF
1634 END DO
1635
1636 DO i = 1, section%n_subsections
1637 CALL write_section_xml(section%subsections(i)%section, l1, unit_number)
1638 END DO
1639
1640 WRITE (unit=unit_number, fmt="(A)") repeat(" ", l0)//"</SECTION>"
1641
1642 END IF
1643
1644 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 RECURSIVE SUBROUTINE section_typo_match(section, section_name, unknown_string, location_string, &
1657 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 CHARACTER(LEN=LEN(matching_string(1))) :: line
1667 INTEGER :: i, imatch, imax, irank, newbonus
1668
1669 IF (ASSOCIATED(section)) THEN
1670 cpassert(section%ref_count > 0)
1671 imatch = typo_match(trim(section%name), trim(unknown_string))
1672 IF (imatch > 0) THEN
1673 imatch = imatch + bonus
1674 WRITE (unit=line, fmt='(T2,A)') &
1675 " subsection "//trim(adjustl(section%name))// &
1676 " in section "//trim(adjustl(location_string))
1677 imax = SIZE(matching_rank, 1)
1678 irank = imax + 1
1679 DO i = imax, 1, -1
1680 IF (imatch > matching_rank(i)) irank = i
1681 END DO
1682 IF (irank <= imax) THEN
1683 matching_rank(irank + 1:imax) = matching_rank(irank:imax - 1)
1684 matching_string(irank + 1:imax) = matching_string(irank:imax - 1)
1685 matching_rank(irank) = imatch
1686 matching_string(irank) = line
1687 END IF
1688 END IF
1689
1690 IF (section_name == section%name) THEN
1691 newbonus = 10
1692 ELSE
1693 newbonus = 0
1694 END IF
1695
1696 DO i = -1, section%n_keywords
1697 IF (ASSOCIATED(section%keywords(i)%keyword)) THEN
1698 CALL keyword_typo_match(section%keywords(i)%keyword, unknown_string, location_string// &
1699 "%"//trim(section%name), matching_rank, matching_string, newbonus)
1700 END IF
1701 END DO
1702
1703 DO i = 1, section%n_subsections
1704 CALL section_typo_match(section%subsections(i)%section, section_name, unknown_string, &
1705 location_string//"%"//trim(section%name), matching_rank, matching_string, newbonus)
1706 END DO
1707
1708 END IF
1709
1710 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 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 cpassert(ASSOCIATED(section_vals))
1733 cpassert(section_vals%ref_count > 0)
1734 cpassert(ASSOCIATED(new_section_vals))
1735 cpassert(new_section_vals%ref_count > 0)
1736
1737 irep = 1
1738 IF (PRESENT(i_rep_section)) irep = i_rep_section
1739
1740 my_index = index(subsection_name, '%') + 1
1741 len_key = len_trim(subsection_name)
1742 IF (my_index > 1) THEN
1743 DO
1744 tmp_index = index(subsection_name(my_index:len_key), "%")
1745 IF (tmp_index <= 0) EXIT
1746 my_index = my_index + tmp_index
1747 END DO
1748 s_vals => section_vals_get_subs_vals(section_vals, subsection_name(1:my_index - 2))
1749 ELSE
1750 s_vals => section_vals
1751 END IF
1752
1753 cpassert(irep <= SIZE(s_vals%subs_vals, 2))
1754
1755 isection = section_get_subsection_index(s_vals%section, subsection_name(my_index:len_trim(subsection_name)))
1756 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 trim(section_vals%section%name)//" at ")
1760 END IF
1761 CALL section_vals_retain(new_section_vals)
1762 CALL section_vals_release(s_vals%subs_vals(isection, irep)%section_vals)
1763 s_vals%subs_vals(isection, irep)%section_vals => new_section_vals
1764
1765 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 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 cpassert(ASSOCIATED(section_vals_in))
1781 cpassert(.NOT. ASSOCIATED(section_vals_out))
1782 CALL section_vals_create(section_vals_out, section_vals_in%section)
1783 CALL section_vals_copy(section_vals_in, section_vals_out, i_rep_start, i_rep_end)
1784 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 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 NULLIFY (v2, el)
1806
1807 cpassert(ASSOCIATED(section_vals_in))
1808 cpassert(ASSOCIATED(section_vals_out))
1809
1810 istart = 1
1811 iend = SIZE(section_vals_in%values, 2)
1812 IF (PRESENT(i_rep_low)) istart = i_rep_low
1813 IF (PRESENT(i_rep_high)) iend = i_rep_high
1814 DO irep = istart, iend
1815 CALL section_vals_add_values(section_vals_out)
1816 DO ival = lbound(section_vals_in%values, 1), ubound(section_vals_in%values, 1)
1817 v1 => section_vals_in%values(ival, irep)%list
1818 IF (ASSOCIATED(v1)) THEN
1819 CALL val_duplicate(v1%first_el, el)
1820 CALL cp_sll_val_create(v2, el)
1821 NULLIFY (el)
1822 section_vals_out%values(ival, irep - istart + 1)%list => v2
1823 DO
1824 IF (.NOT. ASSOCIATED(v1%rest)) EXIT
1825 v1 => v1%rest
1826 CALL val_duplicate(v1%first_el, el)
1827 CALL cp_sll_val_create(v2%rest, first_el=el)
1828 NULLIFY (el)
1829 v2 => v2%rest
1830 END DO
1831 END IF
1832 END DO
1833 END DO
1834 IF (.NOT. PRESENT(i_rep_low) .AND. (.NOT. PRESENT(i_rep_high))) THEN
1835 IF (.NOT. (SIZE(section_vals_in%values, 2) == SIZE(section_vals_out%values, 2))) THEN
1836 cpabort("Incompatible sizes of values between input and output")
1837 END IF
1838 IF (.NOT. (SIZE(section_vals_in%subs_vals, 2) == SIZE(section_vals_out%subs_vals, 2))) THEN
1839 cpabort("Incompatible sizes of subsections between input and output")
1840 END IF
1841 END IF
1842 iend = SIZE(section_vals_in%subs_vals, 2)
1843 IF (PRESENT(i_rep_high)) iend = i_rep_high
1844 DO irep = istart, iend
1845 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 section_vals_out%subs_vals(isec, irep - istart + 1)%section_vals)
1848 END DO
1849 END DO
1850
1851 END SUBROUTINE section_vals_copy
1852
1853END MODULE input_section_types
imax
static int imax(int x, int y)
Returns the larger of two given integers (missing from the C standard)
Definition dbm_internal.h:14
cp_log_handling::cp_to_string
Definition cp_log_handling.F:90
cp_linked_list_input
Definition cp_linked_list_input.F:9
cp_linked_list_input::cp_sll_val_get_rest
type(cp_sll_val_type) function, pointer, public cp_sll_val_get_rest(sll, iter)
returns the rest of the list
Definition cp_linked_list_input.F:926
cp_linked_list_input::cp_sll_val_get_length
integer function, public cp_sll_val_get_length(sll)
returns the length of the list
Definition cp_linked_list_input.F:1076
cp_linked_list_input::cp_sll_val_next
logical function, public cp_sll_val_next(iterator, el_att)
returns true if the actual element is valid (i.e. iterator ont at end) moves the iterator to the next...
Definition cp_linked_list_input.F:1475
cp_linked_list_input::cp_sll_val_rm_el_at
subroutine, public cp_sll_val_rm_el_at(sll, index)
removes the element at the given index
Definition cp_linked_list_input.F:1996
cp_linked_list_input::cp_sll_val_create
subroutine, public cp_sll_val_create(sll, first_el, rest)
allocates and initializes a single linked list
Definition cp_linked_list_input.F:509
cp_linked_list_input::cp_sll_val_set_el_at
subroutine, public cp_sll_val_set_el_at(sll, index, value)
sets the element at the given index
Definition cp_linked_list_input.F:1354
cp_linked_list_input::cp_sll_val_insert_el_at
subroutine, public cp_sll_val_insert_el_at(sll, el, index)
inserts the element at the given index
Definition cp_linked_list_input.F:1854
cp_linked_list_input::cp_sll_val_get_el_at
type(val_type) function, pointer, public cp_sll_val_get_el_at(sll, index)
returns the element at the given index
Definition cp_linked_list_input.F:1213
cp_linked_list_input::cp_sll_val_dealloc
subroutine, public cp_sll_val_dealloc(sll)
deallocates the singly linked list starting at sll. Does not work if loops are present!
Definition cp_linked_list_input.F:600
cp_log_handling
various routines to log and control the output. The idea is that decisions about where to log should ...
Definition cp_log_handling.F:41
cp_parser_types
Utility routines to read data from files. Kept as close as possible to the old parser because.
Definition cp_parser_types.F:21
cp_parser_types::default_section_character
character(len=1), parameter, public default_section_character
Definition cp_parser_types.F:62
input_keyword_types
represents keywords in an input
Definition input_keyword_types.F:14
input_keyword_types::keyword_retain
subroutine, public keyword_retain(keyword)
retains the given keyword (see doc/ReferenceCounting.html)
Definition input_keyword_types.F:435
input_keyword_types::keyword_describe
subroutine, public keyword_describe(keyword, unit_nr, level)
writes out a description of the keyword
Definition input_keyword_types.F:523
input_keyword_types::write_keyword_xml
subroutine, public write_keyword_xml(keyword, level, unit_number)
Prints a description of a keyword in XML format.
Definition input_keyword_types.F:657
input_keyword_types::keyword_release
subroutine, public keyword_release(keyword)
releases the given keyword (see doc/ReferenceCounting.html)
Definition input_keyword_types.F:448
input_keyword_types::keyword_typo_match
subroutine, public keyword_typo_match(keyword, unknown_string, location_string, matching_rank, matching_string, bonus)
...
Definition input_keyword_types.F:849
input_section_types
objects that represent the structure of input sections and the data contained in an input section
Definition input_section_types.F:15
input_section_types::section_vals_val_unset
subroutine, public section_vals_val_unset(section_vals, keyword_name, i_rep_section, i_rep_val)
unsets (removes) the requested value (if it is a keyword repetitions removes the repetition,...
Definition input_section_types.F:1369
input_section_types::section_get_rval
real(kind=dp) function, public section_get_rval(section_vals, keyword_name)
...
Definition input_section_types.F:953
input_section_types::section_typo_match
recursive subroutine, public section_typo_match(section, section_name, unknown_string, location_string, matching_rank, matching_string, bonus)
...
Definition input_section_types.F:1658
input_section_types::section_get_subsection
type(section_type) function, pointer, public section_get_subsection(section, subsection_name)
returns the requested subsection
Definition input_section_types.F:413
input_section_types::write_section_xml
recursive subroutine, public write_section_xml(section, level, unit_number)
writes the values in the given section in xml
Definition input_section_types.F:1578
input_section_types::section_vals_create
recursive subroutine, public section_vals_create(section_vals, section)
creates a object where to store the values of a section
Definition input_section_types.F:612
input_section_types::section_create
subroutine, public section_create(section, location, name, description, n_keywords, n_subsections, repeats, citations, deprecation_notice)
creates a list of keywords
Definition input_section_types.F:158
input_section_types::section_vals_val_set
subroutine, public section_vals_val_set(section_vals, keyword_name, i_rep_section, i_rep_val, val, l_val, i_val, r_val, c_val, l_vals_ptr, i_vals_ptr, r_vals_ptr, c_vals_ptr)
sets the requested value
Definition input_section_types.F:1233
input_section_types::section_get_ivals
integer function, dimension(:), pointer, public section_get_ivals(section_vals, keyword_name)
...
Definition input_section_types.F:1001
input_section_types::section_vals_get_subs_vals2
type(section_vals_type) function, pointer, public section_vals_get_subs_vals2(section_vals, i_section, i_rep_section)
returns the values of the n-th non default subsection (null if no such section exists (not so many no...
Definition input_section_types.F:791
input_section_types::section_add_keyword
subroutine, public section_add_keyword(section, keyword)
adds a keyword to the given section
Definition input_section_types.F:514
input_section_types::typo_match_section
type(section_type), pointer, save, public typo_match_section
Definition input_section_types.F:135
input_section_types::section_get_keyword_index
integer function, public section_get_keyword_index(section, keyword_name)
returns the index of the requested keyword (or -2 if not found)
Definition input_section_types.F:439
input_section_types::section_vals_remove_values
subroutine, public section_vals_remove_values(section_vals)
removes the values of a repetition of the section
Definition input_section_types.F:901
input_section_types::section_add_subsection
subroutine, public section_add_subsection(section, subsection)
adds a subsection to the given section
Definition input_section_types.F:570
input_section_types::section_get_ival
integer function, public section_get_ival(section_vals, keyword_name)
...
Definition input_section_types.F:985
input_section_types::section_vals_list_get
subroutine, public section_vals_list_get(section_vals, keyword_name, i_rep_section, list)
returns the requested list
Definition input_section_types.F:1164
input_section_types::typo_matching_rank
integer, dimension(n_typo_matches), public typo_matching_rank
Definition input_section_types.F:137
input_section_types::section_vals_retain
subroutine, public section_vals_retain(section_vals)
retains the given section values (see doc/ReferenceCounting.html)
Definition input_section_types.F:642
input_section_types::section_vals_get_subs_vals
recursive type(section_vals_type) function, pointer, public section_vals_get_subs_vals(section_vals, subsection_name, i_rep_section, can_return_null)
returns the values of the requested subsection
Definition input_section_types.F:735
input_section_types::section_release
recursive subroutine, public section_release(section)
releases the given keyword list (see doc/ReferenceCounting.html)
Definition input_section_types.F:238
input_section_types::section_get_keyword
recursive type(keyword_type) function, pointer, public section_get_keyword(section, keyword_name)
returns the requested keyword
Definition input_section_types.F:481
input_section_types::section_vals_write
recursive subroutine, public section_vals_write(section_vals, unit_nr, hide_root, hide_defaults)
writes the values in the given section in a way that is suitable to the automatic parsing
Definition input_section_types.F:1443
input_section_types::section_vals_get
subroutine, public section_vals_get(section_vals, ref_count, n_repetition, n_subs_vals_rep, section, explicit)
returns various attributes about the section_vals
Definition input_section_types.F:708
input_section_types::section_describe
recursive subroutine, public section_describe(section, unit_nr, level, hide_root, recurse)
prints a description of the given section
Definition input_section_types.F:311
input_section_types::section_vals_get_subs_vals3
type(section_vals_type) function, pointer, public section_vals_get_subs_vals3(section_vals, subsection_name, i_rep_section)
returns the values of the n-th non default subsection (null if no such section exists (not so many no...
Definition input_section_types.F:829
input_section_types::section_vals_set_subs_vals
subroutine, public section_vals_set_subs_vals(section_vals, subsection_name, new_section_vals, i_rep_section)
replaces of the requested subsection with the one given
Definition input_section_types.F:1723
input_section_types::section_get_subsection_index
integer function, public section_get_subsection_index(section, subsection_name)
returns the index of requested subsection (-1 if not found)
Definition input_section_types.F:383
input_section_types::section_vals_duplicate
subroutine, public section_vals_duplicate(section_vals_in, section_vals_out, i_rep_start, i_rep_end)
creates a deep copy from section_vals_in to section_vals_out
Definition input_section_types.F:1777
input_section_types::typo_matching_line
character(len=default_string_length *5), dimension(n_typo_matches), public typo_matching_line
Definition input_section_types.F:138
input_section_types::section_vals_val_get
subroutine, public section_vals_val_get(section_vals, keyword_name, i_rep_section, i_rep_val, n_rep_val, val, l_val, i_val, r_val, c_val, l_vals, i_vals, r_vals, c_vals, explicit)
returns the requested value
Definition input_section_types.F:1052
input_section_types::section_vals_add_values
subroutine, public section_vals_add_values(section_vals)
adds the place to store the values of a repetition of the section
Definition input_section_types.F:853
input_section_types::section_vals_release
recursive subroutine, public section_vals_release(section_vals)
releases the given object
Definition input_section_types.F:657
input_section_types::section_get_lval
logical function, public section_get_lval(section_vals, keyword_name)
...
Definition input_section_types.F:1017
input_val_types
a wrapper for basic fortran types.
Definition input_val_types.F:14
input_val_types::lchar_t
integer, parameter, public lchar_t
Definition input_val_types.F:41
input_val_types::val_duplicate
subroutine, public val_duplicate(val_in, val_out)
creates a copy of the given value
Definition input_val_types.F:740
input_val_types::val_write
subroutine, public val_write(val, unit_nr, unit, unit_str, fmt)
writes out the values stored in the val
Definition input_val_types.F:480
input_val_types::val_get
subroutine, public val_get(val, has_l, has_i, has_r, has_lc, has_c, l_val, l_vals, i_val, i_vals, r_val, r_vals, c_val, c_vals, len_c, type_of_var, enum)
returns the stored values
Definition input_val_types.F:334
input_val_types::val_create
subroutine, public val_create(val, l_val, l_vals, l_vals_ptr, i_val, i_vals, i_vals_ptr, r_val, r_vals, r_vals_ptr, c_val, c_vals, c_vals_ptr, lc_val, lc_vals, lc_vals_ptr, enum)
creates a keyword value
Definition input_val_types.F:103
input_val_types::val_release
subroutine, public val_release(val)
releases the given val
Definition input_val_types.F:262
input_val_types::no_t
integer, parameter, public no_t
Definition input_val_types.F:41
kinds
Defines the basic variable types.
Definition kinds.F:23
kinds::dp
integer, parameter, public dp
Definition kinds.F:34
kinds::default_string_length
integer, parameter, public default_string_length
Definition kinds.F:57
kinds::default_path_length
integer, parameter, public default_path_length
Definition kinds.F:58
list
An array-based list which grows on demand. When the internal array is full, a new array of twice the ...
Definition list.F:24
print_messages
Perform an abnormal program termination.
Definition print_messages.F:21
print_messages::print_message
subroutine, public print_message(message, output_unit, declev, before, after)
Perform a basic blocking of the text in message and print it optionally decorated with a frame of sta...
Definition print_messages.F:56
reference_manager
provides a uniform framework to add references to CP2K cite and output these
Definition reference_manager.F:25
reference_manager::get_citation_key
pure character(len=default_string_length) function, public get_citation_key(key)
...
Definition reference_manager.F:358
string_utilities
Utilities for string manipulations.
Definition string_utilities.F:16
string_utilities::typo_match
elemental integer function, public typo_match(string, typo_string)
returns a non-zero positive value if typo_string equals string apart from a few typos....
Definition string_utilities.F:71
string_utilities::a2s
pure character(len=size(array)) function, public a2s(array)
Converts a character-array into a string.
Definition string_utilities.F:135
string_utilities::substitute_special_xml_tokens
character(len=2 *len(inp_string)) function, public substitute_special_xml_tokens(inp_string)
Substitutes the five predefined XML entities: &, <, >, ', and ".
Definition string_utilities.F:3299
string_utilities::uppercase
elemental subroutine, public uppercase(string)
Convert all lower case characters in a string to upper case.
Definition string_utilities.F:3362
cp_linked_list_input::cp_sll_val_p_type
pointer to a linked list (to make arrays of pointers)
Definition cp_linked_list_input.F:393
cp_linked_list_input::cp_sll_val_type
represent a single linked list that stores pointers to the elements
Definition cp_linked_list_input.F:341
input_keyword_types::keyword_p_type
represent a pointer to a keyword (to make arrays of pointers)
Definition input_keyword_types.F:55
input_keyword_types::keyword_type
represent a keyword in the input
Definition input_keyword_types.F:89
input_section_types::section_type
represent a section of the input file
Definition input_section_types.F:102
input_section_types::section_vals_type
stores the values of a section
Definition input_section_types.F:127
input_val_types::val_type
a type to have a wrapper that stores any basic fortran type
Definition input_val_types.F:63