;+
; NAME: ffo_string - substitute for string()
;
; PURPOSE: allows override of free format I/O specifications
;
; INPUT: format - a format specification, value - a value to be string'ed
;
; Examples: newstring = ffo_string( 'F10.2', 354.9985 )
; newstring = ffo_string( struct.format, struct.dat )
;
; NOTE: this function wraps the format string in parenthesis
;
; original version - JWJ 08/08/2000
;
FUNCTION ffo_string, format, value
; First, if format is defined, just use it against the value
; and return the result
if strlen( format ) gt 0 then begin
; print, 'ffo_string using given format: string( FORMAT = (' + format + '), value)'
return, string( FORMAT = '(' + format + ')', value )
endif
; Here's the original reason this function was developed.
; If the format is not defined and the data type
; is FLOAT, use F13.6 instead of the IDL 5.2 free format
; specifier of G13.6 which is causes us particular problems
if size( value, /type ) eq 4 then begin
; print, 'ffo_string overriding free format for FLOAT type: string( FORMAT = (F13.6), value)'
return, string( FORMAT = '(F13.6)', value )
endif
; At last, if no particular rules were met for overriding the
; format specifcation, use the free format I/O
; print, 'ffo_string doing free format I/O: string( value )'
return, string( value )
end ; ffo_string
;+
; NAME: delete.pro
;
; PURPOSE: Frees memory
;
; INPUT; var - any variable
;
PRO delete, var
;
; ptr=PTR_NEW(var)
; PTR_FREE, ptr
var = 0B
;
end
;+
; NAME: reform_strc.pro
;
; PURPOSE: Reforms the data array from a (1,N) to a (N).
;
; astrc - Input structure
;
FUNCTION reform_strc, astrc
istr=0
namest=tag_names(astrc)
ns_tags=n_tags(astrc)
for k=0, ns_tags-1 do begin
tagname=namest(k)
names=tag_names(astrc.(k))
ntags=n_tags(astrc.(k))
mc=where((names eq 'VAR_NOTES'),nc)
for j=0, ntags-1 do begin
if(names(j) eq 'DAT') then begin
asize=size(astrc.(k).dat)
if(asize(0) gt 0) then newdata=reform(astrc.(k).dat) else $
newdata=astrc.(k).dat
tempa=create_struct('DAT',newdata)
tempb=create_struct(tempb,tempa)
endif else begin
str_p=astrc.(k).(j)
if(j eq 0) then begin
tempb=create_struct(names(j),str_p)
endif else begin
tempa=create_struct(names(j),str_p)
tempb=create_struct(tempb,tempa)
endelse
endelse
endfor ; end j
; Add VAR_NOTES to each variable that does not have this attribute
if(mc(0) lt 0) then begin
tempa=create_struct('VAR_NOTES','')
tempb=create_struct(tempb,tempa)
endif
; Add each variable to the overall structure
if(istr eq 0) then begin
temp2=create_struct(namest(k),tempb)
b=create_struct(temp2)
endif else begin
temp2=create_struct(namest(k),tempb)
b=create_struct(b,temp2)
endelse
istr=istr+1
endfor ; end k
; Free Memory
delete, tempa
delete, tempb
delete, temp2
return, b
end
;
;12/13/2006 - TJK moved parse_mydepend0 out of this file to its own
;file (w/ same name so that it can be called by read_myCDF.pro
;
;+
; NAME: reform_mystruc.pro
;
; PURPOSE: Reforms the data array from a (i,j,k) to a (i*j,k).
;
; astrc - Input structure
FUNCTION reform_mystruct, astrc
istr=0
namest=tag_names(astrc)
ns_tags=n_tags(astrc)
for k=0, ns_tags-1 do begin
sz=size(astrc.(k).dat)
names=tag_names(astrc.(k))
ntags=n_tags(astrc.(k))
if(sz(0) eq 3) then begin
tagname=namest(k)
newsz=sz(1)*sz(2)
newdata=reform(astrc.(k).dat,newsz,sz(3))
astrc.(k).var_notes='ListImage'
for j=0, ntags-1 do begin
if(names(j) eq 'DAT') then begin
tempa=create_struct('DAT',newdata)
tempb=create_struct(tempb,tempa)
endif else begin
tag_cmd='str_p=astrc.'+tagname+'.(j)'
if(not execute(tag_cmd)) then begin
print, 'ERROR=Execute error setting tag_cmd2'
close,1
return, -1
endif
if(j eq 0) then begin
tempb=create_struct(names(j),str_p)
endif else begin
tempa=create_struct(names(j),str_p)
tempb=create_struct(tempb,tempa)
endelse
endelse
endfor ; end j
temp2=create_struct(namest(k),tempb)
b=create_struct(b,temp2)
endif else begin
if(istr eq 0) then begin
b=create_struct(namest(k),astrc.(k))
endif else begin
temp=create_struct(namest(k),astrc.(k))
b=create_struct(b,temp)
endelse
endelse
istr=istr+1
endfor
; Free Memory
delete, tempa
delete, tempb
delete, temp
return, b
end
;+
; NAME: ord_mystruc.pro
;
; PURPOSE: Reorders the given structure so that the dimension of the data
; variables is increasing w/ each entry.
;
; astrc - Input structure
; vorder - An array of the dimension of each variable in the structure
FUNCTION ord_mystruct, astrc, vorder, is
vlen=n_elements(vorder)
vmax=max(vorder)
istr=0
names=tag_names(astrc)
for k=is, vmax do begin
for i=0, vlen-1 do begin
if(vorder(i) eq k) then begin
if(istr eq 0) then begin
bnew=create_struct(names(i),astrc.(i))
endif else begin
temp=create_struct(names(i),astrc.(i))
bnew=create_struct(bnew,temp)
endelse
istr=istr+1
endif
endfor ; end i
endfor ; end k
; Free Memeory
delete, temp
return, bnew
end
;
;
FUNCTION dependn_search,a,i,d
;
; INPUT: a - data structure
; i - index of variable for which we want the values of depend_n
; d - which depend? 1? 2?
; OUTPUT: array of depend_n values
;
; Establish error handler
catch, error_status
if(error_status ne 0) then begin
print, 'STATUS= Data cannot be listed.'
print, 'ERROR=Error number: ',error_status,' in listing (dependn_search).'
print, 'ERROR=Error Message: ', !ERR_STRING
close, 1
return, -1
endif
depn_values=''
tmp_stuff=''
dependn=''
;
case d of
1:begin
q=where(tag_names(a.(i)) eq 'DEPEND_1')
if (q(0) ne -1) then dependn=a.(i).depend_1
end
2:begin
q=where(tag_names(a.(i)) eq 'DEPEND_2')
if (q(0) ne -1) then dependn=a.(i).depend_2
end
endcase
if (dependn(0) ne '') then s=execute('tmp_stuff= a.'+dependn+'.DAT')
if (dependn(0) ne '') then s=execute('dep_fill= a.'+dependn+'.FILLVAL')
if string(tmp_stuff(0)) ne '' then begin
size_tmp=size(tmp_stuff)
case size_tmp(0) of
1: begin
depn_values=strtrim(tmp_stuff,2)
end
2: begin
; RCJ 12/01 As far as I know, there are 2 types of 2D depend matrices.
; Taking, for example angles and a 3x3 matrix:
; a=[[90,180,270],[90,180,270],[90,180,270]] is one possible arrangement, but
; a=[[90,90,90],[180,180,180],[270,270,270]] is also an arrangement I've seen.
; So this code is checking for these 2 types. Taking the first and second
; rows, the first is compared to the second using 'match'. If the elements
; do not match (second case, count=0) our depend array is column 0 of
; the original matrix. If all elements match (first case,
; count=n_elements(one of the rows) then our depend array is row 0 of
; the original matrix. For a case other than these 2 listing the data
; becomes a more difficult task. I would have to think about it....
;ts1=tmp_stuff[*,0]
;ts2=tmp_stuff[*,1]
; Above is the old ts1 and ts2. Now I'm trying to avoid
; comparing arrays that contain fillval (hopefully not *all* of
; them do!) : RCJ 02/21/02
; The "if j lt size_tmp(2)" tests are used in case there are fillvals in
; all of the rows and we don't want to run out of rows to test. RCJ 09/25/02
j=0
test_ts1:
q=where(tmp_stuff[*,j] eq dep_fill)
if q(0) ne -1 then begin
j=j+1
if j lt size_tmp(2)-1 then goto, test_ts1
endif
ts1=tmp_stuff[*,j]
if j lt size_tmp(2)-1 then j=j+1
test_ts2:
q=where(tmp_stuff[*,j] eq dep_fill)
if ((q(0) ne -1) and (j lt size_tmp(2)-1)) then begin
j=j+1
goto, test_ts2
endif
ts2=tmp_stuff[*,j]
;
; Test one array against the other:
;
match,ts1,ts2,its1,its2,count=count
; recycling the variable:
its1=n_elements(ts1)
case count(0) of
0: begin
tmp_stuff=transpose(tmp_stuff[0,*])
end
its1: begin
tmp_stuff=tmp_stuff[*,0]
end
else: begin
print,'WARNING: s/w does not recognize this 2D depend matrix. Too many fillvals?'
print,' Returning first row of array. In listing (dependn_search).'
;return, depn_values ; oh well, it's better to return something:
tmp_stuff=tmp_stuff[*,0]
end
endcase
; read only first line, but this is not generic enough... RCJ (10/01)
;tmp_stuff=tmp_stuff[*,0]
depn_values=strtrim(tmp_stuff,2)
end
endcase
endif
;
return, depn_values
end
;-------------------------------------------------------------------------------------------------
FUNCTION label_search,a,sz,i,k
; RCJ 01/29/2003 We are no longer using label_search_max_width.
;
; Please pay attention to label_search_max_width
; if you make changes to label_search. The previous
; function is a copy of the latter with one specific
; modification, hence any changes may need to be made
; in both places
;
; JWJ 07/31/2000
;
;
; INPUT: a - data structure
; sz - dimension of a(i) variable. First element of output of size().
; i - index of variable for which we want the label
; k - index of array element for which we want the label
;
; OUTPUT: element k of label array for variable a.(i)
;
; Establish error handler
catch, error_status
if(error_status ne 0) then begin
print, 'STATUS= Data cannot be listed.'
print, 'ERROR=Error number: ',error_status,' in listing (label_search).'
print, 'ERROR=Error Message: ', !ERR_STRING
close, 1
return, -1
endif
label=''
len=size(a.(i).dat)
lent=size(a.(0).dat)
length=lent(lent(0)+2)
if(sz le 1) then begin
if(length eq 1 and len(0) eq 1 and len(1) gt 1) then begin
if(a.(i).lablaxis ne '') then label=strupcase(a.(i).lablaxis) else $
lab=strupcase(a.(i).labl_ptr_1)
label=lab(k)
endif else begin
if(a.(i).lablaxis eq '') then label=strupcase(a.(i).fieldnam) else $
label=strupcase(a.(i).lablaxis)
endelse
endif
if(sz eq 2) then begin
if(a.(i).var_notes eq 'ListImage') then begin
if(a.(i).lablaxis ne '') then label=a.(i).lablaxis else $
label=a.(i).fieldnam
endif
if(a.(i).var_notes ne 'ListImage') then begin
;if(a.(i).lablaxis ne '') then label=strupcase(a.(i).lablaxis) ;else begin
;lab=strupcase(a.(i).labl_ptr_1)
;if(lab(0) ne '') then begin
; label=lab(k)
;
; RCJ 03/28/01 Replaced the above with the code below. It is not
; guaranteed that we have labl_ptr_1, and k is sometimes out of range.
;
if(a.(i).lablaxis ne '') then begin
lab=strupcase(a.(i).lablaxis)
endif else begin
lab=strupcase(a.(i).labl_ptr_1)
endelse
if(lab(0) ne '') then begin
if (n_elements(lab) gt 1) then label=lab(k) else label=lab(0)
endif else begin
;
depend1=strupcase(a.(i).depend_1)
; RTB added code 3/98
temp_names=tag_names(a)
z=tagindex(depend1,temp_names)
if(z(0) ne -1) then $
lab_cmd='lab=a.(z(0)).labl_ptr_1' else $
print, depend1, ' not found (ListImage section of LIST_mystruct).'
; lab_cmd='lab=a.'+depend1+'.labl_ptr_1'
if(not execute(lab_cmd)) then print, "ERROR=Error setting lab_cmd"
if(lab(0) eq '') then begin
; RTB 3/98
;lab_cmd='lab=string(a.'+depend1+'.dat(k))'
; JWJ 08/08/2000 - changed below ffo_string() call from a string() call
lab=ffo_string(a.(z(0)).format, a.(z(0)).dat(k))
label=strtrim(lab(0),2)
endif else begin
label=strtrim(lab(k),2)
endelse
endelse
endif
endif
if(n_elements(label) eq 0) then label = ''
; Fill ' ' w/ '_'
;ii = strpos(label,' ')
;if(ii ne -1) then begin
; if(ii eq 0) then begin
; label=strtrim(label,1)
; ii = strpos(label,' ')
; endif
return, label
end
;-------------------------------------------------------------------------------------------------
FUNCTION unit_search,a,sz,i,k
; INPUT: a - data structure
; sz - dimension of a(i) variable. First element of output of size().
; i - index of variable for which we want the unit
; k - index of array element for which we want the unit
;
; OUTPUT: element k of label array for variable a.(i)
;
; Establish error handler
catch, error_status
if(error_status ne 0) then begin
print, 'STATUS= Data cannot be listed.'
print, 'ERROR=Error number: ',error_status,' in listing (unit_search).'
print, 'ERROR=Error Message: ', !ERR_STRING
close, 1
return, -1
endif
;print,'stuff = ',sz,i,k
; RCJ 02/06/2003 Was going to call this var 'unit' but the name is already used: "printf, unit,.."
; so I'm calling it 'units':
units=''
len=size(a.(i).dat)
lent=size(a.(0).dat)
length=lent(lent(0)+2)
if(sz le 1) then begin
if(a.(i).units ne '') then units=a.(i).units else begin
; RCJ 04/18/2003 'units' or 'unit_ptr' are *required* var attributes according to the
; ISTP guidelines but some cdfs come w/ neither of them, so here's a test:
z=tagindex('unit_ptr',tag_names(a.(i)))
if z[0] ne -1 then unts=a.(i).unit_ptr else unts=''
units=unts(k)
endelse
endif
if(sz eq 2) then begin
if(a.(i).var_notes eq 'ListImage') then begin
if(a.(i).units ne '') then units=a.(i).units
endif
if(a.(i).var_notes ne 'ListImage') then begin
;
if(a.(i).units ne '') then begin
unts=a.(i).units
endif else begin
; RCJ 02/25/2004 'units' or 'unit_ptr' are *required* var attributes according to the
; ISTP guidelines but some cdfs come w/ neither of them, so here's the same
; test as above:
z=tagindex('unit_ptr',tag_names(a.(i)))
if z[0] ne -1 then unts=a.(i).unit_ptr else unts=''
;unts=a.(i).unit_ptr
;print,'this is units = ',unts,' and k = ', k
endelse
;for ii=0,n_elements(unts)-1 do print,ii,' &',unts(ii),'&'
;if(unts(0) ne '') then begin
if (n_elements(unts) gt 1) then units=unts(k) else units=unts(0)
;endif
endif
endif
if(n_elements(units) eq 0) then units = ''
return, units
end
;-------------------------------------------------------------------------------------------------
;FUNCTION label_search_max_width,a,sz,i,k
;
;;
;; This function mirrors the function label_search
;; with one difference. This version will, when the
;; label search involves the "dat" array, return the
;; first instance of the widest "string" value from
;; that array.
;;
;; JWJ 07/31/2000
;;
;; Establish error handler
;catch, error_status
;if(error_status ne 0) then begin
; print, 'STATUS= Data cannot be listed.'
; print, 'ERROR=Error number: ',error_status,' in listing (label_search).'
; print, 'ERROR=Error Message: ', !ERR_STRING
; close, 1
; return, -1
;endif
;
;label=''
;len=size(a.(i).dat)
;lent=size(a.(0).dat)
;length=lent(lent(0)+2)
;
;if(sz le 1) then begin
; if(length eq 1 and len(0) eq 1 and len(1) gt 1) then begin
; if(a.(i).lablaxis ne '') then label=strupcase(a.(i).lablaxis) else $
; lab=strupcase(a.(i).labl_ptr_1)
; label=lab(k)
; endif else begin
; if(a.(i).lablaxis eq '') then label=strupcase(a.(i).fieldnam) else $
; label=strupcase(a.(i).lablaxis)
; endelse
;endif
;
;if(sz eq 2) then begin
; if(a.(i).var_notes eq 'ListImage') then begin
; if(a.(i).lablaxis ne '') then label=a.(i).lablaxis else $
; label=a.(i).fieldnam
; endif
; if(a.(i).var_notes ne 'ListImage') then begin
; ;if(a.(i).lablaxis ne '') then label=strupcase(a.(i).lablaxis) ;else begin
; ;lab=strupcase(a.(i).labl_ptr_1)
; ;if(lab(0) ne '') then begin
; ; label=lab(k)
; ;endif else begin
; ;
; ; RCJ 03/28/01 Replaced the above with the code below. It is not
; ; guaranteed that we have labl_ptr_1, and k is sometimes out of range.
; ;
; lab=''
; if(a.(i).lablaxis ne '') then begin
; lab=strupcase(a.(i).lablaxis)
; endif else begin
; lab=strupcase(a.(i).labl_ptr_1)
; endelse
; if(lab(0) ne '') then begin
; if (n_elements(lab) gt 1) then label=lab(k) else label=lab(0)
; endif else begin
; ;
; depend1=strupcase(a.(i).depend_1)
; ; RTB added code 3/98
; temp_names=tag_names(a)
; z=tagindex(depend1,temp_names)
; if(z(0) ne -1) then $
; lab_cmd='lab=a.(z(0)).labl_ptr_1' else $
; print, depend1, ' not found (ListImage section of LIST_mystruct).'
; ; lab_cmd='lab=a.'+depend1+'.labl_ptr_1'
; if(not execute(lab_cmd)) then print, "ERROR=Error setting lab_cmd"
; if(lab(0) eq '') then begin
; ; RTB 3/98
; ;lab_cmd='lab=string(a.'+depend1+'.dat(k))'
;
; ; JWJ 07/31/2000 ; lab_cmd='lab=string(a.(z(0)).dat(k))'
; ; JWJ 07/31/2000 ; wtmp=execute(lab_cmd)
; ; JWJ 07/31/2000 ; if(not wtmp) then print, "ERROR=Error setting lab_cmd 1"
; ; JWJ 07/31/2000 ; label=strtrim(lab(0),2)
;
; ; Loop through "dat" array structure element here, find widest
; ; "string" contained there, and set label to that value. The
; ; first instance of the widest "string" found is the one used
; ; primarily for efficiancy reasons
; ;
; ; JWJ 07/31/2000
; ;
; label = ''
; element_string = ''
; element_width = 0
; max_element_width = 0
; for element = 0, ( n_elements( a.(z(0)).dat ) - 1 ) do begin
;
; ; JWJ 08/08/2000 - changed below ffo_string() call from a string() call
; element_string = strtrim( ffo_string( a.(z(0)).format, a.(z(0)).dat(element) ), 2 )
;
; element_width = strlen( element_string )
; if( element_width gt max_element_width ) then begin
; label = element_string
; max_element_width = element_width
; endif
; ; uncomment the below statement for debugging
; ; print, 'label = "', label, '" element = ', element, $
; ; ', element_string = "', element_string, '"'
; endfor
;
; endif else begin
; label=strtrim(lab(k),2)
; endelse
; endelse
; endif
;endif
;
;if(n_elements(label) eq 0) then label = ''
;
;; Fill ' ' w/ '_'
;;ii = strpos(label,' ')
;;if(ii ne -1) then begin
;; ;if(ii eq 0) then begin
;; ; label=strtrim(label,1)
;; ; ii = strpos(label,' ')
;; ;endif
;; strput,label,'_',ii
;;endif
;
;return, label
;end
;-----------------------------------------------------------------------------------
FUNCTION list_header, a, unit, ntags
; Establish error handler
catch, error_status
if(error_status ne 0) then begin
print, 'STATUS= Data cannot be listed.'
print, 'ERROR=Error number: ',error_status,' in listing (list_header).'
print, 'ERROR=Error Message: ', !ERR_STRING
close, 1
return, -1
endif
status=0
printf, unit, format='(15x,"************************************")'
printf, unit, format='(15x,"**** RECORD VARYING VARIABLES ****")'
printf, unit, format='(15x,"************************************")'
printf, unit, format='(15x)'
ii=0
for i=0L, ntags-5 do begin
if(a.(i).var_type eq 'data') or (a.(i).var_type eq 'support_data') then begin
ii=ii+1
if(n_elements(a.(i).catdesc) eq 0) then begin
printf,unit, format='(i2,". ",a)', ii, a.(i).fieldnam
endif else begin
if(strlen(a.(i).catdesc) eq 0) then begin
printf,unit, format='(i2,". ",a)', ii, a.(i).fieldnam
endif else begin
printf,unit, format='(i2,". ",a)', ii, a.(i).catdesc
endelse
endelse
endif
;if(a.(i).var_notes eq 'ListImage') then begin
if(a.(i).var_notes eq 'ListImage') and $
((a.(i).var_type eq 'data') or (a.(i).var_type eq 'support_data')) then begin
depend1=a.(i).depend_1
depend2=a.(i).depend_2
temp_names=tag_names(a)
; RTB added code 3/98
z=tagindex(depend1,temp_names)
if(z(0) ne -1) then dep1_cmd='dep1=a.(z(0)).dat' else $
print, depend1, ' not found(ListImage section of LIST_mystruct).'
if(z(0) ne -1) then frm1_cmd='frm1=a.(z(0)).format' else $
print, depend1, ' not found (ListImage section of LIST_mystruct).'
; RTB added code 3/98
; RCJ 12/99 changed z -> zz, otherwise energy and angle will have
;the same values when the commands are executed
;
zz=tagindex(depend2,temp_names)
if(zz(0) ne -1) then dep2_cmd='dep2=a.(zz(0)).dat' else $
print, depend2, ' not found (ListImage section of LIST_mystruct).'
if(zz(0) ne -1) then frm2_cmd='frm2=a.(zz(0)).format' else $
print, depend2, ' not found (ListImage section of LIST_mystruct).'
;dep1_cmd='dep1=a.'+depend1+'.dat'
;frm1_cmd='frm1=a.'+depend1+'.format'
;dep2_cmd='dep2=a.'+depend2+'.dat'
;frm2_cmd='frm2=a.'+depend2+'.format'
if(not execute(dep1_cmd)) then print, "ERROR=Error setting dep1"
if(not execute(frm1_cmd)) then print, "ERROR=Error setting frm1"
if(not execute(dep2_cmd)) then print, "ERROR=Error setting dep2"
if(not execute(frm2_cmd)) then print, "ERROR=Error setting frm2"
len1=string(strlen(dep1(0))+1)
len2=string(strlen(dep2(0))+1)
sz1=size(dep1)
sz2=size(dep2)
ln1=strtrim(sz1(sz1(0)+2),2)
ln2=strtrim(sz2(sz2(0)+2),2)
frm1=ln1+'a'+len1
frm2=ln2+'a'+len2
; if(frm1 eq '') then frm1=ln1+'a'
; if(frm2 eq '') then frm2=ln2+'a'
form1='("depend_1 is ",a,": [",'+frm1+',"]")'
form2='("depend_2 is ",a,": [",'+frm2+',"]")'
printf, unit, format=form1, depend1,dep1
printf, unit, format=form2, depend2,dep2
;TJK changed this upon Bob's request since its not an accurate statement...
; printf, unit, format='("Format: [1st depend_1 x M depend_2s, 2nd depend_1 x M depend_2s, ... Nth depend_1 x M depend_2s]")'
printf, unit, format='("Order of values for this variable in each row: values at each depend_1 for the 1st depend_2, values at each depend_1 for the 2nd depend_2, ..., values at each depend_1 for the last depend_2")'
printf,unit,format='(15x)'
endif
endfor ; end i
printf,unit,format='(15x)'
return, status
end
;----------------------------------------------------------------------------------------------
FUNCTION ex_prt, unit, var, var2, slen, k
; Establish error handler
catch, error_status
if(error_status ne 0) then begin
print, 'STATUS = Data cannot be listed.'
print, 'ERROR=Error number: ',error_status,' in listing (ex_prt).'
print, 'ERROR=Error Message: ', !ERR_STRING
close, 1
return, -1
endif
status=0
icnt=0
output=' '
for i=0, slen-1 do begin
ch=strmid(var2,i,1)
if(icnt lt 75) then begin
strput,output,ch,icnt
endif else begin
if(ch eq ' ') then begin
if(k eq 0) then begin
printf, unit, format='(5x,a,5x,a)', var, output
endif else begin
printf, unit, format='(30x,a)', output
endelse
icnt=0
output=' '
endif else strput,output,ch,icnt
endelse
icnt=icnt+1
endfor
if(icnt gt 1) then printf, unit, format='(30x,a)', output
return, status
end
;+
; NAME: wrt_hybd_strct.pro
;
; PURPOSE: Prints ascii file of RV or NRV variables
;
;------------------------------------------------------------------------------------------------
FUNCTION wrt_hybd_strct, a, unit, convar, maxrecs, depend0
; Establish error handler
catch, error_status
if(error_status ne 0) then begin
if(error_status eq -96) then $
print, 'STATUS= This amount of data cannot be listed, please request a shorter time range'
if(error_status eq -133) then $
print, 'STATUS= Incompatible variable types. Select variables separately'
if(error_status eq -124) then $
print, 'STATUS= Temporary memory error. Please try again.' $
else print, 'STATUS= Data cannot be listed'
print, 'ERROR=Error number: ',error_status,' in listing (wrt_hybd_strct).'
print, 'ERROR=Error Message: ', !ERR_STRING
return, -1
endif
status=0
names=strupcase(tag_names(a))
ntags=n_tags(a)
blnk=' '
;print,'convar = ',convar
case convar of
0 : begin
; Check MAXRECS
if(n_elements(num_data) eq 0) then num_data=0
num_data=num_data+ntags
if(num_data gt maxrecs) then begin
dif_rec=num_data-maxrecs
text='The maximum number of records allowed to be listed is '
text1='Your request has exceeded this maximum by '
text2='WARNING: Maxrecs exceeded in Global Attributes; No. Recs. = '
printf, unit, format='(a,i6)',text,maxrecs
printf, unit, format='(a,i6)',text1,dif_rec
printf, unit, format='(a)',blnk
status=1
endif
printf, unit, format='(15x,"************************************")'
printf, unit, format='(15x,"***** GLOBAL ATTRIBUTES ******")'
printf, unit, format='(15x,"************************************")'
printf, unit, format='(15x)'
for i=0, ntags-1 do begin
var=' '
var1=strtrim(names(i),2)
strput,var,var1,0
tstsz=size(a.(i))
if(tstsz(0) eq 0) then begin
var2=strtrim(a.(i),2)
slen=strlen(var2)
if(slen gt 80) then begin
status=ex_prt(unit,var,var2,slen,0)
endif else begin
printf, unit, format='(5x,a,5x,a)', var, var2
endelse
endif else begin
for k=0, tstsz(1)-1 do begin
var2=strtrim(a.(i)(k))
slen=strlen(var2)
if(slen gt 80) then begin
status=ex_prt(unit,var,var2,slen,k)
endif else begin
if(k eq 0) then begin
printf, unit, format='(5x,a,5x,a)', var, var2
endif else begin
printf, unit, format='(30x,a)', var2
endelse
endelse
endfor ; end k
endelse
endfor ; end i
;
if(num_data gt maxrecs) then begin
dif_rec=num_data-maxrecs
text='The maximum number of records allowed to be listed is '
text1='Your request has exceeded this maximum by '
text2='WARNING: Maxrecs exceeded in Global Attributes; No. Recs. = '
printf, unit, format='(a)',blnk
printf, unit, format='(a,i6)',text,maxrecs
printf, unit, format='(a,i6)',text1,dif_rec
status=1
endif
;
printf, unit, format='(15x)'
end ; end case 0
;
; Record Varying Variables
;
1 : begin
; Check MAXRECS
if(n_elements(num_data) eq 0) then num_data=0
; Put in appropriate record count
len=size(a.(0).dat)
length=len(len(0)+2)
num_data=length
; Check for maxrecs begin exceeded
num_data=num_data+4
if(num_data gt maxrecs) then begin
dif_rec=num_data-maxrecs
text='The maximum number of records allowed to be listed is '
text1='Your request has exceeded this maximum by '
printf, unit, format='(a,i6)',text,maxrecs
printf, unit, format='(a,i6)',text1,dif_rec
printf, unit, format='(a)',blnk
status=1
length=maxrecs
endif
status=list_header(a,unit,ntags)
labels=strarr(ntags-3)
units=strarr(ntags-3)
;
for i=0, ntags-5 do begin
if (a.(i).var_type eq 'data') or (a.(i).var_type eq 'support_data') then begin
nvar=a.(i).fillval
labels(i)=label_search(a,1,i,0)
;units(i)=a.(i).units
units(i)=unit_search(a,1,i,0)
; if 'EPOCH' or 'EPOCH92' etc.
if(names(i) eq depend0) then begin
temp=create_struct(names(i),a.(i).dateph(0))
endif else begin
if(nvar eq 0) then begin
temp=create_struct(names(i),a.(i).dat(0))
endif else begin
temp=create_struct(names(i),a.(i).dat(0:nvar))
endelse
endelse
if(i eq 0) then begin
b=temp
endif else begin
b=create_struct(b,temp)
endelse
endif
endfor ; end i
; Free Memory
delete, temp
printf,unit,format=a.lform,labels
printf,unit,format=a.uform,units
;
for j=0L, length-1 do begin
nj=0
for i=0,ntags-5 do begin
if (a.(i).var_type eq 'data') or (a.(i).var_type eq 'support_data') then begin
; temporary patch until nvar included as a new variable attribute
nvar=a.(i).fillval
nvar=nvar(0)
; if(names(i) eq 'EPOCH' or names(i) eq 'EPOCH92') then begin
if(names(i) eq depend0) then begin
b.(i)=a.(i).dateph(j)
endif else begin
if(nvar eq 0) then begin
b.(i)=a.(i).dat(j)
endif else begin
b.(i)=a.(i).dat(0:nvar)
endelse
endelse
endif
endfor ; end i
printf,unit,format=a.dform,b
endfor ; end j
if(num_data gt maxrecs) then begin
dif_rec=num_data-maxrecs
text='The maximum number of records allowed to be listed is '
text1='Your request has exceeded this maximum by '
printf, unit, format='(a)',blnk
; printf, unit, ' '
printf, unit, format='(a,i6)',text,maxrecs
printf, unit, format='(a,i6)',text1,dif_rec
status=1
endif
; Free Memory
delete, b
end ; end case 1
;
; Non-Record Varying Variables
;
2 : begin
; Check MAXRECS
if(n_elements(num_data) eq 0) then num_data=0
; Put in appropriate record count
num_data=num_data+4
if(num_data gt maxrecs) then begin
dif_rec=num_data-maxrecs
text='The maximum number of records allowed to be listed is '
text1='Your request has exceeded this maximum by '
printf, unit, format='(a,i6)',text,maxrecs
printf, unit, format='(a,i6)',text1,dif_rec
printf, unit, format='(a)',blnk
status=1
length=maxrecs
endif
;
printf, unit, format='(15x,"************************************")'
printf, unit, format='(15x,"** NON-RECORD VARYING VARIABLES **")'
printf, unit, format='(15x,"************************************")'
printf, unit, format='(15x)'
end ; end case 2
;
; 2-D Record Varying Variables
;
3 : begin
; Check MAXRECS
if(n_elements(num_data) eq 0) then num_data=0
; Put in appropriate record count
len=size(a.(0).dat)
length=len(len(0)+2)
; Check for maxrecs begin exceeded
num_data=length
num_data=num_data+4
if(num_data gt maxrecs) then begin
dif_rec=num_data-maxrecs
text='The maximum number of records allowed to be listed is '
text1='Your request has exceeded this maximum by '
printf, unit, format='(a,i6)',text,maxrecs
printf, unit, format='(a,i6)',text1,dif_rec
printf, unit, format='(a)',blnk
status=1
length=maxrecs
endif
status=list_header(a,unit,ntags)
num=a.(0).fillval
labels=strarr(num)
units=strarr(num)
dep1_values=''
atags=tag_names(a)
inc=0
for i=0, ntags-5 do begin
;print,'var type = ',a.(i).var_type
if(a.(i).var_type eq 'data') or (a.(i).var_type eq 'support_data') then begin
st_sz=size(a.(i).dat)
;print,'size = ',st_sz
if(st_sz(0) le 1) then begin
; Include condition where only 1 time selected w/ num_var
; length vector
if(st_sz(0) eq 1 and st_sz(1) gt 1 and length eq 1) then begin
num_var=st_sz(1)
for k=0, num_var-1 do begin
labels(inc)=label_search(a,st_sz(0),i,k)
;units(inc)=a.(i).units
units(inc)=unit_search(a,st_sz(0),i,k)
; temp=create_struct(labels(inc),a.(i).dat(k,0))
; temp=create_struct(atags(i)+labels(inc),a.(i).dat(k,0))
unique = strtrim(string(inc), 2)
temp=create_struct(atags(i)+unique,a.(i).dat(k,0))
if(inc eq 0) then begin
b=temp
endif else begin
b=create_struct(b,temp)
endelse
inc=inc+1
endfor ; end k
endif else begin
;print,'2', inc, size(labels)
labels(inc)=label_search(a,st_sz(0),i,0)
;print,'labels(inc) 1 = ',labels(inc)
;units(inc)=a.(i).units
units(inc)=unit_search(a,st_sz(0),i,0)
;print,'units(inc) 1 = ',units(inc)
; names(i) eq 'EPOCH' or 'EPOCH92' etc.
if(names(i) eq depend0) then begin
temp=create_struct(names(i),a.(i).dateph(0))
endif else begin
temp=create_struct(names(i),a.(i).dat(0))
endelse
if(inc eq 0) then begin
b=temp
endif else begin
b=create_struct(b,temp)
endelse
inc=inc+1
endelse
endif ; end st_sz(0) le 1
;
if(st_sz(0) eq 2) then begin
num_var=st_sz(1)
; RCJ 12/02/2003 Commented out the 'if num_var lt 20....'
; It doesn't seem to make sense. Will test.
;if(num_var lt 20) then begin
for k=0, num_var-1 do begin
labels(inc)=label_search(a,st_sz(0),i,k)
;units(inc)=a.(i).units
units(inc)=unit_search(a,st_sz(0),i,k)
; temp=create_struct(labels(inc),a.(i).dat(k,0))
;temp=create_struct(atags(i)+labels(inc),a.(i).dat(k,0))
unique = strtrim(string(inc), 2)
temp=create_struct(atags(i)+unique,a.(i).dat(k,0))
if(inc eq 0) then begin
b=temp
endif else begin
b=create_struct(b,temp)
endelse
; RCJ 05/19/2003 Added the 'if endif else' above because
; we got errors when inc=0: b was undefined.
;b=create_struct(b,temp)
inc=inc+1
endfor
;endif else begin ; condition where # vars >20
;; A large number of variables can exceed allowabel
;; format lengths etc.
;biglab='2_dim'
;;print, biglab
;for k=0,num_var-1 do begin
; labels(inc)=label_search(a,st_sz(0),i,k)
; ;print,'labels(inc) 2 = ',labels(inc)
; ;units(inc)=a.(i).units
; units(inc)=unit_search(a,st_sz(0),i,k)
; ;print,'units(inc) 2 = ',units(inc)
; inc=inc+1
;endfor
;temp=create_struct(atags(i)+biglab,a.(i).dat(*,0))
;b=create_struct(b,temp)
;endelse
; create array of depend_1 values, if they exist, to also be listed
; RCJ 04/01
; exist test is done in dependn_search, if does not exist
; return ''
dep1=dependn_search(a,i,1)
if (dep1(0) ne '') then begin
depend1=a.(i).depend_1
s=execute('dep1_units=a.'+strtrim(depend1,2)+'.units')
dep1=['(@_'+dep1+'_'+dep1_units+')']
dep1_values=[dep1_values,dep1]
endif
endif ; end if st_sz(0) eq 2
endif ; end a.(i).var_type
endfor ; end i
; Free Memory
delete, temp
;
printf,unit,format=a.lform,labels
; listing depend_1 values if they exist. RCJ 04/01
if (n_elements(dep1_values) gt 1) then begin
dep1_values=dep1_values[1:*]
diff=n_elements(labels)-n_elements(dep1_values)
for k=1,diff do begin
cmd='space=string("",format="('+strtrim(strlen(labels(k))+1,2)+'x,a)")
s=execute(cmd)
dep1_values=[space,dep1_values]
endfor
printf,unit,format=a.dpform,dep1_values
endif
printf,unit,format=a.uform,units
;
for j=0L, length-1 do begin
inc=0
for i=0,ntags-5 do begin
if(a.(i).var_type eq 'data') or (a.(i).var_type eq 'support_data') then begin
; 'EPOCH' or 'EPOCH92'
if(names(i) eq depend0) then begin
b.(inc)=a.(i).dateph(j)
inc=inc+1
endif else begin
st_sz=size(a.(i).dat)
if(st_sz(0) le 1) then begin
if(st_sz(0) eq 1 and st_sz(1) gt 1 and length eq 1) then begin
num_var=st_sz(1)
for k=0,num_var-1 do begin
b.(inc)=a.(i).dat(k,j)
inc=inc+1
endfor
endif else begin
b.(inc)=a.(i).dat(j)
inc=inc+1
endelse
endif
if(st_sz(0) eq 2) then begin
num_var=st_sz(1)
; RCJ 12/02/2003 Commented out this 'if num_var lt 20...'
; It doesn't seem to make sense. Will test.
;if(num_var lt 20) then begin
for k=0,num_var-1 do begin
b.(inc)=a.(i).dat(k,j)
inc=inc+1
endfor
;endif else begin
;b.(inc)=a.(i).dat(*,j)
;inc=inc+1 ; RTB added 1/21/99
;endelse
endif
endelse ; end (names(i) ne depend0)
endif ; end a.(i).var_type
endfor ; end i
printf,unit,format=a.dform,b
endfor ; end j
;
if(num_data gt maxrecs) then begin
dif_rec=num_data-maxrecs
text='The maximum number of records allowed to be listed is '
text1='Your request has exceeded this maximum by '
printf, unit, format='(a)',blnk
printf, unit, format='(a,i6)',text,maxrecs
printf, unit, format='(a,i6)',text1,dif_rec
status=1
length=maxrecs
endif
; Free Memory
delete, b
end ; end case 3
;
; 3-D Record Varying Variables
;
4 : begin
; Check MAXRECS
if(n_elements(num_data) eq 0) then num_data=0
; Put in appropriate record count
len=size(a.(0).dat)
length=len(len(0)+2)
; Check for maxrecs begin exceeded
num_data=length
num_data=num_data+4
if(num_data gt maxrecs) then begin
dif_rec=num_data-maxrecs
text='The maximum number of records allowed to be listed is '
text1='Your request has exceeded this maximum by '
printf, unit, format='(a,i6)',text,maxrecs
printf, unit, format='(a,i6)',text1,dif_rec
printf, unit, format='(a)',blnk
; printf, unit, ' '
status=1
length=maxrecs
endif
;
printf, unit, format='(15x,"************************************")'
printf, unit, format='(15x,"**** RECORD VARYING VARIABLES ****")'
printf, unit, format='(15x,"************************************")'
printf, unit, format='(15x)'
printf,unit, format='("1. ",a)', a.epoch.fieldnam
printf,unit, format='("2. ",a)', a.index.catdesc
printf,unit, format='("3. ",a)', a.qflag.catdesc
printf,unit, format='("4. ",a)', a.position.fieldnam
printf,unit, format='("5. ",a)', a.vel.fieldnam
printf,unit,format='(15x)'
;
num=7
labels=strarr(num)
units=strarr(num)
inc=0
; Epoch
eplabel=' '
strput,eplabel,a.epoch.fieldnam,0
labels(inc)=eplabel
units(inc)=a.epoch.units
temp=create_struct('EPOCH',a.epoch.dateph(0))
b=temp
inc=inc+1
; Index
labels(inc)="Index"
units(inc)=''
inc=inc+1
; Qflag
labels(inc)=a.qflag.lablaxis
units(inc)=a.qflag.units
inc=inc+1
; Position
for k=0, 1 do begin
if(k eq 0) then labels(inc)=" geo latitude"
if(k eq 1) then labels(inc)="geo longitude"
units(inc)=a.position.units
inc=inc+1
endfor
for k=0, 1 do begin
if(k eq 0) then labels(inc)=" geo east vel"
if(k eq 1) then labels(inc)="geo north vel"
units(inc)=a.vel.units
inc=inc+1
endfor
;
farr=fltarr(180)
in=0
for l=0,29 do begin
farr(in)=a.index.dat(0)
in=in+1
farr(in)=a.qflag.dat(l,0)
in=in+1
for k=0, 1 do begin
farr(in)= a.position.dat(k,l,0)
in=in+1
endfor
for k=0, 1 do begin
farr(in)= a.vel.dat(k,l,0)
in=in+1
endfor
endfor
temp=create_struct('DATREC',farr)
b=create_struct(b,temp)
;
; Free Memory
delete, temp
printf,unit,format=a.lform,labels
printf,unit,format=a.uform,units
;
for j=0L, length-1 do begin
m=0
b.epoch=a.epoch.dateph(j)
for l=0,29 do begin
b.datrec(m)=a.index.dat(l)
m=m+1
b.datrec(m)=a.qflag.dat(l,j)
m=m+1
for k=0,1 do begin
b.datrec(m)=a.position.dat(k,l,j)
m=m+1
endfor
for k=0,1 do begin
b.datrec(m)=a.vel.dat(k,l,j)
m=m+1
endfor
endfor ; end l
printf,unit,format=a.dform,b
endfor ; end j
;
if(num_data gt maxrecs) then begin
dif_rec=num_data-maxrecs
text='The maximum number of records allowed to be listed is '
text1='Your request has exceeded this maximum by '
printf, unit, format='(a)',blnk
printf, unit, format='(a,i6)',text,maxrecs
printf, unit, format='(a,i6)',text1,dif_rec
status=1
length=maxrecs
endif
; Free Memory
delete, b
end ; end case 4
;
; Image Data
;
5 : begin
; Check MAXRECS
if(n_elements(num_data) eq 0) then num_data=0
; Put in appropriate record count
len=size(a.(0).dat)
length=len(len(0)+2)
; Check for maxrecs begin exceeded
num_data=length
num_data=num_data+4
if(num_data gt maxrecs) then begin
dif_rec=num_data-maxrecs
text='The maximum number of records allowed to be listed is '
text1='Your request has exceeded this maximum by '
printf, unit, format='(a,i6)',text,maxrecs
printf, unit, format='(a,i6)',text1,dif_rec
printf, unit, format='(a)',blnk
; printf, unit, ' '
status=1
length=maxrecs
endif
status=list_header(a,unit,ntags)
num=a.(0).fillval
;labels=strarr(num)
;units=strarr(num)
final_labels=''
final_units=''
final_dep1_values=''
final_dep2_values=''
atags=tag_names(a)
inc=0
for i=0, ntags-5 do begin
;print,'i = ',i,' varname = ',a.(i).varname,' ',a.(i).var_type
if(a.(i).var_type eq 'data') or (a.(i).var_type eq 'support_data') then begin
labels=''
units=''
dep1_values=''
dep2_values=''
st_sz=size(a.(i).dat)
if(st_sz(0) le 1) then begin
; get labels and units:
labels=[labels,label_search(a,st_sz(0),i,0)]
;units=[units,a.(i).units]
units=[units,unit_search(a,st_sz(0),i,0)]
if(names(i) eq depend0) then begin
temp=create_struct(names(i),a.(i).dateph(0))
endif else begin
temp=create_struct(names(i),a.(i).dat(0))
endelse
if(inc eq 0) then begin
b=temp
endif else begin
b=create_struct(b,temp)
endelse
inc=inc+1
endif
if(st_sz(0) eq 2) then begin
; get labels and units:
num_var=st_sz(1)
;if(a.(i).var_notes eq 'ListImage') then begin
; for k=0, num_var-1 do begin
; ;labels(inc)=label_search(a,st_sz(0),i,0)
; ;labels(inc)=label_search(a,st_sz(0),i,k)
; ;units(inc)=a.(i).units
; labels=[labels,label_search(a,st_sz(0),i,k)]
; units=[units,a.(i).units]
; ;temp=create_struct(labels(inc),a.(i).dat(*,0))
; ;temp=create_struct(atags(i)+labels(inc),a.(i).dat(*,0))
; uniq = strtrim(string(inc), 2)
; ;temp=create_struct(atags(i)+uniq,a.(i).dat(*,0))
; temp=create_struct(atags(i)+uniq,a.(i).dat(k,0))
; b=create_struct(b,temp)
; inc=inc+1
; endfor
;endif else begin
for k=0, num_var-1 do begin
labels=[labels,label_search(a,st_sz(0),i,k)]
;units=[units,a.(i).units]
units=[units,unit_search(a,st_sz(0),i,k)]
unique = strtrim(string(inc), 2)
;temp=create_struct(atags(i)+uniq,a.(i).dat(*,0))
; RCJ 04/11/2001 modified the line above. New line is below.
temp=create_struct(atags(i)+unique,a.(i).dat(k,0))
b=create_struct(b,temp)
inc=inc+1
endfor
;endelse
endif ; end st_sz(0) eq 2
; Free Memory
delete, temp
;
labels=labels[1:*]
final_labels=[final_labels,labels]
units=units[1:*]
final_units=[final_units,units]
;
; create array of depend_1 values, if they exist, to also be listed
; RCJ 06/01
; exist test is done in dependn_search, if does not exist
; return ''
dep1=dependn_search(a,i,1)
if (dep1(0) ne '') then begin
depend1=a.(i).depend_1
s=execute('dep1_units=a.'+strtrim(depend1,2)+'.units')
dep1=['(@_'+dep1+'_'+dep1_units+')']
dep1_values=[dep1_values,dep1]
endif
; create array of depend_2 values, if they exist, to also be listed
; RCJ 06/01
; exist test is done in dependn_search, if does not exist
; return ''
dep2=dependn_search(a,i,2)
if (dep2(0) ne '') then begin
depend2=a.(i).depend_2
s=execute('dep2_units=a.'+strtrim(depend2,2)+'.units')
dep2=['(@_'+dep2+'_'+dep2_units+')']
dep2_values=[dep2_values,dep2]
endif
;
; listing depend_1 values if they exist. RCJ 06/01
if (n_elements(dep1_values) gt 1) then begin
tmp_dep1_values=dep1_values[1:*]
while n_elements(dep1_values)-1 le n_elements(labels)-n_elements(tmp_dep1_values) do begin
dep1_values=[dep1_values,tmp_dep1_values]
endwhile
dep1_values=dep1_values[1:*]
final_dep1_values=[final_dep1_values,dep1_values]
endif
; listing depend_2 values if they exist. RCJ 06/01
if (n_elements(dep2_values) gt 1) then begin
tmp_dep2_values=dep2_values[1:*]
if n_elements(tmp_dep2_values) eq n_elements(labels) then begin
;print,'SAME NUMBER OF ELEMENTS!!!!!!'
; RCJ 07/01 If the initial depend_2 is 2D (now stretched into 1D)
; we don't need to do what goes below:
endif else begin
k=0
dep2_values=''
while n_elements(dep2_values)-1 le n_elements(labels)-n_elements(tmp_dep1_values) do begin
for kk=0,n_elements(tmp_dep1_values)-1 do begin
dep2_values=[dep2_values,tmp_dep2_values(k)]
endfor
k=k+1
if k ge n_elements(tmp_dep2_values) then k=0
endwhile
endelse
if n_elements(dep2_values) gt 1 then dep2_values=dep2_values[1:*]
final_dep2_values=[final_dep2_values,dep2_values]
endif
;
;
endif ; end a.(i).var_type
;
endfor ; end i
;
final_labels=final_labels[1:*]
printf,unit,format=a.lform,final_labels
final_units=final_units[1:*] ; but cannot printf the units right now
; If there are depend_1/_2 they come first.
; If there are labels with no corresponding dep1 values,
; then add spaces before the first element of the array.
; This works as long as the labels which *do not have* corresponding dep1
; values come before the labels which *have* corresponding dep1 values.
; If that condition is not true, the logic has to be reworked. RCJ 07/01
if n_elements(final_dep1_values) gt 1 then begin
final_dep1_values=final_dep1_values[1:*]
diff=n_elements(final_labels)-n_elements(final_dep1_values)
for k=1,diff do begin
cmd='space=string("",format="('+strtrim(strlen(final_labels(k))+1,2)+'x,a)")
s=execute(cmd)
final_dep1_values=[space,final_dep1_values]
endfor
printf,unit,format=a.dpform,final_dep1_values
endif
; same for dep2 values:
if n_elements(final_dep2_values) gt 1 then begin
final_dep2_values=final_dep2_values[1:*]
diff=n_elements(final_labels)-n_elements(final_dep2_values)
for k=1,diff do begin
cmd='space=string("",format="('+strtrim(strlen(final_labels(k))+1,2)+'x,a)")
s=execute(cmd)
final_dep2_values=[space,final_dep2_values]
endfor
printf,unit,format=a.dpform,final_dep2_values
endif
;
printf,unit,format=a.uform,final_units
;
for j=0L, length-1 do begin
inc=0
for i=0,ntags-5 do begin
if(a.(i).var_type eq 'data') or (a.(i).var_type eq 'support_data') then begin
; if(names(i) eq 'EPOCH' or names(i) eq 'EPOCH92') then begin
if(names(i) eq depend0) then begin
b.(inc)=a.(i).dateph(j)
inc=inc+1
endif else begin
st_sz=size(a.(i).dat)
if(st_sz(0) eq 1) then begin
b.(inc)=a.(i).dat(j)
inc=inc+1
endif
if(st_sz(0) eq 2) then begin
num_var=st_sz(1)
;if(a.(i).var_notes eq 'ListImage') then begin
; for k=0,num_var-inc-1 do begin
; ;b.(inc)=a.(i).dat(*,j)
; b.(inc)=a.(i).dat(k,j)
; inc=inc+1
; endfor
;endif else begin
for k=0,num_var-1 do begin
b.(inc)=a.(i).dat(k,j)
inc=inc+1
endfor
;endelse
endif
endelse
endif
endfor ; end i
printf,unit,format=a.dform,b
endfor ; end j
;
if(num_data gt maxrecs) then begin
dif_rec=num_data-maxrecs
text='The maximum number of records allowed to be listed is '
text1='Your request has exceeded this maximum by '
printf, unit, format='(a)',blnk
printf, unit, format='(a,i6)',text,maxrecs
printf, unit, format='(a,i6)',text1,dif_rec
status=1
length=maxrecs
endif
; Free Memory
delete, b
end ; end case 5
;
else : begin
print, 'STATUS= A listing of these data cannot be generated. '
print, "ERROR=Error: Invalid control variable; convar= ",convar
close,1
return, -1
end
endcase ; end case convar
return, status
end
;+
; NAME: form_bld.pro
;
; PURPOSE: Builds format statements
;
; shft - 0= left justified field; 1= right justified field
;
FUNCTION form_bld, col_sz, label, units, dat_len, dep_col_sz, depend1_labels, $
dep2_col_sz, depend2_labels, form, shft
; Use column size and to build label, unit and data format statements
;
maxlength=max(strlen(depend1_labels)) > max(strlen(depend2_labels)) > strlen(label)
mintab=fix(dep_col_sz-max(strlen(depend1_labels))) < fix(dep2_col_sz-max(strlen(depend2_labels))) <fix(col_sz-strlen(label))
;
; depend1 and depend2 use the same format (depv) :
ltab=strtrim(mintab,2)
lfld=strtrim(maxlength,2)
if(shft eq 0) then begin
if(ltab ne '0') then depv='A'+lfld+','+ltab+'X,1X,' else depv='A'+lfld+',1X,'
endif else begin
if(ltab ne '0') then depv=ltab+'X,A'+lfld+',1X,' else depv='A'+lfld+',1X,'
endelse
;
if(shft eq 0) then begin
if(ltab ne '0') then labv='A'+lfld+','+ltab+'X,1X,' else labv='A'+lfld+',1X,'
endif else begin
if(ltab ne '0') then labv=ltab+'X,A'+lfld+',1X,' else labv='A'+lfld+',1X,'
endelse
;
col_sz=maxlength > col_sz
utab=strtrim(fix(col_sz-strlen(units)),2)
ufld=strtrim(strlen(units),2)
if(shft eq 0) then begin
if(utab ne '0') then untv='A'+ufld+','+utab+'X,1X,' else untv='A'+ufld+',1X,'
endif else begin
if(utab ne '0') then untv=utab+'X,A'+ufld+',1X,' else untv='A'+ufld+',1X,'
endelse
;
dtab=strtrim(fix(col_sz-dat_len),2)
if(dtab ne '0') then datv=dtab+'X,'+form+',1X,' $
else datv=form+',1X,'
sform=create_struct('labv',labv,'untv',untv,'datv',datv,'depv',depv)
return, sform
end
;+
; NAME: data_len.pro
;
; PURPOSE: Determines the length of the data field given FORMAT, FILLVAL
;
;
FUNCTION data_len,format,fillval
; Set input values if undefined
;
status=0
;if(n_elements(format) eq 0) then form='null' else form=strmid(format,0,1)
;if(strlen(format) eq 0) then form='null' else begin
; RCJ 11/23/05 It has to be G format or fillvals will be ****
if(strlen(format) eq 0) then format='G13.6'
itrip=0
nc=0
new_form=' '
nvar=''
ivar=0
for i=0, strlen(format)-1 do begin
ch=strupcase(strmid(format,i,1))
if(ch ne '(') and (ch ne 'A') and (ch ne 'F') and (ch ne 'P') and $
(ch ne 'I') and (ch ne 'Z') and (ch ne 'G') and (ch ne 'E') then begin
if(ivar eq 0) then nvar=nvar+ch
endif
if(ch eq 'A') or (ch eq 'F') or (ch eq 'I') or (ch eq 'Z') or (ch eq 'G') $
or (ch eq 'E') then begin
form=ch
itrip=1
ivar=1
endif
if(ch eq 'P') then ch=''
if(ch eq ',') or (ch eq ')') then itrip=0
if(itrip eq 1) then begin
strput,new_form,ch,nc
nc=nc+1
endif
endfor ; end i
format=strtrim(new_form,2)
formlen=strlen(format)-1
;endelse
;
case form of
'null' : begin
status=-1
return, status
end
; RCJ 11/23/05 We are setting formats F,E,G to G13.6 (or wider)
; to accomodate possible fillvals in the data
'F' : begin
dat_len = 13.6 > strmid(format,1,formlen)
dat_len = strmid(dat_len,6,4)
end
'E' : begin
dat_len = 13.6 > strmid(format,1,formlen)
dat_len = strmid(dat_len,6,4)
end
'G' : begin
dat_len = 13.6 > strmid(format,1,formlen)
dat_len = strmid(dat_len,6,4)
end
'I' : begin
; Program caused arithmetic error: Floating illegal operand; where?
if(n_elements(fillval) eq 0) then dat_len=strmid(format,1,formlen) else $
dat_len=strlen(strtrim(string(fix(fillval)),2)) > strmid(format,1,3)
end
'A' : begin
;if(n_elements(fillval) eq 0) then dat_len=strmid(format,1,formlen) else $
; dat_len=strlen(strtrim(fillval,2)) > strmid(format,1,3)
if(n_elements(fillval) eq 0) then dat_len=strmid(format,1,formlen) $
else begin
if size(fillval,/tname) eq 'DCOMPLEX' then $
; RCJ 11/2006 This is the case of epoch for themis data
dat_len=strlen(strtrim(real_part(fillval),2)) > strmid(format,1,3) else $
dat_len=strlen(strtrim(fillval,2)) > strmid(format,1,3)
endelse
end
else : begin
dat_len=0
end
endcase
; RCJ 11/23/05 It has to be G format or fillvals will be ****:
if(form eq 'F') or (form eq 'E') then form='G'
if(nvar ne '') then begin
format=nvar+form+strtrim(dat_len,2)
dat_len=fix(nvar)*fix(dat_len)
nvar=fix(nvar)-1
endif else begin
format=form+strtrim(dat_len,2)
dat_len=fix(dat_len)
nvar=0
endelse
frm_st=create_struct('status',status, 'form',format, 'dat_len',dat_len, $
'nvar',nvar)
return, frm_st
end
function ep_conv, b, depd0, HANDLE=handle
;
catch, error_status
if(error_status ne 0) then begin
if(error_status eq -78) then $
print, 'STATUS=Available memory exceeded. Re-select time interval.'
print, 'ERROR=Error number: ',error_status,' in listing (ep_conv).'
print, 'ERROR=Error Message: ', !ERR_STRING
stop
endif
;
tagnames=tag_names(b)
v1=tagindex(depd0,tagnames)
if(n_elements(handle) eq 0) then handle=0
; x1='b.'+strtrim(depd0,2)+'.units="dd-mm-yyyy hh:mm:ss.ms "'
b.(v1(0)).units="dd-mm-yyyy hh:mm:ss.ms "
; if(not execute(x1)) then begin
; print, 'ERROR=Execute error setting x1'
; close,1
; return, -1
; endif
; b.epoch.units="dd-mm-yyyy hh:mm:ss.ms "
if(handle eq 0) then begin
dat=b.(v1(0)).dat
; x2=execute('dat=b.'+strtrim(depd0,2)+'.dat')
; dat=b.epoch.dat
datsz=size(dat)
if(datsz(0) gt 0) then dat=reform(dat)
endif else begin
;x3=execute('tmp=b.'+strtrim(depd0,2)+'.HANDLE')
tmp=b.(v1(0)).HANDLE
handle_value, tmp, dat
datsz=size(dat)
if(datsz(0) gt 0) then dat=reform(dat)
endelse
len=size(dat)
length=long(len(len(0)+2))
dat_eph=strarr(length)
for k=0L, length-1 do begin
CDF_EPOCH,dat(k), yr, mo, dy, hr, mn, sc, milli, /break
if(dy lt 10) then dy= '0'+strtrim(dy,2) else dy=strtrim(dy,2)
if(mo lt 10) then mo= '0'+strtrim(mo,2) else mo=strtrim(mo,2)
if(hr lt 10) then hr= '0'+strtrim(hr,2) else hr=strtrim(hr,2)
if(mn lt 10) then mn= '0'+strtrim(mn,2) else mn=strtrim(mn,2)
if(sc lt 10) then sc= '0'+strtrim(sc,2) else sc=strtrim(sc,2)
milli=strmid(strtrim(float(milli)/1000.,2),2,3)
yr=strtrim(yr,2)
dat_eph(k)=dy+'-'+mo+'-'+yr+' '+hr+':'+mn+':'+sc+'.'+milli
endfor
eptmp=create_struct('DATEPH',dat_eph)
return, eptmp
;
end
;+
; NAME: LIST_mystruct.pro
;
; PURPOSE: Generates a list output for CDAWweb
;
; CALLING SEQUENCE:
;
; FUNCTION LIST_mystruct, a,NOGATT=nogatt,NOVATT=novatt,NORV=norv,$
; NONRV=nonrv,NO2DRV=no2drv,FILENAME=filename,$
; TSTART=TSTART,TSTOP=TSTOP,MAXRECS=maxrecs
;
; VARIABLES:
;
; Input:
;
; a - an IDL structure
;
; Keyword Parameters:
;
; nogatt - Global attributes output: =0 (print), =1 (no print)
; novatt - Variable attributes output: =0 (print), =1 (no print)
; norv - Record varying output: =0 (print), =1 (no print)
; nonrv - Non record varying output: =0 (print), =1 (no print)
; no2drv - 2D record varying output: =0 (print), =1 (no print)
; filename - Output filename
; maxrecs - Maximum record output
;
; REQUIRED PROCEDURES:
;
; HISTORY
;
; Initial version:
;
; 1.0 R. Baldwin HSTX 2/9/96
;
;-------------------------------------------------------------------
;
FUNCTION LIST_mystruct, a,NOGATT=nogatt,NOVATT=novatt,NORV=norv,$
NONRV=nonrv,NO2DRV=no2drv,FILENAME=filename,$
TSTART=TSTART,TSTOP=TSTOP,MAXRECS=maxrecs,$
REPORT=REPORT,STATUS=STATUS,DEBUG=DEBUG
;
; Set input values if undefined
;
;TJK 5/18/00 - Modified to allow 100,000 records to be listed - greatly
;increased from 30,000 - might have to back this off some should we start
;to see performance impacts.
;
status=0
reportflag = 0
if(n_elements(nogatt) eq 0) then nogatt=0
if(n_elements(novatt) eq 0) then novatt=0
if(n_elements(norv) eq 0) then norv=1
if(n_elements(nonrv) eq 0) then nonrv=1
if(n_elements(no2drv) eq 0) then no2drv=1
if(n_elements(no3drv) eq 0) then no3drv=1
if(n_elements(noimg) eq 0) then noimg=1
if(n_elements(filename) eq 0) then filename='cdaweb_listing.asc'
;if(n_elements(maxrecs) eq 0) then maxrecs=150000 ;TJK changed from 30000
if(n_elements(maxrecs) eq 0) then maxrecs=15000000 ;TJK changed from 150000 for testing on new machine
;if(n_elements(maxrecs) eq 0) then maxrecs=100000 ;TJK changed from 30000
; REPORT and reportflag no longer used;
if(n_elements(REPORT) eq 0) then report=''
; statusflag not implemented yet!
if(n_elements(STATUS) eq 0) then statusflag=1L else statusflag=0L
if(n_elements(DEBUG) eq 0) then debugflag=1L else debugflag=0L
; Establish error handler
;catch, error_status
;if(error_status ne 0) then begin
; print, 'ERROR=Error number: ',error_status,' in listing (LIST_mystruct).'
; print, 'ERROR=Error Message: ', !ERR_STRING
; if(error_status eq -98) then begin
; if reportflag then printf, 1, 'STATUS=Data space too large. Cannot currently list these data.'
; print, 'STATUS=Data space too large. Cannot currently list these data.'
; endif else begin
; if reportflag then printf, 1, 'STATUS= Data cannot be listed. '
; print, 'STATUS=Data cannot be listed. '
; endelse
; close,1
; return, -1
;endif
; Open report file
if(REPORT) then begin
openw, 1, REPORT, error=err
if(err ne 0) then begin
print, "ERROR=",!ERR_STRING
close, 1 & return, -1
endif
reportFlag = 1
endif
if(keyword_set(DEBUG)) then print, 'Opening output file=', filename
;
; Open output file
;
openw, unit, filename, /get_lun,error=err,width=1000
if(n_elements(a) eq 0) then begin
if reportflag then printf, 1, 'STATUS= Data cannot be listed.'
print, 'STATUS=Data cannot be listed.'
print, 'ERROR=Error: Undefined structure'
close, 1
return, -1
endif
; Add Code to trap a=-1 bad structures RTB
str_tst=size(a)
if(str_tst(str_tst(0)+1) ne 8) then begin
v_data='DATASET=UNDEFINED'
v_err='ERROR=Input is not a stucture.'
v_stat='STATUS=Cannot list this data'
; a=crate_struct('DATASET',v_data,'ERROR',v_err,'STATUS',v_stat)
print, v_data
print, v_err
print, v_stat
return, 0
endif else begin
; Test for errors trapped in read_myCDF
atags=tag_names(a)
rflag=tagindex('DATASET',atags)
if(rflag(0) ne -1) then begin
print, a.DATASET
; print, a.ERROR 1/97 read_myCDF change
print, a.STATUS
return, 0
endif
;
; RCJ 06/09/2004. Testing number of columns. Large images
; yield more than 32767. columns and IDL will not print
; that much (and it will take a looong time to process).
; This test had to be done here, before 'LISTING=' because parse.ph
; will register a 'system error' if there is a filename but nothing
; is listed.
for i=0,n_elements(atags)-1 do begin
if strupcase(a.(i).var_type) eq 'DATA' or $
strupcase(a.(i).var_type) eq 'SUPPORT_DATA' then begin
aatags=tag_names(a.(i))
q=where(aatags eq 'HANDLE')
if q[0] ne -1 then handle_value,a.(i).handle,testarr $
else testarr=a.(i).dat
sz=size(testarr)
if sz[0] eq 3 then begin
if sz[1]*sz[2] gt 32767. then begin
a.(i).var_type = 'ignore_data'
print,'STATUS=3D array too big. Will not list.'
endif
endif
endif
endfor
;
;
; There's nothing to list unless at least one of the variables is var_type=data
; reuse variable rflag: RCJ 09/16/02
rflag=''
for i=0,n_elements(atags)-1 do rflag=[rflag,a.(i).var_type]
q=where(strupcase(rflag) eq 'DATA')
if q(0) eq -1 then return,0
endelse
; Write DATASET=
data_set=''
if(data_set eq '') then begin
; RCJ 03/13/2003 Some datasets are larger than 9 characters.
; Using strsplit to separate the string at the '_' and rejoin the dataset name only.
;data_set=strmid(a.(0).LOGICAL_FILE_ID,0,9)
s=strsplit(a.(0).LOGICAL_FILE_ID,'_',/extract)
data_set=s[0]+'_'
for i=1,n_elements(s)-4 do begin
data_set=data_set+s[i]+'_'
endfor
data_set=strupcase(data_set+s[n_elements(s)-3])
;data_set=strupcase(data_set[0]+'_'+data_set[1]+'_'+data_set[2])
endif
if(data_set eq '') then begin
data_set=strtrim(a.(0).LOGICAL_SOURCE,2)
data_set=strupcase(data_set)
endif
if reportflag then printf, 1, 'DATASET=',data_set
print, 'DATASET=',data_set
; Write file name to REPORT file
if reportflag then printf, 1, 'LISTING=',filename
print, 'LISTING=',filename
;
; Reform dat arrays w/in structure.
;
if(keyword_set(DEBUG)) then print, 'Reform arrays w/in structure.'
a=reform_strc(a)
;
; Separate variables by their depend_0; build mega-structure
;
mega=parse_mydepend0(a)
depends=tag_names(mega)
for mega_loop=1, mega.num do begin
a=mega.(mega_loop)
depend0=depends(mega_loop)
if(depend0 eq ' ') then continue
;
; Determine Global and variable attribute structures for listing
;
ns_tags=n_tags(a)
namest=strupcase(tag_names(a))
; Determine location of Epoch variable
if(keyword_set(DEBUG)) then print, 'Find DEPEND_0'
incep=-1
incep=where(namest eq depend0,w)
; Remove any nasty variables
v1=tagindex(depend0,namest)
if(v1(0) ne -1) then begin
; x1=execute('station=a.'+strtrim(depend0,2)+'.source_name')
station=a.(v1(0)).source_name
station=strmid(station,0,4)
v1=tagindex('delay_time',namest)
;if((station eq "ISIS") and (v1(0) ne -1)) then a.DELAY_TIME.var_type="metadata"
if (((station eq "ISIS")or(station eq "ALOU")) and (v1(0) ne -1)) then a.DELAY_TIME.var_type="metadata"
endif else begin
print, 'ERROR= Tag name not found'
return, -1
endelse
; No record varying attribute found
incep=incep(0)
if(incep eq -1) then begin
if reportflag then printf, 1, 'STATUS= Data cannot be listed. '
print, 'STATUS= Data cannot be listed. '
print, 'ERROR=Error: No record varying data selected'
close, 1
return, -1
endif
; Create new structure w/ data (w/o handle) and determine size of Data array
; Epoch or depend_0 will be the first variable processed
if(keyword_set(DEBUG)) then print, 'Converting handles; Compute size;',$
' Build new structure.'
names=tag_names(a.(incep))
ntags=n_tags(a.(incep))
; Check to see if HANDLE a tag name
wh=where(names eq 'HANDLE',whn)
if(whn) then begin
handle_value, a.(incep).HANDLE, dat
datsz=size(dat)
if(datsz(0) gt 0) then dat=reform(dat)
; Convert Epoch info. to string
; 'EPOCH' or 'EPOCH92' etc.
if(namest(incep) eq depend0) then begin
eptmp=ep_conv(a,depend0,/handle)
temp=create_struct('DAT',dat)
temp1=create_struct(a.(incep),temp)
temp2=create_struct(temp1,eptmp)
b=create_struct(namest(incep),temp2)
endif else begin
temp=create_struct('DAT',dat)
temp1=create_struct(a.(incep),temp)
b=create_struct(namest(incep),temp1)
endelse
;
endif else begin
; Convert Epoch info. to string
; 'EPOCH' or 'EPOCH92' etc.
if(namest(incep) eq depend0) then begin
eptmp=ep_conv(a,depend0)
tmp=create_struct(a.(incep),eptmp)
b=create_struct(namest(incep),tmp)
endif else begin
b=create_struct(namest(incep),a.(incep))
endelse
endelse
vorder=intarr(ns_tags)
for k=0, ns_tags-1 do begin
if(k ne incep) then begin
names=tag_names(a.(k))
ntags=n_tags(a.(k))
whc=where(names eq 'HANDLE',whn)
if(whn) then begin
handle_value, a.(k).HANDLE, dat
datsz=size(dat)
if(datsz(0) gt 0) then dat=reform(dat)
temp=create_struct('DAT',dat)
temp1=create_struct(a.(k),temp)
temp2=create_struct(namest(k),temp1)
b=create_struct(b,temp2)
endif else begin
temp=create_struct(namest(k),a.(k))
b=create_struct(b,temp)
endelse
endif
st_sz=size(b.(k).DAT)
vorder(k)=st_sz(0)
endfor ; end k
; Free Memory
delete, a
delete, temp
delete, temp1
delete, temp2
delete, tmp
;
if(keyword_set(DEBUG)) then print, 'Determine type of listing.'
; Determine type of listing
plist=max(vorder)
;TJK change to 1st variable since not all CDF's have a time variable called
;"EPOCH" if(plist eq 3) then station=strmid(b.epoch.source_name,0,4)
if(plist eq 3) then station=strmid(b.(0).source_name,0,4)
;
if(plist eq 0) then begin
norv=1 & no2drv=1 & nonrv=1 & no3drv=1 & noimg=1
endif
if(plist eq 1) then begin
norv=0 & no2drv=1 & nonrv=1 & no3drv=1 & noimg=1
endif
if(plist eq 2) then begin
norv=1 & no2drv=0 & nonrv=1 & no3drv=1 & noimg=1
endif
if(plist eq 3) then begin
if(station ne "DARN") then begin
norv=1 & no2drv=1 & nonrv=1 & no3drv=1 & noimg=0
endif else begin
norv=1 & no2drv=1 & nonrv=1 & no3drv=0 & noimg=1
endelse
endif
if(plist gt 3) then begin
if reportflag then printf, 1, 'STATUS= Data of 3D or less can be listed. Re-select variables'
print, 'STATUS= Data of 3D or less can be listed. Re-select variables'
close, 1
return, -1
endif
; Reorder structue
b_tagnames=tag_names(b)
v1=tagindex(depend0,b_tagnames)
if(v1(0) eq -1) then begin
print, 'ERROR= No tag found for DEPEND0'
return, -1
endif
epsz=size(b.(v1(0)).dat)
;x1=execute('epsz=size(b.'+depend0+'.dat)')
if(epsz(0) eq 0) then b=ord_mystruct(b,vorder,0) else $
b=ord_mystruct(b,vorder,1)
; Reform Image 3D data arrays
if(noimg eq 0 and keyword_set(DEBUG)) then print, 'Reform 3D Image arrays.'
if(noimg eq 0) then b=reform_mystruct(b)
; Set/Convert tstart and tstop
if(keyword_set(DEBUG)) then print, 'Set/Convert tstart and tstop.'
tmpoch=b.(v1(0)).dat
;x1=execute('tmpoch=b.'+strtrim(depend0,2)+'.dat')
leng=n_elements(tmpoch)
if((n_elements(TSTART) eq 0) or (n_elements(TSTOP) eq 0)) then begin
if(leng gt 1) then begin
TSTART=tmpoch(0)
TSTOP=tmpoch(leng-1)
endif else begin
tmp=tmpoch
tmpoch=fltarr(1)
tmpoch(0)=tmp
TSTART=tmpoch(0)
TSTOP=tmpoch(0)
endelse
endif
; Set time constraints
start_time = 0.0D0 ; initialize
stop_time = 0.0D0 ; initialize
if keyword_set(TSTART) then begin ; determine datatype and process if needed
b1 = size(TSTART) & c1 = n_elements(b1)
case (b1(c1-2)) of
5: start_time=tstart ; double float
9: start_time=tstart ; dcomplex
7: begin ; string
if (size(tstart,/tname) eq 'DCOMPLEX') then $
start_time=encode_cdfepoch(tstart,/epoch16) else $
start_time=encode_cdfepoch(tstart)
end
else: begin
print,'ERROR=TSTART parameter must be STRING, DOUBLE or DCOMPLEX' & close, 1
return,-1
end
endcase
; RCJ 11/2006 Replaced w/ code above, extending capability to complex values
;if (b1(c1-2) eq 5) then start_time = TSTART $ ; double float already
; else if (b1(c1-2) eq 7) then start_time = encode_cdfepoch(TSTART) $ ; string
;else begin
; print,'ERROR=TSTART parameter must be STRING or DOUBLE' & close, 1
; return,-1
;endelse
endif
if keyword_set(TSTOP) then begin ; determine datatype and process if needed
b1 = size(TSTOP) & c1 = n_elements(b1)
case (b1(c1-2)) of
5: stop_time=tstop ; double float
9: stop_time=tstop ; dcomplex
7: begin ;string
if (size(tstop,/tname) eq 'DCOMPLEX') then $
stop_time=encode_cdfepoch(tstop,/epoch16) else $
stop_time=encode_cdfepoch(tstop)
end
else: begin
print,'ERROR=TSTOP parameter must be STRING, DOUBLE or DCOMPLEX' & close, 1
return,-1
end
endcase
; RCJ 11/2006 Replaced w/ code above, extending capability to complex values
;if (b1(c1-2) eq 5) then stop_time = TSTOP $ ; double float already
; else if (b1(c1-2) eq 7) then stop_time = encode_cdfepoch(TSTOP) $ ; string
;else begin
; print,'ERROR=TSTOP parameter must be STRING or DOUBLE' & close, 1
; return,-1
;endelse
endif
; Restrict long listings giving user some information to gage their
; work
time_dif=stop_time-start_time
time_dif=time_dif/(86400.*1000.)
tnum=n_elements(tmpoch)-1
; Try a more accurate method for determining time interval
;dif_ep=tmpoch(1)-tmpoch(0)
if(tnum gt 100) then begin
idcs=findgen(99)
idct=findgen(99)+1
difs=tmpoch(idct)-tmpoch(idcs)
mnval=min(difs)
mxval=max(difs)
if(mnval ne mxval) then begin
dif_ep=moment(difs)
endif else begin
;dif_ep=fltarr(1)
; Input to cdf_epoch has to be double:
dif_ep=dblarr(1)
dif_ep(0)=difs(0)
endelse
cdf_epoch,dif_ep(0),y1,mo1,d1,h1,m1,s1,mi1,/break
; cdf_epoch,dif_ep,y1,mo1,d1,h1,m1,s1,mi1,/break
deltime=strtrim(h1,2)+':'+strtrim(m1,2)+':'+strtrim(s1,2)+'.'+strtrim(mi1,2)
endif
;TJK 8/30/2004 - add code to determine the number of columns of data being requested -
;and kick out on that, in addition to the number of records (below).
;TJK 9/21/2004 - find the depend_1 and depend_2 variables and then look at their sizes
; in order to determine the actual number of columns of data requested
for vars = 0, n_tags(b)-1 do begin
dep1=dependn_search(b,vars,1)
if (dep1(0) ne '') then begin
depend1 = b.(vars).depend_1
if (n_elements(dep1_values) eq 0) then dep1_values = depend1 else $
dep1_values=[dep1_values,depend1]
endif
dep2=dependn_search(b,vars,2)
if (dep2(0) ne '') then begin
depend2 = b.(vars).depend_2
if (n_elements(dep2_values) eq 0) then dep2_values = depend2 else $
dep2_values=[dep2_values,depend2]
endif
endfor
;sort and uniq the arrays to get rid of duplicates
if (n_elements(dep1_values) gt 0) then begin
dep1_idx = uniq(dep1_values,sort(dep1_values))
dep1_values = dep1_values(dep1_idx)
endif
if (n_elements(dep2_values) gt 0) then begin
dep2_idx = uniq(dep2_values,sort(dep2_values))
dep2_values = dep2_values(dep2_idx)
; print, 'DEBUG - dep1_values = ',dep1_values, 'dep2_values = ',dep2_values
endif
cols = 0 & d1cols = 0 & d2cols = 0
b_tagnames=tag_names(b)
;Find the number of records
idx = tagindex(depend0,b_tagnames)
var_size = size(b.(idx).dat)
n_recs = var_size(1)
for vars = 0, n_elements(dep1_values)-1 do begin
var_idx = tagindex(dep1_values(vars),b_tagnames)
if (var_idx ge 0) then begin
var_size = size(b.(var_idx).dat)
if (strupcase(b.(var_idx).var_type) eq 'SUPPORT_DATA') then begin
; print, 'support varname and size = ',b.(var_idx).varname, var_size
if (var_size(0) eq 1) then d1cols = d1cols + var_size(1) ; support data like rows and
; columns for an image variable
if (var_size(0) eq 2) then d1cols = d1cols+ var_size(1) ;spectrogram type vars.
endif
endif
; print, 'DEBUG DEP1 Cols = ',d1cols
endfor
for vars = 0, n_elements(dep2_values)-1 do begin
var_idx = tagindex(dep2_values(vars),b_tagnames)
if (var_idx ge 0) then begin
var_size = size(b.(var_idx).dat)
if (strupcase(b.(var_idx).var_type) eq 'SUPPORT_DATA') then begin
; print, 'support varname and size = ',b.(var_idx).varname, var_size
if (var_size(0) eq 1) then d2cols = d2cols + var_size(1) ; support data like rows and
; columns for an image variable
if (var_size(0) eq 2) then d2cols = d2cols+ var_size(1) ;spectrogram type vars.
endif
endif
; print, 'DEBUG DEP2 Cols = ',d2cols
endfor
cols = d1cols + d2cols
if (cols eq 0) then begin ;have to look at the data variables to decide # cols
; print, 'TJK DEBUG - No depend1 or depend2 values, so looking at the data vars to determine cols'
for vars = 0, n_elements(b_tagnames)-1 do begin
if (strupcase(b.(vars).var_type) eq 'DATA') then begin
var_size = size(b.(vars).dat)
; print, 'data varname and size = ',b.(vars).varname, var_size
if (var_size(0) eq 1) then cols = cols+ 1 ;regular DATA variable - scalar
if (var_size(0) eq 2 and var_size(1) lt 10) then cols = cols+ var_size(1) ;vectors
endif
; print, 'DEBUG DATA Cols = ',cols
endfor
endif
;print, 'DEBUG - Number of columns requested = ',cols, 'number of records = ',n_recs
;TJK 9/2/2004 - change the logic to check for a large number of columns AND a large number of records
;print a different message, depending on whichever is too large for listing to handle
stars = '******************'
if((n_recs gt 15000000 and cols gt 6) or n_recs gt 16000000) then begin ;larger than this takes 30+ min. to generate.
status = 'WARNING: You have requested '+strtrim(string(n_recs),2)+' records of data, the limit is 15,000,000, please reduce the time range and resubmit.'
printf, unit, stars
printf, unit, format='(a)',status
printf, unit, stars
; Continue to get listing of Global Attributes
nogatt=0 & norv=1 & nonrv=1 & no2drv=1 & no3drv=1 & noimg=1
; print, 'STATUS= ',status
; return, 0
endif
if((cols gt 100 and n_recs gt 10000) or $
(d1cols gt 40 and d2cols gt 40))then begin
status = 'WARNING: Cannot list this type of data, at least one of the variables that you have selected requires too many columns.'
printf, unit, stars
printf, unit, format='(a)',status
printf, unit, stars
; Continue to get listing of Global Attributes
nogatt=0 & norv=1 & nonrv=1 & no2drv=1 & no3drv=1 & noimg=1
; print, 'STATUS= ',status
; return, 0
endif
; Determine indices of epoch.dat that are within the tstart and tstop
;tind=where((b.epoch.dat ge start_time) and (b.epoch.dat le stop_time),w)
; RCJ 11/2006 Cannot do 'where' when complex numbers are introduced.
; Have to use cdf_epoch_compare.
;tind=where((tmpoch ge start_time) and (tmpoch le stop_time),w)
if (size(tmpoch,/tname) eq 'DCOMPLEX')then begin
tind = lonarr(n_elements(tmpoch))
for i = 0L, n_elements(tmpoch)-1 do begin
tind(i) = ((cdf_epoch_compare(stop_time, tmpoch(i)) ge 0) and $
(cdf_epoch_compare(tmpoch(i), start_time) ge 0))
;cdf_epoch_compare returns 0 for equal
;value and 1 for greater than
endfor
tind = where(tind eq 1,w)
endif else begin
;original code for regular tmpoch value
tind=where((tmpoch ge start_time) and (tmpoch le stop_time),w)
endelse
if(tind(0) eq -1) then begin
; Continue to get listing of Global Attributes
warning=' WARNING: No Data Selected for this Time Period. '
printf, unit, format='(a)',warning
; printf, unit, ' WARNING: No Data Selected for this Time Period. '
nogatt=0 & norv=1 & nonrv=1 & no2drv=1 & no3drv=1 & noimg=1
c=b
; print, 'ERROR= No Data Selected for this Time Period. '
; status=-1
; return, status
endif
;
; temporary fix for 1 time choosen for a N dim arrays
if(w eq 1) then begin
warning=' WARNING: Increase time period selected for listing. '
printf, unit, '******************************************************* '
printf, unit, format='(a)',warning
printf, unit, '******************************************************* '
printf, unit, ' '
w=0
nogatt=0 & norv=1 & nonrv=1 & no2drv=1 & no3drv=1 & noimg=1
c=b
endif
itrip=0
irv=0
inrv=0
lab_for='('
unt_for='('
dat_for='('
dep_for='('
ns_tags=n_tags(b)
namest=tag_names(b)
;
; Apply time constraints to data structure
if keyword_set(DEBUG) then print,'Apply time constraints to data structure.'
if(w gt 0) then begin
for i=0, ns_tags-1 do begin
ntags=n_tags(b.(i))
names=tag_names(b.(i))
st_sz=size(b.(i).dat)
; if(namest(i) eq "EPOCH" or namest(i) eq "EPOCH92") then begin
if(namest(i) eq depend0) then begin
temp_dat=b.(i).dateph(tind)
temp_dat1=b.(i).dat(tind)
tmp=create_struct('DATEPH',temp_dat)
tmp1=create_struct('DAT',temp_dat1)
for l=0, ntags-1 do begin
if((names(l) eq "DAT") or (names(l) eq "DATEPH")) then begin
if(names(l) eq "DAT") then tmpt=create_struct(tmpt,tmp1)
if(names(l) eq "DATEPH") then tmpt=create_struct(tmpt,tmp)
endif else begin
if(l eq 0) then tmpt=create_struct(names(l),b.(i).(l)) else begin $
tmpt1=create_struct(names(l),b.(i).(l))
tmpt=create_struct(tmpt,tmpt1)
endelse
endelse
endfor
ctmp=create_struct(namest(i),tmpt)
if(i eq 0) then c=ctmp else c=create_struct(c,ctmp)
endif else begin
if(b.(i).var_type eq 'data') then begin
if(st_sz(0) eq 1) then temp_dat1=b.(i).dat(tind)
if(st_sz(0) eq 2) then temp_dat1=b.(i).dat(*,tind)
if(st_sz(0) eq 3) then temp_dat1=b.(i).dat(*,*,tind)
endif else begin
temp_dat1=b.(i).dat
endelse
tmp1=create_struct('DAT',temp_dat1)
for l=0, ntags-1 do begin
if(names(l) ne "DAT") then begin
if(l eq 0) then tmpt=create_struct(names(l),b.(i).(l)) else begin $
tmpt1=create_struct(names(l),b.(i).(l))
tmpt=create_struct(tmpt,tmpt1)
endelse
endif else begin
tmpt=create_struct(tmpt,tmp1)
endelse
endfor ; end l
ctmp=create_struct(namest(i),tmpt)
if(i eq 0) then c=ctmp else c=create_struct(c,ctmp)
endelse ; end if (namest(i) ne depend0)
endfor ; end i
endif ; end if (w gt 0)
; Free Memory
delete, ctmp
delete, tmp1
delete, tmpt
delete, tmpt1
delete, tmp
delete, b
;
nvar=0
for i=0,ns_tags-1 do begin
j=0
ntags=n_tags(c.(i))
names=tag_names(c.(i))
shft=1
; 'EPOCH' or 'EPOCH92' etc.
if(namest(i) eq depend0) then shft=0
;if(c.(i).var_notes eq 'ListImage') then shft=0
; Build Global Structure
if keyword_set(DEBUG) then print,'Build Global Structure.'
while (itrip eq 0) and (j lt ntags) do begin
j=j+1
nc=j
if(names(j) eq 'FIELDNAM') then begin
itrip=1
endif else begin
pair=create_struct(names(j),c.(i).(j))
if(j eq 1) then begin
glbatt=create_struct(pair)
endif else begin
glbatt=create_struct(glbatt,pair)
endelse
endelse
endwhile
; End Global Structure
; Determine Format type and data width
if keyword_set(DEBUG) then print,'Determine Format type and data width.'
form='' ; Default field
; 'EPOCH' or 'EPOCH92' etc.
if(namest(i) eq depend0) then format='A23' else format=c.(i).format
if(c.(i).var_type eq 'data') or $
; the line below will allow support_data that is not a depend_1 or 2 variable to be listed.
; I'm assuming depend_1 or 2 variables do not have depend_0=Epoch
; RCJ 10/28/2002
;((c.(i).var_type eq 'support_data') and (strupcase(c.(i).depend_0) eq depend0)) or $
; (strupcase(c.(i).VARNAME) eq depend0) then begin
; RCJ 11/12/2003 Sometimes depend_1 or 2 do have depend_0=Epoch (see
; i8_h0_gme var Proton_DIntn2. This seems to be a better test:
((c.(i).var_type eq 'support_data') and $
(c.(i).cdfrecvary ne 'NOVARY')) then begin
frm_st=data_len(format,c.(i).fillval)
status=frm_st.status
if( status ne 0) then begin
if reportflag then printf, 1, 'STATUS= Data cannot be listed. '
print, 'STATUS= Data cannot be listed. '
print, 'ERROR=Error: In function data_len'
close, 1
return, -1
endif
dat_len=frm_st.dat_len
form=frm_st.form
; patch
c.(i).fillval=frm_st.nvar
endif
; For now replace fillval w/ nvar (number of elements of a variable)
; else rebuild the structure w/ nvar attributes appended to each variable
; RTB 3/96
; Set record varying formats
if(form ne '') then begin
;print,'^^^ ',nogatt,norv,nonrv,no2drv,no3drv,noimg
if(norv eq 0) then begin
; if(c.(i).lablaxis eq '') then label=c.(i).fieldnam else $
; label=c.(i).lablaxis
label=label_search(c,1,i,0)
units=unit_search(c,1,i,0)
;col_sz=strlen(label) > strlen(c.(i).units) > dat_len
col_sz=strlen(label) > strlen(units) > dat_len
; the second set of "col_sz, label" input will be used to define the format
; dep_for. This input changes when we have variables w/ depend_1 attribute.
; RCJ 04/01
;sform=form_bld(col_sz, label, c.(i).units, dat_len, col_sz, label, col_sz, label,form, shft)
sform=form_bld(col_sz, label, units, dat_len, col_sz, label, col_sz, label,form, shft)
lab_for=lab_for + sform.labv
unt_for=unt_for + sform.untv
dat_for=dat_for + sform.datv
dep_for=dep_for + sform.depv
endif
; Determine formats for 2D-RV
if(no2drv eq 0) then begin
if keyword_set(DEBUG) then print,'Determine formats for 2D-RV.'
if(c.(i).var_type eq 'data') or $
;(c.(i).var_type eq 'support_data') then begin
; RCJ 11/12/2003 Same kind of test as above. Look for 11/12/2003.
((c.(i).var_type eq 'support_data') and $
(c.(i).cdfrecvary ne 'NOVARY')) then begin
st_sz=size(c.(i).dat)
; Compute depend_0 or Epoch
if(st_sz(0) le 1) then begin
label=label_search(c,1,i,0)
units=unit_search(c,1,i,0)
num_var=1
if(w eq 1 and st_sz(1) gt 1 and st_sz(0) eq 1) then num_var=st_sz(1)
for k=0, num_var-1 do begin
;col_sz=strlen(label) > strlen(c.(i).units) > dat_len
col_sz=strlen(label) > strlen(units) > dat_len
; the second set of "col_sz, label" input will be used to define the format
; dep_for. This input changes when we have variables w/ depend_1 attribute.
; RCJ 04/01
;sform=form_bld(col_sz, label, c.(i).units, dat_len, col_sz,label,col_sz,label,form, shft)
sform=form_bld(col_sz, label, units, dat_len, col_sz,label,col_sz,label,form, shft)
lab_for=lab_for + sform.labv
unt_for=unt_for + sform.untv
dat_for=dat_for + sform.datv
dep_for=dep_for + sform.depv
nvar=nvar+1
endfor
endif
; Compute all other 2D variables
if(st_sz(0) eq 2) then begin
;
; This part of the program will change depend_1 variables var_type from
; 'data' or 'support_data' to 'metadata' so that we can set the labels
;
;
; 2D variables do not necessarily have depend_1 defined, so I'm defining
; cur_val_typ and cur_val = '' so we don't get into an error as we pass by
; this part of the program. RCJ 06/00
;
cur_var_typ='' & cur_val=''
depend1=strupcase(c.(i).depend_1)
temp_names=tag_names(c)
z=tagindex(depend1,temp_names)
if(z(0) ne -1) then $
cur_val='cur_var_typ=c.(z(0)).var_type' else $
print, 'Depend_1 not found. This does not necessarily represent a problem (LIST_mystruct).'
if(not execute(cur_val)) then begin
print, "ERROR=Execute error setting cur_val"
close, 1
return, -1
endif
if(cur_var_typ eq 'data') or $
(cur_var_typ eq 'support_data') then begin
cur_var_typ="metadata"
set_val='c.(z(0)).var_type=cur_var_typ'
if(not execute(set_val)) then begin
print, 'ERROR=Execute error setting set_val'
close, 1
return, -1
endif
endif
;
; Set labels
;
num_var=st_sz(1)
; RCJ 12/02/2003 It seems to me we could use only the second
; part of this if statement whatever the value of num_var is.
;if(num_var lt 20) then begin
;for k=0, num_var-1 do begin
;if(c.(i).var_type eq 'data') or $
; (c.(i).var_type eq 'support_data') then begin
; ; Determine labels
; ;print,'k = ',k
; depend1_labels=dependn_search(c,i,1) ; st_sz(0)=2
; if (depend1_labels(0) ne '') then begin
; depend1=c.(i).depend_1
; s=execute('dep1_units=c.'+strtrim(depend1,2)+'.units')
; depend1_labels=['(@_'+depend1_labels+'_'+dep1_units+')']
; ;dep1_values=[dep1_values,dep1]
; endif
; ; Determine labels
; depend2_labels=dependn_search(c,i,2) ; st_sz(0)=2
; if (depend2_labels(0) ne '') then begin
; depend2=c.(i).depend_2
; s=execute('dep2_units=c.'+strtrim(depend2,2)+'.units')
; depend2_labels=['(@_'+depend2_labels+'_'+dep2_units+')']
; endif
; ;dep_col_sz=max(strlen(depend1_labels)) > max(strlen(depend2_labels)) >strlen(c.(i).units) > dat_len
; label=label_search(c,st_sz(0),i,k)
; units=unit_search(c,st_sz(0),i,k)
; dep_col_sz=max(strlen(depend1_labels)) > max(strlen(depend2_labels)) >strlen(units) > dat_len
; ;col_sz = strlen(label) > strlen(c.(i).units) > dat_len
; col_sz = strlen(label) > strlen(units) > dat_len
; ;sform=form_bld(col_sz, label, c.(i).units, dat_len, dep_col_sz,depend1_labels,dep_col_sz,depend2_labels,form, shft)
; sform=form_bld(col_sz, label, units, dat_len, dep_col_sz,depend1_labels,dep_col_sz,depend2_labels,form, shft)
; lab_for=lab_for + sform.labv
; unt_for=unt_for + sform.untv
; dat_for=dat_for + sform.datv
; dep_for=dep_for + sform.depv
; nvar=nvar+1
;endif ; end var_type= data condition
;endfor
;endif else begin ; num_var condition
if(c.(i).var_type eq 'data') or $
(c.(i).var_type eq 'support_data') then begin
depend1_labels=dependn_search(c,i,1) ; st_sz(0)=2
if (depend1_labels(0) ne '') then begin
depend1=c.(i).depend_1
s=execute('dep1_units=c.'+strtrim(depend1,2)+'.units')
depend1_labels=['(@_'+depend1_labels+'_'+dep1_units+')']
;dep1_values=[dep1_values,dep1]
endif
depend2_labels=dependn_search(c,i,2) ; st_sz(0)=2
if (depend2_labels(0) ne '') then begin
depend2=c.(i).depend_2
s=execute('dep2_units=c.'+strtrim(depend2,2)+'.units')
depend2_labels=['(@_'+depend2_labels+'_'+dep2_units+')']
endif
;dep_col_sz=max(strlen(depend1_labels)) > max(strlen(depend2_labels)) >strlen(c.(i).units) > dat_len
; JWJ 07/31/2000
; changed below from label_search to label_search_max_width
;label=label_search_max_width(c,st_sz(0),i,k)
; RCJ 01/29/2003. Label_search_max_width no longer being used.
label=''
units=''
for kk=0L,st_sz(1)-1 do begin
label0=label_search(c,st_sz(0),i,kk)
if strlen(label0) gt strlen(label) then label=label0
units0=unit_search(c,st_sz(0),i,kk)
if strlen(units0) gt strlen(units) then units=units0
endfor
; label: this is only the longest of the labels, not a specific label.
dep_col_sz=max(strlen(depend1_labels)) > max(strlen(depend2_labels)) >strlen(units) > dat_len
;col_sz = strlen(label) > strlen(c.(i).units) > dat_len
col_sz = strlen(label) > strlen(units) > dat_len
;sform=form_bld(col_sz, label, c.(i).units, dat_len, dep_col_sz, depend1_labels,dep_col_sz, depend2_labels,form, shft)
sform=form_bld(col_sz, label, units, dat_len, dep_col_sz, depend1_labels,dep_col_sz, depend2_labels,form, shft)
; Modify format
labv=strtrim(num_var,2)+'('+sform.labv+' '
untv=strtrim(num_var,2)+'('+sform.untv+' '
datv=strtrim(num_var,2)+'('+sform.datv+' '
depv=strtrim(num_var,2)+'('+sform.depv+' '
lend=strlen(labv)-2
uend=strlen(untv)-2
dend=strlen(datv)-2
dpend=max(strlen(depv))-2
strput,labv,'),',lend
strput,untv,'),',uend
strput,datv,'),',dend
strput,depv,'),',dpend
lab_for=lab_for + labv
unt_for=unt_for + untv
dat_for=dat_for + datv
dep_for=dep_for + depv
nvar=nvar+num_var
endif
;endelse
endif ; end if (z(0) ne -1)
c.(0).fillval=nvar
endif ; end if (c.(i).var_type eq 'data')
endif ; format condition
endif ; end if (form ne '')
;
; Determine formats for 3D-RV images
if(noimg eq 0) then begin
if keyword_set(DEBUG) then print,'Determine formats for 3D-RV images.'
if(i gt 0) then $
if(c.(i).var_type eq 'support_data') then c.(i).var_type="metadata"
if(c.(i).var_type eq 'data') or (c.(i).var_type eq 'support_data') then begin
st_sz=size(c.(i).dat)
;print,'st_sz in 3d images = ',c.(i).varname,$
; ' ',c.(i).var_type,' ',st_sz
; RCJ 06/04/2004 If image causes list to have too many columns
; IDL will not print. Get out.
;if st_sz[1] gt 32767. then begin
; print, 'STATUS=Array has too many columns and cannot be listed.'
; ;print,'ERROR=Array has too many columns. Will not list.'
; return,-1
;endif
; Compute depend_0 or Epoch
if(st_sz(0) le 1) then begin
nvar=nvar+1
label=label_search(c,st_sz(0),i,0)
units=unit_search(c,st_sz(0),i,0)
;col_sz=strlen(label) > strlen(c.(i).units) > dat_len
col_sz=strlen(label) > strlen(units) > dat_len
; the second set of "col_sz, label" input will be used to define the format
; dep_for. This input changes when we have variables w/ depend_1 attribute.
; RCJ 04/01
;sform=form_bld(col_sz, label, c.(i).units, dat_len, col_sz, label, col_sz, label,form, shft)
sform=form_bld(col_sz, label, units, dat_len, col_sz, label, col_sz, label,form, shft)
lab_for=lab_for + sform.labv
unt_for=unt_for + sform.untv
dat_for=dat_for + sform.datv
dep_for=dep_for + sform.depv
endif
; Compute all other 2D variables
if(st_sz(0) eq 2) then begin
; Set labels
;num_var=st_sz(1)
;if(c.(i).var_notes eq 'ListImage') then num_var=1
;for k=0, num_var-1 do begin
if(c.(i).var_type eq 'data') or $
(c.(i).var_type eq 'support_data') then begin
; Determine labels
depend1_labels=dependn_search(c,i,1) ; st_sz(0)=2
if (depend1_labels(0) ne '') then begin
depend1=c.(i).depend_1
s=execute('dep1_units=c.'+strtrim(depend1,2)+'.units')
depend1_labels=['(@_'+depend1_labels+'_'+dep1_units+')']
endif
depend2_labels=dependn_search(c,i,2) ; st_sz(0)=2
if (depend2_labels(0) ne '') then begin
depend2=c.(i).depend_2
s=execute('dep2_units=c.'+strtrim(depend2,2)+'.units')
depend2_labels=['(@_'+depend2_labels+'_'+dep2_units+')']
endif
;dep_col_sz=max(strlen(depend1_labels)) > max(strlen(depend2_labels)) >strlen(c.(i).units) > dat_len
label=''
units=''
for kk=0L,st_sz(1)-1 do begin
label0=label_search(c,st_sz(0),i,kk)
if strlen(label0) gt strlen(label) then label=label0
units0=unit_search(c,st_sz(0),i,kk)
if strlen(units0) gt strlen(units) then units=units0
endfor
;label=label_search(c,st_sz(0),i,k)
dep_col_sz=max(strlen(depend1_labels)) > max(strlen(depend2_labels)) >strlen(units) > dat_len
;col_sz = strlen(label) > strlen(c.(i).units) > dat_len
col_sz = strlen(label) > strlen(units) > dat_len
;sform=form_bld(col_sz, label, c.(i).units, dat_len,col_sz,label,form, shft)
;sform=form_bld(col_sz, label, c.(i).units, dat_len,dep_col_sz,depend1_labels,dep_col_sz,depend2_labels,form, shft)
sform=form_bld(col_sz, label, units, dat_len,dep_col_sz,depend1_labels,dep_col_sz,depend2_labels,form, shft)
;
;lab_for=lab_for + sform.labv
sform.labv=strmid(sform.labv,0,strlen(sform.labv)-1) ; remove comma
;lab_for=lab_for + strtrim((st_sz(1)-1),2)+'('+sform.labv+'),'
lab_for=lab_for + strtrim((st_sz(1)),2)+'('+sform.labv+'),'
;
;unt_for=unt_for + sform.untv
sform.untv=strmid(sform.untv,0,strlen(sform.untv)-1) ; remove comma
;unt_for=unt_for + strtrim((st_sz(1)-1),2)+'('+sform.untv+'),'
unt_for=unt_for + strtrim((st_sz(1)),2)+'('+sform.untv+'),'
;
sform.depv=strmid(sform.depv,0,strlen(sform.depv)-1) ; remove comma
;dep_for=dep_for + strtrim((st_sz(1)-1),2)+'('+sform.depv+'),'
dep_for=dep_for + strtrim((st_sz(1)),2)+'('+sform.depv+'),'
;
sform.datv=strmid(sform.datv,0,strlen(sform.datv)-1) ; remove comma
;dat_for=dat_for + strtrim((st_sz(1)-1),2)+'('+sform.datv+'),'
dat_for=dat_for + strtrim((st_sz(1)),2)+'('+sform.datv+'),'
; Modify sform.datv
;if(c.(i).var_notes eq 'ListImage') then begin
;lab_for=lab_for + strtrim((st_sz(1)-1),2)+'x,'
;unt_for=unt_for + strtrim((st_sz(1)-1),2)+'x,'
;dep_for=dep_for + strtrim((st_sz(1)-1),2)+'x,'
;sform.datv=strtrim(st_sz(1),2)+'('+form+',1x),'
;endif
;dat_for=dat_for + sform.datv
nvar=nvar+1
endif ; end var_type= data condition
;endfor
endif
;c.(0).fillval=nvar
c.(0).fillval=st_sz(1)
endif ; end if (c.(i).var_type eq 'data' or ...)
endif ; end if (noimg eq 0)
endfor ; end i
;
; Add ending parenthesis of formats
lend=strlen(lab_for)-1
uend=strlen(unt_for)-1
dend=strlen(dat_for)-1
dpend=max(strlen(dep_for))-1
strput,lab_for,')',lend
strput,unt_for,')',uend
strput,dat_for,')',dend
strput,dep_for,')',dpend
;
if(no3drv eq 0) then begin
lab_for='(a23,1x,A5,1x,a9,2(1x,a13),2(1x,a13))'
unt_for='(a23,1x,a5,1x,a9,2(7x,a7),2(11x,a3))'
dat_for='(a23,4x,i2,7x,i3,2(1x,g13.5),2(1x,g13.5),/,29(27x,i2,7x,i3,2(1x,g13.5),2(1x,g13.5),/))'
endif
;print,'dep_for = ', dep_for
;print,'lab_for = ', lab_for
;print,'unt_for = ', unt_for
;print,'dat_for = ', dat_for
if(norv eq 0) or (no2drv eq 0) or (no3drv eq 0) or (noimg eq 0) then $
rvars=create_struct(c,'LFORM',lab_for,'UFORM',unt_for,'DFORM',dat_for,'DPFORM',dep_for)
;
; Write out structure listing
; Turn off glbatt for mulitple depend_0's
if(mega_loop gt 1) then begin
nogatt=1
printf, unit, format='(" ")'
endif
; Free Memory
delete, c
if keyword_set(DEBUG) then print,'Write out variables.'
if(nogatt eq 0) then status=wrt_hybd_strct(glbatt,unit,0,maxrecs,depend0)
if(norv eq 0) then status=wrt_hybd_strct(rvars,unit,1,maxrecs,depend0)
if(nonrv eq 0) then status=wrt_hybd_strct(nrvars,unit,2,maxrecs,depend0)
if(no2drv eq 0) then status=wrt_hybd_strct(rvars,unit,3,maxrecs,depend0)
if(no3drv eq 0) then status=wrt_hybd_strct(rvars,unit,4,maxrecs,depend0)
if(noimg eq 0) then status=wrt_hybd_strct(rvars,unit,5,maxrecs,depend0)
; Free Memory
delete, rvars
endfor ; end mega_loop
time_string=systime()
printf, unit, format='(" ")'
printf, unit, format='("Key Parameter and Survey data (labels K0,K1,K2) are preliminary browse data.")'
printf, unit, format='("Generated by CDAWeb on: ",a)',time_string
close,unit
close,1
free_lun, unit
end