(git:a145afa)
Loading...
Searching...
No Matches
cp_parser_methods.F
Go to the documentation of this file.
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! **************************************************************************************************
20MODULE 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
61CONTAINS
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 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 ", Column: "//trim(adjustl(cp_to_string(parser%icol)))
78 IF (parser%icol == -1) THEN
79 res(len_trim(res):) = " (EOF)"
80 ELSE IF (max(1, parser%icol1) <= parser%icol2) THEN
81 res(len_trim(res):) = ", Chunk: <"// &
82 parser%input_line(max(1, parser%icol1):parser%icol2)//">"
83 END IF
84
85 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 SUBROUTINE parser_store_status(parser)
94
95 TYPE(cp_parser_type), INTENT(INOUT) :: parser
96
97 cpassert(ASSOCIATED(parser%status))
98 parser%status%in_use = .true.
99 parser%status%old_input_line = parser%input_line
100 parser%status%old_input_line_number = parser%input_line_number
101 parser%status%old_icol = parser%icol
102 parser%status%old_icol1 = parser%icol1
103 parser%status%old_icol2 = parser%icol2
104 ! Store buffer info
105 CALL copy_buffer_type(parser%buffer, parser%status%buffer)
106
107 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 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 IF (parser%buffer%buffer_id /= parser%status%buffer%buffer_id) THEN
121 CALL initialize_sub_buffer(parser%buffer%sub_buffer, parser%buffer)
122 END IF
123 parser%status%in_use = .false.
124 parser%input_line = parser%status%old_input_line
125 parser%input_line_number = parser%status%old_input_line_number
126 parser%icol = parser%status%old_icol
127 parser%icol1 = parser%status%old_icol1
128 parser%icol2 = parser%status%old_icol2
129
130 ! Retrieve buffer info
131 CALL copy_buffer_type(parser%status%buffer, parser%buffer)
132
133 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 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 CALL timeset(routinen, handle)
157
158 IF (PRESENT(at_end)) at_end = .false.
159
160 DO iline = 1, nline
161 ! Try to read the next line from the buffer
162 CALL parser_get_line_from_buffer(parser, istat)
163
164 ! Handle (persisting) read errors
165 IF (istat /= 0) THEN
166 IF (istat < 0) THEN ! EOF/EOR is negative other errors positive
167 IF (PRESENT(at_end)) THEN
168 at_end = .true.
169 ELSE
170 cpabort("Unexpected EOF"//trim(parser_location(parser)))
171 END IF
172 parser%icol = -1
173 parser%icol1 = 0
174 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 trim(parser_location(parser)))
180 END IF
181 CALL timestop(handle)
182 RETURN
183 END IF
184 END DO
185
186 ! Reset column pointer, if a new line was read
187 IF (nline > 0) parser%icol = 0
188
189 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 SUBROUTINE parser_get_line_from_buffer(parser, istat)
200
201 TYPE(cp_parser_type), INTENT(INOUT) :: parser
202 INTEGER, INTENT(OUT) :: istat
203
204 istat = 0
205 ! Check buffer
206 IF (parser%buffer%present_line_number == parser%buffer%size) THEN
207 IF (ASSOCIATED(parser%buffer%sub_buffer)) THEN
208 ! If the sub_buffer is initialized let's restore its buffer
209 CALL finalize_sub_buffer(parser%buffer%sub_buffer, parser%buffer)
210 ELSE
211 ! Rebuffer input file if required
212 CALL parser_read_line_low(parser)
213 END IF
214 END IF
215 parser%buffer%present_line_number = parser%buffer%present_line_number + 1
216 parser%input_line_number = parser%buffer%input_line_numbers(parser%buffer%present_line_number)
217 parser%input_line = parser%buffer%input_lines(parser%buffer%present_line_number)
218 IF ((parser%buffer%istat /= 0) .AND. &
219 (parser%buffer%last_line_number == parser%buffer%present_line_number)) THEN
220 istat = parser%buffer%istat
221 END IF
222
223 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 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 CALL timeset(routinen, handle)
243
244 parser%buffer%input_lines = ""
245 IF (parser%para_env%is_source()) THEN
246 iline = 0
247 istat = 0
248 parser%buffer%buffer_id = parser%buffer%buffer_id + 1
249 parser%buffer%present_line_number = 0
250 parser%buffer%last_line_number = parser%buffer%size
251 last_buffered_line_number = parser%buffer%input_line_numbers(parser%buffer%size)
252 DO WHILE (iline /= parser%buffer%size)
253 ! Increment counters by 1
254 iline = iline + 1
255 last_buffered_line_number = last_buffered_line_number + 1
256
257 ! Try to read the next line from file
258 parser%buffer%input_line_numbers(iline) = last_buffered_line_number
259 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 IF (istat == 0) THEN
265 islen = len_trim(parser%buffer%input_lines(iline))
266 this_line_is_white_or_comment = is_comment_line(parser, parser%buffer%input_lines(iline))
267 IF (.NOT. this_line_is_white_or_comment .AND. parser%apply_preprocessing) THEN
268 imark = index(parser%buffer%input_lines(iline) (1:islen), "$")
269 IF (imark /= 0) THEN
270 CALL inpp_expand_variables(parser%inpp, parser%buffer%input_lines(iline), &
271 parser%input_file_name, parser%buffer%input_line_numbers(iline))
272 islen = len_trim(parser%buffer%input_lines(iline))
273 END IF
274 imark = index(parser%buffer%input_lines(iline) (1:islen), "@")
275 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 parser%input_unit)
279 islen = len_trim(parser%buffer%input_lines(iline))
280 ! Handle index and cycle
281 last_buffered_line_number = 0
282 iline = iline - 1
283 cycle
284 END IF
285
286 ! after preprocessor parsing could the line be empty again
287 this_line_is_white_or_comment = is_comment_line(parser, parser%buffer%input_lines(iline))
288 END IF
289 ELSE IF (istat < 0) THEN ! handle EOF
290 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 parser%buffer%input_line_numbers(iline), parser%input_unit)
294 ! Handle index and cycle
295 last_buffered_line_number = parser%buffer%input_line_numbers(iline)
296 iline = iline - 1
297 cycle
298 END IF
299 END IF
300
301 ! Saving persisting read errors
302 IF (istat /= 0) THEN
303 parser%buffer%istat = istat
304 parser%buffer%last_line_number = iline
305 parser%buffer%input_line_numbers(iline:) = 0
306 parser%buffer%input_lines(iline:) = ""
307 EXIT
308 END IF
309
310 ! Pre-processing and error checking done. Ready for parsing.
311 IF (.NOT. parser%parse_white_lines) THEN
312 non_white_found = .NOT. this_line_is_white_or_comment
313 ELSE
314 non_white_found = .true.
315 END IF
316 IF (.NOT. non_white_found) THEN
317 iline = iline - 1
318 last_buffered_line_number = last_buffered_line_number - 1
319 END IF
320 END DO
321 END IF
322 ! Broadcast buffer informations
323 CALL broadcast_input_information(parser)
324
325 CALL timestop(handle)
326
327 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 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 CALL timeset(routinen, handle)
346
347 para_env => parser%para_env
348 IF (para_env%num_pe > 1) THEN
349 CALL para_env%bcast(parser%buffer%buffer_id)
350 CALL para_env%bcast(parser%buffer%present_line_number)
351 CALL para_env%bcast(parser%buffer%last_line_number)
352 CALL para_env%bcast(parser%buffer%istat)
353 CALL para_env%bcast(parser%buffer%input_line_numbers)
354 CALL para_env%bcast(parser%buffer%input_lines)
355 END IF
356
357 CALL timestop(handle)
358
359 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 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 resval = .true.
379 DO icol = 1, len(line)
380 thischar = line(icol:icol)
381 IF (.NOT. is_whitespace(thischar)) THEN
382 IF (.NOT. is_comment(parser, thischar)) resval = .false.
383 EXIT
384 END IF
385 END DO
386
387 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 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 resval = .false.
405 ! We are in a private function, and parser has been tested before...
406 IF (any(parser%comment_character == testchar)) resval = .true.
407
408 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 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 IF (nline > 0) THEN
429 CALL parser_read_line(parser, nline, at_end=my_at_end)
430 IF (PRESENT(at_end)) THEN
431 at_end = my_at_end
432 ELSE
433 IF (my_at_end) THEN
434 cpabort("Unexpected EOF"//trim(parser_location(parser)))
435 END IF
436 END IF
437 ELSE IF (PRESENT(at_end)) THEN
438 at_end = .false.
439 END IF
440
441 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 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 IF (parser%icol == -1) THEN
460 parser%icol1 = 1
461 parser%icol2 = -1
462 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 parser%icol = parser%icol + 1
470
471 ! Quick return, if the end of line is found
472 IF ((parser%icol > len_trim(parser%input_line)) .OR. &
473 is_comment(parser, parser%input_line(parser%icol:parser%icol))) THEN
474 parser%icol1 = 1
475 parser%icol2 = -1
476 RETURN
477 END IF
478
479 ! Ignore all white space
480 IF (.NOT. is_whitespace(parser%input_line(parser%icol:parser%icol))) THEN
481 ! Check for input line continuation
482 IF (parser%input_line(parser%icol:parser%icol) == parser%continuation_character) THEN
483 inner_loop: DO i = parser%icol + 1, len_trim(parser%input_line)
484 IF (is_whitespace(parser%input_line(i:i))) cycle inner_loop
485 IF (is_comment(parser, parser%input_line(i:i))) THEN
486 EXIT inner_loop
487 ELSE
488 parser%icol1 = i
489 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 parser%continuation_character//"'"//trim(parser_location(parser)))
493 END IF
494 END DO inner_loop
495 CALL parser_get_next_line(parser, 1, at_end=at_end)
496 IF (at_end) THEN
497 CALL cp_abort(__location__, &
498 "Unexpected end of file (EOF) found after line continuation"// &
499 trim(parser_location(parser)))
500 END IF
501 parser%icol = 0
502 cycle outer_loop
503 ELSE
504 parser%icol = parser%icol - 1
505 parser%icol1 = parser%icol
506 parser%icol2 = parser%icol
507 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 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 IF (PRESENT(string_length)) THEN
534 IF (string_length > max_line_length) THEN
535 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 len_trim_inputline = len_trim(parser%input_line)
545
546 IF (length > 0) THEN
547
548 ! Read input string of fixed length (single line)
549
550 ! Check for EOF
551 IF (parser%icol == -1) THEN
552 cpabort("Unexpectetly reached EOF"//trim(parser_location(parser)))
553 END IF
554
555 length = min(len_trim_inputline - parser%icol1 + 1, length)
556 parser%icol1 = parser%icol + 1
557 parser%icol2 = parser%icol + length
558 i = index(parser%input_line(parser%icol1:parser%icol2), parser%quote_character)
559 IF (i > 0) parser%icol2 = parser%icol + i
560 parser%icol = parser%icol2
561
562 ELSE
563
564 ! Variable input string length (automatic multi-line search)
565
566 ! Check for EOF
567 IF (parser%icol == -1) THEN
568 parser%icol1 = 1
569 parser%icol2 = -1
570 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 parser%icol = parser%icol + 1
578
579 ! Quick return, if the end of line is found
580 IF (parser%icol > len_trim_inputline) THEN
581 parser%icol1 = 1
582 parser%icol2 = -1
583 RETURN
584 END IF
585
586 token = parser%input_line(parser%icol:parser%icol)
587
588 IF (is_whitespace(token)) THEN
589 ! Ignore white space
590 cycle outer_loop1
591 ELSE IF (is_comment(parser, token)) THEN
592 parser%icol1 = 1
593 parser%icol2 = -1
594 parser%first_separator = .true.
595 RETURN
596 ELSE IF (token == parser%quote_character) THEN
597 ! Read quoted string
598 parser%icol1 = parser%icol + 1
599 parser%icol2 = parser%icol + index(parser%input_line(parser%icol1:), parser%quote_character)
600 IF (parser%icol2 == parser%icol) THEN
601 parser%icol1 = parser%icol
602 parser%icol2 = parser%icol
603 CALL cp_abort(__location__, &
604 "Unmatched quotation mark found"//trim(parser_location(parser)))
605 ELSE
606 parser%icol = parser%icol2
607 parser%icol2 = parser%icol2 - 1
608 parser%first_separator = .true.
609 RETURN
610 END IF
611 ELSE IF (token == parser%continuation_character) THEN
612 ! Check for input line continuation
613 inner_loop1: DO i = parser%icol + 1, len_trim_inputline
614 IF (is_whitespace(parser%input_line(i:i))) THEN
615 cycle inner_loop1
616 ELSE IF (is_comment(parser, parser%input_line(i:i))) THEN
617 EXIT inner_loop1
618 ELSE
619 parser%icol1 = i
620 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 parser%continuation_character//"'"//trim(parser_location(parser)))
624 END IF
625 END DO inner_loop1
626 CALL parser_get_next_line(parser, 1, at_end=at_end)
627 IF (at_end) THEN
628 CALL cp_abort(__location__, &
629 "Unexpected end of file (EOF) found after line continuation"//trim(parser_location(parser)))
630 END IF
631 len_trim_inputline = len_trim(parser%input_line)
632 cycle outer_loop1
633 ELSE IF (index(parser%separators, token) > 0) THEN
634 IF (parser%first_separator) THEN
635 parser%first_separator = .false.
636 cycle outer_loop1
637 ELSE
638 parser%icol1 = parser%icol
639 parser%icol2 = parser%icol
640 CALL cp_abort(__location__, &
641 "Unexpected separator token '"//token// &
642 "' found"//trim(parser_location(parser)))
643 END IF
644 ELSE
645 parser%icol1 = parser%icol
646 parser%first_separator = .true.
647 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 parser%icol = parser%icol + 1
655 IF (parser%icol > len_trim_inputline) EXIT outer_loop2
656 token = parser%input_line(parser%icol:parser%icol)
657 IF (is_whitespace(token) .OR. is_comment(parser, token) .OR. &
658 (token == parser%continuation_character)) THEN
659 EXIT outer_loop2
660 ELSE IF (index(parser%separators, token) > 0) THEN
661 parser%first_separator = .false.
662 EXIT outer_loop2
663 END IF
664 END DO outer_loop2
665
666 parser%icol2 = parser%icol - 1
667
668 IF (parser%input_line(parser%icol:parser%icol) == &
669 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 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 test_result = ""
703
704 ! Store current status
705 CALL parser_store_status(parser)
706
707 ! Handle possible list of integers
708 ilist_in_use = parser%ilist%in_use .AND. (parser%ilist%ipresent < parser%ilist%iend)
709 IF (ilist_in_use) THEN
710 test_result = "INT"
711 CALL parser_retrieve_status(parser)
712 RETURN
713 END IF
714
715 ! Otherwise continue normally
716 IF (PRESENT(string_length)) THEN
717 CALL parser_next_token(parser, string_length=string_length)
718 ELSE
719 CALL parser_next_token(parser)
720 END IF
721
722 ! End of line
723 IF (parser%icol1 > parser%icol2) THEN
724 test_result = "EOL"
725 CALL parser_retrieve_status(parser)
726 RETURN
727 END IF
728
729 string = parser%input_line(parser%icol1:parser%icol2)
730 n = len_trim(string)
731
732 IF (n == 0) THEN
733 test_result = "STR"
734 CALL parser_retrieve_status(parser)
735 RETURN
736 END IF
737
738 ! Check for end section string
739 IF (string(1:n) == parser%end_section) THEN
740 test_result = "EOS"
741 CALL parser_retrieve_status(parser)
742 RETURN
743 END IF
744
745 ! Check for integer object
746 error_message = ""
747 CALL read_integer_object(string(1:n), iz, error_message)
748 IF (len_trim(error_message) == 0) THEN
749 test_result = "INT"
750 CALL parser_retrieve_status(parser)
751 RETURN
752 END IF
753
754 ! Check for floating point object
755 error_message = ""
756 CALL read_float_object(string(1:n), fz, error_message)
757 IF (len_trim(error_message) == 0) THEN
758 test_result = "FLT"
759 CALL parser_retrieve_status(parser)
760 RETURN
761 END IF
762
763 test_result = "STR"
764 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 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 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 found = .false.
801 begin = .false.
802 do_reset = .false.
803 IF (PRESENT(begin_line)) begin = begin_line
804 IF (PRESENT(search_from_begin_of_file)) do_reset = search_from_begin_of_file
805 IF (PRESENT(line)) line = ""
806
807 ! Search for string pattern
808 pattern = string
809 IF (ignore_case) CALL uppercase(pattern)
810 IF (do_reset) CALL parser_reset(parser)
811 DO
812 ! This call is buffered.. so should not represent any bottleneck
813 CALL parser_get_next_line(parser, 1, at_end=at_end)
814
815 ! Exit loop, if the end of file is reached
816 IF (at_end) EXIT
817
818 ! Check the current line for string pattern
819 current_line = parser%input_line
820 IF (ignore_case) CALL uppercase(current_line)
821 ipattern = index(current_line, trim(pattern))
822
823 IF (ipattern > 0) THEN
824 found = .true.
825 parser%icol = ipattern - 1
826 IF (PRESENT(line)) THEN
827 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 trim(parser_location(parser)))
834 END IF
835 END IF
836 EXIT
837 END IF
838
839 END DO
840
841 IF (found) THEN
842 IF (begin) parser%icol = 0
843 END IF
844
845 IF (found) THEN
846 IF (PRESENT(line)) line = parser%input_line
847 IF (.NOT. begin) CALL parser_next_token(parser)
848 END IF
849
850 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 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 contains_integer_object = .true.
871 n = len_trim(string)
872
873 IF (n == 0) THEN
874 contains_integer_object = .false.
875 RETURN
876 END IF
877
878 idots = index(string(1:n), "..")
879 istar = index(string(1:n), "*")
880
881 IF (idots /= 0) THEN
882 contains_integer_object = is_integer(string(1:idots - 1)) .AND. &
883 is_integer(string(idots + 2:n))
884 ELSE IF (istar /= 0) THEN
885 i = 1
886 DO WHILE (istar /= 0)
887 IF (.NOT. is_integer(string(i:i + istar - 2))) THEN
888 contains_integer_object = .false.
889 RETURN
890 END IF
891 i = i + istar
892 istar = index(string(i:n), "*")
893 END DO
894 contains_integer_object = is_integer(string(i:n))
895 ELSE
896 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 ELEMENTAL FUNCTION is_integer(string) RESULT(check)
907
908 CHARACTER(LEN=*), INTENT(IN) :: string
909 LOGICAL :: check
910
911 INTEGER :: i, n
912
913 check = .true.
914 n = len_trim(string)
915
916 IF (n == 0) THEN
917 check = .false.
918 RETURN
919 END IF
920
921 IF ((index("+-", string(1:1)) > 0) .AND. (n == 1)) THEN
922 check = .false.
923 RETURN
924 END IF
925
926 IF (index("+-0123456789", string(1:1)) == 0) THEN
927 check = .false.
928 RETURN
929 END IF
930
931 DO i = 2, n
932 IF (index("0123456789", string(i:i)) == 0) THEN
933 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 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 IF (PRESENT(skip_lines)) THEN
966 nline = skip_lines
967 ELSE
968 nline = 0
969 END IF
970
971 IF (PRESENT(newline)) THEN
972 IF (newline) nline = nline + 1
973 END IF
974
975 CALL parser_get_next_line(parser, nline, at_end=my_at_end)
976 IF (PRESENT(at_end)) THEN
977 at_end = my_at_end
978 IF (my_at_end) RETURN
979 ELSE IF (my_at_end) THEN
980 cpabort("Unexpected EOF"//trim(parser_location(parser)))
981 END IF
982
983 IF (parser%ilist%in_use) THEN
984 CALL ilist_update(parser%ilist)
985 ELSE
986 IF (PRESENT(string_length)) THEN
987 CALL parser_next_token(parser, string_length=string_length)
988 ELSE
989 CALL parser_next_token(parser)
990 END IF
991 IF (parser%icol1 > parser%icol2) THEN
992 parser%icol1 = parser%icol
993 parser%icol2 = parser%icol
994 CALL cp_abort(__location__, &
995 "An integer type object was expected, found end of line"// &
996 trim(parser_location(parser)))
997 END IF
998 ! Checks for possible lists of integers
999 IF (index(parser%input_line(parser%icol1:parser%icol2), "..") /= 0) THEN
1000 CALL ilist_setup(parser%ilist, parser%input_line(parser%icol1:parser%icol2))
1001 END IF
1002 END IF
1003
1004 IF (integer_object(parser%input_line(parser%icol1:parser%icol2))) THEN
1005 IF (parser%ilist%in_use) THEN
1006 object = parser%ilist%ipresent
1007 CALL ilist_reset(parser%ilist)
1008 ELSE
1009 CALL read_integer_object(parser%input_line(parser%icol1:parser%icol2), object, error_message)
1010 IF (len_trim(error_message) > 0) THEN
1011 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 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 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 cpassert(.NOT. parser%ilist%in_use)
1051 IF (PRESENT(skip_lines)) THEN
1052 nline = skip_lines
1053 ELSE
1054 nline = 0
1055 END IF
1056
1057 IF (PRESENT(newline)) THEN
1058 IF (newline) nline = nline + 1
1059 END IF
1060
1061 CALL parser_get_next_line(parser, nline, at_end=my_at_end)
1062 IF (PRESENT(at_end)) THEN
1063 at_end = my_at_end
1064 IF (my_at_end) RETURN
1065 ELSE IF (my_at_end) THEN
1066 cpabort("Unexpected EOF"//trim(parser_location(parser)))
1067 END IF
1068
1069 IF (PRESENT(string_length)) THEN
1070 CALL parser_next_token(parser, string_length=string_length)
1071 ELSE
1072 CALL parser_next_token(parser)
1073 END IF
1074
1075 input_string_length = parser%icol2 - parser%icol1 + 1
1076
1077 IF (input_string_length == 0) THEN
1078 parser%icol1 = parser%icol
1079 parser%icol2 = parser%icol
1080 CALL cp_abort(__location__, &
1081 "A string representing a logical object was expected, found end of line"// &
1082 trim(parser_location(parser)))
1083 ELSE
1084 input_string = ""
1085 input_string(:input_string_length) = parser%input_line(parser%icol1:parser%icol2)
1086 END IF
1087 CALL uppercase(input_string)
1088
1089 SELECT CASE (trim(input_string))
1090 CASE ("0", "F", ".F.", "FALSE", ".FALSE.", "N", "NO", "OFF")
1091 object = .false.
1092 CASE ("1", "T", ".T.", "TRUE", ".TRUE.", "Y", "YES", "ON")
1093 object = .true.
1094 CASE DEFAULT
1095 CALL cp_abort(__location__, &
1096 "A string representing a logical object was expected, found <"// &
1097 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 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 cpassert(.NOT. parser%ilist%in_use)
1128
1129 IF (PRESENT(skip_lines)) THEN
1130 nline = skip_lines
1131 ELSE
1132 nline = 0
1133 END IF
1134
1135 IF (PRESENT(newline)) THEN
1136 IF (newline) nline = nline + 1
1137 END IF
1138
1139 CALL parser_get_next_line(parser, nline, at_end=my_at_end)
1140 IF (PRESENT(at_end)) THEN
1141 at_end = my_at_end
1142 IF (my_at_end) RETURN
1143 ELSE IF (my_at_end) THEN
1144 cpabort("Unexpected EOF"//trim(parser_location(parser)))
1145 END IF
1146
1147 IF (PRESENT(string_length)) THEN
1148 CALL parser_next_token(parser, string_length=string_length)
1149 ELSE
1150 CALL parser_next_token(parser)
1151 END IF
1152
1153 IF (parser%icol1 > parser%icol2) THEN
1154 parser%icol1 = parser%icol
1155 parser%icol2 = parser%icol
1156 CALL cp_abort(__location__, &
1157 "A floating point type object was expected, found end of the line"// &
1158 trim(parser_location(parser)))
1159 END IF
1160
1161 ! Possibility to have real numbers described in the input as division between two numbers
1162 CALL read_float_object(parser%input_line(parser%icol1:parser%icol2), object, error_message)
1163 IF (len_trim(error_message) > 0) THEN
1164 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 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 object = ""
1195 cpassert(.NOT. parser%ilist%in_use)
1196 IF (PRESENT(skip_lines)) THEN
1197 nline = skip_lines
1198 ELSE
1199 nline = 0
1200 END IF
1201
1202 IF (PRESENT(newline)) THEN
1203 IF (newline) nline = nline + 1
1204 END IF
1205
1206 CALL parser_get_next_line(parser, nline, at_end=my_at_end)
1207 IF (PRESENT(at_end)) THEN
1208 at_end = my_at_end
1209 IF (my_at_end) RETURN
1210 ELSE IF (my_at_end) THEN
1211 CALL cp_abort(__location__, &
1212 "Unexpected EOF"//trim(parser_location(parser)))
1213 END IF
1214
1215 IF (PRESENT(string_length)) THEN
1216 CALL parser_next_token(parser, string_length=string_length)
1217 ELSE
1218 CALL parser_next_token(parser)
1219 END IF
1220
1221 input_string_length = parser%icol2 - parser%icol1 + 1
1222
1223 IF (input_string_length <= 0) THEN
1224 CALL cp_abort(__location__, &
1225 "A string type object was expected, found end of line"// &
1226 trim(parser_location(parser)))
1227 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 "specified variable"//trim(parser_location(parser)))
1233 object = parser%input_line(parser%icol1:parser%icol1 + len(object) - 1)
1234 ELSE
1235 object(:input_string_length) = parser%input_line(parser%icol1:parser%icol2)
1236 END IF
1237
1238 ! Convert lowercase to uppercase, if requested
1239 IF (PRESENT(lower_to_upper)) THEN
1240 IF (lower_to_upper) CALL uppercase(object)
1241 END IF
1242
1243 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 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 error_message = ""
1273 func = ""
1274
1275 i = 1
1276 iop = 0
1277 n = len_trim(string)
1278
1279 parsing_done = .false.
1280
1281 DO WHILE (.NOT. parsing_done)
1282 i = i + iop
1283 islash = index(string(i:n), "/")
1284 istar = index(string(i:n), "*")
1285 IF ((islash == 0) .AND. (istar == 0)) THEN
1286 ! Last factor found: read it and then exit the loop
1287 iop = n - i + 2
1288 parsing_done = .true.
1289 ELSE IF ((islash > 0) .AND. (istar > 0)) THEN
1290 iop = min(islash, istar)
1291 ELSE IF (islash > 0) THEN
1292 iop = islash
1293 ELSE IF (istar > 0) THEN
1294 iop = istar
1295 END IF
1296 ileft = index(string(i:min(n, i + maxlen + 1)), "(")
1297 IF (ileft > 0) THEN
1298 ! Check for sign
1299 is = ichar(string(i:i))
1300 SELECT CASE (is)
1301 CASE (43)
1302 fsign = 1.0_dp
1303 func = string(i + 1:i + ileft - 2)
1304 CASE (45)
1305 fsign = -1.0_dp
1306 func = string(i + 1:i + ileft - 2)
1307 CASE DEFAULT
1308 fsign = 1.0_dp
1309 func = string(i:i + ileft - 2)
1310 END SELECT
1311 iright = index(string(i:n), ")")
1312 READ (unit=string(i + ileft:i + iright - 2), fmt=*, iostat=istat) z
1313 IF (istat /= 0) THEN
1314 error_message = "A floating point type object as argument for function <"// &
1315 trim(func)//"> is expected, found <"// &
1316 string(i + ileft:i + iright - 2)//">"
1317 RETURN
1318 END IF
1319 SELECT CASE (func)
1320 CASE ("COS")
1321 z = fsign*cos(z*radians)
1322 CASE ("EXP")
1323 z = fsign*exp(z)
1324 CASE ("LOG")
1325 z = fsign*log(z)
1326 CASE ("LOG10")
1327 z = fsign*log10(z)
1328 CASE ("SIN")
1329 z = fsign*sin(z*radians)
1330 CASE ("SQRT")
1331 z = fsign*sqrt(z)
1332 CASE ("TAN")
1333 z = fsign*tan(z*radians)
1334 CASE DEFAULT
1335 error_message = "Unknown function <"//trim(func)//"> found"
1336 RETURN
1337 END SELECT
1338 ELSE
1339 READ (unit=string(i:i + iop - 2), fmt=*, iostat=istat) z
1340 IF (istat /= 0) THEN
1341 error_message = "A floating point type object was expected, found <"// &
1342 string(i:i + iop - 2)//">"
1343 RETURN
1344 END IF
1345 END IF
1346 IF (i == 1) THEN
1347 object = z
1348 ELSE IF (string(i - 1:i - 1) == "*") THEN
1349 object = object*z
1350 ELSE
1351 IF (z == 0.0_dp) THEN
1352 error_message = "Division by zero found <"// &
1353 string(i:i + iop - 2)//">"
1354 RETURN
1355 ELSE
1356 object = object/z
1357 END IF
1358 END IF
1359 END DO
1360
1361 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 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 error_message = ""
1386
1387 i = 1
1388 iop = 0
1389 n = len_trim(string)
1390
1391 parsing_done = .false.
1392
1393 DO WHILE (.NOT. parsing_done)
1394 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 iop = index(string(i:n), "*")
1398 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 iop = n - i + 2
1404 parsing_done = .true.
1405 END IF
1406 istat = 1
1407 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 WRITE (fmtstr, fmt='(A,I0,A)') '(I', iop - 1, ')'
1412 READ (unit=string(i:i + iop - 2), fmt=fmtstr, iostat=istat) iz8
1413 END IF
1414 IF (istat /= 0) THEN
1415 error_message = "An integer type object was expected, found <"// &
1416 string(i:i + iop - 2)//">"
1417 RETURN
1418 END IF
1419 IF (i == 1) THEN
1420 object8 = iz8
1421 ELSE
1422 object8 = object8*iz8
1423 END IF
1424 IF (abs(object8) > huge(0)) THEN
1425 error_message = "The specified integer number <"//string(i:i + iop - 2)// &
1426 "> exceeds the allowed range of a 32-bit integer number."
1427 RETURN
1428 END IF
1429 END DO
1430
1431 object = int(object8)
1432
1433 END SUBROUTINE read_integer_object
1434
1435END MODULE cp_parser_methods
cp_log_handling::cp_to_string
Definition cp_log_handling.F:90
cp_parser_methods::parser_get_object
Definition cp_parser_methods.F:54
cp_log_handling
various routines to log and control the output. The idea is that decisions about where to log should ...
Definition cp_log_handling.F:41
cp_parser_buffer_types
a module to allow simple buffering of read lines of a parser
Definition cp_parser_buffer_types.F:13
cp_parser_buffer_types::copy_buffer_type
recursive subroutine, public copy_buffer_type(buffer_in, buffer_out, force)
Copies buffer types.
Definition cp_parser_buffer_types.F:89
cp_parser_buffer_types::initialize_sub_buffer
subroutine, public initialize_sub_buffer(sub_buffer, buffer)
Initializes sub buffer structure.
Definition cp_parser_buffer_types.F:126
cp_parser_buffer_types::finalize_sub_buffer
subroutine, public finalize_sub_buffer(sub_buffer, buffer)
Finalizes sub buffer structure.
Definition cp_parser_buffer_types.F:143
cp_parser_ilist_methods
a module to allow simple internal preprocessing in input files.
Definition cp_parser_ilist_methods.F:17
cp_parser_ilist_methods::ilist_update
subroutine, public ilist_update(ilist)
updates the integer listing type
Definition cp_parser_ilist_methods.F:66
cp_parser_ilist_methods::ilist_setup
subroutine, public ilist_setup(ilist, token)
setup the integer listing type
Definition cp_parser_ilist_methods.F:38
cp_parser_ilist_methods::ilist_reset
subroutine, public ilist_reset(ilist)
updates the integer listing type
Definition cp_parser_ilist_methods.F:82
cp_parser_inpp_methods
a module to allow simple internal preprocessing in input files.
Definition cp_parser_inpp_methods.F:19
cp_parser_inpp_methods::inpp_expand_variables
subroutine, public inpp_expand_variables(inpp, input_line, input_file_name, input_line_number)
expand all ${VAR} or $VAR variable entries on the input string (LTR, no nested vars)
Definition cp_parser_inpp_methods.F:548
cp_parser_inpp_methods::inpp_end_include
subroutine, public inpp_end_include(inpp, input_file_name, input_line_number, input_unit)
Restore older file status from stack after EOF on include file.
Definition cp_parser_inpp_methods.F:518
cp_parser_inpp_methods::inpp_process_directive
subroutine, public inpp_process_directive(inpp, input_line, input_file_name, input_line_number, input_unit)
process internal preprocessor directives like @INCLUDE, @SET, @IF/@ENDIF
Definition cp_parser_inpp_methods.F:88
cp_parser_methods
Utility routines to read data from files. Kept as close as possible to the old parser because.
Definition cp_parser_methods.F:20
cp_parser_methods::parser_read_line
subroutine, public parser_read_line(parser, nline, at_end)
Read the next line from a logical unit "unit" (I/O node only). Skip (nline-1) lines and skip also all...
Definition cp_parser_methods.F:147
cp_parser_methods::read_integer_object
elemental subroutine, public read_integer_object(string, object, error_message)
Returns an integer number read from a string including products of integer numbers like iz1*iz2*iz3.
Definition cp_parser_methods.F:1375
cp_parser_methods::parser_skip_space
subroutine, public parser_skip_space(parser)
Skips the whitespaces.
Definition cp_parser_methods.F:451
cp_parser_methods::parser_get_next_line
subroutine, public parser_get_next_line(parser, nline, at_end)
Read the next input line and broadcast the input information. Skip (nline-1) lines and skip also all ...
Definition cp_parser_methods.F:421
cp_parser_methods::parser_test_next_token
character(len=3) function, public parser_test_next_token(parser, string_length)
Test next input object.
Definition cp_parser_methods.F:692
cp_parser_methods::parser_location
character(len=default_path_length+default_string_length) function, public parser_location(parser)
return a description of the part of the file actually parsed
Definition cp_parser_methods.F:70
cp_parser_methods::read_float_object
elemental subroutine, public read_float_object(string, object, error_message)
Returns a floating point number read from a string including fraction like z1/z2.
Definition cp_parser_methods.F:1259
cp_parser_methods::parser_search_string
subroutine, public parser_search_string(parser, string, ignore_case, found, line, begin_line, search_from_begin_of_file)
Search a string pattern in a file defined by its logical unit number "unit". A case sensitive search ...
Definition cp_parser_methods.F:787
cp_parser_types
Utility routines to read data from files. Kept as close as possible to the old parser because.
Definition cp_parser_types.F:21
cp_parser_types::parser_reset
subroutine, public parser_reset(parser)
Resets the parser: rewinding the unit and re-initializing all parser structures.
Definition cp_parser_types.F:229
kinds
Defines the basic variable types.
Definition kinds.F:23
kinds::max_line_length
integer, parameter, public max_line_length
Definition kinds.F:59
kinds::int_8
integer, parameter, public int_8
Definition kinds.F:54
kinds::dp
integer, parameter, public dp
Definition kinds.F:34
kinds::default_string_length
integer, parameter, public default_string_length
Definition kinds.F:57
kinds::default_path_length
integer, parameter, public default_path_length
Definition kinds.F:58
mathconstants
Definition of mathematical constants and functions.
Definition mathconstants.F:16
mathconstants::radians
real(kind=dp), parameter, public radians
Definition mathconstants.F:139
message_passing
Interface to the message passing library MPI.
Definition message_passing.F:23
string_utilities
Utilities for string manipulations.
Definition string_utilities.F:16
string_utilities::is_whitespace
elemental logical function, public is_whitespace(testchar)
returns .true. if the character passed is a whitespace char.
Definition string_utilities.F:3426
string_utilities::uppercase
elemental subroutine, public uppercase(string)
Convert all lower case characters in a string to upper case.
Definition string_utilities.F:3362
cp_parser_types::cp_parser_type
represent a parser
Definition cp_parser_types.F:77
message_passing::mp_para_env_type
stores all the informations relevant to an mpi environment
Definition message_passing.F:746