Line data Source code
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 : ! **************************************************************************************************
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 11031 : 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 11031 : is_valid_varname = .FALSE.
55 :
56 11031 : IF (LEN(str) == 0) then
57 : RETURN
58 : end if
59 :
60 11031 : IF (INDEX(alpha, str(1:1)) == 0) then
61 : RETURN
62 : end if
63 :
64 116478 : DO idx = 2, LEN(str)
65 116478 : IF (INDEX(alphanum, str(idx:idx)) == 0) then
66 : RETURN
67 : end if
68 : END DO
69 :
70 11031 : 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 9976 : 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 19952 : output_unit = cp_logger_get_default_io_unit()
100 :
101 9976 : CPASSERT(ASSOCIATED(inpp))
102 :
103 : ! Find location of directive in line and check whether it is commented out
104 9976 : indi = INDEX(input_line, "@")
105 9976 : pos1 = INDEX(input_line, "!")
106 9976 : pos2 = INDEX(input_line, "#")
107 9976 : IF (((pos1 > 0) .AND. (pos1 < indi)) .OR. ((pos2 > 0) .AND. (pos2 < indi))) THEN
108 : ! Nothing to do
109 2497 : RETURN
110 : END IF
111 :
112 : ! Get the start of the instruction and find "@KEYWORD" (or "@")
113 : indf = indi
114 60850 : DO WHILE (.NOT. is_whitespace(input_line(indf:indf)))
115 50874 : indf = indf + 1
116 : END DO
117 9976 : mytag = input_line(indi:indf - 1)
118 9976 : CALL uppercase(mytag)
119 :
120 513 : SELECT CASE (mytag)
121 :
122 : CASE ("@INCLUDE")
123 : ! Get the file name, allow for " or ' or nothing
124 513 : filename = TRIM(input_line(indf:))
125 513 : 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 0 : "> Line:", input_line_number
130 0 : CPABORT(TRIM(message))
131 : END IF
132 513 : indi = 1
133 1027 : DO WHILE (is_whitespace(filename(indi:indi)))
134 514 : indi = indi + 1
135 : END DO
136 513 : filename = TRIM(filename(indi:))
137 :
138 : ! Handle quoting of the filename
139 513 : pos1 = INDEX(filename, '"')
140 513 : pos2 = INDEX(filename(pos1 + 1:), '"')
141 513 : IF ((pos1 /= 0) .AND. (pos2 /= 0)) THEN
142 8 : filename = filename(pos1 + 1:pos1 + pos2 - 1)
143 : ELSE
144 505 : pos1 = INDEX(filename, "'")
145 505 : pos2 = INDEX(filename(pos1 + 1:), "'")
146 505 : IF ((pos1 /= 0) .AND. (pos2 /= 0)) THEN
147 40 : filename = filename(pos1 + 1:pos1 + pos2 - 1)
148 : ELSE
149 : ! Check quoting of the included file name
150 465 : pos2 = INDEX(filename, '"')
151 465 : IF ((pos1 /= 0) .OR. (pos2 /= 0)) THEN
152 : WRITE (UNIT=message, FMT="(A,I0)") &
153 0 : "Incorrect quoting of the included filename in file <", &
154 0 : TRIM(input_file_name)//"> Line:", input_line_number
155 0 : 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 656 : DO i = 1, inpp%io_stack_level
162 143 : check = TRIM(filename) /= TRIM(inpp%io_stack_filename(i))
163 656 : 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 513 : unit_number=unit)
171 :
172 : ! Make room, save status and position the parser at the beginning of new file.
173 513 : inpp%io_stack_level = inpp%io_stack_level + 1
174 513 : CALL reallocate(inpp%io_stack_channel, 1, inpp%io_stack_level)
175 513 : CALL reallocate(inpp%io_stack_lineno, 1, inpp%io_stack_level)
176 513 : CALL reallocate(inpp%io_stack_filename, 1, inpp%io_stack_level)
177 :
178 513 : inpp%io_stack_channel(inpp%io_stack_level) = input_unit
179 513 : inpp%io_stack_lineno(inpp%io_stack_level) = input_line_number
180 513 : inpp%io_stack_filename(inpp%io_stack_level) = input_file_name
181 :
182 513 : input_file_name = TRIM(filename)
183 513 : input_line_number = 0
184 513 : 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 24 : filename = TRIM(input_line(indf:))
191 24 : 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 0 : "> Line:", input_line_number
196 0 : CPABORT(TRIM(message))
197 : END IF
198 24 : indi = 1
199 48 : DO WHILE (is_whitespace(filename(indi:indi)))
200 24 : indi = indi + 1
201 : END DO
202 24 : filename = TRIM(filename(indi:))
203 :
204 : ! Handle quoting of the filename
205 24 : pos1 = INDEX(filename, '"')
206 24 : pos2 = INDEX(filename(pos1 + 1:), '"')
207 24 : IF ((pos1 /= 0) .AND. (pos2 /= 0)) THEN
208 0 : filename = filename(pos1 + 1:pos1 + pos2 - 1)
209 : ELSE
210 24 : pos1 = INDEX(filename, "'")
211 24 : pos2 = INDEX(filename(pos1 + 1:), "'")
212 24 : IF ((pos1 /= 0) .AND. (pos2 /= 0)) THEN
213 0 : filename = filename(pos1 + 1:pos1 + pos2 - 1)
214 : ELSE
215 : ! Incorrect quotes (only one of ' or ").
216 24 : pos2 = INDEX(filename, '"')
217 24 : IF ((pos1 /= 0) .OR. (pos2 /= 0)) THEN
218 : WRITE (UNIT=message, FMT="(A,I0)") &
219 0 : "Incorrect quoting of the filename argument in file <", &
220 0 : TRIM(input_file_name)//"> Line:", input_line_number
221 0 : CPABORT(TRIM(message))
222 : END IF
223 : END IF
224 : END IF
225 :
226 : ! Add file extension ".sec"
227 24 : filename = TRIM(filename)//".sec"
228 : ! Check for file
229 24 : IF (.NOT. file_exists(TRIM(filename))) THEN
230 24 : IF (filename(1:1) == "/") THEN
231 : ! this is an absolute path filename, don't change
232 : ELSE
233 5 : SELECT CASE (mytag)
234 : CASE ("@FFTYPE")
235 5 : filename = "forcefield_section/"//TRIM(filename)
236 : CASE ("@XCTYPE")
237 24 : filename = "xc_section/"//TRIM(filename)
238 : END SELECT
239 : END IF
240 : END IF
241 24 : 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 0 : TRIM(input_file_name)//"> Line: ", input_line_number
246 0 : CPABORT(TRIM(message))
247 : END IF
248 :
249 : ! Let's check that files already opened won't be again opened
250 24 : DO i = 1, inpp%io_stack_level
251 0 : check = TRIM(filename) /= TRIM(inpp%io_stack_filename(i))
252 24 : 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 24 : unit_number=unit)
261 :
262 : ! make room, save status and position the parser at the beginning of new file.
263 24 : inpp%io_stack_level = inpp%io_stack_level + 1
264 24 : CALL reallocate(inpp%io_stack_channel, 1, inpp%io_stack_level)
265 24 : CALL reallocate(inpp%io_stack_lineno, 1, inpp%io_stack_level)
266 24 : CALL reallocate(inpp%io_stack_filename, 1, inpp%io_stack_level)
267 :
268 24 : inpp%io_stack_channel(inpp%io_stack_level) = input_unit
269 24 : inpp%io_stack_lineno(inpp%io_stack_level) = input_line_number
270 24 : inpp%io_stack_filename(inpp%io_stack_level) = input_file_name
271 :
272 24 : input_file_name = TRIM(filename)
273 24 : input_line_number = 0
274 24 : input_unit = unit
275 :
276 : CASE ("@SET")
277 : ! Split directive into variable name and value data.
278 4184 : varname = TRIM(input_line(indf:))
279 4184 : 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 0 : TRIM(input_file_name)//"> Line:", input_line_number
283 0 : CPABORT(TRIM(message))
284 : END IF
285 :
286 4184 : indi = 1
287 8373 : DO WHILE (is_whitespace(varname(indi:indi)))
288 4189 : indi = indi + 1
289 : END DO
290 : indf = indi
291 51200 : DO WHILE (.NOT. is_whitespace(varname(indf:indf)))
292 47016 : indf = indf + 1
293 : END DO
294 4184 : value = TRIM(varname(indf:))
295 4184 : varname = TRIM(varname(indi:indf - 1))
296 :
297 4184 : 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 0 : TRIM(input_file_name)//"> Line:", input_line_number
301 0 : CPABORT(TRIM(message))
302 : END IF
303 :
304 4184 : indi = 1
305 30747 : DO WHILE (is_whitespace(value(indi:indi)))
306 26563 : indi = indi + 1
307 : END DO
308 4184 : value = TRIM(value(indi:))
309 :
310 4184 : 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 0 : TRIM(input_file_name)//"> Line:", input_line_number
315 0 : CPABORT(TRIM(message))
316 : END IF
317 :
318 : ! sort into table of variables.
319 4184 : indi = inpp_find_variable(inpp, varname)
320 4184 : IF (indi == 0) THEN
321 : ! create new variable
322 3931 : inpp%num_variables = inpp%num_variables + 1
323 3931 : CALL reallocate(inpp%variable_name, 1, inpp%num_variables)
324 3931 : CALL reallocate(inpp%variable_value, 1, inpp%num_variables)
325 3931 : inpp%variable_name(inpp%num_variables) = varname
326 3931 : 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 253 : inpp%variable_value(indi) = value
343 : END IF
344 :
345 2497 : 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 2497 : indi = indf
353 2497 : pos1 = INDEX(input_line, "==")
354 2497 : pos2 = INDEX(input_line, "/=")
355 : ! shave off leading whitespace
356 4993 : DO WHILE (is_whitespace(input_line(indi:indi)))
357 2497 : indi = indi + 1
358 4993 : IF (indi > LEN_TRIM(input_line)) EXIT
359 : END DO
360 2497 : check = .FALSE.
361 2497 : IF (pos1 > 0) THEN
362 2368 : cond1 = input_line(indi:pos1 - 1)
363 2368 : cond2 = input_line(pos1 + 2:)
364 2368 : check = .TRUE.
365 2368 : IF ((pos2 > 0) .OR. (INDEX(cond2, "==") > 0)) THEN
366 : WRITE (UNIT=message, FMT="(A,I0)") &
367 0 : "Incorrect "//TRIM(mytag)//" directive found in file <", &
368 0 : TRIM(input_file_name)//"> Line:", input_line_number
369 0 : CPABORT(TRIM(message))
370 : END IF
371 129 : ELSE IF (pos2 > 0) THEN
372 2 : cond1 = input_line(indi:pos2 - 1)
373 2 : cond2 = input_line(pos2 + 2:)
374 2 : check = .FALSE.
375 2 : IF ((pos1 > 0) .OR. (INDEX(cond2, "/=") > 0)) THEN
376 : WRITE (UNIT=message, FMT="(A,I0)") &
377 0 : "Incorrect "//TRIM(mytag)//" directive found in file <", &
378 0 : TRIM(input_file_name)//"> Line:", input_line_number
379 0 : CPABORT(TRIM(message))
380 : END IF
381 : ELSE
382 127 : IF (LEN_TRIM(input_line(indi:)) > 0) THEN
383 126 : IF (TRIM(input_line(indi:)) == '0') THEN
384 62 : cond1 = 'XXX'
385 62 : cond2 = 'XXX'
386 62 : check = .FALSE.
387 : ELSE
388 64 : cond1 = 'XXX'
389 64 : cond2 = 'XXX'
390 64 : check = .TRUE.
391 : END IF
392 : ELSE
393 1 : cond1 = 'XXX'
394 1 : cond2 = 'XXX'
395 1 : check = .FALSE.
396 : END IF
397 : END IF
398 :
399 : ! Get rid of possible parentheses
400 2497 : IF (INDEX(cond1, "(") /= 0) cond1 = cond1(INDEX(cond1, "(") + 1:)
401 2497 : IF (INDEX(cond2, ")") /= 0) cond2 = cond2(1:INDEX(cond2, ")") - 1)
402 :
403 : ! Shave off leading whitespace from cond1
404 2497 : indi = 1
405 4782 : DO WHILE (is_whitespace(cond1(indi:indi)))
406 2285 : indi = indi + 1
407 : END DO
408 2497 : cond1 = cond1(indi:)
409 :
410 : ! Shave off leading whitespace from cond2
411 2497 : indi = 1
412 4865 : DO WHILE (is_whitespace(cond2(indi:indi)))
413 2368 : indi = indi + 1
414 : END DO
415 2497 : cond2 = cond2(indi:)
416 :
417 2497 : IF (LEN_TRIM(cond2) == 0) THEN
418 : WRITE (UNIT=message, FMT="(3A,I6)") &
419 0 : "INPP_@IF: Incorrect @IF directive in file: ", &
420 0 : TRIM(input_file_name), " Line:", input_line_number
421 0 : CPABORT(TRIM(message))
422 : END IF
423 :
424 2497 : 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 1199 : istat = 0
443 5545 : DO WHILE (istat == 0)
444 5545 : input_line_number = input_line_number + 1
445 5545 : 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 5545 : indi = INDEX(input_line, "@")
453 5545 : pos1 = INDEX(input_line, "!")
454 5545 : pos2 = INDEX(input_line, "#")
455 5545 : 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 5545 : indi = MAX(1, indi)
462 5545 : indf = indi
463 12911 : DO WHILE (input_line(indf:indf) /= " ")
464 7366 : indf = indf + 1
465 : END DO
466 5545 : CPASSERT((indf - indi) <= default_string_length)
467 5545 : mytag = input_line(indi:indf - 1)
468 5545 : CALL uppercase(mytag)
469 5545 : 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 0 : TRIM(input_file_name)//"> Line:", input_line_number
481 0 : CPABORT(TRIM(message))
482 : END IF
483 : END IF
484 :
485 : CASE ("@ENDIF")
486 : ! In normal mode, just skip line and continue
487 1 : 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 9976 : IF (output_unit > 0) THEN
496 : WRITE (UNIT=output_unit, FMT="(T2,A,I0,A)") &
497 : TRIM(mytag)//" directive in file <"// &
498 1 : TRIM(input_file_name)//"> Line: ", input_line_number, &
499 2 : " ->"//TRIM(input_line(indf:))
500 : END IF
501 :
502 : END SELECT
503 :
504 9976 : 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 537 : 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 0 : CPASSERT(ASSOCIATED(inpp))
523 537 : IF (inpp%io_stack_level > 0) THEN
524 537 : CALL close_file(input_unit)
525 537 : input_unit = inpp%io_stack_channel(inpp%io_stack_level)
526 537 : input_line_number = inpp%io_stack_lineno(inpp%io_stack_level)
527 537 : input_file_name = TRIM(inpp%io_stack_filename(inpp%io_stack_level))
528 537 : inpp%io_stack_level = inpp%io_stack_level - 1
529 537 : CALL reallocate(inpp%io_stack_channel, 1, inpp%io_stack_level)
530 537 : CALL reallocate(inpp%io_stack_lineno, 1, inpp%io_stack_level)
531 537 : CALL reallocate(inpp%io_stack_filename, 1, inpp%io_stack_level)
532 : END IF
533 :
534 537 : 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 5882 : 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 5882 : CHARACTER(LEN=:), ALLOCATABLE :: var_value, var_name
555 : INTEGER :: idx, pos1, pos2, default_val_sep_idx
556 :
557 0 : CPASSERT(ASSOCIATED(inpp))
558 :
559 : ! process line until all variables named with the convention ${VAR} are expanded
560 12521 : DO WHILE (INDEX(input_line, '${') > 0)
561 6639 : pos1 = INDEX(input_line, '${')
562 6639 : pos1 = pos1 + 2
563 6639 : pos2 = INDEX(input_line(pos1:), '}')
564 :
565 6639 : IF (pos2 == 0) THEN
566 : WRITE (UNIT=message, FMT="(3A,I6)") &
567 0 : "Missing '}' in file: ", &
568 0 : TRIM(input_file_name), " Line:", input_line_number
569 0 : CPABORT(TRIM(message))
570 : END IF
571 :
572 6639 : pos2 = pos1 + pos2 - 2
573 6639 : var_name = input_line(pos1:pos2)
574 :
575 6639 : default_val_sep_idx = INDEX(var_name, '-')
576 :
577 6639 : IF (default_val_sep_idx > 0) THEN
578 8 : var_value = var_name(default_val_sep_idx + 1:)
579 8 : var_name = var_name(:default_val_sep_idx - 1)
580 : END IF
581 :
582 6639 : IF (.NOT. is_valid_varname(var_name)) THEN
583 : WRITE (UNIT=message, FMT="(5A,I6)") &
584 0 : "Invalid variable name ${", var_name, "} in file: ", &
585 0 : TRIM(input_file_name), " Line:", input_line_number
586 0 : CPABORT(TRIM(message))
587 : END IF
588 :
589 6639 : idx = inpp_find_variable(inpp, var_name)
590 :
591 6639 : IF (idx == 0 .AND. default_val_sep_idx == 0) THEN
592 : WRITE (UNIT=message, FMT="(5A,I6)") &
593 0 : "Variable ${", var_name, "} not defined in file: ", &
594 0 : TRIM(input_file_name), " Line:", input_line_number
595 0 : CPABORT(TRIM(message))
596 : END IF
597 :
598 6639 : IF (idx > 0) then
599 6639 : var_value = TRIM(inpp%variable_value(idx))
600 : end if
601 :
602 6639 : newline = input_line(1:pos1 - 3)//var_value//input_line(pos2 + 2:)
603 12521 : input_line = newline
604 : END DO
605 :
606 : ! process line until all variables named with the convention $VAR are expanded
607 6090 : DO WHILE (INDEX(input_line, '$') > 0)
608 208 : pos1 = INDEX(input_line, '$')
609 208 : pos1 = pos1 + 1 ! move to the start of the variable name
610 208 : pos2 = INDEX(input_line(pos1:), ' ')
611 :
612 208 : IF (pos2 == 0) then
613 0 : pos2 = LEN_TRIM(input_line(pos1:)) + 1
614 : end if
615 :
616 208 : pos2 = pos1 + pos2 - 2 ! end of the variable name, minus the separating whitespace
617 208 : var_name = input_line(pos1:pos2)
618 208 : idx = inpp_find_variable(inpp, var_name)
619 :
620 208 : IF (.NOT. is_valid_varname(var_name)) THEN
621 : WRITE (UNIT=message, FMT="(5A,I6)") &
622 0 : "Invalid variable name ${", var_name, "} in file: ", &
623 0 : TRIM(input_file_name), " Line:", input_line_number
624 0 : CPABORT(TRIM(message))
625 : END IF
626 :
627 208 : IF (idx == 0) THEN
628 : WRITE (UNIT=message, FMT="(5A,I6)") &
629 0 : "Variable $", var_name, " not defined in file: ", &
630 0 : TRIM(input_file_name), " Line:", input_line_number
631 0 : CPABORT(TRIM(message))
632 : END IF
633 :
634 208 : newline = input_line(1:pos1 - 2)//TRIM(inpp%variable_value(idx))//input_line(pos2 + 1:)
635 6090 : input_line = newline
636 : END DO
637 :
638 11764 : 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 11031 : 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 11031 : idx = 0
658 130941 : DO i = 1, inpp%num_variables
659 130941 : IF (TRIM(varname) == TRIM(inpp%variable_name(i))) THEN
660 11031 : 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 0 : SUBROUTINE inpp_list_variables(inpp, iochan)
677 : TYPE(inpp_type), POINTER :: inpp
678 : INTEGER, INTENT(IN) :: iochan
679 :
680 : INTEGER :: i
681 :
682 0 : WRITE (iochan, '(A)') ' # NAME VALUE'
683 0 : DO i = 1, inpp%num_variables
684 : WRITE (iochan, '(I4," | ",A,T30," | ",A," |")') &
685 0 : i, TRIM(inpp%variable_name(i)), TRIM(inpp%variable_value(i))
686 : END DO
687 0 : END SUBROUTINE inpp_list_variables
688 :
689 8 : END MODULE cp_parser_inpp_methods
|
