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