LCOV - code coverage report
Current view: top level - src/input - cp_parser_inpp_methods.F (source / functions) Hit Total Coverage
Test: CP2K Regtests (git:b40b070) Lines: 220 275 80.0 %
Date: 2024-07-14 07:18:37 Functions: 5 6 83.3 %

          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 a module to allow simple internal preprocessing in input files.
      10             : !> \par History
      11             : !>      - standalone proof-of-concept implementation (20.02.2008,AK)
      12             : !>      - integration into cp2k (22.02.2008,tlaino)
      13             : !>      - variables added (23.02.2008,AK)
      14             : !>      - @IF/@ENDIF added (25.02.2008,AK)
      15             : !>      - @PRINT and debug ifdefs added (26.02.2008,AK)
      16             : !> \author Axel Kohlmeyer [AK] - CMM/UPenn Philadelphia
      17             : !> \date 20.02.2008
      18             : ! **************************************************************************************************
      19             : MODULE cp_parser_inpp_methods
      20             :    USE cp_files, ONLY: close_file, &
      21             :                        open_file, file_exists
      22             :    USE cp_log_handling, ONLY: cp_logger_get_default_io_unit
      23             :    USE cp_parser_inpp_types, ONLY: inpp_type
      24             :    USE kinds, ONLY: default_path_length, &
      25             :                     default_string_length
      26             :    USE memory_utilities, ONLY: reallocate
      27             :    USE string_utilities, ONLY: is_whitespace, &
      28             :                                uppercase
      29             : #include "../base/base_uses.f90"
      30             : 
      31             :    IMPLICIT NONE
      32             : 
      33             :    PRIVATE
      34             :    CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'cp_parser_inpp_methods'
      35             :    LOGICAL, PARAMETER, PRIVATE          :: debug_this_module = .FALSE.
      36             :    INTEGER, PARAMETER, PRIVATE          :: max_message_length = 400
      37             : 
      38             :    PUBLIC  :: inpp_process_directive, inpp_end_include, inpp_expand_variables
      39             :    PRIVATE :: inpp_find_variable, inpp_list_variables
      40             : 
      41             : CONTAINS
      42             : 
      43             : ! **************************************************************************************************
      44             : !> \brief Validates whether the given string is a valid preprocessor variable name
      45             : !> \param str The input string (must be already trimmed if necessary)
      46             : !> \return .TRUE. if it is a valid variable name, .FALSE. otherwise
      47             : ! **************************************************************************************************
      48       10640 :    LOGICAL PURE FUNCTION is_valid_varname(str)
      49             :       CHARACTER(LEN=*), INTENT(IN) :: str
      50             :       CHARACTER(LEN=*), PARAMETER  :: alpha = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ_"
      51             :       CHARACTER(LEN=*), PARAMETER  :: alphanum = alpha//"0123456789"
      52             :       INTEGER                      :: idx
      53             : 
      54       10640 :       is_valid_varname = .FALSE.
      55             : 
      56       10640 :       IF (LEN(str) == 0) &
      57             :          RETURN
      58             : 
      59       10640 :       IF (INDEX(alpha, str(1:1)) == 0) &
      60             :          RETURN
      61             : 
      62      114521 :       DO idx = 2, LEN(str)
      63      103881 :          IF (INDEX(alphanum, str(idx:idx)) == 0) &
      64       10640 :             RETURN
      65             :       END DO
      66             : 
      67       10640 :       is_valid_varname = .TRUE.
      68             :    END FUNCTION is_valid_varname
      69             : ! **************************************************************************************************
      70             : !> \brief process internal preprocessor directives like @INCLUDE, @SET, @IF/@ENDIF
      71             : !> \param inpp ...
      72             : !> \param input_line ...
      73             : !> \param input_file_name ...
      74             : !> \param input_line_number ...
      75             : !> \param input_unit ...
      76             : !> \par History
      77             : !>      - standalone proof-of-concept implementation (20.02.2008,AK)
      78             : !>      - integration into cp2k (22.02.2008,tlaino)
      79             : !>      - variables added (23.02.2008,AK)
      80             : !>      - @IF/@ENDIF added (25.02.2008,AK)
      81             : !> \author AK
      82             : ! **************************************************************************************************
      83        9853 :    SUBROUTINE inpp_process_directive(inpp, input_line, input_file_name, input_line_number, &
      84             :                                      input_unit)
      85             :       TYPE(inpp_type), POINTER                           :: inpp
      86             :       CHARACTER(LEN=*), INTENT(INOUT)                    :: input_line, input_file_name
      87             :       INTEGER, INTENT(INOUT)                             :: input_line_number, input_unit
      88             : 
      89             :       CHARACTER(LEN=default_path_length)                 :: cond1, cond2, filename, mytag, value, &
      90             :                                                             varname
      91             :       CHARACTER(LEN=max_message_length)                  :: message
      92             :       INTEGER                                            :: i, indf, indi, istat, output_unit, pos1, &
      93             :                                                             pos2, unit
      94             :       LOGICAL                                            :: check
      95             : 
      96       19706 :       output_unit = cp_logger_get_default_io_unit()
      97             : 
      98        9853 :       CPASSERT(ASSOCIATED(inpp))
      99             : 
     100             :       ! Find location of directive in line and check whether it is commented out
     101        9853 :       indi = INDEX(input_line, "@")
     102        9853 :       pos1 = INDEX(input_line, "!")
     103        9853 :       pos2 = INDEX(input_line, "#")
     104        9853 :       IF (((pos1 > 0) .AND. (pos1 < indi)) .OR. ((pos2 > 0) .AND. (pos2 < indi))) THEN
     105             :          ! Nothing to do
     106        2495 :          RETURN
     107             :       END IF
     108             : 
     109             :       ! Get the start of the instruction and find "@KEYWORD" (or "@")
     110             :       indf = indi
     111       60178 :       DO WHILE (.NOT. is_whitespace(input_line(indf:indf)))
     112       50325 :          indf = indf + 1
     113             :       END DO
     114        9853 :       mytag = input_line(indi:indf - 1)
     115        9853 :       CALL uppercase(mytag)
     116             : 
     117         513 :       SELECT CASE (mytag)
     118             : 
     119             :       CASE ("@INCLUDE")
     120             :          ! Get the file name, allow for " or ' or nothing
     121         513 :          filename = TRIM(input_line(indf:))
     122         513 :          IF (LEN_TRIM(filename) == 0) THEN
     123             :             WRITE (UNIT=message, FMT="(A,I0)") &
     124             :                "No filename argument found for "//TRIM(mytag)// &
     125             :                " directive in file <"//TRIM(input_file_name)// &
     126           0 :                ">  Line:", input_line_number
     127           0 :             CPABORT(TRIM(message))
     128             :          END IF
     129         513 :          indi = 1
     130        1027 :          DO WHILE (is_whitespace(filename(indi:indi)))
     131         514 :             indi = indi + 1
     132             :          END DO
     133         513 :          filename = TRIM(filename(indi:))
     134             : 
     135             :          ! Handle quoting of the filename
     136         513 :          pos1 = INDEX(filename, '"')
     137         513 :          pos2 = INDEX(filename(pos1 + 1:), '"')
     138         513 :          IF ((pos1 /= 0) .AND. (pos2 /= 0)) THEN
     139           8 :             filename = filename(pos1 + 1:pos1 + pos2 - 1)
     140             :          ELSE
     141         505 :             pos1 = INDEX(filename, "'")
     142         505 :             pos2 = INDEX(filename(pos1 + 1:), "'")
     143         505 :             IF ((pos1 /= 0) .AND. (pos2 /= 0)) THEN
     144          40 :                filename = filename(pos1 + 1:pos1 + pos2 - 1)
     145             :             ELSE
     146             :                ! Check quoting of the included file name
     147         465 :                pos2 = INDEX(filename, '"')
     148         465 :                IF ((pos1 /= 0) .OR. (pos2 /= 0)) THEN
     149             :                   WRITE (UNIT=message, FMT="(A,I0)") &
     150           0 :                      "Incorrect quoting of the included filename in file <", &
     151           0 :                      TRIM(input_file_name)//">  Line:", input_line_number
     152           0 :                   CPABORT(TRIM(message))
     153             :                END IF
     154             :             END IF
     155             :          END IF
     156             : 
     157             :          ! Let's check that files already opened won't be again opened
     158         656 :          DO i = 1, inpp%io_stack_level
     159         143 :             check = TRIM(filename) /= TRIM(inpp%io_stack_filename(i))
     160         656 :             CPASSERT(check)
     161             :          END DO
     162             : 
     163             :          CALL open_file(file_name=TRIM(filename), &
     164             :                         file_status="OLD", &
     165             :                         file_form="FORMATTED", &
     166             :                         file_action="READ", &
     167         513 :                         unit_number=unit)
     168             : 
     169             :          ! Make room, save status and position the parser at the beginning of new file.
     170         513 :          inpp%io_stack_level = inpp%io_stack_level + 1
     171         513 :          CALL reallocate(inpp%io_stack_channel, 1, inpp%io_stack_level)
     172         513 :          CALL reallocate(inpp%io_stack_lineno, 1, inpp%io_stack_level)
     173         513 :          CALL reallocate(inpp%io_stack_filename, 1, inpp%io_stack_level)
     174             : 
     175         513 :          inpp%io_stack_channel(inpp%io_stack_level) = input_unit
     176         513 :          inpp%io_stack_lineno(inpp%io_stack_level) = input_line_number
     177         513 :          inpp%io_stack_filename(inpp%io_stack_level) = input_file_name
     178             : 
     179         513 :          input_file_name = TRIM(filename)
     180         513 :          input_line_number = 0
     181         513 :          input_unit = unit
     182             : 
     183             :       CASE ("@FFTYPE", "@XCTYPE")
     184             :          ! Include a &XC section from the data/xc_section directory or include
     185             :          ! a &FORCEFIELD section from the data/forcefield_section directory
     186             :          ! Get the filename, allow for " or ' or nothing
     187          23 :          filename = TRIM(input_line(indf:))
     188          23 :          IF (LEN_TRIM(filename) == 0) THEN
     189             :             WRITE (UNIT=message, FMT="(A,I0)") &
     190             :                "No filename argument found for "//TRIM(mytag)// &
     191             :                " directive in file <"//TRIM(input_file_name)// &
     192           0 :                ">  Line:", input_line_number
     193           0 :             CPABORT(TRIM(message))
     194             :          END IF
     195          23 :          indi = 1
     196          46 :          DO WHILE (is_whitespace(filename(indi:indi)))
     197          23 :             indi = indi + 1
     198             :          END DO
     199          23 :          filename = TRIM(filename(indi:))
     200             : 
     201             :          ! Handle quoting of the filename
     202          23 :          pos1 = INDEX(filename, '"')
     203          23 :          pos2 = INDEX(filename(pos1 + 1:), '"')
     204          23 :          IF ((pos1 /= 0) .AND. (pos2 /= 0)) THEN
     205           0 :             filename = filename(pos1 + 1:pos1 + pos2 - 1)
     206             :          ELSE
     207          23 :             pos1 = INDEX(filename, "'")
     208          23 :             pos2 = INDEX(filename(pos1 + 1:), "'")
     209          23 :             IF ((pos1 /= 0) .AND. (pos2 /= 0)) THEN
     210           0 :                filename = filename(pos1 + 1:pos1 + pos2 - 1)
     211             :             ELSE
     212             :                ! Incorrect quotes (only one of ' or ").
     213          23 :                pos2 = INDEX(filename, '"')
     214          23 :                IF ((pos1 /= 0) .OR. (pos2 /= 0)) THEN
     215             :                   WRITE (UNIT=message, FMT="(A,I0)") &
     216           0 :                      "Incorrect quoting of the filename argument in file <", &
     217           0 :                      TRIM(input_file_name)//">  Line:", input_line_number
     218           0 :                   CPABORT(TRIM(message))
     219             :                END IF
     220             :             END IF
     221             :          END IF
     222             : 
     223             :          ! Add file extension ".sec"
     224          23 :          filename = TRIM(filename)//".sec"
     225             :          ! Check for file
     226          23 :          IF (.NOT. file_exists(TRIM(filename))) THEN
     227          23 :             IF (filename(1:1) == "/") THEN
     228             :                ! this is an absolute path filename, don't change
     229             :             ELSE
     230           5 :                SELECT CASE (mytag)
     231             :                CASE ("@FFTYPE")
     232           5 :                   filename = "forcefield_section/"//TRIM(filename)
     233             :                CASE ("@XCTYPE")
     234          23 :                   filename = "xc_section/"//TRIM(filename)
     235             :                END SELECT
     236             :             END IF
     237             :          END IF
     238          23 :          IF (.NOT. file_exists(TRIM(filename))) THEN
     239             :             WRITE (UNIT=message, FMT="(A,I0)") &
     240             :                TRIM(mytag)//": Could not find the file <"// &
     241             :                TRIM(filename)//"> with the input section given in the file <"// &
     242           0 :                TRIM(input_file_name)//">  Line: ", input_line_number
     243           0 :             CPABORT(TRIM(message))
     244             :          END IF
     245             : 
     246             :          ! Let's check that files already opened won't be again opened
     247          23 :          DO i = 1, inpp%io_stack_level
     248           0 :             check = TRIM(filename) /= TRIM(inpp%io_stack_filename(i))
     249          23 :             CPASSERT(check)
     250             :          END DO
     251             : 
     252             :          ! This stops on error so we can always assume success
     253             :          CALL open_file(file_name=TRIM(filename), &
     254             :                         file_status="OLD", &
     255             :                         file_form="FORMATTED", &
     256             :                         file_action="READ", &
     257          23 :                         unit_number=unit)
     258             : 
     259             :          ! make room, save status and position the parser at the beginning of new file.
     260          23 :          inpp%io_stack_level = inpp%io_stack_level + 1
     261          23 :          CALL reallocate(inpp%io_stack_channel, 1, inpp%io_stack_level)
     262          23 :          CALL reallocate(inpp%io_stack_lineno, 1, inpp%io_stack_level)
     263          23 :          CALL reallocate(inpp%io_stack_filename, 1, inpp%io_stack_level)
     264             : 
     265          23 :          inpp%io_stack_channel(inpp%io_stack_level) = input_unit
     266          23 :          inpp%io_stack_lineno(inpp%io_stack_level) = input_line_number
     267          23 :          inpp%io_stack_filename(inpp%io_stack_level) = input_file_name
     268             : 
     269          23 :          input_file_name = TRIM(filename)
     270          23 :          input_line_number = 0
     271          23 :          input_unit = unit
     272             : 
     273             :       CASE ("@SET")
     274             :          ! Split directive into variable name and value data.
     275        4074 :          varname = TRIM(input_line(indf:))
     276        4074 :          IF (LEN_TRIM(varname) == 0) THEN
     277             :             WRITE (UNIT=message, FMT="(A,I0)") &
     278             :                "No variable name found for "//TRIM(mytag)//" directive in file <"// &
     279           0 :                TRIM(input_file_name)//">  Line:", input_line_number
     280           0 :             CPABORT(TRIM(message))
     281             :          END IF
     282             : 
     283        4074 :          indi = 1
     284        8153 :          DO WHILE (is_whitespace(varname(indi:indi)))
     285        4079 :             indi = indi + 1
     286             :          END DO
     287             :          indf = indi
     288       50491 :          DO WHILE (.NOT. is_whitespace(varname(indf:indf)))
     289       46417 :             indf = indf + 1
     290             :          END DO
     291        4074 :          value = TRIM(varname(indf:))
     292        4074 :          varname = TRIM(varname(indi:indf - 1))
     293             : 
     294        4074 :          IF (.NOT. is_valid_varname(TRIM(varname))) THEN
     295             :             WRITE (UNIT=message, FMT="(A,I0)") &
     296             :                "Invalid variable name for "//TRIM(mytag)//" directive in file <"// &
     297           0 :                TRIM(input_file_name)//">  Line:", input_line_number
     298           0 :             CPABORT(TRIM(message))
     299             :          END IF
     300             : 
     301        4074 :          indi = 1
     302       30261 :          DO WHILE (is_whitespace(value(indi:indi)))
     303       26187 :             indi = indi + 1
     304             :          END DO
     305        4074 :          value = TRIM(value(indi:))
     306             : 
     307        4074 :          IF (LEN_TRIM(value) == 0) THEN
     308             :             WRITE (UNIT=message, FMT="(A,I0)") &
     309             :                "Incomplete "//TRIM(mytag)//" directive: "// &
     310             :                "No value found for variable <"//TRIM(varname)//"> in file <"// &
     311           0 :                TRIM(input_file_name)//">  Line:", input_line_number
     312           0 :             CPABORT(TRIM(message))
     313             :          END IF
     314             : 
     315             :          ! sort into table of variables.
     316        4074 :          indi = inpp_find_variable(inpp, varname)
     317        4074 :          IF (indi == 0) THEN
     318             :             ! create new variable
     319        3821 :             inpp%num_variables = inpp%num_variables + 1
     320        3821 :             CALL reallocate(inpp%variable_name, 1, inpp%num_variables)
     321        3821 :             CALL reallocate(inpp%variable_value, 1, inpp%num_variables)
     322        3821 :             inpp%variable_name(inpp%num_variables) = varname
     323        3821 :             inpp%variable_value(inpp%num_variables) = value
     324             :             IF (debug_this_module .AND. output_unit > 0) THEN
     325             :                WRITE (UNIT=message, FMT="(3A,I6,4A)") "INPP_@SET: in file: ", &
     326             :                   TRIM(input_file_name), "  Line:", input_line_number, &
     327             :                   " Set new variable ", TRIM(varname), " to value: ", TRIM(value)
     328             :                WRITE (output_unit, *) TRIM(message)
     329             :             END IF
     330             :          ELSE
     331             :             ! reassign variable
     332             :             IF (debug_this_module .AND. output_unit > 0) THEN
     333             :                WRITE (UNIT=message, FMT="(3A,I6,6A)") "INPP_@SET: in file: ", &
     334             :                   TRIM(input_file_name), "  Line:", input_line_number, &
     335             :                   " Change variable ", TRIM(varname), " from value: ", &
     336             :                   TRIM(inpp%variable_value(indi)), " to value: ", TRIM(value)
     337             :                WRITE (output_unit, *) TRIM(message)
     338             :             END IF
     339         253 :             inpp%variable_value(indi) = value
     340             :          END IF
     341             : 
     342        2495 :          IF (debug_this_module) CALL inpp_list_variables(inpp, 6)
     343             : 
     344             :       CASE ("@IF")
     345             :          ! detect IF expression.
     346             :          ! we recognize lexical equality or inequality, and presence of
     347             :          ! a string (true) vs. blank (false). in case the expression resolves
     348             :          ! to "false" we read lines here until we reach an @ENDIF or EOF.
     349        2495 :          indi = indf
     350        2495 :          pos1 = INDEX(input_line, "==")
     351        2495 :          pos2 = INDEX(input_line, "/=")
     352             :          ! shave off leading whitespace
     353        4989 :          DO WHILE (is_whitespace(input_line(indi:indi)))
     354        2495 :             indi = indi + 1
     355        4989 :             IF (indi > LEN_TRIM(input_line)) EXIT
     356             :          END DO
     357        2495 :          check = .FALSE.
     358        2495 :          IF (pos1 > 0) THEN
     359        2366 :             cond1 = input_line(indi:pos1 - 1)
     360        2366 :             cond2 = input_line(pos1 + 2:)
     361        2366 :             check = .TRUE.
     362        2366 :             IF ((pos2 > 0) .OR. (INDEX(cond2, "==") > 0)) THEN
     363             :                WRITE (UNIT=message, FMT="(A,I0)") &
     364           0 :                   "Incorrect "//TRIM(mytag)//" directive found in file <", &
     365           0 :                   TRIM(input_file_name)//">  Line:", input_line_number
     366           0 :                CPABORT(TRIM(message))
     367             :             END IF
     368         129 :          ELSE IF (pos2 > 0) THEN
     369           2 :             cond1 = input_line(indi:pos2 - 1)
     370           2 :             cond2 = input_line(pos2 + 2:)
     371           2 :             check = .FALSE.
     372           2 :             IF ((pos1 > 0) .OR. (INDEX(cond2, "/=") > 0)) THEN
     373             :                WRITE (UNIT=message, FMT="(A,I0)") &
     374           0 :                   "Incorrect "//TRIM(mytag)//" directive found in file <", &
     375           0 :                   TRIM(input_file_name)//">  Line:", input_line_number
     376           0 :                CPABORT(TRIM(message))
     377             :             END IF
     378             :          ELSE
     379         127 :             IF (LEN_TRIM(input_line(indi:)) > 0) THEN
     380         126 :                IF (TRIM(input_line(indi:)) == '0') THEN
     381          62 :                   cond1 = 'XXX'
     382          62 :                   cond2 = 'XXX'
     383          62 :                   check = .FALSE.
     384             :                ELSE
     385          64 :                   cond1 = 'XXX'
     386          64 :                   cond2 = 'XXX'
     387          64 :                   check = .TRUE.
     388             :                END IF
     389             :             ELSE
     390           1 :                cond1 = 'XXX'
     391           1 :                cond2 = 'XXX'
     392           1 :                check = .FALSE.
     393             :             END IF
     394             :          END IF
     395             : 
     396             :          ! Get rid of possible parentheses
     397        2495 :          IF (INDEX(cond1, "(") /= 0) cond1 = cond1(INDEX(cond1, "(") + 1:)
     398        2495 :          IF (INDEX(cond2, ")") /= 0) cond2 = cond2(1:INDEX(cond2, ")") - 1)
     399             : 
     400             :          ! Shave off leading whitespace from cond1
     401        2495 :          indi = 1
     402        4780 :          DO WHILE (is_whitespace(cond1(indi:indi)))
     403        2285 :             indi = indi + 1
     404             :          END DO
     405        2495 :          cond1 = cond1(indi:)
     406             : 
     407             :          ! Shave off leading whitespace from cond2
     408        2495 :          indi = 1
     409        4861 :          DO WHILE (is_whitespace(cond2(indi:indi)))
     410        2366 :             indi = indi + 1
     411             :          END DO
     412        2495 :          cond2 = cond2(indi:)
     413             : 
     414        2495 :          IF (LEN_TRIM(cond2) == 0) THEN
     415             :             WRITE (UNIT=message, FMT="(3A,I6)") &
     416           0 :                "INPP_@IF: Incorrect @IF directive in file: ", &
     417           0 :                TRIM(input_file_name), "  Line:", input_line_number
     418           0 :             CPABORT(TRIM(message))
     419             :          END IF
     420             : 
     421        2495 :          IF ((TRIM(cond1) == TRIM(cond2)) .EQV. check) THEN
     422             :             IF (debug_this_module .AND. output_unit > 0) THEN
     423             :                WRITE (UNIT=message, FMT="(3A,I6,A)") "INPP_@IF: in file: ", &
     424             :                   TRIM(input_file_name), "  Line:", input_line_number, &
     425             :                   " Conditional ("//TRIM(cond1)//","//TRIM(cond2)// &
     426             :                   ") resolves to true. Continuing parsing."
     427             :                WRITE (output_unit, *) TRIM(message)
     428             :             END IF
     429             :             ! resolves to true. keep on reading normally...
     430             :             RETURN
     431             :          ELSE
     432             :             IF (debug_this_module .AND. output_unit > 0) THEN
     433             :                WRITE (UNIT=message, FMT="(3A,I6,A)") "INPP_@IF: in file: ", &
     434             :                   TRIM(input_file_name), "  Line:", input_line_number, &
     435             :                   " Conditional ("//TRIM(cond1)//","//TRIM(cond2)// &
     436             :                   ") resolves to false. Skipping Lines."
     437             :                WRITE (output_unit, *) TRIM(message)
     438             :             END IF
     439        1198 :             istat = 0
     440        5532 :             DO WHILE (istat == 0)
     441        5532 :                input_line_number = input_line_number + 1
     442        5532 :                READ (UNIT=input_unit, FMT="(A)", IOSTAT=istat) input_line
     443             :                IF (debug_this_module .AND. output_unit > 0) THEN
     444             :                   WRITE (UNIT=message, FMT="(1A,I6,2A)") "INPP_@IF: skipping line ", &
     445             :                      input_line_number, ": ", TRIM(input_line)
     446             :                   WRITE (output_unit, *) TRIM(message)
     447             :                END IF
     448             : 
     449        5532 :                indi = INDEX(input_line, "@")
     450        5532 :                pos1 = INDEX(input_line, "!")
     451        5532 :                pos2 = INDEX(input_line, "#")
     452        5532 :                IF (((pos1 > 0) .AND. (pos1 < indi)) .OR. ((pos2 > 0) .AND. (pos2 < indi))) THEN
     453             :                   ! Nothing to do
     454             :                   CYCLE
     455             :                END IF
     456             : 
     457             :                ! Get the start of the instruction and find "@KEYWORD"
     458        5532 :                indi = MAX(1, indi)
     459        5532 :                indf = indi
     460       12892 :                DO WHILE (input_line(indf:indf) /= " ")
     461        7360 :                   indf = indf + 1
     462             :                END DO
     463        5532 :                CPASSERT((indf - indi) <= default_string_length)
     464        5532 :                mytag = input_line(indi:indf - 1)
     465        5532 :                CALL uppercase(mytag)
     466        5532 :                IF (INDEX(mytag, "@ENDIF") > 0) THEN
     467             :                   ! ok found it. go back to normal
     468             :                   IF (debug_this_module .AND. output_unit > 0) THEN
     469             :                      WRITE (output_unit, *) "INPP_@IF: found @ENDIF. End of skipping."
     470             :                   END IF
     471             :                   RETURN
     472             :                END IF
     473             :             END DO
     474             :             IF (istat /= 0) THEN
     475             :                WRITE (UNIT=message, FMT="(A,I0)") &
     476             :                   "Error while searching for matching @ENDIF directive in file <"// &
     477           0 :                   TRIM(input_file_name)//">  Line:", input_line_number
     478           0 :                CPABORT(TRIM(message))
     479             :             END IF
     480             :          END IF
     481             : 
     482             :       CASE ("@ENDIF")
     483             :          ! In normal mode, just skip line and continue
     484           1 :          IF (debug_this_module .AND. output_unit > 0) THEN
     485             :             WRITE (UNIT=message, FMT="(A,I0)") &
     486             :                TRIM(mytag)//" directive found and ignored in file <"// &
     487             :                TRIM(input_file_name)//">  Line: ", input_line_number
     488             :          END IF
     489             : 
     490             :       CASE ("@PRINT")
     491             :          ! For debugging of variables etc.
     492        9853 :          IF (output_unit > 0) THEN
     493             :             WRITE (UNIT=output_unit, FMT="(T2,A,I0,A)") &
     494             :                TRIM(mytag)//" directive in file <"// &
     495           1 :                TRIM(input_file_name)//">  Line: ", input_line_number, &
     496           2 :                " ->"//TRIM(input_line(indf:))
     497             :          END IF
     498             : 
     499             :       END SELECT
     500             : 
     501        9853 :    END SUBROUTINE inpp_process_directive
     502             : 
     503             : ! **************************************************************************************************
     504             : !> \brief Restore older file status from stack after EOF on include file.
     505             : !> \param inpp ...
     506             : !> \param input_file_name ...
     507             : !> \param input_line_number ...
     508             : !> \param input_unit ...
     509             : !> \par History
     510             : !>      - standalone proof-of-concept implementation (20.02.2008,AK)
     511             : !>      - integrated into cp2k (21.02.2008)
     512             : !> \author AK
     513             : ! **************************************************************************************************
     514         536 :    SUBROUTINE inpp_end_include(inpp, input_file_name, input_line_number, input_unit)
     515             :       TYPE(inpp_type), POINTER                           :: inpp
     516             :       CHARACTER(LEN=*), INTENT(INOUT)                    :: input_file_name
     517             :       INTEGER, INTENT(INOUT)                             :: input_line_number, input_unit
     518             : 
     519           0 :       CPASSERT(ASSOCIATED(inpp))
     520         536 :       IF (inpp%io_stack_level > 0) THEN
     521         536 :          CALL close_file(input_unit)
     522         536 :          input_unit = inpp%io_stack_channel(inpp%io_stack_level)
     523         536 :          input_line_number = inpp%io_stack_lineno(inpp%io_stack_level)
     524         536 :          input_file_name = TRIM(inpp%io_stack_filename(inpp%io_stack_level))
     525         536 :          inpp%io_stack_level = inpp%io_stack_level - 1
     526         536 :          CALL reallocate(inpp%io_stack_channel, 1, inpp%io_stack_level)
     527         536 :          CALL reallocate(inpp%io_stack_lineno, 1, inpp%io_stack_level)
     528         536 :          CALL reallocate(inpp%io_stack_filename, 1, inpp%io_stack_level)
     529             :       END IF
     530             : 
     531         536 :    END SUBROUTINE inpp_end_include
     532             : 
     533             : ! **************************************************************************************************
     534             : !> \brief expand all ${VAR} or $VAR variable entries on the input string (LTR, no nested vars)
     535             : !> \param inpp ...
     536             : !> \param input_line ...
     537             : !> \param input_file_name ...
     538             : !> \param input_line_number ...
     539             : !> \par History
     540             : !>      - standalone proof-of-concept implementation (22.02.2008,AK)
     541             : !>      - integrated into cp2k (23.02.2008)
     542             : !> \author AK
     543             : ! **************************************************************************************************
     544        5740 :    SUBROUTINE inpp_expand_variables(inpp, input_line, input_file_name, input_line_number)
     545             :       TYPE(inpp_type), POINTER                           :: inpp
     546             :       CHARACTER(LEN=*), INTENT(INOUT)                    :: input_line, input_file_name
     547             :       INTEGER, INTENT(IN)                                :: input_line_number
     548             : 
     549             :       CHARACTER(LEN=default_path_length)                 :: newline
     550             :       CHARACTER(LEN=max_message_length)                  :: message
     551        5740 :       CHARACTER(LEN=:), ALLOCATABLE                      :: var_value, var_name
     552             :       INTEGER                                            :: idx, pos1, pos2, default_val_sep_idx
     553             : 
     554           0 :       CPASSERT(ASSOCIATED(inpp))
     555             : 
     556             :       ! process line until all variables named with the convention ${VAR} are expanded
     557       12130 :       DO WHILE (INDEX(input_line, '${') > 0)
     558        6390 :          pos1 = INDEX(input_line, '${')
     559        6390 :          pos1 = pos1 + 2
     560        6390 :          pos2 = INDEX(input_line(pos1:), '}')
     561             : 
     562        6390 :          IF (pos2 == 0) THEN
     563             :             WRITE (UNIT=message, FMT="(3A,I6)") &
     564           0 :                "Missing '}' in file: ", &
     565           0 :                TRIM(input_file_name), "  Line:", input_line_number
     566           0 :             CPABORT(TRIM(message))
     567             :          END IF
     568             : 
     569        6390 :          pos2 = pos1 + pos2 - 2
     570        6390 :          var_name = input_line(pos1:pos2)
     571             : 
     572        6390 :          default_val_sep_idx = INDEX(var_name, '-')
     573             : 
     574        6390 :          IF (default_val_sep_idx > 0) THEN
     575           8 :             var_value = var_name(default_val_sep_idx + 1:)
     576           8 :             var_name = var_name(:default_val_sep_idx - 1)
     577             :          END IF
     578             : 
     579        6390 :          IF (.NOT. is_valid_varname(var_name)) THEN
     580             :             WRITE (UNIT=message, FMT="(5A,I6)") &
     581           0 :                "Invalid variable name ${", var_name, "} in file: ", &
     582           0 :                TRIM(input_file_name), "  Line:", input_line_number
     583           0 :             CPABORT(TRIM(message))
     584             :          END IF
     585             : 
     586        6390 :          idx = inpp_find_variable(inpp, var_name)
     587             : 
     588        6390 :          IF (idx == 0 .AND. default_val_sep_idx == 0) THEN
     589             :             WRITE (UNIT=message, FMT="(5A,I6)") &
     590           0 :                "Variable ${", var_name, "} not defined in file: ", &
     591           0 :                TRIM(input_file_name), "  Line:", input_line_number
     592           0 :             CPABORT(TRIM(message))
     593             :          END IF
     594             : 
     595        6390 :          IF (idx > 0) &
     596        6390 :             var_value = TRIM(inpp%variable_value(idx))
     597             : 
     598        6390 :          newline = input_line(1:pos1 - 3)//var_value//input_line(pos2 + 2:)
     599       12130 :          input_line = newline
     600             :       END DO
     601             : 
     602             :       ! process line until all variables named with the convention $VAR are expanded
     603        5916 :       DO WHILE (INDEX(input_line, '$') > 0)
     604         176 :          pos1 = INDEX(input_line, '$')
     605         176 :          pos1 = pos1 + 1 ! move to the start of the variable name
     606         176 :          pos2 = INDEX(input_line(pos1:), ' ')
     607             : 
     608         176 :          IF (pos2 == 0) &
     609           0 :             pos2 = LEN_TRIM(input_line(pos1:)) + 1
     610             : 
     611         176 :          pos2 = pos1 + pos2 - 2 ! end of the variable name, minus the separating whitespace
     612         176 :          var_name = input_line(pos1:pos2)
     613         176 :          idx = inpp_find_variable(inpp, var_name)
     614             : 
     615         176 :          IF (.NOT. is_valid_varname(var_name)) THEN
     616             :             WRITE (UNIT=message, FMT="(5A,I6)") &
     617           0 :                "Invalid variable name ${", var_name, "} in file: ", &
     618           0 :                TRIM(input_file_name), "  Line:", input_line_number
     619           0 :             CPABORT(TRIM(message))
     620             :          END IF
     621             : 
     622         176 :          IF (idx == 0) THEN
     623             :             WRITE (UNIT=message, FMT="(5A,I6)") &
     624           0 :                "Variable $", var_name, " not defined in file: ", &
     625           0 :                TRIM(input_file_name), "  Line:", input_line_number
     626           0 :             CPABORT(TRIM(message))
     627             :          END IF
     628             : 
     629         176 :          newline = input_line(1:pos1 - 2)//TRIM(inpp%variable_value(idx))//input_line(pos2 + 1:)
     630        5916 :          input_line = newline
     631             :       END DO
     632             : 
     633       11480 :    END SUBROUTINE inpp_expand_variables
     634             : 
     635             : ! **************************************************************************************************
     636             : !> \brief return index position of a variable in dictionary. 0 if not found.
     637             : !> \param inpp ...
     638             : !> \param varname ...
     639             : !> \return ...
     640             : !> \par History
     641             : !>      - standalone proof-of-concept implementation (22.02.2008,AK)
     642             : !>      - integrated into cp2k (23.02.2008)
     643             : !> \author AK
     644             : ! **************************************************************************************************
     645       10640 :    FUNCTION inpp_find_variable(inpp, varname) RESULT(idx)
     646             :       TYPE(inpp_type), POINTER                           :: inpp
     647             :       CHARACTER(len=*), INTENT(IN)                       :: varname
     648             :       INTEGER                                            :: idx
     649             : 
     650             :       INTEGER                                            :: i
     651             : 
     652       10640 :       idx = 0
     653      128235 :       DO i = 1, inpp%num_variables
     654      128235 :          IF (TRIM(varname) == TRIM(inpp%variable_name(i))) THEN
     655       10640 :             idx = i
     656             :             RETURN
     657             :          END IF
     658             :       END DO
     659             :       RETURN
     660             :    END FUNCTION inpp_find_variable
     661             : 
     662             : ! **************************************************************************************************
     663             : !> \brief print a list of the variable/value table
     664             : !> \param inpp ...
     665             : !> \param iochan ...
     666             : !> \par History
     667             : !>      - standalone proof-of-concept implementation (22.02.2008,AK)
     668             : !>      - integrated into cp2k (23.02.2008)
     669             : !> \author AK
     670             : ! **************************************************************************************************
     671           0 :    SUBROUTINE inpp_list_variables(inpp, iochan)
     672             :       TYPE(inpp_type), POINTER                           :: inpp
     673             :       INTEGER, INTENT(IN)                                :: iochan
     674             : 
     675             :       INTEGER                                            :: i
     676             : 
     677           0 :       WRITE (iochan, '(A)') '   #   NAME                   VALUE'
     678           0 :       DO i = 1, inpp%num_variables
     679             :          WRITE (iochan, '(I4," | ",A,T30," | ",A," |")') &
     680           0 :             i, TRIM(inpp%variable_name(i)), TRIM(inpp%variable_value(i))
     681             :       END DO
     682           0 :    END SUBROUTINE inpp_list_variables
     683             : 
     684           8 : END MODULE cp_parser_inpp_methods

Generated by: LCOV version 1.15