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
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
|
!
! Copyright (C) 2001-2004 Carlo Cavazzoni and PWSCF 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 .
!
!
! ... SUBROUTINE field_count: accepts two string (one of them is optional)
! and one integer and count the number of fields
! in the string separated by a blank or a tab
! character. If the optional string is specified
! (it has anyway len=1) it is assumed as the
! separator character.
! Ignores any character following the exclamation
! mark (fortran comment)
!
! ... SUBROUTINE con_cam: counts the number of fields in a string
! separated by the optional character
!
! ... SUBROUTINE field_compare: accepts two strings and one integer. Counts the
! fields contained in the first string and
! compares it with the integer.
! If they are less than the integer calls the
! routine error and show by the second string the
! name of the field where read-error occurred.
!
!
!----------------------------------------------------------------------------
MODULE parser
!----------------------------------------------------------------------------
!
USE io_global, ONLY : stdout
USE kinds, ONLY : DP
!
PRIVATE
!
PUBLIC :: parse_unit, field_count, read_line, get_field
PUBLIC :: version_parse, version_compare
!
INTEGER :: parse_unit = 5 ! normally 5, but can be set otherwise
!
CONTAINS
!
!
!--------------------------------------------------------------------------
SUBROUTINE field_count( num, line, car )
!--------------------------------------------------------------------------
!
IMPLICIT NONE
!
INTEGER, INTENT(OUT) :: num
CHARACTER(LEN=*), INTENT(IN) :: line
CHARACTER(LEN=1), OPTIONAL, INTENT(IN) :: car
CHARACTER(LEN=1) :: sep1, sep2
INTEGER :: j
!
!
num = 0
!
IF ( .NOT. present(car) ) THEN
!
sep1 = char(32) ! ... blank character
sep2 = char(9) ! ... tab character
!
DO j = 2, MAX( LEN( line ), 256 )
!
IF ( line(j:j) == '!' .OR. line(j:j) == char(0) ) THEN
!
IF ( line(j-1:j-1) /= sep1 .AND. line(j-1:j-1) /= sep2 ) THEN
!
num = num + 1
!
END IF
!
EXIT
!
END IF
!
IF ( ( line(j:j) == sep1 .OR. line(j:j) == sep2 ) .AND. &
( line(j-1:j-1) /= sep1 .AND. line(j-1:j-1) /= sep2 ) ) THEN
!
num = num + 1
!
END IF
!
END DO
!
ELSE
!
sep1 = car
!
DO j = 2, MAX( LEN( line ), 256 )
!
IF ( line(j:j) == '!' .OR. &
line(j:j) == char(0) .OR. line(j:j) == char(32) ) THEN
!
IF ( line(j-1:j-1) /= sep1 ) num = num + 1
!
EXIT
!
END IF
!
IF ( line(j:j) == sep1 .AND. line(j-1:j-1) /= sep1 ) num = num + 1
!
END DO
!
END IF
!
RETURN
!
END SUBROUTINE field_count
!
!
!--------------------------------------------------------------------------
SUBROUTINE read_line( line, nfield, field, end_of_file, error )
!--------------------------------------------------------------------------
!
USE mp, ONLY : mp_bcast
USE mp_images, ONLY : intra_image_comm
USE io_global, ONLY : ionode, ionode_id
!
IMPLICIT NONE
!
CHARACTER(LEN=*), INTENT(OUT) :: line
CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: field
INTEGER, OPTIONAL, INTENT(IN) :: nfield
LOGICAL, OPTIONAL, INTENT(OUT) :: end_of_file, error
LOGICAL :: tend, terr
!
!
IF( LEN( line ) < 256 ) THEN
CALL errore(' read_line ', ' input line too short ', MAX(LEN(line),1) )
END IF
!
tend = .FALSE.
terr = .FALSE.
IF ( ionode ) THEN
30 READ (parse_unit, fmt='(A256)', ERR=15, END=10) line
IF( line == ' ' .OR. line(1:1) == '#' ) GO TO 30
GO TO 20
10 tend = .TRUE.
GO TO 20
15 terr = .TRUE.
20 CONTINUE
END IF
!
CALL mp_bcast( tend, ionode_id, intra_image_comm )
CALL mp_bcast( terr, ionode_id, intra_image_comm )
CALL mp_bcast( line, ionode_id, intra_image_comm )
!
IF( PRESENT(end_of_file) ) THEN
end_of_file = tend
ELSE IF( tend ) THEN
CALL infomsg(' read_line ', ' end of file ' )
END IF
IF( PRESENT(error) ) THEN
error = terr
ELSE IF( terr ) THEN
CALL infomsg(' read_line ', ' read error ' )
END IF
IF( PRESENT(field) .and. .not.(tend.or.terr) ) &
&CALL field_compare( line, nfield, field )
!
END SUBROUTINE read_line
!
!
!--------------------------------------------------------------------------
SUBROUTINE field_compare( str, nf, var )
!--------------------------------------------------------------------------
!
IMPLICIT NONE
!
CHARACTER(LEN=*), INTENT(IN) :: var
INTEGER, INTENT(IN) :: nf
CHARACTER(LEN=*), INTENT(IN) :: str
INTEGER :: nc
!
CALL field_count( nc, str )
!
IF( nc < nf ) &
CALL errore( ' field_compare ', &
& ' wrong number of fields: ' // TRIM( var ), 1 )
!
RETURN
!
END SUBROUTINE field_compare
!
!
!--------------------------------------------------------------------------
SUBROUTINE con_cam(num, line, car)
!--------------------------------------------------------------------------
CHARACTER(LEN=*) :: line
CHARACTER(LEN=1) :: sep
CHARACTER(LEN=1), OPTIONAL :: car
INTEGER :: num, j
num = 0
IF (len(line) .GT. 256 ) THEN
WRITE( stdout,*) 'riga ', line
WRITE( stdout,*) 'lunga ', len(line)
num = -1
RETURN
END IF
WRITE( stdout,*) '1riga ', line
WRITE( stdout,*) '1lunga ', len(line)
IF ( .NOT. present(car) ) THEN
sep=char(32) !char(32) is the blank character
ELSE
sep=car
END IF
DO j=2, MAX(len(line),256)
IF ( line(j:j) == '!' .OR. line(j:j) == char(0)) THEN
RETURN
END IF
IF ( (line(j:j) .EQ. sep) .AND. &
(line(j-1:j-1) .NE. sep) ) THEN
num = num + 1
END IF
END DO
RETURN
END SUBROUTINE con_cam
!
!--------------------------------------------------------------------------
SUBROUTINE get_field(n, field, str, sep)
!--------------------------------------------------------------------------
! Extract whitespace-separated nth block from string
IMPLICIT NONE
INTEGER,INTENT(IN) :: n
CHARACTER(len=*),INTENT(OUT) :: field
CHARACTER(len=*),INTENT(IN) :: str
CHARACTER(len=1),OPTIONAL,INTENT(IN) :: sep
INTEGER :: i,j,z ! block start and end
INTEGER :: k ! block counter
CHARACTER(len=1) :: sep1, sep2
!print*, "------------- parser start -------------"
!print '(3a)', "string: -->", str,"<--"
IF(present(sep)) THEN
sep1 = sep
sep2 = sep ! redundant, but easy
ELSE
sep1 = char(32) ! ... blank character
sep2 = char(9) ! ... tab char
ENDIF
!
k = 1 ! counter for the required block
!
DO i = 1,len(str)
! look for the beginning of the required block
z = MAX(i-1,1)
!print '(2a1,3i4,2l)', str(i:i), str(z:z), i,z,k,n,&
! (str(i:i) == sep1 .or. str(i:i) == sep2), (str(z:z) /= sep1 .and. str(z:z) /= sep2)
IF( k == n) EXIT
IF( (str(i:i) == sep1 .or. str(i:i) == sep2) &
.and. &
(str(z:z) /= sep1 .and. str(z:z) /= sep2) &
) &
k = k+1
ENDDO
!
!print*, "i found: ",i
DO j = i,len(str)
! look for the beginning of the next block
z = MAX(j-1,1)
IF( (str(j:j) == sep1 .or. str(j:j) == sep2) &
.and. &
(str(z:z) /= sep1 .and. str(z:z) /= sep2) &
) &
k = k+1
IF( k >n) EXIT
ENDDO
!print*, "j found: ",j
!
IF (j <= len(str)) THEN
! if we are here, the reqired block was followed by a separator
! and another field, we have to trash one char (a separator)
field = TRIM(adjustl(str(i:j-1)))
!print*, "taking: ",i,j-2
ELSE
! if we are here, it was the last block in str, we have to take
! all the remaining chars
field = TRIM(adjustl(str(i:len(str))))
!print*, "taking from ",i
ENDIF
!print*, "------------- parser end -------------"
END SUBROUTINE get_field
END MODULE parser
|
