Line data Source code
1 : !--------------------------------------------------------------------------------------------------!
2 : ! CP2K: A general program to perform molecular dynamics simulations !
3 : ! Copyright 2000-2025 CP2K developers group <https://cp2k.org> !
4 : ! !
5 : ! SPDX-License-Identifier: GPL-2.0-or-later !
6 : !--------------------------------------------------------------------------------------------------!
7 :
8 : ! **************************************************************************************************
9 : !> \brief objects that represent the structure of input sections and the data
10 : !> contained in an input section
11 : !> \par History
12 : !> 06.2004 created [fawzi]
13 : !> \author fawzi
14 : ! **************************************************************************************************
15 : MODULE input_section_types
16 :
17 : USE cp_linked_list_input, ONLY: &
18 : cp_sll_val_create, cp_sll_val_dealloc, cp_sll_val_get_el_at, cp_sll_val_get_length, &
19 : cp_sll_val_get_rest, cp_sll_val_insert_el_at, cp_sll_val_next, cp_sll_val_p_type, &
20 : cp_sll_val_rm_el_at, cp_sll_val_set_el_at, cp_sll_val_type
21 : USE cp_log_handling, ONLY: cp_to_string
22 : USE cp_parser_types, ONLY: default_section_character
23 : USE input_keyword_types, ONLY: keyword_describe,&
24 : keyword_p_type,&
25 : keyword_release,&
26 : keyword_retain,&
27 : keyword_type,&
28 : keyword_typo_match,&
29 : write_keyword_xml
30 : USE input_val_types, ONLY: lchar_t,&
31 : no_t,&
32 : val_create,&
33 : val_duplicate,&
34 : val_get,&
35 : val_release,&
36 : val_type,&
37 : val_write
38 : USE kinds, ONLY: default_path_length,&
39 : default_string_length,&
40 : dp
41 : USE print_messages, ONLY: print_message
42 : USE reference_manager, ONLY: get_citation_key
43 : USE string_utilities, ONLY: a2s,&
44 : substitute_special_xml_tokens,&
45 : typo_match,&
46 : uppercase
47 : #include "../base/base_uses.f90"
48 :
49 : IMPLICIT NONE
50 : PRIVATE
51 :
52 : LOGICAL, PRIVATE, PARAMETER :: debug_this_module = .TRUE.
53 : CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'input_section_types'
54 :
55 : PUBLIC :: section_type
56 : PUBLIC :: section_create, section_release, section_describe, &
57 : section_get_subsection, section_get_keyword, &
58 : section_add_keyword, section_add_subsection
59 : PUBLIC :: section_get_subsection_index, section_get_keyword_index
60 :
61 : PUBLIC :: section_vals_type
62 : PUBLIC :: section_vals_create, section_vals_retain, section_vals_release, &
63 : section_vals_get, section_vals_get_subs_vals, section_vals_val_get, section_vals_list_get, &
64 : section_vals_write, section_vals_add_values, section_vals_get_subs_vals2, &
65 : section_vals_val_set, section_vals_val_unset, section_vals_get_subs_vals3, &
66 : section_vals_set_subs_vals, section_vals_duplicate, section_vals_remove_values
67 : PUBLIC :: write_section_xml
68 :
69 : PUBLIC :: section_get_ival, &
70 : section_get_ivals, &
71 : section_get_rval, &
72 : section_get_lval
73 : PUBLIC :: section_typo_match, typo_match_section, typo_matching_rank, typo_matching_line
74 :
75 : ! **************************************************************************************************
76 : !> \brief represent a pointer to a section (to make arrays of pointers)
77 : !> \param section the pointer to the section
78 : !> \author fawzi
79 : ! **************************************************************************************************
80 : TYPE section_p_type
81 : TYPE(section_type), POINTER :: section => NULL()
82 : END TYPE section_p_type
83 :
84 : ! **************************************************************************************************
85 : !> \brief represent a section of the input file
86 : !> \note
87 : !> - frozen: if the section has been frozen (and no keyword/subsections
88 : !> can be added)
89 : !> - repeats: if the section can be repeated more than once in the same
90 : !> context
91 : !> - ref_count: reference count (see doc/ReferenceCounting.html)
92 : !> - n_keywords: the number of keywords in this section
93 : !> - name: name of the section
94 : !> - location where in the source code (file and line) the section is created
95 : !> - description: description of the section
96 : !> - citations: references to literature associated to this section
97 : !> - keywords: array with the keywords of this section (might be
98 : !> oversized)
99 : !> - subsections: sections contained in this section
100 : !> \author fawzi
101 : ! **************************************************************************************************
102 : TYPE section_type
103 : LOGICAL :: frozen = .FALSE., repeats = .FALSE.
104 : INTEGER :: ref_count = 0, n_keywords = 0, n_subsections = 0
105 : CHARACTER(len=default_string_length) :: name = ""
106 : CHARACTER(len=default_string_length) :: location = ""
107 : CHARACTER, DIMENSION(:), POINTER :: description => Null()
108 : CHARACTER(LEN=:), ALLOCATABLE :: deprecation_notice
109 : INTEGER, POINTER, DIMENSION(:) :: citations => NULL()
110 : TYPE(keyword_p_type), DIMENSION(:), POINTER :: keywords => NULL()
111 : TYPE(section_p_type), POINTER, DIMENSION(:) :: subsections => NULL()
112 : END TYPE section_type
113 :
114 : ! **************************************************************************************************
115 : !> \brief repesents a pointer to a parsed section (to make arrays of pointers)
116 : !> \param section_vals the pointer to the parsed section
117 : !> \author fawzi
118 : ! **************************************************************************************************
119 : TYPE section_vals_p_type
120 : TYPE(section_vals_type), POINTER :: section_vals => NULL()
121 : END TYPE section_vals_p_type
122 :
123 : ! **************************************************************************************************
124 : !> \brief stores the values of a section
125 : !> \author fawzi
126 : ! **************************************************************************************************
127 : TYPE section_vals_type
128 : INTEGER :: ref_count = 0
129 : INTEGER, POINTER, DIMENSION(:) :: ibackup => NULL()
130 : TYPE(section_type), POINTER :: section => NULL()
131 : TYPE(cp_sll_val_p_type), DIMENSION(:, :), POINTER :: values => NULL()
132 : TYPE(section_vals_p_type), DIMENSION(:, :), POINTER :: subs_vals => NULL()
133 : END TYPE section_vals_type
134 :
135 : TYPE(section_type), POINTER, SAVE :: typo_match_section => NULL()
136 : INTEGER, PARAMETER :: n_typo_matches = 5
137 : INTEGER, DIMENSION(n_typo_matches) :: typo_matching_rank = 0
138 : CHARACTER(LEN=default_string_length*5), DIMENSION(n_typo_matches):: typo_matching_line = ""
139 :
140 : CONTAINS
141 :
142 : ! **************************************************************************************************
143 : !> \brief creates a list of keywords
144 : !> \param section the list to be created
145 : !> \param location from where in the source code section_create() is called
146 : !> \param name ...
147 : !> \param description ...
148 : !> \param n_keywords hint about the number of keywords, defaults to 10
149 : !> \param n_subsections a hint about how many sections will be added to this
150 : !> structure, defaults to 0
151 : !> \param repeats if this section can repeat (defaults to false)
152 : !> \param citations ...
153 : !> \param deprecation_notice show this warning that the section is deprecated
154 : !> \author fawzi
155 : ! **************************************************************************************************
156 71865767 : SUBROUTINE section_create(section, location, name, description, n_keywords, &
157 4366272 : 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 71865767 : CPASSERT(.NOT. ASSOCIATED(section))
169 71865767 : my_n_keywords = 10
170 71865767 : IF (PRESENT(n_keywords)) my_n_keywords = n_keywords
171 71865767 : my_n_subsections = 0
172 71865767 : IF (PRESENT(n_subsections)) my_n_subsections = n_subsections
173 :
174 71865767 : ALLOCATE (section)
175 71865767 : section%ref_count = 1
176 :
177 : section%n_keywords = 0
178 : section%n_subsections = 0
179 71865767 : section%location = location
180 :
181 71865767 : CPASSERT(LEN_TRIM(name) > 0)
182 71865767 : section%name = name
183 71865767 : CALL uppercase(section%name)
184 :
185 71865767 : n = LEN_TRIM(description)
186 215468253 : ALLOCATE (section%description(n))
187 6767704128 : DO i = 1, n
188 6767704128 : section%description(i) = description(i:i)
189 : END DO
190 :
191 71865767 : section%frozen = .FALSE.
192 71865767 : section%repeats = .FALSE.
193 71865767 : IF (PRESENT(repeats)) section%repeats = repeats
194 :
195 71865767 : NULLIFY (section%citations)
196 71865767 : IF (PRESENT(citations)) THEN
197 13098816 : ALLOCATE (section%citations(SIZE(citations)))
198 12752222 : section%citations = citations
199 : END IF
200 :
201 741029021 : ALLOCATE (section%keywords(-1:my_n_keywords))
202 597297487 : DO i = -1, my_n_keywords
203 597297487 : NULLIFY (section%keywords(i)%keyword)
204 : END DO
205 :
206 155077230 : ALLOCATE (section%subsections(my_n_subsections))
207 79167080 : DO i = 1, my_n_subsections
208 79167080 : NULLIFY (section%subsections(i)%section)
209 : END DO
210 :
211 71865767 : IF (PRESENT(deprecation_notice)) THEN
212 18332 : section%deprecation_notice = TRIM(deprecation_notice)
213 : END IF
214 :
215 71865767 : 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 153262536 : SUBROUTINE section_retain(section)
223 :
224 : TYPE(section_type), POINTER :: section
225 :
226 153262536 : CPASSERT(ASSOCIATED(section))
227 153262536 : CPASSERT(section%ref_count > 0)
228 153262536 : section%ref_count = section%ref_count + 1
229 :
230 153262536 : 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 316936067 : RECURSIVE SUBROUTINE section_release(section)
238 :
239 : TYPE(section_type), POINTER :: section
240 :
241 : INTEGER :: i
242 :
243 316936067 : IF (ASSOCIATED(section)) THEN
244 225128303 : CPASSERT(section%ref_count > 0)
245 225128303 : section%ref_count = section%ref_count - 1
246 225128303 : IF (section%ref_count == 0) THEN
247 71865767 : IF (ASSOCIATED(section%citations)) THEN
248 4366272 : DEALLOCATE (section%citations)
249 : END IF
250 71865767 : IF (ASSOCIATED(section%keywords)) THEN
251 948195034 : DO i = -1, UBOUND(section%keywords, 1)
252 876329267 : CALL keyword_release(section%keywords(i)%keyword)
253 : END DO
254 71865767 : DEALLOCATE (section%keywords)
255 : END IF
256 71865767 : section%n_keywords = 0
257 71865767 : IF (ASSOCIATED(section%subsections)) THEN
258 235471570 : DO i = 1, SIZE(section%subsections)
259 235471570 : CALL section_release(section%subsections(i)%section)
260 : END DO
261 71865767 : DEALLOCATE (section%subsections)
262 : END IF
263 71865767 : DEALLOCATE (section%description)
264 71865767 : DEALLOCATE (section)
265 : END IF
266 225128303 : NULLIFY (section)
267 : END IF
268 :
269 316936067 : END SUBROUTINE section_release
270 :
271 : ! **************************************************************************************************
272 : !> \brief collects additional information on the section for IO + documentation
273 : !> \param section ...
274 : !> \return ...
275 : !> \author fawzi
276 : ! **************************************************************************************************
277 1 : FUNCTION get_section_info(section) RESULT(message)
278 :
279 : TYPE(section_type), INTENT(IN) :: section
280 : CHARACTER(LEN=default_path_length) :: message
281 :
282 : INTEGER :: length
283 :
284 1 : message = " "
285 1 : length = LEN_TRIM(a2s(section%description))
286 1 : IF (length > 0) THEN
287 1 : IF (section%description(length) /= ".") THEN
288 0 : message = "."
289 : END IF
290 : END IF
291 1 : IF (section%repeats) THEN
292 0 : message = TRIM(message)//" This section can be repeated."
293 : ELSE
294 1 : message = TRIM(message)//" This section can not be repeated."
295 : END IF
296 :
297 1 : END FUNCTION get_section_info
298 :
299 : ! **************************************************************************************************
300 : !> \brief prints a description of the given section
301 : !> \param section the section to describe
302 : !> \param unit_nr the unit to write to
303 : !> \param level the level of output: 0: just section name, 1:keywords,
304 : !> then see keyword_describe :-)
305 : !> \param hide_root if the name of the first section should be hidden
306 : !> (defaults to false).
307 : !> \param recurse ...
308 : !> \author fawzi
309 : ! **************************************************************************************************
310 2 : RECURSIVE SUBROUTINE section_describe(section, unit_nr, level, hide_root, recurse)
311 :
312 : TYPE(section_type), INTENT(IN), POINTER :: section
313 : INTEGER, INTENT(in) :: unit_nr, level
314 : LOGICAL, INTENT(in), OPTIONAL :: hide_root
315 : INTEGER, INTENT(in), OPTIONAL :: recurse
316 :
317 : CHARACTER(LEN=default_path_length) :: message
318 : INTEGER :: ikeyword, isub, my_recurse
319 : LOGICAL :: my_hide_root
320 :
321 2 : IF (unit_nr > 0) THEN
322 1 : my_hide_root = .FALSE.
323 1 : IF (PRESENT(hide_root)) my_hide_root = hide_root
324 1 : my_recurse = 0
325 1 : IF (PRESENT(recurse)) my_recurse = recurse
326 1 : IF (ASSOCIATED(section)) THEN
327 1 : CPASSERT(section%ref_count > 0)
328 :
329 1 : IF (.NOT. my_hide_root) &
330 1 : WRITE (UNIT=unit_nr, FMT="('*** section &',A,' ***')") TRIM(ADJUSTL(section%name))
331 1 : IF (level > 1) THEN
332 1 : message = get_section_info(section)
333 1 : CALL print_message(TRIM(a2s(section%description))//TRIM(message), unit_nr, 0, 0, 0)
334 : END IF
335 1 : IF (level > 0) THEN
336 1 : IF (ASSOCIATED(section%keywords(-1)%keyword)) THEN
337 : CALL keyword_describe(section%keywords(-1)%keyword, unit_nr, &
338 0 : level)
339 : END IF
340 1 : IF (ASSOCIATED(section%keywords(0)%keyword)) THEN
341 : CALL keyword_describe(section%keywords(0)%keyword, unit_nr, &
342 0 : level)
343 : END IF
344 20 : DO ikeyword = 1, section%n_keywords
345 : CALL keyword_describe(section%keywords(ikeyword)%keyword, unit_nr, &
346 20 : level)
347 : END DO
348 : END IF
349 1 : IF (section%n_subsections > 0 .AND. my_recurse >= 0) THEN
350 1 : IF (.NOT. my_hide_root) &
351 1 : WRITE (UNIT=unit_nr, FMT="('** subsections **')")
352 15 : DO isub = 1, section%n_subsections
353 15 : IF (my_recurse > 0) THEN
354 : CALL section_describe(section%subsections(isub)%section, unit_nr, &
355 0 : level, recurse=my_recurse - 1)
356 : ELSE
357 14 : WRITE (UNIT=unit_nr, FMT="(1X,A)") section%subsections(isub)%section%name
358 : END IF
359 : END DO
360 : END IF
361 1 : IF (.NOT. my_hide_root) &
362 1 : WRITE (UNIT=unit_nr, FMT="('*** &end section ',A,' ***')") TRIM(ADJUSTL(section%name))
363 : ELSE
364 0 : WRITE (unit_nr, "(a)") '<section *null*>'
365 : END IF
366 : END IF
367 :
368 2 : END SUBROUTINE section_describe
369 :
370 : ! **************************************************************************************************
371 : !> \brief returns the index of requested subsection (-1 if not found)
372 : !> \param section the root section
373 : !> \param subsection_name the name of the subsection you want to get
374 : !> \return ...
375 : !> \author fawzi
376 : !> \note
377 : !> private utility function
378 : ! **************************************************************************************************
379 36783554 : FUNCTION section_get_subsection_index(section, subsection_name) RESULT(res)
380 :
381 : TYPE(section_type), INTENT(IN) :: section
382 : CHARACTER(len=*), INTENT(IN) :: subsection_name
383 : INTEGER :: res
384 :
385 : CHARACTER(len=default_string_length) :: upc_name
386 : INTEGER :: isub
387 :
388 0 : CPASSERT(section%ref_count > 0)
389 36783554 : res = -1
390 36783554 : upc_name = subsection_name
391 36783554 : CALL uppercase(upc_name)
392 294041999 : DO isub = 1, section%n_subsections
393 294041878 : CPASSERT(ASSOCIATED(section%subsections(isub)%section))
394 294041999 : IF (section%subsections(isub)%section%name == upc_name) THEN
395 : res = isub
396 : EXIT
397 : END IF
398 : END DO
399 :
400 36783554 : 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 166 : 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 166 : isub = section_get_subsection_index(section, subsection_name)
418 166 : IF (isub > 0) THEN
419 166 : res => section%subsections(isub)%section
420 : ELSE
421 : NULLIFY (res)
422 : END IF
423 :
424 166 : 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 39330516 : FUNCTION section_get_keyword_index(section, keyword_name) RESULT(res)
436 :
437 : TYPE(section_type), INTENT(IN) :: section
438 : CHARACTER(len=*), INTENT(IN) :: keyword_name
439 : INTEGER :: res
440 :
441 : INTEGER :: ik, in
442 : CHARACTER(len=default_string_length) :: upc_name
443 :
444 0 : CPASSERT(section%ref_count > 0)
445 39330516 : CPASSERT(ASSOCIATED(section%keywords))
446 39330516 : res = -2
447 39330516 : upc_name = keyword_name
448 39330516 : CALL uppercase(upc_name)
449 117991548 : DO ik = -1, 0
450 117991548 : IF (ASSOCIATED(section%keywords(ik)%keyword)) THEN
451 26610034 : IF (section%keywords(ik)%keyword%names(1) == upc_name) THEN
452 8380920 : res = ik
453 : END IF
454 : END IF
455 : END DO
456 39330516 : IF (res == -2) THEN
457 278268350 : k_search_loop: DO ik = 1, section%n_keywords
458 277981780 : CPASSERT(ASSOCIATED(section%keywords(ik)%keyword))
459 543335920 : DO in = 1, SIZE(section%keywords(ik)%keyword%names)
460 543049350 : 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 39330516 : 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 52563 : 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 52563 : IF (INDEX(keyword_name, "%") /= 0) THEN
486 2298 : my_index = INDEX(keyword_name, "%") + 1
487 2298 : CPASSERT(ASSOCIATED(section%subsections))
488 15386 : DO ik = LBOUND(section%subsections, 1), UBOUND(section%subsections, 1)
489 10790 : IF (section%subsections(ik)%section%name == keyword_name(1:my_index - 2)) EXIT
490 : END DO
491 2298 : CPASSERT(ik <= UBOUND(section%subsections, 1))
492 2298 : res => section_get_keyword(section%subsections(ik)%section, keyword_name(my_index:))
493 : ELSE
494 50265 : ik = section_get_keyword_index(section, keyword_name)
495 50265 : IF (ik == -2) THEN
496 : NULLIFY (res)
497 : ELSE
498 50265 : res => section%keywords(ik)%keyword
499 : END IF
500 : END IF
501 :
502 52563 : 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 540973505 : 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 540973505 : TYPE(keyword_p_type), DIMENSION(:), POINTER :: new_keywords
517 :
518 0 : CPASSERT(section%ref_count > 0)
519 540973505 : CPASSERT(.NOT. section%frozen)
520 540973505 : CPASSERT(ASSOCIATED(keyword))
521 540973505 : CPASSERT(keyword%ref_count > 0)
522 540973505 : CALL keyword_retain(keyword)
523 540973505 : IF (keyword%names(1) == "_SECTION_PARAMETERS_") THEN
524 53236253 : CALL keyword_release(section%keywords(-1)%keyword)
525 53236253 : section%keywords(-1)%keyword => keyword
526 487737252 : ELSE IF (keyword%names(1) == "_DEFAULT_KEYWORD_") THEN
527 1949576 : CALL keyword_release(section%keywords(0)%keyword)
528 1949576 : section%keywords(0)%keyword => keyword
529 : ELSE
530 983467493 : DO k = 1, SIZE(keyword%names)
531 4528764187 : DO i = 1, section%n_keywords
532 7701499737 : DO j = 1, SIZE(section%keywords(i)%keyword%names)
533 7203819920 : IF (keyword%names(k) == section%keywords(i)%keyword%names(j)) THEN
534 : CALL cp_abort(__LOCATION__, &
535 : "trying to add a keyword with a name ("// &
536 : TRIM(keyword%names(k))//") that was already used in section " &
537 0 : //TRIM(section%name))
538 : END IF
539 : END DO
540 : END DO
541 : END DO
542 :
543 971575352 : IF (UBOUND(section%keywords, 1) == section%n_keywords) THEN
544 572100754 : ALLOCATE (new_keywords(-1:section%n_keywords + 10))
545 237262618 : DO i = -1, section%n_keywords
546 237262618 : new_keywords(i)%keyword => section%keywords(i)%keyword
547 : END DO
548 334838136 : DO i = section%n_keywords + 1, UBOUND(new_keywords, 1)
549 306934958 : NULLIFY (new_keywords(i)%keyword)
550 : END DO
551 27903178 : DEALLOCATE (section%keywords)
552 27903178 : section%keywords => new_keywords
553 : END IF
554 485787676 : section%n_keywords = section%n_keywords + 1
555 485787676 : section%keywords(section%n_keywords)%keyword => keyword
556 : END IF
557 :
558 540973505 : 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 71823237 : 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 71823237 : TYPE(section_p_type), DIMENSION(:), POINTER :: new_subsections
573 :
574 0 : CPASSERT(section%ref_count > 0)
575 71823237 : CPASSERT(ASSOCIATED(subsection))
576 71823237 : CPASSERT(subsection%ref_count > 0)
577 71823237 : IF (SIZE(section%subsections) < section%n_subsections + 1) THEN
578 1823303825 : ALLOCATE (new_subsections(section%n_subsections + 10))
579 1635738437 : DO i = 1, section%n_subsections
580 1635738437 : new_subsections(i)%section => section%subsections(i)%section
581 : END DO
582 171934939 : DO i = section%n_subsections + 1, SIZE(new_subsections)
583 171934939 : NULLIFY (new_subsections(i)%section)
584 : END DO
585 15630449 : DEALLOCATE (section%subsections)
586 15630449 : section%subsections => new_subsections
587 : END IF
588 16116889038 : DO i = 1, section%n_subsections
589 16045065801 : 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 71823237 : //TRIM(section%name))
594 : END DO
595 71823237 : CALL section_retain(subsection)
596 71823237 : section%n_subsections = section%n_subsections + 1
597 71823237 : section%subsections(section%n_subsections)%section => subsection
598 :
599 71823237 : 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 81439299 : 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 81439299 : CPASSERT(.NOT. ASSOCIATED(section_vals))
615 81439299 : ALLOCATE (section_vals)
616 81439299 : section_vals%ref_count = 1
617 81439299 : CALL section_retain(section)
618 81439299 : section_vals%section => section
619 81439299 : section%frozen = .TRUE.
620 162878598 : ALLOCATE (section_vals%values(-1:section%n_keywords, 0))
621 338569549 : ALLOCATE (section_vals%subs_vals(section%n_subsections, 1))
622 162810636 : DO i = 1, section%n_subsections
623 81371337 : NULLIFY (section_vals%subs_vals(i, 1)%section_vals)
624 : CALL section_vals_create(section_vals%subs_vals(i, 1)%section_vals, &
625 162810636 : section=section%subsections(i)%section)
626 : END DO
627 :
628 81439299 : NULLIFY (section_vals%ibackup)
629 :
630 81439299 : 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 66250 : SUBROUTINE section_vals_retain(section_vals)
638 :
639 : TYPE(section_vals_type), POINTER :: section_vals
640 :
641 66250 : CPASSERT(ASSOCIATED(section_vals))
642 66250 : CPASSERT(section_vals%ref_count > 0)
643 66250 : section_vals%ref_count = section_vals%ref_count + 1
644 :
645 66250 : 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 81519937 : 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 81519937 : IF (ASSOCIATED(section_vals)) THEN
661 81505549 : CPASSERT(section_vals%ref_count > 0)
662 81505549 : section_vals%ref_count = section_vals%ref_count - 1
663 81505549 : IF (section_vals%ref_count == 0) THEN
664 81439299 : CALL section_release(section_vals%section)
665 81710213 : DO j = 1, SIZE(section_vals%values, 2)
666 85272247 : DO i = -1, UBOUND(section_vals%values, 1)
667 3291120 : vals => section_vals%values(i, j)%list
668 4152985 : DO WHILE (cp_sll_val_next(vals, el_att=el))
669 861865 : CALL val_release(el)
670 : END DO
671 3562034 : CALL cp_sll_val_dealloc(section_vals%values(i, j)%list)
672 : END DO
673 : END DO
674 81439299 : DEALLOCATE (section_vals%values)
675 162901058 : DO j = 1, SIZE(section_vals%subs_vals, 2)
676 244328559 : DO i = 1, SIZE(section_vals%subs_vals, 1)
677 162889260 : CALL section_vals_release(section_vals%subs_vals(i, j)%section_vals)
678 : END DO
679 : END DO
680 81439299 : DEALLOCATE (section_vals%subs_vals)
681 81439299 : IF (ASSOCIATED(section_vals%ibackup)) THEN
682 3769 : DEALLOCATE (section_vals%ibackup)
683 : END IF
684 81439299 : DEALLOCATE (section_vals)
685 : END IF
686 : END IF
687 :
688 81519937 : 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 4379946 : 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 4379946 : CPASSERT(section_vals%ref_count > 0)
711 4379946 : IF (PRESENT(ref_count)) ref_count = section_vals%ref_count
712 4379946 : IF (PRESENT(section)) section => section_vals%section
713 4379946 : IF (PRESENT(n_repetition)) n_repetition = SIZE(section_vals%values, 2)
714 4379946 : IF (PRESENT(n_subs_vals_rep)) n_subs_vals_rep = SIZE(section_vals%subs_vals, 2)
715 4379946 : IF (PRESENT(explicit)) explicit = (SIZE(section_vals%values, 2) > 0)
716 :
717 4379946 : 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 36481035 : 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 36481035 : CPASSERT(section_vals%ref_count > 0)
742 :
743 36481035 : my_can_return_null = .FALSE.
744 36481035 : IF (PRESENT(can_return_null)) my_can_return_null = can_return_null
745 36481035 : NULLIFY (res)
746 36481035 : irep = 1
747 36481035 : 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 36481035 : my_index = INDEX(subsection_name, "%")
751 36481035 : IF (my_index .EQ. 0) THEN
752 21387771 : is_path = .FALSE.
753 21387771 : my_index = LEN_TRIM(subsection_name)
754 : ELSE
755 15093264 : is_path = .TRUE.
756 15093264 : irep = 1
757 15093264 : my_index = my_index - 1
758 : END IF
759 :
760 36481035 : CPASSERT(irep <= SIZE(section_vals%subs_vals, 2))
761 :
762 36481035 : isection = section_get_subsection_index(section_vals%section, subsection_name(1:my_index))
763 36481035 : IF (isection > 0) res => section_vals%subs_vals(isection, irep)%section_vals
764 36481035 : IF (.NOT. (ASSOCIATED(res) .OR. my_can_return_null)) &
765 : CALL cp_abort(__LOCATION__, &
766 : "could not find subsection "//TRIM(subsection_name(1:my_index))//" in section "// &
767 0 : TRIM(section_vals%section%name)//" at ")
768 36481035 : 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 15093264 : i_rep_section, can_return_null)
771 : END IF
772 :
773 36481035 : 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 951765 : 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 951765 : CPASSERT(ASSOCIATED(section_vals))
795 951765 : CPASSERT(section_vals%ref_count > 0)
796 951765 : NULLIFY (res)
797 951765 : irep = 1
798 951765 : IF (PRESENT(i_rep_section)) irep = i_rep_section
799 951765 : CPASSERT(irep <= SIZE(section_vals%subs_vals, 2))
800 951765 : isect_att = 0
801 510414120 : DO i = 1, section_vals%section%n_subsections
802 510414120 : IF (SIZE(section_vals%subs_vals(i, irep)%section_vals%values, 2) > 0) THEN
803 1029009 : isect_att = isect_att + 1
804 1029009 : 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 951765 : 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 73848 : 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 73848 : CPASSERT(section_vals%ref_count > 0)
833 73848 : NULLIFY (res)
834 73848 : irep = 1
835 73848 : IF (PRESENT(i_rep_section)) irep = i_rep_section
836 73848 : CPASSERT(irep <= SIZE(section_vals%subs_vals, 2))
837 73848 : i_section = section_get_subsection_index(section_vals%section, subsection_name)
838 73848 : res => section_vals%subs_vals(i_section, irep)%section_vals
839 :
840 73848 : 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 280654 : SUBROUTINE section_vals_add_values(section_vals)
848 :
849 : TYPE(section_vals_type), INTENT(INOUT) :: section_vals
850 :
851 : INTEGER :: i, j
852 280654 : TYPE(cp_sll_val_p_type), DIMENSION(:, :), POINTER :: new_values
853 : TYPE(section_vals_p_type), DIMENSION(:, :), &
854 280654 : POINTER :: new_sps
855 :
856 0 : CPASSERT(section_vals%ref_count > 0)
857 5648622 : ALLOCATE (new_values(-1:UBOUND(section_vals%values, 1), SIZE(section_vals%values, 2) + 1))
858 338040 : DO j = 1, SIZE(section_vals%values, 2)
859 1213917 : DO i = -1, UBOUND(section_vals%values, 1)
860 875877 : new_values(i, j)%list => section_vals%values(i, j)%list
861 : END DO
862 : END DO
863 280654 : DEALLOCATE (section_vals%values)
864 280654 : section_vals%values => new_values
865 280654 : j = SIZE(new_values, 2)
866 3930783 : DO i = -1, UBOUND(new_values, 1)
867 3650129 : NULLIFY (new_values(i, j)%list)
868 : END DO
869 :
870 280654 : IF (SIZE(new_values, 2) > 1) THEN
871 : ALLOCATE (new_sps(SIZE(section_vals%subs_vals, 1), &
872 336558 : SIZE(section_vals%subs_vals, 2) + 1))
873 79846 : DO j = 1, SIZE(section_vals%subs_vals, 2)
874 204160 : DO i = 1, SIZE(section_vals%subs_vals, 1)
875 181700 : new_sps(i, j)%section_vals => section_vals%subs_vals(i, j)%section_vals
876 : END DO
877 : END DO
878 22460 : DEALLOCATE (section_vals%subs_vals)
879 22460 : section_vals%subs_vals => new_sps
880 22460 : j = SIZE(new_sps, 2)
881 78624 : DO i = 1, SIZE(new_sps, 1)
882 56164 : NULLIFY (new_sps(i, j)%section_vals)
883 : CALL section_vals_create(new_sps(i, SIZE(new_sps, 2))%section_vals, &
884 78624 : section=section_vals%section%subsections(i)%section)
885 : END DO
886 : END IF
887 :
888 280654 : 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 68937 : SUBROUTINE section_vals_remove_values(section_vals)
896 :
897 : TYPE(section_vals_type), POINTER :: section_vals
898 :
899 : INTEGER :: i, j
900 68937 : 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 68937 : IF (ASSOCIATED(section_vals)) THEN
905 68937 : CPASSERT(section_vals%ref_count > 0)
906 68937 : NULLIFY (el, vals)
907 : ! Allocate a null 0 dimension array of values
908 206811 : ALLOCATE (new_values(-1:section_vals%section%n_keywords, 0))
909 : ! Release old values
910 78677 : DO j = 1, SIZE(section_vals%values, 2)
911 166772 : DO i = -1, UBOUND(section_vals%values, 1)
912 78355 : vals => section_vals%values(i, j)%list
913 668648 : DO WHILE (cp_sll_val_next(vals, el_att=el))
914 590293 : CALL val_release(el)
915 : END DO
916 88095 : CALL cp_sll_val_dealloc(section_vals%values(i, j)%list)
917 : END DO
918 : END DO
919 68937 : DEALLOCATE (section_vals%values)
920 68937 : section_vals%values => new_values
921 : END IF
922 :
923 68937 : END SUBROUTINE section_vals_remove_values
924 :
925 : ! **************************************************************************************************
926 : !> \brief ...
927 : !> \param section_vals ...
928 : !> \param keyword_name ...
929 : !> \return ...
930 : ! **************************************************************************************************
931 0 : FUNCTION section_get_cval(section_vals, keyword_name) RESULT(res)
932 :
933 : TYPE(section_vals_type), INTENT(IN) :: section_vals
934 : CHARACTER(len=*), INTENT(in) :: keyword_name
935 : CHARACTER(LEN=default_string_length) :: res
936 :
937 0 : CALL section_vals_val_get(section_vals, keyword_name, c_val=res)
938 :
939 0 : END FUNCTION section_get_cval
940 :
941 : ! **************************************************************************************************
942 : !> \brief ...
943 : !> \param section_vals ...
944 : !> \param keyword_name ...
945 : !> \return ...
946 : ! **************************************************************************************************
947 457900 : 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 457900 : CALL section_vals_val_get(section_vals, keyword_name, r_val=res)
954 :
955 457900 : END FUNCTION section_get_rval
956 :
957 : ! **************************************************************************************************
958 : !> \brief ...
959 : !> \param section_vals ...
960 : !> \param keyword_name ...
961 : !> \return ...
962 : ! **************************************************************************************************
963 0 : FUNCTION section_get_rvals(section_vals, keyword_name) RESULT(res)
964 :
965 : TYPE(section_vals_type), INTENT(IN) :: section_vals
966 : CHARACTER(len=*), INTENT(in) :: keyword_name
967 : REAL(kind=dp), DIMENSION(:), POINTER :: res
968 :
969 0 : CALL section_vals_val_get(section_vals, keyword_name, r_vals=res)
970 :
971 0 : END FUNCTION section_get_rvals
972 :
973 : ! **************************************************************************************************
974 : !> \brief ...
975 : !> \param section_vals ...
976 : !> \param keyword_name ...
977 : !> \return ...
978 : ! **************************************************************************************************
979 383286 : 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 383286 : CALL section_vals_val_get(section_vals, keyword_name, i_val=res)
986 :
987 383286 : END FUNCTION section_get_ival
988 :
989 : ! **************************************************************************************************
990 : !> \brief ...
991 : !> \param section_vals ...
992 : !> \param keyword_name ...
993 : !> \return ...
994 : ! **************************************************************************************************
995 4912 : 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 4912 : CALL section_vals_val_get(section_vals, keyword_name, i_vals=res)
1002 :
1003 4912 : END FUNCTION section_get_ivals
1004 :
1005 : ! **************************************************************************************************
1006 : !> \brief ...
1007 : !> \param section_vals ...
1008 : !> \param keyword_name ...
1009 : !> \return ...
1010 : ! **************************************************************************************************
1011 92863 : 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 92863 : CALL section_vals_val_get(section_vals, keyword_name, l_val=res)
1018 :
1019 92863 : 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 38191628 : 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 38191628 : CPASSERT(section_vals%ref_count > 0)
1074 :
1075 38191628 : my_index = INDEX(keyword_name, '%') + 1
1076 38191628 : len_key = LEN_TRIM(keyword_name)
1077 38191628 : IF (my_index > 1) THEN
1078 2779458 : DO
1079 10927478 : tmp_index = INDEX(keyword_name(my_index:len_key), "%")
1080 10927478 : IF (tmp_index <= 0) EXIT
1081 2779458 : my_index = my_index + tmp_index
1082 : END DO
1083 8148020 : 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 38191628 : irk = 1
1089 38191628 : irs = 1
1090 38191628 : IF (PRESENT(i_rep_section)) irs = i_rep_section
1091 38191628 : IF (PRESENT(i_rep_val)) irk = i_rep_val
1092 38191628 : IF (PRESENT(val)) NULLIFY (val)
1093 38191628 : IF (PRESENT(explicit)) explicit = .FALSE.
1094 38191628 : 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 38191628 : PRESENT(r_vals) .OR. PRESENT(c_vals)
1098 38191628 : ik = section_get_keyword_index(s_vals%section, keyword_name(my_index:len_key))
1099 38191628 : IF (ik == -2) &
1100 : CALL cp_abort(__LOCATION__, &
1101 : "section "//TRIM(section%name)//" does not contain keyword "// &
1102 0 : TRIM(keyword_name(my_index:len_key)))
1103 38191628 : keyword => section%keywords(ik)%keyword
1104 38191628 : IF (.NOT. (irs > 0 .AND. irs <= SIZE(s_vals%subs_vals, 2))) &
1105 : CALL cp_abort(__LOCATION__, &
1106 : "section repetition requested ("//cp_to_string(irs)// &
1107 : ") out of bounds (1:"//cp_to_string(SIZE(s_vals%subs_vals, 2)) &
1108 0 : //")")
1109 38191628 : NULLIFY (my_val)
1110 38191628 : IF (PRESENT(n_rep_val)) n_rep_val = 0
1111 38191628 : IF (irs <= SIZE(s_vals%values, 2)) THEN ! the section was parsed
1112 10385499 : vals => s_vals%values(ik, irs)%list
1113 10385499 : IF (PRESENT(n_rep_val)) n_rep_val = cp_sll_val_get_length(vals)
1114 10385499 : IF (.NOT. ASSOCIATED(vals)) THEN
1115 : ! this keyword was not parsed
1116 6810998 : IF (ASSOCIATED(keyword%default_value)) THEN
1117 6309420 : my_val => keyword%default_value
1118 6309420 : 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 3574501 : irk)
1123 3574501 : IF (PRESENT(explicit)) explicit = .TRUE.
1124 : END IF
1125 27806129 : ELSE IF (ASSOCIATED(keyword%default_value)) THEN
1126 27770873 : IF (PRESENT(n_rep_val)) n_rep_val = 1
1127 27770873 : my_val => keyword%default_value
1128 : END IF
1129 38191628 : IF (PRESENT(val)) val => my_val
1130 38191628 : IF (valRequested) THEN
1131 35424583 : IF (.NOT. ASSOCIATED(my_val)) &
1132 : CALL cp_abort(__LOCATION__, &
1133 : "Value requested, but no value set getting value from "// &
1134 : "keyword "//TRIM(keyword_name(my_index:len_key))//" of section "// &
1135 0 : TRIM(section%name))
1136 : CALL val_get(my_val, l_val=l_val, i_val=i_val, r_val=r_val, &
1137 : c_val=c_val, l_vals=l_vals, i_vals=i_vals, r_vals=r_vals, &
1138 104264478 : c_vals=c_vals)
1139 : END IF
1140 :
1141 38191628 : 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 9113 : 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 9113 : CPASSERT(ASSOCIATED(section_vals))
1167 9113 : CPASSERT(section_vals%ref_count > 0)
1168 9113 : NULLIFY (list)
1169 9113 : my_index = INDEX(keyword_name, '%') + 1
1170 9113 : len_key = LEN_TRIM(keyword_name)
1171 9113 : IF (my_index > 1) THEN
1172 0 : DO
1173 0 : tmp_index = INDEX(keyword_name(my_index:len_key), "%")
1174 0 : IF (tmp_index <= 0) EXIT
1175 0 : my_index = my_index + tmp_index
1176 : END DO
1177 0 : s_vals => section_vals_get_subs_vals(section_vals, keyword_name(1:my_index - 2))
1178 : ELSE
1179 9113 : s_vals => section_vals
1180 : END IF
1181 :
1182 9113 : irs = 1
1183 9113 : IF (PRESENT(i_rep_section)) irs = i_rep_section
1184 9113 : section => s_vals%section
1185 9113 : ik = section_get_keyword_index(s_vals%section, keyword_name(my_index:len_key))
1186 9113 : IF (ik == -2) &
1187 : CALL cp_abort(__LOCATION__, &
1188 : "section "//TRIM(section%name)//" does not contain keyword "// &
1189 0 : TRIM(keyword_name(my_index:len_key)))
1190 9113 : IF (.NOT. (irs > 0 .AND. irs <= SIZE(s_vals%subs_vals, 2))) &
1191 : CALL cp_abort(__LOCATION__, &
1192 : "section repetition requested ("//cp_to_string(irs)// &
1193 : ") out of bounds (1:"//cp_to_string(SIZE(s_vals%subs_vals, 2)) &
1194 0 : //")")
1195 9113 : list => s_vals%values(ik, irs)%list
1196 :
1197 9113 : 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 358824 : 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 358824 : CPASSERT(ASSOCIATED(section_vals))
1248 358824 : CPASSERT(section_vals%ref_count > 0)
1249 :
1250 358824 : my_index = INDEX(keyword_name, '%') + 1
1251 358824 : len_key = LEN_TRIM(keyword_name)
1252 358824 : IF (my_index > 1) THEN
1253 8126 : DO
1254 86249 : tmp_index = INDEX(keyword_name(my_index:len_key), "%")
1255 86249 : IF (tmp_index <= 0) EXIT
1256 8126 : my_index = my_index + tmp_index
1257 : END DO
1258 78123 : s_vals => section_vals_get_subs_vals(section_vals, keyword_name(1:my_index - 2))
1259 : ELSE
1260 280701 : s_vals => section_vals
1261 : END IF
1262 :
1263 358824 : irk = 1
1264 358824 : irs = 1
1265 358824 : IF (PRESENT(i_rep_section)) irs = i_rep_section
1266 358824 : IF (PRESENT(i_rep_val)) irk = i_rep_val
1267 358824 : section => s_vals%section
1268 358824 : ik = section_get_keyword_index(s_vals%section, keyword_name(my_index:len_key))
1269 358824 : IF (ik == -2) &
1270 : CALL cp_abort(__LOCATION__, &
1271 : "section "//TRIM(section%name)//" does not contain keyword "// &
1272 0 : TRIM(keyword_name(my_index:len_key)))
1273 : ! Add values..
1274 25767 : DO
1275 384591 : IF (irs <= SIZE(s_vals%values, 2)) EXIT
1276 25767 : CALL section_vals_add_values(s_vals)
1277 : END DO
1278 358824 : IF (.NOT. (irs > 0 .AND. irs <= SIZE(s_vals%subs_vals, 2))) &
1279 : CALL cp_abort(__LOCATION__, &
1280 : "section repetition requested ("//cp_to_string(irs)// &
1281 : ") out of bounds (1:"//cp_to_string(SIZE(s_vals%subs_vals, 2)) &
1282 0 : //")")
1283 358824 : keyword => s_vals%section%keywords(ik)%keyword
1284 358824 : NULLIFY (my_val)
1285 358824 : 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 358824 : PRESENT(r_vals_ptr) .OR. PRESENT(c_vals_ptr)
1289 358824 : IF (ASSOCIATED(my_val)) THEN
1290 : ! check better?
1291 0 : IF (valSet) &
1292 : CALL cp_abort(__LOCATION__, &
1293 : " both val and values present, in setting "// &
1294 : "keyword "//TRIM(keyword_name(my_index:len_key))//" of section "// &
1295 0 : TRIM(section%name))
1296 : ELSE
1297 : ! ignore ?
1298 358824 : IF (.NOT. valSet) &
1299 : CALL cp_abort(__LOCATION__, &
1300 : " empty value in setting "// &
1301 : "keyword "//TRIM(keyword_name(my_index:len_key))//" of section "// &
1302 0 : TRIM(section%name))
1303 0 : CPASSERT(valSet)
1304 358824 : IF (keyword%type_of_var == lchar_t) THEN
1305 106848 : 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 910838 : c_vals_ptr=c_vals_ptr, enum=keyword%enum)
1311 : END IF
1312 358824 : CPASSERT(ASSOCIATED(my_val))
1313 358824 : CPASSERT(my_val%type_of_var == keyword%type_of_var)
1314 : END IF
1315 358824 : vals => s_vals%values(ik, irs)%list
1316 358824 : IF (irk == -1) THEN
1317 0 : CALL cp_sll_val_insert_el_at(vals, my_val, index=-1)
1318 358824 : ELSE IF (irk <= cp_sll_val_get_length(vals)) THEN
1319 213251 : IF (irk <= 0) &
1320 : CALL cp_abort(__LOCATION__, &
1321 : "invalid irk "//TRIM(ADJUSTL(cp_to_string(irk)))// &
1322 : " in keyword "//TRIM(keyword_name(my_index:len_key))//" of section "// &
1323 0 : TRIM(section%name))
1324 213251 : old_val => cp_sll_val_get_el_at(vals, index=irk)
1325 213251 : CALL val_release(old_val)
1326 213251 : CALL cp_sll_val_set_el_at(vals, value=my_val, index=irk)
1327 145573 : ELSE IF (irk > cp_sll_val_get_length(vals) + 1) THEN
1328 : ! change?
1329 : CALL cp_abort(__LOCATION__, &
1330 : "cannot add extra keyword repetitions to keyword" &
1331 : //TRIM(keyword_name(my_index:len_key))//" of section "// &
1332 0 : TRIM(section%name))
1333 : ELSE
1334 145573 : CALL cp_sll_val_insert_el_at(vals, my_val, index=irk)
1335 : END IF
1336 358824 : s_vals%values(ik, irs)%list => vals
1337 : NULLIFY (my_val)
1338 358824 : 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 37954 : 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 37954 : NULLIFY (pos)
1367 37954 : CPASSERT(ASSOCIATED(section_vals))
1368 37954 : CPASSERT(section_vals%ref_count > 0)
1369 :
1370 37954 : my_index = INDEX(keyword_name, '%') + 1
1371 37954 : len_key = LEN_TRIM(keyword_name)
1372 37954 : IF (my_index > 1) THEN
1373 320 : DO
1374 696 : tmp_index = INDEX(keyword_name(my_index:len_key), "%")
1375 696 : IF (tmp_index <= 0) EXIT
1376 320 : my_index = my_index + tmp_index
1377 : END DO
1378 376 : s_vals => section_vals_get_subs_vals(section_vals, keyword_name(1:my_index - 2))
1379 : ELSE
1380 37578 : s_vals => section_vals
1381 : END IF
1382 :
1383 37954 : irk = 1
1384 37954 : irs = 1
1385 37954 : IF (PRESENT(i_rep_section)) irs = i_rep_section
1386 37954 : IF (PRESENT(i_rep_val)) irk = i_rep_val
1387 37954 : section => s_vals%section
1388 37954 : ik = section_get_keyword_index(s_vals%section, keyword_name(my_index:len_key))
1389 37954 : IF (ik == -2) &
1390 : CALL cp_abort(__LOCATION__, &
1391 : "section "//TRIM(section%name)//" does not contain keyword "// &
1392 0 : TRIM(keyword_name(my_index:len_key)))
1393 : ! ignore unset of non set values
1394 37954 : IF (irs <= SIZE(s_vals%values, 2)) THEN
1395 37954 : IF (.NOT. (irs > 0 .AND. irs <= SIZE(s_vals%subs_vals, 2))) &
1396 : CALL cp_abort(__LOCATION__, &
1397 : "section repetition requested ("//cp_to_string(irs)// &
1398 : ") out of bounds (1:"//cp_to_string(SIZE(s_vals%subs_vals, 2)) &
1399 0 : //")")
1400 37954 : IF (irk == -1) THEN
1401 0 : pos => cp_sll_val_get_rest(s_vals%values(ik, irs)%list, iter=-1)
1402 : ELSE
1403 37954 : pos => cp_sll_val_get_rest(s_vals%values(ik, irs)%list, iter=irk - 1)
1404 : END IF
1405 37954 : IF (ASSOCIATED(pos)) THEN
1406 7380 : old_val => cp_sll_val_get_el_at(s_vals%values(ik, irs)%list, index=irk)
1407 7380 : CALL val_release(old_val)
1408 7380 : CALL cp_sll_val_rm_el_at(s_vals%values(ik, irs)%list, index=irk)
1409 : END IF
1410 : END IF
1411 :
1412 37954 : 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 2388638 : RECURSIVE SUBROUTINE section_vals_write(section_vals, unit_nr, hide_root, hide_defaults)
1426 :
1427 : TYPE(section_vals_type), INTENT(IN) :: section_vals
1428 : INTEGER, INTENT(in) :: unit_nr
1429 : LOGICAL, INTENT(in), OPTIONAL :: hide_root, hide_defaults
1430 :
1431 : INTEGER, PARAMETER :: incr = 2
1432 :
1433 : CHARACTER(len=default_string_length) :: myfmt
1434 : INTEGER :: i_rep_s, ik, isec, ival, nr, nval
1435 : INTEGER, SAVE :: indent = 1
1436 : LOGICAL :: defaultSection, explicit, &
1437 : my_hide_defaults, my_hide_root
1438 : TYPE(cp_sll_val_type), POINTER :: new_pos, vals
1439 : TYPE(keyword_type), POINTER :: keyword
1440 : TYPE(section_type), POINTER :: section
1441 : TYPE(section_vals_type), POINTER :: sval
1442 : TYPE(val_type), POINTER :: val
1443 :
1444 2388638 : my_hide_root = .FALSE.
1445 2388638 : my_hide_defaults = .TRUE.
1446 2388638 : IF (PRESENT(hide_root)) my_hide_root = hide_root
1447 2388638 : IF (PRESENT(hide_defaults)) my_hide_defaults = hide_defaults
1448 :
1449 2388638 : CPASSERT(section_vals%ref_count > 0)
1450 2388638 : IF (unit_nr > 0) THEN
1451 2388623 : CALL section_vals_get(section_vals, explicit=explicit, n_repetition=nr, section=section)
1452 2388623 : IF (explicit .OR. (.NOT. my_hide_defaults)) THEN
1453 577415 : DO i_rep_s = 1, nr
1454 292914 : IF (.NOT. my_hide_root) THEN
1455 284410 : WRITE (UNIT=myfmt, FMT="(I0,A1)") indent, "X"
1456 284410 : IF (ASSOCIATED(section%keywords(-1)%keyword)) THEN
1457 : WRITE (UNIT=unit_nr, FMT="("//TRIM(myfmt)//",A)", ADVANCE="NO") &
1458 58589 : default_section_character//TRIM(ADJUSTL(section%name))
1459 : ELSE
1460 : WRITE (UNIT=unit_nr, FMT="("//TRIM(myfmt)//",A)") &
1461 225821 : default_section_character//TRIM(ADJUSTL(section%name))
1462 : END IF
1463 : END IF
1464 292914 : defaultSection = (SIZE(section_vals%values, 2) == 0)
1465 292914 : IF (.NOT. defaultSection) THEN
1466 292914 : IF (.NOT. my_hide_root) indent = indent + incr
1467 292914 : WRITE (UNIT=myfmt, FMT="(I0,A1)") indent, "X"
1468 3102715 : DO ik = -1, section%n_keywords
1469 2809801 : keyword => section%keywords(ik)%keyword
1470 3102715 : IF (ASSOCIATED(keyword)) THEN
1471 2313409 : IF (keyword%type_of_var /= no_t .AND. keyword%names(1) (1:2) /= "__") THEN
1472 : CALL section_vals_val_get(section_vals, keyword%names(1), &
1473 2252740 : i_rep_s, n_rep_val=nval)
1474 2252740 : IF (i_rep_s <= SIZE(section_vals%values, 2)) THEN
1475 : ! Section was parsed
1476 2252740 : vals => section_vals%values(ik, i_rep_s)%list
1477 5634572 : DO ival = 1, nval
1478 3381832 : IF (ival == 1) THEN
1479 : new_pos => vals
1480 : ELSE
1481 1292098 : new_pos => new_pos%rest
1482 : END IF
1483 3381832 : IF (.NOT. ASSOCIATED(new_pos)) THEN
1484 : ! this keyword was not parsed
1485 1501153 : IF (ASSOCIATED(keyword%default_value)) THEN
1486 1501153 : val => keyword%default_value
1487 1501153 : IF (my_hide_defaults) CYCLE
1488 : END IF
1489 : ELSE
1490 1880679 : val => new_pos%first_el
1491 : END IF
1492 1887993 : IF (keyword%names(1) /= '_DEFAULT_KEYWORD_' .AND. &
1493 : keyword%names(1) /= '_SECTION_PARAMETERS_') THEN
1494 : WRITE (UNIT=unit_nr, FMT="("//TRIM(myfmt)//",A)", ADVANCE="NO") &
1495 507713 : TRIM(keyword%names(1))
1496 1380280 : ELSE IF (keyword%names(1) == '_DEFAULT_KEYWORD_' .AND. &
1497 : keyword%type_of_var /= lchar_t) THEN
1498 450493 : WRITE (UNIT=unit_nr, FMT="("//TRIM(myfmt)//")", ADVANCE="NO")
1499 : END IF
1500 5634572 : CALL val_write(val, unit_nr=unit_nr, unit=keyword%unit, fmt=myfmt)
1501 : END DO
1502 0 : ELSE IF (ASSOCIATED(keyword%default_value)) THEN
1503 : ! Section was not parsed but default for the keywords may exist
1504 0 : IF (my_hide_defaults) CYCLE
1505 0 : val => keyword%default_value
1506 0 : IF (keyword%names(1) /= '_DEFAULT_KEYWORD_' .AND. &
1507 : keyword%names(1) /= '_SECTION_PARAMETERS_') THEN
1508 : WRITE (UNIT=unit_nr, FMT="("//TRIM(myfmt)//",A)", ADVANCE="NO") &
1509 0 : TRIM(keyword%names(1))
1510 0 : ELSE IF (keyword%names(1) == '_DEFAULT_KEYWORD_' .AND. &
1511 : keyword%type_of_var /= lchar_t) THEN
1512 0 : WRITE (UNIT=unit_nr, FMT="("//TRIM(myfmt)//")", ADVANCE="NO")
1513 : END IF
1514 0 : CALL val_write(val, unit_nr=unit_nr, unit=keyword%unit, fmt=myfmt)
1515 : END IF
1516 : END IF
1517 : END IF
1518 : END DO
1519 292914 : IF (ASSOCIATED(section_vals%subs_vals)) THEN
1520 2673033 : DO isec = 1, SIZE(section_vals%subs_vals, 1)
1521 2380119 : sval => section_vals%subs_vals(isec, i_rep_s)%section_vals
1522 2673033 : IF (ASSOCIATED(sval)) THEN
1523 2380119 : CALL section_vals_write(sval, unit_nr=unit_nr, hide_defaults=hide_defaults)
1524 : END IF
1525 : END DO
1526 : END IF
1527 : END IF
1528 2681537 : IF (.NOT. my_hide_root) THEN
1529 284410 : indent = indent - incr
1530 284410 : WRITE (UNIT=myfmt, FMT="(I0,A1)") indent, "X"
1531 : WRITE (UNIT=unit_nr, FMT="("//TRIM(myfmt)//",A)") &
1532 284410 : default_section_character//"END "//TRIM(ADJUSTL(section%name))
1533 : END IF
1534 : END DO
1535 : END IF
1536 : END IF
1537 :
1538 2388638 : END SUBROUTINE section_vals_write
1539 :
1540 : ! **************************************************************************************************
1541 : !> \brief writes the values in the given section in xml
1542 : !> \param section ...
1543 : !> \param level ...
1544 : !> \param unit_number ...
1545 : ! **************************************************************************************************
1546 0 : RECURSIVE SUBROUTINE write_section_xml(section, level, unit_number)
1547 :
1548 : TYPE(section_type), POINTER :: section
1549 : INTEGER, INTENT(IN) :: level, unit_number
1550 :
1551 : CHARACTER(LEN=3) :: repeats
1552 : CHARACTER(LEN=8) :: short_string
1553 : INTEGER :: i, l0, l1, l2
1554 :
1555 0 : IF (ASSOCIATED(section)) THEN
1556 :
1557 0 : CPASSERT(section%ref_count > 0)
1558 :
1559 : ! Indentation for current level, next level, etc.
1560 :
1561 0 : l0 = level
1562 0 : l1 = level + 1
1563 0 : l2 = level + 2
1564 :
1565 0 : IF (section%repeats) THEN
1566 0 : repeats = "yes"
1567 : ELSE
1568 0 : repeats = "no "
1569 : END IF
1570 :
1571 0 : WRITE (UNIT=unit_number, FMT="(A)") &
1572 0 : REPEAT(" ", l0)//"<SECTION repeats="""//TRIM(repeats)//""">", &
1573 0 : REPEAT(" ", l1)//"<NAME>"//TRIM(section%name)//"</NAME>", &
1574 : REPEAT(" ", l1)//"<DESCRIPTION>"// &
1575 : TRIM(substitute_special_xml_tokens(a2s(section%description))) &
1576 0 : //"</DESCRIPTION>"
1577 :
1578 0 : IF (ALLOCATED(section%deprecation_notice)) &
1579 : WRITE (UNIT=unit_number, FMT="(A)") REPEAT(" ", l1)//"<DEPRECATION_NOTICE>"// &
1580 : TRIM(substitute_special_xml_tokens(section%deprecation_notice)) &
1581 0 : //"</DEPRECATION_NOTICE>"
1582 :
1583 0 : IF (ASSOCIATED(section%citations)) THEN
1584 0 : DO i = 1, SIZE(section%citations, 1)
1585 0 : short_string = ""
1586 0 : WRITE (UNIT=short_string, FMT="(I8)") section%citations(i)
1587 0 : WRITE (UNIT=unit_number, FMT="(A)") &
1588 0 : REPEAT(" ", l1)//"<REFERENCE>", &
1589 0 : REPEAT(" ", l2)//"<NAME>"//TRIM(get_citation_key(section%citations(i)))//"</NAME>", &
1590 0 : REPEAT(" ", l2)//"<NUMBER>"//TRIM(ADJUSTL(short_string))//"</NUMBER>", &
1591 0 : REPEAT(" ", l1)//"</REFERENCE>"
1592 : END DO
1593 : END IF
1594 :
1595 0 : WRITE (UNIT=unit_number, FMT="(A)") &
1596 0 : REPEAT(" ", l1)//"<LOCATION>"//TRIM(section%location)//"</LOCATION>"
1597 :
1598 0 : DO i = -1, section%n_keywords
1599 0 : IF (ASSOCIATED(section%keywords(i)%keyword)) THEN
1600 0 : CALL write_keyword_xml(section%keywords(i)%keyword, l1, unit_number)
1601 : END IF
1602 : END DO
1603 :
1604 0 : DO i = 1, section%n_subsections
1605 0 : CALL write_section_xml(section%subsections(i)%section, l1, unit_number)
1606 : END DO
1607 :
1608 0 : WRITE (UNIT=unit_number, FMT="(A)") REPEAT(" ", l0)//"</SECTION>"
1609 :
1610 : END IF
1611 :
1612 0 : END SUBROUTINE write_section_xml
1613 :
1614 : ! **************************************************************************************************
1615 : !> \brief ...
1616 : !> \param section ...
1617 : !> \param section_name ...
1618 : !> \param unknown_string ...
1619 : !> \param location_string ...
1620 : !> \param matching_rank ...
1621 : !> \param matching_string ...
1622 : !> \param bonus ...
1623 : ! **************************************************************************************************
1624 0 : RECURSIVE SUBROUTINE section_typo_match(section, section_name, unknown_string, location_string, &
1625 0 : matching_rank, matching_string, bonus)
1626 :
1627 : TYPE(section_type), INTENT(IN), POINTER :: section
1628 : CHARACTER(LEN=*) :: section_name, unknown_string, &
1629 : location_string
1630 : INTEGER, DIMENSION(:), INTENT(INOUT) :: matching_rank
1631 : CHARACTER(LEN=*), DIMENSION(:), INTENT(INOUT) :: matching_string
1632 : INTEGER, INTENT(IN) :: bonus
1633 :
1634 0 : CHARACTER(LEN=LEN(matching_string(1))) :: line
1635 : INTEGER :: i, imatch, imax, irank, newbonus
1636 :
1637 0 : IF (ASSOCIATED(section)) THEN
1638 0 : CPASSERT(section%ref_count > 0)
1639 0 : imatch = typo_match(TRIM(section%name), TRIM(unknown_string))
1640 0 : IF (imatch > 0) THEN
1641 0 : imatch = imatch + bonus
1642 : WRITE (UNIT=line, FMT='(T2,A)') &
1643 : " subsection "//TRIM(ADJUSTL(section%name))// &
1644 0 : " in section "//TRIM(ADJUSTL(location_string))
1645 0 : imax = SIZE(matching_rank, 1)
1646 0 : irank = imax + 1
1647 0 : DO I = imax, 1, -1
1648 0 : IF (imatch > matching_rank(I)) irank = i
1649 : END DO
1650 0 : IF (irank <= imax) THEN
1651 0 : matching_rank(irank + 1:imax) = matching_rank(irank:imax - 1)
1652 0 : matching_string(irank + 1:imax) = matching_string(irank:imax - 1)
1653 0 : matching_rank(irank) = imatch
1654 0 : matching_string(irank) = line
1655 : END IF
1656 : END IF
1657 :
1658 0 : IF (section_name == section%name) THEN
1659 0 : newbonus = 10
1660 : ELSE
1661 0 : newbonus = 0
1662 : END IF
1663 :
1664 0 : DO i = -1, section%n_keywords
1665 0 : IF (ASSOCIATED(section%keywords(i)%keyword)) THEN
1666 : CALL keyword_typo_match(section%keywords(i)%keyword, unknown_string, location_string// &
1667 0 : "%"//TRIM(section%name), matching_rank, matching_string, newbonus)
1668 : END IF
1669 : END DO
1670 :
1671 0 : DO i = 1, section%n_subsections
1672 : CALL section_typo_match(section%subsections(i)%section, section_name, unknown_string, &
1673 0 : location_string//"%"//TRIM(section%name), matching_rank, matching_string, newbonus)
1674 : END DO
1675 :
1676 : END IF
1677 :
1678 0 : END SUBROUTINE section_typo_match
1679 :
1680 : ! **************************************************************************************************
1681 : !> \brief replaces of the requested subsection with the one given
1682 : !> \param section_vals the root section
1683 : !> \param subsection_name the name of the subsection to replace
1684 : !> \param new_section_vals the new section_vals to use
1685 : !> \param i_rep_section index of the repetition of section_vals of which
1686 : !> you want to replace the subsection (defaults to 1)
1687 : !> \author fawzi
1688 : ! **************************************************************************************************
1689 4618 : SUBROUTINE section_vals_set_subs_vals(section_vals, subsection_name, &
1690 : new_section_vals, i_rep_section)
1691 : TYPE(section_vals_type), POINTER :: section_vals
1692 : CHARACTER(len=*), INTENT(in) :: subsection_name
1693 : TYPE(section_vals_type), POINTER :: new_section_vals
1694 : INTEGER, INTENT(in), OPTIONAL :: i_rep_section
1695 :
1696 : INTEGER :: irep, isection, len_key, my_index, &
1697 : tmp_index
1698 : TYPE(section_vals_type), POINTER :: s_vals
1699 :
1700 4618 : CPASSERT(ASSOCIATED(section_vals))
1701 4618 : CPASSERT(section_vals%ref_count > 0)
1702 4618 : CPASSERT(ASSOCIATED(new_section_vals))
1703 4618 : CPASSERT(new_section_vals%ref_count > 0)
1704 :
1705 4618 : irep = 1
1706 4618 : IF (PRESENT(i_rep_section)) irep = i_rep_section
1707 :
1708 4618 : my_index = INDEX(subsection_name, '%') + 1
1709 4618 : len_key = LEN_TRIM(subsection_name)
1710 4618 : IF (my_index > 1) THEN
1711 5854 : DO
1712 8646 : tmp_index = INDEX(subsection_name(my_index:len_key), "%")
1713 8646 : IF (tmp_index <= 0) EXIT
1714 5854 : my_index = my_index + tmp_index
1715 : END DO
1716 2792 : s_vals => section_vals_get_subs_vals(section_vals, subsection_name(1:my_index - 2))
1717 : ELSE
1718 1826 : s_vals => section_vals
1719 : END IF
1720 :
1721 4618 : CPASSERT(irep <= SIZE(s_vals%subs_vals, 2))
1722 :
1723 4618 : isection = section_get_subsection_index(s_vals%section, subsection_name(my_index:LEN_TRIM(subsection_name)))
1724 4618 : IF (isection <= 0) &
1725 : CALL cp_abort(__LOCATION__, &
1726 : "could not find subsection "//subsection_name(my_index:LEN_TRIM(subsection_name))//" in section "// &
1727 0 : TRIM(section_vals%section%name)//" at ")
1728 4618 : CALL section_vals_retain(new_section_vals)
1729 4618 : CALL section_vals_release(s_vals%subs_vals(isection, irep)%section_vals)
1730 4618 : s_vals%subs_vals(isection, irep)%section_vals => new_section_vals
1731 :
1732 4618 : END SUBROUTINE section_vals_set_subs_vals
1733 :
1734 : ! **************************************************************************************************
1735 : !> \brief creates a deep copy from section_vals_in to section_vals_out
1736 : !> \param section_vals_in the section_vals to copy
1737 : !> \param section_vals_out the section_vals to create
1738 : !> \param i_rep_start ...
1739 : !> \param i_rep_end ...
1740 : !> \author fawzi
1741 : ! **************************************************************************************************
1742 1615 : SUBROUTINE section_vals_duplicate(section_vals_in, section_vals_out, &
1743 : i_rep_start, i_rep_end)
1744 : TYPE(section_vals_type), POINTER :: section_vals_in, section_vals_out
1745 : INTEGER, INTENT(IN), OPTIONAL :: i_rep_start, i_rep_end
1746 :
1747 1615 : CPASSERT(ASSOCIATED(section_vals_in))
1748 1615 : CPASSERT(.NOT. ASSOCIATED(section_vals_out))
1749 1615 : CALL section_vals_create(section_vals_out, section_vals_in%section)
1750 1615 : CALL section_vals_copy(section_vals_in, section_vals_out, i_rep_start, i_rep_end)
1751 1615 : END SUBROUTINE section_vals_duplicate
1752 :
1753 : ! **************************************************************************************************
1754 : !> \brief deep copy from section_vals_in to section_vals_out
1755 : !> \param section_vals_in the section_vals to copy
1756 : !> \param section_vals_out the section_vals where to copy
1757 : !> \param i_rep_low ...
1758 : !> \param i_rep_high ...
1759 : !> \author fawzi
1760 : !> \note
1761 : !> private, only works with a newly initialized section_vals_out
1762 : ! **************************************************************************************************
1763 3936824 : RECURSIVE SUBROUTINE section_vals_copy(section_vals_in, section_vals_out, &
1764 : i_rep_low, i_rep_high)
1765 : TYPE(section_vals_type), POINTER :: section_vals_in, section_vals_out
1766 : INTEGER, INTENT(IN), OPTIONAL :: i_rep_low, i_rep_high
1767 :
1768 : INTEGER :: iend, irep, isec, istart, ival
1769 : TYPE(cp_sll_val_type), POINTER :: v1, v2
1770 : TYPE(val_type), POINTER :: el
1771 :
1772 3936824 : NULLIFY (v2, el)
1773 :
1774 3936824 : CPASSERT(ASSOCIATED(section_vals_in))
1775 3936824 : CPASSERT(ASSOCIATED(section_vals_out))
1776 : ! IF(.NOT. ASSOCIATED(section_vals_in%section, section_vals_out%section))&
1777 : ! CPABORT("")
1778 :
1779 3936824 : istart = 1
1780 3936824 : iend = SIZE(section_vals_in%values, 2)
1781 3936824 : IF (PRESENT(i_rep_low)) istart = i_rep_low
1782 3936824 : IF (PRESENT(i_rep_high)) iend = i_rep_high
1783 3954181 : DO irep = istart, iend
1784 17357 : CALL section_vals_add_values(section_vals_out)
1785 4159934 : DO ival = LBOUND(section_vals_in%values, 1), UBOUND(section_vals_in%values, 1)
1786 171039 : v1 => section_vals_in%values(ival, irep)%list
1787 188396 : IF (ASSOCIATED(v1)) THEN
1788 35714 : CALL val_duplicate(v1%first_el, el)
1789 35714 : CALL cp_sll_val_create(v2, el)
1790 35714 : NULLIFY (el)
1791 35714 : section_vals_out%values(ival, irep - istart + 1)%list => v2
1792 45966 : DO
1793 81680 : IF (.NOT. ASSOCIATED(v1%rest)) EXIT
1794 45966 : v1 => v1%rest
1795 45966 : CALL val_duplicate(v1%first_el, el)
1796 45966 : CALL cp_sll_val_create(v2%rest, first_el=el)
1797 45966 : NULLIFY (el)
1798 45966 : v2 => v2%rest
1799 : END DO
1800 : END IF
1801 : END DO
1802 : END DO
1803 3936824 : IF (.NOT. PRESENT(i_rep_low) .AND. (.NOT. PRESENT(i_rep_high))) THEN
1804 3936320 : IF (.NOT. (SIZE(section_vals_in%values, 2) == SIZE(section_vals_out%values, 2))) &
1805 0 : CPABORT("")
1806 3936320 : IF (.NOT. (SIZE(section_vals_in%subs_vals, 2) == SIZE(section_vals_out%subs_vals, 2))) &
1807 0 : CPABORT("")
1808 : END IF
1809 3936824 : iend = SIZE(section_vals_in%subs_vals, 2)
1810 3936824 : IF (PRESENT(i_rep_high)) iend = i_rep_high
1811 7874781 : DO irep = istart, iend
1812 11809990 : DO isec = 1, SIZE(section_vals_in%subs_vals, 1)
1813 : CALL section_vals_copy(section_vals_in%subs_vals(isec, irep)%section_vals, &
1814 7873166 : section_vals_out%subs_vals(isec, irep - istart + 1)%section_vals)
1815 : END DO
1816 : END DO
1817 :
1818 3936824 : END SUBROUTINE section_vals_copy
1819 :
1820 0 : END MODULE input_section_types
|
