pro sxt_prep, input1, input2, index_out, data_out, unc_data, satpix, $
;
;------------------------- Calibration parameters
nocorrections=nocorrections, $
second_order_leak=second_order_leak, noleak=noleak, $
dc_scalar=dc_scalar, dc_interpolate=dc_interpolate, $
dc_orbit_correct=dc_orbit_correct, $
no_dc_orbit_correct=no_dc_orbit_correct, $
upper_only=upper_only, $
sfd_corr=sfd_corr, $
rest_low8=rest_low8, $
;
;------------------------- Alignment parameters
register=register, fast=fast, $
ref_image=ref_image, $
helio=helio, date_helio=date_helio, $
suncoord=suncoord, $
ccdcoord=ccdcoord, $
outres=outres, outsize=outsize, $
st_en_lin = st_en_lin, $
fill_gap=fill_gap, trim_edge=trim_edge, $
noroll=noroll, roll_do=roll_do, $
cubic=cubic, interp=interp, $
oride_pnt_chk=oride_pnt_chk, $
;
;------------------------- Secondary processing parameters
exp_normalize=exp_normalize, normalize=normalize, $
sum=sum, $
vignette_cor=vignette_cor, $
despike_thresh=despike_thresh, width=width, $
sigma_filt=sigma_filt, n_sigma=n_sigma, sigma_iterate=sigma_iterate, $
sxt_kleenx=sxt_kleenx, sxt_cleanx=sxt_cleanx, destreak=destreak, $
;
;------------------------- Miscellaneous
float=float, $
force_read=force_read, outfile=outfil, append=append, $
allow_duplicates=allow_duplicates, $
new_sdc_db=new_sdc_db, new_sfc_db=new_sfc_db, $
error=error, $
run_time=run_time, $
override=override, $
qdebug=qdebug, qstop=qstop, qmstop=qmstop, q2stop=q2stop, help=help,$
suture=suture, verbose=verbose, loud=loud
common sxt_prep_com1,called_already
first_call=n_elements(called_already) eq 0
progverno = 1.72*1000
if first_call then $
print, ' ***** SXT_PREP Ver 1.65 6-March-2003 *****
;
if (keyword_set(help)) then begin ;MDM added 20-Mar-95
help_file = concat_dir('$DIR_SXT_DOC', 'sxt_prep.txt')
if (file_exist(help_file)) then begin
help = rd_tfile(help_file)
prstr, help
end else begin
print, 'The help file: ' + help_file + ' is not available. Sorry...'
end
print, 'Returning...
return
end
loud=keyword_set(loud) or keyword_set(verbose)
if first_call then begin
box_message,'Suppressing old and useless messages; use /LOUD to see those'
called_already=1
endif
;
;------------------------------------------------------------------------------
; Variable initialization and help information
;------------------------------------------------------------------------------
;
if (keyword_set(helio)+keyword_set(suncoord)+keyword_set(ccdcoord) ge 2) then begin ;MDM added 25-Jul-94
print, 'SXT_PREP: More than one of the following keywords was used'
print, ' SUNCOORD, HELIO, CCDCOORD
print, 'Returning ...
tbeep, 3
return
end
;
append=keyword_set(append)
start_time = systime(1)
run_time = 0.
error = 0
data_out = 0
index_out = 0
sat_limit = [235, 255, 255] ; Full, half, quarter resolution
;
his_index, /enable
suture=keyword_set(suture)
quncert = n_params() ge 5 or suture ; required for sxt_suture
qsatpix = n_params() ge 6 or suture ; required for sxt_suture
qoutfil = n_elements(outfil) ne 0
qroll = keyword_set(roll_do) or keyword_set(interp) or keyword_set(cubic)
if (keyword_set(noroll)) then qroll = 0
qreg = keyword_set(register) or keyword_set(helio) or keyword_set(suncoord) or $
keyword_set(ref_image) or keyword_set(fast) or keyword_set(qroll) or keyword_set(ccdcoord)
qcor = 1-keyword_set(nocorrections)
qsfd = keyword_set(sfd_corr)
qnorm = keyword_set(exp_normalize) or keyword_set(normalize)
qsum = keyword_set(sum)
qfill_gap = keyword_set(fill_gap) or keyword_set(trim_edge)
if (qsfd) then qcor = 0 ;don't do normal corrections if doing SFD corrections
qvig = keyword_set(vignette_cor)
qdespike= keyword_set(despike_thresh)
qsig_filt=keyword_set(sigma_filt)
qsxt_kleen=keyword_set(sxt_kleenx)
destreak=keyword_set(destreak)
qsxt_clean=keyword_set(sxt_cleanx) or destreak or qsxt_kleen
qlow8 = keyword_set(rest_low8)
if (qroll) and (keyword_set(ccdcoord)) then begin ;MDM added 22-Jun-95
print, 'SXT_PREP: Sorry, you cannot apply roll correction with CCDCOORD option.
print, ' Continuing without applying roll correction
qroll = 0
end
;
if (qcor and (n_elements(dc_interpolate) eq 0) and (not keyword_set(dc_scalar)))and loud then begin ;MDM added 20-Mar-95
print, '--------------------------------------------------------------'
print, ' The /DC_INTERPOLATE option is strongly recommended '
print, ' SXT_PREP is setting this option automatically '
print, ' Use "DC_INTERPOLATE=0 to disable dark current interpolation '
print, '--------------------------------------------------------------'
dc_interpolate = 1
end
;
if (keyword_set(oride_pnt_chk)) then set_logenv, 'YS_ORIDE_PNT_CHK', '1'
;
if (n_params() LT 2) then begin
print, 'SXT_PREP Sample Calling Sequences:
print, ' sxt_prep, input1, input2, index_out, data_out
print, ' sxt_prep, index, data, index_out, data_out
print, ' sxt_prep, infil, dset_arr, index_out, data_out, $
print, ' helio=[-9.8,-20.3], date_helio=''14-JUN-92 02:37:41'')
print, ' sxt_prep, index, data, index_out, data_out, $
print, ' /helio, ref_image=index(0))
print, ' sxt_prep, index, data, index_out, data_out, ref_image=spr_index(0))
end
;
ARCSEC_PER_PIX = gt_pix_size()
;
;------------------------------------------------------------------------------
; Figure out how the input images are specified
;------------------------------------------------------------------------------
;
if ((n_elements(input1) eq 0) or (n_elements(input2) eq 0) ) then begin
message, 'First two parameters Undefined. Must be INDEX,DATA or INFIL,DSET_ARR', /info
error = 1
return
end
;
typ_in = -99
siz = size(input1) & typ1 = siz( siz(0)+1 )
siz = size(input2) & typ2 = siz( siz(0)+1 )
;
case typ1 of
7: begin ;string type
qread = 1
quse_input2 = 0
infil = input1
dset_arr = input2
dset = mk_dset_str(infil, dset_arr)
rd_xda, infil, dset, index, /nodata ;read the index for all input images
end
8: begin ;structure type
qread = 0
quse_input2 = 1
index = input1
end
else: begin
message, 'Error in input data types', /info
message, 'First two parameters must be INDEX,DATA or INFIL,DSET_ARR', /info
error = 2
return
end
endcase
;
if (typ2 ge 6) then begin ;complex, string, or structure
message, 'Error in input data types', /info
message, 'First two parameters must be INDEX,DATA or INFIL,DSET_ARR', /info
error = 2
return
end
;
;------------------------------------------------------------------------------
; Check to see if all resolutions are the same if using /NOCORRECTIONS (MDM added 25-Feb-94)
;------------------------------------------------------------------------------
;
if (keyword_set(nocorrections)) then begin
resarr = gt_res(index)
if (min(resarr) ne max(resarr)) then begin
print, 'SXT_PREP: Sorry, all input images must be the same resolution
print, ' when using the /NOCORRECTIONS option'
;MOD_RES crashes otherwise - fix there if you are going to remove this requirement
return
end
outres = min(resarr)
end
;------------------------------------------------------------------------------
; Figure out the mixture of FFI and PFI
;------------------------------------------------------------------------------
;
n = n_elements(index)
;pfi_ffi = gt_pfi_ffi(index, /true_ffi) ;returns 1 for true FFI, 0 for PFI/OR/Extracted PFI
pfi_ffi = gt_pfi_ffi(index) ;returns 1 for FFI
ss_pfi = where(pfi_ffi eq 0, npfi)
ss_ffi = where(pfi_ffi eq 1, nffi)
fcode = (npfi ne 0) + (nffi ne 0)*2 ;1 = PFI only
;2 = FFI only
;3 = PFI/FFI mixed
if (keyword_set(qdebug)) then print, 'FCODE = ', fcode
;------------------------------------------------------------------------------
; Figure out the output resolution (MDM added 20-Mar-95)
;------------------------------------------------------------------------------
if (n_elements(outres) eq 0) then begin
if (n_elements(outsize) eq 0) and (fcode eq 2) then outres = min(gt_res(index)) $
else outres = 0
end
;------------------------------------------------------------------------------
; Figure out the output image size
;------------------------------------------------------------------------------
;
case n_elements(outsize) of
0: begin
;call something like mk_mosaic to get size - TODO
if (fcode eq 3) then ss = ss_pfi else ss = lindgen(n)
if (qreg) then begin
nx = max(gt_shape(index(ss), /x, /obs_reg) * 2^gt_res(index(ss))) / 2^outres
ny = max(gt_shape(index(ss), /y, /obs_reg) * 2^gt_res(index(ss))) / 2^outres
if ((fcode eq 2) and keyword_set(helio)) then begin ;MDM added 9-Dec-93
nx = 128 < max(gt_shape(index(ss), /x, /obs_reg) * 2^gt_res(index(ss))) / 2^outres ;MDM added < conditional 25-Feb-94
ny = 128 < max(gt_shape(index(ss), /y, /obs_reg) * 2^gt_res(index(ss))) / 2^outres
end
end else begin
nx = max(gt_shape(index(ss), /x, /obs_reg))
ny = max(gt_shape(index(ss), /y, /obs_reg))
end
end
1: begin
nx = outsize
ny = outsize
end
else: begin
nx = outsize(0)
ny = outsize(1)
end
endcase
;
;------------------------------------------------------------------------------
; Define the output variables
;------------------------------------------------------------------------------
;
if (keyword_set(new_sdc_db)) then set_new_db, new_sdc_db ;MDM added 18-May-95
if (keyword_set(new_sfc_db)) then set_new_db, new_sfc_db, /leak
;
ss = uniqo(index.sxt.serial_num)
ser_map = index(ss).sxt.serial_num
if (keyword_set(allow_duplicates)) then begin
ser_map = lindgen(n_elements(index)) ;MDM added 18-May-95
ss = lindgen(n_elements(index))
end
nout = n_elements(ser_map)
if (qoutfil) then nout = 1
;
index_out = index(ss) ;just defining the output array
his_index, index_out ;append on the .HIS structure
;
typout = 1 ;default is byte type out
if (qread eq 0) then begin
siz = size(input2)
typ_in = siz( siz(0)+1 )
typout = typ_in
if (typout gt 1) and (not qlow8) then begin
if loud then begin
tbeep
message, 'Input data is non-Byte type. ', /info
message, 'DECOMP/DARK_SUB/LEAK_SUB will not be called', /info
endif
if (quncert) then message, 'Uncertainty array will not be created', /info
if (qsatpix) then message, 'Saturated pixel array will not be created', /info
qcor = 0
quncert = 0
qsatpix = 0
end
end
if (not keyword_set(nocorrections)) then typout = typout>2 ;decompressed = integer*2 type
if (qlow8) then typout = 2
if (qnorm) then typout = 4
if (keyword_set(float)) then typout = 4 ;MDM 20-Mar-95
if (qsfd) then typout = 1 ;MDM added 19-Nov-93
;
data_out = make_array(nx, ny, nout, type=typout)
if (quncert) then unc_data = make_array(nx, ny, nout, type=2) ;always int
if (qsatpix) then satpix = make_array(nx, ny, nout, type=1) ;always byte
if (quncert and qnorm) then unc_data = float(unc_data) ;MDM added 6-Mar-95
;
nstrip = max( gt_or_expnum(index) )
st_en_lin = intarr(2, nstrip, nout) ;start/end line number where each PFI strip is inserted into the output array
;
;------------------------------------------------------------------------------
; Initialization of the alignment information
;------------------------------------------------------------------------------
;
if (qreg) then begin
align_prep, index, xx, yy, sc, code, $
ref_image=ref_image, $
helio=helio, date_helio=date_helio, $
suncoord=suncoord, $
ccdcoord=ccdcoord, $
qroll=qroll, $
roll=roll_arr, $
qdebug=qdebug, qstop=qstop
end else begin
if (qroll) then roll_arr = get_roll(index) ;MDM added 31-Mar-94
end
;------------------------------------------------------------------------------
; Optionally read all datasets even if input is INFIL/DSET
;------------------------------------------------------------------------------
;
nbytes = total(gt_shape(index,/x) * long(gt_shape(index,/y)))/1e+6 ;MDM 9-Dec-93 - force read only if < 4 meg
if ((qread) and (fcode eq 1) and (nbytes lt 4)) then force_read = 1 ;MDM 19-Aug-93
if (keyword_set(force_read)) then begin
print, 'Reading all selected data from the input SPR files'
rd_xda, infil, dset, index, data, roadmap
qread = 0
quse_input2 = 0
end
;
;------------------------------------------------------------------------------
; Optionally restore low-8 data
;------------------------------------------------------------------------------
;
if (qlow8) then begin
ss88 = where(gt_comp(index) eq 0, nn88)
if (nn88 eq 0) then begin
print, 'SXT_PREP: You asked for restoring low-8, but did not
print, ' pass in a compressed image. Please retry.
print, ' Returning.........
return
end
;
if (qread eq 1) then begin
print, 'SXT_PREP: You asked for restoring low-8, but did not
print, ' pass in data. You cannot use INFIL option
print, ' Returning.........
return
end
;
if (quse_input2) then begin
data = rest_low8_cube(index, input2)
quse_input2 = 0
end else begin
data = rest_low8_cube(index, data)
end
end
;
;------------------------------------------------------------------------------
; If reading outside the loop, optionally call LEAK_SUB
;------------------------------------------------------------------------------
;
if (qread eq 0) then begin
if (quse_input2) then begin
if (quncert) then udata = sxt_decomp(input2, /uncert) else udata = 0 ;jmm, 18-Jan-95
if (qsatpix) then sdata = sxt_satpix(index, input2, sat_limit=sat_limit, upper_only=upper_only)
if (qcor) then begin ;jmm, 12-feb-95
udata_out = quncert ;this must be set for LEAK_SUB to pass out uncertainties
data = leak_sub(index, input2, index_out_qr, dc_interpolate = dc_interpolate, $
dc_scalar = dc_scalar, udata_in = udata, udata_out = udata_out, $
float=float, force_darksub=qlow8, $
noleak=noleak, orbit_correct=dc_orbit_correct)
;, second_order=second_order_leak) LWA 1/10/04
if (quncert) then udata = udata_out ;jmm, 12-feb-95, reset udata to the DARK_SUB value
end
end else begin
if (quncert) then udata = sxt_decomp(data, /uncert) else udata = 0 ;jmm, 18-Jan-95
if (qsatpix) then sdata = sxt_satpix(index, data, sat_limit=sat_limit, upper_only=upper_only)
if (qcor) then begin ;jmm, 12-feb-95
udata_out = quncert ;this must be set for LEAK_SUB to pass out uncertainties
data = leak_sub(index, data, index_out_qr, dc_interpolate = dc_interpolate, $
dc_scalar = dc_scalar, udata_in = udata, udata_out = udata_out, $
float=float, force_darksub=qlow8, $
noleak=noleak, orbit_correct=dc_orbit_correct)
;, second_order=second_order_leak) LWA 1/10/04
if (quncert) then udata = udata_out ;jmm, 12-feb-95, reset udata to the DARK_SUB value
end
end
if (qcor) then quse_input2 = 0
end
;
;------------------------------------------------------------------------------
; Begin looping through each input image
;------------------------------------------------------------------------------
;
qfirst_out = 1
last_ser_num = -999
for iimg=0,n_elements(index)-1 do begin
if (qread) then begin
if (keyword_set(qdebug)) then print, 'Reading dataset # ', iimg
rd_xda, infil, dset(iimg), index0, data0, roadmap
siz = size(data0)
typ_in = siz( siz(0)+1 )
index_out0 = index0
end else begin
index0 = index(iimg)
if (quse_input2) then data0 = input2(*,*,iimg) $
else data0 = data(*,*,iimg)
index_out0 = index0
if (qcor) then index_out0 = index_out_qr(iimg) ;index out in this case is what is returned from LEAK_SUB
end
if (keyword_set(qdebug)) then print, 'Now processing ', fmt_tim(index0)
ser_num = index0.sxt.serial_num
if (keyword_set(allow_duplicates)) then ser_num = iimg ;MDM added 18-May-95
iout = where(ser_map eq ser_num)
iout = iout(0) ;make it scalar
if (qoutfil) then iout = 0
num_or = index_out0.sxt.shape_cmd(1) / index_out0.sxt.shape_sav(1) ;MDM added 24-Nov-93 (there has to be a better way!!)
;^^ is the number of observing regions
siz = size(data0)
nx_data = siz(1)
ny_data = siz(2)
nx_in = gt_shape(index0, /x)
ny_in = gt_shape(index0, /y)
xxx1 = (nx_in-1) < (nx_data-1) ;trim for the case of a smaller image imbedded in a larger data cube
yyy1 = (ny_in-1) < (ny_data-1)
data0 = temporary(data0(0:xxx1, 0:yyy1)) ;need "<(ny_data-1)" because gt_shape is or shape, and data0 could be pfi strip
;--------------------------------------------------------------------------------
; Data decompression and background subtaction
;--------------------------------------------------------------------------------
if (qread) then begin ;if not read, then already did leak_sub up above
if (quncert) then udata0 = sxt_decomp(data0, /uncert) else udata0=0
if (qsatpix) then sdata0 = sxt_satpix(index0, data0, sat_limit=sat_limit, upper_only=upper_only)
if (qcor) then begin ;jmm, 12-feb-95
udata_out = quncert ;this must be set for LEAK_SUB to pass out uncertainties
data0 = leak_sub(index_out0, temporary(data0), save = (iimg NE N_ELEMENTS(index)-1) , $
/update_index, dc_interpolate = dc_interpolate, dc_scalar = dc_scalar, $
udata_in = udata0, udata_out = udata_out, $
float=float, noleak=noleak, orbit_correct=dc_orbit_correct)
if (quncert) then udata0 = udata_out ;jmm, 12-feb-95, reset udata0 to LEAK_SUB value
end
end else begin
if (quncert) then udata0 = udata(0:xxx1, 0:yyy1, iimg)
if (qsatpix) then sdata0 = sdata(0:xxx1, 0:yyy1, iimg)
end
;--------------------------------------------------------------------------------
; Optionally Despike and Clean
;--------------------------------------------------------------------------------
if (qdespike) then begin ;MDM added 20-Mar-95
data0 = de_spiker(data0, despike_thresh, width=width)
his_index, index_out0, 0, 'q_extra', 1
his_index, index_out0, 0, 'extra1', despike_thresh
end
if (qsig_filt) then begin ;MDM added 20-Mar-95
cmd = 'data0 = sigma_filter(data0, sigma_filt, n_sigma=n_sigma, ' + $
'iterate=sigma_iterate, /all_pixels)'
stat = execute(cmd)
his_index, index_out0, 0, 'q_extra', 2
his_index, index_out0, 0, 'extra1', sigma_filt
end
if n_elements(n_sigma) eq 0 then n_sigma=3 ; default for LWA cleanup routines
case 1 of ; despike/clean options
qsxt_clean: begin
if qsxt_kleen then box_message,'/SXT_KLEEN is obsolete - forcing /SXT_CLEAN
if loud then print,'sxt_clean> '+get_info(index_out0,/non)
data0=sxt_clean(index_out0, data0, nsigma=n_sigma, xsaa=destreak)
his_index,index_out0, 0, 'q_extra', 4 + destreak
his_index,index_out0, 0, 'extra1',n_sigma
if qsatpix then sdata0=big_smooth(sdata0,/med) ;LWA 1/16/2004
endcase
qsxt_kleen: begin
box_message,'/SXT_KLEEN is OBSOLETE, please use /SXT_CLEAN
endcase
else: ; else, no 'clean routine'
endcase
;--------------------------------------------------------------------------------
; Optionally Apply Second_Order_Leak and Vignette Corrections
;--------------------------------------------------------------------------------
firstleak=get_yo_dates(/ent) ; Test for first entrance failure.
tt=int2secarr(anytim(index(0),/yohkoh),anytim(firstleak(1),/yohkoh)) - $
int2secarr(anytim(firstleak(1),/yohkoh))
if (keyword_set(second_order_leak) and tt gt 0) then begin
dtp=data_type(input2)
second_done=0 ; assume not applied (sxt_deleak "failure")
case 1 of
dtp eq 1 : data0=sxt_deleak(index0,temporary(data0),xdata=input2(*,*,iimg),$
yn=second_done)
dtp ne 1 : data0=sxt_deleak(index0,temporary(data0),yn=second_done)
endcase
pver = gt_tagval(index_out0,/q_leak_sub) ; get existing value
pver = pver + (2^15. * (second_done ne 0)) ; sets bit if sxt_deleak "succesful"
his_index, index_out0, 0, 'q_leak_sub', pver
endif
if (qvig) then begin ;MDM added 20-Mar-95
data0 = sxt_off_axis(index_out0, data0, /update_index)
end
if (qreg) then begin
if (qsfd) then begin ;do SFD decompression
if (keyword_set(qdebug)) then print, 'SFD decompression'
data0 = sfd_decomp( temporary(data0) )
typ_in = 4 ;it is decompressed now
end
;------------------------- Update the index record (do before ALIGN1IMG so have sun center location for pivot point)
if (n_elements(helio) ne 0) then his_index, index_out0, 0, 'q_sun_rot', progverno
if (n_elements(sc) ne 0) then his_index, index_out0, 0, 'sun_center', [sc(*,iimg), roll_arr(iimg)]
;--------------------------------------------------------------------------------
; Extract and align the data
;--------------------------------------------------------------------------------
;;xc = xx(iimg) - nx/2*2^outres ;x corner address
;;yc = yy(iimg) - ny/2*2^outres
; -------------------------------------------------------
oddeven=nx mod 2 ; added 20-Nov-98 by DMcK
xc = xx(iimg) - (nx-(1-oddeven))/2.*2^outres
oddeven=ny mod 2
yc = yy(iimg) - (ny-(1-oddeven))/2.*2^outres
index_save = index_out0
align1img, index_out0, data0, xc, yc, nx, ny, ox0, oy0, outres, fast = fast, $
qcor = qcor, typout = typout, typ_in = typ_in, qdebug = qdebug, oy = oy, override = override, norm_fact = qsfd
;^^ "norm_fact=qsfd" added because the signal level of SFD images are all normalized to DN/sec/HR pixels
index_junk = index_save
;;udata0 = fix(udata0) - use the /override option and stay in byte type the whole way
if (quncert) then align1img, index_junk, udata0, xc, yc, nx, ny, ox0, oy0, outres, fast = fast, $
qcor = qcor, typout = typout, typ_in = typ_in, qdebug = qdebug, oy = oy, /override, norm_fact = 2
index_junk = index_save
if (qsatpix) then begin
sdata0 = sdata0 * 100 ;Added 15-Sept-93
align1img, index_junk, sdata0, xc, yc, nx, ny, ox0, oy0, outres, fast=fast, $
qcor=qcor, typout=typout, typ_in=typ_in, qdebug=qdebug, oy=oy, override=override, norm_fact=1
sdata0 = byte( sdata0/100. + 0.99) ;more than 1% of a saturated pixel moves will cause the 1% pixel to be flagged as
;saturated
end
st_en_lin(*, gt_or_expnum(index0)-1, iout) = oy
;-------------------------
if (keyword_set(qmstop)) then stop
;-------------------------
if (qsfd) then begin
if (keyword_set(qdebug)) then print, 'SFD compression'
data0 = alog10( temporary(data0) >1. )
data0 = bytscl( temporary(data0), max=6., min=0., top=255)
end
end else begin ;---------------------------------------- No registration case - still need to assemble observing region
ox0 = 0
oy0 = (gt_or_expnum(index0)-1)*64
index_out0.sxt.shape_sav = gt_shape(index0, /obs_region) ;save the updated shape
if (his_exist(index_out0)) then index_out0.his.corner_sav(1) = index_out0.his.corner_sav(1) - (gt_or_expnum(index0)-1)*64 $
else index_out0.sxt.corner_sav(1) = index_out0.sxt.corner_sav(1) - (gt_or_expnum(index0)-1)*64
end
;--------------------------------------------------------------------------------
; Optionally Normalize the data
;--------------------------------------------------------------------------------
if (qnorm) then begin
data0 = exp_norm(data0, index_out0, 0.)
junk_index = index(iimg)
if (quncert) then udata0 = fix( exp_norm(udata0, junk_index, 0.0) + 0.5)
end
;-------------------- Save the data into the index array
if (ser_num ne last_ser_num) then begin ;only update the history record for the first occurance of a strip
percentd = float(index_out0.sxt.percentd)/num_or + 0.5 ;initialize percentd variable (round up)
index_out0b = str_copy_tags(index_out(0), index_out0)
index_out(iout) = index_out0b
end else begin
percentd = percentd + float(index_out0.sxt.percentd)/num_or
end
;-------------------- Save the data into the output cube
if (keyword_set(qdebug)) then print, 'Image being inserted into: ox0, oy0, iout', ox0, oy0, iout
if ((ox0 lt nx-1) and (oy0 le ny-1)) then begin
data_out(ox0, oy0, iout) = data0
if (quncert) then unc_data(ox0, oy0, iout) = udata0
if (qsatpix) then satpix(ox0, oy0, iout) = sdata0
end
next_ser_num = -999
if (iimg ne n_elements(index)-1) then next_ser_num = index(iimg+1).sxt.serial_num
qfinished = next_ser_num ne ser_num ;if next image is a different OR, then we are finished with this one
if (qfinished) then begin
index_out(iout).sxt.percentd = byte(percentd)<255
;--------------------------------------------------------------------------------
; Optionally Roll the Image (MDM added/moved 14-Jan-94)
;--------------------------------------------------------------------------------
if (qroll) then begin
roll = roll_arr(iimg)
xpiv = -gt_corner(index_out(iout), /from_sc, /x) ;invert the sign
ypiv = -gt_corner(index_out(iout), /from_sc, /y)
data0 = data_out(*,*,iout)
if (quncert) then udata0 = unc_data(*, *, iout)
if (qsatpix) then sdata0 = satpix(*, *, iout)
;
data_out(0,0,iout) = rot(data0, -roll, 1, xpiv, ypiv, missing=0, /pivot, cubic=cubic, interp=interp)
if (quncert) then begin
;MDM made the rotated results be saved in "udata0" instead of directly into "unc_data" so that OUTFIL option works
udata0 = rot(udata0, -roll, 1, xpiv, ypiv, missing=0, /pivot, cubic=cubic, interp=interp)
unc_data(0, 0, iout) = udata0
end
if (qsatpix) then begin
sdata0 = temporary(sdata0) * 100
sdata0 = rot(temporary(sdata0), -roll, 1, xpiv, ypiv, missing=0, /pivot, cubic=cubic, interp=interp)
sdata0 = byte( temporary(sdata0)/100. + 0.99)
;more than 1% of a saturated pixel moves will cause the 1% pixel to be flagged as saturated
satpix(0, 0, iout) = sdata0
end
;
vals = [0,0,roll]
if (n_elements(sc) ne 0) then vals = [sc(*,iimg), roll_arr(iimg)]
his_index, index_out, iout, 'sun_center', vals
his_index, index_out, iout, 'q_roll_corr', progverno ;MDM added 8-Mar-94 - corrected 31-Mar-94
end
;--------------------------------------------------------------------------------
; Optionally Fill the gap in the OR assembly
;--------------------------------------------------------------------------------
if (qfill_gap) then begin
interp_or, data_out, st_en_lin, iout, iout, trim_edge=trim_edge, qdebug=qdebug
if (quncert) then interp_or, unc_data, st_en_lin, iout, iout, trim_edge=trim_edge
if (qsatpix) then interp_or, satpix, st_en_lin, iout, iout, trim_edge=trim_edge
end
;--------------------------------------------------------------------------------
; Write the data out
;--------------------------------------------------------------------------------
;
if (qoutfil) then begin
if (qfinished) then begin
sav_sda, outfil, index_out(iout), data_out, append=(1-qfirst_out) or append
if (quncert) then sav_sda, outfil+'_unc', index_out(iout), udata0, append=(1-qfirst_out)
if (qsatpix) then sav_sda, outfil+'_sat', index_out(iout), sdata0, append=(1-qfirst_out)
qfirst_out = 0
data_out = make_array(nx, ny, nout, type=typout) ;needed to zero out the data array
end
end
if (keyword_set(q2stop)) then stop
end
last_ser_num = ser_num
end
;
if suture and n_elements(data_out) gt 0 then begin
if loud or first_call then box_message,'Applying sxt_suture post processing'
for i=0,n_elements(index_out)-1 do begin
temp=sxt_suture(data_out(*,*,i), satpix(*,*,i), unc_data(*,*,i))
data_out(0,0,i)=temp
endfor
endif
end_time = systime(1)
run_time = (end_time-start_time)/60.
print, 'SXT_PREP took: ', run_time, ' minutes to process your request'
if (keyword_set(new_sdc_db)) then set_new_db, /reset ;MDM added 18-May-95
if (keyword_set(new_sfc_db)) then set_new_db, /reset, /leak
if (keyword_set(oride_pnt_chk)) then set_logenv, 'YS_ORIDE_PNT_CHK', ''
if (keyword_set(qstop)) then stop
end