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