(git:374b731)
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-2024 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) &
552 cpabort("Unexpectetly reached EOF"//trim(parser_location(parser)))
553
554 length = min(len_trim_inputline - parser%icol1 + 1, length)
555 parser%icol1 = parser%icol + 1
556 parser%icol2 = parser%icol + length
557 i = index(parser%input_line(parser%icol1:parser%icol2), parser%quote_character)
558 IF (i > 0) parser%icol2 = parser%icol + i
559 parser%icol = parser%icol2
560
561 ELSE
562
563 ! Variable input string length (automatic multi-line search)
564
565 ! Check for EOF
566 IF (parser%icol == -1) THEN
567 parser%icol1 = 1
568 parser%icol2 = -1
569 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 parser%icol = parser%icol + 1
577
578 ! Quick return, if the end of line is found
579 IF (parser%icol > len_trim_inputline) THEN
580 parser%icol1 = 1
581 parser%icol2 = -1
582 RETURN
583 END IF
584
585 token = parser%input_line(parser%icol:parser%icol)
586
587 IF (is_whitespace(token)) THEN
588 ! Ignore white space
589 cycle outer_loop1
590 ELSE IF (is_comment(parser, token)) THEN
591 parser%icol1 = 1
592 parser%icol2 = -1
593 parser%first_separator = .true.
594 RETURN
595 ELSE IF (token == parser%quote_character) THEN
596 ! Read quoted string
597 parser%icol1 = parser%icol + 1
598 parser%icol2 = parser%icol + index(parser%input_line(parser%icol1:), parser%quote_character)
599 IF (parser%icol2 == parser%icol) THEN
600 parser%icol1 = parser%icol
601 parser%icol2 = parser%icol
602 CALL cp_abort(__location__, &
603 "Unmatched quotation mark found"//trim(parser_location(parser)))
604 ELSE
605 parser%icol = parser%icol2
606 parser%icol2 = parser%icol2 - 1
607 parser%first_separator = .true.
608 RETURN
609 END IF
610 ELSE IF (token == parser%continuation_character) THEN
611 ! Check for input line continuation
612 inner_loop1: DO i = parser%icol + 1, len_trim_inputline
613 IF (is_whitespace(parser%input_line(i:i))) THEN
614 cycle inner_loop1
615 ELSE IF (is_comment(parser, parser%input_line(i:i))) THEN
616 EXIT inner_loop1
617 ELSE
618 parser%icol1 = i
619 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 parser%continuation_character//"'"//trim(parser_location(parser)))
623 END IF
624 END DO inner_loop1
625 CALL parser_get_next_line(parser, 1, at_end=at_end)
626 IF (at_end) THEN
627 CALL cp_abort(__location__, &
628 "Unexpected end of file (EOF) found after line continuation"//trim(parser_location(parser)))
629 END IF
630 len_trim_inputline = len_trim(parser%input_line)
631 cycle outer_loop1
632 ELSE IF (index(parser%separators, token) > 0) THEN
633 IF (parser%first_separator) THEN
634 parser%first_separator = .false.
635 cycle outer_loop1
636 ELSE
637 parser%icol1 = parser%icol
638 parser%icol2 = parser%icol
639 CALL cp_abort(__location__, &
640 "Unexpected separator token '"//token// &
641 "' found"//trim(parser_location(parser)))
642 END IF
643 ELSE
644 parser%icol1 = parser%icol
645 parser%first_separator = .true.
646 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 parser%icol = parser%icol + 1
654 IF (parser%icol > len_trim_inputline) EXIT outer_loop2
655 token = parser%input_line(parser%icol:parser%icol)
656 IF (is_whitespace(token) .OR. is_comment(parser, token) .OR. &
657 (token == parser%continuation_character)) THEN
658 EXIT outer_loop2
659 ELSE IF (index(parser%separators, token) > 0) THEN
660 parser%first_separator = .false.
661 EXIT outer_loop2
662 END IF
663 END DO outer_loop2
664
665 parser%icol2 = parser%icol - 1
666
667 IF (parser%input_line(parser%icol:parser%icol) == &
668 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 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 test_result = ""
702
703 ! Store current status
704 CALL parser_store_status(parser)
705
706 ! Handle possible list of integers
707 ilist_in_use = parser%ilist%in_use .AND. (parser%ilist%ipresent < parser%ilist%iend)
708 IF (ilist_in_use) THEN
709 test_result = "INT"
710 CALL parser_retrieve_status(parser)
711 RETURN
712 END IF
713
714 ! Otherwise continue normally
715 IF (PRESENT(string_length)) THEN
716 CALL parser_next_token(parser, string_length=string_length)
717 ELSE
718 CALL parser_next_token(parser)
719 END IF
720
721 ! End of line
722 IF (parser%icol1 > parser%icol2) THEN
723 test_result = "EOL"
724 CALL parser_retrieve_status(parser)
725 RETURN
726 END IF
727
728 string = parser%input_line(parser%icol1:parser%icol2)
729 n = len_trim(string)
730
731 IF (n == 0) THEN
732 test_result = "STR"
733 CALL parser_retrieve_status(parser)
734 RETURN
735 END IF
736
737 ! Check for end section string
738 IF (string(1:n) == parser%end_section) THEN
739 test_result = "EOS"
740 CALL parser_retrieve_status(parser)
741 RETURN
742 END IF
743
744 ! Check for integer object
745 error_message = ""
746 CALL read_integer_object(string(1:n), iz, error_message)
747 IF (len_trim(error_message) == 0) THEN
748 test_result = "INT"
749 CALL parser_retrieve_status(parser)
750 RETURN
751 END IF
752
753 ! Check for floating point object
754 error_message = ""
755 CALL read_float_object(string(1:n), fz, error_message)
756 IF (len_trim(error_message) == 0) THEN
757 test_result = "FLT"
758 CALL parser_retrieve_status(parser)
759 RETURN
760 END IF
761
762 test_result = "STR"
763 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 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 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 found = .false.
800 begin = .false.
801 do_reset = .false.
802 IF (PRESENT(begin_line)) begin = begin_line
803 IF (PRESENT(search_from_begin_of_file)) do_reset = search_from_begin_of_file
804 IF (PRESENT(line)) line = ""
805
806 ! Search for string pattern
807 pattern = string
808 IF (ignore_case) CALL uppercase(pattern)
809 IF (do_reset) CALL parser_reset(parser)
810 DO
811 ! This call is buffered.. so should not represent any bottleneck
812 CALL parser_get_next_line(parser, 1, at_end=at_end)
813
814 ! Exit loop, if the end of file is reached
815 IF (at_end) EXIT
816
817 ! Check the current line for string pattern
818 current_line = parser%input_line
819 IF (ignore_case) CALL uppercase(current_line)
820 ipattern = index(current_line, trim(pattern))
821
822 IF (ipattern > 0) THEN
823 found = .true.
824 parser%icol = ipattern - 1
825 IF (PRESENT(line)) THEN
826 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 trim(parser_location(parser)))
833 END IF
834 END IF
835 EXIT
836 END IF
837
838 END DO
839
840 IF (found) THEN
841 IF (begin) parser%icol = 0
842 END IF
843
844 IF (found) THEN
845 IF (PRESENT(line)) line = parser%input_line
846 IF (.NOT. begin) CALL parser_next_token(parser)
847 END IF
848
849 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 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 contains_integer_object = .true.
870 n = len_trim(string)
871
872 IF (n == 0) THEN
873 contains_integer_object = .false.
874 RETURN
875 END IF
876
877 idots = index(string(1:n), "..")
878 istar = index(string(1:n), "*")
879
880 IF (idots /= 0) THEN
881 contains_integer_object = is_integer(string(1:idots - 1)) .AND. &
882 is_integer(string(idots + 2:n))
883 ELSE IF (istar /= 0) THEN
884 i = 1
885 DO WHILE (istar /= 0)
886 IF (.NOT. is_integer(string(i:i + istar - 2))) THEN
887 contains_integer_object = .false.
888 RETURN
889 END IF
890 i = i + istar
891 istar = index(string(i:n), "*")
892 END DO
893 contains_integer_object = is_integer(string(i:n))
894 ELSE
895 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 ELEMENTAL FUNCTION is_integer(string) RESULT(check)
906
907 CHARACTER(LEN=*), INTENT(IN) :: string
908 LOGICAL :: check
909
910 INTEGER :: i, n
911
912 check = .true.
913 n = len_trim(string)
914
915 IF (n == 0) THEN
916 check = .false.
917 RETURN
918 END IF
919
920 IF ((index("+-", string(1:1)) > 0) .AND. (n == 1)) THEN
921 check = .false.
922 RETURN
923 END IF
924
925 IF (index("+-0123456789", string(1:1)) == 0) THEN
926 check = .false.
927 RETURN
928 END IF
929
930 DO i = 2, n
931 IF (index("0123456789", string(i:i)) == 0) THEN
932 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 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 IF (PRESENT(skip_lines)) THEN
965 nline = skip_lines
966 ELSE
967 nline = 0
968 END IF
969
970 IF (PRESENT(newline)) THEN
971 IF (newline) nline = nline + 1
972 END IF
973
974 CALL parser_get_next_line(parser, nline, at_end=my_at_end)
975 IF (PRESENT(at_end)) THEN
976 at_end = my_at_end
977 IF (my_at_end) RETURN
978 ELSE IF (my_at_end) THEN
979 cpabort("Unexpected EOF"//trim(parser_location(parser)))
980 END IF
981
982 IF (parser%ilist%in_use) THEN
983 CALL ilist_update(parser%ilist)
984 ELSE
985 IF (PRESENT(string_length)) THEN
986 CALL parser_next_token(parser, string_length=string_length)
987 ELSE
988 CALL parser_next_token(parser)
989 END IF
990 IF (parser%icol1 > parser%icol2) THEN
991 parser%icol1 = parser%icol
992 parser%icol2 = parser%icol
993 CALL cp_abort(__location__, &
994 "An integer type object was expected, found end of line"// &
995 trim(parser_location(parser)))
996 END IF
997 ! Checks for possible lists of integers
998 IF (index(parser%input_line(parser%icol1:parser%icol2), "..") /= 0) THEN
999 CALL ilist_setup(parser%ilist, parser%input_line(parser%icol1:parser%icol2))
1000 END IF
1001 END IF
1002
1003 IF (integer_object(parser%input_line(parser%icol1:parser%icol2))) THEN
1004 IF (parser%ilist%in_use) THEN
1005 object = parser%ilist%ipresent
1006 CALL ilist_reset(parser%ilist)
1007 ELSE
1008 CALL read_integer_object(parser%input_line(parser%icol1:parser%icol2), object, error_message)
1009 IF (len_trim(error_message) > 0) THEN
1010 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 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 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 cpassert(.NOT. parser%ilist%in_use)
1050 IF (PRESENT(skip_lines)) THEN
1051 nline = skip_lines
1052 ELSE
1053 nline = 0
1054 END IF
1055
1056 IF (PRESENT(newline)) THEN
1057 IF (newline) nline = nline + 1
1058 END IF
1059
1060 CALL parser_get_next_line(parser, nline, at_end=my_at_end)
1061 IF (PRESENT(at_end)) THEN
1062 at_end = my_at_end
1063 IF (my_at_end) RETURN
1064 ELSE IF (my_at_end) THEN
1065 cpabort("Unexpected EOF"//trim(parser_location(parser)))
1066 END IF
1067
1068 IF (PRESENT(string_length)) THEN
1069 CALL parser_next_token(parser, string_length=string_length)
1070 ELSE
1071 CALL parser_next_token(parser)
1072 END IF
1073
1074 input_string_length = parser%icol2 - parser%icol1 + 1
1075
1076 IF (input_string_length == 0) THEN
1077 parser%icol1 = parser%icol
1078 parser%icol2 = parser%icol
1079 CALL cp_abort(__location__, &
1080 "A string representing a logical object was expected, found end of line"// &
1081 trim(parser_location(parser)))
1082 ELSE
1083 input_string = ""
1084 input_string(:input_string_length) = parser%input_line(parser%icol1:parser%icol2)
1085 END IF
1086 CALL uppercase(input_string)
1087
1088 SELECT CASE (trim(input_string))
1089 CASE ("0", "F", ".F.", "FALSE", ".FALSE.", "N", "NO", "OFF")
1090 object = .false.
1091 CASE ("1", "T", ".T.", "TRUE", ".TRUE.", "Y", "YES", "ON")
1092 object = .true.
1093 CASE DEFAULT
1094 CALL cp_abort(__location__, &
1095 "A string representing a logical object was expected, found <"// &
1096 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 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 cpassert(.NOT. parser%ilist%in_use)
1127
1128 IF (PRESENT(skip_lines)) THEN
1129 nline = skip_lines
1130 ELSE
1131 nline = 0
1132 END IF
1133
1134 IF (PRESENT(newline)) THEN
1135 IF (newline) nline = nline + 1
1136 END IF
1137
1138 CALL parser_get_next_line(parser, nline, at_end=my_at_end)
1139 IF (PRESENT(at_end)) THEN
1140 at_end = my_at_end
1141 IF (my_at_end) RETURN
1142 ELSE IF (my_at_end) THEN
1143 cpabort("Unexpected EOF"//trim(parser_location(parser)))
1144 END IF
1145
1146 IF (PRESENT(string_length)) THEN
1147 CALL parser_next_token(parser, string_length=string_length)
1148 ELSE
1149 CALL parser_next_token(parser)
1150 END IF
1151
1152 IF (parser%icol1 > parser%icol2) THEN
1153 parser%icol1 = parser%icol
1154 parser%icol2 = parser%icol
1155 CALL cp_abort(__location__, &
1156 "A floating point type object was expected, found end of the line"// &
1157 trim(parser_location(parser)))
1158 END IF
1159
1160 ! Possibility to have real numbers described in the input as division between two numbers
1161 CALL read_float_object(parser%input_line(parser%icol1:parser%icol2), object, error_message)
1162 IF (len_trim(error_message) > 0) THEN
1163 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 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 object = ""
1194 cpassert(.NOT. parser%ilist%in_use)
1195 IF (PRESENT(skip_lines)) THEN
1196 nline = skip_lines
1197 ELSE
1198 nline = 0
1199 END IF
1200
1201 IF (PRESENT(newline)) THEN
1202 IF (newline) nline = nline + 1
1203 END IF
1204
1205 CALL parser_get_next_line(parser, nline, at_end=my_at_end)
1206 IF (PRESENT(at_end)) THEN
1207 at_end = my_at_end
1208 IF (my_at_end) RETURN
1209 ELSE IF (my_at_end) THEN
1210 CALL cp_abort(__location__, &
1211 "Unexpected EOF"//trim(parser_location(parser)))
1212 END IF
1213
1214 IF (PRESENT(string_length)) THEN
1215 CALL parser_next_token(parser, string_length=string_length)
1216 ELSE
1217 CALL parser_next_token(parser)
1218 END IF
1219
1220 input_string_length = parser%icol2 - parser%icol1 + 1
1221
1222 IF (input_string_length <= 0) THEN
1223 CALL cp_abort(__location__, &
1224 "A string type object was expected, found end of line"// &
1225 trim(parser_location(parser)))
1226 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 "specified variable"//trim(parser_location(parser)))
1232 object = parser%input_line(parser%icol1:parser%icol1 + len(object) - 1)
1233 ELSE
1234 object(:input_string_length) = parser%input_line(parser%icol1:parser%icol2)
1235 END IF
1236
1237 ! Convert lowercase to uppercase, if requested
1238 IF (PRESENT(lower_to_upper)) THEN
1239 IF (lower_to_upper) CALL uppercase(object)
1240 END IF
1241
1242 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 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 error_message = ""
1272 func = ""
1273
1274 i = 1
1275 iop = 0
1276 n = len_trim(string)
1277
1278 parsing_done = .false.
1279
1280 DO WHILE (.NOT. parsing_done)
1281 i = i + iop
1282 islash = index(string(i:n), "/")
1283 istar = index(string(i:n), "*")
1284 IF ((islash == 0) .AND. (istar == 0)) THEN
1285 ! Last factor found: read it and then exit the loop
1286 iop = n - i + 2
1287 parsing_done = .true.
1288 ELSE IF ((islash > 0) .AND. (istar > 0)) THEN
1289 iop = min(islash, istar)
1290 ELSE IF (islash > 0) THEN
1291 iop = islash
1292 ELSE IF (istar > 0) THEN
1293 iop = istar
1294 END IF
1295 ileft = index(string(i:min(n, i + maxlen + 1)), "(")
1296 IF (ileft > 0) THEN
1297 ! Check for sign
1298 is = ichar(string(i:i))
1299 SELECT CASE (is)
1300 CASE (43)
1301 fsign = 1.0_dp
1302 func = string(i + 1:i + ileft - 2)
1303 CASE (45)
1304 fsign = -1.0_dp
1305 func = string(i + 1:i + ileft - 2)
1306 CASE DEFAULT
1307 fsign = 1.0_dp
1308 func = string(i:i + ileft - 2)
1309 END SELECT
1310 iright = index(string(i:n), ")")
1311 READ (unit=string(i + ileft:i + iright - 2), fmt=*, iostat=istat) z
1312 IF (istat /= 0) THEN
1313 error_message = "A floating point type object as argument for function <"// &
1314 trim(func)//"> is expected, found <"// &
1315 string(i + ileft:i + iright - 2)//">"
1316 RETURN
1317 END IF
1318 SELECT CASE (func)
1319 CASE ("COS")
1320 z = fsign*cos(z*radians)
1321 CASE ("EXP")
1322 z = fsign*exp(z)
1323 CASE ("LOG")
1324 z = fsign*log(z)
1325 CASE ("LOG10")
1326 z = fsign*log10(z)
1327 CASE ("SIN")
1328 z = fsign*sin(z*radians)
1329 CASE ("SQRT")
1330 z = fsign*sqrt(z)
1331 CASE ("TAN")
1332 z = fsign*tan(z*radians)
1333 CASE DEFAULT
1334 error_message = "Unknown function <"//trim(func)//"> found"
1335 RETURN
1336 END SELECT
1337 ELSE
1338 READ (unit=string(i:i + iop - 2), fmt=*, iostat=istat) z
1339 IF (istat /= 0) THEN
1340 error_message = "A floating point type object was expected, found <"// &
1341 string(i:i + iop - 2)//">"
1342 RETURN
1343 END IF
1344 END IF
1345 IF (i == 1) THEN
1346 object = z
1347 ELSE IF (string(i - 1:i - 1) == "*") THEN
1348 object = object*z
1349 ELSE
1350 IF (z == 0.0_dp) THEN
1351 error_message = "Division by zero found <"// &
1352 string(i:i + iop - 2)//">"
1353 RETURN
1354 ELSE
1355 object = object/z
1356 END IF
1357 END IF
1358 END DO
1359
1360 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 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 error_message = ""
1385
1386 i = 1
1387 iop = 0
1388 n = len_trim(string)
1389
1390 parsing_done = .false.
1391
1392 DO WHILE (.NOT. parsing_done)
1393 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 iop = index(string(i:n), "*")
1397 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 iop = n - i + 2
1403 parsing_done = .true.
1404 END IF
1405 istat = 1
1406 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 WRITE (fmtstr, fmt='(A,I0,A)') '(I', iop - 1, ')'
1411 READ (unit=string(i:i + iop - 2), fmt=fmtstr, iostat=istat) iz8
1412 END IF
1413 IF (istat /= 0) THEN
1414 error_message = "An integer type object was expected, found <"// &
1415 string(i:i + iop - 2)//">"
1416 RETURN
1417 END IF
1418 IF (i == 1) THEN
1419 object8 = iz8
1420 ELSE
1421 object8 = object8*iz8
1422 END IF
1423 IF (abs(object8) > huge(0)) THEN
1424 error_message = "The specified integer number <"//string(i:i + iop - 2)// &
1425 "> exceeds the allowed range of a 32-bit integer number."
1426 RETURN
1427 END IF
1428 END DO
1429
1430 object = int(object8)
1431
1432 END SUBROUTINE read_integer_object
1433
1434END 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:65
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:81
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:545
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:515
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:85
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:1374
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:691
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:1258
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:786
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:228
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:3425
string_utilities::uppercase
elemental subroutine, public uppercase(string)
Convert all lower case characters in a string to upper case.
Definition string_utilities.F:3361
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:763