; $Id: tasrd.pro,v 1.6 2003/10/27 13:57:43 jmspark Exp $
function tasrd,filen, error = error
;+
; NAME:         TASRD
; PURPOSE:
;               Read a TASCOM *.DAT file
; CATEGORY:
; CALLING SEQUENCE:
;               d=tasrd('filename')
; INPUTS:
;               filename= eg. ora059.dat
; OPTIONAL INPUT PARAMETERS:
; KEYWORD PARAMETERS:
; OUPUTS:
;               a data structure consisting of:
;                 d.points - integer - # of points in scan
;                 d.heads - integer - # of header parameters
;                 d.pars - integer - # of scan parameters
;                 d.text - string array - 2 lines of descriptive text
;                 d.hdef - string array - definition of header parameters
;                 d.hnum - float array - header parameters
;                 d.prp - string array - definition of scan parameters
;                 d.data - 2D float array - scan data (parameter,point#)
; OPTIONAL OUTPUT PARAMETERS:
; COMMON BLOCKS:
; SIDE EFFECTS:
; RESTRICTIONS:
; PROCEDURE:
; MODIFICATION HISTORY:
;               Thom Mason, Riso National Laboratory, 1993
;-
COMMON SEARP,sear,ddmask

error = 0

on_ioerror,bad
openr,unit,filen,/get_lun
;*********** New C version of TASCOM stores files differently ****************
;**** We can identify them by the fact that the first line is just CR/LF
;**** and the second line has something like:
;**** #fdt     C:\DATA\MYDATA\u2ba03.DAT 30/09 1993   20:12:31
;*****************************************************************************
dummy=' '
READF,unit,dummy                ;read the first line
;see if this is a NIST data file(*.BT*)

; 2002.11.13
; Fixing 'Cannot read polarized beam data' bug.
; Previously only those polarized data files ending '.na', '.nb', etc. were read.
; Adding '.B*' series to fix this bug.
filetype = strupcase( strmid( dummy, 9, 3 ) )
switch filetype of
   '.BA':
    '.BB':
    '.BC':
    '.BD':
   '.BT':
   '.NA':
    '.NB':
    '.NC':
    '.ND':
   '.NG': $
     begin
      free_lun,unit
       stuff=readnist(filen)
       RETURN, stuff
      end
    else: ; goto, bad
ENDswitch
;
; Old codes.
;
;IF ( (strupcase(STRMID(dummy,9,3)) EQ '.BT') $
;  or (strupcase(STRMID(dummy,9,3)) EQ '.NG')) THEN BEGIN
;   free_lun,unit
;   stuff=readnist(filen)
;   RETURN, stuff
;END
;
;IF ( (strupcase(STRMID(dummy,9,3)) EQ '.NA') $
;  or (strupcase(STRMID(dummy,9,3)) EQ '.NB') or    $
;  (strupcase(STRMID(dummy,9,3)) EQ '.NC') or $
;  (strupcase(STRMID(dummy,9,3)) EQ '.ND'))   $
;   THEN BEGIN
;    free_lun,unit
;    stuff=readnisti(filen)
;  print,stuff
;    RETURN, stuff
;
;END

mytemp=''
mytemp=readword(dummy,0)


IF (mytemp EQ 'Motor')  THEN BEGIN
    free_lun,unit

;       this is a strange format!

    stuff=readnistng(filen)
    RETURN, stuff
END



IF (mytemp EQ 'Fit:')  THEN BEGIN
    free_lun,unit

;       this is a strange format!

    stuff=readngfit(filen)
    RETURN, stuff
END


READF,unit,dummy                ;read that second line
free_lun, unit                  ;close it again
IF (STRMID(dummy,0,4) EQ '#fdt') THEN BEGIN
    stuff=ctasrd(filen)    ;Now read it as a c version of tascom
    RETURN, stuff               ;and return the tascom structure
END ELSE IF (STRMID(dummy,0,1) EQ '!') THEN BEGIN
    stuff=fiord(filen)   ;It's actually a SPECTRA file from
    RETURN, stuff               ; HASYLAB
END
OPENR,unit,filen,/GET_LUN  ;otherwise open it again
itot=0
ipar=0
lines=[' ',' ']
readf,unit,format='(i4,i3,2(/,a79))',itot,ipar,lines
lines(0)=strcompress(lines(0))
if (strpos(lines(0),'NAME :') gt 1) then $
  lines(0)=STRLOWCASE(strmid(lines(0),strpos(lines(0),'.DAT')-6,6))
lines(1)=strcompress(lines(1))
ih=itot-ipar-2
heads=strarr(30)
theads='    '
headn=fltarr(30)
theadn=0.0
for i=0,ih-1 do begin
    readf,unit,format='(1x,a4,3x,g13.6)',theads,theadn
    heads(i)=strcompress(theads,/remove_all)
    headn(i)=theadn
endfor
prps=strarr(30)
tpars='    '
for i=0,ipar-1 do begin
    readf,unit,format='(a5)',tpars
    prps(i)=strcompress(tpars,/remove_all)
    if (tpars eq 'INT1 ') then prps(i)='I'
    if ((tpars eq 'I   ') or (tpars eq 'INT1')) then nin=i
    if (tpars eq 'MON ') then nmon=i
endfor
fsigi='false'
fsigm='false'
for i=0,ipar-1 do begin
    if (prps(i) eq 'SIGI') then begin
        fsigi='true'
    endif
    if (prps(i) eq 'SIGM') then begin
        fsigm='true'
    endif
endfor
if (fsigi eq 'false') then begin
    prps(ipar)='SIGI'
endif
if (fsigm eq 'false') then begin
    prps(ipar+1)='SIGM'
endif
posi=where(prps eq 'I',icount)
tnum=0.0
scandat=fltarr(30,5000)
n=0
while (not EOF(unit)) do begin
    for i=0,ipar-1 do begin
        readf,unit,format='(1x,g13.6)',tnum
        scandat(i,n)=tnum
        if ((prps(i) eq 'I') and (fsigi eq 'false')) then scandat(ipar,n)=sqrt(tnum)
        if ((prps(i) eq 'MON') and (fsigm eq 'false')) then scandat(ipar+1,n)=sqrt(tnum)
    endfor
;    if ( sear ne 0 ) and (icount ne 0) then begin
;
;        darread,filen,sear,aux
;        scandat(posi,n)=aux
;        if fsigi eq 'false' then scandat(ipar,n)=sqrt(aux)
;    endif
    n=n+1
endwhile
npt=n
if (fsigi eq 'false') then ipar=ipar+1
if (fsigm eq 'false') then ipar=ipar+1
scan={points: npt,heads: ih,pars: ipar,text: lines,$
      hdef: heads(0:ih-1),hnum: headn(0:ih-1),prp: prps(0:ipar-1),$
      data: scandat(0:ipar-1,0:npt-1)}
goto,done

;***************************
; BAD
;***************************
bad:

   print,!err_string

on_ioerror,null
   done: free_lun,unit, exit_status = exit_status, /force
   error = -1
   if n_elements( scan ) eq 0 then return, -1 else return, scan
end
