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