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