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 95004723 : SUBROUTINE section_create(section, location, name, description, n_keywords, &
157 5423944 : 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 95004723 : CPASSERT(.NOT. ASSOCIATED(section))
169 95004723 : my_n_keywords = 10
170 95004723 : IF (PRESENT(n_keywords)) my_n_keywords = n_keywords
171 95004723 : my_n_subsections = 0
172 95004723 : IF (PRESENT(n_subsections)) my_n_subsections = n_subsections
173 :
174 95004723 : ALLOCATE (section)
175 95004723 : section%ref_count = 1
176 :
177 : section%n_keywords = 0
178 : section%n_subsections = 0
179 95004723 : section%location = location
180 :
181 95004723 : CPASSERT(LEN_TRIM(name) > 0)
182 95004723 : section%name = name
183 95004723 : CALL uppercase(section%name)
184 :
185 95004723 : n = LEN_TRIM(description)
186 284883249 : ALLOCATE (section%description(n))
187 8023704567 : DO i = 1, n
188 8023704567 : section%description(i) = description(i:i)
189 : END DO
190 :
191 95004723 : section%frozen = .FALSE.
192 95004723 : section%repeats = .FALSE.
193 95004723 : IF (PRESENT(repeats)) section%repeats = repeats
194 :
195 95004723 : NULLIFY (section%citations)
196 95004723 : IF (PRESENT(citations)) THEN
197 16271832 : ALLOCATE (section%citations(SIZE(citations)))
198 15931821 : section%citations = citations
199 : END IF
200 :
201 1003245247 : ALLOCATE (section%keywords(-1:my_n_keywords))
202 813235801 : DO i = -1, my_n_keywords
203 813235801 : NULLIFY (section%keywords(i)%keyword)
204 : END DO
205 :
206 203286626 : ALLOCATE (section%subsections(my_n_subsections))
207 103572021 : DO i = 1, my_n_subsections
208 103572021 : NULLIFY (section%subsections(i)%section)
209 : END DO
210 :
211 95004723 : IF (PRESENT(deprecation_notice)) THEN
212 18584 : section%deprecation_notice = TRIM(deprecation_notice)
213 : END IF
214 :
215 95004723 : 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 203699052 : SUBROUTINE section_retain(section)
223 :
224 : TYPE(section_type), POINTER :: section
225 :
226 203699052 : CPASSERT(ASSOCIATED(section))
227 203699052 : CPASSERT(section%ref_count > 0)
228 203699052 : section%ref_count = section%ref_count + 1
229 :
230 203699052 : 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 399881971 : RECURSIVE SUBROUTINE section_release(section)
238 :
239 : TYPE(section_type), POINTER :: section
240 :
241 : INTEGER :: i
242 :
243 399881971 : IF (ASSOCIATED(section)) THEN
244 298703775 : CPASSERT(section%ref_count > 0)
245 298703775 : section%ref_count = section%ref_count - 1
246 298703775 : IF (section%ref_count == 0) THEN
247 95004723 : IF (ASSOCIATED(section%citations)) THEN
248 5423944 : DEALLOCATE (section%citations)
249 : END IF
250 95004723 : IF (ASSOCIATED(section%keywords)) THEN
251 1223067314 : DO i = -1, UBOUND(section%keywords, 1)
252 1128062591 : CALL keyword_release(section%keywords(i)%keyword)
253 : END DO
254 95004723 : DEALLOCATE (section%keywords)
255 : END IF
256 95004723 : section%n_keywords = 0
257 95004723 : IF (ASSOCIATED(section%subsections)) THEN
258 291121061 : DO i = 1, SIZE(section%subsections)
259 291121061 : CALL section_release(section%subsections(i)%section)
260 : END DO
261 95004723 : DEALLOCATE (section%subsections)
262 : END IF
263 95004723 : DEALLOCATE (section%description)
264 95004723 : DEALLOCATE (section)
265 : END IF
266 298703775 : NULLIFY (section)
267 : END IF
268 :
269 399881971 : 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 37052312 : 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 37052312 : res = -1
390 37052312 : upc_name = subsection_name
391 37052312 : CALL uppercase(upc_name)
392 297583692 : DO isub = 1, section%n_subsections
393 297583571 : CPASSERT(ASSOCIATED(section%subsections(isub)%section))
394 297583692 : IF (section%subsections(isub)%section%name == upc_name) THEN
395 : res = isub
396 : EXIT
397 : END IF
398 : END DO
399 :
400 37052312 : 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 39568444 : 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 39568444 : CPASSERT(ASSOCIATED(section%keywords))
446 39568444 : res = -2
447 39568444 : upc_name = keyword_name
448 39568444 : CALL uppercase(upc_name)
449 118705332 : DO ik = -1, 0
450 118705332 : IF (ASSOCIATED(section%keywords(ik)%keyword)) THEN
451 26812833 : IF (section%keywords(ik)%keyword%names(1) == upc_name) THEN
452 8429999 : res = ik
453 : END IF
454 : END IF
455 : END DO
456 39568444 : IF (res == -2) THEN
457 282751362 : k_search_loop: DO ik = 1, section%n_keywords
458 282464404 : CPASSERT(ASSOCIATED(section%keywords(ik)%keyword))
459 552540463 : DO in = 1, SIZE(section%keywords(ik)%keyword%names)
460 552253505 : 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 39568444 : 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 53062 : 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 53062 : IF (INDEX(keyword_name, "%") /= 0) THEN
486 2338 : my_index = INDEX(keyword_name, "%") + 1
487 2338 : CPASSERT(ASSOCIATED(section%subsections))
488 15665 : DO ik = LBOUND(section%subsections, 1), UBOUND(section%subsections, 1)
489 10989 : IF (section%subsections(ik)%section%name == keyword_name(1:my_index - 2)) EXIT
490 : END DO
491 2338 : CPASSERT(ik <= UBOUND(section%subsections, 1))
492 2338 : res => section_get_keyword(section%subsections(ik)%section, keyword_name(my_index:))
493 : ELSE
494 50724 : ik = section_get_keyword_index(section, keyword_name)
495 50724 : IF (ik == -2) THEN
496 : NULLIFY (res)
497 : ELSE
498 50724 : res => section%keywords(ik)%keyword
499 : END IF
500 : END IF
501 :
502 53062 : 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 706880064 : 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 706880064 : TYPE(keyword_p_type), DIMENSION(:), POINTER :: new_keywords
517 :
518 0 : CPASSERT(section%ref_count > 0)
519 706880064 : CPASSERT(.NOT. section%frozen)
520 706880064 : CPASSERT(ASSOCIATED(keyword))
521 706880064 : CPASSERT(keyword%ref_count > 0)
522 706880064 : CALL keyword_retain(keyword)
523 706880064 : IF (keyword%names(1) == "_SECTION_PARAMETERS_") THEN
524 74564071 : CALL keyword_release(section%keywords(-1)%keyword)
525 74564071 : section%keywords(-1)%keyword => keyword
526 632315993 : ELSE IF (keyword%names(1) == "_DEFAULT_KEYWORD_") THEN
527 1963054 : CALL keyword_release(section%keywords(0)%keyword)
528 1963054 : section%keywords(0)%keyword => keyword
529 : ELSE
530 1276173586 : DO k = 1, SIZE(keyword%names)
531 5845219617 : DO i = 1, section%n_keywords
532 9929276128 : DO j = 1, SIZE(section%keywords(i)%keyword%names)
533 9283455481 : 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 1260705878 : IF (UBOUND(section%keywords, 1) == section%n_keywords) THEN
544 641143031 : ALLOCATE (new_keywords(-1:section%n_keywords + 10))
545 263350883 : DO i = -1, section%n_keywords
546 263350883 : new_keywords(i)%keyword => section%keywords(i)%keyword
547 : END DO
548 377792148 : DO i = section%n_keywords + 1, UBOUND(new_keywords, 1)
549 346309469 : NULLIFY (new_keywords(i)%keyword)
550 : END DO
551 31482679 : DEALLOCATE (section%keywords)
552 31482679 : section%keywords => new_keywords
553 : END IF
554 630352939 : section%n_keywords = section%n_keywords + 1
555 630352939 : section%keywords(section%n_keywords)%keyword => keyword
556 : END IF
557 :
558 706880064 : 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 94961931 : 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 94961931 : TYPE(section_p_type), DIMENSION(:), POINTER :: new_subsections
573 :
574 0 : CPASSERT(section%ref_count > 0)
575 94961931 : CPASSERT(ASSOCIATED(subsection))
576 94961931 : CPASSERT(subsection%ref_count > 0)
577 94961931 : IF (SIZE(section%subsections) < section%n_subsections + 1) THEN
578 2587243612 : ALLOCATE (new_subsections(section%n_subsections + 10))
579 2362184764 : DO i = 1, section%n_subsections
580 2362184764 : new_subsections(i)%section => section%subsections(i)%section
581 : END DO
582 206303944 : DO i = section%n_subsections + 1, SIZE(new_subsections)
583 206303944 : NULLIFY (new_subsections(i)%section)
584 : END DO
585 18754904 : DEALLOCATE (section%subsections)
586 18754904 : section%subsections => new_subsections
587 : END IF
588 23300845426 : DO i = 1, section%n_subsections
589 23205883495 : 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 94961931 : //TRIM(section%name))
594 : END DO
595 94961931 : CALL section_retain(subsection)
596 94961931 : section%n_subsections = section%n_subsections + 1
597 94961931 : section%subsections(section%n_subsections)%section => subsection
598 :
599 94961931 : 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 108737121 : 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 108737121 : CPASSERT(.NOT. ASSOCIATED(section_vals))
615 108737121 : ALLOCATE (section_vals)
616 108737121 : section_vals%ref_count = 1
617 108737121 : CALL section_retain(section)
618 108737121 : section_vals%section => section
619 108737121 : section%frozen = .TRUE.
620 217474242 : ALLOCATE (section_vals%values(-1:section%n_keywords, 0))
621 449257873 : ALLOCATE (section_vals%subs_vals(section%n_subsections, 1))
622 217405600 : DO i = 1, section%n_subsections
623 108668479 : NULLIFY (section_vals%subs_vals(i, 1)%section_vals)
624 : CALL section_vals_create(section_vals%subs_vals(i, 1)%section_vals, &
625 217405600 : section=section%subsections(i)%section)
626 : END DO
627 :
628 108737121 : NULLIFY (section_vals%ibackup)
629 :
630 108737121 : 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 67116 : SUBROUTINE section_vals_retain(section_vals)
638 :
639 : TYPE(section_vals_type), POINTER :: section_vals
640 :
641 67116 : CPASSERT(ASSOCIATED(section_vals))
642 67116 : CPASSERT(section_vals%ref_count > 0)
643 67116 : section_vals%ref_count = section_vals%ref_count + 1
644 :
645 67116 : 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 108818749 : 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 108818749 : IF (ASSOCIATED(section_vals)) THEN
661 108804237 : CPASSERT(section_vals%ref_count > 0)
662 108804237 : section_vals%ref_count = section_vals%ref_count - 1
663 108804237 : IF (section_vals%ref_count == 0) THEN
664 108737121 : CALL section_release(section_vals%section)
665 109011311 : DO j = 1, SIZE(section_vals%values, 2)
666 112634682 : DO i = -1, UBOUND(section_vals%values, 1)
667 3349181 : vals => section_vals%values(i, j)%list
668 4218036 : DO WHILE (cp_sll_val_next(vals, el_att=el))
669 868855 : CALL val_release(el)
670 : END DO
671 3623371 : CALL cp_sll_val_dealloc(section_vals%values(i, j)%list)
672 : END DO
673 : END DO
674 108737121 : DEALLOCATE (section_vals%values)
675 217496782 : DO j = 1, SIZE(section_vals%subs_vals, 2)
676 326221929 : DO i = 1, SIZE(section_vals%subs_vals, 1)
677 217484808 : CALL section_vals_release(section_vals%subs_vals(i, j)%section_vals)
678 : END DO
679 : END DO
680 108737121 : DEALLOCATE (section_vals%subs_vals)
681 108737121 : IF (ASSOCIATED(section_vals%ibackup)) THEN
682 3858 : DEALLOCATE (section_vals%ibackup)
683 : END IF
684 108737121 : DEALLOCATE (section_vals)
685 : END IF
686 : END IF
687 :
688 108818749 : 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 4447771 : 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 4447771 : CPASSERT(section_vals%ref_count > 0)
711 4447771 : IF (PRESENT(ref_count)) ref_count = section_vals%ref_count
712 4447771 : IF (PRESENT(section)) section => section_vals%section
713 4447771 : IF (PRESENT(n_repetition)) n_repetition = SIZE(section_vals%values, 2)
714 4447771 : IF (PRESENT(n_subs_vals_rep)) n_subs_vals_rep = SIZE(section_vals%subs_vals, 2)
715 4447771 : IF (PRESENT(explicit)) explicit = (SIZE(section_vals%values, 2) > 0)
716 :
717 4447771 : 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 36746722 : 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 36746722 : CPASSERT(section_vals%ref_count > 0)
742 :
743 36746722 : my_can_return_null = .FALSE.
744 36746722 : IF (PRESENT(can_return_null)) my_can_return_null = can_return_null
745 36746722 : NULLIFY (res)
746 36746722 : irep = 1
747 36746722 : 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 36746722 : my_index = INDEX(subsection_name, "%")
751 36746722 : IF (my_index == 0) THEN
752 21573456 : is_path = .FALSE.
753 21573456 : my_index = LEN_TRIM(subsection_name)
754 : ELSE
755 15173266 : is_path = .TRUE.
756 15173266 : irep = 1
757 15173266 : my_index = my_index - 1
758 : END IF
759 :
760 36746722 : CPASSERT(irep <= SIZE(section_vals%subs_vals, 2))
761 :
762 36746722 : isection = section_get_subsection_index(section_vals%section, subsection_name(1:my_index))
763 36746722 : IF (isection > 0) res => section_vals%subs_vals(isection, irep)%section_vals
764 36746722 : 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 36746722 : 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 15173266 : i_rep_section, can_return_null)
771 : END IF
772 :
773 36746722 : 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 1020953 : 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 1020953 : CPASSERT(ASSOCIATED(section_vals))
795 1020953 : CPASSERT(section_vals%ref_count > 0)
796 1020953 : NULLIFY (res)
797 1020953 : irep = 1
798 1020953 : IF (PRESENT(i_rep_section)) irep = i_rep_section
799 1020953 : CPASSERT(irep <= SIZE(section_vals%subs_vals, 2))
800 1020953 : isect_att = 0
801 554638536 : DO i = 1, section_vals%section%n_subsections
802 554638536 : IF (SIZE(section_vals%subs_vals(i, irep)%section_vals%values, 2) > 0) THEN
803 1064187 : isect_att = isect_att + 1
804 1064187 : 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 1020953 : 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 74363 : 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 74363 : CPASSERT(section_vals%ref_count > 0)
833 74363 : NULLIFY (res)
834 74363 : irep = 1
835 74363 : IF (PRESENT(i_rep_section)) irep = i_rep_section
836 74363 : CPASSERT(irep <= SIZE(section_vals%subs_vals, 2))
837 74363 : i_section = section_get_subsection_index(section_vals%section, subsection_name)
838 74363 : res => section_vals%subs_vals(i_section, irep)%section_vals
839 :
840 74363 : 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 283942 : SUBROUTINE section_vals_add_values(section_vals)
848 :
849 : TYPE(section_vals_type), INTENT(INOUT) :: section_vals
850 :
851 : INTEGER :: i, j
852 283942 : TYPE(cp_sll_val_p_type), DIMENSION(:, :), POINTER :: new_values
853 : TYPE(section_vals_p_type), DIMENSION(:, :), &
854 283942 : POINTER :: new_sps
855 :
856 0 : CPASSERT(section_vals%ref_count > 0)
857 5739235 : ALLOCATE (new_values(-1:UBOUND(section_vals%values, 1), SIZE(section_vals%values, 2) + 1))
858 341410 : DO j = 1, SIZE(section_vals%values, 2)
859 1233337 : DO i = -1, UBOUND(section_vals%values, 1)
860 891927 : new_values(i, j)%list => section_vals%values(i, j)%list
861 : END DO
862 : END DO
863 283942 : DEALLOCATE (section_vals%values)
864 283942 : section_vals%values => new_values
865 283942 : j = SIZE(new_values, 2)
866 3995482 : DO i = -1, UBOUND(new_values, 1)
867 3711540 : NULLIFY (new_values(i, j)%list)
868 : END DO
869 :
870 283942 : IF (SIZE(new_values, 2) > 1) THEN
871 : ALLOCATE (new_sps(SIZE(section_vals%subs_vals, 1), &
872 338054 : SIZE(section_vals%subs_vals, 2) + 1))
873 80008 : DO j = 1, SIZE(section_vals%subs_vals, 2)
874 204840 : DO i = 1, SIZE(section_vals%subs_vals, 1)
875 182300 : new_sps(i, j)%section_vals => section_vals%subs_vals(i, j)%section_vals
876 : END DO
877 : END DO
878 22540 : DEALLOCATE (section_vals%subs_vals)
879 22540 : section_vals%subs_vals => new_sps
880 22540 : j = SIZE(new_sps, 2)
881 79208 : DO i = 1, SIZE(new_sps, 1)
882 56668 : NULLIFY (new_sps(i, j)%section_vals)
883 : CALL section_vals_create(new_sps(i, SIZE(new_sps, 2))%section_vals, &
884 79208 : section=section_vals%section%subsections(i)%section)
885 : END DO
886 : END IF
887 :
888 283942 : 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 68311 : SUBROUTINE section_vals_remove_values(section_vals)
896 :
897 : TYPE(section_vals_type), POINTER :: section_vals
898 :
899 : INTEGER :: i, j
900 68311 : 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 68311 : IF (ASSOCIATED(section_vals)) THEN
905 68311 : CPASSERT(section_vals%ref_count > 0)
906 68311 : NULLIFY (el, vals)
907 : ! Allocate a null 0 dimension array of values
908 204933 : ALLOCATE (new_values(-1:section_vals%section%n_keywords, 0))
909 : ! Release old values
910 78063 : DO j = 1, SIZE(section_vals%values, 2)
911 166232 : DO i = -1, UBOUND(section_vals%values, 1)
912 78417 : vals => section_vals%values(i, j)%list
913 668740 : DO WHILE (cp_sll_val_next(vals, el_att=el))
914 590323 : CALL val_release(el)
915 : END DO
916 88169 : CALL cp_sll_val_dealloc(section_vals%values(i, j)%list)
917 : END DO
918 : END DO
919 68311 : DEALLOCATE (section_vals%values)
920 68311 : section_vals%values => new_values
921 : END IF
922 :
923 68311 : 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 468778 : 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 468778 : CALL section_vals_val_get(section_vals, keyword_name, r_val=res)
954 :
955 468778 : 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 391812 : 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 391812 : CALL section_vals_val_get(section_vals, keyword_name, i_val=res)
986 :
987 391812 : END FUNCTION section_get_ival
988 :
989 : ! **************************************************************************************************
990 : !> \brief ...
991 : !> \param section_vals ...
992 : !> \param keyword_name ...
993 : !> \return ...
994 : ! **************************************************************************************************
995 1932 : 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 1932 : CALL section_vals_val_get(section_vals, keyword_name, i_vals=res)
1002 :
1003 1932 : END FUNCTION section_get_ivals
1004 :
1005 : ! **************************************************************************************************
1006 : !> \brief ...
1007 : !> \param section_vals ...
1008 : !> \param keyword_name ...
1009 : !> \return ...
1010 : ! **************************************************************************************************
1011 95051 : 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 95051 : CALL section_vals_val_get(section_vals, keyword_name, l_val=res)
1018 :
1019 95051 : 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 38422948 : 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 38422948 : CPASSERT(section_vals%ref_count > 0)
1074 :
1075 38422948 : my_index = INDEX(keyword_name, '%') + 1
1076 38422948 : len_key = LEN_TRIM(keyword_name)
1077 38422948 : IF (my_index > 1) THEN
1078 2810213 : DO
1079 10961977 : tmp_index = INDEX(keyword_name(my_index:len_key), "%")
1080 10961977 : IF (tmp_index <= 0) EXIT
1081 2810213 : my_index = my_index + tmp_index
1082 : END DO
1083 8151764 : 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 38422948 : irk = 1
1089 38422948 : irs = 1
1090 38422948 : IF (PRESENT(i_rep_section)) irs = i_rep_section
1091 38422948 : IF (PRESENT(i_rep_val)) irk = i_rep_val
1092 38422948 : IF (PRESENT(val)) NULLIFY (val)
1093 38422948 : IF (PRESENT(explicit)) explicit = .FALSE.
1094 38422948 : 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 38422948 : PRESENT(r_vals) .OR. PRESENT(c_vals)
1098 38422948 : ik = section_get_keyword_index(s_vals%section, keyword_name(my_index:len_key))
1099 38422948 : 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 38422948 : keyword => section%keywords(ik)%keyword
1104 38422948 : 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 38422948 : NULLIFY (my_val)
1110 38422948 : IF (PRESENT(n_rep_val)) n_rep_val = 0
1111 38422948 : IF (irs <= SIZE(s_vals%values, 2)) THEN ! the section was parsed
1112 10337266 : vals => s_vals%values(ik, irs)%list
1113 10337266 : IF (PRESENT(n_rep_val)) n_rep_val = cp_sll_val_get_length(vals)
1114 10337266 : IF (.NOT. ASSOCIATED(vals)) THEN
1115 : ! this keyword was not parsed
1116 6776266 : IF (ASSOCIATED(keyword%default_value)) THEN
1117 6273025 : my_val => keyword%default_value
1118 6273025 : 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 3561000 : irk)
1123 3561000 : IF (PRESENT(explicit)) explicit = .TRUE.
1124 : END IF
1125 28085682 : ELSE IF (ASSOCIATED(keyword%default_value)) THEN
1126 28049952 : IF (PRESENT(n_rep_val)) n_rep_val = 1
1127 28049952 : my_val => keyword%default_value
1128 : END IF
1129 38422948 : IF (PRESENT(val)) val => my_val
1130 38422948 : IF (valRequested) THEN
1131 35614616 : 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 104841572 : c_vals=c_vals)
1139 : END IF
1140 :
1141 38422948 : 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 9235 : 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 9235 : CPASSERT(ASSOCIATED(section_vals))
1167 9235 : CPASSERT(section_vals%ref_count > 0)
1168 9235 : NULLIFY (list)
1169 9235 : my_index = INDEX(keyword_name, '%') + 1
1170 9235 : len_key = LEN_TRIM(keyword_name)
1171 9235 : 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 9235 : s_vals => section_vals
1180 : END IF
1181 :
1182 9235 : irs = 1
1183 9235 : IF (PRESENT(i_rep_section)) irs = i_rep_section
1184 9235 : section => s_vals%section
1185 9235 : ik = section_get_keyword_index(s_vals%section, keyword_name(my_index:len_key))
1186 9235 : 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 9235 : 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 9235 : list => s_vals%values(ik, irs)%list
1196 :
1197 9235 : 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 360586 : 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 360586 : CPASSERT(ASSOCIATED(section_vals))
1248 360586 : CPASSERT(section_vals%ref_count > 0)
1249 :
1250 360586 : my_index = INDEX(keyword_name, '%') + 1
1251 360586 : len_key = LEN_TRIM(keyword_name)
1252 360586 : IF (my_index > 1) THEN
1253 8042 : DO
1254 86577 : tmp_index = INDEX(keyword_name(my_index:len_key), "%")
1255 86577 : IF (tmp_index <= 0) EXIT
1256 8042 : my_index = my_index + tmp_index
1257 : END DO
1258 78535 : s_vals => section_vals_get_subs_vals(section_vals, keyword_name(1:my_index - 2))
1259 : ELSE
1260 282051 : s_vals => section_vals
1261 : END IF
1262 :
1263 360586 : irk = 1
1264 360586 : irs = 1
1265 360586 : IF (PRESENT(i_rep_section)) irs = i_rep_section
1266 360586 : IF (PRESENT(i_rep_val)) irk = i_rep_val
1267 360586 : section => s_vals%section
1268 360586 : ik = section_get_keyword_index(s_vals%section, keyword_name(my_index:len_key))
1269 360586 : 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 26205 : DO
1275 386791 : IF (irs <= SIZE(s_vals%values, 2)) EXIT
1276 26205 : CALL section_vals_add_values(s_vals)
1277 : END DO
1278 360586 : 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 360586 : keyword => s_vals%section%keywords(ik)%keyword
1284 360586 : NULLIFY (my_val)
1285 360586 : 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 360586 : PRESENT(r_vals_ptr) .OR. PRESENT(c_vals_ptr)
1289 360586 : 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 360586 : 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 360586 : IF (keyword%type_of_var == lchar_t) THEN
1305 108820 : 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 913138 : c_vals_ptr=c_vals_ptr, enum=keyword%enum)
1311 : END IF
1312 360586 : CPASSERT(ASSOCIATED(my_val))
1313 360586 : CPASSERT(my_val%type_of_var == keyword%type_of_var)
1314 : END IF
1315 360586 : vals => s_vals%values(ik, irs)%list
1316 360586 : IF (irk == -1) THEN
1317 0 : CALL cp_sll_val_insert_el_at(vals, my_val, index=-1)
1318 360586 : ELSE IF (irk <= cp_sll_val_get_length(vals)) THEN
1319 213242 : 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 213242 : old_val => cp_sll_val_get_el_at(vals, index=irk)
1325 213242 : CALL val_release(old_val)
1326 213242 : CALL cp_sll_val_set_el_at(vals, value=my_val, index=irk)
1327 147344 : 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 147344 : CALL cp_sll_val_insert_el_at(vals, my_val, index=irk)
1335 : END IF
1336 360586 : s_vals%values(ik, irs)%list => vals
1337 : NULLIFY (my_val)
1338 360586 : 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 37989 : 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 37989 : NULLIFY (pos)
1367 37989 : CPASSERT(ASSOCIATED(section_vals))
1368 37989 : CPASSERT(section_vals%ref_count > 0)
1369 :
1370 37989 : my_index = INDEX(keyword_name, '%') + 1
1371 37989 : len_key = LEN_TRIM(keyword_name)
1372 37989 : 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 37613 : s_vals => section_vals
1381 : END IF
1382 :
1383 37989 : irk = 1
1384 37989 : irs = 1
1385 37989 : IF (PRESENT(i_rep_section)) irs = i_rep_section
1386 37989 : IF (PRESENT(i_rep_val)) irk = i_rep_val
1387 37989 : section => s_vals%section
1388 37989 : ik = section_get_keyword_index(s_vals%section, keyword_name(my_index:len_key))
1389 37989 : 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 37989 : IF (irs <= SIZE(s_vals%values, 2)) THEN
1395 37989 : 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 37989 : IF (irk == -1) THEN
1401 0 : pos => cp_sll_val_get_rest(s_vals%values(ik, irs)%list, iter=-1)
1402 : ELSE
1403 37989 : pos => cp_sll_val_get_rest(s_vals%values(ik, irs)%list, iter=irk - 1)
1404 : END IF
1405 37989 : IF (ASSOCIATED(pos)) THEN
1406 7381 : old_val => cp_sll_val_get_el_at(s_vals%values(ik, irs)%list, index=irk)
1407 7381 : CALL val_release(old_val)
1408 7381 : CALL cp_sll_val_rm_el_at(s_vals%values(ik, irs)%list, index=irk)
1409 : END IF
1410 : END IF
1411 :
1412 37989 : 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 2412568 : RECURSIVE SUBROUTINE section_vals_write(section_vals, unit_nr, hide_root, hide_defaults)
1426 :
1427 : TYPE(section_vals_type), INTENT(IN) :: section_vals
1428 : INTEGER, INTENT(in) :: unit_nr
1429 : LOGICAL, INTENT(in), OPTIONAL :: hide_root, hide_defaults
1430 :
1431 : INTEGER, PARAMETER :: incr = 2
1432 :
1433 : CHARACTER(LEN=1) :: first_key_char, first_sec_char
1434 : CHARACTER(LEN=25) :: myfmt
1435 : INTEGER :: i_rep_s, ik, isec, ival, nr, nval
1436 : INTEGER, SAVE :: indent = 1
1437 : LOGICAL :: defaultSection, explicit, &
1438 : my_hide_defaults, my_hide_root
1439 : TYPE(cp_sll_val_type), POINTER :: new_pos, vals
1440 : TYPE(keyword_type), POINTER :: keyword
1441 : TYPE(section_type), POINTER :: section
1442 : TYPE(section_vals_type), POINTER :: sval
1443 : TYPE(val_type), POINTER :: val
1444 :
1445 2412568 : my_hide_root = .FALSE.
1446 2412568 : my_hide_defaults = .TRUE.
1447 2412568 : IF (PRESENT(hide_root)) my_hide_root = hide_root
1448 2412568 : IF (PRESENT(hide_defaults)) my_hide_defaults = hide_defaults
1449 :
1450 2412568 : CPASSERT(section_vals%ref_count > 0)
1451 2412568 : IF (unit_nr > 0) THEN
1452 2412568 : CALL section_vals_get(section_vals, explicit=explicit, n_repetition=nr, section=section)
1453 2412568 : IF (ALLOCATED(section%deprecation_notice)) THEN
1454 3567 : first_sec_char = "#"
1455 : ELSE
1456 2409001 : first_sec_char = " "
1457 : END IF
1458 2412568 : IF (explicit .OR. (.NOT. my_hide_defaults)) THEN
1459 573220 : DO i_rep_s = 1, nr
1460 293372 : IF (.NOT. my_hide_root) THEN
1461 284834 : WRITE (UNIT=myfmt, FMT="(A1,I0,A4)") "(", indent, "X,A)"
1462 284834 : IF (ASSOCIATED(section%keywords(-1)%keyword)) THEN
1463 : WRITE (UNIT=unit_nr, FMT=myfmt, ADVANCE="NO") &
1464 58622 : TRIM(first_sec_char)//default_section_character//TRIM(ADJUSTL(section%name))
1465 : ELSE
1466 : WRITE (UNIT=unit_nr, FMT=myfmt) &
1467 226212 : TRIM(first_sec_char)//default_section_character//TRIM(ADJUSTL(section%name))
1468 : END IF
1469 : END IF
1470 293372 : defaultSection = (SIZE(section_vals%values, 2) == 0)
1471 293372 : IF (.NOT. defaultSection) THEN
1472 293372 : IF (.NOT. my_hide_root) indent = indent + incr
1473 293372 : WRITE (UNIT=myfmt, FMT="(A1,I0,A4)") "(", indent, "X,A)"
1474 3120423 : DO ik = -1, section%n_keywords
1475 2827051 : keyword => section%keywords(ik)%keyword
1476 3120423 : IF (ASSOCIATED(keyword)) THEN
1477 2329838 : IF (ALLOCATED(keyword%deprecation_notice) .OR. &
1478 : ALLOCATED(section%deprecation_notice)) THEN
1479 : ! Comment deprecated keyword
1480 15573 : first_key_char = "#"
1481 : ELSE
1482 2314265 : first_key_char = " "
1483 : END IF
1484 2329838 : IF (keyword%type_of_var /= no_t .AND. keyword%names(1) (1:2) /= "__") THEN
1485 : CALL section_vals_val_get(section_vals, keyword%names(1), &
1486 2269313 : i_rep_s, n_rep_val=nval)
1487 2269313 : IF (i_rep_s <= SIZE(section_vals%values, 2)) THEN
1488 : ! Section was parsed
1489 2269313 : vals => section_vals%values(ik, i_rep_s)%list
1490 5666144 : DO ival = 1, nval
1491 3396831 : IF (ival == 1) THEN
1492 : new_pos => vals
1493 : ELSE
1494 1291464 : new_pos => new_pos%rest
1495 : END IF
1496 3396831 : IF (.NOT. ASSOCIATED(new_pos)) THEN
1497 : ! this keyword was not parsed
1498 1515587 : IF (ASSOCIATED(keyword%default_value)) THEN
1499 1515587 : val => keyword%default_value
1500 1515587 : IF (my_hide_defaults) CYCLE
1501 : END IF
1502 : ELSE
1503 1881244 : val => new_pos%first_el
1504 : END IF
1505 1884908 : IF (keyword%names(1) /= '_DEFAULT_KEYWORD_' .AND. &
1506 : keyword%names(1) /= '_SECTION_PARAMETERS_') THEN
1507 : WRITE (UNIT=unit_nr, FMT=myfmt, ADVANCE="NO") &
1508 505173 : TRIM(first_key_char)//TRIM(keyword%names(1))
1509 1379735 : ELSE IF (keyword%names(1) == '_DEFAULT_KEYWORD_' .AND. &
1510 : keyword%type_of_var /= lchar_t) THEN
1511 450492 : WRITE (UNIT=unit_nr, FMT=myfmt, ADVANCE="NO")
1512 : END IF
1513 5666144 : CALL val_write(val, unit_nr=unit_nr, unit=keyword%unit, fmt=myfmt)
1514 : END DO
1515 0 : ELSE IF (ASSOCIATED(keyword%default_value)) THEN
1516 : ! Section was not parsed but default for the keywords may exist
1517 0 : IF (my_hide_defaults) CYCLE
1518 0 : val => keyword%default_value
1519 0 : IF (keyword%names(1) /= '_DEFAULT_KEYWORD_' .AND. &
1520 : keyword%names(1) /= '_SECTION_PARAMETERS_') THEN
1521 : WRITE (UNIT=unit_nr, FMT=myfmt, ADVANCE="NO") &
1522 0 : TRIM(first_key_char)//TRIM(keyword%names(1))
1523 0 : ELSE IF (keyword%names(1) == '_DEFAULT_KEYWORD_' .AND. &
1524 : keyword%type_of_var /= lchar_t) THEN
1525 0 : WRITE (UNIT=unit_nr, FMT=myfmt, ADVANCE="NO")
1526 : END IF
1527 0 : CALL val_write(val, unit_nr=unit_nr, unit=keyword%unit, fmt=myfmt)
1528 : END IF
1529 : END IF
1530 : END IF
1531 : END DO
1532 293372 : IF (ASSOCIATED(section_vals%subs_vals)) THEN
1533 2697402 : DO isec = 1, SIZE(section_vals%subs_vals, 1)
1534 2404030 : sval => section_vals%subs_vals(isec, i_rep_s)%section_vals
1535 2697402 : IF (ASSOCIATED(sval)) THEN
1536 2404030 : CALL section_vals_write(sval, unit_nr=unit_nr, hide_defaults=hide_defaults)
1537 : END IF
1538 : END DO
1539 : END IF
1540 : END IF
1541 2705940 : IF (.NOT. my_hide_root) THEN
1542 284834 : indent = indent - incr
1543 284834 : WRITE (UNIT=myfmt, FMT="(A1,I0,A4)") "(", indent, "X,A)"
1544 : WRITE (UNIT=unit_nr, FMT=myfmt) &
1545 : TRIM(first_sec_char)//default_section_character// &
1546 284834 : "END "//TRIM(ADJUSTL(section%name))
1547 : END IF
1548 : END DO
1549 : END IF
1550 : END IF
1551 :
1552 2412568 : END SUBROUTINE section_vals_write
1553 :
1554 : ! **************************************************************************************************
1555 : !> \brief writes the values in the given section in xml
1556 : !> \param section ...
1557 : !> \param level ...
1558 : !> \param unit_number ...
1559 : ! **************************************************************************************************
1560 0 : RECURSIVE SUBROUTINE write_section_xml(section, level, unit_number)
1561 :
1562 : TYPE(section_type), POINTER :: section
1563 : INTEGER, INTENT(IN) :: level, unit_number
1564 :
1565 : CHARACTER(LEN=3) :: repeats
1566 : CHARACTER(LEN=8) :: short_string
1567 : INTEGER :: i, l0, l1, l2
1568 :
1569 0 : IF (ASSOCIATED(section)) THEN
1570 :
1571 0 : CPASSERT(section%ref_count > 0)
1572 :
1573 : ! Indentation for current level, next level, etc.
1574 :
1575 0 : l0 = level
1576 0 : l1 = level + 1
1577 0 : l2 = level + 2
1578 :
1579 0 : IF (section%repeats) THEN
1580 0 : repeats = "yes"
1581 : ELSE
1582 0 : repeats = "no "
1583 : END IF
1584 :
1585 0 : WRITE (UNIT=unit_number, FMT="(A)") &
1586 0 : REPEAT(" ", l0)//"<SECTION repeats="""//TRIM(repeats)//""">", &
1587 0 : REPEAT(" ", l1)//"<NAME>"//TRIM(section%name)//"</NAME>", &
1588 : REPEAT(" ", l1)//"<DESCRIPTION>"// &
1589 : TRIM(substitute_special_xml_tokens(a2s(section%description))) &
1590 0 : //"</DESCRIPTION>"
1591 :
1592 0 : IF (ALLOCATED(section%deprecation_notice)) &
1593 : WRITE (UNIT=unit_number, FMT="(A)") REPEAT(" ", l1)//"<DEPRECATION_NOTICE>"// &
1594 : TRIM(substitute_special_xml_tokens(section%deprecation_notice)) &
1595 0 : //"</DEPRECATION_NOTICE>"
1596 :
1597 0 : IF (ASSOCIATED(section%citations)) THEN
1598 0 : DO i = 1, SIZE(section%citations, 1)
1599 0 : short_string = ""
1600 0 : WRITE (UNIT=short_string, FMT="(I8)") section%citations(i)
1601 0 : WRITE (UNIT=unit_number, FMT="(A)") &
1602 0 : REPEAT(" ", l1)//"<REFERENCE>", &
1603 0 : REPEAT(" ", l2)//"<NAME>"//TRIM(get_citation_key(section%citations(i)))//"</NAME>", &
1604 0 : REPEAT(" ", l2)//"<NUMBER>"//TRIM(ADJUSTL(short_string))//"</NUMBER>", &
1605 0 : REPEAT(" ", l1)//"</REFERENCE>"
1606 : END DO
1607 : END IF
1608 :
1609 0 : WRITE (UNIT=unit_number, FMT="(A)") &
1610 0 : REPEAT(" ", l1)//"<LOCATION>"//TRIM(section%location)//"</LOCATION>"
1611 :
1612 0 : DO i = -1, section%n_keywords
1613 0 : IF (ASSOCIATED(section%keywords(i)%keyword)) THEN
1614 0 : CALL write_keyword_xml(section%keywords(i)%keyword, l1, unit_number)
1615 : END IF
1616 : END DO
1617 :
1618 0 : DO i = 1, section%n_subsections
1619 0 : CALL write_section_xml(section%subsections(i)%section, l1, unit_number)
1620 : END DO
1621 :
1622 0 : WRITE (UNIT=unit_number, FMT="(A)") REPEAT(" ", l0)//"</SECTION>"
1623 :
1624 : END IF
1625 :
1626 0 : END SUBROUTINE write_section_xml
1627 :
1628 : ! **************************************************************************************************
1629 : !> \brief ...
1630 : !> \param section ...
1631 : !> \param section_name ...
1632 : !> \param unknown_string ...
1633 : !> \param location_string ...
1634 : !> \param matching_rank ...
1635 : !> \param matching_string ...
1636 : !> \param bonus ...
1637 : ! **************************************************************************************************
1638 0 : RECURSIVE SUBROUTINE section_typo_match(section, section_name, unknown_string, location_string, &
1639 0 : matching_rank, matching_string, bonus)
1640 :
1641 : TYPE(section_type), INTENT(IN), POINTER :: section
1642 : CHARACTER(LEN=*) :: section_name, unknown_string, &
1643 : location_string
1644 : INTEGER, DIMENSION(:), INTENT(INOUT) :: matching_rank
1645 : CHARACTER(LEN=*), DIMENSION(:), INTENT(INOUT) :: matching_string
1646 : INTEGER, INTENT(IN) :: bonus
1647 :
1648 0 : CHARACTER(LEN=LEN(matching_string(1))) :: line
1649 : INTEGER :: i, imatch, imax, irank, newbonus
1650 :
1651 0 : IF (ASSOCIATED(section)) THEN
1652 0 : CPASSERT(section%ref_count > 0)
1653 0 : imatch = typo_match(TRIM(section%name), TRIM(unknown_string))
1654 0 : IF (imatch > 0) THEN
1655 0 : imatch = imatch + bonus
1656 : WRITE (UNIT=line, FMT='(T2,A)') &
1657 : " subsection "//TRIM(ADJUSTL(section%name))// &
1658 0 : " in section "//TRIM(ADJUSTL(location_string))
1659 0 : imax = SIZE(matching_rank, 1)
1660 0 : irank = imax + 1
1661 0 : DO I = imax, 1, -1
1662 0 : IF (imatch > matching_rank(I)) irank = i
1663 : END DO
1664 0 : IF (irank <= imax) THEN
1665 0 : matching_rank(irank + 1:imax) = matching_rank(irank:imax - 1)
1666 0 : matching_string(irank + 1:imax) = matching_string(irank:imax - 1)
1667 0 : matching_rank(irank) = imatch
1668 0 : matching_string(irank) = line
1669 : END IF
1670 : END IF
1671 :
1672 0 : IF (section_name == section%name) THEN
1673 0 : newbonus = 10
1674 : ELSE
1675 0 : newbonus = 0
1676 : END IF
1677 :
1678 0 : DO i = -1, section%n_keywords
1679 0 : IF (ASSOCIATED(section%keywords(i)%keyword)) THEN
1680 : CALL keyword_typo_match(section%keywords(i)%keyword, unknown_string, location_string// &
1681 0 : "%"//TRIM(section%name), matching_rank, matching_string, newbonus)
1682 : END IF
1683 : END DO
1684 :
1685 0 : DO i = 1, section%n_subsections
1686 : CALL section_typo_match(section%subsections(i)%section, section_name, unknown_string, &
1687 0 : location_string//"%"//TRIM(section%name), matching_rank, matching_string, newbonus)
1688 : END DO
1689 :
1690 : END IF
1691 :
1692 0 : END SUBROUTINE section_typo_match
1693 :
1694 : ! **************************************************************************************************
1695 : !> \brief replaces of the requested subsection with the one given
1696 : !> \param section_vals the root section
1697 : !> \param subsection_name the name of the subsection to replace
1698 : !> \param new_section_vals the new section_vals to use
1699 : !> \param i_rep_section index of the repetition of section_vals of which
1700 : !> you want to replace the subsection (defaults to 1)
1701 : !> \author fawzi
1702 : ! **************************************************************************************************
1703 4618 : SUBROUTINE section_vals_set_subs_vals(section_vals, subsection_name, &
1704 : new_section_vals, i_rep_section)
1705 : TYPE(section_vals_type), POINTER :: section_vals
1706 : CHARACTER(len=*), INTENT(in) :: subsection_name
1707 : TYPE(section_vals_type), POINTER :: new_section_vals
1708 : INTEGER, INTENT(in), OPTIONAL :: i_rep_section
1709 :
1710 : INTEGER :: irep, isection, len_key, my_index, &
1711 : tmp_index
1712 : TYPE(section_vals_type), POINTER :: s_vals
1713 :
1714 4618 : CPASSERT(ASSOCIATED(section_vals))
1715 4618 : CPASSERT(section_vals%ref_count > 0)
1716 4618 : CPASSERT(ASSOCIATED(new_section_vals))
1717 4618 : CPASSERT(new_section_vals%ref_count > 0)
1718 :
1719 4618 : irep = 1
1720 4618 : IF (PRESENT(i_rep_section)) irep = i_rep_section
1721 :
1722 4618 : my_index = INDEX(subsection_name, '%') + 1
1723 4618 : len_key = LEN_TRIM(subsection_name)
1724 4618 : IF (my_index > 1) THEN
1725 5854 : DO
1726 8646 : tmp_index = INDEX(subsection_name(my_index:len_key), "%")
1727 8646 : IF (tmp_index <= 0) EXIT
1728 5854 : my_index = my_index + tmp_index
1729 : END DO
1730 2792 : s_vals => section_vals_get_subs_vals(section_vals, subsection_name(1:my_index - 2))
1731 : ELSE
1732 1826 : s_vals => section_vals
1733 : END IF
1734 :
1735 4618 : CPASSERT(irep <= SIZE(s_vals%subs_vals, 2))
1736 :
1737 4618 : isection = section_get_subsection_index(s_vals%section, subsection_name(my_index:LEN_TRIM(subsection_name)))
1738 4618 : IF (isection <= 0) &
1739 : CALL cp_abort(__LOCATION__, &
1740 : "could not find subsection "//subsection_name(my_index:LEN_TRIM(subsection_name))//" in section "// &
1741 0 : TRIM(section_vals%section%name)//" at ")
1742 4618 : CALL section_vals_retain(new_section_vals)
1743 4618 : CALL section_vals_release(s_vals%subs_vals(isection, irep)%section_vals)
1744 4618 : s_vals%subs_vals(isection, irep)%section_vals => new_section_vals
1745 :
1746 4618 : END SUBROUTINE section_vals_set_subs_vals
1747 :
1748 : ! **************************************************************************************************
1749 : !> \brief creates a deep copy from section_vals_in to section_vals_out
1750 : !> \param section_vals_in the section_vals to copy
1751 : !> \param section_vals_out the section_vals to create
1752 : !> \param i_rep_start ...
1753 : !> \param i_rep_end ...
1754 : !> \author fawzi
1755 : ! **************************************************************************************************
1756 1651 : SUBROUTINE section_vals_duplicate(section_vals_in, section_vals_out, &
1757 : i_rep_start, i_rep_end)
1758 : TYPE(section_vals_type), POINTER :: section_vals_in, section_vals_out
1759 : INTEGER, INTENT(IN), OPTIONAL :: i_rep_start, i_rep_end
1760 :
1761 1651 : CPASSERT(ASSOCIATED(section_vals_in))
1762 1651 : CPASSERT(.NOT. ASSOCIATED(section_vals_out))
1763 1651 : CALL section_vals_create(section_vals_out, section_vals_in%section)
1764 1651 : CALL section_vals_copy(section_vals_in, section_vals_out, i_rep_start, i_rep_end)
1765 1651 : END SUBROUTINE section_vals_duplicate
1766 :
1767 : ! **************************************************************************************************
1768 : !> \brief deep copy from section_vals_in to section_vals_out
1769 : !> \param section_vals_in the section_vals to copy
1770 : !> \param section_vals_out the section_vals where to copy
1771 : !> \param i_rep_low ...
1772 : !> \param i_rep_high ...
1773 : !> \author fawzi
1774 : !> \note
1775 : !> private, only works with a newly initialized section_vals_out
1776 : ! **************************************************************************************************
1777 5179668 : RECURSIVE SUBROUTINE section_vals_copy(section_vals_in, section_vals_out, &
1778 : i_rep_low, i_rep_high)
1779 : TYPE(section_vals_type), POINTER :: section_vals_in, section_vals_out
1780 : INTEGER, INTENT(IN), OPTIONAL :: i_rep_low, i_rep_high
1781 :
1782 : INTEGER :: iend, irep, isec, istart, ival
1783 : TYPE(cp_sll_val_type), POINTER :: v1, v2
1784 : TYPE(val_type), POINTER :: el
1785 :
1786 5179668 : NULLIFY (v2, el)
1787 :
1788 5179668 : CPASSERT(ASSOCIATED(section_vals_in))
1789 5179668 : CPASSERT(ASSOCIATED(section_vals_out))
1790 : ! IF(.NOT. ASSOCIATED(section_vals_in%section, section_vals_out%section))&
1791 : ! CPABORT("")
1792 :
1793 5179668 : istart = 1
1794 5179668 : iend = SIZE(section_vals_in%values, 2)
1795 5179668 : IF (PRESENT(i_rep_low)) istart = i_rep_low
1796 5179668 : IF (PRESENT(i_rep_high)) iend = i_rep_high
1797 5197191 : DO irep = istart, iend
1798 17523 : CALL section_vals_add_values(section_vals_out)
1799 5405068 : DO ival = LBOUND(section_vals_in%values, 1), UBOUND(section_vals_in%values, 1)
1800 172831 : v1 => section_vals_in%values(ival, irep)%list
1801 190354 : IF (ASSOCIATED(v1)) THEN
1802 36018 : CALL val_duplicate(v1%first_el, el)
1803 36018 : CALL cp_sll_val_create(v2, el)
1804 36018 : NULLIFY (el)
1805 36018 : section_vals_out%values(ival, irep - istart + 1)%list => v2
1806 45966 : DO
1807 81984 : IF (.NOT. ASSOCIATED(v1%rest)) EXIT
1808 45966 : v1 => v1%rest
1809 45966 : CALL val_duplicate(v1%first_el, el)
1810 45966 : CALL cp_sll_val_create(v2%rest, first_el=el)
1811 45966 : NULLIFY (el)
1812 45966 : v2 => v2%rest
1813 : END DO
1814 : END IF
1815 : END DO
1816 : END DO
1817 5179668 : IF (.NOT. PRESENT(i_rep_low) .AND. (.NOT. PRESENT(i_rep_high))) THEN
1818 5179164 : IF (.NOT. (SIZE(section_vals_in%values, 2) == SIZE(section_vals_out%values, 2))) &
1819 0 : CPABORT("")
1820 5179164 : IF (.NOT. (SIZE(section_vals_in%subs_vals, 2) == SIZE(section_vals_out%subs_vals, 2))) &
1821 0 : CPABORT("")
1822 : END IF
1823 5179668 : iend = SIZE(section_vals_in%subs_vals, 2)
1824 5179668 : IF (PRESENT(i_rep_high)) iend = i_rep_high
1825 10360469 : DO irep = istart, iend
1826 15538486 : DO isec = 1, SIZE(section_vals_in%subs_vals, 1)
1827 : CALL section_vals_copy(section_vals_in%subs_vals(isec, irep)%section_vals, &
1828 10358818 : section_vals_out%subs_vals(isec, irep - istart + 1)%section_vals)
1829 : END DO
1830 : END DO
1831 :
1832 5179668 : END SUBROUTINE section_vals_copy
1833 :
1834 0 : END MODULE input_section_types
|
