; $Id: fans_loadfiles.pro,v 1.12 2007/10/12 22:58:40 azuah Exp $
;###############################################################################
;
; NAME:
;   fans_loadfiles
;
; PURPOSE:
;   Various utitlity routines used by the FANS data reduction
;   application defined in the file fans_datreduc.pro. The routines in
;   this file mainly deal with reading data from .bt4 files.
;
; CATEGORY:
;   FANS Data Reduction
;
; AUTHOR:
;   Richard Tumanjong Azuah
;   NIST Center for Neutron Research
;   100 Bureau Drive, Gaithersburg, MD 20899
;   United States
;   azuah@nist.gov; (301) 9755604
;   May, 2002
;
; LICENSE:
;  The software in this file is written by an employee of 
;  National Institute of Standards and Technology 
;  as part of the DAVE software project.
;
;  The DAVE software package is not subject to copyright protection
;  and is in the public domain. It should be considered as an
;  experimental neutron scattering data reduction, visualization, and
;  analysis system. As such, the authors assume no responsibility
;  whatsoever for its use, and make no guarantees, expressed or
;  implied, about its quality, reliability, or any other
;  characteristic. The use of certain trade names or commercial
;  products does not imply any endorsement of a particular product,
;  nor does it imply that the named product is necessarily the best
;  product for the stated purpose. We would appreciate acknowledgment
;  if the DAVE software is used of if the code in this file is
;  included in another product.
;
;###############################################################################



;===============================================================================
; printerror
;
; PURPOSE:
;   Debug tool: print current error and error message on the command line
;
; PARAMETERS:
;   err [in] - the error number to be displayed
;
;   emsg [in] - the error message to be displayed
;
pro printerror, err, emsg

if (!debug) then begin
    if (n_params() ne 2) then begin
        print,'In "printerror" - Invalid number of parameters in call to "printerror"'
        return
    endif
    
    print,'ERROR encountered... '
    print,'error number: ',err
    print,'error message: ',emsg
endif

end
;-------------------------------------------------------------------------------



;===============================================================================
; cleanDataPtr
;
; PURPOSE:
;   Free or cleanup internal data structure containing FANS data
;   (should now use the IDL procedure heap_free).
;
; PARAMETERS:
;   dataPtr [in] - data structure to be freed
;
pro cleanDataPtr, dataPtr

; obviously, dataPtr has to be valid
if ( ptr_valid(dataPtr) eq 0) then return

; get the data structure and cleanup all its pointers. The FANS data
; structure is defined in fans_initDataPtr
ds = *dataPtr
if ptr_valid(ds.qxPtr) then ptr_free, ds.qxPtr
if ptr_valid(ds.qyPtr) then ptr_free, ds.qyPtr
if ptr_valid(ds.qzPtr) then ptr_free, ds.qzPtr
if ptr_valid(ds.tempPtr) then ptr_free, ds.tempPtr
if ptr_valid(ds.timePtr) then ptr_free, ds.timePtr
if ptr_valid(ds.energyPtr) then ptr_free, ds.energyPtr
if ptr_valid(ds.detCntsPtr) then ptr_free, ds.detCntsPtr
if ptr_valid(ds.detErrsPtr) then ptr_free, ds.detErrsPtr
if ptr_valid(ds.totCntsPtr) then ptr_free, ds.totCntsPtr
if ptr_valid(ds.totErrsPtr) then ptr_free, ds.totErrsPtr
if ptr_valid(ds.historyPtr) then ptr_free, ds.historyPtr
; finally, clean dataPtr
ptr_free, dataPtr

end
;-------------------------------------------------------------------------------



;===============================================================================
; fans_cleanDataPtr
;
; PURPOSE:
;   Wrapper procedure to cleanDataPtr enabling clean up of all
;   datasets for a particular data type (samp, bkgd or fast) by making
;   a single call 
;
; PARAMETERS:
;   sPtr [in] - pointer to state structure
;
;   dataType [in] - data type string: 'samp'|'bkgd'|'fast'
;
pro fans_cleanDataPtrs, sPtr, dataType

; can't have this
if ((ptr_valid(sPtr) eq 0) or (n_elements(dataType) le 0)) then begin
    if (!debug) then $
      print,'ERROR: In "fans_cleanDataPtrs" - invalid input parameter(s)'
    return
endif

switch dataType of

    'samp': begin
        i = 0
        while (i lt n_elements((*(*sPtr).sDataPtr)) ) do begin
            cleanDataPtr, (*(*sPtr).sDataPtr)[i]
            i = i+1
        endwhile
        ptr_free, (*sPtr).sDataPtr
        (*sPtr).sampCount = 0

        break
    end

    'bkgd': begin
        i = 0
        while (i lt  n_elements((*(*sPtr).bDataPtr)) ) do begin
            cleanDataPtr, (*(*sPtr).bDataPtr)[i]
            i = i+1
        endwhile
        ptr_free, (*sPtr).bDataPtr
        (*sPtr).bkgdCount = 0

        break
    end

    'fast': begin
        i = 0
        while (i lt  n_elements((*(*sPtr).fDataPtr)) ) do begin
            cleanDataPtr, (*(*sPtr).fDataPtr)[i]
            i = i+1
        endwhile
        ptr_free, (*sPtr).fDataPtr
        (*sPtr).fastCount = 0

        break
    end

    'outp': begin
        i = 0
        while (i lt  n_elements((*(*sPtr).oDataPtr)) ) do begin
            cleanDataPtr, (*(*sPtr).oDataPtr)[i]
            i = i+1
        endwhile
        ptr_free, (*sPtr).oDataPtr
        (*sPtr).outpCount = 0

        break
    end

endswitch



end
;-------------------------------------------------------------------------------



;===============================================================================
; fans_initDataPtr
;
; PURPOSE:
;   Define a suitable data structure that can hold contents of FANS
;   data file.
;
; PARAMETERS:
;   rvaluePtr [in] - Pointer to an existed data structure. If
;                    specified, then initialise the new data structure
;                    with it's contents.
;
; RETURN VALUE:
;   a valid data structure for storing FANS data.
;
function fans_initDataPtr, rvaluePtr

; If there is an rvaluePtr, 
fdStr = {filename:'', $
         date:'', $
         scan:'T', $
         monitor:0L, $   
         prefactor:0L, $
         base:'TIME', $
         type:'RAW', $
         title:'', $
         collimation:'00 00 00 00', $
         mosaic:'0  0  0', $
         orientation:'0 0 0 0.000 0 0 0', $
         latticeA:0.0, $
         latticeB:0.0, $
         latticeC:0.0, $
         latticeAl:0.0, $
         latticeBe:0.0, $
         latticeGa:0.0, $
         eStart:0.0, $
         eFinal:0.0, $
         eDelta:0.0, $
         monDSpace:0.0, $
         anaDSpace:0.0, $
         tStart:0.0, $
         tInc:0.0, $
         qhCenter:0.0, $
         qkCenter:0.0, $
         qlCenter:0.0, $
         qhDelta:0.0, $
         qkDelta:0.0, $
         qlDelta:0.0, $
         hfield:0.0, $          ; header info ends here
         tflag:0B, $
         ndets:128, $           ; however, it seems only 50 are currently active - see below
         nspec:0, $
         monPtr:ptr_new(), $ ;monitor array
         qxPtr:ptr_new(), $
         qyPtr:ptr_new(), $
         qzPtr:ptr_new(), $
         tempPtr:ptr_new(), $
         timePtr:ptr_new(), $
         energyPtr:ptr_new(), $
         detCntsPtr:ptr_new(), $
         totCntsPtr:ptr_new(), $
         totErrsPtr:ptr_new(), $ ; error in totCnts
         detErrsPtr:ptr_new(), $ ; error in detCnts
         historyPtr:ptr_new() $ ; ptr to a string array containing history of file 
        }


if ( ptr_valid(rvaluePtr) gt 0) then begin ; copy values from rvaluePtr
    
    rvalue = *rvaluePtr

    for i = 0,33 do $           ; copy the ordinary structure members
      fdStr.(i) = rvalue.(i)

    for i = 34,n_tags(rvalue)-1 do $            ; copy the pointer structure members
      fdStr.(i) = ptr_new( *(rvalue.(i)) ) ; b/c ptrs in fdStr are initia. to NULL
endif

lvaluePtr = ptr_new(fdStr)

return, lvaluePtr               

end
;-------------------------------------------------------------------------------



;===============================================================================
; fans_readData
;
; PURPOSE:
;   Read the contents of a .bt4 file
;
; PARAMETERS:
;   file [in] - filename to be read.
;
;   dataPtr [in|out] - data structure to read file contents into
;
;   nosActDets [in]  - number of active detectors in this file
;
;   conv_factor [in] - energy conversion factor meV <-> wavenumbers
;
; KEYWORDS:
;   err [out] - err number, if an error occured
;
;   emsg [out] - explanatory error message, if an error occured
;
pro fans_readData, file, dataPtr, nosActDets,conv_factor,err=err, emsg=emsg
; Read data from the specified FANS file. The data is then loaded into a
; FANS data structure stored in IDL heap memory. A pointer to the heap
; is then returned.

; reset !error_state
message,/reset_error_state

; check parameter count
if (n_params() ne 4) then begin
    err = 1
    emsg = '"In fans_readData" - Invalid number of procedure parameters'
    return
endif

; check file parameter is defined
if (n_elements(file) le 0 or n_elements(nosActDets) le 0) then begin
    err = 2
    emsg = 'In "fans_readData" - Input parameter(s) undefined'
    return
endif

; open input file
openr, lun, file, /get_lun, error=err

if (err ne 0) then begin        ; if error, get the error msg and exit
    emsg = 'In "fans_readData" - '+!error_state.msg    
    return
endif


; initialised dataPtr to point to a FANS data structure if necessary
if not ptr_valid(dataPtr) then dataPtr = fans_initDataPtr()

; get file header and sort out the useful info from it
line = ''
header = strarr(5)
readf, lun, header
(*dataPtr).filename = strmid(header[0],1,12)
(*dataPtr).date = strmid(header[0],16,17)
(*dataPtr).scan = strmid(header[0],36,1)
(*dataPtr).monitor = long(strmid(header[0],39,12))
(*dataPtr).prefactor = long(strmid(header[0],52,4))
(*dataPtr).base = strmid(header[0],58,4)
(*dataPtr).type = strmid(header[0],71,3)
(*dataPtr).title = strtrim(header[2],2)
(*dataPtr).collimation = strmid(header[3],1,11)
(*dataPtr).mosaic = strmid(header[3],18,8)
(*dataPtr).orientation = strmid(header[3],36,23)
buf = fltarr(6) & readf,lun,buf
(*dataPtr).latticeA = buf[0]
(*dataPtr).latticeB = buf[1]
(*dataPtr).latticeC = buf[2]
(*dataPtr).latticeAl = buf[3]
(*dataPtr).latticeBe = buf[4]
(*dataPtr).latticeGa = buf[5]
readf, lun,line & buf = fltarr(7) & readf, lun,buf
(*dataPtr).eStart = buf[0]
(*dataPtr).eDelta = buf[1]
(*dataPtr).eFinal = buf[2]
(*dataPtr).monDSpace = buf[3]
(*dataPtr).anaDSpace = buf[4] 
(*dataPtr).tStart = buf[5]
(*dataPtr).tInc = buf[6]
readf, lun,line & readf, lun,buf
(*dataPtr).qhCenter = buf[0]
(*dataPtr).qkCenter = buf[1]
(*dataPtr).qlCenter = buf[2]
(*dataPtr).qhDelta = buf[3]
(*dataPtr).qkDelta = buf[4]
(*dataPtr).qlDelta = buf[5]
(*dataPtr).hfield = buf[6]
readf, lun,line,line
if (strmid(line,37,1) eq 'T') then (*dataPtr).tflag = 1

; now in the data section.
hbuf = ((*dataPtr).tflag)? fltarr(7) : fltarr(6)
dbuf = lonarr((*dataPtr).ndets)
nspec = 2000 & i = 0 
time = (temp = (totErrs = (totCnts =  (omega = (qx = (qy = (qz = fltarr(nspec))))))))
;nosActDets = (*sPtr).nosActDets 
detCnts = fltarr(nosActDets,nspec)
detErrs = fltarr(nosActDets,nspec)
 
while (not eof(lun)) do begin
    readf, lun, hbuf,dbuf       ; read one data block (per energy transfer)
    qx[i] = hbuf[0]
    qy[i] = hbuf[1]
    qz[i] = hbuf[2]
    omega[i] = hbuf[3]
    if ( (*dataPtr).tflag) then begin
        temp[i] = hbuf[4]
        time[i] = hbuf[5]
        totCnts[i] = hbuf[6]
    endif else begin
        temp[i] = (*dataPtr).tStart
        time[i] = hbuf[4]
        totCnts[i] = hbuf[5]
    endelse
    totErrs[i] = (totCnts[i] le 0)? 1 : sqrt(totCnts[i]) ; assign 1 to erros if cnts <= 0
    detCnts[*,i] = dbuf[0:nosActDets-1] ; trim to active detectors only
    res = where(dbuf le 0)      ; locate indices where detcts <= 0
    if (res[0] ne -1) then begin ; and assign an error value of 1 to
        dbuf[res] = 1
    endif
    detErrs[*,i] = sqrt(dbuf[0:nosActDets-1])
    i = i + 1
endwhile

free_lun, lun

; move data into the heap and save pointers in dataPtr; trim spectra
; to number of points read from file
(*dataPtr).nspec = i 
(*dataPtr).ndets = nosActDets
(*dataPtr).qxPtr = ptr_new(qx[0:i-1],/no_copy)
(*dataPtr).qyPtr = ptr_new(qy[0:i-1],/no_copy)
(*dataPtr).qzPtr = ptr_new(qz[0:i-1],/no_copy)
(*dataPtr).energyPtr = ptr_new(omega[0:i-1]*conv_factor,/no_copy)
(*dataPtr).tempPtr = ptr_new(temp[0:i-1],/no_copy)
(*dataPtr).timePtr = ptr_new(time[0:i-1],/no_copy)
(*dataPtr).totCntsPtr = ptr_new(totCnts[0:i-1],/no_copy)
(*dataPtr).totErrsPtr = ptr_new(totErrs[0:i-1],/no_copy)
(*dataPtr).detCntsPtr = ptr_new(detCnts[*,0:i-1],/no_copy)
(*dataPtr).detErrsPtr = ptr_new(detErrs[*,0:i-1],/no_copy)
(*dataPtr).monPtr = ptr_new(fltarr(i) + (*dataPtr).monitor * (*dataPtr).prefactor)

; finally check for untrapped errors
err = 0
emsg = ''
if (!error_state.code ne 0) then begin
    err = !error_state.code
    emsg = 'In "fans_loadFiles" - ' + !error_state.msg
    fans_cleanDataPtrs, dataPtr
    message,/reset_error_state
endif



end
;-------------------------------------------------------------------------------



;===============================================================================
; defaultOutpFiles
;
; PURPOSE:
;   Determine an output filename(s) for storing the reduced data from the
;   input sample filename.
;
; PARAMETERS:
;   sPtr [in] - Pointer to state structure.
;
;   ofiles [out] - The output filename
;
pro defaultOutpFiles, sPtr, ofiles

for i = 0,n_elements(ofiles)-1 do begin
    ofile = (*(*sPtr).sampListPtr)[i]
    ;; get base name for output file [replace the current file extension with '.dave' and add the]
    ofiles[i] = strmid(ofiles[i],0,strpos(ofiles[i],'.',/reverse_search)) ;+'.dave'
endfor 

(*(*sPtr).outpListPtr) = ofiles

end
;-------------------------------------------------------------------------------



;===============================================================================
; getFileList
;
; PURPOSE:
;   Get a list of files to be reduced from the user.
;
; PARAMETERS:
;   sPtr [in] - pointer to state structure
;
;   dataType [in|out] - data type string: 'samp'|'bkgd'|'fast'
;
;   lFileList [in] - fully qualified chosen files.
;
;   fileList [in] - basename of selected files.
;
;   count [in] - number of files chosen.
;
; KEYWORDS:
;   err [out] - err number, if an error occured
;
;   emsg [out] - explanatory error message, if an error occured
;
pro fans_loadFiles, dataType, sPtr,lFileList,fileList,count,err=err, emsg=emsg

err=0  &  emsg=''

; check parameter count
if (n_params() ne 5) then begin
    err = 1
    emsg = 'In "fans_loadFiles" - Invalid number of procedure parameters'
    return
endif

; check input parameters are defined
if ( (n_elements(dataType) le 0) or (ptr_valid(sPtr) eq 0) or $
     (n_elements(lFileList) le 0) or (n_elements(fileList) le 0) or $
     (n_elements(count) le 0) ) then begin
    err = 2
    emsg = 'In "fans_loadFiles" - Input parameter(s) undefined'
    return
endif

; which energy units is selected - meV or wavenumbers? Set the proper
;                                  conversion factor
conv_factor = ((*(*sPtr).mfoPtr)[3] eq 0)? 1.0 : (*sPtr).mev2wnos
switch dataType of
    ;; load sample files
    'samp': begin
        ;; clean up any previous sample data
        if ( ptr_valid((*sPtr).sDataPtr) ) then $
          fans_cleanDataPtrs, sPtr, 'samp'

        ;; load new sample file list
        widget_control, (*sPtr).sampID, set_value=fileList
        (*(*sPtr).sampListPtr) = lFileList
        (*sPtr).sampCount = count
        (*sPtr).sampIndex = 0

        ;; use sample filenames to create default output filename(s)
        ;; and store in sPtr
        defaultOutpFiles, sPtr, fileList

        ;; loop through files and read data
        tmparr=ptrarr(count)    ; create a pointer array - initialised to NULL!
        tmpPtr = 0 & i=0        ; tmpPtr will point to the FANS data later

        while (i lt count) do begin
            fans_readData, lFileList[i],tmpPtr,(*sPtr).nosActDets,conv_factor,err=err,emsg=emsg ; read the data file
            
            if (err ne 0) then return ; unsuccessful so no need to continue

            ;; fill the historyPtr
            history = ['Sample file(s): ', lFileList[i]]
            (*tmpPtr).historyPtr = ptr_new(history)

            tmparr[i] = tmpPtr  ; copy ptr to an array
            tmpPtr = 0          ; make tmpPtr an invalid ptr
            i = i+1
        end
        
        ;; move arr of ptrs to the heap 
        (*sPtr).sDataPtr = ptr_new(tmparr,/no_copy)
        
        break
    end

    ;; load bkgd files
    'bkgd': begin
        ;; clean up any previous bkgd data
        if ( ptr_valid((*sPtr).bDataPtr) ) then $
          fans_cleanDataPtrs, sPtr, 'bkgd'

        ;; load new sample file list
        widget_control, (*sPtr).bkgdID, set_value=fileList
        (*(*sPtr).bkgdListPtr) = lFileList
        (*sPtr).bkgdCount = count
        (*sPtr).bkgdIndex = 0

        ;; loop through files and read data
        tmparr=ptrarr(count)    ; create a pointer array - initialised to NULL!
        tmpPtr = 0 & i=0        ; tmpPtr will point to the FANS data later

        while (i lt count) do begin
            fans_readData, lFileList[i],tmpPtr,(*sPtr).nosActDets,conv_factor,err=err,emsg=emsg ; read the data file
            
            if (err ne 0) then return ; unsuccessful so no need to continue

            ;; fill the historyPtr
            history = ['Background file(s): ', lFileList[i]]
            (*tmpPtr).historyPtr = ptr_new(history)

            tmparr[i] = tmpPtr  ; copy ptr to an array
            tmpPtr = 0          ; make tmpPtr an invalid ptr
            i = i+1
        end
        
        ;; move arr of ptrs to the heap 
        (*sPtr).bDataPtr = ptr_new(tmparr,/no_copy)
  
        break
    end

    ;; load fast bkgd files
    'fast': begin
        ;; clean up any previous fast bkgd data
        if ( ptr_valid((*sPtr).fDataPtr) ) then $
          fans_cleanDataPtrs, sPtr, 'fast'

        ;; load new sample file list
        widget_control, (*sPtr).fastID, set_value=fileList
        (*(*sPtr).fastListPtr) = lFileList
        (*sPtr).fastCount = count
        (*sPtr).fastIndex = 0

        ;; loop through files and read data
        tmparr=ptrarr(count)    ; create a pointer array - initialised to NULL!
        tmpPtr = 0 & i=0        ; tmpPtr will point to the FANS data later

        while (i lt count) do begin
            fans_readData, lFileList[i],tmpPtr,(*sPtr).nosActDets,conv_factor,err=err,emsg=emsg ; read the data file
            
            if (err ne 0) then return ; unsuccessful so no need to continue

            ;; fill the historyPtr
            history = ['Fast Background file(s): ', lFileList[i]]
            (*tmpPtr).historyPtr = ptr_new(history)

            tmparr[i] = tmpPtr  ; copy ptr in an array
            tmpPtr = 0          ; make tmpPtr an invalid ptr
            i = i+1
        end
        
        ;; move arr of ptrs to the heap 
        (*sPtr).fDataPtr = ptr_new(tmparr,/no_copy)

        break
    end
endswitch

end
