LCOV - code coverage report
Current view: top level - src/input - cp_parser_inpp_methods.F (source / functions) Hit Total Coverage
Test: CP2K Regtests (git:c94756d) Lines: 221 283 78.1 %
Date: 2023-09-27 07:33:39 Functions: 5 6 83.3 %

          Line data    Source code
       1             : !--------------------------------------------------------------------------------------------------!
       2             : !   CP2K: A general program to perform molecular dynamics simulations                              !
       3             : !   Copyright 2000-2023 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       10423 :    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       10423 :       is_valid_varname = .FALSE.
      55             : 
      56       10423 :       IF (LEN(str) == 0) &
      57             :          RETURN
      58             : 
      59       10423 :       IF (INDEX(alpha, str(1:1)) == 0) &
      60             :          RETURN
      61             : 
      62      113992 :       DO idx = 2, LEN(str)
      63      103569 :          IF (INDEX(alphanum, str(idx:idx)) == 0) &
      64       10423 :             RETURN
      65             :       END DO
      66             : 
      67       10423 :       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        9800 :    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       19600 :       output_unit = cp_logger_get_default_io_unit()
      97             : 
      98        9800 :       CPASSERT(ASSOCIATED(inpp))
      99             : 
     100             :       ! find location of directive in line and check whether it is commented out
     101        9800 :       indi = INDEX(input_line, "@")
     102        9800 :       pos1 = INDEX(input_line, "!")
     103        9800 :       pos2 = INDEX(input_line, "#")
     104        9800 :       IF (((pos1 > 0) .AND. (pos1 < indi)) .OR. ((pos2 > 0) .AND. (pos2 < indi))) THEN
     105             :          ! nothing to do here.
     106        3793 :          RETURN
     107             :       END IF
     108             : 
     109             :       ! Get the start of the instruction and find "@KEYWORD" (or "@")
     110             :       indf = indi
     111       59898 :       DO WHILE (.NOT. is_whitespace(input_line(indf:indf)))
     112       50098 :          indf = indf + 1
     113             :       END DO
     114        9800 :       mytag = input_line(indi:indf - 1)
     115        9800 :       CALL uppercase(mytag)
     116             : 
     117         513 :       SELECT CASE (mytag)
     118             : 
     119             :       CASE ("@INCLUDE")
     120             :          ! Get the filename.. 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="(3A,I6)") &
     124           0 :                "INPP_@INCLUDE: Incorrect @INCLUDE directive in file: ", &
     125           0 :                TRIM(input_file_name), "  Line:", input_line_number
     126           0 :             CPABORT(TRIM(message))
     127             :          END IF
     128         513 :          indi = 1
     129        1027 :          DO WHILE (is_whitespace(filename(indi:indi)))
     130         514 :             indi = indi + 1
     131             :          END DO
     132         513 :          filename = TRIM(filename(indi:))
     133             : 
     134             :          ! handle quoting of the filename
     135         513 :          pos1 = INDEX(filename, '"')
     136         513 :          pos2 = INDEX(filename(pos1 + 1:), '"')
     137         513 :          IF ((pos1 /= 0) .AND. (pos2 /= 0)) THEN
     138           8 :             filename = filename(pos1 + 1:pos1 + pos2 - 1)
     139             :          ELSE
     140         505 :             pos1 = INDEX(filename, "'")
     141         505 :             pos2 = INDEX(filename(pos1 + 1:), "'")
     142         505 :             IF ((pos1 /= 0) .AND. (pos2 /= 0)) THEN
     143          40 :                filename = filename(pos1 + 1:pos1 + pos2 - 1)
     144             :             ELSE
     145             :                ! incorrect quotes (only one of ' or ").
     146         465 :                pos2 = INDEX(filename, '"')
     147         465 :                IF ((pos1 /= 0) .OR. (pos2 /= 0)) THEN
     148             :                   WRITE (UNIT=message, FMT="(3A,I6)") &
     149           0 :                      "INPP_@INCLUDE: Incorrect quoting of include file in file: ", &
     150           0 :                      TRIM(input_file_name), "  Line:", input_line_number
     151           0 :                   CPABORT(TRIM(message))
     152             :                END IF
     153             :                ! nothing to do. unquoted filename.
     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             :          ! this stops on so we can always assume success
     164             :          CALL open_file(file_name=TRIM(filename), &
     165             :                         file_status="OLD", &
     166             :                         file_form="FORMATTED", &
     167             :                         file_action="READ", &
     168         513 :                         unit_number=unit)
     169             : 
     170             :          IF (debug_this_module .AND. output_unit > 0) THEN
     171             :             WRITE (UNIT=message, FMT="(3A,I6,2A)") "INPP_@INCLUDE: in file: ", &
     172             :                TRIM(input_file_name), "  Line:", input_line_number, &
     173             :                " Opened include file: ", TRIM(filename)
     174             :             WRITE (output_unit, *) TRIM(message)
     175             :          END IF
     176             : 
     177             :          ! make room, save status and position the parser at the beginning of new file.
     178         513 :          inpp%io_stack_level = inpp%io_stack_level + 1
     179         513 :          CALL reallocate(inpp%io_stack_channel, 1, inpp%io_stack_level)
     180         513 :          CALL reallocate(inpp%io_stack_lineno, 1, inpp%io_stack_level)
     181         513 :          CALL reallocate(inpp%io_stack_filename, 1, inpp%io_stack_level)
     182             : 
     183         513 :          inpp%io_stack_channel(inpp%io_stack_level) = input_unit
     184         513 :          inpp%io_stack_lineno(inpp%io_stack_level) = input_line_number
     185         513 :          inpp%io_stack_filename(inpp%io_stack_level) = input_file_name
     186             : 
     187         513 :          input_file_name = TRIM(filename)
     188         513 :          input_line_number = 0
     189         513 :          input_unit = unit
     190             : 
     191             :       CASE ("@XCTYPE")
     192             :          ! Include a &XC section from the data/xc_section directory or the local directory
     193             :          ! Get the filename.. allow for " or ' or nothing..
     194          18 :          filename = TRIM(input_line(indf:))
     195          18 :          IF (LEN_TRIM(filename) == 0) THEN
     196             :             WRITE (UNIT=message, FMT="(3A,I6)") &
     197           0 :                "INPP_@XCTYPE: Incorrect @XCTYPE directive in file: ", &
     198           0 :                TRIM(input_file_name), "  Line:", input_line_number
     199           0 :             CPABORT(TRIM(message))
     200             :          END IF
     201          18 :          indi = 1
     202          36 :          DO WHILE (is_whitespace(filename(indi:indi)))
     203          18 :             indi = indi + 1
     204             :          END DO
     205          18 :          filename = TRIM(filename(indi:))
     206             : 
     207             :          ! handle quoting of the filename
     208          18 :          pos1 = INDEX(filename, '"')
     209          18 :          pos2 = INDEX(filename(pos1 + 1:), '"')
     210          18 :          IF ((pos1 /= 0) .AND. (pos2 /= 0)) THEN
     211           0 :             filename = filename(pos1 + 1:pos1 + pos2 - 1)
     212             :          ELSE
     213          18 :             pos1 = INDEX(filename, "'")
     214          18 :             pos2 = INDEX(filename(pos1 + 1:), "'")
     215          18 :             IF ((pos1 /= 0) .AND. (pos2 /= 0)) THEN
     216           0 :                filename = filename(pos1 + 1:pos1 + pos2 - 1)
     217             :             ELSE
     218             :                ! incorrect quotes (only one of ' or ").
     219          18 :                pos2 = INDEX(filename, '"')
     220          18 :                IF ((pos1 /= 0) .OR. (pos2 /= 0)) THEN
     221             :                   WRITE (UNIT=message, FMT="(3A,I6)") &
     222           0 :                      "INPP_@XCTYPE: Incorrect quoting of include file in file: ", &
     223           0 :                      TRIM(input_file_name), "  Line:", input_line_number
     224           0 :                   CPABORT(TRIM(message))
     225             :                END IF
     226             :                ! nothing to do. unquoted filename.
     227             :             END IF
     228             :          END IF
     229             : 
     230             :          ! add file extension ".sec"
     231          18 :          filename = TRIM(filename)//".sec"
     232             :          ! check for file
     233          18 :          IF (.NOT. file_exists(TRIM(filename))) THEN
     234          18 :             IF (filename(1:1) == '/') THEN
     235             :                ! this is an absolute path filename, don't change
     236             :             ELSE
     237          18 :                filename = "xc_section"//'/'//filename
     238             :             END IF
     239             :          END IF
     240          18 :          IF (.NOT. file_exists(TRIM(filename))) THEN
     241             :             WRITE (UNIT=message, FMT="(3A,I6)") &
     242           0 :                "INPP_@XCTYPE: Could not find input XC section: ", &
     243           0 :                TRIM(input_file_name), "  Line:", input_line_number
     244           0 :             CPABORT(TRIM(message))
     245             :          END IF
     246             : 
     247             :          ! Let's check that files already opened won't be again opened
     248          18 :          DO i = 1, inpp%io_stack_level
     249           0 :             check = TRIM(filename) /= TRIM(inpp%io_stack_filename(i))
     250          18 :             CPASSERT(check)
     251             :          END DO
     252             : 
     253             :          ! this stops on so we can always assume success
     254             :          CALL open_file(file_name=TRIM(filename), &
     255             :                         file_status="OLD", &
     256             :                         file_form="FORMATTED", &
     257             :                         file_action="READ", &
     258          18 :                         unit_number=unit)
     259             : 
     260             :          IF (debug_this_module .AND. output_unit > 0) THEN
     261             :             WRITE (UNIT=message, FMT="(3A,I6,2A)") "INPP_@XCTYPE: in file: ", &
     262             :                TRIM(input_file_name), "  Line:", input_line_number, &
     263             :                " Opened include file: ", TRIM(filename)
     264             :             WRITE (output_unit, *) TRIM(message)
     265             :          END IF
     266             : 
     267             :          ! make room, save status and position the parser at the beginning of new file.
     268          18 :          inpp%io_stack_level = inpp%io_stack_level + 1
     269          18 :          CALL reallocate(inpp%io_stack_channel, 1, inpp%io_stack_level)
     270          18 :          CALL reallocate(inpp%io_stack_lineno, 1, inpp%io_stack_level)
     271          18 :          CALL reallocate(inpp%io_stack_filename, 1, inpp%io_stack_level)
     272             : 
     273          18 :          inpp%io_stack_channel(inpp%io_stack_level) = input_unit
     274          18 :          inpp%io_stack_lineno(inpp%io_stack_level) = input_line_number
     275          18 :          inpp%io_stack_filename(inpp%io_stack_level) = input_file_name
     276             : 
     277          18 :          input_file_name = TRIM(filename)
     278          18 :          input_line_number = 0
     279          18 :          input_unit = unit
     280             : 
     281             :       CASE ("@SET")
     282             :          ! split directive into variable name and value data.
     283        4026 :          varname = TRIM(input_line(indf:))
     284        4026 :          IF (LEN_TRIM(varname) == 0) THEN
     285             :             WRITE (UNIT=message, FMT="(3A,I6)") &
     286           0 :                "INPP_@SET: Incorrect @SET directive in file: ", &
     287           0 :                TRIM(input_file_name), "  Line:", input_line_number
     288           0 :             CPABORT(TRIM(message))
     289             :          END IF
     290             : 
     291        4026 :          indi = 1
     292        8057 :          DO WHILE (is_whitespace(varname(indi:indi)))
     293        4031 :             indi = indi + 1
     294             :          END DO
     295             :          indf = indi
     296       50307 :          DO WHILE (.NOT. is_whitespace(varname(indf:indf)))
     297       46281 :             indf = indf + 1
     298             :          END DO
     299        4026 :          value = TRIM(varname(indf:))
     300        4026 :          varname = TRIM(varname(indi:indf - 1))
     301             : 
     302        4026 :          IF (.NOT. is_valid_varname(TRIM(varname))) THEN
     303             :             WRITE (UNIT=message, FMT="(3A,I6)") &
     304           0 :                "INPP_@SET: Invalid variable name in @SET directive in file: ", &
     305           0 :                TRIM(input_file_name), "  Line:", input_line_number
     306           0 :             CPABORT(TRIM(message))
     307             :          END IF
     308             : 
     309        4026 :          indi = 1
     310       30019 :          DO WHILE (is_whitespace(value(indi:indi)))
     311       25993 :             indi = indi + 1
     312             :          END DO
     313        4026 :          value = TRIM(value(indi:))
     314             : 
     315        4026 :          IF (LEN_TRIM(value) == 0) THEN
     316             :             WRITE (UNIT=message, FMT="(3A,I6)") &
     317           0 :                "INPP_@SET: Incorrect @SET directive in file: ", &
     318           0 :                TRIM(input_file_name), "  Line:", input_line_number
     319           0 :             CPABORT(TRIM(message))
     320             :          END IF
     321             : 
     322             :          ! sort into table of variables.
     323        4026 :          indi = inpp_find_variable(inpp, varname)
     324        4026 :          IF (indi == 0) THEN
     325             :             ! create new variable
     326        3773 :             inpp%num_variables = inpp%num_variables + 1
     327        3773 :             CALL reallocate(inpp%variable_name, 1, inpp%num_variables)
     328        3773 :             CALL reallocate(inpp%variable_value, 1, inpp%num_variables)
     329        3773 :             inpp%variable_name(inpp%num_variables) = varname
     330        3773 :             inpp%variable_value(inpp%num_variables) = value
     331             :             IF (debug_this_module .AND. output_unit > 0) THEN
     332             :                WRITE (UNIT=message, FMT="(3A,I6,4A)") "INPP_@SET: in file: ", &
     333             :                   TRIM(input_file_name), "  Line:", input_line_number, &
     334             :                   " Set new variable ", TRIM(varname), " to value: ", TRIM(value)
     335             :                WRITE (output_unit, *) TRIM(message)
     336             :             END IF
     337             :          ELSE
     338             :             ! reassign variable
     339             :             IF (debug_this_module .AND. output_unit > 0) THEN
     340             :                WRITE (UNIT=message, FMT="(3A,I6,6A)") "INPP_@SET: in file: ", &
     341             :                   TRIM(input_file_name), "  Line:", input_line_number, &
     342             :                   " Change variable ", TRIM(varname), " from value: ", &
     343             :                   TRIM(inpp%variable_value(indi)), " to value: ", TRIM(value)
     344             :                WRITE (output_unit, *) TRIM(message)
     345             :             END IF
     346         253 :             inpp%variable_value(indi) = value
     347             :          END IF
     348             : 
     349        2495 :          IF (debug_this_module) CALL inpp_list_variables(inpp, 6)
     350             : 
     351             :       CASE ("@IF")
     352             :          ! detect IF expression.
     353             :          ! we recognize lexical equality or inequality, and presence of
     354             :          ! a string (true) vs. blank (false). in case the expression resolves
     355             :          ! to "false" we read lines here until we reach an @ENDIF or EOF.
     356        2495 :          indi = indf
     357        2495 :          pos1 = INDEX(input_line, "==")
     358        2495 :          pos2 = INDEX(input_line, "/=")
     359             :          ! shave off leading whitespace
     360        4989 :          DO WHILE (is_whitespace(input_line(indi:indi)))
     361        2495 :             indi = indi + 1
     362        4989 :             IF (indi > LEN_TRIM(input_line)) EXIT
     363             :          END DO
     364        2495 :          check = .FALSE.
     365        2495 :          IF (pos1 > 0) THEN
     366        2366 :             cond1 = input_line(indi:pos1 - 1)
     367        2366 :             cond2 = input_line(pos1 + 2:)
     368        2366 :             check = .TRUE.
     369        2366 :             IF ((pos2 > 0) .OR. (INDEX(cond2, "==") > 0)) THEN
     370             :                WRITE (UNIT=message, FMT="(3A,I6)") &
     371           0 :                   "INPP_@IF: Incorrect @IF directive in file: ", &
     372           0 :                   TRIM(input_file_name), "  Line:", input_line_number
     373           0 :                CPABORT(TRIM(message))
     374             :             END IF
     375         129 :          ELSEIF (pos2 > 0) THEN
     376           2 :             cond1 = input_line(indi:pos2 - 1)
     377           2 :             cond2 = input_line(pos2 + 2:)
     378           2 :             check = .FALSE.
     379           2 :             IF ((pos1 > 0) .OR. (INDEX(cond2, "/=") > 0)) THEN
     380             :                WRITE (UNIT=message, FMT="(3A,I6)") &
     381           0 :                   "INPP_@IF: Incorrect @IF directive in file: ", &
     382           0 :                   TRIM(input_file_name), "  Line:", input_line_number
     383           0 :                CPABORT(TRIM(message))
     384             :             END IF
     385             :          ELSE
     386         127 :             IF (LEN_TRIM(input_line(indi:)) > 0) THEN
     387         126 :                IF (TRIM(input_line(indi:)) == '0') THEN
     388          62 :                   cond1 = 'XXX'
     389          62 :                   cond2 = 'XXX'
     390          62 :                   check = .FALSE.
     391             :                ELSE
     392          64 :                   cond1 = 'XXX'
     393          64 :                   cond2 = 'XXX'
     394          64 :                   check = .TRUE.
     395             :                END IF
     396             :             ELSE
     397           1 :                cond1 = 'XXX'
     398           1 :                cond2 = 'XXX'
     399           1 :                check = .FALSE.
     400             :             END IF
     401             :          END IF
     402             : 
     403             :          ! Get rid of possible parentheses
     404        2495 :          IF (INDEX(cond1, "(") /= 0) cond1 = cond1(INDEX(cond1, "(") + 1:)
     405        2495 :          IF (INDEX(cond2, ")") /= 0) cond2 = cond2(1:INDEX(cond2, ")") - 1)
     406             : 
     407             :          ! Shave off leading whitespace from cond1
     408        2495 :          indi = 1
     409        4780 :          DO WHILE (is_whitespace(cond1(indi:indi)))
     410        2285 :             indi = indi + 1
     411             :          END DO
     412        2495 :          cond1 = cond1(indi:)
     413             : 
     414             :          ! Shave off leading whitespace from cond2
     415        2495 :          indi = 1
     416        4861 :          DO WHILE (is_whitespace(cond2(indi:indi)))
     417        2366 :             indi = indi + 1
     418             :          END DO
     419        2495 :          cond2 = cond2(indi:)
     420             : 
     421        2495 :          IF (LEN_TRIM(cond2) == 0) THEN
     422             :             WRITE (UNIT=message, FMT="(3A,I6)") &
     423           0 :                "INPP_@IF: Incorrect @IF directive in file: ", &
     424           0 :                TRIM(input_file_name), "  Line:", input_line_number
     425           0 :             CPABORT(TRIM(message))
     426             :          END IF
     427             : 
     428        2495 :          IF ((TRIM(cond1) == TRIM(cond2)) .EQV. check) THEN
     429             :             IF (debug_this_module .AND. output_unit > 0) THEN
     430             :                WRITE (UNIT=message, FMT="(3A,I6,A)") "INPP_@IF: in file: ", &
     431             :                   TRIM(input_file_name), "  Line:", input_line_number, &
     432             :                   " Conditional ("//TRIM(cond1)//","//TRIM(cond2)// &
     433             :                   ") resolves to true. Continuing parsing."
     434             :                WRITE (output_unit, *) TRIM(message)
     435             :             END IF
     436             :             ! resolves to true. keep on reading normally...
     437             :             RETURN
     438             :          ELSE
     439             :             IF (debug_this_module .AND. output_unit > 0) THEN
     440             :                WRITE (UNIT=message, FMT="(3A,I6,A)") "INPP_@IF: in file: ", &
     441             :                   TRIM(input_file_name), "  Line:", input_line_number, &
     442             :                   " Conditional ("//TRIM(cond1)//","//TRIM(cond2)// &
     443             :                   ") resolves to false. Skipping Lines."
     444             :                WRITE (output_unit, *) TRIM(message)
     445             :             END IF
     446        1198 :             istat = 0
     447        5528 :             DO WHILE (istat == 0)
     448        5528 :                input_line_number = input_line_number + 1
     449        5528 :                READ (UNIT=input_unit, FMT="(A)", IOSTAT=istat) input_line
     450             :                IF (debug_this_module .AND. output_unit > 0) THEN
     451             :                   WRITE (UNIT=message, FMT="(1A,I6,2A)") "INPP_@IF: skipping line ", &
     452             :                      input_line_number, ": ", TRIM(input_line)
     453             :                   WRITE (output_unit, *) TRIM(message)
     454             :                END IF
     455             : 
     456        5528 :                indi = INDEX(input_line, "@")
     457        5528 :                pos1 = INDEX(input_line, "!")
     458        5528 :                pos2 = INDEX(input_line, "#")
     459        5528 :                IF (((pos1 > 0) .AND. (pos1 < indi)) .OR. ((pos2 > 0) .AND. (pos2 < indi))) THEN
     460             :                   ! comment. nothing to do here.
     461             :                   CYCLE
     462             :                END IF
     463             : 
     464             :                ! Get the start of the instruction and find "@KEYWORD"
     465        5528 :                indi = MAX(1, indi)
     466        5528 :                indf = indi
     467       12906 :                DO WHILE (input_line(indf:indf) /= " ")
     468        7378 :                   indf = indf + 1
     469             :                END DO
     470        5528 :                CPASSERT((indf - indi) <= default_string_length)
     471        5528 :                mytag = input_line(indi:indf - 1)
     472        5528 :                CALL uppercase(mytag)
     473        5528 :                IF (INDEX(mytag, "@ENDIF") > 0) THEN
     474             :                   ! ok found it. go back to normal
     475             :                   IF (debug_this_module .AND. output_unit > 0) THEN
     476             :                      WRITE (output_unit, *) "INPP_@IF: found @ENDIF. End of skipping."
     477             :                   END IF
     478             :                   RETURN
     479             :                END IF
     480             :             END DO
     481             :             IF (istat /= 0) THEN
     482             :                WRITE (UNIT=message, FMT="(3A,I6)") &
     483           0 :                   "INPP_@IF: Error while looking for @ENDIF directive in file: ", &
     484           0 :                   TRIM(input_file_name), "  Line:", input_line_number
     485           0 :                CPABORT(TRIM(message))
     486             :             END IF
     487             :          END IF
     488             : 
     489             :       CASE ("@ENDIF")
     490             :          IF (debug_this_module .AND. output_unit > 0) THEN
     491             :             WRITE (output_unit, *) "INPP_@IF: found @ENDIF in normal parsing. Ignoring it."
     492             :          END IF
     493             :          ! nothing to do. just return to skip the line.
     494           1 :          RETURN
     495             : 
     496             :       CASE ("@PRINT")
     497             :          ! for debugging of variables etc.
     498           1 :          IF (output_unit > 0) THEN
     499           1 :             WRITE (UNIT=message, FMT="(3A,I6,2A)") "INPP_@PRINT: in file: ", &
     500           1 :                TRIM(input_file_name), "  Line:", input_line_number, &
     501           2 :                " Text: ", TRIM(input_line(indf:))
     502           1 :             WRITE (output_unit, *) TRIM(message)
     503             :          END IF
     504        9800 :          RETURN
     505             :          ! Do Nothing..
     506             :       END SELECT
     507             : 
     508        9800 :    END SUBROUTINE inpp_process_directive
     509             : 
     510             : ! **************************************************************************************************
     511             : !> \brief Restore older file status from stack after EOF on include file.
     512             : !> \param inpp ...
     513             : !> \param input_file_name ...
     514             : !> \param input_line_number ...
     515             : !> \param input_unit ...
     516             : !> \par History
     517             : !>      - standalone proof-of-concept implementation (20.02.2008,AK)
     518             : !>      - integrated into cp2k (21.02.2008)
     519             : !> \author AK
     520             : ! **************************************************************************************************
     521         531 :    SUBROUTINE inpp_end_include(inpp, input_file_name, input_line_number, input_unit)
     522             :       TYPE(inpp_type), POINTER                           :: inpp
     523             :       CHARACTER(LEN=*), INTENT(INOUT)                    :: input_file_name
     524             :       INTEGER, INTENT(INOUT)                             :: input_line_number, input_unit
     525             : 
     526           0 :       CPASSERT(ASSOCIATED(inpp))
     527         531 :       IF (inpp%io_stack_level > 0) THEN
     528         531 :          CALL close_file(input_unit)
     529         531 :          input_unit = inpp%io_stack_channel(inpp%io_stack_level)
     530         531 :          input_line_number = inpp%io_stack_lineno(inpp%io_stack_level)
     531         531 :          input_file_name = TRIM(inpp%io_stack_filename(inpp%io_stack_level))
     532         531 :          inpp%io_stack_level = inpp%io_stack_level - 1
     533         531 :          CALL reallocate(inpp%io_stack_channel, 1, inpp%io_stack_level)
     534         531 :          CALL reallocate(inpp%io_stack_lineno, 1, inpp%io_stack_level)
     535         531 :          CALL reallocate(inpp%io_stack_filename, 1, inpp%io_stack_level)
     536             :       END IF
     537             : 
     538         531 :    END SUBROUTINE inpp_end_include
     539             : 
     540             : ! **************************************************************************************************
     541             : !> \brief expand all ${VAR} or $VAR variable entries on the input string (LTR, no nested vars)
     542             : !> \param inpp ...
     543             : !> \param input_line ...
     544             : !> \param input_file_name ...
     545             : !> \param input_line_number ...
     546             : !> \par History
     547             : !>      - standalone proof-of-concept implementation (22.02.2008,AK)
     548             : !>      - integrated into cp2k (23.02.2008)
     549             : !> \author AK
     550             : ! **************************************************************************************************
     551        5634 :    SUBROUTINE inpp_expand_variables(inpp, input_line, input_file_name, input_line_number)
     552             :       TYPE(inpp_type), POINTER                           :: inpp
     553             :       CHARACTER(LEN=*), INTENT(INOUT)                    :: input_line, input_file_name
     554             :       INTEGER, INTENT(IN)                                :: input_line_number
     555             : 
     556             :       CHARACTER(LEN=default_path_length)                 :: newline
     557             :       CHARACTER(LEN=max_message_length)                  :: message
     558        5634 :       CHARACTER(LEN=:), ALLOCATABLE                      :: var_value, var_name
     559             :       INTEGER                                            :: idx, pos1, pos2, default_val_sep_idx
     560             : 
     561           0 :       CPASSERT(ASSOCIATED(inpp))
     562             : 
     563             :       ! process line until all variables named with the convention ${VAR} are expanded
     564       11855 :       DO WHILE (INDEX(input_line, '${') > 0)
     565        6221 :          pos1 = INDEX(input_line, '${')
     566        6221 :          pos1 = pos1 + 2
     567        6221 :          pos2 = INDEX(input_line(pos1:), '}')
     568             : 
     569        6221 :          IF (pos2 == 0) THEN
     570             :             WRITE (UNIT=message, FMT="(3A,I6)") &
     571           0 :                "Missing '}' in file: ", &
     572           0 :                TRIM(input_file_name), "  Line:", input_line_number
     573           0 :             CPABORT(TRIM(message))
     574             :          END IF
     575             : 
     576        6221 :          pos2 = pos1 + pos2 - 2
     577        6221 :          var_name = input_line(pos1:pos2)
     578             : 
     579        6221 :          default_val_sep_idx = INDEX(var_name, '-')
     580             : 
     581        6221 :          IF (default_val_sep_idx > 0) THEN
     582           8 :             var_value = var_name(default_val_sep_idx + 1:)
     583           8 :             var_name = var_name(:default_val_sep_idx - 1)
     584             :          END IF
     585             : 
     586        6221 :          IF (.NOT. is_valid_varname(var_name)) THEN
     587             :             WRITE (UNIT=message, FMT="(5A,I6)") &
     588           0 :                "Invalid variable name ${", var_name, "} in file: ", &
     589           0 :                TRIM(input_file_name), "  Line:", input_line_number
     590           0 :             CPABORT(TRIM(message))
     591             :          END IF
     592             : 
     593        6221 :          idx = inpp_find_variable(inpp, var_name)
     594             : 
     595        6221 :          IF (idx == 0 .AND. default_val_sep_idx == 0) THEN
     596             :             WRITE (UNIT=message, FMT="(5A,I6)") &
     597           0 :                "Variable ${", var_name, "} not defined in file: ", &
     598           0 :                TRIM(input_file_name), "  Line:", input_line_number
     599           0 :             CPABORT(TRIM(message))
     600             :          END IF
     601             : 
     602        6221 :          IF (idx > 0) &
     603        6221 :             var_value = TRIM(inpp%variable_value(idx))
     604             : 
     605        6221 :          newline = input_line(1:pos1 - 3)//var_value//input_line(pos2 + 2:)
     606       11855 :          input_line = newline
     607             :       END DO
     608             : 
     609             :       ! process line until all variables named with the convention $VAR are expanded
     610        5810 :       DO WHILE (INDEX(input_line, '$') > 0)
     611         176 :          pos1 = INDEX(input_line, '$')
     612         176 :          pos1 = pos1 + 1 ! move to the start of the variable name
     613         176 :          pos2 = INDEX(input_line(pos1:), ' ')
     614             : 
     615         176 :          IF (pos2 == 0) &
     616           0 :             pos2 = LEN_TRIM(input_line(pos1:)) + 1
     617             : 
     618         176 :          pos2 = pos1 + pos2 - 2 ! end of the variable name, minus the separating whitespace
     619         176 :          var_name = input_line(pos1:pos2)
     620         176 :          idx = inpp_find_variable(inpp, var_name)
     621             : 
     622         176 :          IF (.NOT. is_valid_varname(var_name)) THEN
     623             :             WRITE (UNIT=message, FMT="(5A,I6)") &
     624           0 :                "Invalid variable name ${", var_name, "} in file: ", &
     625           0 :                TRIM(input_file_name), "  Line:", input_line_number
     626           0 :             CPABORT(TRIM(message))
     627             :          END IF
     628             : 
     629         176 :          IF (idx == 0) THEN
     630             :             WRITE (UNIT=message, FMT="(5A,I6)") &
     631           0 :                "Variable $", var_name, " not defined in file: ", &
     632           0 :                TRIM(input_file_name), "  Line:", input_line_number
     633           0 :             CPABORT(TRIM(message))
     634             :          END IF
     635             : 
     636         176 :          newline = input_line(1:pos1 - 2)//TRIM(inpp%variable_value(idx))//input_line(pos2 + 1:)
     637        5810 :          input_line = newline
     638             :       END DO
     639       11268 :    END SUBROUTINE inpp_expand_variables
     640             : 
     641             : ! **************************************************************************************************
     642             : !> \brief return index position of a variable in dictionary. 0 if not found.
     643             : !> \param inpp ...
     644             : !> \param varname ...
     645             : !> \return ...
     646             : !> \par History
     647             : !>      - standalone proof-of-concept implementation (22.02.2008,AK)
     648             : !>      - integrated into cp2k (23.02.2008)
     649             : !> \author AK
     650             : ! **************************************************************************************************
     651       10423 :    FUNCTION inpp_find_variable(inpp, varname) RESULT(idx)
     652             :       TYPE(inpp_type), POINTER                           :: inpp
     653             :       CHARACTER(len=*), INTENT(IN)                       :: varname
     654             :       INTEGER                                            :: idx
     655             : 
     656             :       INTEGER                                            :: i
     657             : 
     658       10423 :       idx = 0
     659      126894 :       DO i = 1, inpp%num_variables
     660      126894 :          IF (TRIM(varname) == TRIM(inpp%variable_name(i))) THEN
     661       10423 :             idx = i
     662             :             RETURN
     663             :          END IF
     664             :       END DO
     665             :       RETURN
     666             :    END FUNCTION inpp_find_variable
     667             : 
     668             : ! **************************************************************************************************
     669             : !> \brief print a list of the variable/value table
     670             : !> \param inpp ...
     671             : !> \param iochan ...
     672             : !> \par History
     673             : !>      - standalone proof-of-concept implementation (22.02.2008,AK)
     674             : !>      - integrated into cp2k (23.02.2008)
     675             : !> \author AK
     676             : ! **************************************************************************************************
     677           0 :    SUBROUTINE inpp_list_variables(inpp, iochan)
     678             :       TYPE(inpp_type), POINTER                           :: inpp
     679             :       INTEGER, INTENT(IN)                                :: iochan
     680             : 
     681             :       INTEGER                                            :: i
     682             : 
     683           0 :       WRITE (iochan, '(A)') '   #   NAME                   VALUE'
     684           0 :       DO i = 1, inpp%num_variables
     685             :          WRITE (iochan, '(I4," | ",A,T30," | ",A," |")') &
     686           0 :             i, TRIM(inpp%variable_name(i)), TRIM(inpp%variable_value(i))
     687             :       END DO
     688           0 :    END SUBROUTINE inpp_list_variables
     689             : 
     690           8 : END MODULE cp_parser_inpp_methods

Generated by: LCOV version 1.15