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 Utility routines to read data from files.
10 : !> Kept as close as possible to the old parser because
11 : !> 1. string handling is a weak point of fortran compilers, and it is
12 : !> easy to write correct things that do not work
13 : !> 2. conversion of old code
14 : !> \par History
15 : !> 22.11.1999 first version of the old parser (called qs_parser)
16 : !> Matthias Krack
17 : !> 06.2004 removed module variables, cp_parser_type, new module [fawzi]
18 : !> \author Fawzi Mohamed, Matthias Krack
19 : ! **************************************************************************************************
20 : MODULE cp_parser_methods
21 :
22 : USE cp_log_handling, ONLY: cp_to_string
23 : USE cp_para_types, ONLY: cp_para_env_type
24 : USE cp_parser_buffer_types, ONLY: copy_buffer_type,&
25 : finalize_sub_buffer,&
26 : initialize_sub_buffer
27 : USE cp_parser_ilist_methods, ONLY: ilist_reset,&
28 : ilist_setup,&
29 : ilist_update
30 : USE cp_parser_inpp_methods, ONLY: inpp_end_include,&
31 : inpp_expand_variables,&
32 : inpp_process_directive
33 : USE cp_parser_types, ONLY: cp_parser_type,&
34 : parser_reset
35 : USE kinds, ONLY: default_path_length,&
36 : default_string_length,&
37 : dp,&
38 : int_8,&
39 : max_line_length
40 : USE message_passing, ONLY: mp_bcast
41 : USE string_utilities, ONLY: is_whitespace,&
42 : uppercase
43 : #include "../base/base_uses.f90"
44 :
45 : IMPLICIT NONE
46 : PRIVATE
47 :
48 : PUBLIC :: parser_test_next_token, parser_get_object, parser_location, &
49 : parser_search_string, parser_get_next_line, parser_skip_space, &
50 : parser_read_line, read_float_object, read_integer_object
51 :
52 : CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'cp_parser_methods'
53 :
54 : INTERFACE parser_get_object
55 : MODULE PROCEDURE parser_get_integer, &
56 : parser_get_logical, &
57 : parser_get_real, &
58 : parser_get_string
59 : END INTERFACE
60 :
61 : CONTAINS
62 :
63 : ! **************************************************************************************************
64 : !> \brief return a description of the part of the file actually parsed
65 : !> \param parser the parser
66 : !> \return ...
67 : !> \author fawzi
68 : ! **************************************************************************************************
69 0 : FUNCTION parser_location(parser) RESULT(res)
70 :
71 : TYPE(cp_parser_type), POINTER :: parser
72 : CHARACTER&
73 : (len=default_path_length+default_string_length) :: res
74 :
75 0 : CPASSERT(ASSOCIATED(parser))
76 0 : CPASSERT(parser%ref_count > 0)
77 : res = ", File: '"//TRIM(parser%input_file_name)//"', Line: "// &
78 : TRIM(ADJUSTL(cp_to_string(parser%input_line_number)))// &
79 0 : ", Column: "//TRIM(ADJUSTL(cp_to_string(parser%icol)))
80 0 : IF (parser%icol == -1) THEN
81 0 : res(LEN_TRIM(res):) = " (EOF)"
82 0 : ELSE IF (MAX(1, parser%icol1) <= parser%icol2) THEN
83 : res(LEN_TRIM(res):) = ", Chunk: <"// &
84 0 : parser%input_line(MAX(1, parser%icol1):parser%icol2)//">"
85 : END IF
86 :
87 0 : END FUNCTION parser_location
88 :
89 : ! **************************************************************************************************
90 : !> \brief store the present status of the parser
91 : !> \param parser ...
92 : !> \date 08.2008
93 : !> \author Teodoro Laino [tlaino] - University of Zurich
94 : ! **************************************************************************************************
95 10267596 : SUBROUTINE parser_store_status(parser)
96 :
97 : TYPE(cp_parser_type), POINTER :: parser
98 :
99 10267596 : CPASSERT(ASSOCIATED(parser))
100 10267596 : CPASSERT(parser%ref_count > 0)
101 10267596 : CPASSERT(ASSOCIATED(parser%status))
102 10267596 : parser%status%in_use = .TRUE.
103 10267596 : parser%status%old_input_line = parser%input_line
104 10267596 : parser%status%old_input_line_number = parser%input_line_number
105 10267596 : parser%status%old_icol = parser%icol
106 10267596 : parser%status%old_icol1 = parser%icol1
107 10267596 : parser%status%old_icol2 = parser%icol2
108 : ! Store buffer info
109 10267596 : CALL copy_buffer_type(parser%buffer, parser%status%buffer)
110 :
111 10267596 : END SUBROUTINE parser_store_status
112 :
113 : ! **************************************************************************************************
114 : !> \brief retrieve the original status of the parser
115 : !> \param parser ...
116 : !> \date 08.2008
117 : !> \author Teodoro Laino [tlaino] - University of Zurich
118 : ! **************************************************************************************************
119 10267596 : SUBROUTINE parser_retrieve_status(parser)
120 :
121 : TYPE(cp_parser_type), POINTER :: parser
122 :
123 10267596 : CPASSERT(ASSOCIATED(parser))
124 10267596 : CPASSERT(parser%ref_count > 0)
125 :
126 : ! Always store the new buffer (if it is really newly read)
127 10267596 : IF (parser%buffer%buffer_id /= parser%status%buffer%buffer_id) THEN
128 1238 : CALL initialize_sub_buffer(parser%buffer%sub_buffer, parser%buffer)
129 : END IF
130 10267596 : parser%status%in_use = .FALSE.
131 10267596 : parser%input_line = parser%status%old_input_line
132 10267596 : parser%input_line_number = parser%status%old_input_line_number
133 10267596 : parser%icol = parser%status%old_icol
134 10267596 : parser%icol1 = parser%status%old_icol1
135 10267596 : parser%icol2 = parser%status%old_icol2
136 :
137 : ! Retrieve buffer info
138 10267596 : CALL copy_buffer_type(parser%status%buffer, parser%buffer)
139 :
140 10267596 : END SUBROUTINE parser_retrieve_status
141 :
142 : ! **************************************************************************************************
143 : !> \brief Read the next line from a logical unit "unit" (I/O node only).
144 : !> Skip (nline-1) lines and skip also all comment lines.
145 : !> \param parser ...
146 : !> \param nline ...
147 : !> \param at_end ...
148 : !> \date 22.11.1999
149 : !> \author Matthias Krack (MK)
150 : !> \version 1.0
151 : !> \note 08.2008 [tlaino] - Teodoro Laino UZH : updated for buffer
152 : ! **************************************************************************************************
153 31433975 : SUBROUTINE parser_read_line(parser, nline, at_end)
154 :
155 : TYPE(cp_parser_type), POINTER :: parser
156 : INTEGER, INTENT(IN) :: nline
157 : LOGICAL, INTENT(out), OPTIONAL :: at_end
158 :
159 : CHARACTER(LEN=*), PARAMETER :: routineN = 'parser_read_line'
160 :
161 : INTEGER :: handle, iline, istat
162 :
163 31433975 : CALL timeset(routineN, handle)
164 :
165 31433975 : CPASSERT(ASSOCIATED(parser))
166 31433975 : CPASSERT(parser%ref_count > 0)
167 31433975 : IF (PRESENT(at_end)) at_end = .FALSE.
168 :
169 62854601 : DO iline = 1, nline
170 : ! Try to read the next line from the buffer
171 31439064 : CALL parser_get_line_from_buffer(parser, istat)
172 :
173 : ! Handle (persisting) read errors
174 62854601 : IF (istat /= 0) THEN
175 18438 : IF (istat < 0) THEN ! EOF/EOR is negative other errors positive
176 18438 : IF (PRESENT(at_end)) THEN
177 18438 : at_end = .TRUE.
178 : ELSE
179 0 : CPABORT("Unexpected EOF"//TRIM(parser_location(parser)))
180 : END IF
181 18438 : parser%icol = -1
182 18438 : parser%icol1 = 0
183 18438 : parser%icol2 = -1
184 : ELSE
185 : CALL cp_abort(__LOCATION__, &
186 : "An I/O error occurred (IOSTAT = "// &
187 : TRIM(ADJUSTL(cp_to_string(istat)))//")"// &
188 0 : TRIM(parser_location(parser)))
189 : END IF
190 18438 : CALL timestop(handle)
191 18438 : RETURN
192 : END IF
193 : END DO
194 :
195 : ! Reset column pointer, if a new line was read
196 31415537 : IF (nline > 0) parser%icol = 0
197 :
198 31415537 : CALL timestop(handle)
199 : END SUBROUTINE parser_read_line
200 :
201 : ! **************************************************************************************************
202 : !> \brief Retrieving lines from buffer
203 : !> \param parser ...
204 : !> \param istat ...
205 : !> \date 08.2008
206 : !> \author Teodoro Laino [tlaino] - University of Zurich
207 : ! **************************************************************************************************
208 31439064 : SUBROUTINE parser_get_line_from_buffer(parser, istat)
209 :
210 : TYPE(cp_parser_type), POINTER :: parser
211 : INTEGER, INTENT(OUT) :: istat
212 :
213 31439064 : istat = 0
214 : ! Check buffer
215 31439064 : IF (parser%buffer%present_line_number == parser%buffer%size) THEN
216 70407 : IF (ASSOCIATED(parser%buffer%sub_buffer)) THEN
217 : ! If the sub_buffer is initialized let's restore its buffer
218 1238 : CALL finalize_sub_buffer(parser%buffer%sub_buffer, parser%buffer)
219 : ELSE
220 : ! Rebuffer input file if required
221 69169 : CALL parser_read_line_low(parser)
222 : END IF
223 : END IF
224 31439064 : parser%buffer%present_line_number = parser%buffer%present_line_number + 1
225 31439064 : parser%input_line_number = parser%buffer%input_line_numbers(parser%buffer%present_line_number)
226 31439064 : parser%input_line = parser%buffer%input_lines(parser%buffer%present_line_number)
227 31439064 : IF ((parser%buffer%istat /= 0) .AND. &
228 : (parser%buffer%last_line_number == parser%buffer%present_line_number)) THEN
229 18438 : istat = parser%buffer%istat
230 : END IF
231 :
232 31439064 : END SUBROUTINE parser_get_line_from_buffer
233 :
234 : ! **************************************************************************************************
235 : !> \brief Low level reading subroutine with buffering
236 : !> \param parser ...
237 : !> \date 08.2008
238 : !> \author Teodoro Laino [tlaino] - University of Zurich
239 : ! **************************************************************************************************
240 69169 : SUBROUTINE parser_read_line_low(parser)
241 :
242 : TYPE(cp_parser_type), POINTER :: parser
243 :
244 : CHARACTER(LEN=*), PARAMETER :: routineN = 'parser_read_line_low'
245 :
246 : INTEGER :: handle, iline, imark, islen, istat, &
247 : last_buffered_line_number
248 : LOGICAL :: non_white_found, &
249 : this_line_is_white_or_comment
250 :
251 69169 : CALL timeset(routineN, handle)
252 :
253 69169 : CPASSERT(ASSOCIATED(parser))
254 69169 : CPASSERT(parser%ref_count > 0)
255 69238169 : parser%buffer%input_lines = ""
256 69169 : IF (parser%para_env%ionode) THEN
257 36503 : iline = 0
258 36503 : istat = 0
259 36503 : parser%buffer%buffer_id = parser%buffer%buffer_id + 1
260 36503 : parser%buffer%present_line_number = 0
261 36503 : parser%buffer%last_line_number = parser%buffer%size
262 36503 : last_buffered_line_number = parser%buffer%input_line_numbers(parser%buffer%size)
263 23418800 : DO WHILE (iline /= parser%buffer%size)
264 : ! Increment counters by 1
265 23400489 : iline = iline + 1
266 23400489 : last_buffered_line_number = last_buffered_line_number + 1
267 :
268 : ! Try to read the next line from file
269 23400489 : parser%buffer%input_line_numbers(iline) = last_buffered_line_number
270 23400489 : READ (UNIT=parser%input_unit, FMT="(A)", IOSTAT=istat) parser%buffer%input_lines(iline)
271 :
272 : ! Pre-processing steps:
273 : ! 1. Expand variables 2. Process directives and read next line.
274 : ! On read failure try to go back from included file to previous i/o-stream.
275 23400489 : IF (istat == 0) THEN
276 23381766 : islen = LEN_TRIM(parser%buffer%input_lines(iline))
277 23381766 : this_line_is_white_or_comment = is_comment_line(parser, parser%buffer%input_lines(iline))
278 23381766 : IF (.NOT. this_line_is_white_or_comment .AND. parser%apply_preprocessing) THEN
279 20403306 : imark = INDEX(parser%buffer%input_lines(iline) (1:islen), "$")
280 20403306 : IF (imark /= 0) THEN
281 : CALL inpp_expand_variables(parser%inpp, parser%buffer%input_lines(iline), &
282 5642 : parser%input_file_name, parser%buffer%input_line_numbers(iline))
283 5642 : islen = LEN_TRIM(parser%buffer%input_lines(iline))
284 : END IF
285 20403306 : imark = INDEX(parser%buffer%input_lines(iline) (1:islen), "@")
286 20403306 : IF (imark /= 0) THEN
287 : CALL inpp_process_directive(parser%inpp, parser%buffer%input_lines(iline), &
288 : parser%input_file_name, parser%buffer%input_line_numbers(iline), &
289 9803 : parser%input_unit)
290 9803 : islen = LEN_TRIM(parser%buffer%input_lines(iline))
291 : ! Handle index and cycle
292 9803 : last_buffered_line_number = 0
293 9803 : iline = iline - 1
294 9803 : CYCLE
295 : END IF
296 :
297 : ! after preprocessor parsing could the line be empty again
298 20393503 : this_line_is_white_or_comment = is_comment_line(parser, parser%buffer%input_lines(iline))
299 : END IF
300 18723 : ELSE IF (istat < 0) THEN ! handle EOF
301 18723 : IF (parser%inpp%io_stack_level > 0) THEN
302 : ! We were reading from an included file. Go back one level.
303 : CALL inpp_end_include(parser%inpp, parser%input_file_name, &
304 531 : parser%buffer%input_line_numbers(iline), parser%input_unit)
305 : ! Handle index and cycle
306 531 : last_buffered_line_number = parser%buffer%input_line_numbers(iline)
307 531 : iline = iline - 1
308 531 : CYCLE
309 : END IF
310 : END IF
311 :
312 : ! Saving persisting read errors
313 23390155 : IF (istat /= 0) THEN
314 18192 : parser%buffer%istat = istat
315 18192 : parser%buffer%last_line_number = iline
316 16115650 : parser%buffer%input_line_numbers(iline:) = 0
317 16115650 : parser%buffer%input_lines(iline:) = ""
318 : EXIT
319 : END IF
320 :
321 : ! Pre-processing and error checking done. Ready for parsing.
322 23371963 : IF (.NOT. parser%parse_white_lines) THEN
323 23160161 : non_white_found = .NOT. this_line_is_white_or_comment
324 : ELSE
325 : non_white_found = .TRUE.
326 : END IF
327 23178472 : IF (.NOT. non_white_found) THEN
328 2966421 : iline = iline - 1
329 2966421 : last_buffered_line_number = last_buffered_line_number - 1
330 : END IF
331 : END DO
332 : END IF
333 : ! Broadcast buffer informations
334 69169 : CALL broadcast_input_information(parser)
335 :
336 69169 : CALL timestop(handle)
337 :
338 69169 : END SUBROUTINE parser_read_line_low
339 :
340 : ! **************************************************************************************************
341 : !> \brief Broadcast the input information.
342 : !> \param parser ...
343 : !> \date 02.03.2001
344 : !> \author Matthias Krack (MK)
345 : !> \note 08.2008 [tlaino] - Teodoro Laino UZH : updated for buffer
346 : ! **************************************************************************************************
347 69169 : SUBROUTINE broadcast_input_information(parser)
348 :
349 : TYPE(cp_parser_type), POINTER :: parser
350 :
351 : CHARACTER(len=*), PARAMETER :: routineN = 'broadcast_input_information'
352 :
353 : INTEGER :: handle
354 : TYPE(cp_para_env_type), POINTER :: para_env
355 :
356 69169 : CALL timeset(routineN, handle)
357 :
358 69169 : CPASSERT(ASSOCIATED(parser))
359 69169 : CPASSERT(parser%ref_count > 0)
360 69169 : para_env => parser%para_env
361 69169 : IF (para_env%num_pe > 1) THEN
362 65332 : CALL mp_bcast(parser%buffer%buffer_id, para_env%source, para_env%group)
363 65332 : CALL mp_bcast(parser%buffer%present_line_number, para_env%source, para_env%group)
364 65332 : CALL mp_bcast(parser%buffer%last_line_number, para_env%source, para_env%group)
365 65332 : CALL mp_bcast(parser%buffer%istat, para_env%source, para_env%group)
366 65332 : CALL mp_bcast(parser%buffer%input_line_numbers, para_env%source, para_env%group)
367 65332 : CALL mp_bcast(parser%buffer%input_lines, para_env%source, para_env%group)
368 : END IF
369 :
370 69169 : CALL timestop(handle)
371 :
372 69169 : END SUBROUTINE broadcast_input_information
373 :
374 : ! **************************************************************************************************
375 : !> \brief returns .true. if the line is a comment line or an empty line
376 : !> \param parser ...
377 : !> \param line ...
378 : !> \return ...
379 : !> \par History
380 : !> 03.2009 [tlaino] - Teodoro Laino
381 : ! **************************************************************************************************
382 43775269 : FUNCTION is_comment_line(parser, line) RESULT(resval)
383 :
384 : TYPE(cp_parser_type), POINTER :: parser
385 : CHARACTER(LEN=*), INTENT(IN) :: line
386 : LOGICAL :: resval
387 :
388 : CHARACTER(LEN=1) :: thischar
389 : INTEGER :: icol
390 :
391 43775269 : resval = .TRUE.
392 605640037 : DO icol = 1, LEN(line)
393 605533277 : thischar = line(icol:icol)
394 605640037 : IF (.NOT. is_whitespace(thischar)) THEN
395 43668509 : IF (.NOT. is_comment(parser, thischar)) resval = .FALSE.
396 : EXIT
397 : END IF
398 : END DO
399 :
400 43775269 : END FUNCTION is_comment_line
401 :
402 : ! **************************************************************************************************
403 : !> \brief returns .true. if the character passed is a comment character
404 : !> \param parser ...
405 : !> \param testchar ...
406 : !> \return ...
407 : !> \par History
408 : !> 02.2008 created, AK
409 : !> \author AK
410 : ! **************************************************************************************************
411 364590393 : FUNCTION is_comment(parser, testchar) RESULT(resval)
412 :
413 : TYPE(cp_parser_type), POINTER :: parser
414 : CHARACTER(LEN=1), INTENT(IN) :: testchar
415 : LOGICAL :: resval
416 :
417 364590393 : resval = .FALSE.
418 : ! We are in a private function, and parser has been tested before...
419 1088551251 : IF (ANY(parser%comment_character == testchar)) resval = .TRUE.
420 :
421 364590393 : END FUNCTION is_comment
422 :
423 : ! **************************************************************************************************
424 : !> \brief Read the next input line and broadcast the input information.
425 : !> Skip (nline-1) lines and skip also all comment lines.
426 : !> \param parser ...
427 : !> \param nline ...
428 : !> \param at_end ...
429 : !> \date 22.11.1999
430 : !> \author Matthias Krack (MK)
431 : !> \version 1.0
432 : ! **************************************************************************************************
433 41133105 : SUBROUTINE parser_get_next_line(parser, nline, at_end)
434 :
435 : TYPE(cp_parser_type), POINTER :: parser
436 : INTEGER, INTENT(IN) :: nline
437 : LOGICAL, INTENT(out), OPTIONAL :: at_end
438 :
439 : LOGICAL :: my_at_end
440 :
441 41133105 : IF (nline > 0) THEN
442 31014123 : CALL parser_read_line(parser, nline, at_end=my_at_end)
443 31014123 : IF (PRESENT(at_end)) THEN
444 30142900 : at_end = my_at_end
445 : ELSE
446 871223 : IF (my_at_end) THEN
447 0 : CPABORT("Unexpected EOF"//TRIM(parser_location(parser)))
448 : END IF
449 : END IF
450 10118982 : ELSE IF (PRESENT(at_end)) THEN
451 10118722 : at_end = .FALSE.
452 : END IF
453 :
454 41133105 : END SUBROUTINE parser_get_next_line
455 :
456 : ! **************************************************************************************************
457 : !> \brief Skips the whitespaces
458 : !> \param parser ...
459 : !> \date 02.03.2001
460 : !> \author Matthias Krack (MK)
461 : !> \version 1.0
462 : ! **************************************************************************************************
463 19337 : SUBROUTINE parser_skip_space(parser)
464 : TYPE(cp_parser_type), POINTER :: parser
465 :
466 : INTEGER :: i
467 : LOGICAL :: at_end
468 :
469 19337 : CPASSERT(ASSOCIATED(parser))
470 19337 : CPASSERT(parser%ref_count > 0)
471 : ! Variable input string length (automatic search)
472 :
473 : ! Check for EOF
474 19337 : IF (parser%icol == -1) THEN
475 0 : parser%icol1 = 1
476 0 : parser%icol2 = -1
477 0 : RETURN
478 : END IF
479 :
480 : ! Search for the beginning of the next input string
481 : outer_loop: DO
482 :
483 : ! Increment the column counter
484 24141 : parser%icol = parser%icol + 1
485 :
486 : ! Quick return, if the end of line is found
487 24141 : IF ((parser%icol > LEN_TRIM(parser%input_line)) .OR. &
488 : is_comment(parser, parser%input_line(parser%icol:parser%icol))) THEN
489 74 : parser%icol1 = 1
490 74 : parser%icol2 = -1
491 74 : RETURN
492 : END IF
493 :
494 : ! Ignore all white space
495 24067 : IF (.NOT. is_whitespace(parser%input_line(parser%icol:parser%icol))) THEN
496 : ! Check for input line continuation
497 19263 : IF (parser%input_line(parser%icol:parser%icol) == parser%continuation_character) THEN
498 0 : inner_loop: DO i = parser%icol + 1, LEN_TRIM(parser%input_line)
499 0 : IF (is_whitespace(parser%input_line(i:i))) CYCLE inner_loop
500 0 : IF (is_comment(parser, parser%input_line(i:i))) THEN
501 : EXIT inner_loop
502 : ELSE
503 0 : parser%icol1 = i
504 0 : parser%icol2 = LEN_TRIM(parser%input_line)
505 : CALL cp_abort(__LOCATION__, &
506 : "Found a non-blank token which is not a comment after the line continuation character '"// &
507 0 : parser%continuation_character//"'"//TRIM(parser_location(parser)))
508 : END IF
509 : END DO inner_loop
510 0 : CALL parser_get_next_line(parser, 1, at_end=at_end)
511 0 : IF (at_end) THEN
512 : CALL cp_abort(__LOCATION__, &
513 : "Unexpected end of file (EOF) found after line continuation"// &
514 0 : TRIM(parser_location(parser)))
515 : END IF
516 0 : parser%icol = 0
517 0 : CYCLE outer_loop
518 : ELSE
519 19263 : parser%icol = parser%icol - 1
520 19263 : parser%icol1 = parser%icol
521 19263 : parser%icol2 = parser%icol
522 19263 : RETURN
523 : END IF
524 : END IF
525 :
526 : END DO outer_loop
527 :
528 : END SUBROUTINE parser_skip_space
529 :
530 : ! **************************************************************************************************
531 : !> \brief Get the next input string from the input line.
532 : !> \param parser ...
533 : !> \param string_length ...
534 : !> \date 19.02.2001
535 : !> \author Matthias Krack (MK)
536 : !> \version 1.0
537 : !> \notes -) this function MUST be private in this module!
538 : ! **************************************************************************************************
539 21527447 : SUBROUTINE parser_next_token(parser, string_length)
540 :
541 : TYPE(cp_parser_type), POINTER :: parser
542 : INTEGER, INTENT(IN), OPTIONAL :: string_length
543 :
544 : CHARACTER(LEN=1) :: token
545 : INTEGER :: i, len_trim_inputline, length
546 : LOGICAL :: at_end
547 :
548 21527447 : CPASSERT(ASSOCIATED(parser))
549 21527447 : CPASSERT(parser%ref_count > 0)
550 21527447 : IF (PRESENT(string_length)) THEN
551 291935 : IF (string_length > max_line_length) THEN
552 0 : CPABORT("string length > max_line_length")
553 : ELSE
554 : length = string_length
555 : END IF
556 : ELSE
557 : length = 0
558 : END IF
559 :
560 : ! Precompute trimmed line length
561 21527447 : len_trim_inputline = LEN_TRIM(parser%input_line)
562 :
563 21527447 : IF (length > 0) THEN
564 :
565 : ! Read input string of fixed length (single line)
566 :
567 : ! Check for EOF
568 291935 : IF (parser%icol == -1) &
569 0 : CPABORT("Unexpectetly reached EOF"//TRIM(parser_location(parser)))
570 :
571 291935 : length = MIN(len_trim_inputline - parser%icol1 + 1, length)
572 291935 : parser%icol1 = parser%icol + 1
573 291935 : parser%icol2 = parser%icol + length
574 291935 : i = INDEX(parser%input_line(parser%icol1:parser%icol2), parser%quote_character)
575 291935 : IF (i > 0) parser%icol2 = parser%icol + i
576 291935 : parser%icol = parser%icol2
577 :
578 : ELSE
579 :
580 : ! Variable input string length (automatic multi-line search)
581 :
582 : ! Check for EOF
583 21235512 : IF (parser%icol == -1) THEN
584 0 : parser%icol1 = 1
585 0 : parser%icol2 = -1
586 1446087 : RETURN
587 : END IF
588 :
589 : ! Search for the beginning of the next input string
590 : outer_loop1: DO
591 :
592 : ! Increment the column counter
593 105043599 : parser%icol = parser%icol + 1
594 :
595 : ! Quick return, if the end of line is found
596 105043599 : IF (parser%icol > len_trim_inputline) THEN
597 1411255 : parser%icol1 = 1
598 1411255 : parser%icol2 = -1
599 1411255 : RETURN
600 : END IF
601 :
602 103632344 : token = parser%input_line(parser%icol:parser%icol)
603 :
604 103632344 : IF (is_whitespace(token)) THEN
605 : ! Ignore white space
606 : CYCLE outer_loop1
607 22344023 : ELSE IF (is_comment(parser, token)) THEN
608 32304 : parser%icol1 = 1
609 32304 : parser%icol2 = -1
610 32304 : parser%first_separator = .TRUE.
611 32304 : RETURN
612 22311719 : ELSE IF (token == parser%quote_character) THEN
613 : ! Read quoted string
614 2528 : parser%icol1 = parser%icol + 1
615 2528 : parser%icol2 = parser%icol + INDEX(parser%input_line(parser%icol1:), parser%quote_character)
616 2528 : IF (parser%icol2 == parser%icol) THEN
617 0 : parser%icol1 = parser%icol
618 0 : parser%icol2 = parser%icol
619 : CALL cp_abort(__LOCATION__, &
620 0 : "Unmatched quotation mark found"//TRIM(parser_location(parser)))
621 : ELSE
622 2528 : parser%icol = parser%icol2
623 2528 : parser%icol2 = parser%icol2 - 1
624 2528 : parser%first_separator = .TRUE.
625 2528 : RETURN
626 : END IF
627 22309191 : ELSE IF (token == parser%continuation_character) THEN
628 : ! Check for input line continuation
629 2519384 : inner_loop1: DO i = parser%icol + 1, len_trim_inputline
630 2519384 : IF (is_whitespace(parser%input_line(i:i))) THEN
631 : CYCLE inner_loop1
632 0 : ELSE IF (is_comment(parser, parser%input_line(i:i))) THEN
633 : EXIT inner_loop1
634 : ELSE
635 0 : parser%icol1 = i
636 0 : parser%icol2 = len_trim_inputline
637 : CALL cp_abort(__LOCATION__, &
638 : "Found a non-blank token which is not a comment after the line continuation character '"// &
639 0 : parser%continuation_character//"'"//TRIM(parser_location(parser)))
640 : END IF
641 : END DO inner_loop1
642 2519384 : CALL parser_get_next_line(parser, 1, at_end=at_end)
643 2519384 : IF (at_end) THEN
644 : CALL cp_abort(__LOCATION__, &
645 0 : "Unexpected end of file (EOF) found after line continuation"//TRIM(parser_location(parser)))
646 : END IF
647 2519384 : len_trim_inputline = LEN_TRIM(parser%input_line)
648 2519384 : CYCLE outer_loop1
649 19789807 : ELSE IF (INDEX(parser%separators, token) > 0) THEN
650 382 : IF (parser%first_separator) THEN
651 382 : parser%first_separator = .FALSE.
652 382 : CYCLE outer_loop1
653 : ELSE
654 0 : parser%icol1 = parser%icol
655 0 : parser%icol2 = parser%icol
656 : CALL cp_abort(__LOCATION__, &
657 : "Unexpected separator token '"//token// &
658 0 : "' found"//TRIM(parser_location(parser)))
659 : END IF
660 : ELSE
661 19789425 : parser%icol1 = parser%icol
662 19789425 : parser%first_separator = .TRUE.
663 19789425 : EXIT outer_loop1
664 : END IF
665 :
666 : END DO outer_loop1
667 :
668 : ! Search for the end of the next input string
669 : outer_loop2: DO
670 318341199 : parser%icol = parser%icol + 1
671 318341199 : IF (parser%icol > len_trim_inputline) EXIT outer_loop2
672 316467555 : token = parser%input_line(parser%icol:parser%icol)
673 316467555 : IF (is_whitespace(token) .OR. is_comment(parser, token) .OR. &
674 19787467 : (token == parser%continuation_character)) THEN
675 : EXIT outer_loop2
676 298553732 : ELSE IF (INDEX(parser%separators, token) > 0) THEN
677 1958 : parser%first_separator = .FALSE.
678 1958 : EXIT outer_loop2
679 : END IF
680 : END DO outer_loop2
681 :
682 19789425 : parser%icol2 = parser%icol - 1
683 :
684 19789425 : IF (parser%input_line(parser%icol:parser%icol) == &
685 14 : parser%continuation_character) parser%icol = parser%icol2
686 :
687 : END IF
688 :
689 : END SUBROUTINE parser_next_token
690 :
691 : ! **************************************************************************************************
692 : !> \brief Test next input object.
693 : !> - test_result : "EOL": End of line
694 : !> - test_result : "EOS": End of section
695 : !> - test_result : "FLT": Floating point number
696 : !> - test_result : "INT": Integer number
697 : !> - test_result : "STR": String
698 : !> \param parser ...
699 : !> \param string_length ...
700 : !> \return ...
701 : !> \date 23.11.1999
702 : !> \author Matthias Krack (MK)
703 : !> \note - 08.2008 [tlaino] - Teodoro Laino UZH : updated for buffer
704 : !> - Major rewrite to parse also (multiple) products of integer or
705 : !> floating point numbers (23.11.2012,MK)
706 : ! **************************************************************************************************
707 10267596 : FUNCTION parser_test_next_token(parser, string_length) RESULT(test_result)
708 :
709 : TYPE(cp_parser_type), POINTER :: parser
710 : INTEGER, INTENT(IN), OPTIONAL :: string_length
711 : CHARACTER(LEN=3) :: test_result
712 :
713 : CHARACTER(LEN=max_line_length) :: error_message, string
714 : INTEGER :: iz, n
715 : LOGICAL :: ilist_in_use
716 : REAL(KIND=dp) :: fz
717 :
718 10267596 : test_result = ""
719 10267596 : CPASSERT(ASSOCIATED(parser))
720 10267596 : CPASSERT(parser%ref_count > 0)
721 :
722 : ! Store current status
723 10267596 : CALL parser_store_status(parser)
724 :
725 : ! Handle possible list of integers
726 10267596 : ilist_in_use = parser%ilist%in_use .AND. (parser%ilist%ipresent < parser%ilist%iend)
727 : IF (ilist_in_use) THEN
728 14154 : test_result = "INT"
729 14154 : CALL parser_retrieve_status(parser)
730 9546506 : RETURN
731 : END IF
732 :
733 : ! Otherwise continue normally
734 10253442 : IF (PRESENT(string_length)) THEN
735 0 : CALL parser_next_token(parser, string_length=string_length)
736 : ELSE
737 10253442 : CALL parser_next_token(parser)
738 : END IF
739 :
740 : ! End of line
741 10253442 : IF (parser%icol1 > parser%icol2) THEN
742 1443559 : test_result = "EOL"
743 1443559 : CALL parser_retrieve_status(parser)
744 1443559 : RETURN
745 : END IF
746 :
747 8809883 : string = parser%input_line(parser%icol1:parser%icol2)
748 8809883 : n = LEN_TRIM(string)
749 :
750 8809883 : IF (n == 0) THEN
751 0 : test_result = "STR"
752 0 : CALL parser_retrieve_status(parser)
753 0 : RETURN
754 : END IF
755 :
756 : ! Check for end section string
757 8809883 : IF (string(1:n) == parser%end_section) THEN
758 0 : test_result = "EOS"
759 0 : CALL parser_retrieve_status(parser)
760 0 : RETURN
761 : END IF
762 :
763 : ! Check for integer object
764 8809883 : error_message = ""
765 8809883 : CALL read_integer_object(string(1:n), iz, error_message)
766 8809883 : IF (LEN_TRIM(error_message) == 0) THEN
767 1284699 : test_result = "INT"
768 1284699 : CALL parser_retrieve_status(parser)
769 1284699 : RETURN
770 : END IF
771 :
772 : ! Check for floating point object
773 7525184 : error_message = ""
774 7525184 : CALL read_float_object(string(1:n), fz, error_message)
775 7525184 : IF (LEN_TRIM(error_message) == 0) THEN
776 6804094 : test_result = "FLT"
777 6804094 : CALL parser_retrieve_status(parser)
778 6804094 : RETURN
779 : END IF
780 :
781 721090 : test_result = "STR"
782 721090 : CALL parser_retrieve_status(parser)
783 :
784 : END FUNCTION parser_test_next_token
785 :
786 : ! **************************************************************************************************
787 : !> \brief Search a string pattern in a file defined by its logical unit
788 : !> number "unit". A case sensitive search is performed, if
789 : !> ignore_case is .FALSE..
790 : !> begin_line: give back the parser at the beginning of the line
791 : !> matching the search
792 : !> \param parser ...
793 : !> \param string ...
794 : !> \param ignore_case ...
795 : !> \param found ...
796 : !> \param line ...
797 : !> \param begin_line ...
798 : !> \param search_from_begin_of_file ...
799 : !> \date 05.10.1999
800 : !> \author MK
801 : !> \note 08.2008 [tlaino] - Teodoro Laino UZH : updated for buffer
802 : ! **************************************************************************************************
803 128867 : SUBROUTINE parser_search_string(parser, string, ignore_case, found, line, begin_line, &
804 : search_from_begin_of_file)
805 :
806 : TYPE(cp_parser_type), POINTER :: parser
807 : CHARACTER(LEN=*), INTENT(IN) :: string
808 : LOGICAL, INTENT(IN) :: ignore_case
809 : LOGICAL, INTENT(OUT) :: found
810 : CHARACTER(LEN=*), INTENT(OUT), OPTIONAL :: line
811 : LOGICAL, INTENT(IN), OPTIONAL :: begin_line, search_from_begin_of_file
812 :
813 128867 : CHARACTER(LEN=LEN(string)) :: pattern
814 : CHARACTER(LEN=max_line_length+1) :: current_line
815 : INTEGER :: ipattern
816 : LOGICAL :: at_end, begin, do_reset
817 :
818 128867 : found = .FALSE.
819 128867 : begin = .FALSE.
820 128867 : do_reset = .FALSE.
821 66132 : IF (PRESENT(begin_line)) begin = begin_line
822 128867 : IF (PRESENT(search_from_begin_of_file)) do_reset = search_from_begin_of_file
823 128867 : CPASSERT(ASSOCIATED(parser))
824 128867 : CPASSERT(parser%ref_count > 0)
825 128867 : IF (PRESENT(line)) line = ""
826 :
827 : ! Search for string pattern
828 128867 : pattern = string
829 128867 : IF (ignore_case) CALL uppercase(pattern)
830 128867 : IF (do_reset) CALL parser_reset(parser)
831 : DO
832 : ! This call is buffered.. so should not represent any bottleneck
833 25726929 : CALL parser_get_next_line(parser, 1, at_end=at_end)
834 :
835 : ! Exit loop, if the end of file is reached
836 25726929 : IF (at_end) EXIT
837 :
838 : ! Check the current line for string pattern
839 25718475 : current_line = parser%input_line
840 25718475 : IF (ignore_case) CALL uppercase(current_line)
841 25718475 : ipattern = INDEX(current_line, TRIM(pattern))
842 :
843 25726929 : IF (ipattern > 0) THEN
844 120413 : found = .TRUE.
845 120413 : parser%icol = ipattern - 1
846 120413 : IF (PRESENT(line)) THEN
847 62046 : IF (LEN(line) < LEN_TRIM(parser%input_line)) THEN
848 : CALL cp_warn(__LOCATION__, &
849 : "The returned input line has more than "// &
850 : TRIM(ADJUSTL(cp_to_string(LEN(line))))// &
851 : " characters and is therefore too long to fit in the "// &
852 : "specified variable"// &
853 0 : TRIM(parser_location(parser)))
854 : END IF
855 : END IF
856 : EXIT
857 : END IF
858 :
859 : END DO
860 :
861 128867 : IF (found) THEN
862 120413 : IF (begin) parser%icol = 0
863 : END IF
864 :
865 128867 : IF (found) THEN
866 120413 : IF (PRESENT(line)) line = parser%input_line
867 120413 : IF (.NOT. begin) CALL parser_next_token(parser)
868 : END IF
869 :
870 128867 : END SUBROUTINE parser_search_string
871 :
872 : ! **************************************************************************************************
873 : !> \brief Check, if the string object contains an object of type integer.
874 : !> \param string ...
875 : !> \return ...
876 : !> \date 22.11.1999
877 : !> \author Matthias Krack (MK)
878 : !> \version 1.0
879 : !> \note - Introducing the possibility to parse a range of integers INT1..INT2
880 : !> Teodoro Laino [tlaino] - University of Zurich - 08.2008
881 : !> - Parse also a product of integer numbers (23.11.2012,MK)
882 : ! **************************************************************************************************
883 1681285 : FUNCTION integer_object(string) RESULT(contains_integer_object)
884 :
885 : CHARACTER(LEN=*), INTENT(IN) :: string
886 : LOGICAL :: contains_integer_object
887 :
888 : INTEGER :: i, idots, istar, n
889 :
890 1681285 : contains_integer_object = .TRUE.
891 1681285 : n = LEN_TRIM(string)
892 :
893 1681285 : IF (n == 0) THEN
894 1681285 : contains_integer_object = .FALSE.
895 : RETURN
896 : END IF
897 :
898 1681285 : idots = INDEX(string(1:n), "..")
899 1681285 : istar = INDEX(string(1:n), "*")
900 :
901 1681285 : IF (idots /= 0) THEN
902 : contains_integer_object = is_integer(string(1:idots - 1)) .AND. &
903 14760 : is_integer(string(idots + 2:n))
904 1666525 : ELSE IF (istar /= 0) THEN
905 : i = 1
906 64 : DO WHILE (istar /= 0)
907 36 : IF (.NOT. is_integer(string(i:i + istar - 2))) THEN
908 1681285 : contains_integer_object = .FALSE.
909 : RETURN
910 : END IF
911 36 : i = i + istar
912 64 : istar = INDEX(string(i:n), "*")
913 : END DO
914 28 : contains_integer_object = is_integer(string(i:n))
915 : ELSE
916 1666497 : contains_integer_object = is_integer(string(1:n))
917 : END IF
918 :
919 : END FUNCTION integer_object
920 :
921 : ! **************************************************************************************************
922 : !> \brief ...
923 : !> \param string ...
924 : !> \return ...
925 : ! **************************************************************************************************
926 1696081 : FUNCTION is_integer(string) RESULT(check)
927 :
928 : CHARACTER(LEN=*), INTENT(IN) :: string
929 : LOGICAL :: check
930 :
931 : INTEGER :: i, n
932 :
933 1696081 : check = .TRUE.
934 1696081 : n = LEN_TRIM(string)
935 :
936 1696081 : IF (n == 0) THEN
937 1696081 : check = .FALSE.
938 : RETURN
939 : END IF
940 :
941 1696081 : IF ((INDEX("+-", string(1:1)) > 0) .AND. (n == 1)) THEN
942 1696081 : check = .FALSE.
943 : RETURN
944 : END IF
945 :
946 1696081 : IF (INDEX("+-0123456789", string(1:1)) == 0) THEN
947 1696081 : check = .FALSE.
948 : RETURN
949 : END IF
950 :
951 4972603 : DO i = 2, n
952 4972603 : IF (INDEX("0123456789", string(i:i)) == 0) THEN
953 1696081 : check = .FALSE.
954 : RETURN
955 : END IF
956 : END DO
957 :
958 : END FUNCTION is_integer
959 :
960 : ! **************************************************************************************************
961 : !> \brief Read an integer number.
962 : !> \param parser ...
963 : !> \param object ...
964 : !> \param newline ...
965 : !> \param skip_lines ...
966 : !> \param string_length ...
967 : !> \param at_end ...
968 : !> \date 22.11.1999
969 : !> \author Matthias Krack (MK)
970 : !> \version 1.0
971 : ! **************************************************************************************************
972 3362570 : SUBROUTINE parser_get_integer(parser, object, newline, skip_lines, &
973 : string_length, at_end)
974 :
975 : TYPE(cp_parser_type), POINTER :: parser
976 : INTEGER, INTENT(OUT) :: object
977 : LOGICAL, INTENT(IN), OPTIONAL :: newline
978 : INTEGER, INTENT(IN), OPTIONAL :: skip_lines, string_length
979 : LOGICAL, INTENT(out), OPTIONAL :: at_end
980 :
981 : CHARACTER(LEN=max_line_length) :: error_message
982 : INTEGER :: nline
983 : LOGICAL :: my_at_end
984 :
985 1681285 : CPASSERT(ASSOCIATED(parser))
986 1681285 : CPASSERT(parser%ref_count > 0)
987 1681285 : IF (PRESENT(skip_lines)) THEN
988 0 : nline = skip_lines
989 : ELSE
990 1681285 : nline = 0
991 : END IF
992 :
993 1681285 : IF (PRESENT(newline)) THEN
994 43601 : IF (newline) nline = nline + 1
995 : END IF
996 :
997 1681285 : CALL parser_get_next_line(parser, nline, at_end=my_at_end)
998 1681285 : IF (PRESENT(at_end)) THEN
999 0 : at_end = my_at_end
1000 0 : IF (my_at_end) RETURN
1001 1681285 : ELSE IF (my_at_end) THEN
1002 0 : CPABORT("Unexpected EOF"//TRIM(parser_location(parser)))
1003 : END IF
1004 :
1005 1681285 : IF (parser%ilist%in_use) THEN
1006 14162 : CALL ilist_update(parser%ilist)
1007 : ELSE
1008 1667123 : IF (PRESENT(string_length)) THEN
1009 0 : CALL parser_next_token(parser, string_length=string_length)
1010 : ELSE
1011 1667123 : CALL parser_next_token(parser)
1012 : END IF
1013 1667123 : IF (parser%icol1 > parser%icol2) THEN
1014 0 : parser%icol1 = parser%icol
1015 0 : parser%icol2 = parser%icol
1016 : CALL cp_abort(__LOCATION__, &
1017 : "An integer type object was expected, found end of line"// &
1018 0 : TRIM(parser_location(parser)))
1019 : END IF
1020 : ! Checks for possible lists of integers
1021 1667123 : IF (INDEX(parser%input_line(parser%icol1:parser%icol2), "..") /= 0) THEN
1022 598 : CALL ilist_setup(parser%ilist, parser%input_line(parser%icol1:parser%icol2))
1023 : END IF
1024 : END IF
1025 :
1026 1681285 : IF (integer_object(parser%input_line(parser%icol1:parser%icol2))) THEN
1027 1681285 : IF (parser%ilist%in_use) THEN
1028 14760 : object = parser%ilist%ipresent
1029 14760 : CALL ilist_reset(parser%ilist)
1030 : ELSE
1031 1666525 : CALL read_integer_object(parser%input_line(parser%icol1:parser%icol2), object, error_message)
1032 1666525 : IF (LEN_TRIM(error_message) > 0) THEN
1033 0 : CPABORT(TRIM(error_message)//TRIM(parser_location(parser)))
1034 : END IF
1035 : END IF
1036 : ELSE
1037 : CALL cp_abort(__LOCATION__, &
1038 : "An integer type object was expected, found <"// &
1039 : parser%input_line(parser%icol1:parser%icol2)//">"// &
1040 0 : TRIM(parser_location(parser)))
1041 : END IF
1042 :
1043 : END SUBROUTINE parser_get_integer
1044 :
1045 : ! **************************************************************************************************
1046 : !> \brief Read a string representing logical object.
1047 : !> \param parser ...
1048 : !> \param object ...
1049 : !> \param newline ...
1050 : !> \param skip_lines ...
1051 : !> \param string_length ...
1052 : !> \param at_end ...
1053 : !> \date 01.04.2003
1054 : !> \par History
1055 : !> - New version (08.07.2003,MK)
1056 : !> \author FM
1057 : !> \version 1.0
1058 : ! **************************************************************************************************
1059 31628 : SUBROUTINE parser_get_logical(parser, object, newline, skip_lines, &
1060 : string_length, at_end)
1061 :
1062 : TYPE(cp_parser_type), POINTER :: parser
1063 : LOGICAL, INTENT(OUT) :: object
1064 : LOGICAL, INTENT(IN), OPTIONAL :: newline
1065 : INTEGER, INTENT(IN), OPTIONAL :: skip_lines, string_length
1066 : LOGICAL, INTENT(out), OPTIONAL :: at_end
1067 :
1068 : CHARACTER(LEN=max_line_length) :: input_string
1069 : INTEGER :: input_string_length, nline
1070 : LOGICAL :: my_at_end
1071 :
1072 15814 : CPASSERT(ASSOCIATED(parser))
1073 15814 : CPASSERT(parser%ref_count > 0)
1074 15814 : CPASSERT(.NOT. parser%ilist%in_use)
1075 15814 : IF (PRESENT(skip_lines)) THEN
1076 0 : nline = skip_lines
1077 : ELSE
1078 15814 : nline = 0
1079 : END IF
1080 :
1081 15814 : IF (PRESENT(newline)) THEN
1082 0 : IF (newline) nline = nline + 1
1083 : END IF
1084 :
1085 15814 : CALL parser_get_next_line(parser, nline, at_end=my_at_end)
1086 15814 : IF (PRESENT(at_end)) THEN
1087 0 : at_end = my_at_end
1088 0 : IF (my_at_end) RETURN
1089 15814 : ELSE IF (my_at_end) THEN
1090 0 : CPABORT("Unexpected EOF"//TRIM(parser_location(parser)))
1091 : END IF
1092 :
1093 15814 : IF (PRESENT(string_length)) THEN
1094 0 : CALL parser_next_token(parser, string_length=string_length)
1095 : ELSE
1096 15814 : CALL parser_next_token(parser)
1097 : END IF
1098 :
1099 15814 : input_string_length = parser%icol2 - parser%icol1 + 1
1100 :
1101 15814 : IF (input_string_length == 0) THEN
1102 0 : parser%icol1 = parser%icol
1103 0 : parser%icol2 = parser%icol
1104 : CALL cp_abort(__LOCATION__, &
1105 : "A string representing a logical object was expected, found end of line"// &
1106 0 : TRIM(parser_location(parser)))
1107 : ELSE
1108 15814 : input_string = ""
1109 15814 : input_string(:input_string_length) = parser%input_line(parser%icol1:parser%icol2)
1110 : END IF
1111 15814 : CALL uppercase(input_string)
1112 :
1113 21290 : SELECT CASE (TRIM(input_string))
1114 : CASE ("0", "F", ".F.", "FALSE", ".FALSE.", "N", "NO", "OFF")
1115 5476 : object = .FALSE.
1116 : CASE ("1", "T", ".T.", "TRUE", ".TRUE.", "Y", "YES", "ON")
1117 10338 : object = .TRUE.
1118 : CASE DEFAULT
1119 : CALL cp_abort(__LOCATION__, &
1120 : "A string representing a logical object was expected, found <"// &
1121 15814 : TRIM(input_string)//">"//TRIM(parser_location(parser)))
1122 : END SELECT
1123 :
1124 : END SUBROUTINE parser_get_logical
1125 :
1126 : ! **************************************************************************************************
1127 : !> \brief Read a floating point number.
1128 : !> \param parser ...
1129 : !> \param object ...
1130 : !> \param newline ...
1131 : !> \param skip_lines ...
1132 : !> \param string_length ...
1133 : !> \param at_end ...
1134 : !> \date 22.11.1999
1135 : !> \author Matthias Krack (MK)
1136 : !> \version 1.0
1137 : ! **************************************************************************************************
1138 14626358 : SUBROUTINE parser_get_real(parser, object, newline, skip_lines, string_length, &
1139 : at_end)
1140 :
1141 : TYPE(cp_parser_type), POINTER :: parser
1142 : REAL(KIND=dp), INTENT(OUT) :: object
1143 : LOGICAL, INTENT(IN), OPTIONAL :: newline
1144 : INTEGER, INTENT(IN), OPTIONAL :: skip_lines, string_length
1145 : LOGICAL, INTENT(out), OPTIONAL :: at_end
1146 :
1147 : CHARACTER(LEN=max_line_length) :: error_message
1148 : INTEGER :: nline
1149 : LOGICAL :: my_at_end
1150 :
1151 7313179 : CPASSERT(ASSOCIATED(parser))
1152 7313179 : CPASSERT(parser%ref_count > 0)
1153 7313179 : CPASSERT(.NOT. parser%ilist%in_use)
1154 :
1155 7313179 : IF (PRESENT(skip_lines)) THEN
1156 0 : nline = skip_lines
1157 : ELSE
1158 7313179 : nline = 0
1159 : END IF
1160 :
1161 7313179 : IF (PRESENT(newline)) THEN
1162 72731 : IF (newline) nline = nline + 1
1163 : END IF
1164 :
1165 7313179 : CALL parser_get_next_line(parser, nline, at_end=my_at_end)
1166 7313179 : IF (PRESENT(at_end)) THEN
1167 0 : at_end = my_at_end
1168 0 : IF (my_at_end) RETURN
1169 7313179 : ELSE IF (my_at_end) THEN
1170 0 : CPABORT("Unexpected EOF"//TRIM(parser_location(parser)))
1171 : END IF
1172 :
1173 7313179 : IF (PRESENT(string_length)) THEN
1174 0 : CALL parser_next_token(parser, string_length=string_length)
1175 : ELSE
1176 7313179 : CALL parser_next_token(parser)
1177 : END IF
1178 :
1179 7313179 : IF (parser%icol1 > parser%icol2) THEN
1180 0 : parser%icol1 = parser%icol
1181 0 : parser%icol2 = parser%icol
1182 : CALL cp_abort(__LOCATION__, &
1183 : "A floating point type object was expected, found end of the line"// &
1184 0 : TRIM(parser_location(parser)))
1185 : END IF
1186 :
1187 : ! Possibility to have real numbers described in the input as division between two numbers
1188 7313179 : CALL read_float_object(parser%input_line(parser%icol1:parser%icol2), object, error_message)
1189 7313179 : IF (LEN_TRIM(error_message) > 0) THEN
1190 0 : CPABORT(TRIM(error_message)//TRIM(parser_location(parser)))
1191 : END IF
1192 :
1193 : END SUBROUTINE parser_get_real
1194 :
1195 : ! **************************************************************************************************
1196 : !> \brief Read a string.
1197 : !> \param parser ...
1198 : !> \param object ...
1199 : !> \param lower_to_upper ...
1200 : !> \param newline ...
1201 : !> \param skip_lines ...
1202 : !> \param string_length ...
1203 : !> \param at_end ...
1204 : !> \date 22.11.1999
1205 : !> \author Matthias Krack (MK)
1206 : !> \version 1.0
1207 : ! **************************************************************************************************
1208 4448128 : SUBROUTINE parser_get_string(parser, object, lower_to_upper, newline, skip_lines, &
1209 : string_length, at_end)
1210 :
1211 : TYPE(cp_parser_type), POINTER :: parser
1212 : CHARACTER(LEN=*), INTENT(OUT) :: object
1213 : LOGICAL, INTENT(IN), OPTIONAL :: lower_to_upper, newline
1214 : INTEGER, INTENT(IN), OPTIONAL :: skip_lines, string_length
1215 : LOGICAL, INTENT(out), OPTIONAL :: at_end
1216 :
1217 : INTEGER :: input_string_length, nline
1218 : LOGICAL :: my_at_end
1219 :
1220 2224064 : object = ""
1221 2224064 : CPASSERT(ASSOCIATED(parser))
1222 2224064 : CPASSERT(parser%ref_count > 0)
1223 2224064 : CPASSERT(.NOT. parser%ilist%in_use)
1224 2224064 : IF (PRESENT(skip_lines)) THEN
1225 0 : nline = skip_lines
1226 : ELSE
1227 2224064 : nline = 0
1228 : END IF
1229 :
1230 2224064 : IF (PRESENT(newline)) THEN
1231 1158437 : IF (newline) nline = nline + 1
1232 : END IF
1233 :
1234 2224064 : CALL parser_get_next_line(parser, nline, at_end=my_at_end)
1235 2224064 : IF (PRESENT(at_end)) THEN
1236 998124 : at_end = my_at_end
1237 998124 : IF (my_at_end) RETURN
1238 1225940 : ELSE IF (my_at_end) THEN
1239 : CALL cp_abort(__LOCATION__, &
1240 0 : "Unexpected EOF"//TRIM(parser_location(parser)))
1241 : END IF
1242 :
1243 2215644 : IF (PRESENT(string_length)) THEN
1244 291935 : CALL parser_next_token(parser, string_length=string_length)
1245 : ELSE
1246 1923709 : CALL parser_next_token(parser)
1247 : END IF
1248 :
1249 2215644 : input_string_length = parser%icol2 - parser%icol1 + 1
1250 :
1251 2215644 : IF (input_string_length <= 0) THEN
1252 : CALL cp_abort(__LOCATION__, &
1253 : "A string type object was expected, found end of line"// &
1254 0 : TRIM(parser_location(parser)))
1255 2215644 : ELSE IF (input_string_length > LEN(object)) THEN
1256 : CALL cp_abort(__LOCATION__, &
1257 : "The input string <"//parser%input_line(parser%icol1:parser%icol2)// &
1258 : "> has more than "//cp_to_string(LEN(object))// &
1259 : " characters and is therefore too long to fit in the "// &
1260 0 : "specified variable"//TRIM(parser_location(parser)))
1261 0 : object = parser%input_line(parser%icol1:parser%icol1 + LEN(object) - 1)
1262 : ELSE
1263 2215644 : object(:input_string_length) = parser%input_line(parser%icol1:parser%icol2)
1264 : END IF
1265 :
1266 : ! Convert lowercase to uppercase, if requested
1267 2215644 : IF (PRESENT(lower_to_upper)) THEN
1268 1290587 : IF (lower_to_upper) CALL uppercase(object)
1269 : END IF
1270 :
1271 2224064 : END SUBROUTINE parser_get_string
1272 :
1273 : ! **************************************************************************************************
1274 : !> \brief Returns a floating point number read from a string including
1275 : !> fraction like z1/z2.
1276 : !> \param string ...
1277 : !> \param object ...
1278 : !> \param error_message ...
1279 : !> \date 11.01.2011 (MK)
1280 : !> \author Matthias Krack
1281 : !> \version 1.0
1282 : !> \note - Parse also multiple products and fractions of floating point
1283 : !> numbers (23.11.2012,MK)
1284 : ! **************************************************************************************************
1285 15429717 : SUBROUTINE read_float_object(string, object, error_message)
1286 :
1287 : CHARACTER(LEN=*), INTENT(IN) :: string
1288 : REAL(KIND=dp), INTENT(OUT) :: object
1289 : CHARACTER(LEN=*), INTENT(OUT) :: error_message
1290 :
1291 : INTEGER :: i, iop, islash, istar, istat, n
1292 : LOGICAL :: parsing_done
1293 : REAL(KIND=dp) :: z
1294 :
1295 15429717 : error_message = ""
1296 :
1297 15429717 : i = 1
1298 15429717 : iop = 0
1299 15429717 : n = LEN_TRIM(string)
1300 :
1301 15429717 : parsing_done = .FALSE.
1302 :
1303 30142630 : DO WHILE (.NOT. parsing_done)
1304 15434003 : i = i + iop
1305 15434003 : islash = INDEX(string(i:n), "/")
1306 15434003 : istar = INDEX(string(i:n), "*")
1307 15434003 : IF ((islash == 0) .AND. (istar == 0)) THEN
1308 : ! Last factor found: read it and then exit the loop
1309 15417832 : iop = n - i + 2
1310 15417832 : parsing_done = .TRUE.
1311 16171 : ELSE IF ((islash > 0) .AND. (istar > 0)) THEN
1312 6276 : iop = MIN(islash, istar)
1313 9895 : ELSE IF (islash > 0) THEN
1314 : iop = islash
1315 4200 : ELSE IF (istar > 0) THEN
1316 4200 : iop = istar
1317 : END IF
1318 15434003 : READ (UNIT=string(i:i + iop - 2), FMT=*, IOSTAT=istat) z
1319 15434003 : IF (istat /= 0) THEN
1320 : error_message = "A floating point type object was expected, found <"// &
1321 721090 : string(i:i + iop - 2)//">"
1322 721090 : RETURN
1323 : END IF
1324 29421540 : IF (i == 1) THEN
1325 14711951 : object = z
1326 962 : ELSE IF (string(i - 1:i - 1) == "*") THEN
1327 80 : object = object*z
1328 : ELSE
1329 882 : IF (z == 0.0_dp) THEN
1330 : error_message = "Division by zero found <"// &
1331 0 : string(i:i + iop - 2)//">"
1332 0 : RETURN
1333 : ELSE
1334 882 : object = object/z
1335 : END IF
1336 : END IF
1337 : END DO
1338 :
1339 15429717 : END SUBROUTINE read_float_object
1340 :
1341 : ! **************************************************************************************************
1342 : !> \brief Returns an integer number read from a string including products of
1343 : !> integer numbers like iz1*iz2*iz3
1344 : !> \param string ...
1345 : !> \param object ...
1346 : !> \param error_message ...
1347 : !> \date 23.11.2012 (MK)
1348 : !> \author Matthias Krack
1349 : !> \version 1.0
1350 : !> \note - Parse also (multiple) products of integer numbers (23.11.2012,MK)
1351 : ! **************************************************************************************************
1352 10502812 : SUBROUTINE read_integer_object(string, object, error_message)
1353 :
1354 : CHARACTER(LEN=*), INTENT(IN) :: string
1355 : INTEGER, INTENT(OUT) :: object
1356 : CHARACTER(LEN=*), INTENT(OUT) :: error_message
1357 :
1358 : CHARACTER(LEN=20) :: fmtstr
1359 : INTEGER :: i, iop, istat, n
1360 : INTEGER(KIND=int_8) :: iz8, object8
1361 : LOGICAL :: parsing_done
1362 :
1363 10502812 : error_message = ""
1364 :
1365 10502812 : i = 1
1366 10502812 : iop = 0
1367 10502812 : n = LEN_TRIM(string)
1368 :
1369 10502812 : parsing_done = .FALSE.
1370 :
1371 13457228 : DO WHILE (.NOT. parsing_done)
1372 10505972 : i = i + iop
1373 : ! note that INDEX always starts counting from 1 if found. Thus iop
1374 : ! will give the length of the integer number plus 1
1375 10505972 : iop = INDEX(string(i:n), "*")
1376 10505972 : IF (iop == 0) THEN
1377 : ! Last factor found: read it and then exit the loop
1378 : ! note that iop will always be the length of one integer plus 1
1379 : ! and we still need to calculate it here as it is need for fmtstr
1380 : ! below to determine integer format length
1381 10495510 : iop = n - i + 2
1382 10495510 : parsing_done = .TRUE.
1383 : END IF
1384 10505972 : istat = 1
1385 10505972 : IF (iop - 1 > 0) THEN
1386 : ! need an explicit fmtstr here. With 'FMT=*' compilers from intel and pgi will also
1387 : ! read float numbers as integers, without setting istat non-zero, i.e. string="0.3", istat=0, iz8=0
1388 : ! this leads to wrong CP2K results (e.g. parsing force fields).
1389 10505970 : WRITE (fmtstr, FMT='(A,I0,A)') '(I', iop - 1, ')'
1390 10505970 : READ (UNIT=string(i:i + iop - 2), FMT=fmtstr, IOSTAT=istat) iz8
1391 : END IF
1392 10505972 : IF (istat /= 0) THEN
1393 : error_message = "An integer type object was expected, found <"// &
1394 7551556 : string(i:i + iop - 2)//">"
1395 7551556 : RETURN
1396 : END IF
1397 2954416 : IF (i == 1) THEN
1398 2954344 : object8 = iz8
1399 : ELSE
1400 72 : object8 = object8*iz8
1401 : END IF
1402 5905672 : IF (ABS(object8) > HUGE(0)) THEN
1403 : error_message = "The specified integer number <"//string(i:i + iop - 2)// &
1404 0 : "> exceeds the allowed range of a 32-bit integer number."
1405 0 : RETURN
1406 : END IF
1407 : END DO
1408 :
1409 2951256 : object = INT(object8)
1410 :
1411 10502812 : END SUBROUTINE read_integer_object
1412 :
1413 : END MODULE cp_parser_methods
|
