(git:b279b6b)
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 ! **************************************************************************************************
20 MODULE cp_parser_methods
21 
22  USE cp_log_handling, ONLY: cp_to_string
23  USE cp_parser_buffer_types, ONLY: copy_buffer_type,&
24  finalize_sub_buffer,&
25  initialize_sub_buffer
26  USE cp_parser_ilist_methods, ONLY: ilist_reset,&
27  ilist_setup,&
28  ilist_update
29  USE cp_parser_inpp_methods, ONLY: inpp_end_include,&
30  inpp_expand_variables,&
31  inpp_process_directive
32  USE cp_parser_types, ONLY: cp_parser_type,&
33  parser_reset
34  USE kinds, ONLY: default_path_length,&
35  default_string_length,&
36  dp,&
37  int_8,&
38  max_line_length
39  USE mathconstants, ONLY: radians
40  USE message_passing, ONLY: mp_para_env_type
41  USE string_utilities, ONLY: is_whitespace,&
42  uppercase
43 #include "../base/base_uses.f90"
44 
45  IMPLICIT NONE
46  PRIVATE
47 
48  PUBLIC :: parser_test_next_token, parser_get_object, parser_location, &
49  parser_search_string, parser_get_next_line, parser_skip_space, &
50  parser_read_line, read_float_object, read_integer_object
51 
52  CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'cp_parser_methods'
53 
54  INTERFACE parser_get_object
55  MODULE PROCEDURE parser_get_integer, &
56  parser_get_logical, &
57  parser_get_real, &
58  parser_get_string
59  END INTERFACE
60 
61 CONTAINS
62 
63 ! **************************************************************************************************
64 !> \brief return a description of the part of the file actually parsed
65 !> \param parser the parser
66 !> \return ...
67 !> \author fawzi
68 ! **************************************************************************************************
69  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 
1434 END MODULE cp_parser_methods
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