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