;===============================================================================
;                                 RDTFR
;
; This file contains routines to read MDI high rate data files. 
;
; 1. RDTFR           - Returns image and header data from the specified 
;                      data set
; 2. GET_TF_REC      - Returns the "next" transfer frame, skipping to next file
;                      if necessary.
; 3. CLOSE_TFR       - Closes currently open ".tfr" file
; 4. GET_IMAGE_PARAM - Returns the dimensions and the number of pixels in the
;                      images for the specified data product code
; 5. MK_TFI          - Creats an index file for a data set
; 6. LIST_TFI        - Lists an index file.
;===============================================================================

;+
function get_image_param, dpc, nx, ny, npix
;
; Returns image dimensions and number of pixels from the data product code
;-
;
dpc_128x128 = 'FFFFFF15'XL  ; Data product code for a 128 x 128 image
dpc5_4x4 =    'FFFFFF01'XL  ; Data product code for a 4 x 4 summed image
dpc_256 =     'FFFFFF03'XL  ; Data product code for a 256 x 256 image
dpc_4x4 =     'FFFFFF02'XL  ; Data product code for a 4 x 4 image
dpc_1x1 =     'FFFFFF04'XL  ; Data Product Code for 1024X1024
dpc_vel =     'FFFFFF40'XL  ; Data Product Code for 1024X1024 Velocity
dpc_sqc =     'FFFFFF41'XL  ; Data Product Code for 1024X1024 SQCOMP (Continuum)
dpc_42 =      'FFFFFF42'XL  ; Data Product Code for i1-i3 raw
dpc_43 =      'FFFFFF43'XL  ; Data Product Code for i2=i4 raw
dpc_44 =      'FFFFFF44'XL  ; Data Product Code for raw continuum
;dpc_dsos =    'dsosmode'
dpc_dsos =    '10000000'XL


DataErr = 0

case dpc of
dpc5_4x4: begin
  nx = 256L
  ny = 256L
  npix =  nx * ny 
  endcase
dpc_256: begin
  nx = 256L
  ny = 256L
  npix = nx * ny
  endcase
dpc_vel: begin
  nx = 1024L
  ny = 1024L
  npix = nx * ny
  endcase
dpc_sqc: begin
  nx = 1024L
  ny = 1024L
  npix = nx * ny
  endcase
dpc_1x1: begin
  nx = 1024L
  ny = 1024L
  npix = nx * ny
  endcase
dpc_42: begin
  nx = 1040L
  ny = 1033L
  npix = nx * ny
  endcase
dpc_43: begin
  nx = 1040L
  ny = 1033L
  npix = nx * ny
  endcase
dpc_44: begin
  nx = 1040L
  ny = 1033L
  npix = nx * ny
  endcase
dpc_4x4: begin
  nx = 256L
  ny = 256L
  npix = nx * ny
  endcase
dpc_128x128: begin
  nx = 128L
  ny = 128L
  npix = nx * ny
  endcase
dpc_dsos: begin
  nx = 1040L
  ny = 1032L
  npix = nx * ny
  endcase
else: begin
  print,"Unknown data product code"
  DataErr=1 
  endcase
endcase

return, DataErr
end
;..............................................................................
;+
; function get_tf_rec, fname, filnum, recnum
;
; Purpose: To return the a record from a ".tfr" file.
;          
; Arguments: 
;    1. fname - Name of the tfr file, not including the file number of the 
;               extension. (INPUT)
;    2. filnum - File Number
;    3. recnum - record number in file.
;
;  This procedure can be used to read a set of tfr files as though they were a 
; a single file. The procedure procedure updates filnum and recnum after
; reading the specified record, opening the next file in the series if 
; necessary.  
;-
function get_tf_rec, fname, filnum, recnum

common getrec, tfr_rec, lun_tfr, nfiles, tfr_files   ; Save these between calls
common lf_common,last_filnum

if (filnum ne last_filnum ) then begin 		; if need to open a new file
  if (last_filnum ne 0 ) then close, lun_tfr	; close the previous file
  file_search_str = fname + '*.tfr'
  tfr_files = findfile (file_search_str, count=nfiles)
  if (nfiles eq 0) then return, -10
  tfr_name = tfr_files(filnum-1)
  openr, lun_tfr, tfr_name, get_lun = 1
  tfr_rec = assoc (lun_tfr, bytarr(1113))
endif

if (eof(lun_tfr)) then begin
  close, lun_tfr
  filnum = filnum + 1
  if (filnum gt nfiles) then begin
    filnum = filnum - 1
    free_lun, lun_tfr
    lun_tfr = -99
  endif else begin
    tfr_name = tfr_files(filnum-1)
    openr, lun_tfr, tfr_name
    recnum = 0
  endelse
endif

last_filnum = filnum
if (lun_tfr eq -99) then return, -1

tfr_blk = tfr_rec(recnum)
recnum = recnum + 1

return, tfr_blk


end
;..........................................................................


pro close_tfr

common getrec, tfr_rec, lun_tfr, nfiles, tfr_files

close, lun_tfr
free_lun, lun_tfr
lun_tfr = -99

return
end

;..........................................................................
;+
pro mk_tfi, fname
;
; PURPOSE: To create an index file for specified data set
;
; PARAMETERS: fname - Data set name
;
;-

;*** Check if specified data set exists and if so, 
;    the number of files in set.
file_search_str = fname + '*.tfr'
tfr_files = findfile (file_search_str, count=nfiles)
if (nfiles eq 0) then begin
    print, 'No files found'
    return
endif

;*** Set up assocate variable to read data
get_lun, lun_tfr
tfr_rec = assoc(lun_tfr, bytarr(1113))

;*** Open index file
openw, lun_tfi, fname + '.tfx', get_lun=1
tfi_rec = assoc(lun_tfi, intarr(16))
tfi_buf = intarr(16)

; Read all files. 
img_num = 0
last_ba = 0
img_data = 0

for filnum = 1, nfiles do begin
    filename = tfr_files(filnum - 1)
    print, filename
    openr, lun_tfr, filename
    i = 0
    while (not eof(lun_tfr)) do begin
        a = tfr_rec(i)
        ba = long(a,9) and '3fffff'x 
        if ((ba eq '373737'x) or (ba ne last_ba+549)) then begin
            if (img_data eq 1) then begin
                tfi_buf(3) = filnum
                tfi_buf(4) = i - 1
                tfi_rec(img_num) = tfi_buf
            endif
            img_data = 0       ; Image data flow off
        endif
        if (ba eq 0) then begin
            img_num = img_num + 1
            print, img_num, filnum, i, $
            format = '("Image # ",i3, " is in file ",i2, " at record # ", i6)' 
            dpc = long(a,520)
            print, dpc, format='(z10.10)'
            tfi_buf(0) = img_num
            tfi_buf(1) = filnum
            tfi_buf(2) = i
            tfi_buf(3) = 0
            tfi_buf(4) = 0
            tfi_buf(5) = 0
            tfi_buf(6) = fix(a, 520)
            tfi_buf(7) = fix(a, 522)
            tfi_buf(8) = fix(a, 0)
            tfi_buf(9) = fix(a, 2)
            tfi_rec(img_num) = tfi_buf
            img_data = 1      ; Image data flow on
        endif
        last_ba = ba
        i = i + 1
    endwhile

    close, lun_tfr
endfor

tfi_buf(0) = img_num
for i = 1, 15 do tfi_buf(i) = 0
tfi_rec(0) = tfi_buf
close, lun_tfr & free_lun, lun_tfr
close, lun_tfi & free_lun, lun_tfi

return
end
;
;..............................................................................
;+
pro list_tfi, fnam
;
; Procedure to list an index file
;-

;Check if the index files exists. If not create it.
tfi_name = fnam + '.tfx'
tfi_file = findfile (tfi_name, count=ntfi)
if (ntfi eq 0) then mk_tfi, fnam

openr, lun_tfi, tfi_name, get_lun = 1

rec = assoc(lun_tfi, intarr(16))
blk = intarr(16)
blk = rec(0)
nimg = blk(0)

for i = 1, nimg do begin
    blk = rec(i)
    print, blk(0:9), format = '(6i7, 2x, z8, z8, i10)'
endfor

end
;
;...............................................................................
;+
function nimg_in_tfr, fnam
;
; Returns number of images in a data set
;HISTORY:
;	17-Mar-94 (MDM) - Renamed from NUM_IMAGES to NIMG_IN_TFR
;			- Added a FREE_LUN call
;-
;Check if the index files exists. If not create it.
tfi_name = fnam + '.tfx'
tfi_file = findfile (tfi_name, count=ntfi)
if (ntfi eq 0) then mk_tfi, fnam

openr, lun_tfi, tfi_name, get_lun = 1

rec = assoc(lun_tfi, intarr(16))
blk = intarr(16)
blk = rec(0)
nimg = blk(0)

free_lun, lun_tfi
return, nimg
end
;
;...............................................................................
;
;+
pro rdtfr, fnam, img, hdr, timeblk, nimg=nimg, first=first, dpc=dpc 
;  This subroutine reads images from a 160k decom file and places the requested
;  images in caller's array.
;
;  Call:
;	fnam:	name of the decom file, without the file number or the .tfr extension.
;	img:	array for image data (will be dimensioned [x,y,nimg])
;       hdr:	array for headers (dimensioned [549,nimg])
;       nimg:	on INPUT specifies number of images: routine will then return 
;			only the first nimg images (or less if file ends sooner)
;		on OUTPUT has the actual number of images read
;		(optional parameter)
;       first:	optional parameter. Used it to specify the first image to be
;               extracted 
;       dpc:    The data product code to be extracted.
;
;  Method:
;       The "index" file is used to determine the file number and record number
;       where the first image begins. If the index file is not found, it is 
;       created using the MK_TFI procedure. Successive records are read, until
;       the entire image is read. The procedure is repeated if more than one image
;       is to be extracted, until the required number of images has been read.
;
;  NOTE:
;       The routine can be used repetitively to extract nimg images of a given type.
;       To use it repetitively, the nimg and the first keywords should be variable
;       names rather than values. The routine will update these variables upon exit.
;
;       If the DPC keyword is absent, the DPC code of the first image is selected.
;
;       The routine creates a temporary disk file to hold all the data for requested
;       images. This file is deleted when control is returned to the caller but the 
;       routine will fail if sufficient disk space is not available.
;-

common getrec, tfr_rec, lun_tfr, nfiles, tfr_files   ; Save these between calls
common lf_common,last_filnum

print,fnam
print, !stime
lun_tfr = -99
last_filnum = 0

;Check if the index files exists. If not create it.
tfi_name = fnam + '.tfx'
tfi_file = findfile (tfi_name, count=ntfi)
if (ntfi eq 0) then mk_tfi, fnam

;Open index file and assign an associate variable to read it.
openr, lun_tfi, fnam + '.tfx', get_lun=1
tfi_rec = assoc (lun_tfi, intarr(16))
tfi_blk = intarr(16)
tfi_blk = tfi_rec(0)
num_images = tfi_blk(0)
timeblk = lonarr(num_images)

;Initialize data structures
ccd_hdr = intarr(549)	; Buffer for CCD header block read
b = intarr(549)		; Buffer for data block read
tf_blk = bytarr(1113)

ip_sync = 'DBE128BD'XL
imno=0

;Check if keywords are set.
if (keyword_set(nimg) eq 0) then nimg = 32000
if (keyword_set(first) eq 0) then first_image = 1 $
else                              first_image = first
if (keyword_set(dpc) eq 0) then dpc_req = '10000000'xl $
else                            dpc_req = dpc

on_ioerror,finish

; Main Loop;
;     Data for each image requested is extracted and put into
;     a temporary file. 

last_image = first_image + nimg - 1
if (last_image gt num_images) then begin
    nimg = num_images - first_image + 1
    last_image = num_images
endif
image_num = first_image


imno = 0
while (image_num le last_image) do begin
    done = 0
    block_ct = 0L
    word_ct = 0L
    block_addr = 0L
    stop_addr = 0L
    idx = 0L
    temp = 0
    dsos_mode = 0
    block_size = 549L
    data_product_code = 0L
    n_full_blocks = 0L
    image_words = 0L
    part_block_words = 0L
    img_size = 0
    tfi_blk = tfi_rec(image_num)
    filnum = tfi_blk(1)
    recnum = tfi_blk(2)
    ;print, tfi_blk

    tf_blk = get_tf_rec (fnam, filnum, recnum)
    block_addr = long (tf_blk, 9) and '3fffff'x
    ;print,'ccd hdr blk adr: ', block_addr, recnum
    ccd_hdr = fix (tf_blk, 14, 549)
    timeblk(imno) = long(tfi_blk, 16)

    ip_sync_test = long(ccd_hdr,502)
    if ip_sync ne ip_sync_test then dsos_mode = 1
    ip_exec_ct = fix(ccd_hdr,510)
    ip_src_page = fix(ccd_hdr,512)
    ip_cksum = fix(ccd_hdr,554)	; byte addr 554

    extr=0

    if dsos_mode eq 1 then begin
        data_product_code = dpc_dsos
        extr=743
    endif $
    else data_product_code = long(ccd_hdr,506)
    print, data_product_code, format = '("DPC = ", z10)'

    if ((imno eq 0) and (keyword_set(dpc) eq 0)) then dpc_req = data_product_code

    if (data_product_code eq dpc_req) then begin
        DataErr=0

        DataErr = get_image_param(data_product_code, image_x, image_y, image_words)

        if (DataErr eq 0) then begin
            a = intarr (image_words)
            n_full_blocks = image_words / block_size
            part_block_words = image_words - (n_full_blocks * block_size)
;           print,done, image_words
;           Reading DATA BLOCKS...

            repeat begin
                tf_blk = get_tf_rec (fnam, filnum, recnum)
                block_addr = long (tf_blk, 9) and '3fffff'x
                ;print,block_addr, recnum,format='(2i10,$)'
                b = fix (tf_blk, 14, 549)
	        if word_ct+549 le image_words then a(word_ct) = b $
	        else begin
                    done = 1
                    stop_addr = image_words - word_ct - 2
;	            print,stop_addr,image_words,block_addr
                    a(word_ct) = b(0:stop_addr)
                endelse

                block_addr = block_addr + 549
                word_ct = word_ct + 549
                block_ct = block_ct + 1
            endrep until done eq 1

;           if dsos_mode eq 1 then begin
;               for block_addr=0L,118L do begin
;                   a(block_addr) = b(block_addr)
;               endfor
;           endif
  
            if imno gt 0 then begin
;               img=[img,a(extr:*)]
                imgrec(imno) = a(extr:*)
                hdr=[hdr,ccd_hdr] & endif $
            else begin
                s_time = string (systime(1), format='(d12.2)')
                tmp_file = getenv('MDI_TEMP_DIR') + '/img_' + s_time
                openw, lun_img, tmp_file, get_lun = 1
                image_size = image_words
                imgrec = assoc(lun_img, intarr(image_words))
                imgrec(imno)=a(extr:*)
                hdr=ccd_hdr
            endelse

            imno = imno + 1
            print, format='(".", $)'
        endif
    endif
    image_num = image_num + 1
endwhile



print, !stime

if (imno ne 0) then begin
    print, 'all data read'
    imgrec = assoc (lun_img, intarr(image_x, image_y, imno))
    img = imgrec(0)
    hdr = reform(hdr, block_size, nimg,/overwrite)
    close, lun_img
    free_lun, lun_img
    spawn, 'rm ' + tmp_file
endif

close, lun_tfi
free_lun, lun_tfi
close_tfr

if (keyword_set(first)) then begin
    print, first, nimg
    first = first + nimg                      ; Set starting image number to the "next" image
    if (first ge num_images) then first = 1
endif
timeblk = timeblk(0:imno-1)

return

finish: 
print, !err_string

end

;...............................................................................