Line data Source code
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 : ! **************************************************************************************************
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 10705 : 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 10705 : is_valid_varname = .FALSE.
55 :
56 10705 : IF (LEN(str) == 0) &
57 : RETURN
58 :
59 10705 : IF (INDEX(alpha, str(1:1)) == 0) &
60 : RETURN
61 :
62 115087 : DO idx = 2, LEN(str)
63 104382 : IF (INDEX(alphanum, str(idx:idx)) == 0) &
64 10705 : RETURN
65 : END DO
66 :
67 10705 : 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 9879 : 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 19758 : output_unit = cp_logger_get_default_io_unit()
97 :
98 9879 : CPASSERT(ASSOCIATED(inpp))
99 :
100 : ! Find location of directive in line and check whether it is commented out
101 9879 : indi = INDEX(input_line, "@")
102 9879 : pos1 = INDEX(input_line, "!")
103 9879 : pos2 = INDEX(input_line, "#")
104 9879 : IF (((pos1 > 0) .AND. (pos1 < indi)) .OR. ((pos2 > 0) .AND. (pos2 < indi))) THEN
105 : ! Nothing to do
106 2495 : RETURN
107 : END IF
108 :
109 : ! Get the start of the instruction and find "@KEYWORD" (or "@")
110 : indf = indi
111 60308 : DO WHILE (.NOT. is_whitespace(input_line(indf:indf)))
112 50429 : indf = indf + 1
113 : END DO
114 9879 : mytag = input_line(indi:indf - 1)
115 9879 : CALL uppercase(mytag)
116 :
117 513 : SELECT CASE (mytag)
118 :
119 : CASE ("@INCLUDE")
120 : ! Get the file name, 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="(A,I0)") &
124 : "No filename argument found for "//TRIM(mytag)// &
125 : " directive in file <"//TRIM(input_file_name)// &
126 0 : "> Line:", input_line_number
127 0 : CPABORT(TRIM(message))
128 : END IF
129 513 : indi = 1
130 1027 : DO WHILE (is_whitespace(filename(indi:indi)))
131 514 : indi = indi + 1
132 : END DO
133 513 : filename = TRIM(filename(indi:))
134 :
135 : ! Handle quoting of the filename
136 513 : pos1 = INDEX(filename, '"')
137 513 : pos2 = INDEX(filename(pos1 + 1:), '"')
138 513 : IF ((pos1 /= 0) .AND. (pos2 /= 0)) THEN
139 8 : filename = filename(pos1 + 1:pos1 + pos2 - 1)
140 : ELSE
141 505 : pos1 = INDEX(filename, "'")
142 505 : pos2 = INDEX(filename(pos1 + 1:), "'")
143 505 : IF ((pos1 /= 0) .AND. (pos2 /= 0)) THEN
144 40 : filename = filename(pos1 + 1:pos1 + pos2 - 1)
145 : ELSE
146 : ! Check quoting of the included file name
147 465 : pos2 = INDEX(filename, '"')
148 465 : IF ((pos1 /= 0) .OR. (pos2 /= 0)) THEN
149 : WRITE (UNIT=message, FMT="(A,I0)") &
150 0 : "Incorrect quoting of the included filename in file <", &
151 0 : TRIM(input_file_name)//"> Line:", input_line_number
152 0 : 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 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 : CALL open_file(file_name=TRIM(filename), &
164 : file_status="OLD", &
165 : file_form="FORMATTED", &
166 : file_action="READ", &
167 513 : unit_number=unit)
168 :
169 : ! Make room, save status and position the parser at the beginning of new file.
170 513 : inpp%io_stack_level = inpp%io_stack_level + 1
171 513 : CALL reallocate(inpp%io_stack_channel, 1, inpp%io_stack_level)
172 513 : CALL reallocate(inpp%io_stack_lineno, 1, inpp%io_stack_level)
173 513 : CALL reallocate(inpp%io_stack_filename, 1, inpp%io_stack_level)
174 :
175 513 : inpp%io_stack_channel(inpp%io_stack_level) = input_unit
176 513 : inpp%io_stack_lineno(inpp%io_stack_level) = input_line_number
177 513 : inpp%io_stack_filename(inpp%io_stack_level) = input_file_name
178 :
179 513 : input_file_name = TRIM(filename)
180 513 : input_line_number = 0
181 513 : 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 23 : filename = TRIM(input_line(indf:))
188 23 : 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 0 : "> Line:", input_line_number
193 0 : CPABORT(TRIM(message))
194 : END IF
195 23 : indi = 1
196 46 : DO WHILE (is_whitespace(filename(indi:indi)))
197 23 : indi = indi + 1
198 : END DO
199 23 : filename = TRIM(filename(indi:))
200 :
201 : ! Handle quoting of the filename
202 23 : pos1 = INDEX(filename, '"')
203 23 : pos2 = INDEX(filename(pos1 + 1:), '"')
204 23 : IF ((pos1 /= 0) .AND. (pos2 /= 0)) THEN
205 0 : filename = filename(pos1 + 1:pos1 + pos2 - 1)
206 : ELSE
207 23 : pos1 = INDEX(filename, "'")
208 23 : pos2 = INDEX(filename(pos1 + 1:), "'")
209 23 : IF ((pos1 /= 0) .AND. (pos2 /= 0)) THEN
210 0 : filename = filename(pos1 + 1:pos1 + pos2 - 1)
211 : ELSE
212 : ! Incorrect quotes (only one of ' or ").
213 23 : pos2 = INDEX(filename, '"')
214 23 : IF ((pos1 /= 0) .OR. (pos2 /= 0)) THEN
215 : WRITE (UNIT=message, FMT="(A,I0)") &
216 0 : "Incorrect quoting of the filename argument in file <", &
217 0 : TRIM(input_file_name)//"> Line:", input_line_number
218 0 : CPABORT(TRIM(message))
219 : END IF
220 : END IF
221 : END IF
222 :
223 : ! Add file extension ".sec"
224 23 : filename = TRIM(filename)//".sec"
225 : ! Check for file
226 23 : IF (.NOT. file_exists(TRIM(filename))) THEN
227 23 : IF (filename(1:1) == "/") THEN
228 : ! this is an absolute path filename, don't change
229 : ELSE
230 5 : SELECT CASE (mytag)
231 : CASE ("@FFTYPE")
232 5 : filename = "forcefield_section/"//TRIM(filename)
233 : CASE ("@XCTYPE")
234 23 : filename = "xc_section/"//TRIM(filename)
235 : END SELECT
236 : END IF
237 : END IF
238 23 : 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 0 : TRIM(input_file_name)//"> Line: ", input_line_number
243 0 : CPABORT(TRIM(message))
244 : END IF
245 :
246 : ! Let's check that files already opened won't be again opened
247 23 : DO i = 1, inpp%io_stack_level
248 0 : check = TRIM(filename) /= TRIM(inpp%io_stack_filename(i))
249 23 : 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 23 : unit_number=unit)
258 :
259 : ! make room, save status and position the parser at the beginning of new file.
260 23 : inpp%io_stack_level = inpp%io_stack_level + 1
261 23 : CALL reallocate(inpp%io_stack_channel, 1, inpp%io_stack_level)
262 23 : CALL reallocate(inpp%io_stack_lineno, 1, inpp%io_stack_level)
263 23 : CALL reallocate(inpp%io_stack_filename, 1, inpp%io_stack_level)
264 :
265 23 : inpp%io_stack_channel(inpp%io_stack_level) = input_unit
266 23 : inpp%io_stack_lineno(inpp%io_stack_level) = input_line_number
267 23 : inpp%io_stack_filename(inpp%io_stack_level) = input_file_name
268 :
269 23 : input_file_name = TRIM(filename)
270 23 : input_line_number = 0
271 23 : input_unit = unit
272 :
273 : CASE ("@SET")
274 : ! Split directive into variable name and value data.
275 4100 : varname = TRIM(input_line(indf:))
276 4100 : 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 0 : TRIM(input_file_name)//"> Line:", input_line_number
280 0 : CPABORT(TRIM(message))
281 : END IF
282 :
283 4100 : indi = 1
284 8205 : DO WHILE (is_whitespace(varname(indi:indi)))
285 4105 : indi = indi + 1
286 : END DO
287 : indf = indi
288 50765 : DO WHILE (.NOT. is_whitespace(varname(indf:indf)))
289 46665 : indf = indf + 1
290 : END DO
291 4100 : value = TRIM(varname(indf:))
292 4100 : varname = TRIM(varname(indi:indf - 1))
293 :
294 4100 : 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 0 : TRIM(input_file_name)//"> Line:", input_line_number
298 0 : CPABORT(TRIM(message))
299 : END IF
300 :
301 4100 : indi = 1
302 30313 : DO WHILE (is_whitespace(value(indi:indi)))
303 26213 : indi = indi + 1
304 : END DO
305 4100 : value = TRIM(value(indi:))
306 :
307 4100 : 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 0 : TRIM(input_file_name)//"> Line:", input_line_number
312 0 : CPABORT(TRIM(message))
313 : END IF
314 :
315 : ! sort into table of variables.
316 4100 : indi = inpp_find_variable(inpp, varname)
317 4100 : IF (indi == 0) THEN
318 : ! create new variable
319 3847 : inpp%num_variables = inpp%num_variables + 1
320 3847 : CALL reallocate(inpp%variable_name, 1, inpp%num_variables)
321 3847 : CALL reallocate(inpp%variable_value, 1, inpp%num_variables)
322 3847 : inpp%variable_name(inpp%num_variables) = varname
323 3847 : 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 253 : inpp%variable_value(indi) = value
340 : END IF
341 :
342 2495 : 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 2495 : indi = indf
350 2495 : pos1 = INDEX(input_line, "==")
351 2495 : pos2 = INDEX(input_line, "/=")
352 : ! shave off leading whitespace
353 4989 : DO WHILE (is_whitespace(input_line(indi:indi)))
354 2495 : indi = indi + 1
355 4989 : IF (indi > LEN_TRIM(input_line)) EXIT
356 : END DO
357 2495 : check = .FALSE.
358 2495 : IF (pos1 > 0) THEN
359 2366 : cond1 = input_line(indi:pos1 - 1)
360 2366 : cond2 = input_line(pos1 + 2:)
361 2366 : check = .TRUE.
362 2366 : IF ((pos2 > 0) .OR. (INDEX(cond2, "==") > 0)) THEN
363 : WRITE (UNIT=message, FMT="(A,I0)") &
364 0 : "Incorrect "//TRIM(mytag)//" directive found in file <", &
365 0 : TRIM(input_file_name)//"> Line:", input_line_number
366 0 : CPABORT(TRIM(message))
367 : END IF
368 129 : ELSE IF (pos2 > 0) THEN
369 2 : cond1 = input_line(indi:pos2 - 1)
370 2 : cond2 = input_line(pos2 + 2:)
371 2 : check = .FALSE.
372 2 : IF ((pos1 > 0) .OR. (INDEX(cond2, "/=") > 0)) THEN
373 : WRITE (UNIT=message, FMT="(A,I0)") &
374 0 : "Incorrect "//TRIM(mytag)//" directive found in file <", &
375 0 : TRIM(input_file_name)//"> Line:", input_line_number
376 0 : CPABORT(TRIM(message))
377 : END IF
378 : ELSE
379 127 : IF (LEN_TRIM(input_line(indi:)) > 0) THEN
380 126 : IF (TRIM(input_line(indi:)) == '0') THEN
381 62 : cond1 = 'XXX'
382 62 : cond2 = 'XXX'
383 62 : check = .FALSE.
384 : ELSE
385 64 : cond1 = 'XXX'
386 64 : cond2 = 'XXX'
387 64 : check = .TRUE.
388 : END IF
389 : ELSE
390 1 : cond1 = 'XXX'
391 1 : cond2 = 'XXX'
392 1 : check = .FALSE.
393 : END IF
394 : END IF
395 :
396 : ! Get rid of possible parentheses
397 2495 : IF (INDEX(cond1, "(") /= 0) cond1 = cond1(INDEX(cond1, "(") + 1:)
398 2495 : IF (INDEX(cond2, ")") /= 0) cond2 = cond2(1:INDEX(cond2, ")") - 1)
399 :
400 : ! Shave off leading whitespace from cond1
401 2495 : indi = 1
402 4780 : DO WHILE (is_whitespace(cond1(indi:indi)))
403 2285 : indi = indi + 1
404 : END DO
405 2495 : cond1 = cond1(indi:)
406 :
407 : ! Shave off leading whitespace from cond2
408 2495 : indi = 1
409 4861 : DO WHILE (is_whitespace(cond2(indi:indi)))
410 2366 : indi = indi + 1
411 : END DO
412 2495 : cond2 = cond2(indi:)
413 :
414 2495 : IF (LEN_TRIM(cond2) == 0) THEN
415 : WRITE (UNIT=message, FMT="(3A,I6)") &
416 0 : "INPP_@IF: Incorrect @IF directive in file: ", &
417 0 : TRIM(input_file_name), " Line:", input_line_number
418 0 : CPABORT(TRIM(message))
419 : END IF
420 :
421 2495 : 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 1198 : istat = 0
440 5532 : DO WHILE (istat == 0)
441 5532 : input_line_number = input_line_number + 1
442 5532 : 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 5532 : indi = INDEX(input_line, "@")
450 5532 : pos1 = INDEX(input_line, "!")
451 5532 : pos2 = INDEX(input_line, "#")
452 5532 : 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 5532 : indi = MAX(1, indi)
459 5532 : indf = indi
460 12892 : DO WHILE (input_line(indf:indf) /= " ")
461 7360 : indf = indf + 1
462 : END DO
463 5532 : CPASSERT((indf - indi) <= default_string_length)
464 5532 : mytag = input_line(indi:indf - 1)
465 5532 : CALL uppercase(mytag)
466 5532 : 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 0 : TRIM(input_file_name)//"> Line:", input_line_number
478 0 : CPABORT(TRIM(message))
479 : END IF
480 : END IF
481 :
482 : CASE ("@ENDIF")
483 : ! In normal mode, just skip line and continue
484 1 : 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 9879 : IF (output_unit > 0) THEN
493 : WRITE (UNIT=output_unit, FMT="(T2,A,I0,A)") &
494 : TRIM(mytag)//" directive in file <"// &
495 1 : TRIM(input_file_name)//"> Line: ", input_line_number, &
496 2 : " ->"//TRIM(input_line(indf:))
497 : END IF
498 :
499 : END SELECT
500 :
501 9879 : 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 536 : 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 0 : CPASSERT(ASSOCIATED(inpp))
520 536 : IF (inpp%io_stack_level > 0) THEN
521 536 : CALL close_file(input_unit)
522 536 : input_unit = inpp%io_stack_channel(inpp%io_stack_level)
523 536 : input_line_number = inpp%io_stack_lineno(inpp%io_stack_level)
524 536 : input_file_name = TRIM(inpp%io_stack_filename(inpp%io_stack_level))
525 536 : inpp%io_stack_level = inpp%io_stack_level - 1
526 536 : CALL reallocate(inpp%io_stack_channel, 1, inpp%io_stack_level)
527 536 : CALL reallocate(inpp%io_stack_lineno, 1, inpp%io_stack_level)
528 536 : CALL reallocate(inpp%io_stack_filename, 1, inpp%io_stack_level)
529 : END IF
530 :
531 536 : 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 5771 : 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 5771 : CHARACTER(LEN=:), ALLOCATABLE :: var_value, var_name
552 : INTEGER :: idx, pos1, pos2, default_val_sep_idx
553 :
554 0 : CPASSERT(ASSOCIATED(inpp))
555 :
556 : ! process line until all variables named with the convention ${VAR} are expanded
557 12173 : DO WHILE (INDEX(input_line, '${') > 0)
558 6402 : pos1 = INDEX(input_line, '${')
559 6402 : pos1 = pos1 + 2
560 6402 : pos2 = INDEX(input_line(pos1:), '}')
561 :
562 6402 : IF (pos2 == 0) THEN
563 : WRITE (UNIT=message, FMT="(3A,I6)") &
564 0 : "Missing '}' in file: ", &
565 0 : TRIM(input_file_name), " Line:", input_line_number
566 0 : CPABORT(TRIM(message))
567 : END IF
568 :
569 6402 : pos2 = pos1 + pos2 - 2
570 6402 : var_name = input_line(pos1:pos2)
571 :
572 6402 : default_val_sep_idx = INDEX(var_name, '-')
573 :
574 6402 : IF (default_val_sep_idx > 0) THEN
575 8 : var_value = var_name(default_val_sep_idx + 1:)
576 8 : var_name = var_name(:default_val_sep_idx - 1)
577 : END IF
578 :
579 6402 : IF (.NOT. is_valid_varname(var_name)) THEN
580 : WRITE (UNIT=message, FMT="(5A,I6)") &
581 0 : "Invalid variable name ${", var_name, "} in file: ", &
582 0 : TRIM(input_file_name), " Line:", input_line_number
583 0 : CPABORT(TRIM(message))
584 : END IF
585 :
586 6402 : idx = inpp_find_variable(inpp, var_name)
587 :
588 6402 : IF (idx == 0 .AND. default_val_sep_idx == 0) THEN
589 : WRITE (UNIT=message, FMT="(5A,I6)") &
590 0 : "Variable ${", var_name, "} not defined in file: ", &
591 0 : TRIM(input_file_name), " Line:", input_line_number
592 0 : CPABORT(TRIM(message))
593 : END IF
594 :
595 6402 : IF (idx > 0) &
596 6402 : var_value = TRIM(inpp%variable_value(idx))
597 :
598 6402 : newline = input_line(1:pos1 - 3)//var_value//input_line(pos2 + 2:)
599 12173 : input_line = newline
600 : END DO
601 :
602 : ! process line until all variables named with the convention $VAR are expanded
603 5974 : DO WHILE (INDEX(input_line, '$') > 0)
604 203 : pos1 = INDEX(input_line, '$')
605 203 : pos1 = pos1 + 1 ! move to the start of the variable name
606 203 : pos2 = INDEX(input_line(pos1:), ' ')
607 :
608 203 : IF (pos2 == 0) &
609 0 : pos2 = LEN_TRIM(input_line(pos1:)) + 1
610 :
611 203 : pos2 = pos1 + pos2 - 2 ! end of the variable name, minus the separating whitespace
612 203 : var_name = input_line(pos1:pos2)
613 203 : idx = inpp_find_variable(inpp, var_name)
614 :
615 203 : IF (.NOT. is_valid_varname(var_name)) THEN
616 : WRITE (UNIT=message, FMT="(5A,I6)") &
617 0 : "Invalid variable name ${", var_name, "} in file: ", &
618 0 : TRIM(input_file_name), " Line:", input_line_number
619 0 : CPABORT(TRIM(message))
620 : END IF
621 :
622 203 : IF (idx == 0) THEN
623 : WRITE (UNIT=message, FMT="(5A,I6)") &
624 0 : "Variable $", var_name, " not defined in file: ", &
625 0 : TRIM(input_file_name), " Line:", input_line_number
626 0 : CPABORT(TRIM(message))
627 : END IF
628 :
629 203 : newline = input_line(1:pos1 - 2)//TRIM(inpp%variable_value(idx))//input_line(pos2 + 1:)
630 5974 : input_line = newline
631 : END DO
632 :
633 11542 : 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 10705 : 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 10705 : idx = 0
653 128474 : DO i = 1, inpp%num_variables
654 128474 : IF (TRIM(varname) == TRIM(inpp%variable_name(i))) THEN
655 10705 : 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 0 : SUBROUTINE inpp_list_variables(inpp, iochan)
672 : TYPE(inpp_type), POINTER :: inpp
673 : INTEGER, INTENT(IN) :: iochan
674 :
675 : INTEGER :: i
676 :
677 0 : WRITE (iochan, '(A)') ' # NAME VALUE'
678 0 : DO i = 1, inpp%num_variables
679 : WRITE (iochan, '(I4," | ",A,T30," | ",A," |")') &
680 0 : i, TRIM(inpp%variable_name(i)), TRIM(inpp%variable_value(i))
681 : END DO
682 0 : END SUBROUTINE inpp_list_variables
683 :
684 8 : END MODULE cp_parser_inpp_methods
|
