-
Notifications
You must be signed in to change notification settings - Fork 0
/
rd_tfile.pro
290 lines (283 loc) · 11.4 KB
/
rd_tfile.pro
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
function rd_tfile, filename, ncols, skip, hskip=hskip,$
delim=delim, nocomment=nocomment, compress=compress, $
quiet=quiet, autocol=autocol, convert=convert, header=header, $
first_char_comm=first_char_comm
;+
; Name: rd_tfile
;
; Purpose: read/return contents of text file - optionally interpret
; and convert text table data
;
; Input Paramters:
; filename - string variable containing file name to read
; ncols - (optional) #colunms (output will be matrix, strarr(NCOLSxN)
; skip - (optional) #lines to skip (header) for readfile compatibile
; (if skip=-1, first non-numeric lines are skipped)
;
; Output Parameters:
; function returns file contents (string array(list) or matrix)
; if convert is set, auto-convert to numeric data type
;
; Keyword Parameters:
; delim - table column delimiter (default is blank/tab)
; nocomment - if=1 (switch) , remove lines with (unix:#, vms:!)
; if string (scaler), remove lines with specified character
; compress - eliminate leading/trailing blanks and excess whitespace
; (for table data (ncols gt 1), compress is assumed)
; quiet - if set, suppress warning messages
; autocol - if set, derive column count from first non-comment line
; convert - if set, convert to numeric data type
; header - output string(array) containing header lines
; hskip - header skip (sets skip to -1)
; first_char_comm - if set, only apply "nocomment" flag when the
; comment character is the first character
;
; Calling Sequence:
; ; RETURNS
; text=rd_tfile(filename) ; orig. file-> string array
; text=rd_tfile(filename,/nocomment) ; same less comment lines
; text=rd_tfile(filename,/compress) ; same less excess blanks
; data=rd_tfile('text.dat',3) ; strarr(3,N) (table data)
; data=rd_tfile('fdata.dat',/auto,/convert); determine n columns and
; ; data type automatically
; data=rd_tfile(filename,/hskip,head=head) ; return file header in head
;
;
; History:
; slf, 4-Jan-1992 - for yohkoh configuration files
; slf, 6-Jan-1992 - remove partial comment lines
; slf, 11-feb-1993 - added autocol keyword and function
; added convert keyword and function
; slf, 28-Oct-1993 - temp fix for VMS variable length files
; slf, 26-jan-94 fixed bug if /auto and user supplied comment char
; dmz, 3-Mar-94 - changed type to type/nopage (for vms), otherwise
; it is really slow
; slf, 21-May-94 - fix bug in /convert auto skip function (allow '-' !!)
; mdm, 15-Mar-95 - Modified to not crash on reading a null file.
; mdm, 12-Oct-95 - Modification to allow tab character to be the delimiter.
; slf, 27-mar-96 - Put MDM oct change online
; ras, 19-jun-96 - Use rd_ascii in vms
; slf, 29-may-97 - force FILENAME -> scalar
; slf, 16-sep-97 - allow ascii files with NO carraige returns
; slf, 6-oct-97 - include last line which has NO carraige return
; mdm, 25-Nov-97 - Made FOR loop long integer
; mdm, 7-Apr-98 - Print the filename when NULL
; slf, 19-aug-98 - per MDM report, free lun on read error
; mdm, 11-Feb-99 - Added /first_char_comm
;
; Category:
; gen, setup, swmaint, file i/o, util
;
; Method:
; files are assumed to be ascii - file contents read into a variable
; if ncols is greater than 1, then a table is assumed and a string
; matrix is returned - table is null filled for non existant table
; entries (ncols gt 1 forces white space removal for proper alignment)
;
;-
; ----------- handle input parameter setup and assign defaults -------------
; set up defaults
if not keyword_set(delim) then delim=' ' ; blank/tab is default
if not keyword_set(ncols) then ncols=1 ; default is text list
if keyword_set(hskip) then skip=-1 ; skip header
if n_elements(skip) eq 0 then skip=0
if (keyword_set(first_char_comm)) and (not keyword_set(nocomment)) then nocomment = first_char_comm
;
qtemp=!quiet ; avoid global effects
!quiet=keyword_set(quiet)
;
; if table data (ncols gt 1) then override nocomp flag to force proper
; table alignment....
convert=keyword_set(convert) ; convert text to numeric
autocol=keyword_set(autocol) ; auto-determine number columns
numeric= (skip eq -1) or convert ;
compress= ( (keyword_set(compress)) or (ncols ne 1) or autocol or numeric) and (delim ne string(9b))
;
; for table, force removal of comment lines (returning table)
if not keyword_set(nocomment) then $
nocomment=ncols ne 1 or autocol or convert
;
; ----------------------------------------------------------------------------
;
data='' ; initialize return
; read file into text buffer
on_ioerror, openerror
filename=filename(0) ; force scalar
if strupcase(!version.os) ne 'VMS' then begin
openr,lun,/get_lun, filename
on_ioerror, readerror
; --------- slf, 5-Jan-1992 read into one byte buffer for speed -------
; (replaced read line till eof which was too slow)
fstatus=fstat(lun) ; determine file size
if (fstatus.size ne 0) then begin
btext=bytarr(fstatus.size) ; byte buffer for all
readu,lun,btext ; read into byte buffer
wlfs=where(btext eq 10b,lfcount) ; number of line feeds
if lfcount eq 0 then begin
text=string(btext) ; NO Line feed case
endif else begin
btext=0 ; release memory
text=strarr(lfcount) ; now use string arrary
point_lun,lun,0 ; reset to beginning
readf,lun,text ; read into string array
fstatus=fstat(lun) ; re-check status
remainder=fstatus.size - fstatus.cur_ptr
if remainder gt 0 then begin
lastline=bytarr(remainder)
readu,lun,lastline
text=[temporary(text),string(lastline)]
endif
endelse
end else begin
text = ''
end
free_lun,lun
endif else begin
;message,/info,'VMS Temp Fix, may be slow...'
;spawn,'type/nopage ' + filename,text
text=rd_ascii(filename)
endelse
; ------------------------------------------------------------------------
; ------------ optional non-numeric header skip function ----------------
; header has non-numeric (0,1,...9 or decimal point) first character
header=keyword_set(header) or (skip eq -1)
if numeric then begin ; auto-skip non-numerical header
ttext=strmid(strtrim(text,1),0,1) ; first non-blank character
firstbyte=byte(ttext)
; slf 21-may-94 add negative (-) to valid numeric first character
special=where(firstbyte eq 46b or firstbyte eq 45b,dcnt)
if dcnt gt 0 then firstbyte(special)=48b ; force in range
numerics=where(firstbyte ge 48b and firstbyte le 57b,ncnt)
if ncnt eq 0 then skip=0 else skip=numerics(0)
endif
header=''
if skip ge n_elements(text) then begin
message,/info,'Skip lines greater than file lines!'
header=text
text=''
endif else begin
if skip gt 0 then header = text[0:skip-1]
text=text[skip:*]
endelse
;
if numeric then if ncnt gt 0 then text=text(numerics-skip)
; ----------- optional compression and whitespace elimination -----------------
; eliminate excess whitespace, leading and trailing blanks, null lines
; unless otherwise indicated (ie, nocomp is set)
if compress then begin
text=strtrim(strcompress(text),2)
nonnulls = where(text ne '',nncount)
if nncount eq 0 then begin
message,/info,'Null file! (' + filename + ')'
return,data
endif else text=text(nonnulls)
endif
; ----------------------------------------------------------------------------
;
; -------------- optional comment elimination ---------------------------------
;
; ('wordy' to handle partial comment lines and retension of existing null lines)
;
gtext=text ; 'good' text
if keyword_set(nocomment) then begin ; remove comment lines
scomment=size(nocomment)
comtype=scomment(n_elements(scomment)-2)
; allow user-supplied delimiter or use default if nocomment use as switch
case comtype of
7: comchar=nocomment ; user supplied comment char
else: case strupcase(!version.os) of
'VMS': comchar='!' ; assume VMS command file
else: comchar='#' ; assume unix script
endcase
endcase
compos=strpos(gtext,comchar)
if (keyword_set(first_char_comm)) then wherecom=where(compos eq 0, ccount) $
else wherecom=where(compos + 1, ccount)
; wherecom=where(compos + 1, ccount)
; for each line containing a comment character
for j=0L,ccount-1 do begin
gtext(wherecom(j)) = $
strmid(gtext(wherecom(j)),0,compos(wherecom(j)))
endfor
;
; dont delete
if ccount gt 0 then begin
newnulls=where(gtext(wherecom) eq '',nncount)
if nncount gt 0 then begin
delpat='rd_tfile_delete'
gtext(wherecom(newnulls)) = delpat ; mark for deletion
keep = where(gtext ne delpat,kcount)
if kcount gt 0 then gtext=gtext(keep) else begin
message,/info,'Nothing left after removing comment lines!'
return,data
endelse
endif
endif
endif
; ----------------------------------------------------------------------------
;
; ------------- auto column determination function -------------------------
if autocol then begin ; determine number columns from 1st
testcol=str2arr(gtext(0),delim)
ncols=n_elements(testcol)
endif
; ---------------------------------------------------------------------------
; ------------- matrix formation (table data) -------------------------------
; fill in matrix if ncols gt 1
if ncols eq 1 then data=gtext else begin
data=strarr(ncols,n_elements(gtext))
for i=0L,n_elements(gtext)-1 do begin
array = str2arr(gtext(i),delim)
array = array(0:min([ncols-1,n_elements(array)-1]) )
data(0,i) = array
endfor
endelse
!quiet=qtemp
;
if compress then data=strtrim(data,2) ; clean up substrings
;
; ------------ optional numeric data type conversion -----------------------
; slf, 11-feb-1993
; add data type conversion code for convenience - assume user knows what
; shes doing. Of course, user can do this outside of this routine:
; for example, data=fix(rd_tfile(file,/auto))
if convert then begin ; auto convert
data=strupcase(data)
bdata=byte(data) ; always ok
; are these floating numbers?
decimal=where(bdata eq 46b,dcnt)
eexp=where(bdata eq 69b,ecnt)
on_ioerror,cnverror
if (dcnt or ecnt) gt 0 then data=float(data) else begin
data=long(data)
case 1 of
; max(data) lt 256: data=byte(data) ; do we want this?
max(data) lt 32768l: data=fix(data) ; fix it
else: ; leave it long
endcase
endelse
endif
;
;-----------------------------------------------------------------------------
;
; normal completion, return the data
;
return, data
;
;
; i/o and type conversion errors
openerror:
message,/info,'No file: ' + filename
!quiet=qtemp
return,data
readerror:
free_lun,lun
message,/info,'Error reading file: ' + filename
!quiet=qtemp
return,data
cnverror:
free_lun,lun
message,/info,'Error converting text to numeric data in file: ' + filename
!quiet=qtemp
return,data
end