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