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