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 4629835 : SUBROUTINE parser_store_status(parser)
94 :
95 : TYPE(cp_parser_type), INTENT(INOUT) :: parser
96 :
97 4629835 : CPASSERT(ASSOCIATED(parser%status))
98 4629835 : parser%status%in_use = .TRUE.
99 4629835 : parser%status%old_input_line = parser%input_line
100 4629835 : parser%status%old_input_line_number = parser%input_line_number
101 4629835 : parser%status%old_icol = parser%icol
102 4629835 : parser%status%old_icol1 = parser%icol1
103 4629835 : parser%status%old_icol2 = parser%icol2
104 : ! Store buffer info
105 4629835 : CALL copy_buffer_type(parser%buffer, parser%status%buffer)
106 :
107 4629835 : 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 4629835 : 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 4629835 : 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 4629835 : parser%status%in_use = .FALSE.
124 4629835 : parser%input_line = parser%status%old_input_line
125 4629835 : parser%input_line_number = parser%status%old_input_line_number
126 4629835 : parser%icol = parser%status%old_icol
127 4629835 : parser%icol1 = parser%status%old_icol1
128 4629835 : parser%icol2 = parser%status%old_icol2
129 :
130 : ! Retrieve buffer info
131 4629835 : CALL copy_buffer_type(parser%status%buffer, parser%buffer)
132 :
133 4629835 : 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 44204188 : 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 44204188 : CALL timeset(routineN, handle)
157 :
158 44204188 : IF (PRESENT(at_end)) at_end = .FALSE.
159 :
160 88391774 : DO iline = 1, nline
161 : ! Try to read the next line from the buffer
162 44209937 : CALL parser_get_line_from_buffer(parser, istat)
163 :
164 : ! Handle (persisting) read errors
165 88391774 : IF (istat /= 0) THEN
166 22351 : IF (istat < 0) THEN ! EOF/EOR is negative other errors positive
167 22351 : IF (PRESENT(at_end)) THEN
168 22351 : at_end = .TRUE.
169 : ELSE
170 0 : CPABORT("Unexpected EOF"//TRIM(parser_location(parser)))
171 : END IF
172 22351 : parser%icol = -1
173 22351 : parser%icol1 = 0
174 22351 : 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 22351 : CALL timestop(handle)
182 22351 : RETURN
183 : END IF
184 : END DO
185 :
186 : ! Reset column pointer, if a new line was read
187 44181837 : IF (nline > 0) parser%icol = 0
188 :
189 44181837 : 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 44209937 : SUBROUTINE parser_get_line_from_buffer(parser, istat)
200 :
201 : TYPE(cp_parser_type), INTENT(INOUT) :: parser
202 : INTEGER, INTENT(OUT) :: istat
203 :
204 44209937 : istat = 0
205 : ! Check buffer
206 44209937 : IF (parser%buffer%present_line_number == parser%buffer%size) THEN
207 93837 : 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 93799 : CALL parser_read_line_low(parser)
213 : END IF
214 : END IF
215 44209937 : parser%buffer%present_line_number = parser%buffer%present_line_number + 1
216 44209937 : parser%input_line_number = parser%buffer%input_line_numbers(parser%buffer%present_line_number)
217 44209937 : parser%input_line = parser%buffer%input_lines(parser%buffer%present_line_number)
218 44209937 : IF ((parser%buffer%istat /= 0) .AND. &
219 : (parser%buffer%last_line_number == parser%buffer%present_line_number)) THEN
220 22351 : istat = parser%buffer%istat
221 : END IF
222 :
223 44209937 : 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 93799 : 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 93799 : CALL timeset(routineN, handle)
243 :
244 93892799 : parser%buffer%input_lines = ""
245 93799 : IF (parser%para_env%is_source()) THEN
246 48905 : iline = 0
247 48905 : istat = 0
248 48905 : parser%buffer%buffer_id = parser%buffer%buffer_id + 1
249 48905 : parser%buffer%present_line_number = 0
250 48905 : parser%buffer%last_line_number = parser%buffer%size
251 48905 : last_buffered_line_number = parser%buffer%input_line_numbers(parser%buffer%size)
252 35178190 : DO WHILE (iline /= parser%buffer%size)
253 : ! Increment counters by 1
254 35150157 : iline = iline + 1
255 35150157 : last_buffered_line_number = last_buffered_line_number + 1
256 :
257 : ! Try to read the next line from file
258 35150157 : parser%buffer%input_line_numbers(iline) = last_buffered_line_number
259 35150157 : 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 35150157 : IF (istat == 0) THEN
265 35128748 : islen = LEN_TRIM(parser%buffer%input_lines(iline))
266 35128748 : this_line_is_white_or_comment = is_comment_line(parser, parser%buffer%input_lines(iline))
267 35128748 : IF (.NOT. this_line_is_white_or_comment .AND. parser%apply_preprocessing) THEN
268 29323393 : imark = INDEX(parser%buffer%input_lines(iline) (1:islen), "$")
269 29323393 : IF (imark /= 0) THEN
270 : CALL inpp_expand_variables(parser%inpp, parser%buffer%input_lines(iline), &
271 5882 : parser%input_file_name, parser%buffer%input_line_numbers(iline))
272 5882 : islen = LEN_TRIM(parser%buffer%input_lines(iline))
273 : END IF
274 29323393 : imark = INDEX(parser%buffer%input_lines(iline) (1:islen), "@")
275 29323393 : 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 9976 : parser%input_unit)
279 9976 : islen = LEN_TRIM(parser%buffer%input_lines(iline))
280 : ! Handle index and cycle
281 9976 : last_buffered_line_number = 0
282 9976 : iline = iline - 1
283 9976 : CYCLE
284 : END IF
285 :
286 : ! after preprocessor parsing could the line be empty again
287 29313417 : this_line_is_white_or_comment = is_comment_line(parser, parser%buffer%input_lines(iline))
288 : END IF
289 21409 : ELSE IF (istat < 0) THEN ! handle EOF
290 21409 : 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 537 : parser%buffer%input_line_numbers(iline), parser%input_unit)
294 : ! Handle index and cycle
295 537 : last_buffered_line_number = parser%buffer%input_line_numbers(iline)
296 537 : iline = iline - 1
297 537 : CYCLE
298 : END IF
299 : END IF
300 :
301 : ! Saving persisting read errors
302 35139644 : IF (istat /= 0) THEN
303 20872 : parser%buffer%istat = istat
304 20872 : parser%buffer%last_line_number = iline
305 18390423 : parser%buffer%input_line_numbers(iline:) = 0
306 18390423 : parser%buffer%input_lines(iline:) = ""
307 : EXIT
308 : END IF
309 :
310 : ! Pre-processing and error checking done. Ready for parsing.
311 35118772 : IF (.NOT. parser%parse_white_lines) THEN
312 34897401 : non_white_found = .NOT. this_line_is_white_or_comment
313 : ELSE
314 : non_white_found = .TRUE.
315 : END IF
316 35146805 : IF (.NOT. non_white_found) THEN
317 4583323 : iline = iline - 1
318 4583323 : last_buffered_line_number = last_buffered_line_number - 1
319 : END IF
320 : END DO
321 : END IF
322 : ! Broadcast buffer informations
323 93799 : CALL broadcast_input_information(parser)
324 :
325 93799 : CALL timestop(handle)
326 :
327 93799 : 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 93799 : 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 93799 : CALL timeset(routineN, handle)
346 :
347 93799 : para_env => parser%para_env
348 93799 : IF (para_env%num_pe > 1) THEN
349 89788 : CALL para_env%bcast(parser%buffer%buffer_id)
350 89788 : CALL para_env%bcast(parser%buffer%present_line_number)
351 89788 : CALL para_env%bcast(parser%buffer%last_line_number)
352 89788 : CALL para_env%bcast(parser%buffer%istat)
353 179665788 : CALL para_env%bcast(parser%buffer%input_line_numbers)
354 179665788 : CALL para_env%bcast(parser%buffer%input_lines)
355 : END IF
356 :
357 93799 : CALL timestop(handle)
358 :
359 93799 : 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 64442165 : 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 64442165 : resval = .TRUE.
379 1166050314 : DO icol = 1, LEN(line)
380 1165759148 : thischar = line(icol:icol)
381 1166050314 : IF (.NOT. is_whitespace(thischar)) THEN
382 64150999 : IF (.NOT. is_comment(parser, thischar)) resval = .FALSE.
383 : EXIT
384 : END IF
385 : END DO
386 :
387 64442165 : 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 127916566 : 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 127916566 : resval = .FALSE.
405 : ! We are in a private function, and parser has been tested before...
406 375664554 : IF (ANY(parser%comment_character == testchar)) resval = .TRUE.
407 :
408 127916566 : 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 48941813 : 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 48941813 : IF (nline > 0) THEN
429 43774026 : CALL parser_read_line(parser, nline, at_end=my_at_end)
430 43774026 : IF (PRESENT(at_end)) THEN
431 42869089 : at_end = my_at_end
432 : ELSE
433 904937 : IF (my_at_end) THEN
434 0 : CPABORT("Unexpected EOF"//TRIM(parser_location(parser)))
435 : END IF
436 : END IF
437 5167787 : ELSE IF (PRESENT(at_end)) THEN
438 5167507 : at_end = .FALSE.
439 : END IF
440 :
441 48941813 : 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 23597 : 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 23597 : 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 24295 : parser%icol = parser%icol + 1
470 :
471 : ! Quick return, if the end of line is found
472 24295 : IF ((parser%icol > LEN_TRIM(parser%input_line)) .OR. &
473 : is_comment(parser, parser%input_line(parser%icol:parser%icol))) THEN
474 74 : parser%icol1 = 1
475 74 : parser%icol2 = -1
476 74 : RETURN
477 : END IF
478 :
479 : ! Ignore all white space
480 24221 : IF (.NOT. is_whitespace(parser%input_line(parser%icol:parser%icol))) THEN
481 : ! Check for input line continuation
482 23523 : 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 23523 : parser%icol = parser%icol - 1
505 23523 : parser%icol1 = parser%icol
506 23523 : parser%icol2 = parser%icol
507 23523 : 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 11203245 : 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 11203245 : IF (PRESENT(string_length)) THEN
534 297211 : 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 11203245 : len_trim_inputline = LEN_TRIM(parser%input_line)
545 :
546 11203245 : IF (length > 0) THEN
547 :
548 : ! Read input string of fixed length (single line)
549 :
550 : ! Check for EOF
551 297211 : IF (parser%icol == -1) THEN
552 0 : CPABORT("Unexpectetly reached EOF"//TRIM(parser_location(parser)))
553 : END IF
554 :
555 297211 : length = MIN(len_trim_inputline - parser%icol1 + 1, length)
556 297211 : parser%icol1 = parser%icol + 1
557 297211 : parser%icol2 = parser%icol + length
558 297211 : i = INDEX(parser%input_line(parser%icol1:parser%icol2), parser%quote_character)
559 297211 : IF (i > 0) parser%icol2 = parser%icol + i
560 297211 : parser%icol = parser%icol2
561 :
562 : ELSE
563 :
564 : ! Variable input string length (automatic multi-line search)
565 :
566 : ! Check for EOF
567 10906034 : IF (parser%icol == -1) THEN
568 0 : parser%icol1 = 1
569 0 : parser%icol2 = -1
570 1616691 : 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 32984988 : parser%icol = parser%icol + 1
578 :
579 : ! Quick return, if the end of line is found
580 32984988 : IF (parser%icol > len_trim_inputline) THEN
581 1574643 : parser%icol1 = 1
582 1574643 : parser%icol2 = -1
583 1574643 : RETURN
584 : END IF
585 :
586 31410345 : token = parser%input_line(parser%icol:parser%icol)
587 :
588 31410345 : IF (is_whitespace(token)) THEN
589 : ! Ignore white space
590 : CYCLE outer_loop1
591 9450621 : ELSE IF (is_comment(parser, token)) THEN
592 32446 : parser%icol1 = 1
593 32446 : parser%icol2 = -1
594 32446 : parser%first_separator = .TRUE.
595 32446 : RETURN
596 9418175 : ELSE IF (token == parser%quote_character) THEN
597 : ! Read quoted string
598 9602 : parser%icol1 = parser%icol + 1
599 9602 : parser%icol2 = parser%icol + INDEX(parser%input_line(parser%icol1:), parser%quote_character)
600 9602 : 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 9602 : parser%icol = parser%icol2
607 9602 : parser%icol2 = parser%icol2 - 1
608 9602 : parser%first_separator = .TRUE.
609 9602 : RETURN
610 : END IF
611 9408573 : 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 9289789 : ELSE IF (INDEX(parser%separators, token) > 0) THEN
634 446 : IF (parser%first_separator) THEN
635 446 : parser%first_separator = .FALSE.
636 446 : 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 9289343 : parser%icol1 = parser%icol
646 9289343 : parser%first_separator = .TRUE.
647 9289343 : 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 63000776 : parser%icol = parser%icol + 1
655 63000776 : IF (parser%icol > len_trim_inputline) EXIT outer_loop2
656 60636632 : token = parser%input_line(parser%icol:parser%icol)
657 60636632 : IF (is_whitespace(token) .OR. is_comment(parser, token) .OR. &
658 8710113 : (token == parser%continuation_character)) THEN
659 : EXIT outer_loop2
660 54290663 : ELSE IF (INDEX(parser%separators, token) > 0) THEN
661 579230 : parser%first_separator = .FALSE.
662 579230 : EXIT outer_loop2
663 : END IF
664 : END DO outer_loop2
665 :
666 9289343 : parser%icol2 = parser%icol - 1
667 :
668 9289343 : 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 4629835 : 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 4629835 : test_result = ""
703 :
704 : ! Store current status
705 4629835 : CALL parser_store_status(parser)
706 :
707 : ! Handle possible list of integers
708 4629835 : ilist_in_use = parser%ilist%in_use .AND. (parser%ilist%ipresent < parser%ilist%iend)
709 : IF (ilist_in_use) THEN
710 14300 : test_result = "INT"
711 14300 : CALL parser_retrieve_status(parser)
712 3757562 : RETURN
713 : END IF
714 :
715 : ! Otherwise continue normally
716 4615535 : IF (PRESENT(string_length)) THEN
717 0 : CALL parser_next_token(parser, string_length=string_length)
718 : ELSE
719 4615535 : CALL parser_next_token(parser)
720 : END IF
721 :
722 : ! End of line
723 4615535 : IF (parser%icol1 > parser%icol2) THEN
724 1607113 : test_result = "EOL"
725 1607113 : CALL parser_retrieve_status(parser)
726 1607113 : RETURN
727 : END IF
728 :
729 3008422 : string = parser%input_line(parser%icol1:parser%icol2)
730 3008422 : n = LEN_TRIM(string)
731 :
732 3008422 : 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 3008422 : 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 3008422 : error_message = ""
747 3008422 : CALL read_integer_object(string(1:n), iz, error_message)
748 3008422 : IF (LEN_TRIM(error_message) == 0) THEN
749 1312311 : test_result = "INT"
750 1312311 : CALL parser_retrieve_status(parser)
751 1312311 : RETURN
752 : END IF
753 :
754 : ! Check for floating point object
755 1696111 : error_message = ""
756 1696111 : CALL read_float_object(string(1:n), fz, error_message)
757 1696111 : IF (LEN_TRIM(error_message) == 0) THEN
758 823838 : test_result = "FLT"
759 823838 : CALL parser_retrieve_status(parser)
760 823838 : RETURN
761 : END IF
762 :
763 872273 : test_result = "STR"
764 872273 : 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 156252 : 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 156252 : 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 156252 : found = .FALSE.
801 156252 : begin = .FALSE.
802 156252 : do_reset = .FALSE.
803 66724 : IF (PRESENT(begin_line)) begin = begin_line
804 156252 : IF (PRESENT(search_from_begin_of_file)) do_reset = search_from_begin_of_file
805 156252 : IF (PRESENT(line)) line = ""
806 :
807 : ! Search for string pattern
808 156252 : pattern = string
809 156252 : IF (ignore_case) CALL uppercase(pattern)
810 156252 : IF (do_reset) CALL parser_reset(parser)
811 : DO
812 : ! This call is buffered.. so should not represent any bottleneck
813 39930291 : CALL parser_get_next_line(parser, 1, at_end=at_end)
814 :
815 : ! Exit loop, if the end of file is reached
816 39930291 : IF (at_end) EXIT
817 :
818 : ! Check the current line for string pattern
819 39921079 : current_line = parser%input_line
820 39921079 : IF (ignore_case) CALL uppercase(current_line)
821 39921079 : ipattern = INDEX(current_line, TRIM(pattern))
822 :
823 39930291 : IF (ipattern > 0) THEN
824 147040 : found = .TRUE.
825 147040 : parser%icol = ipattern - 1
826 147040 : IF (PRESENT(line)) THEN
827 88231 : 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 156252 : IF (found) THEN
842 147040 : IF (begin) parser%icol = 0
843 : END IF
844 :
845 156252 : IF (found) THEN
846 147040 : IF (PRESENT(line)) line = parser%input_line
847 147040 : IF (.NOT. begin) CALL parser_next_token(parser)
848 : END IF
849 :
850 156252 : 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 1803721 : 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 1803721 : contains_integer_object = .TRUE.
871 1803721 : n = LEN_TRIM(string)
872 :
873 1803721 : IF (n == 0) THEN
874 1803721 : contains_integer_object = .FALSE.
875 : RETURN
876 : END IF
877 :
878 1803721 : idots = INDEX(string(1:n), "..")
879 1803721 : istar = INDEX(string(1:n), "*")
880 :
881 1803721 : IF (idots /= 0) THEN
882 : contains_integer_object = is_integer(string(1:idots - 1)) .AND. &
883 14930 : is_integer(string(idots + 2:n))
884 1788791 : ELSE IF (istar /= 0) THEN
885 : i = 1
886 140 : DO WHILE (istar /= 0)
887 78 : IF (.NOT. is_integer(string(i:i + istar - 2))) THEN
888 1803721 : contains_integer_object = .FALSE.
889 : RETURN
890 : END IF
891 78 : i = i + istar
892 140 : istar = INDEX(string(i:n), "*")
893 : END DO
894 62 : contains_integer_object = is_integer(string(i:n))
895 : ELSE
896 1788729 : 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 1818729 : ELEMENTAL FUNCTION is_integer(string) RESULT(check)
907 :
908 : CHARACTER(LEN=*), INTENT(IN) :: string
909 : LOGICAL :: check
910 :
911 : INTEGER :: i, n
912 :
913 1818729 : check = .TRUE.
914 1818729 : n = LEN_TRIM(string)
915 :
916 1818729 : IF (n == 0) THEN
917 1818729 : check = .FALSE.
918 : RETURN
919 : END IF
920 :
921 1818729 : IF ((INDEX("+-", string(1:1)) > 0) .AND. (n == 1)) THEN
922 1818729 : check = .FALSE.
923 : RETURN
924 : END IF
925 :
926 1818729 : IF (INDEX("+-0123456789", string(1:1)) == 0) THEN
927 1818729 : check = .FALSE.
928 : RETURN
929 : END IF
930 :
931 5124159 : DO i = 2, n
932 5124159 : IF (INDEX("0123456789", string(i:i)) == 0) THEN
933 1818729 : 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 3607442 : 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 1803721 : IF (PRESENT(skip_lines)) THEN
966 0 : nline = skip_lines
967 : ELSE
968 1803721 : nline = 0
969 : END IF
970 :
971 1803721 : IF (PRESENT(newline)) THEN
972 60717 : IF (newline) nline = nline + 1
973 : END IF
974 :
975 1803721 : CALL parser_get_next_line(parser, nline, at_end=my_at_end)
976 1803721 : IF (PRESENT(at_end)) THEN
977 0 : at_end = my_at_end
978 0 : IF (my_at_end) RETURN
979 1803721 : ELSE IF (my_at_end) THEN
980 0 : CPABORT("Unexpected EOF"//TRIM(parser_location(parser)))
981 : END IF
982 :
983 1803721 : IF (parser%ilist%in_use) THEN
984 14308 : CALL ilist_update(parser%ilist)
985 : ELSE
986 1789413 : IF (PRESENT(string_length)) THEN
987 0 : CALL parser_next_token(parser, string_length=string_length)
988 : ELSE
989 1789413 : CALL parser_next_token(parser)
990 : END IF
991 1789413 : 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 1789413 : IF (INDEX(parser%input_line(parser%icol1:parser%icol2), "..") /= 0) THEN
1000 622 : CALL ilist_setup(parser%ilist, parser%input_line(parser%icol1:parser%icol2))
1001 : END IF
1002 : END IF
1003 :
1004 1803721 : IF (integer_object(parser%input_line(parser%icol1:parser%icol2))) THEN
1005 1803721 : IF (parser%ilist%in_use) THEN
1006 14930 : object = parser%ilist%ipresent
1007 14930 : CALL ilist_reset(parser%ilist)
1008 : ELSE
1009 1788791 : CALL read_integer_object(parser%input_line(parser%icol1:parser%icol2), object, error_message)
1010 1788791 : 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 47724 : 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 23862 : CPASSERT(.NOT. parser%ilist%in_use)
1051 23862 : IF (PRESENT(skip_lines)) THEN
1052 0 : nline = skip_lines
1053 : ELSE
1054 23862 : nline = 0
1055 : END IF
1056 :
1057 23862 : IF (PRESENT(newline)) THEN
1058 0 : IF (newline) nline = nline + 1
1059 : END IF
1060 :
1061 23862 : CALL parser_get_next_line(parser, nline, at_end=my_at_end)
1062 23862 : IF (PRESENT(at_end)) THEN
1063 0 : at_end = my_at_end
1064 0 : IF (my_at_end) RETURN
1065 23862 : ELSE IF (my_at_end) THEN
1066 0 : CPABORT("Unexpected EOF"//TRIM(parser_location(parser)))
1067 : END IF
1068 :
1069 23862 : IF (PRESENT(string_length)) THEN
1070 0 : CALL parser_next_token(parser, string_length=string_length)
1071 : ELSE
1072 23862 : CALL parser_next_token(parser)
1073 : END IF
1074 :
1075 23862 : input_string_length = parser%icol2 - parser%icol1 + 1
1076 :
1077 23862 : 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 23862 : input_string = ""
1085 23862 : input_string(:input_string_length) = parser%input_line(parser%icol1:parser%icol2)
1086 : END IF
1087 23862 : CALL uppercase(input_string)
1088 :
1089 32440 : SELECT CASE (TRIM(input_string))
1090 : CASE ("0", "F", ".F.", "FALSE", ".FALSE.", "N", "NO", "OFF")
1091 8578 : object = .FALSE.
1092 : CASE ("1", "T", ".T.", "TRUE", ".TRUE.", "Y", "YES", "ON")
1093 15284 : object = .TRUE.
1094 : CASE DEFAULT
1095 : CALL cp_abort(__LOCATION__, &
1096 : "A string representing a logical object was expected, found <"// &
1097 23862 : 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 2901262 : 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 1450631 : CPASSERT(.NOT. parser%ilist%in_use)
1128 :
1129 1450631 : IF (PRESENT(skip_lines)) THEN
1130 0 : nline = skip_lines
1131 : ELSE
1132 1450631 : nline = 0
1133 : END IF
1134 :
1135 1450631 : IF (PRESENT(newline)) THEN
1136 100785 : IF (newline) nline = nline + 1
1137 : END IF
1138 :
1139 1450631 : CALL parser_get_next_line(parser, nline, at_end=my_at_end)
1140 1450631 : IF (PRESENT(at_end)) THEN
1141 0 : at_end = my_at_end
1142 0 : IF (my_at_end) RETURN
1143 1450631 : ELSE IF (my_at_end) THEN
1144 0 : CPABORT("Unexpected EOF"//TRIM(parser_location(parser)))
1145 : END IF
1146 :
1147 1450631 : IF (PRESENT(string_length)) THEN
1148 0 : CALL parser_next_token(parser, string_length=string_length)
1149 : ELSE
1150 1450631 : CALL parser_next_token(parser)
1151 : END IF
1152 :
1153 1450631 : 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 1450631 : CALL read_float_object(parser%input_line(parser%icol1:parser%icol2), object, error_message)
1163 1450631 : 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 : !> \date 22.11.1999
1179 : !> \author Matthias Krack (MK)
1180 : !> \version 1.0
1181 : ! **************************************************************************************************
1182 6493124 : SUBROUTINE parser_get_string(parser, object, lower_to_upper, newline, skip_lines, &
1183 : string_length, at_end)
1184 :
1185 : TYPE(cp_parser_type), INTENT(INOUT) :: parser
1186 : CHARACTER(LEN=*), INTENT(OUT) :: object
1187 : LOGICAL, INTENT(IN), OPTIONAL :: lower_to_upper, newline
1188 : INTEGER, INTENT(IN), OPTIONAL :: skip_lines, string_length
1189 : LOGICAL, INTENT(out), OPTIONAL :: at_end
1190 :
1191 : INTEGER :: input_string_length, nline
1192 : LOGICAL :: my_at_end
1193 :
1194 3246562 : object = ""
1195 3246562 : CPASSERT(.NOT. parser%ilist%in_use)
1196 3246562 : IF (PRESENT(skip_lines)) THEN
1197 0 : nline = skip_lines
1198 : ELSE
1199 3246562 : nline = 0
1200 : END IF
1201 :
1202 3246562 : IF (PRESENT(newline)) THEN
1203 1441897 : IF (newline) nline = nline + 1
1204 : END IF
1205 :
1206 3246562 : CALL parser_get_next_line(parser, nline, at_end=my_at_end)
1207 3246562 : IF (PRESENT(at_end)) THEN
1208 1194097 : at_end = my_at_end
1209 1194097 : IF (my_at_end) RETURN
1210 2052465 : ELSE IF (my_at_end) THEN
1211 : CALL cp_abort(__LOCATION__, &
1212 0 : "Unexpected EOF"//TRIM(parser_location(parser)))
1213 : END IF
1214 :
1215 3235250 : IF (PRESENT(string_length)) THEN
1216 297211 : CALL parser_next_token(parser, string_length=string_length)
1217 : ELSE
1218 2938039 : CALL parser_next_token(parser)
1219 : END IF
1220 :
1221 3235250 : input_string_length = parser%icol2 - parser%icol1 + 1
1222 :
1223 3235250 : IF (input_string_length <= 0) THEN
1224 : CALL cp_abort(__LOCATION__, &
1225 : "A string type object was expected, found end of line"// &
1226 0 : TRIM(parser_location(parser)))
1227 3235250 : ELSE IF (input_string_length > LEN(object)) THEN
1228 : CALL cp_abort(__LOCATION__, &
1229 : "The input string <"//parser%input_line(parser%icol1:parser%icol2)// &
1230 : "> has more than "//cp_to_string(LEN(object))// &
1231 : " characters and is therefore too long to fit in the "// &
1232 0 : "specified variable"//TRIM(parser_location(parser)))
1233 0 : object = parser%input_line(parser%icol1:parser%icol1 + LEN(object) - 1)
1234 : ELSE
1235 3235250 : object(:input_string_length) = parser%input_line(parser%icol1:parser%icol2)
1236 : END IF
1237 :
1238 : ! Convert lowercase to uppercase, if requested
1239 3235250 : IF (PRESENT(lower_to_upper)) THEN
1240 1581593 : IF (lower_to_upper) CALL uppercase(object)
1241 : END IF
1242 :
1243 3246562 : END SUBROUTINE parser_get_string
1244 :
1245 : ! **************************************************************************************************
1246 : !> \brief Returns a floating point number read from a string including
1247 : !> fraction like z1/z2.
1248 : !> \param string ...
1249 : !> \param object ...
1250 : !> \param error_message ...
1251 : !> \date 11.01.2011 (MK)
1252 : !> \par History
1253 : !> - Add simple function parsing (17.05.2023, MK)
1254 : !> \author Matthias Krack
1255 : !> \version 2.0
1256 : !> \note - Parse also multiple products and fractions of floating point numbers (23.11.2012,MK)
1257 : ! **************************************************************************************************
1258 3810912 : ELEMENTAL SUBROUTINE read_float_object(string, object, error_message)
1259 :
1260 : CHARACTER(LEN=*), INTENT(IN) :: string
1261 : REAL(KIND=dp), INTENT(OUT) :: object
1262 : CHARACTER(LEN=*), INTENT(OUT) :: error_message
1263 :
1264 : INTEGER, PARAMETER :: maxlen = 5
1265 :
1266 : CHARACTER(LEN=maxlen) :: func
1267 : INTEGER :: i, ileft, iop, iright, is, islash, &
1268 : istar, istat, n
1269 : LOGICAL :: parsing_done
1270 : REAL(KIND=dp) :: fsign, z
1271 :
1272 3810912 : error_message = ""
1273 3810912 : func = ""
1274 :
1275 3810912 : i = 1
1276 3810912 : iop = 0
1277 3810912 : n = LEN_TRIM(string)
1278 :
1279 3810912 : parsing_done = .FALSE.
1280 :
1281 6754179 : DO WHILE (.NOT. parsing_done)
1282 3815540 : i = i + iop
1283 3815540 : islash = INDEX(string(i:n), "/")
1284 3815540 : istar = INDEX(string(i:n), "*")
1285 3815540 : IF ((islash == 0) .AND. (istar == 0)) THEN
1286 : ! Last factor found: read it and then exit the loop
1287 3798601 : iop = n - i + 2
1288 3798601 : parsing_done = .TRUE.
1289 16939 : ELSE IF ((islash > 0) .AND. (istar > 0)) THEN
1290 6294 : iop = MIN(islash, istar)
1291 10645 : ELSE IF (islash > 0) THEN
1292 : iop = islash
1293 4312 : ELSE IF (istar > 0) THEN
1294 4312 : iop = istar
1295 : END IF
1296 3815540 : ileft = INDEX(string(i:MIN(n, i + maxlen + 1)), "(")
1297 3815540 : IF (ileft > 0) THEN
1298 : ! Check for sign
1299 334 : is = ICHAR(string(i:i))
1300 12 : SELECT CASE (is)
1301 : CASE (43)
1302 12 : fsign = 1.0_dp
1303 12 : func = string(i + 1:i + ileft - 2)
1304 : CASE (45)
1305 22 : fsign = -1.0_dp
1306 22 : func = string(i + 1:i + ileft - 2)
1307 : CASE DEFAULT
1308 300 : fsign = 1.0_dp
1309 334 : func = string(i:i + ileft - 2)
1310 : END SELECT
1311 334 : iright = INDEX(string(i:n), ")")
1312 334 : READ (UNIT=string(i + ileft:i + iright - 2), FMT=*, IOSTAT=istat) z
1313 334 : IF (istat /= 0) THEN
1314 : error_message = "A floating point type object as argument for function <"// &
1315 : TRIM(func)//"> is expected, found <"// &
1316 234 : string(i + ileft:i + iright - 2)//">"
1317 872273 : RETURN
1318 : END IF
1319 8 : SELECT CASE (func)
1320 : CASE ("COS")
1321 8 : z = fsign*COS(z*radians)
1322 : CASE ("EXP")
1323 4 : z = fsign*EXP(z)
1324 : CASE ("LOG")
1325 4 : z = fsign*LOG(z)
1326 : CASE ("LOG10")
1327 4 : z = fsign*LOG10(z)
1328 : CASE ("SIN")
1329 6 : z = fsign*SIN(z*radians)
1330 : CASE ("SQRT")
1331 4 : z = fsign*SQRT(z)
1332 : CASE ("TAN")
1333 4 : z = fsign*TAN(z*radians)
1334 : CASE DEFAULT
1335 66 : error_message = "Unknown function <"//TRIM(func)//"> found"
1336 100 : RETURN
1337 : END SELECT
1338 : ELSE
1339 3815206 : READ (UNIT=string(i:i + iop - 2), FMT=*, IOSTAT=istat) z
1340 3815206 : IF (istat /= 0) THEN
1341 : error_message = "A floating point type object was expected, found <"// &
1342 871973 : string(i:i + iop - 2)//">"
1343 871973 : RETURN
1344 : END IF
1345 : END IF
1346 5881906 : IF (i == 1) THEN
1347 2941937 : object = z
1348 1330 : ELSE IF (string(i - 1:i - 1) == "*") THEN
1349 152 : object = object*z
1350 : ELSE
1351 1178 : IF (z == 0.0_dp) THEN
1352 : error_message = "Division by zero found <"// &
1353 0 : string(i:i + iop - 2)//">"
1354 0 : RETURN
1355 : ELSE
1356 1178 : object = object/z
1357 : END IF
1358 : END IF
1359 : END DO
1360 :
1361 3810912 : END SUBROUTINE read_float_object
1362 :
1363 : ! **************************************************************************************************
1364 : !> \brief Returns an integer number read from a string including products of
1365 : !> integer numbers like iz1*iz2*iz3
1366 : !> \param string ...
1367 : !> \param object ...
1368 : !> \param error_message ...
1369 : !> \date 23.11.2012 (MK)
1370 : !> \author Matthias Krack
1371 : !> \version 1.0
1372 : !> \note - Parse also (multiple) products of integer numbers (23.11.2012,MK)
1373 : ! **************************************************************************************************
1374 4841815 : ELEMENTAL SUBROUTINE read_integer_object(string, object, error_message)
1375 :
1376 : CHARACTER(LEN=*), INTENT(IN) :: string
1377 : INTEGER, INTENT(OUT) :: object
1378 : CHARACTER(LEN=*), INTENT(OUT) :: error_message
1379 :
1380 : CHARACTER(LEN=20) :: fmtstr
1381 : INTEGER :: i, iop, istat, n
1382 : INTEGER(KIND=int_8) :: iz8, object8
1383 : LOGICAL :: parsing_done
1384 :
1385 4841815 : error_message = ""
1386 :
1387 4841815 : i = 1
1388 4841815 : iop = 0
1389 4841815 : n = LEN_TRIM(string)
1390 :
1391 4841815 : parsing_done = .FALSE.
1392 :
1393 7946193 : DO WHILE (.NOT. parsing_done)
1394 4845059 : i = i + iop
1395 : ! note that INDEX always starts counting from 1 if found. Thus iop
1396 : ! will give the length of the integer number plus 1
1397 4845059 : iop = INDEX(string(i:n), "*")
1398 4845059 : IF (iop == 0) THEN
1399 : ! Last factor found: read it and then exit the loop
1400 : ! note that iop will always be the length of one integer plus 1
1401 : ! and we still need to calculate it here as it is need for fmtstr
1402 : ! below to determine integer format length
1403 4834411 : iop = n - i + 2
1404 4834411 : parsing_done = .TRUE.
1405 : END IF
1406 4845059 : istat = 1
1407 4845059 : IF (iop - 1 > 0) THEN
1408 : ! need an explicit fmtstr here. With 'FMT=*' compilers from intel and pgi will also
1409 : ! read float numbers as integers, without setting istat non-zero, i.e. string="0.3", istat=0, iz8=0
1410 : ! this leads to wrong CP2K results (e.g. parsing force fields).
1411 4845055 : WRITE (fmtstr, FMT='(A,I0,A)') '(I', iop - 1, ')'
1412 4845055 : READ (UNIT=string(i:i + iop - 2), FMT=fmtstr, IOSTAT=istat) iz8
1413 : END IF
1414 4845059 : IF (istat /= 0) THEN
1415 : error_message = "An integer type object was expected, found <"// &
1416 1740681 : string(i:i + iop - 2)//">"
1417 1740681 : RETURN
1418 : END IF
1419 3104378 : IF (i == 1) THEN
1420 3104222 : object8 = iz8
1421 : ELSE
1422 156 : object8 = object8*iz8
1423 : END IF
1424 6205512 : IF (ABS(object8) > HUGE(0)) THEN
1425 : error_message = "The specified integer number <"//string(i:i + iop - 2)// &
1426 0 : "> exceeds the allowed range of a 32-bit integer number."
1427 0 : RETURN
1428 : END IF
1429 : END DO
1430 :
1431 3101134 : object = INT(object8)
1432 :
1433 4841815 : END SUBROUTINE read_integer_object
1434 :
1435 : END MODULE cp_parser_methods
|
