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 262246 : 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 262246 : CALL timeset(routineN, handle)
86 :
87 262246 : NULLIFY (previous_list, previous_last)
88 :
89 262246 : root_sect = .TRUE.
90 262246 : IF (PRESENT(root_section)) root_sect = root_section
91 :
92 262246 : CPASSERT(ASSOCIATED(section_vals))
93 262246 : output_unit = cp_logger_get_default_io_unit()
94 :
95 262246 : CPASSERT(section_vals%ref_count > 0)
96 262246 : 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 262246 : section => section_vals%section
102 262246 : IF (root_sect) THEN
103 250808 : token = TRIM(ADJUSTL(parser%input_line(parser%icol1:parser%icol2))) ! Ignore leading or trailing blanks
104 250808 : CALL uppercase(token)
105 250808 : 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 262246 : 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 262246 : CALL section_vals_add_values(section_vals)
116 262246 : irs = SIZE(section_vals%values, 2)
117 :
118 262246 : 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 262246 : IF (ASSOCIATED(section%keywords(-1)%keyword)) THEN ! reads section params
126 57227 : keyword => section%keywords(-1)%keyword
127 57227 : NULLIFY (el)
128 57227 : 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 57227 : parser=parser)
134 57227 : NULLIFY (new_val)
135 57227 : CALL cp_sll_val_create(new_val, el)
136 57227 : section_vals%values(-1, irs)%list => new_val
137 57227 : NULLIFY (el)
138 : END IF
139 : DO WHILE (.TRUE.)
140 : CALL parser_get_object(parser, token, newline=.TRUE., &
141 1206131 : lower_to_upper=.TRUE., at_end=at_end)
142 1206131 : token = TRIM(ADJUSTL(token)) ! Ignore leading or trailing blanks
143 1206131 : IF (at_end) THEN
144 11438 : 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 1194693 : IF (token(1:1) == parser%section_character) THEN
152 501531 : IF (token == "&END") THEN
153 : ! end of section
154 250808 : compatible_end = .TRUE.
155 250808 : IF (parser_test_next_token(parser) /= "EOL") THEN
156 : CALL parser_get_object(parser, token, newline=.FALSE., &
157 249322 : lower_to_upper=.TRUE.)
158 500130 : IF (token /= "SECTION" .AND. token /= section%name) THEN
159 0 : compatible_end = .FALSE.
160 : END IF
161 : END IF
162 250808 : IF (parser_test_next_token(parser) /= "EOL") THEN
163 : CALL parser_get_object(parser, token, newline=.FALSE., &
164 0 : lower_to_upper=.TRUE.)
165 250808 : IF (token /= section%name) THEN
166 0 : PRINT *, TRIM(token), "/=", TRIM(section%name)
167 : compatible_end = .FALSE.
168 : END IF
169 : END IF
170 250808 : 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 250723 : is = section_get_subsection_index(section, token(2:))
179 250723 : IF (is > 0) THEN
180 : CALL section_vals_parse(section_vals%subs_vals(is, irs)%section_vals, &
181 250723 : 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 693162 : 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 693160 : ik = section_get_keyword_index(section, token)
240 693160 : IF (ik < 1) THEN ! don't accept pseudo keyword names
241 291268 : parser%icol = parser%icol1 - 1 ! re-read also the actual token
242 291268 : ik = 0
243 291268 : 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 693160 : keyword => section%keywords(ik)%keyword
263 693160 : IF (ASSOCIATED(keyword)) THEN
264 693160 : 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 693160 : 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 1028 : keyword%deprecation_notice)
281 : END IF
282 :
283 693160 : NULLIFY (el)
284 693160 : IF (ik /= 0 .AND. keyword%type_of_var == lchar_t) THEN
285 23911 : 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 693160 : default_units=default_units, parser=parser)
291 693160 : IF (ASSOCIATED(el)) THEN
292 693160 : NULLIFY (new_val)
293 693160 : CALL cp_sll_val_create(new_val, el)
294 693160 : last_val => section_vals%values(ik, irs)%list
295 693160 : IF (.NOT. ASSOCIATED(last_val)) THEN
296 409067 : section_vals%values(ik, irs)%list => new_val
297 : ELSE
298 284093 : 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 284093 : IF (ASSOCIATED(last_val, previous_list)) THEN
304 284093 : last_val => previous_last
305 : ELSE
306 13321 : previous_list => last_val
307 : END IF
308 284093 : DO WHILE (ASSOCIATED(last_val%rest))
309 284093 : last_val => last_val%rest
310 : END DO
311 284093 : last_val%rest => new_val
312 284093 : previous_last => new_val
313 : END IF
314 : END IF
315 : END IF
316 : END IF
317 : END IF
318 : END DO
319 262246 : CALL timestop(handle)
320 262246 : 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 750387 : 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 750387 : DIMENSION(:), POINTER :: c_val_p
351 : INTEGER :: handle, i, i_val
352 750387 : INTEGER, DIMENSION(:), POINTER :: i_val_p
353 : LOGICAL :: check, eol, l_val, quoted
354 750387 : LOGICAL, DIMENSION(:), POINTER :: l_val_p
355 : REAL(kind=dp) :: r_val
356 750387 : 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 750387 : CALL timeset(routineN, handle)
363 :
364 750387 : CPASSERT(.NOT. ASSOCIATED(val))
365 795941 : SELECT CASE (type_of_var)
366 : CASE (no_t)
367 : CASE (logical_t)
368 45554 : NULLIFY (l_val_p)
369 91108 : IF (parser_test_next_token(parser) == "EOL") THEN
370 21404 : 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 21404 : CPASSERT(ASSOCIATED(default_value%l_val))
381 21404 : CALL val_create(val, l_vals=default_value%l_val)
382 : END IF
383 : ELSE
384 24150 : 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 72450 : ALLOCATE (l_val_p(n_var))
399 48300 : DO i = 1, n_var
400 48300 : CALL parser_get_object(parser, l_val_p(i))
401 : END DO
402 : END IF
403 69704 : IF (ASSOCIATED(l_val_p)) THEN
404 24150 : CALL val_create(val, l_vals_ptr=l_val_p)
405 : END IF
406 : END IF
407 : CASE (integer_t)
408 56284 : NULLIFY (i_val_p)
409 112568 : 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 56268 : IF (n_var < 1) THEN
426 8671 : NULLIFY (i_last, i_first)
427 8671 : CALL parser_get_object(parser, i_val)
428 8671 : CALL cp_create(i_first, i_val)
429 8671 : i_last => i_first
430 31387 : DO WHILE (parser_test_next_token(parser) /= "EOL")
431 22716 : CALL parser_get_object(parser, i_val)
432 22716 : CALL cp_create(i_new, i_val)
433 22716 : i_last%rest => i_new
434 22716 : i_last => i_new
435 : END DO
436 8671 : i_val_p => cp_to_array(i_first)
437 8671 : CALL cp_dealloc(i_first)
438 : ELSE
439 142791 : ALLOCATE (i_val_p(n_var))
440 100682 : DO i = 1, n_var
441 100682 : CALL parser_get_object(parser, i_val_p(i))
442 : END DO
443 : END IF
444 112552 : IF (ASSOCIATED(i_val_p)) THEN
445 56268 : CALL val_create(val, i_vals_ptr=i_val_p)
446 : END IF
447 : END IF
448 : CASE (real_t)
449 169589 : NULLIFY (r_val_p)
450 339178 : 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 169587 : IF (n_var < 1) THEN
466 16931 : NULLIFY (r_last, r_first)
467 16931 : c_val = ""
468 16931 : CALL get_r_val(r_val, parser, unit, default_units, c_val)
469 16931 : CALL cp_create(r_first, r_val)
470 16931 : r_last => r_first
471 333973 : DO WHILE (parser_test_next_token(parser) /= "EOL")
472 317042 : CALL get_r_val(r_val, parser, unit, default_units, c_val)
473 317042 : CALL cp_create(r_new, r_val)
474 317042 : r_last%rest => r_new
475 317042 : r_last => r_new
476 : END DO
477 16931 : NULLIFY (r_last)
478 16931 : r_val_p => cp_to_array(r_first)
479 16931 : CALL cp_dealloc(r_first)
480 : ELSE
481 457968 : ALLOCATE (r_val_p(n_var))
482 152656 : c_val = ""
483 395848 : DO i = 1, n_var
484 395848 : CALL get_r_val(r_val_p(i), parser, unit, default_units, c_val)
485 : END DO
486 : END IF
487 339176 : IF (ASSOCIATED(r_val_p)) THEN
488 169587 : CALL val_create(val, r_vals_ptr=r_val_p)
489 : END IF
490 : END IF
491 : CASE (char_t)
492 83813 : NULLIFY (c_val_p)
493 167626 : IF (parser_test_next_token(parser) == "EOL") THEN
494 208 : IF (ASSOCIATED(default_value)) THEN
495 206 : CPASSERT(ASSOCIATED(default_value%c_val))
496 206 : CALL val_create(val, c_vals=default_value%c_val)
497 2 : ELSE IF (n_var < 1) THEN
498 2 : ALLOCATE (c_val_p(1))
499 2 : c_val_p(1) = ' '
500 2 : CALL val_create(val, c_vals_ptr=c_val_p)
501 : ELSE
502 : CALL cp_abort(__LOCATION__, &
503 : "no value was given and there is no default value"// &
504 0 : TRIM(parser_location(parser)))
505 : END IF
506 : ELSE
507 83605 : IF (n_var < 1) THEN
508 32900 : CPASSERT(n_var == -1)
509 32900 : NULLIFY (c_last, c_first)
510 32900 : CALL parser_get_object(parser, c_val)
511 32900 : CALL cp_create(c_first, c_val)
512 32900 : c_last => c_first
513 42740 : DO WHILE (parser_test_next_token(parser) /= "EOL")
514 9840 : CALL parser_get_object(parser, c_val)
515 9840 : CALL cp_create(c_new, c_val)
516 9840 : c_last%rest => c_new
517 9840 : c_last => c_new
518 : END DO
519 32900 : c_val_p => cp_to_array(c_first)
520 32900 : CALL cp_dealloc(c_first)
521 : ELSE
522 152115 : ALLOCATE (c_val_p(n_var))
523 117780 : DO i = 1, n_var
524 117780 : CALL parser_get_object(parser, c_val_p(i))
525 : END DO
526 : END IF
527 167418 : IF (ASSOCIATED(c_val_p)) THEN
528 83605 : CALL val_create(val, c_vals_ptr=c_val_p)
529 : END IF
530 : END IF
531 : CASE (lchar_t)
532 273141 : IF (ASSOCIATED(default_value)) THEN
533 : CALL cp_abort(__LOCATION__, &
534 : "input variables of type lchar_t cannot have a lone keyword attribute,"// &
535 : " no value is interpreted as empty string"// &
536 0 : TRIM(parser_location(parser)))
537 : END IF
538 273141 : IF (n_var /= 1) THEN
539 : CALL cp_abort(__LOCATION__, &
540 : "input variables of type lchar_t cannot be repeated,"// &
541 : " one always represent a whole line, till the end"// &
542 0 : TRIM(parser_location(parser)))
543 : END IF
544 273141 : IF (parser_test_next_token(parser) == "EOL") THEN
545 86 : ALLOCATE (c_val_p(1))
546 86 : c_val_p(1) = ' '
547 : ELSE
548 273055 : NULLIFY (c_last, c_first)
549 273055 : CALL parser_get_object(parser, c_val, string_length=LEN(c_val))
550 273055 : IF (c_val(1:1) == parser%quote_character) THEN
551 40 : quoted = .TRUE.
552 40 : c_val(1:) = c_val(2:) ! Drop first quotation mark
553 40 : i = INDEX(c_val, parser%quote_character) ! Check for second quotation mark
554 40 : IF (i > 0) THEN
555 0 : c_val(i:) = "" ! Discard stuff after second quotation mark
556 : eol = .TRUE. ! Enforce end of line
557 : ELSE
558 : eol = .FALSE.
559 : END IF
560 : ELSE
561 : quoted = .FALSE.
562 : eol = .FALSE.
563 : END IF
564 273055 : CALL cp_create(c_first, c_val)
565 273055 : c_last => c_first
566 295243 : DO WHILE ((.NOT. eol) .AND. (parser_test_next_token(parser) /= "EOL"))
567 22188 : CALL parser_get_object(parser, c_val, string_length=LEN(c_val))
568 22188 : i = INDEX(c_val, parser%quote_character) ! Check for quotation mark
569 22188 : IF (i > 0) THEN
570 40 : IF (quoted) THEN
571 40 : c_val(i:) = "" ! Discard stuff after second quotation mark
572 : eol = .TRUE. ! Enforce end of line
573 : ELSE
574 : CALL cp_abort(__LOCATION__, &
575 : "Quotation mark found which is not the first non-blank character. "// &
576 : "Possibly the first quotation mark is missing?"// &
577 0 : TRIM(parser_location(parser)))
578 : END IF
579 : ELSE
580 : eol = .FALSE.
581 : END IF
582 22188 : CALL cp_create(c_new, c_val)
583 22188 : c_last%rest => c_new
584 22188 : c_last => c_new
585 : END DO
586 273055 : c_val_p => cp_to_array(c_first)
587 546196 : CALL cp_dealloc(c_first)
588 : END IF
589 273141 : CPASSERT(ASSOCIATED(c_val_p))
590 273141 : CALL val_create(val, lc_vals_ptr=c_val_p)
591 : CASE (enum_t)
592 122006 : CPASSERT(ASSOCIATED(enum))
593 122006 : NULLIFY (i_val_p)
594 244012 : IF (parser_test_next_token(parser) == "EOL") THEN
595 11394 : IF (.NOT. ASSOCIATED(default_value)) THEN
596 0 : IF (n_var < 1) THEN
597 0 : ALLOCATE (i_val_p(0))
598 0 : CALL val_create(val, i_vals_ptr=i_val_p)
599 : ELSE
600 : CALL cp_abort(__LOCATION__, &
601 : "no value was given and there is no default value"// &
602 0 : TRIM(parser_location(parser)))
603 : END IF
604 : ELSE
605 11394 : CPASSERT(ASSOCIATED(default_value%i_val))
606 : CALL val_create(val, i_vals=default_value%i_val, &
607 11394 : enum=default_value%enum)
608 : END IF
609 : ELSE
610 110612 : IF (n_var < 1) THEN
611 76 : NULLIFY (i_last, i_first)
612 76 : CALL parser_get_object(parser, c_val)
613 76 : CALL cp_create(i_first, enum_c2i(enum, c_val))
614 76 : i_last => i_first
615 86 : DO WHILE (parser_test_next_token(parser) /= "EOL")
616 10 : CALL parser_get_object(parser, c_val)
617 10 : CALL cp_create(i_new, enum_c2i(enum, c_val))
618 10 : i_last%rest => i_new
619 10 : i_last => i_new
620 : END DO
621 76 : i_val_p => cp_to_array(i_first)
622 76 : CALL cp_dealloc(i_first)
623 : ELSE
624 331608 : ALLOCATE (i_val_p(n_var))
625 221072 : DO i = 1, n_var
626 110536 : CALL parser_get_object(parser, c_val)
627 221072 : i_val_p(i) = enum_c2i(enum, c_val)
628 : END DO
629 : END IF
630 232618 : IF (ASSOCIATED(i_val_p)) THEN
631 110612 : CALL val_create(val, i_vals_ptr=i_val_p, enum=enum)
632 : END IF
633 : END IF
634 : CASE default
635 : CALL cp_abort(__LOCATION__, &
636 750387 : "type "//cp_to_string(type_of_var)//"unknown to the parser")
637 : END SELECT
638 750387 : IF (parser_test_next_token(parser) /= "EOL") THEN
639 0 : location = TRIM(parser_location(parser))
640 0 : CALL parser_get_object(parser, info)
641 : CALL cp_abort(__LOCATION__, &
642 750387 : "found unexpected extra argument "//TRIM(info)//" at "//location)
643 : END IF
644 :
645 750387 : CALL timestop(handle)
646 :
647 750387 : END SUBROUTINE val_create_parsing
648 :
649 : ! **************************************************************************************************
650 : !> \brief Reads and convert a real number from the input file
651 : !> \param r_val ...
652 : !> \param parser the parser from where the values should be read
653 : !> \param unit ...
654 : !> \param default_units ...
655 : !> \param c_val ...
656 : !> \author Teodoro Laino - 11.2007 [tlaino] - University of Zurich
657 : ! **************************************************************************************************
658 1154330 : SUBROUTINE get_r_val(r_val, parser, unit, default_units, c_val)
659 : REAL(kind=dp), INTENT(OUT) :: r_val
660 : TYPE(cp_parser_type), INTENT(INOUT) :: parser
661 : TYPE(cp_unit_type), POINTER :: unit
662 : TYPE(cp_unit_set_type), INTENT(IN) :: default_units
663 : CHARACTER(len=default_string_length), &
664 : INTENT(INOUT) :: c_val
665 :
666 : TYPE(cp_unit_type), POINTER :: my_unit
667 :
668 577165 : NULLIFY (my_unit)
669 577165 : IF (ASSOCIATED(unit)) THEN
670 114311 : IF ('STR' == parser_test_next_token(parser)) THEN
671 12708 : CALL parser_get_object(parser, c_val)
672 12708 : IF (c_val(1:1) /= "[" .OR. c_val(LEN_TRIM(c_val):LEN_TRIM(c_val)) /= "]") THEN
673 : CALL cp_abort(__LOCATION__, &
674 : "Invalid unit specifier or function found when parsing a number: "// &
675 0 : c_val)
676 : END IF
677 317700 : ALLOCATE (my_unit)
678 12708 : CALL cp_unit_create(my_unit, c_val(2:LEN_TRIM(c_val) - 1))
679 : ELSE
680 215914 : IF (c_val /= "") THEN
681 94800 : ALLOCATE (my_unit)
682 3792 : CALL cp_unit_create(my_unit, c_val(2:LEN_TRIM(c_val) - 1))
683 : ELSE
684 97811 : my_unit => unit
685 : END IF
686 : END IF
687 114311 : IF (.NOT. cp_unit_compatible(unit, my_unit)) THEN
688 : CALL cp_abort(__LOCATION__, &
689 : "Incompatible units. Defined as ("// &
690 : TRIM(cp_unit_desc(unit))//") specified in input as ("// &
691 0 : TRIM(cp_unit_desc(my_unit))//"). These units are incompatible!")
692 : END IF
693 : END IF
694 577165 : CALL parser_get_object(parser, r_val)
695 577165 : IF (ASSOCIATED(unit)) THEN
696 114311 : r_val = cp_unit_to_cp2k1(r_val, my_unit, default_units)
697 114311 : IF (.NOT. (ASSOCIATED(my_unit, unit))) THEN
698 16500 : CALL cp_unit_release(my_unit)
699 16500 : DEALLOCATE (my_unit)
700 : END IF
701 : END IF
702 :
703 577165 : END SUBROUTINE get_r_val
704 :
705 : END MODULE input_parsing
|
