Line data Source code
1 : !--------------------------------------------------------------------------------------------------!
2 : ! CP2K: A general program to perform molecular dynamics simulations !
3 : ! Copyright 2000-2023 CP2K developers group <https://cp2k.org> !
4 : ! !
5 : ! SPDX-License-Identifier: GPL-2.0-or-later !
6 : !--------------------------------------------------------------------------------------------------!
7 :
8 : ! **************************************************************************************************
9 : !> \brief Utility routines to read data from files.
10 : !> Kept as close as possible to the old parser because
11 : !> 1. string handling is a weak point of fortran compilers, and it is
12 : !> easy to write correct things that do not work
13 : !> 2. conversion of old code
14 : !> \par History
15 : !> 22.11.1999 first version of the old parser (called qs_parser)
16 : !> Matthias Krack
17 : !> 06.2004 removed module variables, cp_parser_type, new module [fawzi]
18 : !> \author Fawzi Mohamed, Matthias Krack
19 : ! **************************************************************************************************
20 : MODULE cp_parser_methods
21 :
22 : USE cp_log_handling, ONLY: cp_to_string
23 : USE cp_parser_buffer_types, ONLY: copy_buffer_type,&
24 : finalize_sub_buffer,&
25 : initialize_sub_buffer
26 : USE cp_parser_ilist_methods, ONLY: ilist_reset,&
27 : ilist_setup,&
28 : ilist_update
29 : USE cp_parser_inpp_methods, ONLY: inpp_end_include,&
30 : inpp_expand_variables,&
31 : inpp_process_directive
32 : USE cp_parser_types, ONLY: cp_parser_type,&
33 : parser_reset
34 : USE kinds, ONLY: default_path_length,&
35 : default_string_length,&
36 : dp,&
37 : int_8,&
38 : max_line_length
39 : USE 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 4368399 : SUBROUTINE parser_store_status(parser)
94 :
95 : TYPE(cp_parser_type), INTENT(INOUT) :: parser
96 :
97 4368399 : CPASSERT(ASSOCIATED(parser%status))
98 4368399 : parser%status%in_use = .TRUE.
99 4368399 : parser%status%old_input_line = parser%input_line
100 4368399 : parser%status%old_input_line_number = parser%input_line_number
101 4368399 : parser%status%old_icol = parser%icol
102 4368399 : parser%status%old_icol1 = parser%icol1
103 4368399 : parser%status%old_icol2 = parser%icol2
104 : ! Store buffer info
105 4368399 : CALL copy_buffer_type(parser%buffer, parser%status%buffer)
106 :
107 4368399 : 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 4368399 : 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 4368399 : 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 4368399 : parser%status%in_use = .FALSE.
124 4368399 : parser%input_line = parser%status%old_input_line
125 4368399 : parser%input_line_number = parser%status%old_input_line_number
126 4368399 : parser%icol = parser%status%old_icol
127 4368399 : parser%icol1 = parser%status%old_icol1
128 4368399 : parser%icol2 = parser%status%old_icol2
129 :
130 : ! Retrieve buffer info
131 4368399 : CALL copy_buffer_type(parser%status%buffer, parser%buffer)
132 :
133 4368399 : 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 35533830 : 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 35533830 : CALL timeset(routineN, handle)
157 :
158 35533830 : IF (PRESENT(at_end)) at_end = .FALSE.
159 :
160 71055595 : DO iline = 1, nline
161 : ! Try to read the next line from the buffer
162 35541253 : CALL parser_get_line_from_buffer(parser, istat)
163 :
164 : ! Handle (persisting) read errors
165 71055595 : IF (istat /= 0) THEN
166 19488 : IF (istat < 0) THEN ! EOF/EOR is negative other errors positive
167 19488 : IF (PRESENT(at_end)) THEN
168 19488 : at_end = .TRUE.
169 : ELSE
170 0 : CPABORT("Unexpected EOF"//TRIM(parser_location(parser)))
171 : END IF
172 19488 : parser%icol = -1
173 19488 : parser%icol1 = 0
174 19488 : 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 19488 : CALL timestop(handle)
182 19488 : RETURN
183 : END IF
184 : END DO
185 :
186 : ! Reset column pointer, if a new line was read
187 35514342 : IF (nline > 0) parser%icol = 0
188 :
189 35514342 : 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 35541253 : SUBROUTINE parser_get_line_from_buffer(parser, istat)
200 :
201 : TYPE(cp_parser_type), INTENT(INOUT) :: parser
202 : INTEGER, INTENT(OUT) :: istat
203 :
204 35541253 : istat = 0
205 : ! Check buffer
206 35541253 : IF (parser%buffer%present_line_number == parser%buffer%size) THEN
207 76557 : 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 76519 : CALL parser_read_line_low(parser)
213 : END IF
214 : END IF
215 35541253 : parser%buffer%present_line_number = parser%buffer%present_line_number + 1
216 35541253 : parser%input_line_number = parser%buffer%input_line_numbers(parser%buffer%present_line_number)
217 35541253 : parser%input_line = parser%buffer%input_lines(parser%buffer%present_line_number)
218 35541253 : IF ((parser%buffer%istat /= 0) .AND. &
219 : (parser%buffer%last_line_number == parser%buffer%present_line_number)) THEN
220 19488 : istat = parser%buffer%istat
221 : END IF
222 :
223 35541253 : 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 76519 : 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 76519 : CALL timeset(routineN, handle)
243 :
244 76595519 : parser%buffer%input_lines = ""
245 76519 : IF (parser%para_env%is_source()) THEN
246 40178 : iline = 0
247 40178 : istat = 0
248 40178 : parser%buffer%buffer_id = parser%buffer%buffer_id + 1
249 40178 : parser%buffer%present_line_number = 0
250 40178 : parser%buffer%last_line_number = parser%buffer%size
251 40178 : last_buffered_line_number = parser%buffer%input_line_numbers(parser%buffer%size)
252 26893946 : DO WHILE (iline /= parser%buffer%size)
253 : ! Increment counters by 1
254 26872767 : iline = iline + 1
255 26872767 : last_buffered_line_number = last_buffered_line_number + 1
256 :
257 : ! Try to read the next line from file
258 26872767 : parser%buffer%input_line_numbers(iline) = last_buffered_line_number
259 26872767 : 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 26872767 : IF (istat == 0) THEN
265 26853237 : islen = LEN_TRIM(parser%buffer%input_lines(iline))
266 26853237 : this_line_is_white_or_comment = is_comment_line(parser, parser%buffer%input_lines(iline))
267 26853237 : IF (.NOT. this_line_is_white_or_comment .AND. parser%apply_preprocessing) THEN
268 23346019 : imark = INDEX(parser%buffer%input_lines(iline) (1:islen), "$")
269 23346019 : IF (imark /= 0) THEN
270 : CALL inpp_expand_variables(parser%inpp, parser%buffer%input_lines(iline), &
271 5634 : parser%input_file_name, parser%buffer%input_line_numbers(iline))
272 5634 : islen = LEN_TRIM(parser%buffer%input_lines(iline))
273 : END IF
274 23346019 : imark = INDEX(parser%buffer%input_lines(iline) (1:islen), "@")
275 23346019 : 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 9800 : parser%input_unit)
279 9800 : islen = LEN_TRIM(parser%buffer%input_lines(iline))
280 : ! Handle index and cycle
281 9800 : last_buffered_line_number = 0
282 9800 : iline = iline - 1
283 9800 : CYCLE
284 : END IF
285 :
286 : ! after preprocessor parsing could the line be empty again
287 23336219 : this_line_is_white_or_comment = is_comment_line(parser, parser%buffer%input_lines(iline))
288 : END IF
289 19530 : ELSE IF (istat < 0) THEN ! handle EOF
290 19530 : 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 531 : parser%buffer%input_line_numbers(iline), parser%input_unit)
294 : ! Handle index and cycle
295 531 : last_buffered_line_number = parser%buffer%input_line_numbers(iline)
296 531 : iline = iline - 1
297 531 : CYCLE
298 : END IF
299 : END IF
300 :
301 : ! Saving persisting read errors
302 26862436 : IF (istat /= 0) THEN
303 18999 : parser%buffer%istat = istat
304 18999 : parser%buffer%last_line_number = iline
305 16847041 : parser%buffer%input_line_numbers(iline:) = 0
306 16847041 : parser%buffer%input_lines(iline:) = ""
307 : EXIT
308 : END IF
309 :
310 : ! Pre-processing and error checking done. Ready for parsing.
311 26843437 : IF (.NOT. parser%parse_white_lines) THEN
312 26626981 : non_white_found = .NOT. this_line_is_white_or_comment
313 : ELSE
314 : non_white_found = .TRUE.
315 : END IF
316 26648160 : IF (.NOT. non_white_found) THEN
317 3493479 : iline = iline - 1
318 3493479 : last_buffered_line_number = last_buffered_line_number - 1
319 : END IF
320 : END DO
321 : END IF
322 : ! Broadcast buffer informations
323 76519 : CALL broadcast_input_information(parser)
324 :
325 76519 : CALL timestop(handle)
326 :
327 76519 : 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 76519 : 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 76519 : CALL timeset(routineN, handle)
346 :
347 76519 : para_env => parser%para_env
348 76519 : IF (para_env%num_pe > 1) THEN
349 72682 : CALL para_env%bcast(parser%buffer%buffer_id)
350 72682 : CALL para_env%bcast(parser%buffer%present_line_number)
351 72682 : CALL para_env%bcast(parser%buffer%last_line_number)
352 72682 : CALL para_env%bcast(parser%buffer%istat)
353 145436682 : CALL para_env%bcast(parser%buffer%input_line_numbers)
354 145436682 : CALL para_env%bcast(parser%buffer%input_lines)
355 : END IF
356 :
357 76519 : CALL timestop(handle)
358 :
359 76519 : 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 50189456 : 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 50189456 : resval = .TRUE.
379 771636512 : DO icol = 1, LEN(line)
380 771480514 : thischar = line(icol:icol)
381 771636512 : IF (.NOT. is_whitespace(thischar)) THEN
382 50033458 : IF (.NOT. is_comment(parser, thischar)) resval = .FALSE.
383 : EXIT
384 : END IF
385 : END DO
386 :
387 50189456 : 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 106662682 : 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 106662682 : resval = .FALSE.
405 : ! We are in a private function, and parser has been tested before...
406 313811958 : IF (ANY(parser%comment_character == testchar)) resval = .TRUE.
407 :
408 106662682 : 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 39308350 : 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 39308350 : IF (nline > 0) THEN
429 35111242 : CALL parser_read_line(parser, nline, at_end=my_at_end)
430 35111242 : IF (PRESENT(at_end)) THEN
431 34207631 : at_end = my_at_end
432 : ELSE
433 903611 : IF (my_at_end) THEN
434 0 : CPABORT("Unexpected EOF"//TRIM(parser_location(parser)))
435 : END IF
436 : END IF
437 4197108 : ELSE IF (PRESENT(at_end)) THEN
438 4196812 : at_end = .FALSE.
439 : END IF
440 :
441 39308350 : 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 20805 : 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 20805 : 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 25779 : parser%icol = parser%icol + 1
470 :
471 : ! Quick return, if the end of line is found
472 25779 : 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 25705 : IF (.NOT. is_whitespace(parser%input_line(parser%icol:parser%icol))) THEN
481 : ! Check for input line continuation
482 20731 : 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 20731 : parser%icol = parser%icol - 1
505 20731 : parser%icol1 = parser%icol
506 20731 : parser%icol2 = parser%icol
507 20731 : 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 9789762 : 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 9789762 : IF (PRESENT(string_length)) THEN
534 287093 : 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 9789762 : len_trim_inputline = LEN_TRIM(parser%input_line)
545 :
546 9789762 : IF (length > 0) THEN
547 :
548 : ! Read input string of fixed length (single line)
549 :
550 : ! Check for EOF
551 287093 : IF (parser%icol == -1) &
552 0 : CPABORT("Unexpectetly reached EOF"//TRIM(parser_location(parser)))
553 :
554 287093 : length = MIN(len_trim_inputline - parser%icol1 + 1, length)
555 287093 : parser%icol1 = parser%icol + 1
556 287093 : parser%icol2 = parser%icol + length
557 287093 : i = INDEX(parser%input_line(parser%icol1:parser%icol2), parser%quote_character)
558 287093 : IF (i > 0) parser%icol2 = parser%icol + i
559 287093 : parser%icol = parser%icol2
560 :
561 : ELSE
562 :
563 : ! Variable input string length (automatic multi-line search)
564 :
565 : ! Check for EOF
566 9502669 : IF (parser%icol == -1) THEN
567 0 : parser%icol1 = 1
568 0 : parser%icol2 = -1
569 1518542 : RETURN
570 : END IF
571 :
572 : ! Search for the beginning of the next input string
573 : outer_loop1: DO
574 :
575 : ! Increment the column counter
576 29997036 : parser%icol = parser%icol + 1
577 :
578 : ! Quick return, if the end of line is found
579 29997036 : IF (parser%icol > len_trim_inputline) THEN
580 1477128 : parser%icol1 = 1
581 1477128 : parser%icol2 = -1
582 1477128 : RETURN
583 : END IF
584 :
585 28519908 : token = parser%input_line(parser%icol:parser%icol)
586 :
587 28519908 : IF (is_whitespace(token)) THEN
588 : ! Ignore white space
589 : CYCLE outer_loop1
590 8144729 : ELSE IF (is_comment(parser, token)) THEN
591 32378 : parser%icol1 = 1
592 32378 : parser%icol2 = -1
593 32378 : parser%first_separator = .TRUE.
594 32378 : RETURN
595 8112351 : ELSE IF (token == parser%quote_character) THEN
596 : ! Read quoted string
597 9036 : parser%icol1 = parser%icol + 1
598 9036 : parser%icol2 = parser%icol + INDEX(parser%input_line(parser%icol1:), parser%quote_character)
599 9036 : IF (parser%icol2 == parser%icol) THEN
600 0 : parser%icol1 = parser%icol
601 0 : parser%icol2 = parser%icol
602 : CALL cp_abort(__LOCATION__, &
603 0 : "Unmatched quotation mark found"//TRIM(parser_location(parser)))
604 : ELSE
605 9036 : parser%icol = parser%icol2
606 9036 : parser%icol2 = parser%icol2 - 1
607 9036 : parser%first_separator = .TRUE.
608 9036 : RETURN
609 : END IF
610 8103315 : ELSE IF (token == parser%continuation_character) THEN
611 : ! Check for input line continuation
612 118784 : inner_loop1: DO i = parser%icol + 1, len_trim_inputline
613 118784 : IF (is_whitespace(parser%input_line(i:i))) THEN
614 : CYCLE inner_loop1
615 0 : ELSE IF (is_comment(parser, parser%input_line(i:i))) THEN
616 : EXIT inner_loop1
617 : ELSE
618 0 : parser%icol1 = i
619 0 : parser%icol2 = len_trim_inputline
620 : CALL cp_abort(__LOCATION__, &
621 : "Found a non-blank token which is not a comment after the line continuation character '"// &
622 0 : parser%continuation_character//"'"//TRIM(parser_location(parser)))
623 : END IF
624 : END DO inner_loop1
625 118784 : CALL parser_get_next_line(parser, 1, at_end=at_end)
626 118784 : IF (at_end) THEN
627 : CALL cp_abort(__LOCATION__, &
628 0 : "Unexpected end of file (EOF) found after line continuation"//TRIM(parser_location(parser)))
629 : END IF
630 118784 : len_trim_inputline = LEN_TRIM(parser%input_line)
631 118784 : CYCLE outer_loop1
632 7984531 : ELSE IF (INDEX(parser%separators, token) > 0) THEN
633 404 : IF (parser%first_separator) THEN
634 404 : parser%first_separator = .FALSE.
635 404 : CYCLE outer_loop1
636 : ELSE
637 0 : parser%icol1 = parser%icol
638 0 : parser%icol2 = parser%icol
639 : CALL cp_abort(__LOCATION__, &
640 : "Unexpected separator token '"//token// &
641 0 : "' found"//TRIM(parser_location(parser)))
642 : END IF
643 : ELSE
644 7984127 : parser%icol1 = parser%icol
645 7984127 : parser%first_separator = .TRUE.
646 7984127 : EXIT outer_loop1
647 : END IF
648 :
649 : END DO outer_loop1
650 :
651 : ! Search for the end of the next input string
652 : outer_loop2: DO
653 56440851 : parser%icol = parser%icol + 1
654 56440851 : IF (parser%icol > len_trim_inputline) EXIT outer_loop2
655 54459723 : token = parser%input_line(parser%icol:parser%icol)
656 54459723 : IF (is_whitespace(token) .OR. is_comment(parser, token) .OR. &
657 7982123 : (token == parser%continuation_character)) THEN
658 : EXIT outer_loop2
659 48458728 : ELSE IF (INDEX(parser%separators, token) > 0) THEN
660 2004 : parser%first_separator = .FALSE.
661 2004 : EXIT outer_loop2
662 : END IF
663 : END DO outer_loop2
664 :
665 7984127 : parser%icol2 = parser%icol - 1
666 :
667 7984127 : IF (parser%input_line(parser%icol:parser%icol) == &
668 14 : parser%continuation_character) parser%icol = parser%icol2
669 :
670 : END IF
671 :
672 : END SUBROUTINE parser_next_token
673 :
674 : ! **************************************************************************************************
675 : !> \brief Test next input object.
676 : !> - test_result : "EOL": End of line
677 : !> - test_result : "EOS": End of section
678 : !> - test_result : "FLT": Floating point number
679 : !> - test_result : "INT": Integer number
680 : !> - test_result : "STR": String
681 : !> \param parser ...
682 : !> \param string_length ...
683 : !> \return ...
684 : !> \date 23.11.1999
685 : !> \author Matthias Krack (MK)
686 : !> \note - 08.2008 [tlaino] - Teodoro Laino UZH : updated for buffer
687 : !> - Major rewrite to parse also (multiple) products of integer or
688 : !> floating point numbers (23.11.2012,MK)
689 : ! **************************************************************************************************
690 4368399 : FUNCTION parser_test_next_token(parser, string_length) RESULT(test_result)
691 :
692 : TYPE(cp_parser_type), INTENT(INOUT) :: parser
693 : INTEGER, INTENT(IN), OPTIONAL :: string_length
694 : CHARACTER(LEN=3) :: test_result
695 :
696 : CHARACTER(LEN=max_line_length) :: error_message, string
697 : INTEGER :: iz, n
698 : LOGICAL :: ilist_in_use
699 : REAL(KIND=dp) :: fz
700 :
701 4368399 : test_result = ""
702 :
703 : ! Store current status
704 4368399 : CALL parser_store_status(parser)
705 :
706 : ! Handle possible list of integers
707 4368399 : ilist_in_use = parser%ilist%in_use .AND. (parser%ilist%ipresent < parser%ilist%iend)
708 : IF (ilist_in_use) THEN
709 14256 : test_result = "INT"
710 14256 : CALL parser_retrieve_status(parser)
711 3622339 : RETURN
712 : END IF
713 :
714 : ! Otherwise continue normally
715 4354143 : IF (PRESENT(string_length)) THEN
716 0 : CALL parser_next_token(parser, string_length=string_length)
717 : ELSE
718 4354143 : CALL parser_next_token(parser)
719 : END IF
720 :
721 : ! End of line
722 4354143 : IF (parser%icol1 > parser%icol2) THEN
723 1509506 : test_result = "EOL"
724 1509506 : CALL parser_retrieve_status(parser)
725 1509506 : RETURN
726 : END IF
727 :
728 2844637 : string = parser%input_line(parser%icol1:parser%icol2)
729 2844637 : n = LEN_TRIM(string)
730 :
731 2844637 : IF (n == 0) THEN
732 0 : test_result = "STR"
733 0 : CALL parser_retrieve_status(parser)
734 0 : RETURN
735 : END IF
736 :
737 : ! Check for end section string
738 2844637 : IF (string(1:n) == parser%end_section) THEN
739 0 : test_result = "EOS"
740 0 : CALL parser_retrieve_status(parser)
741 0 : RETURN
742 : END IF
743 :
744 : ! Check for integer object
745 2844637 : error_message = ""
746 2844637 : CALL read_integer_object(string(1:n), iz, error_message)
747 2844637 : IF (LEN_TRIM(error_message) == 0) THEN
748 1289551 : test_result = "INT"
749 1289551 : CALL parser_retrieve_status(parser)
750 1289551 : RETURN
751 : END IF
752 :
753 : ! Check for floating point object
754 1555086 : error_message = ""
755 1555086 : CALL read_float_object(string(1:n), fz, error_message)
756 1555086 : IF (LEN_TRIM(error_message) == 0) THEN
757 809026 : test_result = "FLT"
758 809026 : CALL parser_retrieve_status(parser)
759 809026 : RETURN
760 : END IF
761 :
762 746060 : test_result = "STR"
763 746060 : CALL parser_retrieve_status(parser)
764 :
765 : END FUNCTION parser_test_next_token
766 :
767 : ! **************************************************************************************************
768 : !> \brief Search a string pattern in a file defined by its logical unit
769 : !> number "unit". A case sensitive search is performed, if
770 : !> ignore_case is .FALSE..
771 : !> begin_line: give back the parser at the beginning of the line
772 : !> matching the search
773 : !> \param parser ...
774 : !> \param string ...
775 : !> \param ignore_case ...
776 : !> \param found ...
777 : !> \param line ...
778 : !> \param begin_line ...
779 : !> \param search_from_begin_of_file ...
780 : !> \date 05.10.1999
781 : !> \author MK
782 : !> \note 08.2008 [tlaino] - Teodoro Laino UZH : updated for buffer
783 : ! **************************************************************************************************
784 140979 : SUBROUTINE parser_search_string(parser, string, ignore_case, found, line, begin_line, &
785 : search_from_begin_of_file)
786 :
787 : TYPE(cp_parser_type), INTENT(INOUT) :: parser
788 : CHARACTER(LEN=*), INTENT(IN) :: string
789 : LOGICAL, INTENT(IN) :: ignore_case
790 : LOGICAL, INTENT(OUT) :: found
791 : CHARACTER(LEN=*), INTENT(OUT), OPTIONAL :: line
792 : LOGICAL, INTENT(IN), OPTIONAL :: begin_line, search_from_begin_of_file
793 :
794 140979 : CHARACTER(LEN=LEN(string)) :: pattern
795 : CHARACTER(LEN=max_line_length+1) :: current_line
796 : INTEGER :: ipattern
797 : LOGICAL :: at_end, begin, do_reset
798 :
799 140979 : found = .FALSE.
800 140979 : begin = .FALSE.
801 140979 : do_reset = .FALSE.
802 66292 : IF (PRESENT(begin_line)) begin = begin_line
803 140979 : IF (PRESENT(search_from_begin_of_file)) do_reset = search_from_begin_of_file
804 140979 : IF (PRESENT(line)) line = ""
805 :
806 : ! Search for string pattern
807 140979 : pattern = string
808 140979 : IF (ignore_case) CALL uppercase(pattern)
809 140979 : IF (do_reset) CALL parser_reset(parser)
810 : DO
811 : ! This call is buffered.. so should not represent any bottleneck
812 32110298 : CALL parser_get_next_line(parser, 1, at_end=at_end)
813 :
814 : ! Exit loop, if the end of file is reached
815 32110298 : IF (at_end) EXIT
816 :
817 : ! Check the current line for string pattern
818 32101510 : current_line = parser%input_line
819 32101510 : IF (ignore_case) CALL uppercase(current_line)
820 32101510 : ipattern = INDEX(current_line, TRIM(pattern))
821 :
822 32110298 : IF (ipattern > 0) THEN
823 132191 : found = .TRUE.
824 132191 : parser%icol = ipattern - 1
825 132191 : IF (PRESENT(line)) THEN
826 73704 : IF (LEN(line) < LEN_TRIM(parser%input_line)) THEN
827 : CALL cp_warn(__LOCATION__, &
828 : "The returned input line has more than "// &
829 : TRIM(ADJUSTL(cp_to_string(LEN(line))))// &
830 : " characters and is therefore too long to fit in the "// &
831 : "specified variable"// &
832 0 : TRIM(parser_location(parser)))
833 : END IF
834 : END IF
835 : EXIT
836 : END IF
837 :
838 : END DO
839 :
840 140979 : IF (found) THEN
841 132191 : IF (begin) parser%icol = 0
842 : END IF
843 :
844 140979 : IF (found) THEN
845 132191 : IF (PRESENT(line)) line = parser%input_line
846 132191 : IF (.NOT. begin) CALL parser_next_token(parser)
847 : END IF
848 :
849 140979 : END SUBROUTINE parser_search_string
850 :
851 : ! **************************************************************************************************
852 : !> \brief Check, if the string object contains an object of type integer.
853 : !> \param string ...
854 : !> \return ...
855 : !> \date 22.11.1999
856 : !> \author Matthias Krack (MK)
857 : !> \version 1.0
858 : !> \note - Introducing the possibility to parse a range of integers INT1..INT2
859 : !> Teodoro Laino [tlaino] - University of Zurich - 08.2008
860 : !> - Parse also a product of integer numbers (23.11.2012,MK)
861 : ! **************************************************************************************************
862 1712939 : ELEMENTAL FUNCTION integer_object(string) RESULT(contains_integer_object)
863 :
864 : CHARACTER(LEN=*), INTENT(IN) :: string
865 : LOGICAL :: contains_integer_object
866 :
867 : INTEGER :: i, idots, istar, n
868 :
869 1712939 : contains_integer_object = .TRUE.
870 1712939 : n = LEN_TRIM(string)
871 :
872 1712939 : IF (n == 0) THEN
873 1712939 : contains_integer_object = .FALSE.
874 : RETURN
875 : END IF
876 :
877 1712939 : idots = INDEX(string(1:n), "..")
878 1712939 : istar = INDEX(string(1:n), "*")
879 :
880 1712939 : IF (idots /= 0) THEN
881 : contains_integer_object = is_integer(string(1:idots - 1)) .AND. &
882 14874 : is_integer(string(idots + 2:n))
883 1698065 : ELSE IF (istar /= 0) THEN
884 : i = 1
885 64 : DO WHILE (istar /= 0)
886 36 : IF (.NOT. is_integer(string(i:i + istar - 2))) THEN
887 1712939 : contains_integer_object = .FALSE.
888 : RETURN
889 : END IF
890 36 : i = i + istar
891 64 : istar = INDEX(string(i:n), "*")
892 : END DO
893 28 : contains_integer_object = is_integer(string(i:n))
894 : ELSE
895 1698037 : contains_integer_object = is_integer(string(1:n))
896 : END IF
897 :
898 : END FUNCTION integer_object
899 :
900 : ! **************************************************************************************************
901 : !> \brief ...
902 : !> \param string ...
903 : !> \return ...
904 : ! **************************************************************************************************
905 1727849 : ELEMENTAL FUNCTION is_integer(string) RESULT(check)
906 :
907 : CHARACTER(LEN=*), INTENT(IN) :: string
908 : LOGICAL :: check
909 :
910 : INTEGER :: i, n
911 :
912 1727849 : check = .TRUE.
913 1727849 : n = LEN_TRIM(string)
914 :
915 1727849 : IF (n == 0) THEN
916 1727849 : check = .FALSE.
917 : RETURN
918 : END IF
919 :
920 1727849 : IF ((INDEX("+-", string(1:1)) > 0) .AND. (n == 1)) THEN
921 1727849 : check = .FALSE.
922 : RETURN
923 : END IF
924 :
925 1727849 : IF (INDEX("+-0123456789", string(1:1)) == 0) THEN
926 1727849 : check = .FALSE.
927 : RETURN
928 : END IF
929 :
930 5005651 : DO i = 2, n
931 5005651 : IF (INDEX("0123456789", string(i:i)) == 0) THEN
932 1727849 : check = .FALSE.
933 : RETURN
934 : END IF
935 : END DO
936 :
937 : END FUNCTION is_integer
938 :
939 : ! **************************************************************************************************
940 : !> \brief Read an integer number.
941 : !> \param parser ...
942 : !> \param object ...
943 : !> \param newline ...
944 : !> \param skip_lines ...
945 : !> \param string_length ...
946 : !> \param at_end ...
947 : !> \date 22.11.1999
948 : !> \author Matthias Krack (MK)
949 : !> \version 1.0
950 : ! **************************************************************************************************
951 3425878 : SUBROUTINE parser_get_integer(parser, object, newline, skip_lines, &
952 : string_length, at_end)
953 :
954 : TYPE(cp_parser_type), INTENT(INOUT) :: parser
955 : INTEGER, INTENT(OUT) :: object
956 : LOGICAL, INTENT(IN), OPTIONAL :: newline
957 : INTEGER, INTENT(IN), OPTIONAL :: skip_lines, string_length
958 : LOGICAL, INTENT(out), OPTIONAL :: at_end
959 :
960 : CHARACTER(LEN=max_line_length) :: error_message
961 : INTEGER :: nline
962 : LOGICAL :: my_at_end
963 :
964 1712939 : IF (PRESENT(skip_lines)) THEN
965 0 : nline = skip_lines
966 : ELSE
967 1712939 : nline = 0
968 : END IF
969 :
970 1712939 : IF (PRESENT(newline)) THEN
971 50263 : IF (newline) nline = nline + 1
972 : END IF
973 :
974 1712939 : CALL parser_get_next_line(parser, nline, at_end=my_at_end)
975 1712939 : IF (PRESENT(at_end)) THEN
976 0 : at_end = my_at_end
977 0 : IF (my_at_end) RETURN
978 1712939 : ELSE IF (my_at_end) THEN
979 0 : CPABORT("Unexpected EOF"//TRIM(parser_location(parser)))
980 : END IF
981 :
982 1712939 : IF (parser%ilist%in_use) THEN
983 14264 : CALL ilist_update(parser%ilist)
984 : ELSE
985 1698675 : IF (PRESENT(string_length)) THEN
986 0 : CALL parser_next_token(parser, string_length=string_length)
987 : ELSE
988 1698675 : CALL parser_next_token(parser)
989 : END IF
990 1698675 : IF (parser%icol1 > parser%icol2) THEN
991 0 : parser%icol1 = parser%icol
992 0 : parser%icol2 = parser%icol
993 : CALL cp_abort(__LOCATION__, &
994 : "An integer type object was expected, found end of line"// &
995 0 : TRIM(parser_location(parser)))
996 : END IF
997 : ! Checks for possible lists of integers
998 1698675 : IF (INDEX(parser%input_line(parser%icol1:parser%icol2), "..") /= 0) THEN
999 610 : CALL ilist_setup(parser%ilist, parser%input_line(parser%icol1:parser%icol2))
1000 : END IF
1001 : END IF
1002 :
1003 1712939 : IF (integer_object(parser%input_line(parser%icol1:parser%icol2))) THEN
1004 1712939 : IF (parser%ilist%in_use) THEN
1005 14874 : object = parser%ilist%ipresent
1006 14874 : CALL ilist_reset(parser%ilist)
1007 : ELSE
1008 1698065 : CALL read_integer_object(parser%input_line(parser%icol1:parser%icol2), object, error_message)
1009 1698065 : IF (LEN_TRIM(error_message) > 0) THEN
1010 0 : CPABORT(TRIM(error_message)//TRIM(parser_location(parser)))
1011 : END IF
1012 : END IF
1013 : ELSE
1014 : CALL cp_abort(__LOCATION__, &
1015 : "An integer type object was expected, found <"// &
1016 : parser%input_line(parser%icol1:parser%icol2)//">"// &
1017 0 : TRIM(parser_location(parser)))
1018 : END IF
1019 :
1020 : END SUBROUTINE parser_get_integer
1021 :
1022 : ! **************************************************************************************************
1023 : !> \brief Read a string representing logical object.
1024 : !> \param parser ...
1025 : !> \param object ...
1026 : !> \param newline ...
1027 : !> \param skip_lines ...
1028 : !> \param string_length ...
1029 : !> \param at_end ...
1030 : !> \date 01.04.2003
1031 : !> \par History
1032 : !> - New version (08.07.2003,MK)
1033 : !> \author FM
1034 : !> \version 1.0
1035 : ! **************************************************************************************************
1036 34232 : SUBROUTINE parser_get_logical(parser, object, newline, skip_lines, &
1037 : string_length, at_end)
1038 :
1039 : TYPE(cp_parser_type), INTENT(INOUT) :: parser
1040 : LOGICAL, INTENT(OUT) :: object
1041 : LOGICAL, INTENT(IN), OPTIONAL :: newline
1042 : INTEGER, INTENT(IN), OPTIONAL :: skip_lines, string_length
1043 : LOGICAL, INTENT(out), OPTIONAL :: at_end
1044 :
1045 : CHARACTER(LEN=max_line_length) :: input_string
1046 : INTEGER :: input_string_length, nline
1047 : LOGICAL :: my_at_end
1048 :
1049 17116 : CPASSERT(.NOT. parser%ilist%in_use)
1050 17116 : IF (PRESENT(skip_lines)) THEN
1051 0 : nline = skip_lines
1052 : ELSE
1053 17116 : nline = 0
1054 : END IF
1055 :
1056 17116 : IF (PRESENT(newline)) THEN
1057 0 : IF (newline) nline = nline + 1
1058 : END IF
1059 :
1060 17116 : CALL parser_get_next_line(parser, nline, at_end=my_at_end)
1061 17116 : IF (PRESENT(at_end)) THEN
1062 0 : at_end = my_at_end
1063 0 : IF (my_at_end) RETURN
1064 17116 : ELSE IF (my_at_end) THEN
1065 0 : CPABORT("Unexpected EOF"//TRIM(parser_location(parser)))
1066 : END IF
1067 :
1068 17116 : IF (PRESENT(string_length)) THEN
1069 0 : CALL parser_next_token(parser, string_length=string_length)
1070 : ELSE
1071 17116 : CALL parser_next_token(parser)
1072 : END IF
1073 :
1074 17116 : input_string_length = parser%icol2 - parser%icol1 + 1
1075 :
1076 17116 : IF (input_string_length == 0) THEN
1077 0 : parser%icol1 = parser%icol
1078 0 : parser%icol2 = parser%icol
1079 : CALL cp_abort(__LOCATION__, &
1080 : "A string representing a logical object was expected, found end of line"// &
1081 0 : TRIM(parser_location(parser)))
1082 : ELSE
1083 17116 : input_string = ""
1084 17116 : input_string(:input_string_length) = parser%input_line(parser%icol1:parser%icol2)
1085 : END IF
1086 17116 : CALL uppercase(input_string)
1087 :
1088 23250 : SELECT CASE (TRIM(input_string))
1089 : CASE ("0", "F", ".F.", "FALSE", ".FALSE.", "N", "NO", "OFF")
1090 6134 : object = .FALSE.
1091 : CASE ("1", "T", ".T.", "TRUE", ".TRUE.", "Y", "YES", "ON")
1092 10982 : object = .TRUE.
1093 : CASE DEFAULT
1094 : CALL cp_abort(__LOCATION__, &
1095 : "A string representing a logical object was expected, found <"// &
1096 17116 : TRIM(input_string)//">"//TRIM(parser_location(parser)))
1097 : END SELECT
1098 :
1099 : END SUBROUTINE parser_get_logical
1100 :
1101 : ! **************************************************************************************************
1102 : !> \brief Read a floating point number.
1103 : !> \param parser ...
1104 : !> \param object ...
1105 : !> \param newline ...
1106 : !> \param skip_lines ...
1107 : !> \param string_length ...
1108 : !> \param at_end ...
1109 : !> \date 22.11.1999
1110 : !> \author Matthias Krack (MK)
1111 : !> \version 1.0
1112 : ! **************************************************************************************************
1113 2704934 : SUBROUTINE parser_get_real(parser, object, newline, skip_lines, string_length, &
1114 : at_end)
1115 :
1116 : TYPE(cp_parser_type), INTENT(INOUT) :: parser
1117 : REAL(KIND=dp), INTENT(OUT) :: object
1118 : LOGICAL, INTENT(IN), OPTIONAL :: newline
1119 : INTEGER, INTENT(IN), OPTIONAL :: skip_lines, string_length
1120 : LOGICAL, INTENT(out), OPTIONAL :: at_end
1121 :
1122 : CHARACTER(LEN=max_line_length) :: error_message
1123 : INTEGER :: nline
1124 : LOGICAL :: my_at_end
1125 :
1126 1352467 : CPASSERT(.NOT. parser%ilist%in_use)
1127 :
1128 1352467 : IF (PRESENT(skip_lines)) THEN
1129 0 : nline = skip_lines
1130 : ELSE
1131 1352467 : nline = 0
1132 : END IF
1133 :
1134 1352467 : IF (PRESENT(newline)) THEN
1135 83591 : IF (newline) nline = nline + 1
1136 : END IF
1137 :
1138 1352467 : CALL parser_get_next_line(parser, nline, at_end=my_at_end)
1139 1352467 : IF (PRESENT(at_end)) THEN
1140 0 : at_end = my_at_end
1141 0 : IF (my_at_end) RETURN
1142 1352467 : ELSE IF (my_at_end) THEN
1143 0 : CPABORT("Unexpected EOF"//TRIM(parser_location(parser)))
1144 : END IF
1145 :
1146 1352467 : IF (PRESENT(string_length)) THEN
1147 0 : CALL parser_next_token(parser, string_length=string_length)
1148 : ELSE
1149 1352467 : CALL parser_next_token(parser)
1150 : END IF
1151 :
1152 1352467 : IF (parser%icol1 > parser%icol2) THEN
1153 0 : parser%icol1 = parser%icol
1154 0 : parser%icol2 = parser%icol
1155 : CALL cp_abort(__LOCATION__, &
1156 : "A floating point type object was expected, found end of the line"// &
1157 0 : TRIM(parser_location(parser)))
1158 : END IF
1159 :
1160 : ! Possibility to have real numbers described in the input as division between two numbers
1161 1352467 : CALL read_float_object(parser%input_line(parser%icol1:parser%icol2), object, error_message)
1162 1352467 : IF (LEN_TRIM(error_message) > 0) THEN
1163 0 : CPABORT(TRIM(error_message)//TRIM(parser_location(parser)))
1164 : END IF
1165 :
1166 : END SUBROUTINE parser_get_real
1167 :
1168 : ! **************************************************************************************************
1169 : !> \brief Read a string.
1170 : !> \param parser ...
1171 : !> \param object ...
1172 : !> \param lower_to_upper ...
1173 : !> \param newline ...
1174 : !> \param skip_lines ...
1175 : !> \param string_length ...
1176 : !> \param at_end ...
1177 : !> \date 22.11.1999
1178 : !> \author Matthias Krack (MK)
1179 : !> \version 1.0
1180 : ! **************************************************************************************************
1181 4605004 : SUBROUTINE parser_get_string(parser, object, lower_to_upper, newline, skip_lines, &
1182 : string_length, at_end)
1183 :
1184 : TYPE(cp_parser_type), INTENT(INOUT) :: parser
1185 : CHARACTER(LEN=*), INTENT(OUT) :: object
1186 : LOGICAL, INTENT(IN), OPTIONAL :: lower_to_upper, newline
1187 : INTEGER, INTENT(IN), OPTIONAL :: skip_lines, string_length
1188 : LOGICAL, INTENT(out), OPTIONAL :: at_end
1189 :
1190 : INTEGER :: input_string_length, nline
1191 : LOGICAL :: my_at_end
1192 :
1193 2302502 : object = ""
1194 2302502 : CPASSERT(.NOT. parser%ilist%in_use)
1195 2302502 : IF (PRESENT(skip_lines)) THEN
1196 0 : nline = skip_lines
1197 : ELSE
1198 2302502 : nline = 0
1199 : END IF
1200 :
1201 2302502 : IF (PRESENT(newline)) THEN
1202 1224573 : IF (newline) nline = nline + 1
1203 : END IF
1204 :
1205 2302502 : CALL parser_get_next_line(parser, nline, at_end=my_at_end)
1206 2302502 : IF (PRESENT(at_end)) THEN
1207 1053190 : at_end = my_at_end
1208 1053190 : IF (my_at_end) RETURN
1209 1249312 : ELSE IF (my_at_end) THEN
1210 : CALL cp_abort(__LOCATION__, &
1211 0 : "Unexpected EOF"//TRIM(parser_location(parser)))
1212 : END IF
1213 :
1214 2293418 : IF (PRESENT(string_length)) THEN
1215 287093 : CALL parser_next_token(parser, string_length=string_length)
1216 : ELSE
1217 2006325 : CALL parser_next_token(parser)
1218 : END IF
1219 :
1220 2293418 : input_string_length = parser%icol2 - parser%icol1 + 1
1221 :
1222 2293418 : IF (input_string_length <= 0) THEN
1223 : CALL cp_abort(__LOCATION__, &
1224 : "A string type object was expected, found end of line"// &
1225 0 : TRIM(parser_location(parser)))
1226 2293418 : ELSE IF (input_string_length > LEN(object)) THEN
1227 : CALL cp_abort(__LOCATION__, &
1228 : "The input string <"//parser%input_line(parser%icol1:parser%icol2)// &
1229 : "> has more than "//cp_to_string(LEN(object))// &
1230 : " characters and is therefore too long to fit in the "// &
1231 0 : "specified variable"//TRIM(parser_location(parser)))
1232 0 : object = parser%input_line(parser%icol1:parser%icol1 + LEN(object) - 1)
1233 : ELSE
1234 2293418 : object(:input_string_length) = parser%input_line(parser%icol1:parser%icol2)
1235 : END IF
1236 :
1237 : ! Convert lowercase to uppercase, if requested
1238 2293418 : IF (PRESENT(lower_to_upper)) THEN
1239 1357735 : IF (lower_to_upper) CALL uppercase(object)
1240 : END IF
1241 :
1242 2302502 : END SUBROUTINE parser_get_string
1243 :
1244 : ! **************************************************************************************************
1245 : !> \brief Returns a floating point number read from a string including
1246 : !> fraction like z1/z2.
1247 : !> \param string ...
1248 : !> \param object ...
1249 : !> \param error_message ...
1250 : !> \date 11.01.2011 (MK)
1251 : !> \par History
1252 : !> - Add simple function parsing (17.05.2023, MK)
1253 : !> \author Matthias Krack
1254 : !> \version 2.0
1255 : !> \note - Parse also multiple products and fractions of floating point numbers (23.11.2012,MK)
1256 : ! **************************************************************************************************
1257 3504823 : ELEMENTAL SUBROUTINE read_float_object(string, object, error_message)
1258 :
1259 : CHARACTER(LEN=*), INTENT(IN) :: string
1260 : REAL(KIND=dp), INTENT(OUT) :: object
1261 : CHARACTER(LEN=*), INTENT(OUT) :: error_message
1262 :
1263 : INTEGER, PARAMETER :: maxlen = 5
1264 :
1265 : CHARACTER(LEN=maxlen) :: func
1266 : INTEGER :: i, ileft, iop, iright, is, islash, &
1267 : istar, istat, n
1268 : LOGICAL :: parsing_done
1269 : REAL(KIND=dp) :: fsign, z
1270 :
1271 3504823 : error_message = ""
1272 3504823 : func = ""
1273 :
1274 3504823 : i = 1
1275 3504823 : iop = 0
1276 3504823 : n = LEN_TRIM(string)
1277 :
1278 3504823 : parsing_done = .FALSE.
1279 :
1280 6268020 : DO WHILE (.NOT. parsing_done)
1281 3509257 : i = i + iop
1282 3509257 : islash = INDEX(string(i:n), "/")
1283 3509257 : istar = INDEX(string(i:n), "*")
1284 3509257 : IF ((islash == 0) .AND. (istar == 0)) THEN
1285 : ! Last factor found: read it and then exit the loop
1286 3492782 : iop = n - i + 2
1287 3492782 : parsing_done = .TRUE.
1288 16475 : ELSE IF ((islash > 0) .AND. (istar > 0)) THEN
1289 6308 : iop = MIN(islash, istar)
1290 10167 : ELSE IF (islash > 0) THEN
1291 : iop = islash
1292 4270 : ELSE IF (istar > 0) THEN
1293 4270 : iop = istar
1294 : END IF
1295 3509257 : ileft = INDEX(string(i:MIN(n, i + maxlen + 1)), "(")
1296 3509257 : IF (ileft > 0) THEN
1297 : ! Check for sign
1298 284 : is = ICHAR(string(i:i))
1299 12 : SELECT CASE (is)
1300 : CASE (43)
1301 12 : fsign = 1.0_dp
1302 12 : func = string(i + 1:i + ileft - 2)
1303 : CASE (45)
1304 22 : fsign = -1.0_dp
1305 22 : func = string(i + 1:i + ileft - 2)
1306 : CASE DEFAULT
1307 250 : fsign = 1.0_dp
1308 284 : func = string(i:i + ileft - 2)
1309 : END SELECT
1310 284 : iright = INDEX(string(i:n), ")")
1311 284 : READ (UNIT=string(i + ileft:i + iright - 2), FMT=*, IOSTAT=istat) z
1312 284 : IF (istat /= 0) THEN
1313 : error_message = "A floating point type object as argument for function <"// &
1314 : TRIM(func)//"> is expected, found <"// &
1315 184 : string(i + ileft:i + iright - 2)//">"
1316 746060 : RETURN
1317 : END IF
1318 8 : SELECT CASE (func)
1319 : CASE ("COS")
1320 8 : z = fsign*COS(z*radians)
1321 : CASE ("EXP")
1322 4 : z = fsign*EXP(z)
1323 : CASE ("LOG")
1324 4 : z = fsign*LOG(z)
1325 : CASE ("LOG10")
1326 4 : z = fsign*LOG10(z)
1327 : CASE ("SIN")
1328 6 : z = fsign*SIN(z*radians)
1329 : CASE ("SQRT")
1330 4 : z = fsign*SQRT(z)
1331 : CASE ("TAN")
1332 4 : z = fsign*TAN(z*radians)
1333 : CASE DEFAULT
1334 66 : error_message = "Unknown function <"//TRIM(func)//"> found"
1335 100 : RETURN
1336 : END SELECT
1337 : ELSE
1338 3508973 : READ (UNIT=string(i:i + iop - 2), FMT=*, IOSTAT=istat) z
1339 3508973 : IF (istat /= 0) THEN
1340 : error_message = "A floating point type object was expected, found <"// &
1341 745810 : string(i:i + iop - 2)//">"
1342 745810 : RETURN
1343 : END IF
1344 : END IF
1345 5521960 : IF (i == 1) THEN
1346 2762057 : object = z
1347 1140 : ELSE IF (string(i - 1:i - 1) == "*") THEN
1348 112 : object = object*z
1349 : ELSE
1350 1028 : IF (z == 0.0_dp) THEN
1351 : error_message = "Division by zero found <"// &
1352 0 : string(i:i + iop - 2)//">"
1353 0 : RETURN
1354 : ELSE
1355 1028 : object = object/z
1356 : END IF
1357 : END IF
1358 : END DO
1359 :
1360 3504823 : END SUBROUTINE read_float_object
1361 :
1362 : ! **************************************************************************************************
1363 : !> \brief Returns an integer number read from a string including products of
1364 : !> integer numbers like iz1*iz2*iz3
1365 : !> \param string ...
1366 : !> \param object ...
1367 : !> \param error_message ...
1368 : !> \date 23.11.2012 (MK)
1369 : !> \author Matthias Krack
1370 : !> \version 1.0
1371 : !> \note - Parse also (multiple) products of integer numbers (23.11.2012,MK)
1372 : ! **************************************************************************************************
1373 4578298 : ELEMENTAL SUBROUTINE read_integer_object(string, object, error_message)
1374 :
1375 : CHARACTER(LEN=*), INTENT(IN) :: string
1376 : INTEGER, INTENT(OUT) :: object
1377 : CHARACTER(LEN=*), INTENT(OUT) :: error_message
1378 :
1379 : CHARACTER(LEN=20) :: fmtstr
1380 : INTEGER :: i, iop, istat, n
1381 : INTEGER(KIND=int_8) :: iz8, object8
1382 : LOGICAL :: parsing_done
1383 :
1384 4578298 : error_message = ""
1385 :
1386 4578298 : i = 1
1387 4578298 : iop = 0
1388 4578298 : n = LEN_TRIM(string)
1389 :
1390 4578298 : parsing_done = .FALSE.
1391 :
1392 7569106 : DO WHILE (.NOT. parsing_done)
1393 4581458 : i = i + iop
1394 : ! note that INDEX always starts counting from 1 if found. Thus iop
1395 : ! will give the length of the integer number plus 1
1396 4581458 : iop = INDEX(string(i:n), "*")
1397 4581458 : IF (iop == 0) THEN
1398 : ! Last factor found: read it and then exit the loop
1399 : ! note that iop will always be the length of one integer plus 1
1400 : ! and we still need to calculate it here as it is need for fmtstr
1401 : ! below to determine integer format length
1402 4570898 : iop = n - i + 2
1403 4570898 : parsing_done = .TRUE.
1404 : END IF
1405 4581458 : istat = 1
1406 4581458 : IF (iop - 1 > 0) THEN
1407 : ! need an explicit fmtstr here. With 'FMT=*' compilers from intel and pgi will also
1408 : ! read float numbers as integers, without setting istat non-zero, i.e. string="0.3", istat=0, iz8=0
1409 : ! this leads to wrong CP2K results (e.g. parsing force fields).
1410 4581456 : WRITE (fmtstr, FMT='(A,I0,A)') '(I', iop - 1, ')'
1411 4581456 : READ (UNIT=string(i:i + iop - 2), FMT=fmtstr, IOSTAT=istat) iz8
1412 : END IF
1413 4581458 : IF (istat /= 0) THEN
1414 : error_message = "An integer type object was expected, found <"// &
1415 1590650 : string(i:i + iop - 2)//">"
1416 1590650 : RETURN
1417 : END IF
1418 2990808 : IF (i == 1) THEN
1419 2990736 : object8 = iz8
1420 : ELSE
1421 72 : object8 = object8*iz8
1422 : END IF
1423 5978456 : IF (ABS(object8) > HUGE(0)) THEN
1424 : error_message = "The specified integer number <"//string(i:i + iop - 2)// &
1425 0 : "> exceeds the allowed range of a 32-bit integer number."
1426 0 : RETURN
1427 : END IF
1428 : END DO
1429 :
1430 2987648 : object = INT(object8)
1431 :
1432 4578298 : END SUBROUTINE read_integer_object
1433 :
1434 : END MODULE cp_parser_methods
|
