1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
|
!
! Copyright (C) 2011-2020 Quantum ESPRESSO group
! This file is distributed under the terms of the
! GNU General Public License. See the file `License'
! in the root directory of the present distribution,
! or http://www.gnu.org/copyleft/gpl.txt .
!
! Aug 2020 (PG): streamlined and simplified
! open_input_file() may read the file name either from
! passed argumet or directly from the command line
! Aug 2018 (PG): reading of old xml input file using iotk deleted
MODULE open_close_input_file
!
USE io_global, ONLY : stdin, stdout, qestdin
!
CHARACTER(LEN=256), SAVE :: input_file = ' '
PRIVATE
PUBLIC :: get_file_name, open_input_file, close_input_file
!
CONTAINS
!----------------------------------------------------------------------------
FUNCTION get_file_name ( )
!
!! Get the file name provided in command line
!
IMPLICIT NONE
!
CHARACTER (len=256) :: get_file_name
!
LOGICAL :: found
INTEGER :: iiarg, nargs
!
nargs = command_argument_count()
get_file_name = ' '
found = .false.
!
DO iiarg = 1, ( nargs - 1 )
!
CALL get_command_argument( iiarg, get_file_name )
!
IF ( TRIM( get_file_name ) == '-i' .OR. &
TRIM( get_file_name ) == '-in' .OR. &
TRIM( get_file_name ) == '-inp' .OR. &
TRIM( get_file_name ) == '-input' ) THEN
!
CALL get_command_argument( ( iiarg + 1 ) , get_file_name )
found = .true.
EXIT
!
END IF
!
END DO
!
IF ( .NOT. found ) get_file_name = ' '
!
END FUNCTION get_file_name
!
!----------------------------------------------------------------------------
FUNCTION open_input_file ( input_file_, is_xml) RESULT ( ierr )
!-----------------------------------------------------------------------------
!
! ... Open file for input read, connecting it to unit qestdin.
! ... If "input_file_" is not present, read it from command line
! ... If "input_file_" is empty, the standard input is dumped to
! ... temporary file "input_tmp.in" and this is opened for read
! ... If optional variable is_xml is present, test if the file is a
! ... valid xml file.
! ... In parallel execution, must be called by a single processor
! ... On exit:
! ... ierr = -1 if standard input is successfuly dumped to file
! ... ierr = 0 if input file is successfully opened
! ... ierr = 1 if there was an error opening file
! ... If optional variable is_xml is present:
! ... is_xml=.true. if the file has extension '.xml' or '.XML'
! ... or if either <xml...> or <?xml...> is found as first token
! ... Module varliable input_file is set to the file name actually read
! ... ---------------------------------------------------------------
!
IMPLICIT NONE
!
CHARACTER (len=*), intent(in), OPTIONAL :: input_file_
LOGICAL, intent(out), OPTIONAL :: is_xml
INTEGER :: ierr
!
LOGICAL :: is_xml_, is_tmp
INTEGER :: length
CHARACTER(LEN=512) :: dummy
LOGICAL, EXTERNAL :: test_input_xml
!
! copy file to be opened into input_file
!
IF ( PRESENT(input_file_) ) THEN
input_file = input_file_
ELSE
input_file = get_file_name ( )
END IF
!
! is_tmp: no file name read or provided, dump to "input_tmp.in"
!
is_tmp = ( TRIM(input_file) == ' ' )
IF ( is_tmp ) THEN
!
input_file="input_tmp.in"
OPEN(UNIT = qestdin, FILE=input_file, FORM='formatted', &
STATUS='unknown', IOSTAT = ierr )
IF ( ierr > 0 ) GO TO 30
!
dummy=' '
WRITE(stdout, '(5x,a)') "Waiting for input..."
DO
READ (stdin,fmt='(A512)',END=20, ERR=30) dummy
WRITE (qestdin,'(A)') trim(dummy)
END DO
!
20 CLOSE ( UNIT=qestdin, STATUS='keep' )
!
ENDIF
!
is_xml_ = PRESENT(is_xml)
IF (is_xml_) THEN
!
length = LEN_TRIM(input_file)
IF ( length > 4 ) THEN
is_xml = ( input_file(length-3:length) == '.xml' .OR. &
input_file(length-3:length) == '.XML' )
ELSE
is_xml = .false.
END IF
IF ( .NOT. is_xml ) THEN
OPEN ( UNIT = qestdin, FILE = input_file , FORM = 'FORMATTED', &
STATUS = 'OLD', IOSTAT = ierr )
IF ( ierr > 0 ) GO TO 30
is_xml = test_input_xml (qestdin )
CLOSE ( UNIT=qestdin, status='keep')
END IF
is_xml_ = is_xml
!
ENDIF
!
IF ( is_xml_ ) then
IF ( is_tmp ) THEN
WRITE(stdout, '(5x,a)') "Reading xml input from standard input"
ELSE
WRITE(stdout, '(5x,a)') "Reading xml input from "//TRIM(input_file)
END IF
ELSE
IF ( is_tmp ) THEN
WRITE(stdout, '(5x,a)') "Reading input from standard input"
ELSE
WRITE(stdout, '(5x,a)') "Reading input from "//TRIM(input_file)
END IF
ENDIF
!
OPEN ( UNIT = qestdin, FILE = input_file, FORM = 'FORMATTED', &
STATUS = 'OLD', IOSTAT = ierr )
!
IF ( ierr > 0 ) GO TO 30
IF ( is_tmp ) ierr = -1
RETURN
!
30 ierr = 1
!
! Do not call "errore" here: may hang in parallel execution
!
WRITE(stdout, "('open_input_file: fatal error opening ',A)") TRIM(input_file)
!
END FUNCTION open_input_file
FUNCTION close_input_file ( ) RESULT ( ierr )
!
! ... this subroutine closes the input file opened by open_input_file
! ... also removes temporary file if data was dumped from stdin
! ... returns -1 if unit is not opened, 0 if no problem, > 0 if problems
!
IMPLICIT NONE
!
INTEGER :: ierr
LOGICAL :: opnd
!
INQUIRE ( qestdin, opened = opnd )
IF (opnd) THEN
IF ( TRIM(input_file) == "input_tmp.in") THEN
CLOSE (UNIT=qestdin, STATUS='delete', IOSTAT=ierr )
ELSE
CLOSE (UNIT=qestdin, STATUS='keep', IOSTAT=ierr )
ENDIF
ELSE
ierr = -1
ENDIF
!
END FUNCTION close_input_file
!
END MODULE open_close_input_file
|
