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 :
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 : INTEGER, POINTER, DIMENSION(:) :: citations => NULL()
109 : TYPE(keyword_p_type), DIMENSION(:), POINTER :: keywords => NULL()
110 : TYPE(section_p_type), POINTER, DIMENSION(:) :: subsections => NULL()
111 : END TYPE section_type
112 :
113 : ! **************************************************************************************************
114 : !> \brief repesents a pointer to a parsed section (to make arrays of pointers)
115 : !> \param section_vals the pointer to the parsed section
116 : !> \author fawzi
117 : ! **************************************************************************************************
118 : TYPE section_vals_p_type
119 : TYPE(section_vals_type), POINTER :: section_vals => NULL()
120 : END TYPE section_vals_p_type
121 :
122 : ! **************************************************************************************************
123 : !> \brief stores the values of a section
124 : !> \author fawzi
125 : ! **************************************************************************************************
126 : TYPE section_vals_type
127 : INTEGER :: ref_count = 0
128 : INTEGER, POINTER, DIMENSION(:) :: ibackup => NULL()
129 : TYPE(section_type), POINTER :: section => NULL()
130 : TYPE(cp_sll_val_p_type), DIMENSION(:, :), POINTER :: values => NULL()
131 : TYPE(section_vals_p_type), DIMENSION(:, :), POINTER :: subs_vals => NULL()
132 : END TYPE section_vals_type
133 :
134 : TYPE(section_type), POINTER, SAVE :: typo_match_section => NULL()
135 : INTEGER, PARAMETER :: n_typo_matches = 5
136 : INTEGER, DIMENSION(n_typo_matches) :: typo_matching_rank = 0
137 : CHARACTER(LEN=default_string_length*5), DIMENSION(n_typo_matches):: typo_matching_line = ""
138 :
139 : CONTAINS
140 :
141 : ! **************************************************************************************************
142 : !> \brief creates a list of keywords
143 : !> \param section the list to be created
144 : !> \param location from where in the source code section_create() is called
145 : !> \param name ...
146 : !> \param description ...
147 : !> \param n_keywords hint about the number of keywords, defaults to 10
148 : !> \param n_subsections a hint about how many sections will be added to this
149 : !> structure, defaults to 0
150 : !> \param repeats if this section can repeat (defaults to false)
151 : !> \param citations ...
152 : !> \author fawzi
153 : ! **************************************************************************************************
154 69422231 : SUBROUTINE section_create(section, location, name, description, n_keywords, &
155 3932483 : n_subsections, repeats, citations)
156 :
157 : TYPE(section_type), POINTER :: section
158 : CHARACTER(len=*), INTENT(in) :: location, name, description
159 : INTEGER, INTENT(in), OPTIONAL :: n_keywords, n_subsections
160 : LOGICAL, INTENT(in), OPTIONAL :: repeats
161 : INTEGER, DIMENSION(:), INTENT(IN), OPTIONAL :: citations
162 :
163 : INTEGER :: i, my_n_keywords, my_n_subsections, n
164 :
165 69422231 : CPASSERT(.NOT. ASSOCIATED(section))
166 69422231 : my_n_keywords = 10
167 69422231 : IF (PRESENT(n_keywords)) my_n_keywords = n_keywords
168 69422231 : my_n_subsections = 0
169 69422231 : IF (PRESENT(n_subsections)) my_n_subsections = n_subsections
170 :
171 69422231 : ALLOCATE (section)
172 69422231 : section%ref_count = 1
173 :
174 : section%n_keywords = 0
175 : section%n_subsections = 0
176 69422231 : section%location = location
177 :
178 69422231 : CPASSERT(LEN_TRIM(name) > 0)
179 69422231 : section%name = name
180 69422231 : CALL uppercase(section%name)
181 :
182 69422231 : n = LEN_TRIM(description)
183 208149831 : ALLOCATE (section%description(n))
184 6041382668 : DO i = 1, n
185 6041382668 : section%description(i) = description(i:i)
186 : END DO
187 :
188 69422231 : section%frozen = .FALSE.
189 69422231 : section%repeats = .FALSE.
190 69422231 : IF (PRESENT(repeats)) section%repeats = repeats
191 :
192 69422231 : NULLIFY (section%citations)
193 69422231 : IF (PRESENT(citations)) THEN
194 11797449 : ALLOCATE (section%citations(SIZE(citations)))
195 11179080 : section%citations = citations
196 : END IF
197 :
198 720523145 : ALLOCATE (section%keywords(-1:my_n_keywords))
199 581678683 : DO i = -1, my_n_keywords
200 581678683 : NULLIFY (section%keywords(i)%keyword)
201 : END DO
202 :
203 149148162 : ALLOCATE (section%subsections(my_n_subsections))
204 76024398 : DO i = 1, my_n_subsections
205 76024398 : NULLIFY (section%subsections(i)%section)
206 : END DO
207 :
208 69422231 : END SUBROUTINE section_create
209 :
210 : ! **************************************************************************************************
211 : !> \brief retains the given keyword list (see doc/ReferenceCounting.html)
212 : !> \param section the list to retain
213 : !> \author fawzi
214 : ! **************************************************************************************************
215 149159626 : SUBROUTINE section_retain(section)
216 :
217 : TYPE(section_type), POINTER :: section
218 :
219 149159626 : CPASSERT(ASSOCIATED(section))
220 149159626 : CPASSERT(section%ref_count > 0)
221 149159626 : section%ref_count = section%ref_count + 1
222 :
223 149159626 : END SUBROUTINE section_retain
224 :
225 : ! **************************************************************************************************
226 : !> \brief releases the given keyword list (see doc/ReferenceCounting.html)
227 : !> \param section the list to release
228 : !> \author fawzi
229 : ! **************************************************************************************************
230 299261261 : RECURSIVE SUBROUTINE section_release(section)
231 :
232 : TYPE(section_type), POINTER :: section
233 :
234 : INTEGER :: i
235 :
236 299261261 : IF (ASSOCIATED(section)) THEN
237 218581857 : CPASSERT(section%ref_count > 0)
238 218581857 : section%ref_count = section%ref_count - 1
239 218581857 : IF (section%ref_count == 0) THEN
240 69422231 : IF (ASSOCIATED(section%citations)) THEN
241 3932483 : DEALLOCATE (section%citations)
242 : END IF
243 69422231 : IF (ASSOCIATED(section%keywords)) THEN
244 896073494 : DO i = -1, UBOUND(section%keywords, 1)
245 826651263 : CALL keyword_release(section%keywords(i)%keyword)
246 : END DO
247 69422231 : DEALLOCATE (section%keywords)
248 : END IF
249 69422231 : section%n_keywords = 0
250 69422231 : IF (ASSOCIATED(section%subsections)) THEN
251 219457078 : DO i = 1, SIZE(section%subsections)
252 219457078 : CALL section_release(section%subsections(i)%section)
253 : END DO
254 69422231 : DEALLOCATE (section%subsections)
255 : END IF
256 69422231 : DEALLOCATE (section%description)
257 69422231 : DEALLOCATE (section)
258 : END IF
259 218581857 : NULLIFY (section)
260 : END IF
261 :
262 299261261 : END SUBROUTINE section_release
263 :
264 : ! **************************************************************************************************
265 : !> \brief collects additional information on the section for IO + documentation
266 : !> \param section ...
267 : !> \return ...
268 : !> \author fawzi
269 : ! **************************************************************************************************
270 1 : FUNCTION get_section_info(section) RESULT(message)
271 :
272 : TYPE(section_type), INTENT(IN) :: section
273 : CHARACTER(LEN=default_path_length) :: message
274 :
275 : INTEGER :: length
276 :
277 1 : message = " "
278 1 : length = LEN_TRIM(a2s(section%description))
279 1 : IF (length > 0) THEN
280 1 : IF (section%description(length) /= ".") THEN
281 0 : message = "."
282 : END IF
283 : END IF
284 1 : IF (section%repeats) THEN
285 0 : message = TRIM(message)//" This section can be repeated."
286 : ELSE
287 1 : message = TRIM(message)//" This section can not be repeated."
288 : END IF
289 :
290 1 : END FUNCTION get_section_info
291 :
292 : ! **************************************************************************************************
293 : !> \brief prints a description of the given section
294 : !> \param section the section to describe
295 : !> \param unit_nr the unit to write to
296 : !> \param level the level of output: 0: just section name, 1:keywords,
297 : !> then see keyword_describe :-)
298 : !> \param hide_root if the name of the first section should be hidden
299 : !> (defaults to false).
300 : !> \param recurse ...
301 : !> \author fawzi
302 : ! **************************************************************************************************
303 2 : RECURSIVE SUBROUTINE section_describe(section, unit_nr, level, hide_root, recurse)
304 :
305 : TYPE(section_type), INTENT(IN), POINTER :: section
306 : INTEGER, INTENT(in) :: unit_nr, level
307 : LOGICAL, INTENT(in), OPTIONAL :: hide_root
308 : INTEGER, INTENT(in), OPTIONAL :: recurse
309 :
310 : CHARACTER(LEN=default_path_length) :: message
311 : INTEGER :: ikeyword, isub, my_recurse
312 : LOGICAL :: my_hide_root
313 :
314 2 : IF (unit_nr > 0) THEN
315 1 : my_hide_root = .FALSE.
316 1 : IF (PRESENT(hide_root)) my_hide_root = hide_root
317 1 : my_recurse = 0
318 1 : IF (PRESENT(recurse)) my_recurse = recurse
319 1 : IF (ASSOCIATED(section)) THEN
320 1 : CPASSERT(section%ref_count > 0)
321 :
322 1 : IF (.NOT. my_hide_root) &
323 1 : WRITE (UNIT=unit_nr, FMT="('*** section &',A,' ***')") TRIM(ADJUSTL(section%name))
324 1 : IF (level > 1) THEN
325 1 : message = get_section_info(section)
326 1 : CALL print_message(TRIM(a2s(section%description))//TRIM(message), unit_nr, 0, 0, 0)
327 : END IF
328 1 : IF (level > 0) THEN
329 1 : IF (ASSOCIATED(section%keywords(-1)%keyword)) THEN
330 : CALL keyword_describe(section%keywords(-1)%keyword, unit_nr, &
331 0 : level)
332 : END IF
333 1 : IF (ASSOCIATED(section%keywords(0)%keyword)) THEN
334 : CALL keyword_describe(section%keywords(0)%keyword, unit_nr, &
335 0 : level)
336 : END IF
337 20 : DO ikeyword = 1, section%n_keywords
338 : CALL keyword_describe(section%keywords(ikeyword)%keyword, unit_nr, &
339 20 : level)
340 : END DO
341 : END IF
342 1 : IF (section%n_subsections > 0 .AND. my_recurse >= 0) THEN
343 1 : IF (.NOT. my_hide_root) &
344 1 : WRITE (UNIT=unit_nr, FMT="('** subsections **')")
345 15 : DO isub = 1, section%n_subsections
346 15 : IF (my_recurse > 0) THEN
347 : CALL section_describe(section%subsections(isub)%section, unit_nr, &
348 0 : level, recurse=my_recurse - 1)
349 : ELSE
350 14 : WRITE (UNIT=unit_nr, FMT="(1X,A)") section%subsections(isub)%section%name
351 : END IF
352 : END DO
353 : END IF
354 1 : IF (.NOT. my_hide_root) &
355 1 : WRITE (UNIT=unit_nr, FMT="('*** &end section ',A,' ***')") TRIM(ADJUSTL(section%name))
356 : ELSE
357 0 : WRITE (unit_nr, "(a)") '<section *null*>'
358 : END IF
359 : END IF
360 :
361 2 : END SUBROUTINE section_describe
362 :
363 : ! **************************************************************************************************
364 : !> \brief returns the index of requested subsection (-1 if not found)
365 : !> \param section the root section
366 : !> \param subsection_name the name of the subsection you want to get
367 : !> \return ...
368 : !> \author fawzi
369 : !> \note
370 : !> private utility function
371 : ! **************************************************************************************************
372 35509903 : FUNCTION section_get_subsection_index(section, subsection_name) RESULT(res)
373 :
374 : TYPE(section_type), INTENT(IN) :: section
375 : CHARACTER(len=*), INTENT(IN) :: subsection_name
376 : INTEGER :: res
377 :
378 : CHARACTER(len=default_string_length) :: upc_name
379 : INTEGER :: isub
380 :
381 0 : CPASSERT(section%ref_count > 0)
382 35509903 : res = -1
383 35509903 : upc_name = subsection_name
384 35509903 : CALL uppercase(upc_name)
385 278482475 : DO isub = 1, section%n_subsections
386 278482366 : CPASSERT(ASSOCIATED(section%subsections(isub)%section))
387 278482475 : IF (section%subsections(isub)%section%name == upc_name) THEN
388 : res = isub
389 : EXIT
390 : END IF
391 : END DO
392 :
393 35509903 : END FUNCTION section_get_subsection_index
394 :
395 : ! **************************************************************************************************
396 : !> \brief returns the requested subsection
397 : !> \param section the root section
398 : !> \param subsection_name the name of the subsection you want to get
399 : !> \return ...
400 : !> \author fawzi
401 : ! **************************************************************************************************
402 164 : FUNCTION section_get_subsection(section, subsection_name) RESULT(res)
403 :
404 : TYPE(section_type), INTENT(IN) :: section
405 : CHARACTER(len=*), INTENT(IN) :: subsection_name
406 : TYPE(section_type), POINTER :: res
407 :
408 : INTEGER :: isub
409 :
410 164 : isub = section_get_subsection_index(section, subsection_name)
411 164 : IF (isub > 0) THEN
412 164 : res => section%subsections(isub)%section
413 : ELSE
414 : NULLIFY (res)
415 : END IF
416 :
417 164 : END FUNCTION section_get_subsection
418 :
419 : ! **************************************************************************************************
420 : !> \brief returns the index of the requested keyword (or -2 if not found)
421 : !> \param section the section the keyword is in
422 : !> \param keyword_name the keyword you are interested in
423 : !> \return ...
424 : !> \author fawzi
425 : !> \note
426 : !> private utility function
427 : ! **************************************************************************************************
428 44716228 : FUNCTION section_get_keyword_index(section, keyword_name) RESULT(res)
429 :
430 : TYPE(section_type), INTENT(IN) :: section
431 : CHARACTER(len=*), INTENT(IN) :: keyword_name
432 : INTEGER :: res
433 :
434 : INTEGER :: ik, in
435 : CHARACTER(len=default_string_length) :: upc_name
436 :
437 0 : CPASSERT(section%ref_count > 0)
438 44716228 : CPASSERT(ASSOCIATED(section%keywords))
439 44716228 : res = -2
440 44716228 : upc_name = keyword_name
441 44716228 : CALL uppercase(upc_name)
442 134148684 : DO ik = -1, 0
443 134148684 : IF (ASSOCIATED(section%keywords(ik)%keyword)) THEN
444 24408288 : IF (section%keywords(ik)%keyword%names(1) == upc_name) THEN
445 8179546 : res = ik
446 : END IF
447 : END IF
448 : END DO
449 44716228 : IF (res == -2) THEN
450 159614115 : k_search_loop: DO ik = 1, section%n_keywords
451 159331587 : CPASSERT(ASSOCIATED(section%keywords(ik)%keyword))
452 299293123 : DO in = 1, SIZE(section%keywords(ik)%keyword%names)
453 299010595 : IF (section%keywords(ik)%keyword%names(in) == upc_name) THEN
454 : res = ik
455 : EXIT k_search_loop
456 : END IF
457 : END DO
458 : END DO k_search_loop
459 : END IF
460 :
461 44716228 : END FUNCTION section_get_keyword_index
462 :
463 : ! **************************************************************************************************
464 : !> \brief returns the requested keyword
465 : !> \param section the section the keyword is in
466 : !> \param keyword_name the keyword you are interested in
467 : !> \return ...
468 : !> \author fawzi
469 : ! **************************************************************************************************
470 50163 : RECURSIVE FUNCTION section_get_keyword(section, keyword_name) RESULT(res)
471 :
472 : TYPE(section_type), INTENT(IN) :: section
473 : CHARACTER(len=*), INTENT(IN) :: keyword_name
474 : TYPE(keyword_type), POINTER :: res
475 :
476 : INTEGER :: ik, my_index
477 :
478 50163 : IF (INDEX(keyword_name, "%") /= 0) THEN
479 1951 : my_index = INDEX(keyword_name, "%") + 1
480 1951 : CPASSERT(ASSOCIATED(section%subsections))
481 13283 : DO ik = LBOUND(section%subsections, 1), UBOUND(section%subsections, 1)
482 9381 : IF (section%subsections(ik)%section%name == keyword_name(1:my_index - 2)) EXIT
483 : END DO
484 1951 : CPASSERT(ik <= UBOUND(section%subsections, 1))
485 1951 : res => section_get_keyword(section%subsections(ik)%section, keyword_name(my_index:))
486 : ELSE
487 48212 : ik = section_get_keyword_index(section, keyword_name)
488 48212 : IF (ik == -2) THEN
489 : NULLIFY (res)
490 : ELSE
491 48212 : res => section%keywords(ik)%keyword
492 : END IF
493 : END IF
494 :
495 50163 : END FUNCTION section_get_keyword
496 :
497 : ! **************************************************************************************************
498 : !> \brief adds a keyword to the given section
499 : !> \param section the section to which the keyword should be added
500 : !> \param keyword the keyword to add
501 : !> \author fawzi
502 : ! **************************************************************************************************
503 510546574 : SUBROUTINE section_add_keyword(section, keyword)
504 :
505 : TYPE(section_type), INTENT(INOUT) :: section
506 : TYPE(keyword_type), INTENT(IN), POINTER :: keyword
507 :
508 : INTEGER :: i, j, k
509 510546574 : TYPE(keyword_p_type), DIMENSION(:), POINTER :: new_keywords
510 :
511 0 : CPASSERT(section%ref_count > 0)
512 510546574 : CPASSERT(.NOT. section%frozen)
513 510546574 : CPASSERT(ASSOCIATED(keyword))
514 510546574 : CPASSERT(keyword%ref_count > 0)
515 510546574 : CALL keyword_retain(keyword)
516 510546574 : IF (keyword%names(1) == "_SECTION_PARAMETERS_") THEN
517 52534702 : CALL keyword_release(section%keywords(-1)%keyword)
518 52534702 : section%keywords(-1)%keyword => keyword
519 458011872 : ELSE IF (keyword%names(1) == "_DEFAULT_KEYWORD_") THEN
520 1844648 : CALL keyword_release(section%keywords(0)%keyword)
521 1844648 : section%keywords(0)%keyword => keyword
522 : ELSE
523 922636714 : DO k = 1, SIZE(keyword%names)
524 4080163749 : DO i = 1, section%n_keywords
525 6875060477 : DO j = 1, SIZE(section%keywords(i)%keyword%names)
526 6408590987 : IF (keyword%names(k) == section%keywords(i)%keyword%names(j)) THEN
527 : CALL cp_abort(__LOCATION__, &
528 : "trying to add a keyword with a name ("// &
529 : TRIM(keyword%names(k))//") that was already used in section " &
530 0 : //TRIM(section%name))
531 : END IF
532 : END DO
533 : END DO
534 : END DO
535 :
536 912334448 : IF (UBOUND(section%keywords, 1) == section%n_keywords) THEN
537 485714357 : ALLOCATE (new_keywords(-1:section%n_keywords + 10))
538 191747261 : DO i = -1, section%n_keywords
539 191747261 : new_keywords(i)%keyword => section%keywords(i)%keyword
540 : END DO
541 293967096 : DO i = section%n_keywords + 1, UBOUND(new_keywords, 1)
542 269469838 : NULLIFY (new_keywords(i)%keyword)
543 : END DO
544 24497258 : DEALLOCATE (section%keywords)
545 24497258 : section%keywords => new_keywords
546 : END IF
547 456167224 : section%n_keywords = section%n_keywords + 1
548 456167224 : section%keywords(section%n_keywords)%keyword => keyword
549 : END IF
550 :
551 510546574 : END SUBROUTINE section_add_keyword
552 :
553 : ! **************************************************************************************************
554 : !> \brief adds a subsection to the given section
555 : !> \param section to section to which you want to add a subsection
556 : !> \param subsection the subsection to add
557 : !> \author fawzi
558 : ! **************************************************************************************************
559 69381597 : SUBROUTINE section_add_subsection(section, subsection)
560 :
561 : TYPE(section_type), INTENT(INOUT) :: section
562 : TYPE(section_type), INTENT(IN), POINTER :: subsection
563 :
564 : INTEGER :: i
565 69381597 : TYPE(section_p_type), DIMENSION(:), POINTER :: new_subsections
566 :
567 0 : CPASSERT(section%ref_count > 0)
568 69381597 : CPASSERT(ASSOCIATED(subsection))
569 69381597 : CPASSERT(subsection%ref_count > 0)
570 69381597 : IF (SIZE(section%subsections) < section%n_subsections + 1) THEN
571 1733148489 : ALLOCATE (new_subsections(section%n_subsections + 10))
572 1561029273 : DO i = 1, section%n_subsections
573 1561029273 : new_subsections(i)%section => section%subsections(i)%section
574 : END DO
575 157775948 : DO i = section%n_subsections + 1, SIZE(new_subsections)
576 157775948 : NULLIFY (new_subsections(i)%section)
577 : END DO
578 14343268 : DEALLOCATE (section%subsections)
579 14343268 : section%subsections => new_subsections
580 : END IF
581 15743445692 : DO i = 1, section%n_subsections
582 15674064095 : IF (subsection%name == section%subsections(i)%section%name) &
583 : CALL cp_abort(__LOCATION__, &
584 : "trying to add a subsection with a name ("// &
585 : TRIM(subsection%name)//") that was already used in section " &
586 69381597 : //TRIM(section%name))
587 : END DO
588 69381597 : CALL section_retain(subsection)
589 69381597 : section%n_subsections = section%n_subsections + 1
590 69381597 : section%subsections(section%n_subsections)%section => subsection
591 :
592 69381597 : END SUBROUTINE section_add_subsection
593 :
594 : ! **************************************************************************************************
595 : !> \brief creates a object where to store the values of a section
596 : !> \param section_vals the parsed section that will be created
597 : !> \param section the structure of the section that you want to parse
598 : !> \author fawzi
599 : ! **************************************************************************************************
600 79778029 : RECURSIVE SUBROUTINE section_vals_create(section_vals, section)
601 :
602 : TYPE(section_vals_type), POINTER :: section_vals
603 : TYPE(section_type), POINTER :: section
604 :
605 : INTEGER :: i
606 :
607 79778029 : CPASSERT(.NOT. ASSOCIATED(section_vals))
608 79778029 : ALLOCATE (section_vals)
609 79778029 : section_vals%ref_count = 1
610 79778029 : CALL section_retain(section)
611 79778029 : section_vals%section => section
612 79778029 : section%frozen = .TRUE.
613 159556058 : ALLOCATE (section_vals%values(-1:section%n_keywords, 0))
614 330567432 : ALLOCATE (section_vals%subs_vals(section%n_subsections, 1))
615 159489980 : DO i = 1, section%n_subsections
616 79711951 : NULLIFY (section_vals%subs_vals(i, 1)%section_vals)
617 : CALL section_vals_create(section_vals%subs_vals(i, 1)%section_vals, &
618 159489980 : section=section%subsections(i)%section)
619 : END DO
620 :
621 79778029 : NULLIFY (section_vals%ibackup)
622 :
623 79778029 : END SUBROUTINE section_vals_create
624 :
625 : ! **************************************************************************************************
626 : !> \brief retains the given section values (see doc/ReferenceCounting.html)
627 : !> \param section_vals the object to retain
628 : !> \author fawzi
629 : ! **************************************************************************************************
630 73297 : SUBROUTINE section_vals_retain(section_vals)
631 :
632 : TYPE(section_vals_type), POINTER :: section_vals
633 :
634 73297 : CPASSERT(ASSOCIATED(section_vals))
635 73297 : CPASSERT(section_vals%ref_count > 0)
636 73297 : section_vals%ref_count = section_vals%ref_count + 1
637 :
638 73297 : END SUBROUTINE section_vals_retain
639 :
640 : ! **************************************************************************************************
641 : !> \brief releases the given object
642 : !> \param section_vals the section_vals to release
643 : !> \author fawzi
644 : ! **************************************************************************************************
645 79864772 : RECURSIVE SUBROUTINE section_vals_release(section_vals)
646 :
647 : TYPE(section_vals_type), POINTER :: section_vals
648 :
649 : INTEGER :: i, j
650 : TYPE(cp_sll_val_type), POINTER :: vals
651 : TYPE(val_type), POINTER :: el
652 :
653 79864772 : IF (ASSOCIATED(section_vals)) THEN
654 79851326 : CPASSERT(section_vals%ref_count > 0)
655 79851326 : section_vals%ref_count = section_vals%ref_count - 1
656 79851326 : IF (section_vals%ref_count == 0) THEN
657 79778029 : CALL section_release(section_vals%section)
658 80036757 : DO j = 1, SIZE(section_vals%values, 2)
659 83355049 : DO i = -1, UBOUND(section_vals%values, 1)
660 3059564 : vals => section_vals%values(i, j)%list
661 3892855 : DO WHILE (cp_sll_val_next(vals, el_att=el))
662 833291 : CALL val_release(el)
663 : END DO
664 3318292 : CALL cp_sll_val_dealloc(section_vals%values(i, j)%list)
665 : END DO
666 : END DO
667 79778029 : DEALLOCATE (section_vals%values)
668 159578312 : DO j = 1, SIZE(section_vals%subs_vals, 2)
669 239345373 : DO i = 1, SIZE(section_vals%subs_vals, 1)
670 159567344 : CALL section_vals_release(section_vals%subs_vals(i, j)%section_vals)
671 : END DO
672 : END DO
673 79778029 : DEALLOCATE (section_vals%subs_vals)
674 79778029 : IF (ASSOCIATED(section_vals%ibackup)) THEN
675 3739 : DEALLOCATE (section_vals%ibackup)
676 : END IF
677 79778029 : DEALLOCATE (section_vals)
678 : END IF
679 : END IF
680 :
681 79864772 : END SUBROUTINE section_vals_release
682 :
683 : ! **************************************************************************************************
684 : !> \brief returns various attributes about the section_vals
685 : !> \param section_vals the section vals you want information from
686 : !> \param ref_count ...
687 : !> \param n_repetition number of repetitions of the section
688 : !> \param n_subs_vals_rep number of repetitions of the subsections values
689 : !> (max(1,n_repetition))
690 : !> \param section ...
691 : !> \param explicit if the section was explicitly present in
692 : !> \author fawzi
693 : !> \note For the other arguments see the attributes of section_vals_type
694 : ! **************************************************************************************************
695 4183540 : SUBROUTINE section_vals_get(section_vals, ref_count, n_repetition, &
696 : n_subs_vals_rep, section, explicit)
697 :
698 : TYPE(section_vals_type), INTENT(IN) :: section_vals
699 : INTEGER, INTENT(out), OPTIONAL :: ref_count, n_repetition, n_subs_vals_rep
700 : TYPE(section_type), OPTIONAL, POINTER :: section
701 : LOGICAL, INTENT(out), OPTIONAL :: explicit
702 :
703 4183540 : CPASSERT(section_vals%ref_count > 0)
704 4183540 : IF (PRESENT(ref_count)) ref_count = section_vals%ref_count
705 4183540 : IF (PRESENT(section)) section => section_vals%section
706 4183540 : IF (PRESENT(n_repetition)) n_repetition = SIZE(section_vals%values, 2)
707 4183540 : IF (PRESENT(n_subs_vals_rep)) n_subs_vals_rep = SIZE(section_vals%subs_vals, 2)
708 4183540 : IF (PRESENT(explicit)) explicit = (SIZE(section_vals%values, 2) > 0)
709 :
710 4183540 : END SUBROUTINE section_vals_get
711 :
712 : ! **************************************************************************************************
713 : !> \brief returns the values of the requested subsection
714 : !> \param section_vals the root section
715 : !> \param subsection_name the name of the requested subsection
716 : !> \param i_rep_section index of the repetition of section_vals from which
717 : !> you want to extract the subsection (defaults to 1)
718 : !> \param can_return_null if the results can be null (defaults to false)
719 : !> \return ...
720 : !> \author fawzi
721 : ! **************************************************************************************************
722 35209487 : RECURSIVE FUNCTION section_vals_get_subs_vals(section_vals, subsection_name, &
723 : i_rep_section, can_return_null) RESULT(res)
724 :
725 : TYPE(section_vals_type), INTENT(IN) :: section_vals
726 : CHARACTER(len=*), INTENT(IN) :: subsection_name
727 : INTEGER, INTENT(IN), OPTIONAL :: i_rep_section
728 : LOGICAL, INTENT(IN), OPTIONAL :: can_return_null
729 : TYPE(section_vals_type), POINTER :: res
730 :
731 : INTEGER :: irep, isection, my_index
732 : LOGICAL :: is_path, my_can_return_null
733 :
734 35209487 : CPASSERT(section_vals%ref_count > 0)
735 :
736 35209487 : my_can_return_null = .FALSE.
737 35209487 : IF (PRESENT(can_return_null)) my_can_return_null = can_return_null
738 35209487 : NULLIFY (res)
739 35209487 : irep = 1
740 35209487 : IF (PRESENT(i_rep_section)) irep = i_rep_section
741 :
742 : ! prepare for recursive parsing of subsections. i_rep_section will be used for last section
743 35209487 : my_index = INDEX(subsection_name, "%")
744 35209487 : IF (my_index .EQ. 0) THEN
745 20620158 : is_path = .FALSE.
746 20620158 : my_index = LEN_TRIM(subsection_name)
747 : ELSE
748 14589329 : is_path = .TRUE.
749 14589329 : irep = 1
750 14589329 : my_index = my_index - 1
751 : END IF
752 :
753 35209487 : CPASSERT(irep <= SIZE(section_vals%subs_vals, 2))
754 :
755 35209487 : isection = section_get_subsection_index(section_vals%section, subsection_name(1:my_index))
756 35209487 : IF (isection > 0) res => section_vals%subs_vals(isection, irep)%section_vals
757 35209487 : IF (.NOT. (ASSOCIATED(res) .OR. my_can_return_null)) &
758 : CALL cp_abort(__LOCATION__, &
759 : "could not find subsection "//TRIM(subsection_name(1:my_index))//" in section "// &
760 0 : TRIM(section_vals%section%name)//" at ")
761 35209487 : IF (is_path .AND. ASSOCIATED(res)) THEN
762 : res => section_vals_get_subs_vals(res, subsection_name(my_index + 2:LEN_TRIM(subsection_name)), &
763 14589329 : i_rep_section, can_return_null)
764 : END IF
765 :
766 35209487 : END FUNCTION section_vals_get_subs_vals
767 :
768 : ! **************************************************************************************************
769 : !> \brief returns the values of the n-th non default subsection (null if no
770 : !> such section exists (not so many non default section))
771 : !> \param section_vals the root section
772 : !> \param i_section index of the section
773 : !> \param i_rep_section index of the repetition of section_vals from which
774 : !> you want to extract the subsection (defaults to 1)
775 : !> \return ...
776 : !> \author fawzi
777 : ! **************************************************************************************************
778 918389 : FUNCTION section_vals_get_subs_vals2(section_vals, i_section, i_rep_section) RESULT(res)
779 :
780 : TYPE(section_vals_type), POINTER :: section_vals
781 : INTEGER, INTENT(in) :: i_section
782 : INTEGER, INTENT(in), OPTIONAL :: i_rep_section
783 : TYPE(section_vals_type), POINTER :: res
784 :
785 : INTEGER :: i, irep, isect_att
786 :
787 918389 : CPASSERT(ASSOCIATED(section_vals))
788 918389 : CPASSERT(section_vals%ref_count > 0)
789 918389 : NULLIFY (res)
790 918389 : irep = 1
791 918389 : IF (PRESENT(i_rep_section)) irep = i_rep_section
792 918389 : CPASSERT(irep <= SIZE(section_vals%subs_vals, 2))
793 918389 : isect_att = 0
794 473734756 : DO i = 1, section_vals%section%n_subsections
795 473734756 : IF (SIZE(section_vals%subs_vals(i, irep)%section_vals%values, 2) > 0) THEN
796 998491 : isect_att = isect_att + 1
797 998491 : IF (isect_att == i_section) THEN
798 : res => section_vals%subs_vals(i, irep)%section_vals
799 : EXIT
800 : END IF
801 : END IF
802 : END DO
803 918389 : END FUNCTION section_vals_get_subs_vals2
804 :
805 : ! **************************************************************************************************
806 : !> \brief returns the values of the n-th non default subsection (null if no
807 : !> such section exists (not so many non default section))
808 : !> \param section_vals the root section
809 : !> \param subsection_name ...
810 : !> \param i_rep_section index of the repetition of section_vals from which
811 : !> you want to extract the subsection (defaults to 1)
812 : !> \return ...
813 : !> \author fawzi
814 : ! **************************************************************************************************
815 70874 : FUNCTION section_vals_get_subs_vals3(section_vals, subsection_name, &
816 : i_rep_section) RESULT(res)
817 :
818 : TYPE(section_vals_type), INTENT(IN) :: section_vals
819 : CHARACTER(LEN=*), INTENT(IN) :: subsection_name
820 : INTEGER, INTENT(in), OPTIONAL :: i_rep_section
821 : TYPE(section_vals_type), POINTER :: res
822 :
823 : INTEGER :: i_section, irep
824 :
825 70874 : CPASSERT(section_vals%ref_count > 0)
826 70874 : NULLIFY (res)
827 70874 : irep = 1
828 70874 : IF (PRESENT(i_rep_section)) irep = i_rep_section
829 70874 : CPASSERT(irep <= SIZE(section_vals%subs_vals, 2))
830 70874 : i_section = section_get_subsection_index(section_vals%section, subsection_name)
831 70874 : res => section_vals%subs_vals(i_section, irep)%section_vals
832 :
833 70874 : END FUNCTION section_vals_get_subs_vals3
834 :
835 : ! **************************************************************************************************
836 : !> \brief adds the place to store the values of a repetition of the section
837 : !> \param section_vals the section you want to extend
838 : !> \author fawzi
839 : ! **************************************************************************************************
840 268386 : SUBROUTINE section_vals_add_values(section_vals)
841 :
842 : TYPE(section_vals_type), INTENT(INOUT) :: section_vals
843 :
844 : INTEGER :: i, j
845 268386 : TYPE(cp_sll_val_p_type), DIMENSION(:, :), POINTER :: new_values
846 : TYPE(section_vals_p_type), DIMENSION(:, :), &
847 268386 : POINTER :: new_sps
848 :
849 0 : CPASSERT(section_vals%ref_count > 0)
850 5335158 : ALLOCATE (new_values(-1:UBOUND(section_vals%values, 1), SIZE(section_vals%values, 2) + 1))
851 325458 : DO j = 1, SIZE(section_vals%values, 2)
852 1181437 : DO i = -1, UBOUND(section_vals%values, 1)
853 855979 : new_values(i, j)%list => section_vals%values(i, j)%list
854 : END DO
855 : END DO
856 268386 : DEALLOCATE (section_vals%values)
857 268386 : section_vals%values => new_values
858 268386 : j = SIZE(new_values, 2)
859 3674021 : DO i = -1, UBOUND(new_values, 1)
860 3405635 : NULLIFY (new_values(i, j)%list)
861 : END DO
862 :
863 268386 : IF (SIZE(new_values, 2) > 1) THEN
864 : ALLOCATE (new_sps(SIZE(section_vals%subs_vals, 1), &
865 332904 : SIZE(section_vals%subs_vals, 2) + 1))
866 79326 : DO j = 1, SIZE(section_vals%subs_vals, 2)
867 202344 : DO i = 1, SIZE(section_vals%subs_vals, 1)
868 180090 : new_sps(i, j)%section_vals => section_vals%subs_vals(i, j)%section_vals
869 : END DO
870 : END DO
871 22254 : DEALLOCATE (section_vals%subs_vals)
872 22254 : section_vals%subs_vals => new_sps
873 22254 : j = SIZE(new_sps, 2)
874 77364 : DO i = 1, SIZE(new_sps, 1)
875 55110 : NULLIFY (new_sps(i, j)%section_vals)
876 : CALL section_vals_create(new_sps(i, SIZE(new_sps, 2))%section_vals, &
877 77364 : section=section_vals%section%subsections(i)%section)
878 : END DO
879 : END IF
880 :
881 268386 : END SUBROUTINE section_vals_add_values
882 :
883 : ! **************************************************************************************************
884 : !> \brief removes the values of a repetition of the section
885 : !> \param section_vals the section you want to extend
886 : !> \author fawzi
887 : ! **************************************************************************************************
888 68753 : SUBROUTINE section_vals_remove_values(section_vals)
889 :
890 : TYPE(section_vals_type), POINTER :: section_vals
891 :
892 : INTEGER :: i, j
893 68753 : TYPE(cp_sll_val_p_type), DIMENSION(:, :), POINTER :: new_values
894 : TYPE(cp_sll_val_type), POINTER :: vals
895 : TYPE(val_type), POINTER :: el
896 :
897 68753 : IF (ASSOCIATED(section_vals)) THEN
898 68753 : CPASSERT(section_vals%ref_count > 0)
899 68753 : NULLIFY (el, vals)
900 : ! Allocate a null 0 dimension array of values
901 206259 : ALLOCATE (new_values(-1:section_vals%section%n_keywords, 0))
902 : ! Release old values
903 78411 : DO j = 1, SIZE(section_vals%values, 2)
904 165754 : DO i = -1, UBOUND(section_vals%values, 1)
905 77685 : vals => section_vals%values(i, j)%list
906 656726 : DO WHILE (cp_sll_val_next(vals, el_att=el))
907 579041 : CALL val_release(el)
908 : END DO
909 87343 : CALL cp_sll_val_dealloc(section_vals%values(i, j)%list)
910 : END DO
911 : END DO
912 68753 : DEALLOCATE (section_vals%values)
913 68753 : section_vals%values => new_values
914 : END IF
915 :
916 68753 : END SUBROUTINE section_vals_remove_values
917 :
918 : ! **************************************************************************************************
919 : !> \brief ...
920 : !> \param section_vals ...
921 : !> \param keyword_name ...
922 : !> \return ...
923 : ! **************************************************************************************************
924 0 : FUNCTION section_get_cval(section_vals, keyword_name) RESULT(res)
925 :
926 : TYPE(section_vals_type), INTENT(IN) :: section_vals
927 : CHARACTER(len=*), INTENT(in) :: keyword_name
928 : CHARACTER(LEN=default_string_length) :: res
929 :
930 0 : CALL section_vals_val_get(section_vals, keyword_name, c_val=res)
931 :
932 0 : END FUNCTION section_get_cval
933 :
934 : ! **************************************************************************************************
935 : !> \brief ...
936 : !> \param section_vals ...
937 : !> \param keyword_name ...
938 : !> \return ...
939 : ! **************************************************************************************************
940 437354 : FUNCTION section_get_rval(section_vals, keyword_name) RESULT(res)
941 :
942 : TYPE(section_vals_type), INTENT(IN) :: section_vals
943 : CHARACTER(len=*), INTENT(in) :: keyword_name
944 : REAL(kind=dp) :: res
945 :
946 437354 : CALL section_vals_val_get(section_vals, keyword_name, r_val=res)
947 :
948 437354 : END FUNCTION section_get_rval
949 :
950 : ! **************************************************************************************************
951 : !> \brief ...
952 : !> \param section_vals ...
953 : !> \param keyword_name ...
954 : !> \return ...
955 : ! **************************************************************************************************
956 0 : FUNCTION section_get_rvals(section_vals, keyword_name) RESULT(res)
957 :
958 : TYPE(section_vals_type), INTENT(IN) :: section_vals
959 : CHARACTER(len=*), INTENT(in) :: keyword_name
960 : REAL(kind=dp), DIMENSION(:), POINTER :: res
961 :
962 0 : CALL section_vals_val_get(section_vals, keyword_name, r_vals=res)
963 :
964 0 : END FUNCTION section_get_rvals
965 :
966 : ! **************************************************************************************************
967 : !> \brief ...
968 : !> \param section_vals ...
969 : !> \param keyword_name ...
970 : !> \return ...
971 : ! **************************************************************************************************
972 366316 : FUNCTION section_get_ival(section_vals, keyword_name) RESULT(res)
973 :
974 : TYPE(section_vals_type), INTENT(IN) :: section_vals
975 : CHARACTER(len=*), INTENT(in) :: keyword_name
976 : INTEGER :: res
977 :
978 366316 : CALL section_vals_val_get(section_vals, keyword_name, i_val=res)
979 :
980 366316 : END FUNCTION section_get_ival
981 :
982 : ! **************************************************************************************************
983 : !> \brief ...
984 : !> \param section_vals ...
985 : !> \param keyword_name ...
986 : !> \return ...
987 : ! **************************************************************************************************
988 3546 : FUNCTION section_get_ivals(section_vals, keyword_name) RESULT(res)
989 :
990 : TYPE(section_vals_type), INTENT(IN) :: section_vals
991 : CHARACTER(len=*), INTENT(in) :: keyword_name
992 : INTEGER, DIMENSION(:), POINTER :: res
993 :
994 3546 : CALL section_vals_val_get(section_vals, keyword_name, i_vals=res)
995 :
996 3546 : END FUNCTION section_get_ivals
997 :
998 : ! **************************************************************************************************
999 : !> \brief ...
1000 : !> \param section_vals ...
1001 : !> \param keyword_name ...
1002 : !> \return ...
1003 : ! **************************************************************************************************
1004 87023 : FUNCTION section_get_lval(section_vals, keyword_name) RESULT(res)
1005 :
1006 : TYPE(section_vals_type), INTENT(IN) :: section_vals
1007 : CHARACTER(len=*), INTENT(in) :: keyword_name
1008 : LOGICAL :: res
1009 :
1010 87023 : CALL section_vals_val_get(section_vals, keyword_name, l_val=res)
1011 :
1012 87023 : END FUNCTION section_get_lval
1013 :
1014 : ! **************************************************************************************************
1015 : !> \brief returns the requested value
1016 : !> \param section_vals ...
1017 : !> \param keyword_name the name of the keyword you want
1018 : !> \param i_rep_section which repetition of the section you are interested in
1019 : !> (defaults to 1)
1020 : !> \param i_rep_val which repetition of the keyword/val you are interested in
1021 : !> (defaults to 1)
1022 : !> \param n_rep_val returns number of val available
1023 : !> \param val ...
1024 : !> \param l_val ,i_val,r_val,c_val: returns the logical,integer,real or
1025 : !> character value
1026 : !> \param i_val ...
1027 : !> \param r_val ...
1028 : !> \param c_val ...
1029 : !> \param l_vals ,i_vals,r_vals,c_vals: returns the logical,integer,real or
1030 : !> character arrays. The val reamins the owner of the array
1031 : !> \param i_vals ...
1032 : !> \param r_vals ...
1033 : !> \param c_vals ...
1034 : !> \param explicit ...
1035 : !> \author fawzi
1036 : ! **************************************************************************************************
1037 43607024 : SUBROUTINE section_vals_val_get(section_vals, keyword_name, i_rep_section, &
1038 : i_rep_val, n_rep_val, val, l_val, i_val, r_val, c_val, l_vals, i_vals, r_vals, &
1039 : c_vals, explicit)
1040 :
1041 : TYPE(section_vals_type), INTENT(IN), TARGET :: section_vals
1042 : CHARACTER(len=*), INTENT(in) :: keyword_name
1043 : INTEGER, INTENT(in), OPTIONAL :: i_rep_section, i_rep_val
1044 : INTEGER, INTENT(out), OPTIONAL :: n_rep_val
1045 : TYPE(val_type), OPTIONAL, POINTER :: val
1046 : LOGICAL, INTENT(out), OPTIONAL :: l_val
1047 : INTEGER, INTENT(out), OPTIONAL :: i_val
1048 : REAL(KIND=DP), INTENT(out), OPTIONAL :: r_val
1049 : CHARACTER(LEN=*), INTENT(out), OPTIONAL :: c_val
1050 : LOGICAL, DIMENSION(:), OPTIONAL, POINTER :: l_vals
1051 : INTEGER, DIMENSION(:), OPTIONAL, POINTER :: i_vals
1052 : REAL(KIND=DP), DIMENSION(:), OPTIONAL, POINTER :: r_vals
1053 : CHARACTER(LEN=default_string_length), &
1054 : DIMENSION(:), OPTIONAL, POINTER :: c_vals
1055 : LOGICAL, INTENT(out), OPTIONAL :: explicit
1056 :
1057 : INTEGER :: ik, irk, irs, len_key, my_index, &
1058 : tmp_index
1059 : LOGICAL :: valRequested
1060 : TYPE(cp_sll_val_type), POINTER :: vals
1061 : TYPE(keyword_type), POINTER :: keyword
1062 : TYPE(section_type), POINTER :: section
1063 : TYPE(section_vals_type), POINTER :: s_vals
1064 : TYPE(val_type), POINTER :: my_val
1065 :
1066 43607024 : CPASSERT(section_vals%ref_count > 0)
1067 :
1068 43607024 : my_index = INDEX(keyword_name, '%') + 1
1069 43607024 : len_key = LEN_TRIM(keyword_name)
1070 43607024 : IF (my_index > 1) THEN
1071 2593446 : DO
1072 10452751 : tmp_index = INDEX(keyword_name(my_index:len_key), "%")
1073 10452751 : IF (tmp_index <= 0) EXIT
1074 2593446 : my_index = my_index + tmp_index
1075 : END DO
1076 7859305 : s_vals => section_vals_get_subs_vals(section_vals, keyword_name(1:my_index - 2))
1077 : ELSE
1078 : s_vals => section_vals
1079 : END IF
1080 :
1081 43607024 : irk = 1
1082 43607024 : irs = 1
1083 43607024 : IF (PRESENT(i_rep_section)) irs = i_rep_section
1084 43607024 : IF (PRESENT(i_rep_val)) irk = i_rep_val
1085 43607024 : IF (PRESENT(val)) NULLIFY (val)
1086 43607024 : IF (PRESENT(explicit)) explicit = .FALSE.
1087 43607024 : section => s_vals%section
1088 : valRequested = PRESENT(l_val) .OR. PRESENT(i_val) .OR. PRESENT(r_val) .OR. &
1089 : PRESENT(c_val) .OR. PRESENT(l_vals) .OR. PRESENT(i_vals) .OR. &
1090 43607024 : PRESENT(r_vals) .OR. PRESENT(c_vals)
1091 43607024 : ik = section_get_keyword_index(s_vals%section, keyword_name(my_index:len_key))
1092 43607024 : IF (ik == -2) &
1093 : CALL cp_abort(__LOCATION__, &
1094 : "section "//TRIM(section%name)//" does not contain keyword "// &
1095 0 : TRIM(keyword_name(my_index:len_key)))
1096 43607024 : keyword => section%keywords(ik)%keyword
1097 43607024 : IF (.NOT. (irs > 0 .AND. irs <= SIZE(s_vals%subs_vals, 2))) &
1098 : CALL cp_abort(__LOCATION__, &
1099 : "section repetition requested ("//cp_to_string(irs)// &
1100 : ") out of bounds (1:"//cp_to_string(SIZE(s_vals%subs_vals, 2)) &
1101 0 : //")")
1102 43607024 : NULLIFY (my_val)
1103 43607024 : IF (PRESENT(n_rep_val)) n_rep_val = 0
1104 43607024 : IF (irs <= SIZE(s_vals%values, 2)) THEN ! the section was parsed
1105 18099690 : vals => s_vals%values(ik, irs)%list
1106 18099690 : IF (PRESENT(n_rep_val)) n_rep_val = cp_sll_val_get_length(vals)
1107 18099690 : IF (.NOT. ASSOCIATED(vals)) THEN
1108 : ! this keyword was not parsed
1109 9560761 : IF (ASSOCIATED(keyword%default_value)) THEN
1110 8080283 : my_val => keyword%default_value
1111 8080283 : IF (PRESENT(n_rep_val)) n_rep_val = 1
1112 : END IF
1113 : ELSE
1114 : my_val => cp_sll_val_get_el_at(s_vals%values(ik, irs)%list, &
1115 8538929 : irk)
1116 8538929 : IF (PRESENT(explicit)) explicit = .TRUE.
1117 : END IF
1118 25507334 : ELSE IF (ASSOCIATED(keyword%default_value)) THEN
1119 25489204 : IF (PRESENT(n_rep_val)) n_rep_val = 1
1120 25489204 : my_val => keyword%default_value
1121 : END IF
1122 43607024 : IF (PRESENT(val)) val => my_val
1123 43607024 : IF (valRequested) THEN
1124 37938220 : IF (.NOT. ASSOCIATED(my_val)) &
1125 : CALL cp_abort(__LOCATION__, &
1126 : "Value requested, but no value set getting value from "// &
1127 : "keyword "//TRIM(keyword_name(my_index:len_key))//" of section "// &
1128 0 : TRIM(section%name))
1129 : CALL val_get(my_val, l_val=l_val, i_val=i_val, r_val=r_val, &
1130 : c_val=c_val, l_vals=l_vals, i_vals=i_vals, r_vals=r_vals, &
1131 294406526 : c_vals=c_vals)
1132 : END IF
1133 :
1134 43607024 : END SUBROUTINE section_vals_val_get
1135 :
1136 : ! **************************************************************************************************
1137 : !> \brief returns the requested list
1138 : !> \param section_vals ...
1139 : !> \param keyword_name the name of the keyword you want
1140 : !> \param i_rep_section which repetition of the section you are interested in
1141 : !> (defaults to 1)
1142 : !> \param list ...
1143 : !> \author Joost VandeVondele
1144 : !> \note
1145 : !> - most useful if the full list is needed anyway, so that faster iteration can be used
1146 : ! **************************************************************************************************
1147 8353 : SUBROUTINE section_vals_list_get(section_vals, keyword_name, i_rep_section, &
1148 : list)
1149 :
1150 : TYPE(section_vals_type), INTENT(IN), POINTER :: section_vals
1151 : CHARACTER(len=*), INTENT(in) :: keyword_name
1152 : INTEGER, OPTIONAL :: i_rep_section
1153 : TYPE(cp_sll_val_type), POINTER :: list
1154 :
1155 : INTEGER :: ik, irs, len_key, my_index, tmp_index
1156 : TYPE(section_type), POINTER :: section
1157 : TYPE(section_vals_type), POINTER :: s_vals
1158 :
1159 8353 : CPASSERT(ASSOCIATED(section_vals))
1160 8353 : CPASSERT(section_vals%ref_count > 0)
1161 8353 : NULLIFY (list)
1162 8353 : my_index = INDEX(keyword_name, '%') + 1
1163 8353 : len_key = LEN_TRIM(keyword_name)
1164 8353 : IF (my_index > 1) THEN
1165 0 : DO
1166 0 : tmp_index = INDEX(keyword_name(my_index:len_key), "%")
1167 0 : IF (tmp_index <= 0) EXIT
1168 0 : my_index = my_index + tmp_index
1169 : END DO
1170 0 : s_vals => section_vals_get_subs_vals(section_vals, keyword_name(1:my_index - 2))
1171 : ELSE
1172 8353 : s_vals => section_vals
1173 : END IF
1174 :
1175 8353 : irs = 1
1176 8353 : IF (PRESENT(i_rep_section)) irs = i_rep_section
1177 8353 : section => s_vals%section
1178 8353 : ik = section_get_keyword_index(s_vals%section, keyword_name(my_index:len_key))
1179 8353 : IF (ik == -2) &
1180 : CALL cp_abort(__LOCATION__, &
1181 : "section "//TRIM(section%name)//" does not contain keyword "// &
1182 0 : TRIM(keyword_name(my_index:len_key)))
1183 8353 : IF (.NOT. (irs > 0 .AND. irs <= SIZE(s_vals%subs_vals, 2))) &
1184 : CALL cp_abort(__LOCATION__, &
1185 : "section repetition requested ("//cp_to_string(irs)// &
1186 : ") out of bounds (1:"//cp_to_string(SIZE(s_vals%subs_vals, 2)) &
1187 0 : //")")
1188 8353 : list => s_vals%values(ik, irs)%list
1189 :
1190 8353 : END SUBROUTINE section_vals_list_get
1191 :
1192 : ! **************************************************************************************************
1193 : !> \brief sets the requested value
1194 : !> \param section_vals ...
1195 : !> \param keyword_name the name of the keyword you want (can be a path
1196 : !> separated by '%')
1197 : !> \param i_rep_section isection which repetition of the section you are
1198 : !> nterested in (defaults to 1)
1199 : !> \param i_rep_val which repetition of the keyword/val you are interested in
1200 : !> (defaults to 1)
1201 : !> \param val ...
1202 : !> \param l_val ,i_val,r_val,c_val: sets the logical,integer,real or
1203 : !> character value
1204 : !> \param i_val ...
1205 : !> \param r_val ...
1206 : !> \param c_val ...
1207 : !> \param l_vals_ptr ,i_vals_ptr,r_vals,c_vals: sets the logical,integer,real or
1208 : !> character arrays. The val becomes the owner of the array
1209 : !> \param i_vals_ptr ...
1210 : !> \param r_vals_ptr ...
1211 : !> \param c_vals_ptr ...
1212 : !> \author fawzi
1213 : ! **************************************************************************************************
1214 353424 : SUBROUTINE section_vals_val_set(section_vals, keyword_name, i_rep_section, i_rep_val, &
1215 : val, l_val, i_val, r_val, c_val, l_vals_ptr, i_vals_ptr, r_vals_ptr, c_vals_ptr)
1216 :
1217 : TYPE(section_vals_type), POINTER :: section_vals
1218 : CHARACTER(len=*), INTENT(in) :: keyword_name
1219 : INTEGER, INTENT(in), OPTIONAL :: i_rep_section, i_rep_val
1220 : TYPE(val_type), OPTIONAL, POINTER :: val
1221 : LOGICAL, INTENT(in), OPTIONAL :: l_val
1222 : INTEGER, INTENT(in), OPTIONAL :: i_val
1223 : REAL(KIND=DP), INTENT(in), OPTIONAL :: r_val
1224 : CHARACTER(LEN=*), INTENT(in), OPTIONAL :: c_val
1225 : LOGICAL, DIMENSION(:), OPTIONAL, POINTER :: l_vals_ptr
1226 : INTEGER, DIMENSION(:), OPTIONAL, POINTER :: i_vals_ptr
1227 : REAL(KIND=DP), DIMENSION(:), OPTIONAL, POINTER :: r_vals_ptr
1228 : CHARACTER(LEN=default_string_length), &
1229 : DIMENSION(:), OPTIONAL, POINTER :: c_vals_ptr
1230 :
1231 : INTEGER :: ik, irk, irs, len_key, my_index, &
1232 : tmp_index
1233 : LOGICAL :: valSet
1234 : TYPE(cp_sll_val_type), POINTER :: vals
1235 : TYPE(keyword_type), POINTER :: keyword
1236 : TYPE(section_type), POINTER :: section
1237 : TYPE(section_vals_type), POINTER :: s_vals
1238 : TYPE(val_type), POINTER :: my_val, old_val
1239 :
1240 353424 : CPASSERT(ASSOCIATED(section_vals))
1241 353424 : CPASSERT(section_vals%ref_count > 0)
1242 :
1243 353424 : my_index = INDEX(keyword_name, '%') + 1
1244 353424 : len_key = LEN_TRIM(keyword_name)
1245 353424 : IF (my_index > 1) THEN
1246 7974 : DO
1247 84607 : tmp_index = INDEX(keyword_name(my_index:len_key), "%")
1248 84607 : IF (tmp_index <= 0) EXIT
1249 7974 : my_index = my_index + tmp_index
1250 : END DO
1251 76633 : s_vals => section_vals_get_subs_vals(section_vals, keyword_name(1:my_index - 2))
1252 : ELSE
1253 276791 : s_vals => section_vals
1254 : END IF
1255 :
1256 353424 : irk = 1
1257 353424 : irs = 1
1258 353424 : IF (PRESENT(i_rep_section)) irs = i_rep_section
1259 353424 : IF (PRESENT(i_rep_val)) irk = i_rep_val
1260 353424 : section => s_vals%section
1261 353424 : ik = section_get_keyword_index(s_vals%section, keyword_name(my_index:len_key))
1262 353424 : IF (ik == -2) &
1263 : CALL cp_abort(__LOCATION__, &
1264 : "section "//TRIM(section%name)//" does not contain keyword "// &
1265 0 : TRIM(keyword_name(my_index:len_key)))
1266 : ! Add values..
1267 25301 : DO
1268 378725 : IF (irs <= SIZE(s_vals%values, 2)) EXIT
1269 25301 : CALL section_vals_add_values(s_vals)
1270 : END DO
1271 353424 : IF (.NOT. (irs > 0 .AND. irs <= SIZE(s_vals%subs_vals, 2))) &
1272 : CALL cp_abort(__LOCATION__, &
1273 : "section repetition requested ("//cp_to_string(irs)// &
1274 : ") out of bounds (1:"//cp_to_string(SIZE(s_vals%subs_vals, 2)) &
1275 0 : //")")
1276 353424 : keyword => s_vals%section%keywords(ik)%keyword
1277 353424 : NULLIFY (my_val)
1278 353424 : IF (PRESENT(val)) my_val => val
1279 : valSet = PRESENT(l_val) .OR. PRESENT(i_val) .OR. PRESENT(r_val) .OR. &
1280 : PRESENT(c_val) .OR. PRESENT(l_vals_ptr) .OR. PRESENT(i_vals_ptr) .OR. &
1281 353424 : PRESENT(r_vals_ptr) .OR. PRESENT(c_vals_ptr)
1282 353424 : IF (ASSOCIATED(my_val)) THEN
1283 : ! check better?
1284 0 : IF (valSet) &
1285 : CALL cp_abort(__LOCATION__, &
1286 : " both val and values present, in setting "// &
1287 : "keyword "//TRIM(keyword_name(my_index:len_key))//" of section "// &
1288 0 : TRIM(section%name))
1289 : ELSE
1290 : ! ignore ?
1291 353424 : IF (.NOT. valSet) &
1292 : CALL cp_abort(__LOCATION__, &
1293 : " empty value in setting "// &
1294 : "keyword "//TRIM(keyword_name(my_index:len_key))//" of section "// &
1295 0 : TRIM(section%name))
1296 353424 : CPASSERT(valSet)
1297 353424 : IF (keyword%type_of_var == lchar_t) THEN
1298 156750 : CALL val_create(my_val, lc_val=c_val, lc_vals_ptr=c_vals_ptr)
1299 : ELSE
1300 : CALL val_create(my_val, l_val=l_val, i_val=i_val, r_val=r_val, &
1301 : c_val=c_val, l_vals_ptr=l_vals_ptr, i_vals_ptr=i_vals_ptr, &
1302 : r_vals_ptr=r_vals_ptr, &
1303 2317322 : c_vals_ptr=c_vals_ptr, enum=keyword%enum)
1304 : END IF
1305 353424 : CPASSERT(ASSOCIATED(my_val))
1306 353424 : CPASSERT(my_val%type_of_var == keyword%type_of_var)
1307 : END IF
1308 353424 : vals => s_vals%values(ik, irs)%list
1309 353424 : IF (irk == -1) THEN
1310 0 : CALL cp_sll_val_insert_el_at(vals, my_val, index=-1)
1311 353424 : ELSE IF (irk <= cp_sll_val_get_length(vals)) THEN
1312 211167 : IF (irk <= 0) &
1313 : CALL cp_abort(__LOCATION__, &
1314 : "invalid irk "//TRIM(ADJUSTL(cp_to_string(irk)))// &
1315 : " in keyword "//TRIM(keyword_name(my_index:len_key))//" of section "// &
1316 0 : TRIM(section%name))
1317 211167 : old_val => cp_sll_val_get_el_at(vals, index=irk)
1318 211167 : CALL val_release(old_val)
1319 211167 : CALL cp_sll_val_set_el_at(vals, value=my_val, index=irk)
1320 142257 : ELSE IF (irk > cp_sll_val_get_length(vals) + 1) THEN
1321 : ! change?
1322 : CALL cp_abort(__LOCATION__, &
1323 : "cannot add extra keyword repetitions to keyword" &
1324 : //TRIM(keyword_name(my_index:len_key))//" of section "// &
1325 0 : TRIM(section%name))
1326 : ELSE
1327 142257 : CALL cp_sll_val_insert_el_at(vals, my_val, index=irk)
1328 : END IF
1329 353424 : s_vals%values(ik, irs)%list => vals
1330 : NULLIFY (my_val)
1331 353424 : END SUBROUTINE section_vals_val_set
1332 :
1333 : ! **************************************************************************************************
1334 : !> \brief unsets (removes) the requested value (if it is a keyword repetitions
1335 : !> removes the repetition, so be careful: the repetition indices bigger
1336 : !> than the actual change.
1337 : !> \param section_vals ...
1338 : !> \param keyword_name the name of the keyword you want (can be a path
1339 : !> separated by '%')
1340 : !> \param i_rep_section which repetition of the section you are interested in
1341 : !> (defaults to 1)
1342 : !> \param i_rep_val which repetition of the keyword/val you are interested in
1343 : !> (defaults to 1)
1344 : !> \author fawzi
1345 : ! **************************************************************************************************
1346 37816 : SUBROUTINE section_vals_val_unset(section_vals, keyword_name, i_rep_section, i_rep_val)
1347 :
1348 : TYPE(section_vals_type), POINTER :: section_vals
1349 : CHARACTER(len=*), INTENT(in) :: keyword_name
1350 : INTEGER, INTENT(in), OPTIONAL :: i_rep_section, i_rep_val
1351 :
1352 : INTEGER :: ik, irk, irs, len_key, my_index, &
1353 : tmp_index
1354 : TYPE(cp_sll_val_type), POINTER :: pos
1355 : TYPE(section_type), POINTER :: section
1356 : TYPE(section_vals_type), POINTER :: s_vals
1357 : TYPE(val_type), POINTER :: old_val
1358 :
1359 37816 : NULLIFY (pos)
1360 37816 : CPASSERT(ASSOCIATED(section_vals))
1361 37816 : CPASSERT(section_vals%ref_count > 0)
1362 :
1363 37816 : my_index = INDEX(keyword_name, '%') + 1
1364 37816 : len_key = LEN_TRIM(keyword_name)
1365 37816 : IF (my_index > 1) THEN
1366 316 : DO
1367 688 : tmp_index = INDEX(keyword_name(my_index:len_key), "%")
1368 688 : IF (tmp_index <= 0) EXIT
1369 316 : my_index = my_index + tmp_index
1370 : END DO
1371 372 : s_vals => section_vals_get_subs_vals(section_vals, keyword_name(1:my_index - 2))
1372 : ELSE
1373 37444 : s_vals => section_vals
1374 : END IF
1375 :
1376 37816 : irk = 1
1377 37816 : irs = 1
1378 37816 : IF (PRESENT(i_rep_section)) irs = i_rep_section
1379 37816 : IF (PRESENT(i_rep_val)) irk = i_rep_val
1380 37816 : section => s_vals%section
1381 37816 : ik = section_get_keyword_index(s_vals%section, keyword_name(my_index:len_key))
1382 37816 : IF (ik == -2) &
1383 : CALL cp_abort(__LOCATION__, &
1384 : "section "//TRIM(section%name)//" does not contain keyword "// &
1385 0 : TRIM(keyword_name(my_index:len_key)))
1386 : ! ignore unset of non set values
1387 37816 : IF (irs <= SIZE(s_vals%values, 2)) THEN
1388 37816 : IF (.NOT. (irs > 0 .AND. irs <= SIZE(s_vals%subs_vals, 2))) &
1389 : CALL cp_abort(__LOCATION__, &
1390 : "section repetition requested ("//cp_to_string(irs)// &
1391 : ") out of bounds (1:"//cp_to_string(SIZE(s_vals%subs_vals, 2)) &
1392 0 : //")")
1393 37816 : IF (irk == -1) THEN
1394 0 : pos => cp_sll_val_get_rest(s_vals%values(ik, irs)%list, iter=-1)
1395 : ELSE
1396 37816 : pos => cp_sll_val_get_rest(s_vals%values(ik, irs)%list, iter=irk - 1)
1397 : END IF
1398 37816 : IF (ASSOCIATED(pos)) THEN
1399 7314 : old_val => cp_sll_val_get_el_at(s_vals%values(ik, irs)%list, index=irk)
1400 7314 : CALL val_release(old_val)
1401 7314 : CALL cp_sll_val_rm_el_at(s_vals%values(ik, irs)%list, index=irk)
1402 : END IF
1403 : END IF
1404 :
1405 37816 : END SUBROUTINE section_vals_val_unset
1406 :
1407 : ! **************************************************************************************************
1408 : !> \brief writes the values in the given section in a way that is suitable to
1409 : !> the automatic parsing
1410 : !> \param section_vals the section to write out
1411 : !> \param unit_nr the unit where to write to
1412 : !> \param hide_root ...
1413 : !> \param hide_defaults ...
1414 : !> \author fawzi
1415 : !> \note
1416 : !> skips required sections which weren't read
1417 : ! **************************************************************************************************
1418 2336646 : RECURSIVE SUBROUTINE section_vals_write(section_vals, unit_nr, hide_root, hide_defaults)
1419 :
1420 : TYPE(section_vals_type), INTENT(IN) :: section_vals
1421 : INTEGER, INTENT(in) :: unit_nr
1422 : LOGICAL, INTENT(in), OPTIONAL :: hide_root, hide_defaults
1423 :
1424 : INTEGER, PARAMETER :: incr = 2
1425 :
1426 : CHARACTER(len=default_string_length) :: myfmt
1427 : INTEGER :: i_rep_s, ik, isec, ival, nr, nval
1428 : INTEGER, SAVE :: indent = 1
1429 : LOGICAL :: defaultSection, explicit, &
1430 : my_hide_defaults, my_hide_root
1431 : TYPE(cp_sll_val_type), POINTER :: new_pos, vals
1432 : TYPE(keyword_type), POINTER :: keyword
1433 : TYPE(section_type), POINTER :: section
1434 : TYPE(section_vals_type), POINTER :: sval
1435 : TYPE(val_type), POINTER :: val
1436 :
1437 2336646 : my_hide_root = .FALSE.
1438 2336646 : my_hide_defaults = .TRUE.
1439 2336646 : IF (PRESENT(hide_root)) my_hide_root = hide_root
1440 2336646 : IF (PRESENT(hide_defaults)) my_hide_defaults = hide_defaults
1441 :
1442 2336646 : CPASSERT(section_vals%ref_count > 0)
1443 2336646 : IF (unit_nr > 0) THEN
1444 2336631 : CALL section_vals_get(section_vals, explicit=explicit, n_repetition=nr, section=section)
1445 2336631 : IF (explicit .OR. (.NOT. my_hide_defaults)) THEN
1446 571361 : DO i_rep_s = 1, nr
1447 289908 : IF (.NOT. my_hide_root) THEN
1448 281435 : WRITE (UNIT=myfmt, FMT="(I0,A1)") indent, "X"
1449 281435 : IF (ASSOCIATED(section%keywords(-1)%keyword)) THEN
1450 : WRITE (UNIT=unit_nr, FMT="("//TRIM(myfmt)//",A)", ADVANCE="NO") &
1451 56994 : default_section_character//TRIM(ADJUSTL(section%name))
1452 : ELSE
1453 : WRITE (UNIT=unit_nr, FMT="("//TRIM(myfmt)//",A)") &
1454 224441 : default_section_character//TRIM(ADJUSTL(section%name))
1455 : END IF
1456 : END IF
1457 289908 : defaultSection = (SIZE(section_vals%values, 2) == 0)
1458 289908 : IF (.NOT. defaultSection) THEN
1459 289908 : IF (.NOT. my_hide_root) indent = indent + incr
1460 289908 : WRITE (UNIT=myfmt, FMT="(I0,A1)") indent, "X"
1461 3031777 : DO ik = -1, section%n_keywords
1462 2741869 : keyword => section%keywords(ik)%keyword
1463 3031777 : IF (ASSOCIATED(keyword)) THEN
1464 2249701 : IF (keyword%type_of_var /= no_t .AND. keyword%names(1) (1:2) /= "__") THEN
1465 : CALL section_vals_val_get(section_vals, keyword%names(1), &
1466 2190813 : i_rep_s, n_rep_val=nval)
1467 2190813 : IF (i_rep_s <= SIZE(section_vals%values, 2)) THEN
1468 : ! Section was parsed
1469 2190813 : vals => section_vals%values(ik, i_rep_s)%list
1470 5483951 : DO ival = 1, nval
1471 3293138 : IF (ival == 1) THEN
1472 : new_pos => vals
1473 : ELSE
1474 1261166 : new_pos => new_pos%rest
1475 : END IF
1476 3293138 : IF (.NOT. ASSOCIATED(new_pos)) THEN
1477 : ! this keyword was not parsed
1478 1449008 : IF (ASSOCIATED(keyword%default_value)) THEN
1479 1449008 : val => keyword%default_value
1480 1449008 : IF (my_hide_defaults) CYCLE
1481 : END IF
1482 : ELSE
1483 1844130 : val => new_pos%first_el
1484 : END IF
1485 1851346 : IF (keyword%names(1) /= '_DEFAULT_KEYWORD_' .AND. &
1486 : keyword%names(1) /= '_SECTION_PARAMETERS_') THEN
1487 : WRITE (UNIT=unit_nr, FMT="("//TRIM(myfmt)//",A)", ADVANCE="NO") &
1488 503743 : TRIM(keyword%names(1))
1489 1347603 : ELSE IF (keyword%names(1) == '_DEFAULT_KEYWORD_' .AND. &
1490 : keyword%type_of_var /= lchar_t) THEN
1491 437387 : WRITE (UNIT=unit_nr, FMT="("//TRIM(myfmt)//")", ADVANCE="NO")
1492 : END IF
1493 5483951 : CALL val_write(val, unit_nr=unit_nr, unit=keyword%unit, fmt=myfmt)
1494 : END DO
1495 0 : ELSE IF (ASSOCIATED(keyword%default_value)) THEN
1496 : ! Section was not parsed but default for the keywords may exist
1497 0 : IF (my_hide_defaults) CYCLE
1498 0 : val => keyword%default_value
1499 0 : IF (keyword%names(1) /= '_DEFAULT_KEYWORD_' .AND. &
1500 : keyword%names(1) /= '_SECTION_PARAMETERS_') THEN
1501 : WRITE (UNIT=unit_nr, FMT="("//TRIM(myfmt)//",A)", ADVANCE="NO") &
1502 0 : TRIM(keyword%names(1))
1503 0 : ELSE IF (keyword%names(1) == '_DEFAULT_KEYWORD_' .AND. &
1504 : keyword%type_of_var /= lchar_t) THEN
1505 0 : WRITE (UNIT=unit_nr, FMT="("//TRIM(myfmt)//")", ADVANCE="NO")
1506 : END IF
1507 0 : CALL val_write(val, unit_nr=unit_nr, unit=keyword%unit, fmt=myfmt)
1508 : END IF
1509 : END IF
1510 : END IF
1511 : END DO
1512 289908 : IF (ASSOCIATED(section_vals%subs_vals)) THEN
1513 2618066 : DO isec = 1, SIZE(section_vals%subs_vals, 1)
1514 2328158 : sval => section_vals%subs_vals(isec, i_rep_s)%section_vals
1515 2618066 : IF (ASSOCIATED(sval)) THEN
1516 2328158 : CALL section_vals_write(sval, unit_nr=unit_nr, hide_defaults=hide_defaults)
1517 : END IF
1518 : END DO
1519 : END IF
1520 : END IF
1521 2626539 : IF (.NOT. my_hide_root) THEN
1522 281435 : indent = indent - incr
1523 281435 : WRITE (UNIT=myfmt, FMT="(I0,A1)") indent, "X"
1524 : WRITE (UNIT=unit_nr, FMT="("//TRIM(myfmt)//",A)") &
1525 281435 : default_section_character//"END "//TRIM(ADJUSTL(section%name))
1526 : END IF
1527 : END DO
1528 : END IF
1529 : END IF
1530 :
1531 2336646 : END SUBROUTINE section_vals_write
1532 :
1533 : ! **************************************************************************************************
1534 : !> \brief writes the values in the given section in xml
1535 : !> \param section ...
1536 : !> \param level ...
1537 : !> \param unit_number ...
1538 : ! **************************************************************************************************
1539 0 : RECURSIVE SUBROUTINE write_section_xml(section, level, unit_number)
1540 :
1541 : TYPE(section_type), POINTER :: section
1542 : INTEGER, INTENT(IN) :: level, unit_number
1543 :
1544 : CHARACTER(LEN=3) :: repeats
1545 : CHARACTER(LEN=8) :: short_string
1546 : INTEGER :: i, l0, l1, l2
1547 :
1548 0 : IF (ASSOCIATED(section)) THEN
1549 :
1550 0 : CPASSERT(section%ref_count > 0)
1551 :
1552 : ! Indentation for current level, next level, etc.
1553 :
1554 0 : l0 = level
1555 0 : l1 = level + 1
1556 0 : l2 = level + 2
1557 :
1558 0 : IF (section%repeats) THEN
1559 0 : repeats = "yes"
1560 : ELSE
1561 0 : repeats = "no "
1562 : END IF
1563 :
1564 0 : WRITE (UNIT=unit_number, FMT="(A)") &
1565 0 : REPEAT(" ", l0)//"<SECTION repeats="""//TRIM(repeats)//""">", &
1566 0 : REPEAT(" ", l1)//"<NAME>"//TRIM(section%name)//"</NAME>", &
1567 : REPEAT(" ", l1)//"<DESCRIPTION>"// &
1568 : TRIM(substitute_special_xml_tokens(a2s(section%description))) &
1569 0 : //"</DESCRIPTION>"
1570 :
1571 0 : IF (ASSOCIATED(section%citations)) THEN
1572 0 : DO i = 1, SIZE(section%citations, 1)
1573 0 : short_string = ""
1574 0 : WRITE (UNIT=short_string, FMT="(I8)") section%citations(i)
1575 0 : WRITE (UNIT=unit_number, FMT="(A)") &
1576 0 : REPEAT(" ", l1)//"<REFERENCE>", &
1577 0 : REPEAT(" ", l2)//"<NAME>"//TRIM(get_citation_key(section%citations(i)))//"</NAME>", &
1578 0 : REPEAT(" ", l2)//"<NUMBER>"//TRIM(ADJUSTL(short_string))//"</NUMBER>", &
1579 0 : REPEAT(" ", l1)//"</REFERENCE>"
1580 : END DO
1581 : END IF
1582 :
1583 0 : WRITE (UNIT=unit_number, FMT="(A)") &
1584 0 : REPEAT(" ", l1)//"<LOCATION>"//TRIM(section%location)//"</LOCATION>"
1585 :
1586 0 : DO i = -1, section%n_keywords
1587 0 : IF (ASSOCIATED(section%keywords(i)%keyword)) THEN
1588 0 : CALL write_keyword_xml(section%keywords(i)%keyword, l1, unit_number)
1589 : END IF
1590 : END DO
1591 :
1592 0 : DO i = 1, section%n_subsections
1593 0 : CALL write_section_xml(section%subsections(i)%section, l1, unit_number)
1594 : END DO
1595 :
1596 0 : WRITE (UNIT=unit_number, FMT="(A)") REPEAT(" ", l0)//"</SECTION>"
1597 :
1598 : END IF
1599 :
1600 0 : END SUBROUTINE write_section_xml
1601 :
1602 : ! **************************************************************************************************
1603 : !> \brief ...
1604 : !> \param section ...
1605 : !> \param section_name ...
1606 : !> \param unknown_string ...
1607 : !> \param location_string ...
1608 : !> \param matching_rank ...
1609 : !> \param matching_string ...
1610 : !> \param bonus ...
1611 : ! **************************************************************************************************
1612 0 : RECURSIVE SUBROUTINE section_typo_match(section, section_name, unknown_string, location_string, &
1613 0 : matching_rank, matching_string, bonus)
1614 :
1615 : TYPE(section_type), INTENT(IN), POINTER :: section
1616 : CHARACTER(LEN=*) :: section_name, unknown_string, &
1617 : location_string
1618 : INTEGER, DIMENSION(:), INTENT(INOUT) :: matching_rank
1619 : CHARACTER(LEN=*), DIMENSION(:), INTENT(INOUT) :: matching_string
1620 : INTEGER, INTENT(IN) :: bonus
1621 :
1622 0 : CHARACTER(LEN=LEN(matching_string(1))) :: line
1623 : INTEGER :: i, imatch, imax, irank, newbonus
1624 :
1625 0 : IF (ASSOCIATED(section)) THEN
1626 0 : CPASSERT(section%ref_count > 0)
1627 0 : imatch = typo_match(TRIM(section%name), TRIM(unknown_string))
1628 0 : IF (imatch > 0) THEN
1629 0 : imatch = imatch + bonus
1630 : WRITE (UNIT=line, FMT='(T2,A)') &
1631 : " subsection "//TRIM(ADJUSTL(section%name))// &
1632 0 : " in section "//TRIM(ADJUSTL(location_string))
1633 0 : imax = SIZE(matching_rank, 1)
1634 0 : irank = imax + 1
1635 0 : DO I = imax, 1, -1
1636 0 : IF (imatch > matching_rank(I)) irank = i
1637 : END DO
1638 0 : IF (irank <= imax) THEN
1639 0 : matching_rank(irank + 1:imax) = matching_rank(irank:imax - 1)
1640 0 : matching_string(irank + 1:imax) = matching_string(irank:imax - 1)
1641 0 : matching_rank(irank) = imatch
1642 0 : matching_string(irank) = line
1643 : END IF
1644 : END IF
1645 :
1646 0 : IF (section_name == section%name) THEN
1647 0 : newbonus = 10
1648 : ELSE
1649 0 : newbonus = 0
1650 : END IF
1651 :
1652 0 : DO i = -1, section%n_keywords
1653 0 : IF (ASSOCIATED(section%keywords(i)%keyword)) THEN
1654 : CALL keyword_typo_match(section%keywords(i)%keyword, unknown_string, location_string// &
1655 0 : "%"//TRIM(section%name), matching_rank, matching_string, newbonus)
1656 : END IF
1657 : END DO
1658 :
1659 0 : DO i = 1, section%n_subsections
1660 : CALL section_typo_match(section%subsections(i)%section, section_name, unknown_string, &
1661 0 : location_string//"%"//TRIM(section%name), matching_rank, matching_string, newbonus)
1662 : END DO
1663 :
1664 : END IF
1665 :
1666 0 : END SUBROUTINE section_typo_match
1667 :
1668 : ! **************************************************************************************************
1669 : !> \brief replaces of the requested subsection with the one given
1670 : !> \param section_vals the root section
1671 : !> \param subsection_name the name of the subsection to replace
1672 : !> \param new_section_vals the new section_vals to use
1673 : !> \param i_rep_section index of the repetition of section_vals of which
1674 : !> you want to replace the subsection (defaults to 1)
1675 : !> \author fawzi
1676 : ! **************************************************************************************************
1677 16869 : SUBROUTINE section_vals_set_subs_vals(section_vals, subsection_name, &
1678 : new_section_vals, i_rep_section)
1679 : TYPE(section_vals_type), POINTER :: section_vals
1680 : CHARACTER(len=*), INTENT(in) :: subsection_name
1681 : TYPE(section_vals_type), POINTER :: new_section_vals
1682 : INTEGER, INTENT(in), OPTIONAL :: i_rep_section
1683 :
1684 : INTEGER :: irep, isection, len_key, my_index, &
1685 : tmp_index
1686 : TYPE(section_vals_type), POINTER :: s_vals
1687 :
1688 16869 : CPASSERT(ASSOCIATED(section_vals))
1689 16869 : CPASSERT(section_vals%ref_count > 0)
1690 16869 : CPASSERT(ASSOCIATED(new_section_vals))
1691 16869 : CPASSERT(new_section_vals%ref_count > 0)
1692 :
1693 16869 : irep = 1
1694 16869 : IF (PRESENT(i_rep_section)) irep = i_rep_section
1695 :
1696 16869 : my_index = INDEX(subsection_name, '%') + 1
1697 16869 : len_key = LEN_TRIM(subsection_name)
1698 16869 : IF (my_index > 1) THEN
1699 18103 : DO
1700 33144 : tmp_index = INDEX(subsection_name(my_index:len_key), "%")
1701 33144 : IF (tmp_index <= 0) EXIT
1702 18103 : my_index = my_index + tmp_index
1703 : END DO
1704 15041 : s_vals => section_vals_get_subs_vals(section_vals, subsection_name(1:my_index - 2))
1705 : ELSE
1706 1828 : s_vals => section_vals
1707 : END IF
1708 :
1709 16869 : CPASSERT(irep <= SIZE(s_vals%subs_vals, 2))
1710 :
1711 16869 : isection = section_get_subsection_index(s_vals%section, subsection_name(my_index:LEN_TRIM(subsection_name)))
1712 16869 : IF (isection <= 0) &
1713 : CALL cp_abort(__LOCATION__, &
1714 : "could not find subsection "//subsection_name(my_index:LEN_TRIM(subsection_name))//" in section "// &
1715 0 : TRIM(section_vals%section%name)//" at ")
1716 16869 : CALL section_vals_retain(new_section_vals)
1717 16869 : CALL section_vals_release(s_vals%subs_vals(isection, irep)%section_vals)
1718 16869 : s_vals%subs_vals(isection, irep)%section_vals => new_section_vals
1719 :
1720 16869 : END SUBROUTINE section_vals_set_subs_vals
1721 :
1722 : ! **************************************************************************************************
1723 : !> \brief creates a deep copy from section_vals_in to section_vals_out
1724 : !> \param section_vals_in the section_vals to copy
1725 : !> \param section_vals_out the section_vals to create
1726 : !> \param i_rep_start ...
1727 : !> \param i_rep_end ...
1728 : !> \author fawzi
1729 : ! **************************************************************************************************
1730 1597 : SUBROUTINE section_vals_duplicate(section_vals_in, section_vals_out, &
1731 : i_rep_start, i_rep_end)
1732 : TYPE(section_vals_type), POINTER :: section_vals_in, section_vals_out
1733 : INTEGER, INTENT(IN), OPTIONAL :: i_rep_start, i_rep_end
1734 :
1735 1597 : CPASSERT(ASSOCIATED(section_vals_in))
1736 1597 : CPASSERT(.NOT. ASSOCIATED(section_vals_out))
1737 1597 : CALL section_vals_create(section_vals_out, section_vals_in%section)
1738 1597 : CALL section_vals_copy(section_vals_in, section_vals_out, i_rep_start, i_rep_end)
1739 1597 : END SUBROUTINE section_vals_duplicate
1740 :
1741 : ! **************************************************************************************************
1742 : !> \brief deep copy from section_vals_in to section_vals_out
1743 : !> \param section_vals_in the section_vals to copy
1744 : !> \param section_vals_out the section_vals where to copy
1745 : !> \param i_rep_low ...
1746 : !> \param i_rep_high ...
1747 : !> \author fawzi
1748 : !> \note
1749 : !> private, only works with a newly initialized section_vals_out
1750 : ! **************************************************************************************************
1751 4103330 : RECURSIVE SUBROUTINE section_vals_copy(section_vals_in, section_vals_out, &
1752 : i_rep_low, i_rep_high)
1753 : TYPE(section_vals_type), POINTER :: section_vals_in, section_vals_out
1754 : INTEGER, INTENT(IN), OPTIONAL :: i_rep_low, i_rep_high
1755 :
1756 : INTEGER :: iend, irep, isec, istart, ival
1757 : TYPE(cp_sll_val_type), POINTER :: v1, v2
1758 : TYPE(val_type), POINTER :: el
1759 :
1760 4103330 : NULLIFY (v2, el)
1761 :
1762 4103330 : CPASSERT(ASSOCIATED(section_vals_in))
1763 4103330 : CPASSERT(ASSOCIATED(section_vals_out))
1764 : ! IF(.NOT. ASSOCIATED(section_vals_in%section, section_vals_out%section))&
1765 : ! CPABORT("")
1766 :
1767 4103330 : istart = 1
1768 4103330 : iend = SIZE(section_vals_in%values, 2)
1769 4103330 : IF (PRESENT(i_rep_low)) istart = i_rep_low
1770 4103330 : IF (PRESENT(i_rep_high)) iend = i_rep_high
1771 4121143 : DO irep = istart, iend
1772 17813 : CALL section_vals_add_values(section_vals_out)
1773 4327579 : DO ival = LBOUND(section_vals_in%values, 1), UBOUND(section_vals_in%values, 1)
1774 170810 : v1 => section_vals_in%values(ival, irep)%list
1775 188623 : IF (ASSOCIATED(v1)) THEN
1776 36041 : CALL val_duplicate(v1%first_el, el)
1777 36041 : CALL cp_sll_val_create(v2, el)
1778 36041 : NULLIFY (el)
1779 36041 : section_vals_out%values(ival, irep - istart + 1)%list => v2
1780 45920 : DO
1781 81961 : IF (.NOT. ASSOCIATED(v1%rest)) EXIT
1782 45920 : v1 => v1%rest
1783 45920 : CALL val_duplicate(v1%first_el, el)
1784 45920 : CALL cp_sll_val_create(v2%rest, first_el=el)
1785 45920 : NULLIFY (el)
1786 45920 : v2 => v2%rest
1787 : END DO
1788 : END IF
1789 : END DO
1790 : END DO
1791 4103330 : IF (.NOT. PRESENT(i_rep_low) .AND. (.NOT. PRESENT(i_rep_high))) THEN
1792 4102826 : IF (.NOT. (SIZE(section_vals_in%values, 2) == SIZE(section_vals_out%values, 2))) &
1793 0 : CPABORT("")
1794 4102826 : IF (.NOT. (SIZE(section_vals_in%subs_vals, 2) == SIZE(section_vals_out%subs_vals, 2))) &
1795 0 : CPABORT("")
1796 : END IF
1797 4103330 : iend = SIZE(section_vals_in%subs_vals, 2)
1798 4103330 : IF (PRESENT(i_rep_high)) iend = i_rep_high
1799 8207789 : DO irep = istart, iend
1800 12309522 : DO isec = 1, SIZE(section_vals_in%subs_vals, 1)
1801 : CALL section_vals_copy(section_vals_in%subs_vals(isec, irep)%section_vals, &
1802 8206192 : section_vals_out%subs_vals(isec, irep - istart + 1)%section_vals)
1803 : END DO
1804 : END DO
1805 :
1806 4103330 : END SUBROUTINE section_vals_copy
1807 :
1808 0 : END MODULE input_section_types
|
