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