; $Id: illrd.pro,v 1.2 2002/01/14 20:59:26 amunter Exp $
function illrd,filename
;+
; NAME:		ILLRD
; PURPOSE:
;		Read ILL ASCII output into a tasxp data structure
; CATEGORY:
; CALLING SEQUENCE:
;		illrd,'filename'
; INPUTS:
;		filename - name of an ILL  ascii file 
; OPTIONAL INPUT PATRAMETERS:
;		none
; KEYWORD PARAMETERS:
; OUTPUTS:
;		a tasxp data structure
; OPTIONAL OUTPUT PARAMETERS:
; COMMON BLOCKS:
; SIDE EFFECTS:
;		only tested on IN20 data
; RESTRICTIONS:
; PROCEDURE:
; MODIFICATION HISTORY:
;		Thom Mason, University of Toronto Physics, Nov. 1995
;-
if (n_params() lt 1) then filename=pickfile(filter='*',title=$
 'Select a ILL file')
on_ioerror,bad
openr,unit,filename,/get_lun
lines=[' ',' ']
dum=' '
ih=58
heads=strarr(ih)
headn=fltarr(ih)
heads(0)='DM'
heads(1)='DA'
heads(2)='SM'
heads(3)='SS'
heads(4)='SA'
heads(5)='FX'
heads(6)='KFIX'
heads(7)='ALF1'
heads(8)='ALF2'
heads(9)='ALF3'
heads(10)='ALF4'
heads(11)='BET1'
heads(12)='BET2'
heads(13)='BET3'
heads(14)='BET4'
heads(15)='ETAM'
heads(16)='ETAA'
heads(17)='AS'
heads(18)='BS'
heads(19)='CS'
heads(20)='AA'
heads(21)='BB'
heads(22)='CC'
heads(23)='ETAS'
heads(24)='AX'
heads(25)='AY'
heads(26)='AZ'
heads(27)='BX'
heads(28)='BY'
heads(29)='BZ'
heads(30)='A1'
heads(31)='A2'
heads(32)='A3'
heads(33)='A4'
heads(34)='A5'
heads(35)='A6'
heads(36)='CH'
heads(37)='TM'
heads(38)='GM'
heads(39)='RM'
heads(40)='GL'
heads(41)='GU'
heads(42)='GA'
heads(43)='TA'
heads(44)='RA'
heads(45)='TT'
heads(46)='RT'
heads(47)='I1'
heads(48)='I2'
heads(49)='I3'
heads(50)='I4'
heads(51)='I5'
heads(52)='I6'
heads(53)='I7'
heads(54)='I8'
heads(55)='I9'
heads(56)='I10'
heads(57)='I11'
polan='F'
readf,unit,format='(/,/,/,/,/,a79)',dum
lines(1)=dum
readf,unit,format='(/,/,/,/,/,7x,a6)',dum
lines(0)=dum
readf,unit,format='(/,7x,a72)',dum
lines(1)=strcompress(lines(1))+strcompress(dum)
instrum=strmid(lines(1),0,4)
if (instrum eq 'IN14') then begin
 ih=47
 heads(37)='GU'
 heads(38)='GL'
 heads(39)='TST'
 heads(40)='RBA'
 heads(41)='RB'
 heads(42)='RF1'
 heads(43)='GA'
 heads(44)='TA'
 endif
readf,unit,format='(/,/,/,5x,2(6x,f9.5),3(5x,f3.0))'$
   ,h0,h1,h2,h3,h4
readf,unit,format='(10x,f3.0,7x,f10.5)'$
   ,h5,h6
readf,unit,format='(5x,4(7x,f7.2))',h7,h8,h9,h10
readf,unit,format='(5x,4(7x,f7.2))',h11,h12,h13,h14
readf,unit,format='(5x,2(7x,f8.1))',h15,h16
readf,unit,format='(5x,3(5x,f10.5))',h17,h18,h19
readf,unit,format='(5x,3(5x,f8.4),7x,f8.1)',h20,h21,h22,h23
fmt='(5x,3(5x,f8.3))'
readf,unit,format=fmt,h24,h25,h26
readf,unit,format=fmt,h27,h28,h29
fmt='(5x,4(11x,f7.2))'
if (instrum eq 'IN20') then begin
 readf,unit,format=fmt,h47,h48,h49,h50
 readf,unit,format=fmt,h51,h52,h53,h54
 readf,unit,format=fmt,h55,h56,h57
 endif
readf,unit,format=fmt,h30,h31,h32,h33
readf,unit,format=fmt,h34,h35,h36,h37
readf,unit,format=fmt,h38,h39,h40,h41
readf,unit,format=fmt,h42,h43,h44
readf,unit,format='(/,/,/,/,a5)',polan
if (polan eq 'POLAN') then readf,unit,format='(a79)',dum
prefix=' '
htxt=' '
readf,unit,format='(a5,a145)',prefix,htxt
if (prefix eq 'PARAM') then begin
 reads,htxt,format='(2(5x,f10.4))',h45,h46
 readf,unit,format='(7x,a150)',fmt
 endif else begin
  reads,htxt,format='(2x,a150)',fmt
  h45=0.0
  h46=0.0
  endelse
fmt=strcompress(fmt)
headn(0)=h0
headn(1)=h1
headn(2)=h2
headn(3)=h3
headn(4)=h4
headn(5)=h5
headn(6)=h6
headn(7)=h7
headn(8)=h8
headn(9)=h9
headn(10)=h10
headn(11)=h11
headn(12)=h12
headn(13)=h13
headn(14)=h14
headn(15)=h15
headn(16)=h16
headn(17)=h17
headn(18)=h18
headn(19)=h19
headn(20)=h20
headn(21)=h21
headn(22)=h22
headn(23)=h23
headn(24)=h24
headn(25)=h25
headn(26)=h26
headn(27)=h27
headn(28)=h28
headn(29)=h29
headn(30)=h30
headn(31)=h31
headn(32)=h32
headn(33)=h33
headn(34)=h34
headn(35)=h35
headn(36)=h36
headn(37)=h37
headn(38)=h38
headn(39)=h39
headn(40)=h40
headn(41)=h41
headn(42)=h42
headn(43)=h43
headn(44)=h44
headn(45)=h45
headn(46)=h46
if (instrum eq 'IN20') then begin
 headn(47)=h47
 headn(48)=h48
 headn(49)=h49
 headn(50)=h50
 headn(51)=h51
 headn(52)=h52
 headn(53)=h53
 headn(54)=h54
 headn(55)=h55
 headn(56)=h56
 headn(57)=h57
 endif
i=0
datalab=' '
readf,unit,format='(/,a150)',datalab
datalab=strcompress(datalab)
blank=strpos(datalab,' ')
prps=strarr(50)
ipar=0
while (datalab ne '') do begin
 datalab=strmid(datalab,blank+1,149)
 last=strpos(datalab,' ')
 prps(ipar)=strmid(datalab,blank,last)
 ipar=ipar+1
 datalab=strmid(datalab,last+1,149)
 blank=-1
 endwhile
loc=where(prps eq 'CNTS')
if (loc(0) ge 0) then prps(loc)='I'
loc=where(prps eq 'TIME')
if (loc(0) ge 0) then prps(loc)='TIM'
loc=where(prps eq 'M1')
if (loc(0) ge 0) then prps(loc)='MON'
loc=where(prps eq 'F1')
if (loc(0) ge 0) then prps(loc)='1F1'
loc=where(prps eq 'F2')
if (loc(0) ge 0) then prps(loc)='1F2'
loc=where(prps eq 'QH')
if (loc(0) ge 0) then prps(loc)='H'
loc=where(prps eq 'QK')
if (loc(0) ge 0) then prps(loc)='K'
loc=where(prps eq 'QL')
if (loc(0) ge 0) then prps(loc)='L'
prps=prps(0:ipar-1)
ipar=ipar+2
prps=[prps,'SIGI','SIGM']
if (polan eq 'POLAN') then begin
 ipar=ipar+4
 prps=[prps,'2F1','2F2','I2','SIG2']
 first=' '
 second=' '
 endif
iind=where(prps eq 'I')
mind=where(prps eq 'MON')
i=0
if (instrum eq 'IN14') then begin
 a=fltarr(ipar-2)
 readf,unit,format=fmt,a
 scandat=[a,sqrt(a(iind)),sqrt(a(mind))]
 i=1
 while (not eof(unit)) do begin
  readf,unit,format=fmt,a
  b=[a,sqrt(a(iind)),sqrt(a(mind))]
  scandat=[[scandat],[b]]
  i=i+1
  endwhile
 goto,done
 endif
if (polan eq 'POLAN') then begin
 a=fltarr(ipar-6)
 f1ind=where(prps eq '1F1')
 f2ind=where(prps eq '1F2')
 readf,unit,format='(a150)',first
;kludge to deal with line overflow problem
 if (strmid(first,0,4) eq '   N') then readf,unit,format='(a150)',first
 while (rstrpos(first,' ON') ge 0) do $
   strput,first,'1.0',rstrpos(first,' ON')
 while (rstrpos(first,'OFF') ge 0) do $
   strput,first,'0.0',rstrpos(first,'OFF')
 readf,unit,format='(a150)',second
;kludge to deal with line overflow problem
 if (not (strmid(second,0,2) eq '  ')) then readf,unit,format='(a150)',second
 while (rstrpos(second,' ON') ge 0) do $
   strput,second,'1.0',rstrpos(second,' ON')
 while (rstrpos(second,'OFF') ge 0) do $
   strput,second,'0.0',rstrpos(second,'OFF')
 reads,first,a
 b=[a,sqrt(a(iind)),sqrt(a(mind))]
 reads,second,a
 scandat=[b,a(f1ind),a(f2ind),a(iind),sqrt(a(iind))]
 i=1
 while (not eof(unit)) do begin
  readf,unit,format='(a150)',first
;line overflow
  if (not (strmid(first,0,2) eq '  ')) then readf,unit,format='(a150)',first
  while (rstrpos(first,' ON') ge 0) do $
   strput,first,'1.0',rstrpos(first,' ON')
  while (rstrpos(first,'OFF') ge 0) do $
   strput,first,'0.0',rstrpos(first,'OFF')
  readf,unit,format='(a150)',second
;line overflow
  if (not (strmid(second,0,2) eq '  ')) then readf,unit,format='(a150)',second
  while (rstrpos(second,' ON') ge 0) do $
   strput,second,'1.0',rstrpos(second,' ON')
  while (rstrpos(second,'OFF') ge 0) do $
   strput,second,'0.0',rstrpos(second,'OFF')
  reads,first,a
  b=[a,sqrt(a(iind)),sqrt(a(mind))]
  reads,second,a
  c=[b,a(f1ind),a(f2ind),a(iind),sqrt(a(iind))]
  scandat=[[scandat],[c]]
  i=i+1
  endwhile 
 endif else begin
  a=fltarr(ipar-2)
  readf,unit,format=fmt,a
  scandat=[a,sqrt(a(iind)),sqrt(a(mind))]
  i=1
  while (not eof(unit)) do begin
   readf,unit,format=fmt,a
   b=[a,sqrt(a(iind)),sqrt(a(mind))]
   scandat=[[scandat],[b]]
   i=i+1
   endwhile
  endelse
goto,done

bad:print,!err_string

done: free_lun,unit
if (i eq 0) then begin
; null data set
 scandat=[[0.0],[0.0]]
 i=1
 prps=strarr(1)
 prps(0)='NULL'
 ipar=1
 endif
npt=i
scan={points: npt, heads: ih, pars: ipar, text: lines,$
hdef: heads(0:ih-1), hnum: headn(0:ih-1), prp: prps, data: scandat(*,0:npt-1)}
return,scan
end





