FUNCTION smei_getfile, wanted_file, $

        nodialog= nodialog  , $
        usetime = usetime   , $
        exists  = exists    , $
        exact   = exact     , $

        camera  = camera    , $
        mode    = mode      , $
        count   = count     , $

        tt      = tt        , $
        source  = source    , $
        nodig   = nodig     , $

        science_mode     = science_mode     , $
        engineering_mode = engineering_mode , $
        smoothdark       = smoothdark       , $
        prefer_smoothdark= prefer_smoothdark, $
        chronological    = chronological    , $

        get_hdr = get_hdr   , $
        hdr     = hdr       , $
        get_map = get_map   , $
        map     = map       , $

        silent  = silent    , $

        ramdisk = ramdisk   , $
        ls_corrupt=ls_corrupt,$
        rm_corrupt=rm_corrupt
    @compile_opt.pro        ; On error, return to caller

InitVar, silent  , 0
InitVar, nodialog, /key
InitVar, exact   , /key

InitVar, science_mode    , /key
InitVar, engineering_mode, /key
InitVar, smoothdark      , /key
InitVar, chronological   , /key
InitVar, prefer_smoothdark, /key

uday = TimeUnit(/day)
usec = TimeUnit(/sec)
umin = TimeUnit(/min)

; Default source is SMEI database

InitVar, source , 'SMEIDB?'
InitVar, nodig  , /key
nodig AND= source[0] NE 'SMEIDB?'

InitVar, wanted_file, '*.fts.gz'

ff = wanted_file

; /usetime and /exists only make sense for string ff

InitVar, usetime, /key
usetime AND= IsType(ff,/string)

InitVar, exists, 0
exists  AND= IsType(ff,/string)

usetime OR= exists      ; /exists implies /usetime
assuming_ut = 0

; Do not take a closer look at time structures
; or strings containing file names (with /usetime set)

IF NOT IsTime(ff) AND NOT usetime THEN BEGIN

    ; ff could be:
    ; - string with wildcard in it
    ; - strings containing chars and numbers (filenames)
    ; - numeric (orbit numbers)
    ; - strings containing numbers only (orbit numbers)
    ; - strings containing valid times
    ; - orbit structures

    ; The first two are translated to fully-qualified filenames
    ; for existing files (using dialog_pickfile or file_search).
    ; Everything else is translated to time structures.

    ; Check for a scalar or 1-element array wildcard spec.
    ; This will lead to a selection with dialog_pickfile
    ; or file_search

    wildcard = IsType(ff, /string)

    IF wildcard THEN BEGIN

        ; Check for the presence of wildcard if input_map is
        ; a single scalar string

        wildcard = n_elements(ff) EQ 1

        IF wildcard THEN BEGIN
            ff = ff[0]
            wildcard = strpos(ff, '*') NE -1 OR $
                       strpos(ff, '?') NE -1 OR $
                       strpos(ff, '%') NE -1
        ENDIF

    ENDIF

    IF NOT wildcard THEN BEGIN

        IF IsType(ff,/string) THEN BEGIN

            ; Special case: check for a string array or scalar
            ; with each string containing a single number,
            ; which is interpreted as an orbit number.

            time = flt_string(ff, strcrumbs=tmp, /double)

            IF IsType(tmp,/undefined) THEN BEGIN    ; Only numeric chars
                IF IsType(time,/scalar) OR (size(time,/dim))[0] EQ 1 THEN BEGIN
                    IF (where(1-finite(time)))[0] EQ -1 THEN BEGIN
                        IF silent LE 1 THEN message, /info, 'assuming orbit numbers'
                        ff = TimeSet(smei=time); Orbit nrs converted to time
                    ENDIF
                ENDIF
            ENDIF

        ENDIF

        IF IsType(ff,/string) THEN BEGIN

            ; Special case: check for a string array
            ; containing valid times

            IF !idl_mode THEN BEGIN
                catch, error
                IF error EQ 0 THEN time = TimeSet(ff)
                catch, /cancel
            ENDIF ELSE BEGIN
                error = 1
            ENDELSE

            IF error EQ 0 THEN BEGIN
                IF silent LE 1 THEN message, /info, 'assuming UT times'
                assuming_ut = 1
                ff = time                   ; Time structure
            ENDIF

        ENDIF

        ; Numerical input (i.e. orbit numbers) and orbit structures are
        ; intercepted here and converted to time.

        IF NOT IsType(ff, /string) AND NOT IsTime(ff) THEN $
            ff = TimeSet(smei=ff)

    ENDIF

    ; At this point ff is a string (scalar or array) or
    ; a time structure.
    ; If it is a string, then it probably is a file spec
    ; (with or without a wildcard in it).

    IF IsType(ff, /string) THEN BEGIN

        CASE wildcard OF

        0: BEGIN

            ; If no wildcard present then the input must be
            ; one or more file names.

            FOR i=0,n_elements(ff)-1 DO BEGIN
                tmp = (file_search(ff[i]))[0]
                IF tmp EQ '' AND GetFileSpec(ff[i], upto='dir') EQ '' THEN BEGIN
                    ff[i] = (file_search(filepath(root=smei_filepath(ff[i],source=source),ff[i])))[0]
                ENDIF ELSE  $
                    ff[i] = tmp
            ENDFOR

            tmp = where(ff NE '')
            IF tmp[0] EQ -1 THEN ff = '' ELSE ff = ff[tmp]

        END

        1: BEGIN                ; Pick up multiple files
                                ; with dialog_pickfile or file_search
            CASE 1 OF
            nodig                   : tmp = smei_filepath(source=source)
            n_elements(mode  ) GT 1 : tmp = smei_filepath(source=source)
            n_elements(camera) GT 1 : tmp = smei_filepath(source=source, mode=mode)
            ELSE                    : tmp = smei_filepath(source=source, mode=mode, camera=camera)
            ENDCASE

            CASE nodialog OF
            0: BEGIN
                ff = dialog_pickfile(path=tmp,filter=ff,/multiple)
                IF n_elements(ff) EQ 1 THEN IF CheckDir(ff[0],/silent) THEN ff = ''
            END
            1: BEGIN

                IF IsType(mode,/string) AND n_elements(camera) EQ 1 THEN BEGIN
                    CASE 1 OF
                    smoothdark      : tmp += 's'
                    science_mode    :
                    engineering_mode: tmp += 'm0'
                    ELSE            : tmp += ['','s','m0']
                    ENDCASE
                ENDIF

                ff = FindAllFiles(ff, path=tmp, /nodir)
                ;ff = file_search(filepath(root=tmp,ff))
            END
            ENDCASE

        END

        ENDCASE

        CASE ff[0] NE '' OF
        0: BEGIN
            IF silent LE 0 THEN BEGIN
                CASE nodialog OF
                0: message, /info, 'no files selected'
                1: BEGIN
                    FOR i=0,n_elements(tmp)-1 DO tmp[i] = hide_env(tmp[i])
                    message, /info, 'no files selected from '+strjoin(tmp,',')
                END
                ENDCASE
            ENDIF
            count = 0
        END
        1: count = n_elements(ff)
        ENDCASE

        exists = n_elements(camera) LE 1 OR count EQ 0
        ;exists = 1

    ENDIF

ENDIF

; input file now contains:
; - strings with file names. The files:
;   * either definitely exist (files_exist=1, either by
;     input or by selection using file_search/dialog_pickfile)
;     These are read immediately
;   * or potentially exist (no_search=1 on input)
;     For these the times, modes and cameras are extracted,
;     and are then treated as if the times were input. 
; - time structures (either by direct input, or by translation)


; If exists = 1 then skip to read section

CASE exists OF

0: BEGIN

    CASE 1 OF

    IsType(ff, /string): BEGIN; List of file names

        ff = smei_filename(ff,camera=camera_,mode=mode_,dir=full_dir)

        InitVar, camera, camera_[unique_only(camera_)] 
        InitVar, mode  , mode_  [unique_only(mode_  )]

        ; If an explicit directory is specified then store it here
        ; in full_dir, and switch to /exact.

        exact OR= max(strlen(full_dir)) GT 0

        IF n_elements(full_dir) EQ 1 AND n_elements(camera) GT 1 AND IsType(mode_,/string) THEN BEGIN
            tmp = strpos(full_dir,mode_+os_separator(/dir)+'c'+strcompress(camera_,/rem))
            IF tmp NE -1 THEN BEGIN
                source = strmid(full_dir,0,tmp)
                destroyvar, full_dir
            ENDIF
        ENDIF
    END

    IsTime(ff): BEGIN       ; List of times

        InitVar, camera, [1,2,3]
        InitVar, mode  , [0,1,2]

    END

    ENDCASE

    skymaps = IsType(mode, /string)
    ccdfrms = 1-skymaps

    IF skymaps AND exact AND assuming_ut THEN   $
        ff = TimeSet(smei=smei_orbit_get(TimeGet(/smei,ff),/round))

    input_time = ff 
    destroyvar, ff

    ncams = n_elements(camera)
    nmods = n_elements(mode  )
    ntime = n_elements(input_time)

    ; A time range is extracted unless /exact is set

    ; If only one time is specified and /exact is not set then
    ; change to time range that should include at least one frame/skymap.

    CASE exact OF

    0: BEGIN

        IF ntime EQ 1 THEN BEGIN

            CASE skymaps OF
            0: tmp = 2
            1: tmp = TimeGet(smei_coriolis(input_time[0],/orbital_period),usec,/full,/scalar)/2
            ENDCASE

            input_time = TimeOp(/add, input_time, TimeSet(sec=tmp*[-1,1]))

        ENDIF

        time_range = TimeLimits(input_time, /bounds)

        t0    = TimeGet(time_range[0], /bot, uday)
        tmp   = TimeGet(time_range[1], /bot, uday)
        ndays = TimeOp(/subtract,tmp,t0,uday)+(TimeOp(/subtract,tmp,time_range[1],usec) NE 0)

        count = 0

        FOR iday=0L,(ndays-1)*ccdfrms DO BEGIN      ; Loop over all requested days (only 1 day for skymaps)

            FOR icam=0,ncams-1 DO BEGIN             ; Loop over all requested cameras

                FOR imod=0,(nmods-1)*skymaps DO BEGIN; Loop over all modes (only one mode for frames)

                    ; For CCD frames 'mode' is not used
                    ; For skymaps the time is not used

                    tmp = smei_filepath(source=source,mode=mode[imod],camera=camera[icam],TimeOp(/add, t0,TimeSet(/diff,iday,uday)))
                    IF silent LE 1 THEN message, /info, 'from '+hide_env(tmp)
                    IF skymaps THEN BEGIN
                        CASE 1 OF
                        smoothdark      : tmp += 's'
                        science_mode    :
                        engineering_mode: tmp += 'm0'
                        ELSE            : tmp += ['','s','m0']
                        ENDCASE
                    ENDIF

                    tmp = FindAllFiles('', path=tmp, count=cnt, /nodir)

                    IF skymaps AND prefer_smoothdark THEN BEGIN
                        i = GetFileSpec(GetFileSpec(tmp,upto='DIR',/asfilename),part='NAME')
                        j = 'c'+strcompress(camera[icam],/rem)
                        is_c3s = where(i EQ j+'s')
                        no_c3s = where(i EQ j    )
                        IF is_c3s[0] NE -1 AND no_c3s[0] NE -1 THEN BEGIN
                            i = where_common( GetFileSpec(tmp[no_c3s],part='NAME',/strict),GetFileSpec(tmp[is_c3s],part='NAME',/strict) )
                            IF i[0] NE -1 THEN BEGIN
                                i = no_c3s[i]
                                i = where_common(indgen(cnt),i,absent=j)
                                tmp = tmp[j]
                                cnt = n_elements(tmp)
                            ENDIF 
                        ENDIF
                    ENDIF

                    IF cnt NE 0 THEN BEGIN
                        tt = timeposn(tmp, /extract, part='name')

                        CASE n_elements(input_time) EQ 2 OF
                        0: i = where_common( TimeOp(/subtract,tt                             ,time_range[0],usec),  $
                                             TimeOp(/subtract,TimeGet(input_time,usec,/round),time_range[0],usec), count=cnt )
                        1: i = where( TimeOp(/subtract,tt,time_range[0],usec) GE 0 AND      $
                                      TimeOp(/subtract,tt,time_range[1],usec) LE 0, cnt )
                        ENDCASE

                        count += cnt
                        IF cnt NE 0 THEN boost, ff, tmp[i]
                    ENDIF

                ENDFOR

            ENDFOR

        ENDFOR
    
        IF silent LE 1 THEN IF count EQ 0 THEN $
            message, /info, 'no files in '+hide_env(smei_filepath(source=source,t0, /base))+    $
                ' ['+strjoin(TimeGet(/string, /_ydoy, time_range, upto=usec), '->')+']'

    END

    1: BEGIN

        ; Since we are trying to match SMEI files, round to nearest sec
        ; (file names do not contain msec)

        input_time = TimeGet(input_time,usec,/round)

        time_range = TimeLimits(input_time, /bounds)
        t0 = TimeGet(time_range[0], /bot, uday)

        count = 0

        nsource = n_elements(source)

        FOR icam=0,ncams-1 DO BEGIN

            IF nsource EQ ncams THEN the_source = source[icam] ELSE the_source = source

            FOR imod=0,(nmods-1)*skymaps DO BEGIN

                FOR itim=0L,ntime-1 DO BEGIN

                    IF nsource EQ ntime THEN the_source = source[itim] ELSE the_source = source

                    CASE nodig OF
                    0: BEGIN
                        path = ''
                        IF IsType(full_dir,/defined) THEN IF full_dir[itim] NE '' THEN path = full_dir[itim]

                        ; For CCD frames 'mode' is not used
                        ; For skymaps the time is not used

                        IF path EQ '' THEN  $ 
                            path = smei_filepath(source=the_source,mode=mode[imod],camera=camera[icam],input_time[itim])

                        IF skymaps THEN BEGIN
                            CASE 1 OF
                            smoothdark      : path += 's'
                            science_mode    :
                            engineering_mode: path += 'm0'
                            ELSE            : path += ['','s','m0']
                            ENDCASE
                        ENDIF
                    END
                    1: path = source
                    ENDCASE

                    tmp = FindAllFiles( $
                        smei_filename(input_time[itim], camera=camera[icam], mode='*', type='.*'),  $
                        path=path, count=cnt, /nodir)

                    IF skymaps AND prefer_smoothdark THEN BEGIN
                        i = GetFileSpec(GetFileSpec(tmp,upto='DIR',/asfilename),part='NAME')
                        j = 'c'+strcompress(camera[icam],/rem)
                        is_c3s = where(i EQ j+'s')
                        no_c3s = where(i EQ j    )
                        IF is_c3s[0] NE -1 AND no_c3s[0] NE -1 THEN BEGIN
                            i = where_common( GetFileSpec(tmp[no_c3s],part='NAME',/strict),GetFileSpec(tmp[is_c3s],part='NAME',/strict) )
                            IF i[0] NE -1 THEN BEGIN
                                i = no_c3s[i]
                                i = where_common(indgen(cnt),i,absent=j)
                                tmp = tmp[j]
                                cnt = n_elements(tmp)
                            ENDIF 
                        ENDIF
                    ENDIF

                    count += cnt
                    IF cnt NE 0 THEN boost, ff, tmp

                ENDFOR

                IF silent LE 1 AND count EQ 0 THEN BEGIN

                    CASE nodig OF
                    0: BEGIN
                        CASE ntime NE 1 OF
                        0: message, /info, 'no exact matches in '+hide_env( $
                            smei_filepath(source=the_source,mode=mode[imod],camera=camera[icam],t0) $
                            )+' @ '+TimeGet(/string, /_ydoy, time_range[0], upto=usec)
                        1: message, /info, 'no exact matches in '+hide_env( $
                            smei_filepath(source=the_source,mode=mode[imod],camera=camera[icam],t0) $
                            )+' ['+strjoin(TimeGet(/string, /_ydoy, time_range, upto=usec), '->')+']'
                        ENDCASE
                    END
                    1: BEGIN
                        CASE ntime NE 1 OF
                        0: message, /info, 'no exact matches in '+hide_env(source)+ $
                            ' @ '+TimeGet(/string, /_ydoy, time_range[0], upto=usec)
                        1: message, /info, 'no exact matches in '+hide_env(source)+ $
                            ' ['+strjoin(TimeGet(/string, /_ydoy, time_range, upto=usec), '->')+']'
                        ENDCASE
                    END
                    ENDCASE

                ENDIF

            ENDFOR

        ENDFOR

    END

    ENDCASE


    ; The mode is coded into the file name for all files, so do mode
    ; selection here. This avoids reading the header to retrieve the mode.

    IF count NE 0 THEN BEGIN

        tmp = smei_filename(ff,mode=modes)
        tmp = where_common(modes, mode, count=count)
        IF count EQ 0 THEN ff = ''  ELSE ff = ff[tmp]   ; Retain only selected modes

    ENDIF

END

1: BEGIN

    IF ff[0] EQ '' THEN count = 0 ELSE count = n_elements(ff)

    IF count NE 0 THEN BEGIN
        tmp = smei_filename(ff,mode=mode_)
        skymaps = IsType(mode_,/string)
    ENDIF

END

ENDCASE



; The read section

InitVar, get_hdr, /key
InitVar, get_map, /key

need_hdr = arg_present(hdr) OR get_hdr
need_map = arg_present(map) OR get_map

CASE count EQ 0 OF

0: BEGIN

    ;ff = ff[sort(ff)]
    tt = timeposn(ff,/extract,part='name')

    IF chronological THEN BEGIN
        i  = sort( TimeGet(tt,/_ydoy) )
        ff = ff[i]
        tt = tt[i]
    ENDIF

    ; At this point ff contains a list of fully-qualified filenames

    IF need_hdr OR need_map THEN BEGIN

        IF need_hdr THEN BEGIN
            CASE skymaps OF
            0: hdr = replicate({smei_frm_hdr},count)
            1: hdr = replicate({smei_sky_hdr},count)
            ENDCASE
        ENDIF

        IF need_map THEN BEGIN
            IF IsType(map, /pointer) THEN ptr_free, map
            map = ptrarr(count, /allocate_heap)
        ENDIF

        IF silent LE 1 THEN message, /info, 'read'+strcompress(count)+' files'

        tlaps = TimeSystem(/silent)

        FOR i=0L,count-1 DO BEGIN

            IF silent LE 0 THEN IF i mod 1000 EQ 999 THEN print, hide_env(ff[i]), i+1, count

            CASE skymaps OF
            0: imgi = smei_frm_read(ff[i], hdr=hdri, /silent, nodata=1-need_map,    $
                ramdisk=ramdisk, ls_corrupt=ls_corrupt, rm_corrupt=rm_corrupt)
            1: imgi = smei_sky_read(ff[i], hdr=hdri, /silent, _extra=_extra)
            ENDCASE

            IF need_hdr THEN  hdr[i] = hdri
            IF need_map THEN *map[i] = imgi

        ENDFOR

        IF silent LE 1 THEN BEGIN
            tmp = TimeOp(/subtract, TimeSystem(/silent), tlaps, umin)
            IF tmp GT 0 THEN    $
                message, /info, strcompress(tmp,/rem)+' minutes ('+ $
                    strcompress(tmp*60000.0/count,/rem)+' msec/frame)'
        ENDIF

    ENDIF

END

1: BEGIN

    ff = ''
    tt = -1

    IF need_hdr THEN hdr = -1
    IF need_map THEN BEGIN
        IF IsType(map,/pointer) THEN ptr_free, map
        map = -1
    ENDIF

END

ENDCASE

CASE 1 OF
get_hdr : ff = hdr
get_map : ff = map
ELSE    : IF count EQ 1 THEN ff = ff[0]
ENDCASE

RETURN, ff  &  END