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