LCOV - code coverage report
Current view: top level - src/input - cp_parser_methods.F (source / functions) Hit Total Coverage
Test: CP2K Regtests (git:fe90383) Lines: 446 530 84.2 %
Date: 2024-06-15 07:32:52 Functions: 21 22 95.5 %

          Line data    Source code
       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           0 :    FUNCTION parser_location(parser) RESULT(res)
      70             : 
      71             :       TYPE(cp_parser_type), INTENT(IN)                   :: parser
      72             :       CHARACTER&
      73             :          (len=default_path_length+default_string_length) :: res
      74             : 
      75             :       res = ", File: '"//TRIM(parser%input_file_name)//"', Line: "// &
      76             :             TRIM(ADJUSTL(cp_to_string(parser%input_line_number)))// &
      77           0 :             ", Column: "//TRIM(ADJUSTL(cp_to_string(parser%icol)))
      78           0 :       IF (parser%icol == -1) THEN
      79           0 :          res(LEN_TRIM(res):) = " (EOF)"
      80           0 :       ELSE IF (MAX(1, parser%icol1) <= parser%icol2) THEN
      81             :          res(LEN_TRIM(res):) = ", Chunk: <"// &
      82           0 :                                parser%input_line(MAX(1, parser%icol1):parser%icol2)//">"
      83             :       END IF
      84             : 
      85           0 :    END FUNCTION parser_location
      86             : 
      87             : ! **************************************************************************************************
      88             : !> \brief   store the present status of the parser
      89             : !> \param parser ...
      90             : !> \date    08.2008
      91             : !> \author  Teodoro Laino [tlaino] - University of Zurich
      92             : ! **************************************************************************************************
      93     4393387 :    SUBROUTINE parser_store_status(parser)
      94             : 
      95             :       TYPE(cp_parser_type), INTENT(INOUT)                :: parser
      96             : 
      97     4393387 :       CPASSERT(ASSOCIATED(parser%status))
      98     4393387 :       parser%status%in_use = .TRUE.
      99     4393387 :       parser%status%old_input_line = parser%input_line
     100     4393387 :       parser%status%old_input_line_number = parser%input_line_number
     101     4393387 :       parser%status%old_icol = parser%icol
     102     4393387 :       parser%status%old_icol1 = parser%icol1
     103     4393387 :       parser%status%old_icol2 = parser%icol2
     104             :       ! Store buffer info
     105     4393387 :       CALL copy_buffer_type(parser%buffer, parser%status%buffer)
     106             : 
     107     4393387 :    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     4393387 :    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     4393387 :       IF (parser%buffer%buffer_id /= parser%status%buffer%buffer_id) THEN
     121          38 :          CALL initialize_sub_buffer(parser%buffer%sub_buffer, parser%buffer)
     122             :       END IF
     123     4393387 :       parser%status%in_use = .FALSE.
     124     4393387 :       parser%input_line = parser%status%old_input_line
     125     4393387 :       parser%input_line_number = parser%status%old_input_line_number
     126     4393387 :       parser%icol = parser%status%old_icol
     127     4393387 :       parser%icol1 = parser%status%old_icol1
     128     4393387 :       parser%icol2 = parser%status%old_icol2
     129             : 
     130             :       ! Retrieve buffer info
     131     4393387 :       CALL copy_buffer_type(parser%status%buffer, parser%buffer)
     132             : 
     133     4393387 :    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    36722076 :    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    36722076 :       CALL timeset(routineN, handle)
     157             : 
     158    36722076 :       IF (PRESENT(at_end)) at_end = .FALSE.
     159             : 
     160    73431806 :       DO iline = 1, nline
     161             :          ! Try to read the next line from the buffer
     162    36729513 :          CALL parser_get_line_from_buffer(parser, istat)
     163             : 
     164             :          ! Handle (persisting) read errors
     165    73431806 :          IF (istat /= 0) THEN
     166       19783 :             IF (istat < 0) THEN ! EOF/EOR is negative other errors positive
     167       19783 :                IF (PRESENT(at_end)) THEN
     168       19783 :                   at_end = .TRUE.
     169             :                ELSE
     170           0 :                   CPABORT("Unexpected EOF"//TRIM(parser_location(parser)))
     171             :                END IF
     172       19783 :                parser%icol = -1
     173       19783 :                parser%icol1 = 0
     174       19783 :                parser%icol2 = -1
     175             :             ELSE
     176             :                CALL cp_abort(__LOCATION__, &
     177             :                              "An I/O error occurred (IOSTAT = "// &
     178             :                              TRIM(ADJUSTL(cp_to_string(istat)))//")"// &
     179           0 :                              TRIM(parser_location(parser)))
     180             :             END IF
     181       19783 :             CALL timestop(handle)
     182       19783 :             RETURN
     183             :          END IF
     184             :       END DO
     185             : 
     186             :       ! Reset column pointer, if a new line was read
     187    36702293 :       IF (nline > 0) parser%icol = 0
     188             : 
     189    36702293 :       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    36729513 :    SUBROUTINE parser_get_line_from_buffer(parser, istat)
     200             : 
     201             :       TYPE(cp_parser_type), INTENT(INOUT)                :: parser
     202             :       INTEGER, INTENT(OUT)                               :: istat
     203             : 
     204    36729513 :       istat = 0
     205             :       ! Check buffer
     206    36729513 :       IF (parser%buffer%present_line_number == parser%buffer%size) THEN
     207       79637 :          IF (ASSOCIATED(parser%buffer%sub_buffer)) THEN
     208             :             ! If the sub_buffer is initialized let's restore its buffer
     209          38 :             CALL finalize_sub_buffer(parser%buffer%sub_buffer, parser%buffer)
     210             :          ELSE
     211             :             ! Rebuffer input file if required
     212       79599 :             CALL parser_read_line_low(parser)
     213             :          END IF
     214             :       END IF
     215    36729513 :       parser%buffer%present_line_number = parser%buffer%present_line_number + 1
     216    36729513 :       parser%input_line_number = parser%buffer%input_line_numbers(parser%buffer%present_line_number)
     217    36729513 :       parser%input_line = parser%buffer%input_lines(parser%buffer%present_line_number)
     218    36729513 :       IF ((parser%buffer%istat /= 0) .AND. &
     219             :           (parser%buffer%last_line_number == parser%buffer%present_line_number)) THEN
     220       19783 :          istat = parser%buffer%istat
     221             :       END IF
     222             : 
     223    36729513 :    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       79599 :    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       79599 :       CALL timeset(routineN, handle)
     243             : 
     244    79678599 :       parser%buffer%input_lines = ""
     245       79599 :       IF (parser%para_env%is_source()) THEN
     246       41757 :          iline = 0
     247       41757 :          istat = 0
     248       41757 :          parser%buffer%buffer_id = parser%buffer%buffer_id + 1
     249       41757 :          parser%buffer%present_line_number = 0
     250       41757 :          parser%buffer%last_line_number = parser%buffer%size
     251       41757 :          last_buffered_line_number = parser%buffer%input_line_numbers(parser%buffer%size)
     252    28444964 :          DO WHILE (iline /= parser%buffer%size)
     253             :             ! Increment counters by 1
     254    28422506 :             iline = iline + 1
     255    28422506 :             last_buffered_line_number = last_buffered_line_number + 1
     256             : 
     257             :             ! Try to read the next line from file
     258    28422506 :             parser%buffer%input_line_numbers(iline) = last_buffered_line_number
     259    28422506 :             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    28422506 :             IF (istat == 0) THEN
     265    28402671 :                islen = LEN_TRIM(parser%buffer%input_lines(iline))
     266    28402671 :                this_line_is_white_or_comment = is_comment_line(parser, parser%buffer%input_lines(iline))
     267    28402671 :                IF (.NOT. this_line_is_white_or_comment .AND. parser%apply_preprocessing) THEN
     268    24699810 :                   imark = INDEX(parser%buffer%input_lines(iline) (1:islen), "$")
     269    24699810 :                   IF (imark /= 0) THEN
     270             :                      CALL inpp_expand_variables(parser%inpp, parser%buffer%input_lines(iline), &
     271        5740 :                                                 parser%input_file_name, parser%buffer%input_line_numbers(iline))
     272        5740 :                      islen = LEN_TRIM(parser%buffer%input_lines(iline))
     273             :                   END IF
     274    24699810 :                   imark = INDEX(parser%buffer%input_lines(iline) (1:islen), "@")
     275    24699810 :                   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        9853 :                                                  parser%input_unit)
     279        9853 :                      islen = LEN_TRIM(parser%buffer%input_lines(iline))
     280             :                      ! Handle index and cycle
     281        9853 :                      last_buffered_line_number = 0
     282        9853 :                      iline = iline - 1
     283        9853 :                      CYCLE
     284             :                   END IF
     285             : 
     286             :                   ! after preprocessor parsing could the line be empty again
     287    24689957 :                   this_line_is_white_or_comment = is_comment_line(parser, parser%buffer%input_lines(iline))
     288             :                END IF
     289       19835 :             ELSE IF (istat < 0) THEN ! handle EOF
     290       19835 :                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         536 :                                         parser%buffer%input_line_numbers(iline), parser%input_unit)
     294             :                   ! Handle index and cycle
     295         536 :                   last_buffered_line_number = parser%buffer%input_line_numbers(iline)
     296         536 :                   iline = iline - 1
     297         536 :                   CYCLE
     298             :                END IF
     299             :             END IF
     300             : 
     301             :             ! Saving persisting read errors
     302    28412117 :             IF (istat /= 0) THEN
     303       19299 :                parser%buffer%istat = istat
     304       19299 :                parser%buffer%last_line_number = iline
     305    17072215 :                parser%buffer%input_line_numbers(iline:) = 0
     306    17072215 :                parser%buffer%input_lines(iline:) = ""
     307             :                EXIT
     308             :             END IF
     309             : 
     310             :             ! Pre-processing and error checking done. Ready for parsing.
     311    28392818 :             IF (.NOT. parser%parse_white_lines) THEN
     312    28176317 :                non_white_found = .NOT. this_line_is_white_or_comment
     313             :             ELSE
     314             :                non_white_found = .TRUE.
     315             :             END IF
     316    28415276 :             IF (.NOT. non_white_found) THEN
     317     3688734 :                iline = iline - 1
     318     3688734 :                last_buffered_line_number = last_buffered_line_number - 1
     319             :             END IF
     320             :          END DO
     321             :       END IF
     322             :       ! Broadcast buffer informations
     323       79599 :       CALL broadcast_input_information(parser)
     324             : 
     325       79599 :       CALL timestop(handle)
     326             : 
     327       79599 :    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       79599 :    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       79599 :       CALL timeset(routineN, handle)
     346             : 
     347       79599 :       para_env => parser%para_env
     348       79599 :       IF (para_env%num_pe > 1) THEN
     349       75684 :          CALL para_env%bcast(parser%buffer%buffer_id)
     350       75684 :          CALL para_env%bcast(parser%buffer%present_line_number)
     351       75684 :          CALL para_env%bcast(parser%buffer%last_line_number)
     352       75684 :          CALL para_env%bcast(parser%buffer%istat)
     353   151443684 :          CALL para_env%bcast(parser%buffer%input_line_numbers)
     354   151443684 :          CALL para_env%bcast(parser%buffer%input_lines)
     355             :       END IF
     356             : 
     357       79599 :       CALL timestop(handle)
     358             : 
     359       79599 :    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    53092628 :    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    53092628 :       resval = .TRUE.
     379   836887093 :       DO icol = 1, LEN(line)
     380   836715220 :          thischar = line(icol:icol)
     381   836887093 :          IF (.NOT. is_whitespace(thischar)) THEN
     382    52920755 :             IF (.NOT. is_comment(parser, thischar)) resval = .FALSE.
     383             :             EXIT
     384             :          END IF
     385             :       END DO
     386             : 
     387    53092628 :    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   110476432 :    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   110476432 :       resval = .FALSE.
     405             :       ! We are in a private function, and parser has been tested before...
     406   324894334 :       IF (ANY(parser%comment_character == testchar)) resval = .TRUE.
     407             : 
     408   110476432 :    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    40546573 :    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    40546573 :       IF (nline > 0) THEN
     429    36291976 :          CALL parser_read_line(parser, nline, at_end=my_at_end)
     430    36291976 :          IF (PRESENT(at_end)) THEN
     431    35388793 :             at_end = my_at_end
     432             :          ELSE
     433      903183 :             IF (my_at_end) THEN
     434           0 :                CPABORT("Unexpected EOF"//TRIM(parser_location(parser)))
     435             :             END IF
     436             :          END IF
     437     4254597 :       ELSE IF (PRESENT(at_end)) THEN
     438     4254299 :          at_end = .FALSE.
     439             :       END IF
     440             : 
     441    40546573 :    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       21089 :    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       21089 :       IF (parser%icol == -1) THEN
     460           0 :          parser%icol1 = 1
     461           0 :          parser%icol2 = -1
     462           0 :          RETURN
     463             :       END IF
     464             : 
     465             :       ! Search for the beginning of the next input string
     466             :       outer_loop: DO
     467             : 
     468             :          ! Increment the column counter
     469       21787 :          parser%icol = parser%icol + 1
     470             : 
     471             :          ! Quick return, if the end of line is found
     472       21787 :          IF ((parser%icol > LEN_TRIM(parser%input_line)) .OR. &
     473             :              is_comment(parser, parser%input_line(parser%icol:parser%icol))) THEN
     474          74 :             parser%icol1 = 1
     475          74 :             parser%icol2 = -1
     476          74 :             RETURN
     477             :          END IF
     478             : 
     479             :          ! Ignore all white space
     480       21713 :          IF (.NOT. is_whitespace(parser%input_line(parser%icol:parser%icol))) THEN
     481             :             ! Check for input line continuation
     482       21015 :             IF (parser%input_line(parser%icol:parser%icol) == parser%continuation_character) THEN
     483           0 :                inner_loop: DO i = parser%icol + 1, LEN_TRIM(parser%input_line)
     484           0 :                   IF (is_whitespace(parser%input_line(i:i))) CYCLE inner_loop
     485           0 :                   IF (is_comment(parser, parser%input_line(i:i))) THEN
     486             :                      EXIT inner_loop
     487             :                   ELSE
     488           0 :                      parser%icol1 = i
     489           0 :                      parser%icol2 = LEN_TRIM(parser%input_line)
     490             :                      CALL cp_abort(__LOCATION__, &
     491             :                                    "Found a non-blank token which is not a comment after the line continuation character '"// &
     492           0 :                                    parser%continuation_character//"'"//TRIM(parser_location(parser)))
     493             :                   END IF
     494             :                END DO inner_loop
     495           0 :                CALL parser_get_next_line(parser, 1, at_end=at_end)
     496           0 :                IF (at_end) THEN
     497             :                   CALL cp_abort(__LOCATION__, &
     498             :                                 "Unexpected end of file (EOF) found after line continuation"// &
     499           0 :                                 TRIM(parser_location(parser)))
     500             :                END IF
     501           0 :                parser%icol = 0
     502           0 :                CYCLE outer_loop
     503             :             ELSE
     504       21015 :                parser%icol = parser%icol - 1
     505       21015 :                parser%icol1 = parser%icol
     506       21015 :                parser%icol2 = parser%icol
     507       21015 :                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     9890177 :    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     9890177 :       IF (PRESENT(string_length)) THEN
     534      287701 :          IF (string_length > max_line_length) THEN
     535           0 :             CPABORT("string length > max_line_length")
     536             :          ELSE
     537             :             length = string_length
     538             :          END IF
     539             :       ELSE
     540             :          length = 0
     541             :       END IF
     542             : 
     543             :       ! Precompute trimmed line length
     544     9890177 :       len_trim_inputline = LEN_TRIM(parser%input_line)
     545             : 
     546     9890177 :       IF (length > 0) THEN
     547             : 
     548             :          ! Read input string of fixed length (single line)
     549             : 
     550             :          ! Check for EOF
     551      287701 :          IF (parser%icol == -1) &
     552           0 :             CPABORT("Unexpectetly reached EOF"//TRIM(parser_location(parser)))
     553             : 
     554      287701 :          length = MIN(len_trim_inputline - parser%icol1 + 1, length)
     555      287701 :          parser%icol1 = parser%icol + 1
     556      287701 :          parser%icol2 = parser%icol + length
     557      287701 :          i = INDEX(parser%input_line(parser%icol1:parser%icol2), parser%quote_character)
     558      287701 :          IF (i > 0) parser%icol2 = parser%icol + i
     559      287701 :          parser%icol = parser%icol2
     560             : 
     561             :       ELSE
     562             : 
     563             :          ! Variable input string length (automatic multi-line search)
     564             : 
     565             :          ! Check for EOF
     566     9602476 :          IF (parser%icol == -1) THEN
     567           0 :             parser%icol1 = 1
     568           0 :             parser%icol2 = -1
     569     1493693 :             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    30786230 :             parser%icol = parser%icol + 1
     577             : 
     578             :             ! Quick return, if the end of line is found
     579    30786230 :             IF (parser%icol > len_trim_inputline) THEN
     580     1452253 :                parser%icol1 = 1
     581     1452253 :                parser%icol2 = -1
     582     1452253 :                RETURN
     583             :             END IF
     584             : 
     585    29333977 :             token = parser%input_line(parser%icol:parser%icol)
     586             : 
     587    29333977 :             IF (is_whitespace(token)) THEN
     588             :                ! Ignore white space
     589             :                CYCLE outer_loop1
     590     8269413 :             ELSE IF (is_comment(parser, token)) THEN
     591       32384 :                parser%icol1 = 1
     592       32384 :                parser%icol2 = -1
     593       32384 :                parser%first_separator = .TRUE.
     594       32384 :                RETURN
     595     8237029 :             ELSE IF (token == parser%quote_character) THEN
     596             :                ! Read quoted string
     597        9056 :                parser%icol1 = parser%icol + 1
     598        9056 :                parser%icol2 = parser%icol + INDEX(parser%input_line(parser%icol1:), parser%quote_character)
     599        9056 :                IF (parser%icol2 == parser%icol) THEN
     600           0 :                   parser%icol1 = parser%icol
     601           0 :                   parser%icol2 = parser%icol
     602             :                   CALL cp_abort(__LOCATION__, &
     603           0 :                                 "Unmatched quotation mark found"//TRIM(parser_location(parser)))
     604             :                ELSE
     605        9056 :                   parser%icol = parser%icol2
     606        9056 :                   parser%icol2 = parser%icol2 - 1
     607        9056 :                   parser%first_separator = .TRUE.
     608        9056 :                   RETURN
     609             :                END IF
     610     8227973 :             ELSE IF (token == parser%continuation_character) THEN
     611             :                ! Check for input line continuation
     612      118784 :                inner_loop1: DO i = parser%icol + 1, len_trim_inputline
     613      118784 :                   IF (is_whitespace(parser%input_line(i:i))) THEN
     614             :                      CYCLE inner_loop1
     615           0 :                   ELSE IF (is_comment(parser, parser%input_line(i:i))) THEN
     616             :                      EXIT inner_loop1
     617             :                   ELSE
     618           0 :                      parser%icol1 = i
     619           0 :                      parser%icol2 = len_trim_inputline
     620             :                      CALL cp_abort(__LOCATION__, &
     621             :                                    "Found a non-blank token which is not a comment after the line continuation character '"// &
     622           0 :                                    parser%continuation_character//"'"//TRIM(parser_location(parser)))
     623             :                   END IF
     624             :                END DO inner_loop1
     625      118784 :                CALL parser_get_next_line(parser, 1, at_end=at_end)
     626      118784 :                IF (at_end) THEN
     627             :                   CALL cp_abort(__LOCATION__, &
     628           0 :                                 "Unexpected end of file (EOF) found after line continuation"//TRIM(parser_location(parser)))
     629             :                END IF
     630      118784 :                len_trim_inputline = LEN_TRIM(parser%input_line)
     631      118784 :                CYCLE outer_loop1
     632     8109189 :             ELSE IF (INDEX(parser%separators, token) > 0) THEN
     633         406 :                IF (parser%first_separator) THEN
     634         406 :                   parser%first_separator = .FALSE.
     635         406 :                   CYCLE outer_loop1
     636             :                ELSE
     637           0 :                   parser%icol1 = parser%icol
     638           0 :                   parser%icol2 = parser%icol
     639             :                   CALL cp_abort(__LOCATION__, &
     640             :                                 "Unexpected separator token '"//token// &
     641           0 :                                 "' found"//TRIM(parser_location(parser)))
     642             :                END IF
     643             :             ELSE
     644     8108783 :                parser%icol1 = parser%icol
     645     8108783 :                parser%first_separator = .TRUE.
     646     8108783 :                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    57371270 :             parser%icol = parser%icol + 1
     654    57371270 :             IF (parser%icol > len_trim_inputline) EXIT outer_loop2
     655    55325402 :             token = parser%input_line(parser%icol:parser%icol)
     656    55325402 :             IF (is_whitespace(token) .OR. is_comment(parser, token) .OR. &
     657     8106781 :                 (token == parser%continuation_character)) THEN
     658             :                EXIT outer_loop2
     659    49264489 :             ELSE IF (INDEX(parser%separators, token) > 0) THEN
     660        2002 :                parser%first_separator = .FALSE.
     661        2002 :                EXIT outer_loop2
     662             :             END IF
     663             :          END DO outer_loop2
     664             : 
     665     8108783 :          parser%icol2 = parser%icol - 1
     666             : 
     667     8108783 :          IF (parser%input_line(parser%icol:parser%icol) == &
     668          14 :              parser%continuation_character) parser%icol = parser%icol2
     669             : 
     670             :       END IF
     671             : 
     672             :    END SUBROUTINE parser_next_token
     673             : 
     674             : ! **************************************************************************************************
     675             : !> \brief   Test next input object.
     676             : !>           -  test_result : "EOL": End of line
     677             : !>           -  test_result : "EOS": End of section
     678             : !>           -  test_result : "FLT": Floating point number
     679             : !>           -  test_result : "INT": Integer number
     680             : !>           -  test_result : "STR": String
     681             : !> \param parser ...
     682             : !> \param string_length ...
     683             : !> \return ...
     684             : !> \date    23.11.1999
     685             : !> \author  Matthias Krack (MK)
     686             : !> \note - 08.2008 [tlaino] - Teodoro Laino UZH : updated for buffer
     687             : !>          - Major rewrite to parse also (multiple) products of integer or
     688             : !>            floating point numbers (23.11.2012,MK)
     689             : ! **************************************************************************************************
     690     4393387 :    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     4393387 :       test_result = ""
     702             : 
     703             :       ! Store current status
     704     4393387 :       CALL parser_store_status(parser)
     705             : 
     706             :       ! Handle possible list of integers
     707     4393387 :       ilist_in_use = parser%ilist%in_use .AND. (parser%ilist%ipresent < parser%ilist%iend)
     708             :       IF (ilist_in_use) THEN
     709       14268 :          test_result = "INT"
     710       14268 :          CALL parser_retrieve_status(parser)
     711     3600378 :          RETURN
     712             :       END IF
     713             : 
     714             :       ! Otherwise continue normally
     715     4379119 :       IF (PRESENT(string_length)) THEN
     716           0 :          CALL parser_next_token(parser, string_length=string_length)
     717             :       ELSE
     718     4379119 :          CALL parser_next_token(parser)
     719             :       END IF
     720             : 
     721             :       ! End of line
     722     4379119 :       IF (parser%icol1 > parser%icol2) THEN
     723     1484637 :          test_result = "EOL"
     724     1484637 :          CALL parser_retrieve_status(parser)
     725     1484637 :          RETURN
     726             :       END IF
     727             : 
     728     2894482 :       string = parser%input_line(parser%icol1:parser%icol2)
     729     2894482 :       n = LEN_TRIM(string)
     730             : 
     731     2894482 :       IF (n == 0) THEN
     732           0 :          test_result = "STR"
     733           0 :          CALL parser_retrieve_status(parser)
     734           0 :          RETURN
     735             :       END IF
     736             : 
     737             :       ! Check for end section string
     738     2894482 :       IF (string(1:n) == parser%end_section) THEN
     739           0 :          test_result = "EOS"
     740           0 :          CALL parser_retrieve_status(parser)
     741           0 :          RETURN
     742             :       END IF
     743             : 
     744             :       ! Check for integer object
     745     2894482 :       error_message = ""
     746     2894482 :       CALL read_integer_object(string(1:n), iz, error_message)
     747     2894482 :       IF (LEN_TRIM(error_message) == 0) THEN
     748     1291353 :          test_result = "INT"
     749     1291353 :          CALL parser_retrieve_status(parser)
     750     1291353 :          RETURN
     751             :       END IF
     752             : 
     753             :       ! Check for floating point object
     754     1603129 :       error_message = ""
     755     1603129 :       CALL read_float_object(string(1:n), fz, error_message)
     756     1603129 :       IF (LEN_TRIM(error_message) == 0) THEN
     757      810120 :          test_result = "FLT"
     758      810120 :          CALL parser_retrieve_status(parser)
     759      810120 :          RETURN
     760             :       END IF
     761             : 
     762      793009 :       test_result = "STR"
     763      793009 :       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      142968 :    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      142968 :       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      142968 :       found = .FALSE.
     800      142968 :       begin = .FALSE.
     801      142968 :       do_reset = .FALSE.
     802       66608 :       IF (PRESENT(begin_line)) begin = begin_line
     803      142968 :       IF (PRESENT(search_from_begin_of_file)) do_reset = search_from_begin_of_file
     804      142968 :       IF (PRESENT(line)) line = ""
     805             : 
     806             :       ! Search for string pattern
     807      142968 :       pattern = string
     808      142968 :       IF (ignore_case) CALL uppercase(pattern)
     809      142968 :       IF (do_reset) CALL parser_reset(parser)
     810             :       DO
     811             :          ! This call is buffered.. so should not represent any bottleneck
     812    33275337 :          CALL parser_get_next_line(parser, 1, at_end=at_end)
     813             : 
     814             :          ! Exit loop, if the end of file is reached
     815    33275337 :          IF (at_end) EXIT
     816             : 
     817             :          ! Check the current line for string pattern
     818    33266399 :          current_line = parser%input_line
     819    33266399 :          IF (ignore_case) CALL uppercase(current_line)
     820    33266399 :          ipattern = INDEX(current_line, TRIM(pattern))
     821             : 
     822    33275337 :          IF (ipattern > 0) THEN
     823      134030 :             found = .TRUE.
     824      134030 :             parser%icol = ipattern - 1
     825      134030 :             IF (PRESENT(line)) THEN
     826       75283 :                IF (LEN(line) < LEN_TRIM(parser%input_line)) THEN
     827             :                   CALL cp_warn(__LOCATION__, &
     828             :                                "The returned input line has more than "// &
     829             :                                TRIM(ADJUSTL(cp_to_string(LEN(line))))// &
     830             :                                " characters and is therefore too long to fit in the "// &
     831             :                                "specified variable"// &
     832           0 :                                TRIM(parser_location(parser)))
     833             :                END IF
     834             :             END IF
     835             :             EXIT
     836             :          END IF
     837             : 
     838             :       END DO
     839             : 
     840      142968 :       IF (found) THEN
     841      134030 :          IF (begin) parser%icol = 0
     842             :       END IF
     843             : 
     844      142968 :       IF (found) THEN
     845      134030 :          IF (PRESENT(line)) line = parser%input_line
     846      134030 :          IF (.NOT. begin) CALL parser_next_token(parser)
     847             :       END IF
     848             : 
     849      142968 :    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     1719281 :    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     1719281 :       contains_integer_object = .TRUE.
     870     1719281 :       n = LEN_TRIM(string)
     871             : 
     872     1719281 :       IF (n == 0) THEN
     873     1719281 :          contains_integer_object = .FALSE.
     874             :          RETURN
     875             :       END IF
     876             : 
     877     1719281 :       idots = INDEX(string(1:n), "..")
     878     1719281 :       istar = INDEX(string(1:n), "*")
     879             : 
     880     1719281 :       IF (idots /= 0) THEN
     881             :          contains_integer_object = is_integer(string(1:idots - 1)) .AND. &
     882       14890 :                                    is_integer(string(idots + 2:n))
     883     1704391 :       ELSE IF (istar /= 0) THEN
     884             :          i = 1
     885         124 :          DO WHILE (istar /= 0)
     886          66 :             IF (.NOT. is_integer(string(i:i + istar - 2))) THEN
     887     1719281 :                contains_integer_object = .FALSE.
     888             :                RETURN
     889             :             END IF
     890          66 :             i = i + istar
     891         124 :             istar = INDEX(string(i:n), "*")
     892             :          END DO
     893          58 :          contains_integer_object = is_integer(string(i:n))
     894             :       ELSE
     895     1704333 :          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     1734237 :    ELEMENTAL FUNCTION is_integer(string) RESULT(check)
     906             : 
     907             :       CHARACTER(LEN=*), INTENT(IN)                       :: string
     908             :       LOGICAL                                            :: check
     909             : 
     910             :       INTEGER                                            :: i, n
     911             : 
     912     1734237 :       check = .TRUE.
     913     1734237 :       n = LEN_TRIM(string)
     914             : 
     915     1734237 :       IF (n == 0) THEN
     916     1734237 :          check = .FALSE.
     917             :          RETURN
     918             :       END IF
     919             : 
     920     1734237 :       IF ((INDEX("+-", string(1:1)) > 0) .AND. (n == 1)) THEN
     921     1734237 :          check = .FALSE.
     922             :          RETURN
     923             :       END IF
     924             : 
     925     1734237 :       IF (INDEX("+-0123456789", string(1:1)) == 0) THEN
     926     1734237 :          check = .FALSE.
     927             :          RETURN
     928             :       END IF
     929             : 
     930     5012099 :       DO i = 2, n
     931     5012099 :          IF (INDEX("0123456789", string(i:i)) == 0) THEN
     932     1734237 :             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     3438562 :    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     1719281 :       IF (PRESENT(skip_lines)) THEN
     965           0 :          nline = skip_lines
     966             :       ELSE
     967     1719281 :          nline = 0
     968             :       END IF
     969             : 
     970     1719281 :       IF (PRESENT(newline)) THEN
     971       51515 :          IF (newline) nline = nline + 1
     972             :       END IF
     973             : 
     974     1719281 :       CALL parser_get_next_line(parser, nline, at_end=my_at_end)
     975     1719281 :       IF (PRESENT(at_end)) THEN
     976           0 :          at_end = my_at_end
     977           0 :          IF (my_at_end) RETURN
     978     1719281 :       ELSE IF (my_at_end) THEN
     979           0 :          CPABORT("Unexpected EOF"//TRIM(parser_location(parser)))
     980             :       END IF
     981             : 
     982     1719281 :       IF (parser%ilist%in_use) THEN
     983       14276 :          CALL ilist_update(parser%ilist)
     984             :       ELSE
     985     1705005 :          IF (PRESENT(string_length)) THEN
     986           0 :             CALL parser_next_token(parser, string_length=string_length)
     987             :          ELSE
     988     1705005 :             CALL parser_next_token(parser)
     989             :          END IF
     990     1705005 :          IF (parser%icol1 > parser%icol2) THEN
     991           0 :             parser%icol1 = parser%icol
     992           0 :             parser%icol2 = parser%icol
     993             :             CALL cp_abort(__LOCATION__, &
     994             :                           "An integer type object was expected, found end of line"// &
     995           0 :                           TRIM(parser_location(parser)))
     996             :          END IF
     997             :          ! Checks for possible lists of integers
     998     1705005 :          IF (INDEX(parser%input_line(parser%icol1:parser%icol2), "..") /= 0) THEN
     999         614 :             CALL ilist_setup(parser%ilist, parser%input_line(parser%icol1:parser%icol2))
    1000             :          END IF
    1001             :       END IF
    1002             : 
    1003     1719281 :       IF (integer_object(parser%input_line(parser%icol1:parser%icol2))) THEN
    1004     1719281 :          IF (parser%ilist%in_use) THEN
    1005       14890 :             object = parser%ilist%ipresent
    1006       14890 :             CALL ilist_reset(parser%ilist)
    1007             :          ELSE
    1008     1704391 :             CALL read_integer_object(parser%input_line(parser%icol1:parser%icol2), object, error_message)
    1009     1704391 :             IF (LEN_TRIM(error_message) > 0) THEN
    1010           0 :                CPABORT(TRIM(error_message)//TRIM(parser_location(parser)))
    1011             :             END IF
    1012             :          END IF
    1013             :       ELSE
    1014             :          CALL cp_abort(__LOCATION__, &
    1015             :                        "An integer type object was expected, found <"// &
    1016             :                        parser%input_line(parser%icol1:parser%icol2)//">"// &
    1017           0 :                        TRIM(parser_location(parser)))
    1018             :       END IF
    1019             : 
    1020             :    END SUBROUTINE parser_get_integer
    1021             : 
    1022             : ! **************************************************************************************************
    1023             : !> \brief   Read a string representing logical object.
    1024             : !> \param parser ...
    1025             : !> \param object ...
    1026             : !> \param newline ...
    1027             : !> \param skip_lines ...
    1028             : !> \param string_length ...
    1029             : !> \param at_end ...
    1030             : !> \date    01.04.2003
    1031             : !> \par History
    1032             : !>      - New version (08.07.2003,MK)
    1033             : !> \author  FM
    1034             : !> \version 1.0
    1035             : ! **************************************************************************************************
    1036       34900 :    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       17450 :       CPASSERT(.NOT. parser%ilist%in_use)
    1050       17450 :       IF (PRESENT(skip_lines)) THEN
    1051           0 :          nline = skip_lines
    1052             :       ELSE
    1053       17450 :          nline = 0
    1054             :       END IF
    1055             : 
    1056       17450 :       IF (PRESENT(newline)) THEN
    1057           0 :          IF (newline) nline = nline + 1
    1058             :       END IF
    1059             : 
    1060       17450 :       CALL parser_get_next_line(parser, nline, at_end=my_at_end)
    1061       17450 :       IF (PRESENT(at_end)) THEN
    1062           0 :          at_end = my_at_end
    1063           0 :          IF (my_at_end) RETURN
    1064       17450 :       ELSE IF (my_at_end) THEN
    1065           0 :          CPABORT("Unexpected EOF"//TRIM(parser_location(parser)))
    1066             :       END IF
    1067             : 
    1068       17450 :       IF (PRESENT(string_length)) THEN
    1069           0 :          CALL parser_next_token(parser, string_length=string_length)
    1070             :       ELSE
    1071       17450 :          CALL parser_next_token(parser)
    1072             :       END IF
    1073             : 
    1074       17450 :       input_string_length = parser%icol2 - parser%icol1 + 1
    1075             : 
    1076       17450 :       IF (input_string_length == 0) THEN
    1077           0 :          parser%icol1 = parser%icol
    1078           0 :          parser%icol2 = parser%icol
    1079             :          CALL cp_abort(__LOCATION__, &
    1080             :                        "A string representing a logical object was expected, found end of line"// &
    1081           0 :                        TRIM(parser_location(parser)))
    1082             :       ELSE
    1083       17450 :          input_string = ""
    1084       17450 :          input_string(:input_string_length) = parser%input_line(parser%icol1:parser%icol2)
    1085             :       END IF
    1086       17450 :       CALL uppercase(input_string)
    1087             : 
    1088       23674 :       SELECT CASE (TRIM(input_string))
    1089             :       CASE ("0", "F", ".F.", "FALSE", ".FALSE.", "N", "NO", "OFF")
    1090        6224 :          object = .FALSE.
    1091             :       CASE ("1", "T", ".T.", "TRUE", ".TRUE.", "Y", "YES", "ON")
    1092       11226 :          object = .TRUE.
    1093             :       CASE DEFAULT
    1094             :          CALL cp_abort(__LOCATION__, &
    1095             :                        "A string representing a logical object was expected, found <"// &
    1096       17450 :                        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     2718554 :    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     1359277 :       CPASSERT(.NOT. parser%ilist%in_use)
    1127             : 
    1128     1359277 :       IF (PRESENT(skip_lines)) THEN
    1129           0 :          nline = skip_lines
    1130             :       ELSE
    1131     1359277 :          nline = 0
    1132             :       END IF
    1133             : 
    1134     1359277 :       IF (PRESENT(newline)) THEN
    1135       85465 :          IF (newline) nline = nline + 1
    1136             :       END IF
    1137             : 
    1138     1359277 :       CALL parser_get_next_line(parser, nline, at_end=my_at_end)
    1139     1359277 :       IF (PRESENT(at_end)) THEN
    1140           0 :          at_end = my_at_end
    1141           0 :          IF (my_at_end) RETURN
    1142     1359277 :       ELSE IF (my_at_end) THEN
    1143           0 :          CPABORT("Unexpected EOF"//TRIM(parser_location(parser)))
    1144             :       END IF
    1145             : 
    1146     1359277 :       IF (PRESENT(string_length)) THEN
    1147           0 :          CALL parser_next_token(parser, string_length=string_length)
    1148             :       ELSE
    1149     1359277 :          CALL parser_next_token(parser)
    1150             :       END IF
    1151             : 
    1152     1359277 :       IF (parser%icol1 > parser%icol2) THEN
    1153           0 :          parser%icol1 = parser%icol
    1154           0 :          parser%icol2 = parser%icol
    1155             :          CALL cp_abort(__LOCATION__, &
    1156             :                        "A floating point type object was expected, found end of the line"// &
    1157           0 :                        TRIM(parser_location(parser)))
    1158             :       END IF
    1159             : 
    1160             :       ! Possibility to have real numbers described in the input as division between two numbers
    1161     1359277 :       CALL read_float_object(parser%input_line(parser%icol1:parser%icol2), object, error_message)
    1162     1359277 :       IF (LEN_TRIM(error_message) > 0) THEN
    1163           0 :          CPABORT(TRIM(error_message)//TRIM(parser_location(parser)))
    1164             :       END IF
    1165             : 
    1166             :    END SUBROUTINE parser_get_real
    1167             : 
    1168             : ! **************************************************************************************************
    1169             : !> \brief   Read a string.
    1170             : !> \param parser ...
    1171             : !> \param object ...
    1172             : !> \param lower_to_upper ...
    1173             : !> \param newline ...
    1174             : !> \param skip_lines ...
    1175             : !> \param string_length ...
    1176             : !> \param at_end ...
    1177             : !> \date    22.11.1999
    1178             : !> \author  Matthias Krack (MK)
    1179             : !> \version 1.0
    1180             : ! **************************************************************************************************
    1181     4725868 :    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     2362934 :       object = ""
    1194     2362934 :       CPASSERT(.NOT. parser%ilist%in_use)
    1195     2362934 :       IF (PRESENT(skip_lines)) THEN
    1196           0 :          nline = skip_lines
    1197             :       ELSE
    1198     2362934 :          nline = 0
    1199             :       END IF
    1200             : 
    1201     2362934 :       IF (PRESENT(newline)) THEN
    1202     1280319 :          IF (newline) nline = nline + 1
    1203             :       END IF
    1204             : 
    1205     2362934 :       CALL parser_get_next_line(parser, nline, at_end=my_at_end)
    1206     2362934 :       IF (PRESENT(at_end)) THEN
    1207     1066383 :          at_end = my_at_end
    1208     1066383 :          IF (my_at_end) RETURN
    1209     1296551 :       ELSE IF (my_at_end) THEN
    1210             :          CALL cp_abort(__LOCATION__, &
    1211           0 :                        "Unexpected EOF"//TRIM(parser_location(parser)))
    1212             :       END IF
    1213             : 
    1214     2353720 :       IF (PRESENT(string_length)) THEN
    1215      287701 :          CALL parser_next_token(parser, string_length=string_length)
    1216             :       ELSE
    1217     2066019 :          CALL parser_next_token(parser)
    1218             :       END IF
    1219             : 
    1220     2353720 :       input_string_length = parser%icol2 - parser%icol1 + 1
    1221             : 
    1222     2353720 :       IF (input_string_length <= 0) THEN
    1223             :          CALL cp_abort(__LOCATION__, &
    1224             :                        "A string type object was expected, found end of line"// &
    1225           0 :                        TRIM(parser_location(parser)))
    1226     2353720 :       ELSE IF (input_string_length > LEN(object)) THEN
    1227             :          CALL cp_abort(__LOCATION__, &
    1228             :                        "The input string <"//parser%input_line(parser%icol1:parser%icol2)// &
    1229             :                        "> has more than "//cp_to_string(LEN(object))// &
    1230             :                        " characters and is therefore too long to fit in the "// &
    1231           0 :                        "specified variable"//TRIM(parser_location(parser)))
    1232           0 :          object = parser%input_line(parser%icol1:parser%icol1 + LEN(object) - 1)
    1233             :       ELSE
    1234     2353720 :          object(:input_string_length) = parser%input_line(parser%icol1:parser%icol2)
    1235             :       END IF
    1236             : 
    1237             :       ! Convert lowercase to uppercase, if requested
    1238     2353720 :       IF (PRESENT(lower_to_upper)) THEN
    1239     1413267 :          IF (lower_to_upper) CALL uppercase(object)
    1240             :       END IF
    1241             : 
    1242     2362934 :    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     3560690 :    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     3560690 :       error_message = ""
    1272     3560690 :       func = ""
    1273             : 
    1274     3560690 :       i = 1
    1275     3560690 :       iop = 0
    1276     3560690 :       n = LEN_TRIM(string)
    1277             : 
    1278     3560690 :       parsing_done = .FALSE.
    1279             : 
    1280     6332875 :       DO WHILE (.NOT. parsing_done)
    1281     3565194 :          i = i + iop
    1282     3565194 :          islash = INDEX(string(i:n), "/")
    1283     3565194 :          istar = INDEX(string(i:n), "*")
    1284     3565194 :          IF ((islash == 0) .AND. (istar == 0)) THEN
    1285             :             ! Last factor found: read it and then exit the loop
    1286     3548511 :             iop = n - i + 2
    1287     3548511 :             parsing_done = .TRUE.
    1288       16683 :          ELSE IF ((islash > 0) .AND. (istar > 0)) THEN
    1289        6308 :             iop = MIN(islash, istar)
    1290       10375 :          ELSE IF (islash > 0) THEN
    1291             :             iop = islash
    1292        4360 :          ELSE IF (istar > 0) THEN
    1293        4360 :             iop = istar
    1294             :          END IF
    1295     3565194 :          ileft = INDEX(string(i:MIN(n, i + maxlen + 1)), "(")
    1296     3565194 :          IF (ileft > 0) THEN
    1297             :             ! Check for sign
    1298         282 :             is = ICHAR(string(i:i))
    1299          12 :             SELECT CASE (is)
    1300             :             CASE (43)
    1301          12 :                fsign = 1.0_dp
    1302          12 :                func = string(i + 1:i + ileft - 2)
    1303             :             CASE (45)
    1304          22 :                fsign = -1.0_dp
    1305          22 :                func = string(i + 1:i + ileft - 2)
    1306             :             CASE DEFAULT
    1307         248 :                fsign = 1.0_dp
    1308         282 :                func = string(i:i + ileft - 2)
    1309             :             END SELECT
    1310         282 :             iright = INDEX(string(i:n), ")")
    1311         282 :             READ (UNIT=string(i + ileft:i + iright - 2), FMT=*, IOSTAT=istat) z
    1312         282 :             IF (istat /= 0) THEN
    1313             :                error_message = "A floating point type object as argument for function <"// &
    1314             :                                TRIM(func)//"> is expected, found <"// &
    1315         182 :                                string(i + ileft:i + iright - 2)//">"
    1316      793009 :                RETURN
    1317             :             END IF
    1318           8 :             SELECT CASE (func)
    1319             :             CASE ("COS")
    1320           8 :                z = fsign*COS(z*radians)
    1321             :             CASE ("EXP")
    1322           4 :                z = fsign*EXP(z)
    1323             :             CASE ("LOG")
    1324           4 :                z = fsign*LOG(z)
    1325             :             CASE ("LOG10")
    1326           4 :                z = fsign*LOG10(z)
    1327             :             CASE ("SIN")
    1328           6 :                z = fsign*SIN(z*radians)
    1329             :             CASE ("SQRT")
    1330           4 :                z = fsign*SQRT(z)
    1331             :             CASE ("TAN")
    1332           4 :                z = fsign*TAN(z*radians)
    1333             :             CASE DEFAULT
    1334          66 :                error_message = "Unknown function <"//TRIM(func)//"> found"
    1335         100 :                RETURN
    1336             :             END SELECT
    1337             :          ELSE
    1338     3564912 :             READ (UNIT=string(i:i + iop - 2), FMT=*, IOSTAT=istat) z
    1339     3564912 :             IF (istat /= 0) THEN
    1340             :                error_message = "A floating point type object was expected, found <"// &
    1341      792761 :                                string(i:i + iop - 2)//">"
    1342      792761 :                RETURN
    1343             :             END IF
    1344             :          END IF
    1345     5539866 :          IF (i == 1) THEN
    1346     2770975 :             object = z
    1347        1210 :          ELSE IF (string(i - 1:i - 1) == "*") THEN
    1348         112 :             object = object*z
    1349             :          ELSE
    1350        1098 :             IF (z == 0.0_dp) THEN
    1351             :                error_message = "Division by zero found <"// &
    1352           0 :                                string(i:i + iop - 2)//">"
    1353           0 :                RETURN
    1354             :             ELSE
    1355        1098 :                object = object/z
    1356             :             END IF
    1357             :          END IF
    1358             :       END DO
    1359             : 
    1360     3560690 :    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     4634005 :    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     4634005 :       error_message = ""
    1385             : 
    1386     4634005 :       i = 1
    1387     4634005 :       iop = 0
    1388     4634005 :       n = LEN_TRIM(string)
    1389             : 
    1390     4634005 :       parsing_done = .FALSE.
    1391             : 
    1392     7633001 :       DO WHILE (.NOT. parsing_done)
    1393     4637225 :          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     4637225 :          iop = INDEX(string(i:n), "*")
    1397     4637225 :          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     4626515 :             iop = n - i + 2
    1403     4626515 :             parsing_done = .TRUE.
    1404             :          END IF
    1405     4637225 :          istat = 1
    1406     4637225 :          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     4637221 :             WRITE (fmtstr, FMT='(A,I0,A)') '(I', iop - 1, ')'
    1411     4637221 :             READ (UNIT=string(i:i + iop - 2), FMT=fmtstr, IOSTAT=istat) iz8
    1412             :          END IF
    1413     4637225 :          IF (istat /= 0) THEN
    1414             :             error_message = "An integer type object was expected, found <"// &
    1415     1638229 :                             string(i:i + iop - 2)//">"
    1416     1638229 :             RETURN
    1417             :          END IF
    1418     2998996 :          IF (i == 1) THEN
    1419     2998864 :             object8 = iz8
    1420             :          ELSE
    1421         132 :             object8 = object8*iz8
    1422             :          END IF
    1423     5994772 :          IF (ABS(object8) > HUGE(0)) THEN
    1424             :             error_message = "The specified integer number <"//string(i:i + iop - 2)// &
    1425           0 :                             "> exceeds the allowed range of a 32-bit integer number."
    1426           0 :             RETURN
    1427             :          END IF
    1428             :       END DO
    1429             : 
    1430     2995776 :       object = INT(object8)
    1431             : 
    1432     4634005 :    END SUBROUTINE read_integer_object
    1433             : 
    1434             : END MODULE cp_parser_methods

Generated by: LCOV version 1.15