Commit 1cc85c79 authored by Ian Boyd's avatar Ian Boyd
Browse files

Upload New File

parent 801b4d34
; ************ pstr start ************
function pstr, x, format=fmt
;+
; NAME:
; pstr
; PURPOSE:
; Utility to format a variable or array for printing as a string
; CATEGORY:
; text string
; CALLING SEQUENCE:
; print_str = pstr(x)
; print_str = pstr(x,format=fmt)
; print, pstr(x)
; INPUTS:
; x = variable to print
; OPTIONAL INPUT PARAMETERS: none
; KEYWORD PARAMETERS:
; fmt = format descriptor string
; OUTPUTS: none
; SIDE EFFECTS: none known
; RESTRICTIONS:
; Format string is assumed correct.
; PROCEDURE:
; A scalar is returned as a simple string with trailing
; and leading blanks removed. An array is returned as a string if it fits
; on one 79-character line, and an array of 79-character strings otherwise.
; REQUIRED ROUTINES:
; IDL library: n_elements, strtrim, string, strlen, strarr, strmid
; MODIFICATION HISTORY:
; T.Atwater 910405 -- Created
; $Header$
;-
; If variable is undefined, return the variable
; Redefine variable as string, and remove leading and trailing blanks
; If variable is a scalar, return the string
; For each element in array except last, add it to string, plus a blank
; Add last element to string
; Compute no.lines
; If only 1 line, return the line
if n_elements(x) eq 0 then return, x
if n_elements(fmt) eq 0 then fmt = ''
s = strtrim(string(x,format=fmt),2)
if n_elements(s) eq 1 then return, s
t = ''
for i=0,n_elements(s)-2 do t = t + s(i) + ' '
t = t + s( n_elements(s) - 1 )
ll = 79
nl = strlen(t)/ll + 1
if nl eq 0 then return, t
; Dimension array of lines
; Save normal line length (approx. length of all lines except last)
; For each line of output
; Extract next chunk from string
; Determine length of chunk
; (Make sure lines do not end in the middle of a variable or word)
; If chunk has at least 1 blank, beginning of next chunk is not a blank,
; and this is not the last chunk
; While looking for 1st blank from end of string, increment string index
; Save chunk up to (but not including) last blank as output line
; Endif else save entire chunk as output line
; Increment string position counter to beginning of next chunk
; End for
; Return the array of lines
r = strarr(nl)
rlen = ll - 1
c = 0
for i=0,nl-1 do begin
temp = strmid(t,c,ll)
j = strlen(temp) - 1
if strpos(temp,' ') ne -1 and strmid(t,c+ll,1) ne ' ' and j eq rlen then $
begin
while strmid(temp,j,1) ne ' ' do j = j - 1
r(i) = strtrim( strmid(temp,0,j), 2 )
endif else r(i) = strtrim(temp,2)
c = c + j + 1
endfor
return, r
end
; ************ pstr end ************
; ************ xchgread_hdcom start ************
pro xchgread_hdcom, in, head_common, errfix
;+
; NAME:
; xchgread_hdcom
; PURPOSE:
; Reads that part of exchange file header common to all formats for xchgread
; CATEGORY:
; mission, exchange
; CALLING SEQUENCE:
; xchgread_hdcom, in, head_common
; INPUTS:
; in = LUN of exchange file
; OPTIONAL INPUT PARAMETERS: none
; KEYWORD PARAMETERS: none
; OUTPUTS:
; head_common = header values common to all file formats
; head_common.nlhead = No. lines in exchange file header
; head_common.ffi = File format index
; head_common.oname = Observer name
; head_common.org = Organization
; head_common.sname = Source of measurements
; head_common.mname = Mission name
; head_common.ivol = Volume number of this file
; head_common.nvol = Total no. volumes for this dataset
; head_common.date = Date of mission (yymmdd)
; head_common.rdate = Revision date (yymmdd)
; SIDE EFFECTS: none known
; RESTRICTIONS: none
; PROCEDURE: straightforward
; Date is changed from 3 integer parameters (yyyy,dd,mm) to 1 string (ddmmyy);
; Otherwise data is not modified.
; REQUIRED ROUTINES:
; Idl Library: intarr, readf, fix, long
; MODIFICATION HISTORY:
; T.Atwater 910405 -- Created
; I.Boyd 130324 -- Add errfix to call which accounts for incorrect number of header values
; in some McMurdo sonde files
; $Header: /science/missions/programs/exchange/xchgread_hdcom.pro,v 1.1
; 91/05/07 12:27:40 atmos Exp $
;-
nlhead = 0
ffi = 0
oname = 'empty'
sname = 'empty'
mname = 'empty'
org = 'empty'
ivol = 0
nvol = 0
date = intarr(3)
rdate = intarr(3)
; Read no. lines in header, file format index
; Read observer name, source of measurements, mission
; Read volume no. of this file, total no. volumes of this dataset
; Read yyyy mm dd datset created, yyyy mm dd dataset revised
readf, in, nlhead, ffi
readf, in, oname
readf, in, org
readf, in, sname
readf, in, mname
readf, in, ivol, nvol
readf, in, date, rdate
;Check for fix to total number of header lines to some McMurdo Sonde Data
if N_PARAMS() eq 2 then errfix=[0,0]
if errfix[1] ne 0 then nlhead=errfix[1]
; Save common header data into structure
; Return
head_common.nlhead = nlhead
head_common.ffi = fix(ffi)
head_common.oname = oname
head_common.org = org
head_common.sname = sname
head_common.mname = mname
head_common.ivol = ivol
head_common.nvol = nvol
head_common.date = $
pstr( 10000 * ( long( date(0)) mod 100 ) + 100 * date(1) + date(2) )
head_common.rdate = $
pstr( 10000 * ( long(rdate(0)) mod 100 ) + 100 * rdate(1) + rdate(2) )
return
end
; ************ xchgread_hdcom end ************
; ************ xchgread_var start ************
pro xchgread_var, in, n, scal, miss, name, errfix
;+
; NAME:
; xchgread_var
; PURPOSE:
; Reads primary or auxiliary variable descriptors for xchgread
; CATEGORY:
; mission, exchange
; CALLING SEQUENCE:
; xchgread_var, in, n, scal, miss, name
; INPUTS:
; in = LUN of exchange file
; OPTIONAL INPUT PARAMETERS: none
; KEYWORD PARAMETERS: none
; OUTPUTS:
; n = No.variable(s)
; scal = Variable scale(s)
; miss = Variable missing data value(s)
; name = Variable name(s)
; SIDE EFFECTS: none known
; RESTRICTIONS:
; Intended for use only by procedure XCGHREAD.
; PROCEDURE: straightforward
; REQUIRED ROUTINES:
; Idl Library: readf, intarr, lonarr, strarr
; MODIFICATION HISTORY:
; T.Atwater 910405 -- Created
; $Header: /science/missions/programs/exchange/xchgread_var.pro,v 1.1
; 91/05/07 12:27:46 atmos Exp $
; I.Boyd 110625 - Make missing values double precision instead of long integer,
; Check for header error in Hilo sonde data
;-
; Read no.variables
; If zero, return
; Declare scale factor, missing value, variable name arrays
; Read scale factor, missimg value, variable name
; Return
n = 0
if N_PARAMS() lt 6 then errfix=[0,0]
readf, in, n
if n le 0 then return
scal = fltarr(n)
miss = dblarr(n)
if errfix[0] eq 1 then name = strarr(n-1) else name = strarr(n)
readf, in, scal
readf, in, miss
readf, in, name
if errfix[0] eq 1 then begin ;add missing Frost Point data header
name=[name[0:3],'Frost Point Temperature; degrees C',name[4:9]]
endif
return
end
; ************ xchgread_var end ************
; ************ xchgread_cmnt start ************
pro xchgread_cmnt, in, ncoml, cmnt, flag
;+
; NAME:
; xchgread_cmnt
; PURPOSE:
; Reads and prints data exchange file comments for xchgread
; CATEGORY:
; mission, exchange
; CALLING SEQUENCE:
; xchgread_cmnt, in, flag
; INPUTS:
; in = LUN of exchange file
; flag = Comment print request flag
; =1, Echo all comments in file to standard output
; =0, Do not echo
; OPTIONAL INPUT PARAMETERS: none
; KEYWORD PARAMETERS: none
; OUTPUTS: none
; SIDE EFFECTS: none known
; RESTRICTIONS:
; Intended for use only by procedure XCHGREAD.
; File pointer must be positioned at the correct line in the file.
; PROCEDURE: Straightforward. Comments are not saved.
; REQUIRED ROUTINES:
; Idl Library: readf, print
; MODIFICATION HISTORY:
; T.Atwater 910405 -- Created
; $Header: /science/missions/programs/exchange/xchgread_cmnt.pro,v 1.1
; 91/05/07 12:27:36 atmos Exp $
;-
; Initialize
; For each of normal, special comments
; Read no.comment lines from file header
; For each comment line
; Read the comment
; If requested, write it to standard output
; End for
; End for
; Return
cmnt = ''
ncoml1 = 0
ncoml2 = 0
readf, in, ncoml1
if ncoml1 gt 0 then begin
coms1=strarr(ncoml1)
readf, in, coms1
endif
readf, in, ncoml2
ncoml=ncoml1+ncoml2
if ncoml2 gt 0 then begin
coms2=strarr(ncoml2)
readf, in, coms2
if ncoml1 ne 0 then cmnt=[coms1,coms2] $
else cmnt=coms2
endif else if ncoml1 gt 0 then cmnt=coms1
if ncoml eq 0 then cmnt=['']
;for i=0,1 do begin
; readf, in, ncoml
; for j=0,ncoml-1 do begin
; readf, in, cmnt
; if flag then print, cmnt
; endfor
;endfor
return
end
; ************ xchgread_cmnt end ************
; ************ xchgread_next start ************
function xchgread_next, in, file_names, nf, i, nlhead, db_head
;+
; NAME:
; xchgread_next
; PURPOSE:
; Repositions file pointer and optionally opens next data exchange file
; volume for xchgread
; CATEGORY:
; mission, exchange
; CALLING SEQUENCE:
; ret_code = xchgread_next( in, file_names, nf, i, nlhead, db_head )
; INPUTS:
; in = LUN of exchange file
; file_names = Data exchange file name(s)
; nf = Total no. data volumes to process
; i = Volume no. of exchange file
; nlhead = No. lines in exchange file header
; db_head = 1 if database header in files
; 0 if no database header
; OPTIONAL INPUT PARAMETERS: none
; KEYWORD PARAMETERS: none
; OUTPUTS:
; ret_code = returned value
; =0, success
; <0, Error opening data exchange file volume #(abs(n))
; SIDE EFFECTS: none known
; RESTRICTIONS:
; Intended for use only by procedure XCGHREAD.
; PROCEDURE: If processing more than 1 data volume, close old file and open
; next one; else rewind old file to top. Skip header to position file
; pointer at first data record.
; REQUIRED ROUTINES:
; Idl Library: free_lun, openr, print, point_lun, readf
; MODIFICATION HISTORY:
; T.Atwater 910405 -- Created
; J.Wild 910920 -- Added lines to skip database header
; $Header: /science/missions/programs/exchange/xchgread_next.pro,v 1.1
; 91/05/07 12:27:42 atmos Exp $
;-
; If more than 1 data volume requested
; Close old data file
; If this is not the last volume, set index to next volume
; Else set index to first volume
; Open next volume
; If error, return
; Else reset file pointer to beginning of file
; While still reading header
; Read a header line
; Increment index
; End while
; Return
if nf gt 1 then begin
free_lun, in
if i lt nf then fi = i else fi = 0
openr, in, file_names(fi), error=err, /get_lun
if err ne 0 then begin
print, 'XCHGREAD_NEXT: Error opening file ' + file_names(i+1)
return, -1*(i+1)
endif
endif else point_lun, in, 0
a_line = ''
nh = 0L
while nh lt nlhead+db_head do begin
readf, in, a_line
nh = nh + 1
endwhile
return, 0
end
; ************ xchgread_next end ************
; ************ xchgread_numrec start ************
function xchgread_numrec, in, file_names, nf, nlhead, record_1, db_head, $
var_rec, nx_miss, nx_max, nx_all
;+
; NAME:
; xchgread_numrec
; PURPOSE:
; Determine total no. data records in data exchange file(s) for XCHGREAD
; CATEGORY:
; mission, exchange
; CALLING SEQUENCE:
; nrec = xchgread_numrec( f, file_names, nf, nlhead, record_1,db_head )
; nrec = xchgread_numrec( f, file_names, nf, nlhead, record_1,db_head, $
; record_2, nx_miss, nx_max )
; nrec = xchgread_numrec( f, file_names, nf, nlhead, record_1,db_head, $
; nv, nx_miss, nx_max )
; INPUTS:
; in = LUN of exchange file
; file_names = Data exchange file name(s)
; nf = Total no. data volumes to process
; nlhead = No. lines in exchange file header
; record_1 = Record structure
; If the file is of constant record length format, record_1 is the
; entire data record structure
; If the file is of variable record length format, record_1 is the
; structure of the constant part of the data record
; record_1.nx must be read as no.(variable length) sub-records
; db_head = 1 if file contains database header
; = 0 if file does not contain database header
; OPTIONAL INPUT PARAMETERS: (variable record length format only)
; var_rec = Parameter relating to variable length portion of record
; If FFI is not 2310, var_rec is a structure describing variable portion
; If FFI is 2310, var_rec is a scalar and equal to no.primary variables
; nx_miss = missing value of no. sub-records variable
; KEYWORD PARAMETERS: none
; OUTPUTS:
; nx_max = max no.sub records in entire dataset (variable recl only)
; nrec = returned value
; >0, Total no. data records in data exchange file(s)
; <0, Error opening data exchange file volume #(abs(n))
; SIDE EFFECTS: none known
; RESTRICTIONS:
; Intended for use only by procedure XCGHREAD.
; PROCEDURE:
; Set flags to indicate special processing cases.
; For each data volume to process, while file not yet exhausted, read a
; record; if variable record length, also read sub_records. When file
; is exhausted, call routine to optionally open next file and skip over
; header. Return no. data records.
; REQUIRED ROUTINES:
; IDL Library: n_params, size, n_elements, readf
; User library: xchgread_next
; MODIFICATION HISTORY:
; T.Atwater 910405 -- Created
; T.Halihan 910801 -- Changed loop to count through integer values
; J.Wild 910920 -- Added lines to skip database header
; $Header: /science/missions/programs/exchange/xchgread_numrec.pro,v 1.1
; 91/05/07 12:27:44 atmos Exp $
;-
; Set flag to indicate whether will process sub_records
; Determine type of input variable 'var_rec'
; If 'var_rec' is defined (i.e. if reading a variable record length format file)
; If 'var_rec' is a structure
; Save 'var_rec' as structure for reading variable part of record
; Else
; Save 'var_rec' as scalar, no.primary variables
; Set flag to indicate that this is format 2310
; End if/else
; Endif
flag = ( n_params() gt 6 )
var_rec_size = size( var_rec )
var_rec_type = var_rec_size(n_elements(var_rec_size)-2)
flag_2310 = 0
if var_rec_type gt 0 then begin
if var_rec_type eq 8 then begin
record_2 = var_rec
endif else begin
nv = var_rec
flag_2310 = 1
endelse
endif
nrec = 0L
nx_max = 0L
junk=''
nx_all=lonarr(1) ;array holding all individual nx values
; For each volume
; While not out of data
; Read record (or part of record if processing sub-records)
for f=1,nf do begin
while not eof(in) do begin
if junk eq '' then readf, in, record_1 else record_1=junk
; If processing sub-records and there is at least one sub-record
; If this is not format 2310
; For each sub-record, read it
; Else (necessary because more than 1 value per 80-char line in file)
; Declare array
; For each primary variable, read data
; End if/else
; If this is the largest no.sub-records yet read, save no.sub-records
; End if
if flag then if record_1.nx ne 0 and record_1.nx ne nx_miss then begin
if not flag_2310 then begin
;check that nx value is correct (also check extra line if not eof after reading set of records)
nxinc=0L
while (not eof(in)) and (nxinc lt long(record_1.nx)) do begin
readf, in, record_2 & nxinc=nxinc+1L
endwhile
if not eof(in) then begin
;read in one more line and check for eof otherwise assume that there is another record
readf, in, junk
if eof(in) then nxinc=nxinc+1L ;this means that record_1.nx is low by 1
endif
;if eof before record_1.nx this means that record_1.nx is incorrect i.e. too high
if nxinc gt nx_max then nx_max=nxinc
if n_elements(nx_all) eq 1 then nx_all(0)=nxinc else nx_all=[nx_all,nxinc]
endif else begin
v_n = fltarr(record_1.nx)
for n=0,nv-1 do readf, in, v_n
if record_1.nx gt nx_max then nx_max = record_1.nx
endelse
endif
; Increment record counter
; End while
; Call routine to close file and open next one if required
; End for
; Return no.records read
nrec = nrec + 1
endwhile
r = xchgread_next( in, file_names, nf, f, nlhead ,db_head)
if r lt 0 then return, r
endfor
return, nrec
end
; ************ xchgread_numrec end ************
; ************ xchgread_bldstr start ************
function xchgread_bldstr, i, n, m, f
;+
; NAME:
; xchgread_bldstr
; PURPOSE:
; Builds a string to be used as a structure declaration for xchgread
; CATEGORY:
; mission, exchange
; CALLING SEQUENCE:
; build_str = xchgread_bldstr( i, nauxv, m, f )
; INPUTS:
; i = initial string
; n = switch for including middle string
; m = middle string
; f = final string
; OPTIONAL INPUT PARAMETERS: none
; KEYWORD PARAMETERS: none
; OUTPUTS: none
; SIDE EFFECTS: none known
; RESTRICTIONS:
; Intended for use only by procedure XCGHREAD.
; PROCEDURE: straightforward
; REQUIRED ROUTINES: none
; MODIFICATION HISTORY:
; T.Atwater 910405 -- Created
; $Header: /science/missions/programs/exchange/xchgread_bldstr.pro,v 1.1
; 91/05/07 12:27:34 atmos Exp $
;-
s = i
if n gt 0 then s = s + m
s = s + f
return, s
end
; ************ xchgread_bldstr end ************
; ************ xchgread_ffi start ************
function xchgread_ffi, in, head_common, file_names, c_flag, db_head, data, errfix
;+
; NAME:
; xchgread_ffi
; PURPOSE:
; Switch on file format index and read data exchange file for xchgread
; CATEGORY:
; mission, exchange
; CALLING SEQUENCE:
; ret_code = xchgread_ffi( in, head_common, file_names, c_flag,db_head, $
; data )
; INPUTS:
; in = LUN of data exchange file explicitly requested in XCHGREAD call
; head_common = Header values common to all formats
; head_common.nlhead = Total no. lines in header
; head_common.ffi = File format index
; head_common.ivol = Volume number of data exchange file explicitly
; requested in XCHGREAD call
; head_common.nvol = Total number of volumes for this dataset
; file_names = Data exchange file name(s), one for each volume to read
; c_flag = Comment print request flag
; =1, Echo all comments in file to standard output
; =0, Do not echo (default)
; db_head = 1 if file contains database header
; = 0 if file contains no database header
; OPTIONAL INPUT PARAMETERS: none
; KEYWORD PARAMETERS: none
; OUTPUTS:
; (Header values unique to this format are output via common blocks)
; data = Data values
; data.x = Unbounded independent variable
; data.x0 = Bounded independent variable(s)
; data.v = Primary variable(s)
; data.a = Auxiliary variable(s)
; ret_code: