Line data Source code
1 : !--------------------------------------------------------------------------------------------------!
2 : ! CP2K: A general program to perform molecular dynamics simulations !
3 : ! Copyright 2000-2022 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 203904 : 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), POINTER :: parser
69 : TYPE(cp_unit_set_type), POINTER :: 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 203904 : CALL timeset(routineN, handle)
86 :
87 203904 : NULLIFY (previous_list, previous_last)
88 :
89 203904 : root_sect = .TRUE.
90 203904 : IF (PRESENT(root_section)) root_sect = root_section
91 :
92 203904 : CPASSERT(ASSOCIATED(section_vals))
93 203904 : CPASSERT(ASSOCIATED(parser))
94 203904 : output_unit = cp_logger_get_default_io_unit()
95 :
96 203904 : CPASSERT(section_vals%ref_count > 0)
97 203904 : CPASSERT(parser%ref_count > 0)
98 203904 : IF (root_sect .AND. parser%icol1 > parser%icol2) &
99 : CALL cp_abort(__LOCATION__, &
100 : "Error 1: this routine must be called just after having parsed the start of the section " &
101 0 : //TRIM(parser_location(parser)))
102 203904 : section => section_vals%section
103 203904 : IF (root_sect) THEN
104 195496 : token = TRIM(ADJUSTL(parser%input_line(parser%icol1:parser%icol2))) ! Ignore leading or trailing blanks
105 195496 : CALL uppercase(token)
106 195496 : IF (token /= parser%section_character//section%name) &
107 : CALL cp_abort(__LOCATION__, &
108 : "Error 2: this routine must be called just after having parsed the start of the section " &
109 0 : //TRIM(parser_location(parser)))
110 : END IF
111 203904 : IF (.NOT. section%repeats .AND. SIZE(section_vals%values, 2) /= 0) &
112 : CALL cp_abort(__LOCATION__, "Section "//TRIM(section%name)// &
113 0 : " should not repeat "//TRIM(parser_location(parser)))
114 203904 : CALL section_vals_add_values(section_vals)
115 203904 : irs = SIZE(section_vals%values, 2)
116 :
117 203904 : IF (ASSOCIATED(section%keywords(-1)%keyword)) THEN ! reads section params
118 42281 : keyword => section%keywords(-1)%keyword
119 42281 : NULLIFY (el)
120 42281 : IF (keyword%type_of_var == lchar_t) CALL parser_skip_space(parser)
121 : CALL val_create_parsing(el, type_of_var=keyword%type_of_var, &
122 : n_var=keyword%n_var, default_value=keyword%lone_keyword_value, &
123 : enum=keyword%enum, unit=keyword%unit, &
124 : default_units=default_units, &
125 42281 : parser=parser)
126 42281 : NULLIFY (new_val)
127 42281 : CALL cp_sll_val_create(new_val, el)
128 42281 : section_vals%values(-1, irs)%list => new_val
129 42281 : NULLIFY (el)
130 : END IF
131 : DO WHILE (.TRUE.)
132 : CALL parser_get_object(parser, token, newline=.TRUE., &
133 996960 : lower_to_upper=.TRUE., at_end=at_end)
134 996960 : token = TRIM(ADJUSTL(token)) ! Ignore leading or trailing blanks
135 996960 : IF (at_end) THEN
136 8408 : IF (root_sect) &
137 : CALL cp_abort(__LOCATION__, &
138 : "unexpected end of file while parsing section "// &
139 0 : TRIM(section%name)//" "//TRIM(parser_location(parser)))
140 : EXIT
141 : END IF
142 988552 : IF (token(1:1) == parser%section_character) THEN
143 390909 : IF (token == "&END") THEN
144 : ! end of section
145 195496 : compatible_end = .TRUE.
146 195496 : IF (parser_test_next_token(parser) /= "EOL") THEN
147 : CALL parser_get_object(parser, token, newline=.FALSE., &
148 159027 : lower_to_upper=.TRUE.)
149 354523 : IF (token /= "SECTION" .AND. token /= section%name) THEN
150 0 : compatible_end = .FALSE.
151 : END IF
152 : END IF
153 195496 : IF (parser_test_next_token(parser) /= "EOL") THEN
154 : CALL parser_get_object(parser, token, newline=.FALSE., &
155 50 : lower_to_upper=.TRUE.)
156 195546 : IF (token /= section%name) THEN
157 0 : PRINT *, TRIM(token), "/=", TRIM(section%name)
158 : compatible_end = .FALSE.
159 : END IF
160 : END IF
161 195496 : IF (.NOT. compatible_end) THEN
162 : CALL cp_abort(__LOCATION__, &
163 : "non-compatible end of section "//TRIM(section%name)//" "// &
164 0 : TRIM(parser_location(parser)))
165 : END IF
166 : ! RETURN
167 : EXIT
168 : END IF
169 195413 : is = section_get_subsection_index(section, token(2:))
170 195413 : IF (is > 0) THEN
171 : CALL section_vals_parse(section_vals%subs_vals(is, irs)%section_vals, &
172 195413 : default_units=default_units, parser=parser)
173 : ELSE
174 : ! unknown subsection
175 0 : IF (output_unit > 0) THEN
176 0 : WRITE (output_unit, *)
177 0 : WRITE (output_unit, '(T2,A)') "Possible matches for unknown subsection "
178 0 : WRITE (output_unit, *)
179 0 : WRITE (output_unit, '(T2,A)') TRIM(token(2:))
180 0 : WRITE (output_unit, *)
181 : CALL section_typo_match(typo_match_section, TRIM(section%name), TRIM(token(2:)), "", &
182 0 : typo_matching_rank, typo_matching_line, bonus=0)
183 0 : DO imatch = 1, SIZE(typo_matching_rank)
184 0 : WRITE (output_unit, '(T2,A,1X,I0)') TRIM(typo_matching_line(imatch))//" score: ", typo_matching_rank(imatch)
185 : END DO
186 : END IF
187 : CALL cp_abort(__LOCATION__, &
188 : "unknown subsection "//TRIM(token(2:))//" of section " &
189 0 : //TRIM(section%name))
190 0 : nSub = 1
191 0 : DO WHILE (nSub > 0)
192 : CALL parser_get_object(parser, token, newline=.TRUE., &
193 0 : lower_to_upper=.TRUE.)
194 0 : IF (token(1:1) == parser%section_character) THEN
195 0 : IF (token == "&END") THEN
196 0 : nSub = nSub - 1
197 : ELSE
198 0 : nSub = nSub + 1
199 : END IF
200 : END IF
201 : END DO
202 : END IF
203 : ELSE ! token is a keyword
204 597643 : IF (token == "DESCRIBE") THEN
205 2 : IF (output_unit > 0) WRITE (output_unit, "(/,' ****** DESCRIPTION ******',/)")
206 2 : desc_level = 3
207 2 : IF (parser_test_next_token(parser) == "INT") THEN
208 2 : CALL parser_get_object(parser, desc_level)
209 : END IF
210 2 : whole_section = .TRUE.
211 2 : DO WHILE (parser_test_next_token(parser) == "STR")
212 0 : whole_section = .FALSE.
213 : CALL parser_get_object(parser, token, newline=.FALSE., &
214 0 : lower_to_upper=.TRUE.)
215 0 : keyword => section_get_keyword(section, token)
216 0 : IF (.NOT. ASSOCIATED(keyword)) THEN
217 : CALL cp_warn(__LOCATION__, &
218 : "unknown keyword to describe "//TRIM(token)// &
219 0 : " in section "//TRIM(section%name))
220 : ELSE
221 0 : CALL keyword_describe(keyword, output_unit, desc_level)
222 : END IF
223 : END DO
224 2 : IF (whole_section) THEN
225 2 : CALL section_describe(section, output_unit, desc_level, hide_root=.NOT. root_sect)
226 : END IF
227 2 : IF (output_unit > 0) WRITE (output_unit, "(/,' ****** =========== ******',/)")
228 :
229 : ELSE ! token is a "normal" keyword
230 597641 : ik = section_get_keyword_index(section, token)
231 597641 : IF (ik < 1) THEN ! don't accept pseudo keyword names
232 280174 : parser%icol = parser%icol1 - 1 ! re-read also the actual token
233 280174 : ik = 0
234 280174 : IF (.NOT. ASSOCIATED(section%keywords(0)%keyword)) THEN
235 0 : IF (output_unit > 0) THEN
236 0 : WRITE (output_unit, *)
237 0 : WRITE (output_unit, '(T2,A)') "Possible matches for unknown keyword "
238 0 : WRITE (output_unit, *)
239 0 : WRITE (output_unit, '(T2,A)') TRIM(token)
240 0 : WRITE (output_unit, *)
241 : CALL section_typo_match(typo_match_section, TRIM(section%name), TRIM(token), "", &
242 0 : typo_matching_rank, typo_matching_line, bonus=0)
243 0 : DO imatch = 1, SIZE(typo_matching_rank)
244 : WRITE (output_unit, '(T2,A,1X,I0)') &
245 0 : TRIM(typo_matching_line(imatch))//" score: ", typo_matching_rank(imatch)
246 : END DO
247 : END IF
248 : CALL cp_abort(__LOCATION__, &
249 : "found an unknown keyword "//TRIM(token)// &
250 0 : " in section "//TRIM(section%name))
251 : END IF
252 : END IF
253 597641 : keyword => section%keywords(ik)%keyword
254 597641 : IF (ASSOCIATED(keyword)) THEN
255 597641 : IF (keyword%removed) THEN
256 0 : IF (ALLOCATED(keyword%deprecation_notice)) THEN
257 : CALL cp_abort(__LOCATION__, &
258 : "The specified keyword '"//TRIM(token)//"' is not available anymore: "// &
259 0 : keyword%deprecation_notice)
260 : ELSE
261 : CALL cp_abort(__LOCATION__, &
262 : "The specified keyword '"//TRIM(token)// &
263 0 : "' is not available anymore, please consult the manual.")
264 : END IF
265 : END IF
266 :
267 597641 : IF (ALLOCATED(keyword%deprecation_notice)) &
268 : CALL cp_warn(__LOCATION__, &
269 : "The specified keyword '"//TRIM(token)// &
270 : "' is deprecated and may be removed in a future version: "// &
271 22 : keyword%deprecation_notice//".")
272 :
273 597641 : NULLIFY (el)
274 597641 : IF (ik /= 0 .AND. keyword%type_of_var == lchar_t) &
275 19337 : CALL parser_skip_space(parser)
276 : CALL val_create_parsing(el, type_of_var=keyword%type_of_var, &
277 : n_var=keyword%n_var, default_value=keyword%lone_keyword_value, &
278 : enum=keyword%enum, unit=keyword%unit, &
279 597641 : default_units=default_units, parser=parser)
280 597641 : IF (ASSOCIATED(el)) THEN
281 597641 : NULLIFY (new_val)
282 597641 : CALL cp_sll_val_create(new_val, el)
283 597641 : last_val => section_vals%values(ik, irs)%list
284 597641 : IF (.NOT. ASSOCIATED(last_val)) THEN
285 323192 : section_vals%values(ik, irs)%list => new_val
286 : ELSE
287 274449 : IF (.NOT. keyword%repeats) &
288 : CALL cp_abort(__LOCATION__, &
289 : "Keyword "//TRIM(token)// &
290 0 : " in section "//TRIM(section%name)//" should not repeat.")
291 274449 : IF (ASSOCIATED(last_val, previous_list)) THEN
292 265124 : last_val => previous_last
293 : ELSE
294 274449 : previous_list => last_val
295 : END IF
296 274449 : DO WHILE (ASSOCIATED(last_val%rest))
297 274449 : last_val => last_val%rest
298 : END DO
299 274449 : last_val%rest => new_val
300 274449 : previous_last => new_val
301 : END IF
302 : END IF
303 : END IF
304 : END IF
305 : END IF
306 : END DO
307 203904 : CALL timestop(handle)
308 203904 : END SUBROUTINE section_vals_parse
309 :
310 : ! **************************************************************************************************
311 : !> \brief creates a val_type object by parsing the values
312 : !> \param val the value that will be created
313 : !> \param type_of_var type of the value to be created
314 : !> \param n_var number of values to be parsed (-1: undefined)
315 : !> \param enum ...
316 : !> \param parser the parser from where the values should be read
317 : !> \param unit ...
318 : !> \param default_units ...
319 : !> \param default_value a default value if nothing is found (can be null)
320 : !> \author fawzi
321 : !> \note
322 : !> - no_t does not create a value
323 : ! **************************************************************************************************
324 639922 : SUBROUTINE val_create_parsing(val, type_of_var, n_var, enum, &
325 : parser, unit, default_units, default_value)
326 : TYPE(val_type), POINTER :: val
327 : INTEGER, INTENT(in) :: type_of_var, n_var
328 : TYPE(enumeration_type), POINTER :: enum
329 : TYPE(cp_parser_type), POINTER :: parser
330 : TYPE(cp_unit_type), POINTER :: unit
331 : TYPE(cp_unit_set_type), POINTER :: default_units
332 : TYPE(val_type), OPTIONAL, POINTER :: default_value
333 :
334 : CHARACTER(len=*), PARAMETER :: routineN = 'val_create_parsing'
335 :
336 : CHARACTER(len=default_string_length) :: c_val, info, location
337 : CHARACTER(len=default_string_length), &
338 639922 : DIMENSION(:), POINTER :: c_val_p
339 : INTEGER :: handle, i, i_val
340 639922 : INTEGER, DIMENSION(:), POINTER :: i_val_p
341 : LOGICAL :: check, eol, l_val, quoted
342 639922 : LOGICAL, DIMENSION(:), POINTER :: l_val_p
343 : REAL(kind=dp) :: r_val
344 639922 : REAL(kind=dp), DIMENSION(:), POINTER :: r_val_p
345 : TYPE(cp_sll_char_type), POINTER :: c_first, c_last, c_new
346 : TYPE(cp_sll_int_type), POINTER :: i_first, i_last, i_new
347 : TYPE(cp_sll_logical_type), POINTER :: l_first, l_last, l_new
348 : TYPE(cp_sll_real_type), POINTER :: r_first, r_last, r_new
349 :
350 639922 : CALL timeset(routineN, handle)
351 :
352 639922 : CPASSERT(.NOT. ASSOCIATED(val))
353 669407 : SELECT CASE (type_of_var)
354 : CASE (no_t)
355 : CASE (logical_t)
356 29485 : NULLIFY (l_val_p)
357 58970 : IF (parser_test_next_token(parser) == "EOL") THEN
358 13799 : IF (.NOT. ASSOCIATED(default_value)) THEN
359 0 : IF (n_var < 1) THEN
360 0 : ALLOCATE (l_val_p(0))
361 0 : CALL val_create(val, l_vals_ptr=l_val_p)
362 : ELSE
363 : CALL cp_abort(__LOCATION__, &
364 : "no value was given and there is no default value"// &
365 0 : TRIM(parser_location(parser)))
366 : END IF
367 : ELSE
368 13799 : CPASSERT(ASSOCIATED(default_value%l_val))
369 13799 : CALL val_create(val, l_vals=default_value%l_val)
370 : END IF
371 : ELSE
372 15686 : IF (n_var < 1) THEN
373 0 : NULLIFY (l_last, l_first)
374 0 : CALL parser_get_object(parser, l_val)
375 0 : CALL cp_create(l_first, l_val)
376 0 : l_last => l_first
377 0 : DO WHILE (parser_test_next_token(parser) /= "EOL")
378 0 : CALL parser_get_object(parser, l_val)
379 0 : CALL cp_create(l_new, l_val)
380 0 : l_last%rest => l_new
381 0 : l_last => l_new
382 : END DO
383 0 : l_val_p => cp_to_array(l_first)
384 0 : CALL cp_dealloc(l_first)
385 : ELSE
386 47058 : ALLOCATE (l_val_p(n_var))
387 31372 : DO i = 1, n_var
388 31372 : CALL parser_get_object(parser, l_val_p(i))
389 : END DO
390 : END IF
391 45171 : IF (ASSOCIATED(l_val_p)) THEN
392 15686 : CALL val_create(val, l_vals_ptr=l_val_p)
393 : END IF
394 : END IF
395 : CASE (integer_t)
396 46380 : NULLIFY (i_val_p)
397 92760 : IF (parser_test_next_token(parser) == "EOL") THEN
398 14 : IF (.NOT. ASSOCIATED(default_value)) THEN
399 0 : IF (n_var < 1) THEN
400 0 : ALLOCATE (i_val_p(0))
401 0 : CALL val_create(val, i_vals_ptr=i_val_p)
402 : ELSE
403 : CALL cp_abort(__LOCATION__, &
404 : "no value was given and there is no default value"// &
405 0 : TRIM(parser_location(parser)))
406 : END IF
407 : ELSE
408 14 : check = ASSOCIATED(default_value%i_val)
409 14 : CPASSERT(check)
410 14 : CALL val_create(val, i_vals=default_value%i_val)
411 : END IF
412 : ELSE
413 46366 : IF (n_var < 1) THEN
414 7501 : NULLIFY (i_last, i_first)
415 7501 : CALL parser_get_object(parser, i_val)
416 7501 : CALL cp_create(i_first, i_val)
417 7501 : i_last => i_first
418 29449 : DO WHILE (parser_test_next_token(parser) /= "EOL")
419 21948 : CALL parser_get_object(parser, i_val)
420 21948 : CALL cp_create(i_new, i_val)
421 21948 : i_last%rest => i_new
422 21948 : i_last => i_new
423 : END DO
424 7501 : i_val_p => cp_to_array(i_first)
425 7501 : CALL cp_dealloc(i_first)
426 : ELSE
427 116595 : ALLOCATE (i_val_p(n_var))
428 82306 : DO i = 1, n_var
429 82306 : CALL parser_get_object(parser, i_val_p(i))
430 : END DO
431 : END IF
432 92746 : IF (ASSOCIATED(i_val_p)) THEN
433 46366 : CALL val_create(val, i_vals_ptr=i_val_p)
434 : END IF
435 : END IF
436 : CASE (real_t)
437 150593 : NULLIFY (r_val_p)
438 301186 : IF (parser_test_next_token(parser) == "EOL") THEN
439 2 : IF (.NOT. ASSOCIATED(default_value)) THEN
440 2 : IF (n_var < 1) THEN
441 2 : ALLOCATE (r_val_p(0))
442 2 : CALL val_create(val, r_vals_ptr=r_val_p)
443 : ELSE
444 : CALL cp_abort(__LOCATION__, &
445 : "no value was given and there is no default value"// &
446 0 : TRIM(parser_location(parser)))
447 : END IF
448 : ELSE
449 0 : CPASSERT(ASSOCIATED(default_value%r_val))
450 0 : CALL val_create(val, r_vals=default_value%r_val)
451 : END IF
452 : ELSE
453 150591 : IF (n_var < 1) THEN
454 16771 : NULLIFY (r_last, r_first)
455 16771 : c_val = ""
456 16771 : CALL get_r_val(r_val, parser, unit, default_units, c_val)
457 16771 : CALL cp_create(r_first, r_val)
458 16771 : r_last => r_first
459 6335207 : DO WHILE (parser_test_next_token(parser) /= "EOL")
460 6318436 : CALL get_r_val(r_val, parser, unit, default_units, c_val)
461 6318436 : CALL cp_create(r_new, r_val)
462 6318436 : r_last%rest => r_new
463 6318436 : r_last => r_new
464 : END DO
465 16771 : NULLIFY (r_last)
466 16771 : r_val_p => cp_to_array(r_first)
467 16771 : CALL cp_dealloc(r_first)
468 : ELSE
469 401460 : ALLOCATE (r_val_p(n_var))
470 133820 : c_val = ""
471 350148 : DO i = 1, n_var
472 350148 : CALL get_r_val(r_val_p(i), parser, unit, default_units, c_val)
473 : END DO
474 : END IF
475 301184 : IF (ASSOCIATED(r_val_p)) THEN
476 150591 : CALL val_create(val, r_vals_ptr=r_val_p)
477 : END IF
478 : END IF
479 : CASE (char_t)
480 66253 : NULLIFY (c_val_p)
481 132506 : IF (parser_test_next_token(parser) == "EOL") THEN
482 206 : IF (n_var < 1) THEN
483 2 : ALLOCATE (c_val_p(1))
484 2 : c_val_p(1) = ' '
485 2 : CALL val_create(val, c_vals_ptr=c_val_p)
486 : ELSE
487 204 : IF (.NOT. ASSOCIATED(default_value)) THEN
488 : CALL cp_abort(__LOCATION__, &
489 : "no value was given and there is no default value"// &
490 0 : TRIM(parser_location(parser)))
491 : ELSE
492 204 : CPASSERT(ASSOCIATED(default_value%c_val))
493 204 : CALL val_create(val, c_vals=default_value%c_val)
494 : END IF
495 : END IF
496 : ELSE
497 66047 : IF (n_var < 1) THEN
498 24074 : CPASSERT(n_var == -1)
499 24074 : NULLIFY (c_last, c_first)
500 24074 : CALL parser_get_object(parser, c_val)
501 24074 : CALL cp_create(c_first, c_val)
502 24074 : c_last => c_first
503 30674 : DO WHILE (parser_test_next_token(parser) /= "EOL")
504 6600 : CALL parser_get_object(parser, c_val)
505 6600 : CALL cp_create(c_new, c_val)
506 6600 : c_last%rest => c_new
507 6600 : c_last => c_new
508 : END DO
509 24074 : c_val_p => cp_to_array(c_first)
510 24074 : CALL cp_dealloc(c_first)
511 : ELSE
512 125919 : ALLOCATE (c_val_p(n_var))
513 99748 : DO i = 1, n_var
514 99748 : CALL parser_get_object(parser, c_val_p(i))
515 : END DO
516 : END IF
517 132300 : IF (ASSOCIATED(c_val_p)) THEN
518 66047 : CALL val_create(val, c_vals_ptr=c_val_p)
519 : END IF
520 : END IF
521 : CASE (lchar_t)
522 257515 : IF (ASSOCIATED(default_value)) &
523 : CALL cp_abort(__LOCATION__, &
524 : "input variables of type lchar_t cannot have a lone keyword attribute,"// &
525 : " no value is interpreted as empty string"// &
526 0 : TRIM(parser_location(parser)))
527 257515 : IF (n_var /= 1) &
528 : CALL cp_abort(__LOCATION__, &
529 : "input variables of type lchar_t cannot be repeated,"// &
530 : " one always represent a whole line, till the end"// &
531 0 : TRIM(parser_location(parser)))
532 257515 : IF (parser_test_next_token(parser) == "EOL") THEN
533 74 : ALLOCATE (c_val_p(1))
534 74 : c_val_p(1) = ' '
535 : ELSE
536 257441 : NULLIFY (c_last, c_first)
537 257441 : CALL parser_get_object(parser, c_val, string_length=LEN(c_val))
538 257441 : IF (c_val(1:1) == parser%quote_character) THEN
539 8 : quoted = .TRUE.
540 8 : c_val(1:) = c_val(2:) ! Drop first quotation mark
541 8 : i = INDEX(c_val, parser%quote_character) ! Check for second quotation mark
542 8 : IF (i > 0) THEN
543 0 : c_val(i:) = "" ! Discard stuff after second quotation mark
544 : eol = .TRUE. ! Enforce end of line
545 : ELSE
546 : eol = .FALSE.
547 : END IF
548 : ELSE
549 : quoted = .FALSE.
550 : eol = .FALSE.
551 : END IF
552 257441 : CALL cp_create(c_first, c_val)
553 257441 : c_last => c_first
554 288131 : DO WHILE ((.NOT. eol) .AND. (parser_test_next_token(parser) /= "EOL"))
555 30690 : CALL parser_get_object(parser, c_val, string_length=LEN(c_val))
556 30690 : i = INDEX(c_val, parser%quote_character) ! Check for quotation mark
557 30690 : IF (i > 0) THEN
558 8 : IF (quoted) THEN
559 8 : c_val(i:) = "" ! Discard stuff after second quotation mark
560 : eol = .TRUE. ! Enforce end of line
561 : ELSE
562 : CALL cp_abort(__LOCATION__, &
563 : "Quotation mark found which is not the first non-blank character. "// &
564 : "Possibly the first quotation mark is missing?"// &
565 0 : TRIM(parser_location(parser)))
566 : END IF
567 : ELSE
568 : eol = .FALSE.
569 : END IF
570 30690 : CALL cp_create(c_new, c_val)
571 30690 : c_last%rest => c_new
572 30690 : c_last => c_new
573 : END DO
574 257441 : c_val_p => cp_to_array(c_first)
575 514956 : CALL cp_dealloc(c_first)
576 : END IF
577 257515 : CPASSERT(ASSOCIATED(c_val_p))
578 257515 : CALL val_create(val, lc_vals_ptr=c_val_p)
579 : CASE (enum_t)
580 89696 : CPASSERT(ASSOCIATED(enum))
581 89696 : NULLIFY (i_val_p)
582 179392 : IF (parser_test_next_token(parser) == "EOL") THEN
583 9786 : IF (.NOT. ASSOCIATED(default_value)) THEN
584 0 : IF (n_var < 1) THEN
585 0 : ALLOCATE (i_val_p(0))
586 0 : CALL val_create(val, i_vals_ptr=i_val_p)
587 : ELSE
588 : CALL cp_abort(__LOCATION__, &
589 : "no value was given and there is no default value"// &
590 0 : TRIM(parser_location(parser)))
591 : END IF
592 : ELSE
593 9786 : CPASSERT(ASSOCIATED(default_value%i_val))
594 : CALL val_create(val, i_vals=default_value%i_val, &
595 9786 : enum=default_value%enum)
596 : END IF
597 : ELSE
598 79910 : IF (n_var < 1) THEN
599 58 : NULLIFY (i_last, i_first)
600 58 : CALL parser_get_object(parser, c_val)
601 58 : CALL cp_create(i_first, enum_c2i(enum, c_val))
602 58 : i_last => i_first
603 64 : DO WHILE (parser_test_next_token(parser) /= "EOL")
604 6 : CALL parser_get_object(parser, c_val)
605 6 : CALL cp_create(i_new, enum_c2i(enum, c_val))
606 6 : i_last%rest => i_new
607 6 : i_last => i_new
608 : END DO
609 58 : i_val_p => cp_to_array(i_first)
610 58 : CALL cp_dealloc(i_first)
611 : ELSE
612 239556 : ALLOCATE (i_val_p(n_var))
613 159704 : DO i = 1, n_var
614 79852 : CALL parser_get_object(parser, c_val)
615 159704 : i_val_p(i) = enum_c2i(enum, c_val)
616 : END DO
617 : END IF
618 169606 : IF (ASSOCIATED(i_val_p)) THEN
619 79910 : CALL val_create(val, i_vals_ptr=i_val_p, enum=enum)
620 : END IF
621 : END IF
622 : CASE default
623 : CALL cp_abort(__LOCATION__, &
624 639922 : "type "//cp_to_string(type_of_var)//"unknown to the parser")
625 : END SELECT
626 639922 : IF (parser_test_next_token(parser) .NE. "EOL") THEN
627 0 : location = TRIM(parser_location(parser))
628 0 : CALL parser_get_object(parser, info)
629 : CALL cp_abort(__LOCATION__, &
630 639922 : "found unexpected extra argument "//TRIM(info)//" at "//location)
631 : END IF
632 :
633 639922 : CALL timestop(handle)
634 :
635 639922 : END SUBROUTINE val_create_parsing
636 :
637 : ! **************************************************************************************************
638 : !> \brief Reads and convert a real number from the input file
639 : !> \param r_val ...
640 : !> \param parser the parser from where the values should be read
641 : !> \param unit ...
642 : !> \param default_units ...
643 : !> \param c_val ...
644 : !> \author Teodoro Laino - 11.2007 [tlaino] - University of Zurich
645 : ! **************************************************************************************************
646 6551535 : SUBROUTINE get_r_val(r_val, parser, unit, default_units, c_val)
647 : REAL(kind=dp), INTENT(OUT) :: r_val
648 : TYPE(cp_parser_type), POINTER :: parser
649 : TYPE(cp_unit_type), POINTER :: unit
650 : TYPE(cp_unit_set_type), POINTER :: default_units
651 : CHARACTER(len=default_string_length), &
652 : INTENT(INOUT) :: c_val
653 :
654 : TYPE(cp_unit_type), POINTER :: my_unit
655 :
656 6551535 : NULLIFY (my_unit)
657 6551535 : IF (ASSOCIATED(unit)) THEN
658 97443 : IF ('STR' == parser_test_next_token(parser)) THEN
659 11390 : CALL parser_get_object(parser, c_val)
660 11390 : IF (c_val(1:1) /= "[" .OR. c_val(LEN_TRIM(c_val):LEN_TRIM(c_val)) /= "]") THEN
661 : CALL cp_abort(__LOCATION__, &
662 : "Invalid unit specifier found when parsing a number: "// &
663 0 : c_val)
664 : END IF
665 11390 : CALL cp_unit_create(my_unit, c_val(2:LEN_TRIM(c_val) - 1))
666 : ELSE
667 183496 : IF (c_val /= "") THEN
668 2704 : CALL cp_unit_create(my_unit, c_val(2:LEN_TRIM(c_val) - 1))
669 : ELSE
670 83349 : my_unit => unit
671 : END IF
672 : END IF
673 97443 : IF (.NOT. cp_unit_compatible(unit, my_unit)) &
674 : CALL cp_abort(__LOCATION__, &
675 : "Incompatible units. Defined as ("// &
676 : TRIM(cp_unit_desc(unit))//") specified in input as ("// &
677 0 : TRIM(cp_unit_desc(my_unit))//"). These units are incompatible!")
678 : END IF
679 6551535 : CALL parser_get_object(parser, r_val)
680 6551535 : IF (ASSOCIATED(unit)) THEN
681 97443 : r_val = cp_unit_to_cp2k1(r_val, my_unit, default_units)
682 97443 : IF (.NOT. (ASSOCIATED(my_unit, unit))) CALL cp_unit_release(my_unit)
683 : END IF
684 :
685 6551535 : END SUBROUTINE get_r_val
686 :
687 : END MODULE input_parsing
|
