(git:53a46e8)
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-2025 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) &
330 WRITE (unit=unit_nr, fmt="('*** section &',A,' ***')") trim(adjustl(section%name))
331 IF (level > 1) THEN
332 message = get_section_info(section)
333 CALL print_message(trim(a2s(section%description))//trim(message), unit_nr, 0, 0, 0)
334 END IF
335 IF (level > 0) THEN
336 IF (ASSOCIATED(section%keywords(-1)%keyword)) THEN
337 CALL keyword_describe(section%keywords(-1)%keyword, unit_nr, &
338 level)
339 END IF
340 IF (ASSOCIATED(section%keywords(0)%keyword)) THEN
341 CALL keyword_describe(section%keywords(0)%keyword, unit_nr, &
342 level)
343 END IF
344 DO ikeyword = 1, section%n_keywords
345 CALL keyword_describe(section%keywords(ikeyword)%keyword, unit_nr, &
346 level)
347 END DO
348 END IF
349 IF (section%n_subsections > 0 .AND. my_recurse >= 0) THEN
350 IF (.NOT. my_hide_root) &
351 WRITE (unit=unit_nr, fmt="('** subsections **')")
352 DO isub = 1, section%n_subsections
353 IF (my_recurse > 0) THEN
354 CALL section_describe(section%subsections(isub)%section, unit_nr, &
355 level, recurse=my_recurse - 1)
356 ELSE
357 WRITE (unit=unit_nr, fmt="(1X,A)") section%subsections(isub)%section%name
358 END IF
359 END DO
360 END IF
361 IF (.NOT. my_hide_root) &
362 WRITE (unit=unit_nr, fmt="('*** &end section ',A,' ***')") trim(adjustl(section%name))
363 ELSE
364 WRITE (unit_nr, "(a)") '<section *null*>'
365 END IF
366 END IF
367
368 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 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 cpassert(section%ref_count > 0)
389 res = -1
390 upc_name = subsection_name
391 CALL uppercase(upc_name)
392 DO isub = 1, section%n_subsections
393 cpassert(ASSOCIATED(section%subsections(isub)%section))
394 IF (section%subsections(isub)%section%name == upc_name) THEN
395 res = isub
396 EXIT
397 END IF
398 END DO
399
400 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 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 isub = section_get_subsection_index(section, subsection_name)
418 IF (isub > 0) THEN
419 res => section%subsections(isub)%section
420 ELSE
421 NULLIFY (res)
422 END IF
423
424 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 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 cpassert(section%ref_count > 0)
445 cpassert(ASSOCIATED(section%keywords))
446 res = -2
447 upc_name = keyword_name
448 CALL uppercase(upc_name)
449 DO ik = -1, 0
450 IF (ASSOCIATED(section%keywords(ik)%keyword)) THEN
451 IF (section%keywords(ik)%keyword%names(1) == upc_name) THEN
452 res = ik
453 END IF
454 END IF
455 END DO
456 IF (res == -2) THEN
457 k_search_loop: DO ik = 1, section%n_keywords
458 cpassert(ASSOCIATED(section%keywords(ik)%keyword))
459 DO in = 1, SIZE(section%keywords(ik)%keyword%names)
460 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 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 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 IF (index(keyword_name, "%") /= 0) THEN
486 my_index = index(keyword_name, "%") + 1
487 cpassert(ASSOCIATED(section%subsections))
488 DO ik = lbound(section%subsections, 1), ubound(section%subsections, 1)
489 IF (section%subsections(ik)%section%name == keyword_name(1:my_index - 2)) EXIT
490 END DO
491 cpassert(ik <= ubound(section%subsections, 1))
492 res => section_get_keyword(section%subsections(ik)%section, keyword_name(my_index:))
493 ELSE
494 ik = section_get_keyword_index(section, keyword_name)
495 IF (ik == -2) THEN
496 NULLIFY (res)
497 ELSE
498 res => section%keywords(ik)%keyword
499 END IF
500 END IF
501
502 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 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 TYPE(keyword_p_type), DIMENSION(:), POINTER :: new_keywords
517
518 cpassert(section%ref_count > 0)
519 cpassert(.NOT. section%frozen)
520 cpassert(ASSOCIATED(keyword))
521 cpassert(keyword%ref_count > 0)
522 CALL keyword_retain(keyword)
523 IF (keyword%names(1) == "_SECTION_PARAMETERS_") THEN
524 CALL keyword_release(section%keywords(-1)%keyword)
525 section%keywords(-1)%keyword => keyword
526 ELSE IF (keyword%names(1) == "_DEFAULT_KEYWORD_") THEN
527 CALL keyword_release(section%keywords(0)%keyword)
528 section%keywords(0)%keyword => keyword
529 ELSE
530 DO k = 1, SIZE(keyword%names)
531 DO i = 1, section%n_keywords
532 DO j = 1, SIZE(section%keywords(i)%keyword%names)
533 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 //trim(section%name))
538 END IF
539 END DO
540 END DO
541 END DO
542
543 IF (ubound(section%keywords, 1) == section%n_keywords) THEN
544 ALLOCATE (new_keywords(-1:section%n_keywords + 10))
545 DO i = -1, section%n_keywords
546 new_keywords(i)%keyword => section%keywords(i)%keyword
547 END DO
548 DO i = section%n_keywords + 1, ubound(new_keywords, 1)
549 NULLIFY (new_keywords(i)%keyword)
550 END DO
551 DEALLOCATE (section%keywords)
552 section%keywords => new_keywords
553 END IF
554 section%n_keywords = section%n_keywords + 1
555 section%keywords(section%n_keywords)%keyword => keyword
556 END IF
557
558 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 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 TYPE(section_p_type), DIMENSION(:), POINTER :: new_subsections
573
574 cpassert(section%ref_count > 0)
575 cpassert(ASSOCIATED(subsection))
576 cpassert(subsection%ref_count > 0)
577 IF (SIZE(section%subsections) < section%n_subsections + 1) THEN
578 ALLOCATE (new_subsections(section%n_subsections + 10))
579 DO i = 1, section%n_subsections
580 new_subsections(i)%section => section%subsections(i)%section
581 END DO
582 DO i = section%n_subsections + 1, SIZE(new_subsections)
583 NULLIFY (new_subsections(i)%section)
584 END DO
585 DEALLOCATE (section%subsections)
586 section%subsections => new_subsections
587 END IF
588 DO i = 1, section%n_subsections
589 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 //trim(section%name))
594 END DO
595 CALL section_retain(subsection)
596 section%n_subsections = section%n_subsections + 1
597 section%subsections(section%n_subsections)%section => subsection
598
599 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 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 cpassert(.NOT. ASSOCIATED(section_vals))
615 ALLOCATE (section_vals)
616 section_vals%ref_count = 1
617 CALL section_retain(section)
618 section_vals%section => section
619 section%frozen = .true.
620 ALLOCATE (section_vals%values(-1:section%n_keywords, 0))
621 ALLOCATE (section_vals%subs_vals(section%n_subsections, 1))
622 DO i = 1, section%n_subsections
623 NULLIFY (section_vals%subs_vals(i, 1)%section_vals)
624 CALL section_vals_create(section_vals%subs_vals(i, 1)%section_vals, &
625 section=section%subsections(i)%section)
626 END DO
627
628 NULLIFY (section_vals%ibackup)
629
630 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 SUBROUTINE section_vals_retain(section_vals)
638
639 TYPE(section_vals_type), POINTER :: section_vals
640
641 cpassert(ASSOCIATED(section_vals))
642 cpassert(section_vals%ref_count > 0)
643 section_vals%ref_count = section_vals%ref_count + 1
644
645 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 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 IF (ASSOCIATED(section_vals)) THEN
661 cpassert(section_vals%ref_count > 0)
662 section_vals%ref_count = section_vals%ref_count - 1
663 IF (section_vals%ref_count == 0) THEN
664 CALL section_release(section_vals%section)
665 DO j = 1, SIZE(section_vals%values, 2)
666 DO i = -1, ubound(section_vals%values, 1)
667 vals => section_vals%values(i, j)%list
668 DO WHILE (cp_sll_val_next(vals, el_att=el))
669 CALL val_release(el)
670 END DO
671 CALL cp_sll_val_dealloc(section_vals%values(i, j)%list)
672 END DO
673 END DO
674 DEALLOCATE (section_vals%values)
675 DO j = 1, SIZE(section_vals%subs_vals, 2)
676 DO i = 1, SIZE(section_vals%subs_vals, 1)
677 CALL section_vals_release(section_vals%subs_vals(i, j)%section_vals)
678 END DO
679 END DO
680 DEALLOCATE (section_vals%subs_vals)
681 IF (ASSOCIATED(section_vals%ibackup)) THEN
682 DEALLOCATE (section_vals%ibackup)
683 END IF
684 DEALLOCATE (section_vals)
685 END IF
686 END IF
687
688 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 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 cpassert(section_vals%ref_count > 0)
711 IF (PRESENT(ref_count)) ref_count = section_vals%ref_count
712 IF (PRESENT(section)) section => section_vals%section
713 IF (PRESENT(n_repetition)) n_repetition = SIZE(section_vals%values, 2)
714 IF (PRESENT(n_subs_vals_rep)) n_subs_vals_rep = SIZE(section_vals%subs_vals, 2)
715 IF (PRESENT(explicit)) explicit = (SIZE(section_vals%values, 2) > 0)
716
717 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 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 cpassert(section_vals%ref_count > 0)
742
743 my_can_return_null = .false.
744 IF (PRESENT(can_return_null)) my_can_return_null = can_return_null
745 NULLIFY (res)
746 irep = 1
747 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 my_index = index(subsection_name, "%")
751 IF (my_index == 0) THEN
752 is_path = .false.
753 my_index = len_trim(subsection_name)
754 ELSE
755 is_path = .true.
756 irep = 1
757 my_index = my_index - 1
758 END IF
759
760 cpassert(irep <= SIZE(section_vals%subs_vals, 2))
761
762 isection = section_get_subsection_index(section_vals%section, subsection_name(1:my_index))
763 IF (isection > 0) res => section_vals%subs_vals(isection, irep)%section_vals
764 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 trim(section_vals%section%name)//" at ")
768 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 i_rep_section, can_return_null)
771 END IF
772
773 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 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 cpassert(ASSOCIATED(section_vals))
795 cpassert(section_vals%ref_count > 0)
796 NULLIFY (res)
797 irep = 1
798 IF (PRESENT(i_rep_section)) irep = i_rep_section
799 cpassert(irep <= SIZE(section_vals%subs_vals, 2))
800 isect_att = 0
801 DO i = 1, section_vals%section%n_subsections
802 IF (SIZE(section_vals%subs_vals(i, irep)%section_vals%values, 2) > 0) THEN
803 isect_att = isect_att + 1
804 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 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 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 cpassert(section_vals%ref_count > 0)
833 NULLIFY (res)
834 irep = 1
835 IF (PRESENT(i_rep_section)) irep = i_rep_section
836 cpassert(irep <= SIZE(section_vals%subs_vals, 2))
837 i_section = section_get_subsection_index(section_vals%section, subsection_name)
838 res => section_vals%subs_vals(i_section, irep)%section_vals
839
840 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 SUBROUTINE section_vals_add_values(section_vals)
848
849 TYPE(section_vals_type), INTENT(INOUT) :: section_vals
850
851 INTEGER :: i, j
852 TYPE(cp_sll_val_p_type), DIMENSION(:, :), POINTER :: new_values
853 TYPE(section_vals_p_type), DIMENSION(:, :), &
854 POINTER :: new_sps
855
856 cpassert(section_vals%ref_count > 0)
857 ALLOCATE (new_values(-1:ubound(section_vals%values, 1), SIZE(section_vals%values, 2) + 1))
858 DO j = 1, SIZE(section_vals%values, 2)
859 DO i = -1, ubound(section_vals%values, 1)
860 new_values(i, j)%list => section_vals%values(i, j)%list
861 END DO
862 END DO
863 DEALLOCATE (section_vals%values)
864 section_vals%values => new_values
865 j = SIZE(new_values, 2)
866 DO i = -1, ubound(new_values, 1)
867 NULLIFY (new_values(i, j)%list)
868 END DO
869
870 IF (SIZE(new_values, 2) > 1) THEN
871 ALLOCATE (new_sps(SIZE(section_vals%subs_vals, 1), &
872 SIZE(section_vals%subs_vals, 2) + 1))
873 DO j = 1, SIZE(section_vals%subs_vals, 2)
874 DO i = 1, SIZE(section_vals%subs_vals, 1)
875 new_sps(i, j)%section_vals => section_vals%subs_vals(i, j)%section_vals
876 END DO
877 END DO
878 DEALLOCATE (section_vals%subs_vals)
879 section_vals%subs_vals => new_sps
880 j = SIZE(new_sps, 2)
881 DO i = 1, SIZE(new_sps, 1)
882 NULLIFY (new_sps(i, j)%section_vals)
883 CALL section_vals_create(new_sps(i, SIZE(new_sps, 2))%section_vals, &
884 section=section_vals%section%subsections(i)%section)
885 END DO
886 END IF
887
888 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 SUBROUTINE section_vals_remove_values(section_vals)
896
897 TYPE(section_vals_type), POINTER :: section_vals
898
899 INTEGER :: i, j
900 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 IF (ASSOCIATED(section_vals)) THEN
905 cpassert(section_vals%ref_count > 0)
906 NULLIFY (el, vals)
907 ! Allocate a null 0 dimension array of values
908 ALLOCATE (new_values(-1:section_vals%section%n_keywords, 0))
909 ! Release old values
910 DO j = 1, SIZE(section_vals%values, 2)
911 DO i = -1, ubound(section_vals%values, 1)
912 vals => section_vals%values(i, j)%list
913 DO WHILE (cp_sll_val_next(vals, el_att=el))
914 CALL val_release(el)
915 END DO
916 CALL cp_sll_val_dealloc(section_vals%values(i, j)%list)
917 END DO
918 END DO
919 DEALLOCATE (section_vals%values)
920 section_vals%values => new_values
921 END IF
922
923 END SUBROUTINE section_vals_remove_values
924
925! **************************************************************************************************
926!> \brief ...
927!> \param section_vals ...
928!> \param keyword_name ...
929!> \return ...
930! **************************************************************************************************
931 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 CALL section_vals_val_get(section_vals, keyword_name, c_val=res)
938
939 END FUNCTION section_get_cval
940
941! **************************************************************************************************
942!> \brief ...
943!> \param section_vals ...
944!> \param keyword_name ...
945!> \return ...
946! **************************************************************************************************
947 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 CALL section_vals_val_get(section_vals, keyword_name, r_val=res)
954
955 END FUNCTION section_get_rval
956
957! **************************************************************************************************
958!> \brief ...
959!> \param section_vals ...
960!> \param keyword_name ...
961!> \return ...
962! **************************************************************************************************
963 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 CALL section_vals_val_get(section_vals, keyword_name, r_vals=res)
970
971 END FUNCTION section_get_rvals
972
973! **************************************************************************************************
974!> \brief ...
975!> \param section_vals ...
976!> \param keyword_name ...
977!> \return ...
978! **************************************************************************************************
979 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 CALL section_vals_val_get(section_vals, keyword_name, i_val=res)
986
987 END FUNCTION section_get_ival
988
989! **************************************************************************************************
990!> \brief ...
991!> \param section_vals ...
992!> \param keyword_name ...
993!> \return ...
994! **************************************************************************************************
995 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 CALL section_vals_val_get(section_vals, keyword_name, i_vals=res)
1002
1003 END FUNCTION section_get_ivals
1004
1005! **************************************************************************************************
1006!> \brief ...
1007!> \param section_vals ...
1008!> \param keyword_name ...
1009!> \return ...
1010! **************************************************************************************************
1011 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 CALL section_vals_val_get(section_vals, keyword_name, l_val=res)
1018
1019 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 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 cpassert(section_vals%ref_count > 0)
1074
1075 my_index = index(keyword_name, '%') + 1
1076 len_key = len_trim(keyword_name)
1077 IF (my_index > 1) THEN
1078 DO
1079 tmp_index = index(keyword_name(my_index:len_key), "%")
1080 IF (tmp_index <= 0) EXIT
1081 my_index = my_index + tmp_index
1082 END DO
1083 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 irk = 1
1089 irs = 1
1090 IF (PRESENT(i_rep_section)) irs = i_rep_section
1091 IF (PRESENT(i_rep_val)) irk = i_rep_val
1092 IF (PRESENT(val)) NULLIFY (val)
1093 IF (PRESENT(explicit)) explicit = .false.
1094 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 PRESENT(r_vals) .OR. PRESENT(c_vals)
1098 ik = section_get_keyword_index(s_vals%section, keyword_name(my_index:len_key))
1099 IF (ik == -2) &
1100 CALL cp_abort(__location__, &
1101 "section "//trim(section%name)//" does not contain keyword "// &
1102 trim(keyword_name(my_index:len_key)))
1103 keyword => section%keywords(ik)%keyword
1104 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 //")")
1109 NULLIFY (my_val)
1110 IF (PRESENT(n_rep_val)) n_rep_val = 0
1111 IF (irs <= SIZE(s_vals%values, 2)) THEN ! the section was parsed
1112 vals => s_vals%values(ik, irs)%list
1113 IF (PRESENT(n_rep_val)) n_rep_val = cp_sll_val_get_length(vals)
1114 IF (.NOT. ASSOCIATED(vals)) THEN
1115 ! this keyword was not parsed
1116 IF (ASSOCIATED(keyword%default_value)) THEN
1117 my_val => keyword%default_value
1118 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 irk)
1123 IF (PRESENT(explicit)) explicit = .true.
1124 END IF
1125 ELSE IF (ASSOCIATED(keyword%default_value)) THEN
1126 IF (PRESENT(n_rep_val)) n_rep_val = 1
1127 my_val => keyword%default_value
1128 END IF
1129 IF (PRESENT(val)) val => my_val
1130 IF (valrequested) THEN
1131 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 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 c_vals=c_vals)
1139 END IF
1140
1141 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 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 cpassert(ASSOCIATED(section_vals))
1167 cpassert(section_vals%ref_count > 0)
1168 NULLIFY (list)
1169 my_index = index(keyword_name, '%') + 1
1170 len_key = len_trim(keyword_name)
1171 IF (my_index > 1) THEN
1172 DO
1173 tmp_index = index(keyword_name(my_index:len_key), "%")
1174 IF (tmp_index <= 0) EXIT
1175 my_index = my_index + tmp_index
1176 END DO
1177 s_vals => section_vals_get_subs_vals(section_vals, keyword_name(1:my_index - 2))
1178 ELSE
1179 s_vals => section_vals
1180 END IF
1181
1182 irs = 1
1183 IF (PRESENT(i_rep_section)) irs = i_rep_section
1184 section => s_vals%section
1185 ik = section_get_keyword_index(s_vals%section, keyword_name(my_index:len_key))
1186 IF (ik == -2) &
1187 CALL cp_abort(__location__, &
1188 "section "//trim(section%name)//" does not contain keyword "// &
1189 trim(keyword_name(my_index:len_key)))
1190 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 //")")
1195 list => s_vals%values(ik, irs)%list
1196
1197 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 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 cpassert(ASSOCIATED(section_vals))
1248 cpassert(section_vals%ref_count > 0)
1249
1250 my_index = index(keyword_name, '%') + 1
1251 len_key = len_trim(keyword_name)
1252 IF (my_index > 1) THEN
1253 DO
1254 tmp_index = index(keyword_name(my_index:len_key), "%")
1255 IF (tmp_index <= 0) EXIT
1256 my_index = my_index + tmp_index
1257 END DO
1258 s_vals => section_vals_get_subs_vals(section_vals, keyword_name(1:my_index - 2))
1259 ELSE
1260 s_vals => section_vals
1261 END IF
1262
1263 irk = 1
1264 irs = 1
1265 IF (PRESENT(i_rep_section)) irs = i_rep_section
1266 IF (PRESENT(i_rep_val)) irk = i_rep_val
1267 section => s_vals%section
1268 ik = section_get_keyword_index(s_vals%section, keyword_name(my_index:len_key))
1269 IF (ik == -2) &
1270 CALL cp_abort(__location__, &
1271 "section "//trim(section%name)//" does not contain keyword "// &
1272 trim(keyword_name(my_index:len_key)))
1273 ! Add values..
1274 DO
1275 IF (irs <= SIZE(s_vals%values, 2)) EXIT
1276 CALL section_vals_add_values(s_vals)
1277 END DO
1278 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 //")")
1283 keyword => s_vals%section%keywords(ik)%keyword
1284 NULLIFY (my_val)
1285 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 PRESENT(r_vals_ptr) .OR. PRESENT(c_vals_ptr)
1289 IF (ASSOCIATED(my_val)) THEN
1290 ! check better?
1291 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 trim(section%name))
1296 ELSE
1297 ! ignore ?
1298 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 trim(section%name))
1303 cpassert(valset)
1304 IF (keyword%type_of_var == lchar_t) THEN
1305 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 c_vals_ptr=c_vals_ptr, enum=keyword%enum)
1311 END IF
1312 cpassert(ASSOCIATED(my_val))
1313 cpassert(my_val%type_of_var == keyword%type_of_var)
1314 END IF
1315 vals => s_vals%values(ik, irs)%list
1316 IF (irk == -1) THEN
1317 CALL cp_sll_val_insert_el_at(vals, my_val, index=-1)
1318 ELSE IF (irk <= cp_sll_val_get_length(vals)) THEN
1319 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 trim(section%name))
1324 old_val => cp_sll_val_get_el_at(vals, index=irk)
1325 CALL val_release(old_val)
1326 CALL cp_sll_val_set_el_at(vals, value=my_val, index=irk)
1327 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 trim(section%name))
1333 ELSE
1334 CALL cp_sll_val_insert_el_at(vals, my_val, index=irk)
1335 END IF
1336 s_vals%values(ik, irs)%list => vals
1337 NULLIFY (my_val)
1338 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 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 NULLIFY (pos)
1367 cpassert(ASSOCIATED(section_vals))
1368 cpassert(section_vals%ref_count > 0)
1369
1370 my_index = index(keyword_name, '%') + 1
1371 len_key = len_trim(keyword_name)
1372 IF (my_index > 1) THEN
1373 DO
1374 tmp_index = index(keyword_name(my_index:len_key), "%")
1375 IF (tmp_index <= 0) EXIT
1376 my_index = my_index + tmp_index
1377 END DO
1378 s_vals => section_vals_get_subs_vals(section_vals, keyword_name(1:my_index - 2))
1379 ELSE
1380 s_vals => section_vals
1381 END IF
1382
1383 irk = 1
1384 irs = 1
1385 IF (PRESENT(i_rep_section)) irs = i_rep_section
1386 IF (PRESENT(i_rep_val)) irk = i_rep_val
1387 section => s_vals%section
1388 ik = section_get_keyword_index(s_vals%section, keyword_name(my_index:len_key))
1389 IF (ik == -2) &
1390 CALL cp_abort(__location__, &
1391 "section "//trim(section%name)//" does not contain keyword "// &
1392 trim(keyword_name(my_index:len_key)))
1393 ! ignore unset of non set values
1394 IF (irs <= SIZE(s_vals%values, 2)) THEN
1395 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 //")")
1400 IF (irk == -1) THEN
1401 pos => cp_sll_val_get_rest(s_vals%values(ik, irs)%list, iter=-1)
1402 ELSE
1403 pos => cp_sll_val_get_rest(s_vals%values(ik, irs)%list, iter=irk - 1)
1404 END IF
1405 IF (ASSOCIATED(pos)) THEN
1406 old_val => cp_sll_val_get_el_at(s_vals%values(ik, irs)%list, index=irk)
1407 CALL val_release(old_val)
1408 CALL cp_sll_val_rm_el_at(s_vals%values(ik, irs)%list, index=irk)
1409 END IF
1410 END IF
1411
1412 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 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=1) :: first_key_char, first_sec_char
1434 CHARACTER(LEN=25) :: myfmt
1435 INTEGER :: i_rep_s, ik, isec, ival, nr, nval
1436 INTEGER, SAVE :: indent = 1
1437 LOGICAL :: defaultsection, explicit, &
1438 my_hide_defaults, my_hide_root
1439 TYPE(cp_sll_val_type), POINTER :: new_pos, vals
1440 TYPE(keyword_type), POINTER :: keyword
1441 TYPE(section_type), POINTER :: section
1442 TYPE(section_vals_type), POINTER :: sval
1443 TYPE(val_type), POINTER :: val
1444
1445 my_hide_root = .false.
1446 my_hide_defaults = .true.
1447 IF (PRESENT(hide_root)) my_hide_root = hide_root
1448 IF (PRESENT(hide_defaults)) my_hide_defaults = hide_defaults
1449
1450 cpassert(section_vals%ref_count > 0)
1451 IF (unit_nr > 0) THEN
1452 CALL section_vals_get(section_vals, explicit=explicit, n_repetition=nr, section=section)
1453 IF (ALLOCATED(section%deprecation_notice)) THEN
1454 first_sec_char = "#"
1455 ELSE
1456 first_sec_char = " "
1457 END IF
1458 IF (explicit .OR. (.NOT. my_hide_defaults)) THEN
1459 DO i_rep_s = 1, nr
1460 IF (.NOT. my_hide_root) THEN
1461 WRITE (unit=myfmt, fmt="(A1,I0,A4)") "(", indent, "X,A)"
1462 IF (ASSOCIATED(section%keywords(-1)%keyword)) THEN
1463 WRITE (unit=unit_nr, fmt=myfmt, advance="NO") &
1464 trim(first_sec_char)//default_section_character//trim(adjustl(section%name))
1465 ELSE
1466 WRITE (unit=unit_nr, fmt=myfmt) &
1467 trim(first_sec_char)//default_section_character//trim(adjustl(section%name))
1468 END IF
1469 END IF
1470 defaultsection = (SIZE(section_vals%values, 2) == 0)
1471 IF (.NOT. defaultsection) THEN
1472 IF (.NOT. my_hide_root) indent = indent + incr
1473 WRITE (unit=myfmt, fmt="(A1,I0,A4)") "(", indent, "X,A)"
1474 DO ik = -1, section%n_keywords
1475 keyword => section%keywords(ik)%keyword
1476 IF (ASSOCIATED(keyword)) THEN
1477 IF (ALLOCATED(keyword%deprecation_notice) .OR. &
1478 ALLOCATED(section%deprecation_notice)) THEN
1479 ! Comment deprecated keyword
1480 first_key_char = "#"
1481 ELSE
1482 first_key_char = " "
1483 END IF
1484 IF (keyword%type_of_var /= no_t .AND. keyword%names(1) (1:2) /= "__") THEN
1485 CALL section_vals_val_get(section_vals, keyword%names(1), &
1486 i_rep_s, n_rep_val=nval)
1487 IF (i_rep_s <= SIZE(section_vals%values, 2)) THEN
1488 ! Section was parsed
1489 vals => section_vals%values(ik, i_rep_s)%list
1490 DO ival = 1, nval
1491 IF (ival == 1) THEN
1492 new_pos => vals
1493 ELSE
1494 new_pos => new_pos%rest
1495 END IF
1496 IF (.NOT. ASSOCIATED(new_pos)) THEN
1497 ! this keyword was not parsed
1498 IF (ASSOCIATED(keyword%default_value)) THEN
1499 val => keyword%default_value
1500 IF (my_hide_defaults) cycle
1501 END IF
1502 ELSE
1503 val => new_pos%first_el
1504 END IF
1505 IF (keyword%names(1) /= '_DEFAULT_KEYWORD_' .AND. &
1506 keyword%names(1) /= '_SECTION_PARAMETERS_') THEN
1507 WRITE (unit=unit_nr, fmt=myfmt, advance="NO") &
1508 trim(first_key_char)//trim(keyword%names(1))
1509 ELSE IF (keyword%names(1) == '_DEFAULT_KEYWORD_' .AND. &
1510 keyword%type_of_var /= lchar_t) THEN
1511 WRITE (unit=unit_nr, fmt=myfmt, advance="NO")
1512 END IF
1513 CALL val_write(val, unit_nr=unit_nr, unit=keyword%unit, fmt=myfmt)
1514 END DO
1515 ELSE IF (ASSOCIATED(keyword%default_value)) THEN
1516 ! Section was not parsed but default for the keywords may exist
1517 IF (my_hide_defaults) cycle
1518 val => keyword%default_value
1519 IF (keyword%names(1) /= '_DEFAULT_KEYWORD_' .AND. &
1520 keyword%names(1) /= '_SECTION_PARAMETERS_') THEN
1521 WRITE (unit=unit_nr, fmt=myfmt, advance="NO") &
1522 trim(first_key_char)//trim(keyword%names(1))
1523 ELSE IF (keyword%names(1) == '_DEFAULT_KEYWORD_' .AND. &
1524 keyword%type_of_var /= lchar_t) THEN
1525 WRITE (unit=unit_nr, fmt=myfmt, advance="NO")
1526 END IF
1527 CALL val_write(val, unit_nr=unit_nr, unit=keyword%unit, fmt=myfmt)
1528 END IF
1529 END IF
1530 END IF
1531 END DO
1532 IF (ASSOCIATED(section_vals%subs_vals)) THEN
1533 DO isec = 1, SIZE(section_vals%subs_vals, 1)
1534 sval => section_vals%subs_vals(isec, i_rep_s)%section_vals
1535 IF (ASSOCIATED(sval)) THEN
1536 CALL section_vals_write(sval, unit_nr=unit_nr, hide_defaults=hide_defaults)
1537 END IF
1538 END DO
1539 END IF
1540 END IF
1541 IF (.NOT. my_hide_root) THEN
1542 indent = indent - incr
1543 WRITE (unit=myfmt, fmt="(A1,I0,A4)") "(", indent, "X,A)"
1544 WRITE (unit=unit_nr, fmt=myfmt) &
1545 trim(first_sec_char)//default_section_character// &
1546 "END "//trim(adjustl(section%name))
1547 END IF
1548 END DO
1549 END IF
1550 END IF
1551
1552 END SUBROUTINE section_vals_write
1553
1554! **************************************************************************************************
1555!> \brief writes the values in the given section in xml
1556!> \param section ...
1557!> \param level ...
1558!> \param unit_number ...
1559! **************************************************************************************************
1560 RECURSIVE SUBROUTINE write_section_xml(section, level, unit_number)
1561
1562 TYPE(section_type), POINTER :: section
1563 INTEGER, INTENT(IN) :: level, unit_number
1564
1565 CHARACTER(LEN=3) :: repeats
1566 CHARACTER(LEN=8) :: short_string
1567 INTEGER :: i, l0, l1, l2
1568
1569 IF (ASSOCIATED(section)) THEN
1570
1571 cpassert(section%ref_count > 0)
1572
1573 ! Indentation for current level, next level, etc.
1574
1575 l0 = level
1576 l1 = level + 1
1577 l2 = level + 2
1578
1579 IF (section%repeats) THEN
1580 repeats = "yes"
1581 ELSE
1582 repeats = "no "
1583 END IF
1584
1585 WRITE (unit=unit_number, fmt="(A)") &
1586 repeat(" ", l0)//"<SECTION repeats="""//trim(repeats)//""">", &
1587 repeat(" ", l1)//"<NAME>"//trim(section%name)//"</NAME>", &
1588 repeat(" ", l1)//"<DESCRIPTION>"// &
1589 trim(substitute_special_xml_tokens(a2s(section%description))) &
1590 //"</DESCRIPTION>"
1591
1592 IF (ALLOCATED(section%deprecation_notice)) &
1593 WRITE (unit=unit_number, fmt="(A)") repeat(" ", l1)//"<DEPRECATION_NOTICE>"// &
1594 trim(substitute_special_xml_tokens(section%deprecation_notice)) &
1595 //"</DEPRECATION_NOTICE>"
1596
1597 IF (ASSOCIATED(section%citations)) THEN
1598 DO i = 1, SIZE(section%citations, 1)
1599 short_string = ""
1600 WRITE (unit=short_string, fmt="(I8)") section%citations(i)
1601 WRITE (unit=unit_number, fmt="(A)") &
1602 repeat(" ", l1)//"<REFERENCE>", &
1603 repeat(" ", l2)//"<NAME>"//trim(get_citation_key(section%citations(i)))//"</NAME>", &
1604 repeat(" ", l2)//"<NUMBER>"//trim(adjustl(short_string))//"</NUMBER>", &
1605 repeat(" ", l1)//"</REFERENCE>"
1606 END DO
1607 END IF
1608
1609 WRITE (unit=unit_number, fmt="(A)") &
1610 repeat(" ", l1)//"<LOCATION>"//trim(section%location)//"</LOCATION>"
1611
1612 DO i = -1, section%n_keywords
1613 IF (ASSOCIATED(section%keywords(i)%keyword)) THEN
1614 CALL write_keyword_xml(section%keywords(i)%keyword, l1, unit_number)
1615 END IF
1616 END DO
1617
1618 DO i = 1, section%n_subsections
1619 CALL write_section_xml(section%subsections(i)%section, l1, unit_number)
1620 END DO
1621
1622 WRITE (unit=unit_number, fmt="(A)") repeat(" ", l0)//"</SECTION>"
1623
1624 END IF
1625
1626 END SUBROUTINE write_section_xml
1627
1628! **************************************************************************************************
1629!> \brief ...
1630!> \param section ...
1631!> \param section_name ...
1632!> \param unknown_string ...
1633!> \param location_string ...
1634!> \param matching_rank ...
1635!> \param matching_string ...
1636!> \param bonus ...
1637! **************************************************************************************************
1638 RECURSIVE SUBROUTINE section_typo_match(section, section_name, unknown_string, location_string, &
1639 matching_rank, matching_string, bonus)
1640
1641 TYPE(section_type), INTENT(IN), POINTER :: section
1642 CHARACTER(LEN=*) :: section_name, unknown_string, &
1643 location_string
1644 INTEGER, DIMENSION(:), INTENT(INOUT) :: matching_rank
1645 CHARACTER(LEN=*), DIMENSION(:), INTENT(INOUT) :: matching_string
1646 INTEGER, INTENT(IN) :: bonus
1647
1648 CHARACTER(LEN=LEN(matching_string(1))) :: line
1649 INTEGER :: i, imatch, imax, irank, newbonus
1650
1651 IF (ASSOCIATED(section)) THEN
1652 cpassert(section%ref_count > 0)
1653 imatch = typo_match(trim(section%name), trim(unknown_string))
1654 IF (imatch > 0) THEN
1655 imatch = imatch + bonus
1656 WRITE (unit=line, fmt='(T2,A)') &
1657 " subsection "//trim(adjustl(section%name))// &
1658 " in section "//trim(adjustl(location_string))
1659 imax = SIZE(matching_rank, 1)
1660 irank = imax + 1
1661 DO i = imax, 1, -1
1662 IF (imatch > matching_rank(i)) irank = i
1663 END DO
1664 IF (irank <= imax) THEN
1665 matching_rank(irank + 1:imax) = matching_rank(irank:imax - 1)
1666 matching_string(irank + 1:imax) = matching_string(irank:imax - 1)
1667 matching_rank(irank) = imatch
1668 matching_string(irank) = line
1669 END IF
1670 END IF
1671
1672 IF (section_name == section%name) THEN
1673 newbonus = 10
1674 ELSE
1675 newbonus = 0
1676 END IF
1677
1678 DO i = -1, section%n_keywords
1679 IF (ASSOCIATED(section%keywords(i)%keyword)) THEN
1680 CALL keyword_typo_match(section%keywords(i)%keyword, unknown_string, location_string// &
1681 "%"//trim(section%name), matching_rank, matching_string, newbonus)
1682 END IF
1683 END DO
1684
1685 DO i = 1, section%n_subsections
1686 CALL section_typo_match(section%subsections(i)%section, section_name, unknown_string, &
1687 location_string//"%"//trim(section%name), matching_rank, matching_string, newbonus)
1688 END DO
1689
1690 END IF
1691
1692 END SUBROUTINE section_typo_match
1693
1694! **************************************************************************************************
1695!> \brief replaces of the requested subsection with the one given
1696!> \param section_vals the root section
1697!> \param subsection_name the name of the subsection to replace
1698!> \param new_section_vals the new section_vals to use
1699!> \param i_rep_section index of the repetition of section_vals of which
1700!> you want to replace the subsection (defaults to 1)
1701!> \author fawzi
1702! **************************************************************************************************
1703 SUBROUTINE section_vals_set_subs_vals(section_vals, subsection_name, &
1704 new_section_vals, i_rep_section)
1705 TYPE(section_vals_type), POINTER :: section_vals
1706 CHARACTER(len=*), INTENT(in) :: subsection_name
1707 TYPE(section_vals_type), POINTER :: new_section_vals
1708 INTEGER, INTENT(in), OPTIONAL :: i_rep_section
1709
1710 INTEGER :: irep, isection, len_key, my_index, &
1711 tmp_index
1712 TYPE(section_vals_type), POINTER :: s_vals
1713
1714 cpassert(ASSOCIATED(section_vals))
1715 cpassert(section_vals%ref_count > 0)
1716 cpassert(ASSOCIATED(new_section_vals))
1717 cpassert(new_section_vals%ref_count > 0)
1718
1719 irep = 1
1720 IF (PRESENT(i_rep_section)) irep = i_rep_section
1721
1722 my_index = index(subsection_name, '%') + 1
1723 len_key = len_trim(subsection_name)
1724 IF (my_index > 1) THEN
1725 DO
1726 tmp_index = index(subsection_name(my_index:len_key), "%")
1727 IF (tmp_index <= 0) EXIT
1728 my_index = my_index + tmp_index
1729 END DO
1730 s_vals => section_vals_get_subs_vals(section_vals, subsection_name(1:my_index - 2))
1731 ELSE
1732 s_vals => section_vals
1733 END IF
1734
1735 cpassert(irep <= SIZE(s_vals%subs_vals, 2))
1736
1737 isection = section_get_subsection_index(s_vals%section, subsection_name(my_index:len_trim(subsection_name)))
1738 IF (isection <= 0) &
1739 CALL cp_abort(__location__, &
1740 "could not find subsection "//subsection_name(my_index:len_trim(subsection_name))//" in section "// &
1741 trim(section_vals%section%name)//" at ")
1742 CALL section_vals_retain(new_section_vals)
1743 CALL section_vals_release(s_vals%subs_vals(isection, irep)%section_vals)
1744 s_vals%subs_vals(isection, irep)%section_vals => new_section_vals
1745
1746 END SUBROUTINE section_vals_set_subs_vals
1747
1748! **************************************************************************************************
1749!> \brief creates a deep copy from section_vals_in to section_vals_out
1750!> \param section_vals_in the section_vals to copy
1751!> \param section_vals_out the section_vals to create
1752!> \param i_rep_start ...
1753!> \param i_rep_end ...
1754!> \author fawzi
1755! **************************************************************************************************
1756 SUBROUTINE section_vals_duplicate(section_vals_in, section_vals_out, &
1757 i_rep_start, i_rep_end)
1758 TYPE(section_vals_type), POINTER :: section_vals_in, section_vals_out
1759 INTEGER, INTENT(IN), OPTIONAL :: i_rep_start, i_rep_end
1760
1761 cpassert(ASSOCIATED(section_vals_in))
1762 cpassert(.NOT. ASSOCIATED(section_vals_out))
1763 CALL section_vals_create(section_vals_out, section_vals_in%section)
1764 CALL section_vals_copy(section_vals_in, section_vals_out, i_rep_start, i_rep_end)
1765 END SUBROUTINE section_vals_duplicate
1766
1767! **************************************************************************************************
1768!> \brief 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 where to copy
1771!> \param i_rep_low ...
1772!> \param i_rep_high ...
1773!> \author fawzi
1774!> \note
1775!> private, only works with a newly initialized section_vals_out
1776! **************************************************************************************************
1777 RECURSIVE SUBROUTINE section_vals_copy(section_vals_in, section_vals_out, &
1778 i_rep_low, i_rep_high)
1779 TYPE(section_vals_type), POINTER :: section_vals_in, section_vals_out
1780 INTEGER, INTENT(IN), OPTIONAL :: i_rep_low, i_rep_high
1781
1782 INTEGER :: iend, irep, isec, istart, ival
1783 TYPE(cp_sll_val_type), POINTER :: v1, v2
1784 TYPE(val_type), POINTER :: el
1785
1786 NULLIFY (v2, el)
1787
1788 cpassert(ASSOCIATED(section_vals_in))
1789 cpassert(ASSOCIATED(section_vals_out))
1790 ! IF(.NOT. ASSOCIATED(section_vals_in%section, section_vals_out%section))&
1791 ! CPABORT("")
1792
1793 istart = 1
1794 iend = SIZE(section_vals_in%values, 2)
1795 IF (PRESENT(i_rep_low)) istart = i_rep_low
1796 IF (PRESENT(i_rep_high)) iend = i_rep_high
1797 DO irep = istart, iend
1798 CALL section_vals_add_values(section_vals_out)
1799 DO ival = lbound(section_vals_in%values, 1), ubound(section_vals_in%values, 1)
1800 v1 => section_vals_in%values(ival, irep)%list
1801 IF (ASSOCIATED(v1)) THEN
1802 CALL val_duplicate(v1%first_el, el)
1803 CALL cp_sll_val_create(v2, el)
1804 NULLIFY (el)
1805 section_vals_out%values(ival, irep - istart + 1)%list => v2
1806 DO
1807 IF (.NOT. ASSOCIATED(v1%rest)) EXIT
1808 v1 => v1%rest
1809 CALL val_duplicate(v1%first_el, el)
1810 CALL cp_sll_val_create(v2%rest, first_el=el)
1811 NULLIFY (el)
1812 v2 => v2%rest
1813 END DO
1814 END IF
1815 END DO
1816 END DO
1817 IF (.NOT. PRESENT(i_rep_low) .AND. (.NOT. PRESENT(i_rep_high))) THEN
1818 IF (.NOT. (SIZE(section_vals_in%values, 2) == SIZE(section_vals_out%values, 2))) &
1819 cpabort("")
1820 IF (.NOT. (SIZE(section_vals_in%subs_vals, 2) == SIZE(section_vals_out%subs_vals, 2))) &
1821 cpabort("")
1822 END IF
1823 iend = SIZE(section_vals_in%subs_vals, 2)
1824 IF (PRESENT(i_rep_high)) iend = i_rep_high
1825 DO irep = istart, iend
1826 DO isec = 1, SIZE(section_vals_in%subs_vals, 1)
1827 CALL section_vals_copy(section_vals_in%subs_vals(isec, irep)%section_vals, &
1828 section_vals_out%subs_vals(isec, irep - istart + 1)%section_vals)
1829 END DO
1830 END DO
1831
1832 END SUBROUTINE section_vals_copy
1833
1834END 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:427
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:515
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:649
input_keyword_types::keyword_release
subroutine, public keyword_release(keyword)
releases the given keyword (see doc/ReferenceCounting.html)
Definition input_keyword_types.F:440
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:840
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:1354
input_section_types::section_get_rval
real(kind=dp) function, public section_get_rval(section_vals, keyword_name)
...
Definition input_section_types.F:948
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:1640
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:410
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:1561
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:608
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:1223
input_section_types::section_get_ivals
integer function, dimension(:), pointer, public section_get_ivals(section_vals, keyword_name)
...
Definition input_section_types.F:996
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:786
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:511
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:436
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:896
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:567
input_section_types::section_get_ival
integer function, public section_get_ival(section_vals, keyword_name)
...
Definition input_section_types.F:980
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:1156
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:638
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:731
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:478
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:1426
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:704
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:824
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:1705
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:380
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:1758
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:1047
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:848
input_section_types::section_vals_release
recursive subroutine, public section_vals_release(section_vals)
releases the given object
Definition input_section_types.F:653
input_section_types::section_get_lval
logical function, public section_get_lval(section_vals, keyword_name)
...
Definition input_section_types.F:1012
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:737
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:477
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:341
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