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