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
92 CHARACTER(LEN=default_path_length) :: cond1, cond2, filename, mytag,
value, &
94 CHARACTER(LEN=max_message_length) :: message
95 INTEGER :: i, indf, indi, istat, output_unit, pos1, &
99 output_unit = cp_logger_get_default_io_unit()
101 cpassert(
ASSOCIATED(inpp))
104 indi = index(input_line,
"@")
105 pos1 = index(input_line,
"!")
106 pos2 = index(input_line,
"#")
107 IF (((pos1 > 0) .AND. (pos1 < indi)) .OR. ((pos2 > 0) .AND. (pos2 < indi)))
THEN
114 DO WHILE (.NOT. is_whitespace(input_line(indf:indf)))
117 mytag = input_line(indi:indf - 1)
118 CALL uppercase(mytag)
124 filename = trim(input_line(indf:))
125 IF (len_trim(filename) == 0)
THEN
126 WRITE (unit=message, fmt=
"(A,I0)") &
127 "No filename argument found for "//trim(mytag)// &
128 " directive in file <"//trim(input_file_name)// &
129 "> Line:", input_line_number
130 cpabort(trim(message))
133 DO WHILE (is_whitespace(filename(indi:indi)))
136 filename = trim(filename(indi:))
139 pos1 = index(filename,
'"')
140 pos2 = index(filename(pos1 + 1:),
'"')
141 IF ((pos1 /= 0) .AND. (pos2 /= 0))
THEN
142 filename = filename(pos1 + 1:pos1 + pos2 - 1)
144 pos1 = index(filename,
"'")
145 pos2 = index(filename(pos1 + 1:),
"'")
146 IF ((pos1 /= 0) .AND. (pos2 /= 0))
THEN
147 filename = filename(pos1 + 1:pos1 + pos2 - 1)
150 pos2 = index(filename,
'"')
151 IF ((pos1 /= 0) .OR. (pos2 /= 0))
THEN
152 WRITE (unit=message, fmt=
"(A,I0)") &
153 "Incorrect quoting of the included filename in file <", &
154 trim(input_file_name)//
"> Line:", input_line_number
155 cpabort(trim(message))
161 DO i = 1, inpp%io_stack_level
162 check = trim(filename) /= trim(inpp%io_stack_filename(i))
166 CALL open_file(file_name=trim(filename), &
168 file_form=
"FORMATTED", &
169 file_action=
"READ", &
173 inpp%io_stack_level = inpp%io_stack_level + 1
174 CALL reallocate(inpp%io_stack_channel, 1, inpp%io_stack_level)
175 CALL reallocate(inpp%io_stack_lineno, 1, inpp%io_stack_level)
176 CALL reallocate(inpp%io_stack_filename, 1, inpp%io_stack_level)
178 inpp%io_stack_channel(inpp%io_stack_level) = input_unit
179 inpp%io_stack_lineno(inpp%io_stack_level) = input_line_number
180 inpp%io_stack_filename(inpp%io_stack_level) = input_file_name
182 input_file_name = trim(filename)
183 input_line_number = 0
186 CASE (
"@FFTYPE",
"@XCTYPE")
190 filename = trim(input_line(indf:))
191 IF (len_trim(filename) == 0)
THEN
192 WRITE (unit=message, fmt=
"(A,I0)") &
193 "No filename argument found for "//trim(mytag)// &
194 " directive in file <"//trim(input_file_name)// &
195 "> Line:", input_line_number
196 cpabort(trim(message))
199 DO WHILE (is_whitespace(filename(indi:indi)))
202 filename = trim(filename(indi:))
205 pos1 = index(filename,
'"')
206 pos2 = index(filename(pos1 + 1:),
'"')
207 IF ((pos1 /= 0) .AND. (pos2 /= 0))
THEN
208 filename = filename(pos1 + 1:pos1 + pos2 - 1)
210 pos1 = index(filename,
"'")
211 pos2 = index(filename(pos1 + 1:),
"'")
212 IF ((pos1 /= 0) .AND. (pos2 /= 0))
THEN
213 filename = filename(pos1 + 1:pos1 + pos2 - 1)
216 pos2 = index(filename,
'"')
217 IF ((pos1 /= 0) .OR. (pos2 /= 0))
THEN
218 WRITE (unit=message, fmt=
"(A,I0)") &
219 "Incorrect quoting of the filename argument in file <", &
220 trim(input_file_name)//
"> Line:", input_line_number
221 cpabort(trim(message))
227 filename = trim(filename)//
".sec"
229 IF (.NOT. file_exists(trim(filename)))
THEN
230 IF (filename(1:1) ==
"/")
THEN
235 filename =
"forcefield_section/"//trim(filename)
237 filename =
"xc_section/"//trim(filename)
241 IF (.NOT. file_exists(trim(filename)))
THEN
242 WRITE (unit=message, fmt=
"(A,I0)") &
243 trim(mytag)//
": Could not find the file <"// &
244 trim(filename)//
"> with the input section given in the file <"// &
245 trim(input_file_name)//
"> Line: ", input_line_number
246 cpabort(trim(message))
250 DO i = 1, inpp%io_stack_level
251 check = trim(filename) /= trim(inpp%io_stack_filename(i))
256 CALL open_file(file_name=trim(filename), &
258 file_form=
"FORMATTED", &
259 file_action=
"READ", &
263 inpp%io_stack_level = inpp%io_stack_level + 1
264 CALL reallocate(inpp%io_stack_channel, 1, inpp%io_stack_level)
265 CALL reallocate(inpp%io_stack_lineno, 1, inpp%io_stack_level)
266 CALL reallocate(inpp%io_stack_filename, 1, inpp%io_stack_level)
268 inpp%io_stack_channel(inpp%io_stack_level) = input_unit
269 inpp%io_stack_lineno(inpp%io_stack_level) = input_line_number
270 inpp%io_stack_filename(inpp%io_stack_level) = input_file_name
272 input_file_name = trim(filename)
273 input_line_number = 0
278 varname = trim(input_line(indf:))
279 IF (len_trim(varname) == 0)
THEN
280 WRITE (unit=message, fmt=
"(A,I0)") &
281 "No variable name found for "//trim(mytag)//
" directive in file <"// &
282 trim(input_file_name)//
"> Line:", input_line_number
283 cpabort(trim(message))
287 DO WHILE (is_whitespace(varname(indi:indi)))
291 DO WHILE (.NOT. is_whitespace(varname(indf:indf)))
294 value = trim(varname(indf:))
295 varname = trim(varname(indi:indf - 1))
297 IF (.NOT. is_valid_varname(trim(varname)))
THEN
298 WRITE (unit=message, fmt=
"(A,I0)") &
299 "Invalid variable name for "//trim(mytag)//
" directive in file <"// &
300 trim(input_file_name)//
"> Line:", input_line_number
301 cpabort(trim(message))
305 DO WHILE (is_whitespace(value(indi:indi)))
308 value = trim(value(indi:))
310 IF (len_trim(
value) == 0)
THEN
311 WRITE (unit=message, fmt=
"(A,I0)") &
312 "Incomplete "//trim(mytag)//
" directive: "// &
313 "No value found for variable <"//trim(varname)//
"> in file <"// &
314 trim(input_file_name)//
"> Line:", input_line_number
315 cpabort(trim(message))
319 indi = inpp_find_variable(inpp, varname)
322 inpp%num_variables = inpp%num_variables + 1
323 CALL reallocate(inpp%variable_name, 1, inpp%num_variables)
324 CALL reallocate(inpp%variable_value, 1, inpp%num_variables)
325 inpp%variable_name(inpp%num_variables) = varname
326 inpp%variable_value(inpp%num_variables) =
value
327 IF (debug_this_module .AND. output_unit > 0)
THEN
328 WRITE (unit=message, fmt=
"(3A,I6,4A)")
"INPP_@SET: in file: ", &
329 trim(input_file_name),
" Line:", input_line_number, &
330 " Set new variable ", trim(varname),
" to value: ", trim(
value)
331 WRITE (output_unit, *) trim(message)
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)
342 inpp%variable_value(indi) =
value
345 IF (debug_this_module)
CALL inpp_list_variables(inpp, 6)
353 pos1 = index(input_line,
"==")
354 pos2 = index(input_line,
"/=")
356 DO WHILE (is_whitespace(input_line(indi:indi)))
358 IF (indi > len_trim(input_line))
EXIT
362 cond1 = input_line(indi:pos1 - 1)
363 cond2 = input_line(pos1 + 2:)
365 IF ((pos2 > 0) .OR. (index(cond2,
"==") > 0))
THEN
366 WRITE (unit=message, fmt=
"(A,I0)") &
367 "Incorrect "//trim(mytag)//
" directive found in file <", &
368 trim(input_file_name)//
"> Line:", input_line_number
369 cpabort(trim(message))
371 ELSE IF (pos2 > 0)
THEN
372 cond1 = input_line(indi:pos2 - 1)
373 cond2 = input_line(pos2 + 2:)
375 IF ((pos1 > 0) .OR. (index(cond2,
"/=") > 0))
THEN
376 WRITE (unit=message, fmt=
"(A,I0)") &
377 "Incorrect "//trim(mytag)//
" directive found in file <", &
378 trim(input_file_name)//
"> Line:", input_line_number
379 cpabort(trim(message))
382 IF (len_trim(input_line(indi:)) > 0)
THEN
383 IF (trim(input_line(indi:)) ==
'0')
THEN
400 IF (index(cond1,
"(") /= 0) cond1 = cond1(index(cond1,
"(") + 1:)
401 IF (index(cond2,
")") /= 0) cond2 = cond2(1:index(cond2,
")") - 1)
405 DO WHILE (is_whitespace(cond1(indi:indi)))
412 DO WHILE (is_whitespace(cond2(indi:indi)))
417 IF (len_trim(cond2) == 0)
THEN
418 WRITE (unit=message, fmt=
"(3A,I6)") &
419 "INPP_@IF: Incorrect @IF directive in file: ", &
420 trim(input_file_name),
" Line:", input_line_number
421 cpabort(trim(message))
424 IF ((trim(cond1) == trim(cond2)) .EQV. check)
THEN
425 IF (debug_this_module .AND. output_unit > 0)
THEN
426 WRITE (unit=message, fmt=
"(3A,I6,A)")
"INPP_@IF: in file: ", &
427 trim(input_file_name),
" Line:", input_line_number, &
428 " Conditional ("//trim(cond1)//
","//trim(cond2)// &
429 ") resolves to true. Continuing parsing."
430 WRITE (output_unit, *) trim(message)
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)
443 DO WHILE (istat == 0)
444 input_line_number = input_line_number + 1
445 READ (unit=input_unit, fmt=
"(A)", iostat=istat) input_line
446 IF (debug_this_module .AND. output_unit > 0)
THEN
447 WRITE (unit=message, fmt=
"(1A,I6,2A)")
"INPP_@IF: skipping line ", &
448 input_line_number,
": ", trim(input_line)
449 WRITE (output_unit, *) trim(message)
452 indi = index(input_line,
"@")
453 pos1 = index(input_line,
"!")
454 pos2 = index(input_line,
"#")
455 IF (((pos1 > 0) .AND. (pos1 < indi)) .OR. ((pos2 > 0) .AND. (pos2 < indi)))
THEN
463 DO WHILE (input_line(indf:indf) /=
" ")
466 cpassert((indf - indi) <= default_string_length)
467 mytag = input_line(indi:indf - 1)
468 CALL uppercase(mytag)
469 IF (index(mytag,
"@ENDIF") > 0)
THEN
471 IF (debug_this_module .AND. output_unit > 0)
THEN
472 WRITE (output_unit, *)
"INPP_@IF: found @ENDIF. End of skipping."
478 WRITE (unit=message, fmt=
"(A,I0)") &
479 "Error while searching for matching @ENDIF directive in file <"// &
480 trim(input_file_name)//
"> Line:", input_line_number
481 cpabort(trim(message))
487 IF (debug_this_module .AND. output_unit > 0)
THEN
488 WRITE (unit=message, fmt=
"(A,I0)") &
489 trim(mytag)//
" directive found and ignored in file <"// &
490 trim(input_file_name)//
"> Line: ", input_line_number
495 IF (output_unit > 0)
THEN
496 WRITE (unit=output_unit, fmt=
"(T2,A,I0,A)") &
497 trim(mytag)//
" directive in file <"// &
498 trim(input_file_name)//
"> Line: ", input_line_number, &
499 " ->"//trim(input_line(indf:))
548 TYPE(inpp_type),
POINTER :: inpp
549 CHARACTER(LEN=*),
INTENT(INOUT) :: input_line, input_file_name
550 INTEGER,
INTENT(IN) :: input_line_number
552 CHARACTER(LEN=default_path_length) :: newline
553 CHARACTER(LEN=max_message_length) :: message
554 CHARACTER(LEN=:),
ALLOCATABLE :: var_value, var_name
555 INTEGER ::
idx, pos1, pos2, default_val_sep_idx
557 cpassert(
ASSOCIATED(inpp))
560 DO WHILE (index(input_line,
'${') > 0)
561 pos1 = index(input_line,
'${')
563 pos2 = index(input_line(pos1:),
'}')
566 WRITE (unit=message, fmt=
"(3A,I6)") &
567 "Missing '}' in file: ", &
568 trim(input_file_name),
" Line:", input_line_number
569 cpabort(trim(message))
572 pos2 = pos1 + pos2 - 2
573 var_name = input_line(pos1:pos2)
575 default_val_sep_idx = index(var_name,
'-')
577 IF (default_val_sep_idx > 0)
THEN
578 var_value = var_name(default_val_sep_idx + 1:)
579 var_name = var_name(:default_val_sep_idx - 1)
582 IF (.NOT. is_valid_varname(var_name))
THEN
583 WRITE (unit=message, fmt=
"(5A,I6)") &
584 "Invalid variable name ${", var_name,
"} in file: ", &
585 trim(input_file_name),
" Line:", input_line_number
586 cpabort(trim(message))
589 idx = inpp_find_variable(inpp, var_name)
591 IF (
idx == 0 .AND. default_val_sep_idx == 0)
THEN
592 WRITE (unit=message, fmt=
"(5A,I6)") &
593 "Variable ${", var_name,
"} not defined in file: ", &
594 trim(input_file_name),
" Line:", input_line_number
595 cpabort(trim(message))
599 var_value = trim(inpp%variable_value(
idx))
602 newline = input_line(1:pos1 - 3)//var_value//input_line(pos2 + 2:)
607 DO WHILE (index(input_line,
'$') > 0)
608 pos1 = index(input_line,
'$')
610 pos2 = index(input_line(pos1:),
' ')
613 pos2 = len_trim(input_line(pos1:)) + 1
616 pos2 = pos1 + pos2 - 2
617 var_name = input_line(pos1:pos2)
618 idx = inpp_find_variable(inpp, var_name)
620 IF (.NOT. is_valid_varname(var_name))
THEN
621 WRITE (unit=message, fmt=
"(5A,I6)") &
622 "Invalid variable name ${", var_name,
"} in file: ", &
623 trim(input_file_name),
" Line:", input_line_number
624 cpabort(trim(message))
628 WRITE (unit=message, fmt=
"(5A,I6)") &
629 "Variable $", var_name,
" not defined in file: ", &
630 trim(input_file_name),
" Line:", input_line_number
631 cpabort(trim(message))
634 newline = input_line(1:pos1 - 2)//trim(inpp%variable_value(
idx))//input_line(pos2 + 1:)