Line data Source code
1 : !--------------------------------------------------------------------------------------------------!
2 : ! CP2K: A general program to perform molecular dynamics simulations !
3 : ! Copyright 2000-2026 CP2K developers group <https://cp2k.org> !
4 : ! !
5 : ! SPDX-License-Identifier: GPL-2.0-or-later !
6 : !--------------------------------------------------------------------------------------------------!
7 :
8 : ! **************************************************************************************************
9 : !> \brief routines that parse the input
10 : !> \par History
11 : !> 06.2004 created
12 : !> \author fawzi
13 : ! **************************************************************************************************
14 : MODULE input_parsing
15 : USE cp_linked_list_input, ONLY: &
16 : cp_create, cp_dealloc, cp_sll_char_type, cp_sll_int_type, cp_sll_logical_type, &
17 : cp_sll_real_type, cp_sll_val_create, cp_sll_val_type, cp_to_array
18 : USE cp_log_handling, ONLY: cp_logger_get_default_io_unit,&
19 : cp_to_string
20 : USE cp_parser_methods, ONLY: parser_get_object,&
21 : parser_location,&
22 : parser_skip_space,&
23 : parser_test_next_token
24 : USE cp_parser_types, ONLY: cp_parser_type
25 : USE cp_units, ONLY: cp_unit_compatible,&
26 : cp_unit_create,&
27 : cp_unit_desc,&
28 : cp_unit_release,&
29 : cp_unit_set_type,&
30 : cp_unit_to_cp2k1,&
31 : cp_unit_type
32 : USE input_enumeration_types, ONLY: enum_c2i,&
33 : enumeration_type
34 : USE input_keyword_types, ONLY: keyword_describe,&
35 : keyword_type
36 : USE input_section_types, ONLY: &
37 : section_describe, section_get_keyword, section_get_keyword_index, &
38 : section_get_subsection_index, section_type, section_typo_match, section_vals_add_values, &
39 : section_vals_type, typo_match_section, typo_matching_line, typo_matching_rank
40 : USE input_val_types, ONLY: &
41 : char_t, enum_t, integer_t, lchar_t, logical_t, no_t, real_t, val_create, val_type
42 : USE kinds, ONLY: default_string_length,&
43 : dp,&
44 : max_line_length
45 : USE string_utilities, ONLY: 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_parsing'
53 :
54 : PUBLIC :: section_vals_parse
55 : !***
56 : CONTAINS
57 :
58 : ! **************************************************************************************************
59 : !> \brief ...
60 : !> \param section_vals ...
61 : !> \param parser ...
62 : !> \param default_units ...
63 : !> \param root_section if the root section should be parsed (defaults to true)
64 : !> \author fawzi
65 : ! **************************************************************************************************
66 258828 : RECURSIVE SUBROUTINE section_vals_parse(section_vals, parser, default_units, root_section)
67 : TYPE(section_vals_type), POINTER :: section_vals
68 : TYPE(cp_parser_type), INTENT(INOUT) :: parser
69 : TYPE(cp_unit_set_type), INTENT(IN) :: default_units
70 : LOGICAL, INTENT(in), OPTIONAL :: root_section
71 :
72 : CHARACTER(len=*), PARAMETER :: routineN = 'section_vals_parse'
73 :
74 : CHARACTER(len=max_line_length) :: token
75 : INTEGER :: desc_level, handle, ik, imatch, irs, is, &
76 : nsub, output_unit
77 : LOGICAL :: at_end, compatible_end, root_sect, &
78 : whole_section
79 : TYPE(cp_sll_val_type), POINTER :: last_val, new_val, previous_last, &
80 : previous_list
81 : TYPE(keyword_type), POINTER :: keyword
82 : TYPE(section_type), POINTER :: section
83 : TYPE(val_type), POINTER :: el
84 :
85 258828 : CALL timeset(routineN, handle)
86 :
87 258828 : NULLIFY (previous_list, previous_last)
88 :
89 258828 : root_sect = .TRUE.
90 258828 : IF (PRESENT(root_section)) root_sect = root_section
91 :
92 258828 : CPASSERT(ASSOCIATED(section_vals))
93 258828 : output_unit = cp_logger_get_default_io_unit()
94 :
95 258828 : CPASSERT(section_vals%ref_count > 0)
96 258828 : IF (root_sect .AND. parser%icol1 > parser%icol2) THEN
97 : CALL cp_abort(__LOCATION__, &
98 : "Error 1: this routine must be called just after having parsed the start of the section " &
99 0 : //TRIM(parser_location(parser)))
100 : END IF
101 258828 : section => section_vals%section
102 258828 : IF (root_sect) THEN
103 247528 : token = TRIM(ADJUSTL(parser%input_line(parser%icol1:parser%icol2))) ! Ignore leading or trailing blanks
104 247528 : CALL uppercase(token)
105 247528 : IF (token /= parser%section_character//section%name) THEN
106 : CALL cp_abort(__LOCATION__, &
107 : "Error 2: this routine must be called just after having parsed the start of the section " &
108 0 : //TRIM(parser_location(parser)))
109 : END IF
110 : END IF
111 258828 : IF (.NOT. section%repeats .AND. SIZE(section_vals%values, 2) /= 0) THEN
112 : CALL cp_abort(__LOCATION__, "Section "//TRIM(section%name)// &
113 0 : " should not repeat "//TRIM(parser_location(parser)))
114 : END IF
115 258828 : CALL section_vals_add_values(section_vals)
116 258828 : irs = SIZE(section_vals%values, 2)
117 :
118 258828 : IF (ALLOCATED(section%deprecation_notice)) THEN
119 : CALL cp_warn(__LOCATION__, &
120 : "The specified section '"//TRIM(section%name)// &
121 : "' is deprecated and may be removed in a future version: "// &
122 0 : section%deprecation_notice)
123 : END IF
124 :
125 258828 : IF (ASSOCIATED(section%keywords(-1)%keyword)) THEN ! reads section params
126 56223 : keyword => section%keywords(-1)%keyword
127 56223 : NULLIFY (el)
128 56223 : IF (keyword%type_of_var == lchar_t) CALL parser_skip_space(parser)
129 : CALL val_create_parsing(el, type_of_var=keyword%type_of_var, &
130 : n_var=keyword%n_var, default_value=keyword%lone_keyword_value, &
131 : enum=keyword%enum, unit=keyword%unit, &
132 : default_units=default_units, &
133 56223 : parser=parser)
134 56223 : NULLIFY (new_val)
135 56223 : CALL cp_sll_val_create(new_val, el)
136 56223 : section_vals%values(-1, irs)%list => new_val
137 56223 : NULLIFY (el)
138 : END IF
139 : DO WHILE (.TRUE.)
140 : CALL parser_get_object(parser, token, newline=.TRUE., &
141 1192933 : lower_to_upper=.TRUE., at_end=at_end)
142 1192933 : token = TRIM(ADJUSTL(token)) ! Ignore leading or trailing blanks
143 1192933 : IF (at_end) THEN
144 11300 : IF (root_sect) THEN
145 : CALL cp_abort(__LOCATION__, &
146 : "unexpected end of file while parsing section "// &
147 0 : TRIM(section%name)//" "//TRIM(parser_location(parser)))
148 : END IF
149 : EXIT
150 : END IF
151 1181633 : IF (token(1:1) == parser%section_character) THEN
152 494971 : IF (token == "&END") THEN
153 : ! end of section
154 247528 : compatible_end = .TRUE.
155 247528 : IF (parser_test_next_token(parser) /= "EOL") THEN
156 : CALL parser_get_object(parser, token, newline=.FALSE., &
157 246042 : lower_to_upper=.TRUE.)
158 493570 : IF (token /= "SECTION" .AND. token /= section%name) THEN
159 0 : compatible_end = .FALSE.
160 : END IF
161 : END IF
162 247528 : IF (parser_test_next_token(parser) /= "EOL") THEN
163 : CALL parser_get_object(parser, token, newline=.FALSE., &
164 0 : lower_to_upper=.TRUE.)
165 247528 : IF (token /= section%name) THEN
166 0 : PRINT *, TRIM(token), "/=", TRIM(section%name)
167 : compatible_end = .FALSE.
168 : END IF
169 : END IF
170 247528 : IF (.NOT. compatible_end) THEN
171 : CALL cp_abort(__LOCATION__, &
172 : "non-compatible end of section "//TRIM(section%name)//" "// &
173 0 : TRIM(parser_location(parser)))
174 : END IF
175 : ! RETURN
176 : EXIT
177 : END IF
178 247443 : is = section_get_subsection_index(section, token(2:))
179 247443 : IF (is > 0) THEN
180 : CALL section_vals_parse(section_vals%subs_vals(is, irs)%section_vals, &
181 247443 : default_units=default_units, parser=parser)
182 : ELSE
183 : ! unknown subsection
184 0 : IF (output_unit > 0) THEN
185 0 : WRITE (output_unit, *)
186 0 : WRITE (output_unit, '(T2,A)') "Possible matches for unknown subsection "
187 0 : WRITE (output_unit, *)
188 0 : WRITE (output_unit, '(T2,A)') TRIM(token(2:))
189 0 : WRITE (output_unit, *)
190 : CALL section_typo_match(typo_match_section, TRIM(section%name), TRIM(token(2:)), "", &
191 0 : typo_matching_rank, typo_matching_line, bonus=0)
192 0 : DO imatch = 1, SIZE(typo_matching_rank)
193 0 : WRITE (output_unit, '(T2,A,1X,I0)') TRIM(typo_matching_line(imatch))//" score: ", typo_matching_rank(imatch)
194 : END DO
195 : END IF
196 : CALL cp_abort(__LOCATION__, &
197 : "unknown subsection "//TRIM(token(2:))//" of section " &
198 0 : //TRIM(section%name))
199 0 : nSub = 1
200 0 : DO WHILE (nSub > 0)
201 : CALL parser_get_object(parser, token, newline=.TRUE., &
202 0 : lower_to_upper=.TRUE.)
203 0 : IF (token(1:1) == parser%section_character) THEN
204 0 : IF (token == "&END") THEN
205 0 : nSub = nSub - 1
206 : ELSE
207 0 : nSub = nSub + 1
208 : END IF
209 : END IF
210 : END DO
211 : END IF
212 : ELSE ! token is a keyword
213 686662 : IF (token == "DESCRIBE") THEN
214 2 : IF (output_unit > 0) WRITE (output_unit, "(/,' ****** DESCRIPTION ******',/)")
215 2 : desc_level = 3
216 2 : IF (parser_test_next_token(parser) == "INT") THEN
217 2 : CALL parser_get_object(parser, desc_level)
218 : END IF
219 2 : whole_section = .TRUE.
220 2 : DO WHILE (parser_test_next_token(parser) == "STR")
221 0 : whole_section = .FALSE.
222 : CALL parser_get_object(parser, token, newline=.FALSE., &
223 0 : lower_to_upper=.TRUE.)
224 0 : keyword => section_get_keyword(section, token)
225 0 : IF (.NOT. ASSOCIATED(keyword)) THEN
226 : CALL cp_warn(__LOCATION__, &
227 : "unknown keyword to describe "//TRIM(token)// &
228 0 : " in section "//TRIM(section%name))
229 : ELSE
230 0 : CALL keyword_describe(keyword, output_unit, desc_level)
231 : END IF
232 : END DO
233 2 : IF (whole_section) THEN
234 2 : CALL section_describe(section, output_unit, desc_level, hide_root=.NOT. root_sect)
235 : END IF
236 2 : IF (output_unit > 0) WRITE (output_unit, "(/,' ****** =========== ******',/)")
237 :
238 : ELSE ! token is a "normal" keyword
239 686660 : ik = section_get_keyword_index(section, token)
240 686660 : IF (ik < 1) THEN ! don't accept pseudo keyword names
241 289418 : parser%icol = parser%icol1 - 1 ! re-read also the actual token
242 289418 : ik = 0
243 289418 : IF (.NOT. ASSOCIATED(section%keywords(0)%keyword)) THEN
244 0 : IF (output_unit > 0) THEN
245 0 : WRITE (output_unit, *)
246 0 : WRITE (output_unit, '(T2,A)') "Possible matches for unknown keyword "
247 0 : WRITE (output_unit, *)
248 0 : WRITE (output_unit, '(T2,A)') TRIM(token)
249 0 : WRITE (output_unit, *)
250 : CALL section_typo_match(typo_match_section, TRIM(section%name), TRIM(token), "", &
251 0 : typo_matching_rank, typo_matching_line, bonus=0)
252 0 : DO imatch = 1, SIZE(typo_matching_rank)
253 : WRITE (output_unit, '(T2,A,1X,I0)') &
254 0 : TRIM(typo_matching_line(imatch))//" score: ", typo_matching_rank(imatch)
255 : END DO
256 : END IF
257 : CALL cp_abort(__LOCATION__, &
258 : "found an unknown keyword "//TRIM(token)// &
259 0 : " in section "//TRIM(section%name))
260 : END IF
261 : END IF
262 686660 : keyword => section%keywords(ik)%keyword
263 686660 : IF (ASSOCIATED(keyword)) THEN
264 686660 : IF (keyword%removed) THEN
265 0 : IF (ALLOCATED(keyword%deprecation_notice)) THEN
266 : CALL cp_abort(__LOCATION__, &
267 : "The specified keyword '"//TRIM(token)//"' is not available anymore: "// &
268 0 : keyword%deprecation_notice)
269 : ELSE
270 : CALL cp_abort(__LOCATION__, &
271 : "The specified keyword '"//TRIM(token)// &
272 0 : "' is not available anymore, please consult the manual.")
273 : END IF
274 : END IF
275 :
276 686660 : IF (ALLOCATED(keyword%deprecation_notice)) THEN
277 : CALL cp_warn(__LOCATION__, &
278 : "The specified keyword '"//TRIM(token)// &
279 : "' is deprecated and may be removed in a future version: "// &
280 1022 : keyword%deprecation_notice)
281 : END IF
282 :
283 686660 : NULLIFY (el)
284 686660 : IF (ik /= 0 .AND. keyword%type_of_var == lchar_t) THEN
285 23597 : CALL parser_skip_space(parser)
286 : END IF
287 : CALL val_create_parsing(el, type_of_var=keyword%type_of_var, &
288 : n_var=keyword%n_var, default_value=keyword%lone_keyword_value, &
289 : enum=keyword%enum, unit=keyword%unit, &
290 686660 : default_units=default_units, parser=parser)
291 686660 : IF (ASSOCIATED(el)) THEN
292 686660 : NULLIFY (new_val)
293 686660 : CALL cp_sll_val_create(new_val, el)
294 686660 : last_val => section_vals%values(ik, irs)%list
295 686660 : IF (.NOT. ASSOCIATED(last_val)) THEN
296 404357 : section_vals%values(ik, irs)%list => new_val
297 : ELSE
298 282303 : IF (.NOT. keyword%repeats) THEN
299 : CALL cp_abort(__LOCATION__, &
300 : "Keyword "//TRIM(token)// &
301 0 : " in section "//TRIM(section%name)//" should not repeat.")
302 : END IF
303 282303 : IF (ASSOCIATED(last_val, previous_list)) THEN
304 282303 : last_val => previous_last
305 : ELSE
306 13125 : previous_list => last_val
307 : END IF
308 282303 : DO WHILE (ASSOCIATED(last_val%rest))
309 282303 : last_val => last_val%rest
310 : END DO
311 282303 : last_val%rest => new_val
312 282303 : previous_last => new_val
313 : END IF
314 : END IF
315 : END IF
316 : END IF
317 : END IF
318 : END DO
319 258828 : CALL timestop(handle)
320 258828 : END SUBROUTINE section_vals_parse
321 :
322 : ! **************************************************************************************************
323 : !> \brief creates a val_type object by parsing the values
324 : !> \param val the value that will be created
325 : !> \param type_of_var type of the value to be created
326 : !> \param n_var number of values to be parsed (-1: undefined)
327 : !> \param enum ...
328 : !> \param parser the parser from where the values should be read
329 : !> \param unit ...
330 : !> \param default_units ...
331 : !> \param default_value a default value if nothing is found (can be null)
332 : !> \author fawzi
333 : !> \note
334 : !> - no_t does not create a value
335 : ! **************************************************************************************************
336 742883 : SUBROUTINE val_create_parsing(val, type_of_var, n_var, enum, &
337 : parser, unit, default_units, default_value)
338 : TYPE(val_type), POINTER :: val
339 : INTEGER, INTENT(in) :: type_of_var, n_var
340 : TYPE(enumeration_type), POINTER :: enum
341 : TYPE(cp_parser_type), INTENT(INOUT) :: parser
342 : TYPE(cp_unit_type), POINTER :: unit
343 : TYPE(cp_unit_set_type), INTENT(IN) :: default_units
344 : TYPE(val_type), OPTIONAL, POINTER :: default_value
345 :
346 : CHARACTER(len=*), PARAMETER :: routineN = 'val_create_parsing'
347 :
348 : CHARACTER(len=default_string_length) :: c_val, info, location
349 : CHARACTER(len=default_string_length), &
350 742883 : DIMENSION(:), POINTER :: c_val_p
351 : INTEGER :: handle, i, i_val
352 742883 : INTEGER, DIMENSION(:), POINTER :: i_val_p
353 : LOGICAL :: check, eol, l_val, quoted
354 742883 : LOGICAL, DIMENSION(:), POINTER :: l_val_p
355 : REAL(kind=dp) :: r_val
356 742883 : REAL(kind=dp), DIMENSION(:), POINTER :: r_val_p
357 : TYPE(cp_sll_char_type), POINTER :: c_first, c_last, c_new
358 : TYPE(cp_sll_int_type), POINTER :: i_first, i_last, i_new
359 : TYPE(cp_sll_logical_type), POINTER :: l_first, l_last, l_new
360 : TYPE(cp_sll_real_type), POINTER :: r_first, r_last, r_new
361 :
362 742883 : CALL timeset(routineN, handle)
363 :
364 742883 : CPASSERT(.NOT. ASSOCIATED(val))
365 787557 : SELECT CASE (type_of_var)
366 : CASE (no_t)
367 : CASE (logical_t)
368 44674 : NULLIFY (l_val_p)
369 89348 : IF (parser_test_next_token(parser) == "EOL") THEN
370 20940 : IF (.NOT. ASSOCIATED(default_value)) THEN
371 0 : IF (n_var < 1) THEN
372 0 : ALLOCATE (l_val_p(0))
373 0 : CALL val_create(val, l_vals_ptr=l_val_p)
374 : ELSE
375 : CALL cp_abort(__LOCATION__, &
376 : "no value was given and there is no default value"// &
377 0 : TRIM(parser_location(parser)))
378 : END IF
379 : ELSE
380 20940 : CPASSERT(ASSOCIATED(default_value%l_val))
381 20940 : CALL val_create(val, l_vals=default_value%l_val)
382 : END IF
383 : ELSE
384 23734 : IF (n_var < 1) THEN
385 0 : NULLIFY (l_last, l_first)
386 0 : CALL parser_get_object(parser, l_val)
387 0 : CALL cp_create(l_first, l_val)
388 0 : l_last => l_first
389 0 : DO WHILE (parser_test_next_token(parser) /= "EOL")
390 0 : CALL parser_get_object(parser, l_val)
391 0 : CALL cp_create(l_new, l_val)
392 0 : l_last%rest => l_new
393 0 : l_last => l_new
394 : END DO
395 0 : l_val_p => cp_to_array(l_first)
396 0 : CALL cp_dealloc(l_first)
397 : ELSE
398 71202 : ALLOCATE (l_val_p(n_var))
399 47468 : DO i = 1, n_var
400 47468 : CALL parser_get_object(parser, l_val_p(i))
401 : END DO
402 : END IF
403 68408 : IF (ASSOCIATED(l_val_p)) THEN
404 23734 : CALL val_create(val, l_vals_ptr=l_val_p)
405 : END IF
406 : END IF
407 : CASE (integer_t)
408 55530 : NULLIFY (i_val_p)
409 111060 : IF (parser_test_next_token(parser) == "EOL") THEN
410 16 : IF (.NOT. ASSOCIATED(default_value)) THEN
411 0 : IF (n_var < 1) THEN
412 0 : ALLOCATE (i_val_p(0))
413 0 : CALL val_create(val, i_vals_ptr=i_val_p)
414 : ELSE
415 : CALL cp_abort(__LOCATION__, &
416 : "no value was given and there is no default value"// &
417 0 : TRIM(parser_location(parser)))
418 : END IF
419 : ELSE
420 16 : check = ASSOCIATED(default_value%i_val)
421 16 : CPASSERT(check)
422 16 : CALL val_create(val, i_vals=default_value%i_val)
423 : END IF
424 : ELSE
425 55514 : IF (n_var < 1) THEN
426 8575 : NULLIFY (i_last, i_first)
427 8575 : CALL parser_get_object(parser, i_val)
428 8575 : CALL cp_create(i_first, i_val)
429 8575 : i_last => i_first
430 31259 : DO WHILE (parser_test_next_token(parser) /= "EOL")
431 22684 : CALL parser_get_object(parser, i_val)
432 22684 : CALL cp_create(i_new, i_val)
433 22684 : i_last%rest => i_new
434 22684 : i_last => i_new
435 : END DO
436 8575 : i_val_p => cp_to_array(i_first)
437 8575 : CALL cp_dealloc(i_first)
438 : ELSE
439 140817 : ALLOCATE (i_val_p(n_var))
440 99250 : DO i = 1, n_var
441 99250 : CALL parser_get_object(parser, i_val_p(i))
442 : END DO
443 : END IF
444 111044 : IF (ASSOCIATED(i_val_p)) THEN
445 55514 : CALL val_create(val, i_vals_ptr=i_val_p)
446 : END IF
447 : END IF
448 : CASE (real_t)
449 168407 : NULLIFY (r_val_p)
450 336814 : IF (parser_test_next_token(parser) == "EOL") THEN
451 2 : IF (.NOT. ASSOCIATED(default_value)) THEN
452 2 : IF (n_var < 1) THEN
453 2 : ALLOCATE (r_val_p(0))
454 2 : CALL val_create(val, r_vals_ptr=r_val_p)
455 : ELSE
456 : CALL cp_abort(__LOCATION__, &
457 : "no value was given and there is no default value"// &
458 0 : TRIM(parser_location(parser)))
459 : END IF
460 : ELSE
461 0 : CPASSERT(ASSOCIATED(default_value%r_val))
462 0 : CALL val_create(val, r_vals=default_value%r_val)
463 : END IF
464 : ELSE
465 168405 : IF (n_var < 1) THEN
466 16879 : NULLIFY (r_last, r_first)
467 16879 : c_val = ""
468 16879 : CALL get_r_val(r_val, parser, unit, default_units, c_val)
469 16879 : CALL cp_create(r_first, r_val)
470 16879 : r_last => r_first
471 333893 : DO WHILE (parser_test_next_token(parser) /= "EOL")
472 317014 : CALL get_r_val(r_val, parser, unit, default_units, c_val)
473 317014 : CALL cp_create(r_new, r_val)
474 317014 : r_last%rest => r_new
475 317014 : r_last => r_new
476 : END DO
477 16879 : NULLIFY (r_last)
478 16879 : r_val_p => cp_to_array(r_first)
479 16879 : CALL cp_dealloc(r_first)
480 : ELSE
481 454578 : ALLOCATE (r_val_p(n_var))
482 151526 : c_val = ""
483 393286 : DO i = 1, n_var
484 393286 : CALL get_r_val(r_val_p(i), parser, unit, default_units, c_val)
485 : END DO
486 : END IF
487 336812 : IF (ASSOCIATED(r_val_p)) THEN
488 168405 : CALL val_create(val, r_vals_ptr=r_val_p)
489 : END IF
490 : END IF
491 : CASE (char_t)
492 83097 : NULLIFY (c_val_p)
493 166194 : IF (parser_test_next_token(parser) == "EOL") THEN
494 206 : IF (n_var < 1) THEN
495 2 : ALLOCATE (c_val_p(1))
496 2 : c_val_p(1) = ' '
497 2 : CALL val_create(val, c_vals_ptr=c_val_p)
498 : ELSE
499 204 : IF (.NOT. ASSOCIATED(default_value)) THEN
500 : CALL cp_abort(__LOCATION__, &
501 : "no value was given and there is no default value"// &
502 0 : TRIM(parser_location(parser)))
503 : ELSE
504 204 : CPASSERT(ASSOCIATED(default_value%c_val))
505 204 : CALL val_create(val, c_vals=default_value%c_val)
506 : END IF
507 : END IF
508 : ELSE
509 82891 : IF (n_var < 1) THEN
510 32546 : CPASSERT(n_var == -1)
511 32546 : NULLIFY (c_last, c_first)
512 32546 : CALL parser_get_object(parser, c_val)
513 32546 : CALL cp_create(c_first, c_val)
514 32546 : c_last => c_first
515 42246 : DO WHILE (parser_test_next_token(parser) /= "EOL")
516 9700 : CALL parser_get_object(parser, c_val)
517 9700 : CALL cp_create(c_new, c_val)
518 9700 : c_last%rest => c_new
519 9700 : c_last => c_new
520 : END DO
521 32546 : c_val_p => cp_to_array(c_first)
522 32546 : CALL cp_dealloc(c_first)
523 : ELSE
524 151035 : ALLOCATE (c_val_p(n_var))
525 117032 : DO i = 1, n_var
526 117032 : CALL parser_get_object(parser, c_val_p(i))
527 : END DO
528 : END IF
529 165988 : IF (ASSOCIATED(c_val_p)) THEN
530 82891 : CALL val_create(val, c_vals_ptr=c_val_p)
531 : END IF
532 : END IF
533 : CASE (lchar_t)
534 270967 : IF (ASSOCIATED(default_value)) THEN
535 : CALL cp_abort(__LOCATION__, &
536 : "input variables of type lchar_t cannot have a lone keyword attribute,"// &
537 : " no value is interpreted as empty string"// &
538 0 : TRIM(parser_location(parser)))
539 : END IF
540 270967 : IF (n_var /= 1) THEN
541 : CALL cp_abort(__LOCATION__, &
542 : "input variables of type lchar_t cannot be repeated,"// &
543 : " one always represent a whole line, till the end"// &
544 0 : TRIM(parser_location(parser)))
545 : END IF
546 270967 : IF (parser_test_next_token(parser) == "EOL") THEN
547 86 : ALLOCATE (c_val_p(1))
548 86 : c_val_p(1) = ' '
549 : ELSE
550 270881 : NULLIFY (c_last, c_first)
551 270881 : CALL parser_get_object(parser, c_val, string_length=LEN(c_val))
552 270881 : IF (c_val(1:1) == parser%quote_character) THEN
553 40 : quoted = .TRUE.
554 40 : c_val(1:) = c_val(2:) ! Drop first quotation mark
555 40 : i = INDEX(c_val, parser%quote_character) ! Check for second quotation mark
556 40 : IF (i > 0) THEN
557 0 : c_val(i:) = "" ! Discard stuff after second quotation mark
558 : eol = .TRUE. ! Enforce end of line
559 : ELSE
560 : eol = .FALSE.
561 : END IF
562 : ELSE
563 : quoted = .FALSE.
564 : eol = .FALSE.
565 : END IF
566 270881 : CALL cp_create(c_first, c_val)
567 270881 : c_last => c_first
568 293069 : DO WHILE ((.NOT. eol) .AND. (parser_test_next_token(parser) /= "EOL"))
569 22188 : CALL parser_get_object(parser, c_val, string_length=LEN(c_val))
570 22188 : i = INDEX(c_val, parser%quote_character) ! Check for quotation mark
571 22188 : IF (i > 0) THEN
572 40 : IF (quoted) THEN
573 40 : c_val(i:) = "" ! Discard stuff after second quotation mark
574 : eol = .TRUE. ! Enforce end of line
575 : ELSE
576 : CALL cp_abort(__LOCATION__, &
577 : "Quotation mark found which is not the first non-blank character. "// &
578 : "Possibly the first quotation mark is missing?"// &
579 0 : TRIM(parser_location(parser)))
580 : END IF
581 : ELSE
582 : eol = .FALSE.
583 : END IF
584 22188 : CALL cp_create(c_new, c_val)
585 22188 : c_last%rest => c_new
586 22188 : c_last => c_new
587 : END DO
588 270881 : c_val_p => cp_to_array(c_first)
589 541848 : CALL cp_dealloc(c_first)
590 : END IF
591 270967 : CPASSERT(ASSOCIATED(c_val_p))
592 270967 : CALL val_create(val, lc_vals_ptr=c_val_p)
593 : CASE (enum_t)
594 120208 : CPASSERT(ASSOCIATED(enum))
595 120208 : NULLIFY (i_val_p)
596 240416 : IF (parser_test_next_token(parser) == "EOL") THEN
597 11236 : IF (.NOT. ASSOCIATED(default_value)) THEN
598 0 : IF (n_var < 1) THEN
599 0 : ALLOCATE (i_val_p(0))
600 0 : CALL val_create(val, i_vals_ptr=i_val_p)
601 : ELSE
602 : CALL cp_abort(__LOCATION__, &
603 : "no value was given and there is no default value"// &
604 0 : TRIM(parser_location(parser)))
605 : END IF
606 : ELSE
607 11236 : CPASSERT(ASSOCIATED(default_value%i_val))
608 : CALL val_create(val, i_vals=default_value%i_val, &
609 11236 : enum=default_value%enum)
610 : END IF
611 : ELSE
612 108972 : IF (n_var < 1) THEN
613 76 : NULLIFY (i_last, i_first)
614 76 : CALL parser_get_object(parser, c_val)
615 76 : CALL cp_create(i_first, enum_c2i(enum, c_val))
616 76 : i_last => i_first
617 86 : DO WHILE (parser_test_next_token(parser) /= "EOL")
618 10 : CALL parser_get_object(parser, c_val)
619 10 : CALL cp_create(i_new, enum_c2i(enum, c_val))
620 10 : i_last%rest => i_new
621 10 : i_last => i_new
622 : END DO
623 76 : i_val_p => cp_to_array(i_first)
624 76 : CALL cp_dealloc(i_first)
625 : ELSE
626 326688 : ALLOCATE (i_val_p(n_var))
627 217792 : DO i = 1, n_var
628 108896 : CALL parser_get_object(parser, c_val)
629 217792 : i_val_p(i) = enum_c2i(enum, c_val)
630 : END DO
631 : END IF
632 229180 : IF (ASSOCIATED(i_val_p)) THEN
633 108972 : CALL val_create(val, i_vals_ptr=i_val_p, enum=enum)
634 : END IF
635 : END IF
636 : CASE default
637 : CALL cp_abort(__LOCATION__, &
638 742883 : "type "//cp_to_string(type_of_var)//"unknown to the parser")
639 : END SELECT
640 742883 : IF (parser_test_next_token(parser) /= "EOL") THEN
641 0 : location = TRIM(parser_location(parser))
642 0 : CALL parser_get_object(parser, info)
643 : CALL cp_abort(__LOCATION__, &
644 742883 : "found unexpected extra argument "//TRIM(info)//" at "//location)
645 : END IF
646 :
647 742883 : CALL timestop(handle)
648 :
649 742883 : END SUBROUTINE val_create_parsing
650 :
651 : ! **************************************************************************************************
652 : !> \brief Reads and convert a real number from the input file
653 : !> \param r_val ...
654 : !> \param parser the parser from where the values should be read
655 : !> \param unit ...
656 : !> \param default_units ...
657 : !> \param c_val ...
658 : !> \author Teodoro Laino - 11.2007 [tlaino] - University of Zurich
659 : ! **************************************************************************************************
660 1151306 : SUBROUTINE get_r_val(r_val, parser, unit, default_units, c_val)
661 : REAL(kind=dp), INTENT(OUT) :: r_val
662 : TYPE(cp_parser_type), INTENT(INOUT) :: parser
663 : TYPE(cp_unit_type), POINTER :: unit
664 : TYPE(cp_unit_set_type), INTENT(IN) :: default_units
665 : CHARACTER(len=default_string_length), &
666 : INTENT(INOUT) :: c_val
667 :
668 : TYPE(cp_unit_type), POINTER :: my_unit
669 :
670 575653 : NULLIFY (my_unit)
671 575653 : IF (ASSOCIATED(unit)) THEN
672 113323 : IF ('STR' == parser_test_next_token(parser)) THEN
673 12578 : CALL parser_get_object(parser, c_val)
674 12578 : IF (c_val(1:1) /= "[" .OR. c_val(LEN_TRIM(c_val):LEN_TRIM(c_val)) /= "]") THEN
675 : CALL cp_abort(__LOCATION__, &
676 : "Invalid unit specifier or function found when parsing a number: "// &
677 0 : c_val)
678 : END IF
679 314450 : ALLOCATE (my_unit)
680 12578 : CALL cp_unit_create(my_unit, c_val(2:LEN_TRIM(c_val) - 1))
681 : ELSE
682 214068 : IF (c_val /= "") THEN
683 94300 : ALLOCATE (my_unit)
684 3772 : CALL cp_unit_create(my_unit, c_val(2:LEN_TRIM(c_val) - 1))
685 : ELSE
686 96973 : my_unit => unit
687 : END IF
688 : END IF
689 113323 : IF (.NOT. cp_unit_compatible(unit, my_unit)) THEN
690 : CALL cp_abort(__LOCATION__, &
691 : "Incompatible units. Defined as ("// &
692 : TRIM(cp_unit_desc(unit))//") specified in input as ("// &
693 0 : TRIM(cp_unit_desc(my_unit))//"). These units are incompatible!")
694 : END IF
695 : END IF
696 575653 : CALL parser_get_object(parser, r_val)
697 575653 : IF (ASSOCIATED(unit)) THEN
698 113323 : r_val = cp_unit_to_cp2k1(r_val, my_unit, default_units)
699 113323 : IF (.NOT. (ASSOCIATED(my_unit, unit))) THEN
700 16350 : CALL cp_unit_release(my_unit)
701 16350 : DEALLOCATE (my_unit)
702 : END IF
703 : END IF
704 :
705 575653 : END SUBROUTINE get_r_val
706 :
707 : END MODULE input_parsing
|
